Add support for OCaml 4.07 (#167)

* Add support for OCaml 4.07

* try esy 0.2.11

* working nicely under 4.07!

* Fix code review comments and rebase on master

* forgot to regenerate the lockfile

* ignore

.gitignore

@@ -8,8 +8,10 @@ examples/*/_build
 examples/*/_opam
 examples/*/node_modules
 node_modules
+node_modules/
 log_types.txt
 *.install
+_esy
 _build
 _esy
 static/codemirror-5.36.0

codemod-example/ExampleCodemod.re

@@ -15,6 +15,7 @@ let replaceErrors = (ctx, expr) =>
       switch (expr.pexp_desc) {
         /* We should be more flexible here, e.g. to accept Result.Error() in addition to Error() */
       | Pexp_construct({txt: Longident.Lident("Error")} as lid, Some({pexp_desc: Pexp_tuple([arg])})) =>
+        let loc = Location.none
         switch (ctx->getExprType(arg)) {
           | Reference(Builtin("string"), []) => Some([%expr Error(Unspecified([%e arg]))])
           | _ => None
@@ -30,7 +31,7 @@ let modify = (ctx, structure) => {
             /* The type Belt.Result.t is just an alias for Belt_Result.t, and we have to specify the "original declaration" path */
           | Reference(Public({moduleName: "Belt_Result", modulePath: [], name: "t"}), [Reference(Builtin("int"), []), Reference(Builtin("string"), [])]) =>
             Some((args, ctx->replaceErrors(body)))
-          | _ => 
+          | _ =>
             None
           };
         })

codemod-example/dune

@@ -3,5 +3,4 @@
   (public_name ExampleCodemod.exe)
   (libraries Codemod Util TypeMap compiler-libs.common ocaml-migrate-parsetree reason)
   (flags :standard -open Util -w -26-32-50-9-27-39-33-35-6-3)
-  (preprocess (pps Belt_ppx Ppx_monads ppx_tools_versioned.metaquot_406))
-  )
+  (preprocess (pps Belt_ppx Ppx_monads ppxlib.metaquot)))

codemod/Codemod.re

