xstrp4_here_lexer.mll 2.39 KB
Newer Older
gerd's avatar
gerd committed
1
(* $Id$
gerd's avatar
gerd committed
2 3 4 5 6 7
 * ----------------------------------------------------------------------
 *
 *)

{
  open Xstrp4_here_types
gerd's avatar
gerd committed
8
  open Camlp4.PreCast
gerd's avatar
gerd committed
9

gerd's avatar
gerd committed
10
  let _loc = Loc.ghost
gerd's avatar
gerd committed
11

gerd's avatar
gerd committed
12
  let pos lexbuf =  (Lexing.lexeme_start_p lexbuf, Lexing.lexeme_end_p lexbuf)
gerd's avatar
gerd committed
13 14 15 16 17
}

let ucletter = [ 'A' - 'Z' ]
let lcletter = [ 'a' - 'z' '_' ] 
let acletter = ucletter | lcletter
gerd's avatar
gerd committed
18
let value_id = ( acletter+ '.' )* lcletter acletter *
gerd's avatar
gerd committed
19 20 21 22 23

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

rule token = parse
gerd's avatar
gerd committed
29 30 31 32 33
    '$' (value_id as vid) 
    { Variable (id [] (Lexing.from_string vid), "%s", pos lexbuf) }

  | '$' '{' (value_id as vid) ( ',' (format as fmt))?  '}'
      {
gerd's avatar
gerd committed
34
	let fmt = 
gerd's avatar
gerd committed
35 36 37
    match fmt with 
    | Some s -> s
    | None -> "%s"
gerd's avatar
gerd committed
38
	in
gerd's avatar
gerd committed
39
  Variable (id [] (Lexing.from_string vid), fmt, pos lexbuf)
gerd's avatar
gerd committed
40 41 42 43
      }
  | '$'
      { failwith "Bad $ expander" }
  | '\\' '\n' 
gerd's avatar
gerd committed
44
      { Literal("", pos lexbuf) }
gerd's avatar
gerd committed
45
  | '\\' '$'
gerd's avatar
gerd committed
46
      { Literal("$", pos lexbuf) }
gerd's avatar
gerd committed
47
  | '\\' [ '0'-'9' ] [ '0'-'9' ] [ '0'-'9' ]
gerd's avatar
gerd committed
48 49 50
      {  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
gerd's avatar
gerd committed
51
	 Literal(lit, pos lexbuf)
gerd's avatar
gerd committed
52
      }
gerd's avatar
gerd committed
53 54
(*
  | '\\' 'o' [ '0'-'7' ] [ '0'-'7' ] [ '0'-'7' ]
gerd's avatar
gerd committed
55 56 57 58 59
      {  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)
		 ) 
      }
gerd's avatar
gerd committed
60
*)
gerd's avatar
gerd committed
61
  | '\\' 'x' [ '0'-'9' 'a'-'f' 'A'-'F' ] [ '0'-'9' 'a'-'f' 'A'-'F' ]
gerd's avatar
gerd committed
62 63 64
      {  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
gerd's avatar
gerd committed
65
	 Literal(lit, pos lexbuf)
gerd's avatar
gerd committed
66 67
      }

gerd's avatar
gerd committed
68
  | '\\' _
gerd's avatar
gerd committed
69
      { let lit = Lexing.lexeme lexbuf in
gerd's avatar
gerd committed
70
	 Literal(lit, pos lexbuf)
gerd's avatar
gerd committed
71
      }
gerd's avatar
gerd committed
72
  | [^ '$' '\\']+
gerd's avatar
gerd committed
73
      { let lit = Lexing.lexeme lexbuf in
gerd's avatar
gerd committed
74
	 Literal(lit, pos lexbuf)
gerd's avatar
gerd committed
75
      }
gerd's avatar
gerd committed
76 77 78
  | eof 
      { Textend }
  | _ 
gerd's avatar
gerd committed
79
      { let lit = Lexing.lexeme lexbuf in
gerd's avatar
gerd committed
80
	 Literal(lit, pos lexbuf)
gerd's avatar
gerd committed
81
      }
gerd's avatar
gerd committed
82

gerd's avatar
gerd committed
83 84 85 86 87 88 89
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 }
gerd's avatar
gerd committed
90
  | eof
gerd's avatar
gerd committed
91 92 93
      { 
        Camlp4.PreCast.Ast.idAcc_of_list (List.rev acc)
      }
gerd's avatar
gerd committed
94