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

Diff of /typing/typer.ml

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

revision 64 by abate, Tue Jul 10 17:02:32 2007 UTC revision 65 by abate, Tue Jul 10 17:02:35 2007 UTC
# Line 430  Line 430 
430          | Some f -> Env.add f a.fun_typ env in          | Some f -> Env.add f a.fun_typ env in
431        List.iter        List.iter
432          (fun (t1,t2) ->          (fun (t1,t2) ->
433             ignore (type_check_branches loc env true t1 a.fun_body t2 false)             ignore (type_check_branches loc env t1 a.fun_body t2 false)
434          ) a.fun_iface;          ) a.fun_iface;
435        t        t
436    
437    | Match (e,b) ->    | Match (e,b) ->
438        let t = type_check env e b.br_accept true in        let t = type_check env e b.br_accept true in
439        type_check_branches loc env true t b constr precise        type_check_branches loc env t b constr precise
440    
441    | Try (e,b) ->    | Try (e,b) ->
442        let te = type_check env e constr precise in        let te = type_check env e constr precise in
443        let tb = type_check_branches loc env false Types.any b constr precise in        let tb = type_check_branches loc env Types.any b constr precise in
444        Types.cup te tb        Types.cup te tb
445    
446    | Pair (e1,e2) ->    | Pair (e1,e2) ->
# Line 503  Line 503 
503        let res =        let res =
504          Sequence.map          Sequence.map
505            (fun t ->            (fun t ->
506               type_check_branches loc env true t b constr' (precise || (not exact)))               type_check_branches loc env t b constr' (precise || (not exact)))
507            t in            t in
508        if not exact then check loc res constr "";        if not exact then check loc res constr "";
509        if precise then res else constr        if precise then res else constr
# Line 570  Line 570 
570        type_op loc op args        type_op loc op args
571    | Map (e,b) ->    | Map (e,b) ->
572        let t = compute_type env e in        let t = compute_type env e in
573        Sequence.map (fun t -> type_check_branches loc env true t b Types.any true) t        Sequence.map (fun t -> type_check_branches loc env t b Types.any true) t
574    
575  (* We keep these cases here to allow comparison and benchmarking ...  (* We keep these cases here to allow comparison and benchmarking ...
576     Just comment the corresponding cases in type_check' to     Just comment the corresponding cases in type_check' to
# Line 591  Line 591 
591    
592    | _ -> assert false    | _ -> assert false
593    
594  and type_check_branches loc env exh targ brs constr precise =  and type_check_branches loc env targ brs constr precise =
595    if Types.is_empty targ then Types.empty    if Types.is_empty targ then Types.empty
596    else (    else (
597      brs.br_typ <- Types.cup brs.br_typ targ;      brs.br_typ <- Types.cup brs.br_typ targ;
598      branches_aux loc env exh targ      branches_aux loc env targ
599        (if precise then Types.empty else constr)        (if precise then Types.empty else constr)
600        constr precise brs.br_branches        constr precise brs.br_branches
601    )    )
602    
603  and branches_aux loc env exh targ tres constr precise = function  and branches_aux loc env targ tres constr precise = function
604    | [] -> if exh then raise_loc loc (NonExhaustive targ) else tres    | [] -> raise_loc loc (NonExhaustive targ)
605    | b :: rem ->    | b :: rem ->
606        let p = b.br_pat in        let p = b.br_pat in
607        let acc = Types.descr (Patterns.accept p) in        let acc = Types.descr (Patterns.accept p) in
608    
609        let targ' = Types.cap targ acc in        let targ' = Types.cap targ acc in
610        if Types.is_empty targ'        if Types.is_empty targ'
611        then branches_aux loc env exh targ tres constr precise rem        then branches_aux loc env targ tres constr precise rem
612        else        else
613          ( b.br_used <- true;          ( b.br_used <- true;
614            let res = Patterns.filter targ' p in            let res = Patterns.filter targ' p in
# Line 619  Line 619 
619            let tres = if precise then Types.cup t tres else tres in            let tres = if precise then Types.cup t tres else tres in
620            let targ'' = Types.diff targ acc in            let targ'' = Types.diff targ acc in
621            if (Types.non_empty targ'') then            if (Types.non_empty targ'') then
622              branches_aux loc env exh targ'' tres constr precise rem              branches_aux loc env targ'' tres constr precise rem
623            else            else
624              tres              tres
625          )          )
Legend:
Removed from v.64  
changed lines
  Added in v.65
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5