Skip to content

Commit

Permalink
Add support for Type & Type syntax (#7127)
Browse files Browse the repository at this point in the history
* [syntax] add CTIntersection

* [typer] allow loading intersection types over structures

* [std/tests] use intersection types in place of structural extensions

* don't forget about haxe.macro.Printer

* [typer] add initial support for intersection constraints

* right...
  • Loading branch information
Simn authored Jun 6, 2018
1 parent 456bfb9 commit 9fea5f9
Show file tree
Hide file tree
Showing 16 changed files with 133 additions and 50 deletions.
6 changes: 3 additions & 3 deletions src/codegen/dotnet.ml
Original file line number Diff line number Diff line change
Expand Up @@ -469,7 +469,7 @@ let convert_ilmethod ctx p m is_explicit_impl =
{
tp_name = "M" ^ string_of_int t.tnumber,null_pos;
tp_params = [];
tp_constraints = [];
tp_constraints = None;
tp_meta = [];
}
) m.mtypes in
Expand Down Expand Up @@ -638,7 +638,7 @@ let convert_delegate ctx p ilcls =
{
tp_name = ("T" ^ string_of_int t.tnumber),null_pos;
tp_params = [];
tp_constraints = [];
tp_constraints = None;
tp_meta = [];
}
) ilcls.ctypes in
Expand Down Expand Up @@ -802,7 +802,7 @@ let convert_ilclass ctx p ?(delegate=false) ilcls = match ilcls.csuper with
{
tp_name = "T" ^ string_of_int p.tnumber,null_pos;
tp_params = [];
tp_constraints = [];
tp_constraints = None;
tp_meta = [];
}) ilcls.ctypes
in
Expand Down
12 changes: 8 additions & 4 deletions src/codegen/java.ml
Original file line number Diff line number Diff line change
Expand Up @@ -183,6 +183,11 @@ let rec same_sig parent jsig =
| TArray(s,_) -> same_sig parent s
| _ -> false

let convert_constraints ctx p tl = match tl with
| [] -> None
| [t] -> Some (convert_signature ctx p t,null_pos)
| tl -> Some (CTIntersection(List.map (fun t -> convert_signature ctx p t,null_pos) tl),null_pos)

let convert_param ctx p parent param =
let name, constraints = match param with
| (name, Some extends_sig, implem_sig) ->
Expand All @@ -194,7 +199,7 @@ let convert_param ctx p parent param =
{
tp_name = jname_to_hx name,null_pos;
tp_params = [];
tp_constraints = List.map (fun t -> convert_signature ctx p t,null_pos) constraints;
tp_constraints = convert_constraints ctx p constraints;
tp_meta = [];
}

Expand Down Expand Up @@ -311,20 +316,19 @@ let convert_java_enum ctx p pe =
) args in
let t = Option.map_default (convert_signature ctx p) (mk_type_path ctx ([], "Void") []) ret in
cff_meta := (Meta.Overload, [], p) :: !cff_meta;

let types = List.map (function
| (name, Some ext, impl) ->
{
tp_name = name,null_pos;
tp_params = [];
tp_constraints = List.map (fun t -> convert_signature ctx p t,null_pos) (ext :: impl);
tp_constraints = convert_constraints ctx p (ext :: impl);
tp_meta = [];
}
| (name, None, impl) ->
{
tp_name = name,null_pos;
tp_params = [];
tp_constraints = List.map (fun t -> convert_signature ctx p t,null_pos) (impl);
tp_constraints = convert_constraints ctx p impl;
tp_meta = [];
}
) field.jf_types in
Expand Down
4 changes: 3 additions & 1 deletion src/context/display/findReferences.ml
Original file line number Diff line number Diff line change
Expand Up @@ -39,9 +39,11 @@ let find_possible_references kind name (pack,decls) =
| CTExtend(tl,cffl) ->
List.iter (fun (path,_) -> type_path KModuleType path) tl;
List.iter field cffl;
| CTIntersection tl ->
List.iter type_hint tl
and type_param tp =
List.iter type_param tp.tp_params;
List.iter type_hint tp.tp_constraints
Option.may type_hint tp.tp_constraints
and expr (e,p) =
begin match e with
| EConst(Ident s) ->
Expand Down
12 changes: 9 additions & 3 deletions src/core/ast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -162,6 +162,7 @@ and complex_type =
| CTExtend of placed_type_path list * class_field list
| CTOptional of type_hint
| CTNamed of placed_name * type_hint
| CTIntersection of type_hint list

