(* $Id: link_ocamllex.src 675 2004-06-13 16:03:16Z gerd $
 * ----------------------------------------------------------------------
 *
 *)

(* This file is divided up into sections, marked by (* [SECTION] *).
 * Sections are processed by lexpp.
 *)

(* ---------------------------------------------------------------------- *)
(* [LINK] *)

(* This section contains code going into the link module. The patterns
 * $ {name} (w/o space) are substituted by generated strings:
 * - $ {encoding} is replaced by the name of the character encoding
 * - all other names must be names of lexical rules, and $ {name} is
 *   replaced by Module.name, i.e. the correct module prefix is prepended
 *   to the rule name.
 *)

open Pxp_types
open Pxp_lexer_types
open Pxp_reader

class lfactory : lexer_factory =
object(self)
  method encoding = `Enc_${encoding}

  method open_source src = 
    new lobj 
      (self : #lexer_factory :> lexer_factory) 
      (Lazy.force src.lsrc_lexbuf) false

  method open_string s =
    new lobj 
      (self : #lexer_factory :> lexer_factory) 
      (Lexing.from_string s) true

  method open_string_inplace s =
    new lobj 
      (self : #lexer_factory :> lexer_factory) 
      (Pxp_lexing.from_string_inplace s) true
end

and lobj factory _lexbuf _lexbuf_from_string : lexer_obj =
object(self)
  val mutable lexbuf = _lexbuf
  val mutable lexbuf_from_string = _lexbuf_from_string

  method factory = factory

  method encoding = `Enc_${encoding}

  method open_source src =
    lexbuf <- Lazy.force src.lsrc_lexbuf;
    lexbuf_from_string <- false

  method open_string s =
    lexbuf <- Lexing.from_string s;
    lexbuf_from_string <- true

  method open_string_inplace s =
    if lexbuf_from_string then (
      Pxp_lexing.from_another_string_inplace lexbuf s
    )
    else (
      lexbuf <- Pxp_lexing.from_string_inplace s;
      lexbuf_from_string <- true
    )

  method lexeme_length =
    if Netconversion.is_single_byte `Enc_${encoding} then
      Lexing.lexeme_end lexbuf - Lexing.lexeme_start lexbuf
    else (
      (* Very inefficient: *)
      let s = Lexing.lexeme lexbuf in
      Netconversion.ustring_length `Enc_${encoding} s
    )

  method lexeme_char pos =
    (* Very inefficient: *)
    let s = Lexing.lexeme lexbuf in
    let cs = Netconversion.create_cursor `Enc_${encoding} s in
    Netconversion.move ~num:pos cs;
    Netconversion.uchar_at cs

  method lexeme =
    Lexing.lexeme lexbuf

  method lexeme_strlen =
    Pxp_lexing.lexeme_len lexbuf

  method sub_lexeme pos len =
    if Netconversion.is_single_byte `Enc_${encoding} then (
      Pxp_lexing.sub_lexeme lexbuf pos len
    )
    else (
      (* Very inefficient: *)
      let s = Lexing.lexeme lexbuf in
      let ua = Netconversion.uarray_of_ustring `Enc_${encoding} s in
      Netconversion.ustring_of_uarray `Enc_${encoding} ~pos ~len ua
    )

    
  method scan_document =
    fun () -> 
      ${scan_document}.scan_document (self : #lexer_obj :> lexer_obj) lexbuf

  method scan_content =
    fun () -> 
      ${scan_content}.scan_content (self : #lexer_obj :> lexer_obj) lexbuf

  method scan_within_tag = 
    fun () -> 
      ${scan_within_tag}.scan_within_tag
        (self : #lexer_obj :> lexer_obj) lexbuf

  method scan_document_type = 
    fun () -> 
      ${scan_document_type}.scan_document_type
        (self : #lexer_obj :> lexer_obj) lexbuf
    
  method scan_declaration = 
    fun () -> 
      ${scan_declaration}.scan_declaration 
        (self : #lexer_obj :> lexer_obj) lexbuf
    
  method scan_comment = 
    fun () -> 
      ${scan_comment}.scan_comment (self : #lexer_obj :> lexer_obj) lexbuf

  method scan_ignored_section = 
    fun () -> 
      ${scan_ignored_section}.scan_ignored_section
        (self : #lexer_obj :> lexer_obj) lexbuf

  method detect_xml_pi = 
    fun () -> 
      ${detect_xml_pi}.detect_xml_pi (self : #lexer_obj :> lexer_obj) lexbuf

  method scan_xml_pi = 
    fun () -> 
      ${scan_xml_pi}.scan_xml_pi (self : #lexer_obj :> lexer_obj) lexbuf

  method scan_pi_string = 
    fun () -> 
      ${scan_pi_string}.scan_pi_string (self : #lexer_obj :> lexer_obj) lexbuf

  method scan_dtd_string = 
    fun () -> 
      ${scan_dtd_string}.scan_dtd_string (self : #lexer_obj :> lexer_obj) lexbuf

  method scan_content_string = 
    fun () -> 
      ${scan_content_string}.scan_content_string
        (self : #lexer_obj :> lexer_obj) lexbuf

  method scan_name_string =
    fun () -> 
      ${scan_name_string}.scan_name_string
        (self : #lexer_obj :> lexer_obj) lexbuf

  method scan_for_crlf = 
    fun () -> 
      ${scan_for_crlf}.scan_for_crlf (self : #lexer_obj :> lexer_obj) lexbuf

  method scan_characters = 
    fun () -> 
      ${scan_characters}.scan_characters (self : #lexer_obj :> lexer_obj) lexbuf

  method scan_character = 
    fun () -> 
      ${scan_character}.scan_character (self : #lexer_obj :> lexer_obj) lexbuf

  method scan_tag_eb = 
    fun () -> 
      ${scan_tag_eb}.scan_tag_eb (self : #lexer_obj :> lexer_obj) lexbuf

  method scan_tag_eb_att = 
    fun () -> 
      ${scan_tag_eb_att}.scan_tag_eb_att (self : #lexer_obj :> lexer_obj) lexbuf

end
;;


Pxp_lexers.init (new lfactory)
;;


(* [END] *)

