-- Module       : string_scanner_.ada
-- Component of : common_library
-- Version      : 1.2
-- Date         : 11/21/86  16:37:08
-- SCCS File    : disk21~/rschm/hasee/sccs/common_library/sccs/sxstring_scanner_.ada

with String_Pkg; use String_Pkg;

package String_Scanner is

--| Functions for scanning tokens from strings.
   pragma Page;
--| Overview
--| This package provides a set of functions used to scan tokens from
--| strings.  After the function make_Scanner is called to convert a string
--| into a string Scanner, the following functions may be called to scan
--| various tokens from the string:
--|-
--| Make_Scanner        Given a string returns a Scanner
--| Destroy_Scanner     Free storage used by Scanner
--| More                Return TRUE iff unscanned characters remain
--| Forward             Bump the Scanner
--| Backward            Bump back the Scanner
--| Get                 Return character
--| Next                Return character and bump the Scanner
--| Get_String          Return String_Type in Scanner
--| Get_Remainder       Return String_Type in Scanner from current Index
--| Mark                Mark the current Index for Restore
--| Restore             Restore the previously marked Index
--| Position            Return the current position of the Scanner
--| Is_Word             Return TRUE iff Scanner is at a non-blank character
--| Scan_Word           Return sequence of non blank characters
--| Is_Number           Return TRUE iff Scanner is at a digit
--| Scan_Number (2)     Return sequence of decimal digits
--| Is_Signed_Number    Return TRUE iff Scanner is at a digit or sign
--| Scan_Signed_Number (2)
--|                     sequence of decimal digits with optional sign (+/-)
--| Is_Space            Return TRUE iff Scanner is at a space or tab
--| Scan_Space          Return sequence of spaces or tabs
--| Skip_Space          Advance Scanner past white space
--| Is_Ada_Id           Return TRUE iff Scanner is at first character of ada id
--| Scan_Ada_Id         Scan an Ada identifier
--| Is_Quoted           Return TRUE iff Scanner is at a double quote
--| Scan_Quoted         Scan quoted string, embedded quotes doubled
--| Is_Enclosed         Return TRUE iff Scanner is at an enclosing character
--| Scan_Enclosed       Scan enclosed string, embedded enclosing character doubled
--| Is_Sequence         Return TRUE iff Scanner is at some character in sequence
--| Scan_Sequence       Scan user specified sequence of chars
--| Is_Not_Sequence     Return TRUE iff Scanner is not at the characters in sequence
--| Scan_Not_Sequence   Scan string up to but not including a given sequence of chars
--| Is_Literal          Return TRUE iff Scanner is at literal
--| Scan_Literal        Scan user specified literal
--| Is_Not_Literal      Return TRUE iff Scanner is not a given literal
--| Scan_Not_Literal    Scan string up to but not including a given literal
--|+

----------------------------------------------------------------

   Out_Of_Bounds : exception;      --| Raised when a operation is attempted on a
   --| Scanner that has passed the end
   Scanner_Already_Marked : exception;
   --| Raised when a Mark is attemped on a Scanner
   --| that has already been marked

----------------------------------------------------------------

   type Scanner is private;        --| Scanner type

----------------------------------------------------------------
   pragma Page;
   function Make_Scanner
     (          --| Construct a Scanner from S.
   S : in String_Type          --| String to be scanned.
   ) return Scanner;

--| Effects: Construct a Scanner from S.
--| N/A: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Destroy_Scanner
     (      --| Free Scanner storage
   T : in out Scanner          --| Scanner to be freed
   );

--| Effects: Free space occupied by the Scanner.
--| N/A: Raises, Modifies, Errors

----------------------------------------------------------------

   function More
     (                  --| Check if Scanner is exhausted
   T : in Scanner              --| Scanner to check
   ) return Boolean;

--| Effects: Return TRUE iff additional characters remain to be scanned.
--| N/A: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Forward
     (              --| Bump scanner
   T : in Scanner              --| Scanner
   );

