let narrow =
    let intersect f origin m1 m2 =
      if m1 == m2 then m1 else
        match m1, m2 with
        | Top (x1, a1), Top (x2, a2) ->
            let meet_topparam = Top_Param.meet x1 x2 in
            Top (meet_topparam, origin x1 a1 x2 a2)
        | Top (Top_Param.Top, _), (Map _ as x)
        | (Map _ as x),Top (Top_Param.Top, _) -> x
        | Top (Top_Param.Set set, _), (Map _ as x)
        | (Map _ as x), Top (Top_Param.Set set, _) ->
            filter_base (fun v -> is_in_set ~set v) x
        | Map m1, Map m2 ->
            let merge_key k v acc =
              add_or_bottom k (f v (find_or_bottom k m2)) acc in
            Map (M.fold merge_key m1 M.empty)
    in 
    let compute_origin_narrow x1 a1 x2 a2 =
      if Top_Param.equal x1 x2 then
        Origin.narrow a1 a2
      else if Top_Param.is_included x1 x2
      then a1
      else if Top_Param.is_included x2 x1
      then a2
      else Origin.top
    in
    (fun x y -> let r = intersect V.narrow compute_origin_narrow x y in
(*     Format.printf "Map_Lattice.narrow %a and %a ===> %a@\n"
       pretty x pretty y pretty r;  *)

     r)