Add end position

src/Makefile

@@ -3,17 +3,31 @@ all: opam-file-format.cmxa opam-file-format.cma
 %.ml: %.mll
 	ocamllex $<
 
+OCAML_VERSION:=$(shell ocamlc -vnum | tr -d '\r' | sed -e 's/+.*//' -e 's/\.//g')
+ifeq ($(OCAML_VERSION),)
+OCAML_VERSION:=0
+endif
+
+ifeq ($(shell test $(OCAML_VERSION) -ge 4022 || echo no-attributes),)
+PP=
+else
+PP=-pp 'sed -e s/\\[@@\\?ocaml[^]]*\\]//'
+endif
+
+show:
+	echo $(OCAML_VERSION)
+
 %.ml %.mli: %.mly
 	ocamlyacc $<
 
 %.cmi: %.mli
-	ocamlc -c $<
+	ocamlc -c $(PP) $<
 
 %.cmo: %.ml %.cmi
-	ocamlc -c $<
+	ocamlc -c $(PP) $<
 
 %.cmx: %.ml %.cmi
-	ocamlopt -c $<
+	ocamlopt -c $(PP) $<
 
 MODULES = $(sort $(basename $(wildcard *.ml *.mll *.mly)))
 
@@ -41,6 +55,6 @@ clean:
 	rm -f *.cm* *.o *.a $(GENERATED) .depend .merlin
 
 .depend: *.ml *.mli $(GENERATED)
-	ocamldep *.mli *.ml > .depend
+	ocamldep $(PP) *.mli *.ml > .depend
 
 -include .depend

src/dune

@@ -3,7 +3,16 @@
   (public_name opam-file-format)
   (synopsis "Parser and printer for the opam file syntax")
   (wrapped false)
+  (flags :standard (:include flags.sexp))
   (modules_without_implementation opamParserTypes))
 
+(rule
+  (with-stdout-to flags.ml
+    (echo "print_string (if String.sub Sys.ocaml_version 0 5 = \"4.02.\" then \"(-w -50)\" else \"()\")")))
+
+(rule
+  (with-stdout-to flags.sexp
+    (run ocaml %{dep:flags.ml})))
+
 (ocamlyacc opamBaseParser)
 (ocamllex opamLexer)

src/opamBaseParser.mly

@@ -11,15 +11,20 @@
 
 %{
 
-open OpamParserTypes
+open OpamParserTypes.FullPos
 
 (** Opam config file generic type parser *)
 
-let get_pos n =
-  let pos = Parsing.rhs_start_pos n in
-  Lexing.(pos.pos_fname,
-          pos.pos_lnum,
-          pos.pos_cnum - pos.pos_bol)
+let get_pos_full ?(s=1) n =
+  let spos = Parsing.rhs_start_pos s in
+  let epos = Parsing.rhs_end_pos n in
+  Lexing.({
+      filename = spos.pos_fname;
+      start = spos.pos_lnum, spos.pos_cnum - spos.pos_bol;
+      stop = epos.pos_lnum, epos.pos_cnum - epos.pos_bol;
+    })
+
+let get_pos n = get_pos_full ~s:n n
 
 %}
 
@@ -31,11 +36,11 @@ let get_pos n =
 %token LBRACE RBRACE
 %token COLON
 %token <int> INT
-%token <OpamParserTypes.relop> RELOP
+%token <OpamParserTypes.FullPos.relop_kind> RELOP
 %token AND
 %token OR
-%token <OpamParserTypes.pfxop> PFXOP
-%token <OpamParserTypes.env_update_op> ENVOP
+%token <OpamParserTypes.FullPos.pfxop_kind> PFXOP
+%token <OpamParserTypes.FullPos.env_update_op_kind> ENVOP
 
 %left COLON
 %left ATOM
@@ -48,8 +53,10 @@ let get_pos n =
 %nonassoc URELOP
 
 %start main value
