diff --git a/TODO.md b/TODO.md index a952104a..559d2d10 100644 --- a/TODO.md +++ b/TODO.md @@ -44,3 +44,9 @@ Amorphous switch between Maude packages. - Increase inter-opability of Maude files. + + +Nelson Oppen +============ + +- Generalize to multiple modules diff --git a/build b/build index af1ba440..1c90e98e 100755 --- a/build +++ b/build @@ -60,7 +60,7 @@ build_yices2() { mkdir -p $build_dir ( cd "$yices2_dir" autoconf - ./configure --prefix="$build_dir" + ./configure --enable-mcsat --prefix="$build_dir" make -s -j4 make -s install ) @@ -121,12 +121,20 @@ build_test_smt() { build_maude_cvc4 build_tangle build_test tests/Misc/smtTest + build_test tests/tools/meta/nelson-oppen/hereditarily-finite-set + build_test tests/tools/meta/nelson-oppen/integer-list + build_test tests/tools/meta/nelson-oppen/lexical-trichotomy-law + build_test tests/tools/meta/nelson-oppen/matrix build_clean build_deps build_maude_yices2 build_tangle build_test tests/Misc/smtTest + build_test tests/tools/meta/nelson-oppen/hereditarily-finite-set + build_test tests/tools/meta/nelson-oppen/integer-list + build_test tests/tools/meta/nelson-oppen/lexical-trichotomy-law + build_test tests/tools/meta/nelson-oppen/matrix git checkout -- src/Mixfix/tokenizer.cc } diff --git a/configure.ac b/configure.ac index ae8df41d..1b0a2a20 100755 --- a/configure.ac +++ b/configure.ac @@ -415,6 +415,7 @@ AC_CONFIG_FILES([Makefile tests/tools/varsat/Makefile tests/tools/fvp/Makefile tests/systems/Makefile + tests/systems/nelson-oppen/Makefile ]) AC_OUTPUT diff --git a/contrib/systems.md/nelson-oppen/hereditarily-finite-set.md b/contrib/systems.md/nelson-oppen/hereditarily-finite-set.md new file mode 100644 index 00000000..9d7ed016 --- /dev/null +++ b/contrib/systems.md/nelson-oppen/hereditarily-finite-set.md @@ -0,0 +1,249 @@ +Hereditarily Finite Sets with Reals +----------------------------------- + +In this example, we demonstrate the combination algorithm with non-convex theories -- non-linear +real arithmetic and hereditarily finite sets. Hereditarily finite sets is an example of a theory not +currently definable in CVC4 or Yices2 because of its use of algebraic data types modulo axioms like +associativity-commutativity and having FVP equations. Hereditarily finite sets (HFS) are a model of +set theory without the axiom of infinity. Although hereditarily finite sets are expressive enough to +encode constructs like the integers and the natural numbers, its initial model is a countable model +and so cannot encode the real numbers. + +```test +set include BOOL off . + +fmod HEREDITARILY-FINITE-SET is + sort MyBool . + op tt : -> MyBool [ctor] . + op ff : -> MyBool [ctor] . +``` + +We have three sorts, `X`, the parametric sort, `Set`s and `Magma`s. +Both `X`s and `Set`s are `Magma`s. + +``` {.test .njr-thesis} + sorts X Set Magma . + subsorts X Set < Magma . +``` + +```test + vars M M' M'' : Magma . + vars S : Set . +``` + +The elements of a hereditarily finite set can be elements of the parameter sort `X` of "atomic +elements", or can be other hereditarily constructed inductively from the following three +constructors. First, `empty` is a `Set`: + +``` {.test .njr-thesis} + op empty : -> Set [ctor] . +``` + +Second, the union operator is an associative, commutative and idemopotent operator: + +``` {.test .njr-thesis} + op _ , _ : Magma Magma -> Magma [ctor assoc comm] . + ---------------------------------------------------------------------------- + eq M , M , M' = M , M' [variant] . + eq M , M = M [variant] . +``` + +Finally, a `Set` may be constructed from any `Magma` by enclosing it in braces. + +``` {.test .njr-thesis} + op { _ } : Magma -> Set [ctor] . +``` + +We also have a subset operator and the various equations (not detailed here) defining it: + +``` {.test .njr-thesis} + op _ C= _ : Magma Magma -> MyBool . +``` + +```test + ---------------------------------------------------------------------------- + eq empty C= M = tt [variant] . + eq { M } C= { M, M' } = tt [variant] . + + eq { M } C= { M } = tt [variant] . + eq { M } C= empty = ff [variant] . + + eq { M, M' } C= { M, M'' } + = { M' } C= { M, M'' } [variant] . + eq { M, M' } C= { M } + = { M' } C= { M } [variant] . + +--- Since `var-sat` does not support `[owise]`, we do not implement the equation +--- for handling the negative case. Since the theory is OS-Compact, we can just let +--- the predicate get stuck, partially evaluated. + + op _ U _ : Set Set -> Set . + ---------------------------------------------------------------------------- + eq empty U S = S [variant] . + eq { M } U { M' } = { M, M' } [variant] . +``` + +```test +endfm + +``` + +```test +fmod TEST-HEREDITARILY-FINITE-SET-SANITY is + protecting HEREDITARILY-FINITE-SET . + protecting BOOL . + vars M M' : Magma . +endfm + +reduce M, M', M == M, M' . +reduce { { empty }, { { empty } }, empty } + == { { empty }, { { empty } }, empty } + . + +reduce empty C= { empty } == tt . +reduce { empty } C= empty . +reduce { empty } C= { { empty } } . +reduce { empty } C= { empty, { empty } } == tt . +reduce { empty } C= { { empty }, { { empty } } } . +reduce { M, M' } C= { M, M' } . + +reduce { empty, empty } C= { empty } . + +--- Nelson Oppen +--- ------------ +--- +--- We must trick `var-sat` into thinking that the `X` sort is countable. +``` + +We instantiate this module with `Real`s as a subsort of `X`: + +``` {.test .njr-thesis} +fmod HFS-REAL is + including HEREDITARILY-FINITE-SET . + sorts Real . + subsorts Real < X . + + op fake-0 : -> Real [ctor] . + op fake-s : Real -> Real [ctor] . +endfm +``` + +```test +load ../../../contrib/tools/meta/nelson-oppen-combination + +fmod HEREDITARILY-FINITE-SET-TEST-VARSAT is + protecting BOOL . + protecting VAR-SAT . + protecting HFS-REAL . + vars M M' : Magma . +endfm + +--- TODO: This does not reduce as I expect it to +reduce upTerm({ X:Real, Y:Real, Z:Real } C= { X:Real }) . + +reduce upTerm({ X:Real, Y:Real, Z:Real } C= { A:Real }) . +reduce upTerm({ X:Real, Y:Real, Z:Real } ) . + +reduce var-sat( upModule('HFS-REAL, true) + , upTerm({ empty , M } C= { empty }) ?= 'tt.MyBool + ) . +reduce var-sat( upModule('HFS-REAL, true) + , upTerm({ empty , M } C= { empty }) ?= 'tt.MyBool + /\ upTerm(M) != 'empty.Set + ) . +reduce var-sat( upModule('HFS-REAL, true) + , upTerm({ empty , M } C= { empty , M' }) ?= 'tt.MyBool + ) . + +--- get variants { X:Magma, Y:Magma, Z:Magma } . +--- --- Lots and lots of variants? or variant computation is slow? +--- reduce var-sat( upModule('HFS-REAL, true) +--- , upTerm({ X:Magma, Y:Magma, Z:Magma } C= { X:Magma }) ?= 'tt.MyBool +--- ) == true . + +reduce var-sat( upModule('HFS-REAL, true) + , upTerm({ X:Real, Y:Real, Z:Real }) ?= upTerm({ X:Real }) + ) == true . + +reduce var-sat( upModule('HFS-REAL, true) + , upTerm({ X:Real, Y:Real, Z:Real } C= { X:Real }) ?= 'tt.MyBool + ) == true . +``` + +Finally, we check the satisfiability of the formula $\{ x^2 , y^2, z^2 \} \subseteq \{ a \} \land x \ne y$. i.e. "is +it possible for the set of squares of three numbers, two of which must be distinct, to be a +subset of a set with a single element." This is indeed possible, since every positive real number +has two distinct square roots. Since set union is idempotent, if the two distinct numbers are +additive inverses of each other and the third is equal to either, then the proposition would indeed +be satisfied. + +```test +set print attribute on . +``` + +Our query is: + +``` {.test .njr-thesis} +reduce in NELSON-OPPEN-COMBINATION : + nelson-oppen-sat( ( tagged(tt, ('mod > 'REAL) ; ('check-sat > 'smt-sat)) + , tagged(tt, ('mod > 'HFS-REAL); ('check-sat > 'var-sat)) + ) + , ( '_C=_[ '`{_`}['_`,_[ '_*_ [ 'Z:Real, 'Z:Real ] + , '_*_ [ 'X:Real, 'X:Real ] + , '_*_ [ 'Y:Real, 'Y:Real ] + ]] + , '`{_`}['A:Real]] + ?= 'tt.MyBool + ) + /\ 'X:Real != 'Y:Real + ) . +``` + +This purifies to: + +```njr-thesis + 'x2:Real ?= '_*_['X:Real,'X:Real] + /\ 'y2:Real ?= '_*_['Y:Real,'Y:Real] + /\ 'z2:Real ?= '_*_['Z:Real,'Z:Real] + /\ 'X:Real != 'Y:Real, +``` + +in the theory of the hereditarily finite sets, and to: + +```njr-thesis + 'tt.MyBool ?= '_C=_['`{_`}['_`,_['z2:Real,'x2:Real,'y2:Real]],'`{_`}['A:Real]] + /\ 'X:Real != 'Y:Real + +``` + +in the theory of the reals. + +Initially, a few equalities are propagated from the theory of hereditarily finite sets: + +```njr-thesis +'HFS-REAL: => 'x2:Real ?= 'y2:Real +'HFS-REAL: => 'y2:Real ?= 'z2:Real +'HFS-REAL: => 'z2:Real ?= 'A:Real +``` + +Since no more identifications of variables are implied on their own and the theories are not convex, +the algorithm must check whether a disjunction of identifications is implied by either of the +theories, and indeed $x = z \lor y = z$ is implied. The algorithm splits the search space on the +remaining candidate equalities ($a = x$, $a = y$, $a = z$, $x = y$, $z = z$ and $y = z$). It first +tries the case where $a = x$ and finds that there are satisfiabile arrangements (this can happen +when $a = x = 1$). It then splits the search space again, but finds that there are no arrangements +$a = y$ possible (since that implies that $x = y$). However the case where $a = z$ is satisfiable. +This causes the the equality $x = z$ to be propagated. Now, since no further equalities or +disjunctions thereof hold, the algorithm concludes that the formula is satisfiable. + +``` +Split? 'A:Real ?= 'X:Real \/ 'A:Real ?= 'Y:Real \/ 'A:Real ?= 'Z:Real \/ 'X:Real ?= 'Y:Real \/ 'X:Real ?= 'Z:Real \/ 'Y:Real ?= 'Z:Real +Split: 'HFS-REAL : 'A:Real ?= 'X:Real +Split? 'A:Real ?= 'Y:Real \/ 'A:Real ?= 'Z:Real \/ 'X:Real ?= 'Y:Real \/ 'X:Real ?= 'Z:Real \/ 'Y:Real ?= 'Z:Real +Split: 'HFS-REAL : 'A:Real ?= 'Y:Real +Split: 'HFS-REAL : 'A:Real ?= 'Z:Real +EqualityProp: 'HFS-REAL: => 'X:Real ?= 'Z:Real +Split? 'A:Real ?= 'Y:Real \/ 'Y:Real ?= 'Z:Real +rewrites: 36007 in 4943ms cpu (4951ms real) (7284 rewrites/second) +result Bool: (true).Bool +``` diff --git a/contrib/systems.md/nelson-oppen/integer-list.md b/contrib/systems.md/nelson-oppen/integer-list.md new file mode 100644 index 00000000..60a897e9 --- /dev/null +++ b/contrib/systems.md/nelson-oppen/integer-list.md @@ -0,0 +1,92 @@ +Combining Integers with Lists +----------------------------- + +\newcommand \head {\text{head}} + +In this example we demonstrate the Nelson-Oppen combination where one of the theories involved is +not convex and the split rule needs to be applied to get the correct result. Here, lists are a +convex theory, but the integers with order are now. + +```test +load ../../../contrib/tools/meta/nelson-oppen-combination.maude +``` + +We implement the lists as a theory that has the finite variant property and use variant based +satisfiability to decide its formulae. Here, the head function returns the first element of the +list. + +```{.test .njr-thesis} +fmod INTEGER-LIST is + sort Integer . + + --- Convince var-sat we are infinite + op fake-0 : -> Integer [ctor] . + op fake-s : Integer -> Integer [ctor] . + + sort IntegerList NeIntegerList . + subsort Integer < NeIntegerList < IntegerList . + op _ _ : NeIntegerList NeIntegerList -> NeIntegerList [ctor assoc] . + op nil : -> IntegerList [ctor] . + + op head : NeIntegerList -> Integer . + var N : Integer . var L : NeIntegerList . + eq head(N) = N [variant] . + eq head(N L) = N [variant] . +endfm +``` + +For the integers, we use one of the external SMT solvers, CVC4 for checking satisfiability. + +```test +fmod TEST-NO-SMT-LIST is + protecting REAL-INTEGER . + protecting INTEGER-LIST . + protecting NELSON-OPPEN-COMBINATION . + protecting META-LEVEL . +endfm + +reduce nelson-oppen-sat(( tagged(tt, ('mod > 'INTEGER-LIST); ('check-sat > 'var-sat)) + , tagged(tt, ('mod > 'INTEGER ); ('check-sat > 'smt-sat))), + '_-_ [ '_*_ [ '2.Integer , 'head[ 'L:NeIntegerList ] ] + , '_*_ [ '2.Integer , 'head[ 'M:NeIntegerList ] ] ] + ?= '1.Integer) + == false + . +reduce nelson-oppen-sat(( tagged(tt, ('mod > 'INTEGER-LIST); 'check-sat > 'var-sat) + , tagged(tt, ('mod > 'INTEGER ); 'check-sat > 'smt-sat)), + '_-_ [ '_*_ [ '2.Integer , 'head[ 'L:NeIntegerList ] ] + , '_*_ [ '2.Integer , 'head[ 'M:NeIntegerList ] ] ] + ?= '0.Integer) + == true + . + +reduce nelson-oppen-sat(( tagged(tt, ('mod > 'INTEGER-LIST); 'check-sat > 'var-sat) + , tagged(tt, ('mod > 'INTEGER ); 'check-sat > 'smt-sat)), + '_-_ [ 'head[ 'L:NeIntegerList ] + , '_*_ [ '2.Integer , 'head[ 'M:NeIntegerList ] ] ] + ?= '0.Integer) + == true + . +``` + +We use Nelson-Oppen to mechanically prove that +$1 \le \head(L) \land +\head(L) \le 2 +\limplies \head(L) = 1 \lor \head(L) = 2$ + +\colorbox{red}{XXX: This example has become trivial (has no equalities to propagate) since we made the change to +the purification that added the extra equalities} + +``` {.test .njr-thesis} +set print attribute on . +reduce nelson-oppen-valid(( tagged(tt, (('mod > 'INTEGER-LIST); 'check-sat > 'var-sat)) + , tagged(tt, (('mod > 'INTEGER ); 'check-sat > 'smt-sat))), + ( '_<=_ [ '1.Integer , 'head[ 'L:NeIntegerList ] ] ?= 'true.Boolean + /\ '_<=_ [ 'head[ 'L:NeIntegerList ] , '2.Integer ] ?= 'true.Boolean + ) + => ( 'head[ 'L:NeIntegerList ] ?= '1.Integer + \/ 'head[ 'L:NeIntegerList ] ?= '2.Integer + ) + ) . +``` + diff --git a/contrib/systems.md/nelson-oppen/lexical-trichotomy-law.md b/contrib/systems.md/nelson-oppen/lexical-trichotomy-law.md new file mode 100644 index 00000000..8d4dcc10 --- /dev/null +++ b/contrib/systems.md/nelson-oppen/lexical-trichotomy-law.md @@ -0,0 +1,114 @@ +Regarding other examples, here is one that might be interesting but it is +unclear whether we can handle it. One could define in var-sat a parametric +module: + +```test +set include Bool off . +load ../../../contrib/tools/meta/nelson-oppen-combination +load smt + +fmod PAIR is + protecting BOOLEAN . + sort X . *** parameter sort + sort Pair . *** pairs + + op [_,_] : X X -> Pair [ctor] . + + op first : Pair -> X . + op second : Pair -> X . + + vars x y : X . + + eq first ([x,y]) = x [variant] . + eq second([x,y]) = y [variant] . + + vars b b' : Boolean . + + op if : Boolean Boolean Boolean -> Boolean . + + eq if(true, b,b') = b [variant] . + eq if(false,b,b') = b' [variant] . +endfm +``` + +Then one could instantiate the parameter X with the rational numbers and define +a lexicographic order on pairs of rationals as follows: + +```test +fmod PAIR-REAL is + including PAIR . + sort Real . + subsorts Real < X . + + --- Convince var-sat that Real is an infinite sort. + op fake-zero : -> Real [ctor] . + op fake-succ : Real -> Real [ctor] . +endfm +``` + +```test +fmod PAIR-REAL-INSTANTIATED is + including REAL . + including PAIR-REAL . + + vars P Q : Pair . + + op _>lex_ : Pair Pair -> Boolean . + eq P >lex Q = if( (first(P) > first(Q)) + , true + , if( (first(Q) > first(P)) + , false + , (second(P) > second(Q)) + ) + ) . +endfm +``` + + op _>lex_ : Pair Pair -> Bool . *** lexicographic order on pairs + + eq [x,y] >lex [x',y'] = if((x > y),tt,if((y > x),ff,(y > y'))) . + +where x \> y is the order on the rationals. + +Then one would like to prove the trichotomy law: + +```test +set print attribute on . +reduce in NELSON-OPPEN-COMBINATION : nelson-oppen-valid( + ( tagged(tt, (('mod > 'PAIR-REAL) ; 'check-sat > 'var-sat)) + , tagged(tt, (('mod > 'REAL ) ; 'check-sat > 'smt-sat)) + ), + (getTerm(metaReduce(upModule('PAIR-REAL-INSTANTIATED, false), '_>lex_[ 'P:Pair , 'Q:Pair]))) ?= 'true.Boolean + \/ (getTerm(metaReduce(upModule('PAIR-REAL-INSTANTIATED, false), '_>lex_[ 'Q:Pair , 'P:Pair]))) ?= 'true.Boolean + \/ 'P:Pair ?= 'Q:Pair + ) + . + +``` + +The only part where I am unsure about how we can define this is the function +symbol \>lex since it is unclear to which signature this function symbol +belongs. It does not belong to the parameterized module as such, and it does not +belong to RAT as such. In some tricky sense, the equation: + + eq [x,y] >lex [x',y'] = if((x > y),tt,if((y > x),ff,(y > y'))) . + +has the finite variant property, since it can only evaluate to tt, ff, or x \> y + +But the module needs to be instantiated before the order operator \> can be +defined. + +What seems to be happening is that \>lex is defined in a third signature, +besides those of PAIR and of RAT and we may not have a way to deal with this. + +Of course, there would be no problem verifying this for \>lex in var-sat for +pairs of naturals with the order on the naturals, but then Nelson-Oppen would +not be needed. + +An alternative approach, used in CS 576 would be to make PAIR parametric on the +theory of total order, and then prove the above trichotomy result for any total +order by instantiating the parameter of total order to the natural numbers, +since I proved that a formula holds for total order if and only if it holds for +the natural numbers order. But again, we would not need to use Nelson-Oppen: all +could be done within var-sat. + diff --git a/contrib/systems.md/nelson-oppen/matrix.md b/contrib/systems.md/nelson-oppen/matrix.md new file mode 100644 index 00000000..2ed0c0ca --- /dev/null +++ b/contrib/systems.md/nelson-oppen/matrix.md @@ -0,0 +1,309 @@ +## Matrices with real and integer entries + +\newcommand \R {\mathbb{R}} + +The specification that follows is not exactly the one used in the experiments, but is equivalent to +it. There are two somewhat subtle issues about this example, namely: (i) the use of +parameterization, and (ii) the use of definitional extensions, that can best be explained using +Maude parameter theories, parameterized modules, and parameter instantiation by views. + +We can define in Maude the theory of $2 \times 2$ matrices over a ring as the following module +parameterized by the theory of rings as its parameter theory: + +\begin{verbatim} +fth RING is + sort Ring . + op _+_ : Ring Ring -> Ring [assoc comm] . + op _*_ : Ring Ring -> Ring [assoc comm] . + op 0 : -> Ring . + op 1 : -> Ring . + op - : Ring -> Ring . + vars x y z : Ring . + eq x + 0 = x . + eq 1 * x = x . + eq x + -(x) = 0 . + eq x * (y + z) = (x * y) + (x * z) . +endfth + +fmod MATRIX{R :: RING} is + sort Matrix . + op matrix : R$Ring R$Ring R$Ring R$Ring -> Matrix [ctor] . + + vars A B C D : R$Ring . + + op m11 : Matrix -> R$Ring . + op m12 : Matrix -> R$Ring . + op m21 : Matrix -> R$Ring . + op m22 : Matrix -> R$Ring . + + eq m11(matrix(A, B, C, D)) = A [variant] . + eq m12(matrix(A, B, C, D)) = B [variant] . + eq m21(matrix(A, B, C, D)) = C [variant] . + eq m22(matrix(A, B, C, D)) = D [variant] . +endfm +\end{verbatim} + +Next, we define matrix multiplication, determinant and identity as \emph{definitional extensions} of +the theory of matrices. That is, these new functions are fully defined in terms of the theory of +matrices itself and can always be "evaluated away." This is important to meet the Nelson-Oppen +theory disjointness requirement, as explained below. + +\begin{verbatim} +fmod MATRIX-OPS{R :: RING} is + protecting MATRIX{R} . + + vars A1 B1 A2 B2 : R$Ring . + vars A B : Matrix . + + op mulSum : R$Ring R$Ring R$Ring R$Ring -> R$Ring . + eq mulSum(A1, B1, A2, B2) = (A1 * B1) + (A2 * B2) . + + op multiply : Matrix Matrix -> Matrix . + eq multiply(A, B) + = matrix(mulSum(m11(A),m11(B),m12(A),m21(B)), + mulSum(m11(A),m12(B),m12(A),m22(B)), + mulSum(m21(A),m11(B),m22(A),m21(B)), + mulSum(m21(A),m12(B),m22(A),m22(B))) . + + op determinant : Matrix -> R*Ring . + eq determinant(A) + = (m11(A) * m22(A)) - (m12(A) * m21(A)) . + + op identity : -> Matrix . + eq identity = matrix(1, 0, 0, 1) . +endfm +\end{verbatim} + +Next we instantiate the theory of rings to the module for the theory of Reals using a view: + +\begin{verbatim} +view Real from RING to REAL is + sort Ring to Real . + op 0 to 0/1 . + op 1 to 1/1 . + op _+_ to _+_ . + op _- to _- . + op _*_ to _*_ . +endv + +fmod MATRIX-REAL is + protecting MATRIX-OPS{Real} . +endfm +\end{verbatim} + +What is crucial about this theory instantiation is that, since the operators in \texttt{MATRIX-OPS} +are all definitional extensions, they can all be evaluated away to their righthand sides, i.e., to +operators in the disjoint union of two theories: (i) the FVP theory \texttt{MATRIX} obtained by +completely removing its \texttt{RING} parameter part, and (ii) the theory \texttt{REAL} to which the +parameter theory \texttt{RING} is instantiated. Therefore, the order-sorted Nelson-Oppen algorithm +can be invoked to decide validity and satisfiability of formulas in \texttt{MATRIX-REAL}, once we: +(i) evaluate away all defined operations in \texttt{MATRIX-OPS} appearing in a formula, and (ii) +purify the formula into its two disjoint parts. + +```test +set include BOOL off . +load ../../../contrib/tools/meta/nelson-oppen-combination.maude +``` + +```{.test} +fmod MATRIX-X is + sort X Matrix . + op matrix : X X X X -> Matrix [ctor] . + + vars A B C D : X . + op m11 : Matrix -> X . + op m12 : Matrix -> X . + op m21 : Matrix -> X . + op m22 : Matrix -> X . + + eq m11(matrix(A, B, C, D)) = A [variant] . + eq m12(matrix(A, B, C, D)) = B [variant] . + eq m21(matrix(A, B, C, D)) = C [variant] . + eq m22(matrix(A, B, C, D)) = D [variant] . +endfm + +--- Next, we define multiplication, determinant and identify as meta-functions -- +--- functions over terms at the meta-level. + +fmod MATRIX-TEST is + protecting NELSON-OPPEN-COMBINATION . + + vars A B A1 B1 A2 B2 ZERO ONE : Term . +``` + +```{.test} + op mulSum : Term Term Term Term -> Term . + eq mulSum(A1, B1, A2, B2) = '_+_ [ '_*_ [ A1 , B1 ] + , '_*_ [ A2 , B2 ] + ] . + + op multiply : Term Term -> Term . + eq multiply(A, B) = 'matrix[ mulSum('m11[A], 'm11[B], 'm12[A], 'm21[B]) + , mulSum('m11[A], 'm12[B], 'm12[A], 'm22[B]) + , mulSum('m21[A], 'm11[B], 'm22[A], 'm21[B]) + , mulSum('m21[A], 'm12[B], 'm22[A], 'm22[B]) + ] . + op determinant : Term -> Term . + eq determinant(A) = '_-_ [ '_*_ [ 'm11[A], 'm22[A] ] + , '_*_ [ 'm12[A], 'm21[A] ] + ] . + + op identity : Term Term -> Term . + eq identity(ZERO, ONE) = 'matrix[ONE, ZERO, ZERO, ONE] . +``` + +```test +endfm + +--- Finally, we the parameterise this theory over the reals: + +fmod MATRIX-REAL is + including MATRIX-X . + sort Real . + subsorts Real < X . + --- Convince var-sat that Real is an infinite sort. + op fake-zero : -> Real [ctor] . + op fake-succ : Real -> Real [ctor] . +endfm + +--- Reducing this in via Nelson-Oppen yeilds: + +set print attribute on . +``` + +We cannot, at the moment, use this specification as is, because the Nelson-Oppen implementation does +not support views yet. Instead, we execute the the following query against an equivalent +specification of real matrices: + +``` {.test .njr-thesis} +reduce in MATRIX-TEST : nelson-oppen-valid( + ( tagged(tt, (('mod > 'MATRIX-REAL); ('check-sat > 'var-sat))) + , tagged(tt, (('mod > 'REAL); ('check-sat > 'smt-sat))) + ), + (multiply('A:Matrix, 'B:Matrix) ?= identity('0/1.Real, '1/1.Real)) + => (determinant('A:Matrix) != '0/1.Real) + ) . +``` + +The negation of this forumla (since we are checking validity) purifies to the following the formula +in the theory of reals: + +```njr-thesis + '0:Real ?= '0/1.Real + /\ '1:Real ?= '1/1.Real + /\ 'p11:Real ?= '_+_['_*_['a11:Real, 'b11:Real],'_*_[ 'a12:Real, 'b21:Real]] + /\ 'p12:Real ?= '_+_['_*_['a11:Real, 'b12:Real],'_*_[ 'a12:Real, 'b22:Real]] + /\ 'p21:Real ?= '_+_['_*_['a21:Real, 'b11:Real],'_*_[ 'a22:Real, 'b21:Real]] + /\ 'p22:Real ?= '_+_['_*_['a21:Real, 'b12:Real],'_*_[ 'a22:Real, 'b22:Real]] + /\ '0/1.Real ?= '_-_['_*_['a11:Real, 'a22:Real],'_*_[ 'a12:Real, 'a21:Real]] +``` + +and, in the theory of Matrices: + +```njr-thesis + 'a11:Real ?= 'm11['A:Matrix] /\ 'b11:Real ?= 'm11['B:Matrix] + /\ 'a12:Real ?= 'm12['A:Matrix] /\ 'b12:Real ?= 'm12['B:Matrix] + /\ 'a21:Real ?= 'm21['A:Matrix] /\ 'b21:Real ?= 'm21['B:Matrix] + /\ 'a22:Real ?= 'm22['A:Matrix] /\ 'b22:Real ?= 'm22['B:Matrix] + /\ 'matrix['1:Real ,'0:Real , '0:Real ,'1:Real ] + ?= 'matrix['p11:Real,'p12:Real,'p21:Real,'p22:Real] +``` + +Next, each theory propagates equalities that are implied by each formula: + +```njr-thesis +'MATRIX-REAL: => '0:Real ?= 'p12:Real +'MATRIX-REAL: => '1:Real ?= 'p11:Real +'REAL: => 'p12:Real ?= 'p22:Real +'MATRIX-REAL: => 'p11:Real ?= 'p21:Real +'REAL: => 'a11:Real ?= 'a21:Real +'REAL: => 'a12:Real ?= 'a22:Real +'MATRIX-REAL: => 'p21:Real ?= 'p22:Real +``` + +But, this last identification is a contradiction in the theory of reals. $p_{22}$ cannot equal +$p_{21}$ since $p_{22} = p_{12} = 0$, while $p_{21} = p_{11} = 1$. Thus, the negation is +unsatisfiable and the original formula must be valid. + +It turns out that if we combine this module with the Integers instead of the Reals, we can prove +something stronger: that any invertible matrix must have determinant $\pm 1$. Unfortunately, CVC4 is +not able to solve the non-linear arithmetic needed to prove this. We must instead turn to the Yices +solver, the other SMT solver available in Maude. Even so, the default configuration for Yices does +not enable the solver for non-linear arithmetic (MCSAT), and running this example involved modifying +the Maude C++ source code to enable that configuration. Even so, the computational difficulty +involved in solving non-linear integer arithmetic forced us to restrict the proof to +upper-triangular matrices. + +```test +fmod MATRIX-INTEGER is + including MATRIX-X . + sort Integer . + subsorts Integer < X . + --- Convince var-sat that Integer is an infinite sort. + op fake-zero : -> Integer [ctor] . + op fake-succ : Integer -> Integer [ctor] . +endfm +``` + +``` {.test .njr-thesis} +reduce in MATRIX-TEST : nelson-oppen-valid( + ( tagged(tt, (('mod > 'MATRIX-INTEGER); + ('check-sat > 'var-sat); ('convex > 'true))) + , tagged(tt, (('mod > 'INTEGER ); + ('check-sat > 'smt-sat); ('convex > 'false))) + ), + ( multiply('A:Matrix, 'B:Matrix) ?= identity('0.Integer, '1.Integer) + /\ 'm21['A:Matrix] ?= '0.Integer + /\ 'm21['B:Matrix] ?= '0.Integer + ) + => ( determinant('A:Matrix) ?= '1.Integer + \/ determinant('A:Matrix) ?= '-_['1.Integer] + ) + ) . +``` + +In the theory of integers this purifies to: + +```njr-thesis + '0:Integer ?= 'a21:Integer /\ '0:Integer ?= 'b21:Integer + /\ '0:Integer ?= '0.Integer /\ '1:Integer ?= '1.Integer + /\ 'p11:Integer ?= '_+_[ '_*_['a11:Integer, 'b11:Integer] + , '_*_['a12:Integer, 'b21:Integer]] + /\ 'p12:Integer ?= '_+_[ '_*_['a11:Integer, 'b12:Integer] + , '_*_['a12:Integer, 'b22:Integer]] + /\ 'p21:Integer ?= '_+_[ '_*_['a21:Integer, 'b11:Integer] + , '_*_['a22:Integer, 'b21:Integer]] + /\ 'p22:Integer ?= '_+_[ '_*_['a21:Integer, 'b12:Integer] + , '_*_['a22:Integer, 'b22:Integer]] + /\ '1.Integer != '_-_['_*_[ 'a11:Integer, 'a22:Integer] + ,'_*_[ 'a12:Integer, 'a21:Integer]] + /\ '-_['1.Integer] != '_-_[ '_*_['a11:Integer, 'a22:Integer] + , '_*_[ 'a12:Integer, 'a21:Integer]] +``` + +and, in the theory of matrices to: + +```njr-thesis + '0:Integer ?= 'a21:Integer /\ '0:Integer ?= 'b21:Integer + /\ 'a11:Integer ?= 'm11['A:Matrix] /\ 'b11:Integer ?= 'm11['B:Matrix] + /\ 'a12:Integer ?= 'm12['A:Matrix] /\ 'b12:Integer ?= 'm12['B:Matrix] + /\ 'a21:Integer ?= 'm21['A:Matrix] /\ 'b21:Integer ?= 'm21['B:Matrix] + /\ 'a22:Integer ?= 'm22['A:Matrix] /\ 'b22:Integer ?= 'm22['B:Matrix] + /\ 'matrix[ '1:Integer,'0:Integer, '0:Integer,'1:Integer] + ?= 'matrix['p11:Integer,'p12:Integer,'p21:Integer,'p22:Integer] +``` + +Similar equalities are propagated: + +```njr-thesis +'INTEGER: => '0:Integer ?= 'p21:Integer +'INTEGER: => 'p21:Integer ?= 'a21:Integer +'INTEGER: => 'a21:Integer ?= 'b21:Integer +'MATRIX-INTEGER: => '1:Integer ?= 'p11:Integer +'INTEGER: => 'a11:Integer ?= 'b11:Integer +'MATRIX-INTEGER: => 'p11:Integer ?= 'p22:Integer +``` + +leading to a complex contradiction forcing some elements to be inverses of others in an impossible +way, allowing us to conclude that the original formula is valid. + diff --git a/contrib/tools/meta.md/eqform.md b/contrib/tools/meta.md/eqform.md index 1685a278..47652c89 100644 --- a/contrib/tools/meta.md/eqform.md +++ b/contrib/tools/meta.md/eqform.md @@ -93,6 +93,7 @@ base sort which helps ensure preregularity in complex cases (this gives ```maude load terms.maude +load ../meta/meta-aux.maude set include BOOL off . @@ -143,7 +144,7 @@ fmod EQFORM-IMPL{X :: TRIV} is subsort EqDisj{X} < NegTruthDisj{X} < NoTrueDisj{X} NoFalseDisj{X} < NormDisj{X} < Disj{X} . subsort EqForm{X} < NegTruthForm{X} < NoTrueForm{X} NoFalseForm{X} < NormForm{X} < Form{X} . - vars F F' : Form{X} . var EqL : EqLit{X} . + vars X X' : X$Elt . var EqL : EqLit{X} . vars F F' : Form{X} . --- Define Literals op tt : -> TrueLit{X} [ctor] . @@ -192,12 +193,24 @@ fmod EQFORM-IMPL{X :: TRIV} is op _\/_ : NoFalseForm{X} NoFalseForm{X} -> NoFalseForm{X} [ctor ditto] . op _\/_ : Form{X} Form{X} -> Form{X} [ctor ditto] . --------------------------------------------------- + eq ~ tt = ff . + eq ~ ff = tt . + + eq ff /\ ff = ff . + eq tt \/ tt = tt . + eq ff /\ EqL = ff . eq tt \/ EqL = tt . eq EqL /\ EqL = EqL . eq EqL \/ EqL = EqL . + eq X ?= X = tt . + eq X != X = ff . + + eq X ?= X' /\ X != X' = ff . + eq X ?= X' \/ X != X' = tt . + --- Implication op _=>_ : Form{X} Form{X} -> Form{X} . op _<=>_ : Form{X} Form{X} -> Form{X} . @@ -479,6 +492,7 @@ endfm fmod EQFORM-SET is pr EQFORM . + pr SUBSTITUTION-SET . sort EmptyFormSet . sort PosEqLitSet PosEqConjSet PosEqDisjSet PosEqFormSet . @@ -565,5 +579,135 @@ fmod EQFORM-SET is op (_|_) : EqFormNeSet EqFormSet -> EqFormNeSet [ctor ditto] . op (_|_) : NormFormNeSet NormFormSet -> NormFormNeSet [ctor ditto] . op (_|_) : FormNeSet FormSet -> FormNeSet [ctor ditto] . + + var S : Substitution . var NeSS : NeSubstitutionSet . var SS : SubstitutionSet . + var F : Form . var FNeS : FormNeSet . var FS : FormSet . + + op _<<_ : FormSet SubstitutionSet -> [FormSet] . + ------------------------------------------------ + eq mtFormSet << SS = mtFormSet . + eq (F | FNeS) << SS = (F << SS) | (FNeS << SS) . + + eq FS << .SubstitutionSet = mtFormSet . + eq FS << (S | NeSS) = (FS << S) | (FS << NeSS) . +endfm +``` + +```maude +fmod EQFORM-OPERATIONS is + pr EQFORM . + pr TERM-EXTRA . --- defines vars() : Term -> QidSet + + vars F F1 F2 : Form . vars TL : TruthLit . vars PEC1 : PosEqConj . + vars M : Module . vars T T' : Term . + + op wellFormed : Module Form -> [Bool] . + op $wellFormed : Module Form -> [Bool] . + ---------------------------------------- + ceq wellFormed(M,F) = $wellFormed(M,F) if wellFormed(M) . + ceq $wellFormed(M,F1 /\ F2) = $wellFormed(M,F1) and-then $wellFormed(M,F2) if F1 =/= tt /\ F2 =/= tt . + ceq $wellFormed(M,F1 \/ F2) = $wellFormed(M,F1) and-then $wellFormed(M,F2) if F1 =/= ff /\ F2 =/= ff . + eq $wellFormed(M,~ F) = $wellFormed(M,F) . + --- eq lit + eq $wellFormed(M,T ?= T') = wellFormed(M,T) and-then wellFormed(M,T') and-then sameKind(M,leastSort(M,T),leastSort(M,T')) . + eq $wellFormed(M,T != T') = wellFormed(M,T) and-then wellFormed(M,T') and-then sameKind(M,leastSort(M,T),leastSort(M,T')) . + --- true/false lit or mtForm + eq $wellFormed(M,TL) = true . + + op normalize : Module Form -> [Form] . + -------------------------------------- + ceq normalize(M,F1 /\ F2) = normalize(M,F1) /\ normalize(M,F2) if F1 =/= tt /\ F2 =/= tt . + ceq normalize(M,F1 \/ F2) = normalize(M,F1) \/ normalize(M,F2) if F1 =/= ff /\ F2 =/= ff . + eq normalize(M,~ F) = ~ normalize(M,F) . + eq normalize(M,T ?= T') = getTerm(metaNormalize(M,T)) ?= getTerm(metaNormalize(M,T')) . + eq normalize(M,T != T') = getTerm(metaNormalize(M,T)) != getTerm(metaNormalize(M,T')) . + eq normalize(M,TL) = TL . + + op reduce : Module Form -> [Form] . + ----------------------------------- + ceq reduce(M,F1 /\ F2) = reduce(M,F1) /\ reduce(M,F2) if F1 =/= tt /\ F2 =/= tt . + ceq reduce(M,F1 \/ F2) = reduce(M,F1) \/ reduce(M,F2) if F1 =/= ff /\ F2 =/= ff . + eq reduce(M,~ F) = ~ reduce(M,F) . + eq reduce(M,T ?= T') = getTerm(metaReduce(M,T)) ?= getTerm(metaReduce(M,T')) . + eq reduce(M,T != T') = getTerm(metaReduce(M,T)) != getTerm(metaReduce(M,T')) . + eq reduce(M,TL) = TL . + + op vars : Form -> QidSet . + -------------------------- + ceq vars(F1 /\ F2) = vars(F1) ; vars(F2) if F1 =/= tt /\ F2 =/= tt . + ceq vars(F1 \/ F2) = vars(F1) ; vars(F2) if F1 =/= ff /\ F2 =/= ff . + eq vars(~ F) = vars(F) . + eq vars(T ?= T') = vars(T) ; vars(T') . + eq vars(T != T') = vars(T) ; vars(T') . + eq vars(TL) = none . + + --- INP: PosConj + --- PRE: PosConj has no ff literals + --- OUT: UnificationProblem + op toUnifProb : PosEqConj -> UnificationProblem . + ------------------------------------------------ + eq toUnifProb((T ?= T') /\ PEC1) = T =? T' /\ toUnifProb(PEC1) . + eq toUnifProb(T ?= T') = T =? T' . +endfm +``` + +```maude +fmod EQFORM-SET-OPERATIONS is + pr EQFORM-OPERATIONS . + pr EQFORM-SET . + pr EQFORM-CNF . + pr EQFORM-DNF . + + var TL : TruthLit . var C : EqConj . var D : EqDisj . + var FS : FormSet . var F F' : Form . var UP : UnificationProblem . + var PEA : PosEqLit . var PELS : PosEqLitSet . var T T' : Term . var M : Module . + + op wellFormed : Module FormSet -> Bool . + ---------------------------------------- + eq wellFormed(M , F | F' | FS) = wellFormed(M,F) and-then wellFormed(M,F' | FS) . + eq wellFormed(M , mtFormSet) = true . + + op disj-join : FormSet -> [Form] . + op disj-join : FormSet -> [Form] . + ---------------------------------- + eq disj-join(F | FS) = F \/ disj-join(FS) . + eq disj-join(mtFormSet) = ff . + + op conj-join : FormSet -> [Form] . + op conj-join : FormSet -> [Form] . + ---------------------------------- + eq conj-join(F | FS) = F /\ conj-join(FS) . + eq conj-join(mtFormSet) = tt . + + op toDisjSet : Form -> [EqDisjSet] . + op toDisjSet' : Form -> [EqDisjSet] . + ------------------------------------- + eq toDisjSet (F) = toDisjSet'(cnf(F)) . + eq toDisjSet'(TL) = mtFormSet . + eq toDisjSet'(D /\ F) = D | toDisjSet'(F) . + + op toConjSet : Form -> [EqConjSet] . + op toConjSet' : Form -> [EqConjSet] . + ------------------------------------- + eq toConjSet (F) = toConjSet'(dnf(F)) . + eq toConjSet'(TL) = mtFormSet . + eq toConjSet'(C \/ F) = C | toConjSet'(F) . + + op toEqSet : PosEqLitSet -> EquationSet . + ----------------------------------------- + eq toEqSet((T ?= T') | PELS) = (eq T = T' [none] .) toEqSet(PELS) . + eq toEqSet(mtFormSet) = none . + + op toPosEqLits : PosEqForm -> PosEqLitSet . + op toPosEqLits : UnificationProblem -> PosEqLitSet . + ---------------------------------------------------- + eq toPosEqLits(TL) = mtFormSet . + eq toPosEqLits(T ?= T') = T ?= T' . + eq toPosEqLits(~ F) = toPosEqLits(F) . + ceq toPosEqLits(F /\ F') = toPosEqLits(F) | toPosEqLits(F') if F =/= tt /\ F' =/= tt . + ceq toPosEqLits(F \/ F') = toPosEqLits(F) | toPosEqLits(F') if F =/= ff /\ F' =/= ff . + + eq toPosEqLits(T =? T' /\ UP) = (T ?= T') | toPosEqLits(UP) . + eq toPosEqLits(T =? T') = T ?= T' . endfm ``` diff --git a/contrib/tools/meta.md/foform.md b/contrib/tools/meta.md/foform.md index bb35bf17..a380ebe9 100644 --- a/contrib/tools/meta.md/foform.md +++ b/contrib/tools/meta.md/foform.md @@ -8,65 +8,64 @@ in separate modules from FOFORM and are called through META-LEVEL reflection. This isolates the modules from one another and simplifies the algorithm design. ```maude -load variables.maude -load ../base/full-maude.maude - -fmod BOOL-ERR is - protecting MAYBE-BOOL * ( sort MaybeBool to Bool? ) . -endfm +load meta-aux.maude --- library of extensions to Maude's META-LEVEL module +load variables.maude --- next-gen renaming library fmod REFLECT is pr META-LEVEL . + pr UNIT-FM . + op modReduce : Module Term -> [Term] . op redReflect : Qid Term -> [Term] . op sortReflect : Qid Term Type -> [Bool] . + var Mod : Module . var M : Qid . var T : Term . var TY : Type . + eq modReduce(Mod,T) = if Mod =/= noModule then getTerm(metaReduce(Mod,T)) else T fi . eq redReflect(M,T) = getTerm(metaReduce(upModule(M,false),T)) . eq sortReflect(M,T,TY) = sortLeq(upModule(M,false),leastSort(upModule(M,false),T),TY) . endfm -fmod FOFORM is +fmod QFFOFORM is pr META-LEVEL . --- NOTE: This sort structure is complicated. Edit at your own risk (unless you want to simplify it). --- Sort Declarations --- Non-Empty/Possibly Empty Forms - sort TrueAtom FalseAtom TruthAtom PosEqAtom NegEqAtom Truth+PosEqAtom Truth+NegEqAtom EqAtom Atom . + sort TrueLit FalseLit TruthLit PosEqLit NegEqLit Truth+PosEqLit Truth+NegEqLit EqLit Lit . sort ConstConj PosEqConj NegEqConj EqConj PosConj NegConj Conj . sort ConstDisj PosEqDisj NegEqDisj EqDisj PosDisj NegDisj Disj . - sort PosEqQFForm NegEqQFForm EqQFForm QFForm AEQForm FOForm . - sort EmptyForm TruthAtom? PosEqAtom? NegEqAtom? Truth+NegEqAtom? Truth+PosEqAtom? EqAtom? Atom? . + sort PosEqQFForm NegEqQFForm EqQFForm QFForm . + sort EmptyForm TruthLit? PosEqLit? NegEqLit? Truth+NegEqLit? Truth+PosEqLit? EqLit? Lit? . sort ConstConj? PosEqConj? NegEqConj? EqConj? PosConj? NegConj? Conj? . sort ConstDisj? PosEqDisj? NegEqDisj? EqDisj? PosDisj? NegDisj? Disj? . - sort PosEqQFForm? NegEqQFForm? EqQFForm? QFForm? AEQForm? FOForm? . + sort PosEqQFForm? NegEqQFForm? EqQFForm? QFForm? . --- Subsorting - --- Atoms - subsort TrueAtom FalseAtom < TruthAtom . - subsort PosEqAtom NegEqAtom < EqAtom < Atom . - subsort TruthAtom PosEqAtom < Truth+PosEqAtom < Atom . - subsort TruthAtom NegEqAtom < Truth+NegEqAtom < Atom . - --- Non-Atoms - subsort PosEqConj PosEqDisj < PosEqQFForm < EqQFForm . - subsort NegEqConj NegEqDisj < NegEqQFForm < EqQFForm . - subsort EqConj EqDisj EqAtom < EqQFForm < QFForm . - subsort Atom < Conj Disj < QFForm < FOForm . - subsort AEQForm < FOForm . + --- Lits + subsort TrueLit FalseLit < TruthLit . + subsort PosEqLit NegEqLit < EqLit < Lit . + subsort TruthLit PosEqLit < Truth+PosEqLit < Lit . + subsort TruthLit NegEqLit < Truth+NegEqLit < Lit . + --- Non-Lits + subsort PosEqConj PosEqDisj < PosEqQFForm < EqQFForm . + subsort NegEqConj NegEqDisj < NegEqQFForm < EqQFForm . + subsort EqConj EqDisj EqLit < EqQFForm < QFForm . + subsort Lit < Conj Disj < QFForm . --- Conjunctions/Disjunctions - subsort PosEqAtom < PosEqConj < PosConj . - subsort NegEqAtom < NegEqConj < NegConj . - subsort PosEqAtom < PosEqDisj < PosDisj . - subsort NegEqAtom < NegEqDisj < NegDisj . - subsort PosEqConj NegEqConj EqAtom < EqConj < Conj . - subsort PosEqDisj NegEqDisj EqAtom < EqDisj < Disj . - subsort TruthAtom < ConstConj < PosConj NegConj < Conj . - subsort TruthAtom < ConstDisj < PosDisj NegDisj < Disj . - subsort Truth+PosEqAtom < PosConj PosDisj . - subsort Truth+NegEqAtom < NegConj NegDisj . + subsort PosEqLit < PosEqConj < PosConj . + subsort NegEqLit < NegEqConj < NegConj . + subsort PosEqLit < PosEqDisj < PosDisj . + subsort NegEqLit < NegEqDisj < NegDisj . + subsort PosEqConj NegEqConj EqLit < EqConj < Conj . + subsort PosEqDisj NegEqDisj EqLit < EqDisj < Disj . + subsort TruthLit < ConstConj < PosConj NegConj < Conj . + subsort TruthLit < ConstDisj < PosDisj NegDisj < Disj . + subsort Truth+PosEqLit < PosConj PosDisj . + subsort Truth+NegEqLit < NegConj NegDisj . --- Link Non-Empty/Possibly Empty Forms - subsort TruthAtom < TruthAtom? . subsort PosEqAtom < PosEqAtom? . - subsort Truth+PosEqAtom < Truth+PosEqAtom? . subsort NegEqAtom < NegEqAtom? . - subsort EqAtom < EqAtom? . subsort Atom < Atom? . - subsort Truth+NegEqAtom < Truth+NegEqAtom? . subsort PosEqConj < PosEqConj? . + subsort TruthLit < TruthLit? . subsort PosEqLit < PosEqLit? . + subsort Truth+PosEqLit < Truth+PosEqLit? . subsort NegEqLit < NegEqLit? . + subsort EqLit < EqLit? . subsort Lit < Lit? . + subsort Truth+NegEqLit < Truth+NegEqLit? . subsort PosEqConj < PosEqConj? . subsort ConstConj < ConstConj? . subsort NegEqConj < NegEqConj? . subsort EqConj < EqConj? . subsort Conj < Conj? . subsort PosConj < PosConj? . subsort PosEqDisj < PosEqDisj? . @@ -74,38 +73,36 @@ fmod FOFORM is subsort ConstDisj < ConstDisj? . subsort PosDisj < PosDisj? . subsort NegDisj < NegDisj? . subsort EqDisj < EqDisj? . subsort QFForm < QFForm? . subsort Disj < Disj? . - subsort FOForm < FOForm? . subsort AEQForm < AEQForm? . subsort EqQFForm < EqQFForm? . subsort PosEqQFForm < PosEqQFForm? . subsort NegEqQFForm < NegEqQFForm? . - --- Possibly Empty Atoms - subsort EmptyForm < TruthAtom? < Truth+PosEqAtom? Truth+NegEqAtom? < Atom? . - subsort EmptyForm < PosEqAtom? NegEqAtom? < EqAtom? < Atom? . - subsort EmptyForm < TruthAtom? PosEqAtom? < Truth+PosEqAtom? . - subsort EmptyForm < TruthAtom? NegEqAtom? < Truth+NegEqAtom? . - --- Possibly Empty Non-Atoms + --- Possibly Empty Lits + subsort EmptyForm < TruthLit? < Truth+PosEqLit? Truth+NegEqLit? < Lit? . + subsort EmptyForm < PosEqLit? NegEqLit? < EqLit? < Lit? . + subsort EmptyForm < TruthLit? PosEqLit? < Truth+PosEqLit? . + subsort EmptyForm < TruthLit? NegEqLit? < Truth+NegEqLit? . + --- Possibly Empty Non-Lits subsort EmptyForm < PosEqConj? PosEqDisj? < PosEqQFForm? < EqQFForm? . subsort EmptyForm < NegEqConj? NegEqDisj? < NegEqQFForm? < EqQFForm? . - subsort EmptyForm < EqConj? EqDisj? EqAtom? < EqQFForm? < QFForm? . - subsort EmptyForm < Atom? < Conj? Disj? < QFForm? < FOForm? . - subsort EmptyForm < AEQForm? < FOForm? . + subsort EmptyForm < EqConj? EqDisj? EqLit? < EqQFForm? < QFForm? . + subsort EmptyForm < Lit? < Conj? Disj? < QFForm? . --- Possibly Empty Conjunctions/Disjunctions - subsort EmptyForm < PosEqAtom? < PosEqConj? < PosConj? . - subsort EmptyForm < NegEqAtom? < NegEqConj? < NegConj? . - subsort EmptyForm < PosEqAtom? < PosEqDisj? < PosDisj? . - subsort EmptyForm < NegEqAtom? < NegEqDisj? < NegDisj? . - subsort EmptyForm < PosEqConj? NegEqConj? EqAtom? < EqConj? < Conj? . - subsort EmptyForm < PosEqDisj? NegEqDisj? EqAtom? < EqDisj? < Disj? . - subsort EmptyForm < TruthAtom? < ConstConj? < PosConj? NegConj? < Conj? . - subsort EmptyForm < TruthAtom? < ConstDisj? < PosDisj? NegDisj? < Disj? . - subsort EmptyForm < Truth+PosEqAtom? < PosConj? PosDisj? . - subsort EmptyForm < Truth+NegEqAtom? < NegConj? NegDisj? . - - --- Atomic Formulas + subsort EmptyForm < PosEqLit? < PosEqConj? < PosConj? . + subsort EmptyForm < NegEqLit? < NegEqConj? < NegConj? . + subsort EmptyForm < PosEqLit? < PosEqDisj? < PosDisj? . + subsort EmptyForm < NegEqLit? < NegEqDisj? < NegDisj? . + subsort EmptyForm < PosEqConj? NegEqConj? EqLit? < EqConj? < Conj? . + subsort EmptyForm < PosEqDisj? NegEqDisj? EqLit? < EqDisj? < Disj? . + subsort EmptyForm < TruthLit? < ConstConj? < PosConj? NegConj? < Conj? . + subsort EmptyForm < TruthLit? < ConstDisj? < PosDisj? NegDisj? < Disj? . + subsort EmptyForm < Truth+PosEqLit? < PosConj? PosDisj? . + subsort EmptyForm < Truth+NegEqLit? < NegConj? NegDisj? . + + --- Litic Formulas op mtForm : -> EmptyForm [ctor] . - op tt : -> TrueAtom [ctor] . - op ff : -> FalseAtom [ctor] . - op _?=_ : Term Term -> PosEqAtom [ctor comm prec 50] . - op _!=_ : Term Term -> NegEqAtom [ctor comm prec 50] . + op tt : -> TrueLit [ctor] . + op ff : -> FalseLit [ctor] . + op _?=_ : Term Term -> PosEqLit [ctor comm prec 50] . + op _!=_ : Term Term -> NegEqLit [ctor comm prec 50] . --- Non-empty Conjunctions/Disjunctions (NeSets) op _/\_ : ConstConj? ConstConj -> ConstConj [ctor assoc comm id: mtForm prec 51] . op _/\_ : PosEqConj? PosEqConj -> PosEqConj [ctor ditto] . @@ -118,8 +115,6 @@ fmod FOFORM is op _/\_ : NegEqQFForm? NegEqQFForm -> NegEqQFForm [ctor ditto] . op _/\_ : EqQFForm? EqQFForm -> EqQFForm [ctor ditto] . op _/\_ : QFForm? QFForm -> QFForm [ctor ditto] . - op _/\_ : AEQForm? AEQForm -> AEQForm [ctor ditto] . - op _/\_ : FOForm? FOForm -> FOForm [ctor ditto] . op _\/_ : ConstDisj? ConstDisj -> ConstDisj [ctor assoc comm id: mtForm prec 51] . op _\/_ : PosEqDisj? PosEqDisj -> PosEqDisj [ctor ditto] . op _\/_ : NegEqDisj? NegEqDisj -> NegEqDisj [ctor ditto] . @@ -131,8 +126,6 @@ fmod FOFORM is op _\/_ : NegEqQFForm? NegEqQFForm -> NegEqQFForm [ctor ditto] . op _\/_ : EqQFForm? EqQFForm -> EqQFForm [ctor ditto] . op _\/_ : QFForm? QFForm -> QFForm [ctor ditto] . - op _\/_ : AEQForm? AEQForm -> AEQForm [ctor ditto] . - op _\/_ : FOForm? FOForm -> FOForm [ctor ditto] . --- Possibly Empty Conjunctions/Disjunctions (Sets) op _/\_ : PosEqConj? PosEqConj? -> PosEqConj? [ctor ditto] . op _/\_ : NegEqConj? NegEqConj? -> NegEqConj? [ctor ditto] . @@ -146,8 +139,6 @@ fmod FOFORM is op _/\_ : NegEqQFForm? NegEqQFForm? -> NegEqQFForm? [ctor ditto] . op _/\_ : EqQFForm? EqQFForm? -> EqQFForm? [ctor ditto] . op _/\_ : QFForm? QFForm? -> QFForm? [ctor ditto] . - op _/\_ : AEQForm? AEQForm? -> AEQForm? [ctor ditto] . - op _/\_ : FOForm? FOForm? -> FOForm? [ctor ditto] . op _\/_ : EmptyForm EmptyForm -> EmptyForm [ctor ditto] . op _\/_ : ConstDisj? ConstDisj? -> ConstDisj? [ctor ditto] . op _\/_ : PosEqDisj? PosEqDisj? -> PosEqDisj? [ctor ditto] . @@ -160,51 +151,74 @@ fmod FOFORM is op _\/_ : NegEqQFForm? NegEqQFForm? -> NegEqQFForm? [ctor ditto] . op _\/_ : EqQFForm? EqQFForm? -> EqQFForm? [ctor ditto] . op _\/_ : QFForm? QFForm? -> QFForm? [ctor ditto] . - op _\/_ : AEQForm? AEQForm? -> AEQForm? [ctor ditto] . - op _\/_ : FOForm? FOForm? -> FOForm? [ctor ditto] . - --- Negations and Quantifiers - op ~_ : QFForm -> QFForm [ctor prec 49] . - op ~_ : AEQForm -> AEQForm [ctor ditto] . - op ~_ : FOForm -> FOForm [ctor ditto] . - op A[_]_ : NeQidSet QFForm -> AEQForm [ctor prec 52] . - op E[_]_ : NeQidSet QFForm -> AEQForm [ctor prec 52] . + --- Negations + op ~_ : QFForm -> QFForm [ctor prec 49] . +endfm + +fmod FOFORM is + pr QFFOFORM . + + sorts AEQForm FOForm AEQForm? FOForm? . + --------------------------------------- + subsort FOForm < FOForm? . + subsort AEQForm < AEQForm? . + + subsorts QFForm AEQForm < FOForm . + subsorts EmptyForm < QFForm? AEQForm? < FOForm? . + + op A[_]_ : NeQidSet QFForm -> AEQForm [ctor prec 52] . + op E[_]_ : NeQidSet QFForm -> AEQForm [ctor prec 52] . op A[_]_ : NeQidSet AEQForm -> AEQForm [ctor ditto] . op E[_]_ : NeQidSet AEQForm -> AEQForm [ctor ditto] . - op A[_]_ : NeQidSet FOForm -> FOForm [ctor ditto] . - op E[_]_ : NeQidSet FOForm -> FOForm [ctor ditto] . - op A[_]_ : QidSet QFForm -> AEQForm [ditto] . - op E[_]_ : QidSet QFForm -> AEQForm [ditto] . - op A[_]_ : QidSet AEQForm -> AEQForm [ditto] . - op E[_]_ : QidSet AEQForm -> AEQForm [ditto] . - op A[_]_ : QidSet FOForm -> FOForm [ditto] . - op E[_]_ : QidSet FOForm -> FOForm [ditto] . - --- Error Terms - op error : String -> [FOForm] [ctor] . - --- Remove useless quantifiers + op A[_]_ : NeQidSet FOForm -> FOForm [ctor ditto] . + op E[_]_ : NeQidSet FOForm -> FOForm [ctor ditto] . + op A[_]_ : QidSet QFForm -> AEQForm [ditto] . + op E[_]_ : QidSet QFForm -> AEQForm [ditto] . + op A[_]_ : QidSet AEQForm -> AEQForm [ditto] . + op E[_]_ : QidSet AEQForm -> AEQForm [ditto] . + op A[_]_ : QidSet FOForm -> FOForm [ditto] . + op E[_]_ : QidSet FOForm -> FOForm [ditto] . + -------------------------------------------------- eq A[none] F:AEQForm = F:AEQForm . eq E[none] F:AEQForm = F:AEQForm . + + --- Negations and Quantifiers + op ~_ : AEQForm -> AEQForm [ctor ditto] . + op ~_ : FOForm -> FOForm [ctor ditto] . + --- Non-empty Conjunctions/Disjunctions (NeSets) + op _/\_ : AEQForm? AEQForm -> AEQForm [ctor ditto] . + op _/\_ : FOForm? FOForm -> FOForm [ctor ditto] . + op _\/_ : AEQForm? AEQForm -> AEQForm [ctor ditto] . + op _\/_ : FOForm? FOForm -> FOForm [ctor ditto] . + --- Possibly Empty Conjunctions/Disjunctions (Sets) + op _/\_ : AEQForm? AEQForm? -> AEQForm? [ctor ditto] . + op _/\_ : FOForm? FOForm? -> FOForm? [ctor ditto] . + op _\/_ : AEQForm? AEQForm? -> AEQForm? [ctor ditto] . + op _\/_ : FOForm? FOForm? -> FOForm? [ctor ditto] . + --- Error Terms + op error : String -> [FOForm] [ctor] . endfm -fmod FOFORMSET is - pr FOFORM . +fmod QFFOFORMSET is + pr QFFOFORM . sort FormEmptySet . - sort TruthAtomSet PosEqAtomSet NegEqAtomSet Truth+PosEqAtomSet Truth+NegEqAtomSet EqAtomSet AtomSet . + sort TruthLitSet PosEqLitSet NegEqLitSet Truth+PosEqLitSet Truth+NegEqLitSet EqLitSet LitSet . sort ConstConjSet PosEqConjSet NegEqConjSet EqConjSet PosConjSet NegConjSet ConjSet . sort ConstDisjSet PosEqDisjSet NegEqDisjSet EqDisjSet PosDisjSet NegDisjSet DisjSet . sort PosEqQFFormSet NegEqQFFormSet EqQFFormSet QFFormSet AEQFormSet FOFormSet . - sort EmptyFormSet PosEqAtom?Set NegEqAtom?Set TruthAtom?Set Truth+NegEqAtom?Set Truth+PosEqAtom?Set EqAtom?Set Atom?Set . + sort EmptyFormSet PosEqLit?Set NegEqLit?Set TruthLit?Set Truth+NegEqLit?Set Truth+PosEqLit?Set EqLit?Set Lit?Set . sort ConstConj?Set PosEqConj?Set NegEqConj?Set EqConj?Set PosConj?Set NegConj?Set Conj?Set . sort ConstDisj?Set PosEqDisj?Set NegEqDisj?Set EqDisj?Set PosDisj?Set NegDisj?Set Disj?Set . - sort PosEqQFForm?Set NegEqQFForm?Set EqQFForm?Set QFForm?Set AEQForm?Set FOForm?Set . + sort PosEqQFForm?Set NegEqQFForm?Set EqQFForm?Set QFForm?Set . --- Subsorting subsort EmptyForm < EmptyFormSet . - subsort TruthAtom < TruthAtomSet . subsort TruthAtom? < TruthAtom?Set . - subsort PosEqAtom < PosEqAtomSet . subsort PosEqAtom? < PosEqAtom?Set . - subsort NegEqAtom < NegEqAtomSet . subsort NegEqAtom? < NegEqAtom?Set . - subsort Truth+PosEqAtom < Truth+PosEqAtomSet . subsort Truth+PosEqAtom? < Truth+PosEqAtom?Set . - subsort Truth+NegEqAtom < Truth+NegEqAtomSet . subsort Truth+NegEqAtom? < Truth+NegEqAtom?Set . - subsort EqAtom < EqAtomSet . subsort EqAtom? < EqAtom?Set . - subsort Atom < AtomSet . subsort Atom? < Atom?Set . + subsort TruthLit < TruthLitSet . subsort TruthLit? < TruthLit?Set . + subsort PosEqLit < PosEqLitSet . subsort PosEqLit? < PosEqLit?Set . + subsort NegEqLit < NegEqLitSet . subsort NegEqLit? < NegEqLit?Set . + subsort Truth+PosEqLit < Truth+PosEqLitSet . subsort Truth+PosEqLit? < Truth+PosEqLit?Set . + subsort Truth+NegEqLit < Truth+NegEqLitSet . subsort Truth+NegEqLit? < Truth+NegEqLit?Set . + subsort EqLit < EqLitSet . subsort EqLit? < EqLit?Set . + subsort Lit < LitSet . subsort Lit? < Lit?Set . subsort ConstConj < ConstConjSet . subsort ConstConj? < ConstConj?Set . subsort PosEqConj < PosEqConjSet . subsort PosEqConj? < PosEqConj?Set . subsort NegEqConj < NegEqConjSet . subsort NegEqConj? < NegEqConj?Set . @@ -223,77 +237,72 @@ fmod FOFORMSET is subsort NegEqQFForm < NegEqQFFormSet . subsort NegEqQFForm? < NegEqQFForm?Set . subsort EqQFForm < EqQFFormSet . subsort EqQFForm? < EqQFForm?Set . subsort QFForm < QFFormSet . subsort QFForm? < QFForm?Set . - subsort AEQForm < AEQFormSet . subsort AEQForm? < AEQForm?Set . - subsort FOForm < FOFormSet . subsort FOForm? < FOForm?Set . - --- Atoms Sets - subsort FormEmptySet < PosEqAtomSet NegEqAtomSet < EqAtomSet < AtomSet . - subsort FormEmptySet < TruthAtomSet PosEqAtomSet < Truth+PosEqAtomSet < AtomSet . - subsort FormEmptySet < TruthAtomSet NegEqAtomSet < Truth+NegEqAtomSet < AtomSet . - --- Non-Atom Sets - subsort PosEqConjSet PosEqDisjSet < PosEqQFFormSet < EqQFFormSet . - subsort NegEqConjSet NegEqDisjSet < NegEqQFFormSet < EqQFFormSet . - subsort EqConjSet EqDisjSet EqAtomSet < EqQFFormSet < QFFormSet . - subsort AtomSet < ConjSet DisjSet < QFFormSet < FOFormSet . - subsort FormEmptySet < AEQFormSet < FOFormSet . + --- Lits Sets + subsort FormEmptySet < PosEqLitSet NegEqLitSet < EqLitSet < LitSet . + subsort FormEmptySet < TruthLitSet PosEqLitSet < Truth+PosEqLitSet < LitSet . + subsort FormEmptySet < TruthLitSet NegEqLitSet < Truth+NegEqLitSet < LitSet . + --- Non-Lit Sets + subsort PosEqConjSet PosEqDisjSet < PosEqQFFormSet < EqQFFormSet . + subsort NegEqConjSet NegEqDisjSet < NegEqQFFormSet < EqQFFormSet . + subsort EqConjSet EqDisjSet EqLitSet < EqQFFormSet < QFFormSet . + subsort LitSet < ConjSet DisjSet < QFFormSet . --- Conjunctions/Disjunctions Sets - subsort PosEqAtomSet < PosEqConjSet < PosConjSet . - subsort NegEqAtomSet < NegEqConjSet < NegConjSet . - subsort PosEqAtomSet < PosEqDisjSet < PosDisjSet . - subsort NegEqAtomSet < NegEqDisjSet < NegDisjSet . - subsort PosEqConjSet NegEqConjSet EqAtomSet < EqConjSet < ConjSet . - subsort PosEqDisjSet NegEqDisjSet EqAtomSet < EqDisjSet < DisjSet . - subsort TruthAtomSet < ConstConjSet < PosConjSet NegConjSet < ConjSet . - subsort TruthAtomSet < ConstDisjSet < PosDisjSet NegDisjSet < DisjSet . - subsort Truth+PosEqAtomSet < PosConjSet PosDisjSet . - subsort Truth+NegEqAtomSet < NegConjSet NegDisjSet . + subsort PosEqLitSet < PosEqConjSet < PosConjSet . + subsort NegEqLitSet < NegEqConjSet < NegConjSet . + subsort PosEqLitSet < PosEqDisjSet < PosDisjSet . + subsort NegEqLitSet < NegEqDisjSet < NegDisjSet . + subsort PosEqConjSet NegEqConjSet EqLitSet < EqConjSet < ConjSet . + subsort PosEqDisjSet NegEqDisjSet EqLitSet < EqDisjSet < DisjSet . + subsort TruthLitSet < ConstConjSet < PosConjSet NegConjSet < ConjSet . + subsort TruthLitSet < ConstDisjSet < PosDisjSet NegDisjSet < DisjSet . + subsort Truth+PosEqLitSet < PosConjSet PosDisjSet . + subsort Truth+NegEqLitSet < NegConjSet NegDisjSet . --- Link Non-Empty/Possibly Empty Forms - subsort TruthAtomSet < TruthAtom?Set . subsort PosEqAtomSet < PosEqAtom?Set . - subsort NegEqAtomSet < NegEqAtom?Set . subsort EqAtomSet < EqAtom?Set . - subsort Truth+PosEqAtomSet < Truth+PosEqAtom?Set . subsort Truth+NegEqAtomSet < Truth+NegEqAtom?Set . - subsort AtomSet < Atom?Set . subsort NegEqConjSet < NegEqConj?Set . + subsort TruthLitSet < TruthLit?Set . subsort PosEqLitSet < PosEqLit?Set . + subsort NegEqLitSet < NegEqLit?Set . subsort EqLitSet < EqLit?Set . + subsort Truth+PosEqLitSet < Truth+PosEqLit?Set . subsort Truth+NegEqLitSet < Truth+NegEqLit?Set . + subsort LitSet < Lit?Set . subsort NegEqConjSet < NegEqConj?Set . subsort PosEqConjSet < PosEqConj?Set . subsort EqConjSet < EqConj?Set . subsort ConstConjSet < ConstConj?Set . subsort ConjSet < Conj?Set . subsort PosConjSet < PosConj?Set . subsort PosEqDisjSet < PosEqDisj?Set . subsort NegConjSet < NegConj?Set . subsort NegEqDisjSet < NegEqDisj?Set . subsort ConstDisjSet < ConstDisj?Set . subsort EqDisjSet < EqDisj?Set . subsort PosDisjSet < PosDisj?Set . subsort DisjSet < Disj?Set . - subsort NegDisjSet < NegDisj?Set . subsort AEQFormSet < AEQForm?Set . + subsort NegDisjSet < NegDisj?Set . subsort PosEqQFFormSet < PosEqQFForm?Set . subsort NegEqQFFormSet < NegEqQFForm?Set . subsort EqQFFormSet < EqQFForm?Set . subsort QFFormSet < QFForm?Set . - subsort FOFormSet < FOForm?Set . - --- Possibly Empty Atoms Sets + --- Possibly Empty Lits Sets subsort FormEmptySet < EmptyFormSet . - subsort EmptyFormSet < PosEqAtom?Set NegEqAtom?Set < EqAtom?Set < Atom?Set . - subsort EmptyFormSet < TruthAtom?Set PosEqAtom?Set < Truth+PosEqAtom?Set < Atom?Set . - subsort EmptyFormSet < TruthAtom?Set NegEqAtom?Set < Truth+NegEqAtom?Set < Atom?Set . - --- Possibly Empty Non-Atom Sets - subsort PosEqConj?Set PosEqDisj?Set < PosEqQFForm?Set < EqQFForm?Set . - subsort NegEqConj?Set NegEqDisj?Set < NegEqQFForm?Set < EqQFForm?Set . - subsort EqConj?Set EqDisj?Set EqAtom?Set < EqQFForm?Set < QFForm?Set . - subsort Atom?Set < Conj?Set Disj?Set < QFForm?Set < FOForm?Set . - subsort EmptyFormSet < AEQForm?Set < FOForm?Set . + subsort EmptyFormSet < PosEqLit?Set NegEqLit?Set < EqLit?Set < Lit?Set . + subsort EmptyFormSet < TruthLit?Set PosEqLit?Set < Truth+PosEqLit?Set < Lit?Set . + subsort EmptyFormSet < TruthLit?Set NegEqLit?Set < Truth+NegEqLit?Set < Lit?Set . + --- Possibly Empty Non-Lit Sets + subsort PosEqConj?Set PosEqDisj?Set < PosEqQFForm?Set < EqQFForm?Set . + subsort NegEqConj?Set NegEqDisj?Set < NegEqQFForm?Set < EqQFForm?Set . + subsort EqConj?Set EqDisj?Set EqLit?Set < EqQFForm?Set < QFForm?Set . + subsort Lit?Set < Conj?Set Disj?Set < QFForm?Set . --- Possibly Empty Conjunctions/Disjunctions - subsort EmptyFormSet < PosEqAtom?Set < PosEqConj?Set < PosConj?Set . - subsort EmptyFormSet < NegEqAtom?Set < NegEqConj?Set < NegConj?Set . - subsort EmptyFormSet < PosEqAtom?Set < PosEqDisj?Set < PosDisj?Set . - subsort EmptyFormSet < NegEqAtom?Set < NegEqDisj?Set < NegDisj?Set . - subsort EmptyFormSet < PosEqConj?Set NegEqConj?Set EqAtom?Set < EqConj?Set < Conj?Set . - subsort EmptyFormSet < PosEqDisj?Set NegEqDisj?Set EqAtom?Set < EqDisj?Set < Disj?Set . - subsort EmptyFormSet < TruthAtom?Set < ConstConj?Set < PosConj?Set NegConj?Set < Conj?Set . - subsort EmptyFormSet < TruthAtom?Set < ConstDisj?Set < PosDisj?Set NegDisj?Set < Disj?Set . - subsort EmptyFormSet < Truth+PosEqAtom?Set < PosConj?Set PosDisj?Set . - subsort EmptyFormSet < Truth+NegEqAtom?Set < NegConj?Set NegDisj?Set . + subsort EmptyFormSet < PosEqLit?Set < PosEqConj?Set < PosConj?Set . + subsort EmptyFormSet < NegEqLit?Set < NegEqConj?Set < NegConj?Set . + subsort EmptyFormSet < PosEqLit?Set < PosEqDisj?Set < PosDisj?Set . + subsort EmptyFormSet < NegEqLit?Set < NegEqDisj?Set < NegDisj?Set . + subsort EmptyFormSet < PosEqConj?Set NegEqConj?Set EqLit?Set < EqConj?Set < Conj?Set . + subsort EmptyFormSet < PosEqDisj?Set NegEqDisj?Set EqLit?Set < EqDisj?Set < Disj?Set . + subsort EmptyFormSet < TruthLit?Set < ConstConj?Set < PosConj?Set NegConj?Set < Conj?Set . + subsort EmptyFormSet < TruthLit?Set < ConstDisj?Set < PosDisj?Set NegDisj?Set < Disj?Set . + subsort EmptyFormSet < Truth+PosEqLit?Set < PosConj?Set PosDisj?Set . + subsort EmptyFormSet < Truth+NegEqLit?Set < NegConj?Set NegDisj?Set . --- Empty [Formula Sets] op mtFormSet : -> FormEmptySet [ctor] . op _|_ : FormEmptySet FormEmptySet -> FormEmptySet [ctor assoc comm id: mtFormSet prec 53] . --- [Non-Empty Formula] Sets - op _|_ : PosEqAtomSet PosEqAtomSet -> PosEqAtomSet [ctor ditto] . - op _|_ : NegEqAtomSet NegEqAtomSet -> NegEqAtomSet [ctor ditto] . - op _|_ : TruthAtomSet TruthAtomSet -> TruthAtomSet [ctor ditto] . - op _|_ : Truth+PosEqAtomSet Truth+PosEqAtomSet -> Truth+PosEqAtomSet [ctor ditto] . - op _|_ : Truth+NegEqAtomSet Truth+NegEqAtomSet -> Truth+NegEqAtomSet [ctor ditto] . - op _|_ : EqAtomSet EqAtomSet -> EqAtomSet [ctor ditto] . - op _|_ : AtomSet AtomSet -> AtomSet [ctor ditto] . + op _|_ : PosEqLitSet PosEqLitSet -> PosEqLitSet [ctor ditto] . + op _|_ : NegEqLitSet NegEqLitSet -> NegEqLitSet [ctor ditto] . + op _|_ : TruthLitSet TruthLitSet -> TruthLitSet [ctor ditto] . + op _|_ : Truth+PosEqLitSet Truth+PosEqLitSet -> Truth+PosEqLitSet [ctor ditto] . + op _|_ : Truth+NegEqLitSet Truth+NegEqLitSet -> Truth+NegEqLitSet [ctor ditto] . + op _|_ : EqLitSet EqLitSet -> EqLitSet [ctor ditto] . + op _|_ : LitSet LitSet -> LitSet [ctor ditto] . op _|_ : ConstConjSet ConstConjSet -> ConstConjSet [ctor ditto] . op _|_ : PosEqConjSet PosEqConjSet -> PosEqConjSet [ctor ditto] . op _|_ : NegEqConjSet NegEqConjSet -> NegEqConjSet [ctor ditto] . @@ -312,17 +321,15 @@ fmod FOFORMSET is op _|_ : PosEqQFFormSet PosEqQFFormSet -> PosEqQFFormSet [ctor ditto] . op _|_ : EqQFFormSet EqQFFormSet -> EqQFFormSet [ctor ditto] . op _|_ : QFFormSet QFFormSet -> QFFormSet [ctor ditto] . - op _|_ : AEQFormSet AEQFormSet -> AEQFormSet [ctor ditto] . - op _|_ : FOFormSet FOFormSet -> FOFormSet [ctor ditto] . --- [Possibly Empty Formula] Sets op _|_ : EmptyFormSet EmptyFormSet -> EmptyFormSet [ctor ditto] . - op _|_ : PosEqAtom?Set PosEqAtom?Set -> PosEqAtom?Set [ctor ditto] . - op _|_ : NegEqAtom?Set NegEqAtom?Set -> NegEqAtom?Set [ctor ditto] . - op _|_ : TruthAtom?Set TruthAtom?Set -> TruthAtom?Set [ctor ditto] . - op _|_ : Truth+PosEqAtom?Set Truth+PosEqAtom?Set -> Truth+PosEqAtom?Set [ctor ditto] . - op _|_ : Truth+NegEqAtom?Set Truth+NegEqAtom?Set -> Truth+NegEqAtom?Set [ctor ditto] . - op _|_ : EqAtom?Set EqAtom?Set -> EqAtom?Set [ctor ditto] . - op _|_ : Atom?Set Atom?Set -> Atom?Set [ctor ditto] . + op _|_ : PosEqLit?Set PosEqLit?Set -> PosEqLit?Set [ctor ditto] . + op _|_ : NegEqLit?Set NegEqLit?Set -> NegEqLit?Set [ctor ditto] . + op _|_ : TruthLit?Set TruthLit?Set -> TruthLit?Set [ctor ditto] . + op _|_ : Truth+PosEqLit?Set Truth+PosEqLit?Set -> Truth+PosEqLit?Set [ctor ditto] . + op _|_ : Truth+NegEqLit?Set Truth+NegEqLit?Set -> Truth+NegEqLit?Set [ctor ditto] . + op _|_ : EqLit?Set EqLit?Set -> EqLit?Set [ctor ditto] . + op _|_ : Lit?Set Lit?Set -> Lit?Set [ctor ditto] . op _|_ : ConstConj?Set ConstConj?Set -> ConstConj?Set [ctor ditto] . op _|_ : PosEqConj?Set PosEqConj?Set -> PosEqConj?Set [ctor ditto] . op _|_ : NegEqConj?Set NegEqConj?Set -> NegEqConj?Set [ctor ditto] . @@ -341,29 +348,105 @@ fmod FOFORMSET is op _|_ : PosEqQFForm?Set PosEqQFForm?Set -> PosEqQFForm?Set [ctor ditto] . op _|_ : EqQFForm?Set EqQFForm?Set -> EqQFForm?Set [ctor ditto] . op _|_ : QFForm?Set QFForm?Set -> QFForm?Set [ctor ditto] . - op _|_ : AEQForm?Set AEQForm?Set -> AEQForm?Set [ctor ditto] . - op _|_ : FOForm?Set FOForm?Set -> FOForm?Set [ctor ditto] . +endfm + +fmod FOFORMSET is + pr FOFORM . + pr QFFOFORMSET . + + sorts AEQForm?Set FOForm?Set . + ------------------------------ + subsorts AEQForm < AEQFormSet . subsort AEQForm? < AEQForm?Set . + subsorts FOForm < FOFormSet . subsort FOForm? < FOForm?Set . + + subsort QFFormSet < FOFormSet . + subsort QFForm?Set < FOForm?Set . + + subsorts FormEmptySet < AEQFormSet < FOFormSet . + subsorts EmptyFormSet < AEQForm?Set < FOForm?Set . + subsort AEQFormSet < AEQForm?Set . + subsort FOFormSet < FOForm?Set . + + op _|_ : AEQForm?Set AEQForm?Set -> AEQForm?Set [ctor ditto] . + op _|_ : FOForm?Set FOForm?Set -> FOForm?Set [ctor ditto] . + op _|_ : AEQFormSet AEQFormSet -> AEQFormSet [ctor ditto] . + op _|_ : FOFormSet FOFormSet -> FOFormSet [ctor ditto] . +endfm + +fmod FOFORMBASICLIST is + pr FOFORM . + sort FormEmptyList . + sort QFForm?List FOForm?List . + subsort FormEmptyList QFForm? < QFForm?List . + subsort FormEmptyList FOForm? < FOForm?List . + subsort QFForm?List < FOForm?List . + op nilFormList : -> FormEmptyList [ctor] . + op _;_ : FormEmptyList FormEmptyList -> FormEmptyList [ctor assoc id: nilFormList] . + op _;_ : FOForm?List FOForm?List -> FOForm?List [ctor ditto] . + op _;_ : QFForm?List QFForm?List -> QFForm?List [ctor ditto] . +endfm + +fmod FOFORM-CONVERSION is + pr FOFORMSET . + pr FOFORMBASICLIST . + op set2list : FOForm?Set -> FOForm?List . + op list2set : FOForm?List -> FOForm?Set . + var F : FOForm? . var FS : FOForm?Set . var FL : FOForm?List . + eq set2list(F | FS) = F ; set2list(FS) . + eq set2list(mtFormSet) = nilFormList . + eq list2set(F ; FL) = F | list2set(FL) . + eq list2set(nilFormList) = mtFormSet . +endfm + +fmod QFFOFORM-DEFINEDOPS is + pr QFFOFORM . + op _=>_ : QFForm QFForm -> QFForm [ctor] . + op _<=>_ : QFForm QFForm -> QFForm [ctor] . + var F1 F2 : QFForm . + eq F1 => F2 = (~ F1) \/ F2 . + eq F1 <=> F2 = (F1 => F2) /\ (F2 => F1) . endfm fmod FOFORM-DEFINEDOPS is + pr QFFOFORM-DEFINEDOPS . pr FOFORM . - op _=>_ : FOForm FOForm -> FOForm . - op _<=>_ : FOForm FOForm -> FOForm . + op _=>_ : FOForm FOForm -> FOForm [ctor ditto] . + op _<=>_ : FOForm FOForm -> FOForm [ctor ditto] . var F1 F2 : FOForm . eq F1 => F2 = (~ F1) \/ F2 . eq F1 <=> F2 = (F1 => F2) /\ (F2 => F1) . endfm -fmod FOFORMSIMPLIFY-IMPL is +fmod FOFORMSIMPLIFY-IMP-IMPL is pr FOFORM . - var C : Conj . var D : Disj . vars F F' : FOForm . vars T T' : Term . + var F G H K : FOForm . var K? : FOForm? . + var C : Conj . var D : Disj . var T T' : Term . + + --- Repeated Subformula + eq F /\ F = F . + eq F \/ F = F . + + --- Implication + eq (~ (F /\ G)) \/ F = tt . + eq (~ F ) \/ ((F \/ K?) /\ H) = (~ F) \/ H . + eq (~ (F /\ G)) \/ ((F \/ K?) /\ H) = (~ G) \/ H . + + --- Break up implication into clauses + eq (~ (F /\ (G \/ H)) ) \/ K = ((~ (F /\ G)) \/ K) /\ ((~ (F /\ H)) \/ K) . +endfm + +fmod QFFOFORMSIMPLIFY-IMPL is + pr QFFOFORM . + var F G H K : QFForm . var K? : QFForm? . + var C : Conj . var D : Disj . var T T' : Term . + --- Repeated subformula in Conj/Disj eq F /\ F = F . eq F \/ F = F . - --- Negated TruthAtom + --- Negated TruthLit eq ~ tt = ff . eq ~ ff = tt . - --- TruthAtom in Conj/Disj + --- TruthLit in Conj/Disj eq ff /\ C = ff . eq tt /\ C = C . eq tt \/ D = tt . @@ -371,115 +454,147 @@ fmod FOFORMSIMPLIFY-IMPL is --- Negated Formula eq F \/ ~ F = tt . eq F /\ ~ F = ff . - --- De Morgan's Laws - eq ~(F /\ F') = ~ F \/ ~ F' . - eq ~(F \/ F') = ~ F /\ ~ F' . - --- Negated Equality/Disequality - eq ~(T ?= T') = T != T' . - eq ~(T != T') = T ?= T' . + + --- eq T ?= T' /\ T != T' /\ C = ff . + --- eq T ?= T' \/ T != T' \/ D = tt . + eq (T ?= T' /\ T != T') = ff . + eq (T ?= T' \/ T != T') = tt . + --- Trivial Equality/Disequality eq T ?= T = tt . eq T != T = ff . endfm +fmod FOFORMSIMPLIFY-IMPL is + pr QFFOFORMSIMPLIFY-IMPL . + pr FOFORM . +endfm + +fmod QFFOFORMSIMPLIFY is + pr QFFOFORM . + pr REFLECT . + op simplify : QFForm -> QFForm . + var F : QFForm . + eq simplify(F) = downTerm(redReflect('QFFOFORMSIMPLIFY-IMPL,upTerm(F)),F) . +endfm + fmod FOFORMSIMPLIFY is pr FOFORM . pr REFLECT . op simplify : FOForm -> FOForm . var F : FOForm . - eq simplify(F) = downTerm(redReflect('FOFORMSIMPLIFY-IMPL,upTerm(F)),error("FOForm Simplify Failed")) . + eq simplify(F) = downTerm(redReflect('FOFORMSIMPLIFY-IMPL,upTerm(F)),F) . endfm fmod FOFORMREDUCE-IMPL is - pr FOFORM . - pr UNIT . - op reduce : Module FOForm? -> FOForm? . - op reduce : Module FOForm -> FOForm . - op reduceL : Module EqAtom ~> EqAtom . - op reduceL : Bool Term Term ~> EqAtom . - var F : FOForm . var F? : FOForm? . var E : EqAtom . var T T' : Term . var M : Module . - var L : Atom . var Q : NeQidSet . var B : Bool . var TK TK' : [Term] . - eq reduce(M,E /\ F?) = reduceL(M,E) /\ reduce(M,F?) . - eq reduce(M,E \/ F?) = reduceL(M,E) \/ reduce(M,F?) . - eq reduce(M,L /\ F?) = L /\ reduce(M,F?) [owise] . - eq reduce(M,L \/ F?) = L \/ reduce(M,F?) [owise] . - eq reduce(M,mtForm) = mtForm . - eq reduce(M,A[Q] F) = A[Q] reduce(M,F) . - eq reduce(M,E[Q] F) = E[Q] reduce(M,F) . - eq reduce(M,~ F) = ~ reduce(M,F) . - eq reduceL(M,T ?= T') = reduceL(true, getTerm(metaReduce(M,T)),getTerm(metaReduce(M,T'))) . - eq reduceL(M,T != T') = reduceL(false,getTerm(metaReduce(M,T)),getTerm(metaReduce(M,T'))) . - eq reduceL(true,T,T') = T ?= T' . - eq reduceL(false,T,T') = T != T' . + pr FOFORM . --- + pr TERM-EXTRA . --- vars() function + op red : Module Bool FOForm? ~> FOForm? . + op red : Module Bool FOForm ~> FOForm . + op red : Module Bool EqLit ~> Lit . + op redL : Module Lit Lit Term Term ~> Lit . + op noteq : Module Term Term -> Bool . + var F F' : FOForm . var T T' : Term . var M : Module . var E : EqLit . + var Q : NeQidSet . var AT AF : TruthLit . var B : Bool . + eq red(M,B,F /\ F') = red(M,B,F) /\ red(M,B,F') . + eq red(M,B,F \/ F') = red(M,B,F) \/ red(M,B,F') . + eq red(M,B,mtForm) = mtForm . + eq red(M,B,A[Q] F) = A[Q] red(M,B,F) . + eq red(M,B,E[Q] F) = E[Q] red(M,B,F) . + eq red(M,B,~ F) = ~ red(M,B,F) . + eq red(M,B,AT) = AT . + eq red(M,B,T ?= T') = if B + then redL(M,tt,ff,getTerm(metaReduce(M,T)),getTerm(metaReduce(M,T'))) + else getTerm(metaReduce(M,T)) ?= getTerm(metaReduce(M,T')) + fi . + eq red(M,B,T != T') = if B + then redL(M,ff,tt,getTerm(metaReduce(M,T)),getTerm(metaReduce(M,T'))) + else getTerm(metaReduce(M,T)) != getTerm(metaReduce(M,T')) + fi . + --- if both sides are ground, check equality + ceq redL(M,AT,AF,T,T') = if T == T' then AT else AF fi if vars('a[T,T']) == none . + --- if one side is ground, check disequality via least sorts (if possible) + ceq redL(M,AT,AF,T,T') = AF if noteq(M,T,T') or-else noteq(M,T',T) . + --- otherwise, return simplified atom + eq redL(M,AT,AF,T,T') = if AT == tt then T ?= T' else T != T' fi [owise] . + --- INP: Module Term1 Term2 + --- PRE: Term1 and Term2 are well-defined in Module + --- OUT: true iff Term1 is ground and its least sort is greater than Term2; + --- this implies Term1 is NOT equal to Term2 + eq noteq(M,T,T') = (vars(T) == none and-then + sortLeq(M,leastSort(M,T'),leastSort(M,T)) and-then leastSort(M,T) =/= leastSort(M,T')) == true . endfm fmod FOFORMREDUCE is pr FOFORM . pr REFLECT . - op reduce : Module FOForm -> FOForm . + op reduce : Module FOForm ~> FOForm . + op reduce : Module Bool FOForm ~> FOForm . op $reduce : [FOForm] -> FOForm . - var M : Module . var F : FOForm . var S : String . var G : [FOForm] . - eq reduce(M,F) = downTerm(redReflect('FOFORMREDUCE-IMPL,'reduce[upTerm(M),upTerm(F)]),error("FOForm Reduce Failed")) . + var M : Module . var F : FOForm . var S : String . var G : [FOForm] . var B : Bool . + eq reduce(M,F) = reduce(M,true,F) . + eq reduce(M,B,F) = downTerm(redReflect('FOFORMREDUCE-IMPL,'red[upTerm(M),upTerm(B),upTerm(F)]),error("FOForm Reduce Failed")) . eq $reduce(F) = F . eq $reduce(error(S)) = error(S) . eq $reduce(G) = error("Formula IllFormed") [owise] . endfm -fmod FOFORM-OPERATIONS is - pr FOFORM . - pr EXT-TERM . --- defines vars() : Term -> QidSet - op size : FOForm? -> Nat . - op depth : FOForm? -> Nat . - op falseLit? : Conj -> Bool . - op wellFormed : Module FOForm? -> Bool . - op $wellFormed : Module FOForm? -> Bool . +fmod QFFOFORM-OPERATIONS is + pr QFFOFORM . + pr TERM-EXTRA . --- defines vars() : Term -> QidSet + op size : QFForm? -> Nat . + op depth : QFForm? -> Nat . + op wellFormed : Module QFForm? -> Bool . + op $wellFormed : Module QFForm? -> Bool . + op normalize : Module QFForm? -> QFForm? . op toUnifProb : PosConj -> UnificationProblem . op $toUnifProb : PosConj -> UnificationProblem . - op trueId : FOForm? -> FOForm . - op falseId : FOForm? -> FOForm . - op true2mt : FOForm? -> FOForm? . - op false2mt : FOForm? -> FOForm? . - op vars : FOForm? -> QidSet . - var M : Module . var F? : FOForm? . var F1 F2 : FOForm . var QS : NeQidSet . - var TA : TruthAtom . var T T' : Term . var PC : PosConj . var C : Conj . + op trueId : QFForm? -> QFForm . + op falseId : QFForm? -> QFForm . + op true2mt : QFForm? -> QFForm? . + op false2mt : QFForm? -> QFForm? . + op vars : QFForm? -> QidSet . + var M : Module . var F? : QFForm? . var F1 F2 : QFForm . var QS : NeQidSet . + var TA : TruthLit . var T T' : Term . var PC : PosConj . var C : Conj . --- get the size/depth of a formula - eq size(A[QS] F1) = s(size(F1)) . - eq size(E[QS] F1) = s(size(F1)) . eq size(F1 /\ F2) = s(size(F1) + size(F2)) . eq size(F1 \/ F2) = s(size(F1) + size(F2)) . eq size(~ F1) = s(size(F1)) . - eq size(A:Atom) = 1 . + eq size(A:Lit) = 1 . eq size(mtForm) = 0 . - eq depth(A[QS] F1) = s(depth(F1)) . - eq depth(E[QS] F1) = s(depth(F1)) . eq depth(F1 /\ F2) = s(max(depth(F1),depth(F2))) . eq depth(F1 \/ F2) = s(max(depth(F1),depth(F2))) . eq depth(~ F1) = s(depth(F1)) . - eq depth(A:Atom) = 1 . + eq depth(A:Lit) = 1 . eq depth(mtForm) = 0 . - --- INP: Module FOForm? + --- INP: Module QFForm? --- PRE: N/A - --- OUT: true iff FOForm? is a wellFormed formula over module M + --- OUT: true iff QFForm? is a wellFormed formula over module M --- non-lits ceq wellFormed(M,F?) = $wellFormed(M,F?) if wellFormed(M) . eq $wellFormed(M,F1 /\ F2) = $wellFormed(M,F1) and-then $wellFormed(M,F2) . eq $wellFormed(M,F1 \/ F2) = $wellFormed(M,F1) and-then $wellFormed(M,F2) . eq $wellFormed(M,~ F1) = $wellFormed(M,F1) . - eq $wellFormed(M,A[QS] F1) = $wellFormed(M,F1) . - eq $wellFormed(M,E[QS] F1) = $wellFormed(M,F1) . --- eq lit - eq $wellFormed(M,T ?= T') = wellFormed(M,T) and-then wellFormed(M,T') . - eq $wellFormed(M,T != T') = wellFormed(M,T) and-then wellFormed(M,T') . + eq $wellFormed(M,T ?= T') = wellFormed(M,T) and-then wellFormed(M,T') and-then sameKind(M,leastSort(M,T),leastSort(M,T')) . + eq $wellFormed(M,T != T') = wellFormed(M,T) and-then wellFormed(M,T') and-then sameKind(M,leastSort(M,T),leastSort(M,T')) . --- true/false lit or mtForm eq $wellFormed(M,TA) = true . eq $wellFormed(M,mtForm) = true . - --- INP: FOForm? + --- PRE: QFForm is well-formed in Module + --- OUT: A metanormalized formula + --- INP: QFForm? + eq normalize(M,F1 /\ F2) = normalize(M,F1) /\ normalize(M,F2) . + eq normalize(M,F1 \/ F2) = normalize(M,F1) \/ normalize(M,F2) . + eq normalize(M,~ F1) = ~ normalize(M,F1) . + eq normalize(M,T ?= T') = getTerm(metaNormalize(M,T)) ?= getTerm(metaNormalize(M,T')) . + eq normalize(M,T != T') = getTerm(metaNormalize(M,T)) != getTerm(metaNormalize(M,T')) . + eq normalize(M,TA) = TA . + eq normalize(M,mtForm) = mtForm . --- PRE: N/A - --- OUT: QidSet of all MetaVariables in the FOForm? + --- OUT: QidSet of all MetaVariables in the QFForm? eq vars(F1 /\ F2) = vars(F1) ; vars(F2) . eq vars(F1 \/ F2) = vars(F1) ; vars(F2) . - eq vars(A[QS] F1) = vars(F1) . - eq vars(E[QS] F1) = vars(F1) . eq vars(~ F1) = vars(F1) . eq vars(TA) = none . eq vars(mtForm) = none . @@ -489,15 +604,11 @@ fmod FOFORM-OPERATIONS is --- PRE: N/A --- OUT: UnificationProblem if PosConj has no ff literals; --- Otherwise, fail to reduce - ceq toUnifProb(PC) = $toUnifProb(PC) if not falseLit?(PC) . + ceq toUnifProb(PC) = $toUnifProb(PC) if not PC :: ConstConj . + eq $toUnifProb(TA /\ PC) = $toUnifProb(PC) . eq $toUnifProb((T ?= T') /\ PC) = T =? T' /\ $toUnifProb(PC) . eq $toUnifProb(T ?= T') = T =? T' . - --- INP: Conj - --- PRE: N/A - --- OUT: true iff Conj contains a false literal - eq falseLit?(ff /\ C) = true . - eq falseLit?(C) = false [owise] . - --- INP: FOForm? + --- INP: QFForm? --- PRE: N/A --- OUT: obvious from definition eq trueId (mtForm) = tt . @@ -510,6 +621,31 @@ fmod FOFORM-OPERATIONS is eq false2mt(F1) = F1 [owise] . endfm +fmod FOFORM-OPERATIONS is + pr QFFOFORM-OPERATIONS . + pr FOFORM . + + var M : Module . var F1 F2 : FOForm . var QS : NeQidSet . + + op size : FOForm? -> Nat [ditto] . + op depth : FOForm? -> Nat [ditto] . + op wellFormed : Module FOForm? -> Bool [ditto] . + op $wellFormed : Module FOForm? -> Bool [ditto] . + op normalize : Module FOForm? -> FOForm? [ditto] . + op vars : FOForm? -> QidSet [ditto] . + --------------------------------------------- + eq size(A[QS] F1) = s(size(F1)) . + eq size(E[QS] F1) = s(size(F1)) . + eq depth(A[QS] F1) = s(depth(F1)) . + eq depth(E[QS] F1) = s(depth(F1)) . + eq $wellFormed(M,A[QS] F1) = $wellFormed(M,F1) . + eq $wellFormed(M,E[QS] F1) = $wellFormed(M,F1) . + eq normalize(M,A[QS] F1) = A[QS] normalize(M,F1) . + eq normalize(M,E[QS] F1) = E[QS] normalize(M,F1) . + eq vars(A[QS] F1) = vars(F1) . + eq vars(E[QS] F1) = vars(F1) . +endfm + fmod FOFORM-QUANTIFIERS is pr META-LEVEL . pr FOFORM . @@ -553,26 +689,31 @@ endfm fmod FOFORM-TUPLES is pr FOFORM . - sort FOFormNatPair FOFormPair . - op ((_,_)) : FOForm? Nat -> FOFormNatPair [ctor] . - op ((_,_)) : FOForm? FOForm? -> FOFormPair [ctor] . + pr MODULE-LIST . + sort FOFormNatPair FOFormPair ModFOFormPair NeModListFOFormPair . + subsort ModFOFormPair < NeModListFOFormPair . + op ((_,_)) : NeModuleList FOForm? -> NeModListFOFormPair [ctor] . + op ((_,_)) : Module FOForm? -> ModFOFormPair [ctor] . + op ((_,_)) : FOForm? Nat -> FOFormNatPair [ctor] . + op ((_,_)) : FOForm? FOForm? -> FOFormPair [ctor] . + + var ML : NeModuleList . var F : FOForm? . + + op getForm : NeModListFOFormPair ~> FOForm? . + eq getForm((ML,F)) = F . endfm -fmod FOFORM-SUBSTITUTION is +fmod QFFOFORM-SUBSTITUTION is pr META-LEVEL . - pr SUBSTITUTION-HANDLING . --- from full-maude - pr FOFORM . - op _<<_ : FOForm? Substitution -> FOForm? . + pr SUBSTITUTION-HANDLING . + pr QFFOFORM . + op _<<_ : QFForm? Substitution -> QFForm? . + op toConj? : Substitution -> Conj? . --- var U V : Term . var X Y : Variable . var S : Substitution . - var F G : FOForm . var Q Q' : QidSet . var I : Qid . var N : Nat . + var F G : QFForm . var I : Qid . var N : Nat . --- base case eq F << none = F . - --- quantifiers - eq (A[X ; Q] F) << (X <- Y ; S) = (A[X ; Q] F) << S . - eq (E[X ; Q] F) << (X <- Y ; S) = (E[X ; Q] F) << S . - eq (A[Q] F) << S = A[Q] (F << S) [owise] . - eq (E[Q] F) << S = E[Q] (F << S) [owise] . --- other symbols eq (F \/ G) << S = (F << S) \/ (G << S) . eq (F /\ G) << S = (F << S) /\ (G << S) . @@ -582,19 +723,34 @@ fmod FOFORM-SUBSTITUTION is eq tt << S = tt . eq ff << S = ff . eq mtForm << S = mtForm . + + --- INP: Substitution + --- PRE: None + --- OUT: Conj? + eq toConj?(X <- U ; S) = X ?= U /\ toConj?(S) . + eq toConj?(none) = mtForm . endfm -fmod FOFORM-VARS-TO-CONSTS is +fmod FOFORM-SUBSTITUTION is + pr QFFOFORM-SUBSTITUTION . + pr FOFORM . + + var T : Term . var X Y : Variable . var S : Substitution . + var F : QFForm . var QS : QidSet . + + --- quantifiers + eq (A[X ; QS] F) << (X <- T ; S) = (A[X ; QS] F) << S . + eq (E[X ; QS] F) << (X <- T ; S) = (E[X ; QS] F) << S . + eq (A[QS] F) << S = A[QS] (F << S) [owise] . + eq (E[QS] F) << S = E[QS] (F << S) [owise] . +endfm + +fmod FOFORM-CONSTS-TO-VARS is pr VARIABLES-TO-CONSTANTS . pr FOFORM . pr FOFORM-SUBSTITUTION . - op varsToConsts : Substitution QFForm? -> QFForm? . op constsToVars : Substitution QFForm? -> QFForm? . - var S : Substitution . var F1 F2 : QFForm . var T T' : Term . - - eq varsToConsts(S,F1) = F1 << S . - --- eq constsToVars(S,mtForm) = mtForm . eq constsToVars(S,F1 /\ F2) = constsToVars(S,F1) /\ constsToVars(S,F2) . eq constsToVars(S,F1 \/ F2) = constsToVars(S,F1) \/ constsToVars(S,F2) . @@ -603,49 +759,160 @@ fmod FOFORM-VARS-TO-CONSTS is eq constsToVars(S,T != T') = constsToVars(S,T) != constsToVars(S,T') . endfm -fmod FOFORMSUBSTITUTION-PAIR is - pr FOFORM-SUBSTITUTION . - sort FOFormSubstPair . - op ((_,_)) : FOForm? Substitution -> FOFormSubstPair [ctor] . +fmod FOFORMSET-CONSTS-TO-VARS is + pr FOFORM-CONSTS-TO-VARS . + pr FOFORMSET . + op constsToVars : Substitution QFForm?Set -> QFForm?Set . + var S : Substitution . var F F' : QFForm? . var FS : QFForm?Set . + eq constsToVars(S,F | F' | FS) = constsToVars(S,F) | constsToVars(S,F' | FS) . + eq constsToVars(S,mtFormSet) = mtFormSet . endfm -fmod FOFORM-SUBSTITUTIONSET is +fmod QFFOFORMSUBSTITUTION-PAIR is + pr QFFOFORM-SUBSTITUTION . --- substitution application + pr SUBSTITUTION-AUX . --- id + pr QFFOFORM-OPERATIONS . --- vars + sort QFFormSubstPair . + op ((_,_)) : QFForm? Substitution -> QFFormSubstPair [ctor] . + op errQFFormSubstPair : QidList -> [QFFormSubstPair] [ctor] . + op errQFFormSubstPairMsg : [QFFormSubstPair] -> QidList [ctor] . + op idpair : QFForm? -> QFFormSubstPair . + op getForm : QFFormSubstPair -> QFForm? . + op getSub : QFFormSubstPair -> Substitution . + op _Pair<<_ : QFForm? Substitution -> QFFormSubstPair . + op _<<_ : QFFormSubstPair Substitution -> QFFormSubstPair . + --- + var F : QFForm? . var S S' : Substitution . + var QL : QidList . var FK : [QFFormSubstPair] . + + eq errQFFormSubstPairMsg(errQFFormSubstPair(QL)) = QL . + eq errQFFormSubstPairMsg(FK) = nil [owise] . + + eq idpair(F) = (F,idsub(vars(F))) . + --- + eq getForm((F,S)) = F . + eq getSub ((F,S)) = S . + --- + eq F Pair<< S = (F << S,S) . + eq (F,S) << S' = (F << S,S << S') . +endfm + +fmod QFFOFORM-SUBSTITUTIONSET is pr META-LEVEL . pr SUBSTITUTIONSET . --- from full-maude - pr FOFORMSET . - pr FOFORM-SUBSTITUTION . - op _<<_ : FOForm? SubstitutionSet -> FOForm?Set . + pr QFFOFORMSET . + pr QFFOFORM-SUBSTITUTION . + op _<<_ : QFForm? SubstitutionSet -> QFForm?Set . --- - var S S' : Substitution . var SS : SubstitutionSet . var F : FOForm? . + var S S' : Substitution . var SS : SubstitutionSet . var F : QFForm? . --- base case eq F << .SubstitutionSet = mtFormSet . eq F << (S | S' | SS) = (F << S) | (F << S' | SS) . endfm -fmod FOFORMSUBSTITUTION-PAIRSET is - pr FOFORMSUBSTITUTION-PAIR . - pr FOFORM-SUBSTITUTIONSET . - sort FOFormSubstPairSet . - subsort FOFormSubstPair < FOFormSubstPairSet . - op _|_ : FOFormSubstPairSet FOFormSubstPairSet -> FOFormSubstPairSet [ctor assoc comm id: mtFSPS] . - op mtFSPS : -> FOFormSubstPairSet [ctor] . - op toSet : FOFormSubstPairSet -> FOFormSet . - op build : FOForm? SubstitutionSet -> FOFormSubstPairSet . - op build-app : FOForm? SubstitutionSet -> FOFormSubstPairSet . +fmod QFFOFORMSUBSTITUTION-PAIRSET is + pr QFFOFORMSUBSTITUTION-PAIR . + pr QFFOFORM-SUBSTITUTIONSET . + sort QFFormSubstPairSet . + subsort QFFormSubstPair < QFFormSubstPairSet . + op _|_ : QFFormSubstPairSet QFFormSubstPairSet -> QFFormSubstPairSet [ctor assoc comm id: mtFSPS] . + op mtFSPS : -> QFFormSubstPairSet [ctor] . + --- + op idpair : QFForm?Set -> QFFormSubstPairSet . + op build : QFForm? SubstitutionSet -> QFFormSubstPairSet . + --- + op getForm : QFFormSubstPairSet -> QFForm?Set . + op getSub : QFFormSubstPairSet -> SubstitutionSet . --- - var F : FOForm? . var S : Substitution . var FPS : FOFormSubstPairSet . var SS : SubstitutionSet . - eq toSet((F,S) | FPS) = F | toSet(FPS) . - eq toSet(mtFSPS) = mtFormSet . - eq build(F,S | SS) = (F,S) | build(F,SS) . - eq build(F,.SubstitutionSet) = mtFSPS . - eq build-app(F,S | SS) = (F << S,S) | build-app(F,SS) . - eq build-app(F,.SubstitutionSet) = mtFSPS . + op dnf-join : QFFormSubstPairSet -> QFForm? . + op _Pair<<_ : QFForm? SubstitutionSet -> QFFormSubstPairSet . + op _<<_ : QFFormSubstPairSet SubstitutionSet -> QFFormSubstPairSet . + op idem : QFFormSubstPairSet -> QFFormSubstPairSet . + --- + var F F' : QFForm? . var FS : QFForm?Set . var C? : Conj? . var S S' : Substitution . var SS : SubstitutionSet . + var FP FP' : QFFormSubstPair . var FPS : QFFormSubstPairSet . + var QL : QidList . var FK : [QFFormSubstPair] . var SK : [Substitution] . + + eq errQFFormSubstPairMsg(errQFFormSubstPair(QL) | FK) = QL . + + eq idpair(F | F' | FS) = idpair(F) | idpair(F' | FS) . + eq idpair(mtFormSet) = mtFSPS . + + --- INP: QFForm? SubstitutionSet + --- PRE: None + --- OUT: An QFFormSubstPairSet built by pairing QFForm? with each Substitution + eq build(F,S | SS) = (F,S) | build(F,SS) . + eq build(F,.SubstitutionSet) = mtFSPS . + + --- projections + eq getForm((F,S) | FPS) = F | getForm(FPS) . + eq getForm(mtFSPS) = mtFormSet . + eq getSub((F,S) | FPS) = S | getSub(FPS) . + eq getSub(mtFSPS) = .SubstitutionSet . + + --- INP: QFFormSubstPairSet + --- PRE: Each QFForm in the argument is also a Conj? + --- OUT: A DNF? + eq dnf-join((C?,S) | FPS) = (C? /\ toConj?(S)) \/ dnf-join(FPS) . + eq dnf-join(mtFSPS) = mtForm . + + --- Substitution Functions + eq (FP | FP' | FPS) << SS = (FP << SS) | ((FP' | FPS) << SS) . + eq mtFSPS << SS = mtFSPS . + eq FPS << .SubstitutionSet = mtFSPS . + eq FP << (S | S' | SS) = (FP << S) | (FP << (S' | SS)) . + + --- Construct pairs from one side + eq F Pair<< (S | S' | SS) = (F Pair<< S) | (F Pair<< (S' | SS)) . + eq F Pair<< .SubstitutionSet = mtFSPS . + eq F Pair<< errsub(QL) | SK = errQFFormSubstPair(QL) [owise] . + + --- Apply the idempotency equation + eq idem(FP | FP | FPS) = idem(FP | FPS) . + eq idem(FPS) = FPS [owise] . + eq idem(errQFFormSubstPair(QL) | FK) = errQFFormSubstPair(QL) . +endfm + +fmod FOFORM-RENAME is + pr FOFORM . + pr RENAME-METAVARS . + op renameAllVar : Module FindResult FOForm? -> FOForm? . + op renameTmpVar : Module FindResult FOForm? -> FOForm? . + op unwrapFOForm : TermData -> FOForm? . + var U : Module . var F : FOForm? . var N : FindResult . var T : Term . + eq renameAllVar(U,N,F) = unwrapFOForm(#renameAllVar(U,N,upTerm(F))) . + eq renameTmpVar(U,N,F) = unwrapFOForm(#renameTmpVar(U,N,upTerm(F))) . + eq unwrapFOForm(termdata(T,N)) = downTerm(T,error("Rename failed")) . +endfm + +fmod FOFORMSET-RENAME is + pr FOFORMSET . + pr FOFORM-RENAME . + op renameAllVar : Module FindResult FOForm?Set -> FOForm?Set . + op renameTmpVar : Module FindResult FOForm?Set -> FOForm?Set . + op unwrapFOFormSet : TermData -> FOForm?Set . + var U : Module . var F : FOForm?Set . var N : FindResult . var T : Term . + eq renameAllVar(U,N,F) = unwrapFOFormSet(#renameAllVar(U,N,upTerm(F))) . + eq renameTmpVar(U,N,F) = unwrapFOFormSet(#renameTmpVar(U,N,upTerm(F))) . + eq unwrapFOFormSet(termdata(T,N)) = downTerm(T,error("Rename failed")) . +endfm + +fmod FOFORMBASICLIST-RENAME is + pr FOFORMBASICLIST . + pr FOFORM-RENAME . + op renameAllVar : Module FindResult FOForm?List -> FOForm?List . + op renameTmpVar : Module FindResult FOForm?List -> FOForm?List . + op unwrapFOFormList : TermData -> FOForm?List . + var U : Module . var F : FOForm?List . var N : FindResult . var T : Term . + eq renameAllVar(U,N,F) = unwrapFOFormList(#renameAllVar(U,N,upTerm(F))) . + eq renameTmpVar(U,N,F) = unwrapFOFormList(#renameTmpVar(U,N,upTerm(F))) . + eq unwrapFOFormList(termdata(T,N)) = downTerm(T,error("Rename failed")) . endfm fmod FQF-IMPL is pr FOFORM-SUBSTITUTION . pr FOFORM-TUPLES . - pr RENAME-METAVARS . + pr FOFORM-RENAME . op renameQuantifiers : Module FOForm? -> FOForm? . op $rq : FOFormNatPair -> FOForm? . op $rq : Nat FOForm? -> FOFormNatPair . @@ -659,11 +926,10 @@ fmod FQF-IMPL is var N : Nat . var S S' : QidSet . var P : QFForm? . var M : Module . --- entry point eq renameQuantifiers(M,P) = P . - eq renameQuantifiers(M,F) = - $rq($rq(0,downTerm(renameAllVar(M,upTerm(F)),error("Rename failed")))) [owise] . + eq renameQuantifiers(M,F) = $rq($rq(0,renameAllVar(M,notFound,F))) [owise] . --- dispatch handlers for different cases eq $rq((F,N)) = F . - eq $rq(N,P:QFForm?) = (P:QFForm?,N) . + eq $rq(N,P:QFForm?) = (P:QFForm?,N) . eq $rq(N,F /\ G) = $rq2('/\,$rq(N,F),G) [owise] . eq $rq(N,F \/ G) = $rq2('\/,$rq(N,F),G) [owise] . eq $rq(N,~ F) = $rq1('~ ,$rq(N,F)) [owise] . @@ -696,12 +962,12 @@ endfm fmod NNF-IMPL is pr META-LEVEL . - sort EmptyForm TrueAtom FalseAtom NNF Form . - subsort EmptyForm TrueAtom FalseAtom < NNF < Form . + sort EmptyForm TrueLit FalseLit NNF Form . + subsort EmptyForm TrueLit FalseLit < NNF < Form . --- Negation Normal Forms op mtForm : -> EmptyForm [ctor] . - op tt : -> TrueAtom [ctor] . - op ff : -> FalseAtom [ctor] . + op tt : -> TrueLit [ctor] . + op ff : -> FalseLit [ctor] . op _?=_ : Term Term -> NNF [ctor comm] . op _!=_ : Term Term -> NNF [ctor comm] . op _/\_ : NNF NNF -> NNF [ctor assoc comm prec 51] . @@ -739,12 +1005,12 @@ endfm fmod PNF-IMPL is pr META-LEVEL . - sort EmptyForm TrueAtom FalseAtom QFF EPNF APNF PNF Form . - subsort EmptyForm TrueAtom FalseAtom < QFF < PNF < Form . + sort EmptyForm TrueLit FalseLit QFF EPNF APNF PNF Form . + subsort EmptyForm TrueLit FalseLit < QFF < PNF < Form . --- Quantifier Free Formulas op mtForm : -> EmptyForm [ctor] . - op tt : -> TrueAtom [ctor] . - op ff : -> FalseAtom [ctor] . + op tt : -> TrueLit [ctor] . + op ff : -> FalseLit [ctor] . op _?=_ : Term Term -> QFF [ctor comm] . op _!=_ : Term Term -> QFF [ctor comm] . op _/\_ : QFF QFF -> QFF [ctor assoc comm prec 50] . @@ -784,12 +1050,12 @@ endfm fmod DNF-IMPL is pr META-LEVEL . - sort EmptyForm TrueAtom FalseAtom Conj DNF QDNF Form . - subsort EmptyForm TrueAtom FalseAtom < Conj < DNF < QDNF < Form . + sort EmptyForm TrueLit FalseLit Conj DNF QDNF Form . + subsort EmptyForm TrueLit FalseLit < Conj < DNF < QDNF < Form . --- Disjunctive Normal Forms op mtForm : -> EmptyForm [ctor] . - op tt : -> TrueAtom [ctor] . - op ff : -> FalseAtom [ctor] . + op tt : -> TrueLit [ctor] . + op ff : -> FalseLit [ctor] . op _?=_ : Term Term -> Conj [ctor comm] . op _!=_ : Term Term -> Conj [ctor comm] . op _/\_ : Conj Conj -> Conj [ctor assoc comm] . @@ -827,12 +1093,12 @@ endfm fmod CNF-IMPL is pr META-LEVEL . - sort EmptyForm TrueAtom FalseAtom Disj CNF QCNF Form . - subsort EmptyForm TrueAtom FalseAtom < Disj < CNF < QCNF < Form . + sort EmptyForm TrueLit FalseLit Disj CNF QCNF Form . + subsort EmptyForm TrueLit FalseLit < Disj < CNF < QCNF < Form . --- Disjunctive Normal Forms op mtForm : -> EmptyForm [ctor] . - op tt : -> TrueAtom [ctor] . - op ff : -> FalseAtom [ctor] . + op tt : -> TrueLit [ctor] . + op ff : -> FalseLit [ctor] . op _?=_ : Term Term -> Disj [ctor comm] . op _!=_ : Term Term -> Disj [ctor comm] . op _\/_ : Disj Disj -> Disj [ctor assoc comm] . @@ -868,18 +1134,28 @@ fmod CNF is eq cnf?(F) = sortReflect('CNF-IMPL,upTerm(F),'CNF) . endfm -fmod FOFORMSET-OPERATIONS is - pr FOFORMSET . +fmod QFFOFORMSET-OPERATIONS is + pr QFFOFORM-OPERATIONS . + pr QFFOFORMSET . pr CNF . pr DNF . - op disj-join : FOForm?Set -> FOForm? . - op conj-join : FOForm?Set -> FOForm? . + op disj-join : QFForm?Set -> QFForm? . + op disj-join : QFForm?Set -> QFForm? . + op conj-join : QFForm?Set -> QFForm? . + op conj-join : QFForm?Set -> QFForm? . + op toPosEqLits : PosEqQFForm -> PosEqLitSet . + op toPosEqLits : UnificationProblem -> PosEqLitSet . + op toEqSet : PosEqLitSet -> EquationSet . + op wellFormed : Module QFForm?Set -> Bool . --- op toDisjSet : QFForm? ~> DisjSet . op toDisjSet' : QFForm? ~> DisjSet . op toConjSet : QFForm? ~> ConjSet . op toConjSet' : QFForm? ~> ConjSet . - var FS : FOForm?Set . var FF : FOForm? . var F : QFForm? . var D : Disj . var C : Conj . + --- + var FS : QFForm?Set . var FF FF' : QFForm? . var F : QFForm? . var D : Disj . var UP : UnificationProblem . + var C : Conj . var PEA : PosEqLit . var PEAS : PosEqLitSet . var T T' : Term . var M : Module . + --- eq toDisjSet (F) = toDisjSet'(toCNF(F)) . eq toDisjSet'(D /\ F) = D | toDisjSet'(F) . eq toDisjSet'(mtForm) = mtFormSet . @@ -892,27 +1168,336 @@ fmod FOFORMSET-OPERATIONS is eq disj-join(mtFormSet) = ff . eq conj-join(FF | FS) = FF /\ conj-join(FS) . eq conj-join(mtFormSet) = tt . + --- + eq toPosEqLits(PEA /\ F) = PEA | toPosEqLits(F) . + eq toPosEqLits(PEA \/ F) = PEA | toPosEqLits(F) . + eq toPosEqLits(mtForm) = mtFormSet . + --- + eq toPosEqLits(T =? T' /\ UP) = T ?= T' | toPosEqLits(UP) . + eq toPosEqLits(T =? T') = T ?= T' . + --- + eq toEqSet(T ?= T' | PEAS) = (eq T = T' [none] .) toEqSet(PEAS) . + eq toEqSet(mtFormSet) = none . + --- + eq wellFormed(M,FF | FF' | FS) = wellFormed(M,FF) and-then wellFormed(M,FF' | FS) . + eq wellFormed(M,mtFormSet) = true . +endfm + +fmod FOFORM-DESCENT-MAP is + pr FOFORM . + pr UNIT-FM . + op descent-map : Module Module QFForm? -> QFForm? . + op check-map? : QFForm? ~> QFForm? . + --- + var DM RM : Module . var F : FOForm? . + --- INP: Module:DM Module:RM QFForm? + --- PRE: DM should have a function reduce : Form -> Form which returns ff in case of any error + --- Form is wellFormed w.r.t to RM + --- OUT: Use DM to descent-map Form + eq descent-map(noModule,RM,F) = F . + eq descent-map(DM,RM,F) = if F == ff then ff else + check-map?(downTerm(getTerm(metaReduce(DM,'reduce[upTerm(RM),upTerm(F)])),ff)) fi [owise] . + ceq check-map?(F) = F if F =/= ff . +endfm + +fmod FOFORM-EASY-SIMPLIFY is + pr FOFORMSIMPLIFY . + pr FOFORMREDUCE . + pr FOFORM-DESCENT-MAP . + pr NNF . + op srs : Module FOForm? -> FOForm? . + op srsd : Module Module FOForm? -> FOForm? . + var DM RM : Module . var F : FOForm? . + eq srs (RM,F) = simplify(toNNF(reduce(RM,simplify(F)))) . + eq srsd(DM,RM,F) = descent-map(DM,RM,srs(RM,F)) . +endfm + +--- NOTE: this simplification of extracting a substitution and applying it is NOT deterministic... +--- this module extracts fragments out of QFForms that look like substitutions and applies them +fmod FOFORM-EXTRACT-SUBSTITUTION is + pr QFFOFORMSUBSTITUTION-PAIRSET . + pr DNF . + pr SUBSTITUTION-HANDLING . + pr FOFORM-OPERATIONS . + pr QFFOFORMSET-OPERATIONS . + + op is-sub? : Module QFForm? -> Bool . + op #extract-subs : Module QFForm? -> QFFormSubstPairSet . + op #extract-subs : Module QFForm? QFFormSubstPairSet -> QFFormSubstPairSet . + op #extract-sub : Module Conj? -> QFFormSubstPair . + op #extract-sub : Module Conj? Conj? Substitution -> QFFormSubstPair . + op extract-sub : Module Conj? -> Conj? . + op extract-imp-sub : Module QFForm ~> QFForm . + + var Q1? Q2? : QFForm? . var Q Q' : QFForm . var C : Conj . var C1? C2? C3? : Conj? . var FS : QFFormSubstPairSet . + var V : Variable . var T : Term . var S : Substitution . var A : Lit . var U : Module . + + --- INP: QFForm? + --- PRE: + --- OUT: Check if the QFForm? is equivalent to a disjunction of substitutions (which is always satisfiable) + eq is-sub?(U,Q1?) = getForm(#extract-subs(U,Q1?)) == mtForm . + + --- INP: QFForm? + --- PRE: + --- OUT: [1] QFForm? is first converted into a DNF + --- [2] In each conjunct, substitution-like fragments are #extracted (but not applied) into a QFFormSubstPair + --- [3] We return a set of all such pairs (one for each conjunct) + eq #extract-subs (U,Q1?) = #extract-subs(U,toDNF(Q1?),mtFSPS) . + eq #extract-subs (U,mtForm,FS) = FS . + eq #extract-subs (U,C \/ Q1?,FS) = #extract-subs(U,Q1?,FS | #extract-sub(U,C)) . + + --- INP: Conj? + --- PRE: + --- OUT: An QFFormSubstPair (C'?,S?) such that C? = C'? /\ S? and S? is the substitution-like fragment (may be empty) + eq #extract-sub(U,C1?) = #extract-sub(U,C1?,mtForm,none) . + ceq #extract-sub(U,V ?= T /\ C1?,C2?,S) = #extract-sub(U,(C1? /\ C2?) << (V <- T),mtForm,S .. (V <- T)) + if sortLeq(U,leastSort(U,T),getType(V)) /\ not V in vars(T) . + eq #extract-sub(U,A /\ C1?,C2?,S) = #extract-sub(U,C1?,C2? /\ A,S) [owise] . + eq #extract-sub(U,mtForm,C2?,S) = (C2?,S) . + + + eq extract-sub(U,C1?) = getForm(#extract-sub(U,C1?)) . + + eq extract-imp-sub(U, Q \/ ~ C) = Q << getSub(#extract-sub(U,C)) \/ ~ trueId(getForm(#extract-sub(U,C))) . + eq extract-imp-sub(U,(Q \/ ~ C) /\ Q') = extract-imp-sub(U,Q \/ ~ C) /\ extract-imp-sub(U,Q') . + eq extract-imp-sub(U,Q) = Q [owise] . +endfm + +---( +fmod FOFORM-AUX is + pr MGCI . --- for ctor-term + pr SUBSTITUTIONPAIRSET . + pr QFFOFORMSUBSTITUTION-PAIR . + pr STREAM{QFFormSubstPair} . + + --- Simplify constraints by apply substitutions whenever possible + op litToNonRecBinding : Module Lit -> Substitution . + op bindingsToConj : Substitution -> PosEqConj . + op findBinding : Module QFForm -> QFFormSubstPair . + op findBindings : Module QFForm -> QFFormSubstPair . + op $findBindings : Module QFForm QFForm Substitution -> Stream{QFFormSubstPair} . + op $findBindings : Module QFForm QFForm Substitution Lit Substitution -> Stream{QFFormSubstPair} . + op recSimplifyForm : Module QFForm Substitution -> QFFormSubstPair . + op $recSimplifyForm : Module QFFormSubstPair Substitution -> QFFormSubstPair . + op simplifyForm : Module QFForm -> QFForm . + op simplifyBindings : Module Substitution -> Substitution . + op removeGround : QFForm -> QFForm . + op filterBindingsByCtor : Module Substitution -> SubstitutionPair . + op removeRedundantLits : QFForm -> QFForm . + + var F F' : QFForm . var V : Variable . + var T T' : Term . var VS : VariableSet . var M : Module . var L : Lit . + var S S' S1 S2 : Substitution . var B1 B2 : Bool . var F? F'? : QFForm? . + + --- INP: Substitution + --- PRE: None + --- OUT: A PosEqConj where each V <- T becomes V ?= T + eq bindingsToConj(V <- T ; S) = V ?= T /\ bindingsToConj(S) . + eq bindingsToConj(none) = tt . + + --- INP: Module Lit + --- PRE: Lit is well-formed + --- OUT: If Lit is of the form V ?= T or T ?= V then + --- returns a substitution V <- T if leastSort(T) < leastSort(V) and not V in vars(T) + --- otherwise returns none + eq litToNonRecBinding(M,V ?= T) = + if sortLeq(M,leastSort(M,T),leastSort(M,V)) and not V in vars(T) then V <- T else none fi . + eq litToNonRecBinding(M,L) = none [owise] . + + --- INP: Module FOForm1 + --- PRE: FOForm1 is well-formed + --- OUT: Given Form1 = F /\ B with B a substitution, returns (F,B), + --- otherwise returns (Form1,none) + eq findBinding(M,F) = pick!(0,$findBindings(M,F,mtForm,none)) . + eq findBindings(M,F) = last!($findBindings(M,F,mtForm,none)) . + eq $findBindings(M,mtForm,F',S) = (F',S) & end . + eq $findBindings(M,L /\ F?,F'?,S) = $findBindings(M,F?,F'?,S,L,litToNonRecBinding(M,L)) . + eq $findBindings(M,F?,F'?,S,L,V <- T) = (F? /\ F'?,S ; V <- T) & $findBindings(M,F?,F'?,S ; V <- T) . + eq $findBindings(M,F?,F'?,S,L,none) = $findBindings(M,F?,F'? /\ L,S) . + + --- INP: Module FOForm Substitution + --- PRE: None + --- OUT: If FOForm = F /\ B with B a non-circular binding, then performs + --- such substitutions followed by a simplification until a fixpoint + --- is reached; returns the substituted formula plus the set of bindings + --- that were generated + eq recSimplifyForm(M,F,S) = $recSimplifyForm(M,findBinding(M,F),S) . + eq $recSimplifyForm(M,(F,V <- T),S) = + if S == none then + recSimplifyForm(M,F << (V <- T),V <- T) + else + recSimplifyForm(M,F << (V <- T),(S << (V <- T)) ; V <- T) + fi . + ceq $recSimplifyForm(M,(F,none),S) = + if F == F' then (F,S') else recSimplifyForm(M,F',S') fi + if F' := removeRedundantLits(simplifyForm(M,F)) + /\ S' := simplifyBindings(M,S) . + + --- INP: Module Substitution (SubstitutionPair) + --- PRE: Substitution is well-formed with respect to module + --- OUT: Split substitution S into pair (S1,S2) where S = S1 ; S2 + --- and each V <- T in S1 has ctor-term?(M,T) holds + op $filterBindingsByCtor : Module Substitution SubstitutionPair -> SubstitutionPair . + eq filterBindingsByCtor(M,S) = $filterBindingsByCtor(M,S,(none,none)) . + eq $filterBindingsByCtor(M,V <- T ; S,(S1,S2)) = + if ctor-term?(M,T) then $filterBindingsByCtor(M,S,(S1 ; V <- T,S2)) + else $filterBindingsByCtor(M,S,(S1,S2 ; V <- T)) fi . + eq $filterBindingsByCtor(M,none,(S1,S2)) = (S1,S2) . + + --- INP: Bool VariableSet Substitution + --- PRE: None + --- OUT: Split substitution S into pair (S1,S2) where S = S1 ; S2 + --- and each V <- T in S1 has V in VariableSet holds + op filterBindingsByVars : VariableSet Substitution -> SubstitutionPair . + op $filterBindingsByVars : VariableSet Substitution SubstitutionPair -> SubstitutionPair . + eq filterBindingsByVars(VS,S) = $filterBindingsByVars(VS,S,(none,none)) . + eq $filterBindingsByVars(VS,V <- T ; S,(S1,S2)) = + if V in VS then $filterBindingsByVars(VS,S,(S1 ; V <- T,S2)) + else $filterBindingsByVars(VS,S,(S1,S2 ; V <- T)) fi . + eq $filterBindingsByVars(VS,none,(S1,S2)) = (S1,S2) . + + --- INP: Module Form + --- PRE: FOForm should be well-formed, Module should satisfy executability requirments + --- OUT: A form where all terms have been meta-reduced + eq simplifyForm(M,F /\ F') = simplifyForm(M,F) /\ simplifyForm(M,F') . + eq simplifyForm(M,T ?= T') = getTerm(metaReduce(M,T)) ?= getTerm(metaReduce(M,T')) . + eq simplifyForm(M,T != T') = getTerm(metaReduce(M,T)) != getTerm(metaReduce(M,T')) . + eq simplifyForm(M,L) = L [owise] . + + --- INP: Module Substitution + --- PRE: Substitution should be well-formed, Module should satisfy executability requirments + --- OUT: A substitution where all terms have been meta-reduced + eq simplifyBindings(M,V <- T ; S) = V <- getTerm(metaReduce(M,T)) ; simplifyBindings(M,S) . + eq simplifyBindings(M,none) = none . + + --- INP: FOForm + --- PRE: None + --- OUT: A form where redundant elements are deleted (by assoc-comm) + eq removeRedundantLits(L /\ L /\ F?) = L /\ F? . + eq removeRedundantLits(L \/ L \/ F?) = L /\ F? . + eq removeRedundantLits(F) = F [owise] . + + --- INP: FOForm + --- PRE: None + --- OUT: All literals L in FOForm that are ground are removed + eq removeGround(F /\ F') = removeGround(F) /\ removeGround(F') . + eq removeGround(F \/ F') = removeGround(F) \/ removeGround(F') . + eq removeGround(L:Lit) = if vars(L:Lit) =/= none then L:Lit else tt fi . +endfm +---) + +fmod FOFORM-PRINTER is pr FOFORM . pr GENERIC-PRINTER . + op print : Module QFForm? -> QidList . + op printImp : Module QFForm? -> QidList . + var M : Module . var F F' : QFForm . var T T' : Term . + --- print formulas + eq print(M,F /\ F') = '`( print(M,F) '/\ print(M,F') '`) . + eq print(M,F \/ F') = '`( print(M,F) '\/ print(M,F') '`) . + eq print(M,T ?= T') = print(M,T) '= print(M,T') . + eq print(M,T != T') = print(M,T) '=/= print(M,T') . + eq print(M,~ F) = '~ print(M,F) . + eq print(M,mtForm) = 'true . + eq print(M,tt) = 'true . + eq print(M,ff) = 'false . + eq print(M,F:[QFForm?]) = 'Error: 'Cannot 'Print 'Ill-formed 'Formula [owise] . + --- print formulas as implication + eq printImp(M,(~ F) \/ F') = print(M,F) &sp '=> &sp print(M,F') . +endfm + +fmod FOFORMSET-PRINTER is pr FOFORMSET . pr FOFORM-PRINTER . + op print : Module Qid QFForm?Set -> QidList . + var M : Module . var F F' : QFForm? . var FS : QFForm?Set . var Q : Qid . + --- print formula sets + eq print(M,Q,F | F | FS) = print(M,F) Q print(M,F | FS) . + eq print(M,Q,F) = print(M,F) . + eq print(M,Q,mtFormSet) = 'None . endfm --- this module defines a generic structure to represent the success/failure --- of a formula reduction --- which also includes an optional status code: --- true/false/unknown/errb --- to represent the result of the reduction fmod GENERIC-FORMULA-REDUCTION is - pr BOOL-ERR . + pr MAYBE-BOOL . pr FOFORMSET . sort QFFormSetBoolPair . - op ((_,_)) : QFForm?Set Bool? -> QFFormSetBoolPair [ctor] . + op ((_,_)) : QFForm?Set MaybeBool -> QFFormSetBoolPair [ctor] . --- op true? : QFFormSetBoolPair -> Bool . - op bool : QFFormSetBoolPair -> Bool? . + op bool : QFFormSetBoolPair -> MaybeBool . op form : QFFormSetBoolPair -> QFForm?Set . --- projections - var B : Bool? . var F : QFForm?Set . + var B : MaybeBool . var F : QFForm?Set . eq true?((F,B)) = B == true . eq form ((F,B)) = F . eq bool ((F,B)) = B . endfm +--- NOTE: implementing this kind of module REALLY should be the first +--- step in building a theorem prover, i.e. the ideal theorem +--- prover should produce a proof witness as its result that can +--- be inspected and validated +--- NOTE: implementing this here makes NO sense because this file is +--- NOT a theorem prover---we keep this only as a reference +fmod PROOF-WITNESS is + pr FOFORM . + --- Kinds of Proofs + sort SatWitness ValWitness Witness . + subsort SatWitness ValWitness < Witness . + subsort ValWitness < SatWitness . + --- Proof witnesses have projections + op pi : Witness -> FOForm . --- the formula proved + op algebra : Witness -> Module . --- Maude module which corresponds to algebra class + op verify : Witness -> Bool . --- verify if the proof object is correct for algebra/formula + op complete : Witness -> Bool . --- if this witness was generated by a complete method + op ctor : Witness -> Bool . --- if this witness was generated by a constructive proof method + --- Default non-constructive proofs + op sat2val : SatWitness -> ValWitness [ctor] . + op val2sat : ValWitness -> SatWitness [ctor] . + --- Default non-construcitive proof verifier + var SW : SatWitness . var VW : ValWitness . + eq verify(sat2val(SW)) = complete(SW) and-then verify(SW) . + eq verify(val2sat(VW)) = complete(VW) and-then verify(VW) . + eq pi(sat2val(SW)) = ~ pi(SW) . + eq pi(val2sat(VW)) = ~ pi(VW) . + eq algebra(sat2val(SW)) = algebra(SW) . + eq algebra(val2sat(VW)) = algebra(VW) . + eq complete(sat2val(SW)) = complete(SW) . + eq complete(val2sat(VW)) = complete(VW) . + eq ctor(sat2val(SW)) = false . + eq ctor(val2sat(VW)) = false . +endfm + +--- this module defines a "pretty" printer for core Maude, i.e. +--- defines new syntax that stands out better than the old syntax +--- NB: such pretty printing should always occur before display to +--- the user and not earlier because otherwise the user will +--- have to extend their functions to deal with the new +--- constructors that we invent here. +fmod FOFORM-CORE-PRETTYPRINT is + pr FOFORM . + + --- syntax for (respectively): + --- positive predicates + --- negative predicates + --- implications + op ##_ : Term -> QFForm [ctor format(g o o)] . + op !!_ : Term -> QFForm [ctor format(g o o)] . + op _=>_ : QFForm QFForm -> QFForm [ctor format(o rn on d)] . + + var F F' : QFForm . var Q : Qid . var T : Term . + var TA : TruthLit . var E : EqLit . + + op prettyPrint : Qid QFForm -> QFForm . + eq prettyPrint(Q,F /\ F') = prettyPrint(Q,F) /\ prettyPrint(Q,F') . + eq prettyPrint(Q,(~ F) \/ F') = prettyPrint(Q,F) => prettyPrint(Q,F') . + eq prettyPrint(Q,F \/ F') = prettyPrint(Q,F) \/ prettyPrint(Q,F') [owise] . + eq prettyPrint(Q,~ F) = ~ prettyPrint(Q,F) . + eq prettyPrint(Q,TA) = TA . + eq prettyPrint(Q,Q != T) = !! T . + eq prettyPrint(Q,Q ?= T) = ## T . + eq prettyPrint(Q,E) = E [owise] . +endfm + --- Views for some of our formula datatypes --- NeSet view FOForm from TRIV to FOFORM is sort Elt to FOForm . endv @@ -934,6 +1519,6 @@ view PosConj? from TRIV to FOFORM is sort Elt to PosConj view PosDisj? from TRIV to FOFORM is sort Elt to PosDisj? . endv view NegConj? from TRIV to FOFORM is sort Elt to NegConj? . endv view NegDisj? from TRIV to FOFORM is sort Elt to NegDisj? . endv ---- FOFormSubstPair -view FOFormSubstPair from TRIV to FOFORMSUBSTITUTION-PAIR is sort Elt to FOFormSubstPair . endv +--- QFFormSubstPair +view QFFormSubstPair from TRIV to QFFOFORMSUBSTITUTION-PAIR is sort Elt to QFFormSubstPair . endv ``` diff --git a/contrib/tools/meta.md/kind-ops.md b/contrib/tools/meta.md/kind-ops.md index 70143e72..35602f84 100644 --- a/contrib/tools/meta.md/kind-ops.md +++ b/contrib/tools/meta.md/kind-ops.md @@ -165,7 +165,7 @@ fmod KIND-LIST-EXT is var T T' : Term . var TS : TermSet . var TL : NeTermList . - var NL : NegEqAtom . + var NL : NegEqLit . var NF : NegEqConj . var Q : Qid . diff --git a/contrib/tools/meta.md/nelson-oppen-combination.md b/contrib/tools/meta.md/nelson-oppen-combination.md new file mode 100644 index 00000000..52de6756 --- /dev/null +++ b/contrib/tools/meta.md/nelson-oppen-combination.md @@ -0,0 +1,350 @@ +The Nelson-Oppen algorithm is implemented in Maude as the function +`nelson-oppen-sat`. Besides the names of the theories and the unpurified +formulae, the algorithm also requires information about which function to use to +check satisfiability, and whether the theory is convex. We use "tagged" formulae +to represent this information. For example, the term +`tagged('1.Nat ?= '2.Nat, (('mod > 'NAT), ('check-sat > 'var-sat)))` represents +the formula "$1 = 2$" in the module of `NAT`, and that we should use the +`var-sat` procedure to check its satisfiability. In the implementation in Maude, +these tagged formula are represented by the sort `TaggedFormula` and sets of +tagged formulae by the sort `TaggedFormulaSet`. For rewriting logic variables +(not to be confused with variables part of the formula we are rewriting over) of +the sort `TaggedFormula` we use the variables `TF1` and `TF2`, while for +`TaggedFormulaSet` we use `TFS`. + +```maude +load eqform.maude +load purification.maude +load meta-aux.maude --- VariableSet +load ../varsat/var-sat.maude +load smt.maude + +fmod TAGGED-EQFORM is + protecting EQFORM . + sort TaggedFormula TaggedFormulaSet Tags Tag . + subsorts Tag < Tags . + subsorts TaggedFormula < TaggedFormulaSet . + + op tagged : Form Tags -> TaggedFormula . + op empty : -> Tags [ctor] . + op _ ; _ : Tags Tags -> Tags [ctor assoc comm id: empty] . + op _ > _ : Qid Qid -> Tag . --- TODO Genneralize to QidSet? + + op empty : -> TaggedFormulaSet [ctor] . + op _,_ : TaggedFormulaSet TaggedFormulaSet -> TaggedFormulaSet [ctor comm assoc id: empty] . +endfm +``` + +```maude +fmod EQFORM-TO-SMT is + protecting META-TERM . + protecting EQFORM . + + vars F1 F2 : Form . + vars T1 T2 : Term . + + op eqform-to-smt : Form -> Term . + op eqform-to-smt : Term -> Term . + --------------------------------------------------------------------------------- + eq eqform-to-smt(tt) = 'true.Boolean . + ceq eqform-to-smt(F1 /\ F2) = '_and_ [eqform-to-smt(F1), eqform-to-smt(F2)] if F1 =/= tt /\ F2 =/= tt . + ceq eqform-to-smt(F1 \/ F2) = '_or_ [eqform-to-smt(F1), eqform-to-smt(F2)] if F1 =/= ff /\ F2 =/= ff . + eq eqform-to-smt(T1 ?= T2) = '_===_ [eqform-to-smt(T1), eqform-to-smt(T2)] . + eq eqform-to-smt(T1 != T2) = '_=/==_ [eqform-to-smt(T1), eqform-to-smt(T2)] . + eq eqform-to-smt(T1) = T1 [owise] . +endfm +``` + +```maude +fmod NO-CHECK-HELPER is + protecting EQFORM . + protecting TAGGED-EQFORM . + protecting EQFORM-TO-SMT . + protecting META-LEVEL . + + protecting VAR-SAT . + + op check-valid : TaggedFormula -> Bool . + op check-sat : TaggedFormula -> Bool . + op $check-sat.dnf : TaggedFormula -> Bool . + op $check-sat.print : ModuleExpression Form Bool -> Bool . + + var ME : ModuleExpression . + var F : Form . + var SAT? : Bool . + vars TS : Tags . + + --- strictNot gets stuck when it cannot evaluate further. This prevents + --- `valid` from returning true if `sat` gets stuck + op strictNot : Bool -> Bool . + op $strictNot.error : Bool -> Bool . + ------------------------------ + eq strictNot(true) = false . + eq strictNot(false) = true . + eq strictNot(B:Bool) = $strictNot.error(B:Bool) [owise print "----- what is? " B:Bool] . + + op smt-sat : ModuleExpression Form -> Bool . + eq smt-sat(ME, F) + = metaCheck([ME], eqform-to-smt(F)) + . + + eq check-valid(tagged(F, TS)) = strictNot(check-sat(tagged(~ F, TS))) . + eq check-sat(tagged(F, TS)) = $check-sat.dnf(tagged(F, TS)) . + + eq $check-sat.dnf (tagged(F, ('mod > ME); ('check-sat > 'var-sat); TS)) + = $check-sat.print(ME, F, var-sat(upModule(ME, true), F)) + [print "check-sat? " F] + . + + eq $check-sat.dnf (tagged(F, ('mod > ME); ('check-sat > 'smt-sat); TS)) + = $check-sat.print(ME, F, smt-sat(ME, F)) + . + + eq $check-sat.print(ME, F, SAT?) = SAT? +--- [print "check-sat: " ME ": " F " is " SAT? ] + . + + eq smt-sat(ME, F) = metaCheck([ME], eqform-to-smt(F)) + . +endfm +``` + +```maude +fmod NELSON-OPPEN-COMBINATION is + protecting NO-CHECK-HELPER . + protecting QIDSET-REFINEMENT . + protecting EQFORM-DNF . + protecting PURIFICATION . + protecting TAGGED-EQFORM . + protecting EQFORM-OPERATIONS . + + vars MCONJ2 : Conj . + vars CONJ PHI1 PHI2 : Conj . + vars F F1 F2 : Form . + vars CANDEQ DISJ?1 DISJ?2 : Disj . + vars M1 M2 : Module . + vars ME1 ME2 : Qid . --- TODO: Wierd, Qids are a subsort of ModuleExpr s not the other way around + vars TFS : TaggedFormulaSet . + vars TF1 TF2 : TaggedFormula . + vars TS1 TS2 : Tags . + vars X X1 X2 : Variable . + vars XS XS1 XS2 : VariableSet . + vars T1 T2 : Term . var TL : TermList . + +--- Tag a conjunction of wellFormed atoms into TaggedFormula. Atoms in the +--- intersection of multiple theories are copied into each tag. +--- TODO: Ill formed formulae are silently ignored. + + op tagWellFormed : TaggedFormulaSet EqConj -> TaggedFormulaSet . + op tagWellFormed.hasConvex : TaggedFormulaSet EqConj -> TaggedFormulaSet . + op $tagWellFormed.filter : ModuleExpression EqConj -> EqConj . + ----------------------------------------------------------------------------- + eq tagWellFormed(TFS, CONJ) = tagWellFormed.hasConvex(addConvexTag(TFS), CONJ) . + eq tagWellFormed.hasConvex(empty, CONJ) = empty . + eq tagWellFormed.hasConvex((tagged(PHI1, ('mod > ME1); TS1 ), TFS), CONJ) + = ( tagged(PHI1 /\ $tagWellFormed.filter(ME1, CONJ), ('mod > ME1) ; TS1) + , tagWellFormed(TFS, CONJ)) . + eq $tagWellFormed.filter(ME1, A:EqLit /\ MCONJ2) + = if A:EqLit in upModule(ME1, true) then A:EqLit /\ $tagWellFormed.filter(ME1, MCONJ2) + else $tagWellFormed.filter(ME1, MCONJ2) + fi + . + eq $tagWellFormed.filter(ME1, TA:TruthLit) = TA:TruthLit . + + op addConvexTag : TaggedFormulaSet -> TaggedFormulaSet . + -------------------------------------------------------- + eq addConvexTag((tagged(PHI1, ('convex > 'true ) ; TS1 ), TFS)) = tagged(PHI1, ('convex > 'true ) ; TS1 ), addConvexTag(TFS) . + eq addConvexTag((tagged(PHI1, ('convex > 'false) ; TS1 ), TFS)) = tagged(PHI1, ('convex > 'false) ; TS1 ), addConvexTag(TFS) . + eq addConvexTag((tagged(PHI1, TS1 ), TFS)) = tagged(PHI1, ('convex > 'false) ; TS1 ), addConvexTag(TFS) [owise] . + eq addConvexTag(empty) = empty . + + op in-module : Module VariableSet -> VariableSet . + eq in-module(M1, X1 ; XS) = if wellFormed(M1, X1) + then X1 + else none + fi ; in-module(M1, XS) . + eq in-module(M1, none) = none . + + op var-intersect : VariableSet VariableSet -> VariableSet . + ------------------------------------------------------- + eq var-intersect(X1 ; XS1, X1 ; XS2) = X1 ; var-intersect(XS1, XS2) . + eq var-intersect(XS1, XS2) = none [owise] . +``` + +```{.maude .njr-thesis} + op nelson-oppen-sat : TaggedFormulaSet Form -> Bool . +``` + +The `nelson-oppen-valid` function converts a validity check into a satisfiability check: + +```{.maude .njr-thesis} + op nelson-oppen-valid : TaggedFormulaSet Form -> Bool . + ---------------------------------------------------------- + eq nelson-oppen-valid(TFS, F) = strictNot(nelson-oppen-sat(TFS, ~ F)) . +``` + + + +```maude + op $nosat.dnf : TaggedFormulaSet Form -> Bool . + op $nosat.purified : TaggedFormulaSet EqConj -> Bool . + op $nosat.tagged : TaggedFormulaSet -> Bool . + op $nosat.basicSat : TaggedFormulaSet -> Bool . + op $nosat.ep : TaggedFormulaSet PosEqDisj -> Bool . + op $nosat.split : TaggedFormulaSet PosEqDisj -> Bool . + op $nosat.split.genEqs : TaggedFormulaSet PosEqDisj PosEqDisj -> Bool . + -------------------------------------------------------------------------- +``` + +Given a quantifier free formula `F` in the set of theories `TFS` (each tagged with information +regarding covexitivity, and information about which procedure to use for checking sat), we first +convert it to disjunctive normal form (DNF) and simplify it (e.g. $\bot \land \phi$ becomes +$\bot$). + +```{ .maude .njr-thesis } + eq nelson-oppen-sat(TFS, F) + = $nosat.dnf(TFS, dnf(F)) . +``` + +The algorithm then considers each disjunction separately. + +```{ .maude .njr-thesis } + ceq $nosat.dnf(TFS, F1 \/ F2) + = $nosat.dnf(TFS, F1) or-else $nosat.dnf(TFS, F2) + if F1 =/= ff /\ F2 =/= ff + . +``` + +We then purify each mixed disjunct into a conjunction of "pure" atoms each wellformed in the signature +of one of the theories, and tagged with the appropriate information. + +```{ .maude .njr-thesis } + ceq $nosat.dnf(TFS , CONJ) + = $nosat.purified(TFS, purify(ME1, ME2, CONJ)) + if ( tagged(tt, ('mod > ME1); TS1) + , tagged(tt, ('mod > ME2); TS2)) + := TFS + . + eq $nosat.purified(TFS, CONJ) + = $nosat.tagged(tagWellFormed(TFS, CONJ)) . +``` + +Next, we make sure each of the tagged formulae (`TF1`, `TF2`) are satisfiable on their own. + +```{ .maude .njr-thesis } + eq $nosat.tagged((TF1, TF2)) + = check-sat(TF1) and-then check-sat(TF2) and-then $nosat.basicSat(TF1, TF2) + [print "Purified:\n\t" TF1 "\n\t" TF2] + . +``` + +From the set of shared variables $\SharedVariables := \vars(\phi_1) \intersect \vars(\phi_2)$ we +define a set of candidate equalities. + +$$\CandidateEqualities := \{ x_i = y_i | x_i, y_i \in \SharedVariables_{s_i}, x_i \not\equiv y_i \}$$ + +where $\SharedVariables_{s_i}$ is the subset of shared variables in the connected component of sort $s_i$. + +```{ .maude .njr-thesis } + ceq $nosat.basicSat(TFS) + = $nosat.ep( TFS + , candidate-equalities(in-module(moduleIntersect(ME1, ME2) + , vars(PHI1) ; vars(PHI2))) + ) + if ( tagged(PHI1, ('mod > ME1); _1:Tags) + , tagged(PHI2, ('mod > ME2); _2:Tags)) + := TFS + . +``` + +```maude + op candidate-equalities : VariableSet -> PosEqDisj . + op candidate-equalities : Variable VariableSet VariableSet -> PosEqDisj . + --------------------------------------------------------------------- + eq candidate-equalities(X ; XS1) = candidate-equalities(X, XS1, XS1) . + ceq candidate-equalities(X, X1 ; XS1, XS2) = X ?= X1 \/ candidate-equalities(X, XS1, XS2) if getType(X) == getType(X1) . + ceq candidate-equalities(X, X1 ; XS1, XS2) = candidate-equalities(X, XS1, XS2) if not getType(X) == getType(X1) . + eq candidate-equalities(X, none, X2 ; XS2) = candidate-equalities(X2, XS2, XS2) . + eq candidate-equalities(X, none, none) = ff . +``` + +Next, we apply the equality propagation inference rule. If any identification of variables is +implied by a theory, we propagate that identification to the other theories by replacing all +occurrences of the variable in the left hand side with that on the right hand side in all formulae +and the candidate equalities. Performing the substitution instead of merely adding the equality to +the formula has the advantage of reducing the number of candidate equalities we need to try. + +```{ .maude .njr-thesis } + ceq $nosat.ep(( tagged(PHI1, ('mod > ME1); TS1) + , tagged(PHI2, ('mod > ME2); TS2)), X1 ?= X2 \/ CANDEQ) + = check-sat(tagged(PHI2 << (X1 <- X2), ('mod > ME2); TS2)) + and-then $nosat.ep(( tagged(PHI1 << (X1 <- X2), ('mod > ME1); TS1) + , tagged(PHI2 << (X1 <- X2), ('mod > ME2); TS2)) + , CANDEQ << (X1 <- X2)) + if check-valid(tagged(PHI1 => (X1 ?= X2), ('mod > ME1); TS1)) + [ print "EqualityProp: " ME1 ": => " X1 " ?= " X2 ] . +``` + +If, after checking each identification individually, there are none that are implied we apply the split +rule. + +```{ .maude .njr-thesis } + eq $nosat.ep(TFS, CANDEQ) = $nosat.split(TFS, CANDEQ) [owise print "Split? " CANDEQ] . +``` + +If there are no variables left to identify, then the formula is satisfiable + +```{ .maude .njr-thesis } +--- eq $nosat.split(TFS, mtForm) = true . +``` + +However, if some disjunction of identifications is implied and we are in a non-convex theory, we +"split". i.e. we try each of the possible identification left in turn and see if at least one of them +is satisfiable. + +```{ .maude .njr-thesis } + ceq $nosat.split(TFS, CANDEQ) + = $nosat.split.genEqs(TFS, CANDEQ, CANDEQ) + if ( tagged(PHI1, ('mod > ME1) ; ('convex > 'false) ; TS1) + , tagged(PHI2, ('mod > ME2) ; TS2)) + := TFS + /\ check-valid(tagged((PHI1) => (CANDEQ), ('mod > ME1); ('convex > 'false) ; TS1)) + . +``` + +Otherwise, since there are no implied identifications and the theories +are stably-infinite, the equation is satisfiable. + +```{ .maude .njr-thesis } + eq $nosat.split(TFS, CANDEQ) = true [owise] . +``` + +We use `$nosat.split.genEqs` to generate this disequality of sat problems. + + +```{ .maude .njr-thesis } + eq $nosat.split.genEqs((tagged(PHI1, ('mod > ME1); TS1), tagged(PHI2, ('mod > ME2); TS2)) + , X1 ?= X2 \/ DISJ?1, X1 ?= X2 \/ DISJ?2) + = ( check-sat(tagged(PHI1 /\ X1 ?= X2, ('mod > ME1); TS1)) + and-then check-sat(tagged(PHI2 /\ X1 ?= X2, ('mod > ME2); TS2)) + and-then $nosat.ep(( tagged(PHI1 /\ X1 ?= X2, ('mod > ME1); TS1) + , tagged(PHI2 /\ X1 ?= X2, ('mod > ME2); TS2)) + , DISJ?2) + ) + or-else $nosat.split.genEqs(( tagged(PHI1, ('mod > ME1); TS1) + , tagged(PHI2, ('mod > ME2); TS2)) + , DISJ?1, X1 ?= X2 \/ DISJ?2) + [print "Split: " ME1 " : " X1 " ?= " X2 ] + . + +---- eq $nosat.split.genEqs(( tagged(PHI1, ('mod > ME1); TS1) +---- , tagged(PHI2, ('mod > ME2); TS2)) +---- , mtForm, DISJ?2) +---- = false +---- . +``` + +``` {.maude} +endfm +``` + diff --git a/contrib/tools/meta.md/purification.md b/contrib/tools/meta.md/purification.md index 76fab0f7..ad347223 100644 --- a/contrib/tools/meta.md/purification.md +++ b/contrib/tools/meta.md/purification.md @@ -97,10 +97,12 @@ endfm Breaking Equalities =================== -Breaking equality atoms means taking an equality atom between terms of different modules and reforming them: +- `T ?= T'` goes to `x ?= T /\ x ?= x' /\ x' ?= T'` for `x` and `x'` variables of sort common to `T` and `T'`. +- `T != T'` goes to `x ?= T /\ x != x' /\ x' ?= T'` for `x` and `x'` variables of sort greater than that `T'`. -- `T ?= T'` goes to `x ?= T /\ x ?= T'` for `x` a variable of sort common to `T` and `T'`. -- `T != T'` goes to `x ?= T /\ x != T'` for `x` a variable of sort greater than that `T'`. +We generate two different variables `x` and `x'` each having names determined by `T` and `T'`. This means +that if the terms are encountered elsewhere in the algorithm, the identifications are automatically shared +without any seconday checks. ```maude fmod BREAK-EQATOMS is @@ -108,7 +110,7 @@ fmod BREAK-EQATOMS is protecting EQFORM . vars EqC EqC' : EqConj . vars MOD MOD' : Module . vars ME ME' : ModuleExpression . - vars T T' : Term . var NV : Variable . + vars T T' : Term . var NV NV' : Variable . op break-eqatoms : Module Module EqConj -> EqConj . op break-eqatoms : ModuleExpression ModuleExpression EqConj -> EqConj . @@ -116,14 +118,21 @@ fmod BREAK-EQATOMS is eq break-eqatoms(ME, ME', EqC) = break-eqatoms(upModule(ME, true), upModule(ME', true), EqC) . eq break-eqatoms(MOD, MOD', EqC /\ EqC') = break-eqatoms(MOD, MOD', EqC) /\ break-eqatoms(MOD, MOD', EqC') . - ceq break-eqatoms(MOD, MOD', T ?= T') = T ?= NV /\ T' ?= NV if not (T :: Variable or T' :: Variable) - /\ NV := joint-variable(MOD, MOD', T) . - ceq break-eqatoms(MOD, MOD', T != T') = T ?= NV /\ T' != NV if not (T :: Variable or T' :: Variable) - /\ NV := joint-variable(MOD, MOD', T) - /\ sortLeq(MOD, leastSort(MOD, T), leastSort(MOD, NV)) . - ceq break-eqatoms(MOD, MOD', T != T') = T ?= NV /\ T' != NV if not (T :: Variable or T' :: Variable) - /\ NV := joint-variable(MOD, MOD', T) - /\ sortLeq(MOD', leastSort(MOD', T), leastSort(MOD', NV)) . + ceq break-eqatoms(MOD, MOD', T ?= T') = T ?= NV + /\ NV ?= NV' + /\ T' ?= NV' + if not (T :: Variable or T' :: Variable) + /\ NV := joint-variable(MOD, MOD', T) + /\ NV' := joint-variable(MOD', MOD, T') + . +--- XXX: Everett please review this rule. Have I put all the primes in? + ceq break-eqatoms(MOD, MOD', T != T') = T ?= NV + /\ NV != NV' + /\ T' ?= NV' + if not (T :: Variable or T' :: Variable) + /\ NV := joint-variable(MOD, MOD', T) /\ sortLeq(MOD, leastSort(MOD , T ), leastSort(MOD , NV )) + /\ NV' := joint-variable(MOD', MOD, T') /\ sortLeq(MOD', leastSort(MOD', T'), leastSort(MOD', NV')) + . endfm ``` @@ -241,6 +250,8 @@ If so, then it leaves it alone, otherwise more work is required on the equationa op purify : ModulePair Form -> [Form] . --------------------------------------- + eq purify(modulePair(M, M'), tt) = tt . + eq purify(modulePair(M, M'), ff) = ff . ceq purify(modulePair(M, M'), F) = F if (F in M) . eq purify(modulePair(M, M'), ~ F) = ~ purify(modulePair(M, M'), F) . ceq purify(modulePair(M, M'), F /\ F') = purify(modulePair(M, M'), F) /\ purify(modulePair(M, M'), F') @@ -260,7 +271,9 @@ TODO: Abstract ?= vs != ceq purify(modulePair(M, M'), Q[TL] ?= T2) = purify(modulePair(M, M'), purify(M, M', Q[TL]) ?= T2) if not wellFormed(M, Q[TL]) and not wellFormed(M', Q[TL]) and Q inO asTemplate(M) . ceq purify(modulePair(M, M'), Q[TL] != T2) = purify(modulePair(M, M'), purify(M, M', Q[TL]) != T2) if not wellFormed(M, Q[TL]) and not wellFormed(M', Q[TL]) and Q inO asTemplate(M) . ceq purify(modulePair(M, M'), T1 ?= T2) = break-eqatoms(M, M', T1 ?= T2) if wellFormed(M, T1) and wellFormed(M', T2) and not wellFormed(M, T2) . + ceq purify(modulePair(M, M'), T1 != T2) = break-eqatoms(M, M', T1 != T2) if wellFormed(M, T1) and wellFormed(M', T2) and not wellFormed(M, T2) . ceq purify(modulePair(M, M'), T1 ?= T2) = T1 ?= T2 if wellFormed(M, T1) and wellFormed(M, T2) . + ceq purify(modulePair(M, M'), T1 != T2) = T1 != T2 if wellFormed(M, T1) and wellFormed(M, T2) . ``` Purifying Terms diff --git a/contrib/tools/varsat/foform.maude b/contrib/tools/varsat/foform.maude index df2a3327..2d9e50e0 100644 --- a/contrib/tools/varsat/foform.maude +++ b/contrib/tools/varsat/foform.maude @@ -7,1441 +7,4 @@ --- and are called through META-LEVEL reflection. This isolates the --- modules from one another and simplifies the algorithm design. -load meta-aux.maude --- library of extensions to Maude's META-LEVEL module -load renaming.maude --- next-gen renaming library - -fmod REFLECT is - pr META-LEVEL . - pr UNIT-FM . - op modReduce : Module Term -> [Term] . - op redReflect : Qid Term -> [Term] . - op sortReflect : Qid Term Type -> [Bool] . - var Mod : Module . - var M : Qid . - var T : Term . - var TY : Type . - eq modReduce(Mod,T) = if Mod =/= noModule then getTerm(metaReduce(Mod,T)) else T fi . - eq redReflect(M,T) = getTerm(metaReduce(upModule(M,false),T)) . - eq sortReflect(M,T,TY) = sortLeq(upModule(M,false),leastSort(upModule(M,false),T),TY) . -endfm - -fmod FOFORM is - pr META-LEVEL . - --- NOTE: This sort structure is complicated. Edit at your own risk (unless you want to simplify it). - --- Sort Declarations - --- Non-Empty/Possibly Empty Forms - sort TrueAtom FalseAtom TruthAtom PosEqAtom NegEqAtom Truth+PosEqAtom Truth+NegEqAtom EqAtom Atom . - sort ConstConj PosEqConj NegEqConj EqConj PosConj NegConj Conj . - sort ConstDisj PosEqDisj NegEqDisj EqDisj PosDisj NegDisj Disj . - sort PosEqQFForm NegEqQFForm EqQFForm QFForm AEQForm FOForm . - sort EmptyForm TruthAtom? PosEqAtom? NegEqAtom? Truth+NegEqAtom? Truth+PosEqAtom? EqAtom? Atom? . - sort ConstConj? PosEqConj? NegEqConj? EqConj? PosConj? NegConj? Conj? . - sort ConstDisj? PosEqDisj? NegEqDisj? EqDisj? PosDisj? NegDisj? Disj? . - sort PosEqQFForm? NegEqQFForm? EqQFForm? QFForm? AEQForm? FOForm? . - --- Subsorting - --- Atoms - subsort TrueAtom FalseAtom < TruthAtom . - subsort PosEqAtom NegEqAtom < EqAtom < Atom . - subsort TruthAtom PosEqAtom < Truth+PosEqAtom < Atom . - subsort TruthAtom NegEqAtom < Truth+NegEqAtom < Atom . - --- Non-Atoms - subsort PosEqConj PosEqDisj < PosEqQFForm < EqQFForm . - subsort NegEqConj NegEqDisj < NegEqQFForm < EqQFForm . - subsort EqConj EqDisj EqAtom < EqQFForm < QFForm . - subsort Atom < Conj Disj < QFForm < FOForm . - subsort AEQForm < FOForm . - --- Conjunctions/Disjunctions - subsort PosEqAtom < PosEqConj < PosConj . - subsort NegEqAtom < NegEqConj < NegConj . - subsort PosEqAtom < PosEqDisj < PosDisj . - subsort NegEqAtom < NegEqDisj < NegDisj . - subsort PosEqConj NegEqConj EqAtom < EqConj < Conj . - subsort PosEqDisj NegEqDisj EqAtom < EqDisj < Disj . - subsort TruthAtom < ConstConj < PosConj NegConj < Conj . - subsort TruthAtom < ConstDisj < PosDisj NegDisj < Disj . - subsort Truth+PosEqAtom < PosConj PosDisj . - subsort Truth+NegEqAtom < NegConj NegDisj . - --- Link Non-Empty/Possibly Empty Forms - subsort TruthAtom < TruthAtom? . subsort PosEqAtom < PosEqAtom? . - subsort Truth+PosEqAtom < Truth+PosEqAtom? . subsort NegEqAtom < NegEqAtom? . - subsort EqAtom < EqAtom? . subsort Atom < Atom? . - subsort Truth+NegEqAtom < Truth+NegEqAtom? . subsort PosEqConj < PosEqConj? . - subsort ConstConj < ConstConj? . subsort NegEqConj < NegEqConj? . - subsort EqConj < EqConj? . subsort Conj < Conj? . - subsort PosConj < PosConj? . subsort PosEqDisj < PosEqDisj? . - subsort NegConj < NegConj? . subsort NegEqDisj < NegEqDisj? . - subsort ConstDisj < ConstDisj? . subsort PosDisj < PosDisj? . - subsort NegDisj < NegDisj? . subsort EqDisj < EqDisj? . - subsort QFForm < QFForm? . subsort Disj < Disj? . - subsort FOForm < FOForm? . subsort AEQForm < AEQForm? . - subsort EqQFForm < EqQFForm? . subsort PosEqQFForm < PosEqQFForm? . - subsort NegEqQFForm < NegEqQFForm? . - --- Possibly Empty Atoms - subsort EmptyForm < TruthAtom? < Truth+PosEqAtom? Truth+NegEqAtom? < Atom? . - subsort EmptyForm < PosEqAtom? NegEqAtom? < EqAtom? < Atom? . - subsort EmptyForm < TruthAtom? PosEqAtom? < Truth+PosEqAtom? . - subsort EmptyForm < TruthAtom? NegEqAtom? < Truth+NegEqAtom? . - --- Possibly Empty Non-Atoms - subsort EmptyForm < PosEqConj? PosEqDisj? < PosEqQFForm? < EqQFForm? . - subsort EmptyForm < NegEqConj? NegEqDisj? < NegEqQFForm? < EqQFForm? . - subsort EmptyForm < EqConj? EqDisj? EqAtom? < EqQFForm? < QFForm? . - subsort EmptyForm < Atom? < Conj? Disj? < QFForm? < FOForm? . - subsort EmptyForm < AEQForm? < FOForm? . - --- Possibly Empty Conjunctions/Disjunctions - subsort EmptyForm < PosEqAtom? < PosEqConj? < PosConj? . - subsort EmptyForm < NegEqAtom? < NegEqConj? < NegConj? . - subsort EmptyForm < PosEqAtom? < PosEqDisj? < PosDisj? . - subsort EmptyForm < NegEqAtom? < NegEqDisj? < NegDisj? . - subsort EmptyForm < PosEqConj? NegEqConj? EqAtom? < EqConj? < Conj? . - subsort EmptyForm < PosEqDisj? NegEqDisj? EqAtom? < EqDisj? < Disj? . - subsort EmptyForm < TruthAtom? < ConstConj? < PosConj? NegConj? < Conj? . - subsort EmptyForm < TruthAtom? < ConstDisj? < PosDisj? NegDisj? < Disj? . - subsort EmptyForm < Truth+PosEqAtom? < PosConj? PosDisj? . - subsort EmptyForm < Truth+NegEqAtom? < NegConj? NegDisj? . - - --- Atomic Formulas - op mtForm : -> EmptyForm [ctor] . - op tt : -> TrueAtom [ctor] . - op ff : -> FalseAtom [ctor] . - op _?=_ : Term Term -> PosEqAtom [ctor comm prec 50] . - op _!=_ : Term Term -> NegEqAtom [ctor comm prec 50] . - --- Non-empty Conjunctions/Disjunctions (NeSets) - op _/\_ : ConstConj? ConstConj -> ConstConj [ctor assoc comm id: mtForm prec 51] . - op _/\_ : PosEqConj? PosEqConj -> PosEqConj [ctor ditto] . - op _/\_ : NegEqConj? NegEqConj -> NegEqConj [ctor ditto] . - op _/\_ : EqConj? EqConj -> EqConj [ctor ditto] . - op _/\_ : PosConj? PosConj -> PosConj [ctor ditto] . - op _/\_ : NegConj? NegConj -> NegConj [ctor ditto] . - op _/\_ : Conj? Conj -> Conj [ctor ditto] . - op _/\_ : PosEqQFForm? PosEqQFForm -> PosEqQFForm [ctor ditto] . - op _/\_ : NegEqQFForm? NegEqQFForm -> NegEqQFForm [ctor ditto] . - op _/\_ : EqQFForm? EqQFForm -> EqQFForm [ctor ditto] . - op _/\_ : QFForm? QFForm -> QFForm [ctor ditto] . - op _/\_ : AEQForm? AEQForm -> AEQForm [ctor ditto] . - op _/\_ : FOForm? FOForm -> FOForm [ctor ditto] . - op _\/_ : ConstDisj? ConstDisj -> ConstDisj [ctor assoc comm id: mtForm prec 51] . - op _\/_ : PosEqDisj? PosEqDisj -> PosEqDisj [ctor ditto] . - op _\/_ : NegEqDisj? NegEqDisj -> NegEqDisj [ctor ditto] . - op _\/_ : EqDisj? EqDisj -> EqDisj [ctor ditto] . - op _\/_ : PosDisj? PosDisj -> PosDisj [ctor ditto] . - op _\/_ : NegDisj? NegDisj -> NegDisj [ctor ditto] . - op _\/_ : Disj? Disj -> Disj [ctor ditto] . - op _\/_ : PosEqQFForm? PosEqQFForm -> PosEqQFForm [ctor ditto] . - op _\/_ : NegEqQFForm? NegEqQFForm -> NegEqQFForm [ctor ditto] . - op _\/_ : EqQFForm? EqQFForm -> EqQFForm [ctor ditto] . - op _\/_ : QFForm? QFForm -> QFForm [ctor ditto] . - op _\/_ : AEQForm? AEQForm -> AEQForm [ctor ditto] . - op _\/_ : FOForm? FOForm -> FOForm [ctor ditto] . - --- Possibly Empty Conjunctions/Disjunctions (Sets) - op _/\_ : PosEqConj? PosEqConj? -> PosEqConj? [ctor ditto] . - op _/\_ : NegEqConj? NegEqConj? -> NegEqConj? [ctor ditto] . - op _/\_ : EqConj? EqConj? -> EqConj? [ctor ditto] . - op _/\_ : EmptyForm EmptyForm -> EmptyForm [ctor ditto] . - op _/\_ : ConstConj? ConstConj? -> ConstConj? [ctor ditto] . - op _/\_ : PosConj? PosConj? -> PosConj? [ctor ditto] . - op _/\_ : NegConj? NegConj? -> NegConj? [ctor ditto] . - op _/\_ : Conj? Conj? -> Conj? [ctor ditto] . - op _/\_ : PosEqQFForm? PosEqQFForm? -> PosEqQFForm? [ctor ditto] . - op _/\_ : NegEqQFForm? NegEqQFForm? -> NegEqQFForm? [ctor ditto] . - op _/\_ : EqQFForm? EqQFForm? -> EqQFForm? [ctor ditto] . - op _/\_ : QFForm? QFForm? -> QFForm? [ctor ditto] . - op _/\_ : AEQForm? AEQForm? -> AEQForm? [ctor ditto] . - op _/\_ : FOForm? FOForm? -> FOForm? [ctor ditto] . - op _\/_ : EmptyForm EmptyForm -> EmptyForm [ctor ditto] . - op _\/_ : ConstDisj? ConstDisj? -> ConstDisj? [ctor ditto] . - op _\/_ : PosEqDisj? PosEqDisj? -> PosEqDisj? [ctor ditto] . - op _\/_ : NegEqDisj? NegEqDisj? -> NegEqDisj? [ctor ditto] . - op _\/_ : EqDisj? EqDisj? -> EqDisj? [ctor ditto] . - op _\/_ : PosDisj? PosDisj? -> PosDisj? [ctor ditto] . - op _\/_ : NegDisj? NegDisj? -> NegDisj? [ctor ditto] . - op _\/_ : Disj? Disj? -> Disj? [ctor ditto] . - op _\/_ : PosEqQFForm? PosEqQFForm? -> PosEqQFForm? [ctor ditto] . - op _\/_ : NegEqQFForm? NegEqQFForm? -> NegEqQFForm? [ctor ditto] . - op _\/_ : EqQFForm? EqQFForm? -> EqQFForm? [ctor ditto] . - op _\/_ : QFForm? QFForm? -> QFForm? [ctor ditto] . - op _\/_ : AEQForm? AEQForm? -> AEQForm? [ctor ditto] . - op _\/_ : FOForm? FOForm? -> FOForm? [ctor ditto] . - --- Negations and Quantifiers - op ~_ : QFForm -> QFForm [ctor prec 49] . - op ~_ : AEQForm -> AEQForm [ctor ditto] . - op ~_ : FOForm -> FOForm [ctor ditto] . - op A[_]_ : NeQidSet QFForm -> AEQForm [ctor prec 52] . - op E[_]_ : NeQidSet QFForm -> AEQForm [ctor prec 52] . - op A[_]_ : NeQidSet AEQForm -> AEQForm [ctor ditto] . - op E[_]_ : NeQidSet AEQForm -> AEQForm [ctor ditto] . - op A[_]_ : NeQidSet FOForm -> FOForm [ctor ditto] . - op E[_]_ : NeQidSet FOForm -> FOForm [ctor ditto] . - op A[_]_ : QidSet QFForm -> AEQForm [ditto] . - op E[_]_ : QidSet QFForm -> AEQForm [ditto] . - op A[_]_ : QidSet AEQForm -> AEQForm [ditto] . - op E[_]_ : QidSet AEQForm -> AEQForm [ditto] . - op A[_]_ : QidSet FOForm -> FOForm [ditto] . - op E[_]_ : QidSet FOForm -> FOForm [ditto] . - --- Error Terms - op error : String -> [FOForm] [ctor] . - --- Remove useless quantifiers - eq A[none] F:AEQForm = F:AEQForm . - eq E[none] F:AEQForm = F:AEQForm . -endfm - -fmod FOFORMSET is - pr FOFORM . - sort FormEmptySet . - sort TruthAtomSet PosEqAtomSet NegEqAtomSet Truth+PosEqAtomSet Truth+NegEqAtomSet EqAtomSet AtomSet . - sort ConstConjSet PosEqConjSet NegEqConjSet EqConjSet PosConjSet NegConjSet ConjSet . - sort ConstDisjSet PosEqDisjSet NegEqDisjSet EqDisjSet PosDisjSet NegDisjSet DisjSet . - sort PosEqQFFormSet NegEqQFFormSet EqQFFormSet QFFormSet AEQFormSet FOFormSet . - sort EmptyFormSet PosEqAtom?Set NegEqAtom?Set TruthAtom?Set Truth+NegEqAtom?Set Truth+PosEqAtom?Set EqAtom?Set Atom?Set . - sort ConstConj?Set PosEqConj?Set NegEqConj?Set EqConj?Set PosConj?Set NegConj?Set Conj?Set . - sort ConstDisj?Set PosEqDisj?Set NegEqDisj?Set EqDisj?Set PosDisj?Set NegDisj?Set Disj?Set . - sort PosEqQFForm?Set NegEqQFForm?Set EqQFForm?Set QFForm?Set AEQForm?Set FOForm?Set . - --- Subsorting - subsort EmptyForm < EmptyFormSet . - subsort TruthAtom < TruthAtomSet . subsort TruthAtom? < TruthAtom?Set . - subsort PosEqAtom < PosEqAtomSet . subsort PosEqAtom? < PosEqAtom?Set . - subsort NegEqAtom < NegEqAtomSet . subsort NegEqAtom? < NegEqAtom?Set . - subsort Truth+PosEqAtom < Truth+PosEqAtomSet . subsort Truth+PosEqAtom? < Truth+PosEqAtom?Set . - subsort Truth+NegEqAtom < Truth+NegEqAtomSet . subsort Truth+NegEqAtom? < Truth+NegEqAtom?Set . - subsort EqAtom < EqAtomSet . subsort EqAtom? < EqAtom?Set . - subsort Atom < AtomSet . subsort Atom? < Atom?Set . - subsort ConstConj < ConstConjSet . subsort ConstConj? < ConstConj?Set . - subsort PosEqConj < PosEqConjSet . subsort PosEqConj? < PosEqConj?Set . - subsort NegEqConj < NegEqConjSet . subsort NegEqConj? < NegEqConj?Set . - subsort EqConj < EqConjSet . subsort EqConj? < EqConj?Set . - subsort PosConj < PosConjSet . subsort PosConj? < PosConj?Set . - subsort NegConj < NegConjSet . subsort NegConj? < NegConj?Set . - subsort Conj < ConjSet . subsort Conj? < Conj?Set . - subsort ConstDisj < ConstDisjSet . subsort ConstDisj? < ConstDisj?Set . - subsort PosEqDisj < PosEqDisjSet . subsort PosEqDisj? < PosEqDisj?Set . - subsort NegEqDisj < NegEqDisjSet . subsort NegEqDisj? < NegEqDisj?Set . - subsort EqDisj < EqDisjSet . subsort EqDisj? < EqDisj?Set . - subsort PosDisj < PosDisjSet . subsort PosDisj? < PosDisj?Set . - subsort NegDisj < NegDisjSet . subsort NegDisj? < NegDisj?Set . - subsort Disj < DisjSet . subsort Disj? < Disj?Set . - subsort PosEqQFForm < PosEqQFFormSet . subsort PosEqQFForm? < PosEqQFForm?Set . - subsort NegEqQFForm < NegEqQFFormSet . subsort NegEqQFForm? < NegEqQFForm?Set . - subsort EqQFForm < EqQFFormSet . subsort EqQFForm? < EqQFForm?Set . - subsort QFForm < QFFormSet . subsort QFForm? < QFForm?Set . - subsort AEQForm < AEQFormSet . subsort AEQForm? < AEQForm?Set . - subsort FOForm < FOFormSet . subsort FOForm? < FOForm?Set . - --- Atoms Sets - subsort FormEmptySet < PosEqAtomSet NegEqAtomSet < EqAtomSet < AtomSet . - subsort FormEmptySet < TruthAtomSet PosEqAtomSet < Truth+PosEqAtomSet < AtomSet . - subsort FormEmptySet < TruthAtomSet NegEqAtomSet < Truth+NegEqAtomSet < AtomSet . - --- Non-Atom Sets - subsort PosEqConjSet PosEqDisjSet < PosEqQFFormSet < EqQFFormSet . - subsort NegEqConjSet NegEqDisjSet < NegEqQFFormSet < EqQFFormSet . - subsort EqConjSet EqDisjSet EqAtomSet < EqQFFormSet < QFFormSet . - subsort AtomSet < ConjSet DisjSet < QFFormSet < FOFormSet . - subsort FormEmptySet < AEQFormSet < FOFormSet . - --- Conjunctions/Disjunctions Sets - subsort PosEqAtomSet < PosEqConjSet < PosConjSet . - subsort NegEqAtomSet < NegEqConjSet < NegConjSet . - subsort PosEqAtomSet < PosEqDisjSet < PosDisjSet . - subsort NegEqAtomSet < NegEqDisjSet < NegDisjSet . - subsort PosEqConjSet NegEqConjSet EqAtomSet < EqConjSet < ConjSet . - subsort PosEqDisjSet NegEqDisjSet EqAtomSet < EqDisjSet < DisjSet . - subsort TruthAtomSet < ConstConjSet < PosConjSet NegConjSet < ConjSet . - subsort TruthAtomSet < ConstDisjSet < PosDisjSet NegDisjSet < DisjSet . - subsort Truth+PosEqAtomSet < PosConjSet PosDisjSet . - subsort Truth+NegEqAtomSet < NegConjSet NegDisjSet . - --- Link Non-Empty/Possibly Empty Forms - subsort TruthAtomSet < TruthAtom?Set . subsort PosEqAtomSet < PosEqAtom?Set . - subsort NegEqAtomSet < NegEqAtom?Set . subsort EqAtomSet < EqAtom?Set . - subsort Truth+PosEqAtomSet < Truth+PosEqAtom?Set . subsort Truth+NegEqAtomSet < Truth+NegEqAtom?Set . - subsort AtomSet < Atom?Set . subsort NegEqConjSet < NegEqConj?Set . - subsort PosEqConjSet < PosEqConj?Set . subsort EqConjSet < EqConj?Set . - subsort ConstConjSet < ConstConj?Set . subsort ConjSet < Conj?Set . - subsort PosConjSet < PosConj?Set . subsort PosEqDisjSet < PosEqDisj?Set . - subsort NegConjSet < NegConj?Set . subsort NegEqDisjSet < NegEqDisj?Set . - subsort ConstDisjSet < ConstDisj?Set . subsort EqDisjSet < EqDisj?Set . - subsort PosDisjSet < PosDisj?Set . subsort DisjSet < Disj?Set . - subsort NegDisjSet < NegDisj?Set . subsort AEQFormSet < AEQForm?Set . - subsort PosEqQFFormSet < PosEqQFForm?Set . subsort NegEqQFFormSet < NegEqQFForm?Set . - subsort EqQFFormSet < EqQFForm?Set . subsort QFFormSet < QFForm?Set . - subsort FOFormSet < FOForm?Set . - --- Possibly Empty Atoms Sets - subsort FormEmptySet < EmptyFormSet . - subsort EmptyFormSet < PosEqAtom?Set NegEqAtom?Set < EqAtom?Set < Atom?Set . - subsort EmptyFormSet < TruthAtom?Set PosEqAtom?Set < Truth+PosEqAtom?Set < Atom?Set . - subsort EmptyFormSet < TruthAtom?Set NegEqAtom?Set < Truth+NegEqAtom?Set < Atom?Set . - --- Possibly Empty Non-Atom Sets - subsort PosEqConj?Set PosEqDisj?Set < PosEqQFForm?Set < EqQFForm?Set . - subsort NegEqConj?Set NegEqDisj?Set < NegEqQFForm?Set < EqQFForm?Set . - subsort EqConj?Set EqDisj?Set EqAtom?Set < EqQFForm?Set < QFForm?Set . - subsort Atom?Set < Conj?Set Disj?Set < QFForm?Set < FOForm?Set . - subsort EmptyFormSet < AEQForm?Set < FOForm?Set . - --- Possibly Empty Conjunctions/Disjunctions - subsort EmptyFormSet < PosEqAtom?Set < PosEqConj?Set < PosConj?Set . - subsort EmptyFormSet < NegEqAtom?Set < NegEqConj?Set < NegConj?Set . - subsort EmptyFormSet < PosEqAtom?Set < PosEqDisj?Set < PosDisj?Set . - subsort EmptyFormSet < NegEqAtom?Set < NegEqDisj?Set < NegDisj?Set . - subsort EmptyFormSet < PosEqConj?Set NegEqConj?Set EqAtom?Set < EqConj?Set < Conj?Set . - subsort EmptyFormSet < PosEqDisj?Set NegEqDisj?Set EqAtom?Set < EqDisj?Set < Disj?Set . - subsort EmptyFormSet < TruthAtom?Set < ConstConj?Set < PosConj?Set NegConj?Set < Conj?Set . - subsort EmptyFormSet < TruthAtom?Set < ConstDisj?Set < PosDisj?Set NegDisj?Set < Disj?Set . - subsort EmptyFormSet < Truth+PosEqAtom?Set < PosConj?Set PosDisj?Set . - subsort EmptyFormSet < Truth+NegEqAtom?Set < NegConj?Set NegDisj?Set . - --- Empty [Formula Sets] - op mtFormSet : -> FormEmptySet [ctor] . - op _|_ : FormEmptySet FormEmptySet -> FormEmptySet [ctor assoc comm id: mtFormSet prec 53] . - --- [Non-Empty Formula] Sets - op _|_ : PosEqAtomSet PosEqAtomSet -> PosEqAtomSet [ctor ditto] . - op _|_ : NegEqAtomSet NegEqAtomSet -> NegEqAtomSet [ctor ditto] . - op _|_ : TruthAtomSet TruthAtomSet -> TruthAtomSet [ctor ditto] . - op _|_ : Truth+PosEqAtomSet Truth+PosEqAtomSet -> Truth+PosEqAtomSet [ctor ditto] . - op _|_ : Truth+NegEqAtomSet Truth+NegEqAtomSet -> Truth+NegEqAtomSet [ctor ditto] . - op _|_ : EqAtomSet EqAtomSet -> EqAtomSet [ctor ditto] . - op _|_ : AtomSet AtomSet -> AtomSet [ctor ditto] . - op _|_ : ConstConjSet ConstConjSet -> ConstConjSet [ctor ditto] . - op _|_ : PosEqConjSet PosEqConjSet -> PosEqConjSet [ctor ditto] . - op _|_ : NegEqConjSet NegEqConjSet -> NegEqConjSet [ctor ditto] . - op _|_ : EqConjSet EqConjSet -> EqConjSet [ctor ditto] . - op _|_ : PosConjSet PosConjSet -> PosConjSet [ctor ditto] . - op _|_ : NegConjSet NegConjSet -> NegConjSet [ctor ditto] . - op _|_ : ConjSet ConjSet -> ConjSet [ctor ditto] . - op _|_ : ConstDisjSet ConstDisjSet -> ConstDisjSet [ctor ditto] . - op _|_ : PosEqDisjSet PosEqDisjSet -> PosEqDisjSet [ctor ditto] . - op _|_ : NegEqDisjSet NegEqDisjSet -> NegEqDisjSet [ctor ditto] . - op _|_ : EqDisjSet EqDisjSet -> EqDisjSet [ctor ditto] . - op _|_ : PosDisjSet PosDisjSet -> PosDisjSet [ctor ditto] . - op _|_ : NegDisjSet NegDisjSet -> NegDisjSet [ctor ditto] . - op _|_ : DisjSet DisjSet -> DisjSet [ctor ditto] . - op _|_ : NegEqQFFormSet NegEqQFFormSet -> NegEqQFFormSet [ctor ditto] . - op _|_ : PosEqQFFormSet PosEqQFFormSet -> PosEqQFFormSet [ctor ditto] . - op _|_ : EqQFFormSet EqQFFormSet -> EqQFFormSet [ctor ditto] . - op _|_ : QFFormSet QFFormSet -> QFFormSet [ctor ditto] . - op _|_ : AEQFormSet AEQFormSet -> AEQFormSet [ctor ditto] . - op _|_ : FOFormSet FOFormSet -> FOFormSet [ctor ditto] . - --- [Possibly Empty Formula] Sets - op _|_ : EmptyFormSet EmptyFormSet -> EmptyFormSet [ctor ditto] . - op _|_ : PosEqAtom?Set PosEqAtom?Set -> PosEqAtom?Set [ctor ditto] . - op _|_ : NegEqAtom?Set NegEqAtom?Set -> NegEqAtom?Set [ctor ditto] . - op _|_ : TruthAtom?Set TruthAtom?Set -> TruthAtom?Set [ctor ditto] . - op _|_ : Truth+PosEqAtom?Set Truth+PosEqAtom?Set -> Truth+PosEqAtom?Set [ctor ditto] . - op _|_ : Truth+NegEqAtom?Set Truth+NegEqAtom?Set -> Truth+NegEqAtom?Set [ctor ditto] . - op _|_ : EqAtom?Set EqAtom?Set -> EqAtom?Set [ctor ditto] . - op _|_ : Atom?Set Atom?Set -> Atom?Set [ctor ditto] . - op _|_ : ConstConj?Set ConstConj?Set -> ConstConj?Set [ctor ditto] . - op _|_ : PosEqConj?Set PosEqConj?Set -> PosEqConj?Set [ctor ditto] . - op _|_ : NegEqConj?Set NegEqConj?Set -> NegEqConj?Set [ctor ditto] . - op _|_ : EqConj?Set EqConj?Set -> EqConj?Set [ctor ditto] . - op _|_ : PosConj?Set PosConj?Set -> PosConj?Set [ctor ditto] . - op _|_ : NegConj?Set NegConj?Set -> NegConj?Set [ctor ditto] . - op _|_ : Conj?Set Conj?Set -> Conj?Set [ctor ditto] . - op _|_ : ConstDisj?Set ConstDisj?Set -> ConstDisj?Set [ctor ditto] . - op _|_ : PosEqDisj?Set PosEqDisj?Set -> PosEqDisj?Set [ctor ditto] . - op _|_ : NegEqDisj?Set NegEqDisj?Set -> NegEqDisj?Set [ctor ditto] . - op _|_ : EqDisj?Set EqDisj?Set -> EqDisj?Set [ctor ditto] . - op _|_ : PosDisj?Set PosDisj?Set -> PosDisj?Set [ctor ditto] . - op _|_ : NegDisj?Set NegDisj?Set -> NegDisj?Set [ctor ditto] . - op _|_ : Disj?Set Disj?Set -> Disj?Set [ctor ditto] . - op _|_ : NegEqQFForm?Set NegEqQFForm?Set -> NegEqQFForm?Set [ctor ditto] . - op _|_ : PosEqQFForm?Set PosEqQFForm?Set -> PosEqQFForm?Set [ctor ditto] . - op _|_ : EqQFForm?Set EqQFForm?Set -> EqQFForm?Set [ctor ditto] . - op _|_ : QFForm?Set QFForm?Set -> QFForm?Set [ctor ditto] . - op _|_ : AEQForm?Set AEQForm?Set -> AEQForm?Set [ctor ditto] . - op _|_ : FOForm?Set FOForm?Set -> FOForm?Set [ctor ditto] . -endfm - -fmod FOFORMBASICLIST is - pr FOFORM . - sort FormEmptyList . - sort QFForm?List FOForm?List . - subsort FormEmptyList QFForm? < QFForm?List . - subsort FormEmptyList FOForm? < FOForm?List . - subsort QFForm?List < FOForm?List . - op nilFormList : -> FormEmptyList [ctor] . - op _;_ : FormEmptyList FormEmptyList -> FormEmptyList [ctor assoc id: nilFormList] . - op _;_ : FOForm?List FOForm?List -> FOForm?List [ctor ditto] . - op _;_ : QFForm?List QFForm?List -> QFForm?List [ctor ditto] . -endfm - -fmod FOFORM-CONVERSION is - pr FOFORMSET . - pr FOFORMBASICLIST . - op set2list : FOForm?Set -> FOForm?List . - op list2set : FOForm?List -> FOForm?Set . - var F : FOForm? . var FS : FOForm?Set . var FL : FOForm?List . - eq set2list(F | FS) = F ; set2list(FS) . - eq set2list(mtFormSet) = nilFormList . - eq list2set(F ; FL) = F | list2set(FL) . - eq list2set(nilFormList) = mtFormSet . -endfm - -fmod FOFORM-DEFINEDOPS is - pr FOFORM . - op _=>_ : FOForm FOForm -> FOForm [ctor] . - op _<=>_ : FOForm FOForm -> FOForm [ctor] . - var F1 F2 : FOForm . - eq F1 => F2 = (~ F1) \/ F2 . - eq F1 <=> F2 = (F1 => F2) /\ (F2 => F1) . -endfm - -fmod FOFORMSIMPLIFY-IMP-IMPL is - pr FOFORM . - var F G H K : FOForm . var K? : FOForm? . - var C : Conj . var D : Disj . var T T' : Term . - - --- Repeated Subformula - eq F /\ F = F . - eq F \/ F = F . - - --- Implication - eq (~ (F /\ G)) \/ F = tt . - eq (~ F ) \/ ((F \/ K?) /\ H) = (~ F) \/ H . - eq (~ (F /\ G)) \/ ((F \/ K?) /\ H) = (~ G) \/ H . - - --- Break up implication into clauses - eq (~ (F /\ (G \/ H)) ) \/ K = ((~ (F /\ G)) \/ K) /\ ((~ (F /\ H)) \/ K) . -endfm - -fmod FOFORMSIMPLIFY-IMPL is - pr FOFORM . - var F G H K : FOForm . var K? : FOForm? . - var C : Conj . var D : Disj . var T T' : Term . - - --- Repeated subformula in Conj/Disj - eq F /\ F = F . - eq F \/ F = F . - --- Negated TruthAtom - eq ~ tt = ff . - eq ~ ff = tt . - --- TruthAtom in Conj/Disj - eq ff /\ C = ff . - eq tt /\ C = C . - eq tt \/ D = tt . - eq ff \/ D = D . - --- Negated Formula - eq F \/ ~ F = tt . - eq F /\ ~ F = ff . - - --- eq T ?= T' /\ T != T' /\ C = ff . - --- eq T ?= T' \/ T != T' \/ D = tt . - eq (T ?= T' /\ T != T') = ff . - eq (T ?= T' \/ T != T') = tt . - - --- Trivial Equality/Disequality - eq T ?= T = tt . - eq T != T = ff . -endfm - -fmod FOFORMSIMPLIFY is - pr FOFORM . - pr REFLECT . - op simplify : FOForm -> FOForm . - var F : FOForm . - eq simplify(F) = downTerm(redReflect('FOFORMSIMPLIFY-IMPL,upTerm(F)),error("FOForm Simplify Failed")) . -endfm - -fmod FOFORMREDUCE-IMPL is - pr FOFORM . --- - pr TERM-EXTRA . --- vars() function - op red : Module Bool FOForm? ~> FOForm? . - op red : Module Bool FOForm ~> FOForm . - op red : Module Bool EqAtom ~> Atom . - op redL : Module Atom Atom Term Term ~> Atom . - op noteq : Module Term Term -> Bool . - var F F' : FOForm . var T T' : Term . var M : Module . var E : EqAtom . - var Q : NeQidSet . var AT AF : TruthAtom . var B : Bool . - eq red(M,B,F /\ F') = red(M,B,F) /\ red(M,B,F') . - eq red(M,B,F \/ F') = red(M,B,F) \/ red(M,B,F') . - eq red(M,B,mtForm) = mtForm . - eq red(M,B,A[Q] F) = A[Q] red(M,B,F) . - eq red(M,B,E[Q] F) = E[Q] red(M,B,F) . - eq red(M,B,~ F) = ~ red(M,B,F) . - eq red(M,B,AT) = AT . - eq red(M,B,T ?= T') = if B - then redL(M,tt,ff,getTerm(metaReduce(M,T)),getTerm(metaReduce(M,T'))) - else getTerm(metaReduce(M,T)) ?= getTerm(metaReduce(M,T')) - fi . - eq red(M,B,T != T') = if B - then redL(M,ff,tt,getTerm(metaReduce(M,T)),getTerm(metaReduce(M,T'))) - else getTerm(metaReduce(M,T)) != getTerm(metaReduce(M,T')) - fi . - --- if both sides are ground, check equality - ceq redL(M,AT,AF,T,T') = if T == T' then AT else AF fi if vars('a[T,T']) == none . - --- if one side is ground, check disequality via least sorts (if possible) - ceq redL(M,AT,AF,T,T') = AF if noteq(M,T,T') or-else noteq(M,T',T) . - --- otherwise, return simplified atom - eq redL(M,AT,AF,T,T') = if AT == tt then T ?= T' else T != T' fi [owise] . - --- INP: Module Term1 Term2 - --- PRE: Term1 and Term2 are well-defined in Module - --- OUT: true iff Term1 is ground and its least sort is greater than Term2; - --- this implies Term1 is NOT equal to Term2 - eq noteq(M,T,T') = (vars(T) == none and-then - sortLeq(M,leastSort(M,T'),leastSort(M,T)) and-then leastSort(M,T) =/= leastSort(M,T')) == true . -endfm - -fmod FOFORMREDUCE is - pr FOFORM . - pr REFLECT . - op reduce : Module FOForm ~> FOForm . - op reduce : Module Bool FOForm ~> FOForm . - op $reduce : [FOForm] -> FOForm . - var M : Module . var F : FOForm . var S : String . var G : [FOForm] . var B : Bool . - eq reduce(M,F) = reduce(M,true,F) . - eq reduce(M,B,F) = downTerm(redReflect('FOFORMREDUCE-IMPL,'red[upTerm(M),upTerm(B),upTerm(F)]),error("FOForm Reduce Failed")) . - eq $reduce(F) = F . - eq $reduce(error(S)) = error(S) . - eq $reduce(G) = error("Formula IllFormed") [owise] . -endfm - -fmod FOFORM-OPERATIONS is - pr FOFORM . - pr TERM-EXTRA . --- defines vars() : Term -> QidSet - op size : FOForm? -> Nat . - op depth : FOForm? -> Nat . - op wellFormed : Module FOForm? -> Bool . - op $wellFormed : Module FOForm? -> Bool . - op normalize : Module FOForm? -> FOForm? . - op toUnifProb : PosConj -> UnificationProblem . - op $toUnifProb : PosConj -> UnificationProblem . - op trueId : FOForm? -> FOForm . - op falseId : FOForm? -> FOForm . - op true2mt : FOForm? -> FOForm? . - op false2mt : FOForm? -> FOForm? . - op vars : FOForm? -> QidSet . - var M : Module . var F? : FOForm? . var F1 F2 : FOForm . var QS : NeQidSet . - var TA : TruthAtom . var T T' : Term . var PC : PosConj . var C : Conj . - --- get the size/depth of a formula - eq size(A[QS] F1) = s(size(F1)) . - eq size(E[QS] F1) = s(size(F1)) . - eq size(F1 /\ F2) = s(size(F1) + size(F2)) . - eq size(F1 \/ F2) = s(size(F1) + size(F2)) . - eq size(~ F1) = s(size(F1)) . - eq size(A:Atom) = 1 . - eq size(mtForm) = 0 . - eq depth(A[QS] F1) = s(depth(F1)) . - eq depth(E[QS] F1) = s(depth(F1)) . - eq depth(F1 /\ F2) = s(max(depth(F1),depth(F2))) . - eq depth(F1 \/ F2) = s(max(depth(F1),depth(F2))) . - eq depth(~ F1) = s(depth(F1)) . - eq depth(A:Atom) = 1 . - eq depth(mtForm) = 0 . - --- INP: Module FOForm? - --- PRE: N/A - --- OUT: true iff FOForm? is a wellFormed formula over module M - --- non-lits - ceq wellFormed(M,F?) = $wellFormed(M,F?) if wellFormed(M) . - eq $wellFormed(M,F1 /\ F2) = $wellFormed(M,F1) and-then $wellFormed(M,F2) . - eq $wellFormed(M,F1 \/ F2) = $wellFormed(M,F1) and-then $wellFormed(M,F2) . - eq $wellFormed(M,~ F1) = $wellFormed(M,F1) . - eq $wellFormed(M,A[QS] F1) = $wellFormed(M,F1) . - eq $wellFormed(M,E[QS] F1) = $wellFormed(M,F1) . - --- eq lit - eq $wellFormed(M,T ?= T') = wellFormed(M,T) and-then wellFormed(M,T') and-then sameKind(M,leastSort(M,T),leastSort(M,T')) . - eq $wellFormed(M,T != T') = wellFormed(M,T) and-then wellFormed(M,T') and-then sameKind(M,leastSort(M,T),leastSort(M,T')) . - --- true/false lit or mtForm - eq $wellFormed(M,TA) = true . - eq $wellFormed(M,mtForm) = true . - --- PRE: FOForm is well-formed in Module - --- OUT: A metanormalized formula - --- INP: FOForm? - eq normalize(M,F1 /\ F2) = normalize(M,F1) /\ normalize(M,F2) . - eq normalize(M,F1 \/ F2) = normalize(M,F1) \/ normalize(M,F2) . - eq normalize(M,~ F1) = ~ normalize(M,F1) . - eq normalize(M,A[QS] F1) = A[QS] normalize(M,F1) . - eq normalize(M,E[QS] F1) = E[QS] normalize(M,F1) . - eq normalize(M,T ?= T') = getTerm(metaNormalize(M,T)) ?= getTerm(metaNormalize(M,T')) . - eq normalize(M,T != T') = getTerm(metaNormalize(M,T)) != getTerm(metaNormalize(M,T')) . - eq normalize(M,TA) = TA . - eq normalize(M,mtForm) = mtForm . - --- PRE: N/A - --- OUT: QidSet of all MetaVariables in the FOForm? - eq vars(F1 /\ F2) = vars(F1) ; vars(F2) . - eq vars(F1 \/ F2) = vars(F1) ; vars(F2) . - eq vars(A[QS] F1) = vars(F1) . - eq vars(E[QS] F1) = vars(F1) . - eq vars(~ F1) = vars(F1) . - eq vars(TA) = none . - eq vars(mtForm) = none . - eq vars(T ?= T') = vars(T) ; vars(T') . - eq vars(T != T') = vars(T) ; vars(T') . - --- INP: PosConj - --- PRE: N/A - --- OUT: UnificationProblem if PosConj has no ff literals; - --- Otherwise, fail to reduce - ceq toUnifProb(PC) = $toUnifProb(PC) if not PC :: ConstConj . - eq $toUnifProb(TA /\ PC) = $toUnifProb(PC) . - eq $toUnifProb((T ?= T') /\ PC) = T =? T' /\ $toUnifProb(PC) . - eq $toUnifProb(T ?= T') = T =? T' . - --- INP: FOForm? - --- PRE: N/A - --- OUT: obvious from definition - eq trueId (mtForm) = tt . - eq trueId (F1) = F1 [owise] . - eq falseId (mtForm) = ff . - eq falseId (F1) = F1 [owise] . - eq true2mt (tt) = mtForm . - eq true2mt (F1) = F1 [owise] . - eq false2mt(ff) = mtForm . - eq false2mt(F1) = F1 [owise] . -endfm - -fmod FOFORM-QUANTIFIERS is - pr META-LEVEL . - pr FOFORM . - --- Sort Declarations - sort Quantifier UniQuantifier ExiQuantifier . - sort QuantifierList EmptyQuantifierList UniQuantifierList ExiQuantifierList QLFormPair . - --- Subsorting Declarations - subsort UniQuantifier ExiQuantifier < Quantifier < QuantifierList . - subsort EmptyQuantifierList < UniQuantifierList ExiQuantifierList < QuantifierList . - subsort UniQuantifier < UniQuantifierList . - subsort ExiQuantifier < ExiQuantifierList . - --- Quantifier Lists - op A[_] : QidSet -> UniQuantifier [ctor] . - op E[_] : QidSet -> ExiQuantifier [ctor] . - op none : -> EmptyQuantifierList [ctor] . - op __ : EmptyQuantifierList EmptyQuantifierList -> EmptyQuantifierList [ctor assoc id: none] . - op __ : UniQuantifierList UniQuantifierList -> UniQuantifierList [ctor ditto] . - op __ : ExiQuantifierList ExiQuantifierList -> ExiQuantifierList [ctor ditto] . - op __ : QuantifierList QuantifierList -> QuantifierList [ctor ditto] . - op ((_,_)) : QuantifierList FOForm -> QLFormPair [ctor] . - --- Defined Symbols - op getForm : QLFormPair -> FOForm . - op getQuantifierList : QLFormPair -> QuantifierList . - op stripQuantifiers : FOForm -> QLFormPair . - op stripQuantifiers : QuantifierList FOForm -> QLFormPair . - op appendQuantifiers : QuantifierList FOForm -> FOForm . - --- - var F : FOForm . var QL : QuantifierList . var Q : QidSet . - --- projections - eq getForm((QL,F)) = F . - eq getQuantifierList((QL,F)) = QL . - --- strip/append quantifiers - eq stripQuantifiers (F) = stripQuantifiers(none,F) . - eq stripQuantifiers (QL,A[Q] F) = stripQuantifiers(QL A[Q],F) . - eq stripQuantifiers (QL,E[Q] F) = stripQuantifiers(QL E[Q],F) . - eq stripQuantifiers (QL,F) = (QL,F) [otherwise] . - eq appendQuantifiers(QL A[Q],F) = appendQuantifiers(QL, A[Q] F) . - eq appendQuantifiers(QL E[Q],F) = appendQuantifiers(QL, E[Q] F) . - eq appendQuantifiers(none,F) = F . -endfm - -fmod FOFORM-TUPLES is - pr FOFORM . - pr MODULE-LIST . - sort FOFormNatPair FOFormPair ModFOFormPair NeModListFOFormPair . - subsort ModFOFormPair < NeModListFOFormPair . - op ((_,_)) : NeModuleList FOForm? -> NeModListFOFormPair [ctor] . - op ((_,_)) : Module FOForm? -> ModFOFormPair [ctor] . - op ((_,_)) : FOForm? Nat -> FOFormNatPair [ctor] . - op ((_,_)) : FOForm? FOForm? -> FOFormPair [ctor] . - - var ML : NeModuleList . var F : FOForm? . - - op getForm : NeModListFOFormPair ~> FOForm? . - eq getForm((ML,F)) = F . -endfm - -fmod FOFORM-SUBSTITUTION is - pr META-LEVEL . - pr SUBSTITUTION-HANDLING . --- from full-maude - pr FOFORM . - op _<<_ : FOForm? Substitution -> FOForm? . - op toConj? : Substitution -> Conj? . - --- - var U V : Term . var X Y : Variable . var S : Substitution . - var F G : FOForm . var Q Q' : QidSet . var I : Qid . var N : Nat . - --- base case - eq F << none = F . - --- quantifiers - eq (A[X ; Q] F) << (X <- Y ; S) = (A[X ; Q] F) << S . - eq (E[X ; Q] F) << (X <- Y ; S) = (E[X ; Q] F) << S . - eq (A[Q] F) << S = A[Q] (F << S) [owise] . - eq (E[Q] F) << S = E[Q] (F << S) [owise] . - --- other symbols - eq (F \/ G) << S = (F << S) \/ (G << S) . - eq (F /\ G) << S = (F << S) /\ (G << S) . - eq (~ F) << S = ~ (F << S) . - eq (U ?= V) << S = (U << S) ?= (V << S) . - eq (U != V) << S = (U << S) != (V << S) . - eq tt << S = tt . - eq ff << S = ff . - eq mtForm << S = mtForm . - - --- INP: Substitution - --- PRE: None - --- OUT: Conj? - eq toConj?(X <- U ; S) = X ?= U /\ toConj?(S) . - eq toConj?(none) = mtForm . -endfm - -fmod FOFORM-CONSTS-TO-VARS is - pr VARIABLES-TO-CONSTANTS . - pr FOFORM . - pr FOFORM-SUBSTITUTION . - op constsToVars : Substitution QFForm? -> QFForm? . - var S : Substitution . var F1 F2 : QFForm . var T T' : Term . - eq constsToVars(S,mtForm) = mtForm . - eq constsToVars(S,F1 /\ F2) = constsToVars(S,F1) /\ constsToVars(S,F2) . - eq constsToVars(S,F1 \/ F2) = constsToVars(S,F1) \/ constsToVars(S,F2) . - eq constsToVars(S,~ F1) = ~ constsToVars(S,F1) . - eq constsToVars(S,T ?= T') = constsToVars(S,T) ?= constsToVars(S,T') . - eq constsToVars(S,T != T') = constsToVars(S,T) != constsToVars(S,T') . -endfm - -fmod FOFORMSET-CONSTS-TO-VARS is - pr FOFORM-CONSTS-TO-VARS . - pr FOFORMSET . - op constsToVars : Substitution QFForm?Set -> QFForm?Set . - var S : Substitution . var F F' : QFForm? . var FS : QFForm?Set . - eq constsToVars(S,F | F' | FS) = constsToVars(S,F) | constsToVars(S,F' | FS) . - eq constsToVars(S,mtFormSet) = mtFormSet . -endfm - -fmod FOFORMSUBSTITUTION-PAIR is - pr FOFORM-SUBSTITUTION . --- substitution application - pr SUBSTITUTION-AUX . --- id - pr FOFORM-OPERATIONS . --- vars - sort FOFormSubstPair . - op ((_,_)) : FOForm? Substitution -> FOFormSubstPair [ctor] . - op errFOFormSubstPair : QidList -> [FOFormSubstPair] [ctor] . - op errFOFormSubstPairMsg : [FOFormSubstPair] -> QidList [ctor] . - op idpair : FOForm? -> FOFormSubstPair . - op getForm : FOFormSubstPair -> FOForm? . - op getSub : FOFormSubstPair -> Substitution . - op _Pair<<_ : FOForm? Substitution -> FOFormSubstPair . - op _<<_ : FOFormSubstPair Substitution -> FOFormSubstPair . - --- - var F : FOForm? . var S S' : Substitution . - var QL : QidList . var FK : [FOFormSubstPair] . - - eq errFOFormSubstPairMsg(errFOFormSubstPair(QL)) = QL . - eq errFOFormSubstPairMsg(FK) = nil [owise] . - - eq idpair(F) = (F,idsub(vars(F))) . - --- - eq getForm((F,S)) = F . - eq getSub ((F,S)) = S . - --- - eq F Pair<< S = (F << S,S) . - eq (F,S) << S' = (F << S,S << S') . -endfm - -fmod FOFORM-SUBSTITUTIONSET is - pr META-LEVEL . - pr SUBSTITUTIONSET . --- from full-maude - pr FOFORMSET . - pr FOFORM-SUBSTITUTION . - op _<<_ : FOForm? SubstitutionSet -> FOForm?Set . - --- - var S S' : Substitution . var SS : SubstitutionSet . var F : FOForm? . - --- base case - eq F << .SubstitutionSet = mtFormSet . - eq F << (S | S' | SS) = (F << S) | (F << S' | SS) . -endfm - -fmod FOFORMSUBSTITUTION-PAIRSET is - pr FOFORMSUBSTITUTION-PAIR . - pr FOFORM-SUBSTITUTIONSET . - sort FOFormSubstPairSet . - subsort FOFormSubstPair < FOFormSubstPairSet . - op _|_ : FOFormSubstPairSet FOFormSubstPairSet -> FOFormSubstPairSet [ctor assoc comm id: mtFSPS] . - op mtFSPS : -> FOFormSubstPairSet [ctor] . - --- - op idpair : FOForm?Set -> FOFormSubstPairSet . - op build : FOForm? SubstitutionSet -> FOFormSubstPairSet . - --- - op getForm : FOFormSubstPairSet -> FOForm?Set . - op getSub : FOFormSubstPairSet -> SubstitutionSet . - --- - op dnf-join : FOFormSubstPairSet -> QFForm? . - op _Pair<<_ : FOForm? SubstitutionSet -> FOFormSubstPairSet . - op _<<_ : FOFormSubstPairSet SubstitutionSet -> FOFormSubstPairSet . - op idem : FOFormSubstPairSet -> FOFormSubstPairSet . - --- - var F F' : FOForm? . var FS : FOForm?Set . var C? : Conj? . var S S' : Substitution . var SS : SubstitutionSet . - var FP FP' : FOFormSubstPair . var FPS : FOFormSubstPairSet . - var QL : QidList . var FK : [FOFormSubstPair] . var SK : [Substitution] . - - eq errFOFormSubstPairMsg(errFOFormSubstPair(QL) | FK) = QL . - - eq idpair(F | F' | FS) = idpair(F) | idpair(F' | FS) . - eq idpair(mtFormSet) = mtFSPS . - - --- INP: FOForm? SubstitutionSet - --- PRE: None - --- OUT: An FOFormSubstPairSet built by pairing FOForm? with each Substitution - eq build(F,S | SS) = (F,S) | build(F,SS) . - eq build(F,.SubstitutionSet) = mtFSPS . - - --- projections - eq getForm((F,S) | FPS) = F | getForm(FPS) . - eq getForm(mtFSPS) = mtFormSet . - eq getSub((F,S) | FPS) = S | getSub(FPS) . - eq getSub(mtFSPS) = .SubstitutionSet . - - --- INP: FOFormSubstPairSet - --- PRE: Each FOForm in the argument is also a Conj? - --- OUT: A DNF? - eq dnf-join((C?,S) | FPS) = (C? /\ toConj?(S)) \/ dnf-join(FPS) . - eq dnf-join(mtFSPS) = mtForm . - - --- Substitution Functions - eq (FP | FP' | FPS) << SS = (FP << SS) | ((FP' | FPS) << SS) . - eq mtFSPS << SS = mtFSPS . - eq FPS << .SubstitutionSet = mtFSPS . - eq FP << (S | S' | SS) = (FP << S) | (FP << (S' | SS)) . - - --- Construct pairs from one side - eq F Pair<< (S | S' | SS) = (F Pair<< S) | (F Pair<< (S' | SS)) . - eq F Pair<< .SubstitutionSet = mtFSPS . - eq F Pair<< errsub(QL) | SK = errFOFormSubstPair(QL) [owise] . - - --- Apply the idempotency equation - eq idem(FP | FP | FPS) = idem(FP | FPS) . - eq idem(FPS) = FPS [owise] . - eq idem(errFOFormSubstPair(QL) | FK) = errFOFormSubstPair(QL) . -endfm - -fmod FOFORM-RENAME is - pr FOFORM . - pr RENAME-METAVARS . - op renameAllVar : Module FindResult FOForm? -> FOForm? . - op renameTmpVar : Module FindResult FOForm? -> FOForm? . - op unwrapFOForm : TermData -> FOForm? . - var U : Module . var F : FOForm? . var N : FindResult . var T : Term . - eq renameAllVar(U,N,F) = unwrapFOForm(#renameAllVar(U,N,upTerm(F))) . - eq renameTmpVar(U,N,F) = unwrapFOForm(#renameTmpVar(U,N,upTerm(F))) . - eq unwrapFOForm(termdata(T,N)) = downTerm(T,error("Rename failed")) . -endfm - -fmod FOFORMSET-RENAME is - pr FOFORMSET . - pr FOFORM-RENAME . - op renameAllVar : Module FindResult FOForm?Set -> FOForm?Set . - op renameTmpVar : Module FindResult FOForm?Set -> FOForm?Set . - op unwrapFOFormSet : TermData -> FOForm?Set . - var U : Module . var F : FOForm?Set . var N : FindResult . var T : Term . - eq renameAllVar(U,N,F) = unwrapFOFormSet(#renameAllVar(U,N,upTerm(F))) . - eq renameTmpVar(U,N,F) = unwrapFOFormSet(#renameTmpVar(U,N,upTerm(F))) . - eq unwrapFOFormSet(termdata(T,N)) = downTerm(T,error("Rename failed")) . -endfm - -fmod FOFORMBASICLIST-RENAME is - pr FOFORMBASICLIST . - pr FOFORM-RENAME . - op renameAllVar : Module FindResult FOForm?List -> FOForm?List . - op renameTmpVar : Module FindResult FOForm?List -> FOForm?List . - op unwrapFOFormList : TermData -> FOForm?List . - var U : Module . var F : FOForm?List . var N : FindResult . var T : Term . - eq renameAllVar(U,N,F) = unwrapFOFormList(#renameAllVar(U,N,upTerm(F))) . - eq renameTmpVar(U,N,F) = unwrapFOFormList(#renameTmpVar(U,N,upTerm(F))) . - eq unwrapFOFormList(termdata(T,N)) = downTerm(T,error("Rename failed")) . -endfm - -fmod FQF-IMPL is - pr FOFORM-SUBSTITUTION . - pr FOFORM-TUPLES . - pr FOFORM-RENAME . - op renameQuantifiers : Module FOForm? -> FOForm? . - op $rq : FOFormNatPair -> FOForm? . - op $rq : Nat FOForm? -> FOFormNatPair . - op $rq2 : Qid FOFormNatPair FOForm? -> FOFormNatPair . - op $rq2 : Qid FOForm? FOFormNatPair -> FOFormNatPair . - op $rq1 : Qid FOFormNatPair -> FOFormNatPair . - op $rqQ : Qid FOFormNatPair QidSet -> FOFormNatPair . - op $rqQ : Qid Nat FOForm? QidSet QidSet -> FOFormNatPair . - --- - var Q : Qid . var F G : FOForm . var X : Variable . var K : [FOForm] . - var N : Nat . var S S' : QidSet . var P : QFForm? . var M : Module . - --- entry point - eq renameQuantifiers(M,P) = P . - eq renameQuantifiers(M,F) = $rq($rq(0,renameAllVar(M,notFound,F))) [owise] . - --- dispatch handlers for different cases - eq $rq((F,N)) = F . - eq $rq(N,P:QFForm?) = (P:QFForm?,N) . - eq $rq(N,F /\ G) = $rq2('/\,$rq(N,F),G) [owise] . - eq $rq(N,F \/ G) = $rq2('\/,$rq(N,F),G) [owise] . - eq $rq(N,~ F) = $rq1('~ ,$rq(N,F)) [owise] . - eq $rq(N,A[Q] F) = $rqQ('A ,$rq(N,F),Q) [owise] . - eq $rq(N,E[Q] F) = $rqQ('E ,$rq(N,F),Q) [owise] . - eq $rq(N,K) = (K,N) [owise] . - --- and/or - eq $rq2(Q,(F,N),G) = $rq2(Q,F,$rq(N,G)) . - eq $rq2('/\,F,(G,N)) = (F /\ G,N) . - eq $rq2('\/,F,(G,N)) = (F \/ G,N) . - --- not - eq $rq1('~,(F,N)) = (~ F,N) . - --- quantifiers - eq $rqQ(Q,(F,N),S) = $rqQ(Q,N,F,S,none) . - eq $rqQ(Q, N,F,X ; S,S') = $rqQ(Q,s(N),F << (X <- tmpvar(N,X)),S,S' ; tmpvar(N,X)) . - eq $rqQ('A,N,F,none, S') = (A[S'] F,N) . - eq $rqQ('E,N,F,none, S') = (E[S'] F,N) . -endfm - -fmod FQF is - pr META-LEVEL . - pr REFLECT . - pr FOFORM . - --- convert to fresh quantifier form - op toFQF : Module FOForm -> FOForm . - var M : Module . var F : FOForm . - --- perform conversion and validation - eq toFQF(M,F) = downTerm(redReflect('FQF-IMPL,'renameQuantifiers[upTerm(M),upTerm(F)]),error("FQF failed")) . -endfm - -fmod NNF-IMPL is - pr META-LEVEL . - sort EmptyForm TrueAtom FalseAtom NNF Form . - subsort EmptyForm TrueAtom FalseAtom < NNF < Form . - --- Negation Normal Forms - op mtForm : -> EmptyForm [ctor] . - op tt : -> TrueAtom [ctor] . - op ff : -> FalseAtom [ctor] . - op _?=_ : Term Term -> NNF [ctor comm] . - op _!=_ : Term Term -> NNF [ctor comm] . - op _/\_ : NNF NNF -> NNF [ctor assoc comm prec 51] . - op _\/_ : NNF NNF -> NNF [ctor assoc comm prec 51] . - op A[_]_ : QidSet NNF -> NNF [ctor prec 52] . - op E[_]_ : QidSet NNF -> NNF [ctor prec 52] . - --- General Formulas - op ~_ : Form -> Form [prec 50] . - op _/\_ : Form Form -> Form [ctor ditto] . - op _\/_ : Form Form -> Form [ctor ditto] . - op A[_]_ : QidSet Form -> Form [ctor ditto] . - op E[_]_ : QidSet Form -> Form [ctor ditto] . - var T T' : Term . var F F' : Form . var Q : QidSet . - --- Push negations down everywhere --- flip sign accordingly - eq ~ tt = ff . - eq ~ ff = tt . - eq ~ T ?= T' = T != T' . - eq ~ T != T' = T ?= T' . - eq ~ (A[Q] F) = E[Q] ~ F . - eq ~ (E[Q] F) = A[Q] ~ F . - eq ~ (F /\ F') = ~ F \/ ~ F' . - eq ~ (F \/ F') = ~ F /\ ~ F' . -endfm - -fmod NNF is - pr META-LEVEL . - pr REFLECT . - pr FOFORM . - op toNNF : FOForm? -> FOForm? . - op nnf? : FOForm? -> Bool . - var F : FOForm? . - eq toNNF(F) = downTerm(redReflect('NNF-IMPL,upTerm(F)),error("NNF failed")) . - eq nnf?(F) = sortReflect('NNF-IMPL,upTerm(F),'NNF) . -endfm - -fmod PNF-IMPL is - pr META-LEVEL . - sort EmptyForm TrueAtom FalseAtom QFF EPNF APNF PNF Form . - subsort EmptyForm TrueAtom FalseAtom < QFF < PNF < Form . - --- Quantifier Free Formulas - op mtForm : -> EmptyForm [ctor] . - op tt : -> TrueAtom [ctor] . - op ff : -> FalseAtom [ctor] . - op _?=_ : Term Term -> QFF [ctor comm] . - op _!=_ : Term Term -> QFF [ctor comm] . - op _/\_ : QFF QFF -> QFF [ctor assoc comm prec 50] . - op _\/_ : QFF QFF -> QFF [ctor assoc comm prec 50] . - op ~_ : QFF -> QFF [ctor prec 51] . - --- Prenex Normal Forms - op A[_]_ : QidSet PNF -> PNF [ctor prec 51] . - op E[_]_ : QidSet PNF -> PNF [ctor prec 51] . - --- General Formulas - op _/\_ : Form Form -> Form [ctor ditto] . - op _\/_ : Form Form -> Form [ctor ditto] . - op ~_ : Form -> Form [ctor ditto] . - op A[_]_ : QidSet Form -> Form [ctor ditto] . - op E[_]_ : QidSet Form -> Form [ctor ditto] . - --- Bubble Quantifiers Up - var F G : Form . var Q : QidSet . - eq ~ A[Q] F = E[Q] ~ F . - eq ~ E[Q] F = A[Q] ~ F . - eq (A[Q] F) /\ G = A[Q] (F /\ G) . - eq (E[Q] F) /\ G = E[Q] (F /\ G) . -endfm - -fmod PNF is - pr META-LEVEL . - pr REFLECT . - pr FOFORM . - pr FQF . - op toPNF : Module FOForm -> FOForm . - op toPNF1 : FOForm -> FOForm . - op pnf? : FOForm -> Bool . - var M : Module . var F : FOForm . var K : [FOForm] . - eq toPNF (M,F) = if F :: QFForm? or-else pnf?(F) then F else toPNF1(toFQF(M,F)) fi . - eq toPNF1(F) = downTerm(redReflect('PNF-IMPL,upTerm(F)),error("PNF Failed")) . - eq toPNF1(K) = K [owise] . - eq pnf?(F) = sortReflect('PNF-IMPL,upTerm(F),'PNF) . -endfm - -fmod DNF-IMPL is - pr META-LEVEL . - sort EmptyForm TrueAtom FalseAtom Conj DNF QDNF Form . - subsort EmptyForm TrueAtom FalseAtom < Conj < DNF < QDNF < Form . - --- Disjunctive Normal Forms - op mtForm : -> EmptyForm [ctor] . - op tt : -> TrueAtom [ctor] . - op ff : -> FalseAtom [ctor] . - op _?=_ : Term Term -> Conj [ctor comm] . - op _!=_ : Term Term -> Conj [ctor comm] . - op _/\_ : Conj Conj -> Conj [ctor assoc comm] . - op _\/_ : DNF DNF -> DNF [ctor assoc comm] . - op A[_]_ : QidSet QDNF -> QDNF [ctor] . - op E[_]_ : QidSet QDNF -> QDNF [ctor] . - --- General Formulas - op _/\_ : Form Form -> Form [ctor ditto] . - op _\/_ : Form Form -> Form [ctor ditto] . - op ~_ : Form -> Form [ctor] . - op A[_]_ : QidSet Form -> Form [ctor] . - op E[_]_ : QidSet Form -> Form [ctor] . - --- - var F F' F'' : Form . - --- With NNF/PNF transformations, one equation is enough - eq F /\ (F' \/ F'') = (F /\ F') \/ (F /\ F'') . -endfm - -fmod DNF is - pr META-LEVEL . - pr REFLECT . - pr FOFORM . - pr PNF + NNF . - op toDNF : Module FOForm? -> FOForm? . - op toDNF : QFForm? -> QFForm? . - op qdnf? : FOForm? -> Bool . - op dnf? : FOForm? -> Bool . - var M : Module . var F : FOForm? . var Q : QFForm? . - --- order: call NNF, PNF, and then CNF conversion function - eq toDNF(M,F) = downTerm(redReflect('DNF-IMPL,upTerm(toPNF(M,toNNF(F)))),error("DNF failed")) . - eq toDNF(Q) = downTerm(redReflect('DNF-IMPL,upTerm(toNNF(Q))),error("DNF failed")) . - eq qdnf?(F) = sortReflect('DNF-IMPL,upTerm(F),'QDNF) . - eq dnf?(F) = sortReflect('DNF-IMPL,upTerm(F),'DNF) . -endfm - -fmod CNF-IMPL is - pr META-LEVEL . - sort EmptyForm TrueAtom FalseAtom Disj CNF QCNF Form . - subsort EmptyForm TrueAtom FalseAtom < Disj < CNF < QCNF < Form . - --- Disjunctive Normal Forms - op mtForm : -> EmptyForm [ctor] . - op tt : -> TrueAtom [ctor] . - op ff : -> FalseAtom [ctor] . - op _?=_ : Term Term -> Disj [ctor comm] . - op _!=_ : Term Term -> Disj [ctor comm] . - op _\/_ : Disj Disj -> Disj [ctor assoc comm] . - op _/\_ : CNF CNF -> CNF [ctor assoc comm] . - op A[_]_ : QidSet QCNF -> QCNF [ctor] . - op E[_]_ : QidSet QCNF -> QCNF [ctor] . - --- General Formulas - op _/\_ : Form Form -> Form [ctor ditto] . - op _\/_ : Form Form -> Form [ctor ditto] . - op ~_ : Form -> Form [ctor] . - op A[_]_ : QidSet Form -> Form [ctor] . - op E[_]_ : QidSet Form -> Form [ctor] . - --- - var F F' F'' : Form . - --- With NNF/PNF transformations, one equation is enough - eq F \/ (F' /\ F'') = (F \/ F') /\ (F \/ F'') . -endfm - -fmod CNF is - pr META-LEVEL . - pr REFLECT . - pr FOFORM . - pr PNF + NNF . - op toCNF : Module FOForm? -> FOForm? . - op toCNF : QFForm? -> QFForm? . - op qcnf? : FOForm? -> Bool . - op cnf? : FOForm? -> Bool . - var M : Module . var F : FOForm? . var Q : QFForm? . - --- order: call NNF, PNF, and then CNF conversion function - eq toCNF(M,F) = downTerm(redReflect('CNF-IMPL,upTerm(toPNF(M,toNNF(F)))),error("CNF failed")) . - eq toCNF(Q) = downTerm(redReflect('CNF-IMPL,upTerm(toNNF(Q))),error("CNF failed")) . - eq qcnf?(F) = sortReflect('CNF-IMPL,upTerm(F),'QCNF) . - eq cnf?(F) = sortReflect('CNF-IMPL,upTerm(F),'CNF) . -endfm - -fmod FOFORMSET-OPERATIONS is - pr FOFORM-OPERATIONS . - pr FOFORMSET . - pr CNF . - pr DNF . - op disj-join : FOForm?Set -> FOForm? . - op disj-join : QFForm?Set -> QFForm? . - op conj-join : FOForm?Set -> FOForm? . - op conj-join : QFForm?Set -> QFForm? . - op toPosEqAtoms : PosEqQFForm -> PosEqAtomSet . - op toPosEqAtoms : UnificationProblem -> PosEqAtomSet . - op toEqSet : PosEqAtomSet -> EquationSet . - op wellFormed : Module FOForm?Set -> Bool . - --- - op toDisjSet : QFForm? ~> DisjSet . - op toDisjSet' : QFForm? ~> DisjSet . - op toConjSet : QFForm? ~> ConjSet . - op toConjSet' : QFForm? ~> ConjSet . - --- - var FS : FOForm?Set . var FF FF' : FOForm? . var F : QFForm? . var D : Disj . var UP : UnificationProblem . - var C : Conj . var PEA : PosEqAtom . var PEAS : PosEqAtomSet . var T T' : Term . var M : Module . - --- - eq toDisjSet (F) = toDisjSet'(toCNF(F)) . - eq toDisjSet'(D /\ F) = D | toDisjSet'(F) . - eq toDisjSet'(mtForm) = mtFormSet . - --- - eq toConjSet (F) = toConjSet'(toDNF(F)) . - eq toConjSet'(C \/ F) = C | toConjSet'(F) . - eq toConjSet (mtForm) = mtFormSet . - --- - eq disj-join(FF | FS) = FF \/ disj-join(FS) . - eq disj-join(mtFormSet) = ff . - eq conj-join(FF | FS) = FF /\ conj-join(FS) . - eq conj-join(mtFormSet) = tt . - --- - eq toPosEqAtoms(PEA /\ F) = PEA | toPosEqAtoms(F) . - eq toPosEqAtoms(PEA \/ F) = PEA | toPosEqAtoms(F) . - eq toPosEqAtoms(mtForm) = mtFormSet . - --- - eq toPosEqAtoms(T =? T' /\ UP) = T ?= T' | toPosEqAtoms(UP) . - eq toPosEqAtoms(T =? T') = T ?= T' . - --- - eq toEqSet(T ?= T' | PEAS) = (eq T = T' [none] .) toEqSet(PEAS) . - eq toEqSet(mtFormSet) = none . - --- - eq wellFormed(M,FF | FF' | FS) = wellFormed(M,FF) and-then wellFormed(M,FF' | FS) . - eq wellFormed(M,mtFormSet) = true . -endfm - -fmod FOFORM-DESCENT-MAP is - pr FOFORM . - pr UNIT-FM . - op descent-map : Module Module QFForm? -> QFForm? . - op check-map? : QFForm? ~> QFForm? . - --- - var DM RM : Module . var F : FOForm? . - --- INP: Module:DM Module:RM QFForm? - --- PRE: DM should have a function reduce : Form -> Form which returns ff in case of any error - --- Form is wellFormed w.r.t to RM - --- OUT: Use DM to descent-map Form - eq descent-map(noModule,RM,F) = F . - eq descent-map(DM,RM,F) = if F == ff then ff else - check-map?(downTerm(getTerm(metaReduce(DM,'reduce[upTerm(RM),upTerm(F)])),ff)) fi [owise] . - ceq check-map?(F) = F if F =/= ff . -endfm - -fmod FOFORM-EASY-SIMPLIFY is - pr FOFORMSIMPLIFY . - pr FOFORMREDUCE . - pr FOFORM-DESCENT-MAP . - pr NNF . - op srs : Module FOForm? -> FOForm? . - op srsd : Module Module FOForm? -> FOForm? . - var DM RM : Module . var F : FOForm? . - eq srs (RM,F) = simplify(toNNF(reduce(RM,simplify(F)))) . - eq srsd(DM,RM,F) = descent-map(DM,RM,srs(RM,F)) . -endfm - ---- NOTE: this simplification of extracting a substitution and applying it is NOT deterministic... ---- this module extracts fragments out of QFForms that look like substitutions and applies them -fmod FOFORM-EXTRACT-SUBSTITUTION is - pr FOFORMSUBSTITUTION-PAIRSET . - pr DNF . - pr SUBSTITUTION-HANDLING . - pr FOFORM-OPERATIONS . - pr FOFORMSET-OPERATIONS . - - op is-sub? : Module QFForm? -> Bool . - op #extract-subs : Module QFForm? -> FOFormSubstPairSet . - op #extract-subs : Module QFForm? FOFormSubstPairSet -> FOFormSubstPairSet . - op #extract-sub : Module Conj? -> FOFormSubstPair . - op #extract-sub : Module Conj? Conj? Substitution -> FOFormSubstPair . - op extract-sub : Module Conj? -> Conj? . - op extract-imp-sub : Module QFForm ~> QFForm . - - var Q1? Q2? : QFForm? . var Q Q' : QFForm . var C : Conj . var C1? C2? C3? : Conj? . var FS : FOFormSubstPairSet . - var V : Variable . var T : Term . var S : Substitution . var A : Atom . var U : Module . - - --- INP: QFForm? - --- PRE: - --- OUT: Check if the QFForm? is equivalent to a disjunction of substitutions (which is always satisfiable) - eq is-sub?(U,Q1?) = getForm(#extract-subs(U,Q1?)) == mtForm . - - --- INP: QFForm? - --- PRE: - --- OUT: [1] QFForm? is first converted into a DNF - --- [2] In each conjunct, substitution-like fragments are #extracted (but not applied) into a FOFormSubstPair - --- [3] We return a set of all such pairs (one for each conjunct) - eq #extract-subs (U,Q1?) = #extract-subs(U,toDNF(Q1?),mtFSPS) . - eq #extract-subs (U,mtForm,FS) = FS . - eq #extract-subs (U,C \/ Q1?,FS) = #extract-subs(U,Q1?,FS | #extract-sub(U,C)) . - - --- INP: Conj? - --- PRE: - --- OUT: An FOFormSubstPair (C'?,S?) such that C? = C'? /\ S? and S? is the substitution-like fragment (may be empty) - eq #extract-sub(U,C1?) = #extract-sub(U,C1?,mtForm,none) . - ceq #extract-sub(U,V ?= T /\ C1?,C2?,S) = #extract-sub(U,(C1? /\ C2?) << (V <- T),mtForm,S .. (V <- T)) - if sortLeq(U,leastSort(U,T),getType(V)) /\ not V in vars(T) . - eq #extract-sub(U,A /\ C1?,C2?,S) = #extract-sub(U,C1?,C2? /\ A,S) [owise] . - eq #extract-sub(U,mtForm,C2?,S) = (C2?,S) . - - - eq extract-sub(U,C1?) = getForm(#extract-sub(U,C1?)) . - - eq extract-imp-sub(U, Q \/ ~ C) = Q << getSub(#extract-sub(U,C)) \/ ~ trueId(getForm(#extract-sub(U,C))) . - eq extract-imp-sub(U,(Q \/ ~ C) /\ Q') = extract-imp-sub(U,Q \/ ~ C) /\ extract-imp-sub(U,Q') . - eq extract-imp-sub(U,Q) = Q [owise] . -endfm - ----( -fmod FOFORM-AUX is - pr MGCI . --- for ctor-term - pr SUBSTITUTIONPAIRSET . - pr FOFORMSUBSTITUTION-PAIR . - pr STREAM{FOFormSubstPair} . - - --- Simplify constraints by apply substitutions whenever possible - op litToNonRecBinding : Module Atom -> Substitution . - op bindingsToConj : Substitution -> PosEqConj . - op findBinding : Module QFForm -> FOFormSubstPair . - op findBindings : Module QFForm -> FOFormSubstPair . - op $findBindings : Module QFForm QFForm Substitution -> Stream{FOFormSubstPair} . - op $findBindings : Module QFForm QFForm Substitution Atom Substitution -> Stream{FOFormSubstPair} . - op recSimplifyForm : Module QFForm Substitution -> FOFormSubstPair . - op $recSimplifyForm : Module FOFormSubstPair Substitution -> FOFormSubstPair . - op simplifyForm : Module QFForm -> QFForm . - op simplifyBindings : Module Substitution -> Substitution . - op removeGround : QFForm -> QFForm . - op filterBindingsByCtor : Module Substitution -> SubstitutionPair . - op removeRedundantLits : QFForm -> QFForm . - - var F F' : QFForm . var V : Variable . - var T T' : Term . var VS : VariableSet . var M : Module . var L : Atom . - var S S' S1 S2 : Substitution . var B1 B2 : Bool . var F? F'? : QFForm? . - - --- INP: Substitution - --- PRE: None - --- OUT: A PosEqConj where each V <- T becomes V ?= T - eq bindingsToConj(V <- T ; S) = V ?= T /\ bindingsToConj(S) . - eq bindingsToConj(none) = tt . - - --- INP: Module Atom - --- PRE: Atom is well-formed - --- OUT: If Atom is of the form V ?= T or T ?= V then - --- returns a substitution V <- T if leastSort(T) < leastSort(V) and not V in vars(T) - --- otherwise returns none - eq litToNonRecBinding(M,V ?= T) = - if sortLeq(M,leastSort(M,T),leastSort(M,V)) and not V in vars(T) then V <- T else none fi . - eq litToNonRecBinding(M,L) = none [owise] . - - --- INP: Module FOForm1 - --- PRE: FOForm1 is well-formed - --- OUT: Given Form1 = F /\ B with B a substitution, returns (F,B), - --- otherwise returns (Form1,none) - eq findBinding(M,F) = pick!(0,$findBindings(M,F,mtForm,none)) . - eq findBindings(M,F) = last!($findBindings(M,F,mtForm,none)) . - eq $findBindings(M,mtForm,F',S) = (F',S) & end . - eq $findBindings(M,L /\ F?,F'?,S) = $findBindings(M,F?,F'?,S,L,litToNonRecBinding(M,L)) . - eq $findBindings(M,F?,F'?,S,L,V <- T) = (F? /\ F'?,S ; V <- T) & $findBindings(M,F?,F'?,S ; V <- T) . - eq $findBindings(M,F?,F'?,S,L,none) = $findBindings(M,F?,F'? /\ L,S) . - - --- INP: Module FOForm Substitution - --- PRE: None - --- OUT: If FOForm = F /\ B with B a non-circular binding, then performs - --- such substitutions followed by a simplification until a fixpoint - --- is reached; returns the substituted formula plus the set of bindings - --- that were generated - eq recSimplifyForm(M,F,S) = $recSimplifyForm(M,findBinding(M,F),S) . - eq $recSimplifyForm(M,(F,V <- T),S) = - if S == none then - recSimplifyForm(M,F << (V <- T),V <- T) - else - recSimplifyForm(M,F << (V <- T),(S << (V <- T)) ; V <- T) - fi . - ceq $recSimplifyForm(M,(F,none),S) = - if F == F' then (F,S') else recSimplifyForm(M,F',S') fi - if F' := removeRedundantLits(simplifyForm(M,F)) - /\ S' := simplifyBindings(M,S) . - - --- INP: Module Substitution (SubstitutionPair) - --- PRE: Substitution is well-formed with respect to module - --- OUT: Split substitution S into pair (S1,S2) where S = S1 ; S2 - --- and each V <- T in S1 has ctor-term?(M,T) holds - op $filterBindingsByCtor : Module Substitution SubstitutionPair -> SubstitutionPair . - eq filterBindingsByCtor(M,S) = $filterBindingsByCtor(M,S,(none,none)) . - eq $filterBindingsByCtor(M,V <- T ; S,(S1,S2)) = - if ctor-term?(M,T) then $filterBindingsByCtor(M,S,(S1 ; V <- T,S2)) - else $filterBindingsByCtor(M,S,(S1,S2 ; V <- T)) fi . - eq $filterBindingsByCtor(M,none,(S1,S2)) = (S1,S2) . - - --- INP: Bool VariableSet Substitution - --- PRE: None - --- OUT: Split substitution S into pair (S1,S2) where S = S1 ; S2 - --- and each V <- T in S1 has V in VariableSet holds - op filterBindingsByVars : VariableSet Substitution -> SubstitutionPair . - op $filterBindingsByVars : VariableSet Substitution SubstitutionPair -> SubstitutionPair . - eq filterBindingsByVars(VS,S) = $filterBindingsByVars(VS,S,(none,none)) . - eq $filterBindingsByVars(VS,V <- T ; S,(S1,S2)) = - if V in VS then $filterBindingsByVars(VS,S,(S1 ; V <- T,S2)) - else $filterBindingsByVars(VS,S,(S1,S2 ; V <- T)) fi . - eq $filterBindingsByVars(VS,none,(S1,S2)) = (S1,S2) . - - --- INP: Module Form - --- PRE: FOForm should be well-formed, Module should satisfy executability requirments - --- OUT: A form where all terms have been meta-reduced - eq simplifyForm(M,F /\ F') = simplifyForm(M,F) /\ simplifyForm(M,F') . - eq simplifyForm(M,T ?= T') = getTerm(metaReduce(M,T)) ?= getTerm(metaReduce(M,T')) . - eq simplifyForm(M,T != T') = getTerm(metaReduce(M,T)) != getTerm(metaReduce(M,T')) . - eq simplifyForm(M,L) = L [owise] . - - --- INP: Module Substitution - --- PRE: Substitution should be well-formed, Module should satisfy executability requirments - --- OUT: A substitution where all terms have been meta-reduced - eq simplifyBindings(M,V <- T ; S) = V <- getTerm(metaReduce(M,T)) ; simplifyBindings(M,S) . - eq simplifyBindings(M,none) = none . - - --- INP: FOForm - --- PRE: None - --- OUT: A form where redundant elements are deleted (by assoc-comm) - eq removeRedundantLits(L /\ L /\ F?) = L /\ F? . - eq removeRedundantLits(L \/ L \/ F?) = L /\ F? . - eq removeRedundantLits(F) = F [owise] . - - --- INP: FOForm - --- PRE: None - --- OUT: All literals L in FOForm that are ground are removed - eq removeGround(F /\ F') = removeGround(F) /\ removeGround(F') . - eq removeGround(F \/ F') = removeGround(F) \/ removeGround(F') . - eq removeGround(L:Atom) = if vars(L:Atom) =/= none then L:Atom else tt fi . -endfm ----) - -fmod FOFORM-PRINTER is pr FOFORM . pr GENERIC-PRINTER . - op print : Module QFForm? -> QidList . - op printImp : Module QFForm? -> QidList . - var M : Module . var F F' : QFForm . var T T' : Term . - --- print formulas - eq print(M,F /\ F') = '`( print(M,F) '/\ print(M,F') '`) . - eq print(M,F \/ F') = '`( print(M,F) '\/ print(M,F') '`) . - eq print(M,T ?= T') = print(M,T) '= print(M,T') . - eq print(M,T != T') = print(M,T) '=/= print(M,T') . - eq print(M,~ F) = '~ print(M,F) . - eq print(M,mtForm) = 'true . - eq print(M,tt) = 'true . - eq print(M,ff) = 'false . - eq print(M,F:[QFForm?]) = 'Error: 'Cannot 'Print 'Ill-formed 'Formula [owise] . - --- print formulas as implication - eq printImp(M,(~ F) \/ F') = print(M,F) &sp '=> &sp print(M,F') . -endfm - -fmod FOFORMSET-PRINTER is pr FOFORMSET . pr FOFORM-PRINTER . - op print : Module Qid QFForm?Set -> QidList . - var M : Module . var F F' : QFForm? . var FS : QFForm?Set . var Q : Qid . - --- print formula sets - eq print(M,Q,F | F | FS) = print(M,F) Q print(M,F | FS) . - eq print(M,Q,F) = print(M,F) . - eq print(M,Q,mtFormSet) = 'None . -endfm - ---- this module defines a generic structure to represent the success/failure ---- of a formula reduction --- which also includes an optional status code: ---- true/false/unknown/errb --- to represent the result of the reduction -fmod GENERIC-FORMULA-REDUCTION is - pr MAYBE-BOOL . - pr FOFORMSET . - sort QFFormSetBoolPair . - op ((_,_)) : QFForm?Set MaybeBool -> QFFormSetBoolPair [ctor] . - --- - op true? : QFFormSetBoolPair -> Bool . - op bool : QFFormSetBoolPair -> MaybeBool . - op form : QFFormSetBoolPair -> QFForm?Set . - --- projections - var B : MaybeBool . var F : QFForm?Set . - eq true?((F,B)) = B == true . - eq form ((F,B)) = F . - eq bool ((F,B)) = B . -endfm - ---- NOTE: implementing this kind of module REALLY should be the first ---- step in building a theorem prover, i.e. the ideal theorem ---- prover should produce a proof witness as its result that can ---- be inspected and validated ---- NOTE: implementing this here makes NO sense because this file is ---- NOT a theorem prover---we keep this only as a reference -fmod PROOF-WITNESS is - pr FOFORM . - --- Kinds of Proofs - sort SatWitness ValWitness Witness . - subsort SatWitness ValWitness < Witness . - subsort ValWitness < SatWitness . - --- Proof witnesses have projections - op pi : Witness -> FOForm . --- the formula proved - op algebra : Witness -> Module . --- Maude module which corresponds to algebra class - op verify : Witness -> Bool . --- verify if the proof object is correct for algebra/formula - op complete : Witness -> Bool . --- if this witness was generated by a complete method - op ctor : Witness -> Bool . --- if this witness was generated by a constructive proof method - --- Default non-constructive proofs - op sat2val : SatWitness -> ValWitness [ctor] . - op val2sat : ValWitness -> SatWitness [ctor] . - --- Default non-construcitive proof verifier - var SW : SatWitness . var VW : ValWitness . - eq verify(sat2val(SW)) = complete(SW) and-then verify(SW) . - eq verify(val2sat(VW)) = complete(VW) and-then verify(VW) . - eq pi(sat2val(SW)) = ~ pi(SW) . - eq pi(val2sat(VW)) = ~ pi(VW) . - eq algebra(sat2val(SW)) = algebra(SW) . - eq algebra(val2sat(VW)) = algebra(VW) . - eq complete(sat2val(SW)) = complete(SW) . - eq complete(val2sat(VW)) = complete(VW) . - eq ctor(sat2val(SW)) = false . - eq ctor(val2sat(VW)) = false . -endfm - ---- this module defines a "pretty" printer for core Maude, i.e. ---- defines new syntax that stands out better than the old syntax ---- NB: such pretty printing should always occur before display to ---- the user and not earlier because otherwise the user will ---- have to extend their functions to deal with the new ---- constructors that we invent here. -fmod FOFORM-CORE-PRETTYPRINT is - pr FOFORM . - - --- syntax for (respectively): - --- positive predicates - --- negative predicates - --- implications - op ##_ : Term -> QFForm [ctor format(g o o)] . - op !!_ : Term -> QFForm [ctor format(g o o)] . - op _=>_ : QFForm QFForm -> QFForm [ctor format(o rn on d)] . - - var F F' : QFForm . var Q : Qid . var T : Term . - var TA : TruthAtom . var E : EqAtom . - - op prettyPrint : Qid QFForm -> QFForm . - eq prettyPrint(Q,F /\ F') = prettyPrint(Q,F) /\ prettyPrint(Q,F') . - eq prettyPrint(Q,(~ F) \/ F') = prettyPrint(Q,F) => prettyPrint(Q,F') . - eq prettyPrint(Q,F \/ F') = prettyPrint(Q,F) \/ prettyPrint(Q,F') [owise] . - eq prettyPrint(Q,~ F) = ~ prettyPrint(Q,F) . - eq prettyPrint(Q,TA) = TA . - eq prettyPrint(Q,Q != T) = !! T . - eq prettyPrint(Q,Q ?= T) = ## T . - eq prettyPrint(Q,E) = E [owise] . -endfm - ---- Views for some of our formula datatypes ---- NeSet -view FOForm from TRIV to FOFORM is sort Elt to FOForm . endv -view QFForm from TRIV to FOFORM is sort Elt to QFForm . endv -view AEQForm from TRIV to FOFORM is sort Elt to AEQForm . endv -view Conj from TRIV to FOFORM is sort Elt to Conj . endv -view Disj from TRIV to FOFORM is sort Elt to Disj . endv -view PosConj from TRIV to FOFORM is sort Elt to PosConj . endv -view PosDisj from TRIV to FOFORM is sort Elt to PosDisj . endv -view NegConj from TRIV to FOFORM is sort Elt to NegConj . endv -view NegDisj from TRIV to FOFORM is sort Elt to NegDisj . endv ---- Set -view FOForm? from TRIV to FOFORM is sort Elt to FOForm? . endv -view QFForm? from TRIV to FOFORM is sort Elt to QFForm? . endv -view AEQForm? from TRIV to FOFORM is sort Elt to AEQForm? . endv -view Conj? from TRIV to FOFORM is sort Elt to Conj? . endv -view Disj? from TRIV to FOFORM is sort Elt to Disj? . endv -view PosConj? from TRIV to FOFORM is sort Elt to PosConj? . endv -view PosDisj? from TRIV to FOFORM is sort Elt to PosDisj? . endv -view NegConj? from TRIV to FOFORM is sort Elt to NegConj? . endv -view NegDisj? from TRIV to FOFORM is sort Elt to NegDisj? . endv ---- FOFormSubstPair -view FOFormSubstPair from TRIV to FOFORMSUBSTITUTION-PAIR is sort Elt to FOFormSubstPair . endv +load ../meta/foform.maude diff --git a/contrib/tools/varsat/meta-aux.maude b/contrib/tools/varsat/meta-aux.maude index 51805b4f..62425b60 100644 --- a/contrib/tools/varsat/meta-aux.maude +++ b/contrib/tools/varsat/meta-aux.maude @@ -3,2063 +3,4 @@ --- desc: This file extends the meta-level --- with many additional operations ---- ----# TERMS, TERMSETS, QIDSETS, AND REFINEMENTS ---- - -load ../meta/terms.maude -load prelude-aux.maude - -fmod TERM-EXTRA is - pr META-LEVEL . - op vars : Term -> QidSet . - op vars : TermList -> QidSet . - op getName : QidSet -> [QidSet] . - op getType : QidSet -> [QidSet] . - op filterByType : QidSet TypeSet -> [QidSet] . - op varsToTermList : QidSet -> [TermList] . - op subterms : Term -> TermList . - op repeatedNames : QidSet -> QidSet . - op $repeatedNames : QidSet QidSet QidSet -> QidSet . - - var TQ : TermQid . var Q : Qid . var QS QS' QS'' : QidSet . var V : Variable . - var T : Term . var NTL : NeTermList . var C : Constant . var TS : TypeSet . - var M : Module . var TL : TermList . - - eq vars(V) = V . - eq vars(C) = none . - eq vars(Q[NTL]) = vars(NTL) . - eq vars(empty) = none . - eq vars((T, TL)) = vars(T) ; vars(TL) . - - --- INP: QidSet - --- PRE: Each Qid in QidSet is a TermQid - --- OUT: QidSet composed of the name/sort of each TermQid - eq getName(TQ ; Q ; QS) = getName(TQ) ; getName(Q ; QS) . - eq getName(none) = none . - eq getType(TQ ; Q ; QS) = getType(TQ) ; getType(Q ; QS) . - eq getType(none) = none . - - --- INP: QidSet - --- PRE: Each Qid in QidSet is a TermQid - --- OUT: Set of names (obtained by getName) which are not unique - eq repeatedNames(QS) = $repeatedNames(QS,none,none) . - eq $repeatedNames(TQ ; QS,QS',QS'') = if getName(TQ) in QS' then $repeatedNames(QS,QS',QS'' ; getName(TQ)) - else $repeatedNames(QS,QS' ; getName(TQ),QS'') fi . - eq $repeatedNames(none,QS',QS'') = QS'' . - - --- INP: QidSet - --- PRE: Each Qid in QidSet is a TermQid - --- OUT: QidSet composed of only those TermQids who Type is in TypeSet - eq filterByType(TQ ; QS,TS) = - if getType(TQ) in TS then TQ else none fi ; filterByType(QS,TS) . - eq filterByType(none,TS) = none . - - --- INP: QidSet - --- PRE: Each Qid in QidSet is a Variable - --- OUT: A TermList where each Variable occurs in an undefined order - eq varsToTermList(V ; QS) = V,varsToTermList(QS) . - eq varsToTermList(none) = empty . - - --- INP: Term - --- PRE: None - --- OUT: The list of subterms from this term - eq subterms(Q[NTL]) = NTL . - eq subterms(C) = empty . - eq subterms(V) = empty . -endfm - -fmod GTERMLIST-REFINEMENT is - pr META-TERM . - sort GTerm NeGTermList . - subsort Term Context < GTerm < NeGTermList < GTermList . - subsort NeTermList NeCTermList < NeGTermList . - op _,_ : NeGTermList GTermList -> NeGTermList [ctor ditto] . - op _,_ : GTermList NeGTermList -> NeGTermList [ctor ditto] . -endfm - -fmod TERMSET-FM is - pr META-LEVEL . - pr TERM-SET . -endfm - -fmod QIDSET-REFINEMENT is - pr META-MODULE . - --- - sort VariableSet ConstantSet TermQidSet . - sort NeVariableSet NeConstantSet NeTermQidSet . - --- - subsort Variable < NeVariableSet < VariableSet . - subsort Constant < NeConstantSet < ConstantSet . - subsort TermQid < NeTermQidSet < TermQidSet . - --- - subsort EmptyTypeSet < ConstantSet VariableSet . - subsort VariableSet ConstantSet < TermQidSet . - subsort NeVariableSet NeConstantSet < NeTermQidSet . - --- - subsort TermQidSet < QidSet . - subsort NeTermQidSet < NeQidSet . - --- - op _;_ : TermQidSet TermQidSet -> TermQidSet [ctor ditto] . - op _;_ : NeTermQidSet TermQidSet -> NeTermQidSet [ctor ditto] . - op _;_ : ConstantSet ConstantSet -> ConstantSet [ctor ditto] . - op _;_ : NeConstantSet ConstantSet -> NeConstantSet [ctor ditto] . - op _;_ : VariableSet VariableSet -> VariableSet [ctor ditto] . - op _;_ : NeVariableSet VariableSet -> NeVariableSet [ctor ditto] . -endfm - ---- ----# Module Operations ---- - -fmod UNIT-FM is - inc META-LEVEL . - - op noModule : -> Module [ctor] . - - op emptyFModule : -> FModule . - eq emptyFModule = fmod 'fmod is nil sorts none . none none none none endfm . - op emptyFTheory : -> FModule . - eq emptyFTheory = fth 'fth is nil sorts none . none none none none endfth . - op emptySModule : -> SModule . - eq emptySModule = mod 'mod is nil sorts none . none none none none none endm . - op emptySTheory : -> SModule . - eq emptySTheory = th 'th is nil sorts none . none none none none none endth . - - op getName : Module -> Header . - op getPars : Module -> ParameterDeclList . - - op setName : Module ModuleExpression -> Module . - op setName : Module ParameterDecl -> Module . - op setPars : Module ParameterDeclList -> Module . - op setImports : Module ImportList -> Module . - op setSorts : Module SortSet -> Module . - op setSubsorts : Module SubsortDeclSet -> Module . - op setOps : Module OpDeclSet -> Module . - op setMbs : Module MembAxSet -> Module . - op setEqs : Module EquationSet -> Module . - op setRls : Module RuleSet ~> Module . - - op addImports : ImportList Module -> Module . - op addSorts : SortSet Module -> Module . - op addSubsorts : [SubsortDeclSet] Module -> Module . - op addOps : [OpDeclSet] Module -> Module . - op addMbs : MembAxSet Module -> Module . - op addEqs : EquationSet Module -> Module . - op addRls : RuleSet Module -> Module . - op addDecls : Module Module -> Module . - - vars M M' M'' : Module . - vars SSDS SSDS' SSDS'' : SubsortDeclSet . - vars OPD OPD' : OpDecl . - vars OPDS OPDS' : OpDeclSet . - vars MAS MAS' : MembAxSet . - vars Eq Eq' : Equation . - vars EqS EqS' : EquationSet . - vars Rl Rl' : Rule . - vars RlS RlS' : RuleSet . - vars SS SS' : SortSet . - vars IL IL' : ImportList . - vars PL PL' : ParameterList . - vars U U' : Module . - vars I I' : Import . - vars ME ME' : ModuleExpression . - vars PD PD' : ParameterDecl . - vars PDL PDL' : ParameterDeclList . - var H H' : Header . - - eq getName(noModule) = ' . - eq getName(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = ME . - eq getName(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = ME . - eq getName(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = H . - eq getName(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm) = ME . - eq getName(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm) = ME . - eq getName(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = H . - - eq getImports(noModule) = nil . - eq getImports(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = IL . - eq getImports(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = IL . - eq getImports(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = IL . - eq getImports(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = IL . - - eq getPars(noModule) = nil . - eq getPars(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = nil . - eq getPars(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = PDL . - eq getPars(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = nil . - eq getPars(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = nil . - eq getPars(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm) = nil . - eq getPars(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm) = PDL . - eq getPars(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = nil . - - eq getSorts(noModule) = none . - eq getSorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = SS . - eq getSorts(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = SS . - eq getSorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = SS . - eq getSorts(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = SS . - - eq getSubsorts(noModule) = none . - eq getSubsorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = SSDS . - eq getSubsorts(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = SSDS . - eq getSubsorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = SSDS . - eq getSubsorts(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = SSDS . - - eq getOps(noModule) = none . - eq getOps(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = OPDS . - eq getOps(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = OPDS . - eq getOps(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = OPDS . - eq getOps(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = OPDS . - - eq getMbs(noModule) = none . - eq getMbs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = MAS . - eq getMbs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = MAS . - eq getMbs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = MAS . - eq getMbs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = MAS . - - eq getEqs(noModule) = none . - eq getEqs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = EqS . - eq getEqs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = EqS . - eq getEqs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = EqS . - eq getEqs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = EqS . - - eq getRls(noModule) = none . - eq getRls(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = RlS . - eq getRls(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = RlS . - eq getRls(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none . - eq getRls(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none . - - eq setImports(noModule, IL) = noModule . - eq setImports(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, IL') - = mod H is IL' sorts SS . SSDS OPDS MAS EqS RlS endm . - eq setImports(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, IL') - = th H is IL' sorts SS . SSDS OPDS MAS EqS RlS endth . - eq setImports(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, IL') - = fmod H is IL' sorts SS . SSDS OPDS MAS EqS endfm . - eq setImports(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, IL') - = fth H is IL' sorts SS . SSDS OPDS MAS EqS endfth . - - eq setOps(noModule, OPDS) = noModule . - eq setOps(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, OPDS') - = mod H is IL sorts SS . SSDS OPDS' MAS EqS RlS endm . - eq setOps(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, OPDS') - = th H is IL sorts SS . SSDS OPDS' MAS EqS RlS endth . - eq setOps(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, OPDS') - = fmod H is IL sorts SS . SSDS OPDS' MAS EqS endfm . - eq setOps(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, OPDS') - = fth H is IL sorts SS . SSDS OPDS' MAS EqS endfth . - - eq setSubsorts(noModule, SSDS) = noModule . - eq setSubsorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SSDS') - = mod H is IL sorts SS . SSDS' OPDS MAS EqS RlS endm . - eq setSubsorts(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, SSDS') - = th H is IL sorts SS . SSDS' OPDS MAS EqS RlS endth . - eq setSubsorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, SSDS') - = fmod H is IL sorts SS . SSDS' OPDS MAS EqS endfm . - eq setSubsorts(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, SSDS') - = fth H is IL sorts SS . SSDS' OPDS MAS EqS endfth . - - eq setMbs(noModule, MAS) = noModule . - eq setMbs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, MAS') - = mod H is IL sorts SS . SSDS OPDS MAS' EqS RlS endm . - eq setMbs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MAS') - = th H is IL sorts SS . SSDS OPDS MAS' EqS RlS endth . - eq setMbs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, MAS') - = fmod H is IL sorts SS . SSDS OPDS MAS' EqS endfm . - eq setMbs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, MAS') - = fth H is IL sorts SS . SSDS OPDS MAS' EqS endfth . - - eq setEqs(noModule, EqS) = noModule . - eq setEqs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, EqS') - = mod H is IL sorts SS . SSDS OPDS MAS EqS' RlS endm . - eq setEqs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, EqS') - = th H is IL sorts SS . SSDS OPDS MAS EqS' RlS endth . - eq setEqs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, EqS') - = fmod H is IL sorts SS . SSDS OPDS MAS EqS' endfm . - eq setEqs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, EqS') - = fth H is IL sorts SS . SSDS OPDS MAS EqS' endfth . - - eq setRls(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, RlS') - = mod H is IL sorts SS . SSDS OPDS MAS EqS RlS' endm . - eq setRls(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, RlS') - = th H is IL sorts SS . SSDS OPDS MAS EqS RlS' endth . - eq setRls(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, RlS) - = if RlS == none - then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm - else mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm - fi . - eq setRls(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, RlS) - = if RlS == none - then fth H is IL sorts SS . SSDS OPDS MAS EqS endfth - else th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth - fi . - - eq setSorts(noModule, SS) = noModule . - eq setSorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SS') - = mod H is IL sorts SS' . SSDS OPDS MAS EqS RlS endm . - eq setSorts(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, SS') - = th H is IL sorts SS' . SSDS OPDS MAS EqS RlS endth . - eq setSorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, SS') - = fmod H is IL sorts SS' . SSDS OPDS MAS EqS endfm . - eq setSorts(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, SS') - = fth H is IL sorts SS' . SSDS OPDS MAS EqS endfth . - - eq setPars(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm, PDL) - = if PDL == nil - then mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm - else mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm - fi . - eq setPars(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm, PDL') - = if PDL' == nil - then mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm - else mod ME{PDL'} is IL sorts SS . SSDS OPDS MAS EqS RlS endm - fi . - eq setPars(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, PDL) - = th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth . - eq setPars(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm, PDL) - = if PDL == nil - then fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm - else fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm - fi . - eq setPars(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm, PDL') - = if PDL' == nil - then fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm - else fmod ME{PDL'} is IL sorts SS . SSDS OPDS MAS EqS endfm - fi . - eq setPars(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, PDL) - = fth H is IL sorts SS . SSDS OPDS MAS EqS endfth . - - eq setName(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm, ME') - = mod ME' is IL sorts SS . SSDS OPDS MAS EqS RlS endm . - eq setName(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm, ME') - = mod ME'{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm . - eq setName(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm, ME') - = fmod ME' is IL sorts SS . SSDS OPDS MAS EqS endfm . - eq setName(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm, ME') - = fmod ME'{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm . - eq setName(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, H') - = fth H' is IL sorts SS . SSDS OPDS MAS EqS endfth . - eq setName(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, H') - = th H' is IL sorts SS . SSDS OPDS MAS EqS RlS endth . - eq setName(noModule, ME) = noModule . - - eq addSorts(SS, U) = setSorts(U, (SS ; getSorts(U))) . - eq addSorts(SS, noModule) = noModule . - eq addSubsorts(SSDS, U) = setSubsorts(U, (SSDS getSubsorts(U))) . - eq addSubsorts(SSDS, noModule) = noModule . - eq addOps(OPDS, U) = setOps(U, (OPDS getOps(U))) . - eq addMbs(MAS, U) = setMbs(U, (MAS getMbs(U))) . - eq addMbs(MAS, noModule) = noModule . - eq addEqs(EqS, U) = setEqs(U, (EqS getEqs(U))) . - eq addEqs(EqS, noModule) = noModule . - eq addRls(RlS, U) = setRls(U, (RlS getRls(U))) . - eq addRls(RlS, noModule) = noModule . - eq addImports(IL, U) = setImports(U, (getImports(U) IL)) . - eq addImports(IL, noModule) = noModule . - - eq addDecls(noModule, U) = U . - eq addDecls(U, noModule) = U . - eq addDecls(U, U') - = addImports(getImports(U'), - addSorts(getSorts(U'), - addSubsorts(getSubsorts(U'), - addOps(getOps(U'), - addMbs(getMbs(U'), - addEqs(getEqs(U'), - if U' :: FModule or U' :: FTheory - then U - else addRls(getRls(U'),U) - fi)))))) - [owise] . -endfm - -fmod MOD-EXTRA is - pr UNIT-FM . - op protecting? : ModuleExpression ImportList -> Bool . - op setRls : Module QidList -> [Module] . - op setRls : QidList RuleSet RuleSet -> [RuleSet] . - op getModQid : Import -> Qid . - op getImports2 : Module -> [ImportList] . - op getImports2 : Qid -> [ImportList] . - op getImports2 : ImportList ImportList -> [ImportList] . - op getImports2 : Module ImportList ImportList -> [ImportList] . - - var ME ME' : ModuleExpression . var M M' : Module . var I : Import . - var Q : Qid . var QL : QidList . var L R : Term . var A : AttrSet . - var RL : Rule . var RS RS' : RuleSet . var C : Condition . - var IL IL1 IL2 : ImportList . - - --- INP: ModuleExpression ImportList - --- PRE: None - --- OUT: true iff ModuleExpression is protected in ImportList - eq protecting?(ME,protecting ME' . IL) = ME == ME' or-else protecting?(ME,IL) . - eq protecting?(ME,I IL) = protecting?(ME,IL) [owise] . - eq protecting?(ME,nil) = false . - - --- INP: Module QidList - --- PRE: Each Qid in QidList refers to a rule label in Module - --- OUT: Set of rules which are labelled with any Qid in QidList - eq setRls(M,QL) = setRls(M,setRls(QL,getRls(M),none)) . - eq setRls(Q QL,rl L => R [label(Q) A]. RS,RS') = setRls(Q QL,RS,rl L => R [label(Q) A]. RS') . - eq setRls(Q QL,RS,RL RS') = setRls(QL,RS,none) RL RS' [owise] . - eq setRls(nil,RS,none) = none . - - --- INP: Module/Qid (name of Module) - --- PRE: Module (and all of its recursive imports) have names that are Qids - --- OUT: ImportList that contains imports of this module and its dependencies - eq getImports2(M) = getImports2(getName(M)) . - eq getImports2(Q) = getImports2(getImports(upModule(Q,false)),nil) . - eq getImports2(I IL,IL1 I IL2) = getImports2(IL,IL1 I IL2) . - eq getImports2(nil,IL2) = IL2 . - eq getImports2(I IL,IL2) = getImports2(upModule(getModQid(I),false),IL,IL2 I) [owise] . - eq getImports2(M,IL,IL2) = getImports2(getImports(M) IL,IL2) . - - --- INP: Import - --- PRE: ModuleExpression in Import is a Qid - --- OUT: Qid that corresponds to the Module name in this Import - eq getModQid(protecting Q .) = Q . - eq getModQid(including Q .) = Q . - eq getModQid(extending Q .) = Q . -endfm - -fmod MODQIDPAIR is - pr META-LEVEL . - sort ModQidPair . - op ((_,_)) : Module Qid -> ModQidPair [ctor] . -endfm - -view ModQidPair from TRIV to MODQIDPAIR is sort Elt to ModQidPair . endv - -fmod MODQIDLIST is - pr LIST{ModQidPair} * (sort List{ModQidPair} to ModQidList) . -endfm - -view ModQidList from TRIV to MODQIDLIST is sort Elt to ModQidList . endv - -fmod SCOPED-REGISTRY is - pr MAP-EXTRA{Qid,ModQidList} * (sort Map{Qid,ModQidList} to ScopedRegistry) . - pr UNIT-FM . - - var Task Impl : Qid . - var ImplMod : Module . - var ImplList ImplList' : ModQidList . - var Registry : ScopedRegistry . - - op getbackend : Qid Qid ScopedRegistry -> Module . - eq getbackend(Task,Impl,(Task |-> (ImplList (ImplMod,Impl) ImplList'),Registry)) = ImplMod . - eq getbackend(Task,Impl,Registry) = noModule [owise] . -endfm - -view Module from TRIV to META-MODULE is sort Elt to Module . endv - -fmod MODULE-LIST is - pr LIST{Module} * - (op nil : -> List{Module} to nilmod, - op __ : List{Module} List{Module} -> List{Module} to _;_, - sort List{Module} to ModuleList, - sort NeList{Module} to NeModuleList) . -endfm - ---- ----# Substitution, Substitution Sets, and Refinements ---- - -fmod SUBSTITUTION-HANDLING is - protecting META-MODULE . - - var S S' Subst Subst' : Substitution . - var V V' : Variable . - var C C' : Constant . - var Ct : Context . - var T T' T1 T2 T1' T2' T1'' T2'' : Term . - var F F' : Qid . - var TL TL' TL1 TL2 TL1' TL2' : TermList . - var Att : AttrSet . - var RLS : RuleSet . - var Rl : Rule . - var TP : Type . - var N : Nat . - var NeTL : NeTermList . - var CtL : NeCTermList . - - --- Apply Substitution to Term -------------------------------------------- - op _<<_ : Term Substitution -> Term . - eq TL << none = TL . - eq C << Subst = C . - eq V << ((V <- T) ; Subst) = T . - eq V << Subst = V [owise] . - eq F[TL] << Subst = F[TL << Subst] . - - op _<<_ : TermList Substitution -> TermList . - eq (T, NeTL) << Subst = (T << Subst, NeTL << Subst) . - eq empty << Subst = empty . - - op _<<_ : Context Substitution -> Context . - eq Ct << none = Ct . - eq [] << Subst = [] . - eq F[CtL,NeTL] << Subst = F[CtL << Subst,NeTL << Subst] . - eq F[NeTL,CtL] << Subst = F[NeTL << Subst, CtL << Subst] . - eq F[Ct] << Subst = F[Ct << Subst] . - - op _<<_ : Substitution Substitution -> Substitution . - eq S << (none).Substitution = S . - eq (none).Substitution << S = (none).Substitution . - eq ((V' <- T) ; S') << S - = (V' <- (T << S)) - ; - (S' << S) . - - --- Combine Substitutions ------------------------------------------------- - op _.._ : Substitution Substitution -> Substitution . - eq S .. S' = (S << S') ; S' . - - --- Restrict Assignments to Variables in a Term ---------------------- - op _|>_ : Substitution TermList -> Substitution . - - eq Subst |> TL = Subst |>* Vars(TL) . - - op _|>*_ : Substitution TermList -> Substitution . ---- eq noMatch |>* TL = noMatch . - eq Subst |>* TL = Subst |>** TL [none] . - - op _|>**_[_] : Substitution TermList - Substitution -> Substitution . - eq none |>** TL [Subst'] - = Subst' . - eq ((V <- V) ; Subst) |>** TL [Subst'] - = Subst |>** TL [Subst'] . - eq ((V <- T') ; Subst) |>** TL [Subst'] - = Subst |>** TL - [Subst' ; if any V in TL then (V <- T') else none fi] . - - --- Remove Variables from list ---------------------- - op _intersect_ : TermList TermList -> TermList . - eq (TL1,T,TL2) intersect (TL1',T,TL2') - = (T,((TL1,TL2) intersect (TL1',TL2'))) . - eq TL intersect TL' = empty [owise] . - - op _intersectVar_ : TermList TermList -> TermList . - eq TL1 intersectVar TL2 - = TL1 intersectVar* Vars(TL2) . - - op _intersectVar*_ : TermList TermList -> TermList . - eq (T,TL1) intersectVar* TL2 - = (if any Vars(T) in TL2 then T else empty fi,TL1 intersectVar* TL2) . - eq empty intersectVar* TL2 - = empty . - - --- Remove Variables from list ---------------------- - op _setMinus_ : TermList TermList -> TermList . - eq (TL1,T,TL2) setMinus (TL1',T,TL2') - = (TL1,TL2) setMinus (TL1',T,TL2') . - eq TL setMinus TL' = TL [owise] . - - --- Variables --- - op Vars : GTermList -> TermList . - eq Vars((T,TL:GTermList)) = VarsTerm(T),Vars(TL:GTermList) . - eq Vars((Ct,TL:GTermList)) = VarsTerm(Ct),Vars(TL:GTermList) . - eq Vars(empty) = empty . - - op VarsTerm : Term -> TermList . ---warning memo - eq VarsTerm(V) = V . - eq VarsTerm(F[TL:TermList]) = Vars(TL:TermList) . - eq VarsTerm(C) = empty . - - op VarsTerm : Context -> TermList . ---warning memo - eq VarsTerm(F[TL:GTermList]) = Vars(TL:GTermList) . - - --- membership --- - op _in_ : Term TermList -> Bool . - eq T in (TL,T,TL') = true . - eq T in TL = false [owise] . - - --- membership --- - op any_in_ : TermList TermList -> Bool . --- [memo] . - eq any empty in TL = false . - eq any (TL1,T,TL2) in (TL1',T,TL2') = true . - eq any TL in TL' = false [owise] . - - --- membership --- - op all_in_ : TermList TermList -> Bool . --- [memo] . - eq all empty in TL = true . - eq all (TL1,T,TL2) in (TL1',T,TL2') = all (TL1,TL2) in (TL1',T,TL2') . - eq all TL in TL' = false [owise] . - - --- Occur check --- - op allVars_inVars_ : GTermList GTermList -> Bool . - eq allVars TL:GTermList inVars TL':GTermList - = all Vars(TL:GTermList) in Vars(TL':GTermList) . - - op anyVars_inVars_ : GTermList GTermList -> Bool . - eq anyVars TL:GTermList inVars TL':GTermList - = any Vars(TL:GTermList) in Vars(TL':GTermList) . - - op rangeVars : Substitution -> TermList . - eq rangeVars(V <- T ; Subst) = (Vars(T),rangeVars(Subst)) . - eq rangeVars(none) = empty . - - op dom_inVars_ : Substitution TermList -> Bool . - eq dom Subst inVars TL = dom Subst in Vars(TL) . - - op dom_in_ : Substitution TermList -> Bool . - eq dom (V <- T ; Subst) in (TL1,V,TL2) = true . - eq dom Subst in TL = false [owise] . - - op dom_notInVars_ : Substitution TermList -> Bool . - eq dom Subst notInVars TL = dom Subst notIn Vars(TL) . - - op dom_notIn_ : Substitution TermList -> Bool . - eq dom none notIn TL = true . - ceq dom (V <- T ; Subst) notIn TL = true if not (V in TL) . - eq dom Subst notIn TL = false [owise] . - - op range_inVars_ : Substitution TermList -> Bool . - eq range Subst inVars TL = range Subst in Vars(TL) . - - op range_in_ : Substitution TermList -> Bool . - eq range (V <- T ; Subst) in TL - = any Vars(T) in TL or-else range Subst in TL . - eq range none in TL - = false . - - op valid-occur-check? : Substitution -> Bool . - eq valid-occur-check?(Subst) - = not (dom Subst inVars (rangeVars(Subst))) . - - op extract-bindings : Substitution -> TermList . - eq extract-bindings(none) = empty . - eq extract-bindings(V <- T ; Subst) = (T,extract-bindings(Subst)) . -endfm - -fmod SUBSTITUTIONSET is - protecting SUBSTITUTION-SET . - protecting SUBSTITUTION-HANDLING . - protecting TERMSET-FM . - - vars SS SS' : SubstitutionSet . - vars S S' Subst : Substitution . - vars T T' : Term . - vars TL TL' : TermList . - vars N N' : Nat . - var V : Variable . - - op _..._ : SubstitutionSet [SubstitutionSet] - -> SubstitutionSet [strat (1) gather (e E)] . - - eq .SubstitutionSet ... SS':[SubstitutionSet] = .SubstitutionSet . - eq (S | SS) ... SS':[SubstitutionSet] - = (S ...' SS':[SubstitutionSet]) - | - (SS ... SS':[SubstitutionSet]) . - - op _...'_ : Substitution SubstitutionSet -> SubstitutionSet . - - eq S ...' .SubstitutionSet - = .SubstitutionSet . - - eq S ...' (S' | SS') - = (S .. S') - | - (S ...' SS') . -endfm - -fmod SUBSTITUTION-REFINEMENT is - pr QIDSET-REFINEMENT . - pr GTERMLIST-REFINEMENT . - sort VarAssignment ConstAssignment GroundAssignment . - sort EmptySubstitution VarSubstitution ConstSubstitution GroundSubstitution . - subsort ConstAssignment < GroundAssignment . - subsort VarAssignment ConstAssignment GroundAssignment < Assignment . - subsort EmptySubstitution < VarSubstitution ConstSubstitution GroundSubstitution < Substitution . - subsort ConstSubstitution < GroundSubstitution . - subsort VarAssignment < VarSubstitution . - subsort ConstAssignment < ConstSubstitution . - subsort GroundAssignment < GroundSubstitution . - op _<-_ : Variable Variable -> VarAssignment [ctor ditto] . - op _<-_ : Variable Constant -> ConstAssignment [ctor ditto] . - op _<-_ : Variable GroundTerm -> GroundAssignment [ctor ditto] . - op none : -> EmptySubstitution [ctor ditto] . - op _;_ : EmptySubstitution EmptySubstitution -> EmptySubstitution [ctor ditto] . - op _;_ : VarSubstitution VarSubstitution -> VarSubstitution [ctor ditto] . - op _;_ : ConstSubstitution ConstSubstitution -> ConstSubstitution [ctor ditto] . - op _;_ : GroundSubstitution GroundSubstitution -> GroundSubstitution [ctor ditto] . - op errsub : QidList -> [Substitution] . - - op errsubMsg : [Substitution] -> QidList . - eq errsubMsg(errsub(QL:QidList)) = QL:QidList . - eq errsubMsg(S:[Substitution]) = nil . -endfm - -fmod SUBSTITUTIONPAIR is - pr SUBSTITUTION-REFINEMENT . - sort SubstitutionPair . - op ((_,_)) : Substitution Substitution -> SubstitutionPair . - ops p1 p2 : SubstitutionPair -> Substitution . - var S1 S2 : Substitution . - eq p1((S1,S2)) = S1 . - eq p2((S1,S2)) = S2 . -endfm - -fmod SUBSTITUTIONPAIRSET is - pr SUBSTITUTIONPAIR . - sort SubstitutionPairSet NeSubstitutionPairSet . - subsort SubstitutionPair < NeSubstitutionPairSet < SubstitutionPairSet . - op empty : -> SubstitutionPairSet [ctor] . - op _|_ : SubstitutionPairSet SubstitutionPairSet -> SubstitutionPairSet - [ctor assoc comm id: empty format (d n d d)] . - op _|_ : NeSubstitutionPairSet SubstitutionPairSet -> NeSubstitutionPairSet - [ctor ditto] . - eq X:SubstitutionPair | X:SubstitutionPair = X:SubstitutionPair . -endfm - -fmod SUBSTITUTION-AUX is - pr SUBSTITUTION-REFINEMENT . - pr TERM-EXTRA . --- defines vars() - op idsub : VariableSet -> VarSubstitution . - op domain : Substitution -> VariableSet . - op range : Substitution -> VariableSet . - op filterNotIn : Substitution VariableSet -> Substitution . - op bound : Variable Substitution -> Bool . - op remove : Substitution Substitution -> Substitution . - - var V : Variable . var T : Term . var S S' : Substitution . var VS : VariableSet . var A : Assignment . - - --- INP: QidSet - --- PRE: None - --- OUT: Identity substitution over VariableSet - eq idsub(V ; VS) = V <- V ; idsub(VS) . - eq idsub(none) = none . - - --- INP: Substitution - --- PRE: None - --- OUT: VariableSet composed of variables mapped to other values - eq domain(V <- T ; S) = V ; domain(S) . - eq domain(none) = none . - - --- INP: Substitution - --- PRE: None - --- OUT: VariableSet containing all variables in codomain of substitution - eq range(V <- T ; S) = vars(T) ; range(S) . - eq range(none) = none . - - --- INP: Subsitution VS:QidSet - --- PRE: None - --- OUT: Substitution where each binding V <- T is - --- filtered out if V occurs in VS - eq filterNotIn(V <- T ; S,VS) = if V in VS then none else V <- T fi ; filterNotIn(S,VS) . - eq filterNotIn(none,VS) = none . - - --- INP: Variable Substitution - --- PRE: None - --- OUT: True iff variable is bound by substitution - eq bound(V,V <- T ; S) = true . - eq bound(V,S) = false [owise] . - - --- INP: Substitution1 Substitution2 - --- PRE: None - --- OUT: a new Substitution identical to Substiution1 but where any assignment in Substitution2 has been removed - eq remove(S ; A,A ; S') = remove(S,A ; S') . - eq remove(S,S') = S [owise] . -endfm - -fmod SUBSTITUTIONSET-AUX is - pr SUBSTITUTION-AUX . - pr SUBSTITUTIONSET . - pr TERMSET-FM . - - var S S' S2 : Substitution . var SS : SubstitutionSet . - var T : Term . var V : Variable . var QS : VariableSet . - var SSK : [SubstitutionSet] . - - --- OUT: QidSet composed of domain() of each substitution - op domain : SubstitutionSet -> VariableSet . - eq domain(S | S' | SS) = domain(S) ; domain(S' | SS) . - eq domain(.SubstitutionSet) = none . - - --- OUT: SubstitutionSet where each substitution binding V <- T is - --- filtered out if V occurs in QS - op filterNotIn : SubstitutionSet VariableSet -> SubstitutionSet . - eq filterNotIn(S | S' | SS,QS) = filterNotIn(S,QS) | filterNotIn(S' | SS,QS) . - eq filterNotIn(.SubstitutionSet,QS) = .SubstitutionSet . - - --- OUT: A TermSet of instances of Term by application with each Substitution in SubstitutionSet - op _<<_ : Term SubstitutionSet -> TermSet . - eq T << (S | S' | SS) = (T << S) | (T << (S' | SS)) . - eq T << .SubstitutionSet = .TermSet . - - - --- OUT: A SubstitutionSet identical to input but where each assignment in Substitution is removed - op remove : SubstitutionSet Substitution -> SubstitutionSet . - eq remove(S | S' | SS,S2) = remove(S,S2) | remove(S | S' | SS,S2) . - eq remove(.SubstitutionSet,S2) = .SubstitutionSet . - - --- OUT: A SubstitutionSet of Assignments built by blowing this Substitution apart - op explode : Substitution -> SubstitutionSet . - eq explode(V <- T ; S) = (V <- T) | explode(S) . - eq explode(none) = .SubstitutionSet . - - --- OUT: Get first error from SubstitutionSet - eq errsubMsg(errsub(QL:QidList) | SSK) = QL:QidList . -endfm - - ---- operations like metaUnify, metaDisjointUnify, etc... generate fresh variable ---- names for all terms invovled---however, sometimes, it is desirable to preserve ---- the variable names originally chosen by the user---this module implemnts a ---- function which will ``reuse'' user-provided variables as often as possible -fmod RECLAIM-VARS is - pr SUBSTITUTION-REFINEMENT . - pr SUBSTITUTIONSET . - pr SUBSTITUTION-AUX . - op reclaim : VariableSet SubstitutionSet -> SubstitutionSet . - op reclaim' : VariableSet Substitution -> [Substitution] . - op reclaim' : VariableSet Substitution Substitution -> Substitution . - op filter : SubstitutionSet -> SubstitutionSet . - - var V : Variable . var T : Term . var S S' : Substitution . var SS : SubstitutionSet . var VS : VariableSet . - - --- INP: VariableSet SubstitutionSet:SS - --- PRE: domain(SS) intersected with range(SS) is empty - --- OUT: A new SubstitutionSet where each substitution is identical - --- to the previous one except that alpha renamings V <- V' - --- are thrown away and replaced by identity mapping V <- V. - ceq reclaim'(VS,S) = reclaim'(VS,S,none) if intersection(domain(S),range(S)) == none . - eq reclaim'(VS,V <- T ; S,S') = if T :: Variable and-then V in VS and-then not T in VS - then reclaim'(VS,S << (T <- V),(S' << (T <- V)) ; V <- V) else reclaim'(VS,S,S' ; V <- T) fi . - eq reclaim'(VS,none,S') = S' . - - eq reclaim(VS,S | SS) = reclaim'(VS,S) | reclaim(VS,SS) . - eq reclaim(VS,.SubstitutionSet) = .SubstitutionSet . - - --- INP: SubsitutionSet - --- PRE: None - --- OUT: An identical SubstitutionSet where each identity - --- mapping V <- V is removed. - eq filter((S ; V <- V) | SS) = filter(S | SS) . - eq filter(SS) = SS [owise] . -endfm - -view Substitution from TRIV to META-LEVEL is sort Elt to Substitution . endv - ---- this module represents a lazily generated stream of substitutions ---- useful for representing the solutions to a unification problem, etc... -fmod SUBSTITUTION-STREAM is - pr STREAM{Substitution} . - pr SUBSTITUTIONSET . - op set : Stream{Substitution} -> SubstitutionSet . - var X : Substitution . var S : [Stream{Substitution}] . - eq set(X & S) = X | set(S) . - eq set(end) = .SubstitutionSet . -endfm - ---- ----# Term/Substitution Pairs ---- - -fmod TERMSUBSTPAIR is - pr META-TERM . - sort TermSubstPair . - op ((_,_)) : Term Substitution -> TermSubstPair [ctor] . -endfm - -fmod TERMSUBSTSETPAIR is - pr TERMSUBSTPAIR . - pr SUBSTITUTIONSET . - sort TermSubstSetPair . - subsort TermSubstPair < TermSubstSetPair . - op ((_,_)) : Term SubstitutionSet -> TermSubstSetPair . -endfm - -fmod TERMSUBSTPAIRSET is - pr TERMSUBSTPAIR . - pr TERMSET-FM . - pr SUBSTITUTIONSET . - sort TermSubstPairSet . - subsort TermSubstPair < TermSubstPairSet . - op _|_ : TermSubstPairSet TermSubstPairSet -> TermSubstPairSet [ctor assoc comm id: emptyTPS] . - op emptyTPS : -> TermSubstPairSet [ctor] . - op _<<_ : TermSubstPairSet SubstitutionSet -> TermSubstPairSet . - op tsp-term : TermSubstPairSet -> TermSet . - op tsp-sub : TermSubstPairSet -> SubstitutionSet . - - var TPS : TermSubstPairSet . var TP TP' : TermSubstPair . var T : Term . var S S' : Substitution . var SS : SubstitutionSet . - - eq tsp-term(TPS | (T,S)) = T | tsp-term(TPS) . - eq tsp-term(emptyTPS) = .TermSet . - eq tsp-sub(TPS | (T,S)) = S | tsp-sub(TPS) . - eq tsp-sub(emptyTPS) = .SubstitutionSet . - - eq (TP | TP' | TPS) << SS = (TP << SS) | ((TP' | TPS) << SS) . - eq emptyTPS << SS = emptyTPS . - eq TP << (S | S' | SS) = (TP << S) | (TP << (S' | SS)) . - eq TP << .SubstitutionSet = emptyTPS . - eq (T,S) << S' = (T << S',S << S') . -endfm - ---- ----# Variants ---- - -fmod VARIANT is - pr SUBSTITUTIONSET . - pr META-LEVEL . - - var M : Module . - vars T T' TS TS' CtTS CtTS' Lhs Rhs : Term . - vars N N' NextVar NextVar' NextVar'' : Nat . - var B : Bound . - var TL TL' : TermList . - var NeTL : NeTermList . - var EqS : EquationSet . - var AtS : AttrSet . - var Q : Qid . - vars S S' : Substitution . - var V : Variable . - vars TP TP' : Type . - var C : Constant . - vars F F' : Qid . - - - sort VariantTripleSet . - subsort Variant < VariantTripleSet . - - op empty : -> VariantTripleSet [ctor] . - op _|_ : VariantTripleSet VariantTripleSet -> VariantTripleSet - [ctor assoc comm id: empty prec 65 format (d d n d)] . - eq X:Variant | X:Variant = X:Variant . - - op getTerms : VariantTripleSet -> TermSet . - eq getTerms({T:Term,S:Substitution,NextVar:Nat,P:Parent,B:Bool} - | R:VariantTripleSet) - = T:Term | getTerms(R:VariantTripleSet) . - eq getTerms((empty).VariantTripleSet) - = .TermSet . - - op getSubstitutions : VariantTripleSet -> SubstitutionSet . - eq getSubstitutions({T:Term,S:Substitution,NextVar:Nat,P:Parent,B:Bool} - | R:VariantTripleSet) = S:Substitution | getSubstitutions(R:VariantTripleSet) . - eq getSubstitutions((empty).VariantTripleSet) - = .SubstitutionSet . -endfm - ---- ----# Type Operations ---- - -fmod TYPE-EXTRA is - pr META-LEVEL . - - --- BASIC TYPE OPERATIONS - op direct-subsorts : Module Type -> SortSet . - op direct-subsorts : SubsortDeclSet Type -> SortSet . - - --- BASIC TYPE SET OPERATIONS - op getMaximalSorts : Module -> SortSet . - op getMaximalSorts : Module KindSet -> SortSet . - - --- BASIC TYPE TUPLE OPERATIONS - op $typeLeq : Module TypeList TypeList -> Bool . - op $typeLeqS : Module TypeList TypeListSet -> Bool . - op typeLeqS : Module TypeListSet TypeListSet -> Bool . - op $typeRel : Module TypeList TypeList -> Bool . - op $typeRelS : Module TypeList TypeListSet -> Bool . - op typeRelS : Module TypeListSet TypeListSet -> Bool . - op greaterSorts : Module Sort -> SortSet . - op $greaterSorts : Module Sort SortSet -> SortSet . - - --- BASIC TYPE TUPLE SET OPERATIONS - op _in_ : TypeList TypeListSet -> Bool . - op _-_ : TypeListSet TypeListSet -> TypeListSet . - op $tydiff : TypeListSet TypeListSet TypeListSet -> TypeListSet . - op intersect : TypeListSet TypeListSet -> TypeListSet . - - --- TYPE TUPLE AUXILLIARY OPERATIONS - op merge : TypeListSet TypeListSet -> TypeListSet . - op $merge1 : TypeListSet TypeListSet TypeListSet -> TypeListSet . - op $merge2 : TypeList TypeListSet TypeListSet -> TypeListSet . - - --- CONVERSIONS - op typeListToSet : TypeList -> TypeSet . - - --- DECL TYPE OPERATIONS - op possibleTypings : Module Qid -> TypeSet . - - var SDS : SubsortDeclSet . - var TYLS TYLS' TYLS'' : TypeListSet . - var TYS : TypeSet . - var TY TY' : Type . - var S S' : Sort . - var K K' : Kind . - var KS : KindSet . - var TYL TYL' TYL'' : TypeList . - var SS SS' : SortSet . - var M : Module . - var Q Q' : Qid . - var ODS : OpDeclSet . - var AS : AttrSet . - var T : Term . - var TL : TermList . - - --- INP: Module Type - --- PRE: Type is well-defined in Module - --- OUT: Set of direct subsorts of Type - eq direct-subsorts(M,S) = direct-subsorts(getSubsorts(M),S) . - eq direct-subsorts(M,K) = maximalSorts(M,K) . - eq direct-subsorts(SDS subsort S' < S .,S) = S' ; direct-subsorts(SDS,S) . - eq direct-subsorts(SDS,TY) = none [owise] . - - --- INP: Module [KindSet] - --- PRE: Kinds are well-defined in Module - --- OUT: Set of maximal sorts of each kind - eq getMaximalSorts(M) = getMaximalSorts(M,getKinds(M)) . - eq getMaximalSorts(M,K ; KS) = maximalSorts(M,K) ; getMaximalSorts(M,KS) . - eq getMaximalSorts(M,none) = none . - - --- INP: Module TypeListSet1 TypeListSet2 - --- PRE: Types in TypeLists are defined in Module - --- OUT: true if every type in TypeListSet1 is a subtype of TypeListSet2 - eq $typeLeq(M,K TYL,S TYL') = false . - eq $typeLeq(M,S TYL,K TYL') = sortLeq(M,S,K) and-then $typeLeq(M,TYL,TYL') . - eq $typeLeq(M,K TYL,K' TYL') = sortLeq(M,K,K') and-then $typeLeq(M,TYL,TYL') . - eq $typeLeq(M,S TYL,S' TYL') = sortLeq(M,S,S') and-then $typeLeq(M,TYL,TYL') . - eq $typeLeq(M,nil,nil) = true . - eq $typeLeq(M,TYL,TYL') = false [owise] . - eq $typeLeqS(M,TYL,TYL' ; TYLS) = - $typeLeq(M,TYL,TYL') and-then $typeLeqS(M,TYL,TYLS) . - eq $typeLeqS(M,TYL,none) = true . - eq typeLeqS(M,TYL ; TYLS,TYLS') = - $typeLeqS(M,TYL,TYLS') and-then typeLeqS(M,TYLS,TYLS') . - eq typeLeqS(M,none,TYLS') = true . - - --- INP: Module TypeListSet1 TypeListSet2 - --- PRE: Types in TypeLists are defined in Module - --- OUT: true if corresponding types in each typelist have the same kind - --- NOTE: the mnemonic typeRel stands for type related - eq $typeRel(M,TY TYL,TY' TYL') = sameKind(M,TY,TY') and $typeRel(M,TYL,TYL') . - eq $typeRel(M,nil,nil) = true . - eq $typeRel(M,TYL,TYL') = false [owise] . - eq $typeRelS(M,TYL,TYL' ; TYLS) = - $typeRel(M,TYL,TYL') and-then $typeRelS(M,TYL,TYLS) . - eq $typeRelS(M,TYL,none) = true . - eq typeRelS(M,TYL ; TYLS,TYLS') = - $typeRelS(M,TYL,TYLS') and-then typeRelS(M,TYLS,TYLS') . - eq typeRelS(M,none,TYLS') = true . - - --- INP: Module Sort - --- PRE: Type is defined in Module - --- OUT: SortSet of all types greater than Sort - eq greaterSorts(M,S) = $greaterSorts(M,S,lesserSorts(M,getKind(M,S))) . - eq $greaterSorts(M,S,S' ; SS) = - if sortLeq(M,S,S') then - S' ; $greaterSorts(M,S,SS) - else - $greaterSorts(M,S,SS) - fi . - eq $greaterSorts(M,S,none) = none . - - --- INP: TypeList TypeListSet - --- PRE: None - --- OUT: true iff TypeList is in TypeListSet - eq TYL in (TYL ; TYLS) = true . - eq TYL in TYLS = false [owise] . - - --- INP: TypeListSet1 TypeListSet2 - --- PRE: None - --- OUT: TypeListSet containing all TypeLists in TypeListSet1 and not in - --- TypeListSet2 - eq TYLS - TYLS' = $tydiff(TYLS,TYLS',none) . - eq $tydiff(TYL ; TYLS,TYLS',TYLS'') = - if TYL in TYLS' then - $tydiff(TYLS,TYLS',TYLS'') - else - $tydiff(TYLS,TYLS',TYL ; TYLS'') - fi . - eq $tydiff(none,TYLS',TYLS'') = TYLS'' . - - --- INP: TypeListSet1 TypeListSet2 - --- PRE: None - --- OUT: TypeListSet containing all items in both sets - eq intersect(TYL ; TYLS,TYLS') = - if TYL in TYLS' then - TYL ; intersect(TYLS,TYLS') - else - intersect(TYLS,TYLS') - fi . - eq intersect(none,TYLS') = none . - - --- INP: TypeListSet TypeListSet - --- PRE: None - --- OUT: A TypeListSet formed by merging each pair of TypeLists - --- in the two TypeListSets - eq merge(TYLS,TYLS') = $merge1(TYLS,TYLS',none) . - eq $merge1(TYL ; TYLS, TYLS', TYLS'') = - $merge1(TYLS, TYLS', $merge2(TYL,TYLS',none) ; TYLS'') . - eq $merge1(none,TYLS',TYLS'') = TYLS'' . - eq $merge2(TYL, TYL' ; TYLS, TYLS') = - $merge2(TYL, TYLS, TYL TYL' ; TYLS') . - eq $merge2(TYL, none, TYLS') = TYLS' . - - --- INP: TypeList - --- PRE: None - --- OUT: Turns a TypeList into the corresponding TypeSet - eq typeListToSet(TY TYL) = TY ; typeListToSet(TYL) . - eq typeListToSet(nil) = none . - - --- INP: Module Qid - --- PRE: None - --- OUT: Possible result types of operators with name Qid - op possibleTypings : OpDeclSet Qid -> TypeSet . - eq possibleTypings(M,Q) = possibleTypings(getOps(M),Q) . - eq possibleTypings(op Q' : TYL -> TY [AS]. ODS,Q) = - if Q == Q' then - TY ; possibleTypings(ODS,Q) - else - possibleTypings(ODS,Q) - fi . - eq possibleTypings(none,Q) = none . - - --- INP: Module TypeList - --- PRE: TypeList defined in Module - --- OUT: TypeListSet of all TypeLists less than the current one - op typesBelow : Module TypeList -> TypeListSet . - op $typesBelow : Module TypeList TypeListSet -> TypeListSet . - eq typesBelow(M,TYL) = $typesBelow(M,TYL,nil) . - eq $typesBelow(M,TY TYL,TYLS) = $typesBelow(M,TYL,merge(TYLS,lesserSorts(M,TY) ; TY)) . - eq $typesBelow(M,nil,TYLS) = TYLS . - - --- INP: Module TypeList - --- PRE: TypeList well-defined in Module - --- OUT: KindList corresponding to this TypeList - op toKind : Module TypeList -> TypeList . - eq toKind(M,TY TYL) = completeName(M,getKind(M,TY)) toKind(M,TYL) . - eq toKind(M,nil) = nil . - - --- PRE: Term well-defined in Module - --- OUT: A TypeList with n elements corresponding to n terms' types in termlist - op termListTypes : Module TermList -> TypeList . - eq termListTypes(M,(T, TL)) = leastSort(M,T) termListTypes(M,TL) . - eq termListTypes(M,empty) = nil . - - op maxSortAbove : Module Sort ~> Sort . - op maxSortAbove : Module Sort SortSet ~> Sort . - eq maxSortAbove(M,S) = maxSortAbove(M,S,maximalSorts(M,getKind(M,S))) . - eq maxSortAbove(M,S,S' ; SS) = - if sortLeq(M,S,S') then - if maxSortAbove(M,S,SS) :: Sort then - maxSortAbove(M,S,none) else - S' - fi else - maxSortAbove(M,S,SS) - fi . -endfm - ---- ----# Operator/Membership/Rule Declarations ---- - -fmod ATTR-EXTRA is - pr META-MODULE . - - ops special-attr id-attr left-id-attr right-id-attr - strat-attr frozen-attr poly-attr prec-attr gather-attr - format-attr print-attr label-attr metadata-attr : -> Attr . - op _%_ : AttrSet AttrSet -> AttrSet . - op _-_ : AttrSet AttrSet -> AttrSet . - op in : AttrSet AttrSet -> Bool . - - var A A' : Attr . - var Q Q' : Qid . - var QL QL' : QidList . - var TYL : TypeList . - var TY : Type . - var AS AS' : AttrSet . - var S S' : String . - var N N' : Nat . - var NL NL' : NatList . - var HL HL' : NeHookList . - var T T' : Term . - - --- INP: None - --- PRE: None - --- OUT: Attrs for use in _%_ - eq special-attr = special(term-hook('T,'T.S)) . - eq id-attr = id('T.S) . - eq left-id-attr = left-id('T.S) . - eq right-id-attr = right-id('T.S) . - eq strat-attr = strat(0) . - eq frozen-attr = frozen(0) . - eq poly-attr = poly(0) . - eq prec-attr = prec(0) . - eq gather-attr = gather(nil) . - eq format-attr = format(nil) . - eq print-attr = print(nil) . - eq label-attr = label('Q) . - eq metadata-attr = metadata("") . - - --- INP: AttrSet1 AttrSet2 - --- PRE: None - --- OUT: All Attrs in AttrSet1 that are not in AttrSet2; - --- here we ignore subterms; we only match top operator - eq (special(HL) AS) % (special(HL') AS') = AS % AS' . - eq (id(T) AS) % (id(T') AS') = AS % AS' . - eq (left-id(T) AS) % (left-id(T) AS') = AS % AS' . - eq (right-id(T) AS) % (right-id(T) AS') = AS % AS' . - eq (strat(NL) AS) % (strat(NL') AS') = AS % AS' . - eq (frozen(NL) AS) % (frozen(NL') AS') = AS % AS' . - eq (poly(NL) AS) % (poly(NL') AS') = AS % AS' . - eq (prec(N) AS) % (prec(N') AS') = AS % AS' . - eq (gather(QL) AS) % (gather(QL') AS') = AS % AS' . - eq (format(QL) AS) % (format(QL') AS') = AS % AS' . - eq (print(QL) AS) % (print(QL') AS') = AS % AS' . - eq (label(Q) AS) % (label(Q') AS') = AS % AS' . - eq (metadata(S) AS) % (metadata(S') AS') = AS % AS' . - eq AS % AS' = AS - AS' [owise] . - - --- INP: AttrSet1 AttrSet2 - --- PRE: None - --- OUT: All Attrs in AttrSet1 that are not in AttrSet2 - eq (A AS) - (A AS') = AS - AS' . - eq AS - AS' = AS [owise] . - - - --- INP: AttrSet1 AttrSet2 - --- PRE: None - --- OUT: true iff all kinds of Attrs in AttrSet1 are in AttrSet2 - eq in(AS,AS') = (AS % AS') == none . -endfm - -fmod OPDECL-EXTRA is - pr META-LEVEL . - pr ATTR-EXTRA . - op qid : OpDecl -> Qid . - op argTypes : OpDecl -> TypeList . - op resultType : OpDecl -> Type . - op attrSet : OpDecl -> AttrSet . - op metadata : OpDecl ~> String . - var Q : Qid . var T : Type . var TL : TypeList . - var S : String . var AS : AttrSet . - eq qid(op Q : TL -> T [AS].) = Q . - eq argTypes(op Q : TL -> T [AS].) = TL . - eq resultType(op Q : TL -> T [AS].) = T . - eq attrSet(op Q : TL -> T [AS].) = AS . - eq metadata(op Q : TL -> T [metadata(S) AS].) = S . -endfm - -fmod OPDECLSET-EXTRA is - pr OPDECL-EXTRA . - pr META-MODULE . - - op _inODS_ : OpDecl OpDeclSet -> Bool . - op _-_ : OpDeclSet OpDeclSet -> OpDeclSet . - op subset? : OpDeclSet OpDeclSet -> Bool . - op $opdiff : OpDeclSet OpDeclSet OpDeclSet -> OpDeclSet . - op argTypeSet : OpDeclSet -> TypeListSet . - op $argTypeSet : OpDeclSet TypeListSet -> TypeListSet . - op resTypeSet : OpDeclSet -> TypeSet . - op $resTypeSet : OpDeclSet TypeSet -> TypeListSet . - op constants : OpDeclSet -> OpDeclSet . - op $constants : OpDeclSet OpDeclSet -> OpDeclSet . - op ctors : OpDeclSet -> OpDeclSet . - op stripAttrs : OpDeclSet -> OpDeclSet . - --- - op qid : OpDeclSet -> QidSet . - op argTypes : OpDeclSet -> TypeListSet . - op resultType : OpDeclSet -> TypeSet . - --- op attrSet : OpDeclSet -> AttrSetSet . --- right now no attrsetset sort to use... - - var M : Module . - var TS : TypeSet . - var TLS : TypeListSet . - var OS OS' OS'' : OpDeclSet . - var OD OD' : OpDecl . - var Q : Qid . - var AS : AttrSet . - var TYL : TypeList . - var TY : Type . - var QS : QidSet . - - --- INP: OpDecl OpDeclSet - --- PRE: None - --- OUT: true iff OpDecl is in OpDeclSet - eq OD inODS OD OS = true . - eq OD inODS OS = false [owise] . - - --- INP: OpDeclSet1 OpDeclSet2 - --- PRE: None - --- OUT: Removes all OpDecls in set 2 - --- from set 1 - eq OS - OS' = $opdiff(OS,OS',none) . - eq $opdiff(OD OS,OS',OS'') = - $opdiff(OS,OS',if OD inODS OS' then none else OD fi OS'') . - eq $opdiff(none,OS',OS'') = OS'' . - - --- INP: OpDeclSet1 OpDeclSet2 - --- PRE: None - --- OUT: true iff OpDeclSet1 is a subset of OpDeclSet2 - eq subset?(OD OS,OS') = OD inODS OS' and-then subset?(OS,OS') . - eq subset?(none,OS') = true . - - --- INP: OpDeclSet - --- PRE: None - --- OUT: A set of TypeLists represents the arguments from each OpDecl - eq argTypeSet(OS) = $argTypeSet(OS,none) . - eq $argTypeSet(OD OS,TLS) = $argTypeSet(OS,argTypes(OD) ; TLS) . - eq $argTypeSet(none,TLS) = TLS . - - --- INP: OpDeclSet - --- PRE: None - --- OUT: A TypeSet representing the results from each OpDecl - eq resTypeSet(OS) = $resTypeSet(OS,none) . - eq $resTypeSet(OD OS,TS) = $resTypeSet(OS,resultType(OD) ; TS) . - eq $resTypeSet(none,TS) = TS . - - --- INP: OpDeclSet - --- PRE: None - --- OUT: Extracts all constants - eq constants(OS) = $constants(OS,none) . - eq $constants(OD OS,OS') = - $constants(OS,if argTypes(OD) == nil then OD else none fi OS') . - eq $constants(none,OS') = OS' . - - --- INP: OpDeclSet - --- PRE: None - --- OUT: Extracts all ctors - op $ctors : OpDeclSet OpDeclSet -> OpDeclSet . - eq ctors(OS) = $ctors(OS,none) . - eq $ctors(op Q : TYL -> TY [ctor AS]. OS,OS') = - $ctors(OS,op Q : TYL -> TY [ctor AS]. OS') . - eq $ctors(OS,OS') = OS' [owise] . - - --- INP: OpDeclSet - --- PRE: None - --- OUT: Replaces each op's AttrSet with none - eq stripAttrs(op Q : TYL -> TY [AS]. OS) = - op Q : TYL -> TY [none]. stripAttrs(OS) . - eq stripAttrs(none) = none . - - --- INP: OpDeclSet - --- PRE: None - --- OUT: Qid/TypeList/TypeSets (Set functor liftings of OpDecl type) - eq qid(OD OD' OS) = qid(OD) ; qid(OD' OS) . - eq qid(none) = none . - eq argTypes(OD OD' OS) = argTypes(OD) ; argTypes(OD' OS) . - eq argTypes(none) = none . - eq resultType(OD OD' OS) = resultType(OD) ; resultType(OD' OS) . - eq resultType(none) = none . - - --- INP: OpDeclSet OpDeclSet - --- PRE: None - --- OUT: true iff OpDeclSets intersect? - op intersect? : OpDeclSet OpDeclSet -> Bool . - op $intersect? : OpDecl OpDeclSet -> Bool . - eq intersect?(OD OS,OS') = $intersect?(OD,OS') or-else intersect?(OS,OS') . - eq intersect?(none,OS') = false . - eq $intersect?(OD OS,OD OS') = true . - eq $intersect?(OS,OS') = false [owise] . - - --- INP: OpDeclSet - --- PRE: None - --- OUT: True iff there is an assoc op that isn't comm - op assocNotComm? : OpDeclSet -> Bool . - op noComm? : AttrSet -> Bool . - ceq assocNotComm?(op Q : TYL -> TY [assoc AS]. OS) = true if noComm?(AS) . - eq assocNotComm?(OS) = false [owise] . - eq noComm?(comm AS) = false . - eq noComm?(AS) = true [owise] . -endfm - -fmod OPDECL-TYPING is - pr META-LEVEL . - pr TYPE-EXTRA . - pr OPDECLSET-EXTRA . - - op opLeq : Module OpDecl OpDecl -> Bool . - op getMaximal : Module OpDeclSet -> OpDeclSet . - op $getMaximal : Module OpDeclSet OpDeclSet OpDeclSet -> OpDeclSet . - op $getMaximal1 : Module OpDecl OpDeclSet -> Bool . - op opsBelow : Module OpDecl -> OpDeclSet . - op opsBelow : Module OpDecl OpDeclSet -> OpDeclSet . - op $opsBelow : Module OpDecl OpDeclSet OpDeclSet -> OpDeclSet . - op relatedOps : Module Qid TypeList OpDeclSet -> OpDeclSet . - op relatedOps : Module OpDecl OpDeclSet -> OpDeclSet . - - var M : Module . - var OD OD' : OpDecl . - var OS OS' OS'' : OpDeclSet . - var TYL TYL' : TypeList . - var TY TY' : Type . - var AS AS' : AttrSet . - var NTL : NeTermList . - var C : Constant . - var Q : Qid . - - --- INP: Module OpDecl1 OpDecl2 - --- PRE: OpDecls are well-defined with respect to Module - --- OUT: true iff names agree and argTypes of OpDecl1 are less than that - --- of OpDecl2 - eq opLeq(M,OD,OD') = - qid(OD) == qid(OD') and-then typeLeqS(M,argTypes(OD),argTypes(OD')) . - - --- INP: Module OpDeclSet - --- PRE: OpDeclSet is well-defined with respect to Module - --- OUT: The maximal OpDecls in the OpDeclSet - eq getMaximal(M,OS) = $getMaximal(M,OS,none,none) . - eq $getMaximal(M,OD OS,OS',OS'') = - if $getMaximal1(M,OD,OS OS') then - $getMaximal(M,OS,OD OS',OD OS'') - else - $getMaximal(M,OS,OS',OS'') - fi . - eq $getMaximal(M,none,OS',OS'') = OS'' . - eq $getMaximal1(M,OD,OD' OS) = - not opLeq(M,OD,OD') and-then $getMaximal1(M,OD,OS) . - eq $getMaximal1(M,OD,none) = true . - - --- INP: Module OpDecl [OpDeclSet] - --- PRE: OpDecls are well-defined with respect to Module - --- OUT: All OpDecls in OpDeclSet that are less than OpDecl - eq opsBelow(M,OD) = opsBelow(M,OD,getOps(M)) . - eq opsBelow(M,OD,OS) = $opsBelow(M,OD,OS,none) . - eq $opsBelow(M,OD,OD' OS',OS) = - if opLeq(M,OD',OD) and OD' =/= OD then - $opsBelow(M,OD,OS',OD' OS) - else - $opsBelow(M,OD,OS',OS) - fi . - eq $opsBelow(M,OD,none,OS) = OS . - - --- INP: Module OpDecl/(Qid TypeList) OpDeclSet - --- PRE: OpDecls are well-defined with respect to Module - --- OUT: Set of OpDecls in OpDeclSet that are related to OpDecl; that is - --- their arguments are in the same kind - eq relatedOps(M,Q,TYL,OS) = - relatedOps(M,op Q : TYL -> 'Sort [none].,OS) . - eq relatedOps(M,OD,OD' OS) = - if qid(OD) == qid(OD') and typeRelS(M,argTypes(OD),argTypes(OD')) then - OD' relatedOps(M,OD,OS) - else - relatedOps(M,OD,OS) - fi . - eq relatedOps(M,OD,none) = none . - - --- INP: Module TypeList OpDeclSet - --- PRE: OpDecls are well-defined with respect to Module - --- OUT: All OpDecls in OpDeclSet that are less than OpDecl - op opsAbove : Module TypeList -> OpDeclSet . - op opsAbove : Module TypeList OpDeclSet -> OpDeclSet . - op $opsAbove : Module TypeList OpDeclSet OpDeclSet -> OpDeclSet . - eq opsAbove(M,TYL) = opsAbove(M,TYL,getOps(M)) . - eq opsAbove(M,TYL,OS) = $opsAbove(M,TYL,OS,none) . - eq $opsAbove(M,TYL,OD' OS',OS'') = - if typeLeqS(M,TYL,argTypes(OD')) then - $opsAbove(M,TYL,OS',OS'' OD') - else - $opsAbove(M,TYL,OS',OS'') - fi . - eq $opsAbove(M,TYL,none,OS'') = OS'' . - - --- INP: Module OpDeclSet - --- PRE: OpDeclSet is well-defined with respect to Module - --- OUT: The minimal OpDecls in the OpDeclSet - op getMinimal : Module OpDeclSet -> OpDeclSet . - op $getMinimal : Module OpDeclSet OpDeclSet OpDeclSet -> OpDeclSet . - op $getMinimal1 : Module OpDecl OpDeclSet -> Bool . - eq getMinimal(M,OS) = $getMinimal(M,OS,none,none) . - - --- OS'' are the mininmal - eq $getMinimal(M,OD OS,OS',OS'') = - --- if minimal w/respect to rest of OS, add to minimal and non-minimal pools - if $getMinimal1(M,OD,OS OS') then - $getMinimal(M,OS,OD OS',OD OS'') - else - $getMinimal(M,OS,OS',OS'') - fi . - eq $getMinimal(M,none,OS',OS'') = OS'' . - - --- Check if OD is minimal - eq $getMinimal1(M,OD,OD' OS) = - not typeLeqS(M,resultType(OD'),resultType(OD)) and-then $getMinimal1(M,OD,OS) . - eq $getMinimal1(M,OD,none) = true . - - --- PRE: TypeList and Type are defined in Module - --- OUT: Given a term with structure Q(X1...XN) whose - --- least sort is Type where the sorts of X1...XN - --- correspond to the Types in TypeList, find all - --- possible operators in the OpDeclSet that - --- could be instantiated to get this term - op findOps : Module OpDeclSet Qid TypeList Type -> OpDeclSet . - eq findOps(M,OD OS,Q,TYL,TY) = - if typeLeqS(M,TYL,argTypes(OD)) and qid(OD) == Q and - typeLeqS(M,resultType(OD),TY) then - OD - else - none - fi findOps(M,OS,Q,TYL,TY) . - eq findOps(M,none,Q,TYL,TY) = none . - - --- PRE: Term and OpDeclSet are well-defined in Module - --- OUT: Set of OpDecls that could top this term - op findOps : Module OpDeclSet Term -> OpDeclSet . - eq findOps(M,OS,Q[NTL]) = findOps(M,OS,Q,termListTypes(M,NTL),leastSort(M,Q[NTL])) . - eq findOps(M,OS,C) = findOps(M,OS,getName(C),nil,leastSort(M,C)) . - - --- PRE: None - --- OUT: True iff no operators share the same name in OpDeclSet - op overloaded? : OpDeclSet -> Bool . - eq overloaded?(op Q : TYL -> TY [AS]. op Q : TYL' -> TY' [AS']. OS) = true . - eq overloaded?(OS) = false [owise] . -endfm - -fmod OP-FAMILY is - pr TYPE-EXTRA . - pr OPDECL-TYPING . - - sort OpFamily OpFamilyMap . - subsort OpFamily < OpFamilyMap . - op (_,_)|->_ : Qid TypeList OpDeclSet -> OpFamily [ctor] . - op __ : OpFamilyMap OpFamilyMap -> OpFamilyMap [ctor assoc comm id: nil] . - op nil : -> OpFamilyMap [ctor] . - - op getOpFamilies : Module -> OpFamilyMap . - op getOpFamilies : Module OpDeclSet -> OpFamilyMap [memo] . - op $opF : Module OpDeclSet OpFamilyMap -> OpFamilyMap . - op adhoc-overloaded? : OpFamilyMap -> Bool . - - var M : Module . - var Q : Qid . - var TYL TYL' : TypeList . - var TY : Type . - var AS : AttrSet . - var OS OS' : OpDeclSet . - var OFM : OpFamilyMap . - var OD : OpDecl . - - --- INP: Module - --- PRE: None - --- OUT: OpFamilyMap which maps each Qid to all - --- the OpDecl's which have this Qid as their name - eq getOpFamilies(M) = getOpFamilies(M,getOps(M)) . - eq getOpFamilies(M,OS) = $opF(M,OS,nil) . - ceq $opF(M,op Q : TYL -> TY [AS]. OS,OFM (Q,TYL') |-> OS') = $opF(M,OS,OFM (Q,TYL') |-> OS' op Q : TYL -> TY [AS].) - if TYL' == toKind(M,TYL) . - eq $opF(M,OD OS, OFM) = $opF(M,OS, OFM (qid(OD),toKind(M,argTypes(OD))) |-> OD) [owise] . - eq $opF(M,none,OFM) = OFM . - - --- INP: OpFamilyMap - --- PRE: OpFamilyMap is well-formed and sensible - --- OUT: true iff operators are adhoc-overloaded - ceq adhoc-overloaded?(((Q,TYL) |-> OS) ((Q,TYL') |-> OS') OFM) = true if TYL =/= TYL' . - eq adhoc-overloaded?(OFM) = false [owise] . -endfm - -fmod OP-FAMILY-AUX is - pr OP-FAMILY . - - op ctorsPreregularBelow : Module -> Bool . - op ctorsPreregularBelow : Module OpFamilyMap -> Bool . - op $ctorsPreregularBelow : Module TypeListSet OpDeclSet OpDeclSet -> Bool . - op $ctorsPreregularBelow1 : Module TypeList OpDeclSet OpDeclSet -> Bool . - op typesBelowMaximalOps : Module OpDeclSet -> TypeListSet . - - var M : Module . - var Q : Qid . - var TYL TYL' KL : TypeList . - var TY TY' : Type . - var AS AS' : AttrSet . - var OS OS' OS'' : OpDeclSet . - var OFM : OpFamilyMap . - var OD : OpDecl . - var TYLS : TypeListSet . - - eq typesBelowMaximalOps(M,OD OS) = typesBelow(M,argTypes(OD)) ; typesBelowMaximalOps(M,OS) . - eq typesBelowMaximalOps(M,none) = none . - - --- INP: OpFamilyMap - --- PRE: Valid OpFamilyMap - --- OUT: true iff ctors always have minimal typings - eq ctorsPreregularBelow(M) = ctorsPreregularBelow(M,getOpFamilies(M)) . - eq ctorsPreregularBelow(M,OFM (Q,KL) |-> OS) = - $ctorsPreregularBelow(M,typesBelowMaximalOps(M,OS),ctors(OS),OS - ctors(OS)) and-then - ctorsPreregularBelow(M,OFM) . - eq ctorsPreregularBelow(M,nil) = true . - - eq $ctorsPreregularBelow(M,TYL ; TYLS,OS,OS') = - $ctorsPreregularBelow1(M,TYL,OS,OS') and-then - $ctorsPreregularBelow(M,TYLS,OS,OS') . - eq $ctorsPreregularBelow(M,none,OS,OS') = true . - - --- NOTE: if the opsAbove intersect?s with the ctors, then the minimum - --- must be a ctor; if there is no minimum, we violated preregularity - ceq $ctorsPreregularBelow1(M,TYL,OS,OS') = intersect?(OS,OS'') implies OD inODS OS - if OS'' := opsAbove(M,TYL,OS OS') /\ - OD := getMinimal(M,OS'') . - eq $ctorsPreregularBelow1(M,TYL,OS,OS') = false [owise] . - - --- INP: OpFamilyMap - --- PRE: Valid OpFamilyMap - --- OUT: true iff no ops have the same input sorts and different output sorts - op sameArgsDiffRes : OpFamilyMap -> Bool . - ceq sameArgsDiffRes(OFM (Q,KL) |-> OS op Q : TYL -> TY [AS]. op Q : TYL -> TY' [AS'].) = true if TY == TY' . - eq sameArgsDiffRes(OFM) = false [owise] . -endfm - -fmod STMT-EXTRA is - pr META-LEVEL . - - var M : Module . var R R' : Rule . var RS : RuleSet . var Q : Qid . var Y : Sort . - var U V : Term . var A : AttrSet . var C : Condition . var EC : EqCondition . - var E E' : Equation . var ES : EquationSet . var B B' : MembAx . var BS : MembAxSet . - - op rl-labels : Module -> [QidSet] . - op rl-labels : RuleSet -> [QidSet] . - eq rl-labels(M) = rl-labels(getRls(M)) . - eq rl-labels(R R' RS) = rl-labels(R) ; rl-labels(R' RS) . - eq rl-labels(rl U => V [label(Q) A].) = Q . - eq rl-labels(crl U => V if C [label(Q) A].) = Q . - eq rl-labels(none) = none . - - op eq-labels : Module -> [QidSet] . - op eq-labels : EquationSet -> [QidSet] . - eq eq-labels(M) = eq-labels(getEqs(M)) . - eq eq-labels(E E' ES) = eq-labels(E) ; eq-labels(E' ES) . - eq eq-labels(eq U = V [label(Q) A].) = Q . - eq eq-labels(ceq U = V if EC [label(Q) A].) = Q . - eq eq-labels(none) = none . - - op mb-labels : Module -> [QidSet] . - op mb-labels : MembAxSet -> [QidSet] . - eq mb-labels(M) = mb-labels(getMbs(M)) . - eq mb-labels(B B' BS) = mb-labels(B) ; mb-labels(B' BS) . - eq mb-labels(mb U : Y [label(Q) A].) = Q . - eq mb-labels(cmb U : Y if EC [label(Q) A].) = Q . - eq mb-labels(none) = none . - - op stmt-labels : Module -> [QidSet] . - eq stmt-labels(M) = rl-labels(M) ; eq-labels(M) ; mb-labels(M) . -endfm - ---- this module has functionality to generate unique prefixes with ---- respect to the sorts/operators in a module; this is useful when ---- an algorithm needs to generate fresh sorts/operators; if the ---- generated sort/operator will be needed often, it can be memoized -fmod UNIQUE-PREFIX is - pr META-LEVEL . - pr OPDECLSET-EXTRA . - pr STMT-EXTRA . - pr SET{String} . - - op sortPrefix : Module -> String [memo] . - op sortPrefix : SortSet -> String . - op opPrefix : Module -> String [memo] . - op opPrefix : OpDeclSet -> String . - op lblPrefix : Module -> String . - op uniquePrefix : QidSet -> String . - op uniquePrefix : String Set{String} -> String . - op qidSetToStrSet : QidSet -> Set{String} . - - var P S : String . var SS : Set{String} . var D : Qid . var Q : QidSet . - - eq sortPrefix(M:Module) = uniquePrefix(getSorts(M:Module)) . - eq sortPrefix(S:SortSet) = uniquePrefix(S:SortSet) . - eq opPrefix(M:Module) = uniquePrefix(qid(getOps(M:Module))) . - eq opPrefix(O:OpDeclSet) = uniquePrefix(qid(O:OpDeclSet)) . - eq lblPrefix(M:Module) = uniquePrefix(stmt-labels(M:Module)) . - eq uniquePrefix(Q) = uniquePrefix("@",qidSetToStrSet(Q)) . - eq uniquePrefix(P,(S,SS)) = if P == substr(S,0,length(P)) then uniquePrefix(P + "@",(S,SS)) - else uniquePrefix(P,SS) fi . - eq uniquePrefix(P,empty) = P . - eq qidSetToStrSet(D ; Q) = string(D) , qidSetToStrSet(Q) . - eq qidSetToStrSet(none) = empty . -endfm - ---- this module provides functionality to add a set of variables into a module ---- as FRESH constants (by using the functionality of opPrefix above); the function ---- returns a new module as well as an assignment mapping each variable into its ---- fresh constant --- this assignment can later be used to decode the new term ---- back into its original form -fmod VARIABLES-TO-CONSTANTS is - pr TERM-EXTRA . --- for getName()/repeatedNames() - pr UNIT-FM . --- for addOps() - pr QID-JOIN . --- for join() - pr UNIQUE-PREFIX . --- for opPrefix() - pr SUBSTITUTION-REFINEMENT . --- for sort ConstSubstitution - pr SUBSTITUTIONSET . --- for sort SubstitutionSet - - sort ModuleSubstPair . - op ((_,_)) : Module Substitution -> ModuleSubstPair [ctor] . - op mod : ModuleSubstPair -> Module . - op sub : ModuleSubstPair -> Substitution . - - sort ConstGenStrategy . - ops simple prefix full : -> ConstGenStrategy [ctor] . - - op varsToConsts : Module ConstGenStrategy QidSet -> [Module] . - op varsToConsts# : Module ConstGenStrategy QidSet -> [ModuleSubstPair] . - op varsToConsts# : Module ConstGenStrategy QidSet Qid OpDeclSet Substitution -> [ModuleSubstPair] . - - op constsToVars : ConstSubstitution Term -> Term . - op constsToVars : ConstSubstitution Qid TermList TermList -> TermList . - op constsToVars : ConstSubstitution SubstitutionSet -> SubstitutionSet . - - var M : Module . var V : Variable . var C : Constant . var Q : Qid . - var QS : QidSet . var TL TL' : TermList . var T : Term . var SS : SubstitutionSet . - var S S' : Substitution . var P : Qid . var O : OpDeclSet . var CG : ConstGenStrategy . - var TQ : TermQid . var CS : ConstSubstitution . - - --- INP: Module QidSet (Variables) - --- PRE: QidSet should be a set of variables - --- OUT: A new module where variables have been added as constants - eq mod((M,CS)) = M . - eq sub((M,CS)) = CS . - eq varsToConsts(M,CG,QS) = mod(varsToConsts#(M,CG,QS)) . - eq varsToConsts#(M,CG,QS) = varsToConsts#(M,CG,QS,qid(opPrefix(M)),none,none) . - eq varsToConsts#(M,simple,V ; QS,P,O,CS) = varsToConsts#(M,simple,QS,P,O op getName(V) : nil -> getType(V) [none].,CS ; V <- join(getName(V) '. getType(V))) . - eq varsToConsts#(M,prefix,V ; QS,P,O,CS) = varsToConsts#(M,prefix,QS,P,O op join(P getName(V)) : nil -> getType(V) [none].,CS ; V <- join(P getName(V) '. getType(V))) . - eq varsToConsts#(M,full, V ; QS,P,O,CS) = varsToConsts#(M,full, QS,P,O op join(P getName(V) '| getType(V)) : nil -> getType(V) [none].,CS ; V <- join(P getName(V) '| getType(V) '. getType(V))) . - eq varsToConsts#(M,CG,none,P,O,CS) = (addOps(O,M),CS) . - - --- INP: Substitution (Variables to fresh Constants) Term/SubstitutionSet - --- PRE: None - --- OUT: Identical to Term/SubstitutionSet except in Term/Codomain of SubstitutionSet - --- each occurrence of a constant in the codomain of Substitution is - --- replaced by the variable which is assigned to it - --- NB: the first equation is not strictly necessary but it optimizes for the common - --- case when the substitution is empty - eq constsToVars((none).Substitution,T) = T . - eq constsToVars(CS,Q[TL]) = constsToVars(CS,Q,TL,empty) . - eq constsToVars(CS,V) = V . - eq constsToVars(CS ; V <- C,C) = V . - eq constsToVars(CS,C) = C [owise] . - eq constsToVars(CS,Q,(T,TL),TL') = constsToVars(CS,Q,TL,(TL',constsToVars(CS,T))) . - eq constsToVars(CS,Q,empty,TL') = Q[TL'] . - --- - eq constsToVars(CS,S | S' | SS) = constsToVars(CS,S) | constsToVars(CS,S' | SS) . - eq constsToVars(CS,.SubstitutionSet) = .SubstitutionSet . - eq constsToVars(CS,V <- T ; S) = V <- constsToVars(CS,T) ; constsToVars(CS,S) . - eq constsToVars(CS,(none).Substitution) = (none).Substitution . -endfm - ---- Module checks if all the rules in the module we are analyzing in the same kind. ---- If not, that means module cannot be topmost ---- TODO: implement full topmost check -fmod RULES-SHARE-KIND is - pr META-LEVEL . - - op rules-share-kind : Module -> Bool . - op rules-share-kind : Module RuleSet -> Bool . - op rules-share-kind : Module Type RuleSet -> Bool . - op getRuleType : Module ~> Type . - op getRuleType : Module RuleSet ~> Type . - - var M : Module . var L R : Term . var Y : Type . - var RLS : RuleSet . var AS : AttrSet . - - eq rules-share-kind(M) = rules-share-kind(M,getRls(M)) . - eq rules-share-kind(M,none) = false . - eq rules-share-kind(M,rl L => R [AS] . RLS) = - leastSort(M,L) ; leastSort(M,R) :: NeSortSet and-then sameKind(M,leastSort(M,L),leastSort(M,R)) and-then rules-share-kind(M,leastSort(M,L),RLS) . - eq rules-share-kind(M,crl L => R if C:Condition [AS] . RLS) = - leastSort(M,L) ; leastSort(M,R) :: NeSortSet and-then sameKind(M,leastSort(M,L),leastSort(M,R)) and-then rules-share-kind(M,leastSort(M,L),RLS) . - eq rules-share-kind(M,Y,none) = true . - eq rules-share-kind(M,Y,rl L => R [AS] . RLS) = - leastSort(M,L) ; leastSort(M,R) :: NeSortSet and-then sameKind(M,Y,leastSort(M,L)) and-then sameKind(M,Y,leastSort(M,R)) and-then rules-share-kind(M,Y,RLS) . - eq rules-share-kind(M,Y,crl L => R if C:Condition [AS] . RLS) = - leastSort(M,L) ; leastSort(M,R) :: NeSortSet and-then sameKind(M,Y,leastSort(M,L)) and-then sameKind(M,Y,leastSort(M,R)) and-then rules-share-kind(M,Y,RLS) . - - eq getRuleType(M) = getRuleType(M,getRls(M)) . - eq getRuleType(M,rl L => R [AS] . RLS) = leastSort(M,L) . - eq getRuleType(M,crl L => R if C:Condition [AS] . RLS) = leastSort(M,L) . -endfm - ---- defines operator kinds? : Bool Module -> Bool which returns true ---- iff the module contains any reference to a kind anywhere --- ---- the boolean arg controls whether any metaterms in the signature are ---- checked for evaluating to the kind or not --- -fmod KIND-CHECK is - pr META-LEVEL . - - --- copy of or-else to make eqs more readable - op _orL_ : Bool Bool -> Bool [strat (1 0) gather (e E) prec 59] . - - op kinds? : TypeListSet -> Bool . - op kinds? : Module Bool TermList -> Bool . - op kinds? : Module Bool AttrSet -> Bool . - op kinds? : Module Bool Condition -> Bool . - op kinds? : Module Bool OpDeclSet -> Bool . - op kinds? : Module Bool MembAxSet -> Bool . - op kinds? : Module Bool EquationSet -> Bool . - op kinds? : Module Bool RuleSet -> Bool . - op kinds? : Bool Module -> Bool . - - var FM : FModule . - var FT : FTheory . - var SM : SModule . - var ST : STheory . - var M : Module . - var K : Kind . - var S : Sort . - var SS : SortSet . - var T : Type . - var TL TL' : TypeList . - var NTL : NeTypeList . - var TS : TypeListSet . - var C : Constant . - var V : Variable . - var TML : TermList . - var NTML : NeTermList . - var Q : Qid . - var AS : AttrSet . - var CN : Condition . - var TM TM' : Term . - var O O' : OpDecl . - var OS : OpDeclSet . - var E E' : Equation . - var ES : EquationSet . - var MB MB' : MembAx . - var MBS : MembAxSet . - var R R' : Rule . - var RS : RuleSet . - var B : Bool . - - eq true orL B = true . - eq false orL B = B . - - eq kinds?(K) = true . - eq kinds?(S) = false . - eq kinds?(T NTL) = kinds?(T) orL kinds?(NTL) . - eq kinds?(nil) = false . - eq kinds?(TL ; TL' ; TS) = kinds?(TL) orL kinds?(TL' ; TS) . - eq kinds?((none).TypeListSet) = false . - - eq kinds?(M,B,C) = getType(C) :: Kind . - eq kinds?(M,B,V) = getType(V) :: Kind . - eq kinds?(M,B,Q[NTML]) = (B and-then (leastSort(M,Q[NTML]) :: Kind)) orL kinds?(M,B,NTML) . - eq kinds?(M,B,(TM,NTML)) = kinds?(M,B,TM) orL kinds?(M,B,NTML) . - eq kinds?(M,B,empty) = false . - - eq kinds?(M,B,id(T) AS) = kinds?(M,B,T) orL kinds?(M,B,AS) . - eq kinds?(M,B,left-id(T) AS) = kinds?(M,B,T) orL kinds?(M,B,AS) . - eq kinds?(M,B,right-id(T) AS) = kinds?(M,B,T) orL kinds?(M,B,AS) . - eq kinds?(M,B,AS) = false [owise] . - - eq kinds?(M,B,TM = TM' /\ CN) = kinds?(M,B,(TM,TM')) orL kinds?(M,B,CN) . - eq kinds?(M,B,TM : S /\ CN) = kinds?(M,B,TM) orL kinds?(M,B,CN) . - eq kinds?(M,B,TM := TM' /\ CN) = kinds?(M,B,(TM,TM')) orL kinds?(M,B,CN) . - eq kinds?(M,B,TM => TM' /\ CN) = kinds?(M,B,(TM,TM')) orL kinds?(M,B,CN) . - eq kinds?(M,B,(nil).Condition) = false . - - eq kinds?(M,B,op Q : TL -> T [AS].) = kinds?(TL T) orL kinds?(M,B,AS) . - eq kinds?(M,B,O O' OS) = kinds?(M,B,O) orL kinds?(M,B,O' OS) . - eq kinds?(M,B,(none).OpDeclSet) = false . - - eq kinds?(M,B,mb TM : S [AS].) = kinds?(M,B,TM) orL kinds?(M,B,AS) . - eq kinds?(M,B,cmb TM : S if CN [AS].) = kinds?(M,B,TM) orL kinds?(M,B,CN) orL kinds?(M,B,AS) . - eq kinds?(M,B,MB MB' MBS) = kinds?(M,B,MB) orL kinds?(M,B,MB' MBS) . - eq kinds?(M,B,(none).MembAxSet) = false . - - eq kinds?(M,B,eq TM = TM' [AS].) = kinds?(M,B,(TM,TM')) orL kinds?(M,B,AS) . - eq kinds?(M,B,ceq TM = TM' if CN [AS].) = kinds?(M,B,(TM,TM')) orL kinds?(M,B,CN) orL kinds?(M,B,AS) . - eq kinds?(M,B,E E' ES) = kinds?(M,B,E) orL kinds?(M,B,E' ES) . - eq kinds?(M,B,(none).EquationSet) = false . - - eq kinds?(M,B,rl TM => TM' [AS].) = kinds?(M,B,(TM,TM')) orL kinds?(M,B,AS) . - eq kinds?(M,B,crl TM => TM' if CN [AS].) = kinds?(M,B,(TM,TM')) orL kinds?(M,B,CN) orL kinds?(M,B,AS) . - eq kinds?(M,B,R R' RS) = kinds?(M,B,R) orL kinds?(M,B,R' RS) . - eq kinds?(M,B,(none).RuleSet) = false . - - eq kinds?(B,FM) = - kinds?(FM,B,getOps(FM)) orL - kinds?(FM,B,getMbs(FM)) orL - kinds?(FM,B,getEqs(FM)) . - - eq kinds?(B,FT) = - kinds?(FT,B,getOps(FT)) orL - kinds?(FT,B,getMbs(FT)) orL - kinds?(FT,B,getEqs(FT)) . - - eq kinds?(B,SM) = - kinds?(SM,B,getOps(SM)) orL - kinds?(SM,B,getMbs(SM)) orL - kinds?(SM,B,getEqs(SM)) orL - kinds?(SM,B,getRls(SM)) . - - eq kinds?(B,ST) = - kinds?(ST,B,getOps(ST)) orL - kinds?(ST,B,getMbs(ST)) orL - kinds?(ST,B,getEqs(ST)) orL - kinds?(ST,B,getRls(ST)) . -endfm - ---- ----# Generic Fixpoints ---- - ---- here we give an implementation of an arbitrary fixpoint ---- NOTE: the functional theory here is far too weak, since ---- arbitrary functions don't have fixpoints---but ---- adding the constraints to express that F truly has ---- fixpoints is more work than I want to do right now. -fth FUN is inc TRIV . - op F : Elt -> Elt . -endfth - -fmod FIXF{X :: FUN} is - pr TRUTH . - var A A' : X$Elt . - op FixF : X$Elt -> X$Elt . - op FixF : X$Elt X$Elt -> X$Elt . - eq FixF(A) = FixF(A,F(A)) . - eq FixF(A,A') = if A == A' then A' else FixF(A') fi . -endfm - ---- ---- # Meta-Level Functors ---- - -fmod HETEROGENEOUS-LIST-FUNCTOR is - pr META-LEVEL . - pr UNIT-FM . - pr UNIQUE-PREFIX . --- for opPrefix/sortPrefix - pr TYPE-EXTRA . --- for maxSortAbove - - var M : Module . - var S : Sort . var SS : SortSet . - var T : Term . var NTL : NeTermList . var TL : TermList . - var Q : Qid . - - --- Define Free Heterogeneous List Functor over the Module - op hl-inj : Module Sort -> Qid . - eq hl-inj(M,S) = qid(opPrefix(M) + "S") . - - op hl-injops : Module SortSet -> OpDeclSet . - eq hl-injops(M,S ; SS) = (op hl-inj(M,S) : S -> hl-sort(M) [ctor].) hl-injops(M,SS) . - eq hl-injops(M,none) = none . - - --- NOTE: Op Prefix Not Needed Since Sorts All Fresh - op hl-listop : Module -> OpDecl . - eq hl-listop(M) = (op 'singleton : hl-sort(M) -> hl-sort(M) [ctor]. - op '_|_ : hl-sort(M) hl-sort(M) -> hl-sort(M) [assoc ctor].) . - - op hl-sort : Module -> Sort . - eq hl-sort(M) = qid(sortPrefix(M) + "HeterogeneousList") . - - op hl-func : Module -> Module [memo] . - eq hl-func(M) = addSorts(hl-sort(M),addOps(hl-listop(M) hl-injops(M,getMaximalSorts(M)),M)) . - - --- Define Free Heterogenous List Fuctor over Terms in the Module - op toHL : Module NeTermList -> Term . - op $toHL : Module TermList -> TermList . - eq toHL(M,T) = 'singleton[hl-inj(M,maxSortAbove(M,leastSort(M,T)))[T]] . - eq toHL(M,(T,NTL)) = '_|_[$toHL(M,(T,NTL))] . - eq $toHL(M,(T,TL)) = hl-inj(M,maxSortAbove(M,leastSort(M,T)))[T], $toHL(M,TL) . - eq $toHL(M,empty) = empty . - - --- Define Forgetful Functor over Heterogeneous Lists - op toTL : Term -> [NeTermList] . - eq toTL('_|_[T,NTL]) = $toTL((T,NTL)) . - eq toTL('singleton[T]) = $toTL(T) . - - op $toTL : TermList -> TermList . - eq $toTL((Q[T],TL)) = T,$toTL(TL) . - eq $toTL(empty) = empty . - - --- Equational Laws (Left As Proof Obligations) - --- For all - --- [1] modules M - --- [2] termlists NTL in M - --- [3] terms T of sort HeterogeneousList in HL[M] - eq toTL(toHL(M,NTL)) = NTL [nonexec] . - eq toHL(M,toTL(T)) = T [nonexec] . -endfm - -fmod UNIFICATION-PROBLEM-AUX is - pr META-LEVEL . - - var UP : UnificationProblem . - var T T' : Term . - - op UnifProbLHSToTL : UnificationProblem -> NeTermList . - eq UnifProbLHSToTL(T =? T' /\ UP) = T, UnifProbLHSToTL(UP) . - eq UnifProbLHSToTL(T =? T') = T . -endfm - ---- ----# Meta-Term Printing and Parsing ---- - -fmod BUBBLES is - including QID-LIST . - sorts @Token@ @SortToken@ @NeTokenList@ @Bubble@ . - op token : Qid -> @Token@ - [special( - id-hook Bubble (1 1) - op-hook qidSymbol ( : ~> Qid))] . - op sortToken : Qid -> @SortToken@ - [special( - id-hook Bubble (1 1) - op-hook qidSymbol ( : ~> Qid) - id-hook Exclude ([ ] < to , . ( ) { } : | - ditto precedence prec gather - assoc associative comm commutative - ctor constructor id: strat strategy - poly memo memoization iter frozen - config object msg metadata nonexec variant))] . - op neTokenList : QidList -> @NeTokenList@ - [special( - id-hook Bubble (1 -1 ( )) - op-hook qidListSymbol (__ : QidList QidList ~> QidList) - op-hook qidSymbol ( : ~> Qid) - id-hook Exclude (.))] . - op bubble : QidList -> @Bubble@ - [special( - id-hook Bubble (1 -1 ( )) - op-hook qidListSymbol (__ : QidList QidList ~> QidList) - op-hook qidSymbol ( : ~> Qid))] . -endfm - -fmod GENERIC-PRINTER is - pr META-LEVEL . - pr CONVERSION . - pr TERMSET-FM . - - ops &mt &sp : -> Qid . --- constants for nothing/space - op pad : Qid Nat -> QidList . --- add padding upto length - op addsp : Nat -> QidList . - op print : Module TermSet -> QidList . --- printing fuctions below - op printSub : Module Substitution -> QidList . - op print : NatList QidList -> QidList . - op printNL : NatList QidList -> QidList . - - var M : Module . var SB : Substitution . var T T' : Term . var Q : Qid . - var TS : TermSet . var A A' : Assignment . var NL : NatList . - var QL : QidList . var V : Variable . var N : Nat . - var RP RP' : ResultPair . var RP? : [ResultPair] . - - eq addsp(s(N)) = &sp addsp(N) . - eq addsp(0) = nil . - eq pad(Q,N) = Q if length(string(Q)) >= N then nil else addsp(sd(length(string(Q)),N)) fi . - eq &sp = qid(" ") . - eq &mt = qid("") . - --- print termsets - eq print(M,T | T' | TS) = metaPrettyPrint(M,T) '`, print(M,T' | TS) . - eq print(M,T) = metaPrettyPrint(M,T) . - eq print(M,.TermSet) = &mt . - --- print substitutions - eq printSub(M,V <- T) = metaPrettyPrint(M,V) '<- metaPrettyPrint(M,T) . - eq printSub(M,A ; A' ; SB) = printSub(M,A) '; printSub(M,A' ; SB) . - eq printSub(M,none) = 'empty 'substitution . - --- print natlist - eq print(NL,QL) = printNL(NL,QL) . - eq printNL(N NL,QL) = printNL(NL,QL qid(string(N,10))) . - eq printNL((nil).NatList,QL) = QL . - - op printN : Nat QidList -> QidList . *** first N qid's in a qidList - eq printN(N, nil) = nil . - eq printN(0, QL) = nil . - eq printN(s N, Q QL) = Q printN(N, QL) . - - op printSyntaxError : [ResultPair?] QidList -> QidList . - eq printSyntaxError(noParse(N), QL) - = '\r 'Parse 'error 'in '\o '\s printN(N + 1, QL) '\r '<---*HERE* '\o . - eq printSyntaxError(ambiguity(RP, RP'), QL) - = '\r 'Ambiguous 'parsing 'for '\o '\s QL '\o . - eq printSyntaxError(RP?, QL) = QL [owise] . -endfm +load ../meta/meta-aux.maude diff --git a/contrib/tools/varsat/numbers.maude b/contrib/tools/varsat/numbers.maude index b9f14fa0..fa46f4a6 100644 --- a/contrib/tools/varsat/numbers.maude +++ b/contrib/tools/varsat/numbers.maude @@ -183,7 +183,7 @@ endfm fmod PRESBURGER-NAT-TO-NAT is pr NAT* . pr META-LEVEL . - pr FOFORM . + pr QFFOFORM . pr RENAME-METAVARS . sort NatForm . diff --git a/contrib/tools/varsat/var-sat.maude b/contrib/tools/varsat/var-sat.maude index e8a728a0..ea8adc3c 100644 --- a/contrib/tools/varsat/var-sat.maude +++ b/contrib/tools/varsat/var-sat.maude @@ -14,12 +14,12 @@ load sort-ops.maude --- empty and finite sort constructions load ctor-var-unif.maude --- computing constructor variants and unifiers -load foform.maude --- formula data structure +load ../meta/eqform.maude --- formula data structure fmod FORMS-TERMS-AUX is - pr FOFORM . + pr EQFORM . - var EL : EqAtom . var ED : EqDisj . var EC : EqConj . + var EL : EqLit . var ED : EqDisj . var EC : EqConj . var T T' : Term . var NTL : NeTermList . --- Map conjunction or disjunction into list of terms @@ -112,16 +112,16 @@ endfm fmod EQUALITY-INJECTION is pr UNIT-FM . - pr FOFORM . + pr EQFORM . pr CTOR-SIG . op equalExt : FModule -> FModule [memo] . - op unequal : FModule NegConj -> Bool . - op liftdiseqs : NegConj -> Term . - op $unequal : ResultPair NegConj -> Bool . + op unequal : FModule NegEqConj -> Bool . + op liftdiseqs : NegEqConj -> Term . + op $unequal : ResultPair NegEqConj -> Bool . op pruneBool : OpDeclSet -> OpDeclSet . var M : Module . var T T' : Term . - var NC : NegConj . + var NC : NegEqConj . var OS : OpDeclSet . --- INP: Module --- PRE: Module does not have sorts/ops with the prefix/suffix @##/##@ @@ -164,13 +164,8 @@ fmod VAR-SAT is pr UNIT-FM . pr EQUALITY-INJECTION . --- formula handling - pr FOFORMSET . - pr FOFORM-OPERATIONS . - pr FOFORMSET-OPERATIONS . - pr FOFORMSUBSTITUTION-PAIRSET . - pr FOFORM-DEFINEDOPS . - pr FOFORMSIMPLIFY . - pr DNF . + pr EQFORM-SET-OPERATIONS . + pr EQFORM-DNF . pr FORMS-TERMS-AUX . --- finite sort checking pr FIN-SORT-REWTH . @@ -181,34 +176,34 @@ fmod VAR-SAT is pr TERM-EXTRA . --- Main functions - op var-valid : Module QFForm -> Bool . - op var-sat : Module QFForm -> Bool . - op var-valid : Module SortSet SortSet QFForm -> Bool . - op var-sat : Module SortSet SortSet QFForm -> Bool . - op var-sat-opt : Module SortSet QFForm -> Bool . - op var-sat-disj : FModule SortSet QFForm -> Bool . - op var-sat-conj : FModule SortSet Conj -> Bool . - op var-sat-conjset : FModule SortSet NegConjSet -> Bool . + op var-valid : Module Form -> Bool . + op var-sat : Module Form -> Bool . + op var-valid : Module SortSet SortSet Form -> Bool . + op var-sat : Module SortSet SortSet Form -> Bool . + op var-sat-opt : Module SortSet Form -> Bool . + op var-sat-disj : FModule SortSet Form -> Bool . + op var-sat-conj : FModule SortSet Conj -> Bool . + op var-sat-conjset : FModule SortSet NegEqConjSet -> Bool . --- Consistency checking - op consistent? : FModule SortSet NegConjSet -> Bool . - op fin-consistent? : FModule QidList Stream{UnitList}{WrapTermList} NegConj -> Bool . - op inf-consistent? : FModule NegConj -> Bool . + op consistent? : FModule SortSet NegEqConjSet -> Bool . + op fin-consistent? : FModule QidList Stream{UnitList}{WrapTermList} NegEqConj -> Bool . + op inf-consistent? : FModule NegEqConj -> Bool . - var Q : Qid . var QS : QidSet . var PC : PosConj . var F? : FOForm? . var SBS : SubstitutionSet . - var C : Conj . var M : Module . var NC : NegConj . var QL : QidList . var SB : Substitution . - var S : Sort . var FM : FModule . var QF : QFForm . var CS : ConjSet . var NCS : NegConjSet . + var Q : Qid . var QS : QidSet . var PC : PosEqConj . var F : Form . var SBS : SubstitutionSet . + var C : Conj . var M : Module . var NC : NegEqConj . var QL : QidList . var SB : Substitution . + var S : Sort . var FM : FModule . var QF : Form . var CS : EqConjSet . var NCS : NegEqConjSet . var SS FSS ISS : SortSet . var SL : Stream{UnitList}{WrapTermList} . var WTL : WrapTermList . - var T T' : Term . var TS : TermSet . var D : Disj . var NC? : NegConj? . + var T T' : Term . var TS : TermSet . var D : Disj . --- FIXME: filtering NC finite sorts by set computed by original formula QF is slightly incorrect --- --- this is because NC, under instantiation, may have variables in sorts in a lower type --- --- thus we should filter by all types in QF or below --- assuming that variant equations all --- have no free vars on RHS, then this means the new types of variables cannot be by rewriting - --- INP: Module [SortSet SortSet] QFForm - --- PRE: [1] Sorts and QFForm are well-defined in Module + --- INP: Module [SortSet SortSet] Form + --- PRE: [1] Sorts and Form are well-defined in Module --- [2] The Module represents an OS-Compact theory --- OUT: This function takes a Module (optionally two finite/infinite sort sets) - --- and a QFFORM and returns true iff the QFForm is valid/satisfiable in + --- and a QFFORM and returns true iff the Form is valid/satisfiable in --- the given Module. It proceeds by: --- [1] (negating the formula in, converting to NNF, in case of validity) and computing the finite sort set [eqs 1-4] --- [2] recognizing certain patterns which can be optimized and then doing DNF conversion @@ -222,14 +217,14 @@ fmod VAR-SAT is --- NB: Entry point(s)/pre-processing eq var-valid(M,QF) = var-valid(M,none,none,QF) . - eq var-valid(M,FSS,ISS,QF) = not var-sat(M,FSS,ISS,toNNF(~ QF)) . + eq var-valid(M,FSS,ISS,QF) = not var-sat(M,FSS,ISS,nnf(~ QF)) . eq var-sat(M,QF) = var-sat(M,none,none,QF) . eq var-sat(M,FSS,ISS,QF) = var-sat-opt(addDecls(emptyFModule,setRls(M,none)),fin-sorts(M,QF,FSS,ISS),QF) . --- NB: Special Pattern Recognition Before DNF conversion - ceq var-sat-opt(FM,FSS,PC /\ NC? /\ D) = var-sat-opt(FM,FSS,disj-join($renameForm(FM,(NC? /\ D) << ctor-unifiers(FM,toUnifProb(PC))))) - if not PC :: ConstConj . - eq var-sat-opt(FM,FSS,QF) = var-sat-disj(FM,FSS,simplify(toDNF(QF))) [owise] . + ceq var-sat-opt(FM,FSS,PC /\ NC /\ D) = var-sat-opt(FM,FSS,disj-join($renameForm(FM,(NC /\ D) << ctor-unifiers(FM,toUnifProb(PC))))) + if not PC :: TruthLit . + eq var-sat-opt(FM,FSS,QF) = var-sat-disj(FM,FSS,dnf(QF)) [owise] . eq var-sat-disj(FM,FSS,tt) = true . eq var-sat-disj(FM,FSS,ff) = false . @@ -264,22 +259,22 @@ fmod VAR-SAT is eq inf-consistent?(FM,NC) = unequal(FM,NC) . --- Auxiliary functions - op fin-sorts : Module QFForm SortSet SortSet -> SortSet . + op fin-sorts : Module Form SortSet SortSet -> SortSet . eq fin-sorts(FM,QF,FSS,ISS) = FSS ; get-finite-sorts(ctor-sig(FM),getType(vars(QF)) - (FSS ; ISS)) . op not-empty? : SubstitutionSet -> Bool . eq not-empty?(SBS) = SBS =/= .SubstitutionSet . - op $renameForm : Module ConjSet -> ConjSet . - op $renameForm : Module FOForm? -> FOForm? . - op $renameForm : Module Conj -> Conj . + op $renameForm : Module EqConjSet -> [EqConjSet] . + op $renameForm : Module Form -> [Form] . + op $renameForm : Module Conj -> [Conj] . eq $renameForm(M,CS) = downTerm(renameTmpVar(M,upTerm(CS)),ff) . - eq $renameForm(M,F?) = downTerm(renameTmpVar(M,upTerm(F?)),ff) . + eq $renameForm(M,F) = downTerm(renameTmpVar(M,upTerm(F)),ff) . - op nf-ctor-variants : FModule NegConj -> NegConjSet . + op nf-ctor-variants : FModule NegEqConj -> NegEqConjSet . eq nf-ctor-variants(FM,NC) = toDUPs(getTerms(ctor-variants(hl-func(FM),toHL(FM,FormToTL(NC))))) . - op toDUPs : TermSet ~> NegEqConjSet . + op toDUPs : TermSet -> [NegEqConjSet] . eq toDUPs(T | TS) = TLToNegEqConj((toTL(T))) | toDUPs(TS) . eq toDUPs(.TermSet) = mtFormSet . endfm diff --git a/src/Mixfix/yices2_Bindings.cc b/src/Mixfix/yices2_Bindings.cc index da1e2519..6a793d97 100644 --- a/src/Mixfix/yices2_Bindings.cc +++ b/src/Mixfix/yices2_Bindings.cc @@ -62,7 +62,19 @@ VariableGenerator::VariableGenerator(const SMT_Info& smtInfo) if (nrUsers == 0) yices_init(); ++nrUsers; - smtContext = yices_new_context(NULL); + +// // Default config (Does not include Non-linear Real Arithmetic) +// smtContext = yices_new_context(NULL); + + // Allows NRA + ctx_config_t *config = yices_new_config(); +// int32_t ret = yices_default_config_for_logic(config, "QF_NRA"); + int32_t ret = yices_default_config_for_logic(config, "QF_NIRA"); + yices_set_config(config, "mode", "one-shot"); + Assert(ret == 0 || ret == -1, // Success or unchanged. + "Yices logic unknown or unsupported"); + smtContext = yices_new_context(config); + yices_free_config(config); } VariableGenerator::~VariableGenerator() diff --git a/tests/Misc/Makefile.am b/tests/Misc/Makefile.am index 740c1438..97800020 100644 --- a/tests/Misc/Makefile.am +++ b/tests/Misc/Makefile.am @@ -19,7 +19,6 @@ TESTS = \ CU_Unification.maude \ assocUnification.maude \ sreduce.maude \ - smtTest.maude \ narrow.maude \ continue.maude \ parse.maude \ diff --git a/tests/systems/Makefile.am b/tests/systems/Makefile.am index 25f11ce2..6fc04dbc 100644 --- a/tests/systems/Makefile.am +++ b/tests/systems/Makefile.am @@ -1,5 +1,7 @@ include ../test.Makefile +SUBDIRS = nelson-oppen + TESTS = \ nim.maude \ bank-account.maude \ diff --git a/tests/systems/nelson-oppen/Makefile.am b/tests/systems/nelson-oppen/Makefile.am new file mode 100644 index 00000000..bc75fb9b --- /dev/null +++ b/tests/systems/nelson-oppen/Makefile.am @@ -0,0 +1,13 @@ +include ../../test.Makefile + +TESTS = \ + hereditarily-finite-set.maude \ + integer-list.maude \ + matrix.maude + +RESULT_FILES = \ + hereditarily-finite-set.exepected \ + integer-list.exepected \ + matrix.exepected + +EXTRA_DIST = $(TESTS) $(RESULT_FILES) diff --git a/tests/systems/nelson-oppen/hereditarily-finite-set.check b/tests/systems/nelson-oppen/hereditarily-finite-set.check new file mode 100755 index 00000000..ddb31aa6 --- /dev/null +++ b/tests/systems/nelson-oppen/hereditarily-finite-set.check @@ -0,0 +1 @@ +check_config_h USE_CVC4 || return "$exit_code_skip" diff --git a/tests/systems/nelson-oppen/hereditarily-finite-set.expected b/tests/systems/nelson-oppen/hereditarily-finite-set.expected new file mode 100644 index 00000000..309e8a8b --- /dev/null +++ b/tests/systems/nelson-oppen/hereditarily-finite-set.expected @@ -0,0 +1,97 @@ +========================================== +reduce in TEST-HEREDITARILY-FINITE-SET-SANITY : M,M,M' == M,M' . +rewrites: 2 +result Bool: true +========================================== +reduce in TEST-HEREDITARILY-FINITE-SET-SANITY : {{empty},empty,{{empty}}} == {{ + empty},empty,{{empty}}} . +rewrites: 1 +result Bool: true +========================================== +reduce in TEST-HEREDITARILY-FINITE-SET-SANITY : empty C= {empty} == tt . +rewrites: 2 +result Bool: true +========================================== +reduce in TEST-HEREDITARILY-FINITE-SET-SANITY : {empty} C= empty . +rewrites: 1 +result MyBool: ff +========================================== +reduce in TEST-HEREDITARILY-FINITE-SET-SANITY : {empty} C= {{empty}} . +rewrites: 0 +result MyBool: {empty} C= {{empty}} +========================================== +reduce in TEST-HEREDITARILY-FINITE-SET-SANITY : {empty} C= {empty,{empty}} == + tt . +rewrites: 2 +result Bool: true +========================================== +reduce in TEST-HEREDITARILY-FINITE-SET-SANITY : {empty} C= {{empty},{{empty}}} + . +rewrites: 0 +result MyBool: {empty} C= {{empty},{{empty}}} +========================================== +reduce in TEST-HEREDITARILY-FINITE-SET-SANITY : {M,M'} C= {M,M'} . +rewrites: 1 +result MyBool: tt +========================================== +reduce in TEST-HEREDITARILY-FINITE-SET-SANITY : {empty,empty} C= {empty} . +rewrites: 2 +result MyBool: tt +========================================== +reduce in HEREDITARILY-FINITE-SET-TEST-VARSAT : upTerm({X:Real,Z:Real,Y:Real} + C= {X:Real}) . +rewrites: 2 +result Term: '_C=_['`{_`}['_`,_['Z:Real,'Y:Real]],'`{_`}['X:Real]] +========================================== +reduce in HEREDITARILY-FINITE-SET-TEST-VARSAT : upTerm({X:Real,Z:Real,Y:Real} + C= {A:Real}) . +rewrites: 1 +result Term: '_C=_['`{_`}['_`,_['Z:Real,'X:Real,'Y:Real]],'`{_`}['A:Real]] +========================================== +reduce in HEREDITARILY-FINITE-SET-TEST-VARSAT : upTerm({X:Real,Z:Real,Y:Real}) + . +rewrites: 1 +result Term: '`{_`}['_`,_['Z:Real,'X:Real,'Y:Real]] +========================================== +reduce in HEREDITARILY-FINITE-SET-TEST-VARSAT : var-sat(upModule('HFS-REAL, + true), 'tt.MyBool ?= upTerm({empty,M} C= {empty})) . +rewrites: 1488 +result Bool: (true).Bool +========================================== +reduce in HEREDITARILY-FINITE-SET-TEST-VARSAT : var-sat(upModule('HFS-REAL, + true), 'tt.MyBool ?= upTerm({empty,M} C= {empty}) /\ 'empty.Set != upTerm( + M)) . +rewrites: 339 +result Bool: (false).Bool +========================================== +reduce in HEREDITARILY-FINITE-SET-TEST-VARSAT : var-sat(upModule('HFS-REAL, + true), 'tt.MyBool ?= upTerm({empty,M} C= {empty,M'})) . +rewrites: 549 +result Bool: (true).Bool +========================================== +reduce in HEREDITARILY-FINITE-SET-TEST-VARSAT : var-sat(upModule('HFS-REAL, + true), upTerm({X:Real}) ?= upTerm({X:Real,Z:Real,Y:Real})) == (true).Bool . +rewrites: 224 +result Bool: (true).Bool +========================================== +reduce in HEREDITARILY-FINITE-SET-TEST-VARSAT : var-sat(upModule('HFS-REAL, + true), 'tt.MyBool ?= upTerm({X:Real,Z:Real,Y:Real} C= {X:Real})) == ( + true).Bool . +rewrites: 144 +result Bool: (true).Bool +Warning: sort declarations for operator removeNonExecs failed preregularity + check on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +Warning: sort declarations for operator $rmVariants failed preregularity check + on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +Warning: sort declarations for operator clearNonExec failed preregularity check + on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +Warning: sort declarations for operator resolveNames failed preregularity check + on 6 out of 47 sort tuples. First such tuple is (Type). +Warning: sort declarations for operator resolveNames failed preregularity check + on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +========================================== +reduce in NELSON-OPPEN-COMBINATION : nelson-oppen-valid(tagged(tt, ('check-sat + > 'smt-sat) ; 'mod > 'REAL),tagged(tt, ('check-sat > 'var-sat) ; 'mod > + 'HFS-REAL), ('tt.MyBool ?= '_C=_['`{_`}['_`,_['_*_['Z:Real,'Z:Real],'_*_[ + 'X:Real,'X:Real],'_*_['Y:Real,'Y:Real]]],'`{_`}['_`,_['A:Real]]] /\ 'X:Real + != 'Y:Real) => ('X:Real ?= 'Z:Real \/ 'Y:Real ?= 'Z:Real)) . diff --git a/tests/systems/nelson-oppen/integer-list.check b/tests/systems/nelson-oppen/integer-list.check new file mode 100755 index 00000000..bf5f16e8 --- /dev/null +++ b/tests/systems/nelson-oppen/integer-list.check @@ -0,0 +1 @@ +check_config_h USE_CVC4 || return "$exit_code_skip" diff --git a/tests/systems/nelson-oppen/integer-list.expected b/tests/systems/nelson-oppen/integer-list.expected new file mode 100644 index 00000000..c365d39f --- /dev/null +++ b/tests/systems/nelson-oppen/integer-list.expected @@ -0,0 +1,60 @@ +Warning: sort declarations for operator removeNonExecs failed preregularity + check on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +Warning: sort declarations for operator $rmVariants failed preregularity check + on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +Warning: sort declarations for operator clearNonExec failed preregularity check + on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +Warning: sort declarations for operator resolveNames failed preregularity check + on 6 out of 47 sort tuples. First such tuple is (Type). +Warning: sort declarations for operator resolveNames failed preregularity check + on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +========================================== +reduce in TEST-NO-SMT-LIST : nelson-oppen-sat(tagged(tt, ('check-sat > + 'smt-sat) ; 'mod > 'INTEGER),tagged(tt, ('check-sat > 'var-sat) ; 'mod > + 'INTEGER-LIST), '1.Integer ?= '_-_['_*_['2.Integer,'head[ + 'L:NeIntegerList]],'_*_['2.Integer,'head['M:NeIntegerList]]]) == ( + false).Bool . +rewrites: 341 +result Bool: (true).Bool +========================================== +reduce in TEST-NO-SMT-LIST : nelson-oppen-sat(tagged(tt, ('check-sat > + 'smt-sat) ; 'mod > 'INTEGER),tagged(tt, ('check-sat > 'var-sat) ; 'mod > + 'INTEGER-LIST), '0.Integer ?= '_-_['_*_['2.Integer,'head[ + 'L:NeIntegerList]],'_*_['2.Integer,'head['M:NeIntegerList]]]) == ( + true).Bool . +rewrites: 3519 +result Bool: (false).Bool +========================================== +reduce in TEST-NO-SMT-LIST : nelson-oppen-sat(tagged(tt, ('check-sat > + 'smt-sat) ; 'mod > 'INTEGER),tagged(tt, ('check-sat > 'var-sat) ; 'mod > + 'INTEGER-LIST), '0.Integer ?= '_-_['head['L:NeIntegerList],'_*_['2.Integer, + 'head['M:NeIntegerList]]]) == (true).Bool . +rewrites: 7464 +result Bool: (true).Bool +========================================== +reduce in TEST-NO-SMT-LIST : nelson-oppen-valid(tagged(tt, ('check-sat > + 'smt-sat) ; 'mod > 'INTEGER),tagged(tt, ('check-sat > 'var-sat) ; 'mod > + 'INTEGER-LIST), ('true.Boolean ?= '_<=_['1.Integer,'head['L:NeIntegerList]] + /\ 'true.Boolean ?= '_<=_['head['L:NeIntegerList],'2.Integer]) => ( + '1.Integer ?= 'head['L:NeIntegerList] \/ '2.Integer ?= 'head[ + 'L:NeIntegerList])) . +Purified: + tagged('#makeVariable`(head`[L:NeIntegerList`]`):Integer ?= 'head[ + 'L:NeIntegerList] /\ '#makeVariable`(1.Integer`):Integer != + '#makeVariable`(head`[L:NeIntegerList`]`):Integer /\ + '#makeVariable`(2.Integer`):Integer != + '#makeVariable`(head`[L:NeIntegerList`]`):Integer, ('check-sat > 'var-sat) + ; ('convex > 'false) ; 'mod > 'INTEGER-LIST) + tagged('#makeVariable`(1.Integer`):Integer ?= '1.Integer /\ + '#makeVariable`(2.Integer`):Integer ?= '2.Integer /\ 'true.Boolean ?= + '_<=_['#makeVariable`(head`[L:NeIntegerList`]`):Integer,'2.Integer] /\ + 'true.Boolean ?= '_<=_['1.Integer, + '#makeVariable`(head`[L:NeIntegerList`]`):Integer] /\ + '#makeVariable`(1.Integer`):Integer != + '#makeVariable`(head`[L:NeIntegerList`]`):Integer /\ + '#makeVariable`(2.Integer`):Integer != + '#makeVariable`(head`[L:NeIntegerList`]`):Integer, ('check-sat > 'smt-sat) + ; ('convex > 'false) ; 'mod > 'INTEGER) +rewrites: 1851 +result Bool: (true).Bool +Bye. diff --git a/tests/systems/nelson-oppen/matrix.check b/tests/systems/nelson-oppen/matrix.check new file mode 100755 index 00000000..d3d99c8d --- /dev/null +++ b/tests/systems/nelson-oppen/matrix.check @@ -0,0 +1 @@ +check_config_h USE_YICES2 || return "$exit_code_skip" diff --git a/tests/systems/nelson-oppen/matrix.expected b/tests/systems/nelson-oppen/matrix.expected new file mode 100644 index 00000000..7994f578 --- /dev/null +++ b/tests/systems/nelson-oppen/matrix.expected @@ -0,0 +1,123 @@ +Warning: sort declarations for operator removeNonExecs failed preregularity + check on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +Warning: sort declarations for operator $rmVariants failed preregularity check + on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +Warning: sort declarations for operator clearNonExec failed preregularity check + on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +Warning: sort declarations for operator resolveNames failed preregularity check + on 6 out of 47 sort tuples. First such tuple is (Type). +Warning: sort declarations for operator resolveNames failed preregularity check + on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +========================================== +reduce in MATRIX-TEST : nelson-oppen-valid(tagged(tt, ('check-sat > 'smt-sat) ; + 'mod > 'REAL),tagged(tt, ('check-sat > 'var-sat) ; 'mod > 'MATRIX-REAL), ( + multiply('A:Matrix, 'B:Matrix) ?= identity('0/1.Real, '1/1.Real)) => ( + '0/1.Real != determinant('A:Matrix))) . +Purified: + tagged('#makeVariable`(0/1.Real`):Real ?= '0/1.Real /\ + '#makeVariable`(1/1.Real`):Real ?= '1/1.Real /\ '#makeVariable`(_+_`[_*_`[#makeVariable`(m11`[A:Matrix`]`):Real`,#makeVariable`(m11`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m12`[A:Matrix`]`):Real`,#makeVariable`(m21`[B:Matrix`]`):Real`]`]`):Real ?= '_+_['_*_['#makeVariable`(m11`[A:Matrix`]`):Real, + '#makeVariable`(m11`[B:Matrix`]`):Real],'_*_[ + '#makeVariable`(m12`[A:Matrix`]`):Real, + '#makeVariable`(m21`[B:Matrix`]`):Real]] /\ '#makeVariable`(_+_`[_*_`[#makeVariable`(m11`[A:Matrix`]`):Real`,#makeVariable`(m12`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m12`[A:Matrix`]`):Real`,#makeVariable`(m22`[B:Matrix`]`):Real`]`]`):Real ?= '_+_['_*_['#makeVariable`(m11`[A:Matrix`]`):Real, + '#makeVariable`(m12`[B:Matrix`]`):Real],'_*_[ + '#makeVariable`(m12`[A:Matrix`]`):Real, + '#makeVariable`(m22`[B:Matrix`]`):Real]] /\ '#makeVariable`(_+_`[_*_`[#makeVariable`(m21`[A:Matrix`]`):Real`,#makeVariable`(m11`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m22`[A:Matrix`]`):Real`,#makeVariable`(m21`[B:Matrix`]`):Real`]`]`):Real ?= '_+_['_*_['#makeVariable`(m21`[A:Matrix`]`):Real, + '#makeVariable`(m11`[B:Matrix`]`):Real],'_*_[ + '#makeVariable`(m22`[A:Matrix`]`):Real, + '#makeVariable`(m21`[B:Matrix`]`):Real]] /\ '#makeVariable`(_+_`[_*_`[#makeVariable`(m21`[A:Matrix`]`):Real`,#makeVariable`(m12`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m22`[A:Matrix`]`):Real`,#makeVariable`(m22`[B:Matrix`]`):Real`]`]`):Real ?= '_+_['_*_['#makeVariable`(m21`[A:Matrix`]`):Real, + '#makeVariable`(m12`[B:Matrix`]`):Real],'_*_[ + '#makeVariable`(m22`[A:Matrix`]`):Real, + '#makeVariable`(m22`[B:Matrix`]`):Real]] /\ '0/1.Real ?= '_-_['_*_[ + '#makeVariable`(m11`[A:Matrix`]`):Real, + '#makeVariable`(m22`[A:Matrix`]`):Real],'_*_[ + '#makeVariable`(m12`[A:Matrix`]`):Real, + '#makeVariable`(m21`[A:Matrix`]`):Real]], ('check-sat > 'smt-sat) ; ( + 'convex > 'false) ; 'mod > 'REAL) + tagged('#makeVariable`(m11`[A:Matrix`]`):Real ?= 'm11['A:Matrix] /\ + '#makeVariable`(m11`[B:Matrix`]`):Real ?= 'm11['B:Matrix] /\ + '#makeVariable`(m12`[A:Matrix`]`):Real ?= 'm12['A:Matrix] /\ + '#makeVariable`(m12`[B:Matrix`]`):Real ?= 'm12['B:Matrix] /\ + '#makeVariable`(m21`[A:Matrix`]`):Real ?= 'm21['A:Matrix] /\ + '#makeVariable`(m21`[B:Matrix`]`):Real ?= 'm21['B:Matrix] /\ + '#makeVariable`(m22`[A:Matrix`]`):Real ?= 'm22['A:Matrix] /\ + '#makeVariable`(m22`[B:Matrix`]`):Real ?= 'm22['B:Matrix] /\ 'matrix[ + '#makeVariable`(1/1.Real`):Real,'#makeVariable`(0/1.Real`):Real, + '#makeVariable`(0/1.Real`):Real,'#makeVariable`(1/1.Real`):Real] ?= + 'matrix['#makeVariable`(_+_`[_*_`[#makeVariable`(m11`[A:Matrix`]`):Real`,#makeVariable`(m11`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m12`[A:Matrix`]`):Real`,#makeVariable`(m21`[B:Matrix`]`):Real`]`]`):Real,'#makeVariable`(_+_`[_*_`[#makeVariable`(m11`[A:Matrix`]`):Real`,#makeVariable`(m12`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m12`[A:Matrix`]`):Real`,#makeVariable`(m22`[B:Matrix`]`):Real`]`]`):Real,'#makeVariable`(_+_`[_*_`[#makeVariable`(m21`[A:Matrix`]`):Real`,#makeVariable`(m11`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m22`[A:Matrix`]`):Real`,#makeVariable`(m21`[B:Matrix`]`):Real`]`]`):Real,'#makeVariable`(_+_`[_*_`[#makeVariable`(m21`[A:Matrix`]`):Real`,#makeVariable`(m12`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m22`[A:Matrix`]`):Real`,#makeVariable`(m22`[B:Matrix`]`):Real`]`]`):Real], ('check-sat > 'var-sat) ; ('convex > 'false) ; 'mod > 'MATRIX-REAL) +EqualityProp: 'MATRIX-REAL: => '#makeVariable`(0/1.Real`):Real ?= '#makeVariable`(_+_`[_*_`[#makeVariable`(m11`[A:Matrix`]`):Real`,#makeVariable`(m12`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m12`[A:Matrix`]`):Real`,#makeVariable`(m22`[B:Matrix`]`):Real`]`]`):Real +EqualityProp: 'MATRIX-REAL: => '#makeVariable`(1/1.Real`):Real ?= '#makeVariable`(_+_`[_*_`[#makeVariable`(m11`[A:Matrix`]`):Real`,#makeVariable`(m11`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m12`[A:Matrix`]`):Real`,#makeVariable`(m21`[B:Matrix`]`):Real`]`]`):Real +EqualityProp: 'REAL: => '#makeVariable`(_+_`[_*_`[#makeVariable`(m11`[A:Matrix`]`):Real`,#makeVariable`(m12`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m12`[A:Matrix`]`):Real`,#makeVariable`(m22`[B:Matrix`]`):Real`]`]`):Real ?= '#makeVariable`(_+_`[_*_`[#makeVariable`(m21`[A:Matrix`]`):Real`,#makeVariable`(m12`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m22`[A:Matrix`]`):Real`,#makeVariable`(m22`[B:Matrix`]`):Real`]`]`):Real +EqualityProp: 'MATRIX-REAL: => '#makeVariable`(_+_`[_*_`[#makeVariable`(m11`[A:Matrix`]`):Real`,#makeVariable`(m11`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m12`[A:Matrix`]`):Real`,#makeVariable`(m21`[B:Matrix`]`):Real`]`]`):Real ?= '#makeVariable`(_+_`[_*_`[#makeVariable`(m21`[A:Matrix`]`):Real`,#makeVariable`(m11`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m22`[A:Matrix`]`):Real`,#makeVariable`(m21`[B:Matrix`]`):Real`]`]`):Real +EqualityProp: 'REAL: => '#makeVariable`(m11`[A:Matrix`]`):Real ?= + '#makeVariable`(m21`[A:Matrix`]`):Real +EqualityProp: 'REAL: => '#makeVariable`(m12`[A:Matrix`]`):Real ?= + '#makeVariable`(m22`[A:Matrix`]`):Real +EqualityProp: 'MATRIX-REAL: => '#makeVariable`(_+_`[_*_`[#makeVariable`(m21`[A:Matrix`]`):Real`,#makeVariable`(m11`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m22`[A:Matrix`]`):Real`,#makeVariable`(m21`[B:Matrix`]`):Real`]`]`):Real ?= '#makeVariable`(_+_`[_*_`[#makeVariable`(m21`[A:Matrix`]`):Real`,#makeVariable`(m12`[B:Matrix`]`):Real`]`,_*_`[#makeVariable`(m22`[A:Matrix`]`):Real`,#makeVariable`(m22`[B:Matrix`]`):Real`]`]`):Real +rewrites: 73440 +result Bool: (true).Bool +========================================== +reduce in MATRIX-TEST : nelson-oppen-valid(tagged(tt, (('check-sat > 'smt-sat) + ; 'convex > 'false) ; 'mod > 'INTEGER),tagged(tt, (('check-sat > 'var-sat) + ; 'convex > 'true) ; 'mod > 'MATRIX-INTEGER), (multiply('A:Matrix, + 'B:Matrix) ?= identity('0.Integer, '1.Integer) /\ '0.Integer ?= 'm21[ + 'A:Matrix] /\ '0.Integer ?= 'm21['B:Matrix]) => ('1.Integer ?= determinant( + 'A:Matrix) \/ determinant('A:Matrix) ?= '-_['1.Integer])) . +Purified: + tagged('#makeVariable`(0.Integer`):Integer ?= + '#makeVariable`(m21`[A:Matrix`]`):Integer /\ + '#makeVariable`(0.Integer`):Integer ?= + '#makeVariable`(m21`[B:Matrix`]`):Integer /\ + '#makeVariable`(0.Integer`):Integer ?= '0.Integer /\ + '#makeVariable`(1.Integer`):Integer ?= '1.Integer /\ '#makeVariable`(_+_`[_*_`[#makeVariable`(m11`[A:Matrix`]`):Integer`,#makeVariable`(m11`[B:Matrix`]`):Integer`]`,_*_`[#makeVariable`(m12`[A:Matrix`]`):Integer`,#makeVariable`(m21`[B:Matrix`]`):Integer`]`]`):Integer ?= '_+_['_*_[ + '#makeVariable`(m11`[A:Matrix`]`):Integer, + '#makeVariable`(m11`[B:Matrix`]`):Integer],'_*_[ + '#makeVariable`(m12`[A:Matrix`]`):Integer, + '#makeVariable`(m21`[B:Matrix`]`):Integer]] /\ '#makeVariable`(_+_`[_*_`[#makeVariable`(m11`[A:Matrix`]`):Integer`,#makeVariable`(m12`[B:Matrix`]`):Integer`]`,_*_`[#makeVariable`(m12`[A:Matrix`]`):Integer`,#makeVariable`(m22`[B:Matrix`]`):Integer`]`]`):Integer ?= '_+_['_*_[ + '#makeVariable`(m11`[A:Matrix`]`):Integer, + '#makeVariable`(m12`[B:Matrix`]`):Integer],'_*_[ + '#makeVariable`(m12`[A:Matrix`]`):Integer, + '#makeVariable`(m22`[B:Matrix`]`):Integer]] /\ '#makeVariable`(_+_`[_*_`[#makeVariable`(m21`[A:Matrix`]`):Integer`,#makeVariable`(m11`[B:Matrix`]`):Integer`]`,_*_`[#makeVariable`(m22`[A:Matrix`]`):Integer`,#makeVariable`(m21`[B:Matrix`]`):Integer`]`]`):Integer ?= '_+_['_*_[ + '#makeVariable`(m21`[A:Matrix`]`):Integer, + '#makeVariable`(m11`[B:Matrix`]`):Integer],'_*_[ + '#makeVariable`(m22`[A:Matrix`]`):Integer, + '#makeVariable`(m21`[B:Matrix`]`):Integer]] /\ '#makeVariable`(_+_`[_*_`[#makeVariable`(m21`[A:Matrix`]`):Integer`,#makeVariable`(m12`[B:Matrix`]`):Integer`]`,_*_`[#makeVariable`(m22`[A:Matrix`]`):Integer`,#makeVariable`(m22`[B:Matrix`]`):Integer`]`]`):Integer ?= '_+_['_*_[ + '#makeVariable`(m21`[A:Matrix`]`):Integer, + '#makeVariable`(m12`[B:Matrix`]`):Integer],'_*_[ + '#makeVariable`(m22`[A:Matrix`]`):Integer, + '#makeVariable`(m22`[B:Matrix`]`):Integer]] /\ '1.Integer != '_-_['_*_[ + '#makeVariable`(m11`[A:Matrix`]`):Integer, + '#makeVariable`(m22`[A:Matrix`]`):Integer],'_*_[ + '#makeVariable`(m12`[A:Matrix`]`):Integer, + '#makeVariable`(m21`[A:Matrix`]`):Integer]] /\ '-_['1.Integer] != '_-_[ + '_*_['#makeVariable`(m11`[A:Matrix`]`):Integer, + '#makeVariable`(m22`[A:Matrix`]`):Integer],'_*_[ + '#makeVariable`(m12`[A:Matrix`]`):Integer, + '#makeVariable`(m21`[A:Matrix`]`):Integer]], ('check-sat > 'smt-sat) ; ( + 'convex > 'false) ; 'mod > 'INTEGER) + tagged('#makeVariable`(0.Integer`):Integer ?= + '#makeVariable`(m21`[A:Matrix`]`):Integer /\ + '#makeVariable`(0.Integer`):Integer ?= + '#makeVariable`(m21`[B:Matrix`]`):Integer /\ + '#makeVariable`(m11`[A:Matrix`]`):Integer ?= 'm11['A:Matrix] /\ + '#makeVariable`(m11`[B:Matrix`]`):Integer ?= 'm11['B:Matrix] /\ + '#makeVariable`(m12`[A:Matrix`]`):Integer ?= 'm12['A:Matrix] /\ + '#makeVariable`(m12`[B:Matrix`]`):Integer ?= 'm12['B:Matrix] /\ + '#makeVariable`(m21`[A:Matrix`]`):Integer ?= 'm21['A:Matrix] /\ + '#makeVariable`(m21`[B:Matrix`]`):Integer ?= 'm21['B:Matrix] /\ + '#makeVariable`(m22`[A:Matrix`]`):Integer ?= 'm22['A:Matrix] /\ + '#makeVariable`(m22`[B:Matrix`]`):Integer ?= 'm22['B:Matrix] /\ 'matrix[ + '#makeVariable`(1.Integer`):Integer,'#makeVariable`(0.Integer`):Integer, + '#makeVariable`(0.Integer`):Integer,'#makeVariable`(1.Integer`):Integer] ?= + 'matrix['#makeVariable`(_+_`[_*_`[#makeVariable`(m11`[A:Matrix`]`):Integer`,#makeVariable`(m11`[B:Matrix`]`):Integer`]`,_*_`[#makeVariable`(m12`[A:Matrix`]`):Integer`,#makeVariable`(m21`[B:Matrix`]`):Integer`]`]`):Integer,'#makeVariable`(_+_`[_*_`[#makeVariable`(m11`[A:Matrix`]`):Integer`,#makeVariable`(m12`[B:Matrix`]`):Integer`]`,_*_`[#makeVariable`(m12`[A:Matrix`]`):Integer`,#makeVariable`(m22`[B:Matrix`]`):Integer`]`]`):Integer,'#makeVariable`(_+_`[_*_`[#makeVariable`(m21`[A:Matrix`]`):Integer`,#makeVariable`(m11`[B:Matrix`]`):Integer`]`,_*_`[#makeVariable`(m22`[A:Matrix`]`):Integer`,#makeVariable`(m21`[B:Matrix`]`):Integer`]`]`):Integer,'#makeVariable`(_+_`[_*_`[#makeVariable`(m21`[A:Matrix`]`):Integer`,#makeVariable`(m12`[B:Matrix`]`):Integer`]`,_*_`[#makeVariable`(m22`[A:Matrix`]`):Integer`,#makeVariable`(m22`[B:Matrix`]`):Integer`]`]`):Integer], ( + 'check-sat > 'var-sat) ; ('convex > 'true) ; 'mod > 'MATRIX-INTEGER) +EqualityProp: 'INTEGER: => '#makeVariable`(0.Integer`):Integer ?= '#makeVariable`(_+_`[_*_`[#makeVariable`(m21`[A:Matrix`]`):Integer`,#makeVariable`(m11`[B:Matrix`]`):Integer`]`,_*_`[#makeVariable`(m22`[A:Matrix`]`):Integer`,#makeVariable`(m21`[B:Matrix`]`):Integer`]`]`):Integer +EqualityProp: 'INTEGER: => '#makeVariable`(_+_`[_*_`[#makeVariable`(m21`[A:Matrix`]`):Integer`,#makeVariable`(m11`[B:Matrix`]`):Integer`]`,_*_`[#makeVariable`(m22`[A:Matrix`]`):Integer`,#makeVariable`(m21`[B:Matrix`]`):Integer`]`]`):Integer ?= '#makeVariable`(m21`[A:Matrix`]`):Integer +EqualityProp: 'INTEGER: => '#makeVariable`(m21`[A:Matrix`]`):Integer ?= + '#makeVariable`(m21`[B:Matrix`]`):Integer +EqualityProp: 'MATRIX-INTEGER: => '#makeVariable`(1.Integer`):Integer ?= '#makeVariable`(_+_`[_*_`[#makeVariable`(m11`[A:Matrix`]`):Integer`,#makeVariable`(m11`[B:Matrix`]`):Integer`]`,_*_`[#makeVariable`(m12`[A:Matrix`]`):Integer`,#makeVariable`(m21`[B:Matrix`]`):Integer`]`]`):Integer +EqualityProp: 'INTEGER: => '#makeVariable`(m11`[A:Matrix`]`):Integer ?= + '#makeVariable`(m11`[B:Matrix`]`):Integer +EqualityProp: 'MATRIX-INTEGER: => '#makeVariable`(_+_`[_*_`[#makeVariable`(m11`[A:Matrix`]`):Integer`,#makeVariable`(m11`[B:Matrix`]`):Integer`]`,_*_`[#makeVariable`(m12`[A:Matrix`]`):Integer`,#makeVariable`(m21`[B:Matrix`]`):Integer`]`]`):Integer ?= '#makeVariable`(_+_`[_*_`[#makeVariable`(m21`[A:Matrix`]`):Integer`,#makeVariable`(m12`[B:Matrix`]`):Integer`]`,_*_`[#makeVariable`(m22`[A:Matrix`]`):Integer`,#makeVariable`(m22`[B:Matrix`]`):Integer`]`]`):Integer +rewrites: 61607 +result Bool: (true).Bool +Bye. diff --git a/tests/tools/meta/Makefile.am b/tests/tools/meta/Makefile.am index 34ebb83e..db311df1 100644 --- a/tests/tools/meta/Makefile.am +++ b/tests/tools/meta/Makefile.am @@ -10,6 +10,11 @@ TESTS = \ mtemplate.maude \ mtransform.maude \ mconstruction.maude \ + nelson-oppen-combination.maude \ + nelson-oppen/hereditarily-finite-set.maude \ + nelson-oppen/integer-list.maude \ + nelson-oppen/lexical-trichotomy-law.maude \ + nelson-oppen/matrix.maude \ sort-ops.maude \ unification.maude \ variables.maude \ @@ -26,6 +31,11 @@ RESULT_FILES = \ mtemplate.expected \ mtransform.expected \ mconstruction.expected \ + nelson-oppen-combination.expected \ + nelson-oppen/hereditarily-finite-set.expected \ + nelson-oppen/integer-list.expected \ + nelson-oppen/lexical-trichotomy-law.expected \ + nelson-oppen/matrix.expected \ sort-ops.expected \ unification.expected \ variables.expected \ diff --git a/tests/tools/meta/eqform.expected b/tests/tools/meta/eqform.expected index 0d09b1fd..583a5313 100644 --- a/tests/tools/meta/eqform.expected +++ b/tests/tools/meta/eqform.expected @@ -14,13 +14,29 @@ rewrites: 36 result Bool: true ========================================== reduce in EQFORM-TEST : f1 :: Form . -rewrites: 7 +rewrites: 14 result Bool: true ========================================== reduce in EQFORM-TEST : f2 :: Form . -rewrites: 11 +rewrites: 21 result Bool: true ========================================== +reduce in EQFORM-TEST : tt . +rewrites: 0 +result TrueLit: tt +========================================== +reduce in EQFORM-TEST : tt \/ tt . +rewrites: 1 +result TrueLit: tt +========================================== +reduce in EQFORM-TEST : ff /\ ff . +rewrites: 1 +result FalseLit: ff +========================================== +reduce in EQFORM-TEST : ff . +rewrites: 0 +result FalseLit: ff +========================================== reduce in EQFORM-TEST : ff . rewrites: 0 result FalseLit: ff @@ -37,46 +53,198 @@ reduce in EQFORM-TEST : F:Form . rewrites: 0 result Form: F:Form ========================================== +reduce in EQFORM-TEST : 'B:Bar ?= 'foo.Foo /\ 'B:Bar != 'foo.Foo . +rewrites: 1 +result FalseLit: ff +========================================== +reduce in EQFORM-TEST : 'B:Bar ?= 'foo.Foo \/ 'B:Bar != 'foo.Foo . +rewrites: 1 +result TrueLit: tt +========================================== +reduce in EQFORM-TEST : t1 ?= t1 . +rewrites: 2 +result TrueLit: tt +========================================== +reduce in EQFORM-TEST : t1 != t1 . +rewrites: 2 +result FalseLit: ff +========================================== reduce in EQFORM-TEST : nnf(f1) . -rewrites: 111 -result EqForm: 'F:Foo ?= 'G:Bar \/ 'F:Foo != 'G:Bar \/ t1 != t2 \/ 'H:Baz ?= - 'I:Wop /\ 'H:Baz != 'I:Wop +rewrites: 118 +result EqForm: 'F:Foo ?= 'f['bar.Bar] \/ 'B:Bar != 'foo.Foo \/ 'W:Wop != + 'bar.Bar \/ 'f['H:Baz] ?= 'f['f['I:Wop]] /\ 'H:Baz != 'f['I:Wop] ========================================== reduce in EQFORM-TEST : nnf(f2) . -rewrites: 132 -result EqForm: 'U:Stu != 'W:Roc /\ 'F:Foo ?= 'G:Bar \/ 'F:Foo != 'G:Bar \/ t1 - != t2 \/ 'H:Baz ?= 'I:Wop /\ 'H:Baz != 'I:Wop +rewrites: 142 +result EqForm: 'U:Stu != 'W:Roc /\ 'F:Foo ?= 'f['bar.Bar] \/ 'B:Bar != 'foo.Foo + \/ 'W:Wop != 'bar.Bar \/ 'f['H:Baz] ?= 'f['f['I:Wop]] /\ 'H:Baz != 'f[ + 'I:Wop] ========================================== reduce in EQFORM-TEST : nef(f1) . -rewrites: 113 -result EqForm: 'F:Foo ?= 'G:Bar \/ 'F:Foo != 'G:Bar \/ t1 != t2 \/ 'H:Baz ?= - 'I:Wop /\ 'H:Baz != 'I:Wop +rewrites: 120 +result EqForm: 'F:Foo ?= 'f['bar.Bar] \/ 'B:Bar != 'foo.Foo \/ 'W:Wop != + 'bar.Bar \/ 'f['H:Baz] ?= 'f['f['I:Wop]] /\ 'H:Baz != 'f['I:Wop] ========================================== reduce in EQFORM-TEST : nef(f2) . -rewrites: 134 -result EqForm: 'U:Stu != 'W:Roc /\ 'F:Foo ?= 'G:Bar \/ 'F:Foo != 'G:Bar \/ t1 - != t2 \/ 'H:Baz ?= 'I:Wop /\ 'H:Baz != 'I:Wop +rewrites: 144 +result EqForm: 'U:Stu != 'W:Roc /\ 'F:Foo ?= 'f['bar.Bar] \/ 'B:Bar != 'foo.Foo + \/ 'W:Wop != 'bar.Bar \/ 'f['H:Baz] ?= 'f['f['I:Wop]] /\ 'H:Baz != 'f[ + 'I:Wop] ========================================== reduce in EQFORM-TEST : cnf(f1) . -rewrites: 628 -result EqForm: ('F:Foo ?= 'G:Bar \/ 'H:Baz ?= 'I:Wop \/ 'F:Foo != 'G:Bar \/ t1 - != t2) /\ 'F:Foo ?= 'G:Bar \/ 'F:Foo != 'G:Bar \/ 'H:Baz != 'I:Wop \/ t1 != - t2 +rewrites: 635 +result EqForm: ('F:Foo ?= 'f['bar.Bar] \/ 'f['H:Baz] ?= 'f['f['I:Wop]] \/ + 'B:Bar != 'foo.Foo \/ 'W:Wop != 'bar.Bar) /\ 'F:Foo ?= 'f['bar.Bar] \/ + 'B:Bar != 'foo.Foo \/ 'H:Baz != 'f['I:Wop] \/ 'W:Wop != 'bar.Bar ========================================== reduce in EQFORM-TEST : cnf(f2) . -rewrites: 695 -result EqForm: 'U:Stu != 'W:Roc /\ ('F:Foo ?= 'G:Bar \/ 'H:Baz ?= 'I:Wop \/ - 'F:Foo != 'G:Bar \/ t1 != t2) /\ 'F:Foo ?= 'G:Bar \/ 'F:Foo != 'G:Bar \/ - 'H:Baz != 'I:Wop \/ t1 != t2 +rewrites: 705 +result EqForm: 'U:Stu != 'W:Roc /\ ('F:Foo ?= 'f['bar.Bar] \/ 'f['H:Baz] ?= 'f[ + 'f['I:Wop]] \/ 'B:Bar != 'foo.Foo \/ 'W:Wop != 'bar.Bar) /\ 'F:Foo ?= 'f[ + 'bar.Bar] \/ 'B:Bar != 'foo.Foo \/ 'H:Baz != 'f['I:Wop] \/ 'W:Wop != + 'bar.Bar ========================================== reduce in EQFORM-TEST : dnf(f1) . -rewrites: 238 -result EqForm: 'F:Foo ?= 'G:Bar \/ 'F:Foo != 'G:Bar \/ t1 != t2 \/ 'H:Baz ?= - 'I:Wop /\ 'H:Baz != 'I:Wop +rewrites: 245 +result EqForm: 'F:Foo ?= 'f['bar.Bar] \/ 'B:Bar != 'foo.Foo \/ 'W:Wop != + 'bar.Bar \/ 'f['H:Baz] ?= 'f['f['I:Wop]] /\ 'H:Baz != 'f['I:Wop] ========================================== reduce in EQFORM-TEST : dnf(f2) . -rewrites: 543 -result EqForm: ('F:Foo ?= 'G:Bar /\ 'U:Stu != 'W:Roc) \/ ('F:Foo != 'G:Bar /\ - 'U:Stu != 'W:Roc) \/ ('U:Stu != 'W:Roc /\ t1 != t2) \/ 'H:Baz ?= 'I:Wop /\ - 'H:Baz != 'I:Wop /\ 'U:Stu != 'W:Roc +rewrites: 553 +result EqForm: ('F:Foo ?= 'f['bar.Bar] /\ 'U:Stu != 'W:Roc) \/ ('B:Bar != + 'foo.Foo /\ 'U:Stu != 'W:Roc) \/ ('U:Stu != 'W:Roc /\ 'W:Wop != 'bar.Bar) + \/ 'f['H:Baz] ?= 'f['f['I:Wop]] /\ 'H:Baz != 'f['I:Wop] /\ 'U:Stu != 'W:Roc +========================================== +reduce in EQFORM-TEST : wellFormed(upModule('EQFORM-TEST-MODULE), t1 ?= t2) . +rewrites: 20 +result Bool: true +========================================== +reduce in EQFORM-TEST : wellFormed(upModule('EQFORM-TEST-MODULE), c) . +rewrites: 19 +result Bool: true +========================================== +reduce in EQFORM-TEST : wellFormed(upModule('EQFORM-TEST-MODULE), f1) . +rewrites: 126 +result Bool: true +========================================== +reduce in EQFORM-TEST : wellFormed(upModule('EQFORM-TEST-MODULE), f2) . +rewrites: 159 +result Bool: true +========================================== +reduce in EQFORM-TEST : wellFormed(upModule('EQFORM-TEST-MODULE), f1 /\ '0.Term + ?= 'T:BadSort) . +rewrites: 30 +result Bool: false +========================================== +reduce in EQFORM-TEST : normalize(upModule('NAT), '0.Nat ?= 's_['s_['0.Nat]]) . +rewrites: 13 +result PosEqLit: '0.Zero ?= 's_^2['0.Zero] +========================================== +reduce in EQFORM-TEST : normalize(upModule('EQFORM-TEST-MODULE), t1 ?= t2) . +rewrites: 14 +result PosEqLit: 'W:Wop ?= 'bar.Bar +========================================== +reduce in EQFORM-TEST : normalize(upModule('EQFORM-TEST-MODULE), f(t2) ?= f(f( + t1))) . +rewrites: 17 +result PosEqLit: 'f['W:Wop] ?= 'f['f['bar.Bar]] +========================================== +reduce in EQFORM-TEST : normalize(upModule('EQFORM-TEST-MODULE), f1) . +rewrites: 105 +result Form: ~ ('B:Bar ?= 'foo.Foo /\ 'F:Foo != 'f['bar.Bar]) \/ ~ ('W:Wop ?= + 'bar.Bar /\ 'H:Baz ?= 'f['I:Wop] \/ 'f['H:Baz] != 'f['f['I:Wop]]) +========================================== +reduce in EQFORM-TEST : normalize(upModule('EQFORM-TEST-MODULE), f2) . +rewrites: 134 +result Form: ~ 'U:Stu ?= 'W:Roc /\ ~ ('B:Bar ?= 'foo.Foo /\ 'F:Foo != 'f[ + 'bar.Bar]) \/ ~ ('W:Wop ?= 'bar.Bar /\ 'H:Baz ?= 'f['I:Wop] \/ 'f['H:Baz] + != 'f['f['I:Wop]]) +========================================== +reduce in EQFORM-TEST : reduce(upModule('EQFORM-TEST-MODULE), t1 ?= t2) . +rewrites: 14 +result PosEqLit: 'W:Wop ?= 'bar.Bar +========================================== +reduce in EQFORM-TEST : reduce(upModule('EQFORM-TEST-MODULE), f(t2) ?= f(f( + t1))) . +rewrites: 19 +result PosEqLit: 'baz.Baz ?= 'f['W:Wop] +========================================== +reduce in EQFORM-TEST : reduce(upModule('EQFORM-TEST-MODULE), f1) . +rewrites: 106 +result Form: ~ ('B:Bar ?= 'foo.Foo /\ 'F:Foo != 'baz.Baz) \/ ~ ('W:Wop ?= + 'bar.Bar /\ 'H:Baz ?= 'f['I:Wop] \/ 'f['H:Baz] != 'f['f['I:Wop]]) +========================================== +reduce in EQFORM-TEST : reduce(upModule('EQFORM-TEST-MODULE), f2) . +rewrites: 135 +result Form: ~ 'U:Stu ?= 'W:Roc /\ ~ ('B:Bar ?= 'foo.Foo /\ 'F:Foo != 'baz.Baz) + \/ ~ ('W:Wop ?= 'bar.Bar /\ 'H:Baz ?= 'f['I:Wop] \/ 'f['H:Baz] != 'f['f[ + 'I:Wop]]) +========================================== +reduce in EQFORM-TEST : vars('0.Nat ?= 's_['s_['X:Nat]]) . +rewrites: 11 +result Variable: 'X:Nat +========================================== +reduce in EQFORM-TEST : vars(f1) . +rewrites: 100 +result NeQidSet: 'B:Bar ; 'F:Foo ; 'H:Baz ; 'I:Wop ; 'W:Wop +========================================== +reduce in EQFORM-TEST : vars(f2) . +rewrites: 127 +result NeQidSet: 'B:Bar ; 'F:Foo ; 'H:Baz ; 'I:Wop ; 'U:Stu ; 'W:Roc ; 'W:Wop +========================================== +reduce in EQFORM-TEST : toUnifProb(a /\ c /\ e) . +rewrites: 7 +result UnificationProblem: 'B:Bar =? 'foo.Foo /\ 'H:Baz =? 'f['I:Wop] /\ 'U:Stu + =? 'W:Roc +========================================== +reduce in EQFORM-TEST : toConjSet(t1 ?= t2) . +rewrites: 20 +result PosEqLit: 'W:Wop ?= 'bar.Bar +========================================== +reduce in EQFORM-TEST : toDisjSet(t1 ?= t2) . +rewrites: 20 +result PosEqLit: 'W:Wop ?= 'bar.Bar +========================================== +reduce in EQFORM-TEST : toConjSet(f1) . +rewrites: 251 +result EqConjNeSet: ('F:Foo ?= 'f['bar.Bar]) | ('B:Bar != 'foo.Foo) | ('W:Wop + != 'bar.Bar) | ('f['H:Baz] ?= 'f['f['I:Wop]] /\ 'H:Baz != 'f['I:Wop]) +========================================== +reduce in EQFORM-TEST : toDisjSet(f1) . +rewrites: 639 +result EqDisjNeSet: ('F:Foo ?= 'f['bar.Bar] \/ 'f['H:Baz] ?= 'f['f['I:Wop]] \/ + 'B:Bar != 'foo.Foo \/ 'W:Wop != 'bar.Bar) | ('F:Foo ?= 'f['bar.Bar] \/ + 'B:Bar != 'foo.Foo \/ 'H:Baz != 'f['I:Wop] \/ 'W:Wop != 'bar.Bar) +========================================== +reduce in EQFORM-TEST : toConjSet(f2) . +rewrites: 559 +result EqConjNeSet: ('F:Foo ?= 'f['bar.Bar] /\ 'U:Stu != 'W:Roc) | ('B:Bar != + 'foo.Foo /\ 'U:Stu != 'W:Roc) | ('U:Stu != 'W:Roc /\ 'W:Wop != 'bar.Bar) | + ('f['H:Baz] ?= 'f['f['I:Wop]] /\ 'H:Baz != 'f['I:Wop] /\ 'U:Stu != 'W:Roc) +========================================== +reduce in EQFORM-TEST : toDisjSet(f2) . +rewrites: 710 +result EqDisjNeSet: ('U:Stu != 'W:Roc) | ('F:Foo ?= 'f['bar.Bar] \/ 'f['H:Baz] + ?= 'f['f['I:Wop]] \/ 'B:Bar != 'foo.Foo \/ 'W:Wop != 'bar.Bar) | ('F:Foo ?= + 'f['bar.Bar] \/ 'B:Bar != 'foo.Foo \/ 'H:Baz != 'f['I:Wop] \/ 'W:Wop != + 'bar.Bar) +========================================== +reduce in EQFORM-TEST : toPosEqLits(f3) . +rewrites: 19 +result PosEqLitNeSet: ('B:Bar ?= 'foo.Foo) | ('H:Baz ?= 'f['I:Wop]) | ('U:Stu + ?= 'W:Roc) +========================================== +reduce in EQFORM-TEST : (f1 | f2) << ( + 'H:Baz <- 'bar.Bar) | ( + 'H:Baz <- 'baz.Baz) . +rewrites: 316 +result FormNeSet: (~ 'U:Stu ?= 'W:Roc /\ ~ ('B:Bar ?= 'foo.Foo /\ 'F:Foo != 'f[ + 'bar.Bar]) \/ ~ ('W:Wop ?= 'bar.Bar /\ 'bar.Bar ?= 'f['I:Wop] \/ 'f[ + 'bar.Bar] != 'f['f['I:Wop]])) | (~ 'U:Stu ?= 'W:Roc /\ ~ ('B:Bar ?= + 'foo.Foo /\ 'F:Foo != 'f['bar.Bar]) \/ ~ ('W:Wop ?= 'bar.Bar /\ 'baz.Baz ?= + 'f['I:Wop] \/ 'f['baz.Baz] != 'f['f['I:Wop]])) | (~ ('B:Bar ?= 'foo.Foo /\ + 'F:Foo != 'f['bar.Bar]) \/ ~ ('W:Wop ?= 'bar.Bar /\ 'bar.Bar ?= 'f['I:Wop] + \/ 'f['bar.Bar] != 'f['f['I:Wop]])) | (~ ('B:Bar ?= 'foo.Foo /\ 'F:Foo != + 'f['bar.Bar]) \/ ~ ('W:Wop ?= 'bar.Bar /\ 'baz.Baz ?= 'f['I:Wop] \/ 'f[ + 'baz.Baz] != 'f['f['I:Wop]])) Bye. diff --git a/tests/tools/meta/eqform.maude b/tests/tools/meta/eqform.maude index daaec596..1c3fa7ec 100644 --- a/tests/tools/meta/eqform.maude +++ b/tests/tools/meta/eqform.maude @@ -1,18 +1,52 @@ load ../../../contrib/tools/meta/eqform.maude +fmod EQFORM-TEST-MODULE is + sorts Foo Bar Baz Wop Stu Roc . + ------------------------------- + subsorts Wop < Foo Bar < Baz . + subsorts Roc < Stu . + + op wop : -> Wop . + op foo : -> Foo . + op bar : -> Bar . + op baz : -> Baz . + op roc : -> Roc . + op stu : -> Stu . + + op f : Baz -> Baz . + ------------------- + eq f(baz) = baz . + eq f(bar) = baz . + eq f(foo) = bar . + eq f(wop) = wop . +endfm + fmod EQFORM-TEST is inc EQFORM-CNF . inc EQFORM-DNF . inc EQFORM-LIST . inc EQFORM-SET . + inc EQFORM-OPERATIONS . + inc EQFORM-SET-OPERATIONS . + + vars T T' : Term . ops t1 t2 : -> Term . - ops a b c d e : -> Lit . + eq t1 = 'bar.Bar . + eq t2 = 'W:Wop . - eq a = 'F:Foo ?= 'G:Bar . - eq b = 'F:Foo != 'G:Bar . - eq c = 'H:Baz ?= 'I:Wop . - eq d = 'H:Baz != 'I:Wop . + op f : Term -> Term . + eq f(T) = 'f[T] . + + op ~' : Form -> Form . + eq ~' (T ?= T') = T != T' . + eq ~' (T != T') = T ?= T' . + + ops a b c d e : -> Lit . + eq a = 'foo.Foo ?= 'B:Bar . + eq b = 'F:Foo != f('bar.Bar) . + eq c = 'H:Baz ?= f('I:Wop) . + eq d = f('H:Baz) != f(f('I:Wop)) . eq e = 'U:Stu ?= 'W:Roc . op f1 : -> Form . @@ -20,6 +54,9 @@ fmod EQFORM-TEST is op f2 : -> Form . eq f2 = (f1 /\ ~ e) /\ (d \/ tt) . + + op f3 : -> Form . + eq f3 = (a /\ c) \/ e . endfm --- substitutions @@ -34,6 +71,12 @@ reduce f1 :: Form . reduce f2 :: Form . --- testing identities +reduce tt /\ tt . +reduce tt \/ tt . + +reduce ff /\ ff . +reduce ff \/ ff . + reduce tt /\ ff . reduce tt \/ ff . @@ -41,6 +84,13 @@ reduce tt \/ ff . reduce tt /\ F:Form . reduce ff \/ F:Form . +--- simplifications +reduce 'B:Bar ?= 'foo.Foo /\ 'B:Bar != 'foo.Foo . +reduce 'B:Bar ?= 'foo.Foo \/ 'B:Bar != 'foo.Foo . + +reduce t1 ?= t1 . +reduce t1 != t1 . + --- testing transformations reduce nnf(f1) . reduce nnf(f2) . @@ -53,3 +103,40 @@ reduce cnf(f2) . reduce dnf(f1) . reduce dnf(f2) . + +--- testing operations +reduce wellFormed(upModule('EQFORM-TEST-MODULE), t1 ?= t2) . +reduce wellFormed(upModule('EQFORM-TEST-MODULE), c) . +reduce wellFormed(upModule('EQFORM-TEST-MODULE), f1) . +reduce wellFormed(upModule('EQFORM-TEST-MODULE), f2) . +reduce wellFormed(upModule('EQFORM-TEST-MODULE), f1 /\ 'T:BadSort ?= '0.Term) . + +reduce normalize(upModule('NAT), 's_['s_['0.Nat]] ?= '0.Nat) . +reduce normalize(upModule('EQFORM-TEST-MODULE), t1 ?= t2) . +reduce normalize(upModule('EQFORM-TEST-MODULE), f(f(t1)) ?= f(t2)) . +reduce normalize(upModule('EQFORM-TEST-MODULE), f1) . +reduce normalize(upModule('EQFORM-TEST-MODULE), f2) . + +reduce reduce(upModule('EQFORM-TEST-MODULE), t1 ?= t2) . +reduce reduce(upModule('EQFORM-TEST-MODULE), f(f(t1)) ?= f(t2)) . +reduce reduce(upModule('EQFORM-TEST-MODULE), f1) . +reduce reduce(upModule('EQFORM-TEST-MODULE), f2) . + +reduce vars('s_ ['s_['X:Nat]] ?= '0.Nat) . +reduce vars(f1) . +reduce vars(f2) . + +reduce toUnifProb(a /\ c /\ e) . + +reduce toConjSet(t1 ?= t2) . +reduce toDisjSet(t1 ?= t2) . + +reduce toConjSet(f1) . +reduce toDisjSet(f1) . + +reduce toConjSet(f2) . +reduce toDisjSet(f2) . + +reduce toPosEqLits(f3) . + +reduce (f1 | f2) << (('H:Baz <- 'baz.Baz) | ('H:Baz <- 'bar.Bar)) . diff --git a/tests/tools/meta/nelson-oppen-combination.expected b/tests/tools/meta/nelson-oppen-combination.expected new file mode 100644 index 00000000..3949cf31 --- /dev/null +++ b/tests/tools/meta/nelson-oppen-combination.expected @@ -0,0 +1,27 @@ +Warning: sort declarations for operator removeNonExecs failed preregularity + check on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +Warning: sort declarations for operator $rmVariants failed preregularity check + on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +Warning: sort declarations for operator clearNonExec failed preregularity check + on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +Warning: sort declarations for operator resolveNames failed preregularity check + on 6 out of 47 sort tuples. First such tuple is (Type). +Warning: sort declarations for operator resolveNames failed preregularity check + on 1 out of 26 sort tuples. First such tuple is (NullDeclSet). +========================================== +reduce in TEST-NO-NAT-LIST : nelson-oppen-sat(tagged(tt, ('check-sat > + 'var-sat) ; 'mod > 'MYLISTNAT*),tagged(tt, ('check-sat > 'var-sat) ; 'mod > + 'NAT*), ('tt.Bool* ?= '_ ( + 'tt.Bool* ?= '_ + 'var-sat) ; 'mod > 'MYLISTNAT*),tagged(tt, ('check-sat > 'var-sat) ; 'mod > + 'NAT*), 'L':NeNatList* ?= 'L:NeNatList* /\ 'tt.Bool* ?= '_ NeListNat [ctor assoc] . + op nil : -> ListNat [ctor] . + + op head : NeListNat -> Nat . + var N : Nat . var L : NeListNat . + eq head(N) = N [variant] . + eq head(N ; L) = N [variant] . + +--- For var-sat to work, in needs to be able to compute whether the sorts it +--- works over a finite or not. A the same time, we cannot include the usual +--- `0`, `1` and `_+_` constructors, since purification will then lump the +--- entire formula into `LIST-NAT` instead of separating the `List` parts from +--- the `Nat` parts. So, instead, we add two contructors that will convince var-sat +--- that the sort is infinite, that will never be used in the formulae, and so not +--- intefere with purification. + + op fake-zero : -> Nat [ctor] . + op fake-succ : Nat -> Nat [ctor] . +endfm + +fmod TEST-NO-NAT-LIST is + protecting NELSON-OPPEN-COMBINATION . + op natMod : -> TaggedFormulaSet . eq natMod = tagged(tt, (('mod > 'FVP-NAT-PRED); 'check-sat > 'var-sat)) . + op natListMod : -> TaggedFormulaSet . eq natListMod = tagged(tt, (('mod > 'LIST-NAT ); 'check-sat > 'var-sat)) . +endfm + +--- TODO Move to var-sat tests: +reduce var-sat(upModule('FVP-NAT-PRED, true), 'true.Bool != '_<_['_+_['N:Nat, 'N:Nat],'_+_[ 'M:Nat, 'M:Nat]]) . +eof . + +reduce nelson-oppen-sat((natListMod, natMod), ff) == false . + +set print attribute on . +reduce nelson-oppen-sat((natListMod, natMod), + ('true.Bool ?= ('_<_ [ '_+_['head['L':NeListNat] , 'head['L':NeListNat]] + , '_+_['head['L:NeListNat] , 'head['L:NeListNat ]] + ])) + => ( 'L:NeListNat != 'L':NeListNat + /\ 'true.Bool ?= '_<_ ['head['L':NeListNat] , 'head['L:NeListNat]] + ) + ) + . +eof . + +reduce nelson-oppen-sat((natListMod, natMod), + ( 'L:NeListNat ?= 'L':NeListNat + /\ 'true.Bool ?= '_<_ ['head['L':NeListNat] , 'head['L:NeListNat]] + )) + == false + . diff --git a/tests/tools/meta/nelson-oppen/hereditarily-finite-set.check b/tests/tools/meta/nelson-oppen/hereditarily-finite-set.check new file mode 100755 index 00000000..75189603 --- /dev/null +++ b/tests/tools/meta/nelson-oppen/hereditarily-finite-set.check @@ -0,0 +1,3 @@ +check_config_h USE_CVC4 || \ +check_config_h USE_YICES2 || \ +return "$exit_code_skip" diff --git a/tests/tools/meta/nelson-oppen/hereditarily-finite-set.maude b/tests/tools/meta/nelson-oppen/hereditarily-finite-set.maude new file mode 100644 index 00000000..533868b4 --- /dev/null +++ b/tests/tools/meta/nelson-oppen/hereditarily-finite-set.maude @@ -0,0 +1,168 @@ +--- Hereditarily Finite Sets with Reals +--- ----------------------------------- +--- +--- In this example, we demonstrate the combination algorithm with non-convex theories -- non-linear +--- real arithmetic and hereditarily finite sets. Hereditarily finite sets is an example of a theory not +--- currently definable in CVC4 or Yices2 because of its use of algebraic data types modulo axioms like +--- associativity-commutativity and having FVP equations. Hereditarily finite sets (HFS) are a model of +--- set theory without the axiom of infinity. Although hereditarily finite sets are expressive enough to +--- encode constructs like the integers and the natural numbers, its initial model is a countable model +--- and so cannot encode the real numbers. + +set include BOOL off . + +fmod HEREDITARILY-FINITE-SET is + sort MyBool . + op tt : -> MyBool [ctor] . + op ff : -> MyBool [ctor] . + +--- We have three sorts, `X`, the parametric sort, `Set`s and `Magma`s. +--- Both `X`s and `Set`s are `Magma`s. + + sorts X Set Magma . + subsorts X Set < Magma . + + vars M M' M'' : Magma . + vars S : Set . + +--- The elements of a hereditarily finite set can be elements of the parameter sort `X` of "atomic +--- elements", or can be other hereditarily constructed inductively from the following three +--- constructors. First, `empty` is a `Set`: + + op empty : -> Set [ctor] . + +--- Second, the union operator is an associative, commutative and idemopotent operator: + + op _ , _ : Magma Magma -> Magma [ctor assoc comm] . + ---------------------------------------------------------------------------- + eq M , M , M' = M , M' [variant] . + eq M , M = M [variant] . + +--- Finally, a `Set` may be constructed from any `Magma` by enclosing it in braces. + + op { _ } : Magma -> Set [ctor] . + +--- We also have a subset operator and the various equations (not detailed here) defining it: + + op _ C= _ : Magma Magma -> MyBool . + ---------------------------------------------------------------------------- + eq empty C= M = tt [variant] . + eq { M } C= { M, M' } = tt [variant] . + + eq { M } C= { M } = tt [variant] . + eq { M } C= empty = ff [variant] . + + eq { M, M' } C= { M, M'' } + = { M' } C= { M, M'' } [variant] . + eq { M, M' } C= { M } + = { M' } C= { M } [variant] . + +--- Since `var-sat` does not support `[owise]`, we do not implement the equation +--- for handling the negative case. Since the theory is OS-Compact, we can just let +--- the predicate get stuck, partially evaluated. + + op _ U _ : Set Set -> Set . + ---------------------------------------------------------------------------- + eq empty U S = S [variant] . + eq { M } U { M' } = { M, M' } [variant] . +endfm + +fmod TEST-HEREDITARILY-FINITE-SET-SANITY is + protecting HEREDITARILY-FINITE-SET . + protecting BOOL . + vars M M' : Magma . +endfm + +reduce M, M', M == M, M' . +reduce { { empty }, { { empty } }, empty } + == { { empty }, { { empty } }, empty } + . + +reduce empty C= { empty } == tt . +reduce { empty } C= empty . +reduce { empty } C= { { empty } } . +reduce { empty } C= { empty, { empty } } == tt . +reduce { empty } C= { { empty }, { { empty } } } . +reduce { M, M' } C= { M, M' } . + +reduce { empty, empty } C= { empty } . + +--- Nelson Oppen +--- ------------ +--- +--- We must trick `var-sat` into thinking that the `X` sort is countable. +--- We instantiate this module with `Real`s as a subsort of `X`: + +fmod HFS-REAL is + including HEREDITARILY-FINITE-SET . + sorts Real . + subsorts Real < X . + + op fake-0 : -> Real [ctor] . + op fake-s : Real -> Real [ctor] . +endfm + +load ../../../contrib/tools/meta/nelson-oppen-combination + +fmod HEREDITARILY-FINITE-SET-TEST-VARSAT is + protecting BOOL . + protecting VAR-SAT . + protecting HFS-REAL . + vars M M' : Magma . +endfm + +--- TODO: This does not reduce as I expect it to +reduce upTerm({ X:Real, Y:Real, Z:Real } C= { X:Real }) . + +reduce upTerm({ X:Real, Y:Real, Z:Real } C= { A:Real }) . +reduce upTerm({ X:Real, Y:Real, Z:Real } ) . + +reduce var-sat( upModule('HFS-REAL, true) + , upTerm({ empty , M } C= { empty }) ?= 'tt.MyBool + ) . +reduce var-sat( upModule('HFS-REAL, true) + , upTerm({ empty , M } C= { empty }) ?= 'tt.MyBool + /\ upTerm(M) != 'empty.Set + ) . +reduce var-sat( upModule('HFS-REAL, true) + , upTerm({ empty , M } C= { empty , M' }) ?= 'tt.MyBool + ) . + +--- get variants { X:Magma, Y:Magma, Z:Magma } . +--- --- Lots and lots of variants? or variant computation is slow? +--- reduce var-sat( upModule('HFS-REAL, true) +--- , upTerm({ X:Magma, Y:Magma, Z:Magma } C= { X:Magma }) ?= 'tt.MyBool +--- ) == true . + +reduce var-sat( upModule('HFS-REAL, true) + , upTerm({ X:Real, Y:Real, Z:Real }) ?= upTerm({ X:Real }) + ) == true . + +reduce var-sat( upModule('HFS-REAL, true) + , upTerm({ X:Real, Y:Real, Z:Real } C= { X:Real }) ?= 'tt.MyBool + ) == true . + +--- Finally, we check the satisfiability of the formula $\{ x^2 , y^2, z^2 \} \subseteq \{ a \} \land x \ne y$. i.e. "is +--- it possible for the set of squares of three numbers, two of which must be distinct, to be a +--- subset of a set with a single element." This is indeed possible, since every positive real number +--- has two distinct square roots. Since set union is idempotent, if the two distinct numbers are +--- additive inverses of each other and the third is equal to either, then the proposition would indeed +--- be satisfied. + +set print attribute on . + +--- Our query is: + +reduce in NELSON-OPPEN-COMBINATION : + nelson-oppen-sat( ( tagged(tt, ('mod > 'REAL) ; ('check-sat > 'smt-sat)) + , tagged(tt, ('mod > 'HFS-REAL); ('check-sat > 'var-sat)) + ) + , ( '_C=_[ '`{_`}['_`,_[ '_*_ [ 'Z:Real, 'Z:Real ] + , '_*_ [ 'X:Real, 'X:Real ] + , '_*_ [ 'Y:Real, 'Y:Real ] + ]] + , '`{_`}['A:Real]] + ?= 'tt.MyBool + ) + /\ 'X:Real != 'Y:Real + ) . diff --git a/tests/tools/meta/nelson-oppen/integer-list.check b/tests/tools/meta/nelson-oppen/integer-list.check new file mode 100755 index 00000000..75189603 --- /dev/null +++ b/tests/tools/meta/nelson-oppen/integer-list.check @@ -0,0 +1,3 @@ +check_config_h USE_CVC4 || \ +check_config_h USE_YICES2 || \ +return "$exit_code_skip" diff --git a/tests/tools/meta/nelson-oppen/integer-list.maude b/tests/tools/meta/nelson-oppen/integer-list.maude new file mode 100644 index 00000000..0318ed16 --- /dev/null +++ b/tests/tools/meta/nelson-oppen/integer-list.maude @@ -0,0 +1,74 @@ +--- Combining Integers with Lists +--- ----------------------------- +--- +--- In this example we demonstrate the Nelson-Oppen combination where one of the theories involved is +--- not convex and the split rule needs to be applied to get the correct result. Here, lists are a +--- convex theory, but the integers with order are now. + +load ../../../contrib/tools/meta/nelson-oppen-combination.maude + +--- We implement the lists as a theory that has the finite variant property and use variant based +--- satisfiability to decide its formulae. Here, the head function returns the first element of the +--- list. + +fmod INTEGER-LIST is + sort Integer . + + --- Convince var-sat we are infinite + op fake-0 : -> Integer [ctor] . + op fake-s : Integer -> Integer [ctor] . + + sort IntegerList NeIntegerList . + subsort Integer < NeIntegerList < IntegerList . + op _ _ : NeIntegerList NeIntegerList -> NeIntegerList [ctor assoc] . + op nil : -> IntegerList [ctor] . + + op head : NeIntegerList -> Integer . + var N : Integer . var L : NeIntegerList . + eq head(N) = N [variant] . + eq head(N L) = N [variant] . +endfm + +--- For the integers, we use one of the external SMT solvers, CVC4 for checking satisfiability. + +fmod TEST-NO-SMT-LIST is + protecting REAL-INTEGER . + protecting INTEGER-LIST . + protecting NELSON-OPPEN-COMBINATION . + protecting META-LEVEL . +endfm + +reduce nelson-oppen-sat(( tagged(tt, ('mod > 'INTEGER-LIST); ('check-sat > 'var-sat)) + , tagged(tt, ('mod > 'INTEGER ); ('check-sat > 'smt-sat))), + '_-_ [ '_*_ [ '2.Integer , 'head[ 'L:NeIntegerList ] ] + , '_*_ [ '2.Integer , 'head[ 'M:NeIntegerList ] ] ] + ?= '1.Integer) + == false + . +reduce nelson-oppen-sat(( tagged(tt, ('mod > 'INTEGER-LIST); 'check-sat > 'var-sat) + , tagged(tt, ('mod > 'INTEGER ); 'check-sat > 'smt-sat)), + '_-_ [ '_*_ [ '2.Integer , 'head[ 'L:NeIntegerList ] ] + , '_*_ [ '2.Integer , 'head[ 'M:NeIntegerList ] ] ] + ?= '0.Integer) + == true + . + +reduce nelson-oppen-sat(( tagged(tt, ('mod > 'INTEGER-LIST); 'check-sat > 'var-sat) + , tagged(tt, ('mod > 'INTEGER ); 'check-sat > 'smt-sat)), + '_-_ [ 'head[ 'L:NeIntegerList ] + , '_*_ [ '2.Integer , 'head[ 'M:NeIntegerList ] ] ] + ?= '0.Integer) + == true + . + +set print attribute on . + +reduce nelson-oppen-valid(( tagged(tt, (('mod > 'INTEGER-LIST); 'check-sat > 'var-sat)) + , tagged(tt, (('mod > 'INTEGER ); 'check-sat > 'smt-sat))), + ( '_<=_ [ '1.Integer , 'head[ 'L:NeIntegerList ] ] ?= 'true.Boolean + /\ '_<=_ [ 'head[ 'L:NeIntegerList ] , '2.Integer ] ?= 'true.Boolean + ) + => ( 'head[ 'L:NeIntegerList ] ?= '1.Integer + \/ 'head[ 'L:NeIntegerList ] ?= '2.Integer + ) + ) . diff --git a/tests/tools/meta/nelson-oppen/lexical-trichotomy-law.check b/tests/tools/meta/nelson-oppen/lexical-trichotomy-law.check new file mode 100755 index 00000000..75189603 --- /dev/null +++ b/tests/tools/meta/nelson-oppen/lexical-trichotomy-law.check @@ -0,0 +1,3 @@ +check_config_h USE_CVC4 || \ +check_config_h USE_YICES2 || \ +return "$exit_code_skip" diff --git a/tests/tools/meta/nelson-oppen/lexical-trichotomy-law.maude b/tests/tools/meta/nelson-oppen/lexical-trichotomy-law.maude new file mode 100644 index 00000000..94e03504 --- /dev/null +++ b/tests/tools/meta/nelson-oppen/lexical-trichotomy-law.maude @@ -0,0 +1,96 @@ +--- Regarding other examples, here is one that might be interesting but it is +--- unclear whether we can handle it. One could define in var-sat a parametric +--- module: + +set include Bool off . +load ../../../contrib/tools/meta/nelson-oppen-combination +load smt + +fmod PAIR is + protecting BOOLEAN . + sort X . *** parameter sort + sort Pair . *** pairs + + op [_,_] : X X -> Pair [ctor] . + + op first : Pair -> X . + op second : Pair -> X . + + vars x y : X . + + eq first ([x,y]) = x [variant] . + eq second([x,y]) = y [variant] . + + vars b b' : Boolean . + + op if : Boolean Boolean Boolean -> Boolean . + + eq if(true, b,b') = b [variant] . + eq if(false,b,b') = b' [variant] . +endfm + +--- Then one could instantiate the parameter X with the rational numbers and define +--- a lexicographic order on pairs of rationals as follows: + +fmod PAIR-REAL is + including PAIR . + sort Real . + subsorts Real < X . + + --- Convince var-sat that Real is an infinite sort. + op fake-zero : -> Real [ctor] . + op fake-succ : Real -> Real [ctor] . +endfm + +fmod PAIR-REAL-INSTANTIATED is + including REAL . + including PAIR-REAL . + + vars P Q : Pair . + + op _>lex_ : Pair Pair -> Boolean . + eq P >lex Q = if( (first(P) > first(Q)) + , true + , if( (first(Q) > first(P)) + , false + , (second(P) > second(Q)) + ) + ) . +endfm + +set print attribute on . +reduce in NELSON-OPPEN-COMBINATION : nelson-oppen-valid( + ( tagged(tt, (('mod > 'PAIR-REAL) ; 'check-sat > 'var-sat)) + , tagged(tt, (('mod > 'REAL ) ; 'check-sat > 'smt-sat)) + ), + (getTerm(metaReduce(upModule('PAIR-REAL-INSTANTIATED, false), '_>lex_[ 'P:Pair , 'Q:Pair]))) ?= 'true.Boolean + \/ (getTerm(metaReduce(upModule('PAIR-REAL-INSTANTIATED, false), '_>lex_[ 'Q:Pair , 'P:Pair]))) ?= 'true.Boolean + \/ 'P:Pair ?= 'Q:Pair + ) + . + +--- The only part where I am unsure about how we can define this is the function +--- symbol \>lex since it is unclear to which signature this function symbol +--- belongs. It does not belong to the parameterized module as such, and it does not +--- belong to RAT as such. In some tricky sense, the equation: +--- +--- eq [x,y] >lex [x',y'] = if((x > y),tt,if((y > x),ff,(y > y'))) . +--- +--- has the finite variant property, since it can only evaluate to tt, ff, or x \> y +--- +--- But the module needs to be instantiated before the order operator \> can be +--- defined. +--- +--- What seems to be happening is that \>lex is defined in a third signature, +--- besides those of PAIR and of RAT and we may not have a way to deal with this. +--- +--- Of course, there would be no problem verifying this for \>lex in var-sat for +--- pairs of naturals with the order on the naturals, but then Nelson-Oppen would +--- not be needed. +--- +--- An alternative approach, used in CS 576 would be to make PAIR parametric on the +--- theory of total order, and then prove the above trichotomy result for any total +--- order by instantiating the parameter of total order to the natural numbers, +--- since I proved that a formula holds for total order if and only if it holds for +--- the natural numbers order. But again, we would not need to use Nelson-Oppen: all +--- could be done within var-sat. diff --git a/tests/tools/meta/nelson-oppen/matrix.check b/tests/tools/meta/nelson-oppen/matrix.check new file mode 100755 index 00000000..a3b9f67e --- /dev/null +++ b/tests/tools/meta/nelson-oppen/matrix.check @@ -0,0 +1,2 @@ +check_config_h USE_YICES2 || \ +return "$exit_code_skip" diff --git a/tests/tools/meta/nelson-oppen/matrix.maude b/tests/tools/meta/nelson-oppen/matrix.maude new file mode 100644 index 00000000..586aac76 --- /dev/null +++ b/tests/tools/meta/nelson-oppen/matrix.maude @@ -0,0 +1,115 @@ +--- Matrices with real and integer entries +--- -------------------------------------- +--- +--- We can define in Maude the theory of $2 \times 2$ matrices over a ring as the following module +--- parameterized by the theory of rings as its parameter theory: + +--- What is crucial about this theory instantiation is that, since the operators in \texttt{MATRIX-OPS} +--- are all definitional extensions, they can all be evaluated away to their righthand sides, i.e., to +--- operators in the disjoint union of two theories: (i) the FVP theory \texttt{MATRIX} obtained by +--- completely removing its \texttt{RING} parameter part, and (ii) the theory \texttt{REAL} to which the +--- parameter theory \texttt{RING} is instantiated. Therefore, the order-sorted Nelson-Oppen algorithm +--- can be invoked to decide validity and satisfiability of formulas in \texttt{MATRIX-REAL}, once we: +--- (i) evaluate away all defined operations in \texttt{MATRIX-OPS} appearing in a formula, and (ii) +--- purify the formula into its two disjoint parts. + +set include BOOL off . +load ../../../contrib/tools/meta/nelson-oppen-combination.maude + +fmod MATRIX-X is + sort X Matrix . + op matrix : X X X X -> Matrix [ctor] . + + vars A B C D : X . + op m11 : Matrix -> X . + op m12 : Matrix -> X . + op m21 : Matrix -> X . + op m22 : Matrix -> X . + + eq m11(matrix(A, B, C, D)) = A [variant] . + eq m12(matrix(A, B, C, D)) = B [variant] . + eq m21(matrix(A, B, C, D)) = C [variant] . + eq m22(matrix(A, B, C, D)) = D [variant] . +endfm + +--- Next, we define multiplication, determinant and identify as meta-functions -- +--- functions over terms at the meta-level. + +fmod MATRIX-TEST is + protecting NELSON-OPPEN-COMBINATION . + + vars A B A1 B1 A2 B2 ZERO ONE : Term . + + op mulSum : Term Term Term Term -> Term . + eq mulSum(A1, B1, A2, B2) = '_+_ [ '_*_ [ A1 , B1 ] + , '_*_ [ A2 , B2 ] + ] . + + op multiply : Term Term -> Term . + eq multiply(A, B) = 'matrix[ mulSum('m11[A], 'm11[B], 'm12[A], 'm21[B]) + , mulSum('m11[A], 'm12[B], 'm12[A], 'm22[B]) + , mulSum('m21[A], 'm11[B], 'm22[A], 'm21[B]) + , mulSum('m21[A], 'm12[B], 'm22[A], 'm22[B]) + ] . + op determinant : Term -> Term . + eq determinant(A) = '_-_ [ '_*_ [ 'm11[A], 'm22[A] ] + , '_*_ [ 'm12[A], 'm21[A] ] + ] . + + op identity : Term Term -> Term . + eq identity(ZERO, ONE) = 'matrix[ONE, ZERO, ZERO, ONE] . +endfm + +--- Finally, we the parameterise this theory over the reals: + +fmod MATRIX-REAL is + including MATRIX-X . + sort Real . + subsorts Real < X . + --- Convince var-sat that Real is an infinite sort. + op fake-zero : -> Real [ctor] . + op fake-succ : Real -> Real [ctor] . +endfm + +set print attribute on . + +reduce in MATRIX-TEST : nelson-oppen-valid( + ( tagged(tt, (('mod > 'MATRIX-REAL); ('check-sat > 'var-sat))) + , tagged(tt, (('mod > 'REAL); ('check-sat > 'smt-sat))) + ), + (multiply('A:Matrix, 'B:Matrix) ?= identity('0/1.Real, '1/1.Real)) + => (determinant('A:Matrix) != '0/1.Real) + ) . + +--- It turns out that if we combine this module with the Integers instead of the Reals, we can prove +--- something stronger: that any invertible matrix must have determinant $\pm 1$. Unfortunately, CVC4 is +--- not able to solve the non-linear arithmetic needed to prove this. We must instead turn to the Yices +--- solver, the other SMT solver available in Maude. Even so, the default configuration for Yices does +--- not enable the solver for non-linear arithmetic (MCSAT), and running this example involved modifying +--- the Maude C++ source code to enable that configuration. Even so, the computational difficulty +--- involved in solving non-linear integer arithmetic forced us to restrict the proof to +--- upper-triangular matrices. + +fmod MATRIX-INTEGER is + including MATRIX-X . + sort Integer . + subsorts Integer < X . + --- Convince var-sat that Integer is an infinite sort. + op fake-zero : -> Integer [ctor] . + op fake-succ : Integer -> Integer [ctor] . +endfm + +reduce in MATRIX-TEST : nelson-oppen-valid( + ( tagged(tt, (('mod > 'MATRIX-INTEGER); + ('check-sat > 'var-sat); ('convex > 'true))) + , tagged(tt, (('mod > 'INTEGER ); + ('check-sat > 'smt-sat); ('convex > 'false))) + ), + ( multiply('A:Matrix, 'B:Matrix) ?= identity('0.Integer, '1.Integer) + /\ 'm21['A:Matrix] ?= '0.Integer + /\ 'm21['B:Matrix] ?= '0.Integer + ) + => ( determinant('A:Matrix) ?= '1.Integer + \/ determinant('A:Matrix) ?= '-_['1.Integer] + ) + ) . diff --git a/tests/tools/varsat/var-sat.expected b/tests/tools/varsat/var-sat.expected index 8f191399..7271d9f7 100644 --- a/tests/tools/varsat/var-sat.expected +++ b/tests/tools/varsat/var-sat.expected @@ -1,196 +1,225 @@ ========================================== +reduce in TEST-NAT : nf-ctor-variants(nat, 'true.Bool != '_<_['X:Nat,'Y:Nat]) . +rewrites: 1347 +result NegEqLitSet: 'false.Bool != 'true.Bool | 'true.Bool != 'true.Bool +========================================== +reduce in TEST-NAT : toDUPs(getTerms(ctor-variants(hl-func(nat), toHL(nat, + FormToTL('true.Bool != '_<_['X:Nat,'Y:Nat]))))) . +rewrites: 159 +result NegEqLitSet: 'false.Bool != 'true.Bool | 'true.Bool != 'true.Bool +========================================== +reduce in TEST-NAT : getTerms(ctor-variants(hl-func(nat), toHL(nat, FormToTL( + 'true.Bool != '_<_['X:Nat,'Y:Nat])))) . +rewrites: 146 +result NeTermSet: ('_|_['@S['true.Bool],'@S['false.Bool]]) | ('_|_['@S[ + 'true.Bool],'@S['true.Bool]]) +========================================== +reduce in TEST-NAT : ctor-variants(hl-func(nat), toHL(nat, FormToTL('true.Bool + != '_<_['X:Nat,'Y:Nat]))) . +rewrites: 143 +result VariantTripleSet: {'_|_['@S['true.Bool],'@S['false.Bool]], + 'X:Nat <- '_+_['%7:Nat,'%8:Nat] ; + 'Y:Nat <- '%7:Nat,8,0,false} | +{'_|_['@S['true.Bool],'@S['true.Bool]], + 'X:Nat <- '%4:Nat ; + 'Y:Nat <- '_+_['%4:Nat,'%5:NzNat],5,0,true} +========================================== +reduce in TEST-NAT : toHL(nat, FormToTL('true.Bool != '_<_['X:Nat,'Y:Nat])) . +rewrites: 33 +result Term: '_|_['@S['true.Bool],'@S['_<_['X:Nat,'Y:Nat]]] +========================================== reduce in TEST-NAT : var-sat(nat, 'true.Bool ?= upTerm(X < Y)) == true . -rewrites: 2019 +rewrites: 2012 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'true.Bool != upTerm(X < Y)) == true . -rewrites: 305 +rewrites: 298 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'true.Bool ?= upTerm(X < X)) == false . -rewrites: 119 +rewrites: 112 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'true.Bool ?= upTerm(X <= Y)) == true . -rewrites: 170 +rewrites: 163 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'true.Bool ?= upTerm(X <= X)) == true . -rewrites: 158 +rewrites: 151 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'true.Bool ?= upTerm(X < Y) /\ 'true.Bool ?= upTerm(Y <= Z)) == true . -rewrites: 636 +rewrites: 631 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'true.Bool ?= upTerm(X < Y) \/ 'true.Bool ?= upTerm(Y <= Z)) == true . -rewrites: 189 +rewrites: 182 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'true.Bool ?= upTerm(X < Y) /\ 'true.Bool ?= upTerm(Y < X)) == false . -rewrites: 519 +rewrites: 514 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'true.Bool ?= upTerm(X < Y) \/ 'true.Bool ?= upTerm(Y < X)) == true . -rewrites: 180 +rewrites: 173 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'true.Bool ?= upTerm(X < Y) /\ 'true.Bool ?= upTerm(Z < X) /\ 'true.Bool ?= upTerm(Y < Z)) == false . -rewrites: 672 +rewrites: 667 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, ('true.Bool ?= upTerm(X < Y)) => ('true.Bool ?= '_<_['_+_['X:Nat,'1.NzNat],'Y:Nat])) == true . -rewrites: 187 +rewrites: 180 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'Z:Bool ?= '_<_['_+_['N:Nat,'N:Nat],'_+_[ 'M:Nat,'M:Nat]] /\ 'M:Nat != 'N:Nat /\ 'Z:Bool != 'true.Bool) == true . -rewrites: 1186 +rewrites: 1520 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'B1:Bool ?= '_<_['N:Nat,'M:Nat] /\ 'M:Nat != 'N:Nat) == true . -rewrites: 1013 +rewrites: 1008 result Bool: true ========================================== reduce in TEST-NAT : var-valid(nat, ('true.Bool ?= upTerm(X < Y)) => ( 'true.Bool ?= '_<_['X:Nat,'_+_['Y:Nat,'1.NzNat]])) == true . -rewrites: 647 +rewrites: 642 result Bool: true ========================================== reduce in TEST-NAT : var-valid(nat, ('true.Bool ?= upTerm(X < Y)) => ( 'true.Bool ?= '_<_['_+_['X:Nat,'1.NzNat],'Y:Nat])) == false . -rewrites: 720 +rewrites: 715 result Bool: true ========================================== reduce in TEST-NAT : var-valid(nat, ('true.Bool ?= upTerm(X < Y)) => ( 'true.Bool ?= upTerm(Y < X))) == false . -rewrites: 608 +rewrites: 603 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'B2:Bool ?= 'true.Bool /\ 'B2:Bool ?= '_<_[ 'N2:Nat,'N1:Nat]) == true . -rewrites: 391 +rewrites: 477 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'B2:Bool ?= '_<_['N2:Nat,'N1:Nat] /\ 'N1:Nat ?= 'N2:Nat) == true . -rewrites: 568 +rewrites: 563 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'B2:Bool ?= 'true.Bool /\ 'B2:Bool ?= '_<_[ 'N2:Nat,'N1:Nat] /\ 'N1:Nat ?= 'N2:Nat) == false . -rewrites: 435 +rewrites: 430 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'B1:Bool ?= '_<_['N1:Nat,'N2:Nat] /\ 'N1:Nat != 'N2:Nat) == true . -rewrites: 1013 +rewrites: 1008 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'B2:Bool ?= 'true.Bool /\ 'B2:Bool ?= '_<_[ 'N2:Nat,'N1:Nat] /\ 'N1:Nat != 'N2:Nat) == true . -rewrites: 1096 +rewrites: 1420 result Bool: true ========================================== reduce in TEST-NAT : var-sat(nat, 'B1:Bool ?= '_<_['N2:Nat,'_+_['N1:Nat, 'N1:Nat]] /\ 'B1:Bool != 'true.Bool) == true . -rewrites: 552 +rewrites: 545 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'N1:Nat ?= 'head['L':NeNatList] /\ 'N2:Nat ?= 'head['L:NeNatList] /\ 'N1:Nat != 'N2:Nat) == true . -rewrites: 2977 +rewrites: 2970 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'B2:Bool ?= 'true.Bool /\ 'N2:Nat ?= 'head[ 'L':NeNatList] /\ 'N1:Nat ?= 'head['L:NeNatList] /\ 'L':NeNatList ?= 'L:NeNatList /\ 'N1:Nat != 'N2:Nat) == false . -rewrites: 1028 +rewrites: 1770 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'N2:Nat ?= 'head['L':NeNatList] /\ 'N1:Nat ?= 'head['L:NeNatList] /\ 'B1:Bool != 'true.Bool /\ 'N1:Nat != 'N2:Nat) == true . -rewrites: 2406 +rewrites: 2399 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'I1:Nat ?= 'head['L:NeNatList] /\ 'I2:Nat ?= 'head['M:NeNatList] /\ 'I1:Nat != 'I2:Nat) == true . -rewrites: 1579 +rewrites: 1572 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'I1:Nat ?= 'I2:Nat /\ 'I1:Nat ?= 'head[ 'L:NeNatList] /\ 'I2:Nat ?= 'head['M:NeNatList]) == true . -rewrites: 1818 +rewrites: 1812 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'N2:Nat ?= 'head['L':NeNatList] /\ 'N1:Nat ?= 'head['L:NeNatList] /\ 'B1:Bool != 'true.Bool) == true . -rewrites: 1472 +rewrites: 1465 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'I1:Nat ?= 'head['L:NeNatList] /\ 'I2:Nat ?= 'head['M:NeNatList]) == true . -rewrites: 965 +rewrites: 960 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'B2:Bool ?= 'true.Bool /\ 'N2:Nat ?= 'head[ 'L':NeNatList] /\ 'L':NeNatList ?= 'L:NeNatList /\ 'N1:Nat ?= 'head[ 'L:NeNatList]) == true . -rewrites: 928 +rewrites: 923 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'I1:Nat ?= 'head['L:NeNatList] /\ 'X:Nat != 'head['L:NeNatList] /\ 'Y:Nat != 'head['L:NeNatList]) == true . -rewrites: 1358 +rewrites: 1351 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'I1:Nat ?= 'head['L:NeNatList] /\ 'I1:Nat != 'X:Nat /\ 'X:Nat != 'head['L:NeNatList] /\ 'Y:Nat != 'head[ 'L:NeNatList]) == true . -rewrites: 1452 +rewrites: 1445 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'I1:Nat ?= 'head['L:NeNatList] /\ 'I1:Nat != 'Y:Nat /\ 'X:Nat != 'head['L:NeNatList] /\ 'Y:Nat != 'head[ 'L:NeNatList]) == true . -rewrites: 1452 +rewrites: 1445 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'I1:Nat ?= 'head['L:NeNatList] /\ 'X:Nat != 'Y:Nat /\ 'X:Nat != 'head['L:NeNatList] /\ 'Y:Nat != 'head['L:NeNatList]) == true . -rewrites: 1456 +rewrites: 1449 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'I1:Nat ?= 'head['L:NeNatList] /\ 'I1:Nat != 'X:Nat /\ 'I1:Nat != 'Y:Nat /\ 'X:Nat != 'Y:Nat /\ 'X:Nat != 'head[ 'L:NeNatList] /\ 'Y:Nat != 'head['L:NeNatList]) == true . -rewrites: 1653 +rewrites: 1646 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'I1:Nat ?= 'X:Nat /\ 'I1:Nat ?= 'head[ 'L:NeNatList] /\ 'X:Nat != 'head['L:NeNatList] /\ 'Y:Nat != 'head[ 'L:NeNatList]) == false . -rewrites: 2537 +rewrites: 2530 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'I1:Nat ?= 'Y:Nat /\ 'I1:Nat ?= 'head[ 'L:NeNatList] /\ 'X:Nat != 'head['L:NeNatList] /\ 'Y:Nat != 'head[ 'L:NeNatList]) == false . -rewrites: 2537 +rewrites: 2530 result Bool: true ========================================== reduce in TEST-LIST : var-sat(list, 'I1:Nat ?= 'head['L:NeNatList] /\ 'X:Nat ?= 'Y:Nat /\ 'X:Nat != 'head['L:NeNatList] /\ 'Y:Nat != 'head['L:NeNatList]) == true . -rewrites: 1556 +rewrites: 1673 result Bool: true Bye. diff --git a/tests/tools/varsat/var-sat.maude b/tests/tools/varsat/var-sat.maude index bc2bf573..a773894f 100644 --- a/tests/tools/varsat/var-sat.maude +++ b/tests/tools/varsat/var-sat.maude @@ -5,12 +5,18 @@ load ../../../contrib/tools/varsat/var-sat.maude fmod TEST-NAT is pr VAR-SAT . - pr FOFORM-DEFINEDOPS . + pr EQFORM-OPERATIONS . pr NAT . op nat : -> Module . vars U V W X Y Z : Nat . - var F : QFForm . - eq nat = upModule('FVP-NAT-PRED, true) . + var F : Form . + eq nat = upModule('FVP-NAT-PRED, true) . endfm +red nf-ctor-variants(nat, 'true.Bool != '_<_['X:Nat,'Y:Nat]) . +red toDUPs(getTerms(ctor-variants(hl-func(nat),toHL(nat,FormToTL('true.Bool != '_<_['X:Nat,'Y:Nat]))))) . +red getTerms(ctor-variants(hl-func(nat),toHL(nat,FormToTL('true.Bool != '_<_['X:Nat,'Y:Nat])))) . +red ctor-variants(hl-func(nat),toHL(nat,FormToTL('true.Bool != '_<_['X:Nat,'Y:Nat]))) . +red toHL(nat,FormToTL('true.Bool != '_<_['X:Nat,'Y:Nat])) . + --- Satisfiability red var-sat(nat, upTerm(X < Y) ?= 'true.Bool) == true . red var-sat(nat, upTerm(X < Y) != 'true.Bool) == true . @@ -83,6 +89,7 @@ reduce var-sat(nat, /\ 'B1:Bool != 'true.Bool) == true . +red var-sat(nat, 'true.Bool != upTerm(X + X < Y + Y)) . --- These checks are to make sure we work with the theories that nelson oppen --- uses for testing. @@ -107,8 +114,8 @@ endfm fmod TEST-LIST is pr VAR-SAT . - pr FOFORM-DEFINEDOPS . - var F : QFForm . + pr EQFORM-OPERATIONS . + var F : Form . op list : -> Module . eq list = upModule('MYNATLIST, true) . endfm