lxm.ml

(** Time-stamp: <modified the 01/09/2008 (at 17:03) by jahier> *)

(** Common to lus2lic and lic2loc  *)


let new_line ( lexbuf ) = (
  Global.line_start_pos := Lexing.lexeme_end lexbuf;
  incr Global.line_num;
  ()
)

(* exported *)
type pragma = Pragma of string * string

(* le type ``lexeme'', string + info source *)
type t = {
        _file : string ;
        _str : string ;
        _line : int ;
        _cstart : int ;
        _cend : int;
	_pragma : pragma list
}

let str x = (x._str)
let id x = (Ident.of_string x._str)
let line x = (x._line)
let cstart x = (x._cstart)
let cend x = (x._cend)
let file x = x._file
let pragma x = x._pragma
(* affichage standard: *)
let details lxm = (
  Printf.sprintf "in file \"%s\", line %d, col %d to %d, token '%s'"
    lxm._file lxm._line lxm._cstart lxm._cend lxm._str 
)
let position lxm = (
  Printf.sprintf "line:%d, col:%d to %d"
    lxm._line lxm._cstart lxm._cend
)

(* constructeur de type flagg avec un lexeme *)
type 'a srcflagged = {
   src : t ;
   it  : 'a
}
(* flagage d'une valeur quelconque *) 
let (flagit : 'a -> t -> 'a srcflagged) = 
  fun x lxm -> 
    { it = x; src = lxm }


let dummy str = 
  {
    _str = str ;  
    _file = String.concat ", " !Global.infiles ; 
    _line = 0 ; 
    _cstart = 0 ; 
    _cend = 0 ;
    _pragma = []
  }

let last_lexeme = ref (dummy "")

let make ( lexbuf ) = (
  let s = (Lexing.lexeme lexbuf) in
  let l = !Global.line_num in
  let c1 = (Lexing.lexeme_start lexbuf - !Global.line_start_pos + 1) in
  let c2 = (Lexing.lexeme_end lexbuf - !Global.line_start_pos) in
    last_lexeme := 
      { _str = s ; 
        _file = !Global.current_file; 
        _line = l; 
        _cstart = c1 ; 
        _cend = c2 ;
	_pragma = []
      };
    !last_lexeme
)

let add_pragma lxm pl = { lxm with _pragma = pl }
let make_string ( lexbuf ) = 
  let lxm = make lexbuf in
    { lxm with _str = String.sub lxm._str 1 ((String.length lxm._str)-2) }



let last_made () = !last_lexeme