From 1df280b4f54bd6749ee940f6d98904f602d4dc75 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Sat, 27 Aug 2016 21:51:03 -0600 Subject: [PATCH 1/7] astjson on the way --- .merlin | 2 +- _tags | 2 +- pkg/build.ml | 1 + src/reason_astjson.ml | 882 ++++++++++++++++++++++++++++++++++++++++++ src/refmt_impl.ml | 6 + 5 files changed, 891 insertions(+), 2 deletions(-) create mode 100644 src/reason_astjson.ml diff --git a/.merlin b/.merlin index 46986e5e3..d7aab038a 100644 --- a/.merlin +++ b/.merlin @@ -1,3 +1,3 @@ -PKG utop merlin_extend compiler-libs easy-format re.str +PKG utop merlin_extend compiler-libs easy-format re.str yojson B _build/src S src diff --git a/_tags b/_tags index 9ef29e184..ba18e6d92 100644 --- a/_tags +++ b/_tags @@ -4,7 +4,7 @@ true: warn(@5@8@10@11@12@14@23-24@26@29@40), bin_annot, safe_string, debug : -traverse "formatTest": -traverse "src": include -: package(menhirLib unix compiler-libs.common ocamlbuild findlib easy-format BetterErrors merlin_extend re.str) +: package(menhirLib unix compiler-libs.common ocamlbuild findlib easy-format BetterErrors merlin_extend re.str ppx_deriving.std yojson ppx_deriving_yojson) : package(menhirLib utop) : package(sedlex) diff --git a/pkg/build.ml b/pkg/build.ml index 767c2ecc3..35ca2600d 100755 --- a/pkg/build.ml +++ b/pkg/build.ml @@ -51,6 +51,7 @@ let () = Pkg.bin ~auto:true "src/reason_format_type" ~dst:"refmttype"; Pkg.share "editorSupport/emacs/refmt.el" ~dst:"../emacs/site-lisp/refmt.el"; Pkg.share "editorSupport/emacs/reason-mode.el" ~dst:"../emacs/site-lisp/reason-mode.el"; + (* atom-reason *) (* Unfortunately we have to specificy each individual file *) Pkg.share "editorSupport/atom-reason/package.json" ~dst:"editorSupport/atom-reason/package.json"; diff --git a/src/reason_astjson.ml b/src/reason_astjson.ml new file mode 100644 index 000000000..ce581c5ca --- /dev/null +++ b/src/reason_astjson.ml @@ -0,0 +1,882 @@ + +type position = Lexing.position = { + pos_fname : string; + pos_lnum : int; + pos_bol : int; + pos_cnum : int; +} +[@@deriving yojson] + +type locationt = Location.t = { + loc_start: position; + loc_end: position; + loc_ghost: bool; +} +[@@deriving yojson] + +(* asttypes *) + +type constant = Asttypes.constant = + Const_int of int + | Const_char of char + | Const_string of string * string option + | Const_float of string + | Const_int32 of int32 + | Const_int64 of int64 + | Const_nativeint of nativeint +[@@deriving yojson] + +type rec_flag = Asttypes.rec_flag = Nonrecursive | Recursive +[@@deriving yojson] + +type direction_flag = Asttypes.direction_flag = Upto | Downto +[@@deriving yojson] + +type private_flag = Asttypes.private_flag = Private | Public +[@@deriving yojson] + +type mutable_flag = Asttypes.mutable_flag = Immutable | Mutable +[@@deriving yojson] + +type virtual_flag = Asttypes.virtual_flag = Virtual | Concrete +[@@deriving yojson] + +type override_flag = Asttypes.override_flag = Override | Fresh +[@@deriving yojson] + +type closed_flag = Asttypes.closed_flag = Closed | Open +[@@deriving yojson] + +type label = string +[@@deriving yojson] + +type 'a loc = 'a Location.loc = { + txt : 'a; + loc : locationt; +} +[@@deriving yojson] + + +type variance = Asttypes.variance = + | Covariant + | Contravariant + | Invariant +[@@deriving yojson] + + + + + + + + + + + + + + +type attribute = string loc * payload + (* [@id ARG] + [@@id ARG] + Metadata containers passed around within the AST. + The compiler ignores unknown attributes. + *) + +and extension = string loc * payload + (* [%id ARG] + [%%id ARG] + Sub-language placeholder -- rejected by the typechecker. + *) + +and attributes = attribute list + +and payload = Parsetree.payload = + | PStr of structure + | PTyp of core_type (* : T *) + | PPat of pattern * expression option (* ? P or ? P when E *) + +(** {2 Core language} *) + +(* Type expressions *) + +and core_type = Parsetree.core_type = + { + ptyp_desc: core_type_desc; + ptyp_loc: locationt; + ptyp_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and core_type_desc = Parsetree.core_type_desc = + | Ptyp_any + (* _ *) + | Ptyp_var of string + (* 'a *) + | Ptyp_arrow of label * core_type * core_type + (* T1 -> T2 (label = "") + ~l:T1 -> T2 (label = "l") + ?l:T1 -> T2 (label = "?l") + *) + | Ptyp_tuple of core_type list + (* T1 * ... * Tn + Invariant: n >= 2 + *) + | Ptyp_constr of Longident.t loc * core_type list + (* tconstr + T tconstr + (T1, ..., Tn) tconstr + *) + | Ptyp_object of (string * attributes * core_type) list * closed_flag + (* < l1:T1; ...; ln:Tn > (flag = Closed) + < l1:T1; ...; ln:Tn; .. > (flag = Open) + *) + | Ptyp_class of Longident.t loc * core_type list + (* #tconstr + T #tconstr + (T1, ..., Tn) #tconstr + *) + | Ptyp_alias of core_type * string + (* T as 'a *) + | Ptyp_variant of row_field list * closed_flag * label list option + (* [ `A|`B ] (flag = Closed; labels = None) + [> `A|`B ] (flag = Open; labels = None) + [< `A|`B ] (flag = Closed; labels = Some []) + [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) + *) + | Ptyp_poly of string list * core_type + (* 'a1 ... 'an. T + Can only appear in the following context: + - As the core_type of a Ppat_constraint node corresponding + to a constraint on a let-binding: let x : 'a1 ... 'an. T + = e ... + - Under Cfk_virtual for methods (not values). + - As the core_type of a Pctf_method node. + - As the core_type of a Pexp_poly node. + - As the pld_type field of a label_declaration. + - As a core_type of a Ptyp_object node. + *) + + | Ptyp_package of package_type + (* (module S) *) + | Ptyp_extension of extension + (* [%id] *) + +and package_type = Longident.t loc * (Longident.t loc * core_type) list + (* + (module S) + (module S with type t1 = T1 and ... and tn = Tn) + *) + +and row_field = Parsetree.row_field = + | Rtag of label * attributes * bool * core_type list + (* [`A] ( true, [] ) + [`A of T] ( false, [T] ) + [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) + [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) + - The 2nd field is true if the tag contains a + constant (empty) constructor. + - '&' occurs when several types are used for the same constructor + (see 4.2 in the manual) + - TODO: switch to a record representation, and keep location + *) + | Rinherit of core_type + (* [ T ] *) + +(* Patterns *) + +and pattern = Parsetree.pattern = + { + ppat_desc: pattern_desc; + ppat_loc: locationt; + ppat_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and pattern_desc = Parsetree.pattern_desc = + | Ppat_any + (* _ *) + | Ppat_var of string loc + (* x *) + | Ppat_alias of pattern * string loc + (* P as 'a *) + | Ppat_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Ppat_interval of constant * constant + (* 'a'..'z' + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of pattern list + (* (P1, ..., Pn) + Invariant: n >= 2 + *) + | Ppat_construct of Longident.t loc * pattern option + (* C None + C P Some P + C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) + *) + | Ppat_variant of label * pattern option + (* `A (None) + `A P (Some P) + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (* { l1=P1; ...; ln=Pn } (flag = Closed) + { l1=P1; ...; ln=Pn; _} (flag = Open) + Invariant: n > 0 + *) + | Ppat_array of pattern list + (* [| P1; ...; Pn |] *) + | Ppat_or of pattern * pattern + (* P1 | P2 *) + | Ppat_constraint of pattern * core_type + (* (P : T) *) + | Ppat_type of Longident.t loc + (* #tconst *) + | Ppat_lazy of pattern + (* lazy P *) + | Ppat_unpack of string loc + (* (module P) + Note: (module P : S) is represented as + Ppat_constraint(Ppat_unpack, Ptyp_package) + *) + | Ppat_exception of pattern + (* exception P *) + | Ppat_extension of extension + (* [%id] *) + +(* Value expressions *) + +and expression = Parsetree.expression = + { + pexp_desc: expression_desc; + pexp_loc: locationt; + pexp_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and expression_desc = Parsetree.expression_desc = + | Pexp_ident of Longident.t loc + (* x + M.x + *) + | Pexp_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Pexp_let of rec_flag * value_binding list * expression + (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) + *) + | Pexp_function of case list + (* function P1 -> E1 | ... | Pn -> En *) + | Pexp_fun of label * expression option * pattern * expression + (* fun P -> E1 (lab = "", None) + fun ~l:P -> E1 (lab = "l", None) + fun ?l:P -> E1 (lab = "?l", None) + fun ?l:(P = E0) -> E1 (lab = "?l", Some E0) + Notes: + - If E0 is provided, lab must start with '?'. + - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. + - "let f P = E" is represented using Pexp_fun. + *) + | Pexp_apply of expression * (label * expression) list + (* E0 ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + Invariant: n > 0 + *) + | Pexp_match of expression * case list + (* match E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_try of expression * case list + (* try E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_tuple of expression list + (* (E1, ..., En) + Invariant: n >= 2 + *) + | Pexp_construct of Longident.t loc * expression option + (* C None + C E Some E + C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) + *) + | Pexp_variant of label * expression option + (* `A (None) + `A E (Some E) + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (* { l1=P1; ...; ln=Pn } (None) + { E0 with l1=P1; ...; ln=Pn } (Some E0) + Invariant: n > 0 + *) + | Pexp_field of expression * Longident.t loc + (* E.l *) + | Pexp_setfield of expression * Longident.t loc * expression + (* E1.l <- E2 *) + | Pexp_array of expression list + (* [| E1; ...; En |] *) + | Pexp_ifthenelse of expression * expression * expression option + (* if E1 then E2 else E3 *) + | Pexp_sequence of expression * expression + (* E1; E2 *) + | Pexp_while of expression * expression + (* while E1 do E2 done *) + | Pexp_for of + pattern * expression * expression * direction_flag * expression + (* for i = E1 to E2 do E3 done (flag = Upto) + for i = E1 downto E2 do E3 done (flag = Downto) + *) + | Pexp_constraint of expression * core_type + (* (E : T) *) + | Pexp_coerce of expression * core_type option * core_type + (* (E :> T) (None, T) + (E : T0 :> T) (Some T0, T) + *) + | Pexp_send of expression * string + (* E # m *) + | Pexp_new of Longident.t loc + (* new M.c *) + | Pexp_setinstvar of string loc * expression + (* x <- 2 *) + | Pexp_override of (string loc * expression) list + (* {< x1 = E1; ...; Xn = En >} *) + | Pexp_letmodule of string loc * module_expr * expression + (* let module M = ME in E *) + | Pexp_assert of expression + (* assert E + Note: "assert false" is treated in a special way by the + type-checker. *) + | Pexp_lazy of expression + (* lazy E *) + | Pexp_poly of expression * core_type option + (* Used for method bodies. + Can only be used as the expression under Cfk_concrete + for methods (not values). *) + | Pexp_object of class_structure + (* object ... end *) + | Pexp_newtype of string * expression + (* fun (type t) -> E *) + | Pexp_pack of module_expr + (* (module ME) + (module ME : S) is represented as + Pexp_constraint(Pexp_pack, Ptyp_package S) *) + | Pexp_open of override_flag * Longident.t loc * expression + (* let open M in E + let! open M in E + *) + | Pexp_extension of extension + (* [%id] *) + +and case = Parsetree.case = (* (P -> E) or (P when E0 -> E) *) + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } + +(* Value descriptions *) + +and value_description = Parsetree.value_description = + { + pval_name: string loc; + pval_type: core_type; + pval_prim: string list; + pval_attributes: attributes; (* ... [@@id1] [@@id2] *) + pval_loc: locationt; + } + +(* + val x: T (prim = []) + external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) + Note: when used under Pstr_primitive, prim cannot be empty +*) + +(* Type declarations *) + +and type_declaration = Parsetree.type_declaration = + { + ptype_name: string loc; + ptype_params: (core_type * variance) list; + (* ('a1,...'an) t; None represents _*) + ptype_cstrs: (core_type * core_type * locationt) list; + (* ... constraint T1=T1' ... constraint Tn=Tn' *) + ptype_kind: type_kind; + ptype_private: private_flag; (* = private ... *) + ptype_manifest: core_type option; (* = T *) + ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) + ptype_loc: locationt; + } + +(* + type t (abstract, no manifest) + type t = T0 (abstract, manifest=T0) + type t = C of T | ... (variant, no manifest) + type t = T0 = C of T | ... (variant, manifest=T0) + type t = {l: T; ...} (record, no manifest) + type t = T0 = {l : T; ...} (record, manifest=T0) + type t = .. (open, no manifest) +*) + +and type_kind = Parsetree.type_kind = + | Ptype_abstract + | Ptype_variant of constructor_declaration list + (* Invariant: non-empty list *) + | Ptype_record of label_declaration list + (* Invariant: non-empty list *) + | Ptype_open + +and label_declaration = Parsetree.label_declaration = + { + pld_name: string loc; + pld_mutable: mutable_flag; + pld_type: core_type; + pld_loc: locationt; + pld_attributes: attributes; (* l [@id1] [@id2] : T *) + } + +(* { ...; l: T; ... } (mutable=Immutable) + { ...; mutable l: T; ... } (mutable=Mutable) + Note: T can be a Ptyp_poly. +*) + +and constructor_declaration = Parsetree.constructor_declaration = + { + pcd_name: string loc; + pcd_args: core_type list; + pcd_res: core_type option; + pcd_loc: locationt; + pcd_attributes: attributes; (* C [@id1] [@id2] of ... *) + } +(* + | C of T1 * ... * Tn (res = None) + | C: T0 (args = [], res = Some T0) + | C: T1 * ... * Tn -> T0 (res = Some T0) +*) + +and type_extension = Parsetree.type_extension = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * variance) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) + } +(* + type t += ... +*) + +and extension_constructor = Parsetree.extension_constructor = + { + pext_name: string loc; + pext_kind : extension_constructor_kind; + pext_loc : locationt; + pext_attributes: attributes; (* C [@id1] [@id2] of ... *) + } + +and extension_constructor_kind = Parsetree.extension_constructor_kind = + Pext_decl of core_type list * core_type option + (* + | C of T1 * ... * Tn ([T1; ...; Tn], None) + | C: T0 ([], Some T0) + | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) + *) + | Pext_rebind of Longident.t loc + (* + | C = D + *) + +(** {2 Class language} *) + +(* Type expressions for the class language *) + +and class_type = Parsetree.class_type = + { + pcty_desc: class_type_desc; + pcty_loc: locationt; + pcty_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and class_type_desc = Parsetree.class_type_desc = + | Pcty_constr of Longident.t loc * core_type list + (* c + ['a1, ..., 'an] c *) + | Pcty_signature of class_signature + (* object ... end *) + | Pcty_arrow of label * core_type * class_type + (* T -> CT (label = "") + ~l:T -> CT (label = "l") + ?l:T -> CT (label = "?l") + *) + | Pcty_extension of extension + (* [%id] *) + +and class_signature = Parsetree.class_signature = + { + pcsig_self: core_type; + pcsig_fields: class_type_field list; + } +(* object('selfpat) ... end + object ... end (self = Ptyp_any) + *) + +and class_type_field = Parsetree.class_type_field = + { + pctf_desc: class_type_field_desc; + pctf_loc: locationt; + pctf_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + +and class_type_field_desc = Parsetree.class_type_field_desc = + | Pctf_inherit of class_type + (* inherit CT *) + | Pctf_val of (string * mutable_flag * virtual_flag * core_type) + (* val x: T *) + | Pctf_method of (string * private_flag * virtual_flag * core_type) + (* method x: T + Note: T can be a Ptyp_poly. + *) + | Pctf_constraint of (core_type * core_type) + (* constraint T1 = T2 *) + | Pctf_attribute of attribute + (* [@@@id] *) + | Pctf_extension of extension + (* [%%id] *) + +and 'a class_infos = 'a Parsetree.class_infos = + { + pci_virt: virtual_flag; + pci_params: (core_type * variance) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: locationt; + pci_attributes: attributes; (* ... [@@id1] [@@id2] *) + } +(* class c = ... + class ['a1,...,'an] c = ... + class virtual c = ... + Also used for "class type" declaration. +*) + +and class_description = class_type class_infos + +and class_type_declaration = class_type class_infos + +(* Value expressions for the class language *) + +and class_expr = Parsetree.class_expr = + { + pcl_desc: class_expr_desc; + pcl_loc: locationt; + pcl_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and class_expr_desc = Parsetree.class_expr_desc = + | Pcl_constr of Longident.t loc * core_type list + (* c + ['a1, ..., 'an] c *) + | Pcl_structure of class_structure + (* object ... end *) + | Pcl_fun of label * expression option * pattern * class_expr + (* fun P -> CE (lab = "", None) + fun ~l:P -> CE (lab = "l", None) + fun ?l:P -> CE (lab = "?l", None) + fun ?l:(P = E0) -> CE (lab = "?l", Some E0) + *) + | Pcl_apply of class_expr * (label * expression) list + (* CE ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + Invariant: n > 0 + *) + | Pcl_let of rec_flag * value_binding list * class_expr + (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) + *) + | Pcl_constraint of class_expr * class_type + (* (CE : CT) *) + | Pcl_extension of extension + (* [%id] *) + +and class_structure = Parsetree.class_structure = + { + pcstr_self: pattern; + pcstr_fields: class_field list; + } +(* object(selfpat) ... end + object ... end (self = Ppat_any) + *) + +and class_field = Parsetree.class_field = + { + pcf_desc: class_field_desc; + pcf_loc: locationt; + pcf_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + +and class_field_desc = Parsetree.class_field_desc = + | Pcf_inherit of override_flag * class_expr * string option + (* inherit CE + inherit CE as x + inherit! CE + inherit! CE as x + *) + | Pcf_val of (string loc * mutable_flag * class_field_kind) + (* val x = E + val virtual x: T + *) + | Pcf_method of (string loc * private_flag * class_field_kind) + (* method x = E (E can be a Pexp_poly) + method virtual x: T (T can be a Ptyp_poly) + *) + | Pcf_constraint of (core_type * core_type) + (* constraint T1 = T2 *) + | Pcf_initializer of expression + (* initializer E *) + | Pcf_attribute of attribute + (* [@@@id] *) + | Pcf_extension of extension + (* [%%id] *) + +and class_field_kind = Parsetree.class_field_kind = + | Cfk_virtual of core_type + | Cfk_concrete of override_flag * expression + +and class_declaration = class_expr class_infos + +(** {2 Module language} *) + +(* Type expressions for the module language *) + +and module_type = Parsetree.module_type = + { + pmty_desc: module_type_desc; + pmty_loc: locationt; + pmty_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and module_type_desc = Parsetree.module_type_desc = + | Pmty_ident of Longident.t loc + (* S *) + | Pmty_signature of signature + (* sig ... end *) + | Pmty_functor of string loc * module_type option * module_type + (* functor(X : MT1) -> MT2 *) + | Pmty_with of module_type * with_constraint list + (* MT with ... *) + | Pmty_typeof of module_expr + (* module type of ME *) + | Pmty_extension of extension + (* [%id] *) + | Pmty_alias of Longident.t loc + (* (module M) *) + +and signature = signature_item list + +and signature_item = Parsetree.signature_item = + { + psig_desc: signature_item_desc; + psig_loc: locationt; + } + +and signature_item_desc = Parsetree.signature_item_desc = + | Psig_value of value_description + (* + val x: T + external x: T = "s1" ... "sn" + *) + | Psig_type of type_declaration list + (* type t1 = ... and ... and tn = ... *) + | Psig_typext of type_extension + (* type t1 += ... *) + | Psig_exception of extension_constructor + (* exception C of T *) + | Psig_module of module_declaration + (* module X : MT *) + | Psig_recmodule of module_declaration list + (* module rec X1 : MT1 and ... and Xn : MTn *) + | Psig_modtype of module_type_declaration + (* module type S = MT + module type S *) + | Psig_open of open_description + (* open X *) + | Psig_include of include_description + (* include MT *) + | Psig_class of class_description list + (* class c1 : ... and ... and cn : ... *) + | Psig_class_type of class_type_declaration list + (* class type ct1 = ... and ... and ctn = ... *) + | Psig_attribute of attribute + (* [@@@id] *) + | Psig_extension of extension * attributes + (* [%%id] *) + +and module_declaration = Parsetree.module_declaration = + { + pmd_name: string loc; + pmd_type: module_type; + pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmd_loc: locationt; + } +(* S : MT *) + +and module_type_declaration = Parsetree.module_type_declaration = + { + pmtd_name: string loc; + pmtd_type: module_type option; + pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmtd_loc: locationt; + } +(* S = MT + S (abstract module type declaration, pmtd_type = None) +*) + +and open_description = Parsetree.open_description = + { + popen_lid: Longident.t loc; + popen_override: override_flag; + popen_loc: locationt; + popen_attributes: attributes; + } +(* open! X - popen_override = Override (silences the 'used identifier + shadowing' warning) + open X - popen_override = Fresh + *) + +and 'a include_infos = 'a Parsetree.include_infos = + { + pincl_mod: 'a; + pincl_loc: locationt; + pincl_attributes: attributes; + } + +and include_description = module_type include_infos +(* include MT *) + +and include_declaration = module_expr include_infos +(* include ME *) + +and with_constraint = Parsetree.with_constraint = + | Pwith_type of Longident.t loc * type_declaration + (* with type X.t = ... + Note: the last component of the longident must match + the name of the type_declaration. *) + | Pwith_module of Longident.t loc * Longident.t loc + (* with module X.Y = Z *) + | Pwith_typesubst of type_declaration + (* with type t := ... *) + | Pwith_modsubst of string loc * Longident.t loc + (* with module X := Z *) + +(* Value expressions for the module language *) + +and module_expr = Parsetree.module_expr = + { + pmod_desc: module_expr_desc; + pmod_loc: locationt; + pmod_attributes: attributes; (* ... [@id1] [@id2] *) + } + +and module_expr_desc = Parsetree.module_expr_desc = + | Pmod_ident of Longident.t loc + (* X *) + | Pmod_structure of structure + (* struct ... end *) + | Pmod_functor of string loc * module_type option * module_expr + (* functor(X : MT1) -> ME *) + | Pmod_apply of module_expr * module_expr + (* ME1(ME2) *) + | Pmod_constraint of module_expr * module_type + (* (ME : MT) *) + | Pmod_unpack of expression + (* (val E) *) + | Pmod_extension of extension + (* [%id] *) + +and structure = structure_item list + +and structure_item = Parsetree.structure_item = + { + pstr_desc: structure_item_desc; + pstr_loc: locationt; + } + +and structure_item_desc = Parsetree.structure_item_desc = + | Pstr_eval of expression * attributes + (* E *) + | Pstr_value of rec_flag * value_binding list + (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN (flag = Recursive) + *) + | Pstr_primitive of value_description + (* external x: T = "s1" ... "sn" *) + | Pstr_type of type_declaration list + (* type t1 = ... and ... and tn = ... *) + | Pstr_typext of type_extension + (* type t1 += ... *) + | Pstr_exception of extension_constructor + (* exception C of T + exception C = M.X *) + | Pstr_module of module_binding + (* module X = ME *) + | Pstr_recmodule of module_binding list + (* module rec X1 = ME1 and ... and Xn = MEn *) + | Pstr_modtype of module_type_declaration + (* module type S = MT *) + | Pstr_open of open_description + (* open X *) + | Pstr_class of class_declaration list + (* class c1 = ... and ... and cn = ... *) + | Pstr_class_type of class_type_declaration list + (* class type ct1 = ... and ... and ctn = ... *) + | Pstr_include of include_declaration + (* include ME *) + | Pstr_attribute of attribute + (* [@@@id] *) + | Pstr_extension of extension * attributes + (* [%%id] *) + +and value_binding = Parsetree.value_binding = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_attributes: attributes; + pvb_loc: locationt; + } + +and module_binding = Parsetree.module_binding = + { + pmb_name: string loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: locationt; + } +(* X = ME *) + +(** {2 Toplevel} *) + +(* Toplevel phrases *) + +type toplevel_phrase = Parsetree.toplevel_phrase = + | Ptop_def of structure + | Ptop_dir of string * directive_argument + (* #use, #load ... *) + +and directive_argument = Parsetree.directive_argument = + | Pdir_none + | Pdir_string of string + | Pdir_int of int + | Pdir_ident of Longident.t + | Pdir_bool of bool + + + +let checkconv (ast:structure) = +();; + + +let print_intf (ast:Parsetree.signature) = + print_endline "interface";; + +type a = {hi: string; ho: int} [@@deriving yojson];; + +type x = | A of a | B of int [@@deriving yojson];; + +let print_ast (ast:Parsetree.structure) = + let () = checkconv ast in + print_endline (Yojson.Safe.to_string +(* (structure_to_yojson ast) *) +(x_to_yojson (A {hi="ho"; ho=10})) +);; diff --git a/src/refmt_impl.ml b/src/refmt_impl.ml index 7cd098daa..0be1c796e 100644 --- a/src/refmt_impl.ml +++ b/src/refmt_impl.ml @@ -175,6 +175,9 @@ let () = | Some "ast" -> fun (ast, comments) -> ( Printast.interface Format.std_formatter ast ) + | Some "json" -> fun (ast, comments) -> ( + Reason_astjson.print_intf ast + ) (* If you don't wrap the function in parens, it's a totally different * meaning #thanksOCaml *) | Some "none" -> (fun (ast, comments) -> ()) @@ -224,6 +227,9 @@ let () = | Some "ast" -> fun (ast, comments) -> ( Printast.implementation Format.std_formatter ast ) + | Some "json" -> fun (ast, comments) -> ( + Reason_astjson.print_ast ast + ) (* If you don't wrap the function in parens, it's a totally different * meaning #thanksOCaml *) | Some "none" -> (fun (ast, comments) -> ()) From 881ce6342f4795c6be83e1e582325c22019884ad Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Sat, 27 Aug 2016 22:22:10 -0600 Subject: [PATCH 2/7] json input & output works!! --- .merlin | 2 +- src/reason_astjson.ml | 171 ++++++++++++++++++++++++++------------- src/reason_pprint_ast.ml | 1 + src/refmt_impl.ml | 7 +- 4 files changed, 121 insertions(+), 60 deletions(-) diff --git a/.merlin b/.merlin index d7aab038a..18d5c106a 100644 --- a/.merlin +++ b/.merlin @@ -1,3 +1,3 @@ -PKG utop merlin_extend compiler-libs easy-format re.str yojson +PKG utop merlin_extend compiler-libs easy-format re.str yojson result B _build/src S src diff --git a/src/reason_astjson.ml b/src/reason_astjson.ml index ce581c5ca..8ffbc9802 100644 --- a/src/reason_astjson.ml +++ b/src/reason_astjson.ml @@ -1,4 +1,24 @@ +(* Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. *) + +(** + This file is the result of copying parsetree.mli from https://github.com/ocaml/ocaml/blob/4.02/parsing/parsetree.mli, + annotating all types with `[@@deriving yojson]`, and then bringing in all + types that are depended upon. Currently that includes types from + - Longident + - Lexing + - Location + - Asttypes +**) + +(* Longident *) +type longidentt = Longident.t = + Lident of string + | Ldot of longidentt * string + | Lapply of longidentt * longidentt +[@@deriving yojson] + +(* Lexing *) type position = Lexing.position = { pos_fname : string; pos_lnum : int; @@ -7,6 +27,8 @@ type position = Lexing.position = { } [@@deriving yojson] + +(* Location *) type locationt = Location.t = { loc_start: position; loc_end: position; @@ -14,8 +36,8 @@ type locationt = Location.t = { } [@@deriving yojson] -(* asttypes *) +(* Asttypes *) type constant = Asttypes.constant = Const_int of int | Const_char of char @@ -56,7 +78,6 @@ type 'a loc = 'a Location.loc = { } [@@deriving yojson] - type variance = Asttypes.variance = | Covariant | Contravariant @@ -64,37 +85,30 @@ type variance = Asttypes.variance = [@@deriving yojson] - - - - - - - - - - - - +(* Parsetree *) type attribute = string loc * payload (* [@id ARG] [@@id ARG] Metadata containers passed around within the AST. The compiler ignores unknown attributes. *) +[@@deriving yojson] and extension = string loc * payload (* [%id ARG] [%%id ARG] Sub-language placeholder -- rejected by the typechecker. *) +[@@deriving yojson] and attributes = attribute list +[@@deriving yojson] and payload = Parsetree.payload = | PStr of structure | PTyp of core_type (* : T *) | PPat of pattern * expression option (* ? P or ? P when E *) +[@@deriving yojson] (** {2 Core language} *) @@ -106,6 +120,7 @@ and core_type = Parsetree.core_type = ptyp_loc: locationt; ptyp_attributes: attributes; (* ... [@id1] [@id2] *) } +[@@deriving yojson] and core_type_desc = Parsetree.core_type_desc = | Ptyp_any @@ -121,7 +136,7 @@ and core_type_desc = Parsetree.core_type_desc = (* T1 * ... * Tn Invariant: n >= 2 *) - | Ptyp_constr of Longident.t loc * core_type list + | Ptyp_constr of longidentt loc * core_type list (* tconstr T tconstr (T1, ..., Tn) tconstr @@ -130,7 +145,7 @@ and core_type_desc = Parsetree.core_type_desc = (* < l1:T1; ...; ln:Tn > (flag = Closed) < l1:T1; ...; ln:Tn; .. > (flag = Open) *) - | Ptyp_class of Longident.t loc * core_type list + | Ptyp_class of longidentt loc * core_type list (* #tconstr T #tconstr (T1, ..., Tn) #tconstr @@ -160,12 +175,14 @@ and core_type_desc = Parsetree.core_type_desc = (* (module S) *) | Ptyp_extension of extension (* [%id] *) +[@@deriving yojson] -and package_type = Longident.t loc * (Longident.t loc * core_type) list +and package_type = longidentt loc * (longidentt loc * core_type) list (* (module S) (module S with type t1 = T1 and ... and tn = Tn) *) +[@@deriving yojson] and row_field = Parsetree.row_field = | Rtag of label * attributes * bool * core_type list @@ -181,6 +198,7 @@ and row_field = Parsetree.row_field = *) | Rinherit of core_type (* [ T ] *) +[@@deriving yojson] (* Patterns *) @@ -190,6 +208,7 @@ and pattern = Parsetree.pattern = ppat_loc: locationt; ppat_attributes: attributes; (* ... [@id1] [@id2] *) } +[@@deriving yojson] and pattern_desc = Parsetree.pattern_desc = | Ppat_any @@ -208,7 +227,7 @@ and pattern_desc = Parsetree.pattern_desc = (* (P1, ..., Pn) Invariant: n >= 2 *) - | Ppat_construct of Longident.t loc * pattern option + | Ppat_construct of longidentt loc * pattern option (* C None C P Some P C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) @@ -217,7 +236,7 @@ and pattern_desc = Parsetree.pattern_desc = (* `A (None) `A P (Some P) *) - | Ppat_record of (Longident.t loc * pattern) list * closed_flag + | Ppat_record of (longidentt loc * pattern) list * closed_flag (* { l1=P1; ...; ln=Pn } (flag = Closed) { l1=P1; ...; ln=Pn; _} (flag = Open) Invariant: n > 0 @@ -228,7 +247,7 @@ and pattern_desc = Parsetree.pattern_desc = (* P1 | P2 *) | Ppat_constraint of pattern * core_type (* (P : T) *) - | Ppat_type of Longident.t loc + | Ppat_type of longidentt loc (* #tconst *) | Ppat_lazy of pattern (* lazy P *) @@ -241,6 +260,7 @@ and pattern_desc = Parsetree.pattern_desc = (* exception P *) | Ppat_extension of extension (* [%id] *) +[@@deriving yojson] (* Value expressions *) @@ -250,9 +270,10 @@ and expression = Parsetree.expression = pexp_loc: locationt; pexp_attributes: attributes; (* ... [@id1] [@id2] *) } +[@@deriving yojson] and expression_desc = Parsetree.expression_desc = - | Pexp_ident of Longident.t loc + | Pexp_ident of longidentt loc (* x M.x *) @@ -288,7 +309,7 @@ and expression_desc = Parsetree.expression_desc = (* (E1, ..., En) Invariant: n >= 2 *) - | Pexp_construct of Longident.t loc * expression option + | Pexp_construct of longidentt loc * expression option (* C None C E Some E C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) @@ -297,14 +318,14 @@ and expression_desc = Parsetree.expression_desc = (* `A (None) `A E (Some E) *) - | Pexp_record of (Longident.t loc * expression) list * expression option + | Pexp_record of (longidentt loc * expression) list * expression option (* { l1=P1; ...; ln=Pn } (None) { E0 with l1=P1; ...; ln=Pn } (Some E0) Invariant: n > 0 *) - | Pexp_field of expression * Longident.t loc + | Pexp_field of expression * longidentt loc (* E.l *) - | Pexp_setfield of expression * Longident.t loc * expression + | Pexp_setfield of expression * longidentt loc * expression (* E1.l <- E2 *) | Pexp_array of expression list (* [| E1; ...; En |] *) @@ -327,7 +348,7 @@ and expression_desc = Parsetree.expression_desc = *) | Pexp_send of expression * string (* E # m *) - | Pexp_new of Longident.t loc + | Pexp_new of longidentt loc (* new M.c *) | Pexp_setinstvar of string loc * expression (* x <- 2 *) @@ -353,12 +374,13 @@ and expression_desc = Parsetree.expression_desc = (* (module ME) (module ME : S) is represented as Pexp_constraint(Pexp_pack, Ptyp_package S) *) - | Pexp_open of override_flag * Longident.t loc * expression + | Pexp_open of override_flag * longidentt loc * expression (* let open M in E let! open M in E *) | Pexp_extension of extension (* [%id] *) +[@@deriving yojson] and case = Parsetree.case = (* (P -> E) or (P when E0 -> E) *) { @@ -366,6 +388,7 @@ and case = Parsetree.case = (* (P -> E) or (P when E0 -> E) *) pc_guard: expression option; pc_rhs: expression; } +[@@deriving yojson] (* Value descriptions *) @@ -377,6 +400,7 @@ and value_description = Parsetree.value_description = pval_attributes: attributes; (* ... [@@id1] [@@id2] *) pval_loc: locationt; } +[@@deriving yojson] (* val x: T (prim = []) @@ -399,6 +423,7 @@ and type_declaration = Parsetree.type_declaration = ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) ptype_loc: locationt; } +[@@deriving yojson] (* type t (abstract, no manifest) @@ -417,6 +442,7 @@ and type_kind = Parsetree.type_kind = | Ptype_record of label_declaration list (* Invariant: non-empty list *) | Ptype_open +[@@deriving yojson] and label_declaration = Parsetree.label_declaration = { @@ -426,6 +452,7 @@ and label_declaration = Parsetree.label_declaration = pld_loc: locationt; pld_attributes: attributes; (* l [@id1] [@id2] : T *) } +[@@deriving yojson] (* { ...; l: T; ... } (mutable=Immutable) { ...; mutable l: T; ... } (mutable=Mutable) @@ -445,10 +472,11 @@ and constructor_declaration = Parsetree.constructor_declaration = | C: T0 (args = [], res = Some T0) | C: T1 * ... * Tn -> T0 (res = Some T0) *) +[@@deriving yojson] and type_extension = Parsetree.type_extension = { - ptyext_path: Longident.t loc; + ptyext_path: longidentt loc; ptyext_params: (core_type * variance) list; ptyext_constructors: extension_constructor list; ptyext_private: private_flag; @@ -457,6 +485,7 @@ and type_extension = Parsetree.type_extension = (* type t += ... *) +[@@deriving yojson] and extension_constructor = Parsetree.extension_constructor = { @@ -465,6 +494,7 @@ and extension_constructor = Parsetree.extension_constructor = pext_loc : locationt; pext_attributes: attributes; (* C [@id1] [@id2] of ... *) } +[@@deriving yojson] and extension_constructor_kind = Parsetree.extension_constructor_kind = Pext_decl of core_type list * core_type option @@ -473,10 +503,11 @@ and extension_constructor_kind = Parsetree.extension_constructor_kind = | C: T0 ([], Some T0) | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) *) - | Pext_rebind of Longident.t loc + | Pext_rebind of longidentt loc (* | C = D *) +[@@deriving yojson] (** {2 Class language} *) @@ -488,9 +519,10 @@ and class_type = Parsetree.class_type = pcty_loc: locationt; pcty_attributes: attributes; (* ... [@id1] [@id2] *) } +[@@deriving yojson] and class_type_desc = Parsetree.class_type_desc = - | Pcty_constr of Longident.t loc * core_type list + | Pcty_constr of longidentt loc * core_type list (* c ['a1, ..., 'an] c *) | Pcty_signature of class_signature @@ -502,6 +534,7 @@ and class_type_desc = Parsetree.class_type_desc = *) | Pcty_extension of extension (* [%id] *) +[@@deriving yojson] and class_signature = Parsetree.class_signature = { @@ -511,6 +544,7 @@ and class_signature = Parsetree.class_signature = (* object('selfpat) ... end object ... end (self = Ptyp_any) *) +[@@deriving yojson] and class_type_field = Parsetree.class_type_field = { @@ -518,6 +552,7 @@ and class_type_field = Parsetree.class_type_field = pctf_loc: locationt; pctf_attributes: attributes; (* ... [@@id1] [@@id2] *) } +[@@deriving yojson] and class_type_field_desc = Parsetree.class_type_field_desc = | Pctf_inherit of class_type @@ -534,6 +569,7 @@ and class_type_field_desc = Parsetree.class_type_field_desc = (* [@@@id] *) | Pctf_extension of extension (* [%%id] *) +[@@deriving yojson] and 'a class_infos = 'a Parsetree.class_infos = { @@ -549,10 +585,13 @@ and 'a class_infos = 'a Parsetree.class_infos = class virtual c = ... Also used for "class type" declaration. *) +[@@deriving yojson] and class_description = class_type class_infos +[@@deriving yojson] and class_type_declaration = class_type class_infos +[@@deriving yojson] (* Value expressions for the class language *) @@ -562,9 +601,10 @@ and class_expr = Parsetree.class_expr = pcl_loc: locationt; pcl_attributes: attributes; (* ... [@id1] [@id2] *) } +[@@deriving yojson] and class_expr_desc = Parsetree.class_expr_desc = - | Pcl_constr of Longident.t loc * core_type list + | Pcl_constr of longidentt loc * core_type list (* c ['a1, ..., 'an] c *) | Pcl_structure of class_structure @@ -589,6 +629,7 @@ and class_expr_desc = Parsetree.class_expr_desc = (* (CE : CT) *) | Pcl_extension of extension (* [%id] *) +[@@deriving yojson] and class_structure = Parsetree.class_structure = { @@ -598,6 +639,7 @@ and class_structure = Parsetree.class_structure = (* object(selfpat) ... end object ... end (self = Ppat_any) *) +[@@deriving yojson] and class_field = Parsetree.class_field = { @@ -605,6 +647,7 @@ and class_field = Parsetree.class_field = pcf_loc: locationt; pcf_attributes: attributes; (* ... [@@id1] [@@id2] *) } +[@@deriving yojson] and class_field_desc = Parsetree.class_field_desc = | Pcf_inherit of override_flag * class_expr * string option @@ -629,12 +672,15 @@ and class_field_desc = Parsetree.class_field_desc = (* [@@@id] *) | Pcf_extension of extension (* [%%id] *) +[@@deriving yojson] and class_field_kind = Parsetree.class_field_kind = | Cfk_virtual of core_type | Cfk_concrete of override_flag * expression +[@@deriving yojson] and class_declaration = class_expr class_infos +[@@deriving yojson] (** {2 Module language} *) @@ -646,9 +692,10 @@ and module_type = Parsetree.module_type = pmty_loc: locationt; pmty_attributes: attributes; (* ... [@id1] [@id2] *) } +[@@deriving yojson] and module_type_desc = Parsetree.module_type_desc = - | Pmty_ident of Longident.t loc + | Pmty_ident of longidentt loc (* S *) | Pmty_signature of signature (* sig ... end *) @@ -660,16 +707,19 @@ and module_type_desc = Parsetree.module_type_desc = (* module type of ME *) | Pmty_extension of extension (* [%id] *) - | Pmty_alias of Longident.t loc + | Pmty_alias of longidentt loc (* (module M) *) +[@@deriving yojson] and signature = signature_item list +[@@deriving yojson] and signature_item = Parsetree.signature_item = { psig_desc: signature_item_desc; psig_loc: locationt; } +[@@deriving yojson] and signature_item_desc = Parsetree.signature_item_desc = | Psig_value of value_description @@ -702,6 +752,7 @@ and signature_item_desc = Parsetree.signature_item_desc = (* [@@@id] *) | Psig_extension of extension * attributes (* [%%id] *) +[@@deriving yojson] and module_declaration = Parsetree.module_declaration = { @@ -711,6 +762,7 @@ and module_declaration = Parsetree.module_declaration = pmd_loc: locationt; } (* S : MT *) +[@@deriving yojson] and module_type_declaration = Parsetree.module_type_declaration = { @@ -722,10 +774,11 @@ and module_type_declaration = Parsetree.module_type_declaration = (* S = MT S (abstract module type declaration, pmtd_type = None) *) +[@@deriving yojson] and open_description = Parsetree.open_description = { - popen_lid: Longident.t loc; + popen_lid: longidentt loc; popen_override: override_flag; popen_loc: locationt; popen_attributes: attributes; @@ -734,6 +787,7 @@ and open_description = Parsetree.open_description = shadowing' warning) open X - popen_override = Fresh *) +[@@deriving yojson] and 'a include_infos = 'a Parsetree.include_infos = { @@ -741,24 +795,28 @@ and 'a include_infos = 'a Parsetree.include_infos = pincl_loc: locationt; pincl_attributes: attributes; } +[@@deriving yojson] and include_description = module_type include_infos (* include MT *) +[@@deriving yojson] and include_declaration = module_expr include_infos (* include ME *) +[@@deriving yojson] and with_constraint = Parsetree.with_constraint = - | Pwith_type of Longident.t loc * type_declaration + | Pwith_type of longidentt loc * type_declaration (* with type X.t = ... Note: the last component of the longident must match the name of the type_declaration. *) - | Pwith_module of Longident.t loc * Longident.t loc + | Pwith_module of longidentt loc * longidentt loc (* with module X.Y = Z *) | Pwith_typesubst of type_declaration (* with type t := ... *) - | Pwith_modsubst of string loc * Longident.t loc + | Pwith_modsubst of string loc * longidentt loc (* with module X := Z *) +[@@deriving yojson] (* Value expressions for the module language *) @@ -768,9 +826,10 @@ and module_expr = Parsetree.module_expr = pmod_loc: locationt; pmod_attributes: attributes; (* ... [@id1] [@id2] *) } +[@@deriving yojson] and module_expr_desc = Parsetree.module_expr_desc = - | Pmod_ident of Longident.t loc + | Pmod_ident of longidentt loc (* X *) | Pmod_structure of structure (* struct ... end *) @@ -784,14 +843,17 @@ and module_expr_desc = Parsetree.module_expr_desc = (* (val E) *) | Pmod_extension of extension (* [%id] *) +[@@deriving yojson] and structure = structure_item list +[@@deriving yojson] and structure_item = Parsetree.structure_item = { pstr_desc: structure_item_desc; pstr_loc: locationt; } +[@@deriving yojson] and structure_item_desc = Parsetree.structure_item_desc = | Pstr_eval of expression * attributes @@ -827,6 +889,7 @@ and structure_item_desc = Parsetree.structure_item_desc = (* [@@@id] *) | Pstr_extension of extension * attributes (* [%%id] *) +[@@deriving yojson] and value_binding = Parsetree.value_binding = { @@ -835,6 +898,7 @@ and value_binding = Parsetree.value_binding = pvb_attributes: attributes; pvb_loc: locationt; } +[@@deriving yojson] and module_binding = Parsetree.module_binding = { @@ -844,6 +908,7 @@ and module_binding = Parsetree.module_binding = pmb_loc: locationt; } (* X = ME *) +[@@deriving yojson] (** {2 Toplevel} *) @@ -853,30 +918,26 @@ type toplevel_phrase = Parsetree.toplevel_phrase = | Ptop_def of structure | Ptop_dir of string * directive_argument (* #use, #load ... *) +[@@deriving yojson] and directive_argument = Parsetree.directive_argument = | Pdir_none | Pdir_string of string | Pdir_int of int - | Pdir_ident of Longident.t + | Pdir_ident of longidentt | Pdir_bool of bool +[@@deriving yojson] +type commentWithCategory = (string * Reason_pprint_ast.commentCategory * locationt) list +[@@deriving yojson] +type full = structure * commentWithCategory [@@deriving yojson] -let checkconv (ast:structure) = -();; - - -let print_intf (ast:Parsetree.signature) = - print_endline "interface";; - -type a = {hi: string; ho: int} [@@deriving yojson];; - -type x = | A of a | B of int [@@deriving yojson];; +let print_ast (ast:Parsetree.structure) comments = + print_endline (Yojson.Safe.to_string (full_to_yojson (ast, comments)));; -let print_ast (ast:Parsetree.structure) = - let () = checkconv ast in - print_endline (Yojson.Safe.to_string -(* (structure_to_yojson ast) *) -(x_to_yojson (A {hi="ho"; ho=10})) -);; +let parse_ast (filename:string) = +match (full_of_yojson (Yojson.Safe.from_file filename)) with +| Result.Ok data -> (data, false, false) +| Result.Error wat -> failwith "FAIL" + ;; diff --git a/src/reason_pprint_ast.ml b/src/reason_pprint_ast.ml index 103986d4d..a4dbe9f88 100644 --- a/src/reason_pprint_ast.ml +++ b/src/reason_pprint_ast.ml @@ -64,6 +64,7 @@ type commentCategory = | EndOfLine | SingleLine | Regular +[@@deriving yojson] (* (comment text, attachment_location, physical location) *) type commentWithCategory = (String.t * commentCategory * Location.t) list diff --git a/src/refmt_impl.ml b/src/refmt_impl.ml index 0be1c796e..23dc38033 100644 --- a/src/refmt_impl.ml +++ b/src/refmt_impl.ml @@ -11,6 +11,7 @@ let default_print_width = 100 let defaultImplementationParserFor use_stdin filename = if Filename.check_suffix filename ".re" then (Reason_toolchain.JS.canonical_implementation_with_comments (Reason_toolchain.setup_lexbuf use_stdin filename), false, false) else if Filename.check_suffix filename ".ml" then (Reason_toolchain.ML.canonical_implementation_with_comments (Reason_toolchain.setup_lexbuf use_stdin filename), true, false) + else if Filename.check_suffix filename ".json" then Reason_astjson.parse_ast filename else ( raise (Invalid_config ("Cannot determine default implementation parser for filename '" ^ filename ^ "'.")) ) @@ -175,9 +176,6 @@ let () = | Some "ast" -> fun (ast, comments) -> ( Printast.interface Format.std_formatter ast ) - | Some "json" -> fun (ast, comments) -> ( - Reason_astjson.print_intf ast - ) (* If you don't wrap the function in parens, it's a totally different * meaning #thanksOCaml *) | Some "none" -> (fun (ast, comments) -> ()) @@ -195,6 +193,7 @@ let () = | Some "binary" -> ocamlBinaryParser use_stdin filename false | Some "ml" -> (Reason_toolchain.ML.canonical_implementation_with_comments (Reason_toolchain.setup_lexbuf use_stdin filename), true, false) | Some "re" -> (Reason_toolchain.JS.canonical_implementation_with_comments (Reason_toolchain.setup_lexbuf use_stdin filename), false, false) + | Some "json" -> Reason_astjson.parse_ast filename | Some s -> ( raise (Invalid_config ("Invalid -parse setting for interface '" ^ s ^ "'.")) ) @@ -228,7 +227,7 @@ let () = Printast.implementation Format.std_formatter ast ) | Some "json" -> fun (ast, comments) -> ( - Reason_astjson.print_ast ast + Reason_astjson.print_ast ast comments ) (* If you don't wrap the function in parens, it's a totally different * meaning #thanksOCaml *) From 37142924c0274f2df0eec026947bc241b5a83bb5 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Sat, 27 Aug 2016 22:26:24 -0600 Subject: [PATCH 3/7] formatting --- pkg/build.ml | 1 - src/refmt_impl.ml | 8 +++----- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/pkg/build.ml b/pkg/build.ml index 35ca2600d..767c2ecc3 100755 --- a/pkg/build.ml +++ b/pkg/build.ml @@ -51,7 +51,6 @@ let () = Pkg.bin ~auto:true "src/reason_format_type" ~dst:"refmttype"; Pkg.share "editorSupport/emacs/refmt.el" ~dst:"../emacs/site-lisp/refmt.el"; Pkg.share "editorSupport/emacs/reason-mode.el" ~dst:"../emacs/site-lisp/reason-mode.el"; - (* atom-reason *) (* Unfortunately we have to specificy each individual file *) Pkg.share "editorSupport/atom-reason/package.json" ~dst:"editorSupport/atom-reason/package.json"; diff --git a/src/refmt_impl.ml b/src/refmt_impl.ml index 23dc38033..290618900 100644 --- a/src/refmt_impl.ml +++ b/src/refmt_impl.ml @@ -87,10 +87,10 @@ let () = "-use-stdin", Arg.Bool (fun x -> use_stdin := x), ", parse AST from (either true, false). You still must provide a file name even if using stdin for errors to be reported"; "-recoverable", Arg.Bool (fun x -> recoverable := x), "Enable recoverable parser"; "-assume-explicit-arity", Arg.Unit (fun () -> assumeExplicitArity := true), "If a constructor's argument is a tuple, always interpret it as multiple arguments"; - "-parse", Arg.String (fun x -> prse := Some x), ", parse AST as (either 'ml', 're', 'binary_reason(for interchange between Reason versions)', 'binary (from the ocaml compiler)')"; + "-parse", Arg.String (fun x -> prse := Some x), ", parse AST as (either 'ml', 're', 'binary_reason(for interchange between Reason versions)', 'binary (from the ocaml compiler)', 'json')"; (* Use a print option of "none" to simply perform a parsing validation - * useful for IDE error messages etc.*) - "-print", Arg.String (fun x -> prnt := Some x), ", print AST in (either 'ml', 're', 'binary(default - for compiler input)', 'binary_reason(for interchange between Reason versions)', 'ast (print human readable directly)', 'none')"; + "-print", Arg.String (fun x -> prnt := Some x), ", print AST in (either 'ml', 're', 'binary(default - for compiler input)', 'binary_reason(for interchange between Reason versions)', 'ast (print human readable directly)', 'json', 'none')"; "-print-width", Arg.Int (fun x -> print_width := Some x), ", wrapping width for printing the AST"; "-heuristics-file", Arg.String (fun x -> heuristics_file := Some x), ", load path as a heuristics file to specify which constructors are defined with multi-arguments. Mostly used in removing [@implicit_arity] introduced from OCaml conversion.\n\t\texample.txt:\n\t\tConstructor1\n\t\tConstructor2"; @@ -226,9 +226,7 @@ let () = | Some "ast" -> fun (ast, comments) -> ( Printast.implementation Format.std_formatter ast ) - | Some "json" -> fun (ast, comments) -> ( - Reason_astjson.print_ast ast comments - ) + | Some "json" -> fun (ast, comments) -> Reason_astjson.print_ast ast comments (* If you don't wrap the function in parens, it's a totally different * meaning #thanksOCaml *) | Some "none" -> (fun (ast, comments) -> ()) From 7ea0cb341831f5da7ea5eddbe398e55c62501f8a Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Sat, 27 Aug 2016 22:34:38 -0600 Subject: [PATCH 4/7] better error message --- src/reason_astjson.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/reason_astjson.ml b/src/reason_astjson.ml index 8ffbc9802..04eafbe52 100644 --- a/src/reason_astjson.ml +++ b/src/reason_astjson.ml @@ -939,5 +939,5 @@ let print_ast (ast:Parsetree.structure) comments = let parse_ast (filename:string) = match (full_of_yojson (Yojson.Safe.from_file filename)) with | Result.Ok data -> (data, false, false) -| Result.Error wat -> failwith "FAIL" +| Result.Error message -> failwith ("Provided JSON doesn't match reason AST format: " ^ message) ;; From 8a4649a53fd4d9b8c7086f84996929de726220e4 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Sat, 27 Aug 2016 23:50:24 -0600 Subject: [PATCH 5/7] get -use-stdin working --- src/reason_astjson.ml | 13 ++++++++----- src/refmt_impl.ml | 4 ++-- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/src/reason_astjson.ml b/src/reason_astjson.ml index 04eafbe52..68897f638 100644 --- a/src/reason_astjson.ml +++ b/src/reason_astjson.ml @@ -936,8 +936,11 @@ type full = structure * commentWithCategory [@@deriving yojson] let print_ast (ast:Parsetree.structure) comments = print_endline (Yojson.Safe.to_string (full_to_yojson (ast, comments)));; -let parse_ast (filename:string) = -match (full_of_yojson (Yojson.Safe.from_file filename)) with -| Result.Ok data -> (data, false, false) -| Result.Error message -> failwith ("Provided JSON doesn't match reason AST format: " ^ message) - ;; +let parse_ast use_stdin (filename:string) = + let json = if use_stdin then + Yojson.Safe.from_channel Pervasives.stdin + else (Yojson.Safe.from_file filename) in + match (full_of_yojson json) with + | Result.Ok data -> (data, false, false) + | Result.Error message -> failwith ("Provided JSON doesn't match reason AST format: " ^ message) + ;; diff --git a/src/refmt_impl.ml b/src/refmt_impl.ml index 290618900..51bd633a5 100644 --- a/src/refmt_impl.ml +++ b/src/refmt_impl.ml @@ -11,7 +11,7 @@ let default_print_width = 100 let defaultImplementationParserFor use_stdin filename = if Filename.check_suffix filename ".re" then (Reason_toolchain.JS.canonical_implementation_with_comments (Reason_toolchain.setup_lexbuf use_stdin filename), false, false) else if Filename.check_suffix filename ".ml" then (Reason_toolchain.ML.canonical_implementation_with_comments (Reason_toolchain.setup_lexbuf use_stdin filename), true, false) - else if Filename.check_suffix filename ".json" then Reason_astjson.parse_ast filename + else if Filename.check_suffix filename ".json" then Reason_astjson.parse_ast use_stdin filename else ( raise (Invalid_config ("Cannot determine default implementation parser for filename '" ^ filename ^ "'.")) ) @@ -193,7 +193,7 @@ let () = | Some "binary" -> ocamlBinaryParser use_stdin filename false | Some "ml" -> (Reason_toolchain.ML.canonical_implementation_with_comments (Reason_toolchain.setup_lexbuf use_stdin filename), true, false) | Some "re" -> (Reason_toolchain.JS.canonical_implementation_with_comments (Reason_toolchain.setup_lexbuf use_stdin filename), false, false) - | Some "json" -> Reason_astjson.parse_ast filename + | Some "json" -> Reason_astjson.parse_ast use_stdin filename | Some s -> ( raise (Invalid_config ("Invalid -parse setting for interface '" ^ s ^ "'.")) ) From b1f863f56dc9370143eb93eeb4a39fe9c6b46844 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Sat, 27 Aug 2016 23:53:47 -0600 Subject: [PATCH 6/7] update opam deps --- opam | 3 +++ 1 file changed, 3 insertions(+) diff --git a/opam b/opam index 5b2477a72..0390aef22 100644 --- a/opam +++ b/opam @@ -26,6 +26,9 @@ depends: [ "BetterErrors" {>= "0.0.1"} "menhir" {>= "20160303"} "re" {>= "1.5.0"} + "ppx_deriving" {>= "4.0"} + "ppx_deriving_yojson" {>= "3.0"} + "yojson" {>= "1.3.2"} ] depopts: [ ] From 9e096050da99077ec517da7eac366a9b0868f3d8 Mon Sep 17 00:00:00 2001 From: Jordan Walke Date: Tue, 13 Sep 2016 23:19:45 -0700 Subject: [PATCH 7/7] Add ppx_deriving to package.json --- package.json | 1 + 1 file changed, 1 insertion(+) diff --git a/package.json b/package.json index cdcd7edc0..fa5e0bab9 100644 --- a/package.json +++ b/package.json @@ -46,6 +46,7 @@ }, "name": "reason", "dependencies": { + "ppx_deriving": "https://github.com/npm-opam/ppx_deriving.git", "merlin": "https://github.com/npm-opam/merlin", "re": "https://github.com/npm-opam/re", "ocamlfind": "https://github.com/npm-opam/ocamlfind",