DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦94931fe53⟧ Ada Source

    Length: 25600 (0x6400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package Parameter_Parser, pragma Module_Name 4 3528, pragma Segmented_Heap Iterator, pragma Subsystem Directory, seg_02850b

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

E3 Source Code



with Directory;

-- All options appear in Adaesque aggregate notation, with appropriate
-- relaxations of the rules.  Switch values and switch names, where the set
-- of choices is static (i.e. fixed set of switches, but not for User
-- names), should recognize unique prefix.  A package is available for
-- parsing parameter lists that adhere to this convention.

-- Options are formed from the following lexical components:
--
--    Punctuation ::=  '=>' | '=' | ':=' | '|' | '..'
--                ::=  Separator
--
--    Separator   ::=  ',' | ';'
--
--    Value       ::=  Directory-String-Name
--                ::=  Integer-Literal
--                ::=  Float-Literal
--                ::=  Literal
--                ::=  '<>'            --  The default value defined for an
--                                     --  option.
--                ::=  Other-Value     --  Any sequence of contiguous char-
--                                     --  acters not including separators;
--                                     --  leading and trailing blanks are
--                                     --  removed.
--                ::=  '(' Balanced ') --  Any sequence of contiguous char-
--                                     --  acters, balanced with respect to
--                                     --  parentheses, nested within
--                                     --  parentheses. The outer-most
--                                     --  enclosing parentheses are not part
--                                     --  of the value, but all contained
--                                     --  characters, including blanks, are.
--
--    Name        ::=  Simple-Ada-Name
--                ::=  Other-Name      --  Any sequence of contiguous char-
--                                     --  acters not including punctuation
--                                     --  or blanks
--
--    Literal     ::=  Simple-Ada-Name

--    Any two-character sequence begining with \ is interpreted as a single,
--    non-special occurence of the second character.  Thus, "\," is NOT a
--    separator character, but a benign ocurrence of ','.
--
--    Blanks are allowed around the special characters:
--
--    Since Blanks are not allowed in a Name, a blank following a Name may be
--    used as a separator.
--
-- The syntax is (enclosing quotes not included):
--
--    Options     ::=  [Option {Separator Option}]
--
--    Option      ::=  Range {'|' Range} [('=>' | ':=' | '=') Value]
--                ::=  ['~'] Range {'|' Range}
--                ::=  Literal
--                ::=  '_' File-Name
--
--    Range       ::=  Name ['..' Name]
--                ::=  'others'        --  Denotes names not otherwise
--                                     --  specified.
--
--
-- General semantics:

-- A Name denotes an option. A Range denotes the options in a predefined
-- sequence of options from the option denoted by the first name to and
-- including the option denoted by the last name of the range.  The
-- specified Value is associated with each option denoted by the Names and
-- Ranges of the Option.

-- If a Value clause is omitted, the options denoted by the Names and
-- Ranges of the Option must be Boolean-valued.  If '~' preceeds
-- the Names of an Option, the options assume the value False, otherwise they
-- assume the value True.

-- A Literal denotes a value of a specific option.  When it appears as an
-- Option, it denotes both the Name and the Value of that option.

-- If a name appears more than once, the value associated with the leftmost
-- instance of the name is the one used.

-- Examples:

-- Access_List.Set ("Public=>RW");
-- Profile.Set  ("+++,---,++*,!!!,l=>80");
-- Profile.Set ("Persevere, +++ | --- | ++* | !!! => true,w => 80");
-- Source_Archive.Restore (..., Form => "New_Units, Acl => (Public=>RW)");
-- Switches.set ("Semantics.Ignore_Minor_Errors := True");


generic
    type Option_Id is (<>);

    -- This discrete type defines the ordering of option names used to
    -- define ranges.  Its values are used in the programmatic interface to
    -- identify options.  For a static collection of options, such as in
    -- Profile, Option_Id would probably be an enumerated type; its
    -- enumeration ids would define the names of the options.  For
    -- non-static options, such as access lists, Option_Id would be an
    -- integer type and most names would be defined using the define
    -- procedure exported by the generic.

    Nil   : in Option_Id := Option_Id'First;
    First : in Option_Id := Option_Id'Succ (Nil);
    Last  : in Option_Id := Option_Id'Last;

    -- Nil is an Option_Id that represents no option name.  Only option_id's
    -- in the range First .. Last are definable; Nil should not be in that
    -- range;

    Option_Kinds : in String := "others => Unspecified";

    -- Specification of the kind of each option.  The string must satisfy
    -- the syntax for a forms parameter in which Names are taken from the
    -- set of Option_Id images and Values are the enumeration ids of the
    -- type Option_Kind, defined below.  (The Option_Kind 'Literal' may not
    -- be specified in this string; use the Define function.) The default
    -- kind for all options is 'Unspecified'. Options that are not
    -- Boolean-Valued must be followed by a Value clause when they are used
    -- in a parameter string. If the Kind of an option is other than
    -- 'Unspecified', the parser will verify that the associated value is of
    -- the proper form for the specified Kind.

    Default_Values : in String := "";

    -- Default values for the options.  The string must satisfy the syntax
    -- for a forms parameter in which Names are taken from the set of
    -- Option_Id images.  Not all Option_Ids need to have Default_Values.
    -- Default values are substituted for the special symbol '<>' when it
    -- appears in a Value clause.  If no default value has been specified
    -- for an option and the option appears with a '<>' value, the reference
    -- to the option is deleted by the option parser.

    Alternate_Names : in String := "";

    -- Alternate names for the options.  The string must satisfy the syntax
    -- for a forms parameter in which Names are taken from the set of
    -- Option_Id images, and the Values obey the syntax for Other_Names.
    -- Not all Option_Ids need to have Alternate_Names.  The standard name
    -- for an option is the Image of the Option_Id.  The Undefine function
    -- may be used to remove the standard name from the set of permitted
    -- names. All names for the same option_id value have the same kind and
    -- default value.

    From : Option_Id := First;
    To   : Option_Id := Last;

    -- From and To define the range of Option_Id's that make up the
    -- initial set of defined options.  This set can be expanded or
    -- reduced using the Define and Undefine procedures defined in the
    -- package.

package Parameter_Parser is
    pragma Subsystem (Directory);
    pragma Module_Name (4, 3528);

    type Option_Kind is (Unspecified, Directory_String_Name, Boolean_Valued,
                         Integer_Valued, Float_Valued, Literal);

    procedure Define (Option            : Option_Id;
                      Name              : String      := "";
                      Kind              : Option_Kind := Unspecified;
                      Default_Value     : String      := "";
                      Allow_Name_Prefix : Boolean     := False);

    -- Defines a new Name to be associated with the given Option_Id.  The
    -- default Name is the Option_Id'image of the Option.  Any number of
    -- names may be associated with an Option_Id value.  The parameter
    -- specification may use any of these names to set the option.

    -- Allow_Name_Prefix allows a unique prefix of the Name to be used in
    -- place of the Name in a parameter specification.

    -- The Default_Value string is parsed as if it were a Value
    -- specification; a balanced string or '\' must be used to protect
    -- separators in the default value.  If Default_Value is the null
    -- string, no default value is assigned to the option.  If you want the
    -- default value to be a null string, use "()".

    -- If Kind is 'Literal', Name must be non-null.  The given Name must
    -- never appear with a Value clause. When it appears by itself, without
    -- a Value clause, the implied value is the Name itself.  (The generic
    -- package Enumerated_Value, defined below, provides a convenient way to
    -- define all enumeration ids of an option as literals.)

    procedure Undefine (Name : String);

    -- Removes the Name (and its prefixes) as a possible option name.

    procedure Undefine (From : Option_Id; To : Option_Id := Nil);

    -- Removes all names and prefixes that denote an Option_Id in the given
    -- range as possible option names.

    procedure Allow_Name_Prefix (Name : String; Value : Boolean := True);

    procedure Allow_Name_Prefix (Value : Boolean   := True;
                                 From  : Option_Id := Nil;
                                 To    : Option_Id := Nil);

    -- The Allow_Name_Prefix flag for a name, when set, allows a unique
    -- prefix of the name to be used in place of the name in a parameter
    -- specification.  The default setting of this flag for the initial set
    -- of Option_Ids is true.

    -- The first procedure sets the Allow_Name_Prefix flag for the named
    -- option.

    -- The second procedure sets the Allow_Name_Prefix flag for all defined
    -- Names that map to an Option_Id in the specified range.  The range
    -- implied by the default values is the full set of Option_Id's defined
    -- at the time of call.  If From is non-Nil and To is Nil, the single
    -- Option_Id From is implied.  If From and To are both non-Nil, all
    -- Option_Id's in the range From .. To are implied.

    type Iterator is private;

    procedure Parse (Parameter :     String;
                     Options   : out Iterator;
                     Success   : out Boolean);

    function Parse (Parameter : String) return Iterator;

    function Is_Successful (Iter : Iterator) return Boolean;

    -- Success is True, iff all options were parsed correctly.  When no
    -- options parsed correctly, a Done iterator is returned, which may be
    -- passed to the Diagnosis function to obtain more information.  If
    -- some, but not all, options were parsed correctly the returned
    -- iterator will be non-null.  Iterations (positions in the iterator)
    -- are allocated for erroneous specifications as well as for correctly
    -- parsed specifications.  The Is_Ok() predicate distinguishes between
    -- them.

    -- The iterator returned by Parse represents an expanded, unfactored
    -- specification, equivalent to the input specification; each iteration
    -- represents a simple specification of the form, "Name [=> Value]." All
    -- Names are returned with their full spelling.  Ranges and the reserved
    -- name 'others' are expanded so that there is one iteration for each
    -- option_id covered by the Range or 'others.' Duplicate specifications
    -- have been removed, leaving the last specification at its point of
    -- occurrence.  Except for the deleted duplications all specifications
    -- of the input string are present in the iterator in the same order as
    -- in the input string.


    -- In the following subprograms, the optional Name parameter is used
    -- to interrogate the iterator as a set.  The default value, Nil,
    -- addresses the current iteration of the iterator.

    function Is_Ok (Iter : Iterator; Name : Option_Id := Nil) return Boolean;

    -- Indicates whether the designated option was syntactically correct in
    -- the specification; If the named option was not specified, Is_Ok()
    -- returns False;

    function Is_Present (Iter : Iterator; Name : Option_Id) return Boolean;

    -- Indicates whether the indicated option was present in the option
    -- parameter string.  An option is present if its name was
    -- parsable.  It may otherwise be in error.

    function Diagnosis (Iter : Iterator; Name : Option_Id := Nil) return String;

    -- Returns text for a message that describes what was wrong with the
    -- option specification, if anything.  If the named option was not
    -- specified, Diagnosis returns a message to this effect.  If an
    -- option Is_Ok(), Diagnosis returns the null string.

    function  Done  (Iter : Iterator) return Boolean;
    procedure Next  (Iter : in out Iterator);
    procedure Reset (Iter : in out Iterator);
   -- Advances the iterator to the next iteration.

    function Name (Iter : Iterator) return Option_Id;

    -- Returns Nil if the iteration corresponds to an unparsable
    -- specification.

    function Name (Iter : Iterator; Name : Option_Id := Nil) return String;

    -- Returns the name that was used in the specification to denote the
    -- indicated Option_Id.  The full name is returned even if a prefix was
    -- used.

    function Has_Value
                (Iter : Iterator; Name : Option_Id := Nil) return Boolean;

    -- Indicates whether the Value clause for the indicated option was
    -- specified or not.

    function Get_Image (Iter    : Iterator;
                        Name    : Option_Id := Nil;
                        Default : String    := "") return String;

    -- Get_Image returns the uninterpreted image of the Value associated
    -- with the indicated option.  If Is_OK() or Has_Value() is false,
    -- the null string is returned. If Is_Present() is false, the
    -- default value associated with the named option is returned.

    -- In the returned value, the two-character sequences begining with \
    -- have been reduced to a single character.

    -- The Get_xxx functions defined below use Get_Image to obtain a
    -- string to interpret.  Thus they operate on the default value
    -- when the option has not been named.

    function Kind (Iter : Iterator; Name : Option_Id := Nil) return Option_Kind;

    -- The value of Get_Image() on the specified option is inspected to
    -- determine its type. Kind returns Unspecified if the kind cannot be
    -- determined.

    function Get_Object (Iter    : Iterator;
                         Name    : Option_Id        := Nil;
                         Default : Directory.Object := Directory.Nil)
                        return Directory.Object;

    -- The value of Get_Image() is evaluated by Directory.Naming.-
    -- Resolve. Directory.Nil is returned if it cannot return a
    -- Directory.Object value.  The results of the attempt to resolve
    -- the directory name will also be reflected in Is_Ok() and
    -- Diagnosis() after the call to Get_Object.

    function Get_Objects (Iter         : Iterator;
                          Name         : Option_Id := Nil;
                          Deleted_Ok   : Boolean   := False;
                          Objects_Only : Boolean   := False)
                         return Directory.Naming.Iterator;

    -- The value of Get_Image() is evaluated by Directory.Naming.-
    -- Resolve. A Done iterator is returned if it cannot be resolved.
    -- The results of the attempt to resolve the directory name will
    -- also be reflected in Is_Ok() and Diagnosis() after the call to
    -- Get_Objects.

    function Get_Boolean (Iter    : Iterator;
                          Name    : Option_Id := Nil;
                          Default : Boolean   := False) return Boolean;

    -- If Get_Image() is non-null, Get_boolean tries to interpret it as
    -- a Boolean_Literal and returns the denoted value. If the it is not
    -- a Boolean_Literal, False is returned, and Is_Ok() and Diagnosis()
    -- will indicate an error and the nature of the error. A
    -- Boolean_Literal may be any prefix of True or False.

    -- If Get_Image() is null, Get_Boolean returns false if the name
    -- appeared with a '~' and it returns true otherwise.

    function Get_Integer (Iter    : Iterator;
                          Name    : Option_Id := Nil;
                          Default : Integer   := Integer'Last) return Integer;

    -- Get_Integer tries to parse the Get_Image() value as an
    -- integer and returns the denoted value.  If Integer'Value fails,
    -- Integer'last is returned and Is_OK() and Diagnosis() will
    -- identify the error.

    function Get_Float (Iter    : Iterator;
                        Name    : Option_Id := Nil;
                        Default : Float     := Float'Safe_Large) return Float;

    -- Get_Float tries to parse the Get_Image() value as a float
    -- literal and returns the denoted value.  If it cannot parse the
    -- value as a float value, Float'large is returned and Is_OK() and
    -- Diagnosis() will identify the error.

    generic
        type T is (<>);
        Nil               : in T         := T'First;
        Id                :    Option_Id := Parameter_Parser.Nil;
        Allow_Name_Prefix :    Boolean   := True;
    package Enumerated_Value is
        function Get_Enumeration (Iter : Iterator;
                                  Name : Option_Id := Parameter_Parser.Nil;
                                  Allow_Value_Prefix : Boolean := True;
                                  Default : T := Nil) return T;
    end Enumerated_Value;

    -- Get_Enumeration tries to interpret the Get_Image() value as the
    -- unique prefix of an image of a component of T.  It returns Nil and
    -- preps Is_Ok() and Diagnosis() if no such interpretation is possible.
    -- If Allow_Value_Prefix is false, only full spellings of values of type
    -- T are recognized.

    -- If the Id formal parameter is not Nil, the values of type T will be
    -- defined as legal option names.  If one of these values is found in an
    -- option list in the place of a name, it will be treated as a value of
    -- the option denoted by Id (i.e., "Id =>" is implicitly inserted before
    -- the value).   If Allow_Name_prefix is True, unique prefixes of the
    -- values of T will be recognized.

    generic
        type T is private;
        Nil : in T;
        with function Value     (S : String) return T is <>;
        with function Diagnosis (S : String) return String;
    function Get_Value (Iter    : Iterator;
                        Name    : Option_Id := Parameter_Parser.Nil;
                        Default : T         := Nil) return T;

    -- Get_Value applies the formal Value function to the Get_Image()
    -- value.  Value should return Nil if the passed value is
    -- unacceptable.  If Nil is returned, the next call to Diagnosis
    -- will return the value returned by Get_Value.Diagnosis.

private
    type Iterator_Data;
    type Iterator is access Iterator_Data;
    pragma Segmented_Heap (Iterator);
end Parameter_Parser;

E3 Meta Data

    nblk1=18
    nid=0
    hdr6=30
        [0x00] rec0=18 rec1=00 rec2=01 rec3=078
        [0x01] rec0=12 rec1=00 rec2=02 rec3=030
        [0x02] rec0=1a rec1=00 rec2=03 rec3=062
        [0x03] rec0=16 rec1=00 rec2=04 rec3=05c
        [0x04] rec0=19 rec1=00 rec2=05 rec3=018
        [0x05] rec0=00 rec1=00 rec2=18 rec3=006
        [0x06] rec0=10 rec1=00 rec2=06 rec3=044
        [0x07] rec0=14 rec1=00 rec2=07 rec3=028
        [0x08] rec0=00 rec1=00 rec2=17 rec3=004
        [0x09] rec0=16 rec1=00 rec2=08 rec3=004
        [0x0a] rec0=13 rec1=00 rec2=09 rec3=054
        [0x0b] rec0=16 rec1=00 rec2=0a rec3=016
        [0x0c] rec0=14 rec1=00 rec2=0b rec3=072
        [0x0d] rec0=13 rec1=00 rec2=0c rec3=050
        [0x0e] rec0=16 rec1=00 rec2=0d rec3=000
        [0x0f] rec0=01 rec1=00 rec2=16 rec3=002
        [0x10] rec0=19 rec1=00 rec2=0e rec3=03a
        [0x11] rec0=16 rec1=00 rec2=0f rec3=030
        [0x12] rec0=13 rec1=00 rec2=10 rec3=084
        [0x13] rec0=15 rec1=00 rec2=11 rec3=066
        [0x14] rec0=15 rec1=00 rec2=12 rec3=060
        [0x15] rec0=01 rec1=00 rec2=15 rec3=022
        [0x16] rec0=14 rec1=00 rec2=13 rec3=050
        [0x17] rec0=0a rec1=00 rec2=14 rec3=000
    tail 0x21520fd6483c174d16524 0x42a00088462065003