DataMuseum.dk

top - download

    Length: 7139 (0x1be3)
    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⟧ 

TextFile

with Misc_Defs;
with Misc;
use Misc_Defs;
package body Ecs is

-- ccl2ecl - convert character classes to set of equivalence classes

    procedure Ccl2ecl is
        use Misc_Defs;
        Ich, Newlen, Cclp, Cclmec : Integer;
    begin
        for I in 1 .. Lastccl loop

            -- we loop through each character class, and for each character
            -- in the class, add the character's equivalence class to the
            -- new "character" class we are creating.  Thus when we are all
            -- done, character classes will really consist of collections
            -- of equivalence classes
            Newlen := 0;
            Cclp := Cclmap (I);

            for Ccls in 0 .. Ccllen (I) - 1 loop
                Ich := Character'Pos (Ccltbl (Cclp + Ccls));
                Cclmec := Ecgroup (Ich);
                if (Cclmec > 0) then
                    Ccltbl (Cclp + Newlen) := Character'Val (Cclmec);
                    Newlen := Newlen + 1;
                end if;
            end loop;

            Ccllen (I) := Newlen;
        end loop;
    end Ccl2ecl;


    -- cre8ecs - associate equivalence class numbers with class members
    --  fwd is the forward linked-list of equivalence class members.  bck
    --  is the backward linked-list, and num is the number of class members.
    --  Returned is the number of classes.

    procedure Cre8ecs (Fwd, Bck : in out C_Size_Array;
                       Num : in Integer;
                       Result : out Integer) is
        J, Numcl : Integer;
    begin
        Numcl := 0;

        -- create equivalence class numbers.  From now on, abs( bck(x) )
        -- is the equivalence class number for object x.  If bck(x)
        -- is positive, then x is the representative of its equivalence
        -- class.
        for I in 1 .. Num loop
            if (Bck (I) = Nil) then
                Numcl := Numcl + 1;
                Bck (I) := Numcl;
                J := Fwd (I);
                while (J /= Nil) loop
                    Bck (J) := -Numcl;
                    J := Fwd (J);
                end loop;
            end if;
        end loop;
        Result := Numcl;
        return;
    end Cre8ecs;


    -- mkeccl - update equivalence classes based on character class xtions
    -- where ccls contains the elements of the character class, lenccl is the
    -- number of elements in the ccl, fwd is the forward link-list of equivalent
    -- characters, bck is the backward link-list, and llsiz size of the link-list

    procedure Mkeccl (Ccls : in out Char_Array;
                      Lenccl : in Integer;
                      Fwd, Bck : in out Unbounded_Int_Array;
                      Llsiz : in Integer) is
        use Misc_Defs, Misc;
        Cclp, Oldec, Newec, Cclm, I, J : Integer;
        Proc_Array : Boolean_Ptr;
    begin

        -- note that it doesn't matter whether or not the character class is
        -- negated.  The same results will be obtained in either case.
        Cclp := Ccls'First;

        -- this array tells whether or not a character class has been processed.
        Proc_Array := new Boolean_Array (Ccls'First .. Ccls'Last);
        for Ccl_Index in Ccls'First .. Ccls'Last loop
            Proc_Array (Ccl_Index) := False;
        end loop;

        while (Cclp < Lenccl + Ccls'First) loop
            Cclm := Character'Pos (Ccls (Cclp));
            Oldec := Bck (Cclm);
            Newec := Cclm;

            J := Cclp + 1;

            I := Fwd (Cclm);
            while ((I /= Nil) and (I <= Llsiz)) loop

                -- look for the symbol in the character class
                while ((J < Lenccl + Ccls'First) and
                       ((Ccls (J) <= Character'Val (I)) or Proc_Array (J))) loop
                    if (Ccls (J) = Character'Val (I)) then

                        -- we found an old companion of cclm in the ccl.
                        -- link it into the new equivalence class and flag it as
                        -- having been processed
                        Bck (I) := Newec;
                        Fwd (Newec) := I;
                        Newec := I;
                        Proc_Array (J) := True;

                        -- set flag so we don't reprocess

                        -- get next equivalence class member
                        -- continue 2
                        goto Next_Pt;
                    end if;
                    J := J + 1;
                end loop;

                -- symbol isn't in character class.  Put it in the old equivalence
                -- class
                Bck (I) := Oldec;

                if (Oldec /= Nil) then
                    Fwd (Oldec) := I;
                end if;

                Oldec := I;
                <<Next_Pt>> I := Fwd (I);
            end loop;

            if ((Bck (Cclm) /= Nil) or (Oldec /= Bck (Cclm))) then
                Bck (Cclm) := Nil;
                Fwd (Oldec) := Nil;
            end if;

            Fwd (Newec) := Nil;

            -- find next ccl member to process
            Cclp := Cclp + 1;

            while ((Cclp < Lenccl + Ccls'First) and Proc_Array (Cclp)) loop

                -- reset "doesn't need processing" flag
                Proc_Array (Cclp) := False;
                Cclp := Cclp + 1;
            end loop;
        end loop;
    exception
        when Storage_Error =>
            Misc.Aflexfatal ("dynamic memory failure in mkeccl()");
    end Mkeccl;


    -- mkechar - create equivalence class for single character

    procedure Mkechar (Tch : in Integer; Fwd, Bck : in out C_Size_Array) is
    begin

        -- if until now the character has been a proper subset of
        -- an equivalence class, break it away to create a new ec
        if (Fwd (Tch) /= Nil) then
            Bck (Fwd (Tch)) := Bck (Tch);
        end if;

        if (Bck (Tch) /= Nil) then
            Fwd (Bck (Tch)) := Fwd (Tch);
        end if;

        Fwd (Tch) := Nil;
        Bck (Tch) := Nil;
    end Mkechar;

end Ecs;
-- 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 equivalence class
-- AUTHOR: John Self (UCI)
-- DESCRIPTION finds equivalence classes so DFA will be smaller
-- $Header: /co/ua/self/arcadia/aflex/ada/src/RCS/ecsS.a,v 1.4 90/01/12 15:19:57 self Exp Locker: self $