and type_hint = complex_type * pos

Expand Down Expand Up @@ -217,7 +218,7 @@ and expr = expr_def * pos
and type_param = {
tp_name : placed_name;
tp_params : type_param list;
tp_constraints : type_hint list;
tp_constraints : type_hint option;
tp_meta : metadata;
}

Expand Down Expand Up @@ -575,9 +576,10 @@ let map_expr loop (e,p) =
CTExtend (tl,fl)
| CTOptional t -> CTOptional (type_hint t)
| CTNamed (n,t) -> CTNamed (n,type_hint t)
| CTIntersection tl -> CTIntersection(List.map type_hint tl)
),p
and tparamdecl t =
let constraints = List.map type_hint t.tp_constraints in
let constraints = opt type_hint t.tp_constraints in
let params = List.map tparamdecl t.tp_params in
{ tp_name = t.tp_name; tp_constraints = constraints; tp_params = params; tp_meta = t.tp_meta }
and func f =
Expand Down Expand Up @@ -782,6 +784,7 @@ let s_expr e =
| CTOptional(t,_) -> "?" ^ s_complex_type tabs t
| CTNamed((n,_),(t,_)) -> n ^ ":" ^ s_complex_type tabs t
| CTExtend (tl, fl) -> "{> " ^ String.concat " >, " (List.map (s_complex_type_path tabs) tl) ^ ", " ^ String.concat ", " (List.map (s_class_field tabs) fl) ^ " }"
| CTIntersection tl -> String.concat "&" (List.map (fun (t,_) -> s_complex_type tabs t) tl)
and s_class_field tabs f =
match f.cff_doc with
| Some s -> "/**\n\t" ^ tabs ^ s ^ "\n**/\n"
Expand Down Expand Up @@ -809,7 +812,10 @@ let s_expr e =
s_opt_expr tabs f.f_expr " "
and s_type_param tabs t =
fst (t.tp_name) ^ s_type_param_list tabs t.tp_params ^
if List.length t.tp_constraints > 0 then ":(" ^ String.concat ", " (List.map ((fun (t,_) -> s_complex_type tabs t)) t.tp_constraints) ^ ")" else ""
begin match t.tp_constraints with
| None -> ""
| Some(th,_) -> ":(" ^ s_complex_type tabs th ^ ")"
end
and s_type_param_list tabs tl =
if List.length tl > 0 then "<" ^ String.concat ", " (List.map (s_type_param tabs) tl) ^ ">" else ""
and s_func_arg tabs ((n,_),o,_,t,e) =
Expand Down
2 changes: 1 addition & 1 deletion src/core/display/completionItem.ml
Original file line number Diff line number Diff line change
Expand Up @@ -151,7 +151,7 @@ module CompletionModuleType = struct
| TInst(c,_) -> {
tp_name = s,null_pos;
tp_params = [];
tp_constraints = []; (* TODO? *)
tp_constraints = None; (* TODO? *)
tp_meta = c.cl_meta
}
| _ ->
Expand Down
14 changes: 12 additions & 2 deletions src/macro/macroApi.ml
Original file line number Diff line number Diff line change
Expand Up @@ -440,6 +440,8 @@ and encode_ctype t =
5, [encode_ctype t]
| CTNamed (n,t) ->
6, [encode_placed_name n; encode_ctype t]
| CTIntersection tl ->
7, [(encode_array (List.map encode_ctype tl))]
in
encode_enum ~pos:(Some (pos t)) ICType tag pl

