Keep track of locations in the AST

Armael · Armael · commit 2a9df71c2712 · 2016-08-19T10:56:36.000+02:00
diff --git a/lib/mustache.ml b/lib/mustache.ml
@@ -22,11 +22,16 @@
 open MoreLabels
 include Mustache_types
 
+let dummy_loc = {
+  loc_start = Lexing.dummy_pos;
+  loc_end = Lexing.dummy_pos;
+}
+
 module List = ListLabels
 module String = StringLabels
 
 module Infix = struct
-  let (^) y x = Concat [x; y]
+  let (^) y x = Concat (dummy_loc, [x; y])
 end
 
 module Json = struct
@@ -62,30 +67,30 @@ let escape_html s =
 
 let rec pp fmt = function
 
-  | String s ->
+  | String (_, s) ->
     Format.pp_print_string fmt s
 
-  | Escaped s ->
+  | Escaped (_, s) ->
     Format.fprintf fmt "{{ %s }}" s
 
-  | Unescaped s ->
+  | Unescaped (_, s) ->
     Format.fprintf fmt "{{& %s }}" s
 
-  | Inverted_section s ->
+  | Inverted_section (_, s) ->
     Format.fprintf fmt "{{^%s}}%a{{/%s}}"
       s.name pp s.contents s.name
 
-  | Section s ->
+  | Section (_, s) ->
     Format.fprintf fmt "{{#%s}}%a{{/%s}}"
       s.name pp s.contents s.name
 
-  | Partial s ->
+  | Partial (_, s) ->
     Format.fprintf fmt "{{> %s }}" s
 
-  | Comment s ->
+  | Comment (_, s) ->
     Format.fprintf fmt "{{! %s }}" s
 
-  | Concat s ->
+  | Concat (_, s) ->
     List.iter (pp fmt) s
 
 let to_formatter = pp
@@ -100,26 +105,26 @@ let to_string x =
 let rec fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat t =
   let go = fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat in
   match t with
-  | String s -> string s
-  | Escaped s -> escaped s
-  | Unescaped s -> unescaped s
-  | Comment s -> comment s
-  | Section { name; contents } ->
+  | String (_, s) -> string s
+  | Escaped (_, s) -> escaped s
+  | Unescaped (_, s) -> unescaped s
+  | Comment (_, s) -> comment s
+  | Section (_, { name; contents }) ->
     section ~inverted:false name (go contents)
-  | Inverted_section { name; contents } ->
+  | Inverted_section (_, { name; contents }) ->
     section ~inverted:true name (go contents)
-  | Concat ms ->
+  | Concat (_, ms) ->
     concat (List.map ms ~f:go)
-  | Partial p -> partial p
+  | Partial (_, p) -> partial p
 
-let raw s = String s
-let escaped s = Escaped s
-let unescaped s = Unescaped s
-let section n c = Section { name = n ; contents = c }
-let inverted_section n c = Inverted_section { name = n ; contents = c }
-let partial s = Partial s
-let concat t = Concat t
-let comment s = Comment s
+let raw s = String (dummy_loc, s)
+let escaped s = Escaped (dummy_loc, s)
+let unescaped s = Unescaped (dummy_loc, s)
+let section n c = Section (dummy_loc, { name = n ; contents = c })
+let inverted_section n c = Inverted_section (dummy_loc, { name = n ; contents = c })
+let partial s = Partial (dummy_loc, s)
+let concat t = Concat (dummy_loc, t)
+let comment s = Comment (dummy_loc, s)
 
 let rec expand_partials =
   let section ~inverted =
@@ -176,37 +181,37 @@ let render_fmt ?(strict=true) (fmt : Format.formatter) (m : t) (js : Json.t) =
 
   let rec render' m (js : Json.value) = match m with
 
-    | String s ->
+    | String (_, s) ->
       Format.pp_print_string fmt s
 
-    | Escaped "." ->
+    | Escaped (_, ".") ->
       Format.pp_print_string fmt (escape_html (Lookup.scalar js))
