Octachron

external fiber_memory: unit -> int = "caml_fiber_memory" [@@noalloc]
external active_fiber_memory: unit -> int = "caml_active_fiber_memory" [@@noalloc]


let () = Format.eprintf "m : %d@." (fiber_memory ())

type _ Effect.t += Unit: unit Effect.t

let keep_fiber () =
  let r = ref None in

Octachron

[@@@warning "-32"]
(*  C stubs:

#define CAML_INTERNALS

#include <caml/mlvalues.h>
#include <caml/fiber.h>

value caml_used_stack_size(value cont) {
  value vstack = Field(cont, 0);

Octachron

type any = [ `A | `B | `C ]

type _ t =
| A : [> `A ] t
| B: [> `B ] t
| C: [> `C ] t

let tag (type a) (x: a t) = match x with
| A -> 0
| B -> 1

Octachron

let w = Weak.create 2

let gen () =
  let x = "Hello" ^ string_of_int (Random.int 50) in
  Weak.set w 0 (Some x);
  let f () = () in
  Gc.finalise_last (fun () -> ignore (Sys.opaque_identity x)) f;
  f

let forgetful_gen2 () =

Octachron

type 'a t =
  | Constant of 'a 
    (** [Constant x] is a normal value *)
  | Input of (int -> 'a t)
    (** [Input x] is a value which is blocked on an missing (int) user input *)

let pure x = Constant x

(** [int: int t] is the core extension of ['a t] compared to normal values ['a]:
    it is a concrete representation of the action "reading an integer on stdin"

Octachron

let[@tail_mod_cons] rec split escape_char char start pos s =
  if pos >= String.length s then
    [String.sub s start (String.length s - start)]
  else
    let c = s.[pos] in
    if c = char then
      (String.sub s start (pos-start)) :: split escape_char char (pos+1) (pos+1) s
    else
      let pos =  if c = escape_char then pos + 2 else pos + 1 in
      split escape_char char start pos s

Octachron

module Url = struct let v2 = "v2" end

let fwd_v2 target = (target, Url.v2 ^ target)

let pp_ocaml_version ppf (mj, mn) =
  if mj >= 5 then Format.fprintf ppf "%d.%d" mj mn
  else Format.fprintf ppf "%d.%02d" mj mn

let notes_redirections v =
  let fwd_v2_notes x =

Octachron

module type pair = sig type a type b end

module type S = functor (Pair:sig include pair type b = a end) -> sig
  open Pair
  type either = Left of a | Right of b
end

module R = struct
  type a = A
  type b = a

Octachron

module Unit: sig
  type 'a t
  val magic: 'a t -> 'b t
  type m type s
  val m: m t
  val s: s t
  val (+): 'a t -> 'a t -> 'a t
  val ( * ): 'a t -> 'b t -> ('a * 'b) t 
end = struct
  type 'a t =float

Octachron

type _ calculi_register = ..

type 'a c =
  | Core of 'a
  | Ext: 'b calculi_register *'b -> 'a c

type mixed_eval = { eval: 'a. 'a calculi_register -> 'a -> 'a c }

module type ext_calculus = sig
  type core