core-logic: format

src/core-logic/const.ml

@@ -26,5 +26,4 @@ let pp out (a : t) = a.c_ops.pp out a.c_view
 let ser ~ser_t (self : t) = self.c_ops.ser ser_t self.c_view
 let make c_view c_ops ~ty:c_ty : t = { c_view; c_ops; c_ty }
 
-type decoders =
+type decoders = (string * Ops.t * (term Ser_decode.t -> view Ser_decode.t)) list
-  (string * Ops.t * (term Ser_decode.t -> view Ser_decode.t)) list

src/core-logic/const.mli

@@ -1,6 +1,6 @@
 (** Constants.
 
-  Constants are logical symbols, defined by the user thanks to an open type *)
+    Constants are logical symbols, defined by the user thanks to an open type *)
 
 open Types_
 
@@ -24,10 +24,8 @@ val make : view -> Ops.t -> ty:term -> t
 val ser : ser_t:(term -> Ser_value.t) -> t -> string * Ser_value.t
 val ty : t -> term
 
-type decoders =
+type decoders = (string * Ops.t * (term Ser_decode.t -> view Ser_decode.t)) list
-  (string * Ops.t * (term Ser_decode.t -> view Ser_decode.t)) list
+(** Decoders for constants: given a term store, return a list of supported tags,
-(** Decoders for constants: given a term store, return a list
+    and for each tag, a decoder for constants that have this particular tag. *)
-    of supported tags, and for each tag, a decoder for constants
-    that have this particular tag. *)
 
 include EQ_HASH_PRINT with type t := t

src/core-logic/level.mli

@@ -42,16 +42,15 @@ val as_int : t -> int option
 
 (** {2 Judgements}
 
-    These are little proofs of some symbolic properties of levels, even
+    These are little proofs of some symbolic properties of levels, even those
-    those which contain variables. *)
+    which contain variables. *)
 
 val judge_leq : store -> t -> t -> bool
-(** [judge_leq st l1 l2] is [true] if [l1] is proven to be lower
+(** [judge_leq st l1 l2] is [true] if [l1] is proven to be lower or equal to
-    or equal to [l2] *)
+    [l2] *)
 
 val judge_eq : store -> t -> t -> bool
-(** [judge_eq st l1 l2] is [true] iff [judge_leq l1 l2]
+(** [judge_eq st l1 l2] is [true] iff [judge_leq l1 l2] and [judge_leq l2 l1] *)
-    and [judge_leq l2 l1] *)
 
 val judge_is_zero : store -> t -> bool
 (** [judge_is_zero st l] is [true] iff [l <= 0] holds *)

src/core-logic/reduce.ml

@@ -9,8 +9,8 @@ module T2_tbl = CCHashtbl.Make (struct
   let hash (a, b) = CCHash.combine3 91 (T.hash a) (T.hash b)
 end)
 
-(** Weak head normal form.
+(** Weak head normal form. Beta-reduces at the head until stuck. Memoised via
-    Beta-reduces at the head until stuck. Memoised via [cache]. *)
+    [cache]. *)
 let whnf ?(cache = T.Tbl.create 16) store e =
   let rec loop e =
     match T.Tbl.find_opt cache e with
@@ -34,17 +34,18 @@ let whnf ?(cache = T.Tbl.create 16) store e =
   in
   loop e
 
-(** Definitional equality: WHNF both sides, then compare structurally.
+(** Definitional equality: WHNF both sides, then compare structurally. Uses
-    Uses [Level.judge_eq] for universe levels.
+    [Level.judge_eq] for universe levels. Memoised via pair cache to handle
-    Memoised via pair cache to handle sharing in DAGs. *)
+    sharing in DAGs. *)
 let def_eq store e1 e2 =
   let whnf_cache = T.Tbl.create 16 in
   let eq_cache : bool T2_tbl.t = T2_tbl.create 16 in
   let whnf = whnf ~cache:whnf_cache store in
 
   let rec go e1 e2 =
-    if T.equal e1 e2 then true
+    if T.equal e1 e2 then
-    else
+      true
+    else (
       (* canonical order to halve cache size *)
       let key =
         if T.compare e1 e2 <= 0 then
@@ -60,11 +61,13 @@ let def_eq store e1 e2 =
         let r = check e1 e2 in
         T2_tbl.replace eq_cache key r;
         r
+    )
   and check e1 e2 =
     let e1 = whnf e1 in
     let e2 = whnf e2 in
-    if T.equal e1 e2 then true
+    if T.equal e1 e2 then
-    else
+      true
+    else (
       match T.view e1, T.view e2 with
       | E_type l1, E_type l2 -> Level.judge_eq (T.Store.lvl_store store) l1 l2
       | E_var v1, E_var v2 -> Var.equal v1 v2
@@ -74,6 +77,7 @@ let def_eq store e1 e2 =
       | E_lam (_, ty1, b1), E_lam (_, ty2, b2) -> go ty1 ty2 && go b1 b2
       | E_pi (_, ty1, b1), E_pi (_, ty2, b2) -> go ty1 ty2 && go b1 b2
       | _ -> false
+    )
   in
   go e1 e2
 