-    | Escaped key ->
+    | Escaped (_, key) ->
       Format.pp_print_string fmt (escape_html (Lookup.str ~strict ~key js))
 
-    | Unescaped "." ->
+    | Unescaped (_, ".") ->
       Format.pp_print_string fmt (Lookup.scalar js)
-    | Unescaped key ->
+    | Unescaped (_, key) ->
       Format.pp_print_string fmt (Lookup.str ~strict ~key js)
 
-    | Inverted_section s ->
+    | Inverted_section (loc, s) ->
       if Lookup.inverted js s.name
-      then render' (Section s) js
+      then render' (Section (loc, s)) js
 
-    | Section s ->
+    | Section (_, s) ->
       begin match Lookup.section ~strict js ~key:s.name with
       | `Bool false -> ()
       | `Bool true  -> render' s.contents js
       | `A contexts -> List.iter (render' s.contents) contexts
       | context     -> render' s.contents context
       end
 
-    | Partial _ ->
+    | Partial (_, _) ->
       pp fmt m
 
-    | Comment c -> ()
+    | Comment (_, c) -> ()
 
-    | Concat templates ->
+    | Concat (_, templates) ->
       List.iter (fun x -> render' x js) templates
 
   in render' m (Json.value js)
diff --git a/lib/mustache.mli b/lib/mustache.mli
@@ -20,19 +20,28 @@ module Json : sig (** Compatible with Ezjsonm *)
     | `O of (string * value) list ]
 end
 
+type loc = {
+  loc_start: Lexing.position;
+  loc_end: Lexing.position;
+}
+
 type t =
-  | String of string
-  | Escaped of string
-  | Section of section
-  | Unescaped of string
-  | Partial of string
-  | Inverted_section of section
-  | Concat of t list
-  | Comment of string
+  | String of loc * string
+  | Escaped of loc * string
+  | Section of loc * section
+  | Unescaped of loc * string
+  | Partial of loc * string
+  | Inverted_section of loc * section
+  | Concat of loc * t list
+  | Comment of loc * string
 and section =
   { name: string
   ; contents: t }
 
+(** A value of type [loc], guaranteed to be different from any valid
+    location.  *)
+val dummy_loc : loc
+
 (** Read *)
 val parse_lx : Lexing.lexbuf -> t
 val of_string : string -> t
diff --git a/lib/mustache_lexer.mll b/lib/mustache_lexer.mll
@@ -23,27 +23,42 @@
   open Lexing
   open Mustache_parser
   open Mustache_types
+
+  let with_space space f lexbuf =
+    let start_p = lexbuf.Lexing.lex_start_p in
+    let () = space lexbuf in
+    let x = f lexbuf in
+    space lexbuf;
+    lexbuf.Lexing.lex_start_p <- start_p;
+    x
 }
 
-let space = [' ' '\t' '\n']*
+let blank = [' ' '\t']*
+let newline = ('\n' | "\r\n")
+let raw = [^ '{' '}' '\n']*
 let id = ['a'-'z' 'A'-'Z' '_' '/'] ['a'-'z' 'A'-'Z' '0'-'9' '_' '/']+
 
-rule ident = parse
-  | space '.' space { "." }
-  | space (id as x) space { x }
+rule space = parse
+  | blank newline { new_line lexbuf; space lexbuf }
+  | blank { () }
+
+and ident = parse
+  | '.' { "." }
+  | (id as x) { x }
   | _ { raise (Invalid_template "Invalid section") }
 
 and mustache = parse
-  | "{{{"        { UNESCAPE_START (ident lexbuf) }
-  | "{{&"        { UNESCAPE_START_AMPERSAND (ident lexbuf) }
-  | "{{#"        { SECTION_START (ident lexbuf) }
-  | "{{^"        { SECTION_INVERT_START (ident lexbuf) }
-  | "{{/"        { SECTION_END (ident lexbuf) }
-  | "{{>"        { PARTIAL_START (ident lexbuf) }
+  | "{{{"        { UNESCAPE_START (with_space space ident lexbuf) }
+  | "{{&"        { UNESCAPE_START_AMPERSAND (with_space space ident lexbuf) }
+  | "{{#"        { SECTION_START (with_space space ident lexbuf) }
+  | "{{^"        { SECTION_INVERT_START (with_space space ident lexbuf) }
+  | "{{/"        { SECTION_END (with_space space ident lexbuf) }
+  | "{{>"        { PARTIAL_START (with_space space ident lexbuf) }
   | "{{!"        { COMMENT_START }