--| Effects: Update the scanner position.
--| N/A: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Backward
     (             --| Bump back scanner
   T : in Scanner              --| Scanner
   );

--| Effects: Update the scanner position.
--| N/A: Raises, Modifies, Errors

----------------------------------------------------------------

   function Get
     (                   --| Return character
   T : in Scanner          --| Scanner to check
   ) return Character;

--| Raises: Out_Of_Bounds
--| Effects: Return character at the current Scanner position.
--| The scanner position remains unchanged.
--| N/A: Modifies, Errors

----------------------------------------------------------------

   procedure Next
     (                 --| Return character and bump scanner
   T    : in     Scanner;         --| Scanner to check
      C :    out Character        --| Character to be returned
   );

--| Raises: Out_Of_Bounds
--| Effects: Return character at the current Scanner position and update
--| the position.
--| N/A: Modifies, Errors

----------------------------------------------------------------

   function Position
     (              --| Return current Scanner position
   T : in Scanner              --| Scanner to check
   ) return Positive;

--| Raises: Out_Of_Bounds
--| Effects: Return a positive integer indicating the current Scanner position,
--| N/A: Modifies, Errors

----------------------------------------------------------------

   function Get_String
     (            --| Return contents of Scanner
   T : in Scanner              --| Scanner
   ) return String_Type;

--| Effects: Return a String_Type corresponding to the contents of the Scanner
--| N/A: Raises, Modifies, Errors

----------------------------------------------------------------

   function Get_Remainder
     (         --| Return contents of Scanner from index
   T : in Scanner) return String_Type;

--| Effects: Return a String_Type starting at the current index of the Scanner
--| N/A: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Mark (T : in Scanner);

--| Raises: Scanner_Already_Marked
--| Effects: Mark the current index for possible future use
--| N/A: Modifies, Errors

----------------------------------------------------------------

   procedure Restore (T : in Scanner);

--| Effects: Restore the index to the previously marked value
--| N/A: Raises, Modifies, Errors

----------------------------------------------------------------

   pragma Page;
   function Is_Word
     (               --| Check if Scanner is at the start of a word.
   T : in Scanner              --| Scanner to check
   ) return Boolean;

