open Printf;;
exception Ex of int;;
let asert n b = if not b then raise (Ex n) in
let makePr n c = let n = ref n in 
   fun x -> (printf "%c%x " c x; n := !n - 1;
     asert 0 (!n != 0))
and makeId sink = fun inn -> sink inn
and sinkP = ignore
and makeTee sink1 sink2 = fun x -> (sink1 x; sink2 x)
and makeIota sink = let rec f n = (sink n; f (n+1)) in f
and makeSep sink1 sink2 = let wh = ref true in
  fun x -> if !wh then (wh := false; sink1 x)
           else (wh := true; sink2 x)
and makeOdds sink = let odd = ref false in
  fun x -> if !odd then (odd := false; sink x)
           else odd := true
and makeMerg sink = let left = ref true in
  (fun x -> asert 8 !left;       left := false; sink x),
  (fun x -> asert 9 (not !left); left := true;  sink x)
  
and makeCmp = let ele = ref 0 and full = ref false in
  (fun x -> if !full then (asert 6 (x = !ele); full := false;
  (if (x mod 10000000) = 0
    then (print_int (x / 10000000); print_newline ())))
         else (ele := x; full := true))
and make2utf8 sink = fun x ->
  let rec f x n = if x < (n asr 1) then sink ((0x100 - n) lor x)
  else (f (x asr 6) (n asr 1); sink (0x80 lor (x land 0x3f))) in
  if x < 0x80 then sink x else f x 0x80
and makeFutf8 sink = let st = ref 0 and ac = ref 0 in
  fun x -> asert 1 (x<0x100);
     if x < 0x80 then (asert 2 (!st=0); sink x)
     else if !st=0 then
       (asert 3 (x >= 0xc0);
        st := (let rec g n k = if (n land 64) > 0
           then k else g (n + n) (k+1) in g (lnot x) 0);
        ac := x land (lnot (-1 lsl (7 - !st))))
     else (asert 4 (!st > 0); st := !st - 1;
           ac := (!ac lsl 6) lor (x land 63);
           if !st=0 then sink !ac)
and makePlist list sink = let rec f list = match list with
     a::b -> (sink a; f b) | [] -> raise (Ex 0) in f list in
let makeStut sink = makeTee sink sink
and tr x = try (x ()) with Ex n ->
   if n = 0 then printf "\n"
   else printf "Bad %d\n" n in

tr (fun () -> makeIota (makeId (makeTee (makePr 100 ';') (makeStut
     (makeTee (makePr 50 '|') sinkP)))) 3);
tr (let a, b = makeMerg (makePr 50 ',') in fun () -> 
     (makeIota (makeSep a b) 2));
tr (fun () -> makeIota (makeOdds (makePr 50 '.')) 0);
tr (fun () -> makeIota (make2utf8 (makeFutf8 (makePr 5000 '.'))) 0);
tr (fun () -> let f = makeCmp in
   makePlist [0; 1; 0x7f; 0x80; 0x7ff; 0x800; 0xffff; 
     0x10000; 0x1fffff; 0x200000; 0x3ffffff; 0x4000000; 0x7fffffff]
     (makeTee (make2utf8 (makeFutf8 f)) f));
tr (fun () -> let f = makeCmp in
    makeIota (makeTee (make2utf8 (makeFutf8 f)) f) 0);;