|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 22528 (0x5800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Pattern_Match_Regular_Expression, seg_0046a0
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
--
-- (C) Copyright 1986 Grady Booch
-- All Rights Reserved
--
-- Serial Number 0000000
--
package body Pattern_Match_Regular_Expression is
function Location_Of (The_Pattern : in Items; In_The_Items : in Items)
return Index is
type Kind is (Literal, Class, Any, Stop, Unknown);
type Literals is array (Positive range 1 .. The_Pattern'Length) of Item;
type Pattern (The_Kind : Kind := Unknown) is
record
True_Pattern : Boolean := True;
Has_Closure : Boolean := False;
case The_Kind is
when Literal =>
The_Item : Item;
when Class =>
Number_Of_Items : Natural := 0;
The_Items : Literals;
when Any | Stop | Unknown =>
null;
end case;
end record;
type Patterns is array (Positive range <>) of Pattern;
Full_Pattern : Patterns (1 .. The_Pattern'Length + 1);
procedure Preprocess (The_Pattern : in Items;
Full_Pattern : in out Patterns) is
type State is (Building_Pattern, Building_Class,
Building_Escape_Pattern, Building_Escape_Class);
The_State : State := Building_Pattern;
Pattern_Index : Index := The_Pattern'First;
Full_Index : Positive := Full_Pattern'First;
Last_Pattern : Natural := 0;
begin
loop
case The_State is
when Building_Pattern =>
if Is_Equal (The_Pattern (Pattern_Index), Any_Item) then
if Full_Pattern (Full_Index).True_Pattern then
Full_Pattern (Full_Index) :=
(The_Kind => Any,
True_Pattern =>
Full_Pattern (Full_Index).True_Pattern,
Has_Closure => False);
Last_Pattern := Full_Index;
Full_Index := Full_Index + 1;
else
raise Illegal_Pattern;
end if;
elsif Is_Equal (The_Pattern (Pattern_Index),
Escape_Item) then
The_State := Building_Escape_Pattern;
elsif Is_Equal
(The_Pattern (Pattern_Index), Not_Item) then
if Full_Pattern (Full_Index).True_Pattern then
Full_Pattern (Full_Index).True_Pattern := False;
else
raise Illegal_Pattern;
end if;
elsif Is_Equal (The_Pattern (Pattern_Index),
Closure_Item) then
if not Full_Pattern (Last_Pattern).Has_Closure then
Full_Pattern (Last_Pattern).Has_Closure := True;
else
raise Illegal_Pattern;
end if;
elsif Is_Equal (The_Pattern (Pattern_Index),
Start_Class) then
Full_Pattern (Full_Index) :=
(The_Kind => Class,
True_Pattern =>
Full_Pattern (Full_Index).True_Pattern,
Has_Closure => False,
Number_Of_Items => 0,
The_Items => (others => Any_Item));
Last_Pattern := Full_Index;
Full_Index := Full_Index + 1;
The_State := Building_Class;
elsif Is_Equal (The_Pattern (Pattern_Index),
Stop_Class) then
raise Illegal_Pattern;
else
Full_Pattern (Full_Index) :=
(The_Kind => Literal,
True_Pattern =>
Full_Pattern (Full_Index).True_Pattern,
Has_Closure => False,
The_Item => The_Pattern (Pattern_Index));
Last_Pattern := Full_Index;
Full_Index := Full_Index + 1;
end if;
when Building_Class =>
if Is_Equal (The_Pattern (Pattern_Index), Any_Item) then
raise Illegal_Pattern;
elsif Is_Equal (The_Pattern (Pattern_Index),
Escape_Item) then
The_State := Building_Escape_Class;
elsif Is_Equal
(The_Pattern (Pattern_Index), Not_Item) then
raise Illegal_Pattern;
elsif Is_Equal (The_Pattern (Pattern_Index),
Closure_Item) then
raise Illegal_Pattern;
elsif Is_Equal (The_Pattern (Pattern_Index),
Start_Class) then
raise Illegal_Pattern;
elsif Is_Equal (The_Pattern (Pattern_Index),
Stop_Class) then
if Full_Pattern (Last_Pattern).Number_Of_Items >
0 then
The_State := Building_Pattern;
else
raise Illegal_Pattern;
end if;
else
Full_Pattern (Last_Pattern).Number_Of_Items :=
Full_Pattern (Last_Pattern).Number_Of_Items + 1;
Full_Pattern (Last_Pattern).The_Items
(Full_Pattern (Last_Pattern).Number_Of_Items) :=
The_Pattern (Pattern_Index);
end if;
when Building_Escape_Pattern =>
Full_Pattern (Full_Index) :=
(The_Kind => Literal,
True_Pattern =>
Full_Pattern (Full_Index).True_Pattern,
Has_Closure => False,
The_Item => The_Pattern (Pattern_Index));
Last_Pattern := Full_Index;
Full_Index := Full_Index + 1;
The_State := Building_Pattern;
when Building_Escape_Class =>
Full_Pattern (Last_Pattern).Number_Of_Items :=
Full_Pattern (Last_Pattern).Number_Of_Items + 1;
Full_Pattern (Last_Pattern).The_Items
(Full_Pattern (Last_Pattern).Number_Of_Items) :=
The_Pattern (Pattern_Index);
The_State := Building_Class;
end case;
if Pattern_Index = The_Pattern'Last then
if (The_State = Building_Pattern) and
(Full_Pattern (Full_Index).True_Pattern) then
Full_Pattern (Full_Index) :=
(The_Kind => Stop,
True_Pattern =>
Full_Pattern (Full_Index).True_Pattern,
Has_Closure => False);
return;
else
raise Illegal_Pattern;
end if;
else
Pattern_Index := Index'Succ (Pattern_Index);
end if;
end loop;
exception
when Constraint_Error =>
raise Illegal_Pattern;
end Preprocess;
function Is_Match (The_Pattern : in Pattern; The_Item : in Item)
return Boolean is
begin
case The_Pattern.The_Kind is
when Literal =>
if The_Pattern.True_Pattern then
return Is_Equal (The_Pattern.The_Item, The_Item);
else
return not Is_Equal (The_Pattern.The_Item, The_Item);
end if;
when Class =>
if The_Pattern.True_Pattern then
for Index in 1 .. The_Pattern.Number_Of_Items loop
if Is_Equal (The_Pattern.The_Items (Index),
The_Item) then
return True;
end if;
end loop;
return False;
else
for Index in 1 .. The_Pattern.Number_Of_Items loop
if Is_Equal (The_Pattern.The_Items (Index),
The_Item) then
return False;
end if;
end loop;
return True;
end if;
when Any =>
return True;
when others =>
raise Illegal_Pattern;
end case;
end Is_Match;
function Location_Of (Full_Pattern : in Patterns;
In_The_Items : in Items;
The_Start : in Index) return Index is
Items_Index : Index := The_Start;
Total_Closures : Natural := 0;
Temporary_Location : Index;
Temporary_Index : Index;
begin
for Full_Index in Full_Pattern'Range loop
if Full_Pattern (Full_Index).The_Kind = Stop then
return The_Start;
elsif Full_Pattern (Full_Index).Has_Closure then
for Index in Items_Index .. In_The_Items'Last loop
if Is_Match (Full_Pattern (Full_Index),
In_The_Items (Index)) then
Total_Closures := Total_Closures + 1;
else
exit;
end if;
end loop;
while Total_Closures > 0 loop
begin
Temporary_Index :=
Index'Val (Index'Pos (Items_Index) +
Total_Closures);
Temporary_Location :=
Location_Of (Full_Pattern (Full_Index + 1 ..
Full_Pattern'Last),
In_The_Items (Temporary_Index ..
In_The_Items'Last),
Temporary_Index);
Items_Index := Temporary_Index;
exit;
exception
when Pattern_Not_Found =>
Total_Closures := Total_Closures - 1;
end;
end loop;
elsif Is_Match (Full_Pattern (Full_Index),
In_The_Items (Items_Index)) then
Items_Index := Index'Succ (Items_Index);
else
raise Pattern_Not_Found;
end if;
end loop;
exception
when Constraint_Error =>
raise Pattern_Not_Found;
end Location_Of;
begin
Preprocess (The_Pattern, Full_Pattern);
for Start in In_The_Items'Range loop
begin
return Location_Of (Full_Pattern, In_The_Items, Start);
exception
when Pattern_Not_Found =>
null;
end;
end loop;
raise Pattern_Not_Found;
end Location_Of;
end Pattern_Match_Regular_Expression;
nblk1=15
nid=0
hdr6=2a
[0x00] rec0=1d rec1=00 rec2=01 rec3=010
[0x01] rec0=00 rec1=00 rec2=15 rec3=016
[0x02] rec0=14 rec1=00 rec2=02 rec3=006
[0x03] rec0=00 rec1=00 rec2=14 rec3=01e
[0x04] rec0=10 rec1=00 rec2=03 rec3=04e
[0x05] rec0=01 rec1=00 rec2=13 rec3=014
[0x06] rec0=10 rec1=00 rec2=04 rec3=084
[0x07] rec0=12 rec1=00 rec2=05 rec3=012
[0x08] rec0=00 rec1=00 rec2=12 rec3=038
[0x09] rec0=10 rec1=00 rec2=06 rec3=060
[0x0a] rec0=12 rec1=00 rec2=07 rec3=036
[0x0b] rec0=00 rec1=00 rec2=11 rec3=00a
[0x0c] rec0=11 rec1=00 rec2=08 rec3=02c
[0x0d] rec0=19 rec1=00 rec2=09 rec3=042
[0x0e] rec0=15 rec1=00 rec2=0a rec3=034
[0x0f] rec0=15 rec1=00 rec2=0b rec3=05e
[0x10] rec0=00 rec1=00 rec2=10 rec3=020
[0x11] rec0=13 rec1=00 rec2=0c rec3=040
[0x12] rec0=00 rec1=00 rec2=0f rec3=014
[0x13] rec0=1c rec1=00 rec2=0d rec3=03a
[0x14] rec0=01 rec1=00 rec2=0e rec3=000
tail 0x2170029d0815c66ae3c54 0x42a00088462061e03