Skip to content

Commit

Permalink
cleanup
Browse files Browse the repository at this point in the history
  • Loading branch information
Simn committed Sep 5, 2014
1 parent 9f46179 commit cf7a0fa
Show file tree
Hide file tree
Showing 2 changed files with 30 additions and 29 deletions.
19 changes: 10 additions & 9 deletions type.ml
Original file line number Diff line number Diff line change
Expand Up @@ -636,6 +636,7 @@ let field_type f =
| l -> monomorphs l f.cf_type

let rec raw_class_field build_type c tl i =
let apply = apply_params c.cl_params tl in
try
let f = PMap.find i c.cl_fields in
Some (c,tl), build_type f , f
Expand All @@ -646,9 +647,9 @@ let rec raw_class_field build_type c tl i =
match c.cl_super with
| None ->
raise Not_found
| Some (csup,tl2) ->
let c2 , t , f = raw_class_field build_type csup (List.map (apply_params c.cl_params tl) tl2) i in
c2, apply_params csup.cl_params tl2 t , f
| Some (c,tl) ->
let c2 , t , f = raw_class_field build_type c (List.map apply tl) i in
c2, apply_params c.cl_params tl t , f
with Not_found ->
match c.cl_kind with
| KTypeParameter tl ->
Expand All @@ -663,10 +664,10 @@ let rec raw_class_field build_type c tl i =
None, build_type f, f
with
Not_found -> loop ctl)
| TInst (cp,tl2) ->
| TInst (c,tl) ->
(try
let c2, t , f = raw_class_field build_type cp (List.map (apply_params c.cl_params tl) tl2) i in
c2, apply_params cp.cl_params tl2 t, f
let c2, t , f = raw_class_field build_type c (List.map apply tl) i in
c2, apply_params c.cl_params tl t, f
with
Not_found -> loop ctl)
| _ ->
Expand All @@ -682,10 +683,10 @@ let rec raw_class_field build_type c tl i =
let rec loop = function
| [] ->
raise Not_found
| (ci,tl2) :: l ->
| (c,tl) :: l ->
try
let c2, t , f = raw_class_field build_type ci (List.map (apply_params c.cl_params tl) tl2) i in
c2, apply_params ci.cl_params tl2 t, f
let c2, t , f = raw_class_field build_type c (List.map apply tl) i in
c2, apply_params c.cl_params tl t, f
with
Not_found -> loop l
in
Expand Down
40 changes: 20 additions & 20 deletions typer.ml
Original file line number Diff line number Diff line change
Expand Up @@ -721,53 +721,53 @@ let unify_field_call ctx fa el args ret p inline =
let expand_overloads map cf =
(TFun(args,ret),cf) :: (List.map (map_cf map) cf.cf_overloads)
in
let candidates,is_overload,mk_fa = match fa with
let candidates,co,cf,mk_fa = match fa with
| FStatic(c,cf) ->
expand_overloads (fun t -> t) cf,Meta.has Meta.Overload cf.cf_meta,(fun cf -> FStatic(c,cf))
expand_overloads (fun t -> t) cf,Some c,cf,(fun cf -> FStatic(c,cf))
| FAnon cf ->
expand_overloads (fun t -> t) cf,Meta.has Meta.Overload cf.cf_meta,(fun cf -> FAnon cf)
expand_overloads (fun t -> t) cf,None,cf,(fun cf -> FAnon cf)
| FInstance(c,tl,cf) ->
let map = apply_params c.cl_params tl in
let cfl = if cf.cf_name = "new" || not (Meta.has Meta.Overload cf.cf_meta && ctx.com.config.pf_overload) then
List.map (map_cf map) cf.cf_overloads
else
List.map (fun (t,cf) -> map (monomorphs cf.cf_params t),cf) (Typeload.get_overloads c cf.cf_name)
in
(TFun(args,ret),cf) :: cfl,Meta.has Meta.Overload cf.cf_meta,(fun cf -> FInstance(c,tl,cf))
(TFun(args,ret),cf) :: cfl,None,cf,(fun cf -> FInstance(c,tl,cf))
| _ ->
error "Invalid field call" p
in
let is_forced_inline = false in
let is_forced_inline = is_forced_inline co cf in
let is_overload = Meta.has Meta.Overload cf.cf_meta in
let candidates,failures = List.fold_left (fun (candidates,failures) (t,cf) ->
begin try
begin match follow t with
| TFun(args,ret) ->
let el,tf = unify_call_args' ctx el args ret p inline is_forced_inline in
let el,tf = unify_call_args' ctx el args ret p inline is_forced_inline in
let mk_call ethis =
let ef = mk (TField(ethis,fa)) tf p in
make_call ctx ef (List.map fst el) ret p
in
(el,tf,mk_call) :: candidates,failures
(el,tf,mk_call) :: candidates,failures
| _ ->
assert false
end
with Error (Call_error _,_) as err ->
candidates,err :: failures
end
) ([],[]) candidates in
let candidates = if is_overload && ctx.com.config.pf_overload then
Codegen.Overloads.reduce_compatible candidates
else
List.rev candidates
let fail () = match List.rev failures with
| err :: _ -> raise err
| _ -> assert false
in
match candidates with
| [] ->
begin match List.rev failures with
| err :: _ -> raise err
| _ -> assert false
end
| _ :: _ :: _ when is_overload && ctx.com.config.pf_overload -> error "Ambiguous overload" p
if is_overload && ctx.com.config.pf_overload then begin match Codegen.Overloads.reduce_compatible candidates with
| [] -> fail()
| [el,tf,mk_call] -> List.map fst el,tf,mk_call
| _ -> error "Ambiguous overload" p
end else begin match List.rev candidates with
| [] -> fail()
| (el,tf,mk_call) :: _ -> List.map fst el,tf,mk_call
end

let fast_enum_field e ef p =
let et = mk (TTypeExpr (TEnumDecl e)) (TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics e) }) p in
Expand Down Expand Up @@ -1716,7 +1716,7 @@ let type_generic_function ctx (e,cf) el ?(using_param=None) with_type p =
cf2
in
let e = if stat then type_type ctx c.cl_path p else e in
let e = acc_get ctx (field_access ctx MCall cf2 (if stat then FStatic (c,cf2) else FInstance (c,[],cf2)) cf2.cf_type e p) p in (* TODO *)
let e = acc_get ctx (field_access ctx MCall cf2 (if stat then FStatic (c,cf2) else FInstance (c,tl,cf2)) cf2.cf_type e p) p in
make_call ctx e el ret p
with Codegen.Generic_Exception (msg,p) ->
error msg p)
Expand Down Expand Up @@ -2901,7 +2901,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
let el = e1 :: el in
let v = gen_local ctx tmap in
let ev = mk (TLocal v) tmap p in
let ef = mk (TField(ev,FInstance(c,[],cf))) (tfun [tkey;tval] ctx.t.tvoid) p in (* TODO *)
let ef = mk (TField(ev,FInstance(c,[tkey;tval],cf))) (tfun [tkey;tval] ctx.t.tvoid) p in
let el = ev :: List.fold_left (fun acc e -> match fst e with
| EBinop(OpArrow,e1,e2) ->
let e1,e2 = type_arrow e1 e2 in
Expand Down

0 comments on commit cf7a0fa

Please sign in to comment.