/[svn]/typing/typer.ml
ViewVC logotype

Diff of /typing/typer.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 28 by abate, Tue Jul 10 16:59:15 2007 UTC revision 29 by abate, Tue Jul 10 16:59:19 2007 UTC
# Line 333  Line 333 
333            let (fv,e) = expr e in            let (fv,e) = expr e in
334            (fv,  Typed.Dot (e,l))            (fv,  Typed.Dot (e,l))
335        | RecordLitt r ->        | RecordLitt r ->
336            (* XXX TODO: check that no label appears twice *)            (* Note: quadratic check for non duplication of labels.
337                 Should improve that to O(n log n) for dealing
338                 with huge number of attributes ?
339              *)
340            let fv = ref Fv.empty in            let fv = ref Fv.empty in
341            let labs = ref [] in            let labs = ref [] in
342            let r = List.map            let r = List.map
# Line 435  Line 438 
438          Types.times (Types.cons t1) (Types.cons t2)          Types.times (Types.cons t1) (Types.cons t2)
439        else        else
440          constr          constr
441      | RecordLitt r ->
442          let rconstr = Types.Record.get constr in
443          if Types.Record.is_empty rconstr then
444            raise_loc loc (ShouldHave (constr,"but it is a record."));
445    
446          let (rconstr,res) =
447            List.fold_left
448              (fun (rconstr,res) (l,e) ->
449                 let rconstr = Types.Record.restrict_label_present rconstr l in
450                 let pi = Types.Record.project_field rconstr l in
451                 if Types.Record.is_empty rconstr then
452                   raise_loc loc
453                     (ShouldHave (constr,(Printf.sprintf
454                                            "Field %s is not allowed here."
455                                            (Types.label_name l)
456                                         )
457                                 ));
458                 let t = type_check env e pi true in
459                 let rconstr = Types.Record.restrict_field rconstr l t in
460    
461                 let res =
462                   if precise
463                   then Types.cap res (Types.record l false (Types.cons t))
464                   else res in
465                 (rconstr,res)
466              ) (rconstr, if precise then Types.Record.any else constr) r
467          in
468          res
469    
470    | _ ->    | _ ->
471        let t : Types.descr = compute_type' loc env e in        let t : Types.descr = compute_type' loc env e in
472        check loc t constr "";        check loc t constr "";
# Line 460  Line 492 
492        let t = type_check env e Types.Record.any true in        let t = type_check env e Types.Record.any true in
493           (try (Types.Record.project t l)           (try (Types.Record.project t l)
494            with Not_found -> raise_loc loc (WrongLabel(t,l)))            with Not_found -> raise_loc loc (WrongLabel(t,l)))
   | RecordLitt r ->  
       List.fold_left  
         (fun accu (l,e) ->  
            let t = compute_type env e in  
            let t = Types.record l false (Types.cons t) in  
            Types.cap accu t  
         ) Types.Record.any r  
495    | Op (op, el) ->    | Op (op, el) ->
496        let args = List.map (fun e -> (e.exp_loc, compute_type env e)) el in        let args = List.map (fun e -> (e.exp_loc, compute_type env e)) el in
497        type_op loc op args        type_op loc op args
Legend:
Removed from v.28  
changed lines
  Added in v.29
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5