Pārlūkot izejas kodu

Minimal implementation of module metadata

Rudy Ges 10 mēneši atpakaļ
vecāks
revīzija
6735fcfd55

+ 3 - 1
src/compiler/compilationCache.ml

@@ -9,6 +9,7 @@ type cached_file = {
 	c_time : float;
 	c_package : string list;
 	c_decls : type_decl list;
+	c_meta : metadata;
 	mutable c_module_name : string option;
 	mutable c_pdi : Parser.parser_display_information;
 }
@@ -47,7 +48,8 @@ class context_cache (index : int) (sign : Digest.t) = object(self)
 		Hashtbl.find files key
 
 	method cache_file key path time data pdi =
-		Hashtbl.replace files key { c_file_path = path; c_time = time; c_package = fst data; c_decls = snd data; c_module_name = None; c_pdi = pdi }
+		let (pack,meta,decls) = data in
+		Hashtbl.replace files key { c_file_path = path; c_time = time; c_package = pack; c_meta = meta; c_decls = decls; c_module_name = None; c_pdi = pdi }
 
 	method remove_file key =
 		try

+ 5 - 5
src/compiler/displayProcessing.ml

@@ -229,7 +229,7 @@ let load_display_module_in_macro tctx display_file_dot_path clear = match displa
 
 let load_display_file_standalone (ctx : Typecore.typer) file =
 	let com = ctx.com in
-	let pack,decls = TypeloadParse.parse_module_file com (ClassPaths.create_resolved_file file ctx.com.empty_class_path) null_pos in
+	let pack,meta,decls = TypeloadParse.parse_module_file com (ClassPaths.create_resolved_file file ctx.com.empty_class_path) null_pos in
 	let path = Path.FilePath.parse file in
 	let name = match path.file_name with
 		| None -> "?DISPLAY"
@@ -244,15 +244,15 @@ let load_display_file_standalone (ctx : Typecore.typer) file =
 			let dir = ExtString.String.join (if path.backslash then "\\" else "/") parts in
 			com.class_paths#add (new ClassPath.directory_class_path dir User)
 	end;
-	ignore(TypeloadModule.type_module ctx.com ctx.g (pack,name) file ~dont_check_path:true decls null_pos)
+	ignore(TypeloadModule.type_module ctx.com ctx.g (pack,name) file ~dont_check_path:true meta decls null_pos)
 
 let load_display_content_standalone (ctx : Typecore.typer) input =
 	let com = ctx.com in
 	let file = file_input_marker in
 	let p = file_pos file in
 	let parsed = TypeloadParse.parse_file_from_string com file p input in
-	let pack,decls = TypeloadParse.handle_parser_result com p parsed in
-	ignore(TypeloadModule.type_module ctx.com ctx.g (pack,"?DISPLAY") file ~dont_check_path:true decls p)
+	let pack,meta,decls = TypeloadParse.handle_parser_result com p parsed in
+	ignore(TypeloadModule.type_module ctx.com ctx.g (pack,"?DISPLAY") file ~dont_check_path:true meta decls p)
 
 (* 4. Display processing before typing *)
 