-%type <string -> OpamParserTypes.opamfile> main
-%type <OpamParserTypes.value> value
+%type <string -> OpamParserTypes.FullPos.opamfile> main
+%type <OpamParserTypes.FullPos.value> value
+%type <OpamParserTypes.FullPos.value list> values
+%type <OpamParserTypes.FullPos.opamfile_item> item
 
 %%
 
@@ -64,28 +71,46 @@ items:
 ;
 
 item:
-| IDENT COLON value                { Variable (get_pos 1, $1, $3) }
+| IDENT COLON value                {
+  { pos = get_pos_full 3;
+    pelem =
+      Variable ({ pos = get_pos 1; pelem =  $1 }, $3);
+  }
+}
 | IDENT LBRACE items RBRACE {
-  Section (get_pos 1,
-           {section_kind=$1; section_name=None; section_items= $3})
+  { pos = get_pos_full 4;
+    pelem =
+      Section ({section_kind = { pos = get_pos 1; pelem = $1 };
+                section_name = None;
+                section_items =
+                  { pos = get_pos_full ~s:2 4; pelem = $3 };
+               })
+  }
 }
 | IDENT STRING LBRACE items RBRACE {
-  Section (get_pos 1,
-           {section_kind=$1; section_name=Some $2; section_items= $4})
+  { pos = get_pos_full 4;
+    pelem =
+      Section ({section_kind = { pos = get_pos 1; pelem = $1 };
+                section_name = Some { pos = get_pos 2; pelem = $2 };
+                section_items =
+                  { pos = get_pos_full ~s:2 4; pelem = $4 };
+               })
+  }
 }
 ;
 
 value:
 | atom            %prec ATOM { $1 }
-| LPAR values RPAR           { Group (get_pos 1,$2) }
-| LBRACKET values RBRACKET   { List (get_pos 1,$2) }
-| value LBRACE values RBRACE { Option (get_pos 2,$1, $3) }
-| value AND value            { Logop (get_pos 2,`And,$1,$3) }
-| value OR value             { Logop (get_pos 2,`Or,$1,$3) }
-| atom RELOP atom            { Relop (get_pos 2,$2,$1,$3) }
-| atom ENVOP atom            { Env_binding (get_pos 1,$1,$2,$3) }
-| PFXOP value                { Pfxop (get_pos 1,$1,$2) }
-| RELOP atom                 { Prefix_relop (get_pos 1,$1,$2) }
+| LPAR values RPAR           {{ pos = get_pos_full 3 ; pelem = Group { pos = get_pos_full ~s:1 3; pelem = $2 } }}
+| LBRACKET values RBRACKET   {{ pos = get_pos_full 3 ; pelem = List { pos = get_pos_full ~s:1 3; pelem = $2 } }}
+| value LBRACE values RBRACE {{ pos = get_pos_full 4 ;
+                                pelem = Option ($1, { pos = get_pos_full ~s:2 4; pelem = $3 }) }}
+| value AND value            {{ pos = get_pos_full 3 ; pelem = Logop ({ pos = get_pos 2 ; pelem = `And },$1,$3) }}
+| value OR value             {{ pos = get_pos_full 3 ; pelem = Logop ({ pos = get_pos 2 ; pelem = `Or },$1,$3) }}
+| atom RELOP atom            {{ pos = get_pos_full 3 ; pelem = Relop ({ pos = get_pos 2 ; pelem = $2 },$1,$3) }}
+| atom ENVOP atom            {{ pos = get_pos_full 3 ; pelem = Env_binding ($1,{ pos = get_pos 2 ; pelem = $2 },$3) }}
+| PFXOP value                {{ pos = get_pos_full 2 ; pelem = Pfxop ({ pos = get_pos 1 ; pelem = $1 },$2) }}
+| RELOP atom                 {{ pos = get_pos_full 2 ; pelem = Prefix_relop ({ pos = get_pos 1 ; pelem = $1 },$2) }}
 ;
 
 values:
@@ -94,10 +119,10 @@ values:
 ;
 
 atom:
-| IDENT                      { Ident (get_pos 1,$1) }
-| BOOL                       { Bool (get_pos 1,$1) }
-| INT                        { Int (get_pos 1,$1) }
-| STRING                     { String (get_pos 1,$1) }
+| IDENT                      {{ pos = get_pos 1 ; pelem = Ident $1 }}
+| BOOL                       {{ pos = get_pos 1 ; pelem = Bool $1 }}
+| INT                        {{ pos = get_pos 1 ; pelem = Int $1 }}
+| STRING                     {{ pos = get_pos 1 ; pelem = String $1 }}
 ;
 
 %%

src/opamLexer.mli

@@ -17,17 +17,35 @@ exception Error of string
 (** Raised on any lexing error with a description of the fault. Note that
     [Failure "lexing: empty token"] is never raised by the lexer. *)
 
+val token: Lexing.lexbuf -> OpamBaseParser.token
+
+(** [OpamLexer] transitional module with full position types *)
+module FullPos : sig
+
+  open OpamParserTypes.FullPos
+
+  val relop: string -> relop_kind
+  (** Inverse of {!OpamPrinter.relop} *)
+
+  val logop: string -> logop_kind
+  (** Inverse of {!OpamPrinter.logop} *)
+
+  val pfxop: string -> pfxop_kind
+  (** Inverse of {!OpamPrinter.pfxop} *)
+
+  val env_update_op: string -> env_update_op_kind
+  (** Inverse of {!OpamPrinter.env_update_op} *)
+
+end
+
 val relop: string -> relop
-(** Inverse of {!OpamPrinter.relop} *)
+[@@ocaml.deprecated "Use OpamLexer.FullPos.relop instead."]
 
 val logop: string -> logop
-(** Inverse of {!OpamPrinter.logop} *)
+[@@ocaml.deprecated "Use OpamLexer.FullPos.logop instead."]
 
 val pfxop: string -> pfxop
-(** Inverse of {!OpamPrinter.pfxop} *)
+[@@ocaml.deprecated "Use OpamLexer.FullPos.pfxop instead."]
 
 val env_update_op: string -> env_update_op
-(** Inverse of {!OpamPrinter.env_update_op} *)
-
-
-val token: Lexing.lexbuf -> OpamBaseParser.token
+[@@ocaml.deprecated "Use OpamLexer.FullPos.env_update_op instead."]

src/opamLexer.mll

