diff --git a/courses/fundamentals_of_ada/170_tagged_derivation-intro.rst b/courses/fundamentals_of_ada/170_tagged_derivation-intro.rst new file mode 100644 index 000000000..3a09053be --- /dev/null +++ b/courses/fundamentals_of_ada/170_tagged_derivation-intro.rst @@ -0,0 +1,40 @@ +***************** +Tagged Derivation +***************** + +.. container:: PRELUDE BEGIN + +.. container:: PRELUDE ROLES + +.. role:: ada(code) + :language: Ada + +.. role:: C(code) + :language: C + +.. role:: cpp(code) + :language: C++ + +.. container:: PRELUDE SYMBOLS + +.. |rightarrow| replace:: :math:`\rightarrow` +.. |forall| replace:: :math:`\forall` +.. |exists| replace:: :math:`\exists` +.. |equivalent| replace:: :math:`\iff` +.. |le| replace:: :math:`\le` +.. |ge| replace:: :math:`\ge` +.. |lt| replace:: :math:`<` +.. |gt| replace:: :math:`>` +.. |checkmark| replace:: :math:`\checkmark` + +.. container:: PRELUDE REQUIRES + +.. container:: PRELUDE PROVIDES + +.. container:: PRELUDE END + +.. include:: 170_tagged_derivation/01-introduction.rst +.. include:: 170_tagged_derivation/02-tagged_derivation-simple.rst +.. include:: labs/170_tagged_derivation-simple.lab.rst +.. include:: 170_tagged_derivation/99-summary.rst +.. include:: 170_tagged_derivation/03-extending_tagged_types.rst diff --git a/courses/fundamentals_of_ada/170_tagged_derivation.rst b/courses/fundamentals_of_ada/170_tagged_derivation.rst index a11e4a028..2d2c8d426 100644 --- a/courses/fundamentals_of_ada/170_tagged_derivation.rst +++ b/courses/fundamentals_of_ada/170_tagged_derivation.rst @@ -1,515 +1,40 @@ -***************** -Tagged Derivation -***************** - -.. container:: PRELUDE BEGIN - -.. container:: PRELUDE ROLES - -.. role:: ada(code) - :language: Ada - -.. role:: C(code) - :language: C - -.. role:: cpp(code) - :language: C++ - -.. container:: PRELUDE SYMBOLS - -.. |rightarrow| replace:: :math:`\rightarrow` -.. |forall| replace:: :math:`\forall` -.. |exists| replace:: :math:`\exists` -.. |equivalent| replace:: :math:`\iff` -.. |le| replace:: :math:`\le` -.. |ge| replace:: :math:`\ge` -.. |lt| replace:: :math:`<` -.. |gt| replace:: :math:`>` -.. |checkmark| replace:: :math:`\checkmark` - -.. container:: PRELUDE REQUIRES - -.. container:: PRELUDE PROVIDES - -.. container:: PRELUDE END - -============== -Introduction -============== - ---------------------------------------------- -Object-Oriented Programming with Tagged Types ---------------------------------------------- - -* For :ada:`record` types - - .. code:: Ada - - type T is tagged record - ... - -* Child types can add new components (*attributes*) -* Object of a child type can be **substituted** for base type -* Primitive (*method*) can :dfn:`dispatch` **at run-time** depending on the type at call-site -* Types can be **extended** by other packages - - - Conversion and qualification to base type is allowed - -* Private data is encapsulated through **privacy** - ------------------------------- -Tagged Derivation Ada Vs C++ ------------------------------- - -.. container:: columns - - .. container:: column - - .. code:: Ada - - type T1 is tagged record - Member1 : Integer; - end record; - - procedure Attr_F (This : T1); - - type T2 is new T1 with record - Member2 : Integer; - end record; - - overriding procedure Attr_F ( - This : T2); - procedure Attr_F2 (This : T2); - - .. container:: column - - .. code:: C++ - - class T1 { - public: - int Member1; - virtual void Attr_F(void); - }; - - class T2 : public T1 { - public: - int Member2; - virtual void Attr_F(void); - virtual void Attr_F2(void); - }; - -================= -Tagged Derivation -================= - ---------------------------------- -Difference with Simple Derivation ---------------------------------- - -* Tagged derivation **can** change the structure of a type - - - Keywords :ada:`tagged record` and :ada:`with record` - - .. code:: Ada - - type Root is tagged record - F1 : Integer; - end record; - - type Child is new Root with record - F2 : Integer; - end record; - -* Conversion is only allowed from **child to parent** - - .. code:: Ada - - V1 : Root; - V2 : Child; - ... - V1 := Root (V2); - V2 := Child (V1); -- illegal - ------------- -Primitives ------------- - -* Child **cannot remove** a primitive -* Child **can add** new primitives -* :dfn:`Controlling parameter` - - - Parameters the subprogram is a primitive of - - For :ada:`tagged` types, all should have the **same type** - - .. code:: Ada - - type Root1 is tagged null record; - type Root2 is tagged null record; - - procedure P1 (V1 : Root1; - V2 : Root1); - procedure P2 (V1 : Root1; - V2 : Root2); -- illegal - -------------------------------- -Freeze Point for Tagged Types -------------------------------- - -* Freeze point definition does not change - - - A variable of the type is declared - - The type is derived - - The end of the scope is reached - -* Declaring tagged type primitives past freeze point is **forbidden** - -.. code:: Ada - - type Root is tagged null record; - - procedure Prim (V : Root); - - type Child is new Root with null record; -- freeze root - - procedure Prim2 (V : Root); -- illegal - - V : Child; -- freeze child - - procedure Prim3 (V : Child); -- illegal - ---------------------- -Overriding Indicators ---------------------- - -* Optional :ada:`overriding` and :ada:`not overriding` indicators - - .. code:: Ada - - type Shape_T is tagged record - Name : String (1..10); - end record; - - -- primitives of "Shape_T" - function Get_Name (S : Shape_T) return String; - procedure Set_Name (S : in out Shape_T); - - -- Derive "Point" from Shape_T - type Point_T is new Shape_T with record - Origin : Coord_T; - end Point_T; - - -- Get_Name is inherited - -- We want to _change_ the behavior of Set_Name - overriding procedure Set_Name (P : in out Point_T); - -- We want to _add_ a new primitive - not overriding procedure Set_Origin (P : in out Point_T); - -.. - language_version 2005 - ------------------ -Prefix Notation ------------------ - -* Tagged types primitives can be called as usual -* The call can use prefixed notation - - - **If** the first argument is a controlling parameter - - No need for :ada:`use` or :ada:`use type` for visibility - - .. code:: Ada - - -- Prim1 visible even without *use Pkg* - X.Prim1; - - declare - use Pkg; - begin - Prim1 (X); - end; - -.. - language_version 2005 - ------- -Quiz ------- - -.. include:: quiz/tagged_primitives/quiz.rst - ------- -Quiz ------- - -.. include:: quiz/tagged_dot_and_with/quiz.rst - ------- -Quiz ------- - -Which code block(s) is (are) legal? - -.. container:: columns - - .. container:: column - - A. | ``type A1 is record`` - | ``Field1 : Integer;`` - | ``end record;`` - | ``type A2 is new A1 with null record;`` - B. | :answermono:`type B1 is tagged record` - | :answermono:`Field2 : Integer;` - | :answermono:`end record;` - | :answermono:`type B2 is new B1 with record` - | :answermono:`Field2b : Integer;` - | :answermono:`end record;` - - .. container:: column - - C. | ``type C1 is tagged record`` - | ``Field3 : Integer;`` - | ``end record;`` - | ``type C2 is new C1 with record`` - | ``Field3 : Integer;`` - | ``end record;`` - D. | ``type D1 is tagged record`` - | ``Field1 : Integer;`` - | ``end record;`` - | ``type D2 is new D1;`` - -.. container:: animate - - Explanations - - A. Cannot extend a non-tagged type - B. Correct - C. Components must have distinct names - D. Types derived from a tagged type must have an extension - -======================== -Extending Tagged Types -======================== - ----------------------------------- -How Do You Extend a Tagged Type? ----------------------------------- - -* Premise of a tagged type is to :dfn:`extend` an existing type - -* In general, that means we want to add more fields - - * We can extend a :ada:`tagged` type by adding fields - - .. code:: Ada - - package Animals is - type Animal_T is tagged record - Age : Natural; - end record; - end Animals; - - with Animals; use Animals; - package Mammals is - type Mammal_T is new Animal_T with record - Number_Of_Legs : Natural; - end record; - end Mammals; - - with Mammals; use Mammals; - package Canines is - type Canine_T is new Mammal_T with record - Domesticated : Boolean; - end record; - end Canines; - ------------------- -Tagged Aggregate ------------------- - -* At initialization, all fields (including **inherited**) must have a **value** - - .. code:: Ada - - Animal : Animal_T := (Age => 1); - Mammal : Mammal_T := (Age => 2, - Number_Of_Legs => 2); - Canine : Canine_T := (Age => 2, - Number_Of_Legs => 4, - Domesticated => True); - -* But we can also "seed" the aggregate with a parent object - - .. code:: Ada - - Mammal := (Animal with Number_Of_Legs => 4); - Canine := (Animal with Number_Of_Legs => 4, - Domesticated => False); - Canine := (Mammal with Domesticated => True); - ----------------------- -Private Tagged Types ----------------------- - -* But data hiding says types should be private! - -* So we can define our base type as private - - .. container:: latex_environment tiny - - .. code:: Ada - - package Animals is - type Animal_T is tagged private; - function Get_Age (P : Animal_T) return Natural; - procedure Set_Age (P : in out Animal_T; A : Natural); - private - type Animal_T is tagged record - Age : Natural; - end record; - end Animals; - -* And still allow derivation - - .. container:: latex_environment tiny - - .. code:: Ada - - with Animals; - package Mammals is - type Mammal_T is new Animals.Animal_T with record - Number_Of_Legs : Natural; - end record; - -* But now the only way to get access to :ada:`Age` is with accessor subprograms - --------------------- -Private Extensions --------------------- - -* In the previous slide, we exposed the fields for :ada:`Mammal_T`! - -* Better would be to make the extension itself private - - .. code:: Ada - - package Mammals is - type Mammal_T is new Animals.Animal_T with private; - private - type Mammal_T is new Animals.Animal_T with record - Number_Of_Legs : Natural; - end record; - end Mammals; - --------------------------------------- -Aggregates with Private Tagged Types --------------------------------------- - -* Remember, an aggregate must specify values for all components - - * But with private types, we can't see all the components! - -* So we need to use the "seed" method: - - .. code:: Ada - - procedure Inside_Mammals_Pkg is - Animal : Animal_T := Animals.Create; - Mammal : Mammal_T; - begin - Mammal := (Animal with Number_Of_Legs => 4); - Mammal := (Animals.Create with Number_Of_Legs => 4); - end Inside_Mammals_Pkg; - -* Note that we cannot use :ada:`others => <>` for components that are not visible to us - - .. code:: Ada - - Mammal := (Number_Of_Legs => 4, - others => <>); -- Compile Error - ------------------ -Null Extensions ------------------ - -* To create a new type with no additional fields - - * We still need to "extend" the record - we just do it with an empty record - - .. code:: Ada - - type Dog_T is new Canine_T with null record; - - -* We still need to specify the "added" fields in an aggregate - - .. code:: Ada - - C : Canine_T := Canines.Create; - Dog1 : Dog_T := C; -- Compile Error - Dog2 : Dog_T := (C with null record); - ------- -Quiz ------- - -Given the following code: - - .. code::ada - - package Parents is - type Parent_T is tagged private; - function Create return Parent_T; - private - type Parent_T is tagged record - Id : Integer; - end record; - end Parents; - - with Parents; use Parents; - package Children is - P : Parent_T; - type Child_T is new Parent_T with record - Count : Natural; - end record; - function Create (C : Natural) return Child_T; - end Children; - -Which completion(s) of Create is (are) valid? - - A. :answermono:`function Create return Child_T is (Parents.Create with Count => 0);` - B. ``function Create return Child_T is (others => <>);`` - B. ``function Create return Child_T is (0, 0);`` - D. :answermono:`function Create return Child_T is (P with Count => 0);` - -.. container:: animate - - Explanations - - A. Correct - :ada:`Parents.Create` returns :ada:`Parent_T` - B. Cannot use :ada:`others` to complete private part of an aggregate - C. Aggregate has no visibility to :ada:`Id` field, so cannot assign - D. Correct - :ada:`P` is a :ada:`Parent_T` - -======== -Lab -======== - -.. include:: labs/170_tagged_derivation.lab.rst - -========= -Summary -========= - ---------- -Summary ---------- - -* Tagged derivation - - - Building block for OOP types in Ada - -* Primitives rules for tagged types are trickier - - - Primitives **forbidden** below freeze point - - **Unique** controlling parameter - - Tip: Keep the number of tagged type per package low +***************** +Tagged Derivation +***************** + +.. container:: PRELUDE BEGIN + +.. container:: PRELUDE ROLES + +.. role:: ada(code) + :language: Ada + +.. role:: C(code) + :language: C + +.. role:: cpp(code) + :language: C++ + +.. container:: PRELUDE SYMBOLS + +.. |rightarrow| replace:: :math:`\rightarrow` +.. |forall| replace:: :math:`\forall` +.. |exists| replace:: :math:`\exists` +.. |equivalent| replace:: :math:`\iff` +.. |le| replace:: :math:`\le` +.. |ge| replace:: :math:`\ge` +.. |lt| replace:: :math:`<` +.. |gt| replace:: :math:`>` +.. |checkmark| replace:: :math:`\checkmark` + +.. container:: PRELUDE REQUIRES + +.. container:: PRELUDE PROVIDES + +.. container:: PRELUDE END + +.. include:: 170_tagged_derivation/01-introduction.rst +.. include:: 170_tagged_derivation/02-tagged_derivation.rst +.. include:: 170_tagged_derivation/03-extending_tagged_types.rst +.. include:: labs/170_tagged_derivation.lab.rst +.. include:: 170_tagged_derivation/99-summary.rst diff --git a/courses/fundamentals_of_ada/170_tagged_derivation/01-introduction.rst b/courses/fundamentals_of_ada/170_tagged_derivation/01-introduction.rst new file mode 100644 index 000000000..6b6ad791c --- /dev/null +++ b/courses/fundamentals_of_ada/170_tagged_derivation/01-introduction.rst @@ -0,0 +1,65 @@ +============== +Introduction +============== + +--------------------------------------------- +Object-Oriented Programming with Tagged Types +--------------------------------------------- + +* For :ada:`record` types + + .. code:: Ada + + type T is tagged record + ... + +* Child types can add new components (*attributes*) +* Object of a child type can be **substituted** for base type +* Primitive (*method*) can :dfn:`dispatch` **at run-time** depending on the type at call-site +* Types can be **extended** by other packages + + - Conversion and qualification to base type is allowed + +* Private data is encapsulated through **privacy** + +------------------------------ +Tagged Derivation Ada Vs C++ +------------------------------ + +.. container:: columns + + .. container:: column + + .. code:: Ada + + type T1 is tagged record + Member1 : Integer; + end record; + + procedure Attr_F (This : T1); + + type T2 is new T1 with record + Member2 : Integer; + end record; + + overriding procedure Attr_F ( + This : T2); + procedure Attr_F2 (This : T2); + + .. container:: column + + .. code:: C++ + + class T1 { + public: + int Member1; + virtual void Attr_F(void); + }; + + class T2 : public T1 { + public: + int Member2; + virtual void Attr_F(void); + virtual void Attr_F2(void); + }; + diff --git a/courses/fundamentals_of_ada/170_tagged_derivation/02-tagged_derivation-simple.rst b/courses/fundamentals_of_ada/170_tagged_derivation/02-tagged_derivation-simple.rst new file mode 100644 index 000000000..348cdb728 --- /dev/null +++ b/courses/fundamentals_of_ada/170_tagged_derivation/02-tagged_derivation-simple.rst @@ -0,0 +1,233 @@ +================= +Tagged Derivation +================= + +--------------------------------- +Difference with Simple Derivation +--------------------------------- + +* Tagged derivation **can** change the structure of a type + + - Keywords :ada:`tagged record` and :ada:`with record` + + .. code:: Ada + + type Root is tagged record + F1 : Integer; + end record; + + type Child is new Root with record + F2 : Integer; + end record; + +-------------- +Type Extension +-------------- + +* A tagged derivation **has** to be a type extension + + - Use :ada:`with null record` if there are no additional components + + .. code:: Ada + + type Child is new Root with null record; + type Child is new Root; -- illegal + +* Conversion is only allowed from **child to parent** + + .. code:: Ada + + V1 : Root; + V2 : Child; + ... + V1 := Root (V2); + V2 := Child (V1); -- illegal + +*Information on extending private types appears at the end of this module* + +------------ +Primitives +------------ + +* Child **cannot remove** a primitive +* Child **can add** new primitives +* :dfn:`Controlling parameter` + + - Parameters the subprogram is a primitive of + - For :ada:`tagged` types, all should have the **same type** + + .. code:: Ada + + type Root1 is tagged null record; + type Root2 is tagged null record; + + procedure P1 (V1 : Root1; + V2 : Root1); + procedure P2 (V1 : Root1; + V2 : Root2); -- illegal + +------------------------------- +Freeze Point for Tagged Types +------------------------------- + +* Freeze point definition does not change + + - A variable of the type is declared + - The type is derived + - The end of the scope is reached + +* Declaring tagged type primitives past freeze point is **forbidden** + +.. code:: Ada + + type Root is tagged null record; + + procedure Prim (V : Root); + + type Child is new Root with null record; -- freeze root + + procedure Prim2 (V : Root); -- illegal + + V : Child; -- freeze child + + procedure Prim3 (V : Child); -- illegal + +------------------ +Tagged Aggregate +------------------ + +* At initialization, all fields (including **inherited**) must have a **value** + + .. code:: Ada + + type Root is tagged record + F1 : Integer; + end record; + + type Child is new Root with record + F2 : Integer; + end record; + + V : Child := (F1 => 0, F2 => 0); + +* For **private types** use :dfn:`aggregate extension` + + - Copy of a parent instance + - Use :ada:`with null record` absent new fields + + .. code:: Ada + + V2 : Child := (Parent_Instance with F2 => 0); + V3 : Empty_Child := (Parent_Instance with null record); + +*Information on aggregates of private extensions appears at the end of this module* + +--------------------- +Overriding Indicators +--------------------- + +* Optional :ada:`overriding` and :ada:`not overriding` indicators + + .. code:: Ada + + type Shape_T is tagged record + Name : String (1..10); + end record; + + -- primitives of "Shape_T" + procedure Set_Name (S : in out Shape_T); + function Name (S : Shape_T) return String; + + -- Derive "Point" from Shape_T + type Point is new Shape_T with record + Origin : Coord_T; + end Point; + + -- We want to _change_ the behavior of Set_Name + overriding procedure Set_Name (P : in out Point_T); + -- We want to _add_ a new primitive + not overriding Origin (P : Point_T) return Point_T; + -- We get "Name" for free + +.. + language_version 2005 + +----------------- +Prefix Notation +----------------- + +* Tagged types primitives can be called as usual +* The call can use prefixed notation + + - **If** the first argument is a controlling parameter + - No need for :ada:`use` or :ada:`use type` for visibility + + .. code:: Ada + + -- Prim1 visible even without *use Pkg* + X.Prim1; + + declare + use Pkg; + begin + Prim1 (X); + end; + +.. + language_version 2012 + +------ +Quiz +------ + +.. include:: ../quiz/tagged_primitives/quiz.rst + +------ +Quiz +------ + +.. include:: ../quiz/tagged_dot_and_with/quiz.rst + +------ +Quiz +------ + +Which code block(s) is (are) legal? + +.. container:: columns + + .. container:: column + + A. | ``type A1 is record`` + | ``Field1 : Integer;`` + | ``end record;`` + | ``type A2 is new A1 with null record;`` + B. | :answermono:`type B1 is tagged record` + | :answermono:`Field2 : Integer;` + | :answermono:`end record;` + | :answermono:`type B2 is new B1 with record` + | :answermono:`Field2b : Integer;` + | :answermono:`end record;` + + .. container:: column + + C. | ``type C1 is tagged record`` + | ``Field3 : Integer;`` + | ``end record;`` + | ``type C2 is new C1 with record`` + | ``Field3 : Integer;`` + | ``end record;`` + D. | ``type D1 is tagged record`` + | ``Field1 : Integer;`` + | ``end record;`` + | ``type D2 is new D1;`` + +.. container:: animate + + Explanations + + A. Cannot extend a non-tagged type + B. Correct + C. Components must have distinct names + D. Types derived from a tagged type must have an extension + diff --git a/courses/fundamentals_of_ada/170_tagged_derivation/02-tagged_derivation.rst b/courses/fundamentals_of_ada/170_tagged_derivation/02-tagged_derivation.rst new file mode 100644 index 000000000..9bc05675f --- /dev/null +++ b/courses/fundamentals_of_ada/170_tagged_derivation/02-tagged_derivation.rst @@ -0,0 +1,188 @@ +================= +Tagged Derivation +================= + +--------------------------------- +Difference with Simple Derivation +--------------------------------- + +* Tagged derivation **can** change the structure of a type + + - Keywords :ada:`tagged record` and :ada:`with record` + + .. code:: Ada + + type Root is tagged record + F1 : Integer; + end record; + + type Child is new Root with record + F2 : Integer; + end record; + +* Conversion is only allowed from **child to parent** + + .. code:: Ada + + V1 : Root; + V2 : Child; + ... + V1 := Root (V2); + V2 := Child (V1); -- illegal + +------------ +Primitives +------------ + +* Child **cannot remove** a primitive +* Child **can add** new primitives +* :dfn:`Controlling parameter` + + - Parameters the subprogram is a primitive of + - For :ada:`tagged` types, all should have the **same type** + + .. code:: Ada + + type Root1 is tagged null record; + type Root2 is tagged null record; + + procedure P1 (V1 : Root1; + V2 : Root1); + procedure P2 (V1 : Root1; + V2 : Root2); -- illegal + +------------------------------- +Freeze Point for Tagged Types +------------------------------- + +* Freeze point definition does not change + + - A variable of the type is declared + - The type is derived + - The end of the scope is reached + +* Declaring tagged type primitives past freeze point is **forbidden** + +.. code:: Ada + + type Root is tagged null record; + + procedure Prim (V : Root); + + type Child is new Root with null record; -- freeze root + + procedure Prim2 (V : Root); -- illegal + + V : Child; -- freeze child + + procedure Prim3 (V : Child); -- illegal + +--------------------- +Overriding Indicators +--------------------- + +* Optional :ada:`overriding` and :ada:`not overriding` indicators + + .. code:: Ada + + type Shape_T is tagged record + Name : String (1..10); + end record; + + -- primitives of "Shape_T" + function Get_Name (S : Shape_T) return String; + procedure Set_Name (S : in out Shape_T); + + -- Derive "Point" from Shape_T + type Point_T is new Shape_T with record + Origin : Coord_T; + end Point_T; + + -- Get_Name is inherited + -- We want to _change_ the behavior of Set_Name + overriding procedure Set_Name (P : in out Point_T); + -- We want to _add_ a new primitive + not overriding procedure Set_Origin (P : in out Point_T); + +.. + language_version 2005 + +----------------- +Prefix Notation +----------------- + +* Tagged types primitives can be called as usual +* The call can use prefixed notation + + - **If** the first argument is a controlling parameter + - No need for :ada:`use` or :ada:`use type` for visibility + + .. code:: Ada + + -- Prim1 visible even without *use Pkg* + X.Prim1; + + declare + use Pkg; + begin + Prim1 (X); + end; + +.. + language_version 2005 + +------ +Quiz +------ + +.. include:: ../quiz/tagged_primitives/quiz.rst + +------ +Quiz +------ + +.. include:: ../quiz/tagged_dot_and_with/quiz.rst + +------ +Quiz +------ + +Which code block(s) is (are) legal? + +.. container:: columns + + .. container:: column + + A. | ``type A1 is record`` + | ``Field1 : Integer;`` + | ``end record;`` + | ``type A2 is new A1 with null record;`` + B. | :answermono:`type B1 is tagged record` + | :answermono:`Field2 : Integer;` + | :answermono:`end record;` + | :answermono:`type B2 is new B1 with record` + | :answermono:`Field2b : Integer;` + | :answermono:`end record;` + + .. container:: column + + C. | ``type C1 is tagged record`` + | ``Field3 : Integer;`` + | ``end record;`` + | ``type C2 is new C1 with record`` + | ``Field3 : Integer;`` + | ``end record;`` + D. | ``type D1 is tagged record`` + | ``Field1 : Integer;`` + | ``end record;`` + | ``type D2 is new D1;`` + +.. container:: animate + + Explanations + + A. Cannot extend a non-tagged type + B. Correct + C. Components must have distinct names + D. Types derived from a tagged type must have an extension + diff --git a/courses/fundamentals_of_ada/170_tagged_derivation/03-extending_tagged_types.rst b/courses/fundamentals_of_ada/170_tagged_derivation/03-extending_tagged_types.rst new file mode 100644 index 000000000..1403ae593 --- /dev/null +++ b/courses/fundamentals_of_ada/170_tagged_derivation/03-extending_tagged_types.rst @@ -0,0 +1,204 @@ +======================== +Extending Tagged Types +======================== + +---------------------------------- +How Do You Extend a Tagged Type? +---------------------------------- + +* Premise of a tagged type is to :dfn:`extend` an existing type + +* In general, that means we want to add more fields + + * We can extend a :ada:`tagged` type by adding fields + + .. code:: Ada + + package Animals is + type Animal_T is tagged record + Age : Natural; + end record; + end Animals; + + with Animals; use Animals; + package Mammals is + type Mammal_T is new Animal_T with record + Number_Of_Legs : Natural; + end record; + end Mammals; + + with Mammals; use Mammals; + package Canines is + type Canine_T is new Mammal_T with record + Domesticated : Boolean; + end record; + end Canines; + +------------------ +Tagged Aggregate +------------------ + +* At initialization, all fields (including **inherited**) must have a **value** + + .. code:: Ada + + Animal : Animal_T := (Age => 1); + Mammal : Mammal_T := (Age => 2, + Number_Of_Legs => 2); + Canine : Canine_T := (Age => 2, + Number_Of_Legs => 4, + Domesticated => True); + +* But we can also "seed" the aggregate with a parent object + + .. code:: Ada + + Mammal := (Animal with Number_Of_Legs => 4); + Canine := (Animal with Number_Of_Legs => 4, + Domesticated => False); + Canine := (Mammal with Domesticated => True); + +---------------------- +Private Tagged Types +---------------------- + +* But data hiding says types should be private! + +* So we can define our base type as private + + .. container:: latex_environment tiny + + .. code:: Ada + + package Animals is + type Animal_T is tagged private; + function Get_Age (P : Animal_T) return Natural; + procedure Set_Age (P : in out Animal_T; A : Natural); + private + type Animal_T is tagged record + Age : Natural; + end record; + end Animals; + +* And still allow derivation + + .. container:: latex_environment tiny + + .. code:: Ada + + with Animals; + package Mammals is + type Mammal_T is new Animals.Animal_T with record + Number_Of_Legs : Natural; + end record; + +* But now the only way to get access to :ada:`Age` is with accessor subprograms + +-------------------- +Private Extensions +-------------------- + +* In the previous slide, we exposed the fields for :ada:`Mammal_T`! + +* Better would be to make the extension itself private + + .. code:: Ada + + package Mammals is + type Mammal_T is new Animals.Animal_T with private; + private + type Mammal_T is new Animals.Animal_T with record + Number_Of_Legs : Natural; + end record; + end Mammals; + +-------------------------------------- +Aggregates with Private Tagged Types +-------------------------------------- + +* Remember, an aggregate must specify values for all components + + * But with private types, we can't see all the components! + +* So we need to use the "seed" method: + + .. code:: Ada + + procedure Inside_Mammals_Pkg is + Animal : Animal_T := Animals.Create; + Mammal : Mammal_T; + begin + Mammal := (Animal with Number_Of_Legs => 4); + Mammal := (Animals.Create with Number_Of_Legs => 4); + end Inside_Mammals_Pkg; + +* Note that we cannot use :ada:`others => <>` for components that are not visible to us + + .. code:: Ada + + Mammal := (Number_Of_Legs => 4, + others => <>); -- Compile Error + +----------------- +Null Extensions +----------------- + +* To create a new type with no additional fields + + * We still need to "extend" the record - we just do it with an empty record + + .. code:: Ada + + type Dog_T is new Canine_T with null record; + + +* We still need to specify the "added" fields in an aggregate + + .. code:: Ada + + C : Canine_T := Canines.Create; + Dog1 : Dog_T := C; -- Compile Error + Dog2 : Dog_T := (C with null record); + +------ +Quiz +------ + +Given the following code: + + .. code::ada + + package Parents is + type Parent_T is tagged private; + function Create return Parent_T; + private + type Parent_T is tagged record + Id : Integer; + end record; + end Parents; + + with Parents; use Parents; + package Children is + P : Parent_T; + type Child_T is new Parent_T with record + Count : Natural; + end record; + function Create (C : Natural) return Child_T; + end Children; + +Which completion(s) of Create is (are) valid? + + A. :answermono:`function Create return Child_T is (Parents.Create with Count => 0);` + B. ``function Create return Child_T is (others => <>);`` + B. ``function Create return Child_T is (0, 0);`` + D. :answermono:`function Create return Child_T is (P with Count => 0);` + +.. container:: animate + + Explanations + + A. Correct - :ada:`Parents.Create` returns :ada:`Parent_T` + B. Cannot use :ada:`others` to complete private part of an aggregate + C. Aggregate has no visibility to :ada:`Id` field, so cannot assign + D. Correct - :ada:`P` is a :ada:`Parent_T` + diff --git a/courses/fundamentals_of_ada/170_tagged_derivation/99-summary.rst b/courses/fundamentals_of_ada/170_tagged_derivation/99-summary.rst new file mode 100644 index 000000000..7e55c5963 --- /dev/null +++ b/courses/fundamentals_of_ada/170_tagged_derivation/99-summary.rst @@ -0,0 +1,17 @@ +========= +Summary +========= + +--------- +Summary +--------- + +* Tagged derivation + + - Building block for OOP types in Ada + +* Primitives rules for tagged types are trickier + + - Primitives **forbidden** below freeze point + - **Unique** controlling parameter + - Tip: Keep the number of tagged type per package low diff --git a/courses/fundamentals_of_ada/175_multiple_inheritance.rst b/courses/fundamentals_of_ada/175_multiple_inheritance.rst new file mode 100644 index 000000000..d23d910dd --- /dev/null +++ b/courses/fundamentals_of_ada/175_multiple_inheritance.rst @@ -0,0 +1,39 @@ +********************** +Multiple Inheritance +********************** + +.. container:: PRELUDE BEGIN + +.. container:: PRELUDE ROLES + +.. role:: ada(code) + :language: Ada + +.. role:: C(code) + :language: C + +.. role:: cpp(code) + :language: C++ + +.. container:: PRELUDE SYMBOLS + +.. |rightarrow| replace:: :math:`\rightarrow` +.. |forall| replace:: :math:`\forall` +.. |exists| replace:: :math:`\exists` +.. |equivalent| replace:: :math:`\iff` +.. |le| replace:: :math:`\le` +.. |ge| replace:: :math:`\ge` +.. |lt| replace:: :math:`<` +.. |gt| replace:: :math:`>` +.. |checkmark| replace:: :math:`\checkmark` + +.. container:: PRELUDE REQUIRES + +.. container:: PRELUDE PROVIDES + +.. container:: PRELUDE END + +.. include:: 175_multiple_inheritance/01-introduction.rst +.. include:: 175_multiple_inheritance/02-interfaces.rst +.. include:: labs/175_multiple_inheritance.lab.rst +.. include:: 175_multiple_inheritance/99-summary.rst diff --git a/courses/fundamentals_of_ada/175_multiple_inheritance/01-introduction.rst b/courses/fundamentals_of_ada/175_multiple_inheritance/01-introduction.rst new file mode 100644 index 000000000..daa8659d3 --- /dev/null +++ b/courses/fundamentals_of_ada/175_multiple_inheritance/01-introduction.rst @@ -0,0 +1,58 @@ +============== +Introduction +============== + +------------------------------------------ +Multiple Inheritance Is Forbidden in Ada +------------------------------------------ + +* There are potential conflicts with multiple inheritance +* Some languages allow it: ambiguities have to be resolved when entities are referenced +* Ada forbids it to improve integration + +.. code:: Ada + + type Graphic is tagged record + X, Y : Float; + end record; + function Get_X (V : Graphic) return Float; + + type Shape is tagged record + X, Y : Float; + end record; + function Get_X (V : Shape) return Float; + + type Displayable_Shape is new Shape and Graphic with ... + +---------------------------------- +Multiple Inheritance - Safe Case +---------------------------------- + +* If only one type has concrete operations and fields, this is fine + + .. code:: Ada + + type Graphic is abstract tagged null record; + function Get_X (V : Graphic) return Float is abstract; + + type Shape is tagged record + X, Y : Float; + end record; + function Get_X (V : Shape) return Float; + + type Displayable_Shape is new Shape and Graphic with ... + +* This is the definition of an interface (as in Java) + + .. code:: Ada + + type Graphic is interface; + function Get_X (V : Graphic) return Float is abstract; + + type Shape is tagged record + X, Y : Float; + end record; + function Get_X (V : Shape) return Float; + + type Displayable_Shape is new Shape and Graphic with ... + diff --git a/courses/fundamentals_of_ada/175_multiple_inheritance/02-interfaces.rst b/courses/fundamentals_of_ada/175_multiple_inheritance/02-interfaces.rst new file mode 100644 index 000000000..10dbb9d8b --- /dev/null +++ b/courses/fundamentals_of_ada/175_multiple_inheritance/02-interfaces.rst @@ -0,0 +1,88 @@ +============ +Interfaces +============ + +-------------------- +Interfaces - Rules +-------------------- + +* An interface is a tagged type marked interface, containing + + - Abstract primitives + - Null primitives + - No fields + +* Null subprograms provide default empty bodies to primitives that can be overridden + + .. code:: Ada + + type I is interface; + procedure P1 (V : I) is abstract; + procedure P2 (V : access I) is abstract + function F return I is abstract; + procedure P3 (V : I) is null; + +* Note: null can be applied to any procedure (not only used for interfaces) + +---------------------- +Interface Derivation +---------------------- + +* An interface can be derived from another interface, adding primitives + + .. code:: Ada + + type I1 is interface; + procedure P1 (V : I) is abstract; + type I2 is interface and I1; + Procedure P2 (V : I) is abstract; + +* A tagged type can derive from several interfaces and can derive from one interface several times + + .. code:: Ada + + type I1 is interface; + type I2 is interface and I1; + type I3 is interface; + + type R is new I1 and I2 and I3 ... + +* A tagged type can derive from a single tagged type and several interfaces + + .. code:: Ada + + type I1 is interface; + type I2 is interface and I1; + type R1 is tagged null record; + + type R2 is new R1 and I1 and I2 ... + +------------------------ +Interfaces and Privacy +------------------------ + +* If the partial view of the type is tagged, then both the partial and the full view must expose the same interfaces + + .. code:: Ada + + package Types is + + type I1 is interface; + type R is new I1 with private; + + private + + type R is new I1 with record ... + +------------------------------------- +Limited Tagged Types and Interfaces +------------------------------------- + +* When a tagged type is limited in the hierarchy, the whole hierarchy has to be limited +* Conversions to interfaces are "just conversions to a view" + + - A view may have more constraints than the actual object + +* :ada:`limited` interfaces can be implemented by BOTH limited types and non-limited types +* Non-limited interfaces have to be implemented by non-limited types + diff --git a/courses/fundamentals_of_ada/175_multiple_inheritance/99-summary.rst b/courses/fundamentals_of_ada/175_multiple_inheritance/99-summary.rst new file mode 100644 index 000000000..501817b18 --- /dev/null +++ b/courses/fundamentals_of_ada/175_multiple_inheritance/99-summary.rst @@ -0,0 +1,18 @@ +========= +Summary +========= + +--------- +Summary +--------- + +* Interfaces must be used for multiple inheritance + + * Usually combined with :ada:`tagged` types, but not necessary + * By using only interfaces, only accessors are allowed + +* Typically there are other ways to do the same thing + + * In our example, the conversion routine could be common to simplify things + +* But interfaces force the compiler to determine when operations are missing diff --git a/courses/fundamentals_of_ada/adv_170_multiple_inheritance.rst b/courses/fundamentals_of_ada/adv_170_multiple_inheritance.rst deleted file mode 100644 index e3d69e112..000000000 --- a/courses/fundamentals_of_ada/adv_170_multiple_inheritance.rst +++ /dev/null @@ -1,205 +0,0 @@ -********************** -Multiple Inheritance -********************** - -.. container:: PRELUDE BEGIN - -.. container:: PRELUDE ROLES - -.. role:: ada(code) - :language: Ada - -.. role:: C(code) - :language: C - -.. role:: cpp(code) - :language: C++ - -.. container:: PRELUDE SYMBOLS - -.. |rightarrow| replace:: :math:`\rightarrow` -.. |forall| replace:: :math:`\forall` -.. |exists| replace:: :math:`\exists` -.. |equivalent| replace:: :math:`\iff` -.. |le| replace:: :math:`\le` -.. |ge| replace:: :math:`\ge` -.. |lt| replace:: :math:`<` -.. |gt| replace:: :math:`>` -.. |checkmark| replace:: :math:`\checkmark` - -.. container:: PRELUDE REQUIRES - -.. container:: PRELUDE PROVIDES - -.. container:: PRELUDE END - -============== -Introduction -============== - ------------------------------------------- -Multiple Inheritance Is Forbidden in Ada ------------------------------------------- - -* There are potential conflicts with multiple inheritance -* Some languages allow it: ambiguities have to be resolved when entities are referenced -* Ada forbids it to improve integration - -.. code:: Ada - - type Graphic is tagged record - X, Y : Float; - end record; - function Get_X (V : Graphic) return Float; - - type Shape is tagged record - X, Y : Float; - end record; - function Get_X (V : Shape) return Float; - - type Displayable_Shape is new Shape and Graphic with ... - ----------------------------------- -Multiple Inheritance - Safe Case ----------------------------------- - -* If only one type has concrete operations and fields, this is fine - - .. code:: Ada - - type Graphic is abstract tagged null record; - function Get_X (V : Graphic) return Float is abstract; - - type Shape is tagged record - X, Y : Float; - end record; - function Get_X (V : Shape) return Float; - - type Displayable_Shape is new Shape and Graphic with ... - -* This is the definition of an interface (as in Java) - - .. code:: Ada - - type Graphic is interface; - function Get_X (V : Graphic) return Float is abstract; - - type Shape is tagged record - X, Y : Float; - end record; - function Get_X (V : Shape) return Float; - - type Displayable_Shape is new Shape and Graphic with ... - -============ -Interfaces -============ - --------------------- -Interfaces - Rules --------------------- - -* An interface is a tagged type marked interface, containing - - - Abstract primitives - - Null primitives - - No fields - -* Null subprograms provide default empty bodies to primitives that can be overridden - - .. code:: Ada - - type I is interface; - procedure P1 (V : I) is abstract; - procedure P2 (V : access I) is abstract - function F return I is abstract; - procedure P3 (V : I) is null; - -* Note: null can be applied to any procedure (not only used for interfaces) - ----------------------- -Interface Derivation ----------------------- - -* An interface can be derived from another interface, adding primitives - - .. code:: Ada - - type I1 is interface; - procedure P1 (V : I) is abstract; - type I2 is interface and I1; - Procedure P2 (V : I) is abstract; - -* A tagged type can derive from several interfaces and can derive from one interface several times - - .. code:: Ada - - type I1 is interface; - type I2 is interface and I1; - type I3 is interface; - - type R is new I1 and I2 and I3 ... - -* A tagged type can derive from a single tagged type and several interfaces - - .. code:: Ada - - type I1 is interface; - type I2 is interface and I1; - type R1 is tagged null record; - - type R2 is new R1 and I1 and I2 ... - ------------------------- -Interfaces and Privacy ------------------------- - -* If the partial view of the type is tagged, then both the partial and the full view must expose the same interfaces - - .. code:: Ada - - package Types is - - type I1 is interface; - type R is new I1 with private; - - private - - type R is new I1 with record ... - -------------------------------------- -Limited Tagged Types and Interfaces -------------------------------------- - -* When a tagged type is limited in the hierarchy, the whole hierarchy has to be limited -* Conversions to interfaces are "just conversions to a view" - - - A view may have more constraints than the actual object - -* :ada:`limited` interfaces can be implemented by BOTH limited types and non-limited types -* Non-limited interfaces have to be implemented by non-limited types - -======== -Lab -======== - -.. include:: labs/adv_170_multiple_inheritance.lab.rst - -========= -Summary -========= - ---------- -Summary ---------- - -* Interfaces must be used for multiple inheritance - - * Usually combined with :ada:`tagged` types, but not necessary - * By using only interfaces, only accessors are allowed - -* Typically there are other ways to do the same thing - - * In our example, the conversion routine could be common to simplify things - -* But interfaces force the compiler to determine when operations are missing diff --git a/courses/fundamentals_of_ada/advanced.txt b/courses/fundamentals_of_ada/advanced.txt index 9f3c81732..40dbda808 100644 --- a/courses/fundamentals_of_ada/advanced.txt +++ b/courses/fundamentals_of_ada/advanced.txt @@ -9,7 +9,7 @@ adv_120_advanced_privacy.rst 140_access_types-advanced.rst 160_genericity.rst 170_tagged_derivation.rst -adv_170_multiple_inheritance.rst +175_multiple_inheritance.rst 180_polymorphism.rst 190_exceptions-in_depth.rst 240_tasking_in_depth.rst diff --git a/courses/fundamentals_of_ada/intro_170_tagged_derivation.rst b/courses/fundamentals_of_ada/intro_170_tagged_derivation.rst deleted file mode 100644 index a1a462a96..000000000 --- a/courses/fundamentals_of_ada/intro_170_tagged_derivation.rst +++ /dev/null @@ -1,564 +0,0 @@ -***************** -Tagged Derivation -***************** - -.. container:: PRELUDE BEGIN - -.. container:: PRELUDE ROLES - -.. role:: ada(code) - :language: Ada - -.. role:: C(code) - :language: C - -.. role:: cpp(code) - :language: C++ - -.. container:: PRELUDE SYMBOLS - -.. |rightarrow| replace:: :math:`\rightarrow` -.. |forall| replace:: :math:`\forall` -.. |exists| replace:: :math:`\exists` -.. |equivalent| replace:: :math:`\iff` -.. |le| replace:: :math:`\le` -.. |ge| replace:: :math:`\ge` -.. |lt| replace:: :math:`<` -.. |gt| replace:: :math:`>` -.. |checkmark| replace:: :math:`\checkmark` - -.. container:: PRELUDE REQUIRES - -.. container:: PRELUDE PROVIDES - -.. container:: PRELUDE END - -============== -Introduction -============== - ---------------------------------------------- -Object-Oriented Programming with Tagged Types ---------------------------------------------- - -* For :ada:`record` types - - .. code:: Ada - - type T is tagged record - ... - -* Child types can add new components (*attributes*) -* Object of a child type can be **substituted** for base type -* Primitive (*method*) can :dfn:`dispatch` **at run-time** depending on the type at call-site -* Types can be **extended** by other packages - - - Conversion and qualification to base type is allowed - -* Private data is encapsulated through **privacy** - ------------------------------- -Tagged Derivation Ada Vs C++ ------------------------------- - -.. container:: columns - - .. container:: column - - .. code:: Ada - - type T1 is tagged record - Member1 : Integer; - end record; - - procedure Attr_F (This : T1); - - type T2 is new T1 with record - Member2 : Integer; - end record; - - overriding procedure Attr_F ( - This : T2); - procedure Attr_F2 (This : T2); - - .. container:: column - - .. code:: C++ - - class T1 { - public: - int Member1; - virtual void Attr_F(void); - }; - - class T2 : public T1 { - public: - int Member2; - virtual void Attr_F(void); - virtual void Attr_F2(void); - }; - -================= -Tagged Derivation -================= - ---------------------------------- -Difference with Simple Derivation ---------------------------------- - -* Tagged derivation **can** change the structure of a type - - - Keywords :ada:`tagged record` and :ada:`with record` - - .. code:: Ada - - type Root is tagged record - F1 : Integer; - end record; - - type Child is new Root with record - F2 : Integer; - end record; - --------------- -Type Extension --------------- - -* A tagged derivation **has** to be a type extension - - - Use :ada:`with null record` if there are no additional components - - .. code:: Ada - - type Child is new Root with null record; - type Child is new Root; -- illegal - -* Conversion is only allowed from **child to parent** - - .. code:: Ada - - V1 : Root; - V2 : Child; - ... - V1 := Root (V2); - V2 := Child (V1); -- illegal - -`Click here for more information on extending private types `_ - ------------- -Primitives ------------- - -* Child **cannot remove** a primitive -* Child **can add** new primitives -* :dfn:`Controlling parameter` - - - Parameters the subprogram is a primitive of - - For :ada:`tagged` types, all should have the **same type** - - .. code:: Ada - - type Root1 is tagged null record; - type Root2 is tagged null record; - - procedure P1 (V1 : Root1; - V2 : Root1); - procedure P2 (V1 : Root1; - V2 : Root2); -- illegal - -------------------------------- -Freeze Point for Tagged Types -------------------------------- - -* Freeze point definition does not change - - - A variable of the type is declared - - The type is derived - - The end of the scope is reached - -* Declaring tagged type primitives past freeze point is **forbidden** - -.. code:: Ada - - type Root is tagged null record; - - procedure Prim (V : Root); - - type Child is new Root with null record; -- freeze root - - procedure Prim2 (V : Root); -- illegal - - V : Child; -- freeze child - - procedure Prim3 (V : Child); -- illegal - ------------------- -Tagged Aggregate ------------------- - -* At initialization, all fields (including **inherited**) must have a **value** - - .. code:: Ada - - type Root is tagged record - F1 : Integer; - end record; - - type Child is new Root with record - F2 : Integer; - end record; - - V : Child := (F1 => 0, F2 => 0); - -* For **private types** use :dfn:`aggregate extension` - - - Copy of a parent instance - - Use :ada:`with null record` absent new fields - - .. code:: Ada - - V2 : Child := (Parent_Instance with F2 => 0); - V3 : Empty_Child := (Parent_Instance with null record); - -`Click here for more information on aggregates of private extensions `_ - ---------------------- -Overriding Indicators ---------------------- - -* Optional :ada:`overriding` and :ada:`not overriding` indicators - - .. code:: Ada - - type Shape_T is tagged record - Name : String (1..10); - end record; - - -- primitives of "Shape_T" - procedure Set_Name (S : in out Shape_T); - function Name (S : Shape_T) return String; - - -- Derive "Point" from Shape_T - type Point is new Shape_T with record - Origin : Coord_T; - end Point; - - -- We want to _change_ the behavior of Set_Name - overriding procedure Set_Name (P : in out Point_T); - -- We want to _add_ a new primitive - not overriding Origin (P : Point_T) return Point_T; - -- We get "Name" for free - -.. - language_version 2005 - ------------------ -Prefix Notation ------------------ - -* Tagged types primitives can be called as usual -* The call can use prefixed notation - - - **If** the first argument is a controlling parameter - - No need for :ada:`use` or :ada:`use type` for visibility - - .. code:: Ada - - -- Prim1 visible even without *use Pkg* - X.Prim1; - - declare - use Pkg; - begin - Prim1 (X); - end; - -.. - language_version 2012 - ------- -Quiz ------- - -.. include:: quiz/tagged_primitives/quiz.rst - ------- -Quiz ------- - -.. include:: quiz/tagged_dot_and_with/quiz.rst - ------- -Quiz ------- - -Which code block(s) is (are) legal? - -.. container:: columns - - .. container:: column - - A. | ``type A1 is record`` - | ``Field1 : Integer;`` - | ``end record;`` - | ``type A2 is new A1 with null record;`` - B. | :answermono:`type B1 is tagged record` - | :answermono:`Field2 : Integer;` - | :answermono:`end record;` - | :answermono:`type B2 is new B1 with record` - | :answermono:`Field2b : Integer;` - | :answermono:`end record;` - - .. container:: column - - C. | ``type C1 is tagged record`` - | ``Field3 : Integer;`` - | ``end record;`` - | ``type C2 is new C1 with record`` - | ``Field3 : Integer;`` - | ``end record;`` - D. | ``type D1 is tagged record`` - | ``Field1 : Integer;`` - | ``end record;`` - | ``type D2 is new D1;`` - -.. container:: animate - - Explanations - - A. Cannot extend a non-tagged type - B. Correct - C. Components must have distinct names - D. Types derived from a tagged type must have an extension - -======== -Lab -======== - -.. include:: labs/intro_170_tagged_derivation.lab.rst - -========= -Summary -========= - ---------- -Summary ---------- - -* Tagged derivation - - - Building block for OOP types in Ada - -* Primitives rules for tagged types are trickier - - - Primitives **forbidden** below freeze point - - **Unique** controlling parameter - - Tip: Keep the number of tagged type per package low - -================================================= -Additional Information - Extending Tagged Types -================================================= - ----------------------------------- -How Do You Extend a Tagged Type? ----------------------------------- - -* Premise of a tagged type is to :dfn:`extend` an existing type - -* In general, that means we want to add more fields - - * We can extend a :ada:`tagged` type by adding fields - - .. code:: Ada - - package Animals is - type Animal_T is tagged record - Age : Natural; - end record; - end Animals; - - with Animals; use Animals; - package Mammals is - type Mammal_T is new Animal_T with record - Number_Of_Legs : Natural; - end record; - end Mammals; - - with Mammals; use Mammals; - package Canines is - type Canine_T is new Mammal_T with record - Domesticated : Boolean; - end record; - end Canines; - -------------------- -Tagged Aggregates -------------------- - -* At initialization, all fields (including **inherited**) must have a **value** - - .. code:: Ada - - Animal : Animal_T := (Age => 1); - Mammal : Mammal_T := (Age => 2, - Number_Of_Legs => 2); - Canine : Canine_T := (Age => 2, - Number_Of_Legs => 4, - Domesticated => True); - -* But we can also "seed" the aggregate with a parent object - - .. code:: Ada - - Mammal := (Animal with Number_Of_Legs => 4); - Canine := (Animal with Number_Of_Legs => 4, - Domesticated => False); - Canine := (Mammal with Domesticated => True); - ----------------------- -Private Tagged Types ----------------------- - -* But data hiding says types should be private! - -* So we can define our base type as private - - .. container:: latex_environment tiny - - .. code:: Ada - - package Animals is - type Animal_T is tagged private; - function Get_Age (P : Animal_T) return Natural; - procedure Set_Age (P : in out Animal_T; A : Natural); - private - type Animal_T is tagged record - Age : Natural; - end record; - end Animals; - -* And still allow derivation - - .. container:: latex_environment tiny - - .. code:: Ada - - with Animals; - package Mammals is - type Mammal_T is new Animals.Animal_T with record - Number_Of_Legs : Natural; - end record; - -* But now the only way to get access to :ada:`Age` is with accessor subprograms - --------------------- -Private Extensions --------------------- - -* In the previous slide, we exposed the fields for :ada:`Mammal_T`! - -* Better would be to make the extension itself private - - .. code:: Ada - - package Mammals is - type Mammal_T is new Animals.Animal_T with private; - private - type Mammal_T is new Animals.Animal_T with record - Number_Of_Legs : Natural; - end record; - end Mammals; - -`Click here to go back to Type Extension `_ - --------------------------------------- -Aggregates with Private Tagged Types --------------------------------------- - -* Remember, an aggregate must specify values for all components - - * But with private types, we can't see all the components! - -* So we need to use the "seed" method: - - .. code:: Ada - - procedure Inside_Mammals_Pkg is - Animal : Animal_T := Animals.Create; - Mammal : Mammal_T; - begin - Mammal := (Animal with Number_Of_Legs => 4); - Mammal := (Animals.Create with Number_Of_Legs => 4); - end Inside_Mammals_Pkg; - -* Note that we cannot use :ada:`others => <>` for components that are not visible to us - - .. code:: Ada - - Mammal := (Number_Of_Legs => 4, - others => <>); -- Compile Error - ------------------ -Null Extensions ------------------ - -* To create a new type with no additional fields - - * We still need to "extend" the record - we just do it with an empty record - - .. code:: Ada - - type Dog_T is new Canine_T with null record; - - -* We still need to specify the "added" fields in an aggregate - - .. code:: Ada - - C : Canine_T := Canines.Create; - Dog1 : Dog_T := C; -- Compile Error - Dog2 : Dog_T := (C with null record); - -`Click here to go back to Tagged Aggregate `_ - ------- -Quiz ------- - -Given the following code: - - .. code::ada - - package Parents is - type Parent_T is tagged private; - function Create return Parent_T; - private - type Parent_T is tagged record - Id : Integer; - end record; - end Parents; - - with Parents; use Parents; - package Children is - P : Parent_T; - type Child_T is new Parent_T with record - Count : Natural; - end record; - function Create (C : Natural) return Child_T; - end Children; - -Which completion(s) of Create is (are) valid? - - A. :answermono:`function Create return Child_T is (Parents.Create with Count => 0);` - B. ``function Create return Child_T is (others => <>);`` - B. ``function Create return Child_T is (0, 0);`` - D. :answermono:`function Create return Child_T is (P with Count => 0);` - -.. container:: animate - - Explanations - - A. Correct - :ada:`Parents.Create` returns :ada:`Parent_T` - B. Cannot use :ada:`others` to complete private part of an aggregate - C. Aggregate has no visibility to :ada:`Id` field, so cannot assign - D. Correct - :ada:`P` is a :ada:`Parent_T` diff --git a/courses/fundamentals_of_ada/labs/intro_170_tagged_derivation.lab.rst b/courses/fundamentals_of_ada/labs/170_tagged_derivation-simple.lab.rst similarity index 68% rename from courses/fundamentals_of_ada/labs/intro_170_tagged_derivation.lab.rst rename to courses/fundamentals_of_ada/labs/170_tagged_derivation-simple.lab.rst index e220b768a..e8c42d728 100644 --- a/courses/fundamentals_of_ada/labs/intro_170_tagged_derivation.lab.rst +++ b/courses/fundamentals_of_ada/labs/170_tagged_derivation-simple.lab.rst @@ -1,3 +1,7 @@ +======== +Lab +======== + ----------------------- Tagged Derivation Lab ----------------------- @@ -21,16 +25,16 @@ Tagged Derivation Lab Tagged Derivation Lab Solution - Types (Spec) ----------------------------------------------- -.. container:: source_include labs/answers/intro_170_tagged_derivation.txt :start-after:--Types_Spec :end-before:--Types_Spec :code:Ada :number-lines:1 +.. container:: source_include labs/answers/170_tagged_derivation-simple.txt :start-after:--Types_Spec :end-before:--Types_Spec :code:Ada :number-lines:1 ------------------------------------------------------- Tagged Derivation Lab Solution - Types (Partial Body) ------------------------------------------------------- -.. container:: source_include labs/answers/intro_170_tagged_derivation.txt :start-after:--Types_Body :end-before:--Types_Body :code:Ada :number-lines:1 +.. container:: source_include labs/answers/170_tagged_derivation-simple.txt :start-after:--Types_Body :end-before:--Types_Body :code:Ada :number-lines:1 --------------------------------------- Tagged Derivation Lab Solution - Main --------------------------------------- -.. container:: source_include labs/answers/intro_170_tagged_derivation.txt :start-after:--Main :end-before:--Main :code:Ada :number-lines:1 +.. container:: source_include labs/answers/170_tagged_derivation-simple.txt :start-after:--Main :end-before:--Main :code:Ada :number-lines:1 diff --git a/courses/fundamentals_of_ada/labs/170_tagged_derivation.lab.rst b/courses/fundamentals_of_ada/labs/170_tagged_derivation.lab.rst index e285afc4b..4b73bef9d 100644 --- a/courses/fundamentals_of_ada/labs/170_tagged_derivation.lab.rst +++ b/courses/fundamentals_of_ada/labs/170_tagged_derivation.lab.rst @@ -1,3 +1,7 @@ +======== +Lab +======== + ----------------------- Tagged Derivation Lab ----------------------- diff --git a/courses/fundamentals_of_ada/labs/adv_170_multiple_inheritance.lab.rst b/courses/fundamentals_of_ada/labs/175_multiple_inheritance.lab.rst similarity index 61% rename from courses/fundamentals_of_ada/labs/adv_170_multiple_inheritance.lab.rst rename to courses/fundamentals_of_ada/labs/175_multiple_inheritance.lab.rst index 3ccd5c2fc..81b12ddcd 100644 --- a/courses/fundamentals_of_ada/labs/adv_170_multiple_inheritance.lab.rst +++ b/courses/fundamentals_of_ada/labs/175_multiple_inheritance.lab.rst @@ -1,3 +1,7 @@ +======== +Lab +======== + ------------------------------------------ Multiple Inheritance Lab ------------------------------------------ @@ -27,41 +31,41 @@ Multiple Inheritance Lab Inheritance Lab Solution - Data Types --------------------------------------- -.. container:: source_include labs/answers/adv_170_multiple_inheritance.txt :start-after:--Types :end-before:--Types :code:Ada :number-lines:1 +.. container:: source_include labs/answers/175_multiple_inheritance.txt :start-after:--Types :end-before:--Types :code:Ada :number-lines:1 --------------------------------------- Inheritance Lab Solution - Shapes --------------------------------------- -.. container:: source_include labs/answers/adv_170_multiple_inheritance.txt :start-after:--Shapes :end-before:--Shapes :code:Ada :number-lines:1 +.. container:: source_include labs/answers/175_multiple_inheritance.txt :start-after:--Shapes :end-before:--Shapes :code:Ada :number-lines:1 ------------------------------------------- Inheritance Lab Solution - Drawing (Spec) ------------------------------------------- -.. container:: source_include labs/answers/adv_170_multiple_inheritance.txt :start-after:--Drawing_Spec :end-before:--Drawing_Spec :code:Ada :number-lines:1 +.. container:: source_include labs/answers/175_multiple_inheritance.txt :start-after:--Drawing_Spec :end-before:--Drawing_Spec :code:Ada :number-lines:1 ------------------------------------------- Inheritance Lab Solution - Drawing (Body) ------------------------------------------- -.. container:: source_include labs/answers/adv_170_multiple_inheritance.txt :start-after:--Drawing_Body :end-before:--Drawing_Body :code:Ada :number-lines:1 +.. container:: source_include labs/answers/175_multiple_inheritance.txt :start-after:--Drawing_Body :end-before:--Drawing_Body :code:Ada :number-lines:1 --------------------------------------------- Inheritance Lab Solution - Printable Object --------------------------------------------- -.. container:: source_include labs/answers/adv_170_multiple_inheritance.txt :start-after:--Printable_Object :end-before:--Printable_Object :code:Ada :number-lines:1 +.. container:: source_include labs/answers/175_multiple_inheritance.txt :start-after:--Printable_Object :end-before:--Printable_Object :code:Ada :number-lines:1 --------------------------------------------- Inheritance Lab Solution - Rectangle --------------------------------------------- -.. container:: source_include labs/answers/adv_170_multiple_inheritance.txt :start-after:--Rectangle :end-before:--Rectangle :code:Ada :number-lines:1 +.. container:: source_include labs/answers/175_multiple_inheritance.txt :start-after:--Rectangle :end-before:--Rectangle :code:Ada :number-lines:1 --------------------------------------------- Inheritance Lab Solution - Main --------------------------------------------- -.. container:: source_include labs/answers/adv_170_multiple_inheritance.txt :start-after:--Main :end-before:--Main :code:Ada :number-lines:1 +.. container:: source_include labs/answers/175_multiple_inheritance.txt :start-after:--Main :end-before:--Main :code:Ada :number-lines:1 diff --git a/courses/fundamentals_of_ada/labs/answers/intro_170_tagged_derivation.txt b/courses/fundamentals_of_ada/labs/answers/170_tagged_derivation-simple.txt similarity index 100% rename from courses/fundamentals_of_ada/labs/answers/intro_170_tagged_derivation.txt rename to courses/fundamentals_of_ada/labs/answers/170_tagged_derivation-simple.txt diff --git a/courses/fundamentals_of_ada/labs/answers/adv_170_multiple_inheritance.txt b/courses/fundamentals_of_ada/labs/answers/175_multiple_inheritance.txt similarity index 100% rename from courses/fundamentals_of_ada/labs/answers/adv_170_multiple_inheritance.txt rename to courses/fundamentals_of_ada/labs/answers/175_multiple_inheritance.txt diff --git a/courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/base_types.ads b/courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/base_types.ads similarity index 100% rename from courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/base_types.ads rename to courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/base_types.ads diff --git a/courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/default.gpr b/courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/default.gpr similarity index 100% rename from courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/default.gpr rename to courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/default.gpr diff --git a/courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/geometry.ads b/courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/geometry.ads similarity index 100% rename from courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/geometry.ads rename to courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/geometry.ads diff --git a/courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/line_draw.adb b/courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/line_draw.adb similarity index 100% rename from courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/line_draw.adb rename to courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/line_draw.adb diff --git a/courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/line_draw.ads b/courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/line_draw.ads similarity index 100% rename from courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/line_draw.ads rename to courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/line_draw.ads diff --git a/courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/main.adb b/courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/main.adb similarity index 100% rename from courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/main.adb rename to courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/main.adb diff --git a/courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/printable_object.adb b/courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/printable_object.adb similarity index 100% rename from courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/printable_object.adb rename to courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/printable_object.adb diff --git a/courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/printable_object.ads b/courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/printable_object.ads similarity index 100% rename from courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/printable_object.ads rename to courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/printable_object.ads diff --git a/courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/rectangle.adb b/courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/rectangle.adb similarity index 100% rename from courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/rectangle.adb rename to courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/rectangle.adb diff --git a/courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/rectangle.ads b/courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/rectangle.ads similarity index 100% rename from courses/fundamentals_of_ada/labs/prompts/adv_170_multiple_inheritance/rectangle.ads rename to courses/fundamentals_of_ada/labs/prompts/175_multiple_inheritance/rectangle.ads diff --git a/courses/fundamentals_of_ada/opat.txt b/courses/fundamentals_of_ada/opat.txt index d9012a5a0..d2807d5ea 100644 --- a/courses/fundamentals_of_ada/opat.txt +++ b/courses/fundamentals_of_ada/opat.txt @@ -13,7 +13,7 @@ 110_private_types.rst 130_program_structure.rst 135_visibility.rst -intro_170_tagged_derivation.rst +170_tagged_derivation-intro.rst 190_exceptions.rst 140_access_types.rst 160_genericity.rst diff --git a/courses/fundamentals_of_ada/standard_course.txt b/courses/fundamentals_of_ada/standard_course.txt index e34585337..51c6e04fd 100644 --- a/courses/fundamentals_of_ada/standard_course.txt +++ b/courses/fundamentals_of_ada/standard_course.txt @@ -16,7 +16,7 @@ 135_visibility.rst 140_access_types.rst 160_genericity.rst -intro_170_tagged_derivation.rst +170_tagged_derivation-intro.rst 180_polymorphism.rst 190_exceptions.rst 230_interfacing_with_c.rst