Merge pull request #2660 from BuckleScript/spin_off_primitive

[clean] spin off primtive in ppx

Author: bobzhang

jscomp/Makefile

@@ -256,6 +256,7 @@ SYNTAX_SRCS= \
 	external_process\
 	ast_util\
 	ast_tdcls\
+	ast_primitive\
 	ast_exp_apply\
 	ast_exp_extension\
 	ast_core_type_class_type\

jscomp/all.depend

@@ -243,6 +243,8 @@ syntax/ast_tdcls.cmx : ext/ext_list.cmx syntax/bs_ast_mapper.cmx \
     syntax/ast_structure.cmx syntax/ast_signature.cmx syntax/ast_payload.cmx \
     syntax/ast_derive_abstract.cmx syntax/ast_derive.cmx \
     syntax/ast_attributes.cmx syntax/ast_tdcls.cmi
+syntax/ast_primitive.cmx : syntax/external_process.cmx \
+    syntax/bs_ast_mapper.cmx syntax/ast_primitive.cmi
 syntax/ast_exp_apply.cmx : ext/literals.cmx ext/ext_list.cmx \
     syntax/bs_ast_mapper.cmx syntax/bs_ast_invariant.cmx syntax/ast_util.cmx \
     syntax/ast_literal.cmx syntax/ast_attributes.cmx syntax/ast_exp_apply.cmi
@@ -257,14 +259,14 @@ syntax/ast_core_type_class_type.cmx : ext/literals.cmx ext/ext_ref.cmx \
 syntax/ast_tuple_pattern_flatten.cmx : ext/ext_list.cmx \
     syntax/bs_ast_mapper.cmx syntax/ast_tuple_pattern_flatten.cmi
 syntax/ppx_entry.cmx : ext/string_map.cmx ext/literals.cmx \
-    syntax/external_process.cmx ext/ext_string.cmx syntax/bs_ast_mapper.cmx \
-    syntax/bs_ast_invariant.cmx syntax/ast_util.cmx \
-    syntax/ast_utf8_string_interp.cmx syntax/ast_utf8_string.cmx \
-    syntax/ast_tuple_pattern_flatten.cmx syntax/ast_tdcls.cmx \
-    syntax/ast_payload.cmx syntax/ast_exp_extension.cmx \
-    syntax/ast_exp_apply.cmx syntax/ast_derive_projector.cmx \
-    syntax/ast_derive_js_mapper.cmx syntax/ast_core_type_class_type.cmx \
-    syntax/ast_attributes.cmx syntax/ppx_entry.cmi
+    ext/ext_string.cmx syntax/bs_ast_mapper.cmx syntax/bs_ast_invariant.cmx \
+    syntax/ast_util.cmx syntax/ast_utf8_string_interp.cmx \
+    syntax/ast_utf8_string.cmx syntax/ast_tuple_pattern_flatten.cmx \
+    syntax/ast_tdcls.cmx syntax/ast_primitive.cmx syntax/ast_payload.cmx \
+    syntax/ast_exp_extension.cmx syntax/ast_exp_apply.cmx \
+    syntax/ast_derive_projector.cmx syntax/ast_derive_js_mapper.cmx \
+    syntax/ast_core_type_class_type.cmx syntax/ast_attributes.cmx \
+    syntax/ppx_entry.cmi
 syntax/bs_syntaxerr.cmi :
 syntax/ast_utf8_string.cmi :
 syntax/ast_utf8_string_interp.cmi :
@@ -297,6 +299,7 @@ syntax/external_process.cmi : common/bs_loc.cmi syntax/ast_core_type.cmi \
 syntax/ast_util.cmi : syntax/bs_ast_mapper.cmi syntax/ast_payload.cmi
 syntax/ast_tdcls.cmi : syntax/bs_ast_mapper.cmi syntax/ast_structure.cmi \
     syntax/ast_signature.cmi
+syntax/ast_primitive.cmi : syntax/bs_ast_mapper.cmi
 syntax/ast_exp_apply.cmi : syntax/bs_ast_mapper.cmi
 syntax/ast_exp_extension.cmi : syntax/bs_ast_mapper.cmi
 syntax/ast_core_type_class_type.cmi : syntax/bs_ast_mapper.cmi
