added context to lexer logic and added range handling code

diff --git a/lib/colormap.ml b/lib/colormap.ml
index 4fc7f2b31b7730e0684ac9100180bdcc164ecffe..795a497c88cba662995a83c8a7b191bed5ed02f5 100644 (file)
--- a/lib/colormap.ml
+++ b/lib/colormap.ml
@@ -10,7 +10,7 @@ type style = Normal | Comment | Constant | Keyword | Type | PreProcessor
 *)
 
 module Span = struct
-  type t = { start : int; stop : int; style : style }
+  type t = { start : int; stop : int; style : int }
   let compare a b =
     if a.stop < b.start then -1
     else if a.start > b.stop then 1
@@ -21,7 +21,13 @@ module SpanSet = Set.Make(Span)
 
 type t = SpanSet.t
 
-type lexer = (style -> unit) -> Lexing.lexbuf -> unit
+type ctx = {
+  lbuf : lexbuf;
+  mutable map : t;
+  mutable pos : int;
+}
+
+type lexer = ctx -> Lexing.lexbuf -> unit
 
 let get_color = function
 | Normal   -> Cfg.Color.Syntax.normal
@@ -31,31 +37,36 @@ let get_color = function
 | Type     -> Cfg.Color.Syntax.typedef
 | PreProcessor -> Cfg.Color.Syntax.preproc
 
-let set_color mapref lexbuf c =
+let make_span lbuf clr =
+  Span.({ start = (lexeme_start lbuf);
+          stop  = (lexeme_end lbuf) - 1;
+          style = get_color clr })
+
+let set_color ctx clr =
+  ctx.map <- SpanSet.add (make_span ctx.lbuf clr) ctx.map
+
+let range_start ctx =
+  ctx.pos <- (lexeme_start ctx.lbuf)
+
+let range_stop ctx clr =
   let span = Span.({
-    start = (lexeme_start lexbuf);
-    stop  = (lexeme_end lexbuf) - 1;
-    style = c })
+    start = ctx.pos;
+    stop  = (lexeme_end ctx.lbuf) - 1;
+    style = get_color clr })
   in
-  mapref := SpanSet.add span !mapref;
-  ()
+  ctx.map <- SpanSet.add span ctx.map
 
 let make scanfn fetchfn =
-  print_endline "generating colormap";
-  let mapref = ref SpanSet.empty in
-  try
-    let lexbuf = Lexing.from_function fetchfn in
-    let set_color = set_color mapref lexbuf in
-    while true do
-      scanfn set_color lexbuf
-    done;
-    !mapref
-  with Eof -> !mapref
+  let lexbuf = Lexing.from_function fetchfn in
+  let ctx = { lbuf = lexbuf; map = SpanSet.empty; pos = 0; } in
+  (try while true do scanfn ctx lexbuf done
+   with Eof -> ());
+  ctx.map
 
 let empty = SpanSet.empty
 
 let find pos set =
-  let range = Span.({ start = pos; stop = pos; style = Normal }) in
+  let range = Span.({ start = pos; stop = pos; style = Cfg.Color.Syntax.normal }) in
   match (SpanSet.find_opt range set) with
-  | Some r -> get_color Span.(r.style)
-  | None   -> get_color Normal
+  | Some r -> Span.(r.style)
+  | None   -> Cfg.Color.Syntax.normal

diff --git a/lib/colormap.mli b/lib/colormap.mli
index 696dce2398a8549ce077eafaae1eb1c21c78b21c..80ed134643fa63fba3eba1ba2e3c9248d3edb647 100644 (file)
--- a/lib/colormap.mli
+++ b/lib/colormap.mli
@@ -6,15 +6,19 @@ type style = Normal | Comment | Constant | Keyword | Type | PreProcessor
 
 type t
 
-type lexer = (style -> unit) -> Lexing.lexbuf -> unit
+type ctx
+
+type lexer = ctx -> Lexing.lexbuf -> unit
 
 val empty : t
 val make : lexer -> (bytes -> int -> int) -> t
+val find : int -> t -> int
+val set_color : ctx -> style -> unit
+val range_start : ctx -> unit
+val range_stop : ctx -> style -> unit
 
 (*
 val from_channel : lexer -> in_channel -> t
 val from_string : lexer -> string -> t
 val from_function : lexer -> (bytes -> int -> int) -> t
 *)
