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. with Ada.Strings.Unbounded;             use Ada.Strings.Unbounded; 
  10.  
  11. package Values.Strings is 
  12.  
  13.     type String_Value is new Value with private; 
  14.     type String_Ptr is new Value_Ptr with private; 
  15.  
  16.     -- Constructors 
  17.     function Create( val : String ) return String_Ptr; 
  18.     function Create( val : Unbounded_String ) return String_Ptr; 
  19.  
  20.     overriding 
  21.     function Clone( this : access String_Value ) return Value_Ptr'Class; 
  22.  
  23.     overriding 
  24.     function Compare( this : String_Value; other : Value'Class ) return Integer; 
  25.  
  26.     overriding 
  27.     function Get_Type( this : String_Value ) return Value_Type; 
  28.  
  29.     overriding 
  30.     function Image( this : String_Value ) return String; 
  31.  
  32.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  33.  
  34.     -- Access the internal value 
  35.  
  36.     function Length( this : String_Value ) return Natural; 
  37.  
  38.     function To_String( this : String_Value ) return String; 
  39.  
  40.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  41.  
  42.     -- String operators 
  43.     function "&"( l, r : String_Value ) return String_Ptr'Class; 
  44.  
  45.     ---------------------------------------------------------------------------- 
  46.  
  47.     -- Casts a Value_Ptr down to a String_Value. Returns Nul on failure. 
  48.     function As_String( ptr : Value_Ptr'Class ) return String_Ptr; 
  49.  
  50.     -- Casts a String_Value up to a Value_Ptr. 
  51.     function As_Value( this : String_Ptr ) return Value_Ptr; 
  52.  
  53.     -- Returns an access to the String_Value, or null if no target. 
  54.     function Get( this : String_Ptr ) return access String_Value'Class; 
  55.  
  56.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  57.  
  58.     -- The following string operators are equivalent to "l.Get [op] r.Get" 
  59.     -- Both 'l' and 'r' must have targets or the behavior is undefined. 
  60.     function "&"( l, r : String_Ptr ) return String_Ptr; pragma Inline( "&" ); 
  61.  
  62.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  63.  
  64.     -- The following operators are useful for mixing String_Ptrs with primitive 
  65.     -- string types. Equivalent to: "l [op] Create( r )" or "Create( r ) [op] l" 
  66.     function  "="( l : String_Ptr; r : String           ) return Boolean; pragma Inline( "=" ); 
  67.     function  "="( l : String_Ptr; r : Unbounded_String ) return Boolean; pragma Inline( "=" ); 
  68.     function  "<"( l : String_Ptr; r : String           ) return Boolean; pragma Inline( "<" ); 
  69.     function  "<"( l : String_Ptr; r : Unbounded_String ) return Boolean; pragma Inline( "<" ); 
  70.     function  ">"( l : String_Ptr; r : String           ) return Boolean; pragma Inline( ">" ); 
  71.     function  ">"( l : String_Ptr; r : Unbounded_String ) return Boolean; pragma Inline( ">" ); 
  72.     function "<="( l : String_Ptr; r : String           ) return Boolean; pragma Inline( "<=" ); 
  73.     function "<="( l : String_Ptr; r : Unbounded_String ) return Boolean; pragma Inline( "<=" ); 
  74.     function ">="( l : String_Ptr; r : String           ) return Boolean; pragma Inline( ">=" ); 
  75.     function ">="( l : String_Ptr; r : Unbounded_String ) return Boolean; pragma Inline( ">=" ); 
  76.  
  77.     function "&"( l : String_Ptr; r : String           ) return String_Ptr; pragma Inline( "&" ); 
  78.     function "&"( l : String_Ptr; r : Unbounded_String ) return String_Ptr; pragma Inline( "&" ); 
  79.  
  80.     function  "="( l : String;           r : String_Ptr ) return Boolean; pragma Inline( "=" ); 
  81.     function  "="( l : Unbounded_String; r : String_Ptr ) return Boolean; pragma Inline( "=" ); 
  82.     function  "<"( l : String;           r : String_Ptr ) return Boolean; pragma Inline( "<" ); 
  83.     function  "<"( l : Unbounded_String; r : String_Ptr ) return Boolean; pragma Inline( "<" ); 
  84.     function  ">"( l : String;           r : String_Ptr ) return Boolean; pragma Inline( ">" ); 
  85.     function  ">"( l : Unbounded_String; r : String_Ptr ) return Boolean; pragma Inline( ">" ); 
  86.     function "<="( l : String;           r : String_Ptr ) return Boolean; pragma Inline( "<=" ); 
  87.     function "<="( l : Unbounded_String; r : String_Ptr ) return Boolean; pragma Inline( "<=" ); 
  88.     function ">="( l : String;           r : String_Ptr ) return Boolean; pragma Inline( ">=" ); 
  89.     function ">="( l : Unbounded_String; r : String_Ptr ) return Boolean; pragma Inline( ">=" ); 
  90.  
  91.     function "&"( l : String;           r : String_Ptr ) return String_Ptr; pragma Inline( "&" ); 
  92.     function "&"( l : Unbounded_String; r : String_Ptr ) return String_Ptr; pragma Inline( "&" ); 
  93.  
  94.     Nul : constant String_Ptr; 
  95.  
  96.     -- Escapes special characters in a string with backslash notation. 
  97.     -- Tab => \t 
  98.     -- LF  => \n 
  99.     -- CR  => \r 
  100.     -- \   => \\ 
  101.     -- "   => \" 
  102.     function Escape( str : String ) return String; 
  103.  
  104. private 
  105.  
  106.     type String_Value is new Value with 
  107.         record 
  108.             val : Unbounded_String; 
  109.         end record; 
  110.     type A_Naked_String is access all String_Value'Class; 
  111.  
  112.     overriding 
  113.     function Value_Input( stream : access Root_Stream_Type'Class ) return String_Value; 
  114.     for String_Value'Input use Value_Input; 
  115.  
  116.     overriding 
  117.     procedure Value_Read( stream : access Root_Stream_Type'Class; this : out String_Value ); 
  118.     for String_Value'Read use Value_Read; 
  119.  
  120.     procedure Value_Write( stream : access Root_Stream_Type'Class; this : String_Value ); 
  121.     for String_Value'Write use Value_Write; 
  122.  
  123.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  124.  
  125.     type String_Ptr is new Value_Ptr with null record; 
  126.  
  127.     Nul : constant String_Ptr := (Value_Ptr with others => <>); 
  128.  
  129. end Values.Strings;