(* $Id: xstrp4_here_lexer.mll 34 2010-11-30 14:28:45Z gerd $
 * ----------------------------------------------------------------------
 *
 *)

{
  open Xstrp4_here_types
  open Camlp4.PreCast

  let _loc = Loc.ghost

  let pos lexbuf =  (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf)
}

let ucletter = [ 'A' - 'Z' ]
let lcletter = [ 'a' - 'z' '_' ] 
let acletter = ucletter | lcletter
let value_id = ( acletter+ '.' )* lcletter acletter *

let format = '%'
             [ '0' '-' ' ' ]*    (* no more modifiers are supported by Ocaml *)
             ['0'-'9']* 
             ( '.' ['0'-'9']* )?
	     ( ( ['L' 'l' 'n'] [ 'd' 'i' 'u' 'x' 'X' 'o' ])
	       | [ 'd' 'i' 'u' 'x' 'X' 's' 'c' 'f' 'e' 'E' 'g' 'G' 'b' 'a' 't' ]
	     )

rule token = parse
    '$' (value_id as vid) 
    { Variable (id [] (Lexing.from_string vid), "%s", pos lexbuf) }

  | '$' '{' (value_id as vid) ( ',' (format as fmt))?  '}'
      {
	let fmt = 
    match fmt with 
    | Some s -> s
    | None -> "%s"
	in
  Variable (id [] (Lexing.from_string vid), fmt, pos lexbuf)
      }
  | '$'
      { failwith "Bad $ expander" }
  | '\\' '\n' 
      { Literal("", pos lexbuf) }
  | '\\' '$'
      { Literal("$", pos lexbuf) }
  | '\\' [ '0'-'9' ] [ '0'-'9' ] [ '0'-'9' ]
      {  let s = Lexing.lexeme lexbuf in
	 let n = int_of_string(String.sub s 1 3) in
         let lit = Printf.sprintf "%c" (Char.chr n) in
	 Literal(lit, pos lexbuf)
      }
(*
  | '\\' 'o' [ '0'-'7' ] [ '0'-'7' ] [ '0'-'7' ]
      {  Literal (let s = Lexing.lexeme lexbuf in
		  let n = int_of_string("0" ^ String.sub s 1 4) in
                  Printf.sprintf "%c" (Char.chr n)
		 ) 
      }
*)
  | '\\' 'x' [ '0'-'9' 'a'-'f' 'A'-'F' ] [ '0'-'9' 'a'-'f' 'A'-'F' ]
      {  let s = Lexing.lexeme lexbuf in
	 let n = int_of_string("0" ^ String.sub s 1 3) in
         let lit = Printf.sprintf "%c" (Char.chr n) in
	 Literal(lit, pos lexbuf)
      }

  | '\\' _
      { let lit = Lexing.lexeme lexbuf in
	 Literal(lit, pos lexbuf)
      }
  | [^ '$' '\\']+
      { let lit = Lexing.lexeme lexbuf in
	 Literal(lit, pos lexbuf)
      }
  | eof 
      { Textend }
  | _ 
      { let lit = Lexing.lexeme lexbuf in
	 Literal(lit, pos lexbuf)
      }

and id acc = parse
    (ucletter acletter*) as uid
      { id (Ast.IdUid (_loc, uid) :: acc) lexbuf }
  | lcletter acletter* as lid
      { id (Ast.IdLid (_loc, lid) :: acc) lexbuf }
  | '.' 
      { id acc lexbuf }
  | eof
      { 
        Camlp4.PreCast.Ast.idAcc_of_list (List.rev acc)
      }