1. -- 
  2. -- Copyright (c) 2012-2013 Kevin Wellwood 
  3. -- All rights reserved. 
  4. -- 
  5. -- This source code is distributed under the Modified BSD License. For terms and 
  6. -- conditions, see license.txt. 
  7. -- 
  8.  
  9. private with Ada.Containers.Indefinite_Vectors; 
  10.  
  11. package Values.Lists is 
  12.  
  13.     type List_Value is new Value with private; 
  14.     type List_Ptr is new Value_Ptr with private; 
  15.  
  16.     -- Constructor 
  17.     function Create_List return List_Ptr; 
  18.  
  19.     overriding 
  20.     function Clone( this : access List_Value ) return Value_Ptr'Class; 
  21.  
  22.     overriding 
  23.     function Compare( this : List_Value; other : Value'Class ) return Integer; 
  24.  
  25.     function Get( this : List_Value; index : Positive ) return Value_Ptr; 
  26.  
  27.     overriding 
  28.     function Get_Type( this : List_Value ) return Value_Type; 
  29.  
  30.     overriding 
  31.     function Image( this : List_Value ) return String; 
  32.  
  33.     -- Access and modify the internal value 
  34.  
  35.     procedure Append( this : in out List_Value; val : Value_Ptr'Class ); 
  36.  
  37.     function Length( this : List_Value ) return Natural; 
  38.  
  39.     procedure Set( this : in out List_Value; index : Positive; val : Value_Ptr'Class ); 
  40.  
  41.     ---------------------------------------------------------------------------- 
  42.  
  43.     -- Casts a Value_Ptr down to a List_Value. Returns Nul on failure. 
  44.     function As_List( ptr : Value_Ptr'Class ) return List_Ptr; 
  45.  
  46.     -- Casts a List_Value up to a Value_Ptr. 
  47.     function As_Value( this : List_Ptr ) return Value_Ptr; 
  48.  
  49.     -- Returns an access to the List_Value, or null if no target. 
  50.     function Get( this : List_Ptr ) return access List_Value'Class; 
  51.  
  52.     Nul : constant List_Ptr; 
  53.  
  54. private 
  55.  
  56.     package Value_Vectors is new Ada.Containers.Indefinite_Vectors( Positive, Value_Ptr, "=" ); 
  57.  
  58.     type List_Value is new Value with 
  59.         record 
  60.             val : Value_Vectors.Vector; 
  61.         end record; 
  62.     type A_Naked_List is access all List_Value'Class; 
  63.  
  64.     overriding 
  65.     procedure Delete( this : in out List_Value ); 
  66.  
  67.     overriding 
  68.     function Value_Input( stream : access Root_Stream_Type'Class ) return List_Value; 
  69.     for List_Value'Input use Value_Input; 
  70.  
  71.     overriding 
  72.     procedure Value_Read( stream : access Root_Stream_Type'Class; this : out List_Value ); 
  73.     for List_Value'Read use Value_Read; 
  74.  
  75.     procedure Value_Write( stream : access Root_Stream_Type'Class; this : List_Value ); 
  76.     for List_Value'Write use Value_Write; 
  77.  
  78.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  79.  
  80.     type List_Ptr is new Value_Ptr with null record; 
  81.  
  82.     Nul : constant List_Ptr := (Value_Ptr with others => <>); 
  83.  
  84. end Values.Lists;