Skip to content

Commit

Permalink
[generics] use tclass instead of TType.t for substitution
Browse files Browse the repository at this point in the history
  • Loading branch information
Apprentice-Alchemist committed Oct 5, 2024
1 parent 1ce738c commit cce269a
Showing 1 changed file with 13 additions and 17 deletions.
30 changes: 13 additions & 17 deletions src/typing/generic.ml
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ open FieldCallCandidate

type generic_context = {
ctx : typer;
subst : (t * (t * texpr option)) list;
subst : (tclass * (t * texpr option)) list;
name : string;
p : pos;
mutable mg : module_def option;
Expand Down Expand Up @@ -64,7 +64,7 @@ let make_generic ctx ps pt debug p =
let rec loop acc_name acc_subst ttpl tl = match ttpl,tl with
| ttp :: ttpl,t :: tl ->
let name,t = try process t with Exit -> raise_typing_error ("Could not determine type for parameter " ^ ttp.ttp_name) p in
loop (name :: acc_name) ((ttp.ttp_type,t) :: acc_subst) ttpl tl
loop (name :: acc_name) ((ttp.ttp_class,t) :: acc_subst) ttpl tl
| [],[] ->
let name = String.concat "_" (List.rev acc_name) in
name,acc_subst
Expand All @@ -89,9 +89,9 @@ let rec generic_substitute_type' gctx allow_expr t =
let t = info.build_apply (List.map (generic_substitute_type' gctx true) tl2) in
(match follow t,gctx.mg with TInst(c,_), Some m -> add_dependency m c.cl_module MDepFromTyping | _ -> ());
t
| _ ->
try
let t,eo = List.assq t gctx.subst in
| TInst ({ cl_kind = KTypeParameter _ } as c, tl2) ->
(try
let t,eo = List.assq c gctx.subst in
(* Somewhat awkward: If we allow expression types, use the original KExpr one. This is so
recursing into further KGeneric expands correctly. *)
begin match eo with
Expand All @@ -101,7 +101,9 @@ let rec generic_substitute_type' gctx allow_expr t =
generic_substitute_type' gctx false t
end
with Not_found ->
Type.map (generic_substitute_type' gctx allow_expr) t
Type.map (generic_substitute_type' gctx allow_expr) t)
| _ ->
Type.map (generic_substitute_type' gctx allow_expr) t

let generic_substitute_type gctx t =
generic_substitute_type' gctx false t
Expand Down Expand Up @@ -136,11 +138,8 @@ let generic_substitute_expr gctx e =
end;
| TTypeExpr (TClassDecl ({cl_kind = KTypeParameter _;} as c)) when Meta.has Meta.Const c.cl_meta ->
let rec loop subst = match subst with
| (t1,(_,eo)) :: subst ->
begin match follow t1 with
| TInst(c2,_) when c == c2 -> eo
| _ -> loop subst
end
| (c2,(_,eo)) :: subst ->
if c == c2 then eo else loop subst
| [] -> raise Not_found
in
begin try
Expand Down Expand Up @@ -279,11 +278,8 @@ let build_generic_class ctx c p tl =
let m = c.cl_module in
if gctx.generic_debug then begin
print_endline (Printf.sprintf "[GENERIC] Building @:generic class %s as %s with:" (s_type_path c.cl_path) name);
List.iter (fun (t1,(t2,eo)) ->
let name = match follow t1 with
| TInst(c,_) -> snd c.cl_path
| _ -> die "" __LOC__
in
List.iter (fun (c,(t2,eo)) ->
let name = snd c.cl_path in
let expr = match eo with
| None -> ""
| Some e -> Printf.sprintf " (expr: %s)" (s_expr_debug e)
Expand Down Expand Up @@ -326,7 +322,7 @@ let build_generic_class ctx c p tl =
let build_field cf_old =
let params = List.map (fun ttp ->
let ttp' = clone_type_parameter gctx mg ([cf_old.cf_name],ttp.ttp_name) ttp in
(ttp.ttp_type,ttp')
(ttp.ttp_class,ttp')
) cf_old.cf_params in
let param_subst = List.map (fun (t,ttp) -> t,(ttp.ttp_type,None)) params in
let gctx = {gctx with subst = param_subst @ gctx.subst} in
Expand Down

0 comments on commit cce269a

Please sign in to comment.