Sfoglia il codice sorgente

[cs] Fixed Null<> handling inside Type Parameters; Divided CSharpSpecific module into two: One that runs before ExprUnwrap and generates complex expressions, and one that runs after ExprUnwrap, and thus can run at a much later stage in the pipeline. Fixed Issue #878

Caue Waneck 13 anni fa
parent
commit
027cf860de
5 ha cambiato i file con 160 aggiunte e 113 eliminazioni
  1. 29 13
      gencommon.ml
  2. 125 85
      gencs.ml
  3. 0 10
      genjava.ml
  4. 0 5
      std/cs/_std/haxe/lang/Null.hx
  5. 6 0
      std/cs/_std/haxe/lang/Runtime.hx

+ 29 - 13
gencommon.ml

@@ -471,7 +471,7 @@ type generator_ctx =
   (* this is a cache for all field access types *)
   greal_field_types : (path * string, (tclass_field (* does the cf exist *) * t (*cf's type in relation to current class type params *) ) option) Hashtbl.t;
   (* this function allows any code to handle casts as if it were inside the cast_detect module *)
-  mutable ghandle_cast : texpr->t->t->texpr;
+  mutable ghandle_cast : t->t->texpr->texpr;
   (* when an unsafe cast is made, we can warn the user *)
   mutable gon_unsafe_cast : t->t->pos->unit;
   (* does this type needs to be boxed? Normally always false, unless special type handling must be made *)
@@ -652,7 +652,7 @@ let new_ctx con =
     gtypes = types;
     
     greal_field_types = Hashtbl.create 0;
-    ghandle_cast = (fun e to_t from_t -> mk_cast to_t e);
+    ghandle_cast = (fun to_t from_t e -> mk_cast to_t e);
     gon_unsafe_cast = (fun t t2 pos -> (gen.gcon.warning ("Type " ^ (debug_type t2) ^ " is being cast to the unrelated type " ^ (s_type (print_context()) t)) pos));
     gneeds_box = (fun t -> false);
     gspecial_needs_cast = (fun to_t from_t -> true);
@@ -4483,6 +4483,7 @@ struct
     run
   
   let configure gen (mapping_func:texpr->texpr) =
+    gen.ghandle_cast <- (fun tto tfrom expr -> handle_cast gen expr (gen.greal_type tto) (gen.greal_type tfrom));
     let map e = Some(mapping_func e) in
     gen.gsyntax_filters#add ~name:name ~priority:(PCustom priority) map
   
@@ -7981,13 +7982,18 @@ struct
         Some( TType(tdef, [ strip_off_nullable of_t ]) )
       | _ -> None
   
-  let traverse gen unwrap_null wrap_val null_to_dynamic handle_opeq =
+  let traverse gen unwrap_null wrap_val null_to_dynamic handle_opeq handle_cast =
     let handle_unwrap to_t e =
-      match gen.gfollow#run_f to_t with 
+      let e_null_t = get (is_null_t gen e.etype) in
+      match gen.greal_type to_t with 
         | TDynamic _ | TMono _ | TAnon _ ->
-          null_to_dynamic e
+          (match e_null_t with
+            | TDynamic _ | TMono _ | TAnon _ ->
+              gen.ghandle_cast to_t e_null_t (unwrap_null e)
+            | _ -> null_to_dynamic e
+          )
         | _ ->
-          mk_cast to_t (unwrap_null e)
+          gen.ghandle_cast to_t e_null_t (unwrap_null e)
     in
     
     let handle_wrap e t =
@@ -8000,16 +8006,26 @@ struct
     
     let is_null_t = is_null_t gen in
     let rec run e =
-      let null_et = is_null_t e.etype in
       match e.eexpr with 
         | TCast(v, _) ->
+          let null_et = is_null_t e.etype in
           let null_vt = is_null_t v.etype in
-          if is_some null_vt && is_none null_et then
-            handle_unwrap e.etype (run v)
-          else if is_none null_vt && is_some null_et then
-            handle_wrap (run v) (get (is_null_t e.etype))
-          else
-            Type.map_expr run e
+          (match null_vt, null_et with
+            | Some(vt), None ->
+              (match v.eexpr with
+                (* is there an unnecessary cast to Nullable? *)
+                | TCast(v2, _) ->
+                  run { v with etype = e.etype }
+                | _ ->
+                  handle_unwrap e.etype (run v)
+              )
+            | None, Some(et) ->
+              handle_wrap (run v) et
+            | Some(vt), Some(et) when handle_cast ->
+              handle_wrap (gen.ghandle_cast et vt (handle_unwrap vt (run v))) et
+            | _ ->
+              Type.map_expr run e
+          )
         | TField(ef, field) when is_some (is_null_t ef.etype) ->
           let to_t = get (is_null_t ef.etype) in
           { e with eexpr = TField(handle_unwrap to_t (run ef), field) }

+ 125 - 85
gencs.ml

@@ -85,23 +85,22 @@ let is_string t =
     | _ -> false
     
 (* ******************************************* *)
-(* CSharpSpecificSynf *)
+(* CSharpSpecificESynf *)
 (* ******************************************* *)
 
 (*
   
-  Some CSharp-specific syntax filters
+  Some CSharp-specific syntax filters that must run before ExpressionUnwrap
   
   dependencies:
     It must run before ExprUnwrap, as it may not return valid Expr/Statement expressions
     It must run before ClassInstance, as it will detect expressions that need unchanged TTypeExpr
   
 *)
-
-module CSharpSpecificSynf =
+module CSharpSpecificESynf =
 struct
 
-  let name = "csharp_specific"
+  let name = "csharp_specific_e"
   
   let priority = solve_deps name [DBefore ExpressionUnwrap.priority; DBefore ClassInstance.priority; DAfter TryCatchWrapper.priority]
   
@@ -113,32 +112,11 @@ struct
   let traverse gen runtime_cl =
     let basic = gen.gcon.basic in
     let uint = match ( get_type gen ([], "UInt") ) with | TTypeDecl t -> t | _ -> assert false in
-    let tchar = match ( get_type gen (["cs"], "Char16") ) with | TTypeDecl t -> t | _ -> assert false in
-    let tchar = TType(tchar,[]) in
-    let string_ext = get_cl ( get_type gen (["haxe";"lang"], "StringExt")) in
     
     let is_var = alloc_var "__is__" t_dynamic in
-    let block = ref [] in
-    let is_string t = match follow t with | TInst({ cl_path = ([], "String") }, []) -> true | _ -> false in
-    
-    let clstring = match basic.tstring with | TInst(cl,_) -> cl | _ -> assert false in
-    
-    let is_struct t = (* not basic type *)
-      match follow t with
-        | TInst(cl, _) when has_meta ":struct" cl.cl_meta -> true
-        | _ -> false
-    in
     
     let rec run e =
       match e.eexpr with 
-        | TBlock bl ->
-          let old_block = !block in
-          block := [];
-          List.iter (fun e -> let e = run e in block := e :: !block) bl;
-          let ret = List.rev !block in
-          block := old_block;
-          
-          { e with eexpr = TBlock(ret) }
         (* Std.is() *)
         | TCall(
             { eexpr = TField( { eexpr = TTypeExpr ( TClassDecl { cl_path = ([], "Std") } ) }, "is") },
@@ -179,6 +157,96 @@ struct
               mk_is obj md
           )
         (* end Std.is() *)
+                  
+        | TBinop( Ast.OpUShr, e1, e2 ) ->
+          mk_cast e.etype { e with eexpr = TBinop( Ast.OpShr, mk_cast (TType(uint,[])) (run e1), run e2 ) }
+        
+        | TBinop( Ast.OpAssignOp Ast.OpUShr, e1, e2 ) ->
+          let mk_ushr local = 
+            { e with eexpr = TBinop(Ast.OpAssign, local, run { e with eexpr = TBinop(Ast.OpUShr, local, run e2) }) }
+          in
+          
+          let mk_local obj =
+            let var = mk_temp gen "opUshr" obj.etype in
+            let added = { obj with eexpr = TVars([var, Some(obj)]); etype = basic.tvoid } in
+            let local = mk_local var obj.epos in
+            local, added
+          in
+          
+          let e1 = run e1 in
+          
+          let ret = match e1.eexpr with
+            | TField({ eexpr = TLocal _ }, _)
+            | TField({ eexpr = TTypeExpr _ }, _)
+            | TArray({ eexpr = TLocal _ }, _)
+            | TLocal(_) -> 
+              mk_ushr e1
+            | TField(fexpr, field) ->
+              let local, added = mk_local fexpr in
+              { e with eexpr = TBlock([ added; mk_ushr { e1 with eexpr = TField(local, field) }  ]); }
+            | TArray(ea1, ea2) ->
+              let local, added = mk_local ea1 in
+              { e with eexpr = TBlock([ added; mk_ushr { e1 with eexpr = TArray(local, ea2) }  ]); }
+            | _ -> (* invalid left-side expression *)
+              assert false
+          in
+          
+          ret
+        
+        | _ -> Type.map_expr run e
+    in
+    run
+  
+  let configure gen (mapping_func:texpr->texpr) =
+    let map e = Some(mapping_func e) in
+    gen.gsyntax_filters#add ~name:name ~priority:(PCustom priority) map
+  
+end;;
+
+(* ******************************************* *)
+(* CSharpSpecificSynf *)
+(* ******************************************* *)
+
+(*
+  
+  Some CSharp-specific syntax filters  that can run after ExprUnwrap
+  
+  dependencies:
+    Runs after ExprUnwrap
+  
+*)
+
+module CSharpSpecificSynf =
+struct
+
+  let name = "csharp_specific"
+  
+  let priority = solve_deps name [ DAfter ExpressionUnwrap.priority; DAfter ObjectDeclMap.priority; DAfter ArrayDeclSynf.priority; DBefore IntDivisionSynf.priority; DAfter HardNullableSynf.priority ]
+  
+  let get_cl_from_t t =
+    match follow t with
+      | TInst(cl,_) -> cl
+      | _ -> assert false
+  
+  let traverse gen runtime_cl =
+    let basic = gen.gcon.basic in
+    let tchar = match ( get_type gen (["cs"], "Char16") ) with | TTypeDecl t -> t | _ -> assert false in
+    let tchar = TType(tchar,[]) in
+    let string_ext = get_cl ( get_type gen (["haxe";"lang"], "StringExt")) in
+    
+    let is_string t = match follow t with | TInst({ cl_path = ([], "String") }, []) -> true | _ -> false in
+    
+    let clstring = match basic.tstring with | TInst(cl,_) -> cl | _ -> assert false in
+    
+    let is_struct t = (* not basic type *)
+      match follow t with
+        | TInst(cl, _) when has_meta ":struct" cl.cl_meta -> true
+        | _ -> false
+    in
+    
+    
+    let rec run e =
+      match e.eexpr with 
         
         (* Std.int() *)
         | TCall(
@@ -231,41 +299,6 @@ struct
         | TCast(expr, _) when is_string e.etype ->
           (*{ e with eexpr = TCall( { expr with eexpr = TField(expr, "ToString"); etype = TFun([], basic.tstring) }, [] ) }*)
           mk_paren { e with eexpr = TBinop(Ast.OpAdd, run expr, { e with eexpr = TConst(TString("")) }) }
-          
-        | TBinop( Ast.OpUShr, e1, e2 ) ->
-          mk_cast e.etype { e with eexpr = TBinop( Ast.OpShr, mk_cast (TType(uint,[])) (run e1), run e2 ) }
-        
-        | TBinop( Ast.OpAssignOp Ast.OpUShr, e1, e2 ) ->
-          let mk_ushr local = 
-            { e with eexpr = TBinop(Ast.OpAssign, local, run { e with eexpr = TBinop(Ast.OpUShr, local, run e2) }) }
-          in
-          
-          let mk_local obj =
-            let var = mk_temp gen "opUshr" obj.etype in
-            let added = { obj with eexpr = TVars([var, Some(obj)]); etype = basic.tvoid } in
-            let local = mk_local var obj.epos in
-            local, added
-          in
-          
-          let e1 = run e1 in
-          
-          let ret = match e1.eexpr with
-            | TField({ eexpr = TLocal _ }, _)
-            | TField({ eexpr = TTypeExpr _ }, _)
-            | TArray({ eexpr = TLocal _ }, _)
-            | TLocal(_) -> 
-              mk_ushr e1
-            | TField(fexpr, field) ->
-              let local, added = mk_local fexpr in
-              { e with eexpr = TBlock([ added; mk_ushr { e1 with eexpr = TField(local, field) }  ]); }
-            | TArray(ea1, ea2) ->
-              let local, added = mk_local ea1 in
-              { e with eexpr = TBlock([ added; mk_ushr { e1 with eexpr = TArray(local, ea2) }  ]); }
-            | _ -> (* invalid left-side expression *)
-              assert false
-          in
-          
-          ret
         
         | TBinop( (Ast.OpNotEq as op), e1, e2)
         | TBinop( (Ast.OpEq as op), e1, e2) when is_string e1.etype || is_string e2.etype ->
@@ -416,28 +449,6 @@ let reserved = let res = Hashtbl.create 120 in
   
 let dynamic_anon = TAnon( { a_fields = PMap.empty; a_status = ref Closed } )
   
-(* 
-  On hxcs, the only type parameters allowed to be declared are the basic c# types.
-  That's made like this to avoid casting problems when type parameters in this case
-  add nothing to performance, since the memory layout is always the same.
-  
-  To avoid confusion between Generic<Dynamic> (which has a different meaning in hxcs AST), 
-  all those references are using dynamic_anon, which means Generic<{}>
-*)
-let change_param_type md tl =
-  let is_hxgeneric = (TypeParams.RealTypeParams.is_hxgeneric md) in
-  let ret t = match is_hxgeneric, follow t with
-    | false, _ -> t
-    | true, TInst ( { cl_kind = KTypeParameter }, _ ) -> t
-    | true, TInst _ | true, TEnum _ when is_cs_basic_type t -> t
-    | true, TDynamic _ -> t
-    | true, _ -> dynamic_anon
-  in
-  if is_hxgeneric && List.exists (fun t -> match follow t with | TDynamic _ -> true | _ -> false) tl then 
-    List.map (fun _ -> t_dynamic) tl 
-  else 
-    List.map ret tl 
-  
 let rec get_class_modifiers meta cl_type cl_access cl_modifiers =
   match meta with
     | [] -> cl_type,cl_access,cl_modifiers
@@ -542,6 +553,34 @@ let configure gen =
       | TAnon _ -> dynamic_anon
       | TFun _ -> TInst(fn_cl,[])
       | _ -> t_dynamic
+  and
+  
+  (* 
+    On hxcs, the only type parameters allowed to be declared are the basic c# types.
+    That's made like this to avoid casting problems when type parameters in this case
+    add nothing to performance, since the memory layout is always the same.
+    
+    To avoid confusion between Generic<Dynamic> (which has a different meaning in hxcs AST), 
+    all those references are using dynamic_anon, which means Generic<{}>
+  *)
+  change_param_type md tl =
+    let is_hxgeneric = (TypeParams.RealTypeParams.is_hxgeneric md) in
+    let ret t = match is_hxgeneric, real_type t with
+      | false, _ -> t
+      (*
+        Because Null<> types need a special compiler treatment for many operations (e.g. boxing/unboxing),
+        Null<> type parameters will be transformed into Dynamic.
+      *)
+      | true, TInst ( { cl_path = (["haxe";"lang"], "Null") }, _ ) -> dynamic_anon
+      | true, TInst ( { cl_kind = KTypeParameter }, _ ) -> t
+      | true, TInst _ | true, TEnum _ when is_cs_basic_type t -> t
+      | true, TDynamic _ -> t
+      | true, _ -> dynamic_anon
+    in
+    if is_hxgeneric && List.exists (fun t -> match follow t with | TDynamic _ -> true | _ -> false) tl then 
+      List.map (fun _ -> t_dynamic) tl 
+    else 
+      List.map ret tl 
   in
   
   let is_dynamic t = match real_type t with
@@ -1293,10 +1332,9 @@ let configure gen =
             epos = v.epos
           }
         | _ -> 
-          { eexpr = TNew(null_t, [t], [mk_cast t v; { eexpr = TConst(TBool has_value); etype = gen.gcon.basic.tbool; epos = v.epos } ]); etype = TInst(null_t, [t]); epos = v.epos }
+          { eexpr = TNew(null_t, [t], [gen.ghandle_cast t v.etype v; { eexpr = TConst(TBool has_value); etype = gen.gcon.basic.tbool; epos = v.epos } ]); etype = TInst(null_t, [t]); epos = v.epos }
     ) 
     (fun e ->
-      trace (debug_expr e);
       {
         eexpr = TCall({
             eexpr = TField(mk_paren e, "toDynamic");
@@ -1308,6 +1346,7 @@ let configure gen =
       }
     )
     true
+    true
   );
   
   IteratorsInterface.configure gen (fun e -> e);
@@ -1625,6 +1664,7 @@ let configure gen =
   DefaultArguments.configure gen (DefaultArguments.traverse gen);
   
   CSharpSpecificSynf.configure gen (CSharpSpecificSynf.traverse gen runtime_cl);
+  CSharpSpecificESynf.configure gen (CSharpSpecificESynf.traverse gen runtime_cl);
   
   run_filters gen;
   (* after the filters have been run, add all hashed fields to FieldLookup *)

+ 0 - 10
genjava.ml

@@ -134,19 +134,9 @@ struct
     let float_cl = get_cl ( get_type gen (["java";"lang"], "Double")) in
     
     let is_var = alloc_var "__is__" t_dynamic in
-      let block = ref [] in
     
     let rec run e =
       match e.eexpr with 
-        | TBlock bl ->
-          let old_block = !block in
-          block := [];
-          List.iter (fun e -> let e = run e in block := e :: !block) bl;
-          let ret = List.rev !block in
-          block := old_block;
-          
-          { e with eexpr = TBlock(ret) }
-        
         (* Math changes *)
         | TField( { eexpr = TTypeExpr( TClassDecl( { cl_path = (["java";"lang"], "Math") }) ) }, "NaN" ) ->
           mk_static_field_access_infer float_cl "NaN" e.epos []

+ 0 - 5
std/cs/_std/haxe/lang/Null.hx

@@ -1,10 +1,5 @@
 package haxe.lang;
 
-/**
- * ...
- * @author waneck
- */
-
 @:struct @:nativegen @:native("haxe.lang.Null") private class Nullable<T>
 {
 	

+ 6 - 0
std/cs/_std/haxe/lang/Runtime.hx

@@ -85,6 +85,12 @@ package haxe.lang;
 				}
 			}
 			
+			System.ValueType v1v = v1 as System.ValueType;
+			if (v1v != null)
+			{
+				return v1.Equals(v2);
+			}
+			
 			//add here haxe.lang.Equatable test
 			
 			return false;