--| Effects: Return TRUE iff Scanner is at the start of a word.
--| N/A: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Word
     (            --| Scan sequence of non blank characters
   T         : in     Scanner;    --| String to be scanned
      Found  :    out Boolean;    --| TRUE iff a word found
      Result :    out String_Type;--| Word scanned from string
      Skip   : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan T for a sequence of non blank
--| characters.  If at least one is found, return Found => TRUE,
--| Result => <the characters>.
--| Otherwise return Found => FALSE and Result is unpredictable.

--| N/A: Raises, Modifies, Errors
   pragma Page;
   function Is_Number
     (             --| Return TRUE iff Scanner is at a decimal digit
   T : in Scanner              --| The string being scanned
   ) return Boolean;

--| Effects: Return TRUE iff Scan_Number would return a non-null string.
--| N/A: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Number
     (          --| Scan sequence of digits
   T         : in     Scanner;    --| String to be scanned
      Found  :    out Boolean;    --| TRUE iff one or more digits found
      Result :    out String_Type;--| Number scanned from string
      Skip   : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan T for a sequence of digits.
--| If at least one is found, return Found => TRUE, Result => <the digits>.
--| Otherwise return Found => FALSE and Result is unpredictable.

--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Number
     (          --| Scan sequence of digits
   T         : in     Scanner;    --| String to be scanned
      Found  :    out Boolean;    --| TRUE iff one or more digits found
      Result :    out Integer;    --| Number scanned from string
      Skip   : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan T for a sequence of digits.
--| If at least one is found, return Found => TRUE, Result => <the digits>.
--| Otherwise return Found => FALSE and Result is unpredictable.

--| Modifies: Raises, Modifies, Errors
   pragma Page;
   function Is_Signed_Number
     (      --| Check if Scanner is at a decimal digit or
   --| sign (+/-)
   T : in Scanner              --| The string being scanned
   ) return Boolean;

--| Effects: Return TRUE iff Scan_Signed_Number would return a non-null
--| string.

--| N/A: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Signed_Number
     (   --| Scan signed sequence of digits
   T         : in     Scanner;    --| String to be scanned
      Found  :    out Boolean;    --| TRUE iff one or more digits found
      Result :    out String_Type;--| Number scanned from string
      Skip   : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan T for a sequence of digits preceeded with optional sign.
--| If at least one digit is found, return Found => TRUE,
--| Result => <the digits>.
--| Otherwise return Found => FALSE and Result is unpredictable.

--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Signed_Number
     (   --| Scan signed sequence of digits
   T         : in     Scanner;    --| String to be scanned
      Found  :    out Boolean;    --| TRUE iff one or more digits found
      Result :    out Integer;    --| Number scanned from string
      Skip   : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan T for a sequence of digits preceeded with optional sign.
--| If at least one digit is found, return Found => TRUE,
--| Result => <the digits>.
--| Otherwise return Found => FALSE and Result is unpredictable.

--| Modifies: Raises, Modifies, Errors
   pragma Page;
   function Is_Space
     (              --| Check if T is at a space or tab
   T : in Scanner              --| The string being scanned
   ) return Boolean;

--| Effects: Return TRUE iff Scan_Space would return a non-null string.
--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Space
     (           --| Scan sequence of white space characters
   T         : in     Scanner;    --| String to be scanned
      Found  :    out Boolean;    --| TRUE iff space found
      Result :    out String_Type --| Spaces scanned from string
   );

--| Effects: Scan T past all white space (spaces
--| and tabs.  If at least one is found, return Found => TRUE,
--| Result => <the characters>.
--| Otherwise return Found => FALSE and Result is unpredictable.

--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Skip_Space
     (           --| Skip white space
   T : in Scanner              --| String to be scanned
   );

--| Effects: Scan T past all white space (spaces and tabs).
--| Modifies: Raises, Modifies, Errors
   pragma Page;
   function Is_Ada_Id
     (             --| Check if T is at an Ada identifier
   T : in Scanner              --| The string being scanned
   ) return Boolean;

--| Effects: Return TRUE iff Scan_Ada_Id would return a non-null string.
--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Ada_Id
     (          --| Scan Ada identifier
   T         : in     Scanner;    --| String to be scanned
      Found  :    out Boolean;    --| TRUE iff an Ada identifier found
      Result :    out String_Type;--| Identifier scanned from string
      Skip   : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan T for a valid Ada identifier.
--| If one is found, return Found => TRUE, Result => <the characters>.
--| Otherwise return Found => FALSE and Result is unpredictable.

--| Modifies: Raises, Modifies, Errors
   pragma Page;
   function Is_Quoted
     (             --| Check if T is at a double quote
   T : in Scanner              --| The string being scanned
   ) return Boolean;

--| Effects: Return TRUE iff T is at a quoted string (eg. ... "Hello" ...).
--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Quoted
     (          --| Scan a quoted string
   T         : in     Scanner;    --| String to be scanned
      Found  :    out Boolean;    --| TRUE iff a quoted string found
      Result :    out String_Type;--| Quoted string scanned from string
      Skip   : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan at T for an opening quote
--| followed by a sequence of characters and ending with a closing
--| quote.  If successful, return Found => TRUE, Result => <the characters>.
--| Otherwise return Found => FALSE and Result is unpredictable.
--| A pair of quotes within the quoted string is converted to a single quote.
--| The outer quotes are stripped.

--| Modifies: Raises, Modifies, Errors
   pragma Page;
   function Is_Enclosed
     (           --| Check if T is at an enclosing character
   B    : in Character;           --| Enclosing open character
      E : in Character;           --| Enclosing close character
      T : in Scanner              --| The string being scanned
   ) return Boolean;

--| Effects: Return TRUE iff T as encosed by B and E (eg. ... [ABC] ...).
--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Enclosed
     (        --| Scan an enclosed string
   B         : in     Character;      --| Enclosing open character
      E      : in     Character;      --| Enclosing close character
      T      : in     Scanner;    --| String to be scanned
      Found  :    out Boolean;    --| TRUE iff a quoted string found
      Result :    out String_Type;--| Quoted string scanned from string
      Skip   : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan at T for an enclosing character
--| followed by a sequence of characters and ending with an enclosing character.
--| If successful, return Found => TRUE, Result => <the characters>.
--| Otherwise return Found => FALSE and Result is unpredictable.
--| The enclosing characters are stripped.

--| Modifies: Raises, Modifies, Errors
   pragma Page;
   function Is_Sequence
     (           --| Check if T is at some sequence characters
   Chars : in String_Type;     --| Characters to be scanned
      T  : in Scanner          --| The string being scanned
   ) return Boolean;

--| Effects: Return TRUE iff T is at some character of Chars.
--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   function Is_Sequence
     (           --| Check if T is at some sequence characters
   Chars : in String;          --| Characters to be scanned
      T  : in Scanner          --| The string being scanned
   ) return Boolean;

--| Effects: Return TRUE iff T is at some character of Chars.
--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Sequence
     (        --| Scan arbitrary sequence of characters
   Chars     : in     String_Type;--| Characters that should be scanned
      T      : in     Scanner;    --| String to be scanned
      Found  :    out Boolean;    --| TRUE iff a sequence found
      Result :    out String_Type;--| Sequence scanned from string
      Skip   : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan T for a sequence of characters C such that C appears in
--| Char.  If at least one is found, return Found => TRUE,
--| Result => <the characters>.
--| Otherwise return Found => FALSE and Result is unpredictable.

--| Modifies: Raises, Modifies, Errors

--| Notes:
--| Scan_Sequence("0123456789", S, Index, Found, Result)
--| is equivalent to Scan_Number(S, Index, Found, Result)
--| but is less efficient.

----------------------------------------------------------------

   procedure Scan_Sequence
     (        --| Scan arbitrary sequence of characters
   Chars     : in     String;     --| Characters that should be scanned
      T      : in     Scanner;    --| String to be scanned
      Found  :    out Boolean;    --| TRUE iff a sequence found
      Result :    out String_Type;--| Sequence scanned from string
      Skip   : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan T for a sequence of characters C such that C appears in
--| Char.  If at least one is found, return Found => TRUE,
--| Result => <the characters>.
--| Otherwise return Found => FALSE and Result is unpredictable.

--| Modifies: Raises, Modifies, Errors

--| Notes:
--| Scan_Sequence("0123456789", S, Index, Found, Result)
--| is equivalent to Scan_Number(S, Index, Found, Result)
--| but is less efficient.
   pragma Page;
   function Is_Not_Sequence
     (       --| Check if T is not at some seuqnce of character
   Chars : in String_Type;     --| Characters to be scanned
      T  : in Scanner          --| The string being scanned
   ) return Boolean;

--| Effects: Return TRUE iff T is not at some character of Chars.
--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   function Is_Not_Sequence
     (       --| Check if T is at some sequence of characters
   Chars : in String;          --| Characters to be scanned
      T  : in Scanner          --| The string being scanned
   ) return Boolean;

--| Effects: Return TRUE iff T is not at some character of Chars.
--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Not_Sequence
     (    --| Scan arbitrary sequence of characters
   Chars     : in     String_Type;--| Characters that should be scanned
      T      : in     Scanner;    --| String to be scanned
      Found  :    out Boolean;    --| TRUE iff a sequence found
      Result :    out String_Type;--| Sequence scanned from string
      Skip   : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan T for a sequence of characters C such that C does not appear
--| in Chars.  If at least one such C is found, return Found => TRUE,
--| Result => <the characters>.
--| Otherwise return Found => FALSE and Result is unpredictable.

--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Not_Sequence
     (    --| Scan arbitrary sequence of characters
   Chars     : in     String;     --| Characters that should be scanned
      T      : in     Scanner;    --| String to be scanned
      Found  :    out Boolean;    --| TRUE iff a sequence found
      Result :    out String_Type;--| Sequence scanned from string
      Skip   : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan T for a sequence of characters C such that C does not appear
--| in Chars.  If at least one such C is found, return Found => TRUE,
--| Result => <the characters>.
--| Otherwise return Found => FALSE and Result is unpredictable.

--| Modifies: Raises, Modifies, Errors
   pragma Page;
   function Is_Literal
     (            --| Check if T is at literal Chars
   Chars : in String_Type;     --| Characters to be scanned
      T  : in Scanner          --| The string being scanned
   ) return Boolean;

--| Effects: Return TRUE iff T is at literal Chars.
--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   function Is_Literal
     (            --| Check if T is at literal Chars
   Chars : in String;          --| Characters to be scanned
      T  : in Scanner          --| The string being scanned
   ) return Boolean;

--| Effects: Return TRUE iff T is at literal Chars.
--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Literal
     (         --| Scan arbitrary literal
   Chars    : in     String_Type;--| Literal that should be scanned
      T     : in     Scanner;    --| String to be scanned
      Found :    out Boolean;    --| TRUE iff a sequence found
      Skip  : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan T for a litral Chars such that Char matches the sequence
--| of characters in T.  If found, return Found => TRUE,
--| Otherwise return Found => FALSE

--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Literal
     (         --| Scan arbitrary literal
   Chars    : in     String;     --| Literal that should be scanned
      T     : in     Scanner;    --| String to be scanned
      Found :    out Boolean;    --| TRUE iff a sequence found
      Skip  : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan T for a litral Chars such that Char matches the sequence
--| of characters in T.  If found, return Found => TRUE,
--| Otherwise return Found => FALSE

--| Modifies: Raises, Modifies, Errors
   pragma Page;
   function Is_Not_Literal
     (        --| Check if T is not at literal Chars
   Chars : in String;          --| Characters to be scanned
      T  : in Scanner          --| The string being scanned
   ) return Boolean;

--| Effects: Return TRUE iff T is not at literal Chars
--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   function Is_Not_Literal
     (        --| Check if T is not at literal Chars
   Chars : in String_Type;     --| Characters to be scanned
      T  : in Scanner          --| The string being scanned
   ) return Boolean;

--| Effects: Return TRUE iff T is not at literal Chars
--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Not_Literal
     (     --| Scan arbitrary literal
   Chars     : in     String;     --| Literal that should be scanned
      T      : in     Scanner;    --| String to be scanned
      Found  :    out Boolean;    --| TRUE iff a sequence found
      Result :    out String_Type;--| String up to literal
      Skip   : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan T for a litral Chars such that Char does not match the
--| sequence of characters in T.  If found, return Found => TRUE,
--| Otherwise return Found => FALSE

--| Modifies: Raises, Modifies, Errors

----------------------------------------------------------------

   procedure Scan_Not_Literal
     (     --| Scan arbitrary literal
   Chars     : in     String_Type;--| Literal that should be scanned
      T      : in     Scanner;    --| String to be scanned
      Found  :    out Boolean;    --| TRUE iff a sequence found
      Result :    out String_Type;--| String up to literal
      Skip   : in     Boolean := False
      --| Skip white spaces before scan
      );

--| Effects: Scan T for a litral Chars such that Char does not match the
--| sequence of characters in T.  If found, return Found => TRUE,
--| Otherwise return Found => FALSE

--| Modifies: Raises, Modifies, Errors
   pragma Page;
private
   pragma List (Off);
   type Scan_Record is record
      Text  : String_Type;        --| Copy of string being scanned
      Index : Positive := 1;      --| Current position of Scanner
      Mark  : Natural  := 0;       --| Mark
   end record;

   type Scanner is access Scan_Record;
   pragma List (On);
end String_Scanner;
pragma Page;
