gsg

module LazyFix = struct
  let rec fix f = f (lazy (fix f))

  let f_open = fun clo (x : int) ->
    if x <= 0 then x else (snd (Lazy.force clo)) (x - 1)
  let g_open = fun clo (x : int) ->
    if x <= 0 then x else (fst (Lazy.force clo)) (x - 1)

  let clo = fix (fun clo -> f_open clo, g_open clo)

gsg

let first f (x, y) = (f x, y)

(** A more efficient version of List.concat. *)
let list_concat ll = List.rev (List.fold_left (fun a b -> List.rev_append b a) [] ll)

module type Monoid = sig
  type t
  val mempty : t
  val mappend : t -> t -> t
  val mconcat : t list -> t

gsg

let first f (x, y) = (f x, y)

(** A more efficient version of List.concat. *)
let list_concat ll = List.rev (List.fold_left (fun a b -> List.rev_append b a) [] ll)

module type Monoid = sig
  type t
  val mempty : t
  val mappend : t -> t -> t
  val mconcat : t list -> t

gsg

type symbol = string

module Env = Map.Make (String)

type binary_op = Add | Sub | Mul | Div

module Type = struct
  type t =
    | Unit | Int

gsg

let f =
  FUN t -> fun l ->
    case l of
    | Nil [t] -> None [t]
    | Cons [t] x _ -> Some [t] x

gsg

head : forall x . List x -> Maybe x
head = /\(t : *) . \(l : List t) ->
  case l of
   | Cons [t] x _ -> Just [t] x
   | Nil [t] -> Nothing [t]

gsg

type ('a, 'b) tmp_results =
  | Nada
  | Other of ('a, 'b) tmp_result
  constraint 'b = <
    to_str : string;
    pack : ('a,'b) tmp_results;
    unpack: 'a;
    ..
  >

gsg

type t1 = [`Foo]

let name1 = function `Foo -> "foo"

type t2 = [t1 | `Bar]

let name2 = function #t1 as f -> name1 f | `Bar -> "bar"

gsg

let test1 () =
  let tbl = Hashtbl.create 16 in
  let z = Big_int.big_int_of_string "3242314122423341231" in
  Hashtbl.add tbl z ();
  Hashtbl.find tbl z

let test2 () =
  let tbl = Hashtbl.create 16 in
  let z1 = Big_int.big_int_of_string "3242314122423341231" in

gsg

let partition a p =
  let len = Array.length a in
  let rec loop l r =
    if r = len then l
    else if p a.(r) then begin
      let tmp = a.(l) in
      a.(l) <- a.(r);
      a.(r) <- tmp;
      loop (l + 1) (r + 1)
    end else