Expand All @@ -448,7 +450,9 @@ and encode_tparam_decl tp =
"name", encode_placed_name tp.tp_name;
"name_pos", encode_pos (pos tp.tp_name);
"params", encode_array (List.map encode_tparam_decl tp.tp_params);
"constraints", encode_array (List.map encode_ctype tp.tp_constraints);
"constraints", (match tp.tp_constraints with
| None -> encode_array []
| Some th -> encode_array [encode_ctype th]);
"meta", encode_meta_content tp.tp_meta;
]

Expand Down Expand Up @@ -678,7 +682,11 @@ and decode_tparams v =
and decode_tparam_decl v =
{
tp_name = decode_placed_name (field v "name_pos") (field v "name");
tp_constraints = decode_opt_array decode_ctype (field v "constraints");
tp_constraints = (match decode_array(field v "constraints") with
| [] -> None
| [t] -> Some (decode_ctype t)
| tl -> Some (CTIntersection (List.map decode_ctype tl),Globals.null_pos)
);
tp_params = decode_tparams (field v "params");
tp_meta = decode_meta_content (field v "meta");
}
Expand Down Expand Up @@ -755,6 +763,8 @@ and decode_ctype t =
CTOptional (decode_ctype t)
| 6, [n;t] ->
CTNamed ((decode_string n,p), decode_ctype t)
| 7, [tl] ->
CTIntersection (List.map decode_ctype (decode_array tl))
| _ ->
raise Invalid_expr),p

