Skip to content
Snippets Groups Projects
lxm.ml 2.57 KiB
Newer Older
(* Time-stamp: <modified the 07/09/2017 (at 15:14) by Erwan Jahier> *)
Erwan Jahier's avatar
Erwan Jahier committed

(** Common to lus2lic and lic2loc  *)

Erwan Jahier's avatar
Erwan Jahier committed
let new_line ( lexbuf ) = (
  Lv6MainArgs.global_opt.Lv6MainArgs.line_start_pos <- Lexing.lexeme_end lexbuf;
  Lv6MainArgs.global_opt.Lv6MainArgs.line_num <- Lv6MainArgs.global_opt.Lv6MainArgs.line_num +1;
Erwan Jahier's avatar
Erwan Jahier committed
)

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

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

let str x = (x._str)
Erwan Jahier's avatar
Erwan Jahier committed
let line x = (x._line)
let cstart x = (x._cstart)
let cend x = (x._cend)
let pragma x = x._pragma
Erwan Jahier's avatar
Erwan Jahier committed
(* affichage standard: *)
let details lxm = (
  let file = if Lv6MainArgs.global_opt.Lv6MainArgs.nonreg_test then 
    (* during non-regression test, having absolute paths printed
       complicate the perusal (because of the diff output). *)
    Filename.basename lxm._file 
  else 
    lxm._file 
  in
    Printf.sprintf "in file \"%s\", line %d, col %d to %d, token '%s'"
      file lxm._line lxm._cstart lxm._cend lxm._str 
Erwan Jahier's avatar
Erwan Jahier committed
)
(* affichage compact: *)
let short_details lxm = (
   let file = Filename.basename lxm._file in
   Printf.sprintf "f:%s, l:%d, c:%d-%d, t:'%s'"
      file lxm._line lxm._cstart lxm._cend lxm._str 
)
Erwan Jahier's avatar
Erwan Jahier committed
let position lxm = (
  Printf.sprintf "line:%d, col:%d to %d"
    lxm._line lxm._cstart lxm._cend
Erwan Jahier's avatar
Erwan Jahier committed
)
let (override_name : string -> t -> t) =
  fun nname lxm ->
  { lxm with _str=nname }
Erwan Jahier's avatar
Erwan Jahier committed

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


let dummy str = 
  {
    _str = str ;  
    _line = 0 ; 
    _cstart = 0 ; 
  }

let last_lexeme = ref (dummy "")
Erwan Jahier's avatar
Erwan Jahier committed

open Lv6MainArgs
Erwan Jahier's avatar
Erwan Jahier committed
let make ( lexbuf ) = (
  let s = (Lexing.lexeme lexbuf) in
  let l = global_opt.line_num in
  let c1 = (Lexing.lexeme_start lexbuf - global_opt.line_start_pos) in
  let c2 = (Lexing.lexeme_end lexbuf - global_opt.line_start_pos - 1) in
    last_lexeme := 
      { _str = s ; 
        _file = global_opt.current_file; 
Erwan Jahier's avatar
Erwan Jahier committed
        _line = l; 
        _cstart = c1 ; 
      };
    !last_lexeme
Erwan Jahier's avatar
Erwan Jahier committed
)

let add_pragma lxm pl = { lxm with _pragma = pl }
Erwan Jahier's avatar
Erwan Jahier committed
let make_string ( lexbuf ) = 
  let lxm = make lexbuf in
    { lxm with _str = String.sub lxm._str 1 ((String.length lxm._str)-2) }



Erwan Jahier's avatar
Erwan Jahier committed
let last_made () = !last_lexeme