Преглед изворни кода

[java/cs] filter out enum type parameters from AST
fixed issue #1796

Caue Waneck пре 12 година
родитељ
комит
01fee87425
6 измењених фајлова са 62 додато и 1 уклоњено
  1. 1 0
      ast.ml
  2. 2 1
      common.ml
  3. 54 0
      gencommon.ml
  4. 1 0
      gencs.ml
  5. 1 0
      genjava.ml
  6. 3 0
      typeload.ml

+ 1 - 0
ast.ml

@@ -55,6 +55,7 @@ module Meta = struct
 		| Deprecated
 		| Deprecated
 		| DynamicObject
 		| DynamicObject
 		| Enum
 		| Enum
+		| EnumConstructorParam
 		| Expose
 		| Expose
 		| Extern
 		| Extern
 		| FakeEnum
 		| FakeEnum

+ 2 - 1
common.ml

@@ -310,7 +310,8 @@ module MetaInfo = struct
 		| Depend -> ":depend",("",[Platform Cpp])
 		| Depend -> ":depend",("",[Platform Cpp])
 		| Deprecated -> ":deprecated",("",[Platforms [Java;Cs]])
 		| Deprecated -> ":deprecated",("",[Platforms [Java;Cs]])
 		| DynamicObject -> ":dynamicObject",("",[Platforms [Java;Cs]])
 		| DynamicObject -> ":dynamicObject",("",[Platforms [Java;Cs]])
-		| Enum -> ":enum",("",[Platforms [Java;Cs]])
+    | Enum -> ":enum",("Used internally to annotate a class that was generated from an enum",[Platforms [Java;Cs]; UsedOn TClass])
+		| EnumConstructorParam -> ":enumConstructorParam",("Used internally to annotate GADT type parameters",[UsedOn TClass])
 		| Expose -> ":expose",("Makes the class available on the window object",[HasParam "?Name=Class path";UsedOn TClass;Platform Js])
 		| Expose -> ":expose",("Makes the class available on the window object",[HasParam "?Name=Class path";UsedOn TClass;Platform Js])
 		| Extern -> ":extern",("Marks the field as extern so it is not generated",[UsedOn TClassField])
 		| Extern -> ":extern",("Marks the field as extern so it is not generated",[UsedOn TClassField])
 		| FakeEnum -> ":fakeEnum",("Treat enum as collection of values of the specified type",[HasParam "Type name";UsedOn TEnum])
 		| FakeEnum -> ":fakeEnum",("Treat enum as collection of values of the specified type",[HasParam "Type name";UsedOn TEnum])

+ 54 - 0
gencommon.ml

@@ -10192,6 +10192,60 @@ struct
     gen.gmodule_filters#add ~name:name ~priority:(PCustom priority) map
     gen.gmodule_filters#add ~name:name ~priority:(PCustom priority) map
 end;;
 end;;
 
 
+(* ******************************************* *)
+(* NormalizeType *)
+(* ******************************************* *)
+
+(*
+
+  - Filters out enum constructor type parameters from the AST; See Issue #1796
+  - Filters out monomorphs
+
+  dependencies:
+    No dependencies; but it still should be one of the first filters to run,
+    as it will help normalize the AST
+
+*)
+
+module NormalizeType =
+struct
+
+  let name = "normalize_type"
+
+  let priority = max_dep
+
+  let rec filter_param t = match t with
+  | TInst({ cl_kind = KTypeParameter _ } as c,_) when Meta.has Meta.EnumConstructorParam c.cl_meta ->
+    t_dynamic
+  | TMono r -> (match !r with
+    | None -> t_dynamic
+    | Some t -> filter_param t)
+  | TInst(_,[]) | TEnum(_,[]) | TType(_,[]) | TAbstract(_,[]) -> t
+  | TType(t,tl) -> TType(t,List.map filter_param tl)
+  | TInst(c,tl) -> TInst(c,List.map filter_param tl)
+  | TEnum(e,tl) -> TEnum(e,List.map filter_param tl)
+  | TAbstract(a,tl) -> TAbstract(a, List.map filter_param tl)
+  | TAnon a ->
+    TAnon {
+      a_fields = PMap.map (fun f -> { f with cf_type = filter_param f.cf_type }) a.a_fields;
+      a_status = a.a_status;
+    }
+  | TFun(args,ret) -> TFun(List.map (fun (n,o,t) -> (n,o,filter_param t)) args, filter_param ret)
+  | TDynamic _ -> t
+  | TLazy f -> filter_param (!f())
+
+  let default_implementation gen =
+    let rec run e =
+      map_expr_type (fun e -> run e) filter_param (fun v -> v.v_type <- filter_param v.v_type; v) e
+    in
+    run
+
+  let configure gen =
+    let map e = Some(default_implementation gen e) in
+    gen.gexpr_filters#add ~name:name ~priority:(PCustom priority) map
+
+end;;
+
 (*
 (*
 (* ******************************************* *)
 (* ******************************************* *)
 (* Example *)
 (* Example *)

+ 1 - 0
gencs.ml

@@ -1897,6 +1897,7 @@ let configure gen =
     path_param_s (TClassDecl c) c.cl_path tl ^ "." ^ fname
     path_param_s (TClassDecl c) c.cl_path tl ^ "." ^ fname
   in
   in
   FixOverrides.configure ~explicit_fn_name:explicit_fn_name gen;
   FixOverrides.configure ~explicit_fn_name:explicit_fn_name gen;
+  NormalizeType.configure gen;
 
 
   AbstractImplementationFix.configure gen;
   AbstractImplementationFix.configure gen;
 
 

+ 1 - 0
genjava.ml

@@ -1767,6 +1767,7 @@ let configure gen =
   StubClosureImpl.configure gen (StubClosureImpl.default_implementation gen float_cl 10 (fun e _ _ -> e));*)
   StubClosureImpl.configure gen (StubClosureImpl.default_implementation gen float_cl 10 (fun e _ _ -> e));*)
 
 
   FixOverrides.configure gen;
   FixOverrides.configure gen;
+  NormalizeType.configure gen;
   AbstractImplementationFix.configure gen;
   AbstractImplementationFix.configure gen;
 
 
   IteratorsInterface.configure gen (fun e -> e);
   IteratorsInterface.configure gen (fun e -> e);

+ 3 - 0
typeload.ml

@@ -2088,6 +2088,9 @@ let rec init_module_type ctx context_init do_init (decl,p) =
 			let params = ref [] in
 			let params = ref [] in
 			params := List.map (fun tp -> type_type_params ctx ([],c.ec_name) (fun() -> !params) c.ec_pos tp) c.ec_params;
 			params := List.map (fun tp -> type_type_params ctx ([],c.ec_name) (fun() -> !params) c.ec_pos tp) c.ec_params;
 			let params = !params in
 			let params = !params in
+			List.iter (fun (_,t) -> match follow t with
+				| TInst(p,_) -> p.cl_meta <- (Meta.EnumConstructorParam,[],p.cl_pos) :: p.cl_meta
+				| _ -> assert false) params;
 			let ctx = { ctx with type_params = params @ ctx.type_params } in
 			let ctx = { ctx with type_params = params @ ctx.type_params } in
 			let rt = (match c.ec_type with
 			let rt = (match c.ec_type with
 				| None -> et
 				| None -> et