-
-val find : int -> t -> int

diff --git a/lib/lexers/lex_cpp.mll b/lib/lexers/lex_cpp.mll
index 3029efe5aefeaa9aa7cb32e643917e47360e77fc..48fea7cedb4ea47515940fb5428e0937be468ee7 100644 (file)
--- a/lib/lexers/lex_cpp.mll
+++ b/lib/lexers/lex_cpp.mll
@@ -3,11 +3,9 @@
 let oct = ['0'-'9']
 let dec = ['0'-'9']
 let hex = ['0'-'9' 'a'-'f' 'A'-'F']
-let exp = ['e''E'] ['+''-']? (dec)+
+let exp = ['e''E'] ['+''-']? dec+
 
-let alpha = ['a'-'z' 'A'-'Z']
-let alpha_ = (alpha | '_')
-let alnum = (alpha | dec)
+let alpha_ = ['a'-'z' 'A'-'Z' '_']
 let alnum_ = (alpha_ | dec)
 
 let fstyle = ['f' 'F' 'l' 'L']
@@ -16,16 +14,16 @@ let istyle = ['u' 'U' 'l' 'L']
 let ln_cmt = "//" [^ '\n']*
 let character = "'" ([^'\\' '\''] | '\\' _) "'"
 let string = '"' ([^'\\' '"'] | '\\' _)* ['"' '\n']
-let identifier = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_']*
-let preprocess = "#" [' ' '\t']* ['a'-'z' 'A'-'Z' '_']+
+let identifier = alpha_ alnum_*
+let preprocess = "#" [' ' '\t']* alpha_+
 let sys_incl = (' '|'\t')* '<' [^ '\n' '>']* '>'
 
 let number = (
-    (dec)+ (istyle)*
-  | '0' ['x''X'] (hex)+ (istyle)*
-  | (dec)+ (exp)? (fstyle)?
-  | (dec)* '.' (dec)+ (exp)? (fstyle)?
-  | (dec)+ '.' (dec)* (exp)? (fstyle)?
+    dec+ istyle*
+  | '0' ['x''X'] hex+ istyle*
+  | dec+ exp? fstyle?
+  | dec* '.' dec+ exp? fstyle?
+  | dec+ '.' dec* exp? fstyle?
 )
 
 let const = "true" | "false" | "NULL"
@@ -39,26 +37,26 @@ let typedef = "bool" | "short" | "int" | "long" | "unsigned" | "signed" | "char"
     | "int32_t" | "int64_t" | "uint8_t" | "uint16_t" | "uint32_t" | "uint64_t"
     | "float" | "double"
 
-rule scan color = parse
-  | "/*"       { color Comment; comment color lexbuf }
-  | ln_cmt     { color Comment }
-  | number     { color Constant }
-  | character  { color Constant }
-  | string     { color Constant }
-  | const      { color Constant }
-  | keyword    { color Keyword }
-  | typedef    { color Type }
-  | preprocess { color PreProcessor; preproc color lexbuf }
+rule scan ctx = parse
+  | "/*"       { range_start ctx; comment ctx lexbuf }
+  | ln_cmt     { set_color ctx Comment }
+  | number     { set_color ctx Constant }
+  | character  { set_color ctx Constant }
+  | string     { set_color ctx Constant }
+  | const      { set_color ctx Constant }
+  | keyword    { set_color ctx Keyword }
+  | typedef    { set_color ctx Type }
+  | preprocess { set_color ctx PreProcessor; preproc ctx lexbuf }
   | identifier { (* skip *) }
-  | _          { scan color lexbuf }
+  | _          { scan ctx lexbuf }
   | eof        { raise Eof }
 
-and comment color = parse
-  | "*/" { color Comment }
-  | _ { comment color lexbuf }
-  | eof { raise Eof }
+and comment ctx = parse
+  | "*/" { range_stop ctx Comment }
+  | _    { comment ctx lexbuf }
+  | eof  { raise Eof }
 
-and preproc color = parse
-  | sys_incl { color Constant }
-  | _ { (* skip *) }
-  | eof { raise Eof }
+and preproc ctx = parse
+  | sys_incl { set_color ctx Constant }
+  | _        { (* skip *) }
+  | eof      { raise Eof }