@@ -765,13 +768,15 @@ super_errors/super_main.cmx : super_errors/super_typetexp.cmx \
     super_errors/super_env.cmx
 super_errors/super_reason_react.cmi :
 super_errors/super_misc.cmi :
-outcome_printer/reason_syntax_util.cmx :
+outcome_printer/reason_syntax_util.cmx : \
+    outcome_printer/reason_syntax_util.cmi
 outcome_printer/outcome_printer_ns.cmx : ext/ext_namespace.cmx \
     outcome_printer/outcome_printer_ns.cmi
 outcome_printer/tweaked_reason_oprint.cmx : \
     outcome_printer/reason_syntax_util.cmx
 outcome_printer/reason_outcome_printer_main.cmx : \
     outcome_printer/tweaked_reason_oprint.cmx
+outcome_printer/reason_syntax_util.cmi :
 outcome_printer/outcome_printer_ns.cmi :
 ounit_tests/ounit_cmd_util.cmi :
 ounit_tests/ounit_tests_main.cmi :

jscomp/syntax/ast_primitive.ml

@@ -0,0 +1,88 @@
+(* Copyright (C) 2018 Authors of BuckleScript
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+
+let handlePrimitiveInSig
+    (self : Bs_ast_mapper.mapper)
+    ({pval_attributes;
+      pval_type;
+      pval_loc;
+      pval_prim;
+      pval_name ;
+     } as prim : Parsetree.value_description)
+    (sigi : Parsetree.signature_item)
+  : Parsetree.signature_item
+  =
+  let pval_type = self.typ self pval_type in
+  let pval_attributes = self.attributes self pval_attributes in
+  let pval_type, pval_prim, pval_attributes =
+    match pval_prim with
+    | [ v ] ->
+      External_process.handle_attributes_as_string
+        pval_loc
+        pval_name.txt
+        pval_type
+        pval_attributes v
+    | _ ->
+      Location.raise_errorf
+        ~loc:pval_loc
+        "only a single string is allowed in bs external" in
+  {sigi with
+   psig_desc =
+     Psig_value
+       {prim with
+        pval_type ;
+        pval_prim ;
+        pval_attributes
+       }}
+
+let handlePrimitiveInStru
+    (self : Bs_ast_mapper.mapper)
+    ({pval_attributes;
+      pval_prim;
+      pval_type;
+      pval_name;
+      pval_loc} as prim : Parsetree.value_description)
+    (str : Parsetree.structure_item)
+    : Parsetree.structure_item =
+  let pval_type = self.typ self pval_type in
+  let pval_attributes = self.attributes self pval_attributes in
+  let pval_type, pval_prim, pval_attributes =
+    match pval_prim with
+    | [ v] ->
+      External_process.handle_attributes_as_string
+        pval_loc
+        pval_name.txt
+        pval_type pval_attributes v
+
+    | _ -> Location.raise_errorf
+             ~loc:pval_loc "only a single string is allowed in bs external" in
+  {str with
+   pstr_desc =
+     Pstr_primitive
+       {prim with
+        pval_type ;
+        pval_prim;
+        pval_attributes
+       }}

jscomp/syntax/ast_primitive.mli

@@ -0,0 +1,37 @@
+(* Copyright (C) 2018 Authors of BuckleScript
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+
+val handlePrimitiveInSig:
+  Bs_ast_mapper.mapper ->
+  Parsetree.value_description ->
+  Parsetree.signature_item ->
+  Parsetree.signature_item
+
+val handlePrimitiveInStru:
+  Bs_ast_mapper.mapper ->
+  Parsetree.value_description ->
+  Parsetree.structure_item ->
+  Parsetree.structure_item
+  

jscomp/syntax/ast_tdcls.ml

@@ -24,7 +24,9 @@
 
 open Ast_helper
 
-
+(**
+   [newTdcls tdcls newAttrs]
+   functional update attributes of last declaration *)
 let newTdcls
     (tdcls : Parsetree.type_declaration list)
     (newAttrs : Parsetree.attributes)
@@ -47,17 +49,16 @@ let handleTdclsInSigi
     (self : Bs_ast_mapper.mapper)
     (sigi : Parsetree.signature_item)
     (tdcls : Parsetree.type_declaration list)
-    : Ast_signature.item =
+  : Ast_signature.item =
   begin match Ast_attributes.process_derive_type
                 (Ext_list.last tdcls).ptype_attributes  with
   | {bs_deriving = Some actions; explict_nonrec}, newAttrs
     ->
     let loc = sigi.psig_loc in
-    let newTdcls = newTdcls tdcls newAttrs in
-    let newSigi =
-      self.signature_item self {sigi with psig_desc = Psig_type newTdcls} in
+    let originalTdclsNewAttrs = newTdcls tdcls newAttrs in (* remove the processed attr*)
+    let newTdclsNewAttrs = self.type_declaration_list self originalTdclsNewAttrs in
     if Ast_payload.isAbstract actions then
-      let  codes = Ast_derive_abstract.handleTdclsInSig newTdcls in
+      let  codes = Ast_derive_abstract.handleTdclsInSig originalTdclsNewAttrs in
       Ast_signature.fuseAll ~loc
         (
           Sig.include_ ~loc
@@ -67,23 +68,18 @@ let handleTdclsInSigi
                      (Mod.structure ~loc [
                          { pstr_loc = loc;
                            pstr_desc =
-                             Pstr_type
-                               (match newSigi.psig_desc with
-                                | Psig_type x -> x
-                                | _ -> assert false)
+                             Pstr_type newTdclsNewAttrs
                          }] )
                      (Mty.signature ~loc [])) ) )
