Skip to content

Instantly share code, notes, and snippets.

let device_flush ppf =
let fs = Format.pp_get_formatter_out_functions ppf () in
fs.out_flush ()
let force_break_hints ppf =
let margin = Format.pp_get_margin ppf () in
Format.pp_print_as ppf (margin+1) ""
let gentler_flush ppf =
force_break_hints ppf; device_flush ppf
type 'a abstract
sig
type 'a x = X
type 'a t = A: 'a -> 'a x t
end with type 'a x = 'a abstract
type 'a printer = Format.formatter -> 'a -> unit
type 'a rand = unit -> 'a
let flushed_list pr ppf x =
List.iter (Format.fprintf ppf "%a@." pr) x
module type testable = sig
type t
val pp: t printer
type _ data_cstr = ..
module type t = sig
type a
type _ data_cstr += Fmt: a data_cstr
end
type 'a data_format = (module t with type a = 'a)
let mk_data_format : type a. unit -> a data_format = fun () ->
@Octachron
Octachron / hashed_eq_register.ml
Created February 23, 2022 12:31
Type equality register with hashtbl
type _ data_cstr = ..
type 'a data_format = { id: extension_constructor; cstr: 'a data_cstr}
type (_, _) eq = Eq : ('a, 'a) eq
type data_key = { is_eq: 'a 'b. 'a data_cstr -> 'b data_cstr -> ('a,'b) eq option }
let data_format_register : (extension_constructor, data_key) Hashtbl.t = Hashtbl.create 17
@Octachron
Octachron / bidi.py
Last active November 5, 2021 09:58
Bidirectional test
s = "א" * 100 # "א" is assigned
type e = ..
type e += A | B | C | D | E | F
let f = function
| A -> 1
| B -> 2
| C -> 3
| D -> 4
| E -> 5
type msg = ..
type query_answer =
| Accepted
| Unknown
let printer_registry: (Format.formatter -> msg -> query_answer) list ref = ref []
let register_printer x = printer_registry := x :: !printer_registry
let print ppf msg =
type 'a s = private Succ
type ('elt,'size) t =
| [] : ('elt, 'a -> 'a) t
| (::): 'elt * ('elt, 'z -> 'k) t -> ('elt, 'z -> 'k s) t
let rec (@): type elt low mid high.
(elt, mid -> high) t -> (elt, low -> mid) t -> (elt, low -> high) t =
fun l r ->
match l with
type void = |
module Make(T:sig type 'a t end) = struct
type 'a t =
| []: void t
| (::): 'a T.t * 'b t -> ('a -> 'b) t
end
module HL = Make(struct type 'a t = 'a end)