--- a/keyMerge.ml
+++ b/keyMerge.ml
@@ -87,24 +87,40 @@ let packets_equal p1 p2 = p1 = p2
 (*******************************************************************)
 (** Code for flattening out the above structure back to the original key *)
 
-let rec flatten_sigpair_list list = match list with
-    [] -> []
-  |  (pack,sigs)::tl -> pack :: (sigs @ flatten_sigpair_list tl)
+let rec flatten_sigpair_list list =
+  match list with
+  | [] -> []
+  | (pack,sigs)::tl -> pack :: (List.rev_append sigs (flatten_sigpair_list tl)) (* order of sigs doesn't matter *)
+
+(* stack proportional to [List.length l] which is constant in our case *)
+let rec list_concat l =
+  match l with
+  | [] -> []
+  | h::tl -> List.rev_append (List.rev h) (list_concat tl)
 
 let flatten key =
-  key.key :: List.concat [ key.selfsigs;
+  key.key :: list_concat [ key.selfsigs;
                            flatten_sigpair_list key.uids;
                            flatten_sigpair_list key.subkeys ]
 
 
 (************************************************************)
 
+let nr_packets l = List.fold_left ~f:(fun acc (_,l) -> acc + List.length l) ~init:0 l
+
 let print_pkey key =
-  printf "%d selfsigs, %d uids, %d subkeys\n"
+  let uid =
+    match List.filter ~f:(fun (p,_) -> p.packet_type = User_ID_Packet) key.uids with
+    | [] -> ""
+    | (h,_)::_ -> h.packet_body
+  in
+  printf "%S : %d selfsigs, %d uids (%d packets), %d subkeys (%d packets)\n"
+    uid
     (List.length key.selfsigs)
     (List.length key.uids)
+    (nr_packets key.uids)
     (List.length key.subkeys)
-
+    (nr_packets key.subkeys)
 
 (*******************************************************************)
 
@@ -114,13 +130,6 @@ let get_version packet =
     | Signature_Packet -> int_of_char packet.packet_body.[0]
     | _ -> raise Not_found
 
-let key_to_stream key =
-  let ptype_list = List.map ~f:(fun pack -> (pack.packet_type,pack)) key in
-  Stream.of_list ptype_list
-
-
-
-
 (*******************************************************************)
 (*** Key Parsing ***************************************************)
 (*******************************************************************)
@@ -128,28 +137,24 @@ let key_to_stream key =
 let parse_list parser strm =
   let rec loop parser strm accum =
     match parser strm with
-    | Some elt -> loop parser strm (elt :: accum)
-    | None -> List.rev accum
+    | Some (elt, strm) -> loop parser strm (elt :: accum)
+    | None -> List.rev accum, strm
   in
   loop parser strm []
 
 let parse_sig strm =
-  match Stream.peek strm with
-  | Some (Signature_Packet, p) ->
-    Stream.junk strm;
-    Some p
+  match strm with
+  | { packet_type = Signature_Packet; _ } as p :: strm -> Some (p,strm)
   | _ -> None
 
 let parse_uid strm =
-  match Stream.peek strm with
-  | Some (User_ID_Packet, p) ->
-    Stream.junk strm;
-    let sigs = parse_list parse_sig strm in
-    Some (p, sigs)
-  | Some ((User_Attribute_Packet, p)) ->
-    Stream.junk strm;
-    let sigs = parse_list parse_sig strm in
-    Some (p, sigs)
+  match strm with
+  | { packet_type = User_ID_Packet; _ } as p :: strm ->
+    let sigs, strm = parse_list parse_sig strm in
+    Some ((p, sigs), strm)
+  | { packet_type = User_Attribute_Packet; _ } as p :: strm ->
+    let sigs, strm = parse_list parse_sig strm in
+    Some ((p, sigs), strm)
   | _ ->
       (*
       (p,sigs)::(match s with parser
@@ -160,31 +165,31 @@ let parse_uid strm =
     None
 
 let parse_subkey strm =
-  match Stream.peek strm with
-  | Some (Public_Subkey_Packet, p) ->
-    Stream.junk strm;
-    let sigs = parse_list parse_sig strm in
-    Some (p, sigs)
+  match strm with
+  | { packet_type = Public_Subkey_Packet; _ } as p :: strm ->
+    let sigs, strm = parse_list parse_sig strm in
+    Some ((p, sigs), strm)
   | _ -> None
 
-let parse_keystr strm =
-  match Stream.peek strm with
-  | Some (Public_Key_Packet, key) ->
-    Stream.junk strm;
+let key_to_pkey strm =
+  match strm with
+  | { packet_type = Public_Key_Packet; _ } as key :: strm ->
     begin match get_version key with
     | 4 ->
-      let selfsigs = parse_list parse_sig strm in
-      let uids = parse_list parse_uid strm in
-      let subkeys = parse_list parse_subkey strm in
+      let selfsigs, strm = parse_list parse_sig strm in
+      let uids, strm = parse_list parse_uid strm in
+      let subkeys, strm = parse_list parse_subkey strm in
+      if strm <> [] then raise Unparseable_packet_sequence;
       { key; selfsigs; uids; subkeys; }
     | 2 | 3 ->
-      let revocations = parse_list parse_sig strm in
-      let uids = parse_list parse_uid strm in
+      let revocations, strm = parse_list parse_sig strm in
+      let uids, strm = parse_list parse_uid strm in
+      if strm <> [] then raise Unparseable_packet_sequence;
       { key; selfsigs = revocations; uids; subkeys = []; }
     | _ ->
       failwith "Unexpected key packet version number"
     end
-  | _ -> raise Stream.Failure
+  | _ -> raise Unparseable_packet_sequence
 
 (*******************************************************************)
 (*** Key Merging Code  *********************************************)
@@ -231,17 +236,6 @@ let merge_pkeys key1 key2 =
 (*******************************************************************)
 (*******************************************************************)
 
-let key_to_pkey key =
-  try
-    let keystream = key_to_stream key in
-    let pkey = parse_keystr keystream in
-    Stream.empty keystream;
-    pkey
-  with
-      Stream.Failure | Stream.Error _ ->
-        raise Unparseable_packet_sequence
-
-
 let merge key1 key2 =
   try
     let pkey1 = key_to_pkey key1