-          ::
-          self.signature self
-            codes
+          :: (* include module type of struct [processed_code for checking like invariance ]end *)
+          self.signature self  codes
         )
     else
       Ast_signature.fuseAll ~loc
-        (newSigi::
+        ( {psig_desc = Psig_type newTdclsNewAttrs; psig_loc = loc}::
          self.signature
            self
-           (
-             Ast_derive.gen_signature tdcls actions explict_nonrec))
+           (Ast_derive.gen_signature tdcls actions explict_nonrec))
   | {bs_deriving = None }, _  ->
     Bs_ast_mapper.default_mapper.signature_item self sigi
 
@@ -94,27 +90,27 @@ let handleTdclsInStru
     (self : Bs_ast_mapper.mapper)
     (str : Parsetree.structure_item)
     (tdcls : Parsetree.type_declaration list)
-    : Ast_structure.item =
+  : Ast_structure.item =
   begin match
       Ast_attributes.process_derive_type
         ((Ext_list.last tdcls).ptype_attributes) with
   | {bs_deriving = Some actions;
      explict_nonrec
     }, newAttrs ->
     let loc = str.pstr_loc in
-    let tdcls2 = newTdcls tdcls newAttrs in
-    let newStr =
-      self.structure_item self
-        {str with pstr_desc = Pstr_type tdcls2} in
+    let originalTdclsNewAttrs = newTdcls tdcls newAttrs in
+    let newStr : Parsetree.structure_item =
+      { pstr_desc = Pstr_type (self.type_declaration_list self originalTdclsNewAttrs);
+        pstr_loc = loc}
+    in
     if Ast_payload.isAbstract actions then
-      let codes = Ast_derive_abstract.handleTdclsInStr tdcls2 in
+      let codes = Ast_derive_abstract.handleTdclsInStr originalTdclsNewAttrs in
       (* use [tdcls2] avoid nonterminating *)
       Ast_structure.fuseAll ~loc
         (
-          Ast_structure.constraint_ ~loc
-            [newStr] []::
-          self.structure self
-            codes)
+          Ast_structure.constraint_ ~loc [newStr] []
+          :: (* [include struct end : sig end] for error checking *)
+          self.structure self codes)
     else
       Ast_structure.fuseAll ~loc
         (newStr ::