Skip to content

Commit

Permalink
Use OMP2 + ppxlib instead of OMP1 (#1482)
Browse files Browse the repository at this point in the history 
Closes #1460

The most visible API change is that `Ast_mapper` (record-based) is
replaced by `Ppxlib.Ast_traverse` (object-based). The port is mostly
mechanical, replacing fields by methods and `default_mapper` by `super`.
Ppxlib has more hooks so it is possible to override `location_stack` in
one go for example.

OMP (like compiler-libs) provides two ways to print ASTs: `Pprintast`
outputs concrete syntax (`let x = 1 in x`) and is provided by ppxlib.
`Printast` outputs a form closer to the `Parsetree` representation
(`Pexp_let (Ppat_var "x", Pexp_const 1, Pexp_var "x"`), but ppxlib does
not provide that. It exposes a s-expression converter, so we use that
instead. This is only used in debug messages.

`Location` is used for two different things: the type and relative
functions are used by ocamlformat as a whole. In ppxlib, the API is
slightly different, so there are minor changes. `Location.input_name`
however is used by the parser, so we need to refer to the one in
compiler libs as `Ocaml_common.Location.input_name`.

`parse-wyc` is a special case because it uses a 4.08 parser, so it
produces a 4.08 AST. The library is split in two between the parser and
associated modules that operate on the 4.08 and the rest that uses the
ppxlib AST. The modified parser inserts generated nodes in places that
would correspond to parse errors. For example, if it determines that
some sequence of tokens can only form an expression (but it's missing
some tokens to do so in a valid way), it will emit `[%merlin.hole]` as
an expression. Later, an AST mapper walks the AST and needs to determine
if an expression is generated or not. This is simple with OMP, but with
ppxlib we use two different AST versions: the parser uses 4.08 (from
OMP) and the mapper uses 4.11 (at the time; more generally, the one
ppxlib uses). So in the Annot module, the mk functions return a 4.08 AST
(they are called by the parser), but the is_generated functions expect a
4.11 one (they are called by a mapper after migration).
  • Loading branch information
@emillon
emillon committed Nov 2, 2020
1 parent cfa6d92 commit 56d79b2
Show file tree
Hide file tree
Showing 18 changed files with 459 additions and 542 deletions.
6 changes: 6 additions & 0 deletions CHANGES.md
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,9 @@
### unreleased

#### Internal

+ Use ppxlib instead of ocaml-migrate-parsetree 1.x. (#1482, @emillon)

### 0.15.0 (2020-08-06)

#### Changes
Expand Down
85 changes: 20 additions & 65 deletions lib/Cmts.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,6 @@

module Format = Format_
open Migrate_ast
open Asttypes
open Parsetree

type t =
Expand Down Expand Up @@ -42,48 +41,6 @@ let find_at_position t loc pos =
in
Location.Multimap.find map loc

module Loc_tree : sig
include Non_overlapping_interval_tree.S with type itv = Location.t

val of_ast : 'a Mapper.fragment -> 'a -> Source.t -> t * Location.t list
end = struct
include Non_overlapping_interval_tree.Make (Location)

(* Use Ast_mapper to collect all locs in ast, and create tree of them. *)

let of_ast fragment ast src =
let attribute (m : Ast_mapper.mapper) attr =
(* ignore location of docstrings *)
if Ast.Attr.is_doc attr then attr
else Ast_mapper.default_mapper.attribute m attr
in
let locs = ref [] in
let location _ loc =
locs := loc :: !locs ;
loc
in
let pat m p =
( match p.ppat_desc with
| Ppat_record (flds, Open) ->
Option.iter (Source.loc_of_underscore src flds p.ppat_loc)
~f:(fun loc -> locs := loc :: !locs)
| Ppat_constant _ -> locs := Source.loc_of_pat_constant src p :: !locs
| _ -> () ) ;
Ast_mapper.default_mapper.pat m p
in
let expr m e =
( match e.pexp_desc with
| Pexp_constant _ -> locs := Source.loc_of_expr_constant src e :: !locs
| _ -> () ) ;
Ast_mapper.default_mapper.expr m e
in
let mapper =
Ast_mapper.{default_mapper with location; pat; attribute; expr}
in
Mapper.map_ast fragment mapper ast |> ignore ;
(of_list !locs, !locs)
end

(** Sets of comments supporting splitting by locations. *)
module CmtSet : sig
type t
Expand Down Expand Up @@ -311,29 +268,27 @@ let init fragment ~debug source asts comments_n_docstrings =
match locs with
| [] -> add_cmts t `After ~prev:Location.none Location.none cmts
| _ -> place t loc_tree locs cmts ) ;
let () =
let relocate_loc_stack loc stack =
List.iter stack ~f:(fun src -> relocate t ~src ~before:loc ~after:loc)
in
let expr (m : Ast_mapper.mapper) x =
relocate_loc_stack x.pexp_loc x.pexp_loc_stack ;
Ast_mapper.default_mapper.expr m x
in
let typ (m : Ast_mapper.mapper) x =
relocate_loc_stack x.ptyp_loc x.ptyp_loc_stack ;
Ast_mapper.default_mapper.typ m x
in
let pat (m : Ast_mapper.mapper) x =
relocate_loc_stack x.ppat_loc x.ppat_loc_stack ;
Ast_mapper.default_mapper.pat m x
in
let _ =
Mapper.map_ast fragment
Ast_mapper.{default_mapper with pat; typ; expr}
asts
in
()
let relocate_loc_stack loc stack =
List.iter stack ~f:(fun src -> relocate t ~src ~before:loc ~after:loc)
in
let mapper =
object
inherit Ppxlib.Ast_traverse.map as super

method! pattern x =
relocate_loc_stack x.ppat_loc x.ppat_loc_stack ;
super#pattern x

method! core_type x =
relocate_loc_stack x.ptyp_loc x.ptyp_loc_stack ;
super#core_type x

method! expression x =
relocate_loc_stack x.pexp_loc x.pexp_loc_stack ;
super#expression x
end
in
let _ = Mapper.map_ast fragment mapper asts in
t

let preserve fmt_x t =
Expand Down
51 changes: 51 additions & 0 deletions lib/Loc_tree.ml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,51 @@
(**************************************************************************)
(* *)
(* OCamlFormat *)
(* *)
(* Copyright (c) Facebook, Inc. and its affiliates. *)
(* *)
(* This source code is licensed under the MIT license found in *)
(* the LICENSE file in the root directory of this source tree. *)
(* *)
(**************************************************************************)

open Migrate_ast
open Parsetree
include Non_overlapping_interval_tree.Make (Location)

(** Use Ast_mapper to collect all locs in ast, and create tree of them. *)
let of_ast fragment ast src =
let locs = ref [] in
let add_loc loc = locs := loc :: !locs in
let mapper =
object
inherit Ppxlib.Ast_traverse.map as super

method! location loc = add_loc loc ; loc

method! pattern p =
( match p.ppat_desc with
| Ppat_record (flds, Open) ->
Option.iter
(Source.loc_of_underscore src flds p.ppat_loc)
~f:add_loc
| _ -> () ) ;
super#pattern p

method! attribute attr =
(* ignore location of docstrings *)
if Ast.Attr.is_doc attr then attr else super#attribute attr

(** Ast_traverse recurses down to locations in stacks *)
method! location_stack l = l

method! expression e =
( match e.pexp_desc with
| Pexp_constant _ ->
locs := Source.loc_of_expr_constant src e :: !locs
| _ -> () ) ;
super#expression e
end
in
Mapper.map_ast fragment mapper ast |> ignore ;
(of_list !locs, !locs)
98 changes: 21 additions & 77 deletions lib/Migrate_ast.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,14 +9,10 @@
(* *)
(**************************************************************************)

let selected_version = Migrate_parsetree.Versions.ocaml_411

module Selected_version = Ast_411
module Ast_mapper = Selected_version.Ast_mapper
module Ast_helper = Selected_version.Ast_helper
module Ast_helper = Ppxlib.Ast_helper

module Parsetree = struct
include Selected_version.Parsetree
include Ppxlib.Parsetree

let equal_core_type : core_type -> core_type -> bool = Poly.equal

Expand All @@ -29,7 +25,7 @@ module Parsetree = struct
end

module Asttypes = struct
include Selected_version.Asttypes
include Ppxlib.Asttypes

let is_private = function Private -> true | Public -> false

Expand All @@ -41,30 +37,6 @@ module Asttypes = struct
end

module Mapper = struct
let structure = Selected_version.map_structure

let signature = Selected_version.map_signature

(* Missing from ocaml_migrate_parsetree *)
let use_file (mapper : Ast_mapper.mapper) use_file =
let open Parsetree in
List.map use_file ~f:(fun toplevel_phrase ->
match (toplevel_phrase : toplevel_phrase) with
| Ptop_def structure ->
Ptop_def (mapper.Ast_mapper.structure mapper structure)
| Ptop_dir {pdir_name; pdir_arg; pdir_loc} ->
let pdir_arg =
match pdir_arg with
| None -> None
| Some a ->
Some {a with pdira_loc= mapper.location mapper a.pdira_loc}
in
Ptop_dir
{ pdir_name=
{pdir_name with loc= mapper.location mapper pdir_name.loc}
; pdir_arg
; pdir_loc= mapper.location mapper pdir_loc })

type 'a fragment =
| Structure : Parsetree.structure fragment
| Signature : Parsetree.signature fragment
Expand All @@ -76,22 +48,21 @@ module Mapper = struct
| Signature -> Parsetree.equal_signature
| Use_file -> List.equal Parsetree.equal_toplevel_phrase

let map_ast (type a) (x : a fragment) : Ast_mapper.mapper -> a -> a =
let map_ast (type a) (x : a fragment) (m : Ppxlib.Ast_traverse.map) :
a -> a =
match x with
| Structure -> structure
| Signature -> signature
| Use_file -> use_file
| Structure -> m#structure
| Signature -> m#signature
| Use_file -> m#list m#toplevel_phrase
end

module Parse = struct
open Migrate_parsetree

let implementation = Parse.implementation selected_version
let implementation = Ppxlib_ast.Parse.implementation

let interface = Parse.interface selected_version
let interface = Ppxlib_ast.Parse.interface

let use_file lexbuf =
List.filter (Parse.use_file selected_version lexbuf)
List.filter (Ppxlib_ast.Parse.use_file lexbuf)
~f:(fun (p : Parsetree.toplevel_phrase) ->
match p with
| Ptop_def [] -> false
Expand All @@ -104,55 +75,28 @@ module Parse = struct
| Mapper.Use_file -> use_file lexbuf
end

let to_current =
Migrate_parsetree.Versions.(migrate selected_version ocaml_current)

module Printast = struct
open Printast
let pp_sexp ppf sexp = Format.fprintf ppf "%a" (Sexp.pp_hum_indent 2) sexp

let sexp_of = Ppxlib.Ast_traverse.sexp_of

let implementation f x = implementation f (to_current.copy_structure x)
let implementation ppf x = pp_sexp ppf (sexp_of#structure x)

let interface f x = interface f (to_current.copy_signature x)
let interface ppf x = pp_sexp ppf (sexp_of#signature x)

let expression f x = expression 0 f (to_current.copy_expression x)
let expression ppf x = pp_sexp ppf (sexp_of#expression x)

let payload f (x : Parsetree.payload) =
payload 0 f
( match x with
| PStr x -> PStr (to_current.copy_structure x)
| PSig x -> PSig (to_current.copy_signature x)
| PTyp x -> PTyp (to_current.copy_core_type x)
| PPat (x, y) ->
PPat
( to_current.copy_pattern x
, Option.map ~f:to_current.copy_expression y ) )
let payload ppf x = pp_sexp ppf (sexp_of#payload x)

let use_file f (x : Parsetree.toplevel_phrase list) =
List.iter x ~f:(fun (p : Parsetree.toplevel_phrase) ->
top_phrase f (to_current.copy_toplevel_phrase p))
let use_file ppf x = pp_sexp ppf (List.sexp_of_t sexp_of#toplevel_phrase x)

let fragment (type a) : a Mapper.fragment -> _ -> a -> _ = function
| Mapper.Structure -> implementation
| Mapper.Signature -> interface
| Mapper.Use_file -> use_file
end

module Pprintast = struct
open Pprintast

let structure f x = structure f (to_current.copy_structure x)

let signature f x = signature f (to_current.copy_signature x)

let core_type f x = core_type f (to_current.copy_core_type x)

let expression f x = expression f (to_current.copy_expression x)

let pattern f x = pattern f (to_current.copy_pattern x)

let toplevel_phrase f x =
toplevel_phrase f (to_current.copy_toplevel_phrase x)
end
module Pprintast = Ppxlib.Pprintast

module Position = struct
open Lexing
Expand Down Expand Up @@ -180,7 +124,7 @@ module Position = struct
end

module Location = struct
include Selected_version.Location
include Ppxlib.Location

let fmt fs {loc_start; loc_end; loc_ghost} =
Format.fprintf fs "(%a..%a)%s" Position.fmt loc_start Position.fmt
Expand Down
30 changes: 6 additions & 24 deletions lib/Migrate_ast.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,16 +9,10 @@
(* *)
(**************************************************************************)

val selected_version :
Migrate_parsetree.Versions.OCaml_411.types
Migrate_parsetree.Versions.ocaml_version

module Selected_version = Ast_411
module Ast_mapper = Selected_version.Ast_mapper
module Ast_helper = Selected_version.Ast_helper
module Ast_helper = Ppxlib.Ast_helper

module Parsetree : sig
include module type of Selected_version.Parsetree
include module type of Ppxlib.Parsetree

val equal_core_type : core_type -> core_type -> bool

Expand All @@ -30,7 +24,7 @@ module Parsetree : sig
end

module Asttypes : sig
include module type of Selected_version.Asttypes
include module type of Ppxlib.Asttypes

val is_private : private_flag -> bool

Expand All @@ -52,7 +46,7 @@ module Position : sig
end

module Location : sig
include module type of Selected_version.Location
include module type of Ppxlib.Location

type comparator_witness

Expand Down Expand Up @@ -139,7 +133,7 @@ module Mapper : sig

val equal : 'a fragment -> 'a -> 'a -> bool

val map_ast : 'a fragment -> Ast_mapper.mapper -> 'a -> 'a
val map_ast : 'a fragment -> Ppxlib.Ast_traverse.map -> 'a -> 'a
end

module Parse : sig
Expand All @@ -160,19 +154,7 @@ module Printast : sig
val fragment : 'a Mapper.fragment -> Format.formatter -> 'a -> unit
end

module Pprintast : sig
val core_type : Format.formatter -> Parsetree.core_type -> unit

val pattern : Format.formatter -> Parsetree.pattern -> unit

val toplevel_phrase : Format.formatter -> Parsetree.toplevel_phrase -> unit

val expression : Format.formatter -> Parsetree.expression -> unit

val structure : Format.formatter -> Parsetree.structure -> unit

val signature : Format.formatter -> Parsetree.signature -> unit
end
module Pprintast = Ppxlib.Pprintast

module Longident : sig
type t = Longident.t =
Expand Down
Loading

0 comments on commit 56d79b2

Please sign in to comment.