Patch title: Release 94 bulk changes
Abstract:
File: /pliant/language/type/text/str32.pli
Key:
    Removed line
    Added line
   
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


# scope "/pliant/language/" "/pliant/install/"
module "/pliant/install/ring2.pli"
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


# scope "/pliant/language/" "/pliant/install/"
module "/pliant/install/ring2.pli"
ring_module


method s '' i -> c
  arg Str32 s ; arg Int i ; arg_C Char32 c
  check i>=0 and i<s:len


method s '' i -> c
  arg Str32 s ; arg Int i ; arg_C Char32 c
  check i>=0 and i<s:len
  c :> (s:characters translate Char32 i) map Char32
  c :> s:characters map Char32 i
# ((the_function '' Str32 Int -> Char32) arg 2) maps := 1

method s '' i j -> sub
  arg Str32 s ; arg Int i j ; arg Str32 sub
  check i>=0 and j>=0

method s '' i j -> sub
  arg Str32 s ; arg Int i j ; arg Str32 sub
  check i>=0 and j>=0
  var Int l := min j s:len-i
  var Int l := max (min j s:len-i) 0
  sub set (s:characters translate Char32 i) l false
((the_function '' Str32 Int Int -> Str32) arg 3) maps := 1



function copy s d
  arg Str32 s ; arg_w Str32 d
  var Int l := s len
  sub set (s:characters translate Char32 i) l false
((the_function '' Str32 Int Int -> Str32) arg 3) maps := 1



function copy s d
  arg Str32 s ; arg_w Str32 d
  var Int l := s len
  d set (memory_allocate l*Char32:size addressof:d) l true
  memory_copy s:characters d:characters l*Char32:size
  var Address c := memory_allocate l*Char32:size addressof:d
  memory_copy s:characters c l*Char32:size
  d set c l true




function 'cast Str32' s -> s32
  arg Str s ; arg Str32 s32
  extension
  var Int l := s len
  s32 set (memory_allocate l*Char32:size addressof:s32) l tr
  var Address src := s characters ; var Address stop := src 
  var Address dest := s32 characters
  while src<>stop
    dest map Int32 := src map uInt8
    src := src translate uInt8 1 ; dest := dest translate In
function '+' s1 s2 -> s
  arg Str32 s1 s2 s
  var Int l := s1:len+s2:len
  s set (memory_allocate l*Char32:size addressof:s) l true
  memory_copy s1:characters s:characters s1:len*Char32:size
  memory_copy s2:characters (s:characters translate Char32 s1:len) s2:len*Char32:size


function 'cast Str32' c -> s
  arg Char32 c ; arg Str32 s
  extension
  s set (memory_allocate Char32:size addressof:s) 1 true
  s:characters map Char32 := c


function 'cast Str' s32 -> s
  arg Str32 s32 ; arg Str s
  reduction
  var Int l := s32 len
  s set (memory_allocate l addressof:s) l true
  var Address src := s32 characters
  var Address dest := s characters ; var Address stop := des
  while dest<>stop
    var Int c := src map Int32
    if c>=100h
      c := undefined_character number
    dest map uInt8 := c
    src := src translate Int32 1 ; dest := dest translate uI


function compare s1 s2 -> c
  arg Str32 s1 s2 ; arg Int c
  var Int l := min s1:len s2:len
  var Address p1 := s1 characters ; var Address stop := p1 t
  var Address p2 := s2 characters
  while p1<>stop
    if (p1 map Int32)<>(p2 map Int32)
      return (compare (p1 map Int32) (p2 map Int32))
    p1 := p1 translate Int32 1 ; p2 := p2 translate Int32 1
  if s1:len>s2:len
    c := compare_superior
  eif s1:len<s2:len
    c := compare_inferior
  else
    c := compare_equal

function compare s1 s2 -> c
  arg Str32 s1 s2 ; arg Int c
  var Int l := min s1:len s2:len
  var Address p1 := s1 characters ; var Address stop := p1 t
  var Address p2 := s2 characters
  while p1<>stop
    if (p1 map Int32)<>(p2 map Int32)
      return (compare (p1 map Int32) (p2 map Int32))
    p1 := p1 translate Int32 1 ; p2 := p2 translate Int32 1
  if s1:len>s2:len
    c := compare_superior
  eif s1:len<s2:len
    c := compare_inferior
  else
    c := compare_equal

function '+' s1 s2 -> s
  arg Str32 s1 s2 s
  var Int l := s1:len+s2:len
  s set (memory_allocate l*Char32:size addressof:s) l true
  memory_copy s1:characters s:characters s1:len*Char32:size
  memory_copy s2:characters (s:characters translate Char32 s



export Char32
export character32 '. number'
export Str32 '. set'
export '. characters' '. len' ''
export Char32
export character32 '. number'
export Str32 '. set'
export '. characters' '. len' ''
export 'cast Str32' 'cast Str'
export compare '+'
export compare '+'


function 'cast Str32' c -> s
  arg Char32 c ; arg Str32 s
  extension
  s set (memory_allocate Char32:size addressof:s) 1 true
  s:characters map Char32 := c


function 'cast Str32' s -> s32
  arg Str s ; arg Str32 s32
  extension
  if default_charset_is_utf8
    module "/pliant/util/encoding/utf8.pli"
    s32 := utf8_decode s
  else
    var Int l := s len
    s32 set (memory_allocate l*Char32:size addressof:s32) l true
    var Address src := s characters ; var Address stop := src translate uInt8 l
    var Address dest := s32 characters
    while src<>stop
      dest map Int32 := src map uInt8
      src := src translate uInt8 1 ; dest := dest translate Int32 1


function 'cast Str' s32 -> s
  arg Str32 s32 ; arg Str s
  reduction
  if default_charset_is_utf8
    module "/pliant/util/encoding/utf8.pli"
    s := utf8_encode s32
  else
    var Int l := s32 len
    s set (memory_allocate l addressof:s) l true
    var Address src := s32 characters
    var Address dest := s characters ; var Address stop := dest translate uInt8 l
    while dest<>stop
      var Int c := src map Int32
      if c>=100h
        c := undefined_character number
      dest map uInt8 := c
      src := src translate Int32 1 ; dest := dest translate uInt8 1


method s search pattern default -> index
  arg Str32 s pattern ; arg Int default index
  if true
    var Int ls := s len ; var Int lp := pattern len
    check lp<>0
    if ls>=lp
      var Address cur := s characters
      var Address stop := cur translate Char32 ls-lp+1
      var Address wished := pattern characters ; var Int size := lp*Char32:size
      var Int ch := wished map Int32
      while cur<>stop
        if (cur map Int32)=ch
          if not (memory_different cur size wished size)
            return ((cast cur Int) .-. (cast s:characters Int))\Char32:size
        cur := cur translate Char32
    index := default
  else
    check pattern:len>0
    for index 0 s:len-pattern:len
      if (s index pattern:len)=pattern
        return
    index := default


export 'cast Str32' 'cast Str' '. search'