***(
Maude-NPA, Version: [2.0] [11/26/2011]
Copyright (c) 2012, University of Illinois
All rights reserved.
Redistribution and use in source and binary forms, with or without modification, 
are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, 
this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice, 
this list of conditions and the following disclaimer in the documentation 
and/or other materials provided with the distribution.
* Neither the name of the University of Illinois nor the names of its contributors 
may be used to endorse or promote products derived from this software without 
specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, 
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE 
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-----------------------------------------------------------------------------------------------------------
Copyright (c) 2012. To the extent that a federal employee is an author of 
a portion of the software or a derivative work thereof, no copyright is 
claimed by the United States Government, as represented by the Secretary 
of the Navy ("GOVERNMENT") under Title 17, U.S. Code. All Other Rights Reserved.
Permission to use, copy, and modify this software and its documentation is 
hereby granted, provided that both the copyright notice and this permission 
notice appear in all copies of the software, derivative works or modified 
versions, and any portions thereof, and that both notices appear in 
supporting documentation.
GOVERNMENT ALLOWS FREE USE OF THIS SOFTWARE IN ITS "AS IS" CONDITION AND 
DISCLAIM ANY LIABILITY OF ANY KIND FOR ANY DAMAGES WHATSOEVER RESULTING 
FROM THE USE OF THIS SOFTWARE.
GOVERNMENT requests users of this software to return modifications, 
improvements or extensions that they make to: 
maudenpa@chacs.nrl.navy.mil]
-or-
Naval Research Laboratory, Code 5543
4555 Overlook Avenue, SW
Washington, DC 20375
)***

fmod BANNER-MAUDENPA is 
  pr QID-LIST .
  op banner : -> QidList .
  eq banner = 
'\n '\t '\s '\s '\s '\s 'Maude-NPA 'Version: '11/26/2011
'\n '\t '\s '\s '\s '\s 'Copyright '\s '`( 'c '`) '\s '2012 '`, '\s 'University 'of 'Illinois 
'\n '\t '\s '\s '\s '\s 'All 'rights 'reserved.
'\n
.
endfm

fmod UNIFICATIONTRIPLE is
  protecting META-LEVEL .
  protecting INT .

  --- UnificationPair --------------------------------------------
  ---sorts UnificationPair UnificationPair? .
  ---op {_,_} : Substitution Nat -> UnificationPair [ctor] .
  ---subsort UnificationPair < UnificationPair? .
  ---op noUnifier : -> UnificationPair? [ctor] .

  op getSubst : UnificationPair -> Substitution .
  eq getSubst({S1:Substitution, N:Nat}) = S1:Substitution .
  op getNextVar : UnificationPair -> Nat .
  eq getNextVar({S1:Substitution, N:Nat}) = N:Nat .

  --- UnificationTriple --------------------------------------------
  ---sorts UnificationTriple UnificationTriple? .
  ---op {_,_,_} : Substitution Substitution Nat -> UnificationTriple [ctor] .
  ---subsort UnificationTriple < UnificationTriple? .
  ---op noUnifier : -> UnificationTriple? [ctor] .

  op getLSubst : UnificationTriple -> Substitution .
  eq getLSubst({S1:Substitution, S2:Substitution, N:Nat}) = S1:Substitution .
  op getRSubst : UnificationTriple -> Substitution .
  eq getRSubst({S1:Substitution, S2:Substitution, N:Nat}) = S2:Substitution .
  op getNextVar : UnificationTriple -> Nat .
  eq getNextVar({S1:Substitution, S2:Substitution, N:Nat}) = N:Nat .

endfm

fmod TERM-HANDLING is
  protecting META-TERM .
  protecting META-LEVEL .
  protecting EXT-BOOL . *** For and-then

  var T T' T'' : Term .
  var C C' : Constant .
  var QIL : QidList .
  var N N' : Nat .
  var NL NL' : NatList .
  var Q F F' : Qid .
  var AtS : AttrSet .
  var EqS : EquationSet .
  var Eq : Equation .
  var Cond : Condition .
  var TP : Type .
  var TPL TPL' : TypeList .
  var TL TL' TL'' : TermList .
  var B : Bool .
  var V V' : Variable .
  var Ct : Context .
  var CtL : NeCTermList .
  var NeTL : NeTermList .
  var M : Module .

  *** root  ******************************
  op root : Term -> Qid .
  eq root(V) = V .
  eq root(C) = C .
  eq root(F[TL]) = F .

  *** size  ******************************
  op size : TermList -> Nat .
  eq size(empty) = 0 .
  eq size((T,TL)) = s(size(TL)) .

  *** elem_of_ *****************************************************
  op elem_of_ : Nat TermList ~> Term .
  eq elem 1 of (T,TL) = T .
  eq elem s(s(N)) of (T,TL) = elem s(N) of TL .

  *** subTerm_of_ *****************************************************
  op subTerm_of_ : NatList Term ~> Term .
  eq subTerm NL of T = subTerm* NL of T  .

  op subTerm*_of_ : NatList Term ~> Term .
  eq subTerm* nil of T = T .
  eq subTerm* N NL of (F[TL]) = subTerm* NL of (elem N of TL) .

  *** ToDo: UPGRADE THIS NOTION TO MODULO AC *********************
  *** is_subTermOf_ *****************************************************
  op is_subTermOf_ : Term TermList -> Bool .
  eq is T subTermOf T = true .
  eq is T subTermOf (F[TL]) = is T subTermOf TL .
  eq is T subTermOf (T',NeTL) = is T subTermOf T' 
                                or-else is T subTermOf NeTL .
  eq is T subTermOf T' = false [owise] .

  *** noVarOfSort_In_ *****************************************************
  op noVarOfSort_In_ : Type TermList -> Bool .
  eq noVarOfSort T:Type In V = getType(V) =/= T:Type .
  eq noVarOfSort T:Type In (F[TL]) = noVarOfSort T:Type In TL .
  eq noVarOfSort T:Type In (T',NeTL)
   = noVarOfSort T:Type In T' and noVarOfSort T:Type In NeTL .
  eq noVarOfSort T:Type In X:TermList = true [owise] .

  *** findSubTermOf_In_ ***********************************************
  op findSubTermOf_In_ : NeCTermList TermList ~> Term .
  eq findSubTermOf (TL, [], TL') In (TL, T, TL') = T .
  eq findSubTermOf (TL, F[CtL], TL'') In (TL, F[TL'], TL'')
   = findSubTermOf CtL In TL' .

  *** replaceElem_of_by_ ****************************************************
  op replaceElem_of_by_ : Nat TermList Term ~> TermList .
  eq replaceElem 1 of (T,TL) by T' = (T',TL) .
  eq replaceElem s(s(N)) of (T,TL) by T' = (T,replaceElem s(N) of TL by T') .

  *** replaceSubTerm_of_by_ *************************************************
  op replaceSubTerm_of_by_ : NatList TermList Term ~> TermList .
  eq replaceSubTerm nil of T by T' = T' .
  eq replaceSubTerm N NL of (F[TL]) by T'
   = F[replaceSubTermL N NL of TL by T'] .

  op replaceSubTermL_of_by_ : NatList TermList Term ~> TermList .
  eq replaceSubTermL 1 NL of (T,TL) by T'
   = (replaceSubTerm NL of T by T', TL) .
  eq replaceSubTermL s(s(N)) NL of (T,TL) by T'
   = (T,replaceSubTermL s(N) NL of TL by T') .

  op replaceTerm_by_in_ : Term Term TermList ~> TermList .
  eq replaceTerm T by T' in T = T' .
  eq replaceTerm T by T' in (F[TL]) = F[replaceTerm T by T' in TL] .
  eq replaceTerm T by T' in T'' = T'' [owise] .
  eq replaceTerm T by T' in (T'',NeTL) 
   = (replaceTerm T by T' in T'',replaceTerm T by T' in NeTL) .

  *** context replacement **************************************************

  op _[_] : Context Context -> Context .
  op _[_] : NeCTermList Context -> NeCTermList .
  eq [] [ Ct ] = Ct .
  eq (F[CtL])[ Ct ] = F[ CtL [ Ct ] ] .
  eq (CtL,NeTL) [Ct] = (CtL [Ct] ), NeTL .
  eq (NeTL,CtL) [Ct] = NeTL, (CtL [Ct] ) .

  op _[_] : Context Term -> Term .
  op _[_] : NeCTermList Term -> TermList .
  eq [] [ T ] = T .
  eq (F[CtL])[ T ] = F[ CtL [ T ] ] .
  eq (CtL,NeTL) [T] = (CtL [T] ), NeTL .
  eq (NeTL,CtL) [T] = NeTL, (CtL [T] ) .

  *** is_substring_ *****************************************
  op is_substring_ : Qid Qid -> Bool [memo] .
  eq is F:Qid substring F':Qid
   = rfind(string(F':Qid), string(F:Qid), length(string(F':Qid))) =/= notFound .

  *** addprefix_To_ addsufix_To_ *****************************************
  op addprefix_To_ : Qid Variable -> Variable [memo] .
  eq addprefix Q To V
   = qid(string(Q) + string(getName(V)) + ":" + string(getType(V))) .
   
  op addprefix_To_ : Qid Constant -> Constant [ditto] .
  eq addprefix Q To F
   = if noUnderBar(F) and getName(F) :: Qid then
       if getType(F) :: Type then
         qid(string(Q) + string(getName(F)) + "." + string(getType(F)))
       else
         qid(string(Q) + string(getName(F)))
       fi
     else
       qid(string(Q) + string(F))
     fi .

  op addsufix_To_ : Qid Variable -> Variable [memo] .
  eq addsufix Q To V
   = qid(string(getName(V)) + string(Q) + ":" + string(getType(V))) .
   
  op addsufix_To_ : Qid Constant -> Constant [ditto] .
  eq addsufix Q To F
   = if noUnderBar(F) and getName(F) :: Qid then
       if getType(F) :: Type then
         qid(string(getName(F)) + string(Q) + "." + string(getType(F)))
       else
         qid(string(getName(F)) + string(Q))
       fi
     else
       qid(string(F) + string(Q))
     fi .

  op addType_ToVar_ : Type Qid -> Variable [memo] .
  eq addType TP:Qid ToVar V:Qid
   = qid(string(V:Qid) + ":" + string(TP:Qid)) .

  *** noUnderBar (auxiliary) ****************************
  op noUnderBar : Qid -> Bool .
  eq noUnderBar(F)
   = rfind(string(F), "_", length(string(F))) == notFound .

  *** addType  ******************************
  op addType : Qid Type -> Qid .
  eq addType(F,TP)
   = if noUnderBar(F) and getName(F) :: Qid then
       qid( string(getName(F)) + "." + string(TP) )
     else
       qid( string(F) + "." + string(TP) )
     fi .

  *** addTypeVar  ******************************
  op addTypeVar : Qid Type -> Qid .
  eq addTypeVar(F,TP)
   = qid( string(F) + ":" + string(TP) ) .

  *** createTerm  ******************************
  op createTerm : Qid TypeList -> Term .


endfm

fmod SUBSTITUTION-HANDLING is
  protecting META-TERM .
  protecting META-LEVEL .
  protecting TERM-HANDLING .

  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 .

  --- 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 dom : Substitution -> TermList .
---   eq dom(V <- T ; Subst) = (V,dom(Subst)) .
---   eq dom(none) = empty .
  
---   op range : Substitution -> TermList .
---   eq range(V <- T ; Subst) = (T,range(Subst)) .
---   eq range(none) = empty .

  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 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))) .
endfm

fmod TERMSET is
  protecting META-LEVEL .
  protecting SUBSTITUTION-HANDLING .

  sort TermSet .
  subsort Term < TermSet .
  op emptyTermSet : -> TermSet [ctor] .
  op _|_ : TermSet TermSet -> TermSet
    [ctor assoc comm id: emptyTermSet format (d n d d)] .
  eq X:Term | X:Term = X:Term .

  op _in_ : Term TermSet -> Bool .
  eq T:Term in (T:Term | TS:TermSet) = true .
  eq T:Term in TS:TermSet = false [owise] .
  
  op TermSet : TermList -> TermSet .
  eq TermSet(empty)
   = emptyTermSet .
  eq TermSet((T:Term,TL:TermList))
   = T:Term | TermSet(TL:TermList) .

endfm

fmod RENAMING is
  protecting META-TERM .
  protecting META-LEVEL .
  protecting TERM-HANDLING .
  protecting SUBSTITUTION-HANDLING .
  protecting TERMSET .
  protecting CONVERSION .
  protecting QID .
  protecting INT .
  protecting UNIFICATIONTRIPLE .

  var S S' Subst Subst' : Substitution .
  var V V' : Variable .
  var C C' : Constant .
  var CtL : NeCTermList .
  var Ct : Context .
  var T T' T1 T2 T1' T2' T1'' T2'' : Term .
  var F F' : Qid .
  var TL TL' TL'' TL''' : TermList .
  var Att : AttrSet .
  var RLS : RuleSet .
  var Rl : Rule .
  var TP : Type .
  var N N' : Nat .
  var NeTL : NeTermList .
  
  var Q Q' : Qid .
  var IL : ImportList .
  var SS : SortSet .
  var SSDS : SubsortDeclSet .
  var OPDS : OpDeclSet .
  var MAS : MembAxSet .
  var EQS : EquationSet .

  var TPL : TypeList .

  --- Extra filter for substitutions ------
  op _|>_ : Substitution Nat -> Substitution .
  eq Subst |> N
   = Subst |>* N [none] .

  op _|>*_[_] : Substitution Nat Substitution -> Substitution .
  eq none |>* N [Subst']
   = Subst' .
  eq ((V <- T') ; Subst) |>* N [Subst']
   = Subst |>* N 
     [Subst' ; if highestVar(V) < N then (V <- T') else none fi ] .

  --- instantiatesAbove -----------------------------------
  op _instantiatesAbove_ : Substitution Nat -> Bool .
  eq none instantiatesAbove N = false .
  eq ((V <- T') ; Subst) instantiatesAbove N
   = highestVar(V) >= N
     or-else 
     Subst instantiatesAbove N .

  ----------------------------------------------
  --- New Renaming Utilities -------------------
  op highestVar : GTermList -> Nat .
  eq highestVar(TL:GTermList)
   = highestVar(TL:GTermList,0) .
  
  op highestVarTerm : Term -> Nat . ---warning memo
  op highestVarTerm : Context -> Nat . ---warning memo
  eq highestVarTerm([]) = 0 .
  eq highestVarTerm(C) = 0 .
  eq highestVarTerm(V) 
   = if rfind(string(V), "#", length(string(V))) =/= notFound
        and
        rfind(string(V), ":", length(string(V))) =/= notFound
        and
        rat(substr(string(V),
                   rfind(string(V), "#", length(string(V))) + 1,
                   rfind(string(V), ":", length(string(V))) + (- 1))
            ,10) 
        :: Nat
     then rat(substr(string(V),
                   rfind(string(V), "#", length(string(V))) + 1,
                   rfind(string(V), ":", length(string(V))) + (- 1))
              ,10) 
     else 0
     fi .

  eq highestVarTerm(F[TL:GTermList]) 
   = highestVar(TL:GTermList,0) .
  
  op highestVar : GTermList Nat -> Nat .
  eq highestVar(empty,N)
   = N .
  eq highestVar((Ct,TL:GTermList),N)
   = highestVar(TL:GTermList,
       if highestVarTerm(Ct) > N then highestVarTerm(Ct) else N fi
     ) .
  eq highestVar((T,TL:GTermList),N)
   = highestVar(TL:GTermList,
       if highestVarTerm(T) > N then highestVarTerm(T) else N fi
     ) .

  --- For substitutions
  op highestVar : Substitution -> Nat . --- [memo] .
  eq highestVar(Subst)
   = highestVar(Subst,0) .
  
  op highestVar : Substitution Nat -> Nat .
  eq highestVar((none).Substitution,N) = N .
  eq highestVar(V <- T ; Subst,N) 
   = highestVar(Subst,highestVar((T,V),N)) .

  --- Renaming ------------------------------------------------------
  op newVar : Nat TypeList -> TermList .
  eq newVar(N,nil) = empty .
  eq newVar(N,TP TPL) = (newVar*(N,TP),newVar(s(N),TPL)) .

  op newVar* : Nat Type -> Variable .
  eq newVar*(N,TP)
   = qid("#" + string(N,10) + ":" + string(TP)) .

  op simplifyVars : TermList -> TermList .
  eq simplifyVars(TL) = TL << 0 < .

  op _<<`(_`)< : TermList GTermList -> TermList .
  eq X:TermList <<(TL:GTermList)<
   = X:TermList << highestVar(TL:GTermList) + 1 < .

  op _<<_ : TermList UnificationPair -> TermList .
  eq TL << {Subst,N} = TL << Subst .

  op _<<_ : TermList UnificationTriple -> TermList .
  eq TL << {Subst,Subst',N} = TL << (Subst ; Subst') .

  op _<<_ : Substitution UnificationTriple -> Substitution .
  eq S:Substitution << {Subst,Subst',N} = S:Substitution << (Subst ; Subst') .

  op _<<_< : TermList Nat -> TermList .
  eq TL << N < = TL << (TL << { none, N } <) .

  op _<<_< : TermList UnificationPair -> UnificationPair . ***Huge [memo] .
  eq C << {S,N} < = {S,N} .
  eq F[TL] << {S,N} < = TL << {S,N} < .
  eq V << {S,N} < 
   = if not (dom S inVars V)
     then {S ; V <- newVar(N,getType(V)), N + 1}
     else {S,N}
     fi .

  eq (T,TL:NeTermList) << {S,N} < 
   = TL:NeTermList << (T << {S,N} < ) < .
  eq empty << {S,N} < 
   = {S,N} .

endfm

fmod SUBSTITUTIONSET is
  protecting SUBSTITUTION-HANDLING .
  protecting META-LEVEL .
  protecting TERMSET .
  protecting RENAMING .

  sort SubstitutionSet NeSubstitutionSet .
  subsort Substitution < NeSubstitutionSet < SubstitutionSet .
  op empty : -> SubstitutionSet [ctor] .
  op _|_ : SubstitutionSet SubstitutionSet -> SubstitutionSet
    [ctor assoc comm id: empty format (d n d d)] .
  op _|_ : NeSubstitutionSet SubstitutionSet -> NeSubstitutionSet
    [ctor ditto] .
  eq X:Substitution | X:Substitution = X:Substitution .

  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 _<<_ : Substitution SubstitutionSet -> SubstitutionSet .
  eq S << empty = empty .
  ceq S << (S' | SS') = (S << S') | (S << SS') if SS' =/= empty .

  op _..._ : SubstitutionSet [SubstitutionSet] 
          -> SubstitutionSet [strat (1) gather (e E)] .

  eq empty ... SS':[SubstitutionSet] = empty .
  eq (S | SS) ... SS':[SubstitutionSet]
   = (S ...' SS':[SubstitutionSet])
     |
     (SS ... SS':[SubstitutionSet]) .

  op _...'_ : Substitution SubstitutionSet -> SubstitutionSet .

  eq S ...' empty
   = empty .

  eq S ...' (S' | SS')
   = (S .. S')
     |
     (S ...' SS') .

  op _|>_ : SubstitutionSet TermList -> SubstitutionSet .
  eq (empty).SubstitutionSet |> TL = empty .
  eq (S | SS:NeSubstitutionSet) |> TL 
   = (S |> TL) | (SS:NeSubstitutionSet |> TL) .

  op _|>_ : SubstitutionSet Nat -> SubstitutionSet .
  eq SS:NeSubstitutionSet |> N
   = SS:NeSubstitutionSet |> (0,N) .

  op _|>`(_,_`) : SubstitutionSet Nat Nat -> SubstitutionSet .
  eq (empty).SubstitutionSet |> (N,N') = empty .
  eq (S | SS:NeSubstitutionSet) |> (N,N') 
   = (S |> (N,N')) | (SS:NeSubstitutionSet |> (N,N')) .

  op _|>`(_,_`) : Substitution Nat Nat -> Substitution .
  eq none |> (N,N') = none .
  eq ((V <- T') ; Subst) |> (N,N')
   = if N <= highestVar(V) and highestVar(V) <= N'
     then (V <- T')
     else none
     fi
     ; (Subst |> (N,N')) .

  op filter_by!InVars_ : SubstitutionSet TermList -> SubstitutionSet .
  eq filter (empty).SubstitutionSet by!InVars TL 
   = (empty).SubstitutionSet .
  eq filter (S | SS) by!InVars TL 
   = if dom S inVars TL
     then empty
     else S
     fi
     | filter SS by!InVars TL .

  op _==* none : SubstitutionSet -> Bool .
  eq (none | SS) ==* none = SS ==* none .
  eq (empty).SubstitutionSet ==* none = true .
  eq SS ==* none = false [owise] .

  op |_| : SubstitutionSet -> Nat .
  eq | (empty).SubstitutionSet | = 0 .
  eq | (S | SS) | = s(| SS |) .

endfm

fmod UNIFICATIONPAIRSET is
  protecting SUBSTITUTIONSET .
  protecting RENAMING .
  protecting UNIFICATIONTRIPLE .

  vars V V' : Variable .
  vars U U' : UnificationPair .
  vars US US' : UnificationPairSet .
  vars S S' S1 S1' S2 S2' : Substitution .
  var SS : SubstitutionSet .
  vars N N' N1 N2 : Nat .
  vars T T' : Term .
  var TL : TermList .
  var M : Module .

  --- Combine UnificationPair ---------------------------------------------
  op _.._ : UnificationPair UnificationPair -> UnificationPair .
  eq {S,N} .. {S',N'} = {S .. S',max(N,N')} .

  --- Detect used variables ----------------------------------------------
  op dom_inVars_ : UnificationPair TermList -> Bool . --- [memo] .
  eq dom {S,N} inVars TL = dom S inVars TL .

  --- UnificationPairSet --------------------------------------------------
  sort UnificationPairSet .
  subsort UnificationPair < UnificationPairSet .
  op empty : -> UnificationPairSet [ctor] .
  op _|_ : UnificationPairSet UnificationPairSet -> UnificationPairSet
    [ctor assoc comm id: empty format (d n d d)] .
  eq X:UnificationPair | X:UnificationPair = X:UnificationPair .

  op _..._ : UnificationPairSet [UnificationPairSet] 
          -> UnificationPairSet [strat (1) gather (e E)] .

  eq (empty).UnificationPairSet ... US':[UnificationPairSet] 
   = (empty).UnificationPairSet .
  eq (U | US) ... US':[UnificationPairSet]
   = (U ...' US':[UnificationPairSet])
     |
     (US ... US':[UnificationPairSet]) .

  op _...'_ : UnificationPair UnificationPairSet -> UnificationPairSet .

  eq U ...' (empty).UnificationPairSet
   = (empty).UnificationPairSet .

  eq U ...' (U' | US')
   = (U .. U')
     |
     (U ...' US') .

  --- Restriction -----------------------
  op _|>_ : UnificationPairSet TermList -> UnificationPairSet .
  eq (empty).UnificationPairSet |> TL = empty .
  eq ({S,N} | US) |> TL = {(S |> TL),N} | (US |> TL) .

  op filter_by!InVars_ : UnificationPairSet TermList 
                      -> UnificationPairSet .
  eq filter (empty).UnificationPairSet by!InVars TL 
   = (empty).UnificationPairSet .
  eq filter (U | US) by!InVars TL 
   = if dom U inVars TL
     then empty
     else U
     fi
     | filter US by!InVars TL .

  op toUnificationPair[_]`(_`) : Nat SubstitutionSet -> UnificationPairSet .
  eq toUnificationPair[N](empty) 
   = empty .
  eq toUnificationPair[N](S | SS)
   = {S,highestVar(S,N)} 
     | toUnificationPair[N](SS) .

  op toSubstitution : UnificationPairSet -> SubstitutionSet .
  eq toSubstitution((empty).UnificationPairSet) 
   = empty .
  eq toSubstitution({S,N} | US)
   = S | toSubstitution(US) .

  op _in_ : UnificationPair UnificationPairSet -> Bool .
  eq X:UnificationPair in (X:UnificationPair | XS:UnificationPairSet) = true .
  eq X:UnificationPair in XS:UnificationPairSet = false [owise] .

endfm

fmod UNIFICATIONTRIPLESET is
  protecting SUBSTITUTIONSET .
  protecting RENAMING .
  protecting UNIFICATIONPAIRSET .

  vars V V' : Variable .
  var C : Constant .
  var F : Qid .
  vars U U' : UnificationTriple .
  vars US US' : UnificationTripleSet .
  vars S S' S1 S1' S2 S2' : Substitution .
  var SS : SubstitutionSet .
  var SSe : NeSubstitutionSet .
  vars N N' N1 N2 NextVar : Nat .
  vars T T' : Term .
  var TL : TermList .
  var NeTL : NeTermList .
  var M : Module .
  var UPS : UnificationPairSet .

  --- Combine UnificationPair ---------------------------------------------
  op _.._ : UnificationTriple UnificationTriple -> UnificationTriple .
  eq {S1,S1',N1} .. {S2,S2',N2} = {S1 .. S2,S1' .. S2',max(N1,N2)} .

  --- UnificationPairSet --------------------------------------------------
  sort UnificationTripleSet .
  subsort UnificationTriple < UnificationTripleSet .
  op empty : -> UnificationTripleSet [ctor] .
  op _|_ : UnificationTripleSet UnificationTripleSet 
        -> UnificationTripleSet
    [ctor assoc comm id: empty format (d n d d)] .
  eq X:UnificationTriple | X:UnificationTriple = X:UnificationTriple .

  op _..._ : UnificationTripleSet [UnificationTripleSet] 
          -> UnificationTripleSet [strat (1) gather (e E)] .

  eq (empty).UnificationTripleSet ... US':[UnificationTripleSet] 
   = (empty).UnificationTripleSet .
  eq (U | US) ... US':[UnificationTripleSet]
   = (U ...' US':[UnificationTripleSet])
     |
     (US ... US':[UnificationTripleSet]) .

  op _...'_ : UnificationTriple UnificationTripleSet 
           -> UnificationTripleSet .

  eq U ...' (empty).UnificationTripleSet
   = (empty).UnificationTripleSet .

  eq U ...' (U' | US')
   = (U .. U')
     |
     (U ...' US') .

  --- convert  -----------------------------------------------------
  op split : UnificationPair Nat -> UnificationTriple .
  eq split({none,N},N') = {none,none,N} .
  eq split({(V <- T') ; S,N},N')
   = if highestVar(V) < N' 
     then {(V <- T'),none,N}
     else {none,(V <- T'),N}
     fi
     .. split({S,N},N') .

  op split : UnificationPairSet Term Term -> UnificationTripleSet .
  eq split(empty,T,T') = empty .
  eq split({S,N} | UPS,T,T') = {S |> T, S |> T',N} | split(UPS,T,T') .

  op toUnificationTriple[_]`(_`) : 
             Nat SubstitutionSet -> UnificationTripleSet .
  eq toUnificationTriple[N](SS)
   = toUnificationTriple*[N](SS,empty) .

  op toUnificationTriple*[_]`(_,_`) : 
             Nat SubstitutionSet 
             UnificationTripleSet -> UnificationTripleSet .
  eq toUnificationTriple*[N](empty,US) 
   = US .
  eq toUnificationTriple*[N](S | SS,US)
   = toUnificationTriple*[N](SS, US | {none,S,highestVar(S,N)}) . 

  op toUnificationTriple[_,_]`(_`) : 
             Nat Nat SubstitutionSet -> UnificationTripleSet .
  eq toUnificationTriple[NextVar,N](SS)
   = toUnificationTriple*[NextVar,N](SS,empty) .

  op toUnificationTriple*[_,_]`(_,_`) : 
             Nat Nat SubstitutionSet 
             UnificationTripleSet -> UnificationTripleSet .
  eq toUnificationTriple*[NextVar,N](empty,US) 
   = US .
  eq toUnificationTriple*[NextVar,N](S | SS,US)
   = toUnificationTriple*[NextVar,N](SS,
             US | split({S,highestVar(S,N)},NextVar)) .

  op toUnificationTriple[_,_,_]`(_`) : 
             Term Term Nat SubstitutionSet -> UnificationTripleSet .
  eq toUnificationTriple[T,T',N](SS)
   = toUnificationTriple*[T,T',N](SS,empty) .

  op toUnificationTriple*[_,_,_]`(_,_`) : 
             Term Term Nat SubstitutionSet 
             UnificationTripleSet -> UnificationTripleSet .
  eq toUnificationTriple*[T,T',N](empty,US) 
   = US .
  eq toUnificationTriple*[T,T',N](S | SS,US)
   = toUnificationTriple*[T,T',N](SS, US | {S |> T,S |> T',highestVar(S,N)}) .

  op toSubstitution : UnificationTripleSet -> SubstitutionSet .
  eq toSubstitution(US)
   = toSubstitution*(US,empty) .

  op toSubstitution* : UnificationTripleSet 
                       SubstitutionSet -> SubstitutionSet .
  eq toSubstitution*((empty).UnificationTripleSet,SS) 
   = SS .
  eq toSubstitution*({S,S',N} | US,SS)
   = toSubstitution*(US,SS | (S ; S')) .

  op _in_ : UnificationTriple UnificationTripleSet -> Bool .
  eq X:UnificationTriple 
     in (X:UnificationTriple | XS:UnificationTripleSet) = true .
  eq X:UnificationTriple in XS:UnificationTripleSet = false [owise] .

  --- restriction ---------------------------------------------------
  op _|>_ : UnificationTripleSet TermList -> UnificationTripleSet .
  eq US |> TL
   = US *|> TL [empty] .

  op _*|>_[_] : UnificationTripleSet TermList 
               UnificationTripleSet -> UnificationTripleSet .
  eq (empty).UnificationTripleSet *|> TL [US']
   = US' .
  eq ({S,S',N} | US) *|> TL [US']
   = US *|> TL [US' | {(S |> TL),(S' |> TL),N} ] .

  op _filterBy_ : UnificationTripleSet Nat -> UnificationTripleSet .
  eq US filterBy NextVar 
   = US filterBy* NextVar [empty] .

  op _filterBy*_[_] : UnificationTripleSet Nat 
                     UnificationTripleSet -> UnificationTripleSet .
  eq empty filterBy* NextVar [US']
   = US' .
  eq ({S,S',N} | US) filterBy* NextVar [US']
   = US filterBy* NextVar 
     [US' | if S instantiatesAbove NextVar then empty else {S,S',N} fi ] .
endfm

fmod MODULE-HANDLING is
  protecting INT .
  protecting META-LEVEL .
  protecting EXT-BOOL . *** From Full Maude
  protecting SUBSTITUTION-HANDLING .
  protecting UNIFICATIONTRIPLESET .

  var T T' T'' T1 T2 Lhs Rhs : Term .
  var C C' : Constant .
  var QIL : QidList .
  var N N' : Nat .
  var NL NL' : NatList .
  var Q F F' : Qid .
  vars AtS AtS' : AttrSet .
  var EqS : EquationSet .
  var Eq : Equation .
  var RlS : RuleSet .
  var Rl : Rule .
  var Cond : Condition .
  var TP TP' : Type .
  var TPL TPL' : TypeList .
  ---var TPL TPL' : ETypeList .
  ---var ET ET' : EType .
  var VDS OPDS : OpDeclSet .
  var OPD : OpDecl .
  var M : Module .
  var TL TL' TL'' : TermList .
  var B : Bool .
  var V V' : Variable .
  var I  : Int .
  vars S S' : Substitution .
  var US : UnificationTripleSet .

  *** canonice  ******************************
  op canonice : Module Term -> Term .
---  eq canonice(M,T) = getTerm(metaReduce(eraseRls(eraseEqs(M)),T)) .
  eq canonice(M,T) = getTerm(metaNormalize(M,T)) .

  op canonice : Module Substitution -> Substitution .
  eq canonice(M,(none).Substitution) = none .
  eq canonice(M,V <- T ; S) = V <- canonice(M,T) ; canonice(M,S)  .

  op canonice : Module UnificationTripleSet -> UnificationTripleSet .
  eq canonice(M,(empty).UnificationTripleSet) = (empty).UnificationTripleSet .
  eq canonice(M,{S,S',N} | US) = {canonice(M,S),canonice(M,S'),N} | canonice(M,US) .

  *** normalize  ******************************
  op normalize : Module Term -> Term .
  eq normalize(M,T) = getTerm(metaReduce(eraseRls(M),T)) .

  op normalize : Module Substitution -> Substitution .
  eq normalize(M,(none).Substitution) = none .
  eq normalize(M,V <- T ; S) = V <- normalize(M,T) ; normalize(M,S)  .

  *** normalizeRls  ******************************
  op normalizeRls : Module Term -> Term .
  eq normalizeRls(M,T) = getTerm(metaReduce(rls2eqs(M),T)) .

  op normalizeRls : Module Substitution -> Substitution .
  eq normalizeRls(M,(none).Substitution) = none .
  eq normalizeRls(M,V <- T ; S) = V <- normalizeRls(M,T) ; normalizeRls(M,S)  .

  *** typeLeq **************************************************
  op typeLeq : Module TypeList TypeList ~> Bool [memo] .

  eq typeLeq(M,TP:Sort TPL,TP':Sort TPL')
   = sortLeq(M,TP:Sort,TP':Sort) and typeLeq(M,TPL,TPL') .
  eq typeLeq(M,TP:Sort TPL,TP':Kind TPL')
   = getKind(M,TP:Sort) == TP':Kind
     and typeLeq(M,TPL,TPL') .
  eq typeLeq(M,TP:Kind TPL,TP':Sort TPL')
   = false .
  eq typeLeq(M,TP:Kind TPL,TP':Kind TPL')
   = TP:Kind == TP':Kind and typeLeq(M,TPL,TPL') .
  eq typeLeq(M,nil,nil)
   = true .

  *** getTypes **************************************************
  op getTypes : Module TermList -> TypeList . ---Memo is huge
  eq getTypes(M, (T, TL)) = leastSort(M, T) getTypes(M, TL) .
  eq getTypes(M, empty) = nil .

  *** getFrozen ************************************************
  op getFrozen : Module Qid TypeList -> NatList [memo] .
  eq getFrozen(M,F,TPL) = getFrozen(getOpsOfQid(M,F,TPL)) .

  op getFrozen : OpDeclSet -> NatList .
  eq getFrozen((op F : TPL -> TP [frozen(NL) AtS] .) OPDS) = NL .
  eq getFrozen(OPDS) = 0 [owise] .

  *** inNatList ************************************************
  op _inNatList_ : Nat NatList -> Bool .
  eq N inNatList (NL N NL') = true .
  eq N inNatList NL = false [owise] .

  *** membership ************************************************
  op _in_ : Type TypeList ~> Bool .
  eq TP in (TPL TP TPL') = true .
  eq TP in TPL = false [owise] .
  
  *** isConstructor  ******************************
  op isConstructor : Module Term -> Bool .
  op isConstructor : Module Qid TypeList -> Bool [memo] .
  op isConstructor : OpDeclSet -> Bool .

  eq isConstructor(M,V) = false .
  eq isConstructor(M,C) = isConstructor(M,C,nil) .
  eq isConstructor(M,F[TL]) = isConstructor(M,F,getTypes(M,TL)) .

  eq isConstructor(M,F,TPL)
   = getEqsOfQid(M,F,TPL) == none or-else isConstructor(getOpsOfQid(M,F,TPL)) .

  eq isConstructor((op F : TPL -> TP [ctor AtS] .) OPDS) = true .
  eq isConstructor(OPDS) = false [owise] .

  *** getOpsOfType ***********************************************
  op getOpsOfType : Module Type -> OpDeclSet [memo] .
  op getOpsOfType : Module OpDeclSet Type -> OpDeclSet .

  eq getOpsOfType(M,TP) = getOpsOfType(M,getOps(M),TP) .

  eq getOpsOfType(M,((op F : TPL -> TP [AtS] .) OPDS),TP')
    = if TP == TP'
      then (op F : TPL -> TP [AtS] .)
           getOpsOfType(M,OPDS,TP')
      else getOpsOfType(M,OPDS,TP')
      fi .

  eq getOpsOfType(M,OPDS,TP)
   = none
     [owise] .
     
  *** getOpsOfQid ***********************************************
  op getOpsOfQid : Module Qid TypeList -> OpDeclSet [memo] .
  op getOpsOfQid : Module OpDeclSet Qid TypeList -> OpDeclSet .

  eq getOpsOfQid(M,F,TPL) 
   = if getOpsOfQid(M,getOps(M),F,TPL) =/= none
     then getOpsOfQid(M,getOps(M),F,TPL) 
     else getOpsOfQid(M,getOps(M),F,restrict TPL To 2) 
     fi .

  eq getOpsOfQid(M,((op F : TPL -> TP [AtS] .) OPDS),F,TPL')
    = if eSameKind(M,TPL,TPL')
      then (op F : TPL -> TP [AtS] .)
           getOpsOfQid(M,OPDS,F,TPL')
      else getOpsOfQid(M,OPDS,F,TPL')
      fi .

  eq getOpsOfQid(M,OPDS,F',TPL')
   = none
     [owise] .

  op restrict_To_ : TypeList Nat -> TypeList .
  eq restrict nil To NL = nil .
  eq restrict TPL To 0 = nil .
  eq restrict (TP,TPL) To s(N) = (TP, restrict TPL To N) .

  *** getEqsOfQid ******************************************************
  op getEqsOfQid : Module Qid TypeList -> EquationSet [memo] .
  op getEqsOfQid : Module Qid TypeList EquationSet -> EquationSet .

  eq getEqsOfQid(M, F,TPL) = getEqsOfQid(M, F, TPL, getEqs(M)) .

  ceq getEqsOfQid(M, F, TPL, (eq C = T' [AtS] .) EqS )
   = (eq C = T' [AtS] .) getEqsOfQid(M, F, TPL, EqS)
   if F == C .
  ceq getEqsOfQid(M, F, TPL, (eq F[TL] = T' [AtS] .) EqS )
   = (eq F[TL] = T' [AtS] .) getEqsOfQid(M, F, TPL, EqS)
   if eSameKind(M,getTypes(M,TL),TPL) .
  ceq getEqsOfQid(M, F, TPL, (ceq C = T' if Cond [AtS] .) EqS )
   = (ceq C = T' if Cond [AtS] .) getEqsOfQid(M, F, TPL, EqS)
   if F == C .
  ceq getEqsOfQid(M, F, TPL, (ceq F[TL] = T' if Cond [AtS] .) EqS )
   = (ceq F[TL] = T' if Cond [AtS] .) getEqsOfQid(M, F, TPL, EqS)
   if eSameKind(M,getTypes(M,TL),TPL) .
  eq getEqsOfQid(M, F, TPL, Eq EqS )
   = getEqsOfQid(M, F, TPL, EqS) [owise] .
  eq getEqsOfQid(M, F, TPL, (none).EquationSet )
   = (none).EquationSet .

  *** getTypesOfQid  ****************************************
  op getTypesOfQid : Module Qid TypeList -> TypeSet [memo] .
  op getTypesOfQid : OpDeclSet -> TypeSet .

  eq getTypesOfQid(M,F,TPL) = getTypesOfQid(getOpsOfQid(M,F,TPL)) .
  eq getTypesOfQid((op F : TPL -> TP [AtS] .) OPDS)
   = TP ; getTypesOfQid(OPDS) .
  eq getTypesOfQid((none).OpDeclSet) = (none).TypeSet .

  *** filterConstructorSymbols ************************************
  op filterConstructorSymbols : OpDeclSet -> OpDeclSet .
  eq filterConstructorSymbols(((op F : TPL -> TP [AtS] .) OPDS))
    = if isConstructor((op F : TPL -> TP [AtS] .) none)
      then (op F : TPL -> TP [AtS] .)
           filterConstructorSymbols(OPDS)
      else filterConstructorSymbols(OPDS)
      fi .
  eq filterConstructorSymbols(none)
    = none .

  *** filterDefinedSymbols *****************************************
  op filterDefinedSymbols : OpDeclSet -> OpDeclSet .
  eq filterDefinedSymbols(((op F : TPL -> TP [ctor AtS] .) OPDS))
    = filterDefinedSymbols(OPDS) .
  eq filterDefinedSymbols(((op F : TPL -> TP [AtS] .) OPDS))
    = (op F : TPL -> TP [AtS] .) filterDefinedSymbols(OPDS) [owise] .
  eq filterDefinedSymbols(none)
    = none .

  *** isCommutative ******************************
  op isCommutative : Module Term -> Bool .
  op isCommutative : Module Qid TypeList -> Bool [memo] .
  op isCommutative : OpDeclSet -> Bool .

  eq isCommutative(M,V) = false .
  eq isCommutative(M,C) = false .
  eq isCommutative(M,F[TL]) = isCommutative(M,F,getTypes(M,TL)) .

  eq isCommutative(M,F,TPL) = isCommutative(getOpsOfQid(M,F,TPL)) .

  eq isCommutative((op F : TPL -> TP [comm AtS] .) OPDS) = true .
  eq isCommutative(OPDS) = false [owise] .

  *** isAssociative ******************************
  op isAssociative : Module Term -> Bool .
  op isAssociative : Module Qid TypeList -> Bool [memo] .
  op isAssociative : OpDeclSet -> Bool .

  eq isAssociative(M,V) = false .
  eq isAssociative(M,C) = false .
  eq isAssociative(M,F[TL]) = isAssociative(M,F,getTypes(M,TL)) .

  eq isAssociative(M,F,TPL) = isAssociative(getOpsOfQid(M,F,TPL)) .

  eq isAssociative((op F : TPL -> TP [assoc AtS] .) OPDS) = true .
  eq isAssociative(OPDS) = false [owise] .

  *** getIdSymbol ******************************
  op getIdSymbol : Module Term ~> Term .
  eq getIdSymbol(M,F[TL]) = getIdSymbol(M,F,getTypes(M,TL)) .

  op getIdSymbol : Module Qid TypeList ~> Term [memo] .
  eq getIdSymbol(M,F,TPL) = getIdSymbol(getOpsOfQid(M,F,TPL)) .

  op getIdSymbol : OpDeclSet ~> Term .
  eq getIdSymbol((op F : TPL -> TP [id(T) AtS] .) OPDS) = T .

  op getLeftIdSymbol : Module Term ~> Term .
  eq getLeftIdSymbol(M,F[TL]) = getLeftIdSymbol(M,F,getTypes(M,TL)) .

  op getLeftIdSymbol : Module Qid TypeList ~> Term .
  eq getLeftIdSymbol(M,F,TPL) = getLeftIdSymbol(getOpsOfQid(M,F,TPL)) .

  op getLeftIdSymbol : OpDeclSet ~> Term .
  eq getLeftIdSymbol((op F : TPL -> TP [left-id(T) AtS] .) OPDS) = T .

  op getRightIdSymbol : Module Term ~> Term .
  eq getRightIdSymbol(M,F[TL]) = getRightIdSymbol(M,F,getTypes(M,TL)) .

  op getRightIdSymbol : Module Qid TypeList ~> Term .
  eq getRightIdSymbol(M,F,TPL) = getRightIdSymbol(getOpsOfQid(M,F,TPL)) .

  op getRightIdSymbol : OpDeclSet ~> Term .
  eq getRightIdSymbol((op F : TPL -> TP [right-id(T) AtS] .) OPDS) = T .

  *** anyIdSymbol ******************************
  op anyIdSymbol : Module Term -> Bool .
  eq anyIdSymbol(M,C:Constant) 
   = false .
  eq anyIdSymbol(M,V:Variable) 
   = false .
  eq anyIdSymbol(M,F:Qid[TL:TermList]) 
   = getIdSymbol(M,F:Qid[TL:TermList]) :: Term
     or-else 
     anyIdSymbol*(M,TL:TermList) .

  op anyIdSymbol* : Module TermList -> Bool .
  eq anyIdSymbol*(M,empty) 
   = false .
  eq anyIdSymbol*(M,(T:Term,TL:TermList)) 
   = anyIdSymbol(M,T:Term)
     or-else 
     anyIdSymbol*(M,TL:TermList) .

  ****
  op anyIdSymbol : Module Substitution -> Bool .
  eq anyIdSymbol(M,(none).Substitution) = false .
  eq anyIdSymbol(M,V:Variable <- T:Term ; S:Substitution)
   = anyIdSymbol(M,T:Term)
     or-else
     anyIdSymbol(M,S:Substitution) .

  ****
  op anyIdSymbolT&S : Module Term Substitution -> Bool .
  eq anyIdSymbolT&S(M,C:Constant,S:Substitution) 
   = false .
  eq anyIdSymbolT&S(M,V:Variable,S:Substitution) 
   = false .
  eq anyIdSymbolT&S(M,F:Qid[TL:TermList],S:Substitution) 
   = (getIdSymbol(M,F:Qid[TL:TermList]) :: Term 
      and-then
      inst(getIdSymbol(M,F:Qid[TL:TermList]),S:Substitution) )
     or-else 
     anyIdSymbolT&S*(M,TL:TermList,S:Substitution) .

  op anyIdSymbolT&S* : Module TermList Substitution -> Bool .
  eq anyIdSymbolT&S*(M,empty,S:Substitution) 
   = false .
  eq anyIdSymbolT&S*(M,(T:Term,TL:TermList),S:Substitution) 
   = anyIdSymbolT&S(M,T:Term,S:Substitution)
     or-else 
     anyIdSymbolT&S*(M,TL:TermList,S:Substitution) .

  op inst : Constant Substitution -> Bool .
  eq inst(Id:Constant,V:Variable <- Id:Constant ; S:Substitution) = true .
  eq inst(Id:Constant,S:Substitution) = false [owise] .

  *** eSameKind ******************************
  op eSameKind : Module TypeList TypeList -> Bool [memo] .
  eq eSameKind(M,TP TPL, TP' TPL') 
   = sameKind(M,TP,TP') and eSameKind(M,TPL,TPL') .
  eq eSameKind(M,nil,nil) = true .
  eq eSameKind(M,TPL,nil) = true .
  eq eSameKind(M,nil,TPL') = true .
  ---eq eSameKind(M,TPL,TPL') = false [owise] .

  *** eqs2rls *******************************
  sort EqSet&RlsSet .
  op {_,_} : EquationSet RuleSet -> EqSet&RlsSet .
  op getEqs : EqSet&RlsSet -> EquationSet .
  eq getEqs({EqS,RlS}) = EqS .
  op getRls : EqSet&RlsSet -> RuleSet .
  eq getRls({EqS,RlS}) = RlS .

  op eqs2rls# : EquationSet -> EqSet&RlsSet [memo] .
  eq eqs2rls#(none) = {none,none} .
  eq eqs2rls#((eq Lhs = Rhs [AtS] .) EqS)
   = {getEqs(eqs2rls#(EqS)),
      (rl Lhs => Rhs [AtS] .) getRls(eqs2rls#(EqS))
     } .
  eq eqs2rls#((ceq Lhs = Rhs if Cond [AtS] .) EqS)
   = {getEqs(eqs2rls#(EqS)),
      (crl Lhs => Rhs if Cond [AtS] .) getRls(eqs2rls#(EqS))
     } .

  op eqs2rls : SModule -> SModule .
  eq eqs2rls(
      mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm)
   = mod (addsufix '-EQS2RLS To Q:Qid) is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       getEqs(eqs2rls#(E:EquationSet))
       getRls(eqs2rls#(E:EquationSet))
     endm .

  op eqs2rls : FModule -> FModule .
  eq eqs2rls(
      fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   = mod (addsufix '-EQS2RLS To Q:Qid) is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       getEqs(eqs2rls#(E:EquationSet))
       getRls(eqs2rls#(E:EquationSet))
     endm .

  op eqsNoBuiltInUnify2rls : SModule -> SModule .
  eq eqsNoBuiltInUnify2rls(
      mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm)
   = mod (addsufix '-EQS2RLS To Q:Qid) is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       (getEqs(eqs2rls#(getEqsNoBuiltInUnify(E:EquationSet))) getEqsBuiltInUnify(E:EquationSet))
       getRls(eqs2rls#(getEqsNoBuiltInUnify(E:EquationSet)))
     endm .

  op eqsNoBuiltInUnify2rls : FModule -> SModule .
  eq eqsNoBuiltInUnify2rls(
      fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   = mod (addsufix '-EQS2RLS To Q:Qid) is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       (getEqs(eqs2rls#(getEqsNoBuiltInUnify(E:EquationSet))) getEqsBuiltInUnify(E:EquationSet))
       getRls(eqs2rls#(getEqsNoBuiltInUnify(E:EquationSet)))
     endm .

  op eqsNoVariant2rls : SModule -> SModule .
  eq eqsNoVariant2rls(
      mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm)
   = mod (addsufix '-EQS2RLS To Q:Qid) is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       (getEqs(eqs2rls#(getEqsNoVariant(E:EquationSet))) getEqsVariant(E:EquationSet))
       getRls(eqs2rls#(getEqsNoVariant(E:EquationSet)))
     endm .

  op eqsNoVariant2rls : FModule -> SModule .
  eq eqsNoVariant2rls(
      fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   = mod (addsufix '-EQS2RLS To Q:Qid) is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       (getEqs(eqs2rls#(getEqsNoVariant(E:EquationSet))) getEqsVariant(E:EquationSet))
       getRls(eqs2rls#(getEqsNoVariant(E:EquationSet)))
     endm .

  op eqsVariant2rls : SModule -> SModule .
  eq eqsVariant2rls(
      mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm)
   = mod (addsufix '-EQS2RLS To Q:Qid) is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       (getEqs(eqs2rls#(getEqsVariant(E:EquationSet))) getEqsNoVariant(E:EquationSet))
       getRls(eqs2rls#(getEqsVariant(E:EquationSet)))
     endm .

  op eqsVariant2rls : FModule -> SModule .
  eq eqsVariant2rls(
      fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   = mod (addsufix '-EQS2RLS To Q:Qid) is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       (getEqs(eqs2rls#(getEqsVariant(E:EquationSet))) getEqsNoVariant(E:EquationSet))
       getRls(eqs2rls#(getEqsVariant(E:EquationSet)))
     endm .

  *** getEqsNoBuiltInUnify *******************************
  op getEqsNoBuiltInUnify : Module -> EquationSet .
  eq getEqsNoBuiltInUnify(
      fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   = getEqsNoBuiltInUnify(E:EquationSet) .
  eq getEqsNoBuiltInUnify(
      mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm)
   = getEqsNoBuiltInUnify(E:EquationSet) .

  op getEqsNoBuiltInUnify : EquationSet -> EquationSet [memo] .
  eq getEqsNoBuiltInUnify(none) = none .
  eq getEqsNoBuiltInUnify((eq Lhs = Rhs [AtS metadata("builtin-unify")] .) EqS)
   = getEqsNoBuiltInUnify(EqS) .
  eq getEqsNoBuiltInUnify((eq Lhs = Rhs [AtS] .) EqS)
   = (eq Lhs = Rhs [AtS] .) getEqsNoBuiltInUnify(EqS) 
  [owise] .
  eq getEqsNoBuiltInUnify((ceq Lhs = Rhs if Cond [AtS] .) EqS)
   = (ceq Lhs = Rhs if Cond [AtS] .) getEqsNoBuiltInUnify(EqS) .

  *** getEqsNoVariant *******************************
  op getEqsNoVariant : Module -> EquationSet .
  eq getEqsNoVariant(
      fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   = getEqsNoVariant(E:EquationSet) .
  eq getEqsNoVariant(
      mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm)
   = getEqsNoVariant(E:EquationSet) .

  op getEqsNoVariant : EquationSet -> EquationSet [memo] .
  eq getEqsNoVariant(none) = none .
  eq getEqsNoVariant((eq Lhs = Rhs [AtS metadata("variant")] .) EqS)
   = getEqsNoVariant(EqS) .
  eq getEqsNoVariant((eq Lhs = Rhs [AtS] .) EqS)
   = (eq Lhs = Rhs [AtS] .) getEqsNoVariant(EqS) 
  [owise] .
  eq getEqsNoVariant((ceq Lhs = Rhs if Cond [AtS] .) EqS)
   = (ceq Lhs = Rhs if Cond [AtS] .) getEqsNoVariant(EqS) .

  *** getEqsVariant *******************************
  op getEqsVariant : Module -> EquationSet .
  eq getEqsVariant(
      fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   = getEqsVariant(E:EquationSet) .
  eq getEqsVariant(
      mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm)
   = getEqsVariant(E:EquationSet) .

  op getEqsVariant : EquationSet -> EquationSet [memo] .
  eq getEqsVariant(none) = none .
  eq getEqsVariant((eq Lhs = Rhs [AtS metadata("variant")] .) EqS)
   = (eq Lhs = Rhs [AtS metadata("variant")] .)
     getEqsVariant(EqS) .
  eq getEqsVariant((eq Lhs = Rhs [AtS] .) EqS)
   = getEqsVariant(EqS) 
  [owise] .
  eq getEqsVariant((ceq Lhs = Rhs if Cond [AtS] .) EqS)
   = (ceq Lhs = Rhs if Cond [AtS] .) getEqsVariant(EqS) .

  *** onlyEqsNoBuiltInUnify *******************************
  op onlyEqsNoBuiltInUnify : Module -> Module .
  eq onlyEqsNoBuiltInUnify(
      fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   = fmod (addsufix '-OnlyEqsNoBuiltInUnify To Q:Qid) is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       getEqsNoBuiltInUnify(E:EquationSet)
     endfm .
  eq onlyEqsNoBuiltInUnify(
      mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm)
   = mod (addsufix '-OnlyEqsNoBuiltInUnify To Q:Qid) is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       getEqsNoBuiltInUnify(E:EquationSet)
       R:RuleSet
     endm .

  *** onlyEqsNoVariant *******************************
  op onlyEqsNoVariant : Module -> Module .
  eq onlyEqsNoVariant(
      fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   = fmod (addsufix '-OnlyEqsNoVariant To Q:Qid) is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       getEqsNoVariant(E:EquationSet)
     endfm .
  eq onlyEqsNoVariant(
      mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm)
   = mod (addsufix '-OnlyEqsNoVariant To Q:Qid) is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       getEqsNoVariant(E:EquationSet)
       R:RuleSet
     endm .

  *** getEqsBuiltInUnify *******************************
  op getEqsBuiltInUnify : Module -> EquationSet .
  eq getEqsBuiltInUnify(
      fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   = getEqsBuiltInUnify(E:EquationSet) .
  eq getEqsBuiltInUnify(
      mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm)
   = getEqsBuiltInUnify(E:EquationSet) .

  op getEqsBuiltInUnify : EquationSet -> EquationSet [memo] .
  eq getEqsBuiltInUnify(none) = none .
  eq getEqsBuiltInUnify((eq Lhs = Rhs [AtS metadata("builtin-unify")] .) EqS)
   = (eq Lhs = Rhs [AtS metadata("builtin-unify")] .) getEqsBuiltInUnify(EqS) .
  eq getEqsBuiltInUnify((eq Lhs = Rhs [AtS] .) EqS)
   = getEqsBuiltInUnify(EqS) 
  [owise] .
  eq getEqsBuiltInUnify((ceq Lhs = Rhs if Cond [AtS] .) EqS)
   = getEqsBuiltInUnify(EqS) .

  *** getEqsVariant *******************************
  op getEqsVariant : Module -> EquationSet .
  eq getEqsVariant(
      fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   = getEqsVariant(E:EquationSet) .
  eq getEqsVariant(
      mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm)
   = getEqsVariant(E:EquationSet) .

  op getEqsVariant : EquationSet -> EquationSet [memo] .
  eq getEqsVariant(none) = none .
  eq getEqsVariant((eq Lhs = Rhs [AtS metadata("variant")] .) EqS)
   = (eq Lhs = Rhs [AtS metadata("variant")] .) getEqsVariant(EqS) .
  eq getEqsVariant((eq Lhs = Rhs [AtS] .) EqS)
   = getEqsVariant(EqS) 
  [owise] .
  eq getEqsVariant((ceq Lhs = Rhs if Cond [AtS] .) EqS)
   = getEqsVariant(EqS) .

  *** onlyEqsBuiltInUnify *******************************
  op onlyEqsBuiltInUnify : Module -> Module .
  eq onlyEqsBuiltInUnify(
      fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   = fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       getEqsBuiltInUnify(E:EquationSet)
     endfm .
  eq onlyEqsBuiltInUnify(
      mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm)
   = mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       getEqsBuiltInUnify(E:EquationSet)
       R:RuleSet
     endm .

  *** onlyEqsVariant *******************************
  op onlyEqsVariant : Module -> Module .
  eq onlyEqsVariant(
      fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   = fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       getEqsVariant(E:EquationSet)
     endfm .
  eq onlyEqsVariant(
      mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm)
   = mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       getEqsVariant(E:EquationSet)
       R:RuleSet
     endm .

  *** rls2eqs *******************************
  op rls2eqs# : RuleSet -> EquationSet [memo] .
  eq rls2eqs#(none) = none .
  eq rls2eqs#((rl Lhs => Rhs [AtS] .) RlS)
   = (eq Lhs = Rhs [AtS] .) rls2eqs#(RlS) .
  eq rls2eqs#((crl Lhs => Rhs if Cond [AtS] .) RlS)
   = (ceq Lhs = Rhs if Cond [AtS] .) rls2eqs#(RlS) .

  op rls2eqs : SModule -> SModule .
  eq rls2eqs(
      mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm)
   = mod (addsufix '-RLS2EQS To Q:Qid) is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet rls2eqs#(R:RuleSet)
       none
     endm .

  *** flipRls *******************************
  op flipRls : RuleSet -> RuleSet [memo] .
  eq flipRls(none) = none .
  eq flipRls((rl Lhs => Rhs [AtS] .) RlS:RuleSet) 
   = if all Vars(Lhs) in Vars(Rhs)
     then (rl Rhs => Lhs [removeNonExec(AtS)] .) 
     else (rl Rhs => Lhs [nonexec removeNonExec(AtS)] .)
     fi 
     flipRls(RlS:RuleSet) .
  eq flipRls((crl Lhs => Rhs if Cond [AtS] .) RlS:RuleSet) 
   = if all Vars(Lhs) in Vars(Rhs)
     then (crl Rhs => Lhs if Cond [removeNonExec(AtS)] .)
     else (crl Rhs => Lhs if Cond [nonexec removeNonExec(AtS)] .)
     fi 
     flipRls(RlS:RuleSet) .

  op removeNonExec : AttrSet -> AttrSet .
  eq removeNonExec(nonexec AtS) = AtS .
  eq removeNonExec(AtS) = AtS [owise] .

  op flipRls : SModule -> SModule .
  eq flipRls(mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 
             O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)
   = mod (addsufix '-FLIPPEDRLS To Q:Qid)
     is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 
     O:OpDeclSet M:MembAxSet E:EquationSet flipRls(R:RuleSet) endm .

  *** addOp *******************************
  op addOps : OpDeclSet SModule -> SModule [memo] .
  eq addOps(OO:OpDeclSet,mod Q:Qid is IL:ImportList sorts S:SortSet . 
      S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)
   = mod (addsufix '-ADDEDOPS To Q:Qid)
     is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 
     override(O:OpDeclSet,OO:OpDeclSet) 
     M:MembAxSet E:EquationSet R:RuleSet endm .
  op addOps : OpDeclSet FModule -> FModule [memo] .
  eq addOps(OO:OpDeclSet,fmod Q:Qid is IL:ImportList sorts S:SortSet . 
      S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet endfm)
   = fmod (addsufix '-ADDEDOPS To Q:Qid)
     is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 
     override(O:OpDeclSet,OO:OpDeclSet) 
     M:MembAxSet E:EquationSet endfm .

  op override : OpDeclSet OpDeclSet -> OpDeclSet . 
  eq override(
      (op F : TPL -> TP [AtS] .)  O:OpDeclSet,
      (op F : TPL -> TP [AtS'] .) O':OpDeclSet)
   = override(O:OpDeclSet,(op F : TPL -> TP [AtS'] .) O':OpDeclSet) .
  eq override(O:OpDeclSet,O':OpDeclSet)
   = O:OpDeclSet O':OpDeclSet [owise] .

  *** addRules *******************************
  op addRules : RuleSet SModule -> SModule [memo] .
  eq addRules(RR:RuleSet,mod Q:Qid is IL:ImportList sorts S:SortSet . 
          S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)
   = mod (addsufix '-ADDEDRLS To Q:Qid)
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 
      O:OpDeclSet M:MembAxSet E:EquationSet (R:RuleSet RR:RuleSet) endm .

  *** addEqs *******************************
  op addEqs : EquationSet SModule -> SModule [memo] .
  op addEqs : EquationSet FModule -> FModule [memo] .
  eq addEqs(ES:EquationSet,mod Q:Qid is IL:ImportList sorts S:SortSet . 
          S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)
   = mod (addsufix '-ADDEDEQS To Q:Qid)
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 
      O:OpDeclSet M:MembAxSet (E:EquationSet ES:EquationSet) R:RuleSet endm .
  eq addEqs(ES:EquationSet,fmod Q:Qid is IL:ImportList sorts S:SortSet . 
          S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet endfm)
   = fmod (addsufix '-ADDEDEQS To Q:Qid)
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 
      O:OpDeclSet M:MembAxSet (E:EquationSet ES:EquationSet) endfm .

  *** addSorts *******************************
  op addSorts : SortSet SModule -> SModule [memo] .
  op addSorts : SortSet FModule -> FModule [memo] .
  eq addSorts(X:SortSet,
       mod Q:Qid is IL:ImportList sorts S:SortSet . 
       S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)
   = mod Q:Qid is IL:ImportList sorts (X:SortSet ; S:SortSet) . 
       S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm .
  eq addSorts(X:SortSet,
       fmod Q:Qid is IL:ImportList sorts S:SortSet . 
       S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet endfm)
   = fmod Q:Qid is IL:ImportList sorts (X:SortSet ; S:SortSet) . 
       S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet endfm .

  *** putFrozen *******************************
  op putFrozen : NatList Qid TypeList SModule -> SModule [memo] .
  eq putFrozen(NL,F,TPL,
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [frozen(NL') AtS] .) O:OpDeclSet)
      M:MembAxSet E:EquationSet R:RuleSet endm))
   = (mod (addsufix F To (addsufix '-FROZEN# To Q:Qid)) 
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [frozen(NL) AtS] .) O:OpDeclSet)
      M:MembAxSet E:EquationSet R:RuleSet endm) .
  eq putFrozen(NL,F,TPL,
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [AtS] .) O:OpDeclSet)
      M:MembAxSet E:EquationSet R:RuleSet endm))
   = (mod (addsufix F To (addsufix '-FROZEN# To Q:Qid)) 
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [frozen(NL) AtS] .) O:OpDeclSet)
      M:MembAxSet E:EquationSet R:RuleSet endm) [owise] .

  *** putStrat *******************************
  op putStrat : NatList Qid TypeList SModule -> SModule [memo] .
  eq putStrat(NL,F,TPL,
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [strat(NL') AtS] .) O:OpDeclSet)
      M:MembAxSet E:EquationSet R:RuleSet endm))
   = (mod (addsufix F To (addsufix '-STRAT#EQ# To Q:Qid)) 
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [strat(NL) AtS] .) O:OpDeclSet)
      M:MembAxSet E:EquationSet R:RuleSet endm) .
  eq putStrat(NL,F,TPL,
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [AtS] .) O:OpDeclSet)
      M:MembAxSet E:EquationSet R:RuleSet endm))
   = (mod (addsufix F To (addsufix '-STRAT#EQ# To Q:Qid)) 
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [strat(NL) AtS] .) O:OpDeclSet)
      M:MembAxSet E:EquationSet R:RuleSet endm) [owise] .

  op putStrat : NatList Qid TypeList FModule -> FModule [memo] .
  eq putStrat(NL,F,TPL,
     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [strat(NL') AtS] .) O:OpDeclSet)
      M:MembAxSet E:EquationSet endfm))
   = (fmod (addsufix F To (addsufix '-STRAT#EQ# To Q:Qid)) 
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [strat(NL) AtS] .) O:OpDeclSet)
      M:MembAxSet E:EquationSet endfm) .
  eq putStrat(NL,F,TPL,
     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [AtS] .) O:OpDeclSet)
      M:MembAxSet E:EquationSet endfm))
   = (fmod (addsufix F To (addsufix '-STRAT#EQ# To Q:Qid)) 
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [strat(NL) AtS] .) O:OpDeclSet)
      M:MembAxSet E:EquationSet endfm) [owise] .

  *** clearFrozen *******************************
  op clearFrozen : NatList Qid TypeList SModule -> SModule [memo] .
  eq clearFrozen(NL,F,TPL,
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [frozen(NL') AtS] .) O:OpDeclSet)
      M:MembAxSet E:EquationSet R:RuleSet endm))
   = (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [AtS] .) O:OpDeclSet)
      M:MembAxSet E:EquationSet R:RuleSet endm) .
  eq clearFrozen(NL,F,TPL,M)
   = M [owise] .

  *** clearEqsFrozen *******************************
  op clearEqsFrozen : SModule -> SModule [memo] .
  eq clearEqsFrozen(M)
   = clearEqsFrozen*(M) .

  op clearEqsFrozen* : SModule -> SModule .
  eq clearEqsFrozen*(
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [frozen(NL') AtS] .) O:OpDeclSet)
      M:MembAxSet 
      ((eq F[TL] = Rhs [AtS'] .) E:EquationSet) 
      R:RuleSet endm))
   = clearEqsFrozen*(
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      ((op F : TPL -> TP [AtS] .) O:OpDeclSet)
      M:MembAxSet 
      ((eq F[TL] = Rhs [AtS'] .) E:EquationSet) 
      R:RuleSet endm)) .
  eq clearEqsFrozen*(M)
   = M [owise] .

  *** clearAllFrozen *******************************
  op clearAllFrozen : SModule -> SModule [memo] .
  eq clearAllFrozen(
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet
      M:MembAxSet E:EquationSet R:RuleSet endm))
   = (mod (addsufix '-CLEARFROZEN To Q:Qid) 
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      clearAllFrozen(O:OpDeclSet)
      M:MembAxSet E:EquationSet R:RuleSet endm) .

  op clearAllFrozen : FModule -> FModule [memo] .
  eq clearAllFrozen(
     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet
      M:MembAxSet E:EquationSet endfm))
   = (fmod (addsufix '-CLEARFROZEN To Q:Qid) 
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      clearAllFrozen(O:OpDeclSet)
      M:MembAxSet E:EquationSet endfm) .

  op clearAllFrozen : OpDeclSet -> OpDeclSet .
  eq clearAllFrozen(none)
   = none .
  eq clearAllFrozen(
      (op F : TPL -> TP [frozen(NL) AtS] .) O:OpDeclSet)
   = (op F : TPL -> TP [AtS] .)
     clearAllFrozen(O:OpDeclSet) .
  eq clearAllFrozen(
      (op F : TPL -> TP [AtS] .) O:OpDeclSet)
   = (op F : TPL -> TP [AtS] .)
     clearAllFrozen(O:OpDeclSet) [owise] .

  *** anyNonExec *******************************
  op anyNonExec : SModule -> Bool [memo] .
  eq anyNonExec(
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
   = anyNonExec(E:EquationSet) or-else anyNonExec(R:RuleSet) .

  op anyNonExec : RuleSet -> Bool .
  eq anyNonExec(
      (rl Lhs => Rhs [nonexec AtS] .) R:RuleSet)
   = true .
  eq anyNonExec(
      (crl Lhs => Rhs if Cond [nonexec AtS] .) R:RuleSet)
   = true .
  eq anyNonExec(R:RuleSet)
   = false [owise] .

  op anyNonExec : EquationSet -> Bool .
  eq anyNonExec(
      (eq Lhs = Rhs [nonexec AtS] .) R:EquationSet)
   = true .
  eq anyNonExec(
      (ceq Lhs = Rhs if Cond [nonexec AtS] .) R:EquationSet)
   = true .
  eq anyNonExec(R:EquationSet)
   = false [owise] .

  *** clearNonExec *******************************
  op clearNonExecRls&Eqs : SModule -> SModule [memo] .
  eq clearNonExecRls&Eqs(M:SModule)
   = clearNonExecRls(clearNonExecEqs(M:SModule)) .

  op clearNonExecRls : SModule -> SModule [memo] .
  eq clearNonExecRls(
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
   = (mod (addsufix '-CLEARNONEXEC To Q:Qid) 
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet 
        E:EquationSet clearNonExec(R:RuleSet) endm) .

  op clearNonExecEqs : SModule -> SModule [memo] .
  eq clearNonExecEqs(
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
   = (mod (addsufix '-CLEARNONEXEC To Q:Qid) 
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet 
        clearNonExec(E:EquationSet) R:RuleSet endm) .

  op clearNonExecEqs : FModule -> FModule [memo] .
  eq clearNonExecEqs(
     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet endfm))
   = (fmod (addsufix '-CLEARNONEXEC To Q:Qid) 
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet 
        clearNonExec(E:EquationSet) endfm) .

  op clearNonExec : RuleSet -> RuleSet .
  eq clearNonExec((none).RuleSet)
   = (none).RuleSet .
  eq clearNonExec(
      (rl Lhs => Rhs [nonexec AtS] .) R:RuleSet)
   = (rl Lhs => Rhs [AtS] .)
     clearNonExec(R:RuleSet) .
  eq clearNonExec(
      (rl Lhs => Rhs [AtS] .) R:RuleSet)
   = (rl Lhs => Rhs [AtS] .)
     clearNonExec(R:RuleSet) [owise] .

  op clearNonExec : EquationSet -> EquationSet .
  eq clearNonExec((none).EquationSet)
   = (none).EquationSet .
  eq clearNonExec(
      (eq Lhs = Rhs [nonexec AtS] .) R:EquationSet)
   = (eq Lhs = Rhs [AtS] .)
     clearNonExec(R:EquationSet) .
  eq clearNonExec(
      (eq Lhs = Rhs [AtS] .) R:EquationSet)
   = (eq Lhs = Rhs [AtS] .)
     clearNonExec(R:EquationSet) [owise] .

  *** eraseRls *******************************
  op eraseRls : Module -> Module [memo] .
  eq eraseRls(
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
   = (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet none endm) .
  eq eraseRls(
     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet endfm))
   = (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet endfm) .
      
  *** eraseEqs *******************************
  op eraseEqs : Module -> Module [memo] .
  eq eraseEqs(
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
   = (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet none R:RuleSet endm) .
  eq eraseEqs(
     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet endfm))
   = (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet none endfm) .

  *** flatten  ******************************
  op flatten : Module TermList -> TermList .
  eq flatten(M,V) = V .
  eq flatten(M,C) = C .
  eq flatten(M,F[TL:NeTermList]) 
   = if isAssociative(M,F,getTypes(M,TL:NeTermList))
     then F[aliens(TL:NeTermList,F)]
     else F[flatten(M,TL:NeTermList)]
     fi .
  eq flatten(M,(T:Term,TL:NeTermList)) 
   = (flatten(M,T:Term),flatten(M,TL:NeTermList)) .

  op aliens : TermList Qid -> TermList .
  eq aliens(empty,F) = empty .
  eq aliens((F[TL':NeTermList],TL:TermList),F) 
   = aliens((TL':NeTermList,TL:TermList),F) .
  eq aliens((T:Term,TL:TermList),F) 
   = (T:Term,aliens(TL:TermList,F)) [owise] .

  *** unflatten  ******************************
  op unflatten : Module TermList -> TermList .
  eq unflatten(M,T) = unflatten*(M,T) .

  op unflatten* : Module TermList -> TermList .
  eq unflatten*(M,V) = V .
  eq unflatten*(M,C) = C .
  eq unflatten*(M,F[TL:NeTermList]) 
   = if isAssociative(M,F,getTypes(M,TL:NeTermList))
     then unflatten**(M,F,TL:NeTermList)
     else F[unflatten*(M,TL:NeTermList)]
     fi .
  eq unflatten*(M,(T:Term,TL:NeTermList)) 
   = (unflatten*(M,T:Term),unflatten*(M,TL:NeTermList)) .

  op unflatten** : Module Qid TermList -> TermList .
  eq unflatten**(M,F,(T1:Term,TL:NeTermList))
   = F[unflatten*(M,T1:Term),unflatten**(M,F,TL:NeTermList)] .
  eq unflatten**(M,F,T:Term)
   = unflatten*(M,T:Term) .

  *** wrapRules_bySymbol_ *******************************
  op wrapRules_bySymbol_ : SModule Qid -> SModule [memo] .
  eq wrapRules
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet
      M:MembAxSet E:EquationSet R:RuleSet endm)
     bySymbol F:Qid
   = (mod (addsufix F:Qid To (addsufix '-WRAPPED# To Q:Qid))
       is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet
      M:MembAxSet E:EquationSet 
      wrapRules R:RuleSet bySymbol F:Qid endm) .

  op wrapRules_bySymbol_ : RuleSet Qid -> RuleSet .
  eq wrapRules none bySymbol F:Qid = none .
  eq wrapRules ((rl Lhs => Rhs [AtS] .) RlS:RuleSet) bySymbol F:Qid
   = (rl F:Qid[Lhs] => F:Qid[Rhs] [AtS] .) 
     wrapRules RlS:RuleSet bySymbol F:Qid .
  eq wrapRules ((crl Lhs => Rhs if Cond [AtS] .) RlS:RuleSet) bySymbol F:Qid
   = (crl F:Qid[Lhs] => F:Qid[Rhs] if Cond [AtS] .) 
     wrapRules RlS:RuleSet bySymbol F:Qid .

  op toSModule : FModule -> SModule .
  eq toSModule(
      fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   =  mod (addsufix '-CONVERTED#SMODULE To Q:Qid) is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       none
      endm .

  op newName : Qid SModule -> SModule .
  op newName : Qid FModule -> FModule .
  eq newName(F:Qid,
      fmod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   = fmod F:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm .
  eq newName(F:Qid,
      mod Q:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm)
   = mod F:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
       R:RuleSet
      endm .

  ***
  op removeBoolEqs : Module -> Module [memo] .
  eq removeBoolEqs(
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
   = (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet 
      removeBoolEqs(E:EquationSet) 
      R:RuleSet endm) .
  eq removeBoolEqs(
     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet endfm))
   = (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet 
      removeBoolEqs(E:EquationSet) endfm) .

  op removeBoolEqs : EquationSet -> EquationSet .
  eq removeBoolEqs((eq '_and_[TL] = Rhs [AtS] .) EqS)
   = removeBoolEqs(EqS) .
  eq removeBoolEqs((eq 'not_[TL] = Rhs [AtS] .) EqS)
   = removeBoolEqs(EqS) .
  eq removeBoolEqs((eq '_or_[TL] = Rhs [AtS] .) EqS)
   = removeBoolEqs(EqS) .
  eq removeBoolEqs((eq '_xor_[TL] = Rhs [AtS] .) EqS)
   = removeBoolEqs(EqS) .
  eq removeBoolEqs((eq '_implies_[TL] = Rhs [AtS] .) EqS)
   = removeBoolEqs(EqS) .
  eq removeBoolEqs(EqS) 
   = EqS [owise] .

  *******************************************
  op keepOnlyACAttr : Module -> Module [memo] .
  eq keepOnlyACAttr(
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
   = (mod (addsufix '-REMOVED-ID-SYMBOLS To Q:Qid)
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      keepOnlyACAttr*(O:OpDeclSet) 
      M:MembAxSet E:EquationSet R:RuleSet endm) .
  eq keepOnlyACAttr(
     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet endfm))
   = (fmod (addsufix '-REMOVED-ID-SYMBOLS To Q:Qid)
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      keepOnlyACAttr*(O:OpDeclSet) 
      M:MembAxSet E:EquationSet endfm) .

  op keepOnlyACAttr* : OpDeclSet -> OpDeclSet .
  eq keepOnlyACAttr*((op F : TPL -> TP [id(T) AtS] .) OPDS)
   = keepOnlyACAttr*((op F : TPL -> TP [AtS] .) OPDS) .
  eq keepOnlyACAttr*((op F : TPL -> TP [left-id(T) AtS] .) OPDS)
   = keepOnlyACAttr*((op F : TPL -> TP [AtS] .) OPDS) .
  eq keepOnlyACAttr*((op F : TPL -> TP [right-id(T) AtS] .) OPDS)
   = keepOnlyACAttr*((op F : TPL -> TP [AtS] .) OPDS) .
  eq keepOnlyACAttr*(OPDS) 
   = removeAssocAttr(OPDS) [owise] .

  op _in#_ : Attr AttrSet -> Bool .
  eq X:Attr in# X:Attr X:AttrSet = true .
  eq X:Attr in# X:AttrSet = false [owise] .

  op removeAssocAttr : OpDeclSet -> OpDeclSet .
  eq removeAssocAttr((op F : TPL -> TP [assoc AtS] .) OPDS)
   = if comm in# AtS
     then (op F : TPL -> TP [assoc AtS] .) removeAssocAttr(OPDS)
     else removeAssocAttr((op F : TPL -> TP [AtS] .) OPDS)
     fi .
  eq removeAssocAttr(OPDS) 
   = OPDS [owise] .

  *******************************************
  op keepOnlyACUAttr : Module -> Module [memo] .
  eq keepOnlyACUAttr(
     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
   = (mod (addsufix '-REMOVED-ID-SYMBOLS To Q:Qid)
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      keepOnlyACUAttr*(O:OpDeclSet) 
      M:MembAxSet E:EquationSet R:RuleSet endm) .
  eq keepOnlyACUAttr(
     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      O:OpDeclSet M:MembAxSet E:EquationSet endfm))
   = (fmod (addsufix '-REMOVED-ID-SYMBOLS To Q:Qid)
      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
      keepOnlyACUAttr*(O:OpDeclSet) 
      M:MembAxSet E:EquationSet endfm) .

  op keepOnlyACUAttr* : OpDeclSet -> OpDeclSet .
  eq keepOnlyACUAttr*(OPDS) 
   = removeAssocAttr(OPDS) .

endfm

fmod META-MINIMIZE-BINDINGS is
  pr SUBSTITUTION-HANDLING .
  pr MODULE-HANDLING .
  pr SUBSTITUTIONSET .
  pr UNIFICATIONTRIPLESET .
  pr CONVERSION .
  pr META-LEVEL .

  vars M : Module .
  vars T T' T1 T2 T3 : Term .
  vars TL TL' TL1 TL2 TL3 : TermList .
  vars F F' : Qid .
  vars S S' S* S'* : Substitution .
  vars V V' V1 V2 : Variable .
  vars N N' NOld : Nat .
  var US? : [UnificationTripleSet] .
  vars US US' : UnificationTripleSet .

  --- minimizeBindings ---
  op minimizeBindingsTerm : Module TermList UnificationTripleSet
                         -> UnificationTripleSet .
  eq minimizeBindingsTerm(M,TL,US)
   = minimizeBindingsTerm(M,TL,highestVar(TL),US) .

  op minimizeBindingsTerm : Module TermList Nat UnificationTripleSet
                         -> UnificationTripleSet .
  eq minimizeBindingsTerm(M,TL,NOld,US) 
   = minimizeBindingsTerm*(M,TL,NOld,US,empty) .

  op minimizeBindingsTerm* : Module TermList Nat UnificationTripleSet
                             UnificationTripleSet -> UnificationTripleSet .
  eq minimizeBindingsTerm*(M,TL,NOld,empty,US') 
   = US' .
  eq minimizeBindingsTerm*(M,TL,NOld,{S,S',N} | US,US') 
   = minimizeBindingsTerm*(M,TL,NOld,US,
        US' | minimizeBindingsTerm**(M,TL,NOld,{S,S',N},S,S') 
     ) .

  ****************
  op minimizeBindingsTerm** : Module TermList ---variables to minimize bindings
                             Nat --- or maximum index of variables 
                             UnificationTriple Substitution Substitution
                          -> UnificationTriple .
  eq minimizeBindingsTerm**(M,TL',NOld,{S*,S'*,N},none,none) 
   = {remDup(S*),remDup(S'*),N} .

 ceq minimizeBindingsTerm**(M,TL',NOld,{S*,V <- V' ; S'*,N},none,V <- V' ; S')
   = minimizeBindingsTerm**(M,TL',NOld,
         {  S* << (V' <- V),    S'* .. (V' <- V),  N},
         none,
         S' .. (V' <- V)
     ) 
  if V' =/= V and-then not (V in TL') and-then not (V' in TL')
     and-then highestVar(V) < NOld
     and-then highestVar(V') >= NOld
     and-then typeLeq(M,getTypes(M,V),getTypes(M,V')) .

  eq minimizeBindingsTerm**(M,TL',NOld,{S*,V <- T' ; S'*,N},none,V <- T' ; S')
   = minimizeBindingsTerm**(M,TL',NOld,{S*,V <- T' ; S'*,N},none,S')
  [owise] .

 ceq minimizeBindingsTerm**(M,TL',NOld,{V <- V' ; S*,S'*,N},V <- V' ; S,S') 
   = minimizeBindingsTerm**(M,TL',NOld,
         { S* << (V' <- V),   S'* .. (V' <- V),   N},
         S << (V' <- V),    
         S' .. (V' <- V)
     )
  if V' =/= V and-then V in TL' and-then not (V' in TL')
     and-then typeLeq(M,getTypes(M,V),getTypes(M,V')) . 

  eq minimizeBindingsTerm**(M,TL',NOld,{V <- T' ; S*,S'*,N},V <- T' ; S,S') 
   = minimizeBindingsTerm**(M,TL',NOld,{V <- T' ; S*,S'*,N},S,S')
  [owise] .

  op remDup : Substitution -> Substitution .
  eq remDup(V <- V ; S) = remDup(S) .
  eq remDup(S) = S [owise] .

endfm
fmod TYPEOFNARROWING is
  pr QID .

  --- TypeOfNarrowing ----------------------------------
  sorts TypeOfNarrowingElem TypeOfNarrowing .
  subsort TypeOfNarrowingElem < TypeOfNarrowing .
  op none : -> TypeOfNarrowing [ctor] .
  op __ : TypeOfNarrowing TypeOfNarrowing -> TypeOfNarrowing 
          [ctor assoc comm id: none] .
  ---eq X:TypeOfNarrowingElem X:TypeOfNarrowingElem = X:TypeOfNarrowingElem .
  
  *** select one and only one of the following
  op full : -> TypeOfNarrowingElem [ctor] .
  op basic : -> TypeOfNarrowingElem [ctor] .
  op variant : -> TypeOfNarrowingElem [ctor] . 
  op variant : Nat -> TypeOfNarrowingElem [ctor] . 
  op E-rewriting : -> TypeOfNarrowingElem [ctor] .

  *** Extra flags
  op rigidife : Qid -> TypeOfNarrowingElem [ctor] .

  *** select one and only one of the following
  op E-ACU-unify : -> TypeOfNarrowingElem [ctor] .
  op E-ACU-unify-Irr : -> TypeOfNarrowingElem [ctor] .
  op ACU-unify : -> TypeOfNarrowingElem [ctor] .
  op BuiltIn-unify : -> TypeOfNarrowingElem [ctor] .
  op E-BuiltIn-unify : -> TypeOfNarrowingElem [ctor] .
  op E-BuiltIn-unify-Irr : -> TypeOfNarrowingElem [ctor] .

  *** select one and only one of the following
  op noStrategy : -> TypeOfNarrowingElem [ctor] .
  op topmost : -> TypeOfNarrowingElem [ctor] .
  op innermost : -> TypeOfNarrowingElem [ctor] .
  op outermost : -> TypeOfNarrowingElem [ctor] .

  *** select any combination of the following
  op E-normalize-terms : -> TypeOfNarrowingElem [ctor] .
  op normalize-terms : -> TypeOfNarrowingElem [ctor] .
  op computed-normalized-subs : -> TypeOfNarrowingElem [ctor] .
  op applied-normalized-subs : -> TypeOfNarrowingElem [ctor] .
  op minimal-unifiers : -> TypeOfNarrowingElem [ctor] .
  op testUnifier : -> TypeOfNarrowingElem [ctor] .
  op alsoAtVarPosition : -> TypeOfNarrowingElem [ctor] .

  op _in_ : TypeOfNarrowingElem TypeOfNarrowing -> Bool .
  eq X:TypeOfNarrowingElem in X:TypeOfNarrowingElem XS:TypeOfNarrowing
   = true .
  eq variant in variant(N:Nat) XS:TypeOfNarrowing
   = true .
  eq X:TypeOfNarrowingElem in XS:TypeOfNarrowing
   = false [owise] .

  op _!in_ : TypeOfNarrowingElem TypeOfNarrowing -> Bool .
  eq X:TypeOfNarrowingElem !in XS:TypeOfNarrowing
   = not (X:TypeOfNarrowingElem in XS:TypeOfNarrowing) .
  -------------------------------------------------------

  sort TypeOfRelation .
  ops '* '! '+ : -> TypeOfRelation .

  op [_] : TypeOfRelation -> Qid .
  eq [ '+ ] = qid("+") .
  eq [ '* ] = qid("*") .
  eq [ '! ] = qid("!") .

  op typeOfRelation : Qid ~> TypeOfRelation .
  eq typeOfRelation( '+ ) = '+ .
  eq typeOfRelation( '* ) = '* .
  eq typeOfRelation( '! ) = '! .
endfm

fmod IRR-FLAGS is
  sort IrrFlags .
  op __ : IrrFlags IrrFlags -> IrrFlags [assoc comm id: none] .
  op none : -> IrrFlags [ctor] .
  op irreducible : -> IrrFlags [ctor] .
  op reducible : -> IrrFlags [ctor] .
  op minimal-unifiers : -> IrrFlags [ctor] .
endfm

fmod EFLAGS is
  pr TYPEOFNARROWING .
  pr IRR-FLAGS .

  sort EFlags .
  subsort IrrFlags < EFlags .
  op __ : EFlags EFlags -> EFlags [assoc comm id: none] .
  op none : -> EFlags [ctor] .
  op ACUUnify : -> EFlags [ctor] .
  op BuiltInUnify : -> EFlags [ctor] .
  op testUnifier : -> EFlags [ctor] .

  op _in_ : EFlags EFlags -> Bool .
  eq X:EFlags in X:EFlags Y:EFlags = true .
  eq X:EFlags in Y:EFlags = false [owise] .

  op _!in_ : EFlags EFlags -> Bool .
  eq X:EFlags !in Y:EFlags = not (X:EFlags in Y:EFlags) .

  op [_] : EFlags -> TypeOfNarrowing .
  eq [ ACUUnify X:EFlags ] = ACU-unify [ X:EFlags ] .
  eq [ BuiltInUnify X:EFlags ] = BuiltIn-unify [ X:EFlags ] .
  eq [ minimal-unifiers X:EFlags ] = minimal-unifiers [ X:EFlags ] .
  eq [ testUnifier X:EFlags ] = testUnifier [ X:EFlags ] .
  eq [ X:EFlags ] = none [owise] .
endfm

fmod RESULT-CONTEXT-SET is
  protecting META-TERM .
  protecting META-LEVEL .
  protecting TERM-HANDLING .
  protecting SUBSTITUTION-HANDLING .
  protecting RENAMING .
  protecting SUBSTITUTIONSET .
  protecting UNIFICATIONTRIPLESET .

  vars T T' TS CtTS : Term .
  var TP : Type .
  vars S S' Subst Subst' : Substitution .
  var NL : NatList .
  var M : Module .
  vars Ct CtS : Context .
  vars RTS RTS' : ResultContextSet .
  vars NextVar N : Nat .
  var TL : TermList .

  op subTerm_of_ : NatList ResultTriple ~> ResultTriple .
  eq subTerm NL of {T,TP,S} = {subTerm NL of T,TP,S} .

  op replaceSubTerm_of_by_ : NatList ResultTriple Term ~> ResultTriple .
  eq replaceSubTerm NL of {T,TP,S} by T' = {replaceSubTerm NL of T by T',TP,S} .

  --- ResultTriple ---------------------------
  --- op {_,_,_} : Term Type Substitution -> ResultTriple [ctor] .

  sort ResultTripleSet .
  subsort ResultTriple < ResultTripleSet .
  op empty : -> ResultTripleSet [ctor] .
  op _|_ : ResultTripleSet ResultTripleSet -> ResultTripleSet
    [ctor assoc comm id: empty prec 65 format (d d n d)] .
  eq X:ResultTriple | X:ResultTriple = X:ResultTriple .

  var RT : ResultTripleSet .

  op _|>_ : ResultTripleSet TermList -> ResultTripleSet .
  eq (empty).ResultTripleSet |> TL = (empty).ResultTripleSet .
  eq ({T,TP,S} | RT) |> TL = {T,TP,S |> TL} | (RT |> TL) .
  eq (failure | RT ) |> TL = failure | (RT |> TL) .

  op getTerms : ResultTripleSet -> TermSet .
  eq getTerms({T:Term,TP:Type,S:Substitution} | R:ResultTripleSet)
   = T:Term | getTerms(R:ResultTripleSet) .
  eq getTerms((empty).ResultTripleSet)
   = emptyTermSet .

  op getSubstitutions : ResultTripleSet -> SubstitutionSet .
  eq getSubstitutions({T,TP,S} | R:ResultTripleSet) 
   = S | getSubstitutions(R:ResultTripleSet) .
  eq getSubstitutions((empty).ResultTripleSet)
   = (empty).SubstitutionSet .

  --- ResultContextSet ---------------------------

  --- Flags
  sort Flags Flag .
  subsort Flag < Flags .
  
  op empty : -> Flags [ctor] .
  op __ : Flags Flags -> Flags [ctor assoc comm id: empty] .
  eq X:Flag X:Flag = X:Flag .

  --- Flag to know whether term is a end point or not
  op end : Bool -> Flag [ctor frozen] .
  
  op end : Bool Flags -> Flags .
  eq end(B:Bool, end(B':Bool) B:Flags) = end(B:Bool) B:Flags .
  eq end(B:Bool, B:Flags) = end(B:Bool) B:Flags [owise] .
  
  op end : Flags -> Bool .
  eq end(end(B:Bool) B:Flags) = B:Bool .
  eq end(B:Flags) = false [owise] .
  ---
  
  sorts TraceNarrowStep TraceNarrow TraceNarrowSet .
  subsort TraceNarrowStep < TraceNarrow < TraceNarrowSet .
  op {_,_,_,_} : Term Substitution Type Rule -> TraceNarrowStep [ctor format (d d d d d n d n d d)] .
  op nil : -> TraceNarrow [ctor] .
  op __ : TraceNarrow TraceNarrow -> TraceNarrow [ctor assoc id: nil format (d n d)] .
  op empty : -> TraceNarrowSet [ctor] .
  op _|_ : TraceNarrowSet TraceNarrowSet -> TraceNarrowSet [ctor assoc comm id: empty format (d n n d)] .

  ---
  sorts ResultContext ResultContextSet ResultContextNeSet .
  op {_,_,_,_,_,_,_,_,_,_,_} : 
      Term Type 
      Substitution Substitution --- computed subs and applied subst
      Context Context --- Original and WithSubst
      Term Term --- TermWithSubst and ContextWithTermAndSubt
      Nat --- highest index of variable
      TraceNarrow
      Flags 
      -> ResultContext [ctor] .
		       
  subsort ResultContext < ResultContextNeSet < ResultContextSet .
  op empty : -> ResultContextSet [ctor] .
  op _|_ : ResultContextSet ResultContextSet -> ResultContextSet
    [ctor assoc comm id: empty prec 65 format (d n d d)] .
  op _|_ : ResultContextNeSet ResultContextSet -> ResultContextNeSet
    [ctor ditto] .
  eq X:ResultContext | X:ResultContext = X:ResultContext .

  op getCTTerm : ResultContext -> Term .
  eq getCTTerm(
      {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags})
   = CtTS:Term .
  op getNextVar : ResultContext -> Nat .
  eq getNextVar(
      {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags})
   = NextVar .
  op getLSubst : ResultContext -> Substitution .
  eq getLSubst(
      {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags})
   = S .
  op getRSubst : ResultContext -> Substitution .
  eq getRSubst(
      {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags})
   = S' .
		       
  op _<<_ : ResultContext UnificationTripleSet -> ResultContextSet .
  eq {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 
     << (empty).UnificationTripleSet
   = (empty).ResultContextSet .
  eq {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 
     << ({Subst,Subst',N} | SS:UnificationTripleSet)
   = {T,
      TP,
      (S .. Subst) << Subst', (S' .. Subst') << Subst,
      Ct:Context,
      CtS:Context << (Subst ; Subst'),
      TS:Term << (Subst ; Subst'),
      CtTS:Term << (Subst ; Subst'),
      max(NextVar,N + 1),
      (Tr:TraceNarrow << T TP <) << {Subst,Subst',N},
      B:Flags}
     | {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 
         << SS:UnificationTripleSet .

  op _<<__< : TraceNarrow Term Type -> TraceNarrow .
  eq (nil).TraceNarrow << T:Term TP:Type <
   = (nil).TraceNarrow .
  eq (Tr:TraceNarrow {T$:Term,none,TP$:Type,R:Rule}) --- Subst none here is special 
     << T:Term TP:Type <
   = (Tr:TraceNarrow {T:Term,none,TP:Type,R:Rule}) .
  eq (Tr:TraceNarrow {T$:Term,S:Substitution,TP$:Type,R:Rule})
     << T:Term TP:Type <
   = (Tr:TraceNarrow {T$:Term,S:Substitution,TP$:Type,R:Rule}) [owise] .

  op _<<_ : TraceNarrow UnificationTriple -> TraceNarrow .
  eq (nil).TraceNarrow << {Subst,Subst',N}
   = (nil).TraceNarrow .
  eq (Tr:TraceNarrow {T$:Term,none,TP$:Type,R:Rule}) --- Subst none here is special 
     << {Subst,Subst',N}
   = (Tr:TraceNarrow {T$:Term << (Subst ; Subst'),Subst ; Subst',TP$:Type,R:Rule}) .
  eq (Tr:TraceNarrow {T$:Term,S:Substitution,TP$:Type,R:Rule})
     << {Subst,Subst',N}
   = (Tr:TraceNarrow {T$:Term,S:Substitution,TP$:Type,R:Rule}) [owise] .

  op toTriple : Module ResultContextSet -> ResultTripleSet .
  eq toTriple(M, empty ) = empty .
  eq toTriple(M, {T,TP,S,S',Ct,CtS,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} | RTS )
   = {CtTS:Term, leastSort(M,CtTS:Term), S .. S'}
     | toTriple(M,RTS) .

  op _|>_ : ResultContextSet TermList -> ResultContextSet .
  eq (empty).ResultContextSet |> TL = (empty).ResultContextSet .
  eq ({T,TP,S,S',Ct,CtS,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 
      | RTS:ResultContextSet) |> TL 
   = {T,TP,S |> TL,S' |> TL,Ct,CtS,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags}
     | (RTS:ResultContextSet |> TL) .

  op getTerms : ResultContextSet -> TermSet .
  eq getTerms({T,TP,S,S',Ct,CtS,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} | RTS)
   = CtTS:Term | getTerms(RTS) .
  eq getTerms((empty).ResultContextSet)
   = emptyTermSet .

  op toUnificationTriples : ResultContextSet -> UnificationTripleSet .
  eq toUnificationTriples(
      {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} | R:ResultContextSet)
   = {S,S',NextVar} 
     | toUnificationTriples(R:ResultContextSet) .
  eq toUnificationTriples((empty).ResultContextSet)
   = (empty).UnificationTripleSet .

  *** auxiliary Sort SubstitutionCond for metaNarrowSearch *****
  sort SubstitutionCond .
  subsort Substitution < SubstitutionCond .

  op |_| : ResultTripleSet -> Nat .
  eq | (empty).ResultTripleSet | = 0 .
  eq | (RT:ResultTriple | RTS:ResultTripleSet) | 
   = | RTS:ResultTripleSet | + 1 .
  
  op |_| : ResultContextSet -> Nat .
  eq | (empty).ResultContextSet | = 0 .
  eq | (RT:ResultContext | RTS:ResultContextSet) | 
   = | RTS:ResultContextSet | + 1 .

endfm

fmod META-MATCH is
  protecting TERM-HANDLING .
  protecting MODULE-HANDLING .
  protecting SUBSTITUTION-HANDLING .
  protecting META-LEVEL .
  protecting RENAMING .
  protecting SUBSTITUTIONSET .

  vars T T' : Term .
  vars TL TL' : TermList .
  var M : Module .
  vars S S' : Substitution .
  var S? : Substitution? .
  vars SS SS' : SubstitutionSet .
  vars V V' : Variable .
  vars TPL TPL' : TypeList .
  vars N N' : Nat .

  --- Not defined in this module ----------------------------------------
  op isNF$ : Module Term ~> Bool .
  --- Not defined in this module ----------------------------------------

  --- metaCoreMatch(M,T,T') implies that T is an instance of T'
  op metaCoreMatch : Module Term Term -> SubstitutionSet .
  eq metaCoreMatch(M,T,T')
   = metaCoreMatch$(M,canonice(M,T),canonice(M,T')) .

  op metaCoreMatch$ : Module Term Term -> SubstitutionSet .
  eq metaCoreMatch$(M,T,T')
   = if glbSorts(M,leastSort(M,T),leastSort(M,T')) == none
     then empty
     else metaCoreMatchCollect(eraseEqs(eraseRls(M)),T,T')
     fi .
   
  op metaCoreMatch? : Module Term Term -> Bool .
  eq metaCoreMatch?(M,T,T')
   = metaCoreMatch?$(M,canonice(M,T),canonice(M,T')) .

  op metaCoreMatch?$ : Module Term Term -> Bool .
  eq metaCoreMatch?$(M,T,T')
   = glbSorts(M,leastSort(M,T),leastSort(M,T')) =/= none
     and-then 
     metaMatch(eraseEqs(eraseRls(M)),T',T,nil,0) =/= noMatch .

  --- metaCoreMatchCollect(M,T,T') calls Maude metaMatch
  op metaCoreMatchCollect : Module Term Term -> SubstitutionSet . 
  eq metaCoreMatchCollect(M,T,T')
   = metaCoreMatchCollect*(M,T,T',empty,0) .

  op metaCoreMatchCollect* : Module Term Term SubstitutionSet Nat 
                             -> SubstitutionSet .
  eq metaCoreMatchCollect*(M,T,T',SS,N:Nat)
   = if metaMatch(M,T',T,nil,N:Nat) =/= noMatch
     then metaCoreMatchCollect*(M,T,T',
                            SS | metaMatch(M,T',T,nil,N:Nat),
                            s(N:Nat))
     else SS
     fi .

  op metaBuiltInEqual : Module TermList Term Term -> Bool .
  eq metaBuiltInEqual(M,TL,T,T')
   = canonice(M,T) == canonice(M,T') .

endfm
fmod VARIANT is
  pr SUBSTITUTION-HANDLING .
  pr META-MINIMIZE-BINDINGS .
  pr RESULT-CONTEXT-SET .
  pr MODULE-HANDLING .
  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 .
  var R RT : ResultContext .
  vars RTS RTS' : ResultContextSet .
  vars TP TP' : Type .
  vars Ct Ct' CtS CtS' : Context .
  var C : Constant .
  vars F F' : Qid .

  --- Variants ----------------------------------------------------------
  sort VariantTriple .
  op {_,_,_} : Term Substitution Nat -> VariantTriple [ctor] .

  sort VariantTripleSet .
  subsort VariantTriple < VariantTripleSet .
  op empty : -> VariantTripleSet [ctor] .
  op _|_ : VariantTripleSet VariantTripleSet -> VariantTripleSet
    [ctor assoc comm id: empty prec 65 format (d d n d)] .
  eq X:VariantTriple | X:VariantTriple = X:VariantTriple .

  op getTerms : VariantTripleSet -> TermSet .
  eq getTerms({T:Term,S:Substitution,NextVar:Nat} 
              | R:VariantTripleSet)
   = T:Term | getTerms(R:VariantTripleSet) .
  eq getTerms((empty).VariantTripleSet)
   = emptyTermSet .

  --- Variants ----------------------------------------------------------
  sort VariantFour .
  op {_,_,_,_} : Term Substitution Substitution Nat -> VariantFour [ctor] .

  sort VariantFourSet .
  subsort VariantFour < VariantFourSet .
  op empty : -> VariantFourSet [ctor] .
  op _|_ : VariantFourSet VariantFourSet -> VariantFourSet
    [ctor assoc comm id: empty prec 65 format (d d n d)] .
  eq X:VariantFour | X:VariantFour = X:VariantFour .
  var VT : VariantFour .
  vars VTS VTS' : VariantFourSet .

  op toVariants : Nat ResultContextSet -> VariantFourSet .
  eq toVariants(OldNextVar:Nat,empty) 
   = empty .
  eq toVariants(OldNextVar:Nat,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} | RTS)
   = {CtTS,S |> OldNextVar:Nat,S' |> OldNextVar:Nat,NextVar} 
      | toVariants(OldNextVar:Nat,RTS) .

  op _|>_ : VariantFourSet TermList -> VariantFourSet .
  eq (empty).VariantFourSet |> TL = empty .
  eq ({T,S,S',N} | VTS) |> TL = {T,(S |> TL),(S' |> TL),N} | (VTS |> TL) .

  op getTerms : VariantFourSet -> TermSet .
  eq getTerms({T:Term,S:Substitution,S':Substitution,NextVar:Nat} 
              | R:VariantFourSet)
   = T:Term | getTerms(R:VariantFourSet) .
  eq getTerms((empty).VariantFourSet)
   = emptyTermSet .

  op toVariantTripleSet : VariantFourSet -> VariantTripleSet .
  eq toVariantTripleSet(empty) 
   = empty .
  eq toVariantTripleSet({T,S,S',NextVar} | VTS)
---    = {T,S ; S',NextVar} | toVariantTripleSet(VTS) .
   = {T,S,NextVar} | toVariantTripleSet(VTS) .

endfm

fmod RIGIDIFE is
  protecting UNIFICATIONTRIPLESET .
  protecting MODULE-HANDLING .
  protecting RESULT-CONTEXT-SET .
  protecting VARIANT .

  vars V V' : Variable .
  var C : Constant .
  vars F Q : Qid .
  vars U U' : UnificationTriple .
  vars US US' : UnificationTripleSet .
  vars S S' S1 S1' S2 S2' : Substitution .
  var SS : SubstitutionSet .
  var SSe : NeSubstitutionSet .
  vars N N' N1 N2 NextVar : Nat .
  vars T T' : Term .
  vars TL TL' : TermList .
  var NeTL : NeTermList .
  var M : Module .
  var RTS : ResultTripleSet .
  var TP : Type .

  sort PairRigidife .
  op {_,_} : Module TermList -> PairRigidife .
  op getM : PairRigidife -> Module .
  eq getM({M,TL}) = M .
  op getTL : PairRigidife -> TermList .
  eq getTL({M,TL}) = TL .

  *** Transform variables in TermList into constants
  op rigidifeList : Module Qid TermList TermList -> PairRigidife .
  eq rigidifeList(M,Q,TL,empty)
   = {M,TL} .
  eq rigidifeList(M,Q,(T,NeTL),TL)
   = { getM(rigidifeList(getM(rigidifeList(M,Q,T,TL)),Q,NeTL,TL)),
       (getTL(rigidifeList(M,Q,T,TL)),
        getTL(rigidifeList(getM(rigidifeList(M,Q,T,TL)),Q,NeTL,TL))) } . 
  eq rigidifeList(M,Q,C,TL) 
   = {M,C} .
  eq rigidifeList(M,Q,F[NeTL],TL) 
   = {getM(rigidifeList(M,Q,NeTL,TL)),
      F[getTL(rigidifeList(M,Q,NeTL,TL))]} .
  eq rigidifeList(M,Q,V,TL) 
   = if V in TL then rigidifeVar***(M,Q,V) else {M,V} fi .

  *** Transform all variables into constants
  op rigidifeAllVar : Module Qid TermList -> PairRigidife .
  eq rigidifeAllVar(M,Q,TL)
   = rigidifeNat(M,Q,TL,0) .

  *** Transform variables above Nat into constants
  op rigidifeNat : Module Qid TermList Nat -> PairRigidife .
  eq rigidifeNat(M,Q,(T,NeTL),N)
   = { getM(rigidifeNat(getM(rigidifeNat(M,Q,T,N)),Q,NeTL,N)),
       (getTL(rigidifeNat(M,Q,T,N)),
        getTL(rigidifeNat(getM(rigidifeNat(M,Q,T,N)),Q,NeTL,N))) } . 
  eq rigidifeNat(M,Q,C,N) 
   = {M,C} .
  eq rigidifeNat(M,Q,F[NeTL],N) 
   = {getM(rigidifeNat(M,Q,NeTL,N)),
      F[getTL(rigidifeNat(M,Q,NeTL,N))]} .
  eq rigidifeNat(M,Q,V,N) 
   = if highestVar(V) >= N then rigidifeVar***(M,Q,V) else {M,V} fi .

  *** Transform variables with rigid# into constants
  op rigidifeRigid : Module Qid TermList -> PairRigidife .
  eq rigidifeRigid(M,Q,(T,NeTL))
   = { getM(rigidifeRigid(getM(rigidifeRigid(M,Q,T)),Q,NeTL)),
       (getTL(rigidifeRigid(M,Q,T)),
        getTL(rigidifeRigid(getM(rigidifeRigid(M,Q,T)),Q,NeTL))) } . 
  eq rigidifeRigid(M,Q,C) 
   = {M,C} .
  eq rigidifeRigid(M,Q,F[NeTL]) 
   = {getM(rigidifeRigid(M,Q,NeTL)),
      F[getTL(rigidifeRigid(M,Q,NeTL))]} .
  eq rigidifeRigid(M,Q,V) 
   = if rfind(string(V), "rigid#", length(string(V))) =/= notFound
     then rigidifeVar***(M,Q,V) 
     else {M,V} 
     fi .

  *** Basic case for transforming variables into constants
  op rigidifeVar*** : Module Qid Variable -> PairRigidife .
  ceq rigidifeVar***(M,Q,V) 
    = {addOps((op qid(F:String) : nil -> getType(V) [none].), M),
       qid(F:String + "." + string(getType(V)))} 
   if F:String := "rigid@" + string(Q) 
                     + "@" + string(getName(V)) + "@" + string(getType(V)) . 

  *** Undo the transformation of variables into constants
  op unrigidife : Qid TermList -> TermList .
  eq unrigidife(Q,(T,NeTL))
   = (unrigidife(Q,T),unrigidife(Q,NeTL)) .
  eq unrigidife(Q,V) = V . 
  eq unrigidife(Q,F[TL]) = F[unrigidife(Q,TL)] .
  eq unrigidife(Q,C) 
   = if rfind(string(C), "rigid@" + string(Q) + "@", length(string(C))) 
          =/= notFound
     then qid(
           string(
             qid(
              substr(string(C),
               rfind(string(C), "rigid@" + string(Q) + "@", length(string(C)))
                + 7 + length(string(Q)),
               rfind( 
                substr(string(C),
                  rfind(string(C), "rigid@" + string(Q) + "@", length(string(C)))
                   + 7 + length(string(Q)),
                  length(string(C))),
                "@",length(string(C))
               )
              )
             )
           )
           + ":" + 
           string(getType(qid(
                   substr(string(C),
                   rfind(string(C), "rigid@" + string(Q) + "@", 
                           length(string(C))) + 7 + length(string(Q)),
                   length(string(C)))
           )))
          )
     else C
     fi .

  op unrigidife : Qid Substitution -> Substitution .
  eq unrigidife(Q,(none).Substitution) = none .
  eq unrigidife(Q,V <- T ; S) 
   = unrigidife(Q,V) <- unrigidife(Q,T) ; unrigidife(Q,S) .

  op unrigidife : Qid SubstitutionSet -> SubstitutionSet .
  eq unrigidife(Q,(empty).SubstitutionSet) = empty .
  eq unrigidife(Q,S | SSe) 
   = unrigidife(Q,S) | unrigidife(Q,SSe) .

  op unrigidife : Qid UnificationTripleSet -> UnificationTripleSet .
  eq unrigidife(Q,(empty).UnificationTripleSet) = empty .
  eq unrigidife(Q,{S1,S2,N'} | US) 
   = {unrigidife(Q,S1),unrigidife(Q,S2),N'}
     | unrigidife(Q,US) .

  op unrigidife : Qid ResultTripleSet -> ResultTripleSet .
  eq unrigidife(Q,(empty).ResultTripleSet) = empty .
  eq unrigidife(Q,{T,TP,S} | RTS)
   = {unrigidife(Q,T),TP,unrigidife(Q,S)} 
     | unrigidife(Q,RTS) .

  op unrigidife : Qid VariantFourSet -> VariantFourSet  .
  eq unrigidife(Q,(empty).VariantFourSet) = empty .
  eq unrigidife(Q,{T,S,S',N} | R:VariantFourSet)
   = {unrigidife(Q,T),unrigidife(Q,S),unrigidife(Q,S'),N} 
     | unrigidife(Q,R:VariantFourSet) .

  *** Label variables with rigid
  op rigidLabel : Module TermList TermList -> TermList .
  eq rigidLabel(M,TL,empty) 
   = TL .
  eq rigidLabel(M,(T,NeTL),TL)
   = rigidLabel(M,T,TL), rigidLabel(M,NeTL,TL) .
  eq rigidLabel(M,C,TL) 
   = C .
  eq rigidLabel(M,F[NeTL],TL) 
   = F[rigidLabel(M,NeTL,TL)] .
  eq rigidLabel(M,V,TL) 
   = if V in TL then rigidLabel***(M,V) else V fi .

  op rigidLabel*** : Module Variable -> Variable .
  eq rigidLabel***(M,V) 
   = qid("rigid#" + string(getName(V)) + ":" + string(getType(V))) .

  *** Undo the transformation of variables into constants
  op unrigidLabel : TermList -> TermList .
  eq unrigidLabel((T,NeTL))
   = (unrigidLabel(T),unrigidLabel(NeTL)) .
  eq unrigidLabel(C) = C . 
  eq unrigidLabel(F[TL]) = F[unrigidLabel(TL)] .
  eq unrigidLabel(V) 
   = if rfind(string(V), "rigid#", length(string(V))) 
          =/= notFound
     then qid(
          string(getName(qid(
                   substr(string(V),
                   rfind(string(V), "rigid#", 
                           length(string(V))) + 6,
                   length(string(V)))
          )))
          + ":" + 
          string(getType(qid(
                   substr(string(V),
                   rfind(string(V), "rigid#", 
                           length(string(V))) + 6,
                   length(string(V)))
          )))
          )
     else V
     fi .

  op unrigidLabel : Substitution -> Substitution .
  eq unrigidLabel((none).Substitution) = none .
  eq unrigidLabel(V <- T ; S) 
   = unrigidLabel(V) <- unrigidLabel(T) ; unrigidLabel(S) .

  op unrigidLabel : SubstitutionSet -> SubstitutionSet .
  eq unrigidLabel((empty).SubstitutionSet) = empty .
  eq unrigidLabel(S | SSe) 
   = unrigidLabel(S) | unrigidLabel(SSe) .

  op unrigidLabel : UnificationTripleSet -> UnificationTripleSet .
  eq unrigidLabel((empty).UnificationTripleSet) = empty .
  eq unrigidLabel({S1,S2,N'} | US) 
   = {unrigidLabel(S1),unrigidLabel(S2),N'}
     | unrigidLabel(US) .

  op unrigidLabel : ResultTripleSet -> ResultTripleSet .
  eq unrigidLabel((empty).ResultTripleSet) = empty .
  eq unrigidLabel({T,TP,S} | RTS)
   = {unrigidLabel(T),TP,unrigidLabel(S)} 
     | unrigidLabel(RTS) .

  op unrigidLabel : VariantFourSet -> VariantFourSet  .
  eq unrigidLabel((empty).VariantFourSet) = empty .
  eq unrigidLabel({T,S,S',N} | R:VariantFourSet)
   = {unrigidLabel(T),unrigidLabel(S),unrigidLabel(S'),N} 
     | unrigidLabel(R:VariantFourSet) .

  op qid : Nat -> Qid .
  eq qid(N:Nat) = qid(string(N:Nat,10)) .

endfm

fmod META-E-BASIC-UNIFICATION is
  pr TYPEOFNARROWING .
  pr EFLAGS .
  pr RESULT-CONTEXT-SET .
  pr SUBSTITUTION-HANDLING .
  pr META-MINIMIZE-BINDINGS .
  pr RESULT-CONTEXT-SET .
  pr MODULE-HANDLING .
  pr META-LEVEL .
  pr RIGIDIFE .

  *** Repeated definitions to avoid cross calls between modules ************
  op metaNarrowSearchGenAll : Module Term Term SubstitutionCond 
                              TypeOfRelation Bound Bound Bound TypeOfNarrowing Nat
                           -> ResultContextSet .
  op metaACUUnify : Module Term Term Nat -> UnificationTripleSet .
  *** Repeated definitions to avoid cross calls between modules ************

  var M : Module .
  var M' : [Module] .
  vars T T' : Term .
  vars NextVar N : Nat .
  var EF : EFlags .
  var F : Qid .

  --- metaEUnify-Basic --------------------------------------------------
  op metaEUnify-Basic : Module Term Term Nat EFlags 
                           --- Term Lhs
                     -> UnificationTripleSet .
  eq metaEUnify-Basic(M,T,T',NextVar,EF)
   = if getEqsVariant(M) == none
     then metaACUUnify(M,T,T',NextVar) 
     else metaEUnify-Basic*(M,T,T',NextVar,EF)
     fi .

  op metaEUnify-Basic* : Module Term Term Nat EFlags 
                           --- Term Lhs
                      -> UnificationTripleSet .
  eq metaEUnify-Basic*(M,T,T',NextVar,EF)
   = metaEUnify-Basic**(M,
       normalize(clearAllFrozen(M),T),
       normalize(clearAllFrozen(M),T'),
       NextVar,EF
     ) .

  op metaEUnify-Basic** : Module Term Term Nat EFlags 
                           --- Term Lhs
                      -> UnificationTripleSet .
  eq metaEUnify-Basic**(M,T,T',NextVar,EF)
    = if sameKind(M,leastSort(M,T),leastSort(M,T'))
      then minimizeBindingsTerm(M,Vars(T),NextVar + 1,
            toUnificationTriples(
             metaNarrowSearchGenAll(
               add=E=(new=E=(NextVar),
                      eqsVariant2rls(clearAllFrozen(M)),
                      maximalSorts(M,getKind(M,leastSort(M,T)))),
               new=E=(NextVar)[T',T],
               'true.Bool,
               none,
               '!,
               unbounded,
               unbounded,
               unbounded,
               basic noStrategy [EF] rigidifeAllEqSymbols(getEqs(M)),
               NextVar + 1 
             ) |> (T,T')
            )
           )
      else (empty).UnificationTripleSet
      fi .

  op new=E= : Nat -> Qid .
  eq new=E=(N)
   = qid("_=E" + string(N,10) + "=_") .

  op add=E= : Qid Module SortSet -> Module .
  eq add=E=(F,M,none)
   = M .
  eq add=E=(F,M,S:Sort ; SS:SortSet)
   = add=E=(F,
            addRules(
            (rl F[(addType S:Sort ToVar 'X),(addType S:Sort ToVar 'X)]
             => 'true.Bool [none] .),
             addOps(op F : S:Sort S:Sort -> 'Bool [frozen(2)] .,
             M)),
            SS:SortSet) .

  op rigidifeAllEqSymbols : EquationSet -> TypeOfNarrowing .
  eq rigidifeAllEqSymbols(none) 
   = none . 
  eq rigidifeAllEqSymbols((eq F:Qid[TL:TermList] = Rhs:Term [AtS:AttrSet] .) EqS:EquationSet) 
   = rigidife(F:Qid) rigidifeAllEqSymbols(EqS:EquationSet) . 
endfm

fmod META-E-UNIFICATION is
  pr TYPEOFNARROWING .
  pr EFLAGS .
  pr RESULT-CONTEXT-SET .
  pr SUBSTITUTION-HANDLING .
  pr META-MINIMIZE-BINDINGS .
  pr RESULT-CONTEXT-SET .
  pr MODULE-HANDLING .
  pr META-LEVEL .
  pr META-E-BASIC-UNIFICATION .
  pr VARIANT .

  *** Repeated definitions to avoid cross calls between modules ************
  op normalizedSubstitution? : Module SubstitutionSet -> Bool .
  op metaACUUnify : Module Term Term Nat -> UnificationTripleSet .
  op metaACUUnify? : Module Term Term Nat -> Bool .
  op metaACUUnify* : Module UnificandPair Nat Nat ~> UnificationTriple? .
  op metaCoreUnify : Module Term Term Nat -> UnificationTripleSet .
  op metaCoreUnify? : Module Term Term Nat -> Bool .
  op metaBuiltInUnify : Module Term Term Nat -> UnificationTripleSet .
  op metaBuiltInUnify? : Module Term Term Nat -> Bool .
  op _<=[_]_ : SubstitutionSet Module SubstitutionSet -> Bool .
  op _<=[_]_ : Term Module Term -> Bool .
  *** Repeated definitions to avoid cross calls between modules ************

  var M : Module .
  vars T T' TS TS' CtTS CtTS' Lhs Rhs : Term .
  vars N N' NextVar NextVar' NextVar'' NextVar1 NextVar2 NextVar3 : Nat .
  var B : Bound .
  var TL TL' : TermList .
  var NeTL : NeTermList .
  var EqS : EquationSet .
  var AtS : AttrSet .
  var ON : TypeOfNarrowing .
  var Q : Qid .
  vars US US' US$ : UnificationTripleSet .
  vars U U' : UnificationTriple .
  vars S S' S* S'* S1 S1' S2 S2' S3 S3' : Substitution .
  var V : Variable .
  var R RT : ResultContext .
  vars RTS RTS' : ResultContextSet .
  vars TP TP' : Type .
  vars Ct Ct' CtS CtS' : Context .
  var C : Constant .
  vars F F' : Qid .
  var EF : EFlags .
  vars VT VT' : VariantFour .
  vars VTS VTS' VTS$ : VariantFourSet .
  var IRR : IrrFlags .

  --- metaECoreUnify --------------------------------------------------
  op metaECoreUnify : Module Term Term -> SubstitutionSet .
                     --- Term Lhs
  eq metaECoreUnify(M, T, T')
   = metaEACUUnify(M, T, T') .

  op metaECoreUnify? : Module Term Term -> Bool .
  eq metaECoreUnify?(M, T, T')
   = metaEACUUnify?(M, T, T') .

  --- metaVariantUnify --------------------------------------------------
  op metaVariantUnify : Module Term Term -> SubstitutionSet .
  eq metaVariantUnify(M, T, T') = metaEACUUnify(M, T, T') .

  op metaVariantUnify? : Module Term Term -> Bool .
  eq metaVariantUnify?(M, T, T') = metaEACUUnify?(M, T, T') .

  op metaVariantUnify : Module Term Term Nat IrrFlags -> UnificationTripleSet .
  eq metaVariantUnify(M, T, T',NextVar,IRR) = metaEACUUnify(M, T, T',NextVar,IRR) .

  op metaVariantUnify? : Module Term Term Nat IrrFlags -> Bool .
  eq metaVariantUnify?(M, T, T',NextVar,IRR) = metaEACUUnify?(M, T, T',NextVar,IRR) .

  --- metaEACUUnify --------------------------------------------------
  op metaEACUUnify : Module Term Term -> SubstitutionSet .
  eq metaEACUUnify(M, T, T')
   = toSubstitution(metaEACUUnify(M,T,T',highestVar((T,T')) + 1,reducible)) .

  op metaEACUUnify? : Module Term Term -> Bool .
  eq metaEACUUnify?(M, T, T')
   = metaEACUUnify?(M,T,T',highestVar((T,T')) + 1,reducible) .

  op metaEACUUnifyIrr : Module Term Term -> SubstitutionSet .
                          --- T irreducible T' reducible
  eq metaEACUUnifyIrr(M, T, T')
   = toSubstitution(metaEACUUnify(M,T,T',highestVar((T,T')) + 1,irreducible)) .

  op metaEACUUnifyIrr? : Module Term Term -> Bool .
  eq metaEACUUnifyIrr?(M, T, T')
   = metaEACUUnify?(M,T,T',highestVar((T,T')) + 1,irreducible) .

  op metaEACUUnify : Module Term Term Nat IrrFlags -> UnificationTripleSet .
  eq metaEACUUnify(M, T, T',NextVar,IRR) 
   = minimizeBindingsTerm(M,Vars(T),NextVar,
          metaEUnify&(M, T, T',NextVar,ACUUnify IRR)
     ) |> (T,T') .

  op metaEACUUnify? : Module Term Term Nat IrrFlags -> Bool .
  eq metaEACUUnify?(M, T, T',NextVar,IRR) 
   = metaEUnify&?(M, T, T',NextVar,ACUUnify IRR) .

  --- metaEBuiltInUnify --------------------------------------------------
  op metaEBuiltInUnify : Module Term Term -> SubstitutionSet .
  eq metaEBuiltInUnify(M, T, T')
   = toSubstitution(
       metaEBuiltInUnify(M,T,T',highestVar((T,T')) + 1,reducible)
     ) .

  op metaEBuiltInUnify? : Module Term Term -> Bool .
  eq metaEBuiltInUnify?(M, T, T')
   = metaEBuiltInUnify?(M,T,T',highestVar((T,T')) + 1,reducible) .

  op metaEBuiltInUnifyIrr : Module Term Term -> SubstitutionSet .
                          --- T irreducible T' reducible
  eq metaEBuiltInUnifyIrr(M, T, T')
   = toSubstitution(
       metaEBuiltInUnify(M,T,T',highestVar((T,T')) + 1,irreducible)
     ) .

  op metaEBuiltInUnifyIrr? : Module Term Term -> Bool .
                          --- T irreducible T' reducible
  eq metaEBuiltInUnifyIrr?(M, T, T')
   = metaEBuiltInUnify?(M,T,T',highestVar((T,T')) + 1,irreducible) .

  op metaEBuiltInUnify : Module Term Term Nat IrrFlags 
                 -> UnificationTripleSet . 
  eq metaEBuiltInUnify(M, T, T',NextVar,IRR) 
   = minimizeBindingsTerm(M,Vars(T),NextVar,
        metaEUnify&(M, T, T',NextVar,BuiltInUnify IRR)
     ) |> (T,T') .

  op metaEBuiltInUnify? : Module Term Term Nat IrrFlags -> Bool .
  eq metaEBuiltInUnify?(M, T, T',NextVar,IRR) 
   = metaEUnify&?(M, T, T',NextVar,BuiltInUnify IRR) .

  --- metaEUnify --------------------------------------------------
  op metaEUnify& : Module Term Term Nat EFlags -> UnificationTripleSet . 
                      --- Term Lhs
  eq metaEUnify&(M,T,T',NextVar,EF)
   = if sameKind(M,leastSort(M,T),leastSort(M,T'))
     then metaEUnify&*(removeBoolEqs(M),T,T',NextVar,EF)
     else empty
     fi .

  op metaEUnify&? : Module Term Term Nat EFlags -> Bool . 
                      --- Term Lhs
  eq metaEUnify&?(M,T,T',NextVar,EF)
   = sameKind(M,leastSort(M,T),leastSort(M,T'))
     and-then
     metaEUnify&*?(removeBoolEqs(M),T,T',NextVar,EF) .

  op metaEUnify&* : Module Term Term Nat EFlags -> UnificationTripleSet .
                      --- Term Lhs
  eq metaEUnify&*(M,T,T',NextVar,EF)
   = if metaBuiltInUnify?(M,
          fst(generalize(onlyEqsVariant(M),NextVar,T)),
          fst(generalize(onlyEqsVariant(M),
                         snd(generalize(onlyEqsVariant(M),NextVar,T)),T')),
          snd(generalize(onlyEqsVariant(M),
                         snd(generalize(onlyEqsVariant(M),NextVar,T)),T'))
        )
     then if T == fst(generalize(onlyEqsVariant(M),NextVar,T))
             and
             T' == fst(
                    generalize(onlyEqsVariant(M),
                               snd(generalize(onlyEqsVariant(M),NextVar,T)),T'))
          then --- no narrowing is necessary to unify
               metaBuiltInUnify(M,T,T',NextVar)
          else metaEUnify$(M,T,T',NextVar,EF)
          fi
     else empty
     fi .

  op metaEUnify&*? : Module Term Term Nat EFlags -> Bool .
                      --- Term Lhs
  eq metaEUnify&*?(M,T,T',NextVar,EF)
   = if metaBuiltInUnify?(M,
          fst(generalize(onlyEqsVariant(M),NextVar,T)),
          fst(generalize(onlyEqsVariant(M),
                         snd(generalize(onlyEqsVariant(M),NextVar,T)),T')),
          snd(generalize(onlyEqsVariant(M),
                         snd(generalize(onlyEqsVariant(M),NextVar,T)),T'))
        )
     then if T == fst(generalize(onlyEqsVariant(M),NextVar,T))
             and
             T' == fst(
                    generalize(onlyEqsVariant(M),
                               snd(generalize(onlyEqsVariant(M),NextVar,T)),T'))
          then --- no narrowing is necessary to unify
               metaBuiltInUnify?(M,T,T',NextVar)
          else metaEUnify$?(M,T,T',NextVar,EF)
          fi
     else false
     fi .

  op metaEUnify$ : Module Term Term Nat EFlags -> UnificationTripleSet .
                      --- Term Lhs

  eq metaEUnify$(M,T,T',NextVar,EF)
   = if true ---howManyBuiltIn(M,(T,T')) > 0
     then metaEUnify-Variant(M,EF,NextVar,
            getVariantsTerm(M,T,NextVar,EF),
            getVariants(M,T',maxNextVar(getVariantsTerm(M,T,NextVar,EF)),EF)
          ) 
     else metaEUnify-Basic(M,T,T',NextVar,EF)
     fi .

  op metaEUnify$? : Module Term Term Nat EFlags -> Bool .
  eq metaEUnify$?(M,T,T',NextVar,EF)
   = if true ---howManyBuiltIn(M,(T,T')) > 0
     then metaEUnify-Variant(M,testUnifier EF,NextVar,
            getVariantsTerm(M,T,NextVar,testUnifier EF),
            getVariants(M,T',
              maxNextVar(getVariantsTerm(M,T,NextVar,testUnifier EF)),
              testUnifier EF
            )
          ) 
     else metaEUnify-Basic(M,T,T',NextVar,EF) 
     fi =/= empty .

  op getVariantsTerm : Module Term Nat EFlags -> VariantFourSet .
  eq getVariantsTerm(M,T,NextVar,EF)
   = if irreducible in EF
     then {T,none,none,NextVar}
     else getVariants(M,T,NextVar,EF) 
     fi .

  op metaEUnify-Variant : Module EFlags Nat VariantFourSet VariantFourSet
                       -> UnificationTripleSet .
  eq metaEUnify-Variant(M,EF,N,VTS,VTS')
   = filter-variant-UP(EF,eqsVariant2rls(clearAllFrozen(M)),N,
       filter-NF(eqsVariant2rls(clearAllFrozen(M)),
          metaEUnify-Variant*(M,EF,N,empty,VTS,VTS') 
       ) 
     ) 
     .

  op metaEUnify-Variant* : Module EFlags Nat UnificationTripleSet 
                           VariantFourSet VariantFourSet
                        -> UnificationTripleSet .
  eq metaEUnify-Variant*(M,EF,N, US, empty, VTS')
   = US .
  eq metaEUnify-Variant*(M,EF,N, US, VT | VTS, VTS')
   = if metaEUnify-Variant**(M,EF,N, empty, VT, VTS') == empty
     then *** Continue
          metaEUnify-Variant*(M,EF,N, US, VTS, VTS')
     else if testUnifier in EF
          then *** Stop and don't compute more
               US | metaEUnify-Variant**(M,EF,N, empty, VT, VTS')
          else *** Compute more
               metaEUnify-Variant*(M,EF,N, 
                 US | metaEUnify-Variant**(M,EF,N, empty, VT, VTS'), 
                 VTS, VTS')
          fi
     fi .

  op metaEUnify-Variant** : Module EFlags Nat UnificationTripleSet 
                            VariantFour VariantFourSet
                         -> UnificationTripleSet .
  eq metaEUnify-Variant**(M,EF,N,US,VT,empty)
   = US .
  eq metaEUnify-Variant**(M,EF,N,US,VT,VT' | VTS') 
   = metaEUnify-Variant**(M,EF,N,
       US | metaEUnify-Variant***(M,EF,N,VT,VT'),
       VT, VTS'
     ) .

  op metaEUnify-Variant*** : Module EFlags Nat VariantFour VariantFour
                          -> UnificationTripleSet .
  eq metaEUnify-Variant***(M,EF,N,
         {T,S,S*,NextVar},
         {T',S',S'*,NextVar'}
     ) 
   = metaEUnify-Variant****(M,EF,N,
         {T,S,S*,NextVar},
         {T',S',S'*,NextVar'},
         empty,
         metaEUV***(EF,M,T,T',max(NextVar,NextVar'))
     ) .

  op metaEUV*** : EFlags Module Term Term Nat -> UnificationTripleSet .
  eq metaEUV***(EF,M,T,T',NextVar)
   = if ACUUnify in EF
     then metaACUUnify(M,T,T',NextVar) 
     else metaBuiltInUnify(M,T,T',NextVar)
     fi .

  op metaEUnify-Variant**** : Module EFlags Nat VariantFour VariantFour
                              UnificationTripleSet
                              UnificationTripleSet
                           -> UnificationTripleSet .
  eq metaEUnify-Variant****(M,EF,N,
         {T,S,S*,NextVar},
         {T',S',S'*,NextVar'},
         US',
         empty
     ) 
   = US' .
  eq metaEUnify-Variant****(M,EF,N,
         {T,S,S*,NextVar},
         {T',S',S'*,NextVar'},
         US',
         {S1,S1',NextVar1} | US  --- S1 and S1' come from unify(T,T')
     )
   = metaEUnify-Variant****(M,EF,N,
         {T,S,S*,NextVar},
         {T',S',S'*,NextVar'},
         US' |
         if valid-occur-check?(S .. S1)
            and
            valid-occur-check?(S' .. S1')
         then
         metaEUnify-Variant*****(M,EF,N,
             {T,S,S*,NextVar},
             {T',S',S'*,NextVar'},
             {S1,S1',NextVar1},
             metaEUV****(EF,M,(S .. S1) << S1',(S' .. S1') << S1,NextVar1)
         )
         else empty
         fi,
         US
     ) .

  op metaEUV**** : EFlags Module Substitution Substitution Nat 
                -> UnificationTripleSet .
  eq metaEUV****(EF,M,V <- T ; S,V <- T' ; S',NextVar)
   = if metaEUV***(EF,M,T,T',NextVar) ::  UnificationTripleSet
        and 
        metaEUV***(EF,M,T,T',NextVar) =/= empty
     then canonice(M,
          {V <- T,V <- T',NextVar}
          ...
          metaEUV****$(EF,M,S,S',empty,metaEUV***(EF,M,T,T',NextVar))
          )
     else empty
     fi .
  eq metaEUV****(EF,M,S,S',NextVar)
   = {S,S',NextVar} [owise] .

  op metaEUV****$ : EFlags Module Substitution Substitution  
                   UnificationTripleSet UnificationTripleSet
                -> UnificationTripleSet .
  eq metaEUV****$(EF,M,S,S',US',empty)
   = US' .
  eq metaEUV****$(EF,M,S,S',US',{S1,S1',NextVar1} | US)
   = metaEUV****$(EF,M,S,S',
       US' | metaEUV****(EF,M,S .. S1,S' .. S1',NextVar1),
       US
     ) .

  op metaEUnify-Variant***** : Module EFlags Nat VariantFour VariantFour
                               UnificationTriple UnificationTripleSet
                            -> UnificationTripleSet .
  eq metaEUnify-Variant*****(M,EF,N,
         {T,S,S*,NextVar},
         {T',S',S'*,NextVar'},
         {S1,S1',NextVar1},
         empty
     )
   = empty .
  eq metaEUnify-Variant*****(M,EF,N,
         {T,S,S*,NextVar},
         {T',S',S'*,NextVar'},
         {S1,S1',NextVar1}, --- S1 and S1' come from unify(T,T')
         {S2,S2',NextVar2} | US --- S2 is S .. S1 updated 
                                --- S2' is S' .. S1' updated
     )
   = metaEUnify-Variant*****$(M,EF,N,
         {T,S,S*,NextVar},
         {T',S',S'*,NextVar'},
         {S1,S1',NextVar1},
         {S2,S2',NextVar2}
     )
     |
     metaEUnify-Variant*****(M,EF,N,
         {T,S,S*,NextVar},
         {T',S',S'*,NextVar'},
         {S1,S1',NextVar1},
         US
     ) .
         
  op metaEUnify-Variant*****$ : Module EFlags Nat VariantFour VariantFour
                                UnificationTriple UnificationTriple
                             -> UnificationTripleSet .
  eq metaEUnify-Variant*****$(M,EF,N,
         {T,S,S*,NextVar},
         {T',S',S'*,NextVar'},
         {S1,S1',NextVar1}, --- S1 and S1' come from unify(T,T')
         {S2,S2',NextVar2} --- S2 is S updated & S2' is S' updated
     )
   = {S2,S2',NextVar2} .

  **************************************
  ***** Variant Generation

  op getVariants : Module Term -> VariantFourSet .
  eq getVariants(M,T) = getVariants(M,T,highestVar(T) + 1,reducible BuiltInUnify) .

  op getVariants : Module Term Nat EFlags -> VariantFourSet .
  eq getVariants(M,T,NextVar,EF)
   = unrigidife(qid(NextVar),
      getVariants*(
          getM(rigidifeRigid(M,qid(NextVar),T)),
          getTL(rigidifeRigid(M,qid(NextVar),T)),
          NextVar + 1,EF
      )
     ) .

  op getVariants* : Module Term Nat EFlags -> VariantFourSet .
  eq getVariants*(M,T,NextVar,EF)
   = if howMany(onlyEqsVariant(M),T) == 0 
     then {T,none,none,NextVar}
     else if getVariants**(M,T,NextVar,EF) :: VariantFourSet
             and
             getVariants**(M,T,NextVar,EF) =/= empty
          then getVariants**(M,T,NextVar,EF)
          else {T,none,none,NextVar}
          fi
     fi .

  op getVariants** : Module Term Nat EFlags -> VariantFourSet [memo] .
  eq getVariants**(M,T,NextVar,EF)
   = filter-variant-VT(EF, ---minimal-unifiers EF,
        eqsVariant2rls(clearAllFrozen(removeBoolEqs(M))),
        NextVar,
        toVariants(NextVar,
          metaNarrowSearchGenAll(
           eqsVariant2rls(clearAllFrozen(removeBoolEqs(M))),
           T,newVar(NextVar,leastSort(M,T)),
           none,'*,unbounded,unbounded,unbounded,
           variant(NextVar + 1) noStrategy [EF], ---do not use innermost!!!
           NextVar + 1) 
        )
     ) .


  *** Identify bound for terms
  sort PairGeneralize .
  op {_,_} : TermList Nat -> PairGeneralize .
  op fst : PairGeneralize -> TermList .
  eq fst({X:TermList,Y:Nat}) = X:TermList .
  op snd : PairGeneralize -> Nat .
  eq snd({X:TermList,Y:Nat}) = Y:Nat .

  op generalize : Module Nat NeTermList -> PairGeneralize . 
  eq generalize(M,NextVar,NeTL)
   = generalize*(M,NextVar,getEqs(M),NeTL) .

  op generalize* : Module Nat EquationSet TermList -> PairGeneralize .
  eq generalize*(M,NextVar,EqS,empty)
   = {empty,NextVar} .
  eq generalize*(M,NextVar,EqS,(T,TL))
   = {(fst(generalize**(M,NextVar,EqS,T)), 
       fst(generalize*(M,snd(generalize**(M,NextVar,EqS,T)),EqS,TL))),
      snd(generalize*(M,snd(generalize**(M,NextVar,EqS,T)),EqS,TL))
     } .

  op generalize** : Module Nat EquationSet Term -> PairGeneralize .
  eq generalize**(M,NextVar,EqS,C)
   = {C,NextVar} .
  eq generalize**(M,NextVar,EqS,V)
   = {V,NextVar} .
  ceq generalize**(M,NextVar,(eq F'[TL'] = Rhs [AtS] .) EqS,F[TL])
    = {newVar(NextVar,getKind(M,leastSort(M,F[TL]))),NextVar + 1}
   if F == F' 
      and-then 
      glbSorts(M,leastSort(M,TL),leastSort(M,TL')) =/= none .
  eq generalize**(M,NextVar,EqS,F[TL])
   = {F[fst(generalize*(M,NextVar,EqS,TL))],
      snd(generalize*(M,NextVar,EqS,TL))} 
  [owise] .

  *** Identify bound for terms
  op howMany : Module NeTermList -> Nat .
  eq howMany(M,NeTL)
   = howMany*(M,getEqs(M),NeTL << 0 < ) .

  op howMany* : Module EquationSet TermList -> Nat .
  eq howMany*(M,EqS,empty)
   = 0 .
  eq howMany*(M,EqS,(T,TL))
   = howMany**(M,EqS,T) + howMany*(M,EqS,TL) .

  op howMany** : Module EquationSet Term -> Nat .
  eq howMany**(M,EqS,C)
   = 0 .
  eq howMany**(M,EqS,V)
   = 0 .
  ceq howMany**(M,(eq F'[TL'] = Rhs [AtS] .) EqS,F[TL])
    = 1 + howMany*(M,(eq F'[TL'] = Rhs [AtS] .) EqS,TL) 
   if F == F' 
      and-then 
      glbSorts(M,leastSort(M,TL),leastSort(M,TL')) =/= none
      and-then not isAssociative(M,F,getTypes(M,TL)) .
  ceq howMany**(M,(eq F'[TL'] = Rhs [AtS] .) EqS,F[TL])
    = sd(length(TL),1) + howMany*(M,(eq F'[TL'] = Rhs [AtS] .) EqS,TL) 
   if F == F' 
      and-then 
      glbSorts(M,leastSort(M,TL),leastSort(M,TL')) =/= none
      and-then isCommutative(M,F,getTypes(M,TL)) 
      and-then isAssociative(M,F,getTypes(M,TL)) .
  eq howMany**(M,EqS,F[TL])
   = howMany*(M,EqS,TL) [owise] .


  *** Identify whether basic or variant narrowing should be used
  op howManyAC : Module NeTermList -> Nat .
  eq howManyAC(M,NeTL)
   = if howManyAC$(M,getEqs(M)) == 0 
     then 0
     else howManyAC*(M,getEqs(M),NeTL << 0 < ) 
     fi .

  op howManyAC* : Module EquationSet TermList -> Nat .
  eq howManyAC*(M,EqS,empty)
   = 0 .
  eq howManyAC*(M,EqS,(T,TL))
   = howManyAC**(M,EqS,T) + howManyAC*(M,EqS,TL) .

  op howManyAC** : Module EquationSet Term -> Nat .
  eq howManyAC**(M,EqS,C)
   = 0 .
  eq howManyAC**(M,EqS,V)
   = 0 .
  ceq howManyAC**(M,(eq F'[TL'] = Rhs [AtS] .) EqS,F[TL])
    = sd(length(TL),1) + howManyAC*(M,(eq F'[TL'] = Rhs [AtS] .) EqS,TL) 
   if F == F' 
      and-then 
      glbSorts(M,leastSort(M,TL),leastSort(M,TL')) =/= none
      and-then isCommutative(M,F,getTypes(M,TL)) 
      and-then isAssociative(M,F,getTypes(M,TL)) .
  eq howManyAC**(M,EqS,F[TL])
   = howManyAC*(M,EqS,TL) [owise] .

  op length : TermList -> Nat .
  eq length((empty).TermList) = 0 .
  eq length((T:Term,TL:TermList)) = 1 + length(TL:TermList) .

  op howManyAC$ : Module EquationSet -> Nat [memo] .
  eq howManyAC$(M,EqS)
   = howManyAC$$(M,EqS) .

  op howManyAC$$ : Module EquationSet -> Nat .
  eq howManyAC$$(M,none)
   = 0 .
  eq howManyAC$$(M,(eq F[TL] = Rhs [AtS] .) EqS)
    = if isCommutative(M,F,getTypes(M,TL)) 
         and isAssociative(M,F,getTypes(M,TL)) 
      then 1 else 0 fi 
      + howManyAC$$(M,EqS) .

  *** 
  op howManyBuiltIn : Module NeTermList -> Nat .
  eq howManyBuiltIn(M,NeTL)
   = if howManyAC(M,NeTL) > 0
     then howManyAC(M,NeTL)
     else howMany(onlyEqsBuiltInUnify(M),NeTL) 
     fi .

  *** Filter UnificationPairSet according to Variant narrowing strategy
  op filter-variant-UP : EFlags Module Nat UnificationTripleSet 
                       -> UnificationTripleSet .
  eq filter-variant-UP(EF,M,N,US)
   = if minimal-unifiers in EF and testUnifier !in EF
     then filter-variant-UP*(M,N,empty,US)
     else US
     fi .

  op filter-variant-UP* : 
       Module Nat UnificationTripleSet UnificationTripleSet 
           -> UnificationTripleSet .
  eq filter-variant-UP*(M,N,US$,empty)
   = US$ .
  eq filter-variant-UP*(M,N,US$,{S,S*,NextVar} | US)
   = filter-variant-UP**(M,N,US$,US,{S,S*,NextVar},US) .  

  op filter-variant-UP** : 
        Module Nat UnificationTripleSet UnificationTripleSet
                   UnificationTriple UnificationTripleSet 
                -> UnificationTripleSet .
  eq filter-variant-UP**(M,N,US$,US',{S,S*,NextVar},empty)
   = --- RT is not implied by any in RTS'
     filter-variant-UP*(M,N,US$ | {S,S*,NextVar},US') .
  eq filter-variant-UP**(M,N,US$,U | US',U',U | US)
   = if test-variant-UP(M,N,U,U')  --- keep U & remove U'
     then --- RT is implied by one in RTS'
          filter-variant-UP*(M,N,US$,U | US') 
     else if test-variant-UP(M,N,U',U)  --- keep U' & remove U
          then --- remove T from the set US'
               filter-variant-UP**(M,N,US$,US',U',US)
          else --- continue searching in US
               filter-variant-UP**(M,N,US$,U | US',U',US)
          fi
     fi .

  op test-variant-UP : 
       Module Nat UnificationTriple UnificationTriple -> Bool .
  eq test-variant-UP(M,N,{S,S*,NextVar},{S',S'*,NextVar'})
   = (S ; S*) |> N <=[M] (S' ; S'*) |> N  . --- keep T & remove T' 

  *** Filter VariantFourSet according to Variant narrowing strategy
  op filter-variant-VT : EFlags Module Nat VariantFourSet -> VariantFourSet .
  eq filter-variant-VT(EF,M,N,VTS)
   = if minimal-unifiers in EF and testUnifier !in EF
     then filter-variant-VT*(M,N,empty,VTS)
     else VTS 
     fi .

  op filter-variant-VT* : 
        Module Nat VariantFourSet VariantFourSet -> VariantFourSet .
  eq filter-variant-VT*(M,N,VTS$,empty)
   = VTS$ .
  eq filter-variant-VT*(M,N,VTS$,VT | VTS)
   = filter-variant-VT**(M,N,VTS$,VTS,VT,VTS) .  

  op filter-variant-VT** : 
        Module Nat VariantFourSet VariantFourSet
                   VariantFour VariantFourSet 
                -> VariantFourSet .
  eq filter-variant-VT**(M,N,VTS$,VTS',VT,empty)
   = --- RT is not implied by any in VTSS'
     filter-variant-VT*(M,N,VTS$ | VT,VTS') .
  eq filter-variant-VT**(M,N,VTS$,VT | VTS',VT',VT | VTS)
   = if test-variant-VT(M,N,VT,VT')
     then --- RT is implied by one in RTS'
          filter-variant-VT*(M,N,VTS$,VT | VTS') 
     else if test-variant-VT(M,N,VT',VT)
          then --- remove T from the set VTS'
               filter-variant-VT**(M,N,VTS$,VTS',VT',VTS)
          else --- continue searching in VTS
               filter-variant-VT**(M,N,VTS$,VT | VTS',VT',VTS)
          fi
     fi .

  op test-variant-VT : Module Nat VariantFour VariantFour -> Bool .
  eq test-variant-VT(M,N,{T,S,S*,NextVar},{T',S',S'*,NextVar'})
   = --- keep T & remove T'
     ((S ; S*) |> N ; (newVar(N + 1,leastSort(M,T)) <- T))
      <=[M] 
     ((S' ; S'*) |> N ; (newVar(N + 1,leastSort(M,T')) <- T')) .


  *** Take only normal forms
  op filter-NF : Module UnificationTripleSet -> UnificationTripleSet .
  eq filter-NF(M,empty)
   = empty .
  eq filter-NF(M,{S,S*,NextVar} | US)
   = if normalizedSubstitution?(M,S ; S*)
     then {S,S*,NextVar} 
     else empty 
     fi
     | filter-NF(M,US) .

  op maxNextVar : VariantFourSet -> Nat .
  eq maxNextVar(empty) = 0 .
  eq maxNextVar({T,S,S*,NextVar} | VTS) = max(NextVar,maxNextVar(VTS)) .

endfm

fmod META-ACU-UNIFICATION is
  pr TERM-HANDLING .
  pr SUBSTITUTION-HANDLING .
  pr MODULE-HANDLING .
  pr SUBSTITUTIONSET .
  pr UNIFICATIONPAIRSET .
  pr CONVERSION .
  pr META-LEVEL .
  pr META-MINIMIZE-BINDINGS .
  pr META-E-UNIFICATION .

  var M : Module .
  vars T T' : Term .
  vars N N' : Nat .
  vars US : UnificationTripleSet .

  --- metaACUUnify --------------------------------------------------
  op metaACUUnify : Module Term Term -> SubstitutionSet .
  eq metaACUUnify(M, T, T')
   = toSubstitution(metaACUUnify(M, T, T', highestVar((T,T')) + 1)) .

  op metaACUUnify? : Module Term Term -> Bool .
  eq metaACUUnify?(M, T, T')
   = metaACUUnify?(M, T, T', highestVar((T,T')) + 1) .

  *** General Call for UnificationPairSet
  op metaACUUnify : Module Term Term Nat -> UnificationTripleSet .
  eq metaACUUnify(M, T, T', N) 
   = metaACUUnify$(M, canonice(M,T), canonice(M,T'), N) .

  op metaACUUnify$ : Module Term Term Nat -> UnificationTripleSet .
                      --- Term Lhs
  eq metaACUUnify$(M, T, T', N) 
   = if (root(T) =/= root(T') 
         and not (root(T) :: Variable) and not (root(T') :: Variable))
        or-else
        glbSorts(M,leastSort(M,T),leastSort(M,T')) == none
     then empty
     else minimizeBindingsTerm(M,Vars(T),N,
              metaACUUnifyCollect(M, T, T',N,0,empty)) 
     fi .

  op metaACUUnify? : Module Term Term Nat -> Bool .
  eq metaACUUnify?(M, T, T', N) 
   = metaACUUnify?$(M, canonice(M,T), canonice(M,T'), N) .

  op metaACUUnify?$ : Module Term Term Nat -> Bool .
  eq metaACUUnify?$(M, T, T', N)
   = glbSorts(M,leastSort(M,T),leastSort(M,T')) =/= none
     and-then 
     (metaACUUnify*(M,T =? T',N,0) :: UnificationTriple?
      and
      metaACUUnify*(M,T =? T',N,0) =/= noUnifier) .

  op metaACUUnifyCollect : Module Term Term Nat Nat 
                          UnificationTripleSet 
                       -> UnificationTripleSet .
  eq metaACUUnifyCollect(M,T,T',N,N',US)
   = if metaACUUnify*(M,T =? T',N,N') :: UnificationTriple?
        and
        metaACUUnify*(M,T =? T',N,N') =/= noUnifier
     then metaACUUnifyCollect(M,T,T',N,s(N'),
             US | metaACUUnify*(M,T =? T',N,N') )
     else US
     fi .

  *** Code for collection all unifiers
  op metaACUUnify* : Module UnificandPair Nat Nat ~> UnificationTriple? .
  eq metaACUUnify*(M, T =? T',N,N')
   = metaUnifyTriple(
       keepOnlyACUAttr(eraseEqs(eraseRls(M))),
       unflatten(M,T) =? unflatten(M,T'),
       N,N') .

  op metaUnifyTriple : Module UnificationProblem Nat Nat ~> UnificationTriple? .
  eq metaUnifyTriple(M,T =? T',N,N')
   = if metaUnify(M,T =? T',N,N') == noUnifier
     then noUnifier
     else {getSubst(metaUnify(M,T =? T',N,N')) |> T,
           getSubst(metaUnify(M,T =? T',N,N')) |> T',
           getNextVar(metaUnify(M,T =? T',N,N'))}
     fi .
endfm

fmod META-UNIFICATION is
  pr META-ACU-UNIFICATION .

  var M : Module .
  var T T' : Term .
  var N : Nat .

  --- metaUnify --------------------------------------------------
  op metaCoreUnify : Module Term Term -> SubstitutionSet .
  eq metaCoreUnify(M, T, T')
   = toSubstitution(metaCoreUnify(M, T, T', highestVar((T,T')) + 1)) .

  op metaCoreUnify : Module Term Term Nat -> UnificationTripleSet .
                    --- Term Lhs
  eq metaCoreUnify(M, T, T', N) 
   = metaACUUnify(M, T, T', N)  .

  op metaCoreUnify? : Module Term Term Nat -> Bool .
                    --- Term Lhs
  eq metaCoreUnify?(M, T, T', N) 
   = metaACUUnify?(M, T, T', N)  .

endfm

fmod unification is

pr META-LEVEL .
pr INT .
pr CONVERSION .

sorts ListOfTerms .
sorts HEEquation ListOfEquations .
sort Bit .
sorts BitSequence BitVector .
sort Problem .

subsort Term < ListOfTerms .
subsort HEEquation < ListOfEquations .
subsort Bit < BitSequence .
subsort BitSequence < BitVector .

var Constant_c1 Constant_c2 : Constant .
var Variable_X Variable_Y : Variable .
var Term_X Term_X1 Term_Y1 Term_X2 Term_Y2 : Term .
var TermList_X TermList_X1 TermList_X2 TermList_X3 TermList_X4 : ListOfTerms .
var Equation_X : HEEquation .
var EquationList_X : ListOfEquations .
var Sub Sub' : Assignment .
var BitVector_X BitVector_X1 BitVector_X2 : BitVector .
var BitSequence_X BitSequence_X1 BitSequence_X2 : BitSequence .
var N : Int .
var Assignments_X Assignments_Y : Substitution .
var F G H : Qid .
var T T' T'' : Term .
var TL TL' : TermList .
var M : Module .

op IseTerm(_) : Term -> Bool .
op IspTerm(_) : Term -> Bool .
op IsPTerm(_) : Term -> Bool .
op IsETerm(_) : Term -> Bool .
op HaspTerm(_) : ListOfTerms -> Bool .
op HaseTerm(_) : ListOfTerms -> Bool .
ops unifiable fail : -> HEEquation .
op nil : -> Bit .
op EmptyTerm : -> Term .
ops zero one epsilon : -> Bit .
ops AddZero AddOne : BitVector -> BitVector .
op occurs : Variable Term -> Bool .
op occurs : Variable TermList -> Bool .
op occurs : Variable ListOfTerms -> Bool .

op GenNewVar(_,_) : Variable Int -> Variable .
eq GenNewVar(Variable_X, N) = qid(string(getName(Variable_X)) + "#" + string(N, 10) + ":" + string(getType(Variable_X))) .

op {_}_ : ListOfTerms Assignment -> ListOfTerms [prec 4] .
op {_}_ : TermList Assignment -> TermList [prec 4] .
op {_}_ : Term Assignment -> Term [prec 4] .
op {_}_ : HEEquation Assignment -> HEEquation [prec 5] .
op {_}_ : ListOfEquations Assignment -> ListOfEquations [prec 6] .
op {_}_ : Substitution Assignment -> Substitution [prec 11] .

****************building up subscripts******************
op _|_ : BitSequence BitSequence -> BitSequence [assoc prec 7].
op _,_ : BitVector BitVector -> BitVector [assoc].

*******************building up list of terms*****************
op _#_ : ListOfTerms ListOfTerms -> ListOfTerms [assoc prec 8].

*******************building up terms with P(or E) on top*************************
op p(_,_) : Term Term -> Term .
op e(_,_) : Term Term -> Term .
op P(_;_) : BitVector ListOfTerms -> Term .
op P1(_;_) : BitVector ListOfTerms -> Term .
op E(_,_) : Term ListOfTerms -> Term .

***********************building up equations************************************
op _~_ : Term Term -> HEEquation [comm prec 50].
op _,_ : ListOfEquations ListOfEquations -> ListOfEquations [assoc comm prec 51].

************
op EmptyEquation : -> HEEquation .
op _;_;_;_ : Module ListOfEquations Substitution Int -> Problem [prec 52].
op _;_;_ : ListOfEquations Substitution Int -> Problem [prec 53].
op Solve(_,_,_) : Module ListOfEquations Int -> Problem .
op SolveEquations(_) : ListOfEquations -> ListOfEquations .
op SetOfAssignments(_) : Substitution -> Substitution .

*****************
op GenE(_) : ListOfTerms -> ListOfTerms .
op RemoveTopE(_) : Term -> Term .
op RemoveTopP(_) : Term -> Term .
op ScanBitVector(_) : BitVector -> BitVector .
op ScanTerms(_) : ListOfTerms -> ListOfTerms .
op FirstHalfVector(_) : BitVector -> BitVector .
op SecondHalfVector(_) : BitVector -> BitVector .
op FirstHalfTerms(_) : ListOfTerms -> ListOfTerms .
op SecondHalfTerms(_) : ListOfTerms -> ListOfTerms .
op RemoveZero(_) : BitVector -> BitVector .
op RemoveOne(_) : BitVector -> BitVector .
op Convert(_) : Term -> Term .
op Convert(_) : TermList -> TermList .
op InGoodShape(_,_) : ListOfTerms ListOfTerms -> Bool .
op Shaping(_,_,_) : ListOfTerms Term ListOfTerms -> ListOfTerms .
op Diff(_,_) : ListOfTerms ListOfTerms -> ListOfTerms .
op RemoveLastKey(_) : ListOfTerms -> ListOfTerms .
op LastKey(_) : ListOfTerms -> Term .
op ContainSameVar(_,_) : ListOfTerms ListOfTerms -> Bool .

op length(_) : ListOfTerms -> Int .
eq length(Term_X) = 1 .
eq length(Term_X # TermList_X) = (1 + length(TermList_X)) .

op length(_) : TermList -> Int .
eq length(T) = 1 .
eq length(T, TL) = 1 + length(TL) .

ceq Solve(M, EquationList_X, N) = 
(M ; SolveEquations(EmptyEquation , Replace(EquationList_X, getOperatorE(M), getOperatorP(M))) ; SetOfAssignments((none).Substitution) ; N) 
if HasHomomorphism(M) .

eq e(p(T, T'), T'') = p(e(T, T''), e(T', T'')) .

ceq Solve(M, EquationList_X, N) = 
(M ; SolveEquations(EmptyEquation , EquationList_X) ; SetOfAssignments((none).Substitution) ; N) 
if not HasHomomorphism(M) .

ceq M ; SolveEquations(EmptyEquation) ; SetOfAssignments(Assignments_X) ; N = unifiable ; MapBack(Assignments_X, getOperatorE(M), getOperatorP(M)) ; N
if HasHomomorphism(M) .

ceq M ; SolveEquations(EmptyEquation) ; SetOfAssignments(Assignments_X) ; N = unifiable ; Assignments_X ; N
if not HasHomomorphism(M) .

eq M ; SolveEquations(fail) ; SetOfAssignments(Assignments_X) ; N = fail ; none ; N .
eq fail, EquationList_X = fail .

eq Replace(EmptyEquation, F, G) = EmptyEquation .

eq Replace((Equation_X, EquationList_X), F, G) = 
Replace(Equation_X, F, G), Replace(EquationList_X, F, G) .

eq Replace(Term_X1 ~ Term_X2, F, G) = 
Replace(Term_X1, F, G) ~ Replace(Term_X2, F, G) .

************** Define the process of applying a substituion***********************
**********************************************************************************

eq {Variable_X} (Variable_X <- Term_X1) = Term_X1 .
ceq {Variable_X} (Variable_Y <- Term_X1) = Variable_X if getName(Variable_X) =/= getName(Variable_Y) .
eq {Constant_c1} Sub = Constant_c1 .
eq {p(Term_X1, Term_X2)} Sub = p({Term_X1}Sub, {Term_X2}Sub) .
eq {e(Term_X1, Term_X2)} Sub = e({Term_X1}Sub, {Term_X2}Sub) .
eq {F[TL]}Sub = F[{TL}Sub] .
eq {P(BitVector_X ; TermList_X)} Sub = P(BitVector_X ; {TermList_X}Sub) .
eq {E(Term_X1, TermList_X1)}Sub = E({Term_X1}Sub, {TermList_X1}Sub) .

eq {Term_X1 ~ Term_X2} Sub = {Term_X1} Sub ~ {Term_X2} Sub .
eq {Equation_X, EquationList_X} Sub = {Equation_X} Sub, {EquationList_X} Sub .

eq {Shaping(TermList_X1, Term_X1, TermList_X2)}Sub = Shaping({TermList_X1}Sub, {Term_X1}Sub, {TermList_X2}Sub) .
eq {Replace(Equation_X, F, G)}Sub = Replace(Equation_X, F, G) .
eq {Replace(T, F, G)}Sub = Replace({T}Sub, F, G) .
eq {Replace(TL, F, G)}Sub = Replace({TL}Sub, F, G) .

eq {Variable_X <- Term_X1 ; Assignments_X}Sub = (Variable_X <- ({Term_X1}Sub) ; {Assignments_X}Sub) .
eq {empty}Sub = empty .
eq {EmptyTerm} Sub = EmptyTerm .
eq {EmptyEquation} Sub = EmptyEquation .
eq {(none).Substitution}Sub = (none).Substitution .

eq {Term_X # TermList_X1} Sub = {Term_X}Sub # {TermList_X1}Sub .
eq {T, TL}Sub = ({T}Sub, {TL}Sub) .

********************************Homomorphism**************************************
var EqS : EquationSet .
var AtS : AttrSet .
var ODS : OpDeclSet .
var Tp : Type .
var TpL TpL' TpL'' : TypeList .
var X : Variable .
var C : Constant .

op getOperatorE : Module -> Qid .
op getOperatorE : EquationSet -> Qid .
op getOperatorP : Module -> Qid .
op getOperatorP : EquationSet -> Qid .
op getPara : Module Qid -> TypeList .
op getPara : Module Qid OpDeclSet -> TypeList .
op HasHomomorphism : Module -> Bool .
op HasHomomorphism : EquationSet -> Bool .
op getTypeHomomorphism : Module ~> Type .
op getTypeHomomorphism : EquationSet ~> Type .
op Replace : Term Qid Qid -> Term .
op Replace : TermList Qid Qid -> TermList .
op Replace : HEEquation Qid Qid -> HEEquation .
op Replace : ListOfEquations Qid Qid -> ListOfEquations .
op MapBack : Term Qid Qid -> Term .
op MapBack : TermList Qid Qid -> TermList .
op MapBack : Substitution Qid Qid -> Substitution .
op MapBack : Assignment Qid Qid -> Assignment .

eq getOperatorE(M) = getOperatorE(getEqs(M)) .
eq getOperatorP(M) = getOperatorP(getEqs(M)) .

eq HasHomomorphism(M) = HasHomomorphism(getEqs(M)) .

eq HasHomomorphism((EqS eq F[G[T, T'], T''] = G[F[T, T''], F[T', T'']] [AtS label('homomorphism)].)) = true .
eq HasHomomorphism(EqS) = false [owise].

eq getTypeHomomorphism(M) = getTypeHomomorphism(getEqs(M)) .

eq getTypeHomomorphism((EqS eq F[G[T, T'], T''] = G[F[T, T''], F[T', T'']] [AtS label('homomorphism)].)) = getType(T) .

eq getOperatorE((EqS eq F[G[T, T'], T''] = G[F[T, T''], F[T', T'']] [AtS label('homomorphism)].)) = F .
eq getOperatorP((EqS eq F[G[T, T'], T''] = G[F[T, T''], F[T', T'']] [AtS label('homomorphism)].)) = G .

eq getPara(M, F) = getPara(M, F, getOps(M)) .
eq getPara(M, F, op F : TpL -> Tp [AtS] . ODS) = TpL .

eq Replace((F[T, T'], TL), F, G) = (e(Replace(T, F, G), Replace(T', F, G)), Replace(TL, F, G)) .
eq Replace((G[T, T'], TL), F, G) = (p(Replace(T, F, G), Replace(T', F, G)), Replace(TL, F, G)) .
eq Replace((H[TL], TL'), F, G) = (H[Replace(TL, F, G)], Replace(TL', F, G)) .
eq Replace((X, TL), F, G) = (X, Replace(TL, F, G)) .
eq Replace((C, TL), F, G) = (C, Replace(TL, F, G)) .

eq Replace(empty, F, G) = empty .
eq Replace(X, F, G) = X .
eq Replace(C, F, G) = C .
eq Replace(F[T, T'], F, G) = e(Replace(T, F, G), Replace(T', F, G)) .
eq Replace(G[T, T'], F, G) = p(Replace(T, F, G), Replace(T', F, G)) .
eq Replace(H[TL], F, G) = H[Replace(TL, F, G)] [owise].
eq Replace(fail, F, G) = fail .

eq MapBack(X, F, G) = X .
eq MapBack(C, F, G) = C .
eq MapBack(e(T, T'), F, G) = F[MapBack(T, F, G), MapBack(T', F, G)] .
eq MapBack(p(T, T'), F, G) = G[MapBack(T, F, G), MapBack(T', F, G)] .
eq MapBack(H[TL], F, G) = H[MapBack(TL, F, G)] .
eq MapBack((T, TL), F, G) = MapBack(T, F, G), MapBack(TL, F, G) .
eq MapBack(X <- T, F, G) = X <- MapBack(T, F, G) .
eq MapBack((none).Substitution, F, G) = (none).Substitution .
eq MapBack(Assignments_X ; Assignments_Y, F, G) = (MapBack(Assignments_X, F, G) ; MapBack(Assignments_Y, F, G)) .

************ Check if a variable occurs in some term****************************************
*******************************************************************************************

eq occurs(Variable_X, Constant_c1) = false .
eq occurs(Variable_X, Variable_Y) = (getName(Variable_X) == getName(Variable_Y)) .
eq occurs(Variable_X, p(Term_X1, Term_X2)) = occurs(Variable_X, Term_X1) or occurs(Variable_X, Term_X2) .
eq occurs(Variable_X, e(Term_X1, Term_X2)) = occurs(Variable_X, Term_X1) or occurs(Variable_X, Term_X2) .
eq occurs(Variable_X, F[TL]) = occurs(Variable_X, TL) .
eq occurs(Variable_X, EmptyTerm) = false .
eq occurs(Variable_X, P(BitVector_X ; TermList_X1)) = occurs(Variable_X, TermList_X1).
eq occurs(Variable_X, E(Term_X1, TermList_X1)) = occurs(Variable_X, Term_X1) or occurs(Variable_X, TermList_X1) .
eq occurs(Variable_X, (T, TL)) = occurs(Variable_X, T) or occurs(Variable_X, TL) .
eq occurs(Variable_X, Term_X1 # TermList_X1) = occurs(Variable_X, Term_X1) or occurs(Variable_X, TermList_X1) .

*******************Check if the top symbol of a term is a e(or p or E)*************
*******************************************************************************************

eq IspTerm(P(BitVector_X ; TermList_X)) = false .
eq IspTerm(p(Term_X1, Term_X2)) = true .
eq IspTerm(e(Term_X1, Term_X2)) = false .
eq IspTerm(E(Term_X1, TermList_X)) = false .
eq IspTerm(F[TL]) = false .
eq IspTerm(Constant_c1) = false .
eq IspTerm(Variable_X) = false .
eq IspTerm(EmptyTerm) = false .

eq IsETerm(P(BitVector_X ; TermList_X)) = true .
eq IsETerm(p(Term_X1, Term_X2)) = false .
eq IsETerm(e(Term_X1, Term_X2)) = false .
eq IsETerm(E(Term_X1, TermList_X)) = false .
eq IspTerm(F[TL]) = false .
eq IsETerm(Constant_c1) = false .
eq IsETerm(Variable_X) = false .
eq IsETerm(EmptyTerm) = false .

eq IseTerm(P(BitVector_X ; TermList_X)) = false .
eq IseTerm(p(Term_X1, Term_X2)) = false .
eq IseTerm(e(Term_X1, Term_X2)) = true .
eq IseTerm(E(Term_X1, TermList_X)) = false .
eq IspTerm(F[TL]) = false .
eq IseTerm(Constant_c1) = false .
eq IseTerm(Variable_X) = false .
eq IseTerm(EmptyTerm) = false .

******************** Check if any term from a list of terms has `p' on top.*****************
*******************************************************************************************

eq HaspTerm(Term_X1) = IspTerm(Term_X1) .
ceq HaspTerm(Term_X1 # TermList_X) = true if IspTerm(Term_X1) .
ceq HaspTerm(Term_X1 # TermList_X) = HaspTerm(TermList_X) if not IspTerm(Term_X1) .
eq HaspTerm(EmptyTerm) = false .

******************** Check if any term from a list of terms has `e' on top.*****************
*******************************************************************************************

eq HaseTerm(Term_X1) = IseTerm(Term_X1) .
ceq HaseTerm(Term_X1 # TermList_X) = true if IseTerm(Term_X1) .
ceq HaseTerm(Term_X1 # TermList_X) = HaseTerm(TermList_X) if not IseTerm(Term_X1) .
eq HaseTerm(EmptyTerm) = false .

**********************************************************************
*** InGoodShape() takes two lists of terms, the first one of which is a list of
*** E-terms, returns true if every one of the terms in the 1st list has
*** at least n encryption keys, where n is the length of the 2nd list of the input.
*************************************************************************

eq InGoodShape(EmptyTerm # TermList_X1, TermList_X2) = InGoodShape(TermList_X1, TermList_X2) .
eq InGoodShape(EmptyTerm, TermList_X2) = true .

ceq InGoodShape(E(Term_X1, TermList_X1) # TermList_X2, TermList_X3) = InGoodShape(TermList_X2, TermList_X3) 
if length(TermList_X1) >= length(TermList_X3) .

ceq InGoodShape(E(Term_X1, TermList_X1) # TermList_X2, TermList_X3) = false if 
length(TermList_X1) < length(TermList_X3) .

eq InGoodShape(Constant_c1 # TermList_X2, TermList_X3) = false .

eq InGoodShape(Variable_X # TermList_X2, TermList_X3) = false .

eq InGoodShape((F[TL]) # TermList_X1, TermList_X2) = false .

**************************** Generate E's**********************************************
*** There are 2 possibilities where we need E's
*** 1. P() ~ E() : E on top
*** 2. P(E()) ~ E(): E below P
***************************************************************************************

*** 1. Generate E's on top
eq p(Term_X1, Term_X2) ~ e(Term_Y1, Term_Y2) = p(Term_X1, Term_X2) ~ E(Term_Y1, EmptyTerm # Term_Y2) .
eq E(e(Term_X1, Term_X2), EmptyTerm # TermList_X) = E(Term_X1, EmptyTerm # Term_X2 # TermList_X) .

eq E(E(Term_X1, EmptyTerm # TermList_X1), EmptyTerm # TermList_X2) = E(Term_X1, EmptyTerm # TermList_X1 # TermList_X2) .

*** 2. Generate E's below P
ceq E(Term_X, TermList_X1) ~ P(BitVector_X ; TermList_X2) = E(Term_X, TermList_X1) ~ P(BitVector_X ; GenE(TermList_X2)) if HaseTerm(TermList_X2) .
eq GenE(EmptyTerm # TermList_X1) = EmptyTerm # GenE(TermList_X1) .
eq GenE(EmptyTerm) = EmptyTerm .
ceq GenE(Term_X1 # TermList_X1) = E(Term_X1, EmptyTerm) # GenE(TermList_X1) if not IseTerm(Term_X1) .
eq GenE(e(Term_X1, Term_X2) # TermList_X1) = E(Term_X1, (EmptyTerm # Term_X2)) # GenE(TermList_X1) .

**************Compare two terms with `E' on top**********************************************
*** Remove the top E, and compare them using the "Decomposition Rule".
*** not sure if this is needed for now
*** do we need to compare e() ~ E() ?
*********************************************************************************************

eq E(Term_X1, TermList_X1) ~ E(Term_X2, TermList_X2) = RemoveTopE(E(Term_X1, TermList_X1)) ~ RemoveTopE(E(Term_X2, TermList_X2)) .
eq RemoveTopE(E(Term_X1, TermList_X1 # Term_X2)) = e(E(Term_X1, TermList_X1), Term_X2).

***************************** Generate P's**************************************************
*** We just need one possibility here: P() ~ E()
*** Top-down approach, essentially we need to handle a situation like: P(..., p(), ...)
*** Scan the list of arguments of P() for a p-term, in which
*** case we break the p-term, put its arguments as arguments of the P().
********************************************************************************************

eq p(Term_X1, Term_X2) ~ E(Term_Y1, TermList_X) = P(nil, zero | nil , one | nil, nil ; EmptyTerm # Term_X1 # Term_X2 # EmptyTerm) ~ E(Term_Y1, TermList_X) .

ceq P(BitVector_X ; TermList_X1) = P1(ScanBitVector(BitVector_X) ; ScanTerms(TermList_X1)) if HaspTerm(TermList_X1) .

eq P1(ScanBitVector(nil, BitVector_X2) ; ScanTerms(EmptyTerm # TermList_X2)) = P1(nil, ScanBitVector(BitVector_X2) ; EmptyTerm # ScanTerms(TermList_X2)) .

ceq  P1(BitVector_X1, ScanBitVector(BitSequence_X, BitVector_X2) ; TermList_X1 # ScanTerms(Term_X # TermList_X2)) = 
P1(BitVector_X1, BitSequence_X, ScanBitVector(BitVector_X2) ; TermList_X1 # Term_X # ScanTerms(TermList_X2)) 
if not IspTerm(Term_X) .

eq  P1(BitVector_X1, ScanBitVector(BitSequence_X | nil, BitVector_X2) ; TermList_X1 # ScanTerms(p(Term_X1, Term_X2) # TermList_X2)) = 
P(BitVector_X1,  BitSequence_X | zero | nil, BitSequence_X | one | nil, BitVector_X2 ; TermList_X1 # Term_X1 # Term_X2 # TermList_X2) .

*****************************Compare p() ~ P()**********************************************
*** Do we need a case for P() ~ P() ? Probably not.
*** Scan the bit vector for the first bit sequence that begins with a `1',
*** and then split the arguments into two halves
********************************************************************************************

eq p(Term_X1, Term_X2) ~ P(BitVector_X ; TermList_X1) = p(Term_X1, Term_X2) ~ RemoveTopP(P(BitVector_X ; TermList_X1)) .

eq RemoveTopP(P(BitSequence_X, BitVector_X ; Term_X # TermList_X)) = 
RemoveTopP(P(FirstHalfVector(BitSequence_X), SecondHalfVector(BitVector_X) ; FirstHalfTerms(Term_X) # SecondHalfTerms(TermList_X))) .

eq P(FirstHalfVector(BitVector_X1), SecondHalfVector(zero | BitSequence_X, BitVector_X2) ; FirstHalfTerms(TermList_X1) # SecondHalfTerms(Term_X # TermList_X2))
= P(FirstHalfVector(BitVector_X1, zero | BitSequence_X), SecondHalfVector(BitVector_X2) ; FirstHalfTerms(TermList_X1 # Term_X) # SecondHalfTerms(TermList_X2)) .

eq RemoveTopP(P(FirstHalfVector(BitVector_X1), SecondHalfVector(one | BitSequence_X, BitVector_X2) ; FirstHalfTerms(TermList_X1) # SecondHalfTerms(TermList_X2))) = 
p(P(RemoveZero(BitVector_X1), nil ; TermList_X1 # EmptyTerm), P(nil, RemoveOne(one | BitSequence_X , BitVector_X2) ; EmptyTerm # TermList_X2)) .

eq RemoveOne(one | BitSequence_X , BitVector_X) = BitSequence_X, RemoveOne(BitVector_X) .

eq RemoveOne(one | BitSequence_X) = BitSequence_X .

eq RemoveOne(nil, BitVector_X) = nil,  RemoveOne(BitVector_X) .

eq RemoveOne(nil) = nil .

eq RemoveZero(zero | BitSequence_X , BitVector_X) = BitSequence_X, RemoveZero(BitVector_X) .

eq RemoveZero(zero | BitSequence_X) = BitSequence_X .

eq RemoveZero(nil, BitVector_X) = nil, RemoveZero(BitVector_X) .

eq RemoveZero(nil) = nil .

eq P(nil, nil, nil ; EmptyTerm # Term_X # EmptyTerm) = Term_X .

*****************************************Failure rule**************************************
********************************************************************************************
ceq P(BitVector_X ; TermList_X1) ~ E(Term_X, TermList_X2) = fail if ContainSameVar(TermList_X1, Term_X # TermList_X2) .

eq ContainSameVar(Term_X # TermList_X1, TermList_X2) = ContainSameVar(Term_X, TermList_X2) or ContainSameVar(TermList_X1, TermList_X2) .

eq ContainSameVar(Variable_X, Variable_X # TermList_X1) = true .
ceq ContainSameVar(Variable_X, Term_X # TermList_X1) = ContainSameVar(Variable_X, TermList_X1) if Variable_X =/= Term_X .
eq ContainSameVar(Variable_X, Variable_X) = true .
eq ContainSameVar(TermList_X1, TermList_X2) = false [owise].

************************Convert a term back to p's and e's*******************************
*** typical recursive transformation
*******************************************************************************************

eq Convert(E(Term_X1, TermList_X1)) = Convert(RemoveTopE(E(Term_X1, TermList_X1))) .
eq Convert(P(BitVector_X ; TermList_X1)) = Convert(RemoveTopP(P(BitVector_X ; TermList_X1))) .
eq Convert(p(Term_X1, Term_X2)) = p(Convert(Term_X1), Convert(Term_X2)) .
eq Convert(e(Term_X1, Term_X2)) = e(Convert(Term_X1), Convert(Term_X2)) .
eq Convert(F[TL]) = F[Convert(TL)] .
eq Convert(Variable_X) = Variable_X .
eq Convert(Constant_c1) = Constant_c1 .

eq Convert(E(Term_X1, TermList_X1), TL) = Convert(RemoveTopE(E(Term_X1, TermList_X1))), Convert(TL) .
eq Convert(P(BitVector_X ; TermList_X1), TL) = Convert(RemoveTopP(P(BitVector_X ; TermList_X1))), Convert(TL) .
eq Convert(p(Term_X1, Term_X2), TL) = p(Convert(Term_X1), Convert(Term_X2)), Convert(TL) .
eq Convert(e(Term_X1, Term_X2), TL) = e(Convert(Term_X1), Convert(Term_X2)), Convert(TL) .
eq Convert(F[TL'], TL) = F[Convert(TL')], Convert(TL) .
eq Convert(Variable_X, TL) = Variable_X, Convert(TL) .
eq Convert(Constant_c1, TL) = Constant_c1, Convert(TL) .


******************Shaping************************************************************
*** After "Shaping" is applied, three things can happen:
*** 1. # of keys on the LHS >= # of keys on the RHS => do nothing.
*** 2. # of keys on the LHS <  # of keys on the RHS && there is a variable different from the one on the RHS => substitute that variable.
*** 3. otherwise: fail.
*******************************************************************************************

*** Takes equations of the form P(E, E, ..., E) ~ E(P(), ),
*** and makes the encryption keys on the LHS as many as the
*** encryption keys on the RHS.

***Shaping rule
ceq P(BitVector_X ; TermList_X1) ~ E(Term_X1, TermList_X2) = P(BitVector_X ; Shaping(TermList_X1, Term_X1, TermList_X2)) ~ E(Term_X1, TermList_X2) 
if not InGoodShape(TermList_X1, TermList_X2) and not IseTerm(Term_X1) and not HaspTerm(TermList_X1) and not ContainSameVar(TermList_X1, Term_X1 # TermList_X2) .

*** Case 1:
eq Shaping(EmptyTerm # TermList_X2, Term_X2, TermList_X3) = EmptyTerm # Shaping(TermList_X2, Term_X2, TermList_X3) .
eq Shaping(EmptyTerm, Term_X2, TermList_X3) = EmptyTerm .

ceq Shaping(E(Term_X1, TermList_X1) # TermList_X2, Term_X2, TermList_X3) = 
E(Term_X1, TermList_X1) # Shaping(TermList_X2, Term_X2, TermList_X3) if 
length(TermList_X1) >= length(TermList_X3) .

*** Case 2:
***case 2.1:
ceq (M ; SolveEquations(EquationList_X, P(BitVector_X ; TermList_X1 # Shaping(E(Variable_X, TermList_X2) # TermList_X3, Term_Y1, TermList_X4)) 
~ E(Term_Y1, TermList_X4)) ; SetOfAssignments(Assignments_X) ; N) = (M ;
SolveEquations({EquationList_X} (Variable_X <- Convert(E(GenNewVar(Variable_X, N), Diff(TermList_X4, TermList_X2)))), 
{P(BitVector_X ; TermList_X1 # E(Variable_X, TermList_X2) # TermList_X3) ~ E(Term_Y1, TermList_X4)} 
(Variable_X <- E(GenNewVar(Variable_X, N), Diff(TermList_X4, TermList_X2)))) ;
SetOfAssignments({Assignments_X} (Variable_X <- Convert(E(GenNewVar(Variable_X, N), Diff(TermList_X4, TermList_X2)))) ; 
(Variable_X <- Convert(E(GenNewVar(Variable_X, N), Diff(TermList_X4, TermList_X2))))) ; N + 1)
if Variable_X =/= Term_Y1  and length(TermList_X2) < length(TermList_X4) .

*** Define function Diff()
eq Diff(TermList_X1, EmptyTerm) = TermList_X1 .
eq Diff(TermList_X1 # Term_X1, TermList_X2 # Term_X2) = Diff(TermList_X1, TermList_X2) .

***case 2.2
eq (M ; SolveEquations(EquationList_X, P(BitVector_X ; TermList_X1 # Shaping(Variable_X  # TermList_X3, Term_Y1, TermList_X4)) ~ E(Term_Y1, TermList_X4)) ;
SetOfAssignments(Assignments_X) ; N) = (M ;
SolveEquations({EquationList_X} (Variable_X <- Convert(E(GenNewVar(Variable_X, N), TermList_X4))), 
{P(BitVector_X ; TermList_X1 # Variable_X # TermList_X3) ~ E(Term_Y1, TermList_X4)} (Variable_X <- E(GenNewVar(Variable_X, N), TermList_X4))) ;
SetOfAssignments({Assignments_X}(Variable_X <- Convert(E(GenNewVar(Variable_X, N), TermList_X4))) ; 
Variable_X <- Convert(E(GenNewVar(Variable_X, N), TermList_X4))) ; N + 1) .


***********I don't know why the following is needed************
ceq Shaping(E(Term_X1, TermList_X1), Term_Y1, TermList_X2) = E(Term_X1, TermList_X1) 
if length(TermList_X1) == length(TermList_X2) .

*************************************************************
************ Case 3:*******
***case 3.1***
ceq P(BitVector_X ; TermList_X4 # Shaping(E(Variable_X, TermList_X1) # TermList_X2, Variable_Y, TermList_X3)) ~ E(Variable_Y, TermList_X3) = fail 
if Variable_X == Variable_Y and length(TermList_X1) < length(TermList_X3) .

ceq P(BitVector_X ; TermList_X4 # Shaping(Variable_X # TermList_X2, Variable_Y, TermList_X3)) ~ E(Variable_Y, TermList_X3) = fail 
if Variable_X == Variable_Y .

***case 3.2*****
ceq P(BitVector_X ; TermList_X4 # Shaping(E(Constant_c1, TermList_X1) # TermList_X2, Term_X2, TermList_X3)) ~ E(Term_X2, TermList_X3) = fail 
if length(TermList_X1) < length(TermList_X3) .

eq P(BitVector_X ; TermList_X4 # Shaping(Constant_c1 # TermList_X2, Term_X2, TermList_X3)) ~ E(Term_X2, TermList_X3) = fail .
***case 3.3*********
eq P(BitVector_X ; TermList_X4 # Shaping((F[TL]) # TermList_X2, Term_X2, TermList_X3)) ~ E(Term_X2, TermList_X3) = fail .

******************* Parsing****************************************************************
*** Keep removing the last encryption key on both sides. Because of the "Shaping Rule",
*** eventually the keys on the RHS will run out, and we end up comparing two terms with `P' on top.
*******************************************************************************************

ceq P(BitVector_X ; TermList_X1) ~ E(Term_X1, TermList_X2 # Term_X2) = 
P(BitVector_X ; RemoveLastKey(TermList_X1)) ~ E(Term_X1, TermList_X2), LastKey(TermList_X1) ~ Term_X2 
if InGoodShape(TermList_X1, TermList_X2) and not HaspTerm(TermList_X1) and not IseTerm(Term_X1) .

eq RemoveLastKey(EmptyTerm # TermList_X1) = EmptyTerm # RemoveLastKey(TermList_X1) .
eq RemoveLastKey(EmptyTerm) = EmptyTerm .
eq RemoveLastKey(E(Term_X1, TermList_X1 # Term_X2) # TermList_X2) = E(Term_X1, TermList_X1) # RemoveLastKey(TermList_X2) .

eq E(Term_X1, EmptyTerm) = Term_X1 .

eq LastKey(EmptyTerm # TermList_X1) ~ Term_X1 = LastKey(TermList_X1) ~ Term_X1 .
eq LastKey(E(Term_X1, TermList_X1 # Term_X2) # EmptyTerm) ~ Term_Y1 = Term_X2 ~ Term_Y1 .
eq LastKey(E(Term_X1, TermList_X1 # Term_X2) # TermList_X2) ~ Term_Y1 = Term_X2 ~ Term_Y1, LastKey(TermList_X2) ~ Term_Y1 .

*************************Standard Syntactic Unification rules*******************************
********************************************************************************************

*** Trival
eq Equation_X, T ~ T = Equation_X .

*** Decomposition
op Decomp(_,_) : TermList TermList -> ListOfEquations .
eq p(Term_X1, Term_Y1) ~ p(Term_X2, Term_Y2) = Term_X1 ~ Term_X2, Term_Y1 ~ Term_Y2 .
eq e(Term_X1, Term_Y1) ~ e(Term_X2, Term_Y2) = Term_X1 ~ Term_X2, Term_Y1 ~ Term_Y2 .
eq F[T] ~ F[T'] = T ~ T' .
ceq F[TL] ~ F[TL'] = Decomp(TL, TL') if length(TL) == length(TL') .
eq Decomp(T, T') = (T ~ T') .
eq Decomp((T, TL), (T', TL')) = (T ~ T', Decomp(TL, TL')) .

*** Occur Check
ceq Variable_X ~ Term_X1 = fail if (occurs(Variable_X, Term_X1) and Variable_X =/= Term_X1) .

*** Variable Substitution
eq M ; SolveEquations(EquationList_X, Variable_X ~ Term_X1) ; SetOfAssignments(Assignments_X) ; N = 
if occurs(Variable_X, Term_X1) then M ; SolveEquations(fail) ; SetOfAssignments(Assignments_X) ; N
else 
M ; SolveEquations({EquationList_X} (Variable_X <- Convert(Term_X1))) ; 
SetOfAssignments({Assignments_X} (Variable_X <- Convert(Term_X1)) ; (Variable_X <- Convert(Term_X1))) ; N
fi .


*** Failure rule
eq Constant_c1 ~ p(Term_X1, Term_X2) = fail .
eq Constant_c1 ~ e(Term_X1, Term_X2) = fail .
eq Constant_c1 ~ P(BitVector_X ; TermList_X) = fail .
eq Constant_c1 ~ E(Term_X1, TermList_X) = fail .
eq Constant_c1 ~ F[TL] = fail .

ceq M ; SolveEquations(EquationList_X, Constant_c1 ~ Constant_c2) ; SetOfAssignments(Assignments_X) ; N = 
M ; SolveEquations(fail) ; SetOfAssignments(Assignments_X) ; N
if getName(Constant_c1) =/= getName(Constant_c2) .
***or not sameKind(M, getType(Constant_c1), getType(Constant_c2)) .

ceq M ; SolveEquations(EquationList_X, F[TL] ~ G[TL']) ; SetOfAssignments(Assignments_X) ; N = fail ; none ; N
if F =/= G .

ceq M ; SolveEquations(EquationList_X, F[TL] ~ F[TL']) ; SetOfAssignments(Assignments_X) ; N = fail ; none ; N
if length(TL) =/= length(TL') .

eq M ; SolveEquations(EquationList_X, F[TL] ~ p(Term_X1, Term_Y1)) ; SetOfAssignments(Assignments_X) ; N = fail ; none ; N .
eq M ; SolveEquations(EquationList_X, F[TL] ~ e(Term_X1, Term_Y1)) ; SetOfAssignments(Assignments_X) ; N = fail ; none ; N .

endfm
fmod XTheory is

pr META-LEVEL .
***pr testTheory .
sorts sort1 sort2 .
subsort sort1 sort2 < Term .

***op _+_ : sort1 sort1 ->  sort1 .

op f : Term -> Term .

op XOR :  Term Term -> Term [frozen] .
op 0 : -> Term .

vars x y z : Term .

***eq x + y = y + x [nonexec label Commutativity] .
eq XOR(x, y) = XOR(y, x) [nonexec label Commutativity] .
***eq x + (y + z) = (x + y) + z [nonexec label Associativity] .
eq XOR(x, XOR(y, z)) = XOR(XOR(x,y),z) [nonexec label Associativity] .
***eq 0 + x  = x [nonexec label UNITY] .
eq XOR(0, x) = x [nonexec label UNITY] .
***eq x + x = 0 [nonexec label NilPotent] .
eq XOR(x, x) = 0 [nonexec label NilPotent] .



endfm 
fmod XorUnif is


	pr META-LEVEL .
****We are using some built-in sorts in Meta-Level, like Variable, Term, UnificationProblem,Substitution etc.
	pr INT .
	pr CONVERSION .
****Sometimes, we need to convert terms between qid to string.


**********Sorts and subsorts**********


	sorts DisEquation ListOfDisEquations .
	sorts Problem ProblemList .
	sorts SubstitutionList . ***Collection of all substitutions 
	sorts FinalAss FinalSub . ***For converting back 
	sort FinalList .  ****For final solution and new variable counter

	sort NewVariableStatus . ***For purification

	subsort DisEquation < ListOfDisEquations .
	subsort Problem < ProblemList .
	subsort Substitution < SubstitutionList .
	subsort FinalAss < FinalSub .

********************************************
***********Variable Used in the future********
********************************************

***the following variables' sorts are declared in prelude .
	var str : String .
	var M : Module . 
	vars V V1 : Variable . 
	vars C C1 : Constant .
	vars T T1 T2 T3 : Term .
	vars TL TL1 TL2 TL3 TL4 TL5 : TermList .
	vars NTL NeTL NeTL1 : NeTermList . ***NeTermList is none empty termlist. 
	vars UfPr UfPr1 UfPr2 UfPr3 : UnificationProblem .
	vars UP UP1 : UnificandPair .
	vars EQ EQ1 : Equation .
	vars EQS EQS1 : EquationSet .
	vars ATTS ATTS1 : AttrSet .
	vars QI1 QI2 QI3 QI4 QI5 : Qid .

*******Normally, we use QI1 to denote XOR symbol , and QI2 to denote Nilterm Symbol, which are both gotten from XTheory.maude.

	vars N N1 : Int .
	vars SUB SUB1 : Substitution .
	vars AS AS1 : Assignment . 
	vars TY : Type .

****The following variables' sorts are declared in this file. 
	vars NXOE NXOE1 : DisEquation .
	vars NLE NLE1 : ListOfDisEquations .
	vars SL SL1 : SubstitutionList .
	vars FASS : FinalAss .
	vars FS1 FS2 : FinalSub .
	var P P1 : Problem .
	var PL PL1 : ProblemList .

**************************************
*******Buiding up Basic Term.***********
**************************************

*********************************************
****Terms--Including Variable, constant, f[termlist]--, 
***Termlist, UnificationPair"=? ", UnificaitonProblem : /\ , 
****Assignment, Substitution etc are defined in prelude.maude. 
********************************************************

*****deferent identity sorts

*** empty will be emtpy termlist, which is defined in prelude.
***none will be empty substitution, which is defined in prelude. 
	op NilTerm : -> Term [ctor] .
	op EmptyUnificandPair : -> UnificandPair [ctor] .
	op NilDisEquation : -> DisEquation [ctor] .
	op EmptyEq : -> UnificationProblem [ctor] .
	op EmptyDisEq : -> ListOfDisEquations [ctor] .
	op EmptyProblem : -> ProblemList [ctor] .
	op EmptyModule : -> Module [ctor] .

****If we can not find any problem.
	op NoProblemFound : -> ProblemList [ctor] .
****If we can not find any exclusive or Declaration.
	op noTheoryFoundProblemP : -> ProblemList [ctor] .
	op noTheoryFoundProblem  : -> UnificationProblem [ctor] .
	
	op noneNoProblemFound : -> SubstitutionList [ctor] . ***If no problem was found . 
	op noneNoTheoryFound : -> SubstitutionList [ctor] . ***If no theory declaration was found .

	op IDENTITY : -> FinalSub [ctor] . ***If solution IS none
	op NoProblemFoundInFile : -> FinalSub [ctor] . ***If no problem was found  in the problem file..	
	op NoTheoryFoundInFile : -> FinalSub [ctor] . ***If no theory declaration was found in the problem file. 
*****deferent failure constants

	op FailEquation : -> UnificationProblem .
	op FailProblem : -> Problem .
	op fail : -> Assignment .
	
******Special Terms
	

****** Buidling up the Exclusive Or terms.********
 
	op XO : TermList TermList -> Term [ctor assoc comm] .
	op _N=?_ : Term Term -> DisEquation [ctor] .

	eq XO(NilTerm , T) = T .
	eq XO(empty , T) = T . *** empty is emtpy termlist.
	eq XO(empty , T, TL) = XO(T, TL) .
	eq XO(T , T) = NilTerm . ***Idemponent.
	eq XO(T , T , T2) = XO(NilTerm, T2) . ***Idemponent.
	eq XO(TL, (T1, NTL)) = XO(TL, T1, (NTL)) . ****nomally, precedence of parentheses is prior to termlist. This will be resulting some problems, this equation is to give the same precedence of parentheses as termlist in terms if exclusive or. 


*******List of Terms**********
***_/\_ for unification pair was defined in prelude. 
	op _/\_ : ListOfDisEquations ListOfDisEquations -> ListOfDisEquations [ctor assoc comm format (d n d d)] .

****there are no identities for /\ in prelude, we add them here.
	eq EmptyEq /\ UfPr = UfPr . ***identity in unification problem
	eq EmptyDisEq /\ NLE = NLE . ***identity in list of disequations. 
	eq FailEquation /\ UfPr = FailEquation . ***if some equation is fail, whole problem will be fail.

********We need idemponent for and*************
	eq UP /\ UP = UP .
	eq NXOE /\ NXOE = NXOE .


*********Building up Problems************
********problem is composed by UnificationProblem, Disequations(is used to track the nondeterminstic path), solved equationset(the form is same as unification problem, which is used to remember the solved variable so far.) and int number which is a counter for new variables.

	op _||_||_||_ : UnificationProblem ListOfDisEquations UnificationProblem Int -> Problem [ctor format (d n d n d n d n)] .

	eq UfPr || NLE || FailEquation || N = FailProblem .

*****several operators to extract different parts of a problem for convience in the furture. 

	op getUnificationProblem : Problem -> UnificationProblem .
	op getDisEquations : Problem -> ListOfDisEquations .
	op getSubstitutions : Problem -> UnificationProblem .

	eq getUnificationProblem(UfPr || NLE || UfPr1 || N) = UfPr .
	eq getDisEquations(UfPr || NLE || UfPr1 || N) = NLE .
	eq getSubstitutions(UfPr || NLE || UfPr1 || N) = UfPr1 .

****************************************************************************************
***********Occur Check --Including all kinds of checks******************************
**********************************************************************************


****************
***issingle is used for check whether a term is a variable . this is used in sytactic unification

	op issingle : Term -> Bool .

	eq issingle(V) = true .
	eq issingle(T) = false [owise] .

******************
******Variable checks, integer is to check where it occurs under some variable symbol. 

*** ****occurs in term
	op occurs : Variable Term Int -> Bool .

	eq occurs(V, C, N) = false .
	eq occurs(V, V1, 1) = (getName(V) == getName(V1)) .
	eq occurs(V, V1, 0) = false .
	eq occurs(V, NilTerm, N) = false .
	eq occurs(V, QI1[TL], N) = occurs(V, TL, 1) .
	eq occurs(V, XO(T , TL), N) = occurs(V, T, N) or occurs(V, TL, N) .

*** *******occurs in termlist 
	op occurs : Variable TermList Int -> Bool .

	eq occurs(V, (T,TL), N) = (occurs(V, T, N) or occurs(V, TL, N)).
	eq occurs(V, empty, N) = false .

************sometimes we need check whether it occurs in all the terms. 
	op AndOccurs : Variable TermList Int -> Bool .

	eq AndOccurs(V, (T, TL), N) = (occurs(V, T, N) and AndOccurs(V, TL , N)) .
	eq AndOccurs(V, empty, N) = true .

*** *******occurs in Xor equations
	op occurs : Variable UnificandPair Int -> Bool .

	eq occurs(V, (T =? T1), N) = (occurs(V, T, N) or occurs(V, T1, N)) .
	eq occurs(V, EmptyUnificandPair, N) = false .

*** *******occurs in listofequation
	op occurs : Variable UnificationProblem Int -> Bool .

	eq occurs(V, (UfPr /\ UfPr1), N) = (occurs(V, UfPr, N) or occurs(V, UfPr1, N)) .
	eq occurs(V, EmptyEq, N) = false . 


***********************
**********Free Variable Test ******************
	op noFreeVariable : Term Int -> Bool .

	eq noFreeVariable(V) = false .
	eq noFreeVariable(C) = true .
	eq noFreeVariable(QI1[TL]) = true .
	eq noFreeVariable(XO(T, TL)) = noFreeVariable((T,TL)) .
	eq noFreeVariable(NilTerm) = true .

	op noFreeVariable : TermList -> Bool .

	eq noFreeVariable(empty) = true .
	eq noFreeVariable((T, TL)) = noFreeVariable(T) and noFreeVariable(TL) .

	op noFreeVariable : UnificandPair -> Bool .

	eq noFreeVariable(T =? NilTerm) = noFreeVariable(T) .

	op noFreeVariable : UnificationProblem -> Bool .

	eq noFreeVariable((UP /\ UfPr)) = noFreeVariable(UP) and noFreeVariable(UfPr) .
	eq noFreeVariable(EmptyEq) = true .


*******************
************Find all the variable which occur in pure in some equation. 
*********sometimes, there will be loop problem if some operator overloaded on both the sort and its supersort. So in the following some operator which are going to be applied both sort and supersort, I will build defferent operators to operate the them 

	op PureVariable : UnificationProblem -> TermList .
	op PureVariableL : TermList -> TermList .
	op PureVariable : Term -> TermList .

	eq PureVariableL((T, TL)) = (PureVariable(T), PureVariableL(TL)) .
	eq PureVariable(V) = V .
	eq PureVariable(C) = empty .
	eq PureVariableL(empty) = empty .
	eq PureVariable(NilTerm) = empty .
	eq PureVariable(XO(TL, TL1)) = PureVariableL((TL, TL1)) .
	eq PureVariable(QI1[TL]) = empty .
	eq PureVariable(T) = empty [owise] .

*************************
*****************check whether where are some variable occurs in pure in the problem.

	op PVOccurs : TermList UnificationProblem -> Bool .
	op PVOccurs : TermList UnificandPair -> Bool .
	op PVOccurs : TermList TermList -> Bool .
	op PVOccursT : TermList Term -> Bool .

	eq PVOccurs((T, TL), TL1) =  PVOccursT(T, TL1) and PVOccurs(TL, TL1) .
	eq PVOccursT(V, (T, TL)) = occurs(V, T, 0) or occurs(V, TL , 0) .
	eq PVOccurs(empty, TL) = true .
	eq PVOccurs(T, empty) = false .


*******************************
**************Che whether there Exclusive or symbol in the problem


	op XOoccurs : Term Int -> Bool .
	op XOoccurs : TermList Int -> Bool .

	eq XOoccurs(XO(TL, TL1) , 1) = true .
	eq XOoccurs(XO(T, TL1) , 0) = XOoccurs(T, 0) or XOoccurs(TL1 , 0) .
	eq XOoccurs(QI1[TL] , N) = XOoccurs(TL, 1) .
	eq XOoccurs(C , N) = false .
	eq XOoccurs(V , N) = false .
	eq XOoccurs(NilTerm, N) = false .

	eq XOoccurs((T , TL), N) = XOoccurs(T , 1) or XOoccurs(TL , 1) .
	eq XOoccurs(empty, N) = false .

	op XOoccurs : UnificandPair Int -> Bool .
	eq XOoccurs((T =? NilTerm), N) = (XOoccurs(T , N)) .
	eq XOoccurs(EmptyUnificandPair , N) = false .

	op XOoccurs : UnificationProblem Int -> Bool .
	eq XOoccurs((UP /\ UfPr1) , N) = (XOoccurs(UP , N) or XOoccurs(UfPr1 , N)) .
	eq XOoccurs(EmptyEq , N) = false . 

**************************
******************check whether this pair (which is supposed to be disequal)already occurs in the ListofDisEquations****


**********Test whether two terms are same. 
	op isSame : Term Term -> Bool .
	op isSameL : TermList TermList -> Bool .

	eq isSame(V , V) = true .
	eq isSame(V , C) = false .
	eq isSame(C , V) = false .
	eq isSame(C , C) = true .
	ceq isSame(V, V1) = false if V =/= V1 .
	ceq isSame(C, C1) = false if C =/= C1 .
	ceq isSame(QI1[TL] ,  QI1[TL1]) = isSameL(TL, TL1) if getNumber(TL) == getNumber(TL1).
	ceq isSame(QI1[TL] ,  QI2[TL1]) = false if QI1 =/= QI2 .
	eq isSame(QI1[TL], C) = false .
	eq isSame(QI1[TL], V) = false .
	eq isSame(V, QI1[TL]) = false .
	eq isSame(C, QI1[TL]) = false .


	eq isSameL((T , NeTL) , (T1, NeTL1)) = (isSame(T, T1) and isSameL(NeTL, NeTL1)) .
	eq isSameL(empty, empty) = true .
	ceq isSameL(empty, TL) = false if TL =/= empty .
	ceq isSameL(TL, empty) = false if TL =/= empty .
	eq isSame(NilTerm, NilTerm) = true .
	ceq isSame(NilTerm, T) = false if T =/= NilTerm .
	ceq isSame(T, NilTerm) = false if T =/= NilTerm .
	eq isSame(T , T1) = false [owise] .
	eq isSameL(T , T1) = isSame(T, T1) .

***********check the pair occurs  in disequation set or not.  
	op POccurs : ListOfDisEquations DisEquation -> Bool .
	op POccurs : DisEquation DisEquation -> Bool .

	eq POccurs((NXOE /\ NLE), NXOE1) = POccurs(NXOE, NXOE1) or POccurs(NLE, NXOE1) .
***	ceq POccurs((XO(T N=? NilTerm), T2 N=? NilTerm) = true if isSame(T, T2) = true .
	ceq POccurs((XO(T, T1) N=? NilTerm), XO(T2, T3) N=? NilTerm) = true if isSame(T, T2) = true /\ isSame(T1, T3) = true .
	ceq POccurs((XO(T, T1) N=? NilTerm), XO(T2, T3) N=? NilTerm) = true if isSame(T1, T2) = true /\ isSame(T, T3) = true .
	
	
	eq POccurs(EmptyDisEq, NXOE) = false .
	eq POccurs(NXOE1, NXOE) = false [owise] .


************************************************
**************Counting Top Same Symbols**************

********Get the top symbol of a term.
	op getTopSymbol : Term -> Qid .

	eq getTopSymbol(QI1[TL]) = QI1 .

************collect all the terms with same top symbole. 
	op getSameFunctions : Term Qid -> TermList .
	op getSameFunctions : TermList Qid -> TermList .

	eq getSameFunctions(XO(T, TL1), QI1) = getSameFunctions((T, TL1), QI1) .
	eq getSameFunctions(QI1[TL], QI1) = QI1[TL] .
	eq getSameFunctions(empty, QI1) = empty .
	eq getSameFunctions(V, QI1) = empty .
	eq getSameFunctions(C, QI1) = empty .
	ceq getSameFunctions((QI2[TL], TL), QI1) = getSameFunctions(TL, QI1) if QI1 =/= QI2 .
	ceq getSameFunctions(QI2[TL], QI1) = empty if QI1 =/= QI2 .
	eq getSameFunctions((T, TL), QI1) = (getSameFunctions(T, QI1), getSameFunctions(TL, QI1)).

	op getSameFunctions : UnificandPair Qid -> TermList .

	eq getSameFunctions((T =? NilTerm) , QI1) = getSameFunctions(T, QI1) .

*************Check the number of terms with same function symbol odd or even .When they are applied, they will applied on the same function symbol list. 
	op getOdd : TermList Int -> Int .

	eq getOdd((T, TL), 1) = getOdd(TL, 0) .
	eq getOdd((T, TL), 0) = getOdd(TL, 1) .
	eq getOdd(empty, N) = N .

	op getOdd : UnificandPair Int -> Int .
	eq getOdd(T =? NilTerm, N) = getOdd(T, N) .

******count the number of terms in a termlist .
	op getNumber : TermList -> Int .

	eq getNumber((T, TL)) = (getNumber(TL) + 1) .
	eq getNumber(empty) = 0 .

*** ***************************************
*** *******Generating New Variables********
*** ****************************************

***Normally, we need to know the type of variable when we generate a new one. 
***WLOG, we use the type of the first argument of the term which will be replace by the new variable 
****operater for getType for constant and varialbe is declared in prelude.maude. 

	op getType : Term -> Type .

	eq getType(XO(T , T1)) = getType(T) .
	eq getType(QI1[T , TL]) = getType(T) .

	op GenNewVar(_,_) : Type Int -> Variable .

	eq GenNewVar(TY, N) = qid("NV#" + string((N + 1), 10) + ":" + string(TY)) .

***New varialble is starting with NV#.

***in the precedure in generating new variable , we need track the number of new variable,because sometimes we dont know what is the counter so far, but we still need to know it. 

	op getNewNum : Variable -> Int .
	op getNewNum : Problem -> Int .
	op getNewNumL : ProblemList -> Int .

	eq getNewNum(V) = rat(string(getName(V)), 10) .
	eq getNewNum(UfPr || NLE || UfPr1 || N) = N .
	eq getNewNum(V) = 0 [owise] .
	eq getNewNumL(PL $$ P) = getNewNum(P) .
	
*****************************************************
*********the following operators are used for what the result after generating newvariable.

	op _,_,_ : TermList UnificationProblem Int -> NewVariableStatus [ctor] .
	op _,_,_ : Term UnificationProblem Int -> NewVariableStatus [ctor] .

********Get everypart of after generating new variable.
	op getNewEqs : NewVariableStatus -> UnificationProblem .
	op getNewNum : NewVariableStatus -> Int .
	op getNewResult : NewVariableStatus -> TermList .
	
	eq getNewEqs(TL, UfPr, N) = UfPr .
	eq getNewNum(TL, UfPr, N) = N .
	eq getNewResult(TL, UfPr, N) = TL .

*****sometime, we need to apply our generating method seperately, we need to combine them after convert back. In the precedure, we dont know which part will be applied first, So the counter will be passed through different part. we just get the biggest one will be fine, becouse the counter will be passed everytime I apply it.


	op combine : NewVariableStatus NewVariableStatus -> NewVariableStatus [assoc] .

	eq combine((T, UfPr, N), (TL1, UfPr1, N1)) = ((T, TL1), (UfPr /\ UfPr1), max(N , N1)) .


******************************************
**********Assignment and Substitution****
******************************************

*******Assignment and Substitution was declared in prelude. I think there is some way defined to apply , but I did not find it. So I defined here. Also we need apply them into disequations which was not defined in prelude.

*** ****Apply to Term
	op Apply(_,_) : Term Substitution -> Term .

	eq Apply(V, ((V <- T) ; SUB)) = T .
	ceq Apply(V, ((V1 <- T) ; SUB)) = V if V =/= V1 .
	eq Apply(NilTerm, SUB) = NilTerm .
	eq Apply(C, SUB) = C .
	eq Apply(QI1[TL] , SUB) = QI1[Apply(TL , SUB)] .
	eq Apply(XO(T, TL),SUB) = XO(Apply(T, SUB), Apply(TL,SUB)) .
	eq Apply(T, none) = T .
	eq Apply(T, fail) = T .

*** ****Apply to TermList
	op Apply(_,_) : TermList Substitution -> TermList .

	eq Apply((T,TL1), SUB) = (Apply(T, SUB), Apply(TL1, SUB)) .
	eq Apply(empty, SUB) = empty .
	eq Apply(TL, none) = TL .
	eq Apply(TL, fail) = TL .

*** *****Apply to UnificationPairs
	op Apply(_,_) : UnificandPair Substitution -> UnificandPair .
*******When we apply our substitution to solved euqation set(it is like substituion but in equation form), we only need to apply them into left hand side, so we declare sApply here.
	op sApply(_,_) : UnificandPair Substitution -> UnificandPair .

	eq Apply(T =? T1, SUB) = (Apply(T, SUB)=? Apply(T1, SUB)) [owise] .
	eq Apply(EmptyUnificandPair, SUB) = EmptyUnificandPair .
	eq Apply (UP, fail) = FailEquation .
	eq Apply(UP, none) = UP .
	eq sApply(V =? T, SUB) = (V =? Apply(T, SUB)) [owise] .
	eq sApply(EmptyUnificandPair, SUB) = EmptyUnificandPair .
	eq sApply(UP, none) = UP .
	eq sApply(FailEquation, SUB) = FailEquation .
	eq sApply(UfPr, fail) = FailEquation .

*** ******Apply to DisEquations
	op Apply(_,_) : DisEquation Substitution -> DisEquation .

	eq Apply(T N=? T1, SUB) = (Apply(T, SUB) N=? Apply(T1, SUB)) .
	eq Apply(NilDisEquation, SUB) = NilDisEquation .
	eq Apply(NXOE, none) = NXOE .

*** *****Apply to UnificationProblem
	op Apply(_,_) : UnificationProblem Substitution -> UnificationProblem .
	op sApply(_,_) : UnificationProblem Substitution -> UnificationProblem .

	eq Apply(UfPr /\ UfPr1, SUB) = (Apply(UfPr, SUB) /\ Apply(UfPr1, SUB)) .
	eq sApply(UfPr /\ UfPr1, SUB) = (sApply(UfPr, SUB) /\ sApply(UfPr1, SUB)) .
	eq Apply(EmptyEq, SUB) = EmptyEq .
	eq sApply(EmptyEq, SUB) = EmptyEq .
	eq Apply(UfPr, none) = UfPr .
	eq sApply(UfPr, none) = UfPr .

*** *****Apply to ListOfDisEquations

	op Apply(_,_) : ListOfDisEquations Substitution -> ListOfDisEquations .

	eq Apply(NLE /\ NLE1, SUB) = (Apply(NLE, SUB) /\ Apply(NLE1, SUB)) .
	eq Apply(EmptyDisEq, SUB) = EmptyDisEq .
	eq Apply(NLE, none) = NLE .

*** *****Apply to Substitution

	op Apply(_,_) : Substitution Substitution -> Substitution .

	eq Apply((V <- T ; SUB), SUB1) = (V <- (Apply(T,SUB1)) ; Apply(SUB, SUB1)) .
	eq Apply(SUB , none) = SUB .
	ceq Apply(SUB1 , SUB) = SUB1 if SUB1 == none .
	eq Apply((V <- V1 ; SUB), ((V <- T); SUB1)) = Apply(SUB, (V <- T ; V1 <- T ; SUB1)) .
	eq Apply(fail, SUB) = fail .
	eq Apply(SUB, fail) = fail [owise] .

**********Apply to Problem .
	op Apply(_,_) : Problem Substitution -> Problem .

	eq Apply(UfPr || NLE || UfPr1 || N, SUB) = Apply(UfPr , SUB) || Apply(NLE, SUB) || sApply(UfPr1 , SUB) || N .
	eq Apply(FailProblem, SUB) = FailProblem .

****************************************
*******ConvertSubstitutionTo Equations

***for our inference system, we remember the substitution by set of equations. After get some result(mainly from syntactic unification), we need add these result into our list of solved equations.

	op UnifToEq : Substitution -> UnificationProblem .

	eq UnifToEq(V <- T) = (V =? T) .
	eq UnifToEq(none) = EmptyEq .
	ceq UnifToEq(AS ; SUB) = FailEquation if AS == fail .
	eq UnifToEq((AS ; SUB)) = UnifToEq(AS) /\ UnifToEq(SUB) .


***************************************************
**************Combing problem*********************
**************************************************

*******Sometimes, we need deal with some equationset sepratedly  and we need combine them back. 
	op comProblem : Problem Problem -> Problem [assoc comm] .

	eq comProblem(UfPr || NLE || UfPr1 || N , UfPr2 || NLE1 || UfPr3 || N1) = ((UfPr /\ UfPr2) || (NLE /\ NLE1) || (UfPr1 /\ UfPr3) || max(N, N1)) .
	eq comProblem(FailProblem , P) = FailProblem .

*****************************************
****Combine DeferentProblem***********
*****************************************

******This is for nondeterministic purpose. 

	op _$$_ : ProblemList ProblemList -> ProblemList [ctor assoc comm format (d d n d)].

	eq (FailProblem $$ P) = P .
	eq (FailProblem $$ PL) = PL .
	eq (P $$ P $$ PL) = PL .
	eq (EmptyProblem $$ PL) = PL .
	eq (EmptyProblem $$ P) = P .
	
****************************************
*******Reading Problems*****************
****************************************
********Reading problems from other moude file.
	vars Eqs Eqs1 : EquationSet .
	vars AtS1 AtS2 AtS3 AtS4 : AttrSet .
	op getXor : EquationSet -> Qid . ***Get the XOR symbol

	eq getXor(Eqs eq QI1[QI2 , QI3] = QI3[AtS1 label('UNITY)]. eq QI1[QI3, QI3] = QI2[AtS2 label('NilPotent)]. eq QI1[QI3, QI4] = QI1[QI4, QI3] [AtS3 label('Commutativity)]. eq QI1[QI3, QI1[QI4, QI5]] = QI1[QI1[QI3, QI4], QI5] [AtS4 label('Associativity)]. Eqs1) = QI1 .

	var opp : EquationSet .
	eq getXor(opp) = 'noTheoryFound [owise] .

	op getNil : EquationSet -> Qid .  ***Get the Unit symbol .

	eq getNil(Eqs eq QI1[QI2 , QI3] = QI3[AtS1 label('UNITY)]. eq QI1[QI3, QI3] = QI2[AtS2 label('NilPotent)]. eq QI1[QI3, QI4] = QI1[QI4, QI3] [AtS3 label('Commutativity)]. eq QI1[QI3, QI1[QI4, QI5]] = QI1[QI1[QI3, QI4], QI5] [AtS4 label('Associativity)]. Eqs1) = getName(QI2) .

	eq getNil(opp) = 'noTheoryFound [owise] .

	op getNilType : EquationSet -> Qid . ****Get the Unit type for the purpose of converting back ,

	op getNilType : EquationSet -> Qid . ****Get the Unit type for the purpose of converting back ,
	eq getNilType(Eqs eq QI1[QI2 , QI3] = QI3[AtS1 label('UNITY)]. eq QI1[QI3, QI3] = QI2[AtS2 label('NilPotent)]. eq QI1[QI3, QI4] = QI1[QI4, QI3] [AtS3 label('Commutativity)]. eq QI1[QI3, QI1[QI4, QI5]] = QI1[QI1[QI3, QI4], QI5] [AtS4 label('Associativity)]. Eqs1) = getType(QI2) .

	op getXorType : EquationSet -> Qid . ****Get the type for the purpose of generated new variables ,
	eq getXorType(Eqs eq QI1[QI2 , QI3] = QI3[AtS1 label('UNITY)]. eq QI1[QI3, QI3] = QI2[AtS2 label('NilPotent)]. eq QI1[QI3, QI4] = QI1[QI4, QI3] [AtS3 label('Commutativity)]. eq QI1[QI3, QI1[QI4, QI5]] = QI1[QI1[QI3, QI4], QI5] [AtS4 label('Associativity)]. Eqs1) = getType(QI3) .


*********The following is converting the datafile to our format. 

***	op ConvertEquation : Qid Qid EquationSet -> UnificationProblem .
	op ConvertXorNil : Qid Qid Qid Term -> Term .
	op ConvertXorNilL : Qid Qid Qid TermList -> TermList .
	op ConvertProblem : Qid Qid Qid UnificationProblem -> UnificationProblem .

	eq ConvertProblem(QI1, QI2 , QI5,  UP /\ UfPr2) = ConvertProblem(QI1, QI2, QI5, UP) /\ ConvertProblem(QI1, QI2, QI5, UfPr2) [owise] .
***	eq ConvertProblem('noTheoryFound, QI2 , QI5,  UfPr1) = UfPr1 .
	eq ConvertProblem('noTheoryFound, QI2 , QI5,  UfPr1) = noTheoryFoundProblem .

***	ceq ConvertProblem(QI1, 'noTheoryFound, QI5,  UfPr1) = UfPr1 if QI1 =/= 'noTheoryFound .
	ceq ConvertProblem(QI1, 'noTheoryFound, QI5,  UfPr1) = noTheoryFoundProblem if QI1 =/= 'noTheoryFound .

	eq ConvertProblem(QI1, QI2, QI5, EmptyEq) = EmptyEq .
	eq ConvertProblem(QI1, QI2, QI5, T =? T1) = ((ConvertXorNil(QI1, QI2, QI5, T)) =? (ConvertXorNil(QI1, QI2, QI5, T1))) . 

	eq ConvertXorNil(QI1 , QI2 , QI5, QI1[TL,T]) = XO(ConvertXorNilL(QI1, QI2, QI5, TL), ConvertXorNil(QI1, QI2, QI5, T)) .
	ceq ConvertXorNil(QI1 , QI2 , QI5, QI3[TL]) = QI3[ConvertXorNilL(QI1 , QI2 , QI5, TL)] if QI1 =/= QI3 .
	ceq ConvertXorNil(QI1 , QI2 , QI5, C) = NilTerm if getName(C) == QI2 /\ getType(C) == QI5 .
	eq ConvertXorNil(QI1 , QI2 , QI5, V) = V [owise] .
	eq ConvertXorNil(QI1 , QI2 , QI5, C) = C [owise] .
	eq ConvertXorNilL(QI1 , QI2 , QI5, (T, TL)) = (ConvertXorNil(QI1 , QI2 , QI5, T) , ConvertXorNilL(QI1 , QI2 , QI5,  TL)) .
	eq ConvertXorNilL(QI1 , QI2 , QI5, empty) = empty [owise] .
	
*** ***************************************
*** ******Initialization********************
*** ***************************************
********Initialization is used for convert T=?T1 to T+T1=0 .

	op Initial_ : UnificationProblem -> UnificationProblem .

	eq Initial(T =? T1) = XO(T , T1) =? NilTerm .
	eq Initial(UP /\ UfPr) = Initial(UP) /\ Initial(UfPr) .
	eq Initial(EmptyEq) = EmptyEq .
	eq Initial(noTheoryFoundProblem) = noTheoryFoundProblem .
	


*** ************************************
*** ******Purifying the equations********
*** ************************************

********make all the equation has no exclusive or symble under the function symble. 


	op purify : Type Problem -> Problem .
	op pure : Type TermList UnificationProblem Int -> NewVariableStatus .
	
		
	eq purify(TY, noTheoryFoundProblem || NLE || UfPr || N) = (noTheoryFoundProblem || NLE || UfPr || N) .
	eq pure(TY , T , UfPr , N)  = (T, UfPr , N) [owise] .
	ceq pure(TY , QI1[TL, T, TL1] , UfPr , N)  = pure(TY , QI1[TL, getNewResult(pure(TY , T, UfPr , N)), TL1], getNewEqs(pure(TY , T, UfPr , N)), getNewNum(pure(TY , T, UfPr , N))) if XOoccurs(T, 1) = true .
	eq pure(TY , XO(T , TL2), UfPr , N) = (GenNewVar(TY , N), (UfPr /\ (XO(GenNewVar(TY, N) , XO(T, TL2))) =? NilTerm) , N + 1) .

	eq pure(TY , empty , UfPr,  N) = (empty, UfPr, N) .
	ceq purify(TY , (QI1[TL1, T ,TL] =? NilTerm) || NLE || UfPr || N) = purify(TY , ((QI1[TL1, getNewResult(pure(TY , T, EmptyEq, N)), TL] =? NilTerm) /\ (getNewEqs(pure(TY , T, EmptyEq, N)))) || NLE || UfPr || getNewNum(pure(TY , T, EmptyEq, N))) if XOoccurs(T, 1) = true .
	ceq purify(TY , (XO(T, TL1) =? NilTerm) || NLE || UfPr || N) = purify(TY , ((XO(getNewResult(pure(TY , T, EmptyEq, N)), TL1) =? NilTerm) /\ getNewEqs(pure(TY , T, EmptyEq, N))) || NLE || UfPr || getNewNum(pure(TY , T, EmptyEq, N))) if XOoccurs(T, 0) = true .
	ceq purify(TY , (UP /\ UfPr) || NLE || UfPr1 || N) = purify(TY , comProblem(purify(TY , UP || NLE || UfPr1 || N) , UfPr || NLE || UfPr1 || N)) if XOoccurs(UP, 0) = true .
	eq purify(TY , UfPr || NLE || UfPr1 || N) = UfPr || NLE || UfPr1 || N [owise] .


*******************************************************************************************
*******************Inference System *******************************************************
*******************************************************************************************

******************Syntactic Unification*****************************************

	op syUnify : UnificandPair Substitution -> Substitution .

	op Decomp : TermList TermList Substitution -> Substitution .
	eq Decomp(T , T1, SUB) = syUnify((T =? T1) , SUB) .
	eq Decomp(T, T, SUB) = SUB .
	eq Decomp(empty, empty , SUB) = SUB .
	eq Decomp((T , TL), (T1 , TL1) , SUB) = Decomp(Apply(TL , Apply(syUnify(T =? T1 , SUB), syUnify(T =? T1, SUB))), Apply(TL1 , Apply(syUnify(T =? T1 , SUB) , syUnify(T =? T1, SUB))), Apply((syUnify(T =? T1 , SUB)), syUnify(T =? T1, SUB))) .

****Trivial *****
	eq syUnify(T =? T , SUB) = SUB .

****Decomposition****
	eq syUnify(QI1[TL] =? QI1[TL1], SUB) = Decomp(TL, TL1, SUB) [owise] .
	ceq syUnify(QI1[TL] =? QI1[TL1], SUB) = fail if getNumber(TL) =/= getNumber(TL1) .

****Symbol clash****
	ceq syUnify(QI2[TL] =? QI1[TL1] , SUB) = fail if QI1 =/= QI2 .
	ceq syUnify(C1 =? C, SUB ) = fail if C1 =/= C .

	eq syUnify(QI1[TL] =? C, SUB) = fail .
	eq syUnify(C =? QI1[TL] , SUB) = fail .

	eq syUnify(C =? NilTerm , SUB) = fail .
	eq syUnify(NilTerm =? C , SUB) = fail .

	eq syUnify(NilTerm =? QI1[TL] , SUB) = fail .
	eq syUnify(QI1[TL] =? NilTerm , SUB) = fail .


***Orient******

	ceq syUnify(T =? V, SUB) = syUnify(V =? T , SUB) if issingle(T) == false .

***Occurs check
	ceq syUnify(V =? T, SUB) = fail if occurs(V, T, 0) = true .

***Variable Elimination
	eq syUnify(V =? T, SUB) = (Apply(SUB , V <- T); V <- T) [owise] .


*************Semantic unification. 

*********Detect whether there is no problem to be solved. 
	op Detect : Problem -> Problem .
	
	eq Detect(EmptyEq || NLE || UfPr1 || N) = NoProblemFound .
	eq Detect((noTheoryFoundProblem || NLE || UfPr || N)) = noTheoryFoundProblemP .
	eq Detect(P) = DeInfer(P) [owise] .
************Deterministic Rule
	op DeInfer : Problem -> ProblemList .

***********Non-Deterministic Rule .
	op NDeInfer : Problem -> ProblemList .

*************Basic Rules

****************Trivial Rules.***********
	eq DeInfer(UfPr || NLE || FailEquation || N) = FailProblem .
	eq DeInfer(FailProblem) = FailProblem .

	eq DeInfer((NilTerm =? NilTerm) || NLE || UfPr1 || N) = EmptyEq || NLE || UfPr1 || N .
	eq DeInfer(((NilTerm =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = DeInfer(UfPr || NLE || UfPr1 || N) .

	eq DeInfer(UfPr || ((T N=? T) /\ NLE) || UfPr1 || N) = FailProblem .
	eq DeInfer(UfPr || ((T N=? T)) || UfPr1 || N) = FailProblem .


***************Varialbe Substitution***********
	ceq DeInfer(((V =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = DeInfer(Apply(UfPr || NLE || (UfPr1 /\ V =? NilTerm) || N, V <- NilTerm )) if occurs(V , UfPr , 0) = false . 
	eq DeInfer((V =? NilTerm) || NLE || UfPr1 || N) = Apply(EmptyEq || NLE || (UfPr1 /\ V =? NilTerm) || N, V <- NilTerm ) .

	ceq DeInfer(((XO(V, QI1[TL])=? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = DeInfer(Apply(UfPr || NLE || (UfPr1 /\ V =? QI1[TL]) || N, V <- QI1[TL] )) if occurs(V, QI1[TL] , 0) = false .
	ceq DeInfer((XO(V, QI1[TL])=? NilTerm) || NLE || UfPr1 || N) = Apply(EmptyEq || NLE || (UfPr1 /\ V =? QI1[TL]) || N, V <- QI1[TL] ) if occurs(V, QI1[TL] , 0) = false .


	ceq DeInfer((XO(V, TL) =? NilTerm /\ UfPr) || NLE || UfPr1 || N) = DeInfer(Apply(UfPr || NLE || (UfPr1 /\ V =? TL )|| N , V <- TL)) if occurs(V , (XO(V, TL) =? NilTerm )/\ UfPr , 0) = false .
	ceq DeInfer((XO(V, TL) =? NilTerm) || NLE || UfPr1 || N) = Apply(EmptyEq || NLE || (UfPr1 /\ V =? TL )|| N , V <- TL) if occurs(V, TL , 0) = false .


****************Clash  and Occurs Check***************************
	ceq DeInfer((XO(V, QI1[TL]) =? NilTerm) || NLE || UfPr1 || N) = FailProblem if occurs (V , TL , 1) .
	ceq DeInfer(((XO(V, QI1[TL]) =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = FailProblem if occurs (V , TL , 0) = true .

	ceq DeInfer((XO(V, XO(T, NeTL)) =? NilTerm) || NLE || UfPr1 || N) = FailProblem if occurs (V , T , 0) = true /\ AndOccurs(V, getSameFunctions(NeTL, getTopSymbol(T)), 0) = true /\ getOdd(getSameFunctions((T,NeTL), getTopSymbol(T)), 0) == 1 .
	ceq DeInfer(((XO(V, (T, NeTL)) =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = FailProblem if occurs (V , T , 0) = true /\ AndOccurs(V, getSameFunctions(NeTL, getTopSymbol(T)), 0) = true /\ getOdd(getSameFunctions((T,NeTL), getTopSymbol(T)), 0) == 1 .

	ceq DeInfer((((XO(T, TL)) =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = FailProblem if noFreeVariable(XO(T, TL))= true /\ getOdd(getSameFunctions((T,TL), getTopSymbol(T)), 0) == 1 .
	ceq DeInfer((((XO(T, TL)) =? NilTerm)) || NLE || UfPr1 || N) = FailProblem if noFreeVariable(XO(T, TL)) = true  /\ getOdd(getSameFunctions((T,TL), getTopSymbol(T)), 0) == 1 .

*****************Decomposition***************

	ceq DeInfer(((XO(QI1[TL], QI1[TL1], TL2) =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = DeInfer(Apply(((XO(empty, TL2) =? NilTerm) /\ UfPr) || NLE || (UfPr1 /\ UnifToEq(syUnify(QI1[TL] =? QI1[TL1] , none))) || N , syUnify(QI1[TL] =? QI1[TL1], none))) if getNumber(getSameFunctions(TL2, QI1)) == 0 /\ (PVOccurs(PureVariableL(TL2) , ((TL, TL1)))) .

	ceq DeInfer(((XO(QI1[TL], QI1[TL1], TL2) =? NilTerm) ) || NLE || UfPr1 || N) = DeInfer(Apply(((XO(empty, TL2) =? NilTerm)) || NLE || (UfPr1 /\ UnifToEq(syUnify(QI1[TL] =? QI1[TL1] , none))) || N , syUnify(QI1[TL] =? QI1[TL1], none))) if getNumber(getSameFunctions(TL2, QI1)) == 0 /\ (PVOccurs(PureVariableL(TL2) , ((TL, TL1)))).

	eq DeInfer(((XO(QI1[TL], QI1[TL1]) =? NilTerm) ) || NLE || UfPr1 || N) = DeInfer(Apply(EmptyEq || NLE || (UfPr1 /\ UnifToEq(syUnify(QI1[TL] =? QI1[TL1] , none))) || N , syUnify(QI1[TL] =? QI1[TL1], none))) .

	eq DeInfer(((XO(QI1[TL], QI1[TL1]) =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = DeInfer(Apply(UfPr || NLE || (UfPr1 /\ UnifToEq(syUnify(QI1[TL] =? QI1[TL1] , none))) || N , syUnify(QI1[TL] =? QI1[TL1], none))) .

************NonDetermistic Ruls********

	ceq NDeInfer(((XO(QI1[TL], QI1[TL1], TL2) =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = ((DeInfer(Apply(((XO(NilTerm, TL2) =? NilTerm) /\ UfPr) || NLE || (UfPr1 /\ UnifToEq(syUnify(QI1[TL] =? QI1[TL1] , none))) || N , syUnify(QI1[TL] =? QI1[TL1], none)))) $$ (DeInfer(((XO(QI1[TL], QI1[TL1], TL2) =? NilTerm) /\ UfPr) || (NLE /\ (XO(QI1[TL], QI1[TL1]) N=? NilTerm)) || UfPr1 || N))) if POccurs(NLE, (XO(QI1[TL],QI1[TL1]) N=? NilTerm)) = false .

	ceq NDeInfer(((XO(QI1[TL], QI1[TL1], TL2) =? NilTerm) ) || NLE || UfPr1 || N) = (DeInfer(Apply(((XO(NilTerm, TL2) =? NilTerm)) || NLE || (UfPr1 /\ UnifToEq(syUnify(QI1[TL] =? QI1[TL1] , none))) || N , syUnify(QI1[TL] =? QI1[TL1], none)))) $$ (DeInfer(((XO(QI1[TL], QI1[TL1], TL2) =? NilTerm) ) || (NLE /\ (XO(QI1[TL], QI1[TL1]) N=? NilTerm)) || UfPr1 || N)) if POccurs(NLE, (XO(QI1[TL], QI1[TL1]) N=? NilTerm)) = false .

*****************No rule Applies************

	eq DeInfer(UfPr || NLE || UfPr1 || N) = NDeInfer(UfPr || NLE || UfPr1 || N) [owise] .
	eq NDeInfer(P) = Process(P) [owise] .

*****************Final Disposal

	op Process : Problem -> Problem .

	ceq Process(UfPr || NLE || UfPr1 || N) = FailProblem if UfPr =/= EmptyEq .
	eq Process(P) = P [owise] .


****************************************
*****Getting the substitution***********
****************************************

************From the final problem to get the substitutions. nomally, if unificaitonproblem part is empty, we get solution, other wise, we get fail substitution

*******Converting result
	op GetSub(_) : Problem -> Substitution .
	
	eq GetSub(NoProblemFound) = noneNoProblemFound . ***if no problem was found in the file. 
	eq GetSub(UfPr || NLE || V =? T || N) = V <- T [owise] .
	ceq GetSub(UfPr || NLE || V =? T || N) = none if substr(string(getName(V)), 0, 3) == "NV#"  .
	eq GetSub(UfPr || NLE || (UP /\ UfPr1) || N) = (GetSub(UfPr || NLE || UP || N) ; GetSub(UfPr || NLE || UfPr1 || N)) .
	eq GetSub(FailProblem) = fail .
	eq GetSub(UfPr || NLE || EmptyEq || N) = none .

************** ### is used for combine several diferent substitution.

	op _###_ : SubstitutionList SubstitutionList -> SubstitutionList [ctor assoc comm format (d y no d)] .
	
	
	eq (none ### SUB) = SUB .
	eq (none ### SL) = SL .
	eq (SUB ### SUB ### SL) = (SUB ### SL) .
	

	op GetFinal(_) : ProblemList -> SubstitutionList .

	eq GetFinal((P $$ PL)) = GetSub(P) ### GetFinal(PL) .
	eq GetFinal(EmptyProblem) = none .
	eq GetFinal(NoProblemFound) = noneNoProblemFound .
	eq GetFinal(noTheoryFoundProblemP) = noneNoTheoryFound .
	eq GetFinal(P) = GetSub(P) [owise] .
	eq GetFinal(FailProblem) = fail .

***********Because we need get the counter of new variables. wthis  will be the final result.
	op _[NewVariablesCounter:_] : FinalSub Int -> FinalList [ctor format(d n r d o d)] .



*****************************************************
**************Get Final Result***********************
*****************************************************
***all the format is similar to the final answer except turn all the term to the original format .

****************convert the solution back ***********
	op _<-_ : Universal Universal -> FinalAss [ctor poly (1 2) format (nt d d d) ] .
	op _;_ : FinalSub FinalSub -> FinalSub [ctor assoc comm id: IDENTITY] .
	op _###_ : FinalSub FinalSub -> FinalSub [ctor assoc comm id: IDENTITY format (d ny on d)] .

************************************************
***********convert all the term to original format. 

	op ConvertBack : Qid Qid Qid Term -> Term .
	op ConvertBackL : Qid Qid Qid TermList -> TermList .

	eq ConvertBack(QI1, QI2, QI3 , NilTerm) = qid(string(QI2) + "." + string(QI3)) .
	eq ConvertBack(QI1, QI2, QI3 , V) = V .
	eq ConvertBack(QI1, QI2, QI3 , C) = C .
	eq ConvertBack(QI1, QI2, QI4 , QI3[TL]) = QI3[ConvertBackL(QI1, QI2, QI4, TL)] .
	eq ConvertBackL(QI1, QI2 , QI4 , (T, NeTL)) = (ConvertBack(QI1, QI2, QI4, T), ConvertBackL(QI1, QI2, QI4, NeTL)) .
	eq ConvertBackL(QI1, QI2, QI4 , T) = ConvertBack(QI1, QI2, QI4, T) .
	eq ConvertBack(QI1, QI2, QI4 , XO(T, TL)) = QI1[ConvertBackL(QI1, QI2, QI4, (T, TL))] .
	eq ConvertBackL(QI1, QI2, QI4, empty) = empty .

	eq (FASS ; FASS) = FASS .
	op NoSolution : -> FinalSub [ctor] .

**********************************
****************tern all the solution back .


	op BConvertList : Qid Qid Qid SubstitutionList -> FinalSub .
	eq BConvertList(QI1, QI2, QI3, (SUB ### SL)) = BConvertS(QI1, QI2, QI3, SUB) ### BConvertList(QI1, QI2, QI3 , SL) .

	eq BConvertList(QI1, QI2, QI3, fail) = NoSolution .
	eq BConvertList(QI1, QI2, QI3, noneNoProblemFound) = NoProblemFoundInFile .
	eq BConvertList(QI1, QI2, QI3, noneNoTheoryFound) = NoTheoryFoundInFile .
	eq BConvertList(QI1, QI2, QI3, SUB) = (BConvertS(QI1, QI2, QI3, SUB)) .

	op BConvertS : Qid Qid Qid Substitution -> FinalSub .
	eq BConvertS(QI1, QI2, QI3 , (AS ; SUB)) = BConvert(QI1, QI2, QI3, AS) ; BConvertS(QI1, QI2, QI3, SUB) .
	eq BConvertS(QI1, QI2, QI3, none) = IDENTITY .

	op BConvert : Qid Qid Qid Assignment -> FinalAss .

	eq BConvert(QI1, QI2, QI3, (V <- T)) = V <- ConvertBack(QI1, QI2, QI3, T) .


****************Final Command ************

******************SolveEqS is to solve the problem and output the solution.
	op solveEqS : UnificationProblem Qid Int -> FinalSub .

	eq solveEqS(UfPr, QI4, N) = BConvertList(getXor(getEqs(upModule(QI4, false))), getNil(getEqs(upModule(QI4, false))) , getNilType(getEqs(upModule(QI4, false))), GetFinal(Detect(purify(getXorType(getEqs(upModule(QI4, false))), Initial(ConvertProblem(getXor(getEqs(upModule(QI4, false))) , getNil(getEqs(upModule(QI4, false))), getNilType(getEqs(upModule(QI4, false))), UfPr)) || EmptyDisEq || EmptyEq || N)))) .

	op solveEqSM : UnificationProblem Module Int -> FinalSub .

	eq solveEqSM(UfPr, M:Module, N) = BConvertList(getXor(getEqs(M:Module)), getNil(getEqs(M:Module)) , getNilType(getEqs(M:Module)), GetFinal(Detect(purify(getXorType(getEqs(M:Module)), Initial(ConvertProblem(getXor(getEqs(M:Module)) , getNil(getEqs(M:Module)), getNilType(getEqs(M:Module)), UfPr)) || EmptyDisEq || EmptyEq || N)))) .


****************unf is similar to the solveEqs but output the counter as well. 
	op unf : UnificationProblem Qid Int -> FinalList .
	eq unf(UfPr, QI4, N) = (solveEqS(UfPr , QI4, N))[NewVariablesCounter:(getNewNum(purify(getXorType(getEqs(upModule(QI4, false))), Initial(ConvertProblem(getXor(getEqs(upModule(QI4, false))) , getNil(getEqs(upModule(QI4, false))), getNilType(getEqs(upModule(QI4, false))), UfPr)) || EmptyDisEq || EmptyEq || N)))] .

	op unfM : UnificationProblem Module Int -> FinalList .
	eq unfM(UfPr, M:Module, N) = (solveEqSM(UfPr , M:Module, N))[NewVariablesCounter:(getNewNum(purify(getXorType(getEqs(M:Module)), Initial(ConvertProblem(getXor(getEqs(M:Module)) , getNil(getEqs(M:Module)), getNilType(getEqs(M:Module)), UfPr)) || EmptyDisEq || EmptyEq || N)))] .


*************un is short cut for unf if we already know the theoryfile name is XTheory.maude
	op un : UnificationProblem Int -> FinalList .
	
	eq un(UfPr, N) = unf(UfPr, 'XTheory, N) .


**************the following codes just for testing purpose. 

*****solveEqs2 is to solving the problem without converting back the exlusive or and nilterm symbol.

	op solveEqs2 : UnificationProblem Int -> SubstitutionList .

	eq solveEqs2(UfPr, N) =  GetFinal(Detect(purify(getXorType(getEqs(upModule('XTheory, false))), Initial(ConvertProblem(getXor(getEqs(upModule('XTheory, false))) , getNil(getEqs(upModule('XTheory, false))), getNilType(getEqs(upModule('XTheory, false))), UfPr)) || EmptyDisEq || EmptyEq || N))) .

	op testInitial : UnificationProblem -> UnificationProblem .

	eq testInitial(UfPr) = Initial( testConvert(UfPr)) .

	op testPurify : UnificationProblem -> Problem .

	eq testPurify(UfPr) = purify('Test , testInitial(UfPr) || EmptyDisEq || EmptyEq || 0) .

	op testDetect : UnificationProblem -> Problem .
	
	eq testDetect(UfPr) = testPurify(UfPr) . 
******testConvert is used to test whether all the exclusive or symbol and nilterm can be converted to the proper form.

	op testConvert : UnificationProblem -> UnificationProblem . 
	eq testConvert(UfPr) = ConvertProblem(getXor(getEqs(upModule('XTheory, false))) , getNil(getEqs(upModule('XTheory, false))), getNilType(getEqs(upModule('XTheory, false))), UfPr) .

********************************************************
*******************Testing Area*************************
**********************************************************
	ops p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 : -> UnificationProblem .
	ops p10 p11 p12 p13 p14 p15 p16 p17 p18 p19 : -> UnificationProblem .
	ops p20 p21 p22 p23 p24 p25 p26 p27 p28 p29 p30 p31 p32 p33 p34 p35 p36 p37 p38 p39 : -> UnificationProblem .

	ops n1 n2 n3 n4 n5 n6 n7 n8 n9 n10 : -> ListOfDisEquations .
	ops ne : -> DisEquation .

	eq p1 = ('f['x:sort1, 'XOR['a.sort1, 'b.sort1']] =? ('g['x:sort1, 'b.sort1])) . ***No solution
 
	eq p2 = ('a.sort1 =? 'b.sort1) /\ ('f['x:sort1, 'XOR['a.sort1, 'b.sort1]] =? ('g['x:sort1, 'XOR['b.sort1, 'y:sort1]])) /\ ('XOR['a.sort1 , 'f['XOR['a.sort1, 'g['b.sort1 , 'XOR['c.sort1, 'd.sort1, 'z:sort1]]], 'y:sort1], 'g['y:sort1, 'x:sort1]] =? 'x:sort1) . 
*** No Solution
	eq p3 = ('XOR['f['XOR['x:sort1, 'g['XOR['f['y:sort1], 'z:sort1]]]], 'h['XOR['f['x:sort1], 'y:sort1']]] =? 'x:sort1) .
***No Solution

	eq p4 = ('f['x:sort1, 'XOR['a.sort1, 'b.sort1]]) =? ('f['x:sort1, 'XOR['b.sort1, 'z:sort1]]) .
***z<- a
	eq p5 = ('XOR['x:Term, 'f['y:Term]]) =? '0.sort2 .

****x< fy

	eq p6 = ('XOR['f['x:sort1], 'f['y:sort1], 'f['z:sort1]] =? '0.Term) .
***No Solution
	eq p7 = ('XOR['x:sort1, 'y:sort1, 'g['x:sort1, 'f['y:sort1]], 'f['x:sort1], 'f['g['x:sort1, 'x:sort1]], 'f['f['x:sort1]]] =? '0.Term) .
****No Solution
	eq p8 = ('f['a.sort] =? 'y:sort) .
***y<- fa
	eq p9 = ('f['a.sort] =? 'f['b.sort, 'z.sort]) .
***No Solution, This is a wrong equation.
	eq p10 = ('f['a.sort] =? 'g['b.sort, 'z.sort]) .

***No Solution .

	eq p11 = ('f['a.sort] =? 'g['b.sort]) .
***No Solution .
	eq p12 = ('f['a.sort] =? 'f['x:sort]) .
***x<- a
	eq p13 = ('XOR['f['x:sort], 'f['x:sort]] =? '0.Term) .
****Trivial true. Identity.
	eq p14 = ('f['x:sort, 'y:sort] =? 'f['x:sort, 'a.sort]) .
****y<- a
	eq p15 = ('f['x:sort, 'y:sort] =? 'f['c.sort, 'a.sort]) .
***x <- c, y<- a.

	eq p16 = ('f['x:sort, 'x:sort] =? 'f['c.sort, 'a.sort]) .
***No Solution
	eq p17 = ('f['x:sort, 'g['y:sort, 'b.sort]] =? 'f['c.sort, 'x:sort]) .
***No Solution
	eq p18 = ('f['x:sort, 'g['y:sort, 'b.sort]] =? 'f['c.sort, 'z:sort]) .
***x<-c, z<- g(y, b)
	eq p19 = ('f['x:sort, 'g['y:sort, 'b.sort]] =? 'f['c.sort, 'g['a.sort, 'z:sort]]) .
***x<-c, y<-a, z<-b
	eq p20 = ('f['x:sort, 'g['y:sort, 'b.sort]] =? 'f['c.sort, 'g['b.sort, 'y:sort]]) .
***x<-c, y<-b
	eq p21 = ('f['x:sort, 'g['y:sort, 'b.sort]] =? 'f['c.sort, 'g['b.sort, 'x:sort]]) .
***No Solution
	eq p22 = ('XOR['f['x:sort, 'g['y:sort, 'b.sort]], 'f['c.sort, 'g['a.sort, 'z:sort]], 'w:sort] =? '0.Term /\ ('XOR['f['w:sort], 'f['d.sort]] =? '0.Term)) .
***No Solution.

	eq p23 = ('XOR['f['x:sort, 'g['y:sort, 'w:sort]], 'f['c.sort, 'g['a.sort, 'z:sort]], 'w:sort, 'g['a.sort, 'c.sort]] =? '0.Term) .
*** w<- g(a, c)  x<-c, y<-a z<-g(a, c).

	eq p24 = (('XOR['x:sort, 'f['y:sort] , 'f['x1:sort]] =? '0.Term) /\ ('XOR['y:sort , 'f['z:sort], 'f['x2:sort]] =? '0.Term) /\ ('XOR['z:sort , 'f['x:sort] , 'f['x3:sort]] =? '0.Term)) .

***x1 <- (f(f0+fx3) + fx2) x<-0, y<- (f(f0+fx3) + fx2), z<- f0+fx3
***x2 <- (f(f0+fx1) + fx3) x<- f0+fx1, y<- 0, z<- (f(f0+fx1)+fx3)
***x3<- (f(f0+fx2)+fx1) x<-f(f0+fx2)+fx1  y<-f0+fx2 z<-0

	eq p25 = ('XOR['f['x:sort , 'a.sort], 'f['y:sort, 'a.sort] , 'f['b.sort, 'a.sort] , 'f['c.sort, 'a.sort]] =? '0.Term) .
***x<-b, y<-c
***x<-c, y<-b
	eq p26 = ('XOR['f['x:sort , 'a.sort], 'f['y:sort, 'a.sort] , 'f['b.sort, 'a.sort]] =? '0.Term) .
***No Solution.

	eq p27 = ('XOR['f['a.sort , 'x:sort], 'f['c.sort, 'y:sort] , 'f['x:sort, 'y:sort] , 'f['z:sort, 'z:sort]] =? '0.Term) .
***No Solution.


	eq p28 =('XOR['f['b.sort], 'f['0.Term], 'f['x:sort] , 'f['y:sort]]=? '0.Term) .
***x<-0, y<-b
***x<-b, y<-0
	eq p29 =('XOR['f['b.sort], 'f['0.Term], 'f['x:Term] , 'f['y:sort]]=? '0.Term) /\ ('x:Term =? '0.Term) .
****x<-0, y<-b


       eq p30 = 'XOR['g['g['XOR['2.Msg,'2.Msg],'f['^7:Msg,'^10:Msg]],'g['f['^5:Msg,'^12:Msg],'f['^8:Msg,'^10:Msg]]],'XOR['g['^4:Msg,'^6:Msg],'g['^8:Msg,'3.Msg]]] =? 'XOR['g['g['XOR['2.Msg,'&1:Msg],'f['XOR['&9:Msg,'2.Msg],'&16:Msg]],'g['f['&11:Msg,'g[
    '&8:Msg,'&3:Msg]],'f['&12:Msg,'&13:Msg]]],'XOR['g['g['&8:Msg,'&2:Msg],'&9:Msg],'g['&1:Msg,'&2:Msg]]] .

	eq p31 = 'XOR['g['^4:Msg,'^6:Msg],'g['^8:Msg,'3.Msg]] =? 'XOR['g['g['&8:Msg,'&2:Msg],'&9:Msg],'g['&1:Msg,'&2:Msg]] .

	eq p32 = 'g['g['XOR['2.Msg,'2.Msg],'f['^7:Msg,'^10:Msg]],'g['f['^5:Msg,'^12:Msg],'f['^8:Msg,'^10:Msg]]] =? 'g['g['XOR['2.Msg,'&1:Msg],'f['XOR['&9:Msg,'2.Msg],'&16:Msg]],'g['f['&11:Msg,'g[
    '&8:Msg,'&3:Msg]],'f['&12:Msg,'&13:Msg]]] .

	eq p33 = 'g['XOR['2.Msg,'2.Msg],'f['^7:Msg,'^10:Msg]] =? 'g['u['2.Msg,'&1:Msg],'f['XOR['&9:Msg,'2.Msg],'&16:Msg]] .

	eq p34 = 'XOR['2.Msg,'2.Msg] =? 'u['2.Msg,'&1:Msg] .

	eq p37 = 'f['^7:Msg,'^10:Msg] =? 'f['XOR['&9:Msg,'2.Msg],'&16:Msg] .

	eq p35 = 'XOR['2.Msg,'2.Msg] =? 'XOR['2.Msg,'&1:Msg] .

	eq p36 = 'g['g['XOR['2.Msg,'2.Msg],'f['^7:Msg,'^10:Msg]],'g['f['^5:Msg,'^12:Msg],'f['^8:Msg,'^10:Msg]]] =? 'g['^4:Msg,'^6:Msg] .

	eq p38 = 'pk['#4:Name,'_;_['#0:Msg,'XOR['#5:Name,'n['#4:Name,'#6:Fresh]]]] =? 'pk['#7:Name,'_;_['n['#8:Name,'#9:Fresh],'XOR['#8:Name,'#10:NNSet]]] .

	eq p39 = 'x:Term =? '0.sor2 .

	
endfm

fmod META-MSG-UNIFICATION is
  pr META-ACU-UNIFICATION .
  pr META-MATCH .
  pr unification 
   * (sort Problem to ProblemHE,
      op GenNewVar`(_`,_`) to GenNewVarHE`(_`,_`),
      op Solve(_,_,_) to metaHEUnify,
      op HasHomomorphism to IsMetaHEUnify,
      op getTypeHomomorphism to getTypeHomoUnify) .
  pr XorUnif 
   * (sort Problem to ProblemXOR,
      op GenNewVar`(_`,_`) to GenNewVarXOR`(_`,_`) ) .

  var M : Module .
  vars T T' T1# T2# T1$ T2$ T1 T2 : Term .
  vars N N' N'' N1# N2# : Nat .
  vars S S' S1# S2# LSubst RSubst : Substitution .
  var UP : UnificationProblem .
  vars UTS UTS' : UnificationTripleSet .
  var C : Constant .
  vars V V' V1 V2 V3 : Variable .
  vars F F1 F2 : Qid .
  vars TL TL1 TL1' TL1'' TL2 TL2' TL2'' : TermList .
  var NeTL : NeTermList .

  var U : UnificationPair .
  vars US US' : UnificationPairSet .
  var SS SS' : SubstitutionSet .
  vars TP TP' : Type .
  var TPS : TypeSet .
  var TPL : TypeList .
  var AtS : AttrSet .
  var OPDS : OpDeclSet .

  ******* metaBuiltInMatch ***********************************************
  op metaBuiltInMatch : Module Term Term -> SubstitutionSet .
                           *** T1 instance of T2
  eq metaBuiltInMatch(M, T1, T2)
   = if IsMetaHEUnify(M) or IsMetaXORUnify(M)
     then metaBuiltInMatch(M, T1, T2, highestVar((T1,T2)) + 1)
     else metaCoreMatch(M, T1, T2)
     fi . 

  op metaBuiltInMatch? : Module Term Term -> Bool .
                           *** T1 instance of T2
  eq metaBuiltInMatch?(M, T1, T2)
   = if IsMetaHEUnify(M) or IsMetaXORUnify(M)
     then metaBuiltInMatch?(M, T1, T2, highestVar((T1,T2)) + 1)  
     else metaCoreMatch?(M, T1, T2)
     fi . 

  op metaBuiltInMatch : Module Term Term Nat -> SubstitutionSet .
                       --- Term Lhs
  eq metaBuiltInMatch(M, T1, T2, N)
   = unrigidife(qid(N), 
       metaBuiltInMatch*(getM(rigidifeAllVar(M,qid(N),T1)), 
                         getTypeBuiltInUnify(M),
                         getTL(rigidifeAllVar(M,qid(N),T1)), 
                         T2, 
                         N + 1)
     ) . 

  op metaBuiltInMatch* : Module Type Term Term Nat -> SubstitutionSet .
  ceq metaBuiltInMatch*(M, TP, T1, T2, N)
    = if not (metaCoreMatch###(M,T1,T2#) :: SubstitutionSet)
         or 
         metaCoreMatch###(M,T1,T2#) == empty
      then empty
      else metaBuiltInMatch**(M,S2#,N2#,metaCoreMatch###(M,T1,T2#))
      fi 
   if (T2#,S2#,N2#) := generalize(M,TP,T2,N) .

  op metaCoreMatch### : Module Term Term -> SubstitutionSet .
  eq metaCoreMatch###(M,T1#,T2#)
   = metaCoreMatch(M,T1#,T2#) .

  op metaBuiltInMatch** : Module Substitution Nat
                          SubstitutionSet -> SubstitutionSet .
  eq metaBuiltInMatch**(M, S2#, N, SS)
   = metaBuiltInMatch**$(M, S2#, N, empty, SS) .

  op metaBuiltInMatch**$ : Module Substitution Nat
                           SubstitutionSet SubstitutionSet -> SubstitutionSet .
  eq metaBuiltInMatch**$(M, S2#, N, SS', empty)
   = SS' .
  eq metaBuiltInMatch**$(M, S2#, N, SS', S | SS)
   = metaBuiltInMatch**$(M, S2#, N, 
          SS' | metaBuiltInMatch***(M, S2#, N, S), 
          SS) .

  op metaBuiltInMatch*** : Module Substitution Nat 
                           Substitution -> SubstitutionSet .
 ceq metaBuiltInMatch***(M, 
      V1 <- T1 ; S1#, 
      N,
      V1 <- T2 ; S)
   = if not (metaMsgUnify*Msg(M, T1, T2, N) :: UnificationTripleSet)
        or
        metaMsgUnify*Msg(M, T1, T2, N) == empty
     then empty *** Error, no total unification is possible!!!
     else 
     metaBuiltInMatch****(M, 
      V1 <- T1 ; S1#, 
      N,
      V1,
      V1 <- T2 ; S,
      metaMsgUnify*Msg(M, T1, T2, N) 
     ) 
     fi 
  if F1[TL1] := T1 /\ F2[TL2] := T2 /\ F1 =/= F2 .
  eq metaBuiltInMatch***(M, S1#, N, S)
   = metaBuiltInMatch***#(M, S1#, N, S) [owise] .

  op metaBuiltInMatch***# : Module Substitution Nat 
                           Substitution -> SubstitutionSet .
  eq metaBuiltInMatch***#(M, 
      V1 <- T1 ; S1#, 
      N,
      V1 <- T2 ; S)
   = if not (metaMsgUnify*Msg(M, T1, T2, N) :: UnificationTripleSet)
        or
        metaMsgUnify*Msg(M, T1, T2, N) == empty
     then empty *** Error, no total unification is possible!!!
     else 
     metaBuiltInMatch****(M, 
      V1 <- T1 ; S1#, 
      N,
      V1,
      V1 <- T2 ; S,
      metaMsgUnify*Msg(M, T1, T2, N) 
     ) 
     fi .
  eq metaBuiltInMatch***#(M, S1#, N, S)
   = S << S1# [owise] .

  op metaBuiltInMatch**** : Module Substitution Nat Variable Substitution
                            UnificationTripleSet -> SubstitutionSet .
  eq metaBuiltInMatch****(M, 
      V1 <- T1 ; S1#, 
      N,
      V1,
      V1 <- T2 ; S,
      UTS)
   = metaBuiltInMatch****$(M, 
      V1 <- T1 ; S1#, 
      N,
      V1,
      V1 <- T2 ; S,
      empty,
      UTS) .

  op metaBuiltInMatch****$ : Module Substitution Nat Variable Substitution
                             SubstitutionSet UnificationTripleSet 
                          -> SubstitutionSet .
  eq metaBuiltInMatch****$(M, 
      V1 <- T1 ; S1#, 
      N,
      V1,
      V1 <- T2 ; S,
      SS',
      empty)
   = SS' . 
  eq metaBuiltInMatch****$(M, 
      V1 <- T1 ; S1#, 
      N,
      V1,
      V1 <- T2 ; S,
      SS',
      {LSubst,RSubst,N'} | UTS)
   = metaBuiltInMatch****$(M, 
      V1 <- T1 ; S1#, 
      N,
      V1,
      V1 <- T2 ; S,
      SS' 
      | metaBuiltInMatch***(M, 
           (V1 <- T1 ; S1#) << (LSubst ; RSubst), 
           N',
           S .. (LSubst ; RSubst))
      ,UTS) .

  op metaBuiltInMatch? : Module Term Term Nat -> Bool .
                       --- Term Lhs
  eq metaBuiltInMatch?(M, T1, T2, N)
   = metaBuiltInMatch*?(getM(rigidifeAllVar(M,qid(N),T1)), 
                        getTypeBuiltInUnify(M),
                        getTL(rigidifeAllVar(M,qid(N),T1)), 
                        T2, 
                        N + 1) . 

  op metaBuiltInMatch*? : Module Type Term Term Nat ~> Bool .
  ceq metaBuiltInMatch*?(M, TP, T1, T2, N)
    = if not (metaCoreMatch(M,T1,T2#) :: SubstitutionSet)
         or 
         metaCoreMatch(M,T1,T2#) == empty
      then false
      else metaBuiltInMatch**?(M,S2#,N2#,metaCoreMatch(M,T1,T2#))
      fi 
   if (T2#,S2#,N2#) := generalize(M,TP,T2,N) .

  op metaBuiltInMatch**? : Module Substitution Nat
                           SubstitutionSet -> Bool .
  eq metaBuiltInMatch**?(M, S2#, N, empty)
   = false .
  eq metaBuiltInMatch**?(M, S2#, N, S | SS)
   = metaBuiltInMatch***(M, S2#, N, S) =/= empty
     or-else
     metaBuiltInMatch**?(M, S2#, N, SS) .

  ******* metaBuiltInUnify ***********************************************
  op metaBuiltInUnify : Module Term Term -> SubstitutionSet .
  eq metaBuiltInUnify(M, T, T')
   = toSubstitution(metaBuiltInUnify(M, T, T', highestVar((T,T')) + 1)) .

  *** General Call for UnificationPairSet
  op metaBuiltInUnify : Module Term Term Nat -> UnificationTripleSet .
                       --- Term Lhs
  eq metaBuiltInUnify(M, T1, T2, N) 
   = if IsMetaHEUnify(M) or IsMetaXORUnify(M)
     then 
      minimizeBindingsTerm(M,Vars(T1),N,
             metaMsgUnify*(M, getTypeBuiltInUnify(M), T1, T2,N))
     else
      metaCoreUnify(M, T1, T2, N)
     fi . 

  op metaBuiltInUnify? : Module Term Term -> Bool .
  eq metaBuiltInUnify?(M, T, T')
   = metaBuiltInUnify?(M, T, T',highestVar((T,T')) + 1) .

  op metaBuiltInUnify? : Module Term Term Nat -> Bool .
  eq metaBuiltInUnify?(M, T1, T2, N) 
   = if IsMetaHEUnify(M) or IsMetaXORUnify(M)
     then 
      metaMsgUnify*?(M, getTypeBuiltInUnify(M), T1, T2,N)
     else
      metaCoreUnify?(M, T1, T2, N)
     fi . 

  *********** Unification other theories
  op metaMsgUnify* : Module Type Term Term Nat ~> UnificationTripleSet .
  ceq metaMsgUnify*(M, TP, T1, T2, N)
    = if not (metaCoreUnify(M,T1#,T2#,N2#) :: UnificationTripleSet)
         or 
         metaCoreUnify(M,T1#,T2#,N2#) == empty
      then empty
      else metaMsgUnify**(M,TP,Vars(T1),Vars(T2),
                          S1#,S2#,metaCoreUnify(M,T1#,T2#,N2#))
      fi 
   if (T1#,S1#,N1#) := generalize(M,TP,T1,N)
   /\ (T2#,S2#,N2#) := generalize(M,TP,T2,N1#) .

  op metaMsgUnify*? : Module Type Term Term Nat ~> Bool .
  ceq metaMsgUnify*?(M, TP,T1, T2, N)
    = metaCoreUnify?(M,T1#,T2#,N2#)
      and-then
      metaMsgUnify**?(M,TP,Vars(T1),Vars(T2),S1#,S2#,
          metaCoreUnify(M,T1#,T2#,N2#)
      )
   if (T1#,S1#,N1#) := generalize(M,TP,T1,N)
   /\ (T2#,S2#,N2#) := generalize(M,TP,T2,N1#) .

  op metaMsgUnify** : Module Type TermList TermList
                      Substitution Substitution 
                      UnificationTripleSet -> UnificationTripleSet .
  eq metaMsgUnify**(M, TP, TL1, TL2, S1#, S2#, UTS)
   = metaMsgUnify**#(M, TP,TL1, TL2, S1#, S2#, empty, UTS) .

  op metaMsgUnify**# : Module Type TermList TermList
                      Substitution Substitution 
                      UnificationTripleSet UnificationTripleSet
                   -> UnificationTripleSet .
  eq metaMsgUnify**#(M, TP, TL1, TL2, S1#, S2#, UTS', empty)
   = UTS' .
  eq metaMsgUnify**#(M, TP, TL1, TL2, S1#, S2#, UTS', {S,S',N} | UTS)
   = metaMsgUnify**#(M, TP, TL1, TL2, S1#, S2#, 
        UTS' | 
        metaMsgUnify***(M, TP, TL1, TL2, S1#, S2#, {S,S',N}),
        UTS) .

  op metaMsgUnify**? : Module Type TermList TermList
                       Substitution Substitution 
                       UnificationTripleSet -> Bool .
  eq metaMsgUnify**?(M, TP, TL1, TL2, S1#, S2#, empty)
   = false .
  eq metaMsgUnify**?(M, TP, TL1, TL2, S1#, S2#, {S,S',N} | UTS)
   = metaMsgUnify***(M, TP, TL1, TL2, S1#, S2#, {S,S',N}) =/= empty
     or-else
     metaMsgUnify**?(M, TP, TL1, TL2, S1#, S2#, UTS) .

  op metaMsgUnify*** : Module Type TermList TermList
                        Substitution Substitution 
                        UnificationTriple -> UnificationTripleSet .
  eq metaMsgUnify***(M, TP, TL1, TL2, S1#, S2#, {S,S',N})
   = metaMsgUnify***1st(M, TP, TL1, TL2, empty, empty, S1#, S2#, 
         {(S << S1#) << S2#, (S' << S1#) << S2#,N}
     ) .

  op metaMsgUnify***1st : Module Type TermList TermList
                          TermList TermList
                          Substitution Substitution 
                          UnificationTriple -> UnificationTripleSet .
 ceq metaMsgUnify***1st(M, TP, TL1, TL2, TL1', TL2',
      S1#, 
      S2#, 
      {V1 <- T2 ; S,S',N})
   = metaMsgUnify***1st(M, TP, TL1, TL2, (V1,TL1'), TL2',
      S1# << (V1 <- T2), 
      S2# << (V1 <- T2), 
      {V1 <- T2 ; S, S' << (V1 <- T2),N})
  if V1 in TL1 and-then (not V1 in TL1') 
     and-then 
     ( (not T2 :: Variable) 
       or
       (T2 :: Variable and-then T2 in TL2) ) .
 ceq metaMsgUnify***1st(M, TP, TL1, TL2, TL1', TL2',
      S1#, 
      S2#, 
      {S,V2 <- T1 ; S',N})
   = metaMsgUnify***1st(M, TP, TL1, TL2, TL1', (V2,TL2'),
      S1# << (V2 <- T1), 
      S2# << (V2 <- T1), 
      {S << (V2 <- T1), V2 <- T1 ; S',N})
  if V2 in TL2 and-then (not V2 in TL2') 
     and-then 
     ( (not T1 :: Variable) 
       or
       (T1 :: Variable and-then T1 in TL1) ) .
  eq metaMsgUnify***1st(M, TP, TL1, TL2, TL1', TL2', S1#, S2#, {S,S',N})
   = metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2', S1#, S2#, {S,S',N}) 
  [owise] .

  op metaMsgUnify***2nd : Module Type TermList TermList
                          TermList TermList
                          Substitution Substitution 
                          UnificationTriple -> UnificationTripleSet .
 ceq metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; V2 <- T2 ; S1#, 
      S2#, 
      {V1 <- V2 ; S,S',N})
   = if metaMsgUnify*Msg(M, T1, T2, N) == empty
     then empty
     else 
     metaMsgUnify****LL(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; V2 <- T2 ; S1#, 
      S2#, 
      V1,V2,
      {V1 <- V2 ; S,S',N},
      empty,
      metaMsgUnify*Msg(M, T1, T2, N) 
     ) 
     fi 
  if (not V1 in TL1) and-then (not V2 in TL1) .
 ceq metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2',
      S1#, 
      V1 <- T1 ; V2 <- T2 ; S2#, 
      {S,V1 <- V2 ; S',N})
   = if metaMsgUnify*Msg(M, T1, T2, N) == empty
     then empty
     else 
     metaMsgUnify****RR(M, TP, TL1, TL2, TL1', TL2',
      S1#, 
      V1 <- T1 ; V2 <- T2 ; S2#, 
      V1,V2,
      {S,V1 <- V2 ; S',N},
      empty,
      metaMsgUnify*Msg(M, T1, T2, N) 
     ) 
     fi 
  if (not V1 in TL2) and-then (not V2 in TL2) .
 ceq metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      V2 <- T2 ; S2#, 
      {V1 <- V2 ; S,S',N})
   = if metaMsgUnify*Msg(M, T1, T2, N) == empty
     then empty
     else 
     metaMsgUnify****L(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      V2 <- T2 ; S2#,
      V1,V2,
      {V1 <- V2 ; S,S',N},
      empty,
      metaMsgUnify*Msg(M, T1, T2, N) 
     ) 
     fi 
  if (not V1 in TL1) and-then (not V2 in TL2) .
 ceq metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      V2 <- T2 ; S2#, 
      {S,V2 <- V1 ; S',N})
   = if metaMsgUnify*Msg(M, T1, T2, N) == empty
     then empty
     else 
     metaMsgUnify****R(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      V2 <- T2 ; S2#, 
      V1,V2,
      {S,V2 <- V1 ; S',N},
      empty,
      metaMsgUnify*Msg(M, T1, T2, N) 
     ) 
     fi 
  if (not V1 in TL1) and (not V2 in TL2) .
 ceq metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      S2#, 
      {V1 <- T2 ; S,S',N})
   = if metaMsgUnify*Msg(M, T1, T2, N) == empty
     then empty
     else 
     metaMsgUnify****LC(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      S2#,
      V1,
      {V1 <- T2 ; S,S',N},
      empty,
      metaMsgUnify*Msg(M, T1, T2, N) 
     ) 
     fi 
  if not (T2 :: Variable and getType(T2) == TP) .
 ceq metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2',
      S1#, 
      V2 <- T1 ; S2#, 
      {S,V2 <- T2 ; S',N})
   = if metaMsgUnify*Msg(M, T1, T2, N) == empty
     then empty
     else 
     metaMsgUnify****RC(M, TP, TL1, TL2, TL1', TL2',
      S1#, 
      V2 <- T1 ; S2#,
      V2, 
      {S,V2 <- T2 ; S',N},
      empty,
      metaMsgUnify*Msg(M, T1, T2, N) 
     ) 
     fi 
  if not (T2 :: Variable and getType(T2) == TP) .
 ceq metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      S2#, 
      {V1 <- V2 ; S,S',N})
   = metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2',
      (V1 <- T1 ; S1#) << (V2 <- T1), 
      S2# << (V2 <- T1), 
      {S << (V2 <- T1),S' .. (V2 <- T1),N})
  if (not V1 in TL1) and-then V2 in TL2 and-then not (T1 :: Variable) .
 ceq metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2',
      S1#, 
      V2 <- T2 ; S2#, 
      {S,V2 <- V1 ; S',N})
   = metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2',
      S1# << (V1 <- T2), 
      (V2 <- T2 ; S2#) << (V1 <- T2), 
      {S .. (V1 <- T2),S' << (V1 <- T2),N})
  if (not V2 in TL2) and-then V1 in TL1 and-then not (T2 :: Variable) .
  eq metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2',
      (V2 <- T1) ; S1#, 
      S2#, 
      {(V1 <- V2) ; S, (V3 <- V2) ; S',N})
   = metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2',
      ((V2 <- T1) ; S1#) << (V1 <- T1), 
      S2# << (V3 <- T1), 
      {S .. (V1 <- T1), S' .. (V3 <- T1),N}) .
  eq metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2',
      S1#, 
      (V2 <- T1) ; S2#, 
      {(V1 <- V2) ; S, (V3 <- V2) ; S',N})
   = metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2',
      S1# << (V1 <- T1), 
      ((V2 <- T1) ; S2#) << (V3 <- T1), 
      {S .. (V1 <- T1), S' .. (V3 <- T1),N}) .
  eq metaMsgUnify***2nd(M, TP, TL1, TL2, TL1', TL2', 
      S1#, S2#, {S,S',N})
   = {S .. S2#,
      S' .. S1#,
      N} 
  [owise] .

  op metaMsgUnify****LC : Module Type TermList TermList
                          TermList TermList
                          Substitution Substitution 
                          Variable UnificationTriple
                          UnificationTripleSet UnificationTripleSet
                       -> UnificationTripleSet .
  eq metaMsgUnify****LC(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      S2#,
      V1,
      {V1 <- T2 ; S,S',N},
      UTS',empty)
   = UTS' . 
  eq metaMsgUnify****LC(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      S2#,
      V1,
      {V1 <- T2 ; S,S',N},
      UTS',
      {LSubst,RSubst,N'} | UTS)
   = metaMsgUnify****LC(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      S2#,
      V1,
      {V1 <- T2 ; S,S',N},
      metaMsgUnify***1st(M, TP, TL1, TL2, TL1', TL2',
        (V1 <- T1 ; S1#) << (LSubst ; RSubst), 
        S2# << (LSubst ; RSubst), 
        {S .. (LSubst ; RSubst),S' << (LSubst ; RSubst),N'})
      | UTS',
      UTS) .

  op metaMsgUnify****RC : Module Type TermList TermList
                          TermList TermList
                          Substitution Substitution 
                          Variable UnificationTriple
                          UnificationTripleSet UnificationTripleSet
                       -> UnificationTripleSet .
  eq metaMsgUnify****RC(M, TP, TL1, TL2, TL1', TL2',
      S1#, 
      V2 <- T1 ; S2#,
      V2, 
      {S,V2 <- T2 ; S',N},
      UTS',empty)
   = UTS' . 
  eq metaMsgUnify****RC(M, TP, TL1, TL2, TL1', TL2',
      S1#, 
      V2 <- T1 ; S2#,
      V2, 
      {S,V2 <- T2 ; S',N},
      UTS',
      {LSubst,RSubst,N'} | UTS)
   = metaMsgUnify****RC(M, TP, TL1, TL2, TL1', TL2',
      S1#, 
      V2 <- T1 ; S2#,
      V2, 
      {S,V2 <- T2 ; S',N},
      metaMsgUnify***1st(M, TP, TL1, TL2, TL1', TL2',
        S1# << (LSubst ; RSubst), 
        (V2 <- T1 ; S2#) << (LSubst ; RSubst), 
        {S << (LSubst ; RSubst),S' .. (LSubst ; RSubst),N'})
      | UTS',
      UTS) .

  op metaMsgUnify****LL : Module Type TermList TermList
                          TermList TermList
                          Substitution Substitution 
                          Variable Variable UnificationTriple
                          UnificationTripleSet UnificationTripleSet
                       -> UnificationTripleSet .
  eq metaMsgUnify****LL(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; V2 <- T2 ; S1#, 
      S2#, 
      V1,V2,
      {V1 <- V2 ; S,S',N},
      UTS',empty)
   = UTS' . *** Error, no total unification is possible!!!
  eq metaMsgUnify****LL(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; V2 <- T2 ; S1#, 
      S2#, 
      V1,V2,
      {V1 <- V2 ; S,S',N},
      UTS',
      {LSubst,RSubst,N'} | UTS)
   = metaMsgUnify****LL(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; V2 <- T2 ; S1#, 
      S2#, 
      V1,V2,
      {V1 <- V2 ; S,S',N},
      metaMsgUnify***1st(M, TP, TL1, TL2, TL1', TL2',
        (V1 <- T1 ; V2 <- T2 ; S1#) << (LSubst ; RSubst), 
        S2# << (LSubst ; RSubst), 
        {S .. (LSubst ; RSubst),S' << (LSubst ; RSubst),N'})
      | UTS',
      UTS) .

  op metaMsgUnify****L : Module Type TermList TermList
                          TermList TermList
                         Substitution Substitution 
                         Variable Variable UnificationTriple
                         UnificationTripleSet UnificationTripleSet
                      -> UnificationTripleSet .
  eq metaMsgUnify****L(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      V2 <- T2 ; S2#, 
      V1,V2,
      {V1 <- V2 ; S,S',N},
      UTS',empty)
   = UTS' . *** Error, no total unification is possible!!!
  eq metaMsgUnify****L(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      V2 <- T2 ; S2#, 
      V1,V2,
      {V1 <- V2 ; S,S',N},
      UTS',
      {LSubst,RSubst,N'} | UTS)
   = metaMsgUnify****L(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      V2 <- T2 ; S2#, 
      V1,V2,
      {V1 <- V2 ; S,S',N},
      metaMsgUnify***1st(M, TP, TL1, TL2, TL1', TL2',
        (V1 <- T1 ; S1#) << (LSubst ; RSubst), 
        (V2 <- T2 ; S2#) << (LSubst ; RSubst), 
        {(S .. LSubst) << RSubst,(S' .. RSubst) << LSubst,N'}) 
      | UTS',
      UTS) .

  op metaMsgUnify****R : Module Type TermList TermList
                         TermList TermList
                         Substitution Substitution 
                         Variable Variable UnificationTriple
                         UnificationTripleSet UnificationTripleSet
                      -> UnificationTripleSet .
  eq metaMsgUnify****R(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      V2 <- T2 ; S2#, 
      V1,V2,
      {S,V2 <- V1 ; S',N},
      UTS',empty)
   = UTS' . *** Error, no total unification is possible!!!
  eq metaMsgUnify****R(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      V2 <- T2 ; S2#, 
      V1,V2,
      {S,V2 <- V1 ; S',N},
      UTS',
      {LSubst,RSubst,N'} | UTS)
   = metaMsgUnify****R(M, TP, TL1, TL2, TL1', TL2',
      V1 <- T1 ; S1#, 
      V2 <- T2 ; S2#, 
      V1,V2,
      {S,V2 <- V1 ; S',N},
      metaMsgUnify***1st(M, TP, TL1, TL2, TL1', TL2',
        (V1 <- T1 ; S1#) << (LSubst ; RSubst), 
        (V2 <- T2 ; S2#) << (LSubst ; RSubst), 
        {(S .. LSubst) << RSubst,(S' .. RSubst) << LSubst,N'}) 
      | UTS',
      UTS) .

  op metaMsgUnify****RR : Module Type TermList TermList 
                          TermList TermList
                          Substitution Substitution 
                          Variable Variable UnificationTriple
                          UnificationTripleSet UnificationTripleSet
                       -> UnificationTripleSet .
  eq metaMsgUnify****RR(M, TP, TL1, TL2, TL1', TL2',
      S1#, 
      V1 <- T1 ; V2 <- T2 ; S2#, 
      V1,V2,
      {S,V1 <- V2 ; S',N},
      UTS',empty)
   = UTS' . *** Error, no total unification is possible!!!
  eq metaMsgUnify****RR(M, TP, TL1, TL2, TL1', TL2',
      S1#, 
      V1 <- T1 ; V2 <- T2 ; S2#, 
      V1,V2,
      {S,V1 <- V2 ; S',N},
      UTS',
      {LSubst,RSubst,N'} | UTS)
   = metaMsgUnify****RR(M, TP, TL1, TL2, TL1', TL2',
      S1#, 
      V1 <- T1 ; V2 <- T2 ; S2#, 
      V1,V2,
      {S,V1 <- V2 ; S',N},
      metaMsgUnify***1st(M, TP, TL1, TL2, TL1', TL2',
        S1# << (LSubst ; RSubst), 
        (V1 <- T1 ; V2 <- T2 ; S2#) << (LSubst ; RSubst), 
        {S << (LSubst ; RSubst),S' .. (LSubst ; RSubst),N'})
      | UTS',
      UTS) .

  ********************************************************************
  *** Here we can easily integrate different unification procedures
  ********************************************************************
  op metaMsgUnify*Msg : Module Term Term Nat -> UnificationTripleSet .

  ceq metaMsgUnify*Msg(M, T, T', N) 
    = split(metaOrderSortedFilter(M,{orient(M,S),N'}),T,T')
   if IsMetaHEUnify(M) ***
   /\ unifiable ; S ; N' := metaHEUnify(M, T ~ T', N) .

  ceq metaMsgUnify*Msg(M, T, T', N) 
    = split(metaOrderSortedFilter(M,orient(M,SS,N')),T,T')
   if IsMetaXORUnify(M) ***
   /\ S:FinalSub [NewVariablesCounter: N']  := unfM(T =? T', M, N) 
   /\ SS := convertToSubs(S:FinalSub) .

  eq metaMsgUnify*Msg(M, T, T', N) 
   = empty [owise] .

  ****
  op orient : Module SubstitutionSet Nat -> UnificationPairSet .
  eq orient(M,empty,N) = empty .
  eq orient(M,S | SS,N) = {orient*(M,S),N} | orient(M,SS,N) .

  op orient : Module SubstitutionSet -> SubstitutionSet .
  eq orient(M,empty) = empty .
  eq orient(M,S | SS) = orient*(M,S) | orient(M,SS) .

  op orient* : Module Substitution -> Substitution .
  eq orient*(M,S) = orient**(M,none,S) .

  op orient** : Module Substitution Substitution -> Substitution .
 ceq orient**(M,S',V1 <- V2 ; S)
   = orient**(M,S' .. (V2 <- V1), S << (V2 <- V1))
  if typeLeq(M,getType(V1),getType(V2)) 
     and-then 
     not typeLeq(M,getType(V2),getType(V1)) .
  eq orient**(M,S',S)
   = S' ; S [owise] .

  ****
  op IsMetaXORUnify : Module -> Bool .
  eq IsMetaXORUnify(M)
   = getXor(getEqs(M)) :: Qid and getXor(getEqs(M)) =/= 'noTheoryFound .

  op getTypeBuiltInUnify : Module -> Type .
  eq getTypeBuiltInUnify(M)
   = if IsMetaHEUnify(M) 
     then getTypeHomoUnify(M)
     else if IsMetaXORUnify(M)
          then getXorType(getEqs(M))
          else 'Msg
          fi
     fi .

  ****
  op convertToSubs : FinalSub -> SubstitutionSet .
  eq convertToSubs(NoSolution) 
   = empty .
 ceq convertToSubs(S1:FinalSub ### S2:FinalSub) 
   = convertToSubs(S1:FinalSub) | convertToSubs(S2:FinalSub) 
  if S1:FinalSub =/= IDENTITY and S2:FinalSub =/= IDENTITY .
  eq convertToSubs(S:FinalSub) = convertToSubsE(S:FinalSub) [owise] .

  op convertToSubsE : FinalSub -> Substitution .
  eq convertToSubsE(IDENTITY) = none .
  eq convertToSubsE((T1:Term <- T2:Term) ; S2:FinalSub) = T1:Term <- T2:Term ; convertToSubsE(S2:FinalSub) .

  ********************************************************************
  *** generalize terms of sort Msg
  ********************************************************************

  sort TripleGenVar .
  op `(_`,_`,_`) : TermList Substitution Nat -> TripleGenVar .
  op getTL : TripleGenVar -> Term .
  eq getTL((TL,S,N)) = TL .
  op getS : TripleGenVar -> Substitution .
  eq getS((TL,S,N)) = S .
  op getN : TripleGenVar -> Nat .
  eq getN((TL,S,N)) = N .

  op getOpEqs : Module ~> OpDeclSet .
  eq getOpEqs(M) = getOpEqs(M,getEqs(M)) .
  op getOpEqs : Module EquationSet ~> OpDeclSet .
  eq getOpEqs(M,none) 
   = none .
  ***eq getOpEqs(M, (eq T = V [A:AttrSet] .) Eqs:EquationSet) 
  *** This case is an error, so the function is ~>
  eq getOpEqs(M, (eq F1[TL1] = F2[TL2] [A:AttrSet] .) Eqs:EquationSet) 
   = getOpsOfQid(M,F1,getTypes(M,TL1)) 
     getOpsOfQid(M,F2,getTypes(M,TL2)) 
     getOpEqs(M,Eqs:EquationSet) .
  eq getOpEqs(M, (eq F1[TL1] = C [A:AttrSet] .) Eqs:EquationSet) 
   = getOpsOfQid(M,F1,getTypes(M,TL1)) 
     getOpsOfQid(M,C,nil) 
     getOpEqs(M,Eqs:EquationSet) .
  eq getOpEqs(M, (eq C = F2[TL2] [A:AttrSet] .) Eqs:EquationSet) 
   = getOpsOfQid(M,C,nil) 
     getOpsOfQid(M,F2,getTypes(M,TL2)) 
     getOpEqs(M,Eqs:EquationSet) .

  op _in[_]_ : Term Module OpDeclSet -> Bool .
  eq C in[M] ((op C : nil -> TP [A:AttrSet] .) O:OpDeclSet) = true .
 ceq F[TL] in[M] ((op F : TPL -> TP [A:AttrSet] .) O:OpDeclSet) = true
  if typeLeq(M,leastSort(M,F[TL]),TP) .
  eq T in[M] O:OpDeclSet = false [owise] .

  op generalize : Module Type Term Nat -> TripleGenVar .
  eq generalize(M,TP,T,N) 
   = generalize$(M,TP,T,N) .

  op generalize$ : Module Type Term Nat -> TripleGenVar .
  eq generalize$(M,TP,T,N) 
   = if typeLeq(M,leastSort(M,T),TP)
        and-then
        (not (getOpEqs(M) :: OpDeclSet)
         or-else 
         (getOpEqs(M) :: OpDeclSet and-then T in[M] getOpEqs(M)) 
        )
     then (newVar(N,leastSort(M,T)),newVar(N,leastSort(M,T)) <- T,N + 1)
     else simplifyGen(generalize$*(M,TP,T,N))
     fi .

  op generalize$* : Module Type Term Nat -> TripleGenVar .
  eq generalize$*(M,TP,C,N) = (C,none,N) .
  eq generalize$*(M,TP,V,N) = (V,none,N) .
  eq generalize$*(M,TP,F[NeTL],N) 
   = (F[getTL(generalize$*TL(M,TP,NeTL,N))],
      getS(generalize$*TL(M,TP,NeTL,N)),
      getN(generalize$*TL(M,TP,NeTL,N))) .

  op generalize$*TL : Module Type TermList Nat -> TripleGenVar .
  eq generalize$*TL(M,TP,empty,N) 
   = (empty,none,N) .
  eq generalize$*TL(M,TP,(T,TL),N) 
   = ((getTL(generalize$(M,TP,T,N)), 
       getTL(generalize$*TL(M,TP,TL,getN(generalize$(M,TP,T,N))))),
      (getS(generalize$(M,TP,T,N)) 
        ; getS(generalize$*TL(M,TP,TL,getN(generalize$(M,TP,T,N))))),
      getN(generalize$*TL(M,TP,TL,getN(generalize$(M,TP,T,N)))))  .

  op simplifyGen : TripleGenVar -> TripleGenVar .
  eq simplifyGen((TL,V1 <- T ; V2 <- T ; S,N))
   = simplifyGen((TL << (V2 <- V1),V1 <- T ; (S << (V2 <- V1)),N)) .
  eq simplifyGen((TL,S,N))
   = (TL,S,N) [owise] .

  ********************************************************************
  *** Order-sorted filtering
  ********************************************************************

  op metaOrderSortedFilter : Module 
                             UnificationPairSet -> UnificationPairSet .
  eq metaOrderSortedFilter(M,US)
   = metaOrderSortedFilter*(M,empty,US) .

  op metaOrderSortedFilter* : Module UnificationPairSet
                              UnificationPairSet -> UnificationPairSet .
  eq metaOrderSortedFilter*(M,US',empty)
   = US' .
  eq metaOrderSortedFilter*(M,US',U | US)
   = metaOrderSortedFilter*(M,US' | metaOrderSortedFilterE(M,none,U),US) .

  op metaOrderSortedFilterE : Module Substitution
                              UnificationPair -> UnificationPairSet .
  eq metaOrderSortedFilterE(M,S',{none,N})
   = {S',N} .
  ceq metaOrderSortedFilterE(M,S',{V <- T ; S,N})
    = empty
   if glbSorts(M,getType(V),leastSort(M,T)) == none .
  eq metaOrderSortedFilterE(M,S',{V <- T ; S,N})
   = metaOrderSortedFilterE*(M,S',{V <- T ; S,N}) 
  [owise] .

  op metaOrderSortedFilterE* : Module Substitution
                               UnificationPair -> UnificationPairSet .
  eq metaOrderSortedFilterE*(M,S',{none,N})
   = {S',N} .
  ceq metaOrderSortedFilterE*(M,S',{V <- T ; S,N})
    = metaOrderSortedFilterE*(M,S' ; V <- T,{S,N})
   if typeLeq(M,leastSort(M,T),getType(V)) .
  eq metaOrderSortedFilterE*(M,S',{V <- T ; S,N})
   = metaOrderSortedFilterE*C(M,S',{V <- T ; S,N}) 
  [owise] .

  op metaOrderSortedFilterE*C : Module Substitution
                              UnificationPair -> UnificationPairSet .
  eq metaOrderSortedFilterE*C(M,S',{none,N})
   = {S',N} .
  eq metaOrderSortedFilterE*C(M,S',{V <- C ; S,N})
    = empty .
  eq metaOrderSortedFilterE*C(M,S',{V <- T ; S,N})
   = metaOrderSortedFilterE*F(M,S',{V <- T ; S,N})
  [owise] .

  op metaOrderSortedFilterE*F : Module Substitution
                                UnificationPair -> UnificationPairSet .
  eq metaOrderSortedFilterE*F(M,S',{none,N})
   = {S',N} .
 ceq metaOrderSortedFilterE*F(M,S',{V <- F[TL] ; S,N})
   = metaOrderSortedFilterE(M,
       (S' .. (V <- F[newVar(N,getTypes(M,TL))]))
        << metaOrderSortedFilterE*F#(newVar(N,getTypes(M,TL)),TL),
       {(S << (V <- F[newVar(N,getTypes(M,TL))]))
        .. metaOrderSortedFilterE*F#(newVar(N,getTypes(M,TL)),TL)
        ,N + size(TL)}
     ) 
  if TPL := getTypes(M,TL)
  /\ (op F : TPL -> TP [AtS] .) OPDS := getOpsOfQid(M,F,TPL) 
  /\ TP' ; TPS := glbSorts(M,getType(V),leastSort(M,F[TL]))
  /\ typeLeq(M,TP,TP') .

  eq metaOrderSortedFilterE*F(M,S',{V <- F[TL] ; S,N})
   = empty
  [owise] .

  eq metaOrderSortedFilterE*F(M,S',{V <- V' ; S,N})
   = metaOrderSortedFilterE*V(M,S',V,V',{S,N},
                              glbSorts(M,getType(V),getType(V'))) 
  [owise] .

  op metaOrderSortedFilterE*F# : TermList TermList -> Substitution .
  eq metaOrderSortedFilterE*F#(empty,empty) 
   = none .
  eq metaOrderSortedFilterE*F#((T1,TL1),(T2,TL2)) 
   = T1 <- T2 ; metaOrderSortedFilterE*F#(TL1,TL2) . 

  op metaOrderSortedFilterE*V : Module Substitution Variable Variable
                               UnificationPair TypeSet -> UnificationPairSet .
  eq metaOrderSortedFilterE*V(M,S',V,V',{S,N},none)
   = empty .
  eq metaOrderSortedFilterE*V(M,S',V,V',{S,N},TP TPS)
   = metaOrderSortedFilter(M,
       {(S' ; S) .. (V <- newVar(N,TP) ; V' <- newVar(N,TP)), 
        N + 1}
     ) 
     |
     metaOrderSortedFilterE*V(M,S',V,V',{S,N},TPS) .
  eq metaOrderSortedFilterE*V(M,S',V,T,{S,N},TPS)
   = empty
  [owise] .


endfm
fmod ORDERS-TERM-SUBSTITUTION is
  protecting TERM-HANDLING .
  protecting SUBSTITUTION-HANDLING .
  protecting META-MATCH .
  protecting META-LEVEL .
  protecting META-UNIFICATION .
  protecting META-E-UNIFICATION .
  protecting RENAMING .
  protecting SUBSTITUTIONSET .
  protecting META-MSG-UNIFICATION .

  vars T T' : Term .
  vars TL TL' TL1 TL2 TL3 : TermList .
  var M : Module .
  vars S S' : Substitution .
  vars SS SS' : SubstitutionSet .
  vars V V' V1 V2 : Variable .
  vars TPL TPL' : TypeList .
  vars N N' : Nat .
  vars F : Qid .

  --- metaEMatch(M,T,T') implies that T is an instance of T' modulo E + axioms
  op metaEMatch : Module Term Term -> SubstitutionSet .
  eq metaEMatch(M,T,T')
   = if metaCoreMatch(M,T,T') =/= empty
     then metaCoreMatch(M,T,T')
     else if metaEBuiltInUnifyIrr?(M,T,T')
          then metaShared-filter(M,T,T',metaEBuiltInUnifyIrr(M,T,T'))
          else empty
          fi
     fi .

  op metaEMatch? : Module Term Term -> Bool .
  eq metaEMatch?(M,T,T')
   = metaCoreMatch?(M,T,T') 
     or-else
     metaEBuiltInUnifyIrr?(M,T,T') .

  --- order between terms ---------------------------
  --- T <=[M] T' implies that T' is an instance of T
  op _<=[_]_ : Term Module Term -> Bool .
  eq T <=[M] T' = (metaCoreMatch(M,T',T) |> T) =/= empty .

  --- order between substitutions ---------------------------
  --- Subst <=[M] Subst' implies that Subst' is an instance of Subst
  op _<=[_]_ : SubstitutionSet Module SubstitutionSet -> Bool [ditto] .
  eq SS <=[M] SS'
   = SS <=[empty,M] SS' .

  op _<=[_`,_]_ : SubstitutionSet TermList Module SubstitutionSet -> Bool .
  eq empty <=[TL,M] SS'
   = false .
  eq SS <=[TL,M] SS'
   = SS <=[TL,M]$ SS' [owise] .

  op _<=[_`,_]$_ : SubstitutionSet TermList Module SubstitutionSet -> Bool .
  eq SS <=[TL,M]$ empty
   = true .
  eq SS <=[TL,M]$ (S' | SS')
   = (SS <=[TL,M]* S') and-then SS <=[TL,M]$ SS' .

  op _<=[_`,_]*_ : SubstitutionSet TermList Module Substitution -> Bool .
  eq empty <=[TL,M]* S'
   = false .
  eq (S | SS) <=[TL,M]* S'
   = S <=[TL,M]** S' or-else SS <=[TL,M]* S' .

  op _<=[_`,_]**_ : Substitution TermList Module Substitution -> Bool .
  eq none <=[TL,M]** S'
   = true . 
  eq S <=[TL,M]** S' 
   = 'Q[1st(gen(TL,S,S'))] 
     *<=[ 
       addSorts('XXX,
       addOps((op 'Q : 3rd(gen(TL,S,S')) -> 'XXX [none] .),
         M)) 
     ]*
     'Q[2nd(gen(TL,S,S'))] 
  [owise] .

  --- T <=[M] T' implies that T' is an instance of T
  --- T and T' can have shared variables
  op _*<=[_]*_ : Term Module Term -> Bool .
  eq T *<=[M]* T' 
   = (if anyVars T inVars T'
      then metaCoreMatchShared(M,T',T)
      else metaCoreMatch(M,T',T)
      fi |> T) 
     =/= empty .

  sort Triple . 
  op {{_`,_`,_}} : TermList TermList TypeList -> Triple .
  op 1st : Triple -> TermList .
  eq 1st({{TL,TL',TPL}}) = TL .
  op 2nd : Triple -> TermList .
  eq 2nd({{TL,TL',TPL}}) = TL' .
  op 3rd : Triple -> TypeList .
  eq 3rd({{TL,TL',TPL}}) = TPL .

  ops gen : TermList Substitution Substitution -> Triple . ---[memo] .
  eq gen(empty,none,none) 
   = {{empty,empty,nil}} .
  eq gen((V,TL),none,none) 
   = {{(V,1st(gen(TL,none,none))),
       (V,2nd(gen(TL,none,none))),
       (getType(V) 3rd(gen(TL,none,none)))}} .
  eq gen(TL,none,V <- T ; S') 
   = {{(V,1st(gen(TL \\ V,none,S'))),
       (T,2nd(gen(TL \\ V,none,S'))),
       (getType(V) 3rd(gen(TL \\ V,none,S')))}} .
  eq gen(TL,V <- T ; S,V <- T' ; S')
   = {{(T,1st(gen(TL \\ V,S,S'))),
       (T',2nd(gen(TL \\ V,S,S'))),
       (getType(V) 3rd(gen(TL \\ V,S,S')))}} .
  eq gen(TL,V <- T ; S,S') 
   = {{(T,1st(gen(TL \\ V,S,S'))),
       (V,2nd(gen(TL \\ V,S,S'))),
       (getType(V) 3rd(gen(TL \\ V,S,S')))}} 
   [owise] . 

  op _\\_ : TermList Variable -> TermList .
  eq (TL,V,TL') \\ V = (TL,TL') .
  eq TL \\ V = TL [owise] .

  --- renaming -----------------------------------------------
  op _=[_]=_ : TermSet Module TermSet -> Bool .
  eq T1:TermSet =[M]= T2:TermSet 
   = metaBuiltInRenaming(M,T1:TermSet,T2:TermSet) .

  op metaCoreRenaming : Module TermSet TermSet -> Bool .
  eq metaCoreRenaming(M,emptyTermSet,emptyTermSet)
   = true .
 ceq metaCoreRenaming(M,T:Term | T:TermSet,T':Term | T':TermSet)
    = metaCoreRenaming(M,T:TermSet,T':TermSet)
   if metaCoreRenaming$(M,T:Term,T':Term) .
  eq metaCoreRenaming(M,T:TermSet,T':TermSet)
   = false [owise] .

  op metaCoreRenaming$ : Module Term Term -> Bool .
  eq metaCoreRenaming$(M,T:Term,T':Term)
   = metaCoreRenaming$$(M,canonice(M,T:Term),canonice(M,T':Term)) .

  op metaCoreRenaming$$ : Module Term Term -> Bool .
  eq metaCoreRenaming$$(M,T:Term,T':Term)
   = T == T'
     or-else 
     onlyRenaming(M,metaCoreMatchShared(M,T',T) |> T) .

  *****
  op metaBuiltInRenaming : Module TermSet TermSet -> Bool .
  eq metaBuiltInRenaming(M,emptyTermSet,emptyTermSet)
   = true .
 ceq metaBuiltInRenaming(M,T:Term | T:TermSet,T':Term | T':TermSet)
    = metaBuiltInRenaming(M,T:TermSet,T':TermSet)
   if metaBuiltInRenaming$(M,T:Term,T':Term) .
  eq metaBuiltInRenaming(M,T:TermSet,T':TermSet)
   = false [owise] .

  op metaBuiltInRenaming$ : Module Term Term -> Bool .
  eq metaBuiltInRenaming$(M,T:Term,T':Term)
   = metaBuiltInRenaming$$(M,canonice(M,T:Term),canonice(M,T':Term)) .

  op metaBuiltInRenaming$$ : Module Term Term -> Bool .
  eq metaBuiltInRenaming$$(M,T:Term,T':Term)
   = T == T'
     or-else 
     onlyRenaming(M,metaBuiltInMatchShared(M,T',T) |> T) .

  *****
  op onlyRenaming : Module SubstitutionSet -> Bool .
  eq onlyRenaming(M,empty) 
   = false .
  eq onlyRenaming(M,S | SS)
   = onlyRenaming*(M,S) 
     or-else 
     onlyRenaming(M,SS) .

  op onlyRenaming* : Module Substitution -> Bool .
  eq onlyRenaming*(M,(V <- T) ; (V' <- T) ; S)
   = false .
  eq onlyRenaming*(M,S) 
   = onlyRenaming**(M,S) [owise] .

  op onlyRenaming** : Module Substitution -> Bool .
 ceq onlyRenaming**(M,(V <- F[TL]) ; S)
   = onlyRenaming*(M,
        canonice(M, S << (V1 <- getIdSymbol(M,F[TL])))
     ) 
  if getIdSymbol(M,F[TL]) :: Term
  /\ TL1,V1,TL2,V2,TL3 := TL
  /\ typeLeq(M,getType(getIdSymbol(M,F[TL])),getType(V1))
     and-then
     not (V1 in Vars((TL1,TL2,V2,TL3)))
  /\ typeLeq(M,getType(getIdSymbol(M,F[TL])),getType(V2))
     and-then
     not (V2 in Vars((TL1,V1,TL2,TL3))) .
  eq onlyRenaming**(M,S)
   = onlyRenaming***(S) [owise] .

  op onlyRenaming*** : Substitution -> Bool .
  eq onlyRenaming***(none) 
   = true .
  eq onlyRenaming***((V <- T) ; S)
   = T :: Variable 
     and-then 
     getType(V) == getType(T)
     and-then
     onlyRenaming***(S) .

  --- Standard metaMatch does not deal with shared variables between T and T'  
  --- metaCoreMatch(M,T,T') implies that T is an instance of T'

  op metaCoreMatchShared : Module Term Term -> SubstitutionSet .
  eq metaCoreMatchShared(M,T,T')
   = metaShared-filter(M,T,T',metaCoreMatch(M,T,T')) .

  op metaBuiltInMatchShared : Module Term Term -> SubstitutionSet .
  eq metaBuiltInMatchShared(M,T,T')
   = metaShared-filter(M,T,T',metaBuiltInMatch(M,T,T')) .

  *******
  op metaShared-filter : Module Term Term SubstitutionSet
                           -> SubstitutionSet .
  eq metaShared-filter(M,T,T',SS)
   = metaShared-filter*(M,T,T',empty,SS) .

  op metaShared-filter* : Module Term Term SubstitutionSet SubstitutionSet 
                           -> SubstitutionSet .
  eq metaShared-filter*(M,T,T',SS',empty)
   = SS' .
  eq metaShared-filter*(M,T,T',SS',S | SS)
   = metaShared-filter*(M,T,T',
        if S |> T == none 
        then SS' | S
        else SS'
        fi,
     SS ) .


  *** Normalize Substitutions
  op normalizedSubstitution? : Module SubstitutionSet -> Bool .
  eq normalizedSubstitution?(M, empty)
   = true .
  eq normalizedSubstitution?(M, S | SS)
   = normalizedSubstitution?*(M, S) and-then normalizedSubstitution?(M, SS) .

  op normalizedSubstitution?* : Module Substitution -> Bool . ---[memo] .
  eq normalizedSubstitution?*(M, none)
   = true .
  eq normalizedSubstitution?*(M, V <- T ; S:Substitution)
   = isNF$(clearAllFrozen(M),T) 
     and-then 
     normalizedSubstitution?*(M, S:Substitution) .

  *** Normalize Substitutions
  op |_|`(_`) : SubstitutionSet Module -> SubstitutionSet .
  eq | S:SubstitutionSet |(M)
   = eqNormalizeSubstitution(M,S:SubstitutionSet) .

  op eqNormalizeSubstitution : Module SubstitutionSet -> SubstitutionSet .
  eq eqNormalizeSubstitution(M, empty)
   = empty .
  eq eqNormalizeSubstitution(M, S | SS)
   = eqNormalizeSubstitution*(M, S) | eqNormalizeSubstitution(M, SS) .

  op eqNormalizeSubstitution* : Module Substitution -> Substitution .
  eq eqNormalizeSubstitution*(M, none)
   = none .
  eq eqNormalizeSubstitution*(M, V <- T ; S:Substitution)
   = V <- getTerm(metaReduce(eraseRls(M),T)) 
     ; eqNormalizeSubstitution*(M, S:Substitution) .

endfm
fmod META-NORMALIZE is
  protecting META-TERM .
  protecting META-LEVEL .
  protecting META-UNIFICATION .
  protecting RESULT-CONTEXT-SET .
  protecting ORDERS-TERM-SUBSTITUTION .
  protecting TYPEOFNARROWING .

  vars T T' TOrig Lhs Rhs TS TS' CtTS CtTS' : Term .
  var V : Variable .
  var C : Constant .
  var F : Qid .
  vars TL TL' : TermList .
  var M : Module .
  vars RTS RTS' RTS$ RTS$' : ResultContextSet .
  vars RT RT' : ResultContext .
  vars TP TP' : Type .
  vars S S' S* S'* Subst : Substitution .
  var RLS : RuleSet .
  var Att : AttrSet .
  vars B BN : Bound .
  vars N NextVar NextVar' : Nat .
  var NL : NatList .
  vars Ct CtS Ct' CtS' : Context .
  var ON : TypeOfNarrowing .
  var QQ : TypeOfRelation .

  op |_| : ResultTripleSet -> Nat .
  eq | (empty).ResultTripleSet | = 0 .
  eq | {T,TP,S} | RTS:ResultTripleSet | = s(| RTS:ResultTripleSet |) .

  *** Shortcut to Normalization by rewriting Search
  op metaNormalizeCollect$ : Module Term ~> ResultTripleSet .
  eq metaNormalizeCollect$(M,T)
   = metaNormalizeCollect$(M,{T,leastSort(M,T),none}) .

  op metaNormalizeCollect$ : Module Term Type ~> ResultTripleSet .
  eq metaNormalizeCollect$(M,T,TP)
   = metaNormalizeCollect$(M,{T,TP,none}) .

  op metaNormalizeCollect$ : Module ResultTriple ~> ResultTripleSet .
  eq metaNormalizeCollect$(M,{T,TP,S})
   = metaSearchCollect(M, 
       T, (addType TP ToVar 'XXXXXXX),
       '!,unbounded) .
       
  *** Shortcut to One rewriting step
  op metaOneRewriting$ : Module Term ~> ResultTripleSet .
  eq metaOneRewriting$(M,T)
   = metaOneRewriting$(M,{T,leastSort(M,T),none}) .

  op metaOneRewriting$ : Module Term Type -> ResultTripleSet .
  eq metaOneRewriting$(M,T,TP)
   = metaOneRewriting$(M,{T,TP,none}) .

  op metaOneRewriting$ : Module ResultTriple -> ResultTripleSet .
  
  eq metaOneRewriting$(M,{T,TP,S})
   = metaSearchCollect(M, 
       T, (addType TP ToVar 'XXXXXXX),
       '+,1) .
   
  *** Use Standard Maude metaSearch 
  op metaSearchCollect : Module Term Term TypeOfRelation Bound 
                      ~> ResultTripleSet .
  eq metaSearchCollect(M,T,T',QQ,B)
   = metaSearchCollect(M,T,T',QQ,B,0) .
  
  op metaSearchCollect : Module Term Term TypeOfRelation Bound Nat 
                      ~> ResultTripleSet .
  eq metaSearchCollect(M,T,T',QQ,B,N:Nat)
   = if metaSearch(M,T,T',nil,[QQ],B,N:Nat) :: ResultTripleSet
        and
        metaSearch(M,T,T',nil,[QQ],B,N:Nat) =/= failure
     then metaSearch(M,T,T',nil,[QQ],B,N:Nat) 
          |
          metaSearchCollect(M,T,T',QQ,B,s(N:Nat)) 
     else empty
     fi .

  *** Shortcut to normal form detection
  op isNF$ : Module Substitution ~> Bool .
  eq isNF$(M, (none).Substitution) 
   = true .
  eq isNF$(M, V:Variable <- T:Term ; S:Substitution) 
   = isNF$(M,T) and-then isNF$(M, S:Substitution) .

  op isNF$ : Module Term ~> Bool .
  eq isNF$(M,T) = isNF$$(M,T,leastSort(M,T)) .

  op isNF$$ : Module Term Type ~> Bool .
  eq isNF$$(M,T,TP)
   = metaSearch(M,T,(addType TP ToVar 'XXXXXXX),nil,'+,1,0) == failure .

  ***********************************************************************
  --- Not defined in this module-------------
  op metaNarrowSearchAll : Module Term Term SubstitutionCond TypeOfRelation
                            Bound Bound --- number steps / number solutions
                            Bound --- chosen solution
                            TypeOfNarrowing
                            ResultContextSet
			 -> ResultContextSet .
  --- Not defined in this module-------------

  op metaNormalizeCollect : Module Term ~> ResultTripleSet .
  eq metaNormalizeCollect(M,T)
   = if anyNonExec(M)
     then metaNormalizeCollect#(M,T)
     else metaNormalizeCollect$(M,T)
     fi .

  op metaNormalizeCollect : Module Term Type -> ResultTripleSet .
  eq metaNormalizeCollect(M,T,TP)
   = if anyNonExec(M)
     then metaNormalizeCollect#(M,T,TP)
     else metaNormalizeCollect$(M,T,TP)
     fi .

  op metaNormalizeCollect : Module ResultTriple -> ResultTripleSet .
  eq metaNormalizeCollect(M,{T,TP,S})
   = if anyNonExec(M)
     then metaNormalizeCollect#(M,{T,TP,S})
     else metaNormalizeCollect$(M,{T,TP,S})
     fi .

  op metaOneRewriting : Module Term ~> ResultTripleSet .
  eq metaOneRewriting(M,T)
   = if anyNonExec(M)
     then metaOneRewriting#(M,T)
     else metaOneRewriting$(M,T)
     fi .

  op metaOneRewriting : Module Term Type -> ResultTripleSet .
  eq metaOneRewriting(M,T,TP)
   = if anyNonExec(M)
     then metaOneRewriting#(M,T,TP)
     else metaOneRewriting$(M,T,TP)
     fi .

  op metaOneRewriting : Module ResultTriple -> ResultTripleSet . 
  eq metaOneRewriting(M,{T,TP,S})
   = if anyNonExec(M)
     then metaOneRewriting#(M,{T,TP,S})
     else metaOneRewriting$(M,{T,TP,S})
     fi .

  --- Based on narrowing -----------------------------
  op metaNormalizeCollect# : Module Term ~> ResultTripleSet .
  eq metaNormalizeCollect#(M,T)
   = metaNormalizeCollect#(M,{T,leastSort(M,T),none}) .

  op metaNormalizeCollect# : Module Term Type -> ResultTripleSet .
  eq metaNormalizeCollect#(M,T,TP)
   = metaNormalizeCollect#(M,{T,TP,none}) .

  ---metaSearch of Maude doesn't work for rules with extra vars  
  op metaNormalizeCollect# : Module ResultTriple -> ResultTripleSet .
  eq metaNormalizeCollect#(M,{T,TP,S})
   = toTriple(M,
     metaNarrowSearchAll(
       M,
       T, (addType TP ToVar 'XXXXXXX),
       none,'!,unbounded,unbounded,unbounded,E-rewriting noStrategy,
       {T,TP,S,none,[],[],T << S,T << S,
        max(highestVar(S),highestVar((T,T << S))) + 1,
        nil,
        empty}
     )) .

  op metaOneRewriting# : Module Term ~> ResultTripleSet .
  eq metaOneRewriting#(M,T)
   = metaOneRewriting#(M,{T,leastSort(M,T),none}) .

  op metaOneRewriting# : Module Term Type -> ResultTripleSet .
  eq metaOneRewriting#(M,T,TP)
   = metaOneRewriting#(M,{T,TP,none}) .

  op metaOneRewriting# : Module ResultTriple -> ResultTripleSet . 
  eq metaOneRewriting#(M,{T,TP,S})
   = toTriple(M,
     metaNarrowSearchAll(
       M,
       T, (addType TP ToVar 'XXXXXXX),
       none,'+,1,unbounded,unbounded,E-rewriting noStrategy,
       {T,TP,S,none,[],[],T << S,T << S,
        max(highestVar(S),highestVar((T,T << S))) + 1,
        nil,
        empty}
     )) .

  *** Remove itself
  op noSelf : ResultContextSet ResultContextSet -> ResultContextSet .
  eq noSelf(empty,RTS')
   = RTS' .
  eq noSelf({T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} | RTS,RTS')
   = noSelf(RTS,
      if TS == T and-then CtTS == T and-then Ct == [] and-then CtS == []
      then noSelf*({T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}, RTS')
      else RTS'
      fi
     ) .

  op noSelf* : ResultContext ResultContextSet -> ResultContextSet .
  eq noSelf*(RT,empty)
   = empty .
  eq noSelf*({T,TP,S,S*,[],[],T,T,NextVar,Tr:TraceNarrow,B:Flags}, 
             {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',Tr':TraceNarrow,B':Flags} | RTS)
   = if TS' == T' and-then CtTS' == T' and-then Ct' == [] and-then CtS' == []
        and-then 
        T == T' and-then TP == TP' 
        and-then 
        (S |> T) == (S' |> T) 
     then ---remove
          empty
     else ---keep
          {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',Tr:TraceNarrow,B':Flags}
     fi
     | noSelf*({T,TP,S,S*,[],[],T,T,NextVar,Tr':TraceNarrow,B:Flags},RTS) .

endfm

fmod META-E-NARROWING is
  protecting META-TERM .
  protecting META-LEVEL .
  protecting META-UNIFICATION .
  protecting META-MSG-UNIFICATION .
  protecting META-E-UNIFICATION .
  protecting RESULT-CONTEXT-SET .
  protecting ORDERS-TERM-SUBSTITUTION .
  protecting TYPEOFNARROWING .
  protecting META-NORMALIZE .
  protecting UNIFICATIONTRIPLESET .
  protecting RIGIDIFE .

  var T T' T'' TOrig Lhs Lhs' Rhs Rhs'  : Term .
  var CT' TS TS' TS'' CtTS CtTS' CtTS'' : Term .
  var V : Variable .
  var C : Constant .
  var F : Qid .
  var M : Module .
  var RTS RTS' RTS$ RTS-Rls RTS-Sub RTSSol : ResultContextSet .
  var RTNeS : ResultContextNeSet .
  var RT RT' : ResultContext .
  vars S S' S'' Subst Subst' S* S'* : Substitution .
  var SS : SubstitutionSet .
  var RLS : RuleSet .
  var RL : Rule .
  vars Att Att' : AttrSet .
  var B BN : Bound .
  vars N N' N1 N2 : Nat .
  var NL : NatList .
  vars Ct CtS Ct' CtS' Ct'' CtS'' : Context .
  var NeTL NeTL' : NeTermList .
  vars TL TL' TL'' TL''' : TermList .
  vars TP TP' TP'' : Type .
  var ON : TypeOfNarrowing .
  vars NextVar NextVar' NextVar'' NVarPrev : Nat .
  var U : UnificationTriple .
  vars US US' : UnificationTripleSet .
  var IRR : IrrFlags .

  --- metaNarrow ---------------------------
  ---( We implement:
       * basic narrowing, where terms introduced
         by unifiers (substitutions) are never
         selected for narrowing, and
       * standard narrowing, where this
         restriction does not apply  )


  *** Shortcuts to Narrowing
  op metaNarrow : Module Term -> ResultTripleSet .
  eq metaNarrow(M,T) = metaNarrow(M,T,1) .

  op metaNarrow : Module Term Bound -> ResultTripleSet .
  eq metaNarrow(M,T,B) 
   = toTriple(M,metaENarrowShowAll(M,T,B,full noStrategy BuiltIn-unify)) |> T .

  *** Shortcuts to Basic Narrowing
  op metaBasicNarrow : Module Term -> ResultTripleSet .
  eq metaBasicNarrow(M,T) = metaBasicNarrow(M,T,1) .

  op metaBasicNarrow : Module Term Bound -> ResultTripleSet .
  eq metaBasicNarrow(M,T,B) 
   = toTriple(M,metaENarrowShowAll(M,T,B,basic noStrategy BuiltIn-unify)) |> T .

  *** Shortcuts to Narrowing
  op metaENarrow : Module Term -> ResultTripleSet .
  eq metaENarrow(M,T) = metaENarrow(M,T,1) .

  op metaENarrow : Module Term Bound -> ResultTripleSet .
  eq metaENarrow(M,T,B)
   = toTriple(M,metaENarrowShowAll(M,T,B,full noStrategy E-BuiltIn-unify)) 
     |> T .

  *** Shortcuts to Narrowing
  op metaEBuiltInTopMostNarrow : Module Term Nat -> ResultTripleSet .
  eq metaEBuiltInTopMostNarrow(M,T,N) 
   = metaETopMostNarrow(M,T,1,reducible, E-BuiltIn-unify,N) .
  op metaEBuiltInTopMostNarrowIrr : Module Term Nat -> ResultTripleSet .
  eq metaEBuiltInTopMostNarrowIrr(M,T,N) 
   = metaETopMostNarrow(M,T,1,irreducible, E-BuiltIn-unify,N) .

  op metaEACUTopMostNarrow : Module Term Nat -> ResultTripleSet .
  eq metaEACUTopMostNarrow(M,T,N) 
   = metaETopMostNarrow(M,T,1,reducible, E-ACU-unify,N) .
  op metaEACUTopMostNarrowIrr : Module Term Nat -> ResultTripleSet .
  eq metaEACUTopMostNarrowIrr(M,T,N) 
   = metaETopMostNarrow(M,T,1,irreducible, E-ACU-unify,N) .

  op metaETopMostNarrow : Module Term Bound IrrFlags TypeOfNarrowing Nat
                       -> ResultTripleSet .
  eq metaETopMostNarrow(M,T,B,IRR,ON,N) 
   = toTriple(M,metaENarrowShowAll(M,T,B,full topmost ON [IRR],N)) |> T .

  --- Auxiliary
  op [_,_] : TypeOfNarrowing IrrFlags ~> TypeOfNarrowing .
  eq [ E-ACU-unify, reducible ] = E-ACU-unify .
  eq [ E-ACU-unify, irreducible ] = E-ACU-unify-Irr .
  eq [ E-BuiltIn-unify, reducible ] = E-BuiltIn-unify .
  eq [ E-BuiltIn-unify, irreducible ] = E-BuiltIn-unify-Irr .

  *** Shortcuts to Basic Narrowing
  op metaEBasicNarrow : Module Term -> ResultTripleSet .
  eq metaEBasicNarrow(M,T)
   = metaEBasicNarrow(M,T,1) .

  *** Shortcuts for normalization
  op metaEBasicNarrow : Module Term Bound -> ResultTripleSet .
  eq metaEBasicNarrow(M,T,B)
   = toTriple(M,metaENarrowShowAll(M,T,B,E-BuiltIn-unify noStrategy basic)) |> T .

  op metaBasicNarrowNormalize : Module Term -> ResultTripleSet .
  eq metaBasicNarrowNormalize(M,T)
   = toTriple(M,metaBasicNarrowNormalizeAll(M,T,highestVar(T) + 1)) |> T .

  op metaBasicNarrowNormalizeAll : Module Term Nat -> ResultContextSet .
  eq metaBasicNarrowNormalizeAll(M,T,NextVar)
   = metaENarrowShowAll(M,T,unbounded,
         basic BuiltIn-unify 
         computed-normalized-subs applied-normalized-subs 
         normalize-terms noStrategy,NextVar) .

  op metaNarrowNormalize : Module Term -> ResultTripleSet .
  eq metaNarrowNormalize(M,T)
   = toTriple(M,metaNarrowNormalizeAll(M,T,highestVar(T) + 1)) |> T .

  op metaNarrowNormalizeAll : Module Term Nat -> ResultContextSet .
  eq metaNarrowNormalizeAll(M,T,NextVar)
   = metaENarrowShowAll(M,T,unbounded,
         full BuiltIn-unify 
         computed-normalized-subs applied-normalized-subs 
         normalize-terms noStrategy,NextVar) .

  *** General Call
  op metaENarrowShowAll : Module Term Bound TypeOfNarrowing 
                       -> ResultContextSet .
  eq metaENarrowShowAll(M,T,B,ON)
   = metaENarrowShowAll(M,T,B,ON,highestVar(T) + 1) .

  op metaENarrowShowAll : Module Term Bound TypeOfNarrowing Nat
                       -> ResultContextSet .
  eq metaENarrowShowAll(M,T,B,ON,N)
   = metaENarrowGen(removeBoolEqs(M),B,ON, 
       {T,leastSort(M,T),none,none,[],[],T,T,N,nil,empty}) .

  *** Call for ResultContextSet
  op metaENarrowGen : Module Bound TypeOfNarrowing
                      ResultContextSet  
                   -> ResultContextSet .

  eq metaENarrowGen(M,B,ON,RTS)
   = if B == 0
     then RTS
     else metaENarrowGen*(M,B,ON,empty,empty,RTS) 
     fi .

  op metaENarrowGen* : Module 
                       Bound TypeOfNarrowing 
                       ResultContextSet ResultContextSet ResultContextSet
                    -> ResultContextSet .
  eq metaENarrowGen*(M,B,ON,RTSSol,RTS',empty)
   = if RTS' == empty
        or-else
        (B =/= unbounded and-then B <= 1)
     then RTSSol | RTS' --- Stop
     else metaENarrowGen*(M,dec(B),ON,RTSSol,empty,RTS')
     fi .
  eq metaENarrowGen*(M,B,ON,RTSSol,RTS',RT | RTS)
   = if isEND(normalize-terms?(M,ON,RT))
     then metaENarrowGen*(M,B,ON,
          RTSSol | normalize-terms?(M,ON,RT),
          RTS',RTS)
     else metaENarrowGen*(M,B,ON,RTSSol,
          RTS' | 
             filter-variant-RT(M,ON,normalize-terms?(M,ON,RT),
                metaENarrowGen**(M,B,ON,normalize-terms?(M,ON,RT))),
          RTS)
     fi .

  op testNonVarRedex : TypeOfNarrowing Term Term -> Bool .
  eq testNonVarRedex(alsoAtVarPosition ON,T,TS) = true .
  eq testNonVarRedex(ON,T,TS) = testNonVarRedex*(ON,T,TS) [owise] .

  op testNonVarRedex* : TypeOfNarrowing Term Term -> Bool .
  eq testNonVarRedex*(basic ON,T,TS) = not(T :: Variable) .
  eq testNonVarRedex*(ON,T,TS)       = not(TS :: Variable) [owise] .

  op metaENarrowGen** : Module 
                        Bound TypeOfNarrowing 
                        ResultContext
                     -> ResultContextSet .
  eq metaENarrowGen**(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
   = if not testNonVarRedex(ON,T,TS) --- T is a variable
     then if CtS == []
          then *** Term CtTS is a normal form so we return it
               {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}
	  else *** Term T is a rigid normal form inside a context Ct
	       *** but since no rewrite has been done and
               *** this can be part of a previous metaNarrowSub call,
               *** this path is discarded
               empty
          fi
     else if metaENarrowStra(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
	     =/= empty
          then metaENarrowStra(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
          else if CtS == []
               then *** Term CtTS is a normal form so we return it
                    {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,end(true,B:Flags)}
	       else *** Term T is a rigid normal form inside a context Ct
	            *** but since no rewrite has been done and
                    *** this can be part of a previous metaNarrowSub call,
                    *** this path is discarded
                    empty
               fi
          fi
     fi .

  *** Try all rules at top level of term T in context Ct with metaENarrowRls
  *** Try also inner subterms of T with metaENarrowSub
  *** Note that metaENarrowRls and metaENarrowSub 
  *** call to metaNarrow recursively
  op metaENarrowStra : Module Bound TypeOfNarrowing ResultContext 
                    -> ResultContextSet .
  ---innermost
  eq metaENarrowStra(M,B,innermost ON,RT)
   = if metaENarrowSub(M,B,innermost ON,RT) =/= empty
     then metaENarrowSub(M,B,innermost ON,RT)
     else metaENarrowRls(M,B,innermost ON,getRls(M),RT)
     fi .

  ---outermost
  eq metaENarrowStra(M,B,outermost ON,RT)
   = if metaENarrowRls(M,B,outermost ON,getRls(M),RT) =/= empty
     then metaENarrowRls(M,B,outermost ON,getRls(M),RT)
     else metaENarrowSub(M,B,outermost ON,RT)
     fi .

  ---topmost
  eq metaENarrowStra(M,B,topmost ON,RT)
   = metaENarrowRls(M,B,topmost ON,getRls(M),RT) .

  ---noStrategy
  eq metaENarrowStra(M,B,noStrategy ON,RT)
   = metaENarrowRls(M,B,noStrategy ON,getRls(M),RT)
     | 
     metaENarrowSub(M,B,noStrategy ON,RT) .

  op dec : Bound -> Bound .
  eq dec(unbounded) = unbounded .
  eq dec(s(N)) = N .

  *** Generic call to metaUnification with different parameters
  op auxMetaUnify : Module TypeOfNarrowing 
                    Term Term Nat ~> UnificationTripleSet .
		--- Term Lhs
  eq auxMetaUnify(M,variant(N') ON,T,T',N)
   = unrigidife(qid(N'),
       auxMetaUnify*(getM(rigidifeNat(M,qid(N'),T,N')),
                     variant(N') ON,
                     getTL(rigidifeNat(M,qid(N'),T,N')),
                     T',
                     N)
     ) .

  eq auxMetaUnify(M,ON,T,T',N)
   = auxMetaUnify*(M,ON,T,T',N) [owise] .

  op auxMetaUnify* : Module TypeOfNarrowing 
                    Term Term Nat ~> UnificationTripleSet .
		--- Term Lhs
 ceq auxMetaUnify*(M,rigidife(F:Qid) ON,T,T',N)
   = unrigidife(Q:Qid,
       auxMetaUnify**(M#:Module,rigidife(F:Qid) ON,T#:Term,T',N) 
     ) 
  if F:Qid[TL:TermList] := T
  /\ Q:Qid := 'auxMetaUnify
  /\ X:PairRigidife := rigidifeRigid(M,Q:Qid,T)
  /\ M#:Module := getM(X:PairRigidife)
  /\ T#:Term := getTL(X:PairRigidife) .

  eq auxMetaUnify*(M,ON,T,T',N)
   = auxMetaUnify**(M,ON,T,T',N) [owise] .

  op auxMetaUnify** : Module TypeOfNarrowing 
                     Term Term Nat ~> UnificationTripleSet .
		 --- Term Lhs
                 --- [memo] . --- Very useful but huge space use 
  eq auxMetaUnify**(M,E-rewriting ON,T,T',N)
   = toUnificationTriple[N](metaCoreMatch(removeBoolEqs(M),T,T')) .
  eq auxMetaUnify**(M,E-ACU-unify ON,T,T',N)
   = metaEACUUnify(removeBoolEqs(M),T,T',N,reducible) .
  eq auxMetaUnify**(M,E-ACU-unify-Irr ON,T,T',N)
   = metaEACUUnify(removeBoolEqs(M),T,T',N,irreducible) .
  eq auxMetaUnify**(M,E-BuiltIn-unify ON,T,T',N)
   = metaEBuiltInUnify(removeBoolEqs(M),T,T',N,reducible) .
  eq auxMetaUnify**(M,E-BuiltIn-unify-Irr ON,T,T',N)
   = metaEBuiltInUnify(removeBoolEqs(M),T,T',N,irreducible) .
  eq auxMetaUnify**(M,ACU-unify ON,T,T',N)
   = metaACUUnify(removeBoolEqs(M),T,T',N) .
  eq auxMetaUnify**(M,BuiltIn-unify ON,T,T',N)
   = metaBuiltInUnify(removeBoolEqs(M),T,T',N) .

  *** Remove rigid normal forms
  op removeEND : ResultContextSet -> ResultContextSet .
  eq removeEND(RTS)
   = removeEND*(RTS,empty) .

  op removeEND* : ResultContextSet ResultContextSet -> ResultContextSet .
  eq removeEND*(empty,RTS')
   = RTS' .
  eq removeEND*(RT | RTS,RTS')
   = removeEND*(RTS,if isEND(RT) then RTS' else RTS' | RT fi) .

  op remove_From_ : ResultContextSet ResultContextSet -> ResultContextSet .
  eq remove(RT | RTS) From (RT | RTS')
   = remove(RTS) From (RT | RTS') .
  eq remove(RTS) From (RTS')
   = RTS [owise] .

  op isEND : ResultContext -> Bool .
  eq isEND({T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
   = end(B:Flags) .

  *** Call for Rules ---> Returns empty if no rule is applied
  op metaENarrowRls : Module Bound TypeOfNarrowing
                      RuleSet ResultContext  
                   -> ResultContextSet .
  eq metaENarrowRls(M,B,ON,RL RLS,RT) 
   = metaENarrowRls#(M,B,ON,RL RLS,RT,empty) .
  eq metaENarrowRls(M,B,ON,none,RT)
   = empty .

  op metaENarrowRls# : Module Bound TypeOfNarrowing
                      RuleSet ResultContext ResultContextSet
                   -> ResultContextSet .
  eq metaENarrowRls#(M,B,ON,none,RT,RTS) 
   = RTS .
  eq metaENarrowRls#(M,B,ON,RL RLS,RT,RTS) 
   = metaENarrowRls#(M,B,ON,RLS,RT,
      RTS |
        filter-variant-RT(M,ON,RT,
           metaENarrowRls*(M,B,ON,RL,RT)
        )
     ) .

  --- General case
  op metaENarrowRls* : Module Bound TypeOfNarrowing
                       Rule ResultContext  
                    -> ResultContextSet .
  eq metaENarrowRls*(M,B,ON, 
        (rl Lhs => Rhs [Att].), 
	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
   = metaENarrowRls**$(M,B,ON, 
        (rl Lhs => Rhs [Att].), 
	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,
           Tr:TraceNarrow {CtTS,none,leastSort(M,CtTS),(rl Lhs => Rhs [Att].)},
                          --- Subst none here is key to write the real stuff 
                          --- later in function _<<_
           B:Flags},
        'rl_=>_`[_`].[Lhs,Rhs,'none.AttrSet] <<{none,NextVar}<) . 
  eq metaENarrowRls*(M,B,ON, X:Rule, X:ResultContext)
   = empty [owise] .

  op metaENarrowRls**$ : Module Bound TypeOfNarrowing
                         Rule ResultContext  
                         UnificationPair
                      -> ResultContextSet .
  eq metaENarrowRls**$(M,B,ON,
        (rl Lhs => Rhs [Att].), 
	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags},
        {Subst,NextVar'})
   = metaENarrowRls**$$(M,B,ON, 
	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags},
        {Subst,NextVar'},
        'rl_=>_`[_`].[Lhs,Rhs,'none.AttrSet] << Subst) .

  op metaENarrowRls**$$ : Module Bound TypeOfNarrowing 
                          ResultContext  
                          UnificationPair Term
                       -> ResultContextSet .
  eq metaENarrowRls**$$(M,B,ON, 
	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,
          Tr:TraceNarrow {CtTS,none,TP$:Type,(rl Lhs => Rhs [Att].)},
          B:Flags},
        {Subst,NextVar'},
        'rl_=>_`[_`].[Lhs',Rhs','none.AttrSet])
   = metaENarrowRls**$$$(M,B,ON, 
	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,
           Tr:TraceNarrow {CtTS,none,TP$:Type,(rl Lhs' => Rhs' [Att].)},
           B:Flags},
        {Subst,NextVar'},
        'rl_=>_`[_`].[Lhs',Rhs','none.AttrSet],
        auxMetaUnify(M,ON,TS,Lhs',NextVar')) .

  op metaENarrowRls**$$$ : Module Bound TypeOfNarrowing
                           ResultContext  
                           UnificationPair Term UnificationTripleSet
                        -> ResultContextSet .
  eq metaENarrowRls**$$$(M,B,ON, 
	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags},
        {Subst,NextVar'},
        'rl_=>_`[_`].[Lhs',Rhs','none.AttrSet],US)
    = if US =/= empty
      then rebuildTypeAndDiscardErroneous(M,ON,
               {Ct[Rhs'],
	        TP,
		S,S',
		[],
		[],
		CtS[Rhs'],
		CtS[Rhs'],
		NextVar',
                Tr:TraceNarrow,
                B:Flags} 
               <<(M,ON) US
            )
      else empty
      fi .

  *** rebuild the context of the applied rule **********************
  op rebuildTypeAndDiscardErroneous : Module TypeOfNarrowing
                                      ResultContextSet -> ResultContextSet .
  eq rebuildTypeAndDiscardErroneous(M,ON,empty)
   = empty .
  eq rebuildTypeAndDiscardErroneous(M,ON,RT | RTS)
   = rebuildTypeAndDiscardErroneous*(M,ON,RT)
     | rebuildTypeAndDiscardErroneous(M,ON,RTS) .

  op rebuildTypeAndDiscardErroneous* : Module TypeOfNarrowing
                                       ResultContext -> ResultContextSet .
  eq rebuildTypeAndDiscardErroneous*(M,ON,
       {T,TP,S,S',[],[],TS,TS,NextVar,Tr:TraceNarrow,B:Flags})
   = if	leastSort(M,TS) :: Type
     then normalize-terms?(M,ON,
             {canonice(M,T),leastSort(M,TS),S,S',
              [],[],canonice(M,TS),canonice(M,TS),
              NextVar,Tr:TraceNarrow,B:Flags})
     else empty
     fi .

  *** auxiliary for variant narrowing **********************
  op _<<`(_`,_`)_ : ResultContext 
                    Module TypeOfNarrowing
                    UnificationTripleSet -> ResultContextSet .

  eq RT <<(M,ON) (empty).UnificationTripleSet
   = (empty).ResultContextSet .

  eq {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 
     <<(M,ON) ({Subst,Subst',N} | SS:UnificationTripleSet)
   = {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 
     <<((M,ON)) {Subst,Subst',N}
     |
     {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 
     <<(M,ON) SS:UnificationTripleSet .

  op _<<`(`(_`,_`)`)_ : ResultContext 
                        Module TypeOfNarrowing
                        UnificationTriple -> ResultContextSet .

  eq {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 
     <<((M,ON)) {Subst,Subst',N}
   = if (variant in ON 
         and-then 
         (Subst == none 
          or-else
          (not anyIdSymbol(M,Subst ; Subst')
           and-then
           normalizedSubstitution?(M,Subst ; Subst'))
          or-else
          anyIdSymbol(M,Subst ; Subst')
         )
        )
        or-else
        (computed-normalized-subs in ON 
         and-then normalizedSubstitution?(M,Subst))
        or-else
        (applied-normalized-subs in ON 
         and-then normalizedSubstitution?(M,Subst'))
        or-else 
        (not variant in ON 
         and-then 
         not applied-normalized-subs in ON 
         and-then
         not computed-normalized-subs in ON)
     then {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 
           << if not anyIdSymbol(M,Subst ; Subst')
              then {Subst,Subst',N}
              else {normalizeRls(M,Subst),normalizeRls(M,Subst'),N}
              fi
     else (empty).ResultContextSet
     fi .

  *** test flag normalize-terms and normalize **********************
  *** !!!! This mustn't be combined with basic -> strange behavior
  op normalize-terms? : Module TypeOfNarrowing ResultContext 
                     -> ResultContext .
  eq normalize-terms?(M,E-normalize-terms ON,
     {T,TP,S,S',[],[],TS,TS,NextVar,Tr:TraceNarrow,B:Flags})
   = {getTerm(metaReduce(M,T)),
      getType(metaReduce(M,T)),
      S,S',[],[],
      getTerm(metaReduce(M,TS)),
      getTerm(metaReduce(M,TS)),
      NextVar,Tr:TraceNarrow,B:Flags} .
  eq normalize-terms?(M,normalize-terms ON,
     {T,TP,S,S',[],[],TS,TS,NextVar,Tr:TraceNarrow,B:Flags})
   = {getTerm(metaNormalizeCollect(M,T)),
      getType(metaNormalizeCollect(M,T)),
      S,S',[],[],
      getTerm(metaNormalizeCollect(M,TS)),
      getTerm(metaNormalizeCollect(M,TS)),
      NextVar,Tr:TraceNarrow,B:Flags} .
  eq normalize-terms?(M,ON,RT)
   = RT [owise] .

  *** Call at inner subterms
  op metaENarrowSub : Module Bound TypeOfNarrowing ResultContext  
                      -> ResultContextSet .
  eq metaENarrowSub(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) 
   = metaENarrowSub#(M,B,ON,flatten(M,auxSplitTerm(ON,T,TS)),
            {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) .

  op auxSplitTerm : TypeOfNarrowing Term Term -> Term .
  eq auxSplitTerm(basic ON,T,TS) = T .
  eq auxSplitTerm(ON,T,TS) = TS [owise] .

  op metaENarrowSub# : Module Bound TypeOfNarrowing Term ResultContext  
                      -> ResultContextSet .
  eq metaENarrowSub#(M,B,ON,C,RT) = empty .
  eq metaENarrowSub#(M,B,ON,V,RT) = empty .
  eq metaENarrowSub#(M,B,ON,F[NeTL],RT)
   = metaENarrowSub#Gen(M,B,ON,
       splitTerm(M,F,
                 1,getFrozen(M,F,getTypes(M,NeTL)),
                 isAssociative(M,F,getTypes(M,NeTL)) 
                 or isCommutative(M,F,getTypes(M,NeTL)),
                 empty,NeTL,RT)) .

  op splitTerm : Module Qid
                 Nat NeNatList Bool
                 TermList TermList 
                 ResultContext -> ResultContextSet .

  eq splitTerm(M,F,
               N,NL,AC?:Bool,
               TL',empty,
               RT) 
   = empty .
               
  eq splitTerm(M,F,
               N,NL,AC?:Bool,
               TL',(T,TL),
               {T'',TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
   = if ((not AC?:Bool) and-then N inNatList NL)
        or-else
        (AC?:Bool and-then NL =/= 0)
     then empty
     else {T,leastSort(M,T),S,S',
           Ct[F[TL',[],TL]],
           CtS[F[TL' << (S ; S'),[],TL << (S ; S')]],T << (S ; S'),
           CtTS,NextVar,Tr:TraceNarrow,B:Flags}
     fi
     | splitTerm(M,F,
                 s(N),NL,AC?:Bool,
                 (TL',T),TL,
                 {T'',TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) .

  op metaENarrowSub#Gen : Module Bound TypeOfNarrowing ResultContextSet  
                       -> ResultContextSet .
  eq metaENarrowSub#Gen(M,B,ON,empty)
   = empty .
  eq metaENarrowSub#Gen(M,B,ON,RT | RTS)
   = metaENarrowGen**(M,B,ON,RT) | metaENarrowSub#Gen(M,B,ON,RTS) .

  op filter-variant-RT : Module TypeOfNarrowing ResultContext 
                      ResultContextSet -> ResultContextSet .
  eq filter-variant-RT(M,ON,
          {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags},RTS)
   = if variant in ON and testUnifier !in ON
     then filter-variant-RT*(M,Vars(TS),empty,RTS)
     else RTS
     fi .

  op filter-variant-RT* : 
       Module TermList ResultContextSet ResultContextSet -> ResultContextSet .
  eq filter-variant-RT*(M,TL,RTS$,empty)
   = RTS$ .
  eq filter-variant-RT*(M,TL,RTS$,RT | RTS)
   = filter-variant-RT**(M,TL,RTS$,RTS,RT,RTS) .  

  op filter-variant-RT** : 
        Module TermList ResultContextSet ResultContextSet
                        ResultContext ResultContextSet -> ResultContextSet .
  eq filter-variant-RT**(M,TL,RTS$,RTS',RT,empty)
   = --- RT is not implied by any in RTS'
     filter-variant-RT*(M,TL,RTS$ | RT,RTS') .
  eq filter-variant-RT**(M,TL,RTS$,RT | RTS',RT',RT | RTS)
   = if test-variant-RT(M,TL,RT,RT')
     then --- RT' is implied by RT in RTS'
          filter-variant-RT*(M,TL,RTS$,RT | RTS') 
     else if test-variant-RT(M,TL,RT',RT)
          then --- remove RT from the set RTS'
               filter-variant-RT**(M,TL,RTS$,RTS',RT',RTS)
          else --- continue searching in RTS
               filter-variant-RT**(M,TL,RTS$,RT | RTS',RT',RTS)
          fi
     fi .

  op test-variant-RT : Module TermList ResultContext ResultContext 
                    -> Bool .
  eq test-variant-RT(M,TL,
         {T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags},
         {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',Tr':TraceNarrow,B':Flags})
   = test-variant-RT*(M,TL,S |> TL,S' |> TL) .

  op test-variant-RT* : Module TermList Substitution Substitution -> Bool .
  eq test-variant-RT*(M,TL,S,S')
   = | S | <= | S' |
     and-then
     S <=[TL,M] S' . --- keep T & remove T'

  op |_| : Substitution -> Nat .
  eq | (none).Substitution | = 0 .
  eq | V <- T ; S | = s(| S |) .

endfm

fmod META-NARROWING-SEARCH is
  protecting META-E-NARROWING .
  protecting META-TERM .
  protecting META-LEVEL .
  protecting META-UNIFICATION .
  protecting RESULT-CONTEXT-SET .
  protecting ORDERS-TERM-SUBSTITUTION .

  var T T' TOrig Lhs Rhs TS TS' CtTS CtTS' : Term .
  var V : Variable .
  var C : Constant .
  var F : Qid .
  vars TL TL' : TermList .
  var M : Module .
  var RTS RTS' RTSSol : ResultContextSet .
  var RT RT' : ResultContext .
  vars TP TP' : Type .
  vars S S' Subst S* S'* : Substitution .
  var RLS : RuleSet .
  var Att : AttrSet .
  var B BN Sol : Bound .
  var N : Nat .
  var NL : NatList .
  vars Ct Ct' CtS CtS' : Context .
  var ON : TypeOfNarrowing .
  vars QQ QQ' : TypeOfRelation .
  vars NextVar NextVar' : Nat .

  var SCond : SubstitutionCond .

  --- metaNarrowSearch --------------------------------------------------------

  *** Shortcuts to Narrowing Search
  op metaNarrowSearch : Module Term Term -> ResultTripleSet .
  eq metaNarrowSearch(M,T,T') = metaNarrowSearch(M,T,T',unbounded) .

  op metaNarrowSearch : Module Term Term Bound -> ResultTripleSet .
  eq metaNarrowSearch(M,T,T',B) = metaNarrowSearch(M,T,T',B,1) .

  op metaNarrowSearch : Module Term Term Bound Bound -> ResultTripleSet .
  eq metaNarrowSearch(M,T,T',B,BN) = metaNarrowSearch(M,T,T','*,B,BN) .

  op metaNarrowSearch : Module Term Term TypeOfRelation Bound Bound 
                     -> ResultTripleSet .
  eq metaNarrowSearch(M,T,T',QQ,B,BN) 
   = metaNarrowSearch(M,T,T',none,QQ,B,BN) .

  op metaNarrowSearch : Module Term Term SubstitutionCond 
                        TypeOfRelation Bound Bound 
                        -> ResultTripleSet .
  eq metaNarrowSearch(M,T,T',SCond,QQ,B,BN)
   = metaNarrowSearch(M,T,T',SCond,QQ,B,BN,unbounded) .

  op metaNarrowSearch : Module Term Term SubstitutionCond 
                        TypeOfRelation Bound Bound Bound
                        -> ResultTripleSet .
  eq metaNarrowSearch(M,T,T',SCond,QQ,B,BN,Sol)
   = if (BN == unbounded and-then Sol =/= unbounded)
        or-else
        (BN =/= unbounded and-then Sol =/= unbounded and-then BN < Sol)
     then metaNarrowSearch*(M,T,T',SCond,QQ,B,Sol,Sol) 
     else metaNarrowSearch*(M,T,T',SCond,QQ,B,BN,Sol) 
     fi .

  op metaNarrowSearch* : Module Term Term SubstitutionCond 
                         TypeOfRelation Bound Bound Bound
                         -> ResultTripleSet .
  eq metaNarrowSearch*(M,T,T',SCond,QQ,B,BN,Sol)
   = metaNarrowSearchGen(M,T,T',SCond,QQ,B,BN,Sol,
         full BuiltIn-unify noStrategy E-normalize-terms) .

  *** General Call
  op metaNarrowSearchGen : Module Term Term SubstitutionCond 
                           TypeOfRelation 
                           Bound --- number of steps
                           Bound --- number of solutions
                           Bound --- chosen solution
                           TypeOfNarrowing 
			-> ResultTripleSet .
  eq metaNarrowSearchGen(M,T,T',SCond,QQ,B,BN,Sol,ON)
   = toTriple(M,metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol,ON)) .

  *** Shortcuts to Narrowing Search Path
  op metaNarrowSearchPath : Module Term Term -> TraceNarrowSet .
  eq metaNarrowSearchPath(M,T,T') = metaNarrowSearchPath(M,T,T',unbounded) .

  op metaNarrowSearchPath : Module Term Term Bound -> TraceNarrowSet .
  eq metaNarrowSearchPath(M,T,T',B) = metaNarrowSearchPath(M,T,T',B,1) .

  op metaNarrowSearchPath : Module Term Term Bound Bound -> TraceNarrowSet .
  eq metaNarrowSearchPath(M,T,T',B,BN) = metaNarrowSearchPath(M,T,T','*,B,BN) .

  op metaNarrowSearchPath : Module Term Term TypeOfRelation Bound Bound 
                         -> TraceNarrowSet .
  eq metaNarrowSearchPath(M,T,T',QQ,B,BN) = metaNarrowSearchPath(M,T,T',none,QQ,B,BN) .

  op metaNarrowSearchPath : Module Term Term SubstitutionCond 
                            TypeOfRelation Bound Bound 
                         -> TraceNarrowSet .
  eq metaNarrowSearchPath(M,T,T',SCond,QQ,B,BN)
   = metaNarrowSearchPath(M,T,T',SCond,QQ,B,BN,unbounded) .

  op metaNarrowSearchPath : Module Term Term SubstitutionCond 
                            TypeOfRelation Bound Bound Bound
                         -> TraceNarrowSet .
  eq metaNarrowSearchPath(M,T,T',SCond,QQ,B,BN,Sol)
   = if (BN == unbounded and-then Sol =/= unbounded)
        or-else
        (BN =/= unbounded and-then Sol =/= unbounded and-then BN < Sol)
     then metaNarrowSearchPath*(M,T,T',SCond,QQ,B,Sol,Sol) 
     else metaNarrowSearchPath*(M,T,T',SCond,QQ,B,BN,Sol) 
     fi .

  op metaNarrowSearchPath* : Module Term Term SubstitutionCond 
                             TypeOfRelation Bound Bound Bound
                          -> TraceNarrowSet .
  eq metaNarrowSearchPath*(M,T,T',SCond,QQ,B,BN,Sol)
   = extractTraces(
       metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol,
         full BuiltIn-unify noStrategy E-normalize-terms)) .

  op extractTraces : ResultContextSet -> TraceNarrowSet .
  eq extractTraces(empty) = empty .
  eq extractTraces({T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} | RTS)
   = if Tr:TraceNarrow == nil then empty else Tr:TraceNarrow fi
     | extractTraces(RTS) .

  *** Starting Call
  op metaNarrowSearchGenAll : Module Term Term SubstitutionCond 
                              TypeOfRelation Bound Bound Bound TypeOfNarrowing
                           -> ResultContextSet .
  eq metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol,ON)
   = metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol,ON,highestVar((T,T')) + 1) .

  op metaNarrowSearchGenAll : Module Term Term SubstitutionCond 
                            TypeOfRelation Bound Bound Bound TypeOfNarrowing Nat
                         -> ResultContextSet .
  eq metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol,ON,N)
   = metaNarrowSearchAll(addSorts('Universal,M),
            T,T',SCond,QQ,B,BN,Sol,ON,
            {T,leastSort(M,T),none,none,[],[],T,T,N,nil,empty}) .

  *** One Narrowing step in the search process (including possible filters)
  op metaNarrowStep : Module SubstitutionCond 
                      ResultContextSet TypeOfNarrowing 
		   -> ResultContextSet .
  eq metaNarrowStep(M,SCond,RTS,ON)
   = filterSCond(M,SCond,metaENarrowGen(M,1,ON,RTS)) .

  *** Filter and normal forms
  op filterSCond : Module SubstitutionCond ResultContextSet 
                   -> ResultContextSet .
  eq filterSCond(M,none,RTS)
   = RTS .
  eq filterSCond(M,SCond,RTS)
   = filterSCond*(M,SCond,RTS) [owise] .

  op filterSCond* : Module SubstitutionCond ResultContextSet 
                   -> ResultContextSet .
  eq filterSCond*(M,SCond,empty)
   = empty .
  eq filterSCond*(M,SCond,RT | RTS)
   = filterSCond**(M,SCond,RT) | filterSCond*(M,SCond,RTS) .

  op filterSCond** : Module SubstitutionCond ResultContext 
                   -> ResultContextSet .
  eq filterSCond**(M,SCond,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
   = if SCond <=[M] S
     then {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}
     else empty
     fi .

  *** Generate next successors in a breadth way
  --- We reuse the metaNarrowSearchAll function
  op metaNarrowSearchAll : Module Term Term SubstitutionCond TypeOfRelation
                            Bound --- number steps
                            Bound --- number solutions
                            Bound --- chosen solution
                            TypeOfNarrowing
                            ResultContextSet
			 -> ResultContextSet .
  eq metaNarrowSearchAll(M,TOrig,T',SCond,QQ,B,BN,Sol,ON,RTS)
   = if QQ == '+
     then noSelf(RTS,
          metaNarrowSearchCheck(M,TOrig,T',SCond,'*,B,BN,Sol,ON,empty,RTS,empty) 
          )
     else metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,B,BN,Sol,ON,empty,RTS,RTS)
     fi .

  *** Take only normal forms
  op isNF : Module ResultContext -> Bool .
  eq isNF(M,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
   = end(B:Flags) or-else metaOneRewriting(M,CtTS) == empty .
     
  *** Take only normal forms
  op isVariant : Module Nat ResultContextSet ResultContext -> Bool .
  eq isVariant(M,N,
        {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',Tr':TraceNarrow,B':Flags} | RTS,
        {T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
    = not (
       (S' |> N ; (newVar(N + 1,TP') <- CtTS'))
           <=[M] 
       (S |> N ; (newVar(N + 1,TP) <- CtTS))
      )
      and-then
      isVariant(M,N,RTS,{T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) .
  eq isVariant(M,N,RTS,RT)
   = true [owise] .


  *** Generate successors       
  op oneMoreStep : Module SubstitutionCond TypeOfNarrowing
                   ResultContextSet -> ResultContextSet [memo] .
  eq oneMoreStep(M,SCond,ON,RTS)
   = remove metaNarrowStep(M,SCond,removeEND(RTS),ON) From RTS .

  *** Check each next successor for conditions
  op metaNarrowSearchCheck : Module Term Term SubstitutionCond 
                             TypeOfRelation Bound Bound Bound TypeOfNarrowing
                             ResultContextSet ResultContextSet ResultContextSet
			     -> ResultContextSet .

  eq metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,B,BN,Sol,ON,RTSSol,RTS',empty)
   = if B == 0 or-else BN == 0 or-else Sol == 0 or-else RTS' == empty
     then *** Stop the search
          RTSSol
     else *** Compute Next successors of RTS' with oneMoreStep
          metaNarrowSearchCheck(M, 
            TOrig,T',SCond,
            QQ,
            dec(B),BN,Sol,
            ON,
            RTSSol,
            oneMoreStep(M,SCond,ON,RTS'),
            oneMoreStep(M,SCond,ON,RTS')
          ) 
     fi .

  eq metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,B,BN,Sol,ON,RTSSol,RTS',
         RT | RTS)
   = if isSolution?(M,TOrig,T',QQ,BN,Sol,ON,RTSSol,RT)
        and-then
        auxMetaUnify(M,ON,getCTTerm(RT),T',getNextVar(RT)) =/= empty *** Is actual term an instance of T'?
     then *** This is a solution
          metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,
                  B,dec(BN),dec(Sol),
                  ON,
                  if Sol == unbounded or-else Sol == 1
                  then RT << auxMetaUnify(M,ON,getCTTerm(RT),T',getNextVar(RT))
                  else empty
                  fi 
                  | RTSSol,
                  RTS',RTS)
     else *** Continue with the remaining
	  metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,
             B,BN,Sol,ON,RTSSol,RTS',RTS)
     fi .

  op isSolution? : Module Term Term  
                   TypeOfRelation Bound Bound TypeOfNarrowing
                   ResultContextSet ResultContext
	        -> Bool .
  eq isSolution?(M,TOrig,T',QQ,BN,Sol,ON,RTSSol,RT)
   = *** Is this the chosen solution?
     (BN == unbounded or-else BN > 0)
     and-then
     *** Is this step correct wrt relations <'!,'*,'+> ?
     ( QQ == '* or-else (QQ == '! and-then isEND(RT)) )
     and-then
     *** Is this a valid variant solution?
     (not (variant in ON) or-else 
      (isNF(M,RT) and-then isVariant(M,highestVar(TOrig) + 1,RTSSol,RT))) .

  op upDown : Module ResultTripleSet -> ResultTripleSet .
  eq upDown(M,RTS:ResultTripleSet)
   = upDown#(M,empty,RTS:ResultTripleSet) .
  op upDown# : Module ResultTripleSet ResultTripleSet -> ResultTripleSet .
  eq upDown#(M,RTS':ResultTripleSet, empty)
   = RTS':ResultTripleSet .
  eq upDown#(M,RTS':ResultTripleSet, {T,TP,S} | RTS:ResultTripleSet)
   = upDown#(M,{getTerm(metaReduce(M,T)),TP,upDown(M,S)} 
               | RTS':ResultTripleSet,RTS:ResultTripleSet) .

  op upDown : Module Substitution -> Substitution .
  eq upDown(M,S:Substitution)
   = upDown#(M,none,S:Substitution) .
  op upDown# : Module Substitution Substitution -> Substitution .
  eq upDown#(M,S':Substitution,none) 
   = S':Substitution .
  eq upDown#(M,S':Substitution,V <- T ; S:Substitution)
   = upDown#(M,S':Substitution ; V <- getTerm(metaReduce(M,T)),S:Substitution) .

endfm
fmod DEFINITION-PROTOCOL-RULES is
  sort Universal . --- Special sort used for unsorted actions (don't remove)
  sort Msg . --- Generic sort for messages
  sort Fresh . --- Sort for private information.
  sort Public . --- Handy sort to say what is public
  subsort Public < Msg .
  op emptyPublic : -> Public .
  op nullFresh : -> Fresh .

  sort MsgSet .
  subsort Msg < MsgSet .
  op emptyMsgSet : -> MsgSet [ctor] .
  op _,_ : MsgSet MsgSet -> MsgSet
    [ctor assoc comm id: emptyMsgSet] .

  op noMsg : -> Msg . --- Auxiliar useless message used as a marker

  sort SMsg .

  sort SignedSMsg . 
  subsort SignedSMsg < SMsg .
  op +`(_`) : Msg -> SignedSMsg [format (nir d d d o)] .
  op -`(_`) : Msg -> SignedSMsg [format (nib d d d o)] .

  sort Resuscitated .
  subsort Resuscitated < SMsg .
  op resuscitated`(_`) : Msg -> Resuscitated [ctor format (nic d d d o)] .

  sort LazyLearnt .
  subsort LazyLearnt < SMsg .
  op generatedByIntruder`(_`) : Msg -> LazyLearnt [ctor format (nic d d d o)] .

  sort EmptyList .
  op nil : -> EmptyList [ctor format (ni d)] .
  op _,_ : EmptyList EmptyList -> EmptyList
    [ctor assoc id: nil format (d d s d)] .

  sort SMsgList .
  subsort SMsg Resuscitated < SMsgList .
  subsort EmptyList < SMsgList .
  subsort ResuscitatedList < SMsgList .
  op _,_ : SMsgList SMsgList -> SMsgList
    [ctor assoc id: nil format (d d s d)] .

  sort ResuscitatedList .
  subsort Resuscitated < ResuscitatedList .
  subsort EmptyList < ResuscitatedList .
  op _,_ : ResuscitatedList ResuscitatedList -> ResuscitatedList
    [ctor assoc id: nil format (d d s d)] .

  --- We duplicate the SMsgList sort because A-unification may generate
  --- an infinite number of most-general unifiers.
  sort SMsgList-L SMsgList-R .
  op nil : -> SMsgList-R [ctor] .
  op _,_ : SMsg SMsgList-R -> SMsgList-R
    [ctor format (d d s d) gather (e E)] .
  op nil : -> SMsgList-L [ctor] .
  op _,_ : SMsgList-L SMsg -> SMsgList-L
    [ctor format (d d s d) gather (E e)] .
    
  sort FreshSet .
  subsort Fresh < FreshSet .
  op nil : -> FreshSet [ctor] .
  op _,_ : FreshSet FreshSet -> FreshSet 
    [ctor comm assoc id: nil] .
    
  sort Strand .
  op ::_::[_|_] : FreshSet SMsgList-L SMsgList-R -> Strand 
                  [format (ni d d ni s+++ s--- s+++ d s---)] .

  sort StrandSet .
  subsort Strand < StrandSet .
  op empty : -> StrandSet [ctor] .
  op _&_ : StrandSet StrandSet -> StrandSet
    [ctor assoc comm id: empty format (d d d d)] .

  sort Knowledge-!inI Knowledge-inI Knowledge-!= Knowledge 
       Knowledge-irr Knowledge-inst Knowledge-CPSA .
  subsort Knowledge-!inI Knowledge-inI Knowledge-!=
          Knowledge-irr Knowledge-inst Knowledge-CPSA < Knowledge .
  op _!inI : Msg -> Knowledge-!inI [format (ni d o)] .
  op _inI : Msg -> Knowledge-inI [format (niu d o)] .
  op _!=_ : Msg Msg -> Knowledge-!= [comm format (nig d d o)] .
  op _or_ : Knowledge-!= Knowledge-!= -> Knowledge-!= 
            [assoc comm format (nig d d o)] .
  op _and_ : Knowledge-!= Knowledge-!= -> Knowledge-!= 
             [assoc comm format (nig d d o)] .
  op irr`(_`) : Msg -> Knowledge-irr [format (nim d d d o)] .
  op inst`(_`) : Msg -> Knowledge-inst [format (nim d d d o)] .
  op _before_ : MsgInStrand MsgInStrand -> Knowledge-CPSA [format (nim d d o)] .
  op secret`(_`) : Msg -> Knowledge-CPSA [format (nim d d d o)] .

  sort MsgInStrand PosNat .
  op `(_InStrand_`) : PosNat Fresh -> MsgInStrand .

  ops 1st 2nd 3rd 4th 5th 6th 7th 8th 9th 10th 11th 12th 13th 14th 15th 16th 17th 18th 19th 20th : -> PosNat .
  op z : -> PosNat .
  op s : PosNat -> PosNat [iter] .
  
  sort Ghost .
  op ghost`(_`,_`,_`,_`,_`) : Msg StrandSet IntruderKnowledge SMsgList Properties 
                        -> Ghost 
     [frozen format (ni d s+++ d d d si d si d si s--- d)] .

  sort GhostList .
  subsort Ghost < GhostList .
  op nil : -> GhostList [ctor format (ni d)] .
  op _,_ : GhostList GhostList -> GhostList 
           [ctor assoc id: nil format (d d n d)] .
  
  sort IntruderKnowledge-!inI IntruderKnowledge-inI 
       IntruderKnowledge-!= IntruderKnowledgeElem IntruderKnowledge 
       IntruderKnowledge-irr IntruderKnowledge-inst IntruderKnowledge-CPSA 
       IntruderKnowledge-empty .
  subsort IntruderKnowledge-empty < IntruderKnowledge-!inI .
  subsort IntruderKnowledge-empty < IntruderKnowledge-inI .
  subsort IntruderKnowledge-empty < IntruderKnowledge-!= .
  subsort IntruderKnowledge-empty < IntruderKnowledge-irr .
  subsort IntruderKnowledge-empty < IntruderKnowledge-inst .
  subsort IntruderKnowledge-empty < IntruderKnowledge-CPSA .
  subsort IntruderKnowledge-empty < IntruderKnowledge .
  subsort IntruderKnowledge-!inI IntruderKnowledge-inI 
          IntruderKnowledge-!= 
          IntruderKnowledge-irr 
          IntruderKnowledge-inst 
          IntruderKnowledge-CPSA
          < IntruderKnowledge .
  subsort Knowledge-!inI < IntruderKnowledge-!inI .
  subsort Knowledge-inI < IntruderKnowledge-inI .
  subsort Knowledge-!= < IntruderKnowledge-!= .
  subsort Knowledge-irr < IntruderKnowledge-irr .
  subsort Knowledge-inst < IntruderKnowledge-inst .
  subsort Knowledge-CPSA < IntruderKnowledge-CPSA .
  subsort Knowledge < IntruderKnowledgeElem < IntruderKnowledge .
  op empty : -> IntruderKnowledge-empty [ctor] .
  op _,_ : IntruderKnowledge IntruderKnowledge -> IntruderKnowledge
    [ctor assoc comm id: empty format (d d d d)] .
  op _,_ : IntruderKnowledge-!inI IntruderKnowledge-!inI 
           -> IntruderKnowledge-!inI [ditto] .
  op _,_ : IntruderKnowledge-inI IntruderKnowledge-inI 
           -> IntruderKnowledge-inI [ditto] .
  op _,_ : IntruderKnowledge-!= IntruderKnowledge-!=
           -> IntruderKnowledge-!= [ditto] .
  op _,_ : IntruderKnowledge-irr IntruderKnowledge-irr
           -> IntruderKnowledge-irr [ditto] .
  op _,_ : IntruderKnowledge-inst IntruderKnowledge-inst
           -> IntruderKnowledge-inst [ditto] .
  op _,_ : IntruderKnowledge-CPSA IntruderKnowledge-CPSA
           -> IntruderKnowledge-CPSA [ditto] .
  op _,_ : IntruderKnowledge-empty IntruderKnowledge-empty
           -> IntruderKnowledge-empty [ditto] .

  sort Properties .
  op nil : -> Properties [ctor format (ni d)] .

  sort System .

  ************************
  --- Stuff for never patterns
  sort ExclusionPattern .
  subsort ExclusionPattern < Properties .

  --- neverPattern as StrandSet + IntruderKnowledge
  sort NeverPattern .
  sort NeverPatternSet .
  subsort  NeverPattern < NeverPatternSet .

  op _||_ : StrandSet IntruderKnowledge -> NeverPattern .
  op nil : -> NeverPatternSet .
  op __ : NeverPatternSet NeverPatternSet -> NeverPatternSet  
  [ctor assoc comm id: nil format (d n d)]  .

  op never : NeverPatternSet -> ExclusionPattern .
  ************************

  op _||_||_||_||_
    : StrandSet IntruderKnowledge SMsgList GhostList Properties -> System 
      [format (d n d n d n d n d d)] .

  --- Auxiliary sorts for comparing strands in _implies_ function
  sort SMsgSet .
  subsort SMsg < SMsgSet .
  op emptySMsgSet : -> SMsgSet [ctor] .
  op _;_ : SMsgSet SMsgSet -> SMsgSet
    [ctor assoc comm id: emptySMsgSet] .

  sort SMsgList$ .
  subsort SMsgList < SMsgList$ .
  subsort SMsgSet < SMsgList$ .
  op _,_ : SMsgList$ SMsgList$ -> SMsgList$ [ditto] . --- assoc
  
  sort SMsgList-L$ SMsgList-R$ .
  subsort SMsgList-L < SMsgList-L$ .
  subsort SMsgList-R < SMsgList-R$ .
  op _,_ : SMsgSet SMsgList-R$ -> SMsgList-R$ [ditto] .
  op _,_ : SMsgList-L$ SMsgSet -> SMsgList-L$ [ditto] .
    
  sort Strand$ .
  subsort Strand < Strand$ .
  op ::_::[_|_] : FreshSet SMsgList-L$ SMsgList-R$ -> Strand$ [ditto] .

  sort StrandSet$ .
  subsort Strand$ < StrandSet$ .
  subsort StrandSet < StrandSet$ .
  op _&_ : StrandSet$ StrandSet$ -> StrandSet$ [ditto] .

  *** System$ ********************************************
  sort System$ .
  subsort System < System$ .
  op _||_||_||_||_
    : StrandSet$ IntruderKnowledge SMsgList GhostList Properties 
   -> System$ [ditto] .
      
  subsort SMsgSet < SMsgList .
  op _,_ : SMsgSet SMsgList-R -> SMsgList-R [ditto] .
  op _,_ : SMsgList-L SMsgSet -> SMsgList-L [ditto] .

endfm

fmod GLOBAL-STRATEGY is
  sort GlobalStrategy .
  ops S1 S2 : -> GlobalStrategy .
endfm

fmod DEFINITION-CONSTRAINTS is
  protecting DEFINITION-PROTOCOL-RULES .
  protecting GLOBAL-STRATEGY .

  sort LConstraint DConstraint nIConstraint Constraint .
  subsort LConstraint DConstraint nIConstraint < Constraint .
  op _inL : MsgSet -> LConstraint [format (d g o)] .
  op _notLeq_ : Msg Msg -> DConstraint [format (d g d o)] .
  op _notInI : Msg -> nIConstraint [format (d g o)] .

  sort CtrSet .
  subsort Constraint < CtrSet .
  op empty : -> CtrSet [ctor] .
  op _,_ : CtrSet CtrSet -> CtrSet
    [ctor assoc comm id: empty format (d d s d) ] .

  sort GrammarRule .
  op grl_=>_. : CtrSet LConstraint -> GrammarRule [format (n d d d d d)] .

  sort GrammarRuleSet .
  subsort GrammarRule < GrammarRuleSet .
  op empty : -> GrammarRuleSet [ctor] .
  op _;_ : GrammarRuleSet GrammarRuleSet -> GrammarRuleSet
    [ctor assoc comm id: empty] .

  sort Grammar ResultGrammarNarrowing .
  subsort GrammarRuleSet < Grammar .

  sort GrammarList .
  subsort Grammar < GrammarList .
  op errorInUserSeedTerms : -> GrammarList [ctor format (r o)] .
  op errorInProtocolStrands : -> GrammarList [ctor format (r o)] .
  op errorInDolevYaoStrands : -> GrammarList [ctor format (r o)] .
  op errorInProtocolOrDolevYaoStrands : -> GrammarList [ctor format (r o)] .
  op none : -> GrammarList [ctor] .
  op _|_ : GrammarList GrammarList -> GrammarList
    [ctor assoc id: none format (d n d d)] .

  sort Grammar&Strategy .
  op `(_!_`) : Grammar GlobalStrategy -> Grammar&Strategy .

  sort Grammar&StrategyList .
  subsort Grammar&Strategy < Grammar&StrategyList .
  op none : -> Grammar&StrategyList [ctor] .
  op _|_ : Grammar&StrategyList Grammar&StrategyList -> Grammar&StrategyList
    [ctor assoc id: none format (d n d d)] .

endfm
fmod PROTOCOL-EXAMPLE-SYMBOLS is
  --- Importing sorts Msg, Fresh, Public, and GhostData
  protecting DEFINITION-PROTOCOL-RULES .
  
  ----------------------------------------------------------
  --- Overwrite this module with the syntax of your protocol
  --- Notes:
  --- * Sort Msg and Fresh are special and imported
  --- * Every sort must be a subsort of Msg
  --- * No sort can be a supersort of Msg
  ----------------------------------------------------------

  --- Sort Information 
  sorts Name Nonce Key Enc .
  subsort Name Nonce Enc Key < Msg .
  subsort Name < Key .
  subsort Name < Public .

  --- Encoding operators for public/private encryption
  op pk : Key Msg -> Enc [frozen] .
  op sk : Key Msg -> Enc [frozen] .

  --- Nonce operator
  op n : Name Fresh -> Nonce [frozen] .
  
  --- Principals
  op a : -> Name . --- Alice
  op b : -> Name . --- Bob
  op i : -> Name . --- Intruder
  
 --- Associativity operator
  op _;_ : Msg  Msg  -> Msg [frozen] .
  
endfm

fmod PROTOCOL-EXAMPLE-ALGEBRAIC is
  protecting PROTOCOL-EXAMPLE-SYMBOLS .
  
  ----------------------------------------------------------
  --- Overwrite this module with the algebraic properties 
  --- of your protocol
  ----------------------------------------------------------

  var Z : Msg .
  var Ke : Key .
  
  *** Encryption/Decryption Cancellation
  eq pk(Ke,sk(Ke,Z)) = Z [nonexec] .
  eq sk(Ke,pk(Ke,Z)) = Z [nonexec] .

endfm

fmod PROTOCOL-SPECIFICATION is
  protecting PROTOCOL-EXAMPLE-SYMBOLS .
  protecting DEFINITION-PROTOCOL-RULES .

  ----------------------------------------------------------
  --- Overwrite this module with the strands 
  --- of your protocol
  ----------------------------------------------------------
  
endfm

mod STRAND-GENERAL-RULES is
  protecting PROTOCOL-EXAMPLE-SYMBOLS .
  protecting PROTOCOL-EXAMPLE-ALGEBRAIC .

  ---------------------------------------------------------------------------
  --- DO NOT modify this module for your protocol
  ---------------------------------------------------------------------------

  var SS : StrandSet .
  var K : IntruderKnowledge .
  var ML : SMsgList .
  var L1 : SMsgList-L .
  var L2 : SMsgList-R .
  var M : Msg .
  var rrL : FreshSet .
  var GL : GhostList .
  var PP : Properties .
  
  *** General Rules
  
  *** Accept output message but don't add a new constraint
  rl ((:: rrL :: [ L1 | +(M), L2 ]) & SS) 
     || M !inI, K 
     || +(M), ML
     || GL 
     || PP
  => ((:: rrL :: [ L1, +(M) | L2 ]) & SS) 
     || M inI, K  
     || ML
     || GL 
     || PP
     [nonexec] .

  *** Accept output message & introduce constraint
  rl ((:: rrL :: [ L1 | (+(M), L2) ]) & SS) 
     || K 
     || +(M), ML
     || GL 
     || PP
  => ((:: rrL :: [ L1, +(M) | L2 ]) & SS) 
     || K  
     || ML
     || GL 
     || PP
     [nonexec] .

endm
     
mod STRAND-EXAMPLE-RULES is
  protecting PROTOCOL-EXAMPLE-SYMBOLS .
  protecting PROTOCOL-EXAMPLE-ALGEBRAIC .
  protecting STRAND-GENERAL-RULES .
endm

mod PROTOCOL-EXAMPLE-RULES is
  protecting PROTOCOL-EXAMPLE-SYMBOLS .
  protecting PROTOCOL-EXAMPLE-ALGEBRAIC .
endm

mod STRAND-GENERAL-RULES-INPUT is
  protecting STRAND-GENERAL-RULES .
  var SS : StrandSet .
  var K : IntruderKnowledge .
  var ML : SMsgList .
  var L1 : SMsgList-L .
  var L2 : SMsgList-R .
  var M : Msg .
  var rrL : FreshSet .
  var GL : GhostList .
  var PP : Properties .
  
  *** General Rules
  
  *** Accept input message
  rl ((:: rrL :: [ L1 | -(M), L2 ]) & SS) 
     || M inI, K 
     || -(M), ML
     || GL 
     || PP
  => ((:: rrL :: [ L1, -(M) | L2 ]) & SS) 
     || K  
     || ML
     || GL 
     || PP
     [nonexec] .

endm
     
mod STRAND-EXAMPLE-RULES-INPUT is
  protecting PROTOCOL-EXAMPLE-SYMBOLS .
  protecting PROTOCOL-EXAMPLE-ALGEBRAIC .
  protecting STRAND-GENERAL-RULES-INPUT .
endm


fmod DEFINITION-CONSTRAINTS-HANDLING is
  protecting DEFINITION-CONSTRAINTS .
  protecting TERMSET .
  protecting MODULE-HANDLING .

  eq X:Constraint , X:Constraint = X:Constraint . 
     ---Moved from DEFINITION-CONSTRAINTS
  eq X:GrammarRule ; X:GrammarRule = X:GrammarRule . 
     ---Moved from DEFINITION-CONSTRAINTS

  op _inCtrSet_ : Constraint CtrSet -> Bool .
  eq C:Constraint inCtrSet (C:Constraint , C:CtrSet) = true .
  eq C:Constraint inCtrSet C:CtrSet = false [owise] .

  op get-notLeq : CtrSet -> CtrSet .
  eq get-notLeq((X:DConstraint,C:CtrSet))
   = X:DConstraint , get-notLeq(C:CtrSet) .
  eq get-notLeq(C:CtrSet)
   = empty
  [owise] .

  op get-except-notLeq : CtrSet -> CtrSet .
  eq get-except-notLeq((X:DConstraint,C:CtrSet))
   = get-except-notLeq(C:CtrSet) .
  eq get-except-notLeq(C:CtrSet)
   = C:CtrSet
  [owise] .

  op grammar2Rules : GrammarRuleSet -> RuleSet .
  eq grammar2Rules(empty)
   = none .
  eq grammar2Rules(grl C:CtrSet => L:LConstraint . ; G:GrammarRuleSet)
   = rl upTerm(C:CtrSet) => upTerm(L:LConstraint) [nonexec] .
     grammar2Rules(G:GrammarRuleSet) .

  op grammar2Module : GrammarRuleSet -> Module [memo] .
  eq grammar2Module(G:GrammarRuleSet)
   = addRules(
       grammar2Rules(G:GrammarRuleSet),
       upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true)) .

  op nonEmpty : GrammarRuleSet -> GrammarRuleSet [memo] .
  eq nonEmpty(empty)
   = empty .
  eq nonEmpty(grl empty => L:LConstraint . ; G:GrammarRuleSet)
   = nonEmpty( G:GrammarRuleSet) .
  eq nonEmpty(grl C:CtrSet => L:LConstraint . ; G:GrammarRuleSet)
   = grl C:CtrSet => L:LConstraint . ; nonEmpty(G:GrammarRuleSet)
  [owise] .

  op filterEmpty : GrammarList -> GrammarList .
  eq filterEmpty(G:Grammar | GS:GrammarList) 
   = if G:Grammar == (empty).GrammarRuleSet
     then none
     else G:Grammar
     fi 
     | filterEmpty(GS:GrammarList) .
  eq filterEmpty(G:GrammarList) 
   = G:GrammarList [owise] .

  op only-inL : GrammarList -> GrammarList .
  eq only-inL(grl X:Msg inL => Y:Msg inL . ; G:GrammarRuleSet)
   = grl X:Msg inL => Y:Msg inL . ; only-inL(G:GrammarRuleSet) .
  eq only-inL(G:GrammarRuleSet)
   = empty [owise] .

endfm


fmod DEFINITION-PROTOCOL-RULES-HANDLING is
  protecting DEFINITION-PROTOCOL-RULES .
  protecting PROTOCOL-EXAMPLE-SYMBOLS .
  protecting META-LEVEL .
  protecting TERMSET .
  protecting RESULT-CONTEXT-SET .

  eq X:Msg , X:Msg = X:Msg . ---Moved from DEFINITION-PROTOCOL-RULES

  op downMsgSet : TermSet -> MsgSet .
  eq downMsgSet(emptyTermSet)
   = emptyMsgSet .
  eq downMsgSet('emptyMsgSet.MsgSet | TS:TermSet)
   = downMsgSet(TS:TermSet) .
  eq downMsgSet(T:Term | TS:TermSet)
    = downTerm(T:Term,emptyMsgSet) , downMsgSet(TS:TermSet) .

  op downMsgSet : TermList -> MsgSet .
  eq downMsgSet(empty)
   = emptyMsgSet .
  eq downMsgSet(('emptyMsgSet.MsgSet, TS:TermList))
   = downMsgSet(TS:TermList) .
  eq downMsgSet((T:Term,TS:TermList))
    = downTerm(T:Term,emptyMsgSet) , downMsgSet(TS:TermList) .

  op toMsgSet : SMsgList -> MsgSet .
  eq toMsgSet((nil).SMsgList) = emptyMsgSet .
  eq toMsgSet((M:SMsg,L:SMsgList)) = toMsg(M:SMsg), toMsgSet(L:SMsgList) .

  op toMsg : SMsg -> Msg .
  eq toMsg(+(M:Msg)) = M:Msg .
  eq toMsg(-(M:Msg)) = M:Msg .

  *** SystemSet ********************************************
  sort SystemSet .
  subsort System < SystemSet .
  op empty : -> SystemSet .
  op __ : SystemSet SystemSet -> SystemSet
    [ctor assoc comm id: empty format (d n d)] .

  *** IdSystem ********************************************
  sort Id IdElem .
  op _[_] : Nat Nat -> IdElem [ctor] .
  op _{_} : Nat Nat -> IdElem [ctor] .
  op _{_`,_] : Nat Nat Nat -> IdElem [ctor] .
  subsort Nat < IdElem < Id .
  op _._ : Id Id -> Id [ctor assoc] .

  op _++ : Id -> Id .
  eq (N:Nat) ++ = N:Nat + 1 .
  eq (X:Id . N:Nat) ++ = X:Id . (N:Nat + 1) .
  eq (N1:Nat [N2:Nat]) ++ = N1:Nat [ N2:Nat + 1 ] .
  eq (X:Id . (N1:Nat [N2:Nat])) ++ = X:Id . (N1:Nat [ N2:Nat + 1 ]) .
  eq (N1:Nat {N2:Nat}) ++ = N1:Nat {N2:Nat + 1} .
  eq (X:Id . (N1:Nat {N2:Nat})) ++ = X:Id . (N1:Nat {N2:Nat + 1} ) .
  eq (N1:Nat {N2:Nat,N3:Nat]) ++ = N1:Nat{N2:Nat,N3:Nat + 1] .
  eq (X:Id . (N1:Nat {N2:Nat,N3:Nat])) ++ = X:Id . (N1:Nat{N2:Nat,N3:Nat + 1]) .

  op _.._ : Id Nat -> Id .
  eq (X:Id . N:Nat) .. N:Nat = (X:Id . N:Nat) .
  eq X:Id .. N:Nat = X:Id . N:Nat [owise] .

  op _<<<_ : Id Id -> Bool .
  eq X:Id <<< X:Id = true .
  eq X:Id <<< X:Id . X':Id = true .
  eq N1:Nat <<< (N1:Nat[N2:Nat]) = true .
  eq N1:Nat <<< (N1:Nat{N2:Nat}) = true .
  eq N1:Nat <<< (N1:Nat{N2:Nat,N3:Nat]) = true .
  eq N1:Nat{N2:Nat} <<< (N1:Nat{N2:Nat,N3:Nat]) = true .
  eq N1:Nat <<< ((N1:Nat[N2:Nat]) . X':Id) = true .
  eq N1:Nat <<< ((N1:Nat{N2:Nat}) . X':Id)  = true .
  eq N1:Nat <<< ((N1:Nat{N2:Nat,N3:Nat]) . X':Id)  = true .
  eq N1:Nat{N2:Nat} <<< ((N1:Nat{N2:Nat,N3:Nat]) . X':Id) = true .
  eq (X:Id . N1:Nat) <<< (X:Id . (N1:Nat[N2:Nat]) . X':Id) = true .
  eq (X:Id . N1:Nat) <<< (X:Id . (N1:Nat{N2:Nat}) . X':Id)  = true .
  eq (X:Id . N1:Nat) <<< (X:Id . (N1:Nat{N2:Nat,N3:Nat]) . X':Id)  = true .
  eq (X:Id . (N1:Nat{N2:Nat})) <<< (X:Id . (N1:Nat{N2:Nat,N3:Nat]) . X':Id) = true .
  eq X:Id <<< X':Id = false [owise] .

  sort IdSystem .
  op <_>_ : Id System -> IdSystem [format (d ! o d d)] .

  sort IdSystemSet .
  subsort IdSystem < IdSystemSet .
  op empty : -> IdSystemSet .
  op __ : IdSystemSet IdSystemSet -> IdSystemSet
    [ctor assoc comm id: empty format (d n d)] .

  op getId : IdSystem -> Id .
  eq getId(< I:Id > S:System) = I:Id .

  op setId : Id System -> IdSystem .
  eq setId(I:Id,S:System) 
   = < I:Id > S:System .

  op setIdUnif : Id SystemSet ~> IdSystemSet .
  eq setIdUnif(I:Id,S:System) 
   = setId+(I:Id,S:System) .
  eq setIdUnif(X:Id . N:Nat,SS:SystemSet) 
   = setId+(X:Id . (N:Nat { 1 }),SS:SystemSet) .

  op setIdVariants : Id SystemSet ~> IdSystemSet .
  eq setIdVariants(I:Id,S:System) 
   = setId+(I:Id,S:System) .
  eq setIdVariants(N:Nat,SS:SystemSet) 
   = setId+(N:Nat [ 1 ],SS:SystemSet) .
  eq setIdVariants(X:Id . N:Nat,SS:SystemSet) 
   = setId+(X:Id . (N:Nat [ 1 ]),SS:SystemSet) .
  eq setIdVariants(X:Id . (N:Nat {N2:Nat}),SS:SystemSet) 
   = setId+(X:Id . (N:Nat {N2:Nat, 1 ]),SS:SystemSet) .

  op setId+ : Id SystemSet ~> IdSystemSet .
  eq setId+(I:Id, empty) = empty .
  eq setId+(I:Id, S:System SS:SystemSet)
   = setId(I:Id, S:System) setId+(I:Id ++, SS:SystemSet) .

  op remId : IdSystemSet -> SystemSet .
  eq remId(empty) = empty .
  eq remId((< I:Id > S:System) SS:IdSystemSet)
   = S:System remId(SS:IdSystemSet) .

  op filterId : Id IdSystemSet -> IdSystemSet .
  eq filterId(I*:Id,empty)
   = empty .
  eq filterId(I*:Id,(< I:Id > S:System) SS:IdSystemSet)
   = if I*:Id <<< I:Id or-else I:Id <<< I*:Id
     then (< I:Id > S:System)
     else empty
     fi filterId(I*:Id,SS:IdSystemSet) .

  op toSMsgList : SMsgList-L$ -> SMsgList$ .
  eq toSMsgList((nil).SMsgList-L) = (nil).SMsgList .
  eq toSMsgList((L:SMsgList-L$,M:SMsgSet)) = toSMsgList(L:SMsgList-L$), M:SMsgSet .
  
  op toSMsgList : SMsgList-R$ -> SMsgList$ .
  eq toSMsgList((nil).SMsgList-R) = (nil).SMsgList .
  eq toSMsgList((M:SMsgSet,L:SMsgList-R$)) = M:SMsgSet, toSMsgList(L:SMsgList-R$) .
  
  op toSMsgList-L : SMsgList$ -> SMsgList-L$ .
  eq toSMsgList-L((nil).SMsgList) = (nil).SMsgList-L .
  eq toSMsgList-L((L:SMsgList$,M:SMsgSet)) = toSMsgList-L(L:SMsgList$), M:SMsgSet .
  
  op toSMsgList-R : SMsgList$ -> SMsgList-R$ .
  eq toSMsgList-R((nil).SMsgList) = (nil).SMsgList-R .
  eq toSMsgList-R((M:SMsgSet,L:SMsgList$)) = M:SMsgSet, toSMsgList-R(L:SMsgList$) .

  op _in_ : SMsg SMsgList -> Bool .
  eq X:SMsg in (L1:SMsgList,X:SMsg,L2:SMsgList) = true .
  eq X:SMsg in L:SMsgList = false [owise] .

  op _in_ : Msg MsgSet -> Bool .
  eq X:Msg in (X:Msg,S:MsgSet) = true .
  eq X:Msg in S:MsgSet = false [owise] .

  op _in_ : Term TermList -> Bool .
  eq X:Term in (X1:TermList,X:Term,X2:TermList) = true .
  eq X:Term in X:TermList = false [owise] .

  op _in_ : Fresh FreshSet ~> Bool .
  eq F:Fresh in (F:Fresh,S:FreshSet) = true .
  eq F:Fresh in S:FreshSet = false [owise] .

  *** filters 
  op testFreshInstantiated : Substitution -> Bool .
  eq testFreshInstantiated(Subst:Substitution)
   = testFreshInstantiated(nil,Subst:Substitution) .

  op testFreshInstantiated : FreshSet Substitution -> Bool .
  eq testFreshInstantiated(F:FreshSet,none)
   = false .
  eq testFreshInstantiated(F:FreshSet,V:Variable <- T:Term ; Subst:Substitution)
   = (
      getType(V:Variable) == 'Fresh 
      and-then 
      (F:FreshSet == nil or-else V:Variable in F:FreshSet)
     )
     or-else
     testFreshInstantiated(F:FreshSet,Subst:Substitution) .

  op _in_ : Variable FreshSet ~> Bool .
  ceq V:Variable in FS:FreshSet 
    = F:Fresh in FS:FreshSet 
   if F:Fresh := downTerm(V:Variable,nullFresh) /\ F:Fresh =/= nullFresh .
  eq V:Variable in FS:FreshSet 
   = false [owise] .

  op fresh[_] : SubstitutionSet -> SubstitutionSet .
  eq fresh[SS:SubstitutionSet]
   = fresh[nil,SS:SubstitutionSet] .

  op fresh[_,_] : FreshSet SubstitutionSet -> SubstitutionSet .
  eq fresh[F:FreshSet,empty]
   = empty .
  eq fresh[F:FreshSet,S:Substitution | SS:SubstitutionSet]
   = if testFreshInstantiated(F:FreshSet,S:Substitution)
     then empty
     else S:Substitution
     fi
     | fresh[F:FreshSet,SS:SubstitutionSet] .
  ***
     
  op toStrandSet$ : StrandSet -> StrandSet$ .
  eq toStrandSet$(empty) 
   = empty .
  eq toStrandSet$(
       :: RL:FreshSet :: [ L:SMsgList-L | L':SMsgList-R] & SS:StrandSet)
   = :: RL:FreshSet :: 
     [ toSMsgList-L$(L:SMsgList-L) | toSMsgList-R$(L':SMsgList-R) ] 
     & toStrandSet$(SS:StrandSet) .

  op toSMsgList-R$ : SMsgList-R -> SMsgList-R$ .
  eq toSMsgList-R$(L:SMsgList-R) 
   = toSMsgList-R(toSMsgList$(L:SMsgList-R)) .

  op toSMsgList-L$ : SMsgList-L -> SMsgList-L$ .
  eq toSMsgList-L$(L:SMsgList-L) 
   = toSMsgList-L(toSMsgList$(L:SMsgList-L)) .

  op toSMsgList$ : SMsgList-L -> SMsgList$ .
  eq toSMsgList$(X:SMsgList-L) = toSMsgList$(toSMsgList(X:SMsgList-L)) .
  op toSMsgList$ : SMsgList-R -> SMsgList$ .
  eq toSMsgList$(X:SMsgList-R) = toSMsgList$(toSMsgList(X:SMsgList-R)) .

  op toSMsgList$ : SMsgList -> SMsgList$ .
  ops toSMsgList$+ toSMsgList$- : SMsgList SMsgSet -> SMsgList$ .
  eq toSMsgList$((nil).SMsgList) = (nil).SMsgList .
  eq toSMsgList$((+(M:Msg),L:SMsgList)) = toSMsgList$+(L:SMsgList,+(M:Msg)) .
  eq toSMsgList$((-(M:Msg),L:SMsgList)) = toSMsgList$-(L:SMsgList,-(M:Msg)) .
    
  eq toSMsgList$+(nil,MS:SMsgSet) = MS:SMsgSet .
  eq toSMsgList$+((+(M:Msg),L:SMsgList),MS:SMsgSet) 
   = toSMsgList$+(L:SMsgList,(MS:SMsgSet ; +(M:Msg))) .
  eq toSMsgList$+((-(M:Msg),L:SMsgList),MS:SMsgSet) 
   = (MS:SMsgSet , toSMsgList$-(L:SMsgList,-(M:Msg))) .

  eq toSMsgList$-(nil,MS:SMsgSet) = MS:SMsgSet .
  eq toSMsgList$-((-(M:Msg),L:SMsgList),MS:SMsgSet) 
   = toSMsgList$-(L:SMsgList,(MS:SMsgSet ; -(M:Msg))) .
  eq toSMsgList$-((+(M:Msg),L:SMsgList),MS:SMsgSet) 
   = (MS:SMsgSet , toSMsgList$+(L:SMsgList,+(M:Msg))) .

  --- End auxiliary

  op only-Output : SMsgList -> SMsgList .
  eq only-Output(+(X:Msg),L:SMsgList) = +(X:Msg),only-Output(L:SMsgList) .
  eq only-Output(X:SMsg,L:SMsgList) = only-Output(L:SMsgList) .
  eq only-Output(L:SMsgList) = L:SMsgList .
     
  op only-Input : SMsgList -> SMsgList .
  eq only-Input(-(X:Msg),L:SMsgList) = -(X:Msg),only-Input(L:SMsgList) .
  eq only-Input(X:SMsg,L:SMsgList) = only-Input(L:SMsgList) .
  eq only-Input(L:SMsgList) = L:SMsgList .
     
  op getStrands : IdSystem -> StrandSet .
  eq getStrands(
       < I:Id >
       (SS:StrandSet || K:IntruderKnowledge
        || ML:SMsgList || GL:GhostList 
        || PP:Properties) )
   = SS:StrandSet .

  op getIntruderKnowledge : IdSystem -> IntruderKnowledge .
  eq getIntruderKnowledge(
       < I:Id >
       (SS:StrandSet || K:IntruderKnowledge
        || ML:SMsgList || GL:GhostList 
        || PP:Properties) )
   = K:IntruderKnowledge .

  op downStrandSet : TermSet -> StrandSet$ .
  eq downStrandSet(T:Term)
   = downTerm(T:Term,(empty).StrandSet) .

  op downIntruderKnowledge : NeTermList -> IntruderKnowledge .
  eq downIntruderKnowledge((T:Term,T:NeTermList))
   = downIntruderKnowledge(TermSet((T:Term,T:NeTermList))) .

  op upIntruderKnowledge : IntruderKnowledge -> TermList .
  eq upIntruderKnowledge(X:IntruderKnowledgeElem,K:IntruderKnowledge)
   = (upTerm(X:IntruderKnowledgeElem),
      upIntruderKnowledge(K:IntruderKnowledge)) .
  eq upIntruderKnowledge(empty) = empty .

  op downIntruderKnowledge : TermSet -> IntruderKnowledge .
  eq downIntruderKnowledge(emptyTermSet)
   = empty .
  eq downIntruderKnowledge(T:Term | TS:TermSet)
   = (downTerm(T:Term,(empty).IntruderKnowledge-empty),
      downIntruderKnowledge(TS:TermSet)) .

  op downGhostList : TermSet -> GhostList .
  eq downGhostList(T:Term)
   = downTerm(T:Term,(nil).GhostList) .

  op downStateSet : TermSet -> SystemSet .
  eq downStateSet(TS:TermSet)
   = downSystemSet(TS:TermSet) .

  op downSystemSet : TermSet -> SystemSet .
  eq downSystemSet(emptyTermSet)
   = empty .
  eq downSystemSet('empty.SystemSet | TS:TermSet)
   = downSystemSet(TS:TermSet) .
  eq downSystemSet(T:Term | TS:TermSet)	
   = (downTerm(T:Term,(empty).SystemSet)
     downSystemSet(TS:TermSet)) .

  op downIdSystemSet : TermSet -> IdSystemSet .
  eq downIdSystemSet(emptyTermSet)
   = empty .
  eq downIdSystemSet('empty.IdSystemSet | TS:TermSet)
   = downIdSystemSet(TS:TermSet) .
  eq downIdSystemSet(T:Term | TS:TermSet)	
   = (downTerm(T:Term,(empty).IdSystemSet)
     downIdSystemSet(TS:TermSet)) .

  op downSystemSet : ResultContextSet -> SystemSet .
  eq downSystemSet(RT:ResultContextSet)
   = downSystemSet(toTriple(upModule('PROTOCOL-EXAMPLE-SYMBOLS,true),
                            RT:ResultContextSet)) .

  op downSystemSet : ResultTripleSet -> SystemSet .
  eq downSystemSet(RT:ResultTripleSet)
   = downSystemSet(getTerms(RT:ResultTripleSet)) .

  op addStrands : StrandSet SystemSet -> SystemSet .
  eq addStrands(SS':StrandSet,
       SS:StrandSet || K:IntruderKnowledge 
       || ML:SMsgList || G:GhostList || PP:Properties)
   =  SS:StrandSet & SS':StrandSet 
      || K:IntruderKnowledge 
      || ML:SMsgList || G:GhostList || PP:Properties  .

  op addIKnowledge : IntruderKnowledge SystemSet -> SystemSet .
  eq addIKnowledge(I:IntruderKnowledge,
       SS:StrandSet || K:IntruderKnowledge 
       || ML:SMsgList || G:GhostList || PP:Properties ) 
   =  SS:StrandSet  
      || (K:IntruderKnowledge,I:IntruderKnowledge) 
      || ML:SMsgList || G:GhostList || PP:Properties  . 

  op makeStrandsInitial : SystemSet -> SystemSet [memo] .
  eq makeStrandsInitial(S:SystemSet
       SS:StrandSet || K:IntruderKnowledge 
       || ML:SMsgList || G:GhostList || PP:Properties ) 
   = (makeStrandsInitial*(SS:StrandSet) 
      || K:IntruderKnowledge 
      || ML:SMsgList || G:GhostList || PP:Properties ) 
     makeStrandsInitial(S:SystemSet) .
  eq makeStrandsInitial(S:SystemSet)
   = S:SystemSet [owise] .

  op makeStrandsInitial* : StrandSet -> StrandSet .
  eq makeStrandsInitial*(S:Strand & SS:StrandSet)
   = makeStrandsInitial**(S:Strand) & makeStrandsInitial*(SS:StrandSet) .
  eq makeStrandsInitial*(S:StrandSet) 
   = S:StrandSet [owise] .

  op makeStrandsInitial** : Strand -> Strand .
  eq makeStrandsInitial**(
     :: rrL:FreshSet :: [L:SMsgList-L | L:SMsgList-R])
   = :: rrL:FreshSet :: 
       [nil | toSMsgList-R(
               toSMsgList(L:SMsgList-L),toSMsgList(L:SMsgList-R)) ] .

  op makeStrandsFinal : SystemSet -> SystemSet .
  eq makeStrandsFinal(S:SystemSet
       SS:StrandSet || K:IntruderKnowledge 
       || ML:SMsgList || G:GhostList || PP:Properties) 
   = (makeStrandsFinal*(SS:StrandSet) 
      || K:IntruderKnowledge 
      || ML:SMsgList || G:GhostList || PP:Properties) 
     makeStrandsFinal(S:SystemSet) .
  eq makeStrandsFinal(S:SystemSet)
   = S:SystemSet [owise] .

  op makeStrandsFinal* : StrandSet -> StrandSet .
  eq makeStrandsFinal*(S:Strand & SS:StrandSet)
   = makeStrandsFinal**(S:Strand) & makeStrandsFinal*(SS:StrandSet) .
  eq makeStrandsFinal*(SS:StrandSet) 
   = SS:StrandSet [owise] .

  op makeStrandsFinal** : Strand -> Strand .
  eq makeStrandsFinal**(
     :: rrL:FreshSet :: [L:SMsgList-L | L:SMsgList-R])
   = :: rrL:FreshSet :: 
       [toSMsgList-L(toSMsgList(L:SMsgList-L),toSMsgList(L:SMsgList-R)) 
        | nil ] .

  op onlyNoInitialStrands : StrandSet -> StrandSet .
  eq onlyNoInitialStrands(empty) 
   = empty .
  eq onlyNoInitialStrands(S:Strand & SS:StrandSet)
   = onlyNoInitialStrands*(S:Strand) 
     & 
     onlyNoInitialStrands(SS:StrandSet) .

  op onlyNoInitialStrands* : Strand -> StrandSet .
  eq onlyNoInitialStrands*(:: rrL:FreshSet :: [nil | L:SMsgList-R])
   = empty .
  eq onlyNoInitialStrands*(S:Strand)
   = S:Strand [owise] .

  op onlyInitialStrands : StrandSet -> StrandSet .
  eq onlyInitialStrands(empty) 
   = empty .
  eq onlyInitialStrands(S:Strand & SS:StrandSet)
   = onlyInitialStrands*(S:Strand) 
     & 
     onlyInitialStrands(SS:StrandSet) .

  op onlyInitialStrands* : Strand -> StrandSet .
  eq onlyInitialStrands*(:: rrL:FreshSet :: [nil | L:SMsgList-R])
   = :: rrL:FreshSet :: [nil | L:SMsgList-R] .
  eq onlyInitialStrands*(S:Strand)
   = empty [owise] .

  op _in_ : Knowledge IntruderKnowledge -> Bool .
  eq X:Knowledge in (X:Knowledge, K:IntruderKnowledge)
   = true .
  eq X:Knowledge in K:IntruderKnowledge
   = false [owise] .
   
  eq X:Knowledge-!= and X:Knowledge-!= = X:Knowledge-!= .
  eq X:Knowledge-!= or X:Knowledge-!= = X:Knowledge-!= .

  op only-!= : IntruderKnowledge -> IntruderKnowledge .
  eq only-!=(X:Knowledge-!=,K:IntruderKnowledge)
   = X:Knowledge-!=,only-!=(K:IntruderKnowledge) .
  eq only-!=(empty) = empty .
  eq only-!=(X:IntruderKnowledgeElem,K:IntruderKnowledge)
   = only-!=(K:IntruderKnowledge) [owise] .
     
  op only-!inI : IntruderKnowledge -> IntruderKnowledge .
  eq only-!inI(X:Knowledge-!inI,K:IntruderKnowledge)
   = X:Knowledge-!inI,only-!inI(K:IntruderKnowledge) .
  eq only-!inI(empty) = empty .
  eq only-!inI(X:IntruderKnowledgeElem,K:IntruderKnowledge)
   = only-!inI(K:IntruderKnowledge) [owise] .
     
  op only-inI : IntruderKnowledge -> IntruderKnowledge .
  eq only-inI(X:Knowledge-inI,K:IntruderKnowledge)
   = X:Knowledge-inI,only-inI(K:IntruderKnowledge) .
  eq only-inI(empty) = empty .
  eq only-inI(X:IntruderKnowledgeElem,K:IntruderKnowledge)
   = only-inI(K:IntruderKnowledge) [owise] .

  op only-irr : IntruderKnowledge -> IntruderKnowledge .
  eq only-irr(X:Knowledge-irr,K:IntruderKnowledge)
   = X:Knowledge-irr,only-irr(K:IntruderKnowledge) .
  eq only-irr((empty).IntruderKnowledge) = empty .
  eq only-irr(X:IntruderKnowledgeElem,K:IntruderKnowledge)
   = only-irr(K:IntruderKnowledge) [owise] .

  op only-inst : IntruderKnowledge -> IntruderKnowledge .
  eq only-inst(X:Knowledge-inst,K:IntruderKnowledge)
   = X:Knowledge-inst,only-inst(K:IntruderKnowledge) .
  eq only-inst((empty).IntruderKnowledge) = empty .
  eq only-inst(X:IntruderKnowledgeElem,K:IntruderKnowledge)
   = only-inst(K:IntruderKnowledge) [owise] .

  op only-inst : System -> IntruderKnowledge .
  eq only-inst(
      SS:StrandSet || K:IntruderKnowledge 
      || ML:SMsgList || G:GhostList || PP:Properties) 
   = only-inst(K:IntruderKnowledge) .

  op only-inVars : IntruderKnowledge TermList -> IntruderKnowledge .
  eq only-inVars(K:IntruderKnowledge,TL:TermList)
   = only-inVars*(K:IntruderKnowledge,Vars(TL:TermList)) .

  op only-inVars* : IntruderKnowledge TermList -> IntruderKnowledge .
  eq only-inVars*((X:IntruderKnowledgeElem,K:IntruderKnowledge),TL:TermList)
   = if any Vars(upTerm(X:IntruderKnowledgeElem)) in TL:TermList
     then X:IntruderKnowledgeElem
     else empty
     fi,
     only-inVars*(K:IntruderKnowledge,TL:TermList) .
  eq only-inVars*(empty,TL:TermList) = empty .

  op length : SMsgList -> Nat .
  eq length((nil).SMsgList) = 0 .
  eq length(X:SMsg, L:SMsgList) = s(length(L:SMsgList)) .

  op length : SMsgList-L -> Nat .
  eq length(L:SMsgList-L) = length(toSMsgList(L:SMsgList-L)) .

  op length : SMsgList-R -> Nat .
  eq length(L:SMsgList-R) = length(toSMsgList(L:SMsgList-R)) .

  op [_] : PosNat -> Nat .
  eq [ z ] = 0 .
  eq [ s(X:PosNat) ] = s([ X:PosNat ]) .

  eq 1st = s(z) .
  eq 2nd = s(1st) .
  eq 3rd = s(2nd) .
  eq 4th = s(3rd) .
  eq 5th = s(4th) .
  eq 6th = s(5th) .
  eq 7th = s(6th) .
  eq 8th = s(7th) .
  eq 9th = s(8th) .
  eq 10th = s(9th) .
  eq 11th = s(10th) .
  eq 12th = s(11th) .
  eq 13th = s(12th) .
  eq 14th = s(13th) .
  eq 15th = s(14th) .
  eq 16th = s(15th) .
  eq 17th = s(16th) .
  eq 18th = s(17th) .
  eq 19th = s(18th) .
  eq 20th = s(19th) .

  --- sort for defining more complex attacks
  sort Attack .
  subsort SystemSet < Attack .
  op downAttack : Term -> Attack .
  eq downAttack(T:Term) = downTerm(T:Term,(empty).SystemSet) .

  op _<<_< : Msg UnificationPair -> UnificationPair .
  eq M:Msg << X:UnificationPair < 
   = upTerm(M:Msg) << X:UnificationPair < .
   
  op _<<_ : Msg Substitution -> Msg .
  eq M:Msg << X:Substitution 
   = downMsgSet(upTerm(M:Msg) << X:Substitution) .

endfm

fmod PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS-HANDLING is
  protecting PROTOCOL-EXAMPLE-SYMBOLS .
  protecting DEFINITION-CONSTRAINTS .
  protecting TERMSET .

  op downCtrSet : TermSet -> CtrSet .
  eq downCtrSet(emptyTermSet)
   = empty .
  eq downCtrSet('empty.CtrSet | TS:TermSet)
    = downCtrSet(TS:TermSet) .
  eq downCtrSet(T:Term | TS:TermSet)
    = downTerm(T:Term,(empty).CtrSet) , downCtrSet(TS:TermSet) .

  op downGrammar : TermSet -> GrammarRuleSet .
  eq downGrammar(T:TermSet) = downGrammarRuleSet(T:TermSet) .

  op downGrammarRuleSet : TermSet -> GrammarRuleSet .
  eq downGrammarRuleSet(emptyTermSet)
   = empty .
  eq downGrammarRuleSet(T:Term | TS:TermSet)
    = downTerm(T:Term,(empty).GrammarRuleSet)
      ; downGrammarRuleSet(TS:TermSet) .

endfm

mod STRAND-EXAMPLE-RULES-WITH-ALL is
  protecting STRAND-EXAMPLE-RULES .
  protecting DEFINITION-PROTOCOL-RULES-HANDLING .
endm

fmod DEFINITION-PROTOCOL-RULES-INPUT is
  pr DEFINITION-PROTOCOL-RULES-HANDLING .
  pr NAT .

  --- Symbols to specify your protocol (Dolev-Yao and Principals)
  op STRANDS-DOLEVYAO : -> StrandSet .
  op STRANDS-PROTOCOL : -> StrandSet .

  --- Attack State to start search
  op ATTACK-STATE : Nat -> Attack .
endfm

fmod DEFINITION-CONSTRAINTS-INPUT is
  pr DEFINITION-PROTOCOL-RULES-INPUT .
  pr DEFINITION-CONSTRAINTS .

  --- Specify your grammar seed terms
  op INITIAL-GRAMMARS : -> Grammar&StrategyList .

  --- Specify extra grammars to be added to the automatically generated ones
  op EXTRA-GRAMMARS : -> Grammar&StrategyList .

  --- Specify your grammar seed terms
  op GENERATED-GRAMMARS : -> GrammarList .

endfm

mod PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS is
  protecting PROTOCOL-EXAMPLE-RULES .
  protecting DEFINITION-CONSTRAINTS .
endm

mod PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS is
  protecting PROTOCOL-EXAMPLE-SYMBOLS .
  protecting DEFINITION-CONSTRAINTS .
endm

mod STRAND-EXAMPLE-RULES-WITH-DOLEVYAO-RULES-WITH-CONSTRAINT-SYMBOLS is
  protecting STRAND-EXAMPLE-RULES .
  protecting DEFINITION-CONSTRAINTS .
endm

mod STRAND-EXAMPLE-RULES-WITH-DOLEVYAO-RULES-WITH-CONSTRAINT-SYMBOLS-METATERM is
  protecting STRAND-EXAMPLE-RULES .
  protecting DEFINITION-CONSTRAINTS .
  protecting META-TERM .
endm
fmod PROTOCOL-EXAMPLE-GHOST is
  pr PROTOCOL-EXAMPLE-SYMBOLS .
  pr META-LEVEL .

  *** ghost predicate ************************************************  
  op isGhostMsg : Msg -> Bool [memo] .
  eq isGhostMsg(X:Msg) 
   = upTerm(X:Msg) :: Variable or-else X:Msg :: Public [owise] .
endfm

fmod GENERATE-RULES-PRE is
  protecting DEFINITION-PROTOCOL-RULES-INPUT .
  protecting META-LEVEL .
  protecting DEFINITION-PROTOCOL-RULES-HANDLING .
  protecting MODULE-HANDLING .
  protecting META-NARROWING-SEARCH .

  op extract : Term Module ~> Term .
  ceq extract(Q:Qid,M:Module)
    = T:Term
   if (eq Q:Qid = T:Term [AtS:AttrSet] .) 
      := getEqsOfQid(M:Module,Q:Qid,nil) .
  ceq extract(F:Qid[F:Term],M:Module)
    = T:Term
   if (eq F:Qid[F:Term] = T:Term [AtS:AttrSet] .) EQ:EquationSet
      := getEqsOfQid(M:Module,F:Qid,'Nat) .

  ---------------------------------------------------------------------
  op new-strands? : ~> StrandSet [memo] .
  eq new-strands?
   = downStrandSet(
       extract('STRANDS-PROTOCOL.StrandSet,PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) .

  op new-attack`(_`)? : Nat ~> Attack [memo] .
  eq new-attack(N:Nat)?
   = downAttack(
       extract('ATTACK-STATE[upTerm(N:Nat)],PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) .

  op PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE : -> FModule [memo] .
  eq PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE
   = newName('PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE,
      fixIrreducible(upModule('PROTOCOL-SPECIFICATION,true))) .

  *** Fix-irreducible means that strands are duplicated as much as necessary
  *** to reflect that _inI and -(M) have to be irreducible.
  *** In case they are not, we replicate such messages to show all 
  *** the possible irreducible forms (obtained by narrowing)

  op fixIrreducible : FModule -> FModule .
  eq fixIrreducible(
      fmod F:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       E:EquationSet
      endfm)
   = fmod F:Qid is
       IL:ImportList
       sorts S:SortSet .
       S:SubsortDeclSet
       O:OpDeclSet
       M:MembAxSet
       fixIrrEq(E:EquationSet)
      endfm .

  *** Get equations with strands ***********************************
  op fixIrrEq : EquationSet -> EquationSet .
  eq fixIrrEq(EqS:EquationSet)
   = fixIrrEq*(EqS:EquationSet) .

  op fixIrrEq* : EquationSet -> EquationSet .

  eq fixIrrEq*(none) = none .

  eq fixIrrEq*(
        (eq 'STRANDS-PROTOCOL.StrandSet 
          = T:Term [AtS:AttrSet] .) EqS:EquationSet  )
   = (eq 'STRANDS-PROTOCOL.StrandSet 
       = upTerm(fixIrrStrandSet(downStrandSet(T:Term)))
     [AtS:AttrSet] .)
     fixIrrEq*(EqS:EquationSet) .

***(
  eq fixIrrEq*(
        (eq 'ATTACK-STATE[N:Term] 
          = T:Term [AtS:AttrSet] .) EqS:EquationSet  )
   = (eq 'ATTACK-STATE[N:Term] 
       = upTerm(fixIrrAttack(downAttack(T:Term)))
     [AtS:AttrSet] .)
     fixIrrEq*(EqS:EquationSet) .
)***

  eq fixIrrEq*(Eq:Equation EqS:EquationSet)
   = Eq:Equation fixIrrEq*(EqS:EquationSet) 
  [owise] .

  *** Useful for the whole section ********************************
  op fixIrrMsg : Msg -> VariantTripleSet [memo] .
  eq fixIrrMsg(M:Msg)
   = toVariantTripleSet(
      getVariants(
        clearAllFrozen(removeBoolEqs(
            upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true))),
        upTerm(M:Msg),
        highestVar(upTerm(M:Msg)) + 1,BuiltInUnify irreducible minimal-unifiers
      )
     ) .

  *** Fix Attack states **************************************
  op fixIrrAttack : Attack -> Attack .
  eq fixIrrAttack(S1:SystemSet)
   = fixIrrSystemSet(S1:SystemSet) .

  *** Fix strands **************************************
  op fixIrrStrandSet : StrandSet -> StrandSet .
  eq fixIrrStrandSet(SS:StrandSet) 
   = SystemSet2StrandSet(fixIrrSystemSet(StrandSet2SystemSet(SS:StrandSet))) .

  op StrandSet2SystemSet : StrandSet -> SystemSet .
  eq StrandSet2SystemSet(empty) = empty .
  eq StrandSet2SystemSet(S:Strand & SS:StrandSet) 
   = (S:Strand || empty || nil || nil || nil) 
     StrandSet2SystemSet(SS:StrandSet) .

  op SystemSet2StrandSet : SystemSet -> StrandSet .
  eq SystemSet2StrandSet(empty) = empty .
  eq SystemSet2StrandSet(
      (SS:StrandSet || K:IntruderKnowledge || L:SMsgList 
       || G:GhostList || PP:Properties) 
      SS:SystemSet) 
   = SS:StrandSet & SystemSet2StrandSet(SS:SystemSet) .

  *** Fix systems **************************************
  op fixIrrSystemSet : SystemSet -> SystemSet .

  eq fixIrrSystemSet(empty)
   = empty .
  eq fixIrrSystemSet(S:System SS:SystemSet) 
   = fixIrrSystem(S:System) fixIrrSystemSet(SS:SystemSet) .

  op fixIrrIdSystemSet : IdSystemSet -> IdSystemSet .
  eq fixIrrIdSystemSet(empty)
   = empty .
  eq fixIrrIdSystemSet(IS:IdSystem IST:IdSystemSet) 
   = setId(getId(IS:IdSystem),fixIrrSystem(remId(IS:IdSystem))) 
     fixIrrIdSystemSet(IST:IdSystemSet) .

  sort OptionsFixIrr .
  op empty : -> OptionsFixIrr .
  op __ : OptionsFixIrr OptionsFixIrr -> OptionsFixIrr [assoc comm id: empty] .
  ops inI strands : -> OptionsFixIrr .
  var OFI : OptionsFixIrr .

  op fixIrrSystem : System -> SystemSet .
  eq fixIrrSystem(S:System)
   = fixIrrSystem*(inI strands,S:System,Vars(upTerm(only-inst(S:System)))) .

  op fixIrrSystemInI : System -> SystemSet .
  eq fixIrrSystemInI(S:System)
   = fixIrrSystem*(inI,S:System,Vars(upTerm(only-inst(S:System)))) .

  op fixIrrSystem* : OptionsFixIrr System TermList -> SystemSet .
  ceq fixIrrSystem*(strands OFI,S:System,TL:TermList)
    = fixIrrSystemRT(strands OFI,S:System,M:Msg,TL:TermList,fixIrrMsg(M:Msg)) 
   if :: rrL:FreshSet :: [L:SMsgList-L | L:SMsgList-R] & SS:StrandSet 
      || K:IntruderKnowledge 
      || M:SMsgList || G:GhostList || PP:Properties 
        := S:System
  /\ (L1:SMsgList,-(M:Msg),L2:SMsgList) 
        := (toSMsgList(L:SMsgList-L),toSMsgList(L:SMsgList-R)) 
  /\ not (upTerm(M:Msg) :: Variable or upTerm(M:Msg) :: Constant)
     and-then
     not irr(M:Msg) in K:IntruderKnowledge
     and-then
     not (M:Msg !inI) in K:IntruderKnowledge
     and-then
     not (M:Msg inVars G:GhostList)
     and-then
     not (M:Msg inVars only-irr(K:IntruderKnowledge))
     and-then
     Vars(upTerm(M:Msg)) intersect TL:TermList == empty
     and-then --- this has to be lazy!!!!
     fixIrrMsg(M:Msg) :: VariantTripleSet
     and-then
     downMsgSet(getTerms(fixIrrMsg(M:Msg))) =/= M:Msg .

  ceq fixIrrSystem*(inI OFI,S:System,TL:TermList)
     = fixIrrSystemRT(inI OFI,S:System,M:Msg,TL:TermList,fixIrrMsg(M:Msg)) 
   if SS:StrandSet 
      || M:Msg inI,K:IntruderKnowledge 
      || M:SMsgList || G:GhostList || PP:Properties 
        := S:System
  /\ not (upTerm(M:Msg) :: Variable or upTerm(M:Msg) :: Constant)
     and-then
     not irr(M:Msg) in K:IntruderKnowledge
     and-then
     not (M:Msg !inI) in K:IntruderKnowledge
     and-then
     not (M:Msg inVars G:GhostList)
     and-then
     not (M:Msg inVars only-irr(K:IntruderKnowledge))
     and-then
     Vars(upTerm(M:Msg)) intersect TL:TermList == empty
     and-then --- this has to be lazy!!!!
     fixIrrMsg(M:Msg) :: VariantTripleSet
     and-then
     downMsgSet(getTerms(fixIrrMsg(M:Msg))) =/= M:Msg .

  eq fixIrrSystem*(OFI,S:System,TL:TermList)
   = S:System [owise] .

  op fixIrrSystemRT : OptionsFixIrr System Msg TermList VariantTripleSet 
                   -> SystemSet .
  eq fixIrrSystemRT(OFI,S:System,M:Msg,TL:TermList,empty)
   = empty .
  eq fixIrrSystemRT(OFI,S:System,M:Msg,TL:TermList,
                    R:VariantTriple | RT:VariantTripleSet)
   = fixIrrSystemRTe(OFI,S:System,M:Msg,TL:TermList,R:VariantTriple)
     fixIrrSystemRT(OFI,S:System,M:Msg,TL:TermList,RT:VariantTripleSet) .

  op fixIrrSystemRTe : OptionsFixIrr System Msg TermList VariantTriple 
                    -> SystemSet .
  eq fixIrrSystemRTe(OFI,S:System,M:Msg,TL:TermList,
                     {T:Term,S:Substitution,NextVar:Nat})
   = if dom S:Substitution in TL:TermList 
        --- check no new variable brought by a variant is instantiated
     then empty
     else
     fixIrrSystem*(OFI,
        ---addInst(rangeVars(S:Substitution),
        ---addInst(Vars(T:Term),
        addInst((rangeVars(S:Substitution),Vars(T:Term)),
        addIrr(downMsgSet(T:Term),
          downSystemSet(
            (replaceTerm upTerm(M:Msg) by T:Term in upTerm(S:System))
            << S:Substitution
          )
        )
        )
        ,(TL:TermList,rangeVars(S:Substitution))
     ) 
     fi .
 
  op addIrr : Msg System -> System .
  eq addIrr(M:Msg,
      SS:StrandSet || K:IntruderKnowledge 
      || M:SMsgList || G:GhostList || PP:Properties) 
   = if not irr(M:Msg) in K:IntruderKnowledge
     then 
      SS:StrandSet 
      || irr(M:Msg),K:IntruderKnowledge 
      || M:SMsgList || G:GhostList || PP:Properties 
     else 
      SS:StrandSet || K:IntruderKnowledge 
      || M:SMsgList || G:GhostList || PP:Properties 
     fi .

  op addInst : TermList System -> System .
  eq addInst(empty,S:System)
   = S:System .
  eq addInst((T:Term,TL:TermList),
      SS:StrandSet || K:IntruderKnowledge 
      || M:SMsgList || G:GhostList || PP:Properties) 
   = addInst(TL:TermList,
     if typeLeq(upModule('PROTOCOL-SPECIFICATION,true),
          leastSort(upModule('PROTOCOL-SPECIFICATION,true),T:Term),
          'Msg)
        and-then
        not inst(downMsgSet(T:Term)) in K:IntruderKnowledge
     then 
      SS:StrandSet 
      || inst(downMsgSet(T:Term)),K:IntruderKnowledge 
      || M:SMsgList || G:GhostList || PP:Properties   
     else 
       SS:StrandSet || K:IntruderKnowledge 
       || M:SMsgList || G:GhostList || PP:Properties   
     fi
     ) .

  op _inVars_ : Msg GhostList -> Bool .
  eq M:Msg inVars G:GhostList
   = Vars(upTerm(M:Msg)) inVars G:GhostList .

  op _inVars_ : TermList GhostList -> Bool .
  eq (TL:TermList inVars 
        ghost(M2:Msg,SS2:StrandSet,K2:IntruderKnowledge,ML2:SMsgList,PP2:Properties), 
        G:GhostList)
   = TL:TermList intersect Vars(upTerm(M2:Msg)) =/= empty 
     or-else 
     (TL:TermList inVars G:GhostList) .
  eq (TL:TermList inVars nil)
   = false .

  op _inVars_ : Msg IntruderKnowledge -> Bool .
  eq M:Msg inVars K:IntruderKnowledge
   = Vars(upTerm(M:Msg)) inVars K:IntruderKnowledge .

  op _inVars_ : Term IntruderKnowledge -> Bool .
  eq (TL:TermList inVars (X:IntruderKnowledgeElem,K:IntruderKnowledge))
   = TL:TermList intersect Vars(upTerm(X:IntruderKnowledgeElem)) =/= empty 
     or-else 
     (TL:TermList inVars K:IntruderKnowledge) .
  eq (TL:TermList inVars (empty).IntruderKnowledge)
   = false .

  ---------------------------------------------------------------------
  op STRAND-EXAMPLE-RULES-WITH-ALL : -> SModule [memo] .
  eq STRAND-EXAMPLE-RULES-WITH-ALL
   = newName('STRAND-EXAMPLE-RULES-WITH-ALL-GENERATED,
     addRules(
       genRules(
         downStrandSet(
           extract('STRANDS-DOLEVYAO.StrandSet,PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) & 
         downStrandSet(
           extract('STRANDS-PROTOCOL.StrandSet,PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) 
        ),
       upModule('STRAND-EXAMPLE-RULES-WITH-ALL,true)
     )) .

  op STRAND-EXAMPLE-RULES : -> SModule [memo] .
  eq STRAND-EXAMPLE-RULES
   = newName('STRAND-EXAMPLE-RULES-GENERATED,
     addRules(
       genRules(
         downStrandSet(
           extract('STRANDS-DOLEVYAO.StrandSet,PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) & 
         downStrandSet(
           extract('STRANDS-PROTOCOL.StrandSet,PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) 
        ),
       upModule('STRAND-EXAMPLE-RULES,true)
     )) .

  op STRAND-EXAMPLE-RULES-INPUT : -> SModule [memo] .
  eq STRAND-EXAMPLE-RULES-INPUT
   = newName('STRAND-EXAMPLE-RULES-INPUT-GENERATED,
     addRules(
       genRules(
         downStrandSet(
           extract('STRANDS-DOLEVYAO.StrandSet,PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) & 
         downStrandSet(
           extract('STRANDS-PROTOCOL.StrandSet,PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) 
        ),
       upModule('STRAND-EXAMPLE-RULES-INPUT,true)
     )) .

  op genRules : StrandSet -> RuleSet .
  eq genRules(empty)
   = none .
  eq genRules(S:Strand & S:StrandSet)
   = genRules*(S:Strand) genRules(S:StrandSet) .

  op genRules* : Strand -> Rule .
  eq genRules*(:: rrL:FreshSet :: [ L:SMsgList-L | L:SMsgList-R ])
   = genRules**(
       rrL:FreshSet, 
       nil,
       (toSMsgList(L:SMsgList-L),toSMsgList(L:SMsgList-R)) 
     ) .

  op genRules** : FreshSet SMsgList SMsgList -> RuleSet .

  ---------------------------------------------------------------------
  op PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS : -> SModule [memo] .
  eq PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS
   = newName('PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS-GENERATED,
     addRules(
       genGrammarRules(
         downStrandSet(
           extract('STRANDS-DOLEVYAO.StrandSet,PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) & 
         downStrandSet(
           extract('STRANDS-PROTOCOL.StrandSet,PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) 
        ),
       upModule('PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS,true)
     )) .

  op genGrammarRules : StrandSet -> RuleSet .
  eq genGrammarRules(empty)
   = none .
  eq genGrammarRules(S:Strand & S:StrandSet)
   = genGrammarRules*(S:Strand) genGrammarRules(S:StrandSet) .

  op genGrammarRules* : Strand -> Rule .
  eq genGrammarRules*(:: rrL:FreshSet :: [ L:SMsgList-L | L:SMsgList-R ])
   = genGrammarRules**(
       nil,
       (toSMsgList(L:SMsgList-L),toSMsgList(L:SMsgList-R)) 
     ) .

  op genGrammarRules** : SMsgList SMsgList -> RuleSet .
  eq genGrammarRules**(L:SMsgList, nil)
   = none .
  eq genGrammarRules**(L:SMsgList, (-(M:Msg),R:SMsgList))
   = genGrammarRules**((L:SMsgList,-(M:Msg)), R:SMsgList) .
  eq genGrammarRules**(L:SMsgList, (+(M:Msg),R:SMsgList))
   = (rl
       upTerm(toMsgSet(L:SMsgList))
      =>
       upTerm(M:Msg)
     [nonexec] .) 
     genGrammarRules**(L:SMsgList, R:SMsgList) .

  ---------------------------------------------------------------------
  op PROTOCOL-EXAMPLE-GHOST : -> FModule [memo] .
  eq PROTOCOL-EXAMPLE-GHOST
   = newName('PROTOCOL-EXAMPLE-GHOST-GENERATED,
     addEqs(
       genGhostEqs(
         downStrandSet(
           extract('STRANDS-DOLEVYAO.StrandSet,PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE))
        ),
       upModule('PROTOCOL-EXAMPLE-GHOST,true)
     )) .

  op genGhostEqs : StrandSet -> EquationSet .
  eq genGhostEqs(empty)
   = none .
  eq genGhostEqs(S:Strand & S:StrandSet)
   = genGhostEqs*(S:Strand) genGhostEqs(S:StrandSet) .

  op genGhostEqs* : Strand -> Equation .
  eq genGhostEqs*(:: rrL:FreshSet :: [ L:SMsgList-L | L:SMsgList-R ])
   = genGhostEqs**(
       nil,
       (toSMsgList(L:SMsgList-L),toSMsgList(L:SMsgList-R)) 
     ) .

  op genGhostEqs** : SMsgList SMsgList -> EquationSet .
  eq genGhostEqs**(L:SMsgList, nil)
   = none .
  eq genGhostEqs**(L:SMsgList, (-(M:Msg),R:SMsgList))
   = genGhostEqs**((L:SMsgList,-(M:Msg)), R:SMsgList) .
  eq genGhostEqs**(L:SMsgList, (+(M:Msg),R:SMsgList))
   = if upTerm(M:Msg) :: Variable
     then none
     else 
     if not (getIdSymbol(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE,upTerm(M:Msg)) :: Term)
     then genGhostEqs**Free(upTerm(M:Msg),L:SMsgList)
     else genGhostEqs**Id(upTerm(M:Msg),L:SMsgList,
             getIdSymbol(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE,upTerm(M:Msg)))
     fi
     fi
     genGhostEqs**(L:SMsgList, R:SMsgList) 
  .

  op genGhostEqs**Free : Term SMsgList -> Equation .
  eq genGhostEqs**Free(T:Term,L:SMsgList)
   = (eq 'isGhostMsg[T:Term] 
       = genGhostEqs***(only-Input(L:SMsgList)) 
      [none] .) .

  op genGhostEqs**Id : Term SMsgList Term -> EquationSet .
  eq genGhostEqs**Id(F:Qid[V1:Variable,V2:Variable],L:SMsgList,Id:Term)
   = (ceq 'isGhostMsg[F:Qid[V1:Variable,V2:Variable]] 
        = genGhostEqs***(only-Input(L:SMsgList))
       if '_and_['_=/=_[V1:Variable,Id:Term],'_=/=_[V2:Variable,Id:Term]] = 'true.Bool
      [none] .) .

  op genGhostEqs*** : SMsgList -> Term .
  eq genGhostEqs***(nil)
   = 'true.Bool .
  eq genGhostEqs***((-(M:Msg),L:SMsgList))
   = '_and_['isGhostMsg[upTerm(M:Msg)],genGhostEqs***(L:SMsgList)] .

endfm

fmod GENERATE-RULES is
  pr GENERATE-RULES-PRE .

  op genRules** : FreshSet SMsgList SMsgList -> RuleSet .
  eq genRules**(rrL:FreshSet, L:SMsgList, nil)
   = none .
  eq genRules**(rrL:FreshSet, L:SMsgList, (-(M:Msg),R:SMsgList))
   = genRules**(rrL:FreshSet, (L:SMsgList,-(M:Msg)), R:SMsgList) .
  eq genRules**(rrL:FreshSet, L:SMsgList, (+(M:Msg),R:SMsgList))
   = *** general rule for the general case with id symbols
     (rl
       '_||_||_||_||_[
         '_&_[
           'SS:StrandSet,
           '::_::`[_|_`][
             upTerm(rrL:FreshSet), --- Fresh variables
             upTerm(toSMsgList-L(L:SMsgList)),
             ---upTerm(toSMsgList-R((+(M:Msg),R:SMsgList)))
             upTerm(toSMsgList-R(+(M:Msg)))
           ]
         ],
         '_`,_['_!inI[upTerm(M:Msg)],'K:IntruderKnowledge],
         '_`,_[upTerm(+(M:Msg)),'ML:SMsgList],
         'GL:GhostList,
         'PP:Properties 
       ]
     =>
       '_||_||_||_||_[
         'SS:StrandSet,
         '_`,_['_inI[upTerm(M:Msg)],'K:IntruderKnowledge],
         'ML:SMsgList,
         'GL:GhostList,
         'PP:Properties 
       ]
     [nonexec] .)
     genRules**(rrL:FreshSet, (L:SMsgList,+(M:Msg)), R:SMsgList) .

endfm
fmod RESULT-GRAMMAR-NARROWING is
  protecting DEFINITION-CONSTRAINTS .
  protecting META-LEVEL .

  --- ResultGrammarNarrowing ---------------------------
  ---sort ResultGrammarNarrowing . --- declared in DEFINITION-CONSTRAINTS
  op {_,_,_,_,_} : GrammarRule Substitution GrammarRule 
                               Substitution GrammarRule 
                -> ResultGrammarNarrowing [ctor] .

  sort ResultGrammarNarrowingSet .
  subsort ResultGrammarNarrowing < ResultGrammarNarrowingSet .
  op empty : -> ResultGrammarNarrowingSet [ctor] .
  op _;_ : ResultGrammarNarrowingSet ResultGrammarNarrowingSet 
           -> ResultGrammarNarrowingSet
           [ctor assoc comm id: empty] .
  eq X:ResultGrammarNarrowing ; X:ResultGrammarNarrowing
   = X:ResultGrammarNarrowing .
endfm

fmod CONSTRAINTS-RULES is
  protecting DEFINITION-CONSTRAINTS .
  protecting RESULT-GRAMMAR-NARROWING .

  sort errorGrammar .
  op errorNoHeuristicApplied_usingGrammar_ : 
       ResultGrammarNarrowing GrammarRuleSet 
       -> errorGrammar [format (r! o r! o d)] .
  op errorIntegratingExceptions_intoGrammarRule_ : 
       CtrSet GrammarRuleSet  
       -> errorGrammar [format (r! o r! o d)] .
  op errorInconsistentExceptionsInGrammarRule_inGrammar_ : 
       GrammarRule GrammarRuleSet 
       -> errorGrammar [format (r! o r! o d)] .
  subsort errorGrammar < Grammar .

  op _;_ : errorGrammar GrammarRuleSet -> errorGrammar [ditto] .
  op _;_ : GrammarRuleSet errorGrammar -> errorGrammar [ditto] .

---   op filterError : Grammar -> Grammar .
---   eq filterError(R:errorGrammar ; G:GrammarRuleSet)
---    = R:errorGrammar .
---   eq filterError(G:GrammarRuleSet)
---    = G:GrammarRuleSet [owise] .

  op filterError : Grammar -> Grammar .
  eq filterError(
      errorIntegratingExceptions X:CtrSet 
      intoGrammarRule X:GrammarRuleSet 
      ; G:GrammarRuleSet)
   = errorIntegratingExceptions X:CtrSet 
     intoGrammarRule X:GrammarRuleSet .
  eq filterError(
      errorNoHeuristicApplied X:ResultGrammarNarrowing 
      usingGrammar X:GrammarRuleSet
      ; G:GrammarRuleSet)
   =  errorNoHeuristicApplied X:ResultGrammarNarrowing 
      usingGrammar X:GrammarRuleSet .
  eq filterError(
      errorInconsistentExceptionsInGrammarRule X:GrammarRule
      inGrammar X:GrammarRuleSet
      ; G:GrammarRuleSet)
   = errorInconsistentExceptionsInGrammarRule X:GrammarRule
      inGrammar X:GrammarRuleSet .
  eq filterError(G:GrammarRuleSet)
   = G:GrammarRuleSet [owise] .

  sort Constraints&Rules errorConstraints&Rules .
  op {_,_} : CtrSet GrammarRuleSet -> Constraints&Rules .
  op errorCRNoHeuristicApplied_usingGrammar_ : 
       ResultGrammarNarrowing GrammarRuleSet 
       -> errorConstraints&Rules .
  subsort errorConstraints&Rules < Constraints&Rules .
  
  var XCR : Constraints&Rules .
  var XRE : ResultGrammarNarrowing .
  var GS : GrammarRuleSet .
  var C C' : CtrSet .
  var H H' : GrammarRuleSet .

  op getCtrSet : Constraints&Rules -> CtrSet .
  eq getCtrSet({C:CtrSet,H:GrammarRuleSet}) = C:CtrSet .

  op getGrammarRuleSet : Constraints&Rules -> GrammarRuleSet .
  eq getGrammarRuleSet({C:CtrSet,H:GrammarRuleSet}) = H:GrammarRuleSet .

  op _+_ : Constraints&Rules Constraints&Rules 
        -> Constraints&Rules [assoc comm] .
  eq {empty,empty} + XCR = XCR .
  eq Y:errorConstraints&Rules + X:errorConstraints&Rules 
   = Y:errorConstraints&Rules .
  eq {C,H} + {C',H'} = { (C , C') , (H ; H') } .
  eq XCR + X:errorConstraints&Rules 
   = X:errorConstraints&Rules [owise] .

  op [_] : Constraints&Rules -> Grammar .
  eq [ errorCRNoHeuristicApplied X:ResultGrammarNarrowing 
       usingGrammar GS:GrammarRuleSet ]
   = errorNoHeuristicApplied X:ResultGrammarNarrowing
     usingGrammar GS:GrammarRuleSet .

endfm

fmod MEMBERSHIP-GRAMMAR-LANGUAGE is
  protecting PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS-HANDLING .
  protecting DEFINITION-CONSTRAINTS-HANDLING .
  protecting ORDERS-TERM-SUBSTITUTION .
  protecting TERMSET .
  protecting META-UNIFICATION .
  protecting META-NARROWING-SEARCH .
  protecting CONSTRAINTS-RULES .

  var G : Grammar .
  vars GS GS' : GrammarList .
  vars Dt Dt' Ct Ct' : CtrSet .
  var TL : TermList .

  op {_,_} |- _ : GrammarList CtrSet CtrSet -> Bool .
  ceq {GS,Dt} |- Ct
   = {GS,Dt',Vars(upTerm(Ct'))} |-- Ct'
  if (Ct':Term,Dt':Term) := simplifyVars((upTerm(Ct),upTerm(Dt)))
  /\ Ct' := downCtrSet(Ct':Term)
  /\ Dt' := downCtrSet(Dt':Term) .

  *** We put the memoization only in the |-- version
  *** and simplify variables in the initial term
  op {_,_,_} |-- _ : GrammarList CtrSet TermList CtrSet -> Bool [memo] .

  eq {none,Dt,TL} |-- Ct
   = false .

  ceq {GS,Dt,TL} |-- Ct
   = if C:CtrSet == empty
     then true
     else simplifyOneStepG(GS,GS,Dt,C:CtrSet,TL)
     fi 
  if C:CtrSet := simplify Ct <=[TL] Dt .

  *** simplify CtrSet1 <= CtrSet2 
  *** removes those constraints in CtrSet1 implied by CtrSet2
  op simplify_<=[_]_ : CtrSet TermList CtrSet -> CtrSet .
  eq simplify empty <=[TL] C':CtrSet
   = empty .
  eq simplify (Ct:Constraint,C:CtrSet) <=[TL] C':CtrSet
   = (
     if Ct:Constraint <=[TL] C':CtrSet
     then empty
     else Ct:Constraint
     fi
     , simplify C:CtrSet <=[TL] C':CtrSet) .

  *** simplifyOneStepG applies one rewriting step of a grammar G 
  *** and calls recursively
  op simplifyOneStepG : GrammarList GrammarList CtrSet CtrSet TermList -> Bool .
  eq simplifyOneStepG(none,GS',Dt,Ct,TL)
   = false .
  eq simplifyOneStepG(G | GS,GS',Dt,Ct,TL)
   = (
       not (G :: errorGrammar)
       and-then
       composeOneStepG(GS',Dt,Ct,TL,
         getTerms(
            metaOneRewriting(flipRls(grammar2Module(G)),upTerm(Ct),'CtrSet)
         ) 
       )
     )
     or-else
     simplifyOneStepG(GS,GS',Dt,Ct,TL) .

  *** Test each new set of constraints
  op composeOneStepG : GrammarList CtrSet CtrSet TermList TermSet -> Bool .
  eq composeOneStepG(GS,Dt,Ct,TL,emptyTermSet)
   = false .
  eq composeOneStepG(GS,Dt,Ct,TL,(T:Term | TS:TermSet))
   = if Ct =/= downCtrSet(T:Term)
     then {GS,Dt,TL} |-- downCtrSet(T:Term)
     else false
     fi
     or-else
     composeOneStepG(GS,Dt,Ct,TL,TS:TermSet) .

  *** CtrSet1 <= CtrSet2 implies that CtrSet2 is more general than CtrSet1
  op _<=[_]_ : CtrSet TermList CtrSet -> Bool .

  eq empty <=[TL] C:CtrSet
   = true .

  eq (X:Msg inL, C:CtrSet) <=[TL] (X:Msg inL, C':CtrSet)
   = C:CtrSet <=[TL] (X:Msg inL, C':CtrSet) .

  ceq (X:Msg notInI, C:CtrSet) <=[TL] (Y:Msg notInI, C':CtrSet)
   = C:CtrSet <=[TL] (Y:Msg notInI, C':CtrSet) 
  if M:Module 
     := upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true)
  /\ metaBuiltInEqual(M:Module,TL,upTerm(Y:Msg),upTerm(X:Msg)) .

  eq (X:Msg notLeq Y:Msg), C:CtrSet <=[TL] C':CtrSet
   = (
      ***remove this single constraint 
      *** if X and Y do not unify and X is not a variable
      *** and X is not  W1 * W2 being * ACU
      (not (upTerm(X:Msg) :: Variable)
       and-then
       not checkId(upTerm(X:Msg),upTerm(Y:Msg))
       and-then
       not metaBuiltInUnify?(
         ---upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
         upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true),
                upTerm(X:Msg),
		upTerm(Y:Msg) <<(upTerm(X:Msg))< ***This is not necessary
       )
      )
      or-else
      ***remove this single constraint if it is subsumed by any other constraint
      (X:Msg notLeq Y:Msg) <=Any[TL] C':CtrSet
     )
     and-then
     C:CtrSet <=[TL] C':CtrSet .

  eq C:CtrSet <=[TL] C':CtrSet
   = false 
     [owise] .

  op checkId : Term Term -> Bool .
 ceq checkId(F:Qid[T1:Term,T2:Term],Y:Term)
   = Y:Term == Id:Constant
     or-else
     (T1:Term :: Variable
      and-then 
      typeLeq(upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
              getType(Id:Constant),
              getType(T1:Term))  )
     or-else
     (T2:Term :: Variable
      and-then 
      typeLeq(upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
              getType(Id:Constant),
              getType(T2:Term))  )
  if Id:Constant 
      := getIdSymbol(upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
                       F:Qid[T1:Term,T2:Term]) .

  eq checkId(X:Term,Y:Term)
   = false [owise] .

  op _<=Any[_]_ : Constraint TermList CtrSet -> Bool .

  ceq (X:Msg notLeq Y:Msg) <=Any[TL] ((X#:Msg notLeq Y#:Msg), C':CtrSet)
   = true
  if M:Module 
     := upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true)
  /\ metaBuiltInEqual(M:Module,TL,upTerm(X#:Msg),upTerm(X:Msg))
  /\ metaBuiltInMatch?(M:Module,upTerm(Y#:Msg),upTerm(Y:Msg) <<(upTerm(Y#:Msg))<) .

  eq (X:Msg notLeq Y:Msg) <=Any[TL] C':CtrSet
   = false
     [owise] .

endfm

fmod GRAMMAR-RULE-EXPANDABLE-TEST is
  protecting META-LEVEL .
  protecting MODULE-HANDLING .
  protecting DEFINITION-CONSTRAINTS-HANDLING .
  protecting DEFINITION-PROTOCOL-RULES-HANDLING .
  protecting META-UNIFICATION .
  protecting MEMBERSHIP-GRAMMAR-LANGUAGE .
  protecting GENERATE-RULES .
  protecting ORDERS-TERM-SUBSTITUTION .

  var GSS : GrammarList .
  var Gk : Grammar .
  var Rls : Rule .
  vars Lhs Rhs : Term .
  var AtS : AttrSet .
  var G G' G'' : GrammarRule .
  var S S' : Substitution .

  op IsGrammarRule_ExpandableWith_ : ResultGrammarNarrowing GrammarList -> Bool . ---[memo] .
  eq IsGrammarRule 
     {(grl Lhs*:CtrSet => Rhs*:LConstraint .),S,G',S',
      (grl Lhs:CtrSet => Rhs:LConstraint .)} 
     ExpandableWith GSS
   = noIntruderConstraintwithTermInRhs(Lhs:CtrSet,Rhs:LConstraint)
     and-then
     noTermInRhsIsInGS(Lhs:CtrSet,Rhs:LConstraint,GSS) 
     and-then
     noPublicDataInCtrSet(Lhs:CtrSet) 
     and-then
     doNotAvoidInfiniteBehavior(Lhs*:CtrSet,Rhs*:LConstraint,
                                Lhs:CtrSet,Rhs:LConstraint,S .. S') 
     and-then
     rhsIsNormalized(Rhs*:LConstraint,S)
     and-then
     allDistinctConstraintsPossible(Lhs:CtrSet,Rhs:LConstraint) .

  op noIntruderConstraintwithTermInRhs : CtrSet LConstraint -> Bool .
  eq noIntruderConstraintwithTermInRhs( 
        (T:Msg notInI,C:CtrSet), (T:Msg,M:MsgSet) inL
     )
   = false .
  eq noIntruderConstraintwithTermInRhs( C:CtrSet, M:MsgSet inL)
   = true [owise] .

  op doNotAvoidInfiniteBehavior : CtrSet LConstraint 
                                  CtrSet LConstraint Substitution -> Bool .
  eq doNotAvoidInfiniteBehavior(Lhs*:CtrSet,(T1:Msg,M1:MsgSet) inL,
                                Lhs:CtrSet,(T2:Msg,M2:MsgSet) inL,S)
   = --- New resultant T2 is an instance (or renaming) of T1 => discard
     not (
        not (upTerm(T2:Msg) :: Variable)
        and-then
        not (upTerm(T1:Msg) :: Variable)
        and-then
        (
          (noFreshinSubstitution(S)
           and-then
           metaBuiltInRenaming(
            PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS,
            upTerm(T1:Msg),
            upTerm(T2:Msg) <<(upTerm(T1:Msg))<
           ))
          or-else 
          metaBuiltInRenaming(
            PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS,
            upTerm(T1:Msg) << S,
            upTerm(T2:Msg) <<(upTerm(T1:Msg) << S)<
          )
        )
     )
     and-then
     doNotAvoidInfiniteBehavior(Lhs*:CtrSet,(T1:Msg,M1:MsgSet) inL,
                                Lhs:CtrSet,M2:MsgSet inL,S) .
  eq doNotAvoidInfiniteBehavior(Lhs*:CtrSet,Rhs*:LConstraint,
                                Lhs:CtrSet,Rhs:LConstraint,S)
   = true [owise] . 

  op noFreshinSubstitution : Substitution -> Bool .
  eq noFreshinSubstitution(none)
   = true .
  eq noFreshinSubstitution(V:Variable <- T:Term ; S:Substitution)
   = noFreshinTerm(T:Term) and-then noFreshinSubstitution(S:Substitution) .

  op noFreshinTerm : Term -> Bool .
  eq noFreshinTerm(V:Variable) = getType(V:Variable) =/= 'Fresh .
  eq noFreshinTerm(C:Constant) = true .
  eq noFreshinTerm(F:Qid[TL:TermList]) = noFreshinTermList(TL:TermList) .

  op noFreshinTermList : TermList -> Bool .
  eq noFreshinTermList(empty) = true .
  eq noFreshinTermList((T:Term,TL:TermList)) 
   = noFreshinTerm(T:Term) and-then noFreshinTermList(TL:TermList) .

  *** New code for AC-grammar
  op noInfiniteACInstantiation : CtrSet CtrSet LConstraint Substitution 
                              -> Bool .
  *** 1st case: the head of the grammar rule is instantiated 
  *** with the same kind of symbol
  ceq noInfiniteACInstantiation(
           C:CtrSet,C$:CtrSet,(T:Msg,M:MsgSet) inL,S)
    = false 
   if F:Qid[X:Variable,Y:Variable] := upTerm(T:Msg)
   /\ (X:Variable <- F:Qid[X*:Variable,Y*:Variable] ; S') := S 
   /\ getType(X:Variable) == getType(X*:Variable) 
   or getType(X:Variable) == getType(Y*:Variable) .
  ceq noInfiniteACInstantiation(
           C:CtrSet,C$:CtrSet,(T:Msg,M:MsgSet) inL,S)
    = false 
   if F:Qid[X:Variable,Y:Variable] := upTerm(T:Msg)
   /\ (Y:Variable <- F:Qid[X*:Variable,Y*:Variable] ; S') := S
   /\ getType(Y:Variable) == getType(X*:Variable) 
   or getType(Y:Variable) == getType(Y*:Variable) .
  *** 2nd case: the non-variable notInI constraint is instantiated 
  *** with the same kind of symbol
  ceq noInfiniteACInstantiation(
        (T*:Msg notInI,C:CtrSet),C$:CtrSet,(T:Msg,M:MsgSet) inL,S)
    = false 
   if F:Qid[X:Variable,Y:Variable] := upTerm(T*:Msg)
   /\ (X:Variable <- F:Qid[X*:Variable,Y*:Variable] ; S') := S 
   /\ getType(X:Variable) == getType(X*:Variable) 
   or getType(X:Variable) == getType(Y*:Variable) .
  ceq noInfiniteACInstantiation(
        (T*:Msg notInI,C:CtrSet),C$:CtrSet,(T:Msg,M:MsgSet) inL,S)
    = false 
   if F:Qid[X:Variable,Y:Variable] := upTerm(T*:Msg)
   /\ (Y:Variable <- F:Qid[X*:Variable,Y*:Variable] ; S') := S
   /\ getType(Y:Variable) == getType(X*:Variable) 
   or getType(Y:Variable) == getType(Y*:Variable) .
  eq noInfiniteACInstantiation(C:CtrSet, C$:CtrSet, L:LConstraint, S)
   = true [owise] .

  ****
  op allDistinctConstraintsPossible : CtrSet LConstraint -> Bool .
  eq allDistinctConstraintsPossible(C:CtrSet, Rhs:LConstraint)
   = Rhs:LConstraint == emptyMsgSet inL
     or-else 
     allDistinctConstraintsPossible*(C:CtrSet) .

  op allDistinctConstraintsPossible* : CtrSet -> Bool .
  eq allDistinctConstraintsPossible*( ((U:Msg notLeq T:Msg), C:CtrSet), 
                                     Rhs:LConstraint)
   = (
       upTerm(U:Msg) :: Variable
       or-else
       (
         not (
           metaCoreMatch?(
             PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS,
             upTerm(U:Msg),
             upTerm(T:Msg) <<(upTerm(U:Msg))<
           )
         )
         and-then
         metaEBuiltInUnify?(
           PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS,
           upTerm(U:Msg),
           upTerm(T:Msg) <<(upTerm(U:Msg))<
         )     
       )
     )
     and-then
     allDistinctConstraintsPossible*(C:CtrSet) .
  eq allDistinctConstraintsPossible*(C:CtrSet)
   = true [owise] .

  op noTermInRhsIsInGS : CtrSet LConstraint GrammarList -> Bool .
  eq noTermInRhsIsInGS(Lhs:CtrSet,emptyMsgSet inL,GSS)
   = true .
  eq noTermInRhsIsInGS(Lhs:CtrSet,(T:Msg,M:MsgSet) inL,GSS)
   = not({GSS,Lhs:CtrSet} |- (T:Msg inL))
     and-then
     noTermInRhsIsInGS(Lhs:CtrSet,M:MsgSet inL,GSS) .

  op everyLTermInLhsIsVariable : CtrSet Grammar -> Bool .
  eq everyLTermInLhsIsVariable(((X:Msg inL), C:CtrSet),Gk)
    = upTerm(X:Msg) :: Variable
      and
      everyLTermInLhsIsVariable(C:CtrSet,Gk) .
  eq everyLTermInLhsIsVariable(C:CtrSet,GSS)
   = true [owise] .

  *********
  op noPublicDataInCtrSet : CtrSet -> Bool .
  ceq noPublicDataInCtrSet(((X:Msg inL), C:CtrSet))
    = false
   if typeLeq(PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS,
      leastSort(PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS,
        upTerm(X:Msg)),
      'Public) .
  ceq noPublicDataInCtrSet(((X:Msg notInI), C:CtrSet))
    = false
   if typeLeq(PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS,
      leastSort(PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS,
        upTerm(X:Msg)),
      'Public) .
  eq noPublicDataInCtrSet(C:CtrSet)
   = true [owise] .

  *********
  op rhsIsNormalized : LConstraint Substitution -> Bool .
  eq rhsIsNormalized(Rhs:LConstraint,S:Substitution)
   = --- Discard if any symbol with Id and instantiated by such Id 
     not anyIdSymbolT&S(PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS,
           upTerm(Rhs:LConstraint),
           S:Substitution) 
     and-then
     --- not Id Symbol and not reducible
     rhsIsNormalized*(Rhs:LConstraint << S:Substitution) .

  op rhsIsNormalized* : LConstraint -> Bool .
  eq rhsIsNormalized*(Rhs:LConstraint)
   = downCtrSet(getTerm(
      metaReduce(
       onlyEqsNoBuiltInUnify(
        clearNonExecEqs(eraseRls(PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS))),
       upTerm(Rhs:LConstraint)
      )
     ))
     == Rhs:LConstraint .

  op _<<_ : LConstraint Substitution -> LConstraint .
  eq K:LConstraint << S:Substitution
   = downCtrSet(upTerm(K:LConstraint) << S:Substitution) .

endfm

fmod GRAMMAR-NARROWING is
  protecting GRAMMAR-RULE-EXPANDABLE-TEST .
  protecting RESULT-GRAMMAR-NARROWING .

  var G G1 G2 : GrammarRule .
  var GSS : GrammarList .
  var Gk : Grammar .
  vars T T' : Term .
  var TP : Type .
  vars S S' : Substitution .
  var RS RS' : ResultTripleSet .
  var M : Module .
  var RGNS : ResultGrammarNarrowingSet .

  op oneStepGNarrow : Module GrammarRule GrammarList Grammar
                      -> ResultGrammarNarrowingSet [memo] .
  eq oneStepGNarrow(M,G,GSS,Gk)
   = oneStepGNarrowResultOfProtocol(
      filterByEquationalReducibility(
       metaENarrow(
         putFrozen(1,
	   'grl_=>_.,('CtrSet 'LConstraint),
	   wrapRules M bySymbol '_inL
	 ),
         upTerm(G)
       )
      ),
      G,GSS,Gk) .

  *** auxiliary for oneStepGNarrow *****************************************
  op oneStepGNarrowResultOfProtocol : ResultTripleSet 
           GrammarRule GrammarList Grammar -> ResultGrammarNarrowingSet .
  eq oneStepGNarrowResultOfProtocol(RT:ResultTripleSet,G,GSS,Gk)
   = oneStepGNarrowResultOfProtocol*(RT:ResultTripleSet,G,GSS,Gk,empty) .

  op oneStepGNarrowResultOfProtocol* : ResultTripleSet 
           GrammarRule GrammarList Grammar 
           ResultGrammarNarrowingSet
           -> ResultGrammarNarrowingSet .
  eq oneStepGNarrowResultOfProtocol*(empty,G,GSS,Gk,RGNS)
   = RGNS .
  eq oneStepGNarrowResultOfProtocol*({T,TP,S} | RS,G,GSS,Gk,RGNS)
   = oneStepGNarrowResultOfProtocol*(RS,G,GSS,Gk,
       RGNS ;
       oneStepGNarrowResultOfProtocol#({T,TP,S},G,GSS,Gk)
     ) .

  op oneStepGNarrowResultOfProtocol# : ResultTriple
           GrammarRule GrammarList Grammar -> ResultGrammarNarrowingSet .
  eq oneStepGNarrowResultOfProtocol#({T,TP,S},G,GSS,Gk)
   = oneStepGNarrowResultOfGrammar(T,
      metaNormalizeCollect( ---here we cannot use metaNormalizeCollect$
         onlyEqsNoBuiltInUnify(
         putFrozen(2,
	   'grl_=>_.,('CtrSet 'LConstraint),
           ---flipRls(grammar2Module(nonEmpty(Gk))) 
           flipRls(grammar2Module(Gk))
         )),
         T,'GrammarRule),
      G,
      S,
      Gk) .

  *** auxiliary for oneStepGNarrow *****************************************
  op oneStepGNarrowResultOfGrammar : Term ResultTripleSet 
                GrammarRule Substitution 
                GrammarList -> ResultGrammarNarrowingSet .
  eq oneStepGNarrowResultOfGrammar(T',RT:ResultTripleSet,G,S,GSS)
   = oneStepGNarrowResultOfGrammar*(T',RT:ResultTripleSet,G,S,GSS,empty) .

  op oneStepGNarrowResultOfGrammar* : Term ResultTripleSet 
                GrammarRule Substitution 
                GrammarList 
                ResultGrammarNarrowingSet
                -> ResultGrammarNarrowingSet .
  eq oneStepGNarrowResultOfGrammar*(T',empty,G,S,GSS,RGNS)
   = RGNS .
  eq oneStepGNarrowResultOfGrammar*(T',{T,TP,S'} | RS,G,S,GSS,RGNS)
   = oneStepGNarrowResultOfGrammar*(T',RS,G,S,GSS, 
       RGNS ;
       oneStepGNarrowResultOfGrammar#(T',{T,TP,S'},G,S,GSS)
     ) .

  op oneStepGNarrowResultOfGrammar# : Term ResultTriple 
                GrammarRule Substitution 
                GrammarList -> ResultGrammarNarrowingSet .
  eq oneStepGNarrowResultOfGrammar#(T',{T,TP,S'},G,S,GSS)
   = if IsGrammarRule 
        {G,S |> upTerm(G),downGrammar(T'),S' |> T',downGrammar(T)} 
        ExpandableWith GSS
     then {G,S |> upTerm(G),downGrammar(T'),S' |> T',downGrammar(T)}
     else empty
     fi .

  *** auxiliary for oneStepGNarrow *****************************************
  op filterByEquationalReducibility : ResultTripleSet -> ResultTripleSet .
  eq filterByEquationalReducibility(RS)
   = filterByEquationalReducibility*(empty,RS) .

  op filterByEquationalReducibility* : ResultTripleSet ResultTripleSet
                                    -> ResultTripleSet .
  eq filterByEquationalReducibility*(RS',empty)
   = RS' .
  eq filterByEquationalReducibility*(RS',{T,TP,S} | RS)
   = filterByEquationalReducibility*(
       RS' | filterByEquationalReducibilityE({T,TP,S}),
       RS) .

  op filterByEquationalReducibilityE : ResultTriple -> ResultTripleSet .
  ceq filterByEquationalReducibilityE({T,TP,S})
    = if isNF$(M,T) and isNF$(M,S)        
      then {T,TP,S}
      else empty
      fi
   if M := clearNonExecRls(clearAllFrozen(eqsNoBuiltInUnify2rls(upModule('STRAND-EXAMPLE-RULES-WITH-DOLEVYAO-RULES-WITH-CONSTRAINT-SYMBOLS-METATERM,true)))) .

endfm

fmod GRAMMAR-HEURISTICS is
  protecting MEMBERSHIP-GRAMMAR-LANGUAGE .
  protecting RESULT-GRAMMAR-NARROWING .
  protecting CONSTRAINTS-RULES .
  protecting DEFINITION-PROTOCOL-RULES-HANDLING .
  protecting GLOBAL-STRATEGY .

  var AtS : AttrSet .
  var SS : GlobalStrategy .

  var Gk : Grammar .

  var G G' G'' G''' : GrammarRule .
  vars S S' S'' : Substitution .

  vars CS CS' CS1 CS2 : CtrSet .
  vars M M' M1 M2 M3 M4 : Msg .
  vars MS MS' : MsgSet .

  vars T T' T'' : Term .
  var TP TP' : Type .
  var TPL : TypeList .
  var V : Variable .
  var C : Constant .
  var F : Qid .
  var Ct : Context .
  var NeTL NeTL' : NeTermList .
  var TL TL' : TermList .
  var RN : ResultGrammarNarrowing .
  var RNS : ResultGrammarNarrowingSet .
  var RT : ResultTripleSet .
  var CR : Constraints&Rules .

  *** General Call for a set of results
  op heuristics : GlobalStrategy Grammar ResultGrammarNarrowingSet
                  -> Constraints&Rules [memo] .
  eq heuristics(SS,Gk,RNS)
   = heuristics*(SS,Gk,RNS,{empty,empty}) .
  op heuristics* : GlobalStrategy Grammar ResultGrammarNarrowingSet
                   Constraints&Rules -> Constraints&Rules .
  eq heuristics*(SS,Gk,empty,CR)
   = CR .
  eq heuristics*(SS,Gk,RN ; RNS,CR)
   = heuristics*(SS,Gk,RNS,CR + heuristicsOne(SS,Gk,RN)) .

  *** General Call for one result
  op heuristicsOne : GlobalStrategy Grammar ResultGrammarNarrowing
               -> Constraints&Rules .
  eq heuristicsOne(SS,Gk,{G,S,G'',S',G'}) 
   = if heuristic1(Gk,G,S .. S',G') =/= {empty,empty} 
     then heuristic1(Gk,G,S .. S',G')
     else
     if SS == S1 
        and
        heuristic2A(G,S .. S',G') =/= {empty,empty} 
     then heuristic2A(G,S .. S',G')
     else 
     if SS == S2 
        and
        heuristic2B(G,S .. S',G') =/= {empty,empty} 
     then heuristic2B(G,S .. S',G')
     else 
     if heuristic3(G') =/= {empty,empty} 
     then heuristic3(G')
     else heuristicsOtherwise(SS,Gk,{G,S,G'',S',G'}) 
     fi
     fi
     fi
     fi .
     
  op heuristicsOtherwise : GlobalStrategy Grammar ResultGrammarNarrowing 
                        -> Constraints&Rules .
 ceq heuristicsOtherwise(SS,
        Gk ; (grl CS1 => M1 inL .),
        {G,S,G'',S',grl CS2 => (M2,MS) inL .})
   = {empty, empty}  *** Do not report error if grammar production already exists
  if M:Module 
      := upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true)
  /\ upTerm(grl CS1 => M1 inL .) =[M:Module]= upTerm(grl CS2 => M2 inL .) .
  eq heuristicsOtherwise(SS,Gk,{G,S,G'',S',G'})
   = errorCRNoHeuristicApplied {G,S,G'',S',G'} usingGrammar Gk 
  [owise] .

  ************************************************************************
  *** Heuristic 1
  op heuristic1 : Grammar GrammarRule Substitution GrammarRule -> Constraints&Rules [memo] .
  eq heuristic1(Gk,G,S,grl CS => emptyMsgSet inL .)
   = {empty,empty} .
  ceq heuristic1(Gk,grl CS1 => M1 inL .,S,grl CS => (M,MS) inL .)
   = if heuristic1Test(Gk,M1 << S,CS,T,[]) =/= {empty,empty}
     then filterMostGeneral(heuristic1Test(Gk,M1 << S,CS,T,[]))
     else heuristic1(Gk,grl CS1 => M1 inL .,S,grl CS => MS inL .)
     fi 
   if M:Module 
      := upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true)
   /\ T := flatten(M:Module,upTerm(M)) .

  *** 
  op filterMostGeneral : Constraints&Rules -> Constraints&Rules .
 ceq filterMostGeneral(
      {empty,
       grl M1 inL => M2 inL . ; grl M3 inL => M4 inL . ; GS:GrammarRuleSet })
   = filterMostGeneral(
      {empty,
       grl M3 inL => M4 inL . ; GS:GrammarRuleSet })
  if (upTerm(M1),upTerm(M2)) <<= (upTerm(M3),upTerm(M4)) .
  eq filterMostGeneral({empty,GS:GrammarRuleSet})
   = {empty,GS:GrammarRuleSet } 
  [owise] .

  op `(_`,_`) <<= `(_`,_`) : Term Term Term Term -> Bool .
  eq (M1:Term,M2:Term) <<= (M3:Term,M3:Term) 
   = true .
  eq (M1:Term,F:Qid[TL1:TermList]) <<= (M3:Term,F:Qid[TL2:TermList]) 
   = (M1:Term,TL1:TermList) <<=* (M3:Term,TL2:TermList) .
  eq (M1:Term,M2:Term) <<= (M3:Term,M4:Term) 
   = false [owise] .

  op `(_`,_`) <<=* `(_`,_`) : Term TermList Term TermList -> Bool .
  eq (M1:Term,empty) <<=* (M3:Term,empty)
   = false .
  eq (M1:Term,(T1:Term,TL1:TermList)) <<=* (M3:Term,(T2:Term,TL2:TermList))
   = (M1:Term,T1:Term) <<= (M3:Term,T2:Term)
     or-else
     (M1:Term,TL1:TermList) <<=* (M3:Term,TL2:TermList) .

  *** Test for one position of the term
  op heuristic1Test : Grammar Msg CtrSet Term Context -> Constraints&Rules .

  ceq heuristic1Test(Gk,M1,CS,T,Ct)
    = {empty,
       downGrammar('grl_=>_.['_inL[New:Variable],
                             '_inL[Ct[New:Variable]]
			    ])}
   if M:Module 
      := upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true)
   /\ not typeLeq(M:Module,leastSort(M:Module,T),'Public)
   /\ M1 == downMsgSet(T) 
      or-else
      {Gk,CS} |- downMsgSet(T) inL
   /\ T:Type := leastSort(M:Module,T)
   /\ New:Variable 
       := if typeLeq(M:Module,leastSort(M:Module,Ct['New:Msg]),'Msg)
          then 'New:Msg 
          else addType T:Type ToVar 'New
          fi  <<(Ct[T],upTerm(CS))< .

  eq heuristic1Test(Gk,M1,CS,F[NeTL],Ct)
    = heuristic1Split(Gk,M1,CS,F,empty,NeTL,Ct) .

  eq heuristic1Test(Gk,M1,CS,T,Ct)
   = {empty,empty}
     [owise] .

  *** Split of the term *** Recall there are other two split functions
  op heuristic1Split : Grammar Msg CtrSet Qid TermList TermList Context 
                    -> Constraints&Rules .

  eq heuristic1Split(Gk,M1,CS,F,TL,empty,Ct)
   = {empty,empty} .
 ceq heuristic1Split(Gk,M1,CS,F,TL,(T,TL'),Ct)
   = if sameKind(
         upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
         leastSort(
	   upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
	   F[TL,TL']),
         'Msg)
        and
        heuristic1Test(Gk,M1,CS,F[TL,TL'],Ct[F[T,[]]]) =/= {empty,empty}
     then heuristic1Test(Gk,M1,CS,F[TL,TL'],Ct[F[T,[]]])
     else {empty,empty}
     fi 
     +
     heuristic1Split(Gk,M1,CS,F,(TL,T),TL',Ct)
  if isAssociative(upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),F[TL,T,TL']) 
  /\ size((TL,TL')) >= 2 .

  eq heuristic1Split(Gk,M1,CS,F,TL,(T,TL'),Ct)
   = if sameKind(
         upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
         leastSort(
	   upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
	   T),
         'Msg)
        and
        heuristic1Test(Gk,M1,CS,T,Ct[F[TL,[],TL']]) =/= {empty,empty}
     then heuristic1Test(Gk,M1,CS,T,Ct[F[TL,[],TL']])
     else {empty,empty}
     fi 
     +
     heuristic1Split(Gk,M1,CS,F,(TL,T),TL',Ct)
  [owise] .

  ************************************************************************
  *** Heuristic 2A
  op heuristic2A : GrammarRule Substitution GrammarRule 
                -> Constraints&Rules [memo] .

  ceq heuristic2A(grl (M notInI,CS) => MS inL .,S,G')
   = {downCtrSet('_notLeq_[New:Variable,
                           (New:Variable << S) <<(upTerm(MS))<]), 
      empty}
   if (TL:TermList,New:Variable,TL':TermList) 
            := Vars(upTerm(M)) intersect Vars(upTerm(MS))
   /\ dom S inVars New:Variable 
   /\ not 
        metaBuiltInRenaming(
          upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
          upTerm(M),
          upTerm(M) << S
        )
   /\ (not ((New:Variable << S) :: Variable) 
       or-else
       ((New:Variable << S) :: Variable  
        and-then
        getType(New:Variable) =/= getType((New:Variable << S))  --- A variable is downgraded
       )
      ) .

  ceq heuristic2A(grl (M' inL) => MS' inL .,
                  S,
                  grl (M notInI,CS) => MS inL .)
   = {downCtrSet('_notLeq_['New:Msg,
                           upTerm(M) <<(upTerm(MS),upTerm(MS'))<]), 
      empty}
   if upTerm(M') :: Variable
   /\ dom S inVars upTerm(M')
   /\ not (upTerm(M) :: Variable) .

  ceq heuristic2A(grl (M' inL) => M1:Msg inL .,
                  S,
                  grl (M inL) => MS inL .)
    = {downCtrSet('_notLeq_[upTerm(M1:Msg),
                            (upTerm(M1:Msg) << S) <<(upTerm(M1:Msg))<]),
       empty}
   if dom S inVars upTerm(M') .

  eq heuristic2A(G,S,G')
   = {empty,empty}
     [owise] .

  *** Heuristic 2B
  op heuristic2B : GrammarRule Substitution GrammarRule 
                -> Constraints&Rules [memo] .
  ceq heuristic2B(grl CS => M inL .,S,G')
    = {downCtrSet('_notLeq_[upTerm(M),(upTerm(M) << S) <<(upTerm(M))<]),
           empty}
   if dom S inVars upTerm(M) .

  eq heuristic2B(G,S,G')
   = {empty,empty}
     [owise] .

  ************************************************************************
  *** Heuristic 3
  op heuristic3 : GrammarRule -> Constraints&Rules [memo] .
  eq heuristic3(grl CS => emptyMsgSet inL .)
   = {empty,empty} .
  ceq heuristic3(grl CS => (M,MS) inL .)
   = if heuristic3Test(CS,M#:Term,[]) =/= {empty,empty}
     then heuristic3Test(CS,M#:Term,[])
     else heuristic3(grl CS => MS inL .)
     fi 
   if M:Module 
      := upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true)
   /\ M#:Term := flatten(M:Module,upTerm(M)) .

  *** Test for one posision in the term
  op heuristic3Test : CtrSet Term Context -> Constraints&Rules .

  ceq heuristic3Test((M notInI,CS),T,Ct)
    = if typeLeq(M:Module,T:Type,'Msg)
         and
         M == downMsgSet(T)
         and
         typeLeq(M:Module,leastSort(M:Module,Ct['New:Msg]),'Msg)
      then {empty,downGrammar(
                   'grl_=>_.['_notInI[New:Variable],'_inL[Ct[New:Variable]]])}
      else if heuristic3Split(M,T,Ct) =/= {empty,empty}
           then heuristic3Split(M,T,Ct)
           else heuristic3Test(CS,T,Ct)
           fi
      fi
   if M:Module 
      := upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true)
   /\ not typeLeq(M:Module,leastSort(M:Module,T),'Public)
   /\ T:Type := leastSort(M:Module,T)
   /\ New:Variable 
       := if typeLeq(M:Module,leastSort(M:Module,Ct['New:Msg]),'Msg)
          then 'New:Msg 
          else addType T:Type ToVar 'New
          fi  <<(Ct[T])< .

   eq heuristic3Test(CS,T,Ct)
   = {empty,empty}
     [owise] .

  *** Split of the term *** Recall there are other two split functions
  op heuristic3Split : Msg Term Context 
                    -> Constraints&Rules .
  eq heuristic3Split(M,F[TL],Ct) = heuristic3Split(M,F,empty,TL,Ct) .
  eq heuristic3Split(M,T,Ct) = {empty,empty} [owise] .

  op heuristic3Split : Msg Qid TermList TermList Context 
                    -> Constraints&Rules .

  eq heuristic3Split(M,F,TL,empty,Ct)
   = {empty,empty} .
 ceq heuristic3Split(M,F,TL,(T,TL'),Ct)
   = if sameKind(
         upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
         leastSort(
	   upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
	   F[TL,TL']),
         'Msg)
        and
        heuristic3Test(M notInI,F[TL,TL'],Ct[F[T,[]]]) =/= {empty,empty}
     then heuristic3Test(M notInI,F[TL,TL'],Ct[F[T,[]]])
     else heuristic3Split(M,F,(TL,T),TL',Ct)
     fi 
  if isAssociative(upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),F[TL,T,TL']) 
  /\ size((TL,TL')) >= 2 .
  eq heuristic3Split(M,F,TL,(T,TL'),Ct)
   = if sameKind(
         upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
         leastSort(
	   upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
	   T),
         'Msg)
        and
        heuristic3Test(M notInI,T,Ct[F[TL,[],TL']]) =/= {empty,empty}
     then heuristic3Test(M notInI,T,Ct[F[TL,[],TL']])
     else heuristic3Split(M,F,(TL,T),TL',Ct)
     fi 
  [owise] .

endfm

fmod GENERATION-CONSTRAINTS-RULES is
  protecting CONSTRAINTS-RULES .
  protecting GRAMMAR-HEURISTICS .
  protecting GRAMMAR-NARROWING .
  
  var G : GrammarRule .
  var GS : GrammarRuleSet .
  var GSS : GrammarList .
  var Gk : Grammar .
  var C : CtrSet .
  var H : GrammarRuleSet .
  var SS : GlobalStrategy .
  var M : Module .
  
  op generationNewConstraintsRules : Module GlobalStrategy GrammarList Grammar 
                                     Grammar ~> Constraints&Rules .
  eq generationNewConstraintsRules(M,SS,GSS,Gk,GS)
   = generationNewConstraintsRules*(M,SS,GSS,Gk,empty,empty,GS) .
  
  op generationNewConstraintsRules* : 
       Module GlobalStrategy GrammarList Grammar 
       CtrSet Grammar 
       Grammar ~> Constraints&Rules .
  eq generationNewConstraintsRules*(M,SS,GSS,Gk,C,H, empty)
   = {C,H} .
  ceq generationNewConstraintsRules*(M,SS,GSS,Gk,C,H, G ; GS)
   = if CR:[Constraints&Rules] :: errorConstraints&Rules
     then CR:[Constraints&Rules]
     else generationNewConstraintsRules*(M,SS,GSS,Gk,
             (C, getCtrSet(CR:[Constraints&Rules])),
             (H ; getGrammarRuleSet(CR:[Constraints&Rules])),
             GS) 
     fi
  if CR:[Constraints&Rules] := generationNewConstraintsRulesE(M,SS,GSS,Gk,G) .

  op generationNewConstraintsRulesE : 
       Module GlobalStrategy GrammarList Grammar 
       GrammarRule ~> Constraints&Rules .
  eq generationNewConstraintsRulesE(M,SS,GSS,Gk,G)
   = heuristics(SS,Gk,oneStepGNarrow(M,G,GSS,Gk)) .

endfm
fmod GENERATION-NEW-GRAMMAR is
  protecting CONSTRAINTS-RULES .
  protecting GLOBAL-STRATEGY .
  protecting META-LEVEL .
  protecting ORDERS-TERM-SUBSTITUTION .
  pr META-MSG-UNIFICATION .
  pr SUBSTITUTION-HANDLING .
  pr DEFINITION-PROTOCOL-RULES-HANDLING .
  pr META-NORMALIZE .
  pr DEFINITION-CONSTRAINTS-HANDLING .
  pr PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS-HANDLING .
  pr RESULT-CONTEXT-SET .
  pr TERMSET .

  vars G G' : Grammar .
  vars C C' CS : CtrSet .
  vars H GS : GrammarRuleSet .
  var M M' MV : Msg .
  var MS : MsgSet .
  var TL : TermList .
  var V : Variable .

  *** Shortcut
  op generationNewGrammar : GlobalStrategy Grammar [Constraints&Rules] 
                         -> Grammar  .
  eq generationNewGrammar(SS:GlobalStrategy,G,CR:[Constraints&Rules])
   = if CR:[Constraints&Rules] :: errorConstraints&Rules
     then [ CR:[Constraints&Rules] ]
     else generationNewGrammar*(SS:GlobalStrategy,G,CR:[Constraints&Rules])
     fi .

  op generationNewGrammar* : GlobalStrategy Grammar Constraints&Rules 
                         -> Grammar  .
  eq generationNewGrammar*(SS:GlobalStrategy,G,{C,H})
   = filterError(generationNewGrammar**(SS:GlobalStrategy,G,C,H)) .

  *** General Call for the generation of the new grammar  
  op generationNewGrammar** : GlobalStrategy Grammar CtrSet GrammarRuleSet 
                         -> Grammar .
  eq generationNewGrammar**(SS:GlobalStrategy,G,empty,empty) 
   = G .
  eq generationNewGrammar**(SS:GlobalStrategy,G,C,H) 
   = generationNewGrammar***(SS:GlobalStrategy,G,C,H) 
  [owise] .

  op generationNewGrammar*** : GlobalStrategy Grammar CtrSet GrammarRuleSet 
                         -> Grammar .
  eq generationNewGrammar***(S1,G,C,H)
   = alpha(G,C) ; alpha(H,C) ; hat(G) ; hat(H) .
  eq generationNewGrammar***(S2,G,C,H)
   = beta(G,unwrapExceptions(G,C)) ; hat(G) ; hat(H) .

  *** Alpha transformer
  *** Adds notLeq constraints to rules with a notInI constraint
  op alpha : GrammarRuleSet CtrSet -> GrammarRuleSet .
  eq alpha(GS , C) = alpha*(GS , C) .

  op alpha* : GrammarRuleSet CtrSet -> GrammarRuleSet [memo] .
  eq alpha*((grl (MV inL,CS) => M inL .) ; GS , C)
   = alpha*(GS , C) .

  ceq alpha*((grl empty => M inL .) ; GS , C)
    = (grl adapt(C,M,empty) => M inL .) ; alpha*(GS , C) 
   if adapt(C,M,empty) :: CtrSet .

  ceq alpha*((grl (MV notInI,CS) => M inL .) ; GS , C)
    = (grl (MV notInI,CS, adapt(C,MV,Vars(M) intersect Vars(MV))) => M inL .)
      ; alpha*(GS , C) 
   if adapt(C,MV,Vars(M) intersect Vars(MV)) :: CtrSet .

  eq alpha*(GS , C)
   = if C =/= empty and GS =/= empty
     then errorIntegratingExceptions C intoGrammarRule GS 
     else empty
     fi
     [owise] .

  *** Beta transformer
  *** (Adds notLeq constraints to rules without a notInI constraint)
  *** Here renaming of notLeq constraints is not necessary
  *** because by construction the message in the left part of the notLeq
  *** is exactly the term M in the right part of the rule
  op beta : GrammarRuleSet CtrSet -> GrammarRuleSet .
  eq beta(GS , C) = beta*(GS , C) .

  op beta* : GrammarRuleSet CtrSet -> GrammarRuleSet [memo] .
  
  eq beta*((grl (MV inL,CS) => MS inL .) ; GS , C)
   = (grl (MV inL,CS) => MS inL .)
     ; beta*(GS,C) .

  ceq beta*((grl CS => M inL .) ; GS , C)
    = (grl (CS,adapt(C,M,empty)) => M inL .) ; beta*(GS,C) 
   if adapt(C,M,empty) :: CtrSet .

  eq beta*((grl empty => M inL .) ; GS , C)
    = (grl empty => M inL .) ; beta*(GS,C) .

  eq beta*(GS, C)
   = if C =/= empty and GS =/= empty
     then errorIntegratingExceptions C intoGrammarRule GS
     else empty
     fi 
     [owise] .


  *** It should be all those constraints that match the term MV,
  *** but since we have used the same term MV for creating the constraint
  *** we just look for MV
  op adapt : CtrSet Msg TermList ~> CtrSet .
  eq adapt(C,MV,TL) = adapt*(C,MV,TL,empty) .

  op adapt* : CtrSet Msg TermList CtrSet ~> CtrSet [memo] .
             ---3rd argument is varialbes of 2nd argument relevant 
             ---for introducing the exceptions

  eq adapt*(empty,MV,TL,C')
   = C' .

  ceq adapt*(((M notLeq M'),C),MV,TL,C')
    = adapt*(C,MV,TL,(C',MV notLeq M'))
   if --- case 1
      (upTerm(MV) :: Variable and upTerm(M) :: Variable)
      or-else
      --- case 2
      M == MV
      or-else
      --- case 3
      (not(upTerm(MV) :: Variable) 
       and-then 
       not(upTerm(M) :: Variable)
       and-then
       metaBuiltInMatch?(
        upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
         upTerm(M),
	 upTerm(MV) <<(upTerm(M))<
       )
      ) 
      or-else
      --- case 4
      (not(upTerm(MV) :: Variable) 
       and-then 
       upTerm(M) :: Variable
       and-then
       not(upTerm(M') :: Variable)
       and-then
       metaBuiltInMatch?(
        upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
        upTerm(M'),
	upTerm(MV) <<(upTerm(M'))<
       )
      ) 
      or-else
      --- case 5
      (not(upTerm(MV) :: Variable) 
       and-then
       upTerm(M) :: Variable
       and-then
       (upTerm(M') :: Variable and getType(upTerm(M')) =/= 'Msg)
       and-then
       metaBuiltInMatch?(
        upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
	upTerm(MV) <<(upTerm(M'))<,
        upTerm(M')
       )
      ) .

  ceq adapt*(((M notLeq M'),C),MV,V,C')
    = adapt*(C,MV,V,(C',downMsgSet(V) notLeq M'))
   if --- V is a variable already existing in MV (which is not a variable)
      upTerm(M) :: Variable 
   /\ not (upTerm(MV) :: Variable) .
          
  ceq adapt*(((M notLeq M'),C),MV,TL,C')
    = adapt*(C,MV,TL,C')
   if (not upTerm(M) :: Variable and-then upTerm(MV) :: Variable)
      or-else  
      not 
      metaBuiltInMatch?(
        upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
        upTerm(M),
	upTerm(MV) <<(upTerm(M))<) .

  op hat : GrammarRuleSet -> GrammarRuleSet .
  eq hat(GS) = hat*(GS) .

  op hat* : GrammarRuleSet -> GrammarRuleSet .
  eq hat*(empty) = empty .
  ceq hat*((grl (MV inL,CS) => M inL .) ; GS)
    = (grl (MV inL,CS) => M inL .)
      ; hat*(GS) 
   if upTerm(MV) :: Variable .
  eq hat*((grl CS => MS inL .) ; GS)
   = hat*(GS) 
     [owise] .
   
  *** 
  op Vars : Msg -> TermList .
  eq Vars(M:Msg) = Vars(upTerm(M:Msg)) .

  op unwrapExceptions : Grammar CtrSet -> CtrSet .
  eq unwrapExceptions(G,C)
   = if G == empty then C else unwrapExceptions*(G,C) fi .

  op unwrapExceptions* : Grammar CtrSet -> CtrSet .
  eq unwrapExceptions*(G,((M notLeq M'),C))
   = (M notLeq M'),
     unwrapExceptions$(
      getTerms(
        metaNormalizeCollect( ---here we cannot use metaNormalizeCollect$
         flipRls(grammar2Module(only-inL(G))),
         '_inL[upTerm(M')],'LConstraint))
     ),
     unwrapExceptions*(G,C) .
  eq unwrapExceptions*(G,C)
   = C [owise] .

  op unwrapExceptions$ : TermSet -> CtrSet .
  eq unwrapExceptions$(('_inL[Y:Term]) | TS:TermSet)
   = downCtrSet('_notLeq_['New:Msg,Y:Term]),
     unwrapExceptions$(TS:TermSet) .
  eq unwrapExceptions$(TS:TermSet)
   = empty [owise] .

endfm

fmod OPTIMIZE-NEW-GRAMMAR is
  protecting CONSTRAINTS-RULES .
  protecting GLOBAL-STRATEGY .
  protecting META-LEVEL .
  protecting MEMBERSHIP-GRAMMAR-LANGUAGE .
  pr DEFINITION-PROTOCOL-RULES-HANDLING .
  pr RENAMING .

  var CS : CtrSet .
  vars M M' : Msg .
  var GS : GrammarRuleSet .
  var N : Nat .

  *** General Call  
  op optimizeGrammar : Grammar -> Grammar .
  eq optimizeGrammar(G:Grammar)
   = if G:Grammar :: errorGrammar
     then G:Grammar
     else simplifyVars(removeRules(removeConstraints(G:Grammar))) 
     fi .
   
  op simplifyVars : Grammar -> Grammar .
  eq simplifyVars(G:Grammar)
   = if G:Grammar :: errorGrammar 
     then G:Grammar else simplifyVars*(G:Grammar) fi .

  op simplifyVars* : Grammar -> Grammar .
  eq simplifyVars*((empty).GrammarRuleSet)
   = (empty).GrammarRuleSet .
  eq simplifyVars*((grl CS => M inL .) ; GS)
   = simplifyVarsGRule(
       grl renameVarsExceptions(CS,
             highestVar(upTerm((grl CS => M inL .))) + 1)
       => M inL .)
     ; simplifyVars*(GS) .

  op simplifyVarsGRule : GrammarRule -> GrammarRule .
  eq simplifyVarsGRule(G:GrammarRule) 
   = downGrammar(simplifyVars(upTerm(G:GrammarRule))) .

  op renameVarsExceptions : CtrSet Nat -> CtrSet .
  eq renameVarsExceptions(empty,N)
   = empty .
  eq renameVarsExceptions((M notLeq M'),C:CtrSet,N)
   = (M notLeq (M' << getSubst(M' << {none,N} <))),
     renameVarsExceptions(C:CtrSet,getNextVar(M' << {none,N} <)) . 
  eq renameVarsExceptions(C:Constraint,C:CtrSet,N)
   = C:Constraint,renameVarsExceptions(C:CtrSet,N)
  [owise] .

  ****
  op removeRules : Grammar -> Grammar .
  ceq removeRules((grl CS => M inL .) ; G:Grammar)
    = removeRules(G:Grammar)
   if {G:Grammar,CS} |- M inL .
  ceq removeRules((grl ((M notLeq M'),CS) => M inL .) ; G:Grammar)
    = errorInconsistentExceptionsInGrammarRule 
            (grl ((M notLeq M'),CS) => M inL .)
      inGrammar 
          ((grl ((M notLeq M'),CS) => M inL .) ; G:Grammar)
   if metaBuiltInMatch(
       upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),
       upTerm(M),
       upTerm(M') <<(upTerm(M))<) =/= empty .
  eq removeRules(G:Grammar)
   = if nonRecursive(G:Grammar) then G:Grammar else empty fi 
  [owise] .

  op nonRecursive : Grammar -> Bool .
  eq nonRecursive((grl (M inL) => M inL .) ; G:Grammar)
   = nonRecursive(G:Grammar) .
  eq nonRecursive(empty)
   = false .
  eq nonRecursive(G:Grammar)
   = true [owise] .
     
  *** Second transformer
  op removeConstraints : Grammar -> Grammar .
  eq removeConstraints(empty)
   = empty .
  eq removeConstraints((grl CS => M inL .) ; GS)
   = (grl get-except-notLeq(CS),maximal<=(get-notLeq(CS)) => M inL .) 
     ; removeConstraints(GS) .
     
  op maximal<= : CtrSet -> CtrSet .
  eq maximal<=(CS)
   = if maximal<=Ite(CS,CS) =/= CS
     then maximal<=(maximal<=Ite(CS,CS))
     else CS
     fi .
   
  op maximal<=Ite : CtrSet CtrSet -> CtrSet .
  eq maximal<=Ite( empty, CS':CtrSet )
   = empty .
  eq maximal<=Ite( (C:Constraint,CS:CtrSet), (C:Constraint,CS':CtrSet) )
   = if maximal<=IteOne( C:Constraint, CS':CtrSet ) == empty
     then maximal<=Ite( CS:CtrSet, CS':CtrSet )
     else (maximal<=IteOne( C:Constraint, CS':CtrSet ),
           maximal<=Ite( CS:CtrSet, (C:Constraint,CS':CtrSet)))
     fi .
  
  op maximal<=IteOne : Constraint CtrSet -> CtrSet .
  eq maximal<=IteOne( C:Constraint, empty )
   = C:Constraint .
  eq maximal<=IteOne( C:Constraint, (C':Constraint,CS:CtrSet) )
   = if C':Constraint <=[Vars(upTerm(C:Constraint))] C:Constraint
     then empty
     else maximal<=IteOne( C:Constraint, CS:CtrSet )
     fi .

endfm

fmod GRAMMAR-GENERATION is
  protecting OPTIMIZE-NEW-GRAMMAR .
  protecting GENERATION-NEW-GRAMMAR .
  protecting GENERATION-CONSTRAINTS-RULES .
  protecting GLOBAL-STRATEGY .
  pr ORDERS-TERM-SUBSTITUTION .
  
  op grammarsGeneration : GlobalStrategy Bound GrammarList -> GrammarList .
  ceq grammarsGeneration(SS:GlobalStrategy,B:Bound,GS:GrammarList)
    = if SSD:[StrandSet] :: StrandSet then 
      if SSP:[StrandSet] :: StrandSet then 
      if X:[SModule] :: SModule then
      grammarsGeneration*(X:[SModule],
       SS:GlobalStrategy,B:Bound,B:Bound,GS:GrammarList,GS:GrammarList) 
      else (errorInProtocolOrDolevYaoStrands).GrammarList fi
      else (errorInProtocolStrands).GrammarList fi 
      else (errorInDolevYaoStrands).GrammarList fi
   if X:[SModule] := flipRls(PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS) 
   /\ SSD:[StrandSet] := downStrandSet(
             extract('STRANDS-DOLEVYAO.StrandSet,PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE))
   /\ SSP:[StrandSet] := downStrandSet(
             extract('STRANDS-PROTOCOL.StrandSet,PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) .
   
  op grammarsGeneration* : Module GlobalStrategy Bound Bound 
                          GrammarList GrammarList 
                          -> GrammarList .
  eq grammarsGeneration*(M:Module,SS:GlobalStrategy,
                        B:Bound,
			BOrig:Bound,
			GS':GrammarList,
			none)
   = GS':GrammarList .
  eq grammarsGeneration*(M:Module,
                        SS:GlobalStrategy,
                        B:Bound,
			BOrig:Bound,
                        GS':GrammarList | G:Grammar | GS'':GrammarList,
			G:Grammar | GS:GrammarList)
   = if (B:Bound == unbounded or-else B:Bound > 0)
        and-then
        (not (G:Grammar :: errorGrammar)
         and-then
         grammarsGenerationIte(M:Module,
	     SS:GlobalStrategy,
	     GS':GrammarList | G:Grammar | GS'':GrammarList,
	     G:Grammar) 
          =/[M:Module]= G:Grammar )
     then grammarsGeneration*(
             M:Module,
             SS:GlobalStrategy,
             dec(B:Bound),
	     BOrig:Bound,
             (GS':GrammarList | 
               grammarsGenerationIte(M:Module,
	         SS:GlobalStrategy,
	         GS':GrammarList | G:Grammar | GS'':GrammarList,
	         G:Grammar) 
              | GS'':GrammarList),
             (  grammarsGenerationIte(M:Module,
	         SS:GlobalStrategy,
	         GS':GrammarList | G:Grammar | GS'':GrammarList,
	         G:Grammar) 
              | GS:GrammarList) )
     else grammarsGeneration*(
             M:Module,
             SS:GlobalStrategy,
             BOrig:Bound,
             BOrig:Bound,
             GS':GrammarList | G:Grammar | GS'':GrammarList,
	     GS:GrammarList)
     fi .

  op grammarsGenerationIte : Module GlobalStrategy GrammarList 
                             Grammar -> GrammarList [memo] .
  eq grammarsGenerationIte(M:Module,SS:GlobalStrategy,GS:GrammarList,G:Grammar)
   = optimizeGrammar(
       generationNewGrammar(
          SS:GlobalStrategy,G:Grammar, 
           generationNewConstraintsRules(
              M:Module,SS:GlobalStrategy,GS:GrammarList,G:Grammar,G:Grammar))) .

  op _=/[_]=_ : Grammar Module Grammar -> Bool .
  eq G:Grammar =/[M:Module]= G':Grammar 
   = not(G:Grammar =[M:Module]= G':Grammar) .

  op _=[_]=_ : Grammar Module Grammar -> Bool [memo] .
  eq G:errorGrammar =[M:Module]= G:Grammar
   = false .
  eq G:Grammar =[M:Module]= G:errorGrammar
   = false .
  eq G:Grammar =[M:Module]= G:Grammar
   = true .
  eq G:GrammarRule ; G:Grammar =[M:Module]= G':GrammarRule ; G':Grammar
   = upTerm(G:GrammarRule) =[M:Module]= upTerm(G':GrammarRule) 
       <<(upTerm(G:GrammarRule))<
     and-then 
     G:Grammar =[M:Module]= G':Grammar .
  eq G:Grammar =[M:Module]= G':Grammar
   = false 
  [owise] .

endfm

fmod NEW-NEVER-PATTERNS-HANDLING is
  protecting MEMBERSHIP-GRAMMAR-LANGUAGE .
  protecting META-E-NARROWING .
  protecting DEFINITION-PROTOCOL-RULES-HANDLING .
  protecting META-LEVEL .
  protecting GENERATE-RULES .
  protecting PROTOCOL-EXAMPLE-GHOST .

  vars IS IS' : IdSystem .
  --- vars SS SS' : StrandSet .
  vars IK IK' : IntruderKnowledge .
  vars ML ML' : SMsgList .
  vars GL GL' : GhostList  .
  --- var PP : Properties .
  var S : System .
  var ST : SystemSet .




  --- eq testNewNeverFound() 
  --- función que hace el membership entre los strands del estado 
  --- y los del never pattern, y lo mismo con el intruderknowledge
  --- ahora se aplica igual que el testNeverFound de antes.

  op testNewNeverFound :  IdSystem -> Bool .
  eq testNewNeverFound(IS) 
   = testNewNeverFound*(IS) .

  op testNewNeverFound* :  IdSystem -> Bool .
  eq testNewNeverFound*( < I:Id >
       (SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || GL:GhostList   
           || never( (SS':StrandSet || K':IntruderKnowledge) NPSet:NeverPatternSet )))
   = testNewNeverFound**( < I:Id >
       (SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || GL:GhostList  
           || never( (SS':StrandSet || K':IntruderKnowledge))))
     or-else
     testNewNeverFound*( < I:Id >
       (SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || GL:GhostList  
        || never(NPSet:NeverPatternSet)))  .
  eq testNewNeverFound*(IS) 
   = false [owise] .

  op testNewNeverFound** :  IdSystem -> Bool .
  eq testNewNeverFound**( < I:Id >
       (SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || GL:GhostList  
           || never( (SS':StrandSet || K':IntruderKnowledge) )))
   = if Vars(upTerm(SS:StrandSet || K:IntruderKnowledge)) 
        intersect 
        Vars(upTerm(SS':StrandSet || K':IntruderKnowledge))
        == empty
     then *** Easier test -> much quicker
     metaBuiltInMatch?(
           STRAND-EXAMPLE-RULES-WITH-ALL,
           upTerm(makeStrandsInitial*(SS:StrandSet) 
                  || K:IntruderKnowledge || nil || nil || nil),
           upTerm(makeStrandsInitial*(SS':StrandSet) 
                  || K':IntruderKnowledge ||  nil || nil || nil ) 
         ) 
     else *** Most general test
     metaBuiltInMatch?(
           STRAND-EXAMPLE-RULES-WITH-ALL,
           upTerm(makeStrandsInitial*(SS:StrandSet) 
                  || K:IntruderKnowledge || nil || nil 
                  || never (makeStrandsInitial*(SS:StrandSet) || K:IntruderKnowledge)),
           upTerm(makeStrandsInitial*(SS:StrandSet) 
                  || K:IntruderKnowledge ||  nil || nil 
                  || never (makeStrandsInitial*(SS':StrandSet) || K':IntruderKnowledge) )
         ) 
     fi .

endfm
fmod BACK-NARROWING is
  protecting MEMBERSHIP-GRAMMAR-LANGUAGE .
  protecting META-E-NARROWING .
  protecting DEFINITION-PROTOCOL-RULES-HANDLING .
  protecting META-LEVEL .
  protecting GENERATE-RULES .
  protecting PROTOCOL-EXAMPLE-GHOST .
  protecting NEW-NEVER-PATTERNS-HANDLING .

  vars IST IST' IST'' HistoryIST HistoryIST' : IdSystemSet .
  vars IS IS' IS'' IS$ : IdSystem .
  vars ST ST' HistoryST : SystemSet .
  vars S S' : System .
  vars T T' : Term .
  var V : Variable .
  var VL : TermList .
  vars TP TP' : Type .
  vars Subst Subst' : Substitution .
  var SSubst : SubstitutionSet .
  var Ct : Context .
  var CS : CtrSet .
  vars RS RS' RS'' : ResultTripleSet .
  var RT : ResultTriple .
  var SS : SystemSet .

  var GS : GrammarList .
  var M : Module .

 

  op nextBackNarrow : Module GrammarList Filters IdSystemSet IdSystemSet
                   -> IdSystemSet [memo] .
  eq nextBackNarrow(M,GS,F:Filters,HistoryIST,IST)
   = simplify-theSystemSet(F:Filters,HistoryIST,
       filter-eachSystem#Top(F:Filters,M,GS,
         simplify-eachSystem#Top(M, --- always simplify before filtering
             simplifyGhost(F:Filters,
              createGhost(M,F:Filters,
                reactivateGhost(F:Filters,
                 nextBackNarrow*(M,GS,F:Filters,IST)
                )
              )
             )
         )
       )
      )
     .

  op filter-eachSystem#Top : Filters Module GrammarList 
                         IdSystemSet -> IdSystemSet .
  eq filter-eachSystem#Top(F:Filters,M,GS,IST)
   = filter-eachSystem(F:Filters,M,GS,IST) .

  op simplify-eachSystem#Top : Module IdSystemSet -> IdSystemSet .
  eq simplify-eachSystem#Top(M,IST)
   = simplify-eachSystem(M,IST) .

  op nextBackNarrow* : Module GrammarList Filters IdSystemSet -> IdSystemSet .
  eq nextBackNarrow*(M,GS,F:Filters,IST)
   = nextBackNarrow**(M,GS,F:Filters,empty,
            tryUnificationofKnowledge(M,IST)) .

  op nextBackNarrow** : Module GrammarList Filters 
                        IdSystemSet IdSystemSet -> IdSystemSet .
  eq nextBackNarrow**(M,GS,F:Filters,IST',empty)
   = IST' .
  eq nextBackNarrow**(M,GS,F:Filters,IST',(IS IST))
   = nextBackNarrow**(M,GS,F:Filters,
                      (IST' nextBackNarrow*OneSt(M,GS,F:Filters,IS)),
                      IST) .

  op nextBackNarrow*OneSt : Module GrammarList Filters IdSystem 
                         -> IdSystemSet .
  eq nextBackNarrow*OneSt(M,GS,F:Filters,IS)
   = simplifyByPartialOrder(F:Filters, --- this must be the last action   
      filter-eachSystem#OneSt(F:Filters,M,GS,
       simplify-eachSystem#OneSt(M, --- always simplify before filtering
         nextBackNarrow*Fix(M,GS,F:Filters,IS)
       )
      )
    ) .

  op filter-eachSystem#OneSt : Filters Module GrammarList 
                         IdSystemSet -> IdSystemSet .
  eq filter-eachSystem#OneSt(F:Filters,M,GS,IST)
   = filter-eachSystem(F:Filters,M,GS,IST) .

  op simplify-eachSystem#OneSt : Module IdSystemSet -> IdSystemSet .
  eq simplify-eachSystem#OneSt(M,IST)
   = simplify-eachSystem(M,IST) .

  op nextBackNarrow*Fix : Module GrammarList Filters IdSystem 
                          -> IdSystemSet .
  eq nextBackNarrow*Fix(M,GS,F:Filters,IS)
   = nextBackNarrow*SimpleSet(M,GS,F:Filters,
        setIdVariants(getId(IS),
         fixIrrSystemInI(
            move*Input(F:Filters,
             remId(IS)
            )
         )
      )
     ) .

  op nextBackNarrow*SimpleSet : Module GrammarList Filters IdSystemSet 
                             -> IdSystemSet .
  eq nextBackNarrow*SimpleSet(M,GS,F:Filters,empty)
   = empty .
  eq nextBackNarrow*SimpleSet(M,GS,F:Filters,(IS IST))
   = nextBackNarrow*Simple(M,GS,F:Filters,IS)
     nextBackNarrow*SimpleSet(M,GS,F:Filters,IST) .

  op nextBackNarrow*Simple : Module GrammarList Filters IdSystem 
                          -> IdSystemSet .
  eq nextBackNarrow*Simple(M,GS,F:Filters,IS)
   = setId+(getId(IS) . 1,
       move*Input(F:Filters,
         composeFinalState(
           filter-ResultTripleSet(F:Filters,M,
             oneStepReachability(M,
                   remId(IS)
             )
           )
         )
       )
      ) .

  op move*Input : Filters SystemSet -> SystemSet .
  eq move*Input(F:Filters,SS:SystemSet)
   = if -inputAndNotLearned !in F:Filters
     then move*Input$(empty,SS:SystemSet)
     else SS:SystemSet
     fi .

  op move*Input$ : SystemSet SystemSet -> SystemSet .
  eq move*Input$(SS':SystemSet,empty)
   = SS':SystemSet .
  eq move*Input$(SS':SystemSet,S:System SS:SystemSet)
   = move*Input$(
       SS':SystemSet move*InputAll(S:System),
       SS:SystemSet
     ) .

  op move*InputAll : System -> System .
  eq move*InputAll(
        :: RL:FreshSet :: [ L:SMsgList-L, -(M:Msg) | L':SMsgList-R ]
        & SS:StrandSet 
        || K:IntruderKnowledge 
        || ML:SMsgList 
        || GL:GhostList 
        || PP:Properties
     )
   = move*InputAll( 
        :: RL:FreshSet :: [ L:SMsgList-L | -(M:Msg), L':SMsgList-R ]
        & SS:StrandSet 
        || if M:Msg :: Public or M:Msg inI in K:IntruderKnowledge
           then K:IntruderKnowledge
           else (M:Msg inI, K:IntruderKnowledge)
           fi
        || (-(M:Msg), ML:SMsgList) 
        || GL:GhostList
        || PP:Properties
     ) .
  eq move*InputAll(S)
   = S [owise] .

  op oneStepReachability : Module SystemSet -> ResultTripleSet .
  eq oneStepReachability(M,SS:SystemSet)
   = oneStepReachability*(M,empty,SS:SystemSet) .

  op oneStepReachability* : Module ResultTripleSet 
                            SystemSet -> ResultTripleSet .
  eq oneStepReachability*(M,RS,empty)
   = RS .
  eq oneStepReachability*(M,RS,S:System SS:SystemSet)
   = oneStepReachability*(M,
          RS | oneStepReachability**(M,S:System), 
          SS:SystemSet) .  

  op oneStepReachability** : Module System -> ResultTripleSet .
  eq oneStepReachability**(M, 
      SS:StrandSet || K:IntruderKnowledge 
        || ML:SMsgList || GL:GhostList || PP:Properties)
   = reconstruct(M,
      onlyInitialStrands(SS:StrandSet),
      (only-!inI(K:IntruderKnowledge),only-!=(K:IntruderKnowledge),
       only-irr(K:IntruderKnowledge),only-inst(K:IntruderKnowledge)),
      ML:SMsgList, 
      GL:GhostList,
      PP:Properties,
      empty,
      oneStepReachability***(M,
       (only-inst(K:IntruderKnowledge),only-irr(K:IntruderKnowledge)),
       upTerm(onlyNoInitialStrands(SS:StrandSet)
         || only-inI(K:IntruderKnowledge) 
         || nil || nil || nil
       ),
       highestVar(upTerm(
          SS:StrandSet || K:IntruderKnowledge 
          || ML:SMsgList || GL:GhostList || PP:Properties)
       )
      ) 
     ) .

  op oneStepReachability*** : Module IntruderKnowledge Term Nat
                           -> ResultTripleSet .
  eq oneStepReachability***(M, K:IntruderKnowledge, S:Term, NextVar:Nat)
   = unrigidLabel(
       metaEBuiltInTopMostNarrowIrr(M,
        rigidLabel(M,S:Term,Vars(upTerm(K:IntruderKnowledge))),
        NextVar:Nat
       ) 
     ) .

  op reconstruct : Module StrandSet IntruderKnowledge SMsgList GhostList Properties
                   ResultTripleSet ResultTripleSet -> ResultTripleSet .
  eq reconstruct(M,SS:StrandSet,
                   K:IntruderKnowledge,ML:SMsgList,
                   GL:GhostList,PP:Properties,
                   RS',
       empty)
   = RS' .
  eq reconstruct(M,SS:StrandSet,
                   K:IntruderKnowledge,ML:SMsgList,
                   GL:GhostList,PP:Properties,
                   RS',
       {T,TP,Subst} | RS)
   = reconstruct(M,SS:StrandSet,
                   K:IntruderKnowledge,ML:SMsgList,
                   GL:GhostList,PP:Properties,
       RS' 
       | 
       {reconstruct*(M,SS:StrandSet,
                     K:IntruderKnowledge,ML:SMsgList,
                     GL:GhostList,PP:Properties,
                     Subst,T),
        TP,Subst},
       RS) .

  op reconstruct* : Module StrandSet IntruderKnowledge SMsgList 
                    GhostList Properties
                    Substitution 
                    Term -> Term .

  eq reconstruct*(M,SS:StrandSet,K:IntruderKnowledge,ML:SMsgList,
                    G:GhostList,PP:Properties,
       Subst,
       '_||_||_||_||_[T1:Term,T2:Term,T3:Term,T4:Term,'nil.Properties]) 
   = '_||_||_||_||_[
        '_&_[T1:Term,upTerm(SS:StrandSet) << Subst],
        '_`,_[T2:Term,upTerm(K:IntruderKnowledge) << Subst],
        '_`,_[T3:Term,upTerm(ML:SMsgList) << Subst],
        '_`,_[T4:Term,upTerm(G:GhostList) << Subst],
        upTerm(PP:Properties) << Subst
     ] .

  op composeFinalState : ResultTripleSet -> SystemSet .
  eq composeFinalState(RS)
   = composeFinalState*(empty,RS) .

  op composeFinalState* : SystemSet ResultTripleSet -> SystemSet .
  eq composeFinalState*(SS,empty)
   = SS .
  eq composeFinalState*(SS,{T,TP,Subst} | RS)
   = composeFinalState*(
        addInst(rangeVars(Subst),
          downSystemSet(simplifyVars(T)) 
        )
        SS,
        RS
     ) .

  *** createGhost ************************************************  
  *** Replace current state with a ghost with M:Msg as the control 
  *** variable  
  
  op createGhost : Module Filters IdSystemSet -> IdSystemSet .
  eq createGhost(M,F:Filters,IST)
   = if -ghost !in F:Filters then createGhost(M,IST) else IST fi .

  op createGhost : Module IdSystemSet -> IdSystemSet .
  eq createGhost(M,IST)
   = createGhost*(M,empty,IST) .

  op createGhost* : Module IdSystemSet IdSystemSet -> IdSystemSet .
  eq createGhost*(M,IST',empty)
   = IST' .
  eq createGhost*(M,IST', IS IST)
   = createGhost*(M,(IST' createGhostS(M,IS)),IST) .
  
  op createGhostS : Module IdSystem -> IdSystem .
  eq createGhostS(M, 
       < I:Id >
       (SS:StrandSet || K:IntruderKnowledge 
        || ML:SMsgList || GL:GhostList || PP:Properties) )
   = createGhostSI(M, 
       < I:Id >
       (SS:StrandSet || K:IntruderKnowledge 
        || ML:SMsgList || GL:GhostList || PP:Properties),
       K:IntruderKnowledge ) .

  op createGhostSI : Module IdSystem IntruderKnowledge -> IdSystem .
  eq createGhostSI(M,
       < I:Id >
       (SS:StrandSet 
        || (M:Msg inI, K:IntruderKnowledge) 
        || ML:SMsgList || GL:GhostList || PP:Properties),
       (M:Msg inI, K':IntruderKnowledge))
   = if M:Msg !in GL:GhostList 
        and-then 
        testisGhostMsg(M:Msg)
     then *** Create ghost for M:Msg and continue inspecting
          createGhostSI(M,
            < I:Id >
            (SS:StrandSet 
             || removeIrr(M:Msg,K:IntruderKnowledge) || ML:SMsgList 
	     || (ghost(M:Msg,SS:StrandSet,
                       removeIrr(M:Msg,K:IntruderKnowledge),ML:SMsgList,PP:Properties),
                 GL:GhostList)
             || PP:Properties
            ),
            K':IntruderKnowledge
          )
     else *** Continue inspecting K':IntruderKnowledge
          createGhostSI(M,
             < I:Id >
             (SS:StrandSet 
              || (M:Msg inI, K:IntruderKnowledge) 
              || ML:SMsgList || GL:GhostList || PP:Properties),
             K':IntruderKnowledge
          )
     fi .
  eq createGhostSI(M,IS:IdSystem,K':IntruderKnowledge) 
   = IS:IdSystem [owise] .

  op removeIrr : Msg IntruderKnowledge -> IntruderKnowledge .
  eq removeIrr(M:Msg, (irr(M:Msg),K:IntruderKnowledge)) 
   = K:IntruderKnowledge .
  eq removeIrr(M:Msg, K:IntruderKnowledge) 
   = K:IntruderKnowledge [owise] .

  op _!in_ : Msg GhostList -> Bool .
  eq M:Msg !in 
          (G:GhostList,
           ghost(M:Msg,SS2:StrandSet,K2:IntruderKnowledge,ML2:SMsgList,PP2:Properties),
           G':GhostList)
   = false .
  eq M:Msg !in G:GhostList
   = true [owise] .
   
  *** reactivateGhost ************************************************  
  op reactivateGhost : Filters IdSystemSet -> IdSystemSet .
  eq reactivateGhost(F:Filters,IST:IdSystemSet)
   = if -ghost !in F:Filters 
     then reactivateGhost$(IST:IdSystemSet) else IST:IdSystemSet fi .

  op reactivateGhost$ : IdSystemSet -> IdSystemSet .
  eq reactivateGhost$(empty)
   = empty .
  eq reactivateGhost$(IS:IdSystem IST:IdSystemSet)
   = reactivateGhost$E(IS:IdSystem)    --- reactivate ghost state
     reactivateGhost$(IST:IdSystemSet) .
  
  op reactivateGhost$E : IdSystem -> IdSystemSet .
  eq reactivateGhost$E( 
       < I:Id >
       (SS:StrandSet || K:IntruderKnowledge 
          || ML:SMsgList || GL:GhostList || PP:Properties) )
   = reactivateGhost$G(SS:StrandSet,
       < I:Id >
       (SS:StrandSet || K:IntruderKnowledge 
          || ML:SMsgList || GL:GhostList || PP:Properties),
       GL:GhostList ) .

  op reactivateGhost$G : StrandSet IdSystem GhostList -> IdSystemSet .
  eq reactivateGhost$G(SSOrig:StrandSet,IS:IdSystem,nil)
   = IS:IdSystem .
  eq reactivateGhost$G(SSOrig:StrandSet,
       < I:Id >
       SS1:StrandSet || K1:IntruderKnowledge || ML1:SMsgList 
       || (G:GhostList, 
           ghost(M2:Msg,SS2:StrandSet,K2:IntruderKnowledge,ML2:SMsgList,PP2:Properties), 
           G':GhostList)
       || PP:Properties,
       (ghost(M2:Msg,SS2:StrandSet,K2:IntruderKnowledge,ML2:SMsgList,PP2:Properties),
        G':GhostList)   )
   = if not testisGhostMsg(M2:Msg) 
     then *** Reactivate the frozen ghost
          reactivateGhost$G(SSOrig:StrandSet,
            reactivateFrozenGhost(M2:Msg,SSOrig:StrandSet,
              < I:Id >
              SS1:StrandSet || K1:IntruderKnowledge || ML1:SMsgList 
              || 
              (G:GhostList, 
               ghost(M2:Msg,SS2:StrandSet,K2:IntruderKnowledge,ML2:SMsgList,PP2:Properties),
               G':GhostList) 
              || PP:Properties
            ),G':GhostList  
          )
     else *** Continue searching
          reactivateGhost$G(SSOrig:StrandSet,
            < I:Id >
            SS1:StrandSet || K1:IntruderKnowledge || ML1:SMsgList 
            || 
            (G:GhostList, 
             ghost(M2:Msg,SS2:StrandSet,K2:IntruderKnowledge,ML2:SMsgList,PP2:Properties), 
             G':GhostList)
            || PP:Properties,
            G':GhostList 
          )
     fi .

  --- Use all current strands but put them at final state
  --- and introduce reactivated frozen message
  op reactivateFrozenGhost : Msg StrandSet IdSystem -> IdSystem .
  eq reactivateFrozenGhost(M2:Msg,SSOrig:StrandSet,
       < I:Id >
       SS1:StrandSet || K1:IntruderKnowledge || ML1:SMsgList 
       || (G:GhostList, 
           ghost(M2:Msg,SS2:StrandSet,K2:IntruderKnowledge,ML2:SMsgList,PP2:Properties), 
           G':GhostList)
       || PP:Properties )
   = < I:Id .. 0 >
     fixStrandSet SS2:StrandSet 
     with FreshSet(Vars(SS2:StrandSet)) 
     using SSOrig:StrandSet
     || (M2:Msg inI,K2:IntruderKnowledge)
     || (resuscitated(M2:Msg), ML2:SMsgList) 
     || G':GhostList 
     || PP2:Properties .

  *** testisGhostMsg ********************************************
  op testisGhostMsg : Msg -> Bool [memo] .
  eq testisGhostMsg(M:Msg)
   = 'true.Bool == getTerm(
       metaReduce(PROTOCOL-EXAMPLE-GHOST,'isGhostMsg[upTerm(M:Msg)])) .

  *** fixStrandSet StrandSet with FreshSet using StrandSet
  op fixStrandSet_with_using_ : StrandSet FreshSet StrandSet -> StrandSet .

  eq fixStrandSet SS:StrandSet with nil using SS':StrandSet
   = SS:StrandSet .

  eq fixStrandSet 
       :: R:Fresh,RL:FreshSet :: [ L:SMsgList-L | L':SMsgList-R ]
       & SS:StrandSet 
     with (R:Fresh,RLL:FreshSet) 
     using SS':StrandSet
   = fixStrandSet 
       :: R:Fresh,RL:FreshSet :: [ L:SMsgList-L | L':SMsgList-R ]
       & SS:StrandSet 
     with RLL:FreshSet
     using SS':StrandSet .

  eq fixStrandSet SS:StrandSet 
     with (R:Fresh,RLL:FreshSet) 
     using 
      :: R:Fresh,RL:FreshSet :: [ L:SMsgList-L | L':SMsgList-R ]
      & SS':StrandSet
   = fixStrandSet 
      :: R:Fresh,RL:FreshSet :: 
      [toSMsgList-L(toSMsgList(L:SMsgList-L),toSMsgList(L':SMsgList-R)) | nil]
       & SS:StrandSet 
     with 
      (R:Fresh,RLL:FreshSet,
       FreshSet(Vars(
       :: R:Fresh,RL:FreshSet :: 
       [toSMsgList-L(toSMsgList(L:SMsgList-L),toSMsgList(L':SMsgList-R)) | nil]
         ***& SS:StrandSet *** I believe this is an error
       ))
      )
     using 
      :: R:Fresh,RL:FreshSet :: [ L:SMsgList-L | L':SMsgList-R ]
      & SS':StrandSet [owise] .
   
  eq fixStrandSet 
       SS:StrandSet 
     with (R:Fresh,RLL:FreshSet) 
     using SS':StrandSet
   = fixStrandSet 
       SS:StrandSet 
     with RLL:FreshSet
     using SS':StrandSet [owise] .

  op Vars : StrandSet -> TermList .
  eq Vars(SS:StrandSet) = Vars(upTerm(SS:StrandSet)) .
   
  op FreshSet : TermList -> FreshSet .
  eq FreshSet(empty) = nil .
  eq FreshSet((V,VL)) 
   = (if getType(V) == 'Fresh 
     then downTerm(V,(nil).FreshSet)
     else nil fi), FreshSet(VL) .
   
  *** tryUnificationofKnowledge *********************************************
  op tryUnificationofKnowledge : Module IdSystemSet -> IdSystemSet .
  eq tryUnificationofKnowledge(M,IST)
   = tryUnificationofKnowledge*(M,empty,IST) .

  op tryUnificationofKnowledge* : Module IdSystemSet IdSystemSet -> IdSystemSet .
  eq tryUnificationofKnowledge*(M,IST',empty)
   = IST' .
  eq tryUnificationofKnowledge*(M,IST',IS IST)
   = tryUnificationofKnowledge*(M,IST' tryUnificationofKnowledgeI(M,IS),
                                  IST) .

  op tryUnificationofKnowledgeI : Module IdSystem -> IdSystemSet .
  eq tryUnificationofKnowledgeI(M,IS)
   = setIdUnif(getId(IS),tryUnificationofKnowledgeE(M,remId(IS))) .

  op tryUnificationofKnowledgeA : Module SystemSet -> SystemSet .
  eq tryUnificationofKnowledgeA(M,ST)
   = tryUnificationofKnowledgeA*(M,empty,ST) .

  op tryUnificationofKnowledgeA* : Module SystemSet SystemSet -> SystemSet .
  eq tryUnificationofKnowledgeA*(M,ST',empty)
   = ST' .
  eq tryUnificationofKnowledgeA*(M,ST',S ST)
   = if tryUnificationofKnowledgeE(M,S) == S
     then 
     tryUnificationofKnowledgeA*(M,ST' tryUnificationofKnowledgeE(M,S), ST)
     else
     tryUnificationofKnowledgeA*(M,ST', ST tryUnificationofKnowledgeE(M,S))
     fi .

  op tryUnificationofKnowledgeE : Module System -> SystemSet .
  eq tryUnificationofKnowledgeE(M,
       SS:StrandSet || K:IntruderKnowledge 
           || ML:SMsgList || G:GhostList || PP:Properties)
   = tryUnificationofKnowledgeE**(M,
       SS:StrandSet || K:IntruderKnowledge 
           || ML:SMsgList || G:GhostList || PP:Properties,
       only-inI(K:IntruderKnowledge)) .

  op tryUnificationofKnowledgeE** : Module SystemSet IntruderKnowledge 
                                 -> SystemSet .
  eq tryUnificationofKnowledgeE**(M,ST,
           (X:Msg inI, Y:Msg inI, K:IntruderKnowledge))
   = tryUnificationofKnowledgeE***(M,
        empty,ST,
        X:Msg, Y:Msg, 
        K:IntruderKnowledge, (Y:Msg inI, K:IntruderKnowledge)) .
  eq tryUnificationofKnowledgeE**(M,ST,K:IntruderKnowledge)
   = ST 
  [owise] .

  op tryUnificationofKnowledgeE*** : Module SystemSet SystemSet
                                     Msg Msg 
                                     IntruderKnowledge IntruderKnowledge 
                                  -> SystemSet .
  eq tryUnificationofKnowledgeE***(M,
        ST',empty, 
        X:Msg, Y:Msg, empty, K$:IntruderKnowledge)
   = *** try a new pair and traverse the whole set ST'
     tryUnificationofKnowledgeE**(M,ST',K$:IntruderKnowledge) .

  eq tryUnificationofKnowledgeE***(M,
        ST',empty, 
        X:Msg, Y:Msg, (Z:Msg inI,K:IntruderKnowledge), K$:IntruderKnowledge)
   = *** Take another Y and traverse ST' with X and Y for replication
     tryUnificationofKnowledgeE***(M,
        empty,ST', 
        X:Msg, Z:Msg, K:IntruderKnowledge, K$:IntruderKnowledge) .

  eq tryUnificationofKnowledgeE***(M,
       ST',
       ST
       SS:StrandSet || K:IntruderKnowledge 
          || ML:SMsgList || G:GhostList || PP:Properties,
     X:Msg, Y:Msg,
     K*:IntruderKnowledge,
     K$:IntruderKnowledge)
   = if not (X:Msg inI in K:IntruderKnowledge)
        or-else
        not (Y:Msg inI in K:IntruderKnowledge)
        or-else
        (X:Msg != Y:Msg) in K:IntruderKnowledge
        or-else 
        fresh[metaEBuiltInUnify(M,upTerm(X:Msg),upTerm(Y:Msg))] == empty
     then 
     *** skip
     tryUnificationofKnowledgeE***(M,
        ST'
        SS:StrandSet || K:IntruderKnowledge 
          || ML:SMsgList || G:GhostList || PP:Properties,
        ST,
        X:Msg, Y:Msg,
        K*:IntruderKnowledge,
        K$:IntruderKnowledge)
     else 
     *** replicate
     tryUnificationofKnowledgeE***(M,
        ST'
        replicate(M,             
          SS:StrandSet || K:IntruderKnowledge 
             || ML:SMsgList || G:GhostList || PP:Properties,
          X:Msg,Y:Msg,
          fresh[metaEBuiltInUnify(M,upTerm(X:Msg),upTerm(Y:Msg))] 
           |> (upTerm(X:Msg),upTerm(Y:Msg)),
          empty
        ),
        ST,
        X:Msg, Y:Msg,
        K*:IntruderKnowledge,
        K$:IntruderKnowledge)
     fi .

  *** try to unify and replicate
  op replicate : Module System Msg Msg SubstitutionSet 
                 SystemSet -> SystemSet .
  eq replicate(M,
       (SS:StrandSet 
	|| (X:Msg inI, Y:Msg inI, K:IntruderKnowledge) 
	|| ML:SMsgList 
	|| G:GhostList
        || PP:Properties),
       X:Msg,Y:Msg,
       empty,
       ST)
   = *** Recursive Call
     ST
     (SS:StrandSet 
	|| (X:Msg inI, Y:Msg inI, (X:Msg != Y:Msg), K:IntruderKnowledge) 
	|| ML:SMsgList 
	|| G:GhostList
        || PP:Properties) .

  eq replicate(M,
       (SS:StrandSet 
	|| (X:Msg inI, Y:Msg inI, K:IntruderKnowledge) 
	|| ML:SMsgList 
	|| G:GhostList
        || PP:Properties),
       X:Msg,Y:Msg,
       S:Substitution | SS:SubstitutionSet,
       ST)
   = replicate(M,
       (SS:StrandSet 
	|| (X:Msg inI, Y:Msg inI, K:IntruderKnowledge) 
	|| ML:SMsgList 
	|| G:GhostList
        || PP:Properties),
       X:Msg,Y:Msg,
       SS:SubstitutionSet,
       ST
       downSystemSet(
	   upTerm(SS:StrandSet 
		  || (X:Msg inI, K:IntruderKnowledge) 
		  || ML:SMsgList 
		  || G:GhostList
                  || PP:Properties) 
	     << S:Substitution)
    ) .

  *** filters *******************************************************
  sort Filters Filter .
  subsort Filter < Filters .
  ops all -grammars -inconsistency -alreadySent 
      -secretData -equationalRed -freshInstantiated 
      -implication -partialOrder
      -ghost -before -inputAndNotLearned -never 
      none
      +inputFirst +inputAndNotLearned
     : -> Filter .
  op filterId : Id -> Filters .
  op filterSMsgList : SMsgList -> Filters .

  eq (none).Filters 
   = -grammars -inconsistency -alreadySent 
     -secretData -equationalRed -freshInstantiated 
     -implication -partialOrder
     -ghost -before -inputAndNotLearned -never .
  eq (+inputAndNotLearned).Filters = (+inputFirst).Filters .
  eq (+inputFirst).Filters 
   = -grammars -inconsistency -alreadySent 
     -secretData -equationalRed -freshInstantiated 
     -implication -partialOrder
     -ghost -before -never .

  op __ : Filters Filters -> Filters [assoc comm id: all] .
  eq X:Filter X:Filter = X:Filter .

  op _!in_ : Filters Filters -> Bool .
  eq X:Filters !in X:Filters Y:Filters = false .
  eq X:Filters !in Y:Filters = true [owise] .

  op _in_ : Filters Filters -> Bool .
  eq X:Filters in Y:Filters = not X:Filters !in Y:Filters .

  *** filters *******************************************************
  op filter-ResultTripleSet : Filters Module 
                           ResultTripleSet -> ResultTripleSet .
  eq filter-ResultTripleSet(F:Filters,M,RS)
   = filter-RT-Fresh(F:Filters,M,RS) .

  *******
  op filter-RT-Fresh : Filters Module 
                           ResultTripleSet -> ResultTripleSet .
  eq filter-RT-Fresh(F:Filters,M,RS)
   = if -freshInstantiated !in F:Filters
     then filter-RT-Fresh*(F:Filters,M,empty,RS)
     else RS 
     fi .

  op filter-RT-Fresh* : Filters Module ResultTripleSet
                        ResultTripleSet -> ResultTripleSet .
  eq filter-RT-Fresh*(F:Filters,M,RS',empty)
   = RS' .
  eq filter-RT-Fresh*(F:Filters,M,RS',{T,TP,Subst} | RS)
   = filter-RT-Fresh*(F:Filters,M,
        RS' |
        if testFreshInstantiated(Subst) then empty else {T,TP,Subst} fi,
        RS) .

  *** filters *******************************************************
  op filter-eachSystem : Filters Module GrammarList 
                         IdSystemSet -> IdSystemSet .
  eq filter-eachSystem(F:Filters,M,GS,IST)
   = filter-eachSystem*(F:Filters,M,GS,empty,IST) .

  op filter-eachSystem* : Filters Module GrammarList 
                         IdSystemSet IdSystemSet -> IdSystemSet .
  eq filter-eachSystem*(F:Filters,M,GS,IST',empty)
   = IST' .
  eq filter-eachSystem*(F:Filters,M,GS,IST',IS IST)
   = filter-eachSystem*(F:Filters,M,GS,
        IST' filter-eachSystemE(F:Filters,M,GS,IS),
        IST) .

  op filter-eachSystemE : Filters Module GrammarList IdSystem 
                        -> IdSystemSet .
  eq filter-eachSystemE(F:Filters,M,GS,IS)
   = if filter-eachSystemE*(F:Filters,M,GS,IS) 
     then empty
     else IS
     fi .

  op filter-eachSystemE* : Filters Module GrammarList IdSystem 
                        -> Bool [memo] .
  eq filter-eachSystemE*(F:Filters,M,GS,IS)
   = (-secretData !in F:Filters and-then testBadSecretData(remId(IS)))
      or-else
     (-before !in F:Filters and-then testBadBeforeRelation(remId(IS)))
      or-else
     (-alreadySent !in F:Filters and-then testAlreadySent(remId(IS)))
      or-else
     (-inconsistency !in F:Filters and-then testInconsistency(remId(IS)))
      or-else
     (-never !in F:Filters and-then testNewNeverFound(IS))
      or-else
     (-grammars !in F:Filters and-then testByGrammars(GS,remId(IS)))
      or-else
     (-equationalRed !in F:Filters 
      and-then testByEquationalReducibility(M,remId(IS))) .

*** filters *******************************************************
  op simplify-theSystemSet : Filters IdSystemSet IdSystemSet -> IdSystemSet .
  eq simplify-theSystemSet(F:Filters,HistoryIST,IST)
   = simplifyByImplication(F:Filters,HistoryIST,IST) .


  *** simplify-eachSystem *****************************************************
  op simplify-eachSystem : Module IdSystemSet -> IdSystemSet .
  eq simplify-eachSystem(M,IST)
   = simplify-eachSystem*(M,empty,IST) .

  op simplify-eachSystem* : Module IdSystemSet IdSystemSet -> IdSystemSet .
  eq simplify-eachSystem*(M,IST',empty) 
   = IST' .
  eq simplify-eachSystem*(M,IST',IS IST)
   = simplify-eachSystem*(M,(IST' simplify-eachSystemE(M,IS)),IST) .

  op simplify-eachSystemE : Module IdSystem -> IdSystem . ---[memo] .
  eq simplify-eachSystemE(M,IS)
   = simplifyInIConstraints(
      simplifyDiffConstraints(
       simplifyIrrConstraints(
         simplifyInstConstraints(
           simplifyEquationalReducibility(M,
             IS
           )
         )
        )
      )
     ) .

  *** filters *******************************************************
  op simplifyGhost : Filters IdSystemSet -> IdSystemSet .
  eq simplifyGhost(F:Filters,IST) 
   = if -ghost !in F:Filters then simplifyGhost(IST) else IST fi .

  op simplifyGhost : IdSystemSet -> IdSystemSet .
  eq simplifyGhost(IST) 
   = simplifyGhost*(empty,IST) .

  op simplifyGhost* : IdSystemSet IdSystemSet -> IdSystemSet .
  eq simplifyGhost*(IST',empty) 
   = IST' .
  eq simplifyGhost*(IST',IS IST) 
   = simplifyGhost*((IST' simplifyGhostE(IS)), IST) .
  
  op simplifyGhostE : IdSystem -> IdSystem . ---[memo] .
  eq simplifyGhostE(
       < I:Id >
       SS:StrandSet 
       || K:IntruderKnowledge || ML:SMsgList || 
       (G1':GhostList,
        ghost(M:Msg,SS1':StrandSet,K1':IntruderKnowledge,ML1':SMsgList,PP1:Properties),
        G2':GhostList, 
        ghost(M:Msg,SS2':StrandSet,K2':IntruderKnowledge,ML2':SMsgList,PP2:Properties), 
        G3':GhostList) 
       || PP:Properties
     )
   = simplifyGhostE(
       < I:Id >
       SS:StrandSet 
       || K:IntruderKnowledge || ML:SMsgList || 
       (G1':GhostList,
        ghost(M:Msg,SS1':StrandSet,K1':IntruderKnowledge,ML1':SMsgList,PP1:Properties),
        G2':GhostList, 
        G3':GhostList) 
       || PP:Properties
     ) .
  eq simplifyGhostE(
      < I:Id >
      (SS:StrandSet || K:IntruderKnowledge 
          || ML:SMsgList || G:GhostList || PP:Properties))
   = simplifyGhostE*(
      < I:Id >
      (SS:StrandSet || K:IntruderKnowledge 
          || ML:SMsgList || G:GhostList || PP:Properties),
       G:GhostList ) [owise] .
  
  op simplifyGhostE* : IdSystem GhostList -> IdSystem .
  eq simplifyGhostE*(IS,nil)
   = IS .
  eq simplifyGhostE*(
       < I:Id >
       (SS:StrandSet || K:IntruderKnowledge 
           || ML:SMsgList || G:GhostList || PP:Properties),
       (ghost(M:Msg,SS':StrandSet,K':IntruderKnowledge,ML':SMsgList,PP':Properties), 
        G':GhostList) 
      )
   = simplifyGhostE*(
       < I:Id >
       (SS:StrandSet 
       || if isAnyVarInstantiable(Vars(upTerm(M:Msg)),K:IntruderKnowledge)
             or-else
             isAnyVarInstantiable(Vars(upTerm(M:Msg)),SS:StrandSet)
          then K:IntruderKnowledge 
          else (M:Msg !inI,K:IntruderKnowledge)
          fi
       || if isAnyVarInstantiable(Vars(upTerm(M:Msg)),K:IntruderKnowledge)
             or-else
             isAnyVarInstantiable(Vars(upTerm(M:Msg)),SS:StrandSet)
          then ML:SMsgList 
          else (generatedByIntruder(M:Msg),ML:SMsgList)
          fi
       || if isAnyVarInstantiable(Vars(upTerm(M:Msg)),K:IntruderKnowledge)
             or-else
             isAnyVarInstantiable(Vars(upTerm(M:Msg)),SS:StrandSet)
          then G:GhostList 
          else simplifyGhostM(M:Msg,G:GhostList) 
          fi
       || PP:Properties
       ),
       G':GhostList) .
   
  op simplifyGhostM : Msg GhostList -> GhostList .
  eq simplifyGhostM(M:Msg,
       (G:GhostList,
        ghost(M:Msg,SS:StrandSet,K:IntruderKnowledge,ML:SMsgList,PP:Properties),
        G':GhostList)  ) 
   = (G:GhostList,G':GhostList) .

  *** isAnyVarInstantiable for simplifyGhost **************************
  op isAnyVarInstantiable : TermList IntruderKnowledge -> Bool .
  eq isAnyVarInstantiable(empty,K:IntruderKnowledge)
   = false .
  eq isAnyVarInstantiable((T:Term,TL:TermList),K:IntruderKnowledge)
   = isAnyVarInstantiable*(T:Term,K:IntruderKnowledge) 
     or-else 
     isAnyVarInstantiable(TL:TermList,K:IntruderKnowledge) .

  op isAnyVarInstantiable* : Term IntruderKnowledge -> Bool .
  eq isAnyVarInstantiable*(T:Term,(empty).IntruderKnowledge-empty)
   = false .
  eq isAnyVarInstantiable*(T:Term,(M':Msg inI,K:IntruderKnowledge))
   = is T:Term subTermOf upTerm(M':Msg)
     or-else
     isAnyVarInstantiable*(T:Term,K:IntruderKnowledge) .
  eq isAnyVarInstantiable*(T:Term,
                            (X:IntruderKnowledgeElem,K:IntruderKnowledge))
   = isAnyVarInstantiable*(T:Term,K:IntruderKnowledge) [owise] .
  
  --- isAnyVarInstantiable for simplifyGhost ----   
  op isAnyVarInstantiable : TermList StrandSet -> Bool .
  eq isAnyVarInstantiable(empty,ST:StrandSet)
   = false .
  eq isAnyVarInstantiable((T:Term,TL:TermList),ST:StrandSet)
   = isAnyVarInstantiable*(T:Term,ST:StrandSet) 
     or-else 
     isAnyVarInstantiable(TL:TermList,ST:StrandSet) .

  op isAnyVarInstantiable* : Term StrandSet -> Bool .
  eq isAnyVarInstantiable*(T:Term,(empty).StrandSet)
   = false .
  eq isAnyVarInstantiable*(T:Term,S:Strand & ST:StrandSet)
   = isAnyVarInstantiable*S(T:Term,S:Strand) 
     or-else
     isAnyVarInstantiable*(T:Term,ST:StrandSet) .
  
  op isAnyVarInstantiable*S : Term Strand -> Bool .
  eq isAnyVarInstantiable*S(T:Term,
       :: RL:FreshSet :: [ L:SMsgList-L | L':SMsgList-R])
   = isAnyVarInstantiable*ML(T:Term,toSMsgList(L:SMsgList-L)) .
	  
  op isAnyVarInstantiable*ML : Term SMsgList -> Bool .
  eq isAnyVarInstantiable*ML(T:Term,nil)
   = false .
  eq isAnyVarInstantiable*ML(T:Term,(+(M':Msg),L:SMsgList))
   = isAnyVarInstantiable*ML(T:Term,L:SMsgList) .
  eq isAnyVarInstantiable*ML(T:Term,(-(M':Msg),L:SMsgList))
   = is T:Term subTermOf upTerm(M':Msg)
     or-else 
     isAnyVarInstantiable*ML(T:Term,L:SMsgList) .
	  
  *** filters *******************************************************
  op simplifyEquationalReducibility : Module IdSystem -> IdSystem . ---[memo] .
  eq simplifyEquationalReducibility(M,IS)
    = setId(getId(IS),
      downSystemSet(
        getTerm(
           metaReduce(
	     putStrat(0,'-`(_`),'Msg,
	     putStrat(0,'_inI,'Msg,
	     putStrat(0,'irr`(_`),'Msg,
               clearNonExecEqs(eraseRls(onlyEqsNoBuiltInUnify(M)))
             ))),
             upTerm(remId(IS))
           )
        )
      )) .

  *** filters *******************************************************
  op simplifyInIConstraints : IdSystem -> IdSystem . ---[memo] .
  eq simplifyInIConstraints(
        < I:Id >
        (SS:StrandSet
         || (X:Msg inI,X:Msg inI,K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) )
   = simplifyInIConstraints(
        < I:Id >
        (SS:StrandSet
         || (X:Msg inI,K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) ) .

  eq simplifyInIConstraints(IS) 
   = IS [owise] .

  *** filters *******************************************************
  op simplifyInstConstraints : IdSystem -> IdSystem . ---[memo] .
  eq simplifyInstConstraints(
        < I:Id >
        (SS:StrandSet
         || K:IntruderKnowledge
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) )
   = simplifyInstConstraintsDup(
        < I:Id >
        (SS:StrandSet
         || simplifyInstConstraints*(K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) ) .

  op simplifyInstConstraints* : IntruderKnowledge -> IntruderKnowledge .
  eq simplifyInstConstraints*((inst(X:Msg),K:IntruderKnowledge))
   = simplifyInstConstraints**(upTerm(X:Msg)),
     simplifyInstConstraints*(K:IntruderKnowledge) .
  eq simplifyInstConstraints*(K:IntruderKnowledge)
   = K:IntruderKnowledge [owise] .

  op simplifyInstConstraints** : Term -> IntruderKnowledge-inst .
  eq simplifyInstConstraints**(C:Constant) = empty .
  eq simplifyInstConstraints**(V:Variable) 
   = if ---downMsgSet(V:Variable) :: Msg
        typeLeq(upModule('PROTOCOL-SPECIFICATION,true),
          getType(V:Variable),
          'Msg)
     then inst(downMsgSet(V:Variable)) 
     else empty 
     fi .
  eq simplifyInstConstraints**(F:Qid[TL:TermList])
   = simplifyInstConstraints***(TL:TermList) .

  op simplifyInstConstraints*** : TermList -> IntruderKnowledge-inst .
  eq simplifyInstConstraints***(empty)
   = empty .
  eq simplifyInstConstraints***((T:Term,TL:TermList))
   = simplifyInstConstraints**(T:Term),
     simplifyInstConstraints***(TL:TermList) .

  op simplifyInstConstraintsDup : IdSystem -> IdSystem .
  eq simplifyInstConstraintsDup(
        < I:Id >
        (SS:StrandSet
         || (inst(X:Msg),inst(X:Msg),K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) )
   = simplifyInstConstraintsDup(
        < I:Id >
        (SS:StrandSet
         || (inst(X:Msg),K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) ) .

  eq simplifyInstConstraintsDup(IS) 
   = simplifyInstConstraintsNonUsed(IS) [owise] .

  op simplifyInstConstraintsNonUsed : IdSystem -> IdSystem .
 ceq simplifyInstConstraintsNonUsed(
        < I:Id >
        (SS:StrandSet
         || (inst(X:Msg),K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) )
   = simplifyInstConstraintsNonUsed(
        < I:Id >
        (SS:StrandSet
         || K:IntruderKnowledge
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) )
  if not (allVars upTerm(X:Msg) inVars upTerm(K:IntruderKnowledge)) .

  eq simplifyInstConstraintsNonUsed(IS) 
   = IS [owise] .

  *** filters *******************************************************
  op simplifyIrrConstraints : IdSystem -> IdSystem . ---[memo] .
  eq simplifyIrrConstraints(
        < I:Id >
        (SS:StrandSet
         || (X:Msg !inI,irr(X:Msg),K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) )
   = simplifyIrrConstraints(
        < I:Id >
        (SS:StrandSet
         || (X:Msg !inI,K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) ) .

  eq simplifyIrrConstraints(
        < I:Id >
        (SS:StrandSet
         || (irr(X:Msg),irr(X:Msg),K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) )
   = simplifyIrrConstraints(
        < I:Id >
        (SS:StrandSet
         || (irr(X:Msg),K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) ) .

  eq simplifyIrrConstraints(
        < I:Id >
        (SS:StrandSet
         || (inst(X:Msg),irr(X:Msg),K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) )
   = simplifyIrrConstraints(
        < I:Id >
        (SS:StrandSet
         || (inst(X:Msg),K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) ) .

  eq simplifyIrrConstraints(IS) 
   = IS [owise] .

  *** filters *******************************************************
  op simplifyDiffConstraints : IdSystem -> IdSystem . ---[memo] .

  eq simplifyDiffConstraints(
        < I:Id >
        (SS:StrandSet
         || K:IntruderKnowledge
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) )
   =    < I:Id >
        (SS:StrandSet
         || removeDuplicatedDiffConstraints(
               simplifyDiffConstraints*(getBoundFresh(SS:StrandSet),
                                        empty,K:IntruderKnowledge))
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties) .

  op removeDuplicatedDiffConstraints : IntruderKnowledge -> IntruderKnowledge .

  eq removeDuplicatedDiffConstraints(
         (X:Knowledge-!=,X:Knowledge-!=,K:IntruderKnowledge) )
   = removeDuplicatedDiffConstraints(
         (X:Knowledge-!=,K:IntruderKnowledge) ) .
  eq removeDuplicatedDiffConstraints(K:IntruderKnowledge)
   = K:IntruderKnowledge [owise] .

  op getBoundFresh : StrandSet -> FreshSet .
  eq getBoundFresh(SS:StrandSet)
   = getBoundFresh*(nil,SS:StrandSet) .

  op getBoundFresh* : FreshSet StrandSet -> FreshSet .
  eq getBoundFresh*(F:FreshSet,empty)
   = F:FreshSet .
  eq getBoundFresh*(F:FreshSet,
        :: RL:FreshSet :: [ L:SMsgList-L | L':SMsgList-R ]
        & SS:StrandSet)
   = getBoundFresh*((F:FreshSet,RL:FreshSet),SS:StrandSet) .

  op simplifyDiffConstraints* : FreshSet IntruderKnowledge IntruderKnowledge
                             -> IntruderKnowledge .
  eq simplifyDiffConstraints*(F:FreshSet,K*:IntruderKnowledge,empty)
   = K*:IntruderKnowledge .
  eq simplifyDiffConstraints*(F:FreshSet,K*:IntruderKnowledge,
        (K:Knowledge,K:IntruderKnowledge))
   = simplifyDiffConstraints*(F:FreshSet,
        (simplifyDiffConstraints**(F:FreshSet,K:Knowledge),
           K*:IntruderKnowledge),
        K:IntruderKnowledge
     ) .

  op simplifyDiffConstraints** : FreshSet Knowledge -> IntruderKnowledge .
                            *** returns empty if a constraint is solved
  eq simplifyDiffConstraints**(F:FreshSet,X:Msg != Y:Msg)
   = if fresh[F:FreshSet,
         metaBuiltInUnify(
           STRAND-EXAMPLE-RULES-WITH-ALL,
	   upTerm(X:Msg),
	   upTerm(Y:Msg)) 
         |> (upTerm(X:Msg),upTerm(Y:Msg)) 
        ] == empty 
     then empty *** they don't unify
     else if simplifyMsgDecompose(upTerm(X:Msg),upTerm(Y:Msg)) =/= empty
          then simplifyMsgDecompose(upTerm(X:Msg),upTerm(Y:Msg))
          else (X:Msg != Y:Msg)
          fi 
     fi .

  eq simplifyDiffConstraints**(F:FreshSet,
         K1:IntruderKnowledge-!= or K2:IntruderKnowledge-!=)
   = if simplifyDiffConstraints*(F:FreshSet,empty,K1:IntruderKnowledge-!=) 
        == empty 
     then empty
     else if simplifyDiffConstraints*(F:FreshSet,empty,K2:IntruderKnowledge-!=) 
              == empty 
          then empty
          else if equal(K1:IntruderKnowledge-!=)
               then simplifyDiffConstraints*(F:FreshSet,
                              empty,K2:IntruderKnowledge-!=)
               else if equal(K2:IntruderKnowledge-!=)
                    then simplifyDiffConstraints*(F:FreshSet,
                                 empty,K1:IntruderKnowledge-!=)
                    else simplifyDiffConstraints*(F:FreshSet,
                                 empty,K1:IntruderKnowledge-!=)
                         or 
                         simplifyDiffConstraints*(F:FreshSet,
                                 empty,K2:IntruderKnowledge-!=)
                    fi
               fi
          fi
     fi .

  eq simplifyDiffConstraints**(F:FreshSet,
         K1:IntruderKnowledge-!= and K2:IntruderKnowledge-!=)
   = simplifyDiffConstraints*(F:FreshSet,empty,K1:IntruderKnowledge-!=) 
     [and]
     simplifyDiffConstraints*(F:FreshSet,empty,K2:IntruderKnowledge-!=) .

  eq simplifyDiffConstraints**(F:FreshSet,K:Knowledge)
   = K:Knowledge [owise] .

  op equal : IntruderKnowledge-!= -> Bool .
  eq equal((X:Msg != X:Msg)) = true .
  eq equal(K:IntruderKnowledge-!=) = false [owise] .

  **********
  op simplifyMsgDecompose : Term Term -> IntruderKnowledge-!= [memo] .
                            *** returns empty if it cannot be decomposed

  ceq simplifyMsgDecompose(V:Variable,T:Term)
    = (downMsgSet(V:Variable) != downMsgSet(T:Term)) 
   if typeLeq(
        STRAND-EXAMPLE-RULES-WITH-ALL,
        getType(V:Variable),'Msg) .

  ceq simplifyMsgDecompose(T:Term,V:Variable)
    = (downMsgSet(T:Term) != downMsgSet(V:Variable)) 
   if typeLeq(
        STRAND-EXAMPLE-RULES-WITH-ALL,
        getType(V:Variable),'Msg) .

  ceq simplifyMsgDecompose(F:Qid[NeTL:NeTermList],F:Qid[NeTL':NeTermList])
    = simplifyMsgDecomposeL(NeTL:NeTermList,NeTL':NeTermList) 
   if not isAssociative(STRAND-EXAMPLE-RULES-WITH-ALL,
                        F:Qid,getTypes(STRAND-EXAMPLE-RULES-WITH-ALL,
                                       NeTL:NeTermList)) 
      and
      not isCommutative(STRAND-EXAMPLE-RULES-WITH-ALL,
                        F:Qid,getTypes(STRAND-EXAMPLE-RULES-WITH-ALL,
                                       NeTL:NeTermList)) 
      and
      not isAssociative(STRAND-EXAMPLE-RULES-WITH-ALL,
                        F:Qid,getTypes(STRAND-EXAMPLE-RULES-WITH-ALL,
                                       NeTL':NeTermList)) 
      and
      not isCommutative(STRAND-EXAMPLE-RULES-WITH-ALL,
                        F:Qid,getTypes(STRAND-EXAMPLE-RULES-WITH-ALL,
                                       NeTL':NeTermList)) .

  ceq simplifyMsgDecompose(F:Qid[T1:Term,T2:Term],F:Qid[T1':Term,T2':Term])
    = simplifyMsgDecomposeL((T1:Term,T2:Term),(T1':Term,T2':Term))
      and
      simplifyMsgDecomposeL((T1:Term,T2:Term),(T2':Term,T1':Term)) 
   if not isAssociative(STRAND-EXAMPLE-RULES-WITH-ALL,
                        F:Qid,getTypes(STRAND-EXAMPLE-RULES-WITH-ALL,
                                       (T1:Term,T2:Term))) 
      and
      isCommutative(STRAND-EXAMPLE-RULES-WITH-ALL,
                        F:Qid,getTypes(STRAND-EXAMPLE-RULES-WITH-ALL,
                                       (T1:Term,T2:Term))) 
      and
      not isAssociative(STRAND-EXAMPLE-RULES-WITH-ALL,
                        F:Qid,getTypes(STRAND-EXAMPLE-RULES-WITH-ALL,
                                       (T1':Term,T2':Term))) 
      and
      isCommutative(STRAND-EXAMPLE-RULES-WITH-ALL,
                        F:Qid,getTypes(STRAND-EXAMPLE-RULES-WITH-ALL,
                                       (T1':Term,T2':Term))) .
  ceq simplifyMsgDecompose(F:Qid[NeTL:NeTermList],F:Qid[NeTL':NeTermList])
    = simplifyMsgDecomposeAC(NeTL:NeTermList,empty,NeTL':NeTermList) 
   if isAssociative(STRAND-EXAMPLE-RULES-WITH-ALL,
                        F:Qid,getTypes(STRAND-EXAMPLE-RULES-WITH-ALL,
                                       NeTL:NeTermList)) 
      and
      isCommutative(STRAND-EXAMPLE-RULES-WITH-ALL,
                        F:Qid,getTypes(STRAND-EXAMPLE-RULES-WITH-ALL,
                                       NeTL:NeTermList)) 
      and
      isAssociative(STRAND-EXAMPLE-RULES-WITH-ALL,
                        F:Qid,getTypes(STRAND-EXAMPLE-RULES-WITH-ALL,
                                       NeTL':NeTermList)) 
      and
      isCommutative(STRAND-EXAMPLE-RULES-WITH-ALL,
                        F:Qid,getTypes(STRAND-EXAMPLE-RULES-WITH-ALL,
                                       NeTL':NeTermList)) .

  eq simplifyMsgDecompose(T:Term,T':Term)
   = empty [owise] .

  op simplifyMsgDecomposeL : TermList TermList -> IntruderKnowledge-!= .

  eq simplifyMsgDecomposeL((T:Term,TL:TermList),(T':Term,TL':TermList))
   = if simplifyMsgDecompose(T:Term,T':Term) =/= empty
        and
        simplifyMsgDecomposeL(TL:TermList,TL':TermList) =/= empty
     then simplifyMsgDecompose(T:Term,T':Term)
          [or]
          simplifyMsgDecomposeL(TL:TermList,TL':TermList)
     else empty
     fi  .
  eq simplifyMsgDecomposeL(TL:TermList,TL':TermList)
   = empty [owise] .

  op simplifyMsgDecomposeAC : TermList TermList TermList 
                  -> IntruderKnowledge-!= .
  eq simplifyMsgDecomposeAC(
       (T:Term,NeTL:TermList),
       (Tx:Term,NeTLx:TermList), (T':Term,NeTL':TermList)
     )
   = simplifyMsgDecomposeAC$(T:Term,T':Term,NeTL:TermList,
                   (Tx:Term,NeTLx:TermList),NeTL':TermList)
     [and]
     simplifyMsgDecomposeAC$(T:Term,Tx:Term,NeTL:TermList,
                   NeTLx:TermList,(T':Term,NeTL':TermList))
     [and] 
     simplifyMsgDecomposeAC((T:Term,NeTL:TermList),
       (T':Term,Tx:Term,NeTLx:TermList), NeTL':TermList) .

  eq simplifyMsgDecomposeAC(
       (T:Term,NeTL:TermList),
       empty, (T':Term,NeTL':TermList)
     )
   = simplifyMsgDecomposeAC$(T:Term,T':Term,NeTL:TermList,
                   empty,NeTL':TermList)
     [and]
     simplifyMsgDecomposeAC((T:Term,NeTL:TermList),
       (T':Term,empty), NeTL':TermList) .

  eq simplifyMsgDecomposeAC(
       (T:Term,NeTL:TermList),
       (Tx:Term,NeTLx:TermList), empty
     )
   = simplifyMsgDecomposeAC$(T:Term,Tx:Term,NeTL:TermList,
                   NeTLx:TermList,empty) .

  eq simplifyMsgDecomposeAC(empty,NeTLx:TermList,NeTL':TermList)
   = empty .

  eq simplifyMsgDecomposeAC(NeTL:TermList,empty,empty)
   = empty .

  op simplifyMsgDecomposeAC$ : Term Term TermList TermList TermList
                  -> IntruderKnowledge-!= .
  eq simplifyMsgDecomposeAC$(T:Term,T':Term,
                    NeTL:TermList,NeTLx:TermList,NeTL':TermList)
   = if simplifyMsgDecompose(T:Term,T':Term) =/= empty
        and 
        (simplifyMsgDecomposeAC(NeTL:TermList,NeTLx:TermList,NeTL':TermList) 
             =/= empty
         or NeTL:TermList == empty 
         or (NeTLx:TermList == empty and NeTL':TermList == empty) )
     then simplifyMsgDecompose(T:Term,T':Term)
          [or]
          simplifyMsgDecomposeAC(NeTL:TermList,NeTLx:TermList,NeTL':TermList)
     else empty
     fi .

  op _[or]_ : IntruderKnowledge-!= IntruderKnowledge-!= 
           -> IntruderKnowledge-!= 
              [assoc comm] .
  eq empty [or] K:IntruderKnowledge-!= 
   = K:IntruderKnowledge-!= .
  eq K1:IntruderKnowledge-!= [or] K2:IntruderKnowledge-!= 
   = K1:IntruderKnowledge-!= or K2:IntruderKnowledge-!= [owise] .

  op _[and]_ : IntruderKnowledge-!= IntruderKnowledge-!= 
            -> IntruderKnowledge-!= 
               [assoc comm] .
  eq empty [and] K:IntruderKnowledge-!= 
   = K:IntruderKnowledge-!= .
  eq K1:IntruderKnowledge-!= [and] K2:IntruderKnowledge-!= 
   = K1:IntruderKnowledge-!= and K2:IntruderKnowledge-!= [owise] .

  *** filters *******************************************************
  op simplifyByImplication : Filters IdSystemSet IdSystemSet -> IdSystemSet .
  eq simplifyByImplication(F:Filters,HistoryIST,IST)
   = if -implication !in F:Filters 
     then simplifyByImplication*(HistoryIST,IST) 
     else IST 
     fi .

  op simplifyByImplication* : IdSystemSet IdSystemSet -> IdSystemSet .
  eq simplifyByImplication*(HistoryIST,IST)
   = simplifyByImplicationH(HistoryIST,simplifyByImplicationL(IST)) .

  op simplifyByImplicationL : IdSystemSet -> IdSystemSet .
  eq simplifyByImplicationL(empty)
   = empty .
  eq simplifyByImplicationL(IS IST)
   = simplifyByImplicationL*(empty,IS,IST,IST) .

  op simplifyByImplicationL* : IdSystemSet IdSystem IdSystemSet IdSystemSet
                             -> IdSystemSet .
  eq simplifyByImplicationL*(IST', IS, empty, empty)
   = IST' IS .
  eq simplifyByImplicationL*(IST', IS, empty, IS' IST'')
   = simplifyByImplicationL*(IST' IS, IS', IST'', IST'') .
  eq simplifyByImplicationL*(IST', IS, IS' IST, IS' IST'')
   = if IS implies IS'
     then --- IS' is discarded & continue with IST
          simplifyByImplicationL*(IST', IS, IST, IST'')
     else if IS' implies IS
          then --- IS' implies IS, so restart using IS' as goal
               simplifyByImplicationL*(IST', IS', IST'', IST'')
          else --- IS' is not discarded & continue with IST
               simplifyByImplicationL*(IST', IS, IST, IS' IST'')
          fi 
     fi .

  op simplifyByImplicationH : IdSystemSet IdSystemSet -> IdSystemSet .
  eq simplifyByImplicationH(HistoryIST,IST)
   = simplifyByImplicationH*(HistoryIST,empty,IST) .

  op simplifyByImplicationH* : IdSystemSet IdSystemSet IdSystemSet 
                            -> IdSystemSet .
  eq simplifyByImplicationH*(HistoryIST,IST',empty)
   = IST' .
  eq simplifyByImplicationH*(HistoryIST,IST',IS IST)
   = if any HistoryIST implies IS
     then simplifyByImplicationH*(HistoryIST,IST',IST)
     else simplifyByImplicationH*(HistoryIST,IST' IS,IST)
     fi .

  op any_implies_ : IdSystemSet IdSystem -> Bool .
  eq any empty implies IS'
   = false .
  eq any (IS HistoryIST) implies IS'
   = IS implies IS'
     or-else
     any HistoryIST implies IS' .

  *** implies for System States ****************************************
  op _implies_ : IdSystem IdSystem -> Bool .
  eq < I1:Id > ST:System implies < I2:Id > ST:System 
   = true .
  eq < I1:Id > ST1:System implies < I2:Id > ST2:System 
   = < I1:Id > ST1:System implies* < I2:Id > (ST2:System <<(ST1:System)<) 
     [owise] .

  op _implies*_ : IdSystem IdSystem -> Bool . ---[memo] .
  eq IST1:IdSystem implies* IST2:IdSystem
   = IST1:IdSystem implies** IST2:IdSystem .

  op _implies**_ : IdSystem IdSystem -> Bool . ---[memo] .
  eq < I1:Id >
     (SS1:StrandSet || K1:IntruderKnowledge 
        || ML1:SMsgList || G1:GhostList || PP1:Properties) 
     implies** 
     < I2:Id >
     (SS2:StrandSet || K2:IntruderKnowledge 
        || ML2:SMsgList || G2:GhostList || PP2:Properties)
   = < I1:Id >
     (SS1:StrandSet || K1:IntruderKnowledge 
        || ML1:SMsgList || G1:GhostList || PP1:Properties) 
     implies** 
     < I2:Id >
     (SS2:StrandSet || K2:IntruderKnowledge 
        || ML2:SMsgList || G2:GhostList || PP2:Properties)
     with 
     if noInitial(SS1:StrandSet) == empty and only-inI(K1:IntruderKnowledge) == empty
     then 
          metaBuiltInMatch(
           clearAllFrozen(removeBoolEqs(
                upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true))),
	   '_||_||_||_||_[
             upTerm(noBar(toStrandSet$(noIntruder(SS2:StrandSet)))),
	     '_`,_[
	       upTerm(only-inI(K2:IntruderKnowledge)),
	       upTerm(only-!inI(K2:IntruderKnowledge)),
	       upTerm(only-!=(K2:IntruderKnowledge)),
	       upTerm(only-irr(K2:IntruderKnowledge))
	     ],
	     'nil.SMsgList,
	     'nil.GhostList,
             'nil.Properties 
	   ],
	   '_||_||_||_||_[
	     '_&_[
               upTerm(noBar(toStrandSet$(noIntruder(SS1:StrandSet)))),
	       'XX:StrandSet
	     ],
	     '_`,_[
	       upTerm(only-inI(K1:IntruderKnowledge)),
	       upTerm(only-!inI(K1:IntruderKnowledge)),
	       upTerm(only-!=(K1:IntruderKnowledge)),
	       upTerm(only-irr(K1:IntruderKnowledge)),
               'XX:IntruderKnowledge
	     ],
	     'nil.SMsgList,
	     'nil.GhostList,
             'nil.Properties 
	   ]
           ) 
     else
        metaBuiltInMatch(
           clearAllFrozen(removeBoolEqs(
                upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true))),
	   '_||_||_||_||_[
             upTerm(noBar(toStrandSet$(noInitial(SS2:StrandSet)))),
             upTerm(only-inI(K2:IntruderKnowledge)),
	     'nil.SMsgList,
	     'nil.GhostList,
             'nil.Properties 
	   ],
	   '_||_||_||_||_[
	     '_&_[
               upTerm(noBar(toStrandSet$(noInitial(SS1:StrandSet)))),
	       'XX:StrandSet
	     ],
	     '_`,_[
	       upTerm(only-inI(K1:IntruderKnowledge)),
               'XX:IntruderKnowledge-inI
	     ],
	     'nil.SMsgList,
	     'nil.GhostList,
             'nil.Properties 
	   ]
	 ) 
     fi . 

  op _implies**_with_ : IdSystem IdSystem SubstitutionSet -> Bool .
  eq < I1:Id >
     (SS1:StrandSet || K1:IntruderKnowledge 
       || ML1:SMsgList || G1:GhostList || PP1:Properties) 
     implies** 
     < I2:Id >
     (SS2:StrandSet || K2:IntruderKnowledge 
       || ML2:SMsgList || G2:GhostList || PP2:Properties) 
     with SS:SubstitutionSet 
   = < I1:Id >
     (SS1:StrandSet || K1:IntruderKnowledge 
        || ML1:SMsgList || G1:GhostList || PP1:Properties) 
     implies* forAny SS:SubstitutionSet 
     < I2:Id >
     (SS2:StrandSet || K2:IntruderKnowledge 
        || ML2:SMsgList || G2:GhostList || PP2:Properties) .

  op _implies* forAny__ : IdSystem SubstitutionSet IdSystem -> Bool .
  eq < I1:Id > ST1:System implies* forAny empty < I2:Id > ST2:System
   = false .
  eq < I1:Id > ST1:System 
     implies* forAny (S:Substitution | SS:SubstitutionSet) 
     < I2:Id > ST2:System
   = < I1:Id > ST1:System 
     implies** S:Substitution 
     < I2:Id > ST2:System
     or-else
     < I1:Id > ST1:System 
     implies* forAny SS:SubstitutionSet 
     < I2:Id > ST2:System .

  op _implies**__ : IdSystem Substitution IdSystem -> Bool .
  eq < I1:Id >
     (SS1:StrandSet || K1:IntruderKnowledge 
        || ML1:SMsgList || G1:GhostList || PP1:Properties) 
     implies** S:Substitution 
     < I2:Id >
     (SS2:StrandSet || K2:IntruderKnowledge 
        || ML2:SMsgList || G2:GhostList || PP2:Properties) 
   = if noInitial(SS1:StrandSet) == empty and only-inI(K1:IntruderKnowledge) == empty
     then
       toStrandSet$(noIntruder(SS1:StrandSet) << S:Substitution) 
           implies$ toStrandSet$(noIntruder(SS2:StrandSet))
     else
       toStrandSet$(noInitial(SS1:StrandSet) << S:Substitution) 
           implies$ toStrandSet$(noInitial(SS2:StrandSet))
     fi
     and-then
     I1:Id
     (G1:GhostList << S:Substitution) & (ML1:SMsgList << S:Substitution) 
         noParentGhost I2:Id ML2:SMsgList 
     and-then
     not testInconsistentKnowledge(K1:IntruderKnowledge << S:Substitution) .

  *** noParentGhost ***************
 
  op __&_noParentGhost__ : Id GhostList SMsgList Id SMsgList -> Bool .
 ceq I1:Id
     (G1:GhostList,
      ghost(M:Msg,SS:StrandSet,K:IntruderKnowledge,ML:SMsgList,PP:Properties),
      G2:GhostList) &
     (M1:SMsgList,M2:SMsgList,-(M:Msg),M3:SMsgList)
     noParentGhost
     I2:Id
     (M1:SMsgList,resuscitated(M:Msg),M2:SMsgList,-(M:Msg),M3:SMsgList)
   = false 
  if I1:Id <<< I2:Id .
  eq I1:Id G1:GhostList & ML1:SMsgList noParentGhost I2:Id ML2:SMsgList
   = I1:Id G1:GhostList & ML1:SMsgList noParentGhost# I2:Id ML2:SMsgList
  [owise] .

  op __&_noParentGhost#__ : Id GhostList SMsgList Id SMsgList -> Bool .
 ceq I1:Id
     (G1:GhostList,
      ghost(M:Msg,SS:StrandSet,K:IntruderKnowledge,ML:SMsgList,PP:Properties),
      G2:GhostList) &
     (M1:SMsgList,M2:SMsgList,
      M3:SMsgList,-(M:Msg),M4:SMsgList)
     noParentGhost#
     I2:Id
     (M1*:SMsgList,M1**:SMsgList,+(M:Msg),M2:SMsgList,resuscitated(M:Msg),
      M3:SMsgList,-(M:Msg),M4:SMsgList)
   = false
  if I1:Id <<< I2:Id 
  /\ eachSMsgIn M1**:SMsgList hasSubterm M:Msg
  /\ ((G1:GhostList == nil and G2:GhostList == nil 
                           and M1:SMsgList == M1*:SMsgList)
     or-else 
     (M1:SMsgList == M1*:SMsgList and not resuscitated?(M1*:SMsgList))
     or-else 
     not
     I1:Id
     (G1:GhostList,
      G2:GhostList) &
     (M1:SMsgList,M2:SMsgList,
      M3:SMsgList,-(M:Msg),M4:SMsgList)
     noParentGhost
     I2:Id
     (M1*:SMsgList,M2:SMsgList,
      M3:SMsgList,-(M:Msg),M4:SMsgList)    ) .
  eq I1:Id G1:GhostList & ML1:SMsgList noParentGhost# I2:Id ML2:SMsgList
   = I1:Id G1:GhostList & ML1:SMsgList noParentGhost## I2:Id ML2:SMsgList
  [owise] .

  op __&_noParentGhost##__ : Id GhostList SMsgList Id SMsgList -> Bool .
 ceq I1:Id
     (G1:GhostList,
      ghost(M:Msg,SS:StrandSet,K:IntruderKnowledge,ML:SMsgList,PP:Properties),
      G2:GhostList) &
     (M1:SMsgList,M2:SMsgList,-(M:Msg),M3:SMsgList)
     noParentGhost##
     I2:Id
     (M1#:SMsgList,resuscitated(M#:Msg),M2#:SMsgList,-(M#:Msg),M3#:SMsgList)
   = false 
  if I1:Id <<< I2:Id 
  /\ Subst | SSubst :=
     metaBuiltInMatch(
           clearAllFrozen(removeBoolEqs(
                upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true))),
        upTerm((M1#:SMsgList,M2#:SMsgList,-(M#:Msg),M3#:SMsgList)),
        upTerm((M1:SMsgList, M2:SMsgList, -(M:Msg), M3:SMsgList))
     ) .
  eq I1:Id G1:GhostList & ML1:SMsgList noParentGhost## I2:Id ML2:SMsgList
   = true 
  [owise] .

  op eachSMsgIn_hasSubterm_ : SMsgList Msg -> Bool .
  eq eachSMsgIn nil hasSubterm M:Msg = true .
  eq eachSMsgIn (M1:SMsg,ML:SMsgList) hasSubterm M:Msg
   = is upTerm(M:Msg) subTermOf upTerm(M1:SMsg)
     and-then
     eachSMsgIn ML:SMsgList hasSubterm M:Msg .

  op resuscitated? : SMsgList -> Bool .
  eq resuscitated?((M1:SMsgList,resuscitated(M:Msg),M2:SMsgList)) = true .
  eq resuscitated?(M1:SMsgList) = false [owise] .
 
  *** noParentGhost ***************
 
  op noBar : StrandSet$ -> StrandSet$ .
  eq noBar(empty) 
   = empty .
  eq noBar(:: RL:FreshSet :: [ L:SMsgList-L$ | L':SMsgList-R$] & SS:StrandSet)
   = :: RL:FreshSet :: 
     [ nil | 
       toSMsgList-R((toSMsgList(L:SMsgList-L$),toSMsgList(L':SMsgList-R$))) ]
     & noBar(SS:StrandSet) .

  op noInitial : StrandSet -> StrandSet .
  eq noInitial(empty) 
   = empty .
  eq noInitial(:: RL:FreshSet :: [ nil | L':SMsgList-R] & SS:StrandSet)
   = noInitial(SS:StrandSet) .
  eq noInitial(:: RL:FreshSet :: [ L:SMsgList-L | L':SMsgList-R] & SS:StrandSet)
   = :: RL:FreshSet :: [ L:SMsgList-L | L':SMsgList-R] 
     & noInitial(SS:StrandSet) [owise] .

  op noIntruder : StrandSet -> StrandSet .
  eq noIntruder(empty) 
   = empty .
  eq noIntruder(:: nil :: [ L:SMsgList-L | L':SMsgList-R] & SS:StrandSet)
   = noIntruder(SS:StrandSet) .
  eq noIntruder(:: RL:FreshSet :: [ L:SMsgList-L | L':SMsgList-R] 
                & SS:StrandSet)
   = :: RL:FreshSet :: [ L:SMsgList-L | L':SMsgList-R] 
     & noIntruder(SS:StrandSet) [owise] .

  op _implies$_ : StrandSet$ StrandSet$ -> Bool .
  eq empty implies$ SS':StrandSet$
   = true .
  eq (:: RL:FreshSet :: [ L:SMsgList-L$ | L@:SMsgList-R$] & SS:StrandSet$)
     implies$
     (:: RL:FreshSet :: [ L:SMsgList-L$ | L@':SMsgList-R$] & SS':StrandSet$)
   = SS:StrandSet$ implies$ SS':StrandSet$ .
  eq SS:StrandSet$ implies$ SS':StrandSet$
   = false [owise] .
 


  --- Utilities for _implies_ -----
  op _<<_ : IntruderKnowledge Substitution -> IntruderKnowledge .
  eq K:IntruderKnowledge << S:Substitution
   = downIntruderKnowledge(upTerm(K:IntruderKnowledge) << S:Substitution) .
  
  op _<<_ : GhostList Substitution -> GhostList .
  eq G:GhostList << S:Substitution
   = downGhostList(upTerm(G:GhostList) << S:Substitution) .
  
  op _<<_ : SMsgList Substitution -> SMsgList .
  eq M:SMsgList << S:Substitution
   = downTerm(upTerm(M:SMsgList) << S:Substitution,(nil).SMsgList) .

  op _<<_ : StrandSet$ Substitution -> StrandSet$ .
  eq SS:StrandSet$ << S:Substitution
   = downStrandSet(upTerm(SS:StrandSet$) << S:Substitution) .
  
  op _<<`(_`)< : System System -> System .
  eq S:System <<( S':System )<
   = downSystemSet( upTerm(S:System) <<( upTerm(S':System) )< ) .

  op _<<`(_`)< : IntruderKnowledge IntruderKnowledge -> IntruderKnowledge .
  eq X:IntruderKnowledge <<( X':IntruderKnowledge )<
   = downIntruderKnowledge( upTerm(X:IntruderKnowledge) 
       <<( upTerm(X':IntruderKnowledge) )< ) .
 
  *** filters *******************************************************
  op simplifyByPartialOrder : Filters IdSystemSet -> IdSystemSet .
  eq simplifyByPartialOrder(F:Filters,IST)
   = if -partialOrder !in F:Filters 
     then simplifyByPartialOrder*(IST) 
     else IST 
     fi .

  op simplifyByPartialOrder* : IdSystemSet -> IdSystemSet .
  eq simplifyByPartialOrder*(empty)
   = empty .
  eq simplifyByPartialOrder*(IS IST)
   = simplifyByPartialOrder**(empty,IS,IST,IST) .

  op simplifyByPartialOrder** : IdSystemSet IdSystem IdSystemSet IdSystemSet
                             -> IdSystemSet .
  eq simplifyByPartialOrder**(IST', IS, empty, empty)
   = IST' IS .
  eq simplifyByPartialOrder**(IST', IS, empty, IS' IST'')
   = simplifyByPartialOrder**(IST' IS, IS', IST'', IST'') .
  eq simplifyByPartialOrder**(IST', IS, IS' IST, IS' IST'')
   = if remId(IS) independent (remId(IS') <<(remId(IS))<)
     then simplifyByPartialOrder**(IST', IS, IST, IST'')
     else if remId(IS') independent (remId(IS) <<(remId(IS'))<)
          then simplifyByPartialOrder**(IST', IS', IST'', IST'')
          else simplifyByPartialOrder**(IST', IS, IST, IS' IST'')
          fi 
     fi .

  *** implies for System States ****************************************
  op _independent_ : System System -> Bool .
  eq X:System independent Y:System
   = if X:System *independent* Y:System :: Bool
     then X:System *independent* Y:System 
     else false 
     fi .

  op _*independent*_ : System System ~> Bool .
  --- We assume both states have the same parent state

  --- There is at least one substitution with shared vars => FALSE
  ceq (SS1:StrandSet &
       :: nil :: [ L11:SMsgList-L | +(M1:Msg), L12:SMsgList-R ] 
      || (M2$:Msg inI,M1:Msg !inI,K1:IntruderKnowledge) 
      || (+(M1:Msg),ML1:SMsgList) 
      || G1:GhostList
      || PP1:Properties
     ) 
     *independent* 
     (SS2:StrandSet &
       :: nil :: [ L21:SMsgList-L | +(M2:Msg), L22:SMsgList-R ] 
      || (M1$:Msg inI,M2:Msg !inI,K2:IntruderKnowledge) 
      || (+(M2:Msg),ML2:SMsgList)
      || G2:GhostList
      || PP2:Properties
     )
   = false
  if S:Substitution | SS:SubstitutionSet
     := metaBuiltInMatch(STRAND-EXAMPLE-RULES-WITH-ALL,
               '_`,_['+`(_`)[upTerm(M1$:Msg)],'+`(_`)[upTerm(M2:Msg)]],
               '_`,_['+`(_`)[upTerm(M1:Msg)],'+`(_`)[upTerm(M2$:Msg)]]
        )
  /\ Vars(upTerm(M1:Msg) << S:Substitution) 
     intersect 
     Vars(upTerm(M2:Msg)) 
     =/= empty .

  --- There is no substitution with shared vars (previous ceq does not apply)
  ceq (SS1:StrandSet &
       :: nil :: [ L11:SMsgList-L | +(M1:Msg), L12:SMsgList-R ] 
      || (M2$:Msg inI,M1:Msg !inI,K1:IntruderKnowledge) 
      || (+(M1:Msg),ML1:SMsgList) 
      || G1:GhostList
      || PP1:Properties
     ) 
     *independent* 
     (SS2:StrandSet &
       :: nil :: [ L21:SMsgList-L | +(M2:Msg), L22:SMsgList-R ] 
      || (M1$:Msg inI,M2:Msg !inI,K2:IntruderKnowledge) 
      || (+(M2:Msg),ML2:SMsgList)
      || G2:GhostList
      || PP2:Properties
     )
   = true
  if metaBuiltInMatch?(STRAND-EXAMPLE-RULES-WITH-ALL,
               '_`,_['+`(_`)[upTerm(M1$:Msg)],'+`(_`)[upTerm(M2:Msg)]],
               '_`,_['+`(_`)[upTerm(M1:Msg)],'+`(_`)[upTerm(M2$:Msg)]]
     )
  [owise] .

  *** filters *******************************************************
  op testInconsistency : System -> Bool . ---[memo] .
  eq testInconsistency(
      (SS:StrandSet || K:IntruderKnowledge 
          || ML:SMsgList || G:GhostList || PP:Properties))
   = testInconsistentKnowledge(K:IntruderKnowledge)
     or-else 
     testInconsistentStrands(SS:StrandSet) 
     or-else
     testInconsistentStrandsK(SS:StrandSet,K:IntruderKnowledge) .

  op testInconsistentKnowledge : IntruderKnowledge -> Bool .
  *** If knowledge "X in I" and knowledge "X !in I" appears at the
  *** same time, then error and remove such State
  eq testInconsistentKnowledge( (X:Msg inI,X:Msg !inI,K:IntruderKnowledge) )
   = true .
  *** If some knowledge appears more than once,
  *** then error and remove such State
  eq testInconsistentKnowledge( (X:Msg !inI,X:Msg !inI,K:IntruderKnowledge) )
   = true .
  *** If some T != T knowledge appears, then error
  eq testInconsistentKnowledge( ((X:Msg != X:Msg),K:IntruderKnowledge) )
   = true .
  *** OR
  eq testInconsistentKnowledge(
      ( (K1:IntruderKnowledge-!= or K2:IntruderKnowledge-!=), 
        K:IntruderKnowledge ) 
     )
   = testInconsistentKnowledge((K1:IntruderKnowledge-!=,K:IntruderKnowledge))
     and-then
     testInconsistentKnowledge((K2:IntruderKnowledge-!=,K:IntruderKnowledge)) .
  *** AND
  eq testInconsistentKnowledge(
      ( (K1:IntruderKnowledge-!= and K2:IntruderKnowledge-!=), 
        K:IntruderKnowledge ) 
     )
   = testInconsistentKnowledge((K1:IntruderKnowledge-!=,K:IntruderKnowledge))
     or-else
     testInconsistentKnowledge((K2:IntruderKnowledge-!=,K:IntruderKnowledge)) .
  *** Otherwise
  eq testInconsistentKnowledge(K:IntruderKnowledge)
   = false [owise] .

  op testInconsistentStrands : StrandSet -> Bool .
  eq testInconsistentStrands(
      :: RL1:FreshSet, r:Fresh, RL2:FreshSet :: 
      [ L1:SMsgList-L | L2:SMsgList-R ]
      &
      :: RL1':FreshSet, r:Fresh, RL2':FreshSet :: 
      [ L1':SMsgList-L | L2':SMsgList-R ]
      &
      SS:StrandSet
     )
   = true .
  eq testInconsistentStrands(SS:StrandSet)
   = false [owise] .
  
  op testInconsistentStrandsK : StrandSet IntruderKnowledge -> Bool .
 ceq testInconsistentStrandsK(
      :: RL:FreshSet :: [ L1:SMsgList-L | L2:SMsgList-R ] & SS:StrandSet,
      (X:Msg !inI,K:IntruderKnowledge)
     )
   = true 
  if L1:SMsgList, -(X:Msg), L1':SMsgList := toSMsgList(L1:SMsgList-L) .
  eq testInconsistentStrandsK(SS:StrandSet,K:IntruderKnowledge)
   = false [owise] .
 


  *** filters *******************************************************  
  op testBadSecretData : System -> Bool . ---[memo] .
  eq testBadSecretData( 
         SS:StrandSet
         || (secret(X:Msg), X:Msg !inI, K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties )
   = true .
  eq testBadSecretData( 
         SS:StrandSet
         || (secret(X:Msg), X:Msg inI, K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList 
         || PP:Properties)
   = true .
  ceq testBadSecretData( 
         :: RL:FreshSet :: [ L:SMsgList-L | L':SMsgList-R] 
          & SS:StrandSet
         || (secret(X:Msg), K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList 
         || PP2:Properties)
   = true 
  if L1:SMsgList, -(X:Msg), L2:SMsgList := toSMsgList(L:SMsgList-L) .
  
  eq testBadSecretData(S:System) = false [owise] .

  *** filters *******************************************************  
  op testBadBeforeRelation : System -> Bool . ---[memo] .
  ceq testBadBeforeRelation( 
         :: r1:Fresh,RL1:FreshSet :: [ L1:SMsgList-L | L1:SMsgList-R] &
         :: r2:Fresh,RL2:FreshSet :: [ L2:SMsgList-L | L2:SMsgList-R] &
         SS:StrandSet
         || (((N1:PosNat InStrand r1:Fresh) 
               before 
              (N2:PosNat InStrand r2:Fresh)), 
             IK:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList 
         || PP:Properties)
    = true 
   if length(L1:SMsgList-L) < [ N1:PosNat ]
      and 
      [ N2:PosNat ] <= length(L2:SMsgList-L) .

  eq testBadBeforeRelation(S:System) = false [owise] .

  *** filters *******************************************************  
  op testAlreadySent : System -> Bool . ---[memo] .
  
  ceq testAlreadySent(
       ( :: RL:FreshSet, r:Fresh, RL':FreshSet :: 
         [ L:SMsgList-L | L':SMsgList-R ] & SS:StrandSet 
         || 
	 (X:Msg inI, K:IntruderKnowledge)
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties
       )
     )
   = true 
   if (is upTerm(r:Fresh) subTermOf upTerm(X:Msg))
      and-then
      not (is upTerm(r:Fresh) 
           subTermOf upTerm(only-Output(toSMsgList(L:SMsgList-L)))) .
  
  ceq testAlreadySent(
       ( :: RL:FreshSet :: 
	    [ L:SMsgList-L | L':SMsgList-R ] 
	  &
	  :: RLL:FreshSet, r:Fresh, RLL':FreshSet :: 
	    [ LL:SMsgList-L | LL':SMsgList-R ] 
	  & SS:StrandSet
         || 
	 K:IntruderKnowledge
	 || ML:SMsgList
	 || G:GhostList
         || PP:Properties
       )
     )
   = true 
   if (L1:SMsgList, -(X:Msg), L2:SMsgList) := toSMsgList(L:SMsgList-L) 
   /\ (is upTerm(r:Fresh) subTermOf upTerm(X:Msg))
      and-then
      not (is upTerm(r:Fresh) 
           subTermOf upTerm(only-Output(toSMsgList(LL:SMsgList-L)))) .

  eq testAlreadySent(S:System)
   = false [owise] .
   
  *** filters *******************************************************  
  op testByEquationalReducibility : Module System -> Bool . ---[memo] .
  eq testByEquationalReducibility(M,S)
    = not 
      (upTerm(S) =[M]= 
       getTerm(
         metaReduce(
           onlyEqsNoBuiltInUnify(
           putStrat(0,'+`(_`),'Msg,
           putStrat(0,'_!inI,'Msg,
             clearNonExecEqs(eraseRls(M))
           ))),
           upTerm(S)
         )
       )) .

  *** filters *******************************************************  
  op testByGrammars : GrammarList System -> Bool .
  eq testByGrammars(GS,
       (SS:StrandSet || K:IntruderKnowledge 
          || ML:SMsgList || G:GhostList || PP:Properties))
   = testIKnowledge(GS,filterNotInI(K:IntruderKnowledge),K:IntruderKnowledge) 
     or-else
     testEachStrand(GS,filterNotInI(K:IntruderKnowledge),SS:StrandSet) .

  op filterNotInI : IntruderKnowledge -> CtrSet .
  eq filterNotInI((M:Msg !inI,K:IntruderKnowledge))
   = (M:Msg notInI, filterNotInI(K:IntruderKnowledge)) .
  eq filterNotInI(K:IntruderKnowledge)
   = empty [owise] .

  op testIKnowledge : GrammarList CtrSet IntruderKnowledge -> Bool .
  eq testIKnowledge(GS,Ctr:CtrSet,(M:Msg inI,K:IntruderKnowledge))
   = {GS,Ctr:CtrSet} |- M:Msg inL *** Removed by inclusion in one grammar
     or-else
     testIKnowledge(GS,Ctr:CtrSet,K:IntruderKnowledge) .
  eq testIKnowledge(GS,Ctr:CtrSet,K:IntruderKnowledge)
   = false [owise] .
   
  op testEachStrand : GrammarList CtrSet StrandSet -> Bool .
  eq testEachStrand(GS,Ctr:CtrSet,empty)
   = false .
  eq testEachStrand(GS,Ctr:CtrSet,(S:Strand & SS:StrandSet))
   = testStrand(GS,Ctr:CtrSet,S:Strand)
     or-else
     testEachStrand(GS,Ctr:CtrSet,SS:StrandSet).

  op testStrand : GrammarList CtrSet Strand -> Bool .
  eq testStrand(GS,Ctr:CtrSet,
       :: RL:FreshSet :: [SM1:SMsgList-L | SM2:SMsgList-R])
   = testNegMsg(GS,Ctr:CtrSet,toSMsgList(SM1:SMsgList-L)) .

  op testNegMsg : GrammarList CtrSet SMsgList -> Bool .
  eq testNegMsg(GS,Ctr:CtrSet,nil)
   = false .
  eq testNegMsg(GS,Ctr:CtrSet,(-(M:Msg),SM:SMsgList))
   = {GS,Ctr:CtrSet} |- M:Msg inL *** Removed by inclusion in one grammar
     or-else
     testNegMsg(GS,Ctr:CtrSet,SM:SMsgList) .
  eq testNegMsg(GS,Ctr:CtrSet,(+(M:Msg),SM:SMsgList))
   = testNegMsg(GS,Ctr:CtrSet,SM:SMsgList) .

  *** initials *******************************************************  
  op initials : IdSystemSet -> IdSystemSet .
  eq initials(empty) = empty .
  eq initials(IS IST) 
   = if isInitial(remId(IS))
     then IS
     else empty
     fi
     initials(IST) .
  
  *** isInitial *******************************************************  
  op isInitial : System -> Bool .
  eq isInitial(
       (SS:StrandSet || K:IntruderKnowledge 
           || ML:SMsgList || G:GhostList || PP:Properties))
   = isInitial(SS:StrandSet)
     and-then
     isInitial(K:IntruderKnowledge) .

  op isInitial : StrandSet -> Bool . ---[memo] .
  eq isInitial((empty).StrandSet)
   = true .
  eq isInitial(:: RL:FreshSet :: [ nil | S:SMsgList-R ] & SS:StrandSet)
   = isInitial(SS:StrandSet) .
  eq isInitial(SS:StrandSet)
   = false [owise] .

  op isInitial : IntruderKnowledge -> Bool . ---[memo] .
  eq isInitial((X:Msg inI,K:IntruderKnowledge))
   = false .
  eq isInitial(K:IntruderKnowledge)
   = true [owise] .
   
  *** countSessions *******************************************************  
  op countSessions : IdSystem -> Nat .
  eq countSessions(
       < I:Id >
       SS:StrandSet || K:IntruderKnowledge 
          || M:SMsgList || G:GhostList || PP:Properties) 
   = countSessions(0,new-strands?,SS:StrandSet) .

  op countSessions : Nat StrandSet StrandSet -> Nat .
  eq countSessions(N:Nat,empty,S:StrandSet)
   = N:Nat .
  eq countSessions(N:Nat,S*:Strand & S*:StrandSet,S:StrandSet)
   = if countSessions*(0,S*:Strand,S:StrandSet) > N:Nat
     then countSessions(countSessions*(0,S*:Strand,S:StrandSet),
                        S*:StrandSet,S:StrandSet) 
     else countSessions(N:Nat,S*:StrandSet,S:StrandSet)
     fi .

  op countSessions* : Nat Strand StrandSet -> Nat .

  ceq countSessions*(N:Nat,
        :: RL:FreshSet :: [ L:SMsgList-L | L:SMsgList-R ],
        :: RL':FreshSet :: [ L':SMsgList-L | L':SMsgList-R ]
        & S:StrandSet)
   = countSessions*(s(N:Nat),
      :: RL:FreshSet :: [ L:SMsgList-L | L:SMsgList-R ],
      S:StrandSet)
  if RL:FreshSet =/= nil 
  /\ RL':FreshSet =/= nil 
  /\ metaBuiltInMatch(
       STRAND-EXAMPLE-RULES-WITH-ALL,
       upTerm(toSMsgList(L':SMsgList-L),toSMsgList(L':SMsgList-R)),
       upTerm(toSMsgList(L:SMsgList-L),toSMsgList(L:SMsgList-R))
     ) =/= empty .

  eq countSessions*(N:Nat,S:Strand,SS:StrandSet)
   = N:Nat 
  [owise] .

endfm

fmod BACKWARDS-REACHABILITY is
  protecting BACK-NARROWING .
  protecting NAT-LIST .

  var BStep BSol Sess : Bound .
  var Rem? : Bool .
  vars IST IST' HistoryIST : IdSystemSet .
  var IS : IdSystem .
  vars ST ST' HistoryST : SystemSet .
  var S : System .
  var GS : GrammarList .
  var M : Module .
  var F : Filters .
  var I : Id .
  var ML : SMsgList .

  op genGrammars : -> GrammarList [memo] .

  *** Shortcut to search
  op search : Attack Filters -> IdSystemSet .
  eq search(A:Attack,F)
   = search(A:Attack,F,1,unbounded,unbounded,true) .

  op search : GrammarList Attack Filters -> IdSystemSet .
  eq search(GS,A:Attack,F)
   = search(GS,A:Attack,F,1,unbounded,unbounded,true) .

  op search : Attack Filters Bound Nat Bound Bool -> IdSystemSet .
  eq search(A:Attack,F,BStep,BSol,Sess,Rem?)
   = search(genGrammars,A:Attack,F,BStep,BSol,Sess,Rem?) .

  op search : GrammarList Attack Filters Bound Nat Bound Bool
           -> IdSystemSet [memo] .
  eq search(GS,ST,F,BStep,BSol,Sess,Rem?)
   = searchState(
       GS,
       F,
       BStep, *** number of backward reachability steps
       BSol, *** solutions
       Sess,
       Rem?,
       empty,
       setId+(1,ST)
     ) .


  *** General Call *******************************************************
  op searchState : GrammarList Filters Bound Bound Bound Bool
                   IdSystemSet IdSystemSet -> IdSystemSet .
     --- The first bound is "unbounded"
     ---  or the maximum number of backwards narrowing steps
     --- The second bound is "unbounded" or the number of solutions
     --- B:Bool -> whether the remaining states must be returned or not
     --- Sess:Bound -> Number of sessions allowed        
     --- The last SystemSet is systems that cannot be found in the path
  eq searchState(GS,F,BStep,BSol,Sess,Rem?,HistoryIST,IST)
   = searchStateM(if -inputAndNotLearned !in F
                  then flipRls(STRAND-EXAMPLE-RULES)
                  else flipRls(STRAND-EXAMPLE-RULES-INPUT)
                  fi,
                 GS,F,BStep,BSol,Sess,Rem?,HistoryIST,IST) .

  op searchStateM : Module GrammarList Filters Bound Bound Bound Bool
                    IdSystemSet IdSystemSet -> IdSystemSet .
  eq searchStateM(M,GS,F,BStep,BSol,Sess,Rem?,HistoryIST,IST)
   = if BSol == 0
     then empty --- No more solutions
     else if BStep == 0 or IST == empty
          then --- Stop the search
	       if Rem? then IST else empty fi
          else 
          searchState-Check(M,GS,F,BStep,BSol,Sess,Rem?,HistoryIST,empty,IST)
          fi
     fi .

  *** Auxiliary Call *******************************************************
  op searchState-Check : Module GrammarList Filters Bound Bound Bound Bool
                         IdSystemSet
                         IdSystemSet IdSystemSet -> IdSystemSet .

  eq searchState-Check(M,GS,F,BStep,BSol,Sess,Rem?,HistoryIST,IST',empty)
   = *** Next successors
     searchStateM(M,GS,F,dec(BStep),BSol,Sess,Rem?,HistoryIST IST',
            filterSMsgList(F,filterId(F,
              nextBackNarrow(M,GS,F,HistoryIST IST',IST')
            ))
     ) .

  eq searchState-Check(M,GS,F,BStep,BSol,Sess,Rem?,HistoryIST,IST',(IS IST))
   = if Sess =/= unbounded and-then countSessions(IS) > Sess
     then searchState-Check(M,GS,F,BStep,BSol,Sess,Rem?,HistoryIST,IST',IST)
     else if isSolutionSystem(M,GS,IS)
          then IS
	       searchState-Check(M,GS,F,BStep,dec(BSol),Sess,Rem?,HistoryIST,
                 IST',IST)
          else searchState-Check(M,GS,F,BStep,BSol,Sess,Rem?,HistoryIST,
                 if isNFSystem(M,HistoryIST,IS) 
                 then IST' else (IS IST') fi,
	         IST)
          fi
     fi .


  *** Tools *******************************************************
---   op isNFSystem : Module GrammarList Filters IdSystemSet IdSystem -> Bool .
---   eq isNFSystem(M,GS,F,HistoryIST,IS)
---    = nextBackNarrow*OneSt(M,GS,F,IS) == empty
---      or
---      nextBackNarrow*OneSt(M,GS,F,IS) == IS .

  op isNFSystem : Module IdSystemSet IdSystem -> Bool .
  eq isNFSystem(M,HistoryIST
       < I1:Id >
       (SS:StrandSet || K:IntruderKnowledge 
          || ML:SMsgList || GL:GhostList || PP1:Properties),
       < I2:Id >
       (SS:StrandSet || K:IntruderKnowledge 
          || ML:SMsgList || GL:GhostList || PP2:Properties) 
     )
   = true .
  eq isNFSystem(M,HistoryIST,IS)
   = false [owise] .

  op isSolutionSystem : Module GrammarList IdSystem -> Bool .
  eq isSolutionSystem(M,GS,IS)
   = isInitial(remId(IS)) .

  *** Extra tools ****************************************
  op count : IdSystemSet -> Nat .
  eq count(IST) = | IST | .

  op |_| : IdSystemSet -> Nat .
  eq | (empty).IdSystemSet | = 0 .
  eq | IS IST | = 1 + | IST | .

  op count : SystemSet -> Nat .
  eq count(ST) = | ST | .

  op |_| : SystemSet -> Nat .
  eq | (empty).SystemSet | = 0 .
  eq | S ST | = 1 + | ST | .

  *** Filter States ****************************************
  op _<<<_ : SMsgList SMsgList ~> Bool [memo] .
  eq L1:SMsgList <<< L2:SMsgList
   = metaEBuiltInUnifyIrr(
           STRAND-EXAMPLE-RULES-WITH-ALL,
           upTerm(L2:SMsgList),
           '_`,_['X:SMsgList,upTerm(L1:SMsgList)]
     ) :: SubstitutionSet
     and 
     metaEBuiltInUnifyIrr(
           STRAND-EXAMPLE-RULES-WITH-ALL,
           upTerm(L2:SMsgList),
           '_`,_['X:SMsgList,upTerm(L1:SMsgList)]
     ) =/= empty .

  op filterSMsgList : SMsgList IdSystemSet -> IdSystemSet .
  eq filterSMsgList(L:SMsgList,empty)
   = empty .
  eq filterSMsgList(L:SMsgList,
          (< I:Id > 
          SS:StrandSet || K:IntruderKnowledge 
             || ML:SMsgList || GL:GhostList || PP:Properties)             
          SS:IdSystemSet)
   = if ML:SMsgList <<< L:SMsgList or-else L:SMsgList <<< ML:SMsgList
     then (< I:Id > 
           SS:StrandSet || K:IntruderKnowledge 
             || ML:SMsgList || GL:GhostList || PP:Properties) 
     else empty
     fi filterSMsgList(L:SMsgList,SS:IdSystemSet) .

  *** Filter States ****************************************
  op filterId : Filters IdSystemSet -> IdSystemSet .
  eq filterId(filterId(0) F,SS:IdSystemSet)
   = SS:IdSystemSet .
  eq filterId(filterId(I*:Id) F,SS:IdSystemSet)
   = filterId(I*:Id,SS:IdSystemSet) .
  eq filterId(F,SS:IdSystemSet)
   = SS:IdSystemSet [owise] .

  op filterSMsgList : Filters IdSystemSet -> IdSystemSet .
  eq filterSMsgList(filterSMsgList(L:SMsgList) F,SS:IdSystemSet)
   = filterSMsgList(L:SMsgList,SS:IdSystemSet) .
  eq filterSMsgList(F,SS:IdSystemSet)
   = SS:IdSystemSet [owise] .

endfm

fmod GENERIC-TOOLS is
  protecting BACKWARDS-REACHABILITY .
  protecting GRAMMAR-GENERATION .

  sort Id-SMsgList .
  subsort Id < Id-SMsgList .
  op `(_`) : SMsgList -> Id-SMsgList .

  op extract : Id-SMsgList -> SMsgList .
  eq extract((L:SMsgList)) = L:SMsgList .

  *** General Tools ****************************************
  sort IdSystemSet-or-Error .
  subsort IdSystemSet < IdSystemSet-or-Error .
  op errorOneStrandInAttackStateDoesNotUnifyWithAnyfProtocolStrands : 
     -> IdSystemSet-or-Error [format (r d)] .
  op errorInAttackStateinFile : 
     -> IdSystemSet-or-Error [format (r d)] .

  op run : Bound -> IdSystemSet-or-Error .
  eq run(N:Bound)
   = run[0](N:Bound)< unbounded > .

  op run : Nat Bound -> IdSystemSet-or-Error .
  eq run(N:Nat,N:Bound)
   = run[0](N:Nat,N:Bound)< unbounded > .

  op run : Bound Filters -> IdSystemSet-or-Error .
  eq run(N:Bound,F:Filters)
   = run[0](N:Bound,F:Filters)< unbounded > .

  op run : Nat Bound Filters -> IdSystemSet-or-Error .
  eq run(N:Nat,N:Bound,F:Filters)
   = run[0](N:Nat,N:Bound,F:Filters)< unbounded > .

  op run[_]`(_`) : Id-SMsgList Bound -> IdSystemSet-or-Error .
  eq run[I:Id-SMsgList](N:Bound)
   = run[I:Id-SMsgList](N:Bound)< unbounded > .

  op run[_]`(_`,_`) : Id-SMsgList Nat Bound -> IdSystemSet-or-Error .
  eq run[I:Id-SMsgList](N:Nat,N:Bound)
   = run[I:Id-SMsgList](N:Nat,N:Bound)< unbounded > .

  op run[_]`(_`,_`) : Id-SMsgList Bound Filters -> IdSystemSet-or-Error .
  eq run[I:Id-SMsgList](N:Bound,F:Filters)
   = run[I:Id-SMsgList](N:Bound,F:Filters)< unbounded > .

  op run[_]`(_`,_`,_`) : Id-SMsgList Nat Bound Filters -> IdSystemSet-or-Error .
  eq run[I:Id-SMsgList](N:Nat,N:Bound,F:Filters)
   = run[I:Id-SMsgList](N:Nat,N:Bound,F:Filters)< unbounded > .

  op run`(_`,_`)<_> : Nat Bound Bound -> IdSystemSet-or-Error .
  eq run(N:Nat,N:Bound)< Sess:Bound >
   = run[0](N:Nat,N:Bound,all)< unbounded > .

  op run`(_`)<_> : Bound Bound -> IdSystemSet-or-Error .
  eq run(N:Bound)< Sess:Bound >
   = run[0](0,N:Bound,all )< unbounded > .

  *** General Tools ****************************************
  op initials : Bound -> IdSystemSet-or-Error .
  eq initials(N:Bound)
   = initials[0](N:Bound,all) .

  op initials[_]`(_`) : Id-SMsgList Bound -> IdSystemSet-or-Error .
  eq initials[I:Id-SMsgList](N:Bound)
   = initials[I:Id-SMsgList](0,N:Bound,all) .

  op initials`(_`,_`) : Nat Bound -> IdSystemSet-or-Error .
  eq initials(N:Nat,N:Bound)
   = initials[0](N:Nat,N:Bound) .

  op initials[_]`(_`,_`) : Id-SMsgList Nat Bound -> IdSystemSet-or-Error .
  eq initials[I:Id-SMsgList](N:Nat,N:Bound)
   = initials[I:Id-SMsgList](N:Nat,N:Bound,all) .

  op initials`(_`,_`) : Bound Filters -> IdSystemSet-or-Error .
  eq initials(N:Bound,F:Filters)
   = initials[0](N:Bound,F:Filters) .

  op initials[_]`(_`,_`) : Id-SMsgList Bound Filters -> IdSystemSet-or-Error .
  eq initials[I:Id-SMsgList](N:Bound,F:Filters)
   = initials[I:Id-SMsgList](0,N:Bound,F:Filters) .

  op initials`(_`,_`,_`) : Nat Bound Filters -> IdSystemSet-or-Error .
  eq initials(N:Nat,N:Bound,F:Filters)
   = initials[0](N:Nat,N:Bound,F:Filters) .

  op initials[_]`(_`,_`,_`) 
       : Id-SMsgList Nat Bound Filters -> IdSystemSet-or-Error .
  eq initials[I:Id-SMsgList](N:Nat,N:Bound,F:Filters)
   = initials(run[I:Id-SMsgList](N:Nat,N:Bound,F:Filters)) .

  *** General Tools ****************************************
  op initials`(_`)<_> : Bound Bound -> IdSystemSet-or-Error .
  eq initials(N:Bound)< Sess:Bound >
   = initials[0](N:Bound)< Sess:Bound > .

  op initials[_]`(_`)<_> : Id-SMsgList Bound Bound -> IdSystemSet-or-Error .
  eq initials[I:Id-SMsgList](N:Bound)< Sess:Bound >
   = initials[I:Id-SMsgList](0,N:Bound,all)< Sess:Bound > .

  op initials[_]`(_`,_`)<_> 
        : Id-SMsgList Nat Bound Bound -> IdSystemSet-or-Error .
  eq initials[I:Id-SMsgList](N:Nat,N:Bound)< Sess:Bound >
   = initials[I:Id-SMsgList](N:Nat,N:Bound,all)< Sess:Bound > .

  op initials[_]`(_`,_`)<_> 
        : Id-SMsgList Bound Filters Bound -> IdSystemSet-or-Error .
  eq initials[I:Id-SMsgList](N:Bound,F:Filters)< Sess:Bound >
   = initials[I:Id-SMsgList](0,N:Bound,F:Filters)< Sess:Bound > .

  op initials[_]`(_`,_`,_`)<_> 
        : Id-SMsgList Nat Bound Filters Bound -> IdSystemSet-or-Error .
  eq initials[I:Id-SMsgList](N:Nat,N:Bound,F:Filters)< Sess:Bound >
   = initials(run[I:Id-SMsgList](N:Nat,N:Bound,F:Filters)< Sess:Bound >) .

  op initials`(_`,_`)<_> : Nat Bound Bound -> IdSystemSet-or-Error .
  eq initials(N:Nat,N:Bound)< Sess:Bound >
   = initials[0](N:Nat,N:Bound,all)< unbounded > .

  op initials`(_`)<_> : Bound Bound -> IdSystemSet-or-Error .
  eq initials(N:Bound)< Sess:Bound >
   = initials[0](0,N:Bound,all)< unbounded > .

  *** General Tools ****************************************
  sort Summary .
  op States>>_Solutions>>_ : Nat Nat -> Summary [format (r o r o d)] .

  op summary : Bound -> Summary .
  eq summary(N:Bound)
   = summary[0](N:Bound) .

  op summary : Nat Bound -> Summary .
  eq summary(N:Nat,N:Bound)
   = summary[0](N:Nat,N:Bound,all) .

  op summary : Bound Filters -> Summary .
  eq summary(N:Bound,F:Filters)
   = summary[0](0,N:Bound,F:Filters) .

  op summary : Nat Bound Filters -> Summary .
  eq summary(N:Nat,N:Bound,F:Filters)
   = summary[0](N:Nat,N:Bound,F:Filters ) .

  op summary[_]`(_`) : Id-SMsgList Bound -> Summary .
  eq summary[I:Id-SMsgList](N:Bound)
   = summary[I:Id-SMsgList](0,N:Bound,all) .

  op summary[_]`(_`,_`) : Id-SMsgList Nat Bound -> Summary .
  eq summary[I:Id-SMsgList](N:Nat,N:Bound)
   = summary[I:Id-SMsgList](N:Nat,N:Bound,all) .

  op summary[_]`(_`,_`) : Id-SMsgList Bound Filters -> Summary .
  eq summary[I:Id-SMsgList](N:Bound,F:Filters)
   = summary[I:Id-SMsgList](0,N:Bound,F:Filters) .

  op summary[_]`(_`,_`,_`) : Id-SMsgList Nat Bound Filters -> Summary .
  eq summary[I:Id-SMsgList](N:Nat,N:Bound,F:Filters)
   = States>> count(run[I:Id-SMsgList](N:Nat,N:Bound,F:Filters)) 
     Solutions>> count(initials(run[I:Id-SMsgList](N:Nat,N:Bound,F:Filters))) .

  *** General Tools ****************************************
  op summary`(_`)<_> : Bound Bound -> Summary .
  eq summary(N:Bound)< Sess:Bound >
   = summary[0](N:Bound)< Sess:Bound > .

  op summary[_]`(_`)<_> : Id-SMsgList Bound Bound -> Summary .
  eq summary[I:Id-SMsgList](N:Bound)< Sess:Bound >
   = summary[I:Id-SMsgList](0,N:Bound,all)< Sess:Bound > .

  op summary[_]`(_`,_`)<_> : Id-SMsgList Nat Bound Bound -> Summary .
  eq summary[I:Id-SMsgList](N:Nat,N:Bound)< Sess:Bound >
   = summary[I:Id-SMsgList](N:Nat,N:Bound,all )< Sess:Bound > .

  op summary[_]`(_`,_`)<_> : Id-SMsgList Bound Filters Bound -> Summary .
  eq summary[I:Id-SMsgList](N:Bound,F:Filters)< Sess:Bound >
   = summary[I:Id-SMsgList](0,N:Bound,F:Filters)< Sess:Bound > .

  op summary[_]`(_`,_`,_`)<_> : Id-SMsgList Nat Bound Filters Bound -> Summary .
  eq summary[I:Id-SMsgList](N:Nat,N:Bound,F:Filters)< Sess:Bound >
   = States>> count(run[I:Id-SMsgList](N:Nat,N:Bound,F:Filters)< Sess:Bound >) 
     Solutions>> count(initials(run[I:Id-SMsgList](N:Nat,N:Bound,F:Filters)< Sess:Bound >)) .

  op summary`(_`,_`)<_> : Nat Bound Bound -> Summary .
  eq summary(N:Nat,N:Bound)< Sess:Bound >
   = summary[0](N:Nat,N:Bound,all)< unbounded > .

  op summary`(_`)<_> : Bound Bound -> Summary .
  eq summary(N:Bound)< Sess:Bound >
   = summary[0](0,N:Bound,all)< unbounded > .

  *** General Tools ****************************************
  op run`(_`)<_> : Bound Bound -> IdSystemSet-or-Error .
  eq run(N:Bound)< Sess:Bound >
   = run[0](N:Bound)< Sess:Bound > .

  op run[_]`(_`)<_> : Id-SMsgList Bound Bound -> IdSystemSet-or-Error .
  eq run[I:Id-SMsgList](N:Bound)< Sess:Bound >
   = run[I:Id-SMsgList](0,N:Bound,all  )< Sess:Bound > .

  op run[_]`(_`,_`)<_> : Id-SMsgList Nat Bound Bound -> IdSystemSet-or-Error .
  eq run[I:Id-SMsgList](N:Nat,N:Bound)< Sess:Bound >
   = run[I:Id-SMsgList](N:Nat,N:Bound,all  )< Sess:Bound > .

  op run[_]`(_`,_`)<_> : Id-SMsgList Bound Filters Bound -> IdSystemSet-or-Error .
  eq run[I:Id-SMsgList](N:Bound,F:Filters)< Sess:Bound >
   = run[I:Id-SMsgList](0,N:Bound,F:Filters  )< Sess:Bound > .

  op run[_]`(_`,_`,_`)<_> 
          : Id-SMsgList Nat Bound Filters Bound -> IdSystemSet-or-Error .
  eq run[I:Id-SMsgList](N:Nat,N:Bound,F:Filters)< Sess:Bound >
   = if true
        ***Does downAttack(extract('ATTACK-STATE[upTerm(N:Nat)],
        ***           PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE))
        ***UnifyWith new-strands?
     then 
       if downAttack(extract('ATTACK-STATE[upTerm(N:Nat)],
                     PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) :: Attack
       then
       search(
         downAttack(extract('ATTACK-STATE[upTerm(N:Nat)],
                     PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)),
         if I:Id-SMsgList :: Id 
         then filterId(I:Id-SMsgList)
         else filterSMsgList(extract(I:Id-SMsgList))
         fi 
         F:Filters,
         N:Bound,unbounded,Sess:Bound,true)
       else errorInAttackStateinFile
       fi
     else errorOneStrandInAttackStateDoesNotUnifyWithAnyfProtocolStrands
     fi .

  *** Auxiliary of run
  op Does_UnifyWith_ : Attack StrandSet -> Bool .
  eq Does (S:StrandSet || K:IntruderKnowledge 
              || S:SMsgList || G:GhostList || PP:Properties) 
         S:SystemSet 
     UnifyWith SS:StrandSet
   = DoesS S:StrandSet UnifyWith SS:StrandSet
     and-then
     Does S:SystemSet UnifyWith SS:StrandSet .
  eq Does (empty).SystemSet UnifyWith SS:StrandSet
   = true .

  op DoesS_UnifyWith_ : StrandSet StrandSet -> Bool .
  ceq DoesS S1:Strand & SS1:StrandSet UnifyWith S2:Strand & SS2:StrandSet
    = DoesS SS1:StrandSet UnifyWith S2:Strand & SS2:StrandSet
   if :: RL1:FreshSet :: [ L1:SMsgList-L | L1:SMsgList-R ] := S1:Strand
   /\ :: RL2:FreshSet :: [ L2:SMsgList-L | L2:SMsgList-R ] := S2:Strand
   /\ metaBuiltInUnify(
       STRAND-EXAMPLE-RULES-WITH-ALL,
       upTerm(toSMsgList(L1:SMsgList-L),toSMsgList(L1:SMsgList-R)),
       upTerm(toSMsgList(L2:SMsgList-L),toSMsgList(L2:SMsgList-R))
       <<(upTerm(S1:Strand))<
      ) =/= empty .
  eq DoesS SS1:StrandSet UnifyWith SS:StrandSet
   = SS1:StrandSet == (empty).StrandSet 
     or-else 
     upTerm(SS1:StrandSet) :: Variable [owise] .

  *** General Tools ****************************************
  op genGrammars : -> GrammarList [ditto] .
  --- Standard grammar generation 
  eq genGrammars = genGrammars(unbounded) .

  op genGrammars : Bound -> GrammarList .
  ceq genGrammars(B:Bound)
    = X:GrammarList
   if X:GrammarList
      := downTerm(
          extract('GENERATED-GRAMMARS.GrammarList,
                  PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE),
               (none).GrammarList) 
      /\ X:GrammarList =/= none .
  ceq genGrammars(B:Bound)
    = if USER:[Term] :: Term
         and
         USER:[Grammar&StrategyList] :: Grammar&StrategyList
      then genGrammars*(B:Bound,USER:[Grammar&StrategyList])
      else if USER:[Term] :: Term
           then (errorInUserSeedTerms).GrammarList
           else if EXTRA:[Term] :: Term
                   and
                   EXTRA:[Grammar&StrategyList] :: Grammar&StrategyList
                then genGrammars*(B:Bound,
                       genAllGrammars | EXTRA:[Grammar&StrategyList])
                else if EXTRA:[Term] :: Term
                     then (errorInUserSeedTerms).GrammarList
                     else genGrammars*(B:Bound,genAllGrammars)
                     fi
                fi
           fi 
      fi
   if USER:[Term]
      := extract('INITIAL-GRAMMARS.Grammar&StrategyList,
                 PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)
   /\ USER:[Grammar&StrategyList]
      := downTerm(USER:[Term],(none).Grammar&StrategyList)
   /\ EXTRA:[Term]
      := extract('EXTRA-GRAMMARS.Grammar&StrategyList,
                  PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)
   /\ EXTRA:[Grammar&StrategyList]
      := downTerm(EXTRA:[Term],(none).Grammar&StrategyList) .

  op genGrammars* : Bound Grammar&StrategyList -> GrammarList .
  eq genGrammars*(B:Bound, none)
   = none .
  eq genGrammars*(B:Bound, 
       (G:Grammar ! S:GlobalStrategy) | G:Grammar&StrategyList)
   = filterEmpty(grammarsGeneration(S:GlobalStrategy,B:Bound,G:Grammar)) 
     |
     genGrammars*(B:Bound,G:Grammar&StrategyList) .

  op genAllGrammars : -> Grammar&StrategyList .
  eq genAllGrammars 
   = genAllGrammars*(getOps(upModule('PROTOCOL-EXAMPLE-SYMBOLS,false))) .

  var F : Qid . 
  vars TPL TPL' : TypeList . 
  vars TP TP' TP1 TP2 : Type .
  var AtS : AttrSet .
  var OPDS : OpDeclSet .

  op genAllGrammars* : OpDeclSet -> Grammar&StrategyList .
  eq genAllGrammars*(none)
   = none .
  eq genAllGrammars*(((op F : TPL -> TP [AtS] .) OPDS))
   = if typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP, 'Msg)
        and-then 
        not typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP, 'Public)
        and-then 
        TPL =/= nil
     then genAllGrammars**(AtS,F,nil,TPL)
          |
          genAllGrammarsEmpty(F,TPL)
     else none
     fi 
     | genAllGrammars*(OPDS) .

  --- Grammar for avoiding Auth and Longterm types
  op genAllGrammarsEmpty : Qid TypeList -> Grammar&StrategyList .
 ceq genAllGrammarsEmpty(F,(TP1 TP2))
   = none
  if Id:Constant 
       := getIdSymbol(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE,F[newVar(1,TP1),newVar(2,TP2)]) 
  /\ typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, getType(Id:Constant), TP1)
     or
     typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, getType(Id:Constant), TP2) .
  eq genAllGrammarsEmpty(F,TPL)
   = (downGrammar('grl_=>_.['empty.CtrSet,'_inL[F[newVar(1,TPL)]] ] ) 
              ! S2) 
     [owise] .

  op genAllGrammars** : AttrSet Qid TypeList TypeList -> Grammar&StrategyList .
  eq genAllGrammars**(assoc comm AtS,F,TPL,TPL')
   = genAllGrammarsAC**(F,TPL') .
  eq genAllGrammars**(comm AtS,F,TPL,TPL')
   = genAllGrammarsC**(F,TPL') .
  eq genAllGrammars**(AtS,F,TPL,TPL')
   = genAllGrammarsF**(F,TPL,TPL') [owise] .

  op genAllGrammarsF** : Qid TypeList TypeList -> Grammar&StrategyList .
  eq genAllGrammarsF**(F,TPL,nil)
   = none .
  eq genAllGrammarsF**(F,TPL',TP TPL)
   = if typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP, 'Msg)
        and-then 
        not typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP, 'Public)
     then --- Grammar for avoiding nested intruder searchs
          (downGrammar(
            'grl_=>_.['_notInI[newVar(50,TP)],
                      '_inL[F[newVar(1,TPL'),newVar(50,TP),newVar(60,TPL)]] ] )
          ! S1)
     else none
     fi 
     | genAllGrammarsF**(F,TPL' TP,TPL) .

  op genAllGrammarsC** : Qid TypeList -> Grammar&StrategyList .
  eq genAllGrammarsC**(F,TP TP')
   = if typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP, 'Msg)
        and-then 
        typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP', 'Msg)
        and-then 
        not typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP, 'Public)
        and-then 
        not typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP', 'Public)
     then --- Grammar for avoiding nested intruder searchs
          (downGrammar(
              'grl_=>_.['_notInI[newVar(1,TP)],
                        '_inL[F[newVar(1,TP),newVar(2,TP)]] ] )
          ! S1)
     else none
     fi .

  op genAllGrammarsAC** : Qid TypeList -> Grammar&StrategyList .
 ceq genAllGrammarsAC**(F,TP TP)
   = (downGrammar(
            '_;_[
              'grl_=>_.['_notInI[newVar(1,TP)],
                        '_inL[F[newVar(1,TP),newVar(2,TP)]] ], 
              'grl_=>_.['_notInI[F[newVar(1,TP),newVar(2,TP)]],
                        '_inL[newVar(1,TP)] ] 
            ]
           )
          ! S1)
   if typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP, 'Msg)
      and-then 
      not typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP, 'Public) .

 ceq genAllGrammarsAC**(F,TP TP')
   = (downGrammar(
            '_;_[
              'grl_=>_.['_notInI[newVar(1,TP)],
                        '_inL[F[newVar(1,TP),newVar(2,TP')]] ], 
              'grl_=>_.['_notInI[F[newVar(1,TP),newVar(2,TP')]],
                        '_inL[newVar(1,TP)] ] 
            ]
           )
          ! S1)
   if typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP, 'Msg)
      and-then 
      typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP', 'Msg)
      and-then 
      not typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP, 'Public)
      and-then 
      not typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP', 'Public)
      and-then 
      typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP, TP') .

 ceq genAllGrammarsAC**(F,TP TP')
   = (downGrammar(
            '_;_[
              'grl_=>_.['_notInI[newVar(1,TP')],
                        '_inL[F[newVar(1,TP'),newVar(2,TP)]] ], 
              'grl_=>_.['_notInI[F[newVar(1,TP'),newVar(2,TP)]],
                        '_inL[newVar(1,TP')] ] 
            ]
           )
          ! S1)
   if typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP, 'Msg)
      and-then 
      typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP', 'Msg)
      and-then 
      not typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP, 'Public)
      and-then 
      not typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP', 'Public)
      and-then 
      typeLeq(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, TP', TP) .

  eq genAllGrammarsAC**(F,TP TP')
   = none [owise] .

endfm

mod MAUDE-NPA is
  protecting GENERIC-TOOLS .

  inc LOOP-MODE * (sort System to System-Loop) .
  pr BANNER-MAUDENPA .

  op init : -> System-Loop .
  op empty : -> State .

  eq [init] : init  = [nil, empty, banner] .

endm 

set show advisories off . --- You can turn it on to see extra Maude comments

 set trace on  . 
 set trace select on  . 
 --- trace select notInIMatching .
---  trace select searchStrand .
 ----  trace select isIntruderStrand* .
--- trace select seeIsIntruder .
--- trace select seeBoolSearch .
--- trace select seeBoolSearch2 .
--- trace select seeBool1 .
--- trace select seeBool2 .
--- trace select seeBool3 .
loop init .

set show advisories off .
