keleshev

open StdLabels

let id x = x
let (>>) f g a = g (f a)

let for_all ~set f = 
  List.iter ~f:(fun x -> assert (f x)) set

let for_all2 ~set f = 
  for_all ~set (fun a -> 

keleshev

module Cortege0 = struct
  type _ t =
    | [] : unit t
    | (::) : 'a * 'b t -> ('a -> 'b) t
end

keleshev

let (>>) f g x = g (f x)

module Option = struct
  let value ~default = function
    | None -> default
    | Some x -> x
end

module String = struct
  include String

keleshev

#!/usr/bin/env ruby

require "./rendertree"
require "./bin"

def compress(original)
  tree = build_tree(original)
  table = build_table(tree)
  packer = BinPacker.new

keleshev

module Tree = struct
  type t =
    | Node of {count: int; left: t; right: t}
    | Leaf of {count: int; byte: char}

  let count = function Node {count; _} | Leaf {count; _} -> count

  let compare left right = Pervasives.compare (count left) (count right)

  let rec nodes_to_tree nodes =

keleshev

#!/usr/bin/env ocaml

let detect_sdk_version sdk_dir =
  let include_ = sdk_dir </> "Include" in
  Bin.ls include_ >>= fun dirs ->
  let is_version dir = File.exist (include_ </> dir </> "um/Windows.h") in
  Sh.filter dirs ~f:is_version >>= fun versions ->
  Sh.head versions

keleshev

module type Functor = sig
  type 'a t

  val map: ('a -> 'b) -> 'a t -> 'b t
end


module type Applicative = sig
  type 'a t

keleshev

(* Naive Levenshtein distance and the related diffing algorithm

   $ ocaml levenshtein.ml 
 
 *)

let (=>) left right = print_char (if left = right then '.' else 'F')

module Levenshtein = struct

keleshev

module Hashtbl = MoreLabels.Hashtbl

module Memoized = struct

  let create ?(size=8) f =
    let table = Hashtbl.create size in
    fun argument ->
      try Hashtbl.find table argument
      with Not_found ->
        let result = f argument in

keleshev

module Int : sig
  type t

  (** Return None on overflow *)
  val (+) : t -> t -> t option
  val (-) : t -> t -> t option
  val ( * ) : t -> t -> t option

  (** Return None when divided by zero *)
  val (/) : t -> t -> t option