move some type path related functions around

ast.ml

@@ -870,6 +870,8 @@ let get_value_meta meta =
 	with Not_found ->
 		PMap.empty
 
+(* Type path related functions *)
+
 let rec string_list_of_expr_path_raise (e,p) =
 	match e with
 	| EConst (Ident i) -> [i]
@@ -882,4 +884,28 @@ let expr_of_type_path (sl,s) p =
 	| s1 :: sl ->
 		let e1 = (EConst(Ident s1),p) in
 		let e = List.fold_left (fun e s -> (EField(e,s),p)) e1 sl in
-		EField(e,s),p
+		EField(e,s),p
+
+let match_path recursive sl sl_pattern =
+	let rec loop sl1 sl2 = match sl1,sl2 with
+		| [],[] ->
+			true
+		(* always recurse into types of package paths *)
+		| (s1 :: s11 :: _),[s2] when is_lower_ident s2 && not (is_lower_ident s11)->
+			s1 = s2
+		| [_],[""] ->
+			true
+		| _,([] | [""]) ->
+			recursive
+		| [],_ ->
+			false
+		| (s1 :: sl1),(s2 :: sl2) ->
+			s1 = s2 && loop sl1 sl2
+	in
+	loop sl sl_pattern
+
+let full_dot_path mpath tpath =
+	if mpath = tpath then
+		(fst tpath) @ [snd tpath]
+	else
+		(fst mpath) @ [snd mpath;snd tpath]

interp.ml

@@ -5012,17 +5012,7 @@ let rec make_ast e =
 		in
 		if snd mp = snd p then p else (fst mp) @ [snd mp],snd p
 	in
-	let mk_path (pack,name) p =
-		match List.rev pack with
-		| [] -> (EConst (Ident name),p)
-		| pl ->
-			let rec loop = function
-				| [] -> assert false
-				| [n] -> (EConst (Ident n),p)
-				| n :: l -> (EField (loop l, n),p)
-			in
-			(EField (loop pl,name),p)
-	in
+	let mk_path = expr_of_type_path in
 	let mk_const = function
 		| TInt i -> Int (Int32.to_string i)
 		| TFloat s -> Float s

typeload.ml

@@ -1744,29 +1744,10 @@ let init_core_api ctx c =
 	| _ -> error "Constructor differs from core type" c.cl_pos)
 
 let check_global_metadata ctx f_add mpath tpath so =
-	let sl1 = if mpath = tpath then
-		(fst tpath) @ [snd tpath]
-	else
-		(fst mpath) @ [snd mpath;snd tpath]
-	in
+	let sl1 = full_dot_path mpath tpath in
 	let sl1,field_mode = match so with None -> sl1,false | Some s -> sl1 @ [s],true in
 	List.iter (fun (sl2,m,(recursive,to_types,to_fields)) ->
-		let rec loop sl1 sl2 = match sl1,sl2 with
-			| [],[] ->
-				true
-			(* always recurse into types of package paths *)
-			| (s1 :: s11 :: _),[s2] when is_lower_ident s2 && not (is_lower_ident s11)->
-				s1 = s2
-			| [_],[""] ->
-				true
-			| _,([] | [""]) ->
-				recursive
-			| [],_ ->
-				false
-			| (s1 :: sl1),(s2 :: sl2) ->
-				s1 = s2 && loop sl1 sl2
-		in
-		let add = ((field_mode && to_fields) || (not field_mode && to_types)) && (loop sl1 sl2) in
+		let add = ((field_mode && to_fields) || (not field_mode && to_types)) && (match_path recursive sl1 sl2) in
 		if add then f_add m
 	) ctx.g.global_metadata