@@ -326,7 +326,7 @@ let process_global_display_mode com tctx =
 			List.fold_left (fun acc (file_key,cfile) ->
 				let file = cfile.c_file_path.file in
 				if (filter <> None || DisplayPosition.display_position#is_in_file (com.file_keys#get file)) then
-					(file,DocumentSymbols.collect_module_symbols (Some (file,get_module_name_of_cfile file cfile)) (filter = None) (cfile.c_package,cfile.c_decls)) :: acc
+					(file,DocumentSymbols.collect_module_symbols (Some (file,get_module_name_of_cfile file cfile)) (filter = None) (cfile.c_package,cfile.c_meta,cfile.c_decls)) :: acc
 				else
 					acc
 			) [] l

+ 3 - 3
src/compiler/server.ml

@@ -58,7 +58,7 @@ let parse_file cs com (rfile : ClassPaths.resolved_file) p =
 			try
 				let cfile = cc#find_file fkey in
 				if cfile.c_time <> ftime then raise Not_found;
-				Parser.ParseSuccess((cfile.c_package,cfile.c_decls),false,cfile.c_pdi)
+				Parser.ParseSuccess((cfile.c_package,cfile.c_meta,cfile.c_decls),false,cfile.c_pdi)
 			with Not_found ->
 				let parse_result = TypeloadParse.parse_file com rfile p in
 				let info,is_unusual = match parse_result with
@@ -236,8 +236,8 @@ let check_module sctx com m_path m_extra p =
 			let cfile = cc#find_file fkey in
 			(* We must use the module path here because the file path is absolute and would cause
 				positions in the parsed declarations to differ. *)
-			let new_data = TypeloadParse.parse_module com m_path p in
-			cfile.c_decls <> snd new_data
+			let (_,_,decls) = TypeloadParse.parse_module com m_path p in
+			cfile.c_decls <> decls
 		with Not_found ->
 			true
 	in

+ 1 - 1
src/context/display/displayToplevel.ml

@@ -128,7 +128,7 @@ let read_class_paths com timer =
 	explore_class_paths com timer (com.class_paths#filter (fun cp -> cp#path <> "")) true (fun _ -> ()) (fun file path ->
 		(* Don't parse the display file as that would maybe overwrite the content from stdin with the file contents. *)
 		if not (DisplayPosition.display_position#is_in_file (com.file_keys#get file)) then begin
-			let rfile,_,pack,_ = Display.parse_module' com path Globals.null_pos in
+			let rfile,_,pack,meta,_ = Display.parse_module' com path Globals.null_pos in
 			if pack <> fst path then begin
 				let file_key = com.file_keys#get file in
 				(CommonCache.get_cache com)#remove_file_for_real file_key

+ 1 - 1
src/context/display/documentSymbols.ml

@@ -2,7 +2,7 @@ open Ast
 open Globals
 open DisplayTypes.SymbolKind
 
-let collect_module_symbols mname with_locals (pack,decls) =
+let collect_module_symbols mname with_locals (pack,meta,decls) =
 	let l = DynArray.create() in
 	let add name kind location parent deprecated =
 		let si = DisplayTypes.SymbolInformation.make name kind location (if parent = "" then None else Some parent) deprecated in

+ 1 - 0
src/core/tFunctions.ml

@@ -177,6 +177,7 @@ let module_extra file sign time kind added policy =
 			m_type_hints = [];
 			m_import_positions = PMap.empty;
 		};
+		m_meta = [];
 		m_cache_state = MSGood;
 		m_added = added;
 		m_checked = 0;

+ 1 - 0
src/core/tType.ml

@@ -435,6 +435,7 @@ and module_def_extra = {
 	m_file : Path.UniqueKey.lazy_t;
 	m_sign : Digest.t;
 	m_display : module_def_display;
+	mutable m_meta : metadata;
 	mutable m_check_policy : module_check_policy list;
 	mutable m_time : float;
 	mutable m_cache_state : module_cache_state;

+ 5 - 3
src/syntax/grammar.mly

@@ -124,15 +124,17 @@ let check_redundant_var p1 = parser
 
 let parsing_macro_cond = ref false
 
-let rec parse_file s =
+let rec parse_file metadata s =
 	last_doc := None;
 	match s with parser
+	| [< '(Sharp " "),_; meta = parse_meta; >] ->
+		parse_file (meta @ metadata) s
 	| [< '(Kwd Package,_); pack = parse_package; s >] ->
 		begin match s with parser
 		| [< '(Const(Ident _),p) when pack = [] >] -> error (Custom "Package name must start with a lowercase character") p
-		| [< psem = semicolon; l = parse_type_decls TCAfterImport psem.pmax pack [] >] -> pack , l
+		| [< psem = semicolon; l = parse_type_decls TCAfterImport psem.pmax pack [] >] -> pack , metadata, l
 		end
-	| [< l = parse_type_decls TCBeforePackage (-1) [] [] >] -> [] , l
+	| [< l = parse_type_decls TCBeforePackage (-1) [] [] >] -> [] , metadata, l
 
 and parse_type_decls mode pmax pack acc s =
 	check_type_decl_completion mode pmax s;

+ 1 - 0
src/syntax/lexer.ml

@@ -458,6 +458,7 @@ let rec token lexbuf =
 	| "??" -> mk lexbuf (Binop OpNullCoal)
 	| "?" -> mk lexbuf Question
 	| "@" -> mk lexbuf At
+	| "# " -> mk lexbuf (Sharp " ")
 
 	| "/*" ->
 		reset();

+ 2 - 0
src/syntax/parserEntry.ml

@@ -290,6 +290,8 @@ let parse entry ctx code file =
 			) in
 			!(Lexer.cur).Lexer.lline <- line - 1;
 			next_token();
+		| Sharp " " ->
+			tk
 		| Sharp s ->
 			sharp_error s (pos tk)
 		| _ ->

+ 3 - 2
src/typing/macroContext.ml

@@ -461,7 +461,7 @@ let make_macro_api ctx mctx p =
 			in
 			let add is_macro ctx =
 				let mdep = Option.map_default (fun s -> TypeloadModule.load_module ~origin:MDepFromMacro ctx (parse_path s) pos) ctx.m.curmod mdep in
-				let mnew = TypeloadModule.type_module ctx.com ctx.g ~dont_check_path:(has_native_meta) m (ctx.com.file_keys#generate_virtual ctx.com.compilation_step) [tdef,pos] pos in
+				let mnew = TypeloadModule.type_module ctx.com ctx.g ~dont_check_path:(has_native_meta) m (ctx.com.file_keys#generate_virtual ctx.com.compilation_step) [] [tdef,pos] pos in
 				mnew.m_extra.m_kind <- if is_macro then MMacro else MFake;
 				add_dependency mnew mdep MDepFromMacro;
 				add_dependency mdep mnew MDepFromMacroDefine;
@@ -475,6 +475,7 @@ let make_macro_api ctx mctx p =
 			| _ ->
 				()
 		);
+		(* TODO: allow user to define module metadata *)
 		MacroApi.define_module = (fun m types imports usings ->
 			let types = List.map (fun v ->
 				let _, tdef, pos = (try Interp.decode_type_def v with MacroApi.Invalid_expr -> Interp.exc_string "Invalid type definition") in
@@ -498,7 +499,7 @@ let make_macro_api ctx mctx p =
 				end else
 					ignore(TypeloadModule.type_types_into_module ctx.com ctx.g m types pos)
 			with Not_found ->
-				let mnew = TypeloadModule.type_module ctx.com ctx.g mpath (ctx.com.file_keys#generate_virtual ctx.com.compilation_step) types pos in
+				let mnew = TypeloadModule.type_module ctx.com ctx.g mpath (ctx.com.file_keys#generate_virtual ctx.com.compilation_step) [] types pos in
 				mnew.m_extra.m_kind <- MFake;
 				add_dependency mnew ctx.m.curmod MDepFromMacro;
 				add_dependency ctx.m.curmod mnew MDepFromMacroDefine;

+ 8 - 7
src/typing/typeloadModule.ml

@@ -292,7 +292,7 @@ module ModuleLevel = struct
 				r
 			with Not_found ->
 				if Sys.file_exists path then begin
-					let _,r = match !TypeloadParse.parse_hook com (ClassPaths.create_resolved_file path com.empty_class_path) p with
+					let _,meta,r = match !TypeloadParse.parse_hook com (ClassPaths.create_resolved_file path com.empty_class_path) p with
 						| ParseSuccess(data,_,_) -> data
 						| ParseError(_,(msg,p),_) -> Parser.error msg p
 					in
@@ -722,8 +722,9 @@ let type_types_into_module com g m tdecls p =
 (*
 	Creates a new module and types [tdecls] into it.
 *)
-let type_module com g mpath file ?(dont_check_path=false) ?(is_extern=false) tdecls p =
+let type_module com g mpath file ?(dont_check_path=false) ?(is_extern=false) meta tdecls p =
 	let m = ModuleLevel.make_module com g mpath file p in
+	m.m_extra.m_meta <- meta;
 	com.module_lut#add m.m_path m;
 	let tdecls = ModuleLevel.handle_import_hx com g m tdecls p in
 	let ctx_m = type_types_into_module com g m tdecls p in
@@ -822,10 +823,10 @@ and load_module' com g m p =
 			if com.module_nonexistent_lut#mem m then raise_not_found();
 			if g.load_only_cached_modules then raise_not_found();
 			let is_extern = ref false in
-			let file, decls = try
+			let file, meta, decls = try
 				(* Try parsing *)
-				let rfile,decls = TypeloadParse.parse_module com m p in
-				rfile.file,decls
+				let rfile,meta,decls = TypeloadParse.parse_module com m p in
+				rfile.file,meta,decls
 			with Not_found ->
 				(* Nothing to parse, try loading extern type *)
 				let rec loop = function
@@ -835,13 +836,13 @@ and load_module' com g m p =
 					| (file,load) :: l ->
 						match load m p with
 						| None -> loop l
-						| Some (_,a) -> file, a
+						| Some (_,a) -> file, [], a
 				in
 				is_extern := true;
 				loop com.load_extern_type
 			in
 			let is_extern = !is_extern in
-			type_module com g m file ~is_extern decls p
+			type_module com g m file ~is_extern meta decls p
 
 let load_module ?(origin:module_dep_origin = MDepFromTyping) ctx m p =
 	let m2 = load_module' ctx.com ctx.g m p in

+ 7 - 6
src/typing/typeloadParse.ml

@@ -35,7 +35,7 @@ let parse_file_from_lexbuf com file p lexbuf =
 	Lexer.init file;
 	incr stats.s_files_parsed;
 	let parse_result = try
-		ParserEntry.parse Grammar.parse_file com.defines lexbuf file
+		ParserEntry.parse (fun s -> Grammar.parse_file [] s) com.defines lexbuf file
 	with
 		| Sedlexing.MalFormed ->
 			t();
@@ -124,8 +124,9 @@ let resolve_module_file com m remap p =
 			| (EStatic d,_) :: _ -> d.d_meta
 			| [] -> []
 		in
+		(* TODO: use meta directly? *)
 		let meta = match parse_result with
-			| ParseSuccess((_,decls),_,_) -> loop decls
+			| ParseSuccess((_,meta,decls),_,_) -> meta @ (loop decls)
 			| ParseError _ -> []
 		in
 		if not (Meta.has Meta.NoPackageRestrict meta) then begin
@@ -293,11 +294,11 @@ let parse_module_file com file p =
 let parse_module' com m p =
 	let remap = ref (fst m) in
 	let rfile = resolve_module_file com m remap p in
-	let pack,decls = parse_module_file com rfile p in
-	rfile,remap,pack,decls
+	let pack,meta,decls = parse_module_file com rfile p in
+	rfile,remap,pack,meta,decls
 
 let parse_module com m p =
-	let rfile,remap,pack,decls = parse_module' com m p in
+	let rfile,remap,pack,meta,decls = parse_module' com m p in
 	if pack <> !remap then begin
 		let spack m = if m = [] then "`package;`" else "`package " ^ (String.concat "." m) ^ ";`" in
 		if p == null_pos then
@@ -305,7 +306,7 @@ let parse_module com m p =
 		else
 			display_error com (spack pack ^ " in " ^ rfile.file ^ " should be " ^ spack (fst m)) {p with pmax = p.pmin}
 	end;
-	rfile, if !remap <> fst m then
+	rfile, meta, if !remap <> fst m then
 		(* build typedefs to redirect to real package *)
 		List.rev (List.fold_left (fun acc (t,p) ->
 			let build f d =