pghs975uc
/
infer_clone
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

[sledge] Rename Fol core types to follow convention

Browse Source 
Summary: Use Trm.t and Fml.t instead of Trm.trm and Fml.fml.

Reviewed By: ngorogiannis

Differential Revision: D24532345

fbshipit-source-id: a3b9b7dc9
master
Josh Berdine 4 years ago committed by Facebook GitHub Bot
parent 1643bf1c50
commit dd19e11949
7 changed files with 159 additions and 169 deletions
Show Stats Download Patch File Download Diff File

16
sledge/src/fml.ml
Unescape View File

@ -8,9 +8,9 @@
(** Formulas *) (** Formulas *)
module Prop = Propositional.Make (Trm) module Prop = Propositional.Make (Trm)
module Fmls = Prop.Fmls module Set = Prop.Fmls
type fmls = Fmls.t type set = Set.t
include Prop.Fml include Prop.Fml
@ -19,13 +19,13 @@ let ff = _Not tt
let bool b = if b then tt else ff let bool b = if b then tt else ff
let _Eq0 x = let _Eq0 x =
match (x : Trm.trm) with match (x : Trm.t) with
| Z z -> bool (Z.equal Z.zero z) | Z z -> bool (Z.equal Z.zero z)
| Q q -> bool (Q.equal Q.zero q) | Q q -> bool (Q.equal Q.zero q)
| x -> _Eq0 x | x -> _Eq0 x
let _Pos x = let _Pos x =
match (x : Trm.trm) with match (x : Trm.t) with
| Z z -> bool (Z.gt z Z.zero) | Z z -> bool (Z.gt z Z.zero)
| Q q -> bool (Q.gt q Q.zero) | Q q -> bool (Q.gt q Q.zero)
| x -> _Pos x | x -> _Pos x
@ -35,7 +35,7 @@ let _Eq x y =
else if y == Trm.zero then _Eq0 x else if y == Trm.zero then _Eq0 x
else else
let sort_eq x y = let sort_eq x y =
match Sign.of_int (Trm.compare_trm x y) with match Sign.of_int (Trm.compare x y) with
| Neg -> _Eq x y | Neg -> _Eq x y
| Zero -> tt | Zero -> tt
| Pos -> _Eq y x | Pos -> _Eq y x
@ -51,8 +51,7 @@ let _Eq x y =
let l = min m n in let l = min m n in
let length_common_prefix = let length_common_prefix =
let rec find_lcp i = let rec find_lcp i =
if i < l && Trm.equal_trm a.(i) b.(i) then find_lcp (i + 1) if i < l && Trm.equal a.(i) b.(i) then find_lcp (i + 1) else i
else i
in in
find_lcp 0 find_lcp 0
in in
@ -60,8 +59,7 @@ let _Eq x y =
else else
let length_common_suffix = let length_common_suffix =
let rec find_lcs i = let rec find_lcs i =
if Trm.equal_trm a.(m - 1 - i) b.(n - 1 - i) then if Trm.equal a.(m - 1 - i) b.(n - 1 - i) then find_lcs (i + 1)
find_lcs (i + 1)
else i else i
in in
find_lcs 0 find_lcs 0

20
sledge/src/fml.mli
Unescape View File

@ -8,15 +8,13 @@
(** Formulas *) (** Formulas *)
open Propositional_intf open Propositional_intf
include FORMULA with type trm := Trm.trm include FORMULA with type trm := Trm.t
module Fmls : FORMULA_SET with type elt := fml with type t = fmls module Set : FORMULA_SET with type elt := t with type t = set
type trm := Trm.trm val tt : t
val ff : t
val tt : fml val bool : bool -> t
val ff : fml val _Eq0 : Trm.t -> t
val bool : bool -> fml val _Pos : Trm.t -> t
val _Eq0 : trm -> fml val _Eq : Trm.t -> Trm.t -> t
val _Pos : trm -> fml val vars : t -> Var.t iter
val _Eq : trm -> trm -> fml
val vars : fml -> Trm.Var.t iter

14
sledge/src/fol.ml
Unescape View File