src/core-logic/reduce.mli

@@ -1,13 +1,13 @@
 val whnf : ?cache:Term.t Term.Tbl.t -> Term.store -> Term.t -> Term.t
-(** [whnf store e] reduces [e] to weak head normal form by beta-reducing at
+(** [whnf store e] reduces [e] to weak head normal form by beta-reducing at the
-    the head until stuck. The optional [cache] is a memoisation table; pass
+    head until stuck. The optional [cache] is a memoisation table; pass the same
-    the same table across calls to amortise work over a DAG. *)
+    table across calls to amortise work over a DAG. *)
 
 val def_eq : Term.store -> Term.t -> Term.t -> bool
-(** [def_eq store a b] is true iff [a] and [b] are definitionally equal:
+(** [def_eq store a b] is true iff [a] and [b] are definitionally equal: both
-    both sides are reduced to WHNF and then compared structurally, using
+    sides are reduced to WHNF and then compared structurally, using
-    [Level.judge_eq] for universe levels. Results are memoised internally
+    [Level.judge_eq] for universe levels. Results are memoised internally on the
-    on the shared DAG structure.
+    shared DAG structure.
 
-    Note: this is installed as the kernel's equality check ([Term.Internal_.def_eq_ref])
+    Note: this is installed as the kernel's equality check
-    when this module is loaded. *)
+    ([Term.Internal_.def_eq_ref]) when this module is loaded. *)

src/core-logic/str_const.mli

@@ -1,7 +1,6 @@
 (** Basic string constants.
 
-   These constants are a string name, coupled with a type.
+    These constants are a string name, coupled with a type. *)
-*)
 
 open Types_
 

src/core-logic/t_builtins.mli

@@ -27,12 +27,12 @@ val is_eq : t -> bool
 val is_bool : t -> bool
 
 val abs : store -> t -> bool * t
-(** [abs t] returns an "absolute value" for the term, along with the
+(** [abs t] returns an "absolute value" for the term, along with the sign of
-    sign of [t].
+    [t].
 
-    The idea is that we want to turn [not a] into [(false, a)],
+    The idea is that we want to turn [not a] into [(false, a)], or [(a != b)]
-    or [(a != b)] into [(false, a=b)]. For terms without a negation this
+    into [(false, a=b)]. For terms without a negation this should return
-    should return [(true, t)]. *)
+    [(true, t)]. *)
 
 val as_bool_val : t -> bool option
 

src/core-logic/term.ml

@@ -404,9 +404,9 @@ module Make_ = struct
           map_shallow_ e ~make ~f:(fun inbind u ->
               loop u
                 (if inbind then
-                  k + 1
+                   k + 1
-                else
+                 else
-                  k))
+                   k))
       )
     in
     assert (n >= 0);
@@ -441,9 +441,9 @@ module Make_ = struct
                map_shallow_ e ~make ~f:(fun inb u ->
                    aux u
                      (if inb then
-                       k + 1
+                        k + 1
-                     else
+                      else
-                       k))
+                        k))
              in
              T_int_tbl.add cache_ (e, k) r;
              r)
@@ -610,9 +610,9 @@ module Make_ = struct
         map_shallow_ e ~make ~f:(fun inb u ->
             loop
               (if inb then
-                k + 1
+                 k + 1
-              else
+               else
-                k)
+                 k)
               u)
       | Some u ->
         let u = db_shift_ ~make u k in

src/core-logic/term.mli

@@ -1,11 +1,11 @@
 (** Core logic terms.
 
-  The core terms are expressions in the calculus of constructions,
+    The core terms are expressions in the calculus of constructions, with no
-  with no universe polymorphism nor cumulativity. It should be fast, with hashconsing;
+    universe polymorphism nor cumulativity. It should be fast, with hashconsing;
-  and simple enough (no inductives, no universe trickery).
+    and simple enough (no inductives, no universe trickery).
 
-  It is intended to be the foundation for user-level terms and types and formulas.
+    It is intended to be the foundation for user-level terms and types and
-*)
+    formulas. *)
 
 open Types_
 
