From 263f5aa8a5d1c731843da4bb7146efa69cfcd4d9 Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Sat, 15 Aug 2020 02:19:29 -0700 Subject: [PATCH] [sledge] Refactor: Reorder Fol definitions Summary: No change, just to make reading diffs easier. Reviewed By: jvillard Differential Revision: D22571147 fbshipit-source-id: 91a8be52a --- sledge/src/fol.ml | 172 +++++++++++++++++++++++----------------------- 1 file changed, 86 insertions(+), 86 deletions(-) diff --git a/sledge/src/fol.ml b/sledge/src/fol.ml index 9cb8f3fd1..3087de7cb 100644 --- a/sledge/src/fol.ml +++ b/sledge/src/fol.ml @@ -760,92 +760,6 @@ let apNt : (trm list -> trm) -> exp array -> exp = (fun xs -> `Trm (f xs)) (Array.fold ~f:(fun xs x -> embed_into_cnd x :: xs) ~init:[] xs) -(* - * Formulas: exposed interface - *) - -module Formula = struct - type t = fml [@@deriving compare, equal, sexp] - - let inject f = `Fml f - let project = function `Fml f -> Some f | #cnd as c -> project_out_fml c - let ppx = ppx_f - let pp = pp_f - - (* constants *) - - let tt = Tt - let ff = Ff - - (* comparisons *) - - let eq = ap2f _Eq - let dq = ap2f _Dq - let lt = ap2f _Lt - let le = ap2f _Le - - (* connectives *) - - let and_ = _And - let andN = function [] -> tt | b :: bs -> List.fold ~init:b ~f:and_ bs - let or_ = _Or - let orN = function [] -> ff | b :: bs -> List.fold ~init:b ~f:or_ bs - let iff = _Iff - let xor = _Xor - let cond ~cnd ~pos ~neg = _Cond cnd pos neg - - let rec not_ = function - | Tt -> Ff - | Ff -> Tt - | Eq (x, y) -> Dq (x, y) - | Dq (x, y) -> Eq (x, y) - | Lt (x, y) -> Le (y, x) - | Le (x, y) -> Lt (y, x) - | And (x, y) -> Or (not_ x, not_ y) - | Or (x, y) -> And (not_ x, not_ y) - | Iff (x, y) -> Xor (x, y) - | Xor (x, y) -> Iff (x, y) - | Cond {cnd; pos; neg} -> Cond {cnd; pos= not_ pos; neg= not_ neg} - | UPosLit (p, x) -> UNegLit (p, x) - | UNegLit (p, x) -> UPosLit (p, x) - - (** Query *) - - let fv e = fold_vars_f e ~f:Var.Set.add ~init:Var.Set.empty - let is_true = function Tt -> true | _ -> false - let is_false = function Ff -> true | _ -> false - - (** Traverse *) - - let fold_vars = fold_vars_f - - (** Transform *) - - let map_vars = map_vars_f - - let fold_map_vars ~init e ~f = - let s = ref init in - let f x = - let s', x' = f !s x in - s := s' ; - x' - in - let e' = map_vars ~f e in - (!s, e') - - let rename s e = map_vars ~f:(Var.Subst.apply s) e - - let disjuncts p = - let rec disjuncts_ p ds = - match p with - | Or (a, b) -> disjuncts_ a (disjuncts_ b ds) - | Cond {cnd; pos; neg} -> - disjuncts_ (and_ cnd pos) (disjuncts_ (and_ (not_ cnd) neg) ds) - | d -> d :: ds - in - disjuncts_ p [] -end - (* * Terms: exposed interface *) @@ -973,6 +887,92 @@ module Term = struct let fv e = fold_vars e ~f:Var.Set.add ~init:Var.Set.empty end +(* + * Formulas: exposed interface + *) + +module Formula = struct + type t = fml [@@deriving compare, equal, sexp] + + let inject f = `Fml f + let project = function `Fml f -> Some f | #cnd as c -> project_out_fml c + let ppx = ppx_f + let pp = pp_f + + (* constants *) + + let tt = Tt + let ff = Ff + + (* comparisons *) + + let eq = ap2f _Eq + let dq = ap2f _Dq + let lt = ap2f _Lt + let le = ap2f _Le + + (* connectives *) + + let and_ = _And + let andN = function [] -> tt | b :: bs -> List.fold ~init:b ~f:and_ bs + let or_ = _Or + let orN = function [] -> ff | b :: bs -> List.fold ~init:b ~f:or_ bs + let iff = _Iff + let xor = _Xor + let cond ~cnd ~pos ~neg = _Cond cnd pos neg + + let rec not_ = function + | Tt -> Ff + | Ff -> Tt + | Eq (x, y) -> Dq (x, y) + | Dq (x, y) -> Eq (x, y) + | Lt (x, y) -> Le (y, x) + | Le (x, y) -> Lt (y, x) + | And (x, y) -> Or (not_ x, not_ y) + | Or (x, y) -> And (not_ x, not_ y) + | Iff (x, y) -> Xor (x, y) + | Xor (x, y) -> Iff (x, y) + | Cond {cnd; pos; neg} -> Cond {cnd; pos= not_ pos; neg= not_ neg} + | UPosLit (p, x) -> UNegLit (p, x) + | UNegLit (p, x) -> UPosLit (p, x) + + (** Query *) + + let fv e = fold_vars_f e ~f:Var.Set.add ~init:Var.Set.empty + let is_true = function Tt -> true | _ -> false + let is_false = function Ff -> true | _ -> false + + (** Traverse *) + + let fold_vars = fold_vars_f + + (** Transform *) + + let map_vars = map_vars_f + + let fold_map_vars ~init e ~f = + let s = ref init in + let f x = + let s', x' = f !s x in + s := s' ; + x' + in + let e' = map_vars ~f e in + (!s, e') + + let rename s e = map_vars ~f:(Var.Subst.apply s) e + + let disjuncts p = + let rec disjuncts_ p ds = + match p with + | Or (a, b) -> disjuncts_ a (disjuncts_ b ds) + | Cond {cnd; pos; neg} -> + disjuncts_ (and_ cnd pos) (disjuncts_ (and_ (not_ cnd) neg) ds) + | d -> d :: ds + in + disjuncts_ p [] +end + (* * Convert to Ses *)