From 7c5624b448aa8855b2dd44ea733da02fe9a2f31f Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jeremie@dimino.org>
Date: Tue, 19 Jun 2018 15:58:21 +0100
Subject: [PATCH] Add support for declaring when syntactic elements are
 deleted/removed/renamed

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
---
 src/jbuild.ml  | 50 ++++++++++++++++++++++----------------------------
 src/syntax.ml  | 50 +++++++++++++++++++++++++++++++++++++++++++++++---
 src/syntax.mli | 25 ++++++++++++++++++++++---
 3 files changed, 91 insertions(+), 34 deletions(-)

diff --git a/src/jbuild.ml b/src/jbuild.ml
index e45210eb..0e8d4ff0 100644
--- a/src/jbuild.ml
+++ b/src/jbuild.ml
@@ -6,7 +6,7 @@ open Sexp.Of_sexp
 *)
 
 let syntax =
-  Syntax.create ~name:"dune"
+  Syntax.create ~name:"dune" ~desc:"the dune language"
     [ (0, 0) (* Jbuild syntax *)
     ; (1, 0)
     ]
@@ -907,15 +907,11 @@ module Executables = struct
     ; buildable  : Buildable.t
     }
 
-  let common names public_names ~syntax ~multi =
+  let common names public_names ~multi =
     Buildable.t >>= fun buildable ->
-    (match (syntax : File_tree.Dune_file.Kind.t) with
-     | Dune ->
-       return ()
-     | Jbuild ->
-       field "link_executables" bool ~default:true >>= fun _ ->
-       return ())
-    >>= fun () ->
+    field "link_executables" ~default:true
+      (Syntax.deleted_in syntax (1, 0) >>> bool)
+    >>= fun (_ : bool) ->
     field "link_deps" (list Dep_conf.t) ~default:[] >>= fun link_deps ->
     field_oslu "link_flags" >>= fun link_flags ->
     field "modes" Link_mode.Set.t ~default:Link_mode.Set.default
@@ -987,7 +983,7 @@ module Executables = struct
     | "-" -> None
     | s   -> Some s
 
-  let multi ~syntax =
+  let multi =
     record
       (field "names" (list (located string)) >>= fun names ->
        map_validate (field_o "public_names" (list public_name)) ~f:(function
@@ -999,13 +995,13 @@ module Executables = struct
              Error "The list of public names must be of the same \
                     length as the list of names")
        >>= fun public_names ->
-       common ~syntax names public_names ~multi:true)
+       common names public_names ~multi:true)
 
-  let single ~syntax =
+  let single =
     record
       (field   "name" (located string) >>= fun name ->
        field_o "public_name" string >>= fun public_name ->
-       common ~syntax [name] [public_name] ~multi:false)
+       common [name] [public_name] ~multi:false)
 end
 
 module Rule = struct
@@ -1294,12 +1290,12 @@ module Stanzas = struct
 
   type constructors = (string * Stanza.t list Sexp.Of_sexp.t) list
 
