start working on module-level functions

Author: nadako

src/codegen/gencommon/gencommon.ml

@@ -617,11 +617,11 @@ let new_ctx con =
 		gadd_type = (fun md should_filter ->
 			if should_filter then begin
 				gen.gtypes_list <- md :: gen.gtypes_list;
-				gen.gmodules <- { m_id = alloc_mid(); m_path = (t_path md); m_types = [md]; m_extra = module_extra "" "" 0. MFake [] } :: gen.gmodules;
+				gen.gmodules <- { m_id = alloc_mid(); m_path = (t_path md); m_types = [md]; m_statics = None; m_extra = module_extra "" "" 0. MFake [] } :: gen.gmodules;
 				Hashtbl.add gen.gtypes (t_path md) md;
 			end else gen.gafter_filters_ended <- (fun () ->
 				gen.gtypes_list <- md :: gen.gtypes_list;
-				gen.gmodules <- { m_id = alloc_mid(); m_path = (t_path md); m_types = [md]; m_extra = module_extra "" "" 0. MFake [] } :: gen.gmodules;
+				gen.gmodules <- { m_id = alloc_mid(); m_path = (t_path md); m_types = [md]; m_statics = None; m_extra = module_extra "" "" 0. MFake [] } :: gen.gmodules;
 				Hashtbl.add gen.gtypes (t_path md) md;
 			) :: gen.gafter_filters_ended;
 		);
@@ -682,7 +682,7 @@ let reorder_modules gen =
 	Hashtbl.iter (fun md_path md ->
 		if not (Hashtbl.mem processed md_path) then begin
 			Hashtbl.add processed md_path true;
-			gen.gmodules <- { m_id = alloc_mid(); m_path = md_path; m_types = List.rev ( Hashtbl.find_all modules md_path ); m_extra = (t_infos md).mt_module.m_extra } :: gen.gmodules
+			gen.gmodules <- { m_id = alloc_mid(); m_path = md_path; m_types = List.rev ( Hashtbl.find_all modules md_path ); m_statics = None; m_extra = (t_infos md).mt_module.m_extra } :: gen.gmodules
 		end
 	) modules
 

src/context/typecore.ml

@@ -353,6 +353,7 @@ let create_fake_module ctx file =
 			m_id = alloc_mid();
 			m_path = (["$DEP"],file);
 			m_types = [];
+			m_statics = None;
 			m_extra = module_extra file (Define.get_signature ctx.com.defines) (file_time file) MFake [];
 		} in
 		Hashtbl.add fake_modules file mdep;

src/core/ast.ml

@@ -321,6 +321,7 @@ type type_def =
 	| EEnum of (enum_flag, enum_constructor list) definition
 	| ETypedef of (enum_flag, type_hint) definition
 	| EAbstract of (abstract_flag, class_field list) definition
+	| EGlobal of (placed_access, class_field_kind) definition
 	| EImport of import
 	| EUsing of placed_name list
 

src/core/tFunctions.ml

@@ -151,6 +151,7 @@ let null_module = {
 		m_id = alloc_mid();
 		m_path = [] , "";
 		m_types = [];
+		m_statics = None;
 		m_extra = module_extra "" "" 0. MFake [];
 	}
 

src/core/tType.ml

@@ -185,6 +185,7 @@ and tclass_kind =
 	| KMacroType
 	| KGenericBuild of class_field list
 	| KAbstractImpl of tabstract
+	| KModuleStatics of module_def
 
 and metadata = Ast.metadata
 
@@ -312,6 +313,7 @@ and module_def = {
 	m_id : int;
 	m_path : path;
 	mutable m_types : module_type list;
+	mutable m_statics : tclass option;
 	m_extra : module_def_extra;
 }
 

src/syntax/grammar.mly

