***( Maude-NPA, Version: [3.1.2] [June 3rd 2019] Copyright (c) 2019, 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) 2018. 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: '3.1.2 ' '`( 'June '3rd '2019 '`) '\n '\t '\s '\s '\s '\s 'with 'direct 'composition '`, '\s 'irreducibility 'constraints 'and 'time '\n '\t '\s '\s '\s '\s '`( 'To 'be 'run 'with 'Maude 'alpha '121 'or 'above '`) '\n '\t '\s '\s '\s '\s 'Copyright '\s '`( 'c '`) '\s '2019 '`, '\s 'University 'of 'Illinois '\n '\t '\s '\s '\s '\s 'All 'rights 'reserved. '\n '\n '\s 'Commands: '\n '\s 'red 'unification? '. '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s 'returns 'the 'unification 'algorithm 'to 'be 'used '\n '\s 'red 'new-strands? '. '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s 'returns 'the 'actual 'protocol 'strands '\n '\s 'red 'displayGrammars '. '\s '\s '\s '\s '\s '\s '\s '\s 'for 'generating 'grammars '\n '\s 'red 'run '`( 'X '`, 'Y '`) '. '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s 'for 'Y 'backwards 'analysis 'steps 'for 'attack 'pattern 'X '\n '\s 'red 'debug '`( 'X '`, 'Y '`) '. '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s 'more 'information 'than 'run 'command '\n '\s 'red 'digest '`( 'X '`, 'Y '`) '. '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s 'less 'information 'than 'run 'command '\n '\s 'red 'summary '`( 'X '`, 'Y '`) '. '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s 'for 'summary 'of 'analysis 'steps '\n '\s 'red 'ids '`( 'X '`, 'Y '`) '. '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s 'for 'set 'of 'state 'ids '\n '\s 'red 'initials '`( 'X '`, 'Y '`) '. '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s 'for 'showing 'only 'initial 'steps . endfm fmod META-LEVEL-MNPA is pr META-LEVEL * (op `{_`,_`} : Term Nat -> SmtResult to `{_`,_`}Smt ) . endfm fmod UNIFICATIONTRIPLE is protecting META-LEVEL-MNPA . 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-MNPA . 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',NeTL) = is T subTermOf T' or-else is T subTermOf NeTL . eq is T subTermOf T = true . eq is T subTermOf T' = is T subTermOf* T' [owise] . op is_subTermOf*_ : Term TermList -> Bool . eq is T subTermOf* (F[TL]) = is T subTermOf TL . 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) ) . endfm fmod SUBSTITUTION-HANDLING is protecting META-TERM . protecting META-LEVEL-MNPA . 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' . --- Remove Substitutions ------------------------------------------------- op _\\_ : Substitution Substitution -> Substitution . eq S ; S' \\ S' = S . eq S \\ S' = S [owise] . --- 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 bindings same variable ------------------- op removeSame : Substitution -> Substitution . eq removeSame(V <- V ; Subst) = removeSame(Subst) . eq removeSame(Subst) = Subst [owise] . --- Remove Variables from list ---------------------- op _intersect_ : TermList TermList -> TermList . eq (TL1,T,TL2) intersect (TL1',T,TL2') = (T,((TL1,TL2) intersect (TL1',TL2'))) . eq TL intersect TL' = empty [owise] . op _intersectVar_ : TermList TermList -> TermList . eq TL1 intersectVar TL2 = TL1 intersectVar* Vars(TL2) . op _intersectVar*_ : TermList TermList -> TermList . eq (T,TL1) intersectVar* TL2 = (if any Vars(T) in TL2 then T else empty fi,TL1 intersectVar* TL2) . eq empty intersectVar* TL2 = empty . --- Remove Variables from list ---------------------- op _setMinus_ : TermList TermList -> TermList . eq (TL1,T,TL2) setMinus (TL1',T,TL2') = (TL1,TL2) setMinus (TL1',T,TL2') . eq TL setMinus TL' = TL [owise] . --- Variables --- op Vars : GTermList -> TermList . eq Vars((T,TL:GTermList)) = VarsTerm(T),Vars(TL:GTermList) . eq Vars((Ct,TL:GTermList)) = VarsTerm(Ct),Vars(TL:GTermList) . eq Vars(empty) = empty . op VarsTerm : Term -> TermList . ---warning memo eq VarsTerm(V) = V . eq VarsTerm(F[TL:TermList]) = Vars(TL:TermList) . eq VarsTerm(C) = empty . op VarsTerm : Context -> TermList . ---warning memo eq VarsTerm(F[TL:GTermList]) = Vars(TL:GTermList) . --- membership --- op _in_ : Term TermList -> Bool . eq T in (TL,T,TL') = true . eq T in TL = false [owise] . --- membership --- op any_in_ : TermList TermList -> Bool . --- [memo] . eq any empty in TL = false . eq any (TL1,T,TL2) in (TL1',T,TL2') = true . eq any TL in TL' = false [owise] . --- membership --- op all_in_ : TermList TermList -> Bool . --- [memo] . eq all empty in TL = true . eq all (TL1,T,TL2) in (TL1',T,TL2') = all (TL1,TL2) in (TL1',T,TL2') . eq all TL in TL' = false [owise] . --- Occur check --- op allVars_inVars_ : GTermList GTermList -> Bool . eq allVars TL:GTermList inVars TL':GTermList = all Vars(TL:GTermList) in Vars(TL':GTermList) . op anyVars_inVars_ : GTermList GTermList -> Bool . eq anyVars TL:GTermList inVars TL':GTermList = any Vars(TL:GTermList) in Vars(TL':GTermList) . op domainVars : Substitution -> TermList . eq domainVars(V <- T ; Subst) = (V,domainVars(Subst)) . eq domainVars(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 dom_notInVars_ : Substitution TermList -> Bool . eq dom Subst notInVars TL = dom Subst notIn Vars(TL) . op dom_notIn_ : Substitution TermList -> Bool . eq dom none notIn TL = true . ceq dom (V <- T ; Subst) notIn TL = true if not (V in TL) . eq dom Subst notIn TL = false [owise] . op range_inVars_ : Substitution TermList -> Bool . eq range Subst inVars TL = range Subst in Vars(TL) . op range_in_ : Substitution TermList -> Bool . eq range (V <- T ; Subst) in TL = any Vars(T) in TL or-else range Subst in TL . eq range none in TL = false . op valid-occur-check? : Substitution -> Bool . eq valid-occur-check?(Subst) = not (dom Subst inVars (rangeVars(Subst))) . op extract-bindings : Substitution -> TermList . eq extract-bindings(none) = empty . eq extract-bindings(V <- T ; Subst) = (T,extract-bindings(Subst)) . op isRenaming : Substitution -> Bool . eq isRenaming(none) = true . eq isRenaming((V <- V') ; Subst) = isRenaming(Subst) . eq isRenaming((V <- T) ; Subst) = false [owise] . endfm fmod TERMSET is protecting META-LEVEL-MNPA . 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-MNPA . 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 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 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 fi 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-MNPA . 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 |) . --- Remove bindings same variable ------------------- op removeSame : SubstitutionSet -> SubstitutionSet . ceq removeSame(Subst | SS) = removeSame(Subst) | removeSame(SS) if SS =/= empty . eq removeSame(empty) = empty . 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 split : UnificationPairSet Term -> UnificationTripleSet . eq split(empty,T) = empty . eq split({S,N} | UPS,T) = {S |> T, S \\ (S |> T),N} | split(UPS,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-MNPA . 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' TP1 TP2 : Type . var TPL TPL' : TypeList . ---var TPL TPL' : ETypeList . ---var ET ET' : EType . var VDS OPDS : OpDeclSet . var OPD : OpDecl . vars M 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) . op normalize : Module SModule -> SModule . eq normalize(M, 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 normalize(M,E:EquationSet) R:RuleSet endm . op normalize : Module FModule -> FModule . eq normalize(M, 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 normalize(M,E:EquationSet) endfm . op normalize : Module EquationSet -> EquationSet . eq normalize(M,(eq T = T' [AtS] .) EqS) = (eq T = normalize(M,T') [AtS] .) normalize(M,EqS) . eq normalize(M,(ceq T = T' if Cond [AtS] .) EqS) = (ceq T = normalize(M,T') if Cond [AtS] .) normalize(M,EqS) . eq normalize(M,(none).EquationSet) = (none).EquationSet . *** 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 -> OpDeclSet [memo] . op getOpsOfQid : Module Qid TypeList -> OpDeclSet [memo] . op getOpsOfQid : Module OpDeclSet Qid -> OpDeclSet . op getOpsOfQid : Module OpDeclSet Qid TypeList -> OpDeclSet . eq getOpsOfQid(M,F) = getOpsOfQid(M,getOps(M),F) . 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) = (op F : TPL -> TP [AtS] .) getOpsOfQid(M,OPDS,F) . eq getOpsOfQid(M,OPDS,F') = none [owise] . 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) . *** getOpsOfEqs ****************************************************** op getOpsOfEqs : EquationSet -> QidList [memo] . eq getOpsOfEqs((eq C = T' [AtS] .) EqS ) = C getOpsOfEqs(EqS) . eq getOpsOfEqs((eq F[TL] = T' [AtS] .) EqS ) = F getOpsOfEqs(EqS) . eq getOpsOfEqs((none).EquationSet) = nil . *** 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) . *** 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 . op removeVariantLabel : SModule -> SModule . eq removeVariantLabel( mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm) = mod (addsufix '-EQSV2EQSNV To Q:Qid) is IL:ImportList sorts S:SortSet . S:SubsortDeclSet O:OpDeclSet M:MembAxSet removeVariantLabel(E:EquationSet) R:RuleSet endm . op removeVariantLabel : FModule -> SModule . eq removeVariantLabel( fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet endfm) = fmod (addsufix '-EQSV2EQSNV To Q:Qid) is IL:ImportList sorts S:SortSet . S:SubsortDeclSet O:OpDeclSet M:MembAxSet removeVariantLabel(E:EquationSet) endfm . op removeVariantLabel : EquationSet -> EquationSet . eq removeVariantLabel((eq Lhs = Rhs [AtS variant] .) EqS) = (eq Lhs = Rhs [AtS] .) removeVariantLabel(EqS) . eq removeVariantLabel(EqS) = EqS [owise] . *** 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 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 variant] .) EqS) = (eq Lhs = Rhs [AtS 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 variant] .) EqS) = (eq Lhs = Rhs [AtS 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 . 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 . 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 . op addEqs : EquationSet FModule -> FModule . 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 . op addSorts : SortSet FModule -> FModule . 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] . *** putNarrowing ******************************* op putNarrowing : SModule -> SModule [memo] . eq putNarrowing( 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 putNarrowing(R:RuleSet) endm . op putNarrowing : RuleSet -> RuleSet . eq putNarrowing(none) = none . eq putNarrowing((rl Lhs => Rhs [AtS] .) RlS:RuleSet) = (rl Lhs => Rhs [narrowing AtS] .) putNarrowing(RlS:RuleSet) . eq putNarrowing((crl Lhs => Rhs if Cond [AtS] .) RlS:RuleSet) = (crl Lhs => Rhs if Cond [narrowing AtS] .) putNarrowing(RlS:RuleSet) . *** 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 changeNonSupportedAttr : Module -> Module [memo] . eq changeNonSupportedAttr( (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)) = (mod (addsufix '-CHANGED-NONSUPPORTED-ATTRIBUTED To Q:Qid) is IL:ImportList sorts S:SortSet . S:SubsortDeclSet changeNonSupportedAttr*(O:OpDeclSet) M:MembAxSet changeNonSupportedAttr*(O:OpDeclSet,E:EquationSet) R:RuleSet endm) . eq changeNonSupportedAttr( (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet endfm)) = (fmod (addsufix '-CHANGED-NONSUPPORTED-ATTRIBUTED To Q:Qid) is IL:ImportList sorts S:SortSet . S:SubsortDeclSet changeNonSupportedAttr*(O:OpDeclSet) M:MembAxSet changeNonSupportedAttr*(O:OpDeclSet,E:EquationSet) endfm) . op changeNonSupportedAttr* : OpDeclSet -> OpDeclSet . ceq changeNonSupportedAttr*((op F : TPL -> TP [assoc id(T) AtS] .) OPDS) = changeNonSupportedAttr*((op F : TPL -> TP [assoc AtS] .) OPDS) if not comm in AtS . ceq changeNonSupportedAttr*((op F : TPL -> TP [assoc left-id(T) AtS] .) OPDS) = changeNonSupportedAttr*((op F : TPL -> TP [assoc AtS] .) OPDS) if not comm in AtS . ceq changeNonSupportedAttr*((op F : TPL -> TP [assoc right-id(T) AtS] .) OPDS) = changeNonSupportedAttr*((op F : TPL -> TP [assoc AtS] .) OPDS) if not comm in AtS . eq changeNonSupportedAttr*(OPDS) = OPDS [owise] . op changeNonSupportedAttr* : OpDeclSet EquationSet -> EquationSet . ceq changeNonSupportedAttr*((op F : TP1 TP2 -> TP [assoc id(T) AtS] .) OPDS,EqS) = changeNonSupportedAttr*(OPDS, (eq F[addType TP1 ToVar 'X,T] = addType TP1 ToVar 'X [variant] .) (eq F[T,addType TP2 ToVar 'X] = addType TP2 ToVar 'X [variant] .) EqS) if not comm in AtS . ceq changeNonSupportedAttr*((op F : TP1 TP2 -> TP [assoc left-id(T) AtS] .) OPDS,EqS) = changeNonSupportedAttr*(OPDS, (eq F[T,addType TP2 ToVar 'X] = addType TP2 ToVar 'X [variant] .) EqS) if not comm in AtS . ceq changeNonSupportedAttr*((op F : TP1 TP2 -> TP [assoc right-id(T) AtS] .) OPDS,EqS) = changeNonSupportedAttr*(OPDS, (eq F[addType TP1 ToVar 'X,T] = addType TP1 ToVar 'X [variant] .) EqS) if not comm in AtS . eq changeNonSupportedAttr*(OPDS,EqS) = EqS [owise] . op _in_ : Attr AttrSet -> Bool . eq X:Attr in X:Attr XS:AttrSet = true . eq X:Attr in XS:AttrSet = false [owise] . endfm fmod VARIANT is pr SUBSTITUTION-HANDLING . pr MODULE-HANDLING . pr META-LEVEL-MNPA . var M : Module . vars T T' TS TS' CtTS CtTS' Lhs Rhs : Term . vars N N' NextVar NextVar' NextVar'' : Nat . var B : Bound . var TL TL' : TermList . var NeTL : NeTermList . var EqS : EquationSet . var AtS : AttrSet . var Q : Qid . vars S S' : Substitution . var V : Variable . vars TP TP' : Type . var C : Constant . vars F F' : Qid . --- Variants ---------------------------------------------------------- --- sort Variant . --- op {_,_,_,_,_} : Term Substitution Nat Parent Bool -> Variant [ctor] . sort VariantTripleSet . --- subsort VariantTriple < VariantTripleSet . subsort Variant < VariantTripleSet . op empty : -> VariantTripleSet [ctor] . op _|_ : VariantTripleSet VariantTripleSet -> VariantTripleSet [ctor assoc comm id: empty prec 65 format (d d n d)] . --- eq X:VariantTriple | X:VariantTriple = X:VariantTriple . eq X:Variant | X:Variant = X:Variant . op getTerms : VariantTripleSet -> TermSet . eq getTerms({T:Term,S:Substitution,NextVar:Nat,P:Parent,B:Bool} | R:VariantTripleSet) = T:Term | getTerms(R:VariantTripleSet) . eq getTerms((empty).VariantTripleSet) = emptyTermSet . op getSubstitutions : VariantTripleSet -> SubstitutionSet . eq getSubstitutions({T:Term,S:Substitution,NextVar:Nat,P:Parent,B:Bool} | R:VariantTripleSet) = S:Substitution | getSubstitutions(R:VariantTripleSet) . eq getSubstitutions((empty).VariantTripleSet) = empty . --- 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 . endfm fmod META-MINIMIZE-BINDINGS is pr SUBSTITUTION-HANDLING . pr MODULE-HANDLING . pr SUBSTITUTIONSET . pr UNIFICATIONTRIPLESET . pr CONVERSION . pr META-LEVEL-MNPA . pr VARIANT . 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 . vars VTS VTS' : VariantFourSet . --- moveBindingsInputTerm op moveBindingsInputTerm : TermList UnificationTripleSet -> UnificationTripleSet . eq moveBindingsInputTerm(TL,US) = moveBindingsInputTerm(TL,empty,US) . op moveBindingsInputTerm : TermList UnificationTripleSet UnificationTripleSet -> UnificationTripleSet . eq moveBindingsInputTerm(TL,US',empty) = US' . eq moveBindingsInputTerm(TL,US',{S,S',N} | US) = moveBindingsInputTerm(TL,US' | moveBindingsInputTerm*(TL,{S,S',N}),US) . op moveBindingsInputTerm* : TermList UnificationTriple -> UnificationTriple . ceq moveBindingsInputTerm*(TL,{S,V <- T ; S',N}) = moveBindingsInputTerm*(TL,{S ; V <- T, S',N}) if V in TL . eq moveBindingsInputTerm*(TL,{S,S',N}) = {S,S',N} [owise] . op moveBindingsInputTerm : TermList VariantFourSet -> VariantFourSet . eq moveBindingsInputTerm(TL,VTS) = moveBindingsInputTerm(TL,empty,VTS) . op moveBindingsInputTerm : TermList VariantFourSet VariantFourSet -> VariantFourSet . eq moveBindingsInputTerm(TL,VTS',empty) = VTS' . eq moveBindingsInputTerm(TL,VTS',{T,S,S',N} | VTS) = moveBindingsInputTerm(TL,VTS' | moveBindingsInputTerm*(TL,{T,S,S',N}),VTS) . op moveBindingsInputTerm* : TermList VariantFour -> VariantFour . ceq moveBindingsInputTerm*(TL,{T,S,S',N}) = {T,S*,S'*,N} if {S*,S'*,N} := moveBindingsInputTerm*(TL,{S,S',N}) . --- minimizeBindings --- op minimizeBindings : Module TermList UnificationTripleSet -> UnificationTripleSet . eq minimizeBindings(M,TL,US) = minimizeBindings(M,TL,highestVar(TL),US) . op minimizeBindings : Module TermList Nat UnificationTripleSet -> UnificationTripleSet . eq minimizeBindings(M,TL,NOld,US) = minimizeBindings*(M,TL,NOld,US,empty) . op minimizeBindings* : Module TermList Nat UnificationTripleSet UnificationTripleSet -> UnificationTripleSet . eq minimizeBindings*(M,TL,NOld,empty,US') = US' . eq minimizeBindings*(M,TL,NOld,{S,S',N} | US,US') = minimizeBindings*(M,TL,NOld,US, US' | minimizeBindings**(M,TL,NOld,{S,S',N},S,S') ) . **************** op minimizeBindings** : Module TermList ---variables to minimize bindings Nat --- or maximum index of variables UnificationTriple Substitution Substitution -> UnificationTriple . eq minimizeBindings**(M,TL',NOld,{S*,S'*,N},none,none) = {remDup(S*),remDup(S'*),N} . ceq minimizeBindings**(M,TL',NOld,{S*,V <- V' ; S'*,N},none,V <- V' ; S') = minimizeBindings**(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 minimizeBindings**(M,TL',NOld,{S*,V <- T' ; S'*,N},none,V <- T' ; S') = minimizeBindings**(M,TL',NOld,{S*,V <- T' ; S'*,N},none,S') [owise] . ceq minimizeBindings**(M,TL',NOld,{V <- V' ; S*,S'*,N},V <- V' ; S,S') = minimizeBindings**(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 minimizeBindings**(M,TL',NOld,{V <- T' ; S*,S'*,N},V <- T' ; S,S') = minimizeBindings**(M,TL',NOld,{V <- T' ; S*,S'*,N},S,S') [owise] . --- minimizeBindings --- op minimizeBindings : Module TermList VariantFourSet -> VariantFourSet . eq minimizeBindings(M,TL,VTS) = minimizeBindings(M,TL,highestVar(TL),VTS) . op minimizeBindings : Module TermList Nat VariantFourSet -> VariantFourSet . eq minimizeBindings(M,TL,NOld,VTS) = minimizeBindings*(M,TL,NOld,VTS,empty) . op minimizeBindings* : Module TermList Nat VariantFourSet VariantFourSet -> VariantFourSet . eq minimizeBindings*(M,TL,NOld,empty,VTS') = VTS' . ceq minimizeBindings*(M,TL,NOld,{T,S,S',N} | VTS,VTS') = minimizeBindings*(M,TL,NOld,VTS, VTS' | {T << (S* ; S'*),S*,S'*,N} ) if {S*,S'*,N} := minimizeBindings**(M,TL,NOld,{S,S',N},S,S') . **** op remDup : Substitution -> Substitution . eq remDup(V <- V ; S) = remDup(S) . eq remDup(S) = S [owise] . endfm fmod TYPEOFNARROWING is pr QID . pr META-TERM . --- 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] . *** Irreducible terms for equational unification to check op irrTerms : TermList -> TypeOfNarrowingElem [ctor] . op getIrrTerms : TypeOfNarrowing -> TermList . eq getIrrTerms(X:TypeOfNarrowing irrTerms(TL:TermList)) = TL:TermList . eq getIrrTerms(X:TypeOfNarrowing) = empty [owise] . *** 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-MNPA . protecting TERM-HANDLING . protecting SUBSTITUTION-HANDLING . protecting RENAMING . protecting SUBSTITUTIONSET . protecting UNIFICATIONTRIPLESET . protecting MODULE-HANDLING . protecting META-MINIMIZE-BINDINGS . 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 toResultContextSet : NarrowingApplyResult -> ResultContextSet . eq toResultContextSet( {T:Term,TP:Type,Ct:Context,Q:Qid,S:Substitution,S#:Substitution,Q#:Qid} ) = {T:Term,TP:Type, S:Substitution,S#:Substitution, Ct:Context,Ct:Context << S:Substitution, T:Term,T:Term << S:Substitution, max(highestVar(S:Substitution),highestVar((T:Term,T:Term << S:Substitution))) + 1, nil, empty} . op metaNarrowingApplyCollect : Module Term TermList Qid -> ResultContextSet . eq metaNarrowingApplyCollect(M:Module,T:Term,TL:TermList,Q:Qid) = metaNarrowingApplyCollect#(M:Module,T:Term,TL:TermList,Q:Qid,0) . op metaNarrowingApplyCollect# : Module Term TermList Qid Nat -> ResultContextSet . eq metaNarrowingApplyCollect#(M:Module,T:Term,TL:TermList,Q:Qid,I:Nat) = if metaNarrowingApply(M:Module,T:Term,TL:TermList,Q:Qid,I:Nat) :: NarrowingApplyResult then toResultContextSet( minimizeBindingsNR(M,Vars(T:Term),highestVar(T:Term), metaNarrowingApply(M:Module,T:Term,TL:TermList,Q:Qid,I:Nat))) | metaNarrowingApplyCollect#(M:Module,T:Term,TL:TermList,Q:Qid,I:Nat + 1) else empty fi . op minimizeBindingsNR : Module TermList Nat NarrowingApplyResult -> NarrowingApplyResult . ceq minimizeBindingsNR(M,TL:TermList,N:Nat, {T:Term,TP:Type,Ct:Context,Q:Qid,S:Substitution,S#:Substitution,Q#:Qid}) = {T:Term << (S*:Substitution ; S#*:Substitution), TP:Type, Ct:Context << (S*:Substitution ; S#*:Substitution), Q:Qid, S*:Substitution |> TL:TermList, S#*:Substitution |> domainVars(S#:Substitution), Q#:Qid} if {S*:Substitution,S#*:Substitution,N:Nat} := minimizeBindings(M,TL:TermList,{S:Substitution,S#:Substitution,N:Nat}) . 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,S:Substitution,TP$:Type,R:Rule}) --- Subst none here is special << {Subst,Subst',N} = (Tr:TraceNarrow {T$:Term << (Subst ; Subst'),S:Substitution .. (Subst ; Subst'),TP$:Type,R:Rule}) . op canonice : Module TraceNarrow -> TraceNarrow . eq canonice(M, (nil).TraceNarrow) = nil . eq canonice(M, Tr:TraceNarrow {T$:Term,S:Substitution,TP$:Type,R:Rule}) = {canonice(M,T$:Term),canonice(M,S:Substitution),TP$:Type,R:Rule} canonice(M, Tr:TraceNarrow) . 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-MNPA . 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-HANDLING is pr SUBSTITUTION-HANDLING . pr META-MINIMIZE-BINDINGS . pr RESULT-CONTEXT-SET . pr MODULE-HANDLING . pr META-LEVEL-MNPA . pr VARIANT . 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 . var VTS : VariantFourSet . var VT3S : VariantTripleSet . 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,NextVar,none,false} | toVariantTripleSet(VTS) . op toVariantFourSet : VariantTripleSet -> VariantFourSet . eq toVariantFourSet(empty) = empty . eq toVariantFourSet({T,S,NextVar,none,false} | VT3S) = {T,S,none,NextVar} | toVariantFourSet(VT3S) . 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' S* : Substitution . vars Ct CtS Ct' CtS' : Context . vars TS TS' CtTS CtTS' : Term . 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 : ResultContextSet -> ResultContextSet . eq unrigidLabel((empty).ResultContextSet) = empty . eq unrigidLabel({T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} | RTS:ResultContextSet) = {unrigidLabel(T),TP,unrigidLabel(S),unrigidLabel(S*),Ct,CtS,unrigidLabel(TS),unrigidLabel(CtTS),NextVar,unrigidLabel(Tr:TraceNarrow),B:Flags} | unrigidLabel(RTS:ResultContextSet) . op unrigidLabel : TraceNarrow -> TraceNarrow . eq unrigidLabel((nil).TraceNarrow) = nil . eq unrigidLabel(Tr:TraceNarrow {CtTS:Term,Subst:Substitution,TP:Type,R:Rule}) = unrigidLabel(Tr:TraceNarrow) {unrigidLabel(CtTS:Term),unrigidLabel(Subst:Substitution),TP:Type,R:Rule} . 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-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-MNPA . pr VARIANT . pr RIGIDIFE . *** 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 TermList Term Term Nat -> UnificationTripleSet . op metaBuiltInUnify? : Module TermList 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 TermList -> SubstitutionSet . --- Term Lhs eq metaECoreUnify(M, T, T',TL) = metaEACUUnify(M, T, T',TL) . op metaECoreUnify? : Module Term Term TermList -> Bool . eq metaECoreUnify?(M, T, T', TL) = metaEACUUnify?(M, T, T', TL) . --- metaVariantUnify -------------------------------------------------- op metaVariantUnify : Module Term Term -> SubstitutionSet . eq metaVariantUnify(M, T, T') = metaEACUUnify(M, T, T', empty) . op metaVariantUnify : Module Term Term TermList -> SubstitutionSet . eq metaVariantUnify(M, T, T', TL) = metaEACUUnify(M, T, T', TL) . op metaVariantUnify? : Module Term Term TermList -> Bool . eq metaVariantUnify?(M, T, T', TL) = metaEACUUnify?(M, T, T', TL) . op metaVariantUnify : Module Term Term Nat IrrFlags -> UnificationTripleSet . eq metaVariantUnify(M, T, T',NextVar,IRR) = metaEACUUnify(M, T, T',empty,NextVar,IRR) . op metaVariantUnify : Module Term Term TermList Nat IrrFlags -> UnificationTripleSet . eq metaVariantUnify(M, T, T',TL,NextVar,IRR) = metaEACUUnify(M, T, T',TL,NextVar,IRR) . op metaVariantUnify? : Module Term Term TermList Nat IrrFlags -> Bool . eq metaVariantUnify?(M, T, T',TL,NextVar,IRR) = metaEACUUnify?(M, T, T',TL,NextVar,IRR) . --- metaEACUUnify -------------------------------------------------- op metaEACUUnify : Module Term Term TermList -> SubstitutionSet . eq metaEACUUnify(M, T, T', TL) = toSubstitution(metaEACUUnify(M,T,T',TL,highestVar((T,T',TL)) + 1,reducible)) . op metaEACUUnify? : Module Term Term TermList -> Bool . eq metaEACUUnify?(M, T, T', TL) = metaEACUUnify?(M,T,T',TL,highestVar((T,T',TL)) + 1,reducible) . op metaEACUUnifyIrr : Module Term Term TermList -> SubstitutionSet . --- T irreducible T' reducible eq metaEACUUnifyIrr(M, T, T',TL) = toSubstitution(metaEACUUnify(M,T,T',TL,highestVar((T,T',TL)) + 1,irreducible)) . op metaEACUUnifyIrr? : Module Term Term TermList -> Bool . eq metaEACUUnifyIrr?(M, T, T', TL) = metaEACUUnify?(M,T,T',TL,highestVar((T,T',TL)) + 1,irreducible) . op metaEACUUnify : Module Term Term TermList Nat IrrFlags -> UnificationTripleSet . eq metaEACUUnify(M, T, T',TL,NextVar,IRR) = minimizeBindings(M,Vars(T),NextVar, metaEUnify&(M, T, T',TL,NextVar,ACUUnify IRR) ) |> (T,T',TL) . op metaEACUUnify? : Module Term Term TermList Nat IrrFlags -> Bool . eq metaEACUUnify?(M, T, T',TL,NextVar,IRR) = metaEUnify&?(M, T, T',TL,NextVar,ACUUnify IRR) . --- metaEBuiltInUnify -------------------------------------------------- op metaEBuiltInUnify : Module Term Term -> SubstitutionSet . eq metaEBuiltInUnify(M, T, T') = metaEBuiltInUnify(M, T, T',empty) . op metaEBuiltInUnify : Module Term Term TermList -> SubstitutionSet . eq metaEBuiltInUnify(M, T, T', TL) = toSubstitution(metaEBuiltInUnify(M,T,T',TL,highestVar((T,T',TL)) + 1,reducible)) . op metaEBuiltInUnify? : Module Term Term -> Bool . eq metaEBuiltInUnify?(M, T, T') = metaEBuiltInUnify?(M, T, T',empty) . op metaEBuiltInUnify? : Module Term Term TermList -> Bool . eq metaEBuiltInUnify?(M, T, T',TL) = metaEBuiltInUnify?(M,T,T',TL,highestVar((T,T',TL)) + 1,reducible) . op metaEBuiltInUnifyIrr : Module Term Term -> SubstitutionSet . eq metaEBuiltInUnifyIrr(M, T, T') = metaEBuiltInUnifyIrr(M, T, T', empty) . op metaEBuiltInUnifyIrr : Module Term Term TermList -> SubstitutionSet . --- T irreducible T' reducible eq metaEBuiltInUnifyIrr(M, T, T', TL) = toSubstitution( metaEBuiltInUnify(M,T,T',TL,highestVar((T,T',TL)) + 1,irreducible) ) . op metaEBuiltInUnifyIrr? : Module Term Term -> Bool . eq metaEBuiltInUnifyIrr?(M, T, T') = metaEBuiltInUnifyIrr?(M, T, T', empty) . op metaEBuiltInUnifyIrr? : Module Term Term TermList -> Bool . --- T irreducible T' reducible eq metaEBuiltInUnifyIrr?(M, T, T', TL) = metaEBuiltInUnify?(M,T,T',TL,highestVar((T,T',TL)) + 1,irreducible) . op metaEBuiltInUnify : Module Term Term TermList Nat IrrFlags -> UnificationTripleSet . eq metaEBuiltInUnify(M, T, T',TL,NextVar,IRR) = minimizeBindings(M,Vars(T),NextVar, metaEUnify&(M, T, T',TL,NextVar,BuiltInUnify IRR) ) |> (T,T') . op metaEBuiltInUnify? : Module Term Term TermList Nat IrrFlags -> Bool . eq metaEBuiltInUnify?(M, T, T',TL,NextVar,IRR) = metaEUnify&?(M, T, T',TL,NextVar,BuiltInUnify IRR) . --- metaEUnify -------------------------------------------------- op metaEUnify& : Module Term Term TermList Nat EFlags -> UnificationTripleSet . --- Term Lhs eq metaEUnify&(M,T,T',TL,NextVar,EF) = if sameKind(M,leastSort(M,T),leastSort(M,T')) then metaEUnify&*(removeBoolEqs(M),T,T',TL,NextVar,EF) else empty fi . op metaEUnify&? : Module Term Term TermList Nat EFlags -> Bool . --- Term Lhs eq metaEUnify&?(M,T,T',TL,NextVar,EF) = sameKind(M,leastSort(M,T),leastSort(M,T')) and-then metaEUnify&*?(removeBoolEqs(M),T,T',TL,NextVar,EF) . op metaEUnify&* : Module Term Term TermList Nat EFlags -> UnificationTripleSet . --- Term Lhs eq metaEUnify&*(M,T,T',TL,NextVar,EF) = if metaBuiltInUnify?(M,TL, 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,TL,T,T',NextVar) else metaEUnify$(M,T,T',TL,NextVar,EF) fi else empty fi . op metaEUnify&*? : Module Term Term TermList Nat EFlags -> Bool . --- Term Lhs eq metaEUnify&*?(M,T,T',TL,NextVar,EF) = if metaBuiltInUnify?(M,TL, 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,TL,T,T',NextVar) else metaEUnify$?(M,T,T',TL,NextVar,EF) fi else false fi . op metaEUnify$ : Module Term Term TermList Nat EFlags -> UnificationTripleSet . --- Term Lhs eq metaEUnify$(M,T,T',TL,NextVar,irreducible EF) = metaEUnifyCollect(M,T,T',(T,TL),NextVar,0,empty) . eq metaEUnify$(M,T,T',TL,NextVar,EF) = metaEUnifyCollect(M,T,T',TL,NextVar,0,empty) [owise] . op metaEUnify$? : Module Term Term TermList Nat EFlags -> Bool . --- Term Lhs eq metaEUnify$?(M,T,T',TL,NextVar,irreducible EF) = metaEUnifyCollect?(M,T,T',(T,TL),NextVar,0) . eq metaEUnify$?(M,T,T',TL,NextVar,EF) = metaEUnifyCollect?(M,T,T',TL,NextVar,0) [owise] . op metaEUnifyCollect : Module Term Term TermList Nat Nat UnificationTripleSet -> UnificationTripleSet . eq metaEUnifyCollect(M,T,T',TL,N,N',US) = if metaEUnify*(M,T =? T',TL,N,N') :: UnificationTriple? and metaEUnify*(M,T =? T',TL,N,N') =/= noUnifier then metaEUnifyCollect(M,T,T',TL,N,s(N'), US | metaEUnify*(M,T =? T',TL,N,N') ) else US fi . op metaEUnifyCollect? : Module Term Term TermList Nat Nat -> Bool . eq metaEUnifyCollect?(M,T,T',TL,N,N') = metaEUnify*(M,T =? T',TL,N,N') :: UnificationTriple? and metaEUnify*(M,T =? T',TL,N,N') =/= noUnifier . *** Code for collection all unifiers op metaEUnify* : Module UnificandPair TermList Nat Nat ~> UnificationTriple? . eq metaEUnify*(M, T =? T',TL,N,N') = metaEUnifyTriple( M, unflatten(M,T) =? unflatten(M,T'), TL,N,N') . op metaEUnifyTriple : Module UnificationProblem TermList Nat Nat ~> UnificationTriple? . eq metaEUnifyTriple(M,T =? T',TL,N,N') = if metaVariantUnify(M,T =? T',TL,N,N') == noUnifier then noUnifier else {getSubst(metaVariantUnify(M,T =? T',TL,N,N')) |> T, getSubst(metaVariantUnify(M,T =? T',TL,N,N')) |> T', getNextVar(metaVariantUnify(M,T =? T',TL,N,N'))} fi . ************************************** ***** Variant Generation op getVariants : Module Term -> VariantFourSet . eq getVariants(M,T) = getVariants(M,T,highestVar(T) + 1) . op getVariants : Module Term Nat -> VariantFourSet . eq getVariants(M,T,NextVar) = getVariants(M,T,NextVar,reducible BuiltInUnify) . op getVariants : Module Term Nat TermList -> VariantFourSet . eq getVariants(M,T,NextVar,TL) = getVariants(M,T,NextVar,reducible BuiltInUnify,TL) . op getVariants : Module Term Nat EFlags -> VariantFourSet . eq getVariants(M,T,NextVar,EF) = getVariants(M,T,NextVar,EF,empty) . op getVariants : Module Term Nat EFlags TermList -> VariantFourSet . eq getVariants(M,T,NextVar,EF,TL) = unrigidife(qid(NextVar), getVariants*( getM(rigidifeRigid(M,qid(NextVar),T)), getTL(rigidifeRigid(M,qid(NextVar),T)), NextVar + 1,EF,TL ) ) . op getVariants* : Module Term Nat EFlags TermList -> VariantFourSet . eq getVariants*(M,T,NextVar,EF,TL) = if howMany(onlyEqsVariant(M),T) == 0 then {T,none,none,NextVar} else if getVariants**(M,T,NextVar,EF,TL) :: VariantFourSet and getVariants**(M,T,NextVar,EF,TL) =/= empty then getVariants**(M,T,NextVar,EF,TL) else {T,none,none,NextVar} fi fi . op getVariants** : Module Term Nat EFlags TermList -> VariantFourSet . eq getVariants**(M,T,NextVar,EF,TL) = minimizeBindings(M,Vars(T),NextVar, getVariants***(M,T,NextVar,empty,0,TL) ) . op getVariants*** : Module Term Nat VariantFourSet Nat TermList -> VariantFourSet . eq getVariants***(M,T,NextVar,VTS,N,TL) = if metaGetVariant(M,T,TL,NextVar,N) == noVariant then VTS else getVariants***$(M,T,NextVar,VTS,N, metaGetVariant(M,T,TL,NextVar,N),TL) fi . op getVariants***$ : Module Term Nat VariantFourSet Nat Variant TermList -> VariantFourSet . eq getVariants***$(M,T,NextVar,VTS,N,{T2:Term,S:Substitution,NV2:Nat,P:Parent,B:Bool},TL) = getVariants***$$(M,T,NextVar,VTS,N,{T2:Term,S:Substitution,NV2:Nat,P:Parent,B:Bool}, split({S:Substitution,NV2:Nat},NextVar),TL) . op getVariants***$$ : Module Term Nat VariantFourSet Nat Variant UnificationTriple TermList -> VariantFourSet . eq getVariants***$$(M,T,NextVar,VTS,N, {T2:Term,S:Substitution,NV2:Nat,P:Parent,B:Bool}, {S1:Substitution,S2:Substitution,NV2:Nat},TL) = getVariants***(M,T,NextVar, VTS | {T2:Term,S1:Substitution,S2:Substitution,NV2:Nat}, N + 1,TL) . 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) . endfm fmod META-ACU-UNIFICATION is pr TERM-HANDLING . pr SUBSTITUTION-HANDLING . pr MODULE-HANDLING . pr SUBSTITUTIONSET . pr UNIFICATIONPAIRSET . pr CONVERSION . pr META-LEVEL-MNPA . 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 minimizeBindings(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( changeNonSupportedAttr(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 HEunification is pr META-LEVEL-MNPA . 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 ******This version is modified such that it is more readable. this version is based on xor11.maude. fmod XorUnif is pr META-LEVEL-MNPA . ****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********** ******************************************** ***********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. ************************************** *******Buiding up Basic Term.*********** ************************************** ********************************************* ****Terms--Including Variable, constant, f[termlist]--, ***Termlist, UnificationPair"=? ", UnificaitonProblem : /\ , ****Assignment, Substitution etc are defined in prelude.maude. ******************************************************** ****If we can not find any problem. op noTheoryFoundProblem : -> UnificationProblem [ctor] . op IllegalEquationThere : -> UnificationProblem . eq IllegalEquationThere /\ UP = IllegalEquationThere . op FailEquation : -> UnificationProblem . ****** Buidling up the Exclusive Or terms.******** sorts XORTerm NeXORTerm . subsort Term < NeXORTerm < XORTerm . subsort XORTerm < TermList . subsort XORTerm < NeTermList . vars XT XT1 XT2 XT3 : XORTerm . vars NXT NXT1 NXT2 NXT3 : NeXORTerm . op XO : XORTerm XORTerm -> XORTerm [ctor assoc comm id: NilTerm] . op XO : NeXORTerm XORTerm -> NeXORTerm [ctor ditto] . op XO : XORTerm NeXORTerm -> NeXORTerm [ctor ditto] . op NilTerm : -> XORTerm [ctor] . op _[_] : Qid XORTerm -> Term [ctor] . eq XO(T , T) = NilTerm . ***Idemponent. **********anther form of unificaton pairs. Origianlly, it is Term =? Term, howevery here we add one. op _=?_ : XORTerm XORTerm -> UnificandPair [ctor prec 71] . op EmptyUnificandPair : -> UnificandPair [ctor] . ****there are no identities for /\ in prelude, we add them here. eq EmptyEq /\ UfPr = UfPr . ***identity in unification problem eq FailEquation /\ UfPr = FailEquation . ***if some equation is fail, whole problem will be fail. *******idemponent ************* eq UP /\ UP = UP . *****************DisEquations sorts DisEquation NeListOfDisEquations ListOfDisEquations . subsort DisEquation < NeListOfDisEquations < ListOfDisEquations . vars NXOE NXOE1 : DisEquation . vars NLE NLE1 : ListOfDisEquations . vars NNLE NNLE1 : NeListOfDisEquations . op _N=?_ : XORTerm XORTerm -> DisEquation [ctor] . *** op NilDisEquation : -> DisEquation [ctor] . op EmptyDisEq : -> ListOfDisEquations [ctor] . op _/\_ : ListOfDisEquations ListOfDisEquations -> ListOfDisEquations [ctor assoc comm id: EmptyDisEq format (d n d d)] . op _/\_ : NeListOfDisEquations ListOfDisEquations -> NeListOfDisEquations [ctor ditto] . op _/\_ : ListOfDisEquations NeListOfDisEquations -> NeListOfDisEquations [ctor ditto] . eq NXOE /\ NXOE = NXOE . *****Another form of Assignment. In prelude, assignment is Variable Term, however, here we add one. op _<-_ : Variable XORTerm -> Assignment [ctor prec 63 format (nt d d d)] . op fail : -> Assignment . ***********Substitutions sorts SubstitutionList NeSubstitutionList . ***Collection of all substitutions subsort Substitution < SubstitutionList . subsort Substitution < NeSubstitutionList . subsort NeSubstitutionList < SubstitutionList . vars SL SL1 SL2 : SubstitutionList . vars NSL NSL1 NSL2 : NeSubstitutionList . op _###_ : SubstitutionList SubstitutionList -> SubstitutionList [ctor assoc id: EmptySubstitution gather (e E) format (d y no d)] . op _###_ : NeSubstitutionList SubstitutionList -> NeSubstitutionList [ctor ditto] . op _###_ : SubstitutionList NeSubstitutionList -> NeSubstitutionList [ctor ditto] . op EmptySubstitution : -> SubstitutionList . op noneNoProblemFound : -> SubstitutionList [ctor] . ***If no problem was found . op noneNoTheoryFound : -> SubstitutionList [ctor] . ***If no theory declaration was found . *** eq SUB ### SUB = SUB . eq (SUB ### SL1 ### SUB) = (SUB ### SL1) . ***Idemponent *********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. sorts Problem NeProblemList ProblemList . subsort Problem < ProblemList . subsort NeProblemList < ProblemList . subsort Problem < NeProblemList . vars P P1 : Problem . vars PL PL1 PL2 : ProblemList . vars NPL NPL1 NPL2 : NeProblemList . op EmptyEq : -> UnificationProblem [ctor] . op FailProblem : -> Problem . op _||_||_||_ : UnificationProblem ListOfDisEquations UnificationProblem Int -> Problem [ctor format (d n d n d n d n)] . eq UfPr || NLE || FailEquation || N = FailProblem . op EmptyProblem : -> ProblemList [ctor] . op NoProblemFound : -> ProblemList [ctor] . op noTheoryFoundProblemP : -> ProblemList [ctor] . op _$$_ : ProblemList ProblemList -> ProblemList [ctor assoc id: EmptyProblem gather (E e) format (d d n d)]. op _$$_ : NeProblemList ProblemList -> NeProblemList [ctor ditto] . op _$$_ : ProblemList NeProblemList -> NeProblemList [ctor ditto] . eq (FailProblem $$ NPL) = NPL . eq NPL $$ FailProblem = NPL . eq (P $$ PL1 $$ P) = P $$ PL1 . ***idempotent. ******************Final Substitutions sorts FinalAss FinalSub . ***For converting back sort FinalList . ****For final solution and new variable counter subsort FinalAss < FinalSub . vars FASS : FinalAss . vars FS1 FS2 : FinalSub . 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 id: IDENTITY format (d ny on d)] . eq (FASS ; FASS) = FASS . op NoSolution : -> FinalSub [ctor] . 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. ***********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)] . ************************************************************* ****************operations************************************ ************************************************************* *****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 . *********getFV is used to get all the free variables op getFV : XORTerm UnificationProblem TermList -> TermList . op getFVL : TermList UnificationProblem TermList -> TermList . op getFVP : UnificandPair UnificationProblem TermList -> TermList . ceq getFV(V , UfPr, TL) = (V , TL) if IsInVL(V, TL) = false /\ occurs(V, UfPr , 0) = false . ceq getFV(V , UfPr, TL) = empty if IsInVL(V, TL) = true . eq getFV(V , UfPr, TL) = empty [owise] . eq getFV(C , UfPr , TL) = empty . eq getFV(QI1[TL1], UfPr , TL) = empty . eq getFV(QI1[XT], UfPr , TL) = empty . eq getFV(XO(T , NXT) , UfPr , TL) = getFV(T , UfPr , TL), getFV(NXT , UfPr, TL) . eq getFV(XO(T , NXT) , UP , TL) = getFV(T , UP , TL) , getFV(NXT , UP , TL) . eq getFVL((XT , TL1) , UfPr , TL) = (getFV(XT , UfPr , TL) , getFVL(TL1 , UfPr , TL)) . eq getFVL(empty , UfPr , TL) = TL . eq getFVP(XT =? NilTerm , UfPr , TL ) = getFV(XT , UfPr , TL) [owise] . *** eq getFVP(XT =? NilTerm , UfPr , TL) = getFV(XT , UfPr , TL) . ************************************************ **************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 : XORTerm Qid -> TermList . op getSameFunctions : TermList Qid -> TermList . eq getSameFunctions(XO(T, NXT), QI1) = (getSameFunctions(T, QI1) , getSameFunctions(NXT , QI1)) . eq getSameFunctions(QI1[TL], QI1) = QI1[TL] . eq getSameFunctions(empty, QI1) = empty . eq getSameFunctions(NilTerm, 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((XT, TL), QI1) = (getSameFunctions(XT, QI1), getSameFunctions(TL, QI1)). op getSameFunctions : UnificandPair Qid -> TermList . eq getSameFunctions((XT =? NilTerm) , QI1) = getSameFunctions(XT, 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((XT, TL), 1) = getOdd(TL, 0) . eq getOdd((XT, TL), 0) = getOdd(TL, 1) . eq getOdd(empty, N) = N . op getOdd : UnificandPair Int -> Int . eq getOdd(XT =? NilTerm, N) = getOdd(XT, N) . ******count the number of terms in a termlist . op getNumber : TermList -> Int . eq getNumber((XT, 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 , NXT)) = getType(T) . eq getType(QI1[XT , TL]) = getType(XT) . 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(P) = 0 [owise] . eq getNewNumL(PL $$ P) = getNewNum(P) . ***************************************************** *********the following operators are used for what the result after generating newvariable. sort NewVariableStatus . ***For purification op _,_,_ : TermList UnificationProblem Int -> NewVariableStatus [ctor] . op _,_,_ : XORTerm 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((XT, UfPr, N), (TL1, UfPr1, N1)) = ((XT, TL1), (UfPr /\ UfPr1), max(N , N1)) . ************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 : XORTerm -> TermList . eq PureVariableL((XT, TL)) = (PureVariable(XT), PureVariableL(TL)) . eq PureVariable(V) = V . eq PureVariable(C) = empty . eq PureVariableL(empty) = empty . eq PureVariable(NilTerm) = empty . eq PureVariable(XO(T, NXT)) = (PureVariableL(T), PureVariable(NXT)) . eq PureVariable(XT) = empty [owise] . ****************************************** **********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(_,_) : XORTerm Substitution -> XORTerm . eq Apply(T, none) = T . eq Apply(T, fail) = T . eq Apply(V, ((V <- XT) ; SUB)) = XT . ceq Apply(V, ((V1 <- XT) ; 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, NXT),SUB) = XO(Apply(T, SUB), Apply(NXT,SUB)) . *** ****Apply to TermList op Apply(_,_) : TermList Substitution -> TermList . eq Apply(TL, none) = TL . eq Apply(TL, fail) = TL . eq Apply((XT,TL1), SUB) = (Apply(XT, SUB), Apply(TL1, SUB)) . eq Apply((empty).TermList, SUB) = (empty).TermList . *** *****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(XT =? XT1, SUB) = (Apply(XT, SUB)=? Apply(XT1, SUB)) [owise] . eq Apply(EmptyUnificandPair, SUB) = EmptyUnificandPair . eq Apply (UP, fail) = FailEquation . eq Apply(UP, none) = UP . eq sApply(V =? XT, SUB) = (V =? Apply(XT, 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(XT N=? XT1, SUB) = (Apply(XT, SUB) N=? Apply(XT1, 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(NNLE /\ NNLE1, SUB) = (Apply(NNLE, SUB) /\ Apply(NNLE1, SUB)) . eq Apply(EmptyDisEq, SUB) = EmptyDisEq . eq Apply(NLE, none) = NLE . *** *****Apply to Substitution op Apply(_,_) : Substitution Substitution -> Substitution . eq Apply((V <- XT ; SUB), SUB1) = (V <- (Apply(XT,SUB1)) ; Apply(SUB, SUB1)) . eq Apply(SUB , none) = SUB . ceq Apply(SUB1 , SUB) = SUB1 if SUB1 == none . eq Apply((V <- V1 ; SUB), ((V <- XT); SUB1)) = Apply(SUB, (V <- XT ; V1 <- XT ; SUB1)) . eq Apply(fail, SUB) = fail . eq Apply(SUB, fail) = fail [owise] . *****Apply and add other non defined variables to substitution op CheckVinSub : Variable Substitution -> Bool . eq CheckVinSub(V , (V <- XT ; SUB)) = true . eq CheckVinSub(V , SUB) = false [owise] . op ApplyV(_ , _) : Substitution Substitution -> Substitution . eq ApplyV(SUB , none) = SUB . ceq ApplyV(SUB1 , SUB) = SUB1 if SUB1 == none . ceq ApplyV((SUB), (V <- XT ; SUB1)) = ApplyV((V <- XT ; SUB) , (V <- XT ; SUB1)) if CheckVinSub(V, SUB) == false . eq ApplyV((V <- XT ; SUB), SUB1) = RemoveID(V <- (Apply(XT,SUB1)) ; Apply(SUB, SUB1)) [owise] . eq ApplyV(fail, SUB) = fail . eq ApplyV(SUB, fail) = fail [owise] . op RemoveID : Substitution -> Substitution . eq RemoveID(V <- V ; SUB) = RemoveID(SUB) . eq RemoveID(SUB) = SUB [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 . **************************************** *******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('XOR-UNITY)]. eq QI1[QI3, QI3] = QI2[AtS2 label('XOR-NilPotent)]. 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('XOR-UNITY)]. eq QI1[QI3, QI3] = QI2[AtS2 label('XOR-NilPotent)]. 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('XOR-UNITY)]. eq QI1[QI3, QI3] = QI2[AtS2 label('XOR-NilPotent)]. Eqs1) = getType(QI2) . eq getNilType(opp) = 'noTheoryFound [owise] . op getXorType : EquationSet -> Qid . ****Get the type for the purpose of generated new variables , eq getXorType(Eqs eq QI1[QI2 , QI3] = QI3[AtS1 label('XOR-UNITY)]. eq QI1[QI3, QI3] = QI2[AtS2 label('XOR-NilPotent)]. Eqs1) = getType(QI3) . eq getXorType(opp) = 'noTheoryFound [owise] . ****************Converting********************** op ConvertXORtoTL : XORTerm TermList -> TermList . eq ConvertXORtoTL(T , TL) = (T, TL) . eq ConvertXORtoTL(XO(T, NXT), TL) = ConvertXORtoTL(NXT , (T, TL)) . eq ConvertXORtoTL(NilTerm , TL) = TL . *********The following is converting the datafile to our format. op ConvertXorNil : Qid Qid Qid Term -> XORTerm . op ConvertXorNilL : Qid Qid Qid TermList -> TermList . op ConvertProblem : Qid Qid Qid UnificationProblem -> UnificationProblem . 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, UP /\ UfPr2) = ConvertProblem(QI1, QI2, QI5, UP) /\ ConvertProblem(QI1, QI2, QI5, UfPr2) . eq ConvertProblem(QI1, QI2, QI5, T =? T1) = ((ConvertXorNil(QI1, QI2, QI5, T)) =? (ConvertXorNil(QI1, QI2, QI5, T1))) . eq ConvertProblem(QI1, QI2, QI5, UP) = IllegalEquationThere [owise] . eq ConvertXorNil(QI1 , QI2 , QI5, QI1[T , T1, NTL]) = XO(ConvertXorNil(QI1, QI2, QI5, T), ConvertXorNil(QI1, QI2, QI5, QI1[T1, NTL])) . eq ConvertXorNil(QI1 , QI2 , QI5, QI1[T , T1]) = XO(ConvertXorNil(QI1, QI2, QI5, T), ConvertXorNil(QI1, QI2, QI5, T1)) . 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] . **************************************** *******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 <- XT) = (V =? XT) . eq UnifToEq(none) = EmptyEq . ceq UnifToEq(AS ; SUB) = FailEquation if AS == fail . eq UnifToEq((AS ; SUB)) = UnifToEq(AS) /\ UnifToEq(SUB) . *******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 . **************************************************************************************** ***********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 XORTerm 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 , NXT), N) = occurs(V, T, N) or occurs(V, NXT, N) . *** *******occurs in termlist op occurs : Variable TermList Int -> Bool . eq occurs(V, (XT,TL), N) = (occurs(V, XT, 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, (XT, TL), N) = (occurs(V, XT, 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, (XT =? XT1), N) = (occurs(V, XT, N) or occurs(V, XT1, 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 : XORTerm -> Bool . eq noFreeVariable(V) = false . eq noFreeVariable(C) = true . eq noFreeVariable(QI1[TL]) = true . eq noFreeVariable(QI1[XT]) = true . eq noFreeVariable(XO(T, NXT)) = noFreeVariable((T)) and noFreeVariable(NXT) . eq noFreeVariable(NilTerm) = true . op noFreeVariable : TermList -> Bool . eq noFreeVariable(empty) = true . eq noFreeVariable((XT, TL)) = noFreeVariable(XT) and noFreeVariable(TL) . op noFreeVariable : UnificandPair -> Bool . eq noFreeVariable(XT =? NilTerm) = noFreeVariable(XT) . op noFreeVariable : UnificationProblem -> Bool . eq noFreeVariable((UP /\ UfPr)) = noFreeVariable(UP) and noFreeVariable(UfPr) . eq noFreeVariable(EmptyEq) = true . ************************* *****************check whether there 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 XORTerm -> Bool . eq PVOccurs((XT, TL), TL1) = PVOccursT(XT, TL1) and PVOccurs(TL, TL1) . eq PVOccursT(V, (XT, TL)) = occurs(V, XT, 0) or occurs(V, TL , 0) . eq PVOccurs(empty, TL) = true . eq PVOccurs(XT, empty) = false [owise] . ******************************* **************Che whether there Exclusive or symbol in the problem op XOoccurs : XORTerm Int -> Bool . op XOoccurs : TermList Int -> Bool . eq XOoccurs(XO(T, NXT) , 1) = true . eq XOoccurs(XO(T, NXT) , 0) = XOoccurs(T, 0) or XOoccurs(NXT , 0) . eq XOoccurs(QI1[TL] , N) = XOoccurs(TL, 1) . eq XOoccurs(QI1[XT] , N) = XOoccurs(XT, 1) . eq XOoccurs(C , N) = false . eq XOoccurs(V , N) = false . eq XOoccurs(NilTerm, N) = false . eq XOoccurs((XT , TL), N) = XOoccurs(XT , 1) or XOoccurs(TL , 1) . eq XOoccurs(empty, N) = false . op XOoccurs : UnificandPair Int -> Bool . eq XOoccurs((XT =? NilTerm), N) = (XOoccurs(XT , 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 . **************IsInVL is to check whether a variable in a list of variables. Here i use Termlist to represent the variable list. op IsInVL : Variable TermList -> Bool . eq IsInVL(V , (TL ,V, TL1)) = true . eq IsInVL(V , TL) = false [owise] . ************************************************** *********LessType is used to test whether a variable's type is less than other free variables. op LessTypeL : Module Variable TermList -> Bool . op LessType : Module Variable XORTerm -> Bool . eq LessTypeL(M, V , (XT, TL)) = (LessType(M, V , XT)) or (LessTypeL(M, V, TL)) . eq LessTypeL(M, V, empty) = false . eq LessTypeL(M, V, XT) = LessType(M, V, XT) . ceq LessType(M, V, V1) = false if getType(V) == getType(V1) . eq LessType(M, V, V1) = sortLeq(M, getType(V), getType(V1)) [owise] . ************************** ******************check whether this pair (which is supposed to be disequal)already occurs in the ListofDisEquations**** **********Test whether two terms are same. op isSame : XORTerm XORTerm -> 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 . eq isSame(XT, XT) = true . 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((XT , NeTL) , (XT1, NeTL1)) = (isSame(XT, XT1) 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, XT) = false if XT =/= NilTerm . ceq isSame(XT, NilTerm) = false if XT =/= NilTerm . eq isSameL(XT , XT1) = isSame(XT, XT1) . eq isSame(XT , XT1) = false [owise] . ***********check the pair occurs in disequation set or not. op POccurs : ListOfDisEquations DisEquation -> Bool . op POccurs : DisEquation DisEquation -> Bool . eq POccurs((NXOE /\ NNLE), NXOE1) = POccurs(NXOE, NXOE1) or POccurs(NNLE, NXOE1) . 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] . *** *************************************** *** ******Initialization******************** *** *************************************** ********Initialization is used for convert T=?T1 to T+T1=0 . op Initial_ : UnificationProblem -> UnificationProblem . eq Initial(XT =? XT1) = XO(XT , XT1) =? NilTerm . eq Initial(T =? T1) = XO(T , T1) =? NilTerm . eq Initial(T =? XT) = XO(T , XT) =? NilTerm . eq Initial(XT =? T) = XO(XT , T) =? NilTerm . eq Initial(UP /\ UfPr) = Initial(UP) /\ Initial(UfPr) . eq Initial(EmptyEq) = EmptyEq . eq Initial(noTheoryFoundProblem) = noTheoryFoundProblem . eq Initial(IllegalEquationThere) = IllegalEquationThere . *** ************************************ *** ******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 purify(TY, IllegalEquationThere || NLE || UfPr || N) = (IllegalEquationThere || NLE || UfPr || N) . eq pure(TY , XT , UfPr , N) = (XT, UfPr , N) [owise] . ceq pure(TY , QI1[TL, XT, TL1] , UfPr , N) = pure(TY , QI1[TL, getNewResult(pure(TY , XT, UfPr , N)), TL1], getNewEqs(pure(TY , XT, UfPr , N)), getNewNum(pure(TY , XT, UfPr , N))) if XOoccurs(XT, 1) = true . eq pure(TY , XO(T , NXT), UfPr , N) = (GenNewVar(TY , N), (UfPr /\ (XO(GenNewVar(TY, N) , XO(T, NXT))) =? NilTerm) , N + 1) . eq pure(TY , empty , UfPr, N) = (empty, UfPr, N) . ceq purify(TY , (QI1[TL1, XT ,TL] =? NilTerm) || NLE || UfPr || N) = purify(TY , ((QI1[TL1, getNewResult(pure(TY , XT, EmptyEq, N)), TL] =? NilTerm) /\ (getNewEqs(pure(TY , XT, EmptyEq, N)))) || NLE || UfPr || getNewNum(pure(TY , XT, EmptyEq, N))) if XOoccurs(XT, 1) = true . ceq purify(TY , (XO(T, NXT) =? NilTerm) || NLE || UfPr || N) = purify(TY , ((XO(getNewResult(pure(TY , T, EmptyEq, N)), NXT) =? 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 : Module UnificandPair Substitution -> Substitution . op Decomp : Module TermList TermList Substitution -> Substitution . eq Decomp(M, XT , XT1, SUB) = syUnify(M, (XT =? XT1) , SUB) . eq Decomp(M, XT, XT, SUB) = SUB . eq Decomp(M, empty, empty , SUB) = SUB . eq Decomp(M, (XT , TL), (XT1 , TL1) , SUB) = Decomp(M, Apply(TL , Apply(syUnify(M, XT =? XT1 , SUB), syUnify(M, XT =? XT1, SUB))), Apply(TL1 , Apply(syUnify(M, XT =? XT1 , SUB) , syUnify(M, XT =? XT1, SUB))), Apply((syUnify(M, XT =? XT1 , SUB)), syUnify(M, XT =? XT1, SUB))) . ****Trivial ***** eq syUnify(M, XT =? XT , SUB) = SUB . ****Decomposition**** eq syUnify(M, QI1[TL] =? QI1[TL1], SUB) = Decomp(M, TL, TL1, SUB) [owise] . ceq syUnify(M, QI1[TL] =? QI1[TL1], SUB) = fail if getNumber(TL) =/= getNumber(TL1) . ****Symbol clash**** ceq syUnify(M, QI2[TL] =? QI1[TL1] , SUB) = fail if QI1 =/= QI2 . ceq syUnify(M, C1 =? C, SUB ) = fail if C1 =/= C . eq syUnify(M, QI1[TL] =? C, SUB) = fail . eq syUnify(M, C =? QI1[TL] , SUB) = fail . eq syUnify(M, C =? NilTerm , SUB) = fail . eq syUnify(M, NilTerm =? C , SUB) = fail . eq syUnify(M, NilTerm =? QI1[TL] , SUB) = fail . eq syUnify(M, QI1[TL] =? NilTerm , SUB) = fail . ***Orient****** ceq syUnify(M, T =? V, SUB) = syUnify(M, V =? T , SUB) if issingle(T) == false . eq syUnify(M, NilTerm =? V, SUB) = syUnify(M, V =? NilTerm , SUB) . ***Occurs check ceq syUnify(M, V =? T, SUB) = fail if occurs(V, T, 0) = true . ********sorted variable Elimination **** ceq syUnify(M, V =? V1 , SUB) = (Apply(SUB, V <- V1); V <- V1) if sortLeq(M, getType(V), getType(V1)) == false . ceq syUnify(M, V =? V1 , SUB) = syUnify(M, V1 =? V , SUB) if LessType(M, V, V1) == true . ***Variable Elimination eq syUnify(M, V =? T, SUB) = (Apply(SUB , V <- T); V <- T) [owise] . eq syUnify(M, V =? NilTerm, SUB) = (Apply(SUB , V <- NilTerm); V <- NilTerm) [owise] . *************Semantic unification. *********Detect whether there is no problem to be solved. op Detect : Module Problem -> Problem . var modname : Qid . eq Detect(M, EmptyEq || NLE || UfPr1 || N) = NoProblemFound . eq Detect(M, (noTheoryFoundProblem || NLE || UfPr || N)) = noTheoryFoundProblemP . op IllegalEquationFound : -> Problem . eq Detect(M, (IllegalEquationThere || NLE || UfPr || N)) = IllegalEquationFound . eq Detect(M, P) = DeInfer(M, P) [owise] . ************Deterministic Rule op DeInfer : Module Problem -> ProblemList . ***********Non-Deterministic Rule . op NDeInfer : Module Problem -> ProblemList . *************Basic Rules ****************Trivial Rules.*********** eq DeInfer(M, UfPr || NLE || FailEquation || N) = FailProblem . eq DeInfer(M, FailProblem) = FailProblem . eq DeInfer(M, (NilTerm =? NilTerm) || NLE || UfPr1 || N) = EmptyEq || NLE || UfPr1 || N . eq DeInfer(M, ((NilTerm =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = DeInfer(M, UfPr || NLE || UfPr1 || N) . eq DeInfer(M, UfPr || ((NilTerm N=? NilTerm) /\ NLE) || UfPr1 || N) = FailProblem . eq DeInfer(M, UfPr || ((NilTerm N=? NilTerm)) || UfPr1 || N) = FailProblem . *****************Decomposition*************** ceq DeInfer(M, ((XO(QI1[TL], QI1[TL1], XT) =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = DeInfer(M, Apply(((XO(NilTerm, XT) =? NilTerm) /\ UfPr) || NLE || (UfPr1 /\ UnifToEq(syUnify(M, QI1[TL] =? QI1[TL1] , none))) || N , syUnify(M, QI1[TL] =? QI1[TL1], none))) if getNumber(getSameFunctions(XT, QI1)) == 0 /\ (PVOccurs(PureVariable(XT) , ((TL, TL1)))) . ceq DeInfer(M, ((XO(QI1[TL], QI1[TL1], XT) =? NilTerm) ) || NLE || UfPr1 || N) = DeInfer(M, Apply(((XO(NilTerm, XT) =? NilTerm)) || NLE || (UfPr1 /\ UnifToEq(syUnify(M, QI1[TL] =? QI1[TL1] , none))) || N , syUnify(M, QI1[TL] =? QI1[TL1], none))) if getNumber(getSameFunctions(XT, QI1)) == 0 /\ (PVOccurs(PureVariable(XT) , ((TL, TL1)))). eq DeInfer(M, ((XO(QI1[TL], QI1[TL1]) =? NilTerm) ) || NLE || UfPr1 || N) = DeInfer(M, Apply(EmptyEq || NLE || (UfPr1 /\ UnifToEq(syUnify(M, QI1[TL] =? QI1[TL1] , none))) || N , syUnify(M, QI1[TL] =? QI1[TL1], none))) . eq DeInfer(M, ((XO(QI1[TL], QI1[TL1]) =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = DeInfer(M, Apply(UfPr || NLE || (UfPr1 /\ UnifToEq(syUnify(M, QI1[TL] =? QI1[TL1] , none))) || N , syUnify(M, QI1[TL] =? QI1[TL1], none))) . ***************Varialbe Substitution*********** ceq DeInfer(M, ((V =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = DeInfer(M, Apply(UfPr || NLE || (UfPr1 /\ V =? NilTerm) || N, V <- NilTerm )) if occurs(V , UfPr , 0) == false . eq DeInfer(M, (V =? NilTerm) || NLE || UfPr1 || N) = Apply(EmptyEq || NLE || (UfPr1 /\ V =? NilTerm) || N, V <- NilTerm ) . ceq DeInfer(M, ((XO(V, QI1[TL])=? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = DeInfer(M, Apply(UfPr || NLE || (UfPr1 /\ V =? QI1[TL]) || N, V <- QI1[TL] )) if occurs(V, QI1[TL] , 0) = false /\ occurs(V , UfPr , 0) = false . ceq DeInfer(M, (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(M, (XO(V, T, NXT) =? NilTerm /\ UfPr) || NLE || UfPr1 || N) = DeInfer(M, Apply(UfPr || NLE || (UfPr1 /\ V =? XO(T, NXT) )|| N , V <- XO(T, NXT))) if occurs(V , (XO(V, T, NXT) =? NilTerm )/\ UfPr , 0) = false /\ LessTypeL(M, V, getFVP(XO(V, T, NXT) =? NilTerm, XO(V, T, NXT) =? NilTerm /\ UfPr, empty)) == false . ceq DeInfer(M, (XO(V, T, NXT) =? NilTerm) || NLE || UfPr1 || N) = Apply(EmptyEq || NLE || (UfPr1 /\ V =? XO(T, NXT) )|| N , V <- XO(T, NXT)) if occurs(V, XO(T,NXT) , 0) = false /\ LessTypeL(M, V, getFVP(XO(V, T, NXT) =? NilTerm, XO(V, T, NXT) =? NilTerm, empty)) == false . ceq DeInfer(M, (XO(V, T, NXT) =? NilTerm /\ UfPr) || NLE || UfPr1 || N) = DeInfer(M, Apply(UfPr || NLE || (UfPr1 /\ V =? XO(T, NXT) )|| N , V <- XO(T, NXT))) if occurs(V , (XO(V, T, NXT) =? NilTerm )/\ UfPr , 0) = false . ceq DeInfer(M, (XO(V, T, NXT) =? NilTerm) || NLE || UfPr1 || N) = Apply(EmptyEq || NLE || (UfPr1 /\ V =? XO(T, NXT) )|| N , V <- XO(T,NXT)) if occurs(V, XO(T,NXT) , 0) == false . ceq DeInfer(M, (XO(V, NXT) =? NilTerm /\ UfPr) || NLE || UfPr1 || N) = DeInfer(M, Apply(UfPr || NLE || (UfPr1 /\ V =? NXT )|| N , V <- NXT)) if occurs(V , (XO(V, NXT) =? NilTerm )/\ UfPr , 0) == false /\ LessTypeL(M, V, getFVP(XO(V, NXT) =? NilTerm, XO(V, NXT) =? NilTerm /\ UfPr, empty)) == false . ceq DeInfer(M, (XO(V, NXT) =? NilTerm) || NLE || UfPr1 || N) = Apply(EmptyEq || NLE || (UfPr1 /\ V =? NXT )|| N , V <- NXT) if occurs(V, NXT, 0) == false /\ LessTypeL(M, V, getFVP(XO(V, NXT) =? NilTerm, XO(V, NXT) =? NilTerm, empty)) == false . ****************Clash and Occurs Check*************************** ceq DeInfer(M, (XO(V, QI1[TL]) =? NilTerm) || NLE || UfPr1 || N) = FailProblem if occurs (V , TL , 1) . ceq DeInfer(M, ((XO(V, QI1[TL]) =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = FailProblem if occurs (V , TL , 0) == true . ceq DeInfer(M, (XO(V, XO(T, NXT)) =? NilTerm) || NLE || UfPr1 || N) = FailProblem if occurs (V , T , 0) = true /\ AndOccurs(V, getSameFunctions(NXT, getTopSymbol(T)), 0) == true /\ getOdd(getSameFunctions((T, NXT), getTopSymbol(T)), 0) == 1 . ceq DeInfer(M, ((XO(V, (T, NXT)) =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = FailProblem if occurs (V , T , 0) = true /\ AndOccurs(V, getSameFunctions(NXT, getTopSymbol(T)), 0) == true /\ getOdd(getSameFunctions((T,NXT), getTopSymbol(T)), 0) == 1 . ceq DeInfer(M, (((XO(T, NXT)) =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = FailProblem if noFreeVariable(XO(T, NXT)) == true /\ getOdd(getSameFunctions((T,NXT), getTopSymbol(T)), 0) == 1 . ceq DeInfer(M, (((XO(T, NXT)) =? NilTerm)) || NLE || UfPr1 || N) = FailProblem if noFreeVariable(XO(T, NXT)) == true /\ getOdd(getSameFunctions((T,NXT), getTopSymbol(T)), 0) == 1 . ************NonDetermistic Ruls******** ceq NDeInfer(M, ((XO(QI1[TL], QI1[TL1], XT) =? NilTerm) /\ UfPr) || NLE || UfPr1 || N) = ((DeInfer(M, Apply(((XO(NilTerm, XT) =? NilTerm) /\ UfPr) || NLE || (UfPr1 /\ UnifToEq(syUnify(M, QI1[TL] =? QI1[TL1] , none))) || N , syUnify(M, QI1[TL] =? QI1[TL1], none)))) $$ (DeInfer(M, ((XO(QI1[TL], QI1[TL1], XT) =? 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(M, ((XO(QI1[TL], QI1[TL1], XT) =? NilTerm) ) || NLE || UfPr1 || N) = (DeInfer(M, Apply(((XO(NilTerm, XT) =? NilTerm)) || NLE || (UfPr1 /\ UnifToEq(syUnify(M, QI1[TL] =? QI1[TL1] , none))) || N , syUnify(M, QI1[TL] =? QI1[TL1], none)))) $$ (DeInfer(M, ((XO(QI1[TL], QI1[TL1], XT) =? 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(M, UfPr || NLE || UfPr1 || N) = NDeInfer(M, UfPr || NLE || UfPr1 || N) [owise] . eq NDeInfer(M, 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 . op NoSubforIllegalEquation : -> Substitution . eq GetSub(NoProblemFound) = noneNoProblemFound . ***if no problem was found in the file. eq GetSub(IllegalEquationFound) = NoSubforIllegalEquation . eq GetSub(UfPr || NLE || V =? XT || N) = V <- XT [owise] . ceq GetSub(UfPr || NLE || V =? XT || 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 . op GetFinal(_) : ProblemList -> SubstitutionList . eq GetFinal((P $$ PL)) = GetSub(P) ### GetFinal(PL) . eq GetFinal(EmptyProblem) = EmptySubstitution . eq GetFinal(NoProblemFound) = noneNoProblemFound . eq GetFinal(noTheoryFoundProblemP) = noneNoTheoryFound . eq GetFinal(P) = GetSub(P) [owise] . eq GetFinal(FailProblem) = fail . ***************************************************** **************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 *********** ************************************************ ***********convert all the term to original format. op ConvertBack : Qid Qid Qid XORTerm -> 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 , (XT, NeTL)) = (ConvertBack(QI1, QI2, QI4, XT), ConvertBackL(QI1, QI2, QI4, NeTL)) . eq ConvertBackL(QI1, QI2, QI4 , XT) = ConvertBack(QI1, QI2, QI4, XT) . eq ConvertBack(QI1, QI2, QI4 , XO(T, NXT)) = QI1[ConvertBackL(QI1, QI2, QI4, ConvertXORtoTL(XO(T, NXT), empty))] . eq ConvertBackL(QI1, QI2, QI4, empty) = empty . ********************************** ****************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 , EmptySubstitution) = IDENTITY . eq BConvertList(QI1, QI2, QI3, noneNoProblemFound) = NoProblemFoundInFile . eq BConvertList(QI1, QI2, QI3, noneNoTheoryFound) = NoTheoryFoundInFile . op noSubforIllegalEquations : -> FinalSub . eq BConvertList(QI1, QI2 , QI3 , NoSubforIllegalEquation) = noSubforIllegalEquations . 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 . eq BConvertS(QI1, QI2 , QI3 , NoSubforIllegalEquation) = noSubforIllegalEquations . op BConvert : Qid Qid Qid Assignment -> FinalAss . eq BConvert(QI1, QI2, QI3, (V <- XT)) = V <- ConvertBack(QI1, QI2, QI3, XT) . eq BConvert(QI1, QI2, QI3, fail) = NoSolution . ****************Final Command ************ ******************SolveEqS is to solve the problem and output the solution. op solveEqS : UnificationProblem Module Int -> FinalSub . eq solveEqS(UfPr, M, N) = BConvertList(getXor(getEqs(M)), getNil(getEqs(M)) , getNilType(getEqs(M)), GetFinal(Detect(M, purify(getXorType(getEqs(M)), Initial(ConvertProblem(getXor(getEqs(M)) , getNil(getEqs(M)), getNilType(getEqs(M)), UfPr)) || EmptyDisEq || EmptyEq || N)))) . ****************unf is similar to the solveEqs but output the counter as well. op unf : UnificationProblem Module Int -> FinalList . eq unf(UfPr, M, N) = (solveEqS(UfPr, M, N))[NewVariablesCounter:(getNewNum(purify(getXorType(getEqs(M)), Initial(ConvertProblem(getXor(getEqs(M)) , getNil(getEqs(M)), getNilType(getEqs(M)), 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, upModule('XTheory,false), N) . ************ op unS : UnificationProblem Int -> FinalList . eq unS(UfPr, N) = unf(UfPr, upModule('AsyXTheory,false), 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(upModule('Xtheory,false), 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) = Detect(upModule('Xtheory,false), 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 || 0)) . ******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 p40 p41 p42 p43 p44 p45 p46 p47 p48 p49 p50 p51 : -> 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.Null . ****x< fy eq p6 = ('XOR['f['x:sort1], 'f['y:sort1], 'f['z:sort1]] =? '0.Null) . ***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.Null) . ****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.Null) . ****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.Null /\ ('XOR['f['w:sort], 'f['d.sort]] =? '0.Null)) . ***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.Null) . *** w<- g(a, c) x<-c, y<-a z<-g(a, c). eq p24 = (('XOR['x:sort, 'f['y:sort] , 'f['x1:sort]] =? '0.Null) /\ ('XOR['y:sort , 'f['z:sort], 'f['x2:sort]] =? '0.Null) /\ ('XOR['z:sort , 'f['x:sort] , 'f['x3:sort]] =? '0.Null)) . ***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.Null) . ***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.Null) . ***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.Null) . ***No Solution. eq p28 =('XOR['f['b.sort], 'f['0.Null], 'f['x:sort] , 'f['y:sort]]=? '0.Null) . ***x<-0, y<-b ***x<-b, y<-0 eq p29 =('XOR['f['b.sort], 'f['0.Null], 'f['x:sort] , 'f['y:sort]]=? '0.Null) /\ ('x:sort =? '0.Null) . ****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:Msg =? 'y:Nonce . eq p40 = 'x:Msg =? 'y:NNSet . eq p41 = 'x:NNSet =? 'y:Nonce . eq p42 = 'x:Nonce =? 'y:Msg . eq p43 = 'x:Msg =? 'y:Msg . eq p44 = 'f['x:Msg] =? 'f['y:Msg] . eq p45 = 'f['x:Msg] =? 'f['y:NNSet] . eq p46 = 'f['x:NNSet] =? 'f['y:Nonce] . eq p47 = 'f['x:Nonce] =? 'f['y:Msg] . eq p48 = 'f['x:Msg] =? 'f['y:Msg] . eq p49 = 'f['x:NNSet] =? 'f['y:Msg] . eq p50 = EmptyEq . endfm ******* ******* *******This version modifies the rule of spilting such that it is more efficient. fmod AsyXorUnif is ****** pr META-LEVEL-MNPA . ****We are using some built-in sorts in Meta-Level, like Variable, Term, UnificationProblem,Substitution etc. pr INT . pr CONVERSION . ***We will call XorUnif to get the unifiers of the problem. pr XorUnif . **********Sorts and subsorts********** *************************************** **************Variables ************* *************************************** *********The following sorts where variables are belonged to are in prelude.maude. var str : String . var M : Module . vars V V1 V2 V3 V4 : Variable . vars C C1 : Constant . vars T T1 T2 T3 : Term . vars TL TL1 TL2 TL3 TL4 TL5 : TermList . vars NTL NTL1 NTL2 : NeTermList . ***NeTermList is none empty termlist. vars UfPr UfPr1 UfPr2 UfPr3 : UnificationProblem . vars UP UP1 : UnificandPair . vars QI1 QI2 QI3 QI4 QI5 : Qid . vars N N1 N2 N3 : Int . vars TF TF1 TF2 TF3 RAS : Bool . vars SUB SUB1 : Substitution . vars AS AS1 : Assignment . vars TY : Type . var modname : Qid . ****The following variables' sorts are declared in xorforAsy.maude. vars NXOE NXOE1 : DisEquation . vars NLE NLE1 : ListOfDisEquations . vars SL SL1 : SubstitutionList . vars NSL NSL1 NSL2 : NeSubstitutionList . vars FS1 FS2 : FinalSub . vars XT XT1 XT2 XT3 : XORTerm . vars NXT NXT1 NXT2 NXT3 : NeXORTerm . ********************************************************************** ****************Construction of an asymetric unification problem*********** *********************************************************************** *******pairs in Upsilon********* sorts ResPair NeResPairList ResPairList . ***Restriaction pair subsort ResPair < NeResPairList < ResPairList . vars RP RP1 RP2 RP3 : ResPair . vars RPL RPL1 RPL2 RPL3 : ResPairList . vars NRPL NRPL1 NRPL2 NRPL3 : NeResPairList . op _!_ : Variable XORTerm -> ResPair . op _!L!_ : Variable TermList -> ResPairList . op NilResPair : -> ResPairList [ctor] . ***Empty Restrict pair list. op FailResPair : -> ResPairList [ctor] . ***The Restrict pair for fail asyproblem. op _ , _ : ResPairList ResPairList -> ResPairList [comm assoc ctor id: NilResPair] . op _ , _ : NeResPairList ResPairList -> NeResPairList [ctor ditto] . op _ , _ : ResPairList NeResPairList -> NeResPairList [ctor ditto] . eq (V !L! (T , TL)) = ((V ! T) , (V !L! TL)) . eq (V !L! empty) = NilResPair . eq (V ! XO(T , NXT)) = V !L! ConvertXORtoTL(XO(T , NXT) , empty) . ***for x + a + b, we need x <<< a , x <<< b but not x <<< a+b. eq (RP , RP ) = RP . ***Idempotent. *********Pairs for Original Constraint************ sorts ConPair ConPairList NeConPairList . subsort ConPair < NeConPairList < ConPairList . vars CP CP1 CP2 CP3 : ConPair . vars CPL CPL1 CPL2 CPL3 : ConPairList . vars NCPL NCPL1 NCPL2 NCPL3 : NeConPairList . op _<<<_ : Variable XORTerm -> ConPair . op _< ConPair . op NilConPair : -> ConPairList [ctor] . op _ , _ : ConPairList ConPairList -> ConPairList [comm assoc ctor id: NilConPair] . op _ , _ : NeConPairList ConPairList -> NeConPairList [ctor ditto] . op _ , _ : ConPairList NeConPairList -> NeConPairList [ctor ditto] . eq (V < ConPairRe . op _ ConPairRe . op NilConPairRe : -> ConPairReList [ctor] . op _ ; _ : ConPairReList ConPairReList -> ConPairReList [comm assoc ctor id: NilConPairRe] . op _ ; _ : NeConPairReList ConPairReList -> NeConPairReList [ctor ditto] . op _ ; _ : ConPairReList NeConPairReList -> NeConPairReList [ctor ditto] . eq (XT1 AsyProblem [ctor] . ********Substituionlist // OriginalConstraintList // Upsilon(Resrictpairlist) // Disequations // UnificatoinProblems // Number of new variables // whether it is a solution // whether it is finished for searching for equvalent unifier// whether some rule is applied. op EmptyAsyProblem : -> AsyProblemList [ctor] . op FailAsyProblem : -> AsyProblem [ctor] . op NoXORSolution : -> AsyProblemList [ctor] . op NoAsyProblem : -> AsyProblemList [ctor] . op NoAsyTheory : -> AsyProblemList [ctor] . op IllegalAsyEquation : -> AsyProblemList [ctor] . op IllegalAsyEquationThere : -> AsyProblemList [ctor] . op _$$_ : AsyProblemList AsyProblemList -> AsyProblemList [assoc ctor id: EmptyAsyProblem] . op _$$_ : NeAsyProblemList AsyProblemList -> NeAsyProblemList [ctor ditto] . op _$$_ : AsyProblemList NeAsyProblemList -> NeAsyProblemList [ctor ditto] . eq FailAsyProblem $$ NAPL = NAPL . ***We will omit the fail problem. eq NAPL $$ FailAsyProblem = NAPL . eq AP $$ APL $$ AP = AP $$ APL . ****idempotent. *********************************************************************** **********Finished the construction of the problem************************** *********************************************************************** *******~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~********************* **** Building up the final result **** final result contains two parts: **** 1. Final substitution, **** 2. the number of new variables we introduced. *********************************************************************** sorts AsySub NeAsySubList AsySubList . subsort AsySub < NeAsySubList < AsySubList . vars ASub ASub1 ASub2 ASub3 : AsySub . vars NASub NASub1 NASub2 NASub3 : NeAsySubList . vars ASubL ASubL1 ASubL2 ASubL3 : AsySubList . op TIDAsySub : -> AsySubList . ****Identity op TNoXORUnifier : -> AsySubList . ****Even no soluftion for Symmetric Unifier. op TNoAsyUnifier : -> AsySub . ****No solution for Asymmetric Unifier but some Symmetric Unifier Exsits. op TNoAsyTheoryFoundInFile : -> AsySubList . ****We did not find any theory or the theory format is not in proper format in the file. op TNoAsyProblemFound : -> AsySubList . ****The set of unification problem is empty . op TIllegalEquationDetected : -> AsySubList . ******There is/are some equitation(s) not in proper format . eq TNoAsyUnifier #!# ASub = ASub . op _[NewVariablesNo:_] : Substitution Int -> AsySub [ctor] . op _#!#_ : AsySubList AsySubList -> AsySubList [ctor assoc id: TIDAsySub gather (e E) format (d y no d)] . op _#!#_ : NeAsySubList AsySubList -> NeAsySubList [ctor ditto] . op _#!#_ : AsySubList NeAsySubList -> NeAsySubList [ctor ditto] . op TFailAsySub : -> AsySub . eq ASub #!# ASubL #!# ASub = ASub #!# ASubL . eq TFailAsySub #!# ASub = ASub . ceq ((SUB [NewVariablesNo: N]) #!# (SUB [NewVariablesNo: N1])) = (SUB [NewVariablesNo: N]) if N >= N1 . eq ((SUB [NewVariablesNo: N]) #!# (SUB[NewVariablesNo: N1])) = (SUB [NewVariablesNo: N1]) [owise] . ceq ((SUB [NewVariablesNo: N ]) #!# NASub #!# (SUB [NewVariablesNo: N1 ])) = ((SUB [NewVariablesNo: N]) #!# NASub) if N >= N1 . eq ((SUB [NewVariablesNo: N ]) #!# NASub #!# (SUB [NewVariablesNo: N1 ])) = ((SUB [NewVariablesNo: N1]) #!# NASub) [owise] . eq ((SUB [NewVariablesNo: N ]) #!# NASub #!# (SUB [NewVariablesNo: N1 ])) = ((SUB [NewVariablesNo: N1]) #!# NASub) [owise] . *************************************************************** **** operators above are for building the final sub ** **** before converting back to orginal format. ** **** following operators are over loaded for duilding ** **** the final subs in original format. ** **** FinalSub is definied in xorforAsy.maude, which is ** **** Uiversal-> Universal; Universal->Universal ** *************************************************************** sorts FinalAsySub NeFinalAsySubList FinalAsySubList . subsort FinalAsySub < NeFinalAsySubList < FinalAsySubList . vars FAS FAS1 FAS2 FAS3 : FinalAsySub . vars FASL FASL1 FASL2 FASL3 : FinalAsySubList . vars NFASL NFASL1 NFASL2 NFASL3 : NeFinalAsySubList . op IDAsySub : -> FinalAsySubList . ****Identity op NoXORUnifier : -> FinalAsySubList . ****Even no soluftion for Symmetric Unifier. op NoAsyUnifier : -> FinalAsySub . ****No solution for Asymmetric Unifier but some Symmetric Unifier Exsits. eq NoAsyUnifier #$# FAS = FAS . op NoAsyTheoryFoundInFile : -> FinalAsySubList . ****We did not find any theory or the theory format is not in proper format in the file. op NoAsyProblemFound : -> FinalAsySubList . ****The set of unification problem is empty . op IllegalEquationDetected : -> FinalAsySubList . ******There is/are some equitation(s) not in proper format . op _[NumberOfNewVariables:_] : FinalSub Int -> FinalAsySub [ctor format(d n r d o d)] . op _#$#_ : FinalAsySubList FinalAsySubList -> FinalAsySubList [ctor assoc id: IDAsySub gather (e E) format (d y no d)] . op _#$#_ : NeFinalAsySubList FinalAsySubList -> NeFinalAsySubList [ctor ditto] . op _#$#_ : FinalAsySubList NeFinalAsySubList -> NeFinalAsySubList [ctor ditto] . op FailAsySub : -> FinalAsySubList . eq FailAsySub #$# FAS = FAS . *** ceq ((FS1 [NumberOfNewVariables: N]) #$# (FS1 [NumberOfNewVariables: N1])) = (FS1 [NumberOfNewVariables: N]) if N >= N1 . *** eq ((FS1 [NumberOfNewVariables: N]) #$# (FS1[NumberOfNewVariables: N1])) = (FS1 [NumberOfNewVariables: N1]) [owise] . ********Idempotent. ******If two substitutions are same except they generate diferent new variables in the procedure, we combine them together and let the biggest one as the number of new variables. ceq ((FS1 [NumberOfNewVariables: N ]) #$# FASL #$# (FS1 [NumberOfNewVariables: N1 ])) = ((FS1 [NumberOfNewVariables: N]) #$# FASL) if N >= N1 . eq ((FS1 [NumberOfNewVariables: N ]) #$# FASL #$# (FS1 [NumberOfNewVariables: N1 ])) = ((FS1 [NumberOfNewVariables: N1]) #$# FASL) [owise] . *********Idempotent. ************************************************************************************ ***********Basic operation for subtract information from asymmetric problems************ ************************************************************************************* *** Get the first part of the asyproblem, which is the current substituitons op GetAsySubstitution : AsyProblem -> Substitution . op GetAsySubstitutionL : AsyProblemList -> SubstitutionList . eq GetAsySubstitution(SUB // CPL // RPL // NLE // UfPr // N // 1 // N2 // RAS) = SUB . eq GetAsySubstitutionL(AP $$ APL) = GetAsySubstitution(AP) ### GetAsySubstitutionL(APL) . eq GetAsySubstitutionL(AP) = GetAsySubstitution(AP) . eq GetAsySubstitutionL(EmptyAsyProblem) = EmptySubstitution . eq GetAsySubstitution(FailAsyProblem) = fail . *** Get the second part of the asyproblem, which is the original constraints. op GetConPairList : AsyProblem -> ConPairList . op GetConPairListL : AsyProblemList -> ConPairList . eq GetConPairList(SUB // CPL // RPL // NLE // UfPr // N // N1 // N2 // RAS) = CPL . eq GetConPairListL(AP) = GetConPairList(AP) . eq GetConPairListL(AP $$ NAPL) = GetConPairList(AP) . eq GetConPairList(FailAsyProblem) = NilConPair . eq GetConPairListL(EmptyAsyProblem) = NilConPair . eq GetConPairListL(NoXORSolution) = NilConPair . eq GetConPairListL(NoAsyProblem) = NilConPair . eq GetConPairListL(NoAsyTheory) = NilConPair . eq GetConPairListL(IllegalAsyEquation) = NilConPair . eq GetConPairListL(IllegalAsyEquationThere) = NilConPair . *** Get the third part of the asyproblem, which is the restrict pairs namely, Upsilon op GetResPairList : AsyProblem -> ResPairList . eq GetResPairList(SUB // CPL // RPL // NLE // UfPr // N // N1 // N2 // RAS) = RPL . eq GetResPairList(FailAsyProblem) = FailResPair . eq GetResPairList(EmptyAsyProblem) = NilResPair . *** Get the fourth part of the asyproblem, which is a set of dis equaitons using for tracking the Decomposition Intantiation. op GetDisEquations : AsyProblem -> ListOfDisEquations . eq GetDisEquations(SUB // CPL // RPL // NLE // UfPr // N // N1 // N2 // RAS) = NLE . *** Get the seventsth part of the asy problem, 1 means this is an asymmetric unifier, 0 means no. op GetTestResult : AsyProblem -> Int . op GetTestResultL : AsyProblemList -> Int . eq GetTestResult(SUB // CPL // RPL // NLE // UfPr // N // N1 // N2 // RAS) = N1 . eq GetTestResultL(AP $$ NAPL) = GetTestResult(AP) + GetTestResultL(NAPL) . eq GetTestResultL(AP) = GetTestResult(AP) . eq GetTestResultL(EmptyAsyProblem) = 0 . eq GetTestResult(FailAsyProblem) = 0 . *** Get the eighth part of the asy problem, 1 means we finish searching for equivalent unifier, and next we need to start instantiation. op GetFinishSearching : AsyProblem -> Int . eq GetFinishSearching(SUB // CPL // RPL // NLE // UfPr // N // N1 // N2 // RAS) = N2 . eq GetFinishSearching(EmptyAsyProblem) = 0 . eq GetFinishSearching(FailAsyProblem) = 0 . **** Get the first part and the sixth part of the asyproblem, which is the current substituitons and current number of new variabls. op GetFinalAsySubList : AsyProblemList -> AsySubList . op GetFinalAsySub : AsyProblem -> AsySub . eq GetFinalAsySubList(NoAsyTheory) = TNoAsyTheoryFoundInFile . eq GetFinalAsySubList(AP $$ APL) = GetFinalAsySub(AP) #!# GetFinalAsySubList(APL) . eq GetFinalAsySubList(NoAsyProblem) = TNoAsyProblemFound . eq GetFinalAsySubList(EmptyAsyProblem) = TIDAsySub . eq GetFinalAsySubList(AP) = GetFinalAsySub(AP) . eq GetFinalAsySub(FailAsyProblem) = TNoAsyUnifier . eq GetFinalAsySubList(IllegalAsyEquationThere) = TIllegalEquationDetected . eq GetFinalAsySubList(NoXORSolution) = TNoXORUnifier . eq GetFinalAsySub(none // CPL // RPL // NLE // UfPr // N // 1 // N2 // RAS) = TIDAsySub . eq GetFinalAsySub(SUB // CPL // RPL // NLE // UfPr // N // 1 // N2 // RAS) = SUB [NewVariablesNo: N ] [owise] . ******************************************************* **** Other Parts ******************************************************* **** a sort we need used in rules ******VariableList ****** sorts NeVariableList VariableList . *******List of variables. subsort Variable < NeVariableList < VariableList . vars VL VL1 VL2 VL3 : VariableList . vars NVL NVL1 NVL2 NVL3 : NeVariableList . op _!!_ : VariableList VariableList -> VariableList [ctor comm assoc id: EmptyVariableList] . op _!!_ : NeVariableList VariableList -> NeVariableList [ctor ditto] . op _!!_ : VariableList NeVariableList -> NeVariableList [ctor ditto] . op EmptyVariableList : -> VariableList [ctor] . eq V !! V = V . ***Idempotent. **** Term pairs are used in Failure rules. sorts TermPair NeTermPairList TermPairList . subsort TermPair < NeTermPairList < TermPairList . vars TP TP1 TP2 TP3 : TermPair . vars TPL TPL1 TPL2 TPL3 TPL4 : TermPairList . vars NTPL NTPL1 NTPL2 NTPL3 NTPL4 : NeTermPairList . op (_~_) : Term Term -> TermPair [ctor comm] . op EmptyTermPair : -> TermPairList [ctor] . op _-_ : TermPairList TermPairList -> TermPairList [ctor assoc id: EmptyTermPair] . op _-_ : TermPairList NeTermPairList -> TermPairList [ctor ditto] . op _-_ : NeTermPairList TermPairList -> TermPairList [ctor ditto] . eq TP - TP = TP . eq TP - NTPL - TP = TP - NTPL . ********************************************************************* **************Conditions Checking funcions ***************************** ********************************************************************* ********monic varibles exsits? check whether there the form has the form of v + S********** op MonicVar : XORTerm -> Bool . eq MonicVar(XO(V, NXT)) = true . eq MonicVar(V) = true . eq MonicVar(XT) = false [owise] . ********Check whether some restrict pairs are already in Upsilon op PairOccursL : ResPair ResPairList -> Bool . op PairOccurs : ResPair ResPair -> Bool . eq PairOccursL(V ! XT , (RP, NRPL)) = PairOccurs(V ! XT , RP) or PairOccursL(V ! XT , NRPL) . eq PairOccursL(V ! XT , RP) = PairOccurs(V ! XT , RP) . eq PairOccursL(NilResPair , NRPL) = false . eq PairOccursL(V ! XT , NilResPair) = false . eq PairOccurs(V ! XT , (V ! XT)) = true . eq PairOccurs(V ! XT, RP) = false [owise] . ******* check some pair is in original constraints. op ConPairOccursL : ConPair ConPairList -> Bool . op ConPairOccurs : ConPair ConPair -> Bool . eq ConPairOccursL(V <<< T , (CP, NCPL)) = ConPairOccurs(V <<< T , CP) or ConPairOccursL(V <<< T , NCPL) . eq ConPairOccursL(V <<< NilTerm , (CP, NCPL)) = ConPairOccurs(V <<< NilTerm , CP) or ConPairOccursL(V <<< NilTerm , NCPL) . eq ConPairOccursL(V <<< T , CP) = ConPairOccurs(V <<< T , CP) . eq ConPairOccursL(V <<< NilTerm , CP) = ConPairOccurs(V <<< NilTerm , CP) . eq ConPairOccursL(NilConPair , CPL) = false . eq ConPairOccursL(V <<< T , NilConPair) = false . eq ConPairOccurs(V <<< T , (V <<< T)) = true . eq ConPairOccurs(V <<< NilTerm , (V <<< NilTerm)) = true . eq ConPairOccurs(V <<< XT, CP) = false [owise] . **********Test whether variables occur in ther variableList already. op VariableOccurs : Variable VariableList -> Bool . eq VariableOccurs(V , V) = true . ceq VariableOccurs(V , V1) = false if V =/= V1 . eq VariableOccurs(V , V !! NVL) = true . eq VariableOccurs(V , V1 !! NVL) = false [owise] . *********Check some term is a part of the other term. ********the first term is a term without XOR at the top. op IsPart : Term XORTerm -> Bool . eq IsPart(T, XO(T, NXT)) = true . eq IsPart(T, T) = true . eq IsPart(T, XT1) = false [owise] . **********Check whether two XOR term have common part(s) ********** op IsCommon : XORTerm XORTerm -> Bool . ceq IsCommon(T, XT) = true if IsPart(T, XT) == true . ceq IsCommon(XT, T) = true if IsPart(T, XT) == true . eq IsCommon(XO(T, NXT), XO(T, NXT2)) = true . eq IsCommon(XT, XT1) = false [owise] . *******Checking whether some term is in some termlist. ******** op TermOccursL : Term TermList -> Bool . op TermOccurs : Term XORTerm -> Bool . eq TermOccursL(T , (XT , NTL)) = TermOccurs(T, XT) or TermOccursL(T, NTL) . eq TermOccursL(T, XT) = TermOccurs(T, XT) . eq TermOccursL(T , empty) = false . eq TermOccurs(T, XO(T1 , NXT)) = TermOccursL(T, ConvertXORtoTL(XO(T1, NXT), empty)) . eq TermOccurs(T, T) = true . eq TermOccurs(T, T1) = false [owise] . ********variable occurs *********This is used for testing whether some variable is in original problem. op VarOccurs : Variable UnificationProblem -> Bool . op VarOccurs : Variable UnificandPair -> Bool . op VarOccurs : Variable XORTerm -> Bool . op VarOccursL : Variable TermList -> Bool . eq VarOccurs(V, UP /\ UfPr) = VarOccurs(V, UP) or VarOccurs(V, UfPr) . eq VarOccurs(V, XT =? XT1) = VarOccurs(V, XT) or VarOccurs(V, XT1) . eq VarOccurs(V, V) = true . eq VarOccurs(V, QI1[TL]) = VarOccursL(V, TL) . eq VarOccurs(V, C) = false . ceq VarOccurs(V, V1) = false if V =/= V1 . eq VarOccurs(V , NilTerm) = false . eq VarOccurs(V, XO(T, NXT)) = VarOccurs(V, T) or VarOccurs(V, NXT) . eq VarOccursL(V, (T,TL)) = VarOccurs(V, T) or VarOccursL(V, TL) . eq VarOccursL(V, empty) = false . eq VarOccursL(V, XT) = VarOccurs(V, XT) . *********check whether some variable occurs in the right hand side.. op VarOccursRight : Variable UnificationProblem -> Bool . op VarOccursRight : Variable UnificationPair -> Bool . op VarOccursRight : Variable XORTerm -> Bool . op VarOccursRightList : Variable TermList -> Bool . eq VarOccursRight(V, UP /\ UfPr) = VarOccursRight(V, UP) or VarOccursRight(V, UfPr) . eq VarOccursRight(V, XT =? XT1) = VarOccurs(V, XT1) . ******* Test whether some pair of terms is in the termpairlist. op IsPairIn : TermPair TermPairList -> Bool . eq IsPairIn( TP , TPL - TP - TPL1) = true . eq IsPairIn(TP, TPL) = false [owise] . *********Test whether two pairs can be cancelled op TestCanPairList : TermPairList -> Bool . op TestCanPair : TermPair -> Bool . eq TestCanPairList(TP - NTPL) = TestCanPair(TP) or TestCanPairList(NTPL) . eq TestCanPairList(EmptyTermPair) = false . eq TestCanPairList(TP) = TestCanPair(TP) . eq TestCanPair(T ~ T) = true . eq TestCanPair(TP) = false [owise] . ***Decomp Already? this will be used in the second part of Failure rules. op CheckDecom : Term TermList ListOfDisEquations -> Bool . eq CheckDecom(T, (T1, TL), ((XO(T, T1) N=? NilTerm) /\ NLE)) = true . eq CheckDecom(T, (T1), ((XO(T, T1) N=? NilTerm) /\ NLE)) = true . eq CheckDecom(T, empty, NLE) = false . ceq CheckDecom(T, T1, NLE) = false if POccurs(NLE, (XO(T, T1) N=? NilTerm)) == false . eq CheckDecom(T, (T1, TL), NLE) = CheckDecom(T, TL , NLE) [owise] . ***Check whether a substitution is an asymmetric unifier op CheckAsy : ConPairReList -> Bool . eq CheckAsy((T VariableList . op GetVariableList : Term VariableList -> VariableList . op GetVariableListL : TermList VariableList -> VariableList . eq GetVariableList(UP /\ UfPr1, VL) = GetVariableList(UP, VL) !! GetVariableList(UfPr1, VL) . eq GetVariableList(EmptyEq, VL) = VL . eq GetVariableList(NilTerm, VL) = VL . eq GetVariableList(EmptyUnificandPair, VL) = VL . eq GetVariableList(XT =? XT1, VL) = GetVariableList(XT , VL) !! GetVariableList(XT1 , VL) . eq GetVariableList(V, VL) = V !! VL . eq GetVariableList(C, VL) = VL . eq GetVariableList(XO(T, NXT), VL) = GetVariableList(T, VL) !! GetVariableList(NXT, VL) . eq GetVariableListL((XT,TL), VL) = GetVariableList(XT, VL) !! GetVariableListL(TL, VL) . eq GetVariableListL(empty, VL) = VL . eq GetVariableList(QI1[TL], VL) = GetVariableListL(TL, VL) . **********Get Original Constraints.********** op GetOrConstraintVL : UnificationProblem VariableList ConPairList -> ConPairList . op GetOrConstraint : UnificationProblem Variable ConPairList -> ConPairList . op GetOrConstraint : XORTerm Variable ConPairList -> ConPairList . op GetOrConstraintL : TermList Variable ConPairList -> ConPairList . eq GetOrConstraintVL(UfPr, EmptyVariableList, CPL) = CPL . eq GetOrConstraintVL(UfPr, (V !! NVL), CPL) = GetOrConstraint(UfPr, V, CPL) , GetOrConstraintVL(UfPr, NVL, CPL) . eq GetOrConstraintVL(UfPr, V, CPL) = GetOrConstraint(UfPr, V, CPL) [owise] . eq GetOrConstraintL((XT, NTL), V, CPL) = GetOrConstraint(XT, V, CPL) , GetOrConstraintL(NTL, V, CPL) . eq GetOrConstraintL(XT, V, CPL) = GetOrConstraint(XT, V, CPL) . eq GetOrConstraintL(empty, V, CPL) = CPL . eq GetOrConstraint(UP /\ UfPr, V, CPL) = GetOrConstraint(UP, V, CPL) , GetOrConstraint(UfPr, V, CPL) . eq GetOrConstraint(EmptyUnificandPair, V, CPL) = CPL . eq GetOrConstraint(EmptyEq, V, CPL) = CPL . eq GetOrConstraint(NilTerm, V, CPL) = CPL . eq GetOrConstraint(XT =? XT1, V, CPL) = GetOrConstraint(XT1, V, CPL) . eq GetOrConstraint(XO(V, T), V, CPL) = GetOrConstraint(T, V, ((V <<< T) , (V <<< NilTerm) , CPL)) . eq GetOrConstraint(XO(V, NXT), V, CPL) = GetOrConstraintL(ConvertXORtoTL(NXT , empty), V, ((V <<< NilTerm) ,(V < TermList . eq GetOrConForVar(V , ((V <<< XT) , CPL1) ) = (XT , GetOrConForVar(V , CPL1)) . eq GetOrConForVar(V , CPL1) = empty [owise] . ****get all the conflits terms from a sum term . sorts PairofTermList . op (_SPLITTING_) : TermList TermList -> PairofTermList [ctor] . vars PTL PTL1 : PairofTermList . op Splitting : Variable Variable XORTerm PairofTermList ConPairList -> PairofTermList . ceq Splitting(V , V2 , XO(T , NXT) , (TL1 SPLITTING TL2) , ((V <<< T) , CPL1)) = Splitting(V , V2, NXT , ((T , TL1) SPLITTING TL2), ((V <<< T) , CPL1)) if occurs(V2 , T , 0) == false . ceq Splitting(V , V2 , XO(T , NXT) , (TL1 SPLITTING TL2) , ((V <<< T) , CPL1)) = Splitting(V , V2, NXT , (TL1 SPLITTING (T , TL2)), ((V <<< T) , CPL1)) if occurs(V2 , T , 0) == true . ceq Splitting(V , V2 , T , (TL1 SPLITTING TL2) , ((V <<< T) , CPL1)) = ((T , TL1) SPLITTING TL2) if occurs(V , T, 0) == false . ceq Splitting(V , V2 , T , (TL1 SPLITTING TL2) , ((V <<< T) , CPL1)) = ((TL1) SPLITTING (T, TL2)) if occurs(V , T, 0) == true . eq Splitting(V , V2, XO(T , NXT) , (TL1 SPLITTING TL2) , (CPL1)) = Splitting(V , V2 , NXT , (TL1 SPLITTING (T , TL2)) , CPL1) [owise] . eq Splitting(V , V2, T , (TL1 SPLITTING TL2) , (CPL1)) = (TL1 SPLITTING (T , TL2))[owise] . eq Splitting(V , V2 , NilTerm , (TL1 SPLITTING TL2) , CPL1) = (TL1 SPLITTING TL2) . op GetFirstSP : PairofTermList -> TermList . op GetSecondSP : PairofTermList -> TermList . eq GetFirstSP(TL1 SPLITTING TL2) = TL1 . eq GetSecondSP(TL1 SPLITTING TL2) = TL2 . *********Convert Termlist to XORTerm . op ConvertTLtoTerm : TermList -> XORTerm . eq ConvertTLtoTerm((T , TL)) = XO(T, ConvertTLtoTerm(TL)) . eq ConvertTLtoTerm(empty) = NilTerm . ******Get possible pairs which can be cancelled. op GetCanPairs : XORTerm TermPairList -> TermPairList . op GetCanPairsList : TermList TermPairList -> TermPairList . eq GetCanPairsList((XT, NTL) , TPL) = GetCanPairs(XT , TPL)- GetCanPairsList(NTL , TPL) . eq GetCanPairsList(empty, TPL) = TPL . eq GetCanPairsList(XT, TPL) = GetCanPairs(XT , TPL) . ceq GetCanPairs(XO(QI1[TL1], QI1[TL2], NXT), TPL) = GetCanPairsList(TL1 , TPL)- GetCanPairsList(TL2 , TPL) - GetCanPairs(NXT, TPL) if IsPairIn(QI1[TL1] ~ QI1[TL2] , TPL) == false . ceq GetCanPairs(XO(QI1[TL1], QI1[TL2]), TPL) = GetCanPairsList(TL1 , TPL)- GetCanPairsList(TL2 , TPL) if IsPairIn(QI1[TL1] ~ QI1[TL2] , TPL) == false . eq GetCanPairs((QI1[TL1]), TPL) = GetCanPairsList(TL1, TPL) . eq GetCanPairs(XT , TPL) = TPL [owise] . ******************************** *****Apply substitutions********** ******************************** ***********Apply Substitution to restrict pairs********** op ApplyResL : ResPairList Substitution -> ResPairList . op ApplyRes : ResPair Substitution -> ResPair . eq ApplyResL(NilResPair, SUB1) = NilResPair . eq ApplyResL((RP , RPL), SUB1) = (ApplyRes(RP, SUB1), ApplyResL(RPL, SUB1)) . eq ApplyResL(RP , SUB1) = ApplyRes(RP , SUB1) . eq ApplyRes(V ! XT, SUB1) = V ! (Apply(XT, SUB1)) . eq ApplyRes(V !L! TL , SUB1) = (V !L! Apply(TL, SUB1)) . *********Apply Substitution to Original Constraint Pairs op ApplyConL : ConPairList Substitution -> ConPairList . op ApplyCon : ConPair Substitution -> ConPair . eq ApplyConL(NilConPair, SUB1) = NilConPair . eq ApplyConL((CP , NCPL), SUB1) = (ApplyCon(CP, SUB1), ApplyConL(NCPL, SUB1)) . eq ApplyConL(CP , SUB1) = ApplyCon(CP , SUB1) . eq ApplyCon(V <<< XT, SUB1) = V <<< (Apply(XT, SUB1)) . eq ApplyCon(V < ConPairReList . op ApplyConBoth : ConPair Substitution -> ConPairReList . eq ApplyConBothL(NilConPair, SUB1) = NilConPairRe . eq ApplyConBothL((CP , NCPL), SUB1) = (ApplyConBoth(CP, SUB1) ; ApplyConBothL(NCPL, SUB1)) . eq ApplyConBothL(CP , SUB1) = ApplyConBoth(CP , SUB1) . eq ApplyConBoth(V <<< XT, SUB1) = (Apply(V, SUB1) TermPairList . op ApplyCanPairs : TermPairList Substitution -> TermPair . eq ApplyCanPairsList(TP - NTPL , SUB) = ApplyCanPairs(TP , SUB) - ApplyCanPairsList(NTPL , SUB) . eq ApplyCanPairsList(EmptyTermPair, SUB) = EmptyTermPair . eq ApplyCanPairsList(TP , SUB) = ApplyCanPairs(TP , SUB) . eq ApplyCanPairs(T ~ T1, SUB) = Apply(T, SUB)~ Apply(T, SUB) . ***************************************** ************Other operations************** ****************************************** *********Replace a variable in respairlist by another variable********** op ReplaceVar : Variable Variable ResPairList -> ResPairList . op ReplaceVar : Variable Variable ResPair -> ResPair . eq ReplaceVar(V , V1 , (RP , NRPL)) = (ReplaceVar(V , V1, RP) , ReplaceVar(V , V1 , NRPL)) . eq ReplaceVar(V , V1 , NilResPair) = NilResPair . eq ReplaceVar(V , V1 , V ! XT) = (V1 ! XT) . ceq ReplaceVar(V , V2 , V1 ! XT) = (V1 ! XT) if V =/= V1 . **********CountMonicTerms *********** op CountMonicTerms : XORTerm -> Int . eq CountMonicTerms(T) = 1 . eq CountMonicTerms(XO(T, NXT)) = CountMonicTerms(NXT) + 1 . eq CountMonicTerms(NilTerm) = 0 . **********ConvertTLtoUP is used for calling xor unification. op ConvertTLtoUP : TermList TermList -> UnificationProblem . eq ConvertTLtoUP((T , NTL) , (T1, NTL1)) = ((XO(T , T1) =? NilTerm) /\ ConvertTLtoUP(NTL , NTL1)) . eq ConvertTLtoUP(T , T1) = (XO(T , T1) =? NilTerm) . eq ConvertTLtoUP(empty, empty) = EmptyEq . ******* combineSubs is used for apply new unifiers after calling XOR unification algorith. *** this is used in Decompsition instantiation. ***( op CombineSubs : AsyProblem SubstitutionList -> AsyProblemList . eq CombineSubs(SUB // CPL // RPL // NLE // UfPr // N // N1 // N2 // TF , SUB1 ### NSL) = (Apply((SUB ; SUB1) , (SUB1)) // CPL // ApplyResL(RPL , Apply((SUB ; SUB1) , (SUB1))) // Apply(NLE , Apply((SUB ; SUB1) , (SUB1))) // UfPr // N // N1 // N2 // TF) $$ CombineSubs(SUB // CPL // RPL // NLE // UfPr // N // N1 // N2 // TF , NSL) . eq CombineSubs(SUB // CPL // RPL // NLE // UfPr // N // N1 // N2 // TF, SUB1) = (Apply((SUB ; SUB1) , (SUB1)) // CPL // ApplyResL(RPL , Apply((SUB ; SUB1) , (SUB1))) // Apply(NLE , Apply((SUB ; SUB1) , (SUB1))) // UfPr // N // N1 // N2 // TF) . eq CombineSubs(SUB // CPL // RPL1 // NLE // UfPr // N // N1 // N2 // TF, EmptySubstitution) = EmptyAsyProblem . eq CombineSubs(SUB // CPL // RPL1 // NLE // UfPr // N // N1 // N2 // TF , none) = SUB // CPL // RPL1 // NLE // UfPr // N // N1 // N2 // TF . eq CombineSubs(SUB // CPL // RPL1 // NLE // UfPr // N // N1 // N2 // TF , fail) = FailAsyProblem . ) ********** *******the following are new combinesubs. op CombineSubs : AsyProblem Substitution -> AsyProblemList . op CombineSubsL : AsyProblem SubstitutionList -> AsyProblemList . eq CombineSubsL(AP , SUB1 ### NSL) = CombineSubs(AP , SUB1) $$ CombineSubsL(AP , NSL) . eq CombineSubsL(AP , SUB) = CombineSubs(AP , SUB) . eq CombineSubs(SUB // CPL // RPL // NLE // UfPr // N // N1 // N2 // TF, SUB1) = (Apply((SUB ; SUB1) , (SUB1)) // CPL // ApplyResL(RPL , Apply((SUB ; SUB1) , (SUB1))) // Apply(NLE , Apply((SUB ; SUB1) , (SUB1))) // UfPr // N // N1 // N2 // TF) [owise] . eq CombineSubsL(AP , EmptySubstitution) = EmptyAsyProblem . eq CombineSubs(AP , none) = AP . eq CombineSubs(AP , fail) = FailAsyProblem . ************Remove fresh variables *********** *******eqpairlist is remember the list of pair(SUB, sub1) , if sub is an asymmetric but sub1 is not. and sub1=SUB sorts EqPair EqPairList NeEqPairList . subsort EqPair < NeEqPairList < EqPairList . vars EP EP1 EP2 EP3 : EqPair . vars EPL EPL1 EPL2 EPL3 : EqPairList . vars NEPL NEPL1 NEPL2 NEPL3 : EqPairList . op (_ , _) : Substitution Substitution -> EqPair . op NilEqPair : -> EqPairList [ctor] . ***Empty Restrict pair list. op FailEqPair : -> EqPairList [ctor] . ***The Restrict pair for fail asyproblem. op _ ; _ : EqPairList EqPairList -> EqPairList [comm assoc ctor id: NilEqPair] . op _ ; _ : NeEqPairList EqPairList -> NeEqPairList [ctor ditto] . op _ ; _ : EqPairList NeEqPairList -> NeEqPairList [ctor ditto] . eq (EP ; EP ) = EP . ***Idempotent. op BackVariables : AsySubList ConPairList EqPairList -> AsySubList . ceq BackVariables(ASubL #!# ((V <- V1 ; SUB)[NewVariablesNo: N]) #!# ASubL1, CPL , EPL) = BackVariables(ASubL #!# (Apply(SUB , V1 <- V)[NewVariablesNo: N]) #!# ASubL1, CPL, EPL) if substr(string(getName(V1)), 0, 3) == "NV#" /\ CheckAsy( ApplyConBothL(CPL, (Apply(SUB , V1 <- V)))) == false . ceq BackVariables(ASubL #!# ((V <- V1 ; SUB)[NewVariablesNo: N]) #!# ASubL1, CPL , EPL) = BackVariables(ASubL #!# (Apply(SUB , V1 <- V)[NewVariablesNo: N]) #!# ASubL1, CPL, (EPL ; ( (V <- V1 ; SUB), Apply(SUB, V1 <- V )))) if substr(string(getName(V1)), 0, 3) == "NV#" /\ CheckAsy(ApplyConBothL(CPL, (Apply(SUB , V1 <- V)))) == true . ceq BackVariables(ASubL #!# ((V <- XO(V1, NXT) ; SUB)[NewVariablesNo: N]) #!# ASubL1, CPL, EPL) = BackVariables(ASubL #!# (Apply(SUB , V1 <- XO(V, NXT))[NewVariablesNo: N]) #!# ASubL1, CPL, EPL) if substr(string(getName(V1)), 0, 3) == "NV#" /\ CheckAsy(ApplyConBothL(CPL, (Apply(SUB , V1 <- XO(V, NXT))))) == false . ceq BackVariables(ASubL #!# ((V <- XO(V1, NXT) ; SUB)[NewVariablesNo: N]) #!# ASubL1, CPL, EPL) = BackVariables(ASubL #!# (Apply(SUB , V1 <- XO(V, NXT))[NewVariablesNo: N]) #!# ASubL1, CPL, (EPL ; ((V <- XO(V1, NXT) ; SUB) , Apply(SUB, V1 <- XO(V , NXT))))) if substr(string(getName(V1)), 0, 3) == "NV#" /\ CheckAsy(ApplyConBothL(CPL, (Apply(SUB , V1 <- XO(V, NXT))))) == true . ***eq BackVariables(ASubL, CPL, EPL) = RemoveRS(ASubL , EPL) [owise] . eq BackVariables(ASubL, CPL, EPL) = RemoveRS2(ASubL , EPL) [owise] . ************Remove redundent substitutions*************** op RemoveRS : AsySubList EqPairList -> AsySubList . ****x <- y +T and y<- x+T are equivalent. ceq RemoveRS(ASubL #!# ((V <- XO(V1, NXT) ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ((V1 <- XO(V, NXT) ; SUB1)[NewVariablesNo: N1]) #!# ASubL2 , EPL) = RemoveRS(ASubL #!# ((V <- XO(V1, NXT) ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ASubL2 , EPL) if occurs(V1, NXT, 1) == false /\ CheckRenaming((V <- XO(V1, NXT) ; SUB) , (V1 <- XO(V, NXT) ; SUB1)) == true . ceq RemoveRS(ASubL #!# ((V <- V1 ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ((V1 <- V ; SUB1)[NewVariablesNo: N1]) #!# ASubL2, EPL) = RemoveRS(ASubL #!# ((V <- V1 ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ASubL2 , EPL) if CheckRenaming((V <- V1 ; SUB), (V1 <- V ; SUB1)) == true . op CheckRenaming : Substitution Substitution -> Bool . eq CheckRenaming(SUB , SUB) = true . eq CheckRenaming((V <- V1 ; SUB) , (V1 <- V ; SUB1)) = CheckRenaming(Apply(SUB , V1 <- V) , SUB1) . eq CheckRenaming((V <- XO(V1 , NXT) ; SUB) , (V1 <- XO(V, NXT) ; SUB1)) = CheckRenaming(Apply(SUB , V1 <- XO(V, NXT)) , SUB1) . eq CheckRenaming(SUB, SUB1) = false [owise] . ops sub1 sub2 sub3 sub4 sub5 : -> Substitution . eq sub1 = 'x:Msg <- 'y:Msg ; 'z:Msg <- XO('w:Msg, 'a.Msg) ; 'v:Msg <- 'f['y:Msg, 'g[XO('w:Msg, 'a.Msg), 'b.Msg]] . eq sub2 = 'y:Msg <- 'x:Msg ; 'w:Msg <- XO('z:Msg, 'a.Msg) ; 'v:Msg <- 'f['x:Msg, 'g['z:Msg, 'b.Msg]] . eq sub3 = 'x:Msg <- 'a.Msg ; 'y:Msg <- XO('z:Msg,'w:Msg,'b.Msg) . eq sub4 = 'x:Msg <- 'a.Msg ; 'y:Msg <- 'z:Msg ; 'w:Msg <- 'b.Msg . *********x<- y+T1 +T, and x <- T ceq RemoveRS(ASubL #!# ((V <- XO(V1, NXT , XT1) ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ((V <- XT1 ; SUB1)[NewVariablesNo: N1]) #!# ASubL2 , EPL) = RemoveRS(ASubL #!# ((V <- XO(V1, NXT, XT1) ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ASubL2 , EPL) if occurs(V1, NXT, 1) == false /\ CheckRenaming(Apply((V <- XO(V1, NXT, XT1) ; V1 <- NXT ; SUB) , (V1 <- NXT)), ((V <- XT1 ; SUB1))) == true . ceq RemoveRS(ASubL #!# ((V <- XT1 ; SUB1)[NewVariablesNo: N1]) #!# ASubL1 #!# ((V <- XO(V1, NXT , XT1) ; SUB)[NewVariablesNo: N]) #!# ASubL2 , EPL) = RemoveRS(ASubL #!# ((V <- XO(V1, NXT, XT1) ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ASubL2 , EPL) if occurs(V1, NXT, 1) == false /\ CheckRenaming(Apply((V <- XO(V1, NXT, XT1) ; V1 <- NXT ; SUB) , (V1 <- NXT)), ((V <- XT1 ; SUB1))) == true . *********x->y +T, x-> T ceq RemoveRS(ASubL #!# ((V <- XO(V1, NXT1) ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ((V <- NXT1 ; SUB1)[NewVariablesNo: N1]) #!# ASubL2 , EPL) = RemoveRS(ASubL #!# ((V <- XO(V1, NXT1) ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ASubL2 , EPL) if CheckRenaming(Apply((V <- XO(V1, NXT1) ; V1 <- NilTerm ; SUB) , (V1 <- NilTerm)) , ((V <- NXT1 ; SUB1))) . ceq RemoveRS(ASubL #!# ((V <- NXT1 ; SUB1)[NewVariablesNo: N1]) #!# ASubL1 #!# ((V <- XO(V1, NXT1) ; SUB)[NewVariablesNo: N]) #!# ASubL2 , EPL) = RemoveRS(ASubL #!# ((V <- XO(V1, NXT1) ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ASubL2 , EPL) if CheckRenaming(Apply((V <- XO(V1, NXT1) ; V1 <- NilTerm ; SUB) , (V1 <- NilTerm)), ((V <- NXT1 ; SUB1))) . ********x -> y+w +S, y->x ceq RemoveRS(ASubL #!# ((V <- XO(V1 , V2 , XT1) ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ((V1 <- V ; SUB1)[NewVariablesNo: N1]) #!# ASubL2 , EPL) = RemoveRS(ASubL #!# ((V <- XO(V1 , V2 , XT1) ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ASubL2 , EPL) if occurs(V2, XT1, 1) == false /\ CheckRenaming(Apply((V <- XO(V1 , V2 , XT1) ; V2 <- XT1 ; SUB) , (V2 <- XT1)), (V1 <- V ; SUB1)) == true . ceq RemoveRS(ASubL #!# ((V1 <- V ; SUB1)[NewVariablesNo: N1]) #!# ASubL1 #!# ((V <- XO(V1 , V2 , XT1) ; SUB)[NewVariablesNo: N]) #!# ASubL2 , EPL) = RemoveRS(ASubL #!# ((V <- XO(V1 , V2 , XT1) ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ASubL2 , EPL) if occurs(V2, XT1, 1) == false /\ CheckRenaming(Apply((V <- XO(V1 , V2 , XT1) ; V2 <- XT1 ; SUB) , (V2 <- XT1)), (V1 <- V ; SUB1)) == true . **********x-> y+w +S, y-> x + T ceq RemoveRS(ASubL #!# ((V <- XO(V1 , V2 , XT1) ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ((V1 <- XO(V , XT2) ; SUB1)[NewVariablesNo: N1]) #!# ASubL2 , EPL) = RemoveRS(ASubL #!# ((V <- XO(V1 , V2 , XT1) ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ASubL2 , EPL) if occurs(V2, XO(XT1, XT2), 1) == false /\ CheckRenaming(Apply((V <- XO(V1 , V2 , XT1) ; V2 <- XO(XT1, XT2) ; SUB) , (V2 <- XO(XT1, XT2))), (V1 <- XO(V, XT2) ; SUB1)) == true . ceq RemoveRS(ASubL #!# ((V1 <- XO(V , XT2) ; SUB1)[NewVariablesNo: N1]) #!# ASubL1 #!# ((V <- XO(V1 , V2 , XT1) ; SUB)[NewVariablesNo: N]) #!# ASubL2 , EPL) = RemoveRS(ASubL #!# ((V <- XO(V1 , V2 , XT1) ; SUB)[NewVariablesNo: N]) #!# ASubL1 #!# ASubL2 , EPL) if occurs(V2, XO(XT1, XT2), 1) == false /\ CheckRenaming(Apply((V <- XO(V1 , V2 , XT1) ; V2 <- XO(XT1, XT2) ; SUB) , (V2 <- XO(XT1, XT2))), (V1 <- XO(V, XT2) ; SUB1)) == true . eq RemoveRS(ASubL , EPL) = CheckBack(ASubL , EPL) [owise] . ****Second methods for removing redundent unifiers op RemoveRS2 : AsySubList EqPairList -> AsySubList . ceq RemoveRS2(ASubL #!# (SUB [NewVariablesNo: N]) #!# ASubL1 #!# (SUB1 [NewVariablesNo: N1]) #!# ASubL2 , EPL) = RemoveRS2(ASubL #!# (SUB [NewVariablesNo: N]) #!# ASubL1 #!# ASubL2 , EPL) if (ApplyV(SUB, SUB1)) == SUB1 . ceq RemoveRS2(ASubL #!# (SUB [NewVariablesNo: N]) #!# ASubL1 #!# (SUB1 [NewVariablesNo: N1]) #!# ASubL2 , EPL) = RemoveRS2(ASubL #!# (SUB1 [NewVariablesNo: N1]) #!# ASubL1 #!# ASubL2 , EPL) if (ApplyV(SUB1, SUB)) == SUB . eq RemoveRS2(ASubL , EPL) = CheckBack(ASubL , EPL) [owise] . *****If there are some unifier is not asymmetric unifier, convert them back. op CheckBack : AsySubList EqPairList -> AsySubList . eq CheckBack((ASubL #!# SUB [NewVariablesNo: N]) #!# ASubL1 , ((SUB1 , SUB); EPL)) = CheckBack((ASubL #!# SUB1 [NewVariablesNo: N]) #!# ASubL1 , ((SUB1 , SUB); EPL)) . eq CheckBack(ASubL , EPL) = ASubL [owise] . *************************************************************************** ****************Inferenct Rules********************************************* **************************************************************************** ******************************************************** **** Preparation: **** 1. Test special cases: NoTheory, emptyproblem Illegal equations etc. **** 2. Check whether is fail. Before going to the first part, apply failure rules. **** 3. Whether it is an solution already after applying the rules in the first part. **** 4. Check whether no equivalent unifier after applying rules in the first part. **** and send the problem to the waitinglist for applying rules in the second part. ******************************************************** *** Type is used for generating new variables. *** First asyproblem list is the problemlist we need to solve. *** second asyproblem list is used to store the problems which are applied the rules in first part already . *********Int is used for test how many branched we explored. op StartOver : Module Type AsyProblemList AsyProblemList Int -> AsyProblemList . ***Special cases. eq StartOver(M, TY, NoAsyTheory, APL , N) = NoAsyTheory . eq StartOver(M, TY , NoAsyProblem , APL , N) = NoAsyProblem . eq StartOver(M, TY , IllegalAsyEquationThere , APL , N) = IllegalAsyEquationThere . eq StartOver(M, TY , NoXORSolution , APL , N) = NoXORSolution . ***eq StartOver(M, TY , FailAsyProblem, APL , N) = FailAsyProblem . eq StartOver(M, TY , FailAsyProblem, EmptyAsyProblem, N) = FailAsyProblem . eq StartOver(M, TY , FailAsyProblem, NAPL , N) = WaitingForSecondPart(M, TY , NAPL , N) . *** this is a solution. ceq StartOver(M, TY , AP $$ NAPL , APL , N) = WaitingForSecondPart(M, TY , AP , N) if GetTestResult(AP) == 1 . ceq StartOver(M, TY , AP , APL , N) = WaitingForSecondPart(M, TY , AP , N) if GetTestResult(AP) == 1 . **** Fist step check failure first, then go to the searching rules. ceq StartOver(M, TY , AP $$ NAPL , APL , N) = StartOver(M, TY , SearchingEQVE(M, TY , FailureDetect(M, TY, AP $$ NAPL)) , APL , N + 1) if GetTestResultL(AP) == 0 /\ GetFinishSearching(AP) == 0 . ***AP1 is not a equavilent unifier, and check the AP next. ceq StartOver(M, TY , (AP1 $$ AP $$ NAPL) , APL , N) = StartOver(M, TY , (AP $$ NAPL), (AP1 $$ APL) , N) if GetFinishSearching(AP1) == 1 /\ GetFinishSearching(AP) == 0 /\ GetTestResultL(AP1) == 0 /\ GetTestResultL(AP) == 0 . ceq StartOver(M, TY , (AP1 $$ AP) , APL , N) = StartOver(M, TY , (SearchingEQVE(M, TY , FailureDetect(M,TY, AP)) ), (AP1 $$ APL) , N + 1) if GetFinishSearching(AP1) == 1 /\ GetFinishSearching(AP) == 0 /\ GetTestResultL(AP1) == 0 /\ GetTestResultL(AP) == 0 . ceq StartOver(M, TY , AP , APL , N) = StartOver(M, TY , SearchingEQVE(M,TY , FailureDetect(M, TY, AP)) , APL , N + 1) if GetTestResultL(AP) == 0 /\ GetFinishSearching(AP) == 0 . **** If no equivalent unifier found, put all the problem into APL, then go to second part. ceq StartOver(M, TY , AP , APL , N) = WaitingForSecondPart(M, TY , (AP $$ APL) , N) if GetTestResultL(AP) == 0 /\ GetFinishSearching(AP) == 1 . **** This is a buffering for entering the second part. op WaitingForSecondPart : Module Type AsyProblemList Int -> AsyProblemList . **** this is a solution. ceq WaitingForSecondPart(M, TY , AP , N) = AP if GetTestResultL(AP) == 1 . *****if it is not, go to second part for instantiation. eq WaitingForSecondPart(M, TY , APL , N) = StartSecondPart(M, TY , APL , N) [owise] . *************************************** **************Failure Rules************** **************************************** ****They have the toppest priority. op FailureDetect : Module Type AsyProblem -> AsyProblem . op FailureDetect : Module Type AsyProblemList -> AsyProblemList . *********no Enough terms************* eq FailureDetect(M, TY , AP $$ NAPL) = FailureDetect(M, TY , AP) $$ FailureDetect(M, TY , NAPL) . ceq FailureDetect(M, TY, SUB // ((V <<< T) , CPL) // RPL // NLE // (XT =? XT1) /\ UfPr // N // N1 // N2 // (TF)) = FailAsyProblem if CountMonicTerms(XT) < CountMonicTerms(XT1) /\ MonicVar(XT) == false . ceq FailureDetect(M, TY, SUB // ((V <<< T) , CPL) // RPL // NLE // (XT =? XT1) // N // N1 // N2 // (TF)) = FailAsyProblem if CountMonicTerms(XT) < CountMonicTerms(XT1) /\ MonicVar(XT) == false . *********NilTerm Detected.(Identity Failure)*************** ceq FailureDetect(M, TY , (V <- NilTerm ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // TF) = FailAsyProblem if ConPairOccursL(V <<< NilTerm , CPL) == true . **************Cancellation Failure *************** ceq FailureDetect(M, TY , SUB // CPL // RPL // NLE // (XT =? XT1 /\ UfPr) // N // N1 // N2 // TF) = FailAsyProblem if TestCanPairList(ApplyCanPairsList(GetCanPairs(XT1, EmptyTermPair), SUB)) == true . *********Trivial Failure ************* eq FailureDetect(M, TY, SUB // CPL // RPL // ((NilTerm N=? NilTerm) /\ NLE) // UfPr // N // N1 // N2 // TF ) = FailAsyProblem . ********* No failure rules applicable. eq FailureDetect(M, TY , AP) = AP [owise] . *************************************************** ****** Rule Part One ************************************************** **********Variable Exchange************** op SearchingEQVE : Module Type AsyProblem -> AsyProblemList . op SearchingEQVE : Module Type AsyProblemList -> AsyProblemList . eq SearchingEQVE(M, TY , AP $$ NAPL) = SearchingEQVE(M, TY, AP) $$ NAPL . ceq SearchingEQVE(M, TY , (V <- XO(V1 , NXT) ; SUB) // ((V <<< T) , CPL) // RPL // NLE // UfPr // N // N1 // N2 // TF) = SearchingEQVE(M, TY , Apply((V1 <- XO(V, NXT) ; SUB), (V1 <- XO(V, NXT))) // ((V <<< T) , CPL) // ApplyResL(RPL , V1 <- XO(V, NXT)) // Apply(NLE , (V1 <- XO(V, NXT))) // UfPr // (N + 1) // N1 // N2 // (true)) if TermOccursL(Apply(T, (V <- XO(V1, NXT) ; SUB)), XO(V1, NXT)) == true /\ VarOccurs(V1, UfPr) == true /\ VarOccursRight(V1, UfPr) == false . ceq SearchingEQVE(M, TY , (V <- XO(V1 , NXT)) // ((V <<< T) , CPL) // RPL // NLE // UfPr // N // N1 // N2 // TF) = SearchingEQVE(M, TY , Apply(V1 <- XO(V, NXT), (V1 <- XO(V, NXT))) // ((V <<< T) , CPL) // ApplyResL(RPL , V1 <- XO(V, NXT)) // Apply(NLE , (V1 <- XO(V, NXT))) // UfPr // (N + 1) // N1 // N2 // (true)) if TermOccursL(Apply(T, (V <- XO(V1, NXT))), XO(V1, NXT)) == true /\ VarOccurs(V1, UfPr) == true /\ VarOccursRight(V1, UfPr) == false . eq SearchingEQVE(M, TY , AP) = SearchingEQSp(M, TY , AP) [owise] . **************Splitting************ op SearchingEQSp : Module Type AsyProblem -> AsyProblemList . op SearchingEQSp : Module Type AsyProblemList -> AsyProblemList . ******The reason we put the rest of the problem out is we need to stop when some equivalent unifer is found. if we dont do this, we will check all the branches even the unifier is in the first branch. eq SearchingEQSp(M, TY , AP $$ NAPL) = SearchingEQSp(M, TY , AP) $$ NAPL . *** ceq SearchingEQSp(M, TY , (V <- XO(V1 , NXT) ; SUB) // ((V <<< T) , CPL) // RPL // NLE // UfPr // N // N1 // N2 // TF) = SearchingEQSp(M, TY , Apply((V <- XO(V1 , NXT) ; V1 <- GenNewVar(TY, N) ; SUB), (V1 <- GenNewVar(TY, N) )) // ((V <<< T) , CPL) // ApplyResL(RPL , V1 <- GenNewVar(TY, N)) // Apply(NLE , (V1 <- GenNewVar(TY, N))) // UfPr // (N + 1) // N1 // N2 // (true)) if TermOccursL(Apply(T, (V <- XO(V1, NXT) ; SUB)), XO(V1, NXT)) == true /\ VarOccurs(V1, UfPr) == true . ceq SearchingEQSp(M, TY , (V <- XO(V1 , NXT) ; SUB) // ((V <<< T) , CPL) // RPL // NLE // UfPr // N // N1 // N2 // TF) = SearchingEQSp(M, TY , Apply((V <- XO(V1 , NXT) ; (V1 <- XO(GenNewVar(TY, N), ConvertTLtoTerm(GetFirstSP(Splitting(V , V1, NXT , (empty SPLITTING empty), ApplyConL(((V <<< T) , CPL), (V <- XO(V1, NXT) ; SUB))))))) ; SUB), (V1 <- XO(GenNewVar(TY, N), ConvertTLtoTerm(GetFirstSP(Splitting(V , V1, NXT , (empty SPLITTING empty), ApplyConL(((V <<< T) , CPL), (V <- XO(V1, NXT) ; SUB)))))) )) // ((V <<< T) , CPL) // ApplyResL(RPL , V1 <- GenNewVar(TY, N)) // Apply(NLE , (V1 <- GenNewVar(TY, N))) // UfPr // (N + 1) // N1 // N2 // (true)) if TermOccursL(Apply(T, (V <- XO(V1, NXT) ; SUB)), XO(V1, NXT)) == true /\ VarOccurs(V1, UfPr) == true . ceq SearchingEQSp(M, TY , (V <- XO(V1 , NXT)) // ((V <<< T) , CPL) // RPL // NLE // UfPr // N // N1 // N2 // (TF)) = SearchingEQSp(M, TY , Apply((V <- XO(V1 , NXT) ; (V1 <- XO(GenNewVar(TY, N), ConvertTLtoTerm(GetFirstSP(Splitting(V , V1, NXT , (empty SPLITTING empty), ApplyConL(((V <<< T) , CPL), (V <- XO(V1, NXT))))))))), (V1 <- XO(GenNewVar(TY, N), ConvertTLtoTerm(GetFirstSP(Splitting(V , V1, NXT , (empty SPLITTING empty), ApplyConL(((V <<< T) , CPL), (V <- XO(V1, NXT))))))) )) // ((V <<< T) , CPL) // ApplyResL(RPL, V1 <- GenNewVar(TY, N)) // Apply(NLE , (V1 <- GenNewVar(TY, N))) // UfPr // (N + 1) // N1 // N2 // (true)) if TermOccursL(Apply(T, (V <- XO(V1, NXT))), XO(V1, NXT)) == true /\ VarOccurs(V1, UfPr) == true . eq SearchingEQSp(M, TY , AP) = SearchingEQSp2(M, TY , AP) [owise] . *********Splitting-2 op SearchingEQSp2 : Module Type AsyProblem -> AsyProblemList . op SearchingEQSp2 : Module Type AsyProblemList -> AsyProblemList . ceq SearchingEQSp2(M, TY , (V <- XO(V1 , NXT) ; SUB) // ((V <<< T) , CPL) // RPL // NLE // UfPr // N // N1 // N2 // TF) = SearchingEQSp2(M, TY , Apply((V <- XO(V1 , NXT) ; V1 <- GenNewVar(TY, N) ; SUB), (V1 <- GenNewVar(TY, N))) // ((V <<< T) , CPL) // ApplyResL(RPL , V1 <- GenNewVar(TY, N)) // Apply(NLE , (V1 <- GenNewVar(TY, N))) // UfPr // (N + 1) // N1 // N2 // (true)) if VarOccurs(V1, UfPr) == true . ceq SearchingEQSp2(M, TY , (V <- V1 ; SUB) // ((V <<< T) , CPL) // RPL // NLE // UfPr // N // N1 // N2 // TF) = SearchingEQSp2(M, TY , Apply((V <- V1 ; V1 <- GenNewVar(TY, N) ; SUB), (V1 <- GenNewVar(TY, N))) // ((V <<< T) , CPL) // ApplyResL(RPL , V1 <- GenNewVar(TY, N)) // Apply(NLE , (V1 <- GenNewVar(TY, N))) // UfPr // (N + 1) // N1 // N2 // (true)) if VarOccurs(V1, UfPr) == true . eq SearchingEQSp2(M, TY , AP) = SearchingEQOC(M, TY , AP) [owise] . ******Occurs Check********** op SearchingEQOC : Module Type AsyProblem -> AsyProblemList . op SearchingEQOC : Module Type AsyProblemList -> AsyProblemList . eq SearchingEQOC(M, TY , AP $$ NAPL) = SearchingEQOC(M, TY , AP) $$ NAPL . ceq SearchingEQOC(M, TY , (V <- XO(V1 , T, NXT) ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // (TF)) = SearchingEQOC(M, TY , (V <- XO(V1 , T , NXT) ; SUB) // CPL // ((V1 ! T) , RPL) // NLE // UfPr // N // N1 // N2 // (true)) if VarOccurs(V1, UfPr) == false /\ PairOccursL((V1 ! T) , RPL) == false /\ occurs(V1 , T , 1) == true . ceq SearchingEQOC(M, TY , (V <- XO(V1 , T) ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // (TF)) = SearchingEQOC(M, TY , (V <- XO(V1 , T) ; SUB) // CPL // ((V1 ! T) , RPL) // NLE // UfPr // N // N1 // N2 // (true)) if VarOccurs(V1, UfPr) == false /\ PairOccursL((V1 ! T) , RPL) == false /\ occurs(V1 , T , 1) == true . eq SearchingEQOC(M, TY , AP) = SearchingEQNVB(M, TY , AP) [owise] . ***********NonVariable Branching********* op SearchingEQNVB : Module Type AsyProblem -> AsyProblemList . op SearchingEQNVB : Module Type AsyProblemList -> AsyProblemList . eq SearchingEQNVB(M, TY , AP $$ NAPL) = SearchingEQNVB(M, TY , AP) $$ NAPL . ceq SearchingEQNVB(M, TY , (V <- XO(V1 , T , NXT) ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // (TF)) = SearchingEQNVB(M, TY , Apply(((V <- XO(GenNewVar(TY, N), NXT)) ; SUB ), V1 <- XO(GenNewVar(TY, N), T)) // CPL // ApplyResL(((GenNewVar(TY , N) ! T), ReplaceVar(V1, GenNewVar(TY, N), RPL)), (V1 <- XO(GenNewVar(TY, N), T))) // Apply(NLE , (V1 <- XO(GenNewVar(TY, N), T))) // UfPr // N + 1 // N1 // N2 // (true)) $$ ((V <- XO(V1 , T , NXT) ; SUB) // CPL // ((V1 ! T), RPL) // NLE // UfPr // N // N1 // N2 // (true)) if VarOccurs(V1, T) == false /\ ConPairOccursL((V <<< T) , ApplyConL(CPL , V <- XO(V1, T, NXT) ; SUB)) == true /\ VarOccurs(V1, UfPr) == false /\ PairOccursL((V1 ! T), RPL) == false /\ issingle(T) == false . ceq SearchingEQNVB(M, TY , (V <- XO(V1 , T) ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // (TF)) = SearchingEQNVB(M, TY , Apply(((V <- GenNewVar(TY, N)) ; SUB ), V1 <- XO(GenNewVar(TY, N), T)) // CPL // ApplyResL(((GenNewVar(TY , N) ! T), ReplaceVar(V1, GenNewVar(TY, N), RPL)) , (V1 <- XO(GenNewVar(TY, N), T))) // Apply(NLE , (V1 <- XO(GenNewVar(TY, N), T))) // UfPr // N + 1 // N1 // N2 // (true)) $$ ((V <- XO(V1 , T) ; SUB) // CPL // ((V1 ! T), RPL) // NLE // UfPr // N // N1 // N2 // (true)) if VarOccurs(V1, T) == false /\ ConPairOccursL((V <<< T) , ApplyConL(CPL , V <- XO(V1, T) ; SUB)) == true /\ VarOccurs(V1, UfPr) = false /\ PairOccursL((V1 ! T), RPL) == false /\ issingle(T) == false . eq SearchingEQNVB(M, TY , AP) = SearchingEQVB(M, TY , AP) [owise] . ****************Variable Branching ********** op SearchingEQVB : Module Type AsyProblem -> AsyProblemList . op SearchingEQVB : Module Type AsyProblemList -> AsyProblemList . eq SearchingEQVB(M, TY , AP $$ NAPL) = SearchingEQVB(M, TY , AP) $$ NAPL . ceq SearchingEQVB(M, TY , (V <- XO(V1 , V2 , NXT) ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // (TF)) = SearchingEQVB(M, TY , Apply((V <- XO(V1 , V2 , NXT)) ; SUB , (V1 <- XO(GenNewVar(TY, N) , GenNewVar(TY, N + 1)) ; V2 <- XO(GenNewVar(TY, N), GenNewVar(TY, N + 2)))) // CPL // ApplyResL(((GenNewVar(TY , N) ! GenNewVar(TY, N + 1)), (GenNewVar(TY, N + 1) ! GenNewVar(TY , N)), (GenNewVar(TY, N + 2) ! GenNewVar(TY , N)) , (GenNewVar(TY, N) ! GenNewVar(TY , N + 2)) , (GenNewVar(TY, N + 1) ! GenNewVar(TY , N + 2)) , (GenNewVar(TY, N + 2) ! GenNewVar(TY , N + 1)), ReplaceVar(V1, GenNewVar(TY, N), RPL), ReplaceVar(V1, GenNewVar(TY, N + 1), RPL), ReplaceVar(V2, GenNewVar(TY, N), RPL), ReplaceVar(V2, GenNewVar(TY, N + 2), RPL)) , (V1 <- XO(GenNewVar(TY, N) , GenNewVar(TY, N + 1)) ; V2 <- XO(GenNewVar(TY, N), GenNewVar(TY, N + 2)))) // Apply(NLE , (V1 <- XO(GenNewVar(TY, N) , GenNewVar(TY, N + 1)) ; V2 <- XO(GenNewVar(TY, N), GenNewVar(TY, N + 2)))) // UfPr // N + 3 // N1 // N2 // (true)) $$ ((V <- XO(V1 , V2 , NXT) ; SUB) // CPL // ((V1 ! V2) , (V2 ! V1) , RPL) // NLE // UfPr // N // N1 // N2 // (true)) if ConPairOccursL((V <<< V2) , ApplyConL(CPL , V <- XO(V1, V2, NXT) ; SUB)) == true /\ VarOccurs(V1, UfPr) == false /\ PairOccursL((V1 ! V2), RPL) == false . ceq SearchingEQVB(M, TY , (V <- XO(V1 , V2) ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // (TF)) = SearchingEQVB(M, TY , Apply((V <- XO(V1 , V2)) ; SUB , (V1 <- XO(GenNewVar(TY, N) , GenNewVar(TY, N + 1)) ; V2 <- XO(GenNewVar(TY, N), GenNewVar(TY, N + 2)))) // CPL // ApplyResL(((GenNewVar(TY , N) ! GenNewVar(TY, N + 1)), (GenNewVar(TY, N + 1) ! GenNewVar(TY , N)), (GenNewVar(TY, N + 2) ! GenNewVar(TY , N)) , (GenNewVar(TY, N) ! GenNewVar(TY , N + 2)) , (GenNewVar(TY, N + 1) ! GenNewVar(TY , N + 2)) , (GenNewVar(TY, N + 2) ! GenNewVar(TY , N + 1)) , ReplaceVar(V1, GenNewVar(TY, N), RPL), ReplaceVar(V1, GenNewVar(TY, N + 1), RPL), ReplaceVar(V2, GenNewVar(TY, N), RPL), ReplaceVar(V2, GenNewVar(TY, N + 2), RPL)) , (V1 <- XO(GenNewVar(TY, N) , GenNewVar(TY, N + 1)) ; V2 <- XO(GenNewVar(TY, N), GenNewVar(TY, N + 2)))) // Apply(NLE , (V1 <- XO(GenNewVar(TY, N) , GenNewVar(TY, N + 1)) ; V2 <- XO(GenNewVar(TY, N), GenNewVar(TY, N + 2)))) // UfPr // N + 3 // N1 // N2 // (true)) $$ ((V <- XO(V1 , V2) ; SUB) // CPL // ((V1 ! V2), (V2 ! V1) , RPL) // NLE // UfPr // N // N1 // N2 // (true)) if ConPairOccursL((V <<< V2) , ApplyConL(CPL , V <- XO(V1, V2) ; SUB)) == true /\ VarOccurs(V1, UfPr) == false /\ PairOccursL((V1 ! V2), RPL) == false . ********Test EU is testing whether it is a solution. eq SearchingEQVB(M, TY , AP) = SearchingEQUB(M, TY , AP) [owise] . ******************************************************* ***** Test whether it is the equivalent unifier ***** If it is a unifier, it will set the N1 1 and go to start over **** if it is not. test whether it is fail because of the decomposition. op TestEU : Module Type AsyProblem -> AsyProblem . ceq TestEU(M, TY , (V <- XO(T , NXT) ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // (TF)) = FailureDetectII(M, TY, (V <- XO(T , NXT) ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // 1 // (TF)) if ConPairOccursL((V <<< T) , ApplyConL(CPL , V <- XO(T, NXT) ; SUB)) == true . ceq TestEU(M, TY , (V <- T ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // (TF)) = FailureDetectII(M, TY, (V <- T ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // 1 // (TF)) if ConPairOccursL((V <<< T) , ApplyConL(CPL , V <- T ; SUB)) == true . ceq TestEU(M, TY , (V <- NilTerm ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // (TF)) = FailureDetectII(M, TY, (V <- NilTerm ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // 1 // (TF)) if ConPairOccursL((V <<< NilTerm) , CPL) == true . eq TestEU(M, TY , FailAsyProblem) = FailAsyProblem . *** eq TestEU(M, TY , SUB // CPL // RPL // NLE // UfPr // N // N1 // N2 // TF) = StartOver(M, TY , SUB // CPL // RPL // NLE // UfPr // N // 1 // N2 // TF , EmptyAsyProblem , 0) [owise] . eq TestEU(M, TY , SUB // CPL // RPL // NLE // UfPr // N // N1 // N2 // TF) = SUB // CPL // RPL // NLE // UfPr // N // 1 // N2 // TF [owise] . *********Decomposition Failure *************** ********This failure rules is only applicable if no rules in first part applicable. op FailureDetectII : Module Type AsyProblemList -> AsyProblemList . op FailureDetectII : Module Type AsyProblem -> AsyProblem . eq FailureDetectII(M, TY , AP $$ NAPL) = FailureDetectII(M, TY , AP) $$ FailureDetectII(M, TY , NAPL) . ceq FailureDetectII(M, TY, ((V <- XO(QI1[TL] , NXT)) ; SUB) // ((V <<< QI1[TL1]) , CPL) // RPL // NLE // UfPr // N // N1 // N2 // TF ) = FailAsyProblem if Apply(QI1[TL1], ((V <- XO(QI1[TL] , NXT)) ; SUB)) == QI1[TL] /\ CheckDecom(QI1[TL], getSameFunctions(NXT, QI1), NLE) == true . eq FailureDetectII(M, TY, ((V <- XO(C , NXT)) ; SUB) // ((V <<< C) , CPL) // RPL // NLE // UfPr // N // N1 // N2 // TF ) = FailAsyProblem . eq FailureDetectII(M, TY , AP) = AP [owise] . *********************************************** ****Start the second part ******************************************** op StartSecondPart : Module Type AsyProblemList Int -> AsyProblemList . eq StartSecondPart(M, TY , APL , N) = NDecomIns(M, TY , APL) . *********Useless Branching ********** op SearchingEQUB : Module Type AsyProblem -> AsyProblem . op SearchingEQUB : Module Type AsyProblemList -> AsyProblemList . eq SearchingEQUB(M, TY , AP $$ NAPL) = SearchingEQUB(M, TY , AP) $$ NAPL . ceq SearchingEQUB(M, TY , (V <- XO(V1 , T , NXT) ; SUB) // CPL // RPL1 // NLE // UfPr // N // N1 // N2 // (TF)) = SearchingEQNVB(M, TY , Apply((V <- XO(GenNewVar(TY, N), NXT)) ; SUB , V1 <- XO(GenNewVar(TY, N) , T)) // CPL // ApplyResL(((GenNewVar(TY , N) ! T), ReplaceVar(V1, GenNewVar(TY, N), RPL1)), (V1 <- XO(GenNewVar(TY, N) , T))) // Apply(NLE , (V1 <- XO(GenNewVar(TY, N) , T))) // UfPr // N + 1 // N1 // N2 // (true)) $$ ((V <- XO(V1 , T , NXT) ; SUB) // CPL // ((V1 ! T) , RPL1) // NLE // UfPr // N // N1 // N2 // (true)) if ConPairOccursL((V <<< V1) , ApplyConL(CPL , V <- XO(V1, T, NXT) ; SUB)) == true /\ VarOccurs(V1, UfPr) = false /\ PairOccursL((V1 ! T), RPL1) == false /\ issingle(T) == false . *** ceq SearchingEQUB(M, TY , (V <- XO(V1 , V2 , NXT) ; SUB) // CPL // RPL1 // NLE // UfPr // N // N1 // N2 // (TF)) = SearchingEQUB(M, TY , Apply((V <- XO(GenNewVar(TY, N), NXT)) ; SUB , V1 <- XO(GenNewVar(TY, N) , V2)) // CPL // ApplyResL(((GenNewVar(TY , N) ! V2), (V2 ! GenNewVar(TY , N)), ReplaceVar(V1, GenNewVar(TY, N), RPL1)), (V1 <- XO(GenNewVar(TY, N) , V2))) // Apply(NLE, (V1 <- XO(GenNewVar(TY, N) , V2))) // UfPr // N + 1 // N1 // N2 // (true)) $$ SearchingEQUB(M, TY , (V <- XO(V1 , V2 , NXT) ; SUB) // CPL // ((V1 ! V2) , RPL1) // NLE // UfPr // N // N1 // N2 // (true)) if ConPairOccursL((V <<< V1) , ApplyConL(CPL , V <- XO(V1, V2, NXT) ; SUB)) == true /\ VarOccurs(V1, UfPr) = false /\ PairOccursL((V1 ! V2), RPL1) == false . ceq SearchingEQUB(M, TY , (V <- XO(V1 , T) ; SUB) // CPL // RPL1 // NLE // UfPr // N // N1 // N2 // (TF)) = SearchingEQNVB(M, TY , Apply((V <- (GenNewVar(TY, N))) ; SUB , V1 <- XO(GenNewVar(TY, N) , T)) // CPL // ApplyResL(((GenNewVar(TY , N) ! T), ReplaceVar(V1, GenNewVar(TY, N), RPL1)), (V1 <- XO(GenNewVar(TY, N) , T))) // Apply(NLE, (V1 <- XO(GenNewVar(TY, N) , T))) // UfPr // N + 1 // N1 // N2 // (true)) $$ ((V <- XO(V1 , T) ; SUB) // CPL // ((V1 ! T) , RPL1) // NLE // UfPr // N // N1 // N2 // (true)) if ConPairOccursL((V <<< V1) , ApplyConL(CPL , V <- XO(V1, T) ; SUB)) == true /\ VarOccurs(V1, UfPr) = false /\ PairOccursL((V1 ! T), RPL1) == false /\ issingle(T) == false . *** ceq SearchingEQUB(M, TY , (V <- XO(V1 , V2) ; SUB) // CPL // RPL1 // NLE // UfPr // N // N1 // N2 // (TF)) = SearchingEQUB(M, TY , Apply((V <- (GenNewVar(TY, N))) ; SUB , V1 <- XO(GenNewVar(TY, N) , V2)) // CPL // ApplyResL(((GenNewVar(TY , N) ! V2), (V2 ! GenNewVar(TY , N)), ReplaceVar(V1, GenNewVar(TY, N), RPL1)), (V1 <- XO(GenNewVar(TY, N) , V2))) // Apply(NLE, (V1 <- XO(GenNewVar(TY, N) , V2))) // UfPr // N + 1 // N1 // N2 // (true)) $$ SearchingEQUB(M, TY , (V <- XO(V1 , V2) ; SUB) // CPL // ((V1 ! V2) , RPL1) // NLE // UfPr // N // N1 // N2 // (true)) if ConPairOccursL((V <<< V1) , ApplyConL(CPL , V <- XO(V1, V2) ; SUB)) == true /\ VarOccurs(V1, UfPr) = false /\ PairOccursL((V1 ! V2), RPL1) == false . eq SearchingEQUB(M, TY , AP) = TestEU(M, TY , AP) [owise] . **************Decomposition Instantiation******************** op NDecomIns : Module Type AsyProblem -> AsyProblemList . op NDecomIns : Module Type AsyProblemList -> AsyProblemList . eq NDecomIns(M, TY , AP $$ NAPL ) = NDecomIns(M, TY , AP) $$ NDecomIns(M, TY , NAPL) . ceq NDecomIns(M, TY , (V <- XO(QI1[TL] , QI1[TL2] , NXT) ; SUB) // CPL // RPL1 // NLE // UfPr // N // N1 // N2 // (TF)) = TestNilTerm(M, TY, CombineSubsL((V <- XO(QI1[TL] , QI1[TL2] , NXT) ; SUB) // CPL // RPL1 // NLE // UfPr // getNewNum(purify(TY , (ConvertTLtoUP(Apply(TL, (V <- XO(QI1[TL] , QI1[TL2] , NXT) ; SUB)), Apply(TL2 , (V <- XO(QI1[TL] , QI1[TL2] , NXT) ; SUB))) || NLE || EmptyEq || N))) // N1 // N2 // (true), GetFinal(Detect(M, purify(TY , (ConvertTLtoUP(Apply(TL, (V <- XO(QI1[TL] , QI1[TL2] , NXT) ; SUB)), Apply(TL2 , (V <- XO(QI1[TL] , QI1[TL2] , NXT) ; SUB))) || NLE || EmptyEq || N)))))) $$ NDecomIns(M, TY , (V <- XO(QI1[TL] , QI1[TL2] , NXT) ; SUB) // CPL // RPL1 // (NLE /\ (XO(QI1[TL], QI1[TL2]) N=? NilTerm)) // UfPr // N // N1 // N2 // (TF)) if ConPairOccursL((V <<< QI1[TL]) , ApplyConL(CPL , (V <- XO(QI1[TL] , QI1[TL2] , NXT) ; SUB))) == true /\ POccurs(NLE, (XO(QI1[TL],QI1[TL2]) N=? NilTerm)) = false . ceq NDecomIns(M, TY , (V <- XO(QI1[TL] , QI1[TL2]) ; SUB) // CPL // RPL1 // NLE // UfPr // N // N1 // N2 // (TF)) = TestNilTerm(M, TY, CombineSubsL((V <- XO(QI1[TL] , QI1[TL2]) ; SUB) // CPL // RPL1 // NLE // UfPr // getNewNum(purify(TY , (ConvertTLtoUP(Apply(TL, (V <- XO(QI1[TL] , QI1[TL2]) ; SUB)), Apply(TL2 , (V <- XO(QI1[TL] , QI1[TL2]) ; SUB))) || NLE || EmptyEq || N))) // N1 // N2 // (true), GetFinal(Detect(M, purify(TY , (ConvertTLtoUP(Apply(TL, (V <- XO(QI1[TL] , QI1[TL2]) ; SUB)), Apply(TL2 , (V <- XO(QI1[TL] , QI1[TL2]) ; SUB))) || NLE || EmptyEq || N)))))) if ConPairOccursL((V <<< QI1[TL]) , ApplyConL(CPL , (V <- XO(QI1[TL] , QI1[TL2]) ; SUB))) == true . eq NDecomIns(M, TY , AP) = NAnnulIns(M, TY , AP) [owise] . *** eq NDecomIns(M, TY , AP) = TestNilTerm(M, TY , AP) [owise] . **********Ellimination Instatiation. op NAnnulIns : Module Type AsyProblem -> AsyProblemList . op NAnnulIns : Module Type AsyProblemList -> AsyProblemList . eq NAnnulIns(M, TY , AP $$ NAPL ) = NAnnulIns(M, TY , AP) $$ NAnnulIns(M, TY , NAPL) . ceq NAnnulIns(M, TY , (V <- XO(V1 , NXT) ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // (TF)) = NAnnulIns(M, TY , Apply(((V <- NXT) ; SUB) , V1 <- NilTerm) // CPL // ApplyResL(RPL , V1 <- NilTerm) // Apply(NLE , V1 <- NilTerm) // UfPr // N // N1 // N2 // (true)) if ConPairOccursL(V <<< V1 , ApplyConL(CPL , (V <- XO(V1 , NXT) ; SUB))) == true . *** ceq NAnnulIns(M, TY , (V <- XO(V1 , NXT) ; V2 <- XO(V1, NXT1) ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // (TF)) = TestNilTerm(M, TY , Apply(((V <- NXT) ; V2 <- NXT1 ; SUB) , V1 <- NilTerm) // CPL // ApplyResL(RPL , V1 <- NilTerm) // Apply(NLE , V1 <- NilTerm) // UfPr // N // N1 // N2 // (true)) if ConPairOccursL(V <<< V2 , CPL) == true . eq NAnnulIns(M, TY , AP) = TestNilTerm(M, TY , AP) [owise] . ******************Test NilTerm and Instance are used to test whether the instance is an asymmetric unifer. op TestInstance : Module Type AsyProblem -> AsyProblem . op TestNilTerm : Module Type AsyProblem -> AsyProblem . ceq TestNilTerm(M, TY , (V <- NilTerm ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // TF) = FailAsyProblem if ConPairOccursL(V <<< NilTerm , CPL) == true . eq TestNilTerm(M, TY , AP) = TestInstance(M, TY , AP) [owise] . ceq TestInstance(M, TY , (V <- XO(T , NXT) ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // (true)) = StartOver(M, TY , (V <- XO(T , NXT) ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // 0 // (false) , EmptyAsyProblem , 0) if ConPairOccursL((V <<< T) , ApplyConL(CPL , V <- XO(T, NXT) ; SUB)) == true . ceq TestInstance(M, TY , (V <- XO(T , NXT) ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // (false)) = FailAsyProblem if ConPairOccursL((V <<< T) , ApplyConL(CPL , V <- XO(T, NXT) ; SUB)) == true . ceq TestInstance(M, TY , (V <- T ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // true) = StartOver(M, TY , (V <- T ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // 0 // false , EmptyAsyProblem , 0) if ConPairOccursL((V <<< T) , ApplyConL(CPL , V <- T ; SUB)) == true . eq TestInstance(M, TY , FailAsyProblem) = FailAsyProblem . ceq TestInstance(M, TY , (V <- T ; SUB) // CPL // RPL // NLE // UfPr // N // N1 // N2 // false) = FailAsyProblem if ConPairOccursL((V <<< T) , ApplyConL(CPL , V <- T ; SUB)) == true . eq TestInstance(M, TY , SUB // CPL // RPL // NLE // UfPr // N // N1 // N2 // (TF)) = StartOver(M, TY , SUB // CPL // RPL // NLE // UfPr // N // 1 // N2 // (TF) , EmptyAsyProblem, 0) [owise] . ************************************************************* **************End of the rules********************************* ************************************************************** **************************************************** *******converting the result to the original format****** ***************************************************** op ConvertAsyBackList : Qid Qid Qid AsySubList -> FinalAsySubList . op ConvertAsyBack : Qid Qid Qid AsySub -> FinalAsySub . eq ConvertAsyBackList(QI1 , QI2 , QI3 , ASub #!# NASub) = ConvertAsyBack(QI1, QI2, QI3, ASub) #$# ConvertAsyBackList(QI1, QI2, QI3, NASub) . eq ConvertAsyBackList(QI1, QI2, QI3, TNoAsyTheoryFoundInFile) = NoAsyTheoryFoundInFile . eq ConvertAsyBackList(QI1, QI2, QI3, TNoAsyProblemFound) = NoAsyProblemFound . eq ConvertAsyBackList(QI1, QI2, QI3, ASub) = ConvertAsyBack(QI1, QI2, QI3, ASub) . eq ConvertAsyBackList(QI1, QI2, QI3, TIllegalEquationDetected) = IllegalEquationDetected . eq ConvertAsyBackList(QI1, QI2, QI3, TNoXORUnifier) = NoXORUnifier . eq ConvertAsyBackList(QI1, QI2, QI3, TNoAsyUnifier) = NoAsyUnifier . eq ConvertAsyBack(QI1, QI2, QI3, TNoAsyUnifier) = NoAsyUnifier . eq ConvertAsyBackList(QI1, QI2, QI3, TIDAsySub) = IDAsySub . eq ConvertAsyBack(QI1, QI2, QI3, (SUB [NewVariablesNo: N])) = (BConvertS(QI1, QI2, QI3, SUB))[NumberOfNewVariables: N] [owise] . *********************************************************** ****** The following command is for implementing our algorightm**** *********************************************************** *********Get Exclusive Or Unifiers by calling xor alrogithm op GetGeneralXORUnifier : Module UnificationProblem Int -> SubstitutionList . eq GetGeneralXORUnifier(M, UfPr, N) = GetFinal(Detect(M, purify(getXorType(getEqs(M)), Initial(UfPr) || EmptyDisEq || EmptyEq || N))) . ********After geting Excusive Or unifiers, turn them into the format of our asymmetric unifier algorithm op ConvertToAsyProblemL : SubstitutionList UnificationProblem Int -> AsyProblemList . op ConvertToAsyProblem : Substitution UnificationProblem Int -> AsyProblem . eq ConvertToAsyProblemL(SUB ### NSL , UfPr , N) = ConvertToAsyProblem(SUB , UfPr , N) $$ ConvertToAsyProblemL(NSL , UfPr , N) . eq ConvertToAsyProblemL(EmptySubstitution , UfPr , N) = EmptyAsyProblem . eq ConvertToAsyProblemL(SUB , UfPr , N) = ConvertToAsyProblem(SUB , UfPr , N) . eq ConvertToAsyProblemL(noneNoTheoryFound , UfPr , N) = NoAsyTheory . eq ConvertToAsyProblemL(noneNoProblemFound, UfPr , N) = NoAsyProblem . eq ConvertToAsyProblem(NoSubforIllegalEquation , UfPr , N) = IllegalAsyEquationThere . eq ConvertToAsyProblem(fail , UfPr , N) = NoXORSolution . eq ConvertToAsyProblem(SUB , UfPr , N) = (SUB // GetOrConstraintVL(UfPr , GetVariableList(UfPr, EmptyVariableList) , NilConPair) // NilResPair // EmptyDisEq // UfPr // N // 0 // 0 // false) [owise] . ***********Get the problem list op GetAsyProblemList : Module UnificationProblem Int -> AsyProblemList . eq GetAsyProblemList(M , noTheoryFoundProblem , N) = NoAsyTheory . eq GetAsyProblemList(M, EmptyEq , N) = NoAsyProblem . eq GetAsyProblemList(M, IllegalEquationThere, N) = IllegalAsyEquation . eq GetAsyProblemList(M , UfPr, N) = ConvertToAsyProblemL(GetGeneralXORUnifier(M, ConvertProblem(getXor(getEqs(M)) , getNil(getEqs(M)), getNilType(getEqs(M)), UfPr) , N), ConvertProblem(getXor(getEqs(M)) , getNil(getEqs(M)), getNilType(getEqs(M)), UfPr) , getNewNum(purify(getXorType(getEqs(M)), Initial(ConvertProblem(getXor(getEqs(M)) , getNil(getEqs(M)), getNilType(getEqs(M)), UfPr)) || EmptyDisEq || EmptyEq || N))) [owise] . op GetAsyProblemList2 : Module Substitution UnificationProblem Int -> AsyProblemList . eq GetAsyProblemList2(M, SUB , UfPr, N) = ConvertToAsyProblemL(SUB, ConvertProblem(getXor(getEqs(M)) , getNil(getEqs(M)), getNilType(getEqs(M)), UfPr), getNewNum(purify(getXorType(getEqs(M)), Initial(ConvertProblem(getXor(getEqs(M)) , getNil(getEqs(M)), getNilType(getEqs(M)), UfPr)) || EmptyDisEq || EmptyEq || N))) . ***********Split xor unifiers************** op SplitUn : Module Type AsyProblemList -> AsyProblemList . eq SplitUn(M, TY , AP $$ NAPL) = StartOver(M, TY, AP, EmptyAsyProblem, 0) $$ SplitUn(M, TY, NAPL) . eq SplitUn(M, TY, AP) = StartOver(M, TY, AP, EmptyAsyProblem, 0) . eq SplitUn(M, TY, EmptyAsyProblem) = StartOver(M, TY, EmptyAsyProblem, EmptyAsyProblem, 0) . eq SplitUn(M, TY, FailAsyProblem) = FailAsyProblem . eq SplitUn(M, TY, NoXORSolution) = NoXORSolution . eq SplitUn(M, TY , NoAsyProblem) = NoAsyProblem . eq SplitUn(M, TY , NoAsyTheory) = NoAsyTheory . eq SplitUn(M, TY , IllegalAsyEquation) = IllegalAsyEquation . eq SplitUn(M, TY , IllegalAsyEquationThere) = IllegalAsyEquationThere . ***********Call function op AsyUn : Module UnificationProblem Int -> SubstitutionList . eq AsyUn(M, UfPr, N) = GetAsySubstitutionL(SplitUn(M, getXorType(getEqs(M)), GetAsyProblemList(M, UfPr, N))) . ***************** op AsyUni : Module UnificationProblem Int -> AsySubList . eq AsyUni(M, UfPr, N) = GetFinalAsySubList(SplitUn(M, getXorType(getEqs(M)), GetAsyProblemList(M, UfPr, N))) . op AsyUnification : Module UnificationProblem Int -> FinalAsySubList . eq AsyUnification(M , UfPr, N) = ConvertAsyBackList(getXor(getEqs(M)) , getNil(getEqs(M)), getNilType(getEqs(M)) , GetFinalAsySubList(SplitUn(M, getXorType(getEqs(M)), GetAsyProblemList(M, UfPr, N)))) . op AsyUnification2 : Module Substitution UnificationProblem Int -> FinalAsySubList . eq AsyUnification2(M, SUB , UfPr, N) = ConvertAsyBackList(getXor(getEqs(M)) , getNil(getEqs(M)), getNilType(getEqs(M)) , GetFinalAsySubList(SplitUn(M, getXorType(getEqs(M)), GetAsyProblemList2(M, SUB , UfPr, N)))) . ***********Final Command******* op Asy : Module UnificationProblem Int -> FinalAsySubList . eq Asy(M,UfPr, N) = AsyUnification(M, UfPr, N) . op Asy2 : Substitution UnificationProblem Int -> FinalAsySubList . eq Asy2(SUB , UfPr , N) = AsyUnification2(upModule('AsyXTheory,false), SUB , UfPr, N) . ********** op RAsyUnification : Module UnificationProblem Int -> FinalAsySubList . ***eq RAsyUnification(M, UfPr, N) = ConvertAsyBackList(getXor(getEqs(M)) , getNil(getEqs(M)), getNilType(getEqs(M)) , BackVariables(GetFinalAsySubList(SplitUn(M, getXorType(getEqs(M)), GetAsyProblemList(M, UfPr, N))) , GetOrConstraintVL(UfPr , GetVariableList(UfPr, EmptyVariableList) , NilConPair) , NilEqPair)) . **** eq RAsyUnification(M, UfPr, N) = ConvertAsyBackList(getXor(getEqs(M)) , getNil(getEqs(M)), getNilType(getEqs(M)) , BackVariables(GetFinalAsySubList(SplitUn(M, getXorType(getEqs(M)), GetAsyProblemList(M, UfPr, N))) , GetConPairList(GetAsyProblemList(M, UfPr, N)) , NilEqPair)) . eq RAsyUnification(M , UfPr, N) = ConvertAsyBackList(getXor(getEqs(M)) , getNil(getEqs(M)), getNilType(getEqs(M)) , BackVariables(GetFinalAsySubList(SplitUn(M, getXorType(getEqs(M)), GetAsyProblemList(M, UfPr, N))) , GetConPairListL(GetAsyProblemList(M, UfPr, N)) , NilEqPair)) . op RAsyUnification2 : Module Substitution UnificationProblem Int -> FinalAsySubList . eq RAsyUnification2(M, SUB , UfPr, N) = ConvertAsyBackList(getXor(getEqs(M)) , getNil(getEqs(M)), getNilType(getEqs(M)) , BackVariables(GetFinalAsySubList(SplitUn(M, getXorType(getEqs(M)), GetAsyProblemList2(M, SUB , UfPr , N))) , GetOrConstraintVL(UfPr , GetVariableList(UfPr, EmptyVariableList) , NilConPair) , NilEqPair)) . op RAsy : Module UnificationProblem Int -> FinalAsySubList . eq RAsy(M,UfPr, N) = RAsyUnification(M, UfPr, N) . op RAsy2 : Substitution UnificationProblem Int -> FinalAsySubList . eq RAsy2(SUB , UfPr, N) = RAsyUnification2(upModule('AsyXTheory,false), SUB, UfPr, N) . *******testing commands ********** op testConvertAsy : UnificationProblem -> UnificationProblem . eq testConvertAsy(UfPr) = ConvertProblem(getXor(getEqs(upModule('AsyXTheory, false))) , getNil(getEqs(upModule('AsyXTheory, false))), getNilType(getEqs(upModule('AsyXTheory, false))), UfPr) . op TestGetVariableList : UnificationProblem -> VariableList . eq TestGetVariableList(UfPr) = GetVariableList(UfPr, EmptyVariableList) . op TestGetOrConstraintVL : UnificationProblem -> ConPairList . eq TestGetOrConstraintVL(UfPr) = GetOrConstraintVL(UfPr , TestGetVariableList(UfPr), NilConPair) . op CountNumber : FinalAsySubList -> Int . eq CountNumber(FAS #$# NFASL) = CountNumber(NFASL) + 1 . eq CountNumber(IDAsySub) = 0 . eq CountNumber(FAS) = 1 [owise] . op SimpleSearchingEQ : Module Substitution UnificationProblem -> SubstitutionList . eq SimpleSearchingEQ(M, SUB , UfPr) = GetAsySubstitutionL(StartOver(M, 'val , SUB // GetOrConstraintVL(UfPr , GetVariableList(UfPr, EmptyVariableList) , NilConPair) // NilResPair // EmptyDisEq // UfPr // 0 // 0 // 0 // false , EmptyAsyProblem , 0)) . op TestFailureDetect : UnificationProblem -> FinalAsySubList . eq TestFailureDetect(UfPr) = ConvertAsyBackList(getXor(getEqs(upModule('AsyXTheory, false))) , getNil(getEqs(upModule('AsyXTheory, false))), getNilType(getEqs(upModule('AsyXTheory, false))) , GetFinalAsySubList(FailureDetect(upModule('AsyXTheory,false), getXorType(getEqs(upModule('AsyXTheory, false))), GetAsyProblemList(upModule('AsyXTheory,false), UfPr, 0)))) . ************ Examples ops q0 q1 q2 q3 q4 q5 q6 q7 q8 q9 q10 q11 q12 q13 q14 q15 q16 q17 q18 q19 q20 : -> UnificationProblem . ops q21 q22 q23 q24 q25 q26 q27 q28 q29 q30 q31 q32 q33 q34 q35 q36 q37 q38 q39 q40 q41 q42 q43 q44 q45 q46 q47 q48 q49 q50 : -> UnificationProblem . ops c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 c10 c11 c12 c13 c14 c15 c16 c17 c18 c19 c20 c21 c22 c23 c24 c25 c26 c27 c28 c29 c30 c31 c32 c33 c34 c35 c36 c37 c38 c39 c40 : -> UnificationProblem . ops c41 c42 c43 c44 c45 c46 c47 c48 c49 c50 c51 c52 c53 c53 c54 c55 c56 c57 c58 c59 c60 c61 c62 c63 c64 c65 : -> UnificationProblem . eq c61 = 'pk['#5:Name,'_*_['n['i.Name,'#0:Fresh],'n['#5:Name,'#3:Fresh]]] =? 'pk['i.Name,'_*_['n['a.Name,'#1:Fresh],'#2:NNSet]] . eq c41 = 'XOR['x:Msg, 'y:Msg] =? 'XOR['x:Msg, 'y:Msg] . eq c42 = 'XOR['z1:Msg, 'z11:Msg] =? 'XOR['z1:Msg, 'z11:Msg] . eq c43 = 'XOR['z2:Msg, 'z13:Msg] =? 'XOR['z2:Msg, 'z13:Msg] . eq c44 = 'XOR['z3:Msg, 'z12:Msg] =? 'XOR['z3:Msg, 'z12:Msg] . eq c45 = 'XOR['x:Msg, 'XOR['y:Msg , 'XOR['z1:Msg, 'XOR['z2:Msg, 'z3:Msg]]]] =? '0.Null . eq c46 = 'XOR['z11:Msg, 'XOR['y:Msg , 'XOR['z1:Msg, 'z2:Msg]]] =? '0.Null . eq c47 = 'XOR['z12:Msg, 'XOR['y:Msg , 'XOR['z1:Msg, 'z3:Msg]]] =? '0.Null . eq c48 = 'XOR['z13:Msg, 'XOR['y:Msg , 'XOR['z2:Msg, 'z3:Msg]]] =? '0.Null . eq c49 = c41 /\ c42 /\ c43 /\ c44 /\ c45 /\ c46 /\ c47 /\ c48 . eq c1 = 'XOR['x:Msg, 'a.Msg] =? 'XOR['x:Msg, 'a.Msg] . eq c2 = 'XOR['x:Msg, 'b.Msg] =? 'XOR['x:Msg, 'b.Msg] . eq c3 = 'XOR['x:Msg, 'c.Msg] =? 'XOR['x:Msg, 'c.Msg] . eq c4 = 'XOR['x:Msg, 'd.Msg] =? 'XOR['x:Msg, 'd.Msg] . eq c5 = 'XOR['y:Msg, 'a.Msg] =? 'XOR['y:Msg, 'a.Msg] . eq c6 = 'XOR['y:Msg, 'b.Msg] =? 'XOR['y:Msg, 'b.Msg] . eq c7 = 'XOR['y:Msg, 'c.Msg] =? 'XOR['y:Msg, 'c.Msg] . eq c8 = 'XOR['y:Msg, 'd.Msg] =? 'XOR['y:Msg, 'd.Msg] . eq c9 = 'XOR['z:Msg, 'a.Msg] =? 'XOR['z:Msg, 'a.Msg] . eq c10 = 'XOR['z:Msg, 'b.Msg] =? 'XOR['z:Msg, 'b.Msg] . eq c11 = 'XOR['z:Msg, 'c.Msg] =? 'XOR['z:Msg, 'c.Msg] . eq c12 = 'XOR['z:Msg, 'd.Msg] =? 'XOR['z:Msg, 'd.Msg] . eq c13 = 'XOR['x:Msg, 'y:Msg] =? 'XOR['x:Msg, 'y:Msg] . eq c14 = 'XOR['x:Msg, 'z:Msg] =? 'XOR['x:Msg, 'z:Msg] . eq c15 = 'XOR['x:Msg, 'w:Msg] =? 'XOR['x:Msg, 'w:Msg] . eq c16 = 'XOR['y:Msg, 'z:Msg] =? 'XOR['y:Msg, 'z:Msg] . eq c17 = 'XOR['y:Msg, 'w:Msg] =? 'XOR['y:Msg, 'w:Msg] . eq c18 = 'XOR['z:Msg, 'w:Msg] =? 'XOR['z:Msg, 'w:Msg] . eq c19 = 'XOR['x:Msg, '0.Null] =? 'XOR['x:Msg, '0.Null] . eq c20 = 'XOR['y:Msg, '0.Null] =? 'XOR['y:Msg, '0.Null] . eq c21 = 'XOR['z:Msg, '0.Null] =? 'XOR['z:Msg, '0.Null] . eq c22 = 'XOR['w:Msg, '0.Null] =? 'XOR['w:Msg, '0.Null] . eq c60 = 'XOR['x:Msg, 'y:Msg] =? 'XOR['a.Msg, 'b.Msg] . eq c23 = 'XOR['x:Msg, 'y:Msg, 'z:Msg] =? 'a.Msg . eq c33 = 'XOR['x1:Msg, 'y1:Msg, 'z1:Msg] =? 'b.Msg . eq c34 = 'XOR['x1:Msg, 'y1:Msg] =? 'XOR['x1:Msg, 'y1:Msg] . eq c35 = 'XOR['x1:Msg, 'z1:Msg] =? 'XOR['x1:Msg, 'z1:Msg] . eq c24 = 'XOR['x:Msg, 'y:Msg, 'z:Msg] =? 'XOR['a.Msg, 'b.Msg] . eq c25 = 'XOR['x:Msg, 'y:Msg, 'z:Msg] =? 'XOR['a.Msg, 'b.Msg, 'c.Msg] . eq c26 = 'XOR['x:Msg, 'y:Msg, 'z:Msg] =? 'XOR['a.Msg, 'b.Msg, 'c.Msg, 'd.Msg] . eq c27 = 'XOR['x:Msg, 'y:Msg, 'z:Msg] =? 'XOR['a.Msg, 'b.Msg, 'c.Msg, 'd.Msg, 'e.Msg] . eq c27 = 'XOR['x:Msg, 'y:Msg, 'z:Msg] =? 'XOR['a.Msg, 'b.Msg, 'c.Msg, 'd.Msg, 'e.Msg] . eq c32 = 'XOR['x:Msg, 'y:Msg, 'z:Msg, 'w:Msg] =? 'XOR['a.Msg, 'b.Msg, 'c.Msg, 'd.Msg, 'e.Msg] . *********Dont try c32. It will go forever.... eq c36 = 'XOR['x:Msg, 'y:Msg, 'z:Msg, 'w:Msg] =? 'a.Msg . eq c37 = 'XOR['x:Msg, 'y:Msg, 'z:Msg, 'w:Msg] =? 'XOR['a.Msg, 'b.Msg] . eq c38 = 'XOR['x:Msg, 'y:Msg, 'z:Msg, 'w:Msg] =? 'XOR['a.Msg, 'b.Msg, 'c.Msg] . eq c39 = 'XOR['x:Msg, 'y:Msg, 'z:Msg, 'w:Msg] =? 'XOR['a.Msg, 'b.Msg, 'c.Msg, 'd.Msg] . ********this problem c39 will go about half an hour. eq c28 = 'XOR['x:Msg, 'y:Msg] =? 'a.Msg . eq c29 = 'XOR['x:Msg, 'y:Msg] =? 'XOR['a.Msg, 'b.Msg] . eq c30 = 'XOR['x:Msg, 'y:Msg] =? 'XOR['a.Msg, 'b.Msg, 'c.Msg] . eq c31 = 'XOR['x:Msg, 'y:Msg] =? 'XOR['a.Msg, 'b.Msg, 'c.Msg, 'd.Msg] . eq q0 = 'a:Msg =? '0.Null . eq q1 = 'a:Msg =? 'b:Msg . eq q2 = 'y:Msg =? 'XOR['a.Msg, 'x:Msg] . eq q3 = 'a:Msg =? 'XOR['a:Msg, 'b:Msg, 'c:Msg] . eq q4 = 'a:Msg =? 'XOR['a:Msg, 'b:Msg, 'd.Msg] . eq q5 = 'a:Msg =? 'f['XOR['a:Msg, 'c:Msg]] . eq q6 = 'a:Msg =? 'g['XOR['a:Msg, 'b:Msg], 'c:Msg] . eq q7 = 'a:Msg =? 'XOR['f['a:Msg, 'b:Msg], 'd.Msg] . eq q8 = 'a:Msg =? 'XOR['g['a:Msg, 'XOR['b:Msg, 'd:Msg, 'e:Msg]], 'a:Msg, 'e:Msg] . eq q9 = 'a:Msg =? ('g['XOR['b:Msg, 'f['XOR['d:Msg, 'e:Msg]]], 'a:Msg]) . eq q10 = 'XOR['g:Msg, 'f:Msg] =? 'XOR['f['XOR['m:Msg,'o:Msg]], 'n:Msg, 'o:Msg] . eq q11 = 'g:Msg =? 'XOR['f['XOR['m:Msg,'o:Msg]], 'n:Msg, 'o:Msg] . eq q12 = q9 /\ q2 . eq q13 = q3 /\ q2 . eq q14 = 'XOR['x:Msg , 'a.Msg] =? 'XOR['x:Msg , 'a.Msg] . eq q15 = 'XOR['x:Msg , 'b.Msg] =? 'XOR['x:Msg , 'b.Msg] . eq q16 = 'XOR['y:Msg , 'a.Msg] =? 'XOR['y:Msg , 'a.Msg] . eq q17 = 'XOR['y:Msg , 'b.Msg] =? 'XOR['y:Msg , 'b.Msg] . eq q18 = 'z:Msg =? 'z:Msg . eq q19 = q14 /\ q15 /\ q16 /\ q17 /\ q18 . eq q20 = 'XOR['y:Msg , 'x:Msg] =? 'XOR['y:Msg , 'x:Msg] . eq q21 = q14 /\ q15 /\ q16 /\ q17 /\ q18 /\ q20 . eq q22 = 'XOR['x:Msg , 'y:Msg , 'z:Msg] =? 'XOR['x:Msg , 'y:Msg , 'z:Msg] . eq q23 = q22 /\ q14 /\ q16 . eq q24 = 'XOR['x:Msg , 'y:Msg , 'z:Msg] =? 'XOR['a.Msg , 'b.Msg , 'c.Msg] . eq q25 = q24 /\ q14 /\ q16 . eq q26 = q24 /\ q20 . eq q27 = 'XOR['a.Msg, 'b.Msg] =? 'XOR['x:Msg , 'y:Msg] . eq q28 = 'XOR['f['a.Msg] , 'f['b.Msg]] =? 'XOR['x:Msg , 'f['y:Msg]] . eq q29 = ('XOR['x:sort, 'f['y:sort] , 'f['x1:sort]] =? '0.Null) /\ ('XOR['y:sort , 'f['z:sort], 'f['x2:sort]] =? '0.Null) /\ ('XOR['z:sort , 'f['x:sort] , 'f['x3:sort]] =? '0.Null) . ***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 q30 = '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 q31 = EmptyEq . eq q32 = 'XOR['x:Msg, 'a.Msg] =? 'XOR['b.Msg, 'c.Msg] . eq q33 = 'z:Msg =? 'XOR['f['XOR['x:Msg, 'c.Msg]], 'f['b.Msg, 'c.Msg]] . eq q34 = q32 /\ q33 . eq q35 = 'XOR['f['x:Msg], 'f['a.Msg]] =? 'XOR['x:Msg, 'XOR['y:Msg, 'c.Msg]] . eq q36 = 'x:Msg =? '0.Null . eq q37 = 'x:Msg =? 'XOR['y:Msg , 'c.Msg, 'd.Msg] . eq q38 = 'XOR['y:Msg , 'c.Msg] =? 'XOR['y:Msg , 'c.Msg] . eq q39 = 'XOR['x:Msg , 'c.Msg] =? 'XOR['x:Msg , 'c.Msg] . ops s0 s1 s2 s3 s4 s5 s6 s7 s8 s9 s10 s11 s12 s13 s14 s15 s16 s17 s18 s19 s20 s21 s22 s23 s24 s25 s26 s27 s28 s29 s30 s31 s32 s33 s34 s35 s36 s37 s38 s39 s40 s41 s42 s43 s44 s45 s46 s47 : -> Substitution . eq s0 = 'x:Msg <- 'a.Msg . eq s1 = 'x:Msg <- 'y:Msg . eq s2 = 'x:Msg <- 'XOR['a.Msg, 'y:Msg] . eq s3 = 'x:Msg <- 'f['a.Msg] . eq s4 = 'x:Msg <- 'XOR['f['a.Msg], 'b.Msg, 'd.Msg] . eq s5 = 'x:Msg <- 'g['XOR['a.Msg, 'y:Msg, 'd.Msg], 'e.Msg] . eq s6 = 'x:Msg <- 'XOR['y:Msg , 'z:Msg , 'a.Msg , 'b.Msg] . eq s7 = 'x:Msg <- 'XOR['y:Msg , 'a.Msg , 'b.Msg] . eq s8 = 'x:Msg <- 'XOR['v1:Msg, 'v2:Msg, 'a.Msg] . eq s9 = 'y:Msg <- 'XOR['v1:Msg, 'b.Msg] . eq s10 = 'z:Msg <- 'XOR['v2:Msg , 'c.Msg] . eq s11 = (s8 ; s9 ; s10) . eq s12 = 'x:Msg <- 'XOR['v1:Msg , 'a.Msg] . eq s13 = 'y:Msg <- 'XOR['v1:Msg , 'b.Msg] . eq s14 = (s12 ; s13) . eq s15 = 'x:Msg <- 'XOR['f['a.Msg] , 'f['b.Msg] , 'f['y:Msg]] . eq s16 = 'x:Msg <- XO('NV#1:Msg, XO('NV#2:Msg , XO('NV#3:Msg , 'NV#4:Msg))) . eq s17 = 'y:Msg <- 'NV#1:Msg . eq s18 = 'z1:Msg <- 'NV#2:Msg . eq s19 = 'z2:Msg <- 'NV#3:Msg . eq s20 = 'z3:Msg <- 'NV#4:Msg . eq s21 = 'z11:Msg <- XO('NV#1:Msg, XO('NV#2:Msg , 'NV#3:Msg)) . eq s22 = 'z12:Msg <- XO('NV#1:Msg, XO('NV#2:Msg , 'NV#4:Msg)) . eq s23 = 'z13:Msg <- XO('NV#1:Msg, XO('NV#3:Msg , 'NV#4:Msg)) . eq s24 = (s16 ; s17 ; s18 ; s19 ; s20 ; s21 ; s22 ; s23) . eq s25 = 'NV#1:Msg <- XO('w1:Msg, XO('w2:Msg , 'w3:Msg)) . eq s26 = 'NV#2:Msg <- XO('w1:Msg, 'w:Msg) . eq s27 = 'NV#3:Msg <- XO('w2:Msg, 'w:Msg) . eq s28 = 'NV#4:Msg <- XO('w3:Msg, 'w:Msg) . eq s29 = (s25 ; s26 ; s27 ; s28) . eq s30 = 'x:Msg <- XO('NV#1:Msg , XO('NV#2:Msg , 'NV#3:Msg)) . eq c50 = 'XOR['z1:Msg , 'z2:Msg] =? 'XOR['x:Msg , 'y:Msg] . ops tl1 tl2 tl3 tl4 tl5 tl6 : -> TermList . ops cpl1 cpl2 cpl3 cpl4 cpl5 : -> ConPairList . eq cpl1 = (('x:Msg <<< 'a.Msg) , ('x:Msg <<< 'b.Msg) , ('y:Msg <<< 'x:Msg) , ('x:Msg <<< 'f['y:Msg] ) , ('x:Msg <<< 't:Msg)) . eq cpl2 = 'x:Msg <<< 'a.Msg . eq cpl3 = (('x:Msg <<< 'a.Msg) , ('x:Msg <<< 'b.Msg), ('y:Msg <<< 'x:Msg)). eq cpl3 = (('x:Msg <<< 'a.Msg) , ('x:Msg <<< 'b.Msg), ('y:Msg <<< 'x:Msg)). ops xor1 xor2 xor3 xor4 xor5 xor6 : -> XORTerm . eq xor1 = XO('x:Msg, XO('a.Msg, XO('b.Msg, XO('e.Msg, XO('f['y:Msg] , 't:Msg))))) . endfm fmod CHECKXOR is pr META-LEVEL-MNPA . pr MODULE-HANDLING . pr AsyXorUnif * (sort Problem to ProblemXOR, op GenNewVar`(_`,_`) to GenNewVarXOR`(_`,_`), op _~_ to _~XOR_ ) . ******************************************************************** op checkXOR : Module -> Module [memo] . eq checkXOR(M:Module) = if getXor(getEqs(M:Module)) :: Qid and getXor(getEqs(M:Module)) =/= 'noTheoryFound then checkXOR*(getXor(getEqs(M:Module)),M:Module) else M:Module fi . op checkXOR* : Qid Module -> Module . eq checkXOR*(QI1:Qid, mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet O:OpDeclSet M:MembAxSet (eq QI1:Qid[QI2:Qid, QI3:Qid] = QI3:Qid [AtS1:AttrSet nonexec label('XOR-UNITY) metadata("builtin-unify")] . ) (eq QI1:Qid[QI3:Qid, QI3:Qid] = QI2:Qid [AtS2:AttrSet nonexec label('XOR-NilPotent) metadata("builtin-unify")] .) E:EquationSet R:RuleSet endm) = mod (addsufix '-CHECKEDXOR To Q:Qid) is IL:ImportList sorts S:SortSet . S:SubsortDeclSet O:OpDeclSet M:MembAxSet (eq QI1:Qid[QI2:Qid, QI3:Qid] = QI3:Qid [AtS1:AttrSet variant] .) (eq QI1:Qid[QI3:Qid, QI3:Qid] = QI2:Qid [AtS2:AttrSet variant] .) (eq QI1:Qid[QI3:Qid, QI3:Qid, addType getType(QI3:Qid) ToVar 'ZXYH ] = addType getType(QI3:Qid) ToVar 'ZXYH [AtS2:AttrSet variant] .) E:EquationSet R:RuleSet endm . eq checkXOR*(QI1:Qid, fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet O:OpDeclSet M:MembAxSet (eq QI1:Qid[QI2:Qid, QI3:Qid] = QI3:Qid [AtS1:AttrSet nonexec label('XOR-UNITY) metadata("builtin-unify")] .) (eq QI1:Qid[QI3:Qid, QI3:Qid] = QI2:Qid [AtS2:AttrSet nonexec label('XOR-NilPotent) metadata("builtin-unify")] .) E:EquationSet endfm) = fmod (addsufix '-CHECKEDXOR To Q:Qid) is IL:ImportList sorts S:SortSet . S:SubsortDeclSet O:OpDeclSet M:MembAxSet (eq QI1:Qid[QI2:Qid, QI3:Qid] = QI3:Qid [AtS1:AttrSet variant] .) (eq QI1:Qid[QI3:Qid, QI3:Qid] = QI2:Qid [AtS2:AttrSet variant] .) (eq QI1:Qid[QI3:Qid, QI3:Qid, addType getType(QI3:Qid) ToVar 'ZXYH ] = addType getType(QI3:Qid) ToVar 'ZXYH [AtS2:AttrSet variant] .) E:EquationSet endfm . endfm fmod META-MSG-UNIFICATION-INTEGRATION is pr META-ACU-UNIFICATION . pr META-MATCH . pr HEunification * (sort Problem to ProblemHE, op GenNewVar`(_`,_`) to GenNewVarHE`(_`,_`), op Solve(_,_,_) to metaHEUnify, op HasHomomorphism to IsMetaHEUnify, op getTypeHomomorphism to getTypeHomoUnify, op _#_ to _HE#_ ) . pr AsyXorUnif * (sort Problem to ProblemXOR, op GenNewVar`(_`,_`) to GenNewVarXOR`(_`,_`), op _~_ to _~XOR_ ) . 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'' TL3 : TermList . var NeTL : NeTermList . var U : UnificationPair . vars US US' : UnificationPairSet . var SS SS' : SubstitutionSet . vars TP TP' TP1 TP2 : Type . var TPS : TypeSet . var TPL : TypeList . var AtS : AttrSet . var OPDS : OpDeclSet . ******************************************************************** *** Here we can easily integrate different unification procedures ******************************************************************** op metaMsgUnify*Msg : Module Term Term Nat -> UnificationTripleSet . eq metaMsgUnify*Msg(M, T, T', N) = metaMsgUnify*Msg(M, T, T', empty, N) . op metaMsgUnify*Msg : Module Term Term TermList Nat -> UnificationTripleSet . ceq metaMsgUnify*Msg(M, T, T', TL, N) = split(metaOrderSortedFilter(M,{orient(M,S),N'}),T) if IsMetaHEUnify(M) *** /\ unifiable ; S ; N' := metaHEUnify(M, T ~ T', N) . ceq metaMsgUnify*Msg(M, T, T', TL, N) = split(metaOrderSortedFilter(M,orient(M,SS,N')),T) if IsMetaXORUnify(M) *** /\ S:FinalSub [NumberOfNewVariables: N'] := RAsy#(M, | T T' TL |, N) *** Asymmetric XOR Unification /\ SS := convertToSubs(M,S:FinalSub) . eq metaMsgUnify*Msg(M, T, T', TL, N) = empty [owise] . op |___| : Term Term TermList -> UnificationProblem . eq | T1 T2 empty | = T1 =? T2 . eq | T1 T2 (T,TL) | = T =? T /\ | T1 T2 TL | . **** op RAsy# : Module UnificationProblem Int -> FinalAsySubList . eq RAsy#(M,UfPr:UnificationProblem, N) = if RAsy(M,UfPr:UnificationProblem, N) == IDAsySub then IDENTITY [NumberOfNewVariables: N] else RAsy(M,UfPr:UnificationProblem, N) fi . **** 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 : Module FinalSub -> SubstitutionSet . eq convertToSubs(M,NoSolution) = empty . ceq convertToSubs(M,S1:FinalSub ### S2:FinalSub) = convertToSubs(M,S1:FinalSub) | convertToSubs(M,S2:FinalSub) if S1:FinalSub =/= IDENTITY and S2:FinalSub =/= IDENTITY . eq convertToSubs(M,S:FinalSub) = convertToSubsE(M,S:FinalSub) [owise] . op convertToSubsE : Module FinalSub -> Substitution . eq convertToSubsE(M,IDENTITY) = none . eq convertToSubsE(M,(T1:Term <- T2:Term) ; S2:FinalSub) = T1:Term <- T2:Term ; convertToSubsE(M,S2:FinalSub) . ******************************************************************** *** 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',{S,N}) = metaOrderSortedFilterE*(M,S',{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',{S,N}) = metaOrderSortedFilterE*C(M,S',{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',{S,N}) = metaOrderSortedFilterE*F(M,S',{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') /\ not (getXor(getEqs(M)) :: Qid and getXor(getEqs(M)) =/= 'noTheoryFound) or (getXor(getEqs(M)) :: Qid and getXor(getEqs(M)) =/= F) . ceq metaOrderSortedFilterE*F(M,S',{V <- F[TL1,V1,TL2] ; S,N}) = metaOrderSortedFilterE(M,S',{V1 <- F[TL1,V,TL2] ; S,N}) if getXor(getEqs(M)) :: Qid and getXor(getEqs(M)) == F and typeLeq(M,getType(V),leastSort(M,F[TL1,V1,TL2])) and getType(V) =/= leastSort(M,F[TL1,V1,TL2]) and typeLeq(M,leastSort(M,F[TL1,V,TL2]),getType(V1)) and not dom S in V1 and not dom S' in V1 and not range S in V1 . ceq metaOrderSortedFilterE*F(M,S',{V1 <- F[TL1,V,TL2] ; V2 <- F[TL1',V,TL2'] ; S,N}) = metaOrderSortedFilterE(M,S' << (V <- V'),{(V1 <- F[TL1,V,TL2] ; V2 <- F[TL1',V,TL2'] ; S) << (V <- V'),s(N)}) if getXor(getEqs(M)) :: Qid and getXor(getEqs(M)) == F and typeLeq(M,getType(V1),leastSort(M,F[TL1,V,TL2])) and getType(V1) =/= leastSort(M,F[TL1,V,TL2]) and typeLeq(M,getType(V2),leastSort(M,F[TL1',V,TL2'])) and getType(V2) =/= leastSort(M,F[TL1',V,TL2']) and getType(V1) == getType(V2) and typeLeq(M,leastSort(M,F[TL1,V1,TL2]),getType(V)) and typeLeq(M,leastSort(M,F[TL1',V2,TL2']),getType(V)) /\ V' := newVar(N,getType(V1)) . ceq metaOrderSortedFilterE*F(M,S',{V <- F[TL1,V1,TL2,V2,TL3] ; S,N}) = metaOrderSortedFilterE(M,S',{V <- TT:Term ; V1 <- V2 ; S,N}) if getType(V) =/= leastSort(M,F[TL1,V1,TL2,V2,TL3]) and typeLeq(M,getType(V),leastSort(M,F[TL1,V1,TL2,V2,TL3])) and typeLeq(M,getType(V1),leastSort(M,F[TL1,V1,TL2,V2,TL3])) and typeLeq(M,getType(V2),leastSort(M,F[TL1,V1,TL2,V2,TL3])) and typeLeq(M,getType(V2),getType(V1)) and getXor(getEqs(M)) :: Qid and getXor(getEqs(M)) == F and not dom S in V1 /\ TT:Term := if size((TL1,TL2,TL3)) >= 2 then F[TL1,TL2,TL3] else (TL1,TL2,TL3) fi . 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'))) . 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 META-MSG-UNIFICATION is pr META-MSG-UNIFICATION-INTEGRATION . 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'' VTL1 VTL2 : 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, T2, T1, N) :: UnificationTripleSet) or metaMsgUnify*Msg(M, T2, T1, N) == empty then empty *** Error, no total unification is possible!!! else metaBuiltInMatch****(M, V1 <- T1 ; S1#, N, V1, V1 <- T2 ; S, metaMsgUnify*Msg(M, T2, T1, 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, T2, T1, N) :: UnificationTripleSet) or metaMsgUnify*Msg(M, T2, T1, N) == empty then empty *** Error, no total unification is possible!!! else metaBuiltInMatch****(M, V1 <- T1 ; S1#, N, V1, V1 <- T2 ; S, metaMsgUnify*Msg(M, T2, T1, 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') = metaBuiltInUnify(M, empty, T, T') . op metaBuiltInUnify : Module TermList Term Term -> SubstitutionSet . eq metaBuiltInUnify(M, TL, T, T') = toSubstitution(metaBuiltInUnify(M, TL, T, T', highestVar((T,T')) + 1)) . *** General Call for UnificationPairSet op metaBuiltInUnify : Module Term Term Nat -> UnificationTripleSet . eq metaBuiltInUnify(M, T1, T2, N) = metaBuiltInUnify(M, empty, T1, T2, N) . op metaBuiltInUnify : Module TermList Term Term Nat -> UnificationTripleSet . --- Term Lhs eq metaBuiltInUnify(M, TL, T1, T2, N) = if IsMetaHEUnify(M) or IsMetaXORUnify(M) then moveBindingsInputTerm(Vars(T1), minimizeBindings(M,Vars(T1),N, metaMsgUnify*(M, TL, 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, empty, T, T') . op metaBuiltInUnify? : Module TermList Term Term -> Bool . eq metaBuiltInUnify?(M, TL, T, T') = metaBuiltInUnify?(M, TL, T, T',highestVar((T,T')) + 1) . op metaBuiltInUnify? : Module Term Term Nat -> Bool . eq metaBuiltInUnify?(M, T1, T2, N) = metaBuiltInUnify?(M, empty, T1, T2, N) . op metaBuiltInUnify? : Module TermList Term Term Nat -> Bool . eq metaBuiltInUnify?(M, TL, T1, T2, N) = if IsMetaHEUnify(M) or IsMetaXORUnify(M) then metaMsgUnify*?(M, TL, getTypeBuiltInUnify(M), T1, T2,N) else metaCoreUnify?(M, T1, T2, N) fi . *********** Unification other theories op metaMsgUnify* : Module TermList Type Term Term Nat ~> UnificationTripleSet . ceq metaMsgUnify*(M, TL, TP, T1, T2, N) = if not (metaCoreUnify(M,T1#,T2#,N2#) :: UnificationTripleSet) or metaCoreUnify(M,T1#,T2#,N2#) == empty then empty else metaMsgUnify**(M,TL,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 TermList Type Term Term Nat ~> Bool . ceq metaMsgUnify*?(M, TL, TP, T1, T2, N) = metaCoreUnify?(M,T1#,T2#,N2#) and-then metaMsgUnify**?(M,TL,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 TermList Type TermList TermList Substitution Substitution UnificationTripleSet -> UnificationTripleSet . eq metaMsgUnify**(M, TL, TP, TL1, TL2, S1#, S2#, UTS) = metaMsgUnify**#(M, TL, TP, TL1, TL2, S1#, S2#, empty, UTS) . op metaMsgUnify**# : Module TermList Type TermList TermList Substitution Substitution UnificationTripleSet UnificationTripleSet -> UnificationTripleSet . eq metaMsgUnify**#(M, TL, TP, TL1, TL2, S1#, S2#, UTS', empty) = UTS' . eq metaMsgUnify**#(M, TL, TP, TL1, TL2, S1#, S2#, UTS', {S,S',N} | UTS) = metaMsgUnify**#(M, TL, TP, TL1, TL2, S1#, S2#, UTS' | metaMsgUnify***(M, TL, TP, TL1, TL2, S1#, S2#, {S,S',N}), UTS) . op metaMsgUnify**? : Module TermList Type TermList TermList Substitution Substitution UnificationTripleSet -> Bool . eq metaMsgUnify**?(M, TL, TP, TL1, TL2, S1#, S2#, empty) = false . eq metaMsgUnify**?(M, TL, TP, TL1, TL2, S1#, S2#, {S,S',N} | UTS) = metaMsgUnify***(M, TL, TP, TL1, TL2, S1#, S2#, {S,S',N}) =/= empty or-else metaMsgUnify**?(M, TL, TP, TL1, TL2, S1#, S2#, UTS) . op metaMsgUnify*** : Module TermList Type TermList TermList Substitution Substitution UnificationTriple -> UnificationTripleSet . eq metaMsgUnify***(M, TL, TP, TL1, TL2, S1#, S2#, {S,S',N}) = metaMsgUnify***1st(M, TL, TP, TL1, TL2, empty, empty, S1#, S2#, {(S << S1#) << S2#, (S' << S1#) << S2#,N} ) . op metaMsgUnify***1st : Module TermList Type TermList TermList TermList TermList Substitution Substitution UnificationTriple -> UnificationTripleSet . ceq metaMsgUnify***1st(M, TL, TP, TL1, TL2, TL1', TL2', S1#, S2#, {V1 <- T2 ; S,S',N}) = metaMsgUnify***1st(M, TL, 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, TL, TP, TL1, TL2, TL1', TL2', S1#, S2#, {S,V2 <- T1 ; S',N}) = metaMsgUnify***1st(M, TL, 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, TL, TP, TL1, TL2, TL1', TL2', S1#, S2#, {S,S',N}) = metaMsgUnify***2nd(M, TL, TP, TL1, TL2, TL1', TL2', S1#, S2#, {S,S',N}) [owise] . op metaMsgUnify***2nd : Module TermList Type TermList TermList TermList TermList Substitution Substitution UnificationTriple -> UnificationTripleSet . ceq metaMsgUnify***2nd(M, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; V2 <- T2 ; S1#, S2#, {V1 <- V2 ; S,S',N}) = if metaMsgUnify*Msg(M, T2, T1, TL, N) == empty --- flip T1 & T2??? then empty else metaMsgUnify****LL(M, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; V2 <- T2 ; S1#, S2#, V1,V2, {V1 <- V2 ; S,S',N}, empty, metaMsgUnify*Msg(M, T2, T1, TL, N) ) fi if (not V1 in TL1) and-then (not V2 in TL1) . ceq metaMsgUnify***2nd(M, TL, TP, TL1, TL2, TL1', TL2', S1#, V1 <- T1 ; V2 <- T2 ; S2#, {S,V1 <- V2 ; S',N}) = if metaMsgUnify*Msg(M, T1, T2, TL, N) == empty then empty else metaMsgUnify****RR(M, TL, TP, TL1, TL2, TL1', TL2', S1#, V1 <- T1 ; V2 <- T2 ; S2#, V1,V2, {S,V1 <- V2 ; S',N}, empty, metaMsgUnify*Msg(M, T1, T2, TL, N) ) fi if (not V1 in TL2) and-then (not V2 in TL2) . ceq metaMsgUnify***2nd(M, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; S1#, V2 <- T2 ; S2#, {V1 <- V2 ; S,S',N}) = if metaMsgUnify*Msg(M, T2, T1, TL, N) == empty --- flip T1 & T2??? then empty else metaMsgUnify****L(M, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; S1#, V2 <- T2 ; S2#, V1,V2, {V1 <- V2 ; S,S',N}, empty, metaMsgUnify*Msg(M, T2, T1, TL, N) ) fi if (not V1 in TL1) and-then (not V2 in TL2) . ceq metaMsgUnify***2nd(M, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; S1#, V2 <- T2 ; S2#, {S,V2 <- V1 ; S',N}) = if metaMsgUnify*Msg(M, T1, T2, TL, N) == empty then empty else metaMsgUnify****R(M, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; S1#, V2 <- T2 ; S2#, V1,V2, {S,V2 <- V1 ; S',N}, empty, metaMsgUnify*Msg(M, T1, T2, TL, N) ) fi if (not V1 in TL1) and (not V2 in TL2) . ceq metaMsgUnify***2nd(M, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; S1#, S2#, {V1 <- T2 ; S,S',N}) = if metaMsgUnify*Msg(M, T2, T1, TL, N) == empty --- flip T1 & T2??? then empty else metaMsgUnify****LC(M, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; S1#, S2#, V1, {V1 <- T2 ; S,S',N}, empty, metaMsgUnify*Msg(M, T2, T1, TL, N) ) fi if not (T2 :: Variable and getType(T2) == TP) . ceq metaMsgUnify***2nd(M, TL, TP, TL1, TL2, TL1', TL2', S1#, V2 <- T1 ; S2#, {S,V2 <- T2 ; S',N}) = if metaMsgUnify*Msg(M, T1, T2, TL, N) == empty then empty else metaMsgUnify****RC(M, TL, TP, TL1, TL2, TL1', TL2', S1#, V2 <- T1 ; S2#, V2, {S,V2 <- T2 ; S',N}, empty, metaMsgUnify*Msg(M, T1, T2, TL, N) ) fi if not (T2 :: Variable and getType(T2) == TP) . ceq metaMsgUnify***2nd(M, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; S1#, S2#, {V1 <- V2 ; S,S',N}) = metaMsgUnify***2nd(M, TL, 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, TL, TP, TL1, TL2, TL1', TL2', S1#, V2 <- T2 ; S2#, {S,V2 <- V1 ; S',N}) = metaMsgUnify***2nd(M, TL, 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, TL, TP, TL1, TL2, TL1', TL2', (V2 <- T1) ; S1#, S2#, {(V1 <- V2) ; S, (V3 <- V2) ; S',N}) = metaMsgUnify***2nd(M, TL, TP, TL1, TL2, TL1', TL2', ((V2 <- T1) ; S1#) << (V1 <- T1), S2# << (V3 <- T1), {S .. (V1 <- T1), S' .. (V3 <- T1),N}) . eq metaMsgUnify***2nd(M, TL, TP, TL1, TL2, TL1', TL2', S1#, (V2 <- T1) ; S2#, {(V1 <- V2) ; S, (V3 <- V2) ; S',N}) = metaMsgUnify***2nd(M, TL, TP, TL1, TL2, TL1', TL2', S1# << (V1 <- T1), ((V2 <- T1) ; S2#) << (V3 <- T1), {S .. (V1 <- T1), S' .. (V3 <- T1),N}) . eq metaMsgUnify***2nd(M, TL, TP, TL1, TL2, TL1', TL2', S1#, S2#, {S,S',N}) = {S .. S2#, S' .. S1#, N} [owise] . op split : UnificationTriple Substitution Substitution TermList TermList TermList TermList -> UnificationTriple . --- LSubst maps variables of VTL1 and RSubst maps variables of VTL2 eq split({S,S',N},LSubst,RSubst,VTL1,TL1,VTL2,TL2) = if all VTL1 in TL1 and all VTL2 in TL1 then --- LSubst and RSubst map variables of TL1 (all left) {S .. (LSubst ; RSubst),S' << (LSubst ; RSubst),N} else if all VTL1 in TL1 and all VTL2 in TL2 then --- LSubst maps variables of TL1 and RSubst of TL2 (left & right) {(S << RSubst) .. LSubst, (S' << LSubst) .. RSubst,N} else if all VTL1 in TL2 and all VTL2 in TL1 then --- LSubst maps variables of TL2 and RSubst of TL1 (reverse) {(S << LSubst) .. RSubst, (S' << RSubst) .. LSubst,N} else --- LSubst and RSubst map variables of TL2 (all right) {S << (LSubst ; RSubst),S' .. (LSubst ; RSubst),N} fi fi fi . op metaMsgUnify****LC : Module TermList Type TermList TermList TermList TermList Substitution Substitution Variable UnificationTriple UnificationTripleSet UnificationTripleSet -> UnificationTripleSet . eq metaMsgUnify****LC(M, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; S1#, S2#, V1, {V1 <- T2 ; S,S',N}, UTS',empty) = UTS' . eq metaMsgUnify****LC(M, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; S1#, S2#, V1, {V1 <- T2 ; S,S',N}, UTS', {LSubst,RSubst,N'} | UTS) = metaMsgUnify****LC(M, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; S1#, S2#, V1, {V1 <- T2 ; S,S',N}, metaMsgUnify***1st(M, TL, TP, TL1, TL2, TL1', TL2', (V1 <- T1 ; S1#) << (LSubst ; RSubst), S2# << (LSubst ; RSubst), split({S,S',N'},LSubst,RSubst,Vars(T1),TL1,Vars(T2),TL2) ) | UTS', UTS) . op metaMsgUnify****RC : Module TermList Type TermList TermList TermList TermList Substitution Substitution Variable UnificationTriple UnificationTripleSet UnificationTripleSet -> UnificationTripleSet . eq metaMsgUnify****RC(M, TL, TP, TL1, TL2, TL1', TL2', S1#, V2 <- T1 ; S2#, V2, {S,V2 <- T2 ; S',N}, UTS',empty) = UTS' . eq metaMsgUnify****RC(M, TL, TP, TL1, TL2, TL1', TL2', S1#, V2 <- T1 ; S2#, V2, {S,V2 <- T2 ; S',N}, UTS', {LSubst,RSubst,N'} | UTS) = metaMsgUnify****RC(M, TL, TP, TL1, TL2, TL1', TL2', S1#, V2 <- T1 ; S2#, V2, {S,V2 <- T2 ; S',N}, metaMsgUnify***1st(M, TL, TP, TL1, TL2, TL1', TL2', S1# << (LSubst ; RSubst), (V2 <- T1 ; S2#) << (LSubst ; RSubst), split({S,S',N'},LSubst,RSubst,Vars(T1),TL1,Vars(T2),TL2) ) | UTS', UTS) . op metaMsgUnify****LL : Module TermList Type TermList TermList TermList TermList Substitution Substitution Variable Variable UnificationTriple UnificationTripleSet UnificationTripleSet -> UnificationTripleSet . eq metaMsgUnify****LL(M, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; V2 <- T2 ; S1#, S2#, V1,V2, {V1 <- V2 ; S,S',N}, UTS',empty) = UTS' . eq metaMsgUnify****LL(M, TL, 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, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; V2 <- T2 ; S1#, S2#, V1,V2, {V1 <- V2 ; S,S',N}, metaMsgUnify***1st(M, TL, TP, TL1, TL2, TL1', TL2', (V1 <- T1 ; V2 <- T2 ; S1#) << (LSubst ; RSubst), S2# << (LSubst ; RSubst), split({S,S',N'},LSubst,RSubst,Vars(T1),TL1,Vars(T2),TL2) ) | UTS', UTS) . op metaMsgUnify****L : Module TermList Type TermList TermList TermList TermList Substitution Substitution Variable Variable UnificationTriple UnificationTripleSet UnificationTripleSet -> UnificationTripleSet . eq metaMsgUnify****L(M, TL, 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, TL, 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, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; S1#, V2 <- T2 ; S2#, V1,V2, {V1 <- V2 ; S,S',N}, metaMsgUnify***1st(M, TL, TP, TL1, TL2, TL1', TL2', (V1 <- T1 ; S1#) << (LSubst ; RSubst), (V2 <- T2 ; S2#) << (LSubst ; RSubst), split({S,S',N'},LSubst,RSubst,Vars(T1),TL1,Vars(T2),TL2) ) | UTS', UTS) . op metaMsgUnify****R : Module TermList Type TermList TermList TermList TermList Substitution Substitution Variable Variable UnificationTriple UnificationTripleSet UnificationTripleSet -> UnificationTripleSet . eq metaMsgUnify****R(M, TL, 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, TL, 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, TL, TP, TL1, TL2, TL1', TL2', V1 <- T1 ; S1#, V2 <- T2 ; S2#, V1,V2, {S,V2 <- V1 ; S',N}, metaMsgUnify***1st(M, TL, TP, TL1, TL2, TL1', TL2', (V1 <- T1 ; S1#) << (LSubst ; RSubst), (V2 <- T2 ; S2#) << (LSubst ; RSubst), split({S,S',N'},LSubst,RSubst,Vars(T1),TL1,Vars(T2),TL2) ) | UTS', UTS) . op metaMsgUnify****RR : Module TermList Type TermList TermList TermList TermList Substitution Substitution Variable Variable UnificationTriple UnificationTripleSet UnificationTripleSet -> UnificationTripleSet . eq metaMsgUnify****RR(M, TL, 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, TL, 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, TL, TP, TL1, TL2, TL1', TL2', S1#, V1 <- T1 ; V2 <- T2 ; S2#, V1,V2, {S,V1 <- V2 ; S',N}, metaMsgUnify***1st(M, TL, TP, TL1, TL2, TL1', TL2', S1# << (LSubst ; RSubst), (V1 <- T1 ; V2 <- T2 ; S2#) << (LSubst ; RSubst), split({S,S',N'},LSubst,RSubst,Vars(T1),TL1,Vars(T2),TL2) ) | UTS', UTS) . ******************************************************************** *** 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] . endfm fmod ORDERS-TERM-SUBSTITUTION is protecting TERM-HANDLING . protecting SUBSTITUTION-HANDLING . protecting META-MATCH . protecting META-LEVEL-MNPA . 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' SS'' : SubstitutionSet . vars V V' V1 V2 V3 : Variable . vars TPL TPL' : TypeList . vars N N' : Nat . vars F : Qid . var C : Constant . --- 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 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) = canonice(M,nullVars(T)) == canonice(M,nullVars(T')) and-then (metaBuiltInRenaming$$1(M,canonice(M,T),canonice(M,T')) or-else metaBuiltInRenaming$$2(M,canonice(M,T),canonice(M,T')) ) . op metaBuiltInRenaming$$1 : Module Term Term -> Bool . eq metaBuiltInRenaming$$1(M,T:Term,T':Term) = metaBuiltInRenaming$$1*( canonice(M,totalOrder(M,flatten(M,T:Term)) <<( 0 )<), canonice(M,totalOrder(M,flatten(M,T':Term)) <<( 0 )<) ) . op metaBuiltInRenaming$$1* : Term Term -> Bool . eq metaBuiltInRenaming$$1*(T:Term,T':Term) = T:Term == T':Term . op totalOrder : Module Term -> Term . eq totalOrder(M,C) = C . eq totalOrder(M,V) = V . eq totalOrder(M,F[TL]) = if not isCommutative(M,F[TL]) then F[totalOrderTL(M,TL)] else F[reorderTL(M,F,totalOrderTL(M,TL))] fi . op totalOrderTL : Module TermList -> TermList . eq totalOrderTL(M,empty) = empty . eq totalOrderTL(M,(T,TL)) = (totalOrder(M,T),totalOrderTL(M,TL)) . op reorderTL : Module Qid TermList -> TermList . eq reorderTL(M,F,empty) = empty . eq reorderTL(M,F,(T,TL)) = if insertTL(M,F,T,TL) =/= (T,TL) then reorderTL(M,F,insertTL(M,F,T,TL)) else (T,reorderTL(M,F,TL)) fi . op insertTL : Module Qid Term TermList -> TermList . eq insertTL(M,F,T',empty) = T' . eq insertTL(M,F,T',(T,TL)) = if canonice(M,F[nullVars(T'),nullVars(T)]) == F[canonice(M,nullVars(T')),canonice(M,nullVars(T))] then (T',T,TL) else (T,insertTL(M,F,T',TL)) fi . op nullVars : Term -> Term . eq nullVars(C) = C . eq nullVars(V) = qid("#0:" + string(getType(V))) . eq nullVars(F[TL]) = F[nullVarsTL(TL)] . op nullVarsTL : TermList -> TermList . eq nullVarsTL(empty) = empty . eq nullVarsTL((T,TL)) = (nullVars(T),nullVarsTL(TL)) . ***** op metaBuiltInRenaming$$2 : Module Term Term -> Bool . eq metaBuiltInRenaming$$2(M,T:Term,T':Term) = T == T' or-else onlyRenamingAny(M,metaBuiltInMatchShared(M,T',T) |> T) . ***** op onlyRenamingAll : Module SubstitutionSet -> Bool . eq onlyRenamingAll(M,empty) = true . eq onlyRenamingAll(M,S | SS) = onlyRenaming*(M,S) and-then onlyRenamingAll(M,SS) . op onlyRenamingAny : Module SubstitutionSet -> Bool . eq onlyRenamingAny(M,empty) = false . eq onlyRenamingAny(M,S | SS) = onlyRenaming*(M,S) or-else onlyRenamingAny(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-MNPA . 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) . op metaSearchCollect$ : Module Term Type ~> ResultTripleSet . eq metaSearchCollect$(M,T,TP) = metaSearchCollect$(M,{T,TP,none}) . op metaSearchCollect$ : Module ResultTriple ~> ResultTripleSet . eq metaSearchCollect$(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 metaSearchCollect : Module Term Type -> ResultTripleSet . eq metaSearchCollect(M,T,TP) = if anyNonExec(M) then metaSearchCollect#(M,T,TP) else metaSearchCollect$(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 metaSearchCollect# : Module Term Type -> ResultTripleSet . eq metaSearchCollect#(M,T,TP) = metaSearchCollect#(M,{T,TP,none}) . ---metaSearch of Maude doesn't work for rules with extra vars op metaSearchCollect# : Module ResultTriple -> ResultTripleSet . eq metaSearchCollect#(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-MNPA . 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 . op metaEBuiltInTopMostNarrowRC : Module Term TermList Nat -> ResultContextSet . eq metaEBuiltInTopMostNarrowRC(M,T,TL,N) = metaETopMostNarrowRC(M,T,1,reducible, E-BuiltIn-unify irrTerms(TL),N) . op metaEBuiltInTopMostNarrowRCIrr : Module Term TermList Nat -> ResultContextSet . eq metaEBuiltInTopMostNarrowRCIrr(M,T,TL,N) = metaETopMostNarrowRC(M,T,1,irreducible, E-BuiltIn-unify irrTerms(TL),N) . op metaEACUTopMostNarrowRC : Module Term Nat -> ResultContextSet . eq metaEACUTopMostNarrowRC(M,T,N) = metaETopMostNarrowRC(M,T,1,reducible, E-ACU-unify,N) . op metaEACUTopMostNarrowRCIrr : Module Term Nat -> ResultContextSet . eq metaEACUTopMostNarrowRCIrr(M,T,N) = metaETopMostNarrowRC(M,T,1,irreducible, E-ACU-unify,N) . op metaETopMostNarrowRC : Module Term Bound IrrFlags TypeOfNarrowing Nat -> ResultContextSet . eq metaETopMostNarrowRC(M,T,B,IRR,ON,N) = 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',getIrrTerms(ON),N,reducible) . eq auxMetaUnify**(M,E-ACU-unify-Irr ON,T,T',N) = metaEACUUnify(removeBoolEqs(M),T,T',getIrrTerms(ON),N,irreducible) . eq auxMetaUnify**(M,E-BuiltIn-unify ON,T,T',N) = metaEBuiltInUnify(removeBoolEqs(M),T,T',getIrrTerms(ON),N,reducible) . eq auxMetaUnify**(M,E-BuiltIn-unify-Irr ON,T,T',N) = metaEBuiltInUnify(removeBoolEqs(M),T,T',getIrrTerms(ON),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),getIrrTerms(ON),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), canonice(M,S),canonice(M,S'), [],[],canonice(M,TS),canonice(M,TS), NextVar, canonice(M,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 anyIdSymbol(M,Subst ; Subst') ---then {normalizeRls(M,Subst),normalizeRls(M,Subst'),N} then {canonice(M,Subst),canonice(M,Subst'),N} else {Subst,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-MNPA . 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 SubstitutionCond TypeOfRelation Bound Bound Bound -> ResultTripleSet . eq metaNarrowSearch(M,T,T',SCond,QQ,BN,B,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,Sol,B,Sol) else metaNarrowSearch*(M,T,T',SCond,QQ,BN,B,Sol) fi . op metaNarrowSearch* : Module Term Term SubstitutionCond TypeOfRelation Bound Bound Bound -> ResultTripleSet . eq metaNarrowSearch*(M,T,T',SCond,QQ,BN,B,Sol) = metaNarrowSearchGen(M,T,T',SCond,QQ,BN,B,Sol, full E-BuiltIn-unify noStrategy E-normalize-terms) . *** Shortcuts to Paramodulation Search op metaParamodulationSearch : Module Term Term SubstitutionCond TypeOfRelation Bound Bound Bound -> ResultTripleSet . eq metaParamodulationSearch(M,T,T',SCond,QQ,BN,B,Sol) = if (BN == unbounded and-then Sol =/= unbounded) or-else (BN =/= unbounded and-then Sol =/= unbounded and-then BN < Sol) then metaParamodulationSearch*(M,T,T',SCond,QQ,Sol,B,Sol) else metaParamodulationSearch*(M,T,T',SCond,QQ,BN,B,Sol) fi . op metaParamodulationSearch* : Module Term Term SubstitutionCond TypeOfRelation Bound Bound Bound -> ResultTripleSet . eq metaParamodulationSearch*(M,T,T',SCond,QQ,BN,B,Sol) = metaNarrowSearchGen(M,T,T',SCond,QQ,BN,B,Sol, full E-BuiltIn-unify noStrategy E-normalize-terms alsoAtVarPosition) . *** 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 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,Sol,B,Sol) else metaNarrowSearchPath*(M,T,T',SCond,QQ,BN,B,Sol) fi . op metaNarrowSearchPath* : Module Term Term SubstitutionCond TypeOfRelation Bound Bound Bound -> TraceNarrowSet . eq metaNarrowSearchPath*(M,T,T',SCond,QQ,BN,B,Sol) = extractTraces( metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol, full E-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 auxMetaUnifyCheck(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 rebuildTypeAndDiscardErroneousCheck(M,ON, RT <<(M,ON) auxMetaUnifyCheck(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 auxMetaUnifyCheck : Module TypeOfNarrowing Term Term Nat ~> UnificationTripleSet . eq auxMetaUnifyCheck(M,ON,T,T',N) = auxMetaUnify(M,ON,T,T',N) . op rebuildTypeAndDiscardErroneousCheck : Module TypeOfNarrowing ResultContextSet -> ResultContextSet . eq rebuildTypeAndDiscardErroneousCheck(M,ON,RTS) = rebuildTypeAndDiscardErroneous(M,ON,RTS) . 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 . --- Every term of sort Public can be generated by the intruder sort Private . --- No term of sort Private can be generated by the intruder subsort Public < Msg . subsort Private < Msg . op emptyPublic : -> Public . op emptyPrivate : -> Private . op nullFresh : -> Fresh . op pair : Msg Msg -> Msg [frozen] . --- Special treatment for indistinguishability 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 (ni++r d d d o--)] . op -`(_`) : Msg -> SignedSMsg [format (ni++b 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 StrandConstraint . op _eq_ : Msg Msg -> StrandConstraint [prec 1 format (ni d d d)] . op _neq_ : Msg Msg -> StrandConstraint [prec 1 format (ni d d d)]. sort SMsgList SMsgElem . subsort SMsg Synchro Resuscitated StrandConstraint < SMsgElem < 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 _,_ : Synchro SMsgList-R -> SMsgList-R [ctor format (d d s d) gather (e E)] . op _,_ : StrandConstraint 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)] . op _,_ : SMsgList-L Synchro -> SMsgList-L [ctor format (d d s d) gather (E e)] . op _,_ : SMsgList-L StrandConstraint -> SMsgList-L [ctor format (d d s d) gather (E e)] . --- Composition sort Synchro . op {_->_;;_;;_} : RoleSet RoleSet How Msg -> Synchro [format (nig d d d d d d d d o)] . sorts RoleSet Role . subsort Role < RoleSet . op empty : -> RoleSet . op __ : RoleSet RoleSet -> RoleSet [assoc comm id: empty] . op initiator : -> Role . op responder : -> Role . sort How . op 1-1 : -> How . op 1-* : -> How . --- Strands 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 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 ShortGhost . op ghost : Msg -> ShortGhost . sort GhostList . subsorts Ghost ShortGhost < 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 [ctor ditto] . op _,_ : IntruderKnowledge-inI IntruderKnowledge-inI -> IntruderKnowledge-inI [ctor ditto] . op _,_ : IntruderKnowledge-!= IntruderKnowledge-!= -> IntruderKnowledge-!= [ctor ditto] . op _,_ : IntruderKnowledge-irr IntruderKnowledge-irr -> IntruderKnowledge-irr [ctor ditto] . op _,_ : IntruderKnowledge-inst IntruderKnowledge-inst -> IntruderKnowledge-inst [ctor ditto] . op _,_ : IntruderKnowledge-CPSA IntruderKnowledge-CPSA -> IntruderKnowledge-CPSA [ctor ditto] . op _,_ : IntruderKnowledge-empty IntruderKnowledge-empty -> IntruderKnowledge-empty [ctor ditto] . sort Properties . op nil : -> Properties [ctor format (ni d)] . sort System ShortSystem VeryShortSystem . ************************ --- Stuff for never patterns sort ExclusionPattern . subsort ExclusionPattern < Properties . --- neverPattern as StrandSet + IntruderKnowledge sort NeverPattern . sort NeverPatternSet . subsort NeverPattern < NeverPatternSet . op _||_ : StrandSet IntruderKnowledge -> NeverPattern [format (+++++i ni ni i-----)] . op nil : -> NeverPatternSet . op __ : NeverPatternSet NeverPatternSet -> NeverPatternSet [ctor assoc comm id: nil format (i ni i)] . op never : NeverPatternSet -> ExclusionPattern [format (nci nio)] . ************************ op _||_||_||_||_ : StrandSet IntruderKnowledge SMsgList GhostList Properties -> System [format (d n d n d n d n d d)] . op _|_|_|_ : StrandSet IntruderKnowledge SMsgList GhostList -> ShortSystem [format (d n d n d n d d)] . op _|_ : IntruderKnowledge SMsgList -> VeryShortSystem [format (d n d n)] . --- 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$ . subsort Synchro < 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 _,_ : Synchro SMsgList-R$ -> SMsgList-R$ [ditto] . op _,_ : SMsgList-L$ SMsgSet -> SMsgList-L$ [ditto] . op _,_ : SMsgList-L$ Synchro -> 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 ni d) ] . sort GrammarRule . op grl_=>_. : CtrSet LConstraint -> GrammarRule [format (n+++ d d d d s---)] . 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 sameGrammarListAsPreviousBound : -> [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 *** Positive strand constraint rl ((:: rrL :: [ L1 | (M eq M), L2 ]) & SS) || K || ML || GL || PP => ((:: rrL :: [ L1, (M eq M) | L2 ]) & SS) || K || ML || GL || PP [nonexec] . *** 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 COMPOSITION-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 . vars rrL1 rrL2 : FreshSet . var GL : GhostList . var PP : Properties . vars R1 R2 : Role . vars RR1 RR2 : RoleSet . *** General Rules rl ( (:: rrL1 :: [ L1 | {R1 -> R2 RR2 ;; X:How ;; M}, nil ]) & (:: rrL2 :: [ nil | {R1 RR1 -> R2 ;; X:How ;; M}, L2 ]) & SS) || K || {R1 -> R2 ;; X:How ;; M}, ML || GL || PP => ( (:: rrL1 :: [ L1, {R1 -> R2 RR2 ;; X:How ;; M} | nil ]) & (:: rrL2 :: [ nil, {R1 RR1 -> R2 ;; X:How ;; M} | L2 ]) & SS) || K || ML || GL || PP [nonexec] . rl ( (:: rrL1 :: [ L1 | {R1 -> R2 RR2 ;; 1-* ;; M}, nil ]) & (:: rrL2 :: [ nil | {R1 RR1 -> R2 ;; 1-* ;; M}, L2 ]) & SS) || K || {R1 -> R2 ;; 1-* ;; M}, ML || GL || PP => ( (:: rrL1 :: [ L1 | {R1 -> R2 RR2 ;; 1-* ;; M}, nil ]) & (:: rrL2 :: [ nil, {R1 RR1 -> R2 ;; 1-* ;; 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 . vars M M1 M2 : 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] . *** Negative strand constraint rl ((:: rrL :: [ L1 | (M1 neq M2), L2 ]) & SS) || K, (M1 != M2) || ML || GL || PP => ((:: rrL :: [ L1, (M1 neq M2) | 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-MNPA . protecting TERMSET . protecting RESULT-CONTEXT-SET . eq X:Msg , X:Msg = X:Msg . ---Moved from DEFINITION-PROTOCOL-RULES eq X:Role X:Role = X:Role . ---Moved from DEFINITION-PROTOCOL-RULES eq X:Knowledge-!= , X:Knowledge-!= = X:Knowledge-!= . ---Moved from DEFINITION-PROTOCOL-RULES eq X:Knowledge-irr , X:Knowledge-irr = X:Knowledge-irr . ---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 . *** Extract ******************************************** 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) . *** SystemSet ******************************************** sort SystemSet . subsort System < SystemSet . subsort ShortSystem < SystemSet . subsort VeryShortSystem < SystemSet . op empty : -> SystemSet . op __ : SystemSet SystemSet -> SystemSet [ctor assoc comm id: empty format (d n d)] . *** IdSystem ******************************************** sort Id IdElem . subsort Nat < IdElem . op _[_] : IdElem Nat -> IdElem [ctor prec 31] . op _{_} : IdElem Nat -> IdElem [ctor prec 31] . op _{{_}} : IdElem Nat -> IdElem [ctor prec 31] . subsort IdElem < Id . op _._ : Id Id -> Id [ctor assoc prec 32] . op _++ : Id -> Id . eq (N:Nat) ++ = N:Nat + 1 . eq (I:IdElem [ N2:Nat ]) ++ = I:IdElem [ N2:Nat + 1 ] . eq (I:IdElem { N2:Nat }) ++ = I:IdElem { N2:Nat + 1 } . eq (I:IdElem {{ N2:Nat }}) ++ = I:IdElem {{ N2:Nat + 1 }} . eq (X:Id . N:Nat) ++ = X:Id . (N:Nat + 1) . eq (X:Id . (I:IdElem [ N2:Nat ])) ++ = X:Id . (I:IdElem [ N2:Nat + 1 ]) . eq (X:Id . (I:IdElem { N2:Nat })) ++ = X:Id . (I:IdElem { N2:Nat + 1 }) . eq (X:Id . (I:IdElem {{ N2:Nat }})) ++ = X:Id . (I:IdElem {{ N2: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 (I:IdElem . X1:Id) <<< (I:IdElem . X2:Id) = X1:Id <<< X2:Id . eq X:Id <<< X':Id = X:Id <<<* X':Id [owise] . op _<<<*_ : Id Id -> Bool . eq I1:IdElem <<<* (I2:IdElem . X2:Id) = I1:IdElem <<<* I2:IdElem . eq (I1:IdElem . X1:Id) <<<* I2:IdElem = I1:IdElem <<<* I2:IdElem . eq (I1:IdElem . X1:Id) <<<* (I2:IdElem . X2:Id) = I1:IdElem <<<* I2:IdElem . eq X:Id <<<* X':Id = X:Id <<<** X':Id [owise] . op _<<<**_ : Id Id -> Bool . eq I:IdElem <<<** I:IdElem = true . eq I1:IdElem <<<** (I2:IdElem [ N2:Nat ]) = I1:IdElem <<<** I2:IdElem . eq I1:IdElem <<<** (I2:IdElem { N2:Nat }) = I1:IdElem <<<** I2:IdElem . eq I1:IdElem <<<** (I2:IdElem {{ N2:Nat }}) = I1:IdElem <<<** I2:IdElem . eq X:Id <<<** X':Id = false [owise] . sort IdSet . subsort Id < IdSet . op empty : -> IdSet [ctor] . op _:_ : IdSet IdSet -> IdSet [ctor comm assoc id: empty prec 31 format (d d ni d)] . sort IdSystem . op <_>_ : Id System -> IdSystem [format (d ! o d d)] . sort ShortIdSystem . op <_>_ : Id ShortSystem -> ShortIdSystem [format (d ! o d d)] . sort VeryShortIdSystem . op <_>_ : Id VeryShortSystem -> VeryShortIdSystem [format (d ! o d d)] . sort IdSystemSet . subsort IdSystem < IdSystemSet . subsort ShortIdSystem < IdSystemSet . subsort VeryShortIdSystem < IdSystemSet . op empty : -> IdSystemSet . op __ : IdSystemSet IdSystemSet -> IdSystemSet [ctor assoc comm id: empty format (d n d)] . op getId : IdSystemSet -> IdSet . eq getId(empty) = empty . ceq getId((< I:Id > S:System) SS:IdSystemSet) = I:Id : getId(SS:IdSystemSet) if SS:IdSystemSet =/= empty . 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(I:IdElem ,SS:SystemSet) = setId+((I:IdElem { 1 }), SS:SystemSet) . eq setIdUnif(X:Id . I:IdElem ,SS:SystemSet) = setId+(X:Id . (I:IdElem { 1 }), SS:SystemSet) . op setIdVariants : Id SystemSet ~> IdSystemSet . eq setIdVariants(I:Id,S:System) = setId(I:Id,S:System) . eq setIdVariants(I:IdElem,SS:SystemSet) = setId+((I:IdElem [ 1 ]),SS:SystemSet) . eq setIdVariants(X:Id . I:IdElem,SS:SystemSet) = setId+(X:Id . (I:IdElem [ 1 ]),SS:SystemSet) . op setIdGhost : Id ~> Id . eq setIdGhost(I:IdElem) = I:IdElem {{ 1 }} . eq setIdGhost(X:Id . I:IdElem) = X:Id . (I:IdElem {{ 1 }}) . 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) . eq remId((< I:Id > S:ShortSystem) SS:IdSystemSet) = S:ShortSystem 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 . eq toSMsgList((L:SMsgList-L$,M:Synchro)) = toSMsgList(L:SMsgList-L$), M:Synchro . eq toSMsgList((L:SMsgList-L$,M:StrandConstraint)) = toSMsgList(L:SMsgList-L$), M:StrandConstraint . 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$) . eq toSMsgList((M:Synchro,L:SMsgList-R$)) = M:Synchro, toSMsgList(L:SMsgList-R$) . eq toSMsgList((M:StrandConstraint,L:SMsgList-R$)) = M:StrandConstraint, toSMsgList(L:SMsgList-R$) . op noSynchro&noConstraint : SMsgList$ -> SMsgList$ . eq noSynchro&noConstraint(nil) = nil . eq noSynchro&noConstraint(L1:SMsgList$,M:Synchro,L2:SMsgList$) = noSynchro&noConstraint(L1:SMsgList$,L2:SMsgList$) . eq noSynchro&noConstraint(L1:SMsgList$,M:StrandConstraint,L2:SMsgList$) = noSynchro&noConstraint(L1:SMsgList$,L2:SMsgList$) . eq noSynchro&noConstraint(L:SMsgList$) = L:SMsgList$ [owise] . op yesSynchro&noConstraint : SMsgList$ -> SMsgList$ . eq yesSynchro&noConstraint(nil) = nil . eq yesSynchro&noConstraint(L1:SMsgList$,{X:RoleSet -> Y:RoleSet ;; X:How ;; X:Msg},L2:SMsgList$) = yesSynchro&noConstraint(L1:SMsgList$,-(X:Msg),L2:SMsgList$) . eq yesSynchro&noConstraint(L1:SMsgList$,M:StrandConstraint,L2:SMsgList$) = yesSynchro&noConstraint(L1:SMsgList$,L2:SMsgList$) . eq yesSynchro&noConstraint(L:SMsgList$) = L:SMsgList$ [owise] . 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 . eq toSMsgList-L((L:SMsgList$,M:Synchro)) = toSMsgList-L(L:SMsgList$), M:Synchro . eq toSMsgList-L((L:SMsgList$,M:StrandConstraint)) = toSMsgList-L(L:SMsgList$), M:StrandConstraint . 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$) . eq toSMsgList-R((M:Synchro,L:SMsgList$)) = M:Synchro, toSMsgList-R(L:SMsgList$) . eq toSMsgList-R((M:StrandConstraint,L:SMsgList$)) = M:StrandConstraint, toSMsgList-R(L:SMsgList$) . op _++_ : SMsgList-R SMsgList-R -> SMsgList-R [gather (e E)] . eq nil ++ Z:SMsgList-R = Z:SMsgList-R . eq (X:SMsg , Y:SMsgList-R) ++ Z:SMsgList-R = X:SMsg, (Y:SMsgList-R ++ Z:SMsgList-R) . eq (X:Synchro , Y:SMsgList-R) ++ Z:SMsgList-R = X:Synchro, (Y:SMsgList-R ++ Z:SMsgList-R) . eq (X:StrandConstraint , Y:SMsgList-R) ++ Z:SMsgList-R = X:StrandConstraint, (Y:SMsgList-R ++ Z:SMsgList-R) . op _++_ : SMsgList-L SMsgList-L -> SMsgList-L [gather (E e)] . eq Z:SMsgList-L ++ nil = Z:SMsgList-L . eq Z:SMsgList-L ++ (Y:SMsgList-L, X:SMsg) = (Z:SMsgList-L ++ Y:SMsgList-L), X:SMsg . eq Z:SMsgList-L ++ (Y:SMsgList-L, X:Synchro) = (Z:SMsgList-L ++ Y:SMsgList-L), X:Synchro . eq Z:SMsgList-L ++ (Y:SMsgList-L, X:StrandConstraint) = (Z:SMsgList-L ++ Y:SMsgList-L), X:StrandConstraint . 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] . op _minus_ : FreshSet FreshSet -> FreshSet . eq (F:Fresh,S1:FreshSet) minus (F:Fresh,S2:FreshSet) = S1:FreshSet minus (F:Fresh,S2:FreshSet) . eq S1:FreshSet minus S2:FreshSet = S1:FreshSet [owise] . *** filters op testFreshInstantiated : TraceNarrow Nat -> Bool . eq testFreshInstantiated(nil, N:Nat) = false . eq testFreshInstantiated(Tr:TraceNarrow {CtTS:Term,Subst:Substitution,TP:Type,R:Rule}, N:Nat) = testFreshInstantiated(N:Nat,nil,Subst:Substitution) or-else testFreshInstantiated(Tr:TraceNarrow, N:Nat) . op testFreshInstantiated : Substitution -> Bool . eq testFreshInstantiated(Subst:Substitution) = testFreshInstantiated(0,nil,Subst:Substitution) . op testFreshInstantiated : Substitution Nat -> Bool . eq testFreshInstantiated(Subst:Substitution,N:Nat) = testFreshInstantiated(N:Nat,nil,Subst:Substitution) . op testFreshInstantiated : Nat FreshSet Substitution -> Bool . eq testFreshInstantiated(N:Nat,F:FreshSet,none) = false . eq testFreshInstantiated(N:Nat,F:FreshSet,V:Variable <- T:Term ; Subst:Substitution) = ( getType(V:Variable) == 'Fresh and-then (F:FreshSet == nil or-else V:Variable in F:FreshSet) and-then (N:Nat == 0 or-else (highestVar(V:Variable) > N:Nat and highestVar(T:Term) > N:Nat)) ) or-else testFreshInstantiated(N:Nat,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 noFresh : TermList -> TermList . ceq noFresh((T1:TermList,V:Variable,T2:TermList)) = noFresh((T1:TermList,T2:TermList)) if getType(V:Variable) == 'Fresh . eq noFresh(T:TermList) = T:TermList [owise] . op anyFreshVar : TermList -> Bool . eq anyFreshVar((V:Variable,TL:TermList)) = getType(V:Variable) == 'Fresh or-else anyFreshVar(TL:TermList) . eq anyFreshVar(empty) = false . 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(0,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$((M:SMsgElem,L:SMsgList)) = M:SMsgElem,toSMsgList$(L:SMsgList) [owise] . 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$+((M:SMsgElem,L:SMsgList),MS:SMsgSet) = (MS:SMsgSet , M:SMsgElem , toSMsgList$(L:SMsgList)) [owise] . 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$-((M:SMsgElem,L:SMsgList),MS:SMsgSet) = (MS:SMsgSet , M:SMsgElem , toSMsgList$(L:SMsgList)) [owise] . op makeInI : TermList -> IntruderKnowledge . eq makeInI(empty) = empty . eq makeInI((T:Term,TL:TermList)) = downMsgSet(T:Term) inI,makeInI(TL:TermList) . op makeInI : GhostList -> IntruderKnowledge . eq makeInI((nil).GhostList) = empty . eq makeInI((ghost(M:Msg),GL:GhostList)) = M:Msg inI,makeInI(GL:GhostList) . --- End auxiliary op ghostTerms : GhostList -> TermList . eq ghostTerms(nil) = empty . eq ghostTerms( ghost(M:Msg,SS:StrandSet,K:IntruderKnowledge,ML:SMsgList,PP:Properties), G2:GhostList) = (upTerm(M:Msg),ghostTerms(G2:GhostList)) . op noInI : IntruderKnowledge -> Bool . eq noInI(M:Msg inI,K:IntruderKnowledge) = false . eq noInI(K:IntruderKnowledge) = true [owise] . op only-Output : SMsgList -> SMsgList . eq only-Output(nil) = nil . eq only-Output(+(X:Msg),L:SMsgList) = +(X:Msg),only-Output(L:SMsgList) . eq only-Output(X:SMsgElem,L:SMsgList) = only-Output(L:SMsgList) [owise] . op only-Input : SMsgList -> SMsgList . eq only-Input(nil) = nil . eq only-Input(-(X:Msg),L:SMsgList) = -(X:Msg),only-Input(L:SMsgList) . eq only-Input(X:SMsgElem,L:SMsgList) = only-Input(L:SMsgList) [owise] . op only-Synchro : SMsgList -> SMsgList . eq only-Synchro(nil) = nil . eq only-Synchro(M:Synchro,L:SMsgList) = M:Synchro,only-Synchro(L:SMsgList) . eq only-Synchro(X:SMsgElem,L:SMsgList) = only-Synchro(L:SMsgList) [owise] . 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 FreshSet : TermList -> FreshSet . eq FreshSet(VL:TermList) = FreshSet(VL:TermList,nil) . op FreshSet : TermList FreshSet -> FreshSet . eq FreshSet(empty,F:FreshSet) = noDup(F:FreshSet) . eq FreshSet((V:Variable,VL:TermList),F:FreshSet) = FreshSet(VL:TermList, (if getType(V:Variable) == 'Fresh then downTerm(V:Variable,(nil).FreshSet) else nil fi),F:FreshSet) . op noDup : FreshSet -> FreshSet . eq noDup((r:Fresh,r:Fresh,F:FreshSet)) = noDup((r:Fresh,F:FreshSet)) . eq noDup(F:FreshSet) = F:FreshSet [owise] . 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] . op _setminus_ : IntruderKnowledge IntruderKnowledge -> IntruderKnowledge . eq (X:IntruderKnowledge, K:IntruderKnowledge) setminus X:IntruderKnowledge = K:IntruderKnowledge . eq K:IntruderKnowledge setminus X:IntruderKnowledge = K:IntruderKnowledge [owise] . 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 remove-!= : IntruderKnowledge -> IntruderKnowledge . eq remove-!=(X:Knowledge-!=,K:IntruderKnowledge) = remove-!=(K:IntruderKnowledge) . eq remove-!=(empty) = empty . eq remove-!=(X:IntruderKnowledgeElem,K:IntruderKnowledge) = X:IntruderKnowledgeElem,remove-!=(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-CPSA : IntruderKnowledge -> IntruderKnowledge . eq only-CPSA(X:Knowledge-CPSA,K:IntruderKnowledge) = X:Knowledge-CPSA,only-CPSA(K:IntruderKnowledge) . eq only-CPSA((empty).IntruderKnowledge) = empty . eq only-CPSA(X:IntruderKnowledgeElem,K:IntruderKnowledge) = only-CPSA(K:IntruderKnowledge) [owise] . op getIrrTerms : IntruderKnowledge -> TermList . eq getIrrTerms(irr(M:Msg),K:IntruderKnowledge) = (upTerm(M:Msg),getIrrTerms(K:IntruderKnowledge)) . eq getIrrTerms(K:IntruderKnowledge) = empty [owise] . op remove-irr : IntruderKnowledge -> IntruderKnowledge . eq remove-irr(X:Knowledge-irr,K:IntruderKnowledge) = remove-irr(K:IntruderKnowledge) . eq remove-irr((empty).IntruderKnowledge) = empty . eq remove-irr(X:IntruderKnowledgeElem,K:IntruderKnowledge) = X:IntruderKnowledgeElem,remove-irr(K:IntruderKnowledge) [owise] . op remove-irr : System -> System . eq remove-irr( SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || G:GhostList || PP:Properties) = SS:StrandSet || remove-irr(K:IntruderKnowledge) || ML:SMsgList || G:GhostList || PP:Properties . 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 remove-inst : IntruderKnowledge -> IntruderKnowledge . eq remove-inst(X:Knowledge-inst,K:IntruderKnowledge) = remove-inst(K:IntruderKnowledge) . eq remove-inst((empty).IntruderKnowledge) = empty . eq remove-inst(X:IntruderKnowledgeElem,K:IntruderKnowledge) = X:IntruderKnowledgeElem,remove-inst(K:IntruderKnowledge) [owise] . op remove-inst : System -> System . eq remove-inst( SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || G:GhostList || PP:Properties) = SS:StrandSet || remove-inst(K:IntruderKnowledge) || ML:SMsgList || G:GhostList || PP:Properties . 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)) . eq length(X:Synchro, L:SMsgList) = s(length(L:SMsgList)) . eq length(X:StrandConstraint, 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 fmod DEFINITION-PA-SYMBOLS is pr PROTOCOL-EXAMPLE-SYMBOLS . sorts ProcessConf Process HeadProcess . sorts EmptyProcess EmptyProcessConf . subsort EmptyProcessConf < ProcessConf . subsort EmptyProcess < Process . subsort HeadProcess < Process < ProcessConf . op _&_ : ProcessConf ProcessConf -> ProcessConf [assoc comm id: emptyProcessConf]. op emptyProcessConf : -> EmptyProcessConf . op _._ : HeadProcess Process -> Process [id: nilP prec 1] . op nilP : -> EmptyProcess . subsorts SMsgElem < HeadProcess . op _?_ : Process Process -> HeadProcess . op if_then_else_ : StrandConstraint Process Process -> HeadProcess . sort ProcessAttack . op _||_||_ : ProcessConf IntruderKnowledge ProcessExclusionPattern -> ProcessAttack [format (d n d n d d)] . op errorProcessAttack : -> ProcessAttack . sort ProcessExclusionPattern . sorts ProcessNeverPattern ProcessNeverPatternSet . subsort ProcessNeverPattern < ProcessNeverPatternSet . op _||_ : ProcessConf IntruderKnowledge -> ProcessNeverPattern [format (+++++i ni ni i-----)] . op nil : -> ProcessNeverPatternSet . op __ : ProcessNeverPatternSet ProcessNeverPatternSet -> ProcessNeverPatternSet [ctor assoc comm id: nil format (i ni i)] . op never : ProcessNeverPatternSet -> ProcessExclusionPattern [format (nci nio)] . op nil : -> ProcessExclusionPattern . endfm fmod PA2NPA is pr DEFINITION-PA-SYMBOLS . --- pr BACK-NARROWING . pr SUBSTITUTION-HANDLING . pr DEFINITION-PROTOCOL-RULES-HANDLING . op toCstrSS : ProcessConf -> StrandSet . --- op toCstrSS# : ListProcess SMsgList -> StrandSet . op toCstrSS# : Process SMsgList -> StrandSet . var Ro : Role . var S : SMsgList . vars X Y Z : Msg . var U V W : Process . --- var L : ListProcess . var Ls : ProcessConf . eq toCstrSS(U & Ls) = toCstrSS#(U, nil) & toCstrSS(Ls) . eq toCstrSS(emptyProcessConf) = empty . eq toCstrSS#(nilP, S) = :: getFresh(S) :: [nil | toSMsgList-R(S, nil)] . eq toCstrSS#(+(X) . U, S) = toCstrSS#(U, (S, +(X))) . eq toCstrSS#(-(X) . U, S) = toCstrSS#(U, (S, -(X))) . eq toCstrSS#((if (X eq Y) then U else V) . W, S) = toCstrSS#(U . W, (S, (X eq Y))) & toCstrSS#(V . W, (S, (X neq Y))) . eq toCstrSS#((if (X neq Y) then U else V) . W, S) = toCstrSS#(U . W, (S, (X neq Y))) & toCstrSS#(V . W, (S, (X eq Y))) . eq toCstrSS#((U ? V) . W, S) = toCstrSS#(U . W, S) & toCstrSS#(V . W, S) . eq toCstrSS#(X:SMsgElem . W,S) = toCstrSS#(W,(S, X:SMsgElem)) [owise] . op getFresh : SMsgList -> FreshSet . eq getFresh(S) = getFresh#(S,nil,nil) . op getFresh# : SMsgList FreshSet FreshSet -> FreshSet . eq getFresh#(nil,Pos:FreshSet,Neg:FreshSet) = noDup(Pos:FreshSet) . eq getFresh#((+(X),S),Pos:FreshSet,Neg:FreshSet) = getFresh#(S, (Pos:FreshSet, (FreshSet(Vars(upTerm(X))) minus Neg:FreshSet) ), Neg:FreshSet) . eq getFresh#((-(X),S),Pos:FreshSet,Neg:FreshSet) = getFresh#(S, Pos:FreshSet, (Neg:FreshSet, (FreshSet(Vars(upTerm(X))) minus Pos:FreshSet) ) ). eq getFresh#((X:SMsgElem,S),Pos:FreshSet,Neg:FreshSet) = getFresh#(S,Pos:FreshSet,Neg:FreshSet) [owise] . op downProcessAttack : Term ~> Attack . ceq downProcessAttack(T:Term) = makeStrandsFinal*(toCstrSS(X:ProcessConf)) || X:IntruderKnowledge || nil || nil || toCstrSS@(X:ProcessExclusionPattern) if X:ProcessConf || X:IntruderKnowledge || X:ProcessExclusionPattern := downTerm(T:Term,(errorProcessAttack).ProcessAttack) . op toCstrSS@ : ProcessExclusionPattern -> Properties . eq toCstrSS@(nil) = nil . eq toCstrSS@(never(X:ProcessNeverPatternSet)) = never(toCstrSS@@(X:ProcessNeverPatternSet)) . op toCstrSS@@ : ProcessNeverPatternSet -> NeverPatternSet . eq toCstrSS@@(nil) = nil . eq toCstrSS@@((X:ProcessConf || X:IntruderKnowledge) X:ProcessNeverPatternSet) = (toCstrSS(X:ProcessConf) & downTerm('XXXX:StrandSet,(empty).StrandSet) || (X:IntruderKnowledge,downTerm('XXXX:IntruderKnowledge,(empty).IntruderKnowledge-empty))) toCstrSS@@(X:ProcessNeverPatternSet) . 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 . pr DEFINITION-PA-SYMBOLS . --- Symbols to specify your protocol (Dolev-Yao and Principals) op STRANDS-DOLEVYAO : -> StrandSet . op STRANDS-PROTOCOL : -> StrandSet . --- Process to specify a protocol (Principals only) op PROCESSES-PROTOCOL : -> ProcessConf . --- Attack State to start search op ATTACK-STATE : Nat -> Attack . --- Attack State to start search op ATTACK-PROCESS : Nat -> ProcessAttack . --- User chooses a type of variant to be used in the protocol. --- Either standard variants or constructor variants . sort TypeOfVariants . op variants : -> TypeOfVariants [ctor] . op constructor-variants : -> TypeOfVariants [ctor] . op TYPE-VARIANTS : ~> TypeOfVariants . --- Include this definition in the protocol. --- If this symbol is not defined, constant variants is assumed. 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 MAUDE-NPA-VARIANTS is protecting META-E-UNIFICATION . --- protecting VAR-SAT-TOOL . ---( protecting VAR-SAT-TOOL * (op _,_ : SrtTrmSetMap SrtTrmSetMap -> SrtTrmSetMap to _;;_) .) protecting DEFINITION-PROTOCOL-RULES-INPUT . protecting DEFINITION-PROTOCOL-RULES-HANDLING . protecting VARIANT-HANDLING . op type-variants? : ~> TypeOfVariants [memo] . eq type-variants? = downTerm(extract('TYPE-VARIANTS.TypeOfVariants,upModule('PROTOCOL-SPECIFICATION,true)),variants) . op getVariantsOrConstructorVariants : Module Term -> VariantFourSet . eq getVariantsOrConstructorVariants(M:Module,T:Term) = getVariantsOrConstructorVariants(M:Module,T:Term,0,none,empty) . op getVariantsOrConstructorVariants : Module Term Nat EFlags -> VariantFourSet . eq getVariantsOrConstructorVariants(M:Module,T:Term,N:Nat,E:EFlags) = getVariantsOrConstructorVariants(M:Module,T:Term,N:Nat,E:EFlags,empty) . op getVariantsOrConstructorVariants : Module Term Nat EFlags TermList -> VariantFourSet . eq getVariantsOrConstructorVariants(M:Module,T:Term,N:Nat,E:EFlags,TL:TermList) = getVariants(M:Module,T:Term,N:Nat,E:EFlags,TL:TermList) . ***( op getVariantsOrConstructorVariants : Module Term Nat EFlags TermList -> VariantFourSet . eq getVariantsOrConstructorVariants(M:Module,T:Term,N:Nat,E:EFlags,TL:TermList) = if type-variants? == constructor-variants then toVariantFourSet(ctor-variants*(M:Module,T:Term,N:Nat)) else getVariants(M:Module,T:Term,N:Nat,E:EFlags,TL:TermList) fi . op ctor-variants* : Module Term Nat -> VariantTripleSet . eq ctor-variants*(M:Module,T:Term,N:Nat) = if ctor-variants(M:Module,T:Term,N:Nat) :: VariantTripleSet then ctor-variants(M:Module,T:Term,N:Nat) else empty fi . )*** endfm fmod PROTOCOL-EXAMPLE-GHOST is pr PROTOCOL-EXAMPLE-SYMBOLS . pr META-LEVEL-MNPA . *** ghost predicate ************************************************ op isGhostMsg : Msg -> Bool [memo] . eq isGhostMsg(X:Msg) = X:Msg :: Public or-else (upTerm(X:Msg) :: Variable and-then not (X:Msg :: Private)) [owise] . endfm fmod NORMALIZE-MNPA is protecting CHECKXOR . protecting META-LEVEL-MNPA . op normalize : Term -> Term . eq normalize(T:Term) = normalize( onlyEqsNoBuiltInUnify( clearNonExecEqs(eraseRls(checkXOR( upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true) ))) ), T:Term ) . op normalize : Substitution -> Substitution . eq normalize(S:Substitution) = normalize( onlyEqsNoBuiltInUnify( clearNonExecEqs(eraseRls(checkXOR( upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true) ))) ), S:Substitution ) . endfm fmod GENERATE-RULES is protecting DEFINITION-PROTOCOL-RULES-INPUT . protecting META-LEVEL-MNPA . protecting DEFINITION-PROTOCOL-RULES-HANDLING . protecting MODULE-HANDLING . protecting META-NARROWING-SEARCH . protecting META-MSG-UNIFICATION-INTEGRATION . protecting CHECKXOR . protecting VARIANT-HANDLING . protecting NORMALIZE-MNPA . protecting PA2NPA . protecting MAUDE-NPA-VARIANTS . --------------------------------------------------------------------- op old-strands? : ~> StrandSet [memo] . eq old-strands? = downStrandSet( normalize(upModule('PROTOCOL-SPECIFICATION,true), extract('STRANDS-PROTOCOL.StrandSet, processToStrand( upModule('PROTOCOL-SPECIFICATION,true))))) . op variants-strands? : ~> StrandSet [memo] . eq variants-strands? = fixIrrStrandSet(old-strands?) . 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 typeErrorInStrandsProtocol : -> [FModule] [ctor format (r o)] . op errorInGeneratingVariantsStrandsProtocol : -> [FModule] [ctor format (r o)] . op PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE : -> [FModule] [memo] . eq PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE = processToStrand(PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE2) . op PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE2 : -> [FModule] [memo] . eq PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE2 = normalize(upModule('PROTOCOL-SPECIFICATION,true), upModule('PROTOCOL-SPECIFICATION,true)) . ***( eq PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE2 = if old-strands? :: StrandSet then if fixIrreducible(processToStrand( normalize(upModule('PROTOCOL-SPECIFICATION,true), upModule('PROTOCOL-SPECIFICATION,true)))) :: FModule then newName('PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE, fixIrreducible(processToStrand( normalize(upModule('PROTOCOL-SPECIFICATION,true), upModule('PROTOCOL-SPECIFICATION,true)))) ) else errorInGeneratingVariantsStrandsProtocol fi else typeErrorInStrandsProtocol fi . )*** *** Transform processes into strands op processToStrand : FModule -> [FModule] . ceq processToStrand( 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 X:EquationSet endfm if X:EquationSet := processToStrand(E:EquationSet) . op processToStrand : EquationSet -> [EquationSet] . eq processToStrand( (eq 'PROCESSES-PROTOCOL.ProcessConf = T1:Term [AtS1:AttrSet] .) (eq 'STRANDS-PROTOCOL.StrandSet = T2:Term [AtS2:AttrSet] .) EqS:EquationSet ) = processToStrand*( (eq 'PROCESSES-PROTOCOL.ProcessConf = T1:Term [AtS1:AttrSet] .) EqS:EquationSet ) . eq processToStrand(EqS:EquationSet) = processToStrand*(EqS:EquationSet) [owise] . op processToStrand* : EquationSet -> [EquationSet] . ceq processToStrand*( (eq 'PROCESSES-PROTOCOL.ProcessConf = T:Term [AtS:AttrSet] .) EqS:EquationSet ) = if PC:[ProcessConf] :: ProcessConf and PC:[ProcessConf] =/= (emptyProcessConf).ProcessConf then (eq 'STRANDS-PROTOCOL.StrandSet = upTerm(toCstrSS(PC:[ProcessConf])) [AtS:AttrSet] .) EqS:EquationSet else error fi if PC:[ProcessConf] := downTerm(T:Term,(emptyProcessConf).ProcessConf) . eq processToStrand*(EqS:EquationSet) = EqS:EquationSet [owise] . *** 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] . ceq 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 X:EquationSet endfm if X:EquationSet := fixIrrEq(E:EquationSet) . *** Get equations with strands *********************************** op error : -> [EquationSet] . op fixIrrEq : EquationSet -> [EquationSet] . eq fixIrrEq( (eq 'STRANDS-PROTOCOL.StrandSet = T:Term [AtS:AttrSet] .) EqS:EquationSet ) = if fixIrrStrandSet(downStrandSet(T:Term)) :: StrandSet then (eq 'STRANDS-PROTOCOL.StrandSet = upTerm(fixIrrStrandSet(downStrandSet(T:Term))) [AtS:AttrSet] .) EqS:EquationSet else error fi . eq fixIrrEq(EqS:EquationSet) = EqS:EquationSet [owise] . *** Useful for the whole section ******************************** op fixIrrMsg : Msg -> VariantTripleSet . eq fixIrrMsg(M:Msg) = fixIrrMsg(M:Msg,highestVar(upTerm(M:Msg)) + 1) . op fixIrrMsg : Msg Nat -> VariantTripleSet [memo] . eq fixIrrMsg(M:Msg,N:Nat) = toVariantTripleSet( getVariantsOrConstructorVariants( clearAllFrozen(removeBoolEqs( checkXOR(upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true)))), upTerm(M:Msg), N:Nat,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,empty) . op fixIrrSystemInI!= : System -> SystemSet . eq fixIrrSystemInI!=(S:System) = fixIrrSystem*(inI !=,S:System,empty) . var VTS : VariantTripleSet . op fixIrrSystem* : OptionsFixIrr System TermList -> SystemSet [memo] . ceq fixIrrSystem*(OFI,S:System,TL:TermList) = fixIrrSystemRT(OFI,S:System,M:Msg,TL:TermList,VTS) if M:Msg,MS:MsgSet := getMsg(OFI,S:System,emptyMsgSet) /\ SS:StrandSet || 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 M:Msg includeVars G:GhostList --- This may produce problems of instantions found by variant generation that resucitate a state and-then not (all Vars(upTerm(M:Msg)) in Vars(getIrrTerms(K:IntruderKnowledge))) /\ VTS := fixIrrMsg(M:Msg,highestVar((upTerm(M:Msg),TL:TermList)) + 1) /\ VTS :: VariantTripleSet and-then downMsgSet(getTerms(VTS)) =/= M:Msg and-then not onlyRenamingAll(upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true),getSubstitutions(VTS)) . eq fixIrrSystem*(OFI,S:System,TL:TermList) = S:System [owise] . op getMsg : OptionsFixIrr System MsgSet -> MsgSet . ceq getMsg(strands OFI,S:System,MS:MsgSet) = getMsg(strands OFI,S:System,(M:Msg,MS:MsgSet)) 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 (M:Msg in MS:MsgSet) . ceq getMsg(inI OFI,S:System,MS:MsgSet) = getMsg(inI OFI,S:System,(M:Msg,MS:MsgSet)) if SS:StrandSet || M:Msg inI,K:IntruderKnowledge || M:SMsgList || G:GhostList || PP:Properties := S:System /\ not (M:Msg in MS:MsgSet) . ceq getMsg(!= OFI,S:System,MS:MsgSet) = getMsg(!= OFI,S:System,(M1:Msg,M2:Msg,MS:MsgSet)) if SS:StrandSet || (M1:Msg != M2:Msg),K:IntruderKnowledge || M:SMsgList || G:GhostList || PP:Properties := S:System /\ not (M1:Msg in MS:MsgSet) and not (M2:Msg in MS:MsgSet) . eq getMsg(OFI,S:System,MS:MsgSet) = MS:MsgSet [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:Variant | RT:VariantTripleSet) = fixIrrSystemRTe(OFI,S:System,M:Msg,TL:TermList,R:Variant) fixIrrSystemRT(OFI,S:System,M:Msg,TL:TermList,RT:VariantTripleSet) . op fixIrrSystemRTe : OptionsFixIrr System Msg TermList Variant -> SystemSet . eq fixIrrSystemRTe(OFI,S:System,M:Msg,TL:TermList, {T:Term,S:Substitution,NextVar:Nat,P:Parent,B:Bool}) = if dom S:Substitution notIn TL:TermList --- check at least one variable not brought by a variant is instantiated and check-irr( downSystemSet( (replaceTerm upTerm(M:Msg) by T:Term in upTerm(S:System)) << normalize(S:Substitution) ) ) then fixIrrSystem*(OFI, ---addInst(rangeVars(S:Substitution), ---addInst(Vars(T:Term), addInst((rangeVars(normalize(S:Substitution)),Vars(T:Term)), addIrr(downMsgSet(T:Term), downSystemSet( normalize( (replaceTerm upTerm(M:Msg) by T:Term in upTerm(S:System)) << normalize(S:Substitution) ) ) ) ) ,(TL:TermList,rangeVars(normalize(S:Substitution))) ) else empty fi . op check-irr : System -> Bool . eq check-irr( SS:StrandSet || K:IntruderKnowledge || M:SMsgList || G:GhostList || PP:Properties) = check-irr(K:IntruderKnowledge) . op check-irr : IntruderKnowledge -> Bool . eq check-irr(irr(M:Msg),K:IntruderKnowledge) = (upTerm(M:Msg) =[upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true)]= getTerm( metaReduce( removeVariantLabel(onlyEqsNoBuiltInUnify( clearNonExecEqs(eraseRls(checkXOR( upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true) ))) )), upTerm(M:Msg) ) ) ) and-then check-irr(K:IntruderKnowledge) . eq check-irr(K:IntruderKnowledge) = true [owise] . op addIrr : MsgSet System -> System . eq addIrr(emptyMsgSet,X:System) = X:System . eq addIrr((M:Msg,MS:MsgSet), SS:StrandSet || K:IntruderKnowledge || M:SMsgList || G:GhostList || PP:Properties) = addIrr(MS:MsgSet, 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 _includeVars_ : Msg GhostList -> Bool . eq M:Msg includeVars G:GhostList = Vars(upTerm(M:Msg)) includeVars G:GhostList . op _includeVars_ : TermList GhostList -> Bool . eq (TL:TermList includeVars ghost(M2:Msg,SS2:StrandSet,K2:IntruderKnowledge,ML2:SMsgList,PP2:Properties), G:GhostList) = (TL:TermList intersect Vars(upTerm(M2:Msg)) =/= empty implies (Vars(upTerm(M2:Msg)) setMinus TL:TermList) == empty) and (TL:TermList includeVars G:GhostList) . eq (TL:TermList includeVars nil) = true . 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 COMPOSITION-RULES : -> SModule [memo] . eq COMPOSITION-RULES = newName('COMPOSITION-RULES-GENERATED, addRules( genCompositionRules( downStrandSet( extract('STRANDS-DOLEVYAO.StrandSet,PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) & downStrandSet( extract('STRANDS-PROTOCOL.StrandSet,PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) ), upModule('COMPOSITION-RULES,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 . eq genRules**(rrL:FreshSet, L:SMsgList, nil) = none . eq genRules**(rrL:FreshSet, L:SMsgList, (M:Synchro,R:SMsgList)) = genRules**(rrL:FreshSet, (L:SMsgList,M:Synchro), R:SMsgList) . eq genRules**(rrL:FreshSet, L:SMsgList, (M:StrandConstraint,R:SMsgList)) = genRules**(rrL:FreshSet, (L:SMsgList,M:StrandConstraint), R:SMsgList) . 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)) = if only-Synchro(R:SMsgList) == nil then *** 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))) ] ], '_`,_['_!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] .) else none fi genRules**(rrL:FreshSet, (L:SMsgList,+(M:Msg)), R:SMsgList) . ---------------- op genCompositionRules : StrandSet -> RuleSet . eq genCompositionRules(X:StrandSet) = genCompositionRules*(makeStrandsFinal*(X:StrandSet)) . op genCompositionRules* : StrandSet -> RuleSet . eq genCompositionRules*(empty) = none . eq genCompositionRules*(S:Strand & SS:StrandSet) = genCompositionRules**(S:Strand) genCompositionRules*(SS:StrandSet) . op genCompositionRules** : Strand -> RuleSet . eq genCompositionRules**( :: rrL1:FreshSet :: [ L:SMsgList-L, {R1:Role -> RR2:RoleSet ;; X:How ;; M:Msg} | nil ] ) = genCompositionRules***(RR2:RoleSet, :: rrL1:FreshSet :: [ L:SMsgList-L, {R1:Role -> RR2:RoleSet ;; X:How ;; M:Msg} | nil ] ) . eq genCompositionRules**(S:Strand) = none [owise] . op genCompositionRules*** : RoleSet Strand -> RuleSet . eq genCompositionRules***(empty,S:Strand) = none . eq genCompositionRules***(R2:Role RR2:RoleSet, :: rrL1:FreshSet :: [ L:SMsgList-L, {R1:Role -> R2:Role RR2':RoleSet ;; X:How ;; M:Msg} | nil ] ) = *** general rule for the general case with id symbols (rl '_||_||_||_||_[ '_&_[ 'SS:StrandSet, '_&_[ '::_::`[_|_`][ upTerm(rrL1:FreshSet), upTerm(L:SMsgList-L), '_`,_[upTerm({R1:Role -> R2:Role RR2':RoleSet ;; X:How ;; M:Msg}), 'nil.SMsgList-R] ], '::_::`[_|_`][ 'rrL2:FreshSet, 'nil.SMsgList-L, '_`,_[ '`{_->_;;_;;_`}['__['R:RoleSet,upTerm(R1:Role)],upTerm(R2:Role),upTerm(X:How),upTerm(M:Msg)], 'X:SMsgList-R] ] ] ], 'K:IntruderKnowledge, '_`,_[ '`{_->_;;_;;_`}[upTerm(R1:Role),upTerm(R2:Role),upTerm(X:How),upTerm(M:Msg)], 'ML:SMsgList ], 'GL:GhostList, 'PP:Properties ] => '_||_||_||_||_[ '_&_[ 'SS:StrandSet, '::_::`[_|_`][ 'rrL2:FreshSet, '_`,_['nil.SMsgList-L, '`{_->_;;_;;_`}['__['R:RoleSet,upTerm(R1:Role)],upTerm(R2:Role),upTerm(X:How),upTerm(M:Msg)] ], 'X:SMsgList-R ] ], 'K:IntruderKnowledge, 'ML:SMsgList, 'GL:GhostList, 'PP:Properties ] [nonexec] .) genCompositionRules***(RR2:RoleSet, :: rrL1:FreshSet :: [ L:SMsgList-L, {R1:Role -> R2:Role RR2':RoleSet ;; X:How ;; M:Msg} | nil ] ) . --------------------------------------------------------------------- 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, (noSynchro&noConstraint(toSMsgList(L:SMsgList-L)),noSynchro&noConstraint(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(filterTimeMsg(toMsgSet(L:SMsgList))) => upTerm(filterTimeMsg(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, (noSynchro&noConstraint(toSMsgList(L:SMsgList-L)),noSynchro&noConstraint(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 Vars(upTerm(only-Input(L:SMsgList))) setMinus Vars(upTerm(M:Msg)) =/= empty or-else (upTerm(M:Msg) :: Variable and-then only-Input(L:SMsgList) =/= nil) 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)] . --- Special treatment for messages with symbols adding extra features to sort Msg --- metadata grammar-arg-1 allows removing the extra arguments of special symbol --- and considering just the first argument as the actual messages for grammar generation op filterTimeMsg : MsgSet -> MsgSet . eq filterTimeMsg(emptyMsgSet) = emptyMsgSet . eq filterTimeMsg(X:Msg,Y:MsgSet) = filterTimeMsg$(X:Msg),filterTimeMsg(Y:MsgSet) . op filterTimeMsg$ : Msg -> Msg . ceq filterTimeMsg$(X:Msg) = downMsgSet(T:Term) if F:Qid[T:Term,TL:TermList] := upTerm(X:Msg) /\ M:Module := PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE /\ ((op F:Qid : TPL:TypeList -> TP:Type [metadata("grammar-arg-1") AtS:AttrSet] .) OPDS:OpDeclSet) := getOpsOfQid(M:Module,F:Qid,getTypes(M:Module, (T:Term,TL:TermList))) . eq filterTimeMsg$(X:Msg) = X:Msg [owise] . op filterTimeMsg : IdSystemSet -> IdSystemSet . eq filterTimeMsg((empty).IdSystemSet) = empty . eq filterTimeMsg(X:IdSystem Y:IdSystemSet) = filterTimeMsgIdSystem(X:IdSystem) filterTimeMsg(Y:IdSystemSet) . eq filterTimeMsg(X:IdSystemSet) = X:IdSystemSet [owise] . op filterTimeMsgIdSystem : IdSystem -> IdSystem [memo] . eq filterTimeMsgIdSystem ( < I1:Id > SS1:StrandSet || K:IntruderKnowledge || ML1:SMsgList || G1:GhostList || PP1:Properties) = ( < I1:Id > filterTimeMsgStrandSet(SS1:StrandSet) || filterTimeMsgIntruderKnowledge(K:IntruderKnowledge) || filterTimeMsgSMsgList(ML1:SMsgList) || filterTimeMsgGhostList(G1:GhostList) || filterTimeMsgProperties(PP1:Properties)) . eq filterTimeMsgIdSystem(X:IdSystem) = X:IdSystem [owise] . op filterTimeMsgStrandSet : StrandSet -> StrandSet . eq filterTimeMsgStrandSet(empty) = empty . eq filterTimeMsgStrandSet(:: RL:FreshSet :: [ L:SMsgList-L | L':SMsgList-R ] & SS:StrandSet) = :: RL:FreshSet :: [ filterTimeMsgSMsgList-L(L:SMsgList-L) | filterTimeMsgSMsgList-R(L':SMsgList-R) ] & filterTimeMsgStrandSet(SS:StrandSet) . eq filterTimeMsgStrandSet(X:StrandSet) = X:StrandSet [owise] . op filterTimeMsgSMsgList-R : SMsgList-R -> SMsgList-R . eq filterTimeMsgSMsgList-R(nil) = nil . eq filterTimeMsgSMsgList-R((X:SMsg,Y:SMsgList-R)) = filterTimeMsgSMsgElem(X:SMsg),filterTimeMsgSMsgList-R(Y:SMsgList-R) . eq filterTimeMsgSMsgList-R(X:SMsgList-R) = X:SMsgList-R [owise] . op filterTimeMsgSMsgList-L : SMsgList-L -> SMsgList-L . eq filterTimeMsgSMsgList-L(nil) = nil . eq filterTimeMsgSMsgList-L((Y:SMsgList-L,X:SMsg)) = filterTimeMsgSMsgList-L(Y:SMsgList-L),filterTimeMsgSMsgElem(X:SMsg) . eq filterTimeMsgSMsgList-L(X:SMsgList-L) = X:SMsgList-L [owise] . op filterTimeMsgSMsgList : SMsgList -> SMsgList . eq filterTimeMsgSMsgList(nil) = nil . eq filterTimeMsgSMsgList((X:SMsgElem,Y:SMsgList)) = filterTimeMsgSMsgElem(X:SMsgElem),filterTimeMsgSMsgList(Y:SMsgList) . eq filterTimeMsgSMsgList(X:SMsgList) = X:SMsgList [owise] . op filterTimeMsgSMsgElem : SMsgElem -> SMsgElem . eq filterTimeMsgSMsgElem(+(X:Msg)) = +(filterTimeMsg(X:Msg)) . eq filterTimeMsgSMsgElem(-(X:Msg)) = -(filterTimeMsg(X:Msg)) . eq filterTimeMsgSMsgElem(resuscitated(X:Msg)) = resuscitated(filterTimeMsg(X:Msg)) . eq filterTimeMsgSMsgElem(generatedByIntruder(X:Msg)) = generatedByIntruder(filterTimeMsg(X:Msg)) . eq filterTimeMsgSMsgElem(X:Msg eq Y:Msg) = filterTimeMsg(X:Msg) eq filterTimeMsg(Y:Msg) . eq filterTimeMsgSMsgElem(X:Msg neq Y:Msg) = filterTimeMsg(X:Msg) neq filterTimeMsg(Y:Msg) . eq filterTimeMsgSMsgElem(resuscitated(X:Msg)) = resuscitated(filterTimeMsg(X:Msg)) . eq filterTimeMsgSMsgElem({ X:RoleSet -> Y:RoleSet ;; H:How ;; M:Msg}) = { X:RoleSet -> Y:RoleSet ;; H:How ;; filterTimeMsg(M:Msg)} . eq filterTimeMsgSMsgElem(X:SMsgElem) = X:SMsgElem [owise] . op filterTimeMsgIntruderKnowledge : IntruderKnowledge -> IntruderKnowledge . ceq filterTimeMsgIntruderKnowledge((X1:Msg !inI,X2:Msg inI,Y:IntruderKnowledge)) = filterTimeMsgIntruderKnowledge((X2:Msg inI,Y:IntruderKnowledge)) if X1:Msg =/= X2:Msg and-then filterTimeMsg$(X1:Msg) == filterTimeMsg$(X2:Msg) . ceq filterTimeMsgIntruderKnowledge((X1:Msg !inI,X2:Msg !inI,Y:IntruderKnowledge)) = filterTimeMsgIntruderKnowledge((X2:Msg !inI,Y:IntruderKnowledge)) if X1:Msg =/= X2:Msg and-then filterTimeMsg$(X1:Msg) == filterTimeMsg$(X2:Msg) . ceq filterTimeMsgIntruderKnowledge((X1:Msg inI,X2:Msg inI,Y:IntruderKnowledge)) = filterTimeMsgIntruderKnowledge((X2:Msg inI,Y:IntruderKnowledge)) if X1:Msg =/= X2:Msg and-then filterTimeMsg$(X1:Msg) == filterTimeMsg$(X2:Msg) . eq filterTimeMsgIntruderKnowledge(Y:IntruderKnowledge) = filterTimeMsgIntruderKnowledge@(Y:IntruderKnowledge) [owise] . op filterTimeMsgIntruderKnowledge@ : IntruderKnowledge -> IntruderKnowledge . eq filterTimeMsgIntruderKnowledge@(empty) = empty . eq filterTimeMsgIntruderKnowledge@((X:IntruderKnowledgeElem,Y:IntruderKnowledge)) = filterTimeMsgIntruderKnowledgeElem(X:IntruderKnowledgeElem),filterTimeMsgIntruderKnowledge@(Y:IntruderKnowledge) . eq filterTimeMsgIntruderKnowledge@(X:IntruderKnowledge) = X:IntruderKnowledge [owise] . op filterTimeMsgIntruderKnowledgeElem : IntruderKnowledgeElem -> IntruderKnowledgeElem . eq filterTimeMsgIntruderKnowledgeElem(X:Msg !inI) = filterTimeMsg(X:Msg) !inI . eq filterTimeMsgIntruderKnowledgeElem(X:Msg inI) = filterTimeMsg(X:Msg) inI . eq filterTimeMsgIntruderKnowledgeElem(X:Msg != Y:Msg) = filterTimeMsg(X:Msg) != filterTimeMsg(Y:Msg) . eq filterTimeMsgIntruderKnowledgeElem(irr(X:Msg)) = irr(filterTimeMsg(X:Msg)) . eq filterTimeMsgIntruderKnowledgeElem(inst(X:Msg)) = inst(filterTimeMsg(X:Msg)) . eq filterTimeMsgIntruderKnowledgeElem(secret(X:Msg)) = secret(filterTimeMsg(X:Msg)) . eq filterTimeMsgIntruderKnowledgeElem(X:IntruderKnowledgeElem) = X:IntruderKnowledgeElem [owise] . op filterTimeMsgGhostList : GhostList -> GhostList . eq filterTimeMsgGhostList(nil) = nil . eq filterTimeMsgGhostList((X:Ghost,Y:GhostList)) = filterTimeMsgGhost(X:Ghost),filterTimeMsgGhostList(Y:GhostList) . eq filterTimeMsgGhostList((X:ShortGhost,Y:GhostList)) = filterTimeMsgShortGhost(X:ShortGhost),filterTimeMsgGhostList(Y:GhostList) . eq filterTimeMsgGhostList(X:GhostList) = X:GhostList [owise] . op filterTimeMsgGhost : Ghost -> Ghost . eq filterTimeMsgGhost(ghost(X:Msg,Y:StrandSet,I:IntruderKnowledge,M:SMsgList,P:Properties)) = ghost(filterTimeMsg(X:Msg),filterTimeMsgStrandSet(Y:StrandSet),filterTimeMsgIntruderKnowledge(I:IntruderKnowledge),filterTimeMsgSMsgList(M:SMsgList),filterTimeMsgProperties(P:Properties)) . eq filterTimeMsgGhost(X:Ghost) = X:Ghost [owise] . op filterTimeMsgShortGhost : ShortGhost -> ShortGhost . eq filterTimeMsgShortGhost(ghost(X:Msg)) = ghost(filterTimeMsg(X:Msg)) . eq filterTimeMsgShortGhost(X:ShortGhost) = X:ShortGhost [owise] . op filterTimeMsgProperties : Properties -> Properties . eq filterTimeMsgProperties(nil) = nil . eq filterTimeMsgProperties(never(X:NeverPatternSet)) = never(filterTimeMsgNeverPatternSet(X:NeverPatternSet)) . eq filterTimeMsgProperties(X:Properties) = X:Properties [owise] . op filterTimeMsgNeverPatternSet : NeverPatternSet -> NeverPatternSet . eq filterTimeMsgNeverPatternSet(nil) = nil . eq filterTimeMsgNeverPatternSet((S:StrandSet || K:IntruderKnowledge) Z:NeverPatternSet) = (filterTimeMsgStrandSet(S:StrandSet) || filterTimeMsgIntruderKnowledge(K:IntruderKnowledge)) filterTimeMsgNeverPatternSet(Z:NeverPatternSet) . eq filterTimeMsgNeverPatternSet(X:NeverPatternSet) = X:NeverPatternSet [owise] . endfm fmod RESULT-GRAMMAR-NARROWING is protecting DEFINITION-CONSTRAINTS . protecting META-LEVEL-MNPA . --- 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 DEFINITION-PROTOCOL-RULES-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 . eq {G | GS,Dt} |- Ct = (not (G :: errorGrammar) and-then {G,Dt} |-* Ct) or-else {GS,Dt} |- Ct . eq {none,Dt} |- Ct = false [owise] . op {_,_} |-* _ : Grammar CtrSet CtrSet -> Bool . ceq {G,Dt} |-* Ct = {G,Dt',Vars(upTerm(Ct'))} |-- Ct' if (Ct':Term,Dt':Term) := simplifyVars((upTerm(Ct),upTerm(Dt))) /\ Ct' := downCtrSet(Ct':Term) /\ Dt' := downCtrSet(Dt':Term) . eq {G,Dt} |-* Ct = false [owise] . *** We put the memoization only in the |-- version *** and simplify variables in the initial term op {_,_,_} |-- _ : Grammar CtrSet TermList CtrSet -> Bool [memo] . ceq {G,Dt,TL} |-- Ct = if C:CtrSet == empty then true else simplifyOneStepG(G,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 : Grammar CtrSet CtrSet TermList -> Bool [memo] . eq simplifyOneStepG(G,Dt,Ct,TL) = composeOneStepG(G,Dt,Ct,TL, getTerms( metaOneRewriting(flipRls(grammar2Module(G)),upTerm(Ct),'CtrSet) ) ) . *** Test each new set of constraints op composeOneStepG : Grammar CtrSet CtrSet TermList TermSet -> Bool [memo] . eq composeOneStepG(G,Dt,Ct,TL,emptyTermSet) = false . eq composeOneStepG(G,Dt,Ct,TL,(T:Term | TS:TermSet)) = if Ct =/= downCtrSet(T:Term) then {G,Dt,TL} |-- downCtrSet(T:Term) else false fi or-else composeOneStepG(G,Dt,Ct,TL,TS:TermSet) . *** CtrSet1 <= CtrSet2 implies that CtrSet2 is more general than CtrSet1 op _<=[_]_ : CtrSet TermList CtrSet -> Bool . eq C1:CtrSet <=[TL] C2:CtrSet = C1:CtrSet <=1[TL] C2:CtrSet . op _<=1[_]_ : CtrSet TermList CtrSet -> Bool . eq empty <=1[TL] C:CtrSet = true . eq (X:Msg inL, C:CtrSet) <=1[TL] (X:Msg inL, C':CtrSet) = C:CtrSet <=1[TL] (X:Msg inL, C':CtrSet) . eq C1:CtrSet <=1[TL] C2:CtrSet = C1:CtrSet <=2[TL] C2:CtrSet [owise] . op _<=2[_]_ : CtrSet TermList CtrSet -> Bool . eq empty <=2[TL] C:CtrSet = true . ceq (pair(X:Msg,Z1:Msg) notInI, C:CtrSet) <=2[TL] (pair(Y:Msg,Z2:Msg) notInI, C':CtrSet) = C:CtrSet <=2[TL] (pair(Y:Msg,Z2:Msg) notInI, C':CtrSet) if upTerm(Z1:Msg) :: Variable and not upTerm(Z1:Msg) in TL /\ (X:Msg notInI) <=2*[TL] (Y:Msg notInI) . ceq (pair(Z1:Msg,X:Msg) notInI, C:CtrSet) <=2[TL] (pair(Z2:Msg,Y:Msg) notInI, C':CtrSet) = C:CtrSet <=2[TL] (pair(Z2:Msg,Y:Msg) notInI, C':CtrSet) if upTerm(Z1:Msg) :: Variable and not upTerm(Z1:Msg) in TL /\ (X:Msg notInI) <=2*[TL] (Y:Msg notInI) . eq C1:CtrSet <=2[TL] C2:CtrSet = C1:CtrSet <=2*[TL] C2:CtrSet [owise] . op _<=2*[_]_ : CtrSet TermList CtrSet -> Bool . ceq (X:Msg notInI, C:CtrSet) <=2*[TL] (Y:Msg notInI, C':CtrSet) = C:CtrSet <=2[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)) or-else (not upTerm(X:Msg) :: Variable and-then fresh[removeSame(metaBuiltInMatch(M:Module,upTerm(Y:Msg),upTerm(X:Msg)))] =/= empty ) . --- Yes extra var eq C1:CtrSet <=2*[TL] C2:CtrSet = C1:CtrSet <=3[TL] C2:CtrSet [owise] . op _<=3[_]_ : CtrSet TermList CtrSet -> Bool . eq empty <=3[TL] C:CtrSet = true . ceq (X:Msg notLeq Y:Msg), C:CtrSet <=3[TL] C':CtrSet = C:CtrSet <=3[TL] C':CtrSet if ***remove this single constraint if it is subsumed by any other constraint (X:Msg notLeq Y:Msg) <=Any[TL] C':CtrSet . eq C1:CtrSet <=3[TL] C2:CtrSet = C1:CtrSet <=4[TL] C2:CtrSet [owise] . op _<=4[_]_ : CtrSet TermList CtrSet -> Bool . eq (X:Msg notLeq Y:Msg), C:CtrSet <=4[TL] C':CtrSet = checkNotLeq(X:Msg,Y:Msg) and-then C:CtrSet <=3[TL] C':CtrSet . op checkNotLeq : Msg Msg -> Bool [memo] . eq checkNotLeq(X:Msg,Y:Msg) = ***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 ) ) . eq C:CtrSet <=4[TL] C':CtrSet = false [owise] . op checkId : Term Term -> Bool [memo] . 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-MNPA . 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 . var M : Module . 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) and-then noNewPhantomVariablebyEquationalTHeory(Lhs:CtrSet,Rhs:LConstraint) . op noNewPhantomVariablebyEquationalTHeory : CtrSet LConstraint -> Bool . ceq noNewPhantomVariablebyEquationalTHeory(M1:Msg inL,M2:Msg inL) = false if upTerm(M1:Msg) :: Variable and upTerm(M1:Msg) intersect Vars(upTerm(M2:Msg)) == empty . eq noNewPhantomVariablebyEquationalTHeory(Lhs:CtrSet,Rhs:LConstraint) = true [owise] . 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) = if nonEmpty(GSS) =/= empty then not({GSS,Lhs:CtrSet} |- (T:Msg inL)) else true fi 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((X:Msg inL),S:Substitution) = --- Discard if any symbol with Id and instantiated by such Id not anyIdSymbolT&S(PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS, upTerm((X:Msg inL)), S:Substitution) and-then --- not Id Symbol and not reducible rhsIsNormalized*((X:Msg inL) << S:Substitution) . op rhsIsNormalized* : LConstraint -> Bool . eq rhsIsNormalized*(Rhs:LConstraint) = downCtrSet(getTerm( metaReduce( removeVariantLabel( onlyEqsNoBuiltInUnify( clearNonExecEqs(checkXOR(eraseRls(PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS))))), upTerm(Rhs:LConstraint) ) )) == Rhs:LConstraint . **** 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] . **** 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' T'' : Term . vars TL TL' TL1 TL2 : TermList . var TP : Type . vars S S' S1 S2 : Substitution . var RS RS' : ResultTripleSet . var VTS : VariantFourSet . var M : Module . var RGNS : ResultGrammarNarrowingSet . op oneStepGNarrow : Module GrammarRule GrammarList Grammar -> ResultGrammarNarrowingSet [memo] . eq oneStepGNarrow(M,G,GSS,Gk) = oneStepGNarrowResultOfProtocol( filterByEquationalReducibility(G, generateVariants(G, filterByEquationalReducibility(G, metaENarrow( putFrozen(1, 'grl_=>_.,('CtrSet 'LConstraint), wrapRules checkXOR(M) bySymbol '_inL ), upTerm(G) ) ))), G,GSS,Gk) . op generateVariants : GrammarRule ResultTripleSet -> ResultTripleSet . eq generateVariants(G,empty) = empty . eq generateVariants(G,{T,TP,S} | RS) = generateVariantsE(G,empty,{T,TP,S}) | generateVariants(G,RS) . op generateVariantsE : GrammarRule TermList ResultTriple -> ResultTripleSet . eq generateVariantsE(G,TL,{'grl_=>_.[T','_inL['_`,_[(empty).GroundTermList]]],TP,S}) = empty . eq generateVariantsE(G,TL,{'grl_=>_.[T','_inL['_`,_[T,TL']]],TP,S}) = generateVariantsE*(G,TL,TL',{'grl_=>_.[T','_inL[T]],TP,S}) | generateVariantsE(G,(TL,T),{'grl_=>_.[T','_inL['_`,_[TL]]],TP,S}) . eq generateVariantsE(G,TL,{'grl_=>_.[T','_inL[T]],TP,S}) = generateVariantsE*(G,TL,empty,{'grl_=>_.[T','_inL[T]],TP,S}) . op generateVariantsE* : GrammarRule TermList TermList ResultTriple -> ResultTripleSet . eq generateVariantsE*(G,TL,TL',{'grl_=>_.[T',T],TP,S}) = generateVariantsE**(S,TL,TL','grl_=>_.[T',T], getVariantsOrConstructorVariants( clearAllFrozen(removeBoolEqs( checkXOR(PROTOCOL-EXAMPLE-RULES-WITH-CONSTRAINT-SYMBOLS))), T, max(highestVar(T),highestVar(T'),highestVar(S)) + 1, BuiltInUnify irreducible minimal-unifiers, (upTerm(G) << S,extract-bindings(S),TL,TL') )) . op generateVariantsE** : Substitution TermList TermList Term VariantFourSet -> ResultTripleSet . eq generateVariantsE**(S,TL,TL','grl_=>_.[T',T],empty) = empty . eq generateVariantsE**(S,TL,TL','grl_=>_.[T',T],{'_inL[T''],S1,S2,N:Nat} | VTS) = if TL =/= empty or TL' =/= empty then {'grl_=>_.[T','_inL['_`,_[TL << S1,T'',TL' << S1]]],'GrammarRule,S .. S1} else {'grl_=>_.[T','_inL[T'']],'GrammarRule,S .. S1} fi | generateVariantsE**(S,TL,TL','grl_=>_.[T',T],VTS) . *** 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$ removeVariantLabel(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 : GrammarRule ResultTripleSet -> ResultTripleSet . eq filterByEquationalReducibility(G,RS) = filterByEquationalReducibility*(G,empty,RS) . op filterByEquationalReducibility* : GrammarRule ResultTripleSet ResultTripleSet -> ResultTripleSet . eq filterByEquationalReducibility*(G,RS',empty) = RS' . eq filterByEquationalReducibility*(G,RS',{T,TP,S} | RS) = filterByEquationalReducibility*(G, RS' | filterByEquationalReducibilityE(G,{T,TP,S}), RS) . op filterByEquationalReducibilityE : GrammarRule ResultTriple -> ResultTripleSet [memo] . ceq filterByEquationalReducibilityE(G,{T,TP,S}) = if isNF$(M,T) and isNF$(M,S) and isNF$(M,upTerm(G) << S) then {T,TP,S} else empty fi if M := clearNonExecRls(clearAllFrozen(eqsNoBuiltInUnify2rls(checkXOR(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 . protecting CHECKXOR . 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 and nonEmpty(Gk) =/= empty) /\ 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, normalize(removeVariantLabel(clearNonExecEqs( checkXOR(upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true)))), (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, normalize(removeVariantLabel(clearNonExecEqs( checkXOR(upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true)))), upTerm(M)) <<(upTerm(MS),upTerm(MS'))<]), empty} if upTerm(M') :: Variable /\ dom S inVars upTerm(M') /\ not (upTerm(M) :: Variable) /\ Vars(upTerm(M)) == empty or-else Vars(upTerm(MS)) intersect Vars(upTerm(M)) =/= empty or-else Vars(rangeVars(S)) intersect Vars(upTerm(M)) =/= empty . ceq heuristic2A(grl (M' inL) => M1:Msg inL ., S, grl (M inL) => MS inL .) = {downCtrSet('_notLeq_[upTerm(M1:Msg), normalize(removeVariantLabel(clearNonExecEqs(checkXOR(upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true)))), (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), normalize(removeVariantLabel(clearNonExecEqs(checkXOR(upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true)))), (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-MNPA . 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 typeLeq(upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true), leastSort(upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),upTerm(M')), leastSort(upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),upTerm(MV)) ) /\ --- 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 typeLeq(upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true), leastSort(upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),upTerm(M')), leastSort(upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true),upTerm(MV)) ) /\ --- 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( metaSearchCollect( ---before was 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-MNPA . protecting MEMBERSHIP-GRAMMAR-LANGUAGE . pr DEFINITION-PROTOCOL-RULES-HANDLING . pr RENAMING . var CS CS' : CtrSet . vars M 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 removeRules : Grammar -> Grammar . eq removeRules(G:Grammar) = removeRules3(removeRules2(removeRules1(G:Grammar))) . op removeRules1 : Grammar -> Grammar . eq removeRules1(G:Grammar) = removeRules2x(G:Grammar,empty) . op removeRules1x : Grammar Grammar -> Grammar . eq removeRules1x(empty,R:Grammar) = R:Grammar . eq removeRules1x((grl CS => M inL .) ; G:Grammar,R:Grammar) = removeRules1xx(CS,(grl CS => M inL .), G:Grammar,R:Grammar) . op removeRules1xx : CtrSet GrammarRule Grammar Grammar -> Grammar . eq removeRules1xx(((M notLeq M'),CS),(grl ((M notLeq M'),CS') => M'' inL .),G:Grammar,R:Grammar) = if metaBuiltInMatch( upModule('PROTOCOL-EXAMPLE-SYMBOLS-WITH-CONSTRAINT-SYMBOLS,true), upTerm(M), upTerm(M') <<(upTerm(M))<) =/= empty then errorInconsistentExceptionsInGrammarRule (grl ((M notLeq M'),CS') => M'' inL .) inGrammar ((grl ((M notLeq M'),CS') => M'' inL .) ; G:Grammar ; R:Grammar) else removeRules1xx(CS,(grl ((M notLeq M'),CS') => M'' inL .),G:Grammar,R:Grammar) fi . eq removeRules1xx(CS,(grl CS' => M'' inL .),G:Grammar,R:Grammar) = removeRules1x(G:Grammar,(grl CS' => M'' inL .) ; R:Grammar) [owise] . op removeRules2 : Grammar -> Grammar . eq removeRules2(G:Grammar) = removeRules1x(G:Grammar,empty) . op removeRules2x : Grammar Grammar -> Grammar . eq removeRules2x(empty,R:Grammar) = R:Grammar . eq removeRules2x((grl CS => M inL .) ; G:Grammar,R:Grammar) = if {G:Grammar ; R:Grammar,CS} |- M inL then removeRules2x(G:Grammar,R:Grammar) else removeRules2x(G:Grammar,(grl CS => M inL .) ; R:Grammar) fi . op removeRules3 : Grammar -> Grammar . eq removeRules3(G:Grammar) = if nonRecursive(G:Grammar) then G:Grammar else empty fi . **** 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 --- C:Constraint is subsumed by other constraint so discard it then maximal<=Ite( CS:CtrSet, CS':CtrSet ) else (C:Constraint, maximal<=Ite( CS:CtrSet, (C:Constraint,CS':CtrSet))) fi . op maximal<=IteOne : Constraint CtrSet -> CtrSet . ceq maximal<=IteOne( C:Constraint, (C':Constraint,CS:CtrSet) ) = empty --- C:Constraint is a variable with instances in the set of constraints, so remove it if M1:Msg notLeq M2:Msg := C:Constraint /\ M1:Msg notLeq M3:Msg := C':Constraint /\ upTerm(M1:Msg) :: Variable /\ upTerm(M2:Msg) :: Variable /\ not upTerm(M3:Msg) :: Variable /\ C:Constraint <=[Vars(upTerm(C:Constraint))] C':Constraint . eq maximal<=IteOne( C:Constraint, CS:CtrSet ) = maximal<=IteOne*( C:Constraint, CS:CtrSet ) [owise] . 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 --- C:Constraint is subsumed by other constraint 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 . 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:Grammar ==[M:Module]== G':Grammar = G:Grammar ==[[M:Module]]== G':Grammar [owise] . op _==[[_]]==_ : Grammar Module Grammar -> Bool . eq empty ==[[M:Module]]== empty = true . ceq G:GrammarRule ; G:Grammar ==[[M:Module]]== G':GrammarRule ; G':Grammar = G:Grammar ==[[M:Module]]== G':Grammar if G:GrammarRule ===[M:Module]=== G':GrammarRule . eq G:Grammar ==[[M:Module]]== G':Grammar = false [owise] . op _===[_]===_ : GrammarRule Module GrammarRule -> Bool [memo] . eq G:GrammarRule ===[M:Module]=== G':GrammarRule = G:GrammarRule == G':GrammarRule or-else upTerm(G:GrammarRule) =[M:Module]= upTerm(G':GrammarRule) <<(upTerm(G:GrammarRule))< . endfm fmod NEW-NEVER-PATTERNS-HANDLING is protecting MEMBERSHIP-GRAMMAR-LANGUAGE . protecting META-E-NARROWING . protecting DEFINITION-PROTOCOL-RULES-HANDLING . protecting META-LEVEL-MNPA . 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 [memo] . 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-MNPA . protecting GENERATE-RULES . protecting PROTOCOL-EXAMPLE-GHOST . protecting NEW-NEVER-PATTERNS-HANDLING . protecting NORMALIZE-MNPA . 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' TS CtTS : Term . var V : Variable . var VL : TermList . vars TP TP' : Type . vars Subst Subst' Subst* : Substitution . var SSubst : SubstitutionSet . var Ct CtS : Context . var CS : CtrSet . vars RS RS' RS'' : ResultContextSet . var RC RC' : ResultContext . var SS : SystemSet . var GS : GrammarList . var M : Module . var Nodes : Bound . op unificationQid : -> Qid . --- Defined later in GENERIC-TOOLS op nextBackNarrow : Module GrammarList Filters Bound IdSystemSet IdSystemSet -> IdSystemSet [memo] . eq nextBackNarrow(M,GS,F:Filters,Nodes,HistoryIST,IST) = simplify-theSystemSet(F:Filters,HistoryIST, filter-eachSystem#Top(F:Filters,M,GS, simplify-eachSystem#Top(F:Filters,M, --- always simplify before filtering simplifyGhost#Top(F:Filters, createGhost#Top(M,F:Filters, reactivateGhost#Top(F:Filters, tryUnificationofKnowledge(M, --- create and check ghosts before and after nextBackNarrow*(M,GS,F:Filters,Nodes,empty,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 : Filter Module IdSystemSet -> IdSystemSet . eq simplify-eachSystem#Top(F:Filters,M,IST) = simplify-eachSystem(F:Filters,M,IST) . op simplifyGhost#Top : Filters IdSystemSet -> IdSystemSet . eq simplifyGhost#Top(F:Filters,IST) = simplifyGhost(F:Filters,IST) . op createGhost#Top : Module Filters IdSystemSet -> IdSystemSet . eq createGhost#Top(M,F:Filters,IST) = createGhost(M,F:Filters,IST) . op reactivateGhost#Top : Filters IdSystemSet -> IdSystemSet . eq reactivateGhost#Top(F:Filters,IST:IdSystemSet) = reactivateGhost(F:Filters,IST:IdSystemSet) . op nextBackNarrow* : Module GrammarList Filters Bound IdSystemSet IdSystemSet -> IdSystemSet . eq nextBackNarrow*(M,GS,F:Filters,Nodes,IST',IST) = if Nodes == unbounded or-else Nodes > 0 then nextBackNarrow**(M,GS,F:Filters,Nodes,IST',IST) else IST' fi . op nextBackNarrow** : Module GrammarList Filters Bound IdSystemSet IdSystemSet -> IdSystemSet . eq nextBackNarrow**(M,GS,F:Filters,Nodes,IST',empty) = IST' . eq nextBackNarrow**(M,GS,F:Filters,Nodes,IST',(IS IST)) = nextBackNarrow*(M,GS,F:Filters, if Nodes == unbounded then unbounded else dec(Nodes) fi, (IST' nextBackNarrow*OneSt(M,GS,F:Filters,IS)), IST) . op nextBackNarrow*OneSt : Module GrammarList Filters IdSystem -> IdSystemSet [memo] . 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(F:Filters,M, --- always simplify before filtering simplifyGhost#OneSt(F:Filters, createGhost#OneSt(M,F:Filters, reactivateGhost#OneSt(F:Filters, --- addIrr or nextBackNarrow*Fix are executed depending on using variant or built-in unification nextBackNarrow*Fix(M,GS,F:Filters, --- always before optimizations & before createGhost addIrr(M, move*Input(F:Filters, nextBackNarrow*SimpleSet(M,GS,F:Filters,IS) ) ) ) ) ) ) ) ) ) . op simplifyGhost#OneSt : Filters IdSystemSet -> IdSystemSet . eq simplifyGhost#OneSt(F:Filters,IST) = simplifyGhost(F:Filters,IST) . op createGhost#OneSt : Module Filters IdSystemSet -> IdSystemSet . eq createGhost#OneSt(M,F:Filters,IST) = createGhost(M,F:Filters,IST) . op reactivateGhost#OneSt : Filters IdSystemSet -> IdSystemSet . eq reactivateGhost#OneSt(F:Filters,IST:IdSystemSet) = reactivateGhost(F:Filters,IST:IdSystemSet) . 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 filter-eachSystem#OneSt-noirr : Filters Module GrammarList IdSystemSet -> IdSystemSet . eq filter-eachSystem#OneSt-noirr(F:Filters,M,GS,IST) = filter-eachSystem-noirr(F:Filters,M,GS,IST) . op simplify-eachSystem#OneSt : Filters Module IdSystemSet -> IdSystemSet . eq simplify-eachSystem#OneSt(F:Filters,M,IST) = simplify-eachSystem(F:Filters,M,IST) . op simplify-eachSystem#OneSt-noirr : Filters Module IdSystemSet -> IdSystemSet . eq simplify-eachSystem#OneSt-noirr(F:Filters,M,IST) = simplify-eachSystem-noirr(F:Filters,M,IST) . op nextBackNarrow*Fix : Module GrammarList Filters IdSystemSet -> IdSystemSet . eq nextBackNarrow*Fix(M,GS,F:Filters,IST) = if IsMetaHEUnify(M) or IsMetaXORUnify(M) then nextBackNarrow*Fix#(M,GS,F:Filters,empty,IST) else IST fi . op nextBackNarrow*Fix# : Module GrammarList Filters IdSystemSet IdSystemSet -> IdSystemSet . eq nextBackNarrow*Fix#(M,GS,F:Filters,IST',empty) = IST' . eq nextBackNarrow*Fix#(M,GS,F:Filters,IST',(IS IST)) = nextBackNarrow*Fix#(M,GS,F:Filters,IST' nextBackNarrow*FixE(M,GS,F:Filters,IS), IST) . op nextBackNarrow*FixE : Module GrammarList Filters IdSystem -> IdSystemSet . eq nextBackNarrow*FixE(M,GS,F:Filters,IS) = setIdVariants(getId(IS), fixIrrSystemNext(F:Filters, remId(IS) ) ) . op fixIrrSystemNext : Filters System -> SystemSet . eq fixIrrSystemNext(F:Filters,S:System) = if -variantDiff !in F:Filters then fixIrrSystemInI!=(S:System) else fixIrrSystemInI(S:System) fi . op addIrr : Module IdSystemSet -> IdSystemSet . eq addIrr(M,IST) = if IsMetaHEUnify(M) or IsMetaXORUnify(M) then IST else addIrr$(empty,IST) fi . op addIrr$ : IdSystemSet IdSystemSet -> IdSystemSet . eq addIrr$(IST',empty) = IST' . eq addIrr$(IST',(IS IST)) = addIrr$((IST' addIrrE(IS)),IST) . op addIrrE : IdSystem -> IdSystem . eq addIrrE( < I:Id > SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || GL:GhostList || PP:Properties ) = < I:Id > addIrr**(toMsgSet(addIrr#(ML:SMsgList)), SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || GL:GhostList || PP:Properties ) . op addIrr# : SMsgList -> SMsgList . --- All output messages and all input before last output eq addIrr#(nil) = nil . eq addIrr#((+(X:Msg),L:SMsgList)) = addIrr##((+(X:Msg),L:SMsgList)) . eq addIrr#((-(X:Msg),L:SMsgList)) = addIrr#(L:SMsgList) . eq addIrr#((X:SMsgElem,L:SMsgList)) = addIrr#(L:SMsgList) [owise] . op addIrr## : SMsgList -> SMsgList . eq addIrr##(nil) = nil . eq addIrr##((+(X:Msg),L:SMsgList)) = +(X:Msg),addIrr##(L:SMsgList) . eq addIrr##((-(X:Msg),L:SMsgList)) = -(X:Msg),addIrr##(L:SMsgList) . eq addIrr##((X:SMsgElem,L:SMsgList)) = addIrr##(L:SMsgList) [owise] . op addIrr** : MsgSet System -> System . eq addIrr**(emptyMsgSet,X:System) = X:System . eq addIrr**((M:Msg,MS:MsgSet), SS:StrandSet || K:IntruderKnowledge || M:SMsgList || G:GhostList || PP:Properties) = if not irr(M:Msg) in K:IntruderKnowledge then addIrr**(MS:MsgSet, addIrr***(M:Msg, SS:StrandSet || K:IntruderKnowledge || M:SMsgList || G:GhostList || PP:Properties )) else addIrr**(MS:MsgSet, SS:StrandSet || K:IntruderKnowledge || M:SMsgList || G:GhostList || PP:Properties ) fi . op addIrr*** : Msg System -> System . ceq addIrr***(M':Msg, SS:StrandSet || M:Msg inI,K:IntruderKnowledge || M1:SMsgList,-(M':Msg),M2:SMsgList || G:GhostList || PP:Properties) = addIrr***(M':Msg, SS:StrandSet || M:Msg inI,irr(M:Msg),K:IntruderKnowledge || M1:SMsgList,-(M:Msg),M2:SMsgList || G:GhostList || PP:Properties ) if M:Msg =/= M':Msg and-then M:Msg !in G:GhostList and-then M':Msg !in G:GhostList and-then not generatedByIntruder(M':Msg) in M1:SMsgList,M2:SMsgList and-then not generatedByIntruder(M:Msg) in M1:SMsgList,M2:SMsgList /\ M:Msg := downMsgSet(getTerm( metaReduce( removeVariantLabel(clearNonExecEqs(eraseRls(onlyEqsNoBuiltInUnify(flipRls(STRAND-EXAMPLE-RULES))))), upTerm(M':Msg) ))) . ceq addIrr***(M:Msg, SS:StrandSet || K:IntruderKnowledge || M1:SMsgList,+(M:Msg),M2:SMsgList,-(M':Msg),M3:SMsgList || G:GhostList || PP:Properties) = addIrr***(M:Msg, SS:StrandSet || irr(M:Msg),K:IntruderKnowledge || M1:SMsgList,+(M:Msg),M2:SMsgList,-(M:Msg),M3:SMsgList || G:GhostList || PP:Properties ) if M:Msg =/= M':Msg and-then M:Msg !in G:GhostList and-then M':Msg !in G:GhostList and-then not generatedByIntruder(M':Msg) in M1:SMsgList,M2:SMsgList,M3:SMsgList and-then not generatedByIntruder(M:Msg) in M1:SMsgList,M2:SMsgList,M3:SMsgList /\ M:Msg := downMsgSet(getTerm( metaReduce( removeVariantLabel(clearNonExecEqs(eraseRls(onlyEqsNoBuiltInUnify(flipRls(STRAND-EXAMPLE-RULES))))), upTerm(M':Msg) ))) . eq addIrr***(M:Msg,X:System) = addIrr****(M:Msg,X:System) [owise] . op addIrr**** : Msg System -> System . ceq addIrr****(M:Msg, SS:StrandSet || K:IntruderKnowledge || M:SMsgList || G:GhostList || PP:Properties) = SS:StrandSet || irr(M:Msg),K:IntruderKnowledge || M:SMsgList || G:GhostList || PP:Properties if not generatedByIntruder(M:Msg) in M:SMsgList and-then M:Msg !in G:GhostList /\ M:Msg := downMsgSet(getTerm( metaReduce( removeVariantLabel(clearNonExecEqs(eraseRls(onlyEqsNoBuiltInUnify(flipRls(STRAND-EXAMPLE-RULES))))), upTerm(M:Msg) ))) . eq addIrr****(M:Msg,X:System) = X:System [owise] . 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) = if synchronize?(M,IS) then nextBackNarrow*Synchronize(M,GS,F:Filters,IS) else nextBackNarrow*Simple*(M,GS,F:Filters,IS) fi . op synchronize? : Module IdSystem -> Bool . eq synchronize?(M, < I:Id > :: RL:FreshSet :: [ nil, S:Synchro | L':SMsgList-R ] & SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || GL:GhostList || PP:Properties ) = true . eq synchronize?(M,X:IdSystem) = false [owise] . op nextBackNarrow*Synchronize : Module GrammarList Filters IdSystem -> IdSystemSet . eq nextBackNarrow*Synchronize(M,GS,F:Filters,IS) = setId+(getId(IS) . 1, composeFinalState( filter-ResultContextSet(F:Filters,M,IS, oneStepReachability(flipRls(COMPOSITION-RULES), remId(IS) ) ) ) ) . op nextBackNarrow*Simple* : Module GrammarList Filters IdSystem -> IdSystemSet . eq nextBackNarrow*Simple*(M,GS,F:Filters,IS) = setId+(getId(IS) . 1, composeFinalState( filter-ResultContextSet(F:Filters,M,IS, oneStepReachability(M, remId(IS) ) ) ) ) . op move*Input : Filters IdSystemSet -> IdSystemSet . eq move*Input(F:Filters,SS:IdSystemSet) = if -inputAndNotLearned !in F:Filters then move*Input$(empty,SS:IdSystemSet) else SS:IdSystemSet fi . op move*Input$ : IdSystemSet IdSystemSet -> IdSystemSet . eq move*Input$(SS':IdSystemSet,empty) = SS':IdSystemSet . eq move*Input$(SS':IdSystemSet,S:IdSystem SS:IdSystemSet) = move*Input$( SS':IdSystemSet move*InputAll(S:IdSystem), SS:IdSystemSet ) . op move*InputAll : IdSystem -> IdSystem [memo] . ceq move*InputAll( < I:Id > :: RL:FreshSet :: [ L:SMsgList-L, -(M:Msg) | L':SMsgList-R ] & SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || GL:GhostList || PP:Properties ) = move*InputAll( < I:Id > :: RL:FreshSet :: [ L:SMsgList-L | -(MN:Msg), L':SMsgList-R ] & SS:StrandSet || if MN:Msg :: Public or MN:Msg inI in K:IntruderKnowledge then K:IntruderKnowledge else (MN:Msg inI, K:IntruderKnowledge) fi || (-(MN:Msg), ML:SMsgList) || GL:GhostList || PP:Properties ) if MN:Msg := downMsgSet(normalize(upTerm(M:Msg))) . eq move*InputAll( < I:Id > :: RL:FreshSet :: [ L:SMsgList-L, (M:Msg eq M:Msg) | L':SMsgList-R ] & SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || GL:GhostList || PP:Properties ) = move*InputAll( < I:Id > :: RL:FreshSet :: [ L:SMsgList-L | (M:Msg eq M:Msg), L':SMsgList-R ] & SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || GL:GhostList || PP:Properties ) . ceq move*InputAll( < I:Id > :: RL:FreshSet :: [ L:SMsgList-L, (M1:Msg neq M2:Msg) | L':SMsgList-R ] & SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || GL:GhostList || PP:Properties ) = move*InputAll( < I:Id > :: RL:FreshSet :: [ L:SMsgList-L | (MN1:Msg neq MN2:Msg), L':SMsgList-R ] & SS:StrandSet || K:IntruderKnowledge, MN1:Msg != MN2:Msg || ML:SMsgList || GL:GhostList || PP:Properties ) if MN1:Msg := downMsgSet(normalize(upTerm(M1:Msg))) /\ MN2:Msg := downMsgSet(normalize(upTerm(M2:Msg))) . eq move*InputAll(S:IdSystem) = S:IdSystem [owise] . op oneStepReachability : Module SystemSet -> ResultContextSet . eq oneStepReachability(M,SS:SystemSet) = oneStepReachability*(M,empty,SS:SystemSet) . op oneStepReachability* : Module ResultContextSet SystemSet -> ResultContextSet . 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 -> ResultContextSet . 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), only-CPSA(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 -> ResultContextSet . eq oneStepReachability***(M, K:IntruderKnowledge, S:Term, NextVar:Nat) = if IsMetaHEUnify(M) or IsMetaXORUnify(M) then oneStepReachability***N(M, K:IntruderKnowledge, S:Term, NextVar:Nat) else oneStepReachability***B(M, K:IntruderKnowledge, S:Term, NextVar:Nat) fi . --- Call previous narrowing infrastructure in Full Maude op oneStepReachability***N : Module IntruderKnowledge Term Nat -> ResultContextSet . eq oneStepReachability***N(M, K:IntruderKnowledge, S:Term, NextVar:Nat) = ---unrigidLabel( metaEBuiltInTopMostNarrowRCIrr(M, S:Term, ---rigidLabel(M,S:Term,Vars(upTerm(K:IntruderKnowledge))), getIrrTerms(K:IntruderKnowledge), NextVar:Nat --- ) ) . --- Call narrowing infrastructure in Maude op oneStepReachability***B : Module IntruderKnowledge Term Nat -> ResultContextSet . eq oneStepReachability***B(M, K:IntruderKnowledge, S:Term, NextVar:Nat) = metaNarrowingApplyCollect( putNarrowing(changeNonSupportedAttr(M)), S:Term, getIrrTerms(K:IntruderKnowledge), '#) . op reconstruct : Module StrandSet IntruderKnowledge SMsgList GhostList Properties ResultContextSet ResultContextSet -> ResultContextSet . 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,Subst*,Ct,CtS,TS,CtTS,NextVar:Nat,Tr:TraceNarrow,B:Flags} | RS) = reconstruct(M,SS:StrandSet, K:IntruderKnowledge,ML:SMsgList, GL:GhostList,PP:Properties, RS' | {T,TP,Subst,Subst*,Ct,CtS,TS, reconstruct*(M,SS:StrandSet, K:IntruderKnowledge,ML:SMsgList, GL:GhostList,PP:Properties, Subst,CtTS), NextVar:Nat,Tr:TraceNarrow,B:Flags}, 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 : ResultContextSet -> SystemSet . eq composeFinalState(RS) = composeFinalState*(empty,RS) . op composeFinalState* : SystemSet ResultContextSet -> SystemSet . eq composeFinalState*(SS,empty) = SS . eq composeFinalState*(SS,{T,TP,Subst,Subst*,Ct,CtS,TS,CtTS,NextVar:Nat,Tr:TraceNarrow,B:Flags} | RS) = composeFinalState*( downSystemSet(simplifyVars( upTerm( addInst(rangeVars(Subst),downSystemSet(CtTS)) ))) 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 [memo] . 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$ML( reactivateGhost$G(SS:StrandSet, < I:Id > (SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || GL:GhostList || PP:Properties), GL:GhostList ) ) . op reactivateGhost$ML : IdSystemSet -> IdSystemSet . ceq reactivateGhost$ML( < I:Id > (SS:StrandSet || (X:Msg !inI,K:IntruderKnowledge) || ML1:SMsgList,generatedByIntruder(X:Msg),ML2:SMsgList || GL:GhostList || PP:Properties) ) = reactivateGhost$ML( reactivateFrozenGhost(X:Msg,SS:StrandSet, < I:Id > SS:StrandSet || K:IntruderKnowledge || ML1:SMsgList,ML2:SMsgList || ghost(X:Msg,SS:StrandSet,K:IntruderKnowledge,ML2:SMsgList,PP:Properties) || PP:Properties ) ) if not testisGhostMsg(X:Msg) . eq reactivateGhost$ML(X:IdSystemSet) = X:IdSystemSet [owise] . 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 if isAnyVarInstantiable(Vars(upTerm(M2:Msg)),K1:IntruderKnowledge) or-else isAnyVarInstantiable(Vars(upTerm(M2:Msg)),SS1:StrandSet) 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 *** Should be reactivated but impossible to find ghost expression empty fi 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 . ceq 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 if SSOrig:StrandSet =/= SS2:StrandSet . ceq reactivateFrozenGhost(M2:Msg,SSOrig:StrandSet, --- Ghost term instantiated by unification of knowledge < 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 > SS2:StrandSet || M2:Msg inI,K2:IntruderKnowledge || ML2:SMsgList || (G:GhostList, G':GhostList) || PP:Properties if SSOrig:StrandSet == SS2:StrandSet . *** testisGhostMsg ******************************************** op testisGhostMsg : Msg -> Bool [memo] . eq testisGhostMsg(M:Msg) = not anyFreshVar(Vars(upTerm(M:Msg))) and-then 'true.Bool == getTerm( metaReduce( removeVariantLabel(PROTOCOL-EXAMPLE-GHOST), 'isGhostMsg[upTerm(M:Msg)] ) ) . **************************************************************** op makeGhostInI : System -> System . eq makeGhostInI( SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || G:GhostList || PP:Properties ) = SS:StrandSet || (K:IntruderKnowledge,makeInI(ghostTerms(G:GhostList))) || ML:SMsgList || nil || PP:Properties . *** 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)) . *** 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 tryUnificationofKnowledgeE***Unify(M,X:Msg,Y:Msg,upTerm(only-irr(K:IntruderKnowledge))) == 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, tryUnificationofKnowledgeE***Unify(M,X:Msg,Y:Msg,upTerm(only-irr(K:IntruderKnowledge))) |> (upTerm(X:Msg),upTerm(Y:Msg)), empty ), ST, X:Msg, Y:Msg, K*:IntruderKnowledge, K$:IntruderKnowledge) fi . op tryUnificationofKnowledgeE***Unify : Module Msg Msg TermList -> SubstitutionSet [memo] . eq tryUnificationofKnowledgeE***Unify(M,X:Msg,Y:Msg,TL:TermList) = fresh[metaEBuiltInUnify(M,upTerm(X:Msg),upTerm(Y:Msg),TL:TermList)] . *** 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 -variantsBefore -variantsAfter +variantsAfter -simplifyDiff -inconsistencyDiff -variantDiff -removeDiff -addDiffConstraints +debug minOpt time noopt : -> Filter . op filterId : Id -> Filters . op filterSMsgList : SMsgList -> Filters . eq (minOpt).Filter = -implication -variantsAfter -addDiffConstraints -simplifyDiff -partialOrder -grammars . eq (time).Filter = -partialOrder -simplifyDiff . eq (noopt).Filters --- not include -variantsBefore +variantsAfter = -grammars -inconsistency -alreadySent -secretData -equationalRed -freshInstantiated -implication -partialOrder -ghost -before -never . op no+debug : Filters -> Filters . eq no+debug(+debug F:Filters) = F:Filters . eq no+debug(F:Filters) = F:Filters [owise] . 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-ResultContextSet : Filters Module IdSystem ResultContextSet -> ResultContextSet . eq filter-ResultContextSet(F:Filters,M,IS,RS) = filter-RC-Fresh(F:Filters,M,IS,RS) . ******* op filter-RC-Fresh : Filters Module IdSystem ResultContextSet -> ResultContextSet . eq filter-RC-Fresh(F:Filters,M,IS,RS) = if -freshInstantiated !in F:Filters then filter-RC-Fresh*(F:Filters,M,IS,empty,RS) else RS fi . op filter-RC-Fresh* : Filters Module IdSystem ResultContextSet ResultContextSet -> ResultContextSet . eq filter-RC-Fresh*(F:Filters,M,IS,RS',empty) = RS' . eq filter-RC-Fresh*(F:Filters,M,IS,RS', {T,TP,Subst,Subst*,Ct,CtS,TS,CtTS,NextVar:Nat,Tr:TraceNarrow,B:Flags} | RS) = filter-RC-Fresh*(F:Filters,M,IS, RS' | if testFreshInstantiated(Subst) ---or-else ---testFreshInstantiated(Subst*,highestVar(upTerm(IS))) ---or-else ---testFreshInstantiated(Tr:TraceNarrow,highestVar(upTerm(IS))) then empty else {T,TP,Subst,Subst*,Ct,CtS,TS,CtTS,NextVar:Nat,Tr:TraceNarrow,B:Flags} fi, RS) . *** filters ******************************************************* op filter-eachSystem : Filters Module GrammarList IdSystemSet -> IdSystemSet . eq filter-eachSystem(F:Filters,M,GS,IST) = filter-eachSystem-irr(F:Filters,M,GS,filter-eachSystem-noirr(F:Filters,M,GS,IST)) . op filter-eachSystem-irr : Filters Module GrammarList IdSystemSet -> IdSystemSet . eq filter-eachSystem-irr(F:Filters,M,GS,IST) = filter-eachSystem*-irr(F:Filters,M,GS,empty,IST) . op filter-eachSystem-noirr : Filters Module GrammarList IdSystemSet -> IdSystemSet . eq filter-eachSystem-noirr(F:Filters,M,GS,IST) = filter-eachSystem*-noirr(F:Filters,M,GS,empty,IST) . op filter-eachSystem*-irr : Filters Module GrammarList IdSystemSet IdSystemSet -> IdSystemSet . eq filter-eachSystem*-irr(F:Filters,M,GS,IST',empty) = IST' . eq filter-eachSystem*-irr(F:Filters,M,GS,IST',IS IST) = filter-eachSystem*-irr(F:Filters,M,GS, IST' filter-eachSystemE-irr(F:Filters,M,GS,IS), IST) . op filter-eachSystem*-noirr : Filters Module GrammarList IdSystemSet IdSystemSet -> IdSystemSet . eq filter-eachSystem*-noirr(F:Filters,M,GS,IST',empty) = IST' . eq filter-eachSystem*-noirr(F:Filters,M,GS,IST',IS IST) = filter-eachSystem*-noirr(F:Filters,M,GS, IST' filter-eachSystemE-noirr(F:Filters,M,GS,IS), IST) . op filter-eachSystemE-irr : Filters Module GrammarList IdSystem -> IdSystemSet . eq filter-eachSystemE-irr(F:Filters,M,GS,IS) = if filter-eachSystemE*-irr(F:Filters,M,GS,filterTimeMsg(IS)) then empty else IS fi . op filter-eachSystemE-noirr : Filters Module GrammarList IdSystem -> IdSystemSet . eq filter-eachSystemE-noirr(F:Filters,M,GS,IS) = if filter-eachSystemE*-noirr(F:Filters,M,GS,filterTimeMsg(IS)) then empty else IS fi . op filter-eachSystemE*-noirr : Filters Module GrammarList IdSystem -> Bool . eq filter-eachSystemE*-noirr(F:Filters,M,GS,IS) = (-secretData !in F:Filters and-then testBadSecretData(makeGhostInI(remId(IS)))) or-else (-before !in F:Filters and-then testBadBeforeRelation(makeGhostInI(remId(IS)))) or-else (-alreadySent !in F:Filters and-then testAlreadySent(makeGhostInI(remId(IS)))) or-else (-inconsistency !in F:Filters and-then testInconsistency(F:Filters,makeGhostInI(remId(IS)))) or-else (-never !in F:Filters and-then testNewNeverFound(IS)) . op filter-eachSystemE*-irr : Filters Module GrammarList IdSystem -> Bool . eq filter-eachSystemE*-irr(F:Filters,M,GS,IS) = (-grammars !in F:Filters and-then testByGrammars(GS,IS)) or-else (-equationalRed !in F:Filters and-then testByEquationalReducibility(M,makeGhostInI(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 : Filters Module IdSystemSet -> IdSystemSet . eq simplify-eachSystem(F:Filters,M,IST) = simplify-eachSystem-irr(F:Filters,M, simplify-eachSystem-noirr(F:Filters,M, IST)) . op simplify-eachSystem-noirr : Filters Module IdSystemSet -> IdSystemSet . eq simplify-eachSystem-noirr(F:Filters,M,IST) = simplify-eachSystem-noirr*(F:Filters,checkXOR(M),empty,IST) . op simplify-eachSystem-noirr* : Filters Module IdSystemSet IdSystemSet -> IdSystemSet . eq simplify-eachSystem-noirr*(F:Filters,M,IST',empty) = IST' . eq simplify-eachSystem-noirr*(F:Filters,M,IST',IS IST) = simplify-eachSystem-noirr*(F:Filters,M, (IST' simplify-eachSystemE-noirr(F:Filters,M,IS)),IST) . op simplify-eachSystemE-noirr : Filters Module IdSystem -> IdSystem . eq simplify-eachSystemE-noirr(F:Filters,M,IS) = simplifyNotInIConstraints( simplifyInIConstraints( simplifyIrrConstraints( simplifyInstConstraints( simplifyEquationalReducibility(M, IS ) ) ) ) ) . op simplify-eachSystem-irr : Filters Module IdSystemSet -> IdSystemSet . eq simplify-eachSystem-irr(F:Filters,M,IST) = simplify-eachSystem-irr*(F:Filters,checkXOR(M),empty,IST) . op simplify-eachSystem-irr* : Filters Module IdSystemSet IdSystemSet -> IdSystemSet . eq simplify-eachSystem-irr*(F:Filters,M,IST',empty) = IST' . eq simplify-eachSystem-irr*(F:Filters,M,IST',IS IST) = simplify-eachSystem-irr*(F:Filters,M, (IST' simplify-eachSystemE-irr(F:Filters,M,IS)),IST) . op simplify-eachSystemE-irr : Filters Module IdSystem -> IdSystem . eq simplify-eachSystemE-irr(F:Filters,M,IS) = simplifyDiffConstraints(F:Filters, 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 || (M:Msg inI,K:IntruderKnowledge) || ML:SMsgList || (G1':GhostList, ghost(M:Msg,SS1':StrandSet,K1':IntruderKnowledge,ML1':SMsgList,PP1:Properties), G2':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) || PP:Properties ) . 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:IdSystem,G:GhostList) = simplifyGhostE*Fix( IS:IdSystem, simplifyGhostE**(IS:IdSystem,G:GhostList)) . 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 not testisGhostMsg(M:Msg) or-else isAnyVarInstantiable(Vars(upTerm(M:Msg)),K:IntruderKnowledge) or-else isAnyVarInstantiable(Vars(upTerm(M:Msg)),SS:StrandSet) or-else anyFreshVar(Vars(upTerm(M:Msg))) then K:IntruderKnowledge else (M:Msg !inI,K:IntruderKnowledge) fi || if not testisGhostMsg(M:Msg) or-else isAnyVarInstantiable(Vars(upTerm(M:Msg)),K:IntruderKnowledge) or-else isAnyVarInstantiable(Vars(upTerm(M:Msg)),SS:StrandSet) or-else anyFreshVar(Vars(upTerm(M:Msg))) then ML:SMsgList else (generatedByIntruder(M:Msg),ML:SMsgList) fi || if not testisGhostMsg(M:Msg) or-else isAnyVarInstantiable(Vars(upTerm(M:Msg)),K:IntruderKnowledge) or-else isAnyVarInstantiable(Vars(upTerm(M:Msg)),SS:StrandSet) or-else anyFreshVar(Vars(upTerm(M:Msg))) 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) . op simplifyGhostE*Fix : IdSystem IdSystem -> IdSystem . eq simplifyGhostE*Fix(Original:IdSystem,New:IdSystem) = if Original:IdSystem == New:IdSystem then New:IdSystem else simplifyGhostE*Fix(New:IdSystem,simplifyGhostE*Fix*(Original:IdSystem,New:IdSystem)) fi . op simplifyGhostE*Fix* : IdSystem IdSystem -> IdSystem . ceq simplifyGhostE*Fix*( < I:Id > (SS:StrandSet || K1:IntruderKnowledge || ML1:SMsgList || (G11:GhostList, ghost(M:Msg,SS':StrandSet,K':IntruderKnowledge,ML':SMsgList,PP':Properties), G12:GhostList) || PP:Properties), < I:Id > (SS:StrandSet || M:Msg !inI, K2:IntruderKnowledge || ML21:SMsgList,generatedByIntruder(M:Msg),ML22:SMsgList || (G21:GhostList, ghost(M':Msg,SS'':StrandSet,K'':IntruderKnowledge,ML'':SMsgList,PP'':Properties), G22:GhostList) || PP:Properties) ) = simplifyGhostE*Fix*( < I:Id > (SS:StrandSet || K1:IntruderKnowledge || ML1:SMsgList || (G11:GhostList, ghost(M:Msg,SS':StrandSet,K':IntruderKnowledge,ML':SMsgList,PP':Properties), G12:GhostList) || PP:Properties), < I:Id > (SS:StrandSet || K2:IntruderKnowledge || ML21:SMsgList,ML22:SMsgList || (G21:GhostList, ghost(M:Msg,SS':StrandSet,K':IntruderKnowledge,ML':SMsgList,PP':Properties), ghost(M':Msg,SS'':StrandSet,K'':IntruderKnowledge,ML'':SMsgList,PP'':Properties), G22:GhostList) || PP:Properties) ) if any Vars(upTerm(M:Msg)) in Vars(upTerm(M':Msg)) . eq simplifyGhostE*Fix*(Original:IdSystem,New:IdSystem) = New:IdSystem [owise] . *** 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) and-then not testisGhostMsg(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)) or-else (only-Output(toSMsgList(L:SMsgList-L)) =/= nil and isAnyVarInstantiable*ML(T:Term,only-Synchro(toSMsgList(L':SMsgList-R))) ) . op isAnyVarInstantiable*ML : Term SMsgList -> Bool . eq isAnyVarInstantiable*ML(T:Term,nil) = false . eq isAnyVarInstantiable*ML(T:Term,({X:RoleSet -> Y:RoleSet ;; Z:How ;; M:Msg},L:SMsgList)) = (is T:Term subTermOf upTerm(M:Msg) and-then not testisGhostMsg(M:Msg) ) or-else isAnyVarInstantiable*ML*Fresh(T:Term,M:Msg) or-else isAnyVarInstantiable*ML(T:Term,L:SMsgList) . eq isAnyVarInstantiable*ML(T:Term,(M':StrandConstraint,L:SMsgList)) = isAnyVarInstantiable*ML(T:Term,L:SMsgList) . eq isAnyVarInstantiable*ML(T:Term,(+(M':Msg),L:SMsgList)) = isAnyVarInstantiable*ML*Fresh(T:Term,M':Msg) or-else isAnyVarInstantiable*ML(T:Term,L:SMsgList) . eq isAnyVarInstantiable*ML(T:Term,(-(M':Msg),L:SMsgList)) = (is T:Term subTermOf upTerm(M':Msg) and-then not testisGhostMsg(M':Msg) ) or-else isAnyVarInstantiable*ML(T:Term,L:SMsgList) . op isAnyVarInstantiable*ML*Fresh : Term Msg -> Bool . eq isAnyVarInstantiable*ML*Fresh(V:Variable,M:Msg) = getType(V:Variable) == 'Fresh and is V:Variable subTermOf upTerm(M:Msg) . eq isAnyVarInstantiable*ML*Fresh(T:Term,M:Msg) = false [owise] . *** filters ******************************************************* op simplifyEquationalReducibility : Module IdSystem -> IdSystem . eq simplifyEquationalReducibility(M,IS) = setId(getId(IS), downSystemSet( getTerm( metaReduce( --- putStrat(0,'-`(_`),'Msg, --- putStrat(0,'_inI,'Msg, putStrat(0,'irr`(_`),'Msg, removeVariantLabel(clearNonExecEqs(eraseRls(onlyEqsNoBuiltInUnify(M)))) --- )) ), upTerm(remId(IS)) ) ) )) . *** filters ******************************************************* op simplifyNotInIConstraints : IdSystem -> IdSystem . eq simplifyNotInIConstraints( < I:Id > (SS:StrandSet || (X:Msg !inI,X:Msg !inI,K:IntruderKnowledge) || ML1:SMsgList,generatedByIntruder(X:Msg),ML2:SMsgList,generatedByIntruder(X:Msg),ML3:SMsgList || G:GhostList || PP:Properties) ) = simplifyNotInIConstraints( < I:Id > (SS:StrandSet || (X:Msg !inI,K:IntruderKnowledge) || ML1:SMsgList,generatedByIntruder(X:Msg),ML2:SMsgList,ML3:SMsgList || G:GhostList || PP:Properties) ) . eq simplifyNotInIConstraints( < I:Id > (SS:StrandSet || (X:Msg !inI,X:Msg inI,K:IntruderKnowledge) || ML1:SMsgList,generatedByIntruder(X:Msg),ML2:SMsgList || G:GhostList || PP:Properties) ) = simplifyNotInIConstraints( < I:Id > (SS:StrandSet || (X:Msg !inI,K:IntruderKnowledge) || ML1:SMsgList,generatedByIntruder(X:Msg),ML2:SMsgList || G:GhostList || PP:Properties) ) . eq simplifyNotInIConstraints(IS) = IS [owise] . *** filters ******************************************************* op simplifyInIConstraints : IdSystem -> IdSystem . 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 . 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 . 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 || (irr(X:Msg),K:IntruderKnowledge) || ML:SMsgList || G:GhostList || PP:Properties) ) . eq simplifyIrrConstraints(IS) = IS [owise] . *** filters ******************************************************* op simplifyDiffConstraints : Filters IdSystem -> IdSystem . eq simplifyDiffConstraints(F:Filters,X:IdSystem) = if -simplifyDiff !in F:Filters then simplifyDiffConstraintsE(F:Filters,X:IdSystem) else X:IdSystem fi . op simplifyDiffConstraintsE : Filters IdSystem -> IdSystem . eq simplifyDiffConstraintsE(F:Filters, < I:Id > (SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || G:GhostList || PP:Properties) ) = < I:Id > (SS:StrandSet || remove-!=(K:IntruderKnowledge), simplifyDiffConstraints*(F:Filters, getBoundFresh(SS:StrandSet), only-irr(K:IntruderKnowledge), removeDuplicatedDiffConstraints(only-!=(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) . sort FourDiffConstraint . op {{{_`,_`,_`,_}}} : TermList TermList TypeList Bool -> FourDiffConstraint . op 1st : FourDiffConstraint -> TermList . eq 1st({{{TL:TermList,TL':TermList,TPL:TypeList,B:Bool}}}) = TL:TermList . op 2nd : FourDiffConstraint -> TermList . eq 2nd({{{TL:TermList,TL':TermList,TPL:TypeList,B:Bool}}}) = TL':TermList . op 3rd : FourDiffConstraint -> TypeList . eq 3rd({{{TL:TermList,TL':TermList,TPL:TypeList,B:Bool}}}) = TPL:TypeList . op 4th : FourDiffConstraint -> Bool . eq 4th({{{TL:TermList,TL':TermList,TPL:TypeList,B:Bool}}}) = B:Bool . op gen : IntruderKnowledge-!= IntruderKnowledge-irr -> FourDiffConstraint . eq gen(empty,KK:IntruderKnowledge-irr) = {{{empty,empty,nil,true}}} . eq gen(((M1:Msg != M2:Msg),X:IntruderKnowledge-!=),KK:IntruderKnowledge-irr) = {{{ (upTerm(M1:Msg),1st(gen(X:IntruderKnowledge-!=,KK:IntruderKnowledge-irr))), (upTerm(M2:Msg),2nd(gen(X:IntruderKnowledge-!=,KK:IntruderKnowledge-irr))), ('Msg 3rd(gen(X:IntruderKnowledge-!=,KK:IntruderKnowledge-irr))), ((irr(M1:Msg) in KK:IntruderKnowledge-irr) and (irr(M2:Msg) in KK:IntruderKnowledge-irr) and (4th(gen(X:IntruderKnowledge-!=,KK:IntruderKnowledge-irr)))) }}} . op satDiffConstraints? : FreshSet IntruderKnowledge-irr IntruderKnowledge-!= -> SubstitutionSet [memo] . eq satDiffConstraints?(F:FreshSet,X:IntruderKnowledge-!=,KK:IntruderKnowledge-irr) = satDiffConstraints?*(F:FreshSet,X:IntruderKnowledge-!=,KK:IntruderKnowledge-irr) . op satDiffConstraints?* : FreshSet IntruderKnowledge-irr IntruderKnowledge-!= -> SubstitutionSet . ceq satDiffConstraints?*(F:FreshSet,X:IntruderKnowledge-!=,KK:IntruderKnowledge-irr) = SS:SubstitutionSet if D:FourDiffConstraint := gen(X:IntruderKnowledge-!=,KK:IntruderKnowledge-irr) /\ M:Module := addSorts('XXX, addOps((op 'Q : 3rd(D:FourDiffConstraint) -> 'XXX [none] .), STRAND-EXAMPLE-RULES-WITH-ALL)) /\ SS:SubstitutionSet := fresh[F:FreshSet, if 4th(D:FourDiffConstraint) then metaBuiltInUnify(M:Module, 'Q[1st(D:FourDiffConstraint)], 'Q[2nd(D:FourDiffConstraint)], upTerm(KK:IntruderKnowledge-irr)) else metaEBuiltInUnify(M:Module, 'Q[1st(D:FourDiffConstraint)], 'Q[2nd(D:FourDiffConstraint)], upTerm(KK:IntruderKnowledge-irr)) fi |> ('Q[1st(D:FourDiffConstraint)],'Q[2nd(D:FourDiffConstraint)]) ] . op simplifyDiffConstraints* : Filters FreshSet IntruderKnowledge-irr IntruderKnowledge-!= -> IntruderKnowledge-!= . eq simplifyDiffConstraints*(F:Filters,F:FreshSet,KK:IntruderKnowledge-irr,empty) = empty . ceq simplifyDiffConstraints*(F:Filters,F:FreshSet,KK:IntruderKnowledge-irr,X:IntruderKnowledge-!=) = if SS:SubstitutionSet == empty *** the != constraints don't unify then if -removeDiff !in F:Filters then removeDiffConstraints(F:FreshSet,M:Module,KK:IntruderKnowledge-irr,D:FourDiffConstraint) else empty ---- empty??? fi else if -addDiffConstraints !in F:Filters then addDiffConstraints(X:IntruderKnowledge-!=,SS:SubstitutionSet) else empty fi fi if D:FourDiffConstraint := gen(X:IntruderKnowledge-!=,KK:IntruderKnowledge-irr) /\ M:Module := addSorts('XXX, addOps((op 'Q : 3rd(D:FourDiffConstraint) -> 'XXX [none] .), STRAND-EXAMPLE-RULES-WITH-ALL)) /\ SS:SubstitutionSet := satDiffConstraints?(F:FreshSet,X:IntruderKnowledge-!=,KK:IntruderKnowledge-irr) [owise] . op removeDiffConstraints : FreshSet Module IntruderKnowledge-irr FourDiffConstraint -> IntruderKnowledge-!= . eq removeDiffConstraints(F:FreshSet,M:Module,KK:IntruderKnowledge-irr, {{{ empty, empty, TPL:TypeList, B:Bool }}}) = empty . eq removeDiffConstraints(F:FreshSet,M:Module,KK:IntruderKnowledge-irr, {{{ (T1:Term,TL1:TermList), (T2:Term,TL2:TermList), TPL:TypeList, B:Bool }}}) = (if fresh[F:FreshSet, if B:Bool then metaBuiltInUnify(M:Module,T1:Term,T2:Term, upTerm(KK:IntruderKnowledge-irr)) else metaEBuiltInUnify(M:Module,T1:Term,T2:Term, upTerm(KK:IntruderKnowledge-irr)) fi |> (T1:Term,T2:Term) ] == empty then downMsgSet(T1:Term) != downMsgSet(T2:Term) else empty fi), removeDiffConstraints(F:FreshSet,M:Module,KK:IntruderKnowledge-irr, {{{ TL1:TermList,TL2:TermList,TPL:TypeList, B:Bool }}}) . op addDiffConstraints : IntruderKnowledge-!= SubstitutionSet -> IntruderKnowledge-!= . eq addDiffConstraints(K:IntruderKnowledge-!=,(V:Variable <- T:Term ; S:Substitution) | SS:SubstitutionSet) = if typeLeq(upModule('PROTOCOL-SPECIFICATION,true), getType(V:Variable), 'Msg) then addDiffConstraints( ((downMsgSet(V:Variable) != downMsgSet(T:Term)),K:IntruderKnowledge-!=), S:Substitution | SS:SubstitutionSet) else addDiffConstraints(K:IntruderKnowledge-!=,S:Substitution | SS:SubstitutionSet) fi . eq addDiffConstraints(K:IntruderKnowledge-!=,SS:SubstitutionSet) = K: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' --- filterTimeMsg(IS) implies filterTimeMsg(IS') then --- IS' is discarded & continue with IST simplifyByImplicationL*(IST', IS, IST, IST'') else if IS' implies IS --- filterTimeMsg(IS') implies filterTimeMsg(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 . eq IST1:IdSystem implies* IST2:IdSystem = not bogusOneInIAllGhostTermsNotResuscitated(IST1:IdSystem) and-then IST1:IdSystem implies** IST2:IdSystem . *** Auxiliary ************* op bogusOneInIAllGhostTermsNotResuscitated : IdSystem -> Bool . --- remove??? eq bogusOneInIAllGhostTermsNotResuscitated ( < I1:Id > SS1:StrandSet || (M:Msg inI,K:IntruderKnowledge) || ML1:SMsgList || G1:GhostList || PP1:Properties) = (all Vars(upTerm(M:Msg)) in ghostTerms(G1:GhostList) or (upTerm(M:Msg) :: Variable and G1:GhostList == nil)) and-then noInI(K:IntruderKnowledge) and-then noResuscitatedSubterm(M:Msg,ML1:SMsgList) . eq bogusOneInIAllGhostTermsNotResuscitated(I:IdSystem) = false [owise] . op noResuscitatedSubterm : Msg SMsgList -> Bool . eq noResuscitatedSubterm(M:Msg,nil) = true . eq noResuscitatedSubterm(M:Msg,(resuscitated(M2:Msg),ML:SMsgList)) = not is upTerm(M2:Msg) subTermOf upTerm(M:Msg) and-then noResuscitatedSubterm(M:Msg,ML:SMsgList) . eq noResuscitatedSubterm(M:Msg,(X:SMsgElem,ML:SMsgList)) = noResuscitatedSubterm(M:Msg,ML:SMsgList) [owise] . ****************** op _implies**_ : IdSystem IdSystem -> 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) = < 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(checkXOR(removeBoolEqs( upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true)))), '_||_||_||_||_[ upTerm(noBar(toStrandSet$(noFresh(SS2:StrandSet)))), '_`,_[ upTerm(only-inI(K2:IntruderKnowledge)), upTerm(only-!inI(K2:IntruderKnowledge)), upTerm(only-!=(K2:IntruderKnowledge)), upTerm(only-irr(K2:IntruderKnowledge)), upTerm(makeInI(ghostTerms(G2:GhostList))) ], 'nil.SMsgList, 'nil.GhostList, 'nil.Properties ], '_||_||_||_||_[ '_&_[ upTerm(noBar(toStrandSet$(noFresh(SS1:StrandSet)))), 'XX:StrandSet ], '_`,_[ upTerm(only-inI(K1:IntruderKnowledge)), upTerm(only-!inI(K1:IntruderKnowledge)), upTerm(only-!=(K1:IntruderKnowledge)), upTerm(only-irr(K1:IntruderKnowledge)), upTerm(makeInI(ghostTerms(G1:GhostList))), 'XX:IntruderKnowledge ], 'nil.SMsgList, 'nil.GhostList, 'nil.Properties ] ) else metaBuiltInMatch( clearAllFrozen(checkXOR(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 ST1:IdSystem implies** ST2:IdSystem with empty = false . eq ST1:IdSystem implies** ST2:IdSystem with (S:Substitution | SS:SubstitutionSet) = ST1:IdSystem implies*** ST2:IdSystem with S:Substitution or-else ST1:IdSystem implies** ST2:IdSystem with SS:SubstitutionSet . op _implies***_with_ : IdSystem IdSystem Substitution -> 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 S:Substitution = not parentStateWithUnificationOfKnowledge(I1:Id,I2:Id) and-then not resuscitatedInI(G1:GhostList,S:Substitution,ML2:SMsgList) and-then not testInconsistentKnowledge(K1:IntruderKnowledge << S:Substitution) and-then not testByEquationalReducibility( clearAllFrozen(checkXOR(removeBoolEqs( upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true)))), (SS1:StrandSet || K1:IntruderKnowledge || ML1:SMsgList || G1:GhostList || PP1:Properties) << S:Substitution) and-then included( (only-!=(K1:IntruderKnowledge), if I1:Id <<< I2:Id then empty else makeInI(ghostTerms(G1:GhostList)) fi), S:Substitution, (only-!=(K2:IntruderKnowledge), if I1:Id <<< I2:Id then empty else makeInI(ghostTerms(G2:GhostList)) fi) ) and-then if noInitial(SS1:StrandSet) == empty and only-inI(K1:IntruderKnowledge) == empty then toStrandSet$(noFresh(SS1:StrandSet) << S:Substitution) implies$ toStrandSet$(noFresh(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 . *** noParentState ************* op parentStateWithUnificationOfKnowledge : Id Id -> Bool . eq parentStateWithUnificationOfKnowledge(I1:Id,I1:Id . I:IdElem { N2:Nat } . I2:Id) = true . eq parentStateWithUnificationOfKnowledge(I1:Id,I2:Id) = false [owise] . *** resuscitatedInI ************* op resuscitatedInI : GhostList Substitution SMsgList -> Bool . ceq resuscitatedInI( (G1:GhostList, ghost(M1:Msg,SS:StrandSet,K:IntruderKnowledge,ML:SMsgList,PP:Properties), G2:GhostList), S:Substitution, (M1:SMsgList,resuscitated(M2:Msg),M2:SMsgList)) = true if (M1:Msg inI) << S:Substitution =/= (M1:Msg inI) and-then is upTerm(M1:Msg) subTermOf upTerm(M2:Msg) . eq resuscitatedInI(G:GhostList,S:Substitution,ML:SMsgList) = false [owise] . *** included *** *** Constraints of K2 should imply instantiated constraints of K1 op included : IntruderKnowledge Substitution IntruderKnowledge -> Bool . eq included(empty,S:Substitution,K2:IntruderKnowledge) = true . eq included( (X:Msg inI,K1:IntruderKnowledge), S:Substitution, K2:IntruderKnowledge) = ( (X:Msg inI) << S:Substitution == (X:Msg inI) or-else (X:Msg inI << S:Substitution) in K2:IntruderKnowledge or-else (X:Msg inI << S:Substitution) matchingIn K2:IntruderKnowledge rangeVars empty ) and-then included(K1:IntruderKnowledge,S:Substitution,K2:IntruderKnowledge) . eq included( ((X11:Msg != X12:Msg),K1:IntruderKnowledge), S:Substitution, K2:IntruderKnowledge) = ( ( (X11:Msg inI) << S:Substitution == (X11:Msg inI) and (X12:Msg inI) << S:Substitution == (X12:Msg inI) ) --- discarded or-else ( ((X11:Msg << S:Substitution) != (X12:Msg << S:Substitution)) in K2:IntruderKnowledge ) or-else ( ((X11:Msg << S:Substitution) != (X12:Msg << S:Substitution)) matchingIn K2:IntruderKnowledge rangeVars rangeOnlyVars(S:Substitution) ) ) and-then included(K1:IntruderKnowledge,S:Substitution,K2:IntruderKnowledge) . op rangeOnlyVars : Substitution -> TermList . eq rangeOnlyVars(V1:Variable <- V2:Variable ; Subst) = (V2:Variable,rangeOnlyVars(Subst)) . eq rangeOnlyVars(Subst) = empty [owise] . *** matchingIn ****************** op _matchingIn_rangeVars_ : Knowledge IntruderKnowledge TermList -> Bool . ceq X:Msg inI matchingIn (Y:Msg inI,IK:IntruderKnowledge) rangeVars TL:TermList = SS:SubstitutionSet =/= empty or-else X:Msg inI matchingIn IK:IntruderKnowledge rangeVars TL:TermList if M:Module := clearAllFrozen(checkXOR(removeBoolEqs( upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true)))) /\ {Mx:Module, (TX:Term, TY:Term)} := rigidifeList(M:Module,'included, (upTerm(X:Msg),upTerm(Y:Msg)), (TL:TermList,Vars(upTerm(X:Msg)) intersect Vars(upTerm(Y:Msg)))) /\ SS:SubstitutionSet := metaBuiltInMatch(Mx:Module,TY:Term,TX:Term) . --- TY is instance of TX ceq (X11:Msg != X12:Msg) matchingIn ((X21:Msg != X22:Msg),IK:IntruderKnowledge) rangeVars TL:TermList = SS:SubstitutionSet =/= empty or-else (X11:Msg != X12:Msg) matchingIn IK:IntruderKnowledge rangeVars TL:TermList if M:Module := clearAllFrozen(checkXOR(removeBoolEqs( upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true)))) /\ {Mx:Module, (TX:Term, TY:Term)} := rigidifeList(M:Module,'included, ('_!=_[upTerm(X11:Msg),upTerm(X12:Msg)],'_!=_[upTerm(X21:Msg),upTerm(X22:Msg)]), (TL:TermList,Vars((upTerm(X11:Msg),upTerm(X12:Msg))) intersect Vars((upTerm(X21:Msg),upTerm(X22:Msg))))) /\ SS:SubstitutionSet := metaBuiltInMatch(Mx:Module,TY:Term,TX:Term) . --- TY is instance of TX eq X:Knowledge matchingIn IK:IntruderKnowledge rangeVars TL:TermList = false [owise] . *** 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,-(M:Msg),M2:SMsgList) noParentGhost I2:Id (M1:SMsgList,resuscitated(M:Msg),-(M:Msg),M2: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, -(M:Msg),M3:SMsgList) noParentGhost# I2:Id (M1*:SMsgList,+(M:Msg),M2:SMsgList, resuscitated(M:Msg), -(M:Msg),M3:SMsgList) = false if I1:Id <<< I2:Id /\ (G1:GhostList == nil and-then G2:GhostList == nil and-then (M1:SMsgList subsequenceOf M1*:SMsgList)) or-else (not resuscitated?(M1*:SMsgList) and (M1:SMsgList subsequenceOf M1*:SMsgList)) or-else not ( I1:Id (G1:GhostList, G2:GhostList) & (M1:SMsgList,M2:SMsgList, -(M:Msg),M3:SMsgList) noParentGhost I2:Id (M1*:SMsgList,M2:SMsgList, -(M:Msg),M3: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(checkXOR(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] . op _subsequenceOf_ : SMsgList SMsgList -> Bool . eq nil subsequenceOf ML:SMsgList = true . eq (M1:SMsg,ML1:SMsgList) subsequenceOf (M2:SMsg,ML2:SMsgList) = if M1:SMsg == M2:SMsg then ML1:SMsgList subsequenceOf ML2:SMsgList else ML1:SMsgList subsequenceOf (M2:SMsg,ML2:SMsgList) fi . *** 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 noFresh : StrandSet -> StrandSet . eq noFresh((empty).StrandSet) = (empty).StrandSet . eq noFresh(:: nil :: [ L:SMsgList-L | L':SMsgList-R] & SS:StrandSet) = noFresh(SS:StrandSet) . eq noFresh(:: RL:FreshSet :: [ L:SMsgList-L | L':SMsgList-R] & SS:StrandSet) = :: RL:FreshSet :: [ L:SMsgList-L | L':SMsgList-R] & noFresh(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 Substitution -> System . eq SS:System << S:Substitution = downSystemSet(upTerm(SS:System) << S:Substitution) . op _<<_ : Msg Substitution -> Msg . eq M:Msg << S:Substitution = downMsgSet(upTerm(M:Msg) << 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 : Filters System -> Bool . eq testInconsistency(F:Filters, (SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || G:GhostList || PP:Properties)) = testInconsistentKnowledge(-inconsistencyDiff in F:Filters,K:IntruderKnowledge) or-else testInconsistentStrands(SS:StrandSet) or-else testInconsistentStrandsK(SS:StrandSet,K:IntruderKnowledge) or-else testInIinGhost(K:IntruderKnowledge,makeInI(ghostTerms(G:GhostList))) or-else testIsPrivate(K:IntruderKnowledge) . op testIsPrivate : IntruderKnowledge -> Bool . eq testIsPrivate((X:Private inI,K:IntruderKnowledge)) = true . eq testIsPrivate(K:IntruderKnowledge) = false [owise] . op testInIinGhost : IntruderKnowledge IntruderKnowledge -> Bool . eq testInIinGhost((X:Msg inI,K1:IntruderKnowledge),(X:Msg inI,K2:IntruderKnowledge)) = true . eq testInIinGhost(K1:IntruderKnowledge,K2:IntruderKnowledge) = false [owise] . op testInconsistentKnowledge : IntruderKnowledge -> Bool . eq testInconsistentKnowledge(X:IntruderKnowledge) = testInconsistentKnowledge(false,X:IntruderKnowledge) . op testInconsistentKnowledge : Bool IntruderKnowledge -> Bool . --- true means do not check Diff inconsistency *** If knowledge "X in I" and knowledge "X !in I" appears at the *** same time, then error and remove such State eq testInconsistentKnowledge(B:Bool, (X:Msg inI,X:Msg !inI,K:IntruderKnowledge) ) = true . *** If some knowledge appears more than once, *** then error and remove such State eq testInconsistentKnowledge(B:Bool, (X:Msg !inI,X:Msg !inI,K:IntruderKnowledge) ) = true . *** If some T != T knowledge appears, then error eq testInconsistentKnowledge(false, ((X:Msg != X:Msg),K:IntruderKnowledge) ) = true . *** Otherwise eq testInconsistentKnowledge(B:Bool, 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 . 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), K:IntruderKnowledge) || ML:SMsgList || (ghost(X:Msg,SS1:StrandSet,K1:IntruderKnowledge,ML1:SMsgList,PP1:Properties), GL:GhostList) || PP:Properties ) = true . eq testBadSecretData( SS:StrandSet || (secret(X:Msg), K:IntruderKnowledge) || (ML1:SMsgList,generatedByIntruder(X:Msg),ML2: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 . 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 . ceq testAlreadySent( ( :: RL:FreshSet, r:Fresh, RL':FreshSet :: [ L:SMsgList-L | L':SMsgList-R ] & SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || G:GhostList || PP:Properties ) ) = true if L1:SMsgList$,-(X':Msg),L2:SMsgList$,+(X:Msg),L3:SMsgList$ := (toSMsgList(L:SMsgList-L),toSMsgList(L':SMsgList-R)) /\ is upTerm(r:Fresh) subTermOf upTerm(X:Msg) and-then is upTerm(r:Fresh) subTermOf upTerm(X':Msg) and-then (nil).SMsgList == only-Output(L1:SMsgList$) . 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)),only-Synchro(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-Synchro(toSMsgList(LL:SMsgList-L)),only-Output(toSMsgList(LL:SMsgList-L))))) . eq testAlreadySent(S:System) = false [owise] . *** filters ******************************************************* op testByEquationalReducibility : Module System -> Bool . eq testByEquationalReducibility(M,S) = not (upTerm(S) =[M]= getTerm( metaReduce( removeVariantLabel( onlyEqsNoBuiltInUnify( putStrat(0,'+`(_`),'Msg, putStrat(0,'_!inI,'Msg, clearNonExecEqs(eraseRls(checkXOR(M))) )))), upTerm(S) ) )) . *** filters ******************************************************* op testByGrammars : GrammarList IdSystem -> Bool . eq testByGrammars(GS,IS) = testByGrammars*(GS,remId(IS)) . 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) . eq testNegMsg(GS,Ctr:CtrSet,(M:Synchro,SM:SMsgList)) = testNegMsg(GS,Ctr:CtrSet,SM:SMsgList) . eq testNegMsg(GS,Ctr:CtrSet,(M:StrandConstraint,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) . eq initials(IS:ShortIdSystem IST) = if isInitial(remId(IS:ShortIdSystem)) then IS:ShortIdSystem 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 : ShortSystem -> Bool . eq isInitial( (SS:StrandSet | K:IntruderKnowledge | ML:SMsgList | G:GhostList)) = isInitial(SS:StrandSet) and-then isInitial(K:IntruderKnowledge) . op isInitial : StrandSet -> Bool . 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 . 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 . vars BStep BSol Sess Sol Nodes : 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,Nodes,Sess,Rem?) = search(genGrammars,A:Attack,F,BStep,Nodes,Sess,Rem?) . op search : GrammarList Attack Filters Bound Nat Bound Bool -> IdSystemSet . eq search(GS,ST,F,BStep,Nodes,Sess,Rem?) = searchState( GS, F, BStep, *** number of backward reachability steps Nodes, *** states of the last level that have to be explored Sess, Rem?, setId+(1,ST) ) . *** General Call ******************************************************* op searchState : GrammarList Filters Bound Bound Bound Bool IdSystem -> 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,Nodes,Sess,Rem?,IST) = searchState*( if -inputAndNotLearned !in F then flipRls(STRAND-EXAMPLE-RULES) else flipRls(STRAND-EXAMPLE-RULES-INPUT) fi, GS,F,BStep,Nodes,Sess,Rem?,IST) . op searchState* : Module GrammarList Filters Bound Bound Bound Bool IdSystem -> IdSystemSet . eq searchState*(M,GS,F,BStep,Nodes,Sess,Rem?,IST) = searchStateM(M,GS,F,BStep,Nodes,Sess,Rem?, empty, --- HistoryIST simplifyGhost(F, createGhost(M,F, nextBackNarrow*Fix(M,GS,F:Filters, move*Input(F,IST) ) ) ) ) . op searchStateM : Module GrammarList Filters Bound Bound Bound Bool IdSystemSet IdSystemSet -> IdSystemSet . eq searchStateM(M,GS,F,BStep,Nodes,Sess,Rem?,HistoryIST,IST) = if BStep == 0 or-else IST == empty then --- Stop the search if Rem? then IST else empty fi else searchState-Check(M,GS,F,BStep,Nodes,Sess,Rem?,HistoryIST,empty,IST) fi . *** Auxiliary Call ******************************************************* op searchState-Check : Module GrammarList Filters Bound Bound Bound Bool IdSystemSet IdSystemSet IdSystemSet -> IdSystemSet . eq searchState-Check(M,GS,F,BStep,Nodes,Sess,Rem?,HistoryIST,IST',empty) = *** Next successors searchStateM(M,GS,F,dec(BStep),Nodes,Sess,Rem?,HistoryIST IST', filterSMsgListX(F,filterIdX(F, nextBackNarrow(M,GS,F, if BStep == 1 then Nodes else unbounded fi, HistoryIST IST',IST') )) ) . eq searchState-Check(M,GS,F,BStep,Nodes,Sess,Rem?,HistoryIST,IST',(IS IST)) = if Sess =/= unbounded and-then countSessions(IS) > Sess then searchState-Check(M,GS,F,BStep,Nodes,Sess,Rem?,HistoryIST,IST',IST) else if isInitialM(M,IS) then IS searchState-Check(M,GS,F,BStep,Nodes,Sess,Rem?,HistoryIST,IST',IST) else searchState-Check(M,GS,F,BStep,Nodes,Sess,Rem?,HistoryIST, if isNFSystem(M,HistoryIST,IS) then IST' else (IS IST') fi, IST) fi fi . op filterSMsgListX : Filters IdSystemSet -> IdSystemSet . eq filterSMsgListX(F:Filters,Y:IdSystemSet) = filterSMsgList(F:Filters,Y:IdSystemSet) . *** 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 isInitialM : Module IdSystem -> Bool . eq isInitialM(M,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 | . eq | IS:ShortIdSystem IST | = 1 + | IST | . op count : SystemSet -> Nat . eq count(ST) = | ST | . op |_| : SystemSet -> Nat . eq | (empty).SystemSet | = 0 . eq | S ST | = 1 + | ST | . eq | S:ShortSystem 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 filterIdX : Filters IdSystemSet -> IdSystemSet . eq filterIdX(F:Filters,SS:IdSystemSet) = filterId(F:Filters,SS:IdSystemSet) . 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 . --- Warning: IdSystem and ShortIdSystem op errorOneStrandInAttackStateDoesNotUnifyWithAnyfProtocolStrands : -> IdSystemSet-or-Error [format (r d)] . op errorInAttackStateinFile : -> IdSystemSet-or-Error [format (r d)] . *** run ********************** op digest : Bound -> IdSystemSet-or-Error . eq digest(Depth:Bound) = digest(run[0](Depth:Bound)< unbounded >) . op digest : Nat Bound -> IdSystemSet-or-Error . eq digest(Attack:Nat,Depth:Bound) = digest(run[0](Attack:Nat,Depth:Bound)< unbounded >) . op digest : Bound Filters -> IdSystemSet-or-Error . eq digest(Depth:Bound,F:Filters) = digest(run[0](Depth:Bound,F:Filters)< unbounded >) . op digest : Nat Bound Filters -> IdSystemSet-or-Error . eq digest(Attack:Nat,Depth:Bound,F:Filters) = digest(run[0](Attack:Nat,Depth:Bound,F:Filters,unbounded)< unbounded >) . op digest[_]`(_`) : Id-SMsgList Bound -> IdSystemSet-or-Error . eq digest[I:Id-SMsgList](Depth:Bound) = digest(run[I:Id-SMsgList](Depth:Bound)< unbounded >) . op digest[_]`(_`,_`) : Id-SMsgList Nat Bound -> IdSystemSet-or-Error . eq digest[I:Id-SMsgList](Attack:Nat,Depth:Bound) = digest(run[I:Id-SMsgList](Attack:Nat,Depth:Bound)< unbounded >) . op digest[_]`(_`,_`) : Id-SMsgList Bound Filters -> IdSystemSet-or-Error . eq digest[I:Id-SMsgList](Depth:Bound,F:Filters) = digest(run[I:Id-SMsgList](Depth:Bound,F:Filters)< unbounded >) . op digest[_]`(_`,_`,_`) : Id-SMsgList Nat Bound Filters -> IdSystemSet-or-Error . eq digest[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters) = digest(run[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters,unbounded)< unbounded >) . op digest`(_`,_`)<_> : Nat Bound Bound -> IdSystemSet-or-Error . eq digest(Attack:Nat,Depth:Bound)< Sess:Bound > = digest(run[0](Attack:Nat,Depth:Bound,all,unbounded)< unbounded >) . op digest`(_`)<_> : Bound Bound -> IdSystemSet-or-Error . eq digest(Depth:Bound)< Sess:Bound > = digest(run[0](0,Depth:Bound,all,unbounded )< unbounded >) . op digest : IdSystemSet-or-Error -> IdSystemSet-or-Error . eq digest(X:IdSystemSet-or-Error) = if X:IdSystemSet-or-Error :: IdSystemSet then digest*(X:IdSystemSet-or-Error) else X:IdSystemSet-or-Error fi . op digest* : IdSystemSet -> IdSystemSet . eq digest*(empty) = empty . eq digest*(IST:IdSystemSet < I:Id > SS:StrandSet | K:IntruderKnowledge | ML:SMsgList | GL:GhostList) = (< I:Id > (only-inI(K:IntruderKnowledge),makeInI(GL:GhostList)) | ML:SMsgList) digest*(IST:IdSystemSet) . *** run ********************** op run : Bound -> IdSystemSet-or-Error . eq run(Depth:Bound) = run[0](Depth:Bound)< unbounded > . op run : Nat Bound -> IdSystemSet-or-Error . eq run(Attack:Nat,Depth:Bound) = run[0](Attack:Nat,Depth:Bound)< unbounded > . op run : Bound Filters -> IdSystemSet-or-Error . eq run(Depth:Bound,F:Filters) = run[0](Depth:Bound,F:Filters)< unbounded > . op run : Nat Bound Filters -> IdSystemSet-or-Error . eq run(Attack:Nat,Depth:Bound,F:Filters) = run[0](Attack:Nat,Depth:Bound,F:Filters,unbounded)< unbounded > . op run[_]`(_`) : Id-SMsgList Bound -> IdSystemSet-or-Error . eq run[I:Id-SMsgList](Depth:Bound) = run[I:Id-SMsgList](Depth:Bound)< unbounded > . op run[_]`(_`,_`) : Id-SMsgList Nat Bound -> IdSystemSet-or-Error . eq run[I:Id-SMsgList](Attack:Nat,Depth:Bound) = run[I:Id-SMsgList](Attack:Nat,Depth:Bound)< unbounded > . op run[_]`(_`,_`) : Id-SMsgList Bound Filters -> IdSystemSet-or-Error . eq run[I:Id-SMsgList](Depth:Bound,F:Filters) = run[I:Id-SMsgList](Depth:Bound,F:Filters)< unbounded > . op run[_]`(_`,_`,_`) : Id-SMsgList Nat Bound Filters -> IdSystemSet-or-Error . eq run[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters) = run[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters,unbounded)< unbounded > . op run`(_`,_`)<_> : Nat Bound Bound -> IdSystemSet-or-Error . eq run(Attack:Nat,Depth:Bound)< Sess:Bound > = run[0](Attack:Nat,Depth:Bound,all,unbounded)< unbounded > . op run`(_`)<_> : Bound Bound -> IdSystemSet-or-Error . eq run(Depth:Bound)< Sess:Bound > = run[0](0,Depth:Bound,all,unbounded )< unbounded > . *** debug command -- same as run op debug : Bound -> IdSystemSet-or-Error . eq debug(Depth:Bound) = debug[0](Depth:Bound)< unbounded > . op debug`(_`)<_> : Bound Bound -> IdSystemSet-or-Error . eq debug(Depth:Bound)< Sess:Bound > = debug[0](0,Depth:Bound,all,unbounded)< Sess:Bound > . op debug`(_#_`)<_> : Bound Bound Bound -> IdSystemSet-or-Error . eq debug(Depth:Bound # Nodes:Bound)< Sess:Bound > = debug[0](0,Depth:Bound,all,Nodes:Bound)< Sess:Bound > . op debug[_]`(_`)<_> : Id-SMsgList Bound Bound -> IdSystemSet-or-Error . eq debug[I:Id-SMsgList](Depth:Bound)< Sess:Bound > = debug[I:Id-SMsgList](0,Depth:Bound,all,unbounded)< Sess:Bound > . op debug[_]`(_#_`)<_> : Id-SMsgList Bound Bound Bound -> IdSystemSet-or-Error . eq debug[I:Id-SMsgList](Depth:Bound # Nodes:Bound)< Sess:Bound > = debug[I:Id-SMsgList](0,Depth:Bound,all,Nodes:Bound)< Sess:Bound > . op debug[_]`(_`,_`)<_> : Id-SMsgList Nat Bound Bound -> IdSystemSet-or-Error . eq debug[I:Id-SMsgList](Attack:Nat,Depth:Bound)< Sess:Bound > = debug[I:Id-SMsgList](Attack:Nat,Depth:Bound,all,unbounded)< Sess:Bound > . op debug[_]`(_`,_#_`)<_> : Id-SMsgList Nat Bound Bound Bound -> IdSystemSet-or-Error . eq debug[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound)< Sess:Bound > = debug[I:Id-SMsgList](Attack:Nat,Depth:Bound,all,Nodes:Bound)< Sess:Bound > . op debug[_]`(_`,_`)<_> : Id-SMsgList Bound Filters Bound -> IdSystemSet-or-Error . eq debug[I:Id-SMsgList](Depth:Bound,F:Filters)< Sess:Bound > = debug[I:Id-SMsgList](0,Depth:Bound,F:Filters,unbounded)< Sess:Bound > . op debug[_]`(_#_`,_`)<_> : Id-SMsgList Bound Bound Filters Bound -> IdSystemSet-or-Error . eq debug[I:Id-SMsgList](Depth:Bound # Nodes:Bound,F:Filters)< Sess:Bound > = debug[I:Id-SMsgList](0,Depth:Bound,F:Filters,Nodes:Bound)< Sess:Bound > . op debug : Nat Bound -> IdSystemSet-or-Error . eq debug(Attack:Nat,Depth:Bound) = debug[0](Attack:Nat,Depth:Bound)< unbounded > . op debug : Bound Filters -> IdSystemSet-or-Error . eq debug(Depth:Bound,F:Filters) = debug[0](Depth:Bound,F:Filters)< unbounded > . op debug : Nat Bound Filters -> IdSystemSet-or-Error . eq debug(Attack:Nat,Depth:Bound,F:Filters) = debug[0](Attack:Nat,Depth:Bound,F:Filters,unbounded)< unbounded > . op debug[_]`(_`) : Id-SMsgList Bound -> IdSystemSet-or-Error . eq debug[I:Id-SMsgList](Depth:Bound) = debug[I:Id-SMsgList](Depth:Bound)< unbounded > . op debug[_]`(_`,_`) : Id-SMsgList Nat Bound -> IdSystemSet-or-Error . eq debug[I:Id-SMsgList](Attack:Nat,Depth:Bound) = debug[I:Id-SMsgList](Attack:Nat,Depth:Bound)< unbounded > . op debug[_]`(_`,_`) : Id-SMsgList Bound Filters -> IdSystemSet-or-Error . eq debug[I:Id-SMsgList](Depth:Bound,F:Filters) = debug[I:Id-SMsgList](Depth:Bound,F:Filters)< unbounded > . op debug[_]`(_`,_`,_`) : Id-SMsgList Nat Bound Filters -> IdSystemSet-or-Error . eq debug[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters) = debug[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters,unbounded)< unbounded > . op debug`(_`,_`)<_> : Nat Bound Bound -> IdSystemSet-or-Error . eq debug(Attack:Nat,Depth:Bound)< Sess:Bound > = debug[0](Attack:Nat,Depth:Bound,all,unbounded)< unbounded > . op debug`(_`)<_> : Bound Bound -> IdSystemSet-or-Error . eq debug(Depth:Bound)< Sess:Bound > = debug[0](0,Depth:Bound,all,unbounded )< unbounded > . op debug[_]`(_`,_`,_`,_`)<_> : Id-SMsgList Nat Bound Filters Bound Bound -> IdSystemSet-or-Error . eq debug[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters,Nodes:Bound)< Sess:Bound > = run[I:Id-SMsgList](Attack:Nat,Depth:Bound,+debug F:Filters,Nodes:Bound)< Sess:Bound > . *** General Tools **************************************** op initials : Bound -> IdSystemSet-or-Error . eq initials(Depth:Bound) = initials[0](Depth:Bound,all) . op initials[_]`(_`) : Id-SMsgList Bound -> IdSystemSet-or-Error . eq initials[I:Id-SMsgList](Depth:Bound) = initials[I:Id-SMsgList](0,Depth:Bound,all) . op initials`(_`,_`) : Nat Bound -> IdSystemSet-or-Error . eq initials(Attack:Nat,Depth:Bound) = initials[0](Attack:Nat,Depth:Bound) . op initials[_]`(_`,_`) : Id-SMsgList Nat Bound -> IdSystemSet-or-Error . eq initials[I:Id-SMsgList](Attack:Nat,Depth:Bound) = initials[I:Id-SMsgList](Attack:Nat,Depth:Bound,all) . op initials`(_`,_`) : Bound Filters -> IdSystemSet-or-Error . eq initials(Depth:Bound,F:Filters) = initials[0](Depth:Bound,F:Filters) . op initials[_]`(_`,_`) : Id-SMsgList Bound Filters -> IdSystemSet-or-Error . eq initials[I:Id-SMsgList](Depth:Bound,F:Filters) = initials[I:Id-SMsgList](0,Depth:Bound,F:Filters) . op initials`(_`,_`,_`) : Nat Bound Filters -> IdSystemSet-or-Error . eq initials(Attack:Nat,Depth:Bound,F:Filters) = initials[0](Attack:Nat,Depth:Bound,F:Filters) . op initials[_]`(_`,_`,_`) : Id-SMsgList Nat Bound Filters -> IdSystemSet-or-Error . eq initials[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters) = initials(run[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters)) . *** General Tools **************************************** op initials`(_`)<_> : Bound Bound -> IdSystemSet-or-Error . eq initials(Depth:Bound)< Sess:Bound > = initials[0](Depth:Bound)< Sess:Bound > . op initials[_]`(_`)<_> : Id-SMsgList Bound Bound -> IdSystemSet-or-Error . eq initials[I:Id-SMsgList](Depth:Bound)< Sess:Bound > = initials[I:Id-SMsgList](0,Depth:Bound,all)< Sess:Bound > . op initials[_]`(_`,_`)<_> : Id-SMsgList Nat Bound Bound -> IdSystemSet-or-Error . eq initials[I:Id-SMsgList](Attack:Nat,Depth:Bound)< Sess:Bound > = initials[I:Id-SMsgList](Attack:Nat,Depth:Bound,all)< Sess:Bound > . op initials[_]`(_`,_`)<_> : Id-SMsgList Bound Filters Bound -> IdSystemSet-or-Error . eq initials[I:Id-SMsgList](Depth:Bound,F:Filters)< Sess:Bound > = initials[I:Id-SMsgList](0,Depth:Bound,F:Filters)< Sess:Bound > . op initials[_]`(_`,_`,_`)<_> : Id-SMsgList Nat Bound Filters Bound -> IdSystemSet-or-Error . eq initials[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters)< Sess:Bound > = initials(run[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters,unbounded)< Sess:Bound >) . op initials`(_`,_`)<_> : Nat Bound Bound -> IdSystemSet-or-Error . eq initials(Attack:Nat,Depth:Bound)< Sess:Bound > = initials[0](Attack:Nat,Depth:Bound,all)< unbounded > . op initials`(_`)<_> : Bound Bound -> IdSystemSet-or-Error . eq initials(Depth:Bound)< Sess:Bound > = initials[0](0,Depth: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(Depth:Bound) = summary[0](0,Depth:Bound # unbounded,all)< unbounded > . op summary`(_#_`) : Bound Bound -> Summary . eq summary(Depth:Bound # Nodes:Bound) = summary[0](0,Depth:Bound # unbounded,all)< unbounded > . op summary : Nat Bound -> Summary . eq summary(Attack:Nat,Depth:Bound) = summary[0](Attack:Nat,Depth:Bound # unbounded,all)< unbounded > . op summary`(_`,_#_`) : Nat Bound Bound -> Summary . eq summary(Attack:Nat,Depth:Bound # Nodes:Bound) = summary[0](Attack:Nat,Depth:Bound # Nodes:Bound,all)< unbounded > . op summary : Bound Filters -> Summary . eq summary(Depth:Bound,F:Filters) = summary[0](0,Depth:Bound # unbounded,F:Filters)< unbounded > . op summary`(_#_`,_`) : Bound Bound Filters -> Summary . eq summary(Depth:Bound # Nodes:Bound,F:Filters) = summary[0](0,Depth:Bound # Nodes:Bound,F:Filters)< unbounded > . op summary : Nat Bound Filters -> Summary . eq summary(Attack:Nat,Depth:Bound,F:Filters) = summary[0](Attack:Nat,Depth:Bound # unbounded,F:Filters)< unbounded > . op summary`(_`,_#_`,_`) : Nat Bound Bound Filters -> Summary . eq summary(Attack:Nat,Depth:Bound # Nodes:Bound,F:Filters) = summary[0](Attack:Nat,Depth:Bound # Nodes:Bound,F:Filters)< unbounded > . op summary[_]`(_`) : Id-SMsgList Bound -> Summary . eq summary[I:Id-SMsgList](Depth:Bound) = summary[I:Id-SMsgList](0,Depth:Bound # unbounded,all)< unbounded > . op summary[_]`(_#_`) : Id-SMsgList Bound Bound -> Summary . eq summary[I:Id-SMsgList](Depth:Bound # Nodes:Bound) = summary[I:Id-SMsgList](0,Depth:Bound # Nodes:Bound,all)< unbounded > . op summary[_]`(_`,_`) : Id-SMsgList Nat Bound -> Summary . eq summary[I:Id-SMsgList](Attack:Nat,Depth:Bound) = summary[I:Id-SMsgList](Attack:Nat,Depth:Bound # unbounded,all)< unbounded > . op summary[_]`(_`,_#_`) : Id-SMsgList Nat Bound Bound -> Summary . eq summary[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound) = summary[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound,all)< unbounded > . op summary[_]`(_`,_`) : Id-SMsgList Bound Filters -> Summary . eq summary[I:Id-SMsgList](Depth:Bound,F:Filters) = summary[I:Id-SMsgList](0,Depth:Bound # unbounded,F:Filters)< unbounded > . op summary[_]`(_#_`,_`) : Id-SMsgList Bound Bound Filters -> Summary . eq summary[I:Id-SMsgList](Depth:Bound # Nodes:Bound,F:Filters) = summary[I:Id-SMsgList](0,Depth:Bound # Nodes:Bound,F:Filters)< unbounded > . op summary[_]`(_`,_`,_`) : Id-SMsgList Nat Bound Filters -> Summary . eq summary[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters) = summary[I:Id-SMsgList](Attack:Nat,Depth:Bound # unbounded,F:Filters)< unbounded > . op summary[_]`(_`,_#_`,_`) : Id-SMsgList Nat Bound Bound Filters -> Summary . eq summary[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound,F:Filters) = summary[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound,F:Filters)< unbounded > . op summary`(_`)<_> : Bound Bound -> Summary . eq summary(Depth:Bound)< Sess:Bound > = summary[0](Depth:Bound)< Sess:Bound > . op summary`(_#_`)<_> : Bound Bound Bound -> Summary . eq summary(Depth:Bound # Nodes:Bound)< Sess:Bound > = summary[0](Depth:Bound # Nodes:Bound)< Sess:Bound > . op summary`(_`,_`)<_> : Nat Bound Bound -> Summary . eq summary(Attack:Nat,Depth:Bound)< Sess:Bound > = summary[0](Attack:Nat,Depth:Bound,all)< unbounded > . op summary`(_`,_#_`)<_> : Nat Bound Bound Bound -> Summary . eq summary(Attack:Nat,Depth:Bound # Nodes:Bound)< Sess:Bound > = summary[0](Attack:Nat,Depth:Bound # Nodes:Bound,all)< unbounded > . op summary`(_`)<_> : Bound Bound -> Summary . eq summary(Depth:Bound)< Sess:Bound > = summary[0](0,Depth:Bound,all)< unbounded > . op summary`(_#_`)<_> : Bound Bound Bound -> Summary . eq summary(Depth:Bound # Nodes:Bound)< Sess:Bound > = summary[0](0,Depth:Bound # Nodes:Bound,all)< unbounded > . op summary[_]`(_`)<_> : Id-SMsgList Bound Bound -> Summary . eq summary[I:Id-SMsgList](Depth:Bound)< Sess:Bound > = summary[I:Id-SMsgList](0,Depth:Bound # unbounded,all)< Sess:Bound > . op summary[_]`(_#_`)<_> : Id-SMsgList Bound Bound Bound -> Summary . eq summary[I:Id-SMsgList](Depth:Bound # Nodes:Bound)< Sess:Bound > = summary[I:Id-SMsgList](0,Depth:Bound # Nodes:Bound,all)< Sess:Bound > . op summary[_]`(_`,_`)<_> : Id-SMsgList Nat Bound Bound -> Summary . eq summary[I:Id-SMsgList](Attack:Nat,Depth:Bound)< Sess:Bound > = summary[I:Id-SMsgList](Attack:Nat,Depth:Bound,all )< Sess:Bound > . op summary[_]`(_`,_#_`)<_> : Id-SMsgList Nat Bound Bound Bound -> Summary . eq summary[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound)< Sess:Bound > = summary[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound,all )< Sess:Bound > . op summary[_]`(_`,_`)<_> : Id-SMsgList Bound Filters Bound -> Summary . eq summary[I:Id-SMsgList](Depth:Bound,F:Filters)< Sess:Bound > = summary[I:Id-SMsgList](0,Depth:Bound,F:Filters)< Sess:Bound > . op summary[_]`(_#_`,_`)<_> : Id-SMsgList Bound Bound Filters Bound -> Summary . eq summary[I:Id-SMsgList](Depth:Bound # Nodes:Bound,F:Filters)< Sess:Bound > = summary[I:Id-SMsgList](0,Depth:Bound # Nodes:Bound,F:Filters)< Sess:Bound > . op summary[_]`(_`,_`,_`)<_> : Id-SMsgList Nat Bound Filters Bound -> Summary . eq summary[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters)< Sess:Bound > = States>> count(run[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters,unbounded)< Sess:Bound >) Solutions>> count(initials(run[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters,unbounded)< Sess:Bound >)) . op summary[_]`(_`,_#_`,_`)<_> : Id-SMsgList Nat Bound Bound Filters Bound -> Summary . eq summary[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound,F:Filters)< Sess:Bound > = States>> count(run[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters,Nodes:Bound)< Sess:Bound >) Solutions>> count(initials(run[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters,Nodes:Bound)< Sess:Bound >)) . *** op ids : Bound -> IdSet . eq ids(Depth:Bound) = ids[0](0,Depth:Bound # unbounded,all)< unbounded > . op ids`(_#_`) : Bound Bound -> IdSet . eq ids(Depth:Bound # Nodes:Bound) = ids[0](0,Depth:Bound # unbounded,all)< unbounded > . op ids : Nat Bound -> IdSet . eq ids(Attack:Nat,Depth:Bound) = ids[0](Attack:Nat,Depth:Bound # unbounded,all)< unbounded > . op ids`(_`,_#_`) : Nat Bound Bound -> IdSet . eq ids(Attack:Nat,Depth:Bound # Nodes:Bound) = ids[0](Attack:Nat,Depth:Bound # Nodes:Bound,all)< unbounded > . op ids : Bound Filters -> IdSet . eq ids(Depth:Bound,F:Filters) = ids[0](0,Depth:Bound # unbounded,F:Filters)< unbounded > . op ids`(_#_`,_`) : Bound Bound Filters -> IdSet . eq ids(Depth:Bound # Nodes:Bound,F:Filters) = ids[0](0,Depth:Bound # Nodes:Bound,F:Filters)< unbounded > . op ids : Nat Bound Filters -> IdSet . eq ids(Attack:Nat,Depth:Bound,F:Filters) = ids[0](Attack:Nat,Depth:Bound # unbounded,F:Filters)< unbounded > . op ids`(_`,_#_`,_`) : Nat Bound Bound Filters -> IdSet . eq ids(Attack:Nat,Depth:Bound # Nodes:Bound,F:Filters) = ids[0](Attack:Nat,Depth:Bound # Nodes:Bound,F:Filters)< unbounded > . op ids[_]`(_`) : Id-SMsgList Bound -> IdSet . eq ids[I:Id-SMsgList](Depth:Bound) = ids[I:Id-SMsgList](0,Depth:Bound # unbounded,all)< unbounded > . op ids[_]`(_#_`) : Id-SMsgList Bound Bound -> IdSet . eq ids[I:Id-SMsgList](Depth:Bound # Nodes:Bound) = ids[I:Id-SMsgList](0,Depth:Bound # Nodes:Bound,all)< unbounded > . op ids[_]`(_`,_`) : Id-SMsgList Nat Bound -> IdSet . eq ids[I:Id-SMsgList](Attack:Nat,Depth:Bound) = ids[I:Id-SMsgList](Attack:Nat,Depth:Bound # unbounded,all)< unbounded > . op ids[_]`(_`,_#_`) : Id-SMsgList Nat Bound Bound -> IdSet . eq ids[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound) = ids[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound,all)< unbounded > . op ids[_]`(_`,_`) : Id-SMsgList Bound Filters -> IdSet . eq ids[I:Id-SMsgList](Depth:Bound,F:Filters) = ids[I:Id-SMsgList](0,Depth:Bound # unbounded,F:Filters)< unbounded > . op ids[_]`(_#_`,_`) : Id-SMsgList Bound Bound Filters -> IdSet . eq ids[I:Id-SMsgList](Depth:Bound # Nodes:Bound,F:Filters) = ids[I:Id-SMsgList](0,Depth:Bound # Nodes:Bound,F:Filters)< unbounded > . op ids[_]`(_`,_`,_`) : Id-SMsgList Nat Bound Filters -> IdSet . eq ids[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters) = ids[I:Id-SMsgList](Attack:Nat,Depth:Bound # unbounded,F:Filters)< unbounded > . op ids[_]`(_`,_#_`,_`) : Id-SMsgList Nat Bound Bound Filters -> IdSet . eq ids[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound,F:Filters) = ids[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound,F:Filters)< unbounded > . op ids`(_`)<_> : Bound Bound -> IdSet . eq ids(Depth:Bound)< Sess:Bound > = ids[0](Depth:Bound)< Sess:Bound > . op ids`(_#_`)<_> : Bound Bound Bound -> IdSet . eq ids(Depth:Bound # Nodes:Bound)< Sess:Bound > = ids[0](Depth:Bound # Nodes:Bound)< Sess:Bound > . op ids`(_`,_`)<_> : Nat Bound Bound -> IdSet . eq ids(Attack:Nat,Depth:Bound)< Sess:Bound > = ids[0](Attack:Nat,Depth:Bound,all)< unbounded > . op ids`(_`,_#_`)<_> : Nat Bound Bound Bound -> IdSet . eq ids(Attack:Nat,Depth:Bound # Nodes:Bound)< Sess:Bound > = ids[0](Attack:Nat,Depth:Bound # Nodes:Bound,all)< unbounded > . op ids`(_`)<_> : Bound Bound -> IdSet . eq ids(Depth:Bound)< Sess:Bound > = ids[0](0,Depth:Bound,all)< unbounded > . op ids`(_#_`)<_> : Bound Bound Bound -> IdSet . eq ids(Depth:Bound # Nodes:Bound)< Sess:Bound > = ids[0](0,Depth:Bound # Nodes:Bound,all)< unbounded > . op ids[_]`(_`)<_> : Id-SMsgList Bound Bound -> IdSet . eq ids[I:Id-SMsgList](Depth:Bound)< Sess:Bound > = ids[I:Id-SMsgList](0,Depth:Bound # unbounded,all)< Sess:Bound > . op ids[_]`(_#_`)<_> : Id-SMsgList Bound Bound Bound -> IdSet . eq ids[I:Id-SMsgList](Depth:Bound # Nodes:Bound)< Sess:Bound > = ids[I:Id-SMsgList](0,Depth:Bound # Nodes:Bound,all)< Sess:Bound > . op ids[_]`(_`,_`)<_> : Id-SMsgList Nat Bound Bound -> IdSet . eq ids[I:Id-SMsgList](Attack:Nat,Depth:Bound)< Sess:Bound > = ids[I:Id-SMsgList](Attack:Nat,Depth:Bound,all )< Sess:Bound > . op ids[_]`(_`,_#_`)<_> : Id-SMsgList Nat Bound Bound Bound -> IdSet . eq ids[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound)< Sess:Bound > = ids[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound,all )< Sess:Bound > . op ids[_]`(_`,_`)<_> : Id-SMsgList Bound Filters Bound -> IdSet . eq ids[I:Id-SMsgList](Depth:Bound,F:Filters)< Sess:Bound > = ids[I:Id-SMsgList](0,Depth:Bound,F:Filters)< Sess:Bound > . op ids[_]`(_#_`,_`)<_> : Id-SMsgList Bound Bound Filters Bound -> IdSet . eq ids[I:Id-SMsgList](Depth:Bound # Nodes:Bound,F:Filters)< Sess:Bound > = ids[I:Id-SMsgList](0,Depth:Bound # Nodes:Bound,F:Filters)< Sess:Bound > . op ids[_]`(_`,_`,_`)<_> : Id-SMsgList Nat Bound Filters Bound -> IdSet . eq ids[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters)< Sess:Bound > = getId(run[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters,unbounded)< Sess:Bound >) . op ids[_]`(_`,_#_`,_`)<_> : Id-SMsgList Nat Bound Bound Filters Bound -> IdSet . eq ids[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound,F:Filters)< Sess:Bound > = getId(debug[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters,Nodes:Bound)< Sess:Bound >) . *** General Tools **************************************** op run`(_`)<_> : Bound Bound -> IdSystemSet-or-Error . eq run(Depth:Bound)< Sess:Bound > = run[0](0,Depth:Bound,all,unbounded)< Sess:Bound > . op run`(_#_`)<_> : Bound Bound Bound -> IdSystemSet-or-Error . eq run(Depth:Bound # Nodes:Bound)< Sess:Bound > = run[0](0,Depth:Bound,all,Nodes:Bound)< Sess:Bound > . op run[_]`(_`)<_> : Id-SMsgList Bound Bound -> IdSystemSet-or-Error . eq run[I:Id-SMsgList](Depth:Bound)< Sess:Bound > = run[I:Id-SMsgList](0,Depth:Bound,all,unbounded)< Sess:Bound > . op run[_]`(_#_`)<_> : Id-SMsgList Bound Bound Bound -> IdSystemSet-or-Error . eq run[I:Id-SMsgList](Depth:Bound # Nodes:Bound)< Sess:Bound > = run[I:Id-SMsgList](0,Depth:Bound,all,Nodes:Bound)< Sess:Bound > . op run[_]`(_`,_`)<_> : Id-SMsgList Nat Bound Bound -> IdSystemSet-or-Error . eq run[I:Id-SMsgList](Attack:Nat,Depth:Bound)< Sess:Bound > = run[I:Id-SMsgList](Attack:Nat,Depth:Bound,all,unbounded)< Sess:Bound > . op run[_]`(_`,_#_`)<_> : Id-SMsgList Nat Bound Bound Bound -> IdSystemSet-or-Error . eq run[I:Id-SMsgList](Attack:Nat,Depth:Bound # Nodes:Bound)< Sess:Bound > = run[I:Id-SMsgList](Attack:Nat,Depth:Bound,all,Nodes:Bound)< Sess:Bound > . op run[_]`(_`,_`)<_> : Id-SMsgList Bound Filters Bound -> IdSystemSet-or-Error . eq run[I:Id-SMsgList](Depth:Bound,F:Filters)< Sess:Bound > = run[I:Id-SMsgList](0,Depth:Bound,F:Filters,unbounded)< Sess:Bound > . op run[_]`(_#_`,_`)<_> : Id-SMsgList Bound Bound Filters Bound -> IdSystemSet-or-Error . eq run[I:Id-SMsgList](Depth:Bound # Nodes:Bound,F:Filters)< Sess:Bound > = run[I:Id-SMsgList](0,Depth:Bound,F:Filters,Nodes:Bound)< Sess:Bound > . op run[_]`(_`,_`,_`,_`)<_> : Id-SMsgList Nat Bound Filters Bound Bound -> IdSystemSet-or-Error . eq run[I:Id-SMsgList](Attack:Nat,Depth:Bound,F:Filters,Nodes:Bound)< Sess:Bound > = if true ***Does extractAttack(Attack:Nat) ***UnifyWith new-strands? then if extractAttack(Attack:Nat) :: Attack then changeShortSystem(F:Filters, search( extractAttack(Attack:Nat), if I:Id-SMsgList :: Id then filterId(I:Id-SMsgList) else filterSMsgList(extract(I:Id-SMsgList)) fi no+debug(F:Filters), Depth:Bound,Nodes:Bound,Sess:Bound,true ) ) else errorInAttackStateinFile fi else errorOneStrandInAttackStateDoesNotUnifyWithAnyfProtocolStrands fi . op extractAttack : Nat ~> Attack . ceq extractAttack(N:Nat) = downAttack(extract('ATTACK-STATE[upTerm(N:Nat)], PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) if extract('ATTACK-STATE[upTerm(N:Nat)], PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE) :: Term . ceq extractAttack(N:Nat) = downProcessAttack(extract('ATTACK-PROCESS[upTerm(N:Nat)], PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE)) if extract('ATTACK-PROCESS[upTerm(N:Nat)], PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE) :: Term . op changeShortSystem : Filters IdSystemSet-or-Error -> IdSystemSet-or-Error . eq changeShortSystem(F:Filters,X:IdSystemSet-or-Error) = if +debug !in F:Filters and X:IdSystemSet-or-Error :: IdSystemSet then changeShortSystem*(X:IdSystemSet-or-Error) else X:IdSystemSet-or-Error fi . op changeShortSystem* : IdSystemSet -> IdSystemSet . eq changeShortSystem*(empty) = empty . eq changeShortSystem*(IST:IdSystemSet < I:Id > SS:StrandSet || K:IntruderKnowledge || ML:SMsgList || GL:GhostList || PP:Properties) = (< I:Id > SS:StrandSet | changeShortSystem**(K:IntruderKnowledge) | ML:SMsgList | changeShortSystem*(GL:GhostList)) changeShortSystem*(IST:IdSystemSet) . op changeShortSystem* : GhostList -> GhostList . eq changeShortSystem*( ghost(M:Msg,SS:StrandSet,K:IntruderKnowledge,ML:SMsgList,PP:Properties), GL:GhostList) = (ghost(M:Msg), changeShortSystem*(GL:GhostList)) . eq changeShortSystem*(nil) = nil . op changeShortSystem** : IntruderKnowledge -> IntruderKnowledge . eq changeShortSystem**((X:Knowledge-inst,Y:IntruderKnowledge)) = changeShortSystem**(Y:IntruderKnowledge) . eq changeShortSystem**((X:Knowledge-irr,Y:IntruderKnowledge)) = changeShortSystem**(Y:IntruderKnowledge) . eq changeShortSystem**((X:Knowledge-CPSA,Y:IntruderKnowledge)) = changeShortSystem**(Y:IntruderKnowledge) . eq changeShortSystem**(Y:IntruderKnowledge) = Y:IntruderKnowledge [owise] . *** 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 displayGrammars : -> [GrammarList] . eq displayGrammars = cleanGrammars(genGrammars(unbounded)) . op cleanGrammars : [GrammarList] -> [GrammarList] . eq cleanGrammars(none) = none . eq cleanGrammars(G:Grammar | GS:GrammarList) = if G:Grammar :: errorGrammar then cleanGrammars(GS:GrammarList) else G:Grammar | cleanGrammars(GS:GrammarList) fi . op genGrammars : -> [GrammarList] [ditto] . --- Standard grammar generation eq genGrammars = genGrammars(unbounded) . op genGrammars : Bound -> [GrammarList] . ceq genGrammars(B:Bound) = if M:[Module] :: Module then X:GrammarList else errorInProtocolStrands fi if M:[Module] := PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE /\ X:GrammarList := downTerm( extract('GENERATED-GRAMMARS.GrammarList,M:[Module]), (none).GrammarList) /\ X:GrammarList =/= none . ceq genGrammars(B:Bound) = if not (M:[Module] :: Module) then errorInProtocolStrands else if USER:[Term] :: Term and USER:[Grammar&StrategyList] :: Grammar&StrategyList then genGrammars*(B:Bound,none,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,none, genAllGrammars | EXTRA:[Grammar&StrategyList]) else if EXTRA:[Term] :: Term then (errorInUserSeedTerms).[GrammarList] else genGrammars*(B:Bound,none,genAllGrammars) fi fi fi fi fi if M:[Module] := PROTOCOL-SPECIFICATION-FIX-IRREDUCIBLE /\ USER:[Term] := extract('INITIAL-GRAMMARS.Grammar&StrategyList,M:[Module]) /\ USER:[Grammar&StrategyList] := downTerm(USER:[Term],(none).Grammar&StrategyList) /\ EXTRA:[Term] := extract('EXTRA-GRAMMARS.Grammar&StrategyList,M:[Module]) /\ EXTRA:[Grammar&StrategyList] := downTerm(EXTRA:[Term],(none).Grammar&StrategyList) . op genGrammars* : Bound GrammarList Grammar&StrategyList -> GrammarList . eq genGrammars*(B:Bound, GS:GrammarList,G:Grammar&StrategyList) = if B:Bound :: Nat and-then B:Bound > 1 and-then genGrammars**(B:Bound, GS:GrammarList,G:Grammar&StrategyList) == genGrammars**(sd(B:Bound,1), GS:GrammarList,G:Grammar&StrategyList) then sameGrammarListAsPreviousBound else genGrammars**(B:Bound, GS:GrammarList,G:Grammar&StrategyList) fi . op genGrammars** : Bound GrammarList Grammar&StrategyList -> GrammarList . eq genGrammars**(B:Bound, GS:GrammarList, none) = GS:GrammarList . eq genGrammars**(B:Bound, GS:GrammarList, (G:Grammar ! S:GlobalStrategy) | G:Grammar&StrategyList) = genGrammars**(B:Bound, GS:GrammarList | filterEmpty(grammarsGeneration(S:GlobalStrategy,B:Bound,G:Grammar)), 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 and-then not (metadata("grammar-arg-1") in AtS) --- Do not generate grammars for special grammar symbols 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] . ******* unificationMechanism *********************************************** op unification? : -> String . eq unification? = stringQ(unification??) . op stringQ : QidList -> String . eq stringQ(Q1:Qid Q2:Qid QL:QidList) = string(Q1:Qid) + " " + stringQ(Q2:Qid QL:QidList) . eq stringQ(Q1:Qid) = string(Q1:Qid) . eq stringQ(nil) = "" . op unificationQid : -> Qid . eq unificationQid = if IsMetaHEUnify(upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true)) then 'homomorphic else if IsMetaXORUnify(upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true)) then 'exclusive-or else if getEqsVariant(upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true)) == none then 'built-in else 'variants fi fi fi . op unification?? : -> QidList . eq unification?? = if unificationQid == 'homomorphic then 'Unification 'modulo 'homomorphic 'symbol getOperatorE(upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true)) 'over 'symbol getOperatorP(upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true)) else if unificationQid == 'exclusive-or then 'Unification 'modulo 'exclusive-or 'symbol getXor(getEqs(upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true))) 'with 'identity 'symbol getNil(getEqs(upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true))) else if unificationQid == 'built-in then 'Unification 'using 'built-in 'Maude 'algorithm 'for 'combinations 'of 'C 'AC 'ACU else 'Unification 'using 'variant 'narrowing 'with 'equations 'for 'symbols getOpsOfEqs(getEqsVariant(upModule('PROTOCOL-EXAMPLE-ALGEBRAIC,true))) fi fi fi . 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 loop init . set show advisories off . ***( The informal journal-level description of this protocol is as follows: A --> B: A ; B ; exp(g,N_A) B --> A: A ; B ; exp(g,N_A) A --> B: enc(exp(exp(g,N_B),N_A),secret(A,B)) where N_A and N_B are nonces, exp(x,y) means x raised to y, enc(x,y) means message y encripted using key x, and secret(A,B) is a secret shared between A and B. Moreover, exponentiation and encription/decription have the following algebraic properties: exp(exp(X,Y),Z) = exp(X, Y * Z) e(K,d(K,M)) = M . d(K,e(K,M)) = M . where * is the xor operator, though no algebraic property is given, since they are not necessary for this protocol. However, note that the property for exponentiation is restricted below by using appopriate sorts in such a way that variable X can be only the generator g. This is necessary to have a finitary unification procedure based on narrowing. )*** fmod PROTOCOL-EXAMPLE-SYMBOLS is --- Importing sorts Msg, Fresh, Public 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 NeNonceSet Gen Exp Key GenvExp Secret . subsort Gen Exp < GenvExp . subsort Name NeNonceSet GenvExp Secret Key < Msg . subsort Exp < Key . subsort Name < Public . --- This is quite relevant and necessary subsort Gen < Public . --- This is quite relevant and necessary --- Secret op sec : Name Fresh -> Secret [frozen] . --- Nonce operator op n : Name Fresh -> Nonce [frozen] . --- Intruder ops a b i : -> Name . --- Encryption op e : Key Msg -> Msg [frozen] . op d : Key Msg -> Msg [frozen] . --- Exp op exp : GenvExp NeNonceSet -> Exp [frozen] . --- Gen op g : -> Gen . --- NeNonceSet subsort Nonce < NeNonceSet . op _*_ : NeNonceSet NeNonceSet -> NeNonceSet [frozen assoc comm] . --- Concatenation op _;_ : Msg Msg -> Msg [frozen gather (e E)] . endfm fmod PROTOCOL-EXAMPLE-ALGEBRAIC is protecting PROTOCOL-EXAMPLE-SYMBOLS . ---------------------------------------------------------- --- Overwrite this module with the algebraic properties --- of your protocol ---------------------------------------------------------- eq exp(exp(W:Gen,Y:NeNonceSet),Z:NeNonceSet) = exp(W:Gen, Y:NeNonceSet * Z:NeNonceSet) [variant] . eq e(K:Key,d(K:Key,M:Msg)) = M:Msg [variant] . eq d(K:Key,e(K:Key,M:Msg)) = M:Msg [variant] . endfm fmod PROTOCOL-SPECIFICATION is protecting PROTOCOL-EXAMPLE-SYMBOLS . protecting DEFINITION-PROTOCOL-RULES . protecting DEFINITION-CONSTRAINTS-INPUT . ---------------------------------------------------------- --- Overwrite this module with the strands --- of your protocol ---------------------------------------------------------- vars NS1 NS2 NS3 NS : NeNonceSet . var NA NB N : Nonce . var GE : GenvExp . var G : Gen . vars A B : Name . vars r r' r1 r2 r3 : Fresh . var Ke : Key . vars XE YE : Exp . vars M M1 M2 : Msg . var Sr : Secret . eq STRANDS-DOLEVYAO = :: nil :: [ nil | -(M1 ; M2), +(M1), nil ] & :: nil :: [ nil | -(M1 ; M2), +(M2), nil ] & :: nil :: [ nil | -(M1), -(M2), +(M1 ; M2), nil ] & :: nil :: [ nil | -(Ke), -(M), +(e(Ke,M)), nil ] & :: nil :: [ nil | -(Ke), -(M), +(d(Ke,M)), nil ] & :: nil :: [ nil | -(NS1), -(NS2), +(NS1 * NS2), nil ] & :: nil :: [ nil | -(GE), -(NS), +(exp(GE,NS)), nil ] & :: r :: [ nil | +(n(i,r)), nil ] & :: nil :: [ nil | +(g), nil ] & :: nil :: [ nil | +(A), nil ] [nonexec] . eq STRANDS-PROTOCOL = :: r,r' :: [nil | +(A ; B ; exp(g,n(A,r))), -(A ; B ; XE), +(e(exp(XE,n(A,r)),sec(A,r'))), nil] & :: r :: [nil | -(A ; B ; XE), +(A ; B ; exp(g,n(B,r))), -(e(exp(XE,n(B,r)),Sr)), nil] [nonexec] . eq EXTRA-GRAMMARS = (grl empty => (NS * n(a,r)) inL . ; grl empty => n(a,r) inL . ; grl empty => (NS * n(b,r)) inL . ; grl empty => n(b,r) inL . ! S2 ) [nonexec] . eq ATTACK-STATE(0) = :: r :: [nil, -(a ; b ; XE), +(a ; b ; exp(g,n(b,r))), -(e(exp(XE,n(b,r)),sec(a,r'))) | nil] || empty || nil || nil || never *** Pattern for authentication (:: R:FreshSet :: [nil | +(a ; b ; XE), -(a ; b ; exp(g,n(b,r))), +(e(YE,sec(a,r'))), nil] & S:StrandSet || K:IntruderKnowledge) [nonexec] . eq ATTACK-STATE(1) = :: r :: [nil, -(a ; b ; XE), +(a ; b ; exp(g,n(b,r))), -(e(exp(XE,n(b,r)),sec(a,r'))) | nil] || sec(a,r') inI || nil || nil || nil [nonexec] . eq ATTACK-STATE(2) = :: r :: [nil, -(a ; b ; XE), +(a ; b ; exp(g,n(b,r))), -(e(exp(XE,n(b,r)),sec(a,r'))) | nil] || sec(a,r') inI || nil || nil || never( *** Avoid infinite useless path (:: nil :: [ nil | -(exp(GE,NS1 * NS2)), -(NS3), +(exp(GE,NS1 * NS2 * NS3)), nil ] & S:StrandSet || K:IntruderKnowledge) *** Pattern to avoid unreachable states (:: nil :: [nil | -(exp(#1:Exp, N1:Nonce)), -(sec(A:Name, #2:Fresh)), +(e(exp(#1:Exp, N2:Nonce), sec(A:Name, #2:Fresh))), nil] & S:StrandSet || K:IntruderKnowledge) *** Pattern to avoid unreachable states (:: nil :: [nil | -(exp(#1:Exp, N1:Nonce)), -(e(exp(#1:Exp, N1:Nonce), S:Secret)), +(S:Secret), nil] & S:StrandSet || K:IntruderKnowledge) *** Pattern to avoid unreachable states (S:StrandSet || (#4:Gen != #0:Gen), K:IntruderKnowledge) ) [nonexec] . endfm --- THIS HAS TO BE THE LAST LOADED MODULE !!!! select MAUDE-NPA . red summary(1,1) . red summary(1,2) . red summary(1,3) . red summary(1,4) . red summary(1,5) . red summary(1,6) . red summary(1,7) . red summary(1,8) . red summary(1,9) . red summary(1,10) . red summary(1,11) . red summary(1,12) . red summary(1,13) .