Browse Source

added function parameters names inside type.

Nicolas Cannasse 19 years ago
parent
commit
0802182c5a
5 changed files with 28 additions and 30 deletions
  1. 2 6
      genneko.ml
  2. 0 5
      genswf8.ml
  3. 9 2
      genxml.ml
  4. 6 6
      type.ml
  5. 11 11
      typer.ml

+ 2 - 6
genneko.ml

@@ -64,10 +64,6 @@ let array p el =
 let pmap_list f p =
 let pmap_list f p =
 	PMap.fold (fun v acc -> f v :: acc) p []
 	PMap.fold (fun v acc -> f v :: acc) p []
 
 
-let nparams l =
-	let pcount = ref 0 in
-	List.map (fun _ -> incr pcount; "p" ^ string_of_int (!pcount)) l
-
 let gen_type_path p (path,t) =
 let gen_type_path p (path,t) =
 	match path with
 	match path with
 	| [] -> ident p t
 	| [] -> ident p t
@@ -271,7 +267,7 @@ let gen_class c =
 	| Some f ->
 	| Some f ->
 		(match follow f.cf_type with
 		(match follow f.cf_type with
 		| TFun (args,_) ->
 		| TFun (args,_) ->
-			let params = nparams args in
+			let params = List.map fst args in
 			gen_method p f ["new",(EFunction (params,(EBlock [
 			gen_method p f ["new",(EFunction (params,(EBlock [
 				(EVars ["@o",Some (call p (builtin p "new") [null p])],p);
 				(EVars ["@o",Some (call p (builtin p "new") [null p])],p);
 				(call p (builtin p "objsetproto") [ident p "@o"; clpath]);
 				(call p (builtin p "objsetproto") [ident p "@o"; clpath]);
@@ -315,7 +311,7 @@ let gen_enum_constr c =
 	let p = pos c.ef_pos in
 	let p = pos c.ef_pos in
 	c.ef_name , (match follow c.ef_type with
 	c.ef_name , (match follow c.ef_type with
 		| TFun (params,_) -> 
 		| TFun (params,_) -> 
-			let params = nparams params in
+			let params = List.map fst params in
 			(EFunction (params,array p (str p c.ef_name :: List.map (ident p) params)),p)
 			(EFunction (params,array p (str p c.ef_name :: List.map (ident p) params)),p)
 		| _ ->
 		| _ ->
 			array p [str p c.ef_name]
 			array p [str p c.ef_name]

+ 0 - 5
genswf8.ml

@@ -1000,11 +1000,6 @@ let gen_enum_field ctx f =
 	push ctx [VReg 0; VStr f.ef_name];
 	push ctx [VReg 0; VStr f.ef_name];
 	(match follow f.ef_type with
 	(match follow f.ef_type with
 	| TFun (args,r) ->
 	| TFun (args,r) ->
-		let n = ref 0 in
-		let args = List.map (fun t ->
-			incr n;
-			"p" ^ string_of_int (!n), t
-		) args in
 		let e = mk (TReturn (Some (mk (TArrayDecl (ename :: 
 		let e = mk (TReturn (Some (mk (TArrayDecl (ename :: 
 			List.map (fun (n,t) -> mk (TLocal n) t Ast.null_pos) args
 			List.map (fun (n,t) -> mk (TLocal n) t Ast.null_pos) args
 		)) r Ast.null_pos))) (mk_mono()) Ast.null_pos in
 		)) r Ast.null_pos))) (mk_mono()) Ast.null_pos in

+ 9 - 2
genxml.ml

@@ -46,14 +46,21 @@ let rec gen_type t =
 	| TMono m -> (match !m with None -> tag "unknown" | Some t -> gen_type t)
 	| TMono m -> (match !m with None -> tag "unknown" | Some t -> gen_type t)
 	| TEnum (e,params) -> node "e" [gen_path e.e_path] (List.map gen_type params)
 	| 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)
 	| TInst (c,params) -> node "c" [gen_path c.cl_path] (List.map gen_type params)
-	| TFun (args,r) -> node "f" [] (List.map gen_type (args @ [r]))
+	| 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])
 	| TDynamic t2 -> node "d" [] (if t == t2 then [] else [gen_type t2])
 	| TLazy f -> gen_type (!f())
 	| TLazy f -> gen_type (!f())
 
 
 let gen_constr e =
 let gen_constr e =
 	let doc = gen_doc_opt e.ef_doc in
 	let doc = gen_doc_opt e.ef_doc in
-	node e.ef_name [] (match follow e.ef_type with TFun (args,_) -> List.map gen_type args @ doc | _ -> doc)
+	let args, t = (match follow e.ef_type with 
+		| TFun (args,_) ->
+			["a",String.concat ":" (List.map fst args)] ,
+			List.map (fun (_,t) -> gen_type t) args @ doc
+		| _ -> 
+			[] , doc
+	) in
+	node e.ef_name args t 
 
 
 let gen_field att f =
 let gen_field att f =
 	let att = (match f.cf_expr with None -> att | Some e -> ("line",string_of_int (Lexer.get_error_line e.epos)) :: att) in
 	let att = (match f.cf_expr with None -> att | Some e -> ("line",string_of_int (Lexer.get_error_line e.epos)) :: att) in

+ 6 - 6
type.ml

@@ -23,7 +23,7 @@ type t =
 	| TMono of t option ref
 	| TMono of t option ref
 	| TEnum of tenum * t list
 	| TEnum of tenum * t list
 	| TInst of tclass * t list
 	| TInst of tclass * t list
-	| TFun of t list * t
+	| TFun of (string * t) list * t
 	| TAnon of (string, tclass_field) PMap.t
 	| TAnon of (string, tclass_field) PMap.t
 	| TDynamic of t
 	| TDynamic of t
 	| TLazy of (unit -> t) ref
 	| TLazy of (unit -> t) ref
@@ -164,7 +164,7 @@ let rec s_type ctx t =
 	| TFun ([],t) ->
 	| TFun ([],t) ->
 		"Void -> " ^ s_type ctx t
 		"Void -> " ^ s_type ctx t
 	| TFun (l,t) ->
 	| TFun (l,t) ->
-		String.concat " -> " (List.map (fun t -> match t with TFun _ -> "(" ^ s_type ctx t ^ ")" | _ -> s_type ctx t) l) ^ " -> " ^ s_type ctx 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 ->
 	| TAnon fl ->
 		let fl = PMap.fold (fun f acc -> (" " ^ f.cf_name ^ " : " ^ s_type ctx f.cf_type) :: acc) fl [] in
 		let fl = PMap.fold (fun f acc -> (" " ^ f.cf_name ^ " : " ^ s_type ctx f.cf_type) :: acc) fl [] in
 		"{" ^ String.concat "," fl ^ " }";
 		"{" ^ String.concat "," fl ^ " }";
@@ -207,7 +207,7 @@ let rec link e a b =
 		| TMono t -> (match !t with None -> false | Some t -> loop t)
 		| TMono t -> (match !t with None -> false | Some t -> loop t)
 		| TEnum (_,tl) -> List.exists loop tl
 		| TEnum (_,tl) -> List.exists loop tl
 		| TInst (_,tl) -> List.exists loop tl
 		| TInst (_,tl) -> List.exists loop tl
-		| TFun (tl,t) -> List.exists loop tl || loop t
+		| TFun (tl,t) -> List.exists (fun (_,t) -> loop t) tl || loop t
 		| TDynamic t2 ->
 		| TDynamic t2 ->
 			if t == t2 then
 			if t == t2 then
 				false
 				false
@@ -263,7 +263,7 @@ let apply_params cparams params t =
 			| _ ->
 			| _ ->
 				TInst (c,List.map loop tl))
 				TInst (c,List.map loop tl))
 		| TFun (tl,r) ->
 		| TFun (tl,r) ->
-			TFun (List.map loop tl,loop r)
+			TFun (List.map (fun (s,t) -> s, loop t) tl,loop r)
 		| TAnon fl ->
 		| TAnon fl ->
 			TAnon (PMap.map (fun f -> { f with cf_type = loop f.cf_type }) fl)
 			TAnon (PMap.map (fun f -> { f with cf_type = loop f.cf_type }) fl)
 		| TLazy f ->
 		| TLazy f ->
@@ -291,7 +291,7 @@ let rec type_eq param a b =
 	| TInst (c1,tl1) , TInst (c2,tl2) -> 
 	| TInst (c1,tl1) , TInst (c2,tl2) -> 
 		c1 == c2 && List.for_all2 (type_eq param) tl1 tl2
 		c1 == c2 && List.for_all2 (type_eq param) tl1 tl2
 	| TFun (l1,r1) , TFun (l2,r2) when List.length l1 = List.length l2 ->
 	| TFun (l1,r1) , TFun (l2,r2) when List.length l1 = List.length l2 ->
-		type_eq param r1 r2 && List.for_all2 (type_eq param) l1 l2
+		type_eq param r1 r2 && List.for_all2 (fun (_,t1) (_,t2) -> type_eq param t1 t2) l1 l2
 	| TDynamic a , TDynamic b ->
 	| TDynamic a , TDynamic b ->
 		type_eq param a b
 		type_eq param a b
 	| TAnon fl1, TAnon fl2 ->
 	| TAnon fl1, TAnon fl2 ->
@@ -335,7 +335,7 @@ let rec unify a b =
 		in
 		in
 		loop c1 tl1
 		loop c1 tl1
 	| TFun (l1,r1) , TFun (l2,r2) when List.length l1 = List.length l2 ->
 	| TFun (l1,r1) , TFun (l2,r2) when List.length l1 = List.length l2 ->
-		unify r1 r2 && List.for_all2 unify l2 l1 (* contravariance *)
+		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
 		(try
 			PMap.iter (fun n f2 ->
 			PMap.iter (fun n f2 ->

+ 11 - 11
typer.ml

@@ -154,7 +154,7 @@ and load_type ctx p t =
 		| [TPNormal { tpackage = []; tparams = []; tname = "Void" }] ->
 		| [TPNormal { tpackage = []; tparams = []; tname = "Void" }] ->
 			TFun ([],load_type ctx p r)
 			TFun ([],load_type ctx p r)
 		| _ ->
 		| _ ->
-			TFun (List.map (load_type ctx p) args,load_type ctx p r)
+			TFun (List.map (fun t -> "",load_type ctx p t) args,load_type ctx p r)
 
 
 let load_type_opt ctx p t =
 let load_type_opt ctx p t =
 	match t with
 	match t with
@@ -422,7 +422,7 @@ let type_matching ctx (enum,params) (e,p) ecases =
 		let args = (match c.ef_type with
 		let args = (match c.ef_type with
 			| TFun (l,_) -> 
 			| TFun (l,_) -> 
 				if List.length l <> List.length el then needs (List.length l);
 				if List.length l <> List.length el then needs (List.length l);
-				List.map (apply_params enum.e_types params) l
+				List.map (fun (_,t) -> apply_params enum.e_types params t) l
 			| TEnum _ -> error "This constructor does not take any paramter" p
 			| TEnum _ -> error "This constructor does not take any paramter" p
 			| _ -> assert false
 			| _ -> assert false
 		) in
 		) in
@@ -839,7 +839,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 			(match apply_params c.cl_types params f.cf_type with
 			(match apply_params c.cl_types params f.cf_type with
 			| TFun (args,r) ->
 			| TFun (args,r) ->
 				if List.length args <> List.length el then error "Invalid number of constructor parameters" p;
 				if List.length args <> List.length el then error "Invalid number of constructor parameters" p;
-				List.iter2 (fun e t -> unify ctx e.etype t e.epos) el args;
+				List.iter2 (fun e (_,t) -> unify ctx e.etype t e.epos) el args;
 			| _ ->
 			| _ ->
 				error "Constructor is not a function" p);
 				error "Constructor is not a function" p);
 			TInst (c,params)
 			TInst (c,params)
@@ -851,13 +851,13 @@ and type_expr ctx ?(need_val=true) (e,p) =
 		let t = (match follow e.etype with
 		let t = (match follow e.etype with
 		| TFun (args,r) ->
 		| TFun (args,r) ->
 			if List.length args <> List.length el then error "Invalid number of arguments" p;
 			if List.length args <> List.length el then error "Invalid number of arguments" p;
-			List.iter2 (fun e t ->
+			List.iter2 (fun e (_,t) ->
 				unify ctx e.etype t e.epos;
 				unify ctx e.etype t e.epos;
 			) el args;
 			) el args;
 			r
 			r
 		| TMono _ ->
 		| TMono _ ->
 			let t = mk_mono() in
 			let t = mk_mono() in
-			unify ctx (TFun (List.map (fun e -> e.etype) el,t)) e.etype e.epos;
+			unify ctx (TFun (List.map (fun e -> "",e.etype) el,t)) e.etype e.epos;
 			t
 			t
 		| t ->
 		| t ->
 			if t == t_dynamic then
 			if t == t_dynamic then
@@ -882,7 +882,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 			(match apply_params c.cl_types params f.cf_type with
 			(match apply_params c.cl_types params f.cf_type with
 			| TFun (args,r) ->
 			| TFun (args,r) ->
 				if List.length args <> List.length el then error "Invalid number of constructor parameters" p;
 				if List.length args <> List.length el then error "Invalid number of constructor parameters" p;
-				List.iter2 (fun e t -> unify ctx e.etype t e.epos) el args;
+				List.iter2 (fun e (_,t) -> unify ctx e.etype t e.epos) el args;
 			| _ ->
 			| _ ->
 				error "Constructor is not a function" p);
 				error "Constructor is not a function" p);
 			c , params , t
 			c , params , t
@@ -895,7 +895,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 	| EFunction f ->
 	| EFunction f ->
 		let rt = load_type_opt ctx p f.f_type in
 		let rt = load_type_opt ctx p f.f_type in
 		let args = List.map (fun (s,t) -> s , load_type_opt ctx p t) f.f_args in
 		let args = List.map (fun (s,t) -> s , load_type_opt ctx p t) f.f_args in
-		let ft = TFun (List.map snd args,rt) in
+		let ft = TFun (args,rt) in
 		let e = type_function ctx ft true false f p in
 		let e = type_function ctx ft true false f p in
 		let f = {
 		let f = {
 			tf_args = args;
 			tf_args = args;
@@ -916,7 +916,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 
 
 and type_function ctx t static constr f p =
 and type_function ctx t static constr f p =
 	let locals = ctx.locals in
 	let locals = ctx.locals in
-	let argst , r = (match t with TFun (args,r) -> args, r | _ -> assert false) in
+	let argst , r = (match t with TFun (args,r) -> List.map snd args, r | _ -> assert false) in
 	List.iter2 (fun (n,_) t ->
 	List.iter2 (fun (n,_) t ->
 		ctx.locals <- PMap.add n t ctx.locals;		
 		ctx.locals <- PMap.add n t ctx.locals;		
 	) f.f_args argst;
 	) f.f_args argst;
@@ -1042,7 +1042,7 @@ let init_class ctx c p types herits fields =
 		| FFun (name,doc,access,f) ->
 		| FFun (name,doc,access,f) ->
 			let ret = type_opt p f.f_type in
 			let ret = type_opt p f.f_type in
 			let args = List.map (fun (name,t) -> name , type_opt p t) f.f_args in
 			let args = List.map (fun (name,t) -> name , type_opt p t) f.f_args in
-			let t = TFun (List.map snd args,ret) in
+			let t = TFun (args,ret) in
 			let stat = List.mem AStatic access in
 			let stat = List.mem AStatic access in
 			let constr = (name = "new") in
 			let constr = (name = "new") in
 			let cf = {
 			let cf = {
@@ -1098,7 +1098,7 @@ let init_class ctx c p types herits fields =
 		| TFun (args,r) ->
 		| TFun (args,r) ->
 			let t = f.cf_type in
 			let t = f.cf_type in
 			let n = ref 0 in
 			let n = ref 0 in
-			let args = List.map (fun t -> incr n; "p" ^ string_of_int (!n) , t) args in
+			let args = List.map (fun (_,t) -> incr n; "p" ^ string_of_int (!n) , t) args in
 			let eargs = List.map (fun (n,t) -> mk (TLocal n) t p) args in
 			let eargs = List.map (fun (n,t) -> mk (TLocal n) t p) args in
 			let func = {
 			let func = {
 				tf_args = args;
 				tf_args = args;
@@ -1192,7 +1192,7 @@ let type_module ctx m tdecls =
 			List.iter (fun (c,doc,t,p) ->
 			List.iter (fun (c,doc,t,p) ->
 				let t = (match t with 
 				let t = (match t with 
 					| [] -> et
 					| [] -> et
-					| l -> TFun (List.map (fun (_,t) -> load_type ctx p t) l, et)
+					| l -> TFun (List.map (fun (s,t) -> s, load_type ctx p t) l, et)
 				) in
 				) in
 				e.e_constrs <- PMap.add c { ef_name = c; ef_type = t; ef_pos = p; ef_doc = doc } e.e_constrs
 				e.e_constrs <- PMap.add c { ef_name = c; ef_type = t; ef_pos = p; ef_doc = doc } e.e_constrs
 			) constrs
 			) constrs