Browse Source

added --remap

Nicolas Cannasse 17 years ago
parent
commit
e9df17840c
4 changed files with 38 additions and 3 deletions
  1. 1 0
      common.ml
  2. 1 0
      doc/CHANGES.txt
  3. 5 1
      main.ml
  4. 31 2
      typeload.ml

+ 1 - 0
common.ml

@@ -21,6 +21,7 @@ open Type
 type package_rule =
 type package_rule =
 	| Forbidden
 	| Forbidden
 	| Directory of string
 	| Directory of string
+	| Remap of string
 
 
 type platform =
 type platform =
 	| Cross
 	| Cross

+ 1 - 0
doc/CHANGES.txt

@@ -19,6 +19,7 @@ TODO inlining : substitute class+function type parameters in order to have fully
 	don't allow nullness changes in overrided/implemented
 	don't allow nullness changes in overrided/implemented
 	prevent typing hole with overriden polymorphic methods
 	prevent typing hole with overriden polymorphic methods
 	added neko.vm.Mutex (included in neko 1.7.1)
 	added neko.vm.Mutex (included in neko 1.7.1)
+	added package remapping using --remap
 
 
 2008-07-17: 2.0-RC1
 2008-07-17: 2.0-RC1
 	genneko : remove big array error (fixed in neko 1.7.1)
 	genneko : remove big array error (fixed in neko 1.7.1)

+ 5 - 1
main.ml

@@ -216,7 +216,7 @@ try
 		if com.platform <> Cross then failwith "Multiple targets";
 		if com.platform <> Cross then failwith "Multiple targets";
 		com.platform <- pf;
 		com.platform <- pf;
 		com.file <- file;
 		com.file <- file;
-		let forbid acc p = if p = name then acc else PMap.add p Forbidden acc in
+		let forbid acc p = if p = name || PMap.mem p acc then acc else PMap.add p Forbidden acc in
 		com.package_rules <- List.fold_left forbid com.package_rules root_packages;
 		com.package_rules <- List.fold_left forbid com.package_rules root_packages;
 		Common.define com name; (* define platform name *)
 		Common.define com name; (* define platform name *)
 	in
 	in
@@ -342,6 +342,10 @@ try
 			if com.php_front <> None then raise (Arg.Bad "Multiple --php-front");
 			if com.php_front <> None then raise (Arg.Bad "Multiple --php-front");
 			com.php_front <- Some f;
 			com.php_front <- Some f;
 		),"<filename> : select the name for the php front file");
 		),"<filename> : select the name for the php front file");
+		("--remap", Arg.String (fun s ->
+			let pack, target = (try ExtString.String.split s ":" with _ -> raise (Arg.Bad "Invalid format")) in
+			com.package_rules <- PMap.add pack (Remap target) com.package_rules;
+		),"<package:target> : remap a package to another one");
 	] in
 	] in
 	let current = ref 0 in
 	let current = ref 0 in
 	let args = Array.of_list ("" :: params) in
 	let args = Array.of_list ("" :: params) in

+ 31 - 2
typeload.ml

@@ -950,6 +950,7 @@ let type_module ctx m tdecls loadp =
 	m
 	m
 
 
 let parse_module ctx m p =
 let parse_module ctx m p =
+	let remap = ref (fst m) in
 	let file = (match m with
 	let file = (match m with
 		| [] , name -> name
 		| [] , name -> name
 		| x :: l , name ->
 		| x :: l , name ->
@@ -957,6 +958,7 @@ let parse_module ctx m p =
 				match PMap.find x ctx.com.package_rules with
 				match PMap.find x ctx.com.package_rules with
 				| Forbidden -> error ("You can't access the " ^ x ^ " package with current compilation flags (for " ^ s_type_path m ^ ")") p;
 				| Forbidden -> error ("You can't access the " ^ x ^ " package with current compilation flags (for " ^ s_type_path m ^ ")") p;
 				| Directory d -> d
 				| Directory d -> d
+				| Remap d -> remap := d :: l; d
 				with Not_found -> x
 				with Not_found -> x
 			) in
 			) in
 			String.concat "/" (x :: l) ^ "/" ^ name
 			String.concat "/" (x :: l) ^ "/" ^ name
@@ -968,14 +970,41 @@ let parse_module ctx m p =
 	t();
 	t();
 	close_in ch;
 	close_in ch;
 	if ctx.com.verbose then print_endline ("Parsed " ^ file);
 	if ctx.com.verbose then print_endline ("Parsed " ^ file);
-	if pack <> fst m then begin
+	if pack <> !remap then begin
 		let spack m = if m = [] then "<empty>" else String.concat "." m in
 		let spack m = if m = [] then "<empty>" else String.concat "." m in
 		if p == Ast.null_pos then
 		if p == Ast.null_pos then
 			error ("Invalid commandline class : " ^ s_type_path m ^ " should be " ^ s_type_path (pack,snd m)) p
 			error ("Invalid commandline class : " ^ s_type_path m ^ " should be " ^ s_type_path (pack,snd m)) p
 		else
 		else
 			error ("Invalid package : " ^ spack (fst m) ^ " should be " ^ spack pack) p
 			error ("Invalid package : " ^ spack (fst m) ^ " should be " ^ spack pack) p
 	end;
 	end;
-	decls
+	if !remap <> fst m then
+		(* build typedefs to redirect to real package *)
+		List.fold_left (fun acc (t,p) ->
+			let build f d =
+				let priv = List.mem f d.d_flags in
+				let params = List.map fst d.d_params in
+				(ETypedef { 
+					d_name = d.d_name;
+					d_doc = None;
+					d_params = List.map (fun s -> s, []) params;
+					d_flags = if priv then [EPrivate] else [];
+					d_data = TPNormal {
+						tpackage = !remap;
+						tname = d.d_name;
+						tparams = List.map (fun s ->
+							TPType (TPNormal { tpackage = []; tname = s; tparams = [] })
+						) params;
+					};
+				},p) :: acc
+			in
+			match t with
+			| EClass d -> build HPrivate d
+			| EEnum d -> build EPrivate d
+			| ETypedef d -> build EPrivate d
+			| EImport _ -> acc
+		) [] decls
+	else
+		decls
 
 
 let load_module ctx m p =
 let load_module ctx m p =
 	try
 	try