Browse Source

type without completion optimization if first completion failed (fixed issue #1286)

Simon Krajewski 12 years ago
parent
commit
c8b1365f50
6 changed files with 16 additions and 23 deletions
  1. 1 1
      main.ml
  2. 1 15
      optimizer.ml
  3. 1 1
      std/Reflect.hx
  4. 2 0
      typecore.ml
  5. 10 4
      typeload.ml
  6. 1 2
      typer.ml

+ 1 - 1
main.ml

@@ -1319,7 +1319,7 @@ with
 			fields
 			fields
 		in
 		in
 		complete_fields fields
 		complete_fields fields
-	| Typer.DisplayTypes tl ->
+	| Typecore.DisplayTypes tl ->
 		let ctx = print_context() in
 		let ctx = print_context() in
 		let b = Buffer.create 0 in
 		let b = Buffer.create 0 in
 		List.iter (fun t ->
 		List.iter (fun t ->

+ 1 - 15
optimizer.ml

@@ -966,7 +966,7 @@ let rec make_constant_expression ctx e =
 	We will look at local variables in the form   var v = new ....
 	We will look at local variables in the form   var v = new ....
 	we only capture the ones which have constructors marked as inlined
 	we only capture the ones which have constructors marked as inlined
 	then we make sure that these locals are no more referenced except for fields accesses
 	then we make sure that these locals are no more referenced except for fields accesses
-	
+
 	Second pass :
 	Second pass :
 	We replace the variables by their fields lists, and the corresponding fields accesses as well
 	We replace the variables by their fields lists, and the corresponding fields accesses as well
 *)
 *)
@@ -1226,18 +1226,4 @@ let optimize_completion_expr e =
 	in
 	in
 	(try loop e with Return e -> e)
 	(try loop e with Return e -> e)
 
 
-let optimize_completion c fields =
-	let cp = !Parser.resume_display in
-	List.map (fun f ->
-		if cp.pmin = 0 || (f.cff_pos.pmin <= cp.pmin && f.cff_pos.pmax >= cp.pmax) then
-			let k = try (match f.cff_kind with
-				| FVar (t,Some e) -> FVar (t,Some (optimize_completion_expr e))
-				| FFun fn -> (match optimize_completion_expr (EFunction (None,fn),f.cff_pos) with (EFunction (None,fn),_) -> FFun fn | e -> FFun({ fn with f_expr = Some e; f_args = []; }))
-				| k -> k
-			) with Exit -> f.cff_kind in
-			{ f with cff_kind = k }
-		else
-			f
-	) fields
-
 (* ---------------------------------------------------------------------- *)
 (* ---------------------------------------------------------------------- *)

+ 1 - 1
std/Reflect.hx

@@ -89,7 +89,7 @@ extern class Reflect {
 		Returns the fields of structure [o].
 		Returns the fields of structure [o].
 		
 		
 		This method is only guaranteed to work on anonymous structures. Refer to
 		This method is only guaranteed to work on anonymous structures. Refer to
-		[Type.getInstancefields()] for a function supporting class instances.
+		[Type.getInstanceFields()] for a function supporting class instances.
 		
 		
 		If [o] is null, the result is unspecified.
 		If [o] is null, the result is unspecified.
 	**/
 	**/

+ 2 - 0
typecore.ml

@@ -132,6 +132,8 @@ exception Forbid_package of (string * path * pos) * pos list * string
 
 
 exception Error of error_msg * pos
 exception Error of error_msg * pos
 
 
+exception DisplayTypes of t list
+
 exception DisplayPosition of Ast.pos list
 exception DisplayPosition of Ast.pos list
 
 
 let make_call_ref : (typer -> texpr -> texpr list -> t -> pos -> texpr) ref = ref (fun _ _ _ _ _ -> assert false)
 let make_call_ref : (typer -> texpr -> texpr list -> t -> pos -> texpr) ref = ref (fun _ _ _ _ _ -> assert false)

+ 10 - 4
typeload.ml

@@ -968,7 +968,7 @@ let type_function_params ctx fd fname p =
 	) fd.f_params;
 	) fd.f_params;
 	!params
 	!params
 
 
-let type_function ctx args ret fmode f p =
+let type_function ctx args ret fmode f do_display p =
 	let locals = save_locals ctx in
 	let locals = save_locals ctx in
 	let fargs = List.map (fun (n,c,t) ->
 	let fargs = List.map (fun (n,c,t) ->
 		let c = (match c with
 		let c = (match c with
@@ -989,7 +989,12 @@ let type_function ctx args ret fmode f p =
 	ctx.curfun <- fmode;
 	ctx.curfun <- fmode;
 	ctx.ret <- ret;
 	ctx.ret <- ret;
 	ctx.opened <- [];
 	ctx.opened <- [];
-	let e = type_expr ctx (match f.f_expr with None -> error "Function body required" p | Some e -> e) NoValue in
+	let e = match f.f_expr with None -> error "Function body required" p | Some e -> e in
+	let e = if not do_display then type_expr ctx e NoValue else try
+		type_expr ctx (Optimizer.optimize_completion_expr e) NoValue
+	with DisplayTypes [TMono _] | Parser.TypePath (_,None) ->
+		type_expr ctx e NoValue
+	in
 	let rec loop e =
 	let rec loop e =
 		match e.eexpr with
 		match e.eexpr with
 		| TReturn (Some _) -> raise Exit
 		| TReturn (Some _) -> raise Exit
@@ -1264,7 +1269,7 @@ let init_class ctx c p context_init herits fields =
 
 
 	let display_file = if ctx.com.display then Common.unique_full_path p.pfile = (!Parser.resume_display).pfile else false in
 	let display_file = if ctx.com.display then Common.unique_full_path p.pfile = (!Parser.resume_display).pfile else false in
 
 
-	let fields = if not display_file || Common.defined ctx.com Define.NoCOpt then fields else Optimizer.optimize_completion c fields in
+	let cp = !Parser.resume_display in
 
 
 	let delayed_expr = ref [] in
 	let delayed_expr = ref [] in
 
 
@@ -1528,7 +1533,8 @@ let init_class ctx c p context_init herits fields =
 						| _ ->
 						| _ ->
 							if constr then FunConstructor else if stat then FunStatic else FunMember
 							if constr then FunConstructor else if stat then FunStatic else FunMember
 					) in
 					) in
-					let e , fargs = type_function ctx args ret fmode fd p in
+					let display_field = f.cff_pos.pmin <= cp.pmin && f.cff_pos.pmax >= cp.pmax in
+					let e , fargs = type_function ctx args ret fmode fd display_field p in
 					let f = {
 					let f = {
 						tf_args = fargs;
 						tf_args = fargs;
 						tf_type = ret;
 						tf_type = ret;

+ 1 - 2
typer.ml

@@ -37,7 +37,6 @@ type access_mode =
 	| MSet
 	| MSet
 	| MCall
 	| MCall
 
 
-exception DisplayTypes of t list
 exception DisplayFields of (string * t * documentation) list
 exception DisplayFields of (string * t * documentation) list
 exception DisplayMetadata of metadata_entry list
 exception DisplayMetadata of metadata_entry list
 exception WithTypeError of unify_error list * pos
 exception WithTypeError of unify_error list * pos
@@ -2821,7 +2820,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
 				if v.[0] = '$' then display_error ctx "Variables names starting with a dollar are not allowed" p;
 				if v.[0] = '$' then display_error ctx "Variables names starting with a dollar are not allowed" p;
 				Some (add_local ctx v ft)
 				Some (add_local ctx v ft)
 		) in
 		) in
-		let e , fargs = Typeload.type_function ctx args rt (match ctx.curfun with FunStatic -> FunStatic | _ -> FunMemberLocal) f p in
+		let e , fargs = Typeload.type_function ctx args rt (match ctx.curfun with FunStatic -> FunStatic | _ -> FunMemberLocal) f false p in
 		ctx.type_params <- old;
 		ctx.type_params <- old;
 		let f = {
 		let f = {
 			tf_args = fargs;
 			tf_args = fargs;