1. with Ada.Streams;                       use Ada.Streams; 
  2. with Objects;                           use Objects; 
  3.  
  4. private with Ada.Strings.Unbounded; 
  5.  
  6. package Values is 
  7.  
  8.     -- Defines the base data types supported by Values. 
  9.     type Data_Type is (V_NULL, V_BOOLEAN, V_NUMERIC, V_STRING); 
  10.  
  11.     -- A Value represents a generic value of type boolean, integer or string. 
  12.     -- The value can be converted to other types in certain cases. Values can 
  13.     -- also be copied and written to a stream. 
  14.     type Value is abstract new Object with private; 
  15.     type A_Value is access all Value'Class; 
  16.  
  17.     -- Creates a new boolean Value. 
  18.     function Create_Value( val : Boolean ) return A_Value; 
  19.     pragma Postcondition( Create_Value'Result /= null ); 
  20.  
  21.     -- Creates a new integer Value. 
  22.     function Create_Value( val : Integer ) return A_Value; 
  23.     pragma Postcondition( Create_Value'Result /= null ); 
  24.  
  25.     -- Creates a new string Value. 
  26.     function Create_Value( val : String ) return A_Value; 
  27.     pragma Postcondition( Create_Value'Result /= null ); 
  28.  
  29.     -- Returns the Value as a boolean. Raises INVALID_CONVERSION if the value 
  30.     -- can't be converted to a boolean. 
  31.     function As_Boolean( this : access Value ) return Boolean; 
  32.  
  33.     -- Returns the Value as a boolean. Raises INVALID_CONVERSION if the value 
  34.     -- can't be converted to an integer. 
  35.     function As_Integer( this : access Value ) return Integer; 
  36.  
  37.     -- Returns the Value as a boolean. Raises INVALID_CONVERSION if the value 
  38.     -- can't be converted to a string. 
  39.     function As_String( this : access Value ) return String; 
  40.  
  41.     -- Returns the base data type the Value contains. A null Value reference 
  42.     -- will return V_NULL. 
  43.     function Get_Type( this : access Value'Class ) return Data_Type; 
  44.  
  45.     function Object_Input( stream : access Root_Stream_Type'Class ) return Value is abstract; 
  46.  
  47.     -- Compares 'this' to 'that'. Returns 0 for equal, < 0 if 'this' is less 
  48.     -- than 'that', and > 0 if 'this' is greater than 'that'. If 'that' is a 
  49.     -- different data type then the result is undefined because they are not 
  50.     -- equal and not comparable. 
  51.     function Compare( this : access Value; that : A_Value ) return Integer is abstract; 
  52.  
  53.     -- Returns a copy of 'src'. 
  54.     function Copy( src : A_Value ) return A_Value; 
  55.     pragma Postcondition( Copy'Result /= src or else src = null ); 
  56.  
  57.     -- Deletes the Value. 
  58.     procedure Delete( this : in out A_Value ); 
  59.     pragma Postcondition( this = null ); 
  60.  
  61.     -- Returns the same as To_String but allows for a null pointer. 
  62.     function Img( this : A_Value ) return String; 
  63.  
  64.     ---------------------------------------------------------------------------- 
  65.  
  66.     VALUE_NOT_FOUND, 
  67.     INVALID_CONVERSION : exception; 
  68.  
  69. private 
  70.  
  71.     use Ada.Strings.Unbounded; 
  72.  
  73.     type Value is abstract new Object with 
  74.         record 
  75.             dataType : Data_Type := V_NULL; 
  76.         end record; 
  77.  
  78.     procedure Construct( this : access Value; dataType : Data_Type ); 
  79.  
  80.     procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out Value ); 
  81.     for Value'Read use Object_Read; 
  82.  
  83.     procedure Object_Write( stream : access Root_Stream_Type'Class; obj : Value ); 
  84.     for Value'Write use Object_Write; 
  85.  
  86.     function A_Value_Input( stream : access Root_Stream_Type'Class ) return A_Value; 
  87.     for A_Value'Input use A_Value_Input; 
  88.  
  89.     procedure A_Value_Output( stream : access Root_Stream_Type'Class; obj : A_Value ); 
  90.     for A_Value'Output use A_Value_Output; 
  91.  
  92.     procedure A_Value_Read( stream : access Root_Stream_Type'Class; obj : out A_Value ); 
  93.     for A_Value'Read use A_Value_Read; 
  94.  
  95.     procedure A_Value_Write( stream : access Root_Stream_Type'Class; obj : A_Value ); 
  96.     for A_Value'Write use A_Value_Write; 
  97.  
  98.     ---------------------------------------------------------------------------- 
  99.  
  100.     type Val_Bool is new Value with 
  101.         record 
  102.             bool : Boolean; 
  103.         end record; 
  104.  
  105.     -- Returns the value as a boolean. 
  106.     function As_Boolean( this : access Val_Bool ) return Boolean; 
  107.  
  108.     -- Returns 1 or 0 if the value is True or False, respectively. 
  109.     function As_Integer( this : access Val_Bool ) return Integer; 
  110.  
  111.     -- Returns "True" or "False". 
  112.     function As_String( this : access Val_Bool ) return String; 
  113.  
  114.     function Compare( this : access Val_Bool; that : A_Value ) return Integer; 
  115.  
  116.     function Object_Input( stream : access Root_Stream_Type'Class ) return Val_Bool; 
  117.     for Val_Bool'Input use Object_Input; 
  118.  
  119.     procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out Val_Bool ); 
  120.     for Val_Bool'Read use Object_Read; 
  121.  
  122.     procedure Object_Write( stream : access Root_Stream_Type'Class; obj : Val_Bool ); 
  123.     for Val_Bool'Write use Object_Write; 
  124.  
  125.     -- Returns "True" or "False". 
  126.     function To_String( this : access Val_Bool ) return String; 
  127.  
  128.     ---------------------------------------------------------------------------- 
  129.  
  130.     type Val_Int is new Value with 
  131.         record 
  132.             int : Integer; 
  133.         end record; 
  134.  
  135.     -- Returns True if the value is non-zero. 
  136.     function As_Boolean( this : access Val_Int ) return Boolean; 
  137.  
  138.     -- Returns the value as an integer. 
  139.     function As_Integer( this : access Val_Int ) return Integer; 
  140.  
  141.     -- Returns a string representation of the integer. 
  142.     function As_String( this : access Val_Int ) return String; 
  143.  
  144.     function Compare( this : access Val_Int; that : A_Value ) return Integer; 
  145.  
  146.     function Object_Input( stream : access Root_Stream_Type'Class ) return Val_Int; 
  147.     for Val_Int'Input use Object_Input; 
  148.  
  149.     procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out Val_Int ); 
  150.     for Val_Int'Read use Object_Read; 
  151.  
  152.     procedure Object_Write( stream : access Root_Stream_Type'Class; obj : Val_Int ); 
  153.     for Val_Int'Write use Object_Write; 
  154.  
  155.     -- Returns a string representation of the integer. 
  156.     function To_String( this : access Val_Int ) return String; 
  157.  
  158.     ---------------------------------------------------------------------------- 
  159.  
  160.     type Val_String is new Value with 
  161.         record 
  162.             str : Unbounded_String; 
  163.         end record; 
  164.  
  165.     procedure Adjust( this : access Val_String ); 
  166.  
  167.     -- Returns the string value. 
  168.     function As_String( this : access Val_String ) return String; 
  169.  
  170.     function Compare( this : access Val_String; that : A_Value ) return Integer; 
  171.  
  172.     function Object_Input( stream : access Root_Stream_Type'Class ) return Val_String; 
  173.     for Val_String'Input use Object_Input; 
  174.  
  175.     procedure Object_Read( stream : access Root_Stream_Type'Class; obj : out Val_String ); 
  176.     for Val_String'Read use Object_Read; 
  177.  
  178.     procedure Object_Write( stream : access Root_Stream_Type'Class; obj : Val_String ); 
  179.     for Val_String'Write use Object_Write; 
  180.  
  181.     -- Returns the string value surrounded by double quotes. 
  182.     function To_String( this : access Val_String ) return String; 
  183.  
  184. end Values;