File: asis_ul-misc.ads

package info (click to toggle)
asis 2008-5
  • links: PTS
  • area: main
  • in suites: squeeze
  • size: 9,724 kB
  • ctags: 615
  • sloc: ada: 95,867; makefile: 259; xml: 19
file content (185 lines) | stat: -rw-r--r-- 8,415 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
------------------------------------------------------------------------------
--                                                                          --
--                     ASIS UTILITY LIBRARY COMPONENTS                      --
--                                                                          --
--                         A S I S _ U L . M I S C                          --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--                    Copyright (C) 2006-2008, AdaCore                      --
--                                                                          --
-- Asis Utility Library (ASIS UL) is free software; you can redistribute it --
-- and/or  modify  it  under  terms  of  the  GNU General Public License as --
-- published by the Free Software Foundation; either version 2, or (at your --
-- option)  any later version.  ASIS UL  is distributed in the hope that it --
-- will  be  useful,  but  WITHOUT  ANY  WARRANTY; without even the implied --
-- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --
-- GNU  General Public License for more details. You should have received a --
-- copy of the  GNU General Public License  distributed with GNAT; see file --
-- COPYING.  If  not,  write  to  the Free Software Foundation, 51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
-- ASIS UL is maintained by AdaCore (http://www.adacore.com).               --
--                                                                          --
------------------------------------------------------------------------------

--  This package contains various useful resources for which we can not find
--  at the moment a specific ASIS Utility Library package to place into

with Ada.Unchecked_Deallocation;

package ASIS_UL.Misc is

   -----------------------
   -- String Hash table --
   -----------------------

   --  This is a slight modification from the Hash function from the GNAT Namet
   --  package. The way of computing the hash values is exactly the same as
   --  used in Namet.Hash, but we have changed the interface. There are three
   --  modifications. First, the original GNAT Hash finction does not have a
   --  formal parameter and operates on an internal string buffer, but here we
   --  have added a parameter. Second - our hash function is not
   --  case-sensitive. And third, we use a wrapper generic package to give the
   --  clients the possibility to use hash tables for different string entry
   --  IDs types

   generic
      type Entry_Id is (<>);
   package String_Hash_Table is

      type Int is range -2 ** 31 .. +2 ** 31 - 1;

      Hash_Num : constant Int := 2**12;
      --  Number of headers in the hash table. Current hash algorithm is
      --  closely tailored to this choice, so it can only be changed if a
      --  corresponding change is made to the hash algorithm.

      Hash_Max : constant Int := Hash_Num - 1;
      --  Indexes in the hash header table run from 0 to Hash_Num - 1

      subtype Hash_Index_Type is Int range 0 .. Hash_Max;
      --  Range of hash index values

      Hash_Table : array (Hash_Index_Type) of Entry_Id;
      --  The hash table is used to locate existing entries in the strings
      --  table. The entries point to the first strings table entry whose hash
      --  value matches the hash code. Then subsequent string table entries
      --  with the same hash code value should be linked, and this link chould
      --  be used for locating the needed entry

      function Hash (Name : String) return Hash_Index_Type;
      --  Compute hash code for its argument

   end String_Hash_Table;

   ------------------------------
   -- Simple String dictionary --
   ------------------------------

   generic
      Dictionary_Name : String;
   package Simple_String_Dictionary is
      --  This package defines a simple string dictionary. The dictionary
      --  entries are various strings, each string can be included in the
      --  dictionary only once. The dictionary is not case-sensitive. The
      --  initial state of the dictionart is empty

      procedure Add_To_Dictionary (S : String);
      --  If the dictionary does not contain S, adds S to the dictionary,
      --  Otherwise does nothing.

      procedure Remove_From_Dictionary (S : String);
      --  If the dictionary does not contain S, removes S from the dictionary,
      --  Otherwise does nothing.

      function Is_In_Dictionary (S : String) return Boolean;
      --  Checks if S is in the dictionary

      function Is_Empty return Boolean;
      --  Returns True if the dictionary contains no entries, otherwise returns
      --  False

      procedure Clear;
      --  Removes all the entries from the disctionary

      procedure Reset_Iterator;
      function Next_Entry return String;
      function Done return Boolean;
      --  These three routines implement iterator that allows to get all the
      --  dictionary entries. If a clien adds or removes entries to/from a
      --  dictionary while using the iterator, the iterator behavior is
      --  erroneous.

      procedure Print_Dictionary;
      --  Prints into Stderr the content of the dictionary. Each entry is
      --  printed on a new line and is surrounded by ">>" and "<<". (To be
      --  used for debugging purposes).

   end Simple_String_Dictionary;

   -------------------
   -- Miscellaneous --
   -------------------

   function Is_White_Space (Ch : Character) return Boolean;
   --  Checks if the argumet is either a space or HT character

   function Image (I : Integer) return String;
   --  Returns the string image of I, with no leading or trailing spaces

   function Is_Identifier (S : Wide_String) return Boolean;
   --  Checks if S has a syntax of an Ada identifier

   function Is_Ada_Name (S : Wide_String) return Boolean;
   --  Checks if S has a syntax of an Ada (expanded) name consisting on
   --  identifiers only (and dots) with no white spaces inside. The caller is
   --  responsible for cutting off all the leading and trailing white spaces
   --  from the parameter.

   function Is_Identifier_Suffix (Suffix : Wide_String) return Boolean;
   --  Checks if the Suffix string can be a suffix af a valid Ada identifier.

   --------------------------------------
   --  ASIS string processing routines --
   --------------------------------------

   --  Below there are the modified versions of the standard character and
   --  string processing routines.

   function ASIS_Trim (Source : String) return String;
   --  Similar to Ada.Strings.Fixed.Trim, but cuts out all the Is_White_Space
   --  characters (that is, both spaces and HTs)

   type Direction  is (Forward, Backward);
   --  ??? Or should we reuse Ada.Strings.Direction

   function ASIS_Index_Non_Blank
     (Source : String;
      Going  : Direction := Forward)
      return Natural;
   --  Similar to Ada.Strings.Fixed.Trim, but cuts out all the Is_White_Space
   --  characters (that is, both spaces and HTs)

   function Proper_Case (S : String) return String;
   --  Converts the casing of the argument into proper case: a first character
   --  and each Is_Letter character that follows the underscore are converted
   --  to uppre case, all the other Is_Letter characters are converted to
   --  lower case

   type Wide_String_Access is access all Wide_String;
   --  General purpose wide string access type. Note that the caller is
   --  responsible for freeing allocated strings to avoid memory leaks.
   --  We often need this type, but not just GNAT.OS_Lib.String_Access t0
   --  represent pieces of the source code returned by ASIS queries

   procedure Free is new Ada.Unchecked_Deallocation
     (Object => Wide_String, Name => Wide_String_Access);
   --  This procedure is provided for freeing allocated values of type
   --  Wide_String_Access.

   function To_Upper_Case (S : Wide_String) return Wide_String;
   --  Folds the argument to upper case, may be used for string normalization
   --  before compering strings if the casing is not important for comratision.

end ASIS_UL.Misc;