From 4695d39fa75865366610f3f473c6f145805cded3 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Mon, 13 Aug 2018 00:01:35 -0700 Subject: [PATCH 01/23] extract into separate file --- src/reason-parser/jbuild | 1 + src/reason-parser/reason_attrs.ml | 97 ++++++++++++++++++++++++++ src/reason-parser/reason_pprint_ast.ml | 56 +-------------- 3 files changed, 99 insertions(+), 55 deletions(-) create mode 100644 src/reason-parser/reason_attrs.ml diff --git a/src/reason-parser/jbuild b/src/reason-parser/jbuild index 290d7d1fc..9320543a8 100644 --- a/src/reason-parser/jbuild +++ b/src/reason-parser/jbuild @@ -56,6 +56,7 @@ reason_syntax_util reason_comment reason_layout + reason_attrs reason_heuristics reason_location reason_toolchain diff --git a/src/reason-parser/reason_attrs.ml b/src/reason-parser/reason_attrs.ml new file mode 100644 index 000000000..5c6f0c8e3 --- /dev/null +++ b/src/reason-parser/reason_attrs.ml @@ -0,0 +1,97 @@ + +open Ast_404 +open Parsetree +open Location + +(** Kinds of attributes *) +type attributesPartition = { + arityAttrs : attributes; + docAttrs : attributes; + stdAttrs : attributes; + jsxAttrs : attributes; + refmtAttrs : attributes; + literalAttrs : attributes; + uncurried : bool +} + +let isRefmtTag tag attr = + match attr with + | ( + {txt="refmt"; loc}, + PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant(Pconst_string(foundTag, None))}, _)}] + ) -> foundTag = tag + | _ -> false + +let hasRefmtTag tag = List.exists (isRefmtTag tag) + +let isRefmt ~filter attr = + match attr with + | ( + {txt="refmt"; loc}, + PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant(Pconst_string(tag, None))}, _)}] + ) -> ( + match filter with + | None -> true + | Some style -> String.compare tag style == 0 + ) + | _ -> false +let isRefmtExplicitBraces = isRefmt ~filter:(Some "explicitBraces") +let isRefmtInlineOpen = isRefmt ~filter:(Some "inlineOpen") + +(** Partition attributes into kinds *) +let rec partitionAttributes ?(partDoc=false) ?(allowUncurry=true) attrs : attributesPartition = + match attrs with + | [] -> + {arityAttrs=[]; docAttrs=[]; stdAttrs=[]; jsxAttrs=[]; refmtAttrs=[]; literalAttrs=[]; uncurried = false} + | (({txt = "bs"}, PStr []) as attr)::atTl -> + let partition = partitionAttributes ~partDoc ~allowUncurry atTl in + if allowUncurry then + {partition with uncurried = true} + else {partition with stdAttrs=attr::partition.stdAttrs} + | attr::atTl when isRefmt ~filter:None attr -> + let partition = partitionAttributes ~partDoc ~allowUncurry atTl in + {partition with refmtAttrs=attr::partition.refmtAttrs} + | (({txt="JSX"; loc}, _) as jsx)::atTl -> + let partition = partitionAttributes ~partDoc ~allowUncurry atTl in + {partition with jsxAttrs=jsx::partition.jsxAttrs} + | (({txt="explicit_arity"; loc}, _) as arity_attr)::atTl + | (({txt="implicit_arity"; loc}, _) as arity_attr)::atTl -> + let partition = partitionAttributes ~partDoc ~allowUncurry atTl in + {partition with arityAttrs=arity_attr::partition.arityAttrs} + | (({txt="ocaml.text"; loc}, _) as doc)::atTl when partDoc = true -> + let partition = partitionAttributes ~partDoc ~allowUncurry atTl in + {partition with docAttrs=doc::partition.docAttrs} + | (({txt="ocaml.doc"; loc}, _) as doc)::atTl when partDoc = true -> + let partition = partitionAttributes ~partDoc ~allowUncurry atTl in + {partition with docAttrs=doc::partition.docAttrs} + | (({txt="reason.raw_literal"; _}, _) as attr) :: atTl -> + let partition = partitionAttributes ~partDoc ~allowUncurry atTl in + {partition with literalAttrs=attr::partition.literalAttrs} + | atHd :: atTl -> + let partition = partitionAttributes ~partDoc ~allowUncurry atTl in + {partition with stdAttrs=atHd::partition.stdAttrs} + +let extractStdAttrs attrs = + (partitionAttributes attrs).stdAttrs + +let extract_raw_literal attrs = + let rec loop acc = function + | ({txt="reason.raw_literal"; loc}, + PStr [{pstr_desc = Pstr_eval({pexp_desc = Pexp_constant(Pconst_string(text, None)); _}, _); _}]) + :: rest -> + (Some text, List.rev_append acc rest) + | [] -> (None, List.rev acc) + | attr :: rest -> loop (attr :: acc) rest + in + loop [] attrs + +(* Returns (selected, remaining) *) +let rec partition fn attrs : attribute list * attribute list = + match attrs with + | [] -> ([], []) + | attr::atTl when fn attr -> + let (selectedRec, remainingRec) = partition fn atTl in + (attr::selectedRec, remainingRec) + | attr::atTl -> + let (selectedRec, remainingRec) = partition fn atTl in + (selectedRec, attr::remainingRec) \ No newline at end of file diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index ab17b1ca3..90c1b036e 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -55,6 +55,7 @@ open Longident open Parsetree open Easy_format open Reason_syntax_util +open Reason_attrs module Comment = Reason_comment module Layout = Reason_layout @@ -300,61 +301,6 @@ let extractLocationFromValBindList expr vbs = in { loc with loc_start = expr.pexp_loc.loc_start } -(** Kinds of attributes *) -type attributesPartition = { - arityAttrs : attributes; - docAttrs : attributes; - stdAttrs : attributes; - jsxAttrs : attributes; - literalAttrs : attributes; - uncurried : bool -} - -(** Partition attributes into kinds *) -let rec partitionAttributes ?(partDoc=false) ?(allowUncurry=true) attrs : attributesPartition = - match attrs with - | [] -> - {arityAttrs=[]; docAttrs=[]; stdAttrs=[]; jsxAttrs=[]; literalAttrs=[]; uncurried = false} - | (({txt = "bs"}, PStr []) as attr)::atTl -> - let partition = partitionAttributes ~partDoc ~allowUncurry atTl in - if allowUncurry then - {partition with uncurried = true} - else {partition with stdAttrs=attr::partition.stdAttrs} - | (({txt="JSX"; loc}, _) as jsx)::atTl -> - let partition = partitionAttributes ~partDoc ~allowUncurry atTl in - {partition with jsxAttrs=jsx::partition.jsxAttrs} - | (({txt="explicit_arity"; loc}, _) as arity_attr)::atTl - | (({txt="implicit_arity"; loc}, _) as arity_attr)::atTl -> - let partition = partitionAttributes ~partDoc ~allowUncurry atTl in - {partition with arityAttrs=arity_attr::partition.arityAttrs} - | (({txt="ocaml.text"; loc}, _) as doc)::atTl when partDoc = true -> - let partition = partitionAttributes ~partDoc ~allowUncurry atTl in - {partition with docAttrs=doc::partition.docAttrs} - | (({txt="ocaml.doc"; loc}, _) as doc)::atTl when partDoc = true -> - let partition = partitionAttributes ~partDoc ~allowUncurry atTl in - {partition with docAttrs=doc::partition.docAttrs} - | (({txt="reason.raw_literal"; _}, _) as attr) :: atTl -> - let partition = partitionAttributes ~partDoc ~allowUncurry atTl in - {partition with literalAttrs=attr::partition.literalAttrs} - | atHd :: atTl -> - let partition = partitionAttributes ~partDoc ~allowUncurry atTl in - {partition with stdAttrs=atHd::partition.stdAttrs} - -let extractStdAttrs attrs = - (partitionAttributes attrs).stdAttrs - -let extract_raw_literal attrs = - let rec loop acc = function - | ({txt="reason.raw_literal"; loc}, - PStr [{pstr_desc = Pstr_eval({pexp_desc = Pexp_constant(Pconst_string(text, None)); _}, _); _}]) - :: rest -> - (Some text, List.rev_append acc rest) - | [] -> (None, List.rev acc) - | attr :: rest -> loop (attr :: acc) rest - in - loop [] attrs - - let rec sequentialIfBlocks x = match x with | Some ({pexp_desc=Pexp_ifthenelse (e1, e2, els)}) -> ( From c2d2bf99a40a58f7bc02cb3b15eeb6f3d8e107a2 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Mon, 13 Aug 2018 00:01:35 -0700 Subject: [PATCH 02/23] less open --- src/reason-parser/reason_attrs.ml | 23 ++++--- src/reason-parser/reason_pprint_ast.ml | 88 +++++++++++++------------- 2 files changed, 57 insertions(+), 54 deletions(-) diff --git a/src/reason-parser/reason_attrs.ml b/src/reason-parser/reason_attrs.ml index 5c6f0c8e3..e4fbee92c 100644 --- a/src/reason-parser/reason_attrs.ml +++ b/src/reason-parser/reason_attrs.ml @@ -3,16 +3,19 @@ open Ast_404 open Parsetree open Location -(** Kinds of attributes *) -type attributesPartition = { - arityAttrs : attributes; - docAttrs : attributes; - stdAttrs : attributes; - jsxAttrs : attributes; - refmtAttrs : attributes; - literalAttrs : attributes; - uncurried : bool -} +module T = struct + (** Kinds of attributes *) + type attributesPartition = { + arityAttrs : attributes; + docAttrs : attributes; + stdAttrs : attributes; + jsxAttrs : attributes; + refmtAttrs : attributes; + literalAttrs : attributes; + uncurried : bool + } +end +open T let isRefmtTag tag attr = match attr with diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 90c1b036e..75fa7bfc4 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -55,7 +55,7 @@ open Longident open Parsetree open Easy_format open Reason_syntax_util -open Reason_attrs +open Reason_attrs.T module Comment = Reason_comment module Layout = Reason_layout @@ -2015,7 +2015,7 @@ let isJSXComponent expr = match expr with | ({pexp_desc= Pexp_apply ({pexp_desc=Pexp_ident _}, args); pexp_attributes}) | ({pexp_desc= Pexp_apply ({pexp_desc=Pexp_letmodule(_,_,_)}, args); pexp_attributes}) -> - let {jsxAttrs} = partitionAttributes pexp_attributes in + let {jsxAttrs} = Reason_attrs.partitionAttributes pexp_attributes in let hasLabelledChildrenLiteral = List.exists (function | (Labelled "children", _) -> true | _ -> false @@ -2363,7 +2363,7 @@ let printer = object(self:'self) method non_arrowed_core_type x = self#non_arrowed_non_simple_core_type x method core_type2 x = - let {stdAttrs; uncurried} = partitionAttributes x.ptyp_attributes in + let {stdAttrs; uncurried} = Reason_attrs.partitionAttributes x.ptyp_attributes in let uncurried = uncurried || try Hashtbl.find uncurriedTable x.ptyp_loc with | Not_found -> false in if stdAttrs <> [] then formatAttributed @@ -2416,7 +2416,7 @@ let printer = object(self:'self) (* Same as core_type2 but can be aliased *) method core_type x = - let {stdAttrs; uncurried} = partitionAttributes x.ptyp_attributes in + let {stdAttrs; uncurried} = Reason_attrs.partitionAttributes x.ptyp_attributes in let () = if uncurried then Hashtbl.add uncurriedTable x.ptyp_loc true in if stdAttrs <> [] then formatAttributed @@ -2619,7 +2619,7 @@ let printer = object(self:'self) (atom "=") td in - let {stdAttrs; docAttrs} = partitionAttributes ~partDoc:true td.ptype_attributes in + let {stdAttrs; docAttrs} = Reason_attrs.partitionAttributes ~partDoc:true td.ptype_attributes in let layout = self#attach_std_item_attrs stdAttrs itm in self#attachDocAttrsToLayout ~stdAttrs @@ -2652,7 +2652,7 @@ let printer = object(self:'self) * not parsed or printed correctly. *) method type_variant_leaf1 opt_ampersand polymorphic print_bar x = let {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} = x in - let {stdAttrs} = partitionAttributes pcd_attributes in + let {stdAttrs} = Reason_attrs.partitionAttributes pcd_attributes in let ampersand_helper i arg = let ct = self#core_type arg in let ct = match arg.ptyp_desc with @@ -2754,7 +2754,7 @@ let printer = object(self:'self) let recordRow = match pld.pld_attributes with | [] -> recordRow | attrs -> - let {stdAttrs; docAttrs} = partitionAttributes ~partDoc:true attrs in + let {stdAttrs; docAttrs} = Reason_attrs.partitionAttributes ~partDoc:true attrs in let stdAttrsLayout = makeList ~inline:(true, true) ~postSpace:true (self#attributes stdAttrs) in @@ -2917,7 +2917,7 @@ let printer = object(self:'self) "hello", None. *) method non_arrowed_non_simple_core_type x = - let {stdAttrs} = partitionAttributes x.ptyp_attributes in + let {stdAttrs} = Reason_attrs.partitionAttributes x.ptyp_attributes in if stdAttrs <> [] then formatAttributed (self#non_arrowed_simple_core_type {x with ptyp_attributes=[]}) @@ -2934,7 +2934,7 @@ let printer = object(self:'self) | t -> self#core_type t method non_arrowed_simple_core_type x = - let {stdAttrs} = partitionAttributes x.ptyp_attributes in + let {stdAttrs} = Reason_attrs.partitionAttributes x.ptyp_attributes in if stdAttrs <> [] then formatSimpleAttributed (self#non_arrowed_simple_core_type {x with ptyp_attributes=[]}) @@ -3085,7 +3085,7 @@ let printer = object(self:'self) method pattern_without_or x = (* TODOATTRIBUTES: Handle the stdAttrs here *) - let {arityAttrs} = partitionAttributes x.ppat_attributes in + let {arityAttrs} = Reason_attrs.partitionAttributes x.ppat_attributes in match x.ppat_desc with | Ppat_alias (p, s) -> let raw_pattern = (self#pattern p) in @@ -3126,7 +3126,7 @@ let printer = object(self:'self) | _ -> self#simple_pattern x method pattern x = - let {arityAttrs; stdAttrs} = partitionAttributes x.ppat_attributes in + let {arityAttrs; stdAttrs} = Reason_attrs.partitionAttributes x.ppat_attributes in if stdAttrs <> [] then formatAttributed (* Doesn't need to be simple_pattern because attributes are parse as @@ -3207,7 +3207,7 @@ let printer = object(self:'self) | _ -> self#pattern x method simple_pattern x = - let {arityAttrs; stdAttrs} = partitionAttributes x.ppat_attributes in + let {arityAttrs; stdAttrs} = Reason_attrs.partitionAttributes x.ppat_attributes in if stdAttrs <> [] then formatSimpleAttributed (self#simple_pattern {x with ppat_attributes=arityAttrs}) @@ -3260,7 +3260,7 @@ let printer = object(self:'self) | Ppat_tuple l -> self#patternTuple l | Ppat_constant c -> - let raw_literal, _ = extract_raw_literal x.ppat_attributes in + let raw_literal, _ = Reason_attrs.extract_raw_literal x.ppat_attributes in (self#constant ?raw_literal c) | Ppat_interval (c1, c2) -> makeList [self#constant c1; atom ".."; self#constant c2] @@ -3316,7 +3316,7 @@ let printer = object(self:'self) method simple_get_application x = - let {stdAttrs; jsxAttrs} = partitionAttributes x.pexp_attributes in + let {stdAttrs; jsxAttrs} = Reason_attrs.partitionAttributes x.pexp_attributes in match (x.pexp_desc, stdAttrs, jsxAttrs) with | (_, attrHd::attrTl, []) -> None (* Has some printed attributes - not simple *) | (Pexp_apply ({pexp_desc=Pexp_ident loc}, l), [], _jsx::_) -> ( @@ -3534,7 +3534,7 @@ let printer = object(self:'self) (* This method may not even be needed *) method unparseUnattributedExpr x = - match partitionAttributes x.pexp_attributes with + match Reason_attrs.partitionAttributes x.pexp_attributes with | {docAttrs = []; stdAttrs = []; _} -> self#unparseExpr x | _ -> makeList ~wrap:("(",")") [self#unparseExpr x] @@ -3561,7 +3561,7 @@ let printer = object(self:'self) * Some((-1)) should be printed as Some(-1). This is in contrast with * 1 + (-1) where we print the parens for readability. *) let raw_literal, pexp_attributes = - extract_raw_literal pexp_attributes + Reason_attrs.extract_raw_literal pexp_attributes in let constant = self#constant ?raw_literal ~parens:ensureExpr c in begin match pexp_attributes with @@ -3814,7 +3814,7 @@ let printer = object(self:'self) (* If there are any attributes, render unary like `(~-) x [@ppx]`, and infix like `(+) x y [@attr]` *) let {arityAttrs; stdAttrs; jsxAttrs; literalAttrs; uncurried} = - partitionAttributes ~allowUncurry:(Reason_heuristics.bsExprCanBeUncurried x) x.pexp_attributes + Reason_attrs.partitionAttributes ~allowUncurry:(Reason_heuristics.bsExprCanBeUncurried x) x.pexp_attributes in let () = if uncurried then Hashtbl.add uncurriedTable x.pexp_loc true in let x = {x with pexp_attributes = (literalAttrs @ arityAttrs @ stdAttrs @ jsxAttrs) } in @@ -4051,7 +4051,7 @@ let printer = object(self:'self) let leftItm = self#unparseResolvedRule ( self#ensureExpression ~reducesOnToken:prec e ) in - let {stdAttrs} = partitionAttributes e.pexp_attributes in + let {stdAttrs} = Reason_attrs.partitionAttributes e.pexp_attributes in let formattedLeftItm = if stdAttrs = [] then leftItm else @@ -4978,7 +4978,7 @@ let printer = object(self:'self) let appTerms = self#unparseExprApplicationItems x.pvb_expr in self#formatSimplePatternBinding prefixText layoutPattern None appTerms in - let {stdAttrs; docAttrs} = partitionAttributes ~partDoc:true x.pvb_attributes in + let {stdAttrs; docAttrs} = Reason_attrs.partitionAttributes ~partDoc:true x.pvb_attributes in let body = makeList ~inline:(true, true) [body] in let layout = self#attach_std_item_attrs stdAttrs (source_map ~loc:x.pvb_loc body) in @@ -5323,7 +5323,7 @@ let printer = object(self:'self) (* Expressions requiring parens, in most contexts such as separated by infix *) method expression_requiring_parens_in_infix x = - let {stdAttrs} = partitionAttributes x.pexp_attributes in + let {stdAttrs} = Reason_attrs.partitionAttributes x.pexp_attributes in assert (stdAttrs == []); (* keep the incoming expression around, an expr with * immediate extension sugar might contain less than perfect location @@ -5724,7 +5724,7 @@ let printer = object(self:'self) method unparseObject ?wrap:((lwrap,rwrap)=("", "")) ?(withStringKeys=false) l o = let core_field_type (s, attrs, ct) = - let l = extractStdAttrs attrs in + let l = Reason_attrs.extractStdAttrs attrs in let row = let rowKey = if withStringKeys then (makeList ~wrap:("\"", "\"") [atom s]) @@ -5802,7 +5802,7 @@ let printer = object(self:'self) | _ -> assert false method simplest_expression x = - let {stdAttrs; jsxAttrs} = partitionAttributes x.pexp_attributes in + let {stdAttrs; jsxAttrs} = Reason_attrs.partitionAttributes x.pexp_attributes in if stdAttrs <> [] then None else @@ -5862,7 +5862,7 @@ let printer = object(self:'self) Some (ensureSingleTokenSticksToLabel (self#longident_loc li)) | Pexp_constant c -> (* Constants shouldn't break when to the right of a label *) - let raw_literal, _ = extract_raw_literal x.pexp_attributes in + let raw_literal, _ = Reason_attrs.extract_raw_literal x.pexp_attributes in Some (ensureSingleTokenSticksToLabel (self#constant ?raw_literal c)) | Pexp_pack me -> @@ -5941,7 +5941,7 @@ let printer = object(self:'self) method formatChildren children processedRev = match children with | {pexp_desc = Pexp_constant constant} as x :: remaining -> - let raw_literal, _ = extract_raw_literal x.pexp_attributes in + let raw_literal, _ = Reason_attrs.extract_raw_literal x.pexp_attributes in self#formatChildren remaining (self#constant ?raw_literal constant :: processedRev) | {pexp_desc = Pexp_construct ({txt = Lident "::"}, Some {pexp_desc = Pexp_tuple children} )} as x :: remaining -> begin match x.pexp_attributes with @@ -6032,13 +6032,13 @@ let printer = object(self:'self) method attributes l = List.map self#attribute l method attach_std_attrs l toThis = - let l = extractStdAttrs l in + let l = Reason_attrs.extractStdAttrs l in match l with | [] -> toThis | _::_ -> makeList ~postSpace:true (List.concat [self#attributes l; [toThis]]) method attach_std_item_attrs ?(allowUncurry=true) ?extension l toThis = - let l = (partitionAttributes ~allowUncurry l).stdAttrs in + let l = (Reason_attrs.partitionAttributes ~allowUncurry l).stdAttrs in match extension, l with | None, [] -> toThis | _, _ -> @@ -6061,7 +6061,7 @@ let printer = object(self:'self) | Pext_rebind id -> [atom pcd_name.txt; atom "="; (self#longident_loc id)] in let {stdAttrs; docAttrs} = - partitionAttributes ~partDoc:true ed.pext_attributes + Reason_attrs.partitionAttributes ~partDoc:true ed.pext_attributes in let layout = self#attach_std_item_attrs @@ -6164,7 +6164,7 @@ let printer = object(self:'self) match vd.pval_attributes with | [] -> primDecl | attrs -> - let {stdAttrs; docAttrs} = partitionAttributes ~partDoc:true attrs in + let {stdAttrs; docAttrs} = Reason_attrs.partitionAttributes ~partDoc:true attrs in let docs = List.map self#item_attribute docAttrs in let formattedDocs = makeList ~postSpace:true docs in let attrs = List.map self#item_attribute stdAttrs in @@ -6247,7 +6247,7 @@ let printer = object(self:'self) in let includingEqual = makeList ~postSpace:true [upToName; atom "="] in let {stdAttrs; docAttrs} = - partitionAttributes ~partDoc:true pci_attributes + Reason_attrs.partitionAttributes ~partDoc:true pci_attributes in let layout = self#attach_std_item_attrs stdAttrs @@ @@ -6455,7 +6455,7 @@ let printer = object(self:'self) source_map ~loc:p.ppat_loc field :: fields method simple_class_expr x = - let {stdAttrs} = partitionAttributes x.pcl_attributes in + let {stdAttrs} = Reason_attrs.partitionAttributes x.pcl_attributes in if stdAttrs <> [] then formatSimpleAttributed (self#simple_class_expr {x with pcl_attributes=[]}) @@ -6500,7 +6500,7 @@ let printer = object(self:'self) | _ -> [self#class_expr x] method class_expr x = - let {stdAttrs} = partitionAttributes x.pcl_attributes in + let {stdAttrs} = Reason_attrs.partitionAttributes x.pcl_attributes in (* We cannot handle the attributes here. Must handle them in each item *) if stdAttrs <> [] then (* Do not need a "simple" attributes precedence wrapper. *) @@ -6576,7 +6576,7 @@ let printer = object(self:'self) self#primitive_declaration vd else let intro = atom "let" in - let {stdAttrs; docAttrs} = partitionAttributes ~partDoc:true vd.pval_attributes in + let {stdAttrs; docAttrs} = Reason_attrs.partitionAttributes ~partDoc:true vd.pval_attributes in let layout = self#attach_std_item_attrs stdAttrs (formatTypeConstraint (label ~space:true intro @@ -6608,7 +6608,7 @@ let printer = object(self:'self) patternAux ([(self#class_constructor_type x.pci_expr)], None) in - let {stdAttrs; docAttrs} = partitionAttributes ~partDoc:true x.pci_attributes in + let {stdAttrs; docAttrs} = Reason_attrs.partitionAttributes ~partDoc:true x.pci_attributes in let layout = self#attach_std_item_attrs stdAttrs withColon in source_map ~loc:pci_loc (self#attachDocAttrsToLayout @@ -6629,7 +6629,7 @@ let printer = object(self:'self) | Psig_module {pmd_name; pmd_type={pmty_desc=Pmty_alias alias}; pmd_attributes; pmd_loc} -> let {stdAttrs; docAttrs} = - partitionAttributes ~partDoc:true pmd_attributes + Reason_attrs.partitionAttributes ~partDoc:true pmd_attributes in let layout = self#attach_std_item_attrs stdAttrs @@ @@ -6649,7 +6649,7 @@ let printer = object(self:'self) () | Psig_module pmd -> let {stdAttrs; docAttrs} = - partitionAttributes ~partDoc:true pmd.pmd_attributes + Reason_attrs.partitionAttributes ~partDoc:true pmd.pmd_attributes in let letPattern = makeList @@ -6668,7 +6668,7 @@ let printer = object(self:'self) () | Psig_open od -> let {stdAttrs; docAttrs} = - partitionAttributes ~partDoc:true od.popen_attributes + Reason_attrs.partitionAttributes ~partDoc:true od.popen_attributes in let layout = self#attach_std_item_attrs stdAttrs @@ @@ -6684,7 +6684,7 @@ let printer = object(self:'self) () | Psig_include incl -> let {stdAttrs; docAttrs} = - partitionAttributes ~partDoc:true incl.pincl_attributes + Reason_attrs.partitionAttributes ~partDoc:true incl.pincl_attributes in let layout = self#attach_std_item_attrs stdAttrs @@ @@ -6704,7 +6704,7 @@ let printer = object(self:'self) | Some mt -> self#module_type letPattern mt in let {stdAttrs; docAttrs} = - partitionAttributes ~partDoc:true x.pmtd_attributes + Reason_attrs.partitionAttributes ~partDoc:true x.pmtd_attributes in let layout = self#attach_std_item_attrs stdAttrs main @@ -6719,7 +6719,7 @@ let printer = object(self:'self) | Psig_recmodule decls -> let first xx = let {stdAttrs; docAttrs} = - partitionAttributes ~partDoc:true xx.pmd_attributes + Reason_attrs.partitionAttributes ~partDoc:true xx.pmd_attributes in let letPattern = makeList @@ -6754,7 +6754,7 @@ let printer = object(self:'self) | Psig_attribute a -> self#floating_attribute a | Psig_extension (({loc}, _) as ext, attrs) -> let {stdAttrs; docAttrs} = - partitionAttributes ~partDoc:true attrs + Reason_attrs.partitionAttributes ~partDoc:true attrs in let layout = self#attach_std_item_attrs stdAttrs (self#item_extension ext) @@ -7065,7 +7065,7 @@ let printer = object(self:'self) let item = ( match term.pstr_desc with | Pstr_eval (e, attrs) -> - let {stdAttrs; jsxAttrs; uncurried} = partitionAttributes attrs in + let {stdAttrs; jsxAttrs; uncurried} = Reason_attrs.partitionAttributes attrs in if uncurried then Hashtbl.add uncurriedTable e.pexp_loc true; let layout = self#attach_std_item_attrs stdAttrs (self#unparseUnattributedExpr e) in (* If there was a JSX attribute BUT JSX component wasn't detected, @@ -7130,7 +7130,7 @@ let printer = object(self:'self) | Pstr_value (rf, l) -> self#bindings ~extension (rf, l) | _ -> let {stdAttrs; docAttrs} = - partitionAttributes ~partDoc:true a + Reason_attrs.partitionAttributes ~partDoc:true a in let layout = self#attach_std_item_attrs ~extension stdAttrs @@ -7151,7 +7151,7 @@ let printer = object(self:'self) let name = self#longident_loc ptyext_path in let item = self#formatOneTypeExt prepend name (atom "+=") te in let {stdAttrs; docAttrs} = - partitionAttributes ~partDoc:true te.ptyext_attributes + Reason_attrs.partitionAttributes ~partDoc:true te.ptyext_attributes in let layout = self#attach_std_item_attrs stdAttrs item in self#attachDocAttrsToLayout @@ -7379,7 +7379,7 @@ let printer = object(self:'self) * MyModuleBlah.toList(argument) *) let (argLbl, cb) = callbackArg in - let {stdAttrs; uncurried} = partitionAttributes cb.pexp_attributes in + let {stdAttrs; uncurried} = Reason_attrs.partitionAttributes cb.pexp_attributes in let cbAttrs = stdAttrs in if uncurried then Hashtbl.add uncurriedTable cb.pexp_loc true; let (cbArgs, retCb) = self#curriedPatternsAndReturnVal {cb with pexp_attributes = []} in From 998236452595be8d07b3c093c85caf9a5e60cc89 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Mon, 13 Aug 2018 00:01:35 -0700 Subject: [PATCH 03/23] wip --- esy.lock | 20 ++++++++++---------- src/reason-parser/reason_parser.mly | 29 ++++++++++++++++++++++++----- 2 files changed, 34 insertions(+), 15 deletions(-) diff --git a/esy.lock b/esy.lock index 09dfb3672..c79345fcc 100644 --- a/esy.lock +++ b/esy.lock @@ -78,7 +78,7 @@ "@opam/camomile@ >= 0.8.0", "@opam/camomile@ >= 0.8.6", "@opam/camomile@*": version "1.0.1" - uid f4d58fb782e0362b7848320ac26890de + uid "05d12e0e70ee18f5e2be40610245a687" resolved "@opam/camomile@1.0.1-f4d58fb782e0362b7848320ac26890de.tgz" dependencies: "@esy-ocaml/esy-installer" "^0.0.0" @@ -132,7 +132,7 @@ peerDependencies: ocaml " >= 4.2.3000" -"@opam/jbuilder@ >= 1.0.0-beta14", "@opam/jbuilder@ >= 1.0.0-beta17", "@opam/jbuilder@ >= 1.0.0-beta181", "@opam/jbuilder@ >= 1.0.0-beta7", "@opam/jbuilder@ >= 1.0.0-beta9", "@opam/jbuilder@*": +"@opam/jbuilder@ >= 1.0.0-beta10", "@opam/jbuilder@ >= 1.0.0-beta14", "@opam/jbuilder@ >= 1.0.0-beta17", "@opam/jbuilder@ >= 1.0.0-beta181", "@opam/jbuilder@ >= 1.0.0-beta7", "@opam/jbuilder@ >= 1.0.0-beta9", "@opam/jbuilder@*": version "1.0.0-beta20" uid "1648206284a54407f6eee01ed950fff7" resolved "@opam/jbuilder@1.0.0-beta20-1648206284a54407f6eee01ed950fff7.tgz" @@ -145,7 +145,7 @@ "@opam/lambda-term@ >= 1.2.0": version "1.12.0" - uid "318456db287041f877e89e7098a12312" + uid "0e01b94d401fbc91afe9dfbe283e8daa" resolved "@opam/lambda-term@1.12.0-318456db287041f877e89e7098a12312.tgz" dependencies: "@esy-ocaml/esy-installer" "^0.0.0" @@ -161,7 +161,7 @@ "@opam/lwt@ >= 2.7.0 < 4.0.0", "@opam/lwt@ >= 3.0.0", "@opam/lwt@*": version "3.3.0" - uid d6527433462fadf2f1b8168dbb5cf10e + uid "7a557303c8bfd71515f716b5429733b0" resolved "@opam/lwt@3.3.0-d6527433462fadf2f1b8168dbb5cf10e.tgz" dependencies: "@esy-ocaml/esy-installer" "^0.0.0" @@ -177,12 +177,12 @@ "@opam/lwt_react@*": version "1.1.1" - uid "50615b081ab21218a614fa9792562c69" + uid aa9053f8fd0e2684a474b8dbcc0a30d6 resolved "@opam/lwt_react@1.1.1-aa9053f8fd0e2684a474b8dbcc0a30d6.tgz" dependencies: "@esy-ocaml/esy-installer" "^0.0.0" "@esy-ocaml/substs" "^0.0.1" - "@opam/jbuilder" " >= 1.0.0-beta10" + "@opam/jbuilder" " >= 1.0.0-beta14" "@opam/lwt" " >= 3.0.0" "@opam/react" " >= 1.0.0" peerDependencies: @@ -214,7 +214,7 @@ "@opam/ocaml-migrate-parsetree@ >= 1.0.7", "@opam/ocaml-migrate-parsetree@*": version "1.0.10" - uid "48723a85ec73e8dc29f6f8710d1178a4" + uid f2453b30ff54c7634f7c771fdc71e968 resolved "@opam/ocaml-migrate-parsetree@1.0.10-48723a85ec73e8dc29f6f8710d1178a4.tgz" dependencies: "@esy-ocaml/esy-installer" "^0.0.0" @@ -296,7 +296,7 @@ "@opam/utop@ >= 1.17.0": version "2.1.0" - uid "52ddf36354cf7530843a68ffd29ed6ac" + uid "54c199bb75970aa22652d5456e02ff58" resolved "@opam/utop@2.1.0-52ddf36354cf7530843a68ffd29ed6ac.tgz" dependencies: "@esy-ocaml/esy-installer" "^0.0.0" @@ -312,7 +312,7 @@ "@opam/ocamlfind" " >= 1.7.2" "@opam/react" " >= 1.0.0" peerDependencies: - ocaml " >= 4.2.3000" + ocaml " >= 4.2.3000 < 4.7.0" "@opam/yojson@*": version "1.4.1" @@ -330,7 +330,7 @@ "@opam/zed@ >= 1.2.0": version "1.6.0" - uid "9a4c3157c2db719927f9648234487c6d" + uid e29637bb60b326ac0f0dd7f73e1f90b2 resolved "@opam/zed@1.6.0-9a4c3157c2db719927f9648234487c6d.tgz" dependencies: "@esy-ocaml/esy-installer" "^0.0.0" diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 4e207dc61..ebb20f5d6 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -882,12 +882,14 @@ type let_bindings = { lbs_bindings: Parsetree.value_binding list; lbs_rec: rec_flag; lbs_extension: (attributes * string Asttypes.loc) option; + lbs_bang: Longident.t Asttypes.loc option; lbs_loc: Location.t } -let mklbs ext rf lb loc = +let mklbs bang ext rf lb loc = { lbs_bindings = [lb]; lbs_rec = rf; lbs_extension = ext; + lbs_bang = bang; lbs_loc = loc; } let addlbs lbs lbs' = @@ -895,14 +897,27 @@ let addlbs lbs lbs' = let val_of_let_bindings lbs = let str = Str.value lbs.lbs_rec lbs.lbs_bindings in + if lbs.lbs_bang <> None then + raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "CPS syntax"))); match lbs.lbs_extension with | None -> str | Some ext -> struct_item_extension ext [str] +let monad_of_let_bindings attr lbs body = + match lbs.lbs_bindings with + | [one] -> + Exp.apply (Exp.ident attr) [ + (Nolabel, one.pvb_expr); + (Nolabel, Exp.fun_ Nolabel None one.pvb_pat body) + ] + | _ -> failwith "Only one binding supported just yet" + let expr_of_let_bindings lbs body = (* The location of this expression unfortunately includes the entire rule, * which will include any preceeding extensions. *) - let item_expr = Exp.let_ lbs.lbs_rec lbs.lbs_bindings body in + let item_expr = match lbs.lbs_bang with + | Some attr -> monad_of_let_bindings attr lbs body + | None -> Exp.let_ lbs.lbs_rec lbs.lbs_bindings body in match lbs.lbs_extension with | None -> item_expr | Some ext -> expression_extension ext item_expr @@ -3360,10 +3375,10 @@ let_bindings: let_binding and_let_binding* { addlbs $1 $2 }; let_binding: (* Form with item extension sugar *) - item_attributes LET item_extension_sugar? rec_flag let_binding_body + item_attributes LET let_bang? item_extension_sugar? rec_flag let_binding_body { let loc = mklocation $symbolstartpos $endpos in - let pat, expr = $5 in - mklbs $3 $4 (Vb.mk ~loc ~attrs:$1 pat expr) loc } + let pat, expr = $6 in + mklbs $3 $4 $5 (Vb.mk ~loc ~attrs:$1 pat expr) loc } ; let_binding_body: @@ -4867,6 +4882,10 @@ item_extension_sugar: PERCENT attr_id { ([], $2) } ; +let_bang: + BANG as_loc(val_longident) { $2 } +; + extension: LBRACKETPERCENT attr_id payload RBRACKET { ($2, $3) } ; From a4508ccc8034bf6ff57fb1ca372860742c9f7eed Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Mon, 13 Aug 2018 21:25:02 -0600 Subject: [PATCH 04/23] bang --- src/reason-parser/reason_parser.mly | 14 +++++++++++++- src/reason-parser/reason_pprint_ast.ml | 21 +++++++++++++++++---- 2 files changed, 30 insertions(+), 5 deletions(-) diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index ebb20f5d6..ddc06dcd3 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -258,6 +258,15 @@ let simple_ghost_text_attr ?(loc=dummy_loc ()) txt = let loc = set_loc_state true loc in [({txt; loc}, PStr [])] +(* used for storing stylistic information in the AST *) +(* As if you had written [@refmt "txt"] *) +let simple_ghost_refmt_text_attr ?(loc=dummy_loc ()) txt = + let loc = set_loc_state true loc in + ( + {txt="refmt"; loc}, + PStr [{pstr_desc=Pstr_eval(mkexp ~loc (Pexp_constant(Pconst_string(txt, None))), []); pstr_loc=loc}] + ) + let mkExplicitArityTuplePat ?(loc=dummy_loc ()) pat = (* Tell OCaml type system that what this tuple construction represents is not actually a tuple, and should represent several constructor @@ -906,7 +915,10 @@ let val_of_let_bindings lbs = let monad_of_let_bindings attr lbs body = match lbs.lbs_bindings with | [one] -> - Exp.apply (Exp.ident attr) [ + Exp.apply + ~attrs:[simple_ghost_refmt_text_attr "let_bang"] + ~loc:one.pvb_loc + (Exp.ident attr) [ (Nolabel, one.pvb_expr); (Nolabel, Exp.fun_ Nolabel None one.pvb_pat body) ] diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 75fa7bfc4..dbbd74e7f 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -3813,7 +3813,7 @@ let printer = object(self:'self) let x = self#process_underscore_application x in (* If there are any attributes, render unary like `(~-) x [@ppx]`, and infix like `(+) x y [@attr]` *) - let {arityAttrs; stdAttrs; jsxAttrs; literalAttrs; uncurried} = + let {arityAttrs; stdAttrs; jsxAttrs; refmtAttrs; literalAttrs; uncurried} = Reason_attrs.partitionAttributes ~allowUncurry:(Reason_heuristics.bsExprCanBeUncurried x) x.pexp_attributes in let () = if uncurried then Hashtbl.add uncurriedTable x.pexp_loc true in @@ -3847,6 +3847,8 @@ let printer = object(self:'self) | Some se -> Simple se | None -> match x.pexp_desc with + | Pexp_apply ({pexp_desc=Pexp_ident lid}, [Nolabel, arg; Nolabel, {pexp_desc=Pexp_fun (Nolabel, None, pat, body)}]) when Reason_attrs.hasRefmtTag "let_bang" refmtAttrs -> + Simple (makeLetSequence (self#letList {x with pexp_attributes = refmtAttrs @ x.pexp_attributes})) | Pexp_apply (e, ls) -> ( let ls = List.map (fun (l,expr) -> (l, self#process_underscore_application expr)) ls in match (e, ls) with @@ -5055,7 +5057,8 @@ let printer = object(self:'self) * list containing the location indicating start/end of the "let-item" and * its layout. *) let rec processLetList acc expr = - match (expr.pexp_attributes, expr.pexp_desc) with + let (refmtAttrs, otherAttrs) = Reason_attrs.partition (Reason_attrs.isRefmt ~filter:None) expr.pexp_attributes in + match (otherAttrs, expr.pexp_desc) with | ([], Pexp_let (rf, l, e)) -> (* For "letList" bindings, the start/end isn't as simple as with * module value bindings. For "let lists", the sequences were formed @@ -5065,6 +5068,14 @@ let printer = object(self:'self) let bindingsLoc = self#bindingsLocationRange l in let layout = source_map ~loc:bindingsLoc bindingsLayout in processLetList ((bindingsLoc, layout)::acc) e + | (attrs, Pexp_apply ({pexp_desc=Pexp_ident lid}, [Nolabel, arg; Nolabel, {pexp_desc=Pexp_fun (Nolabel, None, pat, body)}])) when Reason_attrs.hasRefmtTag "let_bang" refmtAttrs -> + (* let!foo x = y; z <-> foo(y, x => z) *) + let binding = Ast_helper.Vb.mk ~loc:expr.pexp_loc pat arg in + let arg = String.concat "." (Longident.flatten lid.txt) in + let bindingsLayout = self#binding ("let!" ^ arg) binding in + let bindingsLoc = self#bindingsLocationRange [binding] in + let layout = source_map ~loc:bindingsLoc bindingsLayout in + processLetList ((bindingsLoc, layout)::acc) body | (attrs, Pexp_open (ovf, lid, e)) (* Add this when check to make sure these are handled as regular "simple expressions" *) when not (self#isSeriesOfOpensFollowedByNonSequencyExpression {expr with pexp_attributes = []}) -> @@ -5104,7 +5115,7 @@ let printer = object(self:'self) * Pexp location is parsed (potentially) beginning with the open * brace {} in the let sequence. *) let layout = source_map ~loc:letModuleLoc letModuleLayout in - let (_, return) = self#curriedFunctorPatternsAndReturnStruct moduleExpr in + let (_, return) = self#curriedFunctorPatternsAndReturnStruct moduleExpr in let loc = { letModuleLoc with loc_end = return.pmod_loc.loc_end @@ -5802,7 +5813,7 @@ let printer = object(self:'self) | _ -> assert false method simplest_expression x = - let {stdAttrs; jsxAttrs} = Reason_attrs.partitionAttributes x.pexp_attributes in + let {stdAttrs; jsxAttrs; refmtAttrs} = Reason_attrs.partitionAttributes x.pexp_attributes in if stdAttrs <> [] then None else @@ -5812,6 +5823,8 @@ let printer = object(self:'self) token will be confused with the match token. *) | Pexp_fun _ when pipe || semi -> Some (self#reset#simplifyUnparseExpr x) | Pexp_function l when pipe || semi -> Some (formatPrecedence ~loc:x.pexp_loc (self#reset#patternFunction x.pexp_loc l)) + | Pexp_apply ({pexp_desc=Pexp_ident _}, [_, {pexp_desc=Pexp_fun (Nolabel, None, _, _)}]) when (Reason_attrs.hasRefmtTag "let_bang" refmtAttrs) -> + Some (makeLetSequence (self#letList x)) | Pexp_apply (e, l) -> ( match self#simple_get_application x with (* If it's the simple form of application. *) From c6623afa41f3a016c1eeebf27cc2689def938f78 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Mon, 13 Aug 2018 21:25:18 -0600 Subject: [PATCH 05/23] why chagen that --- esy.lock | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/esy.lock b/esy.lock index c79345fcc..09dfb3672 100644 --- a/esy.lock +++ b/esy.lock @@ -78,7 +78,7 @@ "@opam/camomile@ >= 0.8.0", "@opam/camomile@ >= 0.8.6", "@opam/camomile@*": version "1.0.1" - uid "05d12e0e70ee18f5e2be40610245a687" + uid f4d58fb782e0362b7848320ac26890de resolved "@opam/camomile@1.0.1-f4d58fb782e0362b7848320ac26890de.tgz" dependencies: "@esy-ocaml/esy-installer" "^0.0.0" @@ -132,7 +132,7 @@ peerDependencies: ocaml " >= 4.2.3000" -"@opam/jbuilder@ >= 1.0.0-beta10", "@opam/jbuilder@ >= 1.0.0-beta14", "@opam/jbuilder@ >= 1.0.0-beta17", "@opam/jbuilder@ >= 1.0.0-beta181", "@opam/jbuilder@ >= 1.0.0-beta7", "@opam/jbuilder@ >= 1.0.0-beta9", "@opam/jbuilder@*": +"@opam/jbuilder@ >= 1.0.0-beta14", "@opam/jbuilder@ >= 1.0.0-beta17", "@opam/jbuilder@ >= 1.0.0-beta181", "@opam/jbuilder@ >= 1.0.0-beta7", "@opam/jbuilder@ >= 1.0.0-beta9", "@opam/jbuilder@*": version "1.0.0-beta20" uid "1648206284a54407f6eee01ed950fff7" resolved "@opam/jbuilder@1.0.0-beta20-1648206284a54407f6eee01ed950fff7.tgz" @@ -145,7 +145,7 @@ "@opam/lambda-term@ >= 1.2.0": version "1.12.0" - uid "0e01b94d401fbc91afe9dfbe283e8daa" + uid "318456db287041f877e89e7098a12312" resolved "@opam/lambda-term@1.12.0-318456db287041f877e89e7098a12312.tgz" dependencies: "@esy-ocaml/esy-installer" "^0.0.0" @@ -161,7 +161,7 @@ "@opam/lwt@ >= 2.7.0 < 4.0.0", "@opam/lwt@ >= 3.0.0", "@opam/lwt@*": version "3.3.0" - uid "7a557303c8bfd71515f716b5429733b0" + uid d6527433462fadf2f1b8168dbb5cf10e resolved "@opam/lwt@3.3.0-d6527433462fadf2f1b8168dbb5cf10e.tgz" dependencies: "@esy-ocaml/esy-installer" "^0.0.0" @@ -177,12 +177,12 @@ "@opam/lwt_react@*": version "1.1.1" - uid aa9053f8fd0e2684a474b8dbcc0a30d6 + uid "50615b081ab21218a614fa9792562c69" resolved "@opam/lwt_react@1.1.1-aa9053f8fd0e2684a474b8dbcc0a30d6.tgz" dependencies: "@esy-ocaml/esy-installer" "^0.0.0" "@esy-ocaml/substs" "^0.0.1" - "@opam/jbuilder" " >= 1.0.0-beta14" + "@opam/jbuilder" " >= 1.0.0-beta10" "@opam/lwt" " >= 3.0.0" "@opam/react" " >= 1.0.0" peerDependencies: @@ -214,7 +214,7 @@ "@opam/ocaml-migrate-parsetree@ >= 1.0.7", "@opam/ocaml-migrate-parsetree@*": version "1.0.10" - uid f2453b30ff54c7634f7c771fdc71e968 + uid "48723a85ec73e8dc29f6f8710d1178a4" resolved "@opam/ocaml-migrate-parsetree@1.0.10-48723a85ec73e8dc29f6f8710d1178a4.tgz" dependencies: "@esy-ocaml/esy-installer" "^0.0.0" @@ -296,7 +296,7 @@ "@opam/utop@ >= 1.17.0": version "2.1.0" - uid "54c199bb75970aa22652d5456e02ff58" + uid "52ddf36354cf7530843a68ffd29ed6ac" resolved "@opam/utop@2.1.0-52ddf36354cf7530843a68ffd29ed6ac.tgz" dependencies: "@esy-ocaml/esy-installer" "^0.0.0" @@ -312,7 +312,7 @@ "@opam/ocamlfind" " >= 1.7.2" "@opam/react" " >= 1.0.0" peerDependencies: - ocaml " >= 4.2.3000 < 4.7.0" + ocaml " >= 4.2.3000" "@opam/yojson@*": version "1.4.1" @@ -330,7 +330,7 @@ "@opam/zed@ >= 1.2.0": version "1.6.0" - uid e29637bb60b326ac0f0dd7f73e1f90b2 + uid "9a4c3157c2db719927f9648234487c6d" resolved "@opam/zed@1.6.0-9a4c3157c2db719927f9648234487c6d.tgz" dependencies: "@esy-ocaml/esy-installer" "^0.0.0" From de976979f7708636a24640a74bc6645088d3a4a5 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Mon, 13 Aug 2018 21:33:38 -0600 Subject: [PATCH 06/23] better error message for toplevel --- src/reason-parser/reason_attrs.ml | 2 ++ src/reason-parser/reason_parser.mly | 4 ++-- src/reason-parser/reason_pprint_ast.ml | 6 +++--- 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/reason-parser/reason_attrs.ml b/src/reason-parser/reason_attrs.ml index e4fbee92c..0c6a6fc2c 100644 --- a/src/reason-parser/reason_attrs.ml +++ b/src/reason-parser/reason_attrs.ml @@ -17,6 +17,8 @@ module T = struct end open T +let letBangTag = "let_bang" + let isRefmtTag tag attr = match attr with | ( diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index ddc06dcd3..1be0bf13e 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -907,7 +907,7 @@ let addlbs lbs lbs' = let val_of_let_bindings lbs = let str = Str.value lbs.lbs_rec lbs.lbs_bindings in if lbs.lbs_bang <> None then - raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "CPS syntax"))); + raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let!foo is not allowed at the top level"))); match lbs.lbs_extension with | None -> str | Some ext -> struct_item_extension ext [str] @@ -916,7 +916,7 @@ let monad_of_let_bindings attr lbs body = match lbs.lbs_bindings with | [one] -> Exp.apply - ~attrs:[simple_ghost_refmt_text_attr "let_bang"] + ~attrs:[simple_ghost_refmt_text_attr Reason_attrs.letBangTag] ~loc:one.pvb_loc (Exp.ident attr) [ (Nolabel, one.pvb_expr); diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index dbbd74e7f..1fde42b97 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -3847,7 +3847,7 @@ let printer = object(self:'self) | Some se -> Simple se | None -> match x.pexp_desc with - | Pexp_apply ({pexp_desc=Pexp_ident lid}, [Nolabel, arg; Nolabel, {pexp_desc=Pexp_fun (Nolabel, None, pat, body)}]) when Reason_attrs.hasRefmtTag "let_bang" refmtAttrs -> + | Pexp_apply ({pexp_desc=Pexp_ident lid}, [Nolabel, arg; Nolabel, {pexp_desc=Pexp_fun (Nolabel, None, pat, body)}]) when Reason_attrs.hasRefmtTag Reason_attrs.letBangTag refmtAttrs -> Simple (makeLetSequence (self#letList {x with pexp_attributes = refmtAttrs @ x.pexp_attributes})) | Pexp_apply (e, ls) -> ( let ls = List.map (fun (l,expr) -> (l, self#process_underscore_application expr)) ls in @@ -5068,7 +5068,7 @@ let printer = object(self:'self) let bindingsLoc = self#bindingsLocationRange l in let layout = source_map ~loc:bindingsLoc bindingsLayout in processLetList ((bindingsLoc, layout)::acc) e - | (attrs, Pexp_apply ({pexp_desc=Pexp_ident lid}, [Nolabel, arg; Nolabel, {pexp_desc=Pexp_fun (Nolabel, None, pat, body)}])) when Reason_attrs.hasRefmtTag "let_bang" refmtAttrs -> + | (attrs, Pexp_apply ({pexp_desc=Pexp_ident lid}, [Nolabel, arg; Nolabel, {pexp_desc=Pexp_fun (Nolabel, None, pat, body)}])) when Reason_attrs.hasRefmtTag Reason_attrs.letBangTag refmtAttrs -> (* let!foo x = y; z <-> foo(y, x => z) *) let binding = Ast_helper.Vb.mk ~loc:expr.pexp_loc pat arg in let arg = String.concat "." (Longident.flatten lid.txt) in @@ -5823,7 +5823,7 @@ let printer = object(self:'self) token will be confused with the match token. *) | Pexp_fun _ when pipe || semi -> Some (self#reset#simplifyUnparseExpr x) | Pexp_function l when pipe || semi -> Some (formatPrecedence ~loc:x.pexp_loc (self#reset#patternFunction x.pexp_loc l)) - | Pexp_apply ({pexp_desc=Pexp_ident _}, [_, {pexp_desc=Pexp_fun (Nolabel, None, _, _)}]) when (Reason_attrs.hasRefmtTag "let_bang" refmtAttrs) -> + | Pexp_apply ({pexp_desc=Pexp_ident _}, [_, {pexp_desc=Pexp_fun (Nolabel, None, _, _)}]) when (Reason_attrs.hasRefmtTag Reason_attrs.letBangTag refmtAttrs) -> Some (makeLetSequence (self#letList x)) | Pexp_apply (e, l) -> ( match self#simple_get_application x with From 2a45863545a36f5d8051bf99962d2d281af86dd5 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Tue, 14 Aug 2018 01:48:57 -0600 Subject: [PATCH 07/23] add multi handling --- src/reason-parser/reason_attrs.ml | 3 ++- src/reason-parser/reason_parser.mly | 28 ++++++++++++++++----- src/reason-parser/reason_pprint_ast.ml | 34 ++++++++++++++++++++------ 3 files changed, 51 insertions(+), 14 deletions(-) diff --git a/src/reason-parser/reason_attrs.ml b/src/reason-parser/reason_attrs.ml index 0c6a6fc2c..fe8749ae1 100644 --- a/src/reason-parser/reason_attrs.ml +++ b/src/reason-parser/reason_attrs.ml @@ -17,7 +17,8 @@ module T = struct end open T -let letBangTag = "let_bang" +let letCPSTag = "let_continuation_passing_style" +let letCPSMulti = "let_continuation_passing_style_multi" let isRefmtTag tag attr = match attr with diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 1be0bf13e..386571fb0 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -912,23 +912,39 @@ let val_of_let_bindings lbs = | None -> str | Some ext -> struct_item_extension ext [str] -let monad_of_let_bindings attr lbs body = +let continuation_passing_style_of_let_bindings attr lbs body = match lbs.lbs_bindings with | [one] -> Exp.apply - ~attrs:[simple_ghost_refmt_text_attr Reason_attrs.letBangTag] + ~attrs:[simple_ghost_refmt_text_attr Reason_attrs.letCPSTag] ~loc:one.pvb_loc - (Exp.ident attr) [ + (Exp.ident ~loc:attr.loc attr) [ (Nolabel, one.pvb_expr); - (Nolabel, Exp.fun_ Nolabel None one.pvb_pat body) + (Nolabel, Exp.fun_ ~loc:attr.loc Nolabel None one.pvb_pat body) ] - | _ -> failwith "Only one binding supported just yet" + | _ -> + let (exprs, pats) = lbs.lbs_bindings + |> List.map (fun binding -> (binding.pvb_expr, binding.pvb_pat)) + |> List.split in + let expr = Ast_helper.Exp.tuple ~loc:lbs.lbs_loc exprs in + let pat = Ast_helper.Pat.tuple ~loc:lbs.lbs_loc pats in + Exp.apply + ~attrs:[ + simple_ghost_refmt_text_attr Reason_attrs.letCPSTag; + simple_ghost_refmt_text_attr Reason_attrs.letCPSMulti + ] + ~loc:lbs.lbs_loc + (Exp.ident ~loc:attr.loc attr) [ + (Nolabel, expr); + (Nolabel, Exp.fun_ ~loc:attr.loc Nolabel None pat body) + ] + let expr_of_let_bindings lbs body = (* The location of this expression unfortunately includes the entire rule, * which will include any preceeding extensions. *) let item_expr = match lbs.lbs_bang with - | Some attr -> monad_of_let_bindings attr lbs body + | Some attr -> continuation_passing_style_of_let_bindings attr lbs body | None -> Exp.let_ lbs.lbs_rec lbs.lbs_bindings body in match lbs.lbs_extension with | None -> item_expr diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 1fde42b97..77d993303 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -3847,7 +3847,7 @@ let printer = object(self:'self) | Some se -> Simple se | None -> match x.pexp_desc with - | Pexp_apply ({pexp_desc=Pexp_ident lid}, [Nolabel, arg; Nolabel, {pexp_desc=Pexp_fun (Nolabel, None, pat, body)}]) when Reason_attrs.hasRefmtTag Reason_attrs.letBangTag refmtAttrs -> + | Pexp_apply ({pexp_desc=Pexp_ident lid}, [Nolabel, arg; Nolabel, {pexp_desc=Pexp_fun (Nolabel, None, pat, body)}]) when Reason_attrs.hasRefmtTag Reason_attrs.letCPSTag refmtAttrs -> Simple (makeLetSequence (self#letList {x with pexp_attributes = refmtAttrs @ x.pexp_attributes})) | Pexp_apply (e, ls) -> ( let ls = List.map (fun (l,expr) -> (l, self#process_underscore_application expr)) ls in @@ -5068,12 +5068,32 @@ let printer = object(self:'self) let bindingsLoc = self#bindingsLocationRange l in let layout = source_map ~loc:bindingsLoc bindingsLayout in processLetList ((bindingsLoc, layout)::acc) e - | (attrs, Pexp_apply ({pexp_desc=Pexp_ident lid}, [Nolabel, arg; Nolabel, {pexp_desc=Pexp_fun (Nolabel, None, pat, body)}])) when Reason_attrs.hasRefmtTag Reason_attrs.letBangTag refmtAttrs -> + | (attrs, Pexp_apply ({pexp_desc=Pexp_ident lid}, [Nolabel, arg; Nolabel, {pexp_desc=Pexp_fun (Nolabel, None, pat, body)}])) when Reason_attrs.hasRefmtTag Reason_attrs.letCPSTag refmtAttrs -> (* let!foo x = y; z <-> foo(y, x => z) *) - let binding = Ast_helper.Vb.mk ~loc:expr.pexp_loc pat arg in - let arg = String.concat "." (Longident.flatten lid.txt) in - let bindingsLayout = self#binding ("let!" ^ arg) binding in - let bindingsLoc = self#bindingsLocationRange [binding] in + let fnIdent = String.concat "." (Longident.flatten lid.txt) in + let (bindings, bindingsLayout) = match (Reason_attrs.hasRefmtTag Reason_attrs.letCPSMulti refmtAttrs, arg, pat) with + | (true, {pexp_desc=Pexp_tuple exprs}, {ppat_desc=Ppat_tuple pats}) -> + (* when List.length exprs = List.length pats -> *) + let pairs = List.combine exprs pats + |> List.map (fun (exp, pat) -> Ast_helper.Vb.mk ~loc:expr.pexp_loc pat exp) in + begin + match pairs with + | [] -> assert(false) + | first::rest -> + let first = self#binding ("let!" ^ fnIdent) first in + (pairs,makeList + ~postSpace:true + ~break:Always + ~indent:0 + ~inline:(true, true) + (first :: List.map (self#binding "and") rest)) + end + | _ -> + let binding = Ast_helper.Vb.mk ~loc:expr.pexp_loc pat arg in + let bindingsLayout = self#binding ("let!" ^ fnIdent) binding in + ([binding], bindingsLayout) + in + let bindingsLoc = self#bindingsLocationRange bindings in let layout = source_map ~loc:bindingsLoc bindingsLayout in processLetList ((bindingsLoc, layout)::acc) body | (attrs, Pexp_open (ovf, lid, e)) @@ -5823,7 +5843,7 @@ let printer = object(self:'self) token will be confused with the match token. *) | Pexp_fun _ when pipe || semi -> Some (self#reset#simplifyUnparseExpr x) | Pexp_function l when pipe || semi -> Some (formatPrecedence ~loc:x.pexp_loc (self#reset#patternFunction x.pexp_loc l)) - | Pexp_apply ({pexp_desc=Pexp_ident _}, [_, {pexp_desc=Pexp_fun (Nolabel, None, _, _)}]) when (Reason_attrs.hasRefmtTag Reason_attrs.letBangTag refmtAttrs) -> + | Pexp_apply ({pexp_desc=Pexp_ident _}, [_, {pexp_desc=Pexp_fun (Nolabel, None, _, _)}]) when (Reason_attrs.hasRefmtTag Reason_attrs.letCPSTag refmtAttrs) -> Some (makeLetSequence (self#letList x)) | Pexp_apply (e, l) -> ( match self#simple_get_application x with From 07e9813548889da9b24031b38e16c63c40dcdb8e Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Tue, 14 Aug 2018 01:54:54 -0600 Subject: [PATCH 08/23] add a test --- .../expected_output/sequences.re | 19 +++++++++++++++++++ .../typeCheckedTests/input/sequences.re | 18 ++++++++++++++++++ 2 files changed, 37 insertions(+) diff --git a/formatTest/typeCheckedTests/expected_output/sequences.re b/formatTest/typeCheckedTests/expected_output/sequences.re index 831e4c1f0..9072d0222 100644 --- a/formatTest/typeCheckedTests/expected_output/sequences.re +++ b/formatTest/typeCheckedTests/expected_output/sequences.re @@ -75,3 +75,22 @@ let singlePunAcceptedIfExtended = { ...firstFieldPunned, a, }; + +let opt = (value, fn) => + switch (value) { + | None => None + | Some(x) => fn(x) + }; + +let opt2 = (values, fn) => + switch (values) { + | (Some(a), Some(b)) => fn((a, b)) + | _ => None + }; + +let _ = { + let!opt x = Some(10); + let!opt2 a = Some(2) + and b = Some(5); + Some(a + x * b); +}; diff --git a/formatTest/typeCheckedTests/input/sequences.re b/formatTest/typeCheckedTests/input/sequences.re index 151ec035f..6da9b0fa1 100644 --- a/formatTest/typeCheckedTests/input/sequences.re +++ b/formatTest/typeCheckedTests/input/sequences.re @@ -79,3 +79,21 @@ let thirdFieldPunned = { c }; let singlePunAcceptedIfExtended = {...firstFieldPunned, a}; + + +let opt = (value, fn) => switch value { + | None => None + | Some(x) => fn(x) +}; + +let opt2 = (values, fn) => switch values { + | (Some(a), Some(b)) => fn((a, b)) + | _ => None +}; + +let _ = { + let!opt x = Some(10); + let!opt2 a = Some(2) + and b = Some(5); + Some(a + x * b) +}; \ No newline at end of file From c729dfd6faf9066e219056930795d800cc650d52 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Tue, 14 Aug 2018 21:54:19 -0600 Subject: [PATCH 09/23] feedbacks --- .../expected_output/sequences.re | 13 ++----- .../typeCheckedTests/input/sequences.re | 12 ++---- src/reason-parser/reason_attrs.ml | 4 +- src/reason-parser/reason_parser.mly | 37 ++++++++----------- src/reason-parser/reason_pprint_ast.ml | 2 +- 5 files changed, 26 insertions(+), 42 deletions(-) diff --git a/formatTest/typeCheckedTests/expected_output/sequences.re b/formatTest/typeCheckedTests/expected_output/sequences.re index 9072d0222..c1872d1a6 100644 --- a/formatTest/typeCheckedTests/expected_output/sequences.re +++ b/formatTest/typeCheckedTests/expected_output/sequences.re @@ -82,15 +82,10 @@ let opt = (value, fn) => | Some(x) => fn(x) }; -let opt2 = (values, fn) => - switch (values) { - | (Some(a), Some(b)) => fn((a, b)) - | _ => None - }; - let _ = { let!opt x = Some(10); - let!opt2 a = Some(2) - and b = Some(5); - Some(a + x * b); + let!opt a = Some(2); + print_endline(string_of_int(a)); + + Some(a + x); }; diff --git a/formatTest/typeCheckedTests/input/sequences.re b/formatTest/typeCheckedTests/input/sequences.re index 6da9b0fa1..e0a262f75 100644 --- a/formatTest/typeCheckedTests/input/sequences.re +++ b/formatTest/typeCheckedTests/input/sequences.re @@ -86,14 +86,10 @@ let opt = (value, fn) => switch value { | Some(x) => fn(x) }; -let opt2 = (values, fn) => switch values { - | (Some(a), Some(b)) => fn((a, b)) - | _ => None -}; - let _ = { let!opt x = Some(10); - let!opt2 a = Some(2) - and b = Some(5); - Some(a + x * b) + let!opt a = Some(2); + print_endline(string_of_int(a)); + + Some(a + x); }; \ No newline at end of file diff --git a/src/reason-parser/reason_attrs.ml b/src/reason-parser/reason_attrs.ml index fe8749ae1..a8be787ee 100644 --- a/src/reason-parser/reason_attrs.ml +++ b/src/reason-parser/reason_attrs.ml @@ -15,7 +15,6 @@ module T = struct uncurried : bool } end -open T let letCPSTag = "let_continuation_passing_style" let letCPSMulti = "let_continuation_passing_style_multi" @@ -45,7 +44,8 @@ let isRefmtExplicitBraces = isRefmt ~filter:(Some "explicitBraces") let isRefmtInlineOpen = isRefmt ~filter:(Some "inlineOpen") (** Partition attributes into kinds *) -let rec partitionAttributes ?(partDoc=false) ?(allowUncurry=true) attrs : attributesPartition = +let rec partitionAttributes ?(partDoc=false) ?(allowUncurry=true) attrs : T.attributesPartition = + let open T in match attrs with | [] -> {arityAttrs=[]; docAttrs=[]; stdAttrs=[]; jsxAttrs=[]; refmtAttrs=[]; literalAttrs=[]; uncurried = false} diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 386571fb0..fb39331d5 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -923,36 +923,29 @@ let continuation_passing_style_of_let_bindings attr lbs body = (Nolabel, Exp.fun_ ~loc:attr.loc Nolabel None one.pvb_pat body) ] | _ -> - let (exprs, pats) = lbs.lbs_bindings - |> List.map (fun binding -> (binding.pvb_expr, binding.pvb_pat)) - |> List.split in - let expr = Ast_helper.Exp.tuple ~loc:lbs.lbs_loc exprs in - let pat = Ast_helper.Pat.tuple ~loc:lbs.lbs_loc pats in - Exp.apply - ~attrs:[ - simple_ghost_refmt_text_attr Reason_attrs.letCPSTag; - simple_ghost_refmt_text_attr Reason_attrs.letCPSMulti - ] - ~loc:lbs.lbs_loc - (Exp.ident ~loc:attr.loc attr) [ - (Nolabel, expr); - (Nolabel, Exp.fun_ ~loc:attr.loc Nolabel None pat body) - ] - + raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "Cannot have `and` in a `let!foo` construct."))) let expr_of_let_bindings lbs body = (* The location of this expression unfortunately includes the entire rule, * which will include any preceeding extensions. *) - let item_expr = match lbs.lbs_bang with - | Some attr -> continuation_passing_style_of_let_bindings attr lbs body - | None -> Exp.let_ lbs.lbs_rec lbs.lbs_bindings body in - match lbs.lbs_extension with - | None -> item_expr - | Some ext -> expression_extension ext item_expr + match lbs.lbs_bang with + | Some attr -> + if lbs.lbs_extension <> None then + raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let!foo cannot be combined with let%foo"))); + continuation_passing_style_of_let_bindings attr lbs body + | None -> + let item_expr = Exp.let_ lbs.lbs_rec lbs.lbs_bindings body in + begin + match lbs.lbs_extension with + | None -> item_expr + | Some ext -> expression_extension ext item_expr + end let class_of_let_bindings lbs body = if lbs.lbs_extension <> None then raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "extension"))); + if lbs.lbs_bang <> None then + raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let!foo is not allowed in class bindings"))); Cl.let_ lbs.lbs_rec lbs.lbs_bindings body (* diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 77d993303..c776b28e5 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -5075,7 +5075,7 @@ let printer = object(self:'self) | (true, {pexp_desc=Pexp_tuple exprs}, {ppat_desc=Ppat_tuple pats}) -> (* when List.length exprs = List.length pats -> *) let pairs = List.combine exprs pats - |> List.map (fun (exp, pat) -> Ast_helper.Vb.mk ~loc:expr.pexp_loc pat exp) in + |> List.map (fun (exp, pat) -> Ast_helper.Vb.mk ~loc:exp.pexp_loc pat exp) in begin match pairs with | [] -> assert(false) From 42a638290eade8244e222fc128da8b5bb1b1a2e6 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Tue, 14 Aug 2018 21:57:53 -0600 Subject: [PATCH 10/23] cleanup, and test interleaving --- .../expected_output/sequences.re | 1 + .../typeCheckedTests/input/sequences.re | 1 + src/reason-parser/reason_attrs.ml | 1 - src/reason-parser/reason_pprint_ast.ml | 25 +++---------------- 4 files changed, 5 insertions(+), 23 deletions(-) diff --git a/formatTest/typeCheckedTests/expected_output/sequences.re b/formatTest/typeCheckedTests/expected_output/sequences.re index c1872d1a6..76d3bbb00 100644 --- a/formatTest/typeCheckedTests/expected_output/sequences.re +++ b/formatTest/typeCheckedTests/expected_output/sequences.re @@ -84,6 +84,7 @@ let opt = (value, fn) => let _ = { let!opt x = Some(10); + let!opt a = Some(2); print_endline(string_of_int(a)); diff --git a/formatTest/typeCheckedTests/input/sequences.re b/formatTest/typeCheckedTests/input/sequences.re index e0a262f75..6c63d05df 100644 --- a/formatTest/typeCheckedTests/input/sequences.re +++ b/formatTest/typeCheckedTests/input/sequences.re @@ -88,6 +88,7 @@ let opt = (value, fn) => switch value { let _ = { let!opt x = Some(10); + let!opt a = Some(2); print_endline(string_of_int(a)); diff --git a/src/reason-parser/reason_attrs.ml b/src/reason-parser/reason_attrs.ml index a8be787ee..6fdf1d42a 100644 --- a/src/reason-parser/reason_attrs.ml +++ b/src/reason-parser/reason_attrs.ml @@ -17,7 +17,6 @@ module T = struct end let letCPSTag = "let_continuation_passing_style" -let letCPSMulti = "let_continuation_passing_style_multi" let isRefmtTag tag attr = match attr with diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index c776b28e5..27971731d 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -5071,28 +5071,9 @@ let printer = object(self:'self) | (attrs, Pexp_apply ({pexp_desc=Pexp_ident lid}, [Nolabel, arg; Nolabel, {pexp_desc=Pexp_fun (Nolabel, None, pat, body)}])) when Reason_attrs.hasRefmtTag Reason_attrs.letCPSTag refmtAttrs -> (* let!foo x = y; z <-> foo(y, x => z) *) let fnIdent = String.concat "." (Longident.flatten lid.txt) in - let (bindings, bindingsLayout) = match (Reason_attrs.hasRefmtTag Reason_attrs.letCPSMulti refmtAttrs, arg, pat) with - | (true, {pexp_desc=Pexp_tuple exprs}, {ppat_desc=Ppat_tuple pats}) -> - (* when List.length exprs = List.length pats -> *) - let pairs = List.combine exprs pats - |> List.map (fun (exp, pat) -> Ast_helper.Vb.mk ~loc:exp.pexp_loc pat exp) in - begin - match pairs with - | [] -> assert(false) - | first::rest -> - let first = self#binding ("let!" ^ fnIdent) first in - (pairs,makeList - ~postSpace:true - ~break:Always - ~indent:0 - ~inline:(true, true) - (first :: List.map (self#binding "and") rest)) - end - | _ -> - let binding = Ast_helper.Vb.mk ~loc:expr.pexp_loc pat arg in - let bindingsLayout = self#binding ("let!" ^ fnIdent) binding in - ([binding], bindingsLayout) - in + let binding = Ast_helper.Vb.mk ~loc:arg.pexp_loc pat arg in + let bindingsLayout = self#binding ("let!" ^ fnIdent) binding in + let bindings = [binding] in let bindingsLoc = self#bindingsLocationRange bindings in let layout = source_map ~loc:bindingsLoc bindingsLayout in processLetList ((bindingsLoc, layout)::acc) body From 1b82a6c02f57da48a28c237391a9709e8e184fba Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 16 Aug 2018 19:32:24 -0500 Subject: [PATCH 11/23] Use a pair of (bind, pair) --- .../expected_output/sequences.re | 48 ++++++-- .../typeCheckedTests/input/sequences.re | 30 ++++- src/reason-parser/reason_attrs.ml | 1 + src/reason-parser/reason_parser.mly | 106 +++++++++++++++--- 4 files changed, 156 insertions(+), 29 deletions(-) diff --git a/formatTest/typeCheckedTests/expected_output/sequences.re b/formatTest/typeCheckedTests/expected_output/sequences.re index 76d3bbb00..6f74aed41 100644 --- a/formatTest/typeCheckedTests/expected_output/sequences.re +++ b/formatTest/typeCheckedTests/expected_output/sequences.re @@ -76,17 +76,43 @@ let singlePunAcceptedIfExtended = { a, }; -let opt = (value, fn) => - switch (value) { - | None => None - | Some(x) => fn(x) - }; +module Option = { + let map = (x, f) => + switch (x) { + | Some(x) => Some(f(x)) + | None => None + }; -let _ = { - let!opt x = Some(10); + let flatMap = (x, f) => + switch (x) { + | Some(x) => f(x) + | None => None + }; - let!opt a = Some(2); - print_endline(string_of_int(a)); - - Some(a + x); + let pair = (x, y) => + switch (x, y) { + | (Some(x), Some(y)) => Some((x, y)) + | _ => None + }; }; + +let opt = (Option.flatMap, Option.pair); +let opt_map = (Option.map, Option.pair); + +let _ = + (Pervasives.fst(opt))(Some(10), x => + (Pervasives.fst(opt_map))( + (Pervasives.snd(opt_map))( + (Pervasives.snd(opt_map))( + Some(2), + Some(5), + ), + Some(7), + ), + (((a, b), c)) => { + print_endline(string_of_int(a)); + + a + x * b + c; + }, + ) + ); diff --git a/formatTest/typeCheckedTests/input/sequences.re b/formatTest/typeCheckedTests/input/sequences.re index 6c63d05df..9c414c99d 100644 --- a/formatTest/typeCheckedTests/input/sequences.re +++ b/formatTest/typeCheckedTests/input/sequences.re @@ -81,16 +81,36 @@ let thirdFieldPunned = { let singlePunAcceptedIfExtended = {...firstFieldPunned, a}; -let opt = (value, fn) => switch value { - | None => None - | Some(x) => fn(x) +module Option = { + let map = (x, f) => + switch (x) { + | Some(x) => Some(f(x)) + | None => None + }; + + let flatMap = (x, f) => + switch (x) { + | Some(x) => f(x) + | None => None + }; + + let pair = (x, y) => + switch (x, y) { + | (Some(x), Some(y)) => Some((x, y)) + | _ => None + }; }; +let opt = (Option.flatMap, Option.pair); +let opt_map = (Option.map, Option.pair); + let _ = { let!opt x = Some(10); - let!opt a = Some(2); + let!opt_map a = Some(2) + and b = Some(5) + and c = Some(7); print_endline(string_of_int(a)); - Some(a + x); + a + x * b + c; }; \ No newline at end of file diff --git a/src/reason-parser/reason_attrs.ml b/src/reason-parser/reason_attrs.ml index 6fdf1d42a..a8be787ee 100644 --- a/src/reason-parser/reason_attrs.ml +++ b/src/reason-parser/reason_attrs.ml @@ -17,6 +17,7 @@ module T = struct end let letCPSTag = "let_continuation_passing_style" +let letCPSMulti = "let_continuation_passing_style_multi" let isRefmtTag tag attr = match attr with diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index fb39331d5..be0aeb7a9 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -912,18 +912,98 @@ let val_of_let_bindings lbs = | None -> str | Some ext -> struct_item_extension ext [str] -let continuation_passing_style_of_let_bindings attr lbs body = - match lbs.lbs_bindings with - | [one] -> - Exp.apply - ~attrs:[simple_ghost_refmt_text_attr Reason_attrs.letCPSTag] - ~loc:one.pvb_loc - (Exp.ident ~loc:attr.loc attr) [ - (Nolabel, one.pvb_expr); - (Nolabel, Exp.fun_ ~loc:attr.loc Nolabel None one.pvb_pat body) - ] - | _ -> - raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "Cannot have `and` in a `let!foo` construct."))) +(* Transforms + + let!foo x = a + and y = b; + rest_of_code + + into + + fst(foo)(snd(foo)(a, b), (x, y) => rest_of_code); + + a much easier-to-red verison is with: + + let func = fst(foo) + and pair = snd(foo) + + then, the transformation is to: + + func(pair(a, b), (x, y) => rest_of_code); + + foo is the "combinator." It is a pair of two functions: + + - fst(foo) is a monadic bind or functor map operation, like Option.map, + Promise.then, etc. It applies a continuation (rest_of_code) to some value, + which is unwrapped from an option, promise, etc. fst(foo) corresponds to + let. + - snd(foo) is a pairing operation, which takes two values, and wraps them in + an option, promise, etc. snd(foo) corresponds to and, and a nested call to + snd(foo) is generated for each and. *) +let combinator_call_of_let_bindings combinator let_bindings rest_of_code = + let combinator_loc = combinator.loc in + let combinator = Exp.ident ~loc:combinator_loc combinator in + let func = + let fst = + Exp.ident + ~loc:combinator_loc + (mkloc (parse "Pervasives.fst") combinator_loc) + in + Exp.apply ~loc:combinator_loc fst [(Nolabel, combinator)] in + let pair and_binding = + let snd = + Exp.ident + ~loc:and_binding.pvb_loc + (mkloc (parse "Pervasives.snd") combinator_loc) + in + Exp.apply ~loc:and_binding.pvb_loc snd [(Nolabel, combinator)] + in + + match let_bindings.lbs_bindings with + | [] -> + assert false + + | let_binding::and_bindings -> + let grow_pair (nested_pair_pattern, pairing_expression) and_binding = + let nested_pair_pattern = + Pat.tuple + ~loc:and_binding.pvb_pat.ppat_loc + [nested_pair_pattern; and_binding.pvb_pat] + in + let pairing_expression = + Exp.apply + ~loc:and_binding.pvb_loc + (pair and_binding) + [(Nolabel, pairing_expression); (Nolabel, and_binding.pvb_expr)] + in + (nested_pair_pattern, pairing_expression) + in + + let let_pattern = let_binding.pvb_pat in + let let_expression = let_binding.pvb_expr in + + let (nested_pair_pattern, pairing_expression) = + List.fold_left grow_pair (let_pattern, let_expression) and_bindings in + + let continuation = + Exp.fun_ + ~loc:combinator_loc Nolabel None nested_pair_pattern rest_of_code + in + + let attrs = + match and_bindings with + | [] -> + [simple_ghost_refmt_text_attr Reason_attrs.letCPSTag] + | _::_ -> + [simple_ghost_refmt_text_attr Reason_attrs.letCPSTag; + simple_ghost_refmt_text_attr Reason_attrs.letCPSMulti] + in + + Exp.apply + ~attrs + ~loc:let_bindings.lbs_loc + func + [(Nolabel, pairing_expression); (Nolabel, continuation)] let expr_of_let_bindings lbs body = (* The location of this expression unfortunately includes the entire rule, @@ -932,7 +1012,7 @@ let expr_of_let_bindings lbs body = | Some attr -> if lbs.lbs_extension <> None then raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let!foo cannot be combined with let%foo"))); - continuation_passing_style_of_let_bindings attr lbs body + combinator_call_of_let_bindings attr lbs body | None -> let item_expr = Exp.let_ lbs.lbs_rec lbs.lbs_bindings body in begin From 01c8e05f22afce17a7931df1baf7345d0195fc3b Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 16 Aug 2018 20:21:11 -0500 Subject: [PATCH 12/23] Use modules --- .../expected_output/sequences.re | 22 +++++++++++-------- .../typeCheckedTests/input/sequences.re | 11 ++++++++-- src/reason-parser/reason_parser.mly | 22 ++++++++----------- src/reason-parser/reason_pprint_ast.ml | 13 ----------- 4 files changed, 31 insertions(+), 37 deletions(-) diff --git a/formatTest/typeCheckedTests/expected_output/sequences.re b/formatTest/typeCheckedTests/expected_output/sequences.re index 6f74aed41..7b1300a88 100644 --- a/formatTest/typeCheckedTests/expected_output/sequences.re +++ b/formatTest/typeCheckedTests/expected_output/sequences.re @@ -96,17 +96,21 @@ module Option = { }; }; -let opt = (Option.flatMap, Option.pair); -let opt_map = (Option.map, Option.pair); +module Opt = { + let let_ = Option.flatMap; + let and_ = Option.pair; +}; + +module Opt_map = { + let let_ = Option.map; + let and_ = Option.pair; +}; let _ = - (Pervasives.fst(opt))(Some(10), x => - (Pervasives.fst(opt_map))( - (Pervasives.snd(opt_map))( - (Pervasives.snd(opt_map))( - Some(2), - Some(5), - ), + Opt.let_(Some(10), x => + Opt_map.let_( + Opt_map.and_( + Opt_map.and_(Some(2), Some(5)), Some(7), ), (((a, b), c)) => { diff --git a/formatTest/typeCheckedTests/input/sequences.re b/formatTest/typeCheckedTests/input/sequences.re index 9c414c99d..b7994de5f 100644 --- a/formatTest/typeCheckedTests/input/sequences.re +++ b/formatTest/typeCheckedTests/input/sequences.re @@ -101,8 +101,15 @@ module Option = { }; }; -let opt = (Option.flatMap, Option.pair); -let opt_map = (Option.map, Option.pair); +module Opt = { + let let_ = Option.flatMap; + let and_ = Option.pair; +}; + +module Opt_map = { + let let_ = Option.map; + let and_ = Option.pair; +}; let _ = { let!opt x = Some(10); diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index be0aeb7a9..92074c861 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -942,21 +942,17 @@ let val_of_let_bindings lbs = snd(foo) is generated for each and. *) let combinator_call_of_let_bindings combinator let_bindings rest_of_code = let combinator_loc = combinator.loc in - let combinator = Exp.ident ~loc:combinator_loc combinator in + let combinator = + String.capitalize (String.concat "." (flatten combinator.txt)) in let func = - let fst = - Exp.ident - ~loc:combinator_loc - (mkloc (parse "Pervasives.fst") combinator_loc) - in - Exp.apply ~loc:combinator_loc fst [(Nolabel, combinator)] in + Exp.ident + ~loc:combinator_loc + (mkloc (parse (combinator ^ ".let_")) combinator_loc) + in let pair and_binding = - let snd = - Exp.ident - ~loc:and_binding.pvb_loc - (mkloc (parse "Pervasives.snd") combinator_loc) - in - Exp.apply ~loc:and_binding.pvb_loc snd [(Nolabel, combinator)] + Exp.ident + ~loc:and_binding.pvb_loc + (mkloc (parse (combinator ^ ".and_")) and_binding.pvb_loc) in match let_bindings.lbs_bindings with diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 27971731d..97a253780 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -3847,8 +3847,6 @@ let printer = object(self:'self) | Some se -> Simple se | None -> match x.pexp_desc with - | Pexp_apply ({pexp_desc=Pexp_ident lid}, [Nolabel, arg; Nolabel, {pexp_desc=Pexp_fun (Nolabel, None, pat, body)}]) when Reason_attrs.hasRefmtTag Reason_attrs.letCPSTag refmtAttrs -> - Simple (makeLetSequence (self#letList {x with pexp_attributes = refmtAttrs @ x.pexp_attributes})) | Pexp_apply (e, ls) -> ( let ls = List.map (fun (l,expr) -> (l, self#process_underscore_application expr)) ls in match (e, ls) with @@ -5068,15 +5066,6 @@ let printer = object(self:'self) let bindingsLoc = self#bindingsLocationRange l in let layout = source_map ~loc:bindingsLoc bindingsLayout in processLetList ((bindingsLoc, layout)::acc) e - | (attrs, Pexp_apply ({pexp_desc=Pexp_ident lid}, [Nolabel, arg; Nolabel, {pexp_desc=Pexp_fun (Nolabel, None, pat, body)}])) when Reason_attrs.hasRefmtTag Reason_attrs.letCPSTag refmtAttrs -> - (* let!foo x = y; z <-> foo(y, x => z) *) - let fnIdent = String.concat "." (Longident.flatten lid.txt) in - let binding = Ast_helper.Vb.mk ~loc:arg.pexp_loc pat arg in - let bindingsLayout = self#binding ("let!" ^ fnIdent) binding in - let bindings = [binding] in - let bindingsLoc = self#bindingsLocationRange bindings in - let layout = source_map ~loc:bindingsLoc bindingsLayout in - processLetList ((bindingsLoc, layout)::acc) body | (attrs, Pexp_open (ovf, lid, e)) (* Add this when check to make sure these are handled as regular "simple expressions" *) when not (self#isSeriesOfOpensFollowedByNonSequencyExpression {expr with pexp_attributes = []}) -> @@ -5824,8 +5813,6 @@ let printer = object(self:'self) token will be confused with the match token. *) | Pexp_fun _ when pipe || semi -> Some (self#reset#simplifyUnparseExpr x) | Pexp_function l when pipe || semi -> Some (formatPrecedence ~loc:x.pexp_loc (self#reset#patternFunction x.pexp_loc l)) - | Pexp_apply ({pexp_desc=Pexp_ident _}, [_, {pexp_desc=Pexp_fun (Nolabel, None, _, _)}]) when (Reason_attrs.hasRefmtTag Reason_attrs.letCPSTag refmtAttrs) -> - Some (makeLetSequence (self#letList x)) | Pexp_apply (e, l) -> ( match self#simple_get_application x with (* If it's the simple form of application. *) From b7d6d254f68967714df061c8a27fb1c06dd1224c Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 16 Aug 2018 20:34:36 -0500 Subject: [PATCH 13/23] Change ! to . --- .../typeCheckedTests/input/sequences.re | 6 ++--- src/reason-parser/reason_parser.mly | 24 +++++++++---------- 2 files changed, 15 insertions(+), 15 deletions(-) diff --git a/formatTest/typeCheckedTests/input/sequences.re b/formatTest/typeCheckedTests/input/sequences.re index b7994de5f..8eac7fc8c 100644 --- a/formatTest/typeCheckedTests/input/sequences.re +++ b/formatTest/typeCheckedTests/input/sequences.re @@ -112,12 +112,12 @@ module Opt_map = { }; let _ = { - let!opt x = Some(10); + let.opt x = Some(10); - let!opt_map a = Some(2) + let.opt_map a = Some(2) and b = Some(5) and c = Some(7); print_endline(string_of_int(a)); a + x * b + c; -}; \ No newline at end of file +}; diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 92074c861..b3ac707e2 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -891,14 +891,14 @@ type let_bindings = { lbs_bindings: Parsetree.value_binding list; lbs_rec: rec_flag; lbs_extension: (attributes * string Asttypes.loc) option; - lbs_bang: Longident.t Asttypes.loc option; + lbs_combinator: Longident.t Asttypes.loc option; lbs_loc: Location.t } -let mklbs bang ext rf lb loc = +let mklbs combinator ext rf lb loc = { lbs_bindings = [lb]; lbs_rec = rf; lbs_extension = ext; - lbs_bang = bang; + lbs_combinator = combinator; lbs_loc = loc; } let addlbs lbs lbs' = @@ -906,8 +906,8 @@ let addlbs lbs lbs' = let val_of_let_bindings lbs = let str = Str.value lbs.lbs_rec lbs.lbs_bindings in - if lbs.lbs_bang <> None then - raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let!foo is not allowed at the top level"))); + if lbs.lbs_combinator <> None then + raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let.foo is not allowed at the top level"))); match lbs.lbs_extension with | None -> str | Some ext -> struct_item_extension ext [str] @@ -1004,10 +1004,10 @@ let combinator_call_of_let_bindings combinator let_bindings rest_of_code = let expr_of_let_bindings lbs body = (* The location of this expression unfortunately includes the entire rule, * which will include any preceeding extensions. *) - match lbs.lbs_bang with + match lbs.lbs_combinator with | Some attr -> if lbs.lbs_extension <> None then - raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let!foo cannot be combined with let%foo"))); + raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let.foo cannot be combined with let%foo"))); combinator_call_of_let_bindings attr lbs body | None -> let item_expr = Exp.let_ lbs.lbs_rec lbs.lbs_bindings body in @@ -1020,8 +1020,8 @@ let expr_of_let_bindings lbs body = let class_of_let_bindings lbs body = if lbs.lbs_extension <> None then raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "extension"))); - if lbs.lbs_bang <> None then - raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let!foo is not allowed in class bindings"))); + if lbs.lbs_combinator <> None then + raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let.foo is not allowed in class bindings"))); Cl.let_ lbs.lbs_rec lbs.lbs_bindings body (* @@ -3472,7 +3472,7 @@ let_bindings: let_binding and_let_binding* { addlbs $1 $2 }; let_binding: (* Form with item extension sugar *) - item_attributes LET let_bang? item_extension_sugar? rec_flag let_binding_body + item_attributes LET let_combinator? item_extension_sugar? rec_flag let_binding_body { let loc = mklocation $symbolstartpos $endpos in let pat, expr = $6 in mklbs $3 $4 $5 (Vb.mk ~loc ~attrs:$1 pat expr) loc } @@ -4979,8 +4979,8 @@ item_extension_sugar: PERCENT attr_id { ([], $2) } ; -let_bang: - BANG as_loc(val_longident) { $2 } +let_combinator: + DOT as_loc(val_longident) { $2 } ; extension: From 17a6ef06bb70fb5c03838567018ad09a3761324d Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Thu, 16 Aug 2018 23:50:05 -0500 Subject: [PATCH 14/23] Update comment --- src/reason-parser/reason_parser.mly | 25 +++++++------------------ 1 file changed, 7 insertions(+), 18 deletions(-) diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index b3ac707e2..75655aac7 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -914,32 +914,21 @@ let val_of_let_bindings lbs = (* Transforms - let!foo x = a + let.foo x = a and y = b; rest_of_code into - fst(foo)(snd(foo)(a, b), (x, y) => rest_of_code); + Foo.let_(Foo.and_(a, b), (x, y) => rest_of_code); - a much easier-to-red verison is with: + foo is the "combinator." It is a module with two functions: - let func = fst(foo) - and pair = snd(foo) - - then, the transformation is to: - - func(pair(a, b), (x, y) => rest_of_code); - - foo is the "combinator." It is a pair of two functions: - - - fst(foo) is a monadic bind or functor map operation, like Option.map, + - Foo.let_ is a monadic bind or functor map operation, like Option.map, Promise.then, etc. It applies a continuation (rest_of_code) to some value, - which is unwrapped from an option, promise, etc. fst(foo) corresponds to - let. - - snd(foo) is a pairing operation, which takes two values, and wraps them in - an option, promise, etc. snd(foo) corresponds to and, and a nested call to - snd(foo) is generated for each and. *) + which is unwrapped from an option, promise, etc. It is used to replace let. + - Foo.and_ is a pairing operation, which takes two values, and wraps them in + an option, promise, etc. Foo.and_ is used to replace and. *) let combinator_call_of_let_bindings combinator let_bindings rest_of_code = let combinator_loc = combinator.loc in let combinator = From 88d25724502b79b2f9c700283e01057b91c959d0 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Fri, 17 Aug 2018 05:53:52 -0500 Subject: [PATCH 15/23] Require matching annotation on ands --- .../typeCheckedTests/input/sequences.re | 4 +-- src/reason-parser/reason_parser.mly | 36 +++++++++++++++---- 2 files changed, 32 insertions(+), 8 deletions(-) diff --git a/formatTest/typeCheckedTests/input/sequences.re b/formatTest/typeCheckedTests/input/sequences.re index 8eac7fc8c..f79f613f7 100644 --- a/formatTest/typeCheckedTests/input/sequences.re +++ b/formatTest/typeCheckedTests/input/sequences.re @@ -115,8 +115,8 @@ let _ = { let.opt x = Some(10); let.opt_map a = Some(2) - and b = Some(5) - and c = Some(7); + and.opt_map b = Some(5) + and.opt_map c = Some(7); print_endline(string_of_int(a)); a + x * b + c; diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 75655aac7..dc1543efc 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -3452,12 +3452,36 @@ labeled_expr: * error if this is an *expression * let binding. Otherwise, they become * attribute* on the structure item for the "and" binding. *) - item_attributes AND let_binding_body - { let pat, expr = $3 in - Vb.mk ~loc:(mklocation $symbolstartpos $endpos) ~attrs:$1 pat expr } -; - -let_bindings: let_binding and_let_binding* { addlbs $1 $2 }; + item_attributes AND let_combinator? let_binding_body + { let pat, expr = $4 in + let vb = + Vb.mk ~loc:(mklocation $symbolstartpos $endpos) ~attrs:$1 pat expr in + (vb, $3) } +; + +let_bindings: let_binding and_let_binding* + { let let_binding = $1 in + let and_bindings = $2 in + and_bindings |> List.iter (fun (and_binding, and_combinator) -> + match (and_combinator, let_binding.lbs_combinator) with + | (None, None) -> () + | (Some a, Some b) when a.txt = b.txt -> () + | _ -> + let loc = + match and_combinator with + | None -> and_binding.pvb_loc + | Some identifier -> identifier.loc + in + let expected = + match let_binding.lbs_combinator with + | None -> "and" + | Some identifier -> + "and." ^ (String.concat "." (flatten identifier.txt)) + in + let message = "and.foo must match let.foo, " ^ expected in + raise Syntaxerr.(Error (Expecting (loc, message)))); + let and_bindings = fst (List.split and_bindings) in + addlbs let_binding and_bindings }; let_binding: (* Form with item extension sugar *) From 30d02218f6a4fba672aac7968d4e8fc87546d5a4 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sat, 18 Aug 2018 16:33:03 -0500 Subject: [PATCH 16/23] Don't allow module paths in let.foo We allow only let.foo, not let.foo.bar. We can add support for module paths later, if/when users demand it. --- src/reason-parser/reason_parser.mly | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index dc1543efc..03b016c3f 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -891,7 +891,7 @@ type let_bindings = { lbs_bindings: Parsetree.value_binding list; lbs_rec: rec_flag; lbs_extension: (attributes * string Asttypes.loc) option; - lbs_combinator: Longident.t Asttypes.loc option; + lbs_combinator: string Asttypes.loc option; lbs_loc: Location.t } let mklbs combinator ext rf lb loc = @@ -931,8 +931,7 @@ let val_of_let_bindings lbs = an option, promise, etc. Foo.and_ is used to replace and. *) let combinator_call_of_let_bindings combinator let_bindings rest_of_code = let combinator_loc = combinator.loc in - let combinator = - String.capitalize (String.concat "." (flatten combinator.txt)) in + let combinator = String.capitalize combinator.txt in let func = Exp.ident ~loc:combinator_loc @@ -3462,6 +3461,9 @@ labeled_expr: let_bindings: let_binding and_let_binding* { let let_binding = $1 in let and_bindings = $2 in + (* Make sure that the and combinators match the let combinators, i.e. if + there is let.foo, then if there are ands, they must be and.foo as + well. *) and_bindings |> List.iter (fun (and_binding, and_combinator) -> match (and_combinator, let_binding.lbs_combinator) with | (None, None) -> () @@ -3475,8 +3477,7 @@ let_bindings: let_binding and_let_binding* let expected = match let_binding.lbs_combinator with | None -> "and" - | Some identifier -> - "and." ^ (String.concat "." (flatten identifier.txt)) + | Some identifier -> "and." ^ identifier.txt in let message = "and.foo must match let.foo, " ^ expected in raise Syntaxerr.(Error (Expecting (loc, message)))); @@ -4993,7 +4994,7 @@ item_extension_sugar: ; let_combinator: - DOT as_loc(val_longident) { $2 } + DOT as_loc(val_ident) { $2 } ; extension: From 683fc0bcb30af59f3ac218b7a834981c691246ff Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sun, 19 Aug 2018 17:10:50 -0500 Subject: [PATCH 17/23] Pretty-print the let.foo sugar --- .../expected_output/sequences.re | 22 ++--- src/reason-parser/reason_attrs.ml | 4 +- src/reason-parser/reason_parser.mly | 12 +-- src/reason-parser/reason_pprint_ast.ml | 83 +++++++++++++++++++ 4 files changed, 96 insertions(+), 25 deletions(-) diff --git a/formatTest/typeCheckedTests/expected_output/sequences.re b/formatTest/typeCheckedTests/expected_output/sequences.re index 7b1300a88..325265081 100644 --- a/formatTest/typeCheckedTests/expected_output/sequences.re +++ b/formatTest/typeCheckedTests/expected_output/sequences.re @@ -106,17 +106,13 @@ module Opt_map = { let and_ = Option.pair; }; -let _ = - Opt.let_(Some(10), x => - Opt_map.let_( - Opt_map.and_( - Opt_map.and_(Some(2), Some(5)), - Some(7), - ), - (((a, b), c)) => { - print_endline(string_of_int(a)); +let _ = { + let.opt x = Some(10); - a + x * b + c; - }, - ) - ); + let.opt_map a = Some(2) + and.opt_map b = Some(5) + and.opt_map c = Some(7); + print_endline(string_of_int(a)); + + a + x * b + c; +}; diff --git a/src/reason-parser/reason_attrs.ml b/src/reason-parser/reason_attrs.ml index a8be787ee..a1ec8e363 100644 --- a/src/reason-parser/reason_attrs.ml +++ b/src/reason-parser/reason_attrs.ml @@ -16,8 +16,8 @@ module T = struct } end -let letCPSTag = "let_continuation_passing_style" -let letCPSMulti = "let_continuation_passing_style_multi" +let letCombinator = "letCombinator" +let andCombinator = "andCombinator" let isRefmtTag tag attr = match attr with diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 03b016c3f..f303e7ebb 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -956,6 +956,7 @@ let combinator_call_of_let_bindings combinator let_bindings rest_of_code = in let pairing_expression = Exp.apply + ~attrs:[simple_ghost_refmt_text_attr Reason_attrs.andCombinator] ~loc:and_binding.pvb_loc (pair and_binding) [(Nolabel, pairing_expression); (Nolabel, and_binding.pvb_expr)] @@ -974,17 +975,8 @@ let combinator_call_of_let_bindings combinator let_bindings rest_of_code = ~loc:combinator_loc Nolabel None nested_pair_pattern rest_of_code in - let attrs = - match and_bindings with - | [] -> - [simple_ghost_refmt_text_attr Reason_attrs.letCPSTag] - | _::_ -> - [simple_ghost_refmt_text_attr Reason_attrs.letCPSTag; - simple_ghost_refmt_text_attr Reason_attrs.letCPSMulti] - in - Exp.apply - ~attrs + ~attrs:[simple_ghost_refmt_text_attr Reason_attrs.letCombinator] ~loc:let_bindings.lbs_loc func [(Nolabel, pairing_expression); (Nolabel, continuation)] diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 97a253780..9f7db958b 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -3847,6 +3847,9 @@ let printer = object(self:'self) | Some se -> Simple se | None -> match x.pexp_desc with + | Pexp_apply _ when Reason_attrs.(hasRefmtTag letCombinator) refmtAttrs -> + let x = {x with pexp_attributes = refmtAttrs @ x.pexp_attributes} in + Simple (makeLetSequence (self#letList x)) | Pexp_apply (e, ls) -> ( let ls = List.map (fun (l,expr) -> (l, self#process_underscore_application expr)) ls in match (e, ls) with @@ -5066,6 +5069,83 @@ let printer = object(self:'self) let bindingsLoc = self#bindingsLocationRange l in let layout = source_map ~loc:bindingsLoc bindingsLayout in processLetList ((bindingsLoc, layout)::acc) e + + | (attrs, Pexp_apply ( + {pexp_desc = Pexp_ident function_name}, [ + Nolabel, bound_expression; + Nolabel, {pexp_desc = Pexp_fun ( + Nolabel, None, continuation_pattern, continuation_body)}])) + when Reason_attrs.(hasRefmtTag letCombinator) refmtAttrs -> + + (* Find all the nested applications that were generated from and.foo + bindings. They are tagged with andCombinator. *) + let rec find_bindings pattern expr = + let (refmtAttrs, otherAttrs) = + Reason_attrs.partition + (Reason_attrs.isRefmt ~filter:None) expr.pexp_attributes + in + + match (otherAttrs, expr.pexp_desc) with + | (_, Pexp_apply ( + {pexp_desc = Pexp_ident function_name}, [ + Nolabel, left_expr; + Nolabel, right_expr + ])) + when Reason_attrs.(hasRefmtTag andCombinator) refmtAttrs -> + + let (left_pattern, right_pattern) = + match pattern.ppat_desc with + | Ppat_tuple [l; r] -> (l, r) + | _ -> assert false + in + + let nested_bindings_reversed = + find_bindings left_pattern left_expr in + + let this_and_binding = + Ast_helper.Vb.mk + ~loc:function_name.loc right_pattern right_expr + in + + this_and_binding::nested_bindings_reversed + + | _ -> + let let_binding = + Ast_helper.Vb.mk + ~loc:function_name.loc pattern expr + in + [let_binding] + in + + let bindings = + find_bindings continuation_pattern bound_expression + |> List.rev + in + + let combinator_name = + match function_name.txt with + | Ldot (Lident module_name, "let_") -> + String.uncapitalize module_name + | _ -> assert false + in + + let bindings_loc = self#bindingsLocationRange bindings in + + let layout = + let let_layout = + self#binding ("let." ^ combinator_name) (List.hd bindings) in + let and_layouts = + List.map + (self#binding ("and." ^ combinator_name)) (List.tl bindings) + in + makeList + ~postSpace:true ~break:Always ~indent:0 ~inline:(true, true) + (let_layout::and_layouts) + |> source_map ~loc:bindings_loc + in + + processLetList ((bindings_loc, layout)::acc) continuation_body + | (attrs, Pexp_open (ovf, lid, e)) (* Add this when check to make sure these are handled as regular "simple expressions" *) when not (self#isSeriesOfOpensFollowedByNonSequencyExpression {expr with pexp_attributes = []}) -> @@ -5813,6 +5893,9 @@ let printer = object(self:'self) token will be confused with the match token. *) | Pexp_fun _ when pipe || semi -> Some (self#reset#simplifyUnparseExpr x) | Pexp_function l when pipe || semi -> Some (formatPrecedence ~loc:x.pexp_loc (self#reset#patternFunction x.pexp_loc l)) + | Pexp_apply _ + when Reason_attrs.(hasRefmtTag letCombinator) refmtAttrs -> + Some (makeLetSequence (self#letList x)) | Pexp_apply (e, l) -> ( match self#simple_get_application x with (* If it's the simple form of application. *) From 9c2617b68647aae4697a8a71b8661865c2eaf9d5 Mon Sep 17 00:00:00 2001 From: Anton Bachin Date: Sun, 19 Aug 2018 17:51:03 -0500 Subject: [PATCH 18/23] Don't auto-capitalize --- .../typeCheckedTests/expected_output/sequences.re | 8 ++++---- formatTest/typeCheckedTests/input/sequences.re | 8 ++++---- src/reason-parser/reason_parser.mly | 12 +++++------- src/reason-parser/reason_pprint_ast.ml | 3 +-- 4 files changed, 14 insertions(+), 17 deletions(-) diff --git a/formatTest/typeCheckedTests/expected_output/sequences.re b/formatTest/typeCheckedTests/expected_output/sequences.re index 325265081..e241d37e4 100644 --- a/formatTest/typeCheckedTests/expected_output/sequences.re +++ b/formatTest/typeCheckedTests/expected_output/sequences.re @@ -107,11 +107,11 @@ module Opt_map = { }; let _ = { - let.opt x = Some(10); + let.Opt x = Some(10); - let.opt_map a = Some(2) - and.opt_map b = Some(5) - and.opt_map c = Some(7); + let.Opt_map a = Some(2) + and.Opt_map b = Some(5) + and.Opt_map c = Some(7); print_endline(string_of_int(a)); a + x * b + c; diff --git a/formatTest/typeCheckedTests/input/sequences.re b/formatTest/typeCheckedTests/input/sequences.re index f79f613f7..2289ed453 100644 --- a/formatTest/typeCheckedTests/input/sequences.re +++ b/formatTest/typeCheckedTests/input/sequences.re @@ -112,11 +112,11 @@ module Opt_map = { }; let _ = { - let.opt x = Some(10); + let.Opt x = Some(10); - let.opt_map a = Some(2) - and.opt_map b = Some(5) - and.opt_map c = Some(7); + let.Opt_map a = Some(2) + and.Opt_map b = Some(5) + and.Opt_map c = Some(7); print_endline(string_of_int(a)); a + x * b + c; diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index f303e7ebb..7cb7f4c65 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -930,17 +930,15 @@ let val_of_let_bindings lbs = - Foo.and_ is a pairing operation, which takes two values, and wraps them in an option, promise, etc. Foo.and_ is used to replace and. *) let combinator_call_of_let_bindings combinator let_bindings rest_of_code = - let combinator_loc = combinator.loc in - let combinator = String.capitalize combinator.txt in let func = Exp.ident - ~loc:combinator_loc - (mkloc (parse (combinator ^ ".let_")) combinator_loc) + ~loc:combinator.loc + (mkloc (parse (combinator.txt ^ ".let_")) combinator.loc) in let pair and_binding = Exp.ident ~loc:and_binding.pvb_loc - (mkloc (parse (combinator ^ ".and_")) and_binding.pvb_loc) + (mkloc (parse (combinator.txt ^ ".and_")) and_binding.pvb_loc) in match let_bindings.lbs_bindings with @@ -972,7 +970,7 @@ let combinator_call_of_let_bindings combinator let_bindings rest_of_code = let continuation = Exp.fun_ - ~loc:combinator_loc Nolabel None nested_pair_pattern rest_of_code + ~loc:combinator.loc Nolabel None nested_pair_pattern rest_of_code in Exp.apply @@ -4986,7 +4984,7 @@ item_extension_sugar: ; let_combinator: - DOT as_loc(val_ident) { $2 } + DOT as_loc(UIDENT) { $2 } ; extension: diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 9f7db958b..9ffc8b061 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -5124,8 +5124,7 @@ let printer = object(self:'self) let combinator_name = match function_name.txt with - | Ldot (Lident module_name, "let_") -> - String.uncapitalize module_name + | Ldot (Lident module_name, "let_") -> module_name | _ -> assert false in From 8f9b7382fae7974d93e8ff179036abf7331de997 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Tue, 21 Aug 2018 09:53:24 -0600 Subject: [PATCH 19/23] rm unused --- src/reason-parser/reason_attrs.ml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/reason-parser/reason_attrs.ml b/src/reason-parser/reason_attrs.ml index a1ec8e363..2e5c6aadc 100644 --- a/src/reason-parser/reason_attrs.ml +++ b/src/reason-parser/reason_attrs.ml @@ -22,7 +22,7 @@ let andCombinator = "andCombinator" let isRefmtTag tag attr = match attr with | ( - {txt="refmt"; loc}, + {txt="refmt"}, PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant(Pconst_string(foundTag, None))}, _)}] ) -> foundTag = tag | _ -> false @@ -32,7 +32,7 @@ let hasRefmtTag tag = List.exists (isRefmtTag tag) let isRefmt ~filter attr = match attr with | ( - {txt="refmt"; loc}, + {txt="refmt"}, PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant(Pconst_string(tag, None))}, _)}] ) -> ( match filter with @@ -57,17 +57,17 @@ let rec partitionAttributes ?(partDoc=false) ?(allowUncurry=true) attrs : T.attr | attr::atTl when isRefmt ~filter:None attr -> let partition = partitionAttributes ~partDoc ~allowUncurry atTl in {partition with refmtAttrs=attr::partition.refmtAttrs} - | (({txt="JSX"; loc}, _) as jsx)::atTl -> + | (({txt="JSX"}, _) as jsx)::atTl -> let partition = partitionAttributes ~partDoc ~allowUncurry atTl in {partition with jsxAttrs=jsx::partition.jsxAttrs} - | (({txt="explicit_arity"; loc}, _) as arity_attr)::atTl - | (({txt="implicit_arity"; loc}, _) as arity_attr)::atTl -> + | (({txt="explicit_arity"}, _) as arity_attr)::atTl + | (({txt="implicit_arity"}, _) as arity_attr)::atTl -> let partition = partitionAttributes ~partDoc ~allowUncurry atTl in {partition with arityAttrs=arity_attr::partition.arityAttrs} - | (({txt="ocaml.text"; loc}, _) as doc)::atTl when partDoc = true -> + | (({txt="ocaml.text"}, _) as doc)::atTl when partDoc = true -> let partition = partitionAttributes ~partDoc ~allowUncurry atTl in {partition with docAttrs=doc::partition.docAttrs} - | (({txt="ocaml.doc"; loc}, _) as doc)::atTl when partDoc = true -> + | (({txt="ocaml.doc"}, _) as doc)::atTl when partDoc = true -> let partition = partitionAttributes ~partDoc ~allowUncurry atTl in {partition with docAttrs=doc::partition.docAttrs} | (({txt="reason.raw_literal"; _}, _) as attr) :: atTl -> @@ -82,7 +82,7 @@ let extractStdAttrs attrs = let extract_raw_literal attrs = let rec loop acc = function - | ({txt="reason.raw_literal"; loc}, + | ({txt="reason.raw_literal"}, PStr [{pstr_desc = Pstr_eval({pexp_desc = Pexp_constant(Pconst_string(text, None)); _}, _); _}]) :: rest -> (Some text, List.rev_append acc rest) From b1a5ca72e733adf93fa43cfc58aaf6ea9bf23330 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Tue, 21 Aug 2018 10:08:04 -0600 Subject: [PATCH 20/23] nother fatal warning --- src/reason-parser/reason_pprint_ast.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 6608957b1..8ff324266 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -5071,7 +5071,7 @@ let printer = object(self:'self) let layout = source_map ~loc:bindingsLoc bindingsLayout in processLetList ((bindingsLoc, layout)::acc) e - | (attrs, Pexp_apply ( + | (_attrs, Pexp_apply ( {pexp_desc = Pexp_ident function_name}, [ Nolabel, bound_expression; Nolabel, {pexp_desc = Pexp_fun ( From fa4ec8320713f0646cf1398efea9f91825403a57 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Tue, 21 Aug 2018 10:08:04 -0600 Subject: [PATCH 21/23] bangs --- .../expected_output/sequences.re | 33 +++++++++++------ .../typeCheckedTests/input/sequences.re | 35 ++++++++++++------- src/reason-parser/reason_parser.mly | 16 ++++----- 3 files changed, 53 insertions(+), 31 deletions(-) diff --git a/formatTest/typeCheckedTests/expected_output/sequences.re b/formatTest/typeCheckedTests/expected_output/sequences.re index e241d37e4..7fbc336ed 100644 --- a/formatTest/typeCheckedTests/expected_output/sequences.re +++ b/formatTest/typeCheckedTests/expected_output/sequences.re @@ -96,23 +96,34 @@ module Option = { }; }; -module Opt = { - let let_ = Option.flatMap; - let and_ = Option.pair; +let _ = { + let!Option x = Some(23) + and!Option y = Some(5); + + Some(x + y) }; -module Opt_map = { - let let_ = Option.map; - let and_ = Option.pair; +module Async = { + type t('value) = Js.Promise.t('value); + let let_: (t('a), 'a => t('b)) => t('b) = Js.Promise.then_; + let and_: (t('a), t('b)) => t(('a, 'b)) = Js.Promise.all2; + let try_: (t('a), exn => t('a)) => t('a) = Js.Promise.catch; + let resolve = Js.Promise.resolve; + let reject = Js.Promise.reject; }; +let getAge = () => Async.reject(Failure("Cannot get age")); + let _ = { - let.Opt x = Some(10); + let!Async x = try!Async (getAge()) { + | Failure(message) => Ok(23) + | exn => raise(exn) + }; - let.Opt_map a = Some(2) - and.Opt_map b = Some(5) - and.Opt_map c = Some(7); + let!Async a = Async.resolve(2) + and!Async b = Async.resolve(5) + and!Async c = Async.resolve(7); print_endline(string_of_int(a)); - a + x * b + c; + Async.resolve(a + x * b + c); }; diff --git a/formatTest/typeCheckedTests/input/sequences.re b/formatTest/typeCheckedTests/input/sequences.re index 2289ed453..711678af6 100644 --- a/formatTest/typeCheckedTests/input/sequences.re +++ b/formatTest/typeCheckedTests/input/sequences.re @@ -101,23 +101,34 @@ module Option = { }; }; -module Opt = { - let let_ = Option.flatMap; - let and_ = Option.pair; +let _ = { + let!Option x = Some(23) + and!Option y = Some(5); + + Some(x + y) }; -module Opt_map = { - let let_ = Option.map; - let and_ = Option.pair; +module Async = { + type t('value) = Js.Promise.t('value); + let let_: (t('a), 'a => t('b)) => t('b) = Js.Promise.then_; + let and_: (t('a), t('b)) => t(('a, 'b)) = Js.Promise.all2; + let try_: (t('a), exn => t('a)) => t('a) = Js.Promise.catch; + let resolve = Js.Promise.resolve; + let reject = Js.Promise.reject; }; -let _ = { - let.Opt x = Some(10); +let getAge = () => Async.reject(Failure("Cannot get age")); - let.Opt_map a = Some(2) - and.Opt_map b = Some(5) - and.Opt_map c = Some(7); +let _ = { + let!Async x = try!Async (getAge()) { + | Failure(message) => Ok(23) + | exn => raise(exn) + }; + + let!Async a = Async.resolve(2) + and!Async b = Async.resolve(5) + and!Async c = Async.resolve(7); print_endline(string_of_int(a)); - a + x * b + c; + Async.resolve(a + x * b + c); }; diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index ce5dc0ccc..ed2c56d88 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -888,14 +888,14 @@ let addlbs lbs lbs' = let val_of_let_bindings lbs = let str = Str.value lbs.lbs_rec lbs.lbs_bindings in if lbs.lbs_combinator <> None then - raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let.foo is not allowed at the top level"))); + raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let!Foo is not allowed at the top level"))); match lbs.lbs_extension with | None -> str | Some ext -> struct_item_extension ext [str] (* Transforms - let.foo x = a + let!Foo x = a and y = b; rest_of_code @@ -966,7 +966,7 @@ let expr_of_let_bindings lbs body = match lbs.lbs_combinator with | Some attr -> if lbs.lbs_extension <> None then - raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let.foo cannot be combined with let%foo"))); + raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let!Foo cannot be combined with let%foo"))); combinator_call_of_let_bindings attr lbs body | None -> let item_expr = Exp.let_ lbs.lbs_rec lbs.lbs_bindings body in @@ -980,7 +980,7 @@ let class_of_let_bindings lbs body = if lbs.lbs_extension <> None then raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "extension"))); if lbs.lbs_combinator <> None then - raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let.foo is not allowed in class bindings"))); + raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "let!Foo is not allowed in class bindings"))); Cl.let_ lbs.lbs_rec lbs.lbs_bindings body (* @@ -2950,9 +2950,9 @@ mark_position_exp | SWITCH optional_expr_extension simple_expr_no_constructor LBRACE match_cases(seq_expr) RBRACE { $2 (mkexp (Pexp_match ($3, $5))) } - | TRY optional_expr_extension simple_expr_no_constructor + | TRY let_combinator optional_expr_extension simple_expr_no_constructor LBRACE match_cases(seq_expr) RBRACE - { $2 (mkexp (Pexp_try ($3, $5))) } + { $3 (mkexp (Pexp_try ($4, $6))) } | TRY optional_expr_extension simple_expr_no_constructor WITH error { syntax_error_exp (mklocation $startpos($5) $endpos($5)) "Invalid try with"} | IF optional_expr_extension parenthesized_expr @@ -3436,7 +3436,7 @@ let_bindings: let_binding and_let_binding* { let let_binding = $1 in let and_bindings = $2 in (* Make sure that the and combinators match the let combinators, i.e. if - there is let.foo, then if there are ands, they must be and.foo as + there is let!Foo, then if there are ands, they must be and.foo as well. *) and_bindings |> List.iter (fun (and_binding, and_combinator) -> match (and_combinator, let_binding.lbs_combinator) with @@ -3453,7 +3453,7 @@ let_bindings: let_binding and_let_binding* | None -> "and" | Some identifier -> "and." ^ identifier.txt in - let message = "and.foo must match let.foo, " ^ expected in + let message = "and.foo must match let!Foo, " ^ expected in raise Syntaxerr.(Error (Expecting (loc, message)))); let and_bindings = fst (List.split and_bindings) in addlbs let_binding and_bindings }; From 6b8907dd5d7829f5c07ac0f1fd100d06e29b1073 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Tue, 21 Aug 2018 10:08:04 -0600 Subject: [PATCH 22/23] ok I think thats it --- src/reason-parser/reason_parser.mly | 13 +++++++------ src/reason-parser/reason_pprint_ast.ml | 4 ++-- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index ed2c56d88..6637b1a21 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -872,7 +872,7 @@ type let_bindings = { lbs_bindings: Parsetree.value_binding list; lbs_rec: rec_flag; lbs_extension: (attributes * string Asttypes.loc) option; - lbs_combinator: string Asttypes.loc option; + lbs_combinator: Longident.t Asttypes.loc option; lbs_loc: Location.t } let mklbs combinator ext rf lb loc = @@ -911,15 +911,16 @@ let val_of_let_bindings lbs = - Foo.and_ is a pairing operation, which takes two values, and wraps them in an option, promise, etc. Foo.and_ is used to replace and. *) let combinator_call_of_let_bindings combinator let_bindings rest_of_code = + let modulePath = combinator.txt |> Longident.flatten |> String.concat "." in let func = Exp.ident ~loc:combinator.loc - (mkloc (parse (combinator.txt ^ ".let_")) combinator.loc) + (mkloc (parse (modulePath ^ ".let_")) combinator.loc) in let pair and_binding = Exp.ident ~loc:and_binding.pvb_loc - (mkloc (parse (combinator.txt ^ ".and_")) and_binding.pvb_loc) + (mkloc (parse (modulePath ^ ".and_")) and_binding.pvb_loc) in match let_bindings.lbs_bindings with @@ -3451,9 +3452,9 @@ let_bindings: let_binding and_let_binding* let expected = match let_binding.lbs_combinator with | None -> "and" - | Some identifier -> "and." ^ identifier.txt + | Some identifier -> "and!" ^ (Longident.flatten identifier.txt |> String.concat ".") in - let message = "and.foo must match let!Foo, " ^ expected in + let message = "and!Foo must match let!Foo, " ^ expected in raise Syntaxerr.(Error (Expecting (loc, message)))); let and_bindings = fst (List.split and_bindings) in addlbs let_binding and_bindings }; @@ -4968,7 +4969,7 @@ item_extension_sugar: ; let_combinator: - DOT as_loc(UIDENT) { $2 } + DOT as_loc(val_longident) { $2 } ; extension: diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 8ff324266..ecf69a215 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -5133,10 +5133,10 @@ let printer = object(self:'self) let layout = let let_layout = - self#binding ("let." ^ combinator_name) (List.hd bindings) in + self#binding ("let!" ^ combinator_name) (List.hd bindings) in let and_layouts = List.map - (self#binding ("and." ^ combinator_name)) (List.tl bindings) + (self#binding ("and!" ^ combinator_name)) (List.tl bindings) in makeList ~postSpace:true ~break:Always ~indent:0 ~inline:(true, true) From 240dc3fb0681a1d0328446ad20a2a430cdc83685 Mon Sep 17 00:00:00 2001 From: Jared Forsyth Date: Tue, 21 Aug 2018 10:08:04 -0600 Subject: [PATCH 23/23] more mentions --- src/reason-parser/reason_parser.mly | 2 +- src/reason-parser/reason_pprint_ast.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 6637b1a21..ac381c448 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -3437,7 +3437,7 @@ let_bindings: let_binding and_let_binding* { let let_binding = $1 in let and_bindings = $2 in (* Make sure that the and combinators match the let combinators, i.e. if - there is let!Foo, then if there are ands, they must be and.foo as + there is let!Foo, then if there are ands, they must be and!Foo as well. *) and_bindings |> List.iter (fun (and_binding, and_combinator) -> match (and_combinator, let_binding.lbs_combinator) with diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index ecf69a215..5955bb568 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -5078,7 +5078,7 @@ let printer = object(self:'self) Nolabel, None, continuation_pattern, continuation_body)}])) when Reason_attrs.(hasRefmtTag letCombinator) refmtAttrs -> - (* Find all the nested applications that were generated from and.foo + (* Find all the nested applications that were generated from and!Foo bindings. They are tagged with andCombinator. *) let rec find_bindings pattern expr = let (refmtAttrs, otherAttrs) =