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.Numbers is 
  10.  
  11.     type Number_Value is new Value with private; 
  12.     type Number_Ptr is new Value_Ptr with private; 
  13.  
  14.     -- Constructors 
  15.     function Create( val : Integer ) return Number_Ptr; 
  16.     function Create( val : Long_Float ) return Number_Ptr; 
  17.  
  18.     overriding 
  19.     function Clone( this : access Number_Value ) return Value_Ptr'Class; 
  20.  
  21.     overriding 
  22.     function Compare( this : Number_Value; other : Value'Class ) return Integer; 
  23.  
  24.     overriding 
  25.     function Get_Type( this : Number_Value ) return Value_Type; 
  26.  
  27.     overriding 
  28.     function Image( this : Number_Value ) return String; 
  29.  
  30.     -- Access the internal value 
  31.     function To_Float( this : Number_Value ) return Float; 
  32.     function To_Int( this : Number_Value ) return Integer; 
  33.  
  34.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  35.  
  36.     -- Unary arithmetic operators 
  37.     function   "-"( l : Number_Value ) return Number_Ptr'Class; pragma Inline( "-" ); 
  38.     function "abs"( l : Number_Value ) return Number_Ptr'Class; pragma Inline( "abs" ); 
  39.  
  40.     -- Binary arithmetic operators 
  41.     function   "+"( l, r : Number_Value ) return Number_Ptr'Class; pragma Inline( "+" ); 
  42.     function   "-"( l, r : Number_Value ) return Number_Ptr'Class; pragma Inline( "-" ); 
  43.     function   "*"( l, r : Number_Value ) return Number_Ptr'Class; pragma Inline( "*" ); 
  44.     function   "/"( l, r : Number_Value ) return Number_Ptr'Class; pragma Inline( "/" ); 
  45.     function  "**"( l, r : Number_Value ) return Number_Ptr'Class; pragma Inline( "**" ); 
  46.     function "mod"( l, r : Number_Value ) return Number_Ptr'Class; pragma Inline( "mod" ); 
  47.     function "rem"( l, r : Number_Value ) return Number_Ptr'Class; pragma Inline( "rem" ); 
  48.  
  49.     ---------------------------------------------------------------------------- 
  50.  
  51.     -- Casts a Value_Ptr down to a Number_Ptr. Returns Nul on failure. 
  52.     function As_Number( ptr : Value_Ptr'Class ) return Number_Ptr; 
  53.  
  54.     -- Casts a Number_Ptr up to a Value_Ptr. 
  55.     function As_Value( this : Number_Ptr ) return Value_Ptr; 
  56.  
  57.     -- Returns an access to the Number_Value, or null if no target. 
  58.     function Get( this : Number_Ptr ) return access Number_Value'Class; pragma Inline( Get ); 
  59.  
  60.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  61.  
  62.     -- The following arithmetic operators are equivalent to "[op] l.Get" 
  63.     -- 'l' must have a target or the behavior is undefined. 
  64.     function   "-"( l : Number_Ptr ) return Number_Ptr; pragma Inline( "-" ); 
  65.     function "abs"( l : Number_Ptr ) return Number_Ptr; pragma Inline( "abs" ); 
  66.  
  67.     -- The following arithmetic operators are equivalent to "l.Get [op] r.Get" 
  68.     -- Both 'l' and 'r' must have targets or the behavior is undefined. 
  69.     function   "+"( l, r : Number_Ptr ) return Number_Ptr; pragma Inline( "+" ); 
  70.     function   "-"( l, r : Number_Ptr ) return Number_Ptr; pragma Inline( "-" ); 
  71.     function   "*"( l, r : Number_Ptr ) return Number_Ptr; pragma Inline( "*" ); 
  72.     function   "/"( l, r : Number_Ptr ) return Number_Ptr; pragma Inline( "/" ); 
  73.     function  "**"( l, r : Number_Ptr ) return Number_Ptr; pragma Inline( "**" ); 
  74.     function "mod"( l, r : Number_Ptr ) return Number_Ptr; pragma Inline( "mod" ); 
  75.     function "rem"( l, r : Number_Ptr ) return Number_Ptr; pragma Inline( "rem" ); 
  76.  
  77.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  78.  
  79.     -- The following operators are useful for mixing Number_Ptrs with primitive 
  80.     -- number types. Equivalent to: "l [op] Create( r )" 
  81.     function  "="( l : Number_Ptr; r : Integer    ) return Boolean; pragma Inline( "=" ); 
  82.     function  "="( l : Number_Ptr; r : Long_Float ) return Boolean; pragma Inline( "=" ); 
  83.     function  "<"( l : Number_Ptr; r : Integer    ) return Boolean; pragma Inline( "<" ); 
  84.     function  "<"( l : Number_Ptr; r : Long_Float ) return Boolean; pragma Inline( "<" ); 
  85.     function  ">"( l : Number_Ptr; r : Integer    ) return Boolean; pragma Inline( ">" ); 
  86.     function  ">"( l : Number_Ptr; r : Long_Float ) return Boolean; pragma Inline( ">" ); 
  87.     function "<="( l : Number_Ptr; r : Integer    ) return Boolean; pragma Inline( "<=" ); 
  88.     function "<="( l : Number_Ptr; r : Long_Float ) return Boolean; pragma Inline( "<=" ); 
  89.     function ">="( l : Number_Ptr; r : Integer    ) return Boolean; pragma Inline( ">=" ); 
  90.     function ">="( l : Number_Ptr; r : Long_Float ) return Boolean; pragma Inline( ">=" ); 
  91.  
  92.     function  "+"( l : Number_Ptr; r : Integer    ) return Number_Ptr; pragma Inline( "+" ); 
  93.     function  "+"( l : Number_Ptr; r : Long_Float ) return Number_Ptr; pragma Inline( "+" ); 
  94.     function  "-"( l : Number_Ptr; r : Integer    ) return Number_Ptr; pragma Inline( "-" ); 
  95.     function  "-"( l : Number_Ptr; r : Long_Float ) return Number_Ptr; pragma Inline( "-" ); 
  96.     function  "*"( l : Number_Ptr; r : Integer    ) return Number_Ptr; pragma Inline( "*" ); 
  97.     function  "*"( l : Number_Ptr; r : Long_Float ) return Number_Ptr; pragma Inline( "*" ); 
  98.     function  "/"( l : Number_Ptr; r : Integer    ) return Number_Ptr; pragma Inline( "/" ); 
  99.     function  "/"( l : Number_Ptr; r : Long_Float ) return Number_Ptr; pragma Inline( "/" ); 
  100.     function "**"( l : Number_Ptr; r : Integer    ) return Number_Ptr; pragma Inline( "**" ); 
  101.     function "**"( l : Number_Ptr; r : Long_Float ) return Number_Ptr; pragma Inline( "**" ); 
  102.     function "mod"( l : Number_Ptr; r : Integer   ) return Number_Ptr; pragma Inline( "mod" ); 
  103.     function "rem"( l : Number_Ptr; r : Integer   ) return Number_Ptr; pragma Inline( "rem" ); 
  104.  
  105.     function  "="( l : Integer;    r : Number_Ptr ) return Boolean; pragma Inline( "=" ); 
  106.     function  "="( l : Long_Float; r : Number_Ptr ) return Boolean; pragma Inline( "=" ); 
  107.     function  "<"( l : Integer;    r : Number_Ptr ) return Boolean; pragma Inline( "<" ); 
  108.     function  "<"( l : Long_Float; r : Number_Ptr ) return Boolean; pragma Inline( "<" ); 
  109.     function  ">"( l : Integer;    r : Number_Ptr ) return Boolean; pragma Inline( ">" ); 
  110.     function  ">"( l : Long_Float; r : Number_Ptr ) return Boolean; pragma Inline( ">" ); 
  111.     function "<="( l : Integer;    r : Number_Ptr ) return Boolean; pragma Inline( "<=" ); 
  112.     function "<="( l : Long_Float; r : Number_Ptr ) return Boolean; pragma Inline( "<=" ); 
  113.     function ">="( l : Integer;    r : Number_Ptr ) return Boolean; pragma Inline( ">=" ); 
  114.     function ">="( l : Long_Float; r : Number_Ptr ) return Boolean; pragma Inline( ">=" ); 
  115.  
  116.     function  "+"( l : Integer;    r : Number_Ptr ) return Number_Ptr; pragma Inline( "+" ); 
  117.     function  "+"( l : Long_Float; r : Number_Ptr ) return Number_Ptr; pragma Inline( "+" ); 
  118.     function  "-"( l : Integer;    r : Number_Ptr ) return Number_Ptr; pragma Inline( "-" ); 
  119.     function  "-"( l : Long_Float; r : Number_Ptr ) return Number_Ptr; pragma Inline( "-" ); 
  120.     function  "*"( l : Integer;    r : Number_Ptr ) return Number_Ptr; pragma Inline( "*" ); 
  121.     function  "*"( l : Long_Float; r : Number_Ptr ) return Number_Ptr; pragma Inline( "*" ); 
  122.     function  "/"( l : Integer;    r : Number_Ptr ) return Number_Ptr; pragma Inline( "/" ); 
  123.     function  "/"( l : Long_Float; r : Number_Ptr ) return Number_Ptr; pragma Inline( "/" ); 
  124.     function "**"( l : Integer;    r : Number_Ptr ) return Number_Ptr; pragma Inline( "**" ); 
  125.     function "**"( l : Long_Float; r : Number_Ptr ) return Number_Ptr; pragma Inline( "**" ); 
  126.     function "mod"( l : Integer;   r : Number_Ptr ) return Number_Ptr; pragma Inline( "mod" ); 
  127.     function "rem"( l : Integer;   r : Number_Ptr ) return Number_Ptr; pragma Inline( "rem" ); 
  128.  
  129.     Nul : constant Number_Ptr; 
  130.  
  131. private 
  132.  
  133.     type Number_Value is new Value with 
  134.         record 
  135.             val : Long_Float := 0.0; 
  136.         end record; 
  137.     type A_Naked_Number is access all Number_Value'Class; 
  138.  
  139.     overriding 
  140.     function Value_Input( stream : access Root_Stream_Type'Class ) return Number_Value; 
  141.     for Number_Value'Input use Value_Input; 
  142.  
  143.     overriding 
  144.     procedure Value_Read( stream : access Root_Stream_Type'Class; this : out Number_Value ); 
  145.     for Number_Value'Read use Value_Read; 
  146.  
  147.     procedure Value_Write( stream : access Root_Stream_Type'Class; this : Number_Value ); 
  148.     for Number_Value'Write use Value_Write; 
  149.  
  150.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  151.  
  152.     type Number_Ptr is new Value_Ptr with null record; 
  153.  
  154.     Nul : constant Number_Ptr := (Value_Ptr with others => <>); 
  155.  
  156. end Values.Numbers;