From 0e7268310b1fcac999a1b3f4e8f6f9b68e7783fc Mon Sep 17 00:00:00 2001 From: Alex AUVOLAT Date: Sun, 5 Jan 2014 22:12:48 +0100 Subject: Handle EQIdent (expressions such as A::x and A::f(x, y) --- src/typing.ml | 35 +++++++++++++++++++++++++++++++++-- 1 file changed, 33 insertions(+), 2 deletions(-) (limited to 'src/typing.ml') diff --git a/src/typing.ml b/src/typing.ml index 6b1c801..009c8b5 100644 --- a/src/typing.ml +++ b/src/typing.ml @@ -233,6 +233,21 @@ let find_cls_mem env cls_name mem_name = | Some k -> k | None -> raise Not_found +let find_cls_superclass env cls_name superclass = + let rec aux s = + if s.h_class = superclass then + Some s + else + List.fold_left (fun q r -> + match q, aux r with + | Some l, None | None, Some l -> Some l + | None, None -> None + | _, _ -> ty_error ("Ambiguous reference to superclass " ^ superclass)) + None s.h_supers + in match aux (get_c env cls_name).tc_hier with + | Some k -> k + | None -> raise Not_found + (* -------------------------------------------- *) (* On passe aux choses sérieuses *) @@ -283,7 +298,15 @@ and compute_type env e = TEIdent i, (t, false, true) with Not_found -> ty_error ("Undeclared identifier: " ^ i) end - | EQIdent(c, i) -> assert false (* TODO *) + | EQIdent(c, i) -> + begin match env.b_class with + | Some k -> + let sc = try find_cls_superclass env.b_pe k.tc_name c + with Not_found -> ty_error (c ^ " is no superclass of current class " ^ k.tc_name) in + let mty, mi = find_cls_mem env.b_pe sc.h_class i in + TEMember(e_this_not_ptr, mi + sc.h_pos), (mty, false, true) + | None -> ty_error "Qualified identifier invalid in function belonging to no class." + end | EAssign (e1,e2) -> let te1,(ty1,r3,b3) = get_expr0 env e1 in let te2,(ty2,_,_) = get_expr0 env e2 in ty_assert (b3 || r3) "Can only assign to lvalue"; @@ -324,7 +347,6 @@ and compute_type env e = ); (* vérifs *) TEBinary(te1,op,te2),(T_Int,false,false) | ECall (e,e_list) -> - (* TODO : look also within parent classes *) let args_values = List.map (get_expr0 env) e_list in let args_types = List.map (fun (e, (t, r, l)) -> t, r||l) args_values in @@ -347,6 +369,15 @@ and compute_type env e = Some e, closest_proto env.b_pe args_types (find_protos_in_class env.b_pe k i) | _ -> ty_error "Invalid argument type for method call (not a class, or not a lvalue)" end + | EQIdent(c, i) -> + begin match env.b_class with + | Some k -> + let sc = try find_cls_superclass env.b_pe k.tc_name c + with Not_found -> ty_error (c ^ " is no superclass of current class " ^ k.tc_name) in + Some e_this_not_ptr, + closest_proto env.b_pe args_types (find_protos_in_class env.b_pe sc.h_class i) + | None -> ty_error "Qualified identifier in a function belonging to no class." + end | _ -> ty_error "Calling something that is neither a function nor a method") in let l_te = List.map fst args_values in let ty,b = match tproto.tp_ret_type with -- cgit v1.2.3 From f22f13c56832da810e297039f858f8b129661a4b Mon Sep 17 00:00:00 2001 From: Alex AUVOLAT Date: Sun, 5 Jan 2014 22:18:18 +0100 Subject: Handle EQIdent properl --- src/typing.ml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'src/typing.ml') diff --git a/src/typing.ml b/src/typing.ml index dae139c..3fd0f72 100644 --- a/src/typing.ml +++ b/src/typing.ml @@ -418,8 +418,12 @@ and compute_type env e = | Some k -> let sc = try find_cls_superclass env.b_pe k.tc_name c with Not_found -> ty_error (c ^ " is no superclass of current class " ^ k.tc_name) in - Some e_this_not_ptr, - closest_proto env.b_pe args_types (find_protos_in_class env.b_pe sc.h_class i) + let proto = closest_proto env.b_pe args_types (find_protos_in_class env.b_pe sc.h_class i) in + let upcasted = if proto.tp_virtual = None + then upcast env.b_pe e_this_not_ptr (TClass(c)) + else upcast env.b_pe e_this_not_ptr + (TClass (match proto.tp_class with | None -> assert false | Some k -> k)) in + Some upcasted, proto | None -> ty_error "Qualified identifier in a function belonging to no class." end | _ -> ty_error "Calling something that is neither a function nor a method") in -- cgit v1.2.3