ligo/Utils.ml

(* Utility types and functions *)

(* Identity *)

let id x = x

(* Combinators *)

let (<@) f g x = f (g x)

let swap f x y = f y x

let lambda = fun x _ -> x

let curry f x y = f (x,y)
let uncurry f (x,y) = f x y

(* Parametric rules for sequences *)

type        'a    nseq = 'a * 'a list
type ('a,'sep) nsepseq = 'a * ('sep * 'a) list
type ('a,'sep)  sepseq = ('a,'sep) nsepseq option

(* Consing *)

let nseq_cons x (hd,tl) = x, hd::tl
let nsepseq_cons x sep (hd,tl) = x, (sep,hd)::tl

let sepseq_cons x sep = function
          None -> x, []
| Some (hd,tl) -> x, (sep,hd)::tl

(* Rightwards iterators *)

let nseq_foldl f a (hd,tl) = List.fold_left f a (hd::tl)

let nsepseq_foldl f a (hd,tl) =
  List.fold_left (fun a (_,e) -> f a e) (f a hd) tl

let sepseq_foldl f a = function
    None -> a
| Some s -> nsepseq_foldl f a s

let nseq_iter f (hd,tl) = List.iter f (hd::tl)

let nsepseq_iter f (hd,tl) = f hd; List.iter (f <@ snd) tl

let sepseq_iter f = function
    None -> ()
| Some s -> nsepseq_iter f s

(* Reversing *)

let nseq_rev (hd,tl) =
  let rec aux acc = function
      [] -> acc
  | x::l -> aux (nseq_cons x acc) l
in aux (hd,[]) tl

let nsepseq_rev =
  let rec aux acc = function
    hd, (sep,snd)::tl -> aux ((sep,hd)::acc) (snd,tl)
  | hd,            [] -> hd, acc in
function
  hd, (sep,snd)::tl -> aux [sep,hd] (snd,tl)
|                 s -> s

let sepseq_rev = function
      None -> None
| Some seq -> Some (nsepseq_rev seq)

(* Leftwards iterators *)

let nseq_foldr f (hd,tl) = List.fold_right f (hd::tl)

let nsepseq_foldr f (hd,tl) a = f hd (List.fold_right (f <@ snd) tl a)

let sepseq_foldr f = function
    None -> fun a -> a
| Some s -> nsepseq_foldr f s

(* Conversions to lists *)

let nseq_to_list (x,y) = x::y

let nsepseq_to_list (x,y) = x :: List.map snd y

let sepseq_to_list = function
    None -> []
| Some s -> nsepseq_to_list s

(* Optional values *)

module Option =
  struct
    let apply f x =
      match x with
        Some y -> Some (f y)
      |   None -> None

    let rev_apply x y =
      match x with
        Some f -> f y
      |   None -> y

    let to_string = function
      Some x -> x
    |   None -> ""
  end

(* Modules based on [String], like sets and maps. *)

module String =
  struct
    include String

    module Ord =
      struct
        type nonrec t = t
        let compare = compare
      end

    module Map = Map.Make (Ord)
    module Set = Set.Make (Ord)
  end

(* Integers *)

module Int =
  struct
    type t = int

    module Ord =
      struct
        type nonrec t = t
        let compare = compare
      end

    module Map = Map.Make (Ord)
    module Set = Set.Make (Ord)
  end

(* Effectful symbol generator *)

let gen_sym =
  let counter = ref 0 in
  fun () -> incr counter; "v" ^ string_of_int !counter

(* General tracing function *)

let trace text = function
       None -> ()
| Some chan -> output_string chan text; flush chan

(* Printing a string in red to standard error *)

let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg