(* 

 * UTF-8 - UTF-8 encoded Unicode string

 * Copyright 2002, 2003 (C) Yamagata Yoriyuki. 

 *

 * This library is free software; you can redistribute it and/or

 * modify it under the terms of the GNU Lesser General Public

 * License as published by the Free Software Foundation; either

 * version 2.1 of the License, or (at your option) any later version,

 * with the special exception on linking described in file LICENSE.

 *

 * This library is distributed in the hope that it will be useful,

 * but WITHOUT ANY WARRANTY; without even the implied warranty of

 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

 * Lesser General Public License for more details.

 *

 * You should have received a copy of the GNU Lesser General Public

 * License along with this library; if not, write to the Free Software

 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

 *)

open UChar

type t = string

type index = int

let look s i =

  let n' =

    let n = Char.code s.[i] in

    if n < 0x80 then n else

    if n <= 0xdf then

      (n - 0xc0) lsl 6 lor (0x7f land (Char.code s.[i + 1]))

    else if n <= 0xef then

      let n' = n - 0xe0 in

      let m0 = Char.code s.[i + 2] in

      let m = Char.code (String.unsafe_get s (i + 1)) in

      let n' = n' lsl 6 lor (0x7f land m) in

      n' lsl 6 lor (0x7f land m0)

    else if n <= 0xf7 then

      let n' = n - 0xf0 in

      let m0 = Char.code s.[i + 3] in

      let m = Char.code (String.unsafe_get s (i + 1)) in

      let n' = n' lsl 6 lor (0x7f land m) in

      let m = Char.code (String.unsafe_get s (i + 2)) in

      let n' = n' lsl 6 lor (0x7f land m) in

      n' lsl 6 lor (0x7f land m0)     

    else if n <= 0xfb then

      let n' = n - 0xf8 in

      let m0 = Char.code s.[i + 4] in

      let m = Char.code (String.unsafe_get s (i + 1)) in

      let n' = n' lsl 6 lor (0x7f land m) in

      let m = Char.code (String.unsafe_get s (i + 2)) in

      let n' = n' lsl 6 lor (0x7f land m) in

      let m = Char.code (String.unsafe_get s (i + 3)) in

      let n' = n' lsl 6 lor (0x7f land m) in

      n' lsl 6 lor (0x7f land m0)     

    else if n <= 0xfd then

      let n' = n - 0xfc in

      let m0 = Char.code s.[i + 5] in

      let m = Char.code (String.unsafe_get s (i + 1)) in

      let n' = n' lsl 6 lor (0x7f land m) in

      let m = Char.code (String.unsafe_get s (i + 2)) in

      let n' = n' lsl 6 lor (0x7f land m) in

      let m = Char.code (String.unsafe_get s (i + 3)) in

      let n' = n' lsl 6 lor (0x7f land m) in

      let m = Char.code (String.unsafe_get s (i + 4)) in

      let n' = n' lsl 6 lor (0x7f land m) in

      n' lsl 6 lor (0x7f land m0)

    else invalid_arg "UTF8.look"

  in

  Obj.magic n'

let rec search_head s i =

  if i >= String.length s then i else

  let n = Char.code (String.unsafe_get s i) in

  if n < 0x80 || n >= 0xc2 then i else

  search_head s (i + 1)

let next s i = 

  let n = Char.code s.[i] in

  if n < 0x80 then i + 1 else

  if n < 0xc0 then search_head s (i + 1) else

  if n <= 0xdf then i + 2

  else if n <= 0xef then i + 3

  else if n <= 0xf7 then i + 4

  else if n <= 0xfb then i + 5

  else if n <= 0xfd then i + 6

  else invalid_arg "UTF8.next"

let rec search_head_backward s i =

  if i < 0 then -1 else

  let n = Char.code s.[i] in

  if n < 0x80 || n >= 0xc2 then i else

  search_head_backward s (i - 1)

let prev s i = search_head_backward s (i - 1)

let move s i n =

  if n >= 0 then

    let rec loop i n = if n <= 0 then i else loop (next s i) (n - 1) in

    loop i n

  else

    let rec loop i n = if n >= 0 then i else loop (prev s i) (n + 1) in

    loop i n

let rec nth_aux s i n =

  if n = 0 then i else

  nth_aux s (next s i) (n - 1)

let nth s n = nth_aux s 0 n

let substring s i n =

  let j = nth s i in

  let j' = (nth_aux s j n) - 1 in

  String.sub s j (j' - j + 1)

let last s = search_head_backward s (String.length s - 1)

let out_of_range s i = i < 0 || i >= String.length s

let compare_index _ i j = i - j

let get s n = look s (nth s n)

let add_uchar buf u =

  let masq = 0b111111 in

  let k = int_of_uchar u in

  if k < 0 || k >= 0x4000000 then begin

    Buffer.add_char buf (Char.chr (0xfc + (k lsr 30)));

    Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((k lsr 24) land masq))); 

    Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((k lsr 18) land masq)));

    Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((k lsr 12) land masq)));

    Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((k lsr 6) land masq)));

    Buffer.add_char buf (Char.unsafe_chr (0x80 lor (k land masq)));

  end else if k <= 0x7f then

    Buffer.add_char buf (Char.unsafe_chr k)

  else if k <= 0x7ff then begin

    Buffer.add_char buf (Char.unsafe_chr (0xc0 lor (k lsr 6)));

    Buffer.add_char buf (Char.unsafe_chr (0x80 lor (k land masq)))

  end else if k <= 0xffff then begin

    Buffer.add_char buf (Char.unsafe_chr (0xe0 lor (k lsr 12)));

    Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((k lsr 6) land masq)));

    Buffer.add_char buf (Char.unsafe_chr (0x80 lor (k land masq)));

  end else if k <= 0x1fffff then begin

    Buffer.add_char buf (Char.unsafe_chr (0xf0 + (k lsr 18)));

    Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((k lsr 12) land masq)));

    Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((k lsr 6) land masq)));

    Buffer.add_char buf (Char.unsafe_chr (0x80 lor (k land masq)));

  end else begin

    Buffer.add_char buf (Char.unsafe_chr (0xf8 + (k lsr 24)));

    Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((k lsr 18) land masq)));

    Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((k lsr 12) land masq)));

    Buffer.add_char buf (Char.unsafe_chr (0x80 lor ((k lsr 6) land masq)));

    Buffer.add_char buf (Char.unsafe_chr (0x80 lor (k land masq)));

  end 

let init len f =

  let buf = Buffer.create len in

  for c = 0 to len - 1 do add_uchar buf (f c) done;

  Buffer.contents buf

let rec length_aux s c i =

  if i >= String.length s then c else

  let n = Char.code (String.unsafe_get s i) in

  let k =

    if n < 0x80 then 1 else

    if n < 0xc0 then invalid_arg "UTF8.length" else

    if n < 0xe0 then 2 else

    if n < 0xf0 then 3 else

    if n < 0xf8 then 4 else

    if n < 0xfc then 5 else

    if n < 0xfe then 6 else

    invalid_arg "UTF8.length" in

  length_aux s (c + 1) (i + k)

let length s = length_aux s 0 0

let rec iter_aux proc s i =

  if i >= String.length s then () else

  let u = look s i in

  proc u;

  iter_aux proc s (next s i)

let iter proc s = iter_aux proc s 0

let compare s1 s2 = Pervasives.compare s1 s2

exception Malformed_code

let validate s =

  let rec trail c i a =

    if c = 0 then a else

    if i >= String.length s then raise Malformed_code else

    let n = Char.code (String.unsafe_get s i) in

    if n < 0x80 || n >= 0xc0 then raise Malformed_code else

    trail (c - 1) (i + 1) (a lsl 6 lor (n - 0x80)) in

  let rec main i =

    if i >= String.length s then () else

    let n = Char.code (String.unsafe_get s i) in

    if n < 0x80 then main (i + 1) else

    if n < 0xc2 then raise Malformed_code else

    if n <= 0xdf then 

      if trail 1 (i + 1) (n - 0xc0) < 0x80 then raise Malformed_code else 

      main (i + 2)

    else if n <= 0xef then 

      if trail 2 (i + 1) (n - 0xe0) < 0x800 then raise Malformed_code else 

      main (i + 3)

    else if n <= 0xf7 then 

      if trail 3 (i + 1) (n - 0xf0) < 0x10000 then raise Malformed_code else

      main (i + 4)

    else if n <= 0xfb then 

      if trail 4 (i + 1) (n - 0xf8) < 0x200000 then raise Malformed_code else

      main (i + 5)

    else if n <= 0xfd then 

      let n = trail 5 (i + 1) (n - 0xfc) in

      if n lsr 16 < 0x400 then raise Malformed_code else

      main (i + 6)

    else raise Malformed_code in

  main 0

module Buf = 

  struct

    include Buffer

    type buf = t

    let add_char = add_uchar

  end