Skip to content

Instantly share code, notes, and snippets.

View table.ml
(*
* GADT friendly hash tables.
*)
module type GadtHashEq = sig
type 'a key
type 'a value
val eq_assoc : 'a key -> 'b key -> 'b value -> 'a value option
val hash : 'a key -> int
end
View trace.ml
module rec Value : sig
type t =
| Nil
| Bool of bool
| Float of float
| String of string
| Table of table
and table = {
id : int;
table : t Table.t;
View impredicative_polymorphism_with_poly_variants.ml
type x = [ `A ]
type y = [ x | `B ]
type z = [ y | `C ]
type 'a t =
| X_1 of x * 'a
| X_2 of x * 'a
| Y_a of x
| Y_var of 'a
constraint 'a = [< z ]
View univ.ml
module Univ : sig
type t
val embed : unit -> ('a -> t) * (t -> 'a option)
end = struct
type t = unit ref * (unit -> unit)
let embed () =
let id = ref () in
let loc = ref None in
let put x = id, (fun () -> loc := Some x) in
let get (rid, rstore) =
View gadt_alist.ml
module Eq = struct
type (_,_) t = Refl : ('a,'a) t
end
module type EqAssoc = sig
type 'a key
type 'a value
val equal : 'a key -> 'b key -> ('a, 'b) Eq.t option
end
View gadt_alist.ml
type _ t = I : int -> int t | F : float -> float t
module TEq = struct
type 'a key = 'a t
type 'a value = 'a t
let equal : type a b . a key -> b key -> (a, b) Eq.t option =
fun x y -> match x, y with
| I a, I b -> if a = b then Some Eq.Refl else None
| F a, F b -> if a = b then Some Eq.Refl else None
| _ -> None
View test.ml
module M = struct
type 'a key
type 'a value
type t = Univ : 'a key * 'a value -> t
type polymorphic_operations = {
conv_key : 'a . 'a key -> string;
conv_value : 'a . 'a value -> string;
}
let as_strings : type a . polymorphic_operations -> t -> (string * string) =
fun ops t -> match t with
View test.ml
module type Witness = sig type 'a key type 'a value end
module type Witnessed = sig
type 'a key
type 'a value
type t
type ('a, 'b) conv = {
key : 'c . 'c key -> 'a;
value : 'c . 'c value -> 'b;
}
View combination.lisp
(defun comb2 (f x y)
(funcall f (+ x y))
(funcall f (- x y))
(funcall f (- y x))
(funcall f (* x y))
(when (not (zerop y))
(funcall f (/ x y)))
(when (not (zerop x))
(funcall f (/ y x))))
View test.ml
module Test : sig
val f : unit -> unit
end = struct
exception Foo
exception Bar of exn
let f () = raise (Bar Foo)
end