-  | "{{"         { ESCAPE_START (ident lexbuf) }
+  | "{{"         { ESCAPE_START (with_space space ident lexbuf) }
   | "}}}"        { UNESCAPE_END }
   | "}}"         { END }
-  | [^ '{' '}']* { RAW (lexeme lexbuf) }
+  | raw newline  { new_line lexbuf; RAW (lexeme lexbuf) }
+  | raw          { RAW (lexeme lexbuf) }
   | ['{' '}']    { RAW (lexeme lexbuf) }
   | eof          { EOF }
diff --git a/lib/mustache_parser.mly b/lib/mustache_parser.mly
@@ -29,6 +29,10 @@
       let msg =
         Printf.sprintf "Mismatched section %s with %s" start_s end_s in
       raise (Invalid_template msg)
+
+  let loc () =
+    { loc_start = Parsing.symbol_start_pos ();
+      loc_end = Parsing.symbol_end_pos () }
 %}
 
 %token EOF
@@ -51,19 +55,19 @@
 %%
 
 section:
-  | SECTION_INVERT_START END mustache SECTION_END END { Inverted_section (parse_section $1 $4 $3) }
-  | SECTION_START END mustache SECTION_END END { Section (parse_section $1 $4 $3) }
+  | SECTION_INVERT_START END mustache SECTION_END END { Inverted_section (loc (), parse_section $1 $4 $3) }
+  | SECTION_START END mustache SECTION_END END { Section (loc (), parse_section $1 $4 $3) }
 
 mustache_element:
-  | UNESCAPE_START UNESCAPE_END { Unescaped $1 }
-  | UNESCAPE_START_AMPERSAND END { Unescaped $1 }
-  | ESCAPE_START END { Escaped $1 }
-  | PARTIAL_START END { Partial $1 }
-  | COMMENT_START RAW END { Comment $2 }
+  | UNESCAPE_START UNESCAPE_END { Unescaped (loc (), $1) }
+  | UNESCAPE_START_AMPERSAND END { Unescaped (loc (), $1) }
+  | ESCAPE_START END { Escaped (loc (), $1) }
+  | PARTIAL_START END { Partial (loc (), $1) }
+  | COMMENT_START RAW END { Comment (loc (), $2) }
   | section { $1 }
 
 string:
-  | RAW { String $1 }
+  | RAW { String (loc (), $1) }
 
 mustache_l:
   | mustache_element mustache_l { ($1 :: $2) }
@@ -75,8 +79,8 @@ mustache:
   | mustache_l {
     match $1 with
     | [x] -> x
-    | x -> Concat x
+    | x -> Concat (loc (), x)
   }
-  | EOF { String "" }
+  | EOF { String (loc (), "") }
 
 %%
diff --git a/lib/mustache_types.ml b/lib/mustache_types.ml
@@ -19,15 +19,21 @@
    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
    FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
    IN THE SOFTWARE. }}}*)
+
+type loc = {
+  loc_start: Lexing.position;
+  loc_end: Lexing.position;
+}
+
 type t =
-  | String of string
-  | Escaped of string
-  | Section of section
-  | Unescaped of string
-  | Partial of string
-  | Inverted_section of section
-  | Concat of t list
-  | Comment of string
+  | String of loc * string
+  | Escaped of loc * string
+  | Section of loc * section
+  | Unescaped of loc * string
+  | Partial of loc * string
+  | Inverted_section of loc * section
+  | Concat of loc * t list
+  | Comment of loc * string
 and section = {
   name: string;
   contents: t;
