1---- To be run on Maude 2.7.1 (alpha 110b) 2---- author: Francisco Duran 3---- printSyntaxError functionality by Peter Olveczky 4---- narrowing search by Santiago Escobar 5 6set show loop stats off . 7set show loop timing off . 8set show advisories off . 9 10fmod BANNER is 11 pr STRING . 12 op banner : -> String . 13 eq banner = "Full Maude 2.7.1 June 30th 2016" . 14endfm 15 16***( 17 This file is part of the Maude 2 interpreter. 18 19 Copyright 1997-2003 SRI International, Menlo Park, CA 94025, USA. 20 21 This program is free software; you can redistribute it and/or modify 22 it under the terms of the GNU General Public License as published by 23 the Free Software Foundation; either version 2 inclof the License, or 24 (at your option) any later version. 25 26 This program is distributed in the hope that it will be useful, 27 but WITHOUT ANY WARRANTY; without even the implied warranty of 28 MERCHANTABILITY or FITNSS FOR A PARTICULAR PURPOSE. See the 29 GNU General Public License for more details. 30 31 You should have received a copy of the GNU General Public Leicense 32 along with this program; if not, write to the Free Software 33 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. 34) 35 36---- to do: 37---- - continue . 38---- - show search graph . 39---- - show path <number> . 40---- - show path labels <number> . 41---- - show components . 42 43---- Main changes and bugs fixed: 44---- 45---- - May 19th, 2016 46---- - Adapted to the new syntax for variants in Alpha109 47---- - Feb 4th, 2016 48---- - The MOD-EXPRS module is renamed to FM-MOD-EXPRS, and a MOD-EXPRS is later 49---- introduced. Now, new module expressions can be used anywhere by redefining 50---- this new MOD-EXPRS module. Although FM could be extended to handle new 51---- module expressions, these were not supported inside "in" sections of 52---- commands. 53---- - Oct 19th, 2015 54---- - bug in the search command on OO modules (reported by Pete Olveczky) 55---- - Oct 12th, 2015 56---- - iter supported by built-in unification, checks adjusted accordingly 57---- - Feb 18th, 2015 58---- - An operator <_[,_]*> was added to the modules for narrowing. It has been 59---- renamed as @<@_[,_]*@>@ to avoid clashes with user-defined operators. 60---- - acu coherence completion has been renamed to ax coherence completion. 61---- This applies to the acu coherence completion [<module-name>] ., to the 62---- metalevel operation axCohComplete and to the module AX-COHERENCE-COMPLETION. 63---- The completion was already performed for the different combinations of 64---- attributes, but the name was the original one. 65---- - Nov 12th, 2014 66---- - Classes without attributes may be defined as class Foo . or class Foo | . 67---- Requested by A. Riesco. 68---- - Parameter sorts used in sort constraints were not appropriately instantiated. 69---- Reported by A. Riesco. 70---- - July 14th, 2014 71---- - Fixed bug in the parsing of terms with operators '=' or '=>'. Although the first-level 72---- parsing was done correctly, to solve bubbles an operator = (resp. =>) was introduced 73---- to handle equations (resp. rules). Reported by Adrian Riesco. 74---- - Fixed bug on the pretty printing of views. Typical error on structures with id elements. 75---- Probably due to changes in the definion of map sets. Reported by Adrian Riesco. 76---- - September 12th, 2013 77---- - Bug in ACU completion when handling modules with explicit use of kinds. Reported 78---- by Luis Aguirre 79---- - December 12th, 2013 80---- - Bug in the renaming of operators with explicit arity where parameterized sorts 81---- are used. 82---- - Bug in the renaming of ac operators fixed. Given an acu operator __, a term 83---- card(E E S, C) was not renamed. 84---- - July 24th, 2012 85---- - commands remove ids and remove non-handled ids available 86---- - July 7th, 2012 87---- - A bug in the removal of identity attributes has been fixed. A metadata("variant") 88---- was expected in all equations to be used to generate the variants. To be consistent 89---- to the new built-in getVariants function I'm using the attribute variant instead 90---- of the metadata. 91---- - March 20th, 2012 92---- - Core Maude views are now accessible from Full Maude. Full Maude do not require 93---- explicit sort maps any more. 94---- - The set of more general eqs and rls (moreGeneralEqs and moreGeneralRls ops) 95---- is now correctly calculated. These functions are used in several places, for 96---- example, in the functions and commands to eliminate identity attributes and in 97---- the completion procedures. 98---- Reported by Santiago Escobar. 99---- - October 24th, 2011 100---- - format attribute was not correctly handled. Equation missing in the downAttr op. 101---- - July 13th, 2011 102---- - A bug on the load metamodule command making it fail when loading a metamodule 103---- with a metadata attribute has been fixed. 104---- Reported by Tobias Muhlbauer and Jonas Eckhardt. 105---- - December 5th, 2009 106---- - New command (remove id attributes [<module-expr.>] .) that shows the 107---- module with the id attributes removed using variants. 108---- - New command (remove assoc attributes [<module-expr.>] .) that shows the 109---- module with the assoc (if not with comm) attributes removed using variants. 110---- - November 22nd, 2009 111---- - A new version of the narrowing/unification stuff by S. Escobar fixing a bug in the 112---- getVariants function and incorporating some other changes. 113---- To integrate it into Full Maude: 114---- - The TERMSET module is moved, so that now Full Maude uses it instead of its 115---- definition of term sets. In the original module by Santiago this module imported 116---- the SUBSTITUTION-HANDLING module; this importation is now commented out. 117---- - October 4th, 2009 118---- - New (acu coherence completion .) / (acu coherence completion <Module> .) command. 119---- It shows result of completing the flatten version of the module for acu coherence. 120---- - Setember 11th, 2009 121---- - sort Set<List<Type>> replaced by the TypeListSet sort from META-MODULE 122---- - sort List<Set<Type>> renamed as TypeSetList 123---- - MAYBE removed, DEFAULT-VALUE used instead. MAYBE{TERM} replaced by DEFAULT-VALUE{Term} 124---- - July 28th, 2009 125---- - Some cleaning up. Some of the changes may break other applications. 126---- - April 18th, 2009 127---- - The metadata attribute is now available for operation declarations. Reported by A. Riesco. 128---- - Fixed bug in the handling of ditto. ctor and metadata attributes were copied. 129---- - March 9th, 2009 130---- - Bug in the search command. The number of solutions argument was used as depth bound. Reported by P. Olveczky. 131---- - New (remove id attributes .) / (remove id attributes <Module> .) command 132---- It shows an equivalent version of the flatten module without ids using variants. 133---- - March 9th, 2009 134---- - Bug in the handling of mbs/cmbs. Sorts in bubbles were not handled correctly. Reported by T. Serbanuta. 135---- - February 12th, 2009 136---- - The summation module expression now generates a module 137---- fmod A + B + C is 138---- inc A . 139---- inc B . 140---- inc C . 141---- endfm 142---- for a module expression A + B + C. 143---- - February 6th, 2009 144---- - Fixed a bug in the id-unify command. Fixed by Santiago Escobar 145---- - February 3rd, 2009 146---- - Missing equation for downAttr, for the case of nonexec 147---- - Missing declaration in the CONFIGURATION+ module to handle class declarations with no attributes 148---- - January 29th, 2009 149---- - The downModule operation has been extended to be able to handle oo metamodules. 150---- Note that omod metamodules are defined in the UNIT Full Maude module. Therefore, 151---- to be able to do things like 152---- (load omod ... endm .) 153---- the current module must be the FM UNIT module or one extending it. 154---- - January 28th, 2009 155---- - A bug in downAttr. Found thanks to a problem with metamodule load. Reported by Peter Olveczky. 156---- - January 8th, 2009 157---- - A bug in the narrowing functionality. It was narrowing on frozen positions. 158---- (fixed by Santiago Escobar) 159---- - December 20th, 2008 160---- - Fixed a bug in the handling of the such-that part of search commands. 161---- Reported by Enrique Martin. 162---- - December 17th, 2008 163---- - A new search_~>_ family of commands (as for search_=>_) is now available. 164---- The commands are implemented by Santiago Escobar. 165---- - December 8th, 2008 166---- - A new meta-module load command is available. 167---- It enters a metamodule into Full Maude's database of modules. 168---- Asked by Peter Olveczky and Jose Meseguer. 169---- The syntax for the new command is (load <meta-module> .), where <meta-module is any term of sort 170---- Module, either a term of the form fmod...endfm or any other expression reducing to a module. 171---- Thus, you can write things like 172---- 173---- (select META-LEVEL .) 174---- 175---- (load fmod 'FOO is 176---- including 'BOOL . 177---- sorts 'Foo . 178---- none 179---- op 'f : nil -> 'Foo [none] . 180---- op 'g : nil -> 'Foo [none] . 181---- none 182---- eq 'f.Foo = 'g.Foo [none] . 183---- endfm .) 184---- 185---- or 186---- 187---- (load upModule('NAT, true) .) 188---- 189---- - September 18th, 2008 190---- The search command now supports its complete generality (maximum depth couln't be given). Bug reported by Zhang Min. 191---- The unify command is now supported. 192---- Bug in the renaming of partial operations fixed. Reported by Edu Rivera. 193---- - April 2nd, 2008 194---- Bug in the application of views (and renamings) with kinds in the specification 195---- of op renamings. It appears in an example in which the sort was coming from a theory. 196---- Reported by A. Boronat. 197---- - March 24th, 2008 198---- Bug in the application of renamings to op hooks. Reported by A. Boronat 199---- - March 17th, 2008 200---- Bug in the instantiation of parameterized sorts in sort memberships. 201---- Reported by A. Boronat 202---- - March 14th, 2008 203---- Bug in the handling of parameterized module expressions. When the parameterers 204---- are not right, the system hangs. Reported by A. Verdejo. 205---- - March 9th, 2008 206---- Statement attributes of membership axioms were not correctly handled. 207---- Reported by A. Riesco & A. Verdejo 208---- - Feb 18th, 2008 209---- Bug in the renaming of operators 210---- - Feb 14th, 2008 211---- Statement attributes of membership axioms were not correctly handled. 212---- Reported by A. Riesco & A. Verdejo 213---- - Dec 17th, 2007 214---- Rule in CONFIGURATION+ was causing non-termination 215---- - Dec 13th, 2007 216---- Change in the specification of the transform function to allow new types of modules 217---- - Nov 23rd, 2007 218---- Bug in the evaluation of expressions in commands (red in FOO + BAR : ...) 219---- - Oct 5th, 2007 220---- Bug in down of modules (reported by Pedro Ojeda) 221---- - July 31st, 2007 222---- bug in the application of maps to terms 223---- - July 31st, 2007 224---- bug in getThClasses 225---- (reported by Marisol) 226---- - (october 17th, 2006) 227---- Changes in Alpha88a's prelude are now correctly handled 228---- - (july 22nd, 2006) 229---- Bug in the meta-pretty-print of types. 230---- - (july 21st, 2006) 231---- Object-oriented messages where not given the attribute msg 232---- (from a comment by Peter). 233---- - (reported by Radestock) 234---- getSort was not handling parameterized sorts appropriately. 235---- - the set protect/extend/include off commands didn't work if the 236---- module not importing was not among the imported ones 237---- 238---- Last changes: 239---- 240---- - May 21st, 2007 241---- GRAMMAR now extends a module BUBBLES with all bubble delcarations. 242---- This BUBBLES module is also used to define the GRAMMAR-RED, GRAMMAR-REW, ... 243---- modules. 244---- 245---- - May 19th, 2007 246---- procCommand changed. It now returns a Tuple{Database, QidList} instead of 247---- just a QidList. Since some modules may need to be compiled for the 248---- execution of a command, the resulting database is returned and used as 249---- new database. 250---- 251---- - May 19th, 2007 252---- proRew takes now one argument less. The Bound (4th arg.) was unnecessary. 253---- 254---- - BOOL is included, instead of protected, into any entered module. 255---- 256---- - A new module expression POWER[n] is now available. A module expression 257---- POWER[n]{Nat} produces a module 258---- 259---- fmod POWER[n]{X :: TRIV} is 260---- inc TUPLE[n]{X, X, ..., X} . 261---- endfm 262---- 263---- which is then instantiated by the Nat view. 264 265---- - (July 18th, 2006) 266---- The summation module expression now generates a module 267---- that includes (instead of protect) its summands. 268---- 269---- - All sorts declared in modules used for parsing have been renamed. 270---- Any sort S in one of these modules is nos called @S@. 271---- Since some of these modules where added to the user defined modules 272---- for dealing with ups, conditions, etc., he was getting error when 273---- using sorts like Token or OpDecl in his specs. 274---- 275---- - Syntax for parameterization has been changed (again) !!! : 276---- - module definition: FOO{X :: TRIV, Y :: TRIV} 277---- - module instantiation: FOO{Bar,Baz} 278---- - parameterized sorts: Foo{Bar,Baz} 279---- 280---- - Any module loaded in Core Maude can be used in Full Maude. 281---- This may be particularly useful in the case of using the model checker. 282---- 283---- (mod CHECK-RESP is 284---- protecting MODEL-CHECKER . 285---- ... 286---- endm) 287---- 288---- (red p(0) |= (<> Qstate) .) 289---- 290---- - Module renaming and summation consistent with Core Maude's. Built-ins 291---- are now handled at the metalevel, instead of leaving the inclusions to 292---- Core Maude. In this way, they can be renamed and redefined, as in 293---- Core Maude. This makes Full Maude slower. 294---- 295---- - The lazy evaluation of modules is working. When a module is redefined 296---- its dependent modules are removed only if generated internally. Those 297---- introduced by the user save their term representation, from which the 298---- whole processing can take place. They will be recompiled by need. 299---- 300---- - The form of qualifying sorts coming from the parameters in 301---- parameterized modules has changed AGAIN: The sort Elt coming from 302---- X :: TRIV is now written as X$Elt (Note that sort names cannot contain 303---- dots anymore). 304---- 305---- - Tuples are built with the syntax 306---- TUPLE[size]{comma_separated_list_of_views} 307---- For example, given a view Nat from TRIV to NAT we can define pairs of 308---- nats with TUPLE[2]{Nat, Nat}. 309---- 310---- - The model-checker is loaded before the full maude modules, so that 311---- it can be used. 312---- 313---- - Object-oriented modules include a module CONFIGURATION+, which 314---- imports CONFIGURATION, defines a function 315---- op class : Object -> Cid . 316---- returning the actual class of the given object, and add syntax 317---- for objects with no attributes <_:_| >. Classes without attributes 318---- are defined with syntax class CLASS-NAME . 319---- 320---- Things to come: 321---- 322---- - Commands missing: continue ... 323---- 324---- - On parameterized theories and views: linked parameters, composed and 325---- lifted views, and default views. 326---- 327---- - ops names in op declarations 328---- 329---- known bugs: 330---- 331---- - error messages could be given in down commands 332---- 333---- - Check: perhaps we need to convert constants back into vbles in 334---- procViewAux 335---- 336---- - Parameterized sorts don't work in sort constraints (nor by themselves, 337---- nor in the conditions of axioms. They are accepted in their equivalent 338---- single token form but do not get instantiated 339---- cmb (A, B) S : PFun(X, Y) if not(A in dom(S)) /\ S : PFun`(X`,Y`) . 340---- 341 342set include BOOL off . 343set include TRUTH-VALUE on . 344set show advisories off . 345 346mod CONFIGURATION is 347 sorts Attribute AttributeSet . 348 subsort Attribute < AttributeSet . 349 op none : -> AttributeSet [ctor] . 350 op _,_ : AttributeSet AttributeSet -> AttributeSet [ctor assoc comm id: none] . 351 352 sorts Oid Cid Object Msg Portal Configuration . 353 subsort Object Msg Portal < Configuration . 354 op <_:_|_> : Oid Cid AttributeSet -> Object [ctor object] . 355 op none : -> Configuration [ctor] . 356 op __ : Configuration Configuration -> Configuration [ctor config assoc comm id: none] . 357 op <> : -> Portal [ctor] . 358endm 359 360mod CONFIGURATION+ is 361 including CONFIGURATION . 362 op <_:_|`> : Oid Cid -> Object . 363 op class : Object -> Cid . 364 ---- eq < O:Oid : C:Cid | > = < O:Oid : C:Cid | none > . 365 eq class(< O:Oid : C:Cid | A:AttributeSet >) = C:Cid . 366endm 367 368set include BOOL on . 369set include TRUTH-VALUE off . 370 371******************************************************************************* 372******************************************************************************* 373*** 374*** Narrowing and Equational Unification 375*** by Santiago Escobar 376*** 377fmod META-LEVEL-MNPA is 378 pr META-LEVEL * (op `{_`,_`} : Term Nat -> SmtResult to `{_`,_`}Smt ) . 379endfm 380 381fmod UNIFICATIONTRIPLE is 382 protecting META-LEVEL-MNPA . 383 protecting INT . 384 385 --- UnificationPair -------------------------------------------- 386 ---sorts UnificationPair UnificationPair? . 387 ---op {_,_} : Substitution Nat -> UnificationPair [ctor] . 388 ---subsort UnificationPair < UnificationPair? . 389 ---op noUnifier : -> UnificationPair? [ctor] . 390 391 op getSubst : UnificationPair -> Substitution . 392 eq getSubst({S1:Substitution, N:Nat}) = S1:Substitution . 393 op getNextVar : UnificationPair -> Nat . 394 eq getNextVar({S1:Substitution, N:Nat}) = N:Nat . 395 396 --- UnificationTriple -------------------------------------------- 397 ---sorts UnificationTriple UnificationTriple? . 398 ---op {_,_,_} : Substitution Substitution Nat -> UnificationTriple [ctor] . 399 ---subsort UnificationTriple < UnificationTriple? . 400 ---op noUnifier : -> UnificationTriple? [ctor] . 401 402 op getLSubst : UnificationTriple -> Substitution . 403 eq getLSubst({S1:Substitution, S2:Substitution, N:Nat}) = S1:Substitution . 404 op getRSubst : UnificationTriple -> Substitution . 405 eq getRSubst({S1:Substitution, S2:Substitution, N:Nat}) = S2:Substitution . 406 op getNextVar : UnificationTriple -> Nat . 407 eq getNextVar({S1:Substitution, S2:Substitution, N:Nat}) = N:Nat . 408 409endfm 410 411fmod TERM-HANDLING is 412 protecting META-TERM . 413 protecting META-LEVEL-MNPA . 414 protecting EXT-BOOL . *** For and-then 415 416 var T T' T'' : Term . 417 var C C' : Constant . 418 var QIL : QidList . 419 var N N' : Nat . 420 var NL NL' : NatList . 421 var Q F F' : Qid . 422 var AtS : AttrSet . 423 var EqS : EquationSet . 424 var Eq : Equation . 425 var Cond : Condition . 426 var TP : Type . 427 var TPL TPL' : TypeList . 428 var TL TL' TL'' : TermList . 429 var B : Bool . 430 var V V' : Variable . 431 var Ct : Context . 432 var CtL : NeCTermList . 433 var NeTL : NeTermList . 434 var M : Module . 435 436 *** root ****************************** 437 op root : Term -> Qid . 438 eq root(V) = V . 439 eq root(C) = C . 440 eq root(F[TL]) = F . 441 442 *** size ****************************** 443 op size : TermList -> Nat . 444 eq size(empty) = 0 . 445 eq size((T,TL)) = s(size(TL)) . 446 447 *** elem_of_ ***************************************************** 448 op elem_of_ : Nat TermList ~> Term . 449 eq elem 1 of (T,TL) = T . 450 eq elem s(s(N)) of (T,TL) = elem s(N) of TL . 451 452 *** subTerm_of_ ***************************************************** 453 op subTerm_of_ : NatList Term ~> Term . 454 eq subTerm NL of T = subTerm* NL of T . 455 456 op subTerm*_of_ : NatList Term ~> Term . 457 eq subTerm* nil of T = T . 458 eq subTerm* N NL of (F[TL]) = subTerm* NL of (elem N of TL) . 459 460 *** ToDo: UPGRADE THIS NOTION TO MODULO AC ********************* 461 *** is_subTermOf_ ***************************************************** 462 op is_subTermOf_ : Term TermList -> Bool . 463 eq is T subTermOf (T',NeTL) = is T subTermOf T' 464 or-else is T subTermOf NeTL . 465 eq is T subTermOf T = true . 466 eq is T subTermOf T' = is T subTermOf* T' [owise] . 467 468 op is_subTermOf*_ : Term TermList -> Bool . 469 eq is T subTermOf* (F[TL]) = is T subTermOf TL . 470 eq is T subTermOf* T' = false [owise] . 471 472 *** noVarOfSort_In_ ***************************************************** 473 op noVarOfSort_In_ : Type TermList -> Bool . 474 eq noVarOfSort T:Type In V = getType(V) =/= T:Type . 475 eq noVarOfSort T:Type In (F[TL]) = noVarOfSort T:Type In TL . 476 eq noVarOfSort T:Type In (T',NeTL) 477 = noVarOfSort T:Type In T' and noVarOfSort T:Type In NeTL . 478 eq noVarOfSort T:Type In X:TermList = true [owise] . 479 480 *** findSubTermOf_In_ *********************************************** 481 op findSubTermOf_In_ : NeCTermList TermList ~> Term . 482 eq findSubTermOf (TL, [], TL') In (TL, T, TL') = T . 483 eq findSubTermOf (TL, F[CtL], TL'') In (TL, F[TL'], TL'') 484 = findSubTermOf CtL In TL' . 485 486 *** replaceElem_of_by_ **************************************************** 487 op replaceElem_of_by_ : Nat TermList Term ~> TermList . 488 eq replaceElem 1 of (T,TL) by T' = (T',TL) . 489 eq replaceElem s(s(N)) of (T,TL) by T' = (T,replaceElem s(N) of TL by T') . 490 491 *** replaceSubTerm_of_by_ ************************************************* 492 op replaceSubTerm_of_by_ : NatList TermList Term ~> TermList . 493 eq replaceSubTerm nil of T by T' = T' . 494 eq replaceSubTerm N NL of (F[TL]) by T' 495 = F[replaceSubTermL N NL of TL by T'] . 496 497 op replaceSubTermL_of_by_ : NatList TermList Term ~> TermList . 498 eq replaceSubTermL 1 NL of (T,TL) by T' 499 = (replaceSubTerm NL of T by T', TL) . 500 eq replaceSubTermL s(s(N)) NL of (T,TL) by T' 501 = (T,replaceSubTermL s(N) NL of TL by T') . 502 503 op replaceTerm_by_in_ : Term Term TermList ~> TermList . 504 eq replaceTerm T by T' in T = T' . 505 eq replaceTerm T by T' in (F[TL]) = F[replaceTerm T by T' in TL] . 506 eq replaceTerm T by T' in T'' = T'' [owise] . 507 eq replaceTerm T by T' in (T'',NeTL) 508 = (replaceTerm T by T' in T'',replaceTerm T by T' in NeTL) . 509 510 *** context replacement ************************************************** 511 512 op _[_] : Context Context -> Context . 513 op _[_] : NeCTermList Context -> NeCTermList . 514 eq [] [ Ct ] = Ct . 515 eq (F[CtL])[ Ct ] = F[ CtL [ Ct ] ] . 516 eq (CtL,NeTL) [Ct] = (CtL [Ct] ), NeTL . 517 eq (NeTL,CtL) [Ct] = NeTL, (CtL [Ct] ) . 518 519 op _[_] : Context Term -> Term . 520 op _[_] : NeCTermList Term -> TermList . 521 eq [] [ T ] = T . 522 eq (F[CtL])[ T ] = F[ CtL [ T ] ] . 523 eq (CtL,NeTL) [T] = (CtL [T] ), NeTL . 524 eq (NeTL,CtL) [T] = NeTL, (CtL [T] ) . 525 526 *** is_substring_ ***************************************** 527 op is_substring_ : Qid Qid -> Bool [memo] . 528 eq is F:Qid substring F':Qid 529 = rfind(string(F':Qid), string(F:Qid), length(string(F':Qid))) =/= notFound . 530 531 *** addprefix_To_ addsufix_To_ ***************************************** 532 op addprefix_To_ : Qid Variable -> Variable [memo] . 533 eq addprefix Q To V 534 = qid(string(Q) + string(getName(V)) + ":" + string(getType(V))) . 535 536 op addprefix_To_ : Qid Constant -> Constant [ditto] . 537 eq addprefix Q To F 538 = if noUnderBar(F) and getName(F) :: Qid then 539 if getType(F) :: Type then 540 qid(string(Q) + string(getName(F)) + "." + string(getType(F))) 541 else 542 qid(string(Q) + string(getName(F))) 543 fi 544 else 545 qid(string(Q) + string(F)) 546 fi . 547 548 op addsufix_To_ : Qid Variable -> Variable [memo] . 549 eq addsufix Q To V 550 = qid(string(getName(V)) + string(Q) + ":" + string(getType(V))) . 551 552 op addsufix_To_ : Qid Constant -> Constant [ditto] . 553 eq addsufix Q To F 554 = if noUnderBar(F) and getName(F) :: Qid then 555 if getType(F) :: Type then 556 qid(string(getName(F)) + string(Q) + "." + string(getType(F))) 557 else 558 qid(string(getName(F)) + string(Q)) 559 fi 560 else 561 qid(string(F) + string(Q)) 562 fi . 563 564 op addType_ToVar_ : Type Qid -> Variable [memo] . 565 eq addType TP:Qid ToVar V:Qid 566 = qid(string(V:Qid) + ":" + string(TP:Qid)) . 567 568 *** noUnderBar (auxiliary) **************************** 569 op noUnderBar : Qid -> Bool . 570 eq noUnderBar(F) 571 = rfind(string(F), "_", length(string(F))) == notFound . 572 573 *** addType ****************************** 574 op addType : Qid Type -> Qid . 575 eq addType(F,TP) 576 = if noUnderBar(F) and getName(F) :: Qid then 577 qid( string(getName(F)) + "." + string(TP) ) 578 else 579 qid( string(F) + "." + string(TP) ) 580 fi . 581 582 *** addTypeVar ****************************** 583 op addTypeVar : Qid Type -> Qid . 584 eq addTypeVar(F,TP) 585 = qid( string(F) + ":" + string(TP) ) . 586 587endfm 588 589fmod SUBSTITUTION-HANDLING is 590 protecting META-TERM . 591 protecting META-LEVEL-MNPA . 592 protecting TERM-HANDLING . 593 594 var S S' Subst Subst' : Substitution . 595 var V V' : Variable . 596 var C C' : Constant . 597 var Ct : Context . 598 var T T' T1 T2 T1' T2' T1'' T2'' : Term . 599 var F F' : Qid . 600 var TL TL' TL1 TL2 TL1' TL2' : TermList . 601 var Att : AttrSet . 602 var RLS : RuleSet . 603 var Rl : Rule . 604 var TP : Type . 605 var N : Nat . 606 var NeTL : NeTermList . 607 var CtL : NeCTermList . 608 609 --- Apply Substitution to Term -------------------------------------------- 610 op _<<_ : Term Substitution -> Term . 611 eq TL << none = TL . 612 eq C << Subst = C . 613 eq V << ((V <- T) ; Subst) = T . 614 eq V << Subst = V [owise] . 615 eq F[TL] << Subst = F[TL << Subst] . 616 617 op _<<_ : TermList Substitution -> TermList . 618 eq (T, NeTL) << Subst = (T << Subst, NeTL << Subst) . 619 eq empty << Subst = empty . 620 621 op _<<_ : Context Substitution -> Context . 622 eq Ct << none = Ct . 623 eq [] << Subst = [] . 624 eq F[CtL,NeTL] << Subst = F[CtL << Subst,NeTL << Subst] . 625 eq F[NeTL,CtL] << Subst = F[NeTL << Subst, CtL << Subst] . 626 eq F[Ct] << Subst = F[Ct << Subst] . 627 628 op _<<_ : Substitution Substitution -> Substitution . 629 eq S << (none).Substitution = S . 630 eq (none).Substitution << S = (none).Substitution . 631 eq ((V' <- T) ; S') << S 632 = (V' <- (T << S)) 633 ; 634 (S' << S) . 635 636 --- Combine Substitutions ------------------------------------------------- 637 op _.._ : Substitution Substitution -> Substitution . 638 eq S .. S' = (S << S') ; S' . 639 640 --- Restrict Assignments to Variables in a Term ---------------------- 641 op _|>_ : Substitution TermList -> Substitution . 642 643 eq Subst |> TL = Subst |>* Vars(TL) . 644 645 op _|>*_ : Substitution TermList -> Substitution . 646--- eq noMatch |>* TL = noMatch . 647 eq Subst |>* TL = Subst |>** TL [none] . 648 649 op _|>**_[_] : Substitution TermList 650 Substitution -> Substitution . 651 eq none |>** TL [Subst'] 652 = Subst' . 653 eq ((V <- V) ; Subst) |>** TL [Subst'] 654 = Subst |>** TL [Subst'] . 655 eq ((V <- T') ; Subst) |>** TL [Subst'] 656 = Subst |>** TL 657 [Subst' ; if any V in TL then (V <- T') else none fi] . 658 659 --- Remove Variables from list ---------------------- 660 op _intersect_ : TermList TermList -> TermList . 661 eq (TL1,T,TL2) intersect (TL1',T,TL2') 662 = (T,((TL1,TL2) intersect (TL1',TL2'))) . 663 eq TL intersect TL' = empty [owise] . 664 665 op _intersectVar_ : TermList TermList -> TermList . 666 eq TL1 intersectVar TL2 667 = TL1 intersectVar* Vars(TL2) . 668 669 op _intersectVar*_ : TermList TermList -> TermList . 670 eq (T,TL1) intersectVar* TL2 671 = (if any Vars(T) in TL2 then T else empty fi,TL1 intersectVar* TL2) . 672 eq empty intersectVar* TL2 673 = empty . 674 675 --- Remove Variables from list ---------------------- 676 op _setMinus_ : TermList TermList -> TermList . 677 eq (TL1,T,TL2) setMinus (TL1',T,TL2') 678 = (TL1,TL2) setMinus (TL1',T,TL2') . 679 eq TL setMinus TL' = TL [owise] . 680 681 --- Variables --- 682 op Vars : GTermList -> TermList . 683 eq Vars((T,TL:GTermList)) = VarsTerm(T),Vars(TL:GTermList) . 684 eq Vars((Ct,TL:GTermList)) = VarsTerm(Ct),Vars(TL:GTermList) . 685 eq Vars(empty) = empty . 686 687 op VarsTerm : Term -> TermList . ---warning memo 688 eq VarsTerm(V) = V . 689 eq VarsTerm(F[TL:TermList]) = Vars(TL:TermList) . 690 eq VarsTerm(C) = empty . 691 692 op VarsTerm : Context -> TermList . ---warning memo 693 eq VarsTerm(F[TL:GTermList]) = Vars(TL:GTermList) . 694 695 --- membership --- 696 op _in_ : Term TermList -> Bool . 697 eq T in (TL,T,TL') = true . 698 eq T in TL = false [owise] . 699 700 --- membership --- 701 op any_in_ : TermList TermList -> Bool . --- [memo] . 702 eq any empty in TL = false . 703 eq any (TL1,T,TL2) in (TL1',T,TL2') = true . 704 eq any TL in TL' = false [owise] . 705 706 --- membership --- 707 op all_in_ : TermList TermList -> Bool . --- [memo] . 708 eq all empty in TL = true . 709 eq all (TL1,T,TL2) in (TL1',T,TL2') = all (TL1,TL2) in (TL1',T,TL2') . 710 eq all TL in TL' = false [owise] . 711 712 --- Occur check --- 713 op allVars_inVars_ : GTermList GTermList -> Bool . 714 eq allVars TL:GTermList inVars TL':GTermList 715 = all Vars(TL:GTermList) in Vars(TL':GTermList) . 716 717 op anyVars_inVars_ : GTermList GTermList -> Bool . 718 eq anyVars TL:GTermList inVars TL':GTermList 719 = any Vars(TL:GTermList) in Vars(TL':GTermList) . 720 721 op rangeVars : Substitution -> TermList . 722 eq rangeVars(V <- T ; Subst) = (Vars(T),rangeVars(Subst)) . 723 eq rangeVars(none) = empty . 724 725 op dom_inVars_ : Substitution TermList -> Bool . 726 eq dom Subst inVars TL = dom Subst in Vars(TL) . 727 728 op dom_in_ : Substitution TermList -> Bool . 729 eq dom (V <- T ; Subst) in (TL1,V,TL2) = true . 730 eq dom Subst in TL = false [owise] . 731 732 op dom_notInVars_ : Substitution TermList -> Bool . 733 eq dom Subst notInVars TL = dom Subst notIn Vars(TL) . 734 735 op dom_notIn_ : Substitution TermList -> Bool . 736 eq dom none notIn TL = true . 737 ceq dom (V <- T ; Subst) notIn TL = true if not (V in TL) . 738 eq dom Subst notIn TL = false [owise] . 739 740 op range_inVars_ : Substitution TermList -> Bool . 741 eq range Subst inVars TL = range Subst in Vars(TL) . 742 743 op range_in_ : Substitution TermList -> Bool . 744 eq range (V <- T ; Subst) in TL 745 = any Vars(T) in TL or-else range Subst in TL . 746 eq range none in TL 747 = false . 748 749 op valid-occur-check? : Substitution -> Bool . 750 eq valid-occur-check?(Subst) 751 = not (dom Subst inVars (rangeVars(Subst))) . 752 753 op extract-bindings : Substitution -> TermList . 754 eq extract-bindings(none) = empty . 755 eq extract-bindings(V <- T ; Subst) = (T,extract-bindings(Subst)) . 756endfm 757 758fmod TERMSET is 759 protecting META-LEVEL-MNPA . 760 protecting SUBSTITUTION-HANDLING . 761 762 sort TermSet . 763 subsort Term < TermSet . 764 op emptyTermSet : -> TermSet [ctor] . 765 op _|_ : TermSet TermSet -> TermSet 766 [ctor assoc comm id: emptyTermSet format (d n d d)] . 767 eq X:Term | X:Term = X:Term . 768 769 op _in_ : Term TermSet -> Bool . 770 eq T:Term in (T:Term | TS:TermSet) = true . 771 eq T:Term in TS:TermSet = false [owise] . 772 773 op TermSet : TermList -> TermSet . 774 eq TermSet(empty) 775 = emptyTermSet . 776 eq TermSet((T:Term,TL:TermList)) 777 = T:Term | TermSet(TL:TermList) . 778 779endfm 780 781fmod RENAMING is 782 protecting META-TERM . 783 protecting META-LEVEL-MNPA . 784 protecting TERM-HANDLING . 785 protecting SUBSTITUTION-HANDLING . 786 protecting TERMSET . 787 protecting CONVERSION . 788 protecting QID . 789 protecting INT . 790 protecting UNIFICATIONTRIPLE . 791 792 var S S' Subst Subst' : Substitution . 793 var V V' : Variable . 794 var C C' : Constant . 795 var CtL : NeCTermList . 796 var Ct : Context . 797 var T T' T1 T2 T1' T2' T1'' T2'' : Term . 798 var F F' : Qid . 799 var TL TL' TL'' TL''' : TermList . 800 var Att : AttrSet . 801 var RLS : RuleSet . 802 var Rl : Rule . 803 var TP : Type . 804 var N N' : Nat . 805 var NeTL : NeTermList . 806 807 var Q Q' : Qid . 808 var IL : ImportList . 809 var SS : SortSet . 810 var SSDS : SubsortDeclSet . 811 var OPDS : OpDeclSet . 812 var MAS : MembAxSet . 813 var EQS : EquationSet . 814 815 var TPL : TypeList . 816 817 --- Extra filter for substitutions ------ 818 op _|>_ : Substitution Nat -> Substitution . 819 eq Subst |> N 820 = Subst |>* N [none] . 821 822 op _|>*_[_] : Substitution Nat Substitution -> Substitution . 823 eq none |>* N [Subst'] 824 = Subst' . 825 eq ((V <- T') ; Subst) |>* N [Subst'] 826 = Subst |>* N 827 [Subst' ; if highestVar(V) < N then (V <- T') else none fi ] . 828 829 --- instantiatesAbove ----------------------------------- 830 op _instantiatesAbove_ : Substitution Nat -> Bool . 831 eq none instantiatesAbove N = false . 832 eq ((V <- T') ; Subst) instantiatesAbove N 833 = highestVar(V) >= N 834 or-else 835 Subst instantiatesAbove N . 836 837 ---------------------------------------------- 838 --- New Renaming Utilities ------------------- 839 op highestVar : GTermList -> Nat . 840 eq highestVar(TL:GTermList) 841 = highestVar(TL:GTermList,0) . 842 843 op highestVarTerm : Term -> Nat . ---warning memo 844 op highestVarTerm : Context -> Nat . ---warning memo 845 eq highestVarTerm([]) = 0 . 846 eq highestVarTerm(C) = 0 . 847 eq highestVarTerm(V) 848 = if rfind(string(V), "#", length(string(V))) =/= notFound 849 and 850 rfind(string(V), ":", length(string(V))) =/= notFound 851 and 852 rat(substr(string(V), 853 rfind(string(V), "#", length(string(V))) + 1, 854 rfind(string(V), ":", length(string(V))) + (- 1)) 855 ,10) 856 :: Nat 857 then rat(substr(string(V), 858 rfind(string(V), "#", length(string(V))) + 1, 859 rfind(string(V), ":", length(string(V))) + (- 1)) 860 ,10) 861 else 862 if rfind(string(V), "%", length(string(V))) =/= notFound 863 and 864 rfind(string(V), ":", length(string(V))) =/= notFound 865 and 866 rat(substr(string(V), 867 rfind(string(V), "%", length(string(V))) + 1, 868 rfind(string(V), ":", length(string(V))) + (- 1)) 869 ,10) 870 :: Nat 871 then rat(substr(string(V), 872 rfind(string(V), "%", length(string(V))) + 1, 873 rfind(string(V), ":", length(string(V))) + (- 1)) 874 ,10) 875 else 0 876 fi 877 fi . 878 879 eq highestVarTerm(F[TL:GTermList]) 880 = highestVar(TL:GTermList,0) . 881 882 op highestVar : GTermList Nat -> Nat . 883 eq highestVar(empty,N) 884 = N . 885 eq highestVar((Ct,TL:GTermList),N) 886 = highestVar(TL:GTermList, 887 if highestVarTerm(Ct) > N then highestVarTerm(Ct) else N fi 888 ) . 889 eq highestVar((T,TL:GTermList),N) 890 = highestVar(TL:GTermList, 891 if highestVarTerm(T) > N then highestVarTerm(T) else N fi 892 ) . 893 894 --- For substitutions 895 op highestVar : Substitution -> Nat . --- [memo] . 896 eq highestVar(Subst) 897 = highestVar(Subst,0) . 898 899 op highestVar : Substitution Nat -> Nat . 900 eq highestVar((none).Substitution,N) = N . 901 eq highestVar(V <- T ; Subst,N) 902 = highestVar(Subst,highestVar((T,V),N)) . 903 904 --- Renaming ------------------------------------------------------ 905 op newVar : Nat TypeList -> TermList . 906 eq newVar(N,nil) = empty . 907 eq newVar(N,TP TPL) = (newVar*(N,TP),newVar(s(N),TPL)) . 908 909 op newVar* : Nat Type -> Variable . 910 eq newVar*(N,TP) 911 = qid("#" + string(N,10) + ":" + string(TP)) . 912 913 op simplifyVars : TermList -> TermList . 914 eq simplifyVars(TL) = TL << 0 < . 915 916 op _<<`(_`)< : TermList GTermList -> TermList . 917 eq X:TermList <<(TL:GTermList)< 918 = X:TermList << highestVar(TL:GTermList) + 1 < . 919 920 op _<<_ : TermList UnificationPair -> TermList . 921 eq TL << {Subst,N} = TL << Subst . 922 923 op _<<_ : TermList UnificationTriple -> TermList . 924 eq TL << {Subst,Subst',N} = TL << (Subst ; Subst') . 925 926 op _<<_ : Substitution UnificationTriple -> Substitution . 927 eq S:Substitution << {Subst,Subst',N} = S:Substitution << (Subst ; Subst') . 928 929 op _<<_< : TermList Nat -> TermList . 930 eq TL << N < = TL << (TL << { none, N } <) . 931 932 op _<<_< : TermList UnificationPair -> UnificationPair . ***Huge [memo] . 933 eq C << {S,N} < = {S,N} . 934 eq F[TL] << {S,N} < = TL << {S,N} < . 935 eq V << {S,N} < 936 = if not (dom S inVars V) 937 then {S ; V <- newVar(N,getType(V)), N + 1} 938 else {S,N} 939 fi . 940 941 eq (T,TL:NeTermList) << {S,N} < 942 = TL:NeTermList << (T << {S,N} < ) < . 943 eq empty << {S,N} < 944 = {S,N} . 945 946endfm 947 948fmod SUBSTITUTIONSET is 949 protecting SUBSTITUTION-HANDLING . 950 protecting META-LEVEL-MNPA . 951 protecting TERMSET . 952 protecting RENAMING . 953 954 sort SubstitutionSet NeSubstitutionSet . 955 subsort Substitution < NeSubstitutionSet < SubstitutionSet . 956 op empty : -> SubstitutionSet [ctor] . 957 op _|_ : SubstitutionSet SubstitutionSet -> SubstitutionSet 958 [ctor assoc comm id: empty format (d n d d)] . 959 op _|_ : NeSubstitutionSet SubstitutionSet -> NeSubstitutionSet 960 [ctor ditto] . 961 eq X:Substitution | X:Substitution = X:Substitution . 962 963 vars SS SS' : SubstitutionSet . 964 vars S S' Subst : Substitution . 965 vars T T' : Term . 966 vars TL TL' : TermList . 967 vars N N' : Nat . 968 var V : Variable . 969 970 op _<<_ : Substitution SubstitutionSet -> SubstitutionSet . 971 eq S << empty = empty . 972 ceq S << (S' | SS') = (S << S') | (S << SS') if SS' =/= empty . 973 974 op _..._ : SubstitutionSet [SubstitutionSet] 975 -> SubstitutionSet [strat (1) gather (e E)] . 976 977 eq empty ... SS':[SubstitutionSet] = empty . 978 eq (S | SS) ... SS':[SubstitutionSet] 979 = (S ...' SS':[SubstitutionSet]) 980 | 981 (SS ... SS':[SubstitutionSet]) . 982 983 op _...'_ : Substitution SubstitutionSet -> SubstitutionSet . 984 985 eq S ...' empty 986 = empty . 987 988 eq S ...' (S' | SS') 989 = (S .. S') 990 | 991 (S ...' SS') . 992 993 op _|>_ : SubstitutionSet TermList -> SubstitutionSet . 994 eq (empty).SubstitutionSet |> TL = empty . 995 eq (S | SS:NeSubstitutionSet) |> TL 996 = (S |> TL) | (SS:NeSubstitutionSet |> TL) . 997 998 op _|>_ : SubstitutionSet Nat -> SubstitutionSet . 999 eq SS:NeSubstitutionSet |> N 1000 = SS:NeSubstitutionSet |> (0,N) . 1001 1002 op _|>`(_,_`) : SubstitutionSet Nat Nat -> SubstitutionSet . 1003 eq (empty).SubstitutionSet |> (N,N') = empty . 1004 eq (S | SS:NeSubstitutionSet) |> (N,N') 1005 = (S |> (N,N')) | (SS:NeSubstitutionSet |> (N,N')) . 1006 1007 op _|>`(_,_`) : Substitution Nat Nat -> Substitution . 1008 eq none |> (N,N') = none . 1009 eq ((V <- T') ; Subst) |> (N,N') 1010 = if N <= highestVar(V) and highestVar(V) <= N' 1011 then (V <- T') 1012 else none 1013 fi 1014 ; (Subst |> (N,N')) . 1015 1016 op filter_by!InVars_ : SubstitutionSet TermList -> SubstitutionSet . 1017 eq filter (empty).SubstitutionSet by!InVars TL 1018 = (empty).SubstitutionSet . 1019 eq filter (S | SS) by!InVars TL 1020 = if dom S inVars TL 1021 then empty 1022 else S 1023 fi 1024 | filter SS by!InVars TL . 1025 1026 op _==* none : SubstitutionSet -> Bool . 1027 eq (none | SS) ==* none = SS ==* none . 1028 eq (empty).SubstitutionSet ==* none = true . 1029 eq SS ==* none = false [owise] . 1030 1031 op |_| : SubstitutionSet -> Nat . 1032 eq | (empty).SubstitutionSet | = 0 . 1033 eq | (S | SS) | = s(| SS |) . 1034 1035endfm 1036 1037fmod UNIFICATIONPAIRSET is 1038 protecting SUBSTITUTIONSET . 1039 protecting RENAMING . 1040 protecting UNIFICATIONTRIPLE . 1041 1042 vars V V' : Variable . 1043 vars U U' : UnificationPair . 1044 vars US US' : UnificationPairSet . 1045 vars S S' S1 S1' S2 S2' : Substitution . 1046 var SS : SubstitutionSet . 1047 vars N N' N1 N2 : Nat . 1048 vars T T' : Term . 1049 var TL : TermList . 1050 var M : Module . 1051 1052 --- Combine UnificationPair --------------------------------------------- 1053 op _.._ : UnificationPair UnificationPair -> UnificationPair . 1054 eq {S,N} .. {S',N'} = {S .. S',max(N,N')} . 1055 1056 --- Detect used variables ---------------------------------------------- 1057 op dom_inVars_ : UnificationPair TermList -> Bool . --- [memo] . 1058 eq dom {S,N} inVars TL = dom S inVars TL . 1059 1060 --- UnificationPairSet -------------------------------------------------- 1061 sort UnificationPairSet . 1062 subsort UnificationPair < UnificationPairSet . 1063 op empty : -> UnificationPairSet [ctor] . 1064 op _|_ : UnificationPairSet UnificationPairSet -> UnificationPairSet 1065 [ctor assoc comm id: empty format (d n d d)] . 1066 eq X:UnificationPair | X:UnificationPair = X:UnificationPair . 1067 1068 op _..._ : UnificationPairSet [UnificationPairSet] 1069 -> UnificationPairSet [strat (1) gather (e E)] . 1070 1071 eq (empty).UnificationPairSet ... US':[UnificationPairSet] 1072 = (empty).UnificationPairSet . 1073 eq (U | US) ... US':[UnificationPairSet] 1074 = (U ...' US':[UnificationPairSet]) 1075 | 1076 (US ... US':[UnificationPairSet]) . 1077 1078 op _...'_ : UnificationPair UnificationPairSet -> UnificationPairSet . 1079 1080 eq U ...' (empty).UnificationPairSet 1081 = (empty).UnificationPairSet . 1082 1083 eq U ...' (U' | US') 1084 = (U .. U') 1085 | 1086 (U ...' US') . 1087 1088 --- Restriction ----------------------- 1089 op _|>_ : UnificationPairSet TermList -> UnificationPairSet . 1090 eq (empty).UnificationPairSet |> TL = empty . 1091 eq ({S,N} | US) |> TL = {(S |> TL),N} | (US |> TL) . 1092 1093 op filter_by!InVars_ : UnificationPairSet TermList 1094 -> UnificationPairSet . 1095 eq filter (empty).UnificationPairSet by!InVars TL 1096 = (empty).UnificationPairSet . 1097 eq filter (U | US) by!InVars TL 1098 = if dom U inVars TL 1099 then empty 1100 else U 1101 fi 1102 | filter US by!InVars TL . 1103 1104 op toUnificationPair[_]`(_`) : Nat SubstitutionSet -> UnificationPairSet . 1105 eq toUnificationPair[N](empty) 1106 = empty . 1107 eq toUnificationPair[N](S | SS) 1108 = {S,highestVar(S,N)} 1109 | toUnificationPair[N](SS) . 1110 1111 op toSubstitution : UnificationPairSet -> SubstitutionSet . 1112 eq toSubstitution((empty).UnificationPairSet) 1113 = empty . 1114 eq toSubstitution({S,N} | US) 1115 = S | toSubstitution(US) . 1116 1117 op _in_ : UnificationPair UnificationPairSet -> Bool . 1118 eq X:UnificationPair in (X:UnificationPair | XS:UnificationPairSet) = true . 1119 eq X:UnificationPair in XS:UnificationPairSet = false [owise] . 1120 1121endfm 1122 1123fmod UNIFICATIONTRIPLESET is 1124 protecting SUBSTITUTIONSET . 1125 protecting RENAMING . 1126 protecting UNIFICATIONPAIRSET . 1127 1128 vars V V' : Variable . 1129 var C : Constant . 1130 var F : Qid . 1131 vars U U' : UnificationTriple . 1132 vars US US' : UnificationTripleSet . 1133 vars S S' S1 S1' S2 S2' : Substitution . 1134 var SS : SubstitutionSet . 1135 var SSe : NeSubstitutionSet . 1136 vars N N' N1 N2 NextVar : Nat . 1137 vars T T' : Term . 1138 var TL : TermList . 1139 var NeTL : NeTermList . 1140 var M : Module . 1141 var UPS : UnificationPairSet . 1142 1143 --- Combine UnificationPair --------------------------------------------- 1144 op _.._ : UnificationTriple UnificationTriple -> UnificationTriple . 1145 eq {S1,S1',N1} .. {S2,S2',N2} = {S1 .. S2,S1' .. S2',max(N1,N2)} . 1146 1147 --- UnificationPairSet -------------------------------------------------- 1148 sort UnificationTripleSet . 1149 subsort UnificationTriple < UnificationTripleSet . 1150 op empty : -> UnificationTripleSet [ctor] . 1151 op _|_ : UnificationTripleSet UnificationTripleSet 1152 -> UnificationTripleSet 1153 [ctor assoc comm id: empty format (d n d d)] . 1154 eq X:UnificationTriple | X:UnificationTriple = X:UnificationTriple . 1155 1156 op _..._ : UnificationTripleSet [UnificationTripleSet] 1157 -> UnificationTripleSet [strat (1) gather (e E)] . 1158 1159 eq (empty).UnificationTripleSet ... US':[UnificationTripleSet] 1160 = (empty).UnificationTripleSet . 1161 eq (U | US) ... US':[UnificationTripleSet] 1162 = (U ...' US':[UnificationTripleSet]) 1163 | 1164 (US ... US':[UnificationTripleSet]) . 1165 1166 op _...'_ : UnificationTriple UnificationTripleSet 1167 -> UnificationTripleSet . 1168 1169 eq U ...' (empty).UnificationTripleSet 1170 = (empty).UnificationTripleSet . 1171 1172 eq U ...' (U' | US') 1173 = (U .. U') 1174 | 1175 (U ...' US') . 1176 1177 --- convert ----------------------------------------------------- 1178 op split : UnificationPair Nat -> UnificationTriple . 1179 eq split({none,N},N') = {none,none,N} . 1180 eq split({(V <- T') ; S,N},N') 1181 = if highestVar(V) < N' 1182 then {(V <- T'),none,N} 1183 else {none,(V <- T'),N} 1184 fi 1185 .. split({S,N},N') . 1186 1187 op split : UnificationPairSet Term Term -> UnificationTripleSet . 1188 eq split(empty,T,T') = empty . 1189 eq split({S,N} | UPS,T,T') = {S |> T, S |> T',N} | split(UPS,T,T') . 1190 1191 op toUnificationTriple[_]`(_`) : 1192 Nat SubstitutionSet -> UnificationTripleSet . 1193 eq toUnificationTriple[N](SS) 1194 = toUnificationTriple*[N](SS,empty) . 1195 1196 op toUnificationTriple*[_]`(_,_`) : 1197 Nat SubstitutionSet 1198 UnificationTripleSet -> UnificationTripleSet . 1199 eq toUnificationTriple*[N](empty,US) 1200 = US . 1201 eq toUnificationTriple*[N](S | SS,US) 1202 = toUnificationTriple*[N](SS, US | {none,S,highestVar(S,N)}) . 1203 1204 op toUnificationTriple[_,_]`(_`) : 1205 Nat Nat SubstitutionSet -> UnificationTripleSet . 1206 eq toUnificationTriple[NextVar,N](SS) 1207 = toUnificationTriple*[NextVar,N](SS,empty) . 1208 1209 op toUnificationTriple*[_,_]`(_,_`) : 1210 Nat Nat SubstitutionSet 1211 UnificationTripleSet -> UnificationTripleSet . 1212 eq toUnificationTriple*[NextVar,N](empty,US) 1213 = US . 1214 eq toUnificationTriple*[NextVar,N](S | SS,US) 1215 = toUnificationTriple*[NextVar,N](SS, 1216 US | split({S,highestVar(S,N)},NextVar)) . 1217 1218 op toUnificationTriple[_,_,_]`(_`) : 1219 Term Term Nat SubstitutionSet -> UnificationTripleSet . 1220 eq toUnificationTriple[T,T',N](SS) 1221 = toUnificationTriple*[T,T',N](SS,empty) . 1222 1223 op toUnificationTriple*[_,_,_]`(_,_`) : 1224 Term Term Nat SubstitutionSet 1225 UnificationTripleSet -> UnificationTripleSet . 1226 eq toUnificationTriple*[T,T',N](empty,US) 1227 = US . 1228 eq toUnificationTriple*[T,T',N](S | SS,US) 1229 = toUnificationTriple*[T,T',N](SS, US | {S |> T,S |> T',highestVar(S,N)}) . 1230 1231 op toSubstitution : UnificationTripleSet -> SubstitutionSet . 1232 eq toSubstitution(US) 1233 = toSubstitution*(US,empty) . 1234 1235 op toSubstitution* : UnificationTripleSet 1236 SubstitutionSet -> SubstitutionSet . 1237 eq toSubstitution*((empty).UnificationTripleSet,SS) 1238 = SS . 1239 eq toSubstitution*({S,S',N} | US,SS) 1240 = toSubstitution*(US,SS | (S ; S')) . 1241 1242 op _in_ : UnificationTriple UnificationTripleSet -> Bool . 1243 eq X:UnificationTriple 1244 in (X:UnificationTriple | XS:UnificationTripleSet) = true . 1245 eq X:UnificationTriple in XS:UnificationTripleSet = false [owise] . 1246 1247 --- restriction --------------------------------------------------- 1248 op _|>_ : UnificationTripleSet TermList -> UnificationTripleSet . 1249 eq US |> TL 1250 = US *|> TL [empty] . 1251 1252 op _*|>_[_] : UnificationTripleSet TermList 1253 UnificationTripleSet -> UnificationTripleSet . 1254 eq (empty).UnificationTripleSet *|> TL [US'] 1255 = US' . 1256 eq ({S,S',N} | US) *|> TL [US'] 1257 = US *|> TL [US' | {(S |> TL),(S' |> TL),N} ] . 1258 1259 op _filterBy_ : UnificationTripleSet Nat -> UnificationTripleSet . 1260 eq US filterBy NextVar 1261 = US filterBy* NextVar [empty] . 1262 1263 op _filterBy*_[_] : UnificationTripleSet Nat 1264 UnificationTripleSet -> UnificationTripleSet . 1265 eq empty filterBy* NextVar [US'] 1266 = US' . 1267 eq ({S,S',N} | US) filterBy* NextVar [US'] 1268 = US filterBy* NextVar 1269 [US' | if S instantiatesAbove NextVar then empty else {S,S',N} fi ] . 1270endfm 1271 1272fmod MODULE-HANDLING is 1273 protecting INT . 1274 protecting META-LEVEL-MNPA . 1275 protecting EXT-BOOL . *** From Full Maude 1276 protecting SUBSTITUTION-HANDLING . 1277 protecting UNIFICATIONTRIPLESET . 1278 1279 var T T' T'' T1 T2 Lhs Rhs : Term . 1280 var C C' : Constant . 1281 var QIL : QidList . 1282 var N N' : Nat . 1283 var NL NL' : NatList . 1284 var Q F F' : Qid . 1285 vars AtS AtS' : AttrSet . 1286 var EqS : EquationSet . 1287 var Eq : Equation . 1288 var RlS : RuleSet . 1289 var Rl : Rule . 1290 var Cond : Condition . 1291 var TP TP' : Type . 1292 var TPL TPL' : TypeList . 1293 ---var TPL TPL' : ETypeList . 1294 ---var ET ET' : EType . 1295 var VDS OPDS : OpDeclSet . 1296 var OPD : OpDecl . 1297 var M : Module . 1298 var TL TL' TL'' : TermList . 1299 var B : Bool . 1300 var V V' : Variable . 1301 var I : Int . 1302 vars S S' : Substitution . 1303 var US : UnificationTripleSet . 1304 1305 *** canonice ****************************** 1306 op canonice : Module Term -> Term . 1307--- eq canonice(M,T) = getTerm(metaReduce(eraseRls(eraseEqs(M)),T)) . 1308 eq canonice(M,T) = getTerm(metaNormalize(M,T)) . 1309 1310 op canonice : Module Substitution -> Substitution . 1311 eq canonice(M,(none).Substitution) = none . 1312 eq canonice(M,V <- T ; S) = V <- canonice(M,T) ; canonice(M,S) . 1313 1314 op canonice : Module UnificationTripleSet -> UnificationTripleSet . 1315 eq canonice(M,(empty).UnificationTripleSet) = (empty).UnificationTripleSet . 1316 eq canonice(M,{S,S',N} | US) = {canonice(M,S),canonice(M,S'),N} | canonice(M,US) . 1317 1318 1319 *** normalize ****************************** 1320 op normalize : Module Term -> Term . 1321 eq normalize(M,T) = getTerm(metaReduce(eraseRls(M),T)) . 1322 1323 op normalize : Module Substitution -> Substitution . 1324 eq normalize(M,(none).Substitution) = none . 1325 eq normalize(M,V <- T ; S) = V <- normalize(M,T) ; normalize(M,S) . 1326 1327 *** normalizeRls ****************************** 1328 op normalizeRls : Module Term -> Term . 1329 eq normalizeRls(M,T) = getTerm(metaReduce(rls2eqs(M),T)) . 1330 1331 op normalizeRls : Module Substitution -> Substitution . 1332 eq normalizeRls(M,(none).Substitution) = none . 1333 eq normalizeRls(M,V <- T ; S) = V <- normalizeRls(M,T) ; normalizeRls(M,S) . 1334 1335 *** typeLeq ************************************************** 1336 op typeLeq : Module TypeList TypeList ~> Bool [memo] . 1337 1338 eq typeLeq(M,TP:Sort TPL,TP':Sort TPL') 1339 = sortLeq(M,TP:Sort,TP':Sort) and typeLeq(M,TPL,TPL') . 1340 eq typeLeq(M,TP:Sort TPL,TP':Kind TPL') 1341 = getKind(M,TP:Sort) == TP':Kind 1342 and typeLeq(M,TPL,TPL') . 1343 eq typeLeq(M,TP:Kind TPL,TP':Sort TPL') 1344 = false . 1345 eq typeLeq(M,TP:Kind TPL,TP':Kind TPL') 1346 = TP:Kind == TP':Kind and typeLeq(M,TPL,TPL') . 1347 eq typeLeq(M,nil,nil) 1348 = true . 1349 1350 *** getTypes ************************************************** 1351 op getTypes : Module TermList -> TypeList . ---Memo is huge 1352 eq getTypes(M, (T, TL)) = leastSort(M, T) getTypes(M, TL) . 1353 eq getTypes(M, empty) = nil . 1354 1355 *** getFrozen ************************************************ 1356 op getFrozen : Module Qid TypeList -> NatList [memo] . 1357 eq getFrozen(M,F,TPL) = getFrozen(getOpsOfQid(M,F,TPL)) . 1358 1359 op getFrozen : OpDeclSet -> NatList . 1360 eq getFrozen((op F : TPL -> TP [frozen(NL) AtS] .) OPDS) = NL . 1361 eq getFrozen(OPDS) = 0 [owise] . 1362 1363 *** inNatList ************************************************ 1364 op _inNatList_ : Nat NatList -> Bool . 1365 eq N inNatList (NL N NL') = true . 1366 eq N inNatList NL = false [owise] . 1367 1368 *** membership ************************************************ 1369 op _in_ : Type TypeList ~> Bool . 1370 eq TP in (TPL TP TPL') = true . 1371 eq TP in TPL = false [owise] . 1372 1373 *** isConstructor ****************************** 1374 op isConstructor : Module Term -> Bool . 1375 op isConstructor : Module Qid TypeList -> Bool [memo] . 1376 op isConstructor : OpDeclSet -> Bool . 1377 1378 eq isConstructor(M,V) = false . 1379 eq isConstructor(M,C) = isConstructor(M,C,nil) . 1380 eq isConstructor(M,F[TL]) = isConstructor(M,F,getTypes(M,TL)) . 1381 1382 eq isConstructor(M,F,TPL) 1383 = getEqsOfQid(M,F,TPL) == none or-else isConstructor(getOpsOfQid(M,F,TPL)) . 1384 1385 eq isConstructor((op F : TPL -> TP [ctor AtS] .) OPDS) = true . 1386 eq isConstructor(OPDS) = false [owise] . 1387 1388 *** getOpsOfType *********************************************** 1389 op getOpsOfType : Module Type -> OpDeclSet [memo] . 1390 op getOpsOfType : Module OpDeclSet Type -> OpDeclSet . 1391 1392 eq getOpsOfType(M,TP) = getOpsOfType(M,getOps(M),TP) . 1393 1394 eq getOpsOfType(M,((op F : TPL -> TP [AtS] .) OPDS),TP') 1395 = if TP == TP' 1396 then (op F : TPL -> TP [AtS] .) 1397 getOpsOfType(M,OPDS,TP') 1398 else getOpsOfType(M,OPDS,TP') 1399 fi . 1400 1401 eq getOpsOfType(M,OPDS,TP) 1402 = none 1403 [owise] . 1404 1405 *** getOpsOfQid *********************************************** 1406 op getOpsOfQid : Module Qid -> OpDeclSet [memo] . 1407 op getOpsOfQid : Module Qid TypeList -> OpDeclSet [memo] . 1408 op getOpsOfQid : Module OpDeclSet Qid -> OpDeclSet . 1409 op getOpsOfQid : Module OpDeclSet Qid TypeList -> OpDeclSet . 1410 1411 eq getOpsOfQid(M,F) 1412 = getOpsOfQid(M,getOps(M),F) . 1413 1414 eq getOpsOfQid(M,F,TPL) 1415 = if getOpsOfQid(M,getOps(M),F,TPL) =/= none 1416 then getOpsOfQid(M,getOps(M),F,TPL) 1417 else getOpsOfQid(M,getOps(M),F,restrict TPL To 2) 1418 fi . 1419 1420 eq getOpsOfQid(M,((op F : TPL -> TP [AtS] .) OPDS),F) 1421 = (op F : TPL -> TP [AtS] .) 1422 getOpsOfQid(M,OPDS,F) . 1423 1424 eq getOpsOfQid(M,OPDS,F') 1425 = none 1426 [owise] . 1427 1428 eq getOpsOfQid(M,((op F : TPL -> TP [AtS] .) OPDS),F,TPL') 1429 = if eSameKind(M,TPL,TPL') 1430 then (op F : TPL -> TP [AtS] .) 1431 getOpsOfQid(M,OPDS,F,TPL') 1432 else getOpsOfQid(M,OPDS,F,TPL') 1433 fi . 1434 1435 eq getOpsOfQid(M,OPDS,F',TPL') 1436 = none 1437 [owise] . 1438 1439 op restrict_To_ : TypeList Nat -> TypeList . 1440 eq restrict nil To NL = nil . 1441 eq restrict TPL To 0 = nil . 1442 eq restrict (TP,TPL) To s(N) = (TP, restrict TPL To N) . 1443 1444 *** getOpsOfEqs ****************************************************** 1445 op getOpsOfEqs : EquationSet -> QidList [memo] . 1446 eq getOpsOfEqs((eq C = T' [AtS] .) EqS ) 1447 = C getOpsOfEqs(EqS) . 1448 eq getOpsOfEqs((eq F[TL] = T' [AtS] .) EqS ) 1449 = F getOpsOfEqs(EqS) . 1450 eq getOpsOfEqs((none).EquationSet) 1451 = nil . 1452 1453 *** getEqsOfQid ****************************************************** 1454 op getEqsOfQid : Module Qid TypeList -> EquationSet [memo] . 1455 op getEqsOfQid : Module Qid TypeList EquationSet -> EquationSet . 1456 1457 eq getEqsOfQid(M, F,TPL) = getEqsOfQid(M, F, TPL, getEqs(M)) . 1458 1459 ceq getEqsOfQid(M, F, TPL, (eq C = T' [AtS] .) EqS ) 1460 = (eq C = T' [AtS] .) getEqsOfQid(M, F, TPL, EqS) 1461 if F == C . 1462 ceq getEqsOfQid(M, F, TPL, (eq F[TL] = T' [AtS] .) EqS ) 1463 = (eq F[TL] = T' [AtS] .) getEqsOfQid(M, F, TPL, EqS) 1464 if eSameKind(M,getTypes(M,TL),TPL) . 1465 ceq getEqsOfQid(M, F, TPL, (ceq C = T' if Cond [AtS] .) EqS ) 1466 = (ceq C = T' if Cond [AtS] .) getEqsOfQid(M, F, TPL, EqS) 1467 if F == C . 1468 ceq getEqsOfQid(M, F, TPL, (ceq F[TL] = T' if Cond [AtS] .) EqS ) 1469 = (ceq F[TL] = T' if Cond [AtS] .) getEqsOfQid(M, F, TPL, EqS) 1470 if eSameKind(M,getTypes(M,TL),TPL) . 1471 eq getEqsOfQid(M, F, TPL, Eq EqS ) 1472 = getEqsOfQid(M, F, TPL, EqS) [owise] . 1473 eq getEqsOfQid(M, F, TPL, (none).EquationSet ) 1474 = (none).EquationSet . 1475 1476 *** getTypesOfQid **************************************** 1477 op getTypesOfQid : Module Qid TypeList -> TypeSet [memo] . 1478 op getTypesOfQid : OpDeclSet -> TypeSet . 1479 1480 eq getTypesOfQid(M,F,TPL) = getTypesOfQid(getOpsOfQid(M,F,TPL)) . 1481 eq getTypesOfQid((op F : TPL -> TP [AtS] .) OPDS) 1482 = TP ; getTypesOfQid(OPDS) . 1483 eq getTypesOfQid((none).OpDeclSet) = (none).TypeSet . 1484 1485 *** filterConstructorSymbols ************************************ 1486 op filterConstructorSymbols : OpDeclSet -> OpDeclSet . 1487 eq filterConstructorSymbols(((op F : TPL -> TP [AtS] .) OPDS)) 1488 = if isConstructor((op F : TPL -> TP [AtS] .) none) 1489 then (op F : TPL -> TP [AtS] .) 1490 filterConstructorSymbols(OPDS) 1491 else filterConstructorSymbols(OPDS) 1492 fi . 1493 eq filterConstructorSymbols(none) 1494 = none . 1495 1496 *** filterDefinedSymbols ***************************************** 1497 op filterDefinedSymbols : OpDeclSet -> OpDeclSet . 1498 eq filterDefinedSymbols(((op F : TPL -> TP [ctor AtS] .) OPDS)) 1499 = filterDefinedSymbols(OPDS) . 1500 eq filterDefinedSymbols(((op F : TPL -> TP [AtS] .) OPDS)) 1501 = (op F : TPL -> TP [AtS] .) filterDefinedSymbols(OPDS) [owise] . 1502 eq filterDefinedSymbols(none) 1503 = none . 1504 1505 *** isCommutative ****************************** 1506 op isCommutative : Module Term -> Bool . 1507 op isCommutative : Module Qid TypeList -> Bool [memo] . 1508 op isCommutative : OpDeclSet -> Bool . 1509 1510 eq isCommutative(M,V) = false . 1511 eq isCommutative(M,C) = false . 1512 eq isCommutative(M,F[TL]) = isCommutative(M,F,getTypes(M,TL)) . 1513 1514 eq isCommutative(M,F,TPL) = isCommutative(getOpsOfQid(M,F,TPL)) . 1515 1516 eq isCommutative((op F : TPL -> TP [comm AtS] .) OPDS) = true . 1517 eq isCommutative(OPDS) = false [owise] . 1518 1519 *** isAssociative ****************************** 1520 op isAssociative : Module Term -> Bool . 1521 op isAssociative : Module Qid TypeList -> Bool [memo] . 1522 op isAssociative : OpDeclSet -> Bool . 1523 1524 eq isAssociative(M,V) = false . 1525 eq isAssociative(M,C) = false . 1526 eq isAssociative(M,F[TL]) = isAssociative(M,F,getTypes(M,TL)) . 1527 1528 eq isAssociative(M,F,TPL) = isAssociative(getOpsOfQid(M,F,TPL)) . 1529 1530 eq isAssociative((op F : TPL -> TP [assoc AtS] .) OPDS) = true . 1531 eq isAssociative(OPDS) = false [owise] . 1532 1533 *** getIdSymbol ****************************** 1534 op getIdSymbol : Module Term ~> Term . 1535 eq getIdSymbol(M,F[TL]) = getIdSymbol(M,F,getTypes(M,TL)) . 1536 1537 op getIdSymbol : Module Qid TypeList ~> Term [memo] . 1538 eq getIdSymbol(M,F,TPL) = getIdSymbol(getOpsOfQid(M,F,TPL)) . 1539 1540 op getIdSymbol : OpDeclSet ~> Term . 1541 eq getIdSymbol((op F : TPL -> TP [id(T) AtS] .) OPDS) = T . 1542 1543 op getLeftIdSymbol : Module Term ~> Term . 1544 eq getLeftIdSymbol(M,F[TL]) = getLeftIdSymbol(M,F,getTypes(M,TL)) . 1545 1546 op getLeftIdSymbol : Module Qid TypeList ~> Term . 1547 eq getLeftIdSymbol(M,F,TPL) = getLeftIdSymbol(getOpsOfQid(M,F,TPL)) . 1548 1549 op getLeftIdSymbol : OpDeclSet ~> Term . 1550 eq getLeftIdSymbol((op F : TPL -> TP [left-id(T) AtS] .) OPDS) = T . 1551 1552 op getRightIdSymbol : Module Term ~> Term . 1553 eq getRightIdSymbol(M,F[TL]) = getRightIdSymbol(M,F,getTypes(M,TL)) . 1554 1555 op getRightIdSymbol : Module Qid TypeList ~> Term . 1556 eq getRightIdSymbol(M,F,TPL) = getRightIdSymbol(getOpsOfQid(M,F,TPL)) . 1557 1558 op getRightIdSymbol : OpDeclSet ~> Term . 1559 eq getRightIdSymbol((op F : TPL -> TP [right-id(T) AtS] .) OPDS) = T . 1560 1561 *** anyIdSymbol ****************************** 1562 op anyIdSymbol : Module Term -> Bool . 1563 eq anyIdSymbol(M,C:Constant) 1564 = false . 1565 eq anyIdSymbol(M,V:Variable) 1566 = false . 1567 eq anyIdSymbol(M,F:Qid[TL:TermList]) 1568 = getIdSymbol(M,F:Qid[TL:TermList]) :: Term 1569 or-else 1570 anyIdSymbol*(M,TL:TermList) . 1571 1572 op anyIdSymbol* : Module TermList -> Bool . 1573 eq anyIdSymbol*(M,empty) 1574 = false . 1575 eq anyIdSymbol*(M,(T:Term,TL:TermList)) 1576 = anyIdSymbol(M,T:Term) 1577 or-else 1578 anyIdSymbol*(M,TL:TermList) . 1579 1580 **** 1581 op anyIdSymbol : Module Substitution -> Bool . 1582 eq anyIdSymbol(M,(none).Substitution) = false . 1583 eq anyIdSymbol(M,V:Variable <- T:Term ; S:Substitution) 1584 = anyIdSymbol(M,T:Term) 1585 or-else 1586 anyIdSymbol(M,S:Substitution) . 1587 1588 *** eSameKind ****************************** 1589 op eSameKind : Module TypeList TypeList -> Bool [memo] . 1590 eq eSameKind(M,TP TPL, TP' TPL') 1591 = sameKind(M,TP,TP') and eSameKind(M,TPL,TPL') . 1592 eq eSameKind(M,nil,nil) = true . 1593 eq eSameKind(M,TPL,nil) = true . 1594 eq eSameKind(M,nil,TPL') = true . 1595 ---eq eSameKind(M,TPL,TPL') = false [owise] . 1596 1597 *** eqs2rls ******************************* 1598 sort EqSet&RlsSet . 1599 op {_,_} : EquationSet RuleSet -> EqSet&RlsSet . 1600 op getEqs : EqSet&RlsSet -> EquationSet . 1601 eq getEqs({EqS,RlS}) = EqS . 1602 op getRls : EqSet&RlsSet -> RuleSet . 1603 eq getRls({EqS,RlS}) = RlS . 1604 1605 op eqs2rls# : EquationSet -> EqSet&RlsSet [memo] . 1606 eq eqs2rls#(none) = {none,none} . 1607 eq eqs2rls#((eq Lhs = Rhs [AtS] .) EqS) 1608 = {getEqs(eqs2rls#(EqS)), 1609 (rl Lhs => Rhs [AtS] .) getRls(eqs2rls#(EqS)) 1610 } . 1611 eq eqs2rls#((ceq Lhs = Rhs if Cond [AtS] .) EqS) 1612 = {getEqs(eqs2rls#(EqS)), 1613 (crl Lhs => Rhs if Cond [AtS] .) getRls(eqs2rls#(EqS)) 1614 } . 1615 1616 op eqs2rls : SModule -> SModule . 1617 eq eqs2rls( 1618 mod Q:Qid is 1619 IL:ImportList 1620 sorts S:SortSet . 1621 S:SubsortDeclSet 1622 O:OpDeclSet 1623 M:MembAxSet 1624 E:EquationSet 1625 R:RuleSet 1626 endm) 1627 = mod (addsufix '-EQS2RLS To Q:Qid) is 1628 IL:ImportList 1629 sorts S:SortSet . 1630 S:SubsortDeclSet 1631 O:OpDeclSet 1632 M:MembAxSet 1633 getEqs(eqs2rls#(E:EquationSet)) 1634 getRls(eqs2rls#(E:EquationSet)) 1635 endm . 1636 1637 op eqs2rls : FModule -> FModule . 1638 eq eqs2rls( 1639 fmod Q:Qid is 1640 IL:ImportList 1641 sorts S:SortSet . 1642 S:SubsortDeclSet 1643 O:OpDeclSet 1644 M:MembAxSet 1645 E:EquationSet 1646 endfm) 1647 = mod (addsufix '-EQS2RLS To Q:Qid) is 1648 IL:ImportList 1649 sorts S:SortSet . 1650 S:SubsortDeclSet 1651 O:OpDeclSet 1652 M:MembAxSet 1653 getEqs(eqs2rls#(E:EquationSet)) 1654 getRls(eqs2rls#(E:EquationSet)) 1655 endm . 1656 1657 op eqsNoBuiltInUnify2rls : SModule -> SModule . 1658 eq eqsNoBuiltInUnify2rls( 1659 mod Q:Qid is 1660 IL:ImportList 1661 sorts S:SortSet . 1662 S:SubsortDeclSet 1663 O:OpDeclSet 1664 M:MembAxSet 1665 E:EquationSet 1666 R:RuleSet 1667 endm) 1668 = mod (addsufix '-EQS2RLS To Q:Qid) is 1669 IL:ImportList 1670 sorts S:SortSet . 1671 S:SubsortDeclSet 1672 O:OpDeclSet 1673 M:MembAxSet 1674 (getEqs(eqs2rls#(getEqsNoBuiltInUnify(E:EquationSet))) getEqsBuiltInUnify(E:EquationSet)) 1675 getRls(eqs2rls#(getEqsNoBuiltInUnify(E:EquationSet))) 1676 endm . 1677 1678 op eqsNoBuiltInUnify2rls : FModule -> SModule . 1679 eq eqsNoBuiltInUnify2rls( 1680 fmod Q:Qid is 1681 IL:ImportList 1682 sorts S:SortSet . 1683 S:SubsortDeclSet 1684 O:OpDeclSet 1685 M:MembAxSet 1686 E:EquationSet 1687 endfm) 1688 = mod (addsufix '-EQS2RLS To Q:Qid) is 1689 IL:ImportList 1690 sorts S:SortSet . 1691 S:SubsortDeclSet 1692 O:OpDeclSet 1693 M:MembAxSet 1694 (getEqs(eqs2rls#(getEqsNoBuiltInUnify(E:EquationSet))) getEqsBuiltInUnify(E:EquationSet)) 1695 getRls(eqs2rls#(getEqsNoBuiltInUnify(E:EquationSet))) 1696 endm . 1697 1698 op eqsNoVariant2rls : SModule -> SModule . 1699 eq eqsNoVariant2rls( 1700 mod Q:Qid is 1701 IL:ImportList 1702 sorts S:SortSet . 1703 S:SubsortDeclSet 1704 O:OpDeclSet 1705 M:MembAxSet 1706 E:EquationSet 1707 R:RuleSet 1708 endm) 1709 = mod (addsufix '-EQS2RLS To Q:Qid) is 1710 IL:ImportList 1711 sorts S:SortSet . 1712 S:SubsortDeclSet 1713 O:OpDeclSet 1714 M:MembAxSet 1715 (getEqs(eqs2rls#(getEqsNoVariant(E:EquationSet))) getEqsVariant(E:EquationSet)) 1716 getRls(eqs2rls#(getEqsNoVariant(E:EquationSet))) 1717 endm . 1718 1719 op eqsNoVariant2rls : FModule -> SModule . 1720 eq eqsNoVariant2rls( 1721 fmod Q:Qid is 1722 IL:ImportList 1723 sorts S:SortSet . 1724 S:SubsortDeclSet 1725 O:OpDeclSet 1726 M:MembAxSet 1727 E:EquationSet 1728 endfm) 1729 = mod (addsufix '-EQS2RLS To Q:Qid) is 1730 IL:ImportList 1731 sorts S:SortSet . 1732 S:SubsortDeclSet 1733 O:OpDeclSet 1734 M:MembAxSet 1735 (getEqs(eqs2rls#(getEqsNoVariant(E:EquationSet))) getEqsVariant(E:EquationSet)) 1736 getRls(eqs2rls#(getEqsNoVariant(E:EquationSet))) 1737 endm . 1738 1739 op eqsVariant2rls : SModule -> SModule . 1740 eq eqsVariant2rls( 1741 mod Q:Qid is 1742 IL:ImportList 1743 sorts S:SortSet . 1744 S:SubsortDeclSet 1745 O:OpDeclSet 1746 M:MembAxSet 1747 E:EquationSet 1748 R:RuleSet 1749 endm) 1750 = mod (addsufix '-EQS2RLS To Q:Qid) is 1751 IL:ImportList 1752 sorts S:SortSet . 1753 S:SubsortDeclSet 1754 O:OpDeclSet 1755 M:MembAxSet 1756 (getEqs(eqs2rls#(getEqsVariant(E:EquationSet))) getEqsNoVariant(E:EquationSet)) 1757 getRls(eqs2rls#(getEqsVariant(E:EquationSet))) 1758 endm . 1759 1760 op eqsVariant2rls : FModule -> SModule . 1761 eq eqsVariant2rls( 1762 fmod Q:Qid is 1763 IL:ImportList 1764 sorts S:SortSet . 1765 S:SubsortDeclSet 1766 O:OpDeclSet 1767 M:MembAxSet 1768 E:EquationSet 1769 endfm) 1770 = mod (addsufix '-EQS2RLS To Q:Qid) is 1771 IL:ImportList 1772 sorts S:SortSet . 1773 S:SubsortDeclSet 1774 O:OpDeclSet 1775 M:MembAxSet 1776 (getEqs(eqs2rls#(getEqsVariant(E:EquationSet))) getEqsNoVariant(E:EquationSet)) 1777 getRls(eqs2rls#(getEqsVariant(E:EquationSet))) 1778 endm . 1779 1780 op removeVariantLabel : SModule -> SModule . 1781 eq removeVariantLabel( 1782 mod Q:Qid is 1783 IL:ImportList 1784 sorts S:SortSet . 1785 S:SubsortDeclSet 1786 O:OpDeclSet 1787 M:MembAxSet 1788 E:EquationSet 1789 R:RuleSet 1790 endm) 1791 = mod (addsufix '-EQSV2EQSNV To Q:Qid) is 1792 IL:ImportList 1793 sorts S:SortSet . 1794 S:SubsortDeclSet 1795 O:OpDeclSet 1796 M:MembAxSet 1797 removeVariantLabel(E:EquationSet) 1798 R:RuleSet 1799 endm . 1800 1801 op removeVariantLabel : FModule -> SModule . 1802 eq removeVariantLabel( 1803 fmod Q:Qid is 1804 IL:ImportList 1805 sorts S:SortSet . 1806 S:SubsortDeclSet 1807 O:OpDeclSet 1808 M:MembAxSet 1809 E:EquationSet 1810 endfm) 1811 = fmod (addsufix '-EQSV2EQSNV To Q:Qid) is 1812 IL:ImportList 1813 sorts S:SortSet . 1814 S:SubsortDeclSet 1815 O:OpDeclSet 1816 M:MembAxSet 1817 removeVariantLabel(E:EquationSet) 1818 endfm . 1819 1820 op removeVariantLabel : EquationSet -> EquationSet . 1821 eq removeVariantLabel((eq Lhs = Rhs [AtS variant] .) EqS) 1822 = (eq Lhs = Rhs [AtS] .) 1823 removeVariantLabel(EqS) . 1824 eq removeVariantLabel(EqS) 1825 = EqS [owise] . 1826 1827 *** getEqsNoBuiltInUnify ******************************* 1828 op getEqsNoBuiltInUnify : Module -> EquationSet . 1829 eq getEqsNoBuiltInUnify( 1830 fmod Q:Qid is 1831 IL:ImportList 1832 sorts S:SortSet . 1833 S:SubsortDeclSet 1834 O:OpDeclSet 1835 M:MembAxSet 1836 E:EquationSet 1837 endfm) 1838 = getEqsNoBuiltInUnify(E:EquationSet) . 1839 eq getEqsNoBuiltInUnify( 1840 mod Q:Qid is 1841 IL:ImportList 1842 sorts S:SortSet . 1843 S:SubsortDeclSet 1844 O:OpDeclSet 1845 M:MembAxSet 1846 E:EquationSet 1847 R:RuleSet 1848 endm) 1849 = getEqsNoBuiltInUnify(E:EquationSet) . 1850 1851 op getEqsNoBuiltInUnify : EquationSet -> EquationSet [memo] . 1852 eq getEqsNoBuiltInUnify(none) = none . 1853 eq getEqsNoBuiltInUnify((eq Lhs = Rhs [AtS metadata("builtin-unify")] .) EqS) 1854 = getEqsNoBuiltInUnify(EqS) . 1855 eq getEqsNoBuiltInUnify((eq Lhs = Rhs [AtS] .) EqS) 1856 = (eq Lhs = Rhs [AtS] .) getEqsNoBuiltInUnify(EqS) 1857 [owise] . 1858 eq getEqsNoBuiltInUnify((ceq Lhs = Rhs if Cond [AtS] .) EqS) 1859 = (ceq Lhs = Rhs if Cond [AtS] .) getEqsNoBuiltInUnify(EqS) . 1860 1861 *** getEqsNoVariant ******************************* 1862 op getEqsNoVariant : Module -> EquationSet . 1863 eq getEqsNoVariant( 1864 fmod Q:Qid is 1865 IL:ImportList 1866 sorts S:SortSet . 1867 S:SubsortDeclSet 1868 O:OpDeclSet 1869 M:MembAxSet 1870 E:EquationSet 1871 endfm) 1872 = getEqsNoVariant(E:EquationSet) . 1873 eq getEqsNoVariant( 1874 mod Q:Qid is 1875 IL:ImportList 1876 sorts S:SortSet . 1877 S:SubsortDeclSet 1878 O:OpDeclSet 1879 M:MembAxSet 1880 E:EquationSet 1881 R:RuleSet 1882 endm) 1883 = getEqsNoVariant(E:EquationSet) . 1884 1885 op getEqsNoVariant : EquationSet -> EquationSet [memo] . 1886 eq getEqsNoVariant(none) = none . 1887 eq getEqsNoVariant((eq Lhs = Rhs [AtS variant] .) EqS) 1888 = getEqsNoVariant(EqS) . 1889 eq getEqsNoVariant((eq Lhs = Rhs [AtS] .) EqS) 1890 = (eq Lhs = Rhs [AtS] .) getEqsNoVariant(EqS) 1891 [owise] . 1892 eq getEqsNoVariant((ceq Lhs = Rhs if Cond [AtS] .) EqS) 1893 = (ceq Lhs = Rhs if Cond [AtS] .) getEqsNoVariant(EqS) . 1894 1895 *** getEqsVariant ******************************* 1896 op getEqsVariant : Module -> EquationSet . 1897 eq getEqsVariant( 1898 fmod Q:Qid is 1899 IL:ImportList 1900 sorts S:SortSet . 1901 S:SubsortDeclSet 1902 O:OpDeclSet 1903 M:MembAxSet 1904 E:EquationSet 1905 endfm) 1906 = getEqsVariant(E:EquationSet) . 1907 eq getEqsVariant( 1908 mod Q:Qid is 1909 IL:ImportList 1910 sorts S:SortSet . 1911 S:SubsortDeclSet 1912 O:OpDeclSet 1913 M:MembAxSet 1914 E:EquationSet 1915 R:RuleSet 1916 endm) 1917 = getEqsVariant(E:EquationSet) . 1918 1919 op getEqsVariant : EquationSet -> EquationSet [memo] . 1920 eq getEqsVariant(none) = none . 1921 eq getEqsVariant((eq Lhs = Rhs [AtS variant] .) EqS) 1922 = (eq Lhs = Rhs [AtS variant] .) 1923 getEqsVariant(EqS) . 1924 eq getEqsVariant((eq Lhs = Rhs [AtS] .) EqS) 1925 = getEqsVariant(EqS) 1926 [owise] . 1927 eq getEqsVariant((ceq Lhs = Rhs if Cond [AtS] .) EqS) 1928 = (ceq Lhs = Rhs if Cond [AtS] .) getEqsVariant(EqS) . 1929 1930 *** onlyEqsNoBuiltInUnify ******************************* 1931 op onlyEqsNoBuiltInUnify : Module -> Module . 1932 eq onlyEqsNoBuiltInUnify( 1933 fmod Q:Qid is 1934 IL:ImportList 1935 sorts S:SortSet . 1936 S:SubsortDeclSet 1937 O:OpDeclSet 1938 M:MembAxSet 1939 E:EquationSet 1940 endfm) 1941 = fmod (addsufix '-OnlyEqsNoBuiltInUnify To Q:Qid) is 1942 IL:ImportList 1943 sorts S:SortSet . 1944 S:SubsortDeclSet 1945 O:OpDeclSet 1946 M:MembAxSet 1947 getEqsNoBuiltInUnify(E:EquationSet) 1948 endfm . 1949 eq onlyEqsNoBuiltInUnify( 1950 mod Q:Qid is 1951 IL:ImportList 1952 sorts S:SortSet . 1953 S:SubsortDeclSet 1954 O:OpDeclSet 1955 M:MembAxSet 1956 E:EquationSet 1957 R:RuleSet 1958 endm) 1959 = mod (addsufix '-OnlyEqsNoBuiltInUnify To Q:Qid) is 1960 IL:ImportList 1961 sorts S:SortSet . 1962 S:SubsortDeclSet 1963 O:OpDeclSet 1964 M:MembAxSet 1965 getEqsNoBuiltInUnify(E:EquationSet) 1966 R:RuleSet 1967 endm . 1968 1969 *** onlyEqsNoVariant ******************************* 1970 op onlyEqsNoVariant : Module -> Module . 1971 eq onlyEqsNoVariant( 1972 fmod Q:Qid is 1973 IL:ImportList 1974 sorts S:SortSet . 1975 S:SubsortDeclSet 1976 O:OpDeclSet 1977 M:MembAxSet 1978 E:EquationSet 1979 endfm) 1980 = fmod (addsufix '-OnlyEqsNoVariant To Q:Qid) is 1981 IL:ImportList 1982 sorts S:SortSet . 1983 S:SubsortDeclSet 1984 O:OpDeclSet 1985 M:MembAxSet 1986 getEqsNoVariant(E:EquationSet) 1987 endfm . 1988 eq onlyEqsNoVariant( 1989 mod Q:Qid is 1990 IL:ImportList 1991 sorts S:SortSet . 1992 S:SubsortDeclSet 1993 O:OpDeclSet 1994 M:MembAxSet 1995 E:EquationSet 1996 R:RuleSet 1997 endm) 1998 = mod (addsufix '-OnlyEqsNoVariant To Q:Qid) is 1999 IL:ImportList 2000 sorts S:SortSet . 2001 S:SubsortDeclSet 2002 O:OpDeclSet 2003 M:MembAxSet 2004 getEqsNoVariant(E:EquationSet) 2005 R:RuleSet 2006 endm . 2007 2008 *** getEqsBuiltInUnify ******************************* 2009 op getEqsBuiltInUnify : Module -> EquationSet . 2010 eq getEqsBuiltInUnify( 2011 fmod Q:Qid is 2012 IL:ImportList 2013 sorts S:SortSet . 2014 S:SubsortDeclSet 2015 O:OpDeclSet 2016 M:MembAxSet 2017 E:EquationSet 2018 endfm) 2019 = getEqsBuiltInUnify(E:EquationSet) . 2020 eq getEqsBuiltInUnify( 2021 mod Q:Qid is 2022 IL:ImportList 2023 sorts S:SortSet . 2024 S:SubsortDeclSet 2025 O:OpDeclSet 2026 M:MembAxSet 2027 E:EquationSet 2028 R:RuleSet 2029 endm) 2030 = getEqsBuiltInUnify(E:EquationSet) . 2031 2032 op getEqsBuiltInUnify : EquationSet -> EquationSet [memo] . 2033 eq getEqsBuiltInUnify(none) = none . 2034 eq getEqsBuiltInUnify((eq Lhs = Rhs [AtS metadata("builtin-unify")] .) EqS) 2035 = (eq Lhs = Rhs [AtS metadata("builtin-unify")] .) getEqsBuiltInUnify(EqS) . 2036 eq getEqsBuiltInUnify((eq Lhs = Rhs [AtS] .) EqS) 2037 = getEqsBuiltInUnify(EqS) 2038 [owise] . 2039 eq getEqsBuiltInUnify((ceq Lhs = Rhs if Cond [AtS] .) EqS) 2040 = getEqsBuiltInUnify(EqS) . 2041 2042 *** getEqsVariant ******************************* 2043 op getEqsVariant : Module -> EquationSet . 2044 eq getEqsVariant( 2045 fmod Q:Qid is 2046 IL:ImportList 2047 sorts S:SortSet . 2048 S:SubsortDeclSet 2049 O:OpDeclSet 2050 M:MembAxSet 2051 E:EquationSet 2052 endfm) 2053 = getEqsVariant(E:EquationSet) . 2054 eq getEqsVariant( 2055 mod Q:Qid is 2056 IL:ImportList 2057 sorts S:SortSet . 2058 S:SubsortDeclSet 2059 O:OpDeclSet 2060 M:MembAxSet 2061 E:EquationSet 2062 R:RuleSet 2063 endm) 2064 = getEqsVariant(E:EquationSet) . 2065 2066 op getEqsVariant : EquationSet -> EquationSet [memo] . 2067 eq getEqsVariant(none) = none . 2068 eq getEqsVariant((eq Lhs = Rhs [AtS variant] .) EqS) 2069 = (eq Lhs = Rhs [AtS variant] .) getEqsVariant(EqS) . 2070 eq getEqsVariant((eq Lhs = Rhs [AtS] .) EqS) 2071 = getEqsVariant(EqS) 2072 [owise] . 2073 eq getEqsVariant((ceq Lhs = Rhs if Cond [AtS] .) EqS) 2074 = getEqsVariant(EqS) . 2075 2076 *** onlyEqsBuiltInUnify ******************************* 2077 op onlyEqsBuiltInUnify : Module -> Module . 2078 eq onlyEqsBuiltInUnify( 2079 fmod Q:Qid is 2080 IL:ImportList 2081 sorts S:SortSet . 2082 S:SubsortDeclSet 2083 O:OpDeclSet 2084 M:MembAxSet 2085 E:EquationSet 2086 endfm) 2087 = fmod Q:Qid is 2088 IL:ImportList 2089 sorts S:SortSet . 2090 S:SubsortDeclSet 2091 O:OpDeclSet 2092 M:MembAxSet 2093 getEqsBuiltInUnify(E:EquationSet) 2094 endfm . 2095 eq onlyEqsBuiltInUnify( 2096 mod Q:Qid is 2097 IL:ImportList 2098 sorts S:SortSet . 2099 S:SubsortDeclSet 2100 O:OpDeclSet 2101 M:MembAxSet 2102 E:EquationSet 2103 R:RuleSet 2104 endm) 2105 = mod Q:Qid is 2106 IL:ImportList 2107 sorts S:SortSet . 2108 S:SubsortDeclSet 2109 O:OpDeclSet 2110 M:MembAxSet 2111 getEqsBuiltInUnify(E:EquationSet) 2112 R:RuleSet 2113 endm . 2114 2115 *** onlyEqsVariant ******************************* 2116 op onlyEqsVariant : Module -> Module . 2117 eq onlyEqsVariant( 2118 fmod Q:Qid is 2119 IL:ImportList 2120 sorts S:SortSet . 2121 S:SubsortDeclSet 2122 O:OpDeclSet 2123 M:MembAxSet 2124 E:EquationSet 2125 endfm) 2126 = fmod Q:Qid is 2127 IL:ImportList 2128 sorts S:SortSet . 2129 S:SubsortDeclSet 2130 O:OpDeclSet 2131 M:MembAxSet 2132 getEqsVariant(E:EquationSet) 2133 endfm . 2134 eq onlyEqsVariant( 2135 mod Q:Qid is 2136 IL:ImportList 2137 sorts S:SortSet . 2138 S:SubsortDeclSet 2139 O:OpDeclSet 2140 M:MembAxSet 2141 E:EquationSet 2142 R:RuleSet 2143 endm) 2144 = mod Q:Qid is 2145 IL:ImportList 2146 sorts S:SortSet . 2147 S:SubsortDeclSet 2148 O:OpDeclSet 2149 M:MembAxSet 2150 getEqsVariant(E:EquationSet) 2151 R:RuleSet 2152 endm . 2153 2154 *** rls2eqs ******************************* 2155 op rls2eqs# : RuleSet -> EquationSet [memo] . 2156 eq rls2eqs#(none) = none . 2157 eq rls2eqs#((rl Lhs => Rhs [AtS] .) RlS) 2158 = (eq Lhs = Rhs [AtS] .) rls2eqs#(RlS) . 2159 eq rls2eqs#((crl Lhs => Rhs if Cond [AtS] .) RlS) 2160 = (ceq Lhs = Rhs if Cond [AtS] .) rls2eqs#(RlS) . 2161 2162 op rls2eqs : SModule -> SModule . 2163 eq rls2eqs( 2164 mod Q:Qid is 2165 IL:ImportList 2166 sorts S:SortSet . 2167 S:SubsortDeclSet 2168 O:OpDeclSet 2169 M:MembAxSet 2170 E:EquationSet 2171 R:RuleSet 2172 endm) 2173 = mod (addsufix '-RLS2EQS To Q:Qid) is 2174 IL:ImportList 2175 sorts S:SortSet . 2176 S:SubsortDeclSet 2177 O:OpDeclSet 2178 M:MembAxSet 2179 E:EquationSet rls2eqs#(R:RuleSet) 2180 none 2181 endm . 2182 2183 *** flipRls ******************************* 2184 op flipRls : RuleSet -> RuleSet [memo] . 2185 eq flipRls(none) = none . 2186 eq flipRls((rl Lhs => Rhs [AtS] .) RlS:RuleSet) 2187 = if all Vars(Lhs) in Vars(Rhs) 2188 then (rl Rhs => Lhs [removeNonExec(AtS)] .) 2189 else (rl Rhs => Lhs [nonexec removeNonExec(AtS)] .) 2190 fi 2191 flipRls(RlS:RuleSet) . 2192 eq flipRls((crl Lhs => Rhs if Cond [AtS] .) RlS:RuleSet) 2193 = if all Vars(Lhs) in Vars(Rhs) 2194 then (crl Rhs => Lhs if Cond [removeNonExec(AtS)] .) 2195 else (crl Rhs => Lhs if Cond [nonexec removeNonExec(AtS)] .) 2196 fi 2197 flipRls(RlS:RuleSet) . 2198 2199 op removeNonExec : AttrSet -> AttrSet . 2200 eq removeNonExec(nonexec AtS) = AtS . 2201 eq removeNonExec(AtS) = AtS [owise] . 2202 2203 op flipRls : SModule -> SModule . 2204 eq flipRls(mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2205 O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm) 2206 = mod (addsufix '-FLIPPEDRLS To Q:Qid) 2207 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2208 O:OpDeclSet M:MembAxSet E:EquationSet flipRls(R:RuleSet) endm . 2209 2210 *** addOp ******************************* 2211 op addOps : OpDeclSet SModule -> SModule . 2212 eq addOps(OO:OpDeclSet,mod Q:Qid is IL:ImportList sorts S:SortSet . 2213 S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm) 2214 = mod (addsufix '-ADDEDOPS To Q:Qid) 2215 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2216 override(O:OpDeclSet,OO:OpDeclSet) 2217 M:MembAxSet E:EquationSet R:RuleSet endm . 2218 op addOps : OpDeclSet FModule -> FModule . 2219 eq addOps(OO:OpDeclSet,fmod Q:Qid is IL:ImportList sorts S:SortSet . 2220 S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet endfm) 2221 = fmod (addsufix '-ADDEDOPS To Q:Qid) 2222 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2223 override(O:OpDeclSet,OO:OpDeclSet) 2224 M:MembAxSet E:EquationSet endfm . 2225 2226 op override : OpDeclSet OpDeclSet -> OpDeclSet . 2227 eq override( 2228 (op F : TPL -> TP [AtS] .) O:OpDeclSet, 2229 (op F : TPL -> TP [AtS'] .) O':OpDeclSet) 2230 = override(O:OpDeclSet,(op F : TPL -> TP [AtS'] .) O':OpDeclSet) . 2231 eq override(O:OpDeclSet,O':OpDeclSet) 2232 = O:OpDeclSet O':OpDeclSet [owise] . 2233 2234 *** addRules ******************************* 2235 op addRules : RuleSet SModule -> SModule [memo] . 2236 eq addRules(RR:RuleSet,mod Q:Qid is IL:ImportList sorts S:SortSet . 2237 S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm) 2238 = mod (addsufix '-ADDEDRLS To Q:Qid) 2239 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2240 O:OpDeclSet M:MembAxSet E:EquationSet (R:RuleSet RR:RuleSet) endm . 2241 2242 *** addEqs ******************************* 2243 op addEqs : EquationSet SModule -> SModule . 2244 op addEqs : EquationSet FModule -> FModule . 2245 eq addEqs(ES:EquationSet,mod Q:Qid is IL:ImportList sorts S:SortSet . 2246 S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm) 2247 = mod (addsufix '-ADDEDEQS To Q:Qid) 2248 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2249 O:OpDeclSet M:MembAxSet (E:EquationSet ES:EquationSet) R:RuleSet endm . 2250 eq addEqs(ES:EquationSet,fmod Q:Qid is IL:ImportList sorts S:SortSet . 2251 S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet endfm) 2252 = fmod (addsufix '-ADDEDEQS To Q:Qid) 2253 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2254 O:OpDeclSet M:MembAxSet (E:EquationSet ES:EquationSet) endfm . 2255 2256 *** addSorts ******************************* 2257 op addSorts : SortSet SModule -> SModule . 2258 op addSorts : SortSet FModule -> FModule . 2259 eq addSorts(X:SortSet, 2260 mod Q:Qid is IL:ImportList sorts S:SortSet . 2261 S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm) 2262 = mod Q:Qid is IL:ImportList sorts (X:SortSet ; S:SortSet) . 2263 S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm . 2264 eq addSorts(X:SortSet, 2265 fmod Q:Qid is IL:ImportList sorts S:SortSet . 2266 S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet endfm) 2267 = fmod Q:Qid is IL:ImportList sorts (X:SortSet ; S:SortSet) . 2268 S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet endfm . 2269 2270 *** putFrozen ******************************* 2271 op putFrozen : NatList Qid TypeList SModule -> SModule [memo] . 2272 eq putFrozen(NL,F,TPL, 2273 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2274 ((op F : TPL -> TP [frozen(NL') AtS] .) O:OpDeclSet) 2275 M:MembAxSet E:EquationSet R:RuleSet endm)) 2276 = (mod (addsufix F To (addsufix '-FROZEN# To Q:Qid)) 2277 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2278 ((op F : TPL -> TP [frozen(NL) AtS] .) O:OpDeclSet) 2279 M:MembAxSet E:EquationSet R:RuleSet endm) . 2280 eq putFrozen(NL,F,TPL, 2281 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2282 ((op F : TPL -> TP [AtS] .) O:OpDeclSet) 2283 M:MembAxSet E:EquationSet R:RuleSet endm)) 2284 = (mod (addsufix F To (addsufix '-FROZEN# To Q:Qid)) 2285 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2286 ((op F : TPL -> TP [frozen(NL) AtS] .) O:OpDeclSet) 2287 M:MembAxSet E:EquationSet R:RuleSet endm) [owise] . 2288 2289 *** putStrat ******************************* 2290 op putStrat : NatList Qid TypeList SModule -> SModule [memo] . 2291 eq putStrat(NL,F,TPL, 2292 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2293 ((op F : TPL -> TP [strat(NL') AtS] .) O:OpDeclSet) 2294 M:MembAxSet E:EquationSet R:RuleSet endm)) 2295 = (mod (addsufix F To (addsufix '-STRAT#EQ# To Q:Qid)) 2296 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2297 ((op F : TPL -> TP [strat(NL) AtS] .) O:OpDeclSet) 2298 M:MembAxSet E:EquationSet R:RuleSet endm) . 2299 eq putStrat(NL,F,TPL, 2300 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2301 ((op F : TPL -> TP [AtS] .) O:OpDeclSet) 2302 M:MembAxSet E:EquationSet R:RuleSet endm)) 2303 = (mod (addsufix F To (addsufix '-STRAT#EQ# To Q:Qid)) 2304 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2305 ((op F : TPL -> TP [strat(NL) AtS] .) O:OpDeclSet) 2306 M:MembAxSet E:EquationSet R:RuleSet endm) [owise] . 2307 2308 op putStrat : NatList Qid TypeList FModule -> FModule [memo] . 2309 eq putStrat(NL,F,TPL, 2310 (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2311 ((op F : TPL -> TP [strat(NL') AtS] .) O:OpDeclSet) 2312 M:MembAxSet E:EquationSet endfm)) 2313 = (fmod (addsufix F To (addsufix '-STRAT#EQ# To Q:Qid)) 2314 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2315 ((op F : TPL -> TP [strat(NL) AtS] .) O:OpDeclSet) 2316 M:MembAxSet E:EquationSet endfm) . 2317 eq putStrat(NL,F,TPL, 2318 (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2319 ((op F : TPL -> TP [AtS] .) O:OpDeclSet) 2320 M:MembAxSet E:EquationSet endfm)) 2321 = (fmod (addsufix F To (addsufix '-STRAT#EQ# To Q:Qid)) 2322 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2323 ((op F : TPL -> TP [strat(NL) AtS] .) O:OpDeclSet) 2324 M:MembAxSet E:EquationSet endfm) [owise] . 2325 2326 *** clearFrozen ******************************* 2327 op clearFrozen : NatList Qid TypeList SModule -> SModule [memo] . 2328 eq clearFrozen(NL,F,TPL, 2329 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2330 ((op F : TPL -> TP [frozen(NL') AtS] .) O:OpDeclSet) 2331 M:MembAxSet E:EquationSet R:RuleSet endm)) 2332 = (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2333 ((op F : TPL -> TP [AtS] .) O:OpDeclSet) 2334 M:MembAxSet E:EquationSet R:RuleSet endm) . 2335 eq clearFrozen(NL,F,TPL,M) 2336 = M [owise] . 2337 2338 *** clearEqsFrozen ******************************* 2339 op clearEqsFrozen : SModule -> SModule [memo] . 2340 eq clearEqsFrozen(M) 2341 = clearEqsFrozen*(M) . 2342 2343 op clearEqsFrozen* : SModule -> SModule . 2344 eq clearEqsFrozen*( 2345 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2346 ((op F : TPL -> TP [frozen(NL') AtS] .) O:OpDeclSet) 2347 M:MembAxSet 2348 ((eq F[TL] = Rhs [AtS'] .) E:EquationSet) 2349 R:RuleSet endm)) 2350 = clearEqsFrozen*( 2351 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2352 ((op F : TPL -> TP [AtS] .) O:OpDeclSet) 2353 M:MembAxSet 2354 ((eq F[TL] = Rhs [AtS'] .) E:EquationSet) 2355 R:RuleSet endm)) . 2356 eq clearEqsFrozen*(M) 2357 = M [owise] . 2358 2359 *** clearAllFrozen ******************************* 2360 op clearAllFrozen : SModule -> SModule [memo] . 2361 eq clearAllFrozen( 2362 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2363 O:OpDeclSet 2364 M:MembAxSet E:EquationSet R:RuleSet endm)) 2365 = (mod (addsufix '-CLEARFROZEN To Q:Qid) 2366 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2367 clearAllFrozen(O:OpDeclSet) 2368 M:MembAxSet E:EquationSet R:RuleSet endm) . 2369 2370 op clearAllFrozen : FModule -> FModule [memo] . 2371 eq clearAllFrozen( 2372 (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2373 O:OpDeclSet 2374 M:MembAxSet E:EquationSet endfm)) 2375 = (fmod (addsufix '-CLEARFROZEN To Q:Qid) 2376 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2377 clearAllFrozen(O:OpDeclSet) 2378 M:MembAxSet E:EquationSet endfm) . 2379 2380 op clearAllFrozen : OpDeclSet -> OpDeclSet . 2381 eq clearAllFrozen(none) 2382 = none . 2383 eq clearAllFrozen( 2384 (op F : TPL -> TP [frozen(NL) AtS] .) O:OpDeclSet) 2385 = (op F : TPL -> TP [AtS] .) 2386 clearAllFrozen(O:OpDeclSet) . 2387 eq clearAllFrozen( 2388 (op F : TPL -> TP [AtS] .) O:OpDeclSet) 2389 = (op F : TPL -> TP [AtS] .) 2390 clearAllFrozen(O:OpDeclSet) [owise] . 2391 2392 *** anyNonExec ******************************* 2393 op anyNonExec : SModule -> Bool [memo] . 2394 eq anyNonExec( 2395 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2396 O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)) 2397 = anyNonExec(E:EquationSet) or-else anyNonExec(R:RuleSet) . 2398 2399 op anyNonExec : RuleSet -> Bool . 2400 eq anyNonExec( 2401 (rl Lhs => Rhs [nonexec AtS] .) R:RuleSet) 2402 = true . 2403 eq anyNonExec( 2404 (crl Lhs => Rhs if Cond [nonexec AtS] .) R:RuleSet) 2405 = true . 2406 eq anyNonExec(R:RuleSet) 2407 = false [owise] . 2408 2409 op anyNonExec : EquationSet -> Bool . 2410 eq anyNonExec( 2411 (eq Lhs = Rhs [nonexec AtS] .) R:EquationSet) 2412 = true . 2413 eq anyNonExec( 2414 (ceq Lhs = Rhs if Cond [nonexec AtS] .) R:EquationSet) 2415 = true . 2416 eq anyNonExec(R:EquationSet) 2417 = false [owise] . 2418 2419 *** clearNonExec ******************************* 2420 op clearNonExecRls&Eqs : SModule -> SModule [memo] . 2421 eq clearNonExecRls&Eqs(M:SModule) 2422 = clearNonExecRls(clearNonExecEqs(M:SModule)) . 2423 2424 op clearNonExecRls : SModule -> SModule [memo] . 2425 eq clearNonExecRls( 2426 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2427 O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)) 2428 = (mod (addsufix '-CLEARNONEXEC To Q:Qid) 2429 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2430 O:OpDeclSet M:MembAxSet 2431 E:EquationSet clearNonExec(R:RuleSet) endm) . 2432 2433 op clearNonExecEqs : SModule -> SModule [memo] . 2434 eq clearNonExecEqs( 2435 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2436 O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)) 2437 = (mod (addsufix '-CLEARNONEXEC To Q:Qid) 2438 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2439 O:OpDeclSet M:MembAxSet 2440 clearNonExec(E:EquationSet) R:RuleSet endm) . 2441 2442 op clearNonExecEqs : FModule -> FModule [memo] . 2443 eq clearNonExecEqs( 2444 (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2445 O:OpDeclSet M:MembAxSet E:EquationSet endfm)) 2446 = (fmod (addsufix '-CLEARNONEXEC To Q:Qid) 2447 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2448 O:OpDeclSet M:MembAxSet 2449 clearNonExec(E:EquationSet) endfm) . 2450 2451 op clearNonExec : RuleSet -> RuleSet . 2452 eq clearNonExec((none).RuleSet) 2453 = (none).RuleSet . 2454 eq clearNonExec( 2455 (rl Lhs => Rhs [nonexec AtS] .) R:RuleSet) 2456 = (rl Lhs => Rhs [AtS] .) 2457 clearNonExec(R:RuleSet) . 2458 eq clearNonExec( 2459 (rl Lhs => Rhs [AtS] .) R:RuleSet) 2460 = (rl Lhs => Rhs [AtS] .) 2461 clearNonExec(R:RuleSet) [owise] . 2462 2463 op clearNonExec : EquationSet -> EquationSet . 2464 eq clearNonExec((none).EquationSet) 2465 = (none).EquationSet . 2466 eq clearNonExec( 2467 (eq Lhs = Rhs [nonexec AtS] .) R:EquationSet) 2468 = (eq Lhs = Rhs [AtS] .) 2469 clearNonExec(R:EquationSet) . 2470 eq clearNonExec( 2471 (eq Lhs = Rhs [AtS] .) R:EquationSet) 2472 = (eq Lhs = Rhs [AtS] .) 2473 clearNonExec(R:EquationSet) [owise] . 2474 2475 *** eraseRls ******************************* 2476 op eraseRls : Module -> Module [memo] . 2477 eq eraseRls( 2478 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2479 O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)) 2480 = (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2481 O:OpDeclSet M:MembAxSet E:EquationSet none endm) . 2482 eq eraseRls( 2483 (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2484 O:OpDeclSet M:MembAxSet E:EquationSet endfm)) 2485 = (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2486 O:OpDeclSet M:MembAxSet E:EquationSet endfm) . 2487 2488 *** eraseEqs ******************************* 2489 op eraseEqs : Module -> Module [memo] . 2490 eq eraseEqs( 2491 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2492 O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)) 2493 = (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2494 O:OpDeclSet M:MembAxSet none R:RuleSet endm) . 2495 eq eraseEqs( 2496 (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2497 O:OpDeclSet M:MembAxSet E:EquationSet endfm)) 2498 = (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2499 O:OpDeclSet M:MembAxSet none endfm) . 2500 2501 *** flatten ****************************** 2502 op flatten : Module TermList -> TermList . 2503 eq flatten(M,V) = V . 2504 eq flatten(M,C) = C . 2505 eq flatten(M,F[TL:NeTermList]) 2506 = if isAssociative(M,F,getTypes(M,TL:NeTermList)) 2507 then F[aliens(TL:NeTermList,F)] 2508 else F[flatten(M,TL:NeTermList)] 2509 fi . 2510 eq flatten(M,(T:Term,TL:NeTermList)) 2511 = (flatten(M,T:Term),flatten(M,TL:NeTermList)) . 2512 2513 op aliens : TermList Qid -> TermList . 2514 eq aliens(empty,F) = empty . 2515 eq aliens((F[TL':NeTermList],TL:TermList),F) 2516 = aliens((TL':NeTermList,TL:TermList),F) . 2517 eq aliens((T:Term,TL:TermList),F) 2518 = (T:Term,aliens(TL:TermList,F)) [owise] . 2519 2520 *** unflatten ****************************** 2521 op unflatten : Module TermList -> TermList . 2522 eq unflatten(M,T) = unflatten*(M,T) . 2523 2524 op unflatten* : Module TermList -> TermList . 2525 eq unflatten*(M,V) = V . 2526 eq unflatten*(M,C) = C . 2527 eq unflatten*(M,F[TL:NeTermList]) 2528 = if isAssociative(M,F,getTypes(M,TL:NeTermList)) 2529 then unflatten**(M,F,TL:NeTermList) 2530 else F[unflatten*(M,TL:NeTermList)] 2531 fi . 2532 eq unflatten*(M,(T:Term,TL:NeTermList)) 2533 = (unflatten*(M,T:Term),unflatten*(M,TL:NeTermList)) . 2534 2535 op unflatten** : Module Qid TermList -> TermList . 2536 eq unflatten**(M,F,(T1:Term,TL:NeTermList)) 2537 = F[unflatten*(M,T1:Term),unflatten**(M,F,TL:NeTermList)] . 2538 eq unflatten**(M,F,T:Term) 2539 = unflatten*(M,T:Term) . 2540 2541 *** wrapRules_bySymbol_ ******************************* 2542 op wrapRules_bySymbol_ : SModule Qid -> SModule [memo] . 2543 eq wrapRules 2544 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2545 O:OpDeclSet 2546 M:MembAxSet E:EquationSet R:RuleSet endm) 2547 bySymbol F:Qid 2548 = (mod (addsufix F:Qid To (addsufix '-WRAPPED# To Q:Qid)) 2549 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2550 O:OpDeclSet 2551 M:MembAxSet E:EquationSet 2552 wrapRules R:RuleSet bySymbol F:Qid endm) . 2553 2554 op wrapRules_bySymbol_ : RuleSet Qid -> RuleSet . 2555 eq wrapRules none bySymbol F:Qid = none . 2556 eq wrapRules ((rl Lhs => Rhs [AtS] .) RlS:RuleSet) bySymbol F:Qid 2557 = (rl F:Qid[Lhs] => F:Qid[Rhs] [AtS] .) 2558 wrapRules RlS:RuleSet bySymbol F:Qid . 2559 eq wrapRules ((crl Lhs => Rhs if Cond [AtS] .) RlS:RuleSet) bySymbol F:Qid 2560 = (crl F:Qid[Lhs] => F:Qid[Rhs] if Cond [AtS] .) 2561 wrapRules RlS:RuleSet bySymbol F:Qid . 2562 2563 op toSModule : FModule -> SModule . 2564 eq toSModule( 2565 fmod Q:Qid is 2566 IL:ImportList 2567 sorts S:SortSet . 2568 S:SubsortDeclSet 2569 O:OpDeclSet 2570 M:MembAxSet 2571 E:EquationSet 2572 endfm) 2573 = mod (addsufix '-CONVERTED#SMODULE To Q:Qid) is 2574 IL:ImportList 2575 sorts S:SortSet . 2576 S:SubsortDeclSet 2577 O:OpDeclSet 2578 M:MembAxSet 2579 E:EquationSet 2580 none 2581 endm . 2582 2583 op newName : Qid SModule -> SModule . 2584 op newName : Qid FModule -> FModule . 2585 eq newName(F:Qid, 2586 fmod Q:Qid is 2587 IL:ImportList 2588 sorts S:SortSet . 2589 S:SubsortDeclSet 2590 O:OpDeclSet 2591 M:MembAxSet 2592 E:EquationSet 2593 endfm) 2594 = fmod F:Qid is 2595 IL:ImportList 2596 sorts S:SortSet . 2597 S:SubsortDeclSet 2598 O:OpDeclSet 2599 M:MembAxSet 2600 E:EquationSet 2601 endfm . 2602 eq newName(F:Qid, 2603 mod Q:Qid is 2604 IL:ImportList 2605 sorts S:SortSet . 2606 S:SubsortDeclSet 2607 O:OpDeclSet 2608 M:MembAxSet 2609 E:EquationSet 2610 R:RuleSet 2611 endm) 2612 = mod F:Qid is 2613 IL:ImportList 2614 sorts S:SortSet . 2615 S:SubsortDeclSet 2616 O:OpDeclSet 2617 M:MembAxSet 2618 E:EquationSet 2619 R:RuleSet 2620 endm . 2621 2622 *** 2623 op removeBoolEqs : Module -> Module [memo] . 2624 eq removeBoolEqs( 2625 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2626 O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)) 2627 = (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2628 O:OpDeclSet M:MembAxSet 2629 removeBoolEqs(E:EquationSet) 2630 R:RuleSet endm) . 2631 eq removeBoolEqs( 2632 (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2633 O:OpDeclSet M:MembAxSet E:EquationSet endfm)) 2634 = (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2635 O:OpDeclSet M:MembAxSet 2636 removeBoolEqs(E:EquationSet) endfm) . 2637 2638 op removeBoolEqs : EquationSet -> EquationSet . 2639 eq removeBoolEqs((eq '_and_[TL] = Rhs [AtS] .) EqS) 2640 = removeBoolEqs(EqS) . 2641 eq removeBoolEqs((eq 'not_[TL] = Rhs [AtS] .) EqS) 2642 = removeBoolEqs(EqS) . 2643 eq removeBoolEqs((eq '_or_[TL] = Rhs [AtS] .) EqS) 2644 = removeBoolEqs(EqS) . 2645 eq removeBoolEqs((eq '_xor_[TL] = Rhs [AtS] .) EqS) 2646 = removeBoolEqs(EqS) . 2647 eq removeBoolEqs((eq '_implies_[TL] = Rhs [AtS] .) EqS) 2648 = removeBoolEqs(EqS) . 2649 eq removeBoolEqs(EqS) 2650 = EqS [owise] . 2651 2652 ******************************************* 2653 op keepOnlyACAttr : Module -> Module [memo] . 2654 eq keepOnlyACAttr( 2655 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2656 O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)) 2657 = (mod (addsufix '-REMOVED-ID-SYMBOLS To Q:Qid) 2658 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2659 keepOnlyACAttr*(O:OpDeclSet) 2660 M:MembAxSet E:EquationSet R:RuleSet endm) . 2661 eq keepOnlyACAttr( 2662 (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2663 O:OpDeclSet M:MembAxSet E:EquationSet endfm)) 2664 = (fmod (addsufix '-REMOVED-ID-SYMBOLS To Q:Qid) 2665 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2666 keepOnlyACAttr*(O:OpDeclSet) 2667 M:MembAxSet E:EquationSet endfm) . 2668 2669 op keepOnlyACAttr* : OpDeclSet -> OpDeclSet . 2670 eq keepOnlyACAttr*((op F : TPL -> TP [id(T) AtS] .) OPDS) 2671 = keepOnlyACAttr*((op F : TPL -> TP [AtS] .) OPDS) . 2672 eq keepOnlyACAttr*((op F : TPL -> TP [left-id(T) AtS] .) OPDS) 2673 = keepOnlyACAttr*((op F : TPL -> TP [AtS] .) OPDS) . 2674 eq keepOnlyACAttr*((op F : TPL -> TP [right-id(T) AtS] .) OPDS) 2675 = keepOnlyACAttr*((op F : TPL -> TP [AtS] .) OPDS) . 2676 eq keepOnlyACAttr*(OPDS) 2677 = removeAssocAttr(OPDS) [owise] . 2678 2679 op _in#_ : Attr AttrSet -> Bool . 2680 eq X:Attr in# X:Attr X:AttrSet = true . 2681 eq X:Attr in# X:AttrSet = false [owise] . 2682 2683 op removeAssocAttr : OpDeclSet -> OpDeclSet . 2684 eq removeAssocAttr((op F : TPL -> TP [assoc AtS] .) OPDS) 2685 = if comm in# AtS 2686 then (op F : TPL -> TP [assoc AtS] .) removeAssocAttr(OPDS) 2687 else removeAssocAttr((op F : TPL -> TP [AtS] .) OPDS) 2688 fi . 2689 eq removeAssocAttr(OPDS) 2690 = OPDS [owise] . 2691 2692 ******************************************* 2693 op keepOnlyACUAttr : Module -> Module [memo] . 2694 eq keepOnlyACUAttr( 2695 (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2696 O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)) 2697 = (mod (addsufix '-REMOVED-ID-SYMBOLS To Q:Qid) 2698 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2699 keepOnlyACUAttr*(O:OpDeclSet) 2700 M:MembAxSet E:EquationSet R:RuleSet endm) . 2701 eq keepOnlyACUAttr( 2702 (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2703 O:OpDeclSet M:MembAxSet E:EquationSet endfm)) 2704 = (fmod (addsufix '-REMOVED-ID-SYMBOLS To Q:Qid) 2705 is IL:ImportList sorts S:SortSet . S:SubsortDeclSet 2706 keepOnlyACUAttr*(O:OpDeclSet) 2707 M:MembAxSet E:EquationSet endfm) . 2708 2709 op keepOnlyACUAttr* : OpDeclSet -> OpDeclSet . 2710 eq keepOnlyACUAttr*(OPDS) 2711 = removeAssocAttr(OPDS) . 2712 2713endfm 2714 2715fmod VARIANT is 2716 pr SUBSTITUTION-HANDLING . 2717 pr MODULE-HANDLING . 2718 pr META-LEVEL-MNPA . 2719 2720 var M : Module . 2721 vars T T' TS TS' CtTS CtTS' Lhs Rhs : Term . 2722 vars N N' NextVar NextVar' NextVar'' : Nat . 2723 var B : Bound . 2724 var TL TL' : TermList . 2725 var NeTL : NeTermList . 2726 var EqS : EquationSet . 2727 var AtS : AttrSet . 2728 var Q : Qid . 2729 vars S S' : Substitution . 2730 var V : Variable . 2731 vars TP TP' : Type . 2732 var C : Constant . 2733 vars F F' : Qid . 2734 2735 --- Variants ---------------------------------------------------------- 2736--- sort VariantTriple . 2737--- op {_,_,_} : Term Substitution Nat -> VariantTriple [ctor] . 2738 2739 sort VariantTripleSet . 2740--- subsort VariantTriple < VariantTripleSet . 2741 subsort Variant < VariantTripleSet . 2742 op empty : -> VariantTripleSet [ctor] . 2743 op _|_ : VariantTripleSet VariantTripleSet -> VariantTripleSet 2744 [ctor assoc comm id: empty prec 65 format (d d n d)] . 2745--- eq X:VariantTriple | X:VariantTriple = X:VariantTriple . 2746 eq X:Variant | X:Variant = X:Variant . 2747 2748 op getTerms : VariantTripleSet -> TermSet . 2749 eq getTerms({T:Term,S:Substitution,NextVar:Nat,Parent:Parent,B:Bool} 2750 | R:VariantTripleSet) 2751 = T:Term | getTerms(R:VariantTripleSet) . 2752 eq getTerms((empty).VariantTripleSet) 2753 = emptyTermSet . 2754 2755 op getSubstitutions : VariantTripleSet -> SubstitutionSet . 2756 eq getSubstitutions({T:Term,S:Substitution,NextVar:Nat,Parent:Parent,B:Bool} 2757 | R:VariantTripleSet) 2758 = S:Substitution | getSubstitutions(R:VariantTripleSet) . 2759 eq getSubstitutions((empty).VariantTripleSet) 2760 = empty . 2761 2762 --- Variants ---------------------------------------------------------- 2763 sort VariantFour . 2764 op {_,_,_,_} : Term Substitution Substitution Nat -> VariantFour [ctor] . 2765 2766 sort VariantFourSet . 2767 subsort VariantFour < VariantFourSet . 2768 op empty : -> VariantFourSet [ctor] . 2769 op _|_ : VariantFourSet VariantFourSet -> VariantFourSet 2770 [ctor assoc comm id: empty prec 65 format (d d n d)] . 2771 eq X:VariantFour | X:VariantFour = X:VariantFour . 2772 2773endfm 2774 2775fmod META-MINIMIZE-BINDINGS is 2776 pr SUBSTITUTION-HANDLING . 2777 pr MODULE-HANDLING . 2778 pr SUBSTITUTIONSET . 2779 pr UNIFICATIONTRIPLESET . 2780 pr CONVERSION . 2781 pr META-LEVEL-MNPA . 2782 pr VARIANT . 2783 2784 vars M : Module . 2785 vars T T' T1 T2 T3 : Term . 2786 vars TL TL' TL1 TL2 TL3 : TermList . 2787 vars F F' : Qid . 2788 vars S S' S* S'* : Substitution . 2789 vars V V' V1 V2 : Variable . 2790 vars N N' NOld : Nat . 2791 var US? : [UnificationTripleSet] . 2792 vars US US' : UnificationTripleSet . 2793 vars VTS VTS' : VariantFourSet . 2794 2795 --- minimizeBindings --- 2796 op minimizeBindingsTerm : Module TermList UnificationTripleSet 2797 -> UnificationTripleSet . 2798 eq minimizeBindingsTerm(M,TL,US) 2799 = minimizeBindingsTerm(M,TL,highestVar(TL),US) . 2800 2801 op minimizeBindingsTerm : Module TermList Nat UnificationTripleSet 2802 -> UnificationTripleSet . 2803 eq minimizeBindingsTerm(M,TL,NOld,US) 2804 = minimizeBindingsTerm*(M,TL,NOld,US,empty) . 2805 2806 op minimizeBindingsTerm* : Module TermList Nat UnificationTripleSet 2807 UnificationTripleSet -> UnificationTripleSet . 2808 eq minimizeBindingsTerm*(M,TL,NOld,empty,US') 2809 = US' . 2810 eq minimizeBindingsTerm*(M,TL,NOld,{S,S',N} | US,US') 2811 = minimizeBindingsTerm*(M,TL,NOld,US, 2812 US' | minimizeBindingsTerm**(M,TL,NOld,{S,S',N},S,S') 2813 ) . 2814 2815 **************** 2816 op minimizeBindingsTerm** : Module TermList ---variables to minimize bindings 2817 Nat --- or maximum index of variables 2818 UnificationTriple Substitution Substitution 2819 -> UnificationTriple . 2820 eq minimizeBindingsTerm**(M,TL',NOld,{S*,S'*,N},none,none) 2821 = {remDup(S*),remDup(S'*),N} . 2822 2823 ceq minimizeBindingsTerm**(M,TL',NOld,{S*,V <- V' ; S'*,N},none,V <- V' ; S') 2824 = minimizeBindingsTerm**(M,TL',NOld, 2825 { S* << (V' <- V), S'* .. (V' <- V), N}, 2826 none, 2827 S' .. (V' <- V) 2828 ) 2829 if V' =/= V and-then not (V in TL') and-then not (V' in TL') 2830 and-then highestVar(V) < NOld 2831 and-then highestVar(V') >= NOld 2832 and-then typeLeq(M,getTypes(M,V),getTypes(M,V')) . 2833 2834 eq minimizeBindingsTerm**(M,TL',NOld,{S*,V <- T' ; S'*,N},none,V <- T' ; S') 2835 = minimizeBindingsTerm**(M,TL',NOld,{S*,V <- T' ; S'*,N},none,S') 2836 [owise] . 2837 2838 ceq minimizeBindingsTerm**(M,TL',NOld,{V <- V' ; S*,S'*,N},V <- V' ; S,S') 2839 = minimizeBindingsTerm**(M,TL',NOld, 2840 { S* << (V' <- V), S'* .. (V' <- V), N}, 2841 S << (V' <- V), 2842 S' .. (V' <- V) 2843 ) 2844 if V' =/= V and-then V in TL' and-then not (V' in TL') 2845 and-then typeLeq(M,getTypes(M,V),getTypes(M,V')) . 2846 2847 eq minimizeBindingsTerm**(M,TL',NOld,{V <- T' ; S*,S'*,N},V <- T' ; S,S') 2848 = minimizeBindingsTerm**(M,TL',NOld,{V <- T' ; S*,S'*,N},S,S') 2849 [owise] . 2850 2851 --- minimizeBindings --- 2852 op minimizeBindingsTerm : Module TermList VariantFourSet 2853 -> VariantFourSet . 2854 eq minimizeBindingsTerm(M,TL,VTS) 2855 = minimizeBindingsTerm(M,TL,highestVar(TL),VTS) . 2856 2857 op minimizeBindingsTerm : Module TermList Nat VariantFourSet 2858 -> VariantFourSet . 2859 eq minimizeBindingsTerm(M,TL,NOld,VTS) 2860 = minimizeBindingsTerm*(M,TL,NOld,VTS,empty) . 2861 2862 op minimizeBindingsTerm* : Module TermList Nat VariantFourSet 2863 VariantFourSet -> VariantFourSet . 2864 eq minimizeBindingsTerm*(M,TL,NOld,empty,VTS') 2865 = VTS' . 2866 eq minimizeBindingsTerm*(M,TL,NOld,{T,S,S',N} | VTS,VTS') 2867 = minimizeBindingsTerm*(M,TL,NOld,VTS, 2868 VTS' | minimizeBindingsTerm**(M,TL,NOld,{T,S,S',N},S,S') 2869 ) . 2870 2871 **************** 2872 op minimizeBindingsTerm** : Module TermList ---variables to minimize bindings 2873 Nat --- or maximum index of variables 2874 VariantFour Substitution Substitution 2875 -> VariantFour . 2876 eq minimizeBindingsTerm**(M,TL',NOld,{T,S*,S'*,N},none,none) 2877 = {T,remDup(S*),remDup(S'*),N} . 2878 2879 ceq minimizeBindingsTerm**(M,TL',NOld,{T,S*,V <- V' ; S'*,N},none,V <- V' ; S') 2880 = minimizeBindingsTerm**(M,TL',NOld, 2881 { T << (V' <- V), S* << (V' <- V), S'* .. (V' <- V), N}, 2882 none, 2883 S' .. (V' <- V) 2884 ) 2885 if V' =/= V and-then not (V in TL') and-then not (V' in TL') 2886 and-then highestVar(V) < NOld 2887 and-then highestVar(V') >= NOld 2888 and-then typeLeq(M,getTypes(M,V),getTypes(M,V')) . 2889 2890 eq minimizeBindingsTerm**(M,TL',NOld,{T,S*,V <- T' ; S'*,N},none,V <- T' ; S') 2891 = minimizeBindingsTerm**(M,TL',NOld,{T,S*,V <- T' ; S'*,N},none,S') 2892 [owise] . 2893 2894 ceq minimizeBindingsTerm**(M,TL',NOld,{T,V <- V' ; S*,S'*,N},V <- V' ; S,S') 2895 = minimizeBindingsTerm**(M,TL',NOld, 2896 { T << (V' <- V), S* << (V' <- V), S'* .. (V' <- V), N}, 2897 S << (V' <- V), 2898 S' .. (V' <- V) 2899 ) 2900 if V' =/= V and-then V in TL' and-then not (V' in TL') 2901 and-then typeLeq(M,getTypes(M,V),getTypes(M,V')) . 2902 2903 eq minimizeBindingsTerm**(M,TL',NOld,{T,V <- T' ; S*,S'*,N},V <- T' ; S,S') 2904 = minimizeBindingsTerm**(M,TL',NOld,{T,V <- T' ; S*,S'*,N},S,S') 2905 [owise] . 2906 2907 **** 2908 op remDup : Substitution -> Substitution . 2909 eq remDup(V <- V ; S) = remDup(S) . 2910 eq remDup(S) = S [owise] . 2911 2912endfm 2913fmod TYPEOFNARROWING is 2914 pr QID . 2915 pr META-TERM . 2916 2917 --- TypeOfNarrowing ---------------------------------- 2918 sorts TypeOfNarrowingElem TypeOfNarrowing . 2919 subsort TypeOfNarrowingElem < TypeOfNarrowing . 2920 op none : -> TypeOfNarrowing [ctor] . 2921 op __ : TypeOfNarrowing TypeOfNarrowing -> TypeOfNarrowing 2922 [ctor assoc comm id: none] . 2923 ---eq X:TypeOfNarrowingElem X:TypeOfNarrowingElem = X:TypeOfNarrowingElem . 2924 2925 *** select one and only one of the following 2926 op full : -> TypeOfNarrowingElem [ctor] . 2927 op basic : -> TypeOfNarrowingElem [ctor] . 2928 op variant : -> TypeOfNarrowingElem [ctor] . 2929 op variant : Nat -> TypeOfNarrowingElem [ctor] . 2930 op E-rewriting : -> TypeOfNarrowingElem [ctor] . 2931 2932 *** Extra flags 2933 op rigidife : Qid -> TypeOfNarrowingElem [ctor] . 2934 2935 *** Irreducible terms for equational unification to check 2936 op irrTerms : TermList -> TypeOfNarrowingElem [ctor] . 2937 2938 op getIrrTerms : TypeOfNarrowing -> TermList . 2939 eq getIrrTerms(X:TypeOfNarrowing irrTerms(TL:TermList)) = TL:TermList . 2940 eq getIrrTerms(X:TypeOfNarrowing) = empty [owise] . 2941 2942 *** select one and only one of the following 2943 op E-ACU-unify : -> TypeOfNarrowingElem [ctor] . 2944 op E-ACU-unify-Irr : -> TypeOfNarrowingElem [ctor] . 2945 op ACU-unify : -> TypeOfNarrowingElem [ctor] . 2946 op BuiltIn-unify : -> TypeOfNarrowingElem [ctor] . 2947 op E-BuiltIn-unify : -> TypeOfNarrowingElem [ctor] . 2948 op E-BuiltIn-unify-Irr : -> TypeOfNarrowingElem [ctor] . 2949 2950 *** select one and only one of the following 2951 op noStrategy : -> TypeOfNarrowingElem [ctor] . 2952 op topmost : -> TypeOfNarrowingElem [ctor] . 2953 op innermost : -> TypeOfNarrowingElem [ctor] . 2954 op outermost : -> TypeOfNarrowingElem [ctor] . 2955 2956 *** select any combination of the following 2957 op E-normalize-terms : -> TypeOfNarrowingElem [ctor] . 2958 op normalize-terms : -> TypeOfNarrowingElem [ctor] . 2959 op computed-normalized-subs : -> TypeOfNarrowingElem [ctor] . 2960 op applied-normalized-subs : -> TypeOfNarrowingElem [ctor] . 2961 op minimal-unifiers : -> TypeOfNarrowingElem [ctor] . 2962 op testUnifier : -> TypeOfNarrowingElem [ctor] . 2963 op alsoAtVarPosition : -> TypeOfNarrowingElem [ctor] . 2964 2965 op _in_ : TypeOfNarrowingElem TypeOfNarrowing -> Bool . 2966 eq X:TypeOfNarrowingElem in X:TypeOfNarrowingElem XS:TypeOfNarrowing 2967 = true . 2968 eq variant in variant(N:Nat) XS:TypeOfNarrowing 2969 = true . 2970 eq X:TypeOfNarrowingElem in XS:TypeOfNarrowing 2971 = false [owise] . 2972 2973 op _!in_ : TypeOfNarrowingElem TypeOfNarrowing -> Bool . 2974 eq X:TypeOfNarrowingElem !in XS:TypeOfNarrowing 2975 = not (X:TypeOfNarrowingElem in XS:TypeOfNarrowing) . 2976 ------------------------------------------------------- 2977 2978 sort TypeOfRelation . 2979 ops '* '! '+ : -> TypeOfRelation . 2980 2981 op [_] : TypeOfRelation -> Qid . 2982 eq [ '+ ] = qid("+") . 2983 eq [ '* ] = qid("*") . 2984 eq [ '! ] = qid("!") . 2985 2986 op typeOfRelation : Qid ~> TypeOfRelation . 2987 eq typeOfRelation( '+ ) = '+ . 2988 eq typeOfRelation( '* ) = '* . 2989 eq typeOfRelation( '! ) = '! . 2990endfm 2991 2992fmod IRR-FLAGS is 2993 sort IrrFlags . 2994 op __ : IrrFlags IrrFlags -> IrrFlags [assoc comm id: none] . 2995 op none : -> IrrFlags [ctor] . 2996 op irreducible : -> IrrFlags [ctor] . 2997 op reducible : -> IrrFlags [ctor] . 2998 op minimal-unifiers : -> IrrFlags [ctor] . 2999endfm 3000 3001fmod EFLAGS is 3002 pr TYPEOFNARROWING . 3003 pr IRR-FLAGS . 3004 3005 sort EFlags . 3006 subsort IrrFlags < EFlags . 3007 op __ : EFlags EFlags -> EFlags [assoc comm id: none] . 3008 op none : -> EFlags [ctor] . 3009 op ACUUnify : -> EFlags [ctor] . 3010 op BuiltInUnify : -> EFlags [ctor] . 3011 op testUnifier : -> EFlags [ctor] . 3012 3013 op _in_ : EFlags EFlags -> Bool . 3014 eq X:EFlags in X:EFlags Y:EFlags = true . 3015 eq X:EFlags in Y:EFlags = false [owise] . 3016 3017 op _!in_ : EFlags EFlags -> Bool . 3018 eq X:EFlags !in Y:EFlags = not (X:EFlags in Y:EFlags) . 3019 3020 op [_] : EFlags -> TypeOfNarrowing . 3021 eq [ ACUUnify X:EFlags ] = ACU-unify [ X:EFlags ] . 3022 eq [ BuiltInUnify X:EFlags ] = BuiltIn-unify [ X:EFlags ] . 3023 eq [ minimal-unifiers X:EFlags ] = minimal-unifiers [ X:EFlags ] . 3024 eq [ testUnifier X:EFlags ] = testUnifier [ X:EFlags ] . 3025 eq [ X:EFlags ] = none [owise] . 3026endfm 3027 3028fmod RESULT-CONTEXT-SET is 3029 protecting META-TERM . 3030 protecting META-LEVEL-MNPA . 3031 protecting TERM-HANDLING . 3032 protecting SUBSTITUTION-HANDLING . 3033 protecting RENAMING . 3034 protecting SUBSTITUTIONSET . 3035 protecting UNIFICATIONTRIPLESET . 3036 protecting MODULE-HANDLING . 3037 3038 vars T T' TS CtTS : Term . 3039 var TP : Type . 3040 vars S S' Subst Subst' : Substitution . 3041 var NL : NatList . 3042 var M : Module . 3043 vars Ct CtS : Context . 3044 vars RTS RTS' : ResultContextSet . 3045 vars NextVar N : Nat . 3046 var TL : TermList . 3047 3048 op subTerm_of_ : NatList ResultTriple ~> ResultTriple . 3049 eq subTerm NL of {T,TP,S} = {subTerm NL of T,TP,S} . 3050 3051 op replaceSubTerm_of_by_ : NatList ResultTriple Term ~> ResultTriple . 3052 eq replaceSubTerm NL of {T,TP,S} by T' = {replaceSubTerm NL of T by T',TP,S} . 3053 3054 --- ResultTriple --------------------------- 3055 --- op {_,_,_} : Term Type Substitution -> ResultTriple [ctor] . 3056 3057 sort ResultTripleSet . 3058 subsort ResultTriple < ResultTripleSet . 3059 op empty : -> ResultTripleSet [ctor] . 3060 op _|_ : ResultTripleSet ResultTripleSet -> ResultTripleSet 3061 [ctor assoc comm id: empty prec 65 format (d d n d)] . 3062 eq X:ResultTriple | X:ResultTriple = X:ResultTriple . 3063 3064 var RT : ResultTripleSet . 3065 3066 op _|>_ : ResultTripleSet TermList -> ResultTripleSet . 3067 eq (empty).ResultTripleSet |> TL = (empty).ResultTripleSet . 3068 eq ({T,TP,S} | RT) |> TL = {T,TP,S |> TL} | (RT |> TL) . 3069 eq (failure | RT ) |> TL = failure | (RT |> TL) . 3070 3071 op getTerms : ResultTripleSet -> TermSet . 3072 eq getTerms({T:Term,TP:Type,S:Substitution} | R:ResultTripleSet) 3073 = T:Term | getTerms(R:ResultTripleSet) . 3074 eq getTerms((empty).ResultTripleSet) 3075 = emptyTermSet . 3076 3077 op getSubstitutions : ResultTripleSet -> SubstitutionSet . 3078 eq getSubstitutions({T,TP,S} | R:ResultTripleSet) 3079 = S | getSubstitutions(R:ResultTripleSet) . 3080 eq getSubstitutions((empty).ResultTripleSet) 3081 = (empty).SubstitutionSet . 3082 3083 --- ResultContextSet --------------------------- 3084 3085 --- Flags 3086 sort Flags Flag . 3087 subsort Flag < Flags . 3088 3089 op empty : -> Flags [ctor] . 3090 op __ : Flags Flags -> Flags [ctor assoc comm id: empty] . 3091 eq X:Flag X:Flag = X:Flag . 3092 3093 --- Flag to know whether term is a end point or not 3094 op end : Bool -> Flag [ctor frozen] . 3095 3096 op end : Bool Flags -> Flags . 3097 eq end(B:Bool, end(B':Bool) B:Flags) = end(B:Bool) B:Flags . 3098 eq end(B:Bool, B:Flags) = end(B:Bool) B:Flags [owise] . 3099 3100 op end : Flags -> Bool . 3101 eq end(end(B:Bool) B:Flags) = B:Bool . 3102 eq end(B:Flags) = false [owise] . 3103 --- 3104 3105 sorts TraceNarrowStep TraceNarrow TraceNarrowSet . 3106 subsort TraceNarrowStep < TraceNarrow < TraceNarrowSet . 3107 op {_,_,_,_} : Term Substitution Type Rule -> TraceNarrowStep [ctor format (d d d d d n d n d d)] . 3108 op nil : -> TraceNarrow [ctor] . 3109 op __ : TraceNarrow TraceNarrow -> TraceNarrow [ctor assoc id: nil format (d n d)] . 3110 op empty : -> TraceNarrowSet [ctor] . 3111 op _|_ : TraceNarrowSet TraceNarrowSet -> TraceNarrowSet [ctor assoc comm id: empty format (d n n d)] . 3112 3113 --- 3114 sorts ResultContext ResultContextSet ResultContextNeSet . 3115 op {_,_,_,_,_,_,_,_,_,_,_} : 3116 Term Type 3117 Substitution Substitution --- computed subs and applied subst 3118 Context Context --- Original and WithSubst 3119 Term Term --- TermWithSubst and ContextWithTermAndSubt 3120 Nat --- highest index of variable 3121 TraceNarrow 3122 Flags 3123 -> ResultContext [ctor] . 3124 3125 subsort ResultContext < ResultContextNeSet < ResultContextSet . 3126 op empty : -> ResultContextSet [ctor] . 3127 op _|_ : ResultContextSet ResultContextSet -> ResultContextSet 3128 [ctor assoc comm id: empty prec 65 format (d n d d)] . 3129 op _|_ : ResultContextNeSet ResultContextSet -> ResultContextNeSet 3130 [ctor ditto] . 3131 eq X:ResultContext | X:ResultContext = X:ResultContext . 3132 3133 op getCTTerm : ResultContext -> Term . 3134 eq getCTTerm( 3135 {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags}) 3136 = CtTS:Term . 3137 op getNextVar : ResultContext -> Nat . 3138 eq getNextVar( 3139 {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags}) 3140 = NextVar . 3141 op getLSubst : ResultContext -> Substitution . 3142 eq getLSubst( 3143 {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags}) 3144 = S . 3145 op getRSubst : ResultContext -> Substitution . 3146 eq getRSubst( 3147 {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags}) 3148 = S' . 3149 3150 op _<<_ : ResultContext UnificationTripleSet -> ResultContextSet . 3151 eq {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 3152 << (empty).UnificationTripleSet 3153 = (empty).ResultContextSet . 3154 eq {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 3155 << ({Subst,Subst',N} | SS:UnificationTripleSet) 3156 = {T, 3157 TP, 3158 (S .. Subst) << Subst', (S' .. Subst') << Subst, 3159 Ct:Context, 3160 CtS:Context << (Subst ; Subst'), 3161 TS:Term << (Subst ; Subst'), 3162 CtTS:Term << (Subst ; Subst'), 3163 max(NextVar,N + 1), 3164 (Tr:TraceNarrow << T TP <) << {Subst,Subst',N}, 3165 B:Flags} 3166 | {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 3167 << SS:UnificationTripleSet . 3168 3169 op _<<__< : TraceNarrow Term Type -> TraceNarrow . 3170 eq (nil).TraceNarrow << T:Term TP:Type < 3171 = (nil).TraceNarrow . 3172 eq (Tr:TraceNarrow {T$:Term,none,TP$:Type,R:Rule}) --- Subst none here is special 3173 << T:Term TP:Type < 3174 = (Tr:TraceNarrow {T:Term,none,TP:Type,R:Rule}) . 3175 eq (Tr:TraceNarrow {T$:Term,S:Substitution,TP$:Type,R:Rule}) 3176 << T:Term TP:Type < 3177 = (Tr:TraceNarrow {T$:Term,S:Substitution,TP$:Type,R:Rule}) [owise] . 3178 3179 op _<<_ : TraceNarrow UnificationTriple -> TraceNarrow . 3180 eq (nil).TraceNarrow << {Subst,Subst',N} 3181 = (nil).TraceNarrow . 3182 eq (Tr:TraceNarrow {T$:Term,S:Substitution,TP$:Type,R:Rule}) --- Subst none here is special 3183 << {Subst,Subst',N} 3184 = (Tr:TraceNarrow {T$:Term << (Subst ; Subst'),S:Substitution .. (Subst ; Subst'),TP$:Type,R:Rule}) . 3185 3186 op canonice : Module TraceNarrow -> TraceNarrow . 3187 eq canonice(M, (nil).TraceNarrow) = nil . 3188 eq canonice(M, Tr:TraceNarrow {T$:Term,S:Substitution,TP$:Type,R:Rule}) 3189 = {canonice(M,T$:Term),canonice(M,S:Substitution),TP$:Type,R:Rule} canonice(M, Tr:TraceNarrow) . 3190 3191 op toTriple : Module ResultContextSet -> ResultTripleSet . 3192 eq toTriple(M, empty ) = empty . 3193 eq toTriple(M, {T,TP,S,S',Ct,CtS,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} | RTS ) 3194 = {CtTS:Term, leastSort(M,CtTS:Term), S .. S'} 3195 | toTriple(M,RTS) . 3196 3197 op _|>_ : ResultContextSet TermList -> ResultContextSet . 3198 eq (empty).ResultContextSet |> TL = (empty).ResultContextSet . 3199 eq ({T,TP,S,S',Ct,CtS,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 3200 | RTS:ResultContextSet) |> TL 3201 = {T,TP,S |> TL,S' |> TL,Ct,CtS,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 3202 | (RTS:ResultContextSet |> TL) . 3203 3204 op getTerms : ResultContextSet -> TermSet . 3205 eq getTerms({T,TP,S,S',Ct,CtS,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} | RTS) 3206 = CtTS:Term | getTerms(RTS) . 3207 eq getTerms((empty).ResultContextSet) 3208 = emptyTermSet . 3209 3210 op toUnificationTriples : ResultContextSet -> UnificationTripleSet . 3211 eq toUnificationTriples( 3212 {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} | R:ResultContextSet) 3213 = {S,S',NextVar} 3214 | toUnificationTriples(R:ResultContextSet) . 3215 eq toUnificationTriples((empty).ResultContextSet) 3216 = (empty).UnificationTripleSet . 3217 3218 *** auxiliary Sort SubstitutionCond for metaNarrowSearch ***** 3219 sort SubstitutionCond . 3220 subsort Substitution < SubstitutionCond . 3221 3222 op |_| : ResultTripleSet -> Nat . 3223 eq | (empty).ResultTripleSet | = 0 . 3224 eq | (RT:ResultTriple | RTS:ResultTripleSet) | 3225 = | RTS:ResultTripleSet | + 1 . 3226 3227 op |_| : ResultContextSet -> Nat . 3228 eq | (empty).ResultContextSet | = 0 . 3229 eq | (RT:ResultContext | RTS:ResultContextSet) | 3230 = | RTS:ResultContextSet | + 1 . 3231 3232endfm 3233 3234fmod META-MATCH is 3235 protecting TERM-HANDLING . 3236 protecting MODULE-HANDLING . 3237 protecting SUBSTITUTION-HANDLING . 3238 protecting META-LEVEL-MNPA . 3239 protecting RENAMING . 3240 protecting SUBSTITUTIONSET . 3241 3242 vars T T' : Term . 3243 vars TL TL' : TermList . 3244 var M : Module . 3245 vars S S' : Substitution . 3246 var S? : Substitution? . 3247 vars SS SS' : SubstitutionSet . 3248 vars V V' : Variable . 3249 vars TPL TPL' : TypeList . 3250 vars N N' : Nat . 3251 3252 --- Not defined in this module ---------------------------------------- 3253 op isNF$ : Module Term ~> Bool . 3254 --- Not defined in this module ---------------------------------------- 3255 3256 --- metaCoreMatch(M,T,T') implies that T is an instance of T' 3257 op metaCoreMatch : Module Term Term -> SubstitutionSet . 3258 eq metaCoreMatch(M,T,T') 3259 = metaCoreMatch$(M,canonice(M,T),canonice(M,T')) . 3260 3261 op metaCoreMatch$ : Module Term Term -> SubstitutionSet . 3262 eq metaCoreMatch$(M,T,T') 3263 = if glbSorts(M,leastSort(M,T),leastSort(M,T')) == none 3264 then empty 3265 else metaCoreMatchCollect(eraseEqs(eraseRls(M)),T,T') 3266 fi . 3267 3268 op metaCoreMatch? : Module Term Term -> Bool . 3269 eq metaCoreMatch?(M,T,T') 3270 = metaCoreMatch?$(M,canonice(M,T),canonice(M,T')) . 3271 3272 op metaCoreMatch?$ : Module Term Term -> Bool . 3273 eq metaCoreMatch?$(M,T,T') 3274 = glbSorts(M,leastSort(M,T),leastSort(M,T')) =/= none 3275 and-then 3276 metaMatch(eraseEqs(eraseRls(M)),T',T,nil,0) =/= noMatch . 3277 3278 --- metaCoreMatchCollect(M,T,T') calls Maude metaMatch 3279 op metaCoreMatchCollect : Module Term Term -> SubstitutionSet . 3280 eq metaCoreMatchCollect(M,T,T') 3281 = metaCoreMatchCollect*(M,T,T',empty,0) . 3282 3283 op metaCoreMatchCollect* : Module Term Term SubstitutionSet Nat 3284 -> SubstitutionSet . 3285 eq metaCoreMatchCollect*(M,T,T',SS,N:Nat) 3286 = if metaMatch(M,T',T,nil,N:Nat) =/= noMatch 3287 then metaCoreMatchCollect*(M,T,T', 3288 SS | metaMatch(M,T',T,nil,N:Nat), 3289 s(N:Nat)) 3290 else SS 3291 fi . 3292 3293 op metaBuiltInEqual : Module TermList Term Term -> Bool . 3294 eq metaBuiltInEqual(M,TL,T,T') 3295 = canonice(M,T) == canonice(M,T') . 3296 3297endfm 3298fmod VARIANT-HANDLING is 3299 pr SUBSTITUTION-HANDLING . 3300 pr META-MINIMIZE-BINDINGS . 3301 pr RESULT-CONTEXT-SET . 3302 pr MODULE-HANDLING . 3303 pr META-LEVEL-MNPA . 3304 pr VARIANT . 3305 3306 var M : Module . 3307 vars T T' TS TS' CtTS CtTS' Lhs Rhs : Term . 3308 vars N N' NextVar NextVar' NextVar'' : Nat . 3309 var B : Bound . 3310 var TL TL' : TermList . 3311 var NeTL : NeTermList . 3312 var EqS : EquationSet . 3313 var AtS : AttrSet . 3314 var Q : Qid . 3315 vars S S' : Substitution . 3316 var V : Variable . 3317 var R RT : ResultContext . 3318 vars RTS RTS' : ResultContextSet . 3319 vars TP TP' : Type . 3320 vars Ct Ct' CtS CtS' : Context . 3321 var C : Constant . 3322 vars F F' : Qid . 3323 3324 var VTS : VariantFourSet . 3325 3326 op toVariants : Nat ResultContextSet -> VariantFourSet . 3327 eq toVariants(OldNextVar:Nat,empty) 3328 = empty . 3329 eq toVariants(OldNextVar:Nat,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} | RTS) 3330 = {CtTS,S |> OldNextVar:Nat,S' |> OldNextVar:Nat,NextVar} 3331 | toVariants(OldNextVar:Nat,RTS) . 3332 3333 op _|>_ : VariantFourSet TermList -> VariantFourSet . 3334 eq (empty).VariantFourSet |> TL = empty . 3335 eq ({T,S,S',N} | VTS) |> TL = {T,(S |> TL),(S' |> TL),N} | (VTS |> TL) . 3336 3337 op getTerms : VariantFourSet -> TermSet . 3338 eq getTerms({T:Term,S:Substitution,S':Substitution,NextVar:Nat} 3339 | R:VariantFourSet) 3340 = T:Term | getTerms(R:VariantFourSet) . 3341 eq getTerms((empty).VariantFourSet) 3342 = emptyTermSet . 3343 3344 op toVariantTripleSet : VariantFourSet -> VariantTripleSet . 3345 eq toVariantTripleSet(empty) 3346 = empty . 3347 eq toVariantTripleSet({T,S,S',NextVar} | VTS) 3348--- = {T,S ; S',NextVar} | toVariantTripleSet(VTS) . 3349 = {T,S,NextVar,none,false} | toVariantTripleSet(VTS) . ---- ",none,false" added without much understanding 3350 3351endfm 3352 3353fmod RIGIDIFE is 3354 protecting UNIFICATIONTRIPLESET . 3355 protecting MODULE-HANDLING . 3356 protecting RESULT-CONTEXT-SET . 3357 protecting VARIANT . 3358 3359 vars V V' : Variable . 3360 var C : Constant . 3361 vars F Q : Qid . 3362 vars U U' : UnificationTriple . 3363 vars US US' : UnificationTripleSet . 3364 vars S S' S1 S1' S2 S2' S* : Substitution . 3365 vars Ct CtS Ct' CtS' : Context . 3366 vars TS TS' CtTS CtTS' : Term . 3367 var SS : SubstitutionSet . 3368 var SSe : NeSubstitutionSet . 3369 vars N N' N1 N2 NextVar : Nat . 3370 vars T T' : Term . 3371 vars TL TL' : TermList . 3372 var NeTL : NeTermList . 3373 var M : Module . 3374 var RTS : ResultTripleSet . 3375 var TP : Type . 3376 3377 sort PairRigidife . 3378 op {_,_} : Module TermList -> PairRigidife . 3379 op getM : PairRigidife -> Module . 3380 eq getM({M,TL}) = M . 3381 op getTL : PairRigidife -> TermList . 3382 eq getTL({M,TL}) = TL . 3383 3384 *** Transform variables in TermList into constants 3385 op rigidifeList : Module Qid TermList TermList -> PairRigidife . 3386 eq rigidifeList(M,Q,TL,empty) 3387 = {M,TL} . 3388 eq rigidifeList(M,Q,(T,NeTL),TL) 3389 = { getM(rigidifeList(getM(rigidifeList(M,Q,T,TL)),Q,NeTL,TL)), 3390 (getTL(rigidifeList(M,Q,T,TL)), 3391 getTL(rigidifeList(getM(rigidifeList(M,Q,T,TL)),Q,NeTL,TL))) } . 3392 eq rigidifeList(M,Q,C,TL) 3393 = {M,C} . 3394 eq rigidifeList(M,Q,F[NeTL],TL) 3395 = {getM(rigidifeList(M,Q,NeTL,TL)), 3396 F[getTL(rigidifeList(M,Q,NeTL,TL))]} . 3397 eq rigidifeList(M,Q,V,TL) 3398 = if V in TL then rigidifeVar***(M,Q,V) else {M,V} fi . 3399 3400 *** Transform all variables into constants 3401 op rigidifeAllVar : Module Qid TermList -> PairRigidife . 3402 eq rigidifeAllVar(M,Q,TL) 3403 = rigidifeNat(M,Q,TL,0) . 3404 3405 *** Transform variables above Nat into constants 3406 op rigidifeNat : Module Qid TermList Nat -> PairRigidife . 3407 eq rigidifeNat(M,Q,(T,NeTL),N) 3408 = { getM(rigidifeNat(getM(rigidifeNat(M,Q,T,N)),Q,NeTL,N)), 3409 (getTL(rigidifeNat(M,Q,T,N)), 3410 getTL(rigidifeNat(getM(rigidifeNat(M,Q,T,N)),Q,NeTL,N))) } . 3411 eq rigidifeNat(M,Q,C,N) 3412 = {M,C} . 3413 eq rigidifeNat(M,Q,F[NeTL],N) 3414 = {getM(rigidifeNat(M,Q,NeTL,N)), 3415 F[getTL(rigidifeNat(M,Q,NeTL,N))]} . 3416 eq rigidifeNat(M,Q,V,N) 3417 = if highestVar(V) >= N then rigidifeVar***(M,Q,V) else {M,V} fi . 3418 3419 *** Transform variables with rigid# into constants 3420 op rigidifeRigid : Module Qid TermList -> PairRigidife . 3421 eq rigidifeRigid(M,Q,(T,NeTL)) 3422 = { getM(rigidifeRigid(getM(rigidifeRigid(M,Q,T)),Q,NeTL)), 3423 (getTL(rigidifeRigid(M,Q,T)), 3424 getTL(rigidifeRigid(getM(rigidifeRigid(M,Q,T)),Q,NeTL))) } . 3425 eq rigidifeRigid(M,Q,C) 3426 = {M,C} . 3427 eq rigidifeRigid(M,Q,F[NeTL]) 3428 = {getM(rigidifeRigid(M,Q,NeTL)), 3429 F[getTL(rigidifeRigid(M,Q,NeTL))]} . 3430 eq rigidifeRigid(M,Q,V) 3431 = if rfind(string(V), "rigid#", length(string(V))) =/= notFound 3432 then rigidifeVar***(M,Q,V) 3433 else {M,V} 3434 fi . 3435 3436 *** Basic case for transforming variables into constants 3437 op rigidifeVar*** : Module Qid Variable -> PairRigidife . 3438 ceq rigidifeVar***(M,Q,V) 3439 = {addOps((op qid(F:String) : nil -> getType(V) [none].), M), 3440 qid(F:String + "." + string(getType(V)))} 3441 if F:String := "rigid@" + string(Q) 3442 + "@" + string(getName(V)) + "@" + string(getType(V)) . 3443 3444 *** Undo the transformation of variables into constants 3445 op unrigidife : Qid TermList -> TermList . 3446 eq unrigidife(Q,(T,NeTL)) 3447 = (unrigidife(Q,T),unrigidife(Q,NeTL)) . 3448 eq unrigidife(Q,V) = V . 3449 eq unrigidife(Q,F[TL]) = F[unrigidife(Q,TL)] . 3450 eq unrigidife(Q,C) 3451 = if rfind(string(C), "rigid@" + string(Q) + "@", length(string(C))) 3452 =/= notFound 3453 then qid( 3454 string( 3455 qid( 3456 substr(string(C), 3457 rfind(string(C), "rigid@" + string(Q) + "@", length(string(C))) 3458 + 7 + length(string(Q)), 3459 rfind( 3460 substr(string(C), 3461 rfind(string(C), "rigid@" + string(Q) + "@", length(string(C))) 3462 + 7 + length(string(Q)), 3463 length(string(C))), 3464 "@",length(string(C)) 3465 ) 3466 ) 3467 ) 3468 ) 3469 + ":" + 3470 string(getType(qid( 3471 substr(string(C), 3472 rfind(string(C), "rigid@" + string(Q) + "@", 3473 length(string(C))) + 7 + length(string(Q)), 3474 length(string(C))) 3475 ))) 3476 ) 3477 else C 3478 fi . 3479 3480 op unrigidife : Qid Substitution -> Substitution . 3481 eq unrigidife(Q,(none).Substitution) = none . 3482 eq unrigidife(Q,V <- T ; S) 3483 = unrigidife(Q,V) <- unrigidife(Q,T) ; unrigidife(Q,S) . 3484 3485 op unrigidife : Qid SubstitutionSet -> SubstitutionSet . 3486 eq unrigidife(Q,(empty).SubstitutionSet) = empty . 3487 eq unrigidife(Q,S | SSe) 3488 = unrigidife(Q,S) | unrigidife(Q,SSe) . 3489 3490 op unrigidife : Qid UnificationTripleSet -> UnificationTripleSet . 3491 eq unrigidife(Q,(empty).UnificationTripleSet) = empty . 3492 eq unrigidife(Q,{S1,S2,N'} | US) 3493 = {unrigidife(Q,S1),unrigidife(Q,S2),N'} 3494 | unrigidife(Q,US) . 3495 3496 op unrigidife : Qid ResultTripleSet -> ResultTripleSet . 3497 eq unrigidife(Q,(empty).ResultTripleSet) = empty . 3498 eq unrigidife(Q,{T,TP,S} | RTS) 3499 = {unrigidife(Q,T),TP,unrigidife(Q,S)} 3500 | unrigidife(Q,RTS) . 3501 3502 op unrigidife : Qid VariantFourSet -> VariantFourSet . 3503 eq unrigidife(Q,(empty).VariantFourSet) = empty . 3504 eq unrigidife(Q,{T,S,S',N} | R:VariantFourSet) 3505 = {unrigidife(Q,T),unrigidife(Q,S),unrigidife(Q,S'),N} 3506 | unrigidife(Q,R:VariantFourSet) . 3507 3508 *** Label variables with rigid 3509 op rigidLabel : Module TermList TermList -> TermList . 3510 eq rigidLabel(M,TL,empty) 3511 = TL . 3512 eq rigidLabel(M,(T,NeTL),TL) 3513 = rigidLabel(M,T,TL), rigidLabel(M,NeTL,TL) . 3514 eq rigidLabel(M,C,TL) 3515 = C . 3516 eq rigidLabel(M,F[NeTL],TL) 3517 = F[rigidLabel(M,NeTL,TL)] . 3518 eq rigidLabel(M,V,TL) 3519 = if V in TL then rigidLabel***(M,V) else V fi . 3520 3521 op rigidLabel*** : Module Variable -> Variable . 3522 eq rigidLabel***(M,V) 3523 = qid("rigid#" + string(getName(V)) + ":" + string(getType(V))) . 3524 3525 *** Undo the transformation of variables into constants 3526 op unrigidLabel : TermList -> TermList . 3527 eq unrigidLabel((T,NeTL)) 3528 = (unrigidLabel(T),unrigidLabel(NeTL)) . 3529 eq unrigidLabel(C) = C . 3530 eq unrigidLabel(F[TL]) = F[unrigidLabel(TL)] . 3531 eq unrigidLabel(V) 3532 = if rfind(string(V), "rigid#", length(string(V))) 3533 =/= notFound 3534 then qid( 3535 string(getName(qid( 3536 substr(string(V), 3537 rfind(string(V), "rigid#", 3538 length(string(V))) + 6, 3539 length(string(V))) 3540 ))) 3541 + ":" + 3542 string(getType(qid( 3543 substr(string(V), 3544 rfind(string(V), "rigid#", 3545 length(string(V))) + 6, 3546 length(string(V))) 3547 ))) 3548 ) 3549 else V 3550 fi . 3551 3552 op unrigidLabel : Substitution -> Substitution . 3553 eq unrigidLabel((none).Substitution) = none . 3554 eq unrigidLabel(V <- T ; S) 3555 = unrigidLabel(V) <- unrigidLabel(T) ; unrigidLabel(S) . 3556 3557 op unrigidLabel : SubstitutionSet -> SubstitutionSet . 3558 eq unrigidLabel((empty).SubstitutionSet) = empty . 3559 eq unrigidLabel(S | SSe) 3560 = unrigidLabel(S) | unrigidLabel(SSe) . 3561 3562 op unrigidLabel : UnificationTripleSet -> UnificationTripleSet . 3563 eq unrigidLabel((empty).UnificationTripleSet) = empty . 3564 eq unrigidLabel({S1,S2,N'} | US) 3565 = {unrigidLabel(S1),unrigidLabel(S2),N'} 3566 | unrigidLabel(US) . 3567 3568 op unrigidLabel : ResultTripleSet -> ResultTripleSet . 3569 eq unrigidLabel((empty).ResultTripleSet) = empty . 3570 eq unrigidLabel({T,TP,S} | RTS) 3571 = {unrigidLabel(T),TP,unrigidLabel(S)} 3572 | unrigidLabel(RTS) . 3573 3574 op unrigidLabel : ResultContextSet -> ResultContextSet . 3575 eq unrigidLabel((empty).ResultContextSet) = empty . 3576 eq unrigidLabel({T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} | RTS:ResultContextSet) 3577 = {unrigidLabel(T),TP,unrigidLabel(S),unrigidLabel(S*),Ct,CtS,unrigidLabel(TS),unrigidLabel(CtTS),NextVar,unrigidLabel(Tr:TraceNarrow),B:Flags} 3578 | unrigidLabel(RTS:ResultContextSet) . 3579 3580 op unrigidLabel : TraceNarrow -> TraceNarrow . 3581 eq unrigidLabel((nil).TraceNarrow) = nil . 3582 eq unrigidLabel(Tr:TraceNarrow {CtTS:Term,Subst:Substitution,TP:Type,R:Rule}) 3583 = unrigidLabel(Tr:TraceNarrow) 3584 {unrigidLabel(CtTS:Term),unrigidLabel(Subst:Substitution),TP:Type,R:Rule} . 3585 3586 op unrigidLabel : VariantFourSet -> VariantFourSet . 3587 eq unrigidLabel((empty).VariantFourSet) = empty . 3588 eq unrigidLabel({T,S,S',N} | R:VariantFourSet) 3589 = {unrigidLabel(T),unrigidLabel(S),unrigidLabel(S'),N} 3590 | unrigidLabel(R:VariantFourSet) . 3591 3592 op qid : Nat -> Qid . 3593 eq qid(N:Nat) = qid(string(N:Nat,10)) . 3594 3595endfm 3596 3597fmod META-E-UNIFICATION is 3598 pr TYPEOFNARROWING . 3599 pr EFLAGS . 3600 pr RESULT-CONTEXT-SET . 3601 pr SUBSTITUTION-HANDLING . 3602 pr META-MINIMIZE-BINDINGS . 3603 pr RESULT-CONTEXT-SET . 3604 pr MODULE-HANDLING . 3605 pr META-LEVEL-MNPA . 3606 pr VARIANT . 3607 pr RIGIDIFE . 3608 3609 *** Repeated definitions to avoid cross calls between modules ************ 3610 op normalizedSubstitution? : Module SubstitutionSet -> Bool . 3611 op metaACUUnify : Module Term Term Nat -> UnificationTripleSet . 3612 op metaACUUnify? : Module Term Term Nat -> Bool . 3613 op metaACUUnify* : Module UnificandPair Nat Nat ~> UnificationTriple? . 3614 op metaCoreUnify : Module Term Term Nat -> UnificationTripleSet . 3615 op metaCoreUnify? : Module Term Term Nat -> Bool . 3616 op metaBuiltInUnify : Module TermList Term Term Nat -> UnificationTripleSet . 3617 op metaBuiltInUnify? : Module TermList Term Term Nat -> Bool . 3618 op _<=[_]_ : SubstitutionSet Module SubstitutionSet -> Bool . 3619 op _<=[_]_ : Term Module Term -> Bool . 3620 *** Repeated definitions to avoid cross calls between modules ************ 3621 3622 var M : Module . 3623 vars T T' TS TS' CtTS CtTS' Lhs Rhs : Term . 3624 vars N N' NextVar NextVar' NextVar'' NextVar1 NextVar2 NextVar3 : Nat . 3625 var B : Bound . 3626 var TL TL' : TermList . 3627 var NeTL : NeTermList . 3628 var EqS : EquationSet . 3629 var AtS : AttrSet . 3630 var ON : TypeOfNarrowing . 3631 var Q : Qid . 3632 vars US US' US$ : UnificationTripleSet . 3633 vars U U' : UnificationTriple . 3634 vars S S' S* S'* S1 S1' S2 S2' S3 S3' : Substitution . 3635 var V : Variable . 3636 var R RT : ResultContext . 3637 vars RTS RTS' : ResultContextSet . 3638 vars TP TP' : Type . 3639 vars Ct Ct' CtS CtS' : Context . 3640 var C : Constant . 3641 vars F F' : Qid . 3642 var EF : EFlags . 3643 vars VT VT' : VariantFour . 3644 vars VTS VTS' VTS$ : VariantFourSet . 3645 var IRR : IrrFlags . 3646 3647 --- metaECoreUnify -------------------------------------------------- 3648 op metaECoreUnify : Module Term Term TermList -> SubstitutionSet . 3649 --- Term Lhs 3650 eq metaECoreUnify(M, T, T',TL) 3651 = metaEACUUnify(M, T, T',TL) . 3652 3653 op metaECoreUnify? : Module Term Term TermList -> Bool . 3654 eq metaECoreUnify?(M, T, T', TL) 3655 = metaEACUUnify?(M, T, T', TL) . 3656 3657 --- metaVariantUnify -------------------------------------------------- 3658 op metaVariantUnify : Module Term Term -> SubstitutionSet . 3659 eq metaVariantUnify(M, T, T') = metaEACUUnify(M, T, T', empty) . 3660 3661 op metaVariantUnify : Module Term Term TermList -> SubstitutionSet . 3662 eq metaVariantUnify(M, T, T', TL) = metaEACUUnify(M, T, T', TL) . 3663 3664 op metaVariantUnify? : Module Term Term TermList -> Bool . 3665 eq metaVariantUnify?(M, T, T', TL) = metaEACUUnify?(M, T, T', TL) . 3666 3667 op metaVariantUnify : Module Term Term Nat IrrFlags -> UnificationTripleSet . 3668 eq metaVariantUnify(M, T, T',NextVar,IRR) = metaEACUUnify(M, T, T',empty,NextVar,IRR) . 3669 3670 op metaVariantUnify : Module Term Term TermList Nat IrrFlags -> UnificationTripleSet . 3671 eq metaVariantUnify(M, T, T',TL,NextVar,IRR) = metaEACUUnify(M, T, T',TL,NextVar,IRR) . 3672 3673 op metaVariantUnify? : Module Term Term TermList Nat IrrFlags -> Bool . 3674 eq metaVariantUnify?(M, T, T',TL,NextVar,IRR) = metaEACUUnify?(M, T, T',TL,NextVar,IRR) . 3675 3676 --- metaEACUUnify -------------------------------------------------- 3677 op metaEACUUnify : Module Term Term TermList -> SubstitutionSet . 3678 eq metaEACUUnify(M, T, T', TL) 3679 = toSubstitution(metaEACUUnify(M,T,T',TL,highestVar((T,T')) + 1,reducible)) . 3680 3681 op metaEACUUnify? : Module Term Term TermList -> Bool . 3682 eq metaEACUUnify?(M, T, T', TL) 3683 = metaEACUUnify?(M,T,T',TL,highestVar((T,T')) + 1,reducible) . 3684 3685 op metaEACUUnifyIrr : Module Term Term TermList -> SubstitutionSet . 3686 --- T irreducible T' reducible 3687 eq metaEACUUnifyIrr(M, T, T',TL) 3688 = toSubstitution(metaEACUUnify(M,T,T',TL,highestVar((T,T')) + 1,irreducible)) . 3689 3690 op metaEACUUnifyIrr? : Module Term Term TermList -> Bool . 3691 eq metaEACUUnifyIrr?(M, T, T', TL) 3692 = metaEACUUnify?(M,T,T',TL,highestVar((T,T')) + 1,irreducible) . 3693 3694 op metaEACUUnify : Module Term Term TermList Nat IrrFlags -> UnificationTripleSet . 3695 eq metaEACUUnify(M, T, T',TL,NextVar,IRR) 3696 = minimizeBindingsTerm(M,Vars(T),NextVar, 3697 metaEUnify&(M, T, T',TL,NextVar,ACUUnify IRR) 3698 ) |> (T,T',TL) . 3699 3700 op metaEACUUnify? : Module Term Term TermList Nat IrrFlags -> Bool . 3701 eq metaEACUUnify?(M, T, T',TL,NextVar,IRR) 3702 = metaEUnify&?(M, T, T',TL,NextVar,ACUUnify IRR) . 3703 3704 --- metaEBuiltInUnify -------------------------------------------------- 3705 op metaEBuiltInUnify : Module Term Term -> SubstitutionSet . 3706 eq metaEBuiltInUnify(M, T, T') = metaEBuiltInUnify(M, T, T',empty) . 3707 3708 op metaEBuiltInUnify : Module Term Term TermList -> SubstitutionSet . 3709 eq metaEBuiltInUnify(M, T, T', TL) 3710 = toSubstitution(metaEBuiltInUnify(M,T,T',TL,highestVar((T,T')) + 1,reducible)) . 3711 3712 op metaEBuiltInUnify? : Module Term Term -> Bool . 3713 eq metaEBuiltInUnify?(M, T, T') = metaEBuiltInUnify?(M, T, T',empty) . 3714 3715 op metaEBuiltInUnify? : Module Term Term TermList -> Bool . 3716 eq metaEBuiltInUnify?(M, T, T',TL) 3717 = metaEBuiltInUnify?(M,T,T',TL,highestVar((T,T')) + 1,reducible) . 3718 3719 op metaEBuiltInUnifyIrr : Module Term Term -> SubstitutionSet . 3720 eq metaEBuiltInUnifyIrr(M, T, T') = metaEBuiltInUnifyIrr(M, T, T', empty) . 3721 3722 op metaEBuiltInUnifyIrr : Module Term Term TermList -> SubstitutionSet . 3723 --- T irreducible T' reducible 3724 eq metaEBuiltInUnifyIrr(M, T, T', TL) 3725 = toSubstitution( 3726 metaEBuiltInUnify(M,T,T',TL,highestVar((T,T')) + 1,irreducible) 3727 ) . 3728 3729 op metaEBuiltInUnifyIrr? : Module Term Term -> Bool . 3730 eq metaEBuiltInUnifyIrr?(M, T, T') = metaEBuiltInUnifyIrr?(M, T, T', empty) . 3731 3732 op metaEBuiltInUnifyIrr? : Module Term Term TermList -> Bool . 3733 --- T irreducible T' reducible 3734 eq metaEBuiltInUnifyIrr?(M, T, T', TL) 3735 = metaEBuiltInUnify?(M,T,T',TL,highestVar((T,T')) + 1,irreducible) . 3736 3737 op metaEBuiltInUnify : Module Term Term TermList Nat IrrFlags 3738 -> UnificationTripleSet . 3739 eq metaEBuiltInUnify(M, T, T',TL,NextVar,IRR) 3740 = minimizeBindingsTerm(M,Vars(T),NextVar, 3741 metaEUnify&(M, T, T',TL,NextVar,BuiltInUnify IRR) 3742 ) |> (T,T') . 3743 3744 op metaEBuiltInUnify? : Module Term Term TermList Nat IrrFlags -> Bool . 3745 eq metaEBuiltInUnify?(M, T, T',TL,NextVar,IRR) 3746 = metaEUnify&?(M, T, T',TL,NextVar,BuiltInUnify IRR) . 3747 3748 --- metaEUnify -------------------------------------------------- 3749 op metaEUnify& : Module Term Term TermList Nat EFlags -> UnificationTripleSet . 3750 --- Term Lhs 3751 eq metaEUnify&(M,T,T',TL,NextVar,EF) 3752 = if sameKind(M,leastSort(M,T),leastSort(M,T')) 3753 then metaEUnify&*(removeBoolEqs(M),T,T',TL,NextVar,EF) 3754 else empty 3755 fi . 3756 3757 op metaEUnify&? : Module Term Term TermList Nat EFlags -> Bool . 3758 --- Term Lhs 3759 eq metaEUnify&?(M,T,T',TL,NextVar,EF) 3760 = sameKind(M,leastSort(M,T),leastSort(M,T')) 3761 and-then 3762 metaEUnify&*?(removeBoolEqs(M),T,T',TL,NextVar,EF) . 3763 3764 op metaEUnify&* : Module Term Term TermList Nat EFlags -> UnificationTripleSet . 3765 --- Term Lhs 3766 eq metaEUnify&*(M,T,T',TL,NextVar,EF) 3767 = if metaBuiltInUnify?(M,TL, 3768 fst(generalize(onlyEqsVariant(M),NextVar,T)), 3769 fst(generalize(onlyEqsVariant(M), 3770 snd(generalize(onlyEqsVariant(M),NextVar,T)),T')), 3771 snd(generalize(onlyEqsVariant(M), 3772 snd(generalize(onlyEqsVariant(M),NextVar,T)),T')) 3773 ) 3774 then if T == fst(generalize(onlyEqsVariant(M),NextVar,T)) 3775 and 3776 T' == fst( 3777 generalize(onlyEqsVariant(M), 3778 snd(generalize(onlyEqsVariant(M),NextVar,T)),T')) 3779 then --- no narrowing is necessary to unify 3780 metaBuiltInUnify(M,TL,T,T',NextVar) 3781 else metaEUnify$(M,T,T',TL,NextVar,EF) 3782 fi 3783 else empty 3784 fi . 3785 3786 op metaEUnify&*? : Module Term Term TermList Nat EFlags -> Bool . 3787 --- Term Lhs 3788 eq metaEUnify&*?(M,T,T',TL,NextVar,EF) 3789 = if metaBuiltInUnify?(M,TL, 3790 fst(generalize(onlyEqsVariant(M),NextVar,T)), 3791 fst(generalize(onlyEqsVariant(M), 3792 snd(generalize(onlyEqsVariant(M),NextVar,T)),T')), 3793 snd(generalize(onlyEqsVariant(M), 3794 snd(generalize(onlyEqsVariant(M),NextVar,T)),T')) 3795 ) 3796 then if T == fst(generalize(onlyEqsVariant(M),NextVar,T)) 3797 and 3798 T' == fst( 3799 generalize(onlyEqsVariant(M), 3800 snd(generalize(onlyEqsVariant(M),NextVar,T)),T')) 3801 then --- no narrowing is necessary to unify 3802 metaBuiltInUnify?(M,TL,T,T',NextVar) 3803 else metaEUnify$?(M,T,T',TL,NextVar,EF) 3804 fi 3805 else false 3806 fi . 3807 3808 op metaEUnify$ : Module Term Term TermList Nat EFlags -> UnificationTripleSet . 3809 --- Term Lhs 3810 eq metaEUnify$(M,T,T',TL,NextVar,irreducible EF) 3811 = metaEUnifyCollect(M,T,T',(T,TL),NextVar,0,empty) . 3812 eq metaEUnify$(M,T,T',TL,NextVar,EF) 3813 = metaEUnifyCollect(M,T,T',TL,NextVar,0,empty) [owise] . 3814 3815 op metaEUnify$? : Module Term Term TermList Nat EFlags -> Bool . 3816 --- Term Lhs 3817 eq metaEUnify$?(M,T,T',TL,NextVar,irreducible EF) 3818 = metaEUnifyCollect?(M,T,T',(T,TL),NextVar,0) . 3819 eq metaEUnify$?(M,T,T',TL,NextVar,EF) 3820 = metaEUnifyCollect?(M,T,T',TL,NextVar,0) [owise] . 3821 3822 op metaEUnifyCollect : Module Term Term TermList Nat Nat 3823 UnificationTripleSet 3824 -> UnificationTripleSet . 3825 eq metaEUnifyCollect(M,T,T',TL,N,N',US) 3826 = if metaEUnify*(M,T =? T',TL,N,N') :: UnificationTriple? 3827 and 3828 metaEUnify*(M,T =? T',TL,N,N') =/= noUnifier 3829 then metaEUnifyCollect(M,T,T',TL,N,s(N'), 3830 US | metaEUnify*(M,T =? T',TL,N,N') ) 3831 else US 3832 fi . 3833 3834 op metaEUnifyCollect? : Module Term Term TermList Nat Nat 3835 -> Bool . 3836 eq metaEUnifyCollect?(M,T,T',TL,N,N') 3837 = metaEUnify*(M,T =? T',TL,N,N') :: UnificationTriple? 3838 and 3839 metaEUnify*(M,T =? T',TL,N,N') =/= noUnifier . 3840 3841 *** Code for collection all unifiers 3842 op metaEUnify* : Module UnificandPair TermList Nat Nat ~> UnificationTriple? . 3843 eq metaEUnify*(M, T =? T',TL,N,N') 3844 = metaEUnifyTriple( 3845 M, 3846 unflatten(M,T) =? unflatten(M,T'), 3847 TL,N,N') . 3848 3849 op metaEUnifyTriple : Module UnificationProblem TermList Nat Nat ~> UnificationTriple? . 3850 eq metaEUnifyTriple(M,T =? T',TL,N,N') 3851 = if metaVariantUnify(M,T =? T',TL,N,N') == noUnifier 3852 then noUnifier 3853 else {getSubst(metaVariantUnify(M,T =? T',TL,N,N')) |> T, 3854 getSubst(metaVariantUnify(M,T =? T',TL,N,N')) |> T', 3855 getNextVar(metaVariantUnify(M,T =? T',TL,N,N'))} 3856 fi . 3857 3858 ************************************** 3859 ***** Variant Generation 3860 3861 op getVariants : Module Term -> VariantFourSet . 3862 eq getVariants(M,T) = getVariants(M,T,highestVar(T) + 1) . 3863 3864 op getVariants : Module Term Nat -> VariantFourSet . 3865 eq getVariants(M,T,NextVar) = getVariants(M,T,NextVar,reducible BuiltInUnify) . 3866 3867 op getVariants : Module Term Nat TermList -> VariantFourSet . 3868 eq getVariants(M,T,NextVar,TL) = getVariants(M,T,NextVar,reducible BuiltInUnify,TL) . 3869 3870 op getVariants : Module Term Nat EFlags -> VariantFourSet . 3871 eq getVariants(M,T,NextVar,EF) = getVariants(M,T,NextVar,EF,empty) . 3872 3873 op getVariants : Module Term Nat EFlags TermList -> VariantFourSet . 3874 eq getVariants(M,T,NextVar,EF,TL) 3875 = unrigidife(qid(NextVar), 3876 getVariants*( 3877 getM(rigidifeRigid(M,qid(NextVar),T)), 3878 getTL(rigidifeRigid(M,qid(NextVar),T)), 3879 NextVar + 1,EF,TL 3880 ) 3881 ) . 3882 3883 op getVariants* : Module Term Nat EFlags TermList -> VariantFourSet . 3884 eq getVariants*(M,T,NextVar,EF,TL) 3885 = if howMany(onlyEqsVariant(M),T) == 0 3886 then {T,none,none,NextVar} 3887 else if getVariants**(M,T,NextVar,EF,TL) :: VariantFourSet 3888 and 3889 getVariants**(M,T,NextVar,EF,TL) =/= empty 3890 then getVariants**(M,T,NextVar,EF,TL) 3891 else {T,none,none,NextVar} 3892 fi 3893 fi . 3894 3895 op getVariants** : Module Term Nat EFlags TermList -> VariantFourSet . 3896 eq getVariants**(M,T,NextVar,EF,TL) 3897 = minimizeBindingsTerm(M,Vars(T),NextVar, 3898 getVariants***(M,T,NextVar,empty,0,TL) 3899 ) . 3900 3901 op getVariants*** : Module Term Nat VariantFourSet Nat TermList -> VariantFourSet . 3902 eq getVariants***(M,T,NextVar,VTS,N,TL) 3903 = if metaGetVariant(M,T,TL,NextVar,N) == noVariant 3904 then VTS 3905 else getVariants***$(M,T,NextVar,VTS,N, 3906 metaGetVariant(M,T,TL,NextVar,N),TL) 3907 fi . 3908 3909 op getVariants***$ : Module Term Nat VariantFourSet Nat Variant TermList -> VariantFourSet . 3910 eq getVariants***$(M,T,NextVar,VTS,N,{T2:Term,S:Substitution,NV2:Nat, P:Parent, B:Bool},TL) 3911 = getVariants***$$(M,T,NextVar,VTS,N,{T2:Term,S:Substitution,NV2:Nat, P:Parent, B:Bool}, 3912 split({S:Substitution,NV2:Nat},NextVar),TL) . 3913 3914 op getVariants***$$ : Module Term Nat VariantFourSet Nat Variant UnificationTriple TermList -> VariantFourSet . 3915 eq getVariants***$$(M,T,NextVar,VTS,N, 3916 {T2:Term,S:Substitution,NV2:Nat, P:Parent, B:Bool}, 3917 {S1:Substitution,S2:Substitution,NV2:Nat},TL) 3918 = getVariants***(M,T,NextVar, 3919 VTS | {T2:Term,S1:Substitution,S2:Substitution,NV2:Nat}, 3920 N + 1,TL) . 3921 3922 sort PairGeneralize . 3923 op {_,_} : TermList Nat -> PairGeneralize . 3924 op fst : PairGeneralize -> TermList . 3925 eq fst({X:TermList,Y:Nat}) = X:TermList . 3926 op snd : PairGeneralize -> Nat . 3927 eq snd({X:TermList,Y:Nat}) = Y:Nat . 3928 3929 op generalize : Module Nat NeTermList -> PairGeneralize . 3930 eq generalize(M,NextVar,NeTL) 3931 = generalize*(M,NextVar,getEqs(M),NeTL) . 3932 3933 op generalize* : Module Nat EquationSet TermList -> PairGeneralize . 3934 eq generalize*(M,NextVar,EqS,empty) 3935 = {empty,NextVar} . 3936 eq generalize*(M,NextVar,EqS,(T,TL)) 3937 = {(fst(generalize**(M,NextVar,EqS,T)), 3938 fst(generalize*(M,snd(generalize**(M,NextVar,EqS,T)),EqS,TL))), 3939 snd(generalize*(M,snd(generalize**(M,NextVar,EqS,T)),EqS,TL)) 3940 } . 3941 3942 op generalize** : Module Nat EquationSet Term -> PairGeneralize . 3943 eq generalize**(M,NextVar,EqS,C) 3944 = {C,NextVar} . 3945 eq generalize**(M,NextVar,EqS,V) 3946 = {V,NextVar} . 3947 ceq generalize**(M,NextVar,(eq F'[TL'] = Rhs [AtS] .) EqS,F[TL]) 3948 = {newVar(NextVar,getKind(M,leastSort(M,F[TL]))),NextVar + 1} 3949 if F == F' 3950 and-then 3951 glbSorts(M,leastSort(M,TL),leastSort(M,TL')) =/= none . 3952 eq generalize**(M,NextVar,EqS,F[TL]) 3953 = {F[fst(generalize*(M,NextVar,EqS,TL))], 3954 snd(generalize*(M,NextVar,EqS,TL))} 3955 [owise] . 3956 3957 *** Identify bound for terms 3958 op howMany : Module NeTermList -> Nat . 3959 eq howMany(M,NeTL) 3960 = howMany*(M,getEqs(M),NeTL << 0 < ) . 3961 3962 op howMany* : Module EquationSet TermList -> Nat . 3963 eq howMany*(M,EqS,empty) 3964 = 0 . 3965 eq howMany*(M,EqS,(T,TL)) 3966 = howMany**(M,EqS,T) + howMany*(M,EqS,TL) . 3967 3968 op howMany** : Module EquationSet Term -> Nat . 3969 eq howMany**(M,EqS,C) 3970 = 0 . 3971 eq howMany**(M,EqS,V) 3972 = 0 . 3973 ceq howMany**(M,(eq F'[TL'] = Rhs [AtS] .) EqS,F[TL]) 3974 = 1 + howMany*(M,(eq F'[TL'] = Rhs [AtS] .) EqS,TL) 3975 if F == F' 3976 and-then 3977 glbSorts(M,leastSort(M,TL),leastSort(M,TL')) =/= none 3978 and-then not isAssociative(M,F,getTypes(M,TL)) . 3979 ceq howMany**(M,(eq F'[TL'] = Rhs [AtS] .) EqS,F[TL]) 3980 = sd(length(TL),1) + howMany*(M,(eq F'[TL'] = Rhs [AtS] .) EqS,TL) 3981 if F == F' 3982 and-then 3983 glbSorts(M,leastSort(M,TL),leastSort(M,TL')) =/= none 3984 and-then isCommutative(M,F,getTypes(M,TL)) 3985 and-then isAssociative(M,F,getTypes(M,TL)) . 3986 eq howMany**(M,EqS,F[TL]) 3987 = howMany*(M,EqS,TL) [owise] . 3988 3989 3990 *** Identify whether basic or variant narrowing should be used 3991 op howManyAC : Module NeTermList -> Nat . 3992 eq howManyAC(M,NeTL) 3993 = if howManyAC$(M,getEqs(M)) == 0 3994 then 0 3995 else howManyAC*(M,getEqs(M),NeTL << 0 < ) 3996 fi . 3997 3998 op howManyAC* : Module EquationSet TermList -> Nat . 3999 eq howManyAC*(M,EqS,empty) 4000 = 0 . 4001 eq howManyAC*(M,EqS,(T,TL)) 4002 = howManyAC**(M,EqS,T) + howManyAC*(M,EqS,TL) . 4003 4004 op howManyAC** : Module EquationSet Term -> Nat . 4005 eq howManyAC**(M,EqS,C) 4006 = 0 . 4007 eq howManyAC**(M,EqS,V) 4008 = 0 . 4009 ceq howManyAC**(M,(eq F'[TL'] = Rhs [AtS] .) EqS,F[TL]) 4010 = sd(length(TL),1) + howManyAC*(M,(eq F'[TL'] = Rhs [AtS] .) EqS,TL) 4011 if F == F' 4012 and-then 4013 glbSorts(M,leastSort(M,TL),leastSort(M,TL')) =/= none 4014 and-then isCommutative(M,F,getTypes(M,TL)) 4015 and-then isAssociative(M,F,getTypes(M,TL)) . 4016 eq howManyAC**(M,EqS,F[TL]) 4017 = howManyAC*(M,EqS,TL) [owise] . 4018 4019 op length : TermList -> Nat . 4020 eq length((empty).TermList) = 0 . 4021 eq length((T:Term,TL:TermList)) = 1 + length(TL:TermList) . 4022 4023 op howManyAC$ : Module EquationSet -> Nat [memo] . 4024 eq howManyAC$(M,EqS) 4025 = howManyAC$$(M,EqS) . 4026 4027 op howManyAC$$ : Module EquationSet -> Nat . 4028 eq howManyAC$$(M,none) 4029 = 0 . 4030 eq howManyAC$$(M,(eq F[TL] = Rhs [AtS] .) EqS) 4031 = if isCommutative(M,F,getTypes(M,TL)) 4032 and isAssociative(M,F,getTypes(M,TL)) 4033 then 1 else 0 fi 4034 + howManyAC$$(M,EqS) . 4035 4036endfm 4037 4038fmod META-ACU-UNIFICATION is 4039 pr TERM-HANDLING . 4040 pr SUBSTITUTION-HANDLING . 4041 pr MODULE-HANDLING . 4042 pr SUBSTITUTIONSET . 4043 pr UNIFICATIONPAIRSET . 4044 pr CONVERSION . 4045 pr META-LEVEL-MNPA . 4046 pr META-MINIMIZE-BINDINGS . 4047 pr META-E-UNIFICATION . 4048 4049 var M : Module . 4050 vars T T' : Term . 4051 vars N N' : Nat . 4052 vars US : UnificationTripleSet . 4053 4054 --- metaACUUnify -------------------------------------------------- 4055 op metaACUUnify : Module Term Term -> SubstitutionSet . 4056 eq metaACUUnify(M, T, T') 4057 = toSubstitution(metaACUUnify(M, T, T', highestVar((T,T')) + 1)) . 4058 4059 op metaACUUnify? : Module Term Term -> Bool . 4060 eq metaACUUnify?(M, T, T') 4061 = metaACUUnify?(M, T, T', highestVar((T,T')) + 1) . 4062 4063 *** General Call for UnificationPairSet 4064 op metaACUUnify : Module Term Term Nat -> UnificationTripleSet . 4065 eq metaACUUnify(M, T, T', N) 4066 = metaACUUnify$(M, canonice(M,T), canonice(M,T'), N) . 4067 4068 op metaACUUnify$ : Module Term Term Nat -> UnificationTripleSet . 4069 --- Term Lhs 4070 eq metaACUUnify$(M, T, T', N) 4071 = if (root(T) =/= root(T') 4072 and not (root(T) :: Variable) and not (root(T') :: Variable)) 4073 or-else 4074 glbSorts(M,leastSort(M,T),leastSort(M,T')) == none 4075 then empty 4076 else minimizeBindingsTerm(M,Vars(T),N, 4077 metaACUUnifyCollect(M, T, T',N,0,empty)) 4078 fi . 4079 4080 op metaACUUnify? : Module Term Term Nat -> Bool . 4081 eq metaACUUnify?(M, T, T', N) 4082 = metaACUUnify?$(M, canonice(M,T), canonice(M,T'), N) . 4083 4084 op metaACUUnify?$ : Module Term Term Nat -> Bool . 4085 eq metaACUUnify?$(M, T, T', N) 4086 = glbSorts(M,leastSort(M,T),leastSort(M,T')) =/= none 4087 and-then 4088 (metaACUUnify*(M,T =? T',N,0) :: UnificationTriple? 4089 and 4090 metaACUUnify*(M,T =? T',N,0) =/= noUnifier) . 4091 4092 op metaACUUnifyCollect : Module Term Term Nat Nat 4093 UnificationTripleSet 4094 -> UnificationTripleSet . 4095 eq metaACUUnifyCollect(M,T,T',N,N',US) 4096 = if metaACUUnify*(M,T =? T',N,N') :: UnificationTriple? 4097 and 4098 metaACUUnify*(M,T =? T',N,N') =/= noUnifier 4099 then metaACUUnifyCollect(M,T,T',N,s(N'), 4100 US | metaACUUnify*(M,T =? T',N,N') ) 4101 else US 4102 fi . 4103 4104 *** Code for collection all unifiers 4105 op metaACUUnify* : Module UnificandPair Nat Nat ~> UnificationTriple? . 4106 eq metaACUUnify*(M, T =? T',N,N') 4107 = metaUnifyTriple( 4108 keepOnlyACUAttr(eraseEqs(eraseRls(M))), 4109 unflatten(M,T) =? unflatten(M,T'), 4110 N,N') . 4111 4112 op metaUnifyTriple : Module UnificationProblem Nat Nat ~> UnificationTriple? . 4113 eq metaUnifyTriple(M,T =? T',N,N') 4114 = if metaUnify(M,T =? T',N,N') == noUnifier 4115 then noUnifier 4116 else {getSubst(metaUnify(M,T =? T',N,N')) |> T, 4117 getSubst(metaUnify(M,T =? T',N,N')) |> T', 4118 getNextVar(metaUnify(M,T =? T',N,N'))} 4119 fi . 4120endfm 4121 4122fmod META-UNIFICATION is 4123 pr META-ACU-UNIFICATION . 4124 4125 var M : Module . 4126 var T T' : Term . 4127 var N : Nat . 4128 4129 --- metaUnify -------------------------------------------------- 4130 op metaCoreUnify : Module Term Term -> SubstitutionSet . 4131 eq metaCoreUnify(M, T, T') 4132 = toSubstitution(metaCoreUnify(M, T, T', highestVar((T,T')) + 1)) . 4133 4134 op metaCoreUnify : Module Term Term Nat -> UnificationTripleSet . 4135 --- Term Lhs 4136 eq metaCoreUnify(M, T, T', N) 4137 = metaACUUnify(M, T, T', N) . 4138 4139 op metaCoreUnify? : Module Term Term Nat -> Bool . 4140 --- Term Lhs 4141 eq metaCoreUnify?(M, T, T', N) 4142 = metaACUUnify?(M, T, T', N) . 4143 4144endfm 4145 4146fmod META-MSG-UNIFICATION is 4147 pr META-ACU-UNIFICATION . 4148 pr META-MATCH . 4149 4150 var M : Module . 4151 vars T T' T1# T2# T1$ T2$ T1 T2 : Term . 4152 vars N N' N'' N1# N2# : Nat . 4153 vars S S' S1# S2# LSubst RSubst : Substitution . 4154 var UP : UnificationProblem . 4155 vars UTS UTS' : UnificationTripleSet . 4156 var C : Constant . 4157 vars V V' V1 V2 V3 : Variable . 4158 vars F F1 F2 : Qid . 4159 vars TL TL1 TL1' TL1'' TL2 TL2' TL2'' : TermList . 4160 var NeTL : NeTermList . 4161 4162 var U : UnificationPair . 4163 vars US US' : UnificationPairSet . 4164 var SS SS' : SubstitutionSet . 4165 vars TP TP' : Type . 4166 var TPS : TypeSet . 4167 var TPL : TypeList . 4168 var AtS : AttrSet . 4169 var OPDS : OpDeclSet . 4170 4171 ******* metaBuiltInMatch *********************************************** 4172 op metaBuiltInMatch : Module Term Term -> SubstitutionSet . 4173 *** T1 instance of T2 4174 eq metaBuiltInMatch(M, T1, T2) 4175 = metaCoreMatch(M, T1, T2) . 4176 4177 op metaBuiltInMatch? : Module Term Term -> Bool . 4178 *** T1 instance of T2 4179 eq metaBuiltInMatch?(M, T1, T2) 4180 = metaCoreMatch?(M, T1, T2) . 4181 4182 ******* metaBuiltInUnify *********************************************** 4183 op metaBuiltInUnify : Module Term Term -> SubstitutionSet . 4184 eq metaBuiltInUnify(M, T, T') 4185 = metaBuiltInUnify(M, empty, T, T') . 4186 4187 op metaBuiltInUnify : Module TermList Term Term -> SubstitutionSet . 4188 eq metaBuiltInUnify(M, TL T, T') 4189 = toSubstitution(metaBuiltInUnify(M, TL, T, T', highestVar((T,T')) + 1)) . 4190 4191 *** General Call for UnificationPairSet 4192 op metaBuiltInUnify : Module TermList Term Term Nat -> UnificationTripleSet . 4193 --- Term Lhs 4194 eq metaBuiltInUnify(M, TL, T1, T2, N) 4195 = metaBuiltInUnify(M, T1, T2, N) . 4196 4197 op metaBuiltInUnify : Module Term Term Nat -> UnificationTripleSet . 4198 eq metaBuiltInUnify(M, T1, T2, N) 4199 = metaCoreUnify(M, T1, T2, N) . 4200 4201 op metaBuiltInUnify? : Module Term Term -> Bool . 4202 eq metaBuiltInUnify?(M, T, T') 4203 = metaBuiltInUnify?(M, empty, T, T') . 4204 4205 op metaBuiltInUnify? : Module TermList Term Term -> Bool . 4206 eq metaBuiltInUnify?(M, TL, T, T') 4207 = metaBuiltInUnify?(M, TL, T, T',highestVar((T,T')) + 1) . 4208 4209 op metaBuiltInUnify? : Module TermList Term Term Nat -> Bool . 4210 eq metaBuiltInUnify?(M, TL, T1, T2, N) 4211 = metaBuiltInUnify?(M, T1, T2, N) . 4212 4213 op metaBuiltInUnify? : Module Term Term Nat -> Bool . 4214 eq metaBuiltInUnify?(M, T1, T2, N) 4215 = metaCoreUnify?(M, T1, T2, N) . 4216 4217 4218endfm 4219fmod ORDERS-TERM-SUBSTITUTION is 4220 protecting TERM-HANDLING . 4221 protecting SUBSTITUTION-HANDLING . 4222 protecting META-MATCH . 4223 protecting META-LEVEL-MNPA . 4224 protecting META-UNIFICATION . 4225 protecting META-E-UNIFICATION . 4226 protecting RENAMING . 4227 protecting SUBSTITUTIONSET . 4228 protecting META-MSG-UNIFICATION . 4229 4230 vars T T' : Term . 4231 vars TL TL' TL1 TL2 TL3 : TermList . 4232 var M : Module . 4233 vars S S' : Substitution . 4234 vars SS SS' SS'' : SubstitutionSet . 4235 vars V V' V1 V2 V3 : Variable . 4236 vars TPL TPL' : TypeList . 4237 vars N N' : Nat . 4238 vars F : Qid . 4239 var C : Constant . 4240 4241 --- metaEMatch(M,T,T') implies that T is an instance of T' modulo E + axioms 4242 op metaEMatch : Module Term Term -> SubstitutionSet . 4243 eq metaEMatch(M,T,T') 4244 = if metaCoreMatch(M,T,T') =/= empty 4245 then metaCoreMatch(M,T,T') 4246 else if metaEBuiltInUnifyIrr?(M,T,T') 4247 then metaShared-filter(M,T,T',metaEBuiltInUnifyIrr(M,T,T')) 4248 else empty 4249 fi 4250 fi . 4251 4252 op metaEMatch? : Module Term Term -> Bool . 4253 eq metaEMatch?(M,T,T') 4254 = metaCoreMatch?(M,T,T') 4255 or-else 4256 metaEBuiltInUnifyIrr?(M,T,T') . 4257 4258 --- order between terms --------------------------- 4259 --- T <=[M] T' implies that T' is an instance of T 4260 op _<=[_]_ : Term Module Term -> Bool . 4261 eq T <=[M] T' = (metaCoreMatch(M,T',T) |> T) =/= empty . 4262 4263 --- order between substitutions --------------------------- 4264 --- Subst <=[M] Subst' implies that Subst' is an instance of Subst 4265 op _<=[_]_ : SubstitutionSet Module SubstitutionSet -> Bool [ditto] . 4266 eq SS <=[M] SS' 4267 = SS <=[empty,M] SS' . 4268 4269 op _<=[_`,_]_ : SubstitutionSet TermList Module SubstitutionSet -> Bool . 4270 eq empty <=[TL,M] SS' 4271 = false . 4272 eq SS <=[TL,M] SS' 4273 = SS <=[TL,M]$ SS' [owise] . 4274 4275 op _<=[_`,_]$_ : SubstitutionSet TermList Module SubstitutionSet -> Bool . 4276 eq SS <=[TL,M]$ empty 4277 = true . 4278 eq SS <=[TL,M]$ (S' | SS') 4279 = (SS <=[TL,M]* S') and-then SS <=[TL,M]$ SS' . 4280 4281 op _<=[_`,_]*_ : SubstitutionSet TermList Module Substitution -> Bool . 4282 eq empty <=[TL,M]* S' 4283 = false . 4284 eq (S | SS) <=[TL,M]* S' 4285 = S <=[TL,M]** S' or-else SS <=[TL,M]* S' . 4286 4287 op _<=[_`,_]**_ : Substitution TermList Module Substitution -> Bool . 4288 eq none <=[TL,M]** S' 4289 = true . 4290 eq S <=[TL,M]** S' 4291 = 'Q[1st(gen(TL,S,S'))] 4292 *<=[ 4293 addSorts('XXX, 4294 addOps((op 'Q : 3rd(gen(TL,S,S')) -> 'XXX [none] .), 4295 M)) 4296 ]* 4297 'Q[2nd(gen(TL,S,S'))] 4298 [owise] . 4299 4300 --- T <=[M] T' implies that T' is an instance of T 4301 --- T and T' can have shared variables 4302 op _*<=[_]*_ : Term Module Term -> Bool . 4303 eq T *<=[M]* T' 4304 = (if anyVars T inVars T' 4305 then metaCoreMatchShared(M,T',T) 4306 else metaCoreMatch(M,T',T) 4307 fi |> T) 4308 =/= empty . 4309 4310 sort Triple . 4311 op {{_`,_`,_}} : TermList TermList TypeList -> Triple . 4312 op 1st : Triple -> TermList . 4313 eq 1st({{TL,TL',TPL}}) = TL . 4314 op 2nd : Triple -> TermList . 4315 eq 2nd({{TL,TL',TPL}}) = TL' . 4316 op 3rd : Triple -> TypeList . 4317 eq 3rd({{TL,TL',TPL}}) = TPL . 4318 4319 ops gen : TermList Substitution Substitution -> Triple . ---[memo] . 4320 eq gen(empty,none,none) 4321 = {{empty,empty,nil}} . 4322 eq gen((V,TL),none,none) 4323 = {{(V,1st(gen(TL,none,none))), 4324 (V,2nd(gen(TL,none,none))), 4325 (getType(V) 3rd(gen(TL,none,none)))}} . 4326 eq gen(TL,none,V <- T ; S') 4327 = {{(V,1st(gen(TL \\ V,none,S'))), 4328 (T,2nd(gen(TL \\ V,none,S'))), 4329 (getType(V) 3rd(gen(TL \\ V,none,S')))}} . 4330 eq gen(TL,V <- T ; S,V <- T' ; S') 4331 = {{(T,1st(gen(TL \\ V,S,S'))), 4332 (T',2nd(gen(TL \\ V,S,S'))), 4333 (getType(V) 3rd(gen(TL \\ V,S,S')))}} . 4334 eq gen(TL,V <- T ; S,S') 4335 = {{(T,1st(gen(TL \\ V,S,S'))), 4336 (V,2nd(gen(TL \\ V,S,S'))), 4337 (getType(V) 3rd(gen(TL \\ V,S,S')))}} 4338 [owise] . 4339 4340 op _\\_ : TermList Variable -> TermList . 4341 eq (TL,V,TL') \\ V = (TL,TL') . 4342 eq TL \\ V = TL [owise] . 4343 4344 --- renaming ----------------------------------------------- 4345 op _=[_]=_ : TermSet Module TermSet -> Bool . 4346 eq T1:TermSet =[M]= T2:TermSet 4347 = metaBuiltInRenaming(M,T1:TermSet,T2:TermSet) . 4348 4349 ***** 4350 op metaBuiltInRenaming : Module TermSet TermSet -> Bool . 4351 eq metaBuiltInRenaming(M,emptyTermSet,emptyTermSet) 4352 = true . 4353 ceq metaBuiltInRenaming(M,T:Term | T:TermSet,T':Term | T':TermSet) 4354 = metaBuiltInRenaming(M,T:TermSet,T':TermSet) 4355 if metaBuiltInRenaming$(M,T:Term,T':Term) . 4356 eq metaBuiltInRenaming(M,T:TermSet,T':TermSet) 4357 = false [owise] . 4358 4359 op metaBuiltInRenaming$ : Module Term Term -> Bool . 4360 eq metaBuiltInRenaming$(M,T:Term,T':Term) 4361 = canonice(M,nullVars(T)) == canonice(M,nullVars(T')) 4362 and-then 4363 (metaBuiltInRenaming$$1(M,canonice(M,T),canonice(M,T')) 4364 or-else 4365 metaBuiltInRenaming$$2(M,canonice(M,T),canonice(M,T')) 4366 ) . 4367 4368 op metaBuiltInRenaming$$1 : Module Term Term -> Bool . 4369 eq metaBuiltInRenaming$$1(M,T:Term,T':Term) 4370 = metaBuiltInRenaming$$1*( 4371 canonice(M,totalOrder(M,flatten(M,T:Term)) <<( 0 )<), 4372 canonice(M,totalOrder(M,flatten(M,T':Term)) <<( 0 )<) ) . 4373 4374 op metaBuiltInRenaming$$1* : Term Term -> Bool . 4375 eq metaBuiltInRenaming$$1*(T:Term,T':Term) = T:Term == T':Term . 4376 4377 op totalOrder : Module Term -> Term . 4378 eq totalOrder(M,C) = C . 4379 eq totalOrder(M,V) = V . 4380 eq totalOrder(M,F[TL]) 4381 = if not isCommutative(M,F[TL]) 4382 then F[totalOrderTL(M,TL)] 4383 else F[reorderTL(M,F,totalOrderTL(M,TL))] 4384 fi . 4385 4386 op totalOrderTL : Module TermList -> TermList . 4387 eq totalOrderTL(M,empty) = empty . 4388 eq totalOrderTL(M,(T,TL)) = (totalOrder(M,T),totalOrderTL(M,TL)) . 4389 4390 op reorderTL : Module Qid TermList -> TermList . 4391 eq reorderTL(M,F,empty) = empty . 4392 eq reorderTL(M,F,(T,TL)) 4393 = if insertTL(M,F,T,TL) =/= (T,TL) 4394 then reorderTL(M,F,insertTL(M,F,T,TL)) 4395 else (T,reorderTL(M,F,TL)) 4396 fi . 4397 4398 op insertTL : Module Qid Term TermList -> TermList . 4399 eq insertTL(M,F,T',empty) = T' . 4400 eq insertTL(M,F,T',(T,TL)) 4401 = if canonice(M,F[nullVars(T'),nullVars(T)]) == F[canonice(M,nullVars(T')),canonice(M,nullVars(T))] 4402 then (T',T,TL) 4403 else (T,insertTL(M,F,T',TL)) 4404 fi . 4405 4406 op nullVars : Term -> Term . 4407 eq nullVars(C) = C . 4408 eq nullVars(V) = qid("#0:" + string(getType(V))) . 4409 eq nullVars(F[TL]) = F[nullVarsTL(TL)] . 4410 4411 op nullVarsTL : TermList -> TermList . 4412 eq nullVarsTL(empty) = empty . 4413 eq nullVarsTL((T,TL)) = (nullVars(T),nullVarsTL(TL)) . 4414 4415 ***** 4416 op metaBuiltInRenaming$$2 : Module Term Term -> Bool . 4417 eq metaBuiltInRenaming$$2(M,T:Term,T':Term) 4418 = T == T' 4419 or-else 4420 onlyRenamingAny(M,metaBuiltInMatchShared(M,T',T) |> T) . 4421 4422 ***** 4423 op onlyRenamingAll : Module SubstitutionSet -> Bool . 4424 eq onlyRenamingAll(M,empty) 4425 = true . 4426 eq onlyRenamingAll(M,S | SS) 4427 = onlyRenaming*(M,S) 4428 and-then 4429 onlyRenamingAll(M,SS) . 4430 4431 op onlyRenamingAny : Module SubstitutionSet -> Bool . 4432 eq onlyRenamingAny(M,empty) 4433 = false . 4434 eq onlyRenamingAny(M,S | SS) 4435 = onlyRenaming*(M,S) 4436 or-else 4437 onlyRenamingAny(M,SS) . 4438 4439 op onlyRenaming* : Module Substitution -> Bool . 4440 eq onlyRenaming*(M,(V <- T) ; (V' <- T) ; S) 4441 = false . 4442 eq onlyRenaming*(M,S) 4443 = onlyRenaming**(M,S) [owise] . 4444 4445 op onlyRenaming** : Module Substitution -> Bool . 4446 ceq onlyRenaming**(M,(V <- F[TL]) ; S) 4447 = onlyRenaming*(M, 4448 canonice(M, S << (V1 <- getIdSymbol(M,F[TL]))) 4449 ) 4450 if getIdSymbol(M,F[TL]) :: Term 4451 /\ TL1,V1,TL2,V2,TL3 := TL 4452 /\ typeLeq(M,getType(getIdSymbol(M,F[TL])),getType(V1)) 4453 and-then 4454 not (V1 in Vars((TL1,TL2,V2,TL3))) 4455 /\ typeLeq(M,getType(getIdSymbol(M,F[TL])),getType(V2)) 4456 and-then 4457 not (V2 in Vars((TL1,V1,TL2,TL3))) . 4458 eq onlyRenaming**(M,S) 4459 = onlyRenaming***(S) [owise] . 4460 4461 op onlyRenaming*** : Substitution -> Bool . 4462 eq onlyRenaming***(none) 4463 = true . 4464 eq onlyRenaming***((V <- T) ; S) 4465 = T :: Variable 4466 and-then 4467 getType(V) == getType(T) 4468 and-then 4469 onlyRenaming***(S) . 4470 4471 --- Standard metaMatch does not deal with shared variables between T and T' 4472 --- metaCoreMatch(M,T,T') implies that T is an instance of T' 4473 4474 op metaCoreMatchShared : Module Term Term -> SubstitutionSet . 4475 eq metaCoreMatchShared(M,T,T') 4476 = metaShared-filter(M,T,T',metaCoreMatch(M,T,T')) . 4477 4478 op metaBuiltInMatchShared : Module Term Term -> SubstitutionSet . 4479 eq metaBuiltInMatchShared(M,T,T') 4480 = metaShared-filter(M,T,T',metaBuiltInMatch(M,T,T')) . 4481 4482 ******* 4483 op metaShared-filter : Module Term Term SubstitutionSet 4484 -> SubstitutionSet . 4485 eq metaShared-filter(M,T,T',SS) 4486 = metaShared-filter*(M,T,T',empty,SS) . 4487 4488 op metaShared-filter* : Module Term Term SubstitutionSet SubstitutionSet 4489 -> SubstitutionSet . 4490 eq metaShared-filter*(M,T,T',SS',empty) 4491 = SS' . 4492 eq metaShared-filter*(M,T,T',SS',S | SS) 4493 = metaShared-filter*(M,T,T', 4494 if S |> T == none 4495 then SS' | S 4496 else SS' 4497 fi, 4498 SS ) . 4499 4500 4501 *** Normalize Substitutions 4502 op normalizedSubstitution? : Module SubstitutionSet -> Bool . 4503 eq normalizedSubstitution?(M, empty) 4504 = true . 4505 eq normalizedSubstitution?(M, S | SS) 4506 = normalizedSubstitution?*(M, S) and-then normalizedSubstitution?(M, SS) . 4507 4508 op normalizedSubstitution?* : Module Substitution -> Bool . ---[memo] . 4509 eq normalizedSubstitution?*(M, none) 4510 = true . 4511 eq normalizedSubstitution?*(M, V <- T ; S:Substitution) 4512 = isNF$(clearAllFrozen(M),T) 4513 and-then 4514 normalizedSubstitution?*(M, S:Substitution) . 4515 4516 *** Normalize Substitutions 4517 op |_|`(_`) : SubstitutionSet Module -> SubstitutionSet . 4518 eq | S:SubstitutionSet |(M) 4519 = eqNormalizeSubstitution(M,S:SubstitutionSet) . 4520 4521 op eqNormalizeSubstitution : Module SubstitutionSet -> SubstitutionSet . 4522 eq eqNormalizeSubstitution(M, empty) 4523 = empty . 4524 eq eqNormalizeSubstitution(M, S | SS) 4525 = eqNormalizeSubstitution*(M, S) | eqNormalizeSubstitution(M, SS) . 4526 4527 op eqNormalizeSubstitution* : Module Substitution -> Substitution . 4528 eq eqNormalizeSubstitution*(M, none) 4529 = none . 4530 eq eqNormalizeSubstitution*(M, V <- T ; S:Substitution) 4531 = V <- getTerm(metaReduce(eraseRls(M),T)) 4532 ; eqNormalizeSubstitution*(M, S:Substitution) . 4533 4534endfm 4535fmod META-NORMALIZE is 4536 protecting META-TERM . 4537 protecting META-LEVEL-MNPA . 4538 protecting META-UNIFICATION . 4539 protecting RESULT-CONTEXT-SET . 4540 protecting ORDERS-TERM-SUBSTITUTION . 4541 protecting TYPEOFNARROWING . 4542 4543 vars T T' TOrig Lhs Rhs TS TS' CtTS CtTS' : Term . 4544 var V : Variable . 4545 var C : Constant . 4546 var F : Qid . 4547 vars TL TL' : TermList . 4548 var M : Module . 4549 vars RTS RTS' RTS$ RTS$' : ResultContextSet . 4550 vars RT RT' : ResultContext . 4551 vars TP TP' : Type . 4552 vars S S' S* S'* Subst : Substitution . 4553 var RLS : RuleSet . 4554 var Att : AttrSet . 4555 vars B BN : Bound . 4556 vars N NextVar NextVar' : Nat . 4557 var NL : NatList . 4558 vars Ct CtS Ct' CtS' : Context . 4559 var ON : TypeOfNarrowing . 4560 var QQ : TypeOfRelation . 4561 4562 op |_| : ResultTripleSet -> Nat . 4563 eq | (empty).ResultTripleSet | = 0 . 4564 eq | {T,TP,S} | RTS:ResultTripleSet | = s(| RTS:ResultTripleSet |) . 4565 4566 *** Shortcut to Normalization by rewriting Search 4567 op metaNormalizeCollect$ : Module Term ~> ResultTripleSet . 4568 eq metaNormalizeCollect$(M,T) 4569 = metaNormalizeCollect$(M,{T,leastSort(M,T),none}) . 4570 4571 op metaNormalizeCollect$ : Module Term Type ~> ResultTripleSet . 4572 eq metaNormalizeCollect$(M,T,TP) 4573 = metaNormalizeCollect$(M,{T,TP,none}) . 4574 4575 op metaNormalizeCollect$ : Module ResultTriple ~> ResultTripleSet . 4576 eq metaNormalizeCollect$(M,{T,TP,S}) 4577 = metaSearchCollect(M, 4578 T, (addType TP ToVar 'XXXXXXX), 4579 '!,unbounded) . 4580 4581 *** Shortcut to One rewriting step 4582 op metaOneRewriting$ : Module Term ~> ResultTripleSet . 4583 eq metaOneRewriting$(M,T) 4584 = metaOneRewriting$(M,{T,leastSort(M,T),none}) . 4585 4586 op metaOneRewriting$ : Module Term Type -> ResultTripleSet . 4587 eq metaOneRewriting$(M,T,TP) 4588 = metaOneRewriting$(M,{T,TP,none}) . 4589 4590 op metaOneRewriting$ : Module ResultTriple -> ResultTripleSet . 4591 4592 eq metaOneRewriting$(M,{T,TP,S}) 4593 = metaSearchCollect(M, 4594 T, (addType TP ToVar 'XXXXXXX), 4595 '+,1) . 4596 4597 *** Use Standard Maude metaSearch 4598 op metaSearchCollect : Module Term Term TypeOfRelation Bound 4599 ~> ResultTripleSet . 4600 eq metaSearchCollect(M,T,T',QQ,B) 4601 = metaSearchCollect(M,T,T',QQ,B,0) . 4602 4603 op metaSearchCollect : Module Term Term TypeOfRelation Bound Nat 4604 ~> ResultTripleSet . 4605 eq metaSearchCollect(M,T,T',QQ,B,N:Nat) 4606 = if metaSearch(M,T,T',nil,[QQ],B,N:Nat) :: ResultTripleSet 4607 and 4608 metaSearch(M,T,T',nil,[QQ],B,N:Nat) =/= failure 4609 then metaSearch(M,T,T',nil,[QQ],B,N:Nat) 4610 | 4611 metaSearchCollect(M,T,T',QQ,B,s(N:Nat)) 4612 else empty 4613 fi . 4614 4615 *** Shortcut to normal form detection 4616 op isNF$ : Module Substitution ~> Bool . 4617 eq isNF$(M, (none).Substitution) 4618 = true . 4619 eq isNF$(M, V:Variable <- T:Term ; S:Substitution) 4620 = isNF$(M,T) and-then isNF$(M, S:Substitution) . 4621 4622 op isNF$ : Module Term ~> Bool . 4623 eq isNF$(M,T) = isNF$$(M,T,leastSort(M,T)) . 4624 4625 op isNF$$ : Module Term Type ~> Bool . 4626 eq isNF$$(M,T,TP) 4627 = metaSearch(M,T,(addType TP ToVar 'XXXXXXX),nil,'+,1,0) == failure . 4628 4629 *********************************************************************** 4630 --- Not defined in this module------------- 4631 op metaNarrowSearchAll : Module Term Term SubstitutionCond TypeOfRelation 4632 Bound Bound --- number steps / number solutions 4633 Bound --- chosen solution 4634 TypeOfNarrowing 4635 ResultContextSet 4636 -> ResultContextSet . 4637 --- Not defined in this module------------- 4638 4639 op metaNormalizeCollect : Module Term ~> ResultTripleSet . 4640 eq metaNormalizeCollect(M,T) 4641 = if anyNonExec(M) 4642 then metaNormalizeCollect#(M,T) 4643 else metaNormalizeCollect$(M,T) 4644 fi . 4645 4646 op metaNormalizeCollect : Module Term Type -> ResultTripleSet . 4647 eq metaNormalizeCollect(M,T,TP) 4648 = if anyNonExec(M) 4649 then metaNormalizeCollect#(M,T,TP) 4650 else metaNormalizeCollect$(M,T,TP) 4651 fi . 4652 4653 op metaNormalizeCollect : Module ResultTriple -> ResultTripleSet . 4654 eq metaNormalizeCollect(M,{T,TP,S}) 4655 = if anyNonExec(M) 4656 then metaNormalizeCollect#(M,{T,TP,S}) 4657 else metaNormalizeCollect$(M,{T,TP,S}) 4658 fi . 4659 4660 op metaOneRewriting : Module Term ~> ResultTripleSet . 4661 eq metaOneRewriting(M,T) 4662 = if anyNonExec(M) 4663 then metaOneRewriting#(M,T) 4664 else metaOneRewriting$(M,T) 4665 fi . 4666 4667 op metaOneRewriting : Module Term Type -> ResultTripleSet . 4668 eq metaOneRewriting(M,T,TP) 4669 = if anyNonExec(M) 4670 then metaOneRewriting#(M,T,TP) 4671 else metaOneRewriting$(M,T,TP) 4672 fi . 4673 4674 op metaOneRewriting : Module ResultTriple -> ResultTripleSet . 4675 eq metaOneRewriting(M,{T,TP,S}) 4676 = if anyNonExec(M) 4677 then metaOneRewriting#(M,{T,TP,S}) 4678 else metaOneRewriting$(M,{T,TP,S}) 4679 fi . 4680 4681 --- Based on narrowing ----------------------------- 4682 op metaNormalizeCollect# : Module Term ~> ResultTripleSet . 4683 eq metaNormalizeCollect#(M,T) 4684 = metaNormalizeCollect#(M,{T,leastSort(M,T),none}) . 4685 4686 op metaNormalizeCollect# : Module Term Type -> ResultTripleSet . 4687 eq metaNormalizeCollect#(M,T,TP) 4688 = metaNormalizeCollect#(M,{T,TP,none}) . 4689 4690 ---metaSearch of Maude doesn't work for rules with extra vars 4691 op metaNormalizeCollect# : Module ResultTriple -> ResultTripleSet . 4692 eq metaNormalizeCollect#(M,{T,TP,S}) 4693 = toTriple(M, 4694 metaNarrowSearchAll( 4695 M, 4696 T, (addType TP ToVar 'XXXXXXX), 4697 none,'!,unbounded,unbounded,unbounded,E-rewriting noStrategy, 4698 {T,TP,S,none,[],[],T << S,T << S, 4699 max(highestVar(S),highestVar((T,T << S))) + 1, 4700 nil, 4701 empty} 4702 )) . 4703 4704 op metaOneRewriting# : Module Term ~> ResultTripleSet . 4705 eq metaOneRewriting#(M,T) 4706 = metaOneRewriting#(M,{T,leastSort(M,T),none}) . 4707 4708 op metaOneRewriting# : Module Term Type -> ResultTripleSet . 4709 eq metaOneRewriting#(M,T,TP) 4710 = metaOneRewriting#(M,{T,TP,none}) . 4711 4712 op metaOneRewriting# : Module ResultTriple -> ResultTripleSet . 4713 eq metaOneRewriting#(M,{T,TP,S}) 4714 = toTriple(M, 4715 metaNarrowSearchAll( 4716 M, 4717 T, (addType TP ToVar 'XXXXXXX), 4718 none,'+,1,unbounded,unbounded,E-rewriting noStrategy, 4719 {T,TP,S,none,[],[],T << S,T << S, 4720 max(highestVar(S),highestVar((T,T << S))) + 1, 4721 nil, 4722 empty} 4723 )) . 4724 4725 *** Remove itself 4726 op noSelf : ResultContextSet ResultContextSet -> ResultContextSet . 4727 eq noSelf(empty,RTS') 4728 = RTS' . 4729 eq noSelf({T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} | RTS,RTS') 4730 = noSelf(RTS, 4731 if TS == T and-then CtTS == T and-then Ct == [] and-then CtS == [] 4732 then noSelf*({T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}, RTS') 4733 else RTS' 4734 fi 4735 ) . 4736 4737 op noSelf* : ResultContext ResultContextSet -> ResultContextSet . 4738 eq noSelf*(RT,empty) 4739 = empty . 4740 eq noSelf*({T,TP,S,S*,[],[],T,T,NextVar,Tr:TraceNarrow,B:Flags}, 4741 {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',Tr':TraceNarrow,B':Flags} | RTS) 4742 = if TS' == T' and-then CtTS' == T' and-then Ct' == [] and-then CtS' == [] 4743 and-then 4744 T == T' and-then TP == TP' 4745 and-then 4746 (S |> T) == (S' |> T) 4747 then ---remove 4748 empty 4749 else ---keep 4750 {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',Tr:TraceNarrow,B':Flags} 4751 fi 4752 | noSelf*({T,TP,S,S*,[],[],T,T,NextVar,Tr':TraceNarrow,B:Flags},RTS) . 4753 4754endfm 4755 4756fmod META-E-NARROWING is 4757 protecting META-TERM . 4758 protecting META-LEVEL-MNPA . 4759 protecting META-UNIFICATION . 4760 protecting META-MSG-UNIFICATION . 4761 protecting META-E-UNIFICATION . 4762 protecting RESULT-CONTEXT-SET . 4763 protecting ORDERS-TERM-SUBSTITUTION . 4764 protecting TYPEOFNARROWING . 4765 protecting META-NORMALIZE . 4766 protecting UNIFICATIONTRIPLESET . 4767 protecting RIGIDIFE . 4768 4769 var T T' T'' TOrig Lhs Lhs' Rhs Rhs' : Term . 4770 var CT' TS TS' TS'' CtTS CtTS' CtTS'' : Term . 4771 var V : Variable . 4772 var C : Constant . 4773 var F : Qid . 4774 var M : Module . 4775 var RTS RTS' RTS$ RTS-Rls RTS-Sub RTSSol : ResultContextSet . 4776 var RTNeS : ResultContextNeSet . 4777 var RT RT' : ResultContext . 4778 vars S S' S'' Subst Subst' S* S'* : Substitution . 4779 var SS : SubstitutionSet . 4780 var RLS : RuleSet . 4781 var RL : Rule . 4782 vars Att Att' : AttrSet . 4783 var B BN : Bound . 4784 vars N N' N1 N2 : Nat . 4785 var NL : NatList . 4786 vars Ct CtS Ct' CtS' Ct'' CtS'' : Context . 4787 var NeTL NeTL' : NeTermList . 4788 vars TL TL' TL'' TL''' : TermList . 4789 vars TP TP' TP'' : Type . 4790 var ON : TypeOfNarrowing . 4791 vars NextVar NextVar' NextVar'' NVarPrev : Nat . 4792 var U : UnificationTriple . 4793 vars US US' : UnificationTripleSet . 4794 var IRR : IrrFlags . 4795 4796 --- metaNarrow --------------------------- 4797 ---( We implement: 4798 * basic narrowing, where terms introduced 4799 by unifiers (substitutions) are never 4800 selected for narrowing, and 4801 * standard narrowing, where this 4802 restriction does not apply ) 4803 4804 4805 *** Shortcuts to Narrowing 4806 op metaNarrow : Module Term -> ResultTripleSet . 4807 eq metaNarrow(M,T) = metaNarrow(M,T,1) . 4808 4809 op metaNarrow : Module Term Bound -> ResultTripleSet . 4810 eq metaNarrow(M,T,B) 4811 = toTriple(M,metaENarrowShowAll(M,T,B,full noStrategy BuiltIn-unify)) |> T . 4812 4813 *** Shortcuts to Basic Narrowing 4814 op metaBasicNarrow : Module Term -> ResultTripleSet . 4815 eq metaBasicNarrow(M,T) = metaBasicNarrow(M,T,1) . 4816 4817 op metaBasicNarrow : Module Term Bound -> ResultTripleSet . 4818 eq metaBasicNarrow(M,T,B) 4819 = toTriple(M,metaENarrowShowAll(M,T,B,basic noStrategy BuiltIn-unify)) |> T . 4820 4821 *** Shortcuts to Narrowing 4822 op metaENarrow : Module Term -> ResultTripleSet . 4823 eq metaENarrow(M,T) = metaENarrow(M,T,1) . 4824 4825 op metaENarrow : Module Term Bound -> ResultTripleSet . 4826 eq metaENarrow(M,T,B) 4827 = toTriple(M,metaENarrowShowAll(M,T,B,full noStrategy E-BuiltIn-unify)) 4828 |> T . 4829 4830 *** Shortcuts to Narrowing 4831 op metaEBuiltInTopMostNarrow : Module Term Nat -> ResultTripleSet . 4832 eq metaEBuiltInTopMostNarrow(M,T,N) 4833 = metaETopMostNarrow(M,T,1,reducible, E-BuiltIn-unify,N) . 4834 op metaEBuiltInTopMostNarrowIrr : Module Term Nat -> ResultTripleSet . 4835 eq metaEBuiltInTopMostNarrowIrr(M,T,N) 4836 = metaETopMostNarrow(M,T,1,irreducible, E-BuiltIn-unify,N) . 4837 4838 op metaEACUTopMostNarrow : Module Term Nat -> ResultTripleSet . 4839 eq metaEACUTopMostNarrow(M,T,N) 4840 = metaETopMostNarrow(M,T,1,reducible, E-ACU-unify,N) . 4841 op metaEACUTopMostNarrowIrr : Module Term Nat -> ResultTripleSet . 4842 eq metaEACUTopMostNarrowIrr(M,T,N) 4843 = metaETopMostNarrow(M,T,1,irreducible, E-ACU-unify,N) . 4844 4845 op metaETopMostNarrow : Module Term Bound IrrFlags TypeOfNarrowing Nat 4846 -> ResultTripleSet . 4847 eq metaETopMostNarrow(M,T,B,IRR,ON,N) 4848 = toTriple(M,metaENarrowShowAll(M,T,B,full topmost ON [IRR],N)) |> T . 4849 4850 op metaEBuiltInTopMostNarrowRC : Module Term TermList Nat -> ResultContextSet . 4851 eq metaEBuiltInTopMostNarrowRC(M,T,TL,N) 4852 = metaETopMostNarrowRC(M,T,1,reducible, E-BuiltIn-unify irrTerms(TL),N) . 4853 op metaEBuiltInTopMostNarrowRCIrr : Module Term TermList Nat -> ResultContextSet . 4854 eq metaEBuiltInTopMostNarrowRCIrr(M,T,TL,N) 4855 = metaETopMostNarrowRC(M,T,1,irreducible, E-BuiltIn-unify irrTerms(TL),N) . 4856 4857 op metaEACUTopMostNarrowRC : Module Term Nat -> ResultContextSet . 4858 eq metaEACUTopMostNarrowRC(M,T,N) 4859 = metaETopMostNarrowRC(M,T,1,reducible, E-ACU-unify,N) . 4860 op metaEACUTopMostNarrowRCIrr : Module Term Nat -> ResultContextSet . 4861 eq metaEACUTopMostNarrowRCIrr(M,T,N) 4862 = metaETopMostNarrowRC(M,T,1,irreducible, E-ACU-unify,N) . 4863 4864 op metaETopMostNarrowRC : Module Term Bound IrrFlags TypeOfNarrowing Nat 4865 -> ResultContextSet . 4866 eq metaETopMostNarrowRC(M,T,B,IRR,ON,N) 4867 = metaENarrowShowAll(M,T,B,full topmost ON [IRR],N) |> T . 4868 4869 --- Auxiliary 4870 op [_,_] : TypeOfNarrowing IrrFlags ~> TypeOfNarrowing . 4871 eq [ E-ACU-unify, reducible ] = E-ACU-unify . 4872 eq [ E-ACU-unify, irreducible ] = E-ACU-unify-Irr . 4873 eq [ E-BuiltIn-unify, reducible ] = E-BuiltIn-unify . 4874 eq [ E-BuiltIn-unify, irreducible ] = E-BuiltIn-unify-Irr . 4875 4876 *** Shortcuts to Basic Narrowing 4877 op metaEBasicNarrow : Module Term -> ResultTripleSet . 4878 eq metaEBasicNarrow(M,T) 4879 = metaEBasicNarrow(M,T,1) . 4880 4881 *** Shortcuts for normalization 4882 op metaEBasicNarrow : Module Term Bound -> ResultTripleSet . 4883 eq metaEBasicNarrow(M,T,B) 4884 = toTriple(M,metaENarrowShowAll(M,T,B,E-BuiltIn-unify noStrategy basic)) |> T . 4885 4886 op metaBasicNarrowNormalize : Module Term -> ResultTripleSet . 4887 eq metaBasicNarrowNormalize(M,T) 4888 = toTriple(M,metaBasicNarrowNormalizeAll(M,T,highestVar(T) + 1)) |> T . 4889 4890 op metaBasicNarrowNormalizeAll : Module Term Nat -> ResultContextSet . 4891 eq metaBasicNarrowNormalizeAll(M,T,NextVar) 4892 = metaENarrowShowAll(M,T,unbounded, 4893 basic BuiltIn-unify 4894 computed-normalized-subs applied-normalized-subs 4895 normalize-terms noStrategy,NextVar) . 4896 4897 op metaNarrowNormalize : Module Term -> ResultTripleSet . 4898 eq metaNarrowNormalize(M,T) 4899 = toTriple(M,metaNarrowNormalizeAll(M,T,highestVar(T) + 1)) |> T . 4900 4901 op metaNarrowNormalizeAll : Module Term Nat -> ResultContextSet . 4902 eq metaNarrowNormalizeAll(M,T,NextVar) 4903 = metaENarrowShowAll(M,T,unbounded, 4904 full BuiltIn-unify 4905 computed-normalized-subs applied-normalized-subs 4906 normalize-terms noStrategy,NextVar) . 4907 4908 *** General Call 4909 op metaENarrowShowAll : Module Term Bound TypeOfNarrowing 4910 -> ResultContextSet . 4911 eq metaENarrowShowAll(M,T,B,ON) 4912 = metaENarrowShowAll(M,T,B,ON,highestVar(T) + 1) . 4913 4914 op metaENarrowShowAll : Module Term Bound TypeOfNarrowing Nat 4915 -> ResultContextSet . 4916 eq metaENarrowShowAll(M,T,B,ON,N) 4917 = metaENarrowGen(removeBoolEqs(M),B,ON, 4918 {T,leastSort(M,T),none,none,[],[],T,T,N,nil,empty}) . 4919 4920 *** Call for ResultContextSet 4921 op metaENarrowGen : Module Bound TypeOfNarrowing 4922 ResultContextSet 4923 -> ResultContextSet . 4924 4925 eq metaENarrowGen(M,B,ON,RTS) 4926 = if B == 0 4927 then RTS 4928 else metaENarrowGen*(M,B,ON,empty,empty,RTS) 4929 fi . 4930 4931 op metaENarrowGen* : Module 4932 Bound TypeOfNarrowing 4933 ResultContextSet ResultContextSet ResultContextSet 4934 -> ResultContextSet . 4935 eq metaENarrowGen*(M,B,ON,RTSSol,RTS',empty) 4936 = if RTS' == empty 4937 or-else 4938 (B =/= unbounded and-then B <= 1) 4939 then RTSSol | RTS' --- Stop 4940 else metaENarrowGen*(M,dec(B),ON,RTSSol,empty,RTS') 4941 fi . 4942 eq metaENarrowGen*(M,B,ON,RTSSol,RTS',RT | RTS) 4943 = if isEND(normalize-terms?(M,ON,RT)) 4944 then metaENarrowGen*(M,B,ON, 4945 RTSSol | normalize-terms?(M,ON,RT), 4946 RTS',RTS) 4947 else metaENarrowGen*(M,B,ON,RTSSol, 4948 RTS' | 4949 filter-variant-RT(M,ON,normalize-terms?(M,ON,RT), 4950 metaENarrowGen**(M,B,ON,normalize-terms?(M,ON,RT))), 4951 RTS) 4952 fi . 4953 4954 op testNonVarRedex : TypeOfNarrowing Term Term -> Bool . 4955 eq testNonVarRedex(alsoAtVarPosition ON,T,TS) = true . 4956 eq testNonVarRedex(ON,T,TS) = testNonVarRedex*(ON,T,TS) [owise] . 4957 4958 op testNonVarRedex* : TypeOfNarrowing Term Term -> Bool . 4959 eq testNonVarRedex*(basic ON,T,TS) = not(T :: Variable) . 4960 eq testNonVarRedex*(ON,T,TS) = not(TS :: Variable) [owise] . 4961 4962 op metaENarrowGen** : Module 4963 Bound TypeOfNarrowing 4964 ResultContext 4965 -> ResultContextSet . 4966 eq metaENarrowGen**(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) 4967 = if not testNonVarRedex(ON,T,TS) --- T is a variable 4968 then if CtS == [] 4969 then *** Term CtTS is a normal form so we return it 4970 {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} 4971 else *** Term T is a rigid normal form inside a context Ct 4972 *** but since no rewrite has been done and 4973 *** this can be part of a previous metaNarrowSub call, 4974 *** this path is discarded 4975 empty 4976 fi 4977 else if metaENarrowStra(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) 4978 =/= empty 4979 then metaENarrowStra(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) 4980 else if CtS == [] 4981 then *** Term CtTS is a normal form so we return it 4982 {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,end(true,B:Flags)} 4983 else *** Term T is a rigid normal form inside a context Ct 4984 *** but since no rewrite has been done and 4985 *** this can be part of a previous metaNarrowSub call, 4986 *** this path is discarded 4987 empty 4988 fi 4989 fi 4990 fi . 4991 4992 *** Try all rules at top level of term T in context Ct with metaENarrowRls 4993 *** Try also inner subterms of T with metaENarrowSub 4994 *** Note that metaENarrowRls and metaENarrowSub 4995 *** call to metaNarrow recursively 4996 op metaENarrowStra : Module Bound TypeOfNarrowing ResultContext 4997 -> ResultContextSet . 4998 ---innermost 4999 eq metaENarrowStra(M,B,innermost ON,RT) 5000 = if metaENarrowSub(M,B,innermost ON,RT) =/= empty 5001 then metaENarrowSub(M,B,innermost ON,RT) 5002 else metaENarrowRls(M,B,innermost ON,getRls(M),RT) 5003 fi . 5004 5005 ---outermost 5006 eq metaENarrowStra(M,B,outermost ON,RT) 5007 = if metaENarrowRls(M,B,outermost ON,getRls(M),RT) =/= empty 5008 then metaENarrowRls(M,B,outermost ON,getRls(M),RT) 5009 else metaENarrowSub(M,B,outermost ON,RT) 5010 fi . 5011 5012 ---topmost 5013 eq metaENarrowStra(M,B,topmost ON,RT) 5014 = metaENarrowRls(M,B,topmost ON,getRls(M),RT) . 5015 5016 ---noStrategy 5017 eq metaENarrowStra(M,B,noStrategy ON,RT) 5018 = metaENarrowRls(M,B,noStrategy ON,getRls(M),RT) 5019 | 5020 metaENarrowSub(M,B,noStrategy ON,RT) . 5021 5022 op dec : Bound -> Bound . 5023 eq dec(unbounded) = unbounded . 5024 eq dec(s(N)) = N . 5025 5026 *** Generic call to metaUnification with different parameters 5027 op auxMetaUnify : Module TypeOfNarrowing 5028 Term Term Nat ~> UnificationTripleSet . 5029 --- Term Lhs 5030 eq auxMetaUnify(M,variant(N') ON,T,T',N) 5031 = unrigidife(qid(N'), 5032 auxMetaUnify*(getM(rigidifeNat(M,qid(N'),T,N')), 5033 variant(N') ON, 5034 getTL(rigidifeNat(M,qid(N'),T,N')), 5035 T', 5036 N) 5037 ) . 5038 5039 eq auxMetaUnify(M,ON,T,T',N) 5040 = auxMetaUnify*(M,ON,T,T',N) [owise] . 5041 5042 op auxMetaUnify* : Module TypeOfNarrowing 5043 Term Term Nat ~> UnificationTripleSet . 5044 --- Term Lhs 5045 ceq auxMetaUnify*(M,rigidife(F:Qid) ON,T,T',N) 5046 = unrigidife(Q:Qid, 5047 auxMetaUnify**(M#:Module,rigidife(F:Qid) ON,T#:Term,T',N) 5048 ) 5049 if F:Qid[TL:TermList] := T 5050 /\ Q:Qid := 'auxMetaUnify 5051 /\ X:PairRigidife := rigidifeRigid(M,Q:Qid,T) 5052 /\ M#:Module := getM(X:PairRigidife) 5053 /\ T#:Term := getTL(X:PairRigidife) . 5054 5055 eq auxMetaUnify*(M,ON,T,T',N) 5056 = auxMetaUnify**(M,ON,T,T',N) [owise] . 5057 5058 op auxMetaUnify** : Module TypeOfNarrowing 5059 Term Term Nat ~> UnificationTripleSet . 5060 --- Term Lhs 5061 --- [memo] . --- Very useful but huge space use 5062 eq auxMetaUnify**(M,E-rewriting ON,T,T',N) 5063 = toUnificationTriple[N](metaCoreMatch(removeBoolEqs(M),T,T')) . 5064 eq auxMetaUnify**(M,E-ACU-unify ON,T,T',N) 5065 = metaEACUUnify(removeBoolEqs(M),T,T',getIrrTerms(ON),N,reducible) . 5066 eq auxMetaUnify**(M,E-ACU-unify-Irr ON,T,T',N) 5067 = metaEACUUnify(removeBoolEqs(M),T,T',getIrrTerms(ON),N,irreducible) . 5068 eq auxMetaUnify**(M,E-BuiltIn-unify ON,T,T',N) 5069 = metaEBuiltInUnify(removeBoolEqs(M),T,T',getIrrTerms(ON),N,reducible) . 5070 eq auxMetaUnify**(M,E-BuiltIn-unify-Irr ON,T,T',N) 5071 = metaEBuiltInUnify(removeBoolEqs(M),T,T',getIrrTerms(ON),N,irreducible) . 5072 eq auxMetaUnify**(M,ACU-unify ON,T,T',N) 5073 = metaACUUnify(removeBoolEqs(M),T,T',N) . 5074 eq auxMetaUnify**(M,BuiltIn-unify ON,T,T',N) 5075 = metaBuiltInUnify(removeBoolEqs(M),getIrrTerms(ON),T,T',N) . 5076 5077 *** Remove rigid normal forms 5078 op removeEND : ResultContextSet -> ResultContextSet . 5079 eq removeEND(RTS) 5080 = removeEND*(RTS,empty) . 5081 5082 op removeEND* : ResultContextSet ResultContextSet -> ResultContextSet . 5083 eq removeEND*(empty,RTS') 5084 = RTS' . 5085 eq removeEND*(RT | RTS,RTS') 5086 = removeEND*(RTS,if isEND(RT) then RTS' else RTS' | RT fi) . 5087 5088 op remove_From_ : ResultContextSet ResultContextSet -> ResultContextSet . 5089 eq remove(RT | RTS) From (RT | RTS') 5090 = remove(RTS) From (RT | RTS') . 5091 eq remove(RTS) From (RTS') 5092 = RTS [owise] . 5093 5094 op isEND : ResultContext -> Bool . 5095 eq isEND({T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) 5096 = end(B:Flags) . 5097 5098 *** Call for Rules ---> Returns empty if no rule is applied 5099 op metaENarrowRls : Module Bound TypeOfNarrowing 5100 RuleSet ResultContext 5101 -> ResultContextSet . 5102 eq metaENarrowRls(M,B,ON,RL RLS,RT) 5103 = metaENarrowRls#(M,B,ON,RL RLS,RT,empty) . 5104 eq metaENarrowRls(M,B,ON,none,RT) 5105 = empty . 5106 5107 op metaENarrowRls# : Module Bound TypeOfNarrowing 5108 RuleSet ResultContext ResultContextSet 5109 -> ResultContextSet . 5110 eq metaENarrowRls#(M,B,ON,none,RT,RTS) 5111 = RTS . 5112 eq metaENarrowRls#(M,B,ON,RL RLS,RT,RTS) 5113 = metaENarrowRls#(M,B,ON,RLS,RT, 5114 RTS | 5115 filter-variant-RT(M,ON,RT, 5116 metaENarrowRls*(M,B,ON,RL,RT) 5117 ) 5118 ) . 5119 5120 --- General case 5121 op metaENarrowRls* : Module Bound TypeOfNarrowing 5122 Rule ResultContext 5123 -> ResultContextSet . 5124 eq metaENarrowRls*(M,B,ON, 5125 (rl Lhs => Rhs [Att].), 5126 {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) 5127 = metaENarrowRls**$(M,B,ON, 5128 (rl Lhs => Rhs [Att].), 5129 {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar, 5130 Tr:TraceNarrow {CtTS,none,leastSort(M,CtTS),(rl Lhs => Rhs [Att].)}, 5131 --- Subst none here is key to write the real stuff 5132 --- later in function _<<_ 5133 B:Flags}, 5134 'rl_=>_`[_`].[Lhs,Rhs,'none.AttrSet] <<{none,NextVar}<) . 5135 eq metaENarrowRls*(M,B,ON, X:Rule, X:ResultContext) 5136 = empty [owise] . 5137 5138 op metaENarrowRls**$ : Module Bound TypeOfNarrowing 5139 Rule ResultContext 5140 UnificationPair 5141 -> ResultContextSet . 5142 eq metaENarrowRls**$(M,B,ON, 5143 (rl Lhs => Rhs [Att].), 5144 {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}, 5145 {Subst,NextVar'}) 5146 = metaENarrowRls**$$(M,B,ON, 5147 {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}, 5148 {Subst,NextVar'}, 5149 'rl_=>_`[_`].[Lhs,Rhs,'none.AttrSet] << Subst) . 5150 5151 op metaENarrowRls**$$ : Module Bound TypeOfNarrowing 5152 ResultContext 5153 UnificationPair Term 5154 -> ResultContextSet . 5155 eq metaENarrowRls**$$(M,B,ON, 5156 {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar, 5157 Tr:TraceNarrow {CtTS,none,TP$:Type,(rl Lhs => Rhs [Att].)}, 5158 B:Flags}, 5159 {Subst,NextVar'}, 5160 'rl_=>_`[_`].[Lhs',Rhs','none.AttrSet]) 5161 = metaENarrowRls**$$$(M,B,ON, 5162 {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar, 5163 Tr:TraceNarrow {CtTS,none,TP$:Type,(rl Lhs' => Rhs' [Att].)}, 5164 B:Flags}, 5165 {Subst,NextVar'}, 5166 'rl_=>_`[_`].[Lhs',Rhs','none.AttrSet], 5167 auxMetaUnify(M,ON,TS,Lhs',NextVar')) . 5168 5169 op metaENarrowRls**$$$ : Module Bound TypeOfNarrowing 5170 ResultContext 5171 UnificationPair Term UnificationTripleSet 5172 -> ResultContextSet . 5173 eq metaENarrowRls**$$$(M,B,ON, 5174 {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}, 5175 {Subst,NextVar'}, 5176 'rl_=>_`[_`].[Lhs',Rhs','none.AttrSet],US) 5177 = if US =/= empty 5178 then rebuildTypeAndDiscardErroneous(M,ON, 5179 {Ct[Rhs'], 5180 TP, 5181 S,S', 5182 [], 5183 [], 5184 CtS[Rhs'], 5185 CtS[Rhs'], 5186 NextVar', 5187 Tr:TraceNarrow, 5188 B:Flags} 5189 <<(M,ON) US 5190 ) 5191 else empty 5192 fi . 5193 5194 *** rebuild the context of the applied rule ********************** 5195 op rebuildTypeAndDiscardErroneous : Module TypeOfNarrowing 5196 ResultContextSet -> ResultContextSet . 5197 eq rebuildTypeAndDiscardErroneous(M,ON,empty) 5198 = empty . 5199 eq rebuildTypeAndDiscardErroneous(M,ON,RT | RTS) 5200 = rebuildTypeAndDiscardErroneous*(M,ON,RT) 5201 | rebuildTypeAndDiscardErroneous(M,ON,RTS) . 5202 5203 op rebuildTypeAndDiscardErroneous* : Module TypeOfNarrowing 5204 ResultContext -> ResultContextSet . 5205 eq rebuildTypeAndDiscardErroneous*(M,ON, 5206 {T,TP,S,S',[],[],TS,TS,NextVar,Tr:TraceNarrow,B:Flags}) 5207 = if leastSort(M,TS) :: Type 5208 then normalize-terms?(M,ON, 5209 {canonice(M,T),leastSort(M,TS), 5210 canonice(M,S),canonice(M,S'), 5211 [],[],canonice(M,TS),canonice(M,TS), 5212 NextVar, 5213 canonice(M,Tr:TraceNarrow),B:Flags}) 5214 else empty 5215 fi . 5216 5217 *** auxiliary for variant narrowing ********************** 5218 op _<<`(_`,_`)_ : ResultContext 5219 Module TypeOfNarrowing 5220 UnificationTripleSet -> ResultContextSet . 5221 5222 eq RT <<(M,ON) (empty).UnificationTripleSet 5223 = (empty).ResultContextSet . 5224 5225 eq {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 5226 <<(M,ON) ({Subst,Subst',N} | SS:UnificationTripleSet) 5227 = {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 5228 <<((M,ON)) {Subst,Subst',N} 5229 | 5230 {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 5231 <<(M,ON) SS:UnificationTripleSet . 5232 5233 op _<<`(`(_`,_`)`)_ : ResultContext 5234 Module TypeOfNarrowing 5235 UnificationTriple -> ResultContextSet . 5236 5237 eq {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 5238 <<((M,ON)) {Subst,Subst',N} 5239 = if (variant in ON 5240 and-then 5241 (Subst == none 5242 or-else 5243 (not anyIdSymbol(M,Subst ; Subst') 5244 and-then 5245 normalizedSubstitution?(M,Subst ; Subst')) 5246 or-else 5247 anyIdSymbol(M,Subst ; Subst') 5248 ) 5249 ) 5250 or-else 5251 (computed-normalized-subs in ON 5252 and-then normalizedSubstitution?(M,Subst)) 5253 or-else 5254 (applied-normalized-subs in ON 5255 and-then normalizedSubstitution?(M,Subst')) 5256 or-else 5257 (not variant in ON 5258 and-then 5259 not applied-normalized-subs in ON 5260 and-then 5261 not computed-normalized-subs in ON) 5262 then {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} 5263 << if anyIdSymbol(M,Subst ; Subst') 5264 ---then {normalizeRls(M,Subst),normalizeRls(M,Subst'),N} 5265 then {canonice(M,Subst),canonice(M,Subst'),N} 5266 else {Subst,Subst',N} 5267 fi 5268 else (empty).ResultContextSet 5269 fi . 5270 5271 *** test flag normalize-terms and normalize ********************** 5272 *** !!!! This mustn't be combined with basic -> strange behavior 5273 op normalize-terms? : Module TypeOfNarrowing ResultContext 5274 -> ResultContext . 5275 eq normalize-terms?(M,E-normalize-terms ON, 5276 {T,TP,S,S',[],[],TS,TS,NextVar,Tr:TraceNarrow,B:Flags}) 5277 = {getTerm(metaReduce(M,T)), 5278 getType(metaReduce(M,T)), 5279 S,S',[],[], 5280 getTerm(metaReduce(M,TS)), 5281 getTerm(metaReduce(M,TS)), 5282 NextVar,Tr:TraceNarrow,B:Flags} . 5283 eq normalize-terms?(M,normalize-terms ON, 5284 {T,TP,S,S',[],[],TS,TS,NextVar,Tr:TraceNarrow,B:Flags}) 5285 = {getTerm(metaNormalizeCollect(M,T)), 5286 getType(metaNormalizeCollect(M,T)), 5287 S,S',[],[], 5288 getTerm(metaNormalizeCollect(M,TS)), 5289 getTerm(metaNormalizeCollect(M,TS)), 5290 NextVar,Tr:TraceNarrow,B:Flags} . 5291 eq normalize-terms?(M,ON,RT) 5292 = RT [owise] . 5293 5294 *** Call at inner subterms 5295 op metaENarrowSub : Module Bound TypeOfNarrowing ResultContext 5296 -> ResultContextSet . 5297 eq metaENarrowSub(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) 5298 = metaENarrowSub#(M,B,ON,flatten(M,auxSplitTerm(ON,T,TS)), 5299 {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) . 5300 5301 op auxSplitTerm : TypeOfNarrowing Term Term -> Term . 5302 eq auxSplitTerm(basic ON,T,TS) = T . 5303 eq auxSplitTerm(ON,T,TS) = TS [owise] . 5304 5305 op metaENarrowSub# : Module Bound TypeOfNarrowing Term ResultContext 5306 -> ResultContextSet . 5307 eq metaENarrowSub#(M,B,ON,C,RT) = empty . 5308 eq metaENarrowSub#(M,B,ON,V,RT) = empty . 5309 eq metaENarrowSub#(M,B,ON,F[NeTL],RT) 5310 = metaENarrowSub#Gen(M,B,ON, 5311 splitTerm(M,F, 5312 1,getFrozen(M,F,getTypes(M,NeTL)), 5313 isAssociative(M,F,getTypes(M,NeTL)) 5314 or isCommutative(M,F,getTypes(M,NeTL)), 5315 empty,NeTL,RT)) . 5316 5317 op splitTerm : Module Qid 5318 Nat NeNatList Bool 5319 TermList TermList 5320 ResultContext -> ResultContextSet . 5321 5322 eq splitTerm(M,F, 5323 N,NL,AC?:Bool, 5324 TL',empty, 5325 RT) 5326 = empty . 5327 5328 eq splitTerm(M,F, 5329 N,NL,AC?:Bool, 5330 TL',(T,TL), 5331 {T'',TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) 5332 = if ((not AC?:Bool) and-then N inNatList NL) 5333 or-else 5334 (AC?:Bool and-then NL =/= 0) 5335 then empty 5336 else {T,leastSort(M,T),S,S', 5337 Ct[F[TL',[],TL]], 5338 CtS[F[TL' << (S ; S'),[],TL << (S ; S')]],T << (S ; S'), 5339 CtTS,NextVar,Tr:TraceNarrow,B:Flags} 5340 fi 5341 | splitTerm(M,F, 5342 s(N),NL,AC?:Bool, 5343 (TL',T),TL, 5344 {T'',TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) . 5345 5346 op metaENarrowSub#Gen : Module Bound TypeOfNarrowing ResultContextSet 5347 -> ResultContextSet . 5348 eq metaENarrowSub#Gen(M,B,ON,empty) 5349 = empty . 5350 eq metaENarrowSub#Gen(M,B,ON,RT | RTS) 5351 = metaENarrowGen**(M,B,ON,RT) | metaENarrowSub#Gen(M,B,ON,RTS) . 5352 5353 op filter-variant-RT : Module TypeOfNarrowing ResultContext 5354 ResultContextSet -> ResultContextSet . 5355 eq filter-variant-RT(M,ON, 5356 {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags},RTS) 5357 = if variant in ON and testUnifier !in ON 5358 then filter-variant-RT*(M,Vars(TS),empty,RTS) 5359 else RTS 5360 fi . 5361 5362 op filter-variant-RT* : 5363 Module TermList ResultContextSet ResultContextSet -> ResultContextSet . 5364 eq filter-variant-RT*(M,TL,RTS$,empty) 5365 = RTS$ . 5366 eq filter-variant-RT*(M,TL,RTS$,RT | RTS) 5367 = filter-variant-RT**(M,TL,RTS$,RTS,RT,RTS) . 5368 5369 op filter-variant-RT** : 5370 Module TermList ResultContextSet ResultContextSet 5371 ResultContext ResultContextSet -> ResultContextSet . 5372 eq filter-variant-RT**(M,TL,RTS$,RTS',RT,empty) 5373 = --- RT is not implied by any in RTS' 5374 filter-variant-RT*(M,TL,RTS$ | RT,RTS') . 5375 eq filter-variant-RT**(M,TL,RTS$,RT | RTS',RT',RT | RTS) 5376 = if test-variant-RT(M,TL,RT,RT') 5377 then --- RT' is implied by RT in RTS' 5378 filter-variant-RT*(M,TL,RTS$,RT | RTS') 5379 else if test-variant-RT(M,TL,RT',RT) 5380 then --- remove RT from the set RTS' 5381 filter-variant-RT**(M,TL,RTS$,RTS',RT',RTS) 5382 else --- continue searching in RTS 5383 filter-variant-RT**(M,TL,RTS$,RT | RTS',RT',RTS) 5384 fi 5385 fi . 5386 5387 op test-variant-RT : Module TermList ResultContext ResultContext 5388 -> Bool . 5389 eq test-variant-RT(M,TL, 5390 {T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}, 5391 {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',Tr':TraceNarrow,B':Flags}) 5392 = test-variant-RT*(M,TL,S |> TL,S' |> TL) . 5393 5394 op test-variant-RT* : Module TermList Substitution Substitution -> Bool . 5395 eq test-variant-RT*(M,TL,S,S') 5396 = | S | <= | S' | 5397 and-then 5398 S <=[TL,M] S' . --- keep T & remove T' 5399 5400 op |_| : Substitution -> Nat . 5401 eq | (none).Substitution | = 0 . 5402 eq | V <- T ; S | = s(| S |) . 5403 5404endfm 5405 5406fmod META-NARROWING-SEARCH is 5407 protecting META-E-NARROWING . 5408 protecting META-TERM . 5409 protecting META-LEVEL-MNPA . 5410 protecting META-UNIFICATION . 5411 protecting RESULT-CONTEXT-SET . 5412 protecting ORDERS-TERM-SUBSTITUTION . 5413 5414 var T T' TOrig Lhs Rhs TS TS' CtTS CtTS' : Term . 5415 var V : Variable . 5416 var C : Constant . 5417 var F : Qid . 5418 vars TL TL' : TermList . 5419 var M : Module . 5420 var RTS RTS' RTSSol : ResultContextSet . 5421 var RT RT' : ResultContext . 5422 vars TP TP' : Type . 5423 vars S S' Subst S* S'* : Substitution . 5424 var RLS : RuleSet . 5425 var Att : AttrSet . 5426 var B BN Sol : Bound . 5427 var N : Nat . 5428 var NL : NatList . 5429 vars Ct Ct' CtS CtS' : Context . 5430 var ON : TypeOfNarrowing . 5431 vars QQ QQ' : TypeOfRelation . 5432 vars NextVar NextVar' : Nat . 5433 5434 var SCond : SubstitutionCond . 5435 5436 --- metaNarrowSearch -------------------------------------------------------- 5437 5438 *** Shortcuts to Narrowing Search 5439 op metaNarrowSearch : Module Term Term SubstitutionCond 5440 TypeOfRelation Bound Bound Bound 5441 -> ResultTripleSet . 5442 eq metaNarrowSearch(M,T,T',SCond,QQ,BN,B,Sol) 5443 = if (BN == unbounded and-then Sol =/= unbounded) 5444 or-else 5445 (BN =/= unbounded and-then Sol =/= unbounded and-then BN < Sol) 5446 then metaNarrowSearch*(M,T,T',SCond,QQ,Sol,B,Sol) 5447 else metaNarrowSearch*(M,T,T',SCond,QQ,BN,B,Sol) 5448 fi . 5449 5450 op metaNarrowSearch* : Module Term Term SubstitutionCond 5451 TypeOfRelation Bound Bound Bound 5452 -> ResultTripleSet . 5453 eq metaNarrowSearch*(M,T,T',SCond,QQ,BN,B,Sol) 5454 = metaNarrowSearchGen(M,T,T',SCond,QQ,BN,B,Sol, 5455 full E-BuiltIn-unify noStrategy E-normalize-terms) . 5456 5457 *** Shortcuts to Paramodulation Search 5458 op metaParamodulationSearch : Module Term Term SubstitutionCond 5459 TypeOfRelation Bound Bound Bound 5460 -> ResultTripleSet . 5461 eq metaParamodulationSearch(M,T,T',SCond,QQ,BN,B,Sol) 5462 = if (BN == unbounded and-then Sol =/= unbounded) 5463 or-else 5464 (BN =/= unbounded and-then Sol =/= unbounded and-then BN < Sol) 5465 then metaParamodulationSearch*(M,T,T',SCond,QQ,Sol,B,Sol) 5466 else metaParamodulationSearch*(M,T,T',SCond,QQ,BN,B,Sol) 5467 fi . 5468 5469 op metaParamodulationSearch* : Module Term Term SubstitutionCond 5470 TypeOfRelation Bound Bound Bound 5471 -> ResultTripleSet . 5472 eq metaParamodulationSearch*(M,T,T',SCond,QQ,BN,B,Sol) 5473 = metaNarrowSearchGen(M,T,T',SCond,QQ,BN,B,Sol, 5474 full E-BuiltIn-unify noStrategy E-normalize-terms alsoAtVarPosition) . 5475 5476 *** General Call 5477 op metaNarrowSearchGen : Module Term Term SubstitutionCond 5478 TypeOfRelation 5479 Bound --- number of steps 5480 Bound --- number of solutions 5481 Bound --- chosen solution 5482 TypeOfNarrowing 5483 -> ResultTripleSet . 5484 eq metaNarrowSearchGen(M,T,T',SCond,QQ,B,BN,Sol,ON) 5485 = toTriple(M,metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol,ON)) . 5486 5487 *** Shortcuts to Narrowing Search Path 5488 op metaNarrowSearchPath : Module Term Term SubstitutionCond 5489 TypeOfRelation Bound Bound Bound 5490 -> TraceNarrowSet . 5491 eq metaNarrowSearchPath(M,T,T',SCond,QQ,B,BN,Sol) 5492 = if (BN == unbounded and-then Sol =/= unbounded) 5493 or-else 5494 (BN =/= unbounded and-then Sol =/= unbounded and-then BN < Sol) 5495 then metaNarrowSearchPath*(M,T,T',SCond,QQ,Sol,B,Sol) 5496 else metaNarrowSearchPath*(M,T,T',SCond,QQ,BN,B,Sol) 5497 fi . 5498 5499 op metaNarrowSearchPath* : Module Term Term SubstitutionCond 5500 TypeOfRelation Bound Bound Bound 5501 -> TraceNarrowSet . 5502 eq metaNarrowSearchPath*(M,T,T',SCond,QQ,BN,B,Sol) 5503 = extractTraces( 5504 metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol, 5505 full E-BuiltIn-unify noStrategy E-normalize-terms)) . 5506 5507 op extractTraces : ResultContextSet -> TraceNarrowSet . 5508 eq extractTraces(empty) = empty . 5509 eq extractTraces({T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} | RTS) 5510 = if Tr:TraceNarrow == nil then empty else Tr:TraceNarrow fi 5511 | extractTraces(RTS) . 5512 5513 *** Starting Call 5514 op metaNarrowSearchGenAll : Module Term Term SubstitutionCond 5515 TypeOfRelation Bound Bound Bound TypeOfNarrowing 5516 -> ResultContextSet . 5517 eq metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol,ON) 5518 = metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol,ON,highestVar((T,T')) + 1) . 5519 5520 op metaNarrowSearchGenAll : Module Term Term SubstitutionCond 5521 TypeOfRelation Bound Bound Bound TypeOfNarrowing Nat 5522 -> ResultContextSet . 5523 eq metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol,ON,N) 5524 = metaNarrowSearchAll(addSorts('Universal,M), 5525 T,T',SCond,QQ,B,BN,Sol,ON, 5526 {T,leastSort(M,T),none,none,[],[],T,T,N,nil,empty}) . 5527 5528 *** One Narrowing step in the search process (including possible filters) 5529 op metaNarrowStep : Module SubstitutionCond 5530 ResultContextSet TypeOfNarrowing 5531 -> ResultContextSet . 5532 eq metaNarrowStep(M,SCond,RTS,ON) 5533 = filterSCond(M,SCond,metaENarrowGen(M,1,ON,RTS)) . 5534 5535 *** Filter and normal forms 5536 op filterSCond : Module SubstitutionCond ResultContextSet 5537 -> ResultContextSet . 5538 eq filterSCond(M,none,RTS) 5539 = RTS . 5540 eq filterSCond(M,SCond,RTS) 5541 = filterSCond*(M,SCond,RTS) [owise] . 5542 5543 op filterSCond* : Module SubstitutionCond ResultContextSet 5544 -> ResultContextSet . 5545 eq filterSCond*(M,SCond,empty) 5546 = empty . 5547 eq filterSCond*(M,SCond,RT | RTS) 5548 = filterSCond**(M,SCond,RT) | filterSCond*(M,SCond,RTS) . 5549 5550 op filterSCond** : Module SubstitutionCond ResultContext 5551 -> ResultContextSet . 5552 eq filterSCond**(M,SCond,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) 5553 = if SCond <=[M] S 5554 then {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} 5555 else empty 5556 fi . 5557 5558 *** Generate next successors in a breadth way 5559 --- We reuse the metaNarrowSearchAll function 5560 op metaNarrowSearchAll : Module Term Term SubstitutionCond TypeOfRelation 5561 Bound --- number steps 5562 Bound --- number solutions 5563 Bound --- chosen solution 5564 TypeOfNarrowing 5565 ResultContextSet 5566 -> ResultContextSet . 5567 eq metaNarrowSearchAll(M,TOrig,T',SCond,QQ,B,BN,Sol,ON,RTS) 5568 = if QQ == '+ 5569 then noSelf(RTS, 5570 metaNarrowSearchCheck(M,TOrig,T',SCond,'*,B,BN,Sol,ON,empty,RTS,empty) 5571 ) 5572 else metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,B,BN,Sol,ON,empty,RTS,RTS) 5573 fi . 5574 5575 *** Take only normal forms 5576 op isNF : Module ResultContext -> Bool . 5577 eq isNF(M,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) 5578 = end(B:Flags) or-else metaOneRewriting(M,CtTS) == empty . 5579 5580 *** Take only normal forms 5581 op isVariant : Module Nat ResultContextSet ResultContext -> Bool . 5582 eq isVariant(M,N, 5583 {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',Tr':TraceNarrow,B':Flags} | RTS, 5584 {T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) 5585 = not ( 5586 (S' |> N ; (newVar(N + 1,TP') <- CtTS')) 5587 <=[M] 5588 (S |> N ; (newVar(N + 1,TP) <- CtTS)) 5589 ) 5590 and-then 5591 isVariant(M,N,RTS,{T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) . 5592 eq isVariant(M,N,RTS,RT) 5593 = true [owise] . 5594 5595 5596 *** Generate successors 5597 op oneMoreStep : Module SubstitutionCond TypeOfNarrowing 5598 ResultContextSet -> ResultContextSet [memo] . 5599 eq oneMoreStep(M,SCond,ON,RTS) 5600 = remove metaNarrowStep(M,SCond,removeEND(RTS),ON) From RTS . 5601 5602 *** Check each next successor for conditions 5603 op metaNarrowSearchCheck : Module Term Term SubstitutionCond 5604 TypeOfRelation Bound Bound Bound TypeOfNarrowing 5605 ResultContextSet ResultContextSet ResultContextSet 5606 -> ResultContextSet . 5607 5608 eq metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,B,BN,Sol,ON,RTSSol,RTS',empty) 5609 = if B == 0 or-else BN == 0 or-else Sol == 0 or-else RTS' == empty 5610 then *** Stop the search 5611 RTSSol 5612 else *** Compute Next successors of RTS' with oneMoreStep 5613 metaNarrowSearchCheck(M, 5614 TOrig,T',SCond, 5615 QQ, 5616 dec(B),BN,Sol, 5617 ON, 5618 RTSSol, 5619 oneMoreStep(M,SCond,ON,RTS'), 5620 oneMoreStep(M,SCond,ON,RTS') 5621 ) 5622 fi . 5623 5624 eq metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,B,BN,Sol,ON,RTSSol,RTS', 5625 RT | RTS) 5626 = if isSolution?(M,TOrig,T',QQ,BN,Sol,ON,RTSSol,RT) 5627 and-then 5628 auxMetaUnifyCheck(M,ON,getCTTerm(RT),T',getNextVar(RT)) =/= empty *** Is actual term an instance of T'? 5629 then *** This is a solution 5630 metaNarrowSearchCheck(M,TOrig,T',SCond,QQ, 5631 B,dec(BN),dec(Sol), 5632 ON, 5633 if Sol == unbounded or-else Sol == 1 5634 then rebuildTypeAndDiscardErroneousCheck(M,ON, 5635 RT <<(M,ON) auxMetaUnifyCheck(M,ON,getCTTerm(RT),T',getNextVar(RT))) 5636 else empty 5637 fi 5638 | RTSSol, 5639 RTS',RTS) 5640 else *** Continue with the remaining 5641 metaNarrowSearchCheck(M,TOrig,T',SCond,QQ, 5642 B,BN,Sol,ON,RTSSol,RTS',RTS) 5643 fi . 5644 5645 op auxMetaUnifyCheck : Module TypeOfNarrowing Term Term Nat ~> UnificationTripleSet . 5646 eq auxMetaUnifyCheck(M,ON,T,T',N) = auxMetaUnify(M,ON,T,T',N) . 5647 5648 op rebuildTypeAndDiscardErroneousCheck : Module TypeOfNarrowing ResultContextSet -> ResultContextSet . 5649 eq rebuildTypeAndDiscardErroneousCheck(M,ON,RTS) = rebuildTypeAndDiscardErroneous(M,ON,RTS) . 5650 5651 op isSolution? : Module Term Term 5652 TypeOfRelation Bound Bound TypeOfNarrowing 5653 ResultContextSet ResultContext 5654 -> Bool . 5655 eq isSolution?(M,TOrig,T',QQ,BN,Sol,ON,RTSSol,RT) 5656 = *** Is this the chosen solution? 5657 (BN == unbounded or-else BN > 0) 5658 and-then 5659 *** Is this step correct wrt relations <'!,'*,'+> ? 5660 ( QQ == '* or-else (QQ == '! and-then isEND(RT)) ) 5661 and-then 5662 *** Is this a valid variant solution? 5663 (not (variant in ON) or-else 5664 (isNF(M,RT) and-then isVariant(M,highestVar(TOrig) + 1,RTSSol,RT))) . 5665 5666 op upDown : Module ResultTripleSet -> ResultTripleSet . 5667 eq upDown(M,RTS:ResultTripleSet) 5668 = upDown#(M,empty,RTS:ResultTripleSet) . 5669 op upDown# : Module ResultTripleSet ResultTripleSet -> ResultTripleSet . 5670 eq upDown#(M,RTS':ResultTripleSet, empty) 5671 = RTS':ResultTripleSet . 5672 eq upDown#(M,RTS':ResultTripleSet, {T,TP,S} | RTS:ResultTripleSet) 5673 = upDown#(M,{getTerm(metaReduce(M,T)),TP,upDown(M,S)} 5674 | RTS':ResultTripleSet,RTS:ResultTripleSet) . 5675 5676 op upDown : Module Substitution -> Substitution . 5677 eq upDown(M,S:Substitution) 5678 = upDown#(M,none,S:Substitution) . 5679 op upDown# : Module Substitution Substitution -> Substitution . 5680 eq upDown#(M,S':Substitution,none) 5681 = S':Substitution . 5682 eq upDown#(M,S':Substitution,V <- T ; S:Substitution) 5683 = upDown#(M,S':Substitution ; V <- getTerm(metaReduce(M,T)),S:Substitution) . 5684 5685endfm 5686************************************* 5687****** End of Santiago Escobar's code 5688******************************************************************************* 5689******************************************************************************* 5690 5691fmod 2TUPLE{X :: TRIV, Y :: TRIV} is 5692 sorts Tuple{X, Y} . 5693 op ((_,_)) : X$Elt Y$Elt -> Tuple{X, Y} . 5694 op p1_ : Tuple{X, Y} -> X$Elt . 5695 op p2_ : Tuple{X, Y} -> Y$Elt . 5696 eq p1(V1:[X$Elt],V2:[Y$Elt]) = V1:[X$Elt] . 5697 eq p2(V1:[X$Elt],V2:[Y$Elt]) = V2:[Y$Elt] . 5698endfm 5699 5700fmod 3TUPLE{X :: TRIV, Y :: TRIV, Z :: TRIV} is 5701 sort Tuple{X, Y, Z} . 5702 op ((_,_,_)) : X$Elt Y$Elt Z$Elt -> Tuple{X, Y, Z} . 5703 op p1_ : Tuple{X, Y, Z} -> X$Elt . 5704 op p2_ : Tuple{X, Y, Z} -> Y$Elt . 5705 op p3_ : Tuple{X, Y, Z} -> Z$Elt . 5706 eq p1((A:[X$Elt], B:[Y$Elt], C:[Z$Elt])) = A:[X$Elt] . 5707 eq p2((A:[X$Elt], B:[Y$Elt], C:[Z$Elt])) = B:[Y$Elt] . 5708 eq p3((A:[X$Elt], B:[Y$Elt], C:[Z$Elt])) = C:[Z$Elt] . 5709endfm 5710 5711fmod 4TUPLE{W :: TRIV, X :: TRIV, Y :: TRIV, Z :: TRIV} is 5712 sort Tuple{W, X, Y, Z} . 5713 op ((_,_,_,_)) : W$Elt X$Elt Y$Elt Z$Elt -> Tuple{W, X, Y, Z} . 5714 op p1_ : Tuple{W, X, Y, Z} -> W$Elt . 5715 op p2_ : Tuple{W, X, Y, Z} -> X$Elt . 5716 op p3_ : Tuple{W, X, Y, Z} -> Y$Elt . 5717 op p4_ : Tuple{W, X, Y, Z} -> Z$Elt . 5718 eq p1((A:[W$Elt], B:[X$Elt], C:[Y$Elt], D:[Z$Elt])) = A:[W$Elt] . 5719 eq p2((A:[W$Elt], B:[X$Elt], C:[Y$Elt], D:[Z$Elt])) = B:[X$Elt] . 5720 eq p3((A:[W$Elt], B:[X$Elt], C:[Y$Elt], D:[Z$Elt])) = C:[Y$Elt] . 5721 eq p4((A:[W$Elt], B:[X$Elt], C:[Y$Elt], D:[Z$Elt])) = D:[Z$Elt] . 5722endfm 5723 5724fmod 5TUPLE{V :: TRIV, W :: TRIV, X :: TRIV, Y :: TRIV, Z :: TRIV} is 5725 sort Tuple{V, W, X, Y, Z} . 5726 op ((_,_,_,_,_)) : V$Elt W$Elt X$Elt Y$Elt Z$Elt -> Tuple{V, W, X, Y, Z} . 5727 op p1_ : Tuple{V, W, X, Y, Z} -> V$Elt . 5728 op p2_ : Tuple{V, W, X, Y, Z} -> W$Elt . 5729 op p3_ : Tuple{V, W, X, Y, Z} -> X$Elt . 5730 op p4_ : Tuple{V, W, X, Y, Z} -> Y$Elt . 5731 op p5_ : Tuple{V, W, X, Y, Z} -> Z$Elt . 5732 eq p1((A:[V$Elt], B:[W$Elt], C:[X$Elt], D:[Y$Elt], E:[Z$Elt])) = A:[V$Elt] . 5733 eq p2((A:[V$Elt], B:[W$Elt], C:[X$Elt], D:[Y$Elt], E:[Z$Elt])) = B:[W$Elt] . 5734 eq p3((A:[V$Elt], B:[W$Elt], C:[X$Elt], D:[Y$Elt], E:[Z$Elt])) = C:[X$Elt] . 5735 eq p4((A:[V$Elt], B:[W$Elt], C:[X$Elt], D:[Y$Elt], E:[Z$Elt])) = D:[Y$Elt] . 5736 eq p5((A:[V$Elt], B:[W$Elt], C:[X$Elt], D:[Y$Elt], E:[Z$Elt])) = E:[Z$Elt] . 5737endfm 5738 5739fmod 6TUPLE{U :: TRIV, V :: TRIV, W :: TRIV, X :: TRIV, Y :: TRIV, Z :: TRIV} is 5740 sort Tuple{U, V, W, X, Y, Z} . 5741 op ((_,_,_,_,_,_)) : U$Elt V$Elt W$Elt X$Elt Y$Elt Z$Elt -> Tuple{U, V, W, X, Y, Z} . 5742 op p1_ : Tuple{U, V, W, X, Y, Z} -> U$Elt . 5743 op p2_ : Tuple{U, V, W, X, Y, Z} -> V$Elt . 5744 op p3_ : Tuple{U, V, W, X, Y, Z} -> W$Elt . 5745 op p4_ : Tuple{U, V, W, X, Y, Z} -> X$Elt . 5746 op p5_ : Tuple{U, V, W, X, Y, Z} -> Y$Elt . 5747 op p6_ : Tuple{U, V, W, X, Y, Z} -> Z$Elt . 5748 eq p1((A:[U$Elt], B:[V$Elt], C:[W$Elt], D:[X$Elt], E:[Y$Elt], F:[Z$Elt])) = A:[U$Elt] . 5749 eq p2((A:[U$Elt], B:[V$Elt], C:[W$Elt], D:[X$Elt], E:[Y$Elt], F:[Z$Elt])) = B:[V$Elt] . 5750 eq p3((A:[U$Elt], B:[V$Elt], C:[W$Elt], D:[X$Elt], E:[Y$Elt], F:[Z$Elt])) = C:[W$Elt] . 5751 eq p4((A:[U$Elt], B:[V$Elt], C:[W$Elt], D:[X$Elt], E:[Y$Elt], F:[Z$Elt])) = D:[X$Elt] . 5752 eq p5((A:[U$Elt], B:[V$Elt], C:[W$Elt], D:[X$Elt], E:[Y$Elt], F:[Z$Elt])) = E:[Y$Elt] . 5753 eq p6((A:[U$Elt], B:[V$Elt], C:[W$Elt], D:[X$Elt], E:[Y$Elt], F:[Z$Elt])) = F:[Z$Elt] . 5754endfm 5755 5756view QidList from TRIV to QID-LIST is 5757 sort Elt to QidList . 5758endv 5759 5760view TermList from TRIV to META-MODULE is 5761 sort Elt to TermList . 5762endv 5763 5764view RuleSet from TRIV to META-MODULE is 5765 sort Elt to RuleSet . 5766endv 5767 5768view EquationSet from TRIV to META-MODULE is 5769 sort Elt to EquationSet . 5770endv 5771 5772view OpDeclSet from TRIV to META-MODULE is 5773 sort Elt to OpDeclSet . 5774endv 5775 5776view ImportList from TRIV to META-MODULE is 5777 sort Elt to ImportList . 5778endv 5779 5780view Condition from TRIV to META-MODULE is 5781 sort Elt to Condition . 5782endv 5783 5784view QidSet from TRIV to META-MODULE is 5785 sort Elt to QidSet . 5786endv 5787 5788view Module from TRIV to META-MODULE is 5789 sort Elt to Module . 5790endv 5791 5792view ParameterDeclList from TRIV to META-MODULE is 5793 sort Elt to ParameterDeclList . 5794endv 5795 5796view Bound from TRIV to META-LEVEL is 5797 sort Elt to Bound . 5798endv 5799 5800view Oid from TRIV to CONFIGURATION is 5801 sort Elt to Oid . 5802endv 5803 5804------------------------------------------------------------------------------- 5805******************************************************************************* 5806*** 5807*** 2 The Signature of Full Maude 5808*** 5809******************************************************************************* 5810------------------------------------------------------------------------------- 5811 5812fmod EXTENDED-SORTS is 5813 ---- Any modification in this module must be reflected in the metamodule 5814 ---- used in eq addInfoConds in module UNIT-BUBBLE-PARSING 5815 sorts @SortToken@ @ViewToken@ @Sort@ @Kind@ @Type@ @SortList@ 5816 @TypeList@ @ViewExp@ @ModExp@ . 5817 5818 subsorts @SortToken@ < @Sort@ < @SortList@ < @TypeList@ . 5819 subsorts @Sort@ @Kind@ < @Type@ < @TypeList@ . 5820 subsort @ViewToken@ < @ViewExp@ . 5821 5822 op _`{_`} : @Sort@ @ViewExp@ -> @Sort@ [prec 40] . 5823 op __ : @SortList@ @SortList@ -> @SortList@ [assoc] . 5824 op __ : @TypeList@ @TypeList@ -> @TypeList@ [assoc] . 5825 op `[_`] : @Sort@ -> @Kind@ . 5826 5827 op _`,_ : @ViewExp@ @ViewExp@ -> @ViewExp@ [assoc] . 5828 op _`{_`} : @ViewExp@ @ViewExp@ -> @ViewExp@ [prec 40] . 5829endfm 5830 5831------------------------------------------------------------------------------- 5832****************************************************************************** 5833------------------------------------------------------------------------------- 5834 5835fmod OPERATOR-ATTRIBUTES is 5836 sorts @Attr@ @AttrList@ @Hook@ @HookList@ @Bubble@ @Token@ @NeTokenList@ . 5837 subsort @Attr@ < @AttrList@ . 5838 subsort @Hook@ < @HookList@ . 5839 5840 op __ : @AttrList@ @AttrList@ -> @AttrList@ [assoc] . 5841 ops assoc associative : -> @Attr@ . 5842 ops comm commutative : -> @Attr@ . 5843 ops idem idempotent : -> @Attr@ . 5844 ops id:_ identity:_ : @Bubble@ -> @Attr@ . 5845 ops left`id:_ left`identity:_ : @Bubble@ -> @Attr@ . 5846 ops right`id:_ right`identity:_ : @Bubble@ -> @Attr@ . 5847 ops frozen`(_`) poly`(_`) strat`(_`) strategy`(_`) : 5848 @NeTokenList@ -> @AttrList@ . 5849 ops memo memoization : -> @Attr@ . 5850 ops prec_ precedence_ : @Token@ -> @Attr@ . 5851 ops gather`(_`) gathering`(_`) : @NeTokenList@ -> @Attr@ . 5852 ops format`(_`) : @NeTokenList@ -> @Attr@ . 5853 ops ctor constructor : -> @Attr@ . 5854 ops frozen ditto iter : -> @Attr@ . 5855 ops object msg message config : -> @Attr@ . 5856 op metadata_ : @Token@ -> @Attr@ . 5857 5858 op special`(_`) : @HookList@ -> @Attr@ . 5859 op __ : @HookList@ @HookList@ -> @HookList@ [assoc] . 5860 op id-hook_ : @Token@ -> @Hook@ . 5861 op id-hook_`(_`) : @Token@ @NeTokenList@ -> @Hook@ . 5862 op op-hook_`(_:_->_`) : @Token@ @Token@ @NeTokenList@ @Token@ -> @Hook@ . 5863 op op-hook_`(_:`->_`) : @Token@ @Token@ @Token@ -> @Hook@ . 5864 op op-hook_`(_:_~>_`) : @Token@ @Token@ @NeTokenList@ @Token@ -> @Hook@ . 5865 op op-hook_`(_:`~>_`) : @Token@ @Token@ @Token@ -> @Hook@ . 5866 op term-hook_`(_`) : @Token@ @Bubble@ -> @Hook@ . 5867endfm 5868 5869------------------------------------------------------------------------------- 5870******************************************************************************* 5871------------------------------------------------------------------------------- 5872 5873fmod FM-MOD-EXPRS is 5874 including OPERATOR-ATTRIBUTES . 5875 including EXTENDED-SORTS . 5876 5877 sorts @Map@ @MapList@ . 5878 subsort @Map@ < @MapList@ . 5879 subsorts @Token@ < @ModExp@ . 5880 5881 *** module expression 5882 op _*`(_`) : @ModExp@ @MapList@ -> @ModExp@ . 5883 op _`{_`} : @ModExp@ @ViewExp@ -> @ModExp@ . 5884 op TUPLE`[_`] : @Token@ -> @ModExp@ . 5885 op POWER`[_`] : @Token@ -> @ModExp@ . 5886 op _+_ : @ModExp@ @ModExp@ -> @ModExp@ [assoc prec 42] . 5887 5888 *** renaming maps 5889 op op_to_ : @Token@ @Token@ -> @Map@ . 5890 op op_:_->_to_ : @Token@ @TypeList@ @Type@ @Token@ -> @Map@ . 5891 op op_: ->_to_ : @Token@ @Type@ @Token@ -> @Map@ . 5892 op op_:_~>_to_ : @Token@ @TypeList@ @Type@ @Token@ -> @Map@ . 5893 op op_: ~>_to_ : @Token@ @Type@ @Token@ -> @Map@ . 5894 op op_to_`[_`] : @Token@ @Token@ @AttrList@ -> @Map@ . 5895 op op_:_->_to_`[_`] : @Token@ @TypeList@ @Type@ @Token@ @AttrList@ -> @Map@ . 5896 op op_:`->_to_`[_`] : @Token@ @Type@ @Token@ @AttrList@ -> @Map@ . 5897 op op_:_~>_to_`[_`] : @Token@ @TypeList@ @Type@ @Token@ @AttrList@ -> @Map@ . 5898 op op_:`~>_to_`[_`] : @Token@ @Type@ @Token@ @AttrList@ -> @Map@ . 5899 op sort_to_ : @Sort@ @Sort@ -> @Map@ . 5900 op label_to_ : @Token@ @Token@ -> @Map@ . 5901 op class_to_ : @Sort@ @Sort@ -> @Map@ . 5902 op attr_._to_ : @Sort@ @Token@ @Token@ -> @Map@ . 5903 op msg_to_ : @Token@ @Token@ -> @Map@ . 5904 op msg_:_->_to_ : @Token@ @TypeList@ @Type@ @Token@ -> @Map@ . 5905 op msg_:`->_to_ : @Token@ @Type@ @Token@ -> @Map@ . 5906 5907 op _`,_ : @MapList@ @MapList@ -> @MapList@ [assoc prec 42] . 5908endfm 5909 5910------------------------------------------------------------------------------- 5911******************************************************************************* 5912------------------------------------------------------------------------------- 5913 5914fmod SIGNATURES is 5915 inc FM-MOD-EXPRS . 5916 5917 sorts @SortDecl@ @SubsortRel@ @SubsortDecl@ @OpDecl@ . 5918 5919 op `(_`) : @Token@ -> @Token@ . 5920 5921 *** sort declaration 5922 op sorts_. : @SortList@ -> @SortDecl@ . 5923 op sort_. : @SortList@ -> @SortDecl@ . 5924 5925 *** subsort declaration 5926 op subsort_. : @SubsortRel@ -> @SubsortDecl@ . 5927 op subsorts_. : @SubsortRel@ -> @SubsortDecl@ . 5928 op _<_ : @SortList@ @SortList@ -> @SubsortRel@ . 5929 op _<_ : @SortList@ @SubsortRel@ -> @SubsortRel@ . 5930 5931 *** operator declaration 5932 op op_:`->_. : @Token@ @Type@ -> @OpDecl@ . 5933 op op_:`->_`[_`]. : @Token@ @Type@ @AttrList@ -> @OpDecl@ . 5934 op op_:_->_. : @Token@ @TypeList@ @Type@ -> @OpDecl@ . 5935 op op_:_->_`[_`]. : @Token@ @TypeList@ @Type@ @AttrList@ -> @OpDecl@ . 5936 op ops_:`->_. : @NeTokenList@ @Type@ -> @OpDecl@ . 5937 op ops_:`->_`[_`]. : @NeTokenList@ @Type@ @AttrList@ -> @OpDecl@ . 5938 op ops_:_->_. : @NeTokenList@ @TypeList@ @Type@ -> @OpDecl@ . 5939 op ops_:_->_`[_`]. : @NeTokenList@ @TypeList@ @Type@ @AttrList@ -> @OpDecl@ . 5940 5941 op op_:`~>_. : @Token@ @Sort@ -> @OpDecl@ . 5942 op op_:`~>_`[_`]. : @Token@ @Sort@ @AttrList@ -> @OpDecl@ . 5943 op op_:_~>_. : @Token@ @TypeList@ @Sort@ -> @OpDecl@ . 5944 op op_:_~>_`[_`]. : @Token@ @TypeList@ @Sort@ @AttrList@ -> @OpDecl@ . 5945 op ops_:`~>_. : @NeTokenList@ @Sort@ -> @OpDecl@ . 5946 op ops_:`~>_`[_`]. : @NeTokenList@ @Sort@ @AttrList@ -> @OpDecl@ . 5947 op ops_:_~>_. : @NeTokenList@ @TypeList@ @Sort@ -> @OpDecl@ . 5948 op ops_:_~>_`[_`]. : @NeTokenList@ @TypeList@ @Sort@ @AttrList@ -> @OpDecl@ . 5949endfm 5950 5951------------------------------------------------------------------------------- 5952******************************************************************************* 5953------------------------------------------------------------------------------- 5954 5955fmod F&S-MODS&THS is 5956 including SIGNATURES . 5957 including QID-LIST . 5958 5959 sorts @FDeclList@ @SDeclList@ @Module@ @ImportDecl@ @Parameter@ 5960 @List<Parameter>@ @EqDecl@ @RlDecl@ @MbDecl@ @VarDecl@ @VarDeclList@ . 5961 5962 subsort @VarDecl@ < @VarDeclList@ . 5963 subsorts @VarDecl@ @ImportDecl@ @SortDecl@ @SubsortDecl@ @OpDecl@ @MbDecl@ 5964 @EqDecl@ @VarDeclList@ < @FDeclList@ . 5965 subsorts @RlDecl@ @FDeclList@ < @SDeclList@ . 5966 5967 *** variable declaration 5968 op vars_:_. : @NeTokenList@ @Type@ -> @VarDecl@ . 5969 op var_:_. : @NeTokenList@ @Type@ -> @VarDecl@ . 5970 5971 *** membership axiom declaration 5972 op mb_:_. : @Bubble@ @Bubble@ -> @MbDecl@ . 5973 ----op mb[_]:_:_. : @Token@ @Bubble@ @Bubble@ -> @MbDecl@ . 5974 op cmb_:_if_. : @Bubble@ @Sort@ @Bubble@ -> @MbDecl@ . 5975 op cmb[_]:_:_if_. : @Token@ @Bubble@ @Sort@ @Bubble@ -> @MbDecl@ . 5976 5977 *** equation declaration 5978 op eq_=_. : @Bubble@ @Bubble@ -> @EqDecl@ . 5979 op ceq_=_if_. : @Bubble@ @Bubble@ @Bubble@ -> @EqDecl@ . 5980 op cq_=_if_. : @Bubble@ @Bubble@ @Bubble@ -> @EqDecl@ . 5981 5982 *** rule declaration 5983 *** op rl`[_`]:_=>_. : @Token@ @Bubble@ @Bubble@ -> @RlDecl@ . 5984 op rl_=>_. : @Bubble@ @Bubble@ -> @RlDecl@ . 5985 *** op crl`[_`]:_=>_if_. : @Token@ @Bubble@ @Bubble@ @Bubble@ -> @RlDecl@ . 5986 op crl_=>_if_. : @Bubble@ @Bubble@ @Bubble@ -> @RlDecl@ . 5987 5988 *** importation declaration 5989 ops including_. inc_. : @ModExp@ -> @ImportDecl@ . 5990 ops extending_. ex_. : @ModExp@ -> @ImportDecl@ . 5991 ops protecting_. pr_. : @ModExp@ -> @ImportDecl@ . 5992 5993 sorts @Interface@ . 5994 subsort @Parameter@ < @List<Parameter>@ . 5995 subsorts @Token@ < @Interface@ . 5996 5997 *** parameterized module interface 5998 op _::_ : @Token@ @ModExp@ -> @Parameter@ [prec 40 gather (e &)] . 5999 op _::_ : @Token@ @Interface@ -> @Parameter@ [prec 40 gather (e &)] . 6000 6001 op _`,_ : @List<Parameter>@ @List<Parameter>@ -> @List<Parameter>@ [assoc] . 6002 6003 op _`{_`} : @ModExp@ @List<Parameter>@ -> @Interface@ . 6004 6005 *** declaration list 6006 op __ : @VarDeclList@ @VarDeclList@ -> @VarDeclList@ [assoc] . 6007 op __ : @SDeclList@ @SDeclList@ -> @SDeclList@ [assoc] . 6008 op __ : @FDeclList@ @FDeclList@ -> @FDeclList@ [assoc] . 6009 6010 *** functional and system module and theory 6011 op fmod_is_endfm : @Interface@ @FDeclList@ -> @Module@ . 6012 op obj_is_jbo : @Interface@ @FDeclList@ -> @Module@ . 6013 op obj_is_endo : @Interface@ @FDeclList@ -> @Module@ . 6014 op mod_is_endm : @Interface@ @SDeclList@ -> @Module@ . 6015 op fth_is_endfth : @Interface@ @FDeclList@ -> @Module@ . 6016 op th_is_endth : @Interface@ @SDeclList@ -> @Module@ . 6017endfm 6018 6019------------------------------------------------------------------------------- 6020******************************************************************************* 6021------------------------------------------------------------------------------- 6022 6023fmod O-MODS&THS is 6024 including F&S-MODS&THS . 6025 6026 sorts @ClassDecl@ @AttrDecl@ @AttrDeclList@ @SubclassDecl@ @MsgDecl@ 6027 @ODeclList@ . 6028 subsorts @SDeclList@ @MsgDecl@ @SubclassDecl@ @ClassDecl@ < @ODeclList@ . 6029 subsort @AttrDecl@ < @AttrDeclList@ . 6030 6031 op __ : @ODeclList@ @ODeclList@ -> @ODeclList@ [assoc] . 6032 6033 *** object-oriented module and theory 6034 op omod_is_endom : @Interface@ @ODeclList@ -> @Module@ . 6035 op oth_is_endoth : @Interface@ @ODeclList@ -> @Module@ . 6036 6037 *** class declaration 6038 op class_|_. : @Sort@ @AttrDeclList@ -> @ClassDecl@ . 6039 op class_|`. : @Sort@ -> @ClassDecl@ . 6040 op class_. : @Sort@ -> @ClassDecl@ . 6041 op _`,_ : @AttrDeclList@ @AttrDeclList@ -> @AttrDeclList@ [assoc] . 6042 op _:_ : @Token@ @Sort@ -> @AttrDecl@ [prec 40] . 6043 6044 *** subclass declaration 6045 op subclass_. : @SubsortRel@ -> @SubclassDecl@ . 6046 op subclasses_. : @SubsortRel@ -> @SubclassDecl@ . 6047 6048 *** message declaration 6049 op msg_:_->_. : @Token@ @SortList@ @Sort@ -> @MsgDecl@ . 6050 op msgs_:_->_. : @NeTokenList@ @SortList@ @Sort@ -> @MsgDecl@ . 6051 op msg_:`->_. : @Token@ @Sort@ -> @MsgDecl@ . 6052 op msgs_:`->_. : @NeTokenList@ @Sort@ -> @MsgDecl@ . 6053endfm 6054 6055------------------------------------------------------------------------------- 6056******************************************************************************* 6057------------------------------------------------------------------------------- 6058 6059fmod VIEWS is 6060 including O-MODS&THS . 6061 6062 sorts @ViewDecl@ @ViewDeclList@ @View@ . 6063 subsorts @VarDecl@ < @ViewDecl@ < @ViewDeclList@ . 6064 subsort @VarDeclList@ < @ViewDeclList@ . 6065 6066 *** view maps 6067 op op_to`term_. : @Bubble@ @Bubble@ -> @ViewDecl@ . 6068 op op_to_. : @Token@ @Token@ -> @ViewDecl@ . 6069 op op_:_->_to_. : @Token@ @TypeList@ @Type@ @Token@ -> @ViewDecl@ . 6070 op op_:`->_to_. : @Token@ @Type@ @Token@ -> @ViewDecl@ . 6071 op op_:_~>_to_. : @Token@ @TypeList@ @Type@ @Token@ -> @ViewDecl@ . 6072 op op_:`~>_to_. : @Token@ @Type@ @Token@ -> @ViewDecl@ . 6073 op sort_to_. : @Sort@ @Sort@ -> @ViewDecl@ . 6074 op class_to_. : @Sort@ @Sort@ -> @ViewDecl@ . 6075 op attr_._to_. : @Sort@ @Token@ @Token@ -> @ViewDecl@ . 6076 op msg_to_. : @Token@ @Token@ -> @ViewDecl@ . 6077 op msg_:_->_to_. : @Token@ @TypeList@ @Type@ @Token@ -> @ViewDecl@ . 6078 op msg_:`->_to_. : @Token@ @Type@ @Token@ -> @ViewDecl@ . 6079 6080 *** view 6081 op view_from_to_is_endv : @Interface@ @ModExp@ @ModExp@ @ViewDeclList@ -> @View@ . 6082 op view_from_to_is endv : @Interface@ @ModExp@ @ModExp@ -> @View@ . 6083 op __ : @ViewDeclList@ @ViewDeclList@ -> @ViewDeclList@ [assoc] . 6084endfm 6085 6086------------------------------------------------------------------------------- 6087******************************************************************************* 6088------------------------------------------------------------------------------- 6089 6090fmod COMMANDS is 6091 including FM-MOD-EXPRS . 6092 6093 sorts @Command@ . 6094 6095 *** down function 6096 op down_:_ : @ModExp@ @Command@ -> @Command@ . 6097 6098 *** parse commands 6099 op parse_. : @Bubble@ -> @Command@ . 6100 6101 *** reduce commands 6102 op red_. : @Bubble@ -> @Command@ . 6103 op reduce_. : @Bubble@ -> @Command@ . 6104 6105 *** rewrite commands 6106 op rew_. : @Bubble@ -> @Command@ . 6107 op rewrite_. : @Bubble@ -> @Command@ . 6108 6109 *** frewrite commands 6110 op frew_. : @Bubble@ -> @Command@ . 6111 op frewrite_. : @Bubble@ -> @Command@ . 6112 6113 *** search commands 6114 op search_=>1_. : @Bubble@ @Bubble@ -> @Command@ . 6115 op search_=>*_. : @Bubble@ @Bubble@ -> @Command@ . 6116 op search_=>+_. : @Bubble@ @Bubble@ -> @Command@ . 6117 op search_=>!_. : @Bubble@ @Bubble@ -> @Command@ . 6118 6119 *** search commands 6120 op search_~>1_. : @Bubble@ @Bubble@ -> @Command@ . 6121 op search_~>*_. : @Bubble@ @Bubble@ -> @Command@ . 6122 op search_~>+_. : @Bubble@ @Bubble@ -> @Command@ . 6123 op search_~>!_. : @Bubble@ @Bubble@ -> @Command@ . 6124 6125 *** matching commands 6126 op match_<=?_. : @Bubble@ @Bubble@ -> @Command@ . 6127 op xmatch_<=?_. : @Bubble@ @Bubble@ -> @Command@ . 6128 6129 *** unifying command 6130 op unify_. : @Bubble@ -> @Command@ . 6131 6132 *** unifying command 6133 op id-unify_. : @Bubble@ -> @Command@ . 6134 6135 *** unifying command 6136 op variant`unify_. : @Bubble@ -> @Command@ . 6137 6138 *** unifying command 6139 op asymmetric`variant`unify_. : @Bubble@ -> @Command@ . 6140 6141 *** unifying command 6142 op get`variants_. : @Bubble@ -> @Command@ . 6143 6144 *** select command 6145 op select_. : @ModExp@ -> @Command@ . 6146 6147 *** show commands 6148 op show`module`. : -> @Command@ . 6149 op show`module_. : @ModExp@ -> @Command@ . 6150 op show`all`. : -> @Command@ . 6151 op show`all_. : @ModExp@ -> @Command@ . 6152 op show`vars`. : -> @Command@ . 6153 op show`vars_. : @ModExp@ -> @Command@ . 6154 op show`sorts`. : -> @Command@ . 6155 op show`sorts_. : @ModExp@ -> @Command@ . 6156 op show`ops`. : -> @Command@ . 6157 op show`ops_. : @ModExp@ -> @Command@ . 6158 op show`mbs`. : -> @Command@ . 6159 op show`mbs_. : @ModExp@ -> @Command@ . 6160 op show`eqs`. : -> @Command@ . 6161 op show`eqs_. : @ModExp@ -> @Command@ . 6162 op show`rls`. : -> @Command@ . 6163 op show`rls_. : @ModExp@ -> @Command@ . 6164 op show`view_. : @ViewExp@ -> @Command@ . 6165 op show`modules`. : -> @Command@ . 6166 op show`views`. : -> @Command@ . 6167 6168 *** set commands 6169 op set`protect_on`. : @ModExp@ -> @Command@ . 6170 op set`protect_off`. : @ModExp@ -> @Command@ . 6171 op set`include_on`. : @ModExp@ -> @Command@ . 6172 op set`include_off`. : @ModExp@ -> @Command@ . 6173 op set`extend_on`. : @ModExp@ -> @Command@ . 6174 op set`extend_off`. : @ModExp@ -> @Command@ . 6175 6176 *** miscellaneous 6177 op load_. : @Bubble@ -> @Command@ . 6178 ops remove`identity`attributes`. rm`ids`. : -> @Command@ . 6179 ops remove`identity`attributes_. rm`ids_. : @ModExp@ -> @Command@ . 6180 op remove`assoc`attributes`. : -> @Command@ . 6181 op remove`assoc`attributes_. : @ModExp@ -> @Command@ . 6182 op ax`coherence`completion`. : -> @Command@ . 6183 op ax`coherence`completion_. : @ModExp@ -> @Command@ . 6184 op help`. : -> @Command@ . 6185endfm 6186 6187------------------------------------------------------------------------------- 6188******************************************************************************* 6189------------------------------------------------------------------------------- 6190 6191fmod FULL-MAUDE-SIGN is 6192 including VIEWS . 6193 including COMMANDS . 6194 6195 sort @Input@ . 6196 subsorts @Command@ @Module@ @View@ < @Input@ . 6197endfm 6198 6199------------------------------------------------------------------------------- 6200******************************************************************************* 6201------------------------------------------------------------------------------- 6202 6203 6204******* 6205******* ERROR HANDLING, by Peter Olveczky 6206******* 6207 6208*** The following module defines a function which prints up to n characters 6209*** of a bubble, followed by the usual arrow <---*HERE* which points to the 6210*** erroneous token: 6211 6212------------------------------------------------------------------------------- 6213******************************************************************************* 6214------------------------------------------------------------------------------- 6215 6216fmod PRINT-SYNTAX-ERROR is 6217--- protecting META-LEVEL + PRE-VARIANT . 6218 protecting META-LEVEL . 6219 protecting INT . 6220 6221 var QIL : QidList . 6222 var Q : Qid . 6223 var N : Nat . 6224 vars RP RP' : ResultPair . 6225 var RP? : [ResultPair?] . 6226 6227 op printN : Nat QidList -> QidList . *** first N qid's in a qidList 6228 eq printN(N, nil) = nil . 6229 eq printN(0, QIL) = nil . 6230 eq printN(s N, Q QIL) = Q printN(N, QIL) . 6231 6232 op removeFront : Nat QidList -> QidList . *** removes first N qid's 6233 eq removeFront(N, nil) = nil . 6234 eq removeFront(0, QIL) = QIL . 6235 eq removeFront(s N, Q QIL) = removeFront(N, QIL) . 6236 6237 op printSyntaxError : [ResultPair?] QidList -> QidList . 6238 eq printSyntaxError(noParse(N), QIL) 6239 = '\r 'Parse 'error 'in '\o '\s printN(N + 1, QIL) '\r '<---*HERE* '\o . 6240 eq printSyntaxError(ambiguity(RP, RP'), QIL) 6241 = '\r 'Ambiguous 'parsing 'for '\o '\s QIL '\o . 6242 eq printSyntaxError(RP?, QIL) = QIL [owise] . 6243 6244endfm 6245 6246------------------------------------------------------------------------------- 6247******************************************************************************* 6248------------------------------------------------------------------------------- 6249*** 6250*** The Abstract Data Type \texttt{Module} 6251*** 6252------------------------------------------------------------------------------- 6253******************************************************************************* 6254------------------------------------------------------------------------------- 6255 6256*** In this section we present the abstract data type \texttt{Module}, which 6257*** can be seen as an extension of the predefined sort \texttt{Module} in 6258*** several ways. There are constructors for functional, system, and object- 6259*** oriented modules and theories, which can be parameterized and can import 6260*** module expressions. There can also be parameterized sorts in Full Maude 6261*** modules, and therefore, the constructors for the different declarations 6262*** that can appear in a module have to be appropriately extended. 6263 6264*** The section is structured as follows. After introducing some modules 6265*** defining some functions on the predefined sorts \texttt{Bool} and 6266*** \texttt{QidList} in Section~\ref{BOOL-QID-LIST}, we present in 6267*** Sections~\ref{EXT-SORT} and~\ref{EXT-DECL} the data types for extended 6268*** sorts and extended declarations. In Section~\ref{mod-exp-mod-id} we 6269*** introduce module expressions and module names, and in 6270*** Section~\ref{unitADT} the abstract data type \texttt{Module} itself. 6271 6272*** 6273*** Extension \texttt{QID-LIST} 6274*** 6275 6276*** The conversion of lists of quoted identifiers into single quoted 6277*** identifiers by concatenating them is heavily used in the coming modules. 6278*** This is the task of the \texttt{} function, which is 6279*** introduced in the following module \texttt{EXT-QID-LIST} extending the 6280*** predefined module \texttt{QID-LIST}. 6281 6282------------------------------------------------------------------------------- 6283******************************************************************************* 6284------------------------------------------------------------------------------- 6285 6286fmod EXT-QID-LIST is 6287 pr QID-LIST . 6288 6289 op qidList2Qid : QidList -> Qid . 6290 6291 vars QI QI' QI'' : Qid . 6292 var QIL : QidList . 6293 vars St St' : String . 6294 var N : Nat . 6295 var F : FindResult . 6296 6297 eq qidList2Qid(('\s QIL)) = qid(" " + string(qidList2Qid(QIL))) . 6298 eq qidList2Qid((QI QIL)) 6299 = qid(string(QI) + " " + string(qidList2Qid(QIL))) 6300 [owise] . 6301 eq qidList2Qid(nil) = qid("") . 6302 6303 op trimQidList : QidList -> QidList . 6304 eq trimQidList(' QIL) = trimQidList(QIL) . 6305 eq trimQidList(QI QIL) = QI trimQidList(QIL) [owise] . 6306 eq trimQidList(nil) = nil . 6307 6308 op qidList2string : QidList -> String . 6309 eq qidList2string('`( QIL) = "(" + " " + qidList2string(QIL) . 6310 eq qidList2string('`) QIL) = ")" + " " + qidList2string(QIL) . 6311 eq qidList2string('`{ QIL) = "{" + " " + qidList2string(QIL) . 6312 eq qidList2string('`} QIL) = "}" + " " + qidList2string(QIL) . 6313 eq qidList2string('`[ QIL) = "[" + " " + qidList2string(QIL) . 6314 eq qidList2string('`] QIL) = "]" + " " + qidList2string(QIL) . 6315 eq qidList2string('`, QIL) = "," + " " + qidList2string(QIL) . 6316 eq qidList2string(QI QIL) = string(QI) + " " + qidList2string(QIL) [owise] . 6317 eq qidList2string(nil) = "" . 6318 6319 op string2qidList : String -> QidList . 6320 op string2qidListAux : String -> QidList . 6321 6322 eq string2qidList(St) = trimQidList(string2qidListAux(St)) . 6323 6324 eq string2qidListAux("") = nil . 6325 ceq string2qidListAux(St) 6326 = if F == notFound 6327 then qid(substr(St, findNonSpace(St), length(St))) 6328 else qid(substr(St, findNonSpace(St), F)) 6329 if substr(St, findNonSpace(St) + F, 1) =/= " " 6330 then qid(substr(St, findNonSpace(St) + F, 1)) 6331 else nil 6332 fi 6333 string2qidListAux(substr(St, findNonSpace(St) + F + 1, length(St))) 6334 fi 6335 if F := myfind(substr(St, findNonSpace(St), length(St)), " (){}[],", 0) 6336 [owise] . 6337 6338 op findNonSpace : String -> Nat . 6339 op findNonSpace : String Nat -> Nat . 6340 ---- returns the length of the string if not found 6341 eq findNonSpace(St) = findNonSpace(St, 0) . 6342 6343 eq findNonSpace(St, N) 6344 = if N < length(St) 6345 then if substr(St, N, 1) == " " 6346 then findNonSpace(St, N + 1) 6347 else N 6348 fi 6349 else length(St) 6350 fi . 6351 6352 op myfind : String String Nat -> FindResult . 6353 eq myfind(St, St', N) 6354 = if N < length(St) 6355 then if find(St', substr(St, N, 1), 0) =/= notFound 6356 then N 6357 else myfind(St, St', N + 1) 6358 fi 6359 else notFound 6360 fi . 6361 6362 op replace : QidList Qid Qid -> QidList . 6363 eq replace(QI QIL, QI', QI'') 6364 = if QI == QI' 6365 then QI'' replace(QIL, QI', QI'') 6366 else QI replace(QIL, QI', QI'') 6367 fi . 6368 eq replace(nil, QI, QI') = nil . 6369endfm 6370 6371fmod HELP is 6372 pr EXT-QID-LIST . 6373 op fm-help : -> QidList . 6374 eq fm-help 6375 = string2qidList("Additional commands available:") '\n 6376 '\t string2qidList("(load <meta-module> .)") '\n 6377 '\t '\t string2qidList("Takes as argument a term of sort Module,") '\s string2qidList("i.e.,") '\s string2qidList("a metaterm.") '\n 6378 '\t '`( 'remove 'identity 'attributes '\s '`[ '<module-expr.> '`] '\s '. '`) '\s '| '\s '`( 'rm 'ids '\s '`[ '<module-expr.> '`] '\s '. '`) '\n 6379 '\t '\t string2qidList("Shows the module with the id attributes removed using a variant-based transformation.") '\n 6380 '\t string2qidList("(remove assoc attributes") '\s string2qidList("[<module-expr.>]") '\s string2qidList(".)") '\n 6381 '\t '\t string2qidList("Shows the module with the assoc (if not with comm) attributes removed using a variant-based transformation.") '\n 6382 '\t string2qidList("(ax coherence completion") '\s string2qidList("[<module-expr.>]") '\s string2qidList(".)") '\n 6383 '\t '\t string2qidList("Shows the module resulting from completing for coherence for the different combinations of axioms.") '\n . 6384endfm 6385 6386 6387------------------------------------------------------------------------------- 6388******************************************************************************* 6389------------------------------------------------------------------------------- 6390 6391*** 3.2 View Expressions and Extended Sorts 6392 6393*** To allow the use of parameterized sorts, or sorts qualified by the view 6394*** expression with which the parameterized module in which the given sorts 6395*** appear is instantiated, we add the sort Sort of ``extended sorts'' as a 6396*** supersort of the predefined sort Sort. View expressions and extended 6397*** sorts are introduced in the following modules. 6398 6399*** 3.2.1 View Expressions 6400 6401*** A view expression is given by a single quoted identifier, by a sequence of 6402*** view expressions (at the user level, separated by commas), or by the 6403*** composition of view expressions. In the current version, the composition 6404*** of view expressions is only used internally; we plan to make it available 6405*** to the user with syntax \verb~_;_~ in the future. View expressions are 6406*** used in the instantiation of parameterized modules and in parameterized 6407*** sorts. We plan to support parameterized views in the future as well. We 6408*** use operators \verb~_|_~ and \verb~_;;_~ to represent, respectively, 6409*** sequences and composition of view expressions. 6410 6411------------------------------------------------------------------------------- 6412******************************************************************************* 6413------------------------------------------------------------------------------- 6414 6415fmod VIEW-EXPR is 6416 pr META-MODULE . 6417 6418 sort ViewExp . 6419 subsorts Sort < ViewExp < ModuleExpression NeParameterList . 6420 6421 op mtViewExp : -> ViewExp . 6422 op _{_} : Sort ParameterList -> ViewExp [ctor prec 37]. 6423 op _;;_ : ViewExp ViewExp -> ViewExp 6424 [assoc id: mtViewExp] . *** view composition _;_ 6425 6426endfm 6427 6428------------------------------------------------------------------------------- 6429******************************************************************************* 6430------------------------------------------------------------------------------- 6431 6432*** Since the Core Maude engine does not know about view expressions, or, as 6433*** we shall see, about extended sorts, extended module expressions, extended 6434*** modules, and other declarations that we introduce, to be able to use them 6435*** with built-in functions such as \texttt{sameComponent}, 6436*** \texttt{leastSort}, \texttt{metaReduce}, etc., we shall have to convert 6437*** them into terms which only use the built-in constructors. Thus, for 6438*** example, view expressions in sort \texttt{ViewExp} will be converted 6439*** into quoted identifiers of sort \texttt{Qid} by means of function 6440*** \texttt{parameter2Qid}, or, similarly, elements of sorts \texttt{Sort}, 6441*** \texttt{SortList}, and \texttt{SortSet} are transformed into elements 6442*** of sorts \texttt{Qid}, \texttt{QidList}, and \texttt{QidSet}, 6443*** respectively, with functions \texttt{eSortToQid} defined on the 6444*** appropriate sorts. 6445 6446------------------------------------------------------------------------------- 6447******************************************************************************* 6448------------------------------------------------------------------------------- 6449 6450fmod VIEW-EXPR-TO-QID is 6451 pr VIEW-EXPR . 6452 pr EXT-QID-LIST . 6453 6454 op viewExp2Qid : ViewExp -> Qid . 6455 op parameterList2Qid : ParameterList -> Qid . 6456 op viewExp2QidList : ViewExp -> QidList . 6457 op parameterList2QidList : ParameterList -> QidList . 6458 6459 op eMetaPrettyPrint : ViewExp -> QidList . 6460 ceq eMetaPrettyPrint(VE) = viewExp2QidList(VE) if not VE :: TypeList . 6461 6462 var V : Sort . 6463 var QI : Qid . 6464 var QIL : QidList . 6465 var P : ViewExp . 6466 var PL : NeParameterList . 6467 vars VE VE' : ViewExp . 6468 6469 eq parameterList2QidList(P) = viewExp2QidList(P) . 6470 ceq parameterList2QidList((P, PL)) 6471 = (if QI == '`) then QIL QI '\s else QIL QI fi) 6472 '`, parameterList2QidList(PL) 6473 if QIL QI := viewExp2QidList(P). 6474 6475 eq viewExp2QidList(V{PL}) 6476 = (viewExp2QidList(V) '`{ parameterList2QidList(PL) '`}) . 6477 ceq viewExp2QidList(VE ;; VE') 6478 = (viewExp2QidList(VE) '; viewExp2QidList(VE')) 6479 if VE =/= mtViewExp /\ VE' =/= mtViewExp . 6480 eq viewExp2QidList(V) = V . 6481 6482 eq parameterList2Qid(P) = viewExp2Qid(P) . 6483 eq parameterList2Qid((P, PL)) 6484 = qid(string(viewExp2Qid(P)) + ", " + string(parameterList2Qid(PL))) . 6485 6486 eq viewExp2Qid(VE) = qidList2Qid(viewExp2QidList(VE)) . 6487endfm 6488 6489------------------------------------------------------------------------------- 6490******************************************************************************* 6491------------------------------------------------------------------------------- 6492 6493*** 6494*** Parameterized Sorts 6495*** 6496 6497*** In addition to the \texttt{Sort} sort, in the following module 6498*** \texttt{EXT-SORT} we also define sorts \texttt{SortList} and 6499*** \texttt{SortSet}. 6500 6501*** The operator \texttt{eSort} is declared to be a constructor for extended 6502*** sorts. 6503 6504*** As for lists and sTS of quoted identifiers, we declare \verb~__~ and 6505*** \verb~_;_~ as constructors for sorts \texttt{SortList} and 6506*** \texttt{SortList}, and \texttt{SortSet}, respectively. 6507 6508------------------------------------------------------------------------------- 6509******************************************************************************* 6510------------------------------------------------------------------------------- 6511 6512fmod EXT-SORT is 6513--- pr META-LEVEL + PRE-VARIANT . 6514 pr META-LEVEL . 6515 pr EXT-BOOL . 6516 pr VIEW-EXPR-TO-QID . 6517 pr EXT-QID-LIST . 6518 pr TERMSET . 6519 6520*** We define operations extending the built-in functions \texttt{sameKind} 6521*** and \texttt{leastSort}, respectively, to lists of sorts and 6522*** to lists of extended terms. The function \texttt{sameKind} takes 6523*** a module and two lists of extended sorts as arguments, and returns 6524*** \texttt{true} if the $i$-th elements of both lists are in the same 6525*** connected component of sorts. This function will be used, for example, to 6526*** check whether two operators are in the same family of subsort overloaded 6527*** operators. \texttt{leastSort} returns a list of sorts where the $i$-th 6528*** element of the list is the least sort, computed by the homonymous built-in 6529*** function, of the $i$-th term in the list of terms given as argument. 6530*** Moreover, we define a function \verb~_in_~ to check whether an 6531*** extended sort is in a given set of extended sorts. Note that before 6532*** calling the built-in function \texttt{sameComponent}, extended sorts of 6533*** sort \texttt{Sort} have to be `desugared' into sorts of sort 6534*** \texttt{Sort} as defined in the predefined \texttt{META-LEVEL} module. 6535*** This conversion is done by the \texttt{eTypeToType} function. Basically, 6536*** user-defined sorts are converted into quoted identifiers by concatenating 6537*** the list of identifiers composing the name of the sort. For example, sorts 6538*** \texttt{'Nat} and \texttt{'List['Nat]} are converted, respectively, into 6539*** \texttt{'Nat} and \texttt{'List`[Nat`]}. Error 6540*** sorts~\cite{ClavelDuranEkerLincolnMarti-OlietMeseguerQuesada99} are left 6541*** as such. 6542 6543 vars Tp Tp' Tp'' Tp''' : Type . 6544 vars TpL TpL' : TypeList . 6545 var M : Module . 6546 6547 op sameKind : Module TypeList TypeList -> Bool [ditto] . 6548 eq sameKind(M, (Tp Tp' TpL), (Tp'' Tp''' TpL')) 6549 = sameKind(M, Tp, Tp'') 6550 and-then sameKind(M, Tp' TpL, Tp''' TpL') . 6551 eq sameKind(M, nil, nil) = true . 6552 eq sameKind(M, TpL, TpL') = false [owise] . 6553 6554 eq sameKind(M, cc(S:Sort ; SS:SortSet), Tp) 6555 = sameKind(M, S:Sort, Tp) . 6556 eq sameKind(M, Tp, cc(S:Sort ; SS:SortSet)) 6557 = sameKind(M, Tp, S:Sort) . 6558 eq sameKind(M, cc(S:Sort ; SS:SortSet), cc(S':Sort ; SS':SortSet)) 6559 = sameKind(M, S:Sort, S':Sort) . 6560 6561 op sameKindAll : Module Type TypeList -> Bool . 6562 eq sameKindAll(M, Tp, Tp' TpL) = sameKind(M, Tp, Tp') and-then sameKindAll(M, Tp, TpL) . 6563 eq sameKindAll(M, Tp, nil) = true . 6564 6565 op eLeastSort : Module TermList ~> TypeList . 6566 eq eLeastSort(M, (T:Term, TL:TermList)) 6567 = (leastSort(M, T:Term) eLeastSort(M, TL:TermList)) . 6568 eq eLeastSort(M, empty) = nil . 6569 eq eLeastSort(M, qidError(QIL)) = qidError(QIL) . 6570 6571 op eLeastSort : Module TermSet ~> TypeSet . 6572 eq eLeastSort(M, (T:Term | TS:TermSet)) 6573 = (leastSort(M, T:Term) ; eLeastSort(M, TS:TermSet)) . 6574 eq eLeastSort(M, emptyTermSet) = none . 6575 eq eLeastSort(M, qidError(QIL)) = qidError(QIL) . 6576 6577 op qidError : QidList -> [Sort] . 6578 op stringError : QidList -> [String] . 6579 eq string(qidError(QIL)) = stringError(QIL) . 6580 eq qid(stringError(QIL)) = qidError(QIL) . 6581 eq stringError(QIL) + St:String = stringError(QIL) . 6582 6583 op getMsg : [Sort] -> QidList . 6584 eq getMsg(qidError(QIL:QidList)) = QIL:QidList . 6585 6586 op kind : TypeList -> Type . 6587 6588 eq kind(S:Sort TL:TypeList) 6589 = qid("[" + string(S:Sort) + "]") kind(TL:TypeList) . 6590 eq kind(K:Kind TL:TypeList) = K:Kind kind(TL:TypeList) . 6591 eq kind(nil) = nil . 6592 6593 op kind : SortSet -> Type . 6594 eq kind(S:Sort ; SS:SortSet) = qid("[" + string(S:Sort) + "]") . 6595 6596 op cc : SortSet -> Type . 6597 6598 op getSort : Kind -> Sort . 6599 eq getSort(K:Kind) 6600 = if findOut(string(K:Kind), "`,", "{", "}", 0) == notFound 6601 then qid(substr(string(K:Kind), 6602 2, 6603 sd(length(string(K:Kind)), 4))) 6604 else qid(substr(string(K:Kind), 6605 2, 6606 sd(findOut(string(K:Kind), "`,", "{", "}", 0), 2))) 6607 fi . 6608 6609 op getSorts : Kind -> SortSet . 6610 eq getSorts(K:Kind) 6611 = if findOut(string(K:Kind), "`,", "{", "}", 0) == notFound 6612 then qid(substr(string(K:Kind), 6613 2, 6614 sd(length(string(K:Kind)), 4))) 6615 else qid(substr(string(K:Kind), 6616 2, 6617 sd(findOut(string(K:Kind), "`,", "{", "}", 0), 2))) 6618 ; 6619 getSorts(qid("[" + substr(string(K:Kind), 6620 sd(findOut(string(K:Kind), "`,", "{", "}", 0), 1), 6621 length(string(K:Kind))))) 6622 fi . 6623 6624---- op qid2Sort : Sort -> Sort . 6625---- eq qid2Sort(S:Sort) = getName{S:Sort} { getPars(S:Sort) } . 6626 6627 ---- name of a sort (the name of S{P1, ..., Pn} is S) 6628 op getName : Sort -> Qid . 6629 eq getName(S:Sort) 6630 = if findOpening(string(S:Sort), "{", "}", sd(length(string(S:Sort)), 2)) 6631 == notFound 6632 then S:Sort 6633 else qid(substr(string(S:Sort), 6634 0, 6635 findOpening(string(S:Sort), 6636 "{", "}", 6637 sd(length(string(S:Sort)), 2)))) 6638 fi . 6639 6640 ---- parameters of a sort (the parameters of S{P1, ..., Pn} are P1 ... Pn) 6641 op getPars : Sort -> ParameterList [memo] . 6642 op getParsAux : String Nat Nat -> ParameterList . 6643 6644 eq getPars(S:Sort) 6645 = if findOpening(string(S:Sort), "{", "}", sd(length(string(S:Sort)), 2)) 6646 == notFound 6647 then empty 6648 else getParsAux(string(S:Sort), 6649 findOpening(string(S:Sort), 6650 "{", "}", sd(length(string(S:Sort)), 2)) + 1, 6651 length(string(S:Sort))) 6652 fi . 6653 6654 var St Pattern OpenPar ClosingPar : String . 6655 vars L R N OpenPars ClosingPars : Nat . 6656 6657 eq getParsAux(St, L, R) 6658 = if findOut(St, ",", "{", "}", L) == notFound 6659 then qid(substr(St, L, sd(findClosing(St, "{", "}", L), L))) 6660 else (qid(substr(St, L, sd(findOut(St, ",", "{", "}", L), L))), 6661 getParsAux(St, findOut(St, ",", "{", "}", L) + 1, R)) 6662 fi . 6663 6664 ---- finds a pattern out of balanced parentheses 6665 ---- findOut("S{P1, P2{P21, P22}, P3}", ",", "{", "}", 6) returns 18, not 12 6666 op findOut : String String String String Nat -> FindResult . 6667 op findOut : String String String String Nat Nat -> FindResult . 6668 6669 eq findOut(St, Pattern, OpenPar, ClosingPar, N) 6670 = findOut(St, Pattern, OpenPar, ClosingPar, 0, N) . 6671 6672 eq findOut(St, Pattern, OpenPar, ClosingPar, OpenPars, N) 6673 = if N >= length(St) 6674 then notFound 6675 else if OpenPars == 0 and-then substr(St, N, length(Pattern)) == Pattern 6676 then N 6677 else if substr(St, N, length(OpenPar)) == OpenPar 6678 then findOut(St, Pattern, OpenPar, ClosingPar, 6679 OpenPars + 1, N + 1) 6680 else if substr(St, N, length(ClosingPar)) == ClosingPar 6681 then findOut(St, Pattern, OpenPar, ClosingPar, 6682 sd(OpenPars, 1), N + 1) 6683 else findOut(St, Pattern, OpenPar, ClosingPar, 6684 OpenPars, N + 1) 6685 fi 6686 fi 6687 fi 6688 fi . 6689 6690 ---- finds the first closing unbalanced parenthesis 6691 ---- findOut("P1, P2{P21, P22}, P3}", "{", "}", 6) returns 21, not 16 6692 op findClosing : String String String Nat -> FindResult . 6693 op findClosing : String String String Nat Nat -> FindResult . 6694 6695 eq findClosing(St, OpenPar, ClosingPar, N) 6696 = findClosing(St, OpenPar, ClosingPar, 0, N) . 6697 6698 eq findClosing(St, OpenPar, ClosingPar, OpenPars, N) 6699 = if N >= length(St) 6700 then notFound 6701 else if OpenPars == 0 6702 and-then substr(St, N, length(ClosingPar)) == ClosingPar 6703 then N 6704 else if substr(St, N, length(OpenPar)) == OpenPar 6705 then findClosing(St, OpenPar, ClosingPar, 6706 OpenPars + 1, N + 1) 6707 else if substr(St, N, length(ClosingPar)) == ClosingPar 6708 then findClosing(St, OpenPar, ClosingPar, 6709 sd(OpenPars, 1), N + 1) 6710 else findClosing(St, OpenPar, ClosingPar, 6711 OpenPars, N + 1) 6712 fi 6713 fi 6714 fi 6715 fi . 6716 6717 ---- finds the last opening unbalanced parenthesis 6718 ---- findOpening("S{P1, P2{P21, P22}, P3}", "{", "}", 21) returns 1, not 8 6719 op findOpening : String String String Nat -> FindResult . 6720 op findOpening : String String String Nat Nat -> FindResult . 6721 6722 eq findOpening(St, OpenPar, ClosingPar, N) 6723 = findOpening(St, OpenPar, ClosingPar, 0, N) . 6724 6725 eq findOpening(St, OpenPar, ClosingPar, ClosingPars, N) 6726 = if N == 0 6727 then notFound 6728 else if ClosingPars == 0 6729 and-then substr(St, N, length(ClosingPar)) == OpenPar 6730 then N 6731 else if substr(St, N, length(OpenPar)) == ClosingPar 6732 then findOpening(St, OpenPar, ClosingPar, 6733 ClosingPars + 1, sd(N, 1)) 6734 else if substr(St, N, length(ClosingPar)) == OpenPar 6735 then findOpening(St, OpenPar, ClosingPar, 6736 sd(ClosingPars, 1), sd(N, 1)) 6737 else findOpening(St, OpenPar, ClosingPar, 6738 ClosingPars, sd(N, 1)) 6739 fi 6740 fi 6741 fi 6742 fi . 6743 6744 op makeSort : Sort ParameterList -> Sort . 6745 op makeSort : Sort ParameterList ParameterList ParameterList -> Sort . 6746 op makeSort2 : Sort ParameterList -> Sort . 6747 op makePars : ParameterList -> String . 6748 6749 vars S P : Sort . 6750 vars PL PL' PL'' PL3 : ParameterList . 6751 var VE : ViewExp . 6752 var QIL : QidList . 6753 var K : Kind . 6754 6755 eq makeSort(S, PL) 6756 = if PL == empty 6757 then S 6758 else makeSort(S, PL, empty, empty) 6759 fi . 6760 6761 ----eq makeSort(S, P, PL, PL') = makeSort(S, empty, (PL, P), PL') . 6762 eq makeSort(S, (P, PL), PL', PL'') = makeSort(S, PL, (PL', P), PL'') . 6763 eq makeSort(S, (P{PL}, PL'), PL'', PL3) 6764 = makeSort(S, PL', (PL'', makeSort(P, PL)), PL3) . 6765 ----eq makeSort(S, (P ;; VE), PL, PL') 6766 ---- = makeSort(S, empty, (PL, P), (PL', VE)) 6767 ---- [owise] . 6768 eq makeSort(S, ((P ;; VE), PL), PL', PL'') 6769 = makeSort(S, PL, (PL', P), (PL'', VE)) 6770 [owise] . 6771 eq makeSort(S, empty, PL, PL') 6772 = if PL' == empty 6773 then makeSort2(S, PL) 6774 else makeSort(makeSort2(S, PL), PL') 6775 fi . 6776 6777 eq makeSort2(S, empty) = S:Sort . 6778 eq makeSort2(S, P) = qid(string(S) + "{" + string(P) + "}") . 6779 eq makeSort2(S, (P, PL)) 6780 = qid(string(S) + "{" + string(P) + makePars(PL)) 6781 [owise] . 6782 6783 eq makePars((P, PL)) = "," + string(P) + makePars(PL) . 6784 eq makePars(P) = "," + string(P) + "}" . 6785 eq makePars(empty) = "}" . 6786 6787 op list2set : TypeList -> TypeSet . 6788 eq list2set(Tp TpL) = Tp ; list2set(TpL) . 6789 eq list2set(nil) = none . 6790 6791 op type2qid : Type -> Qid . 6792 eq type2qid(S) 6793 = if getPars(S) == empty 6794 then S 6795 else qid(string(getName(S)) + "{" + string(qidList2Qid(parameterList2QidList(getPars(S)))) + "}") 6796 fi . 6797 eq type2qid(K) = qid("[" + string(type2qid(getSort(K))) + "]") . 6798 6799 op size : TypeList -> Nat . 6800 eq size(Tp TpL) = 1 + size(TpL) . 6801 eq size((nil).TypeList) = 0 . 6802endfm 6803 6804------------------------------------------------------------------------------- 6805******************************************************************************* 6806------------------------------------------------------------------------------- 6807 6808fmod DEFAULT-VALUE{X :: TRIV} is 6809 sort Default{X} . 6810 subsort X$Elt < Default{X} . 6811 op null : -> Default{X} . 6812endfm 6813 6814view Term from TRIV to META-TERM is 6815 sort Elt to Term . 6816endv 6817 6818------------------------------------------------------------------------------- 6819******************************************************************************* 6820------------------------------------------------------------------------------- 6821 6822*** 6823*** Extended Declarations 6824*** 6825 6826*** In this section we discuss modules \texttt{EXT-DECL} and \texttt{O-O-DECL} 6827*** which introduce, respectively, the declarations extending the sorts and 6828*** constructors for declarations of the predefined data type \texttt{Module} 6829*** in the \texttt{META-LEVEL} module to allow the use of extended sorts in 6830*** them, and the declarations appearing in object-oriented units, namely 6831*** class declarations, subclass relation declarations, and message 6832*** declarations. 6833 6834*** 6835*** Declarations of Functional and System Modules 6836*** 6837 6838*** In the following module \texttt{EXT-DECL}, we introduce the declarations 6839*** extending those in \texttt{META-LEVEL} to allow the use of extended sorts 6840*** in declarations of sorts, subsort relations, operators, variables, and 6841*** membership axioms. 6842 6843*** \begin{comment} 6844*** \footnote{In the future, the declarations for operators, 6845*** membership axioms, equations, and rules will be extended to allow 6846*** the use of extended sorts in sort tests, that is, terms of the 6847*** form \mbox{\verb~T : S~} and \mbox{\verb~T :: S~}.} 6848*** \end{comment} 6849 6850*** The extension is accomplished by adding new supersorts for each of the 6851*** sorts in \texttt{META-LEVEL} involved, and by adding new constructors for 6852*** these new sorts. 6853 6854*** We start introducing the declarations for the supersorts and their 6855*** corresponding constructors. The \texttt{EXT-DECL} module also contains the 6856*** declarations for sTS of such declarations. 6857 6858------------------------------------------------------------------------------- 6859******************************************************************************* 6860------------------------------------------------------------------------------- 6861 6862fmod INT-LIST is 6863 pr META-MODULE . 6864 pr INT . 6865 sort IntList . 6866 subsort Int NatList < IntList . 6867 op __ : IntList IntList -> IntList [ctor ditto] . 6868 6869 op numberError : QidList -> [Nat] . 6870 6871 vars N M : Nat . 6872 6873 op from_to_list : Nat Nat ~> NatList . 6874 ceq from N to M list 6875 = if N == M 6876 then N 6877 else N from N + 1 to M list 6878 fi 6879 if N <= M . 6880endfm 6881 6882------------------------------------------------------------------------------- 6883******************************************************************************* 6884------------------------------------------------------------------------------- 6885 6886fmod EXT-DECL is 6887 pr EXT-SORT . 6888 pr INT-LIST . 6889 6890 var QI : Qid . 6891 vars QIL QIL' : QidList . 6892 var At : Attr . 6893 var AtS : AttrSet . 6894 var OPD OPD' : OpDecl . 6895 var OPDS : OpDeclSet . 6896 vars LHS RHS T T' : Term . 6897 var S : Sort . 6898 var Cond : Condition . 6899 var EqS : EquationSet . 6900 var RlS : RuleSet . 6901 var MbS : MembAxSet . 6902 var M : Module . 6903 6904 op variant : -> Attr [ctor] . 6905 6906*** subsort declarations error 6907 op subsortDeclError : QidList -> [SubsortDeclSet] [ctor format (r o)] . 6908 eq subsortDeclError(QIL) subsortDeclError(QIL') 6909 = subsortDeclError(QIL QIL') . 6910 6911*** extended attribute declarations 6912 op strat : IntList -> Attr [ditto] . *** to handle on-demand strategies 6913 op ditto : -> Attr [ctor] . 6914 6915 op _in_ : Attr AttrSet -> Bool . 6916 eq At in At AtS = true . 6917 eq At in AtS = false [owise] . 6918 6919*** extended operation declarations 6920 op opDeclError : QidList -> [OpDeclSet] [ctor format (r o)] . 6921 eq opDeclError(QIL) opDeclError(QIL') = opDeclError(QIL QIL') . 6922 6923*** extended membership axioms 6924 op membAxError : QidList -> [MembAxSet] [ctor format (r o)] . 6925 eq membAxError(QIL) membAxError(QIL') = membAxError(QIL QIL') . 6926 6927*** extended equations 6928 op equationError : QidList -> [EquationSet] [ctor format (r o)] . 6929 eq equationError(QIL) equationError(QIL') = equationError(QIL QIL') . 6930 6931*** extended rules 6932 op ruleError : QidList -> [RuleSet] [ctor format (r o)] . 6933 eq ruleError(QIL) ruleError(QIL') = ruleError(QIL QIL') . 6934 6935*** The function \verb~_in_~ checks whether a given operator 6936*** declaration is in a set of operator declarations. 6937 6938 op _in_ : OpDecl OpDeclSet -> Bool . 6939 6940 eq OPD in (OPD OPDS) = true . 6941 eq OPD in OPDS = false [owise] . 6942 6943 ops lhs rhs : Rule -> Term . 6944 op cond : Rule -> Condition . 6945 op atts : Rule -> AttrSet . 6946 op label : Rule -> [Qid] . 6947 eq lhs(rl LHS => RHS [AtS] .) = LHS . 6948 eq lhs(crl LHS => RHS if Cond [AtS] .) = LHS . 6949 eq rhs(rl LHS => RHS [AtS] .) = RHS . 6950 eq rhs(crl LHS => RHS if Cond [AtS] .) = RHS . 6951 eq cond(rl LHS => RHS [AtS] .) = nil . 6952 eq cond(crl LHS => RHS if Cond [AtS] .) = Cond . 6953 eq atts(rl LHS => RHS [AtS] .) = AtS . 6954 eq atts(crl LHS => RHS if Cond [AtS] .) = AtS . 6955 eq label(rl LHS => RHS [label(QI) AtS] .) = QI . 6956 eq label(crl LHS => RHS if Cond [label(QI) AtS] .) = QI . 6957 6958 ops lhs rhs : Equation -> Term . 6959 op cond : Equation -> Condition . 6960 op atts : Equation -> AttrSet . 6961 op label : Equation -> [Qid] . 6962 eq lhs(eq LHS = RHS [AtS] .) = LHS . 6963 eq lhs(ceq LHS = RHS if Cond [AtS] .) = LHS . 6964 eq rhs(eq LHS = RHS [AtS] .) = RHS . 6965 eq rhs(ceq LHS = RHS if Cond [AtS] .) = RHS . 6966 eq cond(eq LHS = RHS [AtS] .) = nil . 6967 eq cond(ceq LHS = RHS if Cond [AtS] .) = Cond . 6968 eq atts(eq LHS = RHS [AtS] .) = AtS . 6969 eq atts(ceq LHS = RHS if Cond [AtS] .) = AtS . 6970 eq label(eq LHS = RHS [label(QI) AtS] .) = QI . 6971 eq label(ceq LHS = RHS if Cond [label(QI) AtS] .) = QI . 6972 6973 op cond : MembAx -> Condition . 6974 op atts : MembAx -> AttrSet . 6975 eq cond(mb T : S [AtS] .) = nil . 6976 eq cond(cmb T : S if Cond [AtS] .) = Cond . 6977 eq atts(mb T : S [AtS] .) = AtS . 6978 eq atts(cmb T : S if Cond [AtS] .) = AtS . 6979 6980 op rulify : EquationSet -> RuleSet . 6981 ---- takes a set of equations and turn them into rules 6982 eq rulify(eq LHS = RHS [AtS] . EqS) = (rl LHS => RHS [AtS] .) rulify(EqS) . 6983 eq rulify(ceq LHS = RHS if Cond [AtS] . EqS) = (crl LHS => RHS if Cond [AtS] .) rulify(EqS) . 6984 eq rulify((none).EquationSet) = none . 6985endfm 6986 6987**** The module EXT-TERM extends META-LEVEL with definitions of several 6988**** operations that manipulate terms: definitions for positions and operations 6989**** to get the subterm of a given term at a given position, to replace the 6990**** subterm of a term at a given position by another term, to get all the 6991**** nonvariable positions in a term, to apply a substitution to a term, and to 6992**** get a copy of a term in which all the variables in it have been renamed. 6993 6994fmod EXT-TERM is 6995--- pr META-LEVEL + PRE-VARIANT . 6996 pr META-LEVEL . 6997 pr EXT-BOOL . 6998 pr EXT-DECL . 6999 7000 vars T T' : Term . 7001 vars F X : Qid . 7002 var TL : TermList . 7003 var N : Nat . 7004 vars NL NL' : NatList . 7005 vars V V' W : Variable . 7006 var Subst : Substitution . 7007 vars C Ct : Constant . 7008 var NTL : NeTermList . 7009 var M : Module . 7010 var Tp : Type . 7011 vars TpL TpL' : TypeList . 7012 vars AtS AtS' : AttrSet . 7013 var ODS : OpDeclSet . 7014 var Cd : Condition . 7015 var S : Sort . 7016 7017 **** vars returns the set of variables in a term 7018 op vars : Term -> QidSet . 7019 op vars : TermList -> QidSet . 7020 7021 eq vars(V) = V . 7022 eq vars(C) = none . 7023 eq vars(F[TL]) = vars(TL) . 7024 eq vars(empty) = none . 7025 eq vars((T, TL)) = vars(T) ; vars(TL) . 7026 7027 **** varlist returns the list of variables in a term 7028 op varlist : Term -> QidList . 7029 op varlist : TermList -> QidList . 7030 7031 eq varlist(V) = V . 7032 eq varlist(C) = nil . 7033 eq varlist(F[TL]) = varlist(TL) . 7034 eq varlist(empty) = nil . 7035 eq varlist((T, TL)) = varlist(T) varlist(TL) . 7036 7037 **** occurs? checks whether a variable name occurs in a term or not. 7038 op occurs? : Variable Term -> Bool . 7039 op occurs? : Variable TermList -> Bool . 7040 eq occurs?(V, V') = V == V' . 7041 eq occurs?(V, C) = false . 7042 eq occurs?(V, F[TL]) = occurs?(V, TL) . 7043 eq occurs?(V, (T, TL)) = occurs?(V, T) or-else occurs?(V, TL) . 7044 7045 **** occurrences checks whether a variable name occurs in a term or not. 7046 op occurrences : Variable Term -> Nat . 7047 op occurrences : Variable TermList -> Nat . 7048 eq occurrences(V, V') = if V == V' then 1 else 0 fi . 7049 eq occurrences(V, C) = 0 . 7050 eq occurrences(V, F[TL]) = occurrences(V, TL) . 7051 eq occurrences(V, (T, TL)) = occurrences(V, T) + occurrences(V, TL) . 7052 7053 op frozen : Module Term Nat -> Bool . 7054 op frozen : Module OpDeclSet Qid TypeList Nat -> Bool . 7055 eq frozen(M, F[TL], N) 7056 = frozen(M, getOps(M), F, eLeastSort(M, TL), N) . 7057 7058 ceq frozen(M, op F : TpL -> Tp [AtS] . ODS, F, TpL', N) 7059 = true 7060 if sameKind(M, TpL, TpL') 7061 /\ not ctor(M, op F : TpL -> Tp [AtS] . ODS, F, TpL') . 7062 ceq frozen(M, op F : TpL -> Tp [AtS] . ODS, F, TpL', N) 7063 = true 7064 if sameKind(M, TpL, TpL') 7065 /\ ctor(M, op F : TpL -> Tp [AtS] . ODS, F, TpL') 7066 /\ frozen(NL N NL') AtS' := AtS . 7067 eq frozen(M, ODS, F, TpL, N) = false [owise] . 7068 7069 ---- ctor check whether the operator at the top is a constructor 7070 ---- in any of its overloadings 7071 op ctor : Module OpDeclSet Term -> Bool . 7072 op ctor : Module OpDeclSet Qid TypeList -> Bool . 7073 7074 eq ctor(M, ODS, Ct) = ctor(M, ODS, Ct, nil) . 7075 eq ctor(M, ODS, F[TL]) = ctor(M, ODS, F, eLeastSort(M, TL)) . 7076 eq ctor(M, ODS, T) = false [owise] . 7077 7078 ceq ctor(M, op F : TpL -> Tp [AtS] . ODS, F, TpL') 7079 = ctor in AtS or-else ctor(M, ODS, F, TpL') 7080 if sameKind(M, TpL, TpL') . 7081 eq ctor(M, ODS, F, TpL) = false [owise] . 7082 7083**** The function \texttt{substitute} takes a term $t$ and a substitution 7084**** $\sigma$ and returns the term $t\sigma$. 7085 7086 op substitute : Module Term Substitution -> Term . 7087 op substitute : Module TermList Substitution -> TermList . 7088 7089 eq substitute(M, T, none) = T . 7090 eq substitute(M, V, ((W <- T) ; Subst)) 7091 = if getName(V) == getName(W) and-then sameKind(M, getType(V), getType(W)) 7092 then T 7093 else substitute(M, V, Subst) 7094 fi . 7095 eq substitute(M, C, ((W <- T); Subst)) = C . 7096 eq substitute(M, F[TL], Subst) = F[substitute(M, TL, Subst)] . 7097 eq substitute(M, (T, TL), Subst) 7098 = (substitute(M, T, Subst), substitute(M, TL, Subst)) . 7099 7100 op substitute : Module EqCondition Substitution -> EqCondition . 7101 eq substitute(M, T = T' /\ Cd, Subst) 7102 = substitute(M, T, Subst) = substitute(M, T', Subst) /\ substitute(M, Cd, Subst) . 7103 eq substitute(M, T := T' /\ Cd, Subst) 7104 = substitute(M, T, Subst) := substitute(M, T', Subst) /\ substitute(M, Cd, Subst) . 7105 eq substitute(M, T : S /\ Cd, Subst) 7106 = substitute(M, T, Subst) : S /\ substitute(M, Cd, Subst) . 7107 eq substitute(M, (nil).EqCondition, Subst) = nil . 7108endfm 7109 7110***( 7111red substitute('f['X:Foo, 'g['Y:Foo, 'Z:Foo]], ('Y:Foo <- 'h['W:Foo])) . 7112red rename('f['X:Foo, 'g['Y:Foo, 'Z:Foo]]) . 7113red allNonVarPos( 7114 substitute('f['X:Foo, 'g['Y:Foo, 'Z:Foo]], ('Y:Foo <- 'h['W:Foo]))) . 7115) 7116 7117------------------------------------------------------------------------------- 7118******************************************************************************* 7119------------------------------------------------------------------------------- 7120 7121*** 7122*** Declarations for Object-Oriented Modules 7123*** 7124 7125*** In the \texttt{O-O-DECL} module we introduce the sorts and constructors 7126*** for declarations of classes, subclass relations, and messages in 7127*** object-oriented units. 7128 7129*** Note that we follow the same naming conventions for classes as for 7130*** extended sorts (see Section~\ref{parameterized-modules}), and therefore 7131*** we use the sort \texttt{Sort} for class identifiers, and 7132*** \texttt{TypeList} and \texttt{SortSet} for lists and sTS of class 7133*** identifiers, respectively. We use the operator \verb~attr_:_~ as a 7134*** constructor for declarations of attributes. Since the operator name 7135*** \texttt{\_\,:\_\,} is used for sort tests in the \texttt{META-LEVEL} 7136*** module, we use \texttt{attr\_\,:\_\,} as constructor for declarations of 7137*** attributes to satisfy the preregularity condition. 7138 7139------------------------------------------------------------------------------- 7140******************************************************************************* 7141------------------------------------------------------------------------------- 7142 7143fmod O-O-DECL is 7144 pr EXT-SORT . 7145 7146 vars QIL QIL' : QidList . 7147 7148 sorts AttrDecl AttrDeclSet . 7149 subsort AttrDecl < AttrDeclSet . 7150 op attr_:_ : Qid Sort -> AttrDecl . 7151 op none : -> AttrDeclSet . 7152 op _`,_ : AttrDeclSet AttrDeclSet -> AttrDeclSet [assoc comm id: none] . 7153 7154 eq AD:AttrDecl, AD:AttrDecl = AD:AttrDecl . 7155 7156 sorts ClassDecl ClassDeclSet . 7157 subsort ClassDecl < ClassDeclSet . 7158 op class_|_. : Sort AttrDeclSet -> ClassDecl . 7159 op none : -> ClassDeclSet . 7160 op __ : ClassDeclSet ClassDeclSet -> ClassDeclSet [assoc comm id: none] . 7161 7162 op classDeclError : QidList -> [ClassDeclSet] [ctor format (r o)] . 7163 eq classDeclError(QIL) classDeclError(QIL') = classDeclError(QIL QIL') . 7164 7165 eq CD:ClassDecl CD:ClassDecl = CD:ClassDecl . 7166 7167 sorts SubclassDecl SubclassDeclSet . 7168 subsort SubclassDecl < SubclassDeclSet . 7169 op subclass_<_. : Sort Sort -> SubclassDecl . 7170 op none : -> SubclassDeclSet . 7171 op __ : SubclassDeclSet SubclassDeclSet -> SubclassDeclSet 7172 [assoc comm id: none] . 7173 7174 eq SCD:SubclassDecl SCD:SubclassDecl = SCD:SubclassDecl . 7175 7176 op subclassDeclError : QidList -> [SubclassDeclSet] [ctor format (r o)] . 7177 eq subclassDeclError(QIL) subclassDeclError(QIL') 7178 = subclassDeclError(QIL QIL') . 7179 7180 sorts MsgDecl MsgDeclSet . 7181 subsort MsgDecl < MsgDeclSet . 7182 op msg_:_->_. : Qid TypeList Sort -> MsgDecl . 7183 op none : -> MsgDeclSet . 7184 op __ : MsgDeclSet MsgDeclSet -> MsgDeclSet [assoc comm id: none] . 7185 7186 eq MD:MsgDecl MD:MsgDecl = MD:MsgDecl . 7187 7188 op msgDeclError : QidList -> [MsgDeclSet] [ctor format (r o)] . 7189 eq msgDeclError(QIL) msgDeclError(QIL') = msgDeclError(QIL QIL') . 7190 7191*** The function \texttt{classSet} returns the set of class identifiers in 7192*** the set of class declarations given as argument. 7193 7194 op classSet : ClassDeclSet -> SortSet . 7195 7196 eq classSet((class S:Sort | ADS:AttrDeclSet .) CDS:ClassDeclSet) 7197 = (S:Sort ; classSet(CDS:ClassDeclSet)) . 7198 eq classSet(none) = none . 7199endfm 7200 7201------------------------------------------------------------------------------- 7202******************************************************************************* 7203------------------------------------------------------------------------------- 7204 7205*** 7206*** Renaming Maps 7207*** 7208 7209*** We introduce the different types of renaming maps in the module 7210*** \texttt{FMAP} below. A sort is introduced for each of these types of maps, 7211*** with the appropriate constructors for each sort (see 7212*** Section~\ref{module-expressions}). All these sorts are declared to be 7213*** subsorts of the sort \texttt{Map}. A sort for sTS of 7214*** maps (\texttt{RenamingSet}) is then declared as supersort of \texttt{Map} 7215*** with constructors \texttt{none} and \verb~_,_~. 7216 7217------------------------------------------------------------------------------- 7218******************************************************************************* 7219------------------------------------------------------------------------------- 7220 7221fmod FMAP is 7222 inc META-MODULE . 7223 pr EXT-SORT . 7224 7225 *** renamings 7226 op class_to_ : Sort Sort -> Renaming . 7227 op attr_._to_ : Qid Sort Qid -> Renaming . 7228 op msg_to_ : Qid Qid -> Renaming . 7229 op msg_:_->_to_ : Qid TypeList Sort Qid -> Renaming . 7230 op op_to term_ : Term Term -> Renaming . 7231 7232 op none : -> RenamingSet . 7233 eq (MAP, MAP) = MAP . 7234 eq (MAPS, none) = MAPS . 7235 7236---- eq attr A . qidError(QIL) to A' = none . 7237 7238*** Given a set of maps, the function \texttt{sortMaps} returns the 7239*** subset of sort maps in it. 7240 7241 var MAP : Renaming . 7242 var MAPS : RenamingSet . 7243 vars S S' A A' : Sort . 7244 var QIL : QidList . 7245 7246 op sortMaps : RenamingSet -> RenamingSet . 7247 7248 eq sortMaps(sort S to S') = sort S to S' . 7249 eq sortMaps(((sort S to S'), MAPS)) 7250 = ((sort S to S'), sortMaps(MAPS)) . 7251 eq sortMaps(MAP) = none [owise] . 7252 eq sortMaps((MAP, MAPS)) = sortMaps(MAPS) [owise] . 7253 eq sortMaps(none) = none . 7254endfm 7255 7256------------------------------------------------------------------------------- 7257******************************************************************************* 7258------------------------------------------------------------------------------- 7259 7260*** 7261*** Module Expressions and Module Names 7262*** 7263 7264*** The abstract syntax for writing specifications in Maude can be seen as 7265*** given by module expressions, where the notion of module expression is 7266*** understood as an expression that defines a new module out of previously 7267*** defined modules by combining and/or modifying them according to a specific 7268*** set of operations. All module expressions will be evaluated generating 7269*** modules with such module expressions as names. In the case of parameterized 7270*** modules, each of the parameters in an interface will be used as the name 7271*** of a new module created as a renamed copy of the parameter theory. 7272 7273*** 7274*** Module Expressions 7275*** 7276 7277*** The \texttt{TUPLE} and \texttt{POWER} are declared to be new types of 7278*** \texttt{ModuleExpression}s. 7279 7280------------------------------------------------------------------------------- 7281******************************************************************************* 7282------------------------------------------------------------------------------- 7283 7284fmod MOD-EXPR is 7285 inc META-MODULE . 7286 pr FMAP . 7287 7288 op TUPLE`[_`] : NzNat -> ModuleExpression . 7289 op POWER`[_`] : NzNat -> ModuleExpression . 7290 7291 eq ME:ModuleExpression * ( none ) = ME:ModuleExpression . 7292 7293endfm 7294 7295------------------------------------------------------------------------------- 7296******************************************************************************* 7297------------------------------------------------------------------------------- 7298 7299*** 7300*** Module Names 7301*** 7302 7303*** As we shall see in the coming sections, the evaluation of module 7304*** expressions may produce the creation of new modules, whose \emph{names} 7305*** are given by the module expressions themselves. If there is already a 7306*** module in the database with the module expression being evaluated as name, 7307*** the evaluation of such module expression does not produce any change in 7308*** the database. However, the evaluation of a module expression may involve 7309*** the evaluation of some other module expressions contained in the modules 7310*** involved, which in turn may generate new modules. 7311 7312*** Given a parameterized module $\texttt{N\{L}_1\texttt{\ ::\ T}_1 7313*** \texttt{\ ,\ }\ldots\texttt{\ ,\ L}_n\texttt{\ ::\ T}_n\texttt{\}}$, with 7314*** $\texttt{L}_1\ldots\texttt{L}_n$ labels and 7315*** $\texttt{T}_1\ldots\texttt{T}_n$ theory identifiers, we say that 7316*** \texttt{N} is the name of the module and that 7317*** $\texttt{\{L}_1\texttt{\ ::\ T}_1\texttt{\ ,\ } 7318*** \ldots\texttt{\ ,\ L}_n\texttt{\ ::\ T}_n\texttt{\}}$ 7319*** is its \emph{interface}. 7320*** As we shall see in Sections~\ref{instantiation} and~\ref{unit-processing}, 7321*** for each parameter $\texttt{L}_i\texttt{\ ::\ T}_i$ in the interface of a 7322*** module, a new module is generated with such a parameter expression as its 7323*** name, and a declaration importing it in the parameterized module is added. 7324*** We regard the relationship between the body of a parameterized module and 7325*** the parameters in its interface, not as an inclusion, but as mediated by 7326*** a module constructor that generates renamed copies of the parameters, 7327*** which are then included. Therefore, the sort \texttt{ViewExp} is 7328*** declared as a subsort of \texttt{Header}, that is, terms of sort 7329*** \texttt{ViewExp} are considered to be module names. The constructor 7330*** operator for the sort \texttt{ViewExp} is \verb~par_::_~. 7331 7332------------------------------------------------------------------------------- 7333******************************************************************************* 7334------------------------------------------------------------------------------- 7335 7336fmod MOD-NAME is 7337 inc MOD-EXPR . 7338 pr EXT-BOOL . 7339 op parameterError : QidList -> [ParameterDecl] . 7340 7341 sort ModuleName . 7342 subsorts ModuleExpression < ModuleName < Header . 7343 op _{_} : ModuleExpression ParameterDeclList -> Header . 7344 op pd : ParameterDecl -> ModuleName . 7345 op nullHeader : -> Header . 7346 7347 op getName : Header -> ModuleExpression . 7348 op getParDecls : Header -> ParameterDeclList . 7349 7350 vars QI QI' : Qid . 7351 var ME : ModuleExpression . 7352 vars PDL PDL' : ParameterDeclList . 7353 var PL : NeParameterList . 7354 var MN : ModuleName . 7355 7356 eq getName(ME{PDL}) = ME . 7357 eq getName(MN) = MN . 7358 eq getParDecls(ME{PDL}) = PDL . 7359 eq getParDecls(MN) = nil . 7360 7361 op including_. : ModuleName -> Import [ctor] . 7362 op extending_. : ModuleName -> Import [ctor] . 7363 op protecting_. : ModuleName -> Import [ctor] . 7364 7365 op fth_is_sorts_.____endfth : Header ImportList SortSet SubsortDeclSet 7366 OpDeclSet MembAxSet EquationSet -> FTheory [ctor gather (& & & & & & &) 7367 format (d d d n++i ni d d ni ni ni ni n--i d)] . 7368 op th_is_sorts_._____endth : Header ImportList SortSet SubsortDeclSet 7369 OpDeclSet MembAxSet EquationSet RuleSet -> STheory 7370 [ctor gather (& & & & & & & &) 7371 format (d d d n++i ni d d ni ni ni ni ni n--i d)] . 7372 7373*** The function \texttt{labelInParameterDeclList} checks whether the quoted 7374*** identifier given as first argument is used as a label in the list of 7375*** parameters given as second argument. 7376 7377 op labelInParameterDeclList : Sort ParameterDeclList -> Bool . 7378 eq labelInParameterDeclList(QI, (PDL, (QI :: ME), PDL')) = true . 7379 eq labelInParameterDeclList(QI, PDL) = false [owise] . 7380 7381endfm 7382 7383------------------------------------------------------------------------------- 7384******************************************************************************* 7385------------------------------------------------------------------------------- 7386 7387*** Since the Core Maude engine assumes that module names are identifiers and 7388*** does not know about term-structured module names (such as parameterized 7389*** module interfaces or module expressions), for evaluation purposes we need 7390*** to transform them into quoted identifiers. The functions 7391*** \texttt{header2Qid} and \texttt{header2QidList} in the module 7392*** \texttt{MOD-NAME-TO-QID} below accomplish this transformation. In any 7393*** language extensions, new equations for the function 7394*** \texttt{header2QidList} should be added for each new module expression 7395*** constructor introduced. In Sections~\ref{renaming} and~\ref{instantiation} 7396*** we shall see how the corresponding equalities are added for renaming and 7397*** instantiation expressions, and in Section~\ref{extension} for other new 7398*** module expressions in extensions of Full Maude. 7399 7400------------------------------------------------------------------------------- 7401******************************************************************************* 7402------------------------------------------------------------------------------- 7403 7404fmod MOD-NAME-TO-QID is 7405 pr MOD-NAME . 7406 pr EXT-QID-LIST . 7407 7408 op header2Qid : Header -> Qid . 7409 op header2QidList : Header -> QidList . 7410 op parameterDecl2Qid : ParameterDecl -> Qid . 7411 op parameterDecl2QidList : ParameterDecl -> QidList . 7412 op parameterDeclList2Qid : ParameterDeclList -> Qid . 7413 op parameterDeclList2QidList : ParameterDeclList -> QidList . 7414 7415 vars QI X : Qid . 7416 var QIL : QidList . 7417 vars ME ME' : ModuleExpression . 7418 var PDL : ParameterDeclList . 7419 var PD : ParameterDecl . 7420 7421 eq header2Qid(QI) = QI . 7422 eq header2Qid(nullHeader) = ' . 7423 eq header2Qid(pd(X :: ME)) = qidList2Qid(header2QidList(pd(X :: ME))) . 7424 eq header2QidList(pd(X :: ME)) = X ':: header2QidList(ME) . 7425 7426 eq header2QidList(QI) = QI . 7427 eq header2QidList(nullHeader) = ' . 7428 7429 eq header2Qid((ME { PDL })) = qidList2Qid(header2QidList((ME { PDL }))) . 7430 ceq header2QidList((ME { PDL })) 7431 = (if QI == '\s then QIL else QIL QI fi 7432 '`{ parameterDecl2QidList(PDL) '`} '\s) 7433 if QIL QI := header2QidList(ME) . 7434 7435 eq parameterDecl2Qid(X :: ME) = qidList2Qid(X ':: header2Qid(ME)) . 7436 7437 eq parameterDeclList2Qid(PDL) 7438 = qidList2Qid(parameterDeclList2QidList(PDL)) . 7439 7440 eq parameterDeclList2QidList(X :: ME) = X ':: header2QidList(ME) . 7441 eq parameterDeclList2QidList((X :: ME, PDL)) 7442 = parameterDeclList2QidList(X :: ME) '`, parameterDeclList2QidList(PDL) 7443 [owise] . 7444endfm 7445 7446------------------------------------------------------------------------------- 7447******************************************************************************* 7448------------------------------------------------------------------------------- 7449 7450*** 7451*** Modules 7452*** 7453 7454*** We handle six different types of units: functional, system, and 7455*** object-oriented modules, and functional, system, and object-oriented 7456*** theories. Modules and theories of any kind are considered to be elements 7457*** in specific subsorts of the sort \texttt{Module}. A constructor 7458*** \texttt{error} is also included to represent incorrect units. 7459*** \texttt{error} has a list of quoted identifiers as argument, which is 7460*** used to report the error. Besides considering functional and system 7461*** theories and object-oriented theories and modules, the declarations 7462*** presented in the following module extend the declarations for sort 7463*** \texttt{Module} in the \texttt{META-LEVEL} module in three different ways: 7464 7465*** \begin{itemize} 7466*** \item the name of a module can be any term of sort \texttt{Header}, 7467*** \item parameterized modules are handled, for which a list of 7468*** parameters is added to the constructors of modules, 7469*** \item the importation declaration is extended to module names, and 7470*** \item parameterized sorts are supported. 7471*** \end{itemize} 7472 7473------------------------------------------------------------------------------- 7474******************************************************************************* 7475------------------------------------------------------------------------------- 7476 7477fmod UNIT is 7478 pr EXT-DECL . 7479 pr O-O-DECL . 7480 pr MOD-NAME-TO-QID . 7481--- inc META-LEVEL + PRE-VARIANT . 7482 inc META-LEVEL . 7483 7484 op moduleName : Import -> ModuleName . 7485 eq moduleName(protecting MN .) = MN . 7486 eq moduleName(protecting ME{PL} .) = ME . 7487 eq moduleName(extending MN .) = MN . 7488 eq moduleName(extending ME{PL} .) = ME . 7489 eq moduleName(including MN .) = MN . 7490 eq moduleName(including ME{PL} .) = ME . 7491 7492 op importError : QidList -> [ImportList] [ctor format (r o)] . 7493 eq importError(QIL) importError(QIL') = importError(QIL QIL') . 7494 7495 sorts OModule OTheory . 7496 subsorts SModule < OModule < Module . 7497 subsorts STheory < OTheory < Module . 7498 7499 op noModule : -> Module . *** Module 7500 op unitError : QidList -> [Module] [ctor format (r o)] . 7501 op getMsg : [Module] -> QidList . 7502 eq getMsg(unitError(QIL)) = QIL . 7503 7504 op omod_is_sorts_.________endom : Header ImportList 7505 SortSet SubsortDeclSet ClassDeclSet SubclassDeclSet OpDeclSet 7506 MsgDeclSet MembAxSet EquationSet RuleSet -> OModule 7507 [ctor 7508 gather (& & & & & & & & & & &) 7509 format (r! o r! n++io ni d d ni ni ni ni ni ni ni ni n--ir! o)] . 7510 op oth_is_sorts_.________endoth : Header ImportList 7511 SortSet SubsortDeclSet ClassDeclSet SubclassDeclSet OpDeclSet 7512 MsgDeclSet MembAxSet EquationSet RuleSet -> OTheory 7513 [ctor 7514 gather (& & & & & & & & & & &) 7515 format (r! o r! n++io ni d d ni ni ni ni ni ni ni ni n--ir! o)] . 7516 7517*** In addition to the constructor operators, the following functions are 7518*** introduced in the \texttt{UNIT} module: 7519*** \begin{itemize} 7520*** \item A function \verb~_in_~ to check whether a given importation 7521*** declaration is in a set of importation declarations or not. 7522 7523 op _in_ : Import ImportList -> Bool . 7524 7525*** \item Selector functions for the different components of a Module. 7526 7527 op getName : Module -> Header . 7528 op getPars : Module -> ParameterDeclList . 7529 op getClasses : Module -> ClassDeclSet . 7530 op getSubclasses : Module -> SubclassDeclSet . 7531 op getMsgs : Module -> MsgDeclSet . 7532 7533*** \item Functions to change the value of each of the components of a Module. 7534 7535 op setName : Module ModuleExpression -> Module . 7536 op setName : Module ParameterDecl -> Module . 7537 op setPars : Module ParameterDeclList -> Module . 7538 op setImports : Module ImportList -> Module . 7539 op setSorts : Module SortSet -> Module . 7540 op setSubsorts : Module SubsortDeclSet -> Module . 7541 op setOps : Module OpDeclSet -> Module . 7542 op setMbs : Module MembAxSet -> Module . 7543 op setEqs : Module EquationSet -> Module . 7544 op setRls : Module RuleSet ~> Module . 7545 op setClasses : Module ClassDeclSet -> Module . 7546 op setSubclasses : Module SubclassDeclSet -> Module . 7547 op setMsgs : Module MsgDeclSet -> Module . 7548 7549*** \item Functions to add new declarations to the set of declarations 7550*** already in a unit. 7551 7552 op addImports : ImportList Module -> Module . 7553 op addSorts : SortSet Module -> Module . 7554 op addSubsorts : [SubsortDeclSet] Module -> Module . 7555 op addOps : [OpDeclSet] Module -> Module . 7556 op addMbs : MembAxSet Module -> Module . 7557 op addEqs : EquationSet Module -> Module . 7558 op addRls : RuleSet Module -> Module . 7559 op addClasses : ClassDeclSet Module -> Module . 7560 op addSubclasses : SubclassDeclSet Module -> Module . 7561 op addMsgs : MsgDeclSet Module -> Module . 7562 7563*** \item There are functions and constants to create empty modules of the 7564*** different types. For example, the function \texttt{emptyFTheory} 7565*** returns an empty functional theory. There is also a 7566*** function \texttt{empty} which takes a module as argument and returns 7567*** an empty module of the same type. 7568 7569 op emptyFModule : Header -> FModule . 7570 op emptyFModule : -> FModule . 7571 op emptySModule : -> SModule . 7572 op emptyOModule : -> OModule . 7573 op emptyFTheory : -> FModule . 7574 op emptySTheory : -> SModule . 7575 op emptyOTheory : -> OModule . 7576 op empty : Module -> Module . 7577 7578*** \item A function \texttt{addDecls} which returns the module resulting from 7579*** adding all the declarations in the module passed as second argument 7580*** to the module passed as first argument. 7581 7582 op addDecls : Module Module -> Module . 7583 7584*** \end{itemize} 7585 7586*** Note that some of the `set' and `add' functions are partial functions. 7587 7588 vars M M' M'' : Module . 7589 vars QI V : Qid . 7590 var S : Sort . 7591 vars SSDS SSDS' SSDS'' : SubsortDeclSet . 7592 vars OPD OPD' : OpDecl . 7593 vars OPDS OPDS' : OpDeclSet . 7594 var OPDS? : [OpDeclSet] . 7595 var At : Attr . 7596 var AtS : AttrSet . 7597 vars MAS MAS' MbS : MembAxSet . 7598 vars Eq Eq' : Equation . 7599 vars EqS EqS' : EquationSet . 7600 vars Rl Rl' : Rule . 7601 vars RlS RlS' : RuleSet . 7602 vars SS SS' : SortSet . 7603 vars IL IL' : ImportList . 7604 vars QIL QIL' : QidList . 7605 vars PL PL' : ParameterList . 7606 vars CDS CDS' : ClassDeclSet . 7607 vars SCD SCD' : SubclassDecl . 7608 vars SCDS SCDS' : SubclassDeclSet . 7609 vars U U' : Module . 7610 vars MDS MDS' : MsgDeclSet . 7611 vars I I' : Import . 7612 vars T T' T1 T1' T2 T2' : Term . 7613 vars ME ME' : ModuleExpression . 7614 vars PD PD' : ParameterDecl . 7615 vars PDL PDL' : ParameterDeclList . 7616 var H : Header . 7617 vars MN MN' : ModuleName . 7618 var Cd Cond Cond1 Cond2 : Condition . 7619 7620 eq I in (IL I IL') = true . 7621 eq I in IL = false [owise] . 7622 7623 op theory : Module -> Bool . 7624 eq theory(unitError(QIL)) = false . 7625 eq theory(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = false . 7626 eq theory(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = true . 7627 eq theory(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = false . 7628 eq theory(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) = true . 7629 eq theory(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 7630 = false . 7631 eq theory(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 7632 = true . 7633 7634*** Selection functions for units 7635 7636 eq getName(unitError(QIL)) = ' . 7637 eq getName(noModule) = ' . 7638 eq getName(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = ME . 7639 eq getName(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = ME . 7640 eq getName(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = MN . 7641 ----eq getName(th PD is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = PD . 7642 eq getName(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm) = ME . 7643 eq getName(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm) = ME . 7644 eq getName(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) = MN . 7645 eq getName( 7646 omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 7647 = ME . 7648 eq getName( 7649 omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 7650 = ME . 7651 eq getName( 7652 oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 7653 = MN . 7654 7655 eq getImports(unitError(QIL)) = nil . 7656 eq getImports(noModule) = nil . 7657 eq getImports(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = IL . 7658 eq getImports(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = IL . 7659 eq getImports(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = IL . 7660 eq getImports(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = IL . 7661 eq getImports( 7662 omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 7663 = IL . 7664 eq getImports( 7665 oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 7666 = IL . 7667 7668 eq getPars(unitError(QIL)) = nil . 7669 eq getPars(noModule) = nil . 7670 eq getPars(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = nil . 7671 eq getPars(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = PDL . 7672 eq getPars(mod nullHeader is IL sorts SS . SSDS OPDS MAS EqS RlS endm) 7673 = nil . 7674 eq getPars(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = nil . 7675 eq getPars(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = nil . 7676 eq getPars(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm) = nil . 7677 eq getPars(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm) = PDL . 7678 eq getPars(fmod nullHeader is IL sorts SS . SSDS OPDS MAS EqS endfm) = nil . 7679 eq getPars(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) = nil . 7680 eq getPars( 7681 omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 7682 = nil . 7683 eq getPars( 7684 omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS 7685 endom) 7686 = PDL . 7687 eq getPars( 7688 omod nullHeader is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS 7689 endom) 7690 = nil . 7691 eq getPars( 7692 oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 7693 = nil . 7694 7695 eq getSorts(unitError(QIL)) = none . 7696 eq getSorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = SS . 7697 eq getSorts(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = SS . 7698 eq getSorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = SS . 7699 eq getSorts(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = SS . 7700 eq getSorts( 7701 omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 7702 = SS . 7703 eq getSorts( 7704 oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 7705 = SS . 7706 7707 op getAllSorts : Module -> SortSet . 7708 eq getAllSorts(M) = getSorts(M) . 7709 7710 eq getSubsorts(unitError(QIL)) = none . 7711 eq getSubsorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = SSDS . 7712 eq getSubsorts(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = SSDS . 7713 eq getSubsorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = SSDS . 7714 eq getSubsorts(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = SSDS . 7715 eq getSubsorts( 7716 omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 7717 = SSDS . 7718 eq getSubsorts( 7719 oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 7720 = SSDS . 7721 7722 eq getOps(unitError(QIL)) = none . 7723 eq getOps(noModule) = none . 7724 eq getOps(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = OPDS . 7725 eq getOps(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = OPDS . 7726 eq getOps(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = OPDS . 7727 eq getOps(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = OPDS . 7728 eq getOps(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 7729 = OPDS . 7730 eq getOps(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 7731 = OPDS . 7732 7733 eq getMbs(unitError(QIL)) = none . 7734 eq getMbs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = MAS . 7735 eq getMbs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = MAS . 7736 eq getMbs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = MAS . 7737 eq getMbs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = MAS . 7738 eq getMbs(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 7739 = MAS . 7740 eq getMbs(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 7741 = MAS . 7742 7743 eq getEqs(unitError(QIL)) = none . 7744 eq getEqs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = EqS . 7745 eq getEqs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = EqS . 7746 eq getEqs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = EqS . 7747 eq getEqs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = EqS . 7748 eq getEqs(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 7749 = EqS . 7750 eq getEqs(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 7751 = EqS . 7752 7753 eq getRls(unitError(QIL)) = none . 7754 eq getRls(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = RlS . 7755 eq getRls(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = RlS . 7756 eq getRls(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none . 7757 eq getRls(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none . 7758 eq getRls(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 7759 = RlS . 7760 eq getRls(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 7761 = RlS . 7762 7763 eq getClasses(unitError(QIL)) = none . 7764 eq getClasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = none . 7765 eq getClasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = none . 7766 eq getClasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none . 7767 eq getClasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none . 7768 eq getClasses( 7769 omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 7770 = CDS . 7771 eq getClasses( 7772 oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 7773 = CDS . 7774 7775 eq getSubclasses(unitError(QIL)) = none . 7776 eq getSubclasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = none . 7777 eq getSubclasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = none . 7778 eq getSubclasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none . 7779 eq getSubclasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none . 7780 eq getSubclasses( 7781 omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 7782 = SCDS . 7783 eq getSubclasses( 7784 oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 7785 = SCDS . 7786 7787 eq getMsgs(unitError(QIL)) = none . 7788 eq getMsgs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = none . 7789 eq getMsgs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = none . 7790 eq getMsgs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none . 7791 eq getMsgs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none . 7792 eq getMsgs(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 7793 = MDS . 7794 eq getMsgs(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 7795 = MDS . 7796 7797*** Set functions 7798 7799 eq setImports(unitError(QIL), IL) = unitError(QIL) . 7800 eq setImports(noModule, IL) = noModule . 7801 eq setImports(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, IL') 7802 = mod H is IL' sorts SS . SSDS OPDS MAS EqS RlS endm . 7803 eq setImports(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, IL') 7804 = th H is IL' sorts SS . SSDS OPDS MAS EqS RlS endth . 7805 eq setImports(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, IL') 7806 = fmod H is IL' sorts SS . SSDS OPDS MAS EqS endfm . 7807 eq setImports(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, IL') 7808 = fth H is IL' sorts SS . SSDS OPDS MAS EqS endfth . 7809 eq setImports( 7810 omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, IL') 7811 = omod H is IL' sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom . 7812 eq setImports( 7813 oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, IL') 7814 = oth H is IL' sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth . 7815 7816 eq setOps(unitError(QIL), OPDS) = unitError(QIL) . 7817 eq setOps(noModule, OPDS) = noModule . 7818 eq setOps(U, opDeclError(QIL) OPDS) = unitError(QIL) . 7819 eq setOps(unitError(QIL), opDeclError(QIL') OPDS) = unitError(QIL QIL') . 7820 eq setOps(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, OPDS') 7821 = mod H is IL sorts SS . SSDS OPDS' MAS EqS RlS endm . 7822 eq setOps(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, OPDS') 7823 = th MN is IL sorts SS . SSDS OPDS' MAS EqS RlS endth . 7824 eq setOps(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, OPDS') 7825 = fmod H is IL sorts SS . SSDS OPDS' MAS EqS endfm . 7826 eq setOps(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, OPDS') 7827 = fth MN is IL sorts SS . SSDS OPDS' MAS EqS endfth . 7828 eq setOps(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 7829 OPDS') 7830 = omod H is IL sorts SS . SSDS CDS SCDS OPDS' MDS MAS EqS RlS endom . 7831 eq setOps(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 7832 OPDS') 7833 = oth MN is IL sorts SS . SSDS CDS SCDS OPDS' MDS MAS EqS RlS endoth . 7834 7835 eq setSubsorts(unitError(QIL), SSDS) = unitError(QIL) . 7836 eq setSubsorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SSDS') 7837 = mod H is IL sorts SS . SSDS' OPDS MAS EqS RlS endm . 7838 eq setSubsorts(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, SSDS') 7839 = th MN is IL sorts SS . SSDS' OPDS MAS EqS RlS endth . 7840 eq setSubsorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, SSDS') 7841 = fmod H is IL sorts SS . SSDS' OPDS MAS EqS endfm . 7842 eq setSubsorts(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, SSDS') 7843 = fth MN is IL sorts SS . SSDS' OPDS MAS EqS endfth . 7844 eq setSubsorts( 7845 omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 7846 SSDS') 7847 = omod H is IL sorts SS . SSDS' CDS SCDS OPDS MDS MAS EqS RlS endom . 7848 eq setSubsorts( 7849 oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 7850 SSDS') 7851 = oth MN is IL sorts SS . SSDS' CDS SCDS OPDS MDS MAS EqS RlS endoth . 7852 7853 eq setMbs(unitError(QIL), membAxError(QIL') MAS) = unitError(QIL QIL') . 7854 eq setMbs(unitError(QIL), MAS) = unitError(QIL) . 7855 eq setMbs(U, membAxError(QIL) MAS) = unitError(QIL) . 7856 eq setMbs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, MAS') 7857 = mod H is IL sorts SS . SSDS OPDS MAS' EqS RlS endm . 7858 eq setMbs(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MAS') 7859 = th MN is IL sorts SS . SSDS OPDS MAS' EqS RlS endth . 7860 eq setMbs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, MAS') 7861 = fmod H is IL sorts SS . SSDS OPDS MAS' EqS endfm . 7862 eq setMbs(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, MAS') 7863 = fth MN is IL sorts SS . SSDS OPDS MAS' EqS endfth . 7864 eq setMbs( 7865 omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, MAS') 7866 = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS' EqS RlS endom . 7867 eq setMbs( 7868 oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, MAS') 7869 = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS' EqS RlS endoth . 7870 7871 eq setEqs(unitError(QIL), EqS) = unitError(QIL) . 7872 eq setEqs(U, equationError(QIL) EqS?:[EquationSet]) = unitError(QIL) . 7873 eq setEqs(unitError(QIL), equationError(QIL') EqS?:[EquationSet]) 7874 = unitError(QIL QIL') . 7875 eq setEqs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, EqS') 7876 = mod H is IL sorts SS . SSDS OPDS MAS EqS' RlS endm . 7877 eq setEqs(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, EqS') 7878 = th MN is IL sorts SS . SSDS OPDS MAS EqS' RlS endth . 7879 eq setEqs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, EqS') 7880 = fmod H is IL sorts SS . SSDS OPDS MAS EqS' endfm . 7881 eq setEqs(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, EqS') 7882 = fth MN is IL sorts SS . SSDS OPDS MAS EqS' endfth . 7883 eq setEqs( 7884 omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, EqS') 7885 = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS' RlS endom . 7886 eq setEqs( 7887 oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, EqS') 7888 = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS' RlS endoth . 7889 7890 var U? : [Module] . 7891 var RlS? : [RuleSet] . 7892 7893 eq setRls(unitError(QIL), RlS?) = unitError(QIL) . 7894 eq setRls(U?, ruleError(QIL) RlS?) = unitError(QIL) . 7895 eq setRls(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, RlS') 7896 = mod H is IL sorts SS . SSDS OPDS MAS EqS RlS' endm . 7897 eq setRls(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, RlS') 7898 = th MN is IL sorts SS . SSDS OPDS MAS EqS RlS' endth . 7899 eq setRls(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, RlS) 7900 = if RlS == none 7901 then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm 7902 else mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm 7903 fi . 7904 eq setRls(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, RlS) 7905 = if RlS == none 7906 then fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth 7907 else th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth 7908 fi . 7909 eq setRls(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 7910 RlS') 7911 = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS' endom . 7912 eq setRls(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 7913 RlS') 7914 = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS' endoth . 7915 7916 eq setSorts(unitError(QIL), SS) = unitError(QIL) . 7917 eq setSorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SS') 7918 = mod H is IL sorts SS' . SSDS OPDS MAS EqS RlS endm . 7919 eq setSorts(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, SS') 7920 = th MN is IL sorts SS' . SSDS OPDS MAS EqS RlS endth . 7921 eq setSorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, SS') 7922 = fmod H is IL sorts SS' . SSDS OPDS MAS EqS endfm . 7923 eq setSorts(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, SS') 7924 = fth MN is IL sorts SS' . SSDS OPDS MAS EqS endfth . 7925 eq setSorts( 7926 omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, SS') 7927 = omod H is IL sorts SS' . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom . 7928 eq setSorts( 7929 oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, SS') 7930 = oth MN is IL sorts SS' . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth . 7931 7932 eq setPars(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm, PDL) 7933 = if PDL == nil 7934 then mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm 7935 else mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm 7936 fi . 7937 eq setPars(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm, PDL') 7938 = if PDL' == nil 7939 then mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm 7940 else mod ME{PDL'} is IL sorts SS . SSDS OPDS MAS EqS RlS endm 7941 fi . 7942 eq setPars(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, PDL) 7943 = th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth . 7944 eq setPars(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm, PDL) 7945 = if PDL == nil 7946 then fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm 7947 else fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm 7948 fi . 7949 eq setPars(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm, PDL') 7950 = if PDL' == nil 7951 then fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm 7952 else fmod ME{PDL'} is IL sorts SS . SSDS OPDS MAS EqS endfm 7953 fi . 7954 eq setPars(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, PDL) 7955 = fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth . 7956 eq setPars( 7957 omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 7958 PDL) 7959 = if PDL == nil 7960 then omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom 7961 else omod ME{PDL} is 7962 IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS 7963 endom 7964 fi . 7965 eq setPars( 7966 omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 7967 PDL') 7968 = if PDL' == nil 7969 then omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom 7970 else omod ME{PDL'} is 7971 IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS 7972 endom 7973 fi . 7974 eq setPars( 7975 oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 7976 PDL) 7977 = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth . 7978 7979 eq setClasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, CDS) 7980 = if CDS == none 7981 then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm 7982 else omod H is IL sorts SS . SSDS CDS none OPDS none MAS EqS none endom 7983 fi . 7984 eq setClasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, CDS) 7985 = if CDS == none 7986 then fth H is IL sorts SS . SSDS OPDS MAS EqS endfth 7987 else oth H is IL sorts SS . SSDS CDS none OPDS none MAS EqS none endoth 7988 fi . 7989 eq setClasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, CDS) 7990 = if CDS == none 7991 then mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm 7992 else omod H is IL sorts SS . SSDS CDS none OPDS none MAS EqS RlS endom 7993 fi . 7994 eq setClasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, CDS) 7995 = if CDS == none 7996 then th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth 7997 else oth H is IL sorts SS . SSDS CDS none OPDS none MAS EqS RlS endoth 7998 fi . 7999 eq setClasses( 8000 omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 8001 CDS') 8002 = omod H is IL sorts SS . SSDS CDS' SCDS OPDS MDS MAS EqS RlS endom . 8003 eq setClasses( 8004 oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 8005 CDS') 8006 = oth H is IL sorts SS . SSDS CDS' SCDS OPDS MDS MAS EqS RlS endoth . 8007 eq setClasses(M, CDS) 8008 = unitError(header2QidList(getName(M)) 'not 'an 'object-oriented 'module) 8009 [owise] . 8010 8011 eq setSubclasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, SCDS) 8012 = if SCDS == none 8013 then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm 8014 else omod H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS none endom 8015 fi . 8016 eq setSubclasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, SCDS) 8017 = if SCDS == none 8018 then fth H is IL sorts SS . SSDS OPDS MAS EqS endfth 8019 else oth H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS none endoth 8020 fi . 8021 eq setSubclasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SCDS) 8022 = if SCDS == none 8023 then mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm 8024 else omod H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS RlS endom 8025 fi . 8026 eq setSubclasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, SCDS) 8027 = if SCDS == none 8028 then th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth 8029 else oth H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS RlS endoth 8030 fi . 8031 eq setSubclasses( 8032 omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, SCDS') 8033 = omod H is IL sorts SS . SSDS CDS SCDS' OPDS MDS MAS EqS RlS endom . 8034 eq setSubclasses( 8035 oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 8036 SCDS') 8037 = oth H is IL sorts SS . SSDS CDS SCDS' OPDS MDS MAS EqS RlS endoth . 8038 eq setSubclasses(M, SCDS) 8039 = unitError(header2QidList(getName(M)) 'not 'an 'object-oriented 'module) 8040 [owise] . 8041 8042 eq setMsgs( 8043 fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, MDS) 8044 = if MDS == none 8045 then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm 8046 else omod H is IL sorts SS . SSDS none none OPDS MDS MAS EqS none endom 8047 fi . 8048 eq setMsgs( 8049 fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, MDS) 8050 = if MDS == none 8051 then fth H is IL sorts SS . SSDS OPDS MAS EqS endfth 8052 else oth H is IL sorts SS . SSDS none none OPDS MDS MAS EqS none endoth 8053 fi . 8054 eq setMsgs( 8055 mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, MDS) 8056 = if MDS == none 8057 then mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm 8058 else omod H is IL sorts SS . SSDS none none OPDS MDS MAS EqS RlS endom 8059 fi . 8060 eq setMsgs( 8061 th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MDS) 8062 = if MDS == none 8063 then th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth 8064 else oth H is IL sorts SS . SSDS none none OPDS MDS MAS EqS RlS endoth 8065 fi . 8066 eq setMsgs( 8067 omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, MDS') 8068 = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS' MAS EqS RlS endom . 8069 eq setMsgs( 8070 oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, MDS') 8071 = oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS' MAS EqS RlS endoth . 8072 eq setMsgs(M, MDS) 8073 = unitError(header2QidList(getName(M)) 'not 'an 'object-oriented 'module) 8074 [owise] . 8075 8076 eq setName(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm, ME') 8077 = mod ME' is IL sorts SS . SSDS OPDS MAS EqS RlS endm . 8078 eq setName(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm, ME') 8079 = mod ME'{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm . 8080 eq setName(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm, ME') 8081 = fmod ME' is IL sorts SS . SSDS OPDS MAS EqS endfm . 8082 eq setName(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm, ME') 8083 = fmod ME'{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm . 8084 eq setName(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, MN') 8085 = fth MN' is IL sorts SS . SSDS OPDS MAS EqS endfth . 8086 eq setName(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MN') 8087 = th MN' is IL sorts SS . SSDS OPDS MAS EqS RlS endth . 8088 eq setName(omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, ME') 8089 = omod ME' is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom . 8090 eq setName(omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, ME') 8091 = omod ME'{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom . 8092 eq setName(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, MN') 8093 = oth MN' is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth . 8094 eq setName(noModule, ME) = noModule . 8095 eq setName(unitError(QIL), ME) = unitError(QIL) . 8096 8097 eq setName(mod nullHeader is IL sorts SS . SSDS OPDS MAS EqS RlS endm, ME') 8098 = mod ME' is IL sorts SS . SSDS OPDS MAS EqS RlS endm . 8099 eq setName(fmod nullHeader is IL sorts SS . SSDS OPDS MAS EqS endfm, ME') 8100 = fmod ME' is IL sorts SS . SSDS OPDS MAS EqS endfm . 8101 eq setName(fth nullHeader is IL sorts SS . SSDS OPDS MAS EqS endfth, MN) 8102 = fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth . 8103 eq setName(th nullHeader is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MN) 8104 = th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth . 8105 eq setName( 8106 omod nullHeader is 8107 IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS 8108 endom, 8109 ME') 8110 = omod ME' is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom . 8111 eq setName( 8112 oth nullHeader is 8113 IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 8114 MN) 8115 = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth . 8116 eq setName(noModule, ME) = noModule . 8117 eq setName(unitError(QIL), ME) = unitError(QIL) . 8118 8119*** Add functions 8120 8121 eq addSorts(SS, U) = setSorts(U, (SS ; getSorts(U))) . 8122 eq addSorts(SS, unitError(QIL)) = unitError(QIL) . 8123 8124 eq addSubsorts(SSDS, U) = setSubsorts(U, (SSDS getSubsorts(U))) . 8125 eq addSubsorts(subsortDeclError(QIL), U) = unitError(QIL) . 8126 eq addSubsorts(SSDS, unitError(QIL)) = unitError(QIL) . 8127 8128 eq addOps(OPDS, U) = setOps(U, (OPDS getOps(U))) . 8129 eq addOps(OPDS?, unitError(QIL)) = unitError(QIL) . 8130 eq addOps(OPDS?, U) = U [owise] . 8131 8132 eq addMbs(MAS, U) = setMbs(U, (MAS getMbs(U))) . 8133 eq addMbs(MAS, unitError(QIL)) = unitError(QIL) . 8134 eq addEqs(EqS, U) = setEqs(U, (EqS getEqs(U))) . 8135 eq addEqs(EqS, unitError(QIL)) = unitError(QIL) . 8136 eq addRls(RlS, U) = setRls(U, (RlS getRls(U))) . 8137 eq addRls(RlS, unitError(QIL)) = unitError(QIL) . 8138 eq addRls(ruleError(QIL), U) = unitError(QIL) . 8139 eq addImports(IL, U) = setImports(U, (getImports(U) IL)) . 8140 eq addImports(IL, unitError(QIL)) = unitError(QIL) . 8141 eq addClasses(CDS, U) = setClasses(U, (getClasses(U) CDS)) . 8142 eq addClasses(CDS, unitError(QIL)) = unitError(QIL) . 8143 eq addSubclasses(SCDS, U) = setSubclasses(U, (getSubclasses(U) SCDS)) . 8144 eq addSubclasses(SCDS, unitError(QIL)) = unitError(QIL) . 8145 eq addMsgs(MDS, U) = setMsgs(U, (getMsgs(U) MDS)) . 8146 eq addMsgs(MDS, unitError(QIL)) = unitError(QIL) . 8147 8148*** Creation of empty units 8149 8150 eq emptyFModule(ME) 8151 = fmod header2Qid(ME) is nil sorts none . none none none none endfm . 8152 eq emptyFModule 8153 = fmod nullHeader is nil sorts none . none none none none endfm . 8154 eq emptySModule 8155 = mod nullHeader is nil sorts none . none none none none none endm . 8156 eq emptyOModule 8157 = omod nullHeader is 8158 nil sorts none . none none none none none none none none 8159 endom . 8160 eq emptyFTheory 8161 = fth nullHeader is nil sorts none . none none none none endfth . 8162 eq emptySTheory 8163 = th nullHeader is nil sorts none . none none none none none endth . 8164 eq emptyOTheory 8165 = oth nullHeader is 8166 nil sorts none . none none none none none none none none 8167 endoth . 8168 8169*** \texttt{empty} returns an empty unit of the same type of the one given as 8170*** argument. 8171 8172 eq empty(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) 8173 = (mod H is nil sorts none . none none none none none endm) . 8174 eq empty(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) 8175 = (th MN is nil sorts none . none none none none none endth) . 8176 eq empty(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) 8177 = (fmod H is nil sorts none . none none none none endfm) . 8178 eq empty(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) 8179 = (fth MN is nil sorts none . none none none none endfth) . 8180 eq empty(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 8181 = (omod H is 8182 nil sorts none . none none none none none none none none 8183 endom) . 8184 eq empty(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 8185 = (oth MN is 8186 nil sorts none . none none none none none none none none 8187 endoth) . 8188 8189*** In the following \texttt{addDecls} function, the declarations of the unit 8190*** given as second argument are added to the unit given as first argument. 8191 8192 eq addDecls(noModule, U) = U . 8193 eq addDecls(U, noModule) = U . 8194 eq addDecls(unitError(QIL), U) = unitError(QIL) . 8195 eq addDecls(U, unitError(QIL)) = unitError(QIL) . 8196 eq addDecls(U, U') 8197 = addImports(getImports(U'), 8198 addSorts(getSorts(U'), 8199 addSubsorts(getSubsorts(U'), 8200 addOps(getOps(U'), 8201 addMbs(getMbs(U'), 8202 addEqs(getEqs(U'), 8203 if U' :: FModule or U' :: FTheory 8204 then U 8205 else addRls(getRls(U'), 8206 if U' :: SModule or U' :: STheory 8207 then U 8208 else addClasses(getClasses(U'), 8209 addSubclasses(getSubclasses(U'), 8210 addMsgs(getMsgs(U'), U))) 8211 fi) 8212 fi)))))) 8213 [owise] . 8214 8215 op removeNonExecs : Module -> Module . 8216 op removeNonExecs : MembAxSet -> MembAxSet . 8217 op removeNonExecs : EquationSet -> EquationSet . 8218 op removeNonExecs : RuleSet -> RuleSet . 8219 8220 ceq removeNonExecs(M) 8221 = setRls(M'', removeNonExecs(getRls(M))) 8222 if M' := setMbs(M, removeNonExecs(getMbs(M))) 8223 /\ M'' := setEqs(M', removeNonExecs(getEqs(M))) . 8224 eq removeNonExecs(unitError(QIL)) = unitError(QIL) . 8225 8226 eq removeNonExecs(mb T : S [nonexec AtS] . MbS) = removeNonExecs(MbS) . 8227 eq removeNonExecs(cmb T : S if Cd [nonexec AtS] . MbS) = removeNonExecs(MbS) . 8228 eq removeNonExecs(MbS) = MbS [owise] . 8229 8230 eq removeNonExecs(eq T = T' [nonexec AtS] . EqS) = removeNonExecs(EqS) . 8231 eq removeNonExecs(ceq T = T' if Cd [nonexec AtS] . EqS) = removeNonExecs(EqS) . 8232 eq removeNonExecs(EqS) = EqS [owise] . 8233 8234 eq removeNonExecs(rl T => T' [nonexec AtS] . RlS) = removeNonExecs(RlS) . 8235 eq removeNonExecs(crl T => T' if Cd [nonexec AtS] . RlS) = removeNonExecs(RlS) . 8236 eq removeNonExecs(RlS) = RlS [owise] . 8237 8238 *** moreGeneralEqs ****************************** 8239 ---- An equation is more general than other if there is a substitution such that 8240 ---- the more general equation with such a substitution applied is equal to the 8241 ---- less general one. 8242 op moreGeneralEqs : Module -> Module . 8243 op moreGeneralRls : Module -> Module . 8244 op $moreGeneralEqs : Module Module EquationSet EquationSet -> Module . 8245 op $moreGeneralRls : Module Module RuleSet RuleSet -> Module . 8246 op $moreGeneral : Module Equation Equation -> Bool . 8247 op $moreGeneral : Module Rule Rule -> Bool . 8248 op $moreGeneral : Module Condition Condition Term Term -> Bool . 8249 8250 eq moreGeneralEqs(M) 8251 = $moreGeneralEqs( 8252 M, 8253 addOps((op '@/\@ : '@@@ '@@@ -> '@@@ [assoc] . 8254 op '@--@ : 'Universal -> '@@@ [poly(1)] . 8255 op '@--@ : 'Universal 'Universal -> '@@@ [poly(1 2)] .), 8256 addSorts('@@@, M)), 8257 getEqs(M), getEqs(M)) . 8258 eq moreGeneralRls(M) 8259 = $moreGeneralRls( 8260 M, 8261 addOps((op '@/\@ : '@@@ '@@@ -> '@@@ [assoc] . 8262 op '@--@ : 'Universal -> '@@@ [poly(1)] . 8263 op '@--@ : 'Universal 'Universal -> '@@@ [poly(1 2)] .), 8264 addSorts('@@@, M)), 8265 getRls(M), getRls(M)) . 8266 8267 ceq $moreGeneralEqs(M, M', Eq EqS, Eq Eq' EqS') 8268 = $moreGeneralEqs(M, M', EqS, Eq' EqS') 8269 if $moreGeneral(M', Eq', Eq) . 8270 eq $moreGeneralEqs(M, M', EqS, EqS') = setEqs(M, EqS') [owise] . 8271 8272 ceq $moreGeneralRls(M, M', Rl RlS, Rl Rl' RlS') 8273 = $moreGeneralRls(M, M', RlS, Rl' RlS') 8274 if $moreGeneral(M', Rl', Rl) . 8275 eq $moreGeneralRls(M, M', RlS, RlS') = setRls(M, RlS') [owise] . 8276 8277 eq $moreGeneral(M, Eq, Eq') 8278 = sameKind(M, leastSort(M, lhs(Eq)), leastSort(M, lhs(Eq'))) 8279 and-then 8280 $moreGeneral(M, cond(Eq), cond(Eq'), '@--@[lhs(Eq), rhs(Eq)], '@--@[lhs(Eq'), rhs(Eq')]) . 8281 8282 eq $moreGeneral(M, Rl, Rl') 8283 = sameKind(M, leastSort(M, lhs(Rl)), leastSort(M, lhs(Rl'))) 8284 and-then 8285 $moreGeneral(M, cond(Rl), cond(Rl'), '@--@[lhs(Rl), rhs(Rl)], '@--@[lhs(Rl'), rhs(Rl')]) . 8286 8287 eq $moreGeneral(M, T1 = T1' /\ Cond1, T2 = T2' /\ Cond2, T, T') 8288 = sameKind(M, leastSort(M, T1), leastSort(M, T2)) 8289 and-then 8290 $moreGeneral(M, Cond1, Cond2, '@/\@['@--@[T1, T1'], T], '@/\@['@--@[T2, T2'], T']) . 8291 eq $moreGeneral(M, T1 := T1' /\ Cond1, T2 := T2' /\ Cond2, T, T') 8292 = sameKind(M, leastSort(M, T1), leastSort(M, T2)) 8293 and-then 8294 $moreGeneral(M, Cond1, Cond2, '@/\@['@--@[T1, T1'], T], '@/\@['@--@[T2, T2'], T']) . 8295 eq $moreGeneral(M, T1 => T1' /\ Cond1, T2 => T2' /\ Cond2, T, T') 8296 = sameKind(M, leastSort(M, T1), leastSort(M, T2)) 8297 and-then 8298 $moreGeneral(M, Cond1, Cond2, '@/\@['@--@[T1, T1'], T], '@/\@['@--@[T2, T2'], T']) . 8299 eq $moreGeneral(M, T1 : S /\ Cond1, T2 : S /\ Cond2, T, T') 8300 = $moreGeneral(M, Cond1, Cond2, '@/\@['@--@[T1], T], '@/\@['@--@[T2], T']) . 8301 8302 eq $moreGeneral(M, nil, nil, T, T') = metaMatch(M, T, T', nil, 0) =/= noMatch . 8303 eq $moreGeneral(M, Cond1, Cond2, T, T') = false [owise] . 8304 8305 op rmVariantAttrs : Module -> Module . 8306 op $rmVariants : EquationSet -> EquationSet . 8307 op $rmVariants : RuleSet -> RuleSet . 8308 op $rmVariants : MembAxSet -> MembAxSet . 8309 eq rmVariantAttrs(M) = setRls(setEqs(setMbs(M, $rmVariants(getMbs(M))), $rmVariants(getEqs(M))), $rmVariants(getRls(M))) . 8310 eq rmVariantAttrs(unitError(QIL)) = unitError(QIL) . 8311 8312 eq $rmVariants(eq T = T' [variant AtS] . EqS) = (eq T = T' [variant AtS] .) $rmVariants(EqS) . 8313 eq $rmVariants(ceq T = T' if Cond [variant AtS] . EqS) = (ceq T = T' if Cond [variant AtS] .) $rmVariants(EqS) . 8314 eq $rmVariants(EqS) = EqS [owise] . 8315 8316 eq $rmVariants(rl T => T' [variant AtS] . RlS) = (rl T => T' [variant AtS] .) $rmVariants(RlS) . 8317 eq $rmVariants(crl T => T' if Cond [variant AtS] . RlS) = (crl T => T' if Cond [variant AtS] .) $rmVariants(RlS) . 8318 eq $rmVariants(RlS) = RlS [owise] . 8319 8320 eq $rmVariants(mb T : S [variant AtS] . MbS) = (mb T : S [variant AtS] .) $rmVariants(MbS) . 8321 eq $rmVariants(cmb T : S if Cond [variant AtS] . MbS) = (cmb T : S if Cond [variant AtS] .) $rmVariants(MbS) . 8322 eq $rmVariants(MbS) = MbS [owise] . 8323endfm 8324 8325------------------------------------------------------------------------------- 8326 8327fmod AX-COHERENCE-COMPLETION is 8328 inc UNIT . 8329---- inc MODULE-HANDLING * (op addOps to addOpsSE, op addEqs to addEqsSE, op addSorts to addSortsSE) . 8330 8331 vars V W : Variable . 8332 var C : Constant . 8333 var FM : FModule . 8334 var SM : SModule . 8335 var M : Module . 8336 var N : Nat . 8337 vars T T' T'' LHS RHS : Term . 8338 vars Subst Subst' : Substitution . 8339 var F : Qid . 8340 var TL : TermList . 8341 vars AtS AtS' : AttrSet . 8342---- var VFS : VariantFourSet . 8343 vars Tp Tp' Tp'' : Type . 8344 var TpL : TypeList . 8345 var Rl : Rule . 8346 var RlS : RuleSet . 8347 var Eq : Equation . 8348 var EqS : EquationSet . 8349 var ODS : OpDeclSet . 8350 var Cond : Condition . 8351 var QIL : QidList . 8352 8353 ------------------------------------------------------------------------------ 8354 ---- coherence completion 8355 ------------------------------------------------------------------------------ 8356 8357 op axCohComplete : SModule -> SModule . 8358 op axCohComplete : SModule OpDeclSet RuleSet -> RuleSet . 8359 op axCohCompleteAux : SModule OpDeclSet RuleSet -> RuleSet . 8360 op axCohComplete : SModule Type AttrSet Rule -> RuleSet . 8361 op axCohComplete : SModule OpDeclSet EquationSet -> EquationSet . 8362 op axCohCompleteAux : SModule OpDeclSet EquationSet -> EquationSet . 8363 op axCohComplete : SModule Type AttrSet Equation -> EquationSet . 8364 8365 eq axCohComplete(FM) 8366 = moreGeneralEqs(setEqs(FM, axCohComplete(FM, getOps(FM), getEqs(FM)))) . 8367 eq axCohComplete(SM) 8368 = moreGeneralEqs( 8369 moreGeneralRls( 8370 setRls( 8371 setEqs(SM, 8372 axCohComplete(SM, getOps(SM), getEqs(SM))), 8373 axCohComplete(SM, getOps(SM), getRls(SM))))) 8374 [owise] . 8375 eq axCohComplete(unitError(QIL)) = unitError(QIL) . 8376 8377 ceq axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, rl F[TL] => RHS [AtS'] . RlS) 8378 = axCohComplete(M, Tp, assoc AtS, rl F[TL] => RHS [AtS'] .) 8379 axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, RlS) 8380 if sameKindAll(M, Tp, eLeastSort(M, TL)) . 8381 ceq axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, crl F[TL] => RHS if Cond [AtS'] . RlS) 8382 = axCohComplete(M, Tp, assoc AtS, crl F[TL] => RHS if Cond [AtS'] .) 8383 axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, RlS) 8384 if sameKindAll(M, Tp, eLeastSort(M, TL)) . 8385 eq axCohComplete(M, ODS, RlS) = axCohCompleteAux(M, ODS, RlS) [owise] . 8386 8387 ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, rl LHS => RHS [AtS'] . RlS) 8388 = axCohComplete(M, Tp, assoc id(T) AtS, rl F[LHS] => RHS [AtS'] .) 8389 axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, RlS) 8390 if sameKindAll(M, Tp, leastSort(M, LHS)) . 8391 ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, crl LHS => RHS if Cond [AtS'] . RlS) 8392 = axCohComplete(M, Tp, assoc id(T) AtS, crl F[LHS] => RHS if Cond [AtS'] .) 8393 axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, RlS) 8394 if sameKindAll(M, Tp, leastSort(M, LHS)) . 8395 ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, rl LHS => RHS [AtS'] . RlS) 8396 = axCohComplete(M, Tp, assoc left-id(T) AtS, rl F[LHS] => RHS [AtS'] .) 8397 axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, RlS) 8398 if sameKindAll(M, Tp, leastSort(M, LHS)) . 8399 ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, crl LHS => RHS if Cond [AtS'] . RlS) 8400 = axCohComplete(M, Tp, assoc left-id(T) AtS, crl F[LHS] => RHS if Cond [AtS'] .) 8401 axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, RlS) 8402 if sameKindAll(M, Tp, leastSort(M, LHS)) . 8403 ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, rl LHS => RHS [AtS'] . RlS) 8404 = axCohComplete(M, Tp, assoc right-id(T) AtS, rl F[LHS] => RHS [AtS'] .) 8405 axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, RlS) 8406 if sameKindAll(M, Tp, leastSort(M, LHS)) . 8407 ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, crl LHS => RHS if Cond [AtS'] . RlS) 8408 = axCohComplete(M, Tp, assoc right-id(T) AtS, crl F[LHS] => RHS if Cond [AtS'] .) 8409 axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, RlS) 8410 if sameKindAll(M, Tp, leastSort(M, LHS)) . 8411 eq axCohCompleteAux(M, ODS, RlS) = RlS [owise] . 8412 8413 ceq axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, eq F[TL] = RHS [AtS'] . EqS) 8414 = axCohComplete(M, Tp, assoc AtS, eq F[TL] = RHS [AtS'] .) 8415 axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, EqS) 8416 if sameKindAll(M, Tp, eLeastSort(M, TL)) . 8417 ceq axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, ceq F[TL] = RHS if Cond [AtS'] . EqS) 8418 = axCohComplete(M, Tp, assoc AtS, ceq F[TL] = RHS if Cond [AtS'] .) 8419 axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, EqS) 8420 if sameKindAll(M, Tp, eLeastSort(M, TL)) . 8421 eq axCohComplete(M, ODS, EqS) = axCohCompleteAux(M, ODS, EqS) [owise] . 8422 8423 ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, eq LHS = RHS [AtS'] . EqS) 8424 = axCohComplete(M, Tp, assoc id(T) AtS, eq F[LHS] = RHS [AtS'] .) 8425 axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, EqS) 8426 if sameKindAll(M, Tp, leastSort(M, LHS)) . 8427 ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, ceq LHS = RHS if Cond [AtS'] . EqS) 8428 = axCohComplete(M, Tp, assoc id(T) AtS, ceq F[LHS] = RHS if Cond [AtS'] .) 8429 axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, EqS) 8430 if sameKindAll(M, Tp, leastSort(M, LHS)) . 8431 ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, eq LHS = RHS [AtS'] . EqS) 8432 = axCohComplete(M, Tp, assoc left-id(T) AtS, eq F[LHS] = RHS [AtS'] .) 8433 axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, EqS) 8434 if sameKindAll(M, Tp, leastSort(M, LHS)) . 8435 ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, ceq LHS = RHS if Cond [AtS'] . EqS) 8436 = axCohComplete(M, Tp, assoc left-id(T) AtS, ceq F[LHS] = RHS if Cond [AtS'] .) 8437 axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, EqS) 8438 if sameKindAll(M, Tp, leastSort(M, LHS)) . 8439 ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, eq LHS = RHS [AtS'] . EqS) 8440 = axCohComplete(M, Tp, assoc right-id(T) AtS, eq F[LHS] = RHS [AtS'] .) 8441 axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, EqS) 8442 if sameKindAll(M, Tp, leastSort(M, LHS)) . 8443 ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, ceq LHS = RHS if Cond [AtS'] . EqS) 8444 = axCohComplete(M, Tp, assoc right-id(T) AtS, ceq F[LHS] = RHS if Cond [AtS'] .) 8445 axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, EqS) 8446 if sameKindAll(M, Tp, leastSort(M, LHS)) . 8447 eq axCohCompleteAux(M, ODS, EqS) = EqS [owise] . 8448 8449 ceq axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, eq F[TL] = RHS [AtS'] . EqS) 8450 = axCohComplete(M, Tp, assoc AtS, eq F[TL] = RHS [AtS'] .) 8451 axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, EqS) 8452 if sameKind(M, Tp, Tp') 8453 /\ sameKind(M, Tp', Tp'') 8454 /\ sameKindAll(M, Tp, eLeastSort(M, TL)) . 8455 ceq axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, ceq F[TL] = RHS if Cond [AtS'] . EqS) 8456 = axCohComplete(M, Tp, assoc AtS, ceq F[TL] = RHS if Cond [AtS'] .) 8457 axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, EqS) 8458 if sameKind(M, Tp, Tp') 8459 /\ sameKind(M, Tp', Tp'') 8460 /\ sameKindAll(M, Tp, eLeastSort(M, TL)) . 8461 eq axCohComplete(M, ODS, eq LHS = RHS [AtS] . EqS) 8462 = eq LHS = RHS [AtS] . axCohComplete(M, ODS, EqS) 8463 [owise] . 8464 eq axCohComplete(M, ODS, ceq LHS = RHS if Cond [AtS] . EqS) 8465 = ceq LHS = RHS if Cond [AtS] . axCohComplete(M, ODS, EqS) 8466 [owise] . 8467 eq axCohComplete(M, ODS, (none).EquationSet) = none . 8468 8469 ---- Given f(t1,...,tn) -> r if C 8470 ---- if f AC add f(t1,...,tn,x:[s]) -> f(r,x:[s]) if C 8471 eq axCohComplete(M, Tp, assoc comm AtS, rl F[TL] => RHS [AtS'] .) 8472 = (rl F[TL] => RHS [AtS'] .) 8473 (rl F[TL, qid("X@@@:" + string(getKind(M, Tp)))] => getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) [AtS'] .) 8474 [owise] . 8475 eq axCohComplete(M, Tp, assoc comm AtS, crl F[TL] => RHS if Cond [AtS'] .) 8476 = (crl F[TL] => RHS if Cond [AtS'] .) 8477 (crl F[TL, qid("X@@@:" + string(getKind(M, Tp)))] => getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) 8478 [owise] . 8479 ---- if f ACU replace by f(t1,...,tn,x:[s]) -> f(r,x:[s]) if C 8480 eq axCohComplete(M, Tp, assoc comm id(T) AtS, rl F[TL] => RHS [AtS'] .) 8481 = (rl F[TL, qid("X@@@:" + string(getKind(M, Tp)))] => getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) [AtS'] .) . 8482 eq axCohComplete(M, Tp, assoc comm id(T) AtS, crl F[TL] => RHS if Cond [AtS'] .) 8483 = (crl F[TL, qid("X@@@:" + string(getKind(M, Tp)))] => getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) . 8484 ---- if f AU replace by f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C 8485 ceq axCohComplete(M, Tp, assoc id(T) AtS, rl F[TL] => RHS [AtS'] .) 8486 = (rl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8487 => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .) 8488 if not comm in AtS . 8489 ceq axCohComplete(M, Tp, assoc id(T) AtS, crl F[TL] => RHS if Cond [AtS'] .) 8490 = (crl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8491 => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) 8492 if not comm in AtS . 8493 ---- if f ALU replace by f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C 8494 ---- and add f(x:[s],t1,...,tn) -> f(x:[s],r) if C 8495 eq axCohComplete(M, Tp, assoc left-id(T) AtS, rl F[TL] => RHS [AtS'] .) 8496 = (rl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8497 => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .) 8498 (rl F[qid("X@@@:" + string(getKind(M, Tp))), TL] 8499 => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) [AtS'] .) . 8500 eq axCohComplete(M, Tp, assoc left-id(T) AtS, crl F[TL] => RHS if Cond [AtS'] .) 8501 = (crl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8502 => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) 8503 (crl F[qid("X@@@:" + string(getKind(M, Tp))), TL] 8504 => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) if Cond [AtS'] .) . 8505 ---- if f ARU replace by f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C 8506 ---- and add f(t1,...,tn,y:[s]) -> f(r,y:[s]) if C 8507 eq axCohComplete(M, Tp, assoc right-id(T) AtS, rl F[TL] => RHS [AtS'] .) 8508 = (rl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8509 => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .) 8510 (rl F[TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8511 => getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .) . 8512 eq axCohComplete(M, Tp, assoc right-id(T) AtS, crl F[TL] => RHS if Cond [AtS'] .) 8513 = (crl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8514 => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) 8515 (crl F[TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8516 => getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) . 8517 ---- if f A add f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C 8518 ---- f(x:[s],t1,...,tn) -> f(x:[s],r) if C 8519 ---- f(t1,...,tn,y:[s]) -> f(r,y:[s]) if C 8520 ceq axCohComplete(M, Tp, assoc AtS, rl F[TL] => RHS [AtS'] .) 8521 = (rl F[TL] => RHS [AtS'] .) 8522 (rl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8523 => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .) 8524 (rl F[qid("X@@@:" + string(getKind(M, Tp))), TL] 8525 => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) [AtS'] .) 8526 (rl F[TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8527 => getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .) 8528 if not comm in AtS 8529 [owise] . 8530 ceq axCohComplete(M, Tp, assoc AtS, crl F[TL] => RHS if Cond [AtS'] .) 8531 = (crl F[TL] => RHS if Cond [AtS'] .) 8532 (crl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8533 => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) 8534 (crl F[qid("X@@@:" + string(getKind(M, Tp))), TL] 8535 => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) if Cond [AtS'] .) 8536 (crl F[TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8537 => getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) 8538 if not comm in AtS 8539 [owise] . 8540 8541 ---- Given f(t1,...,tn) -> r if C 8542 ---- if f AC add f(t1,...,tn,x:[s]) -> f(r,x:[s]) if C 8543 eq axCohComplete(M, Tp, assoc comm AtS, eq F[TL] = RHS [AtS'] .) 8544 = (eq F[TL] = RHS [AtS'] .) 8545 (eq F[TL, qid("X@@@:" + string(getKind(M, Tp)))] = getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) [AtS'] .) 8546 [owise] . 8547 eq axCohComplete(M, Tp, assoc comm AtS, ceq F[TL] = RHS if Cond [AtS'] .) 8548 = (ceq F[TL] = RHS if Cond [AtS'] .) 8549 (ceq F[TL, qid("X@@@:" + string(getKind(M, Tp)))] = getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) 8550 [owise] . 8551 ---- if f ACU replace by f(t1,...,tn,x:[s]) -> f(r,x:[s]) if C 8552 eq axCohComplete(M, Tp, assoc comm id(T) AtS, eq F[TL] = RHS [AtS'] .) 8553 = (eq F[TL, qid("X@@@:" + string(getKind(M, Tp)))] = getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) [AtS'] .) . 8554 eq axCohComplete(M, Tp, assoc comm id(T) AtS, ceq F[TL] = RHS if Cond [AtS'] .) 8555 = (ceq F[TL, qid("X@@@:" + string(getKind(M, Tp)))] = getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) . 8556 ---- if f AU replace by f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C 8557 ceq axCohComplete(M, Tp, assoc id(T) AtS, eq F[TL] = RHS [AtS'] .) 8558 = (eq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8559 = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .) 8560 if not comm in AtS . 8561 ceq axCohComplete(M, Tp, assoc id(T) AtS, ceq F[TL] = RHS if Cond [AtS'] .) 8562 = (ceq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8563 = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) 8564 if not comm in AtS . 8565 ---- if f ALU replace by f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C 8566 ---- and add f(x:[s],t1,...,tn) -> f(x:[s],r) if C 8567 eq axCohComplete(M, Tp, assoc left-id(T) AtS, eq F[TL] = RHS [AtS'] .) 8568 = (eq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8569 = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .) 8570 (eq F[qid("X@@@:" + string(getKind(M, Tp))), TL] 8571 = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) [AtS'] .) . 8572 eq axCohComplete(M, Tp, assoc left-id(T) AtS, ceq F[TL] = RHS if Cond [AtS'] .) 8573 = (ceq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8574 = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) 8575 (ceq F[qid("X@@@:" + string(getKind(M, Tp))), TL] 8576 = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) if Cond [AtS'] .) . 8577 ---- if f ARU replace by f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C 8578 ---- and add f(t1,...,tn,y:[s]) -> f(r,y:[s]) if C 8579 eq axCohComplete(M, Tp, assoc right-id(T) AtS, eq F[TL] = RHS [AtS'] .) 8580 = (eq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8581 = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .) 8582 (eq F[TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8583 = getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .) . 8584 eq axCohComplete(M, Tp, assoc right-id(T) AtS, ceq F[TL] = RHS if Cond [AtS'] .) 8585 = (ceq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8586 = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) 8587 (ceq F[TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8588 = getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) . 8589 ---- if f A add f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C 8590 ---- f(x:[s],t1,...,tn) -> f(x:[s],r) if C 8591 ---- f(t1,...,tn,y:[s]) -> f(r,y:[s]) if C 8592 ceq axCohComplete(M, Tp, assoc AtS, eq F[TL] = RHS [AtS'] .) 8593 = (eq F[TL] = RHS [AtS'] .) 8594 (eq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8595 = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .) 8596 (eq F[qid("X@@@:" + string(getKind(M, Tp))), TL] 8597 = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) [AtS'] .) 8598 (eq F[TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8599 = getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .) 8600 if not comm in AtS 8601 [owise] . 8602 ceq axCohComplete(M, Tp, assoc AtS, ceq F[TL] = RHS if Cond [AtS'] .) 8603 = (ceq F[TL] = RHS if Cond [AtS'] .) 8604 (ceq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8605 = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) 8606 (ceq F[qid("X@@@:" + string(getKind(M, Tp))), TL] 8607 = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) if Cond [AtS'] .) 8608 (ceq F[TL, qid("Y@@@:" + string(getKind(M, Tp)))] 8609 = getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) 8610 if not comm in AtS 8611 [owise] . 8612endfm 8613 8614*** To parse some input using the built-in function \texttt{metaParse}, we 8615*** need to give the metarepresentation of the signature in which the input is 8616*** going to be parsed. 8617 8618*** But we do not need to give the complete metarepresentation of such a 8619*** module. In modules including \texttt{META-LEVEL} it is possible to define 8620*** terms of sort \texttt{Module} that import built-in modules or any module 8621*** introduced at the ``object level'' of Core Maude. In this way, it is 8622*** possible to get the equivalent effect of having the explicit 8623*** metarepresentation of a module by declaring a constant and adding an 8624*** equation identifying such a constant with the metarepresentation of an 8625*** extended module that imports the original module at the object level. 8626 8627*** The declaration of constructors for bubble sorts at the object level is 8628*** not supported in the current version of Core Maude. The \texttt{special} 8629*** attributes linking the constructors for the bubble sorts to the built-in 8630*** ones are only supported at the metalevel, that is, the declarations of the 8631*** constructor operators for bubble sorts have to be given in the 8632*** metarepresentation of a module. 8633 8634*** To allow the greatest generality and flexibility in future extensions of 8635*** Full Maude, we have declared its signature as a module 8636*** \texttt{FULL-MAUDE-SIGN}. Then, in the following module 8637*** \texttt{META-FULL-MAUDE-SIGN} we declare a constant \texttt{GRAMMAR} of 8638*** sort \texttt{FModule}, and we give an equation identifying such constant 8639*** with the metarepresentation of a module \texttt{GRAMMAR} in which there is 8640*** a declaration importing \texttt{FULL-MAUDE-SIGN}. Declarations for the 8641*** constructors of the bubble sorts are also included in this module. Note 8642*** that the bubble sorts \texttt{@Token@}, \texttt{@Bubble@}, 8643*** \texttt{@SortToken@}, and \texttt{@NeTokenList@} are declared in the 8644*** module \texttt{SIGN\&VIEW-EXPR}, which is imported by 8645*** \texttt{FULL-MAUDE-SIGN}. These sorts are used in the declarations 8646*** describing the syntax of the system. 8647 8648------------------------------------------------------------------------------- 8649******************************************************************************* 8650------------------------------------------------------------------------------- 8651 8652fmod META-FULL-MAUDE-SIGN is 8653--- including META-LEVEL + PRE-VARIANT . 8654 including META-LEVEL . 8655 including UNIT . 8656 8657 op BUBBLES : -> FModule . 8658 op GRAMMAR : -> FModule [memo] . 8659 8660 eq BUBBLES 8661 = (fmod 'GRAMMAR is 8662 including 'QID-LIST . 8663 sorts none . 8664 none 8665 op 'token : 'Qid -> '@Token@ 8666 [special( 8667 (id-hook('Bubble, '1 '1) 8668 op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] . 8669 op 'viewToken : 'Qid -> '@ViewToken@ 8670 [special( 8671 (id-hook('Bubble, '1 '1) 8672 op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] . 8673 op 'sortToken : 'Qid -> '@SortToken@ 8674 [special( 8675 (id-hook('Bubble, '1 '1) 8676 op-hook('qidSymbol, '<Qids>, nil, 'Qid) 8677 id-hook('Exclude, '`[ '`] '< 'to '`, '. '`( '`) '`{ '`} ': '| 8678 'ditto 'precedence 'prec 'gather 8679 'assoc 'associative 'comm 'commutative 8680 'ctor 'constructor 'id: 'strat 'strategy 8681 'poly 'memo 'memoization 'iter 'frozen 8682 'config 'object 'msg 'metadata 'nonexec 'variant)))] . 8683 op 'neTokenList : 'QidList -> '@NeTokenList@ 8684 [special( 8685 (id-hook('Bubble, '1 '-1 '`( '`)) 8686 op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList) 8687 op-hook('qidSymbol, '<Qids>, nil, 'Qid) 8688 id-hook('Exclude, '.)))] . 8689 op 'bubble : 'QidList -> '@Bubble@ 8690 [special( 8691 (id-hook('Bubble, '1 '-1 '`( '`)) 8692 op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList) 8693 op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] . 8694 none 8695 none 8696 endfm) . 8697 8698 eq GRAMMAR = addImports((including 'FULL-MAUDE-SIGN .), BUBBLES) . 8699 8700endfm 8701 8702------------------------------------------------------------------------------- 8703******************************************************************************* 8704------------------------------------------------------------------------------- 8705 8706 8707*** The \texttt{GRAMMAR} module will be used in calls to the \texttt{metaParse} 8708*** function in order to get the input parsed in this signature. Note that 8709*** this module is not the data type in which we shall represent the inputs. 8710*** From the call to \texttt{metaParse} we shall get a term representing the 8711*** parse tree of the input. This term will then be transformed into terms of 8712*** other appropriate data types if necessary. 8713 8714*** Future extensions to Full Maude will require extending the signature as 8715*** well. The addition of new commands, new module expressions, or additions 8716*** of any other kind will require adding new declarations to the present Full 8717*** Maude signature and defining the corresponding extensions to the data 8718*** types and functions to deal with the new cases introduced by the 8719*** extensions. 8720 8721------------------------------------------------------------------------------- 8722******************************************************************************* 8723------------------------------------------------------------------------------- 8724 8725*** 8726*** The Abstract Data Type \texttt{View} 8727*** 8728 8729*** In this section we present the data type \texttt{View} for views. 8730*** Basically, the data elements of sort \texttt{View} are composed by the 8731*** name of the view, the names of the source and target units, and a set of 8732*** maps representing the maps asserting how the given target unit is claimed 8733*** to satisfy the source theory (see Section~\ref{Views}). 8734 8735*** Internally, renaming maps are considered to be a particular case of view 8736*** maps. The sort \texttt{ViewMap} is declared as a supersort of 8737*** \texttt{Map}. The only kind of maps in sort \texttt{ViewMap} not in sort 8738*** \texttt{Map} are maps of operators going to derived operators. We start 8739*** introducing the declarations for renaming maps and sTS of renaming maps 8740*** in Section~\ref{renaming-maps}, we then introduce view maps and sTS of 8741*** view maps in Section~\ref{view-maps}, and finally we introduce the sort 8742*** \texttt{View}, its constructor, and some operations on it in 8743*** Section~\ref{viewADT}. 8744 8745*** 8746*** View Maps 8747*** 8748 8749*** In addition to the maps of sort \texttt{Renaming}, 8750*** in views there can also be maps from operators to derived 8751*** operators, that is, terms with variables (see Section~\ref{Views}). Maps 8752*** of this kind are given with the constructor \texttt{op_to`term_}, which, in 8753*** addition to the source and target terms, takes the set of variable 8754*** declarations for the variables used in the map. The source term must be of 8755*** the form $\texttt{F(X}_1\texttt{,}\ldots,\texttt{X}_n\texttt{)}$, where 8756*** \texttt{F} is an operator name declared with $n$ arguments of sorts in the 8757*** connected components of the variables $\texttt{X}_1\ldots\texttt{X}_n$, 8758*** respectively. We will see in Section~\ref{view-processing} how in the 8759*** initial processing of a view the variables declared in it are associated 8760*** to each of the maps in which they are used. 8761 8762 8763*** 8764*** Views 8765*** 8766 8767*** The \texttt{View} sort is introduced in the following module 8768*** \texttt{VIEW}. In addition to the constructor for views (\texttt{view}), 8769*** selector functions are added for each of the components of a 8770*** view (\texttt{name}, \texttt{source}, \texttt{target}, and 8771*** \texttt{mapSet}), and a constant \texttt{emptyView}, which is identified 8772*** in an equation with the empty view, is defined. 8773 8774*** Although the declaration of the constructor for views includes an argument 8775*** for the list of parameters, parameterized views are not handled yet, so at 8776*** present this argument must be set to the \texttt{nil}. 8777 8778------------------------------------------------------------------------------- 8779******************************************************************************* 8780------------------------------------------------------------------------------- 8781 8782fmod EXT-RENAMING is 8783 pr META-MODULE . 8784 8785 op op_to term_ : Term Term -> Renaming . 8786endfm 8787 8788------------------------------------------------------------------------------- 8789******************************************************************************* 8790------------------------------------------------------------------------------- 8791 8792fmod VIEW is 8793 ex META-VIEW . 8794 pr VIEW-EXPR . 8795 inc FMAP . 8796 8797 *** mappings 8798 op class_to_. : Sort Sort -> SortMapping . 8799 op attr_._to_. : Qid Sort Qid -> OpMapping . 8800 op msg_to_. : Qid Qid -> OpMapping . 8801 op msg_:_->_to_. : Qid TypeList Sort Qid -> OpMapping . 8802 8803 subsort ViewExp < Header . 8804 8805 op null : -> View [ctor] . 8806 op viewError : QidList -> [View] [ctor format (r o)] . 8807 8808 eq VE{(nil).ParameterDeclList} = VE . 8809 8810 vars A A' F F' Q Q' : Qid . 8811 var QIL : QidList . 8812 var VH : Header . 8813 var VE : ViewExp . 8814 vars PDL PDL' : ParameterDeclList . 8815 vars ME ME' ME'' : ModuleExpression . 8816 vars SMS SMS' : SortMappingSet . 8817 vars OMS OMS' : OpMappingSet . 8818 vars S S' C : Sort . 8819 var Ty : Type . 8820 var TyL : TypeList . 8821 vars T T' : Term . 8822 8823 op maps2rens : SortMappingSet -> RenamingSet . 8824 op maps2rens : OpMappingSet -> RenamingSet . 8825 eq maps2rens(sort S to S' . SMS) = sort S to S', maps2rens(SMS) . 8826 eq maps2rens(class S to S' . SMS) = class S to S', maps2rens(SMS) . 8827 eq maps2rens((none).SortMappingSet) = none . 8828 8829 eq maps2rens(op F to F' . OMS) = op F to F' [none], maps2rens(OMS) . 8830 eq maps2rens(op F : TyL -> Ty to F' . OMS) = op F : TyL -> Ty to F' [none], maps2rens(OMS) . 8831 eq maps2rens(op T to term T' . OMS) = op T to term T', maps2rens(OMS) . 8832 eq maps2rens(msg F to F' . OMS) = msg F to F' [none], maps2rens(OMS) . 8833 eq maps2rens(msg F : TyL -> Ty to F' . OMS) = msg F : TyL -> Ty to F' [none], maps2rens(OMS) . 8834 eq maps2rens(attr A . C to A' . OMS) = attr A . C to A', maps2rens(OMS) . 8835 eq maps2rens((none).OpMappingSet) = none . 8836 8837*** projection functions 8838 op getName : View -> Qid . 8839 eq getName(view VE from ME to ME' is SMS OMS endv) = VE [owise] . 8840 eq getName(view VE{PDL} from ME to ME' is SMS OMS endv) = VE . 8841 8842 op getPars : [View] -> ParameterDeclList . 8843 eq getPars(view VE from ME to ME' is SMS OMS endv) = nil [owise] . 8844 eq getPars(view VE{PDL} from ME to ME' is SMS OMS endv) = PDL . 8845 eq getPars(viewError(QIL)) = nil . 8846 8847 eq getFrom(view VH from ME to ME' is SMS OMS endv) = ME . 8848 eq getTo(view VH from ME to ME' is SMS OMS endv) = ME' . 8849 eq getSortMappings(view VH from ME to ME' is SMS OMS endv) = SMS . 8850 eq getOpMappings(view VH from ME to ME' is SMS OMS endv) = OMS . 8851 8852*** injection functions 8853 op setName : View Qid -> View . 8854 eq setName(view Q from ME to ME' is SMS OMS endv, Q') 8855 = view Q' from ME to ME' is SMS OMS endv . 8856 eq setName(view Q{PDL} from ME to ME' is SMS OMS endv, VH) = view VH{PDL} from ME to ME' is SMS OMS endv . 8857 eq setName(viewError(QIL), VE) = viewError(QIL) . 8858 8859 op setPars : [View] ParameterDeclList -> [View] . 8860 eq setPars(view VH from ME to ME' is SMS OMS endv, PDL) 8861 = view VH{PDL} from ME to ME' is SMS OMS endv [owise] . 8862 eq setPars(view VH{PDL} from ME to ME' is SMS OMS endv, PDL') = view VH{PDL'} from ME to ME' is SMS OMS endv . 8863 eq setPars(viewError(QIL), PDL) = viewError(QIL) . 8864 8865 op setFrom : View ModuleExpression -> View . 8866 eq setFrom(view VH from ME to ME' is SMS OMS endv, ME'') 8867 = view VH from ME'' to ME' is SMS OMS endv . 8868 eq setFrom(viewError(QIL), ME) = viewError(QIL) . 8869 8870 op setTo : View ModuleExpression -> View . 8871 eq setTo(view VH from ME to ME' is SMS OMS endv, ME'') 8872 = view VH from ME to ME'' is SMS OMS endv . 8873 eq setTo(viewError(QIL), ME) = viewError(QIL) . 8874 8875 op setSortMappings : View SortMappingSet -> View . 8876 eq setSortMappings(view VH from ME to ME' is SMS OMS endv, SMS') 8877 = view VH from ME to ME' is SMS' OMS endv . 8878 eq setSortMappings(viewError(QIL), SMS') = viewError(QIL) . 8879 8880 op setOpMappings : View OpMappingSet -> View . 8881 eq setOpMappings(view VH from ME to ME' is SMS OMS endv, OMS') 8882 = view VH from ME to ME' is SMS OMS' endv . 8883 eq setOpMappings(viewError(QIL), OMS') = viewError(QIL) . 8884 8885 op emptyView : Qid ModuleExpression ModuleExpression -> View . 8886 eq emptyView(VH, ME, ME') = view VH from ME to ME' is none none endv . 8887endfm 8888 8889------------------------------------------------------------------------------- 8890******************************************************************************* 8891------------------------------------------------------------------------------- 8892 8893*** 8894*** The Abstract Data Type \texttt{Database} 8895*** 8896 8897*** In this section we present the data type \texttt{Database}, which will be 8898*** used to store information about the units and views in the system. Before 8899*** discussing this data type in Section~\ref{databaseADT}, we present the 8900*** predefined units added in Full Maude to those already available in Core 8901*** Maude. 8902 8903*** 8904*** Non-Built-In Predefined Modules 8905*** 8906 8907*** As we shall see in the following section, except for the 8908*** \texttt{LOOP-MODE} module, all the predefined modules that are available 8909*** in Core Maude are also available in Full Maude. In addition to these Core 8910*** Maude predefined modules, in Full Maude there are some additional 8911*** predefined units. In the present system, the only units with which the 8912*** database is initialized are the functional theory \texttt{TRIV}, the 8913*** module \texttt{CONFIGURATION}, and the module \texttt{UP}, which will be 8914*** used to evaluate the \texttt{up} functions. We shall see in 8915*** Section~\ref{main-module} how new predefined modules can be added to the 8916*** initial database. 8917 8918------------------------------------------------------------------------------- 8919******************************************************************************* 8920------------------------------------------------------------------------------- 8921 8922fmod PREDEF-UNITS is 8923 pr UNIT . 8924 8925*** The following module \texttt{UP} contains the necessary declarations to 8926*** be able to parse the \texttt{up} functions presented in 8927*** Section~\ref{structured-specifications}. We shall see in 8928*** Section~\ref{evaluation} how a declaration importing the following module 8929*** \texttt{UP} is added to all the modules importing the predefined module 8930*** \texttt{META-LEVEL}. With this declaration, it is possible to parse the 8931*** \texttt{up} commands in the bubbles of such modules or in commands being 8932*** evaluated in such modules. We shall see in Section~\ref{bubble-parsing} 8933*** how these commands are then evaluated. 8934 8935 op #UP# : -> FModule [memo] . 8936 eq #UP# 8937 = (fmod '#UP# is 8938 including 'QID-LIST . 8939 including 'MOD-EXPRS . 8940 sorts none . 8941 none 8942 op 'upTerm : '@ModExp@ '@Bubble@ -> 'Term [none] . 8943 op 'upModule : '@ModExp@ -> 'Module [none] . 8944 op '`[_`] : '@Token@ -> 'Module [none] . 8945 op 'token : 'Qid -> '@Token@ 8946 [special( 8947 (id-hook('Bubble, '1 '1) 8948 op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] . 8949 op 'viewToken : 'Qid -> '@ViewToken@ 8950 [special( 8951 (id-hook('Bubble, '1 '1) 8952 op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] . 8953 op 'sortToken : 'Qid -> '@SortToken@ 8954 [special( 8955 (id-hook('Bubble, '1 '1) 8956 op-hook('qidSymbol, '<Qids>, nil, 'Qid) 8957 id-hook('Exclude, '`[ '`] '< 'to '`, '. '`( '`) '`{ '`} ': 8958 'ditto 'precedence 'prec 'gather 8959 'assoc 'associative 'comm 'commutative 8960 'ctor 'constructor 'id: 'strat 'strategy 8961 'poly 'memo 'memoization 'iter 'frozen 8962 'config 'object 'msg 'metadata 'nonexec 'variant)))] . 8963 op 'neTokenList : 'QidList -> '@NeTokenList@ 8964 [special( 8965 (id-hook('Bubble, '1 '-1 '`( '`)) 8966 op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList) 8967 op-hook('qidSymbol, '<Qids>, nil, 'Qid) 8968 id-hook('Exclude, '.)))] . 8969 op 'bubble : 'QidList -> '@Bubble@ 8970 [special( 8971 (id-hook('Bubble, '1 '-1 '`( '`)) 8972 op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList) 8973 op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] . 8974 none 8975 none 8976 endfm) . 8977endfm 8978 8979------------------------------------------------------------------------------- 8980******************************************************************************* 8981------------------------------------------------------------------------------- 8982 8983*** 8984*** 7 The Evaluation of Views 8985*** 8986 8987*** Before being entered into the database, besides containing bubbles, views 8988*** have a somewhat different structure from that of the views given in 8989*** Section~\ref{viewADT}. We introduce in the following module a sort 8990*** \texttt{PreView} with constructor \texttt{view}, which is declared as the 8991*** constructor for views of sort \texttt{View}, but with an additional 8992*** argument, namely, a set of variable declarations to hold the declarations 8993*** of variables in the view. During the processing of views (see 8994*** Section~\ref{view-processing}), which takes place once the parsing process 8995*** has concluded, these variables are associated with the corresponding maps 8996*** where they are used, generating a term of sort \texttt{View}. 8997 8998------------------------------------------------------------------------------- 8999******************************************************************************* 9000------------------------------------------------------------------------------- 9001 9002fmod PRE-VIEW is 9003 pr VIEW . 9004 9005 sort PreView . 9006 op preview_from_to_is___endpv : Header ModuleExpression 9007 ModuleExpression OpDeclSet SortMappingSet OpMappingSet -> PreView 9008 [ctor format (nir! o r! o r! o r! o o o r! o)] . 9009 op null : -> PreView . 9010 9011 op getName : PreView -> ViewExp . 9012 op getPars : PreView -> ParameterDeclList . 9013 op getFrom : PreView -> ModuleExpression . 9014 op getTo : PreView -> ModuleExpression . 9015 op getVars : PreView -> OpDeclSet . 9016 op getSortMappings : PreView -> SortMappingSet . 9017 op getOpMappings : PreView -> OpMappingSet . 9018 9019 var QI : Qid . 9020 vars ME ME' : ModuleExpression . 9021 var VE : ViewExp . 9022 var VH : Header . 9023 vars PDL PDL' : ParameterDeclList . 9024 vars VDS VDS' : OpDeclSet . 9025 vars SMS SMS' : SortMappingSet . 9026 vars OMS OMS' : OpMappingSet . 9027 9028 eq getName(preview VE from ME to ME' is VDS SMS OMS endpv) = VE . 9029 eq getName(preview VE{PDL} from ME to ME' is VDS SMS OMS endpv) = VE . 9030 eq getPars(preview VE from ME to ME' is VDS SMS OMS endpv) = nil . 9031 eq getPars(preview VE{PDL} from ME to ME' is VDS SMS OMS endpv) = PDL . 9032 eq getFrom(preview VH from ME to ME' is VDS SMS OMS endpv) = ME . 9033 eq getTo(preview VH from ME to ME' is VDS SMS OMS endpv) = ME' . 9034 eq getVars(preview VH from ME to ME' is VDS SMS OMS endpv) = VDS . 9035 eq getSortMappings(preview VH from ME to ME' is VDS SMS OMS endpv) = SMS . 9036 eq getOpMappings(preview VH from ME to ME' is VDS SMS OMS endpv) = OMS . 9037 9038*** The following functions can be used to add new declarations to the set of 9039*** declarations already in a preview. 9040 9041 op addMaps : SortMappingSet PreView -> PreView . 9042 op addMaps : OpMappingSet PreView -> PreView . 9043 op addVars : OpDeclSet PreView -> PreView . 9044 9045 eq addMaps(SMS, preview VH from ME to ME' is VDS SMS' OMS endpv) 9046 = preview VH from ME to ME' is VDS (SMS SMS') OMS endpv . 9047 eq addMaps(OMS, preview VH from ME to ME' is VDS SMS OMS' endpv) 9048 = preview VH from ME to ME' is VDS SMS (OMS OMS') endpv . 9049 9050 eq addVars(VDS, preview VH from ME to ME' is VDS' SMS OMS endpv) 9051 = preview VH from ME to ME' is (VDS VDS') SMS OMS endpv . 9052 9053 op setPars : PreView ParameterDeclList -> PreView . 9054 eq setPars(preview VE from ME to ME' is VDS SMS OMS endpv, PDL) 9055 = preview VE{PDL} from ME to ME' is VDS SMS OMS endpv . 9056 eq setPars(preview VE{PDL} from ME to ME' is VDS SMS OMS endpv, PDL') 9057 = preview VE{PDL'} from ME to ME' is VDS SMS OMS endpv . 9058 9059 op emptyPreView : Qid ModuleExpression ModuleExpression -> PreView . 9060 eq emptyPreView(QI, ME, ME') 9061 = preview QI from ME to ME' is none none none endpv . 9062endfm 9063 9064------------------------------------------------------------------------------- 9065******************************************************************************* 9066------------------------------------------------------------------------------- 9067 9068*** 9069*** The Database 9070*** 9071 9072*** In order to be able to refer to modules by name, which is extremely useful 9073*** for module definition purposes at the user level, the evaluation of module 9074*** expressions takes place in the context of a database, in which we keep 9075*** information about the modules already introduced in the system, and also 9076*** about those modules generated internally. This information is stored as 9077*** a set of elements of sort \texttt{ModuleInfo} and \texttt{ViewInfo}, in 9078*** which we hold, respectively, the information concerning units and views. 9079*** For each unit we save: 9080*** \begin{itemize} 9081*** \item Its original form, as introduced by the user, or, in case of an 9082*** internally generated unit, as generated from the original form of 9083*** some other unit. 9084*** \item Its internal representation, in which variables have been renamed 9085*** to avoid collisions with the names of variables in other units in 9086*** the same hierarchy. In the case of object-oriented units, we store 9087*** its equivalent system module, that is, the result of transforming 9088*** it into a system module. 9089*** \item Its signature, which is given as a functional module of sort 9090*** \texttt{FModule} with no axioms, ready to be used in calls to 9091*** \texttt{metaParse}. There can only be importation declarations 9092*** including built-in modules in this module. These are the only 9093*** inclusions handled by the Core Maude engine. 9094*** \item Its flattened version, for which, as for signatures, only the 9095*** importation of built-in modules is left unevaluated. 9096*** \end{itemize} 9097*** For each view we keep its name and the view itself. 9098 9099*** As a simple mechanism to keep the database consistent, for each unit we 9100*** maintain the list of names of all the units and views ``depending'' on it. 9101*** Similarly, for each view we maintain the list of names of all the units 9102*** ``depending'' on it. The idea is that if a unit or view is redefined or 9103*** removed, all those units and/or views depending on it will also be 9104*** removed. This dependency does not only mean direct importation. For 9105*** example, the module resulting from the renaming of some module also 9106*** depends on the module being renamed; the instantiation of a parameterized 9107*** module also depends on the parameterized module and on all the views used 9108*** in its instantiation; a view depends on its source and target units, etc. 9109*** This dependency is transitive: if a module, theory, or view has to be 9110*** removed, all the units and/or views depending on them will be removed as 9111*** well. The dependencies derived from the module expressions themselves are 9112*** established by the function \texttt{setUpModExpDeps}. The function 9113*** \texttt{setUpModuleDeps} calls \texttt{setUpModExpDeps}, 9114*** and then \texttt{setUpImportSetDeps} to add the \emph{back 9115*** references} in the modules being imported. The function 9116*** \texttt{setUpViewDeps} sTS up the back references for the views 9117*** being introduced. 9118 9119*** In addition to this set of information cells for units and views, we also 9120*** keep lists with the names of all the units and views in the database, and 9121*** a list of quoted identifiers in which we store the messages generated 9122*** during the process of treatment of the inputs in order to simplify the 9123*** communication with the read-eval-print loop process. 9124 9125------------------------------------------------------------------------------- 9126******************************************************************************* 9127------------------------------------------------------------------------------- 9128 9129view ModuleName from TRIV to MOD-NAME is 9130 sort Elt to ModuleName . 9131endv 9132 9133view ViewExp from TRIV to VIEW-EXPR is 9134 sort Elt to ViewExp . 9135endv 9136 9137view ParameterDecl from TRIV to META-MODULE is 9138 sort Elt to ParameterDecl . 9139endv 9140 9141fmod INFO is 9142 pr VIEW . 9143 pr DEFAULT-VALUE{Term} . 9144 pr (SET * (op _`,_ to _._, 9145 op empty to emptyModuleNameSet, 9146 op insert to insertModuleNameSet, 9147 op delete to deleteModuleNameSet, 9148 op _in_ to _inModuleNameSet_, 9149 op |_| to |_|ModuleNameSet, 9150 op $card to $cardModuleNameSet, 9151 op union to unionModuleNameSet, 9152 op intersection to intersectionModuleNameSet, 9153 op $intersect to $intersectModuleNameSet, 9154 op _\_ to _\ModuleNameSet_, 9155 op $diff to $diffModuleNameSet, 9156 op _subset_ to _subsetModuleNameSet_, 9157 op _psubset_ to _psubsetModuleNameSet_)){ModuleName} . 9158 pr (SET * (op _`,_ to _#_, 9159 op empty to emptyViewExpSet, 9160 op insert to insertViewExpSet, 9161 op delete to deleteViewExpSet, 9162 op _in_ to _inViewExpSet_, 9163 op |_| to |_|ViewExprSet, 9164 op $card to $cardViewExprSet, 9165 op union to unionViewExprSet, 9166 op intersection to intersectionViewExprSet, 9167 op $intersect to $intersectViewExprSet, 9168 op _\_ to _\ViewExprSet_, 9169 op $diff to $diffViewExprSet, 9170 op _subset_ to _subsetViewExprSet_, 9171 op _psubset_ to _psubsetViewExprSet_)){ViewExp} . 9172 pr (SET * (op _`,_ to _._)){ParameterDecl} . 9173 9174 var MN : ModuleName . 9175 var MNS : Set{ModuleName} . 9176 9177 op remove : Set{ModuleName} ModuleName -> Set{ModuleName} . 9178 eq remove(MN . MNS, MN) = remove(MNS, MN) . 9179 eq remove(MNS, MN) = MNS [owise] . 9180 9181 sort ModuleInfo . 9182 op <_;_;_;_;_;_;_;_> : ModuleName Default{Term} Module Module Module 9183 OpDeclSet Set{ModuleName} Set{ViewExp} -> ModuleInfo 9184 [ctor 9185 format 9186 (nig o g n+++io g nio g nio g nio g nio g nio g nio n---ig o)] . 9187 op <_;_;_;_;_;_;_;_> : ModuleName Module Module Module Module 9188 OpDeclSet Set{ModuleName} Set{ViewExp} -> ModuleInfo 9189 [ctor 9190 format 9191 (nig ur! g n+++io g nio g nio g nio g nio g nio g nio n---ig o)] . 9192 9193 *** - Modules can be introduced by the user or can be generated internally. 9194 *** When introduced by the user the 2nd arg. keeps the term representation 9195 *** of the module as given, so that it can be recompiled later. If the 9196 *** module is generated internally as the result of the evaluation of a 9197 *** module expression, then this second arg. will be null, the default 9198 *** term value. The user can also enter modules with the procModule 9199 *** function, providing then the metarepresentation of a module, which 9200 *** is directly stored in the database as the 2nd arg. of one of these 9201 *** ModuleInfo units of the second kind. This is useful for the ITP for 9202 *** example, where the interaction with the database takes place at the 9203 *** metalevel and the modules given by the "user" are already at the 9204 *** metalevel but still wants the same treatment. 9205 *** - The sixth arg. stores the variables (corresponding ops.) in the top 9206 *** module. 9207 9208 sort ViewInfo . 9209 op <_;_;_;_;_> : ViewExp Default{Term} View Set{ModuleName} 9210 Set{ViewExp} -> ViewInfo 9211 [ctor format (nig o g n+++io g nio g nio g nio n---ig o)] . 9212 op <_;_;_;_;_> : 9213 ViewExp View View Set{ModuleName} Set{ViewExp} -> ViewInfo 9214 [ctor format (nig o g n+++io g nio g nio g nio n---ig o)] . 9215 9216endfm 9217 9218view ModuleInfo from TRIV to INFO is 9219 sort Elt to ModuleInfo . 9220endv 9221 9222view ViewInfo from TRIV to INFO is 9223 sort Elt to ViewInfo . 9224endv 9225 9226fmod DATABASE-DECLS is 9227 pr (SET * (op _`,_ to __, op empty to emptyInfoSet)){ModuleInfo} . 9228 pr (SET * (op _`,_ to __, op empty to emptyInfoSet)){ViewInfo} . 9229 9230 sort Database . 9231 op db : 9232 Set{ModuleInfo} *** module info tuples 9233 Set{ModuleName} *** names of the modules in the database 9234 Set{ViewInfo} *** view info tuples 9235 Set{ViewExp} *** names of the views in the db 9236 Set{ModuleName} *** modules with set protect on (by default empty) 9237 Set{ModuleName} *** modules with set extend on (by default empty) 9238 Set{ModuleName} *** modules with set include on (by default empty) 9239 QidList 9240 -> Database 9241 [ctor 9242 format (nib i++o)] . 9243 9244 ops getDefPrs getDefExs getDefIncs : Database -> Set{ModuleName} . 9245 eq getDefPrs( 9246 db(MIS:Set{ModuleInfo}, MNS:Set{ModuleName}, VIS:Set{ViewInfo}, 9247 VES:Set{ViewExp}, MNS':Set{ModuleName}, MNS'':Set{ModuleName}, 9248 MNS3:Set{ModuleName}, QIL:QidList)) 9249 = MNS':Set{ModuleName} . 9250 eq getDefExs( 9251 db(MIS:Set{ModuleInfo}, MNS:Set{ModuleName}, VIS:Set{ViewInfo}, 9252 VES:Set{ViewExp}, MNS':Set{ModuleName}, MNS'':Set{ModuleName}, 9253 MNS3:Set{ModuleName}, QIL:QidList)) 9254 = MNS'':Set{ModuleName} . 9255 eq getDefIncs( 9256 db(MIS:Set{ModuleInfo}, MNS:Set{ModuleName}, VIS:Set{ViewInfo}, 9257 VES:Set{ViewExp}, MNS':Set{ModuleName}, MNS'':Set{ModuleName}, 9258 MNS3:Set{ModuleName}, QIL:QidList)) 9259 = MNS3:Set{ModuleName} . 9260endfm 9261 9262view Database from TRIV to DATABASE-DECLS is 9263 sort Elt to Database . 9264endv 9265 9266view ModuleExpression from TRIV to META-MODULE is 9267 sort Elt to ModuleExpression . 9268endv 9269 9270fmod DATABASE is 9271 pr (2TUPLE * (op `(_`,_`) to <_;_>, 9272 op p1_ to database, 9273 op p2_ to modExp)) {Database, ModuleExpression} . 9274 pr PRE-VIEW . 9275 pr UNIT . 9276 pr VIEW-EXPR-TO-QID . 9277 9278 op evalModule : Module OpDeclSet Database -> Database . 9279 *** its definition is in the module EVALUATION 9280 9281 op procModule : Qid Database -> Database . 9282 op procView : Qid Database -> Database . 9283 op procView : View Database -> Database . 9284 *** their definitions are in the modules UNIT-PROCESSING and VIEW-PROCESSING 9285 9286 op evalModExp : ModuleExpression Database -> Tuple{Database, ModuleExpression} . 9287 *** its definition is in the module MOD-EXPR-EVAL 9288 9289 vars QI X Y F : Qid . 9290 vars QIL QIL' : QidList . 9291 vars NQIL NQIL' : NeQidList . 9292 vars VE VE' VE'' : ViewExp . 9293 vars VES VES' VES'' VES3 : Set{ViewExp} . 9294 vars MIS MIS' : Set{ModuleInfo} . 9295 var VIS : Set{ViewInfo} . 9296 vars MNS MNS' MNS'' MNS3 MNS4 MNS5 MNS6 : Set{ModuleName} . 9297 vars PL PL' : ParameterList . 9298 vars PDS PDS' PDS'' : Set{ParameterDecl} . 9299 var PDL : ParameterDeclList . 9300 var PD : ParameterDecl . 9301 vars ME ME' : ModuleExpression . 9302 vars VI VI' : View . 9303 var SMS : SortMappingSet . 9304 var OMS : OpMappingSet . 9305 vars PU PU' U U' U'' U3 U4 : Module . 9306 var M : Module . 9307 var DB : Database . 9308 vars IL IL' : ImportList . 9309 var VIf : ViewInfo . 9310 var UIf : ModuleInfo . 9311 vars OPDS VDS VDS' : OpDeclSet . 9312 var PV : PreView . 9313 vars T T' : Term . 9314 var DT : Default{Term} . 9315 var NL : IntList . 9316 var TyL : TypeList . 9317 var Ty : Type . 9318 var AtS : AttrSet . 9319 var B : Bool . 9320 var I : Import . 9321 var MN MN' : ModuleName . 9322 9323 ops dincluded : ModuleExpression ImportList -> Bool . 9324 9325 eq dincluded(ME, IL (protecting ME .) IL') = true . 9326 eq dincluded(ME, IL (extending ME .) IL') = true . 9327 eq dincluded(ME, IL (including ME .) IL') = true . 9328 eq dincluded(ME, IL) = false [owise] . 9329 9330 ops included includedAux : ModuleExpression ImportList Database -> Bool . 9331 9332 eq included(ME, IL (protecting ME .) IL', DB) = true . 9333 eq included(ME, IL (extending ME .) IL', DB) = true . 9334 eq included(ME, IL (including ME .) IL', DB) = true . 9335 eq included(ME, nil, DB) = false . 9336 eq included(ME, IL, DB) = includedAux(ME, IL, DB) [owise] . 9337 9338 eq includedAux(ME, I IL, DB) 9339 = included(ME, getImports(getTopModule(moduleName(I), DB)), DB) 9340 or-else includedAux(ME, IL, DB) . 9341 eq includedAux(ME, nil, DB) = false . 9342 9343 op defImports : Module Database -> ImportList . 9344 op defImports : ImportList ImportList Set{ModuleName} Set{ModuleName} 9345 Set{ModuleName} -> ImportList . 9346 9347 eq defImports(M, DB) 9348 = if theory(M) 9349 then nil 9350 else defImports(getImports(M), nil, 9351 getDefPrs(DB), getDefExs(DB), getDefIncs(DB)) 9352 fi . 9353 9354 eq defImports(IL, IL', MN . MNS, MNS', MNS'') 9355 = if dincluded(MN, IL IL') 9356 then defImports(IL, IL', MNS, MNS', MNS'') 9357 else defImports(IL, IL' (protecting MN .), MNS, MNS', MNS'') 9358 fi . 9359 eq defImports(IL, IL', MNS, MN . MNS', MNS'') 9360 = if dincluded(MN, IL IL') 9361 then defImports(IL, IL', MNS, MNS', MNS'') 9362 else defImports(IL, IL' (extending MN .), MNS, MNS', MNS'') 9363 fi . 9364 eq defImports(IL, IL', MNS, MNS', MN . MNS'') 9365 = if dincluded(MN, IL IL') 9366 then defImports(IL, IL', MNS, MNS', MNS'') 9367 else defImports(IL, IL' (including MN .), MNS, MNS', MNS'') 9368 fi . 9369 eq defImports(IL, IL', 9370 emptyModuleNameSet, emptyModuleNameSet, emptyModuleNameSet) 9371 = IL' . 9372 9373*** The constant \texttt{emptyDatabase} denotes the empty database, and there 9374*** are predicates \texttt{viewInDatabase} and \texttt{unitInDb} to check, 9375*** respectively, whether a view and a unit are in a database or not. 9376 9377 op emptyDatabase : -> Database . 9378 eq emptyDatabase 9379 = db(emptyInfoSet, emptyModuleNameSet, emptyInfoSet, emptyViewExpSet, 9380 emptyModuleNameSet, emptyModuleNameSet, 'BOOL, nil) . 9381 9382 op unitInDb : ModuleName Database -> Bool . 9383 eq unitInDb(MN, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) 9384 = MN inModuleNameSet MNS . 9385 9386 op viewInDb : ViewExp Database -> Bool . 9387 eq viewInDb(VE, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) 9388 = VE inViewExpSet VES . 9389 9390 op includeBOOL : Database -> Bool . 9391 eq includeBOOL(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) 9392 = 'BOOL inModuleNameSet MNS' . 9393 9394*** If a module, theory, or view is being redefined, that is, if there was 9395*** already in the database a module, theory, or view with the same name, 9396*** then all the units and/or views depending on it are removed using the 9397*** functions \texttt{delModules} and \texttt{delViews}. Removing a view 9398*** or a unit from the database means removing its info cell from the set of 9399*** cells in the database. Those entered by the user are not completely 9400*** removed, their term form is saved so that it can be recompiled later. 9401 9402 op delModules : Set{ModuleName} Database -> Database . 9403 op delViews : Set{ViewExp} Database -> Database . 9404 9405 eq delModules((MN . MNS), 9406 db(< MN ; T ; U ; U' ; U'' ; VDS ; MNS' ; VES > MIS, 9407 MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL)) 9408 = delModules((MNS . MNS'), 9409 delViews(VES, 9410 db(< MN ; T ; noModule ; noModule ; noModule ; VDS ; 9411 emptyModuleNameSet ; emptyViewExpSet > MIS, 9412 MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))) . 9413 eq delModules((MN . MNS), 9414 db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS' ; VES > MIS, 9415 MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL)) 9416 = delModules((MNS . MNS'), 9417 delViews(VES, 9418 db(< MN ; U ; noModule ; noModule ; noModule ; VDS ; 9419 emptyModuleNameSet ; emptyViewExpSet > MIS, 9420 MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))) . 9421 eq delModules((MN . MNS), 9422 db(< MN ; null ; U ; U' ; U'' ; VDS ; MNS' ; VES > MIS, 9423 MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL)) 9424 = delModules((MNS . MNS'), 9425 delViews(VES, 9426 db(MIS, MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))) . 9427 eq delModules(emptyModuleNameSet, DB) = DB . 9428 eq delModules((MN . MNS), DB) = delModules(MNS, DB) [owise] . 9429 9430 eq delViews(VE # VES, 9431 db(MIS, MNS, < VE ; T ; VI ; MNS' ; VES' > VIS, VE # VES'', 9432 MNS'', MNS3, MNS4, QIL)) 9433 = delViews(VES # VES', 9434 delModules(MNS', 9435 db(MIS, MNS, 9436 < VE ; T ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS, 9437 VE # VES'', MNS'', MNS3, MNS4, QIL))) . 9438 eq delViews(VE # VES, 9439 db(MIS, MNS, 9440 < VE ; (null).Default{Term} ; VI ; MNS' ; VES' > VIS, VE # VES'', 9441 MNS'', MNS3, MNS4, QIL)) 9442 = delViews(VES # VES', 9443 delModules(MNS', 9444 db(MIS, MNS, VIS, VES'', MNS'', MNS3, MNS4, QIL))) . 9445 eq delViews(VE # VES, 9446 db(MIS, MNS, < VE ; VI ; VI' ; MNS' ; VES' > VIS, VE # VES'', 9447 MNS'', MNS3, MNS4, QIL)) 9448 = delViews(VES # VES', 9449 delModules(MNS', 9450 db(MIS, MNS, 9451 < VE ; VI ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS, 9452 VE # VES'', MNS'', MNS3, MNS4, QIL))) . 9453 eq delViews(emptyViewExpSet, DB) = DB . 9454 eq delViews(VE # VES, DB) = delViews(VES, DB) [owise] . 9455 9456*** The \texttt{warning} function allows us to place messages (warning, error, 9457*** or any other kind of messages) in the last argument of the database 9458*** constructor. These messages are given in the form of quoted identifier 9459*** lists, and will be passed to the third argument of the read-eval-print 9460*** loop, to be printed in the terminal. 9461 9462 op warning : Database QidList -> Database . 9463 eq warning(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, nil), QIL) 9464 = db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL) . 9465 eq warning(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, NQIL), QIL) 9466 = db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, NQIL QIL) . 9467 9468 op getMsg : Database -> QidList . 9469 eq getMsg(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) = QIL . 9470 9471*** Core Maude built-in modules are handled in a special way in the current 9472*** version of the system. They are not explicitly defined in the Full Maude 9473*** database; their importation is directly handled by Core Maude. This has 9474*** some drawbacks: Core Maude built-in modules cannot be renamed; they cannot 9475*** be directly used with built-in functions, such as \texttt{metaReduce} or 9476*** \texttt{sameComponent}, although they can be imported in modules being 9477*** used in the calls to these functions; and, in general, any function taking 9478*** as argument or returning as result the metarepresentation of a module 9479*** cannot take one of these built-in modules as argument. This is the case, 9480*** for example, for the \texttt{up} function presented in 9481*** Section~\ref{changing-levels}, or for functions or commands in which the 9482*** name of a module has to be specified, as the \texttt{select} or 9483*** \texttt{down} commands, or the \texttt{up} function presented in 9484*** Section~\ref{structured-specifications}. Nevertheless, there are also 9485*** some advantages: The flattening of the built-in part of the structure is 9486*** accomplished more efficiently, and, since these modules do not have to be 9487*** stored in the database of Full Maude, the size of the database is reduced. 9488 9489*** Our plan is to have in the future a hybrid solution. Once we have some way 9490*** of storing the modules entered to Full Maude in Core Maude's database, it 9491*** will be enough to keep in the Full Maude database just the original form 9492*** of the top of all the modules, including built-ins, leaving all the 9493*** importation declarations to be resolved by the engine. The structures will 9494*** be normalized as they are now, so that the engine will have to deal just 9495*** with inclusions, but it will be possible to use the predefined modules as 9496*** any other module. Moreover, the Full Maude database will be relatively 9497*** smaller and the flattening will be computed more efficiently. 9498 9499*** When a new module or theory is entered, the names of all the modules, 9500*** theories, and views depending on it are included in its lists of 9501*** dependencies with functions \texttt{setUpModuleDeps} and 9502*** \texttt{setUpViewDeps}. Notice that if new module expressions are 9503*** defined, the function \texttt{setUpModExpDeps} will have to be 9504*** extended accordingly. 9505 9506 op setUpModuleDeps : Module Database -> Database . 9507 op setUpModExpDeps : ModuleName Database -> Database . 9508 op setUpModExpDeps : ModuleName Header Database -> Database . 9509 op setUpModExpDeps : ModuleName ViewExp Database -> Database . 9510 op setUpImportDeps : ModuleName ImportList Database -> Database . 9511 9512 eq setUpModuleDeps(U, DB) 9513 = setUpImportDeps(getName(U), getImports(U), 9514 setUpModExpDeps(getName(U), DB)) . 9515 9516 eq setUpModExpDeps(QI, DB) = DB . 9517 9518 eq setUpModExpDeps(pd(X :: ME), 9519 db(< ME ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, 9520 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9521 = db(< ME ; DT ; U ; U' ; U'' ; VDS ; (MNS . pd(X :: ME)) ; VES > MIS, 9522 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . 9523 eq setUpModExpDeps(pd(X :: ME), 9524 db(< ME ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 9525 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9526 = db(< ME ; U ; U' ; U'' ; U3 ; VDS ; (MNS . pd(X :: ME)) ; VES > MIS, 9527 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . 9528 eq setUpModExpDeps(pd(X :: ME), DB) 9529 = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n)) 9530 [owise] . 9531 9532---- This could be a bug in Core Maude. 9533---- It should work if the next 6 equations are replaced by this single equation. 9534---- ceq setUpImportDeps(MN, (I IL), 9535---- db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), 9536---- MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9537---- = setUpImportDeps(MN, IL, 9538---- db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MN . MNS ; VES > MIS), 9539---- MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9540---- if MN' := moduleName(I) . 9541 eq setUpImportDeps(MN, ((including MN' .) IL), 9542 db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9543 = setUpImportDeps(MN, IL, 9544 db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . 9545 eq setUpImportDeps(MN, ((including MN' .) IL), 9546 db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9547 = setUpImportDeps(MN, IL, 9548 db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . 9549 eq setUpImportDeps(MN, ((extending MN' .) IL), 9550 db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9551 = setUpImportDeps(MN, IL, 9552 db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . 9553 eq setUpImportDeps(MN, ((extending MN' .) IL), 9554 db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9555 = setUpImportDeps(MN, IL, 9556 db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . 9557 eq setUpImportDeps(MN, ((protecting MN' .) IL), 9558 db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9559 = setUpImportDeps(MN, IL, 9560 db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . 9561 eq setUpImportDeps(MN, ((protecting MN' .) IL), 9562 db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9563 = setUpImportDeps(MN, IL, 9564 db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . 9565 eq setUpImportDeps(MN, I IL, DB) 9566 = warning(DB, '\r 'Error: '\o 'Module header2QidList(moduleName(I)) 'not 'in 'database. '\n) 9567 [owise] . 9568 eq setUpImportDeps(MN, nil, DB) = DB . 9569 9570 op setUpViewDeps : ModuleExpression ViewExp Database -> Database . 9571 op setUpViewExpDeps : ViewExp Database -> Database . 9572 op setUpViewExpDeps : ViewExp ParameterList Database -> Database . 9573 9574 eq setUpViewDeps(ME, VE, 9575 db((< ME ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9576 = db((< ME ; DT ; U ; U' ; U'' ; VDS ; MNS ; VE # VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . 9577 eq setUpViewDeps(ME, VE, 9578 db((< ME ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9579 = db((< ME ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VE # VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . 9580 eq setUpViewDeps(ME, VE, DB) 9581 = warning(DB, '\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n) 9582 [owise] . 9583 9584 eq setUpViewExpDeps(QI, DB) = DB . 9585 eq setUpViewExpDeps(QI{PL}, DB) = setUpViewExpDeps(QI{PL}, PL, DB) . 9586 9587 eq setUpViewExpDeps(VE, (QI, PL), 9588 db(MIS, MNS, < QI ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) 9589 = setUpViewExpDeps(VE, PL, 9590 db(MIS, MNS, < QI ; DT ; VI ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) . 9591 eq setUpViewExpDeps(VE, (QI, PL), 9592 db(MIS, MNS, < QI ; VI ; VI' ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) 9593 = setUpViewExpDeps(VE, PL, 9594 db(MIS, MNS, < QI ; VI ; VI' ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) . 9595 eq setUpViewExpDeps(QI{PL}, PL', 9596 db(MIS, MNS, < QI ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) 9597 = db(MIS, MNS, < QI ; DT ; VI ; MNS' ; QI{PL} # VES > VIS, VES', MNS'', MNS3, MNS4, QIL) 9598 [owise] . 9599 eq setUpViewExpDeps(QI{PL}, PL', 9600 db(MIS, MNS, < QI ; VI ; VI' ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) 9601 = db(MIS, MNS, < QI ; VI ; VI' ; MNS' ; QI{PL} # VES > VIS, VES', MNS'', MNS3, MNS4, QIL) 9602 [owise] . 9603 9604 eq setUpViewExpDeps(VE, (QI{PL}, PL'), 9605 db(MIS, MNS, < QI{PL} ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) 9606 = setUpViewExpDeps(VE, PL', 9607 db(MIS, MNS, < QI{PL} ; DT ; VI ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) . 9608 eq setUpViewExpDeps(VE, (QI{PL}, PL'), 9609 db(MIS, MNS, < QI{PL} ; VI ; VI' ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) 9610 = setUpViewExpDeps(VE, PL', 9611 db(MIS, MNS, < QI{PL} ; VI ; VI' ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) . 9612 eq setUpViewExpDeps(VE, (QI{PL}, PL'), DB) 9613 = setUpViewExpDeps(VE, PL', DB) 9614 [owise] . 9615 eq setUpViewExpDeps(VE, empty, DB) = DB . 9616 9617 op compiledModule : ModuleExpression Database -> Bool . 9618 op compiledModule : ParameterDecl Database -> Bool . 9619 op compiledView : ViewExp Database -> Bool . 9620 9621 eq compiledView(VE, 9622 db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) 9623 = VI =/= null . 9624 eq compiledView(ME, DB) = false [owise] . 9625 9626 eq compiledModule(MN, 9627 db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, MNS', 9628 VIS, VES', MNS'', MNS3, MNS4, QIL)) 9629 = U'' =/= noModule . 9630 eq compiledModule(MN, 9631 db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', 9632 VIS, VES', MNS'', MNS3, MNS4, QIL)) 9633 = U3 =/= noModule . 9634 eq compiledModule(MN, DB) = false [owise] . 9635 9636 op insertTermView : ViewExp Term Database -> Database . 9637 op insertView : View Database -> Database . 9638 op getTermView : ViewExp Database -> Default{Term} . 9639 op getView : ViewExp Database -> View . 9640 9641 eq insertTermView(VE, T, 9642 db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', 9643 MNS'', MNS3, MNS4, QIL)) 9644 = delViews(VES, 9645 delModules(MNS', 9646 db(MIS, MNS, 9647 < VE ; T ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS, VES', 9648 MNS'', MNS3, MNS4, 9649 QIL 9650 '\g 'Advisory: '\o 'View viewExp2QidList(VE) 'redefined. '\n))) . 9651 eq insertTermView(VE, T, 9652 db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) 9653 = db(MIS, MNS, 9654 < VE ; T ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS, 9655 (VE # VES), MNS', MNS'', MNS3, QIL) 9656 [owise] . 9657 9658 eq insertView(view VE from ME to ME' is SMS OMS endv, 9659 db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) 9660 = setUpViewExpDeps(VE, 9661 setUpViewDeps(ME, VE, 9662 setUpViewDeps(ME', VE, 9663 db(MIS, MNS, 9664 < VE ; DT ; 9665 view VE from ME to ME' is SMS OMS endv ; 9666 MNS' ; VES > VIS, 9667 VES', MNS'', MNS3, MNS4, QIL)))) . 9668 eq insertView(view VE{PDL} from ME to ME' is SMS OMS endv, 9669 db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) 9670 = setUpViewExpDeps(VE, 9671 setUpViewDeps(ME, VE, 9672 setUpViewDeps(ME', VE, 9673 db(MIS, MNS, 9674 < VE ; DT ; 9675 view VE{PDL} from ME to ME' is SMS OMS endv ; 9676 MNS' ; VES > VIS, 9677 VES', MNS'', MNS3, MNS4, QIL)))) . 9678 eq insertView(view VE from ME to ME' is SMS OMS endv, 9679 db(MIS, MNS, VIS, VES', MNS'', MNS3, MNS4, QIL)) 9680 = setUpViewExpDeps(VE, 9681 setUpViewDeps(ME, VE, 9682 setUpViewDeps(ME', VE, 9683 db(MIS, MNS, 9684 < VE ; (null).Default{Term} ; 9685 view VE from ME to ME' is SMS OMS endv ; 9686 emptyModuleNameSet ; emptyViewExpSet > VIS, 9687 VE # VES', MNS'', MNS3, MNS4, QIL)))) 9688 [owise] . 9689 eq insertView(view VE{PDL} from ME to ME' is SMS OMS endv, db(MIS, MNS, VIS, VES', MNS'', MNS3, MNS4, QIL)) 9690 = setUpViewExpDeps(VE, 9691 setUpViewDeps(ME, VE, 9692 setUpViewDeps(ME', VE, 9693 db(MIS, MNS, 9694 < VE ; (null).Default{Term} ; 9695 view VE{PDL} from ME to ME' is SMS OMS endv ; 9696 emptyModuleNameSet ; emptyViewExpSet > VIS, 9697 VE # VES', MNS'', MNS3, MNS4, QIL)))) 9698 [owise] . 9699 eq insertView(viewError(QIL), DB) = warning(DB, QIL) . 9700 ceq insertView(view VE:[ViewExp] from ME:[ModuleExpression] to ME':[ModuleExpression] is SMS:[SortMappingSet] OMS:[OpMappingSet] endv, DB) 9701 = warning(DB, 'The 'view QIL QI if QI == '`) then '\s else nil fi 'contains 'errors.) 9702 if not view VE:[ViewExp] from ME:[ModuleExpression] to ME':[ModuleExpression] is SMS:[SortMappingSet] OMS:[OpMappingSet] endv :: View 9703 /\ QIL QI := eMetaPrettyPrint(VE:[ViewExp]) 9704 [owise] . 9705 ceq insertView(view VE:[ViewExp]{PDL:[ParameterDeclList]} from ME:[ModuleExpression] to ME':[ModuleExpression] is SMS:[SortMappingSet] OMS:[OpMappingSet] endv, DB) 9706 = warning(DB, 'The 'view QIL QI if QI == '`) then '\s else nil fi 'contains 'errors.) 9707 if not view VE:[ViewExp]{PDL:[ParameterDeclList]} from ME:[ModuleExpression] to ME':[ModuleExpression] is SMS:[SortMappingSet] OMS:[OpMappingSet] endv :: View 9708 /\ QIL QI := eMetaPrettyPrint(VE:[ViewExp]) 9709 [owise] . 9710 9711 eq getTermView(VE, 9712 db(MIS, MNS, (< VE ; DT ; VI ; MNS' ; VES > VIS), VES', MNS'', MNS3, MNS4, QIL)) 9713 = DT . 9714 eq getTermView(VE, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) 9715 = qidError('\r 'Error: '\o 'View viewExp2QidList(VE) 'not 'in 'database. '\n) 9716 [owise] . 9717 9718 eq getView(VE, 9719 db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) 9720 = VI . 9721 eq getView(VE, 9722 db(MIS, MNS, < VE ; VI ; VI' ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) 9723 = VI' . 9724 eq getView(VE, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) 9725 = viewError('\r 'Error: '\o 'View viewExp2QidList(VE) 'not 'in 'database. '\n) 9726 [owise] . 9727 9728*** There are functions to insert the different versions of a unit, and to 9729*** extract them. We only give here the equations for the insertion of top 9730*** units to illustrate the way in which the consistency of the database is 9731*** maintained. We assume that when the internal version, the signature, or 9732*** the flat version of a module is entered in the database, its corresponding 9733*** top module is already present in it. 9734 9735 pr 3TUPLE{Term,OpDeclSet,Module} 9736 * (op ((_,_,_)) to <_;_;_>) . 9737 9738---- sort Tuple{Term,OpDeclSet,Module} . 9739---- op <_;_;_> : Default{Term} OpDeclSet Module -> Tuple{Term,OpDeclSet,Module} . 9740 op error : QidList -> [Tuple{Term,OpDeclSet,Module}] . 9741 9742 op insTermModule : ModuleName Module Database -> Database . 9743 op insTermModule : ModuleName Term Database -> Database . 9744 op insertTopModule : ModuleExpression [Module] Database -> Database . 9745 op insertInternalModule : ModuleExpression [Module] Database -> Database . 9746 op insertFlatModule : ModuleExpression [Module] Database -> Database . 9747 op insertVars : ModuleExpression [OpDeclSet] Database -> Database . 9748 op getTermModule : ModuleExpression Database -> [Tuple{Term,OpDeclSet,Module}] . 9749 op getTopModule : ModuleExpression Database -> [Module] . 9750 op getInternalModule : ModuleExpression Database -> [Module] . 9751 op getFlatModule : ModuleExpression Database -> [Module] . 9752 op getFlatModuleNeg : ModuleExpression Database -> [Module] . 9753 op getVars : ModuleExpression Database -> [OpDeclSet] . 9754 op insertTopModule : ParameterDecl [Module] Database -> Database . 9755 op insertInternalModule : ParameterDecl [Module] Database -> Database . 9756 op insertFlatModule : ParameterDecl [Module] Database -> Database . 9757 op insertVars : ParameterDecl [OpDeclSet] Database -> Database . 9758 op getTermModule : ParameterDecl Database -> [Tuple{Term,OpDeclSet,Module}] . 9759 op getTopModule : ParameterDecl Database -> [Module] . 9760 op getInternalModule : ParameterDecl Database -> [Module] . 9761 op getFlatModule : ParameterDecl Database -> [Module] . 9762 op getFlatModuleNeg : ParameterDecl Database -> [Module] . 9763 op getVars : ParameterDecl Database -> [OpDeclSet] . 9764 9765 eq insTermModule(MN, T, 9766 db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, MNS', 9767 VIS, VES', MNS'', MNS3, MNS4, QIL)) 9768 = delModules(MNS, 9769 delViews(VES, 9770 db(< MN ; T ; noModule ; noModule ; noModule ; none ; 9771 emptyModuleNameSet ; emptyViewExpSet > MIS, 9772 MNS', VIS, VES', MNS'', MNS3, MNS4, 9773 QIL 9774 '\g 'Advisory: '\o 'Module header2QidList(MN) 'redefined. '\n))). 9775 eq insTermModule(MN, T, 9776 db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', 9777 VIS, VES', MNS'', MNS3, MNS4, QIL)) 9778 = delModules(MNS, 9779 delViews(VES, 9780 db(< MN ; T ; noModule ; noModule ; noModule ; none ; 9781 emptyModuleNameSet ; emptyViewExpSet > MIS, 9782 MNS', VIS, VES', MNS'', MNS3, MNS4, 9783 QIL 9784 '\g 'Advisory: '\o 'Module header2QidList(MN) 'redefined. '\n))). 9785 eq insTermModule(MN, T, 9786 db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) 9787 = db(< MN ; T ; noModule ; noModule ; noModule ; none ; 9788 emptyModuleNameSet ; emptyViewExpSet > MIS, 9789 MN . MNS, VIS, VES, MNS', MNS'', MNS3, QIL) 9790 [owise] . 9791 eq insTermModule(MN, qidError(QIL), DB) = warning(DB, QIL) . 9792 eq insTermModule(MN, unitError(QIL), DB) = warning(DB, QIL) . 9793 9794 eq insTermModule(MN, U, 9795 db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', 9796 VIS, VES', MNS'', MNS3, MNS4, QIL)) 9797 = delModules(MNS, 9798 delViews(VES, 9799 db(< MN ; U ; noModule ; noModule ; noModule ; none ; 9800 emptyModuleNameSet ; emptyViewExpSet > MIS, 9801 MNS', VIS, VES', MNS'', MNS3, MNS4, 9802 QIL 9803 '\g 'Advisory: 9804 '\o 'Module header2QidList(MN) 'redefined. '\n))). 9805 eq insTermModule(MN, U, 9806 db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, MNS', 9807 VIS, VES', MNS'', MNS3, MNS4, QIL)) 9808 = delModules(MNS, 9809 delViews(VES, 9810 db(< MN ; U ; noModule ; noModule ; noModule ; none ; 9811 emptyModuleNameSet ; emptyViewExpSet > MIS, 9812 MNS', VIS, VES', MNS'', MNS3, MNS4, 9813 QIL 9814 '\g 'Advisory: 9815 '\o 'Module header2QidList(MN) 'redefined. '\n))). 9816 eq insTermModule(MN, U, 9817 db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) 9818 = db(< MN ; U ; noModule ; noModule ; noModule ; none ; 9819 emptyModuleNameSet ; emptyViewExpSet > MIS, 9820 MN . MNS, VIS, VES, MNS', MNS'', MNS3, QIL) 9821 [owise] . 9822 eq insTermModule(MN, qidError(QIL), DB) = warning(DB, QIL) . 9823 eq insTermModule(MN, unitError(QIL), DB) = warning(DB, QIL) . 9824 9825 eq insertTopModule(MN, U, 9826 db(< MN ; null ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 9827 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9828 = db(< MN ; null ; U ; noModule ; noModule ; VDS ; MNS ; VES > MIS, 9829 MNS', VIS, VES', MNS'', MNS3, MNS4, 9830 QIL 9831 '\r 'Advisory: '\o 9832 'Internally 'generated 'module header2QidList(MN) 'redefined. '\n) . 9833 eq insertTopModule(MN, U, 9834 db(< MN ; T ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 9835 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9836 = setUpModuleDeps(U, 9837 db(< MN ; T ; U ; noModule ; noModule ; VDS ; MNS ; VES > MIS, 9838 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . 9839 eq insertTopModule(MN, U, 9840 db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, 9841 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9842 = setUpModuleDeps(U, 9843 db(< MN ; U' ; U ; noModule ; noModule ; VDS ; MNS ; VES > MIS, 9844 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . 9845 eq insertTopModule(MN, U, 9846 db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) 9847 = setUpModuleDeps(U, 9848 db(< MN ; null ; U ; noModule ; noModule ; 9849 none ; emptyModuleNameSet ; emptyViewExpSet > MIS, 9850 MN . MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) 9851 [owise] . 9852 eq insertTopModule(MN, unitError(QIL), DB) = warning(DB, QIL) . 9853 9854 eq insertInternalModule(MN, U, 9855 db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 9856 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9857 = db(< MN ; DT ; U' ; U ; U3 ; VDS ; MNS ; VES > MIS, 9858 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . 9859 eq insertInternalModule(MN, U, 9860 db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, 9861 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9862 = db(< MN ; U' ; U'' ; U ; U4 ; VDS ; MNS ; VES > MIS, 9863 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . 9864 eq insertInternalModule(MN, unitError(QIL), DB) = warning(DB, QIL) . 9865 9866 eq insertFlatModule(MN, U, 9867 db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 9868 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9869 = db(< MN ; DT ; U' ; U'' ; U ; VDS ; MNS ; VES > MIS, 9870 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . 9871 eq insertFlatModule(MN, U, 9872 db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, 9873 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9874 = db(< MN ; U' ; U'' ; U3 ; U ; VDS ; MNS ; VES > MIS, 9875 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . 9876 eq insertFlatModule(MN, unitError(QIL), DB) = warning(DB, QIL) . 9877 9878 eq insertVars(MN, VDS, 9879 db(< MN ; DT ; U' ; U'' ; U3 ; VDS' ; MNS ; VES > MIS, 9880 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9881 = db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 9882 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . 9883 eq insertVars(MN, VDS, 9884 db(< MN ; U' ; U'' ; U3 ; U4 ; VDS' ; MNS ; VES > MIS, 9885 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9886 = db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, 9887 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . 9888 eq insertVars(MN, opDeclError(QIL), DB) = warning(DB, QIL) . 9889 9890 eq getTermModule(MN, 9891 db(< MN ; null ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, 9892 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9893 = error('\r 'Error: '\o header2QidList(MN) 'is 'an 'internal 'module. '\n) . 9894 eq getTermModule(MN, 9895 db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, 9896 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9897 = < DT ; none ; noModule > . 9898 eq getTermModule(MN, 9899 db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 9900 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9901 = < null ; VDS ; U > . 9902 eq getTermModule(MN, DB) 9903 = error('\r 'Error: '\o 'Module header2QidList(MN) '\n) 9904 [owise] . 9905 9906 eq getTopModule(MN, 9907 db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, 9908 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9909 = U . 9910 eq getTopModule(MN, 9911 db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 9912 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9913 = U' . 9914 eq getTopModule(MN, DB) 9915 = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n) 9916 [owise] . 9917 9918 eq getInternalModule(MN, 9919 db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, 9920 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9921 = U' . 9922 eq getInternalModule(MN, 9923 db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 9924 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9925 = U'' . 9926 eq getInternalModule(MN, DB) 9927 = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n) 9928 [owise] . 9929 9930 eq getVars(MN, 9931 db(< MN ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, 9932 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9933 = VDS . 9934 eq getVars(MN, 9935 db(< MN ; U ; U' ; U'' ; M ; VDS ; MNS ; VES > MIS, 9936 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9937 = VDS . 9938 eq getVars(MN, DB) = none [owise] . 9939 9940*** The name of the signature and the flattened module is not the 9941*** module expression used as the name of the module but the result of 9942*** converting it into a quoted identifier. 9943 9944 eq getFlatModule(MN, 9945 db(< MN ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9946 = if M == noModule 9947 then unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'compiled. '\n) 9948 else remNegAnns(M) 9949 fi . 9950 eq getFlatModule(MN, 9951 db(< MN ; U ; U' ; U'' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9952 = if M == noModule 9953 then unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'compiled. '\n) 9954 else remNegAnns(M) 9955 fi . 9956 eq getFlatModule(MN, DB) 9957 = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n) 9958 [owise] . 9959 9960 *** Handling of negative annotations (by Santiago Escobar) 9961 9962 eq getFlatModuleNeg(MN, 9963 db(< MN ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, 9964 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9965 = M . 9966 eq getFlatModuleNeg(MN, 9967 db(< MN ; U ; U' ; U'' ; M ; VDS ; MNS ; VES > MIS, 9968 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9969 = M . 9970 eq getFlatModuleNeg(MN, 9971 db(< MN ; DT ; U ; U' ; noModule ; VDS ; MNS ; VES > MIS, 9972 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9973 = unitError('\r 'Error: '\o 9974 'Module header2QidList(MN) 'not 'compiled. '\n) . 9975 eq getFlatModuleNeg(MN, 9976 db(< MN ; U ; U' ; U'' ; noModule ; VDS ; MNS ; VES > MIS, 9977 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 9978 = unitError('\r 'Error: '\o 9979 'Module header2QidList(MN) 'not 'compiled. '\n) . 9980 eq getFlatModuleNeg(MN, DB) 9981 = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n) 9982 [owise] . 9983 9984 *** removeNegAnnotations 9985 op remNegAnns : Module -> Module . 9986 op remNegAnns : OpDeclSet -> OpDeclSet . 9987 op remNegAnns : AttrSet -> AttrSet . 9988 op remNegAnns : IntList -> IntList . 9989 9990 eq remNegAnns(M) = setOps(M, remNegAnns(getOps(M))) . 9991 9992 eq remNegAnns(op F : TyL -> Ty [AtS] . OPDS) 9993 = op F : TyL -> Ty [remNegAnns(AtS)] . remNegAnns(OPDS) . 9994 eq remNegAnns((none).OpDeclSet) = (none).OpDeclSet . 9995 9996 eq remNegAnns(strat(NL:NatList) AtS) = strat(NL:NatList) AtS . 9997 eq remNegAnns(strat(IL:IntList) AtS) = AtS [owise] . 9998 eq remNegAnns(AtS) = AtS [owise] . 9999 10000endfm 10001 10002------------------------------------------------------------------------------- 10003******************************************************************************* 10004------------------------------------------------------------------------------- 10005 10006*** 10007*** The Evaluation of Modules 10008*** 10009 10010*** The general principle for the evaluation of units in our design consists in 10011*** first evaluating any module expression, reducing it to a canonical form in 10012*** which only unit inclusions appear, that is, to a unit hierarchy, which can 10013*** be seen as a partial order of unit inclusions. The design of the Full Maude 10014*** system has been based upon the principle of evaluating all module 10015*** expressions to irreducible structured units, and on using the flat version 10016*** of the units only for execution purposes. We have then two different 10017*** processes clearly distinguished: a first step in which the structured unit 10018*** is evaluated and reduced to its normal form, and a second step in which 10019*** this normal form is flattened. 10020 10021*** As explained in Section~\ref{execution-environment}, the process of 10022*** evaluation to normal form is also responsible for the parsing of the 10023*** bubbles in the premodules, which is accomplished once the signature has 10024*** been built. The parsing of bubbles is discussed in 10025*** Section~\ref{bubble-parsing}. To be able to handle the \texttt{up} 10026*** function and the \texttt{down} command presented in 10027*** Section~\ref{structured-specifications}, it is necessary to be able to 10028*** move terms and modules from one level of reflection to another. The 10029*** functionality to move between levels is presented in 10030*** Section~\ref{changing-levels}, where functions \texttt{up} and 10031*** \texttt{down} on sorts \texttt{Module} and \texttt{Term} are defined. The 10032*** transformation of object-oriented modules into system modules in discussed 10033*** in Section~\ref{omod2modfunction}. The evaluation of module expressions is 10034*** discussed in Sections~\ref{evalModExp}, \ref{application-of-maps}, 10035*** \ref{instantiation}, and~\ref{renaming}. 10036 10037*** 10038*** Changing Levels 10039*** 10040 10041*** Moving terms of sorts \texttt{Term} and \texttt{Module} from one 10042*** level of reflection to another is possible thanks to the 10043*** \texttt{up} and \texttt{down} functions, which are defined, 10044*** respectively, in the following modules \texttt{MOVE-UP} and 10045*** \texttt{MOVE-DOWN}. 10046 10047*** 10048*** The \texttt{up} Function 10049*** 10050 10051*** Given a term of sort \texttt{Module} or \texttt{Term}, the 10052*** \texttt{up} function, defined in the following module 10053*** \texttt{MOVE-UP}, returns the term metarepresenting it. The 10054*** function is just call the \texttt{upTerm} predefined function. 10055 10056*** We shall see in Section~\ref{bubble-parsing} how the \texttt{up} function 10057*** is used to evaluate the homonymous function discussed in 10058*** Section~\ref{structured-specifications}. In Section~\ref{instantiation} we 10059*** shall discuss how the \texttt{up} function is used to evaluate the 10060*** \texttt{META-LEVEL} module expression (see 10061*** Section~\ref{structured-specifications}). 10062 10063------------------------------------------------------------------------------- 10064******************************************************************************* 10065------------------------------------------------------------------------------- 10066 10067fmod MOVE-UP is 10068--- pr META-LEVEL + PRE-VARIANT . 10069 pr META-LEVEL . 10070 pr CONVERSION . 10071 op up : Module -> Term . 10072 op up : Term -> Term . 10073 op up : EquationSet -> Term . 10074 10075 eq up(M:Module) = upTerm(M:Module) . 10076 eq up(T:Term) = upTerm(T:Term) . 10077 eq up(EqS:EquationSet) = upTerm(EqS:EquationSet) . 10078 10079endfm 10080 10081------------------------------------------------------------------------------- 10082******************************************************************************* 10083------------------------------------------------------------------------------- 10084 10085*** 10086*** The \texttt{down} Function 10087*** 10088 10089*** Given a term of sort \texttt{Term} metarepresenting a term of sort 10090*** \texttt{Term} or \texttt{Module}, the \texttt{down} function can be seen 10091*** as the inverse of the \texttt{up} function discussed in the previous 10092*** section, that is, it returns the original term that had been 10093*** metarepresented. There are also \texttt{down} functions for terms 10094*** metarepresenting terms in other sorts. We present here only some of them. 10095 10096*** We assume that the \texttt{down} functions are called with valid 10097*** metarepresentations. In fact, these functions should be declared as 10098*** partial functions going to error sorts when their arguments are invalid. 10099 10100*** The main application of the \texttt{down} functions is in the evaluation 10101*** of the \texttt{down} command (see 10102*** Section~\ref{structured-specifications}). However, they are also used in 10103*** other tasks, as for example in the parsing of some inputs. 10104 10105------------------------------------------------------------------------------- 10106******************************************************************************* 10107------------------------------------------------------------------------------- 10108 10109fmod MOVE-DOWN is 10110 pr UNIT . 10111 pr CONVERSION . 10112 pr INT-LIST . 10113 10114 op downTerm : Term -> [Term] . 10115 op downModule : Term -> [Module] . 10116 op downQid : Term -> [Qid] [memo] . 10117 op downQidList : Term -> [QidList] . 10118 op downTypes : Term -> [TypeList] . 10119 op downSorts : Term -> [SortSet] . 10120 op downSort : Term -> [Sort] . 10121 op downModExp : Constant -> [Header] . 10122 op downNat : Term -> [Int] . 10123 op downString : Term -> [String] . 10124 10125 op downResultPair : Term -> [ResultPair] . 10126 op downTerm : TermList -> [Term] . 10127 op downImports : TermList -> [ImportList] . 10128 op downSubsorts : TermList -> [SubsortDeclSet] . 10129 op downOps : TermList -> [OpDeclSet] . 10130 op downEqCond : TermList -> [EqCondition] . 10131 op downCond : TermList -> [Condition] . 10132 op downMbs : TermList -> [MembAxSet] . 10133 op downEqs : TermList -> [EquationSet] . 10134 op downRls : TermList -> [RuleSet] . 10135 op downAttrs : TermList -> [AttrSet] . 10136 op downAttr : Term -> [Attr] . 10137 op downHooks : TermList -> [HookList] . 10138 op downMetaNat : Term -> [Term] . 10139 op downNat : TermList -> [IntList] . 10140 10141 op downClasses : TermList -> [ClassDeclSet] . 10142 op downMsgs : TermList -> [MsgDeclSet] . 10143 op downSubclasses : TermList -> [SubclassDeclSet] . 10144 op downClassAttrs : TermList -> [AttrDeclSet] . 10145 10146 vars T T' T'' T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 : Term . 10147 vars TL TL' : TermList . 10148 vars QI QI' F V L : Qid . 10149 var Ct : Constant . 10150 var M : Module . 10151 var Tp : Type . 10152 10153 eq downResultPair('`{_`,_`}[T, T']) = {downTerm(T), downTerm(T')} . 10154 10155 eq downModule('fmod_is_sorts_.____endfm[T1, T2, T3, T4, T5, T6, T7]) 10156 = (fmod downModExp(T1) is 10157 downImports(T2) 10158 sorts downSorts(T3) . 10159 downSubsorts(T4) 10160 downOps(T5) 10161 downMbs(T6) 10162 downEqs(T7) 10163 endfm) . 10164 eq downModule('mod_is_sorts_._____endm[T1, T2, T3, T4, T5, T6, T7, T8]) 10165 = (mod downModExp(T1) is 10166 downImports(T2) 10167 sorts downSorts(T3) . 10168 downSubsorts(T4) 10169 downOps(T5) 10170 downMbs(T6) 10171 downEqs(T7) 10172 downRls(T8) 10173 endm) . 10174 eq downModule('omod_is_sorts_.________endom[T1, T2, T3, T4, T5, T6, T7, T8, T9, T10, T11]) 10175 = (omod downModExp(T1) is 10176 downImports(T2) 10177 sorts downSorts(T3) . 10178 downSubsorts(T4) 10179 downClasses(T5) 10180 downSubclasses(T6) 10181 downOps(T7) 10182 downMsgs(T8) 10183 downMbs(T9) 10184 downEqs(T10) 10185 downRls(T11) 10186 endom) . 10187 10188 eq downModExp(Ct) = downQid(Ct) . 10189 10190 eq downImports('nil.ImportList) = nil . 10191 eq downImports('__[TL]) = downImports(TL) . 10192 eq downImports('including_.[T]) = (including downModExp(T) .) . 10193 eq downImports('extending_.[T]) = (extending downModExp(T) .) . 10194 eq downImports('protecting_.[T]) = (protecting downModExp(T) .) . 10195 ceq downImports((TL, TL')) = (downImports(TL) downImports(TL')) if TL =/= empty /\ TL' =/= empty . 10196 10197 eq downSubsorts('none.SubsortDeclSet) = none . 10198 eq downSubsorts('__[TL]) = downSubsorts(TL) . 10199 eq downSubsorts('subsort_<_.[T, T']) = (subsort downQid(T) < downQid(T') .) . 10200 ceq downSubsorts((TL, TL')) = (downSubsorts(TL) downSubsorts(TL')) if TL =/= empty /\ TL' =/= empty . 10201 10202 eq downOps('none.OpDeclSet) = none . 10203 eq downOps('__[TL]) = downOps(TL) . 10204 eq downOps('op_:_->_`[_`].[Ct, T, T', T'']) 10205 = (op downQid(Ct) : downTypes(T) -> downQid(T') [downAttrs(T'')] .) . 10206 ceq downOps((TL, TL')) = (downOps(TL) downOps(TL')) if TL =/= empty /\ TL' =/= empty . 10207 10208 eq downAttrs('none.AttrSet) = none . 10209 eq downAttrs('__[TL]) = downAttrs(TL) . 10210 ceq downAttrs((TL, TL')) = (downAttr(TL) downAttrs(TL')) if TL =/= empty /\ TL' =/= empty . 10211 ceq downAttrs(T) 10212 = downAttr(T) 10213 if T =/= 'none.AttrSet . 10214 10215 eq downAttr('assoc.Attr) = assoc . 10216 eq downAttr('comm.Attr) = comm . 10217 eq downAttr('idem.Attr) = idem . 10218 eq downAttr('id[T]) = id(downTerm(T)) . 10219 eq downAttr('left-id[T]) = left-id(downTerm(T)) . 10220 eq downAttr('right-id[T]) = right-id(downTerm(T)) . 10221 eq downAttr('poly[T]) = poly(downNat(T)) . 10222 eq downAttr('strat[T]) = strat(downNat(T)) . 10223 eq downAttr('memo.Attr) = memo . 10224 eq downAttr('prec[T]) = prec(downNat(T)) . 10225 eq downAttr('gather[T]) = gather(downQidList(T)) . 10226 eq downAttr('ctor.Attr) = ctor . 10227 eq downAttr('special[T]) = special(downHooks(T)) . 10228 eq downAttr('iter.Attr) = iter . 10229 eq downAttr('frozen[T]) = frozen(downNat(T)) . 10230 eq downAttr('label[T]) = label(downQid(T)) . 10231 eq downAttr('config.Attr) = config . 10232 eq downAttr('object.Attr) = object . 10233 eq downAttr('msg.Attr) = msg . 10234 eq downAttr('nonexec.Attr) = nonexec . 10235 eq downAttr('variant.Attr) = variant . 10236---- eq downAttr('metadata`(_`)['token[T]]) = metadata(downString(downQid(T))) . 10237 eq downAttr('owise.Attr) = owise . 10238 eq downAttr('metadata[T]) = metadata(substr(string(T), 1, find(string(T), "\".String", 0) + (- 1))) . 10239 eq downAttr('format[T]) = format(downQidList(T)) . 10240 10241 eq downHooks('__[TL]) = downHooks(TL) . 10242 eq downHooks('id-hook[T, T']) = id-hook(downQid(T), downQidList(T')) . 10243 eq downHooks('op-hook[T, T', T'', T3]) 10244 = op-hook(downQid(T), downQid(T'), downQidList(T''), downQid(T3)) . 10245 eq downHooks('term-hook[T, T']) = term-hook(downQid(T), downTerm(T')) . 10246 ceq downHooks((TL, TL')) = downHooks(TL) downHooks(TL') if TL =/= empty /\ TL' =/= empty . 10247 10248---- eq downTerm(T) = downTerm(T, qidError('\r 'Error: '\o 'Incorrect 'term. '\n)) . 10249 eq downTerm(QI) = downQid(QI) . 10250 eq downTerm('_`[_`][T, T']) = downQid(T)[downTerm(T')] . 10251 eq downTerm('_`,_[T, TL]) = (downTerm(T), downTerm(TL)) . 10252 ceq downTerm((T, TL)) = (downTerm(T), downTerm(TL)) if TL =/= empty . 10253 eq downTerm(F[TL]) 10254 = qidError('\r 'Error: '\o 'Incorrect 'term. '\n) [owise] . 10255 10256 eq downEqCond('_/\_[TL]) = downEqCond(TL) . 10257 eq downEqCond('_=_[T, T']) = downTerm(T) = downTerm(T') . 10258 eq downEqCond('_:_[T, T']) = downTerm(T) : downSort(T') . 10259 eq downEqCond('_:=_[T, T']) = downTerm(T) := downTerm(T') . 10260 ceq downEqCond((TL, TL')) = downEqCond(TL) /\ downEqCond(TL') if TL =/= empty /\ TL' =/= empty . 10261 10262 eq downCond('_/\_[TL]) = downCond(TL) . 10263 eq downCond('_=_[T, T']) = downEqCond('_=_[T, T']) . 10264 eq downCond('_:_[T, T']) = downEqCond('_:_[T, T']) . 10265 eq downCond('_:=_[T, T']) = downEqCond('_:=_[T, T']) . 10266 eq downCond('_=>_[T, T']) = downTerm(T) => downTerm(T') . 10267 ceq downCond((TL, TL')) = downCond(TL) /\ downCond(TL') if TL =/= empty /\ TL' =/= empty . 10268 10269 eq downMbs('none.MembAxSet) = none . 10270 eq downMbs('__[TL]) = downMbs(TL) . 10271 eq downMbs('mb_:_`[_`].[T, T', T'']) 10272 = (mb downTerm(T) : downSort(T') [downAttrs(T'')] .) . 10273 eq downMbs('cmb_:_if_`[_`].[T, T', T'', T3]) 10274 = (cmb downTerm(T) : downSort(T') if downEqCond(T'') [downAttrs(T3)] .) . 10275 ceq downMbs((TL, TL')) = (downMbs(TL) downMbs(TL')) if TL =/= empty /\ TL' =/= empty . 10276 10277 eq downEqs('none.EquationSet) = none . 10278 eq downEqs('__[TL]) = downEqs(TL) . 10279 eq downEqs('eq_=_`[_`].[T, T', T'']) 10280 = (eq downTerm(T) = downTerm(T') [downAttrs(T'')] .) . 10281 eq downEqs('ceq_=_if_`[_`].[T, T', T'', T3]) 10282 = (ceq downTerm(T) = downTerm(T') if downEqCond(T'') [downAttrs(T3)] .) . 10283 ceq downEqs((TL, TL')) = (downEqs(TL) downEqs(TL')) if TL =/= empty /\ TL' =/= empty . 10284 10285 eq downRls('none.RuleSet) = none . 10286 eq downRls('__[TL]) = downRls(TL) . 10287 eq downRls('rl_=>_`[_`].[T, T', T'']) 10288 = (rl downTerm(T) => downTerm(T') [downAttrs(T'')] .) . 10289 eq downRls('crl_=>_if_`[_`].[T, T', T'', T3]) 10290 = (crl downTerm(T) => downTerm(T') if downCond(T'') [downAttrs(T3)] .) . 10291 ceq downRls((TL, TL')) = (downRls(TL) downRls(TL')) if TL =/= empty /\ TL' =/= empty . 10292 10293 eq downSorts('none.EmptyTypeSet) = none . 10294---- eq downSorts('none.SortSet) = none . 10295 eq downSorts('_;_[TL]) = downSorts(TL) . 10296 ceq downSorts((TL, TL')) = (downSorts(TL) ; downSorts(TL')) if TL =/= empty /\ TL' =/= empty . 10297 eq downSorts(QI) = downSort(QI) [owise] . 10298 10299 eq downSort(Ct) = downQid(Ct) . 10300 10301 eq downTypes('nil.TypeList) = nil . 10302 eq downTypes('__[TL]) = downTypes(TL) . 10303 ceq downTypes((TL, TL')) 10304 = (downTypes(TL) downTypes(TL')) 10305 if TL =/= empty /\ TL' =/= empty . 10306 eq downTypes(QI) = downSort(QI) [owise] . 10307 10308 eq downQidList('nil.TypeList) = nil . 10309 eq downQidList('__[TL]) = downQidList(TL) . 10310 ceq downQidList((TL, TL')) = (downQidList(TL) downQidList(TL')) if TL =/= empty /\ TL' =/= empty . 10311 eq downQidList(QI) = downQid(QI) [owise] . 10312 10313 eq downQid(Ct) 10314 = qid(substr(string(getName(Ct)), 1, length(string(getName(Ct))))) . 10315---- eq downQid(Ct) = downTerm(Ct) . 10316 10317 eq downMetaNat(QI) 10318 = qid(substr(string(getName(QI)), 1, length(string(getName(QI)))) 10319 + ".Nat") . 10320 10321---- eq downNat(T) = downTerm(T, numberError('Error: 'non 'valid 'metaterm)) . 10322 ceq downNat(QI) 10323 = trunc(rat(string(getName(QI)), 10)) 10324 if getType(QI) == 'Nat or getType(QI) == 'NzNat . 10325 ceq downNat(QI) 10326 = if substr(string(getName(QI)), 0 ,1) == "-" 10327 then - trunc(rat(substr(string(getName(QI)), 1, 10328 length(string(getName(QI)))), 10)) 10329 else trunc(rat(string(getName(QI)), 10)) 10330 fi 10331 if getType(QI) == 'Int or getType(QI) == 'NzInt . 10332 eq downNat('0.Zero) = 0 . 10333 eq downNat('s_['0.Zero]) = 1 . 10334 ceq downNat(F['0.Zero]) 10335 = trunc(rat(substr(string(F), 3, 2), 10)) 10336 if substr(string(F), 0, 3) = "s_^" . 10337 10338 eq downString(QI) = substr(string(QI), 1, _-_(length(string(QI)), 2)) . 10339 10340 eq downNat('__[TL]) = downNat(TL) . 10341 ceq downNat((TL, TL')) = (downNat(TL) downNat(TL')) if TL =/= empty /\ TL' =/= empty . 10342 10343 eq downClasses('none.ClassDeclSet) = none . 10344 eq downClasses('__[TL]) = downClasses(TL) . 10345 ceq downClasses((TL, TL')) = (downClasses(TL) downClasses(TL')) if TL =/= empty /\ TL' =/= empty . 10346 eq downClasses('class_|_.[T, T']) = (class downSort(T) | downClassAttrs(T') .) . 10347 10348 eq downClassAttrs('none.AttrDeclSet) = none . 10349 eq downClassAttrs('_`,_[TL]) = downClassAttrs(TL) . 10350 ceq downClassAttrs((TL, TL')) = (downClassAttrs(TL), downClassAttrs(TL')) if TL =/= empty /\ TL' =/= empty . 10351 eq downClassAttrs('attr_:_[T, T']) = (attr downQid(T) : downSort(T')) . 10352 10353 eq downSubclasses('none.SubclassDeclSet) = none . 10354 eq downSubclasses('__[TL]) = downSubclasses(TL) . 10355 ceq downSubclasses((TL, TL')) = (downSubclasses(TL) downSubclasses(TL')) if TL =/= empty /\ TL' =/= empty . 10356 eq downSubclasses('subclass_<_.[T, T']) = (subclass downQid(T) < downQid(T') .) . 10357 10358 eq downMsgs('none.MsgDeclSet) = none . 10359 eq downMsgs('__[TL]) = downMsgs(TL) . 10360 ceq downMsgs((TL, TL')) = (downMsgs(TL) downMsgs(TL')) if TL =/= empty /\ TL' =/= empty . 10361 eq downMsgs('msg_:_->_.[Ct, T, T']) 10362 = (msg downQid(Ct) : downTypes(T) -> downQid(T') .) . 10363 10364endfm 10365 10366------------------------------------------------------------------------------- 10367******************************************************************************* 10368------------------------------------------------------------------------------- 10369 10370*** 10371*** Parsing of Bubbles 10372*** 10373 10374*** As discussed in Section~\ref{implementation-introduction}, in Full Maude, 10375*** the parsing process is split into two phases. In a first stage, the input 10376*** is parsed using the top-level grammar for Full Maude modules, theories, 10377*** views, and commands. Once this first stage is completed, we get a term 10378*** with bubbles in it, which is converted into a module, theory, or view. 10379*** This unit or view may still have the bubbles in it. We say that a module 10380*** with bubbles is a premodule, a view with bubbles a preview, and so on. The 10381*** second stage of the process consists in taking this preunit or preview and 10382*** converting the bubbles in it into terms by parsing them in the appropriate 10383*** signatures, obtaining a `valid' unit or view out of it, or otherwise a 10384*** parsing error. In the case of commands, if they contain any bubble, the 10385*** same will have to be done. All bubbles have to be parsed in the 10386*** appropriate signature before any further processing can be done with the 10387*** module, view, or command in which they appear. 10388 10389*** 10390*** Parsing of Module Expressions 10391*** 10392 10393*** Before introducing the \texttt{parseDecl} function, we present some 10394*** auxiliary functions. For example, the following functions 10395*** \texttt{parseType}, \texttt{parseSortSet}, and \texttt{parseTypeList} 10396*** return, respectively, the sort, set of sorts, and list of sorts 10397*** represented by the term given as argument. Note that these functions, as 10398*** most of the functions in this module, are partial functions. We assume 10399*** that the term given as argument is in fact the representation of, for 10400*** example, a valid sort, or set of sorts, etc. In the case of 10401*** \texttt{parseDecl} we assume that the term is the representation of a 10402*** predeclaration. 10403 10404------------------------------------------------------------------------------- 10405******************************************************************************* 10406------------------------------------------------------------------------------- 10407 10408fmod MOD-EXP-PARSING is 10409 pr MOVE-DOWN . 10410 pr INT-LIST . 10411 pr VIEW-EXPR-TO-QID . 10412 10413 vars T T' T'' T3 T4 : Term . 10414 vars T? T?' : [Term] . 10415 var TL TL' : TermList . 10416 var QIL : QidList . 10417 var Ct : Constant . 10418 var AtS : AttrSet . 10419 vars QI F : Qid . 10420 var CD? : [Condition] . 10421 vars S S' : Sort . 10422 var TyL : TypeList . 10423 10424 op parseSort : Term ~> Sort . 10425 op parseType : Term ~> Type . 10426 op parseSortSet : Term ~> SortSet . 10427 op parseTypeList : Term ~> TypeList . 10428 op parseViewExp : Term ~> ViewExp . 10429 op parseParameterList : Term ~> ParameterList . 10430 10431 eq parseSort('sortToken[T]) 10432 = if downQid(T) :: Type 10433 then downQid(T) 10434 else qidError('\r 'Warning: '\o downQid(T) 'is 'not 'a 'valid 'sort. '\n) 10435 fi . 10436 eq parseSort('_`{_`}[T, T']) 10437 = qid(string(parseSort(T)) 10438 + "{" + string(parameterList2Qid(parseParameterList(T'))) + "}") . 10439 eq parseSort(T) = qidError('\r 'Warning: '\o 'invalid 'sort. '\n) [owise] . 10440 10441 eq parseType('`[_`][T]) 10442 ---- = kind(parseSort(T)) . 10443 = qid("[" + string(parseSort(T)) + "]") . 10444 eq parseType(T) = parseSort(T) [owise] . 10445 10446 eq parseSortSet('__[T, T']) = (parseSort(T) ; parseSortSet(T')) . 10447 eq parseSortSet(T) = parseSort(T) [owise]. 10448 10449 eq parseTypeList('__[T, T']) = (parseType(T) parseTypeList(T')) . 10450 eq parseTypeList(T) = parseType(T) [owise] . 10451 10452 eq parseViewExp('viewToken[T]) 10453 = if downQid(T) :: Sort 10454 then downQid(T) 10455 else qidError('\r 'Warning: '\o downQid(T) 'is 'not 'a 'valid 'sort. '\n) 10456 fi . 10457 eq parseViewExp('_`{_`}[T, T']) 10458 = parseViewExp(T){parseParameterList(T')} . 10459 eq parseViewExp(T) 10460 = qidError('\r 'Warning: '\o 'invalid 'view 'expression. '\n) 10461 [owise] . 10462 10463 eq parseParameterList('_`,_[T, T']) 10464 = parseViewExp(T), parseParameterList(T') . 10465 eq parseParameterList(T) = parseViewExp(T) [owise] . 10466 10467*** The function \texttt{parseModExp} takes a term representing a 10468*** module expression and returns the corresponding term in sort 10469*** \texttt{ModuleExpression}. In case of adding new constructors for module 10470*** expressions, as it will be done in Section~\ref{extension}, new equations d 10471*** efining the semantics of the function on them will have to be given. 10472 10473 op parseModExp : Term -> ModuleExpression . 10474 op parseMaps : Term -> RenamingSet . 10475 10476 op parseAttrs : Term -> AttrSet . 10477 10478 eq parseModExp('token[T]) = downQid(T) . 10479 eq parseModExp('`(_`)[T]) = parseModExp(T) . 10480 eq parseModExp('_`{_`}[T, T']) 10481 = _`{_`}(parseModExp(T), parseParameterList(T')) . 10482 eq parseModExp('_*`(_`)[T, T']) = _*`(_`)(parseModExp(T), parseMaps(T')) . 10483 eq parseModExp('_+_[T, T']) = parseModExp(T) + parseModExp(T') . 10484 eq parseModExp('TUPLE`[_`]['token[T]]) = TUPLE[parseNat(T)] . 10485 eq parseModExp('POWER`[_`]['token[T]]) = POWER[parseNat(T)] . 10486 10487 eq parseMaps('_`,_[T, T']) = (parseMaps(T), parseMaps(T')) . 10488 10489 eq parseMaps('sort_to_[T, T']) = (sort parseType(T) to parseType(T')) . 10490 eq parseMaps('label_to_['token[T], 'token[T']]) 10491 = (label downQid(T) to downQid(T')) . 10492 eq parseMaps('class_to_[T, T']) = (class parseType(T) to parseType(T')) . 10493 eq parseMaps('attr_._to_[T, 'token[T'], 'token[T'']]) 10494 = (attr downQid(T') . parseType(T) to downQid(T'')) . 10495 eq parseMaps('msg_to_['token[T], 'token[T']]) 10496 = (msg downQid(T) to downQid(T')) . 10497 eq parseMaps('msg_:_->_to_['token[T], T', T'', 'token[T3]]) 10498 = (msg downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3)) . 10499 eq parseMaps('msg_:`->_to_['token[T], T', 'token[T'']]) 10500 = (msg downQid(T) : nil -> parseType(T') to downQid(T'')) . 10501 eq parseMaps('op_to_`[_`]['token[T], 'token[T'], T'']) 10502 = (op downQid(T) to downQid(T') [parseAttrs(T'')]) . 10503 eq parseMaps('op_:_->_to_`[_`]['token[T], T', T'', 'token[T3], T4]) 10504 = (op downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3) 10505 [parseAttrs(T4)]) . 10506 eq parseMaps('op_:`->_to_`[_`]['token[T], T', 'token[T''], T3]) 10507 = (op downQid(T) : nil -> parseType(T') to downQid(T'') 10508 [parseAttrs(T3)]) . 10509 eq parseMaps('op_:_~>_to_`[_`]['token[T], T', T'', 'token[T3], T4]) 10510 = (op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) 10511 to downQid(T3) [parseAttrs(T4)]) . 10512 eq parseMaps('op_:`~>_to_`[_`]['token[T], T', 'token[T''], T3]) 10513 = (op downQid(T) : nil -> kind(parseType(T')) to downQid(T'') 10514 [parseAttrs(T3)]) . 10515 eq parseMaps('op_to_['token[T], 'token[T']]) 10516 = (op downQid(T) to downQid(T') [none]) . 10517 eq parseMaps('op_:_->_to_['token[T], T', T'', 'token[T3]]) 10518 = (op downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3) 10519 [none]) . 10520 eq parseMaps('op_:`->_to_['token[T], T', 'token[T'']]) 10521 = (op downQid(T) : nil -> parseType(T') to downQid(T'') [none]) . 10522 eq parseMaps('op_:_~>_to_['token[T], T', T'', 'token[T3]]) 10523 = (op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) 10524 to downQid(T3) [none]) . 10525 eq parseMaps('op_:`~>_to_['token[T], T', 'token[T'']]) 10526 = (op downQid(T) : nil -> kind(parseType(T')) to downQid(T'') [none]) . 10527 10528 eq parseAttrs('__[T, T']) = (parseAttrs(T) parseAttrs(T')) . 10529 eq parseAttrs('assoc.@Attr@) = assoc . 10530 eq parseAttrs('associative.@Attr@) = assoc . 10531 eq parseAttrs('comm.@Attr@) = comm . 10532 eq parseAttrs('commutative.@Attr@) = comm . 10533 eq parseAttrs('idem.@Attr@) = idem . 10534 eq parseAttrs('idempotent.@Attr@) = idem . 10535 eq parseAttrs('id:_[T]) = none . 10536 eq parseAttrs('identity:_[T]) = none . 10537 eq parseAttrs('left`id:_[T]) = none . 10538 eq parseAttrs('left`identity:_[T]) = none . 10539 eq parseAttrs('right`id:_[T]) = none . 10540 eq parseAttrs('right`identity:_[T]) = none . 10541 eq parseAttrs('poly`(_`)[T]) = poly(parseInt(T)) . 10542 eq parseAttrs('strat`(_`)[T]) = none . 10543 eq parseAttrs('strategy`(_`)[T]) = none . 10544 eq parseAttrs('memo.@Attr@) = none . 10545 eq parseAttrs('memoization.@Attr@) = none . 10546 eq parseAttrs('prec_['token[T]]) = prec(parseNat(T)) . 10547 eq parseAttrs('precedence_['token[T]]) = prec(parseNat(T)) . 10548 eq parseAttrs('prec_['`(_`)['token[T]]]) = prec(parseNat(T)) . 10549 eq parseAttrs('precedence_['`(_`)['token[T]]]) = prec(parseNat(T)) . 10550 eq parseAttrs('gather`(_`)['neTokenList[T]]) = gather(downQidList(T)) . 10551 eq parseAttrs('gathering`(_`)['neTokenList[T]]) = gather(downQidList(T)) . 10552 eq parseAttrs('format`(_`)['neTokenList[T]]) = none . 10553 eq parseAttrs('ctor.@Attr@) = ctor . 10554 eq parseAttrs('constructor.@Attr@) = ctor . 10555 eq parseAttrs('frozen.@Attr@) = none . 10556 eq parseAttrs('frozen`(_`)[T]) = none . 10557 eq parseAttrs('iter.@Attr@) = iter . 10558 eq parseAttrs('ditto.@Attr@) = ditto . 10559 eq parseAttrs('special`(_`)[T]) = parseSpecial(parseHookList(T)) . 10560 eq parseAttrs('config.@Attr@) = config . 10561 eq parseAttrs('object.@Attr@) = object . 10562 eq parseAttrs('msg.@Attr@) = msg . 10563 eq parseAttrs('message.@Attr@) = msg . 10564 eq parseAttrs('metadata_['token[T]]) = metadata(downString(downQid(T))) . 10565 eq parseAttrs('variant.@Attr@) = variant . 10566 eq parseAttrs('nonexec.@Attr@) = nonexec . 10567 10568 op parseSpecial : Set<Hook> -> Attr . 10569 op parseHookList : Term -> Set<Hook> . 10570 op hookList : Set<Hook> -> HookList . 10571 sort Set<Hook> . 10572 subsort Hook < Set<Hook> . 10573 op none : -> Set<Hook> . 10574 op _._ : Set<Hook> Set<Hook> -> Set<Hook> [assoc comm id: none] . 10575 var SH : Set<Hook> . 10576 var H : Hook . 10577 10578 eq parseSpecial(none) = none . 10579 eq parseSpecial(SH) = special(hookList(SH)) [owise] . 10580 10581 eq parseHookList('__[T, TL]) = parseHookList(T) . parseHookList(TL) . 10582 eq parseHookList('id-hook_['token[T]]) = id-hook(downQid(T), nil) . 10583 eq parseHookList('id-hook_`(_`)['token[T], 'neTokenList[T']]) 10584 = id-hook(downQid(T), downQidList(T')) . 10585 eq parseHookList( 10586 'op-hook_`(_:_->_`)[ 10587 'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]]) 10588 = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) . 10589 eq parseHookList('op-hook_`(_:`->_`)['token[T], 'token[T'], 'token[T'']]) 10590 = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) . 10591 eq parseHookList( 10592 'op-hook_`(_:_~>_`)[ 10593 'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]]) 10594 = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) . 10595 eq parseHookList('op-hook_`(_:`~>_`)['token[T], 'token[T'], 'token[T'']]) 10596 = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) . 10597 eq parseHookList('term-hook_`(_`)['token[T], T']) = none . 10598 10599 eq hookList(H) = H . 10600 eq hookList(H . SH) = H hookList(SH) [owise] . 10601 10602*** Given a term representing a machine integer, the function 10603*** \texttt{parseInt} returns the corresponding integer. 10604 10605 op parseNat : Term -> Nat . 10606 10607 op parseInt : Term -> Int . 10608 op parseInt : TermList -> IntList . 10609 10610 eq parseInt(('neTokenList['__[TL]], TL')) = parseInt(TL) parseInt(TL') . 10611 eq parseInt(('neTokenList[QI], TL)) = parseInt(QI) parseInt(TL) . 10612 eq parseInt(empty) = nil . 10613 10614 eq parseInt((T, TL)) = parseInt(T) parseInt(TL) [owise] . 10615 eq parseInt(nil) = nil . 10616 10617 eq parseInt(Ct) 10618 = downNat( 10619 qid(substr(string(getName(Ct)), 1, length(string(getName(Ct)))) 10620 + ".Int")) . 10621 10622 eq parseNat(Ct) 10623 = downNat( 10624 qid(substr(string(getName(Ct)), 1, length(string(getName(Ct)))) 10625 + ".Nat")) . 10626 10627endfm 10628 10629------------------------------------------------------------------------------- 10630******************************************************************************* 10631------------------------------------------------------------------------------- 10632 10633*** 10634*** Parsing of Bubbles 10635*** 10636 10637*** In the following module \texttt{BUBBLE-PARSING}, the definitions for the 10638*** basic processing of bubbles are introduced. In it we declare a function 10639*** \texttt{solveBubbles} which takes a bubble and some other arguments and 10640*** returns the term resulting from parsing it. 10641 10642 10643------------------------------------------------------------------------------- 10644******************************************************************************* 10645------------------------------------------------------------------------------- 10646 10647fmod BUBBLE-PARSING is 10648 pr DATABASE . 10649 pr MOVE-UP . 10650 pr MOVE-DOWN . 10651 pr MOD-EXP-PARSING . 10652 pr PRINT-SYNTAX-ERROR . 10653 10654 vars T T' : Term . 10655 vars M M' : Module . 10656 var B : Bool . 10657 var QIL : QidList . 10658 vars DB DB' : Database . 10659 var TL : TermList . 10660 var S : Sort . 10661 vars QI QI' F : Qid . 10662 var VDS : OpDeclSet . 10663 var C : Constant . 10664 var V : Variable . 10665 var N : Nat . 10666 var Tp : Type . 10667 var RP : [ResultPair] . 10668 var MN : ModuleName . 10669 var ME : ModuleExpression . 10670 var U : Module . 10671 var Cond : Condition . 10672 10673 op resultPairError : QidList -> [ResultPair] [ctor] . 10674 10675*** As we shall see in Section~\ref{evaluation}, a declaration importing the 10676*** predefined module \texttt{UP} (see Section~\ref{non-built-in-predefined}) 10677*** is added to all modules importing the \texttt{META-LEVEL} module. The 10678*** \texttt{solveBubbles} function is called with a `flag' indicating whether 10679*** the module can contain calls to the \texttt{up} function or not. Thus, 10680*** when we call \texttt{metaParse} with some bubble and the module in which 10681*** such bubble has to be parsed, if there are occurrences of the function 10682*** \texttt{up} in it, they will be of the form \verb~'token[T]]~ or 10683*** \verb~'up['token[T], 'bubble[T']]~ for terms \texttt{T} and \texttt{T'}. 10684*** The function \texttt{solveUps} will evaluate them. 10685 10686 op solveBubbles : Term Module Bool OpDeclSet Database -> [Term] . 10687 op solveUps : TermList Database -> [TermList] . 10688 op solveUpsCondition : Condition Database -> Condition . 10689 op solveUpsModExp : TermList Database -> [TermList] . 10690 op constsToVars : Term OpDeclSet -> Term [memo] . 10691 op constsToVars : TermList OpDeclSet -> TermList [memo] . 10692 op constsToVarsAux : Constant OpDeclSet -> Qid [memo] . 10693 10694 eq constsToVars(F[TL], VDS) = F[constsToVars(TL, VDS)] . 10695 eq constsToVars(C, VDS) = constsToVarsAux(C, VDS) . 10696 eq constsToVars(V, VDS) = V . 10697 eq constsToVars(qidError(QIL), VDS) = qidError(QIL) . 10698 ceq constsToVars((T, TL), VDS) 10699 = (constsToVars(T, VDS), constsToVars(TL, VDS)) 10700 if TL =/= empty . 10701 10702 eq constsToVarsAux(C, (op F : nil -> Tp [none] .) VDS) 10703 = if getName(C) == F 10704 then qid(string(F) + ":" + string(Tp)) 10705 else constsToVarsAux(C, VDS) 10706 fi . 10707 eq constsToVarsAux(C, none) = C . 10708 10709 ceq solveBubbles('bubble[T], M, true, VDS, DB) 10710 *** if META-LEVEL is a submodule the ups need to be solved 10711 = if RP :: ResultPair 10712 then solveUps(constsToVars(getTerm(RP), VDS), DB) 10713 else qidError('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n 10714 '\r 'Error: '\o 'no 'parse 'for QIL '\n) 10715 fi 10716 if M' := addOps(VDS, M) 10717 /\ QIL := downQidList(T) 10718 /\ RP := metaParse(M', QIL, anyType) . 10719 10720 ceq solveBubbles('bubble[T], M, false, VDS, DB) 10721 = if RP :: ResultPair 10722 then constsToVars(getTerm(RP), VDS) 10723 else qidError('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n 10724 '\r 'Error: '\o 'no 'parse 'for QIL '\n) 10725 fi 10726 if M' := addOps(VDS, M) 10727 /\ QIL := downQidList(T) 10728 /\ RP := metaParse(M', QIL, anyType) . 10729 10730*** The \texttt{solveBubbles1} function is in charge of calling the function 10731*** \texttt{metaParse}. The flag indicating the inclusion of the module 10732*** \texttt{META-LEVEL} in the module in which the term appears decides 10733*** whether the function \texttt{solveUps} is called or not, so the extra 10734*** price of searching for calls to the \texttt{up} function is paid only 10735*** when an occurrence of the function is possible. This function takes care 10736*** of the occurrences of the \texttt{up} function that may exist in such 10737*** bubbles. 10738 10739*** The function \texttt{solveUps} goes through the term looking for a term 10740*** with \texttt{'up} as top operator and \texttt{'token} as top operator of 10741*** its unique argument if there is only one argument, or with \texttt{'token} 10742*** and \texttt{'bubble} as top operators of its first and second arguments, 10743*** respectively, if there are two. If a term of the form 10744*** \mbox{\texttt{'up['token[T]]}} is reached, it is replaced by the 10745*** metarepresentation of the flat version of the module in the database with 10746*** the name given by the token. If a term of form 10747*** \mbox{\texttt{'up['token[T], 'bubble[T']]}} is reached, the 10748*** metarepresentation of the result of parsing the bubble in the signature 10749*** of the module with the name given by the token, after solving possible 10750*** nested calls to the \texttt{up} function, is returned. 10751 10752 eq solveUps(QI, DB) = QI . 10753 eq solveUps(F[TL], DB) = F[solveUps(TL, DB)] [owise] . 10754 ceq solveUps((T, TL), DB) 10755 = (solveUps(T, DB), solveUps(TL, DB)) 10756 if TL =/= empty . 10757 10758 eq solveUps('upModule['token[T]], DB) 10759 = solveUpsModExp('upModule['token[T]], DB) . 10760 eq solveUps('upModule['`(_`)[T]], DB) 10761 = solveUpsModExp('upModule['`(_`)[T]], DB) . 10762 eq solveUps('upModule['_`{_`}[T, T']], DB) 10763 = solveUpsModExp('upModule['_`{_`}[T, T']], DB) . 10764 eq solveUps('upModule['_*`(_`)[T, T']], DB) 10765 = solveUpsModExp('upModule['_*`(_`)[T, T']], DB) . 10766 eq solveUps('upModule['_+_[T, T']], DB) 10767 = solveUpsModExp('upModule['_+_[T, T']], DB) . 10768 eq solveUps('upModule['TUPLE`[_`]['token[T]]], DB) 10769 = solveUpsModExp('upModule['TUPLE`[_`]['token[T]]], DB) . 10770 eq solveUps('upModule['POWER`[_`]['token[T]]], DB) 10771 = solveUpsModExp('upModule['POWER`[_`]['token[T]]], DB) . 10772 10773 eq solveUpsCondition(T = T' /\ Cond, DB) 10774 = solveUps(T, DB) = solveUps(T', DB) /\ solveUpsCondition(Cond, DB) . 10775 eq solveUpsCondition(T : S /\ Cond, DB) 10776 = solveUps(T, DB) : S /\ solveUpsCondition(Cond, DB) . 10777 eq solveUpsCondition(T := T' /\ Cond, DB) 10778 = T := solveUps(T', DB) /\ solveUpsCondition(Cond, DB) . 10779 eq solveUpsCondition(T => T' /\ Cond, DB) 10780 = solveUps(T, DB) => solveUps(T', DB) /\ solveUpsCondition(Cond, DB) . 10781 eq solveUpsCondition(nil, DB) = nil . 10782 10783 ceq solveUpsModExp('upModule[T], DB) 10784 = up(getFlatModule(MN, DB')) 10785 if < DB' ; MN > := evalModExp(parseModExp(T), DB) 10786 /\ unitInDb(MN, DB') . 10787 ceq solveUpsModExp('upModule[T], DB) 10788 = qidError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n) 10789 if MN := parseModExp(T) 10790 [owise] . 10791 10792 eq solveUps('upTerm['token[T], 'bubble[T']], DB) 10793 = solveUpsModExp('upTerm['token[T], 'bubble[T']], DB) . 10794 eq solveUps('upTerm['`(_`)[T], 'bubble[T']], DB) 10795 = solveUpsModExp('upTerm['`(_`)[T], 'bubble[T']], DB) . 10796 eq solveUps('upTerm['_`{_`}[T, T'], 'bubble[T']], DB) 10797 = solveUpsModExp('upTerm['_`{_`}[T, T'], 'bubble[T']], DB) . 10798 eq solveUps('upTerm['_*`(_`)[T, T'], 'bubble[T']], DB) 10799 = solveUpsModExp('upTerm['_*`(_`)[T, T'], 'bubble[T']], DB) . 10800 eq solveUps('upTerm['_+_[T, T'], 'bubble[T']], DB) 10801 = solveUpsModExp('upTerm['_+_[T, T'], 'bubble[T']], DB) . 10802 eq solveUps('upTerm['TUPLE`[_`]['token[T]], 'bubble[T']], DB) 10803 = solveUpsModExp('upTerm['TUPLE`[_`]['token[T]], 'bubble[T']], DB) . 10804 eq solveUps('upTerm['POWER`[_`]['token[T]], 'bubble[T']], DB) 10805 = solveUpsModExp('upTerm['POWER`[_`]['token[T]], 'bubble[T']], DB) . 10806 10807 ceq solveUpsModExp('upTerm[T, 'bubble[T']], DB) 10808 = if included('META-MODULE, getImports(getInternalModule(MN, DB')), DB') 10809 then if metaParse(U, QIL, anyType) :: ResultPair 10810 then up(solveUps(getTerm(metaParse(U, QIL, anyType)), DB')) 10811 else qidError('\r 'Warning: '\o 10812 'No 'parse 'for 'argument 'of 'up 10813 printSyntaxError(metaParse(U, QIL, anyType), QIL) 10814 '\n) 10815 fi 10816 else if metaParse(U, QIL, anyType) :: ResultPair 10817 then up(getTerm(metaParse(U, QIL, anyType))) 10818 else qidError('\r 'Warning: '\o 10819 'No 'parse 'for 'argument 'of 'up 10820 printSyntaxError(metaParse(U, QIL, anyType), QIL) 10821 '\n) 10822 fi 10823 fi 10824 if < DB' ; MN > := evalModExp(parseModExp(T), DB) 10825 /\ U := getFlatModule(MN, DB') 10826 /\ QIL := downQidList(T'). 10827 ceq solveUpsModExp('upTerm[T, 'bubble[T']], DB) 10828 = qidError('\r 'Error: 'op '\o 'Module header2QidList(ME) 'not 'in 'database. '\n) 10829 if ME := parseModExp(T) 10830 [owise] . 10831 10832 eq solveUps('`[_`][QI], DB) = '`[_`][QI] . 10833 ceq solveUps('`[_`]['token[T]], DB) 10834 = up(getFlatModule(QI, database(evalModExp(QI, DB)))) 10835 if QI := downQid(T) . 10836 eq solveUps('`[_`][F[TL]], DB) = '`[_`][F[solveUps(TL, DB)]] [owise] . 10837 10838endfm 10839 10840------------------------------------------------------------------------------- 10841******************************************************************************* 10842------------------------------------------------------------------------------- 10843 10844*** 10845*** Parsing the Bubbles in a Module 10846*** 10847 10848*** The \texttt{solveBubbles} function defined in the 10849*** \texttt{UNIT-BUBBLE-PARSING} module takes a term of sort \texttt{Module} (a 10850*** preunit in fact) and a signature, and returns the unit resulting from the 10851*** evaluation (parsing) of all the bubbles in it. 10852 10853------------------------------------------------------------------------------- 10854******************************************************************************* 10855------------------------------------------------------------------------------- 10856 10857view AttrSet from TRIV to META-LEVEL is 10858 sort Elt to AttrSet . 10859endv 10860 10861 10862fmod UNIT-BUBBLE-PARSING is 10863 pr BUBBLE-PARSING . 10864 pr DATABASE . 10865 pr MOVE-UP . 10866 pr MOVE-DOWN . 10867 pr PRINT-SYNTAX-ERROR . 10868 10869 vars T T' T'' T3 T4 : Term . 10870 vars T? T?' : [Term] . 10871 vars TL TL' TL'' : TermList . 10872 vars TL? TL?' : [TermList] . 10873 var B : Bool . 10874 vars M M' M'' : Module . 10875 var DB : Database . 10876 vars PU U U' : Module . 10877 var K : Kind . 10878 var KS : KindSet . 10879 vars S S' : Sort . 10880 var SS : SortSet . 10881 var VE : ViewExp . 10882 vars Ty Ty' Tp : Type . 10883 vars TyL TyL' : TypeList . 10884 var At : Attr . 10885 vars AtS AtS' AtS'' : AttrSet . 10886 var NL : IntList . 10887 var QI QI' QI'' QI3 QI4 QI5 F L : Qid . 10888 vars QIL QIL' : QidList . 10889 var I : Nat . 10890 var Hk : Hook . 10891 var HkL : HookList . 10892 var MAS : MembAxSet . 10893 var Eq : Equation . 10894 var EqS : EquationSet . 10895 var Rl : Rule . 10896 var RlS : RuleSet . 10897 var OPD : OpDecl . 10898 vars OPDS OPDS' OPDS'' VDS : OpDeclSet . 10899 var CD? : [Condition] . 10900 var Ct : Constant . 10901 var RP : [ResultPair] . 10902 var St : String . 10903 10904*** In the parsing of bubbles themselves, we consider three different cases: 10905*** The case of having one single bubble in which no context is 10906*** considered (used to parse bubbles in term maps in views and in the 10907*** special attributes of operators); the case of two bubbles to be parsed in 10908*** the same connected component (used for bubbles in equations and rules), 10909*** and the case of one bubble to be parsed in a specific sort (used for the 10910*** bubbles appearing in the identity element attributes in the declarations 10911*** of operators, and in membership axioms). These three cases are reduced to 10912*** the case of one single bubble without context, which is handled by the 10913*** function \texttt{solveBubbles3}. 10914 10915 op solveBubblesEq : Term Term Module Bool OpDeclSet Database -> Term . 10916 op solveBubblesCEq : Term Term Module Bool OpDeclSet Database -> Term . 10917 op solveBubblesRl : Term Term Module Bool OpDeclSet Database -> Term . 10918 op solveBubblesCRl : Term Term Module Bool OpDeclSet Database -> Term . 10919 op solveBubbles2 : Term [Type] Module Bool OpDeclSet Database -> Term . 10920 op solveBubblesCond : Term Module Module Bool OpDeclSet Database -> [Condition] . 10921 10922 op conditionError : QidList -> [Condition] [ctor format (r o)] . 10923 10924*** The case of two bubbles, generated in the case of equations and rules, is 10925*** reduced to the case with one single bubble using the polymorphic operator 10926*** \verb~_==_~ and enclosing each of the bubbles in parentheses. Below, we 10927*** shall see how after calling this function the terms corresponding to each 10928*** of the bubbles is extracted. 10929 10930 ceq solveBubblesEq('bubble[T], 'bubble[T'], M, B, VDS, DB) 10931 = if RP :: ResultPair 10932 then if B 10933 then solveUps(constsToVars(getTerm(RP), VDS), DB) 10934 else constsToVars(getTerm(RP), VDS) 10935 fi 10936 else qidError('\r 'Warning: 10937 '\o printSyntaxError(RP, '`( QIL '`) '= '`( QIL' '`)) '\n 10938 '\r 'Error: '\o 'no 'parse 'for 'eq QIL '\s '= '\s QIL' '\n) 10939 fi 10940 if M' := addOps((VDS 10941 op '_@@@=@@@_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .), 10942 addSorts('@@@, M)) 10943 /\ QIL := downQidList(T) 10944 /\ QIL' := downQidList(T') 10945 /\ RP := metaParse(M', '`( QIL '`) '@@@=@@@ '`( QIL' '`), '@@@) . 10946 10947 ceq solveBubblesCEq('bubble[T], 'bubble[T'], M, B, VDS, DB) 10948 = if RP :: ResultPair 10949 then if B 10950 then solveUps(constsToVars(getTerm(RP), VDS), DB) 10951 else constsToVars(getTerm(RP), VDS) 10952 fi 10953 else qidError('\r 'Warning: 10954 '\o printSyntaxError(RP, '`( QIL '`) '= '`( QIL' '`)) '\n 10955 '\r 'Error: '\o 'no 'parse 'for 'ceq QIL '\s '= '\s QIL' '\n) 10956 fi 10957 if M' := addOps((VDS 10958 op '_@@@=@@@_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .), 10959 addSorts('@@@, M)) 10960 /\ QIL := downQidList(T) 10961 /\ QIL' := downQidList(T') 10962 /\ RP := metaParse(M', '`( QIL '`) '@@@=@@@ '`( QIL' '`), '@@@) . 10963 10964 ceq solveBubblesRl('bubble[T], 'bubble[T'], M, B, VDS, DB) 10965 = if RP :: ResultPair 10966 then if B 10967 then solveUps(constsToVars(getTerm(RP), VDS), DB) 10968 else constsToVars(getTerm(RP), VDS) 10969 fi 10970 else qidError('\r 'Warning: 10971 '\o printSyntaxError(RP, '`( QIL '`) '=> '`( QIL' '`)) '\n 10972 '\r 'Error: '\o 'no 'parse 'for 'rl QIL '\s '=> '\s QIL' '\n) 10973 fi 10974 if M' := addOps((VDS 10975 op '_@@@=>@@@_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .), 10976 addSorts('@@@, M)) 10977 /\ QIL := downQidList(T) 10978 /\ QIL' := downQidList(T') 10979 /\ RP := metaParse(M', '`( QIL '`) '@@@=>@@@ '`( QIL' '`), '@@@) . 10980 ceq solveBubblesCRl('bubble[T], 'bubble[T'], M, B, VDS, DB) 10981 = if RP :: ResultPair 10982 then if B 10983 then solveUps(constsToVars(getTerm(RP), VDS), DB) 10984 else constsToVars(getTerm(RP), VDS) 10985 fi 10986 else qidError('\r 'Warning: 10987 '\o printSyntaxError(RP, '`( QIL '`) '=> '`( QIL' '`)) '\n 10988 '\r 'Error: '\o 'no 'parse 'for 'crl QIL '\s '=> '\s QIL' '\n) 10989 fi 10990 if M' := addOps((VDS 10991 op '_@@@=>@@@_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .), 10992 addSorts('@@@, M)) 10993 /\ QIL := downQidList(T) 10994 /\ QIL' := downQidList(T') 10995 /\ RP := metaParse(M', '`( QIL '`) '@@@=>@@@ '`( QIL' '`), '@@@) . 10996 10997 10998 ceq solveBubbles2('bubble[T], T?:Type?, M, true, VDS, DB) 10999 = if RP :: ResultPair 11000 then solveUps(constsToVars(getTerm(RP), VDS), DB) 11001 else qidError('\r 'Warning: 11002 '\o printSyntaxError(RP, QIL) '\n 11003 '\r 'Error: 'No 'parse 'for QIL '\n) 11004 fi 11005 if QIL := downQidList(T) 11006 /\ RP := metaParse(M, QIL, T?:Type?) . 11007 ceq solveBubbles2('bubble[T], T?:Type?, M, false, VDS, DB) 11008 = if RP :: ResultPair 11009 then constsToVars(getTerm(RP), VDS) 11010 else qidError('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n 11011 '\r 'Error: 'No 'parse 'for QIL '\n) 11012 fi 11013 if QIL := downQidList(T) 11014 /\ RP := metaParse(M, QIL, T?:Type?) . 11015 11016 op addInfoConds : Module -> [Module] . 11017 op addInfoConds : Module SortSet -> Module . 11018 11019 eq addInfoConds(M) = addInfoConds(M, getAllSorts(M)) . 11020 11021 eq addInfoConds(M, '@Token@ ; SS) = addInfoConds(M, SS) . 11022 eq addInfoConds(M, '@Bubble@ ; SS) = addInfoConds(M, SS) . 11023 eq addInfoConds(M, S ; SS) 11024 = addInfoConds( 11025 addOps(op qid(string(S)) : nil -> '@Sort@ [ctor] . 11026 op '_:_ : S '@Sort@ -> '@Condition@ [ctor prec(71)] ., M), 11027 SS) 11028 [owise] . 11029 eq addInfoConds(M, none) 11030 = addOps(op '_/\_ : '@Condition@ '@Condition@ -> '@Condition@ 11031 [ctor assoc prec(73)] . 11032 op '_=_ : 'Universal 'Universal -> '@Condition@ 11033 [ctor poly(1 2) prec(71)] . 11034 op '_:=_ : 'Universal 'Universal -> '@Condition@ 11035 [ctor poly(1 2) prec(71)] . 11036 op '_=>_ : 'Universal 'Universal -> '@Condition@ 11037 [ctor poly(1 2) prec(71)] ., 11038 addSorts('@Condition@ ; '@Sort@, 11039 if 'Bool in getSorts(M) 11040 then addSubsorts(subsort 'Bool < '@Condition@ ., M) 11041 else M 11042 fi)) . 11043 11044 ceq solveBubblesCond('bubble[T], M, M', B, VDS, DB) 11045 = if 'Bool in getSorts(M) 11046 and-then metaParse(M, QIL, 'Bool) :: ResultPair 11047 then if B 11048 then solveUps(constsToVars(getTerm(metaParse(M, QIL, 'Bool)), VDS), DB) 11049 = 'true.Bool 11050 else constsToVars(getTerm(metaParse(M, QIL, 'Bool)), VDS) 11051 = 'true.Bool 11052 fi 11053 else if metaParse(M', QIL, '@Condition@) :: ResultPair 11054 then if B 11055 then solveUpsCondition( 11056 parseCond(getTerm(metaParse(M', QIL, '@Condition@)), VDS), DB) 11057 else parseCond(getTerm(metaParse(M', QIL, '@Condition@)), VDS) 11058 fi 11059 else conditionError('\r 'Warning: '\o 11060 printSyntaxError(metaParse(M', QIL, '@Condition@), QIL) '\n) 11061 fi 11062 fi 11063 if QIL := downQidList(T) . 11064 11065 op parseCond : Term OpDeclSet -> Condition . 11066 11067 eq parseCond('_/\_[T, T'], VDS) = parseCond(T, VDS) /\ parseCond(T', VDS) . 11068 eq parseCond('_=_[T, T'], VDS) 11069 = constsToVars(T, VDS) = constsToVars(T', VDS) . 11070 eq parseCond('_:_[T, T'], VDS) = constsToVars(T, VDS) : getName(T') . 11071 eq parseCond('_:=_[T, T'], VDS) 11072 = constsToVars(T, VDS) := constsToVars(T', VDS) . 11073 eq parseCond('_=>_[T, T'], VDS) 11074 = constsToVars(T, VDS) => constsToVars(T', VDS) . 11075 eq parseCond(T, VDS) = constsToVars(T, VDS) = 'true.Bool [owise] . 11076 11077*** Since bubbles can only appear in the identity or special attributes in the 11078*** declaration of operators, in equations, membership axioms, and rules, the 11079*** evaluation of bubbles on a preunit is reduced to calls to the 11080*** \texttt{solveBubbles} functions on each of these sTS of declarations. 11081 11082 op solveBubblesMod : Module OpDeclSet Module Bool OpDeclSet Database -> Module . 11083 11084 op solveBubbles : EquationSet Module [Module] Bool OpDeclSet Database -> EquationSet . 11085 op solveBubbles : RuleSet Module [Module] Bool OpDeclSet Database -> RuleSet . 11086 op solveBubbles : MembAxSet Module [Module] Bool OpDeclSet Database -> MembAxSet . 11087 op solveBubbles : Condition Module Bool OpDeclSet Database -> Condition . 11088 op solveBubblesOps : OpDeclSet OpDeclSet Module Module -> OpDeclSet . 11089 op solveBubblesOps : OpDeclSet OpDeclSet Module -> OpDeclSet . 11090 op solveBubblesOpsAux : OpDeclSet Module -> OpDeclSet . 11091 op solveBubblesAts : AttrSet TypeList Type Module -> AttrSet . 11092 op solveBubblesHooks : HookList Type Module -> HookList . 11093 11094 ceq solveBubblesMod(PU, OPDS, M, B, VDS, DB) 11095 = setOps( 11096 (if getMbs(PU) == none and getEqs(PU) == none and getRls(PU) == none 11097 then PU 11098 else setEqs( 11099 setMbs( 11100 setRls(PU, 11101 solveBubbles(getRls(PU), M', addInfoConds(M'), B, VDS, DB)), 11102 solveBubbles(getMbs(PU), M', addInfoConds(M'), B, VDS, DB)), 11103 solveBubbles(getEqs(PU), M', addInfoConds(M'), B, VDS, DB)) 11104 fi), 11105 solveBubblesOps(getOps(PU), OPDS, M')) 11106 if M' := addOps(VDS, M) . 11107 11108*** To avoid the parsing ambiguities in the identity elements we add the sort 11109*** of the operator to be used as context in which doing the parsing. We 11110*** assume that the term given as identity element of an operator is in the 11111*** kind of the sort of such operator. 11112 11113 eq solveBubblesOps(OPDS, OPDS', M) 11114 = solveBubblesOps(OPDS, OPDS', 11115 setSubsorts( 11116 setSorts(emptyFModule('DUMMY), getSorts(M)), getSubsorts(M)), M) . 11117 11118 ceq solveBubblesOps(op F : TyL -> Ty [ditto AtS] . op F : TyL' -> Ty' [AtS'] . OPDS, OPDS', M, M') 11119 = solveBubblesOps( 11120 op F : TyL -> Ty [AtS removeCtorMetadata(AtS'')] . op F : TyL' -> Ty' [AtS''] . OPDS, 11121 OPDS', M, M') 11122 if not ditto in AtS' 11123 /\ sameKind(M, TyL Ty, TyL' Ty') 11124---- /\ AtS'' := solveBubblesAts(AtS', TyL', Ty', M') . 11125 /\ AtS'' := AtS' . 11126 ceq solveBubblesOps(op F : TyL -> Ty [ditto AtS] . OPDS, op F : TyL' -> Ty' [AtS'] . OPDS', M, M') 11127 = solveBubblesOps(op F : TyL -> Ty [AtS removeCtorMetadata(AtS'')] . OPDS, op F : TyL' -> Ty' [AtS''] . OPDS', M, M') 11128 if not ditto in AtS' 11129 /\ sameKind(M, TyL Ty, TyL' Ty') 11130---- /\ AtS'' := solveBubblesAts(AtS', TyL, Ty, M') 11131 /\ AtS'' := AtS' . 11132---- [owise] . 11133 eq solveBubblesOps(OPDS, OPDS', M, M') 11134 = solveBubblesOpsAux(OPDS, M') 11135 [owise] . 11136 11137 op removeCtorMetadata : AttrSet -> AttrSet . 11138 eq removeCtorMetadata(ctor AtS) = removeCtorMetadata(AtS) . 11139 eq removeCtorMetadata(metadata(St) AtS) = removeCtorMetadata(AtS) . 11140 eq removeCtorMetadata(AtS) = AtS [owise] . 11141 11142 eq solveBubblesOpsAux(op F : TyL -> Ty [AtS] . OPDS, M) 11143 = op F : TyL -> Ty [solveBubblesAts(AtS, TyL, Ty, M)] . 11144 solveBubblesOpsAux(OPDS, M) . 11145 eq solveBubblesOpsAux(none, M) = none . 11146 11147 eq solveBubblesAts(id('bubble[T]) AtS, TyL, Ty, M) 11148 = (id(solveBubbles2('bubble[T], Ty, M, false, none, emptyDatabase)) 11149 solveBubblesAts(AtS, TyL, Ty, M)) . 11150 eq solveBubblesAts(left-id('bubble[T]) AtS, Ty TyL, Ty', M) 11151 = (left-id(solveBubbles2('bubble[T], Ty, M, false, none, emptyDatabase)) 11152 solveBubblesAts(AtS, Ty TyL, Ty', M)) . 11153 eq solveBubblesAts(right-id('bubble[T]) AtS, TyL Ty, Ty', M) 11154 = (right-id(solveBubbles2('bubble[T], Ty, M, false, none, emptyDatabase)) 11155 solveBubblesAts(AtS, TyL Ty, Ty', M)) . 11156 eq solveBubblesAts(special(HkL) AtS, TyL, Ty, M) 11157 = (special(solveBubblesHooks(HkL, Ty, M)) 11158 solveBubblesAts(AtS, TyL, Ty, M)) . 11159 eq solveBubblesAts(AtS, TyL, Ty, M) = AtS [owise] . 11160 11161 eq solveBubblesHooks(term-hook(QI, 'bubble[T]) HkL, Ty, M) 11162 = term-hook(QI, 11163 solveBubbles2('bubble[T], anyType, M, false, none, emptyDatabase)) 11164 solveBubblesHooks(HkL, Ty, M) . 11165 eq solveBubblesHooks(Hk HkL, Ty, M) 11166 = Hk solveBubblesHooks(HkL, Ty, M) 11167 [owise] . 11168 eq solveBubblesHooks(nil, Ty, M) = nil . 11169 11170*** Since both sides of any equation or rule have to be in the same connected 11171*** component of sorts, we parse the two bubbles together using the 11172*** polymorphic operator \verb~_==_~\footnote{Note that if including 11173*** \texttt{BOOL} the operator \texttt{\_\,==\_\,} is added for each kind.}. 11174*** That is, given for example an equation as \verb~eq T = T' .~, we parse 11175*** \verb~T == T'~, forcing them to be parsed in the same connected component, 11176*** if possible. We add functions \texttt{lhs} and \texttt{rhs} to extract, 11177*** respectively, the lefthand and righthand side terms from the result. Note 11178*** that these are partial functions. 11179 11180 pr 2TUPLE{Term,AttrSet} 11181 * (op p1_ to term, op p2_ to attrSet, 11182 op `(_`,_`) : Term AttrSet -> Tuple{Term,AttrSet} to `{_`,_`}) . 11183 11184 op pullStmtAttrOut : Term OpDeclSet -> [Tuple{Term,AttrSet}] . 11185 op pullStmtAttrOutAux : Term TermList AttrSet OpDeclSet -> [Tuple{Term,AttrSet}] . 11186 op pullLabelOut : Term -> [Tuple{Term,AttrSet}] . 11187 11188 eq pullStmtAttrOut('bubble[QI], VDS) = {'bubble[QI], none} . 11189 eq pullStmtAttrOut('bubble['__[QI, QI']], VDS) = {'bubble['__[QI, QI']], none} . 11190 eq pullStmtAttrOut('bubble['__[QI, QI', QI'']], VDS) 11191 = {'bubble['__[QI, QI', QI'']], none} . 11192 eq pullStmtAttrOut('bubble['__[QI, QI', TL, QI'']], VDS) 11193 = if QI'' =/= ''`].Qid 11194 then {'bubble['__[QI, QI', TL, QI'']], none} 11195 else pullStmtAttrOutAux('bubble['__[QI, QI', TL, QI'']], (QI, QI', TL), none, VDS) 11196 fi . 11197 11198 eq pullStmtAttrOutAux(T, (TL, ''`[.Qid), AtS, VDS) 11199 = if AtS =/= none 11200 then {'bubble['__[TL]], AtS} 11201 else {T, none} 11202 fi . 11203 eq pullStmtAttrOutAux(T, (TL, QI, ''nonexec.Qid), AtS, VDS) 11204 = pullStmtAttrOutAux(T, (TL, QI), AtS nonexec, VDS) . 11205 eq pullStmtAttrOutAux(T, (TL, QI, ''variant.Qid), AtS, VDS) 11206 = pullStmtAttrOutAux(T, (TL, QI), AtS variant, VDS) . 11207 eq pullStmtAttrOutAux(T, (TL, QI, ''owise.Qid), AtS, VDS) 11208 = pullStmtAttrOutAux(T, (TL, QI), AtS owise, VDS) . 11209 eq pullStmtAttrOutAux(T, (TL, QI, ''otherwise.Qid), AtS, VDS) 11210 = pullStmtAttrOutAux(T, (TL, QI), AtS owise, VDS) . 11211 eq pullStmtAttrOutAux(T, (TL, QI, ''label.Qid, QI'), AtS, VDS) 11212 = if downQid(QI') :: Qid 11213 then pullStmtAttrOutAux(T, (TL, QI), AtS label(downQid(QI')), VDS) 11214 else {T, none} 11215 fi . 11216 eq pullStmtAttrOutAux(T, (TL, QI, ''metadata.Qid, QI'), AtS, VDS) 11217 = if downString(downQid(QI')) :: String 11218 then pullStmtAttrOutAux(T, (TL, QI), AtS metadata(downString(downQid(QI'))), VDS) 11219 else {T, none} 11220 fi . 11221 ceq pullStmtAttrOutAux(T, (TL, QI, ''`[.Qid, TL', ''print.Qid, TL''), AtS, VDS) 11222 = pullStmtAttrOutAux(T, (TL, QI, ''`[.Qid, TL'), AtS print(printArg(TL'', VDS)), VDS) 11223 if printArg(TL'', VDS) : QidList . 11224 eq pullStmtAttrOutAux(T, TL, AtS, VDS) = {T, none} [owise] . 11225 11226 op printArg : TermList OpDeclSet ~> QidList . 11227 ceq printArg((T, TL), op QI : nil -> Tp [AtS] . VDS) 11228 = qid(string(downQid(T)) + ":" + string(Tp)) printArg(TL, VDS) 11229 if QI = downQid(T) . 11230 ceq printArg((T, TL), VDS) 11231 = downQid(T) printArg(TL, VDS) 11232 if downString(downQid(T)) : String . 11233 eq printArg(empty, VDS) = nil . 11234 11235 eq pullLabelOut('bubble[QI]) = {'bubble[QI], none} . 11236 eq pullLabelOut('bubble['__[QI, QI']]) = {'bubble['__[QI, QI']], none} . 11237 eq pullLabelOut('bubble['__[QI, QI', QI'']]) 11238 = {'bubble['__[QI, QI', QI'']], none} . 11239 eq pullLabelOut('bubble['__[QI, QI', QI'', QI3]]) 11240 = {'bubble['__[QI, QI', QI'', QI3]], none} . 11241 eq pullLabelOut('bubble['__[QI, QI', QI'', QI3, TL]]) 11242 = if QI == ''`[.Qid and-then (QI'' == ''`].Qid and-then QI3 == '':.Qid) 11243 then {'bubble['__[TL]], label(downQid(QI'))} 11244 else {'bubble['__[QI, QI', QI'', QI3, TL]], none} 11245 fi . 11246 11247 ops lhs rhs : Term -> Term . 11248 eq lhs(F[T, T']) = T . 11249 eq lhs(F[T, T']) = T . 11250 eq rhs(F[T, T']) = T' . 11251 eq rhs(F[T, T']) = T' . 11252 eq lhs(qidError(QIL)) = qidError(QIL) . 11253 eq rhs(qidError(QIL)) = qidError(QIL) . 11254 11255 eq solveBubbles(EqS, M, unitError(QIL), B, VDS, DB) = equationError(QIL) . 11256 eq solveBubbles(RlS, M, unitError(QIL), B, VDS, DB) = ruleError(QIL) . 11257 eq solveBubbles(MAS, M, unitError(QIL), B, VDS, DB) = membAxError(QIL) . 11258 11259 eq solveBubbles(((eq T = T' [AtS] .) EqS), M, M', B, VDS, DB) 11260 = ((eq lhs(solveBubblesEq(term(pullLabelOut(T)), term(pullStmtAttrOut(T', VDS)), 11261 M, B, VDS, DB)) 11262 = rhs(solveBubblesEq(term(pullLabelOut(T)), term(pullStmtAttrOut(T', VDS)), 11263 M, B, VDS, DB)) 11264 [attrSet(pullLabelOut(T)) attrSet(pullStmtAttrOut(T', VDS)) AtS] .) 11265 solveBubbles(EqS, M, M', B, VDS, DB)) . 11266 eq solveBubbles(((ceq T = T' if T'' = 'true.Bool [AtS] .) EqS), 11267 M, M', B, VDS, DB) 11268 = ((ceq lhs(solveBubblesCEq(term(pullLabelOut(T)), T', M, B, VDS, DB)) 11269 = rhs(solveBubblesCEq(term(pullLabelOut(T)), T', M, B, VDS, DB)) 11270 if solveBubblesCond(term(pullStmtAttrOut(T'', VDS)), M, M', B, VDS, DB) 11271 [attrSet(pullLabelOut(T)) attrSet(pullStmtAttrOut(T'', VDS)) AtS] .) 11272 solveBubbles(EqS, M, M', B, VDS, DB)) . 11273 eq solveBubbles((none).EquationSet, M, M', B, VDS, DB) = none . 11274 11275 eq solveBubbles(((rl T => T' [AtS] .) RlS), M, M', B, VDS, DB) 11276 = ((rl lhs(solveBubblesRl(term(pullLabelOut(T)), 11277 term(pullStmtAttrOut(T', VDS)), M, B, VDS, DB)) 11278 => rhs(solveBubblesRl(term(pullLabelOut(T)), 11279 term(pullStmtAttrOut(T', VDS)), M, B, VDS, DB)) 11280 [attrSet(pullLabelOut(T)) attrSet(pullStmtAttrOut(T', VDS)) AtS] .) 11281 solveBubbles(RlS, M, M', B, VDS, DB)) . 11282 eq solveBubbles( 11283 ((crl T => T' if T'' = 'true.Bool [AtS] .) RlS), M, M', B, VDS, DB) 11284 = ((crl lhs(solveBubblesCRl(term(pullLabelOut(T)), T', M, B, VDS, DB)) 11285 => rhs(solveBubblesCRl(term(pullLabelOut(T)), T', M, B, VDS, DB)) 11286 if solveBubblesCond(term(pullStmtAttrOut(T'', VDS)), M, M', B, VDS, DB) 11287 [attrSet(pullLabelOut(T)) attrSet(pullStmtAttrOut(T'', VDS)) AtS] .) 11288 solveBubbles(RlS, M, M', B, VDS, DB)) . 11289 eq solveBubbles((none).RuleSet, M, M', B, VDS, DB) = none . 11290 11291*** In the call to solve the bubbles in membership axioms we add the sort to 11292*** which it is constrained to be used as context. 11293 11294 eq solveBubbles(((mb T : S [AtS] .) MAS), M, M', B, VDS, DB) 11295 = ((mb solveBubbles2(term(pullLabelOut(T)), S, M, B, VDS, DB) : S 11296 [attrSet(pullLabelOut(T)) AtS] .) 11297 solveBubbles(MAS, M, M', B, VDS, DB)) . 11298 eq solveBubbles(((cmb T : S if T' = 'true.Bool [AtS] .) MAS), 11299 M, M', B, VDS, DB) 11300 = ((cmb solveBubbles2(term(pullLabelOut(T)), S, M, B, VDS, DB) : S 11301 if solveBubblesCond(T', M, M', B, VDS, DB) 11302 [attrSet(pullLabelOut(T)) AtS] .) 11303 solveBubbles(MAS, M, M', B, VDS, DB)) . 11304 eq solveBubbles((none).MembAxSet, M, M', B, VDS, DB) = none . 11305 11306*** The parsing process may generate error terms. Since in the 11307*** current version of the system Core Maude is generating the appropriate 11308*** error messages, we just have to worry about the elimination of these 11309*** terms. The effect is the same one as introducing a module at the object 11310*** level of Core Maude: If there is any term in an identity attribute in an 11311*** operator declaration, equation, rule, or membership axiom with a parsing 11312*** error a message is generated and the axiom is eliminated. 11313 11314 eq (op F : TyL -> Ty [id(qidError(QIL)) AtS] .) = opDeclError(QIL) . 11315 eq (op F : TyL -> Ty [left-id(qidError(QIL)) AtS] .) = opDeclError(QIL) . 11316 eq (op F : TyL -> Ty [right-id(qidError(QIL)) AtS] .) = opDeclError(QIL) . 11317 11318 eq (conditionError(QIL) /\ T = T' /\ CD?) = conditionError(QIL) . 11319 eq (conditionError(QIL) /\ T : S /\ CD?) = conditionError(QIL) . 11320 eq (conditionError(QIL) /\ T := T' /\ CD?) = conditionError(QIL) . 11321 eq (conditionError(QIL) /\ T => T' /\ CD?) = conditionError(QIL) . 11322 11323 eq (eq qidError(QIL) = T? [AtS] .) = equationError(QIL) . 11324 eq (eq T? = qidError(QIL) [AtS] .) = equationError(QIL) . 11325 eq (ceq qidError(QIL) = T? if CD? [AtS] .) = equationError(QIL) . 11326 eq (ceq T? = qidError(QIL) if CD? [AtS] .) = equationError(QIL) . 11327 eq (ceq T? = T?' if conditionError(QIL) [AtS] .) = equationError(QIL) . 11328 11329 eq (mb qidError(QIL) : S [AtS] .) = membAxError(QIL) . 11330 eq (cmb qidError(QIL) : S if CD? [AtS] .) = membAxError(QIL) . 11331 eq (cmb T? : S if conditionError(QIL) [AtS] .) = membAxError(QIL) . 11332 11333 eq (rl qidError(QIL) => T? [AtS] .) = ruleError(QIL) . 11334 eq (rl T? => qidError(QIL) [AtS] .) = ruleError(QIL) . 11335 eq (crl qidError(QIL) => T? if CD? [AtS] .) = ruleError(QIL) . 11336 eq (crl T? => qidError(QIL) if CD? [AtS] .) = ruleError(QIL) . 11337 eq (crl T? => T?' if conditionError(QIL) [AtS] .) = ruleError(QIL) . 11338 11339 eq F[qidError(QIL), TL?] = qidError(QIL) . 11340 eq F[TL?, qidError(QIL)] = qidError(QIL) . 11341 eq F[TL?, qidError(QIL), TL?'] = qidError(QIL) . 11342endfm 11343 11344------------------------------------------------------------------------------- 11345******************************************************************************* 11346------------------------------------------------------------------------------- 11347 11348*** The function \texttt{solveBubbles} defined in the following 11349*** \texttt{VIEW-BUBBLE-PARSING} module parses the bubbles in a set of preview 11350*** maps. It takes two modules, the signature of the view's source theory, 11351*** with the variables declared in the view, to parse the source term in the 11352*** term maps, and the target theory, with the mappings of the variable 11353*** declarations in the view, to parse the target terms. 11354 11355------------------------------------------------------------------------------- 11356******************************************************************************* 11357------------------------------------------------------------------------------- 11358 11359fmod VIEW-BUBBLE-PARSING is 11360 pr BUBBLE-PARSING . 11361 pr PRE-VIEW . 11362 11363 var OMS : OpMappingSet . 11364 vars T T' : Term . 11365 vars M M' : Module . 11366 var U : Module . 11367 var QIL : QidList . 11368 vars VDS VDS' : OpDeclSet . 11369 11370 op solveBubbles : OpMappingSet OpDeclSet OpDeclSet Module Module -> OpMappingSet . 11371 11372 eq solveBubbles(OMS, VDS, VDS', U, unitError(QIL)) = none . 11373 eq solveBubbles(OMS, VDS, VDS', unitError(QIL), U) = none . 11374 eq solveBubbles(OMS, VDS, VDS', M, M') = OMS [owise] . 11375 eq solveBubbles((op_to`term_.(T, T') OMS), VDS, VDS', M, M') 11376 = (op_to`term_.( 11377 solveBubbles(T, M, false, VDS, emptyDatabase), 11378 solveBubbles(T', M', false, VDS', emptyDatabase)) 11379 solveBubbles(OMS, VDS, VDS', M, M')) . 11380endfm 11381 11382------------------------------------------------------------------------------- 11383******************************************************************************* 11384------------------------------------------------------------------------------- 11385 11386*** 11387*** Module Expression Evaluation 11388*** 11389 11390*** So far we have not introduced more module expressions than those given by 11391*** simple quoted identifiers. We will introduce some later, but the scheme 11392*** followed for evaluating them is very simple and can be presented in a 11393*** generic way. Given a module expression and a database state, the 11394*** evaluation of a module expression results in the generation of a new 11395*** module, which is introduced in the database, with the module expression 11396*** as its name. The resulting database is then returned. If there is already 11397*** a module in the database with that name, the function returns the original 11398*** database without any change. The evaluation of a module expression may 11399*** produce the evaluation of other module expressions contained in the 11400*** modules involved in the process. This is the case, for example, for the 11401*** renaming of modules, in which not only the top module is renamed but, 11402*** perhaps, some of its submodules as well; it is also the case for the 11403*** instantiation of parameterized modules, where the module being 11404*** instantiated may contain submodules which are parameterized by some of 11405*** the parameter theories of the parameterized module in which are imported. 11406*** We shall discuss in more detail the renaming and instantiation of module 11407*** expressions in Sections~\ref{renaming} and~\ref{instantiation}, 11408*** respectively. 11409 11410*** We saw in Section~\ref{module-expressions} how it is possible to import a 11411*** module expression in which a parameterized module is instantiated by some 11412*** of the formal parameters of the parameterized module into which it is 11413*** imported. To be able to evaluate this kind of module expression, the list 11414*** of parameters of the module in which the module expression appears has to 11415*** be given. 11416 11417------------------------------------------------------------------------------- 11418******************************************************************************* 11419------------------------------------------------------------------------------- 11420 11421fmod MOD-EXPR-EVAL is 11422 pr DATABASE . 11423 11424 *** decl. moved to module DATABASE 11425 *** op evalModExp : ModuleExpression Database -> Database . 11426 op evalModExp : ModuleExpression ParameterDeclList Database -> Tuple{Database, ModuleExpression} . 11427 op evalViewExp : ViewExp ParameterDeclList Database -> Database . 11428 op evalViewExp : ParameterList ParameterDeclList Database -> Database . 11429 11430 var S : Sort . 11431 var QI : Qid . 11432 var ME : ModuleExpression . 11433 var PDL : ParameterDeclList . 11434 var DB : Database . 11435 vars VE VE' VE'' : ViewExp . 11436 vars PL PL' : ParameterList . 11437 11438 eq evalModExp(ME, DB) = evalModExp(ME, nil, DB) . 11439 11440 eq evalModExp(ME, PDL, DB) = < DB ; ME > [owise] . 11441 11442 eq evalModExp(QI, PDL, DB) 11443 = if unitInDb(QI, DB) 11444 then if compiledModule(QI, DB) 11445 then < DB ; QI > 11446 else < procModule(QI, DB) ; QI > 11447 fi 11448 else if upModule(QI, false) :: Module 11449 then < procModule(QI, insTermModule(QI, upModule(QI, false), DB)) ; QI > 11450 else < warning(DB, '\r 'Error: '\o 'Module QI 'not 'in 'database. '\n) ; QI > 11451 fi 11452 fi . 11453 11454 eq evalViewExp(QI, PDL, DB) 11455 = if labelInParameterDeclList(QI, PDL) 11456 then DB 11457 else if viewInDb(QI, DB) 11458 then if compiledView(QI, DB) 11459 then DB 11460 else procView(QI, DB) 11461 fi 11462 else if upView(QI) :: View 11463 then procView(upView(QI), DB) 11464 else warning(DB, ('\r 'Error: '\o 'View QI 'not 'in 'database. '\n)) 11465 fi 11466 fi 11467 fi . 11468 eq evalViewExp(S{PL}, PDL, DB) 11469 = if viewInDb(S{PL}, DB) 11470 then DB 11471 else viewInst(S, PL, PDL, evalViewExp(S, PDL, evalViewExp(PL, PDL, DB))) 11472 fi . 11473 ceq evalViewExp(VE ;; VE', PDL, DB) 11474 = evalViewExp(VE, PDL, evalViewExp(VE', PDL, DB)) 11475 if VE =/= mtViewExp /\ VE' =/= mtViewExp . 11476 eq evalViewExp((S, PL), PDL, DB) 11477 = evalViewExp(S, PDL, evalViewExp(PL, PDL, DB)) 11478 [owise] . 11479 eq evalViewExp((S{PL}, PL'), PDL, DB) 11480 = evalViewExp(S{PL}, PDL, evalViewExp(PL', PDL, DB)) 11481 [owise] . 11482 eq evalViewExp(nil, PDL, DB) = DB . 11483 11484 op viewInst : ViewExp ViewExp ParameterDeclList Database -> Database . 11485 11486******************************************************************************* 11487*** The equations specifying its behavior are later, in INST-EXPR-EVALUATION ** 11488******************************************************************************* 11489 11490endfm 11491 11492------------------------------------------------------------------------------- 11493******************************************************************************* 11494------------------------------------------------------------------------------- 11495 11496*** 11497*** The Transformation of Object-Oriented Modules to System Modules 11498*** 11499 11500*** The transformation of object-oriented modules into system modules has 11501*** already been discussed in Section~\ref{omod2mod}, and also in 11502*** \cite{Meseguer93b,ClavelDuranEkerLincolnMarti-OlietMeseguerQuesada99}. 11503*** We focus here on the part of the process accomplished by each of the main 11504 11505*** functions involved in the transformation. The transformation discussed 11506*** in~\cite{DuranMeseguer98} assumed that object-oriented modules were 11507*** flattened before being transformed into system modules. However, doing it 11508*** in this way, the transformations already made for the modules in the 11509*** structure were not reused. In the current system, the transformation is 11510*** done only for the module being introduced, the top of the structure, and 11511*** dusing the `internal' representations of the submodules stored in the 11512*** ddatabase for the rest of the structure. 11513 11514*** This approach requires gathering all class and subclass relation 11515*** declarations in the structure before starting with the transformation 11516*** process itself. The function \texttt{prepClasses} collects all these 11517*** declarations in the structure, and completes all the declarations of 11518*** classes with the attributes inherited from their superclasses. 11519*** \begin{comment} 11520*** This function makes use of a `dummy' module, in which the classes are 11521*** introduced as sorts and the subclass relations as subsort relations to be 11522*** able to compute all the operations on the subclass relation using the 11523*** built-in functions on sorts. 11524*** \end{comment} 11525 11526*** Once all the class declarations in the structure have been collected and 11527*** completed, the transformation is accomplished in two stages. First, the 11528*** function \texttt{omod2modAux} carries out the 11529*** following tasks: 11530*** \begin{itemize} 11531*** \item For each class declaration of the form 11532*** $\texttt{class }C\texttt{ | }a_1\texttt{:} S_1\texttt{,} 11533*** \ldots\texttt{,} a_n\texttt{:} S_n$, the following items are 11534*** introduced: a subsort $C$ of sort \texttt{Cid}, a constant 11535*** $C$ of sort $C$, and declarations of operations $a_i 11536*** \texttt{\ :\_} \texttt{ :\,\,} S_i \texttt{ -> Attribute}$ 11537*** for each attribute $a_i$ (the function 11538*** \texttt{ops4Attr} creates these declarations). 11539*** \item For each subclass relation of the form 11540*** $\texttt{subclass\ }C\texttt{\ <\ }C'$, a subsort 11541*** declaration $\texttt{subsort\ }C\texttt{\ <\ }C'$ is 11542*** introduced. 11543*** \item For each message declaration of the form \verb~msg F : TyL 11544*** -> S~, an operator declaration \verb~op F : TyL -> S~ is added. 11545*** \end{itemize} 11546*** When this process has been completed, the function \texttt{prepAxs} is 11547*** called. This function applies to the membership axioms, equations, and 11548*** rewriting rules in the module the transformations indicated in 11549*** Section~\ref{omod2mod}, so that they become applicable to all the objects 11550*** of the given class and of their subclasses. The set of attributes of the 11551*** objects appearing in the membership axioms, equations, and rewriting rules 11552*** are completed, so that the default convention of not having to 11553*** exhaustively mention the set of attributes of a class is supported. 11554 11555*** Note that in Meseguer's paper~\cite{Meseguer93b} a parallel hierarchy of 11556*** sorts was defined to deal with objects in different classes, and membership 11557*** axioms constraining the objects to their corresponding sorts were added. 11558*** The transformation could be easily completed with sorts, subsort relations, 11559*** and membership constraints as indicated there. In fact, these declarations 11560*** were added in an initial version and were then removed because they were 11561*** computationally expensive. However, there are examples in which it would 11562*** be interesting to have them; when needed, these declarations can be 11563*** explicitly added by the user in the current version. 11564 11565------------------------------------------------------------------------------- 11566******************************************************************************* 11567------------------------------------------------------------------------------- 11568 11569fmod EXT-TERMSET is 11570 protecting TERMSET . 11571 op |_| : TermSet -> Nat . 11572 eq | X:Term | T:TermSet | = 1 + | T:TermSet | . 11573 eq | emptyTermSet | = 0 . 11574endfm 11575 11576view TermSet from TRIV to EXT-TERMSET is 11577 sort Elt to TermSet . 11578endv 11579 11580fmod O-O-TO-SYSTEM-MOD-TRANSF is 11581 pr DATABASE . 11582 pr CONVERSION . 11583 pr EXT-TERMSET . 11584 11585 var DB : Database . 11586 var I : Nat . 11587 var ME : Header . 11588 vars S S' S'' C C' : Sort . 11589 vars SS SS' SS'' : SortSet . 11590 var Ty : Type . 11591 var TyL : TypeList . 11592 vars T T' T'' T3 : Term . 11593 vars TL TL' : TermList . 11594 var PL : ParameterList . 11595 vars IL IL' IL'' : ImportList . 11596 vars CDS CDS' : ClassDeclSet . 11597 vars ADS ADS' : AttrDeclSet . 11598 var SSDS : SubsortDeclSet . 11599 vars SCDS SCDS' : SubclassDeclSet . 11600 var OPDS : OpDeclSet . 11601 var MDS : MsgDeclSet . 11602 vars MAS MAS' : MembAxSet . 11603 vars EqS EqS' : EquationSet . 11604 vars RlS RlS' : RuleSet . 11605 var QIL : QidList . 11606 var NQIL : NeQidList . 11607 vars O O' : Term . 11608 vars M U : Module . 11609 vars QI A A' L F : Qid . 11610 var V V' : Variable . 11611 var CD : ClassDecl . 11612 vars SCD SCD' : SubclassDecl . 11613 vars Ct Ct' Ct'' : Constant . 11614 var Cond : Condition . 11615 var AtS : AttrSet . 11616 var H : Header . 11617 var PD : ParameterDecl . 11618 var PDL : ParameterDeclList . 11619 var MN : ModuleName . 11620 var CH : ClassHierarchy . 11621 var C'' : Sort . 11622 vars TS TS' : TermSet . 11623 11624 11625 op newVar : Sort Nat -> Variable . 11626 eq newVar(S, I) = qid("V#" + string(I, 10) + ":" + string(S)) . 11627 11628*** The function \texttt{prepClasses} completes all classes in the module with 11629*** all the attributes they inherit from their superclasses. 11630 11631 op prepClasses : ClassDeclSet SubclassDeclSet ImportList ParameterDeclList 11632 Database -> ClassDeclSet . 11633 op prepClasses2 : ClassDeclSet SubclassDeclSet ImportList 11634 ImportList Database -> ClassDeclSet . 11635 op prepClasses3 : ClassDeclSet SubclassDeclSet -> ClassDeclSet . 11636 11637 eq prepClasses(CDS, SCDS, IL, (PD, PDL), DB) 11638 = prepClasses(CDS, SCDS, (IL protecting pd(PD) .), PDL, DB) . 11639 eq prepClasses(CDS, SCDS, IL, nil, DB) 11640 = prepClasses2(CDS, SCDS, IL, nil, DB) . 11641 11642 eq prepClasses2(CDS, SCDS, ((including MN .) IL), IL', DB) 11643 = if (including MN . ) in IL' 11644 then prepClasses2(CDS, SCDS, IL, IL', DB) 11645 else prepClasses2( 11646 (getClasses(getTopModule(MN, DB)) CDS), 11647 (getSubclasses(getTopModule(MN, DB)) SCDS), 11648 (getImports(getTopModule(MN, DB)) IL), 11649 ((including MN .) IL'), DB) 11650 fi . 11651 eq prepClasses2(CDS, SCDS, ((extending MN .) IL), IL', DB) 11652 = if (extending MN . ) in IL' 11653 then prepClasses2(CDS, SCDS, IL, IL', DB) 11654 else prepClasses2( 11655 (getClasses(getTopModule(MN, DB)) CDS), 11656 (getSubclasses(getTopModule(MN, DB)) SCDS), 11657 (getImports(getTopModule(MN, DB)) IL), 11658 ((extending MN .) IL'), DB) 11659 fi . 11660 eq prepClasses2(CDS, SCDS, ((protecting MN .) IL), IL', DB) 11661 = if (protecting MN . ) in IL' 11662 then prepClasses2(CDS, SCDS, IL, IL', DB) 11663 else prepClasses2( 11664 (getClasses(getTopModule(MN, DB)) CDS), 11665 (getSubclasses(getTopModule(MN, DB)) SCDS), 11666 (getImports(getTopModule(MN, DB)) IL), 11667 ((protecting MN .) IL'), DB) 11668 fi . 11669 eq prepClasses2(CDS, SCDS, nil, IL, DB) = prepClasses3(CDS, SCDS) . 11670 11671 eq prepClasses3(CDS, SCDS) 11672 = addAttrs(buildHierarchy(CDS, SCDS, none, empty), SCDS) . 11673 11674 sort ClassHierarchy ClassStruct . 11675 subsort ClassStruct < ClassHierarchy . 11676 11677 op [_,_] : ClassDecl SortSet -> ClassStruct . 11678 11679 op empty : -> ClassHierarchy . 11680 op __ : ClassHierarchy ClassHierarchy -> ClassHierarchy 11681 [assoc comm id: empty] . 11682 11683 op buildHierarchy : 11684 ClassDeclSet SubclassDeclSet SortSet ClassHierarchy -> ClassHierarchy . 11685 op addAttrs : ClassHierarchy SubclassDeclSet -> ClassDeclSet . 11686 op addAttrsToItsSons : 11687 ClassDecl ClassHierarchy SubclassDeclSet -> ClassHierarchy . 11688 11689 eq buildHierarchy(((class C | ADS .) CDS), SCDS, SS, CH) 11690 = if C in SS 11691 then buildHierarchy(CDS, SCDS, SS, CH) 11692 else buildHierarchy(CDS, SCDS, C ; SS, [(class C | ADS .), none] CH) 11693 fi . 11694 eq buildHierarchy(none, (subclass C < C' .) SCDS, SS, 11695 [(class C | ADS .), SS'] [(class C' | ADS' .), SS''] CH) 11696 = buildHierarchy(none, SCDS, SS, 11697 [(class C | ADS .), C' ; SS'] [(class C' | ADS' .), SS''] CH) . 11698 eq buildHierarchy(none, none, SS, CH) = CH . 11699 11700 eq addAttrs([(class C | ADS .), none] CH, SCDS) 11701 = (class C | ADS .) 11702 addAttrs(addAttrsToItsSons((class C | ADS .), CH, SCDS), SCDS) . 11703 eq addAttrs(empty, SCDS) = none . 11704 11705 eq addAttrsToItsSons((class C | ADS .), [(class C' | ADS' .), C ; SS] CH, 11706 (subclass C' < C .) SCDS) 11707 = addAttrsToItsSons((class C | ADS .), [(class C' | ADS, ADS' .), SS] CH, 11708 SCDS) . 11709 ceq addAttrsToItsSons((class C | ADS .), CH, (subclass C' < C'' .) SCDS) 11710 = addAttrsToItsSons((class C | ADS .), CH, SCDS) 11711 if C =/= C'' . 11712 eq addAttrsToItsSons((class C | ADS .), CH, none) = CH . 11713 11714---- op inAttrDeclSet : Qid AttrDeclSet -> Bool . 11715---- 11716---- eq inAttrDeclSet(A, ((attr A' : S), ADS)) 11717---- = (A == A') or-else inAttrDeclSet(A, ADS) . 11718---- eq inAttrDeclSet(A, none) = false . 11719 11720*** Given a set of attribute declarations, the \texttt{ops4Attr} 11721*** function returns a set of operator declarations as indicated above. That 11722*** is, for each attribute $a\texttt{:} S$, an operator of the form 11723*** $a \texttt{\ :\_} \texttt{ :\,\,} S \texttt{ -> Attribute}$ is declared. 11724 11725 op ops4Attr : AttrDeclSet -> OpDeclSet . 11726 11727 eq ops4Attr(((attr A : S), ADS)) 11728 = ((op qid(string(A) + "`:_") : S -> 'Attribute [gather('&)] .) 11729 ops4Attr(ADS)) . 11730 eq ops4Attr(none) = none . 11731 11732*** The function \texttt{prepLHS} takes the term in the lefthand side of a 11733*** rule, equation, or membership axiom, and replaces each object 11734*** 11735*** $\texttt{<\ }O\texttt{\ :\ }C\texttt{\ |\ }ADS\texttt{\ >}$ 11736*** 11737*** in it---with $O$ of sort \texttt{Oid}, $C$ the name of a class, and $ADS$ 11738*** a set of attributes with their corresponding values---by an object 11739*** 11740*** $\texttt{<\ }O\texttt{\ :\ }V\texttt{\ |\ }ADS\ ADS'\ Atts\texttt{\ >}$ 11741*** 11742*** where the identifier of the class is replaced by a variable $V$ of sort 11743*** $C$, which is not used in the axiom, and where the set of attributes is 11744*** completed with attributes $ADS'$ as indicated in Section~\ref{omod2mod}, so 11745*** that each attribute declared in class $C$ or in any of its superclasses is 11746*** added with a new variable as value. $Atts$ is a new variable of sort 11747*** \texttt{AttributeSet}, which is used to range over the additional 11748*** attributes that may appear in objects of a subclass. 11749 11750*** The function \texttt{prepLHS} takes as arguments a term (in the initial 11751*** call, the term in the lefthand side of a rule, equation, or membership 11752*** axiom), the set of variable declarations of those variables declared in the 11753*** module that are not used in the axiom---new variables are created only if 11754*** there are no variables in the module with the appropriate sort---the set of 11755*** attributes in the* occurrences of the objects---and an index---to make sure 11756*** that the variables being added have not occurrences of the objects---and an 11757*** index---to make sure that the variables being added have not been added 11758*** previously. In the initial call this index is set to zero. \texttt{prepLHS} 11759*** gives as result a tuple composed of the resulting term, the set of objects 11760*** in the term (so that the modification of the objects in the righthand side 11761*** of the rule is simplified), the set of variable declarations corresponding 11762*** to the new added variables, the set of variable declarations of the 11763*** variables in the module that have not been used, and the index for the 11764*** creation of new variables. 11765 11766*** change (03/20/2002): a new variable is created everytime one is needed 11767 11768*** The set of objects in the lefthand side will be given as a set of terms. 11769 11770 pr 4TUPLE{TermList, TermSet, Nat, QidList} 11771 * (op p1_ to term, op p2_ to objects, op p3_ to index, op p4_ to messages, 11772 op ((_,_,_,_)) : TermList TermSet Nat QidList -> Tuple{TermList,TermSet,Nat,QidList} to <_;_;_;_>) . 11773 11774 op prepLHS : TermList ClassDeclSet Nat -> Tuple{TermList, TermSet, Nat, QidList} . 11775 11776 op crtObject : Term Sort AttrDeclSet Tuple{TermList, TermSet, Nat, QidList} -> Tuple{TermList, TermSet, Nat, QidList} . 11777 op crtObject2 : Term Variable TermList TermList AttrDeclSet TermSet Nat QidList -> Tuple{TermList, TermSet, Nat, QidList} . 11778 op crtObject3 : Term Qid TermList AttrDeclSet TermSet Nat QidList -> Tuple{TermList, TermSet, Nat, QidList} . 11779 11780 eq prepLHS(qidError(QIL), CDS, I) = < qidError(QIL) ; emptyTermSet ; I ; nil > . 11781 eq prepLHS(F, CDS, I) = < F ; emptyTermSet ; I ; nil > . 11782 eq prepLHS(Ct, CDS, I) = < Ct ; emptyTermSet ; I ; nil > . 11783 11784*** \texttt{prepLHS} on a list of terms $\texttt{(}T\texttt{,\ }TL\texttt{)}$, 11785*** with $T$ a term and $TL$ a list of terms, has to make a call to itself with 11786*** $T$ and with $TL$. The call with $TL$ has to be made with the result of 11787*** the call with $T$ so that the variables and the index are right. 11788 11789 ceq prepLHS((T, TL), CDS, I) 11790 = < (term(prepLHS(T, CDS, I)), 11791 term(prepLHS(TL, CDS, index(prepLHS(T, CDS, I))))) ; 11792 _|_(objects(prepLHS(T, CDS, I)), 11793 objects(prepLHS(TL, CDS, index(prepLHS(T, CDS, I))))) ; 11794 index(prepLHS(TL, CDS, index(prepLHS(T, CDS, I)))) ; 11795 (messages(prepLHS(T, CDS, I)) 11796 messages(prepLHS(TL, CDS, index(prepLHS(T, CDS, I))))) > 11797 if TL =/= empty . 11798 ceq prepLHS(F[TL], CDS, I) 11799 = < F[term(prepLHS(TL, CDS, I))] ; 11800 objects(prepLHS(TL, CDS, I)) ; 11801 index(prepLHS(TL, CDS, I)) ; 11802 messages(prepLHS(TL, CDS, I)) > 11803 if (F =/= '<_:_|_>) /\ (F =/= '<_:_|`>) . 11804 11805 ceq prepLHS('<_:_|_>[O, Ct, T], ((class C | ADS .) CDS), I) 11806 = crtObject(O, C, ADS, prepLHS(T, ((class C | ADS .) CDS), I)) 11807 if getName(Ct) == C . 11808 ceq prepLHS('<_:_|`>[O, Ct], ((class C | ADS .) CDS), I) 11809 = crtObject(O, C, ADS, 11810 prepLHS('none.AttributeSet, ((class C | ADS .) CDS), I)) 11811 if getName(Ct) == C . 11812 eq prepLHS('<_:_|_>[O, V, T], CDS, I) 11813 = < '<_:_|_>[O, V, T] ; emptyTermSet ; I ; nil > . 11814 *** is this eq necessary? 11815 eq prepLHS('<_:_|`>[O, T], CDS, I) 11816 = prepLHS('<_:_|_>[O, T, 'none.AttributeSet], CDS, I) . 11817 11818 eq prepLHS('<_:_|_>[O, T, T'], none, I) 11819 = < qidError('Error: 'undefined 'class T '\n) ; emptyTermSet ; I ; nil > . 11820 11821 eq crtObject(O, C, ADS, < T ; TS ; I ; QIL >) 11822 = crtObject2(O, newVar(C, I), T, 'none.AttributeSet, ADS, TS, (I + 1), QIL) . 11823 11824*** The function \texttt{crtObject2} is called with the metarepresentation of 11825*** the list of attributes appearing in the current object (third argument) 11826*** and the set of attribute declarations of the class to which such object 11827*** belongs + all the attributes declared in its superclasses (fifth 11828*** argument). The function proceeds recursively removing the attribute 11829*** declarations from the set of declarations of attributes for those 11830*** attributes that appear in the object. Each time an attribute is found, it 11831*** is passed with its actual value to the fourth argument of 11832*** \texttt{crtObject2}, which initially has value \verb~'none.AttributeSet~, 11833*** composing a list of terms with them. 11834 11835*** We assume that: 11836*** \begin{itemize} 11837*** \item The metarepresentation of a list of attributes is always given with 11838*** form \verb~'_`,_[F[T], T]~, \verb~F[T]~, or 11839*** \verb~'none.AttributeSet~, where \texttt{TL} is the 11840*** metarepresentation of a list of attributes with the same form (this 11841*** is ensured by the \verb~(e E)~ gathering pattern in the corresponding 11842*** declaration in the signature in which the parsing is done), and 11843*** \item that all the attributes appearing in an object have been declared in 11844*** the corresponding class declaration or in one of its superclasses. 11845*** \end{itemize} 11846 11847 eq crtObject2(O, V, '_`,_[F[T], TL], TL', ADS, TS, I, QIL) 11848 = crtObject2(O, V, (F[T], TL), TL', ADS, TS, I, QIL) . 11849 11850 ceq crtObject2(O, V, (F[T], TL), TL', ((attr A : S), ADS), TS, I, QIL) 11851 = crtObject2(O, V, TL, (F[T], TL'), ADS, TS, I, QIL) 11852 if qid(string(A) + "`:_") == F . 11853 eq crtObject2(O, V, (F[T], TL), TL', ADS, TS, I, QIL) 11854 = crtObject2(O, V, TL, TL', ADS, TS, I, 11855 (QIL '\r 'Warning: '\o 'Attribute F 'not 'valid '\n)) 11856 [owise] . 11857 11858 ceq crtObject2(O, V, F[T], TL, ((attr A : S), ADS), TS, I, QIL) 11859 = crtObject3(O, V, (F[T], TL), ADS, TS, I, QIL) 11860 if qid(string(A) + "`:_") == F . 11861 eq crtObject2(O, V, F[T], TL, ADS, TS, I, QIL) 11862 = crtObject3(O, V, TL, ADS, TS, I, 11863 (QIL '\r 'Warning: '\o 'Attribute F 'not 'valid '\n)) 11864 [owise] . 11865 11866 eq crtObject2(O, V, V', TL, ADS, TS, I, QIL) 11867 = crtObject3(O, V, TL, ADS, TS, I, 11868 QIL '\r 'Warning: '\o 11869 'Variables 'are 'not 'allowed 'in 'the 'set 'of 'attributes 11870 'of 'an 'object '`( V' '`) '\n) . 11871 11872 eq crtObject2(O, V, 'none.AttributeSet, TL, ADS, TS, I, QIL) 11873 = crtObject3(O, V, TL, ADS, TS, I, QIL) . 11874 eq crtObject2(O, V, empty, TL, ADS, TS, I, QIL) 11875 = crtObject3(O, V, TL, ADS, TS, I, QIL) . 11876 11877*** When the function \texttt{crtObject2} has gone through all the 11878*** attributes in the current object, the function \texttt{crtObject3} is 11879*** in charge of returning the metarepresentation of the current object 11880*** completed with the attributes that did not appear in it. These attributes 11881*** are added with new variables not used in the axiom as value. 11882*** \texttt{crtObject3} returns a pair composed by this resulting object, 11883*** and the set of terms representing all the objects in the lefthand 11884*** side (the current object is added to this set). 11885 11886 eq crtObject3(O, V, TL, ((attr A : S), ADS), TS, I, QIL) 11887 = crtObject3(O, V, (qid(string(A) + "`:_")[newVar(S, I)], TL), 11888 ADS, TS, (I + 1), QIL) . 11889 11890 eq crtObject3(O, V, TL, none, TS, I, QIL) 11891 = < '<_:_|_>[O, V, '_`,_[TL, newVar('AttributeSet, I)]] ; 11892 _|_('<_:_|_>[O, V, '_`,_[TL, newVar('AttributeSet, I)]], TS) ; 11893 (I + 1) ; 11894 QIL > . 11895 11896*** Once the lefthand side of a rule or equation has been `prepared', the 11897*** function \texttt{prepRHS} is called with the set of objects returned by 11898*** \texttt{prepLHS} and the term in the righthand side of such rule or 11899*** equation. The function \texttt{prepRHS} proceeds recursively throughout the 11900*** term looking for objects. Each time an object is found, its set of 11901*** attributes is completed with those in the modified object of the lefthand 11902*** side which do not appear in it. 11903 11904 op prepRHS : TermSet TermList -> TermList . 11905 op prepRHS : TermSet Condition -> Condition . 11906 11907 op adjustObject : TermSet Term -> Term . 11908 11909 op adjustObjectRHS : TermSet Term -> [Term] . 11910 op adjustAttrsObjectRHS : Term Term -> [Term] . 11911 op adjustAttrsObjectRHSAux : TermSet Term -> [Term] . 11912 11913 op termAttrListToTermSet : TermList -> TermSet . 11914 op _attrInTermSet_ : Qid TermSet -> Bool . 11915 11916 eq prepRHS(TS, T = T' /\ Cond) 11917 = prepRHS(TS, T) = prepRHS(TS, T') /\ prepRHS(TS, Cond) . 11918 eq prepRHS(TS, T : S /\ Cond) = prepRHS(TS, T) : S /\ prepRHS(TS, Cond) . 11919 eq prepRHS(TS, T := T' /\ Cond) 11920 = prepRHS(TS, T) := prepRHS(TS, T') /\ prepRHS(TS, Cond) . 11921 eq prepRHS(TS, T => T' /\ Cond) 11922 = prepRHS(TS, T) => prepRHS(TS, T') /\ prepRHS(TS, Cond) . 11923 eq prepRHS(TS, (nil).Condition) = nil . 11924 11925 eq prepRHS(TS, qidError(QIL)) = qidError(QIL) . 11926 eq prepRHS(TS, F) = F . 11927 eq prepRHS(TS, Ct) = Ct . 11928 ceq prepRHS(TS, F[TL]) 11929 = F[prepRHS(TS, TL)] 11930 if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) . 11931 eq prepRHS(TS, '<_:_|_>[O, Ct, T]) 11932 = adjustObjectRHS(TS, '<_:_|_>[O, Ct, prepRHS(TS, T)]) . 11933 eq prepRHS(TS, '<_:_|_>[O, V, T]) = '<_:_|_>[O, V, prepRHS(TS, T)] . 11934 eq prepRHS(TS, '<_:_|`>[O, Ct]) 11935 = adjustObjectRHS(TS, '<_:_|_>[O, Ct, prepRHS(TS, 'none.AttributeSet)]) . 11936 eq prepRHS(TS, '<_:_|`>[O, V]) 11937 = '<_:_|_>[O, V, prepRHS(TS, 'none.AttributeSet)] . 11938 ceq prepRHS(TS, (T, TL)) 11939 = (prepRHS(TS, T), prepRHS(TS, TL)) 11940 if TL =/= empty . 11941 11942 eq adjustObjectRHS(_|_('<_:_|_>[O, V, T], TS), '<_:_|_>[O', Ct, T']) 11943 = if O == O' 11944 then if getType(V) == getType(Ct) 11945 then '<_:_|_>[O, V, adjustAttrsObjectRHS(T, T')] 11946 else '<_:_|_>[O', Ct, T'] 11947 fi 11948 else adjustObjectRHS(TS, '<_:_|_>[O', Ct, T']) 11949 fi . 11950 eq adjustObjectRHS(emptyTermSet, '<_:_|_>[O, Ct, T]) = '<_:_|_>[O, Ct, T] . 11951 11952*** eq adjustObjectRHS(_|_('<_:_|_>[Ct, C, T], TS), '<_:_|_>[O, Ct', T']) 11953*** = adjustObjectRHS(TS, '<_:_|_>[O, Ct', T']) . 11954*** eq adjustObjectRHS( 11955*** _|_('<_:_|_>[Ct, C, T], TS), '<_:_|_>[Ct', Ct'', T']) 11956*** = if Ct == Ct' 11957*** then '<_:_|_>[Ct, Ct'', adjustAttrsObjectRHS(T, T')] 11958*** else adjustObjectRHS(TS, '<_:_|_>[Ct', Ct'', T']) 11959*** fi . 11960*** eq adjustObjectRHS(emptyTermSet, '<_:_|_>[Ct, Ct', T]) 11961*** = '<_:_|_>[Ct, Ct', T] . 11962 11963*** The function \texttt{adjustAttrsObjectRHS} completes the set of 11964*** attributes of an object in the righthand side with those in the object in 11965*** the lefthand side or in the class not used in the lefthand side, which 11966*** have been completed by the function \texttt{crtObject}. 11967 11968 eq adjustAttrsObjectRHS('_`,_[TL], T) 11969 = adjustAttrsObjectRHSAux(termAttrListToTermSet(TL), T) . 11970 11971 eq adjustAttrsObjectRHSAux(_|_(A[T], TS), '_`,_[A[T'], T'']) 11972 = '_`,_[A[T'], adjustAttrsObjectRHSAux(TS, T'')] . 11973 ceq adjustAttrsObjectRHSAux(TS, '_`,_[A[T], T']) 11974 = qidError(A 'is 'not 'a 'valid 'attribute) 11975 if not A attrInTermSet TS . 11976 eq adjustAttrsObjectRHSAux(_|_(A[T], TS), A[T']) 11977 = '_`,_[A[T'], adjustAttrsObjectRHSAux(TS, 'none.AttributeSet)] . 11978 ceq adjustAttrsObjectRHSAux(TS, A[T]) 11979 = qidError(A 'is 'not 'a 'valid 'attribute) 11980 if not A attrInTermSet TS . 11981 eq adjustAttrsObjectRHSAux(_|_(A[T], TS), 'none.AttributeSet) 11982 = '_`,_[A[T], adjustAttrsObjectRHSAux(TS, 'none.AttributeSet)] . 11983 eq adjustAttrsObjectRHSAux(V, 'none.AttributeSet) = V . 11984 11985 eq A attrInTermSet _|_(V, TS) = A attrInTermSet TS . 11986 eq A attrInTermSet _|_(A'[T], TS) 11987 = (A == A') or-else (A attrInTermSet TS) . 11988 eq A attrInTermSet emptyTermSet = false . 11989 11990 ceq termAttrListToTermSet((T, TL)) 11991 = if T == 'none.AttributeSet 11992 then termAttrListToTermSet(TL) 11993 else _|_(T, termAttrListToTermSet(TL)) 11994 fi 11995 if TL =/= empty . 11996 eq termAttrListToTermSet(T) 11997 = if T == 'none.AttributeSet 11998 then emptyTermSet 11999 else T 12000 fi . 12001 12002*** In the case of equations and rules, the function \texttt{prepAxs} calls the 12003*** function \texttt{prepLHS} with the term in the lefthand side of the axiom, 12004*** and then use the generated set of objects to call the \texttt{prepRHS} 12005*** function. For conditional equations, rules, and membership axioms, this set 12006*** of terms representing the objects in the lefthand side is also used in the 12007*** calls to \texttt{prepRHS} with each of the terms in the conditions. The 12008*** term in the lefthand side of the equation, rule, or membership axiom is 12009*** replaced by the term returned by \texttt{prepLHS}. The index is used in 12010*** the recursive calls to \texttt{prepAxs}. 12011 12012*** \texttt{prepLHS} returns as second argument the set of objects (as a set of 12013*** terms) appearing in it. These objects are returned after extending their 12014*** set of attributes by those of the class to which they belong not already 12015*** specified. 12016 12017 op prepAxs : Module MembAxSet EquationSet RuleSet ClassDeclSet Nat QidList 12018 -> Module . 12019 12020 eq prepAxs(U, ((mb T : S [AtS] .) MAS), EqS, RlS, CDS, I, QIL) 12021 = prepAxs( 12022 addMbs(mb term(prepLHS(T, CDS, I)) : S [AtS] ., U), 12023 MAS, EqS, RlS, CDS, 12024 index(prepLHS(T, CDS, I)), 12025 (QIL messages(prepLHS(T, CDS, I)))) . 12026 eq prepAxs(U, ((cmb T : S if Cond [AtS] .) MAS), EqS, RlS, CDS, I, QIL) 12027 = prepAxs( 12028 addMbs(cmb term(prepLHS(T, CDS, I)) : S 12029 if prepRHS(objects(prepLHS(T, CDS, I)), Cond) [AtS] ., U), 12030 MAS, EqS, RlS, CDS, 12031 index(prepLHS(T, CDS, I)), 12032 (QIL messages(prepLHS(T, CDS, I)))) . 12033 eq prepAxs(U, MAS, ((eq T = T' [AtS] .) EqS), RlS, CDS, I, QIL) 12034 = prepAxs( 12035 addEqs(eq term(prepLHS(T, CDS, I)) 12036 = prepRHS(objects(prepLHS(T, CDS, I)), T') [AtS] ., U), 12037 MAS, EqS, RlS, CDS, 12038 index(prepLHS(T, CDS, I)), 12039 (QIL messages(prepLHS(T, CDS, I)))) . 12040 eq prepAxs(U, MAS, ((ceq T = T' if Cond [AtS] .) EqS), RlS, CDS, I, QIL) 12041 = prepAxs( 12042 addEqs(ceq term(prepLHS(T, CDS, I)) 12043 = prepRHS(objects(prepLHS(T, CDS, I)), T') 12044 if prepRHS(objects(prepLHS(T, CDS, I)), Cond) [AtS] ., U), 12045 MAS, EqS, RlS, CDS, 12046 index(prepLHS(T, CDS, I)), 12047 (QIL messages(prepLHS(T, CDS, I)))) . 12048 12049 eq prepAxs(U, MAS, EqS, ((rl T => T' [AtS] .) RlS), CDS, I, QIL) 12050 = prepAxs( 12051 addRls(rl term(prepLHS(T, CDS, I)) 12052 => prepRHS(objects(prepLHS(T, CDS, I)), T') [AtS] ., U), 12053 MAS, EqS, RlS, CDS, 12054 index(prepLHS(T, CDS, I)), 12055 (QIL messages(prepLHS(T, CDS, I)))) . 12056 eq prepAxs(U, MAS, EqS, ((crl T => T' if Cond [AtS] .) RlS), CDS, I, QIL) 12057 = prepAxs( 12058 addRls(crl term(prepLHS(T, CDS, I)) 12059 => prepRHS(objects(prepLHS(T, CDS, I)), T') 12060 if prepRHS(objects(prepLHS(T, CDS, I)), Cond) [AtS] ., U), 12061 MAS, EqS, RlS, CDS, 12062 index(prepLHS(T, CDS, I)), 12063 (QIL messages(prepLHS(T, CDS, I)))) . 12064 eq prepAxs(U, none, none, none, CDS, I, nil) = U . 12065 eq prepAxs(U, none, none, none, CDS, I, NQIL) = unitError(NQIL) . 12066 eq prepAxs(unitError(QIL), MAS, EqS, RlS:[RuleSet], CDS, I, QIL':QidList) = unitError(QIL':QidList QIL) . 12067 12068*** After completing the set of classes in the module with the attributes from 12069*** their superclasses, the function \texttt{omod2mod} calls the function 12070*** \texttt{omod2modAux} with the same module and the set of class 12071*** declarations. The definition of the \texttt{omod2mod} function is given by 12072*** the five equations below. 12073 12074 op omod2mod : OModule Database -> SModule . 12075 op omod2modAux : OModule ClassDeclSet -> SModule . 12076 op omod2mod : OTheory Database -> SModule . 12077 op omod2modAux : OTheory ClassDeclSet -> SModule . 12078 12079 eq omod2mod( 12080 omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 12081 DB) 12082 = omod2modAux( 12083 omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 12084 prepClasses(CDS, SCDS, IL, getParDecls(H), DB)) . 12085 eq omod2mod( 12086 oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 12087 DB) 12088 = omod2modAux( 12089 oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 12090 prepClasses(CDS, SCDS, IL, getParDecls(H), DB)) . 12091 12092 eq omod2modAux( 12093 omod H is 12094 IL sorts SS . SSDS ((class C | ADS .) CDS) SCDS OPDS MDS MAS EqS RlS 12095 endom, 12096 CDS') 12097 = omod2modAux( 12098 omod H is 12099 IL sorts (SS ; C) . 12100 (subsort C < 'Cid . SSDS) 12101 CDS SCDS 12102 ((op C : nil -> C [none] .) 12103 ops4Attr(ADS) OPDS) 12104 MDS MAS EqS RlS 12105 endom, 12106 CDS') . 12107 eq omod2modAux( 12108 omod H is 12109 IL sorts SS . SSDS CDS ((subclass C < C' .) SCDS) 12110 OPDS MDS MAS EqS RlS 12111 endom, 12112 CDS') 12113 = omod2modAux( 12114 omod H is 12115 IL sorts SS . ((subsort C < C' .) SSDS) 12116 CDS SCDS OPDS MDS MAS EqS RlS 12117 endom, 12118 CDS') . 12119 eq omod2modAux( 12120 omod H is 12121 IL sorts SS . SSDS CDS SCDS OPDS 12122 ((msg F : TyL -> Ty .) MDS) MAS EqS RlS 12123 endom, 12124 CDS') 12125 = omod2modAux( 12126 omod H is 12127 IL sorts SS . SSDS CDS SCDS 12128 ((op F : TyL -> Ty [msg] .) OPDS) MDS MAS EqS RlS 12129 endom, 12130 CDS') . 12131 eq omod2modAux( 12132 omod H is IL sorts SS . SSDS none none OPDS none MAS EqS RlS endom, 12133 CDS) 12134 = prepAxs(mod H is IL sorts SS . SSDS OPDS none none none endm, 12135 MAS, EqS, RlS, CDS, 0, nil) . 12136 12137 eq omod2modAux( 12138 oth H is 12139 IL sorts SS . SSDS ((class C | ADS .) CDS) 12140 SCDS OPDS MDS MAS EqS RlS 12141 endoth, 12142 CDS') 12143 = omod2modAux( 12144 oth H is 12145 IL sorts (SS ; C) . 12146 (subsort C < 'Cid . SSDS) 12147 CDS SCDS 12148 ((op C : nil -> C [none] .) 12149 ops4Attr(ADS) OPDS) 12150 MDS MAS EqS RlS 12151 endoth, 12152 CDS') . 12153 eq omod2modAux( 12154 oth H is 12155 IL sorts SS . SSDS CDS ((subclass C < C' .) SCDS) 12156 OPDS MDS MAS EqS RlS 12157 endoth, 12158 CDS') 12159 = omod2modAux( 12160 oth H is 12161 IL sorts SS . ((subsort C < C' .) SSDS) 12162 CDS SCDS OPDS MDS MAS EqS RlS 12163 endoth, 12164 CDS') . 12165 eq omod2modAux( 12166 oth H is 12167 IL sorts SS . SSDS CDS SCDS OPDS 12168 ((msg F : TyL -> Ty .) MDS) MAS EqS RlS 12169 endoth, 12170 CDS') 12171 = omod2modAux( 12172 oth H is 12173 IL sorts SS . SSDS CDS SCDS 12174 ((op F : TyL -> Ty [msg] .) OPDS) MDS MAS EqS RlS 12175 endoth, 12176 CDS') . 12177 eq omod2modAux( 12178 oth H is IL sorts SS . SSDS none none OPDS none MAS EqS RlS endoth, 12179 CDS) 12180 = prepAxs( 12181 th H is IL sorts SS . SSDS OPDS none none none endth, 12182 MAS, EqS, RlS, CDS, 0, nil) . 12183endfm 12184 12185------------------------------------------------------------------------------- 12186******************************************************************************* 12187------------------------------------------------------------------------------- 12188 12189*** 12190*** Evaluation of Modules and Theories 12191*** 12192 12193*** As explained in Section~\ref{evaluation-overview}, in our approach 12194*** transforming a module from its possibly complex structured version to its 12195*** unstructured form is a two-step process. First, all module expressions 12196*** are evaluated, generating an intermediate form in which there are only 12197*** simple inclusion relationships among the modules. This first step can be 12198*** seen as the reduction of a structured specification to its structured 12199*** \emph{normal form}. Then, in a second step, this structured normal form is 12200*** flattened into an unstructured specification. Note, however, that the 12201*** importation of built-in modules is left explicit in the flattened form. 12202*** The function \texttt{normalize} is in charge of normalizing the 12203*** structure. 12204 12205*** The process of evaluation of a preunit has to take into account the 12206*** possibility of bubbles being contained in it. Depending on whether it is 12207*** dealing with a preunit or with a unit, the evaluation process is 12208*** accomplished by two different functions, namely, \texttt{evalPreModule} and 12209*** \texttt{evalModule}. One function or the other will be called in each case. 12210*** Evaluating a module already in the database, which is done by 12211*** \texttt{evalModule}, does not require bubble handling. Besides this 12212*** difference, both functions proceed in a similar way. Before presenting the 12213*** functions \texttt{evalPreModule} and \texttt{evalModule} we introduce some 12214*** auxiliary declarations. 12215 12216------------------------------------------------------------------------------- 12217******************************************************************************* 12218------------------------------------------------------------------------------- 12219 12220fmod EVALUATION is 12221 pr O-O-TO-SYSTEM-MOD-TRANSF . 12222 pr MOD-EXPR-EVAL . 12223 pr UNIT-BUBBLE-PARSING . 12224 12225 sort List<Module> . 12226 subsort Module < List<Module> . 12227 12228 op nil : -> List<Module> . 12229 op __ : List<Module> List<Module> -> List<Module> [assoc id: nil] . 12230 eq unitError(QIL) UL unitError(QIL') = unitError(QIL QIL') UL . 12231 12232 vars M PU U U' U'' : Module . 12233 vars UL UL' : List<Module> . 12234 vars DB DB' : Database . 12235 vars ME ME' : ModuleExpression . 12236 var P : ViewExp . 12237 var PD : ParameterDecl . 12238 vars PL PL' PL'' : ParameterList . 12239 vars IL IL' IL'' : ImportList . 12240 var I : Import . 12241 var CDS : ClassDeclSet . 12242 var SSDS : SubsortDeclSet . 12243 var SCDS : SubclassDeclSet . 12244 var OPD : OpDecl . 12245 vars OPDS VDS : OpDeclSet . 12246 var MDS : MsgDeclSet . 12247 var MAS : MembAxSet . 12248 var EqS : EquationSet . 12249 var RlS : RuleSet . 12250 var B : Bool . 12251 vars QI QI' V L L' L'' A A' A'' F F' F'' X Y W Z : Qid . 12252 vars QIL QIL' SL : QidList . 12253 vars S S' S'' C C' C'' : Sort . 12254 vars SS SS' : SortSet . 12255 vars Ty Ty' : Type . 12256 vars TyL TyL' : TypeList . 12257 vars AtS AtS' : AttrSet . 12258 var Rl : Rule . 12259 var CD : ClassDecl . 12260 var ADS : AttrDeclSet . 12261 var MD : MsgDecl . 12262 vars T T' T'' T3 : Term . 12263 var TL : TermList . 12264 var MAP : Renaming . 12265 var MAPS : RenamingSet . 12266 vars VE VE' VE'' : ViewExp . 12267 var HkL : HookList . 12268 vars PDL PDL' : ParameterDeclList . 12269 var St : String . 12270 12271*** The \texttt{subunitImports} function returns the list of all the 12272*** subunits of a given unit. It is called with the list of importations of 12273*** the given unit as first argument, and proceeds recursively through its 12274*** structure collecting all the subunits in it. 12275 12276*** The function \texttt{subunitImports} proceeds storing the importations 12277*** considered up to that point, so it does not have to go through the same 12278*** part of the structure more than once. When the function is initially 12279*** called the second argument is set to \texttt{nil}. 12280 12281 op subunitImports : ParameterDeclList ImportList Database -> ImportList . 12282 op subunitImports : ImportList ImportList Database -> ImportList . 12283 12284 eq subunitImports((PD, PDL), IL, DB) 12285 = subunitImports(PDL, IL (protecting pd(PD) .), DB) . 12286 eq subunitImports((nil).ParameterDeclList, IL, DB) 12287 = subunitImports(IL, nil, DB) . 12288 12289 eq subunitImports(I IL, IL' I IL'', DB) 12290 = subunitImports(IL, IL' I IL'', DB) . 12291 eq subunitImports(I IL, IL', DB) 12292 = subunitImports(getImports(getTopModule(moduleName(I), DB)) IL, I IL', DB) 12293 [owise] . 12294 eq subunitImports((nil).ImportList, IL, DB) = IL . 12295 12296*** The function \texttt{getModules} returns the list of those units 12297*** in the list of importations given as argument which are not built-in. 12298 12299 op getModules : ImportList Database -> List<Module> . 12300 op getModules : ImportList List<Module> Database -> List<Module> . 12301 12302 eq getModules(IL, DB) = getModules(IL, nil, DB) . 12303 12304 eq getModules(((including ME .) IL), UL, DB) 12305 = getModules(IL, (UL getInternalModule(ME, DB)), DB) . 12306 eq getModules(((including pd(PD) .) IL), UL, DB) 12307 = getModules(IL, (UL getInternalModule(pd(PD), DB)), DB) . 12308 eq getModules(((extending ME .) IL), UL, DB) 12309 = getModules(IL, (UL getInternalModule(ME, DB)), DB) . 12310 eq getModules(((extending pd(PD) .) IL), UL, DB) 12311 = getModules(IL, (UL getInternalModule(pd(PD), DB)), DB) . 12312 eq getModules(((protecting ME .) IL), UL, DB) 12313 = getModules(IL, (UL getInternalModule(ME, DB)), DB) . 12314 eq getModules(((protecting pd(PD) .) IL), UL, DB) 12315 = getModules(IL, (UL getInternalModule(pd(PD), DB)), DB) . 12316 eq getModules(IL, UL unitError(QIL) UL', DB) = unitError(QIL) . 12317 eq getModules(nil, UL, DB) = UL . 12318 12319*** The normalization of a structure consists in evaluating each of the module 12320*** expressions appearing in it. Note that, if the \texttt{evalModExp} function 12321*** generates new modules, they will be evaluated using the \texttt{evalModule} 12322*** function, producing recursive calls on the part of the structure not 12323*** previously normalized. Parameters are handled separatedly. They are 12324*** folded out when analyzing the interface of a module. 12325 12326 pr 3TUPLE{ImportList,ParameterDeclList,Database} 12327 * (op ((_,_,_)) to <_;_;_>, 12328 op p1_ to importList, 12329 op p2_ to parameterDeclList, 12330 op p3_ to database) . 12331 12332---- sort Tuple{ImportList,ParameterDeclList,Database} . 12333---- op <_;_;_> : ImportList ParameterDeclList Database 12334---- -> Tuple{ImportList,ParameterDeclList,Database} . 12335---- op importList : Tuple{ImportList,ParameterDeclList,Database} -> ImportList . 12336---- op parameterDeclList : 12337---- Tuple{ImportList,ParameterDeclList,Database} -> ParameterDeclList . 12338---- op database : Tuple{ImportList,ParameterDeclList,Database} -> Database . 12339---- eq importList(< IL ; PDL ; DB >) = IL . 12340---- eq parameterDeclList(< IL ; PDL ; DB >) = PDL . 12341---- eq database(< IL ; PDL ; DB >) = DB . 12342 12343 op normalize : ImportList ParameterDeclList Database 12344 -> Tuple{ImportList,ParameterDeclList,Database} . 12345 op normalize : ImportList ImportList ParameterDeclList ParameterDeclList 12346 Database -> Tuple{ImportList,ParameterDeclList,Database} . 12347 op createCopy : ParameterDecl Database -> Database . 12348 ---- its definition is in INST-EXPR-EVALUATION 12349 12350 eq normalize(IL, PDL, DB) = normalize(nil, IL, nil, PDL, DB) . 12351 12352 eq normalize(IL, IL', PDL, (X :: ME, PDL'), DB) 12353 = normalize(IL, IL', 12354 (PDL, X :: modExp(evalModExp(ME, nil, DB))), PDL', 12355 createCopy((X :: modExp(evalModExp(ME, nil, DB))), 12356 database(evalModExp(ME, nil, DB)))) . 12357 eq normalize(IL, (including ME .) IL', PDL, PDL', DB) 12358 = normalize(IL (including modExp(evalModExp(ME, PDL, DB)) .), IL', 12359 PDL, PDL', database(evalModExp(ME, PDL, DB))) . 12360 eq normalize(IL, (extending ME .) IL', PDL, PDL', DB) 12361 = normalize(IL (extending modExp(evalModExp(ME, PDL, DB)) .), IL', 12362 PDL, PDL', database(evalModExp(ME, PDL, DB))) . 12363 eq normalize(IL, (protecting ME .) IL', PDL, PDL', DB) 12364 = normalize(IL (protecting modExp(evalModExp(ME, PDL, DB)) .), IL', 12365 PDL, PDL', database(evalModExp(ME, PDL, DB))) . 12366 eq normalize(IL, I IL', PDL, PDL', DB) 12367 = normalize(IL I, IL', PDL, PDL', DB) 12368 [owise] . 12369 eq normalize(IL, nil, PDL, nil, DB) = < IL ; PDL ; DB > . 12370 12371*** \texttt{checkSortClashes} checks whether the intersection of the two sTS 12372*** of sorts given as arguments is empty or not. If it is nonempty, then there 12373*** is a clash of names, and a warning message is passed to the database. The 12374*** check is very simple, and only reports the name of one of the modules from 12375*** which the sorts come. Only the name of the module from which the sorts 12376*** given as second argument come is known at this point. This is the module 12377*** name given as first argument. 12378*** 12379*** op checkSortClashes : Header SortSet SortSet Database -> Database . 12380*** 12381*** eq checkSortClashes(ME, (S ; SS), (S ; SS'), DB) 12382*** = checkSortClashes(ME, SS, SS', 12383*** warning(DB, 12384*** '\g 'Advisory: '\o 12385*** 'Clash 'of 'sort eSortToSort(S) 'from header2Qid(ME) '\n)) . 12386*** ceq checkSortClashes(ME, (S ; SS), SS', DB) 12387*** = checkSortClashes(ME, SS, SS', DB) 12388*** if not (S in SS') . 12389*** eq check(ME, none, SS, DB) = DB . 12390 12391*** In the current system, the only transformation handled by the 12392*** \texttt{transform} function is the one from object-oriented modules to 12393*** system modules, which is accomplished by the 12394*** \texttt{omod2mod} function presented in 12395*** Section~\ref{omod2modfunction}. However, \texttt{transform} has been 12396*** defined as a general transformation that could affect other kinds of 12397*** modules in a future extension. 12398 12399 op transform : Module Database -> Module . 12400 12401 eq transform(unitError(QIL), DB) = unitError(QIL) . 12402 ceq transform(U, DB) = rmVariantAttrs(U) if U :: SModule or U :: STheory . 12403 ceq transform(U, DB) = rmVariantAttrs(omod2mod(U, DB)) 12404 if not U :: SModule /\ not U :: STheory /\ U :: OModule or U :: OTheory . 12405 12406*** The function \texttt{signature} generates a functional module of sort 12407*** \texttt{FModule}, without equations, by ``forgetting'' the appropriate 12408*** declarations and converting extended sorts and module names into quoted 12409*** identifiers. 12410 12411 op removeIds : OpDeclSet Module -> OpDeclSet . 12412 eq removeIds(op F : TyL -> Ty [id(T) AtS] . OPDS, M) 12413 = removeIds(op F : TyL -> Ty [AtS] . OPDS, M) . 12414 eq removeIds(op F : TyL -> Ty [right-id(T) AtS] . OPDS, M) 12415 = removeIds(op F : TyL -> Ty [AtS] . OPDS, M) . 12416 eq removeIds(op F : TyL -> Ty [left-id(T) AtS] . OPDS, M) 12417 = removeIds(op F : TyL -> Ty [AtS] . OPDS, M) . 12418 eq removeIds(op F : TyL -> Ty [special(term-hook(QI, T) HkL) AtS] . OPDS, M) 12419 = removeIds(op F : TyL -> Ty [special(HkL) AtS] . OPDS, M) . 12420 eq removeIds(OPDS, M) = OPDS [owise] . 12421 12422 op removeDittos : OpDeclSet Module -> OpDeclSet . 12423 ceq removeDittos( 12424 op F : TyL -> Ty [ditto AtS] . op F : TyL' -> Ty' [AtS'] . OPDS, M) 12425 = removeDittos( 12426 op F : TyL -> Ty [AtS removeCtorMetadata(AtS')] . op F : TyL' -> Ty' [AtS'] . OPDS, M) 12427 if not ditto in AtS' /\ sameKind(M, TyL Ty, TyL' Ty') . 12428 eq removeDittos(OPDS, M) = OPDS [owise] . 12429 12430 op signature : Module -> Module . 12431 eq signature(unitError(QIL)) = unitError(QIL) . 12432 eq signature(U) 12433 = fmod header2Qid(getName(U)) is 12434 convertModuleExpressions(getImports(U)) 12435 sorts getSorts(U) . 12436 getSubsorts(U) 12437 removeIds( 12438 removeDittos(getOps(U), 12439 setSubsorts( 12440 setSorts(emptyFModule('DUMMY), getSorts(U)), 12441 getSubsorts(U))), 12442 setSubsorts( 12443 setSorts(emptyFModule('DUMMY), getSorts(U)), 12444 getSubsorts(U))) 12445 none 12446 none 12447 endfm 12448 [owise] . 12449 12450*** The function \texttt{flatModule} generates a module of sort \texttt{Module} 12451*** by ``forgetting'' declarations and converting extended sorts and module 12452*** identifiers into quoted identifiers. 12453 12454 op flatModule : Module -> Module . 12455 eq flatModule(unitError(QIL)) = unitError(QIL) . 12456 eq flatModule(U) 12457 = if U :: FModule or U :: FTheory 12458 then (fmod header2Qid(getName(U)) is 12459 getImports(U) 12460 sorts getSorts(U) . 12461 getSubsorts(U) 12462 getOps(U) 12463 getMbs(U) 12464 getEqs(U) 12465 endfm) 12466 else (mod header2Qid(getName(U)) is 12467 getImports(U) 12468 sorts getSorts(U) . 12469 getSubsorts(U) 12470 getOps(U) 12471 getMbs(U) 12472 getEqs(U) 12473 getRls(U) 12474 endm) 12475 fi 12476 [owise] . 12477 12478 op convertModuleExpressions : ImportList -> ImportList . 12479 eq convertModuleExpressions(((protecting ME * (MAPS) .) IL)) 12480 = (protecting ME * (renamings(MAPS)) .) convertModuleExpressions(IL) . 12481 eq convertModuleExpressions(((extending ME * (MAPS) .) IL)) 12482 = (extending ME * (renamings(MAPS)) .) convertModuleExpressions(IL) . 12483 eq convertModuleExpressions(((including ME * (MAPS) .) IL)) 12484 = (including ME * (renamings(MAPS)) .) convertModuleExpressions(IL) . 12485 eq convertModuleExpressions(I IL) = I convertModuleExpressions(IL) [owise] . 12486 eq convertModuleExpressions(nil) = nil . 12487 12488 op renamings : RenamingSet -> RenamingSet . 12489 eq renamings(op F to F' [AtS]) = op F to F' [AtS] . 12490 eq renamings((op F to F' [AtS], MAPS)) 12491 = (op F to F' [AtS], renamings(MAPS)) 12492 [owise] . 12493 eq renamings(op F : TyL -> Ty to F' [AtS]) 12494 = op F : TyL -> Ty to F' [AtS] . 12495 eq renamings((op F : TyL -> Ty to F' [AtS], MAPS)) 12496 = (op F : TyL -> Ty to F' [AtS], 12497 renamings(MAPS)) 12498 [owise] . 12499 eq renamings(sort S to S') = sort S to S' . 12500 eq renamings(((sort S to S'), MAPS)) 12501 = ((sort S to S'), renamings(MAPS)) 12502 [owise] . 12503 eq renamings(label L to L') = label L to L' . 12504 eq renamings(((label L to L'), MAPS)) 12505 = ((label L to L'), renamings(MAPS)) 12506 [owise] . 12507 eq renamings((MAP, MAPS)) = renamings(MAPS) [owise] . 12508 eq renamings(none) = none . 12509 12510*** The evaluation process for units without bubbles is as follows. After 12511*** normalizing the structure, the function \texttt{evalModule} calls 12512*** \texttt{evalModule1} with an empty copy of the module to which the list of 12513*** declarations of importations of built-in modules is added, and with the 12514*** list of its nonbuilt-in subunits. 12515 12516*** \texttt{evalModule1} accumulates all the declarations in all the 12517*** nonbuilt-insubmodules in the copy of the module passed as second argument. 12518*** The top module is then introduced in the database, and, after calling the 12519*** \texttt{transform} function and renaming all the variables in it, the 12520*** internal version of such a module is entered in the database as well. 12521 12522*** Finally, \texttt{evalModule2} generates the signature and the flat version 12523*** of the module and enters them in the database. 12524 12525 *** op evalModule : Module Database -> Database . 12526 *** moved to MOD-EXPR-EVAL to solve dependency 12527 op evalModule1 : Module Module List<Module> OpDeclSet Database -> Database . 12528 op evalModule2 : Module Module Database -> Database . 12529 12530 ceq evalModule(U, VDS, DB) 12531 = evalModule1(setPars(setImports(U, IL), PDL), empty(U), 12532 getModules(IL', DB'), VDS, DB') 12533 if < IL ; PDL ; DB' > := normalize(getImports(U), getPars(U), DB) 12534 /\ IL' := subunitImports(PDL, IL, DB') . 12535 eq evalModule(U, VDS, DB) = DB [owise] . 12536 12537 eq evalModule1(U, U', (U'' UL), VDS, DB) 12538 = evalModule1(U, addDecls(U', setImports(U'', nil)), UL, VDS, DB) . 12539 eq evalModule1(U, U', nil, VDS, DB) 12540 = evalModule2( 12541 setImports(transform(U, DB), nil), 12542 U', 12543 insertVars(getName(U), VDS, 12544 insertInternalModule(getName(U), transform(U, DB), 12545 insertTopModule(getName(U), U, DB)))) . 12546 eq evalModule1(U, U', unitError(QIL), VDS, DB) = warning(DB, QIL) . 12547 12548 eq evalModule2(U, U', DB) 12549 = insertFlatModule(getName(U), flatModule(addDecls(U, U')), DB) . 12550 eq evalModule2(unitError(QIL), U, DB) = warning(DB, QIL) . 12551 12552*** The function \texttt{evalPreModule} has to take care of the bubbles in the 12553*** unit. As we explained in Section~\ref{evaluation-overview}, both the 12554*** signature and the flattened version of the module are created 12555*** simultaneously, completing the parsing of the bubbles once the signature 12556*** has been built, and then completing the flattened module. 12557 12558*** The \texttt{evalPreModule} function takes as arguments two copies of the 12559*** module and a database. We shall see in Section~\ref{unit-processing} how 12560*** these two modules are generated; the one passed as first argument has 12561*** still bubbles in it, while the other one, which will be used to build the 12562*** signature, does not contain any bubbles. This module without bubbles is 12563*** the result of removing the bubbles from the declarations in it, or of 12564*** removing the declarations themselves when they contain bubbles, as in the 12565*** case of equations, for example. 12566 12567*** The \texttt{evalPreModule} function is quite similar to the function 12568*** \texttt{evalModule}. First, the structure is normalized by calling the 12569*** \texttt{normalize} function, and then all the subunits in the 12570*** structure are collected (accomplished by \texttt{subunitImports} and 12571*** \texttt{getModules}) and the list of importations is updated 12572*** with the sublist of importations of built-in 12573*** modules (\texttt{selectBuiltInImports}). Second, the structure of all the 12574*** subunits below the top is flattened to a single unit. This unit is used to 12575*** create a first version of the signature (without identity elements of 12576*** operators) in which all the bubbles in the top preunit are 12577*** parsed (\texttt{solveBubbles}). The final version of the signature and 12578*** the flat unit are generated once the bubbles have been parsed. The 12579*** `internal' version of the module is also generated by renaming the 12580*** variables in it (\texttt{renameVars}). All these versions of the module 12581*** are finally entered in the database. 12582 12583*** Note that if the \texttt{META-LEVEL} module is imported in the module 12584*** being evaluated, a declaration importing the predefined module 12585*** \texttt{UP} Section~\ref{non-built-in-predefined}) is added. With the 12586*** declarations in this module it will be possible to parse bubbles 12587*** containing calls to the \texttt{up} functions (see 12588*** Section~\ref{structured-specifications}) in them. 12589 12590 op evalPreModule : Module Module OpDeclSet Database -> Database . 12591 op evalPreModule1 : 12592 Module Module List<Module> Module OpDeclSet Database -> Database . 12593 op evalPreModule2 : Module Module Module OpDeclSet Database -> Database . 12594 op evalPreModule3 : Module Module Module Database -> Database . 12595 12596 *** evalPreModule just calls evalPreModule1 with a set of the units in the 12597 *** structure of the given module. Depending on whether the module is 12598 *** importing META-LEVEL or not UP will be added. BOOL will be added if 12599 *** the include BOOL flag is set and the module doesn't include it already. 12600 12601 ceq evalPreModule(PU, U, VDS, DB) 12602 *** PU : top unit with bubbles (preunit) 12603 *** U : top unit without bubbles (decls with bubbles were removed) 12604 *** VDS : ops corresponding to the vbles in the top unit 12605 = evalPreModule1( 12606 setPars(setImports(PU, IL'), PDL'), 12607 setName(empty(U), getName(U)), 12608 getModules(IL'', DB'), 12609 setImports(U, nil), 12610 VDS, 12611 DB') 12612 if IL := getImports(PU) 12613 /\ PDL := getPars(PU) 12614 /\ < IL' ; PDL' ; DB' > := normalize(defImports(PU, DB) IL, PDL, DB) 12615 /\ IL'' := subunitImports(PDL, IL', DB') . 12616 eq evalPreModule(PU, U, VDS, DB) = DB [owise] . 12617 12618 *** evalPreModule1 joins all the units in the structure into a single unit, 12619 *** the one given as second argument; recall that the fourth one is the 12620 *** top module without bubbles but with the complete list of subunits 12621 *** being imported explicitly 12622 12623 eq evalPreModule1(PU, U, (U' UL), U'', VDS, DB) 12624 = evalPreModule1(PU, addDecls(U, U'), UL, U'', VDS, DB) . 12625 eq evalPreModule1(PU, U, nil, U', VDS, DB) 12626 = evalPreModule2(PU, U, signature(transform(addDecls(U', setImports(U, nil)), DB)), VDS, DB) 12627 [owise] . 12628 eq evalPreModule1(PU, unitError(QIL), UL, U', VDS, DB) = warning(DB, QIL) . 12629 eq evalPreModule1(unitError(QIL), U, UL, U', VDS, DB) = warning(DB, QIL) . 12630 eq evalPreModule1(PU, U, unitError(QIL), U', VDS, DB) = warning(DB, QIL) . 12631 12632 eq evalPreModule2(PU, U, M, VDS, DB) 12633 *** PU : top module with bubbles 12634 *** U : everything below 12635 *** M : complete signature 12636 = evalPreModule3( 12637 solveBubblesMod(PU, getOps(U), M, 12638 included('META-MODULE, getImports(PU), DB), VDS, DB), 12639 U, M, 12640 insertVars(getName(PU), VDS, 12641 insertTopModule(getName(PU), 12642 solveBubblesMod(PU, getOps(U), M, 12643 included('META-MODULE, getImports(PU), DB), VDS, DB), DB))) . 12644 12645 eq evalPreModule3(PU, U, M, DB) 12646 *** PU : top module without bubbles 12647 *** U : everything below 12648 *** M : complete signature 12649 = insertFlatModule(getName(PU), 12650 flatModule(setImports(transform(addDecls(PU, U), DB), nil)), 12651 insertInternalModule(getName(PU), transform(PU, DB), DB)) . 12652 eq evalPreModule3(unitError(QIL), U, M, DB) = warning(DB, QIL) . 12653endfm 12654 12655------------------------------------------------------------------------------- 12656******************************************************************************* 12657------------------------------------------------------------------------------- 12658 12659*** Note that in both \texttt{evalModule} and \texttt{evalPreModule}, the function 12660*** \texttt{transform} has to be invoked to transform the module into a 12661*** functional or system module. In the current system, the only 12662*** transformation available is from object-oriented modules to system modules. 12663 12664*** 12665*** 6.8 Application of Map STS 12666*** 12667 12668*** The following two modules deal with the application of a set of renaming 12669*** maps to a module. Except for the proof obligations and additional checks 12670*** associated with views---almost none of these checks are performed, and 12671*** none of these proof obligations is generated in the current version---the 12672*** way of applying a renaming map and a view map on a module is the same. 12673*** Internally, they are treated in the same way; the only difference between 12674*** them consists in the way of calling the function to accomplish this 12675*** application. 12676 12677*** Note that there might be some `interference' between sort maps, and 12678*** operator maps and message maps when they are applied. Let us consider for 12679*** example a module with an operator declaration 12680*** 12681*** op f : Foo -> Foo . 12682*** 12683*** and a renaming map set 12684*** 12685*** (sort Foo to Bar, op f : Foo -> Foo to g) 12686*** 12687*** These renamings have to be applied carefully to avoid unintended behaviors. 12688*** Depending on which of the maps is applied first, the other will be 12689*** applicable or not. All the maps must be applied to the original module. 12690*** To avoid the interference between the sort maps and other maps, the map set 12691*** is divided into two sTS: The first one contains the sort maps, and the 12692*** second one contains the other maps. 12693 12694*** We assume that there are no ambiguous mappings, that is, that we do not 12695*** have, for example, maps \verb~op f to g~ and \verb~op f to h~. In case of 12696*** such ambiguity, one of the maps will be arbitrarily chosen. 12697 12698*** 12699*** 6.8.1 Map STS on Terms 12700*** 12701 12702*** The application of a set of view maps to a term is defined in the following 12703*** module \texttt{RENAMING-SET-APPL-ON-TERM}. The function 12704*** \texttt{applyMapsToTerm} is used to apply a given view map set to terms 12705*** appearing in equations, rules, identity element declarations, and 12706*** membership axioms, as part of the process of applying a map set to a unit. 12707 12708*** Some of the auxiliary functions introduced in this module will also be used 12709*** in the application of maps to operator and message declarations in the 12710*** \texttt{RENAMING-SET-APPL-ON-UNIT} module. 12711 12712------------------------------------------------------------------------------- 12713******************************************************************************* 12714------------------------------------------------------------------------------- 12715 12716fmod RENAMING-SET-APPL-ON-TERM is 12717 pr UNIT . 12718 pr FMAP . 12719 pr EXT-SORT . 12720 12721 var R : Renaming . 12722 vars RS RS' RS'' SRS ORS : RenamingSet . 12723 var M : Module . 12724 vars F F' F'' A A' A'' : Qid . 12725 vars T T' T'' O : Term . 12726 vars TL TL' TL'' TL3 : TermList . 12727 vars S S' S'' C C' C'' : Sort . 12728 var SS : SortSet . 12729 var K : Kind . 12730 vars TyL TyL' : TypeList . 12731 vars Ty Ty' : Type . 12732 vars Subst Subst' Subst'' : Substitution . 12733 var AtS : AttrSet . 12734 var OPDS : OpDeclSet . 12735 vars V V' : Variable . 12736 vars Ct Ct' : Constant . 12737 var QIL : QidList . 12738 var Cd : Condition . 12739 12740*** The following functions \texttt{applyMapsToSort} and 12741*** \texttt{applyMapsToClassSort} apply a set of maps, respectively, to a 12742*** sort a to a class name in its single identifier form, that is, when they 12743*** appear qualifying constants. Functions \texttt{applyMapsToType} and 12744*** \texttt{applyMapsToClassName} are similar but being applied to sort or 12745*** class names in their normal form. 12746 12747 op applyMapsToSort : RenamingSet Sort -> Sort . 12748 eq applyMapsToSort((sort S to S'), S) = S' . 12749 eq applyMapsToSort((sort S to S'), S'') = S'' [owise] . 12750 eq applyMapsToSort(((sort S to S'), SRS), S) = S' . 12751 eq applyMapsToSort(((sort S to S'), SRS), S'') 12752 = applyMapsToSort(SRS, S'') 12753 [owise] . 12754 eq applyMapsToSort(R, S) = S [owise]. 12755 eq applyMapsToSort((R, SRS), S) = applyMapsToSort(SRS, S) [owise]. 12756 eq applyMapsToSort(none, S) = S . 12757 12758 op applyMapsToSortSet : RenamingSet SortSet -> SortSet . 12759 eq applyMapsToSortSet(SRS, (S ; SS)) 12760 = (applyMapsToType(SRS, S) ; applyMapsToSortSet(SRS, SS)) . 12761 eq applyMapsToSortSet(SRS, none) = none . 12762 12763 op applyMapsToType : RenamingSet Type -> Type . 12764 eq applyMapsToType((sort S to S'), S) = S' . 12765 eq applyMapsToType(((sort S to S'), SRS), S) = S' . 12766 eq applyMapsToType((sort S to S'), K) 12767 = qid("[" + string(applyMapsToType(sort S to S', getSort(K))) + "]") . 12768 eq applyMapsToType(((sort S to S'), SRS), K) 12769 = qid("[" 12770 + string(applyMapsToType(((sort S to S'), SRS), getSort(K))) 12771 + "]") . 12772 eq applyMapsToType(SRS, Ty) = Ty [owise] . 12773 12774 op applyMapsToClassName : RenamingSet Sort -> Sort . 12775 eq applyMapsToClassName((class C to C'), C) = C' . 12776 eq applyMapsToClassName(((class C to C'), SRS), C) = C' . 12777 eq applyMapsToClassName(SRS, C) = C [owise] . 12778 12779*** \texttt{applyOpMapsToOpId} applies a map set to an operator name. 12780 12781 op applyOpMapsToOpId : Qid RenamingSet -> Qid . 12782 eq applyOpMapsToOpId(F, (op F to F' [AtS])) = F' . 12783 eq applyOpMapsToOpId(F, (op F : TyL -> Ty to F' [AtS])) = F' . 12784 eq applyOpMapsToOpId(F, RS) = F [owise] . 12785 12786*** Note that all maps introduced in Sections~\ref{renaming-maps} 12787*** and~\ref{view-maps}, except for label maps, may affect a term. For example, 12788*** sort maps will be applied to the qualifications of terms, and class and 12789*** attribute maps have to be applied to the objects appearing in the term. 12790*** Operator and message maps in which an explicit arity and coarity is given, 12791*** and operator maps going to derived operators (see Section~\ref{Views}) 12792*** must be applied to the complete family of subsort-overloaded operators. 12793 12794*** The function \texttt{applyMapsToTerm} takes as arguments two sTS of 12795*** view maps (the first set for sort maps, and the second for the other maps), 12796*** the term to which the maps will be applied, and a module to be used in the 12797*** matching of terms, sort comparisons, etc. Its declaration is as follows. 12798 12799 op applyMapsToTerm2 : RenamingSet RenamingSet Term Module -> Term . 12800 12801*** If the term on which the maps have to be applied is not an object, 12802*** different cases have to be considered for each of the possible forms of a 12803*** term. If it is a variable or \texttt{error*}, the same term is returned 12804*** without change (term maps are a special case for this). If it is a sort 12805*** test or a lazy sort test, with forms \verb~T : S~ and \verb~T :: S~, 12806*** respectively, the maps are applied to the term \texttt{T} and to the sort 12807*** \texttt{S}. In case of being of forms \verb~F.S~ or \verb~F[TL]~ with 12808*** \texttt{F} an operator name, \texttt{S} a sort, and \texttt{TL} a list of 12809*** terms, the function \texttt{getRightOpMaps} will return the subset of 12810*** maps which are applicable on such term. If \texttt{none} is returned then 12811*** no map is applicable. If more than one map is returned then there is an 12812*** ambiguity, and any of them will be arbitrarily taken. The function 12813*** \texttt{imagTerm} is called with the term and the maps applicable on 12814*** it and return the image of the term. In case of a term of the form 12815*** \texttt{F[TL]}, \texttt{imageOfTerm} will make recursive calls with the 12816*** arguments in \texttt{TL}. 12817 12818*** The application of a term map to a term requires the `matching' of the 12819*** source term in the map with the term on which the map is applied, and then 12820*** the application of the obtained substitution. Note, however, that a 12821*** complete matching algorithm is not required. Given the form of the pattern 12822*** we can choose beforehand the appropriate map, that is, we know that in 12823*** fact there is a match when the function is called. Note also that the map 12824*** has to be applied to the whole family of subsort overloaded operators. We 12825*** just have to check that the sort of the given variable and the 12826*** corresponding term are in the same connected component of sorts. In 12827*** addition to getting the appropriate substitution, the only thing we need 12828*** to check is that there are no variables with different assignments, that 12829*** is, that in case of having a nonlinear pattern, the terms being assigned 12830*** to each variable are equal. We call \texttt{pseudoMatch} to the function 12831*** doing this task. 12832 12833 op applyMapsToTerm2 : RenamingSet RenamingSet TermList Module -> TermList . 12834 12835 op imageOfTerm : RenamingSet RenamingSet Term RenamingSet Module -> Term . 12836 op applyMapsToSubst : RenamingSet RenamingSet Substitution Module -> Substitution . 12837 op pseudoMatch : TermList TermList Module Substitution -> Substitution . 12838 op pseudoMatch2 : TermList TermList Module Substitution -> Substitution . 12839 op pseudoMatchResult : Substitution -> Substitution . 12840 op pseudoMatchResult : Substitution Assignment Substitution Substitution -> Substitution . 12841 12842 op getRightOpMaps : Qid TypeList Type RenamingSet Module -> RenamingSet . 12843 op applyMapsToObjectAttrSet : RenamingSet RenamingSet Sort Term Module -> Term . 12844 op applyMapsToAttrNameInTerm : RenamingSet Sort Qid Module -> Qid . 12845 12846 eq applyMapsToTerm2(SRS, ORS, Ct, M) 12847 = imageOfTerm(SRS, ORS, Ct, 12848 getRightOpMaps(getName(Ct), nil, getType(Ct), ORS, M), M) . 12849 eq applyMapsToTerm2(SRS, ORS, V, M) 12850 = qid(string(getName(V)) + ":" 12851 + string(applyMapsToType(SRS, getType(V)))) . 12852 eq applyMapsToTerm2(SRS, ORS, qidError(QIL), M) = qidError(QIL) . 12853 eq applyMapsToTerm2(SRS, ORS, F[TL], M) 12854 = imageOfTerm(SRS, ORS, F[TL], 12855 getRightOpMaps(F, eLeastSort(M, TL), leastSort(M, F[TL]), ORS, M), 12856 M) 12857 [owise] . 12858 ---- if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) . 12859 eq applyMapsToTerm2(SRS, ORS, '<_:_|_>[O, Ct, T], M) 12860 = '<_:_|_>[applyMapsToTerm2(SRS, ORS, O, M), 12861 qid(string(applyMapsToClassName(SRS, getName(Ct))) 12862 + "." + string(applyMapsToClassName(SRS, getType(Ct)))), 12863 applyMapsToObjectAttrSet(SRS, ORS, getName(Ct), T, M)]. 12864 ceq applyMapsToTerm2(SRS, ORS, '<_:_|_>[O, C, T], M) 12865 = '<_:_|_>[applyMapsToTerm2(SRS, ORS, O, M), 12866 applyMapsToClassName(SRS, C), 12867 applyMapsToObjectAttrSet(SRS, ORS, C, T, M)] 12868 if not C :: Constant . 12869 eq applyMapsToTerm2(SRS, ORS, '<_:_|`>[O, Ct], M) 12870 = '<_:_|_>[applyMapsToTerm2(SRS, ORS, O, M), 12871 qid(string(applyMapsToClassName(SRS, getName(Ct))) 12872 + "." + string(applyMapsToClassName(SRS, getType(Ct)))), 12873 'none.AttributeSet] . 12874 ceq applyMapsToTerm2(SRS, ORS, '<_:_|`>[O, C], M) 12875 = '<_:_|_>[applyMapsToTerm2(SRS, ORS, O, M), 12876 applyMapsToClassName(SRS, C), 'none.AttributeSet] 12877 if not C :: Constant . 12878 ceq applyMapsToTerm2(SRS, ORS, F[TL], M) 12879 = qid("_::`" + string(applyMapsToType(SRS, qid(substr(string(F), 4, length(string(F))))))) [ 12880 applyMapsToTerm2(SRS, ORS, TL, M)] 12881 if substr(string(F), 0, 4) == "_::`" . 12882---- /\ substr(string(F), sd(length(string(F)), 2), 2) = "`}" . 12883 12884 ceq applyMapsToTerm2(SRS, ORS, (T, TL), M) 12885 = (applyMapsToTerm2(SRS, ORS, T, M), 12886 applyMapsToTerm2(SRS, ORS, TL, M)) 12887 if TL =/= empty . 12888 12889*** Application of a map set to the name of an attribute in an object 12890 12891 eq applyMapsToAttrNameInTerm((attr A . S to A'), C, A'', M) 12892 = if sameKind(M, S, C) and-then (qid(string(A) + "`:_") == A'') 12893 then qid(string(A') + "`:_") 12894 else A'' 12895 fi . 12896 eq applyMapsToAttrNameInTerm(((attr A . S to A'), ORS), C, A'', M) 12897 = if sameKind(M, S, C) and-then (qid(string(A) + "`:_") == A'') 12898 then qid(string(A') + "`:_") 12899 else applyMapsToAttrNameInTerm(ORS, C, A'', M) 12900 fi . 12901 eq applyMapsToAttrNameInTerm(R, C, A, M) = A [owise] . 12902 eq applyMapsToAttrNameInTerm((R, ORS), C, A, M) 12903 = applyMapsToAttrNameInTerm(ORS, C, A, M) 12904 [owise] . 12905 eq applyMapsToAttrNameInTerm(none, S, A, M) = A . 12906 12907*** Selection of all the operator or message maps that are applicable on an 12908*** operator with a given arity and coarity. 12909 12910 eq getRightOpMaps(F, TyL, Ty, (msg F' to F''), M) 12911 = getRightOpMaps(F, TyL, Ty, (op F' to F'' [none]), M) . 12912 eq getRightOpMaps(F, TyL, Ty, ((msg F' to F''), RS), M) 12913 = getRightOpMaps(F, TyL, Ty, ((op F' to F'' [none]), RS), M) . 12914 eq getRightOpMaps(F, TyL, Ty, (msg F' : TyL' -> Ty' to F''), M) 12915 = getRightOpMaps(F, TyL, Ty, op F' : TyL' -> Ty' to F'' [none], M) . 12916 eq getRightOpMaps(F, TyL, Ty, ((msg F' : TyL' -> Ty' to F''), RS), M) 12917 = getRightOpMaps(F, TyL, Ty, 12918 (op F' : TyL' -> Ty' to F'' [none], RS), M) . 12919 eq getRightOpMaps(F, TyL, Ty, (op F to F' [AtS]), M) = (op F to F' [AtS]) . 12920 eq getRightOpMaps(F, TyL, Ty, (op F to F' [AtS], RS), M) 12921 = (op F to F' [AtS], getRightOpMaps(F, TyL, Ty, RS, M)) . 12922 eq getRightOpMaps(F, TyL, Ty, op F : TyL' -> Ty' to F' [AtS], M) 12923 = if (size(TyL') == 2 and-then (sameKindAll(M, Ty', TyL) and-then assoc in attrs2SameKind(F, TyL, M))) 12924 or-else 12925 sameKind(M, TyL Ty, TyL' Ty') 12926 then (op F : TyL' -> Ty' to F' [AtS]) 12927 else none 12928 fi . 12929 eq getRightOpMaps(F, TyL, Ty, (op F : TyL' -> Ty' to F' [AtS], RS), M) 12930 = if (size(TyL') == 2 and-then (sameKindAll(M, Ty', TyL) and-then assoc in attrs2SameKind(F, TyL, M))) 12931 or-else 12932 sameKind(M, TyL Ty, TyL' Ty') 12933 then (op F : TyL' -> Ty' to F' [AtS], 12934 getRightOpMaps(F, TyL, Ty, RS, M)) 12935 else getRightOpMaps(F, TyL, Ty, RS, M) 12936 fi . 12937 eq getRightOpMaps(F, TyL, Ty, op_to`term_(F[TL], T), M) 12938 = if sameKind(M, TyL, varListSort(TL)) 12939 then (op_to`term_(F[TL], T)) 12940 else none 12941 fi . 12942 eq getRightOpMaps(F, TyL, Ty, (op_to`term_(F[TL], T), RS), M) 12943 = if sameKind(M, TyL, varListSort(TL)) 12944 then (op_to`term_(F[TL], T), getRightOpMaps(F, TyL, Ty, RS, M)) 12945 else getRightOpMaps(F, TyL, Ty, RS, M) 12946 fi . 12947 eq getRightOpMaps(F, TyL, Ty, (op_to`term_(Ct, T)), M) 12948 = if TyL == nil 12949 and-then (F == getName(Ct) 12950 and-then sameKind(M, Ty, getType(Ct))) 12951 then (op_to`term_(Ct, T)) 12952 else none 12953 fi . 12954 eq getRightOpMaps(F, TyL, Ty, (op_to`term_(Ct, T), RS), M) 12955 = if TyL == nil 12956 and-then (F == getName(Ct) 12957 and-then sameKind(M, Ty, getType(Ct))) 12958 then (op_to`term_(Ct, T), getRightOpMaps(F, TyL, Ty, RS, M)) 12959 else getRightOpMaps(F, TyL, Ty, RS, M) 12960 fi . 12961 eq getRightOpMaps(F, TyL:[Type], Ty:[Type], RS, M) = none [owise]. 12962 12963 op varListSort : TermList -> TypeList . 12964 eq varListSort((V, TL)) = (getType(V) varListSort(TL)) . 12965 eq varListSort(empty) = nil . 12966 12967 op attrs2SameKind : Qid TypeList Module -> AttrSet . 12968 op attrs2SameKind : Qid TypeList OpDeclSet Module -> AttrSet . 12969 eq attrs2SameKind(F, Ty Ty' TyL, M) = attrs2SameKind(F, Ty Ty', getOps(M), M) . 12970 ceq attrs2SameKind(F, TyL, op F : TyL' -> Ty' [AtS] . OPDS, M) ---- all subsort overloaded operators have the same equational attributes 12971 = AtS 12972 if sameKind(M, TyL, TyL') . 12973 eq attrs2SameKind(F, TyL, OPDS, M) = none [owise] . 12974 12975*** Application of a map set to the set of attributes in an object 12976 12977 eq applyMapsToObjectAttrSet(RS, RS', C, '_`,_[A[T], TL], M) 12978 = '_`,_[applyMapsToAttrNameInTerm(RS', C, A, M) 12979 [applyMapsToTerm2(RS, RS', T, M)], 12980 applyMapsToObjectAttrSet(RS, RS', C, TL, M)] . 12981 eq applyMapsToObjectAttrSet(RS, RS', C, A[T], M) 12982 = applyMapsToAttrNameInTerm(RS', C, A, M) 12983 [applyMapsToTerm2(RS, RS', T, M)] . 12984 eq applyMapsToObjectAttrSet(RS, RS', C, 12985 '_`,_['none.AttributeSet, TL], M) 12986 = '_`,_['none.AttributeSet, 12987 applyMapsToObjectAttrSet(RS, RS', C, TL, M)] . 12988 eq applyMapsToObjectAttrSet(RS, RS', C, 'none.AttributeSet, M) 12989 = 'none.AttributeSet . 12990 12991*** Image of a term 12992 12993 eq imageOfTerm(RS, RS', Ct, none, M) 12994 = qid(string(getName(Ct)) + "." 12995 + string(applyMapsToType(RS, getType(Ct)))) . 12996 eq imageOfTerm(RS, RS', F[TL], none, M) 12997 = F [ applyMapsToTerm2(RS, RS', TL, M) ] . 12998 12999 eq imageOfTerm(RS, RS', F[TL], (op F to F' [AtS]), M) 13000 = F' [ applyMapsToTerm2(RS, RS', TL, M) ] . 13001 eq imageOfTerm(RS, RS', F[TL], ((op F to F' [AtS]), RS''), M) 13002 = F' [ applyMapsToTerm2(RS, RS', TL, M) ] . 13003 eq imageOfTerm(RS, RS', F[TL], (op F : TyL -> Ty to F'[AtS]), M) 13004 = F' [ applyMapsToTerm2(RS, RS', TL, M) ] . 13005 eq imageOfTerm(RS, RS', F[TL], (op F : TyL -> Ty to F'[AtS], RS''),M) 13006 = F' [ applyMapsToTerm2(RS, RS', TL, M) ] . 13007 eq imageOfTerm(RS, RS', T, op_to`term_(T', T''), M) 13008 = applySubst(T'', 13009 applyMapsToSubst(RS, RS', pseudoMatch(T', T, M, none), M)) . 13010 eq imageOfTerm(RS, RS', T, (op_to`term_(T', T''), RS''), M) 13011 = applySubst(T'', 13012 applyMapsToSubst(RS, RS', pseudoMatch(T', T, M, none), M)) . 13013 ceq imageOfTerm(RS, RS', Ct, (op F to F' [AtS]), M) 13014 = qid(string(F') + "." + string(applyMapsToType(RS, getType(Ct)))) 13015 if getName(Ct) = F . 13016 ceq imageOfTerm(RS, RS', Ct, ((op F to F' [AtS]), RS''), M) 13017 = qid(string(F') + "." + string(applyMapsToType(RS, getType(Ct)))) 13018 if getName(Ct) = F . 13019 ceq imageOfTerm(RS, RS', Ct, (op F : TyL -> Ty to F' [AtS]), M) 13020 = qid(string(F') + "." + string(applyMapsToType(RS, getType(Ct)))) 13021 if getName(Ct) = F . 13022 ceq imageOfTerm(RS, RS', Ct, (op F : TyL -> Ty to F' [AtS], RS''),M) 13023 = qid(string(F') + "." + string(applyMapsToType(RS, getType(Ct)))) 13024 if getName(Ct) = F . 13025 13026*** Application of a Substitution on a term 13027 13028 op applySubst : TermList Substitution -> TermList . 13029 eq applySubst(T, none) = T . 13030 eq applySubst(V, ((V' <- T) ; Subst)) 13031 = if getName(V) == getName(V') 13032 then T 13033 else applySubst(V, Subst) 13034 fi . 13035 eq applySubst(F[TL], Subst) = F[applySubst(TL, Subst)] . 13036 eq applySubst(Ct, Subst) = Ct . 13037 ceq applySubst((T, TL), Subst) 13038 = (applySubst(T, Subst), applySubst(TL,Subst)) 13039 if TL =/= empty . 13040 13041*** Application of a Substitution to a condition 13042 13043 op applySubst : Condition Substitution -> Condition . 13044 eq applySubst(T = T' /\ Cd, Subst) 13045 = (applySubst(T, Subst) = applySubst(T', Subst)) /\ applySubst(Cd, Subst) . 13046 eq applySubst(T => T' /\ Cd, Subst) 13047 = (applySubst(T, Subst) => applySubst(T', Subst)) /\ applySubst(Cd, Subst) . 13048 eq applySubst(T : S /\ Cd, Subst) 13049 = (applySubst(T, Subst) : S) /\ applySubst(Cd, Subst) . 13050 eq applySubst((nil).EqCondition, Subst) = nil . 13051 13052*** PseudoMatch 13053 13054 eq pseudoMatch(T, T', M, Subst) 13055 = pseudoMatchResult(pseudoMatch2(T, T', M, Subst)) . 13056 13057 eq pseudoMatch2(Ct, Ct', M, Subst) = none . 13058 eq pseudoMatch2(F[TL], F'[TL'], M, Subst) 13059 = if F == F' 13060 then pseudoMatch2(TL, TL', M, Subst) 13061 else none 13062 fi . 13063 eq pseudoMatch2((V, TL), (T, TL'), M, Subst) 13064 = if sameKind(M, getType(V), leastSort(M, T)) 13065 then pseudoMatch2(TL, TL', M, (V <- T ; Subst)) 13066 else none 13067 fi . 13068 eq pseudoMatch2(V, T, M, Subst) 13069 = if sameKind(M, getType(V), leastSort(M, T)) 13070 then (V <- T ; Subst) 13071 else none 13072 fi . 13073 13074 eq pseudoMatch2((V, TL), (T, TL'), M, Subst) 13075 = if sameKind(M, getType(V), leastSort(M, T)) 13076 then pseudoMatch2(TL, TL', M, (V <- T ; Subst)) 13077 else none 13078 fi . 13079 eq pseudoMatch2((Ct, TL), (Ct', TL'), M, Subst) 13080 = if getName(Ct) == getName(Ct') 13081 then pseudoMatch2(TL, TL', M, Subst) 13082 else none 13083 fi . 13084 eq pseudoMatch2((F[TL], TL'), (F'[TL''], TL3), M, Subst) 13085 = if F == F' 13086 then pseudoMatch2(TL', TL3, M, pseudoMatch2(TL, TL'', M, none) ; Subst) 13087 else none 13088 fi . 13089 eq pseudoMatch2(empty, empty, M, Subst) = Subst . 13090 13091 *** pseudoMatchResult detects conflicts and eliminates duplicates 13092 13093 eq pseudoMatchResult((V <- T) ; Subst) 13094 = pseudoMatchResult(none, (V <- T), none, Subst) . 13095 eq pseudoMatchResult(none) = none . 13096 13097 eq pseudoMatchResult(Subst, (V <- T), Subst', (V' <- T') ; Subst'') 13098 = if V == V' 13099 then if T == T' 13100 then pseudoMatchResult(Subst, (V <- T), Subst', Subst'') 13101 else none 13102 fi 13103 else pseudoMatchResult(Subst, (V <- T), Subst' ; (V' <- T'), Subst'') 13104 fi . 13105 eq pseudoMatchResult(Subst, (V <- T), (V' <- T') ; Subst', none) 13106 = pseudoMatchResult(Subst ; (V <- T), (V' <- T'), none, Subst') . 13107 eq pseudoMatchResult(Subst, (V <- T), none, none) = (Subst ; (V <- T)) . 13108 13109*** Application of a set of maps to a substitution 13110 13111 eq applyMapsToSubst(RS, RS', ((V <- T) ; Subst), M) 13112 = ((applyMapsToTerm2(RS, RS', V, M) <- applyMapsToTerm2(RS, RS', T, M)) ; 13113 applyMapsToSubst(RS, RS', Subst, M)) . 13114 eq applyMapsToSubst(RS, RS', none, M) = none . 13115 13116endfm 13117 13118------------------------------------------------------------------------------- 13119******************************************************************************* 13120------------------------------------------------------------------------------- 13121 13122*** We do not include here the equations defining the semantics of the function 13123*** \texttt{applyMapsToTerm}. Instead, we present an example illustrating 13124*** the meaning of the function. Renaming maps and view maps were already 13125*** discussed in Sections~\ref{Views} and~\ref{module-expressions}. 13126 13127*** Let us consider the following configuration in the module 13128*** \texttt{STACK2[Accnt]} presented in Section~\ref{module-expressions}. In 13129*** this configuration we have objects in the class \texttt{Accnt} which 13130*** represent the accounts of different clients of a bank, which is 13131*** represented as an object \texttt{'bank} of class \texttt{Stack[Accnt]}. 13132*** The object \texttt{'bank} in the example configuration below keeps a stack 13133*** with the accounts of the bank represented as a linked list of nodes, each 13134*** of which corresponds to the account of one of the clients. 13135 13136*** ('bank push 'john) 13137*** ('peter elt 2000) 13138*** < 'bank : Stack[Accnt] | first : o ('bank, 1) > 13139*** < 'paul : Accnt | bal : 5000 > 13140*** < 'peter : Accnt | bal : 2000 > 13141*** < 'mary : Accnt | bal : 7200 > 13142*** < 'john : Accnt | bal : 100 > 13143*** < o('bank, 0) : Node[Accnt] | node : 'peter, next : null > 13144*** < o('bank, 1) : Node[Accnt] | node : 'mary, next : o('bank, 0) > . 13145*** 13146*** Let us apply the following renaming to the previous term. 13147*** 13148*** (op o to id, 13149*** class Stack[Accnt] to Bank, 13150*** msg _push_ : Oid Oid -> Msg to open`account`in_to_, 13151*** msg _pop to close`account`of_, 13152*** msg _elt_ to _owns_dollars, 13153*** attr node . Node[Accnt] to client, 13154*** attr bal . Accnt to balance) 13155*** 13156*** The resulting term is as follows. 13157*** 13158*** (open account in 'bank to 'john) 13159*** ('peter owns 2000 dollars) 13160*** < 'bank : Bank | first : id('bank, 1) > 13161*** < 'paul : Accnt | balance : 5000 > 13162*** < 'peter : Accnt | balance : 2000 > 13163*** < 'mary : Accnt | balance : 7200 > 13164*** < 'john : Accnt | balance : 100 > 13165*** < id('bank, 0) : Node[Accnt] | client : 'peter, next : null > 13166*** < id('bank, 1) : Node[Accnt] | client : 'mary, next : id('bank, 0) > 13167 13168*** The function \texttt{applyMapsToTerm} treats the object constructor 13169*** \verb~<_:_|_>~ in a special way. It cannot be renamed, and, when an 13170*** occurrence of such a constructor is found, class and attribute maps require 13171*** a particular handling. Inside terms these maps are only triggered when 13172*** this constructor is found, and they are applied in a very restricted way, 13173*** according to the general pattern for objects. We assume that the operator 13174*** \verb~<_:_|_>~ is only used for objects and that objects constructed using 13175*** it are well-formed. 13176 13177*** 13178*** 6.8.2 Map STS on Modules 13179*** 13180 13181*** The application of view maps to modules and theories of the different types 13182*** is defined in the following module \texttt{RENAMING-SET-APPL-ON-UNIT}. The 13183*** function \texttt{applyMapsToModule} is defined recursively by applying it 13184*** to the different components of a unit. When the terms in the different 13185*** declarations are reached, the function \texttt{applyMapsToTerm} is 13186*** called. This call is made with the set of maps split conveniently, as 13187*** explained above. 13188 13189------------------------------------------------------------------------------- 13190******************************************************************************* 13191------------------------------------------------------------------------------- 13192 13193fmod RENAMING-SET-APPL-ON-UNIT is 13194 pr RENAMING-SET-APPL-ON-TERM . 13195 pr INT-LIST . 13196 pr VIEW-EXPR . 13197 13198 op applyMapsToModule : RenamingSet Module Module -> Module . 13199 op applyMapsToModuleAux : RenamingSet RenamingSet Module Module -> Module . 13200 op splitMaps : RenamingSet -> Tuple{RenamingSet,RenamingSet} . 13201 op splitMapsAux : RenamingSet RenamingSet RenamingSet 13202 -> Tuple{RenamingSet,RenamingSet} . 13203 13204 op applyMapsToTypeList : RenamingSet TypeList -> TypeList . 13205 op applyMapsToSubsorts : RenamingSet SubsortDeclSet -> SubsortDeclSet . 13206 op applyMapsToOps : RenamingSet RenamingSet OpDeclSet Module -> OpDeclSet . 13207 op applyMapsToOp : RenamingSet RenamingSet RenamingSet OpDecl Module -> OpDecl . 13208 op applyMapsToAttrs : RenamingSet RenamingSet AttrSet Module -> AttrSet . 13209 op applyMapToAttrs : Renaming AttrSet -> AttrSet . 13210 op applyMapToAttrsAux : AttrSet AttrSet AttrSet -> AttrSet . 13211 op applyMapsToHooks : RenamingSet RenamingSet HookList Module -> HookList . 13212 op applyMapsToHooksAux : RenamingSet RenamingSet Hook Module -> Hook . 13213 op applyMapsToMbs : RenamingSet RenamingSet MembAxSet Module -> MembAxSet . 13214 op applyMapsToEqs : RenamingSet RenamingSet EquationSet Module -> EquationSet . 13215 op applyMapsToRls : RenamingSet RenamingSet RuleSet Module -> RuleSet . 13216 op applyMapsToCond : RenamingSet RenamingSet Condition Module -> Condition . 13217 op applyMapsToLabel : RenamingSet Qid -> Qid . 13218 op applyMapsToClassDeclSet : RenamingSet RenamingSet ClassDeclSet -> ClassDeclSet . 13219 op applyMapsToSubclassDeclSet : RenamingSet SubclassDeclSet -> SubclassDeclSet . 13220 op applyMapsToMsgDeclSet : RenamingSet RenamingSet MsgDeclSet Module -> MsgDeclSet . 13221 op applyMapsToMsgDecl : RenamingSet RenamingSet MsgDecl Module -> MsgDecl . 13222 op applyMapsToAttrName : RenamingSet Sort Qid -> Qid . 13223 op applyMapsToAttrDeclSet : RenamingSet RenamingSet Sort AttrDeclSet -> AttrDeclSet . 13224 13225 vars M U : Module . 13226 vars QI QI' QI'' L L' L'' F F' F'' A A' A'' : Qid . 13227 vars V V' : Variable . 13228 vars QIL QIL' : QidList . 13229 var VE : ViewExp . 13230 var H : Header . 13231 var ME : ModuleExpression . 13232 var PDL : ParameterDeclList . 13233 var IL : ImportList . 13234 vars S S' S'' C C' C'' : Sort . 13235 var Ty : Type . 13236 vars TyL TyL' : TypeList . 13237 var SS : SortSet . 13238 var SSDS : SubsortDeclSet . 13239 var OPDS : OpDeclSet . 13240 var MAS : MembAxSet . 13241 var EqS : EquationSet . 13242 var RlS : RuleSet . 13243 var CDS : ClassDeclSet . 13244 var SCDS : SubclassDeclSet . 13245 var MDS : MsgDeclSet . 13246 var ADS : AttrDeclSet . 13247 vars T T' T'' T3 O : Term . 13248 vars TL TL' : TermList . 13249 var At : Attr . 13250 vars AtS AtS' AtS'' : AttrSet . 13251 vars I I' : Nat . 13252 vars NL NL' : IntList . 13253 var Hk : Hook . 13254 var HkL : HookList . 13255 var R : Renaming . 13256 vars RS RS' RS'' SRS ORS : RenamingSet . 13257 var Subst : Substitution . 13258 var Cond : Condition . 13259 var St : String . 13260 var MN : ModuleName . 13261 13262 sort Tuple{RenamingSet,RenamingSet} . 13263 op <_;_> : RenamingSet RenamingSet -> Tuple{RenamingSet, RenamingSet} . 13264 ops sortMaps otherMaps : Tuple{RenamingSet, RenamingSet} -> RenamingSet . 13265 eq sortMaps(< RS ; RS' >) = RS . 13266 eq otherMaps(< RS ; RS' >) = RS' . 13267 13268 eq splitMaps(RS) = splitMapsAux(RS, none, none) . 13269 eq splitMapsAux((sort S to S'), RS', RS'') 13270 = splitMapsAux(none, ((sort S to S'), RS'), RS'') . 13271 eq splitMapsAux(((sort S to S'), RS), RS', RS'') 13272 = splitMapsAux(RS, ((sort S to S'), RS'), RS'') . 13273 eq splitMapsAux((class S to S'), RS', RS'') 13274 = splitMapsAux(none, ((class S to S'), RS'), RS'') . 13275 eq splitMapsAux(((class S to S'), RS), RS', RS'') 13276 = splitMapsAux(RS, ((class S to S'), RS'), RS'') . 13277 eq splitMapsAux(R, RS', RS'') 13278 = splitMapsAux(none, RS', (R, RS'')) [owise] . 13279 eq splitMapsAux((R, RS), RS', RS'') 13280 = splitMapsAux(RS, RS', (R, RS'')) [owise] . 13281 eq splitMapsAux(none, RS, RS') = < RS ; RS' > . 13282 13283*** To avoid the interference between the sort and class maps with other maps, the map 13284*** set is divided in two sets. 13285 13286 ceq applyMapsToModule(RS, U, M) 13287 = applyMapsToModuleAux(SRS, ORS, U, M) 13288 if < SRS ; ORS > := splitMaps(RS) . 13289 eq applyMapsToModule(RS, U, unitError(QIL)) = unitError(QIL) . 13290 13291 eq applyMapsToModuleAux(SRS, ORS, mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, M) 13292 = mod H is 13293 IL 13294 sorts applyMapsToSortSet(SRS, SS) . 13295 applyMapsToSubsorts(SRS, SSDS) 13296 applyMapsToOps(SRS, ORS, OPDS, M) 13297 applyMapsToMbs(SRS, ORS, MAS, M) 13298 applyMapsToEqs(SRS, ORS, EqS, M) 13299 applyMapsToRls(SRS, ORS, RlS, M) 13300 endm . 13301 eq applyMapsToModuleAux(SRS, ORS, th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, M) 13302 = th MN is 13303 IL sorts applyMapsToSortSet(SRS, SS) . 13304 applyMapsToSubsorts(SRS, SSDS) 13305 applyMapsToOps(SRS, ORS, OPDS, M) 13306 applyMapsToMbs(SRS, ORS, MAS, M) 13307 applyMapsToEqs(SRS, ORS, EqS, M) 13308 applyMapsToRls(SRS, ORS, RlS, M) 13309 endth . 13310 eq applyMapsToModuleAux(SRS, ORS, fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, M) 13311 = fmod H is 13312 IL 13313 sorts applyMapsToSortSet(SRS, SS) . 13314 applyMapsToSubsorts(SRS, SSDS) 13315 applyMapsToOps(SRS, ORS, OPDS, M) 13316 applyMapsToMbs(SRS, ORS, MAS, M) 13317 applyMapsToEqs(SRS, ORS, EqS, M) 13318 endfm . 13319 eq applyMapsToModuleAux(SRS, ORS, fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, M) 13320 = fth MN is 13321 IL 13322 sorts applyMapsToSortSet(SRS, SS) . 13323 applyMapsToSubsorts(SRS, SSDS) 13324 applyMapsToOps(SRS, ORS, OPDS, M) 13325 applyMapsToMbs(SRS, ORS, MAS, M) 13326 applyMapsToEqs(SRS, ORS, EqS, M) 13327 endfth . 13328 eq applyMapsToModuleAux(SRS, ORS, omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, M) 13329 = omod H is 13330 IL 13331 sorts applyMapsToSortSet(SRS, SS) . 13332 applyMapsToSubsorts(SRS, SSDS) 13333 applyMapsToClassDeclSet(SRS, ORS, CDS) 13334 applyMapsToSubclassDeclSet(SRS, SCDS) 13335 applyMapsToOps(SRS, ORS, OPDS, M) 13336 applyMapsToMsgDeclSet(SRS, ORS, MDS, M) 13337 applyMapsToMbs(SRS, ORS, MAS, M) 13338 applyMapsToEqs(SRS, ORS, EqS, M) 13339 applyMapsToRls(SRS, ORS, RlS, M) 13340 endom . 13341 eq applyMapsToModuleAux(SRS, ORS, oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, M) 13342 = oth MN is 13343 IL 13344 sorts applyMapsToSortSet(SRS, SS) . 13345 applyMapsToSubsorts(SRS, SSDS) 13346 applyMapsToClassDeclSet(SRS, ORS, CDS) 13347 applyMapsToSubclassDeclSet(SRS, SCDS) 13348 applyMapsToOps(SRS, ORS, OPDS, M) 13349 applyMapsToMsgDeclSet(SRS, ORS, MDS, M) 13350 applyMapsToMbs(SRS, ORS, MAS, M) 13351 applyMapsToEqs(SRS, ORS, EqS, M) 13352 applyMapsToRls(SRS, ORS, RlS, M) 13353 endoth . 13354 13355 eq applyMapsToOps(RS, RS', (op F : TyL -> Ty [AtS] . OPDS), M) 13356 = (applyMapsToOp(RS, getRightOpMaps(F, TyL, Ty, RS', M), RS', (op F : TyL -> Ty [AtS] .), M) 13357 applyMapsToOps(RS, RS', OPDS, M)) . 13358 eq applyMapsToOps(RS, RS', none, M) = none . 13359 13360 eq applyMapsToOp(RS, R, RS', (op F : TyL -> Ty [AtS] .), M) 13361 = (op applyOpMapsToOpId(F, R) : applyMapsToTypeList(RS, TyL) -> applyMapsToType(RS, Ty) 13362 [applyMapsToAttrs(RS, RS', applyMapToAttrs(R, AtS), M)] .) . 13363 eq applyMapsToOp(RS, (R, RS'), RS'', (op F : TyL -> Ty [AtS] .), M) 13364 *** In case of ambiguous mappings we take one of them arbitrarily 13365 = (op applyOpMapsToOpId(F, R) : applyMapsToTypeList(RS, TyL) -> applyMapsToType(RS, Ty) 13366 [applyMapsToAttrs(RS, RS'', applyMapToAttrs(R, AtS), M)] .) . 13367 eq applyMapsToOp(RS, none, RS', (op F : TyL -> Ty [AtS] .), M) 13368 *** No map for this declaration 13369 = (op F : applyMapsToTypeList(RS, TyL) -> applyMapsToType(RS, Ty) 13370 [applyMapsToAttrs(RS, RS', AtS, M)] .) . 13371 13372 eq applyMapsToMsgDeclSet(RS, RS', ((msg F : TyL -> Ty .) MDS), M) 13373 = (applyMapsToMsgDecl(RS, getRightOpMaps(F, TyL, Ty, RS', M), (msg F : TyL -> Ty .), M) 13374 applyMapsToMsgDeclSet(RS, RS', MDS, M)) . 13375 eq applyMapsToMsgDeclSet(RS, RS', none, M) = none . 13376 13377 eq applyMapsToMsgDecl(RS, R, (msg F : TyL -> Ty .), M) 13378 = (msg applyOpMapsToOpId(F, R) : applyMapsToTypeList(RS, TyL) -> applyMapsToType(RS, Ty) .) . 13379 eq applyMapsToMsgDecl(RS, (R, RS'), (msg F : TyL -> Ty .), M) 13380 *** In case of ambiguous mappings we take one of them arbitrarily 13381 = (msg applyOpMapsToOpId(F, R) : applyMapsToTypeList(RS, TyL) -> applyMapsToType(RS, Ty) .) . 13382 eq applyMapsToMsgDecl(RS, none, (msg F : TyL -> Ty .), M) 13383 *** No map for this declaration 13384 = (msg F : applyMapsToTypeList(RS, TyL) -> applyMapsToType(RS, Ty) .) . 13385 13386*** The function \texttt{applyMapToAttrs} just takes care of changing the 13387*** attributes of the operators as indicated in the renamings. The renamings 13388*** properly said is accomplished by the function 13389*** \texttt{applyMapsToAttrs}. 13390 13391 eq applyMapToAttrs((msg F to F'), AtS) = AtS . 13392 eq applyMapToAttrs((msg F : TyL -> Ty to F'), AtS) = AtS . 13393 eq applyMapToAttrs(op_to`term_(T, T'), AtS) = AtS . 13394 eq applyMapToAttrs((op F to F' [AtS]), AtS') 13395 = applyMapToAttrsAux(AtS, AtS', none) . 13396 eq applyMapToAttrs((op F : TyL -> Ty to F' [AtS]), AtS') 13397 = applyMapToAttrsAux(AtS, AtS', none) . 13398 13399 *** add the new syntactic attributes 13400 eq applyMapToAttrsAux((gather(QIL) AtS), AtS', AtS'') 13401 = applyMapToAttrsAux(AtS, AtS', (gather(QIL) AtS'')) . 13402 eq applyMapToAttrsAux((format(QIL) AtS), AtS', AtS'') 13403 = applyMapToAttrsAux(AtS, AtS', (format(QIL) AtS'')) . 13404 eq applyMapToAttrsAux((prec(I) AtS), AtS', AtS'') 13405 = applyMapToAttrsAux(AtS, AtS', (prec(I) AtS'')) . 13406 eq applyMapToAttrsAux((At AtS), AtS', AtS'') 13407 = applyMapToAttrsAux(AtS, AtS', AtS'') 13408 [owise] . 13409 13410 *** remove the old syntactic attributes 13411 eq applyMapToAttrsAux(AtS, (format(QIL) AtS'), AtS'') 13412 = applyMapToAttrsAux(AtS, AtS', AtS'') . 13413 eq applyMapToAttrsAux(AtS, (gather(QIL) AtS'), AtS'') 13414 = applyMapToAttrsAux(AtS, AtS', AtS'') . 13415 eq applyMapToAttrsAux(AtS, (prec(I) AtS'), AtS'') 13416 = applyMapToAttrsAux(AtS, AtS', AtS'') . 13417 13418 eq applyMapToAttrsAux(none, (At AtS), AtS') 13419 = applyMapToAttrsAux(none, AtS, (At AtS')) . 13420 eq applyMapToAttrsAux(none, none, AtS) = AtS . 13421 13422 eq applyMapsToTypeList(RS, (Ty TyL)) 13423 = (applyMapsToType(RS, Ty) applyMapsToTypeList(RS, TyL)) . 13424 eq applyMapsToTypeList(RS, nil) = nil . 13425 13426 eq applyMapsToSubsorts(RS, ((subsort S < S' .) SSDS)) 13427 = ((subsort applyMapsToType(RS, S) < applyMapsToType(RS, S') .) 13428 applyMapsToSubsorts(RS, SSDS)) . 13429 eq applyMapsToSubsorts(RS, none) = none . 13430 13431 eq applyMapsToAttrs(RS, RS', (id(T) AtS), M) 13432 = (id(applyMapsToTerm2(RS, RS', T, M)) 13433 applyMapsToAttrs(RS, RS', AtS, M)) . 13434 eq applyMapsToAttrs(RS, RS', (left-id(T) AtS), M) 13435 = (left-id(applyMapsToTerm2(RS, RS', T, M)) 13436 applyMapsToAttrs(RS, RS', AtS, M)) . 13437 eq applyMapsToAttrs(RS, RS', (right-id(T) AtS), M) 13438 = (right-id(applyMapsToTerm2(RS, RS', T, M)) 13439 applyMapsToAttrs(RS, RS', AtS, M)) . 13440 eq applyMapsToAttrs(RS, RS', (special(HkL) AtS), M) 13441 = (special(applyMapsToHooks(RS, RS', HkL, M)) 13442 applyMapsToAttrs(RS, RS', AtS, M)) . 13443 eq applyMapsToAttrs(RS, RS', (label(L) AtS), M) 13444 = (label(applyMapsToLabel(RS, L)) 13445 applyMapsToAttrs(RS, RS', AtS, M)) . 13446 eq applyMapsToAttrs(RS, RS', AtS, M) = AtS [owise] . 13447 13448 eq applyMapsToHooks(RS, RS', id-hook(QI, QIL) HkL, M) 13449 = id-hook(QI, QIL) 13450 applyMapsToHooks(RS, RS', HkL, M). 13451 eq applyMapsToHooks(RS, RS', op-hook(QI, QI', QIL, QI'') HkL, M) 13452 = applyMapsToHooksAux(RS, 13453 getRightOpMaps(QI', QIL, QI'', RS', M), 13454 op-hook(QI, QI', QIL, QI''), M) 13455 applyMapsToHooks(RS, RS', HkL, M). 13456 eq applyMapsToHooks(RS, RS', term-hook(QI, T) HkL, M) 13457 = term-hook(QI, applyMapsToTerm2(RS, RS', T, M)) 13458 applyMapsToHooks(RS, RS', HkL, M). 13459 eq applyMapsToHooks(RS, RS', nil, M) = nil . 13460 13461 eq applyMapsToHooksAux(RS, R, op-hook(QI, F, TyL, Ty), M) 13462 = op-hook(QI, applyOpMapsToOpId(F, R), 13463 applyMapsToTypeList(RS, TyL), applyMapsToType(RS, Ty)) . 13464 eq applyMapsToHooksAux(RS, (R, RS'), op-hook(QI, F, TyL, Ty), M) 13465 *** In case of ambiguous mappings we take any of them arbitrarily 13466 = op-hook(QI, applyOpMapsToOpId(F, R), 13467 applyMapsToTypeList(RS, TyL), applyMapsToType(RS, Ty)) . 13468 eq applyMapsToHooksAux(RS, none, op-hook(QI, F, TyL, Ty), M) 13469 = op-hook(QI, F, applyMapsToTypeList(RS, TyL), 13470 applyMapsToType(RS, Ty)) . 13471 13472 eq applyMapsToMbs(RS, RS', ((mb T : S [AtS] .) MAS), M) 13473 = ((mb applyMapsToTerm2(RS, RS', T, M) : applyMapsToType(RS, S) 13474 [applyMapsToAttrs(RS, RS', AtS, M)] .) 13475 applyMapsToMbs(RS, RS', MAS, M)) . 13476 eq applyMapsToMbs(RS, RS', ((cmb T : S if Cond [AtS] .) MAS), M) 13477 = ((cmb applyMapsToTerm2(RS, RS', T, M) : applyMapsToType(RS, S) 13478 if applyMapsToCond(RS, RS', Cond, M) 13479 [applyMapsToAttrs(RS, RS', AtS, M)] .) 13480 applyMapsToMbs(RS, RS', MAS, M)) . 13481 eq applyMapsToMbs(RS, RS', none, M) = none . 13482 13483 eq applyMapsToEqs(RS, RS', ((ceq T = T' if Cond [AtS] .) EqS), M) 13484 = ((ceq applyMapsToTerm2(RS, RS', T, M) 13485 = applyMapsToTerm2(RS, RS', T', M) 13486 if applyMapsToCond(RS, RS', Cond, M) 13487 [applyMapsToAttrs(RS, RS', AtS, M)] .) 13488 applyMapsToEqs(RS, RS', EqS, M)) . 13489 eq applyMapsToEqs(RS, RS', ((eq T = T' [AtS] .) EqS), M) 13490 = ((eq applyMapsToTerm2(RS, RS', T, M) 13491 = applyMapsToTerm2(RS, RS', T', M) 13492 [applyMapsToAttrs(RS, RS', AtS, M)] .) 13493 applyMapsToEqs(RS, RS', EqS, M)) . 13494 eq applyMapsToEqs(RS, RS', none, M) = none . 13495 13496 eq applyMapsToRls(RS, RS', ((crl T => T' if Cond [AtS] .) RlS), M) 13497 = ((crl applyMapsToTerm2(RS, RS', T, M) 13498 => applyMapsToTerm2(RS, RS', T', M) 13499 if applyMapsToCond(RS, RS', Cond, M) 13500 [applyMapsToAttrs(RS, RS', AtS, M)] .) 13501 applyMapsToRls(RS, RS', RlS, M)) . 13502 eq applyMapsToRls(RS, RS', ((rl T => T' [AtS] .) RlS), M) 13503 = ((rl applyMapsToTerm2(RS, RS', T, M) 13504 => applyMapsToTerm2(RS, RS', T', M) 13505 [applyMapsToAttrs(RS, RS', AtS, M)] .) 13506 applyMapsToRls(RS, RS', RlS, M)) . 13507 eq applyMapsToRls(RS, RS', none, M) = none . 13508 13509 eq applyMapsToCond(RS, RS', T = T' /\ Cond, M) 13510 = applyMapsToTerm2(RS, RS', T, M) = applyMapsToTerm2(RS, RS', T', M) 13511 /\ applyMapsToCond(RS, RS', Cond, M) . 13512 eq applyMapsToCond(RS, RS', T : S /\ Cond, M) 13513 = applyMapsToTerm2(RS, RS', T, M) : applyMapsToSort(RS, S) 13514 /\ applyMapsToCond(RS, RS', Cond, M) . 13515 eq applyMapsToCond(RS, RS', T := T' /\ Cond, M) 13516 = applyMapsToTerm2(RS, RS', T, M) := applyMapsToTerm2(RS, RS', T', M) 13517 /\ applyMapsToCond(RS, RS', Cond, M) . 13518 eq applyMapsToCond(RS, RS', T => T' /\ Cond, M) 13519 = applyMapsToTerm2(RS, RS', T, M) => applyMapsToTerm2(RS, RS', T', M) 13520 /\ applyMapsToCond(RS, RS', Cond, M) . 13521 eq applyMapsToCond(RS, RS', nil, M) = nil . 13522 13523 eq applyMapsToLabel((label L to L'), L'') 13524 = if L == L'' 13525 then L' 13526 else L'' 13527 fi . 13528 eq applyMapsToLabel(((label L to L'), RS), L'') 13529 = if L == L'' 13530 then L' 13531 else applyMapsToLabel(RS, L'') 13532 fi . 13533 eq applyMapsToLabel(R, L) = L [owise] . 13534 eq applyMapsToLabel((R, RS), L) 13535 = applyMapsToLabel(RS, L) 13536 [owise] . 13537 eq applyMapsToLabel(none, L) = L . 13538 13539 eq applyMapsToClassDeclSet(RS, RS', class C | ADS . CDS) 13540 = (class applyMapsToClassName(RS, C) | applyMapsToAttrDeclSet(RS, RS', C, ADS) . 13541 applyMapsToClassDeclSet(RS, RS', CDS)) . 13542 eq applyMapsToClassDeclSet(RS, RS', none) = none . 13543 13544 eq applyMapsToAttrDeclSet(RS, RS', C, ((attr A : Ty), ADS)) 13545 = ((attr applyMapsToAttrName(RS', C, A) : applyMapsToType(RS, Ty)), 13546 applyMapsToAttrDeclSet(RS, RS', C, ADS)) . 13547 eq applyMapsToAttrDeclSet(RS, RS', C, none) = none . 13548 13549 eq applyMapsToAttrName((attr A . C to A'), C', A'') 13550 = if (C == C') and (A == A'') 13551 then A' 13552 else A'' 13553 fi . 13554 eq applyMapsToAttrName(((attr A . C to A'), RS), C', A'') 13555 = if (C == C') and (A == A'') 13556 then A' 13557 else applyMapsToAttrName(RS, C', A'') 13558 fi . 13559 eq applyMapsToAttrName(R, C, A) = A [owise] . 13560 eq applyMapsToAttrName((R, RS), C, A) 13561 = applyMapsToAttrName(RS, C, A) 13562 [owise] . 13563 eq applyMapsToAttrName(none, C, A) = A . 13564 13565 eq applyMapsToSubclassDeclSet(RS, subclass C < C' . SCDS) 13566 = (subclass applyMapsToClassName(RS, C) < applyMapsToClassName(RS, C') . 13567 applyMapsToSubclassDeclSet(RS, SCDS)) . 13568 eq applyMapsToSubclassDeclSet(RS, none) = none . 13569endfm 13570 13571******************************************************************************* 13572 13573*** 13574*** 6.9 Instantiation of Parameterized Modules and the 13575*** \texttt{META-LEVEL} Module Expression 13576 13577*** A parameterized module 13578*** $\texttt{M[L}_1\texttt{\ ::\ T}_1\texttt{,\}\ldots\texttt{, L}_n 13579*** \texttt{ :: T}_n\texttt{]}$, with \mbox{$\texttt{L}_1\ldots\texttt{L}_n$} 13580*** labels and \mbox{$\texttt{T}_1\ldots\texttt{T}_n$} theory identifiers, is 13581*** represented as a module with name \texttt{M} which contains parameter 13582*** declarations \mbox{$\texttt{par\ L}_i\texttt{\ ::\ T}_i$} for 13583*** $1\leq i\leq n$, and an importation declaration 13584*** \mbox{$\texttt{inc\ par\ L}_i\texttt{\ ::\ T}_i\texttt{\ .}$} for each 13585*** parameter \mbox{$\texttt{L}_i\texttt{\ ::\ T}_i$} in its interface. Note 13586*** that all modules are handled in a uniform way: nonparameterized modules 13587*** and theories have their list of parameters set to \texttt{nil}. 13588 13589*** The instantiation of the formal parameters of a parameterized module with 13590*** actual modules or theories requires a view from each formal parameter 13591*** theory to its corresponding actual unit. The process of instantiation 13592*** results in the replacement of each interface theory by its corresponding 13593*** actual parameter, using the views to bind actual names to formal names. 13594 13595*** The naming conventions for sorts have to be taken into account in the 13596*** instantiation process: every occurrence of a sort coming from a theory in 13597*** the interface of a module must be qualified by its theory's label, and 13598*** sorts defined in the body of a parameterized module can be parameterized 13599*** by the labels in the interface of the module (see 13600*** Section~\ref{parameterized-modules}). 13601 13602*** The labeling convention for theories and for the sorts coming from them is 13603*** very useful to avoid collisions of sort names coming from the parameter 13604*** theories, and also to allow different uses of the same theory several 13605*** times in the interface of a module. We assume that all sorts coming from 13606*** the theory part of the parameter theories are used in their qualified form 13607*** to manipulate the maps defined in the views before being applied to the 13608*** body of the module being instantiated. If the target of a view is a 13609*** theory, the sorts from the theory part of the target theory appearing in 13610*** the targTS of the maps in the view will be qualified as well, following 13611*** the same convention. 13612 13613*** When a parameterized module 13614*** $\texttt{M[L}_1\texttt{\ ::\ T}_1\texttt{,\ } 13615*** \ldots\texttt{,\ L}_n\texttt{\ ::\ T}_n\texttt{]}$ 13616*** is instantiated with views $\texttt{V}_1\ldots\texttt{V}_n$, each 13617*** parameterized sort $\texttt{S[L}_1\texttt{,}\ldots\texttt{,L}_n\texttt{]}$ 13618*** in the body of the parameterized module is renamed to 13619*** $\texttt{S[V}_1\texttt{,}\ldots\texttt{,V}_n\texttt{]}$. 13620 13621*** The discussion on the qualification of sorts in views before being used in 13622*** the instantiation process applies in a completely similar way to class 13623*** names in parameterized object-oriented modules. 13624 13625*** As we saw in Section~\ref{module-expressions}, it is possible to import a 13626*** module expression in which a parameterized module is instantiated by some 13627*** of the formal parameters of the parameterized module in which it is 13628*** imported. This is done by using the label of some of the parameters in the 13629*** interface of a module, say \mbox{$\texttt{L}_k\texttt{\ ::\ T}_k$}, in a 13630*** module expression in which some parameterized module \texttt{N} with formal 13631*** parameter $\texttt{T}_k$ is instantiated with $\texttt{L}_k$, that is, we 13632*** have the module expression $\texttt{N[}\ldots\texttt{L}_k\ldots\texttt{]}$. 13633*** In this case, $\texttt{L}_k$ is considered as the identity view for the 13634*** theory $\texttt{T}_k$ with $\texttt{L}_k$ as name. Note that to be able to 13635*** check whether a label in the interface of a module is used in an 13636*** instantiation of this form, in the evaluation of a module expression the 13637*** list of parameters of the module in which the module expression appears 13638*** must be available. This is the reason why the \texttt{evalModExp} function 13639*** was defined with \texttt{ParameterList} as one of the sorts in its 13640*** arity (see Section~\ref{evalModExp}). For module expressions appearing 13641*** outside of any module, that is, in commands, etc., this list will be set 13642*** to \texttt{nil}. 13643 13644*** Note that this kind of instantiation may produce a `cascade' effect. The 13645*** module being instantiated may itself import other module expressions in 13646*** which labels of some of its parameter theories are used in the 13647*** instantiation of some of these imported module expressions. This is handled 13648*** by `preparing' the module expressions appearing in the importation 13649*** declarations of the module (\texttt{prepImports}). This process 13650*** consists in changing the labels of the interface of the module being 13651*** instantiated which are used in the importations of module expressions by 13652*** the corresponding view names (\texttt{prepHeader}). After completing the 13653*** generation of the module resulting from the evaluation of the module 13654*** expression, this module will be evaluated with the \texttt{evalModule} 13655*** function, producing the evaluation of these new module expressions. In any 13656*** extension of the language, new equations for the function 13657*** \texttt{prepHeader} will have to be added for each new kind of module 13658*** expression being defined. 13659 13660*** In Sections~\ref{renaming} and~\ref{extension} we shall see how new 13661*** equations completing the semantics of \texttt{prepHeader} are added for 13662*** each new module expression being defined. In the case of the renaming 13663*** module expression, the renaming maps will have to be prepared as well, to 13664*** adjust the sort names being renamed to the conventions discussed above. 13665 13666*** As for any other module expression being defined, in addition to the 13667*** operator declaration for the constructor of the instantiation module 13668*** expression, equations completing the semantics of operators 13669*** \texttt{evalModExp}, \texttt{header2QidList}, and 13670*** \texttt{setUpModExpDeps} have to be given. 13671 13672fmod INST-EXPR-EVALUATION is 13673 pr EVALUATION . 13674 pr RENAMING-SET-APPL-ON-UNIT . 13675 inc MOD-EXPR . 13676 inc MOD-NAME . 13677 pr DATABASE . 13678 13679*** We start by giving the new constructor for sort \texttt{ModuleExpression}. 13680*** Note thatthe modules \texttt{MOD-EXPR} and \texttt{MOD-NAME} have been 13681*** imported in \texttt{including} mode. 13682 13683 vars QI QI' QI'' X Y W Z C F F' A A' L L' : Qid . 13684 var QIL : QidList . 13685 vars M M' PU U U' U'' DM : Module . 13686 var Th : OTheory . 13687 vars ME ME' ME'' : ModuleExpression . 13688 var H : Header . 13689 vars MN MN' : ModuleName . 13690 vars MNS MNS' MNS'' MNS3 MNS4 MNS5 : Set{ModuleName} . 13691 vars VE VE' VE'' VE3 VE4 : ViewExp . 13692 vars VES VES' : Set{ViewExp} . 13693 vars MIS MIS' : Set{ModuleInfo} . 13694 var VIS : Set{ViewInfo} . 13695 vars DB DB' DB'' : Database . 13696 var PD : ParameterDecl . 13697 vars PDL PDL' PDL'' PDL3 PDL4 PDL5 : ParameterDeclList . 13698 var PDS : Set{ParameterDecl} . 13699 vars PL PL' PL'' PL3 : ParameterList . 13700 vars S S' P P' P'' : Sort . 13701 vars IL IL' IL'' IL3 : ImportList . 13702 vars SMS SMS' SMS'' SMS3 : SortMappingSet . 13703 vars OMS OMS' OMS'' OMS3 : OpMappingSet . 13704 var V : Variable . 13705 var Ct : Constant . 13706 var SL : QidList . 13707 var Ty : Type . 13708 var TyL : TypeList . 13709 vars SS SS' SS'' : SortSet . 13710 var K : Kind . 13711 vars T T' O : Term . 13712 var DT : Default{Term} . 13713 var TL : TermList . 13714 var CDS : ClassDeclSet . 13715 var ADS : AttrDeclSet . 13716 var B : Bool . 13717 var AtS : AttrSet . 13718 var N : Nat . 13719 var PV : PreView . 13720 var VI : View . 13721 var VDS : OpDeclSet . 13722 vars RS RS' RS'' SRS SRS' ORS ORS' : RenamingSet . 13723 13724*** In the input given by the user, the operator \verb~_(_)~ is used both for 13725*** the instantiation of module expressions, and for expressions 13726*** parameterizing the module \texttt{META-LEVEL} with a list of module names. 13727*** The function \texttt{evalModExp} distinguishes these two cases, calling 13728*** the function \texttt{unitInst} in the former and the function 13729*** \texttt{prepMetalevel} in the latter. 13730 13731 op unitInst : Header ParameterList ParameterDeclList Database -> Database . 13732 op prepMetalevel : ParameterList Database -> Database . 13733 13734 eq evalModExp(ME{PL}, PDL, DB) 13735 = if unitInDb(ME{PL}, DB) 13736 then < DB ; ME{PL} > 13737 else if ME == 'META-LEVEL 13738 then < prepMetalevel(PL, DB) ; ME{PL} > 13739 else < unitInst( 13740 modExp(evalModExp(ME, PDL, evalViewExp(PL, PDL, DB))), 13741 PL, PDL, 13742 database(evalModExp(ME, PDL, evalViewExp(PL, PDL, DB)))) 13743 ; 13744 modExp(evalModExp(ME, PDL, evalViewExp(PL, PDL, DB))){PL} > 13745 fi 13746 fi . 13747 13748*** The function \texttt{prepMetalevel} creates a new module with the 13749*** module expression being evaluated as name, which imports the predefined 13750*** \texttt{META-LEVEL} module. For each module name \texttt{I} in the list 13751*** given as parameter of the expression, the declaration of a constant 13752*** \texttt{I} of sort \texttt{Module} and an equation identifying such 13753*** constant with the metarepresentation of the module with such name in the 13754*** database are added to the module being created. 13755 13756 op prepMetalevelAux : ParameterList Module Database -> Database . 13757 13758 eq prepMetalevel(PL, DB) 13759 = prepMetalevelAux(PL, 13760 addImports((including 'META-LEVEL .), 13761 setName(emptyFModule, 'META-LEVEL{PL})), DB) . 13762 13763 eq prepMetalevelAux((QI), U, DB) 13764 = prepMetalevelAux(nil, 13765 addOps((op qid("META-" + string(QI)) : nil -> 'Module [none] .), 13766 addEqs((eq qid("META-" + string(QI) + ".Module") 13767 = up(getFlatModule(QI, database(evalModExp(QI, DB)))) 13768 [none] .), 13769 U)), 13770 DB) . 13771 eq prepMetalevelAux((QI, PL), U, DB) 13772 = prepMetalevelAux(PL, 13773 addOps((op qid("META-" + string(QI)) : nil -> 'Module [none] .), 13774 addEqs((eq qid("META-" + string(QI) + ".Module") 13775 = up(getFlatModule(QI, database(evalModExp(QI, DB)))) 13776 [none] .), 13777 U)), 13778 DB) . 13779 eq prepMetalevelAux(nil, U, DB) = evalModule(U, none, DB) . 13780 13781*** The function \texttt{getClassNames} returns the set of the names of 13782*** the classes in a set of class declarations. 13783 13784 op getClassNames : ClassDeclSet -> SortSet . 13785 13786 eq getClassNames(((class S | ADS .) CDS)) 13787 = (S ; getClassNames(CDS)) . 13788 eq getClassNames(none) = none . 13789 13790*** The following `getTh' functions return the corresponding elements in the 13791*** theory part of the structure of the given unit. For example, the function 13792*** \texttt{getThSorts} returns the set of sorts declared in the ``loose 13793*** part'' of the structure of the unit in the database having the name 13794*** indicated as first argument. 13795 13796 op getThSorts : ModuleExpression Database -> SortSet . 13797 op getThClasses : ModuleExpression Database -> SortSet . 13798 op getThSortsAux : ImportList Database -> SortSet . 13799 op getThClassesAux : ImportList Database -> SortSet . 13800 13801 eq getThSorts(ME, DB) 13802 = if theory(getTopModule(ME, DB)) 13803 then (getThSortsAux(getImports(getTopModule(ME, DB)), DB) ; 13804 getSorts(getTopModule(ME, DB))) 13805 else none 13806 fi . 13807 13808 eq getThSortsAux(((including MN .) IL), DB) 13809 = (getThSorts(MN, DB) ; getThSortsAux(IL, DB)) . 13810 eq getThSortsAux(((extending MN .) IL), DB) 13811 = (getThSorts(MN, DB) ; getThSortsAux(IL, DB)) . 13812 eq getThSortsAux(((protecting MN .) IL), DB) 13813 = (getThSorts(MN, DB) ; getThSortsAux(IL, DB)) . 13814 eq getThSortsAux(nil, DB) = none . 13815 13816 eq getThClasses(ME, DB) 13817 = if getTopModule(ME, DB) :: OTheory 13818 and-then not getTopModule(ME, DB) :: STheory 13819 then (getThClassesAux(getImports(getTopModule(ME, DB)), DB) ; 13820 getClassNames(getClasses(getTopModule(ME, DB)))) 13821 else none 13822 fi . 13823 13824 eq getThClassesAux(((including MN .) IL), DB) 13825 = (getThClasses(MN, DB) ; getThClassesAux(IL, DB)) . 13826 eq getThClassesAux(((extending MN .) IL), DB) 13827 = (getThClasses(MN, DB) ; getThClassesAux(IL, DB)) . 13828 eq getThClassesAux(((protecting MN .) IL), DB) 13829 = (getThClasses(MN, DB) ; getThClassesAux(IL, DB)) . 13830 eq getThClassesAux(nil, DB) = none . 13831 13832*** The `get' functions return the corresponding elements in the structure of 13833*** the given unit. For example, \texttt{getSortSet} returns all the sorts 13834*** declared in the structure of the unit in the database having the name 13835*** given as first argument. 13836 13837 op getSortSet : ModuleName Database -> SortSet . 13838 op getClassSet : ModuleName Database -> SortSet . 13839 13840 op getSortSetAux : ImportList Database -> SortSet . 13841 op getClassSetAux : ImportList Database -> SortSet . 13842 13843 eq getSortSet(MN, DB) 13844 = (getSortSetAux(getImports(getTopModule(MN, DB)), DB) ; 13845 getSorts(getTopModule(MN, DB))) . 13846 13847 eq getSortSetAux(((including MN .) IL), DB) 13848 = (getSortSet(MN, DB) ; getSortSetAux(IL, DB)) . 13849 eq getSortSetAux(((extending MN .) IL), DB) 13850 = (getSortSet(MN, DB) ; getSortSetAux(IL, DB)) . 13851 eq getSortSetAux(((protecting MN .) IL), DB) 13852 = (getSortSet(MN, DB) ; getSortSetAux(IL, DB)) . 13853 eq getSortSetAux(nil, DB) = none . 13854 13855 eq getClassSet(MN, DB) 13856 = (getClassSetAux(getImports(getTopModule(MN, DB)), DB) ; 13857 getClassNames(getClasses(getTopModule(MN, DB)))) . 13858 13859 eq getClassSetAux(((including MN .) IL), DB) 13860 = (getClassSet(MN, DB) ; getClassSetAux(IL, DB)) . 13861 eq getClassSetAux(((extending MN .) IL), DB) 13862 = (getClassSet(MN, DB) ; getClassSetAux(IL, DB)) . 13863 eq getClassSetAux(((protecting MN .) IL), DB) 13864 = (getClassSet(MN, DB) ; getClassSetAux(IL, DB)) . 13865 eq getClassSetAux(nil, DB) = none . 13866 13867*** As pointed out in Section~\ref{parameterized-modules}, in a parameterized 13868*** module all occurrences of sorts or classes coming from the parameter 13869*** theories have to be qualified. \texttt{createCopy} is the function used 13870*** for creating these renamed copies of the parameters. As also explained in 13871*** Section~\ref{parameterized-modules}, if a parameter theory is structured, 13872*** the renaming is carried out not only at the top level, but for the entire 13873*** ``theory part'' in the structure. 13874 13875*** The function \texttt{createCopy} calls an auxiliary function, 13876*** \texttt{prepPar}, which recursively proceeds through all the subtheories 13877*** of the given theory. For each theory in the structure, the required set of 13878*** maps is generated and applied to such a theory using the 13879*** \texttt{applyMapsToModule} function discussed in 13880*** Section~\ref{applyMapsToModule}, which is then evaluated and entered into 13881*** the database. Note that the renamings to which a theory is subjected must 13882*** also be applied to the theories importing it. The new database and the 13883*** renaming maps applied to the theory will have to be returned by the 13884*** function. 13885 13886*** The function \texttt{prepPar} makes a copy of the theory specified by the 13887*** name given as first argument and of all its subtheories (only theories, no 13888*** modules), and qualifies all the sorts appearing in it with the label given 13889*** in the declaration of the parameter, which is given as second argument. 13890 13891 pr 2TUPLE{ViewExp,ViewExp} 13892 * (op ((_,_)) to <_;_>, 13893 op p1_ to 1st, 13894 op p2_ to 2nd). 13895 13896 sorts ---- Tuple{ViewExp,ViewExp} 13897 Set{Tuple{ViewExp,ViewExp}} 13898 prepParResult . 13899 subsort Tuple{ViewExp,ViewExp} < Set{Tuple{ViewExp,ViewExp}} . 13900---- op <_;_> : ViewExp ViewExp -> Tuple{ViewExp,ViewExp} . 13901---- ops 1st 2nd : Tuple{ViewExp,ViewExp} -> ViewExp . 13902 op none : -> Set{Tuple{ViewExp,ViewExp}} . 13903 op __ : Set{Tuple{ViewExp,ViewExp}} Set{Tuple{ViewExp,ViewExp}} 13904 -> Set{Tuple{ViewExp,ViewExp}} [assoc comm id: none] . 13905 13906 vars VEPS VEPS' : Set{Tuple{ViewExp,ViewExp}} . 13907 13908---- eq 1st(< VE ; VE' >) = VE . 13909---- eq 2nd(< VE ; VE' >) = VE' . 13910 13911 op prepPar : Qid Qid ModuleExpression Database -> prepParResult . 13912 op prepParImports : ImportList ImportList Qid Qid SortMappingSet OpMappingSet 13913 Set{Tuple{ViewExp,ViewExp}} ParameterDeclList Database -> prepParResult . 13914 13915 op <_;_;_;_;_;_;_;_> : SortMappingSet OpMappingSet Database ViewExp ViewExp Set{Tuple{ViewExp,ViewExp}} Bool ImportList -> prepParResult . 13916 op sortMappingSet : prepParResult -> SortMappingSet . 13917 op opMappingSet : prepParResult -> OpMappingSet . 13918 op database : prepParResult -> Database . 13919 op sourceViewExp : prepParResult -> ViewExp . 13920 op targetViewExp : prepParResult -> ViewExp . 13921 op viewExpPairSet : prepParResult -> Set{Tuple{ViewExp,ViewExp}} . 13922 op theoryFlag : prepParResult -> Bool . 13923 op getImports : prepParResult -> ImportList . 13924 eq opMappingSet(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = OMS . 13925 eq sortMappingSet(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = SMS . 13926 eq database(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = DB . 13927 eq sourceViewExp(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = VE . 13928 eq targetViewExp(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = VE' . 13929 eq viewExpPairSet(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = VEPS . 13930 eq theoryFlag(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = B . 13931 eq getImports(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = IL . 13932 13933 ----op createCopy : ParameterDecl Database -> Database . 13934 op prepPar : Qid ModuleExpression Database -> prepParResult . 13935 op prepParImports : ImportList ImportList Qid SortMappingSet OpMappingSet 13936 Set{Tuple{ViewExp,ViewExp}} ParameterDeclList Database -> prepParResult . 13937 13938 eq createCopy(X :: ME, DB) 13939 = if unitInDb(pd(X :: ME), DB) 13940 then DB 13941 else database(prepPar(X, ME, database(evalModExp(ME, DB)))) 13942 fi . 13943 13944 ceq prepPar(X, ME, DB) 13945 = < SMS' ; 13946 OMS ; 13947 (if unitInDb(pd(X :: ME), DB) 13948 then DB 13949 else evalModule( 13950 setImports( 13951 setName( 13952 applyMapsToModule(maps2rens(SMS'), maps2rens(OMS), Th, getFlatModule(ME, DB)), 13953 pd(X :: ME)), 13954 IL), 13955 applyMapsToOps(maps2rens(SMS'), maps2rens(OMS), getVars(ME, DB), getFlatModule(ME, DB)), 13956 DB') 13957 fi) ; 13958 mtViewExp ; mtViewExp ; none ; true ; nil > 13959 if Th := getTopModule(ME, DB) 13960 /\ < SMS ; OMS ; DB' ; VE ; VE' ; VEPS ; B ; IL > := prepParImports(getImports(Th), nil, X, none, none, none, X :: ME, DB) 13961 /\ SMS' := (SMS 13962 sortMapsPar(X, getSorts(Th), none) 13963 classMapsPar(X, classSet(getClasses(Th)), none)) . 13964 eq prepPar(X, ME, DB) 13965 = < none ; none ; warning(DB, '\r 'Error: '\o 'Incorrect 'parameter '\n) ; 13966 mtViewExp ; mtViewExp ; none ; false ; nil > 13967 [owise] . 13968 13969 ceq prepParImports(((including ME .) IL), IL', X, SMS, OMS, VEPS, PDL, DB) 13970 = if B 13971 then prepParImports(IL, (IL' (including pd(X :: ME') .)), X, (SMS SMS'), (OMS OMS'), VEPS, PDL, DB') 13972 else prepParImports(IL, (IL' (including ME .)), X, SMS, OMS, VEPS, PDL, DB) 13973 fi 13974 if ME' := prepModExp(ME, VEPS) 13975 /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) . 13976 ceq prepParImports(((extending ME .) IL), IL', X, SMS, OMS, VEPS, PDL, DB) 13977 = if B 13978 then *** A theory shouldn't be imported in protecting mode 13979 prepParImports(IL, (IL' (extending pd(X :: ME') .)), X, (SMS SMS'), (OMS OMS'), VEPS, PDL, DB') 13980 else prepParImports(IL, (IL' (extending ME .)), X, SMS, OMS, VEPS, PDL, DB) 13981 fi 13982 if ME' := prepModExp(ME, VEPS) 13983 /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) . 13984 ceq prepParImports(((protecting ME .) IL), IL', X, SMS, OMS, VEPS, PDL, DB) 13985 = if B 13986 then *** A theory shouldn't be imported in protecting mode 13987 prepParImports(IL, (IL' (protecting pd(X :: ME') .)), X, (SMS SMS'), (OMS OMS'), VEPS, PDL, DB') 13988 else prepParImports(IL, (IL' (protecting ME .)), X, SMS, OMS, VEPS, PDL, DB) 13989 fi 13990 if ME' := prepModExp(ME, VEPS) 13991 /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) . 13992 ceq prepParImports(((including pd(X :: ME) .) IL), IL', Y, SMS, OMS, (< X ; Z > VEPS), PDL, DB) 13993 = prepParImports(IL, (IL' (including pd(Z :: ME') .)), Y, (SMS SMS'), (OMS OMS'), (< X ; Z > VEPS), PDL, DB') 13994 if ME' := prepModExp(ME, VEPS) 13995 /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) . 13996 ceq prepParImports(((extending pd(X :: ME) .) IL), IL', Y, SMS, OMS, (< X ; Z > VEPS), PDL, DB) 13997 = prepParImports(IL, (IL' (extending pd(Z :: ME') .)), Y, (SMS SMS'), (OMS OMS'), (< X ; Z > VEPS), PDL, DB') 13998 if ME' := prepModExp(ME, VEPS) 13999 /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) . 14000 ceq prepParImports(((protecting pd(X :: ME) .) IL), IL', Y, SMS, OMS, (< X ; Z > VEPS), PDL, DB) 14001 = prepParImports(IL, (IL' (protecting pd(Z :: ME') .)), Y, (SMS SMS'), (OMS OMS'), (< X ; Z > VEPS), PDL, DB') 14002 if ME' := prepModExp(ME, VEPS) 14003 /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) . 14004 eq prepParImports(nil, IL, X, SMS, OMS, VEPS, PDL, DB) 14005 = < SMS ; OMS ; DB ; mtViewExp ; mtViewExp ; none ; false ; IL > . 14006 14007 ceq prepPar(X, Y, ME, DB) 14008 = (< SMS' ; OMS ; 14009 (if unitInDb(pd(Y :: ME), DB) 14010 then DB 14011 else evalModule( 14012 setImports( 14013 setName( 14014 applyMapsToModule(maps2rens(SMS'), maps2rens(OMS), getTopModule(pd(X :: ME), DB), getFlatModule(pd(X :: ME), DB)), 14015 pd(Y :: ME)), 14016 IL), 14017 applyMapsToOps(maps2rens(SMS'), maps2rens(OMS), getVars(pd(X :: ME), DB), getFlatModule(pd(X :: ME), DB)), 14018 DB') 14019 fi) ; 14020 X ; Y ; < X ; Y > ; true ; nil >) 14021 if Th := getTopModule(ME, DB) 14022 /\ (< SMS ; OMS ; DB' ; VE ; VE' ; VEPS ; B ; IL >) := prepParImports(getImports(Th), nil, X, Y, none, none, < X ; Y >, X :: ME, DB) 14023 /\ SMS' := (SMS 14024 genMapsQualSorts(X, Y, getSorts(Th), none) 14025 genMapsQualClasses(X, Y, classSet(getClasses(Th)), none)) . 14026 14027 eq prepParImports(((including ME .) IL), IL', X, Y, SMS, OMS, VEPS, PDL, DB) 14028 = prepParImports(IL, (IL' including ME .), X, Y, SMS, OMS, VEPS, PDL, DB) . 14029 eq prepParImports(((extending ME .) IL), IL', X, Y, SMS, OMS, VEPS, PDL, DB) 14030 = prepParImports(IL, (IL' extending ME .), X, Y, SMS, OMS, VEPS, PDL, DB) . 14031 eq prepParImports(((protecting ME .) IL), IL', X, Y, SMS, OMS, VEPS, PDL, DB) 14032 = prepParImports(IL, (IL' protecting ME .), X, Y, SMS, OMS, VEPS, PDL, DB) . 14033 ceq prepParImports(including pd(X :: ME) . IL, IL', Y, Z, SMS, OMS, VEPS, PDL, DB) 14034 = prepParImports(IL, IL' including pd(X :: ME') ., Y, Z, (SMS SMS'), (OMS OMS'), VEPS, PDL, DB') 14035 if ME' := prepModExp(ME, VEPS) 14036 /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(Y, Z, ME', database(evalModExp(ME', PDL, DB))) . 14037 ceq prepParImports(extending pd(X :: ME) . IL, IL', Y, Z, SMS, OMS, VEPS, PDL, DB) 14038 = prepParImports(IL, IL' extending pd(X :: ME') ., Y, Z, (SMS SMS'), (OMS OMS'), VEPS, PDL, DB') 14039 if ME' := prepModExp(ME, VEPS) 14040 /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(Y, Z, ME', database(evalModExp(ME', PDL, DB))) . 14041 ceq prepParImports(protecting pd(X :: ME) . IL, IL', Y, Z, SMS, OMS, VEPS, PDL, DB) 14042 = prepParImports(IL, IL' protecting pd(X :: ME') ., Y, Z, (SMS SMS'), (OMS OMS'), VEPS, PDL, DB') 14043 if ME' := prepModExp(ME, VEPS) 14044 /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(Y, Z, ME', database(evalModExp(ME', PDL, DB))) . 14045 eq prepParImports(nil, IL, X, Y, SMS, OMS, VEPS, PDL, DB) 14046 = < SMS ; OMS ; DB ; mtViewExp ; mtViewExp ; none ; false ; IL > . 14047 14048 op sortMapsPar : Qid SortSet Set{Tuple{ViewExp,ViewExp}} -> SortMappingSet . 14049 op classMapsPar : Qid SortSet Set{Tuple{ViewExp,ViewExp}} -> SortMappingSet . 14050 14051 op qualify : Qid Sort -> Sort . 14052 op qualify : Qid Sort Set{Tuple{ViewExp,ViewExp}} -> Sort . 14053 op qualify : Qid Sort ParameterList ParameterList Set{Tuple{ViewExp,ViewExp}} -> Sort . 14054 14055 eq qualify(X, S) = qualify(X, getName(S), getPars(S), empty, none) . 14056 14057 eq qualify(X, S, VEPS) = qualify(X, getName(S), getPars(S), empty, VEPS) . 14058 14059 eq qualify(X, S, (P, PL), PL', < P ; P' > VEPS) 14060 = qualify(X, S, PL, PL' P', < P ; P' > VEPS) . 14061 eq qualify(X, S, (P, PL), PL', VEPS) 14062 = qualify(X, S, PL, PL' P, VEPS) 14063 [owise] . 14064 eq qualify(X, S, empty, PL, VEPS) 14065 = qid(string(X) + "$" + string(makeSort(S, PL))) . 14066 14067 eq sortMapsPar(X, (S ; SS), VEPS) 14068 = (sort S to qualify(X, S, VEPS) . sortMapsPar(X, SS, VEPS)) . 14069 eq sortMapsPar(X, none, VEPS) = none . 14070 14071 eq classMapsPar(X, (S ; SS), VEPS) 14072 = (class S to qualify(X, S, VEPS) . classMapsPar(X, SS, VEPS)) . 14073 eq classMapsPar(X, none, VEPS) = none . 14074 14075*** When one of the labels of the interface of a module is being used in a 14076*** module expression to instantiate some formal parameter of a module, then, 14077*** in the evaluation of such module expression the qualification of all sorts 14078*** and class names coming from the theory part of the parameter theory have 14079*** to be changed according to such a label. In the evaluation of an 14080*** instantiation module expression this is done by generating the 14081*** corresponding renaming maps, which are then applied to the module being 14082*** instantiated. Given labels \texttt{L} and \texttt{L'}, for each sort or 14083*** class name \texttt{S} in the set given as argument, a map of the form 14084*** \verb~L$S to L'$S~ is generated. 14085 14086 op genMapsQualSorts : Qid Qid SortSet Set{Tuple{ViewExp,ViewExp}} -> SortMappingSet . 14087 op genMapsQualClasses : Qid Qid SortSet Set{Tuple{ViewExp,ViewExp}} -> SortMappingSet . 14088 14089 eq genMapsQualSorts(X, Y, (S ; SS), VEPS) 14090 = (sort qualify(X, S, VEPS) to qualify(Y, S, VEPS) . 14091 genMapsQualSorts(X, Y, SS, VEPS)) . 14092 eq genMapsQualSorts(X, Y, none, VEPS) = none . 14093 14094 eq genMapsQualClasses(X, Y, (S ; SS), VEPS) 14095 = (class qualify(X, S, VEPS) to qualify(Y, S, VEPS) . 14096 genMapsQualClasses(X, Y, SS, VEPS)) . 14097 eq genMapsQualClasses(X, Y, none, VEPS) = none . 14098 14099*** The function \texttt{prepare} takes the map set of a view and 14100*** prepares it to be used in an instantiation by transforming sort and class 14101*** names into their qualified form, if required (sorts and class names in a 14102*** view have to be qualified only if they were defined in a theory). 14103 14104*** The \texttt{prepare} function takes six arguments: The sets of maps 14105*** to be prepared, the label with which the sorts to be renamed have to be 14106*** qualified, the set of sorts in the theory part of the source of the view, 14107*** and the set of sorts and class names in the theory part of the target of 14108*** the view. 14109 14110*** Note that we assume that there is a sort map and a class map for each sort 14111*** and class in the theory part of the source of the view. Therefore, sorts 14112*** and class names appearing as sources of sort and class maps are 14113*** systematically qualified. The sorts or class names used in the targets of 14114*** the maps will be qualified only if they were declared in a theory. In maps 14115*** for operators in which the arity and coarity are specified, or for those 14116*** going to derived terms, the sorts appearing in the arity or coarity of an 14117*** operator and those used to qualify terms, or in sort tests in terms, must 14118*** also be qualified. However, in these cases the qualification cannot be 14119*** done on all sorts, but only on those defined in the theory parts. This is 14120*** the reason why the sets of sorts in the theory parts of the source and 14121*** target and the set of class names in the target of the view are given when 14122*** calling \texttt{prepare}. 14123 14124 op prepare : SortMappingSet Qid SortSet SortSet SortSet -> SortMappingSet . 14125 op prepare : OpMappingSet Qid SortSet SortSet SortSet -> OpMappingSet . 14126 14127 op prepare : TypeList Qid SortSet -> TypeList . 14128 op prepTerm : TermList Qid SortSet -> TermList . 14129 14130 eq prepare(sort S to S' . SMS, X, SS, SS', SS'') 14131 = (if S' in SS' 14132 then sort qualify(X, S) to qualify(X, S') . 14133 else sort qualify(X, S) to S' . 14134 fi 14135 prepare(SMS, X, SS, SS', SS'')) . 14136 eq prepare(class S to S' . SMS, X, SS, SS', SS'') 14137 = (if S' in SS'' 14138 then (class qualify(X, S) to qualify(X, S') .) 14139 else (class qualify(X, S) to S' .) 14140 fi 14141 prepare(SMS, X, SS, SS', SS'')) . 14142 eq prepare((none).SortMappingSet, X, SS, SS', SS'') = none . 14143 14144 eq prepare(op F to F' . OMS, X, SS, SS', SS'') 14145 = (op F to F' . 14146 prepare(OMS, X, SS, SS', SS'')) . 14147 eq prepare(op F : TyL -> Ty to F' . OMS, X, SS, SS', SS'') 14148 = (op F : prepare(TyL, X, SS) -> prepare(Ty, X, SS) to F' . 14149 prepare(OMS, X, SS, SS', SS'')) . 14150 eq prepare(op T to term T' . OMS, X, SS, SS', SS'') 14151 = (op prepTerm(T, X, SS) to term prepTerm(T', X, SS') . 14152 prepare(OMS, X, SS, SS', SS'')) . 14153 eq prepare(msg F to F' . OMS, X, SS, SS', SS'') 14154 = (msg F to F' . 14155 prepare(OMS, X, SS, SS', SS'')) . 14156 eq prepare(msg F : TyL -> Ty to F' . OMS, X, SS, SS', SS'') 14157 = (msg F : prepare(TyL, X, SS) -> prepare(Ty, X, SS) to F' . 14158 prepare(OMS, X, SS, SS', SS'')) . 14159 eq prepare(attr A . S to A' . OMS, X, SS, SS', SS'') 14160 = (attr A . qualify(X, S) to A' . 14161 prepare(OMS, X, SS, SS', SS'')) . 14162 eq prepare((none).OpMappingSet, X, SS, SS', SS'') = none . 14163 14164 eq prepare((S TyL), X, (S ; SS)) = (qualify(X, S) prepare(TyL, X, (S ; SS))) . 14165 eq prepare((K TyL), X, SS) = prepare((getSort(K) TyL), X, SS) . 14166 eq prepare((S TyL), X, SS) = (S prepare(TyL, X, SS)) [owise] . 14167 eq prepare(nil, X, SS) = nil . 14168 14169 eq prepTerm(F[TL], X, SS) = F[prepTerm(TL, X, SS)] . 14170 eq prepTerm(V, X, SS) 14171 = if getType(V) in SS 14172 then qid(string(getName(V)) + ":" + string(qualify(X, getType(V)))) 14173 else qid(string(getName(V)) + ":" + string(getType(V))) 14174 fi . 14175 eq prepTerm(Ct, X, SS) 14176 = if getType(Ct) in SS 14177 then qid(string(getName(Ct)) + "." + string(qualify(X, getType(Ct)))) 14178 else qid(string(getName(Ct)) + "." + string(getType(Ct))) 14179 fi . 14180 ceq prepTerm((T, TL), X, SS) 14181 = (prepTerm(T, X, SS), prepTerm(TL, X, SS)) 14182 if TL =/= empty . 14183 eq prepTerm(qidError(QIL), X, SS) = qidError(QIL) . 14184 14185*** For each parameterized sort 14186*** $\texttt{S[L}_1\texttt{,}\ldots\texttt{,L}_n\texttt{]}$ in the 14187*** body of a parameterized module with 14188*** $\texttt{L}_1\ldots\texttt{L}_n$ the labels of the parameters in 14189*** the interface of the module, a map of the form 9 14190*** $\texttt{sort\ S[L}_1\texttt{,}\ldots\texttt{,L}_n\texttt{]\ 14191*** to\ S[V}_1\texttt{,}\ldots\texttt{,V}_n\texttt{]}$ 14192*** is generated, where $\texttt{V}_i$ is the name of the view associated to 14193*** the label $\texttt{L}_i$ in the set of pairs given as argument. 14194 14195 op genMapsSorts : SortSet Set{Tuple{ViewExp,ViewExp}} -> SortMappingSet . 14196 op genMapsClasses : SortSet Set{Tuple{ViewExp,ViewExp}} -> SortMappingSet . 14197 14198 op prepSort : Sort Set{Tuple{ViewExp,ViewExp}} -> Sort . 14199 op prepSort : Sort ParameterList ParameterList Set{Tuple{ViewExp,ViewExp}} -> Sort . 14200 14201 eq genMapsSorts((S ; SS), VEPS) 14202 = (if prepSort(S, VEPS) == S 14203 then none 14204 else (sort S to prepSort(S, VEPS) .) 14205 fi) 14206 genMapsSorts(SS, VEPS) . 14207 eq genMapsSorts(none, VEPS) = none . 14208 14209 eq genMapsClasses((S ; SS), VEPS) 14210 = (if prepSort(S, VEPS) == S 14211 then none 14212 else (class S to prepSort(S, VEPS) .) 14213 fi) 14214 genMapsClasses(SS, VEPS) . 14215 eq genMapsClasses(none, VEPS) = none . 14216 14217 eq prepSort(S, VEPS) = prepSort(getName(S), empty, getPars(S), VEPS) . 14218 eq prepSort(Ty, VEPS) = Ty [owise] . 14219 14220 eq prepSort(S, PL, P, < P ; VE > VEPS) 14221 = prepSort(S, (PL, VE), empty, < P ; VE > VEPS) . 14222 eq prepSort(S, PL, (P, PL'), < P ; VE > VEPS) 14223 = prepSort(S, (PL, VE), PL', < P ; VE > VEPS) . 14224 eq prepSort(S, PL, P, VEPS) 14225 = prepSort(S, (PL, prepSort(P, VEPS)), empty, VEPS) 14226 [owise] . 14227 eq prepSort(S, PL, (P, PL'), VEPS) 14228 = prepSort(S, (PL, prepSort(P, VEPS)), PL', VEPS) 14229 [owise] . 14230 eq prepSort(S, PL, empty, VEPS) 14231 = if getPars(S) == empty 14232 then makeSort(S, PL) 14233 else makeSort(prepSort(S, VEPS), PL) 14234 fi . 14235 14236*** The function \texttt{prepImports} takes a list of importation 14237*** declarations and a set of pairs composed of a label and a view name, and 14238*** returns the list of importations resulting from changing in each of the 14239*** module expressions the occurrences of the labels of the interface of the 14240*** module being instantiated by the names of the views associated to them in 14241*** the list of pairs. 14242 14243 op prepImports : ImportList Set{Tuple{ViewExp,ViewExp}} -> ImportList . 14244 14245 op prepModExp : 14246 ModuleExpression Set{Tuple{ViewExp,ViewExp}} -> ModuleExpression . 14247 op prepModExp : ModuleExpression ViewExp ViewExp ViewExp 14248 Set{Tuple{ViewExp,ViewExp}} -> ModuleExpression . 14249 op prepParameterDecl : 14250 ParameterDecl Set{Tuple{ViewExp,ViewExp}} -> ParameterDecl . 14251 op prepViewExp : ViewExp Set{Tuple{ViewExp,ViewExp}} -> ViewExp . 14252 op prepViewExp : ParameterList Set{Tuple{ViewExp,ViewExp}} -> ParameterList . 14253 14254 eq prepImports(((including ME .) IL), VEPS) 14255 = (including prepModExp(ME, VEPS) .) 14256 prepImports(IL, VEPS) . 14257 eq prepImports(((including pd(PD) .) IL), VEPS) 14258 = (including pd(prepParameterDecl(PD, VEPS)) .) 14259 prepImports(IL, VEPS) . 14260 eq prepImports(((extending ME .) IL), VEPS) 14261 = (extending prepModExp(ME, VEPS) .) 14262 prepImports(IL, VEPS) . 14263 eq prepImports(((extending pd(PD) .) IL), VEPS) 14264 = (extending pd(prepParameterDecl(PD, VEPS)) .) 14265 prepImports(IL, VEPS) . 14266 eq prepImports(((protecting ME .) IL), VEPS) 14267 = (protecting prepModExp(ME, VEPS) .) 14268 prepImports(IL, VEPS) . 14269 eq prepImports(((protecting pd(PD) .) IL), VEPS) 14270 = (protecting pd(prepParameterDecl(PD, VEPS)) .) 14271 prepImports(IL, VEPS) . 14272 eq prepImports(nil, VEPS) = nil . 14273 14274 eq prepModExp(QI, VEPS) = QI . 14275 eq prepModExp(ME{PL}, VEPS) = prepModExp(ME, empty, empty, PL, VEPS) . 14276 eq prepModExp(ME + ME', VEPS) 14277 = prepModExp(ME, VEPS) + prepModExp(ME', VEPS) . 14278 eq prepModExp(ME, VEPS) = ME [owise] . 14279 14280 eq prepModExp(ME, PL, PL', (P, PL''), < P ; S > VEPS) 14281 = prepModExp(ME, (PL, S), PL', PL'', < P ; S > VEPS) . 14282 eq prepModExp(ME, PL, PL', (P, PL''), < P ; S{PL3} > VEPS) 14283 = prepModExp(ME, (PL, S{PL3}), PL', PL'', < P ; S{PL3} > VEPS) . 14284 ceq prepModExp(ME, PL, PL', (P, PL''), < P ; P' ;; VE > VEPS) 14285 = prepModExp(ME, (PL, P'), (PL', VE), PL'', < P ; P' ;; VE > VEPS) 14286 if VE =/= mtViewExp . 14287 eq prepModExp(ME, PL, PL', (P, PL''), VEPS) 14288 = prepModExp(ME, (PL, P), PL', PL'', VEPS) 14289 [owise] . 14290 eq prepModExp(ME, PL, PL', (QI{PL''}, PL3), VEPS) 14291 = prepModExp(ME, (PL, prepViewExp(QI{PL''}, VEPS)), PL', PL3, VEPS) . 14292 eq prepModExp(ME, PL, empty, empty, VEPS) = ME{PL} . 14293 eq prepModExp(ME, PL, PL', empty, VEPS) = ME{PL}{PL'} [owise] . 14294 14295 eq prepParameterDecl(X :: ME, < Y ; Z > VEPS) 14296 = if X == Y 14297 then (Z :: ME) 14298 else prepParameterDecl(X :: ME, VEPS) 14299 fi . 14300 eq prepParameterDecl(X :: ME, none) = X :: ME . 14301 14302 eq prepViewExp(VE, < VE ; VE' > VEPS) = VE' . 14303 eq prepViewExp(QI, VEPS) = QI [owise] . 14304 eq prepViewExp(X{PL}, VEPS) = X{prepViewExp(PL, VEPS)} [owise] . 14305 ceq prepViewExp((VE, PL), VEPS) 14306 = prepViewExp(VE, VEPS), prepViewExp(PL, VEPS) 14307 if VE =/= nil /\ PL =/= nil [owise] . 14308 14309*** The function \texttt{unitInst} calls the auxiliary function 14310*** \texttt{unitInstAux}, which proceeds recursively on each of the parameters 14311*** in the interface of the module being instantiated. For each view, a set of 14312*** maps to be applied to the module is generated, which are accumulated in 14313*** the third argument of the function. 14314 14315*** In the base case, when there are no more parameters and no more views, the 14316*** maps for the parameterized sorts are also generated, and all maps are 14317*** then applied. 14318 14319*** \texttt{unitInstAux} proceeds accumulating also the list of parameters 14320*** being modified, the list of importations, and a list of label-view 14321*** pairs (\texttt{QidTuple{ViewExp,ViewExp}}) associating each label in 14322*** the interface to the view used in the instantiation of the theory with 14323*** such label. This list of pairs is used to generate the set of maps of the 14324*** parameterized sorts and to `prepare' the list of importations as 14325*** indicated above. 14326 14327 sort TreatParResult . 14328 14329 op <_;_;_;_;_;_> : SortMappingSet OpMappingSet ParameterDeclList ImportList 14330 Set{Tuple{ViewExp,ViewExp}} Database -> TreatParResult . 14331 op getSortMappings : TreatParResult -> SortMappingSet . 14332 op getOpMappings : TreatParResult -> OpMappingSet . 14333 op getPars : TreatParResult -> ParameterDeclList . 14334 op getImports : TreatParResult -> ImportList . 14335 op viewExpPairSet : TreatParResult -> Set{Tuple{ViewExp,ViewExp}} . 14336 op db : TreatParResult -> Database . 14337 14338 eq getSortMappings(< SMS ; OMS ; PDL ; IL ; VEPS ; DB >) = SMS . 14339 eq getOpMappings(< SMS ; OMS ; PDL ; IL ; VEPS ; DB >) = OMS . 14340 eq getPars(< SMS ; OMS ; PDL ; IL ; VEPS ; DB >) = PDL . 14341 eq getImports(< SMS ; OMS ; PDL ; IL ; VEPS ; DB >) = IL . 14342 eq viewExpPairSet(< SMS ; OMS ; PDL ; IL ; VEPS ; DB >) = VEPS . 14343 eq db(< SMS ; OMS ; PDL ; IL ; VEPS ; DB >) = DB . 14344 14345 op unitInstAux : Module Module OpDeclSet SortMappingSet OpMappingSet ParameterDeclList 14346 ParameterDeclList ImportList ImportList ParameterList 14347 Set{Tuple{ViewExp,ViewExp}} ParameterDeclList Database 14348 -> Database . 14349 op treatPar : ParameterDecl ViewExp Set{Tuple{ViewExp,ViewExp}} 14350 ParameterDeclList Database -> TreatParResult . 14351 op treatPar2 : ParameterDecl ViewExp Set{Tuple{ViewExp,ViewExp}} 14352 ParameterDeclList Database -> TreatParResult . 14353 op treatParAux : Qid ModuleExpression ParameterDeclList ViewExp Qid ViewExp 14354 ViewExp ParameterDeclList SortMappingSet OpMappingSet ParameterDeclList 14355 ImportList Set{Tuple{ViewExp,ViewExp}} Database 14356 -> TreatParResult . 14357 op treatParAux2 : Qid ModuleExpression ParameterDeclList ViewExp Qid ViewExp 14358 ViewExp ParameterDeclList SortMappingSet OpMappingSet ParameterDeclList ImportList 14359 Set{Tuple{ViewExp,ViewExp}} Database -> TreatParResult . 14360 14361 eq unitInst(ME, PL, PDL, DB) 14362 = unitInstAux(setName(getTopModule(ME, DB), ME{PL}), 14363 signature(getFlatModule(ME, DB)), getVars(ME, DB), none, none, 14364 getPars(getTopModule(ME, DB)), nil, 14365 getImports(getTopModule(ME, DB)), nil, PL, none, PDL, DB) . 14366 14367 ceq unitInstAux(U, M, VDS, SMS, OMS, (X :: ME, PDL), PDL', IL, IL'', (QI, PL), VEPS, PDL'', DB) 14368 = unitInstAux(U, M, VDS, (SMS SMS'), (OMS OMS'), PDL, (PDL', PDL3), IL, (IL'' IL3), PL, (VEPS VEPS'), PDL'', DB') 14369 if < SMS' ; OMS' ; PDL3 ; IL3 ; VEPS' ; DB' > := treatPar(X :: ME, QI, VEPS, PDL'', DB) . 14370 ceq unitInstAux(U, M, VDS, SMS, OMS, (X :: ME, PDL), PDL', IL, IL'', (QI{PL}, PL'), VEPS, PDL'', DB) 14371 = unitInstAux(U, M, VDS, (SMS SMS'), (OMS OMS'), PDL, (PDL', PDL3), IL, (IL'' IL3), PL', (VEPS VEPS'), PDL'', DB') 14372 if < SMS' ; OMS' ; PDL3 ; IL3 ; VEPS' ; DB' > := treatPar(X :: ME, QI{PL}, VEPS, PDL'', DB) . 14373 ceq unitInstAux(U, M, VDS, SMS, OMS, nil, PDL, IL, IL', empty, VEPS, PDL', DB) 14374 = evalModule( 14375 setImports(setPars(applyMapsToModule(maps2rens(SMS'), maps2rens(OMS), U, M), PDL), (prepImports(IL, VEPS) IL')), 14376 applyMapsToOps(maps2rens(SMS'), maps2rens(OMS), VDS, M), 14377 DB) 14378 if SMS' := (SMS 14379 genMapsSorts((getSorts(U) ; getSortSetAux(getImports(U), DB)), VEPS) 14380 genMapsClasses((getClassNames(getClasses(U)) ; getClassSetAux(getImports(U), DB)), VEPS)) . 14381 eq unitInstAux(unitError(QIL), UK:[Module], SDV:[OpDeclSet], SMS, OMS, PDL, PDL', IL, IL', PL, VEPS, PDL'', DB) 14382 = warning(DB, QIL) . 14383 eq unitInstAux(noModule, unitError(QIL), VDS, SMS, OMS, PDL, PDL', IL, IL', VE, VEPS, PDL'', DB) 14384 = warning(DB, QIL) . 14385 eq unitInstAux(U, M, VDS, SMS, OMS, (X :: ME, PDL), PDL', IL, IL', empty, VEPS, PDL'', DB) 14386 = warning(DB, '\r 'Error: '\o 'Incorrect 'module header2QidList(getName(U)) '. '\n) . 14387 eq unitInstAux(U, M, VDS, SMS, OMS, nil, PDL, IL, IL', (QI, VE, PL), VEPS, PDL', DB) 14388 = warning(DB, '\r 'Error: '\o 'Incorrect 'module header2QidList(getName(U)) '. '\n) . 14389 eq unitInstAux(U, M, VDS, SMS, OMS, PDL, PDL', IL, IL', PL, VEPS, PDL'', DB) 14390 = DB 14391 [owise] . 14392 14393 eq treatParView(X :: ME, VE, ME', VEPS, PDL, DB) 14394 = if labelInModExp(X, ME') 14395 then treatPar(X :: ME, VE, VEPS, PDL, DB) 14396 else < none ; 14397 none ; 14398 getPars(treatPar(X :: ME, VE, VEPS, PDL, DB)) ; 14399 getImports(treatPar(X :: ME, VE, VEPS, PDL, DB)) ; 14400 viewExpPairSet(treatPar(X :: ME, VE, VEPS, PDL, DB)) ; 14401 db(treatPar(X :: ME, VE, VEPS, PDL, DB)) > 14402 fi . 14403 14404 op labelInModExp : Qid ModuleExpression -> Bool . 14405 op labelInViewExp : Qid ViewExp -> Bool . 14406 14407 eq labelInModExp(X, QI) = X == QI . 14408 eq labelInModExp(X, ME{VE}) = labelInViewExp(X, VE) . 14409 eq labelInModExp(X, TUPLE[N]) = false . 14410 eq labelInModExp(X, POWER[N]) = false . 14411 14412 eq labelInViewExp(X, QI) = X == QI . 14413 eq labelInViewExp(X, ((VE, VE'))) 14414 = labelInViewExp(X, VE) or-else labelInViewExp(X, VE') . 14415 eq labelInViewExp(X, QI{VE}) = X == QI or-else labelInViewExp(X, VE) . 14416 14417 eq treatPar(X :: ME, VE, VEPS, PDL, DB) 14418 = if VE :: Qid and-then labelInParameterDeclList(VE, PDL) 14419 then < (genMapsQualSorts(X, VE, getThSorts(ME, DB), VEPS) 14420 genMapsQualClasses(X, VE, getThClasses(ME, DB), VEPS)) ; 14421 none ; 14422 VE :: ME ; 14423 nil ; 14424 < X ; VE > ; 14425 createCopy((VE :: ME), DB) > 14426 else if viewInDb(VE, DB) 14427 then if theory(getTopModule(getTo(getView(VE, DB)), DB)) 14428 then < prepare( 14429 getSortMappings(getView(VE, DB)), 14430 X, 14431 getThSorts(ME, DB), 14432 getThSorts(getTo(getView(VE, DB)), DB), 14433 getThClasses(getTo(getView(VE, DB)), DB)) ; 14434 prepare( 14435 getOpMappings(getView(VE, DB)), 14436 X, 14437 getThSorts(ME, DB), 14438 getThSorts(getTo(getView(VE, DB)), DB), 14439 getThClasses(getTo(getView(VE, DB)), DB)) ; 14440 X :: getTo(getView(VE, DB)) ; 14441 nil ; 14442 < X ; (VE ;; X) > ; 14443 createCopy((X :: getTo(getView(VE, DB))), DB) > 14444 else < prepare( 14445 getSortMappings(getView(VE, DB)), 14446 X, 14447 getThSorts(ME, DB), none, none) ; 14448 prepare( 14449 getOpMappings(getView(VE, DB)), 14450 X, 14451 getThSorts(ME, DB), none, none) ; 14452 getPars(getTopModule(getTo(getView(VE, DB)), DB)) ; 14453 (protecting getTo(getView(VE, DB)) .) ; 14454 < X ; VE > ; 14455 DB > 14456 fi 14457 else < none ; none ; nil ; nil ; none ; warning(DB, '\r 'Error: '\o 'View VE 'not 'in 'database. '\n) > 14458 fi 14459 fi . 14460 14461 op viewInstAux : View SortMappingSet OpMappingSet ParameterDeclList ParameterDeclList 14462 ParameterList Set{Tuple{ViewExp,ViewExp}} ParameterDeclList Database 14463 -> Database . 14464 op treatParView : ParameterDecl ParameterList ModuleExpression 14465 Set{Tuple{ViewExp,ViewExp}} ParameterDeclList Database 14466 -> TreatParResult . 14467 op treatParAux : Qid ModuleExpression ParameterList Qid ViewExp ViewExp 14468 ParameterList SortMappingSet OpMappingSet ParameterList ImportList 14469 Set{Tuple{ViewExp,ViewExp}} Database -> TreatParResult . 14470 14471 eq viewInst(VE, PL, PDL, DB) 14472 = viewInstAux(setName(getView(VE, DB), VE{PL}), 14473 none, none, getPars(getView(VE, DB)), nil, PL, none, PDL, DB) . 14474 14475 ceq viewInstAux(VI, SMS, OMS, (X :: ME, PDL), PDL', (QI, PL), VEPS, PDL'', DB) 14476 = viewInstAux(VI, (SMS SMS'), (OMS OMS'), PDL, (PDL', PDL3), PL, (VEPS VEPS'), PDL'', DB') 14477 if < SMS' ; OMS' ; PDL3 ; IL ; VEPS' ; DB' > := treatParView(X :: ME, QI, getFrom(VI), VEPS, PDL'', DB) . 14478 ceq viewInstAux(VI, SMS, OMS, (X :: ME, PDL), PDL', (QI{PL}, PL'), VEPS, PDL'', DB) 14479 = viewInstAux(VI, SMS SMS', OMS OMS', PDL, (PDL', PDL3), PL', (VEPS VEPS'), PDL'', DB') 14480 if < SMS' ; OMS' ; PDL3 ; IL ; VEPS' ; DB' > := treatParView(X :: ME, QI{PL}, getFrom(VI), VEPS, PDL'', DB) . 14481 ceq viewInstAux(VI, SMS, OMS, nil, PDL, empty, VEPS, PDL', DB) 14482 = insertView( 14483 setPars( 14484 setFrom( 14485 setTo( 14486 setSortMappings( 14487 setOpMappings(VI, 14488 applyMapsToMaps( 14489 maps2rens(genMapsSorts(getSortSet(getFrom(VI), DB''), VEPS) 14490 genMapsClasses(getClassSet(getFrom(VI), DB''), VEPS)), 14491 maps2rens(SMS 14492 genMapsSorts(getSortSet(getTo(VI), DB''), VEPS) 14493 genMapsClasses(getClassSet(getTo(VI), DB''), VEPS)), 14494 getOpMappings(VI))), 14495 applyMapsToMaps( 14496 maps2rens(genMapsSorts(getSortSet(getFrom(VI), DB''), VEPS) 14497 genMapsClasses(getClassSet(getFrom(VI), DB''), VEPS)), 14498 maps2rens(SMS 14499 genMapsSorts(getSortSet(getTo(VI), DB''), VEPS) 14500 genMapsClasses(getClassSet(getTo(VI), DB''), VEPS)), 14501 getSortMappings(VI))), 14502 prepModExp(getTo(VI), VEPS)), 14503 prepModExp(getFrom(VI), VEPS)), 14504 PDL), 14505 DB'') 14506 if < DB' ; ME' > := evalModExp(prepModExp(getFrom(VI), VEPS), PDL', DB) 14507 /\ < DB'' ; ME'' > := evalModExp(prepModExp(getTo(VI), VEPS), PDL', DB') . 14508 eq viewInstAux(viewError(QIL), SMS, OMS, PDL0:[ParameterDeclList], PDL, PL, VEPS, PDL', DB) 14509 = warning(DB, QIL) . 14510 eq viewInstAux(VI, SMS, OMS, (X :: ME, PDL), PDL', empty, VEPS, PDL'', DB) 14511 = warning(DB, ('\r 'Error: '\o 'Incorrect 'view getName(VI) '. '\n)) . 14512 eq viewInstAux(VI, SMS, OMS, nil, PDL, (QI, PL), VEPS, PDL', DB) 14513 = warning(DB, ('\r 'Error: '\o 'Incorrect 'view getName(VI) '. '\n)) . 14514 eq viewInstAux(VI, SMS, OMS, (X :: ME, PDL), PDL', (QI{PL}, PL'), VEPS, PDL'', DB) 14515 = warning(DB, ('\r 'Error: '\o 'Wrong 'instantiation getName(VI) '. '\n)) . 14516 14517 op applyMapsToMaps : RenamingSet RenamingSet SortMappingSet -> SortMappingSet . 14518 op applyMapsToMaps : RenamingSet RenamingSet OpMappingSet -> OpMappingSet . 14519 op applyMapsToTerm : RenamingSet TermList -> TermList . 14520 14521 eq applyMapsToMaps(SRS, SRS', sort S to S' . SMS) 14522 = (sort applyMapsToType(SRS, S) to applyMapsToType(SRS', S') . 14523 applyMapsToMaps(SRS, SRS', SMS)) . 14524 eq applyMapsToMaps(SRS, SRS', class S to S' . SMS) 14525 = (class applyMapsToType(SRS, S) to applyMapsToType(SRS',S') . 14526 applyMapsToMaps(SRS, SRS', SMS)) . 14527 eq applyMapsToMaps(SRS, SRS', SMS) = SMS [owise] . 14528 14529 eq applyMapsToMaps(SRS, SRS', op_to`term_.(T, T') OMS) 14530 = (op_to`term_.(applyMapsToTerm(SRS, T), applyMapsToTerm(SRS', T')) 14531 applyMapsToMaps(SRS, SRS', OMS)) . 14532 eq applyMapsToMaps(SRS, SRS', op F : TyL -> Ty to F' . OMS) 14533 = (op F : applyMapsToTypeList(SRS, TyL) -> applyMapsToType(SRS, Ty) to F' . 14534 applyMapsToMaps(SRS, SRS', OMS)) . 14535 eq applyMapsToMaps(SRS, SRS', msg F : TyL -> S to F' . OMS) 14536 = (msg F : applyMapsToTypeList(SRS, TyL) -> applyMapsToType(SRS, S) to F' . 14537 applyMapsToMaps(SRS, SRS', OMS)) . 14538 eq applyMapsToMaps(SRS, SRS', attr A . S to A' . OMS) 14539 = (attr A . applyMapsToType(SRS, S) to A' . 14540 applyMapsToMaps(SRS, SRS', OMS)) . 14541 eq applyMapsToMaps(SRS, SRS', OMS) = OMS [owise] . 14542 14543 eq applyMapsToTerm(SRS, Ct) 14544 = qid(string(getName(Ct)) + "." + string(applyMapsToType(SRS, getType(Ct)))) . 14545 eq applyMapsToTerm(SRS, V) 14546 = qid(string(getName(V)) + "." + string(applyMapsToType(SRS, getType(V)))) . 14547 eq applyMapsToTerm(SRS, qidError(QIL)) = qidError(QIL) . 14548 ceq applyMapsToTerm(SRS, F[TL]) 14549 = F[applyMapsToTerm(SRS, TL)] 14550 if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) . 14551 eq applyMapsToTerm(SRS, '<_:_|_>[O, Ct, T]) 14552 = '<_:_|_>[applyMapsToTerm(SRS, O), 14553 qid(string(applyMapsToClassName(SRS, getName(Ct))) 14554 + "." + string(applyMapsToClassName(SRS, getType(Ct)))), 14555 applyMapsToTerm(SRS, T)] . 14556 ceq applyMapsToTerm(SRS, '<_:_|_>[O, C, T]) 14557 = '<_:_|_>[applyMapsToTerm(SRS, O), 14558 applyMapsToClassName(SRS, C), 14559 applyMapsToTerm(SRS, T)] 14560 if not C :: Constant . 14561 eq applyMapsToTerm(SRS, '<_:_|`>[O, Ct]) 14562 = '<_:_|_>[applyMapsToTerm(SRS, O), 14563 qid(string(applyMapsToClassName(SRS, getName(Ct))) 14564 + "." + string(applyMapsToClassName(SRS, getType(Ct)))), 14565 'none.AttributeSet] . 14566 ceq applyMapsToTerm(SRS, '<_:_|`>[O, C]) 14567 = '<_:_|_>[applyMapsToTerm(SRS, O), 14568 applyMapsToClassName(SRS, C), 14569 'none.AttributeSet] 14570 if not C :: Constant . 14571 14572 ceq applyMapsToTerm(SRS, (T, TL)) 14573 = (applyMapsToTerm(SRS, T), applyMapsToTerm(SRS, TL)) 14574 if TL =/= empty . 14575 14576*** As pointed out in Section~\ref{module-names}, for each new module 14577*** expression constructor being introduced, we need to add equations for the 14578*** operator \texttt{header2Qid}. Since the function to transform view 14579*** expressions into lists of quoted identifiers was already defined in 14580*** Section~\ref{VIEW-EXPR}, we just need to add the following equation. 14581 14582 eq header2Qid((ME { PL })) 14583 = qidList2Qid(header2Qid(ME) '`{ parameterList2Qid(PL) '`}) . 14584 ceq header2QidList((ME { PL })) 14585 = (if QI == '\s then QIL else QIL QI fi 14586 '`{ parameterList2QidList(PL) '`} '\s) 14587 if QIL QI := header2QidList(ME) . 14588 14589*** Given a module expression of the form \verb~ME{VE}~ such that 14590*** \texttt{ME} is in the database, we need to add \verb~ME{VE}~ to the set 14591*** of names of the modules depending on \texttt{ME} and on \texttt{VE}. 14592*** Since \texttt{VE} may be a composed view expression, we have to add the 14593*** name of the module to each of the views in it. In this way, if \texttt{ME} 14594*** or any of the views in \texttt{VE} is redefined or removed from the 14595*** database, \verb~ME{VE}~ will be removed as well. 14596 14597 eq setUpModExpDeps(ME{PL}, 14598 db(< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', 14599 VIS, VES', MNS'', MNS3, MNS4, QIL)) 14600 = viewExpDeps(ME{PL}, PL, 14601 db(< ME ; DT ; U ; U' ; M ; VDS ; (MNS . ME{PL}) ; VES > MIS, 14602 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . 14603 eq setUpModExpDeps(ME{PL}, 14604 db(< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', 14605 VIS, VES', MNS'', MNS3, MNS4, QIL)) 14606 = viewExpDeps(ME{PL}, PL, 14607 db(< ME ; DM ; U ; U' ; M ; VDS ; (MNS . ME{PL}) ; VES > MIS, 14608 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . 14609 eq setUpModExpDeps('META-LEVEL{PL}, DB) 14610 = setUpModExpDeps('META-LEVEL{PL}, PL, DB) . 14611 eq setUpModExpDeps('META-LEVEL{QI}, 14612 db(< QI ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', 14613 VIS, VES', MNS'', MNS3, MNS4, QIL)) 14614 = db(< QI ; DT ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{QI} ; VES > 14615 MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . 14616 eq setUpModExpDeps('META-LEVEL{QI}, 14617 db(< QI ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', 14618 VIS, VES', MNS'', MNS3, MNS4, QIL)) 14619 = db(< QI ; DM ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{QI} ; VES > 14620 MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . 14621 ceq setUpModExpDeps(ME{PL}, DB) 14622 = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n)) 14623 if (ME =/= 'META-LEVEL) /\ (not unitInDb(ME, DB)) . 14624 14625 eq setUpModExpDeps('META-LEVEL{PL}, (QI, PL'), 14626 db(< QI ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', 14627 VIS, VES', MNS'', MNS3, MNS4, QIL)) 14628 = setUpModExpDeps('META-LEVEL{PL}, PL', 14629 db(< QI ; DT ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{PL} ; VES > 14630 MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . 14631 eq setUpModExpDeps('META-LEVEL{PL}, (QI, PL'), 14632 db(< QI ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', 14633 VIS, VES', MNS'', MNS3, MNS4, QIL)) 14634 = setUpModExpDeps('META-LEVEL{PL}, PL', 14635 db(< QI ; DM ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{PL} ; VES > 14636 MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . 14637 eq setUpModExpDeps('META-LEVEL{PL}, nil, DB) = DB . 14638 14639 op viewExpDeps : Header ViewExp Database -> Database . 14640 14641---- eq viewExpDeps(ME, VE, 14642---- db(MIS, MNS, 14643---- < VE ; DT ; VI ; MNS' ; VES > VIS, VES', 14644---- MNS'', MNS3, MNS4, QIL)) 14645---- = db(MIS, MNS, < VE ; DT ; VI ; MNS' . ME ; VES > VIS, VES', 14646---- MNS'', MNS3, MNS4, QIL) . 14647 eq viewExpDeps(ME, (VE, PL), 14648 db(MIS, MNS, 14649 < VE ; DT ; VI ; MNS' ; VES > VIS, VES', 14650 MNS'', MNS3, MNS4, QIL)) 14651 = viewExpDeps(ME, PL, 14652 db(MIS, MNS, 14653 < VE ; DT ; VI ; MNS' . ME ; VES > VIS, VES', 14654 MNS'', MNS3, MNS4, QIL)) . 14655---- eq viewExpDeps(ME, VE, DB) = DB [owise] . 14656 eq viewExpDeps(ME, (VE, PL), DB) = viewExpDeps(ME, PL, DB) [owise] . 14657 eq viewExpDeps(ME, empty, DB) = DB . 14658 14659endfm 14660 14661******************************************************************************* 14662 14663*** 14664*** 6.10 Renaming of Modules 14665*** 14666 14667*** In addition to the declaration of the constructor for renaming module 14668*** expressions, the following module \texttt{RENAMING-EXPR-EVALUATION} 14669*** introduces equations to treat this new case in the definition of functions 14670*** \texttt{evalModExp}, \texttt{header2QidList}, \texttt{prepHeader}, and 14671*** \texttt{setUpModuleDeps}. 14672 14673*** A renaming expression is evaluated by applying the renaming maps, not only 14674*** to the top unit, but also to the part of the structure \emph{affected} by 14675*** the maps. The renaming process propagates downwards in the unit hierarchy 14676*** while the units in the structure are affected by the renamings. We say that 14677*** a unit is affected by a set of maps (checked by the \texttt{modAffd} 14678*** function) when any of the maps is applicable to any of the declarations in 14679*** the unit, or in any of its subunits. The application of a set of maps to a 14680*** single unit is accomplished by the \texttt{applyMapsToModule} function, 14681*** discussed in Section~\ref{applyMapsToModule}. 14682 14683fmod RENAMING-EXPR-EVALUATION is 14684 pr DATABASE . 14685 pr RENAMING-SET-APPL-ON-UNIT . 14686 pr EVALUATION . 14687 inc MOD-EXPR . 14688 pr MOD-EXPR-EVAL . 14689 pr INST-EXPR-EVALUATION . 14690 pr FMAP . 14691 14692 vars ME ME' : ModuleExpression . 14693 var MNS MNS' MNS'' MNS3 MNS4 : Set{ModuleName} . 14694 vars MIS MIS' : Set{ModuleInfo} . 14695 var VIS : Set{ViewInfo} . 14696 vars M M' : Module . 14697 vars PU U U' DM : Module . 14698 vars DB DB' : Database . 14699 var QIL : QidList . 14700 vars VES VES' : Set{ViewExp} . 14701 var PL : ParameterList . 14702 var PDL : ParameterDeclList . 14703 vars PDS PDS' : Set{ParameterDecl} . 14704 var I : Import . 14705 vars IL IL' : ImportList . 14706 var R : Renaming . 14707 vars RS RS' RS'' RS3 : RenamingSet . 14708 var VEPS : Set{Tuple{ViewExp,ViewExp}} . 14709 vars X QI QI' QI'' F F' F'' L L' L'' A A' A'' : Qid . 14710 vars S S' S'' C C' C'' : Sort . 14711 var K : Kind . 14712 vars SS : SortSet . 14713 vars TyL TyL' : TypeList . 14714 vars Ty Ty' : Type . 14715 vars T T' T'' T3 : Term . 14716 var DT : Default{Term} . 14717 var TL : TermList . 14718 var OPD : OpDeclSet . 14719 vars OPDS VDS : OpDeclSet . 14720 vars AtS AtS' : AttrSet . 14721 var Rl : Rule . 14722 var RlS : RuleSet . 14723 var CD : ClassDecl . 14724 var CDS : ClassDeclSet . 14725 var ADS : AttrDeclSet . 14726 var MD : MsgDecl . 14727 var MDS : MsgDeclSet . 14728 var N : Nat . 14729 var NL : IntList . 14730 var Hk : Hook . 14731 var HkL : HookList . 14732 var B : Bool . 14733 var St : String . 14734 14735*** The function \texttt{crtCopyRen} creates a copy of the part of the 14736*** structure of the specified module which is affected by the renaming, 14737*** applying to each of the generated modules in the new structure the subset 14738*** of maps affecting each one of them. The equation extending the 14739*** \texttt{evalModExp} function to the renaming module expression is then 14740*** reduced to a call to \texttt{crtCopyRen} with the appropriate 14741*** arguments. 14742 14743 eq labelInModExp(X, ME * (RS)) = labelInModExp(X, ME) . 14744 14745 op crtCopyRen : ModuleExpression RenamingSet Database -> Database . 14746 14747 ceq evalModExp(ME * (RS), PDL, DB) 14748 = if unitInDb(ME' * (RS''), DB') 14749 then < DB' ; ME' * (RS'') > 14750 else < crtCopyRen(ME', RS', DB') ; ME' * (RS'') > 14751 fi 14752 if < DB' ; ME' > := evalModExp(ME, PDL, DB) 14753 /\ RS' := fixMaps(RS, ME', DB') 14754 /\ RS'' := canMaps(RS', getFlatModule(ME', DB')) . 14755 14756 eq crtCopyRen(ME, none, DB) = DB . 14757 ceq crtCopyRen(ME, RS, DB) 14758 = if unitInDb(_*`(_`)(ME, RS'), DB) 14759 then DB 14760 else applyMapsRec( 14761 RS, 14762 getImports(getTopModule(ME, DB)), 14763 nil, 14764 setName( 14765 applyMapsToModuleAux(RS'', RS3, 14766 getTopModule(ME, DB), getFlatModule(ME, DB)), 14767 _*`(_`)(ME, RS')), 14768 applyMapsToOps(RS'', RS3, 14769 getVars(ME, DB), getFlatModule(ME, DB)), 14770 DB) 14771 fi 14772 if RS' := canMaps(RS, getFlatModule(ME, DB)) 14773 /\ < RS'' ; RS3 > := splitMaps(RS') . 14774 14775 op canMaps : RenamingSet Module -> RenamingSet . 14776 eq canMaps(op F : TyL -> Ty to F' [AtS], M) 14777 = op F : canKinds(TyL, M) -> canKinds(Ty, M) to F' [AtS] . 14778 eq canMaps((op F : TyL -> Ty to F' [AtS], RS), M) 14779 = (op F : canKinds(TyL, M) -> canKinds(Ty, M) to F' [AtS], 14780 canMaps(RS, M)) . 14781 eq canMaps(msg F : TyL -> Ty to F', M) 14782 = msg F : canKinds(TyL, M) -> canKinds(Ty, M) to F' . 14783 eq canMaps((msg F : TyL -> Ty to F', RS), M) 14784 = (msg F : canKinds(TyL, M) -> canKinds(Ty, M) to F', 14785 canMaps(RS, M)) . 14786 eq canMaps(R:Renaming, M) = R:Renaming [owise] . 14787 eq canMaps((R:Renaming, RS), M) 14788 = (R:Renaming, canMaps(RS, M)) 14789 [owise] . 14790 eq canMaps(none, M) = none . 14791 14792 op canKinds : TypeList Module -> [TypeList] . 14793 ---- eq canKinds(K:Kind TyL, M) 14794 ---- = kind(maximalSorts(M, K:Kind)) canKinds(TyL, M) . 14795 eq canKinds(nil, M) = nil . 14796 eq canKinds(cc(S ; SS) TyL, M) 14797 = kind(maximalSorts(M, getKind(M, S))) canKinds(TyL, M) . 14798 ----eq canKinds(TyL, M) = nil [owise] . 14799 14800*** We proceed downwards while the set of maps affects the module, but we do so 14801*** restricting the set of maps to the subset affecting the module. Since 14802*** operator and message maps in which arity and coarity are specified must be 14803*** applied to the whole subsort-overloaded family of operators or messages, we 14804*** have to carry along the signature of the module at the top to make all the 14805*** calls to the engine. Note that we may have maps of operations or messages 14806*** with the domain given by sorts that are not in the submodules but which 14807*** have other sorts in the submodules in the same connected components. 14808 14809 op applyMapsRec : RenamingSet ImportList ImportList Module OpDeclSet Database -> Database . 14810 14811 eq applyMapsRec(RS, ((including ME .) IL), IL', U, VDS, DB) 14812 = applyMapsRec( 14813 RS, IL, 14814 including ME *( canMaps(fixMaps(RS, ME, DB), 14815 getFlatModule(ME, DB)) ) . IL', 14816 U, VDS, 14817 crtCopyRen(ME, fixMaps(RS, ME, DB), DB)) . 14818 eq applyMapsRec(RS, ((extending ME .) IL), IL', U, VDS, DB) 14819 = applyMapsRec( 14820 RS, IL, 14821 extending ME *( canMaps(fixMaps(RS, ME, DB), 14822 getFlatModule(ME, DB)) ) . IL', 14823 U, VDS, 14824 crtCopyRen(ME, fixMaps(RS, ME, DB), DB)) . 14825 eq applyMapsRec(RS, ((protecting ME .) IL), IL', U, VDS, DB) 14826 = applyMapsRec( 14827 RS, IL, 14828 protecting ME *( canMaps(fixMaps(RS, ME, DB), 14829 getFlatModule(ME, DB)) ) . IL', 14830 U, VDS, 14831 crtCopyRen(ME, fixMaps(RS, ME, DB), DB)) . 14832 eq applyMapsRec(RS, (I IL), IL', U, VDS, DB) 14833 = applyMapsRec(RS, IL, (I IL'), U, VDS, DB) 14834 [owise] . 14835 eq applyMapsRec(RS, nil, IL, U, VDS, DB) 14836 = evalModule(setImports(U, IL), VDS, DB) . 14837 eq applyMapsRec(RS, IL, IL', unitError(QIL), VDS, DB) 14838 = warning(DB, QIL) . 14839 14840 op fixMaps : [RenamingSet] ModuleExpression Database -> RenamingSet . 14841 op fixMaps2 : [RenamingSet] Module ClassDeclSet MsgDeclSet -> RenamingSet . 14842 14843 ceq fixMaps(RS, ME, DB) 14844 = fixMaps2(RS, getFlatModule(ME, DB), CDS, MDS) 14845 if < CDS ; MDS > := getAllClassesAndMsgs(ME, DB) . 14846 14847 eq fixMaps2(op F to F' [AtS], M, CDS, MDS) 14848 = opsAffd(getOps(M), op F to F' [AtS], M) . 14849 eq fixMaps2((op F to F' [AtS], RS), M, CDS, MDS) 14850 = (opsAffd(getOps(M), op F to F' [AtS], M), 14851 fixMaps2(RS, M, CDS, MDS)) . 14852 eq fixMaps2(op F : TyL -> Ty to F' [AtS], M, CDS, MDS) 14853 = opsAffd(getOps(M), op F : TyL -> Ty to F' [AtS], M) . 14854 eq fixMaps2((op F : TyL -> Ty to F' [AtS], RS), M, CDS, MDS) 14855 = (opsAffd(getOps(M), op F : TyL -> Ty to F' [AtS], M), 14856 fixMaps2(RS, M, CDS, MDS)) . 14857 eq fixMaps2(msg F to F', M, CDS, MDS) 14858 = msgsAffd(MDS, msg F to F', M) . 14859 eq fixMaps2((msg F to F', RS), M, CDS, MDS) 14860 = (msgsAffd(MDS, msg F to F', M), fixMaps2(RS, M, CDS, MDS)) . 14861 eq fixMaps2(msg F : TyL -> Ty to F', M, CDS, MDS) 14862 = msgsAffd(MDS, msg F : TyL -> Ty to F', M) . 14863 eq fixMaps2((msg F : TyL -> Ty to F', RS), M, CDS, MDS) 14864 = (msgsAffd(MDS, msg F : TyL -> Ty to F', M), 14865 fixMaps2(RS, M, CDS, MDS)) . 14866 eq fixMaps2(sort Ty to Ty', M, CDS, MDS) 14867 = if sortsAffd(getSorts(M), sort Ty to Ty') 14868 then (sort Ty to Ty') 14869 else none 14870 fi . 14871 eq fixMaps2(((sort Ty to Ty'), RS), M, CDS, MDS) 14872 = (if sortsAffd(getSorts(M), sort Ty to Ty') 14873 then (sort Ty to Ty') 14874 else none 14875 fi, 14876 fixMaps2(RS, M, CDS, MDS)) . 14877 eq fixMaps2(class Ty to Ty', M, CDS, MDS) 14878 = if classesAffd(CDS, class Ty to Ty') 14879 then (class Ty to Ty') 14880 else none 14881 fi . 14882 eq fixMaps2(((class Ty to Ty'), RS), M, CDS, MDS) 14883 = (if classesAffd(CDS, class Ty to Ty') 14884 then (class Ty to Ty') 14885 else none 14886 fi, 14887 fixMaps2(RS, M, CDS, MDS)) . 14888 eq fixMaps2(attr A . Ty to Ty', M, CDS, MDS) 14889 = if classesAffd(CDS, attr A . Ty to Ty') 14890 then (attr A . Ty to Ty') 14891 else none 14892 fi . 14893 eq fixMaps2(((class A . Ty to Ty'), RS), M, CDS, MDS) 14894 = (if classesAffd(CDS, attr A . Ty to Ty') 14895 then (attr A . Ty to Ty') 14896 else none 14897 fi, 14898 fixMaps2(RS, M, CDS, MDS)) . 14899 eq fixMaps2(R:Renaming, M, CDS, MDS) = R:Renaming [owise] . 14900 eq fixMaps2((R:Renaming, RS), M, CDS, MDS) 14901 = (R:Renaming, fixMaps2(RS, M, CDS, MDS)) 14902 [owise] . 14903 eq fixMaps2(none, M, CDS, MDS) = none . 14904 14905 sort Tuple{ClassDeclSet, MsgDeclSet} . 14906 op <_;_> : ClassDeclSet MsgDeclSet -> Tuple{ClassDeclSet, MsgDeclSet} . 14907 op getClasses : Tuple{ClassDeclSet, MsgDeclSet} -> ClassDeclSet . 14908 op getMsgs : Tuple{ClassDeclSet, MsgDeclSet} -> MsgDeclSet . 14909 eq getClasses(< CDS ; MDS >) = CDS . 14910 eq getMsgs(< CDS ; MDS >) = MDS . 14911 14912 op getAllClassesAndMsgs : 14913 ModuleExpression Database -> Tuple{ClassDeclSet, MsgDeclSet} . 14914 op getAllClassesAndMsgs : 14915 ImportList Database -> Tuple{ClassDeclSet, MsgDeclSet} . 14916 14917 eq getAllClassesAndMsgs(ME, DB) 14918 = if getTopModule(ME, DB) :: OModule 14919 and-then not getTopModule(ME, DB) :: SModule 14920 then < getClasses( 14921 getAllClassesAndMsgs(getImports(getTopModule(ME, DB)), DB)) 14922 getClasses(getTopModule(ME, DB)) 14923 ; 14924 getMsgs( 14925 getAllClassesAndMsgs(getImports(getTopModule(ME, DB)), DB)) 14926 getMsgs(getTopModule(ME, DB)) > 14927 else < none ; none > 14928 fi . 14929 14930 eq getAllClassesAndMsgs(I IL, DB) 14931 = < getClasses(getAllClassesAndMsgs(moduleName(I), DB)) 14932 getClasses(getAllClassesAndMsgs(IL, DB)) 14933 ; 14934 getMsgs(getAllClassesAndMsgs(moduleName(I), DB)) 14935 getMsgs(getAllClassesAndMsgs(IL, DB)) > . 14936 eq getAllClassesAndMsgs((nil).ImportList, DB) = < none ; none > . 14937 14938---- sorts NeSet<TypeList> Set<TypeList> . 14939---- subsort TypeList < NeSet<TypeList> < Set<TypeList> . 14940---- op noneTLS : -> Set<TypeList> [ctor] . 14941---- op _!_ : Set<TypeList> Set<TypeList> -> Set<TypeList> 14942---- [ctor assoc comm id: noneTLS] . 14943---- op _!_ : NeSet<TypeList> NeSet<TypeList> -> NeSet<TypeList> 14944---- [ctor assoc comm id: noneTLS] . 14945 14946---- sort Set<Type> . 14947---- subsorts Type SortSet < Set<Type> . 14948---- op _o_ : Set<Type> Set<Type> -> Set<Type> [ctor assoc comm id: none] . 14949---- 14950---- eq Ty o Ty = Ty . 14951 14952 sort TypeSetList . 14953 subsort TypeSet < TypeSetList . 14954 op nilTSL : -> TypeSetList [ctor] . 14955 op _l_ : TypeSetList TypeSetList -> TypeSetList 14956 [ctor assoc id: nilTSL] . 14957 14958 var TS : TypeSet . 14959 var TSL : TypeSetList . 14960 var TLS : TypeListSet . 14961---- var NTLS : NeTypeListSet . 14962 14963---- eq TyL ! TyL = TyL . 14964 14965 ----eq _!_(qidError(QIL), NTLS) = qidError(QIL) . 14966 14967 op fixKinds : TypeList Module -> TypeListSet . 14968 op fixKinds : TypeList TypeSetList Module -> TypeListSet . 14969 op fixKindsAux : Type Module -> TypeSet . 14970 op fixKindsAux2 : SortSet Module -> TypeSet . 14971 op unfold : TypeSetList -> TypeListSet . 14972 op add : TypeSet TypeListSet -> TypeListSet . 14973 14974 eq fixKinds(TyL, M) = fixKinds(TyL, nilTSL, M) . 14975 14976 eq fixKinds(Ty TyL, TSL, M) 14977 = if fixKindsAux(Ty, M) == nil 14978 then none 14979 else fixKinds(TyL, TSL l fixKindsAux(Ty, M), M) 14980 fi . 14981 eq fixKinds(nil, TSL, M) = unfold(TSL) . 14982 14983 eq fixKindsAux(S, M) 14984 = if S in getSorts(M) 14985 then cc(connectedSorts(M, S)) 14986 else none 14987 fi . 14988 eq fixKindsAux(K, M) = fixKindsAux2(getSorts(K), M) . 14989 eq fixKindsAux(cc(SS), M) = fixKindsAux2(SS, M) . 14990 14991 eq fixKindsAux2((S ; SS), M) 14992 = (if S in getSorts(M) 14993 then cc(connectedSorts(M, S)) 14994 else none 14995 fi 14996 ; 14997 fixKindsAux2(SS, M)) . 14998 eq fixKindsAux2(none, M) = none . 14999 15000 ceq unfold(TS l TSL) = add(TS, unfold(TSL)) if TS =/= none . 15001 eq unfold(nilTSL) = none . 15002 15003 ceq add(Ty, TyL ; TLS) = add(Ty, TyL) ; add(Ty, TLS) if TLS =/= none . 15004 eq add(Ty ; Ty' ; TS, TLS) = add(Ty, TLS) ; add(Ty' ; TS, TLS) . 15005 eq add(none, TLS) = nilTSL . 15006 eq add(Ty, none) = Ty . 15007 eq add(Ty, TyL) = Ty TyL . 15008 15009 op connectedSorts : Module Type -> SortSet . 15010 op connectedSorts : Module SortSet Type -> SortSet . 15011 eq connectedSorts(M, Ty) = connectedSorts(M, getSorts(M), Ty) . 15012 eq connectedSorts(M, S ; SS, Ty) 15013 = if sameKind(M, S, Ty) 15014 then S 15015 else none 15016 fi ; connectedSorts(M, SS, Ty) . 15017 eq connectedSorts(M, none, Ty) = none . 15018 15019 op sortsAffd : SortSet Renaming -> Bool . 15020 op opsAffd : OpDeclSet Renaming Module -> RenamingSet . 15021 op opsAffdAux : OpDeclSet Qid TypeListSet Qid AttrSet Module -> RenamingSet . 15022 15023 eq sortsAffd((S ; SS), (sort S to S')) = true . 15024 eq sortsAffd(SS, (sort S to S')) = false [owise] . 15025 15026 eq opsAffd(op F : TyL -> Ty [AtS] . OPDS, op F to F' [AtS'], M) 15027 = op F to F' [AtS'] . 15028 eq opsAffd(OPDS, op F : TyL -> Ty to F' [AtS], M) 15029 = opsAffdAux(OPDS, F, fixKinds(TyL Ty, M), F', AtS, M) . 15030 eq opsAffd(OPDS, RS:[RenamingSet], M) = none [owise] . 15031 15032 eq opsAffdAux(op F : TyL -> Ty [AtS] . OPDS, 15033 F, (TyL' Ty') ; TLS, F', AtS', M) 15034 = if sameKind(M, (TyL Ty), (TyL' Ty')) 15035 then (op F : TyL' -> Ty' to F' [AtS'], 15036 opsAffdAux(OPDS, F, TLS, F', AtS', M)) 15037 else (opsAffdAux(OPDS, F, (TyL' Ty') ; TLS, F', AtS', M), 15038 opsAffdAux(op F : TyL -> Ty [AtS] . OPDS, F, TLS, F', AtS', M)) 15039 fi . 15040 eq opsAffdAux(OPDS, F, TLS, F', AtS, M) = none [owise] . 15041 15042*** The predicate \texttt{modAffd} checks whether the module with the 15043*** name given as first argument in the database is affected by the set of maps 15044*** given as second argument. A module is affected by a map set if any of the 15045*** maps is applicable to the module or to any of its submodules. 15046 15047 op modAffd : Header RenamingSet Module Database -> Bool . 15048 15049 op modAffdAux : Module RenamingSet Module Database -> Bool . 15050 op rlsAffd : RuleSet RenamingSet -> Bool . 15051 op importsAffd : ImportList RenamingSet Module Database -> Bool . 15052 op classesAffd : ClassDeclSet RenamingSet -> Bool . 15053 op msgsAffd : MsgDeclSet RenamingSet Module -> RenamingSet . 15054 op msgsAffdAux : MsgDeclSet Qid TypeListSet Qid Module -> RenamingSet . 15055 15056 eq modAffd(ME, RS, M, DB) 15057 = modAffdAux(getTopModule(ME, DB), RS, M, DB) . 15058 15059 eq modAffdAux(U, RS, M, DB) 15060 = sortsAffd(getSorts(U), RS) 15061 or-else 15062 (opsAffd(getOps(U), RS, M) == none 15063 or-else 15064 ((not U :: FModule 15065 and-then 15066 (rlsAffd(getRls(U), RS) 15067 or-else 15068 (not U :: SModule 15069 and-then 15070 (classesAffd(getClasses(U), RS) 15071 or-else 15072 msgsAffd(getMsgs(U), RS, M) == none)))) 15073 or-else 15074 importsAffd(getImports(U), RS, M, DB))) . 15075 15076 eq importsAffd(((including ME .) IL), RS, M, DB) 15077 = modAffd(ME, RS, M, DB) 15078 or-else importsAffd(IL, RS, M, DB) . 15079 eq importsAffd(((extending ME .) IL), RS, M, DB) 15080 = modAffd(ME, RS, M, DB) 15081 or-else importsAffd(IL, RS, M, DB) . 15082 eq importsAffd(((protecting ME .) IL), RS, M, DB) 15083 = modAffd(ME, RS, M, DB) 15084 or-else importsAffd(IL, RS, M, DB) . 15085 eq importsAffd(nil, RS, M, DB) = false . 15086 15087 eq rlsAffd(((rl T => T' [label(L) AtS] .) RlS), (label L' to L'')) 15088 = (L == L') or-else rlsAffd(RlS, label L' to L'') . 15089 eq rlsAffd(((rl T => T' [label(L) AtS] .) RlS), 15090 ((label L' to L''), RS)) 15091 = (L == L') or-else 15092 (rlsAffd((rl T => T' [label(L) AtS] .), RS) or-else 15093 rlsAffd(RlS, ((label L' to L''), RS))) . 15094 eq rlsAffd(((crl T => T' if T'' = T3 [label(L) AtS] .) RlS), 15095 (label L' to L'')) 15096 = (L == L') or-else rlsAffd(RlS, (label L' to L'')) . 15097 eq rlsAffd(((crl T => T' if T'' = T3 [label(L) AtS] .) RlS), 15098 ((label L' to L''), RS)) 15099 = (L == L') 15100 or-else 15101 (rlsAffd((crl T => T' if T'' = T3 [label(L) AtS] .), RS) 15102 or-else 15103 rlsAffd(RlS, ((label L' to L''), RS))) . 15104 eq rlsAffd(RlS, RS) = false [owise] . 15105 15106 eq classesAffd(((class C | ADS .) CDS), (class C' to C'')) 15107 = (C == C') 15108 or-else 15109 classesAffd(CDS, (class C' to C'')) . 15110 eq classesAffd(((class C | ADS .) CDS), ((class C' to C''), RS)) 15111 = (C == C') 15112 or-else 15113 (classesAffd((class C | ADS .), RS) 15114 or-else 15115 classesAffd(CDS, ((class C' to C''), RS))) . 15116 eq classesAffd(((class C | ((attr A : S), ADS) .) CDS), 15117 (attr A' . C' to A'')) 15118 = if C == C' 15119 then (A == A') 15120 or-else 15121 classesAffd(((class C | ADS .) CDS), (attr A' . C' to A'')) 15122 else classesAffd(CDS, (attr A' . C' to A'')) 15123 fi . 15124 eq classesAffd(((class C | ((attr A : S), ADS) .) CDS), 15125 ((attr A' . C' to A''), RS)) 15126 = if C == C' 15127 then (A == A') 15128 or-else 15129 (classesAffd(((class C | ADS .) CDS), 15130 ((attr A' . C' to A''), RS)) 15131 or-else 15132 classesAffd(CDS, RS)) 15133 else classesAffd((class C | ((attr A : S), ADS) .), RS) 15134 or-else 15135 classesAffd(CDS, ((attr A' . C' to A''), RS)) 15136 fi . 15137 eq classesAffd(CDS, RS) = false [owise] . 15138 15139 eq msgsAffd(msg F : TyL -> Ty . MDS, msg F to F', M) = msg F to F' . 15140 eq msgsAffd(MDS, msg F : TyL -> Ty to F', M) 15141 = msgsAffdAux(MDS, F, fixKinds(TyL Ty, M), F', M) . 15142 eq msgsAffd(MDS, RS:[RenamingSet], M) = none [owise] . 15143 15144 eq msgsAffdAux(msg F : TyL -> Ty . MDS, F, (TyL' Ty') ; TLS, F', M) 15145 = if sameKind(M, (TyL Ty), (TyL' Ty')) 15146 then (msg F : TyL' -> Ty' to F', 15147 msgsAffdAux(MDS, F, TLS, F', M)) 15148 else (msgsAffdAux(MDS, F, (TyL' Ty') ; TLS, F', M), 15149 msgsAffdAux(msg F : TyL -> Ty . MDS, F, TLS, F', M)) 15150 fi . 15151 eq msgsAffdAux(MDS, F, TLS, F', M) = none [owise] . 15152 15153*** The function \texttt{mapsRestrict} returns the subset of the view 15154*** maps given as second argument that affect the given module. 15155 15156 op mapsRestrict : Module RenamingSet Module Database -> RenamingSet . 15157 op mapsRestrict : Header RenamingSet Module Database -> RenamingSet . 15158 15159 eq mapsRestrict(ME, RS, M, DB) 15160 = mapsRestrict(getTopModule(ME, DB), RS, M, DB) . 15161 15162 eq mapsRestrict(U, R, M, DB) 15163 = if modAffdAux(U, R, M, DB) 15164 then R 15165 else none 15166 fi . 15167 eq mapsRestrict(U, (R, RS), M, DB) 15168 = if modAffdAux(U, R, M, DB) 15169 then (R, mapsRestrict(U, RS, M, DB)) 15170 else mapsRestrict(U, RS, M, DB) 15171 fi . 15172 eq mapsRestrict(U, none, M, DB) = none . 15173 15174*** The definition of the function \texttt{header2QidList} on the renaming 15175*** module expression has to take care of transforming into a quoted identifier 15176*** list the set of view maps given in the module expression. 15177 15178 op maps2QidList : RenamingSet -> QidList . 15179 15180 op attrSet2QidList : AttrSet -> QidList . 15181 op hookList2QidList : HookList -> QidList . 15182 op termList2QidList : TermList -> QidList . 15183 op intList2QidList : IntList -> QidList . 15184 op typeList2QidList : TypeList -> QidList . 15185 15186 eq maps2QidList(((op F to F' [AtS]), RS)) 15187 = if AtS == none 15188 then ('op F 'to F' '`, '\s maps2QidList(RS)) 15189 else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`] '`, '\s 15190 maps2QidList(RS)) 15191 fi 15192 [owise] . 15193 eq maps2QidList((op F to F' [AtS])) 15194 = if AtS == none 15195 then ('op F 'to F') 15196 else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`]) 15197 fi . 15198 eq maps2QidList(((op F : TyL -> Ty to F' [AtS]), RS)) 15199 = if AtS == none 15200 then ('op F ': typeList2QidList(TyL) '-> Ty 'to F' '`, 15201 '\s maps2QidList(RS)) 15202 else ('op F ': typeList2QidList(TyL) '-> Ty 'to F' 15203 '`[ attrSet2QidList(AtS) '`] '`, '\s maps2QidList(RS)) 15204 fi 15205 [owise] . 15206 eq maps2QidList((op F : TyL -> Ty to F' [AtS])) 15207 = if AtS == none 15208 then ('op F ': typeList2QidList(TyL) '-> Ty 'to F') 15209 else ('op F ': typeList2QidList(TyL) '-> Ty 'to F' 15210 '`[ attrSet2QidList(AtS) '`]) 15211 fi . 15212 eq maps2QidList(((sort S to S'), RS)) 15213 = ('sort S 'to S' '`, '\s maps2QidList(RS)) 15214 [owise] . 15215 eq maps2QidList((sort S to S')) = ('sort S 'to S') . 15216 15217 eq maps2QidList(((label L to L'), RS)) 15218 = ('label L 'to L' '`, '\s maps2QidList(RS)) 15219 [owise] . 15220 eq maps2QidList((label L to L')) = ('label L 'to L') . 15221 15222 eq maps2QidList(((msg F to F'), RS)) 15223 = ('msg F 'to F' '`, '\s maps2QidList(RS)) 15224 [owise] . 15225 eq maps2QidList((msg F to F')) = ('msg F 'to F') . 15226 15227 eq maps2QidList(((msg F : TyL -> Ty to F'), RS)) 15228 = ('msg F ': typeList2QidList(TyL) '-> Ty 'to F' '`, '\s 15229 maps2QidList(RS)) 15230 [owise] . 15231 eq maps2QidList((msg F : TyL -> Ty to F')) 15232 = ('msg F ': typeList2QidList(TyL) '-> Ty 'to F') . 15233 15234 eq maps2QidList(((class S to S'), RS)) 15235 = ('class S 'to S' '`, '\s maps2QidList(RS)) 15236 [owise] . 15237 eq maps2QidList((class S to S')) = ('class S 'to S') . 15238 15239 eq maps2QidList(((attr QI . S to QI'), RS)) 15240 = ('attr S '. QI 'to QI' '`, '\s maps2QidList(RS)) 15241 [owise] . 15242 eq maps2QidList((attr QI . S to QI')) = ('attr S '. QI 'to QI') . 15243 15244 eq maps2QidList(none) = nil . 15245 15246 eq attrSet2QidList(none) = nil . 15247 eq attrSet2QidList((assoc AtS)) = ('assoc attrSet2QidList(AtS)) . 15248 eq attrSet2QidList((comm AtS)) = ('comm attrSet2QidList(AtS)) . 15249 eq attrSet2QidList((idem AtS)) = ('idem attrSet2QidList(AtS)) . 15250 eq attrSet2QidList((iter AtS)) = ('iter attrSet2QidList(AtS)) . 15251 eq attrSet2QidList((id(T) AtS)) 15252 = ('id: termList2QidList(T) attrSet2QidList(AtS)) . 15253 eq attrSet2QidList((right-id(T) AtS)) 15254 = ('right-id: termList2QidList(T) attrSet2QidList(AtS)) . 15255 eq attrSet2QidList((left-id(T) AtS)) 15256 = ('left-id: termList2QidList(T) attrSet2QidList(AtS)) . 15257 eq attrSet2QidList((poly(NL) AtS)) 15258 = ('poly '`( intList2QidList(NL) '`) attrSet2QidList(AtS)) . 15259 eq attrSet2QidList((strat(NL) AtS)) 15260 = ('strat '`( intList2QidList(NL) '`) attrSet2QidList(AtS)) . 15261 eq attrSet2QidList((memo AtS)) = ('memo attrSet2QidList(AtS)) . 15262 eq attrSet2QidList((prec(N) AtS)) 15263 = ('prec intList2QidList(N) attrSet2QidList(AtS)) . 15264 eq attrSet2QidList((gather(QIL) AtS)) 15265 = ('gather QIL attrSet2QidList(AtS)) . 15266 eq attrSet2QidList((format(QIL) AtS)) 15267 = ('format QIL attrSet2QidList(AtS)) . 15268 eq attrSet2QidList((ctor AtS)) = ('ctor attrSet2QidList(AtS)) . 15269 eq attrSet2QidList((frozen(NL) AtS)) 15270 = ('frozen '`( intList2QidList(NL) '`) attrSet2QidList(AtS)) . 15271 eq attrSet2QidList((config AtS)) = ('config attrSet2QidList(AtS)) . 15272 eq attrSet2QidList((object AtS)) = ('object attrSet2QidList(AtS)) . 15273 eq attrSet2QidList((msg AtS)) = ('msg attrSet2QidList(AtS)) . 15274 eq attrSet2QidList((special(HkL) AtS)) 15275 = ('special '`( hookList2QidList(HkL) '`) attrSet2QidList(AtS)) . 15276 eq attrSet2QidList((none).AttrSet) = nil . 15277 eq attrSet2QidList((metadata(St) AtS)) = (('metadata qid("\"" + St + "\"")) attrSet2QidList(AtS)) . 15278 eq attrSet2QidList((nonexec AtS)) = ('nonexec attrSet2QidList(AtS)) . 15279 eq attrSet2QidList((variant AtS)) = ('variant attrSet2QidList(AtS)) . 15280 15281 eq hookList2QidList((id-hook(QI, QIL) HkL)) 15282 = ('id-hook QI '`, '`( QIL '`) hookList2QidList(HkL)) . 15283 eq hookList2QidList((op-hook(QI, QI', QIL, QI'') HkL)) 15284 = ('op-hook QI '`( QI' ': QIL '-> QI'' '`) hookList2QidList(HkL)) . 15285 eq hookList2QidList((term-hook(QI, T) HkL)) 15286 = ('term-hook '`( QI '`, termList2QidList(T) '`) hookList2QidList(HkL)) . 15287 15288 eq termList2QidList(QI) = QI . 15289 eq termList2QidList(F[TL]) = (F '`( termList2QidList(TL) '`)) . 15290 ceq termList2QidList((T, TL)) 15291 = (termList2QidList(T) '`, termList2QidList(TL)) 15292 if TL =/= empty . 15293 15294 eq intList2QidList((N NL)) = (qid(string(N, 10)) intList2QidList(NL)) . 15295 eq intList2QidList(nil) = nil . 15296 15297 eq typeList2QidList(Ty TyL) = type2qid(Ty) typeList2QidList(TyL) . 15298 eq typeList2QidList(nil) = nil . 15299 15300*** Let us now give the equations for \texttt{setUpModExpDeps} on the 15301*** renaming module expression. Given a module expression of the form 15302*** \verb~ME *< RS >~ such that \texttt{ME} is in the database, we just need 15303*** to add \verb~ME *< RS >~ to the set of names of the modules depending on 15304*** \texttt{ME}. In this way, if \texttt{ME} is redefined or removed from the 15305*** database, \verb~ME *< RS >~ will be removed as well. 15306 15307 eq setUpModExpDeps(ME * (RS), 15308 db(< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, 15309 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 15310 = db(< ME ; DT ; U ; U' ; M ; VDS ; MNS . ME * (RS) ; VES > MIS, 15311 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . 15312 eq setUpModExpDeps(ME * (RS), 15313 db(< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, 15314 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 15315 = db(< ME ; DM ; U ; U' ; M ; VDS ; MNS . ME * (RS) ; VES > MIS, 15316 MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . 15317 ceq setUpModExpDeps(ME * (RS), DB) 15318 = warning(DB, '\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n) 15319 if not unitInDb(ME, DB) . 15320 15321*** The definition of the \texttt{prepHeader} function on a renaming module 15322*** expression must take into account the possibility of having parameterized 15323*** sorts or parameterized class names in the maps of a renaming module 15324*** expression. The preparation of a renaming module expression must take 15325*** into account this fact and prepare accordingly all parameterized sorts and 15326*** classes appearing in it. 15327 15328 op prepare : RenamingSet Set{Tuple{ViewExp,ViewExp}} -> RenamingSet . 15329 15330 op prepare : TypeList Set{Tuple{ViewExp,ViewExp}} -> TypeList . 15331 15332 eq prepModExp(ME * (RS), VEPS) 15333 = _*`(_`)(prepModExp(ME, VEPS), prepare(RS, VEPS)) . 15334 15335*** For example, for sort maps the equation is as follows. 15336 15337 eq prepare((sort S to S'), VEPS) 15338 = (sort prepSort(S, VEPS) to prepSort(S', VEPS)) . 15339 eq prepare(((sort S to S'), RS), VEPS) 15340 = ((sort prepSort(S, VEPS) to prepSort(S', VEPS)), 15341 prepare(RS, VEPS)) . 15342 15343 15344 eq prepare((class S to S'), VEPS) 15345 = (class prepSort(S, VEPS) to prepSort(S', VEPS)) . 15346 eq prepare(((class S to S'), RS), VEPS) 15347 = ((class prepSort(S, VEPS) to prepSort(S', VEPS)), 15348 prepare(RS, VEPS)) . 15349 eq prepare((attr QI . S to QI'), VEPS) 15350 = (attr QI . prepSort(S, VEPS) to QI') . 15351 eq prepare(((attr QI . S to QI'), RS), VEPS) 15352 = ((attr QI . prepSort(S, VEPS) to QI'), prepare(RS, VEPS)) . 15353 eq prepare((op F to F' [AtS]), VEPS) = (op F to F' [AtS]) . 15354 eq prepare(((op F to F' [AtS]), RS), VEPS) 15355 = ((op F to F' [AtS]), prepare(RS, VEPS)) . 15356 eq prepare((op F : TyL -> Ty to F' [AtS]), VEPS) 15357 = (op F : prepare(TyL, VEPS) -> prepSort(Ty, VEPS) to F' [AtS]) . 15358 eq prepare(((op F : TyL -> Ty to F' [AtS]), RS), VEPS) 15359 = (op F : prepare(TyL, VEPS) -> prepSort(Ty, VEPS) to F' [AtS], 15360 prepare(RS, VEPS)) . 15361 eq prepare((label L to L'), VEPS) = (label L to L') . 15362 eq prepare(((label L to L'), RS), VEPS) 15363 = ((label L to L'), prepare(RS, VEPS)) . 15364 eq prepare((msg F to F'), VEPS) = (msg F to F') . 15365 eq prepare(((msg F to F'), RS), VEPS) 15366 = ((msg F to F'), prepare(RS, VEPS)) . 15367 eq prepare((msg F : TyL -> Ty to F'), VEPS) 15368 = (msg F : prepare(TyL, VEPS) -> prepSort(Ty, VEPS) to F') . 15369 eq prepare(((msg F : TyL -> Ty to F'), RS), VEPS) 15370 = ((msg F : prepare(TyL, VEPS) -> prepSort(Ty, VEPS) to F'), 15371 prepare(RS, VEPS)) . 15372 eq prepare((none).RenamingSet, VEPS) = none . 15373 15374 eq prepare((Ty TyL), VEPS) = (prepSort(Ty, VEPS) prepare(TyL, VEPS)) . 15375 eq prepare(nil, VEPS) = nil . 15376 15377 eq header2Qid(ME * (RS)) 15378 = qid(string(header2Qid(ME)) 15379 + " * (" + string(qidList2Qid(maps2QidList(RS))) + ")") 15380 [owise] . 15381 15382 ceq header2QidList(ME * (RS)) 15383 = (if QI == '\s then QIL QI else QIL QI '\s fi 15384 '* '\s '`( maps2QidList(RS) '`)) 15385 if QIL QI := header2QidList(ME) 15386 [owise] . 15387 15388endfm 15389 15390******************************************************************************* 15391 15392*** 15393*** The Union Module Expression 15394*** 15395 15396*** The syntax used for the union of module expressions is 15397 15398*** op _+_ : ModuleExpression ModuleExpression -> ModuleExpression 15399*** [assoc prec 42] . 15400 15401*** Its evaluation consists in generating a unit importing the two module 15402*** expressions given as arguments~\cite{Winkler91,OBJ92}. 15403 15404*** As we explained in Sections~\ref{instantiation} and~\ref{renaming} for the 15405*** cases of the instantiation and the renaming module expressions, 15406*** respectively, the declaration of any new kind of module expression must 15407*** come together with the definition of the functions \texttt{evalModExp}, 15408*** \texttt{header2QidList}, and \texttt{setUpModExpDeps} on the new 15409*** module operator. As discussed in Sections~\ref{instantiation} 15410*** and~\ref{parsing-unit-declarations}, equations for the \texttt{prepHeader} 15411*** and \texttt{parseModExp} functions have to be given as well. 15412 15413fmod UNION-EXPR is 15414 inc MOD-EXPR . 15415 pr INST-EXPR-EVALUATION . 15416 pr RENAMING-EXPR-EVALUATION . 15417 pr EVALUATION . 15418 15419 vars QI X : Qid . 15420 var PDL : ParameterDeclList . 15421 vars DB DB' DB'' : Database . 15422 vars T T' : Term . 15423 vars DT DT' : Default{Term} . 15424 var IL : ImportList . 15425 var VEPS : Set{Tuple{ViewExp,ViewExp}} . 15426 vars ME ME' ME'' ME3 : ModuleExpression . 15427 vars PU PU' U U' U'' U3 DM DM' : Module . 15428 vars M M' M'' M3 : Module . 15429 vars MNS MNS' MNS'' MNS3 MNS4 MNS5 : Set{ModuleName} . 15430 vars VES VES' VES'' : Set{ViewExp} . 15431 vars PDS PDS' PDS'' : Set{ParameterDecl} . 15432 vars MIS MIS' : Set{ModuleInfo} . 15433 var VIS : Set{ViewInfo} . 15434 vars QIL QIL' : QidList . 15435 var VDS VDS' : OpDeclSet . 15436 var B : Bool . 15437 var MAPS : RenamingSet . 15438 15439*** As mentioned above, the evaluation of a union module expression consists 15440*** in the creation of a new unit, with such a module expression as name, 15441*** which imports the two module expressions being united. Note, however, 15442*** that the unit being created has to be of the right type. The new unit 15443*** will be generated having one type or another, depending on the types of 15444*** the arguments of the union module expression. 15445 15446*** The function \texttt{rightEmptyModule} generates an empty unit of the 15447*** lowest of the sorts of its two arguments. In case of having a nonstructured 15448*** module as argument, the corresponding structured one is considered. If one 15449*** of the two module expressions corresponds to a theory, then a theory is 15450*** generated, and the lowest sort is taken between the sort of such a theory 15451*** and the \texttt{Module} sort immediately above the sort of the other unit; 15452*** that is, sorts \texttt{FModule}, \texttt{SModule}, or \texttt{OModule} are 15453*** considered to do the comparison. 15454 15455---- ceq evalModExpAux(ME + ME', PDL, DB) 15456---- = if unitInDb(ME'' + ME3, DB'') or-else not (unitInDb(ME'', DB'') and-then unitInDb(ME3, DB'')) 15457---- then < DB'' ; ME'' + ME3 > 15458---- else < evalModule( 15459---- addImports(including ME'' . including ME3 ., 15460---- setName( 15461---- rightEmptyModule( 15462---- getTopModule(ME'', DB''), 15463---- getTopModule(ME3, DB'')), 15464---- ME'' + ME3)), 15465---- none, 15466---- DB'') ; 15467---- ME'' + ME3 > 15468---- fi 15469---- if < DB' ; ME3 > := evalModExpAux(ME', PDL, DB) 15470---- /\ < DB'' ; ME'' > := evalModExpAux(ME, PDL, DB') . 15471 15472 ceq evalModExp(ME + ME', PDL, DB) 15473 = if unitInDb(ME'', DB') or-else not summandsInDB(ME'', DB') 15474 then < DB' ; ME'' > 15475 else < evalModule( 15476 addImports(unfoldSummands(ME''), 15477 setName(rightEmptyModule(ME'', DB'), ME'')), 15478 none, 15479 DB') 15480 ; ME'' > 15481 fi 15482 if < DB' ; ME'' > := evalModExp+(ME + ME', PDL, DB) . 15483 15484 op summandsInDB : ModuleExpression Database -> Bool . 15485 eq summandsInDB(ME + ME', DB) 15486 = summandsInDB(ME, DB) and-then summandsInDB(ME', DB) . 15487 eq summandsInDB(ME, DB) = unitInDb(ME, DB) [owise] . 15488 15489 op unfoldSummands : ModuleExpression -> ImportList . 15490 eq unfoldSummands(ME + ME') = unfoldSummands(ME) unfoldSummands(ME') . 15491 eq unfoldSummands(ME) = (including ME .) [owise] . 15492 15493 op rightEmptyModule : ModuleExpression Database -> Module . 15494 eq rightEmptyModule(ME, DB) = emptyModule(kindOfModule(ME, DB)) . 15495 15496 op evalModExp+ : ModuleExpression ParameterDeclList Database -> Tuple{Database, ModuleExpression} . 15497 eq evalModExp+(ME + ME', PDL, DB) 15498 = < database(evalModExp+(ME', PDL, database(evalModExp+(ME, PDL, DB)))) 15499 ; modExp(evalModExp+(ME', PDL, database(evalModExp+(ME, PDL, DB)))) 15500 + modExp(evalModExp+(ME, PDL, DB)) > . 15501 eq evalModExp+(ME, PDL, DB) = evalModExp(ME, PDL, DB) [owise] . 15502 15503 op kindOfModule : ModuleExpression Database -> Qid . 15504 eq kindOfModule(ME + ME', DB) = greaterLowest(kindOfModule(ME, DB), kindOfModule(ME', DB)) . 15505 eq kindOfModule(ME, DB) = kindOfModule(getTopModule(ME, DB)) [owise] . 15506 15507 op kindOfModule : Module -> Qid . 15508 eq kindOfModule(U:OModule) 15509 = if U:OModule :: FModule 15510 then 'fmod 15511 else if U:OModule :: SModule 15512 then 'mod 15513 else 'omod 15514 fi 15515 fi . 15516 eq kindOfModule(U:OTheory) 15517 = if U:OTheory :: FTheory 15518 then 'fmod 15519 else if U:OTheory :: STheory 15520 then 'mod 15521 else 'omod 15522 fi 15523 fi . 15524 eq kindOfModule(unitError(QIL)) = qidError(QIL) . 15525 15526 op greaterLowest : Qid Qid ~> Qid [comm] . 15527 eq greaterLowest('fmod, 'fmod) = 'fmod . 15528 eq greaterLowest('fmod, 'fth) = 'fth . 15529 eq greaterLowest('fth, 'fth) = 'fth . 15530 eq greaterLowest('mod, 'fmod) = 'mod . 15531 eq greaterLowest('mod, 'mod) = 'mod . 15532 eq greaterLowest('mod, 'fth) = 'th . 15533 eq greaterLowest('fmod, 'th) = 'th . 15534 eq greaterLowest('mod, 'th) = 'th . 15535 eq greaterLowest('th, 'th) = 'th . 15536 eq greaterLowest('omod, 'fmod) = 'omod . 15537 eq greaterLowest('omod, 'mod) = 'omod . 15538 eq greaterLowest('omod, 'omod) = 'omod . 15539 eq greaterLowest('omod, 'fth) = 'oth . 15540 eq greaterLowest('omod, 'th) = 'oth . 15541 eq greaterLowest('omod, 'oth) = 'oth . 15542 eq greaterLowest('fmod, 'oth) = 'oth . 15543 eq greaterLowest('mod, 'oth) = 'oth . 15544 eq greaterLowest('oth, 'th) = 'oth . 15545 eq greaterLowest('oth, 'fth) = 'oth . 15546 eq greaterLowest('oth, 'oth) = 'oth . 15547 15548 op emptyModule : Qid ~> Module . 15549 eq emptyModule('fmod) = emptyFModule . 15550 eq emptyModule('fth) = emptyFTheory . 15551 eq emptyModule('mod) = emptySModule . 15552 eq emptyModule('th) = emptySTheory . 15553 eq emptyModule('omod) = emptyOModule . 15554 eq emptyModule('oth) = emptyOTheory . 15555 15556---- op rightEmptyModule : Module Module -> Module [comm] . 15557---- 15558---- eq rightEmptyModule(U1:FModule, U2:FModule) = emptyFModule . 15559---- eq rightEmptyModule(U1:FModule, U2:FTheory) = emptyFTheory . 15560---- eq rightEmptyModule(U1:FTheory, U2:FModule) = emptyFTheory . 15561---- eq rightEmptyModule(U1:FTheory, U2:FTheory) = emptyFTheory . 15562---- ceq rightEmptyModule(U1:SModule, U2:SModule) = emptySModule if not U1:SModule :: FModule or not U2:SModule :: FModule . 15563---- ceq rightEmptyModule(U1:STheory, U2:SModule) = emptySTheory if not U1:STheory :: FTheory or not U2:SModule :: FModule . 15564---- ceq rightEmptyModule(U1:SModule, U2:STheory) = emptySTheory if not U1:SModule :: FModule or not U2:STheory :: FTheory . 15565---- ceq rightEmptyModule(U1:STheory, U2:STheory) = emptySTheory if not U1:STheory :: FTheory or not U2:STheory :: FTheory . 15566---- ceq rightEmptyModule(U1:OModule, U2:OModule) = emptyOModule if not U1:OModule :: SModule or not U2:OModule :: SModule . 15567---- ceq rightEmptyModule(U1:OTheory, U2:OModule) = emptyOTheory if not U1:OTheory :: STheory or not U2:OModule :: SModule . 15568---- ceq rightEmptyModule(U1:OModule, U2:OTheory) = emptyOTheory if not U1:OModule :: SModule or not U2:OTheory :: STheory . 15569---- ceq rightEmptyModule(U1:OTheory, U2:OTheory) = emptyOTheory if not U1:OTheory :: STheory or not U2:OTheory :: STheory . 15570---- eq rightEmptyModule(unitError(QIL), U) = unitError(QIL) . 15571---- eq rightEmptyModule(U, unitError(QIL)) = unitError(QIL) . 15572---- eq rightEmptyModule(unitError(QIL), unitError(QIL')) = unitError(QIL QIL') . 15573 15574*** As pointed out in Section~\ref{module-names}, for each new module 15575*** expression operator being introduced, we need to add equations for the 15576*** \texttt{header2Qid} function. For the union module expression we only 15577*** need the following equation: 15578 15579 eq header2Qid(ME + ME') 15580 = qidList2Qid(header2QidList(ME) '+ header2QidList(ME')) . 15581 eq header2Qid(_*`(_`)(ME + ME', MAPS)) 15582 = qid("(" + string(header2Qid(ME + ME')) + ")" 15583 + " * (" + string(qidList2Qid(maps2QidList(MAPS))) + ")") . 15584 15585 eq header2QidList(ME + ME') 15586 = (header2QidList(ME) '+ header2QidList(ME')) . 15587 ceq header2QidList(_*`(_`)(ME + ME', MAPS)) 15588 = (if QI == '\s then '`( QIL '`) QI else '`( QIL QI '`) '\s fi 15589 '* '\s '`( maps2QidList(MAPS) '`)) 15590 if QIL QI := header2QidList(ME + ME') . 15591 15592*** Given a module 15593*** expression of the form \verb~ME + ME'~ such that \texttt{ME} and 15594*** \texttt{ME'} are in the database, we need to add \verb~ME + ME'~ to 15595*** the set of names of the modules depending on \texttt{ME} and \texttt{ME'}. 15596*** In this way, if \texttt{ME} or \texttt{ME'} are redefined or removed from 15597*** the database, \verb~ME + ME'~ will be removed as well. 15598 15599 op setUpModExpDepsAux : ModuleExpression ModuleExpression Database -> Database . 15600 eq setUpModExpDeps(ME + ME', DB) = setUpModExpDepsAux(ME + ME', ME + ME', DB) . 15601 15602 eq setUpModExpDepsAux(ME, ME' + ME'', DB) 15603 = setUpModExpDepsAux(ME, ME', setUpModExpDepsAux(ME, ME'', DB)) . 15604 eq setUpModExpDepsAux(ME, ME', 15605 db(< ME' ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL)) 15606 = db(< ME' ; DT ; U ; U' ; M ; VDS ; MNS . ME ; VES > MIS, MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) 15607 [owise] . 15608 eq setUpModExpDepsAux(ME, ME', 15609 db(< ME' ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL)) 15610 = db(< ME' ; DM ; U ; U' ; M ; VDS ; MNS . ME ; VES > MIS, MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) 15611 [owise] . 15612 15613---( eq setUpModExpDeps((ME + ME'), 15614 db((< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > 15615 < ME' ; DT' ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS), 15616 MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL)) 15617 = db((< ME ; DT ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES > 15618 < ME' ; DT' ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' > 15619 MIS), 15620 MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) . 15621 eq setUpModExpDeps((ME + ME'), 15622 db((< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > 15623 < ME' ; DM ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS), 15624 MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL)) 15625 = db((< ME ; DT ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES > 15626 < ME' ; DM ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' > 15627 MIS), 15628 MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) . 15629 eq setUpModExpDeps((ME + ME'), 15630 db((< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > 15631 < ME' ; DT ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS), 15632 MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL)) 15633 = db((< ME ; DM ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES > 15634 < ME' ; DT ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' > 15635 MIS), 15636 MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) . 15637 eq setUpModExpDeps((ME + ME'), 15638 db((< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > 15639 < ME' ; DM' ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS), 15640 MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL)) 15641 = db((< ME ; DM ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES > 15642 < ME' ; DM' ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' > 15643 MIS), 15644 MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) . 15645 ceq setUpModExpDeps((ME + ME'), DB) 15646 = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n)) 15647 if not unitInDb(ME, DB) . 15648 ceq setUpModExpDeps((ME + ME'), DB) 15649 = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME') 'not 'in 'database. '\n)) 15650 if not unitInDb(ME', DB) . 15651---) 15652 15653*** The \texttt{prepHeader} function on a union module expression makes 15654*** recursive calls with each of the module expressions given as arguments. 15655 15656 eq prepModExp(ME + ME', VEPS) 15657 = prepModExp(ME, VEPS) + prepModExp(ME', VEPS) . 15658 15659*** Finally, the equation for the \texttt{parseModExp} function is as follows: 15660 15661 eq labelInModExp(X, ME + ME') 15662 = labelInModExp(X, ME) or-else labelInModExp(X, ME') . 15663endfm 15664 15665******************************************************************************* 15666 15667*** 15668*** The $n$-tuple Module Expression 15669*** 15670 15671*** The syntax used for the $n$-tuple module expression is as follows: 15672 15673*** op TUPLE[_] : Token -> ModuleExpression . 15674 15675*** Its evaluation consists in the generation of a parameterized functional 15676*** module with the number of \texttt{TRIV} parameters specified by the 15677*** argument. A sort for tuples of such size, and the corresponding constructor 15678*** and selector operators, are also defined. Note that the \texttt{TRIV} 15679*** theory is predefined in Full Maude (see Sections~\ref{main-module} 15680*** and~\ref{non-built-in-predefined}). For example, the module expression 15681*** \verb~TUPLE[3]~ produces the following module. 15682 15683*** fmod TUPLE[3][C1 :: TRIV, C2 :: TRIV, C3 :: TRIV] is 15684*** sorts 3Tuple . 15685*** op (_,_,_) : Elt.C1 Elt.C2 Elt.C3 -> 3Tuple . 15686*** op p1_ : 3Tuple -> Elt.C1 . 15687*** op p2_ : 3Tuple -> Elt.C2 . 15688*** op p3_ : 3Tuple -> Elt.C3 . 15689*** var E1 : Elt.C1 . 15690*** var E2 : Elt.C2 . 15691*** var E3 : Elt.C3 . 15692*** eq p1(E1, E2, E3) = E1 . 15693*** eq p2(E1, E2, E3) = E2 . 15694*** eq p3(E1, E2, E3) = E3 . 15695*** endfm 15696 15697*** Even though the $n$-tuple module expression is in principle of a completely 15698*** different nature, the way of handling it is the same as the way of handling 15699*** any other module expression. Its evaluation produces a new unit, a 15700*** parameterized functional module in this case, wtupleParList(N)ith the module expression as 15701*** name. New equations defining the semantics of functions 15702*** \texttt{evalModExp}, \texttt{header2QidList}, 15703*** \texttt{setUpModExpDeps}, \texttt{prepHeader}, and 15704*** \texttt{parseModExp} are given for this module expression. 15705 15706 15707fmod N-TUPLE-EXPR is 15708 inc MOD-EXPR . 15709 pr INST-EXPR-EVALUATION . 15710 pr EVALUATION . 15711 15712 vars N N' : NzNat . 15713 var PDL : ParameterDeclList . 15714 var DB : Database . 15715 var T : Term . 15716 var IL : ImportList . 15717 var VEPS : Set{Tuple{ViewExp,ViewExp}} . 15718 var X : Qid . 15719 var S : Sort . 15720 15721*** The equation for the \texttt{evalModExp} is reduced to the creation of a 15722*** module as indicated above. Some auxiliary functions are defined in order 15723*** to generate the different declarations in the module. 15724 15725 op tupleParList : NzNat -> ParameterDeclList . 15726 op tupleImportList : NzNat -> ImportList . 15727 op createCopyPars : NzNat Database -> Database . 15728 op tupleOps : NzNat -> OpDeclSet . 15729 op tupleOpsCtor : NzNat -> OpDecl . 15730 op tupleOpsCtorName : NzNat -> String . 15731 op tupleOpsCtorArity : NzNat -> QidList . 15732 op tupleOpsSelectors : NzNat NzNat -> OpDeclSet . 15733 op tupleEqSet : NzNat -> EquationSet . 15734 op tupleEqSetAux : NzNat Term -> EquationSet . 15735 op tupleTermArgs : NzNat -> TermList . 15736 ops tupleSort tupleSortAux : NzNat -> Sort . 15737 15738 eq evalModExp(TUPLE[N], PDL, DB) 15739 = if unitInDb(TUPLE[N], DB) 15740 then < DB ; TUPLE[N] > 15741 else < evalModule( 15742 fmod TUPLE[N]{tupleParList(N)} is 15743 nil ---- tupleImportList(N) 15744 sorts tupleSort(N) . 15745 none 15746 tupleOps(N) 15747 none 15748 tupleEqSet(N) 15749 endfm, 15750 none, 15751 createCopyPars(N, DB)) ; 15752 TUPLE[N] > 15753 fi . 15754 15755 eq createCopyPars(N, DB) 15756 = if N == 1 15757 then createCopy((qid("C" + string(N, 10)) :: 'TRIV), DB) 15758 else createCopyPars(_-_(N, 1), 15759 createCopy((qid("C" + string(N, 10)) :: 'TRIV), DB)) 15760 fi . 15761 15762 eq tupleParList(N) 15763 = if N == 1 15764 then (qid("C" + string(N, 10)) :: 'TRIV) 15765 else (tupleParList(_-_(N, 1)), (qid("C" + string(N, 10)) :: 'TRIV)) 15766 fi . 15767 15768 eq tupleImportList(N) 15769 = if N == 1 15770 then (including pd(qid("C" + string(N, 10)) :: 'TRIV) .) 15771 else (tupleImportList(_-_(N, 1)) 15772 (including pd(qid("C" + string(N, 10)) :: 'TRIV) .)) 15773 fi . 15774 15775 eq tupleSort(N) = makeSort('Tuple, tupleSortAux(N)) . 15776 15777 eq tupleSortAux(N) 15778 = if N == 1 15779 then qid("C" + string(N, 10)) 15780 else (tupleSortAux(_-_(N, 1)), qid("C" + string(N, 10))) 15781 fi . 15782 15783 eq tupleOps(N) 15784 = (tupleOpsCtor(N) tupleOpsSelectors(N, N)) . 15785 15786 eq tupleOpsCtor(N) 15787 = (op qid("(" + tupleOpsCtorName(N) + ")") : 15788 tupleOpsCtorArity(N) -> tupleSort(N) [none] .) . 15789 15790 eq tupleOpsCtorName(N) 15791 = if N == 1 15792 then "_" 15793 else "_," + tupleOpsCtorName(_-_(N, 1)) 15794 fi . 15795 15796 eq tupleOpsCtorArity(N) 15797 = if N == 1 15798 then qid("C" + string(N, 10) + "$Elt") 15799 else tupleOpsCtorArity(_-_(N, 1)) qid("C" + string(N, 10) + "$Elt") 15800 fi . 15801 15802 eq tupleOpsSelectors(N, N') 15803 = if N == 1 15804 then (op qid("p" + string(N, 10) + "_") : 15805 tupleSort(N') -> qid("C" + string(N, 10) + "$Elt") [none] .) 15806 else (tupleOpsSelectors(_-_(N, 1), N') 15807 (op qid("p" + string(N, 10) + "_") : 15808 tupleSort(N') -> qid("C" + string(N, 10) + "$Elt") [none] .)) 15809 fi . 15810 15811 eq tupleEqSet(N) 15812 = tupleEqSetAux(N, 15813 (qid("(" + tupleOpsCtorName(N) + ")") [ tupleTermArgs(N) ])) . 15814 15815 eq tupleTermArgs(N) 15816 = if N == 1 15817 then qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt") 15818 else (tupleTermArgs(_-_(N, 1)), 15819 qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt")) 15820 fi . 15821 15822 eq tupleEqSetAux(N, T) 15823 = if N == 1 15824 then (eq qid("p" + string(N, 10) + "_")[T] 15825 = qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt") 15826 [none] .) 15827 else (tupleEqSetAux(_-_(N, 1), T) 15828 (eq qid("p" + string(N, 10) + "_")[T] 15829 = qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt") 15830 [none] .)) 15831 fi . 15832 15833*** The equations for the \texttt{header2QidList}, 15834*** \texttt{parseModExp}, \texttt{prepHeader}, and 15835*** \texttt{setUpModExpDeps} functions on the $n$-tuple module 15836*** expression are as follows: 15837 15838 eq header2Qid(TUPLE[N]) = qid("TUPLE[" + string(N, 10) + "]") . 15839 eq header2QidList(TUPLE[N]) = ('TUPLE '`[ qid(string(N, 10)) '`]) . 15840 15841 eq prepModExp(TUPLE[N], VEPS) = TUPLE[N] . 15842 15843 eq setUpModExpDeps(TUPLE[N], DB) = DB . 15844 15845endfm 15846 15847fmod N-POWER-EXPR is 15848 inc MOD-EXPR . 15849 pr INST-EXPR-EVALUATION . 15850 pr EVALUATION . 15851 15852 vars N N' : NzNat . 15853 var PDL : ParameterDeclList . 15854 var DB : Database . 15855 var T : Term . 15856 var IL : ImportList . 15857 var VEPS : Set{Tuple{ViewExp,ViewExp}} . 15858 var X : Qid . 15859 var S : Sort . 15860 15861*** As for TUPLE, the equation for the \texttt{evalModExp} is reduced to the 15862*** creation of a new module. A module expression POWER[n]{Nat} produces a 15863*** module 15864*** 15865*** fmod POWER[n]{X :: TRIV} is 15866*** inc TUPLE[n]{X, X, ..., X} . 15867*** endfm 15868*** 15869*** which is then instantiated by the Nat view. 15870 15871*** Some auxiliary functions are defined in order 15872*** to generate the different declarations in the module. 15873 15874 op powImportList : NzNat -> ImportList . 15875 op powTupleImportation : NzNat -> ViewExp . 15876 15877 eq evalModExp(POWER[N], PDL, DB) 15878 = if unitInDb(POWER[N], DB) 15879 then < DB ; POWER[N] > 15880 else < evalModule( 15881 fmod POWER[N]{'X :: 'TRIV} is 15882 powImportList(N) 15883 sorts none . 15884 none 15885 none 15886 none 15887 none 15888 endfm, 15889 none, 15890 createCopy('X :: 'TRIV, DB)) ; 15891 POWER[N] > 15892 fi . 15893 15894 eq powImportList(N) 15895 = (including TUPLE[N]{powTupleImportation(N)} .) . 15896 15897 eq powTupleImportation(N) 15898 = if N == 1 15899 then 'X 15900 else ('X, powTupleImportation(sd(N, 1))) 15901 fi . 15902 15903*** The equations for the \texttt{header2QidList}, 15904*** \texttt{parseModExp}, \texttt{prepHeader}, and 15905*** \texttt{setUpModExpDeps} functions on the $n$-tuple module 15906*** expression are as follows: 15907 15908 eq header2Qid(POWER[N]) = qid("POWER[" + string(N, 10) + "]") . 15909 eq header2QidList(POWER[N]) = ('POWER '`[ qid(string(N, 10)) '`]) . 15910 15911 eq prepModExp(POWER[N], VEPS) = POWER[N] . 15912 15913 eq setUpModExpDeps(POWER[N], DB) = DB . 15914 15915endfm 15916 15917******************************************************************************* 15918 15919*** 15920*** 8 Input/Output Processing 15921*** 15922 15923*** In this section we discuss how the preterm resulting from the call to the 15924*** function \texttt{metaParse} with the input and the top-level signature of 15925*** Full Maude is transformed into a term of sort \texttt{Module}, representing 15926*** a preunit or a term of sort \texttt{PreView}. In the case of commands, 15927*** they are evaluated giving the corresponding results in the appropriate 15928*** form. 15929 15930*** 15931*** 8.1 Input Parsing 15932*** 15933 15934*** Let us recall here the example presented in Section~\ref{bubbles}. Calling 15935*** \texttt{metaParse} with the module \texttt{NAT3} given there and the 15936*** signature of Full Maude presented in Section~\ref{sec:signature}, we 15937*** obtain the following term. 15938 15939*** 'fmod_is_endfm[ 15940*** 'token[{''NAT3}'Qid], 15941*** '__['sort_.['token[{''Nat3}'Qid]], 15942*** '__['op_:_->_.['token[{''s_}'Qid], 15943*** 'neTokenList[{''Nat3}'Qid], 15944*** 'token[{''Nat3}'Qid]], 15945*** '__['op_:`->_.['token[{''0}'Qid], 15946*** 'token[{''Nat3}'Qid]], 15947*** 'eq_=_.['bubble['__[{''s}'Qid, {''s}'Qid, 15948*** {''s}'Qid, {''0}'Qid]], 15949*** 'bubble[{''0}'Qid]]]]]] 15950 15951*** Given each one of the subterms representing declarations in terms 15952*** representing modules as the previous one, the function \texttt{parseDecl} 15953*** generates the corresponding declaration, with no bubbles in it, and the 15954*** corresponding predeclaration, with the bubbles appearing in the term. For 15955*** example, for the term 15956*** 15957*** 'op_:_->_.['token[{''s_}'Qid], 15958*** 'neTokenList[{''Nat3}'Qid], 15959*** 'token[{''Nat3}'Qid]] 15960*** 15961*** the following operator declaration is generated: 15962*** 15963*** op 's_ : 'Nat3 -> 'Nat3 [none] . 15964*** 15965*** Note that in this case, since the operator is declared without identity 15966*** element (the only place a bubble might appear), the declaration and the 15967*** predeclaration generated by \texttt{parseDecl} coincide. 15968 15969*** In the following sections we shall see how this approach is followed for 15970*** declarations appearing in units and in views. 15971 15972*** 15973*** 8.1.1 Parsing of Module Declarations 15974*** 15975 15976*** The \texttt{parseDecl} function takes a term (which corresponds to a 15977*** declaration to be parsed), a preunit (to which the parsed declaration with 15978*** its bubbles in it will be added), and a unit (to which the parsed 15979*** declaration without bubbles will be added to build up the signature). For 15980*** example, a term corresponding to an unconditional equation, that is, a term 15981*** of the form \verb~'eq_=_.[T, T']~ will be added to the set of equations of 15982*** the preunit as \verb~eq T = T' .~, but nothing will be added to the unit. 15983*** Note that according to the signature used in the call to 15984*** \texttt{metaParse} (see Sections~\ref{sec:signature} 15985*** and~\ref{main-module}), \texttt{T} and \texttt{T'} are bubbles. 15986*** Declarations of sorts, subsort relations, operators, classes, subclass 15987*** relations, messages, and variables will be added to both of them. In the 15988*** case of operator declarations, identity element attributes, which in 15989*** general can be terms, are not included in the added declaration. 15990 15991*** As in Core Maude, declarations in a module can be given in any order, and 15992*** therefore we follow a two-step approach consisting in first building the 15993*** signature to parse the bubbles, and then generating the unit without 15994*** bubbles in it. It could be different for other languages. For example, in 15995*** some languages we may be able to assume that each operator and sort has 15996*** been defined before being used, allowing then an incremental processing of 15997*** the input. 15998 15999---- fmod MAYBE{X :: TRIV} is 16000---- sort Maybe{X} . 16001---- subsort X$Elt < Maybe{X} . 16002---- op maybe : -> Maybe{X} . 16003---- endfm 16004 16005fmod UNIT-DECL-PARSING is 16006 pr DATABASE . 16007 pr MOVE-DOWN . 16008 pr INST-EXPR-EVALUATION . 16009 pr RENAMING-EXPR-EVALUATION . 16010 pr UNION-EXPR . 16011 pr N-TUPLE-EXPR . 16012 pr N-POWER-EXPR . 16013 pr DEFAULT-VALUE{Term} . 16014 pr META-FULL-MAUDE-SIGN . 16015 pr UNIT-BUBBLE-PARSING . 16016 16017 vars PU U : Module . 16018 vars T T' T'' T''' T3 T4 : Term . 16019 vars QI QI' QI'' L F : Qid . 16020 vars QIL QIL' : QidList . 16021 vars S S' : Sort . 16022 vars SS SS' : TypeSet . 16023 vars TyL TyL' : TypeList . 16024 var TSL : TypeSetList . 16025 var AtS : AttrSet . 16026 vars TL TL' TL'' : TermList . 16027 var Ct : Constant . 16028 var VDS : OpDeclSet . 16029 vars Ty Tp : Type . 16030 var N : Nat . 16031 var DT : Default{Term} . 16032 16033*** Similarly, auxiliary functions parsing other elements in units 16034*** are defined. 16035 16036 op parsePreAttrs : Term Nat -> AttrSet . 16037 op parsePreHookList : Term -> HookList . 16038 op parseVars : QidList [Type] -> OpDeclSet . 16039 op parseSubsortRel : Term -> TypeListSet . 16040 16041 op parseAttrDeclList : Term -> AttrDeclSet . 16042 op unfoldOpDecl : QidList TypeList Sort AttrSet -> OpDeclSet . 16043 op unfoldMultipleMsgDecl : QidList TypeList Sort -> MsgDeclSet . 16044 op unfoldSubsortRel : TypeSetList ~> SubsortDeclSet . 16045 op unfoldSubclassRel : TypeSetList ~> SubclassDeclSet . 16046 16047 eq parseSubsortRel('_<_[T, T']) 16048 = _l_(parseSortSet(T), parseSubsortRel(T')) . 16049 eq parseSubsortRel('__[T, T']) = parseSortSet('__[T, T']) . 16050 eq parseSubsortRel('sortToken[T]) = downQid(T) . 16051 eq parseSubsortRel('_`{_`}['sortToken[T], T']) 16052 = makeSort(downQid(T), parseParameterList(T')) . 16053 eq parseSubsortRel('_`{_`}['_`{_`}[T, T'], T'']) 16054 = makeSort(parseSubsortRel('_`{_`}[T, T']), parseParameterList(T'')) . 16055 16056 eq unfoldOpDecl((QI QIL), TyL, Ty, AtS) 16057 = ((op QI : TyL -> Ty [AtS] .) unfoldOpDecl(QIL, TyL, Ty, AtS)) . 16058 eq unfoldOpDecl(nil, TyL, Ty, AtS) = none . 16059 16060 eq unfoldMultipleMsgDecl((QI QIL), TyL, Ty) 16061 = ((msg QI : TyL -> Ty .) unfoldMultipleMsgDecl(QIL, TyL, Ty)) . 16062 eq unfoldMultipleMsgDecl(nil, TyL, Ty) = none . 16063 16064 eq unfoldSubsortRel(_l_((S ; SS), (S' ; SS'), TSL)) 16065 = ((subsort S < S' .) 16066 unfoldSubsortRel(_l_(S, SS')) 16067 unfoldSubsortRel(_l_(SS, (S' ; SS'))) 16068 unfoldSubsortRel(_l_((S' ; SS'), TSL))) . 16069 eq unfoldSubsortRel(_l_(SS, none)) = none . 16070 eq unfoldSubsortRel(_l_(none, SS)) = none . 16071 eq unfoldSubsortRel(SS) = none . 16072 eq unfoldSubsortRel(qidError(QIL)) = subsortDeclError(QIL) . 16073 16074 eq unfoldSubclassRel(_l_((S ; SS), (S' ; SS'), TSL)) 16075 = ((subclass S < S' .) 16076 unfoldSubclassRel(_l_(S, SS')) 16077 unfoldSubclassRel(_l_(SS, (S' ; SS'))) 16078 unfoldSubclassRel(_l_((S' ; SS'), TSL))) . 16079 eq unfoldSubclassRel(_l_(SS, none)) = none . 16080 eq unfoldSubclassRel(_l_(none, SS)) = none . 16081 eq unfoldSubclassRel(SS) = none . 16082 eq unfoldSubclassRel(qidError(QIL)) = subclassDeclError(QIL) . 16083 16084 eq parseVars((QI QIL), Tp) 16085 = ((op QI : nil -> Tp [none] .) parseVars(QIL, Tp)) . 16086 eq parseVars(nil, Tp) = none . 16087 eq parseVars(QIL, qidError(QIL')) = opDeclError(QIL') . 16088 16089 eq parsePreAttrs('__[T, T'], N) 16090 = (parsePreAttrs(T, N) parsePreAttrs(T', N)) . 16091 eq parsePreAttrs('assoc.@Attr@, N) = assoc . 16092 eq parsePreAttrs('associative.@Attr@, N) = assoc . 16093 eq parsePreAttrs('comm.@Attr@, N) = comm . 16094 eq parsePreAttrs('commutative.@Attr@, N) = comm . 16095 eq parsePreAttrs('idem.@Attr@, N) = idem . 16096 eq parsePreAttrs('idempotent.@Attr@, N) = idem . 16097 eq parsePreAttrs('id:_[T], N) = id(T) . 16098 eq parsePreAttrs('identity:_[T], N) = id(T) . 16099 eq parsePreAttrs('left`id:_[T], N) = left-id(T) . 16100 eq parsePreAttrs('left`identity:_[T], N) = left-id(T) . 16101 eq parsePreAttrs('right`id:_[T], N) = right-id(T) . 16102 eq parsePreAttrs('right`identity:_[T], N) = right-id(T) . 16103 eq parsePreAttrs('poly`(_`)[T], N) = poly(parseInt(T)) . 16104 eq parsePreAttrs('strat`(_`)[T], N) = strat(parseInt(T)) . 16105 eq parsePreAttrs('strategy`(_`)[T], N) = strat(parseInt(T)) . 16106 eq parsePreAttrs('frozen.@Attr@, N) 16107 = if N == 0 16108 then none 16109 else frozen(from 1 to N list) 16110 fi . 16111 eq parsePreAttrs('frozen`(_`)[T], N) = frozen(parseInt(T)) . 16112 eq parsePreAttrs('memo.@Attr@, N) = memo . 16113 eq parsePreAttrs('memoization.@Attr@, N) = memo . 16114 eq parsePreAttrs('ctor.@Attr@, N) = ctor . 16115 eq parsePreAttrs('constructor.@Attr@, N) = ctor . 16116 eq parsePreAttrs('prec_['token[T]], N) = prec(parseNat(T)) . 16117 eq parsePreAttrs('gather`(_`)['neTokenList[T]], N) = gather(downQidList(T)) . 16118 eq parsePreAttrs('special`(_`)[T], N) = special(parsePreHookList(T)) . 16119 eq parsePreAttrs('format`(_`)['neTokenList[T]], N) = format(downQidList(T)) . 16120 eq parsePreAttrs('iter.@Attr@, N) = iter . 16121 eq parsePreAttrs('ditto.@Attr@, N) = ditto . 16122 eq parsePreAttrs('config.@Attr@, N) = config . 16123 eq parsePreAttrs('object.@Attr@, N) = object . 16124 eq parsePreAttrs('msg.@Attr@, N) = msg . 16125 eq parsePreAttrs('message.@Attr@, N) = msg . 16126 eq parsePreAttrs('metadata_['token[T]], N) = metadata(downString(downQid(T))) . 16127 eq parsePreAttrs('nonexec.@Attr@, N) = nonexec . 16128 eq parsePreAttrs('variant.@Attr@, N) = variant . 16129 16130 eq parsePreHookList('__[T, TL]) = parsePreHookList(T) parsePreHookList(TL) . 16131 eq parsePreHookList('id-hook_['token[T]]) = id-hook(downQid(T), nil) . 16132 eq parsePreHookList('id-hook_`(_`)['token[T], 'neTokenList[T']]) 16133 = id-hook(downQid(T), downQidList(T')) . 16134 eq parsePreHookList( 16135 'op-hook_`(_:_->_`)[ 16136 'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]]) 16137 = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) . 16138 eq parsePreHookList('op-hook_`(_:`->_`)['token[T], 'token[T'], 'token[T'']]) 16139 = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) . 16140 eq parsePreHookList( 16141 'op-hook_`(_:_~>_`)[ 16142 'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]]) 16143 = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) . 16144 eq parsePreHookList('op-hook_`(_:`~>_`)['token[T], 'token[T'], 'token[T'']]) 16145 = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) . 16146 eq parsePreHookList('term-hook_`(_`)['token[T], T']) 16147 = term-hook(downQid(T), T') . 16148 16149 eq parseAttrDeclList('_`,_[T, T']) 16150 = (parseAttrDeclList(T), parseAttrDeclList(T')) . 16151 eq parseAttrDeclList('_:_['token[T], T']) 16152 = (attr downQid(T) : parseType(T')) . 16153 16154*** Given a term representing a declaration or a predeclaration, the function 16155*** \texttt{parseDecl} must generate and update both the unit and the preunit 16156*** that it takes as arguments. Note that in the case of rules, for example, 16157*** only a prerule is generated. 16158 16159*** Since the preunit and the unit may be modified, they have to be returned as 16160*** a pair, which will be used to extract the corresponding arguments for the 16161*** following calls. Note that the \texttt{parseDecl} functions are in fact 16162*** partial functions. Each parsing function assumes that it is possible to 16163*** parse the given term. 16164 16165 sort ParseDeclResult . 16166 op <_;_;_> : Module Module OpDeclSet -> ParseDeclResult . 16167 op preModule : ParseDeclResult -> Module . 16168 op unit : ParseDeclResult -> Module . 16169 op vars : ParseDeclResult -> OpDeclSet . 16170 16171 eq preModule(< PU ; U ; VDS >) = PU . 16172 eq preModule(< unitError(QIL) ; V:[Module] ; V:[OpDeclSet] >) = unitError(QIL) . 16173 eq preModule(< V:[Module] ; unitError(QIL) ; V:[OpDeclSet] >) = unitError(QIL) . 16174 eq preModule(< V:[Module] ; V':[Module] ; opDeclError(QIL) >) = unitError(QIL) . 16175 eq unit(< PU ; U ; VDS >) = U . 16176 eq unit(< unitError(QIL) ; V':[Module] ; V:[OpDeclSet] >) = unitError(QIL) . 16177 eq unit(< V:[Module] ; unitError(QIL) ; V:[OpDeclSet] >) = unitError(QIL) . 16178 eq unit(< V:[Module] ; V':[Module] ; opDeclError(QIL) >) = unitError(QIL) . 16179 eq vars(< PU ; U ; VDS >) = VDS . 16180 eq vars(< unitError(QIL) ; V:[Module] ; V:[OpDeclSet] >) = opDeclError(QIL) . 16181 eq vars(< V:[Module] ; unitError(QIL) ; V:[OpDeclSet] >) = opDeclError(QIL) . 16182 eq vars(< V:[Module] ; V':[Module] ; opDeclError(QIL) >) = opDeclError(QIL) . 16183 16184 op parseDecl : Term Module Module OpDeclSet -> ParseDeclResult . 16185 16186*** changed 03/27/02 16187*** In the case of importation declarations, since internally only the 16188*** \texttt{including} mode is handled, all importations are generated in 16189*** this mode, independently of the keyword used in the input. 16190 16191 eq parseDecl('inc_.[T], PU, U, VDS) 16192 = parseDecl('including_.[T], PU, U, VDS) . 16193 eq parseDecl('ex_.[T], PU, U, VDS) 16194 = parseDecl('extending_.[T], PU, U, VDS) . 16195 eq parseDecl('pr_.[T], PU, U, VDS) 16196 = parseDecl('protecting_.[T], PU, U, VDS) . 16197 eq parseDecl('including_.[T], PU, U, VDS) 16198 = < addImports((including parseModExp(T) .), PU) ; U ; VDS > . 16199 eq parseDecl('extending_.[T], PU, U, VDS) 16200 = < addImports((extending parseModExp(T) .), PU) ; U ; VDS > . 16201 eq parseDecl('protecting_.[T], PU, U, VDS) 16202 = < addImports((protecting parseModExp(T) .), PU) ; U ; VDS > . 16203 16204 eq parseDecl('sort_.[T], PU, U, VDS) = parseDecl('sorts_.[T], PU, U, VDS) . 16205 eq parseDecl('sorts_.[T], PU, U, VDS) 16206 = < addSorts(parseSortSet(T), PU) ; addSorts(parseSortSet(T), U) ; VDS > . 16207 16208 eq parseDecl('subsort_.[T], PU, U, VDS) 16209 = parseDecl('subsorts_.[T], PU, U, VDS) . 16210 eq parseDecl('subsorts_.[T], PU, U, VDS) 16211 = < addSubsorts(unfoldSubsortRel(parseSubsortRel(T)), PU) ; 16212 addSubsorts(unfoldSubsortRel(parseSubsortRel(T)), U) ; VDS > . 16213 16214*** As pointed out in Section~\ref{SyntacticalRequirementsAndCaveats}, the 16215*** name of operators in operator declaration has to be given as a single 16216*** token identifier (see Section~\ref{order-sorted}). We assume that when 16217*** declaring a multitoken operator, its name is given as a single quoted 16218*** identifier in which each token is preceded by a backquote. Thus, the name 16219*** of an operator \verb~_(_)~, for example, is given as \verb~_`(_`)~. 16220 16221 eq parseDecl('op_:`->_.['token[T], T'], PU, U, VDS) 16222 = < addOps((op downQid(T) : nil -> parseType(T') [none] .), PU) ; 16223 addOps((op downQid(T) : nil -> parseType(T') [none] .), U) ; 16224 VDS > . 16225 eq parseDecl('op_:`->_`[_`].['token[T], T', T''], PU, U, VDS) 16226 = < addOps( 16227 (op downQid(T) : nil -> parseType(T') [parsePreAttrs(T'', 0)] .), 16228 PU) ; 16229 addOps( 16230 (op downQid(T) : nil -> parseType(T') [parseAttrs(T'')] .), 16231 U) ; 16232 VDS > . 16233 eq parseDecl('op_:_->_.['token[T], T', T''], PU, U, VDS) 16234 = < addOps( 16235 (op downQid(T) : parseTypeList(T') -> parseType(T'') [none] .), 16236 PU) ; 16237 addOps( 16238 (op downQid(T) : parseTypeList(T') -> parseType(T'') [none] .), 16239 U) ; 16240 VDS > . 16241 eq parseDecl('op_:_->_`[_`].['token[T], T', T'', T3], PU, U, VDS) 16242 = < addOps( 16243 (op downQid(T) : parseTypeList(T') -> parseType(T'') 16244 [parsePreAttrs(T3, size(parseTypeList(T')))] .), PU) ; 16245 addOps( 16246 (op downQid(T) : parseTypeList(T') -> parseType(T'') 16247 [parseAttrs(T3)] .), U) ; 16248 VDS > . 16249 16250 ceq parseDecl('op_:`->_.[F[TL], T], PU, U, VDS) 16251 = < PU ; U ; VDS > 16252 if F =/= 'token . 16253 ceq parseDecl('op_:`->_`[_`].[F[TL], T, T'], PU, U, VDS) 16254 = < PU ; U ; VDS > 16255 if F =/= 'token . 16256 ceq parseDecl('op_:_->_.[F[TL], T, T'], PU, U, VDS) 16257 = < PU ; U ; VDS > 16258 if F =/= 'token . 16259 ceq parseDecl('op_:_->_`[_`].[F[TL], T, T', T''], PU, U, VDS) 16260 = < PU ; U ; VDS > 16261 if F =/= 'token . 16262 16263 eq parseDecl('ops_:`->_.['neTokenList[T], T'], PU, U, VDS) 16264 = < addOps( 16265 unfoldOpDecl(downTypes(T), nil, parseType(T'), none), PU) ; 16266 addOps( 16267 unfoldOpDecl(downTypes(T), nil, parseType(T'), none), U) ; 16268 VDS > . 16269 eq parseDecl('ops_:`->_`[_`].['neTokenList[T], T', T''], PU, U, VDS) 16270 = < addOps( 16271 unfoldOpDecl(downTypes(T), nil, parseType(T'), 16272 parsePreAttrs(T'', 0)), 16273 PU) ; 16274 addOps( 16275 unfoldOpDecl(downTypes(T), nil, parseType(T'), 16276 parseAttrs(T'')), 16277 U) ; 16278 VDS > . 16279 eq parseDecl('ops_:_->_.['neTokenList[T], T', T''], PU, U, VDS) 16280 = < addOps( 16281 unfoldOpDecl(downTypes(T), parseTypeList(T'), 16282 parseType(T''), none), 16283 PU) ; 16284 addOps( 16285 unfoldOpDecl(downTypes(T), parseTypeList(T'), 16286 parseType(T''), none), 16287 U) ; 16288 VDS > . 16289 eq parseDecl('ops_:_->_`[_`].['neTokenList[T], T', T'', T3], PU, U, VDS) 16290 = < addOps( 16291 unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''), 16292 parsePreAttrs(T3, size(parseTypeList(T')))), PU) ; 16293 addOps( 16294 unfoldOpDecl(downTypes(T), 16295 parseTypeList(T'), parseType(T''), parseAttrs(T3)), U) ; 16296 VDS > . 16297 16298 eq parseDecl('op_:`~>_.['token[T], T'], PU, U, VDS) 16299 = < addOps((op downQid(T) : nil -> kind(parseType(T')) [none] .), PU) ; 16300 addOps((op downQid(T) : nil -> kind(parseType(T')) [none] .), U) ; 16301 VDS > . 16302 eq parseDecl('op_:`~>_`[_`].['token[T], T', T''], PU, U, VDS) 16303 = < addOps((op downQid(T) : nil -> kind(parseType(T')) 16304 [parsePreAttrs(T'', 0)] .), PU) ; 16305 addOps((op downQid(T) : nil -> kind(parseType(T')) 16306 [parseAttrs(T'')] .), U) ; 16307 VDS > . 16308 eq parseDecl('op_:_~>_.['token[T], T', T''], PU, U, VDS) 16309 = < addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) 16310 [none] .), PU) ; 16311 addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) 16312 [none] .), U) ; 16313 VDS > . 16314 eq parseDecl('op_:_~>_`[_`].['token[T], T', T'', T3], PU, U, VDS) 16315 = < addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) 16316 [parsePreAttrs(T3, size(parseTypeList(T')))] .), PU) ; 16317 addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) 16318 [parseAttrs(T3)] .), U) ; 16319 VDS > . 16320 16321 ceq parseDecl('op_:`~>_.[F[TL], T], PU, U, VDS) 16322 = < PU ; U ; VDS > 16323 if F =/= 'token . 16324 ceq parseDecl('op_:`~>_`[_`].[F[TL], T, T'], PU, U, VDS) 16325 = < PU ; U ; VDS > 16326 if F =/= 'token . 16327 ceq parseDecl('op_:_~>_.[F[TL], T, T'], PU, U, VDS) 16328 = < PU ; U ; VDS > 16329 if F =/= 'token . 16330 ceq parseDecl('op_:_~>_`[_`].[F[TL], T, T', T''], PU, U, VDS) 16331 = < PU ; U ; VDS > 16332 if F =/= 'token . 16333 16334 eq parseDecl('ops_:`~>_.['neTokenList[T], T'], PU, U, VDS) 16335 = < addOps( 16336 unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), none), 16337 PU) ; 16338 addOps( 16339 unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), none), 16340 U) ; 16341 VDS > . 16342 eq parseDecl('ops_:`~>_`[_`].['neTokenList[T], T', T''], PU, U, VDS) 16343 = < addOps( 16344 unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), 16345 parsePreAttrs(T'', 0)), 16346 PU) ; 16347 addOps( 16348 unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), 16349 parseAttrs(T'')), U) ; 16350 VDS > . 16351 eq parseDecl('ops_:_~>_.['neTokenList[T], T', T''], PU, U, VDS) 16352 = < addOps( 16353 unfoldOpDecl(downTypes(T), parseTypeList(T'), 16354 kind(parseType(T'')), none), 16355 PU) ; 16356 addOps( 16357 unfoldOpDecl(downTypes(T), parseTypeList(T'), 16358 kind(parseType(T'')), none), 16359 U) ; 16360 VDS > . 16361 eq parseDecl('ops_:_~>_`[_`].['neTokenList[T], T', T'', T3], PU, 16362 U, VDS) 16363 = < addOps( 16364 unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''), 16365 parsePreAttrs(T3, size(parseTypeList(T')))), 16366 PU) ; 16367 addOps( 16368 unfoldOpDecl(downTypes(T), 16369 parseTypeList(T'), parseType(T''), parseAttrs(T3)), U) ; 16370 VDS > . 16371 16372 eq parseDecl('var_:_.['neTokenList[T], T'], PU, U, VDS) 16373 = parseDecl('vars_:_.['neTokenList[T], T'], PU, U, VDS) . 16374 eq parseDecl('vars_:_.['neTokenList[T], T'], PU, U, VDS) 16375 = < PU ; U ; VDS parseVars(downQidList(T), parseType(T')) > . 16376 16377 eq parseDecl('mb_:_.['bubble['__[''`[.Qid, L, ''`].Qid]], T], PU, U, VDS) 16378 = < addMbs((mb getTerm(breakMb(T, VDS)) : getSort(breakMb(T, VDS)) 16379 [label(downQid(L)) getAttrSet(breakMb(T, VDS))] .), PU) ; U ; VDS > . 16380 eq parseDecl('mb_:_.[T, T'], PU, U, VDS) 16381 = < addMbs((mb T : getSort(breakMb(T', VDS)) [getAttrSet(breakMb(T', VDS))] .), PU) ; U ; VDS > 16382 [owise] . 16383 eq parseDecl('cmb_:_if_.[T, T', T''], PU, U, VDS) 16384 = < addMbs( 16385 (cmb T : getSort(breakMb(T', VDS)) 16386 if term(pullStmtAttrOut(T'', VDS)) = 'true.Bool 16387 [attrSet(pullStmtAttrOut(T'', VDS))] .), PU) ; U ; VDS > . 16388 eq parseDecl('cmb`[_`]:_:_if_.['token[T'''], T, T', T''], PU, U, VDS) 16389 = < addMbs( 16390 (cmb T : getSort(breakMb(T', VDS)) 16391 if term(pullStmtAttrOut(T'', VDS)) = 'true.Bool 16392 [attrSet(pullStmtAttrOut(T'', VDS)) label(downQid(T'''))] .), PU) ; U ; VDS > . 16393 16394 sort Tuple{Default{Term},Sort,AttrSet} . 16395 16396 op breakMb : Term OpDeclSet -> [Tuple{Default{Term},Sort,AttrSet}] . 16397 op breakMbAux : Term TermList AttrSet OpDeclSet -> [Tuple{Default{Term},Sort,AttrSet}] . 16398 op {_,_,_} : Default{Term} Sort AttrSet -> Tuple{Default{Term},Sort,AttrSet} . 16399 op getTerm : Tuple{Default{Term},Sort,AttrSet} -> Default{Term} . 16400 op getSort : Tuple{Default{Term},Sort,AttrSet} -> Sort . 16401 op getAttrSet : Tuple{Default{Term},Sort,AttrSet} -> AttrSet . 16402 eq getTerm({DT, S, AtS}) = DT . 16403 eq getTerm({DT, qidError(QIL), AtS}) = DT . 16404 eq getSort({DT, S, AtS}) = S . 16405 eq getSort({DT, qidError(QIL), AtS}) = qidError(QIL) . 16406 eq getAttrSet({DT, S, AtS}) = AtS . 16407 eq getAttrSet({DT, qidError(QIL), AtS}) = AtS . 16408 16409---- eq breakMb('bubble[QI]) = {maybe, downQidList(QI), none} . 16410---- eq breakMb('bubble['__[QI, QI']]) 16411---- = {maybe, getType(parseTypeMb('bubble['__[QI, QI']])), none} . 16412---- eq breakMb('bubble['__[QI, QI', QI'']]) 16413---- = {getTerm(parseTypeMb('bubble['__[QI, QI', QI'']])), 16414---- getType(parseTypeMb('bubble['__[QI, QI', QI'']])), 16415---- none} . 16416 eq breakMb('bubble['__[QI, QI', TL, QI'']], VDS) 16417 = if QI'' =/= ''`].Qid 16418 then {getTerm(parseTypeMb('bubble['__[QI, QI', TL, QI'']])), 16419 getType(parseTypeMb('bubble['__[QI, QI', TL, QI'']])), 16420 none} 16421 else breakMbAux('bubble['__[QI, QI', TL, QI'']], (QI, QI', TL), none, VDS) 16422 fi . 16423 eq breakMb('sortToken[T], VDS) = {null, parseType('sortToken[T]), none} [owise] . 16424 eq breakMb('_`{_`}[T, T'], VDS) = {null, parseType('_`{_`}[T, T']), none} [owise] . 16425 eq breakMb(T, VDS) = {null, getType(parseTypeMb(T)), none} [owise] . 16426 16427 eq breakMbAux(T, (TL, ''`[.Qid), AtS, VDS) 16428 = if AtS =/= none 16429 then {null, getType(parseTypeMb('bubble[TL])), AtS} 16430 else {null, T, none} 16431 fi . 16432 eq breakMbAux(T, (TL, QI, QI', ''`[.Qid), AtS, VDS) 16433 = if AtS =/= none 16434 then {getTerm(parseTypeMb('bubble['__[TL, QI, QI']])), 16435 getType(parseTypeMb('bubble['__[TL, QI, QI']])), AtS} 16436 else {getTerm(parseTypeMb(T)), getType(parseTypeMb(T)), none} 16437 fi . 16438 eq breakMbAux(T, (TL, QI, ''nonexec.Qid), AtS, VDS) 16439 = breakMbAux(T, (TL, QI), AtS nonexec, VDS) . 16440 eq breakMbAux(T, (TL, QI, ''variant.Qid), AtS, VDS) 16441 = breakMbAux(T, (TL, QI), AtS variant, VDS) . 16442 eq breakMbAux(T, (TL, QI, ''owise.Qid), AtS, VDS) 16443 = breakMbAux(T, (TL, QI), AtS owise, VDS) . 16444 eq breakMbAux(T, (TL, QI, ''otherwise.Qid), AtS, VDS) 16445 = breakMbAux(T, (TL, QI), AtS owise, VDS) . 16446 eq breakMbAux(T, (TL, QI, ''label.Qid, QI'), AtS, VDS) 16447 = if downQid(QI') :: Qid 16448 then breakMbAux(T, (TL, QI), AtS label(downQid(QI')), VDS) 16449 else {null, T, none} 16450 fi . 16451 eq breakMbAux(T, (TL, QI, ''metadata.Qid, QI'), AtS, VDS) 16452 = if downString(downQid(QI')) :: String 16453 then breakMbAux(T, (TL, QI), AtS metadata(downString(downQid(QI'))), VDS) 16454 else {null, T, none} 16455 fi . 16456 ceq breakMbAux(T, (TL, QI, ''`[.Qid, TL', ''print.Qid, TL''), AtS, VDS) 16457 = breakMbAux(T, (TL, QI, ''`[.Qid, TL'), AtS print(printArg(TL'', VDS)), VDS) 16458 if printArg(TL'', VDS) : QidList . 16459 eq breakMbAux(T, TL, AtS, VDS) = {null, T, none} [owise] . 16460 16461 op parseTypeMb : Term ~> ResultPair . 16462---- eq parseTypeMb('bubble[T]) 16463---- = parseType(getTerm(metaParse(upModule('EXTENDED-SORTS, false), downQidList(T), '@Sort@))) . 16464 eq parseTypeMb('bubble[TL]) 16465 = if metaParse( 16466 addOps( 16467 op '_:_ : '@Bubble@ '@Sort@ -> '@TermSort@ [none] ., 16468 addSorts('@TermSort@, GRAMMAR)), 16469 downQidList(TL), '@TermSort@) :: ResultPair 16470 then breakTermSort( 16471 getTerm( 16472 metaParse( 16473 addOps( 16474 op '_:_ : '@Bubble@ '@Sort@ -> '@TermSort@ [none] ., 16475 addSorts('@TermSort@, GRAMMAR)), 16476 downQidList(TL), '@TermSort@))) 16477 else {null, parseType(getTerm(metaParse(GRAMMAR, downQidList(TL), '@Sort@)))} 16478 fi . 16479 16480 op breakTermSort : Term ~> ResultPair . 16481 eq breakTermSort('_:_[T, T']) = {T, parseType(T')} . 16482 16483 eq parseDecl('eq_=_.[T, T'], PU, U, VDS) 16484 = < addEqs((eq T = T' [none] .), PU) ; U ; VDS > . 16485 eq parseDecl('ceq_=_if_.[T, T', T''], PU, U, VDS) 16486 = < addEqs((ceq T = T' if T'' = 'true.Bool [none] .), PU) ; U ; VDS > . 16487 eq parseDecl('cq_=_if_.[T, T', T''], PU, U, VDS) 16488 = < addEqs((ceq T = T' if T'' = 'true.Bool [none] .), PU) ; U ; VDS > . 16489 16490 eq parseDecl('rl_=>_.[T, T'], PU, U, VDS) 16491 = < addRls((rl T => T' [none] .), PU) ; U ; VDS > . 16492 eq parseDecl('crl_=>_if_.[T, T', T''], PU, U, VDS) 16493 = < addRls((crl T => T' if T'' = 'true.Bool [none] .), PU) ; U ; VDS > . 16494 16495 eq parseDecl('class_|`.[T], PU, U, VDS) 16496 = parseDecl('class_.[T], PU, U, VDS) . 16497 eq parseDecl('class_.[T], PU, U, VDS) 16498 = < addClasses((class parseType(T) | none .), PU) ; 16499 addClasses((class parseType(T) | none .), U) ; VDS > . 16500 eq parseDecl('class_|_.[T, T'], PU, U, VDS) 16501 = < addClasses((class parseType(T) | parseAttrDeclList(T') .), PU) ; 16502 addClasses((class parseType(T) | parseAttrDeclList(T') .), U) ; VDS > . 16503 16504 eq parseDecl('subclass_.[T], PU, U, VDS) 16505 = < addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), PU) ; 16506 addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), U) ; VDS > . 16507 eq parseDecl('subclasses_.[T], PU, U, VDS) 16508 = < addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), PU) ; 16509 addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), U) ; VDS > . 16510 16511 eq parseDecl('msg_:_->_.['token[T], T', T''], PU, U, VDS) 16512 = < addMsgs((msg downQid(T) : parseTypeList(T') -> parseType(T'') .), PU) 16513 ; 16514 addMsgs((msg downQid(T) : parseTypeList(T') -> parseType(T'') .), U) 16515 ; 16516 VDS > . 16517 eq parseDecl('msg_:`->_.['token[T], T'], PU, U, VDS) 16518 = < addMsgs((msg downQid(T) : nil -> parseType(T') .), PU) ; 16519 addMsgs((msg downQid(T) : nil -> parseType(T') .), U) ; VDS > . 16520 eq parseDecl('msgs_:_->_.['neTokenList[T], T', T''], PU, U, VDS) 16521 = < addMsgs(unfoldMultipleMsgDecl(downQidList(T), parseTypeList(T'), parseType(T'')), PU) ; 16522 addMsgs(unfoldMultipleMsgDecl(downQidList(T), parseTypeList(T'), parseType(T'')), U) ; 16523 VDS > . 16524 eq parseDecl('msgs_:`->_.['neTokenList[T], T'], PU, U, VDS) 16525 = < addMsgs(unfoldMultipleMsgDecl(downQidList(T), nil, parseType(T')), PU) ; 16526 addMsgs(unfoldMultipleMsgDecl(downQidList(T), nil, parseType(T')), U) ; VDS > . 16527 16528endfm 16529 16530******************************************************************************* 16531 16532*** 16533*** 8.1.2 Parsing of View Declarations 16534*** 16535 16536*** A similar approach is followed for the parsing of declarations in views. 16537 16538fmod VIEW-DECL-PARSING is 16539 pr PRE-VIEW . 16540 pr VIEW . 16541 pr UNIT . 16542 pr UNIT-DECL-PARSING . 16543 16544 vars T T' : Term . 16545 var OPDS : OpDeclSet . 16546 var MDS : MsgDeclSet . 16547 var M : Module . 16548 vars F F' : Qid . 16549 vars S S' : Sort . 16550 vars Ty Ty' : Type . 16551 vars TyL TyL' : TypeList . 16552 vars T'' T3 : Term . 16553 var PV : PreView . 16554 var OPD : OpDecl . 16555 var OPDS' : OpDeclSet . 16556 var AtS : AttrSet . 16557 var MD : MsgDecl . 16558 var MDS' : MsgDeclSet . 16559 var VDS : OpDeclSet . 16560 16561*** Operator and message name maps of the form \verb~F to F'~ are substituted 16562*** by an equivalent set of maps of the form \verb~F : TyL -> S to F'~. One 16563*** of these maps is added for each family of subsort-overloaded operators in 16564*** the source theory of the view. 16565 16566*** The following functions \texttt{genOpMaps} and \texttt{genMsgMaps} 16567*** take, respectively, an operator and a message map of the form 16568*** \verb~F to F'~, a set of operator or message declarations, and a term of 16569*** sort \texttt{Module}, and return, respectively, a set of operator maps and 16570*** a set of message maps, with each of the members of those sTS having the 16571*** general form \verb~F : TyL -> S to F'~. One of these maps is generated 16572*** for each family of subsort-overloaded operators or messages with name 16573*** \texttt{F} in the module given as argument. 16574 16575 op genOpMaps : OpMapping OpDeclSet Module -> OpMappingSet . 16576 op genMsgMaps : OpMapping MsgDeclSet Module -> OpMappingSet . 16577 16578 op genOpMapsAux : OpDeclSet Qid -> OpMappingSet . 16579 op genMsgMapsAux : MsgDeclSet Qid -> OpMappingSet . 16580 16581 op getOpDeclSet : Qid Module -> OpDeclSet . 16582 op getOpDeclSetAux : Qid OpDeclSet -> OpDeclSet . 16583 *** getOpDeclSet(F, U) returns the set of declarations of operators with 16584 *** name F in the unit U 16585 op getMsgDeclSet : Qid Module -> MsgDeclSet . 16586 op getMsgDeclSetAux : Qid MsgDeclSet -> MsgDeclSet . 16587 *** getMsgDeclSet(F, U) returns the set of declarations of messages with 16588 *** name F in the unit U 16589 op gTSubsortOverloadedFamilies : OpDeclSet OpDeclSet Module -> OpDeclSet . 16590 op gTSubsortOverloadedFamilies : MsgDeclSet MsgDeclSet Module -> MsgDeclSet . 16591 *** gTSubsortOverloadedFamilies returns a declaration of operator or 16592 *** message for each family of subsort-overloaded operators or messages. 16593 op selectOpDeclSet : Qid OpDeclSet -> OpDeclSet . 16594 op selectMsgDeclSet : Qid MsgDeclSet -> MsgDeclSet . 16595 *** selectOpDeclSet and selectMsgDeclSet returns, respectively, the subset 16596 *** of those declarations of ops and msgs which name coincides with the 16597 *** qid given ar argument. 16598 op opFamilyIn : OpDecl OpDeclSet Module -> Bool . 16599 op msgFamilyIn : MsgDecl MsgDeclSet Module -> Bool . 16600 *** Check whether the family of the subsort-overloaded operator given as 16601 *** argument has already a representative in the set of declarations given. 16602 16603 eq genOpMaps(op F to F' ., OPDS, M) 16604 = genOpMapsAux( 16605 gTSubsortOverloadedFamilies(selectOpDeclSet(F, OPDS), none, M), 16606 F') . 16607 16608 eq genMsgMaps(msg F to F' ., MDS, M) 16609 = genMsgMapsAux( 16610 gTSubsortOverloadedFamilies(selectMsgDeclSet(F, MDS), none, M), 16611 F') . 16612 16613 eq selectOpDeclSet(F, ((op F' : TyL -> Ty [AtS] .) OPDS)) 16614 = ((if F == F' 16615 then (op F' : TyL -> Ty [AtS] .) 16616 else none 16617 fi) 16618 selectOpDeclSet(F, OPDS)) . 16619 eq selectOpDeclSet(F, none) = none . 16620 16621 eq selectMsgDeclSet(F, ((msg F' : TyL -> Ty .) MDS)) 16622 = ((if F == F' 16623 then (msg F' : TyL -> Ty .) 16624 else none 16625 fi) 16626 selectMsgDeclSet(F, MDS)) . 16627 eq selectMsgDeclSet(F, none) = none . 16628 16629 eq genOpMapsAux(op F : TyL -> Ty [AtS] . OPDS, F') 16630 = (op F : TyL -> Ty to F' . genOpMapsAux(OPDS, F')) . 16631 eq genOpMapsAux(none, F') = none . 16632 16633 eq genMsgMapsAux(((msg F : TyL -> Ty .) MDS), F') 16634 = (msg F : TyL -> Ty to F' . genMsgMapsAux(MDS, F')) . 16635 eq genMsgMapsAux(none, F') = none . 16636 16637 eq gTSubsortOverloadedFamilies((OPD OPDS), OPDS', M) 16638 = if opFamilyIn(OPD, OPDS', M) 16639 then gTSubsortOverloadedFamilies(OPDS, OPDS', M) 16640 else gTSubsortOverloadedFamilies(OPDS, (OPD OPDS'), M) 16641 fi . 16642 eq gTSubsortOverloadedFamilies(none, OPDS, M) = OPDS . 16643 16644 eq gTSubsortOverloadedFamilies((MD MDS), MDS', M) 16645 = if msgFamilyIn(MD, MDS', M) 16646 then gTSubsortOverloadedFamilies(MDS, MDS', M) 16647 else gTSubsortOverloadedFamilies(MDS, (MD MDS'), M) 16648 fi . 16649 eq gTSubsortOverloadedFamilies(none, MDS, M) = MDS . 16650 16651 eq opFamilyIn( 16652 (op F : TyL -> Ty [AtS] .), ((op F' : TyL' -> Ty' [AtS] .) OPDS), M) 16653 = ((F == F') and-then sameKind(M, TyL, TyL')) or-else 16654 opFamilyIn((op F : TyL -> Ty [AtS] .), OPDS, M) . 16655 eq opFamilyIn((op F : TyL -> Ty [AtS] .), none, M) = false . 16656 16657 eq msgFamilyIn((msg F : TyL -> Ty .), ((msg F' : TyL' -> Ty' .) MDS), M) 16658 = ((F == F') and-then sameKind(M, TyL, TyL')) 16659 or-else 16660 msgFamilyIn((msg F : TyL -> Ty .), MDS, M) . 16661 eq msgFamilyIn((msg F : TyL -> Ty .), none, M) = false . 16662 16663*** In the case of views, the \texttt{parseDecl} function takes the term 16664*** representing the corresponding declaration and a preview in which the 16665*** declarations are introduced. Note that in the case of views, the approach 16666*** followed in the evaluation is somewhat different. The only predeclarations 16667*** in a preview correspond to the term premaps of sort \texttt{PreTermMap}, 16668*** for which, in addition to solving the bubbles in them, we have to convert 16669*** them into term maps of sort \texttt{TermMap} associating to them the set 16670*** of declarations of variables in the view which are used in them (see 16671*** Section~\ref{view-processing}). 16672 16673*** The function \texttt{parseDecl} for declarations in views takes then the 16674*** term representing such declaration and a preview in which the result of 16675*** adding the declaration will be returned. To be able to generate the sTS 16676*** of equivalent operator and message maps as indicated above, the function 16677*** takes also as parameters the sTS of declarations of operators and messages 16678*** in the theory part of the source theory of the view in question, and the 16679*** signature of such theory to make the necessary sort comparisons. 16680 16681 op parseDecl : Term PreView OpDeclSet MsgDeclSet Module -> PreView . 16682 16683 eq parseDecl('sort_to_.[T, T'], PV, OPDS, MDS, M) 16684 = addMaps(sort parseType(T) to parseType(T') ., PV) . 16685 16686 eq parseDecl('class_to_.[T, T'], PV, OPDS, MDS, M) 16687 = addMaps(class parseType(T) to parseType(T') ., PV) . 16688 16689 eq parseDecl('vars_:_.['neTokenList[T], T'], PV, OPDS, MDS, M) 16690 = addVars(parseVars(downQidList(T), parseType(T')), PV). 16691 eq parseDecl('var_:_.['neTokenList[T], T'], PV, OPDS, MDS, M) 16692 = addVars(parseVars(downQidList(T), parseType(T')), PV). 16693 16694 eq parseDecl('op_to`term_.[T, T'], PV, OPDS, MDS, M) 16695 = addMaps(op_to`term_.(T, T'), PV) . 16696 16697 eq parseDecl('op_to_.['token[T], 'token[T']], PV, OPDS, MDS, M) 16698 = addMaps(genOpMaps(op downQid(T) to downQid(T') ., OPDS, M), PV) . 16699 eq parseDecl('op_:_->_to_.['token[T], T', T'', 'token[T3]], PV, OPDS, MDS, M) 16700 = addMaps(op downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3) ., PV) . 16701 eq parseDecl('op_:`->_to_.['token[T], T', 'token[T'']], PV, OPDS, MDS, M) 16702 = addMaps(op downQid(T) : nil -> parseType(T') to downQid(T'') ., PV) . 16703 16704 eq parseDecl('msg_to_.['token[T], 'token[T']], PV, OPDS, MDS, M) 16705 = addMaps(genMsgMaps(msg downQid(T) to downQid(T') ., MDS, M), PV) . 16706 eq parseDecl('msg_:_->_to_.['token[T], T', T'', 'token[T3]], PV, OPDS, MDS, M) 16707 = addMaps(msg downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3) ., PV) . 16708 eq parseDecl('msg_:`->_to_.['token[T], T', 'token[T'']], PV, OPDS, MDS, M) 16709 = addMaps(msg downQid(T) : nil -> parseType(T') to downQid(T'') ., PV) . 16710 16711 eq parseDecl('attr_._to_.[T', 'token[T], 'token[T'']], PV, OPDS, MDS, M) 16712 = addMaps(attr downQid(T) . parseType(T') to downQid(T'') ., PV) . 16713 16714 eq parseDecl(T, PV, OPDS, MDS, M) = PV [owise] . 16715endfm 16716 16717******************************************************************************* 16718 16719*** 16720*** 8.2 Meta Pretty Printing 16721*** 16722 16723*** To be able to show to the user the modules, theories, views, and terms 16724*** resulting from the different commands, the built-in function 16725*** \texttt{meta-pretty-print} is extended in the modules in this section to 16726*** deal with units and views. 16727 16728*** 16729*** 8.2.1 Meta Pretty Printing of Declarations 16730*** 16731 16732*** The predefined function \texttt{meta-pretty-print} is extended in the 16733*** following module \texttt{DECL-META-PRETTY-PRINT} to handle any declaration 16734*** that can appear in a unit. Note that the following 16735*** \texttt{meta-pretty-print} functions, as the built-in one, return a list 16736*** terms---such as equations, rules,* operator declarations with an identity 16737*** attribute, etc.---they have been defined with a term of operator 16738*** declarations with an identity attribute, etc.---they have been defined 16739*** with a term of sort \texttt{Module} as argument. In the other cases the 16740*** module is not necessary. 16741 16742fmod DECL-META-PRETTY-PRINT is 16743 pr EXT-DECL . 16744 pr O-O-DECL . 16745 pr UNIT . 16746 pr CONVERSION . 16747 pr INT-LIST . 16748 pr VIEW-EXPR-TO-QID . 16749 16750 op eMetaPrettyPrint : Sort -> QidList . 16751 op eMetaPrettyPrint : SortSet -> QidList . 16752 op eMetaPrettyPrint : TypeList -> QidList . 16753 op eMetaPrettyPrint : SubsortDeclSet -> QidList . 16754 op eMetaPrettyPrint : ClassDeclSet -> QidList . 16755 op eMetaPrettyPrint : SubclassDeclSet -> QidList . 16756 op eMetaPrettyPrint : Module OpDeclSet -> QidList . 16757 op eMetaPrettyPrintVars : OpDeclSet -> QidList . 16758 op eMetaPrettyPrint : MsgDeclSet -> QidList . 16759 op eMetaPrettyPrint : Module MembAxSet -> QidList . 16760 op eMetaPrettyPrint : Module EquationSet -> QidList . 16761 op eMetaPrettyPrint : Module RuleSet -> QidList . 16762 op eMetaPrettyPrint : Module Condition -> QidList . 16763 op eMetaPrettyPrint : Module Term -> QidList . 16764 16765 ---- error handling 16766---( 16767 eq metaPrettyPrint(M, T, POS:PrintOptionSet) 16768 = 'Module getName(M) 'contains 'errors. . 16769---) 16770 16771 eq eMetaPrettyPrint(U, T) = metaPrettyPrint(U, T) . ----, mixfix flat format) . 16772 eq eMetaPrettyPrint(U, qidError(QIL)) = QIL . 16773 eq eMetaPrettyPrint(qidError(QIL)) = QIL . 16774 16775 op eMetaPrettyPrint : Module AttrSet -> QidList . 16776 op eMetaPrettyPrint : IntList -> QidList . 16777 op eMetaPrettyPrint : AttrDeclSet -> QidList . 16778 op eMetaPrettyPrint : Module HookList -> QidList . 16779 16780 vars QI QI' QI'' F V L : Qid . 16781 var QIL : QidList . 16782 var St : String . 16783 var M : Module . 16784 var U : Module . 16785 vars VE VE' : ViewExp . 16786 vars SS : SortSet . 16787 vars S S' : Sort . 16788 var TyL : TypeList . 16789 var Ty : Type . 16790 var SSDS : SubsortDeclSet . 16791 var OPDS : OpDeclSet . 16792 var AtS : AttrSet . 16793 var MAS : MembAxSet . 16794 var EqS : EquationSet . 16795 var RlS : RuleSet . 16796 var Hk : Hook . 16797 var HkL : HookList . 16798 var I : Int . 16799 var NL : IntList . 16800 vars T T' T'' T3 : Term . 16801 var CDS : ClassDeclSet . 16802 var SCDS : SubclassDeclSet . 16803 var MDS : MsgDeclSet . 16804 var ADS : AttrDeclSet . 16805 var Cond : Condition . 16806 var K : Kind . 16807 16808 --- eq eMetaPrettyPrint(Ty) = Ty . 16809 16810 eq eMetaPrettyPrint(S) 16811 = if getPars(S) == empty 16812 then S 16813 else getName(S) '`{ parameterList2QidList(getPars(S)) '`} 16814 fi . 16815 eq eMetaPrettyPrint(K) = '`[ eMetaPrettyPrint(getSort(K)) '`] . 16816 16817 eq eMetaPrettyPrint((S ; SS)) 16818 = (eMetaPrettyPrint(S) eMetaPrettyPrint(SS)) 16819 [owise] . 16820 eq eMetaPrettyPrint((none).SortSet) = nil . 16821 16822 eq eMetaPrettyPrint(Ty TyL) 16823 = eMetaPrettyPrint(Ty) eMetaPrettyPrint(TyL) 16824 [owise] . 16825 eq eMetaPrettyPrint((nil).TypeList) = nil . 16826 16827 eq eMetaPrettyPrint(((subsort S < S' .) SSDS)) 16828 = ('\s '\s '\b 16829 'subsort '\o eMetaPrettyPrint(S) '\b 16830 '< '\o eMetaPrettyPrint(S') '\b '. '\o '\n 16831 eMetaPrettyPrint(SSDS)) . 16832 eq eMetaPrettyPrint((none).SubsortDeclSet) = nil . 16833 16834 eq eMetaPrettyPrint(M, ((op F : TyL -> Ty [none] .) OPDS)) 16835 = ('\s '\s 16836 '\b 'op '\o F '\b ': '\o eMetaPrettyPrint(TyL) 16837 '\b '-> '\o eMetaPrettyPrint(Ty) '\b '. '\o '\n 16838 eMetaPrettyPrint(M, OPDS)) . 16839 eq eMetaPrettyPrint(M, ((op F : TyL -> Ty [AtS] .) OPDS)) 16840 = ('\s '\s 16841 '\b 'op '\o F '\b ': '\o eMetaPrettyPrint(TyL) 16842 '\b '-> '\o eMetaPrettyPrint(Ty) '\n 16843 '\s '\s '\s '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o '\n 16844 eMetaPrettyPrint(M, OPDS)) 16845 [owise] . 16846 eq eMetaPrettyPrint(M, (none).OpDeclSet) = nil . 16847 16848 eq eMetaPrettyPrintVars((op F : nil -> Ty [none] .) OPDS) 16849 = ('\s '\s '\b 'var '\o F '\b ': '\o eMetaPrettyPrint(Ty) '\b '. '\o '\n 16850 eMetaPrettyPrintVars(OPDS)) . 16851 eq eMetaPrettyPrintVars((none).OpDeclSet) = nil . 16852 16853 eq eMetaPrettyPrint(M, (mb T : S [none] .) MAS) 16854 = ('\s '\s '\b 'mb '\o eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(S) '\b '. '\o '\n 16855 eMetaPrettyPrint(M, MAS)) . 16856 eq eMetaPrettyPrint(M, (mb T : S [AtS] .) MAS) 16857 = ('\s '\s '\b 'mb '\o eMetaPrettyPrint(M, T) 16858 '\b ': '\o eMetaPrettyPrint(S) 16859 '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o '\n 16860 eMetaPrettyPrint(M, MAS)) 16861 [owise] . 16862 eq eMetaPrettyPrint(M, (cmb T : S if Cond [none] .) MAS) 16863 = ('\s '\s '\b 'cmb '\o eMetaPrettyPrint(M, T) 16864 '\b ': '\o eMetaPrettyPrint(S) '\n 16865 '\s '\s '\s '\s '\b 'if '\o eMetaPrettyPrint(M, Cond) '\b '. '\o '\n 16866 eMetaPrettyPrint(M, MAS)) . 16867 eq eMetaPrettyPrint(M, (cmb T : S if Cond [AtS] .) MAS) 16868 = ('\s '\s '\b 'cmb '\o eMetaPrettyPrint(M, T) 16869 '\b ': '\o eMetaPrettyPrint(S) '\n 16870 '\s '\s '\s '\s '\b 'if '\o eMetaPrettyPrint(M, Cond) 16871 '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o '\n 16872 eMetaPrettyPrint(M, MAS)) 16873 [owise] . 16874 eq eMetaPrettyPrint(M, (none).MembAxSet) = nil . 16875 16876 eq eMetaPrettyPrint(M, ((eq T = T' [none] .) EqS)) 16877 = ('\s '\s '\b 'eq '\s '\o eMetaPrettyPrint(M, T) '\n 16878 '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T') '\b '\s '. '\n 16879 '\o 16880 eMetaPrettyPrint(M, EqS)) . 16881 eq eMetaPrettyPrint(M, ((eq T = T' [AtS] .) EqS)) 16882 = ('\s '\s '\b 'eq '\s '\o eMetaPrettyPrint(M, T) '\n 16883 '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T') 16884 '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o '\n 16885 eMetaPrettyPrint(M, EqS)) 16886 [owise] . 16887 eq eMetaPrettyPrint(M, ((ceq T = T' if Cond [none] .) EqS)) 16888 = ('\s '\s '\b 'ceq '\s '\o eMetaPrettyPrint(M, T) '\n 16889 '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T') '\n 16890 '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) '\b '\s '. '\o '\n 16891 eMetaPrettyPrint(M, EqS)) . 16892 eq eMetaPrettyPrint(M, ((ceq T = T' if Cond [AtS] .) EqS)) 16893 = ('\s '\s '\b 'ceq '\s '\o eMetaPrettyPrint(M, T) '\n 16894 '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T') '\n 16895 '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) 16896 '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o '\n 16897 eMetaPrettyPrint(M, EqS)) 16898 [owise] . 16899 eq eMetaPrettyPrint(M, (none).EquationSet) = nil . 16900 16901 eq eMetaPrettyPrint(M, ((rl T => T' [none] .) RlS)) 16902 = ('\s '\s '\b 'rl '\s '\o eMetaPrettyPrint(M, T) '\n 16903 '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') '\b '\s '. '\n '\o 16904 eMetaPrettyPrint(M, RlS)) . 16905 eq eMetaPrettyPrint(M, ((rl T => T' [AtS] .) RlS)) 16906 = ('\s '\s '\b 'rl '\s '\o eMetaPrettyPrint(M, T) '\n 16907 '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') 16908 '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o '\n 16909 eMetaPrettyPrint(M, RlS)) 16910 [owise] . 16911 eq eMetaPrettyPrint(M, ((crl T => T' if Cond [none] .) RlS)) 16912 = ('\s '\s '\b 'crl '\s '\o eMetaPrettyPrint(M, T) '\n 16913 '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') '\n 16914 '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) '\b '\s '. '\o '\n 16915 eMetaPrettyPrint(M, RlS)) . 16916 eq eMetaPrettyPrint(M, ((crl T => T' if Cond [AtS] .) RlS)) 16917 = ('\s '\s '\b 'crl '\s '\o eMetaPrettyPrint(M, T) '\n 16918 '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') '\n 16919 '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) 16920 '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o '\n 16921 eMetaPrettyPrint(M, RlS)) 16922 [owise] . 16923 eq eMetaPrettyPrint(M, (none).RuleSet) = nil . 16924 16925 eq eMetaPrettyPrint(M, T = T' /\ Cond) 16926 = (eMetaPrettyPrint(M, T) '\b '= '\o eMetaPrettyPrint(M, T') '\b 16927 '/\ '\o eMetaPrettyPrint(M, Cond)) 16928 [owise] . 16929 eq eMetaPrettyPrint(M, T : S /\ Cond) 16930 = (eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(S) '\b 16931 '/\ '\o eMetaPrettyPrint(M, Cond)) 16932 [owise] . 16933 eq eMetaPrettyPrint(M, T := T' /\ Cond) 16934 = (eMetaPrettyPrint(M, T) '\b ':= '\o eMetaPrettyPrint(M, T') '\b 16935 '/\ '\o eMetaPrettyPrint(M, Cond)) 16936 [owise] . 16937 eq eMetaPrettyPrint(M, T => T' /\ Cond) 16938 = (eMetaPrettyPrint(M, T) '\b '=> '\o eMetaPrettyPrint(M, T') '\b 16939 '/\ '\o eMetaPrettyPrint(M, Cond)) 16940 [owise] . 16941 eq eMetaPrettyPrint(M, T = T') 16942 = (eMetaPrettyPrint(M, T) '\b '= '\o eMetaPrettyPrint(M, T')) . 16943 eq eMetaPrettyPrint(M, T : S) 16944 = (eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(S)) . 16945 eq eMetaPrettyPrint(M, T := T') 16946 = (eMetaPrettyPrint(M, T) '\b ':= '\o eMetaPrettyPrint(M, T')) . 16947 eq eMetaPrettyPrint(M, T => T') 16948 = (eMetaPrettyPrint(M, T) '\b '=> '\o eMetaPrettyPrint(M, T')) . 16949 eq eMetaPrettyPrint(M, (nil).EqCondition) = nil . 16950 16951 eq eMetaPrettyPrint(M, (assoc AtS)) 16952 = ('\b 'assoc '\o eMetaPrettyPrint(M, AtS)) . 16953 eq eMetaPrettyPrint(M, (comm AtS)) 16954 = ('\b 'comm '\o eMetaPrettyPrint(M, AtS)) . 16955 eq eMetaPrettyPrint(M, (memo AtS)) 16956 = ('\b 'memo '\o eMetaPrettyPrint(M, AtS)) . 16957 eq eMetaPrettyPrint(M, (idem AtS)) 16958 = ('\b 'idem '\o eMetaPrettyPrint(M, AtS)) . 16959 eq eMetaPrettyPrint(M, (id(T) AtS)) 16960 = ('\b 'id: '\o eMetaPrettyPrint(M, T) eMetaPrettyPrint(M, AtS)) . 16961 eq eMetaPrettyPrint(M, (right-id(T) AtS)) 16962 = ('\b 'right 'id: '\o eMetaPrettyPrint(M, T) eMetaPrettyPrint(M, AtS)) . 16963 eq eMetaPrettyPrint(M, (left-id(T) AtS)) 16964 = ('\b 'left 'id: '\o eMetaPrettyPrint(M, T) eMetaPrettyPrint(M, AtS)) . 16965 eq eMetaPrettyPrint(M, (poly(NL) AtS)) 16966 = ('\b 'poly '`( '\o eMetaPrettyPrint(NL) '\b '`) 16967 '\o eMetaPrettyPrint(M, AtS)) . 16968 eq eMetaPrettyPrint(M, (strat(NL) AtS)) 16969 = ('\b 'strat '`( '\o eMetaPrettyPrint(NL) '\b '`) 16970 '\o eMetaPrettyPrint(M, AtS)) . 16971 eq eMetaPrettyPrint(M, (memo AtS)) 16972 = ('\b 'memo '\o eMetaPrettyPrint(M, AtS)) . 16973 eq eMetaPrettyPrint(M, (prec(I) AtS)) 16974 = ('\b 'prec '\o eMetaPrettyPrint(I) eMetaPrettyPrint(M, AtS)) . 16975 eq eMetaPrettyPrint(M, (gather(QIL) AtS)) 16976 = ('\b 'gather '\o '`( QIL '`) eMetaPrettyPrint(M, AtS)) . 16977 eq eMetaPrettyPrint(M, (format(QIL) AtS)) 16978 = ('\b 'format '\o '`( QIL '`) eMetaPrettyPrint(M, AtS)) . 16979 eq eMetaPrettyPrint(M, (ctor AtS)) 16980 = ('\b 'ctor '\o eMetaPrettyPrint(M, AtS)) . 16981 eq eMetaPrettyPrint(M, (frozen(NL) AtS)) 16982 = ('\b 'frozen '`( '\o eMetaPrettyPrint(NL) '\b '`) 16983 '\o eMetaPrettyPrint(M, AtS)) . 16984 eq eMetaPrettyPrint(M, (iter AtS)) 16985 = ('\b 'iter '\o eMetaPrettyPrint(M, AtS)) . 16986 eq eMetaPrettyPrint(M, (special(HkL) AtS)) 16987 = ('\b 'special '`( '\o eMetaPrettyPrint(M, HkL) '\b '`) 16988 '\o eMetaPrettyPrint(M, AtS)) . 16989 eq eMetaPrettyPrint(M, (config AtS)) 16990 = ('\b 'config '\o eMetaPrettyPrint(M, AtS)) . 16991 eq eMetaPrettyPrint(M, (object AtS)) 16992 = ('\b 'object '\o eMetaPrettyPrint(M, AtS)) . 16993 eq eMetaPrettyPrint(M, (msg AtS)) 16994 = ('\b 'msg '\o eMetaPrettyPrint(M, AtS)) . 16995 16996 eq eMetaPrettyPrint(M, (label(QI) AtS)) 16997 = ('\b 'label '\o QI '\b '\o eMetaPrettyPrint(M, AtS)) . 16998 eq eMetaPrettyPrint(M, (metadata(St) AtS)) 16999 = ('\b 'metadata '\o qid("\"" + St + "\"") '\b 17000 '\o eMetaPrettyPrint(M, AtS)) . 17001 eq eMetaPrettyPrint(M, (nonexec AtS)) 17002 = ('\b 'nonexec '\o eMetaPrettyPrint(M, AtS)) . 17003 eq eMetaPrettyPrint(M, (variant AtS)) 17004 = ('\b 'variant '\o eMetaPrettyPrint(M, AtS)) . 17005 eq eMetaPrettyPrint(M, (owise AtS)) 17006 = ('\b 'owise '\o eMetaPrettyPrint(M, AtS)) . 17007 eq eMetaPrettyPrint(M, (print(QIL) AtS)) 17008 = ('\b 'print QIL '\o eMetaPrettyPrint(M, AtS)) . 17009 17010 eq eMetaPrettyPrint(M, (none).AttrSet) = nil . 17011 17012 ceq eMetaPrettyPrint(M, (Hk HkL)) 17013 = (eMetaPrettyPrint(M, Hk) eMetaPrettyPrint(M, HkL)) 17014 if HkL =/= nil . 17015 eq eMetaPrettyPrint(M, id-hook(QI, nil)) = ('\b 'id-hook '\o QI) . 17016 eq eMetaPrettyPrint(M, id-hook(QI, QIL)) 17017 = ('\b 'id-hook '\o QI '\b '`( '\o QIL '\b '`) '\o ) 17018 [owise] . 17019 eq eMetaPrettyPrint(M, op-hook(QI, QI', nil, QI'')) 17020 = ('\b 'op-hook '\o QI '\b '`( '\o QI' ': '~> QI'' '\b '`) '\o) . 17021 eq eMetaPrettyPrint(M, op-hook(QI, QI', QIL, QI'')) 17022 = ('\b 'op-hook '\o QI '\b '`( '\o QI' ': QIL '~> QI'' '\b '`) '\o) 17023 [owise] . 17024 eq eMetaPrettyPrint(M, term-hook(QI, T)) 17025 = ('\b 'term-hook '\o QI '\b '`( '\o eMetaPrettyPrint(M, T) '\b '`) '\o) . 17026 17027 eq eMetaPrettyPrint((I NL)) = (qid(string(I, 10)) eMetaPrettyPrint(NL)) . 17028 eq eMetaPrettyPrint((nil).NatList) = nil . 17029 17030 eq eMetaPrettyPrint((class S | ADS .) CDS) 17031 = ((if ADS == none 17032 then ('\s '\s '\b 'class '\o eMetaPrettyPrint(S) '\b '. '\o '\n) 17033 else ('\s '\s '\b 'class '\o eMetaPrettyPrint(S) '\b '| '\o eMetaPrettyPrint(ADS) '\b '. '\o '\n) 17034 fi) 17035 eMetaPrettyPrint(CDS)) . 17036 eq eMetaPrettyPrint((none).ClassDeclSet) = nil . 17037 17038 eq eMetaPrettyPrint((subclass S < S' .) SCDS) 17039 = ('\s '\s '\b 'subclass '\o eMetaPrettyPrint(S) '\b 17040 '< '\o eMetaPrettyPrint(S') '\b '. '\o '\n 17041 eMetaPrettyPrint(SCDS)) . 17042 eq eMetaPrettyPrint((none).SubclassDeclSet) = nil . 17043 17044 eq eMetaPrettyPrint((msg F : TyL -> Ty .) MDS) 17045 = ('\s '\s '\b 'msg '\o F '\b ': '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty) '\b '. '\o '\n 17046 eMetaPrettyPrint(MDS)) . 17047 eq eMetaPrettyPrint((none).MsgDeclSet) = nil . 17048 17049 eq eMetaPrettyPrint(((attr F : S), ADS)) 17050 = (F '\b ': '\o eMetaPrettyPrint(S) '\b '`, '\o '\s eMetaPrettyPrint(ADS)) 17051 [owise] . 17052 eq eMetaPrettyPrint((attr F : S)) = (F '\b ': '\o eMetaPrettyPrint(S)) . 17053 eq eMetaPrettyPrint((none).AttrDeclSet) = nil . 17054 17055endfm 17056 17057******************************************************************************* 17058 17059*** 17060*** 8.2.2 Meta Pretty Printing of Modules 17061*** 17062 17063*** In the following module, the \texttt{meta-pretty-print} function is 17064*** defined on sort \texttt{Module}. 17065 17066fmod UNIT-META-PRETTY-PRINT is 17067 pr UNIT . 17068 pr RENAMING-EXPR-EVALUATION . 17069 pr DECL-META-PRETTY-PRINT . 17070 17071 op eMetaPrettyPrint : Module Module -> QidList . 17072 17073 op eMetaPrettyPrint : Module Module -> QidList . 17074 op eMetaPrettyPrint : Header -> QidList . 17075 op eMetaPrettyPrint : ParameterDeclList -> QidList . 17076 op eMetaPrettyPrint : ImportList -> QidList . 17077 17078 var M : Module . 17079 vars QI F F' L L' : Qid . 17080 var QIL : QidList . 17081 var ME : ModuleExpression . 17082 vars S S' : Sort . 17083 var Ty : Type . 17084 var TyL : TypeList . 17085 var SS : SortSet . 17086 var PD : ParameterDecl . 17087 var PDL : ParameterDeclList . 17088 vars IL IL' : ImportList . 17089 var SSDS : SubsortDeclSet . 17090 var OPDS : OpDeclSet . 17091 var MAS : MembAxSet . 17092 var EqS : EquationSet . 17093 var RlS : RuleSet . 17094 var CDS : ClassDeclSet . 17095 var SCDS : SubclassDeclSet . 17096 var MDS : MsgDeclSet . 17097 var U : Module . 17098 var AtS : AttrSet . 17099 var MN : ModuleName . 17100 17101 ceq eMetaPrettyPrint(ME) 17102 = if QI == '`) or QI == '`] or QI == '`} 17103 then QIL QI '\s 17104 else QIL QI 17105 fi 17106 if QIL QI := header2QidList(ME) . 17107 17108 eq eMetaPrettyPrint(W:[Module], unitError(QIL)) = QIL . 17109 eq eMetaPrettyPrint(unitError(QIL), noModule) = QIL . 17110 eq eMetaPrettyPrint(noModule, noModule) = nil . 17111 eq eMetaPrettyPrint(M, mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm) 17112 = ('\b 17113 'mod '\o eMetaPrettyPrint(ME) '\b 'is '\o '\n 17114 eMetaPrettyPrint(IL) 17115 (if SS == none 17116 then nil 17117 else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n) 17118 fi) 17119 eMetaPrettyPrint(SSDS) 17120 eMetaPrettyPrint(M, OPDS) 17121 eMetaPrettyPrint(M, MAS) 17122 eMetaPrettyPrint(M, EqS) 17123 eMetaPrettyPrint(M, RlS) 17124 '\b 'endm '\o '\n) . 17125 eq eMetaPrettyPrint(M, mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm) 17126 = ('\b 17127 'mod '\o eMetaPrettyPrint(ME) (if PDL == nil 17128 then nil 17129 else '`{ eMetaPrettyPrint(PDL) '`} '\s 17130 fi) '\b 'is '\o '\n 17131 eMetaPrettyPrint(IL) 17132 (if SS == none 17133 then nil 17134 else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n) 17135 fi) 17136 eMetaPrettyPrint(SSDS) 17137 eMetaPrettyPrint(M, OPDS) 17138 eMetaPrettyPrint(M, MAS) 17139 eMetaPrettyPrint(M, EqS) 17140 eMetaPrettyPrint(M, RlS) 17141 '\b 'endm '\o '\n) . 17142 eq eMetaPrettyPrint(M, th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) 17143 = ('\b 17144 'th '\o eMetaPrettyPrint(MN) '\b 'is '\o '\n 17145 eMetaPrettyPrint(IL) 17146 (if SS == none 17147 then nil 17148 else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n) 17149 fi) 17150 eMetaPrettyPrint(SSDS) 17151 eMetaPrettyPrint(M, OPDS) 17152 eMetaPrettyPrint(M, MAS) 17153 eMetaPrettyPrint(M, EqS) 17154 eMetaPrettyPrint(M, RlS) 17155 '\b 'endth '\o '\n) . 17156 eq eMetaPrettyPrint(M, fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm) 17157 = ('\b 17158 'fmod '\o eMetaPrettyPrint(ME) '\b 'is '\o '\n 17159 eMetaPrettyPrint(IL) 17160 (if SS == none 17161 then nil 17162 else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n) 17163 fi) 17164 eMetaPrettyPrint(SSDS) 17165 eMetaPrettyPrint(M, OPDS) 17166 eMetaPrettyPrint(M, MAS) 17167 eMetaPrettyPrint(M, EqS) 17168 '\b 'endfm '\o '\n) . 17169 eq eMetaPrettyPrint(M, fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm) 17170 = ('\b 17171 'fmod '\o eMetaPrettyPrint(ME) (if PDL == nil 17172 then nil 17173 else '`{ eMetaPrettyPrint(PDL) '`} '\s 17174 fi) '\b 'is '\o '\n 17175 eMetaPrettyPrint(IL) 17176 (if SS == none 17177 then nil 17178 else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n) 17179 fi) 17180 eMetaPrettyPrint(SSDS) 17181 eMetaPrettyPrint(M, OPDS) 17182 eMetaPrettyPrint(M, MAS) 17183 eMetaPrettyPrint(M, EqS) 17184 '\b 'endfm '\o '\n) . 17185 eq eMetaPrettyPrint(M, fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) 17186 = ('\b 17187 'fth '\o eMetaPrettyPrint(MN) '\b 'is '\o '\n 17188 eMetaPrettyPrint(IL) 17189 (if SS == none 17190 then nil 17191 else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n) 17192 fi) 17193 eMetaPrettyPrint(SSDS) 17194 eMetaPrettyPrint(M, OPDS) 17195 eMetaPrettyPrint(M, MAS) 17196 eMetaPrettyPrint(M, EqS) 17197 '\b 'endfth '\o '\n) . 17198 eq eMetaPrettyPrint(M, 17199 omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 17200 = ('\b 17201 'omod '\o eMetaPrettyPrint(ME) '\b 'is '\o '\n 17202 eMetaPrettyPrint(IL) 17203 (if SS == none 17204 then nil 17205 else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n ) 17206 fi) 17207 eMetaPrettyPrint(SSDS) eMetaPrettyPrint(CDS) 17208 eMetaPrettyPrint(SCDS) eMetaPrettyPrint(M, OPDS) 17209 eMetaPrettyPrint(MDS) eMetaPrettyPrint(M, MAS) 17210 eMetaPrettyPrint(M, EqS) eMetaPrettyPrint(M, RlS) 17211 '\b 'endom '\o '\n) . 17212 eq eMetaPrettyPrint(M, omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 17213 = ('\b 17214 'omod '\o eMetaPrettyPrint(ME) (if PDL == nil 17215 then nil 17216 else ('`{ eMetaPrettyPrint(PDL) '`} '\s) 17217 fi) '\b 'is '\o '\n 17218 eMetaPrettyPrint(IL) 17219 (if SS == none 17220 then nil 17221 else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n ) 17222 fi) 17223 eMetaPrettyPrint(SSDS) eMetaPrettyPrint(CDS) 17224 eMetaPrettyPrint(SCDS) eMetaPrettyPrint(M, OPDS) 17225 eMetaPrettyPrint(MDS) eMetaPrettyPrint(M, MAS) 17226 eMetaPrettyPrint(M, EqS) eMetaPrettyPrint(M, RlS) 17227 '\b 'endom '\o '\n) . 17228 eq eMetaPrettyPrint(M, oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 17229 = ('\b 17230 'oth '\o eMetaPrettyPrint(MN) '\b 'is '\o '\n 17231 eMetaPrettyPrint(IL) 17232 (if SS == none 17233 then nil 17234 else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n ) 17235 fi) 17236 eMetaPrettyPrint(SSDS) eMetaPrettyPrint(CDS) 17237 eMetaPrettyPrint(SCDS) eMetaPrettyPrint(M, OPDS) 17238 eMetaPrettyPrint(MDS) eMetaPrettyPrint(M, MAS) 17239 eMetaPrettyPrint(M, EqS) eMetaPrettyPrint(M, RlS) '\n '\b 17240 'endoth '\o '\n) . 17241 17242 eq eMetaPrettyPrint((including ME .) IL) 17243 = ('\s '\s '\b 'including '\o eMetaPrettyPrint(ME) '\b '. '\o '\n 17244 eMetaPrettyPrint(IL)) . 17245 eq eMetaPrettyPrint((extending ME .) IL) 17246 = ('\s '\s '\b 'extending '\o eMetaPrettyPrint(ME) '\b '. '\o '\n 17247 eMetaPrettyPrint(IL)) . 17248 eq eMetaPrettyPrint((protecting ME .) IL) 17249 = ('\s '\s '\b 'protecting '\o eMetaPrettyPrint(ME) '\b '. '\o '\n 17250 eMetaPrettyPrint(IL)) . 17251 eq eMetaPrettyPrint((protecting pd(QI :: ME) .) IL) 17252 = eMetaPrettyPrint(IL) . 17253 eq eMetaPrettyPrint((nil).ImportList) = nil . 17254 17255 eq eMetaPrettyPrint((QI :: ME, PDL)) 17256 = (QI ':: eMetaPrettyPrint(ME) '`, eMetaPrettyPrint(PDL)) 17257 [owise] . 17258 eq eMetaPrettyPrint((QI :: ME)) = (QI ':: eMetaPrettyPrint(ME)) . 17259 eq eMetaPrettyPrint((nil).ParameterDeclList) = (nil).QidList . 17260 17261 op eMetaPrettyPrint : ModuleExpression -> QidList . 17262 eq eMetaPrettyPrint(QI + ME:ModuleExpression) 17263 = QI '+ eMetaPrettyPrint(ME:ModuleExpression) . 17264 eq eMetaPrettyPrint(QI * (RnS:RenamingSet)) 17265 = QI '* '\s '`( renamingSet2QidList(RnS:RenamingSet) '`) . 17266 eq eMetaPrettyPrint(pd(PD)) = eMetaPrettyPrint(PD) . 17267 17268 op renamingSet2QidList : RenamingSet -> QidList . 17269 eq renamingSet2QidList(((op F to F' [AtS]), RS:RenamingSet)) 17270 = if AtS == none 17271 then ('op F 'to F' '`, '\s renamingSet2QidList(RS:RenamingSet)) 17272 else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`] '`, '\s 17273 renamingSet2QidList(RS:RenamingSet)) 17274 fi 17275 [owise] . 17276 eq renamingSet2QidList((op F to F' [AtS])) 17277 = if AtS == none 17278 then ('op F 'to F') 17279 else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`]) 17280 fi . 17281 eq renamingSet2QidList(((op F : TyL -> Ty to F' [AtS]), RS:RenamingSet)) 17282 = if AtS == none 17283 then ('op F ': typeList2QidList(TyL) '-> Ty 'to F' '`, 17284 '\s renamingSet2QidList(RS:RenamingSet)) 17285 else ('op F ': typeList2QidList(TyL) '-> Ty 'to F' 17286 '`[ attrSet2QidList(AtS) '`] '`, 17287 '\s renamingSet2QidList(RS:RenamingSet)) 17288 fi 17289 [owise] . 17290 eq renamingSet2QidList((op F : TyL -> Ty to F' [AtS])) 17291 = if AtS == none 17292 then ('op F ': typeList2QidList(TyL) '-> Ty 'to F') 17293 else ('op F ': typeList2QidList(TyL) '-> Ty 'to F' 17294 '`[ attrSet2QidList(AtS) '`]) 17295 fi . 17296 eq renamingSet2QidList(((sort S to S'), RS:RenamingSet)) 17297 = ('sort S 'to S' '`, '\s 17298 renamingSet2QidList(RS:RenamingSet)) 17299 [owise] . 17300 eq renamingSet2QidList((sort S to S')) = ('sort S 'to S') . 17301 17302 eq renamingSet2QidList(((label L to L'), RS:RenamingSet)) 17303 = ('label L 'to L' '`, '\s renamingSet2QidList(RS:RenamingSet)) 17304 [owise] . 17305 eq renamingSet2QidList((label L to L')) = ('label L 'to L') . 17306endfm 17307 17308******************************************************************************* 17309 17310*** The function \texttt{meta-pretty-print} on units is defined recursively, 17311*** calling the \texttt{meta-pretty-print} functions for the different 17312*** declarations in the unit defined in module \texttt{DECL-META-PRETTY-PRINT}. 17313 17314*** 17315*** 8.2.3 Meta Pretty Printing of Maps and Views 17316*** 17317 17318*** We define in the following module the function \texttt{meta-pretty-print} 17319*** on maps. 17320 17321fmod MAP-SET-META-PRETTY-PRINT is 17322 pr DECL-META-PRETTY-PRINT . 17323 pr FMAP . 17324 pr UNIT . 17325 17326 op eMetaPrettyPrint : RenamingSet -> QidList . 17327 17328 var MAP : Renaming . 17329 var MAPS : RenamingSet . 17330 vars QI QI' F F' L L' : Qid . 17331 var AtS : AttrSet . 17332 vars S S' : Sort . 17333 var Ty : Type . 17334 var TyL : TypeList . 17335 17336 eq eMetaPrettyPrint((MAP, MAPS)) 17337 = (eMetaPrettyPrint(MAP) '`, '\s '\s eMetaPrettyPrint(MAPS)) 17338 [owise] . 17339 eq eMetaPrettyPrint((none).RenamingSet) = nil . 17340 17341 eq eMetaPrettyPrint(op F to F' [AtS]) 17342 = if AtS == none 17343 then ('\b 'op '\o F '\b 'to '\o F') 17344 else ('\b 'op F '\b 'to '\o F' '\b 17345 '`[ '\o eMetaPrettyPrint(noModule, AtS) '\b '`] '\o) 17346 *** In a map there should not be attributes requiring a module 17347 fi . 17348 eq eMetaPrettyPrint(op F : TyL -> Ty to F' [AtS]) 17349 = if AtS == none 17350 then ('\b 'op '\o F '\b ': 17351 '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty) 17352 '\b 'to '\o F') 17353 else ('\b 'op '\o F '\b ': 17354 '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty) 17355 '\b 'to '\o F' 17356 '\b '`[ '\o eMetaPrettyPrint(noModule, AtS) '\b '`] '\o) 17357 *** In a map there should not be attributes requiring a module 17358 fi . 17359 eq eMetaPrettyPrint(sort S to S') 17360 = ('\b 'sort '\o eMetaPrettyPrint(S) '\b 'to '\o eMetaPrettyPrint(S')) . 17361 eq eMetaPrettyPrint(label L to L') = ('\b 'label '\o L '\b 'to '\o L') . 17362 eq eMetaPrettyPrint(class S to S') 17363 = ('\b 'class '\o eMetaPrettyPrint(S) '\b 'to '\o eMetaPrettyPrint(S')) . 17364 eq eMetaPrettyPrint(attr QI . S to QI') 17365 = ('\b 'attr '\o eMetaPrettyPrint(S) '\b '. '\o QI '\b 'to '\o QI') . 17366 eq eMetaPrettyPrint(msg F to F') = ('\b 'msg '\o F '\b 'to '\o F') . 17367 eq eMetaPrettyPrint(msg F : TyL -> Ty to F') 17368 = ('\b 'msg '\o F '\b ': 17369 '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty) 17370 '\b 'to '\o F') . 17371 17372endfm 17373 17374******************************************************************************* 17375 17376*** Finally, in the \texttt{VIEW-META-PRETTY-PRINT} module, the 17377*** \texttt{meta-pretty-print} function is defined on views. 17378 17379 17380fmod VIEW-META-PRETTY-PRINT is 17381 pr DATABASE . 17382 pr MAP-SET-META-PRETTY-PRINT . 17383 pr RENAMING-SET-APPL-ON-UNIT . 17384 pr UNIT-META-PRETTY-PRINT . 17385 17386 op eMetaPrettyPrint : Database View -> QidList . 17387 op eMetaPrettyPrint : ViewExp -> QidList . 17388 op eMetaPrettyPrint : ModuleExpression ModuleExpression Database SortMappingSet SortMappingSet OpMappingSet -> QidList . 17389 op eMetaPrettyPrint : ModuleExpression ModuleExpression Database OpMappingSet SortMappingSet OpMappingSet -> QidList . 17390 op eMetaPrettyPrint : SortMapping -> QidList . 17391 op eMetaPrettyPrint : OpMapping -> QidList . 17392 17393 vars QI QI' F F' : Qid . 17394 vars S S' : Sort . 17395 var TyL : TypeList . 17396 var Ty : Type . 17397 var QIL : QidList . 17398 var DB : Database . 17399 vars ME ME' : ModuleExpression . 17400 var SM : SortMapping . 17401 var OM : OpMapping . 17402 vars SMS SMS' : SortMappingSet . 17403 vars OMS OMS' : OpMappingSet . 17404 vars T T' : Term . 17405 var PDL : ParameterDeclList . 17406 vars VE VE' : ViewExp . 17407 var DT : Default{Term} . 17408 17409 ceq eMetaPrettyPrint(DB, view VE from ME to ME' is SMS OMS endv) 17410 = ('\b 'view '\o 17411 QIL QI 17412 if QI == '`) then '\s else nil fi 17413 '\b 'from '\o eMetaPrettyPrint(ME) 17414 '\b 'to '\o eMetaPrettyPrint(ME') '\b 'is '\o '\n 17415 if SMS =/= none then '\s '\s eMetaPrettyPrint(ME, ME', DB, SMS, SMS, OMS) else nil fi 17416 if OMS =/= none then '\s '\s eMetaPrettyPrint(ME, ME', DB, OMS, SMS, OMS) else nil fi 17417 '\b 'endv '\o '\n) 17418 if QIL QI := eMetaPrettyPrint(VE) . 17419 ceq eMetaPrettyPrint(DB, view VE{PDL} from ME to ME' is SMS OMS endv) 17420 = ('\b 'view '\o 17421 QIL QI 17422 (if PDL == nil 17423 then if QI == '`) then '\s else nil fi 17424 else '`{ eMetaPrettyPrint(PDL) '`} '\s 17425 fi) 17426 '\b 'from '\o eMetaPrettyPrint(ME) 17427 '\b 'to '\o eMetaPrettyPrint(ME') '\b 'is '\o '\n 17428 if OMS =/= none then '\s '\s eMetaPrettyPrint(ME, ME', DB, SMS, SMS, OMS) else nil fi 17429 if OMS =/= none then '\s '\s eMetaPrettyPrint(ME, ME', DB, OMS, SMS, OMS) else nil fi 17430 '\b 'endv '\o '\n ) 17431 if QIL QI := eMetaPrettyPrint(VE) . 17432 eq eMetaPrettyPrint(DB, viewError(QIL)) = QIL . 17433 17434 ceq eMetaPrettyPrint(QI) = QI if not QI :: Type . 17435 ceq eMetaPrettyPrint(((VE, VE'))) 17436 = eMetaPrettyPrint(VE) '`, '\s eMetaPrettyPrint(VE') 17437 if VE =/= nil /\ VE' =/= nil . 17438 eq eMetaPrettyPrint(QI{VE}) = QI '`{ eMetaPrettyPrint(VE) '`} '\s . 17439 17440 ceq eMetaPrettyPrint(ME, ME', DB, SM SMS, SMS', OMS') 17441 = (eMetaPrettyPrint(ME, ME', DB, SM, SMS', OMS') '\n 17442 '\s '\s eMetaPrettyPrint(ME, ME', DB, SMS, SMS', OMS')) 17443 if SMS =/= none . 17444 ceq eMetaPrettyPrint(ME, ME', DB, OM OMS, SMS', OMS') 17445 = (eMetaPrettyPrint(ME, ME', DB, OM, SMS', OMS') '\n 17446 '\s '\s eMetaPrettyPrint(ME, ME', DB, OMS, SMS', OMS')) 17447 if OMS =/= none . 17448 eq eMetaPrettyPrint(ME, ME', DB, (none).SortMappingSet, SMS, OMS) = nil . 17449 eq eMetaPrettyPrint(ME, ME', DB, (none).OpMappingSet, SMS, OMS) = nil . 17450 17451 eq eMetaPrettyPrint(ME, ME', DB, op_to`term_.(T, T'), SMS, OMS) 17452 = ('\b 'op '\o eMetaPrettyPrint(getFlatModule(ME, DB), T) '\b 'to 17453 'term '\o eMetaPrettyPrint(getFlatModule(ME', DB), T') '\b '. '\o) . 17454 17455 eq eMetaPrettyPrint(ME, ME', DB, op_to`term_.(T, T'), SMS, OMS) 17456 = ('op eMetaPrettyPrint(T) '\b 'to 'term '\o eMetaPrettyPrint(T') '. '\n) . 17457 eq eMetaPrettyPrint(ME, ME', DB, op F to F' ., SMS, OMS) 17458 = ('\b 'op '\o F '\b 'to '\o F' '. '\n) . 17459 eq eMetaPrettyPrint(ME, ME', DB, op F : TyL -> Ty to F' ., SMS, OMS) 17460 = ('\b 'op '\o F '\b ': 17461 '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty) 17462 '\b 'to '\o F' '. '\n) . 17463 eq eMetaPrettyPrint(ME, ME', DB, sort S to S' ., SMS, OMS) 17464 = ('\b 'sort '\o eMetaPrettyPrint(S) '\b 'to '\o eMetaPrettyPrint(S') '. '\n) . 17465 eq eMetaPrettyPrint(ME, ME', DB, class S to S' ., SMS, OMS) 17466 = ('\b 'class '\o eMetaPrettyPrint(S) '\b 'to '\o eMetaPrettyPrint(S') '. '\n) . 17467 eq eMetaPrettyPrint(ME, ME', DB, attr QI . S to QI' ., SMS, OMS) 17468 = ('\b 'attr '\o eMetaPrettyPrint(S) '\b '. '\o QI '\b 'to '\o QI' '. '\n) . 17469 eq eMetaPrettyPrint(ME, ME', DB, msg F to F' ., SMS, OMS) 17470 = ('\b 'msg '\o F '\b 'to '\o F' '. '\n) . 17471 eq eMetaPrettyPrint(ME, ME', DB, msg F : TyL -> Ty to F' ., SMS, OMS) 17472 = ('\b 'msg '\o F '\b ': 17473 '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty) 17474 '\b 'to '\o F' '. '\n) . 17475endfm 17476 17477******************************************************************************* 17478 17479*** 17480*** 8.3 Input Processing 17481*** 17482 17483*** The processing functions presented in the following modules are in charge 17484*** of taking each term generated by the \texttt{metaParse} function and, 17485*** after transforming it into an element of the data types \texttt{Module} or 17486*** \texttt{View}, or generating some output, returning the database resulting 17487*** from introducing in it such a term. We shall see in 17488*** Section~\ref{database-handling} how the appropriate function is called 17489*** after having performed a first analysis of the term, in which it is 17490*** detected whether the input corresponds to a unit, view, or command. In the 17491*** cases of units and views the processing is quite similar. After a 17492*** preprocessing of the term, the function \texttt{parseDecl} is called with 17493*** each of the subterms representing declarations, resulting in units or 17494*** views with the parsed declarations in it. 17495 17496*** 17497*** 8.3.1 Module Processing 17498*** 17499 17500*** The processing of a term resulting from the parsing of some input 17501*** corresponding to a unit is accomplished by the \texttt{procModule} function. 17502*** This function takes as arguments a term of sort \texttt{Term}, which 17503*** represents some preunit, and a database. The function then enters into the 17504*** given database the unit obtained from the transformation of such term 17505*** into a term of sort \texttt{Module}. 17506 17507fmod UNIT-PROCESSING is 17508 pr DATABASE . 17509 pr UNIT-DECL-PARSING . 17510 pr EVALUATION . 17511 pr RENAMING-SET-APPL-ON-UNIT . 17512 pr META-FULL-MAUDE-SIGN . 17513 pr MOD-EXP-PARSING . 17514 17515 vars QI F X : Qid . 17516 var M : Module . 17517 vars PU PU' U U' : Module . 17518 vars DB DB' : Database . 17519 vars T T' T'' T3 : Term . 17520 var TL : TermList . 17521 vars PL PL' PL'' : ParameterList . 17522 var PDL : ParameterDeclList . 17523 var IL IL' : ImportList . 17524 var ME : ModuleExpression . 17525 var S : Sort . 17526 var SS : SortSet . 17527 var ME' : ModuleExpression . 17528 var VMAPS : RenamingSet . 17529 var B : Bool . 17530 var VDS : OpDeclSet . 17531 var QIL : QidList . 17532 var PDR : ParseDeclResult . 17533 var DT : Default{Term} . 17534 17535*** The \texttt{parseParList} takes a term representing a list of parameters 17536*** and returns the corresponding list. 17537 17538 op parseParList : Term -> ParameterDeclList . 17539 eq parseParList('_::_['token[T], T']) = downQid(T) :: parseModExp(T') . 17540 eq parseParList('_`,_[T, T']) = (parseParList(T), parseParList(T')) . 17541 17542*** All the operators declared as constructors of sort \texttt{PreModule} in 17543*** the signature of Full Maude, given in Appendix~\ref{signature-full-maude}, 17544*** are declared with two arguments, namely, the name, or name and interface, 17545*** of the unit, and the list of declarations of such units. The function 17546*** \texttt{procModule3} is called with the term corresponding to the name, or 17547*** name and interface, of the module as first argument, the term corresponding 17548*** to the set of declarations as second argument, and an empty module of the 17549*** appropriate type, in which the different declarations will be accumulated, 17550*** as third argument. 17551 17552*** The task of the function \texttt{procModule4} is then to make a second 17553*** level parsing of the input, building up, simultaneously, the preunit 17554*** represented in the term passed as argument, and the unit resulting from the 17555*** declarations without bubbles. This unit without bubbles will be used by the 17556*** \texttt{evalPreModule} function to build the signature with which to 17557*** analyze the bubbles in the preunit (see Section~\ref{evaluation}). 17558 17559*** The case of parameterized modules requires a special treatment of the 17560*** parameters. These parameters are evaluated and are added as submodules in 17561*** the appropriate way. 17562 17563*** When the last declaration is parsed, the function \texttt{evalPreModule} is 17564*** called with the preunit (the top module with bubbles) as first argument, 17565*** the empty copy of it as second argument, the top module without bubbles as 17566*** third argument, and the database. 17567 17568*** Note that the \texttt{procModule} function adds a declaration importing the 17569*** module \texttt{CONFIGURATION+}, presented in 17570*** Section~\ref{non-built-in-predefined}, to the object-oriented modules, and 17571*** that \texttt{procModule4} adds a declaration importing the built-in module 17572*** \texttt{BOOL} to all modules. 17573 17574 op procModule : Term Database -> Database . 17575 *** moved to MOD-EXPR-EVAL to solve dependency 17576 *** op procModule : Qid Database -> Database . 17577 op procModule2 : Term Term Database -> Database . 17578 op procModule2 : Term Database -> Database . 17579 op procModule3 : Term Term Term Module Database -> Database . 17580 op procModule3 : Term Term Module Database -> Database . 17581 op procModule4 : Term Term Module Module OpDeclSet Database -> Database . 17582 op procModule4 : Term Module Module OpDeclSet Database -> Database . 17583 17584 *** When recompiling a module, it's called with a Qid, and it's 17585 *** not reentered into the database. 17586 17587 ceq procModule(QI, DB) 17588 = if DT == null 17589 then evalModule(U, VDS, DB) 17590 else procModule2(DT, DB) 17591 fi 17592 if < DT ; VDS ; U > := getTermModule(QI, DB) . 17593 eq procModule(T, DB) = procModule2(T, T, DB) . 17594 17595 *** procModule2 just calls procModule3 with the name and the declarations of 17596 *** the module, and an empty unit of the right type. 17597 17598 eq procModule2(T, 'fmod_is_endfm[T', T''], DB) 17599 = procModule3(T, T', T'', emptyFModule, DB) . 17600 eq procModule2(T, 'obj_is_endo[T', T''], DB) 17601 = procModule3(T, T', T'', emptyFModule, DB) . 17602 eq procModule2(T, 'obj_is_jbo[T', T''], DB) 17603 = procModule3(T, T', T'', emptyFModule, DB) . 17604 eq procModule2(T, 'mod_is_endm[T', T''], DB) 17605 = procModule3(T, T', T'', emptySModule, DB) . 17606 eq procModule2(T, 'omod_is_endom[T', T''], DB) 17607 = procModule3(T, T', T'', 17608 addImports((including 'CONFIGURATION . including 'CONFIGURATION+ .), 17609 emptyOModule), 17610 DB) . 17611 eq procModule2(T, 'fth_is_endfth[T', T''], DB) 17612 = procModule3(T, T', T'', emptyFTheory, DB) . 17613 eq procModule2(T, 'th_is_endth[T', T''], DB) 17614 = procModule3(T, T', T'', emptySTheory, DB) . 17615 eq procModule2(T, 'oth_is_endoth[T', T''], DB) 17616 = procModule3(T, T', T'', 17617 addImports((including 'CONFIGURATION . including 'CONFIGURATION+ .), 17618 emptyOTheory), 17619 DB) . 17620 17621 eq procModule2('fmod_is_endfm[T, T'], DB) 17622 = procModule3(T, T', emptyFModule, DB) . 17623 eq procModule2('obj_is_endo[T, T'], DB) 17624 = procModule3(T, T', emptyFModule, DB) . 17625 eq procModule2('obj_is_jbo[T, T'], DB) 17626 = procModule3(T, T', emptyFModule, DB) . 17627 eq procModule2('mod_is_endm[T, T'], DB) 17628 = procModule3(T, T', emptySModule, DB) . 17629 eq procModule2('omod_is_endom[T, T'], DB) 17630 = procModule3(T, T', 17631 addImports((including 'CONFIGURATION+ .), 17632 emptyOModule), 17633 DB) . 17634 eq procModule2('fth_is_endfth[T, T'], DB) 17635 = procModule3(T, T', emptyFTheory, DB) . 17636 eq procModule2('th_is_endth[T, T'], DB) 17637 = procModule3(T, T', emptySTheory, DB) . 17638 eq procModule2('oth_is_endoth[T, T'], DB) 17639 = procModule3(T, T', 17640 addImports((including 'CONFIGURATION+ .), 17641 emptyOTheory), 17642 DB) . 17643 17644 *** procModule3 evaluates the name of the module and calls procModule4 17645 *** with the declarations, two empty units (one to contain the declarations 17646 *** with bubbles and another one the declarations without bubbles), and 17647 *** a set of op decls initialy empty in which to store the variables 17648 17649 ceq procModule3(T, 'token[T'], T'', U, DB) 17650 = procModule4(T, T'', setName(U, QI), setName(U, QI), none, DB) 17651 if QI := downQid(T') . 17652 ceq procModule3(T, '_`{_`}['token[T'], T''], T3, U, DB) 17653 = procModule4(T, T3, setPars(setName(U, QI), parseParList(T'')), 17654 setName(U, QI), none, DB) 17655 if QI := downQid(T') . 17656 17657 ceq procModule3('token[T], T', U, DB) 17658 = procModule4(T', setName(U, QI), setName(U, QI), none, DB) 17659 if QI := downQid(T) . 17660 ceq procModule3('_`{_`}['token[T], T'], T'', U, DB) 17661 = procModule4(T'', setPars(setName(U, QI), parseParList(T')), 17662 setName(U, QI), none, DB) 17663 if QI := downQid(T) . 17664 17665 *** procModule4 parses one by one each of the declarations in the module. 17666 *** Note that is parseDecl that adds the parsed declaration to the right 17667 *** place. When it is done, it calls evalPreModule with the resulting 17668 *** preModule-unit-vars triple. 17669 17670 ceq procModule4(T, '__[T', T''], PU, U, VDS, DB) 17671 = procModule4(T, T'', preModule(PDR), unit(PDR), vars(PDR), DB) 17672 if PDR := parseDecl(T', PU, U, VDS) . 17673 ceq procModule4(T, F[TL], PU, U, VDS, DB) 17674 = evalPreModule(preModule(PDR), unit(PDR), vars(PDR), 17675 insTermModule(getName(U), T, DB)) 17676 if F =/= '__ 17677 /\ PDR := parseDecl(F[TL], PU, U, VDS) . 17678 eq procModule4(T, T', unitError(QIL), V:[Module], V:[OpDeclSet], DB) 17679 = warning(DB, QIL) . 17680 eq procModule4(T, T', V:[Module], unitError(QIL), V:[OpDeclSet], DB) 17681 = warning(DB, QIL) . 17682 eq procModule4(T, T', V:[Module], V':[Module], opDeclError(QIL), DB) 17683 = warning(DB, QIL) . 17684 eq procModule4(T, F[TL], PU, U, VDS, DB) 17685 = warning(DB,'Error: 'no 'parse 'for F 'declaration) 17686 [owise] . 17687 17688 ceq procModule4('__[T, T'], PU, U, VDS, DB) 17689 = procModule4(T', preModule(PDR), unit(PDR), vars(PDR), DB) 17690 if PDR := parseDecl(T, PU, U, VDS) . 17691 ceq procModule4(F[TL], PU, U, VDS, DB) 17692 = evalPreModule(preModule(PDR), unit(PDR), vars(PDR), DB) 17693 if F =/= '__ 17694 /\ PDR := parseDecl(F[TL], PU, U, VDS) . 17695 eq procModule4(T, unitError(QIL), U, VDS, DB) = warning(DB, QIL) . 17696 eq procModule4(T, PU, unitError(QIL), VDS, DB) = warning(DB, QIL) . 17697 eq procModule4(T, PU, U, opDeclError(QIL), DB) = warning(DB, QIL) . 17698 eq procModule4(F[TL], PU, U, VDS, DB) 17699 = warning(DB,'Error: 'no 'parse 'for F 'declaration) 17700 [owise] . 17701 17702endfm 17703 17704******************************************************************************* 17705 17706*** 17707*** 8.3.2 View Processing 17708*** 17709 17710*** A similar process is followed for views. Note that in case of operator 17711*** maps going to derived terms we have bubbles, which will have to be treated 17712*** using the signatures of the appropriate modules. 17713 17714fmod VIEW-PROCESSING is 17715 pr UNIT-PROCESSING . 17716 pr VIEW-DECL-PARSING . 17717 pr VIEW-BUBBLE-PARSING . 17718 17719 vars QI X F : Qid . 17720 var QIL : QidList . 17721 vars T T' T'' T3 T4 : Term . 17722 var M : Module . 17723 var VE : ViewExp . 17724 var V : View . 17725 vars PV PV' : PreView . 17726 vars ME ME' : ModuleExpression . 17727 vars DB DB' : Database . 17728 vars OPDS VDS VDS' VDS'' : OpDeclSet . 17729 var MDS : MsgDeclSet . 17730 var TL : TermList . 17731 vars PDL PDL' : ParameterDeclList . 17732 var H : Header . 17733 var IL : ImportList . 17734 var SMS : SortMappingSet . 17735 var OMS : OpMappingSet . 17736 17737*** As the functions \texttt{getThSorts} and \texttt{getThClasses} 17738*** presented in Section~\ref{instantiation}, the functions 17739*** \texttt{getThOpDeclSet} and \texttt{getThMsgDeclSet} return, respectively, 17740*** the set of declarations of operators, and the set of declarations of 17741*** messages in the theory part of the structure of the module given as 17742*** argument. 17743 17744 op getThOpDeclSet : Header Database -> OpDeclSet . 17745 op getThMsgDeclSet : Header Database -> MsgDeclSet . 17746 17747 op getThOpDeclSetAux : ImportList Database -> OpDeclSet . 17748 op getThMsgDeclSetAux : ImportList Database -> MsgDeclSet . 17749 17750 eq getThOpDeclSet(ME, DB) 17751 = if theory(getTopModule(ME, DB)) 17752 then (getThOpDeclSetAux(getImports(getTopModule(ME, DB)), DB) 17753 getOps(getTopModule(ME, DB))) 17754 else none 17755 fi . 17756 17757 eq getThOpDeclSetAux(((including ME .) IL), DB) 17758 = (getThOpDeclSet(ME, DB) getThOpDeclSetAux(IL, DB)) . 17759 eq getThOpDeclSetAux(((extending ME .) IL), DB) 17760 = (getThOpDeclSet(ME, DB) getThOpDeclSetAux(IL, DB)) . 17761 eq getThOpDeclSetAux(((protecting ME .) IL), DB) 17762 = (getThOpDeclSet(ME, DB) getThOpDeclSetAux(IL, DB)) . 17763 eq getThOpDeclSetAux(nil, DB) = none . 17764 17765 eq getThMsgDeclSet(ME, DB) 17766 = if theory(getTopModule(ME, DB)) 17767 then (getThMsgDeclSetAux(getImports(getTopModule(ME, DB)), DB) 17768 getMsgs(getTopModule(ME, DB))) 17769 else none 17770 fi . 17771 17772 eq getThMsgDeclSetAux(((including ME .) IL), DB) 17773 = (getThMsgDeclSet(ME, DB) getThMsgDeclSetAux(IL, DB)) . 17774 eq getThMsgDeclSetAux(((extending ME .) IL), DB) 17775 = (getThMsgDeclSet(ME, DB) getThMsgDeclSetAux(IL, DB)) . 17776 eq getThMsgDeclSetAux(((protecting ME .) IL), DB) 17777 = (getThMsgDeclSet(ME, DB) getThMsgDeclSetAux(IL, DB)) . 17778 eq getThMsgDeclSetAux(nil, DB) = none . 17779 17780*** The processing of terms representing previews accomplished by the function 17781*** \texttt{procView} is quite similar to the one accomplished by 17782*** \texttt{procModule} on terms representing preunits. The algorithms followed 17783*** are also quite similar. Both proceed recursively on the list of 17784*** declarations, accumulating them in a preunit or in a preview. 17785 17786*** The solving of bubbles in views requires the signatures of the source and 17787*** target units extended, respectively, with the declarations of variables in 17788*** the view and with the mappings of these declarations. As we shall see in 17789*** Section~\ref{databaseADT}, the signatures of the built-in modules are not 17790*** accesible at the metalevel, and thus built-in modules cannot be used 17791*** directly as arguments of built-in functions. Thus, to be able to use them 17792*** as targTS of views, a `dummy' module is created importing the 17793*** corresponding predefined module. The source and target module expressions 17794*** of the view are evaluated before the view processing itself starts. 17795 17796*** As we saw in Section~\ref{view-decl-parsing}, parsing of terms representing 17797*** operator and message maps requires the set of operator and message 17798*** declarations in the theory part of the source theory. 17799 17800 op procPars : ParameterDeclList Database -> Database . 17801 17802 eq procPars((X :: ME, PDL), DB) 17803 = procPars(PDL, createCopy((X :: ME), database(evalModExp(ME, DB)))) . 17804 eq procPars((nil).ParameterDeclList, DB) = DB . 17805 17806 op procView : Term Database -> Database . 17807 op procView2 : Term Database -> Database . 17808 op procView : Term PreView Database -> Database . 17809 op procViewAux : Term PreView OpDeclSet MsgDeclSet Module Database -> Database . 17810 17811 eq procView(QI, DB) 17812 = procView2(getTermView(QI, DB), DB) . 17813 17814 eq procView2('view_from_to_is_endv['token[T], T', T'', T3], DB) 17815 = procView(T3, 17816 emptyPreView(downQid(T), parseModExp(T'), parseModExp(T'')), 17817 DB) . 17818 eq procView2('view_from_to_is_endv['_`{_`}['token[T], T'], T'', T3, T4], DB) 17819 = procView(T4, 17820 setPars( 17821 emptyPreView(downQid(T), parseModExp(T''), parseModExp(T3)), 17822 parseParList(T')), 17823 procPars(parseParList(T'), DB)) . 17824 17825 eq procView('view_from_to_is_endv['token[T], T', T'', T3], DB) 17826 = procView(T3, 17827 emptyPreView(downQid(T), parseModExp(T'), parseModExp(T'')), 17828 insertTermView(downQid(T), 17829 'view_from_to_is_endv['token[T], T', T'', T3], DB)) . 17830 eq procView('view_from_to_is_endv['_`{_`}['token[T], T'], T'', T3, T4], DB) 17831 = procView(T4, 17832 setPars( 17833 emptyPreView(downQid(T), parseModExp(T''), parseModExp(T3)), 17834 parseParList(T')), 17835 procPars(parseParList(T'), 17836 insertTermView(downQid(T), 17837 'view_from_to_is_endv['_`{_`}['token[T], T'], T'', T3, T4], 17838 DB))) . 17839 17840 ceq procView(V, DB) 17841 = insertView(V, DB') 17842 if DB' := database(evalModExp(getFrom(V), nil, database(evalModExp(getTo(V), nil, DB)))) . 17843 17844 ceq procView(T, PV, DB) 17845 = procViewAux(T, PV, 17846 getThOpDeclSet(ME, DB'), 17847 getThMsgDeclSet(ME, DB'), 17848 getFlatModule(ME, DB'), 17849 DB') 17850 if preview_from_to_is___endpv(VE, ME, ME', none, none, none) := PV 17851 /\ DB' := database(evalModExp(ME', nil, database(evalModExp(ME, nil, DB)))) . 17852 ceq procView(T, PV, DB) 17853 = procViewAux(T, PV, 17854 getThOpDeclSet(ME, DB':[Database]), 17855 getThMsgDeclSet(ME, DB':[Database]), 17856 getFlatModule(ME, DB':[Database]), 17857 DB':[Database]) 17858 if preview_from_to_is___endpv(VE{PDL}, ME, ME', none, none, none) := PV 17859 /\ DB':[Database] := database(evalModExp(ME', PDL, database(evalModExp(ME, PDL, DB)))) . 17860 17861 eq procViewAux('none.ViewDeclSet, preview_from_to_is___endpv(VE{PDL}, ME, ME', VDS, SMS, OMS), OPDS, MDS, M, DB) 17862 = insertView(view VE{PDL} from ME to ME' is none none endv, DB) . 17863 eq procViewAux('none.ViewDeclSet, preview_from_to_is___endpv(VE, ME, ME', VDS, SMS, OMS), OPDS, MDS, M, DB) 17864 = insertView(view VE from ME to ME' is none none endv, DB) . 17865 eq procViewAux('__[T, T'], PV, OPDS, MDS, M, DB) 17866 *** - OPDS and MDS are, respectively, the set of operation and 17867 *** message declarations in the theory part of the source. 17868 *** - M is the signature of the source theory. 17869 = procViewAux(T', parseDecl(T, PV, OPDS, MDS, M), OPDS, MDS, M, DB) . 17870 ceq procViewAux(F[TL], PV, OPDS, MDS, M, DB) 17871 = insertView( 17872 view VE{PDL} from ME to ME' is 17873 SMS 17874 solveBubbles( 17875 OMS, 17876 VDS, VDS', 17877 addOps(VDS, M), 17878 addOps(VDS', getFlatModule(ME', DB))) 17879 endv, 17880 DB) 17881 if F =/= '__ 17882 /\ preview_from_to_is___endpv(VE{PDL}, ME, ME', VDS, SMS, OMS) := parseDecl(F[TL], PV, OPDS, MDS, M) 17883 /\ VDS' := applyMapsToOps(maps2rens(SMS), none, VDS, M) . 17884 ceq procViewAux(F[TL], PV, OPDS, MDS, M, DB) 17885 = insertView( 17886 view VE from ME to ME' is 17887 SMS 17888 solveBubbles( 17889 OMS, 17890 VDS, VDS', 17891 addOps(VDS, M), 17892 addOps(VDS', getFlatModule(ME', DB))) 17893 endv, 17894 DB) 17895 if F =/= '__ 17896 /\ preview_from_to_is___endpv(VE, ME, ME', VDS, SMS, OMS) := parseDecl(F[TL], PV, OPDS, MDS, M) 17897 /\ VDS' := applyMapsToOps(maps2rens(SMS), none, VDS, M) . 17898 eq procViewAux(T, PV, OPDS, MDS, unitError(QIL), DB) = warning(DB, QIL) . 17899endfm 17900 17901******************************************************************************* 17902 17903*** 17904*** 8.3.3 Command Processing 17905*** 17906 17907*** The function \texttt{procCommand} only handles the \texttt{reduce}, 17908*** \texttt{rewrite}, and \texttt{down} commands. The other commands are 17909*** directly evaluated by the rules for the top-level handling of the 17910*** database (see Section~\ref{database-handling}). The \texttt{procCommand} 17911*** function takes a term, which represents one of these commands, the name of 17912*** the default module, and a database. The result is a list of quoted 17913*** identifiers representing the result of the evaluation of the command that 17914*** will be placed in the read-eval-print loop to be printed in the terminal. 17915 17916*** The \texttt{reduce} and \texttt{rewrite} commands are basically evaluated 17917*** calling the built-in functions \texttt{metaReduce} and 17918*** \texttt{metaRewrite}, respectively. These functions are called with the 17919*** appropriate modules. In the case of commands in which an explicit module 17920*** is not specified the default module is used. 17921 17922*** The preparation of the output for these functions becomes more complex 17923*** when the \texttt{down} command is used. To deal with the \texttt{down} 17924*** command, an auxiliary function \texttt{procCommand2} is introduced, 17925*** returning the term resulting from the evaluation of the command. 17926 17927fmod COMMAND-PROCESSING is 17928 pr AX-COHERENCE-COMPLETION . 17929 pr UNIT-PROCESSING . 17930 pr UNIT-META-PRETTY-PRINT . 17931 inc (2TUPLE * (op `(_`,_`) to <<_;_>>, 17932 op p1_ to getDatabase, 17933 op p2_ to getQidList)) {Database, QidList} . 17934 pr META-FULL-MAUDE-SIGN . 17935 pr META-NARROWING-SEARCH * (op addOps to addOpsSE, op addEqs to addEqsSE, op addSorts to addSortsSE) . 17936 17937 eq getDatabase(<< DB ; qidError(QIL) >>) = warning(DB, QIL) . 17938 eq getQidList(<< DB ; qidError(QIL) >>) = QIL . 17939 17940 op {_,_} : Term Type ~> ResultPair [ctor] . 17941 op {_,_,_} : Term Type Substitution ~> ResultTriple [ctor] . 17942 op {_,_,_,_} : Term Type Substitution Context ~> Result4Tuple [ctor] . 17943 op {_,_} : Substitution Context ~> MatchPair [ctor] . 17944 17945*** projection functions (from prelude.maude) 17946 op getTerm : ResultPair ~> Term . 17947 eq getTerm({T:[Term], T':[Type]}) = T:[Term] . 17948 op getType : ResultPair ~> Type . 17949 eq getType({T:[Term], T':[Type]}) = T':[Type] . 17950 17951 op getTerm : ResultTriple ~> Term . 17952 eq getTerm({T:[Term], T':[Type], S:[Substitution]}) = T:[Term] . 17953 op getType : ResultTriple ~> Type . 17954 eq getType({T:[Term], T':[Type], S:[Substitution]}) = T':[Type] . 17955 op gTSubstitution : ResultTriple ~> Substitution . 17956 eq gTSubstitution({T:[Term], T':[Type], S:[Substitution]}) 17957 = S:[Substitution] . 17958 17959 op getTerm : Result4Tuple ~> Term . 17960 eq getTerm({T:[Term], T':[Type], S:[Substitution], C:[Context]}) = T:[Term] . 17961 op getType : Result4Tuple ~> Type . 17962 eq getType({T:[Term], T':[Type], S:[Substitution], C:[Context]}) = T':[Type] . 17963 op gTSubstitution : Result4Tuple ~> Substitution . 17964 eq gTSubstitution({T:[Term], T':[Type], S:[Substitution], C:[Context]}) 17965 = S:[Substitution] . 17966 op getContext : Result4Tuple ~> Context . 17967 eq getContext({T:[Term], T':[Type], S:[Substitution], C:[Context]}) 17968 = C:[Context] . 17969 17970 op gTSubstitution : MatchPair ~> Substitution . 17971 eq gTSubstitution({S:[Substitution], C:[Context]}) = S:[Substitution] . 17972 op getContext : MatchPair ~> Context . 17973 eq getContext({S:[Substitution], C:[Context]}) = C:[Context] . 17974 17975 vars T T' T'' T''' OT : Term . 17976 var TL : TermList . 17977 vars DB DB' DB'' : Database . 17978 var DB? : [Database] . 17979 vars M M' : Module . 17980 var M? : [Module] . 17981 vars ME ME' : ModuleExpression . 17982 vars H H' : Header . 17983 vars MNS MNS' MNS'' MNS3 MNS4 : Set{ModuleName} . 17984 var VE : ViewExp . 17985 var VES : Set{ViewExp} . 17986 vars N I J : Nat . 17987 var I? : [Nat] . 17988 vars D D' : Bound . 17989 var D? : [Bound] . 17990 var B : Bool . 17991 var B? : [Bool] . 17992 vars MIS MIS' : Set{ModuleInfo} . 17993 var VIS : Set{ViewInfo} . 17994 vars PDS PDS' : Set{ParameterDecl} . 17995 var QIL : QidList . 17996 var SS : SortSet . 17997 var SSDS : SubsortDeclSet . 17998 vars VS VDS OPDS : OpDeclSet . 17999 var OPDS? : [OpDeclSet] . 18000 var MAS : MembAxSet . 18001 var EqS : EquationSet . 18002 var RlS : RuleSet . 18003 vars QI QI' F V O : Qid . 18004 var Ct : Constant . 18005 var IL : ImportList . 18006 var TM : [Tuple{Term,Module,Bool,OpDeclSet,Database}] . 18007 var TMVB : [Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}] . 18008 var TMVBN : [Tuple{Term,Module,OpDeclSet,Bound,Nat}] . 18009 var T? : [Term] . 18010 var RP : [ResultPair] . 18011 var RT : [ResultTriple] . 18012 var Sb? : [Substitution] . 18013 var MP? : [MatchPair] . 18014 var CD : Condition . 18015 var Sb : Substitution . 18016 var UP? : [UnificationPair] . 18017 var UP : UnificationProblem . 18018 18019---- sorts Tuple{Term,Module,Bool,OpDeclSet,Database} 18020---- Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} 18021---- Tuple{Term,Module,OpDeclSet,Bound,Nat} . 18022---- op `{_`,_`,_`,_`,_`} : Term Module Bool OpDeclSet Database 18023---- -> Tuple{Term,Module,Bool,OpDeclSet,Database} . 18024---- op `{_`,_`,_`,_`,_`,_`} : Term Module Bool OpDeclSet Bound Database 18025---- -> Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} . 18026---- op `{_`,_`,_`,_`,_`} : Term Module OpDeclSet Bound Nat 18027---- -> Tuple{Term,Module,OpDeclSet,Bound,Nat} . 18028 op tupleTMBODerror : QidList -> [Tuple{Term,Module,Bool,OpDeclSet,Database}] . 18029 op tupleTMBOBDerror : QidList -> [Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}] . 18030 op tupleTMOBNerror : QidList -> [Tuple{Term,Module,OpDeclSet,Bound,Nat}] . 18031 18032 pr 5TUPLE{Term,Module,Bool,OpDeclSet,Database} 18033 * (op ((_,_,_,_,_)) to `{_`,_`,_`,_`,_`}, 18034 op p1_ to getTerm, 18035 op p2_ to getModule, 18036 op p3_ to getBool, 18037 op p4_ to getVars, 18038 op p5_ to getDatabase) . 18039 pr 6TUPLE{Term,Module,Bool,OpDeclSet,Bound,Database} 18040 * (op ((_,_,_,_,_,_)) to `{_`,_`,_`,_`,_`,_`}, 18041 op p1_ to getTerm, 18042 op p2_ to getModule, 18043 op p3_ to getBool, 18044 op p4_ to getVars, 18045 op p5_ to getBound, 18046 op p6_ to getDatabase) . 18047 pr 5TUPLE{Term,Module,OpDeclSet,Bound,Nat} 18048 * (op ((_,_,_,_,_)) to `{_`,_`,_`,_`,_`}, 18049 op p1_ to getTerm, 18050 op p2_ to getModule, 18051 op p3_ to getVars, 18052 op p4_ to getBound, 18053 op p5_ to getNat) . 18054 18055 op boundError : QidList -> [Bound] . 18056---- op getTerm : Tuple{Term,Module,Bool,OpDeclSet,Database} ~> Term . 18057---- op getModule : Tuple{Term,Module,Bool,OpDeclSet,Database} ~> Module . 18058---- op getVars : Tuple{Term,Module,Bool,OpDeclSet,Database} ~> OpDeclSet . 18059---- op getBool : Tuple{Term,Module,Bool,OpDeclSet,Database} ~> Bool . 18060---- op getDatabase : Tuple{Term,Module,Bool,OpDeclSet,Database} ~> Database . 18061 18062---- op getTerm : Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} ~> Term . 18063---- op getModule : Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} ~> Module . 18064---- op getVars : Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} ~> OpDeclSet . 18065---- op getBound : Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} ~> Bound . 18066---- op getBool : Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} ~> Bool . 18067---- op getDatabase : Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} ~> Database . 18068 18069---- op getTerm : Tuple{Term,Module,OpDeclSet,Bound,Nat} ~> Term . 18070---- op getModule : Tuple{Term,Module,OpDeclSet,Bound,Nat} ~> Module . 18071---- op getVars : Tuple{Term,Module,OpDeclSet,Bound,Nat} ~> OpDeclSet . 18072---- op getBound : Tuple{Term,Module,OpDeclSet,Bound,Nat} ~> Bound . 18073---- op getNat : Tuple{Term,Module,OpDeclSet,Bound,Nat} ~> Nat . 18074 18075---- eq {qidError(QIL), M?, B?, OPDS?, DB?} = tupleTMBODerror(QIL) . 18076---- eq {qidError(QIL), M?, B?, OPDS?, D?, DB?} = tupleTMBOBDerror(QIL) . 18077---- eq {qidError(QIL), M?, OPDS?, D?, I?} = tupleTMOBNerror(QIL) . 18078 18079 eq getTerm({T, M, B, VDS, DB}) = T . 18080 eq getTerm(tupleTMBODerror(QIL)) = qidError(QIL) . 18081 eq getModule({T, M, B, VDS, DB}) = M . 18082 eq getModule(tupleTMBODerror(QIL)) = unitError(QIL) . 18083 eq getVars({T, M, B, VDS, DB}) = VDS . 18084 eq getVars(tupleTMBODerror(QIL)) = opDeclError(QIL) . 18085 eq getBool({T, M, B, VDS, DB}) = B . 18086 eq getBool(tupleTMBODerror(QIL)) = false . 18087 eq getDatabase({T, M, B, VDS, DB}) = DB . 18088 eq getDatabase(tupleTMBODerror(QIL)) = emptyDatabase . 18089 18090 eq getTerm({T, M, B, VDS, D, DB}) = T . 18091---- eq getTerm(error(QIL)) = qidError(QIL) . 18092 eq getModule({T, M, B, VDS, D, DB}) = M . 18093---- eq getModule(error(QIL)) = unitError(QIL) . 18094 eq getVars({T, M, B, VDS, D, DB}) = VDS . 18095---- eq getVars(error(QIL)) = opDeclError(QIL) . 18096 eq getBound({T, M, B, VDS, D, DB}) = D . 18097---- eq getBound(error(QIL)) = boundError(QIL) . 18098 eq getBool({T, M, B, VDS, D, DB}) = B . 18099---- eq getBool(error(QIL)) = false . 18100 eq getDatabase({T, M, B, VDS, D, DB}) = DB . 18101---- eq getDatabase(error(QIL)) = emptyDatabase . 18102 18103 eq getTerm({T, M, VDS, D, I}) = T . 18104---- eq getTerm(error(QIL)) = qidError(QIL) . 18105 eq getModule({T, M, VDS, D, I}) = M . 18106---- eq getModule(error(QIL)) = unitError(QIL) . 18107 eq getVars({T, M, VDS, D, I}) = VDS . 18108---- eq getVars(error(QIL)) = opDeclError(QIL) . 18109 eq getBound({T, M, VDS, D, I}) = D . 18110---- eq getBound(error(QIL)) = boundError(QIL) . 18111 eq getNat({T, M, VDS, D, I}) = I . 18112---- eq getNat(error(QIL)) = numberError(QIL) . 18113 18114 ---- procLoad 18115 18116 op procLoad : Term ModuleExpression Database -> Tuple{Database,QidList} . 18117 op procLoad : Term ModuleExpression Module OpDeclSet Database -> Tuple{Database,QidList} . 18118 18119 eq procLoad(T, ME, DB) 18120 = if compiledModule(ME, DB) 18121 then procLoad(T, ME, getFlatModule(ME, DB), getVars(ME, DB), DB) 18122 else procLoad(T, modExp(evalModExp(ME, DB)), 18123 getFlatModule(modExp(evalModExp(ME, DB)), 18124 database(evalModExp(ME, DB))), 18125 getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 18126 database(evalModExp(ME, DB))) 18127 fi . 18128 18129 ceq procLoad(T, ME, M, VDS, DB) 18130 = if downTerm(T:[Term], emptyFModule) =/= emptyFModule 18131 then << evalModule(downModule(T:[Term]), none, DB) ; 18132 'Introduced 'module header2Qid(getName(downModule(T:[Term]))) '\n >> 18133 else << DB ; '\r 'Error: '\o 'Incorrect 'metamodule. '\n >> 18134 fi 18135 if T:[Term] := getTerm(metaReduce(M, solveBubbles(T, M, true, VDS, DB))) . 18136 18137 ---- procCommand 18138 18139 op procCommand : Term ModuleExpression Database -> Tuple{Database,QidList} . 18140 op procCommand : Term ModuleExpression Module OpDeclSet Database -> QidList . 18141 op procDownCommand : Term ModuleExpression Database -> Tuple{Database,QidList} . 18142 18143 op procParse : ModuleExpression Module Term OpDeclSet Database -> QidList . 18144 18145 op procRed : ModuleExpression Module Term OpDeclSet Database -> QidList . 18146 op solveBubblesRed : Term Module Bool OpDeclSet Database 18147 -> [Tuple{Term,Module,Bool,OpDeclSet,Database}] . 18148 op solveBubblesRed2 : Term Database -> [Tuple{Term,Module,Bool,OpDeclSet,Database}] . 18149 op solveBubblesRed3 : Term Module ModuleExpression OpDeclSet Database -> [Tuple{Term,Module,Bool,OpDeclSet,Database}] . 18150 18151 op procRew : ModuleExpression Module Term OpDeclSet Database -> QidList . 18152 op solveBubblesRew : Term Module Bool Bound OpDeclSet Database -> [Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}] . 18153 op solveBubblesRew2 : Term Module Bool OpDeclSet Database -> [Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}] . 18154 18155 op procFrew : ModuleExpression Module Term Bound Nat OpDeclSet Database -> QidList . 18156 op solveBubblesFrew : Term Module Bool Bound Nat OpDeclSet Database -> [Tuple{Term,Module,OpDeclSet,Bound,Nat}] . 18157 op solveBubblesFrew2 : Term Module Bool Nat OpDeclSet Database -> [Tuple{Term,Module,OpDeclSet,Bound,Nat}] . 18158 18159 op procSearch : ModuleExpression Module Term Term Qid Bound Bound OpDeclSet Database -> QidList . 18160 op solveBubblesSearchL : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList . 18161 op solveBubblesSearchL1 : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList . 18162 op solveBubblesSearchR : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList . 18163 op solveBubblesSearchR1 : Module Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList . 18164 op solveBubblesSearchR2 : Module Term Term Qid Bound Bound OpDeclSet -> QidList . 18165 op procSearch2 : Module Term Term Condition Qid Bound Bound -> QidList . 18166 op procSearch3 : Module Term Term Condition Qid Bound Nat Bound -> QidList . 18167 18168 op procNarrowSearch : ModuleExpression Module Term Term Qid Bound Bound OpDeclSet Database -> QidList . 18169 op solveBubblesNarrowSearchL : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList . 18170 op solveBubblesNarrowSearchL1 : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList . 18171 op solveBubblesNarrowSearchR : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList . 18172 op solveBubblesNarrowSearchR1 : Module Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList . 18173 op solveBubblesNarrowSearchR2 : Module Term Term Qid Bound Bound OpDeclSet -> QidList . 18174 op procNarrowSearch2 : Module Term Term Condition Qid Bound Bound -> QidList . 18175 op procNarrowSearch3 : Module Nat TermList ResultTripleSet -> QidList . 18176 18177 op procMatch : ModuleExpression Module Term Term Qid Bound OpDeclSet Database -> QidList . 18178 op procMatch2 : Module Term Term Condition Qid Bound -> QidList . 18179 op procMatch3 : Module Term Term Condition Qid Bound Nat -> QidList . 18180 op solveBubblesMatch : Module Module Term Term Qid Bound Bool OpDeclSet Database ~> QidList . 18181 op solveBubblesMatch2 : Module Term Term Qid Bound OpDeclSet ~> QidList . 18182 18183 op procUnify : ModuleExpression Module Term Bound OpDeclSet Database -> QidList . 18184 op procUnify2 : ModuleExpression Module Term Bound OpDeclSet Database -> QidList . 18185 op addInfoUnify : Module -> [Module] . 18186 op parseUnify : Term OpDeclSet -> UnificationProblem . 18187 op procUnify2 : Module UnificationProblem Bound -> QidList . 18188 op eMetaPrettyPrint : Module UnificationProblem -> QidList . 18189 op procUnify3 : Module UnificationProblem Bound Nat -> QidList . 18190 op procUnify3Aux : Module UnificationPair Nat -> QidList . 18191 op unificationProblemError : QidList -> [UnificationProblem] . 18192 18193 op procIdUnify : ModuleExpression Module Term Bound OpDeclSet Database -> QidList . 18194 op procIdUnify2 : Module UnificationProblem Bound -> QidList . 18195 op procIdUnify3 : Module UnificationProblem Nat SubstitutionSet -> QidList . 18196 18197 op procVariantUnify : ModuleExpression Module Term Bound OpDeclSet Database -> QidList . 18198 op procVariantUnify2 : Module UnificationProblem Bound -> QidList . 18199 op procVariantUnify3 : Module UnificationProblem Nat SubstitutionSet -> QidList . 18200 18201 op procAsymmetricVariantUnify : ModuleExpression Module Term Bound OpDeclSet Database -> QidList . 18202 op procAsymmetricVariantUnify2 : Module UnificationProblem Bound -> QidList . 18203 op procAsymmetricVariantUnify3 : Module UnificationProblem Nat SubstitutionSet -> QidList . 18204 18205 op procGetVariants : ModuleExpression Module Term Bound OpDeclSet Database -> QidList . 18206 op parseGetVariants : Term OpDeclSet -> Term . 18207 op procGetVariants2 : Module Term Bound -> QidList . 18208 op procGetVariants3 : Module Term Nat VariantFourSet -> QidList . 18209 18210 op solveBubblesUnify : Module Term OpDeclSet ~> UnificationProblem . 18211 op solveBubblesRedUnify : Term Module Bool OpDeclSet Database 18212 -> [Tuple{Term,Module,Bool,OpDeclSet,Database}] . 18213 op solveBubblesRedUnify2 : Term Database -> [Tuple{Term,Module,Bool,OpDeclSet,Database}] . 18214 op solveBubblesRedUnify3 : Term Module ModuleExpression OpDeclSet Database 18215 -> [Tuple{Term,Module,Bool,OpDeclSet,Database}] . 18216 op procRewUnify : ModuleExpression Module Term OpDeclSet Database -> QidList . 18217 op solveBubblesRewUnify : Term Module Bool Bound OpDeclSet Database 18218 -> [Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}] . 18219 op solveBubblesRewUnify2 : Term Module Bool OpDeclSet Database 18220 -> [Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}] . 18221 18222 op eMetaPrettyPrint : Module Substitution -> QidList . 18223 18224 eq eMetaPrettyPrint(M, V <- T ; Sb:Substitution) 18225 = V '--> '\s eMetaPrettyPrint(M, T) 18226 if eMetaPrettyPrint(M, Sb:Substitution) == nil 18227 then nil 18228 else '; '\n eMetaPrettyPrint(M, Sb:Substitution) 18229 fi . 18230 eq eMetaPrettyPrint(M, (none).Substitution) = nil . 18231 18232 op procCommandUp : ModuleExpression Module Term OpDeclSet Database -> Term . 18233 op procRedUp : ModuleExpression Module Term OpDeclSet Database -> Term . 18234 op procRewUp : ModuleExpression Module Term Bound OpDeclSet Database -> Term . 18235 op procFrewUp : ModuleExpression Module Term Bound Nat OpDeclSet Database -> Term . 18236 18237*** Processing of commands. 18238 18239 ceq procDownCommand('down_:_[T, T'], ME, DB) 18240 = if T'':[Term] :: Term 18241 then << DB'' ; 18242 ('\b 'result '\o 18243 '\s eMetaPrettyPrint(leastSort(M, T'':[Term])) 18244 '\s '\b ': '\o '\n '\s '\s 18245 eMetaPrettyPrint(M, T'':[Term]) '\n) >> 18246 else << DB ; ('\r 'Error: '\o 'Incorrect 'input. '\n) >> 18247 fi 18248 if DB' := database(evalModExp(ME, DB)) 18249 /\ < DB'' ; ME' > := evalModExp(parseModExp(T), DB') 18250 /\ M := getFlatModule(ME', DB'') 18251 /\ T'':[Term] := procCommandUp(ME, getFlatModule(ME, DB''), T', getVars(ME, DB''), DB''). 18252 18253 eq procCommand(T, ME, DB) 18254 = if compiledModule(ME, DB) 18255 then << DB ; procCommand(T, ME, getFlatModule(ME, DB), getVars(ME, DB), DB) >> 18256 else << database(evalModExp(ME, DB)) ; 18257 procCommand(T, modExp(evalModExp(ME, DB)), 18258 getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 18259 getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 18260 database(evalModExp(ME, DB))) >> 18261 fi 18262 [owise] . 18263 18264---- eq procCommand(T, ME, unitError(QIL), VS, DB) = qidError(QIL) . 18265 eq procCommand(T, ME, unitError(QIL), VS, DB) = QIL . 18266 18267 eq procCommand('parse_.['bubble[T]], ME, M, VS, DB) 18268 = procParse(ME, M, 'bubble[T], VS, DB) . 18269 18270 eq procCommand('reduce_.['bubble[T]], ME, M, VS, DB) 18271 = procCommand('red_.['bubble[T]], ME, M, VS, DB) . 18272 eq procCommand('red_.['bubble[T]], ME, M, VS, DB) 18273 = procRed(ME, M, 'bubble[T], VS, DB) . 18274 18275 eq procCommand('rewrite_.['bubble[T]], ME, M, VS, DB) 18276 = procCommand('rew_.['bubble[T]], ME, M, VS, DB) . 18277 eq procCommand('rew_.['bubble[T]], ME, M, VS, DB) 18278 = procRew(ME, M, 'bubble[T], VS, DB) . 18279 18280 eq procCommand('frewrite_.['bubble[T]], ME, M, VS, DB) 18281 = procCommand('frew_.['bubble[T]], ME, M, VS, DB) . 18282 eq procCommand('frew_.['bubble[T]], ME, M, VS, DB) 18283 = procFrew(ME, M, 'bubble[T], unbounded, 1, VS, DB) . 18284 18285 eq procCommand('search_=>1_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 18286 = procSearch(ME, M, 'bubble[T], 'bubble[T'], '+, unbounded, 1, VS, DB) . 18287 eq procCommand('search_=>*_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 18288 = procSearch(ME, M, 'bubble[T], 'bubble[T'], '*, unbounded, unbounded, VS, DB) . 18289 eq procCommand('search_=>+_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 18290 = procSearch(ME, M, 'bubble[T], 'bubble[T'], '+, unbounded, unbounded, VS, DB) . 18291 eq procCommand('search_=>!_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 18292 = procSearch(ME, M, 'bubble[T], 'bubble[T'], '!, unbounded, unbounded, VS, DB) . 18293 18294 eq procCommand('search_~>1_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 18295 = procNarrowSearch(ME, M, 'bubble[T], 'bubble[T'], '+, unbounded, 1, VS, DB) . 18296 eq procCommand('search_~>*_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 18297 = procNarrowSearch(ME, M, 'bubble[T], 'bubble[T'], '*, unbounded, unbounded, VS, DB) . 18298 eq procCommand('search_~>+_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 18299 = procNarrowSearch(ME, M, 'bubble[T], 'bubble[T'], '+, unbounded, unbounded, VS, DB) . 18300 eq procCommand('search_~>!_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 18301 = procNarrowSearch(ME, M, 'bubble[T], 'bubble[T'], '!, unbounded, unbounded, VS, DB) . 18302 18303 eq procCommand('match_<=?_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 18304 = procMatch(ME, M, 'bubble[T], 'bubble[T'], 'match, 0, VS, DB) . 18305 eq procCommand('xmatch_<=?_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 18306 = procMatch(ME, M, 'bubble[T], 'bubble[T'], 'xmatch, 0, VS, DB) . 18307 18308 eq procCommand('unify_.['bubble[T]], ME, M, VS, DB) 18309 = procUnify(ME, M, 'bubble[T], unbounded, VS, DB) . 18310 18311 eq procCommand('id-unify_.['bubble[T]], ME, M, VS, DB) 18312 = procIdUnify(ME, M, 'bubble[T], unbounded, VS, DB) . 18313 18314 eq procCommand('variant`unify_.['bubble[T]], ME, M, VS, DB) 18315 = procVariantUnify(ME, M, 'bubble[T], unbounded, VS, DB) . 18316 18317 eq procCommand('asymmetric`variant`unify_.['bubble[T]], ME, M, VS, DB) 18318 = procAsymmetricVariantUnify(ME, M, 'bubble[T], unbounded, VS, DB) . 18319 18320 eq procCommand('get`variants_.['bubble[T]], ME, M, VS, DB) 18321 = procGetVariants(ME, M, 'bubble[T], unbounded, VS, DB) . 18322 18323 eq procCommandUp(ME, M, 'down_:_[T, T'], VDS, DB) 18324 = downTerm(procCommandUp(ME, M, T', VDS, DB)) . 18325 eq procCommandUp(ME, M, 'red_.['bubble[T]], VDS, DB) 18326 = downTerm(procRedUp(ME, M, 'bubble[T], VDS, DB)) . 18327 eq procCommandUp(ME, M, 'reduce_.['bubble[T]], VDS, DB) 18328 = downTerm(procRedUp(ME, M, 'bubble[T], VDS, DB)) . 18329 eq procCommandUp(ME, M, 'rew_.['bubble[T]], VDS, DB) 18330 = downTerm(procRewUp(ME, M, 'bubble[T], unbounded, VDS, DB)) . 18331 eq procCommandUp(ME, M, 'rewrite_.['bubble[T]], VDS, DB) 18332 = downTerm(procRewUp(ME, M, 'bubble[T], unbounded, VDS, DB)) . 18333 eq procCommandUp(ME, M, 'frew_.['bubble[T]], VDS, DB) 18334 = downTerm(procFrewUp(ME, M, 'bubble[T], unbounded, 0, VDS, DB)) . 18335 eq procCommandUp(ME, M, 'frewrite_.['bubble[T]], VDS, DB) 18336 = downTerm(procFrewUp(ME, M, 'bubble[T], unbounded, 0, VDS, DB)) . 18337 18338 ceq procRedUp(ME, M, T, VDS, DB) 18339 = if metaReduce(getModule(TM), getTerm(TM)) :: ResultPair 18340 then getTerm(metaReduce(getModule(TM), getTerm(TM))) 18341 else qidError('\r 'Error: '\o 'Incorrect 'command. '\n) 18342 fi 18343 if TM := solveBubblesRed(T, M, 18344 included('META-MODULE, getImports(getTopModule(ME, DB)), DB), 18345 VDS, DB) . 18346 18347 ceq procRewUp(ME, M, T, D, VDS, DB) 18348 = if metaRewrite(getModule(TMVB), getTerm(TMVB), getBound(TMVB)) 18349 :: ResultPair 18350 then getTerm(metaRewrite(getModule(TMVB), getTerm(TMVB), getBound(TMVB))) 18351 else qidError('\r 'Error: '\o 'Incorrect 'command. '\n) 18352 fi 18353 if TMVB := solveBubblesRew(T, M, 18354 included('META-MODULE, getImports(getTopModule(ME, DB)), DB), 18355 D, VDS, DB) . 18356 18357 ceq procFrewUp(ME, M, T, D, I, VDS, DB) 18358 = if metaFrewrite( 18359 getModule(TMVBN), getTerm(TMVBN), getBound(TMVBN), getNat(TMVBN)) 18360 :: ResultPair 18361 then getTerm( 18362 metaFrewrite(getModule(TMVBN), getTerm(TMVBN), 18363 getBound(TMVBN), getNat(TMVBN))) 18364 else qidError('\r 'Error: '\o 'Incorrect 'command. '\n) 18365 fi 18366 if TMVBN := solveBubblesFrew(T, M, 18367 included('META-MODULE, getImports(getTopModule(ME, DB)), DB), 18368 D, I, VDS, DB) . 18369 18370 ceq procParse(ME, M, T, VDS, DB) 18371 = if leastSort(getModule(TM), getTerm(TM)) :: Type 18372 then (eMetaPrettyPrint(leastSort(getModule(TM), getTerm(TM))) 18373 '\s '\b ': '\o '\n '\s '\s 18374 eMetaPrettyPrint(getModule(TM), getTerm(TM)) '\n) 18375 else getMsg(getTerm(TM)) 18376 fi 18377 if TM := solveBubblesRed(T, M, 18378 included('META-MODULE, getImports(getTopModule(ME, DB)), DB), 18379 VDS, DB) . 18380 eq procParse(ME, unitError(QIL), T, VDS, DB) = QIL . 18381 eq procParse(ME, noModule, T, VDS, DB) = getMsg(DB) . 18382 18383 ceq procRed(ME, M, T, VDS, DB) 18384 = if metaReduce(getModule(TM), getTerm(TM)) :: ResultPair 18385 then ('\b 'reduce 'in 18386 '\o eMetaPrettyPrint(getName(getModule(TM))) '\b ': '\o '\n '\s '\s 18387 eMetaPrettyPrint(getModule(TM), getTerm(TM)) '\n 18388 '\b 'result '\o '\s 18389 eMetaPrettyPrint(getType(metaReduce(getModule(TM), getTerm(TM)))) 18390 '\s '\b ': '\o '\n '\s '\s 18391 eMetaPrettyPrint(getModule(TM), 18392 getTerm(metaReduce(getModule(TM), getTerm(TM)))) 18393 '\n) 18394 else getMsg(getTerm(metaReduce(getModule(TM), getTerm(TM)))) 18395 fi 18396 if TM := solveBubblesRed(T, M, 18397 included('META-MODULE, getImports(getTopModule(ME, DB)), DB), 18398 VDS, DB) . 18399 eq procRed(ME, unitError(QIL), T, VDS, DB) = QIL . 18400 eq procRed(ME, noModule, T, VDS, DB) = getMsg(DB) . 18401 18402 eq metaReduce(unitError(QIL), T) = {qidError(QIL), '`[Term`]} . 18403 eq metaReduce(U:[Module], qidError(QIL)) = {qidError(QIL), '`[Term`]} . 18404 18405 ceq solveBubblesRed('bubble[QI], M, B, VDS, DB) 18406 = if T? :: Term 18407 then {T?, M, B, VDS, DB} 18408 else tupleTMBODerror('\r 'Error: '\o 'no 'parse 'for downQidList(QI) '\n) 18409 fi 18410 if T? := solveBubbles('bubble[QI], M, B, VDS, DB) . 18411 ceq solveBubblesRed('bubble['__[TL]], M, B, VDS, DB) 18412 = if T? :: Term 18413 then {T?, M, B, VDS, DB} 18414 else if metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), '@RedInPart@) :: ResultPair 18415 then solveBubblesRed2( 18416 getTerm(metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), '@RedInPart@)), 18417 DB) 18418 else tupleTMBODerror( 18419 '\r 'Warning: '\o 18420 printSyntaxError( 18421 metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), 18422 '@RedInPart@), downQidList('__[TL, ''..Qid])) '\n 18423 '\r 'Error: '\o 18424 'no 'parse 'for downQidList('__[TL, ''..Qid]) '\n) 18425 fi 18426 fi 18427 if T? := solveBubbles('bubble['__[TL]], M, B, VDS, DB) . 18428 *** There is some problem parsing 'in_:_ in solveBubblesRed, but it 18429 *** seems to work with the additional '. 18430 18431 ceq solveBubblesRed2('in_:_.[T, T'], DB) 18432 = if unitInDb(ME, DB') 18433 then solveBubblesRed3(T', getFlatModule(ME, DB'), ME, getVars(ME, DB'), DB') 18434 else tupleTMBODerror('\r 'Error: '\o 'It 'is 'not 'possible 'to 'compile eMetaPrettyPrint(ME) '. '\n) 18435 fi 18436 if < DB' ; ME > := evalModExp(parseModExp(T), DB) . 18437 eq solveBubblesRed2('in_:_.[T, T'], DB) 18438 = tupleTMBODerror('\r 'Error: '\o 'It 'isn't 'possible 'to 'compile eMetaPrettyPrint(parseModExp(T)) '. '\n) 18439 [owise] . 18440 18441 eq solveBubblesRed3(T, M, ME, VDS, DB) 18442 = {solveBubbles(T, M, 18443 included('META-MODULE, getImports(getTopModule(ME, DB)), DB), 18444 VDS, DB), 18445 M, 18446 included('META-MODULE, getImports(getTopModule(ME, DB)), DB), 18447 VDS, 18448 DB} . 18449 18450 op GRAMMAR-RED : -> FModule [memo] . 18451 eq GRAMMAR-RED 18452 = addImports((including 'MOD-EXPRS .), 18453 addSorts('@RedInPart@, 18454 addOps((op 'in_:_. : '@ModExp@ '@Bubble@ -> '@RedInPart@ [none] .), 18455 BUBBLES))) . 18456 18457 ceq procRew(ME, M, T, VDS, DB) 18458 = if RP :: ResultPair 18459 then ('\b 'rewrite 'in '\o eMetaPrettyPrint(getName(getModule(TMVB))) 18460 '\b ': '\o '\n '\s '\s 18461 eMetaPrettyPrint(getModule(TMVB), getTerm(TMVB)) '\n 18462 '\b 'result '\o '\s 18463 eMetaPrettyPrint(getType(RP)) 18464 '\s '\b ': '\o '\n '\s '\s 18465 eMetaPrettyPrint(getModule(TMVB), getTerm(RP)) 18466 '\n) 18467 else getMsg(getTerm(TMVB)) 18468 fi 18469 if TMVB := solveBubblesRew(T, M, 18470 included('META-MODULE, getImports(getTopModule(ME, DB)), DB), 18471 unbounded, VDS, DB) 18472 /\ RP := metaRewrite(getModule(TMVB), getTerm(TMVB), getBound(TMVB)) . 18473 eq procRew(ME, unitError(QIL), T, VDS, DB) = qidError(QIL) . 18474 18475 eq solveBubblesRew('bubble[QI], M, B, D, VDS, DB) 18476 = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term 18477 then {solveBubbles('bubble[QI], M, B, VDS, DB), M, B, VDS, unbounded, DB} 18478 else tupleTMBOBDerror( 18479 '\r 'Error: '\o 'no 'parsing 'for downQidList(QI) '\n) 18480 fi . 18481 eq solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB) 18482 = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term 18483 then {solveBubbles('bubble['__[TL]], M, B, VDS, DB), M, B, VDS, unbounded, DB} 18484 else if metaParse(GRAMMAR-REW, downQidList('__[TL, ''..Qid]), '@RewNuPart@) 18485 :: ResultPair 18486 then solveBubblesRew2( 18487 getTerm( 18488 metaParse(GRAMMAR-REW, downQidList('__[TL, ''..Qid]), 18489 '@RewNuPart@)), 18490 M, B, VDS, DB) 18491 else {getTerm(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), 18492 getModule(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), 18493 getBool(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), 18494 getVars(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), 18495 unbounded, 18496 getDatabase(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB))} 18497 fi 18498 fi . 18499 18500 eq solveBubblesRew2('`[_`]_.['token[T], T'], M, B, VDS, DB) 18501 = if downNat(downMetaNat(T)) :: Nat 18502 and-then solveBubblesRed(T', M, B, VDS, DB) 18503 :: Tuple{Term,Module,Bool,OpDeclSet,Database} 18504 then {getTerm(solveBubblesRed(T', M, B, VDS, DB)), 18505 getModule(solveBubblesRed(T', M, B, VDS, DB)), 18506 getBool(solveBubblesRed(T', M, B, VDS, DB)), 18507 getVars(solveBubblesRed(T', M, B, VDS, DB)), 18508 downNat(downMetaNat(T)), 18509 getDatabase(solveBubblesRed(T', M, B, VDS, DB))} 18510 else tupleTMBOBDerror( 18511 '\r 'Error: '\o 'Incorrect 'command. '\n) 18512 fi . 18513 18514 op GRAMMAR-REW : -> FModule [memo] . 18515 eq GRAMMAR-REW 18516 = addSorts('@RewNuPart@ ; '@Token@ ; '@SortToken@ ; '@ViewToken@ ; '@NeTokenList@ ; '@Bubble@, 18517 addOps((op '`[_`]_. : '@Token@ '@Bubble@ -> '@RewNuPart@ [none] .), 18518 BUBBLES)) . 18519 18520---- eq metaRewrite(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T, D) 18521---- = metaReduce(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T) . 18522---- eq metaRewrite(M, T, 0) = {T, leastSort(M, T)} . 18523 18524 *** FREW 18525 18526 ceq procFrew(ME, M, T, D, I, VDS, DB) 18527 = if RP :: ResultPair 18528 then ('\b 'frewrite 'in '\o eMetaPrettyPrint(getName(getModule(TMVBN))) 18529 '\b ': '\o '\n '\s '\s 18530 eMetaPrettyPrint(getModule(TMVBN), getTerm(TMVBN)) '\n 18531 '\b 'result '\o '\s eMetaPrettyPrint(getType(RP)) 18532 '\s '\b ': '\o '\n '\s '\s 18533 eMetaPrettyPrint(getModule(TMVBN), getTerm(RP)) '\n) 18534 else ('\r 'Error: '\o 'Incorrect 'command. '\n) 18535 fi 18536 if TMVBN := solveBubblesFrew(T, M, 18537 included('META-MODULE, getImports(getTopModule(ME, DB)), DB), 18538 D, I, VDS, DB) 18539 /\ RP := metaFrewrite(getModule(TMVBN), getTerm(TMVBN), 18540 getBound(TMVBN), getNat(TMVBN)) . 18541 eq procFrew(ME, unitError(QIL), T, D, I, VDS, DB) = qidError(QIL) . 18542 18543 eq solveBubblesFrew('bubble[QI], M, B, D, I, VDS, DB) 18544 = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term 18545 then {solveBubbles('bubble[QI], M, B, VDS, DB), M, VDS, unbounded, I} 18546 else tupleTMOBNerror( 18547 '\r 'Error: '\o 'no 'parse 'for downQidList(QI) '\n) 18548 fi . 18549 eq solveBubblesFrew('bubble['__[TL]], M, B, D, I, VDS, DB) 18550 = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term 18551 then {solveBubbles('bubble['__[TL]], M, B, VDS, DB), 18552 M, VDS, unbounded, I} 18553 else if metaParse(GRAMMAR-FREW, downQidList('__[TL, ''..Qid]), 18554 '@FrewNuPart@) 18555 :: ResultPair 18556 then solveBubblesFrew2( 18557 getTerm( 18558 metaParse(GRAMMAR-FREW, downQidList('__[TL, ''..Qid]), 18559 '@FrewNuPart@)), 18560 M, B, I, VDS, DB) 18561 else {getTerm(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), 18562 getModule(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), 18563 getVars(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), 18564 unbounded, I} 18565 fi 18566 fi . 18567 *** There is some problem parsing _ in solveBubblesRed, but it 18568 *** seems to work with the additional '. 18569 18570 eq solveBubblesFrew2('`[_`]_.['token[T], T'], M, B, I, VDS, DB) 18571 = if downNat(downMetaNat(T)) :: Nat 18572 and-then solveBubblesRed(T', M, B, VDS, DB) 18573 :: Tuple{Term,Module,Bool,OpDeclSet,Database} 18574 then {getTerm(solveBubblesRed(T', M, B, VDS, DB)), 18575 getModule(solveBubblesRed(T', M, B, VDS, DB)), 18576 getVars(solveBubblesRed(T', M, B, VDS, DB)), 18577 downNat(downMetaNat(T)), 18578 I} 18579 else tupleTMOBNerror( 18580 '\r 'Error: '\o 'Incorrect 'command. '\n) 18581 fi . 18582 eq solveBubblesFrew2('`[_`,_`]_.['token[T], 'token[T'], T''], 18583 M, B, I, VDS, DB) 18584 = if downNat(downMetaNat(T)) :: Nat 18585 and-then downNat(downMetaNat(T')) :: Nat 18586 and-then solveBubblesRed(T'', M, B, VDS, DB) 18587 :: Tuple{Term,Module,Bool,OpDeclSet,Database} 18588 then {getTerm(solveBubblesRed(T'', M, B, VDS, DB)), 18589 getModule(solveBubblesRed(T'', M, B, VDS, DB)), 18590 getVars(solveBubblesRed(T'', M, B, VDS, DB)), 18591 downNat(downMetaNat(T)), 18592 downNat(downMetaNat(T'))} 18593 else tupleTMOBNerror('\r 'Error: '\o 'Incorrect 'command. '\n) 18594 fi . 18595 18596 op GRAMMAR-FREW : -> FModule [memo] . 18597 eq GRAMMAR-FREW 18598 = addSorts('@FrewNuPart@ ; '@Token@ ; '@SortToken@ ; '@ViewToken@ ; '@NeTokenList@ ; '@Bubble@, 18599 addOps( 18600 (op '`[_`]_. : '@Token@ '@Bubble@ -> '@FrewNuPart@ [none] . 18601 op '`[_`,_`]_. : '@Token@ '@Token@ '@Bubble@ -> '@FrewNuPart@ [none] .), 18602 BUBBLES)) . 18603 18604 eq metaFrewrite(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T, D, I) 18605 = metaReduce(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T) . 18606 eq metaFrewrite(M, T, 0, I) = {T, leastSort(M, T)} . 18607 eq metaFrewrite(M, T, D, 0) = {T, leastSort(M, T)} . 18608 18609 *** SEARCH 18610 18611 op GRAMMAR-SEARCH : -> FModule [memo] . 18612 eq GRAMMAR-SEARCH 18613 = addSorts('@SearchNuPart@ ; '@Token@ ; '@SortToken@ ; '@ViewToken@ ; '@NeTokenList@ ; '@Bubble@, 18614 addOps((op '`[_`,_`]_. : '@Token@ '@Token@ '@Bubble@ -> '@SearchNuPart@ [none] .) 18615 (op '`[`,_`]_. : '@Token@ '@Bubble@ -> '@SearchNuPart@ [none] .), 18616 BUBBLES)) . 18617 18618 ceq procSearch(ME, M, T, T', QI, D, D', VDS, DB) 18619 *** D is a bound on the number of solutions, and D' is a bound on the depth of the search 18620 = if solveBubblesRl(T, T', M, B, VDS, DB) :: Term 18621 then procSearch2(addOps(VDS, M), 18622 lhs(solveBubblesRl(T, T', M, B, VDS, DB)), 18623 rhs(solveBubblesRl(T, T', M, B, VDS, DB)), nil, QI, D, D') 18624 else solveBubblesSearchL(M, T, T', QI, D, D', B, VDS, DB) 18625 fi 18626 if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) . 18627 18628 eq solveBubblesSearchL(M, 'bubble[QI], T, QI', D, D', B, VDS, DB) 18629 = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term 18630 then solveBubblesSearchR(M, solveBubbles('bubble[QI], M, B, VDS, DB), T, QI', D, D', B, VDS, DB) 18631 else ('\r 'Error: '\o 'no 'parsing 'for downQidList(QI) '\n) 18632 fi . 18633 eq solveBubblesSearchL(M, 'bubble['__[TL]], T, QI, D, D', B, VDS, DB) 18634 = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term 18635 then solveBubblesSearchR(M, solveBubbles('bubble['__[TL]], M, B, VDS, DB), T, QI, D, D', B, VDS, DB) 18636 else if metaParse(GRAMMAR-SEARCH, downQidList('__[TL, ''..Qid]), '@SearchNuPart@) :: ResultPair 18637 then solveBubblesSearchL1( 18638 M, 18639 getTerm(metaParse(GRAMMAR-SEARCH, downQidList('__[TL, ''..Qid]), '@SearchNuPart@)), 18640 T, QI, D, D', B, VDS, DB) 18641 else solveBubblesSearchR( 18642 getModule(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)), 18643 getTerm(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)), 18644 T, 18645 QI, 18646 getBound(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)), 18647 D', 18648 getBool(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)), 18649 getVars(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)), 18650 getDatabase(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB))) 18651 fi 18652 fi . 18653 18654 eq solveBubblesSearchL1(M, '`[`,_`]_.['token[T], T'], T'', QI, D, D', B, VDS, DB) 18655 = if downNat(downMetaNat(T)) :: Nat 18656 and-then solveBubblesRed(T', M, B, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Database} 18657 then solveBubblesSearchR( 18658 getModule(solveBubblesRed(T', M, B, VDS, DB)), 18659 getTerm(solveBubblesRed(T', M, B, VDS, DB)), 18660 T'', QI, D, 18661 downNat(downMetaNat(T)), 18662 B, 18663 getVars(solveBubblesRed(T', M, B, VDS, DB)), 18664 DB) 18665 else ('\r 'Error: '\o 'Incorrect 'command. '\n) 18666 fi . 18667 eq solveBubblesSearchL1(M, '`[_`,_`]_.['token[T], 'token[T'], T''], T''', QI, D, D', B, VDS, DB) 18668 = if downNat(downMetaNat(T)) :: Nat 18669 and-then downNat(downMetaNat(T')) :: Nat 18670 and-then solveBubblesRed(T'', M, B, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Database} 18671 then solveBubblesSearchR( 18672 getModule(solveBubblesRed(T'', M, B, VDS, DB)), 18673 getTerm(solveBubblesRed(T'', M, B, VDS, DB)), 18674 T''', QI, 18675 downNat(downMetaNat(T)), 18676 downNat(downMetaNat(T')), 18677 B, 18678 getVars(solveBubblesRed(T'', M, B, VDS, DB)), 18679 DB) 18680 else ('\r 'Error: '\o 'Incorrect 'command. '\n) 18681 fi . 18682 18683 eq solveBubblesSearchR(M, T, T', QI, D, D', B, VDS, DB) 18684 = solveBubblesSearchR1( 18685 M, 18686 addOps( 18687 op '_s.t._. : leastSort(M, T) '@Condition@ -> 'PatternCondition [none] . 18688 op '_such`that_. : leastSort(M, T) '@Condition@ -> 'PatternCondition [none] ., 18689 addSorts('PatternCondition, addInfoConds(M))), 18690 T, 18691 T', 18692 QI, 18693 D, 18694 D', 18695 B, 18696 VDS, 18697 DB) . 18698 eq solveBubblesSearchR(M:[Module], T:[Term], T':[Term], QI:[Qid], D:[Bound], D':[Bound], B:[Bool], VDS:[OpDeclSet], DB:[Database]) 18699 = ('\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n) . 18700 18701 ceq solveBubblesSearchR1(M, M', T, 'bubble[QI], QI', D, D', B, VDS, DB) 18702 = if T?:[Term] :: Term 18703 then procSearch2(M, T, T?:[Term], nil, QI', D, D') 18704 else ('\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n) 18705 fi 18706 if T?:[Term] := solveBubbles('bubble[QI], M, B, VDS, DB) . 18707 ceq solveBubblesSearchR1(M, M', T, 'bubble['__[TL]], QI, D, D', B, VDS, DB) 18708 = if T?:[Term] :: Term 18709 then procSearch2(M, T, T?:[Term], nil, QI, D, D') 18710 else if metaParse(M', downQidList('__[TL, ''..Qid]), 'PatternCondition) 18711 :: ResultPair 18712 then solveBubblesSearchR2(M, T, 18713 getTerm( 18714 metaParse(M', downQidList('__[TL, ''..Qid]), 18715 'PatternCondition)), 18716 QI, D, D', VDS) 18717 else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n 18718 fi 18719 fi 18720 if T?:[Term] := solveBubbles('bubble['__[TL]], M, B, VDS, DB) . 18721 18722 eq solveBubblesSearchR2(M, T, QI, QI', D, D', VDS) 18723 = procSearch2(M, T, constsToVars(QI, VDS), nil, QI', D, D') . 18724 eq solveBubblesSearchR2(M, T, F[T], QI, D, D', VDS) 18725 = procSearch2(M, T, constsToVars(F[T], VDS), nil, QI, D, D') . 18726 eq solveBubblesSearchR2(M, T, F[T', T''], QI, D, D', VDS) 18727 = if F == '_s.t._. or F == '_such`that_. 18728 then procSearch2(M, T, T', parseCond(T'', VDS), QI, D, D') 18729 else procSearch2(M, T, constsToVars(F[T', T''], VDS), nil, QI, D, D') 18730 fi . 18731 eq solveBubblesSearchR2(M, T, F[T', T'', TL], QI, D, D', VDS) 18732 = procSearch2(M, T, constsToVars(F[T', T'', TL], VDS), nil, QI, D, D') . 18733 18734 ceq procSearch2(M, T, T', CD, QI, D, D') 18735 = if RT :: ResultTriple 18736 then ('search 18737 if D == unbounded and D' == unbounded 18738 then nil 18739 else '\s '`[ 18740 if D == unbounded 18741 then nil 18742 else qid(string(D, 10)) 18743 fi 18744 if D' == unbounded 18745 then nil 18746 else '`, qid(string(D', 10)) 18747 fi 18748 '`] '\s 18749 fi 18750 'in eMetaPrettyPrint(getName(M)) ': 18751 eMetaPrettyPrint(M, T) '\s qid("=>" + string(QI)) '\s 18752 eMetaPrettyPrint(M, T'') '. '\n '\n 18753 'Solution '1 '\n 18754 if gTSubstitution(RT) == none 18755 then 'empty 'substitution '\n '\n 18756 else eMetaPrettyPrint(M, gTSubstitution(RT)) '\n '\n 18757 fi 18758 procSearch3(M, T, T'', CD, QI, D, 1, D')) 18759 else if RT == failure 18760 then ('search 18761 if D == unbounded and D' == unbounded 18762 then nil 18763 else '\s '`[ 18764 if D == unbounded 18765 then nil 18766 else qid(string(D, 10)) 18767 fi 18768 if D' == unbounded 18769 then nil 18770 else '`, qid(string(D', 10)) 18771 fi 18772 '`] '\s 18773 fi 18774 'in eMetaPrettyPrint(getName(M)) ': 18775 eMetaPrettyPrint(M, T) 18776 '\s qid("=>" + string(QI)) '\s 18777 eMetaPrettyPrint(M, T'') '. '\n '\n 18778 'No 'solution. '\n) 18779 else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n 18780 fi 18781 fi 18782 if T'' := prepSearchPattern(T') 18783 /\ RT := metaSearch(M, T, T'', CD, QI, D', 0) . 18784 18785 18786 eq procSearch3(M, T, T', CD, QI, D, I, D') 18787 = if D == unbounded or-else (D == 0 or-else I < D) 18788 then if metaSearch(M, T, T', CD, QI, D', I) :: ResultTriple 18789 then ('Solution qid(string(I + 1, 10)) '\n 18790 if gTSubstitution(metaSearch(M, T, T', CD, QI, D', I)) == none 18791 then 'empty 'substitution '\n '\n 18792 else eMetaPrettyPrint(M, 18793 gTSubstitution( 18794 metaSearch(M, T, T', CD, QI, D', I))) '\n '\n 18795 fi 18796 procSearch3(M, T, T', CD, QI, D, I + 1, D')) 18797 else ('No 'more 'solutions. '\n) 18798 fi 18799 else nil 18800 fi . 18801 18802------------------- 18803*** Equal to procSearch except replacing metaSearch by metaNarrowSearch 18804 18805 ceq procNarrowSearch(ME, M, T, T', QI, D, D', VDS, DB) 18806 *** D is a bound on the number of solutions, and D' is a bound on the depth of the search 18807 = if solveBubblesRl(T, T', M, B, VDS, DB) :: Term 18808 then procNarrowSearch2(addOps(VDS, M), 18809 lhs(solveBubblesRl(T, T', M, B, VDS, DB)), 18810 rhs(solveBubblesRl(T, T', M, B, VDS, DB)), nil, QI, D, D') 18811 else solveBubblesNarrowSearchL(M, T, T', QI, D, D', B, VDS, DB) 18812 fi 18813 if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) . 18814 18815 eq solveBubblesNarrowSearchL(M, 'bubble[QI], T, QI, D, D', B, VDS, DB) 18816 = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term 18817 then solveBubblesNarrowSearchR(M, solveBubbles('bubble[QI], M, B, VDS, DB), T, QI, D, D', B, VDS, DB) 18818 else ('\r 'Error: '\o 'no 'parsing 'for downQidList(QI) '\n) 18819 fi . 18820 eq solveBubblesNarrowSearchL(M, 'bubble['__[TL]], T, QI, D, D', B, VDS, DB) 18821 = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term 18822 then solveBubblesNarrowSearchR(M, solveBubbles('bubble['__[TL]], M, B, VDS, DB), T, QI, D, D', B, VDS, DB) 18823 else if metaParse(GRAMMAR-SEARCH, downQidList('__[TL, ''..Qid]), '@SearchNuPart@) :: ResultPair 18824 then solveBubblesNarrowSearchL1( 18825 M, 18826 getTerm( 18827 metaParse(GRAMMAR-SEARCH, downQidList('__[TL, ''..Qid]), 18828 '@SearchNuPart@)), 18829 T, QI, D, D', B, VDS, DB) 18830 else solveBubblesNarrowSearchR( 18831 getModule(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)), 18832 getTerm(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)), 18833 T, 18834 QI, 18835 getBound(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)), 18836 D', 18837 getBool(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)), 18838 getVars(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)), 18839 getDatabase(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB))) 18840 fi 18841 fi . 18842 18843 eq solveBubblesNarrowSearchL1(M, '`[`,_`]_.['token[T], T'], T'', QI, D, D', B, VDS, DB) 18844 = if downNat(downMetaNat(T)) :: Nat 18845 and-then solveBubblesRed(T', M, B, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Database} 18846 then solveBubblesNarrowSearchR( 18847 getModule(solveBubblesRed(T', M, B, VDS, DB)), 18848 getTerm(solveBubblesRed(T', M, B, VDS, DB)), 18849 T'', QI, D, 18850 downNat(downMetaNat(T)), 18851 B, 18852 getVars(solveBubblesRed(T', M, B, VDS, DB)), 18853 DB) 18854 else ('\r 'Error: '\o 'Incorrect 'command. '\n) 18855 fi . 18856 eq solveBubblesNarrowSearchL1(M, '`[_`,_`]_.['token[T], 'token[T'], T''], T''', QI, D, D', B, VDS, DB) 18857 = if downNat(downMetaNat(T)) :: Nat 18858 and-then downNat(downMetaNat(T')) :: Nat 18859 and-then solveBubblesRed(T'', M, B, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Database} 18860 then solveBubblesNarrowSearchR( 18861 getModule(solveBubblesRed(T'', M, B, VDS, DB)), 18862 getTerm(solveBubblesRed(T'', M, B, VDS, DB)), 18863 T''', QI, 18864 downNat(downMetaNat(T)), 18865 downNat(downMetaNat(T')), 18866 B, 18867 getVars(solveBubblesRed(T'', M, B, VDS, DB)), 18868 DB) 18869 else ('\r 'Error: '\o 'Incorrect 'command. '\n) 18870 fi . 18871 18872 eq solveBubblesNarrowSearchR(M, T, T', QI, D, D', B, VDS, DB) 18873 = solveBubblesNarrowSearchR1( 18874 M, 18875 addOps( 18876 op '_s.t._. : leastSort(M, T) '@Condition@ -> 'PatternCondition [none] . 18877 op '_such`that_. : leastSort(M, T) '@Condition@ -> 'PatternCondition [none] ., 18878 addSorts('PatternCondition, addInfoConds(M))), 18879 T, 18880 T', 18881 QI, 18882 D, 18883 D', 18884 B, 18885 VDS, 18886 DB) . 18887 eq solveBubblesNarrowSearchR(M:[Module], T:[Term], T':[Term], QI:[Qid], D:[Bound], D':[Bound], B:[Bool], VDS:[OpDeclSet], DB:[Database]) 18888 = qidError('\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n) . 18889 18890 ceq solveBubblesNarrowSearchR1(M, M', T, 'bubble[QI], QI', D, D', B, VDS, DB) 18891 = if T?:[Term] :: Term 18892 then procNarrowSearch2(M, T, T?:[Term], nil, QI', D, D') 18893 else ('\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n) 18894 fi 18895 if T?:[Term] := solveBubbles('bubble[QI], M, B, VDS, DB) . 18896 ceq solveBubblesNarrowSearchR1(M, M', T, 'bubble['__[TL]], QI, D, D', B, VDS, DB) 18897 = if T?:[Term] :: Term 18898 then procNarrowSearch2(M, T, T?:[Term], nil, QI, D, D') 18899 else if metaParse(M', downQidList('__[TL, ''..Qid]), 'PatternCondition) 18900 :: ResultPair 18901 then solveBubblesNarrowSearchR2(M, T, 18902 getTerm( 18903 metaParse(M', downQidList('__[TL, ''..Qid]), 18904 'PatternCondition)), 18905 QI, D, D', VDS) 18906 else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n 18907 fi 18908 fi 18909 if T?:[Term] := solveBubbles('bubble['__[TL]], M, B, VDS, DB) . 18910 18911 eq solveBubblesNarrowSearchR2(M, T, QI, QI', D, I, VDS) 18912 = procNarrowSearch2(M, T, constsToVars(QI, VDS), nil, QI', D, I) . 18913 eq solveBubblesNarrowSearchR2(M, T, F[T], QI, D, I, VDS) 18914 = procNarrowSearch2(M, T, constsToVars(F[T], VDS), nil, QI, D, I) . 18915 eq solveBubblesNarrowSearchR2(M, T, F[T', T''], QI, D, I, VDS) 18916 = if F == '_s.t._. or F == '_such`that_. 18917 then procNarrowSearch2(M, T, T', parseCond(T'', VDS), QI, D, I) 18918 else procNarrowSearch2(M, T, constsToVars(F[T', T''], VDS), nil, QI, D, I) 18919 fi . 18920 eq solveBubblesNarrowSearchR2(M, T, F[T', T'', TL], QI, D, I, VDS) 18921 = procNarrowSearch2(M, T, constsToVars(F[T', T'', TL], VDS), nil, QI, D, I) . 18922 18923---- op axCohComplete : SModule -> SModule . ---- Defined later in module AX-COHERENCE-COMPLETION 18924 18925 sort IdsToRemove . ---- moved from VARIANTS 18926 ops all non-handled : -> IdsToRemove . ---- moved from VARIANTS 18927 op removeIds : Module IdsToRemove ~> Module . ---- moved from VARIANTS 18928 18929 ceq procNarrowSearch2(M, T, T', CD, QI, D, D') 18930 = if Mx:[Module] :: Module and RTS:[ResultTripleSet] :: ResultTripleSet 18931 then ('search 18932 if D == unbounded and D' == unbounded 18933 then nil 18934 else '\s '`[ 18935 if D == unbounded 18936 then nil 18937 else qid(string(D, 10)) 18938 fi 18939 if D' == unbounded 18940 then nil 18941 else '`, qid(string(D', 10)) 18942 fi 18943 '`] '\s 18944 fi 18945 'in eMetaPrettyPrint(getName(M)) ': 18946 eMetaPrettyPrint(M, T) '\s qid("~>" + string(QI)) '\s 18947 eMetaPrettyPrint(M, T'') '. 18948 procNarrowSearch3(M, 0, Vars((T,T')), RTS:[ResultTripleSet]) 18949 if D =/= unbounded and-then D' == unbounded and-then | RTS:[ResultTripleSet] | < D 18950 then procNarrowSearch2RT(M, T, T', CD, QI, D, D',RTS:[ResultTripleSet],1) 18951 else nil 18952 fi 18953 ('\n '\n 'No 'more 'solutions. '\n)) 18954 else if RTS:[ResultTripleSet] == empty 18955 then ('search 18956 if D == unbounded and D' == unbounded 18957 then nil 18958 else '\s '`[ 18959 if D == unbounded 18960 then nil 18961 else qid(string(D, 10)) 18962 fi 18963 if D' == unbounded 18964 then nil 18965 else '`, qid(string(D', 10)) 18966 fi 18967 '`] '\s 18968 fi 18969 'in eMetaPrettyPrint(getName(M)) ': 18970 eMetaPrettyPrint(M, T) 18971 '\s qid("~>" + string(QI)) '\s 18972 eMetaPrettyPrint(M, T'') '. '\n '\n 18973 'No 'solution. '\n) 18974 else if getMsg(Mx:[Module]) :: QidList 18975 then getMsg(Mx:[Module]) 18976 else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n 18977 fi 18978 fi 18979 fi 18980 if T'' := prepSearchPattern(T') 18981 /\ Mx:[Module] := removeIds(axCohComplete(M), non-handled) 18982 /\ RTS:[ResultTripleSet] 18983 := upDown(M, 18984 metaNarrowSearchGen( 18985 Mx:[Module], 18986 T, 18987 T'', 18988 none, 18989 typeOfRelation(QI), 18990 D', 18991 D, 18992 unbounded, 18993 full E-ACU-unify noStrategy E-normalize-terms) 18994 |> (T,T'') 18995 ) . 18996 18997 var RTS' : ResultTripleSet . 18998 18999 op procNarrowSearch2RT : Module Term Term Condition Qid Bound Bound ResultTripleSet Nat -> QidList . 19000 ceq procNarrowSearch2RT(M, T, T', CD, QI, D, D',RTS',J) 19001 = nil 19002 if | RTS' | == D . 19003 ceq procNarrowSearch2RT(M, T, T', CD, QI, D, D',RTS',J) 19004 = if RTS:[ResultTripleSet] :: ResultTripleSet 19005 then (procNarrowSearch3(M, | RTS' |, Vars((T,T')), RTS:[ResultTripleSet]) 19006 procNarrowSearch2RT(M, T, T', CD, QI, D, D',RTS' | RTS:[ResultTripleSet],J + 1) ) 19007 else nil 19008 fi 19009 if | RTS' | < D 19010 /\ T'' := prepSearchPattern(T') 19011 /\ (RTS' | RTS:[ResultTripleSet]) 19012 := upDown(M, 19013 metaNarrowSearchGen( 19014 removeIds(axCohComplete(M), non-handled), 19015 T, 19016 T'', 19017 none, 19018 typeOfRelation(QI), 19019 D', 19020 D + J, 19021 unbounded, 19022 full E-ACU-unify noStrategy E-normalize-terms) 19023 |> (T,T'') 19024 ) . 19025 19026 eq procNarrowSearch3(M, I, TL:TermList, empty) 19027 = nil . 19028 eq procNarrowSearch3(M, I, TL:TermList, {T:Term,TP:Type,S:Substitution} | RTS:ResultTripleSet) 19029 = ('\n '\n 'Solution qid(string(I + 1, 10)) 19030 if (S:Substitution |> TL:TermList) == none 19031 then '\n 'empty 'substitution 19032 else '\n eMetaPrettyPrint(M, S:Substitution |> TL:TermList) 19033 fi 19034 procNarrowSearch3(M, I + 1, TL:TermList, RTS:ResultTripleSet)) . 19035 19036------------------- 19037 19038 sort Tuple{TermList, Nat} . 19039 op <_;_> : Term Nat -> Tuple{TermList, Nat} . 19040 op term : Tuple{TermList, Nat} -> TermList . 19041 op index : Tuple{TermList, Nat} -> Nat . 19042 eq term(< TL:[TermList] ; I:[Nat] >) = TL:[TermList] . 19043 eq index(< TL:[TermList] ; I:[Nat] >) = I:[Nat] . 19044 19045 op prepSearchPattern : Term -> Term . 19046 op prepSearchPattern : TermList Nat -> Tuple{TermList, Nat} . 19047 19048 eq prepSearchPattern(T) = term(prepSearchPattern(T, 0)) . 19049 19050 eq prepSearchPattern('<_:_|_>[OT, Ct, T], I) 19051 = < '<_:_|_>[OT, qid("V#" + string(I, 10) + ":" + string(getName(Ct))), 19052 '_`,_[term(prepSearchPattern(T, s s I)), 19053 qid("V#" + string(s I, 10) + ":AttributeSet")]] ; 19054 index(prepSearchPattern(T, s s I)) > . 19055 eq prepSearchPattern('<_:_|`>[OT, Ct], I) 19056 = < '<_:_|_>[OT, qid("V#" + string(I, 10) + ":" + string(getName(Ct))), 19057 qid("V#" + string(s I, 10) + ".AttributeSet")] ; 19058 s I > . 19059 eq prepSearchPattern(F[TL], I) 19060 = < F[term(prepSearchPattern(TL, I))] ; index(prepSearchPattern(TL, I)) > 19061 [owise] . 19062 19063 eq prepSearchPattern(F, I) = < F ; I > . 19064 ----eq prepSearchPattern(Ct, I) = < Ct ; I > . 19065 19066 ceq prepSearchPattern((T, TL), I) 19067 = < (term(prepSearchPattern(T, I)), 19068 term(prepSearchPattern(TL, index(prepSearchPattern(T, I))))) ; 19069 index(prepSearchPattern(TL, index(prepSearchPattern(T, I)))) > 19070 if TL =/= empty . 19071 19072 *** MATCH 19073 19074 ceq procMatch(ME, M, T, T', QI, I, VDS, DB) 19075 *** the number I the number of solutions 19076 = if solveBubblesRl(T, T', M, B, VDS, DB) :: Term 19077 then procMatch2(addOps(VDS, M), 19078 lhs(solveBubblesRl(T, T', M, B, VDS, DB)), 19079 rhs(solveBubblesRl(T, T', M, B, VDS, DB)), nil, QI, I) 19080 else if solveBubblesRew(T, M, B, I, VDS, DB) 19081 :: Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} 19082 then solveBubblesMatch( 19083 getModule(solveBubblesRew(T, M, B, I, VDS, DB)), 19084 addOps( 19085 op '_s.t._. : 19086 leastSort( 19087 getModule(solveBubblesRew(T, M, B, I, VDS, DB)), 19088 getTerm(solveBubblesRew(T, M, B, I, VDS, DB))) 19089 '@Condition@ -> 'PatternCondition [none] . 19090 op '_such`that_. : 19091 leastSort( 19092 getModule(solveBubblesRew(T, M, B, I, VDS, DB)), 19093 getTerm(solveBubblesRew(T, M, B, I, VDS, DB))) 19094 '@Condition@ -> 'PatternCondition [none] ., 19095 addSorts('PatternCondition, 19096 addInfoConds( 19097 getModule(solveBubblesRew(T, M, B, I, VDS, DB))))), 19098 getTerm(solveBubblesRew(T, M, B, I, VDS, DB)), 19099 T', 19100 QI, 19101 (if getBound(solveBubblesRew(T, M, B, I, VDS, DB)) 19102 == unbounded 19103 then 0 19104 else getBound(solveBubblesRew(T, M, B, I, VDS, DB)) 19105 fi), 19106 B, 19107 getVars(solveBubblesRew(T, M, B, I, VDS, DB)), 19108 DB) 19109 else getMsg(getTerm(solveBubblesRew(T, M, B, I, VDS, DB))) 19110 ----('\r 'Error: '\o 'Incorrect 'match 'command. '\n) 19111 fi 19112 fi 19113 if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) . 19114 19115 ceq solveBubblesMatch(M, M', T, 'bubble[QI], QI', I, B, VDS, DB) 19116 = if T?:[Term] :: Term 19117 then procMatch2(M, T, T?:[Term], nil, QI', I) 19118 else ('\r 'Error: '\o 'Incorrect 'use 'of 'the 'match 'command. '\n) 19119 fi 19120 if T?:[Term] := solveBubbles('bubble[QI], M, B, VDS, DB) . 19121 ceq solveBubblesMatch(M, M', T, 'bubble['__[TL]], QI, I, B, VDS, DB) 19122 = if T?:[Term] :: Term 19123 then procMatch2(M, T, T?:[Term], nil, QI, I) 19124 else if metaParse(M', downQidList('__[TL, ''..Qid]), 'PatternCondition) 19125 :: ResultPair 19126 then solveBubblesMatch2(M, T, 19127 getTerm( 19128 metaParse(M', downQidList('__[TL, ''..Qid]), 19129 'PatternCondition)), 19130 QI, I, VDS) 19131 else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'match 'command. '\n 19132 fi 19133 fi 19134 if T?:[Term] := solveBubbles('bubble['__[TL]], M, B, VDS, DB) . 19135 19136 eq solveBubblesMatch2(M, T, QI, QI', I, VDS) 19137 = procMatch2(M, T, constsToVars(QI, VDS), nil, QI', I) . 19138 eq solveBubblesMatch2(M, T, F[T], QI, I, VDS) 19139 = procMatch2(M, T, constsToVars(F[T], VDS), nil, QI, I) . 19140 eq solveBubblesMatch2(M, T, F[T', T''], QI, I, VDS) 19141 = if F == '_s.t._. or F == '_such`that_. 19142 then procMatch2(M, T, T', parseCond(T'', VDS), QI, I) 19143 else procMatch2(M, T, constsToVars(F[T', T''], VDS), nil, QI, I) 19144 fi . 19145 eq solveBubblesMatch2(M, T, F[T', T'', TL], QI, I, VDS) 19146 = procMatch2(M, T, constsToVars(F[T', T'', TL], VDS), nil, QI, I) . 19147 19148 ceq procMatch2(M, T, T', CD, 'match, I) 19149 = if Sb? :: Substitution 19150 then ('match 19151 if I == 0 then nil else '\s '`[ qid(string(I, 10)) '`] '\s fi 19152 'in eMetaPrettyPrint(getName(M)) ': 19153 eMetaPrettyPrint(M, T) '\s '<=? '\s eMetaPrettyPrint(M, T') '. '\n '\n 19154 'Solution '1 '\n 19155 if Sb? == none 19156 then 'empty 'substitution 19157 else eMetaPrettyPrint(M, Sb?) 19158 fi '\n '\n 19159 procMatch3(M, T, T', CD, 'match, I, 1)) 19160 else if Sb? == noMatch 19161 then ('match 19162 if I == 0 19163 then nil 19164 else '\s '`[ qid(string(I, 10)) '`] '\s 19165 fi 19166 'in eMetaPrettyPrint(getName(M)) ': 19167 eMetaPrettyPrint(M, T) '\s '<=? '\s 19168 eMetaPrettyPrint(M, T') '. '\n '\n 19169 'No 'solution. '\n) 19170 else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'match 'command. '\n 19171 fi 19172 fi 19173 if Sb? := metaMatch(M, T, T', CD, 0) . 19174 ceq procMatch2(M, T, T', CD, 'xmatch, I) 19175 = if MP? :: MatchPair 19176 then ('xmatch 19177 if I == 0 then nil else '\s '`[ qid(string(I, 10)) '`] '\s fi 19178 'in eMetaPrettyPrint(getName(M)) ': 19179 eMetaPrettyPrint(M, T) '\s '<=? '\s eMetaPrettyPrint(M, T') '. '\n '\n 19180 'Solution '1 '\n 19181 if gTSubstitution(MP?) == none 19182 then 'empty 'substitution 19183 else eMetaPrettyPrint(M, gTSubstitution(MP?)) 19184 fi '\n '\n 19185 procMatch3(M, T, T', CD, 'xmatch, I, 1)) 19186 else if MP? == noMatch 19187 then ('xmatch 19188 if I == 0 19189 then nil 19190 else '\s '`[ qid(string(I, 10)) '`] '\s 19191 fi 19192 'in eMetaPrettyPrint(getName(M)) ': 19193 eMetaPrettyPrint(M, T) '\s '<=? '\s 19194 eMetaPrettyPrint(M, T') '. '\n '\n 19195 'No 'solution. '\n) 19196 else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'xmatch 'command. '\n 19197 fi 19198 fi 19199 if MP? := metaXmatch(M, T, T', CD, 0, unbounded, 0) . 19200 19201 eq procMatch3(M, T, T', CD, 'match, I, J) 19202 = if I == 0 or J < I 19203 then if metaMatch(M, T, T', CD, J) :: Substitution 19204 then ('Solution qid(string(J + 1, 10)) '\n 19205 if metaMatch(M, T, T', CD, J) == none 19206 then 'empty 'substitution 19207 else eMetaPrettyPrint(M, metaMatch(M, T, T', CD, J)) 19208 fi '\n '\n 19209 procMatch3(M, T, T', CD, 'match, I, J + 1)) 19210 else ('No 'more 'solutions. '\n) 19211 fi 19212 else nil 19213 fi . 19214 eq procMatch3(M, T, T', CD, 'xmatch, I, J) 19215 = if I == 0 or J < I 19216 then if metaXmatch(M, T, T', CD, 0, unbounded, J) :: MatchPair 19217 then ('Solution qid(string(J + 1, 10)) '\n 19218 if gTSubstitution(metaXmatch(M, T, T', CD, 0, unbounded, J)) 19219 == none 19220 then 'empty 'substitution 19221 else eMetaPrettyPrint(M, 19222 gTSubstitution( 19223 metaXmatch(M, T, T', CD, 0, unbounded, J))) 19224 fi '\n '\n 19225 procMatch3(M, T, T', CD, 'xmatch, I, J + 1)) 19226 else ('No 'more 'solutions. '\n) 19227 fi 19228 else nil 19229 fi . 19230 19231 *** UNIFY 19232 19233 ceq procUnify(ME, M, T, D, VDS, DB) 19234 *** D is a bound on the number of solutions 19235 = if solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB) 19236 :: Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} 19237 then procUnify2( 19238 getModule(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)), 19239 parseUnify( 19240 getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)), 19241 getVars(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))), 19242 getBound(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))) 19243 else getMsg(getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))) 19244 ----('\r 'Error: '\o 'Incorrect 'match 'command. '\n) 19245 fi 19246 if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) . 19247 19248 eq addInfoUnify(M) 19249 = addOps(op '_/\_ : '@UnificationProblem@ '@UnificationProblem@ -> '@UnificationProblem@ 19250 [ctor assoc prec(73)] . 19251 op '_=?_ : 'Universal 'Universal -> '@UnificationProblem@ 19252 [ctor poly(1 2) prec(71)] ., 19253 addSorts('@UnificationProblem@, M)) . 19254 19255 eq parseUnify('_/\_[T, T'], VDS) = parseUnify(T, VDS) /\ parseUnify(T', VDS) . 19256 eq parseUnify('_=?_[T, T'], VDS) = constsToVars(T, VDS) =? constsToVars(T', VDS) . 19257 19258 ceq procUnify2(M, UP, D) 19259 = if UP? :: UnificationPair? 19260 then ('unify 19261 if D == unbounded then nil else '\s '`[ qid(string(D, 10)) '`] '\s fi 19262 'in eMetaPrettyPrint(getName(M)) ': 19263 eMetaPrettyPrint(M, UP) '\n '\n 19264 if UP? == noUnifier 19265 then 'No 'unifier 19266 else procUnify3Aux(M, UP?, 0) '\n '\n 19267 procUnify3(M, UP, D, 1) 19268 fi) 19269 else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'unify 'command. '\n 19270 fi 19271 if UP? := metaUnify(M, UP, 0, 0) . 19272 eq procUnify2(M?, UP??:[UnificationProblem], D?) = getMsg(M?) [owise] . 19273 19274 eq eMetaPrettyPrint(M, T =? T') 19275 = eMetaPrettyPrint(M, T) '\s '=? '\s eMetaPrettyPrint(M, T') '. . 19276 eq eMetaPrettyPrint(M, T =? T' /\ UP) 19277 = eMetaPrettyPrint(M, T =? T') '\s '/\ '\s eMetaPrettyPrint(M, UP) '. . 19278 19279 eq procUnify3Aux(M, {Sb, N}, I) 19280 = 'Solution qid(string(I + 1, 10)) '\n 19281 if Sb == none 19282 then 'empty 'substitution '\n '\n 19283 else eMetaPrettyPrint(M, Sb) '\n '\n 19284 fi . 19285 19286 eq procUnify3(M, UP, D, I) 19287 = if D == unbounded or-else I < D 19288 then if metaUnify(M, UP, 0, I) :: UnificationPair 19289 then (procUnify3Aux(M, metaUnify(M, UP, 0, I), I) 19290 procUnify3(M, UP, D, I + 1)) 19291 else ('No 'more 'solutions. '\n) 19292 fi 19293 else nil 19294 fi . 19295 19296 ceq solveBubblesUnify(M, 'bubble[T], VDS) 19297 = if metaParse(M, QIL, '@UnificationProblem@) :: ResultPair 19298 then parseUnify(getTerm(metaParse(M, QIL, '@UnificationProblem@)), VDS) 19299 else unificationProblemError('\r 'Warning: '\o 19300 printSyntaxError(metaParse(M, QIL, '@UnificationProblem@), QIL) '\n) 19301 fi 19302 if QIL := downQidList(T) . 19303 19304 eq solveBubblesRewUnify('bubble[QI], M, B, D, VDS, DB) 19305 = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term 19306 then {solveBubbles('bubble[QI], M, B, VDS, DB), M, B, VDS, unbounded, DB} 19307 else tupleTMBOBDerror( 19308 '\r 'Error: '\o 'no 'parsing 'for downQidList(QI) '\n) 19309 fi . 19310 eq solveBubblesRewUnify('bubble['__[TL]], M, B, D, VDS, DB) 19311 = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term 19312 then {solveBubbles('bubble['__[TL]], M, B, VDS, DB), M, B, VDS, unbounded, DB} 19313 else if metaParse(GRAMMAR-REW, downQidList('__[TL, ''..Qid]), '@RewNuPart@) 19314 :: ResultPair 19315 then solveBubblesRewUnify2( 19316 getTerm( 19317 metaParse(GRAMMAR-REW, downQidList('__[TL, ''..Qid]), 19318 '@RewNuPart@)), 19319 M, B, VDS, DB) 19320 else {getTerm(solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB)), 19321 getModule(solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB)), 19322 getBool(solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB)), 19323 getVars(solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB)), 19324 unbounded, 19325 getDatabase(solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB))} 19326 fi 19327 fi . 19328 19329 eq solveBubblesRewUnify2('`[_`]_.['token[T], T'], M, B, VDS, DB) 19330 = if downNat(downMetaNat(T)) :: Nat 19331 and-then solveBubblesRedUnify(T', M, B, VDS, DB) 19332 :: Tuple{Term,Module,Bool,OpDeclSet,Database} 19333 then {getTerm(solveBubblesRedUnify(T', M, B, VDS, DB)), 19334 getModule(solveBubblesRedUnify(T', M, B, VDS, DB)), 19335 getBool(solveBubblesRedUnify(T', M, B, VDS, DB)), 19336 getVars(solveBubblesRedUnify(T', M, B, VDS, DB)), 19337 downNat(downMetaNat(T)), 19338 getDatabase(solveBubblesRedUnify(T', M, B, VDS, DB))} 19339 else tupleTMBOBDerror('\r 'Error: '\o 'Incorrect 'command. '\n) 19340 fi . 19341 19342 ceq solveBubblesRedUnify('bubble[QI], M, B, VDS, DB) 19343 = if T? :: Term 19344 then {T?, M, B, VDS, DB} 19345 else tupleTMBODerror('\r 'Error: '\o 'no 'parse 'for downQidList(QI) '\n) 19346 fi 19347 if T? := solveBubbles('bubble[QI], M, B, VDS, DB) . 19348 ceq solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB) 19349 = if T? :: Term 19350 then {T?, M, B, VDS, DB} 19351 else if metaParse(GRAMMAR-RED, 19352 downQidList('__[TL, ''..Qid]), '@RedInPart@) 19353 :: ResultPair 19354 then solveBubblesRedUnify2( 19355 getTerm( 19356 metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), '@RedInPart@)), 19357 DB) 19358 else tupleTMBODerror('\r 'Warning: '\o 19359 printSyntaxError( 19360 metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), 19361 '@RedInPart@), downQidList('__[TL, ''..Qid])) '\n 19362 '\r 'Error: '\o 19363 'no 'parse 'for downQidList('__[TL, ''..Qid]) '\n) 19364 fi 19365 fi 19366 if T? := solveBubbles('bubble['__[TL]], M, B, VDS, DB) . 19367 *** There is some problem parsing 'in_:_ in solveBubblesRed, but it 19368 *** seems to work with the additional '. 19369 19370 ceq solveBubblesRedUnify2('in_:_.[T, T'], DB) 19371 = if unitInDb(ME, DB') 19372 then solveBubblesRed3(T', addInfoUnify(getFlatModule(ME, DB')), ME, getVars(ME, DB'), DB') 19373 else tupleTMBODerror('\r 'Error: '\o 'The 'module eMetaPrettyPrint(ME) 'is 'not 'in 'the 'database '. '\n) 19374 fi 19375 if < DB' ; ME > := evalModExp(parseModExp(T), DB) . 19376 eq solveBubblesRedUnify2('in_:_.[T, T'], DB) 19377 = tupleTMBODerror('\r 'Error: '\o 'It 'isn't 'possible 'to 'compile eMetaPrettyPrint(parseModExp(T)) '. '\n) 19378 [owise] . 19379 19380 *** ID-UNIFY 19381 19382 ceq procIdUnify(ME, M, T, D, VDS, DB) 19383 *** D is a bound on the number of solutions 19384 = if solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} 19385 then procIdUnify2( 19386 getModule(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)), 19387 parseUnify( 19388 getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)), 19389 getVars(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))), 19390 getBound(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))) 19391 else getMsg(getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))) 19392 ----('\r 'Error: '\o 'Incorrect 'id-unify 'command. '\n) 19393 fi 19394 if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) . 19395 19396 ceq procIdUnify2(M, T =? T', D) 19397 = if X:[SubstitutionSet] :: SubstitutionSet 19398 then ('id-unify 19399 if D == unbounded then nil else '\s '`[ qid(string(D, 10)) '`] '\s fi 19400 'in eMetaPrettyPrint(getName(M)) ': 19401 eMetaPrettyPrint(M, T =? T') 19402 if X:[SubstitutionSet] == empty 19403 then '\n 'No 'unifier 19404 else procIdUnify3(M, T =? T', 0, X:[SubstitutionSet]) 19405 fi) 19406 else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'id-unify 'command. '\n 19407 fi 19408 if X:[SubstitutionSet] := metaACUUnify(M, T, T') . 19409 eq procIdUnify2(M?, UP??:[UnificationProblem], D?) = getMsg(M?) [owise] . 19410 19411 eq procIdUnify3(M, UP, I, empty) 19412 = ('\n '\n 'No 'more 'solutions. '\n) . 19413 eq procIdUnify3(M, UP, I, S:Substitution | SS:SubstitutionSet) 19414 = '\n '\n 'Solution qid(string(I + 1, 10)) 19415 if S:Substitution == none 19416 then '\n 'empty 'substitution 19417 else '\n eMetaPrettyPrint(M, S:Substitution) 19418 fi 19419 procIdUnify3(M, UP, I + 1, SS:SubstitutionSet) . 19420 19421 *** VARIANT-UNIFY 19422 19423 ceq procVariantUnify(ME, M, T, D, VDS, DB) 19424 *** D is a bound on the number of solutions 19425 = if solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} 19426 then procVariantUnify2( 19427 getModule(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)), 19428 parseUnify( 19429 getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)), 19430 getVars(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))), 19431 getBound(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))) 19432 else getMsg(getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))) 19433 ----('\r 'Error: '\o 'Incorrect 'variant 'unify 'command. '\n) 19434 fi 19435 if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) . 19436 19437 ceq procVariantUnify2(M, T =? T', D) 19438 = if X:[SubstitutionSet] :: SubstitutionSet 19439 then ('variant 'unify 19440 if D == unbounded then nil else '\s '`[ qid(string(D, 10)) '`] '\s fi 19441 'in eMetaPrettyPrint(getName(M)) ': 19442 eMetaPrettyPrint(M, T =? T') 19443 if X:[SubstitutionSet] == empty 19444 then '\n 'No 'variant 'unifier 19445 else procVariantUnify3(M, T =? T', 0, X:[SubstitutionSet]) 19446 fi) 19447 else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'variant 'unify 'command. '\n 19448 fi 19449 if X:[SubstitutionSet] 19450 := toSubstitution( 19451 metaVariantUnify( 19452 removeIds(axCohComplete(M), non-handled), 19453 T, 19454 T', 19455 highestVar((T,T')) + 1, 19456 minimal-unifiers reducible 19457 ) 19458 ) . 19459 eq procVariantUnify2(M?, UP??:[UnificationProblem], D?) = getMsg(M?) [owise] . 19460 19461 eq procVariantUnify3(M, UP, I, empty) 19462 = ('\n '\n 'No 'more 'solutions. '\n) . 19463 eq procVariantUnify3(M, UP, I, S:Substitution | SS:SubstitutionSet) 19464 = '\n '\n 'Solution qid(string(I + 1, 10)) 19465 if S:Substitution == none 19466 then '\n 'empty 'substitution 19467 else '\n eMetaPrettyPrint(M, S:Substitution) 19468 fi 19469 procVariantUnify3(M, UP, I + 1, SS:SubstitutionSet) . 19470 19471 *** ASYMMETRIC-VARIANT-UNIFY 19472 19473 ceq procAsymmetricVariantUnify(ME, M, T, D, VDS, DB) 19474 *** D is a bound on the number of solutions 19475 = if solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} 19476 then procAsymmetricVariantUnify2( 19477 getModule(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)), 19478 parseUnify( 19479 getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)), 19480 getVars(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))), 19481 getBound(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))) 19482 else getMsg(getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))) 19483 ----('\r 'Error: '\o 'Incorrect 'asymmetric 'variant 'unify 'command. '\n) 19484 fi 19485 if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) . 19486 19487 ---op axCohComplete : SModule -> SModule . --- Defined later in module AX-COHERENCE-COMPLETION 19488 ---op removeIds : Module ~> Module . ---Defined later in module VARIANTS 19489 19490 ceq procAsymmetricVariantUnify2(M, T =? T', D) 19491 = if X:[SubstitutionSet] :: SubstitutionSet 19492 then ('variant 'unify 19493 if D == unbounded then nil else '\s '`[ qid(string(D, 10)) '`] '\s fi 19494 'in eMetaPrettyPrint(getName(M)) ': 19495 eMetaPrettyPrint(M, T =? T') 19496 if X:[SubstitutionSet] == empty 19497 then '\n 'No 'asymmetric 'unifier 19498 else procAsymmetricVariantUnify3(M, T =? T', 0, X:[SubstitutionSet]) 19499 fi) 19500 else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'asymmetric 'variant 'unify 'command. '\n 19501 fi 19502 if X:[SubstitutionSet] 19503 := toSubstitution( 19504 metaVariantUnify( 19505 removeIds(axCohComplete(M), non-handled), 19506 T, 19507 T', 19508 highestVar((T,T')) + 1, 19509 minimal-unifiers irreducible 19510 ) 19511 ) . 19512 eq procAsymmetricVariantUnify2(M?, UP??:[UnificationProblem], D?) = getMsg(M?) [owise] . 19513 19514 eq procAsymmetricVariantUnify3(M, UP, I, empty) 19515 = ('\n '\n 'No 'more 'solutions. '\n) . 19516 eq procAsymmetricVariantUnify3(M, UP, I, S:Substitution | SS:SubstitutionSet) 19517 = '\n '\n 'Solution qid(string(I + 1, 10)) 19518 if S:Substitution == none 19519 then '\n 'empty 'substitution 19520 else '\n eMetaPrettyPrint(M, S:Substitution) 19521 fi 19522 procAsymmetricVariantUnify3(M, UP, I + 1, SS:SubstitutionSet) . 19523 19524 *** GET-VARIANTS 19525 19526 ceq procGetVariants(ME, M, T, D, VDS, DB) 19527 *** D is a bound on the number of solutions 19528 = if solveBubblesRewUnify(T, M, B, D, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} 19529 then procGetVariants2( 19530 getModule(solveBubblesRewUnify(T, M, B, D, VDS, DB)), 19531 parseGetVariants( 19532 getTerm(solveBubblesRewUnify(T, M, B, D, VDS, DB)), 19533 getVars(solveBubblesRewUnify(T, M, B, D, VDS, DB))), 19534 getBound(solveBubblesRewUnify(T, M, B, D, VDS, DB))) 19535 else getMsg(getTerm(solveBubblesRewUnify(T, M, B, D, VDS, DB))) 19536 ----('\r 'Error: '\o 'Incorrect 'get 'variants 'command. '\n) 19537 fi 19538 if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) . 19539 19540 eq parseGetVariants(T, VDS) = constsToVars(T, VDS) . 19541 19542 ceq procGetVariants2(M, T, D) 19543 = if X:[VariantFourSet] :: VariantFourSet 19544 then ('get 'variants 19545 if D == unbounded then nil else '\s '`[ qid(string(D, 10)) '`] '\s fi 19546 'in eMetaPrettyPrint(getName(M)) ': 19547 eMetaPrettyPrint(M, T) 19548 if X:[VariantFourSet] == empty 19549 then '\n 'No 'variant 19550 else procGetVariants3(M, T, 0, X:[VariantFourSet]) 19551 fi) 19552 else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'get 'variants 'command. '\n 19553 fi 19554 if X:[VariantFourSet] 19555 := getVariants( 19556 removeIds(axCohComplete(M), non-handled), 19557 T, 19558 highestVar(T) + 1, 19559 ACUUnify irreducible minimal-unifiers 19560 ) . 19561 eq procGetVariants2(M?, UP??:[Term], D?) = getMsg(M?) [owise] . 19562 19563 eq procGetVariants3(M, T, I, (empty).VariantFourSet) 19564 = ('\n '\n 'No 'more 'variants. '\n) . 19565 eq procGetVariants3(M, T, I, {T1:Term,S:Substitution,S*:Substitution,NextVar:Nat} | VS:VariantFourSet) 19566 = '\n '\n 'Variant qid(string(I + 1, 10)) 19567 '\n 19568 '`{ 19569 eMetaPrettyPrint(M, T1:Term) '`, 19570 if S:Substitution == none 19571 then 'empty 'substitution 19572 else eMetaPrettyPrint(M, S:Substitution) 19573 fi 19574 '`} 19575 procGetVariants3(M, T, I + 1, VS:VariantFourSet) . 19576endfm 19577 19578----load check-input-module.maude 19579 19580---- Input modules are assumed not to have: 19581---- - idem 19582---- - assoc without comm 19583---- - variable alone in lhs 19584---- - owise 19585---- - iter 19586---- - built-ins 19587---- - something else? 19588 19589fmod CHECK-INPUT-MODULE is 19590 inc EXT-TERM . 19591 inc MODULE-HANDLING * (op addOps to addOpsSE, op addEqs to addEqsSE, op addSorts to addSortsSE) . 19592 inc COMMAND-PROCESSING . 19593 19594 op checkModule : Module -> Bool . 19595 op attr : OpDeclSet Attr -> Bool . 19596 ops assocWithoutComm specialAttr : OpDeclSet -> Bool . 19597 op nonValidAttrs : OpDeclSet AttrSet -> Bool . 19598 op singleVbleInLHSs : RuleSet -> Bool . 19599 op singleVbleInLHSs : EquationSet -> Bool . 19600 19601 var M : Module . 19602 var F : Qid . 19603 var TpL : TypeList . 19604 vars Tp Tp' Tp'' Tp''' : Type . 19605 var TpS : TypeSet . 19606 var At : Attr . 19607 vars AtS AtS' : AttrSet . 19608 vars ODS ODS' : OpDeclSet . 19609 var V : Variable . 19610 var VS : QidSet . 19611 var RlS : RuleSet . 19612 var EqS : EquationSet . 19613 vars T LHS RHS : Term . 19614 var Cond : Condition . 19615 19616 eq attr(op F : TpL -> Tp [owise AtS] . ODS, At AtS) = true . 19617 eq attr(op F : TpL -> Tp [idem AtS] . ODS, idem) = true . 19618 eq attr(op F : TpL -> Tp [iter AtS] . ODS, iter) = true . 19619 eq attr(ODS, At) = false [owise] . 19620 19621 eq nonValidAttrs(op F : TpL -> Tp [At AtS] . ODS, At AtS') = true . 19622 eq nonValidAttrs(ODS, AtS) = false [owise] . 19623 19624 ---- special attributes only allowed for constants 19625 eq specialAttr(op F : TpL -> Tp [special(NEHL:NeHookList) AtS] . ODS) = TpL =/= nil . 19626 eq specialAttr(ODS) = false [owise] . 19627 19628 eq assocWithoutComm(op F : TpL -> Tp [assoc AtS] . ODS) 19629 = (not comm in AtS) or-else assocWithoutComm(ODS) . 19630 eq assocWithoutComm(ODS) = false [owise] . 19631 19632 eq singleVbleInLHSs(rl V => RHS [AtS] . RlS) = true . 19633 eq singleVbleInLHSs(crl V => RHS if Cond [AtS] . RlS) = true . 19634 eq singleVbleInLHSs(RlS) = false [owise] . 19635 19636 eq singleVbleInLHSs(eq V = RHS [AtS] . EqS) = true . 19637 eq singleVbleInLHSs(ceq V = RHS if Cond [AtS] . EqS) = true . 19638 eq singleVbleInLHSs(EqS) = false [owise] . 19639 19640 op isRegular : EquationSet -> Bool . 19641 op isRegular : RuleSet -> Bool . 19642 eq isRegular(eq LHS = RHS [AtS] . EqS) = (vars(LHS) == vars(RHS)) and isRegular(EqS) . 19643 eq isRegular(ceq LHS = RHS if Cond [AtS] . EqS) = (vars(LHS) == vars(RHS)) and isRegular(EqS) . 19644 eq isRegular(rl LHS => RHS [AtS] . RlS) = (vars(LHS) == vars(RHS)) and isRegular(RlS) . 19645 eq isRegular(crl LHS => RHS if Cond [AtS] . RlS) = (vars(LHS) == vars(RHS)) and isRegular(RlS) . 19646 19647 ---- We say that a term l is linear iff all its variables appear only once in it. 19648 19649 op linear : Term -> Bool . 19650 eq linear(T) = | vars(T) | == size(varlist(T)) . 19651 19652 ---- We say that a term l is C-nonlinear iff all its variables are c-nonlinear. 19653 ---- A variable x : s in vars(l) is c-nonlinear if it is nonlinear in l and 19654 ---- there is a \Sigma-subterm t with ls[t]_B <= s with a position p such that 19655 ---- t|_p = f(u,v) with B_f = {C_f}. 19656 19657 op c-nonlinear : Qid Term Module -> Bool . ---- the variable (1st arg.) is c-linear in the term (2nd arg.) 19658 op c-nonlinear : Term Module -> Bool . ---- no repeated variables and all such varaibles are c-linear 19659 op c-nonlinearAux : QidSet Module -> Bool . 19660 op c-nonlinearAux : Type Module -> Bool . 19661 op c-nonlinearAux : Type TypeSet OpDeclSet OpDeclSet Module -> Bool . 19662 op c-nonlinearAux2 : TypeList TypeSet OpDeclSet Module -> Bool . 19663 19664 eq c-nonlinear(V, T, M) = occurrences(V, T) > 1 and-then c-nonlinearAux(V, M) . 19665 19666 eq c-nonlinear(T, M) = not linear(T) and-then c-nonlinearAux(vars(T), M) . 19667 19668 eq c-nonlinearAux(V ; VS, M) = c-nonlinearAux(getType(V), M) or-else c-nonlinearAux(VS, M) . 19669 eq c-nonlinearAux(none, M) = false . 19670 19671 eq c-nonlinearAux(Tp, M) = c-nonlinearAux(Tp, Tp, getOps(M), getOps(M), M) . 19672 19673 ceq c-nonlinearAux(Tp, TpS, op F : Tp' Tp'' -> Tp''' [comm AtS] . ODS, ODS', M) 19674 = true 19675 if sortLeq(M, Tp''', Tp) . 19676 eq c-nonlinearAux(Tp, TpS, op F : TpL -> Tp' [AtS] . ODS, ODS', M) 19677 = if not comm in AtS and-then (not Tp in TpS and-then sortLeq(M, Tp', Tp)) 19678 then c-nonlinearAux2(TpL, TpS, ODS', M) ---- all the sorts in that declarations have already been checked 19679 else c-nonlinearAux(Tp, TpS, ODS, ODS', M) 19680 fi 19681 [owise] . 19682 eq c-nonlinearAux(Tp, TpS, none, ODS, M) 19683 = false . 19684 19685 eq c-nonlinearAux2(Tp TpL, TpS, ODS, M) 19686 = if Tp in TpS 19687 then false 19688 else c-nonlinearAux(Tp, Tp ; TpS, ODS, ODS, M) 19689 fi 19690 or-else c-nonlinearAux2(TpL, TpS, ODS, M) . 19691 eq c-nonlinearAux2(nil, TpS, ODS, M) = false . 19692 19693---( 19694 eq c-permute(C, M) = C . 19695 eq c-permute(V, M) = V . 19696 ceq c-permute(F[T, T'], M) 19697 = c-combine(F, c-permute((T, T'), M)) # c-combine(F, c-permute((T', T), M)) 19698 if isCommutative(M, F, getTypes(M, (T, T'))) . 19699 eq c-permute(F[TL], M) 19700 = c-combine(F, c-permute(TL, M)) 19701 [owise] . 19702 19703 eq c-permute((T, T'), M) 19704 = c-permute(T, M) . 19705---) 19706endfm 19707 19708-------------------------------------------------------------------------------- 19709 19710view SubstitutionSet from TRIV to SUBSTITUTIONSET is 19711 sort Elt to SubstitutionSet . 19712endv 19713 19714fmod MODULE-VARIANTS is 19715 inc CHECK-INPUT-MODULE . 19716 inc META-NARROWING-SEARCH * (op addOps to addOpsSE, op addEqs to addEqsSE, op addSorts to addSortsSE) . 19717 inc UNIT . 19718 pr 2TUPLE{SubstitutionSet, Nat} 19719 * (op `(_`,_`) : SubstitutionSet Nat -> Tuple{SubstitutionSet, Nat} to <_;_>, 19720 op p1_ : Tuple{SubstitutionSet, Nat} -> SubstitutionSet to getSubst, 19721 op p2_ : Tuple{SubstitutionSet, Nat} -> Nat to getIndex) . 19722 pr CONVERSION . 19723 pr EXT-TERM . 19724 pr EXT-DECL . 19725 pr 2TUPLE{Module,Module} 19726 * (op `(_`,_`) : Module Module -> Tuple{Module, Module} to <_;_>) . 19727 19728 vars V W : Variable . 19729 var C : Constant . 19730 vars M M' M'' : Module . 19731 var N : Nat . 19732 vars T T' T'' LHS RHS : Term . 19733 var F : Qid . 19734 var TL : TermList . 19735 var AtS : AttrSet . 19736 var VFS : VariantFourSet . 19737 var VtS : VariantTripleSet . 19738 vars Tp Tp' Tp'' : Type . 19739 var TpL : TypeList . 19740 var Rl : Rule . 19741 var RlS : RuleSet . 19742 var Eq : Equation . 19743 var EqS : EquationSet . 19744 var ODS : OpDeclSet . 19745 var Cond : Condition . 19746 var S : Sort . 19747 var VS : QidSet . 19748 vars Subst Subst' : Substitution . 19749 vars SubstS SubstS' : SubstitutionSet . 19750 var H : Header . 19751 var SS : SortSet . 19752 var SSDS : SubsortDeclSet . 19753 vars OPDS OPDS' : OpDeclSet . 19754 var MAS : MembAxSet . 19755 var IL : ImportList . 19756 19757 ------------------------------------------------------------------------------ 19758 ---- Given a module \mathcal{R} = (\Sigma, E, R) 19759 ---- removeIds(\mathcal{R}) = removeIds((\widehat{\Sigma}, B, \widetilde{U}), R) 19760 ---- where 19761 ---- - \widehat{\Sigma} is obtained by 19762 ---- - adding to $\Sigma$ a fresh new sort [Tuple] and 19763 ---- - a tupling operator <_,...,_> : [s] [s_1] ... [s_n] -> [Tuple] 19764 ---- for each rule l -> r if u_1 -> v_1 /\ ... /\ u_n -> v_n in R, 19765 ---- where l has sort s and v_i has sort s_i, 1 <= i <= n, 19766 ---- - B_f = E_f \cap {A_f, C_f} 19767 ---- - U_f = E_f \cap {LU_f, RU_f}, 19768 ---- with LU_f and RU_f rewrite rules f(e,x) -> x and f(x,e) -> x, and 19769 ---- where \widetilde{U} is the B-coherence completion of U, 19770 ---- which is described as \widetilde{U} = \bigcup_{f:[s_1]...[s_n] -> [s] \in \Sigma} \widetilde{U}_f. 19771 ---- If A_f \not \in B_f, or A_f, C_f \in B_f, then \widetilde{U}_f = U_f. 19772 ---- Otherwise, if A_f \in B_f, but C_f \not \in B_f, then, 19773 ---- if LU_f \in U_f, then we add the rule f(x,f(e,y)) -> f(x,y) and 19774 ---- if RU_f \in U_f, then we add the rule f(f(x,e'),y) -> f(x,y). 19775 ---- makeIdsModule computes (\widehat{\Sigma}, B, \widetilde{U}) 19776 ------------------------------------------------------------------------------ 19777 19778 sort VariantProcedure . 19779 ops narrowing ad-hoc built-in : -> VariantProcedure . 19780 var VP : VariantProcedure . 19781---- sort IdsToRemove . ---- moved to COMMAND-PROCESSING 19782---- ops all non-handled : -> IdsToRemove . ---- moved to COMMAND-PROCESSING 19783 var Which : IdsToRemove . 19784 19785 op removeIds : Module IdsToRemove ~> Module . ---- moved to COMMAND-PROCESSING 19786 ---- given a module returns an equivalent module without ids but with variants of eqs and rls 19787 ---- the second argument may be either all (all id attributes are removed) or non-handled (only those not directly handled by Maude's unification are removed) 19788 op removeIds : Module IdsToRemove VariantProcedure ~> Module . 19789 ---- given a module returns an equivalent module without ids but with variants 19790 ---- of eqs and rls using the specified procedure for calculating variants 19791 op getVariants : Module Module RuleSet VariantProcedure -> RuleSet . 19792 ---- given a (\widehat{\Sigma}, B, \widetilde{U}) returns the variants of the given set of rules 19793 ---- It takes the modules without and with ids. The module with id attributes is used to normalize. 19794 op getVariants : Module Module EquationSet VariantProcedure -> EquationSet . 19795 ---- given a (\widehat{\Sigma}, B, \widetilde{U}) returns the variants of the given set of equations 19796 ---- It takes the modules without and with ids. The module with id attributes is used to normalize. 19797 op getVariants# : Module Module Term VariantProcedure -> VariantTripleSet . 19798 ---- given a (\widehat{\Sigma}, B, \widetilde{U}) returns the variants of a term (a tuple) 19799 op getRlVariants : Module VariantTripleSet Term Condition AttrSet -> RuleSet . 19800 ---- given the variants of a tuple < LHS, target terms in condition >, a RHS, a condition, and an attribute set, 19801 ---- it constructs the corresponding variant rules 19802 op getEqVariants : Module VariantTripleSet Term Condition AttrSet -> EquationSet . 19803 ---- given the variants of a tuple < LHS, target terms in condition >, a RHS, a condition, and an attribute set, 19804 ---- it constructs the corresponding variant equations 19805 19806 eq removeIds(M, Which) ---- Which may be either all or non-handled 19807 = if nonValidAttrs(getOps(M), owise idem) ---- iter 19808 then unitError('The 'module 'uses 'non-supported 'attributes '`(owise 'or 'idem`). '\n) 19809 else if singleVbleInLHSs(getRls(M)) 19810 then unitError('The 'module 'contains 'rules 'with 'single 'variables 'in 'their 'left-hand 'sides. '\n) 19811 else if singleVbleInLHSs(getEqs(M)) 19812 then unitError('The 'module 'contains 'equations 'with 'single 'variables 'in 'their 'left-hand 'sides. '\n) 19813 else if assocWithoutComm(getOps(M)) 19814 then moreGeneralEqs(moreGeneralRls(removeIds(M, Which, ad-hoc))) 19815 else moreGeneralEqs(moreGeneralRls(removeIds(M, Which, narrowing))) ---- built-in 19816 fi 19817 fi 19818 fi 19819 fi . 19820 19821 eq removeIds(M, Which, VP) 19822 ---- the narrowing based getVariant function requires a module with id attributes turned into eqs 19823 ---- and sort Tuple and tuple operators in; the ad-hoc getVariant (FroCos th 2) only needs the 19824 ---- tuple declarations. 19825 = setRls( 19826 addEqs( 19827 getVariants(makeIdsTuplingModule(M, Which), addTupling(M, M), getEqs(M), VP), 19828 makeIdsModule(M, Which)), 19829 getVariants(makeIdsTuplingModule(M, Which), addTupling(M, M), getRls(M), VP)) . 19830 19831 eq getVariants(M, M', Rl RlS, VP) 19832 = getRlVariants(M', getVariants#(M, M', makeTuple(lhs(Rl), cond(Rl)), VP), rhs(Rl), cond(Rl), atts(Rl)) 19833 getVariants(M, M', RlS, VP) . 19834 eq getVariants(M, M', (none).RuleSet, VP) = none . 19835 19836 eq getVariants(M, M', Eq EqS, VP) 19837 = getEqVariants(M', getVariants#(M, M', makeTuple(lhs(Eq), cond(Eq)), VP), rhs(Eq), cond(Eq), atts(Eq)) 19838 getVariants(M, M', EqS, VP) . 19839 eq getVariants(M, M', (none).EquationSet, VP) = none . 19840 19841 eq getVariants#(M, M', T, narrowing) = makeVariantSet(getVariants(M, T, 1, irreducible ACUUnify minimal-unifiers)) . 19842 19843 op makeVariantSet : VariantFourSet -> VariantTripleSet . 19844 eq makeVariantSet({T, Subst, Subst', N} | VFS) = {T, Subst, N, none, false} | makeVariantSet(VFS) . 19845 eq makeVariantSet(empty) = empty . 19846 19847 eq getRlVariants(M, ({'@<@_@>@[T], Subst, N, P:Parent, B:Bool} | VtS), T', nil, AtS) 19848 = (rl getTerm(metaNormalize(M, T)) 19849 => getTerm(metaNormalize(M, _<<_(T', Subst))) [AtS] .) 19850 getRlVariants(M, VtS, T', nil, AtS) . 19851 eq getRlVariants(M, ({F[T, TL], Subst, N, P:Parent, B:Bool} | VtS), T', Cond, AtS) 19852 = (crl getTerm(metaNormalize(M, T)) 19853 => getTerm(metaNormalize(M, _<<_(T', Subst))) 19854 if makeCond(TL, Cond, Subst) [AtS] .) 19855 getRlVariants(M, VtS, T', Cond, AtS) . 19856 eq getRlVariants(M, empty, T', Cond, AtS) = none . 19857 19858 eq getEqVariants(M, ({'@<@_@>@[T], Subst, N, P:Parent, B:Bool} | VtS), T', nil, AtS) 19859 = (eq getTerm(metaNormalize(M, T)) 19860 = getTerm(metaNormalize(M, _<<_(T', Subst))) [AtS] .) 19861 getEqVariants(M, VtS, T', nil, AtS) . 19862 eq getEqVariants(M, ({F[T, TL], Subst, N, P:Parent, B:Bool} | VtS), T', Cond, AtS) 19863 = (ceq getTerm(metaNormalize(M, T)) 19864 = getTerm(metaNormalize(M, _<<_(T', Subst))) 19865 if makeCond(TL, Cond, Subst) [AtS] .) 19866 getEqVariants(M, VtS, T', Cond, AtS) . 19867 eq getEqVariants(M, empty, T', Cond, AtS) = none . 19868 19869 ------------------------------------------------------------------------------ 19870 19871 op makeTuple : Term Condition -> Term . 19872 op tupleTermList : Condition -> TermList . 19873 eq makeTuple(T, Cond) 19874 = if Cond == nil 19875 then qid("@<@_@>@")[T] 19876 else qid("@<@_" + tupleId(Cond) + "@>@")[T, tupleTermList(Cond)] 19877 fi . 19878 eq tupleTermList(T' => T'' /\ Cond) = (T'', tupleTermList(Cond)) . 19879 eq tupleTermList(T' = T'' /\ Cond) = tupleTermList(Cond) . 19880 eq tupleTermList(T' : S /\ Cond) = tupleTermList(Cond) . 19881 eq tupleTermList(T' := T'' /\ Cond) = (T', tupleTermList(Cond)) . 19882 eq tupleTermList(nil) = empty . 19883 19884 op makeCond : TermList Condition Substitution -> Condition . 19885 eq makeCond((T, TL), T' => T'' /\ Cond, Subst) 19886 = (T' << Subst) => T /\ makeCond(TL, Cond, Subst) . 19887 eq makeCond((T, TL), T' := T'' /\ Cond, Subst) 19888 = T := (T'' << Subst) /\ makeCond(TL, Cond, Subst) . 19889 eq makeCond(TL, T' = T'' /\ Cond, Subst) 19890 = (T' << Subst) = (T'' << Subst) /\ makeCond(TL, Cond, Subst) . 19891 eq makeCond(TL, T' : S /\ Cond, Subst) 19892 = (T' << Subst) : S /\ makeCond(TL, Cond, Subst) . 19893 eq makeCond(empty, nil, Subst) = nil . 19894 19895 ------------------------------------------------------------------------------ 19896 ---- makeIdsTuplingModule((\Sigma, E, R)) computes (\widehat{\Sigma}, B, \widetilde{U}) 19897 ------------------------------------------------------------------------------ 19898 op makeIdsTuplingModule : Module IdsToRemove -> Module . 19899 op makeIdsModule : Module IdsToRemove -> Module . 19900 op addTupling : Module Module -> Module . 19901 ---- addTupling is called after makeIdsModule, which removes the eqs in it 19902 ---- the first module is the oiginal one, with the original eqs and rls 19903 19904 eq makeIdsTuplingModule(M, Which) = addTupling(M, makeIdsModule(M, Which)) . 19905 19906 eq makeIdsModule(M, Which) 19907 = setEqs( 19908 setOps( 19909 setRls(M, none), 19910 removeIds(getOps(M), Which)), 19911 idEqs(M, getOps(M), Which)) . 19912 19913 eq addTupling(M, M') 19914 = addOps( 19915 tuplingOps(M, getEqs(M), getRls(M)), 19916 addSorts('Tuple, M')) . 19917 19918 op idEqs : Module OpDeclSet IdsToRemove -> EquationSet . 19919 ---- the 3rd arguments indicates whether all the id attributes are to be removed (all), or only those not handled by the Maude unification algorithm (non-handled) 19920 eq idEqs(M, op F : Tp Tp' -> Tp'' [left-id(T) AtS] . ODS, Which) 19921 = (eq F[T, qid("X:" + string(type2qid(getKind(M, Tp))))] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('lIdEq1) 19922 if assoc in AtS and not comm in AtS 19923 then (eq F[qid("X:" + string(type2qid(getKind(M, Tp)))), F[T, qid("Y:" + string(type2qid(getKind(M, Tp))))]] 19924 = F[qid("X:" + string(type2qid(getKind(M, Tp)))), qid("Y:" + string(type2qid(getKind(M, Tp))))] 19925 [variant] .) ---- label('lIdEq2) 19926 else none 19927 fi 19928 idEqs(M, ODS, Which) . 19929 eq idEqs(M, op F : Tp Tp' -> Tp'' [right-id(T) AtS] . ODS, Which) 19930 = (eq F[qid("X:" + string(type2qid(getKind(M, Tp)))), T] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('rIdEq1) 19931 if assoc in AtS and not comm in AtS 19932 then (eq F[F[qid("X:" + string(type2qid(getKind(M, Tp)))), T], qid("Y:" + string(type2qid(getKind(M, Tp))))] 19933 = F[qid("X:" + string(type2qid(getKind(M, Tp)))), qid("Y:" + string(type2qid(getKind(M, Tp))))] 19934 [variant] .) ---- label('rIdEq2) 19935 else none 19936 fi 19937 idEqs(M, ODS, Which) . 19938 eq idEqs(M, op F : Tp Tp' -> Tp'' [id(T) AtS] . ODS, all) 19939 = if comm in AtS 19940 then (eq F[T, qid("X:" + string(type2qid(getKind(M, Tp))))] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('idEq1) 19941 else (eq F[qid("X:" + string(type2qid(getKind(M, Tp)))), T] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('idEq2) 19942 (eq F[T, qid("X:" + string(type2qid(getKind(M, Tp))))] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('idEq3) 19943 fi 19944 if assoc in AtS and not comm in AtS 19945 then (eq F[qid("X:" + string(type2qid(getKind(M, Tp)))), F[T, qid("Y:" + string(type2qid(getKind(M, Tp))))]] 19946 = F[qid("X:" + string(type2qid(getKind(M, Tp)))), qid("Y:" + string(type2qid(getKind(M, Tp))))] 19947 [variant] .) 19948 (eq F[F[qid("X:" + string(type2qid(getKind(M, Tp)))), T], qid("Y:" + string(type2qid(getKind(M, Tp))))] 19949 = F[qid("X:" + string(type2qid(getKind(M, Tp)))), qid("Y:" + string(type2qid(getKind(M, Tp))))] 19950 [variant] .) 19951 else none 19952 fi 19953 idEqs(M, ODS, all) . 19954 eq idEqs(M, op F : Tp Tp' -> Tp'' [id(T) AtS] . ODS, non-handled) 19955 ---- modified on Jan 13th, 2011 19956 ---- The ACU case is now handled, the id attributes are left if also AC 19957 = if assoc in AtS and comm in AtS 19958 then none 19959 else if comm in AtS 19960 then (eq F[T, qid("X:" + string(type2qid(getKind(M, Tp))))] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('idEq1) 19961 else (eq F[qid("X:" + string(type2qid(getKind(M, Tp)))), T] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('idEq2) 19962 (eq F[T, qid("X:" + string(type2qid(getKind(M, Tp))))] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('idEq3) 19963 fi 19964 if assoc in AtS and not comm in AtS 19965 then (eq F[qid("X:" + string(type2qid(getKind(M, Tp)))), F[T, qid("Y:" + string(type2qid(getKind(M, Tp))))]] 19966 = F[qid("X:" + string(type2qid(getKind(M, Tp)))), qid("Y:" + string(type2qid(getKind(M, Tp))))] 19967 [variant] .) 19968 (eq F[F[qid("X:" + string(type2qid(getKind(M, Tp)))), T], qid("Y:" + string(type2qid(getKind(M, Tp))))] 19969 = F[qid("X:" + string(type2qid(getKind(M, Tp)))), qid("Y:" + string(type2qid(getKind(M, Tp))))] 19970 [variant] .) 19971 else none 19972 fi 19973 fi 19974 idEqs(M, ODS, non-handled) . 19975 eq idEqs(M, ODS, Which) = none [owise] . 19976 19977 op removeIds : OpDeclSet IdsToRemove -> OpDeclSet . 19978 eq removeIds(op F : TpL -> Tp [id(T) AtS] . ODS, all) 19979 = removeIds(op F : TpL -> Tp [AtS] . ODS, all) . 19980 ceq removeIds(op F : TpL -> Tp [id(T) AtS] . ODS, non-handled) 19981 = removeIds(op F : TpL -> Tp [AtS] . ODS, non-handled) 19982 if not (assoc in AtS and comm in AtS) . 19983 eq removeIds(op F : TpL -> Tp [left-id(T) AtS] . ODS, Which) 19984 = removeIds(op F : TpL -> Tp [AtS] . ODS, Which) . 19985 eq removeIds(op F : TpL -> Tp [right-id(T) AtS] . ODS, Which) 19986 = removeIds(op F : TpL -> Tp [AtS] . ODS, Which) . 19987 eq removeIds(ODS, Which) = ODS [owise] . 19988 19989 op tuplingOps : Module EquationSet RuleSet -> OpDeclSet . 19990 op tuplingOps : Module EquationSet -> OpDeclSet . 19991 op tuplingOps : Module RuleSet -> OpDeclSet . 19992 eq tuplingOps(M, EqS, RlS) = tuplingOps(M, EqS) tuplingOps(M, RlS) . 19993 eq tuplingOps(M, eq LHS = RHS [AtS] . EqS) 19994 = (op qid("@<@_@>@") : getKind(M, leastSort(M, LHS)) -> '`[Tuple`] [none] .) 19995 tuplingOps(M, EqS) . 19996 eq tuplingOps(M, ceq LHS = RHS if Cond [AtS] . EqS) 19997 = (op qid("@<@_" + tupleId(Cond) + "@>@") : getKind(M, leastSort(M, LHS)) arityCond(M, Cond) -> '`[Tuple`] [none] .) 19998 tuplingOps(M, EqS) . 19999 eq tuplingOps(M, (none).EquationSet) = none . 20000 eq tuplingOps(M, rl LHS => RHS [AtS] . RlS) 20001 = (op qid("@<@_@>@") : getKind(M, leastSort(M, LHS)) -> '`[Tuple`] [none] .) 20002 tuplingOps(M, RlS) . 20003 eq tuplingOps(M, crl LHS => RHS if Cond [AtS] . RlS) 20004 = (op qid("@<@_" + tupleId(Cond) + "@>@") : getKind(M, leastSort(M, LHS)) arityCond(M, Cond) -> '`[Tuple`] [none] .) 20005 tuplingOps(M, RlS) . 20006 eq tuplingOps(M, (none).RuleSet) = none . 20007 20008 op arityCond : Module Condition -> TypeList . 20009 eq arityCond(M, T => T' /\ Cond) = getKind(M, leastSort(M, T')) arityCond(M, Cond) . 20010 eq arityCond(M, T := T' /\ Cond) = getKind(M, leastSort(M, T)) arityCond(M, Cond) . 20011 eq arityCond(M, T = T' /\ Cond) = arityCond(M, Cond) . 20012 eq arityCond(M, T : S /\ Cond) = arityCond(M, Cond) . 20013 eq arityCond(M, nil) = nil . 20014 20015 op tupleId : Condition -> String . 20016 eq tupleId(T => T' /\ Cond) = ",_" + tupleId(Cond) . 20017 eq tupleId(T := T' /\ Cond) = ",_" + tupleId(Cond) . 20018 eq tupleId(T = T' /\ Cond) = tupleId(Cond) . 20019 eq tupleId(T : S /\ Cond) = tupleId(Cond) . 20020 eq tupleId(Cond) = "" . 20021 20022 ------------------------------------------------------------------------------ 20023 ---- See Th. 2, FroCos'09 20024 ---- TO DO: it doesn't give the minimal set of variants 20025 20026 op getVariants : Module Term SubstitutionSet -> VariantTripleSet . 20027 op getSubstitutions : Module QidSet OpDeclSet Nat -> Tuple{SubstitutionSet,Nat} . 20028 op getSubstitutions1 : Module Variable OpDeclSet Nat -> Tuple{SubstitutionSet,Nat} . 20029 op combineSubsts : SubstitutionSet SubstitutionSet -> SubstitutionSet . 20030 20031 eq getVariants#(M, M', T, ad-hoc) 20032 = getVariants(M', T, getSubst(getSubstitutions(M', vars(T), getOps(M'), 0))) . 20033 20034 eq getVariants(M, T, Subst | SubstS) 20035 = {getTerm(metaNormalize(M, T << Subst)), Subst, 0, none, false} | getVariants(M, T, SubstS) . 20036 eq getVariants(M, T, empty) = {T, none, 0, none, false} . 20037 20038 eq getSubstitutions(M, V ; VS, ODS, N) 20039 = < combineSubsts( 20040 getSubst(getSubstitutions1(M, V, ODS, N)), 20041 getSubst(getSubstitutions(M, VS, ODS, getIndex(getSubstitutions1(M, V, ODS, N))))) ; 20042 getIndex(getSubstitutions(M, VS, ODS, getIndex(getSubstitutions1(M, V, ODS, N)))) > . 20043 eq getSubstitutions(M, none, ODS, N) = < empty ; N > . 20044 20045 eq combineSubsts(Subst | SubstS, Subst' | SubstS') 20046 = (Subst ; Subst') | combineSubsts(SubstS, Subst' | SubstS') | combineSubsts(Subst, SubstS') . 20047 eq combineSubsts(SubstS, empty) = SubstS . 20048 eq combineSubsts(empty, SubstS) = SubstS . 20049 20050 ceq getSubstitutions1(M, V, op F : TpL -> Tp [id(T) AtS] . ODS, N) 20051 = < (V <- T) | 20052 if (assoc in AtS and-then not comm in AtS) 20053 and-then sortLeq(M, leastSort(M, F[qid("X@" + string(N, 10) + ":" + string(Tp)), T]), getType(V)) 20054 then (V <- (F[qid("X@" + string(N, 10) + ":" + string(Tp)), T])) 20055 | (V <- (F[T, qid("X@" + string(s N, 10) + ":" + string(Tp))])) 20056 else empty 20057 fi | 20058 getSubst(getSubstitutions1(M, V, ODS, s s N)) ; 20059 getIndex(getSubstitutions1(M, V, ODS, s s N)) > 20060 if sortLeq(M, leastSort(M, T), getType(V)) . ---- ls[e] <= s ls[f(y,e)] <= s 20061 ceq getSubstitutions1(M, V, op F : TpL -> Tp [right-id(T) AtS] . ODS, N) 20062 = < (V <- T) | 20063 if (assoc in AtS and-then not comm in AtS) 20064 and-then sortLeq(M, leastSort(M, F[qid("X@" + string(N, 10) + ":" + string(Tp)), T]), getType(V)) 20065 then (V <- F[T, qid("X@" + string(N, 10) + ":" + string(Tp))]) 20066 else empty 20067 fi | 20068 getSubst(getSubstitutions1(M, V, ODS, s s N)) ; 20069 getIndex(getSubstitutions1(M, V, ODS, s s N)) > 20070 if sortLeq(M, leastSort(M, T), getType(V)) . ---- ls[e] <= s ls[f(y,e)] <= s 20071 ceq getSubstitutions1(M, V, op F : TpL -> Tp [left-id(T) AtS] . ODS, N) 20072 = < (V <- T) | 20073 if (assoc in AtS and-then not comm in AtS) 20074 and-then sortLeq(M, leastSort(M, F[qid("X@" + string(N, 10) + ":" + string(Tp)), T]), getType(V)) 20075 then (V <- F[qid("X@" + string(s N, 10) + ":" + string(Tp)), T]) 20076 else empty 20077 fi | 20078 getSubst(getSubstitutions1(M, V, ODS, s s N)) ; 20079 getIndex(getSubstitutions1(M, V, ODS, s s N)) > 20080 if sortLeq(M, leastSort(M, T), getType(V)) . ---- ls[e] <= s ls[f(y,e)] <= s 20081 eq getSubstitutions1(M, V, ODS, N) = < empty ; N > [owise] . 20082 20083 ------------------------------------------------------------------------------ 20084 ---- Given a module with axioms B where for each f we have B_f \in {A_f,C_f}, 20085 ---- we now define a rewrite theory (\Sigma, B', A), where for each f we have 20086 ---- B'_f = B_f if B_f =/= {A_f}, and B'_f = \emptyset if B_f == {A_f}, and 20087 ---- where A consists of rules of either the form 20088 ---- f(f(x, y), z) -> f(x, f(y, z)) 20089 ---- or the form 20090 ---- f(x, f(y, z)) -> f(f(x, y), z) 20091 ---- for each f such that B_f == {A_f}. That is, for any such f we "choose" a 20092 ---- rule asociating f to the right or to the left (but only "one" of these possibilities). 20093 20094 ---- TO DO: I cannot set a timeout. If the first one doesn't work it hangs up! 20095 ---- TO DO: All terms are in their flatten form, when removing the assoc atributes I get error messages. 20096 20097 op removeLonelyAssocs : Module -> Module . 20098 ---- removes all assoc with no comm, returning an equivalent module 20099 op $removeLonelyAssocs : OpDeclSet -> OpDeclSet . 20100 ---- removes those assoc attributes that are not with the comm one 20101 op $removeLonelyAssocs : Module OpDeclSet OpDeclSet EquationSet ~> Module . 20102 ---- arg. 1 (Module): the module with assoc attribute removed 20103 ---- arg. 2 (OpDeclSet): initially all op. decls.; they are evaluated one by one, 20104 ---- adding the corresponding equation to the 4th arg. in the recursive call 20105 ---- arg. 3 (OpDeclSet): initially empty; evaluated op. decls. are added to this set 20106 ---- arg. 4 (EquationSet): assoc. eq. to be added to the module 20107 op $checkAEq : Module Equation -> Bool . 20108 ---- checks whether the assoc. eq. given as argument unifies with any lhs in the module 20109 ---- arg. 1 (Module): the module with assoc attribute removed 20110 ---- arg. 2 (Equation): tentative assoc. eq. to evaluate 20111 op $checkAEqAux : Module EquationSet -> Bool . 20112 ---- tries to narrow with the assoc. eq. (as a rule) on each lhs in the module. 20113 ---- arg. 1 (Module): module with assoc attribute removed, with the assoc. eq. 20114 ---- turned into a rule as single rule (no eqs.) 20115 ---- arg. 2 (EquationSet): eqs. in the original module 20116 op $anyLonelyAssoc : OpDeclSet -> Bool . 20117 ---- checks whether the module contains an operator with assoc and no comm 20118 20119 eq removeLonelyAssocs(M) 20120 = if $anyLonelyAssoc(getOps(M)) 20121 then if nonValidAttrs(getOps(M), owise idem) ---- iter 20122 then unitError('The 'module 'uses 'non-supported 'attributes '`(owise 'or 'idem`). '`)) 20123 else if singleVbleInLHSs(getRls(M)) 20124 then unitError('The 'module 'contains 'rules 'with 'single 'variables 'in 'their 'left-hand 'sides. '`)) 20125 else if singleVbleInLHSs(getEqs(M)) 20126 then unitError('The 'module 'contains 'equations 'with 'single 'variables 'in 'their 'left-hand 'sides. '`)) 20127 else $removeLonelyAssocs(setOps(M, $removeLonelyAssocs(getOps(M))), getOps(M), none, none) 20128 fi 20129 fi 20130 fi 20131 else M 20132 fi . 20133 20134 ceq $removeLonelyAssocs(op F : Tp Tp -> Tp [assoc AtS] . OPDS) 20135 = op F : Tp Tp -> Tp [AtS] . $removeLonelyAssocs(OPDS) 20136 if not comm in AtS . 20137 eq $removeLonelyAssocs(OPDS) = OPDS [owise] . 20138 20139 ceq $removeLonelyAssocs(M, op F : TpL -> Tp [AtS] . OPDS, OPDS', EqS) 20140 = $removeLonelyAssocs(M, OPDS, op F : TpL -> Tp [AtS] . OPDS', EqS) 20141 if size(TpL) =/= 2 or not assoc in AtS or comm in AtS . 20142 ceq $removeLonelyAssocs(M, op F : Tp Tp -> Tp [assoc AtS] . OPDS, OPDS', EqS) 20143 = $removeLonelyAssocs(M, OPDS, op F : Tp Tp -> Tp [AtS] . OPDS', Eq EqS) 20144 if not comm in AtS 20145 /\ Str:String := string(type2qid(getKind(M, Tp))) 20146 /\ Eq := (eq F[F[qid("X:" + Str:String), qid("Y:" + Str:String)], qid("Z:" + Str:String)] 20147 = F[qid("X:" + Str:String), F[qid("Y:" + Str:String), qid("Z:" + Str:String)]] [label('assocEq)] .) 20148 /\ $checkAEq(M, Eq) . 20149 ceq $removeLonelyAssocs(M, op F : Tp Tp -> Tp [assoc AtS] . OPDS, OPDS', EqS) 20150 = $removeLonelyAssocs(M, OPDS, op F : Tp Tp -> Tp [AtS] . OPDS', Eq EqS) 20151 if not comm in AtS 20152 /\ Str:String := string(type2qid(getKind(M, Tp))) 20153 /\ Eq := (eq F[qid("X:" + Str:String), F[qid("Y:" + Str:String), qid("Z:" + Str:String)]] 20154 = F[F[qid("X:" + Str:String), qid("Y:" + Str:String)], qid("Z:" + Str:String)] [label('assocEq)] .) 20155 /\ $checkAEq(M, Eq) . 20156 eq $removeLonelyAssocs(M, none, OPDS', EqS) = addEqs(EqS, M) . 20157 eq $removeLonelyAssocs(M, op F : TpL -> Tp [AtS] . OPDS, OPDS', EqS) = unitError('assoc 'attributes 'cannot 'be 'removed 'for F) [owise] . 20158 20159 eq $checkAEq(M, Eq) = $checkAEqAux(setRls(setEqs(M, none), rulify(Eq)), getEqs(M)) . 20160 20161 ceq $checkAEqAux(M, Eq EqS) 20162 = T:Term == lhs(Eq) ---- the assoc eq doesn't unify with the equation's lhs 20163 and 20164 Subst:Substitution == none 20165 and-then 20166 $checkAEqAux(M, EqS) 20167 if {T:Term, Tp:Type, Subst:Substitution} := metaNarrow(M, lhs(Eq), 1) . 20168 eq $checkAEqAux(M, none) = true . 20169 20170 ceq $anyLonelyAssoc(op F : Tp Tp -> Tp [assoc AtS] . OPDS) 20171 = true 20172 if not comm in AtS . 20173 eq $anyLonelyAssoc(OPDS) = false [owise] . 20174endfm 20175 20176******************************************************************************* 20177 20178*** 20179*** Interaction with the Persistent Database 20180*** 20181 20182*** In the case of Full Maude, the persistent state of the system is given by 20183*** a single object which maintains the database of the system. This object 20184*** has an attribute \texttt{db}, to keep the actual database in which all the 20185*** modules being entered are stored, an attribute \texttt{default}, to keep 20186*** the identifier of the current module by default, and attributes 20187*** \texttt{input} and \texttt{output} to simplify the communication of the 20188*** read-eval-print loop given by the \texttt{LOOP-MODE} module with the 20189*** database. Using the notation for classes in object-oriented modules (see 20190*** Section~\ref{object-oriented-modules}) we can declare the class 20191*** \texttt{database} as follows: 20192*** 20193*** class database | db : Database, input : TermList, 20194*** output : QidList, default : ModId . 20195*** 20196*** Since we assume that \texttt{database} is the only object class that has 20197*** been defined---so that the only objects of sort \texttt{Object} will 20198*** belong to the \texttt{database} class---to specify the admissible states 20199*** in the persistent state of \texttt{LOOP-MODE} for Full Maude, it is enough 20200*** to give the subsort declaration 20201*** 20202*** subsort Object < State . 20203 20204*** 20205*** \subsection{The \texttt{CONFIGURATION+} Module} 20206*** 20207 20208*** change (2/20/2002): CONFIGURATION is now part of the prelude 20209*** 20210*** fmod CONFIGURATION is 20211*** sort Oid Cid Attribute AttributeSet Configuration Object Msg . 20212*** 20213*** subsort Attribute < AttributeSet . 20214*** subsorts Object Msg < Configuration . 20215*** 20216*** op none : -> AttributeSet . 20217*** op _,_ : AttributeSet AttributeSet -> AttributeSet 20218*** [assoc comm id: none] . 20219*** op none : -> Configuration . 20220*** op __ : Configuration Configuration -> Configuration 20221*** [assoc comm id: none] . 20222*** op <_:_|_> : Oid Cid AttributeSet -> Object . 20223*** op <_:_| > : Oid Cid -> Object . 20224*** 20225*** var O : Oid . 20226*** var C : Cid . 20227*** 20228*** eq < O : C | > = < O : C | none > . 20229*** endfm 20230 20231******************************************************************************* 20232 20233*** 20234*** Top Level Handling of the Persistent Database 20235*** 20236 20237*** Note that, since the Full Maude specification is given as a system module 20238***Core Maude, object-oriented declarations cannot be given directly. 20239*** Instead, the equivalent declarations desugaring the desired 20240*** object-oriented declarations have to be specified. We use also the same 20241*** conventions discussed in Section~\ref{omod2mod} regarding the use of 20242*** variables instead of class names in the objects and in the addition of 20243*** variables of sort \texttt{AttributeSet} to range over the additional 20244*** attributes. As we shall see in Chapter~\ref{crc}, this convention will 20245*** allow us to extend the Full Maude system in a very simple and clean way. 20246 20247*** To allow the use of the object-oriented notation the predefined module 20248*** \texttt{CONFIGURATION}, presented in Section~\ref{omod2mod}, is included 20249*** in the following module \texttt{DATABASE-HANDLING}. 20250 20251 20252mod DATABASE-HANDLING is 20253--- inc META-LEVEL + PRE-VARIANT . 20254 inc META-LEVEL . 20255 inc CONFIGURATION . 20256 pr VIEW-META-PRETTY-PRINT . 20257 pr VIEW-PROCESSING . 20258 pr COMMAND-PROCESSING . 20259 pr PREDEF-UNITS . 20260 pr MODULE-VARIANTS . 20261 pr AX-COHERENCE-COMPLETION . 20262 pr HELP . 20263 20264 var F : Qid . 20265 var QIL : QidList . 20266 var NQIL NQIL' NQIL'' : NeQidList . 20267 vars T T' T'' T3 : Term . 20268 var TL : TermList . 20269 var DB DB' : Database . 20270 vars ME ME' ME'' : ModuleExpression . 20271 vars QIL' QIL'' : QidList . 20272 vars MNS MNS' MNS'' MNS3 MNS4 : Set{ModuleName} . 20273 var VE : ViewExp . 20274 var VES : Set{ViewExp} . 20275 vars MIS MIS' : Set{ModuleInfo} . 20276 var VIS : Set{ViewInfo} . 20277 vars PDS PDS' : Set{ParameterDecl} . 20278 var B : Bool . 20279 var I : Import . 20280 var IL : ImportList . 20281 var MN : ModuleName . 20282 20283 op initialDatabase : -> Database . 20284 eq initialDatabase 20285 = insTermModule('META-MODULE, 20286 addOps(getOps(#UP#), 20287 addSorts(getSorts(#UP#), 20288 addImports(getImports(#UP#), upModule('META-MODULE, false)))), 20289 emptyDatabase) . 20290---( 20291 eq initialDatabase 20292 = insTermModule('META-MODULE, 20293 addOps(getOps(#UP#), 20294 addSorts(getSorts(#UP#), 20295 addImports(getImports(#UP#), upModule('META-MODULE, false)))), 20296 insertTermView('TRIV, 20297 ('view_from_to_is_endv['token[''TRIV.Qid],'token[''TRIV.Qid],'token[ 20298 ''TRIV.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ 20299 ''Elt.Qid]]]), 20300 insertTermView('Bool, 20301 ('view_from_to_is_endv['token[''Bool.Qid],'token[''TRIV.Qid],'token[ 20302 ''BOOL.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Bool.Qid]]]), 20303 insertTermView('Nat, 20304 ('view_from_to_is_endv['token[''Nat.Qid],'token[''TRIV.Qid],'token[ 20305 ''NAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Nat.Qid]]]), 20306 insertTermView('Int, 20307 ('view_from_to_is_endv['token[''Int.Qid],'token[''TRIV.Qid],'token[ 20308 ''INT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Int.Qid]]]), 20309 insertTermView('Rat, 20310 ('view_from_to_is_endv['token[''Rat.Qid],'token[''TRIV.Qid],'token[ 20311 ''RAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Rat.Qid]]]), 20312 insertTermView('Float, 20313 ('view_from_to_is_endv['token[''Float.Qid],'token[''TRIV.Qid],'token[ 20314 ''FLOAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ 20315 ''Float.Qid]]]), 20316 insertTermView('String, 20317 ('view_from_to_is_endv['token[''String.Qid],'token[''TRIV.Qid],'token[ 20318 ''STRING.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ 20319 ''String.Qid]]]), 20320 insertTermView('Qid, 20321 ('view_from_to_is_endv['token[''Qid.Qid],'token[''TRIV.Qid],'token[ 20322 ''QID.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Qid.Qid]]]), 20323 insertTermView('STRICT-WEAK-ORDER, 20324 ('view_from_to_is_endv['token[''STRICT-WEAK-ORDER.Qid],'token[''TRIV.Qid], 20325 'token[''STRICT-WEAK-ORDER.Qid],'sort_to_.['sortToken[''Elt.Qid], 20326 'sortToken[''Elt.Qid]]]), 20327 insertTermView('STRICT-TOTAL-ORDER, 20328 ('view_from_to_is_endv['token[''STRICT-TOTAL-ORDER.Qid], 20329 'token[''STRICT-WEAK-ORDER.Qid],'token[''STRICT-TOTAL-ORDER.Qid], 20330 'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Elt.Qid]]]), 20331 insertTermView('Nat<, 20332 ('view_from_to_is_endv['token[''Nat<.Qid],'token[''STRICT-TOTAL-ORDER.Qid], 20333 'token[''NAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Nat.Qid]]]), 20334 insertTermView('Int<, 20335 ('view_from_to_is_endv['token[''Int<.Qid],'token[''STRICT-TOTAL-ORDER.Qid], 20336 'token[''INT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Int.Qid]]]), 20337 insertTermView('Rat<, 20338 ('view_from_to_is_endv['token[''Rat<.Qid],'token[''STRICT-TOTAL-ORDER.Qid],'token[ 20339 ''RAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Rat.Qid]]]), 20340 insertTermView('Float<, 20341 ('view_from_to_is_endv['token[''Float<.Qid],'token[''STRICT-TOTAL-ORDER.Qid], 20342 'token[''FLOAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ 20343 ''Float.Qid]]]), 20344 insertTermView('String<, 20345 ('view_from_to_is_endv['token[''String<.Qid],'token[''STRICT-TOTAL-ORDER.Qid], 20346 'token[''STRING.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ 20347 ''String.Qid]]]), 20348 insertTermView('TOTAL-PREORDER, 20349 ('view_from_to_is_endv['token[''TOTAL-PREORDER.Qid],'token[''TRIV.Qid],'token[ 20350 ''TOTAL-PREORDER.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ 20351 ''Elt.Qid]]]), 20352 insertTermView('TOTAL-ORDER, 20353 ('view_from_to_is_endv['token[''TOTAL-ORDER.Qid],'token[''TOTAL-PREORDER.Qid], 20354 'token[''TOTAL-ORDER.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ 20355 ''Elt.Qid]]]), 20356 insertTermView('Nat<=, 20357 ('view_from_to_is_endv['token[''Nat<=.Qid],'token[''TOTAL-ORDER.Qid], 20358 'token[''NAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Nat.Qid]]]), 20359 insertTermView('Int<=, 20360 ('view_from_to_is_endv['token[''Int<=.Qid],'token[''TOTAL-ORDER.Qid], 20361 'token[''INT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Int.Qid]]]), 20362 insertTermView('Rat<=, 20363 ('view_from_to_is_endv['token[''Rat<=.Qid],'token[''TOTAL-ORDER.Qid],'token[ 20364 ''RAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Rat.Qid]]]), 20365 insertTermView('Float<=, 20366 ('view_from_to_is_endv['token[''Float<=.Qid],'token[''TOTAL-ORDER.Qid], 20367 'token[''FLOAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ 20368 ''Float.Qid]]]), 20369 insertTermView('String<=, 20370 ('view_from_to_is_endv['token[''String<=.Qid],'token[''TOTAL-ORDER.Qid], 20371 'token[''STRING.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ 20372 ''String.Qid]]]), 20373 insertTermView('DEFAULT, 20374 ('view_from_to_is_endv['token[''DEFAULT.Qid],'token[''TRIV.Qid],'token[ 20375 ''DEFAULT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ 20376 ''Elt.Qid]]]), 20377 insertTermView('Nat0, 20378 ('view_from_to_is_endv['token[''Nat0.Qid],'token[''DEFAULT.Qid],'token[ 20379 ''NAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Nat.Qid]]]), 20380 insertTermView('Int0, 20381 ('view_from_to_is_endv['token[''Int0.Qid],'token[''DEFAULT.Qid],'token[ 20382 ''INT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Int.Qid]]]), 20383 insertTermView('Rat0, 20384 ('view_from_to_is_endv['token[''Rat0.Qid],'token[''DEFAULT.Qid],'token[ 20385 ''RAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Rat.Qid]]]), 20386 insertTermView('Float0, 20387 ('view_from_to_is_endv['token[''Float0.Qid],'token[''DEFAULT.Qid], 20388 'token[''FLOAT.Qid],'__['sort_to_.['sortToken[''Elt.Qid],'sortToken[ 20389 ''Float.Qid]], 'op_to`term_.['bubble[''0.Qid],'bubble[''0.0.Qid]]]]), 20390 insertTermView('String0, 20391 ('view_from_to_is_endv['token[''String0.Qid],'token[''DEFAULT.Qid], 20392 'token[''STRING.Qid],'__['sort_to_.['sortToken[''Elt.Qid],'sortToken[ 20393 ''String.Qid]],'op_to`term_.['bubble[''0.Qid],'bubble[''"".Qid]]]]), 20394 insertTermView('Qid0, 20395 ('view_from_to_is_endv['token[''Qid0.Qid],'token[''DEFAULT.Qid],'token[ 20396 ''QID.Qid],'__['sort_to_.['sortToken[''Elt.Qid],'sortToken[''Qid.Qid]], 20397 'op_to`term_.['bubble[''0.Qid],'bubble['''.Qid]]]]), 20398 emptyDatabase)))))))))))))))))))))))))))))) . 20399---) 20400 20401*** We start by introducing a subsort \texttt{DatabaseClass} of sort 20402*** \texttt{Cid}, the operator declarations necessary for representing objects 20403*** in class \texttt{DatabaseClass} as defined above, and variables to range 20404*** over subclasses of class \texttt{DatabaseClass} and over attributes. 20405 20406 sort DatabaseClass . 20407 subsort DatabaseClass < Cid . 20408 op Database : -> DatabaseClass . 20409 op db :_ : Database -> Attribute . 20410 op input :_ : TermList -> Attribute . 20411 op output :_ : QidList -> Attribute . 20412 op default :_ : Header -> Attribute . 20413 20414 var Atts : AttributeSet . 20415 var X@DatabaseClass : DatabaseClass . 20416 var O : Oid . 20417 20418*** Next, we introduce an auxiliary function \texttt{parseHeader} to parse 20419*** names of user-defined modules, and a constant \texttt{nilTermList} of sort 20420*** \texttt{TermList}. Note that the name of a user-defined module must be a 20421*** single identifier (a token) or, for parameterized modules, its name---a 20422*** single identifier---and its interface. 20423 20424 op parseHeader : Term -> Qid . 20425 eq parseHeader('token[T]) = downQid(T) . 20426 ----eq parseHeader('_`(_`)['token[T], T']) = downQid(T) . 20427 eq parseHeader('_`{_`}['token[T], T']) = downQid(T) . 20428 20429 op nilTermList : -> TermList . 20430 20431*** Finally, we present the rules processing the inputs of the database. These 20432*** rules define the behavior of the system for the different commands, 20433*** modules, theories, and views entered into the system. For example, the 20434*** first rule processes the different types of modules entered to the system. 20435*** Note that the operators declared as constructors of sort \texttt{PreModule} 20436*** in the signature of Full Maude, given in 20437*** Appendix~\ref{signature-full-maude}, are declared with two arguments, 20438*** namely the name of the unit, or its name + its interface, and the list 20439*** of declarations of such a unit. 20440 20441 crl [module] : 20442 < O : X@DatabaseClass | db : DB, input : (F[T, T']), output : nil, default : ME, Atts > 20443 => < O : X@DatabaseClass | 20444 db : procModule(F[T, T'], DB), input : nilTermList, 20445 output : ('Introduced 'module header2Qid(parseHeader(T)) '\n), 20446 default : parseHeader(T), Atts > 20447 if (F == 'fmod_is_endfm) or-else 20448 ((F == 'obj_is_endo) or-else 20449 ((F == 'obj_is_jbo) or-else 20450 ((F == 'mod_is_endm) or-else 20451 (F == 'omod_is_endom)))) . 20452 20453*** Notice the message placed in the output channel, and the change in the 20454*** current module by default, which is now the new module just processed. 20455*** Since the name of the module \texttt{T} can be complex---a parameterized 20456*** module---some extra parsing has to be performed by the auxiliary function 20457*** \texttt{parseHeader}. Similar rules are given for the processing of 20458*** theories and views. 20459 20460 crl [theory] : 20461 < O : X@DatabaseClass | db : DB, input : (F[T, T']), output : nil, default : ME, Atts > 20462 => < O : X@DatabaseClass | 20463 db : procModule(F[T, T'], DB), input : nilTermList, 20464 output : ('Introduced 'theory header2Qid(parseHeader(T)) '\n), 20465 default : parseHeader(T), Atts > 20466 if (F == 'fth_is_endfth) or-else 20467 ((F == 'th_is_endth) or-else 20468 (F == 'oth_is_endoth)) . 20469 20470 rl [view] : 20471 < O : X@DatabaseClass | db : DB, 20472 input : ('view_from_to_is`endv[T, T', T'']), 20473 output : nil, default : ME, Atts > 20474 => < O : X@DatabaseClass | 20475 db : procView('view_from_to_is_endv[T, T', T'', 'none.ViewDeclSet], DB), 20476 input : nilTermList, 20477 output : ('Introduced 'view header2Qid(parseHeader(T)) '\n), 20478 default : ME, Atts > . 20479 rl [view] : 20480 < O : X@DatabaseClass | db : DB, 20481 input : ('view_from_to_is_endv[T, T', T'', T3]), 20482 output : nil, default : ME, Atts > 20483 => < O : X@DatabaseClass | 20484 db : procView('view_from_to_is_endv[T, T', T'', T3], DB), 20485 input : nilTermList, 20486 output : ('Introduced 'view header2Qid(parseHeader(T)) '\n), 20487 default : ME, Atts > . 20488 20489*** Commands are handled by rules as well. For example, the \texttt{down}, 20490*** \texttt{reduce}, and \texttt{rewrite} commands are handled by the 20491*** following rules. 20492 20493 rl [down] : 20494 < O : X@DatabaseClass | db : DB, input : ('down_:_[T, T']), output : nil, default : ME, Atts > 20495 => < O : X@DatabaseClass | 20496 db : getDatabase(procDownCommand('down_:_[T, T'], ME, DB)), 20497 input : nilTermList, 20498 output : getQidList(procDownCommand('down_:_[T, T'], ME, DB)), 20499 default : ME, Atts > . 20500 20501 crl [red/rew/frew] : 20502 < O : X@DatabaseClass | db : DB, input : (F[T]), output : QIL, default : ME, Atts > 20503 => < O : X@DatabaseClass | 20504 db : getDatabase(procCommand(F[T], ME, DB)), 20505 input : nilTermList, 20506 output : getQidList(procCommand(F[T], ME, DB)), 20507 default : ME, Atts > 20508 if (F == 'parse_.) or-else 20509 ((F == 'red_.) or-else 20510 ((F == 'reduce_.) or-else 20511 ((F == 'rew_.) or-else 20512 ((F == 'rewrite_.) or-else 20513 ((F == 'frew_.) or-else 20514 ((F == 'frewrite_.) or-else 20515 ((F == 'unify_.) or-else 20516 (F == 'id-unify_.) or-else 20517 (F == 'variant`unify_.) or-else 20518 (F == 'asymmetric`variant`unify_.) or-else 20519 (F == 'get`variants_.) 20520 ))))))) . 20521 20522 crl [search] : 20523 < O : X@DatabaseClass | db : DB, input : (F[T, T']), output : QIL, default : ME, Atts > 20524 => < O : X@DatabaseClass | 20525 db : getDatabase(procCommand(F[T, T'], ME, DB)), 20526 input : nilTermList, 20527 output : getQidList(procCommand(F[T, T'], ME, DB)), 20528 default : ME, Atts > 20529 if (F == 'search_=>_.) or-else 20530 ((F == 'search_=>1_.) or-else 20531 ((F == 'search_=>*_.) or-else 20532 ((F == 'search_=>+_.) or-else 20533 ((F == 'search_=>!_.) or-else 20534 ((F == 'search_~>_.) or-else 20535 ((F == 'search_~>1_.) or-else 20536 ((F == 'search_~>*_.) or-else 20537 ((F == 'search_~>+_.) or-else 20538 ((F == 'search_~>!_.) or-else 20539 ((F == 'match_<=?_.) or-else 20540 (F == 'xmatch_<=?_.))))))))))) . 20541 20542 rl [select] : 20543 < O : X@DatabaseClass | db : DB, input : ('select_.[T]), output : QIL, default : ME, Atts > 20544 => < O : X@DatabaseClass | db : DB, input : nilTermList, output : (QIL 'The eMetaPrettyPrint(parseModExp(T)) 'has 'been 'set 'as 'current 'module. '\n), default : parseModExp(T), Atts > . 20545 20546 rl [show-modules] : 20547 < O : X@DatabaseClass | db : DB, 20548 input : ('show`modules`..@Command@), 20549 output : nil, default : ME, Atts > 20550 => < O : X@DatabaseClass | db : DB, input : nilTermList, 20551 output : showModules(DB), default : ME, Atts > . 20552 rl [show-views] : 20553 < O : X@DatabaseClass | db : DB, 20554 input : ('show`views`..@Command@), 20555 output : nil, default : ME, Atts > 20556 => < O : X@DatabaseClass | db : DB, input : nilTermList, 20557 output : showViews(DB), default : ME, Atts > . 20558 20559*** The \texttt{show module} command, which prints the specified module, or 20560*** the current one if no module name is specified, is handled by the 20561*** following rules. 20562 20563 crl [show-module] : 20564 < O : X@DatabaseClass | db : DB, 20565 input : ('show`module`..@Command@), 20566 output : nil, default : ME, Atts > 20567 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20568 output : eMetaPrettyPrint(getFlatModule(ME', DB'), getTopModule(ME', DB')), 20569 default : ME', Atts > 20570 if < DB' ; ME' > := evalModExp(ME, DB) . 20571 crl [show-module] : 20572 < O : X@DatabaseClass | db : DB, input : ('show`module_.[T]), output : nil, default : ME, Atts > 20573 => < O : X@DatabaseClass | 20574 db : DB', input : nilTermList, 20575 output : eMetaPrettyPrint(getFlatModule(ME'', DB'), getTopModule(ME'', DB')), 20576 default : ME, Atts > 20577 if < DB' ; ME'' > := evalModExp(parseModExp(T), DB) . 20578 crl [show-module] : 20579 < O : X@DatabaseClass | db : DB, input : ('show`module_.[T]), output : nil, Atts > 20580 => < O : X@DatabaseClass | db : DB, input : nil, 20581 output : ('Error 'evaluating 'the 'given 'module 'expression.), Atts > 20582 if evalModExp(ME:[ModuleExpression], DB':[Database]) := evalModExp(parseModExp(T), DB) . 20583 20584 crl [show-all] : 20585 < O : X@DatabaseClass | db : DB, input : ('show`all`..@Command@), 20586 output : nil, default : ME, Atts > 20587 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20588 output : eMetaPrettyPrint(getFlatModule(ME', DB'), getFlatModule(ME', DB')), 20589 default : ME', Atts > 20590 if < DB' ; ME' > := evalModExp(ME, DB) . 20591 crl [show-all] : 20592 < O : X@DatabaseClass | db : DB, input : ('show`all_.[T]), output : nil, default : ME, Atts > 20593 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20594 output : eMetaPrettyPrint(getFlatModule(ME', DB'), getFlatModule(ME', DB')), 20595 default : ME, Atts > 20596 if ME'' := parseModExp(T) 20597 /\ < DB' ; ME' > := evalModExp(ME'', DB) . 20598 20599 crl [show-vars] : 20600 < O : X@DatabaseClass | db : DB, input : ('show`vars`..@Command@), 20601 output : nil, default : ME, Atts > 20602 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20603 output : eMetaPrettyPrintVars(getVars(ME', DB')), 20604 default : ME', Atts > 20605 if DB' := database(evalModExp(ME, DB)) 20606 /\ ME' := modExp(evalModExp(ME, DB)) . 20607 crl [show-vars] : 20608 < O : X@DatabaseClass | db : DB, input : ('show`vars_.[T]), 20609 output : nil, default : ME, Atts > 20610 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20611 output : eMetaPrettyPrintVars(getVars(ME', DB')), 20612 default : ME, Atts > 20613 if ME'' := parseModExp(T) 20614 /\ DB' := database(evalModExp(ME'', DB)) 20615 /\ ME' := modExp(evalModExp(ME'', DB)) . 20616 20617 crl [show-sorts] : 20618 < O : X@DatabaseClass | db : DB, input : ('show`sorts`..@Command@), output : nil, default : ME, Atts > 20619 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20620 output : eMetaPrettyPrint(getSorts(getFlatModule(ME', DB'))), 20621 default : ME', Atts > 20622 if DB' := database(evalModExp(ME, DB)) 20623 /\ ME' := modExp(evalModExp(ME, DB)) . 20624 crl [show-sorts] : 20625 < O : X@DatabaseClass | db : DB, input : ('show`sorts_.[T]), output : nil, default : ME, Atts > 20626 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20627 output : eMetaPrettyPrint(getSorts(getFlatModule(ME', DB'))), 20628 default : ME, Atts > 20629 if ME'' := parseModExp(T) 20630 /\ DB' := database(evalModExp(ME'', DB)) 20631 /\ ME' := modExp(evalModExp(ME'', DB)) . 20632 20633 crl [show-ops] : 20634 < O : X@DatabaseClass | db : DB, input : ('show`ops`..@Command@), output : nil, default : ME, Atts > 20635 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20636 output : eMetaPrettyPrint(getFlatModule(ME', DB'), getOps(getFlatModule(ME', DB'))), 20637 default : ME', Atts > 20638 if DB' := database(evalModExp(ME, DB)) 20639 /\ ME' := modExp(evalModExp(ME, DB)) . 20640 crl [show-ops] : 20641 < O : X@DatabaseClass | db : DB, input : ('show`ops_.[T]), output : nil, default : ME, Atts > 20642 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20643 output : eMetaPrettyPrint(getFlatModule(ME', DB'), getOps(getFlatModule(ME', DB'))), 20644 default : ME, Atts > 20645 if ME'' := parseModExp(T) 20646 /\ DB' := database(evalModExp(ME'', DB)) 20647 /\ ME' := modExp(evalModExp(ME'', DB)) . 20648 20649 crl [show-mbs] : 20650 < O : X@DatabaseClass | db : DB, input : ('show`mbs`..@Command@), output : nil, default : ME, Atts > 20651 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20652 output : eMetaPrettyPrint(getFlatModule(ME', DB'), getMbs(getFlatModule(ME', DB'))), 20653 default : ME', Atts > 20654 if DB' := database(evalModExp(ME, DB)) 20655 /\ ME' := modExp(evalModExp(ME, DB)) . 20656 crl [show-mbs] : 20657 < O : X@DatabaseClass | db : DB, input : ('show`mbs_.[T]), output : nil, default : ME, Atts > 20658 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20659 output : eMetaPrettyPrint(getFlatModule(ME', DB'), getMbs(getFlatModule(ME', DB'))), 20660 default : ME, Atts > 20661 if ME := parseModExp(T) 20662 /\ DB' := database(evalModExp(ME, DB)) 20663 /\ ME' := modExp(evalModExp(ME, DB)) . 20664 20665 crl [show-eqns] : 20666 < O : X@DatabaseClass | db : DB, input : ('show`eqs`..@Command@), output : nil, default : ME, Atts > 20667 => < O : X@DatabaseClass | 20668 db : DB', input : nilTermList, 20669 output : eMetaPrettyPrint(getFlatModule(ME', DB'), getEqs(getFlatModule(ME', DB'))), 20670 default : ME', Atts > 20671 if DB' := database(evalModExp(ME, DB)) 20672 /\ ME' := modExp(evalModExp(ME, DB)) . 20673 crl [show-eqns] : 20674 < O : X@DatabaseClass | db : DB, input : ('show`eqs_.[T]), output : nil, default : ME, Atts > 20675 => < O : X@DatabaseClass | 20676 db : DB', input : nilTermList, 20677 output : eMetaPrettyPrint(getFlatModule(ME', DB'), getEqs(getFlatModule(ME', DB'))), 20678 default : ME, Atts > 20679 if ME'' := parseModExp(T) 20680 /\ DB' := database(evalModExp(ME'', DB)) 20681 /\ ME' := modExp(evalModExp(ME'', DB)) . 20682 20683 crl [show-rls] : 20684 < O : X@DatabaseClass | db : DB, input : ('show`rls`..@Command@), output : nil, default : ME, Atts > 20685 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20686 output : eMetaPrettyPrint(getFlatModule(ME', DB'), getRls(getFlatModule(ME', DB'))), 20687 default : ME', Atts > 20688 if DB' := database(evalModExp(ME, DB)) 20689 /\ ME' := modExp(evalModExp(ME, DB)) . 20690 crl [show-rls] : 20691 < O : X@DatabaseClass | db : DB, input : ('show`rls_.[T]), output : nil, default : ME, Atts > 20692 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20693 output : eMetaPrettyPrint(getFlatModule(ME', DB'), getRls(getFlatModule(ME', DB'))), 20694 default : ME, Atts > 20695 if ME'' := parseModExp(T) 20696 /\ DB' := database(evalModExp(ME'', DB)) 20697 /\ ME' := modExp(evalModExp(ME'', DB)) . 20698 20699 crl [show-view] : 20700 < O : X@DatabaseClass | db : DB, input : ('show`view_.[T]), output : nil, default : ME, Atts > 20701 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20702 output : eMetaPrettyPrint(DB', getView(parseViewExp(T), DB')), 20703 default : ME, Atts > 20704 if DB' := evalViewExp(parseViewExp(T), nil, DB) . 20705 20706 crl [set`protect_on] : 20707 < O : X@DatabaseClass | 20708 db : DB, 20709 input : ('set`protect_on`.[T]), 20710 output : QIL', 20711 default : ME, Atts > 20712 => < O : X@DatabaseClass | 20713 db : db(MIS, MNS, VIS, VES, 20714 MNS' ME', MNS'', MNS3, QIL), 20715 input : nilTermList, 20716 output : (QIL' 'set 'protect header2QidList(ME') 'on '\n), 20717 default : ME, Atts > 20718 if ME' := parseModExp(T) 20719 /\ unitInDb(ME', DB) 20720 /\ db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL) := DB . 20721 crl [set`protect_off] : 20722 < O : X@DatabaseClass | 20723 db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL), 20724 input : ('set`protect_off`.[T]), 20725 output : QIL', 20726 default : ME, Atts > 20727 => < O : X@DatabaseClass | 20728 db : db(MIS, MNS, VIS, VES, remove(MNS', ME'), MNS'', MNS3, QIL), 20729 input : nilTermList, 20730 output : (QIL' 'set 'protect header2QidList(ME') 'off '\n), 20731 default : ME, Atts > 20732 if ME' := parseModExp(T) . 20733 20734 crl [set`extend_on] : 20735 < O : X@DatabaseClass | 20736 db : DB, 20737 input : ('set`extend_on`.[T]), 20738 output : QIL', 20739 default : ME, Atts > 20740 => < O : X@DatabaseClass | 20741 db : db(MIS, MNS, VIS, VES, 20742 MNS', MNS'' ME', MNS3, QIL), 20743 input : nilTermList, 20744 output : (QIL' 'set 'extend header2QidList(ME') 'on '\n), 20745 default : ME, Atts > 20746 if ME' := parseModExp(T) 20747 /\ unitInDb(ME', DB) 20748 /\ db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL) := DB . 20749 crl [set`extend_off] : 20750 < O : X@DatabaseClass | 20751 db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL), 20752 input : ('set`extend_off`.[T]), 20753 output : QIL', 20754 default : ME, Atts > 20755 => < O : X@DatabaseClass | 20756 db : db(MIS, MNS, VIS, VES, MNS', remove(MNS'', ME'), MNS3, QIL), 20757 input : nilTermList, 20758 output : (QIL' 'set 'extend header2QidList(ME') 'off '\n), 20759 default : ME, Atts > 20760 if ME' := parseModExp(T) . 20761 20762 crl [set`include_on] : 20763 < O : X@DatabaseClass | 20764 db : DB, 20765 input : ('set`include_on`.[T]), 20766 output : QIL', 20767 default : ME, Atts > 20768 => < O : X@DatabaseClass | 20769 db : db(MIS, MNS, VIS, VES, 20770 MNS', MNS'', MNS3 . ME', QIL), 20771 input : nilTermList, 20772 output : (QIL' 'set 'include header2QidList(ME') 'on '\n), 20773 default : ME, Atts > 20774 if ME' := parseModExp(T) 20775 ----/\ unitInDb(ME', DB) 20776 /\ db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL) := DB . 20777 crl [set`include_off] : 20778 < O : X@DatabaseClass | 20779 db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL), 20780 input : ('set`include_off`.[T]), 20781 output : QIL', 20782 default : ME, Atts > 20783 => < O : X@DatabaseClass | 20784 db : db(MIS, MNS, VIS, VES, MNS', MNS'', remove(MNS3, ME'), QIL), 20785 input : nilTermList, 20786 output : (QIL' 'set 'include header2QidList(ME') 'off '\n), 20787 default : ME, Atts > 20788 if ME' := parseModExp(T) . 20789 20790 crl [load] : 20791 < O : X@DatabaseClass | 20792 db : DB, 20793 input : ('load_.[T]), 20794 output : QIL', 20795 default : ME, Atts > 20796 => < O : X@DatabaseClass | 20797 db : getDatabase(procLoad(T, ME, DB)), 20798 input : nilTermList, 20799 output : getQidList(procLoad(T, ME, DB)), 20800 default : ME, Atts > 20801 if ME' := parseModExp(T) . 20802 20803 eq 'rm`ids`..@Command@ = 'remove`identity`attributes`..@Command@ . 20804 eq 'rm`ids_.[T] = 'remove`identity`attributes_.[T] . 20805 20806 crl [remove-id-attributes] : 20807 < O : X@DatabaseClass | db : DB, 20808 input : ('remove`identity`attributes`..@Command@), 20809 output : nil, default : ME, Atts > 20810 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20811 output : (eMetaPrettyPrint(getFlatModule(ME', DB'), removeIds(getFlatModule(ME', DB'), all))), 20812 default : ME', Atts > 20813 if < DB' ; ME' > := evalModExp(ME, DB) . 20814 crl [remove-id-attributes] : 20815 < O : X@DatabaseClass | db : DB, input : ('remove`identity`attributes_.[T]), output : nil, default : ME, Atts > 20816 => < O : X@DatabaseClass | 20817 db : DB', input : nilTermList, 20818 output : (eMetaPrettyPrint(getFlatModule(ME'', DB'), removeIds(axCohComplete(getFlatModule(ME'', DB')), all))), 20819 default : ME, Atts > 20820 if < DB' ; ME'' > := evalModExp(parseModExp(T), DB) . 20821 20822 eq 'rm`nh`ids`..@Command@ = 'remove`non-handled`identity`attributes`..@Command@ . 20823 eq 'rm`nh`ids_.[T] = 'remove`non-handled`identity`attributes_.[T] . 20824 20825 crl [remove-id-attributes] : 20826 < O : X@DatabaseClass | db : DB, 20827 input : ('remove`non-handled`identity`attributes`..@Command@), 20828 output : nil, default : ME, Atts > 20829 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20830 output : (eMetaPrettyPrint(getFlatModule(ME', DB'), removeIds(getFlatModule(ME', DB'), non-handled))), 20831 default : ME', Atts > 20832 if < DB' ; ME' > := evalModExp(ME, DB) . 20833 crl [remove-id-attributes] : 20834 < O : X@DatabaseClass | db : DB, input : ('remove`non-handled`identity`attributes_.[T]), output : nil, default : ME, Atts > 20835 => < O : X@DatabaseClass | 20836 db : DB', input : nilTermList, 20837 output : (eMetaPrettyPrint(getFlatModule(ME'', DB'), removeIds(getFlatModule(ME'', DB'), non-handled))), 20838 default : ME, Atts > 20839 if < DB' ; ME'' > := evalModExp(parseModExp(T), DB) . 20840 20841 crl [remove-assoc-attributes] : 20842 < O : X@DatabaseClass | db : DB, 20843 input : ('remove`assoc`attributes`..@Command@), 20844 output : nil, default : ME, Atts > 20845 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20846 output : (eMetaPrettyPrint(getFlatModule(ME', DB'), removeLonelyAssocs(getFlatModule(ME', DB')))), 20847 default : ME', Atts > 20848 if < DB' ; ME' > := evalModExp(ME, DB) . 20849 crl [remove-assoc-attributes] : 20850 < O : X@DatabaseClass | db : DB, input : ('remove`assoc`attributes_.[T]), output : nil, default : ME, Atts > 20851 => < O : X@DatabaseClass | 20852 db : DB', input : nilTermList, 20853 output : (eMetaPrettyPrint(getFlatModule(ME'', DB'), removeLonelyAssocs(getFlatModule(ME'', DB')))), 20854 default : ME, Atts > 20855 if < DB' ; ME'' > := evalModExp(parseModExp(T), DB) . 20856 20857 crl [acu-coherence-completion] : 20858 < O : X@DatabaseClass | db : DB, 20859 input : ('ax`coherence`completion`..@Command@), 20860 output : nil, default : ME, Atts > 20861 => < O : X@DatabaseClass | db : DB', input : nilTermList, 20862 output : (eMetaPrettyPrint(getFlatModule(ME', DB'), axCohComplete(getFlatModule(ME', DB')))), 20863 default : ME', Atts > 20864 if < DB' ; ME' > := evalModExp(ME, DB) . 20865 crl [acu-coherence-completion] : 20866 < O : X@DatabaseClass | db : DB, input : ('ax`coherence`completion_.[T]), output : nil, default : ME, Atts > 20867 => < O : X@DatabaseClass | 20868 db : DB', input : nilTermList, 20869 output : (eMetaPrettyPrint(getFlatModule(ME'', DB'), axCohComplete(getFlatModule(ME'', DB')))), 20870 default : ME, Atts > 20871 if < DB' ; ME'' > := evalModExp(parseModExp(T), DB) . 20872 20873 rl [error] : 20874 < O : X@DatabaseClass | 20875 db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, NQIL), 20876 input : TL, output : nil, default : ME, Atts > 20877 => < O : X@DatabaseClass | 20878 db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, nil), 20879 input : TL, output : NQIL, default : ME, Atts > . 20880 20881 *** Auxiliary Functions 20882 20883 op showViews : Database -> QidList . 20884 op showModules : Database -> QidList . 20885 20886 eq showViews(db(MIS, MNS, VIS, (VE # VES), MNS', MNS'', MNS3, QIL)) 20887 = (eMetaPrettyPrint(VE) '\n 20888 showViews(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))) . 20889 eq showViews( 20890 db(MIS, MNS, VIS, emptyViewExpSet, MNS', MNS'', MNS3, QIL)) 20891 = nil . 20892 20893 eq showModules( 20894 db(MIS, (MN . MNS), VIS, VES, MNS', MNS'', MNS3, QIL)) 20895 = (eMetaPrettyPrint(MN) '\n 20896 showModules(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))) . 20897 eq showModules( 20898 db(MIS, emptyModuleNameSet, VIS, VES, MNS', MNS'', MNS3, QIL)) 20899 = nil . 20900 20901 rl [help] : 20902 < O : X@DatabaseClass | input : ('help`..@Command@), output : QIL, Atts > 20903 => < O : X@DatabaseClass | input : nilTermList, output : fm-help, Atts > . 20904endm 20905 20906******************************************************************************* 20907fmod TEXT-STYLE is 20908--- pr META-LEVEL + PRE-VARIANT . 20909 pr META-LEVEL . 20910 20911 var QL : QidList . 20912 20913 op green : QidList -> QidList . 20914 eq green(QL) = '\g QL '\o . 20915 20916 op yellow : QidList -> QidList . 20917 eq yellow(QL) = '\y QL '\o . 20918 20919 op red : QidList -> QidList . 20920 eq red(QL) = '\r QL '\o . 20921 20922 op bold : QidList -> QidList . 20923 eq bold(QL) = '\! QL '\o . 20924endfm 20925 20926******************************************************************************* 20927 20928*** 20929*** The Full Maude Module 20930*** 20931 20932*** We now give the rules to initialize the loop, and to specify the 20933*** communication between the loop---the input/output of the system---and the 20934*** database. Depending on the kind of input that the database receives, its 20935*** state will be changed, or some output will be generated. 20936 20937fmod MOD-EXPRS is 20938 pr FM-MOD-EXPRS . 20939endfm 20940 20941mod FULL-MAUDE is 20942 pr META-FULL-MAUDE-SIGN . 20943 pr DATABASE-HANDLING . 20944 inc LOOP-MODE . 20945 pr BANNER . 20946 20947*** The state of the persistent system, which is supported by the built-in 20948*** module \texttt{LOOP-MODE}, described in Section~\ref{loop}, is represented 20949*** as a single object. 20950 20951 subsort Object < State . 20952 20953 op o : -> Oid . 20954 op init : -> System . 20955 20956 var Atts : AttributeSet . 20957 var X@DatabaseClass : DatabaseClass . 20958 var O : Oid . 20959 var DB : Database . 20960 var ME : Header . 20961 var QI : Qid . 20962 vars QIL QIL' QIL'' : QidList . 20963 var TL : TermList . 20964 var N : Nat . 20965 vars RP RP' : ResultPair . 20966 20967 rl [init] : 20968 init 20969 => [nil, 20970 < o : Database | 20971 db : initialDatabase, 20972 input : nilTermList, output : nil, 20973 default : 'CONVERSION >, 20974 ('\n '\t '\s '\s '\s '\s string2qidList(banner) '\n)] . 20975 20976*** When some text has been introduced in the loop, the first argument of the 20977*** operator \verb~[_,_,_,]~ is different from \texttt{nil}, and we can use 20978*** this fact to activate the following rule, that enters an input such as a 20979*** module or a command from the user into the database. The constant 20980*** \texttt{GRAMMAR} names the module containing the signature defining the 20981*** top level syntax of Full Maude (see Section~\ref{sec:signature} and 20982*** Appendix~\ref{signature-full-maude}). This signature is used by the 20983*** \texttt{metaParse} function to parse the input. PD the input is 20984*** syntactically valid\footnote{Of course, the input may be syntactically 20985*** valid, but not semantically valid, since further processing---for example, 20986*** of bubbles---may reveal a semantic inconsistency.}, the parsed input is 20987*** placed in the \texttt{input} attribute of the database object; otherwise, 20988*** an error message is placed in the output channel of the loop. 20989 20990 rl [in] : 20991 [QI QIL, 20992 < O : X@DatabaseClass | 20993 db : DB, input : nilTermList, output : nil, default : ME, Atts >, 20994 QIL'] 20995 => if metaParse(GRAMMAR, QI QIL, '@Input@) :: ResultPair 20996 then [nil, 20997 < O : X@DatabaseClass | db : DB, 20998 input : getTerm(metaParse(GRAMMAR, QI QIL, '@Input@)), 20999 output : nil, default : ME, Atts >, 21000 QIL'] 21001 else [nil, 21002 < O : X@DatabaseClass | db : DB, input : nilTermList, 21003 output : ('\r 'Warning: 21004 printSyntaxError(metaParse(GRAMMAR, QI QIL, '@Input@), 21005 QI QIL) 21006 '\n 21007 '\r 'Error: '\o 'No 'parse 'for 'input. '\n), 21008 default : ME, Atts >, 21009 QIL'] 21010 fi . 21011 21012*** When the \texttt{output} attribute of the persistent object contains a 21013*** nonempty list of quoted identifiers, the \texttt{out} rule moves it to the 21014*** third argument of the loop. Then the Core Maude system displays it in the 21015*** terminal. 21016 21017 rl [out] : 21018 [QIL, 21019 < O : X@DatabaseClass | 21020 db : DB, input : TL, output : (QI QIL'), default : ME, Atts >, 21021 QIL''] 21022 => [QIL, 21023 < O : X@DatabaseClass | 21024 db : DB, input : TL, output : nil, default : ME, Atts >, 21025 (QI QIL' QIL'')] . 21026endm 21027 21028******************************************************************************* 21029 21030loop init . 21031 21032--- trace exclude FULL-MAUDE . 21033 21034---- set show loop stats on . 21035---- set show loop timing on . 21036set show advisories on . 21037 21038