@@ -26,10 +26,11 @@ let run = (~rootPath, ~filterPath, modify) => {
   let fullForCmt = (switch (package.compilerVersion) {
     | Analyze.BuildSystem.V402 => Process_402.fullForCmt
     | V406 => Process_406.fullForCmt
+    | V407 => Process_407.fullForCmt
   })(~allLocations=true);
 
-  let module Convert = Migrate_parsetree.Convert(Migrate_parsetree.OCaml_404, Migrate_parsetree.OCaml_406);
-  let module ConvertBack = Migrate_parsetree.Convert(Migrate_parsetree.OCaml_406, Migrate_parsetree.OCaml_404);
+  let module Convert = Migrate_parsetree.Convert(Migrate_parsetree.OCaml_404, Migrate_parsetree.OCaml_407);
+  let module ConvertBack = Migrate_parsetree.Convert(Migrate_parsetree.OCaml_407, Migrate_parsetree.OCaml_404);
 
   package.Analyze.TopTypes.localModules->Belt.List.forEach(moduleName => {
     let%opt_force paths = Utils.maybeHash(package.pathsForModule, moduleName);

codemod/dune

@@ -3,5 +3,5 @@
   (public_name ReasonLanguageServer.Codemod)
   (libraries Analyze Util TypeMap compiler-libs.common ocaml-migrate-parsetree reason)
   (flags :standard -open Util -w -26-32-50-9-27-39-33-35-6-3)
-  (preprocess (pps Belt_ppx Ppx_monads ppx_tools_versioned.metaquot_406))
+  (preprocess (pps Belt_ppx Ppx_monads ppxlib.metaquot))
   )

core/Query.re

@@ -47,16 +47,16 @@ let findInScope = (pos, name, stamps) => {
 
 let rec joinPaths = (modulePath, path) => {
   switch modulePath {
-    | Path.Pident({stamp, name}) => (stamp, name, path)
+    | Path.Pident(ident) => (Ident.binding_time(ident), Ident.name(ident), path)
     | Path.Papply(fnPath, _argPath) => joinPaths(fnPath, path)
     | Path.Pdot(inner, name, _) => joinPaths(inner, Nested(name, path))
   }
 };
 
 let rec makePath = (modulePath) => {
   switch modulePath {
-    | Path.Pident({stamp: 0, name}) => `GlobalMod(name)
-    | Path.Pident({stamp, name}) => `Stamp(stamp)
+    | Path.Pident(ident) when Ident.binding_time(ident) === 0 => `GlobalMod(Ident.name(ident))
+    | Path.Pident(ident) => `Stamp(Ident.binding_time(ident))
     | Path.Papply(fnPath, _argPath) => makePath(fnPath)
     | Path.Pdot(inner, name, _) => `Path(joinPaths(inner, Tip(name)))
   }
@@ -279,4 +279,4 @@ let rec getSourceUri = (~env, ~getModule, path) => switch path {
   | ExportedModule(_, inner)
   | HiddenModule(_, inner)
   | Expression(inner) => getSourceUri(~env, ~getModule, inner)
-};
+};

esy.json

@@ -10,13 +10,12 @@
     "@esy-ocaml/reason": "*",
     "@opam/ocaml-migrate-parsetree": "*",
     "@opam/ppx_tools_versioned": "*",
+    "@opam/ppx_tools": "*",
+    "@opam/ppxlib": "*",
     "rex-json": "*",
-    "ocaml": "~4.6.0"
-  },
-  "resolutions": {
-    "@esy-ocaml/esy-installer": "0.0.1"
+    "ocaml": "~4.7.2"
   },
   "devDependencies": {
-    "ocaml": "~4.6.0"
+    "ocaml": "~4.7.2"
   }
-}
+}

ocaml_typing/402/ident.ml

@@ -12,7 +12,7 @@
 
 open Format
 
-type t = Current.ident = { stamp: int; name: string; mutable flags: int }
+type t = { stamp: int; name: string; mutable flags: int }
 
 let global_flag = 1
 let predef_exn_flag = 2

ocaml_typing/402/ident.mli

@@ -12,7 +12,7 @@
 
 (* Identifiers (unique names) *)
 
-type t = Current.ident = { stamp: int; name: string; mutable flags: int }
+type t = { stamp: int; name: string; mutable flags: int }
 
 val create: string -> t
 val create_persistent: string -> t

ocaml_typing/402/location.ml

@@ -16,7 +16,7 @@ let absname = ref false
     (* This reference should be in Clflags, but it would create an additional
        dependency and make bootstrapping Camlp4 more difficult. *)
 
-type t = Current.location ={ loc_start: position; loc_end: position; loc_ghost: bool };;
+type t = Current.location = { loc_start: position; loc_end: position; loc_ghost: bool };;
 
 let in_file name =
   let loc = {
@@ -104,24 +104,24 @@ let highlight_terminfo ppf num_lines lb locs =
   (* If too many lines, give up *)
   if !lines >= num_lines - 2 then raise Exit;
   (* Move cursor up that number of lines *)
-  flush stdout; Terminfo.backup !lines;
+  flush stdout; Terminfo.backup stdout !lines;
   (* Print the input, switching to standout for the location *)
   let bol = ref false in
   print_string "# ";
   for pos = 0 to lb.lex_buffer_len - pos0 - 1 do
     if !bol then (print_string "  "; bol := false);
     if List.exists (fun loc -> pos = loc.loc_start.pos_cnum) locs then
-      Terminfo.standout true;
+      Terminfo.standout stdout true;
     if List.exists (fun loc -> pos = loc.loc_end.pos_cnum) locs then
-      Terminfo.standout false;
+      Terminfo.standout stdout false;
     let c = Bytes.get lb.lex_buffer (pos + pos0) in
     print_char c;
     bol := (c = '\n')
   done;
   (* Make sure standout mode is over *)
-  Terminfo.standout false;
+  Terminfo.standout stdout false;
   (* Position cursor back to original location *)
-  Terminfo.resume !num_loc_lines;
+  Terminfo.resume stdout !num_loc_lines;
   flush stdout
 
 (* Highlight the location by printing it again. *)
@@ -297,7 +297,7 @@ let echo_eof () =
   print_newline ();
   incr num_loc_lines
 
-type 'a loc = 'a Current.loc = {
+type 'a loc = 'a Current.loc =  {
   txt : 'a;
   loc : t;
 }

ocaml_typing/402/location.mli

@@ -14,11 +14,7 @@
 
 open Format
 
-type t = Current.location = {
-  loc_start: Lexing.position;
-  loc_end: Lexing.position;
-  loc_ghost: bool;
-}
+type t = Current.location = { loc_start: Lexing.position; loc_end: Lexing.position; loc_ghost: bool }
 
 (* Note on the use of Lexing.position in this module.
    If [pos_fname = ""], then use [!input_name] instead.
@@ -68,7 +64,7 @@ val default_warning_printer : t -> formatter -> Warnings.t -> unit
 
 val highlight_locations: formatter -> t list -> bool
 
-type 'a loc = 'a Current.loc = {
+type 'a loc = 'a Current.loc =  {
   txt : 'a;
   loc : t;
 }

ocaml_typing/402/path.ml

@@ -10,7 +10,7 @@
 (*                                                                     *)
 (***********************************************************************)
 
-type t = Current.path =
+type t =
     Pident of Ident.t
   | Pdot of t * string * int
   | Papply of t * t

ocaml_typing/402/path.mli

@@ -12,7 +12,7 @@
 
 (* Access paths *)
 
-type t = Current.path =
+type t =
     Pident of Ident.t
   | Pdot of t * string * int
   | Papply of t * t

ocaml_typing/402/terminfo.ml

@@ -1,23 +1,45 @@
-(***********************************************************************)
-(*                                                                     *)
-(*                                OCaml                                *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* Basic interface to the terminfo database *)
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Gallium, INRIA Paris                  *)
+(*                                                                        *)
+(*   Copyright 2017 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Printf
+
+external isatty : out_channel -> bool = "caml_sys_isatty"
+external terminfo_rows: out_channel -> int = "caml_terminfo_rows"
 
 type status =
   | Uninitialised
   | Bad_term
   | Good_term of int
-;;
-external setup : out_channel -> status = "caml_terminfo_setup";;
-external backup : int -> unit = "caml_terminfo_backup";;
-external standout : bool -> unit = "caml_terminfo_standout";;
-external resume : int -> unit = "caml_terminfo_resume";;
+
+let num_lines oc =
+  let rows = terminfo_rows oc in
+  if rows > 0 then rows else 24
+    (* 24 is a reasonable default for an ANSI-style terminal *)
+
+let setup oc =
+  let term = try Sys.getenv "TERM" with Not_found -> "" in
+  (* Same heuristics as in Misc.Color.should_enable_color *)
+  if term <> "" && term <> "dumb" && isatty oc
+  then Good_term (num_lines oc)
+  else Bad_term
+
+let backup oc n =
+  if n >= 1 then fprintf oc "\027[%dA%!" n
+
+let resume oc n =
+  if n >= 1 then fprintf oc "\027[%dB%!" n
+
+let standout oc b =
+  output_string oc (if b then "\027[4m" else "\027[0m"); flush oc

ocaml_typing/402/terminfo.mli

@@ -17,7 +17,9 @@ type status =
   | Bad_term
   | Good_term of int  (* number of lines of the terminal *)
 ;;
-external setup : out_channel -> status = "caml_terminfo_setup";;
-external backup : int -> unit = "caml_terminfo_backup";;
-external standout : bool -> unit = "caml_terminfo_standout";;
-external resume : int -> unit = "caml_terminfo_resume";;
+
+val setup : out_channel -> status
+val num_lines : out_channel -> int
+val backup : out_channel -> int -> unit
+val standout : out_channel -> bool -> unit
+val resume : out_channel -> int -> unit

ocaml_typing/406/annot.mli

@@ -0,0 +1,24 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Damien Doligez, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Data types for annotations (Stypes.ml) *)
+
+type call = Tail | Stack | Inline;;
+
+type ident =
+  | Iref_internal of Location.t (* defining occurrence *)
+  | Iref_external
+  | Idef of Location.t          (* scope *)
+;;