/pliant/language/type/text/str8.pli
 
 1  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 2  # 
 3  # This program is free software; you can redistribute it and/or 
 4  # modify it under the terms of the GNU General Public License version 2 
 5  # as published by the Free Software Foundation. 
 6  # 
 7  # This program is distributed in the hope that it will be useful, 
 8  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 9  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 10  # GNU General Public License for more details. 
 11  # 
 12  # You should have received a copy of the GNU General Public License 
 13  # version 2 along with this program; if not, write to the Free Software 
 14  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 15   
 16  module "/pliant/install/ring2.pli" 
 17  module "str32.pli" 
 18   
 19   
 20  type Str8 
 21    field Str content 
 22   
 23   
 24  method s characters -> adr 
 25    arg Str8 s ; arg Address adr 
 26    adr := s:content characters 
 27   
 28   
 29  method s len -> l 
 30    arg Str8 s ; arg Int l 
 31    := s:content len 
 32   
 33   
 34  method s set adr len allocated 
 35    arg_rw Str8 s ; arg Address adr ; arg Int len ; arg CBool allocated 
 36    s:content set adr len allocated 
 37   
 38   
 39  method s '' i -> c 
 40    arg Str8 s ; arg Int i ; arg_C Char c 
 41    :> s:content i 
 42  # ((the_function '' Str8 Int -> Char) arg 2) maps := 1 
 43   
 44  method s '' i j -> sub 
 45    arg Str8 s ; arg Int j ; arg Str8 sub 
 46    check i>=and j>=0 
 47    var Int := min s:len-i 
 48    sub set (s:characters translate Char i) false 
 49  ((the_function '' Str8 Int Int -> Str8) arg 3) maps := 1 
 50   
 51   
 52  function 'cast Str' s8 -> s 
 53    arg Str8 s8 ; arg Str s 
 54    extension 
 55    if default_charset_is_utf8 
 56      var Int := s8:content len 
 57      (var Str32 s32) set (memory_allocate l*Char32:size addressof:s32) true 
 58      for (var Int i) l-1 
 59        s32 := character32 s8:content:i:number 
 60      := s32 
 61    else 
 62      s := s8 content 
 63   
 64   
 65  function 'cast Str8' s -> s8 
 66    arg Str s ; arg Str8 s8 
 67    reduction 
 68    if default_charset_is_utf8 
 69      var Str32 s32 := s 
 70      var Int := s32 len 
 71      s8:content set (memory_allocate l*Char:size addressof:s8) true 
 72      for (var Int i) l-1 
 73        s8:content := character (s32:i:number .and. 255) 
 74    else 
 75      s8 content := s 
 76   
 77   
 78  method data 'to string' options -> string 
 79    arg Str8 data ; arg Str options ; arg Str string 
 80    if options="raw" or options="db" 
 81      string := cast data Str 
 82    else 
 83      string := string (cast data Str) 
 84   
 85   
 86  method data 'from string' string options may_skip skiped offset -> status 
 87    arg_w Str8 data ; arg Str string options ; arg CBool may_skip ; arg_w Int skiped offset ; arg Status status 
 88    if options="raw" or options="db" 
 89      data := cast string Str8 
 90      skiped := 0 
 91      offset := string len 
 92      return success 
 93    else 
 94      var Link:Str :> new Str 
 95      status := 'from string' string options may_skip skiped offset 
 96      if status=success 
 97        data := cast Str8 
 98   
 99   
 100  function straight_to_Str s8 -> s 
 101    arg Str8 s8 ; arg Str s 
 102    := s8 content 
 103   
 104  function straight_to_Str8 s -> s8 
 105    arg Str s ; arg Str8 s8 
 106    s8 content := s 
 107   
 108   
 109  export Str8 '. characters' '. len' '' '. set' 
 110  export 'cast Str' 'cast Str8' 
 111  export straight_to_Str straight_to_Str8