@@ -40,7 +40,7 @@ let pfxop = function
   | "?" -> `Defined
   | x -> error "%S is not a valid prefix operator" x
 
-let env_update_op = function
+let env_update_op : string -> env_update_op = function
   | "=" -> Eq
   | "+=" -> PlusEq
   | "=+" -> EqPlus
@@ -49,6 +49,13 @@ let env_update_op = function
   | "=:" -> EqColon
   | x -> error "%S is not a valid environment update operator" x
 
+module FullPos = struct
+  let relop = relop
+  let logop = logop
+  let pfxop = pfxop
+  let env_update_op = env_update_op
+end
+
 let char_for_backslash = function
   | 'n' -> '\010'
   | 'r' -> '\013'
@@ -119,11 +126,11 @@ rule token = parse
 | "false"{ BOOL false }
 | int    { INT (int_of_string (Lexing.lexeme lexbuf)) }
 | ident  { IDENT (Lexing.lexeme lexbuf) }
-| relop  { RELOP (relop (Lexing.lexeme lexbuf)) }
+| relop  { RELOP (FullPos.relop (Lexing.lexeme lexbuf)) }
 | '&'    { AND }
 | '|'    { OR }
-| pfxop  { PFXOP (pfxop (Lexing.lexeme lexbuf)) }
-| envop  { ENVOP (env_update_op (Lexing.lexeme lexbuf)) }
+| pfxop  { PFXOP (FullPos.pfxop (Lexing.lexeme lexbuf)) }
+| envop  { ENVOP (FullPos.env_update_op (Lexing.lexeme lexbuf)) }
 | eof    { EOF }
 | _      { let token = Lexing.lexeme lexbuf in
            error "'%s' is not a valid token" token }

src/opamParser.ml

@@ -29,15 +29,78 @@ let parse_from_file parse_fun filename =
     r
   with e -> close_in ic; raise e
 
+(** file parsers *)
+let main' main filename lexer lexbuf = main lexer lexbuf filename
+let string main str filename = parse_from_string (main' main filename) str filename
+let channel main ic filename = parse_from_channel (main' main filename) ic filename
+let file main filename = parse_from_file (main' main filename) filename
+
+module FullPos = struct
+
+  open OpamParserTypes.FullPos
+
+  (** raw parser entry points *)
+  let main = OpamBaseParser.main
+  let value = OpamBaseParser.value
+
+  (** file parsers *)
+  let string = string main
+  let channel = channel main
+  let file = file main
+
+  (** value parsers *)
+  let value_from_string = parse_from_string value
+  let value_from_channel = parse_from_channel value
+  let value_from_file = parse_from_file value
+
+  (* Functions to transform simple pos to full pos *)
+  module S = OpamParserTypes
+
+  let to_pos e = (e.pos.filename, fst e.pos.start, snd e.pos.start)
+
+  let rec to_value v =
+    match v.pelem with
+    | Bool b -> S.Bool (to_pos v, b)
+    | Int i -> S.Int (to_pos v, i)
+    | String s -> S.String (to_pos v, s)
+    | Relop (r,v,v') -> S.Relop (to_pos r, r.pelem, to_value v, to_value v')
+    | Prefix_relop (r,v) -> S.Prefix_relop (to_pos r, r.pelem, to_value v)
+    | Logop (l,v,v') -> S.Logop (to_pos l, l.pelem, to_value v, to_value v')
+    | Pfxop (p,v) -> S.Pfxop (to_pos p, p.pelem, to_value v)
+    | Ident s -> S.Ident (to_pos v, s)
+    | List l -> S.List (to_pos l, List.map to_value l.pelem)
+    | Group g -> S.Group (to_pos g, List.map to_value g.pelem)
+    | Option (v,vl) -> S.Option (to_pos vl, to_value v, List.map to_value vl.pelem)
+    | Env_binding (v,o,v') -> S.Env_binding (to_pos o, to_value v, o.pelem, to_value v')
+
+  let rec to_section s =
+    { S.section_kind = s.section_kind.pelem;
+      S.section_name =
+        (match s.section_name with
+         | Some n -> Some n.pelem
+         | None -> None);
+      S.section_items = List.map to_item s.section_items.pelem
+    }
+  and to_item i =
+    match i.pelem with
+    | Section s -> S.Section (to_pos s.section_kind, to_section s)
+    | Variable (s, v) -> S.Variable (to_pos s, s.pelem, to_value v)
+
+  let to_opamfile o =
+    { S.file_contents = List.map to_item o.file_contents;
+      S.file_name = o.file_name
+    }
+
+end
+
 (** raw parser entry points *)
-let main = OpamBaseParser.main
-let value = OpamBaseParser.value
+let main f l fd = FullPos.to_opamfile (OpamBaseParser.main f l fd)
+let value f l = FullPos.to_value (OpamBaseParser.value f l)
 
 (** file parsers *)
-let main' filename lexer lexbuf = main lexer lexbuf filename
-let string str filename = parse_from_string (main' filename) str filename
-let channel ic filename = parse_from_channel (main' filename) ic filename
-let file filename = parse_from_file (main' filename) filename
+let string = string main
+let channel = channel main
+let file = file main
 
 (** value parsers *)
 let value_from_string = parse_from_string value