-  let common ~syntax : constructors =
+  let stanzas : constructors =
     [ "library",
       (Library.t >>| fun x ->
        [Library x])
-    ; "executable" , Executables.single ~syntax >>| execs
-    ; "executables", Executables.multi  ~syntax >>| execs
+    ; "executable" , Executables.single >>| execs
+    ; "executables", Executables.multi  >>| execs
     ; "rule",
       (loc >>= fun loc ->
        Rule.t >>| fun x ->
@@ -1335,23 +1331,21 @@ module Stanzas = struct
     ; "documentation",
       (Documentation.t >>| fun d ->
        [Documentation d])
-    ]
-
-  let dune =
-    common ~syntax:Dune @
-    [ "env",
-      (loc >>= fun loc ->
+    ; "jbuild_version",
+      (Syntax.deleted_in syntax (1, 0) >>= fun () ->
+       Jbuild_version.t >>| fun _ -> [])
+    ; "env",
+      (Syntax.since syntax (1, 0) >>= fun () ->
+       loc >>= fun loc ->
        repeat Env.rule >>| fun rules ->
        [Env { loc; rules }])
     ]
 
-  let jbuild =
-    common ~syntax:Jbuild @
-    [ "jbuild_version", (Jbuild_version.t >>| fun _ -> [])
-    ]
+  let jbuild_parser =
+    Syntax.set syntax (0, 0) (sum stanzas)
 
   let () =
-    Dune_project.Lang.register syntax dune
+    Dune_project.Lang.register syntax stanzas
 
   exception Include_loop of Path.t * (Loc.t * Path.t) list
 
@@ -1375,7 +1369,7 @@ module Stanzas = struct
     let stanza_parser =
       Dune_project.set project
         (match (kind : File_tree.Dune_file.Kind.t) with
-         | Jbuild -> sum jbuild
+         | Jbuild -> jbuild_parser
          | Dune   -> project.stanza_parser)
     in
     let stanzas =
diff --git a/src/syntax.ml b/src/syntax.ml
index c197ba42..3c3eed61 100644
--- a/src/syntax.ml
+++ b/src/syntax.ml
@@ -51,12 +51,14 @@ end
 
 type t =
   { name : string
+  ; desc : string
   ; key  : Version.t Univ_map.Key.t
   ; supported_versions : Supported_versions.t
   }
 
-let create ~name supported_versions =
+let create ~name ~desc supported_versions =
   { name
+  ; desc
   ; key = Univ_map.Key.create ()
   ; supported_versions = Supported_versions.make supported_versions
   }
@@ -81,13 +83,55 @@ let greatest_supported_version t =
 
 let key t = t.key
 
+open Sexp.Of_sexp
+
 let set t ver parser =
-  Sexp.Of_sexp.set t.key ver parser
+  set t.key ver parser
 
 let get_exn t =
-  let open Sexp.Of_sexp in
   get t.key >>| function
   | Some x -> x
   | None ->
     Exn.code_error "Syntax identifier is unset"
       [ "name", Sexp.To_sexp.string t.name ]
+
+let desc () =
+  kind >>| fun kind ->
+  match kind with
+  | Values (loc, None) -> (loc, "This syntax")
+  | Fields (loc, None) -> (loc, "This field")
+  | Values (loc, Some s) -> (loc, sprintf "'%s'" s)
+  | Fields (loc, Some s) -> (loc, sprintf "Field '%s'" s)
+
+let deleted_in t ver =
+  get_exn t >>= fun current_ver ->
+  if current_ver < ver then
+    return ()
+  else begin
+    desc () >>= fun (loc, what) ->
+    Loc.fail loc
+      "%s was deleted in version %s of %s" what
+      (Version.to_string ver) t.desc
+  end
+
+let renamed_in t ver ~to_ =
+  get_exn t >>= fun current_ver ->
+  if current_ver < ver then
+    return ()
+  else begin
+    desc () >>= fun (loc, what) ->
+    Loc.fail loc
+      "%s was renamed to '%s' in %s of %s" what to_
+      (Version.to_string ver) t.desc
+  end
+
+let since t ver =
+  get_exn t >>= fun current_ver ->
+  if current_ver >= ver then
+    return ()
+  else begin
+    desc () >>= fun (loc, what) ->
+    Loc.fail loc
+      "%s is only available since version %s of %s" what
+      (Version.to_string ver) t.desc
+  end
diff --git a/src/syntax.mli b/src/syntax.mli
index a89e5dd7..7faf305c 100644
--- a/src/syntax.mli
+++ b/src/syntax.mli
@@ -20,10 +20,11 @@ end
 
 type t
 
-(** [create ~name supported_versions] defines a new
+(** [create ~name ~desc supported_versions] defines a new
     syntax. [supported_version] is the list of the last minor version
-    of each supported major version. *)
-val create : name:string -> Version.t list -> t
+    of each supported major version. [desc] is used to describe what
+    this syntax represent in error messages. *)
+val create : name:string -> desc:string -> Version.t list -> t
 
 (** Return the name of the syntax. *)
 val name : t -> string
@@ -33,6 +34,24 @@ val check_supported : t -> Loc.t * Version.t -> unit
 
 val greatest_supported_version : t -> Version.t
 
+(** {1 S-expression parsing} *)
+
+(** {2 High-level functions} *)
+
+(** Indicate the field/constructor being parsed was deleted in the
+    given version *)
+val deleted_in : t -> Version.t -> (unit, _) Sexp.Of_sexp.parser
+
+(** Indicate the field/constructor being parsed was renamed in the
+    given version *)
+val renamed_in : t -> Version.t -> to_:string ->  (unit, _) Sexp.Of_sexp.parser
+
+(** Indicate the field/constructor being parsed was introduced in the
+    given version *)
+val since : t -> Version.t ->  (unit, _) Sexp.Of_sexp.parser
+
+(** {2 Low-level functions} *)
+
 val set
   :  t
   -> Version.t