@@ -169,6 +169,28 @@ and parse_type_decl mode s =
 	| [< '(Kwd Using,p1) >] -> parse_using s p1
 	| [< doc = get_doc; meta = parse_meta; c = parse_common_flags; s >] ->
 		match s with parser
+		| [< '(Kwd Function,p1); name = dollar_ident; pl = parse_constraint_params; '(POpen,_); args = psep Comma parse_fun_param; '(PClose,_); t = popt parse_type_hint; s >] ->
+			let e, p2 = (match s with parser
+				| [< e = expr; s >] ->
+					ignore(semicolon s);
+					Some e, pos e
+				| [< p = semicolon >] -> None, p
+				| [< >] -> serror()
+			) in
+			let f = {
+				f_params = pl;
+				f_args = args;
+				f_type = t;
+				f_expr = e;
+			} in
+			(EGlobal {
+				d_name = name;
+				d_doc = doc_from_string_opt doc;
+				d_meta = meta;
+				d_params = pl;
+				d_flags = List.map decl_flag_to_global_flag c;
+				d_data = FFun f;
+			}, punion p1 p2)
 		| [< '(Kwd Enum,p1) >] ->
 			begin match s with parser
 			| [< a,p = parse_abstract doc ((Meta.Enum,[],null_pos) :: meta) c >] ->

src/syntax/parser.ml

@@ -106,6 +106,11 @@ let decl_flag_to_abstract_flag (flag,p) = match flag with
 	| DExtern -> AbExtern
 	| DFinal -> error (Custom "final on abstracts is not allowed") p
 
+let decl_flag_to_global_flag (flag,p) = match flag with
+	| DPrivate -> (APrivate,p)
+	| DExtern -> (AExtern,p)
+	| DFinal -> (AFinal,p)
+
 module TokenCache = struct
 	let cache = ref (DynArray.create ())
 	let add (token : (token * pos)) = DynArray.add (!cache) token

src/typing/generic.ml

@@ -160,6 +160,7 @@ let static_method_container gctx c cf p =
 			m_id = alloc_mid();
 			m_path = (pack,name);
 			m_types = [];
+			m_statics = None;
 			m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake m.m_extra.m_check_policy;
 		} in
 		gctx.mg <- Some mg;
@@ -205,6 +206,7 @@ let rec build_generic ctx c p tl =
 			m_id = alloc_mid();
 			m_path = (pack,name);
 			m_types = [];
+			m_statics = None;
 			m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake m.m_extra.m_check_policy;
 		} in
 		gctx.mg <- Some mg;

src/typing/typeloadFields.ml

@@ -598,7 +598,7 @@ let is_public (ctx,cctx) access parent =
 		true
 	else match parent with
 		| Some cf -> (has_class_field_flag cf CfPublic)
-		| _ -> c.cl_extern || c.cl_interface || cctx.extends_public
+		| _ -> c.cl_extern || c.cl_interface || cctx.extends_public || (match c.cl_kind with KModuleStatics _ -> true | _ -> false)
 
 let rec get_parent c name =
 	match c.cl_super with

src/typing/typeloadModule.ml

@@ -39,6 +39,7 @@ let make_module ctx mpath file loadp =
 		m_id = alloc_mid();
 		m_path = mpath;
 		m_types = [];
+		m_statics = None;
 		m_extra = module_extra (Path.unique_full_path file) (Define.get_signature ctx.com.defines) (file_time file) (if ctx.in_macro then MMacro else MCode) (get_policy ctx mpath);
 	} in
 	m
@@ -194,6 +195,7 @@ let module_pass_1 ctx m tdecls loadp =
 		if priv then (fst m.m_path @ ["_" ^ snd m.m_path], name) else (fst m.m_path, name)
 	in
 	let pt = ref None in
+	let globals = ref [] in
 	let rec make_decl acc decl =
 		let p = snd decl in
 		let check_type_name type_name meta =
@@ -205,6 +207,9 @@ let module_pass_1 ctx m tdecls loadp =
 			(match !pt with
 			| None -> acc
 			| Some _ -> error "import and using may not appear after a type declaration" p)
+		| EGlobal d ->
+			globals := (d,p) :: !globals;
+			acc;
 		| EClass d ->
 			let name = fst d.d_name in
 			pt := Some p;
@@ -341,6 +346,43 @@ let module_pass_1 ctx m tdecls loadp =
 		decl :: acc
 	in
 	let tdecls = List.fold_left make_decl [] tdecls in
+	let tdecls =
+		match !globals with
+		| [] ->
+			tdecls
+		| globals ->
+			let first_pos = ref null_pos in
+			let fields = List.map (fun (d,p) ->
+				first_pos := p;
+				{
+					cff_name = d.d_name;
+					cff_doc = d.d_doc;
+					cff_pos = p;
+					cff_meta = d.d_meta;
+					cff_access = (AStatic,null_pos) :: d.d_flags;
+					cff_kind = d.d_data;
+				}
+			) globals in
+			let p = !first_pos in
+			let c = EClass {
+				d_name = (snd m.m_path) ^ "_Statics_", p;
+				d_flags = [HPrivate];
+				d_data = fields;
+				d_doc = None;
+				d_params = [];
+				d_meta = []
+			} in
+			let tdecls = make_decl tdecls (c,p) in
+			(match !decls with
+			| (TClassDecl c,_) :: _ ->
+				assert (m.m_statics = None);
+				m.m_statics <- Some c;
+				c.cl_kind <- KModuleStatics m;
+				c.cl_final <- true;
+			| _ -> assert false);
+			tdecls
+
+	in
 	let decls = List.rev !decls in
 	decls, List.rev tdecls
 
@@ -490,7 +532,16 @@ let init_module_type ctx context_init (decl,p) =
 				| [] ->
 					(match name with
 					| None ->
-						ctx.m.module_types <- List.filter no_private (List.map (fun t -> t,p) types) @ ctx.m.module_types
+						ctx.m.module_types <- List.filter no_private (List.map (fun t -> t,p) types) @ ctx.m.module_types;
+						Option.may (fun c ->
+							context_init#add (fun () ->
+								ignore(c.cl_build());
+								List.iter (fun cf ->
+									if has_class_field_flag cf CfPublic then
+										ctx.m.module_globals <- PMap.add cf.cf_name (TClassDecl c,cf.cf_name,p) ctx.m.module_globals
+								) c.cl_ordered_statics
+							);
+						) md.m_statics
 					| Some(newname,pname) ->
 						ctx.m.module_types <- (rebind (get_type tname) newname pname,p) :: ctx.m.module_types);
 				| [tsub,p2] ->
@@ -802,6 +853,9 @@ let init_module_type ctx context_init (decl,p) =
 			else
 				error "Abstract is missing underlying type declaration" a.a_pos
 		end
+	| EGlobal _ ->
+		(* nothing to do here as globals are collected into a special EClass *)
+		()
 
 let module_pass_2 ctx m decls tdecls p =
 	(* here is an additional PASS 1 phase, which define the type parameters for all module types.

src/typing/typer.ml

@@ -370,6 +370,15 @@ let rec type_ident_raise ctx i p mode =
 		let e = type_type ctx ctx.curclass.cl_path p in
 		(* check_locals_masking already done in type_type *)
 		field_access ctx mode f (FStatic (ctx.curclass,f)) (field_type ctx ctx.curclass [] f p) e p
+	with Not_found -> try
+		(* module-level statics *)
+		(match ctx.m.curmod.m_statics with
+		| None -> raise Not_found
+		| Some c ->
+			let f = PMap.find i c.cl_statics in
+			let e = type_module_type ctx (TClassDecl c) None p in
+			field_access ctx mode f (FStatic (c,f)) (field_type ctx c [] f p) e p
+		)
 	with Not_found -> try
 		let wrap e = if mode = MSet then
 				AKNo i