Expand Down
24 changes: 19 additions & 5 deletions src/syntax/grammar.mly
Original file line number Diff line number Diff line change
Expand Up @@ -599,6 +599,12 @@ and parse_complex_type_next (t : type_hint) s =
| _ ->
CTFunction ([t] , (t2,p2)),punion (pos t) p2
in
let make_intersection t2 p2 = match t2 with
| CTIntersection tl ->
CTIntersection (t :: tl),punion (pos t) p2
| _ ->
CTIntersection ([t;t2,p2]),punion (pos t) p2
in
match s with parser
| [< '(Arrow,pa); s >] ->
begin match s with parser
Expand All @@ -609,6 +615,15 @@ and parse_complex_type_next (t : type_hint) s =
make_fun ct null_pos
end else serror()
end
| [< '(Binop OpAnd,pa); s >] ->
begin match s with parser
| [< t2,p2 = parse_complex_type >] -> make_intersection t2 p2
| [< >] ->
if would_skip_display_position pa s then begin
let ct = CTPath magic_type_path in
make_intersection ct null_pos
end else serror()
end
| [< >] -> t

and parse_function_type_next tl p1 = parser
Expand Down Expand Up @@ -805,18 +820,17 @@ and parse_constraint_param = parser
let params = (match s with parser
| [< >] -> []
) in
let ctl = (match s with parser
let cto = (match s with parser
| [< '(DblDot,_); s >] ->
(match s with parser
| [< '(POpen,_); l = psep Comma parse_complex_type; '(PClose,_) >] -> l
| [< t = parse_complex_type >] -> [t]
| [< t = parse_complex_type >] -> Some t
| [< >] -> serror())
| [< >] -> []
| [< >] -> None
) in
{
tp_name = name;
tp_params = params;
tp_constraints = ctl;
tp_constraints = cto;
tp_meta = meta;
}

Expand Down
5 changes: 3 additions & 2 deletions src/syntax/reification.ml
Original file line number Diff line number Diff line change
Expand Up @@ -137,6 +137,7 @@ let reify in_macro =
| CTExtend (tl,fields) -> ct "TExtend" [to_array to_tpath tl p; to_array to_cfield fields p]
| CTOptional t -> ct "TOptional" [to_type_hint t p]
| CTNamed (n,t) -> ct "TNamed" [to_placed_name n; to_type_hint t p]
| CTIntersection tl -> ct "TIntersection" (List.map (fun t -> to_ctype t p) tl)
and to_type_hint (t,p) _ =
(* to_obj ["type",to_ctype t p;"pos",to_pos p] p *)
to_ctype (t,p) p
Expand All @@ -154,7 +155,7 @@ let reify in_macro =
let rec fparam t p =
let fields = [
"name", to_placed_name t.tp_name;
"constraints", to_array to_ctype t.tp_constraints p;
"constraints", to_opt to_ctype t.tp_constraints p;
"params", to_array fparam t.tp_params p;
] in
to_obj fields p
Expand Down Expand Up @@ -364,7 +365,7 @@ let reify in_macro =
to_obj [
"name", to_placed_name t.tp_name;
"params", (EArrayDecl (List.map (to_tparam_decl p) t.tp_params),p);
"constraints", (EArrayDecl (List.map (fun t -> to_ctype t p) t.tp_constraints),p)
"constraints", (EArrayDecl (match t.tp_constraints with None -> [] | Some th -> [to_ctype th p]),p)
] p
and to_type_def (t,p) =
match t with
Expand Down
69 changes: 51 additions & 18 deletions src/typing/typeload.ml
Original file line number Diff line number Diff line change
Expand Up @@ -333,42 +333,72 @@ and load_instance ctx ?(allow_display=false) (t,pn) allow_no_params p =
*)
and load_complex_type ctx allow_display p (t,pn) =
let p = pselect pn p in
let is_redefined cf1 fields =
try
let cf2 = PMap.find cf1.cf_name fields in
let st = s_type (print_context()) in
if not (type_iseq cf1.cf_type cf2.cf_type) then begin
display_error ctx ("Cannot redefine field " ^ cf1.cf_name ^ " with different type") p;
display_error ctx ("First type was " ^ (st cf1.cf_type)) cf1.cf_pos;
error ("Second type was " ^ (st cf2.cf_type)) cf2.cf_pos
end else
true
with Not_found ->
false
in
match t with
| CTParent t -> load_complex_type ctx allow_display p t
| CTPath t -> load_instance ~allow_display ctx (t,pn) false p
| CTOptional _ -> error "Optional type not allowed here" p
| CTNamed _ -> error "Named type not allowed here" p
| CTIntersection tl ->
let tl = List.map (fun (t,pn) ->
try
load_complex_type ctx allow_display p (t,pn)
with DisplayException(DisplayFields(l,CRTypeHint,p)) ->
let l = List.filter (fun item -> match item.ci_kind with
| ITType({kind = Struct},_) -> true
| _ -> false
) l in
raise_fields l CRStructExtension p
) tl in
let tr = ref None in
let t = TMono tr in
let r = exc_protect ctx (fun r ->
r := lazy_processing (fun() -> t);
let mk_extension fields t = match follow t with
| TAnon a ->
PMap.fold (fun cf fields ->
if not (is_redefined cf fields) then PMap.add cf.cf_name cf fields
else fields
) a.a_fields fields
| _ ->
error "Can only extend structures" p
in
let fields = List.fold_left mk_extension PMap.empty tl in
let ta = TAnon { a_fields = fields; a_status = ref (Extend tl); } in
tr := Some ta;
ta
) "constraint" in
TLazy r
| CTExtend (tl,l) ->
begin match load_complex_type ctx allow_display p (CTAnonymous l,p) with
| TAnon a as ta ->
let is_redefined cf1 a2 =
try
let cf2 = PMap.find cf1.cf_name a2.a_fields in
let st = s_type (print_context()) in
if not (type_iseq cf1.cf_type cf2.cf_type) then begin
display_error ctx ("Cannot redefine field " ^ cf1.cf_name ^ " with different type") p;
display_error ctx ("First type was " ^ (st cf1.cf_type)) cf1.cf_pos;
error ("Second type was " ^ (st cf2.cf_type)) cf2.cf_pos
end else
true
with Not_found ->
false
in
let mk_extension t =
match follow t with
| TInst ({cl_kind = KTypeParameter _},_) ->
error "Cannot structurally extend type parameters" p
| TMono _ ->
error "Loop found in cascading signatures definitions. Please change order/import" p
| TAnon a2 ->
PMap.iter (fun _ cf -> ignore(is_redefined cf a2)) a.a_fields;
PMap.iter (fun _ cf -> ignore(is_redefined cf a2.a_fields)) a.a_fields;
TAnon { a_fields = (PMap.foldi PMap.add a.a_fields a2.a_fields); a_status = ref (Extend [t]); }
| _ -> error "Can only extend structures" p
in
let loop t = match follow t with
| TAnon a2 ->
PMap.iter (fun f cf ->
if not (is_redefined cf a) then
if not (is_redefined cf a.a_fields) then
a.a_fields <- PMap.add f cf a.a_fields
) a2.a_fields
| _ ->
Expand Down Expand Up @@ -649,13 +679,16 @@ let rec type_type_param ?(enum_constructor=false) ctx path get_params p tp =
if ctx.is_display_file && DisplayPosition.encloses_display_position (pos tp.tp_name) then
DisplayEmitter.display_type ctx t (pos tp.tp_name);
match tp.tp_constraints with
| [] ->
| None ->
n, t
| _ ->
| Some th ->
let r = exc_protect ctx (fun r ->
r := lazy_processing (fun() -> t);
let ctx = { ctx with type_params = ctx.type_params @ get_params() } in
let constr = List.map (load_complex_type ctx true p) tp.tp_constraints in
let constr = match fst th with
| CTIntersection tl -> List.map (load_complex_type ctx true p) tl
| _ -> [load_complex_type ctx true p th]
in
(* check against direct recursion *)
let rec loop t =
match follow t with
Expand Down
2 changes: 1 addition & 1 deletion src/typing/typer.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1981,7 +1981,7 @@ and type_local_function ctx name f with_type p =
if name = None then display_error ctx "Type parameters not supported in unnamed local functions" p;
if with_type <> NoValue then error "Type parameters are not supported for rvalue functions" p
end;
List.iter (fun tp -> if tp.tp_constraints <> [] then display_error ctx "Type parameter constraints are not supported for local functions" p) f.f_params;
List.iter (fun tp -> if tp.tp_constraints <> None then display_error ctx "Type parameter constraints are not supported for local functions" p) f.f_params;
let inline, v = (match name with
| None -> false, None
| Some v when ExtString.String.starts_with v "inline_" -> true, Some (String.sub v 7 (String.length v - 7))
Expand Down
5 changes: 5 additions & 0 deletions std/haxe/macro/Expr.hx
Original file line number Diff line number Diff line change
Expand Up @@ -583,6 +583,11 @@ enum ComplexType {
Represents a type with a name.
**/
TNamed( n : String, t : ComplexType );

/**
Represents an intersection type `T1 & T2 & ... & TN`.
**/
TIntersection(tl:Array<ComplexType>);
}

/**
Expand Down
1 change: 1 addition & 0 deletions std/haxe/macro/Printer.hx
Original file line number Diff line number Diff line change
Expand Up @@ -122,6 +122,7 @@ class Printer {
case TOptional(ct): "?" + printComplexType(ct);
case TNamed(n,ct): n + ":" + printComplexType(ct);
case TExtend(tpl, fields): '{> ${tpl.map(printTypePath).join(" >, ")}, ${fields.map(printField).join(", ")} }';
case TIntersection(tl): tl.map(printComplexType).join(" & ");
}

public function printMetadata(meta:MetadataEntry) return
Expand Down
Loading

0 comments on commit 9fea5f9

Please sign in to comment.