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. package Values.Booleans is 
  10.  
  11.     type Boolean_Value is new Value with private; 
  12.     type Boolean_Ptr is new Value_Ptr with private; 
  13.  
  14.     function Create( val : Boolean ) return Boolean_Ptr; 
  15.  
  16.     overriding 
  17.     function Clone( this : access Boolean_Value ) return Value_Ptr'Class; 
  18.  
  19.     overriding 
  20.     function Compare( this : Boolean_Value; other : Value'Class ) return Integer; 
  21.  
  22.     overriding 
  23.     function Get_Type( this : Boolean_Value ) return Value_Type; 
  24.  
  25.     overriding 
  26.     function Image( this : Boolean_Value ) return String; 
  27.  
  28.     -- Access the internal value 
  29.     function To_Boolean( this : Boolean_Value ) return Boolean; 
  30.  
  31.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  32.  
  33.     -- Unary logical operators 
  34.     function "not"( l : Boolean_Value ) return Boolean_Ptr'Class; pragma Inline( "not" ); 
  35.  
  36.     -- Binary logical operators 
  37.     function "and"( l, r : Boolean_Value ) return Boolean_Ptr'Class; pragma Inline( "and" ); 
  38.     function  "or"( l, r : Boolean_Value ) return Boolean_Ptr'Class; pragma Inline( "or" ); 
  39.     function "xor"( l, r : Boolean_Value ) return Boolean_Ptr'Class; pragma Inline( "xor" ); 
  40.  
  41.     ---------------------------------------------------------------------------- 
  42.  
  43.     -- Casts a Value_Ptr down to a Boolean_Ptr. Returns Nul on failure. 
  44.     function As_Boolean( ptr : Value_Ptr'Class ) return Boolean_Ptr; 
  45.  
  46.     -- Casts a Boolean_Ptr up to a Value_Ptr. 
  47.     function As_Value( this : Boolean_Ptr ) return Value_Ptr; 
  48.  
  49.     -- Returns an access to the Boolean_Ptr, or null if no target. 
  50.     function Get( this : Boolean_Ptr ) return access Boolean_Value'Class; pragma Inline( Get ); 
  51.  
  52.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  53.  
  54.     -- The following logical operators are equivalent to "[op] l.Get" 
  55.     -- 'l' must have a target or the behavior is undefined. 
  56.     function "not"( l : Boolean_Ptr ) return Boolean_Ptr; pragma Inline( "not" ); 
  57.  
  58.     -- The following logical operators are equivalent to "l.Get [op] r.Get" 
  59.     -- Both 'l' and 'r' must have targets or the behavior is undefined. 
  60.     function "and"( l, r : Boolean_Ptr ) return Boolean_Ptr; pragma Inline( "and" ); 
  61.     function  "or"( l, r : Boolean_Ptr ) return Boolean_Ptr; pragma Inline( "or" ); 
  62.     function "xor"( l, r : Boolean_Ptr ) return Boolean_Ptr; pragma Inline( "xor" ); 
  63.  
  64.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  65.  
  66.     -- The following operators are useful for mixing Boolean_Ptrs with the 
  67.     -- primitive boolean type. Equivalent to: "l [op] Create( r )" 
  68.     function "="( l : Boolean_Ptr; r : Boolean ) return Boolean; pragma Inline( "=" ); 
  69.  
  70.     function "and"( l : Boolean_Ptr; r : Boolean ) return Boolean_Ptr; pragma Inline( "and" ); 
  71.     function  "or"( l : Boolean_Ptr; r : Boolean ) return Boolean_Ptr; pragma Inline( "or" ); 
  72.     function "xor"( l : Boolean_Ptr; r : Boolean ) return Boolean_Ptr; pragma Inline( "xor" ); 
  73.  
  74.     function "="( l : Boolean; r : Boolean_Ptr ) return Boolean; pragma Inline( "=" ); 
  75.  
  76.     function "and"( l : Boolean; r : Boolean_Ptr ) return Boolean_Ptr; pragma Inline( "and" ); 
  77.     function  "or"( l : Boolean; r : Boolean_Ptr ) return Boolean_Ptr; pragma Inline( "or" ); 
  78.     function "xor"( l : Boolean; r : Boolean_Ptr ) return Boolean_Ptr; pragma Inline( "xor" ); 
  79.  
  80.     Nul : constant Boolean_Ptr; 
  81.  
  82. private 
  83.  
  84.     type Boolean_Value is new Value with 
  85.         record 
  86.             val : Boolean := False; 
  87.         end record; 
  88.     type A_Naked_Boolean is access all Boolean_Value'Class; 
  89.  
  90.     overriding 
  91.     function Value_Input( stream : access Root_Stream_Type'Class ) return Boolean_Value; 
  92.     for Boolean_Value'Input use Value_Input; 
  93.  
  94.     overriding 
  95.     procedure Value_Read( stream : access Root_Stream_Type'Class; this : out Boolean_Value ); 
  96.     for Boolean_Value'Read use Value_Read; 
  97.  
  98.     procedure Value_Write( stream : access Root_Stream_Type'Class; this : Boolean_Value ); 
  99.     for Boolean_Value'Write use Value_Write; 
  100.  
  101.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  102.  
  103.     type Boolean_Ptr is new Value_Ptr with null record; 
  104.  
  105.     Nul : constant Boolean_Ptr := (Value_Ptr with others => <>); 
  106.  
  107. end Values.Booleans;