open Batteries (* The type parameter 'v (for "variable") allows to manipulate two different kinds of terms: those that come directly from the parser, that use strings for variables, and those where variables have been bound to their binding sites, where variables have the type 'var' below. The (string ty) variant is only ever seen inside Closures_parser. *) type 'v _ty = | Atom of atom | Product of 'v _ty * 'v _ty | Closure of ('v, 'v _ann_ty) _context * 'v * 'v _ann_ty * 'v _ty and ('v, 'a) _context = ('v * 'a) list and atom = Const of string and annot = bool and 'v _ann_ty = 'v _ty * annot type 'v _exp = | Var of 'v (* x *) | Pair of 'v _exp * 'v _exp (* (e₁,e₂) *) | Proj of bool * 'v _exp (* π₁ e or π₂ e *) | Lam of 'v * 'v _ty * 'v _exp (* λ(x:σ).e *) | App of 'v _exp * 'v _exp (* t u *) | Let of 'v * 'v _exp * 'v _exp (* let x = e₁ in e₂ *) module Var : sig type t = private (string * int) val compare : t -> t -> int val to_string : t -> string type naming_env val empty_env : naming_env val fresh : string -> naming_env -> t * naming_env (** [fresh x venv] helps enforcing the Barendregt convention (all binders unique) by adding an integer id to the variable [x] so that it is unique in the passed environment [venv]. *) val find : string -> naming_env -> t option end = struct type t = string * int let compare = let module Comp = Tuple2.Comp(String.NumString)(Int) in Comp.compare let to_string (str, n) = if n = 0 then str else str ^ "/" ^ string_of_int n module StrMap = Map.Make(String) type naming_env = int StrMap.t let empty_env = StrMap.empty let fresh v naming_env = let n = try StrMap.find v naming_env with Not_found -> 0 in let naming_env = StrMap.add v (n + 1) naming_env in (v, n), naming_env let find str naming_env = try Some (str, StrMap.find str naming_env - 1) with Not_found -> None end type var = Var.t type ty = var _ty type ann_ty = var _ann_ty type exp = var _exp type 'a context = (var, 'a) _context (* Values are only the result of evaluating well-bound term, so we assume they use 'var' from the start *) type value = | VError | VAtom of atom * value_atom (* vα *) | VPair of value * value (* (v₁,v₂) *) | VClosure of var list * value context * var * exp (* ((x_i), (x_j ↦ v_j), λx.t) *) and value_atom = string