Skip to content

Commit

Permalink
start working on module-level functions
Browse files Browse the repository at this point in the history
  • Loading branch information
nadako committed Feb 9, 2020
1 parent e686af4 commit b3b83eb
Show file tree
Hide file tree
Showing 11 changed files with 102 additions and 5 deletions.
6 changes: 3 additions & 3 deletions src/codegen/gencommon/gencommon.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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;
);
Expand Down Expand Up @@ -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

Expand Down
1 change: 1 addition & 0 deletions src/context/typecore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down
1 change: 1 addition & 0 deletions src/core/ast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
1 change: 1 addition & 0 deletions src/core/tFunctions.ml
Original file line number Diff line number Diff line change
Expand Up @@ -151,6 +151,7 @@ let null_module = {
m_id = alloc_mid();
m_path = [] , "";
m_types = [];
m_statics = None;
m_extra = module_extra "" "" 0. MFake [];
}

Expand Down
2 changes: 2 additions & 0 deletions src/core/tType.ml
Original file line number Diff line number Diff line change
Expand Up @@ -185,6 +185,7 @@ and tclass_kind =
| KMacroType
| KGenericBuild of class_field list
| KAbstractImpl of tabstract
| KModuleStatics of module_def

and metadata = Ast.metadata

Expand Down Expand Up @@ -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;
}

Expand Down
22 changes: 22 additions & 0 deletions src/syntax/grammar.mly
Original file line number Diff line number Diff line change
Expand Up @@ -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 >] ->
Expand Down
5 changes: 5 additions & 0 deletions src/syntax/parser.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 2 additions & 0 deletions src/typing/generic.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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;
Expand Down
2 changes: 1 addition & 1 deletion src/typing/typeloadFields.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
56 changes: 55 additions & 1 deletion src/typing/typeloadModule.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand All @@ -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;
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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] ->
Expand Down Expand Up @@ -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.
Expand Down
9 changes: 9 additions & 0 deletions src/typing/typer.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit b3b83eb

Please sign in to comment.