+2012-04-26 Robert Dewar <dewar@adacore.com>
+
+ * einfo.adb, einfo.ads, sem_res.adb, sem_ch4.adb,
+ sem_eval.adb: Minor reformatting.
+
+2012-04-26 Thomas Quinot <quinot@adacore.com>
+
+ * freeze.adb: Minor change in error wording.
+
+2012-04-26 Ed Schonberg <schonberg@adacore.com>
+
+ * gnat_ugn.texi: Documentation on dimensional analysis.
+
+2012-04-26 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * einfo.adb, einfo.ads: Remove synthesized attribute
+ Proper_First_Index along with its associations in various nodes.
+ (Proper_First_Index): Removed.
+ * sem_ch4.adb (Analyze_Slice): Alphabetize constants. Add new
+ local variable Index_Type. The index type of a string literal
+ subtype is that of the stored low bound.
+ * sem_eval (Get_Static_Length): Remove the use of Proper_First_Index.
+ * sem_res.adb (Resolve_Slice): Alphabetize constants. Add
+ new local variable Index_Type. The index type of a
+ string literal subtype is that of the stored low bound.
+ (Set_String_Literal_Subtype): Code reformatting.
+
2012-04-26 Robert Dewar <dewar@adacore.com>
* exp_aggr.adb: Minor reformatting.
and then Present (Prival_Link (Id)));
end Is_Prival;
- ------------------------
- -- Proper_First_Index --
- ------------------------
-
- function Proper_First_Index (Id : E) return E is
- Typ : Entity_Id;
-
- begin
- Typ := Id;
-
- -- The First_Index field is always empty for string literals, use the
- -- base type instead.
-
- if Ekind (Typ) = E_String_Literal_Subtype then
- Typ := Base_Type (Typ);
- end if;
-
- return First_Index (Typ);
- end Proper_First_Index;
-
----------------------------
-- Is_Protected_Component --
----------------------------
-- in the shadow entity, it points to the proper location in which to
-- restore the private view saved in the shadow.
--- Proper_First_Index (synthesized)
--- Applies to array types and subtypes. Returns the First_Index of the
--- type unless it is a string literal. In that case, the First_Index is
--- obtained from the base type.
-
-- Protected_Formal (Node22)
-- Present in formal parameters (in, in out and out parameters). Used
-- only for formals of protected operations. References corresponding
-- Is_Constrained (Flag12)
-- Next_Index (synth)
-- Number_Dimensions (synth)
- -- Proper_First_Index (synth)
-- (plus type attributes)
-- E_Block
-- Is_Constrained (Flag12)
-- Next_Index (synth)
-- Number_Dimensions (synth)
- -- Proper_First_Index (synth)
-- (plus type attributes)
-- E_String_Literal_Subtype
-- String_Literal_Length (Uint16)
-- First_Index (Node17) (always Empty)
-- Packed_Array_Type (Node23)
- -- Proper_First_Index (synth)
-- (plus type attributes)
-- E_Subprogram_Body
function Number_Formals (Id : E) return Pos;
function Parameter_Mode (Id : E) return Formal_Kind;
function Primitive_Operations (Id : E) return L;
- function Proper_First_Index (Id : E) return E;
function Root_Type (Id : E) return E;
function Safe_Emax_Value (Id : E) return U;
function Safe_First_Value (Id : E) return R;
-- 1) controlled objects
-- 2) library-level tagged types
--
- -- Flag Lib_Level should be set when the list comes from a construct at
- -- the library level. Flag Nested_Constructs should be set when any nested
- -- packages declared in L must be processed.
+ -- Lib_Level is True when the list comes from a construct at the library
+ -- level, and False otherwise. Nested_Constructs is True when any nested
+ -- packages declared in L must be processed, and False otherwise.
-------------------------------------
-- Activate_Atomic_Synchronization --
(N : Node_Id;
Lib_Level : Boolean) return Boolean
is
- At_Lib_Level : constant Boolean := Lib_Level and then
- Nkind_In (N, N_Package_Body, N_Package_Specification);
+ At_Lib_Level : constant Boolean :=
+ Lib_Level
+ and then Nkind_In (N, N_Package_Body,
+ N_Package_Specification);
-- N is at the library level if the top-most context is a package and
-- the path taken to reach N does not inlcude non-package constructs.
return
Requires_Cleanup_Actions (Declarations (N), At_Lib_Level, True)
or else
- (Present (Handled_Statement_Sequence (N))
- and then
- Requires_Cleanup_Actions (Statements
- (Handled_Statement_Sequence (N)), At_Lib_Level, True));
+ (Present (Handled_Statement_Sequence (N))
+ and then
+ Requires_Cleanup_Actions
+ (Statements (Handled_Statement_Sequence (N)),
+ At_Lib_Level, True));
when N_Package_Specification =>
return
-- 1) controlled objects
-- 2) library-level tagged types
--
- -- The above cases require special actions on scope exit. Flag Lib_Level
- -- is used to track whether a construct is at the library level.
+ -- These cases require special actions on scope exit. The flag Lib_Level
+ -- is set True if the construct is at library level, and False otherwise.
function Safe_Unchecked_Type_Conversion (Exp : Node_Id) return Boolean;
-- Given the node for an N_Unchecked_Type_Conversion, return True if this
Error_Msg_Sloc := Sloc (ADC);
Error_Msg_N
("scalar storage order for& specified# inconsistent with "
- & "its bit order", Rec);
+ & "bit order", Rec);
end if;
-- Deal with Bit_Order aspect specifying a non-default bit order
* Verifying Properties Using gnatcheck::
* Creating Sample Bodies Using gnatstub::
* Creating Unit Tests Using gnattest::
+* Performing Dimensionality Analysis in GNAT::
* Generating Ada Bindings for C and C++ headers::
* Other Utility Programs::
* Running and Debugging Ada Programs::
@ref{Creating Unit Tests Using gnattest}, discusses @code{gnattest},
a utility that generates unit testing templates for library units.
+@item
+@ref{Performing Dimensionality Analysis in GNAT}, describes the Ada 2012
+facilities used in GNAT to declare dimensioned objects, and to verify that
+uses of these objects are consistent with their given physical dimensions
+(so that meters cannot be assigned to kilograms, and so on).
+
@item
@ref{Generating Ada Bindings for C and C++ headers}, describes how to
generate automatically Ada bindings from C and C++ headers.
@end itemize
+@c *********************************
+@node Performing Dimensionality Analysis in GNAT
+@chapter Performing Dimensionality Analysis in GNAT
+@noindent
+The GNAT compiler now supports dimensionality checking. The user can
+specify physical units for objects, and the compiler will verify that uses
+of these objects are compatible with their dimensions, in a fashion that is
+familiar to engineering practice. The dimensions of algebraic expressions
+(including powers with static exponents) are computed from their consistuents.
+
+This feature depends on Ada 2012 aspect specifications, and is available from
+version 7.0.1 of GNAT onwards. The GNAT-specific aspect Dimension_System allows
+the user to define a system of units; the aspect Dimension then allows the user
+to declare dimensioned quantities within a given system.
+
+The simplest way to impose dimensionality checking on a computation is to make
+use of the package System.Dim.Mks, which is part of the GNAT library. This
+package defines a floating-point type MKS_Type, for which a sequence of
+dimension names are specified, together with their conventional abbreviations.
+The following should be read together with the full specification of the
+package, in file s-dimmks.ads.
+
+@smallexample @c ada
+ type Mks_Type is new Long_Long_Float
+ with
+ Dimension_System => (
+ (Meter, 'm'),
+ (Kilogram, "kg"),
+ (Second, 's'),
+ (Ampere, 'A'),
+ (Kelvin, 'K'),
+ (Mole, "mol"),
+ (Candela, "cd"));
+@end smallexample
+
+@noindent
+The package then defines a series of subtypes that correspond to these
+conventional units. For example:
+@smallexample @c ada
+ subtype Length is Mks_Type
+ with
+ Dimension => ('m',
+ Meter => 1,
+ others => 0);
+@end smallexample
+@noindent
+and similarly for Mass, Time, Electric_Current, Thermodynamic_Temperature,
+Amount_Of_Substance, and Luminous_Intensity (the standard set of units of
+the SI system).
+
+The package also defines conventional names for values of each unit, for
+example:
+
+@smallexample @c ada
+ m : constant Length := 1.0;
+ kg : constant Mass := 1.0;
+ s : constant Time := 1.0;
+ A : constant Electric_Current := 1.0;
+@end smallexample
+
+@noindent
+as well as useful multiples of these units:
+
+@smallexample @c ada
+ cm : constant Length := 1.0E-02;
+ g : constant Mass := 1.0E-03;
+ min : constant Time := 60.0;
+ day : constant TIme := 60.0 * 24.0 * min;
+ ...
+@end smallexample
+
+@noindent
+The user can then define a derived unit by providing the aspect that
+specifies its dimensions within the MKS system:
+
+@smallexample @c ada
+ subtype Acceleration is Mks_Type
+ with Dimension => ("m/sec**2", 1, 0, -2, others => 0);
+@end smallexample
+
+@noindent
+Here is a complete example of use:
+
+@smallexample @c ada
+with System.Dim.MKS; use System.Dim.Mks;
+with System.Dim.Mks_IO; use System.Dim.Mks_IO;
+with Text_IO; use Text_IO;
+procedure Free_Fall is
+ subtype Acceleration is Mks_Type
+ with Dimension => ("m/sec**2", 1, 0, -2, others => 0);
+ G : constant acceleration := 9.81 * m / (s ** 2);
+ T : Time := 10.0*s;
+ Distance : Length;
+begin
+ Distance := 0.5 * G * T ** 2;
+ Put ("distance travelled in 10 seconds of free fall ");
+ Put (Distance, Aft => 2, Exp => 0);
+ Put_Line ("");
+end Free_Fall;
+@end smallexample
+
+@noindent
+Execution of this program yields:
+@smallexample
+distance travelled in 10 seconds of free fall 490.50 m
+@end smallexample
+
+@noindent
+However, incorrect assignments such as:
+
+@smallexample @c ada
+ Distance := 5.0;
+ Distance := 5.0 * kg:
+@end smallexample
+
+@noindent
+are rejected with the following diagnoses:
+
+@smallexample
+ Distance := 5.0;
+ >>> dimensions mismatch in assignment
+ >>> left-hand side has dimensions (1, 0, 0, 0, 0, 0, 0)
+ >>> right-hand side is dimensionless
+
+ Distance := 5.0 * kg:
+ >>> dimensions mismatch in assignment
+ >>> left-hand side has dimensions (1, 0, 0, 0, 0, 0, 0)
+ >>> right-hand side has dimensions (0, 1, 0, 0, 0, 0, 0)
+@end smallexample
+
+@noindent
+The dimensions of an expression are properly displayed. If we add to the
+program:
+
+@smallexample @c ada
+ Put ("Final velocity: ");
+ Put (G * T, Aft =>2, Exp =>0);
+ Put_Line ("");
+@end smallexample
+
+@noindent
+then the output includes:
+@smallexample
+ Final velocity: 98.10 m.s**(-1)
+@end smallexample
+
@c *********************************
@node Generating Ada Bindings for C and C++ headers
@chapter Generating Ada Bindings for C and C++ headers
Element : Package_Element;
procedure Process_Binder (Arrays : Array_Id);
- -- Process the associate array attributes of package Binder
+ -- Process the associated array attributes of package Binder
procedure Process_Builder (Attributes : Variable_Id);
-- Process the simple attributes of package Builder
procedure Process_Clean (Arrays : Array_Id);
- -- Process the associate array attributes of package Clean
+ -- Process the associated array attributes of package Clean
procedure Process_Compiler (Arrays : Array_Id);
- -- Process the associate array attributes of package Compiler
+ -- Process the associated array attributes of package Compiler
procedure Process_Naming (Attributes : Variable_Id);
-- Process the simple attributes of package Naming
procedure Process_Naming (Arrays : Array_Id);
- -- Process the associate array attributes of package Naming
+ -- Process the associated array attributes of package Naming
procedure Process_Linker (Attributes : Variable_Id);
-- Process the simple attributes of package Linker of a
List : String_List_Id;
begin
- -- Process the associative array attribute of package Clean
+ -- Process the associated array attributes of package Clean
Current_Array_Id := Arrays;
while Current_Array_Id /= No_Array loop
-- Get the name of the language
- Lang_Index := Get_Language_From_Name
- (Project, Get_Name_String (Element.Index));
+ Lang_Index :=
+ Get_Language_From_Name
+ (Project, Get_Name_String (Element.Index));
if Lang_Index /= No_Language_Index then
case Current_Array.Name is
From_List => List,
In_Tree => Data.Tree);
end if;
+
when others =>
null;
end case;
if Project.Library then
Support_For_Libraries := Project.Config.Lib_Support;
- if not Project.Externally_Built and then
- Support_For_Libraries = Prj.None
+ if not Project.Externally_Built
+ and then Support_For_Libraries = Prj.None
then
Error_Msg
(Data.Flags,
end if;
if Project.Library_Kind /= Static then
- if not Project.Externally_Built and then
- Support_For_Libraries = Prj.Static_Only
+ if not Project.Externally_Built
+ and then Support_For_Libraries = Prj.Static_Only
then
Error_Msg
(Data.Flags,
-------------------
procedure Analyze_Slice (N : Node_Id) is
- P : constant Node_Id := Prefix (N);
D : constant Node_Id := Discrete_Range (N);
+ P : constant Node_Id := Prefix (N);
Array_Type : Entity_Id;
+ Index_Type : Entity_Id;
procedure Analyze_Overloaded_Slice;
-- If the prefix is overloaded, select those interpretations that
Error_Msg_N
("type is not one-dimensional array in slice prefix", N);
- elsif not
- Has_Compatible_Type (D, Etype (Proper_First_Index (Array_Type)))
- then
- Wrong_Type (D, Etype (Proper_First_Index (Array_Type)));
-
else
- Set_Etype (N, Array_Type);
+ if Ekind (Array_Type) = E_String_Literal_Subtype then
+ Index_Type := Etype (String_Literal_Low_Bound (Array_Type));
+ else
+ Index_Type := Etype (First_Index (Array_Type));
+ end if;
+
+ if not Has_Compatible_Type (D, Index_Type) then
+ Wrong_Type (D, Index_Type);
+ else
+ Set_Etype (N, Array_Type);
+ end if;
end if;
end if;
end Analyze_Slice;
if Attribute_Name (N) = Name_First then
return String_Literal_Low_Bound (Xtyp);
- else -- Attribute_Name (N) = Name_Last
+ else
return Make_Integer_Literal (Sloc (N),
Intval => Intval (String_Literal_Low_Bound (Xtyp))
+ String_Literal_Length (Xtyp));
-- General case
- T := Etype (Proper_First_Index (Etype (Op)));
+ T := Etype (First_Index (Etype (Op)));
-- The simple case, both bounds are known at compile time
-------------------
procedure Resolve_Slice (N : Node_Id; Typ : Entity_Id) is
- Name : constant Node_Id := Prefix (N);
Drange : constant Node_Id := Discrete_Range (N);
+ Name : constant Node_Id := Prefix (N);
Array_Type : Entity_Id := Empty;
- Index : Node_Id;
+ Index_Type : Entity_Id;
begin
if Is_Overloaded (Name) then
-- necessary. Else resolve the bounds, and apply needed checks.
if not Is_Entity_Name (Drange) then
- Index := Proper_First_Index (Array_Type);
- Resolve (Drange, Base_Type (Etype (Index)));
+ if Ekind (Array_Type) = E_String_Literal_Subtype then
+ Index_Type := Etype (String_Literal_Low_Bound (Array_Type));
+ else
+ Index_Type := Etype (First_Index (Array_Type));
+ end if;
+
+ Resolve (Drange, Base_Type (Index_Type));
if Nkind (Drange) = N_Range then
and then Entity (Selector_Name (Prefix (N))) =
RTE_Record_Component (RE_Prims_Ptr))
then
- Apply_Range_Check (Drange, Etype (Index));
+ Apply_Range_Check (Drange, Index_Type);
end if;
end if;
end if;
Set_Is_Constrained (Subtype_Id);
Set_Etype (N, Subtype_Id);
- if Is_OK_Static_Expression (Low_Bound) then
-
-- The low bound is set from the low bound of the corresponding index
-- type. Note that we do not store the high bound in the string literal
-- subtype, but it can be deduced if necessary from the length and the
-- low bound.
+ if Is_OK_Static_Expression (Low_Bound) then
Set_String_Literal_Low_Bound (Subtype_Id, Low_Bound);
- else
- -- If the lower bound is not static we create a range for the string
- -- literal, using the index type and the known length of the literal.
- -- The index type is not necessarily Positive, so the upper bound is
- -- computed as T'Val (T'Pos (Low_Bound) + L - 1)
+ -- If the lower bound is not static we create a range for the string
+ -- literal, using the index type and the known length of the literal.
+ -- The index type is not necessarily Positive, so the upper bound is
+ -- computed as T'Val (T'Pos (Low_Bound) + L - 1).
+ else
declare
- Index_List : constant List_Id := New_List;
- Index_Type : constant Entity_Id := Etype (First_Index (Typ));
-
- High_Bound : constant Node_Id :=
+ Index_List : constant List_Id := New_List;
+ Index_Type : constant Entity_Id := Etype (First_Index (Typ));
+ High_Bound : constant Node_Id :=
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Val,
Prefix =>
String_Length (Strval (N)) - 1))));
Array_Subtype : Entity_Id;
- Index_Subtype : Entity_Id;
Drange : Node_Id;
Index : Node_Id;
+ Index_Subtype : Entity_Id;
begin
if Is_Integer_Type (Index_Type) then
Rewrite (N,
Make_Unchecked_Type_Conversion (Loc,
Subtype_Mark => New_Occurrence_Of (Array_Subtype, Loc),
- Expression => Relocate_Node (N)));
+ Expression => Relocate_Node (N)));
Set_Etype (N, Array_Subtype);
end;
end if;
git://gcc.gnu.org / gcc.git / commitdiff