|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 34098 (0x8532)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦this⟧
with Dfa, Int_Io, Misc_Defs, Text_Io, Misc, Tblcmp, Ccl, External_File_Manager;
with Ecs, Nfa, Tstring, Gen, Skeleton_Manager;
use Misc_Defs, External_File_Manager;
package body Dfa is
use Tstring;
-- check_for_backtracking - check a DFA state for backtracking
--
-- ds is the number of the state to check and state[) is its out-transitions,
-- indexed by equivalence class, and state_rules[) is the set of rules
-- associated with this state
Did_Stk_Init : Boolean := False;
Stk : Int_Ptr;
procedure Check_For_Backtracking (Ds : in Integer;
State : in Unbounded_Int_Array) is
use Misc_Defs;
begin
if (Dfaacc (Ds).Dfaacc_State = 0) then
-- state is non-accepting
Num_Backtracking := Num_Backtracking + 1;
if (Backtrack_Report) then
Text_Io.Put (Backtrack_File, "State #");
Int_Io.Put (Backtrack_File, Ds, 1);
Text_Io.Put (Backtrack_File, "is non-accepting -");
Text_Io.New_Line (Backtrack_File);
-- identify the state
Dump_Associated_Rules (Backtrack_File, Ds);
-- now identify it further using the out- and jam-transitions
Dump_Transitions (Backtrack_File, State);
Text_Io.New_Line (Backtrack_File);
end if;
end if;
end Check_For_Backtracking;
-- check_trailing_context - check to see if NFA state set constitutes
-- "dangerous" trailing context
--
-- NOTES
-- Trailing context is "dangerous" if both the head and the trailing
-- part are of variable size \and/ there's a DFA state which contains
-- both an accepting state for the head part of the rule and NFA states
-- which occur after the beginning of the trailing context.
-- When such a rule is matched, it's impossible to tell if having been
-- in the DFA state indicates the beginning of the trailing context
-- or further-along scanning of the pattern. In these cases, a warning
-- message is issued.
--
-- nfa_states[1 .. num_states) is the list of NFA states in the DFA.
-- accset[1 .. nacc) is the list of accepting numbers for the DFA state.
procedure Check_Trailing_Context (Nfa_States : in Int_Ptr;
Num_States : in Integer;
Accset : in Int_Ptr;
Nacc : in Integer) is
Ns, Ar : Integer;
State_Var, Type_Var : State_Enum;
use Misc_Defs, Misc, Text_Io;
begin
for I in 1 .. Num_States loop
Ns := Nfa_States (I);
Type_Var := State_Type (Ns);
Ar := Assoc_Rule (Ns);
if ((Type_Var = State_Normal) or
(Rule_Type (Ar) /= Rule_Variable)) then
null;
-- do nothing
else
if (Type_Var = State_Trailing_Context) then
-- potential trouble. Scan set of accepting numbers for
-- the one marking the end of the "head". We assume that
-- this looping will be fairly cheap since it's rare that
-- an accepting number set is large.
for J in 1 .. Nacc loop
if (Check_Yy_Trailing_Head_Mask (Accset (J)) /= 0) then
Text_Io.Put
(Standard_Error,
"aflex: Dangerous trailing context in rule at line ");
Int_Io.Put (Standard_Error, Rule_Linenum (Ar), 1);
Text_Io.New_Line (Standard_Error);
return;
end if;
end loop;
end if;
end if;
end loop;
end Check_Trailing_Context;
-- dump_associated_rules - list the rules associated with a DFA state
--
-- goes through the set of NFA states associated with the DFA and
-- extracts the first MAX_ASSOC_RULES unique rules, sorts them,
-- and writes a report to the given file
procedure Dump_Associated_Rules (F : in File_Type; Ds : in Integer) is
J : Integer;
Num_Associated_Rules : Integer := 0;
Rule_Set : Int_Ptr;
Size, Rule_Num : Integer;
begin
Rule_Set := new Unbounded_Int_Array (0 .. Max_Assoc_Rules + 1);
Size := Dfasiz (Ds);
for I in 1 .. Size loop
Rule_Num := Rule_Linenum (Assoc_Rule (Dss (Ds) (I)));
J := 1;
while (J <= Num_Associated_Rules) loop
if (Rule_Num = Rule_Set (J)) then
exit;
end if;
J := J + 1;
end loop;
if (J > Num_Associated_Rules) then
--new rule
if (Num_Associated_Rules < Max_Assoc_Rules) then
Num_Associated_Rules := Num_Associated_Rules + 1;
Rule_Set (Num_Associated_Rules) := Rule_Num;
end if;
end if;
end loop;
Misc.Bubble (Rule_Set, Num_Associated_Rules);
Text_Io.Put (F, " associated rules:");
for I in 1 .. Num_Associated_Rules loop
if (I mod 8 = 1) then
Text_Io.New_Line (F);
end if;
Text_Io.Put (F, Ascii.Ht);
Int_Io.Put (F, Rule_Set (I), 1);
end loop;
Text_Io.New_Line (F);
exception
when Storage_Error =>
Misc.Aflexfatal
("dynamic memory failure in dump_associated_rules()");
end Dump_Associated_Rules;
-- dump_transitions - list the transitions associated with a DFA state
--
-- goes through the set of out-transitions and lists them in human-readable
-- form (i.e., not as equivalence classes); also lists jam transitions
-- (i.e., all those which are not out-transitions, plus EOF). The dump
-- is done to the given file.
procedure Dump_Transitions (F : in File_Type;
State : in Unbounded_Int_Array) is
Ec : Integer;
Out_Char_Set : C_Size_Bool_Array;
begin
for I in 1 .. Csize loop
Ec := Ecgroup (I);
if (Ec < 0) then
Ec := -Ec;
end if;
Out_Char_Set (I) := (State (Ec) /= 0);
end loop;
Text_Io.Put (F, " out-transitions: ");
Ccl.List_Character_Set (F, Out_Char_Set);
-- now invert the members of the set to get the jam transitions
for I in 1 .. Csize loop
Out_Char_Set (I) := not Out_Char_Set (I);
end loop;
Text_Io.New_Line (F);
Text_Io.Put (F, "jam-transitions: EOF ");
Ccl.List_Character_Set (F, Out_Char_Set);
Text_Io.New_Line (F);
end Dump_Transitions;
-- epsclosure - construct the epsilon closure of a set of ndfa states
--
-- NOTES
-- the epsilon closure is the set of all states reachable by an arbitrary
-- number of epsilon transitions which themselves do not have epsilon
-- transitions going out, unioned with the set of states which have non-null
-- accepting numbers. t is an array of size numstates of nfa state numbers.
-- Upon return, t holds the epsilon closure and numstates is updated. accset
-- holds a list of the accepting numbers, and the size of accset is given
-- by nacc. t may be subjected to reallocation if it is not large enough
-- to hold the epsilon closure.
--
-- hashval is the hash value for the dfa corresponding to the state set
procedure Epsclosure (T : in out Int_Ptr;
Ns_Addr : in out Integer;
Accset : in out Int_Ptr;
Nacc_Addr, Hv_Addr : out Integer;
Result : out Int_Ptr) is
Ns, Tsp : Integer;
Numstates, Nacc, Hashval, Transsym, Nfaccnum : Integer;
Stkend : Integer;
Stkpos : Integer;
procedure Mark_State (State : in Integer) is
begin
Trans1 (State) := Trans1 (State) - Marker_Difference;
end Mark_State;
pragma Inline (Mark_State);
function Is_Marked (State : in Integer) return Boolean is
begin
return Trans1 (State) < 0;
end Is_Marked;
pragma Inline (Is_Marked);
procedure Unmark_State (State : in Integer) is
begin
Trans1 (State) := Trans1 (State) + Marker_Difference;
end Unmark_State;
pragma Inline (Unmark_State);
procedure Check_Accept (State : in Integer) is
begin
Nfaccnum := Accptnum (State);
if (Nfaccnum /= Nil) then
Nacc := Nacc + 1;
Accset (Nacc) := Nfaccnum;
end if;
end Check_Accept;
pragma Inline (Check_Accept);
procedure Do_Reallocation is
begin
Current_Max_Dfa_Size :=
Current_Max_Dfa_Size + Max_Dfa_Size_Increment;
Num_Reallocs := Num_Reallocs + 1;
Reallocate_Integer_Array (T, Current_Max_Dfa_Size);
Reallocate_Integer_Array (Stk, Current_Max_Dfa_Size);
end Do_Reallocation;
pragma Inline (Do_Reallocation);
procedure Put_On_Stack (State : in Integer) is
begin
Stkend := Stkend + 1;
if (Stkend >= Current_Max_Dfa_Size) then
Do_Reallocation;
end if;
Stk (Stkend) := State;
Mark_State (State);
end Put_On_Stack;
pragma Inline (Put_On_Stack);
procedure Add_State (State : in Integer) is
begin
Numstates := Numstates + 1;
if (Numstates >= Current_Max_Dfa_Size) then
Do_Reallocation;
end if;
T (Numstates) := State;
Hashval := Hashval + State;
end Add_State;
pragma Inline (Add_State);
procedure Stack_State (State : in Integer) is
begin
Put_On_Stack (State);
Check_Accept (State);
if ((Nfaccnum /= Nil) or (Transchar (State) /= Sym_Epsilon)) then
Add_State (State);
end if;
end Stack_State;
pragma Inline (Stack_State);
begin
Numstates := Ns_Addr;
if (not Did_Stk_Init) then
Stk := Allocate_Integer_Array (Current_Max_Dfa_Size);
Did_Stk_Init := True;
end if;
Nacc := 0;
Stkend := 0;
Hashval := 0;
for Nstate in 1 .. Numstates loop
Ns := T (Nstate);
-- the state could be marked if we've already pushed it onto
-- the stack
if (not Is_Marked (Ns)) then
Put_On_Stack (Ns);
null;
end if;
Check_Accept (Ns);
Hashval := Hashval + Ns;
end loop;
Stkpos := 1;
while (Stkpos <= Stkend) loop
Ns := Stk (Stkpos);
Transsym := Transchar (Ns);
if (Transsym = Sym_Epsilon) then
Tsp := Trans1 (Ns) + Marker_Difference;
if (Tsp /= No_Transition) then
if (not Is_Marked (Tsp)) then
Stack_State (Tsp);
end if;
Tsp := Trans2 (Ns);
if (Tsp /= No_Transition) then
if (not Is_Marked (Tsp)) then
Stack_State (Tsp);
end if;
end if;
end if;
end if;
Stkpos := Stkpos + 1;
end loop;
-- clear out "visit" markers
for Chk_Stkpos in 1 .. Stkend loop
if (Is_Marked (Stk (Chk_Stkpos))) then
Unmark_State (Stk (Chk_Stkpos));
else
Misc.Aflexfatal ("consistency check failed in epsclosure()");
end if;
end loop;
Ns_Addr := Numstates;
Hv_Addr := Hashval;
Nacc_Addr := Nacc;
Result := T;
end Epsclosure;
-- increase_max_dfas - increase the maximum number of DFAs
procedure Increase_Max_Dfas is
begin
Current_Max_Dfas := Current_Max_Dfas + Max_Dfas_Increment;
Num_Reallocs := Num_Reallocs + 1;
Reallocate_Integer_Array (Base, Current_Max_Dfas);
Reallocate_Integer_Array (Def, Current_Max_Dfas);
Reallocate_Integer_Array (Dfasiz, Current_Max_Dfas);
Reallocate_Integer_Array (Accsiz, Current_Max_Dfas);
Reallocate_Integer_Array (Dhash, Current_Max_Dfas);
Reallocate_Int_Ptr_Array (Dss, Current_Max_Dfas);
Reallocate_Dfaacc_Union (Dfaacc, Current_Max_Dfas);
end Increase_Max_Dfas;
-- ntod - convert an ndfa to a dfa
--
-- creates the dfa corresponding to the ndfa we've constructed. the
-- dfa starts out in state #1.
procedure Ntod is
Accset : Int_Ptr;
Ds, Nacc, Newds : Integer;
Duplist, Targfreq, Targstate, State : C_Size_Array;
Symlist : C_Size_Bool_Array;
Hashval, Numstates, Dsize : Integer;
Nset, Dset : Int_Ptr;
Targptr, Totaltrans, I, J, Comstate, Comfreq, Targ : Integer;
Num_Start_States, Todo_Head, Todo_Next : Integer;
Snsresult : Boolean;
Full_Table_Temp_File : File_Type;
Buf : Vstring;
Num_Nxt_States : Integer;
use Text_Io;
-- this is so find_table_space(...) will know where to start looking in
-- chk/nxt for unused records for space to put in the state
begin
Accset := Allocate_Integer_Array (Num_Rules + 1);
Nset := Allocate_Integer_Array (Current_Max_Dfa_Size);
-- the "todo" queue is represented by the head, which is the DFA
-- state currently being processed, and the "next", which is the
-- next DFA state number available (not in use). We depend on the
-- fact that snstods() returns DFA's \in increasing order/, and thus
-- need only know the bounds of the dfas to be processed.
Todo_Head := 0;
Todo_Next := 0;
for Cnt in 0 .. Csize loop
Duplist (Cnt) := Nil;
Symlist (Cnt) := False;
end loop;
for Cnt in 0 .. Num_Rules loop
Accset (Cnt) := Nil;
end loop;
if (Trace) then
Nfa.Dumpnfa (Scset (1));
Text_Io.New_Line (Standard_Error);
Text_Io.New_Line (Standard_Error);
Text_Io.Put (Standard_Error, "DFA Dump:");
Text_Io.New_Line (Standard_Error);
Text_Io.New_Line (Standard_Error);
end if;
Tblcmp.Inittbl;
if (Fulltbl) then
Gen.Do_Sect3_Out;
-- output user code up to ##
Skeleton_Manager.Skelout;
-- declare it "short" because it's a real long-shot that that
-- won't be large enough
begin -- make a temporary file to write yy_nxt array into
Create (Full_Table_Temp_File, Out_File);
exception
when Use_Error | Name_Error =>
Misc.Aflexfatal ("can't create temporary file");
end;
Num_Nxt_States := 1;
Text_Io.Put (Full_Table_Temp_File, "( ");
-- generate 0 entries for state #0
for Cnt in 0 .. Numecs loop
Misc.Mk2data (Full_Table_Temp_File, 0);
end loop;
Text_Io.Put (Full_Table_Temp_File, " )");
-- force extra blank line next dataflush()
Dataline := Numdatalines;
end if;
-- create the first states
Num_Start_States := Lastsc * 2;
for Cnt in 1 .. Num_Start_States loop
Numstates := 1;
-- for each start condition, make one state for the case when
-- we're at the beginning of the line (the '%' operator) and
-- one for the case when we're not
if (Cnt mod 2 = 1) then
Nset (Numstates) := Scset ((Cnt / 2) + 1);
else
Nset (Numstates) := Nfa.Mkbranch
(Scbol (Cnt / 2), Scset (Cnt / 2));
end if;
Dfa.Epsclosure (Nset, Numstates, Accset, Nacc, Hashval, Nset);
Snstods (Nset, Numstates, Accset, Nacc, Hashval, Ds, Snsresult);
if (Snsresult) then
Numas := Numas + Nacc;
Totnst := Totnst + Numstates;
Todo_Next := Todo_Next + 1;
if (Variable_Trailing_Context_Rules and (Nacc > 0)) then
Check_Trailing_Context (Nset, Numstates, Accset, Nacc);
end if;
end if;
end loop;
Snstods (Nset, 0, Accset, 0, 0, End_Of_Buffer_State, Snsresult);
if (not Snsresult) then
Misc.Aflexfatal ("could not create unique end-of-buffer state");
end if;
Numas := Numas + 1;
Num_Start_States := Num_Start_States + 1;
Todo_Next := Todo_Next + 1;
while (Todo_Head < Todo_Next) loop
Num_Nxt_States := Num_Nxt_States + 1;
Targptr := 0;
Totaltrans := 0;
for State_Cnt in 1 .. Numecs loop
State (State_Cnt) := 0;
end loop;
Todo_Head := Todo_Head + 1;
Ds := Todo_Head;
Dset := Dss (Ds);
Dsize := Dfasiz (Ds);
if (Trace) then
Text_Io.Put (Standard_Error, "state # ");
Int_Io.Put (Standard_Error, Ds, 1);
Text_Io.Put_Line (Standard_Error, ":");
end if;
Sympartition (Dset, Dsize, Symlist, Duplist);
for Sym in 1 .. Numecs loop
if (Symlist (Sym)) then
Symlist (Sym) := False;
if (Duplist (Sym) = Nil) then
-- symbol has unique out-transitions
Numstates := Symfollowset (Dset, Dsize, Sym, Nset);
Dfa.Epsclosure (Nset, Numstates, Accset,
Nacc, Hashval, Nset);
Snstods (Nset, Numstates, Accset, Nacc,
Hashval, Newds, Snsresult);
if (Snsresult) then
Totnst := Totnst + Numstates;
Todo_Next := Todo_Next + 1;
Numas := Numas + Nacc;
if (Variable_Trailing_Context_Rules and
(Nacc > 0)) then
Check_Trailing_Context
(Nset, Numstates, Accset, Nacc);
end if;
end if;
State (Sym) := Newds;
if (Trace) then
Text_Io.Put (Standard_Error, Ascii.Ht);
Int_Io.Put (Standard_Error, Sym, 1);
Text_Io.Put (Standard_Error, Ascii.Ht);
Int_Io.Put (Standard_Error, Newds, 1);
Text_Io.New_Line (Standard_Error);
end if;
Targptr := Targptr + 1;
Targfreq (Targptr) := 1;
Targstate (Targptr) := Newds;
Numuniq := Numuniq + 1;
else
-- sym's equivalence class has the same transitions
-- as duplist(sym)'s equivalence class
Targ := State (Duplist (Sym));
State (Sym) := Targ;
if (Trace) then
Text_Io.Put (Standard_Error, Ascii.Ht);
Int_Io.Put (Standard_Error, Sym, 1);
Text_Io.Put (Standard_Error, Ascii.Ht);
Int_Io.Put (Standard_Error, Targ, 1);
Text_Io.New_Line (Standard_Error);
end if;
-- update frequency count for destination state
I := 1;
while (Targstate (I) /= Targ) loop
I := I + 1;
end loop;
Targfreq (I) := Targfreq (I) + 1;
Numdup := Numdup + 1;
end if;
Totaltrans := Totaltrans + 1;
Duplist (Sym) := Nil;
end if;
end loop;
Numsnpairs := Numsnpairs + Totaltrans;
if (Caseins and not Useecs) then
I := Character'Pos ('A');
J := Character'Pos ('a');
while (I < Character'Pos ('Z')) loop
State (I) := State (J);
I := I + 1;
J := J + 1;
end loop;
end if;
if (Ds > Num_Start_States) then
Check_For_Backtracking (Ds, State);
end if;
if (Fulltbl) then
-- supply array's 0-element
Text_Io.Put (Full_Table_Temp_File, ",");
Misc.Dataflush (Full_Table_Temp_File);
Text_Io.Put (Full_Table_Temp_File, "( ");
if (Ds = End_Of_Buffer_State) then
Misc.Mk2data (Full_Table_Temp_File, -End_Of_Buffer_State);
else
Misc.Mk2data (Full_Table_Temp_File, End_Of_Buffer_State);
end if;
for Cnt in 1 .. Numecs loop
-- jams are marked by negative of state number
if ((State (Cnt) /= 0)) then
Misc.Mk2data (Full_Table_Temp_File, State (Cnt));
else
Misc.Mk2data (Full_Table_Temp_File, -Ds);
end if;
end loop;
Text_Io.Put (Full_Table_Temp_File, " )");
-- force extra blank line next dataflush()
Dataline := Numdatalines;
else
if (Ds = End_Of_Buffer_State) then
-- special case this state to make sure it does what it's
-- supposed to, i.e., jam on end-of-buffer
Tblcmp.Stack1 (Ds, 0, 0, Jamstate_Const);
else -- normal, compressed state
-- determine which destination state is the most common, and
-- how many transitions to it there are
Comfreq := 0;
Comstate := 0;
for Cnt in 1 .. Targptr loop
if (Targfreq (Cnt) > Comfreq) then
Comfreq := Targfreq (Cnt);
Comstate := Targstate (Cnt);
end if;
end loop;
Tblcmp.Bldtbl (State, Ds, Totaltrans, Comstate, Comfreq);
end if;
end if;
end loop;
if (Fulltbl) then
Text_Io.Put ("yy_nxt : constant array(0..");
Int_Io.Put (Num_Nxt_States - 1, 1);
Text_Io.Put_Line
(" , character'first..character'last) of short :=");
Text_Io.Put_Line (" (");
Reset (Full_Table_Temp_File, In_File);
while (not End_Of_File (Full_Table_Temp_File)) loop
Tstring.Get_Line (Full_Table_Temp_File, Buf);
Tstring.Put_Line (Buf);
end loop;
Delete (Full_Table_Temp_File);
Misc.Dataend;
else
Tblcmp.Cmptmps; -- create compressed template entries
-- create tables for all the states with only one out-transition
while (Onesp > 0) loop
Tblcmp.Mk1tbl (Onestate (Onesp), Onesym (Onesp),
Onenext (Onesp), Onedef (Onesp));
Onesp := Onesp - 1;
end loop;
Tblcmp.Mkdeftbl;
end if;
end Ntod;
-- snstods - converts a set of ndfa states into a dfa state
--
-- on return, the dfa state number is in newds.
procedure Snstods (Sns : in Int_Ptr;
Numstates : in Integer;
Accset : in Int_Ptr;
Nacc, Hashval : in Integer;
Newds_Addr : out Integer;
Result : out Boolean) is
Didsort : Boolean := False;
J : Integer;
Newds : Integer;
Oldsns : Int_Ptr;
begin
for I in 1 .. Lastdfa loop
if (Hashval = Dhash (I)) then
if (Numstates = Dfasiz (I)) then
Oldsns := Dss (I);
if (not Didsort) then
-- we sort the states in sns so we can compare it to
-- oldsns quickly. we use bubble because there probably
-- aren't very many states
Misc.Bubble (Sns, Numstates);
Didsort := True;
end if;
J := 1;
while (J <= Numstates) loop
if (Sns (J) /= Oldsns (J)) then
exit;
end if;
J := J + 1;
end loop;
if (J > Numstates) then
Dfaeql := Dfaeql + 1;
Newds_Addr := I;
Result := False;
return;
end if;
Hshcol := Hshcol + 1;
else
Hshsave := Hshsave + 1;
end if;
end if;
end loop;
-- make a new dfa
Lastdfa := Lastdfa + 1;
if (Lastdfa >= Current_Max_Dfas) then
Increase_Max_Dfas;
end if;
Newds := Lastdfa;
Dss (Newds) := new Unbounded_Int_Array (0 .. Numstates + 1);
-- if we haven't already sorted the states in sns, we do so now, so that
-- future comparisons with it can be made quickly
if (not Didsort) then
Misc.Bubble (Sns, Numstates);
end if;
for I in 1 .. Numstates loop
Dss (Newds) (I) := Sns (I);
end loop;
Dfasiz (Newds) := Numstates;
Dhash (Newds) := Hashval;
if (Nacc = 0) then
Dfaacc (Newds).Dfaacc_State := 0;
Accsiz (Newds) := 0;
else
-- find lowest numbered rule so the disambiguating rule will work
J := Num_Rules + 1;
for I in 1 .. Nacc loop
if (Accset (I) < J) then
J := Accset (I);
end if;
end loop;
Dfaacc (Newds).Dfaacc_State := J;
end if;
Newds_Addr := Newds;
Result := True;
return;
exception
when Storage_Error =>
Misc.Aflexfatal ("dynamic memory failure in snstods()");
end Snstods;
-- symfollowset - follow the symbol transitions one step
function Symfollowset (Ds : in Int_Ptr;
Dsize, Transsym : in Integer;
Nset : in Int_Ptr) return Integer is
Ns, Tsp, Sym, Lenccl, Ch, Numstates, Ccllist : Integer;
begin
Numstates := 0;
for I in 1 .. Dsize loop
-- for each nfa state ns in the state set of ds
Ns := Ds (I);
Sym := Transchar (Ns);
Tsp := Trans1 (Ns);
if (Sym < 0) then
-- it's a character class
Sym := -Sym;
Ccllist := Cclmap (Sym);
Lenccl := Ccllen (Sym);
if (Cclng (Sym) /= 0) then
for J in 0 .. Lenccl - 1 loop
-- loop through negated character class
Ch := Character'Pos (Ccltbl (Ccllist + J));
if (Ch > Transsym) then
exit; -- transsym isn't in negated ccl
else
if (Ch = Transsym) then
goto Bottom; -- next 2
end if;
end if;
end loop;
-- didn't find transsym in ccl
Numstates := Numstates + 1;
Nset (Numstates) := Tsp;
else
for J in 0 .. Lenccl - 1 loop
Ch := Character'Pos (Ccltbl (Ccllist + J));
if (Ch > Transsym) then
exit;
else
if (Ch = Transsym) then
Numstates := Numstates + 1;
Nset (Numstates) := Tsp;
exit;
end if;
end if;
end loop;
end if;
else
if ((Sym >= Character'Pos ('A')) and
(Sym <= Character'Pos ('Z')) and Caseins) then
Misc.Aflexfatal
("consistency check failed in symfollowset");
else
if (Sym = Sym_Epsilon) then
null; -- do nothing
else
if (Ecgroup (Sym) = Transsym) then
Numstates := Numstates + 1;
Nset (Numstates) := Tsp;
end if;
end if;
end if;
end if;
<<Bottom>> null;
end loop;
return Numstates;
end Symfollowset;
-- sympartition - partition characters with same out-transitions
procedure Sympartition (Ds : in Int_Ptr;
Numstates : in Integer;
Symlist : in out C_Size_Bool_Array;
Duplist : in out C_Size_Array) is
Tch, J, Ns, Lenccl, Cclp, Ich : Integer;
Dupfwd : C_Size_Array;
-- partitioning is done by creating equivalence classes for those
-- characters which have out-transitions from the given state. Thus
-- we are really creating equivalence classes of equivalence classes.
begin
for I in 1 .. Numecs loop
-- initialize equivalence class list
Duplist (I) := I - 1;
Dupfwd (I) := I + 1;
end loop;
Duplist (1) := Nil;
Dupfwd (Numecs) := Nil;
Dupfwd (0) := 0;
for I in 1 .. Numstates loop
Ns := Ds (I);
Tch := Transchar (Ns);
if (Tch /= Sym_Epsilon) then
if ((Tch < -Lastccl) or (Tch > Csize)) then
Misc.Aflexfatal
("bad transition character detected in sympartition()");
end if;
if (Tch > 0) then
-- character transition
Ecs.Mkechar (Ecgroup (Tch), Dupfwd, Duplist);
Symlist (Ecgroup (Tch)) := True;
else
-- character class
Tch := -Tch;
Lenccl := Ccllen (Tch);
Cclp := Cclmap (Tch);
Ecs.Mkeccl (Ccltbl (Cclp .. Cclp + Lenccl),
Lenccl, Dupfwd, Duplist, Numecs);
if (Cclng (Tch) /= 0) then
J := 0;
for K in 0 .. Lenccl - 1 loop
Ich := Character'Pos (Ccltbl (Cclp + K));
J := J + 1;
while (J < Ich) loop
Symlist (J) := True;
J := J + 1;
end loop;
end loop;
J := J + 1;
while (J <= Numecs) loop
Symlist (J) := True;
J := J + 1;
end loop;
else
for K in 0 .. Lenccl - 1 loop
Ich := Character'Pos (Ccltbl (Cclp + K));
Symlist (Ich) := True;
end loop;
end if;
end if;
end if;
end loop;
end Sympartition;
end Dfa;
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine. The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
-- TITLE DFA construction routines
-- AUTHOR: John Self (UCI)
-- DESCRIPTION converts non-deterministic finite automatons to finite ones.
-- $Header: /co/ua/self/arcadia/aflex/ada/src/RCS/dfaS.a,v 1.4 90/01/12 15:19:52 self Exp Locker: self $