@@ -19,9 +19,9 @@ type t = term
 type store
 (** The store for terms.
 
-    The store is responsible for allocating unique IDs to terms, and
+    The store is responsible for allocating unique IDs to terms, and enforcing
-    enforcing their hashconsing (so that syntactic equality is just a pointer
+    their hashconsing (so that syntactic equality is just a pointer comparison).
-    comparison). *)
+*)
 
 (** View.
 
@@ -61,31 +61,30 @@ val as_type : t -> Level.t option
 val as_type_exn : t -> Level.t
 
 val iter_dag : ?seen:unit Tbl.t -> iter_ty:bool -> f:(t -> unit) -> t -> unit
-(** [iter_dag t ~f] calls [f] once on each subterm of [t], [t] included.
+(** [iter_dag t ~f] calls [f] once on each subterm of [t], [t] included. It must
-        It must {b not} traverse [t] as a tree, but rather as a
+    {b not} traverse [t] as a tree, but rather as a perfectly shared DAG.
-        perfectly shared DAG.
 
-        For example, in:
+    For example, in:
-        {[
+    {[
-          let x = 2 in
+      let x = 2 in
-          let y = f x x in
+      let y = f x x in
-          let z = g y x in
+      let z = g y x in
-          z = z
+      z = z
-        ]}
+    ]}
 
-        the DAG has the following nodes:
+    the DAG has the following nodes:
 
-        {[ n1: 2
+    {[
-           n2: f n1 n1
+      n1: 2
-           n3: g n2 n1
+      n2: f n1 n1
-           n4: = n3 n3
+      n3: g n2 n1
-         ]}
+      n4: = n3 n3
-    *)
+    ]} *)
 
 val iter_shallow : f:(bool -> t -> unit) -> t -> unit
-(** [iter_shallow f e] iterates on immediate subterms of [e],
+(** [iter_shallow f e] iterates on immediate subterms of [e], calling
-  calling [f trdb e'] for each subterm [e'], with [trdb = true] iff
+    [f trdb e'] for each subterm [e'], with [trdb = true] iff [e'] is directly
-  [e'] is directly under a binder. *)
+    under a binder. *)
 
 val map_shallow : store -> f:(bool -> t -> t) -> t -> t
 val exists_shallow : f:(bool -> t -> bool) -> t -> bool
@@ -101,12 +100,11 @@ val is_a_type : t -> bool
 (** [is_a_type t] is true if [is_ty (ty t)] *)
 
 val is_closed : t -> bool
-(** Is the term closed (all bound variables are paired with a binder)?
+(** Is the term closed (all bound variables are paired with a binder)? time:
- time: O(1) *)
+    O(1) *)
 
 val has_fvars : t -> bool
-(** Does the term contain free variables?
+(** Does the term contain free variables? time: O(1) *)
-  time: O(1)  *)
 
 val ty : t -> t
 (** Return the type of this term. *)
@@ -142,33 +140,33 @@ val open_lambda_exn : store -> t -> var * t
 (** De bruijn indices *)
 module DB : sig
   val lam_db : ?var_name:string -> store -> var_ty:t -> t -> t
-  (** [lam_db store ~var_ty bod] is [\ _:var_ty. bod]. Not DB shifting is done. *)
+  (** [lam_db store ~var_ty bod] is [\ _:var_ty. bod]. Not DB shifting is done.
+  *)
 
   val pi_db : ?var_name:string -> store -> var_ty:t -> t -> t
-  (** [pi_db store ~var_ty bod] is [pi _:var_ty. bod]. Not DB shifting is done. *)
+  (** [pi_db store ~var_ty bod] is [pi _:var_ty. bod]. Not DB shifting is done.
+  *)
 
   val subst_db0 : store -> t -> by:t -> t
-  (** [subst_db0 store t ~by] replaces bound variable 0 in [t] with
+  (** [subst_db0 store t ~by] replaces bound variable 0 in [t] with the term
-      the term [by]. This is useful, for example, to implement beta-reduction.
+      [by]. This is useful, for example, to implement beta-reduction.
 
       For example, with [t] being [_[0] = (\x. _[2] _[1] x[0])],
-      [subst_db0 store t ~by:"hello"] is ["hello" = (\x. _[2] "hello" x[0])].
+      [subst_db0 store t ~by:"hello"] is ["hello" = (\x. _[2] "hello" x[0])]. *)
-  *)
 
   val shift : store -> t -> by:int -> t
-  (** [shift store t ~by] shifts all bound variables in [t] that are not
+  (** [shift store t ~by] shifts all bound variables in [t] that are not closed
-    closed on, by amount [by] (which must be >= 0).
+      on, by amount [by] (which must be >= 0).
 
-    For example, with term [t] being [\x. _[1] _[2] x[0]],
+      For example, with term [t] being [\x. _[1] _[2] x[0]],
-    [shift store t ~by:5] is [\x. _[6] _[7] x[0]]. *)
+      [shift store t ~by:5] is [\x. _[6] _[7] x[0]]. *)
 
   val abs_on : store -> var -> t -> t
-  (** [abs_on store v t] is the term [t[v := _[0]]]. It replaces [v] with
+  (** [abs_on store v t] is the term [t[v := _[0]]]. It replaces [v] with the
-      the bound variable with the same type as [v], and the DB index 0,
+      bound variable with the same type as [v], and the DB index 0, and takes
-      and takes care of shifting if [v] occurs under binders.
+      care of shifting if [v] occurs under binders.
 
-      For example, [abs_on store x (\y. x+y)] is [\y. _[1] y].
+      For example, [abs_on store x (\y. x+y)] is [\y. _[1] y]. *)
-  *)
 end
 
 (**/**)
@@ -188,8 +186,8 @@ module Internal_ : sig
     t
 
   val def_eq_ref : (store -> t -> t -> bool) ref
-  (** Definitional equality hook. Defaults to syntactic equality.
+  (** Definitional equality hook. Defaults to syntactic equality. Overwritten by
-      Overwritten by [Reduce] at init time. *)
+      [Reduce] at init time. *)
 end
 
 (**/**)