Browse Source

added optional name for anonymous types in typer.

Nicolas Cannasse 19 years ago
parent
commit
c299b7f8e1
3 changed files with 19 additions and 16 deletions
  1. 1 1
      genxml.ml
  2. 13 10
      type.ml
  3. 5 5
      typer.ml

+ 1 - 1
genxml.ml

@@ -47,7 +47,7 @@ let rec gen_type t =
 	| TEnum (e,params) -> node "e" [gen_path e.e_path] (List.map gen_type params)
 	| TInst (c,params) -> node "c" [gen_path c.cl_path] (List.map gen_type params)
 	| TFun (args,r) -> node "f" ["a",String.concat ":" (List.map fst args)] (List.map gen_type (List.map snd args @ [r]))
-	| TAnon fields -> node "a" [] (pmap (fun f -> node f.cf_name [] [gen_type f.cf_type]) fields)
+	| TAnon (fields,_) -> node "a" [] (pmap (fun f -> node f.cf_name [] [gen_type f.cf_type]) fields)
 	| TDynamic t2 -> node "d" [] (if t == t2 then [] else [gen_type t2])
 	| TLazy f -> gen_type (!f())
 

+ 13 - 10
type.ml

@@ -24,7 +24,7 @@ type t =
 	| TEnum of tenum * t list
 	| TInst of tclass * t list
 	| TFun of (string * t) list * t
-	| TAnon of (string, tclass_field) PMap.t
+	| TAnon of (string, tclass_field) PMap.t * string option
 	| TDynamic of t
 	| TLazy of (unit -> t) ref
 
@@ -165,9 +165,12 @@ let rec s_type ctx t =
 		"Void -> " ^ s_type ctx t
 	| TFun (l,t) ->
 		String.concat " -> " (List.map (fun (s,t) -> s ^ " : " ^ match t with TFun _ -> "(" ^ s_type ctx t ^ ")" | _ -> s_type ctx t) l) ^ " -> " ^ s_type ctx t
-	| TAnon fl ->
-		let fl = PMap.fold (fun f acc -> (" " ^ f.cf_name ^ " : " ^ s_type ctx f.cf_type) :: acc) fl [] in
-		"{" ^ String.concat "," fl ^ " }";
+	| TAnon (fl,name) ->
+		(match name with
+		| Some s -> s
+		| None ->
+			let fl = PMap.fold (fun f acc -> (" " ^ f.cf_name ^ " : " ^ s_type ctx f.cf_type) :: acc) fl [] in
+			"{" ^ String.concat "," fl ^ " }");
 	| TDynamic t2 ->
 		"Dynamic" ^ s_type_params ctx (if t == t2 then [] else [t2])
 	| TLazy f ->		
@@ -215,7 +218,7 @@ let rec link e a b =
 				loop t2
 		| TLazy f ->
 			loop (!f())
-		| TAnon fl ->
+		| TAnon (fl,_) ->
 			try
 				PMap.iter (fun _ f -> if loop f.cf_type then raise Exit) fl;
 				false
@@ -264,8 +267,8 @@ let apply_params cparams params t =
 				TInst (c,List.map loop tl))
 		| TFun (tl,r) ->
 			TFun (List.map (fun (s,t) -> s, loop t) tl,loop r)
-		| TAnon fl ->
-			TAnon (PMap.map (fun f -> { f with cf_type = loop f.cf_type }) fl)
+		| TAnon (fl,name) ->
+			TAnon (PMap.map (fun f -> { f with cf_type = loop f.cf_type }) fl,name)
 		| TLazy f ->
 			loop (!f())
 		| TDynamic t2 ->
@@ -294,7 +297,7 @@ let rec type_eq param a b =
 		type_eq param r1 r2 && List.for_all2 (fun (_,t1) (_,t2) -> type_eq param t1 t2) l1 l2
 	| TDynamic a , TDynamic b ->
 		type_eq param a b
-	| TAnon fl1, TAnon fl2 ->
+	| TAnon (fl1,_), TAnon (fl2,_) ->
 		let keys1 = PMap.fold (fun f acc -> f :: acc) fl1 [] in
 		let keys2 = PMap.fold (fun f acc -> f :: acc) fl2 [] in
 		(try
@@ -336,7 +339,7 @@ let rec unify a b =
 		loop c1 tl1
 	| TFun (l1,r1) , TFun (l2,r2) when List.length l1 = List.length l2 ->
 		unify r1 r2 && List.for_all2 (fun (_,t1) (_,t2) -> unify t1 t2) l2 l1 (* contravariance *)
-	| TInst (c,tl) , TAnon fl ->
+	| TInst (c,tl) , TAnon (fl,_) ->
 		(try
 			PMap.iter (fun n f2 ->
 				let f1 = PMap.find n c.cl_fields in				
@@ -345,7 +348,7 @@ let rec unify a b =
 			true
 		with
 			Not_found -> false)
-	| TAnon fl1 , TAnon fl2 ->
+	| TAnon (fl1,_) , TAnon (fl2,_) ->
 		(try
 			PMap.iter (fun n f2 ->
 				let f1 = PMap.find n fl1 in

+ 5 - 5
typer.ml

@@ -148,7 +148,7 @@ and load_type ctx p t =
 				cf_doc = None;
 			} acc
 		in
-		TAnon (List.fold_left loop PMap.empty l)
+		TAnon (List.fold_left loop PMap.empty l,None)
 	| TPFunction (args,r) ->
 		match args with
 		| [TPNormal { tpackage = []; tparams = []; tname = "Void" }] ->
@@ -368,7 +368,7 @@ let type_type ctx tpath p =
 			else
 				acc
 		) c.cl_statics PMap.empty in
-		mk (TType (TClassDecl c)) (TAnon fl) p
+		mk (TType (TClassDecl c)) (TAnon (fl,Some ("#" ^ s_type_path c.cl_path))) p
 	| TEnumDecl e ->
 		let types = List.map (fun _ -> mk_mono()) e.e_types in
 		let fl = PMap.fold (fun f acc -> 
@@ -380,7 +380,7 @@ let type_type ctx tpath p =
 				cf_expr = None;
 			} acc
 		) e.e_constrs PMap.empty in
-		mk (TType (TEnumDecl e)) (TAnon fl) p
+		mk (TType (TEnumDecl e)) (TAnon (fl,Some ("#" ^ s_type_path e.e_path))) p
 
 let type_constant ctx c p =
 	match c with
@@ -489,7 +489,7 @@ let type_field ctx t i p =
 			no_field())
 	| TDynamic t ->
 		t
-	| TAnon fl ->
+	| TAnon (fl,_) ->
 		(try 
 			let f = PMap.find i fl in
 			if not f.cf_public && not ctx.untyped then error ("Cannot access to private field " ^ i) p;
@@ -702,7 +702,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 			((f,e) :: l, PMap.add f cf acc)
 		in
 		let fields , types = List.fold_left loop ([],PMap.empty) fl in
-		mk (TObjectDecl fields) (TAnon types) p
+		mk (TObjectDecl fields) (TAnon (types,None)) p
 	| EArrayDecl el ->
 		let t , pt = t_array ctx in
 		let dyn = ref ctx.untyped in