@ -9,6 +9,8 @@ open Trm
open Fml open Fml
type var = Var.t type var = Var.t
type trm = Trm.t [@@deriving compare, equal, sexp]
type fml = Fml.t [@@deriving compare, equal, sexp]
(* (*
* Conditional terms * Conditional terms
@ -47,11 +49,11 @@ let ppx_f strength fs fml =
pf "(%a@ @<2>%s %a)" Q.pp (Q.neg c) op (Arith.ppx strength) a pf "(%a@ @<2>%s %a)" Q.pp (Q.neg c) op (Arith.ppx strength) a
in in
let pp_join sep pos neg = let pp_join sep pos neg =
pf "(%a%t%a)" (Fmls.pp ~sep pp) pos pf "(%a%t%a)" (Fml.Set.pp ~sep pp) pos
(fun ppf -> (fun ppf ->
if (not (Fmls.is_empty pos)) && not (Fmls.is_empty neg) then if (not (Fml.Set.is_empty pos)) && not (Fml.Set.is_empty neg) then
Format.fprintf ppf sep ) Format.fprintf ppf sep )
(Fmls.pp ~sep (fun fs fml -> pp fs (_Not fml))) (Fml.Set.pp ~sep (fun fs fml -> pp fs (_Not fml)))
neg neg
in in
match (fml : fml) with match (fml : fml) with
@ -114,8 +116,8 @@ let mapN f e cons xs =
if xs' == xs then e else cons xs' if xs' == xs then e else cons xs'
let map_pos_neg f e cons ~pos ~neg = let map_pos_neg f e cons ~pos ~neg =
let pos' = Fmls.map ~f pos in let pos' = Fml.Set.map ~f pos in
let neg' = Fmls.map ~f neg in let neg' = Fml.Set.map ~f neg in
if pos' == pos && neg' == neg then e else cons ~pos:pos' ~neg:neg' if pos' == pos && neg' == neg then e else cons ~pos:pos' ~neg:neg'
(** map_trms *) (** map_trms *)
@ -531,7 +533,7 @@ module Formula = struct
let fold_pos_neg ~pos ~neg s ~f = let fold_pos_neg ~pos ~neg s ~f =
let f_not p s = f (_Not p) s in let f_not p s = f (_Not p) s in
Fmls.fold ~f:f_not neg (Fmls.fold ~f pos s) Fml.Set.fold ~f:f_not neg (Fml.Set.fold ~f pos s)
let fold_dnf : let fold_dnf :
meet1:('literal -> 'conjunction -> 'conjunction) meet1:('literal -> 'conjunction -> 'conjunction)

40
sledge/src/propositional.ml
Unescape View File

@ -10,12 +10,10 @@
include Propositional_intf include Propositional_intf
module Make (Trm : TERM) = struct module Make (Trm : TERM) = struct
open Trm
(** Sets of formulas *) (** Sets of formulas *)
module rec Fmls : (FORMULA_SET with type elt := Fml.fml) = struct module rec Fmls : (FORMULA_SET with type elt := Fml.t) = struct
module T = struct module T = struct
type t = Fml.fml [@@deriving compare, equal, sexp] type t = Fml.t [@@deriving compare, equal, sexp]
end end
include Set.Make (T) include Set.Make (T)
@ -25,23 +23,23 @@ module Make (Trm : TERM) = struct
(** Formulas, built from literals with predicate symbols from various (** Formulas, built from literals with predicate symbols from various
theories, and propositional constants and connectives. Denote sets of theories, and propositional constants and connectives. Denote sets of
structures. *) structures. *)
and Fml : (FORMULA with type trm := Trm.trm with type fmls := Fmls.t) = and Fml : (FORMULA with type trm := Trm.t with type set := Fmls.t) =
struct struct
type fml = type t =
| Tt | Tt
| Eq of trm * trm | Eq of Trm.t * Trm.t
| Eq0 of trm | Eq0 of Trm.t
| Pos of trm | Pos of Trm.t
| Not of fml | Not of t
| And of {pos: Fmls.t; neg: Fmls.t} | And of {pos: Fmls.t; neg: Fmls.t}
| Or of {pos: Fmls.t; neg: Fmls.t} | Or of {pos: Fmls.t; neg: Fmls.t}
| Iff of fml * fml | Iff of t * t
| Cond of {cnd: fml; pos: fml; neg: fml} | Cond of {cnd: t; pos: t; neg: t}
| Lit of Ses.Predsym.t * trm array | Lit of Ses.Predsym.t * Trm.t array
[@@deriving compare, equal, sexp] [@@deriving compare, equal, sexp]
let invariant f = let invariant f =
let@ () = Invariant.invariant [%here] f [%sexp_of: fml] in let@ () = Invariant.invariant [%here] f [%sexp_of: t] in
match f with match f with
(* formulas are in negation-normal form *) (* formulas are in negation-normal form *)
| Not (Not _ | And _ | Or _ | Cond _) -> assert false | Not (Not _ | And _ | Or _ | Cond _) -> assert false
@ -55,7 +53,7 @@ module Make (Trm : TERM) = struct
| Cond {cnd= Not _ | Or _} -> assert false | Cond {cnd= Not _ | Or _} -> assert false
| _ -> () | _ -> ()
let sort_fml x y = if compare_fml x y <= 0 then (x, y) else (y, x) let sort x y = if compare x y <= 0 then (x, y) else (y, x)
(** Some normalization is necessary for [embed_into_fml] (defined below) (** Some normalization is necessary for [embed_into_fml] (defined below)
to be left inverse to [embed_into_cnd]. Essentially to be left inverse to [embed_into_cnd]. Essentially
@ -93,7 +91,7 @@ module Make (Trm : TERM) = struct
let _Or ~pos ~neg = _Join (fun ~pos ~neg -> Or {pos; neg}) tt ~pos ~neg let _Or ~pos ~neg = _Join (fun ~pos ~neg -> Or {pos; neg}) tt ~pos ~neg
let join _Cons zero split_pos_neg p q = let join _Cons zero split_pos_neg p q =
( if equal_fml p zero || equal_fml q zero then zero ( if equal p zero || equal q zero then zero
else else
let pp, pn = split_pos_neg p in let pp, pn = split_pos_neg p in
if Fmls.is_empty pp && Fmls.is_empty pn then q if Fmls.is_empty pp && Fmls.is_empty pn then q
@ -126,22 +124,22 @@ module Make (Trm : TERM) = struct
let rec eval_iff p q = let rec eval_iff p q =
match (p, q) with match (p, q) with
| p, Not p' | Not p', p -> if equal_fml p p' then Some false else None | p, Not p' | Not p', p -> if equal p p' then Some false else None
| And {pos= ap; neg= an}, Or {pos= op; neg= on} | And {pos= ap; neg= an}, Or {pos= op; neg= on}
|Or {pos= op; neg= on}, And {pos= ap; neg= an} |Or {pos= op; neg= on}, And {pos= ap; neg= an}
when Fmls.equal ap on && Fmls.equal an op -> when Fmls.equal ap on && Fmls.equal an op ->
Some false Some false
| Cond {cnd= c; pos= p; neg= n}, Cond {cnd= c'; pos= p'; neg= n'} -> | Cond {cnd= c; pos= p; neg= n}, Cond {cnd= c'; pos= p'; neg= n'} ->
if equal_fml c c' then if equal c c' then
match eval_iff p p' with match eval_iff p p' with
| Some false -> ( | Some false -> (
match eval_iff n n' with match eval_iff n n' with
| Some false -> Some false | Some false -> Some false
| _ -> None ) | _ -> None )
| Some true -> if equal_fml n n' then Some true else None | Some true -> if equal n n' then Some true else None
| None -> None | None -> None
else None else None
| _ -> if equal_fml p q then Some true else None | _ -> if equal p q then Some true else None
let _Iff p q = let _Iff p q =
( match (p, q) with ( match (p, q) with
@ -151,7 +149,7 @@ module Make (Trm : TERM) = struct
match eval_iff p q with match eval_iff p q with
| Some b -> bool b | Some b -> bool b
| None -> | None ->
let p, q = sort_fml p q in let p, q = sort p q in
Iff (p, q) ) ) Iff (p, q) ) )
|> check invariant |> check invariant

47
sledge/src/propositional_intf.ml
Unescape View File

@ -10,7 +10,7 @@
open Ses open Ses
module type TERM = sig module type TERM = sig
type trm [@@deriving compare, equal, sexp] type t [@@deriving compare, equal, sexp]
end end
(** Formulas, built from literals with predicate symbols from various (** Formulas, built from literals with predicate symbols from various
@ -18,9 +18,9 @@ end
structures. *) structures. *)
module type FORMULA = sig module type FORMULA = sig
type trm type trm
type fmls type set
type fml = private type t = private
(* propositional constants *) (* propositional constants *)
| Tt | Tt
(* equality *) (* equality *)
@ -29,28 +29,28 @@ module type FORMULA = sig
| Eq0 of trm (** [Eq0(x)] iff x = 0 *) | Eq0 of trm (** [Eq0(x)] iff x = 0 *)
| Pos of trm (** [Pos(x)] iff x > 0 *) | Pos of trm (** [Pos(x)] iff x > 0 *)
(* propositional connectives *) (* propositional connectives *)
| Not of fml | Not of t
| And of {pos: fmls; neg: fmls} | And of {pos: set; neg: set}
| Or of {pos: fmls; neg: fmls} | Or of {pos: set; neg: set}
| Iff of fml * fml | Iff of t * t
| Cond of {cnd: fml; pos: fml; neg: fml} | Cond of {cnd: t; pos: t; neg: t}
(* uninterpreted literals *) (* uninterpreted literals *)
| Lit of Predsym.t * trm array | Lit of Predsym.t * trm array
[@@deriving compare, equal, sexp] [@@deriving compare, equal, sexp]
val mk_Tt : unit -> fml val mk_Tt : unit -> t
val _Eq : trm -> trm -> fml val _Eq : trm -> trm -> t
val _Eq0 : trm -> fml val _Eq0 : trm -> t
val _Pos : trm -> fml val _Pos : trm -> t
val _Not : fml -> fml val _Not : t -> t
val _And : pos:fmls -> neg:fmls -> fml val _And : pos:set -> neg:set -> t
val _Or : pos:fmls -> neg:fmls -> fml val _Or : pos:set -> neg:set -> t
val _Iff : fml -> fml -> fml val _Iff : t -> t -> t
val _Cond : fml -> fml -> fml -> fml val _Cond : t -> t -> t -> t
val _Lit : Predsym.t -> trm array -> fml val _Lit : Predsym.t -> trm array -> t
val and_ : fml -> fml -> fml val and_ : t -> t -> t
val or_ : fml -> fml -> fml val or_ : t -> t -> t
val trms : fml -> trm iter val trms : t -> trm iter
end end
(** Sets of formulas *) (** Sets of formulas *)
@ -61,7 +61,6 @@ module type FORMULA_SET = sig
end end
module type MAKE = functor (Trm : TERM) -> sig module type MAKE = functor (Trm : TERM) -> sig
module rec Fml : module rec Fml : (FORMULA with type trm := Trm.t with type set := Fmls.t)
(FORMULA with type trm := Trm.trm with type fmls := Fmls.t) and Fmls : (FORMULA_SET with type elt := Fml.t)
and Fmls : (FORMULA_SET with type elt := Fml.fml)
end end

124
sledge/src/trm.ml
Unescape View File

@ -15,12 +15,12 @@ let pp_boxed fs fmt =
(** Variable terms, represented as a subtype of general terms *) (** Variable terms, represented as a subtype of general terms *)
module rec Var : sig module rec Var : sig
include Ses.Var_intf.VAR with type t = private Trm.trm include Ses.Var_intf.VAR with type t = private Trm.t
val of_ : Trm.trm -> t val of_ : Trm.t -> t
end = struct end = struct
module T = struct module T = struct
type t = Trm.trm [@@deriving compare, equal, sexp] type t = Trm.t [@@deriving compare, equal, sexp]
let invariant x = let invariant x =
let@ () = Invariant.invariant [%here] x [%sexp_of: t] in let@ () = Invariant.invariant [%here] x [%sexp_of: t] in
@ -39,20 +39,23 @@ end = struct
end end
and Arith0 : and Arith0 :
(Arithmetic.REPRESENTATION (Arithmetic.REPRESENTATION with type var := Var.t with type trm := Trm.t) =
with type var := Var.t Arithmetic.Representation (struct
with type trm := Trm.trm) = type trm = Trm.t [@@deriving compare, equal, sexp]
Arithmetic.Representation (Trm) type var = Var.t
let ppx = Trm.ppx
end)
and Arith : and Arith :
(Arithmetic.S (Arithmetic.S
with type var := Var.t with type var := Var.t
with type trm := Trm.trm with type trm := Trm.t
with type t = Arith0.t) = struct with type t = Arith0.t) = struct
include Arith0 include Arith0
include Make (struct include Make (struct
let get_arith (e : Trm.trm) = let get_arith (e : Trm.t) =
match e with match e with
| Z z -> Some (Arith.const (Q.of_z z)) | Z z -> Some (Arith.const (Q.of_z z))
| Q q -> Some (Arith.const q) | Q q -> Some (Arith.const q)
@ -64,9 +67,7 @@ end
(** Terms, built from variables and applications of function symbols from (** Terms, built from variables and applications of function symbols from
various theories. Denote functions from structures to values. *) various theories. Denote functions from structures to values. *)
and Trm : sig and Trm : sig
type var = Var.t type t = private
type trm = private
(* variables *) (* variables *)
| Var of {id: int; name: string} | Var of {id: int; name: string}
(* arithmetic *) (* arithmetic *)
@ -74,71 +75,69 @@ and Trm : sig
| Q of Q.t | Q of Q.t
| Arith of Arith.t | Arith of Arith.t
(* sequences (of flexible size) *) (* sequences (of flexible size) *)
| Splat of trm | Splat of t
| Sized of {seq: trm; siz: trm} | Sized of {seq: t; siz: t}
| Extract of {seq: trm; off: trm; len: trm} | Extract of {seq: t; off: t; len: t}
| Concat of trm array | Concat of t array
(* records (with fixed indices) *) (* records (with fixed indices) *)
| Select of {idx: int; rcd: trm} | Select of {idx: int; rcd: t}
| Update of {idx: int; rcd: trm; elt: trm} | Update of {idx: int; rcd: t; elt: t}
| Record of trm array | Record of t array
| Ancestor of int | Ancestor of int
(* uninterpreted *) (* uninterpreted *)
| Apply of Funsym.t * trm array | Apply of Funsym.t * t array
[@@deriving compare, equal, sexp] [@@deriving compare, equal, sexp]
val ppx : Var.t Var.strength -> trm pp val ppx : Var.t Var.strength -> t pp
val _Var : int -> string -> trm val _Var : int -> string -> t
val _Z : Z.t -> trm val _Z : Z.t -> t
val _Q : Q.t -> trm val _Q : Q.t -> t
val _Arith : Arith.t -> trm val _Arith : Arith.t -> t
val _Splat : trm -> trm val _Splat : t -> t
val _Sized : trm -> trm -> trm val _Sized : t -> t -> t
val _Extract : trm -> trm -> trm -> trm val _Extract : t -> t -> t -> t
val _Concat : trm array -> trm val _Concat : t array -> t
val _Select : int -> trm -> trm val _Select : int -> t -> t
val _Update : int -> trm -> trm -> trm val _Update : int -> t -> t -> t
val _Record : trm array -> trm val _Record : t array -> t
val _Ancestor : int -> trm val _Ancestor : int -> t
val _Apply : Funsym.t -> trm array -> trm val _Apply : Funsym.t -> t array -> t
val add : trm -> trm -> trm val add : t -> t -> t
val sub : trm -> trm -> trm val sub : t -> t -> t
val seq_size_exn : trm -> trm val seq_size_exn : t -> t
val seq_size : trm -> trm option val seq_size : t -> t option
end = struct end = struct
type var = Var.t type t =
type trm =
| Var of {id: int; name: string} | Var of {id: int; name: string}
| Z of Z.t | Z of Z.t
| Q of Q.t | Q of Q.t
| Arith of Arith.t | Arith of Arith.t
| Splat of trm | Splat of t
| Sized of {seq: trm; siz: trm} | Sized of {seq: t; siz: t}
| Extract of {seq: trm; off: trm; len: trm} | Extract of {seq: t; off: t; len: t}
| Concat of trm array | Concat of t array
| Select of {idx: int; rcd: trm} | Select of {idx: int; rcd: t}
| Update of {idx: int; rcd: trm; elt: trm} | Update of {idx: int; rcd: t; elt: t}
| Record of trm array | Record of t array
| Ancestor of int | Ancestor of int
| Apply of Funsym.t * trm array | Apply of Funsym.t * t array
[@@deriving compare, equal, sexp] [@@deriving compare, equal, sexp]
let compare_trm x y = let compare x y =
if x == y then 0 if x == y then 0
else else
match (x, y) with match (x, y) with
| Var {id= i; name= _}, Var {id= j; name= _} when i > 0 && j > 0 -> | Var {id= i; name= _}, Var {id= j; name= _} when i > 0 && j > 0 ->
Int.compare i j Int.compare i j
| _ -> compare_trm x y | _ -> compare x y
let equal_trm x y = let equal x y =
x == y x == y
|| ||
match (x, y) with match (x, y) with
| Var {id= i; name= _}, Var {id= j; name= _} when i > 0 && j > 0 -> | Var {id= i; name= _}, Var {id= j; name= _} when i > 0 && j > 0 ->
Int.equal i j Int.equal i j
| _ -> equal_trm x y | _ -> equal x y
let rec ppx strength fs trm = let rec ppx strength fs trm =
let rec pp fs trm = let rec pp fs trm =
@ -190,7 +189,7 @@ end = struct
let pp = ppx (fun _ -> None) let pp = ppx (fun _ -> None)
let invariant e = let invariant e =
let@ () = Invariant.invariant [%here] e [%sexp_of: trm] in let@ () = Invariant.invariant [%here] e [%sexp_of: t] in
match e with match e with
| Q q -> assert (not (Z.equal Z.one (Q.den q))) | Q q -> assert (not (Z.equal Z.one (Q.den q)))
| Arith a -> ( | Arith a -> (
@ -247,7 +246,7 @@ end = struct
let _Sized seq siz = let _Sized seq siz =
( match seq_size seq with ( match seq_size seq with
(* ⟨n,α⟩ ==> α when n ≡ |α| *) (* ⟨n,α⟩ ==> α when n ≡ |α| *)
| Some n when equal_trm siz n -> seq | Some n when equal siz n -> seq
| _ -> Sized {seq; siz} ) | _ -> Sized {seq; siz} )
|> check invariant |> check invariant
@ -268,7 +267,7 @@ end = struct
~retn:(fun {pf} -> pf "%a" pp) ~retn:(fun {pf} -> pf "%a" pp)
@@ fun () -> @@ fun () ->
(* _[_,0) ==> ⟨⟩ *) (* _[_,0) ==> ⟨⟩ *)
( if equal_trm len zero then empty_seq ( if equal len zero then empty_seq
else else
let o_l = add off len in let o_l = add off len in
match seq with match seq with
@ -279,7 +278,7 @@ end = struct
| Sized {siz= n; seq= Splat _ as e} when partial_ge n o_l -> | Sized {siz= n; seq= Splat _ as e} when partial_ge n o_l ->
_Sized e len _Sized e len
(* ⟨n,a⟩[0,n) ==> ⟨n,a⟩ *) (* ⟨n,a⟩[0,n) ==> ⟨n,a⟩ *)
| Sized {siz= n} when equal_trm off zero && equal_trm n len -> seq | Sized {siz= n} when equal off zero && equal n len -> seq
(* For (α₀^α₁)[o,l) there are 3 cases: (* For (α₀^α₁)[o,l) there are 3 cases:
* *
* ⟨...⟩^⟨...⟩ * ⟨...⟩^⟨...⟩
@ -339,13 +338,12 @@ end = struct
(* ⟨n,a⟩[o,k)^⟨n,a⟩[o+k,l) ==> ⟨n,a⟩[o,k+l) when n ≥ o+k+l *) (* ⟨n,a⟩[o,k)^⟨n,a⟩[o+k,l) ==> ⟨n,a⟩[o,k+l) when n ≥ o+k+l *)
| ( Extract {seq= Sized {siz= n} as na; off= o; len= k} | ( Extract {seq= Sized {siz= n} as na; off= o; len= k}
, Extract {seq= na'; off= o_k; len= l} ) , Extract {seq= na'; off= o_k; len= l} )
when equal_trm na na' when equal na na' && equal o_k (add o k) && partial_ge n (add o_k l)
&& equal_trm o_k (add o k) ->
&& partial_ge n (add o_k l) ->
Some (_Extract na o (add k l)) Some (_Extract na o (add k l))
(* ⟨m,E^⟩^⟨n,E^⟩ ==> ⟨m+n,E^⟩ *) (* ⟨m,E^⟩^⟨n,E^⟩ ==> ⟨m+n,E^⟩ *)
| Sized {siz= m; seq= Splat _ as a}, Sized {siz= n; seq= a'} | Sized {siz= m; seq= Splat _ as a}, Sized {siz= n; seq= a'}
when equal_trm a a' -> when equal a a' ->
Some (_Sized a (add m n)) Some (_Sized a (add m n))
| _ -> None | _ -> None
in in
@ -359,9 +357,7 @@ end = struct
let _Ancestor i = Ancestor i |> check invariant let _Ancestor i = Ancestor i |> check invariant
let _Apply f es = let _Apply f es =
( match ( match Funsym.eval ~equal ~get_z ~ret_z:_Z ~get_q ~ret_q:_Q f es with
Funsym.eval ~equal:equal_trm ~get_z ~ret_z:_Z ~get_q ~ret_q:_Q f es
with
| Some c -> c | Some c -> c
| None -> Apply (f, es) ) | None -> Apply (f, es) )
|> check invariant |> check invariant

67
sledge/src/trm.mli
Unescape View File

@ -9,7 +9,7 @@
type arith type arith
type trm = private type t = private
(* variables *) (* variables *)
| Var of {id: int; name: string} | Var of {id: int; name: string}
(* arithmetic *) (* arithmetic *)
@ -17,49 +17,48 @@ type trm = private
| Q of Q.t | Q of Q.t
| Arith of arith | Arith of arith
(* sequences (of flexible size) *) (* sequences (of flexible size) *)
| Splat of trm | Splat of t
| Sized of {seq: trm; siz: trm} | Sized of {seq: t; siz: t}
| Extract of {seq: trm; off: trm; len: trm} | Extract of {seq: t; off: t; len: t}
| Concat of trm array | Concat of t array
(* records (with fixed indices) *) (* records (with fixed indices) *)
| Select of {idx: int; rcd: trm} | Select of {idx: int; rcd: t}
| Update of {idx: int; rcd: trm; elt: trm} | Update of {idx: int; rcd: t; elt: t}
| Record of trm array | Record of t array
| Ancestor of int | Ancestor of int
(* uninterpreted *) (* uninterpreted *)
| Apply of Ses.Funsym.t * trm array | Apply of Ses.Funsym.t * t array
[@@deriving compare, equal, sexp] [@@deriving compare, equal, sexp]
module Var : sig module Var : sig
type trm := t
include Ses.Var_intf.VAR with type t = private trm include Ses.Var_intf.VAR with type t = private trm
val of_ : trm -> t val of_ : trm -> t
end end
module Arith : module Arith :
Arithmetic.S Arithmetic.S with type var := Var.t with type trm := t with type t = arith
with type var := Var.t
with type trm := trm
with type t = arith
val ppx : Var.t Var.strength -> trm pp val ppx : Var.t Var.strength -> t pp
val _Var : int -> string -> trm val _Var : int -> string -> t
val _Z : Z.t -> trm val _Z : Z.t -> t
val _Q : Q.t -> trm val _Q : Q.t -> t
val _Arith : Arith.t -> trm val _Arith : Arith.t -> t
val _Splat : trm -> trm val _Splat : t -> t
val _Sized : trm -> trm -> trm val _Sized : t -> t -> t
val _Extract : trm -> trm -> trm -> trm val _Extract : t -> t -> t -> t
val _Concat : trm array -> trm val _Concat : t array -> t
val _Select : int -> trm -> trm val _Select : int -> t -> t
val _Update : int -> trm -> trm -> trm val _Update : int -> t -> t -> t
val _Record : trm array -> trm val _Record : t array -> t
val _Ancestor : int -> trm val _Ancestor : int -> t
val _Apply : Ses.Funsym.t -> trm array -> trm val _Apply : Ses.Funsym.t -> t array -> t
val add : trm -> trm -> trm val add : t -> t -> t
val sub : trm -> trm -> trm val sub : t -> t -> t
val seq_size_exn : trm -> trm val seq_size_exn : t -> t
val seq_size : trm -> trm option val seq_size : t -> t option
val vars : trm -> Var.t iter val vars : t -> Var.t iter
val zero : trm val zero : t
val one : trm val one : t

Write Preview
Loading…
Cancel
Save