----                                                     To be run on Maude 2.4
----                                                    author: Francisco Duran
----                           printSyntaxError functionality by Peter Olveczky
----                                       narrowing search by Santiago Escobar

fmod BANNER is 
  pr STRING .
  op banner : -> String .
  eq banner = "Full Maude 2.4i April 2nd 2009" .
endfm

***(
    This file is part of the Maude 2 interpreter.

    Copyright 1997-2003 SRI International, Menlo Park, CA 94025, USA.

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 inclof the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNSS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public Leicense
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
)

---- to do:
---- - continue .
---- - show search path .
---- - show path labels <number> .
---- - show components .

---- Main changes and bugs fixed since last release:
----
---- - March 9th, 2009
----   Bug in the search command. The number of solutions argument was used as depth bound. Reported by P. Olveczky.
----   New (show variants .) / (show variants <Module> .) command. Shows the module 
----   with the variants of its rules instead of its rules. 
---- - March 9th, 2009
----   Bug in the handling of mbs/cmbs. Sorts in bubbles were not handled correctly. Reported by T. Serbanuta.
---- - February 12th, 2009
----   The summation module expression now generates a module 
----      fmod A + B + C is
----        inc A .
----        inc B .
----        inc C .
----      endfm
----   for a module expression A + B + C.
---- - February 6th, 2009
----   Fixed a bug in the id-unify command. Fixed by Santiago Escobar
---- - February 3rd, 2009
----   Missing equation for downAttr, for the case of nonexec
----   Missing declaration in the CONFIGURATION+ module to handle class declarations with no attributes 
---- - January 29th, 2009
----   The downModule operation has been extended to be able to handle oo metamodules. 
----   Note that omod metamodules are defined in the UNIT Full Maude module. Therefore,
----   to be able to do things like 
----      (load omod ... endm .)
----   the current module must be the FM UNIT module or one extending it.  
---- - January 28th, 2009
----   A bug in downAttr. Found thanks to a problem with metamodule load. Reported by Peter Olveczky.
---- - January 8th, 2009
----   A bug in the narrowing functionality. It was narrowing on frozen positions. 
----   (fixed by Santiago Escobar)
---- - December 20th, 2008
----   Fixed a bug in the handling of the such-that part of search commands. 
----   Reported by Enrique Mart’n. 
---- - December 17th, 2008
----   A new search_~>_ family of commands (as for search_=>_) is now available. 
----   The commands are implemented by Santiago Escobar. 
---- - December 8th, 2008
----   A new meta-module load command is available. 
----   It enters a metamodule into Full Maude's database of modules. 
----   Asked by Peter Olveczky and Jose Meseguer.
----   The syntax for the new command is (load <meta-module> .), where <meta-module is any term of sort 
----   Module, either a term of the form fmod...endfm or any other expression reducing to a module. 
----   Thus, you can write things like 
----   
----   (select META-LEVEL .)
----   
----   (load fmod 'FOO is
----           including 'BOOL .
----           sorts 'Foo .
----           none
----           op 'f : nil -> 'Foo [none] .
----           op 'g : nil -> 'Foo [none] .
----           none
----           eq 'f.Foo = 'g.Foo [none] .
----         endfm .)
----   
----   or
----   
----   (load upModule('NAT, true) .)
----   
---- - September 18th, 2008
----   The search command now supports its complete generality (maximum depth couln't be given). Bug reported by Zhang Min.
----   The unify command is now supported.
----   Bug in the renaming of partial operations fixed. Reported by Edu Rivera.
---- - April 2nd, 2008
----   Bug in the application of views (and renamings) with kinds in the specification 
----   of op renamings. It appears in an example in which the sort was coming from a theory. 
----   Reported by A. Boronat.
---- - March 24th, 2008
----   Bug in the application of renamings to op hooks. Reported by A. Boronat
---- - March 17th, 2008
----   Bug in the instantiation of parameterized sorts in sort memberships.
----   Reported by A. Boronat
---- - March 14th, 2008
----   Bug in the handling of parameterized module expressions. When the parameterers
----   are not right, the system hangs. Reported by A. Verdejo.
---- - March 9th, 2008
----   Statement attributes of membership axioms were not correctly handled.
----   Reported by A. Riesco & A. Verdejo
---- - Feb 18th, 2008
----   Bug in the renaming of operators
---- - Feb 14th, 2008
----   Statement attributes of membership axioms were not correctly handled.
----   Reported by A. Riesco & A. Verdejo
---- - Dec 17th, 2007
----   Rule in CONFIGURATION+ was causing non-termination
---- - Dec 13th, 2007
----   Change in the specification of the transform function to allow new types of modules
---- - Nov 23rd, 2007
----   Bug in the evaluation of expressions in commands (red in FOO + BAR : ...)
---- - Oct 5th, 2007
----   Bug in down of modules (reported by Pedro Ojeda) 
---- - July 31st, 2007
----   bug in the application of maps to terms
---- - July 31st, 2007
----   bug in getThClasses
----   (reported by Marisol)
---- - (october 17th, 2006)
----   Changes in Alpha88a's prelude are now correctly handled
---- - (july 22nd, 2006) 
----   Bug in the meta-pretty-print of types.
---- - (july 21st, 2006) 
----   Object-oriented messages where not given the attribute msg 
----   (from a comment by Peter).
---- - (reported by Radestock) 
----   getSort was not handling parameterized sorts appropriately. 
---- - the set protect/extend/include off commands didn't work if the
----   module not importing was not among the imported ones
----
---- Last changes:
----
---- - May 21st, 2007
----   GRAMMAR now extends a module BUBBLES with all bubble delcarations. 
----   This BUBBLES module is also used to define the GRAMMAR-RED, GRAMMAR-REW, ...
----   modules.
----
---- - May 19th, 2007
----   procCommand changed. It now returns a Tuple{Database, QidList} instead of 
----   just a QidList. Since some modules may need to be compiled for the 
----   execution of a command, the resulting database is returned and used as 
----   new database.
----
---- - May 19th, 2007
----   proRew takes now one argument less. The Bound (4th arg.) was unnecessary. 
----
---- - BOOL is included, instead of protected, into any entered module.
----
---- - A new module expression POWER[n] is now available. A module expression 
----   POWER[n]{Nat} produces a module
----   
----    fmod POWER[n]{X :: TRIV} is
----      inc TUPLE[n]{X, X, ..., X} .
----    endfm
----    
----   which is then instantiated by the Nat view.

---- - (July 18th, 2006) 
----   The summation module expression now generates a module
----   that includes (instead of protect) its summands.
----
---- - All sorts declared in modules used for parsing have been renamed. 
----   Any sort S in one of these modules is nos called @S@. 
----   Since some of these modules where added to the user defined modules 
----   for dealing with ups, conditions, etc., he was getting error when 
----   using sorts like Token or OpDecl in his specs. 
----
---- - Syntax for parameterization has been changed (again) !!! : 
----     - module definition: FOO{X :: TRIV, Y :: TRIV}
----     - module instantiation: FOO{Bar,Baz}
----     - parameterized sorts: Foo{Bar,Baz}
----
---- - Any module loaded in Core Maude can be used in Full Maude. 
----   This may be particularly useful in the case of using the model checker. 
----
----   (mod CHECK-RESP is
----      protecting MODEL-CHECKER .
----      ...
----    endm)
----   
----   (red p(0) |= (<> Qstate) .)
----
---- - Module renaming and summation consistent with Core Maude's. Built-ins
----   are now handled at the metalevel, instead of leaving the inclusions to 
----   Core Maude. In this way, they can be renamed and redefined, as in 
----   Core Maude. This makes Full Maude slower.
----
---- - The lazy evaluation of modules is working. When a module is redefined 
----   its dependent modules are removed only if generated internally. Those 
----   introduced by the user save their term representation, from which the
----   whole processing can take place. They will be recompiled by need.
----
---- - The form of qualifying sorts coming from the parameters in 
----   parameterized modules has changed AGAIN: The sort Elt coming from 
----   X :: TRIV is now written as X$Elt (Note that sort names cannot contain
----   dots anymore). 
----
---- - Tuples are built with the syntax 
----     TUPLE[size]{comma_separated_list_of_views}
----   For example, given a view Nat from TRIV to NAT we can define pairs of 
----   nats with TUPLE[2]{Nat, Nat}.
----
---- - The model-checker is loaded before the full maude modules, so that 
----   it can be used. 
----
---- - Object-oriented modules include a module CONFIGURATION+, which 
----   imports CONFIGURATION, defines a function
----     op class : Object -> Cid .
----   returning the actual class of the given object, and add syntax
----   for objects with no attributes <_:_| >. Classes without attributes
----   are defined with syntax class CLASS-NAME .
----
---- Things to come:
----
---- - Commands missing: continue ...
----
---- - On parameterized theories and views: linked parameters, composed and 
----   lifted views, and default views.
----
---- - ops names in op declarations
----
---- known bugs:
----
---- - error messages could be given in down commands
----
---- - Check: perhaps we need to convert constants back into vbles in 
----   procViewAux
----
---- - Parameterized sorts don't work in sort constraints (nor by themselves,
----   nor in the conditions of axioms. They are accepted in their equivalent
----   single token form but do not get instantiated
----     cmb (A, B) S : PFun(X, Y) if not(A in dom(S)) /\ S : PFun`(X`,Y`) .
----

----load model-checker.maude

mod CONFIGURATION+ is
  including CONFIGURATION .
  op <_:_|`> : Oid Cid -> Object .
  op class : Object -> Cid .
  ---- eq < O:Oid : C:Cid | > = < O:Oid : C:Cid | none > .
  eq class(< O:Oid : C:Cid | A:AttributeSet >) = C:Cid .
endm

-------------------------------------------------------------------------------
*******************************************************************************
***
*** 2 The Signature of Full Maude
***
*******************************************************************************
-------------------------------------------------------------------------------

fmod EXTENDED-SORTS is
  ---- Any modification in this module must be reflected in the metamodule 
  ---- used in eq addInfoConds in module UNIT-BUBBLE-PARSING
  sorts @SortToken@ @ViewToken@ @Sort@ @Kind@ @Type@ @SortList@  
        @TypeList@ @ViewExp@ @ModExp@ .
        
  subsorts @SortToken@ < @Sort@ < @SortList@ < @TypeList@ .
  subsorts @Sort@ @Kind@ < @Type@ < @TypeList@ .
  subsort @ViewToken@ < @ViewExp@ .

  op _`{_`} : @Sort@ @ViewExp@ -> @Sort@ [prec 40] .
  op __ : @SortList@ @SortList@ -> @SortList@ [assoc] .
  op __ : @TypeList@ @TypeList@ -> @TypeList@ [assoc] .
  op `[_`] : @Sort@ -> @Kind@ .

  op _`,_ : @ViewExp@ @ViewExp@ -> @ViewExp@ [assoc] .
  op _`{_`} : @ViewExp@ @ViewExp@ -> @ViewExp@ [prec 40] .
endfm

-------------------------------------------------------------------------------
******************************************************************************
-------------------------------------------------------------------------------

fmod OPERATOR-ATTRIBUTES is
  sorts @Attr@ @AttrList@ @Hook@ @HookList@ @Bubble@ @Token@ @NeTokenList@ .
  subsort @Attr@ < @AttrList@ .
  subsort @Hook@ < @HookList@ .

  op __ : @AttrList@ @AttrList@ -> @AttrList@ [assoc] .
  ops assoc associative : -> @Attr@ .
  ops comm commutative : -> @Attr@ .
  ops idem idempotent : -> @Attr@ .
  ops id:_ identity:_ : @Bubble@ -> @Attr@ .
  ops left`id:_ left`identity:_ : @Bubble@ -> @Attr@ .
  ops right`id:_ right`identity:_ : @Bubble@ -> @Attr@ .
  ops frozen`(_`) poly`(_`) strat`(_`) strategy`(_`) : 
        @NeTokenList@ -> @AttrList@ .
  ops memo memoization : -> @Attr@ .
  ops prec_ precedence_ : @Token@ -> @Attr@ .
  ops gather`(_`) gathering`(_`) : @NeTokenList@ -> @Attr@ .
  ops format`(_`) : @NeTokenList@ -> @Attr@ .
  ops ctor constructor : -> @Attr@ .
  ops frozen ditto iter : -> @Attr@ .
  ops object msg message config : -> @Attr@ .

  op special`(_`) : @HookList@ -> @Attr@ .
  op __ : @HookList@ @HookList@ -> @HookList@ [assoc] .
  op id-hook_ : @Token@ -> @Hook@ .
  op id-hook_`(_`) : @Token@ @NeTokenList@ -> @Hook@ .
  op op-hook_`(_:_->_`) : @Token@ @Token@ @NeTokenList@ @Token@ -> @Hook@ .
  op op-hook_`(_:`->_`) : @Token@ @Token@ @Token@ -> @Hook@ .
  op op-hook_`(_:_~>_`) : @Token@ @Token@ @NeTokenList@ @Token@ -> @Hook@ .
  op op-hook_`(_:`~>_`) : @Token@ @Token@ @Token@ -> @Hook@ .
  op term-hook_`(_`) : @Token@ @Bubble@ -> @Hook@ .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod MOD-EXPRS is
  including OPERATOR-ATTRIBUTES .
  including EXTENDED-SORTS .

  sorts @Map@ @MapList@ .
  subsort @Map@ < @MapList@ .
  subsorts @Token@ < @ModExp@ .

  *** module expression
  op _*`(_`) : @ModExp@ @MapList@ -> @ModExp@ .
  op _`{_`} : @ModExp@ @ViewExp@ -> @ModExp@ .
  op TUPLE`[_`] : @Token@ -> @ModExp@ .
  op POWER`[_`] : @Token@ -> @ModExp@ .
  op _+_ : @ModExp@ @ModExp@ -> @ModExp@ [assoc prec 42] .

  *** renaming maps
  op op_to_ : @Token@ @Token@ -> @Map@ .
  op op_:_->_to_ : @Token@ @TypeList@ @Type@ @Token@ -> @Map@ .
  op op_: ->_to_ : @Token@ @Type@ @Token@ -> @Map@ .
  op op_:_~>_to_ : @Token@ @TypeList@ @Type@ @Token@ -> @Map@ .
  op op_: ~>_to_ : @Token@ @Type@ @Token@ -> @Map@ .
  op op_to_`[_`] : @Token@ @Token@ @AttrList@ -> @Map@ .
  op op_:_->_to_`[_`] : @Token@ @TypeList@ @Type@ @Token@ @AttrList@ -> @Map@ .
  op op_:`->_to_`[_`] : @Token@ @Type@ @Token@ @AttrList@ -> @Map@ .
  op op_:_~>_to_`[_`] : @Token@ @TypeList@ @Type@ @Token@ @AttrList@ -> @Map@ .
  op op_:`~>_to_`[_`] : @Token@ @Type@ @Token@ @AttrList@ -> @Map@ .
  op sort_to_ : @Sort@ @Sort@ -> @Map@ .
  op label_to_ : @Token@ @Token@ -> @Map@ .
  op class_to_ : @Sort@ @Sort@ -> @Map@ .
  op attr_._to_ : @Sort@ @Token@ @Token@ -> @Map@ .
  op msg_to_ : @Token@ @Token@ -> @Map@ .
  op msg_:_->_to_ : @Token@ @TypeList@ @Type@ @Token@ -> @Map@ .
  op msg_:`->_to_ : @Token@ @Type@ @Token@ -> @Map@ .

  op _`,_ : @MapList@ @MapList@ -> @MapList@ [assoc prec 42] .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod SIGNATURES is
  inc MOD-EXPRS .

  sorts @SortDecl@ @SubsortRel@ @SubsortDecl@ @OpDecl@ .

  op `(_`) : @Token@ -> @Token@ .

  *** sort declaration
  op sorts_. : @SortList@ -> @SortDecl@ .
  op sort_. : @SortList@ -> @SortDecl@ .

  *** subsort declaration
  op subsort_. : @SubsortRel@ -> @SubsortDecl@ .
  op subsorts_. : @SubsortRel@ -> @SubsortDecl@ .
  op _<_ : @SortList@ @SortList@ -> @SubsortRel@ .
  op _<_ : @SortList@ @SubsortRel@ -> @SubsortRel@ .

  *** operator declaration
  op op_:`->_. : @Token@ @Type@ -> @OpDecl@ .
  op op_:`->_`[_`]. : @Token@ @Type@ @AttrList@ -> @OpDecl@ .
  op op_:_->_. : @Token@ @TypeList@ @Type@ -> @OpDecl@ .
  op op_:_->_`[_`]. : @Token@ @TypeList@ @Type@ @AttrList@ -> @OpDecl@ .
  op ops_:`->_. : @NeTokenList@ @Type@ -> @OpDecl@ .
  op ops_:`->_`[_`]. : @NeTokenList@ @Type@ @AttrList@ -> @OpDecl@ .
  op ops_:_->_. : @NeTokenList@ @TypeList@ @Type@ -> @OpDecl@ .
  op ops_:_->_`[_`]. : @NeTokenList@ @TypeList@ @Type@ @AttrList@ -> @OpDecl@ .

  op op_:`~>_. : @Token@ @Sort@ -> @OpDecl@ .
  op op_:`~>_`[_`]. : @Token@ @Sort@ @AttrList@ -> @OpDecl@ .
  op op_:_~>_. : @Token@ @TypeList@ @Sort@ -> @OpDecl@ .
  op op_:_~>_`[_`]. : @Token@ @TypeList@ @Sort@ @AttrList@ -> @OpDecl@ .
  op ops_:`~>_. : @NeTokenList@ @Sort@ -> @OpDecl@ .
  op ops_:`~>_`[_`]. : @NeTokenList@ @Sort@ @AttrList@ -> @OpDecl@ .
  op ops_:_~>_. : @NeTokenList@ @TypeList@ @Sort@ -> @OpDecl@ .
  op ops_:_~>_`[_`]. : @NeTokenList@ @TypeList@ @Sort@ @AttrList@ -> @OpDecl@ .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod F&S-MODS&THS is
  including SIGNATURES .
  including QID-LIST .

  sorts @FDeclList@ @SDeclList@ @Module@ @ImportDecl@ @Parameter@ 
        @List<Parameter>@ @EqDecl@ @RlDecl@ @MbDecl@ @VarDecl@ @VarDeclList@ .

  subsort @VarDecl@ < @VarDeclList@ .
  subsorts @VarDecl@ @ImportDecl@ @SortDecl@ @SubsortDecl@ @OpDecl@ @MbDecl@  
           @EqDecl@ @VarDeclList@ < @FDeclList@ .
  subsorts @RlDecl@ @FDeclList@ < @SDeclList@ .

  *** variable declaration
  op vars_:_. : @NeTokenList@ @Type@ -> @VarDecl@ .
  op var_:_. : @NeTokenList@ @Type@ -> @VarDecl@ .
  
  *** membership axiom declaration
  op mb_:_. : @Bubble@ @Bubble@ -> @MbDecl@ .
  ----op mb[_]:_:_. : @Token@ @Bubble@ @Bubble@ -> @MbDecl@ .
  op cmb_:_if_. : @Bubble@ @Sort@ @Bubble@ -> @MbDecl@ . 
  op cmb[_]:_:_if_. : @Token@ @Bubble@ @Sort@ @Bubble@ -> @MbDecl@ . 

  *** equation declaration
  op eq_=_. : @Bubble@ @Bubble@ -> @EqDecl@ .
  op ceq_=_if_. : @Bubble@ @Bubble@ @Bubble@ -> @EqDecl@ .
  op cq_=_if_. : @Bubble@ @Bubble@ @Bubble@ -> @EqDecl@ .

  *** rule declaration
  *** op rl`[_`]:_=>_. : @Token@ @Bubble@ @Bubble@ -> @RlDecl@ .
  op rl_=>_. : @Bubble@ @Bubble@ -> @RlDecl@ .
  *** op crl`[_`]:_=>_if_. : @Token@ @Bubble@ @Bubble@ @Bubble@ -> @RlDecl@ .  
  op crl_=>_if_. : @Bubble@ @Bubble@ @Bubble@ -> @RlDecl@ .  

  *** importation declaration
  ops including_. inc_. : @ModExp@ -> @ImportDecl@ .
  ops extending_. ex_. : @ModExp@ -> @ImportDecl@ .
  ops protecting_. pr_. : @ModExp@ -> @ImportDecl@ .

  sorts @Interface@ .
  subsort @Parameter@ < @List<Parameter>@ .
  subsorts @Token@ < @Interface@ .

  *** parameterized module interface
  op _::_ : @Token@ @ModExp@ -> @Parameter@ [prec 40 gather (e &)] .
  op _::_ : @Token@ @Interface@ -> @Parameter@ [prec 40 gather (e &)] .

  op _`,_ : @List<Parameter>@ @List<Parameter>@ -> @List<Parameter>@ [assoc] .

  op _`{_`} : @ModExp@ @List<Parameter>@ -> @Interface@ .

  *** declaration list
  op __ : @VarDeclList@ @VarDeclList@ -> @VarDeclList@ [assoc] .
  op __ : @SDeclList@ @SDeclList@ -> @SDeclList@ [assoc] .
  op __ : @FDeclList@ @FDeclList@ -> @FDeclList@ [assoc] .

  *** functional and system module and theory
  op fmod_is_endfm : @Interface@ @FDeclList@ -> @Module@ .
  op obj_is_jbo : @Interface@ @FDeclList@ -> @Module@ .
  op obj_is_endo : @Interface@ @FDeclList@ -> @Module@ .
  op mod_is_endm : @Interface@ @SDeclList@ -> @Module@ .
  op fth_is_endfth : @Interface@ @FDeclList@ -> @Module@ .
  op th_is_endth : @Interface@ @SDeclList@ -> @Module@ .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod O-MODS&THS is
  including F&S-MODS&THS .

  sorts @ClassDecl@ @AttrDecl@ @AttrDeclList@ @SubclassDecl@ @MsgDecl@
        @ODeclList@ .
  subsorts @SDeclList@ @MsgDecl@ @SubclassDecl@ @ClassDecl@ < @ODeclList@ .
  subsort @AttrDecl@ < @AttrDeclList@ .

  op __ : @ODeclList@ @ODeclList@ -> @ODeclList@ [assoc] .

  *** object-oriented module and theory
  op omod_is_endom : @Interface@ @ODeclList@ -> @Module@ .
  op oth_is_endoth : @Interface@ @ODeclList@ -> @Module@ .

  *** class declaration
  op class_|_. : @Sort@ @AttrDeclList@ -> @ClassDecl@ .
  op class_. : @Sort@ -> @ClassDecl@ .
  op _`,_ : @AttrDeclList@ @AttrDeclList@ -> @AttrDeclList@ [assoc] .
  op _:_ : @Token@ @Sort@ -> @AttrDecl@ [prec 40] .

  *** subclass declaration
  op subclass_. : @SubsortRel@ -> @SubclassDecl@ .
  op subclasses_. : @SubsortRel@ -> @SubclassDecl@ .

  *** message declaration
  op msg_:_->_. : @Token@ @SortList@ @Sort@ -> @MsgDecl@ .
  op msgs_:_->_. : @NeTokenList@ @SortList@ @Sort@ -> @MsgDecl@ .
  op msg_:`->_. : @Token@ @Sort@ -> @MsgDecl@ .
  op msgs_:`->_. : @NeTokenList@ @Sort@ -> @MsgDecl@ .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod VIEWS is
  including O-MODS&THS .

  sorts @ViewDecl@ @ViewDeclList@ @View@ .
  subsorts @VarDecl@ < @ViewDecl@ < @ViewDeclList@ .
  subsort @VarDeclList@ < @ViewDeclList@ .

  *** view maps
  op op_to`term_. : @Bubble@ @Bubble@ -> @ViewDecl@ .
  op op_to_. : @Token@ @Token@ -> @ViewDecl@ .
  op op_:_->_to_. : @Token@ @TypeList@ @Type@ @Token@ -> @ViewDecl@ .
  op op_:`->_to_. : @Token@ @Type@ @Token@ -> @ViewDecl@ .
  op op_:_~>_to_. : @Token@ @TypeList@ @Type@ @Token@ -> @ViewDecl@ .
  op op_:`~>_to_. : @Token@ @Type@ @Token@ -> @ViewDecl@ .
  op sort_to_. : @Sort@ @Sort@ -> @ViewDecl@ .
  op class_to_. : @Sort@ @Sort@ -> @ViewDecl@ .
  op attr_._to_. : @Sort@ @Token@ @Token@ -> @ViewDecl@ .
  op msg_to_. : @Token@ @Token@ -> @ViewDecl@ .
  op msg_:_->_to_. : @Token@ @TypeList@ @Type@ @Token@ -> @ViewDecl@ .
  op msg_:`->_to_. : @Token@ @Type@ @Token@ -> @ViewDecl@ .

  *** view
  op view_from_to_is_endv : @Interface@ @ModExp@ @ModExp@ @ViewDeclList@ 
        -> @View@ .
  op __ : @ViewDeclList@ @ViewDeclList@ -> @ViewDeclList@ [assoc] .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod COMMANDS is
  including MOD-EXPRS .

  sorts @Command@ .

  *** down function
  op down_:_ : @ModExp@ @Command@ -> @Command@ .

  *** parse commands
  op parse_. : @Bubble@ -> @Command@ .

  *** reduce commands
  op red_. : @Bubble@ -> @Command@ .
  op reduce_. : @Bubble@ -> @Command@ .

  *** rewrite commands
  op rew_. : @Bubble@ -> @Command@ .
  op rewrite_. : @Bubble@ -> @Command@ .

  *** frewrite commands
  op frew_. : @Bubble@ -> @Command@ .
  op frewrite_. : @Bubble@ -> @Command@ .

  *** search commands
  op search_=>1_. : @Bubble@ @Bubble@ -> @Command@ .
  op search_=>*_. : @Bubble@ @Bubble@ -> @Command@ .
  op search_=>+_. : @Bubble@ @Bubble@ -> @Command@ .
  op search_=>!_. : @Bubble@ @Bubble@ -> @Command@ .

  *** search commands
  op search_~>1_. : @Bubble@ @Bubble@ -> @Command@ .
  op search_~>*_. : @Bubble@ @Bubble@ -> @Command@ .
  op search_~>+_. : @Bubble@ @Bubble@ -> @Command@ .
  op search_~>!_. : @Bubble@ @Bubble@ -> @Command@ .

  *** matching commands
  op match_<=?_. : @Bubble@ @Bubble@ -> @Command@ .
  op xmatch_<=?_. : @Bubble@ @Bubble@ -> @Command@ .

  *** unifying command
  op unify_. : @Bubble@ -> @Command@ .

  *** unifying command
  op id-unify_. : @Bubble@ -> @Command@ .

  *** select command
  op select_. : @ModExp@ -> @Command@ .

  *** show commands
  op show`module`. : -> @Command@ .
  op show`module_. : @ModExp@ -> @Command@ .
  op show`all`. : -> @Command@ .
  op show`all_. : @ModExp@ -> @Command@ .
  op show`vars`. : -> @Command@ .
  op show`vars_. : @ModExp@ -> @Command@ .
  op show`sorts`. : -> @Command@ .
  op show`sorts_. : @ModExp@ -> @Command@ .
  op show`ops`. : -> @Command@ .
  op show`ops_. : @ModExp@ -> @Command@ .
  op show`mbs`. : -> @Command@ .
  op show`mbs_. : @ModExp@ -> @Command@ .
  op show`eqs`. : -> @Command@ .
  op show`eqs_. : @ModExp@ -> @Command@ .
  op show`rls`. : -> @Command@ .
  op show`rls_. : @ModExp@ -> @Command@ .
  op show`view_. : @ViewExp@ -> @Command@ .
  op show`modules`. : -> @Command@ .
  op show`views`. : -> @Command@ .

  *** set commands
  op set`protect_on`. : @ModExp@ -> @Command@ .
  op set`protect_off`. : @ModExp@ -> @Command@ .
  op set`include_on`. : @ModExp@ -> @Command@ .
  op set`include_off`. : @ModExp@ -> @Command@ .
  op set`extend_on`. : @ModExp@ -> @Command@ .
  op set`extend_off`. : @ModExp@ -> @Command@ .

  *** miscellaneous
  op load_. : @Bubble@ -> @Command@ .
  op show`variants`. : -> @Command@ .
  op show`variants_. : @ModExp@ -> @Command@ .
  op show`all`variants`. : -> @Command@ .
  op show`all`variants_. : @ModExp@ -> @Command@ .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod FULL-MAUDE-SIGN is
  including VIEWS .
  including COMMANDS .

  sort @Input@ .
  subsorts @Command@ @Module@ @View@ < @Input@ .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------


*******
******* ERROR HANDLING, by Peter Olveczky
*******

*** The following module defines a function which prints up to n characters 
*** of a bubble, followed by the usual arrow <---*HERE* which points to the
*** erroneous token:

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod PRINT-SYNTAX-ERROR is
  protecting META-LEVEL .
  protecting INT .

  var  QIL : QidList .
  var  Q : Qid .
  var  N : Nat .
  vars RP RP' : ResultPair .
  var  RP? : [ResultPair?] .

  op printN : Nat QidList -> QidList .  *** first N qid's in a qidList
  eq printN(N, nil) = nil .
  eq printN(0, QIL) = nil .
  eq printN(s N, Q QIL) = Q printN(N, QIL) . 

  op removeFront : Nat QidList -> QidList .  *** removes first N qid's
  eq removeFront(N, nil) = nil .
  eq removeFront(0, QIL) = QIL .
  eq removeFront(s N, Q QIL) = removeFront(N, QIL) .

  op printSyntaxError : [ResultPair?] QidList -> QidList .
  eq printSyntaxError(noParse(N), QIL) 
    = '\r 'Parse 'error 'in '\o '\s printN(N + 1, QIL) '\r '<---*HERE* '\o .
  eq printSyntaxError(ambiguity(RP, RP'), QIL) 
    = '\r 'Ambiguous 'parsing 'for '\o '\s QIL '\o .
  eq printSyntaxError(RP?, QIL) = QIL [owise] . 

endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------
*** 
*** The Abstract Data Type \texttt{Module}
*** 
-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

*** In this section we present the abstract data type \texttt{Module}, which 
*** can be seen as an extension of the predefined sort \texttt{Module} in 
*** several ways. There are constructors for functional, system, and object-
*** oriented modules and theories, which can be parameterized and can import 
*** module expressions. There can also be parameterized sorts in Full Maude 
*** modules, and therefore, the constructors for the different declarations 
*** that can appear in a module have to be appropriately extended.

*** The section is structured as follows. After introducing some modules
*** defining some functions on the predefined sorts \texttt{Bool} and
*** \texttt{QidList} in Section~\ref{BOOL-QID-LIST}, we present in
*** Sections~\ref{EXT-SORT} and~\ref{EXT-DECL} the data types for extended
*** sorts and extended declarations. In Section~\ref{mod-exp-mod-id} we 
*** introduce module expressions and module names, and in 
*** Section~\ref{unitADT} the abstract data type \texttt{Module} itself.

*** 
*** Extension \texttt{QID-LIST}
***

*** The conversion of lists of quoted identifiers into single quoted 
*** identifiers by concatenating them is heavily used in the coming modules.
*** This is the task of the \texttt{} function, which is
*** introduced in the following module \texttt{EXT-QID-LIST} extending the 
*** predefined module \texttt{QID-LIST}.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod EXT-QID-LIST is
  pr QID-LIST .

  op qidList2Qid : QidList -> Qid .

  var  QI : Qid .
  var  QIL : QidList .
  vars St St' : String .
  var  N : Nat .
  var  F : FindResult .

  eq qidList2Qid(('\s QIL)) = qid(" " + string(qidList2Qid(QIL))) .
  eq qidList2Qid((QI QIL)) 
    = qid(string(QI) + " " + string(qidList2Qid(QIL))) 
    [owise] .
  eq qidList2Qid(nil) = qid("") .

  op trimQidList : QidList -> QidList .
  eq trimQidList(' QIL) = trimQidList(QIL) .
  eq trimQidList(QI QIL) = QI trimQidList(QIL) [owise] .
  eq trimQidList(nil) = nil .

  op string2qidList : String -> QidList .
  op string2qidListAux : String -> QidList .
  
  eq string2qidList(St) = trimQidList(string2qidListAux(St)) .
  
  eq string2qidListAux("") = nil .
  ceq string2qidListAux(St)
    = if F == notFound
      then qid(substr(St, findNonSpace(St), length(St))) 
      else qid(substr(St, findNonSpace(St), F)) 
           if substr(St, findNonSpace(St) + F, 1) =/= " "
           then qid(substr(St, findNonSpace(St) + F, 1))
           else nil
           fi 
           string2qidListAux(substr(St, findNonSpace(St) + F + 1, length(St)))
      fi
    if F := myfind(substr(St, findNonSpace(St), length(St)), " (){}[],", 0)
    [owise] .
  
  op findNonSpace : String -> Nat .
  op findNonSpace : String Nat -> Nat .
  ---- returns the length of the string if not found
  eq findNonSpace(St) = findNonSpace(St, 0) .

  eq findNonSpace(St, N)  
    = if N < length(St)
      then if substr(St, N, 1) == " " 
           then findNonSpace(St, N + 1)  
           else N
           fi 
      else length(St)
      fi .
      
  op myfind : String String Nat -> FindResult .
  eq myfind(St, St', N)
    = if N < length(St) 
      then if find(St', substr(St, N, 1), 0) =/= notFound
           then N
           else myfind(St, St', N + 1)
           fi
      else notFound 
      fi .
    
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

*** 3.2 View Expressions and Extended Sorts

*** To allow the use of parameterized sorts, or sorts qualified by the view
*** expression with which the parameterized module in which the given sorts
*** appear is instantiated, we add the sort Sort of ``extended sorts'' as a
*** supersort of the predefined sort Sort.  View expressions and extended 
*** sorts are introduced in the following modules.

*** 3.2.1 View Expressions

*** A view expression is given by a single quoted identifier, by a sequence of
*** view expressions (at the user level, separated by commas), or by the
*** composition of view expressions. In the current version, the composition
*** of view expressions is only used internally; we plan to make it available
*** to the user with syntax \verb~_;_~ in the future. View expressions are
*** used in the instantiation of parameterized modules and in parameterized
*** sorts.  We plan to support parameterized views in the future as well. We 
*** use operators \verb~_|_~ and \verb~_;;_~ to represent, respectively, 
*** sequences and composition of view expressions.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod VIEW-EXPR is
  pr META-MODULE .

  sort ViewExp .
  subsorts Sort < ViewExp < ModuleExpression NeParameterList .

  op mtViewExp : -> ViewExp .
  op _{_} : Sort ParameterList -> ViewExp [ctor prec 37].
  op _;;_ : ViewExp ViewExp -> ViewExp 
       [assoc id: mtViewExp] .                       *** view composition  _;_
      
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

*** Since the Core Maude engine does not know about view expressions, or, as
*** we shall see, about extended sorts, extended module expressions, extended
*** modules, and other declarations that we introduce, to be able to use them
*** with built-in functions such as \texttt{sameComponent},
*** \texttt{leastSort}, \texttt{metaReduce}, etc., we shall have to convert
*** them into terms which only use the built-in constructors.  Thus, for
*** example, view expressions in sort \texttt{ViewExp} will be converted
*** into quoted identifiers of sort \texttt{Qid} by means of function
*** \texttt{parameter2Qid}, or, similarly, elements of sorts \texttt{Sort},
*** \texttt{SortList}, and \texttt{SortSet} are transformed into elements
*** of sorts \texttt{Qid}, \texttt{QidList}, and  \texttt{QidSet},
*** respectively, with functions \texttt{eSortToQid} defined  on the 
*** appropriate sorts.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod VIEW-EXPR-TO-QID is
  pr VIEW-EXPR .
  pr EXT-QID-LIST .

  op viewExp2Qid : ViewExp -> Qid .
  op parameterList2Qid : ParameterList -> Qid .
  op viewExp2QidList : ViewExp -> QidList .
  op parameterList2QidList : ParameterList -> QidList .

  var  V : Sort .
  var  QI : Qid .
  var  QIL : QidList .
  var  P : ViewExp .
  var  PL : NeParameterList .
  vars VE VE' : ViewExp .

  eq parameterList2QidList(P) = viewExp2QidList(P) .
  ceq parameterList2QidList((P, PL))
    = (if QI == '`) then QIL QI '\s else QIL QI fi) 
      '`, parameterList2QidList(PL)
    if QIL QI := viewExp2QidList(P).

  eq viewExp2QidList(V{PL})
    = (viewExp2QidList(V) '`{ parameterList2QidList(PL) '`}) .
  ceq viewExp2QidList(VE ;; VE')
    = (viewExp2QidList(VE) '; viewExp2QidList(VE')) 
    if VE =/= mtViewExp /\ VE' =/= mtViewExp .
  eq viewExp2QidList(V) = V .
 
  eq parameterList2Qid(P) = viewExp2Qid(P) .
  eq parameterList2Qid((P, PL))
    = qid(string(viewExp2Qid(P)) + ", " + string(parameterList2Qid(PL))) .

  eq viewExp2Qid(VE) = qidList2Qid(viewExp2QidList(VE)) .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** Parameterized Sorts
***

*** In addition to the \texttt{Sort} sort, in the following module
*** \texttt{EXT-SORT} we also define sorts \texttt{SortList} and 
*** \texttt{SortSet}.

*** The operator \texttt{eSort} is declared to be a constructor for extended 
*** sorts.

*** As for lists and sTS of quoted identifiers, we declare \verb~__~ and
*** \verb~_;_~ as constructors for sorts \texttt{SortList} and 
*** \texttt{SortList}, and \texttt{SortSet}, respectively.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod EXT-SORT is
  pr META-LEVEL .
  pr EXT-BOOL .
  pr VIEW-EXPR .

*** We define operations extending the built-in functions \texttt{sameKind}
*** and \texttt{leastSort}, respectively, to lists of sorts and
*** to lists of extended terms. The function \texttt{sameKind} takes
*** a module and two lists of extended sorts as arguments, and returns
*** \texttt{true} if the $i$-th elements of both lists are in the same
*** connected component of sorts. This function will be used, for example, to
*** check whether two operators are in the same family of subsort overloaded
*** operators. \texttt{leastSort} returns a list of sorts where the $i$-th
*** element of the list is the least sort, computed by the homonymous built-in
*** function, of the $i$-th term in the list of terms given as argument.
*** Moreover, we define a function \verb~_in_~ to check whether an
*** extended sort is in a given set of extended sorts.  Note that before
*** calling the built-in function \texttt{sameComponent}, extended sorts of
*** sort \texttt{Sort} have to be `desugared' into sorts of sort
*** \texttt{Sort} as defined in the predefined \texttt{META-LEVEL} module.
*** This conversion is done by the \texttt{eTypeToType} function. Basically, 
*** user-defined sorts are converted into quoted identifiers by concatenating 
*** the list of identifiers composing the name of the sort. For example, sorts 
*** \texttt{'Nat} and \texttt{'List['Nat]} are converted, respectively, into 
*** \texttt{'Nat} and \texttt{'List`[Nat`]}. Error 
*** sorts~\cite{ClavelDuranEkerLincolnMarti-OlietMeseguerQuesada99} are left 
*** as such.

  vars Tp Tp' Tp'' Tp''' : Type .
  vars TpL TpL' : TypeList .

  op sameKind : Module TypeList TypeList -> Bool [ditto] .
  eq sameKind(M:Module, (Tp Tp' TpL), (Tp'' Tp''' TpL'))
    = sameKind(M:Module, Tp, Tp'') 
      and-then sameKind(M:Module, Tp' TpL, Tp''' TpL') .
  eq sameKind(M:Module, nil, nil) = true .
  eq sameKind(M:Module, TpL, TpL) = false [owise] .

  eq sameKind(M:Module, cc(S:Sort ; SS:SortSet), Tp) 
    = sameKind(M:Module, S:Sort, Tp) .
  eq sameKind(M:Module, Tp, cc(S:Sort ; SS:SortSet)) 
    = sameKind(M:Module, Tp, S:Sort) .
  eq sameKind(M:Module, cc(S:Sort ; SS:SortSet), cc(S':Sort ; SS':SortSet)) 
    = sameKind(M:Module, S:Sort, S':Sort) .

  op eLeastSort : Module TermList ~> TypeList .
  eq eLeastSort(M:Module, (T:Term, TL:TermList)) 
    = (leastSort(M:Module, T:Term) eLeastSort(M:Module, TL:TermList)) .
  eq eLeastSort(M:Module, empty) = nil .
  eq eLeastSort(M:Module, qidError(QIL)) = qidError(QIL) .

  op qidError : QidList -> [Sort] .
  op stringError : QidList -> [String] .
  eq string(qidError(QIL)) = stringError(QIL) .
  eq qid(stringError(QIL)) = qidError(QIL) .
  eq stringError(QIL) + St:String = stringError(QIL) .

  op getMsg : [Sort] -> QidList .
  eq getMsg(qidError(QIL:QidList)) = QIL:QidList .

  op kind : TypeList -> Type .

  eq kind(S:Sort TL:TypeList) 
    = qid("[" + string(S:Sort) + "]") kind(TL:TypeList) .
  eq kind(K:Kind TL:TypeList) = K:Kind kind(TL:TypeList) .
  eq kind(nil) = nil .

  op kind : SortSet -> Type .
  eq kind(S:Sort ; SS:SortSet) = qid("[" + string(S:Sort) + "]") .

  op cc : SortSet -> Type .

  op getSort : Kind -> Sort .
  eq getSort(K:Kind) 
    = if findOut(string(K:Kind), "`,", "{", "}", 0) == notFound
      then qid(substr(string(K:Kind), 
                      2, 
                      sd(length(string(K:Kind)), 4)))
      else qid(substr(string(K:Kind), 
                      2, 
                      sd(findOut(string(K:Kind), "`,", "{", "}", 0), 2)))
      fi .

  op getSorts : Kind -> SortSet .
  eq getSorts(K:Kind) 
    = if findOut(string(K:Kind), "`,", "{", "}", 0) == notFound
      then qid(substr(string(K:Kind), 
                      2, 
                      sd(length(string(K:Kind)), 4)))
      else qid(substr(string(K:Kind), 
                      2, 
                      sd(findOut(string(K:Kind), "`,", "{", "}", 0), 2)))
           ;
           getSorts(qid("[" + substr(string(K:Kind), 
                                     sd(findOut(string(K:Kind), "`,", "{", "}", 0), 1),
                                     length(string(K:Kind)))))
      fi .

----  op qid2Sort : Sort -> Sort .
----  eq qid2Sort(S:Sort) = getName{S:Sort} { getPars(S:Sort) } .

  ---- name of a sort (the name of S{P1, ..., Pn} is S)
  op getName : Sort -> Qid .
  eq getName(S:Sort) 
    = if findOpening(string(S:Sort), "{", "}", sd(length(string(S:Sort)), 2))
           == notFound
      then S:Sort
      else qid(substr(string(S:Sort), 
                      0, 
                      findOpening(string(S:Sort), 
                        "{", "}", 
                        sd(length(string(S:Sort)), 2))))
      fi .

  ---- parameters of a sort (the parameters of S{P1, ..., Pn} are P1 ... Pn)
  op getPars : Sort -> ParameterList [memo] .
  op getParsAux : String Nat Nat -> ParameterList .

  eq getPars(S:Sort) 
    = if findOpening(string(S:Sort), "{", "}", sd(length(string(S:Sort)), 2))
           == notFound
      then empty
      else getParsAux(string(S:Sort), 
             findOpening(string(S:Sort), 
               "{", "}", sd(length(string(S:Sort)), 2)) + 1,
             length(string(S:Sort)))
      fi .

  var  St Pattern OpenPar ClosingPar : String .
  vars L R N OpenPars ClosingPars : Nat .

  eq getParsAux(St, L, R)
    = if findOut(St, ",", "{", "}", L) == notFound
      then qid(substr(St, L, sd(findClosing(St, "{", "}", L), L)))
      else (qid(substr(St, L, sd(findOut(St, ",", "{", "}", L), L))),
            getParsAux(St, findOut(St, ",", "{", "}", L) + 1, R))
      fi .

  ---- finds a pattern out of balanced parentheses 
  ---- findOut("S{P1, P2{P21, P22}, P3}", ",", "{", "}", 6) returns 18, not 12
  op findOut : String String String String Nat -> FindResult .
  op findOut : String String String String Nat Nat -> FindResult .

  eq findOut(St, Pattern, OpenPar, ClosingPar, N)
    = findOut(St, Pattern, OpenPar, ClosingPar, 0, N) .

  eq findOut(St, Pattern, OpenPar, ClosingPar, OpenPars, N)
    = if N >= length(St)
      then notFound
      else if OpenPars == 0 and-then substr(St, N, length(Pattern)) == Pattern
           then N
           else if substr(St, N, length(OpenPar)) == OpenPar
                then findOut(St, Pattern, OpenPar, ClosingPar, 
                       OpenPars + 1, N + 1)
                else if substr(St, N, length(ClosingPar)) == ClosingPar
                     then findOut(St, Pattern, OpenPar, ClosingPar, 
                            sd(OpenPars, 1), N + 1)
                     else findOut(St, Pattern, OpenPar, ClosingPar, 
                            OpenPars, N + 1)
                     fi
                fi
           fi
      fi .

  ---- finds the first closing unbalanced parenthesis 
  ---- findOut("P1, P2{P21, P22}, P3}", "{", "}", 6) returns 21, not 16
  op findClosing : String String String Nat -> FindResult .
  op findClosing : String String String Nat Nat -> FindResult .

  eq findClosing(St, OpenPar, ClosingPar, N)
    = findClosing(St, OpenPar, ClosingPar, 0, N) .

  eq findClosing(St, OpenPar, ClosingPar, OpenPars, N)
    = if N >= length(St)
      then notFound
      else if OpenPars == 0 
              and-then substr(St, N, length(ClosingPar)) == ClosingPar
           then N
           else if substr(St, N, length(OpenPar)) == OpenPar
                then findClosing(St, OpenPar, ClosingPar, 
                       OpenPars + 1, N + 1)
                else if substr(St, N, length(ClosingPar)) == ClosingPar
                     then findClosing(St, OpenPar, ClosingPar, 
                            sd(OpenPars, 1), N + 1)
                     else findClosing(St, OpenPar, ClosingPar, 
                            OpenPars, N + 1)
                     fi
                fi
           fi
      fi .

  ---- finds the last opening unbalanced parenthesis 
  ---- findOpening("S{P1, P2{P21, P22}, P3}", "{", "}", 21) returns 1, not 8
  op findOpening : String String String Nat -> FindResult .
  op findOpening : String String String Nat Nat -> FindResult .

  eq findOpening(St, OpenPar, ClosingPar, N)
    = findOpening(St, OpenPar, ClosingPar, 0, N) .

  eq findOpening(St, OpenPar, ClosingPar, ClosingPars, N)
    = if N == 0
      then notFound
      else if ClosingPars == 0 
              and-then substr(St, N, length(ClosingPar)) == OpenPar
           then N
           else if substr(St, N, length(OpenPar)) == ClosingPar
                then findOpening(St, OpenPar, ClosingPar, 
                       ClosingPars + 1, sd(N, 1))
                else if substr(St, N, length(ClosingPar)) == OpenPar
                     then findOpening(St, OpenPar, ClosingPar, 
                            sd(ClosingPars, 1), sd(N, 1))
                     else findOpening(St, OpenPar, ClosingPar, 
                            ClosingPars, sd(N, 1))
                     fi
                fi
           fi
      fi .

  op makeSort : Sort ParameterList -> Sort .
  op makeSort : Sort ParameterList ParameterList ParameterList -> Sort .
  op makeSort2 : Sort ParameterList -> Sort .
  op makePars : ParameterList -> String .

  vars S P : Sort .
  vars PL PL' PL'' PL3 : ParameterList .
  var  VE : ViewExp .
  var  QIL : QidList .

  eq makeSort(S, PL) 
    = if PL == empty 
      then S 
      else makeSort(S, PL, empty, empty) 
      fi .
  
  ----eq makeSort(S, P, PL, PL') = makeSort(S, empty, (PL, P), PL') .
  eq makeSort(S, (P, PL), PL', PL'') = makeSort(S, PL, (PL', P), PL'') .
  eq makeSort(S, (P{PL}, PL'), PL'', PL3) 
    = makeSort(S, PL', (PL'', makeSort(P, PL)), PL3) .
  ----eq makeSort(S, (P ;; VE), PL, PL') 
  ----  = makeSort(S, empty, (PL, P), (PL', VE)) 
  ----  [owise] .
  eq makeSort(S, ((P ;; VE), PL), PL', PL'') 
    = makeSort(S, PL, (PL', P), (PL'', VE)) 
    [owise] .
  eq makeSort(S, empty, PL, PL') 
    = if PL' == empty 
      then makeSort2(S, PL) 
      else makeSort(makeSort2(S, PL), PL') 
      fi .

  eq makeSort2(S, empty) = S:Sort .
  eq makeSort2(S, P) = qid(string(S) + "{" + string(P) + "}") .
  eq makeSort2(S, (P, PL)) 
    = qid(string(S) + "{" + string(P) + makePars(PL)) 
    [owise] .

  eq makePars((P, PL)) = "," + string(P) + makePars(PL) .
  eq makePars(P) = "," + string(P) + "}" .
  eq makePars(empty) = "}" .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod DEFAULT-VALUE{X :: TRIV} is
  sort Default{X} .
  subsort X$Elt < Default{X} .
  op null : -> Default{X} .
endfm

view Term from TRIV to META-TERM is
  sort Elt to Term .
endv

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** Extended Declarations
***

*** In this section we discuss modules \texttt{EXT-DECL} and \texttt{O-O-DECL}
*** which introduce, respectively, the declarations extending the sorts and
*** constructors for declarations of the predefined data type \texttt{Module}
*** in the \texttt{META-LEVEL} module to allow the use of extended sorts in
*** them, and the declarations appearing in object-oriented units, namely 
*** class declarations, subclass relation declarations, and message 
*** declarations.

***
*** Declarations of Functional and System Modules
***

*** In the following module \texttt{EXT-DECL}, we introduce the declarations
*** extending those in \texttt{META-LEVEL} to allow the use of extended sorts
*** in declarations of sorts, subsort relations, operators, variables, and 
*** membership axioms.

*** \begin{comment}
*** \footnote{In the future, the declarations for operators,
*** membership axioms, equations, and rules will be extended to allow
*** the use of extended sorts in sort tests, that is, terms of the
*** form \mbox{\verb~T : S~} and \mbox{\verb~T :: S~}.}
*** \end{comment}

*** The extension is accomplished by adding new supersorts for each of the
*** sorts in \texttt{META-LEVEL} involved, and by adding new constructors for 
*** these new sorts.

*** We start introducing the declarations for the supersorts and their 
*** corresponding constructors. The \texttt{EXT-DECL} module also contains the
*** declarations for sTS of such declarations.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod INT-LIST is 
  pr META-MODULE .
  pr INT .
  sort IntList .
  subsort Int NatList < IntList .
  op __ : IntList IntList -> IntList [ctor ditto] .

  op numberError : QidList -> [Nat] .

  vars N M : Nat .

  op from_to_list : Nat Nat ~> NatList .
  ceq from N to M list 
    = if N == M 
      then N 
      else N from N + 1 to M list 
      fi 
    if N <= M .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod EXT-DECL is
  pr EXT-SORT .
  pr INT-LIST .

  vars QIL QIL' : QidList .
  var  At : Attr .
  var  AtS : AttrSet .
  var  OPD OPD' : OpDecl .
  var  OPDS : OpDeclSet .
  vars LHS RHS : Term .
  var  Cond : Condition .

*** subsort declarations error
  op subsortDeclError : QidList -> [SubsortDeclSet] [ctor format (r o)] .
  eq subsortDeclError(QIL) subsortDeclError(QIL') 
    = subsortDeclError(QIL QIL') .

*** extended attribute declarations 
  op strat : IntList -> Attr [ditto] .   *** to handle on-demand strategies
  op ditto : -> Attr [ctor] .

  op _in_ : Attr AttrSet -> Bool .
  eq At in At AtS = true .
  eq At in AtS = false [owise] .

*** extended operation declarations
  op opDeclError : QidList -> [OpDeclSet] [ctor format (r o)] .
  eq opDeclError(QIL) opDeclError(QIL') = opDeclError(QIL QIL') .

*** extended membership axioms 
  op membAxError : QidList -> [MembAxSet] [ctor format (r o)] .
  eq membAxError(QIL) membAxError(QIL') = membAxError(QIL QIL') .

*** extended equations
  op equationError : QidList -> [EquationSet] [ctor format (r o)] .
  eq equationError(QIL) equationError(QIL') = equationError(QIL QIL') .

*** extended rules
  op ruleError : QidList -> [RuleSet] [ctor format (r o)] .
  eq ruleError(QIL) ruleError(QIL') = ruleError(QIL QIL') .

*** The function \verb~_in_~ checks whether a given operator
*** declaration is in a set of operator declarations.

  op _in_ : OpDecl OpDeclSet -> Bool .

  eq OPD in (OPD OPDS) = true .
  eq OPD in OPDS = false [owise] .

  ops lhs rhs : Rule -> Term .
  op cond : Rule -> Condition .
  op atts : Rule -> AttrSet .
  eq lhs(rl LHS => RHS [AtS] .) = LHS .
  eq lhs(crl LHS => RHS if Cond [AtS] .) = LHS .
  eq rhs(rl LHS => RHS [AtS] .) = RHS .
  eq rhs(crl LHS => RHS if Cond [AtS] .) = RHS .
  eq cond(rl LHS => RHS [AtS] .) = nil .
  eq cond(crl LHS => RHS if Cond [AtS] .) = Cond .
  eq atts(rl LHS => RHS [AtS] .) = AtS .
  eq atts(crl LHS => RHS if Cond [AtS] .) = AtS .
  
  ops lhs rhs : Equation -> Term .
  op cond : Equation -> Condition .
  op atts : Equation -> AttrSet .
  eq lhs(eq LHS = RHS [AtS] .) = LHS .
  eq lhs(ceq LHS = RHS if Cond [AtS] .) = LHS .
  eq rhs(eq LHS = RHS [AtS] .) = RHS .
  eq rhs(ceq LHS = RHS if Cond [AtS] .) = RHS .
  eq cond(eq LHS = RHS [AtS] .) = nil .
  eq cond(ceq LHS = RHS if Cond [AtS] .) = Cond .
  eq atts(eq LHS = RHS [AtS] .) = AtS .
  eq atts(ceq LHS = RHS if Cond [AtS] .) = AtS .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** Declarations for Object-Oriented Modules
***

*** In the \texttt{O-O-DECL} module we introduce the sorts and constructors
*** for declarations of classes, subclass relations, and messages in 
*** object-oriented units.

*** Note that we follow the same naming conventions for classes as for
*** extended sorts (see Section~\ref{parameterized-modules}), and therefore
*** we use the sort \texttt{Sort} for class identifiers, and
*** \texttt{TypeList} and \texttt{SortSet} for lists and sTS of class
*** identifiers, respectively.  We use the operator \verb~attr_:_~ as a
*** constructor for declarations of attributes. Since the operator name
*** \texttt{\_\,:\_\,} is used for sort  tests in the \texttt{META-LEVEL}
*** module, we use \texttt{attr\_\,:\_\,} as  constructor for declarations of
*** attributes to satisfy the preregularity  condition.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod O-O-DECL is
  pr EXT-SORT .

  vars QIL QIL' : QidList .

  sorts AttrDecl AttrDeclSet . 
  subsort AttrDecl < AttrDeclSet .
  op attr_:_ : Qid Sort -> AttrDecl .
  op none : -> AttrDeclSet .
  op _`,_ : AttrDeclSet AttrDeclSet -> AttrDeclSet [assoc comm id: none] .

  eq AD:AttrDecl, AD:AttrDecl = AD:AttrDecl .

  sorts ClassDecl ClassDeclSet . 
  subsort ClassDecl < ClassDeclSet .
  op class_|_. : Sort AttrDeclSet -> ClassDecl .
  op none : -> ClassDeclSet .
  op __ : ClassDeclSet ClassDeclSet -> ClassDeclSet [assoc comm id: none] .

  op classDeclError : QidList -> [ClassDeclSet] [ctor format (r o)] .
  eq classDeclError(QIL) classDeclError(QIL') = classDeclError(QIL QIL') .

  eq CD:ClassDecl CD:ClassDecl = CD:ClassDecl .

  sorts SubclassDecl SubclassDeclSet . 
  subsort SubclassDecl < SubclassDeclSet .
  op subclass_<_. : Sort Sort -> SubclassDecl .
  op none : -> SubclassDeclSet .
  op __ : SubclassDeclSet SubclassDeclSet -> SubclassDeclSet 
     [assoc comm id: none] .

  eq SCD:SubclassDecl SCD:SubclassDecl = SCD:SubclassDecl .

  op subclassDeclError : QidList -> [SubclassDeclSet] [ctor format (r o)] .
  eq subclassDeclError(QIL) subclassDeclError(QIL') 
    = subclassDeclError(QIL QIL') .

  sorts MsgDecl MsgDeclSet . 
  subsort MsgDecl < MsgDeclSet .
  op msg_:_->_. : Qid TypeList Sort -> MsgDecl .
  op none : -> MsgDeclSet .
  op __ : MsgDeclSet MsgDeclSet -> MsgDeclSet [assoc comm id: none] .

  eq MD:MsgDecl MD:MsgDecl = MD:MsgDecl .

  op msgDeclError : QidList -> [MsgDeclSet] [ctor format (r o)] .
  eq msgDeclError(QIL) msgDeclError(QIL') = msgDeclError(QIL QIL') .

*** The function \texttt{classSet} returns the set of class identifiers in
*** the set of class declarations given as argument.

  op classSet : ClassDeclSet -> SortSet .

  eq classSet((class S:Sort | ADS:AttrDeclSet .) CDS:ClassDeclSet) 
    = (S:Sort ; classSet(CDS:ClassDeclSet)) .
  eq classSet(none) = none .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** Renaming Maps
***

*** We introduce the different types of renaming maps in the module
*** \texttt{FMAP} below. A sort is introduced for each of these types of maps,
*** with the appropriate constructors for each sort (see
*** Section~\ref{module-expressions}). All these sorts are declared to be
*** subsorts of the sort \texttt{Map}. A sort for sTS of 
*** maps (\texttt{RenamingSet}) is then declared as supersort of \texttt{Map} 
*** with constructors \texttt{none} and \verb~_,_~.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod FMAP is
  inc META-MODULE .
  pr EXT-SORT .

  *** renamings
  op class_to_ : Sort Sort -> Renaming .
  op attr_._to_ : Qid Sort Qid -> Renaming .
  op msg_to_ : Qid Qid -> Renaming .
  op msg_:_->_to_ : Qid TypeList Sort Qid -> Renaming .

  op none : -> RenamingSet .
  eq (MAP, MAP) = MAP .
  eq (MAPS, none) = MAPS .

----  eq attr A . qidError(QIL) to A' = none .

*** Given a set of maps, the function \texttt{sortMaps} returns the
*** subset of sort maps in it.

  var  MAP : Renaming .
  var  MAPS : RenamingSet .
  vars S S' A A' : Sort .
  var  QIL : QidList .

  op sortMaps : RenamingSet -> RenamingSet .

  eq sortMaps(sort S to S') = sort S to S' .
  eq sortMaps(((sort S to S'), MAPS))
    = ((sort S to S'), sortMaps(MAPS)) .
  eq sortMaps(MAP) = none [owise] .
  eq sortMaps((MAP, MAPS)) = sortMaps(MAPS) [owise] .
  eq sortMaps(none) = none .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** Module Expressions and Module Names
***

*** The abstract syntax for writing specifications in Maude can be seen as
*** given by module expressions, where the notion of module expression is
*** understood as an expression that defines a new module out of previously
*** defined modules by combining and/or modifying them according to a specific
*** set of operations.  All module expressions will be evaluated generating
*** modules with such module expressions as names. In the case of parameterized
*** modules, each of the parameters in an interface will be used as the name
*** of a new module created as a renamed copy of the parameter theory.

***
*** Module Expressions
***

*** The \texttt{TUPLE} and \texttt{POWER} are declared to be new types of 
*** \texttt{ModuleExpression}s. 

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod MOD-EXPR is
  inc META-MODULE .
  pr FMAP .

  op TUPLE`[_`] : NzNat -> ModuleExpression .
  op POWER`[_`] : NzNat -> ModuleExpression .

  eq ME:ModuleExpression * ( none ) = ME:ModuleExpression .

endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** Module Names
***

*** As we shall see in the coming sections, the evaluation of module
*** expressions may produce the creation of new modules, whose \emph{names}
*** are given by the module expressions themselves. If there is already a
*** module in the database with the module expression being evaluated as name,
*** the evaluation of such module expression does not produce any change in
*** the database. However, the evaluation of a module expression may involve 
*** the evaluation of some other module expressions contained in the modules 
*** involved, which in turn may generate new modules.

*** Given a parameterized module $\texttt{N\{L}_1\texttt{\ ::\ T}_1
*** \texttt{\ ,\ }\ldots\texttt{\ ,\ L}_n\texttt{\ ::\ T}_n\texttt{\}}$, with
*** $\texttt{L}_1\ldots\texttt{L}_n$ labels and
*** $\texttt{T}_1\ldots\texttt{T}_n$ theory identifiers, we say that
*** \texttt{N} is the name of the module and that
*** $\texttt{\{L}_1\texttt{\ ::\ T}_1\texttt{\ ,\ }
*** \ldots\texttt{\ ,\ L}_n\texttt{\ ::\ T}_n\texttt{\}}$ 
*** is its \emph{interface}.
*** As we shall see in Sections~\ref{instantiation} and~\ref{unit-processing},
*** for each parameter $\texttt{L}_i\texttt{\ ::\ T}_i$ in the interface of a
*** module, a new module is generated with such a parameter expression as its
*** name, and a declaration importing it in the parameterized module is added.
***  We regard the relationship between the body of a parameterized module and
*** the parameters in its interface, not as an inclusion, but as mediated by 
*** a module constructor that generates renamed copies of the parameters, 
*** which are then included. Therefore, the sort \texttt{ViewExp} is 
*** declared as a subsort of \texttt{Header}, that is, terms of sort 
*** \texttt{ViewExp} are considered to be module names. The constructor 
*** operator for the sort \texttt{ViewExp} is \verb~par_::_~.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod MOD-NAME is
  inc MOD-EXPR .
  pr EXT-BOOL .
  op parameterError : QidList -> [ParameterDecl] .

  sort ModuleName .
  subsorts ModuleExpression < ModuleName < Header .
  op _{_}  : ModuleExpression ParameterDeclList -> Header .
  op pd : ParameterDecl -> ModuleName .
  op nullHeader : -> Header .

  op getName : Header -> ModuleExpression .
  op getParDecls : Header -> ParameterDeclList .

  vars QI QI' : Qid .
  var  ME : ModuleExpression .
  vars PDL PDL' : ParameterDeclList .
  var  PL : NeParameterList .
  var  MN : ModuleName .

  eq getName(ME{PDL}) = ME .
  eq getName(MN) = MN .
  eq getParDecls(ME{PDL}) = PDL .
  eq getParDecls(MN) = nil .

  op including_. : ModuleName -> Import [ctor] .
  op extending_. : ModuleName -> Import [ctor] .
  op protecting_. : ModuleName -> Import [ctor] .

  op fth_is_sorts_.____endfth : Header ImportList SortSet SubsortDeclSet
    OpDeclSet MembAxSet EquationSet -> FTheory [ctor gather (& & & & & & &)
     format (d d d n++i ni d d ni ni ni ni n--i d)] .
  op th_is_sorts_._____endth : Header ImportList SortSet SubsortDeclSet
    OpDeclSet MembAxSet EquationSet RuleSet -> STheory
    [ctor gather (& & & & & & & &)
     format (d d d n++i ni d d ni ni ni ni ni n--i d)] .

*** The function \texttt{labelInParameterDeclList} checks whether the quoted
*** identifier given as first argument is used as a label in the list of 
*** parameters given as second argument.

  op labelInParameterDeclList : Sort ParameterDeclList -> Bool .
  eq labelInParameterDeclList(QI, (PDL, (QI :: ME), PDL')) = true .
  eq labelInParameterDeclList(QI, PDL) = false [owise] .

endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

*** Since the Core Maude engine assumes that module names are identifiers and
*** does not know about term-structured module names (such as parameterized
*** module interfaces or module expressions), for evaluation purposes we need
*** to transform them into quoted identifiers. The functions
*** \texttt{header2Qid} and \texttt{header2QidList} in the module
*** \texttt{MOD-NAME-TO-QID} below accomplish this transformation. In any
*** language extensions, new equations for the function
*** \texttt{header2QidList} should be added for each new module expression
*** constructor introduced. In Sections~\ref{renaming} and~\ref{instantiation} 
*** we shall see how the corresponding equalities are added for renaming and 
*** instantiation expressions, and in Section~\ref{extension} for other new 
*** module expressions in extensions of Full Maude.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod MOD-NAME-TO-QID is
  pr MOD-NAME .
  pr EXT-QID-LIST .

  op header2Qid :  -> Qid .
  op header2QidList : Header -> QidList .
  op parameterDecl2Qid : ParameterDecl -> Qid .
  op parameterDecl2QidList : ParameterDecl -> QidList .
  op parameterDeclList2Qid : ParameterDeclList -> Qid .
  op parameterDeclList2QidList : ParameterDeclList -> QidList .

  vars QI X : Qid .
  var  QIL : QidList .
  vars ME ME' : ModuleExpression .
  var  PDL : ParameterDeclList .
  var  PD : ParameterDecl .

  eq header2Qid(QI) = QI .
  eq header2Qid(nullHeader) = ' .
  eq header2Qid(pd(X :: ME)) = qidList2Qid(header2QidList(pd(X :: ME))) .
  eq header2QidList(pd(X :: ME)) = X ':: header2QidList(ME) .

  eq header2QidList(QI) = QI .
  eq header2QidList(nullHeader) = ' .

  eq header2Qid((ME { PDL })) = qidList2Qid(header2QidList((ME { PDL }))) .
  ceq header2QidList((ME { PDL })) 
    = (if QI == '\s then QIL else QIL QI fi 
       '`{ parameterDecl2QidList(PDL) '`} '\s) 
    if QIL QI := header2QidList(ME) .
 
  eq parameterDecl2Qid(X :: ME) = qidList2Qid(X ':: header2Qid(ME)) .

  eq parameterDeclList2Qid(PDL)
    = qidList2Qid(parameterDeclList2QidList(PDL)) .

  eq parameterDeclList2QidList(X :: ME) = X ':: header2QidList(ME) .
  eq parameterDeclList2QidList((X :: ME, PDL))
    = parameterDeclList2QidList(X :: ME) '`, parameterDeclList2QidList(PDL)
    [owise] .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** Modules
***

*** We handle six different types of units: functional, system, and
*** object-oriented modules, and functional, system, and object-oriented
*** theories.  Modules and theories of any kind are considered to be elements
*** in specific subsorts of the sort \texttt{Module}. A constructor
*** \texttt{error} is also included to represent incorrect units.
*** \texttt{error} has a list of quoted identifiers as argument, which is
*** used to report the error. Besides considering functional and system
*** theories and object-oriented theories and modules, the declarations 
*** presented in the following module extend the declarations for sort 
*** \texttt{Module} in the \texttt{META-LEVEL} module in three different ways:

*** \begin{itemize}
*** \item the name of a module can be any term of sort \texttt{Header},
*** \item parameterized modules are handled, for which a list of
***       parameters is added to the constructors of modules,
*** \item the importation declaration is extended to module names, and
*** \item parameterized sorts are supported.  
*** \end{itemize}

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod UNIT is
  pr EXT-DECL .
  pr O-O-DECL .
  pr MOD-NAME-TO-QID .
  inc META-LEVEL .

  op moduleName : Import -> ModuleName .
  eq moduleName(protecting MN .) = MN .
  eq moduleName(protecting ME{PL} .) = ME .
  eq moduleName(extending MN .) = MN .
  eq moduleName(extending ME{PL} .) = ME .
  eq moduleName(including MN .) = MN .
  eq moduleName(including ME{PL} .) = ME .

  op importError : QidList -> [ImportList] [ctor format (r o)] .
  eq importError(QIL) importError(QIL') = importError(QIL QIL') .

  sorts OModule OTheory .
  subsorts SModule < OModule < Module .
  subsorts STheory < OTheory < Module .

  op noModule : -> Module .   *** Module
  op unitError : QidList -> [Module] [ctor format (r o)] .
  op getMsg : [Module] -> QidList .
  eq getMsg(unitError(QIL)) = QIL .

  op omod_is_sorts_.________endom : Header ImportList
        SortSet SubsortDeclSet ClassDeclSet SubclassDeclSet OpDeclSet 
        MsgDeclSet MembAxSet EquationSet RuleSet -> OModule 
        [ctor 
         gather (& & & & & & & & & & &)
         format (r! o r! n++io ni d d ni ni ni ni ni ni ni ni n--ir! o)] .
  op oth_is_sorts_.________endoth : Header ImportList
        SortSet SubsortDeclSet ClassDeclSet SubclassDeclSet OpDeclSet 
        MsgDeclSet MembAxSet EquationSet RuleSet -> OTheory
        [ctor 
         gather (& & & & & & & & & & &)
         format (r! o r! n++io ni d d ni ni ni ni ni ni ni ni n--ir! o)] .

*** In addition to the constructor operators, the following functions are
*** introduced in the \texttt{UNIT} module:
*** \begin{itemize}
*** \item A function \verb~_in_~ to check whether a given importation
***       declaration is in a set of importation declarations or not.

  op _in_ : Import ImportList -> Bool .

*** \item Selector functions for the different components of a Module.

  op getName : Module -> Header .
  op getPars : Module -> ParameterDeclList .
  op getClasses : Module -> ClassDeclSet .
  op getSubclasses : Module -> SubclassDeclSet .
  op getMsgs : Module -> MsgDeclSet .

*** \item Functions to change the value of each of the components of a Module.

  op setName : Module ModuleExpression -> Module .
  op setName : Module ParameterDecl -> Module .
  op setPars : Module ParameterDeclList -> Module .
  op setImports : Module ImportList -> Module .
  op setSorts : Module SortSet -> Module .
  op setSubsorts : Module SubsortDeclSet -> Module .
  op setOps : Module OpDeclSet -> Module .
  op setMbs : Module MembAxSet -> Module .
  op setEqs : Module EquationSet -> Module .
  op setRls : Module RuleSet ~> Module .
  op setClasses : Module ClassDeclSet -> Module .
  op setSubclasses : Module SubclassDeclSet -> Module .
  op setMsgs : Module MsgDeclSet -> Module .

*** \item Functions to add new declarations to the set of declarations 
*** already in a unit.

  op addImports : ImportList Module -> Module .
  op addSorts : SortSet Module -> Module .
  op addSubsorts : [SubsortDeclSet] Module -> Module .
  op addOps : [OpDeclSet] Module -> Module .
  op addMbs : MembAxSet Module -> Module .
  op addEqs : EquationSet Module -> Module .
  op addRls : RuleSet Module -> Module .
  op addClasses : ClassDeclSet Module -> Module .
  op addSubclasses : SubclassDeclSet Module -> Module .
  op addMsgs : MsgDeclSet Module -> Module .

*** \item There are functions and constants to create empty modules of the
***       different types. For example, the function \texttt{emptyFTheory}
***       returns an empty functional theory. There is also a
***       function \texttt{empty} which takes a module as argument and returns 
***       an empty module of the same type.

  op emptyFModule : Header -> FModule .
  op emptyFModule : -> FModule .
  op emptySModule : -> SModule .
  op emptyOModule : -> OModule .
  op emptyFTheory : -> FModule .
  op emptySTheory : -> SModule .
  op emptyOTheory : -> OModule .
  op empty : Module -> Module .

*** \item A function \texttt{addDecls} which returns the module resulting from
***       adding all the declarations in the module passed as second argument 
***       to the module passed as first argument.
 
  op addDecls : Module Module -> Module .

*** \end{itemize}

*** Note that some of the `set' and `add' functions are partial functions.

  var  M : Module .
  vars QI V : Qid .
  var  S : Sort .
  vars SSDS SSDS' SSDS'' : SubsortDeclSet .
  vars OPD OPD' : OpDecl .
  vars OPDS OPDS' : OpDeclSet .
  var  OPDS? : [OpDeclSet] .
  var  At : Attr .
  vars MAS MAS' : MembAxSet .
  vars EqS EqS' : EquationSet .
  vars RlS RlS' : RuleSet .
  vars SS SS' : SortSet .
  vars IL IL' : ImportList .
  vars QIL QIL' : QidList .
  vars PL PL' : ParameterList .
  vars CDS CDS' : ClassDeclSet .
  vars SCD SCD' : SubclassDecl .
  vars SCDS SCDS' : SubclassDeclSet .
  vars U U' : Module .
  vars MDS MDS' : MsgDeclSet .
  vars I I' : Import .
  var  T : Term .
  vars ME ME' : ModuleExpression .
  vars PD PD' : ParameterDecl .
  vars PDL PDL' : ParameterDeclList .
  var  H : Header .
  vars MN MN' : ModuleName .

  eq I in (IL I IL') = true .
  eq I in IL = false [owise] .

  op theory : Module -> Bool .
  eq theory(unitError(QIL)) = false .
  eq theory(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = false .
  eq theory(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = true .
  eq theory(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = false .
  eq theory(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) = true .
  eq theory(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 
    = false .
  eq theory(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 
    = true .

*** Selection functions for units

  eq getName(unitError(QIL)) = ' .
  eq getName(noModule) = ' .
  eq getName(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = ME .
  eq getName(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = ME .
  eq getName(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = MN .
  ----eq getName(th PD is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = PD .
  eq getName(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm) = ME .
  eq getName(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm) = ME .
  eq getName(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) = MN .
  eq getName(
       omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 
    = ME .
  eq getName(
       omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 
    = ME .
  eq getName(
       oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 
    = MN .

  eq getImports(unitError(QIL)) = nil .
  eq getImports(noModule) = nil .
  eq getImports(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = IL .
  eq getImports(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = IL .
  eq getImports(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = IL .
  eq getImports(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = IL .
  eq getImports(
       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 
    = IL .
  eq getImports(
       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 
    = IL .

  eq getPars(unitError(QIL)) = nil .
  eq getPars(noModule) = nil .
  eq getPars(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = nil .
  eq getPars(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = PDL .
  eq getPars(mod nullHeader is IL sorts SS . SSDS OPDS MAS EqS RlS endm) 
    = nil .
  eq getPars(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = nil .
  eq getPars(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = nil .
  eq getPars(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm) = nil .
  eq getPars(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm) = PDL .
  eq getPars(fmod nullHeader is IL sorts SS . SSDS OPDS MAS EqS endfm) = nil .
  eq getPars(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) = nil .
  eq getPars(
       omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 
    = nil .
  eq getPars(
        omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS 
        endom) 
    = PDL .
  eq getPars(
        omod nullHeader is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS 
        endom) 
    = nil .
  eq getPars(
       oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 
    = nil .

  eq getSorts(unitError(QIL)) = none .
  eq getSorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = SS .
  eq getSorts(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = SS .
  eq getSorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = SS .
  eq getSorts(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = SS .
  eq getSorts(
       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 
    = SS .
  eq getSorts(
       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 
    = SS .

  op getAllSorts : Module -> SortSet .
  eq getAllSorts(M) = getSorts(M) .

  eq getSubsorts(unitError(QIL)) = none .
  eq getSubsorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = SSDS .
  eq getSubsorts(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = SSDS .
  eq getSubsorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = SSDS .
  eq getSubsorts(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = SSDS .
  eq getSubsorts(
       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 
    = SSDS .
  eq getSubsorts(
       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
    = SSDS .
   
  eq getOps(unitError(QIL)) = none .
  eq getOps(noModule) = none .
  eq getOps(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = OPDS .
  eq getOps(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = OPDS .
  eq getOps(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = OPDS .
  eq getOps(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = OPDS .
  eq getOps(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 
    = OPDS .
  eq getOps(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 
    = OPDS .
   
  eq getMbs(unitError(QIL)) = none .
  eq getMbs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = MAS .
  eq getMbs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = MAS .
  eq getMbs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = MAS .
  eq getMbs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = MAS .
  eq getMbs(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 
    = MAS .
  eq getMbs(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 
    = MAS .
   
  eq getEqs(unitError(QIL)) = none .
  eq getEqs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = EqS .
  eq getEqs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = EqS .
  eq getEqs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = EqS .
  eq getEqs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = EqS .
  eq getEqs(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 
    = EqS .
  eq getEqs(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 
    = EqS .
   
  eq getRls(unitError(QIL)) = none .
  eq getRls(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = RlS .
  eq getRls(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = RlS .
  eq getRls(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none .
  eq getRls(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none .
  eq getRls(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 
    = RlS .
  eq getRls(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 
    = RlS .
   
  eq getClasses(unitError(QIL)) = none .
  eq getClasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = none .
  eq getClasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = none .
  eq getClasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none .
  eq getClasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none .
  eq getClasses(
       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
    = CDS .
  eq getClasses(
       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 
    = CDS .

  eq getSubclasses(unitError(QIL)) = none .
  eq getSubclasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = none .
  eq getSubclasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = none .
  eq getSubclasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none .
  eq getSubclasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none .
  eq getSubclasses(
       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
    = SCDS .
  eq getSubclasses(
       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
    = SCDS .

  eq getMsgs(unitError(QIL)) = none .
  eq getMsgs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = none .
  eq getMsgs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = none .
  eq getMsgs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none .
  eq getMsgs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none .
  eq getMsgs(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) 
    = MDS .
  eq getMsgs(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) 
    = MDS .

*** Set functions

  eq setImports(unitError(QIL), IL) = unitError(QIL) .
  eq setImports(noModule, IL) = noModule .
  eq setImports(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, IL')
    = mod H is IL' sorts SS . SSDS OPDS MAS EqS RlS endm .
  eq setImports(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, IL')
    = th H is IL' sorts SS . SSDS OPDS MAS EqS RlS endth .
  eq setImports(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, IL')
    = fmod H is IL' sorts SS . SSDS OPDS MAS EqS endfm .
  eq setImports(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, IL')
    = fth H is IL' sorts SS . SSDS OPDS MAS EqS endfth .
  eq setImports(
       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, IL')
    = omod H is IL' sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom .
  eq setImports(
       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, IL')
    = oth H is IL' sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth .

  eq setOps(unitError(QIL), OPDS) = unitError(QIL) .
  eq setOps(noModule, OPDS) = noModule .
  eq setOps(U, opDeclError(QIL) OPDS) = unitError(QIL) .
  eq setOps(unitError(QIL), opDeclError(QIL') OPDS) = unitError(QIL QIL') .
  eq setOps(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, OPDS')
    = mod H is IL sorts SS . SSDS OPDS' MAS EqS RlS endm .
  eq setOps(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, OPDS')
    = th MN is IL sorts SS . SSDS OPDS' MAS EqS RlS endth .
  eq setOps(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, OPDS')
    = fmod H is IL sorts SS . SSDS OPDS' MAS EqS endfm .
  eq setOps(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, OPDS')
    = fth MN is IL sorts SS . SSDS OPDS' MAS EqS endfth .
  eq setOps(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 
       OPDS')
    = omod H is IL sorts SS . SSDS CDS SCDS OPDS' MDS MAS EqS RlS endom .
  eq setOps(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 
       OPDS')
    = oth MN is IL sorts SS . SSDS CDS SCDS OPDS' MDS MAS EqS RlS endoth .

  eq setSubsorts(unitError(QIL), SSDS) = unitError(QIL) .
  eq setSubsorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SSDS')
    = mod H is IL sorts SS . SSDS' OPDS MAS EqS RlS endm . 
  eq setSubsorts(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, SSDS')
    = th MN is IL sorts SS . SSDS' OPDS MAS EqS RlS endth .
  eq setSubsorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, SSDS')
    = fmod H is IL sorts SS . SSDS' OPDS MAS EqS endfm .
  eq setSubsorts(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, SSDS')
    = fth MN is IL sorts SS . SSDS' OPDS MAS EqS endfth .
  eq setSubsorts(
       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 
       SSDS')
    = omod H is IL sorts SS . SSDS' CDS SCDS OPDS MDS MAS EqS RlS endom .
  eq setSubsorts(
       oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 
       SSDS')
    = oth MN is IL sorts SS . SSDS' CDS SCDS OPDS MDS MAS EqS RlS endoth . 

  eq setMbs(unitError(QIL), membAxError(QIL') MAS) = unitError(QIL QIL') .
  eq setMbs(unitError(QIL), MAS) = unitError(QIL) .
  eq setMbs(U, membAxError(QIL) MAS) = unitError(QIL) .
  eq setMbs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, MAS')
    = mod H is IL sorts SS . SSDS OPDS MAS' EqS RlS endm .
  eq setMbs(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MAS')
    = th MN is IL sorts SS . SSDS OPDS MAS' EqS RlS endth .
  eq setMbs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, MAS')
    = fmod H is IL sorts SS . SSDS OPDS MAS' EqS endfm .
  eq setMbs(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, MAS')
    = fth MN is IL sorts SS . SSDS OPDS MAS' EqS endfth .
  eq setMbs(
       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, MAS')
    = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS' EqS RlS endom .
  eq setMbs(
       oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, MAS')
    = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS' EqS RlS endoth .

  eq setEqs(unitError(QIL), EqS) = unitError(QIL) .
  eq setEqs(U, equationError(QIL) EqS?:[EquationSet]) = unitError(QIL) .
  eq setEqs(unitError(QIL), equationError(QIL') EqS?:[EquationSet]) 
    = unitError(QIL QIL') .
  eq setEqs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, EqS')
    = mod H is IL sorts SS . SSDS OPDS MAS EqS' RlS endm .
  eq setEqs(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, EqS')
    = th MN is IL sorts SS . SSDS OPDS MAS EqS' RlS endth .
  eq setEqs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, EqS')
    = fmod H is IL sorts SS . SSDS OPDS MAS EqS' endfm .
  eq setEqs(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, EqS')
    = fth MN is IL sorts SS . SSDS OPDS MAS EqS' endfth .
  eq setEqs(
       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, EqS')
    = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS' RlS endom .
  eq setEqs(
       oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, EqS')
    = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS' RlS endoth .

  var U? : [Module] .
  var RlS? : [RuleSet] .

  eq setRls(unitError(QIL), RlS?) = unitError(QIL) .
  eq setRls(U?, ruleError(QIL) RlS?) = unitError(QIL) .
  eq setRls(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, RlS')
    = mod H is IL sorts SS . SSDS OPDS MAS EqS RlS' endm .
  eq setRls(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, RlS')
    = th MN is IL sorts SS . SSDS OPDS MAS EqS RlS' endth .
  eq setRls(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, RlS)
    = if RlS == none 
      then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm
      else mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm
      fi .
  eq setRls(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, RlS)
    = if RlS == none 
      then fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth
      else th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth
      fi .
  eq setRls(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom,
       RlS')
    = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS' endom .
  eq setRls(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth,
       RlS')
    = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS' endoth .

  eq setSorts(unitError(QIL), SS) = unitError(QIL) .
  eq setSorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SS')
    = mod H is IL sorts SS' . SSDS OPDS MAS EqS RlS endm .
  eq setSorts(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, SS')
    = th MN is IL sorts SS' . SSDS OPDS MAS EqS RlS endth .
  eq setSorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, SS')
    = fmod H is IL sorts SS' . SSDS OPDS MAS EqS endfm .
  eq setSorts(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, SS')
    = fth MN is IL sorts SS' . SSDS OPDS MAS EqS endfth .
  eq setSorts(
        omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, SS')
    = omod H is IL sorts SS' . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom .
  eq setSorts(
        oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, SS')
    = oth MN is IL sorts SS' . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth .

  eq setPars(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm, PDL)
    = if PDL == nil
      then mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm
      else mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm 
      fi .
  eq setPars(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm, PDL')
    = if PDL' == nil 
      then mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm
      else mod ME{PDL'} is IL sorts SS . SSDS OPDS MAS EqS RlS endm 
      fi .
  eq setPars(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, PDL)
    = th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth .
  eq setPars(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm, PDL)
    = if PDL == nil 
      then fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm
      else fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm 
      fi .
  eq setPars(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm, PDL')
    = if PDL' == nil 
      then fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm
      else fmod ME{PDL'} is IL sorts SS . SSDS OPDS MAS EqS endfm 
      fi .
  eq setPars(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, PDL)
    = fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth .
  eq setPars(
        omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 
        PDL)
    = if PDL == nil
      then omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom
      else omod ME{PDL} is 
             IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS 
           endom 
      fi .
  eq setPars(
       omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 
       PDL')
    = if PDL' == nil  
      then omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom
      else omod ME{PDL'} is 
             IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS 
           endom 
      fi .
  eq setPars(
        oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 
        PDL)
    = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth .

  eq setClasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, CDS)
    = if CDS == none
      then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm
      else omod H is IL sorts SS . SSDS CDS none OPDS none MAS EqS none endom 
      fi .
  eq setClasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, CDS)
    = if CDS == none
      then fth H is IL sorts SS . SSDS OPDS MAS EqS endfth
      else oth H is IL sorts SS . SSDS CDS none OPDS none MAS EqS none endoth 
      fi .
  eq setClasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, CDS)
    = if CDS == none
      then mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm
      else omod H is IL sorts SS . SSDS CDS none OPDS none MAS EqS RlS endom 
      fi .
  eq setClasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, CDS)
    = if CDS == none
      then th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth
      else oth H is IL sorts SS . SSDS CDS none OPDS none MAS EqS RlS endoth 
      fi .
  eq setClasses(
        omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 
        CDS')
    = omod H is IL sorts SS . SSDS CDS' SCDS OPDS MDS MAS EqS RlS endom .
  eq setClasses(
        oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 
        CDS')
    = oth H is IL sorts SS . SSDS CDS' SCDS OPDS MDS MAS EqS RlS endoth .
  eq setClasses(M, CDS) 
    = unitError(header2QidList(getName(M)) 'not 'an 'object-oriented 'module) 
    [owise] .

  eq setSubclasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, SCDS)
    = if SCDS == none 
      then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm
      else omod H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS none endom 
      fi .
  eq setSubclasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, SCDS)
    = if SCDS == none 
      then fth H is IL sorts SS . SSDS OPDS MAS EqS endfth
      else oth H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS none endoth
      fi .
  eq setSubclasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SCDS)
    = if SCDS == none 
      then mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm
      else omod H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS RlS endom 
      fi .
  eq setSubclasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, SCDS)
    = if SCDS == none 
      then th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth
      else oth H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS RlS endoth
      fi .
  eq setSubclasses(
       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, SCDS')
    = omod H is IL sorts SS . SSDS CDS SCDS' OPDS MDS MAS EqS RlS endom .
  eq setSubclasses(
       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth,
       SCDS')
    = oth H is IL sorts SS . SSDS CDS SCDS' OPDS MDS MAS EqS RlS endoth .
  eq setSubclasses(M, SCDS) 
    = unitError(header2QidList(getName(M)) 'not 'an 'object-oriented 'module) 
    [owise] .

  eq setMsgs(
       fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, MDS)
    = if MDS == none 
      then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm
      else omod H is IL sorts SS . SSDS none none OPDS MDS MAS EqS none endom 
      fi .
  eq setMsgs(
       fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, MDS)
    = if MDS == none 
      then fth H is IL sorts SS . SSDS OPDS MAS EqS endfth
      else oth H is IL sorts SS . SSDS none none OPDS MDS MAS EqS none endoth 
      fi .
  eq setMsgs(
       mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, MDS)
    = if MDS == none 
      then mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm
      else omod H is IL sorts SS . SSDS none none OPDS MDS MAS EqS RlS endom 
      fi .
  eq setMsgs(
       th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MDS)
    = if MDS == none 
      then th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth
      else oth H is IL sorts SS . SSDS none none OPDS MDS MAS EqS RlS endoth 
      fi .
  eq setMsgs(
       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, MDS')
    = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS' MAS EqS RlS endom .
  eq setMsgs(
       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, MDS')
    = oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS' MAS EqS RlS endoth .
  eq setMsgs(M, MDS) 
    = unitError(header2QidList(getName(M)) 'not 'an 'object-oriented 'module) 
    [owise] .

  eq setName(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm, ME') 
    = mod ME' is IL sorts SS . SSDS OPDS MAS EqS RlS endm .
  eq setName(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm, ME') 
    = mod ME'{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm .
  eq setName(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm, ME') 
    = fmod ME' is IL sorts SS . SSDS OPDS MAS EqS endfm .
  eq setName(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm, ME') 
    = fmod ME'{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm .
  eq setName(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, MN') 
    = fth MN' is IL sorts SS . SSDS OPDS MAS EqS endfth .
  eq setName(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MN') 
    = th MN' is IL sorts SS . SSDS OPDS MAS EqS RlS endth .
  eq setName(
        omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 
        ME') 
    = omod ME' is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom .
  eq setName(
       omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 
       ME') 
    = omod ME'{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom .
  eq setName(
        oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 
        MN') 
    = oth MN' is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth .
  eq setName(noModule, ME) = noModule .
  eq setName(unitError(QIL), ME) = unitError(QIL) .

  eq setName(mod nullHeader is IL sorts SS . SSDS OPDS MAS EqS RlS endm, ME') 
    = mod ME' is IL sorts SS . SSDS OPDS MAS EqS RlS endm .
  eq setName(fmod nullHeader is IL sorts SS . SSDS OPDS MAS EqS endfm, ME') 
    = fmod ME' is IL sorts SS . SSDS OPDS MAS EqS endfm .
  eq setName(fth nullHeader is IL sorts SS . SSDS OPDS MAS EqS endfth, MN) 
    = fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth .
  eq setName(th nullHeader is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MN) 
    = th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth .
  eq setName(
       omod nullHeader is 
         IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS 
       endom, 
       ME') 
    = omod ME' is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom .
  eq setName(
       oth nullHeader is 
         IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 
       MN) 
    = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth .
  eq setName(noModule, ME) = noModule .
  eq setName(unitError(QIL), ME) = unitError(QIL) .

*** Add functions

  eq addSorts(SS, U) = setSorts(U, (SS ; getSorts(U))) .
  eq addSorts(SS, unitError(QIL)) = unitError(QIL) .

  eq addSubsorts(SSDS, U) = setSubsorts(U, (SSDS getSubsorts(U))) .
  eq addSubsorts(subsortDeclError(QIL), U) = unitError(QIL) .
  eq addSubsorts(SSDS, unitError(QIL)) = unitError(QIL) .
  
  eq addOps(OPDS, U) = setOps(U, (OPDS getOps(U))) .
  eq addOps(OPDS?, unitError(QIL)) = unitError(QIL) .
  eq addOps(OPDS?, U) = U [owise] .

  eq addMbs(MAS, U) = setMbs(U, (MAS getMbs(U))) .
  eq addMbs(MAS, unitError(QIL)) = unitError(QIL) .
  eq addEqs(EqS, U) = setEqs(U, (EqS getEqs(U))) .
  eq addEqs(EqS, unitError(QIL)) = unitError(QIL) .
  eq addRls(RlS, U) = setRls(U, (RlS getRls(U))) .
  eq addRls(RlS, unitError(QIL)) = unitError(QIL) .
  eq addImports(IL, U) = setImports(U, (getImports(U) IL)) .
  eq addImports(IL, unitError(QIL)) = unitError(QIL) .
  eq addClasses(CDS, U) = setClasses(U, (getClasses(U) CDS)) .
  eq addClasses(CDS, unitError(QIL)) = unitError(QIL) .
  eq addSubclasses(SCDS, U) = setSubclasses(U, (getSubclasses(U) SCDS)) .
  eq addSubclasses(SCDS, unitError(QIL)) = unitError(QIL) .
  eq addMsgs(MDS, U) = setMsgs(U, (getMsgs(U) MDS)) .
  eq addMsgs(MDS, unitError(QIL)) = unitError(QIL) .

*** Creation of empty units

  eq emptyFModule(ME) 
    = fmod header2Qid(ME) is nil sorts none . none none none none endfm .
  eq emptyFModule 
    = fmod nullHeader is nil sorts none . none none none none endfm .
  eq emptySModule
    = mod nullHeader is nil sorts none . none none none none none endm . 
  eq emptyOModule
    = omod nullHeader is 
        nil sorts none . none none none none none none none none
      endom . 
  eq emptyFTheory
    = fth nullHeader is nil sorts none . none none none none endfth .
  eq emptySTheory
    = th nullHeader is nil sorts none . none none none none none endth .
  eq emptyOTheory
    = oth nullHeader is
         nil sorts none . none none none none none none none none
      endoth .

*** \texttt{empty} returns an empty unit of the same type of the one given as 
*** argument.
  
  eq empty(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm)
    = (mod H is nil sorts none . none none none none none endm) .
  eq empty(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth)
    = (th MN is nil sorts none . none none none none none endth) .
  eq empty(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm)
    = (fmod H is nil sorts none . none none none none endfm) .
  eq empty(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth)
    = (fth MN is nil sorts none . none none none none endfth) .
  eq empty(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
    = (omod H is 
         nil sorts none . none none none none none none none none 
       endom) .
  eq empty(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
    = (oth MN is 
         nil sorts none . none none none none none none none none 
       endoth) .

*** In the following \texttt{addDecls} function, the declarations of the unit
*** given as second argument are added to the unit given as first argument.

  eq addDecls(noModule, U) = U .
  eq addDecls(U, noModule) = U .
  eq addDecls(unitError(QIL), U) = unitError(QIL) .
  eq addDecls(U, unitError(QIL)) = unitError(QIL) .
  eq addDecls(U, U')
    = addImports(getImports(U'),
        addSorts(getSorts(U'),
          addSubsorts(getSubsorts(U'),
            addOps(getOps(U'),
              addMbs(getMbs(U'),
                addEqs(getEqs(U'), 
                  if U' :: FModule or U' :: FTheory
                  then U
                  else addRls(getRls(U'), 
                         if U' :: SModule or U' :: STheory
                         then U
                         else addClasses(getClasses(U'),
                                addSubclasses(getSubclasses(U'),
                                  addMsgs(getMsgs(U'), U)))
                         fi)
                  fi))))))
    [owise] .
endfm

*** To parse some input using the built-in function \texttt{metaParse}, we
*** need to give the metarepresentation of the signature in which the input is 
*** going to be parsed.

*** But we do not need to give the complete metarepresentation of such a
*** module. In modules including \texttt{META-LEVEL} it is possible to define 
*** terms of sort \texttt{Module} that import built-in modules or any module 
*** introduced at the ``object level'' of Core Maude. In this way, it is 
*** possible to get the equivalent effect of having the explicit 
*** metarepresentation of a module by declaring a constant and adding an 
*** equation identifying such a constant with the metarepresentation of an 
*** extended module that imports the original module at the object level.

*** The declaration of constructors for bubble sorts at the object level is 
*** not supported in the current version of Core Maude. The \texttt{special} 
*** attributes linking the constructors for the bubble sorts to the built-in 
*** ones are only supported at the metalevel, that is, the declarations of the 
*** constructor operators for bubble sorts have to be given in the 
*** metarepresentation of a module.

*** To allow the greatest generality and flexibility in future extensions of
*** Full Maude, we have declared its signature as a module
*** \texttt{FULL-MAUDE-SIGN}. Then, in the following module 
*** \texttt{META-FULL-MAUDE-SIGN} we declare a constant \texttt{GRAMMAR} of 
*** sort \texttt{FModule}, and we give an equation identifying such constant 
*** with the metarepresentation of a module \texttt{GRAMMAR} in which there is 
*** a declaration importing \texttt{FULL-MAUDE-SIGN}. Declarations for the 
*** constructors of the bubble sorts are also included in this module. Note 
*** that the bubble sorts \texttt{@Token@}, \texttt{@Bubble@}, 
*** \texttt{@SortToken@}, and \texttt{@NeTokenList@} are declared in the 
*** module \texttt{SIGN\&VIEW-EXPR}, which is imported by 
*** \texttt{FULL-MAUDE-SIGN}. These sorts are used in the declarations 
*** describing the syntax of the system.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod META-FULL-MAUDE-SIGN is
  including META-LEVEL .
  including UNIT .

  op BUBBLES : -> FModule .
  op GRAMMAR : -> FModule [memo] .

  eq BUBBLES
    = (fmod 'GRAMMAR is
        including 'QID-LIST .
        sorts none .
        none
        op 'token : 'Qid -> '@Token@ 
             [special(
               (id-hook('Bubble, '1 '1)
                op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] .
        op 'viewToken : 'Qid -> '@ViewToken@ 
             [special(
               (id-hook('Bubble, '1 '1)
                op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] .
        op 'sortToken : 'Qid -> '@SortToken@ 
             [special(
               (id-hook('Bubble, '1 '1)
                op-hook('qidSymbol, '<Qids>, nil, 'Qid)
                id-hook('Exclude, '`[ '`] '< 'to '`, '. '`( '`) '`{ '`} ':
                                  'ditto 'precedence 'prec 'gather
                                  'assoc 'associative 'comm 'commutative 
                                  'ctor 'constructor 'id: 'strat 'strategy 
                                  'poly 'memo 'memoization 'iter 'frozen
                                  'config 'object 'msg)))] .
        op 'neTokenList : 'QidList -> '@NeTokenList@ 
             [special(
               (id-hook('Bubble, '1 '-1 '`( '`))
                op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList)
                op-hook('qidSymbol, '<Qids>, nil, 'Qid)
                id-hook('Exclude, '.)))] .
        op 'bubble : 'QidList -> '@Bubble@ 
             [special(
               (id-hook('Bubble, '1 '-1 '`( '`))
                op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList)
                op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] .
        none
        none
     endfm) .
     
  eq GRAMMAR = addImports((including 'FULL-MAUDE-SIGN .), BUBBLES) .

endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------


*** The \texttt{GRAMMAR} module will be used in calls to the \texttt{metaParse}
*** function in order to get the input parsed in this signature. Note that
*** this module is not the data type in which we shall represent the inputs.
*** From the call to \texttt{metaParse} we shall get a term representing the
*** parse tree of the input. This term will then be transformed into terms of 
*** other appropriate data types if necessary.

*** Future extensions to Full Maude will require extending the signature as
*** well. The addition of new commands, new module expressions, or additions
*** of any other kind will require adding new declarations to the present Full
*** Maude signature and defining the corresponding extensions to the data
*** types and functions to deal with the new cases introduced by the
*** extensions. 

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** The Abstract Data Type \texttt{View}
***

*** In this section we present the data type \texttt{View} for views.
*** Basically, the data elements of sort \texttt{View} are composed by the
*** name of the view, the names of the source and target units, and a set of
*** maps representing the maps asserting how the given target unit is claimed 
*** to satisfy the source theory (see Section~\ref{Views}).

*** Internally, renaming maps are considered to be a particular case of view
*** maps. The sort \texttt{ViewMap} is declared as a supersort of
*** \texttt{Map}. The only kind of maps in sort \texttt{ViewMap} not in sort
*** \texttt{Map} are maps of operators going to derived operators. We start
*** introducing the declarations for renaming maps and sTS of renaming maps
*** in Section~\ref{renaming-maps}, we then introduce view maps and sTS of
*** view maps in Section~\ref{view-maps}, and finally we introduce the sort 
*** \texttt{View}, its constructor, and some operations on it in 
*** Section~\ref{viewADT}.

***
*** View Maps
***

*** In addition to the maps of sort \texttt{Renaming}, 
*** in views there can also be maps from operators to derived
*** operators, that is, terms with variables (see Section~\ref{Views}). Maps
*** of this kind are given with the constructor \texttt{termMap}, which, in
*** addition to the source and target terms, takes the set of variable
*** declarations for the variables used in the map. The source term must be of
*** the form $\texttt{F(X}_1\texttt{,}\ldots,\texttt{X}_n\texttt{)}$, where
*** \texttt{F} is an operator name declared with $n$ arguments of sorts in the
*** connected components of the variables $\texttt{X}_1\ldots\texttt{X}_n$,
*** respectively. We will see in Section~\ref{view-processing} how in the 
*** initial processing of a view the variables declared in it are associated 
*** to each of the maps in which they are used.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod VIEW-MAP is
  pr FMAP .
  pr EXT-DECL .

  op termMap : Term Term -> ViewMap .

  sorts ViewMap Set{ViewMap} .
  subsorts Renaming < ViewMap .
  subsorts ViewMap RenamingSet < Set{ViewMap} .
  op _`,_ : Set{ViewMap} Set{ViewMap} -> Set{ViewMap} [ditto] .

  eq (VMAP, none) = VMAP .
  eq (VMAP, VMAP) = VMAP .

  var  MAP : Renaming .
  var  VMAP : ViewMap .
  var  VMAPS : Set{ViewMap} .
  vars T T' : Term . 
  vars S S' : Sort .

*** As for sTS of maps, \texttt{SortRenamingSet} returns the subset of sort 
*** maps in a set of view maps.

  op sortMaps : Set{ViewMap} -> RenamingSet .

  eq sortMaps((sort S to S')) = (sort S to S') .
  eq sortMaps(((sort S to S'), VMAPS)) = ((sort S to S'), sortMaps(VMAPS)) .
  eq sortMaps(VMAP) = none [owise] .
  eq sortMaps((VMAP, VMAPS)) = none [owise] .
  eq sortMaps(none) = none .

endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** Views
***

*** The \texttt{View} sort is introduced in the following module
*** \texttt{VIEW}.  In addition to the constructor for views (\texttt{view}),
*** selector functions are added for each of the components of a
*** view (\texttt{name}, \texttt{source}, \texttt{target}, and 
*** \texttt{mapSet}), and a constant \texttt{emptyView}, which is identified 
*** in an equation with the empty view, is defined.

*** Although the declaration of the constructor for views includes an argument
*** for the list of parameters, parameterized views are not handled yet, so at
*** present this argument must be set to the \texttt{nil}.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod VIEW is
  pr META-MODULE .
  pr VIEW-EXPR .
  pr VIEW-MAP .

  sorts View ViewHeader .
  subsort ViewExp Header < ViewHeader .
  op view_from_to_is_endv : 
       ViewHeader ModuleExpression ModuleExpression Set{ViewMap} -> View 
       [ctor format (nir! o r! o r! o r! o r! o)] .
  op null : -> View [ctor] .
  op viewError : QidList -> [View] [ctor format (r o)] .

  eq VE{(nil).ParameterDeclList} = VE .

  var  QI : Qid .
  vars VE VE' : ViewExp .
  vars PDL PDL' : ParameterDeclList .
  vars ME ME' ME'' : ModuleExpression .
  vars VMAPS VMAPS' : Set{ViewMap} .
  var  QIL : QidList .
  var  VH : ViewHeader .

  op name : View -> ViewExp .
  op getPars : [View] -> ParameterDeclList .
  op source : View -> ModuleExpression .
  op target : View -> ModuleExpression .
  op mapSet : View -> RenamingSet .

  eq name(view VE from ME to ME' is VMAPS endv) = VE .
  eq name(view VE{PDL} from ME to ME' is VMAPS endv) = VE .
  eq getPars(view VE from ME to ME' is VMAPS endv) = nil .
  eq getPars(view VE{PDL} from ME to ME' is VMAPS endv) = PDL .
  eq getPars(viewError(QIL)) = nil .
  eq source(view VH from ME to ME' is VMAPS endv) = ME .
  eq target(view VH from ME to ME' is VMAPS endv) = ME' .
  eq mapSet(view VH from ME to ME' is VMAPS endv) = VMAPS .

  op setName : View ViewExp ~> View .
  op setPars : View ParameterDeclList ~> View .
  op setTarget : View ModuleExpression ~> View .
  op sTSource : View ModuleExpression ~> View .
  op setMaps : View RenamingSet ~> View .

  eq setName(view VE from ME to ME' is VMAPS endv, VE') 
    = view VE' from ME to ME' is VMAPS endv .
  eq setName(view VE{PDL} from ME to ME' is VMAPS endv, VE') 
    = view VE'{PDL} from ME to ME' is VMAPS endv .
  eq setName(viewError(QIL), VE) = viewError(QIL) .

  eq setPars(view VE from ME to ME' is VMAPS endv, PDL) 
    = view VE{PDL} from ME to ME' is VMAPS endv .
  eq setPars(view VE{PDL} from ME to ME' is VMAPS endv, PDL') 
    = view VE{PDL'} from ME to ME' is VMAPS endv .
  eq setPars(viewError(QIL), PDL) = viewError(QIL) .

  eq sTSource(view VH from ME to ME' is VMAPS endv, ME'') 
    = view VH from ME'' to ME' is VMAPS endv .
  eq sTSource(viewError(QIL), ME) = viewError(QIL) .

  eq setTarget(view VH from ME to ME' is VMAPS endv, ME'') 
    = view VH from ME to ME'' is VMAPS endv .
  eq setTarget(viewError(QIL), ME) = viewError(QIL) .

  eq setMaps(view VH from ME to ME' is VMAPS endv, VMAPS') 
    = view VH from ME to ME' is VMAPS' endv .
  eq setMaps(viewError(QIL), VMAPS) = viewError(QIL) .

  op emptyView : Qid ModuleExpression ModuleExpression -> View .

  eq emptyView(QI, ME, ME') = view QI from ME to ME' is none endv .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** The Abstract Data Type \texttt{Database}
***

*** In this section we present the data type \texttt{Database}, which will be
*** used to store information about the units and views in the system. Before
*** discussing this data type in Section~\ref{databaseADT}, we present the
*** predefined units added in Full Maude to those already available in Core 
*** Maude.

*** 
*** Non-Built-In Predefined Modules
***

*** As we shall see in the following section, except for the
*** \texttt{LOOP-MODE} module, all the predefined modules that are available
*** in Core Maude are also available in Full Maude. In addition to these Core
*** Maude predefined modules, in Full Maude there are some additional
*** predefined units. In the present system, the only units with which the
*** database is initialized are the functional theory \texttt{TRIV}, the
*** module \texttt{CONFIGURATION}, and the module \texttt{UP}, which will be 
*** used to evaluate the \texttt{up} functions. We shall see in 
*** Section~\ref{main-module} how new predefined modules can be added to the 
*** initial database.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod PREDEF-UNITS is
  pr UNIT .

*** The following module \texttt{UP} contains the necessary declarations to
*** be able to parse the \texttt{up} functions presented in
*** Section~\ref{structured-specifications}. We shall see in
*** Section~\ref{evaluation} how a declaration importing the following module
*** \texttt{UP} is added to all the modules importing the predefined module
*** \texttt{META-LEVEL}. With this declaration, it is possible to parse the
*** \texttt{up} commands in the bubbles of such modules or in commands being 
*** evaluated in such modules. We shall see in Section~\ref{bubble-parsing} 
*** how these commands are then evaluated.

  op #UP# : -> FModule [memo] .
  eq #UP#
    = (fmod '#UP# is
        including 'QID-LIST .
        including 'MOD-EXPRS .
        sorts none .
        none
        op 'upTerm : '@ModExp@ '@Bubble@ -> 'Term [none] .
        op 'upModule : '@ModExp@ -> 'Module [none] .
        op '`[_`] : '@Token@ -> 'Module [none] .
        op 'token : 'Qid -> '@Token@ 
             [special(
               (id-hook('Bubble, '1 '1)
                op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] .
        op 'viewToken : 'Qid -> '@ViewToken@ 
             [special(
               (id-hook('Bubble, '1 '1)
                op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] .
        op 'sortToken : 'Qid -> '@SortToken@ 
             [special(
               (id-hook('Bubble, '1 '1)
                op-hook('qidSymbol, '<Qids>, nil, 'Qid)
                id-hook('Exclude, '`[ '`] '< 'to '`, '. '`( '`) '`{ '`} ':
                                  'ditto 'precedence 'prec 'gather
                                  'assoc 'associative 'comm 'commutative 
                                  'ctor 'constructor 'id: 'strat 'strategy 
                                  'poly 'memo 'memoization 'iter 'frozen
                                  'config 'object 'msg)))] .
        op 'neTokenList : 'QidList -> '@NeTokenList@ 
             [special(
               (id-hook('Bubble, '1 '-1 '`( '`))
                op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList)
                op-hook('qidSymbol, '<Qids>, nil, 'Qid)
                id-hook('Exclude, '.)))] .
        op 'bubble : 'QidList -> '@Bubble@ 
             [special(
               (id-hook('Bubble, '1 '-1 '`( '`))
                op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList)
                op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] .
        none
        none
     endfm) .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** 7 The Evaluation of Views
***

*** Before being entered into the database, besides containing bubbles, views
*** have a somewhat different structure from that of the views given in
*** Section~\ref{viewADT}. We introduce in the following module a sort
*** \texttt{PreView} with constructor \texttt{view}, which is declared as the
*** constructor for views of sort \texttt{View}, but with an additional
*** argument, namely, a set of variable declarations to hold the declarations
*** of variables in the view. During the processing of views (see
*** Section~\ref{view-processing}), which takes place once the parsing process 
*** has concluded, these variables are associated with the corresponding maps 
*** where they are used, generating a term of sort \texttt{View}.

*** We start by introducing in the following module \texttt{PRE-VIEW-MAP} the
*** sorts \texttt{TermPreMap}, \texttt{PreViewMap}, and
*** \texttt{Set{PreViewMap}}. A preview map is a view map with bubbles. Note
*** that the bubbles can only appear in term maps. Elements of sort
*** \texttt{TermPreMap} are built with the constructor \texttt{preTermMap},
*** which takes two terms of sort \texttt{Term}, that is, two bubbles. In the
*** processing of views (see Section~\ref{view-processing}), elements of sort
*** \texttt{PreTermMap} will be converted into elements of sort 
*** \texttt{TermMap} by parsing the bubbles in them, and by associating to 
*** them the variables in them defined in the view in which the maps appear.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod PRE-VIEW-MAP is
  pr VIEW-MAP .

  sort PreViewMap .
  subsorts Renaming < PreViewMap .
  op preTermMap : Term Term -> PreViewMap . 

  sort Set{PreViewMap} .
  subsorts PreViewMap RenamingSet < Set{PreViewMap} .
  op _`,_ : Set{PreViewMap} Set{PreViewMap} -> Set{PreViewMap} [ditto] .

  eq (PVMAPS, none) = PVMAPS .

  var  PVMAP : PreViewMap .
  var  PVMAPS : Set{PreViewMap} .
  vars S S' : Sort .

*** Given a set of maps, the function \texttt{sortMaps} returns the subset 
*** of sort maps in it.

  op sortMaps : Set{PreViewMap} -> RenamingSet .

  eq sortMaps(((sort S to S'), PVMAPS)) = ((sort S to S'), sortMaps(PVMAPS)) .
  eq sortMaps((PVMAP, PVMAPS)) = none [owise] .
  eq sortMaps(none) = none .

endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod PRE-VIEW is
  pr VIEW .
  pr PRE-VIEW-MAP .

  sort PreView .
  op preview_from_to_is__endpv : ViewHeader ModuleExpression 
       ModuleExpression OpDeclSet Set{PreViewMap} -> PreView
       [ctor format (nir! o r! o r! o r! o o r! o)] .
  op null : -> PreView .

  op name : PreView -> ViewExp .
  op getPars : PreView -> ParameterDeclList .
  op source : PreView -> ModuleExpression .
  op target : PreView -> ModuleExpression .
  op vars : PreView -> OpDeclSet .
  op mapSet : PreView -> Set{PreViewMap} .

  var  QI : Qid .
  vars ME ME' : ModuleExpression .
  var  VE : ViewExp .
  var  VH : ViewHeader .
  vars PDL PDL' : ParameterDeclList .
  vars VDS VDS' : OpDeclSet .
  vars PVMAPS PVMAPS' : Set{PreViewMap} .

  eq name(preview VE from ME to ME' is VDS PVMAPS endpv) = VE .
  eq name(preview VE{PDL} from ME to ME' is VDS PVMAPS endpv) = VE .
  eq getPars(preview VE from ME to ME' is VDS PVMAPS endpv) = nil .
  eq getPars(preview VE{PDL} from ME to ME' is VDS PVMAPS endpv) = PDL .
  eq source(preview VH from ME to ME' is VDS PVMAPS endpv) = ME .
  eq target(preview VH from ME to ME' is VDS PVMAPS endpv) = ME' .
  eq vars(preview VH from ME to ME' is VDS PVMAPS endpv) = VDS .
  eq mapSet(preview VH from ME to ME' is VDS PVMAPS endpv) = PVMAPS .

*** The following functions can be used to add new declarations to the set of
*** declarations already in a preview.

  op addMaps : Set{PreViewMap} PreView -> PreView .
  op addVars : OpDeclSet PreView -> PreView .

  eq addMaps(PVMAPS, preview VH from ME to ME' is VDS PVMAPS' endpv) 
    = preview VH from ME to ME' is VDS (PVMAPS, PVMAPS') endpv .

  eq addVars(VDS, preview VH from ME to ME' is VDS' PVMAPS' endpv) 
    = preview VH from ME to ME' is (VDS VDS') PVMAPS' endpv .

  op setPars : PreView ParameterDeclList -> PreView .
  eq setPars(preview VE from ME to ME' is VDS PVMAPS endpv, PDL) 
    = preview VE{PDL} from ME to ME' is VDS PVMAPS endpv .
  eq setPars(preview VE{PDL} from ME to ME' is VDS PVMAPS endpv, PDL')
    = preview VE{PDL'} from ME to ME' is VDS PVMAPS endpv .

  op emptyPreView : Qid ModuleExpression ModuleExpression -> PreView .
  eq emptyPreView(QI, ME, ME') 
    = preview QI from ME to ME' is none none endpv .

endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** The Database
***

*** In order to be able to refer to modules by name, which is extremely useful
*** for module definition purposes at the user level, the evaluation of module
*** expressions takes place in the context of a database, in which we keep
*** information about the modules already introduced in the system, and also
*** about those modules generated internally.  This information is stored as
*** a set of elements of sort \texttt{ModuleInfo} and \texttt{ViewInfo}, in
*** which we hold, respectively, the information concerning units and views. 
*** For each unit we save: 
*** \begin{itemize} 
*** \item Its original form, as introduced by the user, or, in case of an 
***       internally generated unit, as generated from the original form of 
***       some other unit.  
*** \item Its internal representation, in which variables have been renamed 
***       to avoid collisions with the names of variables in other units in 
***       the same hierarchy.  In the case of object-oriented units, we store 
***       its equivalent system module, that is, the result of transforming 
***       it into a system module.  
*** \item Its signature, which is given as a functional module of sort 
***       \texttt{FModule} with no axioms, ready to be used in calls to 
***       \texttt{metaParse}. There can only be importation declarations 
***       including built-in modules in this module. These are the only 
***       inclusions handled by the Core Maude engine.  
*** \item Its flattened version, for which, as for signatures, only the 
***       importation of built-in modules is left unevaluated.  
*** \end{itemize} 
*** For each view we keep its name and the view itself.

*** As a simple mechanism to keep the database consistent, for each unit we
*** maintain the list of names of all the units and views ``depending'' on it.
*** Similarly, for each view we maintain the list of names of all the units
*** ``depending'' on it. The idea is that if a unit or view is redefined or
*** removed, all those units and/or views depending on it will also be
*** removed. This dependency does not only mean direct importation. For
*** example, the module resulting from the renaming of some module also
*** depends on the module being renamed; the instantiation of a parameterized
*** module also depends on the parameterized module and on all the views used
*** in its instantiation; a view depends on its source and target units, etc.
*** This dependency is transitive: if a module, theory, or view has to be
*** removed, all the units and/or views depending on them will be removed as
*** well. The dependencies derived from the module expressions themselves are
*** established by the function \texttt{setUpModExpDeps}. The function
*** \texttt{setUpModuleDeps} calls \texttt{setUpModExpDeps}, 
*** and then \texttt{setUpImportSetDeps} to add the \emph{back 
*** references} in the modules being imported. The function 
*** \texttt{setUpViewDeps} sTS up the back references for the views 
*** being introduced.

*** In addition to this set of information cells for units and views, we also
*** keep lists with the names of all the units and views in the database, and
*** a list of quoted identifiers in which we store the messages generated
*** during the process of treatment of the inputs in order to simplify the 
*** communication with the read-eval-print loop process.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod 2TUPLE{X :: TRIV, Y :: TRIV} is
  sorts Tuple{X, Y} .
  op `(_`,_`) : X$Elt Y$Elt -> Tuple{X, Y} .
  op p1_ : Tuple{X, Y} -> X$Elt .
  op p2_ : Tuple{X, Y} -> Y$Elt .
  eq p1(V1:X$Elt,V2:Y$Elt)
    = V1:X$Elt .
  eq p2(V1:X$Elt,V2:Y$Elt)
    = V2:Y$Elt .
endfm

view ModuleName from TRIV to MOD-NAME is
  sort Elt to ModuleName .
endv

view ViewExp from TRIV to VIEW-EXPR is
  sort Elt to ViewExp .
endv

view ParameterDecl from TRIV to META-MODULE is
  sort Elt to ParameterDecl .
endv

fmod INFO is
  pr VIEW .
  pr DEFAULT-VALUE{Term} .
  pr (SET * (op _`,_ to _._, 
             op empty to emptyModuleNameSet, 
             op insert to insertModuleNameSet,
             op delete to deleteModuleNameSet,
             op _in_ to _inModuleNameSet_,
             op |_| to |_|ModuleNameSet,
             op $card to $cardModuleNameSet,
             op union to unionModuleNameSet,
             op intersection to intersectionModuleNameSet,
             op $intersect to $intersectModuleNameSet,
             op _\_ to _\ModuleNameSet_,
             op $diff to $diffModuleNameSet,
             op _subset_ to _subsetModuleNameSet_,
             op _psubset_ to _psubsetModuleNameSet_)){ModuleName} .
  pr (SET * (op _`,_ to _#_, 
             op empty to emptyViewExpSet, 
             op insert to insertViewExpSet,
             op delete to deleteViewExpSet,
             op _in_ to _inViewExpSet_,
             op |_| to |_|ViewExprSet,
             op $card to $cardViewExprSet,
             op union to unionViewExprSet,
             op intersection to intersectionViewExprSet,
             op $intersect to $intersectViewExprSet,
             op _\_ to _\ViewExprSet_,
             op $diff to $diffViewExprSet,
             op _subset_ to _subsetViewExprSet_,
             op _psubset_ to _psubsetViewExprSet_)){ViewExp} .
  pr (SET * (op _`,_ to _._)){ParameterDecl} .

  var  MN : ModuleName .
  var  MNS : Set{ModuleName} .

  op remove : Set{ModuleName} ModuleName -> Set{ModuleName} .
  eq remove(MN . MNS, MN) = remove(MNS, MN) .
  eq remove(MNS, MN) = MNS [owise] .

  sort ModuleInfo .
  op <_;_;_;_;_;_;_;_> : ModuleName Default{Term} Module Module Module 
       OpDeclSet Set{ModuleName} Set{ViewExp} -> ModuleInfo
     [ctor
      format 
        (nig o g n+++io g nio g nio g nio g nio g nio g nio n---ig o)] .
  op <_;_;_;_;_;_;_;_> : ModuleName Module Module Module Module  
       OpDeclSet Set{ModuleName} Set{ViewExp} -> ModuleInfo
     [ctor
      format 
      (nig ur! g n+++io g nio g nio g nio g nio g nio g nio n---ig o)] .

  *** - Modules can be introduced by the user or can be generated internally.
  ***   When introduced by the user the 2nd arg. keeps the term representation 
  ***   of the module as given, so that it can be recompiled later. If the 
  ***   module is generated internally as the result of the evaluation of a 
  ***   module expression, then this second arg. will be null, the default 
  ***   term value. The user can also enter modules with the procModule 
  ***   function, providing then the metarepresentation of a module, which 
  ***   is directly stored in the database as the 2nd arg. of one of these 
  ***   ModuleInfo units of the second kind. This is useful for the ITP for 
  ***   example, where the interaction with the database takes place at the
  ***   metalevel and the modules given by the "user" are already at the 
  ***   metalevel but still wants the same treatment.
  *** - The sixth arg. stores the variables (corresponding ops.) in the top
  ***   module.

  sort ViewInfo .
  op <_;_;_;_;_> : ViewExp Default{Term} View Set{ModuleName}  
       Set{ViewExp} -> ViewInfo 
       [ctor format (nig o g n+++io g nio g nio g nio n---ig o)] .
  op <_;_;_;_;_> : 
       ViewExp View View Set{ModuleName} Set{ViewExp} -> ViewInfo 
       [ctor format (nig o g n+++io g nio g nio g nio n---ig o)] .

endfm

view ModuleInfo from TRIV to INFO is
  sort Elt to ModuleInfo .
endv

view ViewInfo from TRIV to INFO is
  sort Elt to ViewInfo .
endv

fmod DATABASE-DECLS is
  pr (SET * (op _`,_ to __, op empty to emptyInfoSet)){ModuleInfo} .
  pr (SET * (op _`,_ to __, op empty to emptyInfoSet)){ViewInfo} .

  sort Database .
  op db : 
     Set{ModuleInfo}  *** module info tuples
     Set{ModuleName}  *** names of the modules in the database
     Set{ViewInfo}    *** view info tuples
     Set{ViewExp}     *** names of the views in the db
     Set{ModuleName}  *** modules with set protect on (by default empty)
     Set{ModuleName}  *** modules with set extend on (by default empty)
     Set{ModuleName}  *** modules with set include on (by default empty)
     QidList 
       -> Database 
     [ctor
      format (nib i++o)] .
      
  ops getDefPrs getDefExs getDefIncs : Database -> Set{ModuleName} .
  eq getDefPrs(
        db(MIS:Set{ModuleInfo}, MNS:Set{ModuleName}, VIS:Set{ViewInfo},
           VES:Set{ViewExp}, MNS':Set{ModuleName}, MNS'':Set{ModuleName},
           MNS3:Set{ModuleName}, QIL:QidList)) 
    = MNS':Set{ModuleName} .
  eq getDefExs(
        db(MIS:Set{ModuleInfo}, MNS:Set{ModuleName}, VIS:Set{ViewInfo},
           VES:Set{ViewExp}, MNS':Set{ModuleName}, MNS'':Set{ModuleName},
           MNS3:Set{ModuleName}, QIL:QidList)) 
    = MNS'':Set{ModuleName} .
  eq getDefIncs(
        db(MIS:Set{ModuleInfo}, MNS:Set{ModuleName}, VIS:Set{ViewInfo},
           VES:Set{ViewExp}, MNS':Set{ModuleName}, MNS'':Set{ModuleName},
           MNS3:Set{ModuleName}, QIL:QidList)) 
    = MNS3:Set{ModuleName} .
endfm

view Database from TRIV to DATABASE-DECLS is
  sort Elt to Database .
endv

view ModuleExpression from TRIV to META-MODULE is
  sort Elt to ModuleExpression .
endv

fmod DATABASE is
  pr (2TUPLE * (op `(_`,_`) to <_;_>, 
                op p1_ to database, 
                op p2_ to modExp)) {Database, ModuleExpression} .
  pr PRE-VIEW .
  pr UNIT .
  pr VIEW-EXPR-TO-QID .  

  op evalModule : Module OpDeclSet Database -> Database .
  *** its definition is in the module EVALUATION

  op procModule : Qid Database -> Database .
  op procView : Qid Database -> Database .
  *** their definitions are in the modules UNIT-PROCESSING and VIEW-PROCESSING

  op evalModExp : ModuleExpression Database 
       -> Tuple{Database, ModuleExpression} .
  *** its definition is in the module MOD-EXPR-EVAL 

  vars QI X Y F : Qid .
  vars QIL QIL' : QidList .
  vars NQIL NQIL' : NeQidList .
  vars VE VE' VE'' : ViewExp .
  vars VES VES' VES'' VES3 : Set{ViewExp} .
  vars MIS MIS' : Set{ModuleInfo} .
  var  VIS : Set{ViewInfo} .
  vars MNS MNS' MNS'' MNS3 MNS4 MNS5 MNS6 : Set{ModuleName} .
  vars PL PL' : ParameterList .
  vars PDS PDS' PDS'' : Set{ParameterDecl} .
  var  PDL : ParameterDeclList .
  var  PD : ParameterDecl .
  vars ME ME' : ModuleExpression .
  vars VI VI' : View .
  var  VMAPS : Set{ViewMap} .
  var  PVMAPS : Set{PreViewMap} .
  vars PU PU' U U' U'' U3 U4 : Module .
  var  M : Module .
  var  DB : Database .
  vars IL IL' : ImportList .
  var  VIf : ViewInfo .
  var  UIf : ModuleInfo . 
  vars OPDS VDS VDS' : OpDeclSet .
  var  PV : PreView .
  vars T T' : Term .
  var  DT : Default{Term} .
  var  NL : IntList .
  var  TyL : TypeList .
  var  Ty : Type .
  var  AtS : AttrSet .
  var  B : Bool .
  var  I : Import .
  var  MN MN' : ModuleName .

  ops dincluded : ModuleExpression ImportList -> Bool .

  eq dincluded(ME, IL (protecting ME .) IL') = true .
  eq dincluded(ME, IL (extending ME .) IL') = true .
  eq dincluded(ME, IL (including ME .) IL') = true .
  eq dincluded(ME, IL) = false [owise] .

  ops included includedAux : ModuleExpression ImportList Database -> Bool .

  eq included(ME, IL (protecting ME .) IL', DB) = true .
  eq included(ME, IL (extending ME .) IL', DB) = true .
  eq included(ME, IL (including ME .) IL', DB) = true .
  eq included(ME, nil, DB) = false .
  eq included(ME, IL, DB) = includedAux(ME, IL, DB) [owise] .

  eq includedAux(ME, I IL, DB) 
    = included(ME, getImports(getTopModule(moduleName(I), DB)), DB)
      or-else includedAux(ME, IL, DB) .
  eq includedAux(ME, nil, DB) = false .

  op defImports : Module Database -> ImportList .
  op defImports : ImportList ImportList Set{ModuleName} Set{ModuleName} 
       Set{ModuleName} -> ImportList .

  eq defImports(M, DB) 
    = if theory(M) 
      then nil 
      else defImports(getImports(M), nil,
             getDefPrs(DB), getDefExs(DB), getDefIncs(DB))
      fi .

  eq defImports(IL, IL', MN . MNS, MNS', MNS'') 
    = if dincluded(MN, IL IL')
      then defImports(IL, IL', MNS, MNS', MNS'') 
      else defImports(IL, IL' (protecting MN .), MNS, MNS', MNS'') 
      fi .
  eq defImports(IL, IL', MNS, MN . MNS', MNS'') 
    = if dincluded(MN, IL IL')
      then defImports(IL, IL', MNS, MNS', MNS'') 
      else defImports(IL, IL' (extending MN .), MNS, MNS', MNS'') 
      fi .
  eq defImports(IL, IL', MNS, MNS', MN . MNS'') 
    = if dincluded(MN, IL IL')
      then defImports(IL, IL', MNS, MNS', MNS'') 
      else defImports(IL, IL' (including MN .), MNS, MNS', MNS'') 
      fi .
  eq defImports(IL, IL', 
       emptyModuleNameSet, emptyModuleNameSet, emptyModuleNameSet) 
    = IL' .

*** The constant \texttt{emptyDatabase} denotes the empty database, and there
*** are predicates \texttt{viewInDatabase} and \texttt{unitInDb} to check,
*** respectively, whether a view and a unit are in a database or not.

  op emptyDatabase : -> Database .
  eq emptyDatabase 
    = db(emptyInfoSet, emptyModuleNameSet, emptyInfoSet, emptyViewExpSet, 
         emptyModuleNameSet, emptyModuleNameSet, 'BOOL, nil) .

  op unitInDb : ModuleName Database -> Bool .
  eq unitInDb(MN, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) 
    = MN inModuleNameSet MNS .

  op viewInDb : ViewExp Database -> Bool .
  eq viewInDb(VE, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) 
    = VE inViewExpSet VES .

  op includeBOOL : Database -> Bool .
  eq includeBOOL(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) 
    = 'BOOL inModuleNameSet MNS' .

*** If a module, theory, or view is being redefined, that is, if there was
*** already in the database a module, theory, or view with the same name,
*** then all the units and/or views depending on it are removed using the
*** functions \texttt{delModules} and \texttt{delViews}. Removing a view 
*** or a unit from the database means removing its info cell from the set of 
*** cells in the database. Those entered by the user are not completely 
*** removed, their term form is saved so that it can be recompiled later.

  op delModules : Set{ModuleName} Database -> Database .
  op delViews : Set{ViewExp} Database -> Database .

  eq delModules((MN . MNS), 
       db(< MN ; T ; U ; U' ; U'' ; VDS ; MNS' ; VES > MIS, 
          MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))
    = delModules((MNS . MNS'), 
          delViews(VES, 
            db(< MN ; T ; noModule ; noModule ; noModule ; VDS ; 
                 emptyModuleNameSet ; emptyViewExpSet > MIS,
               MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))) .
  eq delModules((MN . MNS), 
       db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS' ; VES > MIS, 
          MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))
    = delModules((MNS . MNS'), 
          delViews(VES,
            db(< MN ; U ; noModule ; noModule ; noModule ; VDS ; 
                 emptyModuleNameSet ; emptyViewExpSet > MIS,
               MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))) .
  eq delModules((MN . MNS), 
       db(< MN ; null ; U ; U' ; U'' ; VDS ; MNS' ; VES > MIS, 
          MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))
    = delModules((MNS . MNS'), 
        delViews(VES, 
            db(MIS, MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))) .
  eq delModules(emptyModuleNameSet, DB) = DB .
  eq delModules((MN . MNS), DB) = delModules(MNS, DB) [owise] .

  eq delViews(VE # VES, 
       db(MIS, MNS, < VE ; T ; VI ; MNS' ; VES' > VIS, VE # VES'',
          MNS'', MNS3, MNS4, QIL))
    = delViews(VES # VES', 
        delModules(MNS', 
          db(MIS, MNS, 
             < VE ; T ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS, 
             VE # VES'', MNS'', MNS3, MNS4, QIL))) .
  eq delViews(VE # VES, 
       db(MIS, MNS, 
          < VE ; (null).Default{Term} ; VI ; MNS' ; VES' > VIS, VE # VES'',
          MNS'', MNS3, MNS4, QIL))
    = delViews(VES # VES', 
        delModules(MNS', 
          db(MIS, MNS, VIS, VES'', MNS'', MNS3, MNS4, QIL))) .
  eq delViews(VE # VES, 
       db(MIS, MNS, < VE ; VI ; VI' ; MNS' ; VES' > VIS, VE # VES'',
          MNS'', MNS3, MNS4, QIL))
    = delViews(VES # VES', 
        delModules(MNS', 
          db(MIS, MNS, 
             < VE ; VI ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS, 
             VE # VES'', MNS'', MNS3, MNS4, QIL))) .
  eq delViews(emptyViewExpSet, DB) = DB .
  eq delViews(VE # VES, DB) = delViews(VES, DB) [owise] .

*** The \texttt{warning} function allows us to place messages (warning, error,
*** or any other kind of messages) in the last argument of the database
*** constructor. These messages are given in the form of quoted identifier
*** lists, and will be passed to the third argument of the read-eval-print 
*** loop, to be printed in the terminal.

  op warning : Database QidList -> Database .
  eq warning(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, nil), QIL) 
    = db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL) .
  eq warning(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, NQIL), QIL) 
    = db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, NQIL QIL) .

  op getMsg : Database -> QidList .
  eq getMsg(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) = QIL .

*** Core Maude built-in modules are handled in a special way in the current
*** version of the system. They are not explicitly defined in the Full Maude
*** database; their importation is directly handled by Core Maude. This has
*** some drawbacks: Core Maude built-in modules cannot be renamed; they cannot
*** be directly used with built-in functions, such as \texttt{metaReduce} or
*** \texttt{sameComponent}, although they can be imported in modules being
*** used in the calls to these functions; and, in general, any function taking
*** as argument or returning as result the metarepresentation of a module
*** cannot take one of these built-in modules as argument. This is the case,
*** for example, for the \texttt{up} function presented in
*** Section~\ref{changing-levels}, or for functions or commands in which the
*** name of a module has to be specified, as the \texttt{select} or
*** \texttt{down} commands, or the \texttt{up} function presented in
*** Section~\ref{structured-specifications}. Nevertheless, there are also 
*** some advantages: The flattening of the built-in part of the structure is 
*** accomplished more efficiently, and, since these modules do not have to be 
*** stored in the database of Full Maude, the size of the database is reduced.

*** Our plan is to have in the future a hybrid solution. Once we have some way
*** of storing the modules entered to Full Maude in Core Maude's database, it
*** will be enough to keep in the Full Maude database just the original form
*** of the top of all the modules, including built-ins, leaving all the
*** importation declarations to be resolved by the engine. The structures will
*** be normalized as they are now, so that the engine will have to deal just
*** with inclusions, but it will be possible to use the predefined modules as 
*** any other module. Moreover, the Full Maude database will be relatively 
*** smaller and the flattening will be computed more efficiently.

*** When a new module or theory is entered, the names of all the modules,
*** theories, and views depending on it are included in its lists of
*** dependencies with functions \texttt{setUpModuleDeps} and
*** \texttt{setUpViewDeps}. Notice that if new module expressions are
*** defined, the function \texttt{setUpModExpDeps} will have to be 
*** extended accordingly.

  op setUpModuleDeps : Module Database -> Database .
  op setUpModExpDeps : ModuleName Database -> Database .
  op setUpModExpDeps : ModuleName Header Database -> Database .
  op setUpModExpDeps : ModuleName ViewExp Database -> Database .
  op setUpImportDeps : ModuleName ImportList Database -> Database .

  eq setUpModuleDeps(U, DB)
    = setUpImportDeps(getName(U), getImports(U), 
        setUpModExpDeps(getName(U), DB)) .

  eq setUpModExpDeps(QI, DB) = DB .

  eq setUpModExpDeps(pd(X :: ME), 
       db(< ME ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db(< ME ; DT ; U ; U' ; U'' ; VDS ; (MNS . pd(X :: ME)) ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
  eq setUpModExpDeps(pd(X :: ME), 
       db(< ME ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db(< ME ; U ; U' ; U'' ; U3 ; VDS ; (MNS . pd(X :: ME)) ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
  eq setUpModExpDeps(pd(X :: ME), DB)
    = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n))
    [owise] .

---- This could be a bug in Core Maude.
---- It should work if the next 6 equations are replaced by this single equation. 
----  ceq setUpImportDeps(MN, (I IL), 
----       db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), 
----          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
----    = setUpImportDeps(MN, IL, 
----        db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MN . MNS ; VES > MIS), 
----           MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 
----    if MN' := moduleName(I) .
  eq setUpImportDeps(MN, ((including MN' .) IL), 
       db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpImportDeps(MN, IL, 
        db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq setUpImportDeps(MN, ((including MN' .) IL), 
       db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpImportDeps(MN, IL, 
        db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq setUpImportDeps(MN, ((extending MN' .) IL), 
       db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpImportDeps(MN, IL, 
        db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq setUpImportDeps(MN, ((extending MN' .) IL), 
       db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpImportDeps(MN, IL, 
        db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq setUpImportDeps(MN, ((protecting MN' .) IL), 
       db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpImportDeps(MN, IL, 
        db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq setUpImportDeps(MN, ((protecting MN' .) IL), 
       db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpImportDeps(MN, IL, 
        db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq setUpImportDeps(MN, I IL, DB)
    = warning(DB, '\r 'Error: '\o 'Module header2QidList(moduleName(I)) 'not 'in 'database. '\n)
    [owise] .
  eq setUpImportDeps(MN, nil, DB) = DB .

  op setUpViewDeps : ModuleExpression ViewExp Database -> Database .
  op setUpViewExpDeps : ViewExp Database -> Database .
  op setUpViewExpDeps : ViewExp ParameterList Database -> Database .

  eq setUpViewDeps(ME, VE, 
       db((< ME ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db((< ME ; DT ; U ; U' ; U'' ; VDS ; MNS ; VE # VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
  eq setUpViewDeps(ME, VE, 
       db((< ME ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db((< ME ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VE # VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
  eq setUpViewDeps(ME, VE, DB)
    = warning(DB, '\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n)
    [owise] .

  eq setUpViewExpDeps(QI, DB) = DB .
  eq setUpViewExpDeps(QI{PL}, DB) = setUpViewExpDeps(QI{PL}, PL, DB) .

  eq setUpViewExpDeps(VE, (QI, PL), 
       db(MIS, MNS, < QI ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpViewExpDeps(VE, PL, 
        db(MIS, MNS, < QI ; DT ; VI ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq setUpViewExpDeps(VE, (QI, PL), 
       db(MIS, MNS, < QI ; VI ; VI' ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpViewExpDeps(VE, PL, 
        db(MIS, MNS, < QI ; VI ; VI' ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq setUpViewExpDeps(QI{PL}, PL', 
       db(MIS, MNS, < QI ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) 
    = db(MIS, MNS, < QI ; DT ; VI ; MNS' ; QI{PL} # VES > VIS, VES', MNS'', MNS3, MNS4, QIL) 
    [owise] .
  eq setUpViewExpDeps(QI{PL}, PL', 
       db(MIS, MNS, < QI ; VI ; VI' ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db(MIS, MNS, < QI ; VI ; VI' ; MNS' ; QI{PL} # VES > VIS, VES', MNS'', MNS3, MNS4, QIL) 
    [owise] .

  eq setUpViewExpDeps(VE, (QI{PL}, PL'), 
       db(MIS, MNS, < QI{PL} ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpViewExpDeps(VE, PL', 
        db(MIS, MNS, < QI{PL} ; DT ; VI ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq setUpViewExpDeps(VE, (QI{PL}, PL'), 
       db(MIS, MNS, < QI{PL} ; VI ; VI' ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpViewExpDeps(VE, PL', 
        db(MIS, MNS, < QI{PL} ; VI ; VI' ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq setUpViewExpDeps(VE, (QI{PL}, PL'), DB) 
    = setUpViewExpDeps(VE, PL', DB) 
    [owise] .
  eq setUpViewExpDeps(VE, empty, DB) = DB .

  op compiledModule : ModuleExpression Database -> Bool .
  op compiledModule : ParameterDecl Database -> Bool .
  op compiledView : ViewExp Database -> Bool .

  eq compiledView(VE, 
       db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
    = VI =/= null .
  eq compiledView(ME, DB) = false [owise] .

  eq compiledModule(MN, 
       db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, MNS', 
          VIS, VES', MNS'', MNS3, MNS4, QIL))
    = U'' =/= noModule .
  eq compiledModule(MN, 
       db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', 
          VIS, VES', MNS'', MNS3, MNS4, QIL))
    = U3 =/= noModule .
  eq compiledModule(MN, DB) = false [owise] .

  op insertTermView : ViewExp Term Database -> Database .
  op insertView : View Database -> Database .
  op getTermView : ViewExp Database -> Default{Term} .
  op getView : ViewExp Database -> [View] .

  eq insertTermView(VE, T, 
       db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', 
          MNS'', MNS3, MNS4, QIL))
    = delViews(VES,
        delModules(MNS', 
          db(MIS, MNS, 
            < VE ; T ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS, VES', 
            MNS'', MNS3, MNS4, 
            QIL 
            '\g 'Advisory: '\o 'View viewExp2QidList(VE) 'redefined. '\n))) .
  eq insertTermView(VE, T, 
       db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
    = db(MIS, MNS, 
         < VE ; T ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS, 
         (VE # VES), MNS', MNS'', MNS3, QIL)
    [owise] .

  eq insertView(view VE from ME to ME' is VMAPS endv, 
       db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpViewExpDeps(VE, 
        setUpViewDeps(ME, VE, 
          setUpViewDeps(ME', VE, 
            db(MIS, MNS, 
               < VE ; DT ; 
                 view VE from ME to ME' is VMAPS endv ; 
                 MNS' ; VES > VIS, 
                 VES', MNS'', MNS3, MNS4, QIL)))) .
  eq insertView(view VE{PDL} from ME to ME' is VMAPS endv, 
       db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpViewExpDeps(VE, 
        setUpViewDeps(ME, VE, 
          setUpViewDeps(ME', VE, 
            db(MIS, MNS, 
               < VE ; DT ; 
                 view VE{PDL} from ME to ME' is VMAPS endv ; 
                 MNS' ; VES > VIS, 
                 VES', MNS'', MNS3, MNS4, QIL)))) .
  eq insertView(view VE from ME to ME' is VMAPS endv, 
       db(MIS, MNS, VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpViewExpDeps(VE, 
        setUpViewDeps(ME, VE, 
          setUpViewDeps(ME', VE, 
            db(MIS, MNS, 
               < VE ; (null).Default{Term} ; 
                 view VE from ME to ME' is VMAPS endv ; 
                 emptyModuleNameSet ; emptyViewExpSet > VIS, 
                 VE # VES', MNS'', MNS3, MNS4, QIL))))
    [owise] .
  eq insertView(view VE{PDL} from ME to ME' is VMAPS endv, 
       db(MIS, MNS, VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpViewExpDeps(VE, 
        setUpViewDeps(ME, VE, 
          setUpViewDeps(ME', VE, 
            db(MIS, MNS, 
               < VE ; (null).Default{Term} ; 
                 view VE{PDL} from ME to ME' is VMAPS endv ; 
                 emptyModuleNameSet ; emptyViewExpSet > VIS, 
                 VE # VES', MNS'', MNS3, MNS4, QIL))))
    [owise] .
  eq insertView(viewError(QIL), DB) = warning(DB, QIL) .

  eq getTermView(VE, 
       db(MIS, MNS, (< VE ; DT ; VI ; MNS' ; VES > VIS), VES', MNS'', MNS3, MNS4, QIL))
    = DT .
  eq getTermView(VE, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
    = qidError('\r 'Error: '\o 'View viewExp2QidList(VE) 'not 'in 'database. '\n)
    [owise] .

  eq getView(VE, 
       db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
    = VI .
  eq getView(VE, 
       db(MIS, MNS, < VE ; VI ; VI' ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
    = VI' .
  eq getView(VE, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) 
    = viewError('\r 'Error: '\o 'View viewExp2QidList(VE) 'not 'in 'database. '\n)
    [owise] .

*** There are functions to insert the different versions of a unit, and to
*** extract them.  We only give here the equations for the insertion of top
*** units to illustrate the way in which the consistency of the database is
*** maintained.  We assume that when the internal version, the signature, or
*** the flat version of a module is entered in the database, its corresponding 
*** top module is already present in it.

  sort Tuple<Term|OpDeclSet|Module> .
  op <_;_;_> : Default{Term} OpDeclSet Module -> Tuple<Term|OpDeclSet|Module> .
  op tuple<Term|OpDeclSet|Module>Error : 
       QidList -> [Tuple<Term|OpDeclSet|Module>] .

  op insTermModule : ModuleName Module Database -> Database .
  op insTermModule : ModuleName Term Database -> Database .
  op insertTopModule : ModuleExpression [Module] Database -> Database .
  op insertInternalModule : ModuleExpression [Module] Database -> Database .
  op insertFlatModule : ModuleExpression [Module] Database -> Database .
  op insertVars : ModuleExpression [OpDeclSet] Database -> Database .
  op getTermModule : ModuleExpression Database 
       -> [Tuple<Term|OpDeclSet|Module>] .
  op getTopModule : ModuleExpression Database -> [Module] .
  op getInternalModule : ModuleExpression Database -> [Module] .
  op getFlatModule : ModuleExpression Database -> [Module] .
  op getFlatModuleNeg : ModuleExpression Database -> [Module] .
  op getVars : ModuleExpression Database -> [OpDeclSet] .
  op insertTopModule : ParameterDecl [Module] Database -> Database .
  op insertInternalModule : ParameterDecl [Module] Database -> Database .
  op insertFlatModule : ParameterDecl [Module] Database -> Database .
  op insertVars : ParameterDecl [OpDeclSet] Database -> Database .
  op getTermModule : ParameterDecl Database -> [Tuple<Term|OpDeclSet|Module>] .
  op getTopModule : ParameterDecl Database -> [Module] .
  op getInternalModule : ParameterDecl Database -> [Module] .
  op getFlatModule : ParameterDecl Database -> [Module] .
  op getFlatModuleNeg : ParameterDecl Database -> [Module] .
  op getVars : ParameterDecl Database -> [OpDeclSet] .

  eq insTermModule(MN, T, 
       db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, MNS', 
          VIS, VES', MNS'', MNS3, MNS4, QIL))
    = delModules(MNS, 
          delViews(VES, 
            db(< MN ; T ; noModule ; noModule ; noModule ; none ; 
                 emptyModuleNameSet ; emptyViewExpSet > MIS, 
               MNS', VIS, VES', MNS'', MNS3, MNS4, 
               QIL 
               '\g 'Advisory: '\o 'Module header2QidList(MN) 'redefined. '\n))).
  eq insTermModule(MN, T, 
       db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', 
          VIS, VES', MNS'', MNS3, MNS4, QIL))
    = delModules(MNS, 
          delViews(VES, 
            db(< MN ; T ; noModule ; noModule ; noModule ; none ; 
                 emptyModuleNameSet ; emptyViewExpSet > MIS, 
               MNS', VIS, VES', MNS'', MNS3, MNS4, 
               QIL 
               '\g 'Advisory: '\o 'Module header2QidList(MN) 'redefined. '\n))).
  eq insTermModule(MN, T, 
       db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
    = db(< MN ; T ; noModule ; noModule ; noModule ; none ; 
           emptyModuleNameSet ; emptyViewExpSet > MIS, 
         MN . MNS, VIS, VES, MNS', MNS'', MNS3, QIL) 
    [owise] .
  eq insTermModule(MN, qidError(QIL), DB) = warning(DB, QIL) .
  eq insTermModule(MN, unitError(QIL), DB) = warning(DB, QIL) .

  eq insTermModule(MN, U, 
       db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', 
          VIS, VES', MNS'', MNS3, MNS4, QIL))
    = delModules(MNS, 
          delViews(VES, 
            db(< MN ; U ; noModule ; noModule ; noModule ; none ; 
                 emptyModuleNameSet ; emptyViewExpSet > MIS, 
               MNS', VIS, VES', MNS'', MNS3, MNS4, 
               QIL 
               '\g 'Advisory: 
               '\o 'Module header2QidList(MN) 'redefined. '\n))).
  eq insTermModule(MN, U, 
       db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, MNS', 
          VIS, VES', MNS'', MNS3, MNS4, QIL))
    = delModules(MNS, 
          delViews(VES, 
            db(< MN ; U ; noModule ; noModule ; noModule ; none ; 
                 emptyModuleNameSet ; emptyViewExpSet > MIS, 
               MNS', VIS, VES', MNS'', MNS3, MNS4, 
               QIL 
               '\g 'Advisory: 
               '\o 'Module header2QidList(MN) 'redefined. '\n))).
  eq insTermModule(MN, U, 
       db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
    = db(< MN ; U ; noModule ; noModule ; noModule ; none ; 
           emptyModuleNameSet ; emptyViewExpSet > MIS, 
         MN . MNS, VIS, VES, MNS', MNS'', MNS3, QIL) 
    [owise] .
  eq insTermModule(MN, qidError(QIL), DB) = warning(DB, QIL) .
  eq insTermModule(MN, unitError(QIL), DB) = warning(DB, QIL) .

  eq insertTopModule(MN, U,
       db(< MN ; null ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db(< MN ; null ; U ; noModule ; noModule ; VDS ; MNS ; VES > MIS, 
         MNS', VIS, VES', MNS'', MNS3, MNS4,
         QIL 
         '\r 'ERROR: '\o 
         'Internally 'generated 'module header2QidList(MN) 'redefined. '\n) .
  eq insertTopModule(MN, U,
       db(< MN ; T ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpModuleDeps(U, 
        db(< MN ; T ; U ; noModule ; noModule ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq insertTopModule(MN, U,
       db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpModuleDeps(U, 
        db(< MN ; U' ; U ; noModule ; noModule ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq insertTopModule(MN, U, 
       db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
    = setUpModuleDeps(U, 
        db(< MN ; null ; U ; noModule ; noModule ; 
              none ; emptyModuleNameSet ; emptyViewExpSet > MIS, 
           MN . MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
    [owise] .
  eq insertTopModule(MN, unitError(QIL), DB) = warning(DB, QIL) .

  eq insertInternalModule(MN, U, 
       db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db(< MN ; DT ; U' ; U ; U3 ; VDS ; MNS ; VES > MIS, 
         MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
  eq insertInternalModule(MN, U, 
       db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db(< MN ; U' ; U'' ; U ; U4 ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
  eq insertInternalModule(MN, unitError(QIL), DB) = warning(DB, QIL) .

  eq insertFlatModule(MN, U, 
       db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db(< MN ; DT ; U' ; U'' ; U ; VDS ; MNS ; VES > MIS, 
         MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
  eq insertFlatModule(MN, U, 
       db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db(< MN ; U' ; U'' ; U3 ; U ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
  eq insertFlatModule(MN, unitError(QIL), DB) = warning(DB, QIL) .

  eq insertVars(MN, VDS,
       db(< MN ; DT ; U' ; U'' ; U3 ; VDS' ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 
         MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
  eq insertVars(MN, VDS,
       db(< MN ; U' ; U'' ; U3 ; U4 ; VDS' ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, 
         MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
  eq insertVars(MN, opDeclError(QIL), DB) = warning(DB, QIL) .

  eq getTermModule(MN, 
       db(< MN ; null ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = tuple<Term|OpDeclSet|Module>Error('\r 'Error: '\o 
            header2QidList(MN) 'is 'an 'internal 'module. '\n) .
  eq getTermModule(MN, 
       db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = < DT ; none ; noModule > .
  eq getTermModule(MN, 
       db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = < null ; VDS ; U > .
  eq getTermModule(MN, DB)
    = tuple<Term|OpDeclSet|Module>Error('\r 'Error: '\o 
            'Module header2QidList(MN)  '\n) 
    [owise] .

  eq getTopModule(MN, 
      db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) 
    = U .
  eq getTopModule(MN, 
       db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = U' .
  eq getTopModule(MN, DB)
    = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n)
    [owise] .

  eq getInternalModule(MN, 
       db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = U' .
  eq getInternalModule(MN, 
       db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = U'' .
  eq getInternalModule(MN, DB)
    = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n)
    [owise] .

  eq getVars(MN, 
       db(< MN ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = VDS .
  eq getVars(MN, 
       db(< MN ; U ; U' ; U'' ; M ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = VDS .
  eq getVars(MN, DB) = none [owise] .

*** The name of the signature and the flattened module is not the
*** module expression used as the name of the module but the result of
*** converting it into a quoted identifier.

  eq getFlatModule(MN, 
       db(< MN ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = if M == noModule
      then unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'compiled. '\n) 
      else remNegAnns(M)
      fi .
  eq getFlatModule(MN, 
       db(< MN ; U ; U' ; U'' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = if M == noModule
      then unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'compiled. '\n)
      else remNegAnns(M)
      fi .
  eq getFlatModule(MN, DB)
    = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n)
    [owise] .

  *** Handling of negative annotations (by Santiago Escobar)

  eq getFlatModuleNeg(MN, 
       db(< MN ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = M .
  eq getFlatModuleNeg(MN, 
       db(< MN ; U ; U' ; U'' ; M ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = M .
  eq getFlatModuleNeg(MN, 
       db(< MN ; DT ; U ; U' ; noModule ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = unitError('\r 'Error: '\o 
                'Module header2QidList(MN) 'not 'compiled. '\n) .
  eq getFlatModuleNeg(MN, 
      db(< MN ; U ; U' ; U'' ; noModule ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = unitError('\r 'Error: '\o 
                'Module header2QidList(MN) 'not 'compiled. '\n) .
  eq getFlatModuleNeg(MN, DB)
    = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n)
    [owise] .

  *** removeNegAnnotations
  op remNegAnns : Module -> Module .
  op remNegAnns : OpDeclSet -> OpDeclSet .
  op remNegAnns : AttrSet -> AttrSet .
  op remNegAnns : IntList -> IntList .

  eq remNegAnns(M) = setOps(M, remNegAnns(getOps(M))) .

  eq remNegAnns(op F : TyL -> Ty [AtS] . OPDS)
    = op F : TyL -> Ty [remNegAnns(AtS)] . remNegAnns(OPDS) .
  eq remNegAnns((none).OpDeclSet) = (none).OpDeclSet .

  eq remNegAnns(strat(NL:NatList) AtS) = strat(NL:NatList) AtS .
  eq remNegAnns(strat(IL:IntList) AtS) = AtS [owise] .
  eq remNegAnns(AtS) = AtS [owise] .

endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** The Evaluation of Modules
***

*** The general principle for the evaluation of units in our design consists in
*** first evaluating any module expression, reducing it to a canonical form in
*** which only unit inclusions appear, that is, to a unit hierarchy, which can
*** be seen as a partial order of unit inclusions. The design of the Full Maude
*** system has been based upon the principle of evaluating all module
*** expressions to irreducible structured units, and on using the flat version
*** of the units only for execution purposes. We have then two different
*** processes clearly distinguished: a first step in which the structured unit 
*** is evaluated and reduced to its normal form, and a second step in which 
*** this normal form is flattened.

*** As explained in Section~\ref{execution-environment}, the process of
*** evaluation to normal form is also responsible for the parsing of the
*** bubbles in the premodules, which is accomplished once the signature has
*** been built. The parsing of bubbles is discussed in
*** Section~\ref{bubble-parsing}. To be able to handle the \texttt{up}
*** function and the \texttt{down} command presented in
*** Section~\ref{structured-specifications}, it is necessary to be able to
*** move terms and modules from one level of reflection to another. The
*** functionality to move between levels is presented in
*** Section~\ref{changing-levels}, where functions \texttt{up} and
*** \texttt{down} on sorts \texttt{Module} and \texttt{Term} are defined. The 
*** transformation of object-oriented modules into system modules in discussed 
*** in Section~\ref{omod2modfunction}. The evaluation of module expressions is 
*** discussed in Sections~\ref{evalModExp}, \ref{application-of-maps}, 
*** \ref{instantiation}, and~\ref{renaming}.

***
*** Changing Levels
***

*** Moving terms of sorts \texttt{Term} and \texttt{Module} from one
*** level of reflection to another is possible thanks to the
*** \texttt{up} and \texttt{down} functions, which are defined,
*** respectively, in the following modules \texttt{MOVE-UP} and
*** \texttt{MOVE-DOWN}.

***
*** The \texttt{up} Function
***

*** Given a term of sort \texttt{Module} or \texttt{Term}, the
*** \texttt{up} function, defined in the following module
*** \texttt{MOVE-UP}, returns the term metarepresenting it. The
*** function is just call the \texttt{upTerm} predefined function.

*** We shall see in Section~\ref{bubble-parsing} how the \texttt{up} function
*** is used to evaluate the homonymous function discussed in
*** Section~\ref{structured-specifications}. In Section~\ref{instantiation} we
*** shall discuss how the \texttt{up} function is used to evaluate the 
*** \texttt{META-LEVEL} module expression (see 
*** Section~\ref{structured-specifications}).

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod MOVE-UP is
  pr META-LEVEL .  
  pr CONVERSION .
  op up : Module -> Term .
  op up : Term -> Term .
  op up : EquationSet -> Term .

  eq up(M:Module) = upTerm(M:Module) .
  eq up(T:Term) = upTerm(T:Term) .
  eq up(EqS:EquationSet) = upTerm(EqS:EquationSet) .
  
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** The \texttt{down} Function
***

*** Given a term of sort \texttt{Term} metarepresenting a term of sort
*** \texttt{Term} or \texttt{Module}, the \texttt{down} function can be seen
*** as the inverse of the \texttt{up} function discussed in the previous
*** section, that is, it returns the original term that had been
*** metarepresented. There are also \texttt{down} functions for terms 
*** metarepresenting terms in other sorts. We present here only some of them.

*** We assume that the \texttt{down} functions are called with valid
*** metarepresentations. In fact, these functions should be declared as
*** partial functions going to error sorts when their arguments are invalid.

*** The main application of the \texttt{down} functions is in the evaluation
*** of the \texttt{down} command (see
*** Section~\ref{structured-specifications}).  However, they are also used in 
*** other tasks, as for example in the parsing of some inputs.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod MOVE-DOWN is
  pr UNIT .
  pr CONVERSION .
  pr INT-LIST .

  op downTerm : Term -> [Term] .
  op downModule : Term -> [Module] .
  op downQid : Term -> [Qid] [memo] .
  op downQidList : Term -> [QidList] .
  op downTypes : Term -> [TypeList] .
  op downSorts : Term -> [SortSet] .
  op downSort : Term -> [Sort] .
  op downModExp : Constant -> [Header] .
  op downNat : Term -> [Int] .
  op downString : Term -> [String] .

  op downResultPair : Term -> [ResultPair] .
  op downTerm : TermList -> [Term] .
  op downImports : TermList -> [ImportList] .
  op downSubsorts : TermList -> [SubsortDeclSet] .
  op downOps : TermList -> [OpDeclSet] .
  op downEqCond : TermList -> [EqCondition] .
  op downCond : TermList -> [Condition] .
  op downMbs : TermList -> [MembAxSet] .
  op downEqs : TermList -> [EquationSet] .
  op downRls : TermList -> [RuleSet] .
  op downAttrs : TermList -> [AttrSet] .
  op downAttr : Term -> [Attr] .
  op downHooks : TermList -> [HookList] .
  op downMetaNat : Term -> [Term] .
  op downNat : TermList -> [IntList] .

  op downClasses : TermList -> [ClassDeclSet] .
  op downMsgs : TermList -> [MsgDeclSet] .
  op downSubclasses : TermList -> [SubclassDeclSet] .
  op downClassAttrs : TermList -> [AttrDeclSet] .
  
  vars T T' T'' T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 : Term .
  vars TL TL' : TermList .
  vars QI QI' F V L : Qid .
  var  Ct : Constant .
  var  M : Module .
  var  Tp : Type .

  eq downResultPair('`{_`,_`}[T, T']) = {downTerm(T), downTerm(T')} .

  eq downModule('fmod_is_sorts_.____endfm[T1, T2, T3, T4, T5, T6, T7])
    = (fmod downModExp(T1) is
         downImports(T2) 
         sorts downSorts(T3) .
         downSubsorts(T4) 
         downOps(T5) 
         downMbs(T6) 
         downEqs(T7)
       endfm) .
  eq downModule('mod_is_sorts_._____endm[T1, T2, T3, T4, T5, T6, T7, T8])
    = (mod downModExp(T1) is
         downImports(T2) 
         sorts downSorts(T3) .
         downSubsorts(T4) 
         downOps(T5) 
         downMbs(T6) 
         downEqs(T7) 
         downRls(T8)
       endm) .
  eq downModule('omod_is_sorts_.________endom[T1, T2, T3, T4, T5, T6, T7, T8, T9, T10, T11])
    = (omod downModExp(T1) is
         downImports(T2) 
         sorts downSorts(T3) .
         downSubsorts(T4) 
         downClasses(T5) 
         downSubclasses(T6) 
         downOps(T7) 
         downMsgs(T8) 
         downMbs(T9) 
         downEqs(T10) 
         downRls(T11)
       endom) .

  eq downModExp(Ct) = downQid(Ct) .

  eq downImports('nil.ImportList) = nil .
  eq downImports('__[TL]) = downImports(TL) .
  eq downImports('including_.[T]) = (including downModExp(T) .) .
  eq downImports('extending_.[T]) = (extending downModExp(T) .) .
  eq downImports('protecting_.[T]) = (protecting downModExp(T) .) .
  ceq downImports((TL, TL')) = (downImports(TL) downImports(TL')) if TL =/= empty /\ TL' =/= empty .
  
  eq downSubsorts('none.SubsortDeclSet) = none .
  eq downSubsorts('__[TL]) = downSubsorts(TL) .
  eq downSubsorts('subsort_<_.[T, T']) = (subsort downQid(T) < downQid(T') .) .
  ceq downSubsorts((TL, TL')) = (downSubsorts(TL) downSubsorts(TL')) if TL =/= empty /\ TL' =/= empty .

  eq downOps('none.OpDeclSet) = none .
  eq downOps('__[TL]) = downOps(TL) .
  eq downOps('op_:_->_`[_`].[Ct, T, T', T''])
    = (op downQid(Ct) : downTypes(T) -> downQid(T') [downAttrs(T'')] .) .
  ceq downOps((TL, TL')) = (downOps(TL) downOps(TL')) if TL =/= empty /\ TL' =/= empty .

  eq downAttrs('none.AttrSet) = none .
  eq downAttrs('__[TL]) = downAttrs(TL) .
  ceq downAttrs((TL, TL')) = (downAttr(TL) downAttrs(TL')) if TL =/= empty /\ TL' =/= empty .
  ceq downAttrs(T)
    = downAttr(T)
    if T =/= 'none.AttrSet .

  eq downAttr('assoc.Attr) = assoc .
  eq downAttr('comm.Attr) = comm .
  eq downAttr('idem.Attr) = idem .
  eq downAttr('id[T]) = id(downTerm(T)) .
  eq downAttr('left-id[T]) = left-id(downTerm(T)) .
  eq downAttr('right-id[T]) = right-id(downTerm(T)) .
  eq downAttr('poly[T]) = poly(downNat(T)) .
  eq downAttr('strat[T]) = strat(downNat(T)) .
  eq downAttr('memo.Attr) = memo .
  eq downAttr('prec[T]) = prec(downNat(T)) .
  eq downAttr('gather[T]) = gather(downQidList(T)) .
  eq downAttr('ctor.Attr) = ctor .
  eq downAttr('special[T]) = special(downHooks(T)) .
  eq downAttr('iter.Attr) = iter .
  eq downAttr('frozen[T]) = frozen(downNat(T)) .
  eq downAttr('label[T]) = label(downQid(T)) .
  eq downAttr('config.Attr) = config .
  eq downAttr('object.Attr) = object .
  eq downAttr('msg.Attr) = msg .
  eq downAttr('nonexec.Attr) = nonexec .

  eq downHooks('__[TL]) = downHooks(TL) .
  eq downHooks('id-hook[T, T']) = id-hook(downQid(T), downQidList(T')) .
  eq downHooks('op-hook[T, T', T'', T3])
    = op-hook(downQid(T), downQid(T'), downQidList(T''), downQid(T3)) .
  eq downHooks('term-hook[T, T']) = term-hook(downQid(T), downTerm(T')) .
  ceq downHooks((TL, TL')) = downHooks(TL) downHooks(TL') if TL =/= empty /\ TL' =/= empty .

  eq downTerm(QI) = downQid(QI) .
  eq downTerm('_`[_`][T, T']) = downQid(T)[downTerm(T')] .
  eq downTerm('_`,_[T, TL]) = (downTerm(T), downTerm(TL)) .
  ceq downTerm((T, TL)) = (downTerm(T), downTerm(TL)) if TL =/= empty .
  eq downTerm(F[TL]) 
    = qidError('\r 'Error: '\o 'Incorrect 'term. '\n) [owise] .

  eq downEqCond('_/\_[TL]) = downEqCond(TL) .
  eq downEqCond('_=_[T, T']) = downTerm(T) = downTerm(T') .
  eq downEqCond('_:_[T, T']) = downTerm(T) : downSort(T') .
  eq downEqCond('_:=_[T, T']) = downTerm(T) := downTerm(T') .
  ceq downEqCond((TL, TL')) = downEqCond(TL) /\ downEqCond(TL') if TL =/= empty /\ TL' =/= empty .

  eq downCond('_/\_[TL]) = downCond(TL) .
  eq downCond('_=_[T, T']) = downEqCond('_=_[T, T']) .
  eq downCond('_:_[T, T']) = downEqCond('_:_[T, T']) .
  eq downCond('_:=_[T, T']) = downEqCond('_:=_[T, T']) .
  eq downCond('_=>_[T, T']) = downTerm(T) => downTerm(T') .
  ceq downCond((TL, TL')) = downCond(TL) /\ downCond(TL') if TL =/= empty /\ TL' =/= empty .

  eq downMbs('none.MembAxSet) = none .
  eq downMbs('__[TL]) = downMbs(TL) .
  eq downMbs('mb_:_`[_`].[T, T', T'']) 
    = (mb downTerm(T) : downSort(T') [downAttrs(T'')] .) .
  eq downMbs('cmb_:_if_`[_`].[T, T', T'', T3]) 
    = (cmb downTerm(T) : downSort(T') if downEqCond(T'') [downAttrs(T3)] .) .
  ceq downMbs((TL, TL')) = (downMbs(TL) downMbs(TL')) if TL =/= empty /\ TL' =/= empty .

  eq downEqs('none.EquationSet) = none .
  eq downEqs('__[TL]) = downEqs(TL) .
  eq downEqs('eq_=_`[_`].[T, T', T'']) 
    = (eq downTerm(T) = downTerm(T') [downAttrs(T'')] .) .
  eq downEqs('ceq_=_if_`[_`].[T, T', T'', T3]) 
    = (ceq downTerm(T) = downTerm(T') if downEqCond(T'') [downAttrs(T3)] .) .
  ceq downEqs((TL, TL')) = (downEqs(TL) downEqs(TL')) if TL =/= empty /\ TL' =/= empty .

  eq downRls('none.RuleSet) = none .
  eq downRls('__[TL]) = downRls(TL) .
  eq downRls('rl_=>_`[_`].[T, T', T'']) 
    = (rl downTerm(T) => downTerm(T') [downAttrs(T'')] .) .
  eq downRls('crl_=>_if_`[_`].[T, T', T'', T3])
    = (crl downTerm(T) => downTerm(T') if downCond(T'') [downAttrs(T3)] .) .
  ceq downRls((TL, TL')) = (downRls(TL) downRls(TL')) if TL =/= empty /\ TL' =/= empty .

  eq downSorts('none.EmptyTypeSet) = none .
----  eq downSorts('none.SortSet) = none .
  eq downSorts('_;_[TL]) = downSorts(TL) .
  ceq downSorts((TL, TL')) = (downSorts(TL) ; downSorts(TL')) if TL =/= empty /\ TL' =/= empty .
  eq downSorts(QI) = downSort(QI) [owise] .

  eq downSort(Ct) = downQid(Ct) .

  eq downTypes('nil.TypeList) = nil .
  eq downTypes('__[TL]) = downTypes(TL) .
  ceq downTypes((TL, TL')) 
    = (downTypes(TL) downTypes(TL')) 
    if TL =/= empty /\ TL' =/= empty .
  eq downTypes(QI) = downSort(QI) [owise] .

  eq downQidList('nil.TypeList) = nil .
  eq downQidList('__[TL]) = downQidList(TL) .
  ceq downQidList((TL, TL')) = (downQidList(TL) downQidList(TL')) if TL =/= empty /\ TL' =/= empty .
  eq downQidList(QI) = downQid(QI) [owise] .

  eq downQid(Ct) 
    = qid(substr(string(getName(Ct)), 1, length(string(getName(Ct))))) .

  eq downMetaNat(QI) 
    = qid(substr(string(getName(QI)), 1, length(string(getName(QI)))) 
          + ".Nat") .

  ceq downNat(QI) 
    = trunc(rat(string(getName(QI)), 10)) 
    if getType(QI) == 'Nat or getType(QI) == 'NzNat .
  ceq downNat(QI) 
    = if substr(string(getName(QI)), 0 ,1) == "-"
      then - trunc(rat(substr(string(getName(QI)), 1, 
                            length(string(getName(QI)))), 10)) 
      else trunc(rat(string(getName(QI)), 10)) 
      fi
    if getType(QI) == 'Int or getType(QI) == 'NzInt .
  eq downNat('0.Zero) = 0 .
  eq downNat('s_['0.Zero]) = 1 .
  ceq downNat(F['0.Zero]) 
    = trunc(rat(substr(string(F), 3, 2), 10)) 
    if substr(string(F), 0, 3) = "s_^" .

  eq downString(QI) = substr(string(QI), 1, _-_(length(string(QI)), 2)) .

  eq downNat('__[TL]) = downNat(TL) . 
  ceq downNat((TL, TL')) = (downNat(TL) downNat(TL')) if TL =/= empty /\ TL' =/= empty .

  eq downClasses('none.ClassDeclSet) = none .
  eq downClasses('__[TL]) = downClasses(TL) .
  ceq downClasses((TL, TL')) = (downClasses(TL) downClasses(TL')) if TL =/= empty /\ TL' =/= empty .
  eq downClasses('class_|_.[T, T']) = (class downSort(T) | downClassAttrs(T') .) .

  eq downClassAttrs('none.AttrDeclSet) = none .
  eq downClassAttrs('_`,_[TL]) = downClassAttrs(TL) .
  ceq downClassAttrs((TL, TL')) = (downClassAttrs(TL), downClassAttrs(TL')) if TL =/= empty /\ TL' =/= empty .
  eq downClassAttrs('attr_:_[T, T']) = (attr downQid(T) : downSort(T')) .

  eq downSubclasses('none.SubclassDeclSet) = none .
  eq downSubclasses('__[TL]) = downSubclasses(TL) .
  ceq downSubclasses((TL, TL')) = (downSubclasses(TL) downSubclasses(TL')) if TL =/= empty /\ TL' =/= empty .
  eq downSubclasses('subclass_<_.[T, T']) = (subclass downQid(T) < downQid(T') .) .

  eq downMsgs('none.MsgDeclSet) = none .
  eq downMsgs('__[TL]) = downMsgs(TL) .
  ceq downMsgs((TL, TL')) = (downMsgs(TL) downMsgs(TL')) if TL =/= empty /\ TL' =/= empty .
  eq downMsgs('msg_:_->_.[Ct, T, T'])
    = (msg downQid(Ct) : downTypes(T) -> downQid(T') .) .

endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** Parsing of Bubbles
***

*** As discussed in Section~\ref{implementation-introduction}, in Full Maude,
*** the parsing process is split into two phases. In a first stage, the input
*** is parsed using the top-level grammar for Full Maude modules, theories,
*** views, and commands. Once this first stage is completed, we get a term
*** with bubbles in it, which is converted into a module, theory, or view.
*** This unit or view may still have the bubbles in it. We say that a module
*** with bubbles is a premodule, a view with bubbles a preview, and so on. The
*** second stage of the process consists in taking this preunit or preview and
*** converting the bubbles in it into terms by parsing them in the appropriate
*** signatures, obtaining a `valid' unit or view out of it, or otherwise a
*** parsing error. In the case of commands, if they contain any bubble, the 
*** same will have to be done. All bubbles have to be parsed in the 
*** appropriate signature before any further processing can be done with the 
*** module, view, or command in which they appear.

***
*** Parsing of Module Expressions
***

*** Before introducing the \texttt{parseDecl} function, we present some
*** auxiliary functions. For example, the following functions
*** \texttt{parseType}, \texttt{parseSortSet}, and \texttt{parseTypeList}
*** return, respectively, the sort, set of sorts, and list of sorts
*** represented by the term given as argument. Note that these functions, as
*** most of the functions in this module, are partial functions. We assume
*** that the term given as argument is in fact the representation of, for 
*** example, a valid sort, or set of sorts, etc. In the case of 
*** \texttt{parseDecl} we assume that the term is the representation of a 
*** predeclaration.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod MOD-EXP-PARSING is
  pr MOVE-DOWN .
  pr INT-LIST .
  pr VIEW-EXPR-TO-QID .

  vars T T' T'' T3 T4 : Term .
  vars T? T?' : [Term] .
  var  TL TL' : TermList .
  var  QIL  : QidList .
  var  Ct : Constant .
  var  AtS : AttrSet .
  vars QI F : Qid .
  var  CD? : [Condition] .
  vars S S' : Sort .
  var  TyL : TypeList .

  op parseSort : Term ~> Sort .
  op parseType : Term ~> Type .
  op parseSortSet : Term ~> SortSet .
  op parseTypeList : Term ~> TypeList .
  op parseViewExp : Term ~> ViewExp .
  op parseParameterList : Term ~> ParameterList .

  eq parseSort('sortToken[T]) 
    = if downQid(T) :: Type 
      then downQid(T)
      else qidError('\r 'Warning: '\o downQid(T) 'is 'not 'a 'valid 'sort. '\n)
      fi .
  eq parseSort('_`{_`}[T, T']) 
    = qid(string(parseSort(T)) 
          + "{" + string(parameterList2Qid(parseParameterList(T'))) + "}") .
  eq parseSort(T) = qidError('\r 'Warning: '\o 'invalid 'sort. '\n) [owise] .

  eq parseType('`[_`][T]) 
    ---- = kind(parseSort(T)) .
    = qid("[" + string(parseSort(T)) + "]") .
  eq parseType(T) = parseSort(T) [owise] .

  eq parseSortSet('__[T, T']) = (parseSort(T) ; parseSortSet(T')) .
  eq parseSortSet(T) = parseSort(T) [owise].

  eq parseTypeList('__[T, T']) = (parseType(T) parseTypeList(T')) .
  eq parseTypeList(T) = parseType(T) [owise] .

  eq parseViewExp('viewToken[T]) 
    = if downQid(T) :: Sort 
      then downQid(T)
      else qidError('\r 'Warning: '\o downQid(T) 'is 'not 'a 'valid 'sort. '\n)
      fi .
  eq parseViewExp('_`{_`}[T, T']) 
    = parseViewExp(T){parseParameterList(T')} .
  eq parseViewExp(T) 
    = qidError('\r 'Warning: '\o 'invalid 'view 'expression. '\n) 
    [owise] .

  eq parseParameterList('_`,_[T, T']) 
    = parseViewExp(T), parseParameterList(T') .
  eq parseParameterList(T) = parseViewExp(T) [owise] .

*** The function \texttt{parseModExp} takes a term representing a 
*** module expression and returns the corresponding term in sort 
*** \texttt{ModuleExpression}. In case of adding new constructors for module 
*** expressions, as it will be done in Section~\ref{extension}, new equations d
*** efining the semantics of the function on them will have to be given.

  op parseModExp : Term -> ModuleExpression .
  op parseMaps : Term -> RenamingSet .

  op parseAttrs : Term -> AttrSet .

  eq parseModExp('token[T]) = downQid(T) .
  eq parseModExp('`(_`)[T]) = parseModExp(T) .
  eq parseModExp('_`{_`}[T, T']) 
    = _`{_`}(parseModExp(T), parseParameterList(T')) .
  eq parseModExp('_*`(_`)[T, T']) = _*`(_`)(parseModExp(T), parseMaps(T')) .
  eq parseModExp('_+_[T, T']) = parseModExp(T) + parseModExp(T') .
  eq parseModExp('TUPLE`[_`]['token[T]]) = TUPLE[parseNat(T)] .
  eq parseModExp('POWER`[_`]['token[T]]) = POWER[parseNat(T)] .

  eq parseMaps('_`,_[T, T']) = (parseMaps(T), parseMaps(T')) .

  eq parseMaps('sort_to_[T, T']) = (sort parseType(T) to parseType(T')) .
  eq parseMaps('label_to_['token[T], 'token[T']]) 
    = (label downQid(T) to downQid(T')) .
  eq parseMaps('class_to_[T, T']) = (class parseType(T) to parseType(T')) .
  eq parseMaps('attr_._to_[T, 'token[T'], 'token[T'']])
    = (attr downQid(T') . parseType(T) to downQid(T'')) .
  eq parseMaps('msg_to_['token[T], 'token[T']]) 
    = (msg downQid(T) to downQid(T')) .
  eq parseMaps('msg_:_->_to_['token[T], T', T'', 'token[T3]])
    = (msg downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3)) .
  eq parseMaps('msg_:`->_to_['token[T], T', 'token[T'']])
    = (msg downQid(T) : nil -> parseType(T') to downQid(T'')) .
  eq parseMaps('op_to_`[_`]['token[T], 'token[T'], T''])
    = (op downQid(T) to downQid(T') [parseAttrs(T'')]) .
  eq parseMaps('op_:_->_to_`[_`]['token[T], T', T'', 'token[T3], T4])
    = (op downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3) 
            [parseAttrs(T4)]) .
  eq parseMaps('op_:`->_to_`[_`]['token[T], T', 'token[T''], T3])
    = (op downQid(T) : nil -> parseType(T') to downQid(T'') 
          [parseAttrs(T3)]) .
  eq parseMaps('op_:_~>_to_`[_`]['token[T], T', T'', 'token[T3], T4])
    = (op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) 
            to downQid(T3) [parseAttrs(T4)]) .
  eq parseMaps('op_:`~>_to_`[_`]['token[T], T', 'token[T''], T3])
    = (op downQid(T) : nil -> kind(parseType(T')) to downQid(T'') 
          [parseAttrs(T3)]) .
  eq parseMaps('op_to_['token[T], 'token[T']]) 
    = (op downQid(T) to downQid(T') [none]) .
  eq parseMaps('op_:_->_to_['token[T], T', T'', 'token[T3]])
    = (op downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3) 
          [none]) .
  eq parseMaps('op_:`->_to_['token[T], T', 'token[T'']])
    = (op downQid(T) : nil -> parseType(T') to downQid(T'') [none]) .
  eq parseMaps('op_:_~>_to_['token[T], T', T'', 'token[T3]])
    = (op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) 
          to downQid(T3) [none]) .
  eq parseMaps('op_:`~>_to_['token[T], T', 'token[T'']])
    = (op downQid(T) : nil -> kind(parseType(T')) to downQid(T'') [none]) .

  eq parseAttrs('__[T, T']) = (parseAttrs(T) parseAttrs(T')) .
  eq parseAttrs('assoc.@Attr@) = assoc .
  eq parseAttrs('associative.@Attr@) = assoc .
  eq parseAttrs('comm.@Attr@) = comm .
  eq parseAttrs('commutative.@Attr@) = comm .
  eq parseAttrs('idem.@Attr@) = idem .
  eq parseAttrs('idempotent.@Attr@) = idem .
  eq parseAttrs('id:_[T]) = none .
  eq parseAttrs('identity:_[T]) = none .
  eq parseAttrs('left`id:_[T]) = none .
  eq parseAttrs('left`identity:_[T]) = none .
  eq parseAttrs('right`id:_[T]) = none .
  eq parseAttrs('right`identity:_[T]) = none .
  eq parseAttrs('poly`(_`)[T]) = poly(parseInt(T)) .
  eq parseAttrs('strat`(_`)[T]) = none .
  eq parseAttrs('strategy`(_`)[T]) = none .
  eq parseAttrs('memo.@Attr@) = none .
  eq parseAttrs('memoization.@Attr@) = none .
  eq parseAttrs('prec_['token[T]]) = prec(parseNat(T)) .
  eq parseAttrs('precedence_['token[T]]) = prec(parseNat(T)) .
  eq parseAttrs('prec_['`(_`)['token[T]]]) = prec(parseNat(T)) .
  eq parseAttrs('precedence_['`(_`)['token[T]]]) = prec(parseNat(T)) .
  eq parseAttrs('gather`(_`)['neTokenList[T]]) = gather(downQidList(T)) .
  eq parseAttrs('gathering`(_`)['neTokenList[T]]) = gather(downQidList(T)) .
  eq parseAttrs('format`(_`)['neTokenList[T]]) = none .
  eq parseAttrs('ctor.@Attr@) = ctor .
  eq parseAttrs('constructor.@Attr@) = ctor .
  eq parseAttrs('frozen.@Attr@) = none .
  eq parseAttrs('frozen`(_`)[T]) = none .
  eq parseAttrs('iter.@Attr@) = iter .
  eq parseAttrs('ditto.@Attr@) = ditto .
  eq parseAttrs('special`(_`)[T]) = parseSpecial(parseHookList(T)) .
  eq parseAttrs('config.@Attr@) = config .
  eq parseAttrs('object.@Attr@) = object .
  eq parseAttrs('msg.@Attr@) = msg .
  eq parseAttrs('message.@Attr@) = msg .

  op parseSpecial : Set<Hook> -> Attr .
  op parseHookList : Term -> Set<Hook> .
  op hookList : Set<Hook> -> HookList .
  sort Set<Hook> .
  subsort Hook < Set<Hook> .
  op none : -> Set<Hook> .
  op _._ : Set<Hook> Set<Hook> -> Set<Hook> [assoc comm id: none] .
  var  SH : Set<Hook> .
  var  H : Hook .

  eq parseSpecial(none) = none .
  eq parseSpecial(SH) = special(hookList(SH)) [owise] .

  eq parseHookList('__[T, TL]) = parseHookList(T) . parseHookList(TL) .
  eq parseHookList('id-hook_['token[T]]) = id-hook(downQid(T), nil) .
  eq parseHookList('id-hook_`(_`)['token[T], 'neTokenList[T']])
    = id-hook(downQid(T), downQidList(T')) .
  eq parseHookList(
       'op-hook_`(_:_->_`)[
          'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]])
    = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) .
  eq parseHookList('op-hook_`(_:`->_`)['token[T], 'token[T'], 'token[T'']])
    = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) .
  eq parseHookList(
       'op-hook_`(_:_~>_`)[
          'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]])
    = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) .
  eq parseHookList('op-hook_`(_:`~>_`)['token[T], 'token[T'], 'token[T'']])
    = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) .
  eq parseHookList('term-hook_`(_`)['token[T], T']) = none .

  eq hookList(H) = H .
  eq hookList(H . SH) = H hookList(SH) [owise] .

*** Given a term representing a machine integer, the function 
*** \texttt{parseInt} returns the corresponding integer.

  op parseNat : Term -> Nat .

  op parseInt : Term -> Int .
  op parseInt : TermList -> IntList .

  eq parseInt(('neTokenList['__[TL]], TL')) = parseInt(TL) parseInt(TL') .
  eq parseInt(('neTokenList[QI], TL)) = parseInt(QI) parseInt(TL) .
  eq parseInt(empty) = nil .

  eq parseInt((T, TL)) = parseInt(T) parseInt(TL) [owise] .
  eq parseInt(nil) = nil .

  eq parseInt(Ct) 
    = downNat(
        qid(substr(string(getName(Ct)), 1, length(string(getName(Ct)))) 
            + ".Int")) .

  eq parseNat(Ct) 
    = downNat(
        qid(substr(string(getName(Ct)), 1, length(string(getName(Ct)))) 
            + ".Nat")) .

endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** Parsing of Bubbles
***

*** In the following module \texttt{BUBBLE-PARSING}, the definitions for the
*** basic processing of bubbles are introduced. In it we declare a function
*** \texttt{solveBubbles} which takes a bubble and some other arguments and 
*** returns the term resulting from parsing it.


-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod BUBBLE-PARSING is
  pr DATABASE .
  pr MOVE-UP .
  pr MOVE-DOWN .
  pr MOD-EXP-PARSING .
  pr PRINT-SYNTAX-ERROR .

  vars T T' : Term .
  vars M M' : Module .
  var  B : Bool .
  var  QIL : QidList .
  vars DB DB' : Database .
  var  TL : TermList .
  var  S : Sort .
  vars QI QI' F : Qid .
  var  VDS : OpDeclSet .
  var  C : Constant .
  var  V : Variable .
  var  N : Nat .
  var  Tp : Type .
  var  RP : [ResultPair] .
  var  MN : ModuleName .
  var  ME : ModuleExpression .
  var  U : Module .
  var  Cond : Condition .

  op resultPairError : QidList -> [ResultPair] [ctor] .

*** As we shall see in Section~\ref{evaluation}, a declaration importing the
*** predefined module \texttt{UP} (see Section~\ref{non-built-in-predefined})
*** is added to all modules importing the \texttt{META-LEVEL} module. The
*** \texttt{solveBubbles} function is called with a `flag' indicating whether
*** the module can contain calls to the \texttt{up} function or not. Thus,
*** when we call \texttt{metaParse} with some bubble and the module in which
*** such bubble has to be parsed, if there are occurrences of the function
*** \texttt{up} in it, they will be of the form \verb~'token[T]]~ or 
*** \verb~'up['token[T], 'bubble[T']]~ for terms \texttt{T} and \texttt{T'}. 
*** The function \texttt{solveUps} will evaluate them.

  op solveBubbles : Term Module Bool OpDeclSet Database -> [Term] .
  op solveUps : TermList Database -> [TermList] .
  op solveUpsCondition : Condition Database -> Condition .
  op solveUpsModExp : TermList Database -> [TermList] .
  op constsToVars : Term OpDeclSet -> Term [memo] .
  op constsToVars : TermList OpDeclSet -> TermList [memo] .
  op constsToVarsAux : Constant OpDeclSet -> Qid [memo] .

  eq constsToVars(F[TL], VDS) = F[constsToVars(TL, VDS)] .
  eq constsToVars(C, VDS) = constsToVarsAux(C, VDS) .
  eq constsToVars(V, VDS) = V . 
  eq constsToVars(qidError(QIL), VDS) = qidError(QIL) . 
  ceq constsToVars((T, TL), VDS) 
    = (constsToVars(T, VDS), constsToVars(TL, VDS)) 
    if TL =/= empty .

  eq constsToVarsAux(C, (op F : nil -> Tp [none] .) VDS) 
    = if getName(C) == F 
      then qid(string(F) + ":" + string(Tp))
      else constsToVarsAux(C, VDS)
      fi .
  eq constsToVarsAux(C, none) = C .

  ceq solveBubbles('bubble[T], M, true, VDS, DB) 
    *** if META-LEVEL is a submodule the ups need to be solved
    = if RP :: ResultPair
      then solveUps(constsToVars(getTerm(RP), VDS), DB)
      else qidError('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n
                    '\r 'Error: '\o 'no 'parse 'for QIL '\n)
      fi 
    if M' := addOps(VDS, M) 
       /\ QIL := downQidList(T)
       /\ RP := metaParse(M', QIL, anyType) .

  ceq solveBubbles('bubble[T], M, false, VDS, DB) 
    = if RP :: ResultPair
      then constsToVars(getTerm(RP), VDS) 
      else qidError('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n
                    '\r 'Error: '\o 'no 'parse 'for QIL '\n)
      fi 
    if M' := addOps(VDS, M) 
       /\ QIL := downQidList(T)
       /\ RP := metaParse(M', QIL, anyType) .

*** The \texttt{solveBubbles1} function is in charge of calling the function 
*** \texttt{metaParse}. The flag indicating the inclusion of the module  
*** \texttt{META-LEVEL} in the module in which the term appears decides 
*** whether the function \texttt{solveUps} is called or not, so the extra 
*** price of searching for calls to the \texttt{up} function is paid only 
*** when an occurrence of the function is possible. This function takes care 
*** of the occurrences of the \texttt{up} function that may exist in such 
*** bubbles.

*** The function \texttt{solveUps} goes through the term looking for a term
*** with \texttt{'up} as top operator and \texttt{'token} as top operator of
*** its unique argument if there is only one argument, or with \texttt{'token}
*** and \texttt{'bubble} as top operators of its first and second arguments,
*** respectively, if there are two. If a term of the form
*** \mbox{\texttt{'up['token[T]]}} is reached, it is replaced by the
*** metarepresentation of the flat version of the module in the database with
*** the name given by the token. If a term of form 
*** \mbox{\texttt{'up['token[T], 'bubble[T']]}} is reached, the 
*** metarepresentation of the result of parsing the bubble in the signature 
*** of the module with the name given by the token, after solving possible 
*** nested calls to the \texttt{up} function, is returned.

  eq solveUps(QI, DB) = QI .
  eq solveUps(F[TL], DB) = F[solveUps(TL, DB)] [owise] .
  ceq solveUps((T, TL), DB) 
    = (solveUps(T, DB), solveUps(TL, DB)) 
    if TL =/= empty .

  eq solveUps('upModule['token[T]], DB) 
    = solveUpsModExp('upModule['token[T]], DB) .
  eq solveUps('upModule['`(_`)[T]], DB) 
    = solveUpsModExp('upModule['`(_`)[T]], DB) .
  eq solveUps('upModule['_`{_`}[T, T']], DB) 
    = solveUpsModExp('upModule['_`{_`}[T, T']], DB) .
  eq solveUps('upModule['_*`(_`)[T, T']], DB) 
    = solveUpsModExp('upModule['_*`(_`)[T, T']], DB) .
  eq solveUps('upModule['_+_[T, T']], DB) 
    = solveUpsModExp('upModule['_+_[T, T']], DB) .
  eq solveUps('upModule['TUPLE`[_`]['token[T]]], DB) 
    = solveUpsModExp('upModule['TUPLE`[_`]['token[T]]], DB) .
  eq solveUps('upModule['POWER`[_`]['token[T]]], DB) 
    = solveUpsModExp('upModule['POWER`[_`]['token[T]]], DB) .

  eq solveUpsCondition(T = T' /\ Cond, DB)  
    = solveUps(T, DB) = solveUps(T', DB) /\ solveUpsCondition(Cond, DB) .
  eq solveUpsCondition(T : S /\ Cond, DB)  
    = solveUps(T, DB) : S /\ solveUpsCondition(Cond, DB) .
  eq solveUpsCondition(T := T' /\ Cond, DB)  
    = T := solveUps(T', DB) /\ solveUpsCondition(Cond, DB) .
  eq solveUpsCondition(T => T' /\ Cond, DB)  
    = solveUps(T, DB) => solveUps(T', DB) /\ solveUpsCondition(Cond, DB) .
  eq solveUpsCondition(nil, DB) = nil .

  ceq solveUpsModExp('upModule[T], DB)
    = up(getFlatModule(MN, DB'))
    if < DB' ; MN > := evalModExp(parseModExp(T), DB) 
    /\ unitInDb(MN, DB') .
  ceq solveUpsModExp('upModule[T], DB)
    = qidError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n)
    if MN := parseModExp(T)
    [owise] .

  eq solveUps('upTerm['token[T], 'bubble[T']], DB) 
    = solveUpsModExp('upTerm['token[T], 'bubble[T']], DB) .
  eq solveUps('upTerm['`(_`)[T], 'bubble[T']], DB) 
    = solveUpsModExp('upTerm['`(_`)[T], 'bubble[T']], DB) .
  eq solveUps('upTerm['_`{_`}[T, T'], 'bubble[T']], DB) 
    = solveUpsModExp('upTerm['_`{_`}[T, T'], 'bubble[T']], DB) .
  eq solveUps('upTerm['_*`(_`)[T, T'], 'bubble[T']], DB) 
    = solveUpsModExp('upTerm['_*`(_`)[T, T'], 'bubble[T']], DB) .
  eq solveUps('upTerm['_+_[T, T'], 'bubble[T']], DB) 
    = solveUpsModExp('upTerm['_+_[T, T'], 'bubble[T']], DB) .
  eq solveUps('upTerm['TUPLE`[_`]['token[T]], 'bubble[T']], DB) 
    = solveUpsModExp('upTerm['TUPLE`[_`]['token[T]], 'bubble[T']], DB) .
  eq solveUps('upTerm['POWER`[_`]['token[T]], 'bubble[T']], DB) 
    = solveUpsModExp('upTerm['POWER`[_`]['token[T]], 'bubble[T']], DB) .

  ceq solveUpsModExp('upTerm[T, 'bubble[T']], DB)
    = if included('META-MODULE, getImports(getInternalModule(MN, DB')), DB')
      then if metaParse(U, QIL, anyType) :: ResultPair
           then up(solveUps(getTerm(metaParse(U, QIL, anyType)), DB'))
           else qidError('\r 'Warning: '\o 
                  'No 'parse 'for 'argument 'of 'up
                  printSyntaxError(metaParse(U, QIL, anyType), QIL) 
                  '\n)
           fi
      else if metaParse(U, QIL, anyType) :: ResultPair
           then up(getTerm(metaParse(U, QIL, anyType)))
           else qidError('\r 'Warning: '\o 
                  'No 'parse 'for 'argument 'of 'up
                  printSyntaxError(metaParse(U, QIL, anyType), QIL) 
                  '\n)
           fi
      fi
    if < DB' ; MN > := evalModExp(parseModExp(T), DB) 
       /\ U := getFlatModule(MN, DB') 
       /\ QIL := downQidList(T').
  ceq solveUpsModExp('upTerm[T, 'bubble[T']], DB)
    = qidError('\r 'Error: 'op '\o 'Module header2QidList(ME) 'not 'in 'database. '\n)
    if ME := parseModExp(T)
    [owise] .

  eq solveUps('`[_`][QI], DB) = '`[_`][QI] .
  ceq solveUps('`[_`]['token[T]], DB)
    = up(getFlatModule(QI, database(evalModExp(QI, DB))))
    if QI := downQid(T) .
  eq solveUps('`[_`][F[TL]], DB) = '`[_`][F[solveUps(TL, DB)]] [owise] .

endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** Parsing the Bubbles in a Module
***

*** The \texttt{solveBubbles} function defined in the
*** \texttt{UNIT-BUBBLE-PARSING} module takes a term of sort \texttt{Module} (a
*** preunit in fact) and a signature, and returns the unit resulting from the 
*** evaluation (parsing) of all the bubbles in it.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod UNIT-BUBBLE-PARSING is
  pr BUBBLE-PARSING .
  pr DATABASE .
  pr MOVE-UP .
  pr MOVE-DOWN .
  pr PRINT-SYNTAX-ERROR .

  vars T T' T'' T3 T4 : Term .
  vars T? T?' : [Term] .
  vars TL TL' TL'' : TermList .
  vars TL? TL?' : [TermList] .
  var  B : Bool .
  vars M M' M'' : Module .
  var  DB : Database .
  vars PU U U' : Module .
  var  K : Kind .
  var  KS : KindSet .
  vars S S' : Sort .
  var  SS : SortSet .
  var  VE : ViewExp .
  vars Ty Ty' Tp : Type .
  vars TyL TyL' : TypeList .
  var  At : Attr .
  vars AtS AtS' AtS'' : AttrSet .
  var  NL : IntList .
  var  QI QI' QI'' QI3 QI4 QI5 F L : Qid .
  vars QIL QIL' : QidList .
  var  I : Nat .
  var  Hk : Hook .
  var  HkL : HookList .
  var  MAS : MembAxSet .
  var  Eq : Equation .
  var  EqS : EquationSet .
  var  Rl : Rule .
  var  RlS : RuleSet .
  var  OPD : OpDecl .
  vars OPDS OPDS' OPDS'' VDS : OpDeclSet .
  var  CD? : [Condition] .
  var  Ct : Constant .
  var  RP : [ResultPair] .

*** In the parsing of bubbles themselves, we consider three different cases: 
*** The case of having one single bubble in which no context is 
*** considered (used to parse bubbles in term maps in views and in the 
*** special attributes of operators); the case of two bubbles to be parsed in 
*** the same connected component (used for bubbles in equations and rules), 
*** and the case of one bubble to be parsed in a specific sort (used for the 
*** bubbles appearing in the identity element attributes in the declarations 
*** of operators, and in membership axioms). These three cases are reduced to 
*** the case of one single bubble without context, which is handled by the 
*** function \texttt{solveBubbles3}.

  op solveBubblesEq : Term Term Module Bool OpDeclSet Database -> Term .
  op solveBubblesCEq : Term Term Module Bool OpDeclSet Database -> Term .
  op solveBubblesRl : Term Term Module Bool OpDeclSet Database -> Term .
  op solveBubblesCRl : Term Term Module Bool OpDeclSet Database -> Term .
  op solveBubbles2 : Term [Type] Module Bool OpDeclSet Database -> Term .
  op solveBubblesCond : Term Module Module Bool OpDeclSet Database -> [Condition] .

  op conditionError : QidList -> [Condition] [ctor format (r o)] .

*** The case of two bubbles, generated in the case of equations and rules, is 
*** reduced to the case with one single bubble using the polymorphic operator
*** \verb~_==_~ and enclosing each of the bubbles in parentheses. Below, we 
*** shall see how after calling this function the terms corresponding to each 
*** of the bubbles is extracted.

  ceq solveBubblesEq('bubble[T], 'bubble[T'], M, B, VDS, DB)
    = if RP :: ResultPair
      then if B 
           then solveUps(constsToVars(getTerm(RP), VDS), DB) 
           else constsToVars(getTerm(RP), VDS) 
           fi 
      else qidError('\r 'Warning: 
                 '\o printSyntaxError(RP, '`( QIL '`) '= '`( QIL' '`)) '\n
                 '\r 'Error: '\o 'no 'parse 'for 'eq QIL '\s '~ '\s QIL' '\n)
      fi 
    if M' := addOps((VDS
                     op '_=_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .), 
               addSorts('@@@, M)) 
       /\ QIL := downQidList(T) 
       /\ QIL' := downQidList(T') 
       /\ RP := metaParse(M', '`( QIL '`) '= '`( QIL' '`), '@@@) .

  ceq solveBubblesCEq('bubble[T], 'bubble[T'], M, B, VDS, DB)
    = if RP :: ResultPair
      then if B 
           then solveUps(constsToVars(getTerm(RP), VDS), DB) 
           else constsToVars(getTerm(RP), VDS) 
           fi 
      else qidError('\r 'Warning: 
                 '\o printSyntaxError(RP, '`( QIL '`) '= '`( QIL' '`)) '\n
                 '\r 'Error: '\o 'no 'parse 'for 'ceq QIL '\s '~ '\s QIL' '\n)
      fi 
    if M' := addOps((VDS
                     op '_=_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .), 
               addSorts('@@@, M)) 
       /\ QIL := downQidList(T) 
       /\ QIL' := downQidList(T') 
       /\ RP := metaParse(M', '`( QIL '`) '= '`( QIL' '`), '@@@) .

  ceq solveBubblesRl('bubble[T], 'bubble[T'], M, B, VDS, DB)
    = if RP :: ResultPair
      then if B 
           then solveUps(constsToVars(getTerm(RP), VDS), DB) 
           else constsToVars(getTerm(RP), VDS) 
           fi 
      else qidError('\r 'Warning: 
                 '\o printSyntaxError(RP, '`( QIL '`) '=> '`( QIL' '`)) '\n
                 '\r 'Error: '\o 'no 'parse 'for 'rl QIL '\s '=> '\s QIL' '\n)
      fi 
    if M' := addOps((VDS
                     op '_=>_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .), 
               addSorts('@@@, M)) 
       /\ QIL := downQidList(T) 
       /\ QIL' := downQidList(T') 
       /\ RP := metaParse(M', '`( QIL '`) '=> '`( QIL' '`), '@@@) .
  ceq solveBubblesCRl('bubble[T], 'bubble[T'], M, B, VDS, DB)
    = if RP :: ResultPair
      then if B 
           then solveUps(constsToVars(getTerm(RP), VDS), DB) 
           else constsToVars(getTerm(RP), VDS) 
           fi 
      else qidError('\r 'Warning: 
                 '\o printSyntaxError(RP, '`( QIL '`) '=> '`( QIL' '`)) '\n
                 '\r 'Error: '\o 'no 'parse 'for 'crl QIL '\s '=> '\s QIL' '\n)
      fi 
    if M' := addOps((VDS
                     op '_=>_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .), 
               addSorts('@@@, M)) 
       /\ QIL := downQidList(T) 
       /\ QIL' := downQidList(T') 
       /\ RP := metaParse(M', '`( QIL '`) '=> '`( QIL' '`), '@@@) .


  ceq solveBubbles2('bubble[T], T?:Type?, M, true, VDS, DB)
    = if RP :: ResultPair
      then solveUps(constsToVars(getTerm(RP), VDS), DB)
      else qidError('\r 'Warning: 
                 '\o printSyntaxError(RP, QIL) '\n 
                 '\r 'Error: 'No 'parse 'for QIL '\n)
      fi 
    if QIL := downQidList(T) 
       /\ RP := metaParse(M, QIL, T?:Type?) .
  ceq solveBubbles2('bubble[T], T?:Type?, M, false, VDS, DB)
    = if RP :: ResultPair
      then constsToVars(getTerm(RP), VDS) 
      else qidError('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n 
                 '\r 'Error: 'No 'parse 'for QIL '\n)
      fi 
    if QIL := downQidList(T) 
       /\ RP := metaParse(M, QIL, T?:Type?) .

  op addInfoConds : Module -> [Module] .
  op addInfoConds : Module SortSet -> Module . 

  eq addInfoConds(M) = addInfoConds(M, getAllSorts(M)) .

  eq addInfoConds(M, '@Token@ ; SS) = addInfoConds(M, SS) .
  eq addInfoConds(M, '@Bubble@ ; SS) = addInfoConds(M, SS) .
  eq addInfoConds(M, S ; SS)
    = addInfoConds(
        addOps(op qid(string(S)) : nil -> '@Sort@ [ctor] .
               op '_:_ : S '@Sort@ -> '@Condition@ [ctor prec(71)] ., M), 
        SS) 
    [owise] .
  eq addInfoConds(M, none) 
    = addOps(op '_/\_ : '@Condition@ '@Condition@ -> '@Condition@ 
                               [ctor assoc prec(73)] .
             op '_=_  : 'Universal 'Universal -> '@Condition@ 
                               [ctor poly(1 2) prec(71)] .
             op '_:=_ : 'Universal 'Universal -> '@Condition@
                               [ctor poly(1 2) prec(71)] .
             op '_=>_ : 'Universal 'Universal -> '@Condition@
                               [ctor poly(1 2) prec(71)] .,
        addSorts('@Condition@ ; '@Sort@, 
          if 'Bool in getSorts(M)
          then addSubsorts(subsort 'Bool < '@Condition@ ., M)
          else M
          fi)) .

  ceq solveBubblesCond('bubble[T], M, M', B, VDS, DB)
    = if 'Bool in getSorts(M) 
         and-then metaParse(M, QIL, 'Bool) :: ResultPair
      then if B 
           then solveUps(constsToVars(getTerm(metaParse(M, QIL, 'Bool)), VDS), DB) 
                = 'true.Bool
           else constsToVars(getTerm(metaParse(M, QIL, 'Bool)), VDS) 
                = 'true.Bool
           fi
      else if metaParse(M', QIL, '@Condition@) :: ResultPair
           then if B 
                then solveUpsCondition(
                       parseCond(getTerm(metaParse(M', QIL, '@Condition@)), VDS), DB)
                else parseCond(getTerm(metaParse(M', QIL, '@Condition@)), VDS)
                fi
           else conditionError('\r 'Warning: '\o 
                  printSyntaxError(metaParse(M', QIL, '@Condition@), QIL) '\n)
           fi
      fi 
    if QIL := downQidList(T) .

  op parseCond : Term OpDeclSet -> Condition .

  eq parseCond('_/\_[T, T'], VDS) = parseCond(T, VDS) /\ parseCond(T', VDS) .
  eq parseCond('_=_[T, T'], VDS) 
    = constsToVars(T, VDS) = constsToVars(T', VDS) .
  eq parseCond('_:_[T, T'], VDS) = constsToVars(T, VDS) : getName(T') .
  eq parseCond('_:=_[T, T'], VDS) 
    = constsToVars(T, VDS) := constsToVars(T', VDS) .
  eq parseCond('_=>_[T, T'], VDS) 
    = constsToVars(T, VDS) => constsToVars(T', VDS) .
  eq parseCond(T, VDS) = constsToVars(T, VDS) = 'true.Bool [owise] .

*** Since bubbles can only appear in the identity or special attributes in the 
*** declaration of operators, in equations, membership axioms, and rules, the 
*** evaluation of bubbles on a preunit is reduced to calls to the 
*** \texttt{solveBubbles} functions on each of these sTS of declarations.

  op solveBubblesMod : Module OpDeclSet Module Bool OpDeclSet Database -> Module .

  op solveBubbles : EquationSet Module [Module] Bool OpDeclSet Database -> EquationSet .
  op solveBubbles : RuleSet Module [Module] Bool OpDeclSet Database -> RuleSet .
  op solveBubbles : MembAxSet Module [Module] Bool OpDeclSet Database -> MembAxSet .
  op solveBubbles : Condition Module Bool OpDeclSet Database -> Condition .
  op solveBubblesOps : OpDeclSet OpDeclSet Module Module -> OpDeclSet .
  op solveBubblesOps : OpDeclSet OpDeclSet Module -> OpDeclSet .
  op solveBubblesOpsAux : OpDeclSet Module -> OpDeclSet .
  op solveBubblesAts : AttrSet TypeList Type Module -> AttrSet .
  op solveBubblesHooks : HookList Type Module -> HookList .

  ceq solveBubblesMod(PU, OPDS, M, B, VDS, DB)
    = setOps(
       (if getMbs(PU) == none and getEqs(PU) == none and getRls(PU) == none
        then PU
        else setEqs(
               setMbs(
                 setRls(PU, 
                   solveBubbles(getRls(PU), M', addInfoConds(M'), B, VDS, DB)),
                 solveBubbles(getMbs(PU), M', addInfoConds(M'), B, VDS, DB)),
               solveBubbles(getEqs(PU), M', addInfoConds(M'), B, VDS, DB))
        fi),
       solveBubblesOps(getOps(PU), OPDS, M'))
    if M' := addOps(VDS, M) . 

*** To avoid the parsing ambiguities in the identity elements we add the sort 
*** of the operator to be used as context in which doing the parsing. We
*** assume that the term given as identity element of an operator is in the 
*** kind of the sort of such operator.

  eq solveBubblesOps(OPDS, OPDS', M)
    = solveBubblesOps(OPDS, OPDS', 
        setSubsorts(
          setSorts(emptyFModule('DUMMY), getSorts(M)), getSubsorts(M)), M) .

  ceq solveBubblesOps(
       op F : TyL -> Ty [ditto AtS] . op F : TyL' -> Ty' [AtS'] . OPDS,
       OPDS', M, M')
    = solveBubblesOps(
        op F : TyL -> Ty [AtS AtS''] . op F : TyL' -> Ty' [AtS''] . OPDS, 
        OPDS', M, M')
    if ditto in AtS' =/= true
       /\ sameKind(M, TyL Ty, TyL' Ty') 
       /\ AtS'' := solveBubblesAts(AtS', TyL', Ty', M') .
  ceq solveBubblesOps(op F : TyL -> Ty [ditto AtS] . OPDS, 
       op F : TyL' -> Ty' [AtS'] . OPDS', M, M')
    = solveBubblesOps(op F : TyL -> Ty [AtS''] . OPDS,
        op F : TyL' -> Ty' [AtS''] . OPDS', M, M')
    if ditto in AtS' =/= true
       /\ sameKind(M, TyL Ty, TyL' Ty') 
----       /\ AtS'' := solveBubblesAts(AtS', TyL, Ty, M') 
       /\ AtS'' := AtS'
    [owise] .
  eq solveBubblesOps(OPDS, OPDS', M, M') 
    = solveBubblesOpsAux(OPDS, M') 
    [owise] .

  eq solveBubblesOpsAux(op F : TyL -> Ty [AtS] . OPDS, M)
    = op F : TyL -> Ty [solveBubblesAts(AtS, TyL, Ty, M)] .
      solveBubblesOpsAux(OPDS, M) .
  eq solveBubblesOpsAux(none, M) = none .

  eq solveBubblesAts(id('bubble[T]) AtS, TyL, Ty, M)
    = (id(solveBubbles2('bubble[T], Ty, M, false, none, emptyDatabase)) 
       solveBubblesAts(AtS, TyL, Ty, M)) .
  eq solveBubblesAts(left-id('bubble[T]) AtS, Ty TyL, Ty', M)
    = (left-id(solveBubbles2('bubble[T], Ty, M, false, none, emptyDatabase)) 
       solveBubblesAts(AtS, Ty TyL, Ty', M)) .
  eq solveBubblesAts(right-id('bubble[T]) AtS, TyL Ty, Ty', M)
    = (right-id(solveBubbles2('bubble[T], Ty, M, false, none, emptyDatabase)) 
       solveBubblesAts(AtS, TyL Ty, Ty', M)) .
  eq solveBubblesAts(special(HkL) AtS, TyL, Ty, M)
    = (special(solveBubblesHooks(HkL, Ty, M)) 
       solveBubblesAts(AtS, TyL, Ty, M)) .
  eq solveBubblesAts(AtS, TyL, Ty, M) = AtS [owise] .

  eq solveBubblesHooks(term-hook(QI, 'bubble[T]) HkL, Ty, M)
    = term-hook(QI, 
        solveBubbles2('bubble[T], anyType, M, false, none, emptyDatabase)) 
      solveBubblesHooks(HkL, Ty, M) .
  eq solveBubblesHooks(Hk HkL, Ty, M) 
    = Hk solveBubblesHooks(HkL, Ty, M) 
    [owise] .
  eq solveBubblesHooks(nil, Ty, M) = nil .

*** Since both sides of any equation or rule have to be in the same connected
*** component of sorts, we parse the two bubbles together using the
*** polymorphic operator \verb~_==_~\footnote{Note that if including
*** \texttt{BOOL} the operator \texttt{\_\,==\_\,} is added for each kind.}.
*** That is, given for example an equation as \verb~eq T = T' .~, we parse
*** \verb~T == T'~, forcing them to be parsed in the same connected component,
*** if possible. We add functions \texttt{lhs} and \texttt{rhs} to extract, 
*** respectively, the lefthand and righthand side terms from the result. Note 
*** that these are partial functions.

  sort Pair{Term,AttrSet} .

  op pullStmtAttrOut : Term OpDeclSet -> [Pair{Term,AttrSet}] .
  op pullStmtAttrOutAux : Term TermList AttrSet OpDeclSet -> [Pair{Term,AttrSet}] .
  op pullLabelOut : Term -> [Pair{Term,AttrSet}] .
  op {_,_} : Term AttrSet -> Pair{Term,AttrSet} .
  op term : Pair{Term,AttrSet} -> Term .
  op attrSet : Pair{Term,AttrSet} -> AttrSet .

  eq term({T, AtS}) = T .
  eq attrSet({T, AtS}) = AtS .

  eq pullStmtAttrOut('bubble[QI], VDS) = {'bubble[QI], none} .
  eq pullStmtAttrOut('bubble['__[QI, QI']], VDS) = {'bubble['__[QI, QI']], none} .
  eq pullStmtAttrOut('bubble['__[QI, QI', QI'']], VDS) 
    = {'bubble['__[QI, QI', QI'']], none} .
  eq pullStmtAttrOut('bubble['__[QI, QI', TL, QI'']], VDS) 
    = if QI'' =/= ''`].Qid 
      then {'bubble['__[QI, QI', TL, QI'']], none}
      else pullStmtAttrOutAux(
             'bubble['__[QI, QI', TL, QI'']], (QI, QI', TL), none, VDS) 
      fi .

  eq pullStmtAttrOutAux(T, (TL, ''`[.Qid), AtS, VDS) 
    = if AtS =/= none 
      then {'bubble['__[TL]], AtS}
      else {T, none}
      fi . 
  eq pullStmtAttrOutAux(T, (TL, QI, ''nonexec.Qid), AtS, VDS) 
    = pullStmtAttrOutAux(T, (TL, QI), AtS nonexec, VDS) .
  eq pullStmtAttrOutAux(T, (TL, QI, ''owise.Qid), AtS, VDS) 
    = pullStmtAttrOutAux(T, (TL, QI), AtS owise, VDS) .
  eq pullStmtAttrOutAux(T, (TL, QI, ''otherwise.Qid), AtS, VDS) 
    = pullStmtAttrOutAux(T, (TL, QI), AtS owise, VDS) .
  eq pullStmtAttrOutAux(T, (TL, QI, ''label.Qid, QI'), AtS, VDS) 
    = if downQid(QI') :: Qid
      then pullStmtAttrOutAux(T, (TL, QI), AtS label(downQid(QI')), VDS)
      else {T, none}
      fi .
  eq pullStmtAttrOutAux(T, (TL, QI, ''metadata.Qid, QI'), AtS, VDS) 
    = if downString(downQid(QI')) :: String
      then pullStmtAttrOutAux(T, (TL, QI), AtS metadata(downString(downQid(QI'))), VDS)
      else {T, none}
      fi .
  ceq pullStmtAttrOutAux(T, (TL, QI, ''`[.Qid, TL',  ''print.Qid, TL''), AtS, VDS) 
    = pullStmtAttrOutAux(T, (TL, QI, ''`[.Qid, TL'), AtS print(printArg(TL'', VDS)), VDS) 
    if printArg(TL'', VDS) : QidList .
  eq pullStmtAttrOutAux(T, TL, AtS, VDS) = {T, none} [owise] .
  
  op printArg : TermList OpDeclSet ~> QidList .
  ceq printArg((T, TL), op QI : nil -> Tp [AtS] . VDS) 
    = qid(string(downQid(T)) + ":" + string(Tp)) printArg(TL, VDS) 
    if QI = downQid(T) .
  ceq printArg((T, TL), VDS)
    = downQid(T) printArg(TL, VDS)
    if downString(downQid(T)) : String .
  eq printArg(empty, VDS) = nil .

  eq pullLabelOut('bubble[QI]) = {'bubble[QI], none} .
  eq pullLabelOut('bubble['__[QI, QI']]) = {'bubble['__[QI, QI']], none} .
  eq pullLabelOut('bubble['__[QI, QI', QI'']]) 
    = {'bubble['__[QI, QI', QI'']], none} .
  eq pullLabelOut('bubble['__[QI, QI', QI'', QI3]]) 
    = {'bubble['__[QI, QI', QI'', QI3]], none} .
  eq pullLabelOut('bubble['__[QI, QI', QI'', QI3, TL]])
    = if QI == ''`[.Qid and-then (QI'' == ''`].Qid and-then QI3 == '':.Qid)
      then {'bubble['__[TL]], label(downQid(QI'))} 
      else {'bubble['__[QI, QI', QI'', QI3, TL]], none}
      fi .

  ops lhs rhs : Term -> Term .
  eq lhs('_=_[T, T']) = T .
  eq lhs('_=>_[T, T']) = T .
  eq rhs('_=_[T, T']) = T' .
  eq rhs('_=>_[T, T']) = T' .
  eq lhs(qidError(QIL)) = qidError(QIL) .
  eq rhs(qidError(QIL)) = qidError(QIL) .

  eq solveBubbles(EqS, M, unitError(QIL), B, VDS, DB) = equationError(QIL) .
  eq solveBubbles(RlS, M, unitError(QIL), B, VDS, DB) = ruleError(QIL) .
  eq solveBubbles(MAS, M, unitError(QIL), B, VDS, DB) = membAxError(QIL) .

  eq solveBubbles(((eq T = T' [AtS] .) EqS), M, M', B, VDS, DB)
    = ((eq lhs(solveBubblesEq(term(pullLabelOut(T)), term(pullStmtAttrOut(T', VDS)), 
                 M, B, VDS, DB)) 
          = rhs(solveBubblesEq(term(pullLabelOut(T)), term(pullStmtAttrOut(T', VDS)), 
                  M, B, VDS, DB)) 
            [attrSet(pullLabelOut(T)) attrSet(pullStmtAttrOut(T', VDS)) AtS] .)
       solveBubbles(EqS, M, M', B, VDS, DB)) .
  eq solveBubbles(((ceq T = T' if T'' = 'true.Bool [AtS] .) EqS), 
       M, M', B, VDS, DB)
    = ((ceq lhs(solveBubblesCEq(term(pullLabelOut(T)), T', M, B, VDS, DB)) 
          = rhs(solveBubblesCEq(term(pullLabelOut(T)), T', M, B, VDS, DB))
          if solveBubblesCond(term(pullStmtAttrOut(T'', VDS)), M, M', B, VDS, DB) 
          [attrSet(pullLabelOut(T)) attrSet(pullStmtAttrOut(T'', VDS)) AtS] .)
       solveBubbles(EqS, M, M', B, VDS, DB)) .
  eq solveBubbles((none).EquationSet, M, M', B, VDS, DB) = none .

  eq solveBubbles(((rl T => T' [AtS] .) RlS), M, M', B, VDS, DB)
    = ((rl lhs(solveBubblesRl(term(pullLabelOut(T)), 
                 term(pullStmtAttrOut(T', VDS)), M, B, VDS, DB)) 
        => rhs(solveBubblesRl(term(pullLabelOut(T)),  
                 term(pullStmtAttrOut(T', VDS)), M, B, VDS, DB))
             [attrSet(pullLabelOut(T)) attrSet(pullStmtAttrOut(T', VDS)) AtS] .)
       solveBubbles(RlS, M, M', B, VDS, DB)) .
  eq solveBubbles(
       ((crl T => T' if T'' = 'true.Bool [AtS] .) RlS), M, M', B, VDS, DB)
    = ((crl lhs(solveBubblesCRl(term(pullLabelOut(T)), T', M, B, VDS, DB)) 
          => rhs(solveBubblesCRl(term(pullLabelOut(T)), T', M, B, VDS, DB))
          if solveBubblesCond(term(pullStmtAttrOut(T'', VDS)), M, M', B, VDS, DB) 
          [attrSet(pullLabelOut(T)) attrSet(pullStmtAttrOut(T'', VDS)) AtS] .)
       solveBubbles(RlS, M, M', B, VDS, DB)) .
  eq solveBubbles((none).RuleSet, M, M', B, VDS, DB) = none .

*** In the call to solve the bubbles in membership axioms we add the sort to
*** which it is constrained to be used as context.

  eq solveBubbles(((mb T : S [AtS] .) MAS), M, M', B, VDS, DB)
    = ((mb solveBubbles2(term(pullLabelOut(T)), S, M, B, VDS, DB) : S 
           [attrSet(pullLabelOut(T)) AtS] .) 
       solveBubbles(MAS, M, M', B, VDS, DB)) .
  eq solveBubbles(((cmb T : S if T' = 'true.Bool [AtS] .) MAS), 
       M, M', B, VDS, DB)
    = ((cmb solveBubbles2(term(pullLabelOut(T)), S, M, B, VDS, DB) : S
          if solveBubblesCond(T', M, M', B, VDS, DB) 
          [attrSet(pullLabelOut(T)) AtS] .)
       solveBubbles(MAS, M, M', B, VDS, DB)) .
  eq solveBubbles((none).MembAxSet, M, M', B, VDS, DB) = none .

*** The parsing process may generate error terms. Since in the
*** current version of the system Core Maude is generating the appropriate
*** error messages, we just have to worry about the elimination of these
*** terms. The effect is the same one as introducing a module at the object
*** level of Core Maude: If there is any term in an identity attribute in an
*** operator declaration, equation, rule, or membership axiom with a parsing 
*** error a message is generated and the axiom is eliminated.

  eq (op F : TyL -> Ty [id(qidError(QIL)) AtS] .) = opDeclError(QIL) .
  eq (op F : TyL -> Ty [left-id(qidError(QIL)) AtS] .) = opDeclError(QIL) .
  eq (op F : TyL -> Ty [right-id(qidError(QIL)) AtS] .) = opDeclError(QIL) .

  eq (conditionError(QIL) /\ T = T' /\ CD?) = conditionError(QIL) .
  eq (conditionError(QIL) /\ T : S /\ CD?) = conditionError(QIL) .
  eq (conditionError(QIL) /\ T := T' /\ CD?) = conditionError(QIL) .
  eq (conditionError(QIL) /\ T => T' /\ CD?) = conditionError(QIL) .

  eq (eq qidError(QIL) = T? [AtS] .) = equationError(QIL) .
  eq (eq T? = qidError(QIL) [AtS] .) = equationError(QIL) .
  eq (ceq qidError(QIL) = T? if CD? [AtS] .) = equationError(QIL) .
  eq (ceq T? = qidError(QIL) if CD? [AtS] .) = equationError(QIL) .
  eq (ceq T? = T?' if conditionError(QIL) [AtS] .) = equationError(QIL) .

  eq (mb qidError(QIL) : S [AtS] .) = membAxError(QIL) .
  eq (cmb qidError(QIL) : S if CD? [AtS] .) = membAxError(QIL) .
  eq (cmb T? : S if conditionError(QIL) [AtS] .) = membAxError(QIL) .

  eq (rl qidError(QIL) => T? [AtS] .) = ruleError(QIL) .
  eq (rl T? => qidError(QIL) [AtS] .) = ruleError(QIL) .
  eq (crl qidError(QIL) => T? if CD? [AtS] .) = ruleError(QIL) .
  eq (crl T? => qidError(QIL) if CD? [AtS] .) = ruleError(QIL) .
  eq (crl T? => T?' if conditionError(QIL) [AtS] .) = ruleError(QIL) .

  eq F[qidError(QIL), TL?] = qidError(QIL) .
  eq F[TL?, qidError(QIL)] = qidError(QIL) .
  eq F[TL?, qidError(QIL), TL?'] = qidError(QIL) .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

*** The function \texttt{solveBubbles} defined in the following
*** \texttt{VIEW-BUBBLE-PARSING} module parses the bubbles in a set of preview
*** maps. It takes two modules, the signature of the view's source theory,
*** with the variables declared in the view, to parse the source term in the
*** term maps, and the target theory, with the mappings of the variable 
*** declarations in the view, to parse the target terms.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod VIEW-BUBBLE-PARSING is
  pr BUBBLE-PARSING .
  pr PRE-VIEW .

  var  PVMAPS : Set{PreViewMap} .
  var  VMAP : ViewMap .
  vars T T' : Term .
  vars M M' : Module .
  var  U : Module .
  var  QIL : QidList .
  vars VDS VDS' : OpDeclSet .

  op solveBubbles : Set{PreViewMap} OpDeclSet OpDeclSet Module Module -> RenamingSet .

  eq solveBubbles(PVMAPS, VDS, VDS', U, unitError(QIL)) = none .
  eq solveBubbles(PVMAPS, VDS, VDS', unitError(QIL), U) = none .
  eq solveBubbles(VMAP, VDS, VDS', M, M') = VMAP [owise] .
  eq solveBubbles((VMAP, PVMAPS), VDS, VDS', M, M')
    = (VMAP, solveBubbles(PVMAPS, VDS, VDS', M, M')) 
    [owise] .
  eq solveBubbles(preTermMap(T, T'), VDS, VDS', M, M')
    = termMap(
         solveBubbles(T, M, false, VDS, emptyDatabase),
         solveBubbles(T', M', false, VDS', emptyDatabase)) .
  eq solveBubbles((preTermMap(T, T'), PVMAPS), VDS, VDS', M, M')
    = (termMap(
         solveBubbles(T, M, false, VDS, emptyDatabase),
         solveBubbles(T', M', false, VDS', emptyDatabase)),
      solveBubbles(PVMAPS, VDS, VDS', M, M')) .
  eq solveBubbles(none, VDS, VDS', M, M') = none .

endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** Module Expression Evaluation
***

*** So far we have not introduced more module expressions than those given by
*** simple quoted identifiers. We will introduce some later, but the scheme
*** followed for evaluating them is very simple and can be presented in a
*** generic way. Given a module expression and a database state, the
*** evaluation of a module expression results in the generation of a new
*** module, which is introduced in the database, with the module expression
*** as its name. The resulting database is then returned. If there is already
*** a module in the database with that name, the function returns the original
*** database without any change. The evaluation of a module expression may
*** produce the evaluation of other module expressions contained in the
*** modules involved in the process. This is the case, for example, for the
*** renaming of modules, in which not only the top module is renamed but,
*** perhaps, some of its submodules as well; it is also the case for the
*** instantiation of parameterized modules, where the module being 
*** instantiated may contain submodules which are parameterized by some of 
*** the parameter theories of the parameterized module in which are imported. 
*** We shall discuss in more detail the renaming and instantiation of module 
*** expressions in Sections~\ref{renaming} and~\ref{instantiation}, 
*** respectively.

*** We saw in Section~\ref{module-expressions} how it is possible to import a
*** module expression in which a parameterized module is instantiated by some
*** of the formal parameters of the parameterized module into which it is
*** imported. To be able to evaluate this kind of module expression, the list
*** of parameters of the module in which the module expression appears has to 
*** be given.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod MOD-EXPR-EVAL is
  pr DATABASE .

  *** decl. moved to module DATABASE
  *** op evalModExp : ModuleExpression Database -> Database .
  op evalModExp : ModuleExpression ParameterDeclList Database -> Tuple{Database, ModuleExpression} .
  op evalViewExp : ViewExp ParameterDeclList Database -> Database .
  op evalViewExp : ParameterList ParameterDeclList Database -> Database .

  var  S : Sort .
  var  QI : Qid .
  var  ME : ModuleExpression .
  var  PDL : ParameterDeclList .
  var  DB : Database .
  vars VE VE' VE'' : ViewExp .
  vars PL PL' : ParameterList .

  eq evalModExp(ME, DB) = evalModExp(ME, nil, DB) .

  eq evalModExp(ME, PDL, DB) = < DB ; ME > [owise] .

  eq evalModExp(QI, PDL, DB) 
    = if unitInDb(QI, DB)
      then if compiledModule(QI, DB)
           then < DB ; QI >
           else < procModule(QI, DB) ; QI >
           fi
      else if upModule(QI, false) :: Module 
           then < procModule(QI, insTermModule(QI, upModule(QI, false), DB)) ; QI > 
           else < warning(DB, '\r 'Error: '\o 'Module QI 'not 'in 'database. '\n) ; QI >
           fi
      fi .

  eq evalViewExp(QI, PDL, DB)
    = if labelInParameterDeclList(QI, PDL) 
      then DB
      else if viewInDb(QI, DB) 
           then if compiledView(QI, DB)
                then DB
                else procView(QI, DB)
                fi
           else warning(DB, ('\r 'Error: '\o 'View QI 'not 'in 'database. '\n))
           fi
      fi .
  eq evalViewExp(S{PL}, PDL, DB)
    = if viewInDb(S{PL}, DB)
      then DB
      else viewInst(S, PL, PDL, evalViewExp(S, PDL, evalViewExp(PL, PDL, DB)))
      fi .
  ceq evalViewExp(VE ;; VE', PDL, DB)
    = evalViewExp(VE, PDL, evalViewExp(VE', PDL, DB))
    if VE =/= mtViewExp /\ VE' =/= mtViewExp .
  eq evalViewExp((S, PL), PDL, DB)
    = evalViewExp(S, PDL, evalViewExp(PL, PDL, DB)) 
    [owise] .
  eq evalViewExp((S{PL}, PL'), PDL, DB)
    = evalViewExp(S{PL}, PDL, evalViewExp(PL', PDL, DB)) 
    [owise] .
  eq evalViewExp(nil, PDL, DB) = DB . 

  op viewInst : ViewExp ViewExp ParameterDeclList Database -> Database .

*******************************************************************************
*** The equations specifying its behavior are later, in INST-EXPR-EVALUATION **
*******************************************************************************

endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

*** 
*** The Transformation of Object-Oriented Modules to System Modules
***

*** The transformation of object-oriented modules into system modules has
*** already been discussed in Section~\ref{omod2mod}, and also in
*** \cite{Meseguer93b,ClavelDuranEkerLincolnMarti-OlietMeseguerQuesada99}. 
*** We focus here on the part of the process accomplished by each of the main

*** functions involved in the transformation. The transformation discussed
*** in~\cite{DuranMeseguer98} assumed that object-oriented modules were
*** flattened before being transformed into system modules. However, doing it
*** in this way, the transformations already made for the modules in the
*** structure were not reused. In the current system, the transformation is
*** done only for the module being introduced, the top of the structure, and 
*** dusing the `internal' representations of the submodules stored in the 
*** ddatabase for the rest of the structure.

*** This approach requires gathering all class and subclass relation
*** declarations in the structure before starting with the transformation
*** process itself. The function \texttt{prepClasses} collects all these
*** declarations in the structure, and completes all the declarations of 
*** classes with the attributes inherited from their superclasses. 
*** \begin{comment} 
*** This function makes use of a `dummy' module, in which the classes are
*** introduced as sorts and the subclass relations as subsort relations to be 
*** able to compute all the operations on the subclass relation using the 
*** built-in functions on sorts.  
*** \end{comment}

*** Once all the class declarations in the structure have been collected and
*** completed, the transformation is accomplished in two stages. First, the
*** function \texttt{omod2modAux} carries out the 
*** following tasks:
*** \begin{itemize} 
*** \item For each class declaration of the form 
***       $\texttt{class }C\texttt{ | }a_1\texttt{:} S_1\texttt{,}
***       \ldots\texttt{,} a_n\texttt{:} S_n$, the following items are
***       introduced: a subsort $C$ of sort \texttt{Cid}, a constant
***       $C$ of sort $C$, and declarations of operations $a_i
***       \texttt{\ :\_} \texttt{ :\,\,} S_i \texttt{ -> Attribute}$
***       for each attribute $a_i$ (the function
***       \texttt{ops4Attr} creates these declarations).
*** \item For each subclass relation of the form 
***       $\texttt{subclass\ }C\texttt{\ <\ }C'$, a subsort
***       declaration $\texttt{subsort\ }C\texttt{\ <\ }C'$ is
***       introduced.
*** \item For each message declaration of the form \verb~msg F : TyL
***       -> S~, an operator declaration \verb~op F : TyL -> S~ is added.
*** \end{itemize} 
*** When this process has been completed, the function \texttt{prepAxs} is
***  called.  This function applies to the membership axioms, equations, and
*** rewriting rules in the module the transformations indicated in
*** Section~\ref{omod2mod}, so that they become applicable to all the objects
*** of the given class and of their subclasses. The set of attributes of the
*** objects appearing in the membership axioms, equations, and rewriting rules
*** are completed, so that the default convention of not having to 
*** exhaustively mention the set of attributes of a class is supported.

*** Note that in Meseguer's paper~\cite{Meseguer93b} a parallel hierarchy of
*** sorts was defined to deal with objects in different classes, and membership
*** axioms constraining the objects to their corresponding sorts were added.
*** The transformation could be easily completed with sorts, subsort relations,
*** and membership constraints as indicated there. In fact, these declarations
*** were added in an initial version and were then removed because they were
*** computationally expensive. However, there are examples in which it would 
*** be interesting to have them; when needed, these declarations can be 
*** explicitly added by the user in the current version.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

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

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

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

endfm

fmod O-O-TO-SYSTEM-MOD-TRANSF is
  pr DATABASE .
  pr CONVERSION .
  pr TERMSET .

  var  DB : Database .
  var  I : Nat .
  var  ME : Header .
  vars S S' S'' C C' : Sort .
  vars SS SS' SS'' : SortSet .
  var  Ty : Type .
  var  TyL : TypeList .
  vars T T' T'' T3 : Term .
  vars TL TL' : TermList .
  var  PL : ParameterList .
  vars IL IL' IL'' : ImportList .
  vars CDS CDS' : ClassDeclSet .
  vars ADS ADS' : AttrDeclSet .
  var  SSDS : SubsortDeclSet .
  vars SCDS SCDS' : SubclassDeclSet .
  var  OPDS : OpDeclSet .
  var  MDS : MsgDeclSet .
  vars MAS MAS' : MembAxSet .
  vars EqS EqS' : EquationSet .
  vars RlS RlS' : RuleSet .
  var  QIL : QidList .
  var  NQIL : NeQidList .
  vars O O' : Term .
  vars M U : Module .
  vars QI A A' L F : Qid .
  var  V V' : Variable .
  var  CD : ClassDecl .
  vars SCD SCD' : SubclassDecl .
  vars Ct Ct' Ct'' : Constant .
  var  Cond : Condition .
  var  AtS : AttrSet .
  var  H : Header .
  var  PD : ParameterDecl .
  var  PDL : ParameterDeclList .
  var  MN : ModuleName .

  op newVar : Sort Nat -> Variable .
  eq newVar(S, I) = qid("V#" + string(I, 10) + ":" + string(S)) .

*** The function \texttt{prepClasses} completes all classes in the module with
*** all the attributes they inherit from their superclasses.

  op prepClasses : ClassDeclSet SubclassDeclSet ImportList ParameterDeclList 
       Database -> ClassDeclSet .
  op prepClasses2 : ClassDeclSet SubclassDeclSet ImportList
       ImportList Database -> ClassDeclSet .
  op prepClasses3 : ClassDeclSet SubclassDeclSet -> ClassDeclSet .

  eq prepClasses(CDS, SCDS, IL, (PD, PDL), DB) 
    = prepClasses(CDS, SCDS, (IL protecting pd(PD) .), PDL, DB) .
  eq prepClasses(CDS, SCDS, IL, nil, DB) 
    = prepClasses2(CDS, SCDS, IL, nil, DB) .

  eq prepClasses2(CDS, SCDS, ((including MN .) IL), IL', DB)
    = if (including MN . ) in IL' 
      then prepClasses2(CDS, SCDS, IL, IL', DB)
      else prepClasses2(
             (getClasses(getTopModule(MN, DB)) CDS), 
             (getSubclasses(getTopModule(MN, DB)) SCDS), 
             (getImports(getTopModule(MN, DB)) IL), 
             ((including MN .) IL'), DB)
      fi .
  eq prepClasses2(CDS, SCDS, ((extending MN .) IL), IL', DB)
    = if (extending MN . ) in IL' 
      then prepClasses2(CDS, SCDS, IL, IL', DB)
      else prepClasses2(
             (getClasses(getTopModule(MN, DB)) CDS), 
             (getSubclasses(getTopModule(MN, DB)) SCDS), 
             (getImports(getTopModule(MN, DB)) IL), 
             ((extending MN .) IL'), DB)
      fi .
  eq prepClasses2(CDS, SCDS, ((protecting MN .) IL), IL', DB)
    = if (protecting MN . ) in IL' 
      then prepClasses2(CDS, SCDS, IL, IL', DB)
      else prepClasses2(
             (getClasses(getTopModule(MN, DB)) CDS), 
             (getSubclasses(getTopModule(MN, DB)) SCDS), 
             (getImports(getTopModule(MN, DB)) IL), 
             ((protecting MN .) IL'), DB)
      fi .
  eq prepClasses2(CDS, SCDS, nil, IL, DB) = prepClasses3(CDS, SCDS) .

  eq prepClasses3(CDS, SCDS) 
    = addAttrs(buildHierarchy(CDS, SCDS, none, empty), SCDS) .

  sort ClassHierarchy ClassStruct .
  subsort ClassStruct < ClassHierarchy .

  op [_,_] : ClassDecl SortSet -> ClassStruct .

  op empty : -> ClassHierarchy .
  op __ : ClassHierarchy ClassHierarchy -> ClassHierarchy 
       [assoc comm id: empty] .

  op buildHierarchy : 
       ClassDeclSet SubclassDeclSet SortSet ClassHierarchy -> ClassHierarchy .
  op addAttrs : ClassHierarchy SubclassDeclSet -> ClassDeclSet .
  op addAttrsToItsSons : 
       ClassDecl ClassHierarchy SubclassDeclSet -> ClassHierarchy .

  var CH : ClassHierarchy .
  var C'' : Sort .

  eq buildHierarchy(((class C | ADS .) CDS), SCDS, SS, CH)
    = if C in SS 
      then buildHierarchy(CDS, SCDS, SS, CH)
      else buildHierarchy(CDS, SCDS, C ; SS, [(class C | ADS .), none] CH)
      fi .
  eq buildHierarchy(none, (subclass C < C' .) SCDS, SS, 
       [(class C | ADS .), SS'] [(class C' | ADS' .), SS''] CH) 
    = buildHierarchy(none, SCDS, SS,
        [(class C | ADS .), C' ; SS'] [(class C' | ADS' .), SS''] CH) .
  eq buildHierarchy(none, none, SS, CH) = CH .

  eq addAttrs([(class C | ADS .), none] CH, SCDS)
    = (class C | ADS .) 
      addAttrs(addAttrsToItsSons((class C | ADS .), CH, SCDS), SCDS) .
  eq addAttrs(empty, SCDS) = none .

  eq addAttrsToItsSons((class C | ADS .), [(class C' | ADS' .), C ; SS] CH,
       (subclass C' < C .) SCDS) 
    = addAttrsToItsSons((class C | ADS .), [(class C' | ADS, ADS' .), SS] CH, 
        SCDS) .
  ceq addAttrsToItsSons((class C | ADS .), CH, (subclass C' < C'' .) SCDS) 
    = addAttrsToItsSons((class C | ADS .), CH, SCDS) 
    if C =/= C'' .
  eq addAttrsToItsSons((class C | ADS .), CH, none) = CH .

----  op inAttrDeclSet : Qid AttrDeclSet -> Bool .
----
----  eq inAttrDeclSet(A, ((attr A' : S), ADS)) 
----    = (A == A') or-else inAttrDeclSet(A, ADS) .
----  eq inAttrDeclSet(A, none) = false .

*** Given a set of attribute declarations, the \texttt{ops4Attr}
*** function returns a set of operator declarations as indicated above. That
*** is, for each attribute $a\texttt{:} S$, an operator of the form 
*** $a \texttt{\ :\_} \texttt{ :\,\,} S \texttt{ -> Attribute}$ is declared.

  op ops4Attr : AttrDeclSet -> OpDeclSet .

  eq ops4Attr(((attr A : S), ADS))
    = ((op qid(string(A) + "`:_") : S -> 'Attribute [gather('&)] .) 
       ops4Attr(ADS)) .
  eq ops4Attr(none) = none .

*** The function \texttt{prepLHS} takes the term in the lefthand side of a
*** rule, equation, or membership axiom, and replaces each object
***
***   $\texttt{<\ }O\texttt{\ :\ }C\texttt{\ |\ }ADS\texttt{\ >}$
***
*** in it---with $O$ of sort \texttt{Oid}, $C$ the name of a class, and $ADS$
*** a set of attributes with their corresponding values---by an object
***
***   $\texttt{<\ }O\texttt{\ :\ }V\texttt{\ |\ }ADS\ ADS'\ Atts\texttt{\ >}$
***
*** where the identifier of the class is replaced by a variable $V$ of sort
*** $C$, which is not used in the axiom, and where the set of attributes is
*** completed with attributes $ADS'$ as indicated in Section~\ref{omod2mod}, so
*** that each attribute declared in class $C$ or in any of its superclasses is
*** added with a new variable as value. $Atts$ is a new variable of sort
*** \texttt{AttributeSet}, which is used to range over the additional 
*** attributes that may appear in objects of a subclass.

*** The function \texttt{prepLHS} takes as arguments a term (in the initial
*** call, the term in the lefthand side of a rule, equation, or membership
*** axiom), the set of variable declarations of those variables declared in the
*** module that are not used in the axiom---new variables are created only if
*** there are no variables in the module with the appropriate sort---the set of
*** attributes in the* occurrences of the objects---and an index---to make sure
*** that the variables being added have not occurrences of the objects---and an
*** index---to make sure that the variables being added have not been added
*** previously. In the initial call this index is set to zero. \texttt{prepLHS}
*** gives as result a tuple composed of the resulting term, the set of objects
*** in the term (so that the modification of the objects in the righthand side
*** of the rule is simplified), the set of variable declarations corresponding 
*** to the new added variables, the set of variable declarations of the 
*** variables in the module that have not been used, and the index for the 
*** creation of new variables.

*** change (03/20/2002): a new variable is created everytime one is needed

*** The set of objects in the lefthand side will be given as a set of terms.
*** The sort \texttt{TermSet} is defined as a supersort of the sort
*** \texttt{Term}, and with constructors \texttt{emptyTermSet} and 
*** \texttt{_|_} as follows.

----  sort TermSet .
----  subsort Term < TermSet .
----  op emptyTermSet : -> TermSet [ctor] .
----  op _|_ : TermSet TermSet -> TermSet [ctor comm assoc id: emptyTermSet] .

*** Terms of sort \texttt{PrepareLHSResult} are built with constructor
*** \verb~<_;_;_;_;_>~, and have selectors for their different components.  
*** change (03/20/2002): <_;_;_;_;_> -> <_;_;_>

  sort PrepLHSResult .
  op <_;_;_;_> : TermList TermSet Nat QidList -> PrepLHSResult .
  op term : PrepLHSResult -> TermList .
  op objects : PrepLHSResult -> TermSet .
  op index : PrepLHSResult -> Nat .
  op messages : PrepLHSResult -> QidList .

  var TS TS' : TermSet .

  eq term(< TL ; TS ; I ; QIL >) = TL .
  eq objects(< TL ; TS ; I ; QIL >) = TS .
  eq index(< TL ; TS ; I ; QIL >) = I .
  eq messages(< TL ; TS ; I ; QIL >) = QIL .

  op prepLHS : TermList ClassDeclSet Nat -> PrepLHSResult .

  op crtObject : Term Sort AttrDeclSet PrepLHSResult -> PrepLHSResult .
  op crtObject2 : Term Variable TermList TermList AttrDeclSet TermSet Nat 
        QidList -> PrepLHSResult .
  op crtObject3 : Term Qid TermList AttrDeclSet TermSet Nat QidList 
        -> PrepLHSResult .

  eq prepLHS(qidError(QIL), CDS, I) 
    = < qidError(QIL) ; emptyTermSet ; I ; nil > .
  eq prepLHS(F, CDS, I) = < F ; emptyTermSet ; I ; nil > .
  eq prepLHS(Ct, CDS, I) = < Ct ; emptyTermSet ; I ; nil > .

*** \texttt{prepLHS} on a list of terms $\texttt{(}T\texttt{,\ }TL\texttt{)}$,
*** with $T$ a term and $TL$ a list of terms, has to make a call to itself with
*** $T$ and with $TL$. The call with $TL$ has to be made with the result of
*** the call with $T$ so that the variables and the index are right.

  ceq prepLHS((T, TL), CDS, I)
    = < (term(prepLHS(T, CDS, I)), 
         term(prepLHS(TL, CDS, index(prepLHS(T, CDS, I))))) ;
        _|_(objects(prepLHS(T, CDS, I)),
                objects(prepLHS(TL, CDS, index(prepLHS(T, CDS, I))))) ;
        index(prepLHS(TL, CDS, index(prepLHS(T, CDS, I)))) ;
        (messages(prepLHS(T, CDS, I)) 
         messages(prepLHS(TL, CDS, index(prepLHS(T, CDS, I))))) > 
    if TL =/= empty .
  ceq prepLHS(F[TL], CDS, I)
    = < F[term(prepLHS(TL, CDS, I))] ;
        objects(prepLHS(TL, CDS, I)) ;
        index(prepLHS(TL, CDS, I)) ;
        messages(prepLHS(TL, CDS, I)) >
      if (F =/= '<_:_|_>) /\ (F =/= '<_:_|`>) .

  ceq prepLHS('<_:_|_>[O, Ct, T], ((class C | ADS .) CDS), I)
    = crtObject(O, C, ADS, prepLHS(T, ((class C | ADS .) CDS), I)) 
    if getName(Ct) == C .
  ceq prepLHS('<_:_|`>[O, Ct], ((class C | ADS .) CDS), I)
    = crtObject(O, C, ADS, 
        prepLHS('none.AttributeSet, ((class C | ADS .) CDS), I))       
    if getName(Ct) == C .
  eq prepLHS('<_:_|_>[O, V, T], CDS, I) 
    = < '<_:_|_>[O, V, T] ; emptyTermSet ; I ; nil > .
                                                      *** is this eq necessary?
  eq prepLHS('<_:_|`>[O, V], CDS, I)                                   
    = < '<_:_|_>[O, V, 'none.AttributeSet] ; emptyTermSet ; I ; nil > .   
                                                      *** is this eq necessary?

  eq crtObject(O, C, ADS, < T ; TS ; I ; QIL >) 
    = crtObject2(O, newVar(C, I), T, 'none.AttributeSet, 
        ADS, TS, (I + 1), QIL) .

*** The function \texttt{crtObject2} is called with the metarepresentation of
*** the list of attributes appearing in the current object (third argument)
*** and the set of attribute declarations of the class to which such object
*** belongs + all the attributes declared in its superclasses (fifth
*** argument). The function proceeds recursively removing the attribute
*** declarations from the set of declarations of attributes for those
*** attributes that appear in the object. Each time an attribute is found, it
*** is passed with its actual value to the fourth argument of 
*** \texttt{crtObject2}, which initially has value \verb~'none.AttributeSet~, 
*** composing a list of terms with them.

*** We assume that:
*** \begin{itemize}
*** \item The metarepresentation of a list of attributes is always given with
***       form \verb~'_`,_[F[T], T]~, \verb~F[T]~, or
***       \verb~'none.AttributeSet~, where \texttt{TL} is the
***       metarepresentation of a list of attributes with the same form (this
***       is ensured by the \verb~(e E)~ gathering pattern in the corresponding
***       declaration in the signature in which the parsing is done), and
*** \item that all the attributes appearing in an object have been declared in
***       the corresponding class declaration or in one of its superclasses.  
*** \end{itemize} 

  eq crtObject2(O, V, '_`,_[F[T], TL], TL', ADS, TS, I, QIL)
    = crtObject2(O, V, (F[T], TL), TL', ADS, TS, I, QIL) .

  ceq crtObject2(O, V, (F[T], TL), TL', ((attr A : S), ADS), TS, I, QIL)
    = crtObject2(O, V, TL, (F[T], TL'), ADS, TS, I, QIL)
    if qid(string(A) + "`:_") == F .
  eq crtObject2(O, V, (F[T], TL), TL', ADS, TS, I, QIL)
    = crtObject2(O, V, TL, TL', ADS, TS, I, 
        (QIL '\r 'Warning: '\o 'Attribute F 'not 'valid '\n))
    [owise] .

  ceq crtObject2(O, V, F[T], TL, ((attr A : S), ADS), TS, I, QIL)
    = crtObject3(O, V, (F[T], TL), ADS, TS, I, QIL)
    if qid(string(A) + "`:_") == F .
  eq crtObject2(O, V, F[T], TL, ADS, TS, I, QIL)
    = crtObject3(O, V, TL, ADS, TS, I, 
        (QIL '\r 'Warning: '\o 'Attribute F 'not 'valid '\n))
    [owise] .

  eq crtObject2(O, V, V', TL, ADS, TS, I, QIL) 
    = crtObject3(O, V, TL, ADS, TS, I, 
        QIL '\r 'Warning: '\o 
            'Variables 'are 'not 'allowed 'in 'the 'set 'of 'attributes 
            'of 'an 'object '`( V' '`) '\n) .

  eq crtObject2(O, V, 'none.AttributeSet, TL, ADS, TS, I, QIL) 
    = crtObject3(O, V, TL, ADS, TS, I, QIL) .
  eq crtObject2(O, V, empty, TL, ADS, TS, I, QIL) 
    = crtObject3(O, V, TL, ADS, TS, I, QIL) .

*** When the function \texttt{crtObject2} has gone through all the
*** attributes in the current object, the function \texttt{crtObject3} is
*** in charge of returning the metarepresentation of the current object
*** completed with the attributes that did not appear in it. These attributes
*** are added with new variables not used in the axiom as value.
*** \texttt{crtObject3} returns a pair composed by this resulting object, 
*** and the set of terms representing all the objects in the lefthand 
*** side (the current object is added to this set).

  eq crtObject3(O, V, TL, ((attr A : S), ADS), TS, I, QIL)
    = crtObject3(O, V, (qid(string(A) + "`:_")[newVar(S, I)], TL), 
        ADS, TS, (I + 1), QIL) .

  eq crtObject3(O, V, TL, none, TS, I, QIL)
    = < '<_:_|_>[O, V, '_`,_[TL, newVar('AttributeSet, I)]] ; 
        _|_('<_:_|_>[O, V, '_`,_[TL, newVar('AttributeSet, I)]], TS) ;
        (I + 1) ; 
        QIL > .

*** Once the lefthand side of a rule or equation has been `prepared', the
*** function \texttt{prepRHS} is called with the set of objects returned by
*** \texttt{prepLHS} and the term in the righthand side of such rule or
*** equation. The function \texttt{prepRHS} proceeds recursively throughout the
*** term looking for objects. Each time an object is found, its set of 
*** attributes is completed with those in the modified object of the lefthand 
*** side which do not appear in it.

  op prepRHS : TermSet TermList -> TermList .
  op prepRHS : TermSet Condition -> Condition .

  op adjustObject : TermSet Term -> Term .

  op adjustObjectRHS : TermSet Term -> [Term] .
  op adjustAttrsObjectRHS : Term Term -> [Term] .
  op adjustAttrsObjectRHSAux : TermSet Term -> [Term] .

  op termAttrListToTermSet : TermList -> TermSet .
  op _attrInTermSet_ : Qid TermSet -> Bool .

  eq prepRHS(TS, T = T' /\ Cond)  
    = prepRHS(TS, T) = prepRHS(TS, T') /\ prepRHS(TS, Cond) .
  eq prepRHS(TS, T : S /\ Cond)  = prepRHS(TS, T) : S /\ prepRHS(TS, Cond) .
  eq prepRHS(TS, T := T' /\ Cond) 
    = prepRHS(TS, T) := prepRHS(TS, T') /\ prepRHS(TS, Cond) .
  eq prepRHS(TS, T => T' /\ Cond) 
    = prepRHS(TS, T) => prepRHS(TS, T') /\ prepRHS(TS, Cond) .
  eq prepRHS(TS, (nil).Condition) = nil .

  eq prepRHS(TS, qidError(QIL)) = qidError(QIL) .
  eq prepRHS(TS, F) = F .
  eq prepRHS(TS, Ct) = Ct .
  ceq prepRHS(TS, F[TL])
    = F[prepRHS(TS, TL)]
    if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) .
  eq prepRHS(TS, '<_:_|_>[O, Ct, T]) 
    = adjustObjectRHS(TS, '<_:_|_>[O, Ct, prepRHS(TS, T)]) .
  eq prepRHS(TS, '<_:_|_>[O, V, T]) = '<_:_|_>[O, V, prepRHS(TS, T)] .
  eq prepRHS(TS, '<_:_|`>[O, Ct])
    = adjustObjectRHS(TS, '<_:_|_>[O, Ct, prepRHS(TS, 'none.AttributeSet)]) .
  eq prepRHS(TS, '<_:_|`>[O, V]) 
    = '<_:_|_>[O, V, prepRHS(TS, 'none.AttributeSet)] .
  ceq prepRHS(TS, (T, TL)) 
    = (prepRHS(TS, T), prepRHS(TS, TL)) 
    if TL =/= empty .

  eq adjustObjectRHS(_|_('<_:_|_>[O, V, T], TS), '<_:_|_>[O', Ct, T'])
    = if O == O'
      then if getType(V) == getType(Ct)
           then '<_:_|_>[O, V, adjustAttrsObjectRHS(T, T')]
           else '<_:_|_>[O', Ct, T']
           fi
      else adjustObjectRHS(TS, '<_:_|_>[O', Ct, T'])
      fi .
  eq adjustObjectRHS(emptyTermSet, '<_:_|_>[O, Ct, T]) = '<_:_|_>[O, Ct, T] .

***  eq adjustObjectRHS(_|_('<_:_|_>[Ct, C, T], TS), '<_:_|_>[O, Ct', T'])
***    = adjustObjectRHS(TS, '<_:_|_>[O, Ct', T']) .
***  eq adjustObjectRHS(
***       _|_('<_:_|_>[Ct, C, T], TS), '<_:_|_>[Ct', Ct'', T'])
***    = if Ct == Ct'
***      then '<_:_|_>[Ct, Ct'', adjustAttrsObjectRHS(T, T')]
***      else adjustObjectRHS(TS, '<_:_|_>[Ct', Ct'', T'])
***      fi .
***  eq adjustObjectRHS(emptyTermSet, '<_:_|_>[Ct, Ct', T]) 
***    = '<_:_|_>[Ct, Ct', T] .

*** The function \texttt{adjustAttrsObjectRHS} completes the set of
*** attributes of an object in the righthand side with those in the object in
*** the lefthand side or in the class not used in the lefthand side, which 
*** have been completed by the function \texttt{crtObject}.

  eq adjustAttrsObjectRHS('_`,_[TL], T)
    = adjustAttrsObjectRHSAux(termAttrListToTermSet(TL), T) .

  eq adjustAttrsObjectRHSAux(_|_(A[T], TS), '_`,_[A[T'], T''])
    = '_`,_[A[T'], adjustAttrsObjectRHSAux(TS, T'')] .
  ceq adjustAttrsObjectRHSAux(TS, '_`,_[A[T], T'])
    = qidError(A 'is 'not 'a 'valid 'attribute) 
    if not A attrInTermSet TS .
  eq adjustAttrsObjectRHSAux(_|_(A[T], TS), A[T'])
    = '_`,_[A[T'], adjustAttrsObjectRHSAux(TS, 'none.AttributeSet)] .
  ceq adjustAttrsObjectRHSAux(TS, A[T])
    = qidError(A 'is 'not 'a 'valid 'attribute)
    if not A attrInTermSet TS .
  eq adjustAttrsObjectRHSAux(_|_(A[T], TS), 'none.AttributeSet)
    = '_`,_[A[T], adjustAttrsObjectRHSAux(TS, 'none.AttributeSet)] .
  eq adjustAttrsObjectRHSAux(V, 'none.AttributeSet) = V .

  eq A attrInTermSet _|_(V, TS) = A attrInTermSet TS .
  eq A attrInTermSet _|_(A'[T], TS) 
    = (A == A') or-else (A attrInTermSet TS) .
  eq A attrInTermSet emptyTermSet = false .

  ceq termAttrListToTermSet((T, TL))
    = if T == 'none.AttributeSet
      then termAttrListToTermSet(TL)
      else _|_(T, termAttrListToTermSet(TL))
      fi 
    if TL =/= empty .
  eq termAttrListToTermSet(T)
    = if T == 'none.AttributeSet
      then emptyTermSet
      else T 
      fi .

*** In the case of equations and rules, the function \texttt{prepAxs} calls the
*** function \texttt{prepLHS} with the term in the lefthand side of the axiom,
*** and then use the generated set of objects to call the \texttt{prepRHS}
*** function. For conditional equations, rules, and membership axioms, this set
*** of terms representing the objects in the lefthand side is also used in the
*** calls to \texttt{prepRHS} with each of the terms in the conditions. The
*** term in the lefthand side of the equation, rule, or membership axiom is 
*** replaced by the term returned by \texttt{prepLHS}. The index is used in 
*** the recursive calls to \texttt{prepAxs}.

*** \texttt{prepLHS} returns as second argument the set of objects (as a set of
*** terms) appearing in it. These objects are returned after extending their
*** set of attributes by those of the class to which they belong not already 
*** specified.

  op prepAxs : Module MembAxSet EquationSet RuleSet ClassDeclSet Nat QidList 
       -> Module .

  eq prepAxs(U, ((mb T : S [AtS] .) MAS), EqS, RlS, CDS, I, QIL)
    = prepAxs(
        addMbs(mb term(prepLHS(T, CDS, I)) : S [AtS] ., U),
        MAS, EqS, RlS, CDS, 
        index(prepLHS(T, CDS, I)), 
        (QIL messages(prepLHS(T, CDS, I)))) .
  eq prepAxs(U, ((cmb T : S if Cond [AtS] .) MAS), EqS, RlS, CDS, I, QIL)
    = prepAxs(
        addMbs(cmb term(prepLHS(T, CDS, I)) : S 
                 if prepRHS(objects(prepLHS(T, CDS, I)), Cond) [AtS] ., U),
        MAS, EqS, RlS, CDS, 
        index(prepLHS(T, CDS, I)), 
        (QIL messages(prepLHS(T, CDS, I)))) .
  eq prepAxs(U, MAS, ((eq T = T' [AtS] .) EqS), RlS, CDS, I, QIL)
    = prepAxs(
        addEqs(eq term(prepLHS(T, CDS, I)) 
                 = prepRHS(objects(prepLHS(T, CDS, I)), T') [AtS] ., U),
        MAS, EqS, RlS, CDS, 
        index(prepLHS(T, CDS, I)), 
        (QIL messages(prepLHS(T, CDS, I)))) .
  eq prepAxs(U, MAS, ((ceq T = T' if Cond [AtS] .) EqS), RlS, CDS, I, QIL)
    = prepAxs(
        addEqs(ceq term(prepLHS(T, CDS, I))
                 = prepRHS(objects(prepLHS(T, CDS, I)), T')
                 if prepRHS(objects(prepLHS(T, CDS, I)), Cond) [AtS] ., U),
        MAS, EqS, RlS, CDS, 
        index(prepLHS(T, CDS, I)), 
        (QIL messages(prepLHS(T, CDS, I)))) .

  eq prepAxs(U, MAS, EqS, ((rl T => T' [AtS] .) RlS), CDS, I, QIL)
    = prepAxs(
        addRls(rl term(prepLHS(T, CDS, I)) 
                 => prepRHS(objects(prepLHS(T, CDS, I)), T') [AtS] ., U),
        MAS, EqS, RlS, CDS, 
        index(prepLHS(T, CDS, I)), 
        (QIL messages(prepLHS(T, CDS, I)))) .
  eq prepAxs(U, MAS, EqS, ((crl T => T' if Cond [AtS] .) RlS), CDS, I, QIL)
    = prepAxs(
        addRls(crl term(prepLHS(T, CDS, I))
                 => prepRHS(objects(prepLHS(T, CDS, I)), T')
                 if prepRHS(objects(prepLHS(T, CDS, I)), Cond) [AtS] ., U),  
        MAS, EqS, RlS, CDS, 
        index(prepLHS(T, CDS, I)), 
        (QIL messages(prepLHS(T, CDS, I)))) .
  eq prepAxs(U, none, none, none, CDS, I, nil) = U . 
  eq prepAxs(U, none, none, none, CDS, I, NQIL) = unitError(NQIL) .

*** After completing the set of classes in the module with the attributes from
*** their superclasses, the function \texttt{omod2mod} calls the function
*** \texttt{omod2modAux} with the same module and the set of class
*** declarations. The definition of the \texttt{omod2mod} function is given by
*** the five equations below.

  op omod2mod : OModule Database -> SModule .
  op omod2modAux : OModule ClassDeclSet -> SModule .
  op omod2mod : OTheory Database -> SModule .
  op omod2modAux : OTheory ClassDeclSet -> SModule .

  eq omod2mod(
       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom,
       DB)
    = omod2modAux(
        omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 
        prepClasses(CDS, SCDS, IL, getParDecls(H), DB)) .
  eq omod2mod(
       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth,
       DB)
    = omod2modAux(
        oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, 
        prepClasses(CDS, SCDS, IL, getParDecls(H), DB)) .

  eq omod2modAux(
       omod H is 
          IL sorts SS . SSDS ((class C | ADS .) CDS) SCDS OPDS MDS MAS EqS RlS 
       endom, 
       CDS')
    = omod2modAux(
        omod H is 
           IL sorts (SS ; C) .
           (subsort C < 'Cid . SSDS)
           CDS SCDS
           ((op C : nil -> C [none] .) 
            ops4Attr(ADS) OPDS)
           MDS MAS EqS RlS
        endom,
        CDS') .
  eq omod2modAux(
       omod H is 
          IL sorts SS . SSDS CDS ((subclass C < C' .) SCDS) 
          OPDS MDS MAS EqS RlS 
       endom, 
       CDS')
    = omod2modAux(
        omod H is 
           IL sorts SS . ((subsort C < C' .) SSDS) 
           CDS SCDS OPDS MDS MAS EqS RlS 
        endom, 
        CDS') .
  eq omod2modAux(
        omod H is 
           IL sorts SS . SSDS CDS SCDS OPDS 
           ((msg F : TyL -> Ty .) MDS) MAS EqS RlS
        endom, 
        CDS')
    = omod2modAux(
         omod H is 
            IL sorts SS . SSDS CDS SCDS 
            ((op F : TyL -> Ty [msg] .) OPDS) MDS MAS EqS RlS
         endom, 
         CDS') .
  eq omod2modAux(
       omod H is IL sorts SS . SSDS none none OPDS none MAS EqS RlS endom, 
       CDS)
    = prepAxs(mod H is IL sorts SS . SSDS OPDS none none none endm, 
        MAS, EqS, RlS, CDS, 0, nil) .

  eq omod2modAux(
       oth H is 
          IL sorts SS . SSDS ((class C | ADS .) CDS) 
          SCDS OPDS MDS MAS EqS RlS 
       endoth, 
       CDS')
    = omod2modAux(
        oth H is 
           IL sorts (SS ; C) .
           (subsort C < 'Cid . SSDS)
           CDS SCDS
           ((op C : nil -> C [none] .) 
            ops4Attr(ADS) OPDS)
           MDS MAS EqS RlS
        endoth,
        CDS') .
  eq omod2modAux(
       oth H is 
          IL sorts SS . SSDS CDS ((subclass C < C' .) SCDS) 
          OPDS MDS MAS EqS RlS 
       endoth, 
       CDS')
    = omod2modAux(
        oth H is 
           IL sorts SS . ((subsort C < C' .) SSDS) 
           CDS SCDS OPDS MDS MAS EqS RlS 
        endoth, 
        CDS') .
  eq omod2modAux(
        oth H is 
           IL sorts SS . SSDS CDS SCDS OPDS 
           ((msg F : TyL -> Ty .) MDS) MAS EqS RlS
        endoth, 
        CDS')
    = omod2modAux(
         oth H is 
            IL sorts SS . SSDS CDS SCDS 
            ((op F : TyL -> Ty [msg] .) OPDS) MDS MAS EqS RlS
         endoth, 
         CDS') .
  eq omod2modAux(
       oth H is IL sorts SS . SSDS none none OPDS none MAS EqS RlS endoth, 
       CDS)
    = prepAxs(
        th H is IL sorts SS . SSDS OPDS none none none endth, 
        MAS, EqS, RlS, CDS, 0, nil) .
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

***
*** Evaluation of Modules and Theories
***

*** As explained in Section~\ref{evaluation-overview}, in our approach
*** transforming a module from its possibly complex structured version to its
*** unstructured form is a two-step process.  First, all module expressions
*** are evaluated, generating an intermediate form in which there are only
*** simple inclusion relationships among the modules. This first step can be
*** seen as the reduction of a structured specification to its structured
*** \emph{normal form}. Then, in a second step, this structured normal form is
*** flattened into an unstructured specification.  Note, however, that the 
*** importation of built-in modules is left explicit in the flattened form. 
*** The function \texttt{normalize} is in charge of normalizing the 
*** structure.

*** The process of evaluation of a preunit has to take into account the
*** possibility of bubbles being contained in it. Depending on whether it is
*** dealing with a preunit or with a unit, the evaluation process is
*** accomplished by two different functions, namely, \texttt{evalPreModule} and
*** \texttt{evalModule}. One function or the other will be called in each case.
*** Evaluating a module already in the database, which is done by
*** \texttt{evalModule}, does not require bubble handling. Besides this
*** difference, both functions proceed in a similar way. Before presenting the 
*** functions \texttt{evalPreModule} and \texttt{evalModule} we introduce some 
*** auxiliary declarations.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod EVALUATION is
  pr O-O-TO-SYSTEM-MOD-TRANSF .
  pr MOD-EXPR-EVAL .
  pr UNIT-BUBBLE-PARSING .

  sort List<Module> .
  subsort Module < List<Module> .

  op nil : -> List<Module> .
  op __ : List<Module> List<Module> -> List<Module> [assoc id: nil] .
  eq unitError(QIL) UL unitError(QIL') = unitError(QIL QIL') UL .

  vars M PU U U' U'' : Module .
  vars UL UL' : List<Module> .
  vars DB  DB' : Database .
  vars ME ME' : ModuleExpression .
  var  P : ViewExp .
  var  PD : ParameterDecl .
  vars PL PL' PL'' : ParameterList .
  vars IL IL' IL'' : ImportList .
  var  I : Import .
  var  CDS : ClassDeclSet .
  var  SSDS : SubsortDeclSet .
  var  SCDS : SubclassDeclSet .
  var  OPD : OpDecl .
  vars OPDS VDS : OpDeclSet .
  var  MDS : MsgDeclSet .
  var  MAS : MembAxSet .
  var  EqS : EquationSet .
  var  RlS : RuleSet .
  var  B : Bool .
  vars QI QI' V L L' L'' A A' A'' F F' F'' X Y W Z : Qid .
  vars QIL QIL' SL : QidList .
  vars S S' S'' C C' C'' : Sort .
  vars SS SS' : SortSet .
  vars Ty Ty' : Type .
  vars TyL TyL' : TypeList .
  vars AtS AtS' : AttrSet .
  var  Rl : Rule .
  var  CD : ClassDecl .
  var  ADS : AttrDeclSet .
  var  MD : MsgDecl .
  vars T T' T'' T3 : Term .
  var  TL : TermList .
  var  VMAP : ViewMap .
  var  VMAPS : RenamingSet .
  var  MAP : Renaming .
  var  MAPS : RenamingSet .
  vars VE VE' VE'' : ViewExp .
  var  HkL : HookList .
  vars PDL PDL' : ParameterDeclList .

*** The \texttt{subunitImports} function returns the list of all the
*** subunits of a given unit. It is called with the list of importations of
*** the given unit as first argument, and proceeds recursively through its 
*** structure collecting all the subunits in it.

*** The function \texttt{subunitImports} proceeds storing the importations
*** considered up to that point, so it does not have to go through the same
*** part of the structure more than once. When the function is initially 
*** called the second argument is set to \texttt{nil}.

  op subunitImports : ParameterDeclList ImportList Database -> ImportList .
  op subunitImports : ImportList ImportList Database -> ImportList .

  eq subunitImports((PD, PDL), IL, DB) 
    = subunitImports(PDL, IL (protecting pd(PD) .), DB) .
  eq subunitImports((nil).ParameterDeclList, IL, DB) 
    = subunitImports(IL, nil, DB) .

  eq subunitImports(I IL, IL' I IL'', DB) 
    = subunitImports(IL, IL' I IL'', DB)  .
  eq subunitImports(I IL, IL', DB) 
    = subunitImports(getImports(getTopModule(moduleName(I), DB)) IL, I IL', DB)
    [owise] .
  eq subunitImports((nil).ImportList, IL, DB) = IL .

*** The function \texttt{getModules} returns the list of those units
*** in the list of importations given as argument which are not built-in.

  op getModules : ImportList Database -> List<Module> .
  op getModules : ImportList List<Module> Database -> List<Module> .

  eq getModules(IL, DB) = getModules(IL, nil, DB) .

  eq getModules(((including ME .) IL), UL, DB) 
    = getModules(IL, (UL getInternalModule(ME, DB)), DB) .
  eq getModules(((including pd(PD) .) IL), UL, DB) 
    = getModules(IL, (UL getInternalModule(pd(PD), DB)), DB) .
  eq getModules(((extending ME .) IL), UL, DB) 
    = getModules(IL, (UL getInternalModule(ME, DB)), DB) .
  eq getModules(((extending pd(PD) .) IL), UL, DB) 
    = getModules(IL, (UL getInternalModule(pd(PD), DB)), DB) .
  eq getModules(((protecting ME .) IL), UL, DB) 
    = getModules(IL, (UL getInternalModule(ME, DB)), DB) .
  eq getModules(((protecting pd(PD) .) IL), UL, DB) 
    = getModules(IL, (UL getInternalModule(pd(PD), DB)), DB) .
  eq getModules(IL, UL unitError(QIL) UL', DB) = unitError(QIL) .
  eq getModules(nil, UL, DB) = UL .

*** The normalization of a structure consists in evaluating each of the module
*** expressions appearing in it. Note that, if the \texttt{evalModExp} function
*** generates new modules, they will be evaluated using the \texttt{evalModule}
*** function, producing recursive calls on the part of the structure not 
*** previously normalized. Parameters are handled separatedly. They are 
*** folded out when analyzing the interface of a module.

  sort Tuple<ImportList|ParameterDeclList|Database> .
  op <_;_;_> : ImportList ParameterDeclList Database 
       -> Tuple<ImportList|ParameterDeclList|Database> .
  op importList : Tuple<ImportList|ParameterDeclList|Database> -> ImportList .
  op parameterDeclList : 
       Tuple<ImportList|ParameterDeclList|Database> -> ParameterDeclList .
  op database : Tuple<ImportList|ParameterDeclList|Database> -> Database .
  eq importList(< IL ; PDL ; DB >) = IL .
  eq parameterDeclList(< IL ; PDL ; DB >) = PDL .
  eq database(< IL ; PDL ; DB >) = DB .

  op normalize : ImportList ParameterDeclList Database 
       -> Tuple<ImportList|ParameterDeclList|Database> .
  op normalize : ImportList ImportList ParameterDeclList ParameterDeclList 
       Database -> Tuple<ImportList|ParameterDeclList|Database> .
  op createCopy : ParameterDecl Database -> Database .
  ---- its definition is in INST-EXPR-EVALUATION

  eq normalize(IL, PDL, DB) = normalize(nil, IL, nil, PDL, DB) .

  eq normalize(IL, IL', PDL, (X :: ME, PDL'), DB) 
    = normalize(IL, IL', 
        (PDL, X :: modExp(evalModExp(ME, nil, DB))), PDL',
        createCopy((X :: modExp(evalModExp(ME, nil, DB))), 
          database(evalModExp(ME, nil, DB)))) .
  eq normalize(IL, (including ME .) IL', PDL, PDL', DB)
    = normalize(IL (including modExp(evalModExp(ME, PDL, DB)) .), IL', 
        PDL, PDL', database(evalModExp(ME, PDL, DB))) .
  eq normalize(IL, (extending ME .) IL', PDL, PDL', DB)
    = normalize(IL (extending modExp(evalModExp(ME, PDL, DB)) .), IL', 
        PDL, PDL', database(evalModExp(ME, PDL, DB))) .
  eq normalize(IL, (protecting ME .) IL', PDL, PDL', DB)
    = normalize(IL (protecting modExp(evalModExp(ME, PDL, DB)) .), IL', 
        PDL, PDL', database(evalModExp(ME, PDL, DB))) .
  eq normalize(IL, I IL', PDL, PDL', DB) 
    = normalize(IL I, IL', PDL, PDL', DB) 
    [owise] .
  eq normalize(IL, nil, PDL, nil, DB) = < IL ; PDL ; DB > .

*** \texttt{checkSortClashes} checks whether the intersection of the two sTS
*** of sorts given as arguments is empty or not. If it is nonempty, then there
*** is a clash of names, and a warning message is passed to the database.  The
*** check is very simple, and only reports the name of one of the modules from
*** which the sorts come. Only the name of the module from which the sorts 
*** given as second argument come is known at this point. This is the module 
*** name given as first argument.
*** 
***   op checkSortClashes : Header SortSet SortSet Database -> Database .
*** 
***   eq checkSortClashes(ME, (S ; SS), (S ; SS'), DB)
***     = checkSortClashes(ME, SS, SS', 
***         warning(DB, 
***           '\g 'Advisory: '\o
***           'Clash 'of 'sort eSortToSort(S) 'from header2Qid(ME) '\n)) .
***   ceq checkSortClashes(ME, (S ; SS), SS', DB)
***     = checkSortClashes(ME, SS, SS', DB)
***     if not (S in SS') .
***   eq check(ME, none, SS, DB) = DB .

*** In the current system, the only transformation handled by the
*** \texttt{transform} function is the one from object-oriented modules to
*** system modules, which is accomplished by the
*** \texttt{omod2mod} function presented in
*** Section~\ref{omod2modfunction}. However, \texttt{transform} has been 
*** defined as a general transformation that could affect other kinds of 
*** modules in a future extension.

  op transform : Module Database -> Module .

  eq transform(unitError(QIL), DB) = unitError(QIL) .
  ceq transform(U, DB) = U if U :: SModule or U :: STheory .
  ceq transform(U, DB) = omod2mod(U, DB) 
    if not U :: SModule /\ not U :: STheory /\ U :: OModule or U :: OTheory .

*** The function \texttt{signature} generates a functional module of sort
*** \texttt{FModule}, without equations, by ``forgetting'' the appropriate
*** declarations and converting extended sorts and module names into quoted 
*** identifiers.

  op removeIds : OpDeclSet Module -> OpDeclSet .
  eq removeIds(op F : TyL -> Ty [id(T) AtS] . OPDS, M) 
    = removeIds(op F : TyL -> Ty [AtS] . OPDS, M) .
  eq removeIds(op F : TyL -> Ty [right-id(T) AtS] . OPDS, M) 
    = removeIds(op F : TyL -> Ty [AtS] . OPDS, M) .
  eq removeIds(op F : TyL -> Ty [left-id(T) AtS] . OPDS, M) 
    = removeIds(op F : TyL -> Ty [AtS] . OPDS, M) .
  eq removeIds(op F : TyL -> Ty [special(term-hook(QI, T) HkL) AtS] . OPDS, M) 
    = removeIds(op F : TyL -> Ty [special(HkL) AtS] . OPDS, M) .
  eq removeIds(OPDS, M) = OPDS [owise] .

  op removeDittos : OpDeclSet Module -> OpDeclSet .
  ceq removeDittos(
        op F : TyL -> Ty [ditto AtS] . op F : TyL' -> Ty' [AtS'] . OPDS, M)
    = removeDittos(
        op F : TyL -> Ty [AtS AtS'] . op F : TyL' -> Ty' [AtS'] . OPDS, M) 
    if not ditto in AtS' /\ sameKind(M, TyL Ty, TyL' Ty') .
  eq removeDittos(OPDS, M) = OPDS [owise] .

  op signature : Module -> Module .
  eq signature(unitError(QIL)) = unitError(QIL) .
  eq signature(U) 
    = fmod header2Qid(getName(U)) is
         convertModuleExpressions(getImports(U))
         sorts getSorts(U) .
         getSubsorts(U)
         removeIds(
           removeDittos(getOps(U), 
             setSubsorts(
               setSorts(emptyFModule('DUMMY), getSorts(U)),
               getSubsorts(U))),
           setSubsorts(
             setSorts(emptyFModule('DUMMY), getSorts(U)),
             getSubsorts(U)))
         none
         none
      endfm 
    [owise] .

*** The function \texttt{flatModule} generates a module of sort \texttt{Module}
*** by ``forgetting'' declarations and converting extended sorts and module 
*** identifiers into quoted identifiers.

  op flatModule : Module -> Module .
  eq flatModule(unitError(QIL)) = unitError(QIL) .
  eq flatModule(U)
    = if U :: FModule or U :: FTheory
      then (fmod header2Qid(getName(U)) is
               getImports(U)
               sorts getSorts(U) .
               getSubsorts(U)
               getOps(U)
               getMbs(U)
               getEqs(U)
            endfm)
      else (mod header2Qid(getName(U)) is
               getImports(U)
               sorts getSorts(U) .
               getSubsorts(U)
               getOps(U)
               getMbs(U)
               getEqs(U)
               getRls(U)
            endm)
      fi 
    [owise] .

  op convertModuleExpressions : ImportList -> ImportList .
  eq convertModuleExpressions(((protecting ME * (MAPS) .) IL)) 
    = (protecting ME * (renamings(MAPS)) .) convertModuleExpressions(IL) .
  eq convertModuleExpressions(((extending ME * (MAPS) .) IL)) 
    = (extending ME * (renamings(MAPS)) .) convertModuleExpressions(IL) .
  eq convertModuleExpressions(((including ME * (MAPS) .) IL)) 
    = (including ME * (renamings(MAPS)) .) convertModuleExpressions(IL) .
  eq convertModuleExpressions(I IL) = I convertModuleExpressions(IL) [owise] .
  eq convertModuleExpressions(nil) = nil .  
  
  op renamings : RenamingSet -> RenamingSet .
  eq renamings(op F to F' [AtS]) = op F to F' [AtS] .
  eq renamings((op F to F' [AtS], MAPS)) 
    = (op F to F' [AtS], renamings(MAPS)) 
    [owise] .
  eq renamings(op F : TyL -> Ty to F' [AtS]) 
    = op F : TyL -> Ty to F' [AtS] .
  eq renamings((op F : TyL -> Ty to F' [AtS], MAPS)) 
    = (op F : TyL -> Ty to F' [AtS], 
       renamings(MAPS)) 
    [owise] .
  eq renamings(sort S to S') = sort S to S' .
  eq renamings(((sort S to S'), MAPS)) 
    = ((sort S to S'), renamings(MAPS)) 
    [owise] .
  eq renamings(label L to L') = label L to L' .
  eq renamings(((label L to L'), MAPS)) 
    = ((label L to L'), renamings(MAPS)) 
    [owise] .
  eq renamings((MAP, MAPS)) = renamings(MAPS) [owise] .
  eq renamings(none) = none .

*** The evaluation process for units without bubbles is as follows. After 
*** normalizing the structure, the function \texttt{evalModule} calls
*** \texttt{evalModule1} with an empty copy of the module to which the list of
*** declarations of importations of built-in modules is added, and with the
*** list of its nonbuilt-in subunits.

*** \texttt{evalModule1} accumulates all the declarations in all the 
*** nonbuilt-insubmodules in the copy of the module passed as second argument. 
*** The top module is then introduced in the database, and, after calling the
*** \texttt{transform} function and renaming all the variables in it, the 
*** internal version of such a module is entered in the database as well.

*** Finally, \texttt{evalModule2} generates the signature and the flat version
*** of the module and enters them in the database.

  *** op evalModule : Module Database -> Database .
  ***  moved to MOD-EXPR-EVAL to solve dependency
  op evalModule1 : Module Module List<Module> OpDeclSet Database -> Database .
  op evalModule2 : Module Module Database -> Database .

  ceq evalModule(U, VDS, DB)
    = evalModule1(setPars(setImports(U, IL), PDL), empty(U), 
        getModules(IL', DB'), VDS, DB') 
    if < IL ; PDL ; DB' > := normalize(getImports(U), getPars(U), DB)
    /\ IL' := subunitImports(PDL, IL, DB') .

  eq evalModule1(U, U', (U'' UL), VDS, DB)
    = evalModule1(U, addDecls(U', setImports(U'', nil)), UL, VDS, DB) .
  eq evalModule1(U, U', nil, VDS, DB) 
    = evalModule2(
        setImports(transform(U, DB), nil), 
        U', 
        insertVars(getName(U), VDS,
          insertInternalModule(getName(U), transform(U, DB), 
            insertTopModule(getName(U), U, DB)))) .
  eq evalModule1(U, U', unitError(QIL), VDS, DB) = warning(DB, QIL) .

  eq evalModule2(U, U', DB)
    = insertFlatModule(getName(U), flatModule(addDecls(U, U')), DB) .
  eq evalModule2(unitError(QIL), U, DB) = warning(DB, QIL) .

*** The function \texttt{evalPreModule} has to take care of the bubbles in the
*** unit. As we explained in Section~\ref{evaluation-overview}, both the
*** signature and the flattened version of the module are created
*** simultaneously, completing the parsing of the bubbles once the signature 
*** has been built, and then completing the flattened module.

*** The \texttt{evalPreModule} function takes as arguments two copies of the
*** module and a database. We shall see in Section~\ref{unit-processing} how
*** these two modules are generated; the one passed as first argument has
*** still bubbles in it, while the other one, which will be used to build the
*** signature, does not contain any bubbles. This module without bubbles is
*** the result of removing the bubbles from the declarations in it, or of 
*** removing the declarations themselves when they contain bubbles, as in the 
*** case of equations, for example.

*** The \texttt{evalPreModule} function is quite similar to the function
*** \texttt{evalModule}. First, the structure is normalized by calling the
*** \texttt{normalize} function, and then all the subunits in the
*** structure are collected (accomplished by \texttt{subunitImports} and
*** \texttt{getModules}) and the list of importations is updated
*** with the sublist of importations of built-in
*** modules (\texttt{selectBuiltInImports}). Second, the structure of all the
*** subunits below the top is flattened to a single unit. This unit is used to
*** create a first version of the signature (without identity elements of
*** operators) in which all the bubbles in the top preunit are
*** parsed (\texttt{solveBubbles}). The final version of the signature and 
*** the flat unit are generated once the bubbles have been parsed. The 
*** `internal' version of the module is also generated by renaming the 
*** variables in it (\texttt{renameVars}). All these versions of the module 
*** are finally entered in the database.

*** Note that if the \texttt{META-LEVEL} module is imported in the module
*** being evaluated, a declaration importing the predefined module
*** \texttt{UP} Section~\ref{non-built-in-predefined}) is added. With the
*** declarations in this module it will be possible to parse bubbles 
*** containing calls to the \texttt{up} functions (see 
*** Section~\ref{structured-specifications}) in them.

  op evalPreModule : Module Module OpDeclSet Database -> Database .
  op evalPreModule1 : 
       Module Module List<Module> Module OpDeclSet Database -> Database .
  op evalPreModule2 : Module Module Module OpDeclSet Database -> Database .
  op evalPreModule3 : Module Module Module Database -> Database .

  *** evalPreModule just calls evalPreModule1 with a set of the units in the 
  *** structure of the given module. Depending on whether the module is 
  *** importing META-LEVEL or not UP will be added. BOOL will be added if
  *** the include BOOL flag is set and the module doesn't include it already.

  ceq evalPreModule(PU, U, VDS, DB)
    *** PU  : top unit with bubbles (preunit)
    *** U   : top unit without bubbles (decls with bubbles were removed)
    *** VDS : ops corresponding to the vbles in the top unit 
    = evalPreModule1(
        setPars(setImports(PU, IL'), PDL'), 
        setName(empty(U), getName(U)),
        getModules(IL'', DB'), 
        setImports(U, nil), 
        VDS, 
        DB') 
    if IL := getImports(PU) 
    /\ PDL := getPars(PU)
    /\ < IL' ; PDL' ; DB' > := normalize(defImports(PU, DB) IL, PDL, DB)
    /\ IL'' := subunitImports(PDL, IL', DB') .
  eq evalPreModule(PU, U, VDS, DB) = DB [owise] .

  *** evalPreModule1 joins all the units in the structure into a single unit,
  *** the one given as second argument; recall that the fourth one is the
  *** top module without bubbles but with the complete list of subunits
  *** being imported explicitly

  eq evalPreModule1(PU, U, (U' UL), U'', VDS, DB)
    = evalPreModule1(PU, addDecls(U, U'), UL, U'', VDS, DB) .
  eq evalPreModule1(PU, U, nil, U', VDS, DB) 
    = evalPreModule2(PU, U, signature(transform(addDecls(U', setImports(U, nil)), DB)), VDS, DB)
    [owise] . 
  eq evalPreModule1(PU, unitError(QIL), UL, U', VDS, DB) = warning(DB, QIL) .
  eq evalPreModule1(unitError(QIL), U, UL, U', VDS, DB) = warning(DB, QIL) .
  eq evalPreModule1(PU, U, unitError(QIL), U', VDS, DB) = warning(DB, QIL) .

  eq evalPreModule2(PU, U, M, VDS, DB)
    *** PU : top module with bubbles
    *** U  : everything below
    *** M  : complete signature
    = evalPreModule3(
        solveBubblesMod(PU, getOps(U), M, 
          included('META-MODULE, getImports(PU), DB), VDS, DB),
        U, M, 
        insertVars(getName(PU), VDS, 
          insertTopModule(getName(PU), 
            solveBubblesMod(PU, getOps(U), M, 
              included('META-MODULE, getImports(PU), DB), VDS, DB), DB))) .

  eq evalPreModule3(PU, U, M, DB)
    *** PU : top module without bubbles
    *** U  : everything below
    *** M  : complete signature 
    = insertFlatModule(getName(PU),
        flatModule(setImports(transform(addDecls(PU, U), DB), nil)),
        insertInternalModule(getName(PU), transform(PU, DB), DB)) .
  eq evalPreModule3(unitError(QIL), U, M, DB) = warning(DB, QIL) .
 
endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

*** Note that in both \texttt{evalModule} and \texttt{evalPreModule}, the function
*** \texttt{transform} has to be invoked to transform the module into a
*** functional or system module. In the current system, the only 
*** transformation available is from object-oriented modules to system modules.

***
*** 6.8 Application of Map STS
***

*** The following two modules deal with the application of a set of renaming
*** maps to a module. Except for the proof obligations and additional checks
*** associated with views---almost none of these checks are performed, and
*** none of these proof obligations is generated in the current version---the
*** way of applying a renaming map and a view map on a module is the same.
*** Internally, they are treated in the same way; the only difference between 
*** them consists in the way of calling the function to accomplish this 
*** application.

*** Note that there might be some `interference' between sort maps, and
*** operator maps and message maps when they are applied. Let us consider for 
*** example a module with an operator declaration
*** 
***  op f : Foo -> Foo .
***
*** and a renaming map set 
***
***  (sort Foo to Bar, op f : Foo -> Foo to g)
***
*** These renamings have to be applied carefully to avoid unintended behaviors.
*** Depending on which of the maps is applied first, the other will be
*** applicable or not.  All the maps must be applied to the original module. 
*** To avoid the interference between the sort maps and other maps, the map set
*** is divided into two sTS: The first one contains the sort maps, and the 
*** second one contains the other maps.

*** We assume that there are no ambiguous mappings, that is, that we do not
*** have, for example, maps \verb~op f to g~ and \verb~op f to h~. In case of
*** such ambiguity, one of the maps will be arbitrarily chosen.

***
*** 6.8.1 Map STS on Terms
***

*** The application of a set of view maps to a term is defined in the following
*** module \texttt{VIEW-MAP-SET-APPL-ON-TERM}. The function
*** \texttt{applyMapsToTerm} is used to apply a given view map set to terms
*** appearing in equations, rules, identity element declarations, and 
*** membership axioms, as part of the process of applying a map set to a unit.

*** Some of the auxiliary functions introduced in this module will also be used
*** in the application of maps to operator and message declarations in the 
*** \texttt{VIEW-MAP-SET-APPL-ON-UNIT} module.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod VIEW-MAP-SET-APPL-ON-TERM is
  pr UNIT .
  pr VIEW-MAP .
  pr EXT-SORT .

  var  VMAP : ViewMap .
  vars VMAPS VMAPS' VMAPS'' : Set{ViewMap} .
  var  M : Module .
  vars F F' F'' A A' A'' : Qid .
  vars T T' T'' O : Term .
  vars TL TL' TL'' TL3 : TermList .
  vars S S' S'' C C' C'' : Sort .
  var  SS : SortSet .
  var  K : Kind .
  vars TyL TyL' : TypeList .
  vars Ty Ty' : Type .
  vars Subst Subst' Subst'' : Substitution .
  var  AtS : AttrSet .
  var  OPDS : OpDeclSet .
  vars V V' : Variable .
  vars Ct Ct' : Constant .
  var  QIL : QidList .

*** The following functions \texttt{applyMapsToSort} and
*** \texttt{applyMapsToClassSort} apply a set of maps, respectively, to a
*** sort a to a class name in its single identifier form, that is, when they
*** appear qualifying constants. Functions \texttt{applyMapsToType} and
*** \texttt{applyMapsToClassName} are similar but being applied to sort or 
*** class names in their normal form.

  op applyMapsToSort : Set{ViewMap} Sort -> Sort .
  eq applyMapsToSort((sort S to S'), S) = S' .
  eq applyMapsToSort((sort S to S'), S'') = S'' [owise] .
  eq applyMapsToSort(((sort S to S'), VMAPS), S) = S' .
  eq applyMapsToSort(((sort S to S'), VMAPS), S'') 
    = applyMapsToSort(VMAPS, S'')  
    [owise] .
  eq applyMapsToSort(VMAP, S) = S [owise].
  eq applyMapsToSort((VMAP, VMAPS), S) = applyMapsToSort(VMAPS, S) [owise].
  eq applyMapsToSort(none, S) = S .

  op applyMapsToSortSet : Set{ViewMap} SortSet -> SortSet .
  eq applyMapsToSortSet(VMAPS, (S ; SS)) 
    = (applyMapsToType(VMAPS, S) ; applyMapsToSortSet(VMAPS, SS)) .
  eq applyMapsToSortSet(VMAPS, none) = none .

  op applyMapsToType : Set{ViewMap} Type -> Type .
  eq applyMapsToType((sort S to S'), S) = S' .
  eq applyMapsToType((sort S to S'), S'') = S'' [owise] .
  eq applyMapsToType(((sort S to S'), VMAPS), S) = S' .
  eq applyMapsToType(((sort S to S'), VMAPS), S'')
    = applyMapsToType(VMAPS, S'')
    [owise] .
  eq applyMapsToType((sort S to S'), K)
    = qid("[" + string(applyMapsToType(sort S to S', getSort(K))) + "]") .
  eq applyMapsToType(((sort S to S'), VMAPS), K)
    = qid("[" 
       + string(applyMapsToType(((sort S to S'), VMAPS), getSort(K))) 
       + "]") .
  eq applyMapsToType(none, Ty) = Ty .

  op applyMapsToClassName : Set{ViewMap} Sort -> Sort .
  eq applyMapsToClassName((class C to C'), C) = C' .
  eq applyMapsToClassName((class C to C'), C'') = C'' [owise] .
  eq applyMapsToClassName(((class C to C'), VMAPS), C) = C' .
  eq applyMapsToClassName(((class C to C'), VMAPS), C'')
    = applyMapsToClassName(VMAPS, C'')  
    [owise] .
  eq applyMapsToClassName(VMAP, C) = C [owise] .
  eq applyMapsToClassName((VMAP, VMAPS), C)
    = applyMapsToClassName(VMAPS, C)
    [owise] .
  eq applyMapsToClassName(none, C) = C .

*** \texttt{} applies a map set to an operator name.

  op applyOpMapsToOpId : Qid Set{ViewMap} -> Qid .
  eq applyOpMapsToOpId(F, (op F to F' [AtS])) = F' .
  eq applyOpMapsToOpId(F, (op F : TyL -> Ty to F' [AtS])) = F' .
  eq applyOpMapsToOpId(F, VMAPS) = F [owise] .

*** Note that all maps introduced in Sections~\ref{renaming-maps}
*** and~\ref{view-maps}, except for label maps, may affect a term. For example,
*** sort maps will be applied to the qualifications of terms, and class and
*** attribute maps have to be applied to the objects appearing in the term.
*** Operator and message maps in which an explicit arity and coarity is given,
*** and operator maps going to derived operators (see Section~\ref{Views}) 
*** must be applied to the complete family of subsort-overloaded operators.

*** The function \texttt{applyMapsToTerm} takes as arguments two sTS of
*** view maps (the first set for sort maps, and the second for the other maps),
*** the term to which the maps will be applied, and a module to be used in the
*** matching of terms, sort comparisons, etc. Its declaration is as follows.

  op applyMapsToTerm2 : Set{ViewMap} Set{ViewMap} Term Module -> Term .

*** If the term on which the maps have to be applied is not an object,
*** different cases have to be considered for each of the possible forms of a
*** term. If it is a variable or \texttt{error*}, the same term is returned
*** without change (term maps are a special case for this). If it is a sort
*** test or a lazy sort test, with forms \verb~T : S~ and \verb~T :: S~,
*** respectively, the maps are applied to the term \texttt{T} and to the sort
*** \texttt{S}.  In case of being of forms \verb~F.S~ or \verb~F[TL]~ with
*** \texttt{F} an operator name, \texttt{S} a sort, and \texttt{TL} a list of
*** terms, the function \texttt{getRightOpMaps} will return the subset of
*** maps which are applicable on such term. If \texttt{none} is returned then
*** no map is applicable. If more than one map is returned then there is an
*** ambiguity, and any of them will be arbitrarily taken. The function 
*** \texttt{imagTerm} is called with the term and the maps applicable on 
*** it and return the image of the term. In case of a term of the form 
*** \texttt{F[TL]}, \texttt{imageOfTerm} will make recursive calls with the 
*** arguments in \texttt{TL}.

*** The application of a term map to a term requires the `matching' of the
*** source term in the map with the term on which the map is applied, and then
*** the application of the obtained substitution. Note, however, that a
*** complete matching algorithm is not required. Given the form of the pattern
*** we can choose before hand the appropriate map, that is, we know that in
*** fact there is a match when the function is called. Note also that the map
*** has to be applied to the whole family of subsort overloaded operators. We
*** just have to check that the sort of the given variable and the
*** corresponding term are in the same connected component of sorts.  In
*** addition to getting the appropriate substitution, the only thing we need
*** to check is that there are no variables with different assignments, that 
*** is, that in case of having a nonlinear pattern, the terms being assigned 
*** to each variable are equal. We call \texttt{pseudoMatch} to the function 
*** doing this task.

  op applyMapsToTerm2 : Set{ViewMap} Set{ViewMap} TermList Module -> TermList .

  op imageOfTerm : Set{ViewMap} Set{ViewMap} Term Set{ViewMap} Module -> Term .
  op applyMapsToSubst : 
       Set{ViewMap} Set{ViewMap} Substitution Module -> Substitution .
  op pseudoMatch : TermList TermList Module Substitution -> Substitution .
  op pseudoMatch2 : TermList TermList Module Substitution -> Substitution .
  op pseudoMatchResult : Substitution -> Substitution .
  op pseudoMatchResult : 
       Substitution Assignment Substitution Substitution -> Substitution .

  op applySubst : TermList Substitution -> TermList .

  op getRightOpMaps : 
       Qid TypeList Type Set{ViewMap} Module -> Set{ViewMap} .
  op applyMapsToObjectAttrSet : 
       Set{ViewMap} Set{ViewMap} Sort Term Module -> Term .
  op applyMapsToAttrNameInTerm : Set{ViewMap} Sort Qid Module -> Qid .

  eq applyMapsToTerm2(VMAPS, VMAPS', Ct, M) 
    = imageOfTerm(VMAPS, VMAPS', Ct, 
        getRightOpMaps(getName(Ct), nil, getType(Ct), VMAPS', M), M) .
  eq applyMapsToTerm2(VMAPS, VMAPS', V, M) 
    = qid(string(getName(V)) + ":" 
          + string(applyMapsToType(VMAPS, getType(V)))) .
  eq applyMapsToTerm2(VMAPS, VMAPS', qidError(QIL), M) = qidError(QIL) .
  eq applyMapsToTerm2(VMAPS, VMAPS', F[TL], M) 
    = imageOfTerm(VMAPS, VMAPS', F[TL], 
        getRightOpMaps(F, eLeastSort(M, TL), leastSort(M, F[TL]), 
          VMAPS', M), M)
    [owise] .
    ---- if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) .
  eq applyMapsToTerm2(VMAPS, VMAPS', '<_:_|_>[O, Ct, T], M) 
    = '<_:_|_>[applyMapsToTerm2(VMAPS, VMAPS', O, M), 
               qid(string(applyMapsToClassName(VMAPS', getName(Ct)))
                  + "." + string(applyMapsToClassName(VMAPS', getType(Ct)))),
               applyMapsToObjectAttrSet(VMAPS, VMAPS', getName(Ct), T, M)].
  ceq applyMapsToTerm2(VMAPS, VMAPS', '<_:_|_>[O, C, T], M) 
    = '<_:_|_>[applyMapsToTerm2(VMAPS, VMAPS', O, M), 
               applyMapsToClassName(VMAPS', C), 
               applyMapsToObjectAttrSet(VMAPS, VMAPS', C, T, M)] 
    if not C :: Constant .
  eq applyMapsToTerm2(VMAPS, VMAPS', '<_:_|`>[O, Ct], M) 
    = '<_:_|_>[applyMapsToTerm2(VMAPS, VMAPS', O, M), 
               qid(string(applyMapsToClassName(VMAPS', getName(Ct)))
                 + "." + string(applyMapsToClassName(VMAPS', getType(Ct)))),
               'none.AttributeSet] .
  ceq applyMapsToTerm2(VMAPS, VMAPS', '<_:_|`>[O, C], M) 
    = '<_:_|_>[applyMapsToTerm2(VMAPS, VMAPS', O, M), 
         applyMapsToClassName(VMAPS', C), 'none.AttributeSet] 
    if not C :: Constant .
  ceq applyMapsToTerm2(VMAPS, VMAPS', F[TL], M)
    = qid("_::`" + string(applyMapsToType(VMAPS, qid(substr(string(F), 4, length(string(F))))))) [
        applyMapsToTerm2(VMAPS, VMAPS', TL, M)]
    if substr(string(F), 0, 4) == "_::`" 
    /\ substr(string(F), sd(length(string(F)), 2), 2) = "`}" .
    
  ceq applyMapsToTerm2(VMAPS, VMAPS', (T, TL), M) 
    = (applyMapsToTerm2(VMAPS, VMAPS', T, M), 
       applyMapsToTerm2(VMAPS, VMAPS', TL, M)) 
    if TL =/= empty .

*** Application of a map set to the name of an attribute in an object

  eq applyMapsToAttrNameInTerm((attr A . S to A'), C, A'', M)
    = if sameKind(M, S, C) and-then (qid(string(A) + "`:_") == A'')
      then qid(string(A') + "`:_")
      else A''
      fi .
  eq applyMapsToAttrNameInTerm(((attr A . S to A'), VMAPS), C, A'', M)
    = if sameKind(M, S, C) and-then (qid(string(A) + "`:_") == A'')
      then qid(string(A') + "`:_")
      else applyMapsToAttrNameInTerm(VMAPS, C, A'', M)
      fi .
  eq applyMapsToAttrNameInTerm(VMAP, C, A, M) = A [owise] .
  eq applyMapsToAttrNameInTerm((VMAP, VMAPS), C, A, M)
    = applyMapsToAttrNameInTerm(VMAPS, C, A, M)
    [owise] .
  eq applyMapsToAttrNameInTerm(none, S, A, M) = A .

*** Selection of all the operator or message maps that are applicable on an
*** operator with a given arity and coarity.

  eq getRightOpMaps(F, TyL, Ty, (msg F' to F''), M)
    = getRightOpMaps(F, TyL, Ty, (op F' to F'' [none]), M) .
  eq getRightOpMaps(F, TyL, Ty, ((msg F' to F''), VMAPS), M)
    = getRightOpMaps(F, TyL, Ty, ((op F' to F'' [none]), VMAPS), M) .
  eq getRightOpMaps(F, TyL, Ty, (msg F' : TyL' -> Ty' to F''), M)
    = getRightOpMaps(F, TyL, Ty, op F' : TyL' -> Ty' to F'' [none], M) .
  eq getRightOpMaps(F, TyL, Ty, ((msg F' : TyL' -> Ty' to F''), VMAPS), M)
    = getRightOpMaps(F, TyL, Ty,
        (op F' : TyL' -> Ty' to F'' [none], VMAPS), M) .
  eq getRightOpMaps(F, TyL, Ty, (op F to F' [AtS]), M) = (op F to F' [AtS]) .
  eq getRightOpMaps(F, TyL, Ty, (op F to F' [AtS], VMAPS), M)
    = (op F to F' [AtS], getRightOpMaps(F, TyL, Ty, VMAPS, M)) .
  eq getRightOpMaps(F, TyL, Ty, op F : TyL' -> Ty' to F' [AtS], M)
    = if sameKind(M, TyL Ty, TyL' Ty') 
      then (op F : TyL' -> Ty' to F' [AtS])
      else none
      fi .
  eq getRightOpMaps(F, TyL, Ty, (op F : TyL' -> Ty' to F' [AtS], VMAPS), M)
    = if sameKind(M, TyL Ty, TyL' Ty') 
      then (op F : TyL' -> Ty' to F' [AtS], 
            getRightOpMaps(F, TyL, Ty, VMAPS, M))
      else getRightOpMaps(F, TyL, Ty, VMAPS, M)
      fi .
  eq getRightOpMaps(F, TyL, Ty, termMap(F[TL], T), M)
    = if sameKind(M, TyL, varListSort(TL))
      then (termMap(F[TL], T))
      else none
      fi .
  eq getRightOpMaps(F, TyL, Ty, (termMap(F[TL], T), VMAPS), M)
    = if sameKind(M, TyL, varListSort(TL))
      then (termMap(F[TL], T), getRightOpMaps(F, TyL, Ty, VMAPS, M))
      else getRightOpMaps(F, TyL, Ty, VMAPS, M) 
      fi .
  eq getRightOpMaps(F, TyL, Ty, (termMap(Ct, T)), M)
    = if TyL == nil 
         and-then (F == getName(Ct) 
         and-then sameKind(M, Ty, getType(Ct)))
      then (termMap(Ct, T))
      else none
      fi .
  eq getRightOpMaps(F, TyL, Ty, (termMap(Ct, T), VMAPS), M)
    = if TyL == nil 
         and-then (F == getName(Ct) 
         and-then sameKind(M, Ty, getType(Ct)))
      then (termMap(Ct, T), getRightOpMaps(F, TyL, Ty, VMAPS, M))
      else getRightOpMaps(F, TyL, Ty, VMAPS, M) 
      fi .
  eq getRightOpMaps(F, TyL:[Type], Ty:[Type], VMAPS, M) = none [owise].

  op varListSort : TermList -> TypeList .
  eq varListSort((V, TL)) = (getType(V) varListSort(TL)) .
  eq varListSort(empty) = nil .

*** Application of a map set to the set of attributes in an object

  eq applyMapsToObjectAttrSet(VMAPS, VMAPS', C, '_`,_[A[T], TL], M)
    = '_`,_[applyMapsToAttrNameInTerm(VMAPS', C, A, M)
              [applyMapsToTerm2(VMAPS, VMAPS', T, M)], 
            applyMapsToObjectAttrSet(VMAPS, VMAPS', C, TL, M)] .
  eq applyMapsToObjectAttrSet(VMAPS, VMAPS', C, A[T], M)
    = applyMapsToAttrNameInTerm(VMAPS', C, A, M) 
        [applyMapsToTerm2(VMAPS, VMAPS', T, M)] .
  eq applyMapsToObjectAttrSet(VMAPS, VMAPS', C, 
       '_`,_['none.AttributeSet, TL], M)
    = '_`,_['none.AttributeSet, 
            applyMapsToObjectAttrSet(VMAPS, VMAPS', C, TL, M)] .
  eq applyMapsToObjectAttrSet(VMAPS, VMAPS', C, 'none.AttributeSet, M) 
    = 'none.AttributeSet .

*** Image of a term 

  eq imageOfTerm(VMAPS, VMAPS', Ct, none, M)
    = qid(string(getName(Ct)) + "." 
          + string(applyMapsToType(VMAPS, getType(Ct)))) .
  eq imageOfTerm(VMAPS, VMAPS', F[TL], none, M)
    = F [ applyMapsToTerm2(VMAPS, VMAPS', TL, M) ] .

  eq imageOfTerm(VMAPS, VMAPS', F[TL], (op F to F' [AtS]), M) 
    = F' [ applyMapsToTerm2(VMAPS, VMAPS', TL, M) ] .
  eq imageOfTerm(VMAPS, VMAPS', F[TL], ((op F to F' [AtS]), VMAPS''), M) 
    = F' [ applyMapsToTerm2(VMAPS, VMAPS', TL, M) ] .
  eq imageOfTerm(VMAPS, VMAPS', F[TL], (op F : TyL -> Ty to F'[AtS]), M)
    = F' [ applyMapsToTerm2(VMAPS, VMAPS', TL, M) ] .
  eq imageOfTerm(VMAPS, VMAPS', F[TL], (op F : TyL -> Ty to F'[AtS], VMAPS''),M)
    = F' [ applyMapsToTerm2(VMAPS, VMAPS', TL, M) ] .
  eq imageOfTerm(VMAPS, VMAPS', T, termMap(T', T''), M) 
    = applySubst(T'', 
        applyMapsToSubst(VMAPS, VMAPS', pseudoMatch(T', T, M, none), M)) .
  eq imageOfTerm(VMAPS, VMAPS', T, (termMap(T', T''), VMAPS''), M) 
    = applySubst(T'', 
        applyMapsToSubst(VMAPS, VMAPS', pseudoMatch(T', T, M, none), M)) .
  ceq imageOfTerm(VMAPS, VMAPS', Ct, (op F to F' [AtS]), M) 
    = qid(string(F') + "." + string(applyMapsToType(VMAPS, getType(Ct)))) 
    if getName(Ct) = F .
  ceq imageOfTerm(VMAPS, VMAPS', Ct, ((op F to F' [AtS]), VMAPS''), M) 
    = qid(string(F') + "." + string(applyMapsToType(VMAPS, getType(Ct)))) 
    if getName(Ct) = F .
  ceq imageOfTerm(VMAPS, VMAPS', Ct, (op F : TyL -> Ty to F' [AtS]), M)
    = qid(string(F') + "." + string(applyMapsToType(VMAPS, getType(Ct))))
    if getName(Ct) = F .
  ceq imageOfTerm(VMAPS, VMAPS', Ct, (op F : TyL -> Ty to F' [AtS], VMAPS''),M)
    = qid(string(F') + "." + string(applyMapsToType(VMAPS, getType(Ct))))
    if getName(Ct) = F .

*** Application of a Substitution on a term

  eq applySubst(T, none) = T .
  eq applySubst(V, ((V' <- T) ; Subst))
    = if getName(V) == getName(V')
      then T
      else applySubst(V, Subst)
      fi .
  eq applySubst(F[TL], Subst) = F[applySubst(TL, Subst)] .
  eq applySubst(Ct, Subst) = Ct .
  ceq applySubst((T, TL), Subst) 
    = (applySubst(T, Subst), applySubst(TL,Subst))
    if TL =/= empty .

*** PseudoMatch

  eq pseudoMatch(T, T', M, Subst) 
    = pseudoMatchResult(pseudoMatch2(T, T', M, Subst)) .

  eq pseudoMatch2(Ct, Ct', M, Subst) = none .
  eq pseudoMatch2(F[TL], F'[TL'], M, Subst) 
    = if F == F'
      then pseudoMatch2(TL, TL', M, Subst)
      else none 
      fi .
  eq pseudoMatch2((V, TL), (T, TL'), M, Subst) 
    = if sameKind(M, getType(V), leastSort(M, T))
      then pseudoMatch2(TL, TL', M, (V <- T ; Subst)) 
      else none
      fi .
  eq pseudoMatch2(V, T, M, Subst) 
    = if sameKind(M, getType(V), leastSort(M, T))
      then (V <- T ; Subst) 
      else none
      fi .

  eq pseudoMatch2((V, TL), (T, TL'), M, Subst) 
    = if sameKind(M, getType(V), leastSort(M, T))
      then pseudoMatch2(TL, TL', M, (V <- T ; Subst)) 
      else none
      fi .
  eq pseudoMatch2((Ct, TL), (Ct', TL'), M, Subst) 
    = if getName(Ct) == getName(Ct')
      then pseudoMatch2(TL, TL', M, Subst) 
      else none
      fi .
  eq pseudoMatch2((F[TL], TL'), (F'[TL''], TL3), M, Subst) 
    = if F == F'
      then pseudoMatch2(TL', TL3, M, pseudoMatch2(TL, TL'', M, none) ; Subst)
      else none 
      fi .
  eq pseudoMatch2(empty, empty, M, Subst) = Subst .

  *** pseudoMatchResult detects conflicts and eliminates duplicates

  eq pseudoMatchResult((V <- T) ; Subst)
    = pseudoMatchResult(none, (V <- T), none, Subst) .
  eq pseudoMatchResult(none) = none .

  eq pseudoMatchResult(Subst, (V <- T), Subst', (V' <- T') ; Subst'')
    = if V == V' 
      then if T == T' 
           then pseudoMatchResult(Subst, (V <- T), Subst', Subst'')
           else none
           fi
      else pseudoMatchResult(Subst, (V <- T), Subst' ; (V' <- T'), Subst'')
      fi .
  eq pseudoMatchResult(Subst, (V <- T), (V' <- T') ; Subst', none)
    = pseudoMatchResult(Subst ; (V <- T), (V' <- T'), none, Subst') .
  eq pseudoMatchResult(Subst, (V <- T), none, none) = (Subst ; (V <- T)) .

*** Application of a set of maps to a substitution

  eq applyMapsToSubst(VMAPS, VMAPS', ((V <- T) ; Subst), M)
    = ((applyMapsToTerm2(VMAPS, VMAPS', V, M) 
          <- applyMapsToTerm2(VMAPS, VMAPS', T, M)) ; 
       applyMapsToSubst(VMAPS, VMAPS', Subst, M)) .
  eq applyMapsToSubst(VMAPS, VMAPS', none, M) = none .

endfm

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

*** We do not include here the equations defining the semantics of the function
*** \texttt{applyMapsToTerm}. Instead, we present an example illustrating
*** the meaning of the function. Renaming maps and view maps were already
*** discussed in Sections~\ref{Views} and~\ref{module-expressions}.

*** Let us consider the following configuration in the module
*** \texttt{STACK2[Accnt]} presented in Section~\ref{module-expressions}. In
*** this configuration we have objects in the class \texttt{Accnt} which
*** represent the accounts of different clients of a bank, which is
*** represented as an object \texttt{'bank} of class \texttt{Stack[Accnt]}.
*** The object \texttt{'bank} in the example configuration below keeps a stack 
*** with the accounts of the bank represented as a linked list of nodes, each 
*** of which corresponds to the account of one of the clients.

***   ('bank push 'john) 
***   ('peter elt 2000) 
***   < 'bank : Stack[Accnt] | first : o ('bank, 1) > 
***   < 'paul : Accnt | bal : 5000 > 
***   < 'peter : Accnt | bal : 2000 > 
***   < 'mary : Accnt | bal : 7200 > 
***   < 'john : Accnt | bal : 100 > 
***   < o('bank, 0) : Node[Accnt] | node : 'peter, next : null > 
***   < o('bank, 1) : Node[Accnt] | node : 'mary, next : o('bank, 0) > .
***
*** Let us apply the following renaming to the previous term. 
*** 
***   (op o to id, 
***    class Stack[Accnt] to Bank,
***    msg _push_ : Oid Oid -> Msg to open`account`in_to_,
***    msg _pop to close`account`of_,
***    msg _elt_ to _owns_dollars,
***    attr node . Node[Accnt] to client,
***    attr bal . Accnt to balance)
***
*** The resulting term is as follows.
*** 
***   (open account in 'bank to 'john) 
***   ('peter owns 2000 dollars) 
***   < 'bank : Bank | first : id('bank, 1) > 
***   < 'paul : Accnt | balance : 5000 > 
***   < 'peter : Accnt | balance : 2000 > 
***   < 'mary : Accnt | balance : 7200 > 
***   < 'john : Accnt | balance : 100 > 
***   < id('bank, 0) : Node[Accnt] | client : 'peter, next : null > 
***   < id('bank, 1) : Node[Accnt] | client : 'mary, next : id('bank, 0) >

*** The function \texttt{applyMapsToTerm} treats the object constructor
*** \verb~<_:_|_>~ in a special way. It cannot be renamed, and, when an
*** occurrence of such a constructor is found, class and attribute maps require
*** a particular handling. Inside terms these maps are only triggered when
*** this constructor is found, and they are applied in a very restricted way,
*** according to the general pattern for objects.  We assume that the operator 
*** \verb~<_:_|_>~ is only used for objects and that objects constructed using 
*** it are well-formed.

***
*** 6.8.2 Map STS on Modules
***

*** The application of view maps to modules and theories of the different types
*** is defined in the following module \texttt{VIEW-MAP-SET-APPL-ON-UNIT}. The
*** function \texttt{applyMapsToModule} is defined recursively by applying it
*** to the different components of a unit. When the terms in the different
*** declarations are reached, the function \texttt{applyMapsToTerm} is 
*** called. This call is made with the set of maps split conveniently, as 
*** explained above.

-------------------------------------------------------------------------------
*******************************************************************************
-------------------------------------------------------------------------------

fmod VIEW-MAP-SET-APPL-ON-UNIT is
  pr VIEW-MAP-SET-APPL-ON-TERM .
  pr INT-LIST .
  pr VIEW-EXPR .

  op applyMapsToModule : Set{ViewMap} Module Module -> Module .
  op applyMapsToModuleAux : Set{ViewMap} Set{ViewMap} Module Module -> Module .
  op splitMaps : Set{ViewMap} -> Tuple{Set{ViewMap},Set{ViewMap}} .
  op splitMapsAux : Set{ViewMap} Set{ViewMap} Set{ViewMap} 
       -> Tuple{Set{ViewMap},Set{ViewMap}} .

  op applyMapsToTypeList : Set{ViewMap} TypeList -> TypeList .
  op applyMapsToSubsorts : Set{ViewMap} SubsortDeclSet -> SubsortDeclSet .
  op applyMapsToOps : Set{ViewMap} Set{ViewMap} OpDeclSet Module 
       -> OpDeclSet .
  op applyMapsToOp : 
       Set{ViewMap} Set{ViewMap} Set{ViewMap} OpDecl Module -> OpDecl .
  op applyMapsToAttrs : Set{ViewMap} Set{ViewMap} AttrSet Module -> AttrSet .
  op applyMapToAttrs : ViewMap AttrSet -> AttrSet .
  op applyMapToAttrsAux : AttrSet AttrSet AttrSet -> AttrSet .
  op applyMapsToHooks : 
       Set{ViewMap} Set{ViewMap} HookList Module -> HookList .
  op applyMapsToHooksAux : Set{ViewMap} Set{ViewMap} Hook Module -> Hook .
  op applyMapsToMbs : Set{ViewMap} Set{ViewMap} MembAxSet Module 
       -> MembAxSet .
  op applyMapsToEqs : 
       Set{ViewMap} Set{ViewMap} EquationSet Module -> EquationSet .
  op applyMapsToRls : Set{ViewMap} Set{ViewMap} RuleSet Module -> RuleSet .
  op applyMapsToCond : Set{ViewMap} Set{ViewMap} Condition Module -> Condition .
  op applyMapsToLabel : Set{ViewMap} Qid -> Qid .
  op applyMapsToClassDeclSet : 
       Set{ViewMap} Set{ViewMap} ClassDeclSet -> ClassDeclSet .
  op applyMapsToSubclassDeclSet : 
       Set{ViewMap} SubclassDeclSet -> SubclassDeclSet .
  op applyMapsToMsgDeclSet : 
       Set{ViewMap} Set{ViewMap} MsgDeclSet Module -> MsgDeclSet .
  op applyMapsToMsgDecl : Set{ViewMap} Set{ViewMap} MsgDecl Module -> MsgDecl .
  op applyMapsToAttrName : Set{ViewMap} Sort Qid -> Qid .
  op applyMapsToAttrDeclSet : 
       Set{ViewMap} Set{ViewMap} Sort AttrDeclSet -> AttrDeclSet .

  vars M U : Module .
  vars QI QI' QI'' L L' L'' F F' F'' A A' A'' : Qid .
  vars V V' : Variable .
  vars QIL QIL' : QidList .
  var  VE : ViewExp .
  var  H : Header .
  var  ME : ModuleExpression .
  var  PDL : ParameterDeclList .
  var  IL : ImportList .
  vars S S' S'' C C' C'' : Sort .
  var  Ty : Type .
  vars TyL TyL' : TypeList .
  var  SS : SortSet .
  var  SSDS : SubsortDeclSet .
  var  OPDS : OpDeclSet .
  var  MAS : MembAxSet .
  var  EqS : EquationSet .
  var  RlS : RuleSet .
  var  CDS : ClassDeclSet .
  var  SCDS : SubclassDeclSet .
  var  MDS : MsgDeclSet .
  var  ADS : AttrDeclSet .
  vars T T' T'' T3 O : Term .
  vars TL TL' : TermList .
  var  At : Attr .
  vars AtS AtS' AtS'' : AttrSet . 
  vars I I' : Nat .
  vars NL NL' : IntList .
  var  Hk : Hook .
  var  HkL : HookList .
  var  VMAP : ViewMap .
  vars VMAPS VMAPS' VMAPS'' : Set{ViewMap} .
  var  Subst : Substitution .
  var  Cond : Condition .
  var  St : String .
  var  MN : ModuleName .

  sort Tuple{Set{ViewMap},Set{ViewMap}} .
  op <_;_> : Set{ViewMap} Set{ViewMap} -> Tuple{Set{ViewMap},Set{ViewMap}} .
  ops sortMaps otherMaps : Tuple{Set{ViewMap},Set{ViewMap}} -> Set{ViewMap} .
  eq sortMaps(< VMAPS ; VMAPS' >) = VMAPS .
  eq otherMaps(< VMAPS ; VMAPS' >) = VMAPS' .

  eq splitMaps(VMAPS) = splitMapsAux(VMAPS, none, none) .
  eq splitMapsAux((sort S to S'), VMAPS', VMAPS'') 
    = splitMapsAux(none, ((sort S to S'), VMAPS'), VMAPS'') .
  eq splitMapsAux(((sort S to S'), VMAPS), VMAPS', VMAPS'') 
    = splitMapsAux(VMAPS, ((sort S to S'), VMAPS'), VMAPS'') .
  eq splitMapsAux(VMAP, VMAPS', VMAPS'') 
    = splitMapsAux(none, VMAPS', (VMAP, VMAPS'')) [owise] .
  eq splitMapsAux((VMAP, VMAPS), VMAPS', VMAPS'') 
    = splitMapsAux(VMAPS, VMAPS', (VMAP, VMAPS'')) [owise] .
  eq splitMapsAux(none, VMAPS, VMAPS') = < VMAPS ; VMAPS' > .

*** To avoid the interference between the sort maps with other maps, the map
*** set is divided in two sets.

  ceq applyMapsToModule(VMAPS, U, M) 
    = applyMapsToModuleAux(VMAPS', VMAPS'', U, M) 
    if < VMAPS' ; VMAPS'' > := splitMaps(VMAPS) .
  eq applyMapsToModule(VMAPS, U, unitError(QIL)) = unitError(QIL) .

  eq applyMapsToModuleAux(VMAPS, VMAPS', 
        mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, 
        M)
    = mod H is
          IL 
          sorts applyMapsToSortSet(VMAPS, SS) . 
          applyMapsToSubsorts(VMAPS, SSDS)
          applyMapsToOps(VMAPS, VMAPS', OPDS, M)
          applyMapsToMbs(VMAPS, VMAPS', MAS, M)
          applyMapsToEqs(VMAPS, VMAPS', EqS, M)
          applyMapsToRls(VMAPS, VMAPS', RlS, M)
      endm .
  eq applyMapsToModuleAux(VMAPS, VMAPS', 
        th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, 
        M)
    = th MN is
          IL sorts applyMapsToSortSet(VMAPS, SS) . 
          applyMapsToSubsorts(VMAPS, SSDS)
          applyMapsToOps(VMAPS, VMAPS', OPDS, M)
          applyMapsToMbs(VMAPS, VMAPS', MAS, M)
          applyMapsToEqs(VMAPS, VMAPS', EqS, M)
          applyMapsToRls(VMAPS, VMAPS', RlS, M)
      endth .
  eq applyMapsToModuleAux(VMAPS, VMAPS', 
        fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, 
        M)
    = fmod H is
          IL 
          sorts applyMapsToSortSet(VMAPS, SS) .
          applyMapsToSubsorts(VMAPS, SSDS)
          applyMapsToOps(VMAPS, VMAPS', OPDS, M)
          applyMapsToMbs(VMAPS, VMAPS', MAS, M)
          applyMapsToEqs(VMAPS, VMAPS', EqS, M)
      endfm .
  eq applyMapsToModuleAux(VMAPS, VMAPS', fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, M)
    = fth MN is 
          IL 
          sorts applyMapsToSortSet(VMAPS, SS) .
          applyMapsToSubsorts(VMAPS, SSDS)
          applyMapsToOps(VMAPS, VMAPS', OPDS, M)
          applyMapsToMbs(VMAPS, VMAPS', MAS, M)
          applyMapsToEqs(VMAPS, VMAPS', EqS, M)
      endfth .
  eq applyMapsToModuleAux(VMAPS, VMAPS', 
        omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, 
        M)
    = omod H is 
           IL 
           sorts applyMapsToSortSet(VMAPS, SS) . 
           applyMapsToSubsorts(VMAPS, SSDS)
           applyMapsToClassDeclSet(VMAPS, VMAPS', CDS)
           applyMapsToSubclassDeclSet(VMAPS', SCDS)
           applyMapsToOps(VMAPS, VMAPS', OPDS, M)
           applyMapsToMsgDeclSet(VMAPS, VMAPS', MDS, M)
           applyMapsToMbs(VMAPS, VMAPS', MAS, M)
           applyMapsToEqs(VMAPS, VMAPS', EqS, M)
           applyMapsToRls(VMAPS, VMAPS', RlS, M)
      endom .
  eq applyMapsToModuleAux(VMAPS, VMAPS', 
        oth MN is 
          IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS 
        endoth, 
        M)
    = oth MN is 
           IL 
           sorts applyMapsToSortSet(VMAPS, SS) . 
           applyMapsToSubsorts(VMAPS, SSDS)
           applyMapsToClassDeclSet(VMAPS, VMAPS', CDS)
           applyMapsToSubclassDeclSet(VMAPS', SCDS)
           applyMapsToOps(VMAPS, VMAPS', OPDS, M)
           applyMapsToMsgDeclSet(VMAPS, VMAPS', MDS, M)
           applyMapsToMbs(VMAPS, VMAPS', MAS, M)
           applyMapsToEqs(VMAPS, VMAPS', EqS, M)
           applyMapsToRls(VMAPS, VMAPS', RlS, M)
      endoth .

  eq applyMapsToOps(VMAPS, VMAPS', (op F : TyL -> Ty [AtS] . OPDS), M)
    = (applyMapsToOp(VMAPS, getRightOpMaps(F, TyL, Ty, VMAPS', M), 
          VMAPS', (op F : TyL -> Ty [AtS] .), M)
       applyMapsToOps(VMAPS, VMAPS', OPDS, M)) .
  eq applyMapsToOps(VMAPS, VMAPS', none, M) = none .

  eq applyMapsToOp(VMAPS, VMAP, VMAPS', (op F : TyL -> Ty [AtS] .), M)
    = (op applyOpMapsToOpId(F, VMAP) : applyMapsToTypeList(VMAPS, TyL)
           -> applyMapsToType(VMAPS, Ty) 
        [applyMapsToAttrs(VMAPS, VMAPS', applyMapToAttrs(VMAP, AtS), M)] .) .
  eq applyMapsToOp(VMAPS, (VMAP, VMAPS'), VMAPS'', 
       (op F : TyL -> Ty [AtS] .), M)
    *** In case of ambiguous mappings we take one of them arbitrarily 
    = (op applyOpMapsToOpId(F, VMAP) : applyMapsToTypeList(VMAPS, TyL)
           -> applyMapsToType(VMAPS, Ty) 
        [applyMapsToAttrs(VMAPS, VMAPS'', applyMapToAttrs(VMAP, AtS), M)] .) .
  eq applyMapsToOp(VMAPS, none, VMAPS', (op F : TyL -> Ty [AtS] .), M)
    *** No map for this declaration
    = (op F : applyMapsToTypeList(VMAPS, TyL) -> applyMapsToType(VMAPS, Ty) 
        [applyMapsToAttrs(VMAPS, VMAPS', AtS, M)] .) .

  eq applyMapsToMsgDeclSet(VMAPS, VMAPS', ((msg F : TyL -> Ty .) MDS), M)
    = (applyMapsToMsgDecl(VMAPS, getRightOpMaps(F, TyL, Ty, VMAPS', M), 
          (msg F : TyL -> Ty .), M)
       applyMapsToMsgDeclSet(VMAPS, VMAPS', MDS, M)) .
  eq applyMapsToMsgDeclSet(VMAPS, VMAPS', none, M) = none .

  eq applyMapsToMsgDecl(VMAPS, VMAP, (msg F : TyL -> Ty .), M)
    = (msg applyOpMapsToOpId(F, VMAP) : applyMapsToTypeList(VMAPS, TyL)
           -> applyMapsToType(VMAPS, Ty) .) .
  eq applyMapsToMsgDecl(VMAPS, (VMAP, VMAPS'), (msg F : TyL -> Ty .), M)
    *** In case of ambiguous mappings we take one of them arbitrarily
    = (msg applyOpMapsToOpId(F, VMAP) : applyMapsToTypeList(VMAPS, TyL)
           -> applyMapsToType(VMAPS, Ty) .) .
  eq applyMapsToMsgDecl(VMAPS, none, (msg F : TyL -> Ty .), M)
    *** No map for this declaration
    = (msg F : applyMapsToTypeList(VMAPS, TyL) 
         -> applyMapsToType(VMAPS, Ty) .) .

*** The function \texttt{applyMapToAttrs} just takes care of changing the
*** attributes of the operators as indicated in the renamings. The renamings
*** properly said is accomplished by the function 
*** \texttt{applyMapsToAttrs}.

  eq applyMapToAttrs((msg F to F'), AtS) = AtS .
  eq applyMapToAttrs((msg F : TyL -> Ty to F'), AtS) = AtS .
  eq applyMapToAttrs(termMap(T, T'), AtS) = AtS .
  eq applyMapToAttrs((op F to F' [AtS]), AtS')
    = applyMapToAttrsAux(AtS, AtS', none) .
  eq applyMapToAttrs((op F : TyL -> Ty to F' [AtS]), AtS')
    = applyMapToAttrsAux(AtS, AtS', none) .

  *** add the new syntactic attributes
  eq applyMapToAttrsAux((gather(QIL) AtS), AtS', AtS'')
    = applyMapToAttrsAux(AtS, AtS', (gather(QIL) AtS'')) .
  eq applyMapToAttrsAux((format(QIL) AtS), AtS', AtS'')
    = applyMapToAttrsAux(AtS, AtS', (format(QIL) AtS'')) .
  eq applyMapToAttrsAux((prec(I) AtS), AtS', AtS'')
    = applyMapToAttrsAux(AtS, AtS', (prec(I) AtS'')) .
  eq applyMapToAttrsAux((At AtS), AtS', AtS'')
    = applyMapToAttrsAux(AtS, AtS', AtS'') 
    [owise] .

  *** remove the old syntactic attributes
  eq applyMapToAttrsAux(AtS, (format(QIL) AtS'), AtS'')
    = applyMapToAttrsAux(AtS, AtS', AtS'') .
  eq applyMapToAttrsAux(AtS, (gather(QIL) AtS'), AtS'')
    = applyMapToAttrsAux(AtS, AtS', AtS'') .
  eq applyMapToAttrsAux(AtS, (prec(I) AtS'), AtS'')
    = applyMapToAttrsAux(AtS, AtS', AtS'') .

  eq applyMapToAttrsAux(none, (At AtS), AtS')
    = applyMapToAttrsAux(none, AtS, (At AtS')) .
  eq applyMapToAttrsAux(none, none, AtS) = AtS .

  eq applyMapsToTypeList(VMAPS, (Ty TyL)) 
    = (applyMapsToType(VMAPS, Ty) applyMapsToTypeList(VMAPS, TyL)) .
  eq applyMapsToTypeList(VMAPS, nil) = nil .

  eq applyMapsToSubsorts(VMAPS, ((subsort S < S' .) SSDS))
    = ((subsort applyMapsToType(VMAPS, S) 
          < applyMapsToType(VMAPS, S') .)
       applyMapsToSubsorts(VMAPS, SSDS)) .
  eq applyMapsToSubsorts(VMAPS, none) = none .

  eq applyMapsToAttrs(VMAPS, VMAPS', (id(T) AtS), M)
    = (id(applyMapsToTerm2(VMAPS, VMAPS', T, M))
       applyMapsToAttrs(VMAPS, VMAPS', AtS, M)) .
  eq applyMapsToAttrs(VMAPS, VMAPS', (left-id(T) AtS), M)
    = (left-id(applyMapsToTerm2(VMAPS, VMAPS', T, M))
       applyMapsToAttrs(VMAPS, VMAPS', AtS, M)) .
  eq applyMapsToAttrs(VMAPS, VMAPS', (right-id(T) AtS), M)
    = (right-id(applyMapsToTerm2(VMAPS, VMAPS', T, M))
       applyMapsToAttrs(VMAPS, VMAPS', AtS, M)) .
  eq applyMapsToAttrs(VMAPS, VMAPS', (special(HkL) AtS), M)
    = (special(applyMapsToHooks(VMAPS, VMAPS', HkL, M))
       applyMapsToAttrs(VMAPS, VMAPS', AtS, M)) .
  eq applyMapsToAttrs(VMAPS, VMAPS', (label(L) AtS), M)
    = (label(applyMapsToLabel(VMAPS, L))
       applyMapsToAttrs(VMAPS, VMAPS', AtS, M)) .
  eq applyMapsToAttrs(VMAPS, VMAPS', AtS, M) = AtS [owise] .

  eq applyMapsToHooks(VMAPS, VMAPS', id-hook(QI, QIL) HkL, M) 
    = id-hook(QI, QIL) 
      applyMapsToHooks(VMAPS, VMAPS', HkL, M).
  eq applyMapsToHooks(VMAPS, VMAPS', op-hook(QI, QI', QIL, QI'') HkL, M)
    = applyMapsToHooksAux(VMAPS, 
         getRightOpMaps(QI', QIL, QI'', VMAPS', M), 
         op-hook(QI, QI', QIL, QI''), M) 
      applyMapsToHooks(VMAPS, VMAPS', HkL, M).
  eq applyMapsToHooks(VMAPS, VMAPS', term-hook(QI, T) HkL, M)
    = term-hook(QI, applyMapsToTerm2(VMAPS, VMAPS', T, M)) 
      applyMapsToHooks(VMAPS, VMAPS', HkL, M).
  eq applyMapsToHooks(VMAPS, VMAPS', nil, M) = nil .

  eq applyMapsToHooksAux(VMAPS, VMAP, op-hook(QI, F, TyL, Ty), M)
    = op-hook(QI, applyOpMapsToOpId(F, VMAP),
         applyMapsToTypeList(VMAPS, TyL), applyMapsToType(VMAPS, Ty)) .
  eq applyMapsToHooksAux(VMAPS, (VMAP, VMAPS'), op-hook(QI, F, TyL, Ty), M)
    *** In case of ambiguous mappings we take any of them arbitrarily  
    = op-hook(QI, applyOpMapsToOpId(F, VMAP),
         applyMapsToTypeList(VMAPS, TyL), applyMapsToType(VMAPS, Ty)) .
  eq applyMapsToHooksAux(VMAPS, none, op-hook(QI, F, TyL, Ty), M)
    = op-hook(QI, F, applyMapsToTypeList(VMAPS, TyL), 
        applyMapsToType(VMAPS, Ty)) .

  eq applyMapsToMbs(VMAPS, VMAPS', ((mb T : S [AtS] .) MAS), M)
    = ((mb applyMapsToTerm2(VMAPS, VMAPS', T, M) 
            : applyMapsToType(VMAPS, S) 
            [applyMapsToAttrs(VMAPS, VMAPS', AtS, M)] .)
       applyMapsToMbs(VMAPS, VMAPS', MAS, M)) .
  eq applyMapsToMbs(VMAPS, VMAPS', ((cmb T : S if Cond [AtS] .) MAS),
       M)
    = ((cmb applyMapsToTerm2(VMAPS, VMAPS', T, M)
            : applyMapsToType(VMAPS, S)
              if applyMapsToCond(VMAPS, VMAPS', Cond, M) 
        [applyMapsToAttrs(VMAPS, VMAPS', AtS, M)] .)
       applyMapsToMbs(VMAPS, VMAPS', MAS, M)) .
  eq applyMapsToMbs(VMAPS, VMAPS', none, M) = none .

  eq applyMapsToEqs(VMAPS, VMAPS', ((ceq T = T' if Cond [AtS] .) EqS), M) 
    = ((ceq applyMapsToTerm2(VMAPS, VMAPS', T, M) 
           = applyMapsToTerm2(VMAPS, VMAPS', T', M)
             if applyMapsToCond(VMAPS, VMAPS', Cond, M) 
        [applyMapsToAttrs(VMAPS, VMAPS', AtS, M)] .)
       applyMapsToEqs(VMAPS, VMAPS', EqS, M)) .
  eq applyMapsToEqs(VMAPS, VMAPS', ((eq T = T' [AtS] .) EqS), M) 
    = ((eq applyMapsToTerm2(VMAPS, VMAPS', T, M) 
             = applyMapsToTerm2(VMAPS, VMAPS', T', M) 
             [applyMapsToAttrs(VMAPS, VMAPS', AtS, M)] .)
       applyMapsToEqs(VMAPS, VMAPS', EqS, M)) .
  eq applyMapsToEqs(VMAPS, VMAPS', none, M) = none .

  eq applyMapsToRls(VMAPS, VMAPS', ((crl T => T' if Cond [AtS] .) RlS), M) 
    = ((crl applyMapsToTerm2(VMAPS, VMAPS', T, M)
           => applyMapsToTerm2(VMAPS, VMAPS', T', M)
           if applyMapsToCond(VMAPS, VMAPS', Cond, M) 
        [applyMapsToAttrs(VMAPS, VMAPS', AtS, M)] .)
       applyMapsToRls(VMAPS, VMAPS', RlS, M)) .
  eq applyMapsToRls(VMAPS, VMAPS', ((rl T => T' [AtS] .) RlS), M) 
    = ((rl applyMapsToTerm2(VMAPS, VMAPS', T, M)
          => applyMapsToTerm2(VMAPS, VMAPS', T', M) 
        [applyMapsToAttrs(VMAPS, VMAPS', AtS, M)] .)
       applyMapsToRls(VMAPS, VMAPS', RlS, M)) .
  eq applyMapsToRls(VMAPS, VMAPS', none, M) = none .

  eq applyMapsToCond(VMAPS, VMAPS', T = T' /\ Cond, M)
    = applyMapsToTerm2(VMAPS, VMAPS', T, M) 
        = applyMapsToTerm2(VMAPS, VMAPS', T', M)
      /\ applyMapsToCond(VMAPS, VMAPS', Cond, M) .
  eq applyMapsToCond(VMAPS, VMAPS', T : S /\ Cond, M)
    = applyMapsToTerm2(VMAPS, VMAPS', T, M) 
        : applyMapsToSort(VMAPS, S)
      /\ applyMapsToCond(VMAPS, VMAPS', Cond, M) .
  eq applyMapsToCond(VMAPS, VMAPS', T := T' /\ Cond, M)
    = applyMapsToTerm2(VMAPS, VMAPS', T, M) 
        := applyMapsToTerm2(VMAPS, VMAPS', T', M)
      /\ applyMapsToCond(VMAPS, VMAPS', Cond, M) .
  eq applyMapsToCond(VMAPS, VMAPS', T => T' /\ Cond, M)
    = applyMapsToTerm2(VMAPS, VMAPS', T, M) 
        => applyMapsToTerm2(VMAPS, VMAPS', T', M)
      /\ applyMapsToCond(VMAPS, VMAPS', Cond, M) .
  eq applyMapsToCond(VMAPS, VMAPS', nil, M) = nil .

  eq applyMapsToLabel((label L to L'), L'')
    = if L == L'' 
      then L'
      else L''
      fi .
  eq applyMapsToLabel(((label L to L'), VMAPS), L'')
    = if L == L'' 
      then L'
      else applyMapsToLabel(VMAPS, L'')
      fi .
  eq applyMapsToLabel(VMAP, L) = L [owise] .
  eq applyMapsToLabel((VMAP, VMAPS), L)
    = applyMapsToLabel(VMAPS, L)
    [owise] .
  eq applyMapsToLabel(none, L) = L .

  eq applyMapsToClassDeclSet(VMAPS, VMAPS', ((class C | ADS .) CDS))
    = ((class applyMapsToClassName(VMAPS', C) | 
          applyMapsToAttrDeclSet(VMAPS, VMAPS', C, ADS) .)
       applyMapsToClassDeclSet(VMAPS, VMAPS', CDS)) .
  eq applyMapsToClassDeclSet(VMAPS, VMAPS', none) = none .

  eq applyMapsToAttrDeclSet(VMAPS, VMAPS', C, ((attr A : Ty), ADS))
    = ((attr applyMapsToAttrName(VMAPS', C, A) : applyMapsToType(VMAPS, Ty)),
       applyMapsToAttrDeclSet(VMAPS, VMAPS', C, ADS)) .
  eq applyMapsToAttrDeclSet(VMAPS, VMAPS', C, none) = none .

  eq applyMapsToAttrName((attr A . C to A'), C', A'')
    = if (C == C') and (A == A'')
      then A'
      else A''
      fi .
  eq applyMapsToAttrName(((attr A . C to A'), VMAPS), C', A'')
    = if (C == C') and (A == A'')
      then A'
      else applyMapsToAttrName(VMAPS, C', A'')
      fi .
  eq applyMapsToAttrName(VMAP, C, A) = A [owise] .
  eq applyMapsToAttrName((VMAP, VMAPS), C, A)
    = applyMapsToAttrName(VMAPS, C, A)
    [owise] .
  eq applyMapsToAttrName(none, C, A) = A .

  eq applyMapsToSubclassDeclSet(VMAPS, ((subclass C < C' .) SCDS))
    = ((subclass applyMapsToClassName(VMAPS, C) 
           < applyMapsToClassName(VMAPS, C') .)
       applyMapsToSubclassDeclSet(VMAPS, SCDS)) .
  eq applyMapsToSubclassDeclSet(VMAPS, none) = none .

endfm

*******************************************************************************

***
*** 6.9 Instantiation of Parameterized Modules and the 
***     \texttt{META-LEVEL} Module Expression

*** A parameterized module 
*** $\texttt{M[L}_1\texttt{\ ::\ T}_1\texttt{,\}\ldots\texttt{, L}_n
*** \texttt{ :: T}_n\texttt{]}$, with \mbox{$\texttt{L}_1\ldots\texttt{L}_n$}
*** labels and \mbox{$\texttt{T}_1\ldots\texttt{T}_n$} theory identifiers, is
*** represented as a module with name \texttt{M} which contains parameter
*** declarations  \mbox{$\texttt{par\ L}_i\texttt{\ ::\ T}_i$} for 
*** $1\leq i\leq n$, and an importation declaration
*** \mbox{$\texttt{inc\ par\ L}_i\texttt{\ ::\ T}_i\texttt{\ .}$} for each
*** parameter \mbox{$\texttt{L}_i\texttt{\ ::\ T}_i$} in its interface.  Note
*** that all modules are handled in a uniform way: nonparameterized modules 
*** and theories have their list of parameters set to \texttt{nil}.

*** The instantiation of the formal parameters of a parameterized module with
*** actual modules or theories requires a view from each formal parameter
*** theory to its corresponding actual unit. The process of instantiation
*** results in the replacement of each interface theory by its corresponding 
*** actual parameter, using the views to bind actual names to formal names.

*** The naming conventions for sorts have to be taken into account in the
*** instantiation process: every occurrence of a sort coming from a theory in
*** the interface of a module must be qualified by its theory's label, and
*** sorts defined in the body of a parameterized module can be parameterized
*** by the labels in the interface of the module (see 
*** Section~\ref{parameterized-modules}).

*** The labeling convention for theories and for the sorts coming from them is
*** very useful to avoid collisions of sort names coming from the parameter
*** theories, and also to allow different uses of the same theory several
*** times in the interface of a module. We assume that all sorts coming from
*** the theory part of the parameter theories are used in their qualified form
*** to manipulate the maps defined in the views before being applied to the
*** body of the module being instantiated. If the target of a view is a 
*** theory, the sorts from the theory part of the target theory appearing in 
*** the targTS of the maps in the view will be qualified as well, following 
*** the same convention.

*** When a parameterized module
*** $\texttt{M[L}_1\texttt{\ ::\ T}_1\texttt{,\ }
***            \ldots\texttt{,\ L}_n\texttt{\ ::\ T}_n\texttt{]}$
*** is instantiated with views $\texttt{V}_1\ldots\texttt{V}_n$, each
*** parameterized sort $\texttt{S[L}_1\texttt{,}\ldots\texttt{,L}_n\texttt{]}$
*** in the body of the parameterized module is renamed to
*** $\texttt{S[V}_1\texttt{,}\ldots\texttt{,V}_n\texttt{]}$.

*** The discussion on the qualification of sorts in views before being used in
*** the instantiation process applies in a completely similar way to class
*** names in parameterized object-oriented modules.

*** As we saw in Section~\ref{module-expressions}, it is possible to import a
*** module expression in which a parameterized module is instantiated by some
*** of the formal parameters of the parameterized module in which it is
*** imported. This is done by using the label of some of the parameters in the
*** interface of a module, say \mbox{$\texttt{L}_k\texttt{\ ::\ T}_k$}, in a
*** module expression in which some parameterized module \texttt{N} with formal
*** parameter $\texttt{T}_k$ is instantiated with $\texttt{L}_k$, that is, we
*** have the module expression $\texttt{N[}\ldots\texttt{L}_k\ldots\texttt{]}$.
*** In this case, $\texttt{L}_k$ is considered as the identity view for the
*** theory $\texttt{T}_k$ with $\texttt{L}_k$ as name. Note that to be able to
*** check whether a label in the interface of a module is used in an
*** instantiation of this form, in the evaluation of a module expression the
*** list of parameters of the module in which the module expression appears
*** must be available. This is the reason why the \texttt{evalModExp} function 
*** was defined with \texttt{ParameterList} as one of the sorts in its 
*** arity (see Section~\ref{evalModExp}). For module expressions appearing 
*** outside of any module, that is, in commands, etc., this list will be set 
*** to \texttt{nil}.

*** Note that this kind of instantiation may produce a `cascade' effect. The
*** module being instantiated may itself import other module expressions in
*** which labels of some of its parameter theories are used in the
*** instantiation of some of these imported module expressions. This is handled
*** by `preparing' the module expressions appearing in the importation
*** declarations of the module (\texttt{prepImports}). This process
*** consists in changing the labels of the interface of the module being
*** instantiated which are used in the importations of module expressions by
*** the corresponding view names (\texttt{prepHeader}). After completing the
*** generation of the module resulting from the evaluation of the module
*** expression, this module will be evaluated with the \texttt{evalModule} 
*** function, producing the evaluation of these new module expressions. In any 
*** extension of the language, new equations for the function 
*** \texttt{prepHeader} will have to be added for each new kind of module 
*** expression being defined.

*** In Sections~\ref{renaming} and~\ref{extension} we shall see how new
*** equations completing the semantics of \texttt{prepHeader} are added for
*** each new module expression being defined. In the case of the renaming
*** module expression, the renaming maps will have to be prepared as well, to 
*** adjust the sort names being renamed to the conventions discussed above.

*** As for any other module expression being defined, in addition to the
*** operator declaration for the constructor of the instantiation module
*** expression, equations completing the semantics of operators
*** \texttt{evalModExp}, \texttt{header2QidList}, and 
*** \texttt{setUpModExpDeps} have to be given.

fmod INST-EXPR-EVALUATION is
  pr EVALUATION .
  pr VIEW-MAP-SET-APPL-ON-UNIT .
  inc MOD-EXPR .
  inc MOD-NAME .
  pr DATABASE .

*** We start by giving the new constructor for sort \texttt{ModuleExpression}. 
*** Note thatthe modules \texttt{MOD-EXPR} and \texttt{MOD-NAME} have been 
*** imported in \texttt{including} mode.

  vars QI QI' QI'' X Y W Z C F F' A A' L L' : Qid .
  var  QIL : QidList .
  vars M M' PU U U' U'' DM : Module .
  var  Th : OTheory .
  vars ME ME' ME'' : ModuleExpression .
  var  H : Header .
  vars MN MN' : ModuleName .
  vars MNS MNS' MNS'' MNS3 MNS4 MNS5 : Set{ModuleName} .
  vars VE VE' VE'' VE3 VE4 : ViewExp .
  vars VES VES' : Set{ViewExp} .
  vars MIS MIS' : Set{ModuleInfo} .
  var  VIS : Set{ViewInfo} .
  vars DB DB' DB'' : Database . 
  var  PD : ParameterDecl .
  vars PDL PDL' PDL'' PDL3 PDL4 PDL5 : ParameterDeclList .
  var  PDS : Set{ParameterDecl} .
  vars PL PL' PL'' PL3 : ParameterList .
  vars S S' P P' P'' : Sort .
  vars IL IL' IL'' IL3 : ImportList .
  vars VMAPS VMAPS' VMAPS'' VMAPS3 : Set{ViewMap} .
  var  V : Variable .
  var  Ct : Constant .
  var  SL : QidList .
  var  Ty : Type .
  var  TyL : TypeList .
  vars SS SS' SS'' : SortSet .
  var  K : Kind .
  vars T T' O : Term .
  var  DT : Default{Term} .
  var  TL : TermList .
  var  CDS : ClassDeclSet .
  var  ADS : AttrDeclSet .
  var  B : Bool .
  var  AtS : AttrSet .
  var  VMAP : ViewMap .
  var  N : Nat .
  var  PV : PreView .
  var  VI : View .
  var  VDS : OpDeclSet .

*** In the input given by the user, the operator \verb~_(_)~ is used both for
*** the instantiation of module expressions, and for expressions
*** parameterizing the module \texttt{META-LEVEL} with a list of module names.
*** The function \texttt{evalModExp} distinguishes these two cases, calling
*** the function \texttt{unitInst} in the former and the function 
*** \texttt{prepMetalevel} in the latter.

  op unitInst : Header ParameterList ParameterDeclList Database -> Database .
  op prepMetalevel : ParameterList Database -> Database .

  eq evalModExp(ME{PL}, PDL, DB) 
    = if unitInDb(ME{PL}, DB) 
      then < DB ; ME{PL} >
      else if ME == 'META-LEVEL
           then < prepMetalevel(PL, DB) ; ME{PL} >
           else < unitInst(
                    modExp(evalModExp(ME, PDL, evalViewExp(PL, PDL, DB))), 
                    PL, PDL, 
                    database(evalModExp(ME, PDL, evalViewExp(PL, PDL, DB)))) 
                  ; 
                  modExp(evalModExp(ME, PDL, evalViewExp(PL, PDL, DB))){PL} >
           fi
      fi .

*** The function \texttt{prepMetalevel} creates a new module with the
*** module expression being evaluated as name, which imports the predefined
*** \texttt{META-LEVEL} module. For each module name \texttt{I} in the list
*** given as parameter of the expression, the declaration of a constant
*** \texttt{I} of sort \texttt{Module} and an equation identifying such
*** constant with the metarepresentation of the module with such name in the 
*** database are added to the module being created.

  op prepMetalevelAux : ParameterList Module Database -> Database .

  eq prepMetalevel(PL, DB)
    = prepMetalevelAux(PL, 
        addImports((including 'META-LEVEL .),
          setName(emptyFModule, 'META-LEVEL{PL})), DB) .

  eq prepMetalevelAux((QI), U, DB)
    = prepMetalevelAux(nil,
        addOps((op qid("META-" + string(QI)) : nil -> 'Module [none] .), 
          addEqs((eq qid("META-" + string(QI) + ".Module") 
                    = up(getFlatModule(QI, database(evalModExp(QI, DB)))) 
                    [none] .), 
            U)),
        DB) .
  eq prepMetalevelAux((QI, PL), U, DB)
    = prepMetalevelAux(PL,
        addOps((op qid("META-" + string(QI)) : nil -> 'Module [none] .), 
          addEqs((eq qid("META-" + string(QI) + ".Module") 
                    = up(getFlatModule(QI, database(evalModExp(QI, DB)))) 
                    [none] .), 
            U)),
        DB) .
  eq prepMetalevelAux(nil, U, DB) = evalModule(U, none, DB) .

*** The function \texttt{getClassNames} returns the set of the names of
*** the classes in a set of class declarations.

  op getClassNames : ClassDeclSet -> SortSet .

  eq getClassNames(((class S | ADS .) CDS)) 
    = (S ; getClassNames(CDS)) .
  eq getClassNames(none) = none .

*** The following `getTh' functions return the corresponding elements in the
*** theory part of the structure of the given unit. For example, the function
*** \texttt{getThSorts} returns the set of sorts declared in the ``loose
*** part'' of the structure of the unit in the database having the name 
*** indicated as first argument.

  op getThSorts : ModuleExpression Database -> SortSet .
  op getThClasses : ModuleExpression Database -> SortSet .
  op getThSortsAux : ImportList Database -> SortSet .
  op getThClassesAux : ImportList Database -> SortSet .

  eq getThSorts(ME, DB)
    = if theory(getTopModule(ME, DB))
      then (getThSortsAux(getImports(getTopModule(ME, DB)), DB) ; 
            getSorts(getTopModule(ME, DB)))
      else none
      fi .

  eq getThSortsAux(((including MN .) IL), DB)
    = (getThSorts(MN, DB) ; getThSortsAux(IL, DB)) .
  eq getThSortsAux(((extending MN .) IL), DB)
    = (getThSorts(MN, DB) ; getThSortsAux(IL, DB)) .
  eq getThSortsAux(((protecting MN .) IL), DB)
    = (getThSorts(MN, DB) ; getThSortsAux(IL, DB)) .
  eq getThSortsAux(nil, DB) = none .

  eq getThClasses(ME, DB)
    = if getTopModule(ME, DB) :: OTheory
         and-then not getTopModule(ME, DB) :: STheory
      then (getThClassesAux(getImports(getTopModule(ME, DB)), DB) ;
            getClassNames(getClasses(getTopModule(ME, DB))))
      else none
      fi .

  eq getThClassesAux(((including MN .) IL), DB)
    = (getThClasses(MN, DB) ; getThClassesAux(IL, DB)) .
  eq getThClassesAux(((extending MN .) IL), DB)
    = (getThClasses(MN, DB) ; getThClassesAux(IL, DB)) .
  eq getThClassesAux(((protecting MN .) IL), DB)
    = (getThClasses(MN, DB) ; getThClassesAux(IL, DB)) .
  eq getThClassesAux(nil, DB) = none .

*** The `get' functions return the corresponding elements in the structure of
*** the given unit. For example, \texttt{getSortSet} returns all the sorts
*** declared in the structure of the unit in the database having the name 
*** given as first argument.

  op getSortSet : ModuleName Database -> SortSet .
  op getClassSet : ModuleName Database -> SortSet .

  op getSortSetAux : ImportList Database -> SortSet .
  op getClassSetAux : ImportList Database -> SortSet .

  eq getSortSet(MN, DB)
    = (getSortSetAux(getImports(getTopModule(MN, DB)), DB) ; 
       getSorts(getTopModule(MN, DB))) .

  eq getSortSetAux(((including MN .) IL), DB) 
    = (getSortSet(MN, DB) ; getSortSetAux(IL, DB)) .
  eq getSortSetAux(((extending MN .) IL), DB) 
    = (getSortSet(MN, DB) ; getSortSetAux(IL, DB)) .
  eq getSortSetAux(((protecting MN .) IL), DB) 
    = (getSortSet(MN, DB) ; getSortSetAux(IL, DB)) .
  eq getSortSetAux(nil, DB) = none .

  eq getClassSet(MN, DB)
    = (getClassSetAux(getImports(getTopModule(MN, DB)), DB) ;
       getClassNames(getClasses(getTopModule(MN, DB)))) .

  eq getClassSetAux(((including MN .) IL), DB) 
    = (getClassSet(MN, DB) ; getClassSetAux(IL, DB)) .
  eq getClassSetAux(((extending MN .) IL), DB) 
    = (getClassSet(MN, DB) ; getClassSetAux(IL, DB)) .
  eq getClassSetAux(((protecting MN .) IL), DB) 
    = (getClassSet(MN, DB) ; getClassSetAux(IL, DB)) .
  eq getClassSetAux(nil, DB) = none .

*** As pointed out in Section~\ref{parameterized-modules}, in a parameterized
*** module all occurrences of sorts or classes coming from the parameter
*** theories have to be qualified. \texttt{createCopy} is the function used
*** for creating these renamed copies of the parameters. As also explained in
*** Section~\ref{parameterized-modules}, if a parameter theory is structured, 
*** the renaming is carried out not only at the top level, but for the entire 
*** ``theory part'' in the structure.

*** The function \texttt{createCopy} calls an auxiliary function,
*** \texttt{prepPar}, which recursively proceeds through all the subtheories
*** of the given theory. For each theory in the structure, the required set of
*** maps is generated and applied to such a theory using the
*** \texttt{applyMapsToModule} function discussed in
*** Section~\ref{applyMapsToModule}, which is then evaluated and entered into
*** the database. Note that the renamings to which a theory is subjected must 
*** also be applied to the theories importing it. The new database and the 
*** renaming maps applied to the theory will have to be returned by the 
*** function.

*** The function \texttt{prepPar} makes a copy of the theory specified by the
*** name given as first argument and of all its subtheories (only theories, no
*** modules), and qualifies all the sorts appearing in it with the label given
*** in the declaration of the parameter, which is given as second argument.

  sorts Tuple<ViewExp|ViewExp> 
        Set<Tuple<ViewExp|ViewExp>> 
        prepParResult  .
  subsort Tuple<ViewExp|ViewExp> < Set<Tuple<ViewExp|ViewExp>> .
  op <_;_> : ViewExp ViewExp -> Tuple<ViewExp|ViewExp> .
  ops 1st 2nd : Tuple<ViewExp|ViewExp> -> ViewExp .
  op none : -> Set<Tuple<ViewExp|ViewExp>> .
  op __ : Set<Tuple<ViewExp|ViewExp>> Set<Tuple<ViewExp|ViewExp>> 
      -> Set<Tuple<ViewExp|ViewExp>> [assoc comm id: none] .

  vars VEPS VEPS' : Set<Tuple<ViewExp|ViewExp>> .
  
  eq 1st(< VE ; VE' >) = VE .
  eq 2nd(< VE ; VE' >) = VE' .
  
  op prepPar : Qid Qid ModuleExpression Database -> prepParResult .
  op prepParImports : ImportList ImportList Qid Qid RenamingSet 
        Set<Tuple<ViewExp|ViewExp>> ParameterDeclList Database 
        -> prepParResult .

  op <_;_;_;_;_;_;_> : RenamingSet Database ViewExp ViewExp 
        Set<Tuple<ViewExp|ViewExp>> Bool ImportList 
        -> prepParResult .
  op mapSet : prepParResult -> RenamingSet .
  op database : prepParResult -> Database .
  op sourceViewExp : prepParResult -> ViewExp .
  op targetViewExp : prepParResult -> ViewExp .
  op viewExpPairSet : prepParResult -> Set<Tuple<ViewExp|ViewExp>> .
  op theoryFlag : prepParResult -> Bool .
  op getImports : prepParResult -> ImportList .
  eq mapSet(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = VMAPS .
  eq database(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = DB .
  eq sourceViewExp(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = VE .
  eq targetViewExp(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = VE' .
  eq viewExpPairSet(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = VEPS .
  eq theoryFlag(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = B .
  eq getImports(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = IL .

  ----op createCopy : ParameterDecl Database -> Database .
  op prepPar : Qid ModuleExpression Database  -> prepParResult .
  op prepParImports : ImportList ImportList Qid RenamingSet 
        Set<Tuple<ViewExp|ViewExp>> ParameterDeclList Database 
        -> prepParResult .

  eq createCopy(X :: ME, DB)
    = if unitInDb(pd(X :: ME), DB)
      then DB
      else database(prepPar(X, ME, database(evalModExp(ME, DB))))
      fi .

  ceq prepPar(X, ME, DB)
    = < (VMAPS'', VMAPS3) ;
        (if unitInDb(pd(X :: ME), DB)
         then DB
         else evalModule(
                setImports(
                  setName(
                    applyMapsToModule(
                      (VMAPS'', VMAPS3),
                      Th,
                      getFlatModule(ME, DB)),
                    pd(X :: ME)),
                  IL),
                applyMapsToOps(
                  VMAPS'', 
                  VMAPS3,
                  getVars(ME, DB),
                  getFlatModule(ME, DB)),
                DB')
         fi) ;
        mtViewExp ; mtViewExp ; none ; true ; nil >
    if Th := getTopModule(ME, DB)
       /\ < VMAPS ; DB' ; VE ; VE' ; VEPS ; B ; IL > 
          := prepParImports(getImports(Th), nil, X, none, none, X :: ME, DB) 
       /\ < VMAPS'' ; VMAPS3 > 
          := splitMaps(
               (VMAPS,
                sortMapsPar(X, getSorts(Th), none),
                classMapsPar(X, classSet(getClasses(Th)), none))) .
  eq prepPar(X, ME, DB)
    = < none ; warning(DB, '\r 'Error3: '\o 'Incorrect 'parameter '\n) ; 
        mtViewExp ; mtViewExp ; none ; false ; nil > 
      [owise] .

  ceq prepParImports(((including ME .) IL), IL', X, VMAPS, VEPS, PDL, DB)
   = if B
     then prepParImports(IL, (IL' (including pd(X :: ME') .)), 
            X, (VMAPS, VMAPS'), VEPS, PDL, DB')
     else prepParImports(IL, (IL' (including ME .)), X, VMAPS, VEPS, PDL, DB)
     fi 
   if ME' := prepModExp(ME, VEPS)
      /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > 
           := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) .
  ceq prepParImports(((extending ME .) IL), IL', X, VMAPS, VEPS, PDL, DB)
   = if B
     then *** A theory shouldn't be imported in protecting mode
          prepParImports(IL, (IL' (extending pd(X :: ME') .)), 
            X, (VMAPS, VMAPS'), VEPS, PDL, DB')
     else prepParImports(IL, (IL' (extending ME .)), X, VMAPS, VEPS, PDL, DB)
     fi 
   if ME' := prepModExp(ME, VEPS)
      /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > 
            := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) .
  ceq prepParImports(((protecting ME .) IL), IL', X, VMAPS, VEPS, PDL, DB)
   = if B
     then *** A theory shouldn't be imported in protecting mode
          prepParImports(IL, (IL' (protecting pd(X :: ME') .)), 
            X, (VMAPS, VMAPS'), VEPS, PDL, DB')
     else prepParImports(IL, (IL' (protecting ME .)), X, VMAPS, VEPS, PDL, DB)
     fi 
   if ME' := prepModExp(ME, VEPS)
      /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > 
            := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) .
  ceq prepParImports(((including pd(X :: ME) .) IL), IL', 
       Y, VMAPS, (< X ; Z > VEPS), PDL, DB)
    = prepParImports(IL, (IL' (including pd(Z :: ME') .)), 
        Y, (VMAPS, VMAPS'), (< X ; Z > VEPS), PDL, DB') 
   if ME' := prepModExp(ME, VEPS)
      /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > 
            := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) .
  ceq prepParImports(((extending pd(X :: ME) .) IL), IL', 
       Y, VMAPS, (< X ; Z > VEPS), PDL, DB)
    = prepParImports(IL, (IL' (extending pd(Z :: ME') .)), 
        Y, (VMAPS, VMAPS'), (< X ; Z > VEPS), PDL, DB') 
   if ME' := prepModExp(ME, VEPS)
      /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > 
            := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) .
  ceq prepParImports(((protecting pd(X :: ME) .) IL), IL', 
       Y, VMAPS, (< X ; Z > VEPS), PDL, DB)
    = prepParImports(IL, (IL' (protecting pd(Z :: ME') .)), 
        Y, (VMAPS, VMAPS'), (< X ; Z > VEPS), PDL, DB') 
   if ME' := prepModExp(ME, VEPS)
      /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > 
            := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) .
  eq prepParImports(nil, IL, X, VMAPS, VEPS, PDL, DB)
    = < VMAPS ; DB ; mtViewExp ; mtViewExp ; none ; false ; IL > .

  ceq prepPar(X, Y, ME, DB)
    = < (VMAPS'', VMAPS3) ;
        (if unitInDb(pd(Y :: ME), DB)
         then DB
         else evalModule(
                setImports(
                  setName(
                    applyMapsToModule(
                      (VMAPS'', VMAPS3),
                      getTopModule(pd(X :: ME), DB),
                      getFlatModule(pd(X :: ME), DB)),
                    pd(Y :: ME)),
                  IL),
                applyMapsToOps(
                  VMAPS'', 
                  VMAPS3,
                  getVars(pd(X :: ME), DB),
                  getFlatModule(pd(X :: ME), DB)),
                DB')
          fi) ;
        X ; Y ; < X ; Y > ; true ; nil > 
    if Th := getTopModule(ME, DB)
       /\ < VMAPS ; DB' ; VE ; VE' ; VEPS ; B ; IL > 
            := prepParImports(getImports(Th), 
                 nil, X, Y, none, < X ; Y >, X :: ME, DB) 
       /\ < VMAPS'' ; VMAPS3 > 
            := splitMaps(
                 (VMAPS,
                  genMapsQualSorts(X, Y, getSorts(Th), none),
                  genMapsQualClasses(X, Y, classSet(getClasses(Th)), none))) .


  eq prepParImports(((including ME .) IL), IL', X, Y, VMAPS, VEPS, PDL, DB)
    = prepParImports(IL, (IL' including ME .), X, Y, VMAPS, VEPS, PDL, DB) .
  eq prepParImports(((extending ME .) IL), IL', X, Y, VMAPS, VEPS, PDL, DB)
    = prepParImports(IL, (IL' extending ME .), X, Y, VMAPS, VEPS, PDL, DB) .
  eq prepParImports(((protecting ME .) IL), IL', X, Y, VMAPS, VEPS, PDL, DB)
    = prepParImports(IL, (IL' protecting ME .), X, Y, VMAPS, VEPS, PDL, DB) .
  ceq prepParImports(including pd(X :: ME) . IL, IL', 
        Y, Z, VMAPS, VEPS, PDL, DB)
    = prepParImports(IL, IL' including pd(X :: ME') ., 
        Y, Z, (VMAPS, VMAPS'), VEPS, PDL, DB') 
    if ME' := prepModExp(ME, VEPS)
       /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > 
             := prepPar(Y, Z, ME', database(evalModExp(ME', PDL, DB))) .
  ceq prepParImports(extending pd(X :: ME) . IL, IL', 
        Y, Z, VMAPS, VEPS, PDL, DB)
    = prepParImports(IL, IL' extending pd(X :: ME') ., 
        Y, Z, (VMAPS, VMAPS'), VEPS, PDL, DB') 
    if ME' := prepModExp(ME, VEPS)
       /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > 
             := prepPar(Y, Z, ME', database(evalModExp(ME', PDL, DB))) .
  ceq prepParImports(protecting pd(X :: ME) . IL, IL', 
        Y, Z, VMAPS, VEPS, PDL, DB)
    = prepParImports(IL, IL' protecting pd(X :: ME') ., 
        Y, Z, (VMAPS, VMAPS'), VEPS, PDL, DB') 
    if ME' := prepModExp(ME, VEPS)
       /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > 
             := prepPar(Y, Z, ME', database(evalModExp(ME', PDL, DB))) .
  eq prepParImports(nil, IL, X, Y, VMAPS, VEPS, PDL, DB)
    = < VMAPS ; DB ; mtViewExp ; mtViewExp ; none ; false ; IL > .

  op sortMapsPar : Qid SortSet Set<Tuple<ViewExp|ViewExp>> -> RenamingSet .
  op classMapsPar : Qid SortSet Set<Tuple<ViewExp|ViewExp>> -> RenamingSet .

  op qualify : Qid Sort -> Sort .
  op qualify : Qid Sort Set<Tuple<ViewExp|ViewExp>> -> Sort .
  op qualify : Qid Sort ParameterList ParameterList 
       Set<Tuple<ViewExp|ViewExp>> -> Sort .

  eq qualify(X, S) = qualify(X, getName(S), getPars(S), empty, none) .

  eq qualify(X, S, VEPS) = qualify(X, getName(S), getPars(S), empty, VEPS) .

  eq qualify(X, S, (P, PL), PL', < P ; P' > VEPS) 
    = qualify(X, S, PL, PL' P', < P ; P' > VEPS) .
  eq qualify(X, S, (P, PL), PL', VEPS) 
    = qualify(X, S, PL, PL' P, VEPS) 
    [owise] .
  eq qualify(X, S, empty, PL, VEPS) 
    = qid(string(X) + "$" + string(makeSort(S, PL))) .

  eq sortMapsPar(X, (S ; SS), VEPS)
    = ((sort S to qualify(X, S, VEPS)), sortMapsPar(X, SS, VEPS)) .
  eq sortMapsPar(X, none, VEPS) = none .

  eq classMapsPar(X, (S ; SS), VEPS)
    = ((class S to qualify(X, S, VEPS)), classMapsPar(X, SS, VEPS)) .
  eq classMapsPar(X, none, VEPS) = none .

*** When one of the labels of the interface of a module is being used in a
*** module expression to instantiate some formal parameter of a module, then,
*** in the evaluation of such module expression the qualification of all sorts
*** and class names coming from the theory part of the parameter theory have
*** to be changed according to such a label. In the evaluation of an
*** instantiation module expression this is done by generating the
*** corresponding renaming maps, which are then applied to the module being
*** instantiated. Given labels \texttt{L} and \texttt{L'}, for each sort or 
*** class name \texttt{S} in the set given as argument, a map of the form 
*** \verb~L$S to L'$S~ is generated.

  op genMapsQualSorts : 
       Qid Qid SortSet Set<Tuple<ViewExp|ViewExp>> -> RenamingSet .
  op genMapsQualClasses : 
       Qid Qid SortSet Set<Tuple<ViewExp|ViewExp>> -> RenamingSet .

  eq genMapsQualSorts(X, Y, (S ; SS), VEPS)
    = ((sort qualify(X, S, VEPS) to qualify(Y, S, VEPS)),
       genMapsQualSorts(X, Y, SS, VEPS)) .
  eq genMapsQualSorts(X, Y, none, VEPS) = none .

  eq genMapsQualClasses(X, Y, (S ; SS), VEPS)
    = ((class qualify(X, S, VEPS) to qualify(Y, S, VEPS)),
       genMapsQualClasses(X, Y, SS, VEPS)) .
  eq genMapsQualClasses(X, Y, none, VEPS) = none .

*** The function \texttt{prepare} takes the map set of a view and
*** prepares it to be used in an instantiation by transforming sort and class
*** names into their qualified form, if required (sorts and class names in a 
*** view have to be qualified only if they were defined in a theory).

*** The \texttt{prepare} function takes five arguments: The set of maps
*** to be prepared, the label with which the sorts to be renamed have to be
*** qualified, the set of sorts in the theory part of the source of the view,
*** and the set of sorts and class names in the theory part of the target of 
*** the view.

*** Note that we assume that there is a sort map and a class map for each sort
*** and class in the theory part of the source of the view. Therefore, sorts
*** and class names appearing as sources of sort and class maps are
*** systematically qualified. The sorts or class names used in the targTS of
*** the maps will be qualified only if they were declared in a theory. In maps
*** for operators in which the arity and coarity are specified, or for those
*** going to derived terms, the sorts appearing in the arity or coarity of an
*** operator and those used to qualify terms, or in sort tests in terms, must
*** also be qualified. However, in these cases the qualification cannot be
*** done on all sorts, but only on those defined in the theory parts. This is 
*** the reason why the sTS of sorts in the theory parts of the source and 
*** target and the set of class names in the target of the view are given when 
*** calling \texttt{prepare}.

  op prepare : Set{ViewMap} Qid SortSet SortSet SortSet -> RenamingSet .

  op prepare : TypeList Qid SortSet -> TypeList .
  op prepTerm : TermList Qid SortSet -> TermList .

  eq prepare((sort S to S'), X, SS, SS', SS'')
    = if S' in SS'
      then (sort qualify(X, S) to qualify(X, S'))
      else (sort qualify(X, S) to S')
      fi .
  eq prepare(((sort S to S'), VMAPS), X, SS, SS', SS'')
    = ((if S' in SS'
        then (sort qualify(X, S) to qualify(X, S'))
        else (sort qualify(X, S) to S')
        fi),
       prepare(VMAPS, X, SS, SS', SS'')) .
  eq prepare((op F : TyL -> Ty to F' [AtS]), X, SS, SS', SS'')
    = (op F : prepare(TyL, X, SS) -> prepare(Ty, X, SS) to F' [AtS]) .
  eq prepare(((op F : TyL -> Ty to F' [AtS]), VMAPS), 
       X, SS, SS', SS'')
    = ((op F : prepare(TyL, X, SS) -> prepare(Ty, X, SS) to F' 
           [AtS]), 
       prepare(VMAPS, X, SS, SS', SS'')) .
  eq prepare((op F to F' [AtS]), X, SS, SS', SS'') = (op F to F' [AtS]) .
  eq prepare(((op F to F' [AtS]), VMAPS), X, SS, SS', SS'')
    = ((op F to F' [AtS]), prepare(VMAPS, X, SS, SS', SS'')) .
  eq prepare(termMap(T, T'), X, SS, SS', SS'')
    = termMap(prepTerm(T, X, SS), prepTerm(T', X, SS')) .
  eq prepare((termMap(T, T'), VMAPS), X, SS, SS', SS'')
    = (termMap(prepTerm(T, X, SS), prepTerm(T', X, SS')), 
       prepare(VMAPS, X, SS, SS', SS'')) .
  eq prepare((msg F : TyL -> Ty to F'), X, SS, SS', SS'')
    = (msg F : prepare(TyL, X, SS) -> prepare(Ty, X, SS) to F') .
  eq prepare(((msg F : TyL -> Ty to F'), VMAPS), X, SS, SS', SS'')
    = ((msg F : prepare(TyL, X, SS) -> prepare(Ty, X, SS) to F'),
       prepare(VMAPS, X, SS, SS', SS'')) .
  eq prepare((msg F to F'), X, SS, SS', SS'') = (msg F to F') .
  eq prepare(((msg F to F'), VMAPS), X, SS, SS', SS'')
    = ((msg F to F'), prepare(VMAPS, X, SS, SS', SS'')) .
  eq prepare((class S to S'), X, SS, SS', SS'')
    = if S' in SS''
      then (class qualify(X, S) to qualify(X, S'))
      else (class qualify(X, S) to S')
      fi .
  eq prepare(((class S to S'), VMAPS), X, SS, SS', SS'')
    = ((if S' in SS''
        then (class qualify(X, S) to qualify(X, S'))
        else (class qualify(X, S) to S')
        fi),
       prepare(VMAPS, X, SS, SS', SS'')) .
  eq prepare((attr A . S to A'), X, SS, SS', SS'')
    = (attr A . qualify(X, S) to A') .
  eq prepare(((attr A . S to A'), VMAPS), X, SS, SS', SS'')
    = ((attr A . qualify(X, S) to A'), 
       prepare(VMAPS, X, SS, SS', SS'')) .
  eq prepare((label L to L'), X, SS, SS', SS'') = (label L to L') .
  eq prepare(none, X, SS, SS', SS'') = none .

  eq prepare((S TyL), X, (S ; SS))
    = (qualify(X, S) prepare(TyL, X, (S ; SS))) .
  eq prepare((K TyL), X, SS)
    = prepare((getSort(K) TyL), X, SS) .
  eq prepare((S TyL), X, SS)
    = (S prepare(TyL, X, SS))
    [owise] .
  eq prepare(nil, X, SS) = nil .

  eq prepTerm(F[TL], X, SS) = F[prepTerm(TL, X, SS)] .
  eq prepTerm(V, X, SS)
    = if getType(V) in SS 
      then qid(string(getName(V)) + ":" + string(qualify(X, getType(V))))
      else qid(string(getName(V)) + ":" + string(getType(V)))
      fi .
  eq prepTerm(Ct, X, SS)
    = if getType(Ct) in SS 
      then qid(string(getName(Ct)) + "." + string(qualify(X, getType(Ct))))
      else qid(string(getName(Ct)) + "." + string(getType(Ct)))
      fi .
  ceq prepTerm((T, TL), X, SS) 
    = (prepTerm(T, X, SS), prepTerm(TL, X, SS)) 
    if TL =/= empty .
  eq prepTerm(qidError(QIL), X, SS) = qidError(QIL) .

*** For each parameterized sort
*** $\texttt{S[L}_1\texttt{,}\ldots\texttt{,L}_n\texttt{]}$ in the
*** body of a parameterized module with
*** $\texttt{L}_1\ldots\texttt{L}_n$ the labels of the parameters in
*** the interface of the module, a map of the form 9
*** $\texttt{sort\ S[L}_1\texttt{,}\ldots\texttt{,L}_n\texttt{]\
***      to\ S[V}_1\texttt{,}\ldots\texttt{,V}_n\texttt{]}$
*** is generated, where $\texttt{V}_i$ is the name of the view associated to
*** the label $\texttt{L}_i$ in the set of pairs given as argument.

  op genMapsSorts : SortSet Set<Tuple<ViewExp|ViewExp>> -> RenamingSet .
  op genMapsClasses : SortSet Set<Tuple<ViewExp|ViewExp>> -> RenamingSet .

  op prepSort : Sort Set<Tuple<ViewExp|ViewExp>> -> Sort .
  op prepSort : 
       Sort ParameterList ParameterList Set<Tuple<ViewExp|ViewExp>> -> Sort .

  eq genMapsSorts((S ; SS), VEPS) 
    = (if prepSort(S, VEPS) == S
       then none
       else (sort S to prepSort(S, VEPS))
       fi),
      genMapsSorts(SS, VEPS) .
  eq genMapsSorts(none, VEPS) = none .

  eq genMapsClasses((S ; SS), VEPS) 
    = (if prepSort(S, VEPS) == S
       then none
       else (class S to prepSort(S, VEPS))
       fi),
      genMapsClasses(SS, VEPS) .
  eq genMapsClasses(none, VEPS) = none .

  eq prepSort(S, VEPS) = prepSort(getName(S), empty, getPars(S), VEPS) .
  eq prepSort(Ty, VEPS) = Ty [owise] .

  eq prepSort(S, PL, P, < P ; VE > VEPS) 
    = prepSort(S, (PL, VE), empty, < P ; VE > VEPS) .
  eq prepSort(S, PL, (P, PL'), < P ; VE > VEPS) 
    = prepSort(S, (PL, VE), PL', < P ; VE > VEPS) .
  eq prepSort(S, PL, P, VEPS) 
    = prepSort(S, (PL, prepSort(P, VEPS)), empty, VEPS) 
    [owise] .
  eq prepSort(S, PL, (P, PL'), VEPS) 
    = prepSort(S, (PL, prepSort(P, VEPS)), PL', VEPS) 
    [owise] .
  eq prepSort(S, PL, empty, VEPS) 
    = if getPars(S) == empty
      then makeSort(S, PL)
      else makeSort(prepSort(S, VEPS), PL)
      fi .

*** The function \texttt{prepImports} takes a list of importation
*** declarations and a set of pairs composed of a label and a view name, and
*** returns the list of importations resulting from changing in each of the
*** module expressions the occurrences of the labels of the interface of the 
*** module being instantiated by the names of the views associated to them in 
*** the list of pairs.

  op prepImports : ImportList Set<Tuple<ViewExp|ViewExp>> -> ImportList .

  op prepModExp : 
       ModuleExpression Set<Tuple<ViewExp|ViewExp>> -> ModuleExpression .
  op prepModExp : ModuleExpression ViewExp ViewExp ViewExp 
       Set<Tuple<ViewExp|ViewExp>> -> ModuleExpression .
  op prepParameterDecl : 
       ParameterDecl Set<Tuple<ViewExp|ViewExp>> -> ParameterDecl .
  op prepViewExp : ViewExp Set<Tuple<ViewExp|ViewExp>> -> ViewExp .
  op prepViewExp : ParameterList Set<Tuple<ViewExp|ViewExp>> -> ParameterList .

  eq prepImports(((including ME .) IL), VEPS)
    = (including prepModExp(ME, VEPS) .)
      prepImports(IL, VEPS) .
  eq prepImports(((including pd(PD) .) IL), VEPS)
    = (including pd(prepParameterDecl(PD, VEPS)) .)
      prepImports(IL, VEPS) .
  eq prepImports(((extending ME .) IL), VEPS)
    = (extending prepModExp(ME, VEPS) .)
      prepImports(IL, VEPS) .
  eq prepImports(((extending pd(PD) .) IL), VEPS)
    = (extending pd(prepParameterDecl(PD, VEPS)) .)
      prepImports(IL, VEPS) .
  eq prepImports(((protecting ME .) IL), VEPS)
    = (protecting prepModExp(ME, VEPS) .)
      prepImports(IL, VEPS) .
  eq prepImports(((protecting pd(PD) .) IL), VEPS)
    = (protecting pd(prepParameterDecl(PD, VEPS)) .)
      prepImports(IL, VEPS) .
  eq prepImports(nil, VEPS) = nil .

  eq prepModExp(QI, VEPS) = QI .
  eq prepModExp(ME{PL}, VEPS) = prepModExp(ME, empty, empty, PL, VEPS) .
  eq prepModExp(ME + ME', VEPS) 
    = prepModExp(ME, VEPS) + prepModExp(ME', VEPS) .
  eq prepModExp(ME, VEPS) = ME [owise] .

  eq prepModExp(ME, PL, PL', (P, PL''), < P ; S > VEPS) 
    = prepModExp(ME, (PL, S), PL', PL'', < P ; S > VEPS) .
  eq prepModExp(ME, PL, PL', (P, PL''), < P ; S{PL3} > VEPS) 
    = prepModExp(ME, (PL, S{PL3}), PL', PL'', < P ; S{PL3} > VEPS) .
  ceq prepModExp(ME, PL, PL', (P, PL''), < P ; P' ;; VE > VEPS) 
    = prepModExp(ME, (PL, P'), (PL', VE), PL'', < P ; P' ;; VE > VEPS) 
    if VE =/= mtViewExp .
  eq prepModExp(ME, PL, PL', (P, PL''), VEPS) 
    = prepModExp(ME, (PL, P), PL', PL'', VEPS) 
    [owise] .
  eq prepModExp(ME, PL, PL', (QI{PL''}, PL3), VEPS) 
    = prepModExp(ME, (PL, prepViewExp(QI{PL''}, VEPS)), PL', PL3, VEPS) .
  eq prepModExp(ME, PL, empty, empty, VEPS) = ME{PL} .
  eq prepModExp(ME, PL, PL', empty, VEPS) = ME{PL}{PL'} [owise] .

  eq prepParameterDecl(X :: ME, < Y ; Z > VEPS) 
    = if X == Y 
      then (Z :: ME)
      else prepParameterDecl(X :: ME, VEPS) 
      fi .
  eq prepParameterDecl(X :: ME, none) = X :: ME .

  eq prepViewExp(VE, < VE ; VE' > VEPS) = VE' .
  eq prepViewExp(QI, VEPS) = QI [owise] .
  eq prepViewExp(X{PL}, VEPS) = X{prepViewExp(PL, VEPS)} [owise] .
  ceq prepViewExp((VE, PL), VEPS)
    = prepViewExp(VE, VEPS), prepViewExp(PL, VEPS) 
    if VE =/= nil /\ PL =/= nil [owise] .

*** The function \texttt{unitInst} calls the auxiliary function
*** \texttt{unitInstAux}, which proceeds recursively on each of the parameters
*** in the interface of the module being instantiated. For each view, a set of
*** maps to be applied to the module is generated, which are accumulated in 
*** the third argument of the function.

*** In the base case, when there are no more parameters and no more views, the
*** maps for the parameterized sorts are also generated, and all maps are 
*** then applied.

*** \texttt{unitInstAux} proceeds accumulating also the list of parameters
*** being modified, the list of importations, and a list of label-view
*** pairs (\texttt{QidTuple<ViewExp|ViewExp>}) associating each label in
*** the interface to the view used in the instantiation of the theory with
*** such label. This list of pairs is used to generate the set of maps of the
*** parameterized  sorts and to `prepare' the list of importations as 
***  indicated above.

  sort TreatParResult .

  op <_;_;_;_;_> : Set{ViewMap} ParameterDeclList  ImportList 
       Set<Tuple<ViewExp|ViewExp>>  Database  ->  TreatParResult .
  op mapSet : TreatParResult -> Set{ViewMap} .
  op getPars : TreatParResult -> ParameterDeclList .
  op getImports : TreatParResult -> ImportList .
  op viewExpPairSet : TreatParResult -> Set<Tuple<ViewExp|ViewExp>> .
  op db : TreatParResult -> Database .

  eq mapSet(< VMAPS ; PDL ; IL ; VEPS ; DB >) = VMAPS .
  eq getPars(< VMAPS ; PDL ; IL ; VEPS ; DB >) = PDL .
  eq getImports(< VMAPS ; PDL ; IL ; VEPS ; DB >) = IL .
  eq viewExpPairSet(< VMAPS ; PDL ; IL ; VEPS ; DB >) = VEPS .
  eq db(< VMAPS ; PDL ; IL ; VEPS ; DB >) = DB .

  op unitInstAux : Module Module OpDeclSet RenamingSet ParameterDeclList 
        ParameterDeclList  ImportList  ImportList  ParameterList
        Set<Tuple<ViewExp|ViewExp>>  ParameterDeclList  Database 
        ->  Database .
  op treatPar : ParameterDecl ViewExp  Set<Tuple<ViewExp|ViewExp>> 
        ParameterDeclList  Database  ->  TreatParResult .
  op treatPar2 : ParameterDecl ViewExp  Set<Tuple<ViewExp|ViewExp>> 
        ParameterDeclList  Database  ->  TreatParResult .
  op treatParAux : Qid ModuleExpression ParameterDeclList ViewExp Qid ViewExp 
        ViewExp  ParameterDeclList  RenamingSet  ParameterDeclList 
        ImportList  Set<Tuple<ViewExp|ViewExp>>  Database  
        -> TreatParResult .
  op treatParAux2 : Qid ModuleExpression ParameterDeclList ViewExp Qid ViewExp 
        ViewExp ParameterDeclList RenamingSet ParameterDeclList ImportList 
        Set<Tuple<ViewExp|ViewExp>> Database -> TreatParResult .

  eq unitInst(ME, PL, PDL, DB)
    = unitInstAux(setName(getTopModule(ME, DB), ME{PL}),
        signature(getFlatModule(ME, DB)), getVars(ME, DB), none,
        getPars(getTopModule(ME, DB)), nil,
        getImports(getTopModule(ME, DB)), nil, PL, none, PDL, DB) .

  ceq unitInstAux(U, M, VDS, VMAPS, 
       (X :: ME, PDL), PDL', IL, IL'', 
       (QI, PL), VEPS, PDL'', DB)
    = unitInstAux(U, M, VDS, (VMAPS, VMAPS'), PDL, (PDL', PDL3),
        IL, (IL'' IL3), PL, (VEPS VEPS'), PDL'', DB')
    if < VMAPS' ; PDL3 ; IL3 ; VEPS' ; DB' > 
         := treatPar(X :: ME, QI, VEPS, PDL'', DB) .
  ceq unitInstAux(U, M, VDS, VMAPS, 
       (X :: ME, PDL), PDL', IL, IL'', 
       (QI{PL}, PL'), VEPS, PDL'', DB)
    = unitInstAux(U, M, VDS, (VMAPS, VMAPS'), PDL, (PDL', PDL3),
        IL, (IL'' IL3), PL', (VEPS VEPS'), PDL'', DB')
    if < VMAPS' ; PDL3 ; IL3 ; VEPS' ; DB' >  
         := treatPar(X :: ME, QI{PL}, VEPS, PDL'', DB) .
  ceq unitInstAux(U, M, VDS, VMAPS, nil, PDL, IL, IL', empty, VEPS, PDL', DB)
    = evalModule(
        setImports(
          setPars(applyMapsToModule((VMAPS', VMAPS''), U, M), PDL),
          (prepImports(IL, VEPS) IL')), 
        applyMapsToOps(VMAPS', VMAPS'', VDS, M), 
        DB) 
    if < VMAPS' ; VMAPS'' > 
         := splitMaps(
             (VMAPS, 
              genMapsSorts(
                (getSorts(U) ; getSortSetAux(getImports(U), DB)), VEPS),
              genMapsClasses(
                (getClassNames(getClasses(U)) ; 
                 getClassSetAux(getImports(U), DB)), VEPS))) .
  eq unitInstAux(unitError(QIL), UK:[Module], SDV:[OpDeclSet], VMAPS, PDL, 
       PDL', IL, IL', PL, VEPS, PDL'', DB)
    = warning(DB, QIL) .
  eq unitInstAux(noModule, 
       unitError(QIL), VDS, VMAPS, PDL, PDL', IL, IL', VE, VEPS, PDL'', DB)
    = warning(DB, QIL) .
  eq unitInstAux(U, M, VDS, VMAPS, (X :: ME, PDL), 
       PDL', IL, IL', empty, VEPS, PDL'', DB)
    = warning(DB, 
        '\r 'Error: '\o 'Incorrect 'module header2QidList(getName(U)) '. '\n) .
  eq unitInstAux(U, M, VDS, VMAPS, nil, PDL, IL, IL', (QI, VE, PL), VEPS, PDL', DB)
    = warning(DB, 
        '\r 'Error: '\o 'Incorrect 'module header2QidList(getName(U)) '. '\n) .
  eq unitInstAux(U, M, VDS, VMAPS, PDL, PDL', IL, IL', PL, VEPS, PDL'', DB)
    = DB 
    [owise] .

  eq treatParView(X :: ME, VE, ME', VEPS, PDL, DB)
    = if labelInModExp(X, ME')
      then treatPar(X :: ME, VE, VEPS, PDL, DB)
      else < none ; 
             getPars(treatPar(X :: ME, VE, VEPS, PDL, DB)) ;
             getImports(treatPar(X :: ME, VE, VEPS, PDL, DB)) ;
             viewExpPairSet(treatPar(X :: ME, VE, VEPS, PDL, DB)) ;
             db(treatPar(X :: ME, VE, VEPS, PDL, DB)) >
      fi .

  op labelInModExp : Qid ModuleExpression -> Bool .
  op labelInViewExp : Qid ViewExp -> Bool .

  eq labelInModExp(X, QI) = X == QI .
  eq labelInModExp(X, ME{VE}) = labelInViewExp(X, VE) .
  eq labelInModExp(X, TUPLE[N]) = false .
  eq labelInModExp(X, POWER[N]) = false .

  eq labelInViewExp(X, QI) = X == QI .
  eq labelInViewExp(X, ((VE, VE'))) 
    = labelInViewExp(X, VE) or-else labelInViewExp(X, VE') .
  eq labelInViewExp(X, QI{VE}) = X == QI or-else labelInViewExp(X, VE) .

  eq treatPar(X :: ME, VE, VEPS, PDL, DB)
    = if VE :: Qid and-then labelInParameterDeclList(VE, PDL)
      then < (genMapsQualSorts(X, VE, getThSorts(ME, DB), VEPS),
              genMapsQualClasses(X, VE, getThClasses(ME, DB), VEPS)) ;
             VE :: ME ;
             nil ;
             < X ; VE > ;
             createCopy((VE :: ME), DB) >
      else if viewInDb(VE, DB)
           then if theory(getTopModule(target(getView(VE, DB)), DB))
                then < prepare(
                         mapSet(getView(VE, DB)), X, 
                         getThSorts(ME, DB), 
                         getThSorts(target(getView(VE, DB)), DB), 
                         getThClasses(target(getView(VE, DB)), DB)) ; 
                       X :: target(getView(VE, DB)) ;
                       nil ;
                       < X ; (VE ;; X) > ;
                       createCopy((X :: target(getView(VE, DB))), DB) >
                else < prepare(
                         mapSet(getView(VE, DB)), X, 
                         getThSorts(ME, DB), none, none) ; 
                       getPars(getTopModule(target(getView(VE, DB)), DB)) ;
                       (protecting target(getView(VE, DB)) .) ;
                       < X ; VE > ;
                       DB >
                fi
           else < none ; nil ; nil ; none ; 
                  warning(DB, '\r 'Error: '\o 'View VE 'not 'in 'database. '\n) >
           fi
      fi .

  op viewInstAux : View Set{ViewMap} ParameterDeclList ParameterDeclList 
       ParameterList Set<Tuple<ViewExp|ViewExp>> ParameterDeclList Database  
       -> Database .
  op treatParView : ParameterDecl ParameterList ModuleExpression  
       Set<Tuple<ViewExp|ViewExp>> ParameterDeclList Database 
       -> TreatParResult .
  op treatParAux : Qid ModuleExpression ParameterList Qid ViewExp ViewExp 
       ParameterList RenamingSet ParameterList ImportList 
       Set<Tuple<ViewExp|ViewExp>> Database -> TreatParResult .

  eq viewInst(VE, PL, PDL, DB)
    = viewInstAux(setName(getView(VE, DB), VE{PL}),
        none, getPars(getView(VE, DB)), nil, PL, none, PDL, DB) .

  ceq viewInstAux(VI, VMAPS, (X :: ME, PDL), PDL', (QI, PL), VEPS, PDL'', DB)
    = viewInstAux(VI, (VMAPS, VMAPS'), PDL, (PDL', PDL3),
        PL, (VEPS VEPS'), PDL'', DB') 
    if < VMAPS' ; PDL3 ; IL ; VEPS' ; DB' > 
         := treatParView(X :: ME, QI, source(VI), VEPS, PDL'', DB) .
  ceq viewInstAux(VI, VMAPS, (X :: ME, PDL), PDL', 
       (QI{PL}, PL'), VEPS, PDL'', DB)
    = viewInstAux(VI, (VMAPS, VMAPS'), PDL, (PDL', PDL3), 
        PL', (VEPS VEPS'), PDL'', DB') 
    if < VMAPS' ; PDL3 ; IL ; VEPS' ; DB' > 
        := treatParView(X :: ME, QI{PL}, source(VI), VEPS, PDL'', DB) .
  ceq viewInstAux(VI, VMAPS, nil, PDL, empty, VEPS, PDL', DB)
    = insertView(
        setPars(
          sTSource(
            setTarget(
              setMaps(VI,
                applyMapsToMaps(
                  (genMapsSorts(getSortSet(source(VI), DB''), VEPS),
                   genMapsClasses(getClassSet(source(VI), DB''), VEPS)),
                  (VMAPS,
                   genMapsSorts(getSortSet(target(VI), DB''), VEPS),
                   genMapsClasses(getClassSet(target(VI), DB''), VEPS)),
                  mapSet(VI))),
              prepModExp(target(VI), VEPS)),
            prepModExp(source(VI), VEPS)),
          PDL),
        DB'') 
    if < DB'  ; ME'  > := evalModExp(prepModExp(source(VI), VEPS), PDL', DB)
    /\ < DB'' ; ME'' > := evalModExp(prepModExp(target(VI), VEPS), PDL', DB') .
  eq viewInstAux(viewError(QIL), VMAPS, PDL0:[ParameterDeclList], PDL, PL, VEPS, PDL', DB)
    = warning(DB, QIL) .
  eq viewInstAux(VI, VMAPS, (X :: ME, PDL), PDL', empty, VEPS, PDL'', DB)
    = warning(DB, ('\r 'Error: '\o 'Incorrect 'view name(VI) '. '\n)) .
  eq viewInstAux(VI, VMAPS, nil, PDL, (QI, PL), VEPS, PDL', DB)
    = warning(DB, ('\r 'Error: '\o 'Incorrect 'view name(VI) '. '\n)) .
  eq viewInstAux(VI, VMAPS, (X :: ME, PDL), PDL', (QI{PL}, PL'), VEPS, PDL'', DB)
    = warning(DB, ('\r 'Error: '\o 'Wrong 'instantiation name(VI) '. '\n)) .

  op applyMapsToMaps : Set{ViewMap} Set{ViewMap} Set{ViewMap} -> Set{ViewMap} .
  op applyMapsToTerm : Set{ViewMap} TermList -> TermList .

  eq applyMapsToMaps(VMAPS, VMAPS', op F to F' [AtS]) = (op F to F' [AtS]) .
  eq applyMapsToMaps(VMAPS, VMAPS', (op F to F' [AtS], VMAPS''))
    = (op F to F' [AtS], applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) .
  eq applyMapsToMaps(VMAPS, VMAPS', op F : TyL -> Ty to F' [AtS])
    = (op F : applyMapsToTypeList(VMAPS, TyL) 
         -> applyMapsToType(VMAPS, Ty) to F' [AtS]) .
  eq applyMapsToMaps(VMAPS, VMAPS', 
       (op F : TyL -> Ty to F' [AtS], VMAPS''))
    = (op F : applyMapsToTypeList(VMAPS, TyL) 
         -> applyMapsToType(VMAPS, Ty) to F' [AtS], 
       applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) .
  eq applyMapsToMaps(VMAPS, VMAPS', (sort S to S'))
    = (sort applyMapsToType(VMAPS, S) to applyMapsToType(VMAPS', S')) .
  eq applyMapsToMaps(VMAPS, VMAPS', ((sort S to S'), VMAPS''))
    = ((sort applyMapsToType(VMAPS, S) to applyMapsToType(VMAPS', S')),
       applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) .
  eq applyMapsToMaps(VMAPS, VMAPS', (label L to L')) = (label L to L') .
  eq applyMapsToMaps(VMAPS, VMAPS', ((label L to L'), VMAPS''))
    = ((label L to L'), applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) .
  eq applyMapsToMaps(VMAPS, VMAPS', (class S to S'))
    = (class applyMapsToType(VMAPS, S) to applyMapsToType(VMAPS',S')) .
  eq applyMapsToMaps(VMAPS, VMAPS', ((class S to S'), VMAPS''))
    = ((class applyMapsToType(VMAPS, S) to applyMapsToType(VMAPS',S')),
       applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) .
  eq applyMapsToMaps(VMAPS, VMAPS', (attr A . S to A'))
    = (attr A . applyMapsToType(VMAPS, S) to A') .
  eq applyMapsToMaps(VMAPS, VMAPS', ((attr A . S to A'), VMAPS''))
    = ((attr A . applyMapsToType(VMAPS, S) to A'), 
       applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) .
  eq applyMapsToMaps(VMAPS, VMAPS', (msg F to F')) = (msg F to F') .
  eq applyMapsToMaps(VMAPS, VMAPS', ((msg F to F'), VMAPS''))
    = ((msg F to F'), applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) .
  eq applyMapsToMaps(VMAPS, VMAPS', (msg F : TyL -> S to F'))
    = (msg F : applyMapsToTypeList(VMAPS, TyL) 
          -> applyMapsToType(VMAPS, S) to F') .
  eq applyMapsToMaps(VMAPS, VMAPS', 
       ((msg F : TyL -> S to F'), VMAPS''))
    = ((msg F : applyMapsToTypeList(VMAPS, TyL) 
          -> applyMapsToType(VMAPS, S) to F'), 
       applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) .
  eq applyMapsToMaps(VMAPS, VMAPS', termMap(T, T'))
    = termMap(applyMapsToTerm(VMAPS, T), 
               applyMapsToTerm(VMAPS', T')) .
  eq applyMapsToMaps(VMAPS, VMAPS', (termMap(T, T'), VMAPS''))
    = (termMap(applyMapsToTerm(VMAPS, T), 
               applyMapsToTerm(VMAPS', T')), 
       applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) .
  eq applyMapsToMaps(VMAPS, VMAPS', none) = none .

  eq applyMapsToTerm(VMAPS, Ct) 
    = qid(string(getName(Ct)) 
          + "." + string(applyMapsToType(VMAPS, getType(Ct)))) .
  eq applyMapsToTerm(VMAPS, V) = V .
  eq applyMapsToTerm(VMAPS, qidError(QIL)) = qidError(QIL) .
  ceq applyMapsToTerm(VMAPS, F[TL]) 
    = F[applyMapsToTerm(VMAPS, TL)]
    if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) .
  eq applyMapsToTerm(VMAPS, '<_:_|_>[O, Ct, T]) 
    = '<_:_|_>[applyMapsToTerm(VMAPS, O), 
               qid(string(applyMapsToClassName(VMAPS, getName(Ct))) 
                   + "." + string(applyMapsToClassName(VMAPS, getType(Ct)))),
               applyMapsToTerm(VMAPS, T)] .
  ceq applyMapsToTerm(VMAPS, '<_:_|_>[O, C, T]) 
    = '<_:_|_>[applyMapsToTerm(VMAPS, O), 
               applyMapsToClassName(VMAPS, C), 
               applyMapsToTerm(VMAPS, T)] 
    if not C :: Constant .
  eq applyMapsToTerm(VMAPS, '<_:_|`>[O, Ct]) 
    = '<_:_|_>[applyMapsToTerm(VMAPS, O), 
               qid(string(applyMapsToClassName(VMAPS, getName(Ct)))
                   + "." + string(applyMapsToClassName(VMAPS, getType(Ct)))),
               'none.AttributeSet] .
  ceq applyMapsToTerm(VMAPS, '<_:_|`>[O, C]) 
    = '<_:_|_>[applyMapsToTerm(VMAPS, O), 
               applyMapsToClassName(VMAPS, C), 
               'none.AttributeSet] 
    if not C :: Constant .

  ceq applyMapsToTerm(VMAPS, (T, TL)) 
    = (applyMapsToTerm(VMAPS, T), applyMapsToTerm(VMAPS, TL)) 
    if TL =/= empty .

*** As pointed out in Section~\ref{module-names}, for each new module
*** expression constructor being introduced, we need to add equations for the
*** operator \texttt{header2Qid}. Since the function to transform view
*** expressions into lists of quoted identifiers was already defined in 
*** Section~\ref{VIEW-EXPR}, we just need to add the following equation.

  eq header2Qid((ME { PL })) 
    = qidList2Qid(header2Qid(ME) '`{ parameterList2Qid(PL) '`}) .
  ceq header2QidList((ME { PL })) 
    = (if QI == '\s then QIL else QIL QI fi 
       '`{ parameterList2QidList(PL) '`} '\s) 
    if QIL QI := header2QidList(ME) .
 
*** Given a module expression of the form \verb~ME{VE}~ such that
*** \texttt{ME} is in the database, we need to add \verb~ME{VE}~ to the set
*** of names of the modules depending on \texttt{ME} and on \texttt{VE}.
*** Since \texttt{VE} may be a composed view expression, we have to add the
*** name of the module  to each of the views in it. In this way, if \texttt{ME}
*** or any of the  views in \texttt{VE} is redefined or removed from the
*** database,  \verb~ME{VE}~ will be removed as well.

  eq setUpModExpDeps(ME{PL}, 
      db(< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', 
          VIS, VES', MNS'', MNS3, MNS4, QIL))
    = viewExpDeps(ME{PL}, PL,
        db(< ME ; DT ; U ; U' ; M ; VDS ; (MNS . ME{PL}) ; VES > MIS, 
           MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq setUpModExpDeps(ME{PL}, 
      db(< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', 
         VIS, VES', MNS'', MNS3, MNS4, QIL))
    = viewExpDeps(ME{PL}, PL,
        db(< ME ; DM ; U ; U' ; M ; VDS ; (MNS . ME{PL}) ; VES > MIS, 
           MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq setUpModExpDeps('META-LEVEL{PL}, DB)
    = setUpModExpDeps('META-LEVEL{PL}, PL, DB) .
  eq setUpModExpDeps('META-LEVEL{QI}, 
       db(< QI ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', 
          VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db(< QI ; DT ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{QI} ; VES > 
          MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
  eq setUpModExpDeps('META-LEVEL{QI}, 
       db(< QI ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', 
          VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db(< QI ; DM ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{QI} ; VES > 
          MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
  ceq setUpModExpDeps(ME{PL}, DB)
    = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n))
    if (ME =/= 'META-LEVEL) /\ (not unitInDb(ME, DB)) .

  eq setUpModExpDeps('META-LEVEL{PL}, (QI, PL'),
       db(< QI ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', 
          VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpModExpDeps('META-LEVEL{PL}, PL',
        db(< QI ; DT ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{PL} ; VES >
           MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq setUpModExpDeps('META-LEVEL{PL}, (QI, PL'),
       db(< QI ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', 
          VIS, VES', MNS'', MNS3, MNS4, QIL))
    = setUpModExpDeps('META-LEVEL{PL}, PL',
        db(< QI ; DM ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{PL} ; VES >
           MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
  eq setUpModExpDeps('META-LEVEL{PL}, nil, DB) = DB .

  op viewExpDeps : Header ViewExp Database -> Database .

----  eq viewExpDeps(ME, VE, 
----        db(MIS, MNS, 
----           < VE ; DT ; VI ; MNS' ; VES > VIS, VES', 
----           MNS'', MNS3, MNS4, QIL))
----    = db(MIS, MNS, < VE ; DT ; VI ; MNS' . ME ; VES > VIS, VES', 
----         MNS'', MNS3, MNS4, QIL) .
  eq viewExpDeps(ME, (VE, PL), 
        db(MIS, MNS, 
           < VE ; DT ; VI ; MNS' ; VES > VIS, VES', 
           MNS'', MNS3, MNS4, QIL))
    = viewExpDeps(ME, PL, 
        db(MIS, MNS, 
           < VE ; DT ; VI ; MNS' . ME ; VES > VIS, VES', 
           MNS'', MNS3, MNS4, QIL)) .
----  eq viewExpDeps(ME, VE, DB) = DB [owise] .
  eq viewExpDeps(ME, (VE, PL), DB) = viewExpDeps(ME, PL, DB) [owise] .
  eq viewExpDeps(ME, empty, DB) = DB .

endfm

*******************************************************************************

***
*** 6.10 Renaming of Modules
***

*** In addition to the declaration of the constructor for renaming module
*** expressions, the following module \texttt{RENAMING-EXPR-EVALUATION}
*** introduces equations to treat this new case in the definition of functions
*** \texttt{evalModExp}, \texttt{header2QidList}, \texttt{prepHeader}, and 
*** \texttt{setUpModuleDeps}.

*** A renaming expression is evaluated by applying the renaming maps, not only
*** to the top unit, but also to the part of the structure \emph{affected} by
*** the maps. The renaming process propagates downwards in the unit hierarchy
*** while the units in the structure are affected by the renamings. We say that
*** a unit is affected by a set of maps (checked by the \texttt{modAffd}
*** function) when any of the maps is applicable to any of the declarations in
*** the unit, or in any of its subunits. The application of a set of maps to a
*** single unit is accomplished by the \texttt{applyMapsToModule} function, 
*** discussed in Section~\ref{applyMapsToModule}.

fmod RENAMING-EXPR-EVALUATION is
  pr DATABASE .
  pr VIEW-MAP-SET-APPL-ON-UNIT .
  pr EVALUATION .
  inc MOD-EXPR .
  pr MOD-EXPR-EVAL .
  pr INST-EXPR-EVALUATION .
  pr FMAP .

  vars ME ME' : ModuleExpression .
  var  MNS MNS' MNS'' MNS3 MNS4 : Set{ModuleName} .
  vars MIS MIS' : Set{ModuleInfo} .
  var  VIS : Set{ViewInfo} .
  vars M M' : Module .
  vars PU U U' DM : Module .
  vars DB DB' : Database .
  var  QIL : QidList .
  vars VES VES' : Set{ViewExp} .
  var  PL : ParameterList .
  var  PDL : ParameterDeclList .
  vars PDS PDS' : Set{ParameterDecl} .
  var  I : Import .
  vars IL IL' : ImportList .
  var  VMAP : ViewMap .
  vars VMAPS VMAPS' VMAPS'' VMAPS3 : RenamingSet .
  var  VEPS : Set<Tuple<ViewExp|ViewExp>> .
  vars X QI QI' QI'' F F' F'' L L' L'' A A' A'' : Qid .
  vars S S' S'' C C' C'' : Sort .
  var  K : Kind .
  vars SS : SortSet .
  vars TyL TyL' : TypeList .
  vars Ty Ty' : Type .
  vars T T' T'' T3 : Term .
  var  DT : Default{Term} .
  var  TL : TermList .
  var  OPD : OpDeclSet .
  vars OPDS VDS : OpDeclSet .
  vars AtS AtS' : AttrSet .
  var  Rl : Rule .
  var  RlS : RuleSet .
  var  CD : ClassDecl .
  var  CDS : ClassDeclSet .
  var  ADS : AttrDeclSet .
  var  MD : MsgDecl .
  var  MDS : MsgDeclSet .
  var  MAP : Renaming .
  vars MAPS MAPS' MAPS'' : RenamingSet .
  var  N : Nat .
  var  NL : IntList .
  var  Hk : Hook .
  var  HkL : HookList .
  var  B : Bool .

*** The function \texttt{crtCopyRen} creates a copy of the part of the
*** structure of the specified module which is affected by the renaming,
*** applying to each of the generated modules in the new structure the subset
*** of maps affecting each one of them. The equation extending the
*** \texttt{evalModExp} function to the renaming module expression is then 
*** reduced to a call to \texttt{crtCopyRen} with the appropriate 
*** arguments.

  eq labelInModExp(X, ME * (MAPS)) = labelInModExp(X, ME) .

  op crtCopyRen : ModuleExpression RenamingSet Database -> Database .

  ceq evalModExp(ME * (MAPS), PDL, DB) 
    = if unitInDb(ME' * (MAPS''), DB') 
      then < DB' ; ME' * (MAPS'') >
      else < crtCopyRen(ME', MAPS', DB') ; ME' * (MAPS'') >
      fi 
    if < DB' ; ME' > := evalModExp(ME, PDL, DB)
       /\ MAPS' := fixMaps(MAPS, ME', DB') 
       /\ MAPS'' := canMaps(MAPS', getFlatModule(ME', DB')) .

  eq crtCopyRen(ME, none, DB) = DB .
  ceq crtCopyRen(ME, VMAPS, DB)
    = if unitInDb(_*`(_`)(ME, VMAPS'), DB) 
      then DB
      else applyMapsRec(
             VMAPS, 
             getImports(getTopModule(ME, DB)), 
             nil,
             setName(
               applyMapsToModuleAux(VMAPS'', VMAPS3, 
                 getTopModule(ME, DB), getFlatModule(ME, DB)), 
               _*`(_`)(ME, VMAPS')), 
             applyMapsToOps(VMAPS'', VMAPS3, 
               getVars(ME, DB), getFlatModule(ME, DB)),
             DB)
      fi 
    if VMAPS' := canMaps(VMAPS, getFlatModule(ME, DB)) 
       /\ < VMAPS'' ; VMAPS3 > := splitMaps(VMAPS') .

  op canMaps : RenamingSet Module -> RenamingSet .
  eq canMaps(op F : TyL -> Ty to F' [AtS], M)
    = op F : canKinds(TyL, M) -> canKinds(Ty, M) to F' [AtS] .
  eq canMaps((op F : TyL -> Ty to F' [AtS], MAPS), M)
    = (op F : canKinds(TyL, M) -> canKinds(Ty, M) to F' [AtS],
       canMaps(MAPS, M)) .
  eq canMaps(msg F : TyL -> Ty to F', M)
    = msg F : canKinds(TyL, M) -> canKinds(Ty, M) to F' .
  eq canMaps((msg F : TyL -> Ty to F', MAPS), M)
    = (msg F : canKinds(TyL, M) -> canKinds(Ty, M) to F',
       canMaps(MAPS, M)) .
  eq canMaps(MAP:Renaming, M) = MAP:Renaming [owise] .
  eq canMaps((MAP:Renaming, MAPS), M) 
    = (MAP:Renaming, canMaps(MAPS, M)) 
    [owise] .
  eq canMaps(none, M) = none .

  op canKinds : TypeList Module -> [TypeList] .
  ---- eq canKinds(K:Kind TyL, M) 
  ----   = kind(maximalSorts(M, K:Kind)) canKinds(TyL, M) .
  eq canKinds(nil, M) = nil .
  eq canKinds(cc(S ; SS) TyL, M)
    = kind(maximalSorts(M, getKind(M, S))) canKinds(TyL, M) .
  ----eq canKinds(TyL, M) = nil [owise] .

*** We proceed downwards while the set of maps affects the module, but we do so
*** restricting the set of maps to the subset affecting the module. Since
*** operator and message maps in which arity and coarity are specified must be
*** applied to the whole subsort-overloaded family of operators or messages, we
*** have to carry along the signature of the module at the top to make all the
*** calls to the engine. Note that we may have maps of operations or messages
*** with the domain given by sorts that are not in the submodules but which 
*** have other sorts in the submodules in the same connected components.

  op applyMapsRec : Set{ViewMap} ImportList
       ImportList Module OpDeclSet Database -> Database .

  eq applyMapsRec(VMAPS, ((including ME .) IL), IL', U, VDS, DB) 
   = applyMapsRec(
       VMAPS, IL, 
       including ME *( canMaps(fixMaps(VMAPS, ME, DB), 
                               getFlatModule(ME, DB)) ) . IL', 
       U, VDS,  
       crtCopyRen(ME, fixMaps(VMAPS, ME, DB), DB)) .
  eq applyMapsRec(VMAPS, ((extending ME .) IL), IL', U, VDS, DB) 
   = applyMapsRec(
       VMAPS, IL, 
       extending ME *( canMaps(fixMaps(VMAPS, ME, DB), 
                               getFlatModule(ME, DB)) ) . IL', 
       U, VDS,  
       crtCopyRen(ME, fixMaps(VMAPS, ME, DB), DB)) .
  eq applyMapsRec(VMAPS, ((protecting ME .) IL), IL', U, VDS, DB) 
   = applyMapsRec(
       VMAPS, IL, 
       protecting ME *( canMaps(fixMaps(VMAPS, ME, DB), 
                               getFlatModule(ME, DB)) ) . IL', 
       U, VDS,  
       crtCopyRen(ME, fixMaps(VMAPS, ME, DB), DB)) .
  eq applyMapsRec(VMAPS, (I IL), IL', U, VDS, DB) 
    = applyMapsRec(VMAPS, IL, (I IL'), U, VDS, DB) 
    [owise] .
  eq applyMapsRec(VMAPS, nil, IL, U, VDS, DB) 
    = evalModule(setImports(U, IL), VDS, DB) .
  eq applyMapsRec(VMAPS, IL, IL', unitError(QIL), VDS, DB) 
    = warning(DB, QIL) .

  op fixMaps : [RenamingSet] ModuleExpression Database -> RenamingSet .
  op fixMaps2 : [RenamingSet] Module ClassDeclSet MsgDeclSet -> RenamingSet .

  ceq fixMaps(MAPS, ME, DB) 
    = fixMaps2(MAPS, getFlatModule(ME, DB), CDS, MDS) 
    if < CDS ; MDS > := getAllClassesAndMsgs(ME, DB) .

  eq fixMaps2(op F to F' [AtS], M, CDS, MDS) 
    = opsAffd(getOps(M), op F to F' [AtS], M) .
  eq fixMaps2((op F to F' [AtS], MAPS), M, CDS, MDS)
    = (opsAffd(getOps(M), op F to F' [AtS], M), 
       fixMaps2(MAPS, M, CDS, MDS)) .
  eq fixMaps2(op F : TyL -> Ty to F' [AtS], M, CDS, MDS)
    = opsAffd(getOps(M), op F : TyL -> Ty to F' [AtS], M) .
  eq fixMaps2((op F : TyL -> Ty to F' [AtS], MAPS), M, CDS, MDS)
    = (opsAffd(getOps(M), op F : TyL -> Ty to F' [AtS], M),
       fixMaps2(MAPS, M, CDS, MDS)) .
  eq fixMaps2(msg F to F', M, CDS, MDS) 
    = msgsAffd(MDS, msg F to F', M) .
  eq fixMaps2((msg F to F', MAPS), M, CDS, MDS)
    = (msgsAffd(MDS, msg F to F', M), fixMaps2(MAPS, M, CDS, MDS)) .
  eq fixMaps2(msg F : TyL -> Ty to F', M, CDS, MDS)
    = msgsAffd(MDS, msg F : TyL -> Ty to F', M) .
  eq fixMaps2((msg F : TyL -> Ty to F', MAPS), M, CDS, MDS)
    = (msgsAffd(MDS, msg F : TyL -> Ty to F', M),
       fixMaps2(MAPS, M, CDS, MDS)) .
  eq fixMaps2(sort Ty to Ty', M, CDS, MDS)
    = if sortsAffd(getSorts(M), sort Ty to Ty')
      then (sort Ty to Ty')
      else none
      fi .
  eq fixMaps2(((sort Ty to Ty'), MAPS), M, CDS, MDS)
    = (if sortsAffd(getSorts(M), sort Ty to Ty')
       then (sort Ty to Ty')
       else none
       fi,
       fixMaps2(MAPS, M, CDS, MDS)) .
  eq fixMaps2(class Ty to Ty', M, CDS, MDS)
    = if classesAffd(CDS, class Ty to Ty')
      then (class Ty to Ty')
      else none
      fi .
  eq fixMaps2(((class Ty to Ty'), MAPS), M, CDS, MDS)
    = (if classesAffd(CDS, class Ty to Ty')
       then (class Ty to Ty')
       else none
       fi,
       fixMaps2(MAPS, M, CDS, MDS)) .
  eq fixMaps2(attr A . Ty to Ty', M, CDS, MDS)
    = if classesAffd(CDS, attr A . Ty to Ty')
      then (attr A . Ty to Ty')
      else none
      fi .
  eq fixMaps2(((class A . Ty to Ty'), MAPS), M, CDS, MDS)
    = (if classesAffd(CDS, attr A . Ty to Ty')
       then (attr A . Ty to Ty')
       else none
       fi,
       fixMaps2(MAPS, M, CDS, MDS)) .
  eq fixMaps2(MAP:Renaming, M, CDS, MDS) = MAP:Renaming [owise] .
  eq fixMaps2((MAP:Renaming, MAPS), M, CDS, MDS) 
    = (MAP:Renaming, fixMaps2(MAPS, M, CDS, MDS)) 
    [owise] .
  eq fixMaps2(none, M, CDS, MDS) = none .

  sort Tuple{ClassDeclSet, MsgDeclSet} .
  op <_;_> : ClassDeclSet MsgDeclSet -> Tuple{ClassDeclSet, MsgDeclSet} .
  op getClasses : Tuple{ClassDeclSet, MsgDeclSet} -> ClassDeclSet .
  op getMsgs : Tuple{ClassDeclSet, MsgDeclSet} -> MsgDeclSet .
  eq getClasses(< CDS ; MDS >) = CDS .
  eq getMsgs(< CDS ; MDS >) = MDS .

  op getAllClassesAndMsgs : 
       ModuleExpression Database -> Tuple{ClassDeclSet, MsgDeclSet} .
  op getAllClassesAndMsgs : 
       ImportList Database -> Tuple{ClassDeclSet, MsgDeclSet} .

  eq getAllClassesAndMsgs(ME, DB)
    = if getTopModule(ME, DB) :: OModule
         and-then not getTopModule(ME, DB) :: SModule
      then < getClasses(
               getAllClassesAndMsgs(getImports(getTopModule(ME, DB)), DB))
             getClasses(getTopModule(ME, DB)) 
             ;
             getMsgs(
               getAllClassesAndMsgs(getImports(getTopModule(ME, DB)), DB))
             getMsgs(getTopModule(ME, DB)) >
      else < none ; none >
      fi .

  eq getAllClassesAndMsgs(I IL, DB)
    = < getClasses(getAllClassesAndMsgs(moduleName(I), DB))
        getClasses(getAllClassesAndMsgs(IL, DB))
        ;
        getMsgs(getAllClassesAndMsgs(moduleName(I), DB))
        getMsgs(getAllClassesAndMsgs(IL, DB)) > .
  eq getAllClassesAndMsgs((nil).ImportList, DB) = < none ; none > .

  sorts NeSet<TypeList> Set<TypeList> .
  subsort TypeList < NeSet<TypeList> < Set<TypeList> .
  op noneTLS : -> Set<TypeList> [ctor] .
  op _!_ : Set<TypeList> Set<TypeList> -> Set<TypeList>
     [ctor assoc comm id: noneTLS] .
  op _!_ : NeSet<TypeList> NeSet<TypeList> -> NeSet<TypeList>
     [ctor assoc comm id: noneTLS] .

  sort Set<Type> .
  subsorts Type SortSet < Set<Type> .
  op _o_ : Set<Type> Set<Type> -> Set<Type> [ctor assoc comm id: none] .

  eq Ty o Ty = Ty .

  sort List<Set<Type>> .
  subsort Set<Type> < List<Set<Type>> .
  op nilTSL : -> List<Set<Type>> [ctor] .
  op _l_ : List<Set<Type>> List<Set<Type>> -> List<Set<Type>>
     [ctor assoc id: nilTSL] .

  var  TS : Set<Type> .
  var  TSL : List<Set<Type>> .
  var  TLS : Set<TypeList> .
  var  NTLS : NeSet<TypeList> .

  eq TyL ! TyL = TyL .

  ----eq _!_(qidError(QIL), NTLS) = qidError(QIL) .

  op fixKinds : TypeList Module -> Set<TypeList> .
  op fixKinds : TypeList List<Set<Type>> Module -> Set<TypeList> .
  op fixKindsAux : Type Module -> Set<Type> .
  op fixKindsAux2 : SortSet Module -> Set<Type> .
  op unfold : List<Set<Type>> -> Set<TypeList> .
  op add : Set<Type> Set<TypeList> -> Set<TypeList> .

  eq fixKinds(TyL, M) = fixKinds(TyL, nilTSL, M) .

  eq fixKinds(Ty TyL, TSL, M) 
    = if fixKindsAux(Ty, M) == nil
      then noneTLS
      else fixKinds(TyL, TSL l fixKindsAux(Ty, M), M)
      fi .
  eq fixKinds(nil, TSL, M) = unfold(TSL) .

  eq fixKindsAux(S, M) 
    = if S in getSorts(M) 
      then cc(connectedSorts(M, S)) 
      else none 
      fi .
  eq fixKindsAux(K, M) = fixKindsAux2(getSorts(K), M) .
  eq fixKindsAux(cc(SS), M) = fixKindsAux2(SS, M) .

  eq fixKindsAux2((S ; SS), M) 
    = (if S in getSorts(M) 
       then cc(connectedSorts(M, S)) 
       else none 
       fi 
       o
       fixKindsAux2(SS, M)) .
  eq fixKindsAux2(none, M) = none .

  ceq unfold(TS l TSL) = add(TS, unfold(TSL)) if TS =/= none .
  eq unfold(nilTSL) = noneTLS .

  eq add(Ty, TyL ! NTLS) = add(Ty, TyL) ! add(Ty, NTLS) .
  eq add(Ty o Ty' o TS, TLS) = add(Ty, TLS) ! add(Ty' o TS, TLS) .
  eq add(none, TLS) = nilTSL .
  eq add(Ty, noneTLS) = Ty .
  eq add(Ty, TyL) = Ty TyL .

  op connectedSorts : Module Type -> SortSet .
  op connectedSorts : Module SortSet Type -> SortSet .
  eq connectedSorts(M, Ty) = connectedSorts(M, getSorts(M), Ty) .
  eq connectedSorts(M, S ; SS, Ty)
    = if sameKind(M, S, Ty) 
      then S 
      else none 
      fi ; connectedSorts(M, SS, Ty) .
  eq connectedSorts(M, none, Ty) = none .

  op sortsAffd : SortSet ViewMap -> Bool .
  op opsAffd : OpDeclSet ViewMap Module -> RenamingSet .
  op opsAffdAux : OpDeclSet Qid Set<TypeList> Qid AttrSet Module 
       -> RenamingSet .

  eq sortsAffd((S ; SS), (sort S to S')) = true .
  eq sortsAffd(SS, (sort S to S')) = false [owise] .

  eq opsAffd(op F : TyL -> Ty [AtS] . OPDS, op F to F' [AtS'], M)
    = op F to F' [AtS'] .
  eq opsAffd(OPDS, op F : TyL -> Ty to F' [AtS], M) 
    = opsAffdAux(OPDS, F, fixKinds(TyL Ty, M), F', AtS, M) .
  eq opsAffd(OPDS, VMAPS:[RenamingSet], M) = none [owise] .

  eq opsAffdAux(op F : TyL -> Ty [AtS] . OPDS, 
       F, (TyL' Ty') ! TLS, F', AtS', M)
    = if sameKind(M, (TyL Ty), (TyL' Ty'))
      then (op F : TyL' -> Ty' to F' [AtS'],
            opsAffdAux(OPDS, F, TLS, F', AtS', M))
      else (opsAffdAux(OPDS, F, (TyL' Ty') ! TLS, F', AtS', M),
            opsAffdAux(op F : TyL -> Ty [AtS] . OPDS, F, TLS, F', AtS', M))
      fi .
  eq opsAffdAux(OPDS, F, TLS, F', AtS, M) = none [owise] .

*** The predicate \texttt{modAffd} checks whether the module with the
*** name given as first argument in the database is affected by the set of maps
*** given as second argument. A module is affected by a map set if any of the
*** maps is applicable to the module or to any of its submodules.

  op modAffd : Header RenamingSet Module Database -> Bool .

  op modAffdAux : Module RenamingSet Module Database -> Bool .
  op rlsAffd : RuleSet RenamingSet -> Bool .
  op importsAffd : ImportList RenamingSet Module Database -> Bool .
  op classesAffd : ClassDeclSet RenamingSet -> Bool .
  op msgsAffd : MsgDeclSet RenamingSet Module -> RenamingSet .
  op msgsAffdAux : MsgDeclSet Qid Set<TypeList> Qid Module -> RenamingSet .

  eq modAffd(ME, VMAPS, M, DB) 
    = modAffdAux(getTopModule(ME, DB), VMAPS, M, DB) .

  eq modAffdAux(U, VMAPS, M, DB) 
    = sortsAffd(getSorts(U), VMAPS) 
      or-else 
      (opsAffd(getOps(U), VMAPS, M) == none 
       or-else 
       ((not U :: FModule
         and-then
         (rlsAffd(getRls(U), VMAPS) 
          or-else
          (not U :: SModule
           and-then
           (classesAffd(getClasses(U), VMAPS) 
            or-else 
            msgsAffd(getMsgs(U), VMAPS, M) == none))))
        or-else 
        importsAffd(getImports(U), VMAPS, M, DB))) .

  eq importsAffd(((including ME .) IL), VMAPS, M, DB)
    = modAffd(ME, VMAPS, M, DB) 
      or-else importsAffd(IL, VMAPS, M, DB) .
  eq importsAffd(((extending ME .) IL), VMAPS, M, DB)
    = modAffd(ME, VMAPS, M, DB) 
      or-else importsAffd(IL, VMAPS, M, DB) .
  eq importsAffd(((protecting ME .) IL), VMAPS, M, DB)
    = modAffd(ME, VMAPS, M, DB) 
      or-else importsAffd(IL, VMAPS, M, DB) .
  eq importsAffd(nil, VMAPS, M, DB) = false .

  eq rlsAffd(((rl T => T' [label(L) AtS] .) RlS), (label L' to L'')) 
    = (L == L') or-else rlsAffd(RlS, label L' to L'') .
  eq rlsAffd(((rl T => T' [label(L) AtS] .) RlS), 
       ((label L' to L''), VMAPS)) 
    = (L == L') or-else
      (rlsAffd((rl T => T' [label(L) AtS] .), VMAPS) or-else
       rlsAffd(RlS, ((label L' to L''), VMAPS))) .
  eq rlsAffd(((crl T => T' if T'' = T3 [label(L) AtS] .) RlS), 
       (label L' to L''))
    = (L == L') or-else rlsAffd(RlS, (label L' to L'')) .
  eq rlsAffd(((crl T => T' if T'' = T3 [label(L) AtS] .) RlS), 
       ((label L' to L''), VMAPS))
    = (L == L') 
      or-else
      (rlsAffd((crl T => T' if T'' = T3 [label(L) AtS] .), VMAPS) 
      or-else
      rlsAffd(RlS, ((label L' to L''), VMAPS))) .
  eq rlsAffd(RlS, VMAPS) = false [owise] .

  eq classesAffd(((class C | ADS .) CDS), (class C' to C''))
    = (C == C') 
      or-else 
      classesAffd(CDS, (class C' to C'')) .
  eq classesAffd(((class C | ADS .) CDS), ((class C' to C''), VMAPS))
    = (C == C') 
      or-else 
      (classesAffd((class C | ADS .), VMAPS) 
      or-else 
      classesAffd(CDS, ((class C' to C''), VMAPS))) .
  eq classesAffd(((class C | ((attr A : S), ADS) .) CDS), 
       (attr A' . C' to A''))
    = if C == C'
      then (A == A') 
           or-else 
           classesAffd(((class C | ADS .) CDS), (attr A' . C' to A''))
      else classesAffd(CDS, (attr A' . C' to A''))
      fi .
  eq classesAffd(((class C | ((attr A : S), ADS) .) CDS), 
       ((attr A' . C' to A''), VMAPS))
    = if C == C'
      then (A == A') 
           or-else 
           (classesAffd(((class C | ADS .) CDS), 
              ((attr A' . C' to A''), VMAPS))
           or-else 
           classesAffd(CDS, VMAPS))
      else classesAffd((class C | ((attr A : S), ADS) .), VMAPS)
           or-else
           classesAffd(CDS, ((attr A' . C' to A''), VMAPS))
      fi .
  eq classesAffd(CDS, VMAPS) = false [owise] .

  eq msgsAffd(msg F : TyL -> Ty . MDS, msg F to F', M) = msg F to F' .
  eq msgsAffd(MDS, msg F : TyL -> Ty to F', M) 
    = msgsAffdAux(MDS, F, fixKinds(TyL Ty, M), F', M) .
  eq msgsAffd(MDS, VMAPS:[RenamingSet], M) = none [owise] .

  eq msgsAffdAux(msg F : TyL -> Ty . MDS, F, (TyL' Ty') ! TLS, F', M)
    = if sameKind(M, (TyL Ty), (TyL' Ty'))
      then (msg F : TyL' -> Ty' to F',
            msgsAffdAux(MDS, F, TLS, F', M))
      else (msgsAffdAux(MDS, F, (TyL' Ty') ! TLS, F', M),
            msgsAffdAux(msg F : TyL -> Ty . MDS, F, TLS, F', M))
      fi .
  eq msgsAffdAux(MDS, F, TLS, F', M) = none [owise] .

*** The function \texttt{mapsRestrict} returns the subset of the view
*** maps given as second argument that affect the given module.

  op mapsRestrict : Module RenamingSet Module Database -> RenamingSet .
  op mapsRestrict : Header RenamingSet Module Database -> RenamingSet .

  eq mapsRestrict(ME, VMAPS, M, DB)
    = mapsRestrict(getTopModule(ME, DB), VMAPS, M, DB) .

  eq mapsRestrict(U, VMAP, M, DB)
    = if modAffdAux(U, VMAP, M, DB)
      then VMAP
      else none
      fi .
  eq mapsRestrict(U, (VMAP, VMAPS), M, DB)
    = if modAffdAux(U, VMAP, M, DB)
      then (VMAP, mapsRestrict(U, VMAPS, M, DB))
      else mapsRestrict(U, VMAPS, M, DB)
      fi .
  eq mapsRestrict(U, none, M, DB) = none .

*** The definition of the function \texttt{header2QidList} on the renaming
*** module expression has to take care of transforming into a quoted identifier
*** list the set of view maps given in the module expression.

  op maps2QidList : RenamingSet -> QidList .

  op attrSet2QidList : AttrSet -> QidList .
  op hookList2QidList : HookList -> QidList .
  op termList2QidList : TermList -> QidList .
  op intList2QidList : IntList -> QidList .
  op typeList2QidList : TypeList -> QidList .

  eq maps2QidList(((op F to F' [AtS]), MAPS))
    = if AtS == none 
      then ('op F 'to F' '`, '\s maps2QidList(MAPS))
      else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`] '`, '\s 
            maps2QidList(MAPS))
      fi
    [owise] .
  eq maps2QidList((op F to F' [AtS]))
    = if AtS == none 
      then ('op F 'to F')  
      else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`]) 
      fi .
  eq maps2QidList(((op F : TyL -> Ty to F' [AtS]), MAPS))
    = if AtS == none 
      then ('op F ': typeList2QidList(TyL) '-> Ty 'to F' '`, 
            '\s maps2QidList(MAPS))
      else ('op F ': typeList2QidList(TyL) '-> Ty 'to F' 
            '`[ attrSet2QidList(AtS) '`] '`, '\s maps2QidList(MAPS))
      fi 
    [owise] .
  eq maps2QidList((op F : TyL -> Ty to F' [AtS]))
    = if AtS == none 
      then ('op F ': typeList2QidList(TyL) '-> Ty 'to F')
      else ('op F ': typeList2QidList(TyL) '-> Ty 'to F' 
            '`[ attrSet2QidList(AtS) '`]) 
      fi .
  eq maps2QidList(((sort S to S'), MAPS))
    = ('sort S 'to S' '`, '\s maps2QidList(MAPS))
    [owise] .
  eq maps2QidList((sort S to S')) = ('sort S 'to S') .

  eq maps2QidList(((label L to L'), MAPS))
    = ('label L 'to L' '`, '\s maps2QidList(MAPS))
    [owise] .
  eq maps2QidList((label L to L')) = ('label L 'to L') .

  eq maps2QidList(((msg F to F'), MAPS))
    = ('msg F 'to F' '`, '\s maps2QidList(MAPS))
    [owise] .
  eq maps2QidList((msg F to F')) = ('msg F 'to F') .

  eq maps2QidList(((msg F : TyL  -> Ty to F'), MAPS))
    = ('msg F ': typeList2QidList(TyL) '-> Ty 'to F' '`, '\s 
       maps2QidList(MAPS))
    [owise] .
  eq maps2QidList((msg F : TyL -> Ty to F'))
    = ('msg F ': typeList2QidList(TyL) '-> Ty 'to F') .

  eq maps2QidList(((class S to S'), MAPS))
    = ('class S 'to S' '`, '\s maps2QidList(MAPS))
    [owise] .
  eq maps2QidList((class S to S')) = ('class S 'to S') .

  eq maps2QidList(((attr QI . S to QI'), MAPS))
    = ('attr S '. QI 'to QI' '`, '\s maps2QidList(MAPS))
    [owise] .
  eq maps2QidList((attr QI . S to QI')) = ('attr S '. QI 'to QI') .

  eq maps2QidList(none) = nil .

  eq attrSet2QidList(none) = nil .
  eq attrSet2QidList((assoc AtS)) = ('assoc attrSet2QidList(AtS)) .
  eq attrSet2QidList((comm AtS))  = ('comm attrSet2QidList(AtS)) .
  eq attrSet2QidList((idem AtS))  = ('idem attrSet2QidList(AtS)) .
  eq attrSet2QidList((iter AtS))  = ('iter attrSet2QidList(AtS)) .
  eq attrSet2QidList((id(T) AtS)) 
    = ('id: termList2QidList(T) attrSet2QidList(AtS)) .
  eq attrSet2QidList((right-id(T) AtS)) 
    = ('right-id: termList2QidList(T) attrSet2QidList(AtS)) .
  eq attrSet2QidList((left-id(T) AtS))  
    = ('left-id: termList2QidList(T) attrSet2QidList(AtS)) .
  eq attrSet2QidList((poly(NL) AtS))
    = ('poly '`( intList2QidList(NL) '`) attrSet2QidList(AtS)) .
  eq attrSet2QidList((strat(NL) AtS))
    = ('strat '`( intList2QidList(NL) '`) attrSet2QidList(AtS)) .
  eq attrSet2QidList((memo AtS))  = ('memo attrSet2QidList(AtS)) .
  eq attrSet2QidList((prec(N) AtS))  
    = ('prec intList2QidList(N) attrSet2QidList(AtS)) .
  eq attrSet2QidList((gather(QIL) AtS)) 
    = ('gather QIL attrSet2QidList(AtS)) .
  eq attrSet2QidList((format(QIL) AtS)) 
    = ('format QIL attrSet2QidList(AtS)) .
  eq attrSet2QidList((ctor AtS))  = ('ctor attrSet2QidList(AtS)) .
  eq attrSet2QidList((frozen(NL) AtS))
    = ('frozen '`( intList2QidList(NL) '`) attrSet2QidList(AtS)) .
  eq attrSet2QidList((config AtS))  = ('config attrSet2QidList(AtS)) .
  eq attrSet2QidList((object AtS))  = ('object attrSet2QidList(AtS)) .
  eq attrSet2QidList((msg AtS))  = ('msg attrSet2QidList(AtS)) .
  eq attrSet2QidList((special(HkL) AtS))
    = ('special '`( hookList2QidList(HkL) '`) attrSet2QidList(AtS)) .
  eq attrSet2QidList((none).AttrSet) = nil .

  eq hookList2QidList((id-hook(QI, QIL) HkL))
    = ('id-hook QI '`, '`( QIL '`) hookList2QidList(HkL)) .
  eq hookList2QidList((op-hook(QI, QI', QIL, QI'') HkL))
    = ('op-hook QI '`( QI' ': QIL '-> QI'' '`) hookList2QidList(HkL)) .
  eq hookList2QidList((term-hook(QI, T) HkL))
    = ('term-hook '`( QI '`, termList2QidList(T) '`) hookList2QidList(HkL)) .

  eq termList2QidList(QI) = QI .
  eq termList2QidList(F[TL]) = (F '`( termList2QidList(TL) '`)) .
  ceq termList2QidList((T, TL)) 
    = (termList2QidList(T) '`, termList2QidList(TL)) 
    if TL =/= empty .

  eq intList2QidList((N NL)) = (qid(string(N, 10)) intList2QidList(NL)) .
  eq intList2QidList(nil) = nil .

  eq typeList2QidList(Ty TyL) = Ty typeList2QidList(TyL) .
  eq typeList2QidList(nil) = nil .

*** Let us now give the equations for \texttt{setUpModExpDeps} on the
*** renaming module expression.  Given a module expression of the form
*** \verb~ME *< VMAPS >~ such that \texttt{ME} is in the database, we just need
*** to add \verb~ME *< VMAPS >~ to the set of names of the modules depending on
*** \texttt{ME}. In this way, if \texttt{ME} is redefined or removed from the 
*** database, \verb~ME *< VMAPS >~ will be removed as well.

  eq setUpModExpDeps(ME * (VMAPS), 
       db(< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db(< ME ; DT ; U ; U' ; M ; VDS ; MNS . ME * (VMAPS) ; VES > MIS, 
         MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
  eq setUpModExpDeps(ME * (VMAPS), 
       db(< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, 
          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
    = db(< ME ; DM ; U ; U' ; M ; VDS ; MNS . ME * (VMAPS) ; VES > MIS, 
         MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
  ceq setUpModExpDeps(ME * (VMAPS), DB)
    = warning(DB, '\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n)
    if not unitInDb(ME, DB) .

*** The definition of the \texttt{prepHeader} function on a renaming module
*** expression must take into account the possibility of having parameterized
*** sorts or parameterized class names in the maps of a renaming module
*** expression.  The preparation of a renaming module expression must take
*** into account this fact and prepare accordingly all parameterized sorts and 
*** classes appearing in it.

  op prepare : RenamingSet Set<Tuple<ViewExp|ViewExp>> -> RenamingSet .

  op prepare : TypeList Set<Tuple<ViewExp|ViewExp>> -> TypeList .

  eq prepModExp(ME * (VMAPS), VEPS)
    = _*`(_`)(prepModExp(ME, VEPS), prepare(VMAPS, VEPS)) .

*** For example, for sort maps the equation is as follows.

  eq prepare((sort S to S'), VEPS)
    = (sort prepSort(S, VEPS) to prepSort(S', VEPS)) .
  eq prepare(((sort S to S'), VMAPS), VEPS)
    = ((sort prepSort(S, VEPS) to prepSort(S', VEPS)), 
       prepare(VMAPS, VEPS)) .


  eq prepare((class S to S'), VEPS)
    = (class prepSort(S, VEPS) to prepSort(S', VEPS)) .
  eq prepare(((class S to S'), VMAPS), VEPS)
    = ((class prepSort(S, VEPS) to prepSort(S', VEPS)), 
       prepare(VMAPS, VEPS)) .
  eq prepare((attr QI . S to QI'), VEPS)
    = (attr QI . prepSort(S, VEPS) to QI') .
  eq prepare(((attr QI . S to QI'), VMAPS), VEPS)
    = ((attr QI . prepSort(S, VEPS) to QI'), prepare(VMAPS, VEPS)) .
  eq prepare((op F to F' [AtS]), VEPS) = (op F to F' [AtS]) .
  eq prepare(((op F to F' [AtS]), VMAPS), VEPS)
    = ((op F to F' [AtS]), prepare(VMAPS, VEPS)) .
  eq prepare((op F : TyL -> Ty to F' [AtS]), VEPS)
    = (op F : prepare(TyL, VEPS) -> prepSort(Ty, VEPS) to F' [AtS]) .
  eq prepare(((op F : TyL -> Ty to F' [AtS]), VMAPS), VEPS)
    = (op F : prepare(TyL, VEPS) -> prepSort(Ty, VEPS) to F' [AtS],
       prepare(VMAPS, VEPS)) .
  eq prepare((label L to L'), VEPS) = (label L to L') .
  eq prepare(((label L to L'), VMAPS), VEPS)
    = ((label L to L'), prepare(VMAPS, VEPS)) .
  eq prepare((msg F to F'), VEPS) = (msg F to F') .
  eq prepare(((msg F to F'), VMAPS), VEPS)
    = ((msg F to F'), prepare(VMAPS, VEPS)) .
  eq prepare((msg F : TyL -> Ty to F'), VEPS)
    = (msg F : prepare(TyL, VEPS) -> prepSort(Ty, VEPS) to F') .
  eq prepare(((msg F : TyL -> Ty to F'), VMAPS), VEPS)
    = ((msg F : prepare(TyL, VEPS) -> prepSort(Ty, VEPS) to F'),
       prepare(VMAPS, VEPS)) .
  eq prepare((none).RenamingSet, VEPS) = none .

  eq prepare((Ty TyL), VEPS) = (prepSort(Ty, VEPS) prepare(TyL, VEPS)) .
  eq prepare(nil, VEPS) = nil .

  eq header2Qid(ME * (MAPS))
    = qid(string(header2Qid(ME)) 
          + " * (" + string(qidList2Qid(maps2QidList(MAPS))) + ")") 
    [owise] .

  ceq header2QidList(ME * (MAPS))
    = (if QI == '\s then QIL QI else QIL QI '\s fi 
       '* '\s '`( maps2QidList(MAPS) '`))
    if QIL QI := header2QidList(ME) 
    [owise] .

endfm

*******************************************************************************

***
*** The Union Module Expression
***

*** The syntax used for the union of module expressions is

***   op _+_ : ModuleExpression ModuleExpression -> ModuleExpression 
***       [assoc prec 42] .

*** Its evaluation consists in generating a unit importing the two module
*** expressions given as arguments~\cite{Winkler91,OBJ92}.
 
*** As we explained in Sections~\ref{instantiation} and~\ref{renaming} for the
*** cases of the instantiation and the renaming module expressions,
*** respectively, the declaration of any new kind of module expression must
*** come together with the definition of the functions \texttt{evalModExp},
*** \texttt{header2QidList}, and \texttt{setUpModExpDeps} on the new
*** module operator. As discussed in Sections~\ref{instantiation}
*** and~\ref{parsing-unit-declarations}, equations for the \texttt{prepHeader}
*** and \texttt{parseModExp} functions have to be given as well.

fmod UNION-EXPR is
  inc MOD-EXPR .
  pr INST-EXPR-EVALUATION .
  pr RENAMING-EXPR-EVALUATION .
  pr EVALUATION .

  vars QI X : Qid .
  var  PDL : ParameterDeclList .
  vars DB DB' DB'' : Database .
  vars T T' : Term .
  vars DT DT' : Default{Term} .
  var  IL : ImportList .
  var  VEPS : Set<Tuple<ViewExp|ViewExp>> .
  vars ME ME' ME'' ME3 : ModuleExpression .
  vars PU PU' U U' U'' U3 DM DM' : Module .
  vars M M' M'' M3 : Module .
  vars MNS MNS' MNS'' MNS3 MNS4 MNS5 : Set{ModuleName} .
  vars VES VES' VES'' : Set{ViewExp} .
  vars PDS PDS' PDS'' : Set{ParameterDecl} .
  vars MIS MIS' : Set{ModuleInfo} .
  var  VIS : Set{ViewInfo} .
  vars QIL QIL' : QidList .
  var  VDS VDS' : OpDeclSet .
  var  B : Bool .
  var  MAPS : RenamingSet .

*** As mentioned above, the evaluation of a union module expression consists
*** in the creation of a new unit, with such a module expression as name,
*** which imports the two module expressions being united. Note, however,
*** that the unit being created has to be of the right type. The new unit
*** will be generated having one type or another, depending on the types of 
*** the arguments of the union module expression.

*** The function \texttt{rightEmptyModule} generates an empty unit of the 
*** lowest of the sorts of its two arguments. In case of having a nonstructured
*** module as argument, the corresponding structured one is considered. If one
*** of the two module expressions corresponds to a theory, then a theory is
*** generated, and the lowest sort is taken between the sort of such a theory
*** and the \texttt{Module} sort immediately above the sort of the other unit; 
*** that is, sorts \texttt{FModule}, \texttt{SModule}, or \texttt{OModule} are 
*** considered to do the comparison.

----  ceq evalModExpAux(ME + ME', PDL, DB)
----    = if unitInDb(ME'' + ME3, DB'') or-else not (unitInDb(ME'', DB'') and-then unitInDb(ME3, DB''))  
----      then < DB'' ; ME'' + ME3 >
----      else < evalModule(
----                    addImports(including ME'' . including ME3 .,
----                      setName(
----                        rightEmptyModule(
----                          getTopModule(ME'', DB''), 
----                          getTopModule(ME3, DB'')),
----                        ME'' +  ME3)), 
----                    none,
----                    DB'') ;
----                  ME'' +  ME3 >
----      fi 
----    if < DB' ; ME3 > := evalModExpAux(ME', PDL, DB)
----    /\ < DB'' ; ME'' > := evalModExpAux(ME, PDL, DB') .

  ceq evalModExp(ME + ME', PDL, DB)
    = if unitInDb(ME'', DB') or-else not summandsInDB(ME'', DB')  
      then < DB' ; ME'' >
      else < evalModule(
               addImports(unfoldSummands(ME''),
                 setName(rightEmptyModule(ME'', DB'), ME'')), 
               none,
               DB') 
             ; ME'' >
      fi 
    if < DB' ; ME'' > := evalModExp+(ME + ME', PDL, DB) .

  op summandsInDB : ModuleExpression Database -> Bool .
  eq summandsInDB(ME + ME', DB) 
    = summandsInDB(ME, DB) and-then summandsInDB(ME', DB) . 
  eq summandsInDB(ME, DB) = unitInDb(ME, DB) [owise] .
  
  op unfoldSummands : ModuleExpression -> ImportList .
  eq unfoldSummands(ME + ME') = unfoldSummands(ME) unfoldSummands(ME') . 
  eq unfoldSummands(ME) = (including ME .) [owise] . 

  op rightEmptyModule : ModuleExpression Database -> Module .
  eq rightEmptyModule(ME, DB) = emptyModule(kindOfModule(ME, DB)) .

  op evalModExp+ : ModuleExpression ParameterDeclList Database -> Tuple{Database, ModuleExpression} . 
  eq evalModExp+(ME + ME', PDL, DB)
    = < database(evalModExp+(ME', PDL, database(evalModExp+(ME, PDL, DB))))
      ; modExp(evalModExp+(ME', PDL, database(evalModExp+(ME, PDL, DB)))) 
        + modExp(evalModExp+(ME, PDL, DB)) > .
  eq evalModExp+(ME, PDL, DB) = evalModExp(ME, PDL, DB) [owise] .

  op kindOfModule : ModuleExpression Database -> Qid .
  eq kindOfModule(ME + ME', DB) = greaterLowest(kindOfModule(ME, DB), kindOfModule(ME', DB)) .
  eq kindOfModule(ME, DB) = kindOfModule(getTopModule(ME, DB)) [owise] .
  
  op kindOfModule : Module -> Qid .
  eq kindOfModule(U:OModule) 
    = if U:OModule :: FModule
      then 'fmod 
      else if U:OModule :: SModule
           then 'mod
           else 'omod
           fi
      fi .
  eq kindOfModule(U:OTheory) 
    = if U:OTheory :: FTheory
      then 'fmod 
      else if U:OTheory :: STheory
           then 'mod
           else 'omod
           fi
      fi .
  eq kindOfModule(unitError(QIL)) = qidError(QIL) . 
  
  op greaterLowest : Qid Qid ~> Qid [comm] .
  eq greaterLowest('fmod, 'fmod) = 'fmod .
  eq greaterLowest('fmod, 'fth) = 'fth .
  eq greaterLowest('fth, 'fth) = 'fth .
  eq greaterLowest('mod, 'fmod) = 'mod .
  eq greaterLowest('mod, 'mod) = 'mod .
  eq greaterLowest('mod, 'fth) = 'th .
  eq greaterLowest('fmod, 'th) = 'th .
  eq greaterLowest('mod, 'th) = 'th .
  eq greaterLowest('th, 'th) = 'th .
  eq greaterLowest('omod, 'fmod) = 'omod .
  eq greaterLowest('omod, 'mod) = 'omod .
  eq greaterLowest('omod, 'omod) = 'omod .
  eq greaterLowest('omod, 'fth) = 'oth .
  eq greaterLowest('omod, 'th) = 'oth .
  eq greaterLowest('omod, 'oth) = 'oth .
  eq greaterLowest('fmod, 'oth) = 'oth .
  eq greaterLowest('mod, 'oth) = 'oth .
  eq greaterLowest('oth, 'th) = 'oth .
  eq greaterLowest('oth, 'fth) = 'oth .
  eq greaterLowest('oth, 'oth) = 'oth .

  op emptyModule : Qid ~> Module .
  eq emptyModule('fmod) = emptyFModule .
  eq emptyModule('fth) = emptyFTheory .
  eq emptyModule('mod) = emptySModule .
  eq emptyModule('th) = emptySTheory .
  eq emptyModule('omod) = emptyOModule .
  eq emptyModule('oth) = emptyOTheory .
  
----  op rightEmptyModule : Module Module -> Module [comm] .
----
----  eq rightEmptyModule(U1:FModule, U2:FModule) = emptyFModule .
----  eq rightEmptyModule(U1:FModule, U2:FTheory) = emptyFTheory .
----  eq rightEmptyModule(U1:FTheory, U2:FModule) = emptyFTheory .
----  eq rightEmptyModule(U1:FTheory, U2:FTheory) = emptyFTheory .
----  ceq rightEmptyModule(U1:SModule, U2:SModule) = emptySModule if not U1:SModule :: FModule or not U2:SModule :: FModule .
----  ceq rightEmptyModule(U1:STheory, U2:SModule) = emptySTheory if not U1:STheory :: FTheory or not U2:SModule :: FModule .
----  ceq rightEmptyModule(U1:SModule, U2:STheory) = emptySTheory if not U1:SModule :: FModule or not U2:STheory :: FTheory .
----  ceq rightEmptyModule(U1:STheory, U2:STheory) = emptySTheory if not U1:STheory :: FTheory or not U2:STheory :: FTheory .
----  ceq rightEmptyModule(U1:OModule, U2:OModule) = emptyOModule if not U1:OModule :: SModule or not U2:OModule :: SModule .
----  ceq rightEmptyModule(U1:OTheory, U2:OModule) = emptyOTheory if not U1:OTheory :: STheory or not U2:OModule :: SModule .
----  ceq rightEmptyModule(U1:OModule, U2:OTheory) = emptyOTheory if not U1:OModule :: SModule or not U2:OTheory :: STheory .
----  ceq rightEmptyModule(U1:OTheory, U2:OTheory) = emptyOTheory if not U1:OTheory :: STheory or not U2:OTheory :: STheory .
----  eq rightEmptyModule(unitError(QIL), U) = unitError(QIL) .
----  eq rightEmptyModule(U, unitError(QIL)) = unitError(QIL) .
----  eq rightEmptyModule(unitError(QIL), unitError(QIL')) = unitError(QIL QIL') .

*** As pointed out in Section~\ref{module-names}, for each new module
*** expression operator being introduced, we need to add equations for the
*** \texttt{header2Qid} function. For the union module expression we only
*** need the following equation:

  eq header2Qid(ME + ME') 
    = qidList2Qid(header2QidList(ME) '+ header2QidList(ME')) .
  eq header2Qid(_*`(_`)(ME + ME', MAPS))
    = qid("(" + string(header2Qid(ME + ME')) + ")"
          + " * (" + string(qidList2Qid(maps2QidList(MAPS))) + ")") .

  eq header2QidList(ME + ME') 
    = (header2QidList(ME) '+ header2QidList(ME')) .
  ceq header2QidList(_*`(_`)(ME + ME', MAPS))
    = (if QI == '\s then '`( QIL '`) QI else '`( QIL QI '`) '\s fi 
       '* '\s '`( maps2QidList(MAPS) '`))
    if QIL QI := header2QidList(ME + ME') .

*** Given a module
*** expression of the form \verb~ME + ME'~ such that \texttt{ME} and
*** \texttt{ME'} are in the database, we need to add \verb~ME + ME'~ to
*** the set of names of the modules depending on \texttt{ME} and \texttt{ME'}. 
*** In this way, if \texttt{ME} or \texttt{ME'} are redefined or removed from 
*** the database, \verb~ME + ME'~ will be removed as well.

  op setUpModExpDepsAux : ModuleExpression ModuleExpression Database -> Database .
  eq setUpModExpDeps(ME + ME', DB) = setUpModExpDepsAux(ME + ME', ME + ME', DB) .

  eq setUpModExpDepsAux(ME, ME' + ME'', DB)
   = setUpModExpDepsAux(ME, ME', setUpModExpDepsAux(ME, ME'', DB)) .
  eq setUpModExpDepsAux(ME, ME',
      db(< ME' ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL))
   = db(< ME' ; DT ; U ; U' ; M ; VDS ; MNS . ME ; VES > MIS, MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) 
   [owise] .
  eq setUpModExpDepsAux(ME, ME',
      db(< ME' ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL))
   = db(< ME' ; DM ; U ; U' ; M ; VDS ; MNS . ME ; VES > MIS, MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL)  
   [owise] .

---(  eq setUpModExpDeps((ME + ME'), 
      db((< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > 
          < ME' ; DT' ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS), 
         MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL))
   = db((< ME ; DT ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES > 
         < ME' ; DT' ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' > 
         MIS),
        MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) .
  eq setUpModExpDeps((ME + ME'), 
      db((< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > 
          < ME' ; DM ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS), 
         MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL))
   = db((< ME ; DT ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES > 
         < ME' ; DM ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' > 
         MIS),
        MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) .
  eq setUpModExpDeps((ME + ME'), 
      db((< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > 
          < ME' ; DT ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS), 
         MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL))
   = db((< ME ; DM ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES > 
         < ME' ; DT ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' > 
         MIS),
        MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) .
  eq setUpModExpDeps((ME + ME'), 
      db((< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > 
          < ME' ; DM' ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS), 
         MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL))
   = db((< ME ; DM ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES > 
         < ME' ; DM' ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' > 
         MIS),
        MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) .
  ceq setUpModExpDeps((ME + ME'), DB)
    = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n))
    if not unitInDb(ME, DB) .
  ceq setUpModExpDeps((ME + ME'), DB)
    = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME') 'not 'in 'database. '\n))
    if not unitInDb(ME', DB) .
---)

*** The \texttt{prepHeader} function on a union module expression makes
*** recursive calls with each of the module expressions given as arguments.

  eq prepModExp(ME + ME', VEPS) 
    = prepModExp(ME, VEPS) + prepModExp(ME', VEPS) .

*** Finally, the equation for the \texttt{parseModExp} function is as follows:

  eq labelInModExp(X, ME + ME') 
    = labelInModExp(X, ME) or-else labelInModExp(X, ME') .
endfm

*******************************************************************************

***
*** The $n$-tuple Module Expression
***

*** The syntax used for the $n$-tuple module expression is as follows:

***   op TUPLE[_] : Token -> ModuleExpression .

*** Its evaluation consists in the generation of a parameterized functional
*** module with the number of \texttt{TRIV} parameters specified by the
*** argument. A sort for tuples of such size, and the corresponding constructor
*** and selector operators, are also defined. Note that the \texttt{TRIV}
*** theory is predefined in Full Maude (see Sections~\ref{main-module}
*** and~\ref{non-built-in-predefined}). For example, the module expression 
*** \verb~TUPLE[3]~ produces the following module.

*** fmod TUPLE[3][C1 :: TRIV, C2 :: TRIV, C3 :: TRIV] is 
***    sorts 3Tuple . 
***    op (_,_,_) : Elt.C1 Elt.C2 Elt.C3 -> 3Tuple . 
***    op p1_ : 3Tuple -> Elt.C1 . 
***    op p2_ : 3Tuple -> Elt.C2 . 
***    op p3_ : 3Tuple -> Elt.C3 . 
***    var E1 : Elt.C1 . 
***    var E2 : Elt.C2 . 
***    var E3 : Elt.C3 . 
***    eq p1(E1, E2, E3) = E1 . 
***    eq p2(E1, E2, E3) = E2 . 
***    eq p3(E1, E2, E3) = E3 . 
*** endfm

*** Even though the $n$-tuple module expression is in principle of a completely
*** different nature, the way of handling it is the same as the way of handling
*** any other module expression. Its evaluation produces a new unit, a
*** parameterized functional module in this case, wtupleParList(N)ith the module expression as
*** name. New equations defining the semantics of functions
*** \texttt{evalModExp}, \texttt{header2QidList}, 
*** \texttt{setUpModExpDeps}, \texttt{prepHeader}, and 
*** \texttt{parseModExp} are given for this module expression.


fmod N-TUPLE-EXPR is
  inc MOD-EXPR .
  pr INST-EXPR-EVALUATION .
  pr EVALUATION .

  vars N N' : NzNat .
  var  PDL : ParameterDeclList .
  var  DB : Database .
  var  T : Term .
  var  IL : ImportList .
  var  VEPS : Set<Tuple<ViewExp|ViewExp>> .
  var  X : Qid .
  var  S : Sort .

*** The equation for the \texttt{evalModExp} is reduced to the creation of a
*** module as indicated above. Some auxiliary functions are defined in order
*** to generate the different declarations in the module.

  op tupleParList : NzNat -> ParameterDeclList .
  op tupleImportList : NzNat -> ImportList .
  op createCopyPars : NzNat Database -> Database .
  op tupleOps : NzNat -> OpDeclSet .
  op tupleOpsCtor : NzNat -> OpDecl .
  op tupleOpsCtorName : NzNat -> String .
  op tupleOpsCtorArity : NzNat -> QidList .
  op tupleOpsSelectors : NzNat NzNat -> OpDeclSet .
  op tupleEqSet : NzNat -> EquationSet .
  op tupleEqSetAux : NzNat Term -> EquationSet .
  op tupleTermArgs : NzNat -> TermList .
  ops tupleSort tupleSortAux : NzNat -> Sort .

  eq evalModExp(TUPLE[N], PDL, DB)
    = if unitInDb(TUPLE[N], DB) 
      then < DB ; TUPLE[N] >
      else < evalModule(
               fmod TUPLE[N]{tupleParList(N)} is
                 nil  ---- tupleImportList(N)
                 sorts tupleSort(N) .
                 none
                 tupleOps(N)
                 none
                 tupleEqSet(N)
               endfm, 
               none,
               createCopyPars(N, DB)) ; 
             TUPLE[N] >
      fi .

  eq createCopyPars(N, DB)
    = if N == 1
      then createCopy((qid("C" + string(N, 10)) :: 'TRIV), DB)
      else createCopyPars(_-_(N, 1), 
             createCopy((qid("C" + string(N, 10)) :: 'TRIV), DB))
      fi .

  eq tupleParList(N)
    = if N == 1
      then (qid("C" + string(N, 10)) :: 'TRIV)
      else (tupleParList(_-_(N, 1)), (qid("C" + string(N, 10)) :: 'TRIV))
      fi .

  eq tupleImportList(N)
    = if N == 1
      then (including pd(qid("C" + string(N, 10)) :: 'TRIV) .)
      else (tupleImportList(_-_(N, 1)) 
            (including pd(qid("C" + string(N, 10)) :: 'TRIV) .))
      fi .

  eq tupleSort(N) = makeSort('Tuple, tupleSortAux(N)) .

  eq tupleSortAux(N)
    = if N == 1
      then qid("C" + string(N, 10))
      else (tupleSortAux(_-_(N, 1)), qid("C" + string(N, 10)))
      fi .

  eq tupleOps(N) 
    = (tupleOpsCtor(N) tupleOpsSelectors(N, N)) .

  eq tupleOpsCtor(N)
    = (op qid("(" + tupleOpsCtorName(N) + ")") : 
            tupleOpsCtorArity(N) -> tupleSort(N) [none] .) .

  eq tupleOpsCtorName(N)
    = if N == 1
      then "_"
      else "_," + tupleOpsCtorName(_-_(N, 1))
      fi .

  eq tupleOpsCtorArity(N)
    = if N == 1
      then qid("C" + string(N, 10) + "$Elt")
      else tupleOpsCtorArity(_-_(N, 1)) qid("C" + string(N, 10) + "$Elt")
      fi .

  eq tupleOpsSelectors(N, N')
    = if N == 1 
      then (op qid("p" + string(N, 10) + "_") : 
                 tupleSort(N') -> qid("C" + string(N, 10) + "$Elt") [none] .)
      else (tupleOpsSelectors(_-_(N, 1), N')
            (op qid("p" + string(N, 10) + "_") : 
                  tupleSort(N') -> qid("C" + string(N, 10) + "$Elt") [none] .))
      fi .

  eq tupleEqSet(N)
    = tupleEqSetAux(N, 
        (qid("(" + tupleOpsCtorName(N) + ")") [ tupleTermArgs(N) ])) .

  eq tupleTermArgs(N)
    = if N == 1  
      then qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt")
      else (tupleTermArgs(_-_(N, 1)), 
            qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt"))
      fi .

  eq tupleEqSetAux(N, T)
    = if N == 1 
      then (eq qid("p" + string(N, 10) + "_")[T] 
              = qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt") 
              [none] .)
      else (tupleEqSetAux(_-_(N, 1), T) 
            (eq qid("p" + string(N, 10) + "_")[T] 
               = qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt") 
               [none] .))
      fi .

*** The equations for the \texttt{header2QidList}, 
*** \texttt{parseModExp}, \texttt{prepHeader}, and 
*** \texttt{setUpModExpDeps} functions on the $n$-tuple module
*** expression are as follows:

  eq header2Qid(TUPLE[N]) = qid("TUPLE[" + string(N, 10) + "]") .
  eq header2QidList(TUPLE[N]) = ('TUPLE '`[ qid(string(N, 10)) '`]) .

  eq prepModExp(TUPLE[N], VEPS) = TUPLE[N] .

  eq setUpModExpDeps(TUPLE[N], DB) = DB .

endfm

fmod N-POWER-EXPR is
  inc MOD-EXPR .
  pr INST-EXPR-EVALUATION .
  pr EVALUATION .

  vars N N' : NzNat .
  var  PDL : ParameterDeclList .
  var  DB : Database .
  var  T : Term .
  var  IL : ImportList .
  var  VEPS : Set<Tuple<ViewExp|ViewExp>> .
  var  X : Qid .
  var  S : Sort .

*** As for TUPLE, the equation for the \texttt{evalModExp} is reduced to the 
*** creation of a new module. A module expression POWER[n]{Nat} produces a 
*** module
***
*** fmod POWER[n]{X :: TRIV} is
***   inc TUPLE[n]{X, X, ..., X} .
*** endfm
*** 
*** which is then instantiated by the Nat view.

*** Some auxiliary functions are defined in order
*** to generate the different declarations in the module.

  op powImportList : NzNat -> ImportList .
  op powTupleImportation : NzNat -> ViewExp .

  eq evalModExp(POWER[N], PDL, DB)
    = if unitInDb(POWER[N], DB) 
      then < DB ; POWER[N] >
      else < evalModule(
               fmod POWER[N]{'X :: 'TRIV} is
                 powImportList(N)
                 sorts none .
                 none
                 none
                 none
                 none
               endfm, 
               none,
               createCopy('X :: 'TRIV, DB)) ; 
             POWER[N] >
      fi .

  eq powImportList(N)
    = (including TUPLE[N]{powTupleImportation(N)} .) .

  eq powTupleImportation(N)
    = if N == 1
      then 'X
      else ('X, powTupleImportation(sd(N, 1)))
      fi .

*** The equations for the \texttt{header2QidList}, 
*** \texttt{parseModExp}, \texttt{prepHeader}, and 
*** \texttt{setUpModExpDeps} functions on the $n$-tuple module
*** expression are as follows:

  eq header2Qid(POWER[N]) = qid("POWER[" + string(N, 10) + "]") .
  eq header2QidList(POWER[N]) = ('POWER '`[ qid(string(N, 10)) '`]) .

  eq prepModExp(POWER[N], VEPS) = POWER[N] .

  eq setUpModExpDeps(POWER[N], DB) = DB .

endfm

*******************************************************************************

***
*** 8 Input/Output Processing
***

*** In this section we discuss how the preterm resulting from the call to the
*** function \texttt{metaParse} with the input and the top-level signature of
*** Full Maude is transformed into a term of sort \texttt{Module}, representing
*** a preunit or a term of sort \texttt{PreView}. In the case of commands, 
*** they are evaluated giving the corresponding results in the appropriate 
*** form.

*** 
*** 8.1 Input Parsing
***

*** Let us recall here the example presented in Section~\ref{bubbles}. Calling
*** \texttt{metaParse} with the module \texttt{NAT3} given there and the
*** signature of Full Maude presented in Section~\ref{sec:signature}, we 
*** obtain the following term.

***    'fmod_is_endfm[
***       'token[{''NAT3}'Qid], 
***       '__['sort_.['token[{''Nat3}'Qid]], 
***           '__['op_:_->_.['token[{''s_}'Qid], 
***                          'neTokenList[{''Nat3}'Qid], 
***                          'token[{''Nat3}'Qid]], 
***               '__['op_:`->_.['token[{''0}'Qid], 
***                              'token[{''Nat3}'Qid]], 
***                   'eq_=_.['bubble['__[{''s}'Qid, {''s}'Qid,  
***                                       {''s}'Qid, {''0}'Qid]], 
***                           'bubble[{''0}'Qid]]]]]]

*** Given each one of the subterms representing declarations in terms
*** representing modules as the previous one, the function \texttt{parseDecl}
*** generates the corresponding declaration, with no bubbles in it, and the
*** corresponding predeclaration, with the bubbles appearing in the term. For 
*** example, for the term
***
***   'op_:_->_.['token[{''s_}'Qid], 
***              'neTokenList[{''Nat3}'Qid], 
***              'token[{''Nat3}'Qid]]
***
*** the following operator declaration is generated:
***
***   op 's_ : 'Nat3 -> 'Nat3 [none] .
***
*** Note that in this case, since the operator is declared without identity
*** element (the only place a bubble might appear), the declaration and the
*** predeclaration generated by \texttt{parseDecl} coincide.

*** In the following sections we shall see how this approach is followed for
*** declarations appearing in units and in views.

***
*** 8.1.1 Parsing of Module Declarations
***

*** The \texttt{parseDecl} function takes a term (which corresponds to a
*** declaration to be parsed), a preunit (to which the parsed declaration with
*** its bubbles in it will be added), and a unit (to which the parsed
*** declaration without bubbles will be added to build up the signature). For
*** example, a term corresponding to an unconditional equation, that is, a term
*** of the form \verb~'eq_=_.[T, T']~ will be added to the set of equations of
*** the preunit as \verb~eq T = T' .~, but nothing will be added to the unit.
*** Note that according to the signature used in the call to
*** \texttt{metaParse} (see Sections~\ref{sec:signature}
*** and~\ref{main-module}), \texttt{T} and \texttt{T'} are bubbles.
*** Declarations of sorts, subsort relations, operators, classes, subclass 
*** relations, messages, and variables will be added to both of them. In the 
*** case of operator declarations, identity element attributes, which in 
*** general can be terms, are not included in the added declaration.

*** As in Core Maude, declarations in a module can be given in any order, and
*** therefore we follow a two-step approach consisting in first building the
*** signature to parse the bubbles, and then generating the unit without
*** bubbles in it. It could be different for other languages. For example, in
*** some languages we may be able to assume that each operator and sort has 
*** been defined before being used, allowing then an incremental processing of 
*** the input.

fmod MAYBE{X :: TRIV} is
  sort Maybe{X} .
  subsort X$Elt < Maybe{X} .
  op maybe : -> Maybe{X} .
endfm

fmod UNIT-DECL-PARSING is
  pr DATABASE .
  pr MOVE-DOWN .
  pr INST-EXPR-EVALUATION .
  pr RENAMING-EXPR-EVALUATION .
  pr UNION-EXPR .
  pr N-TUPLE-EXPR .
  pr N-POWER-EXPR .
  pr MAYBE{Term} .
  pr META-FULL-MAUDE-SIGN .
  pr UNIT-BUBBLE-PARSING .

  vars PU U : Module .
  vars T T' T'' T''' T3 T4 : Term .
  vars QI QI' QI'' L F : Qid .
  vars QIL QIL' : QidList .
  vars S S' : Sort .
  vars SS SS' : Set<Type> .
  vars TyL TyL' : TypeList .
  var  TSL : List<Set<Type>> .
  var  AtS : AttrSet .
  vars TL TL' TL'' : TermList .
  var  Ct : Constant .
  var  VDS : OpDeclSet .
  vars Ty Tp : Type .
  var  N : Nat .
  var  MT : Maybe{Term} .

*** Similarly, auxiliary functions parsing other elements in units 
*** are defined.

  op parsePreAttrs : Term Nat -> AttrSet .
  op parsePreHookList : Term -> HookList .
  op parseVars : QidList [Type] -> OpDeclSet .
  op parseSubsortRel : Term -> Set<TypeList> .

  op parseAttrDeclList : Term -> AttrDeclSet .
  op unfoldOpDecl : QidList TypeList Sort AttrSet -> OpDeclSet .
  op unfoldMultipleMsgDecl : QidList TypeList Sort -> MsgDeclSet .
  op unfoldSubsortRel : List<Set<Type>> ~> SubsortDeclSet .
  op unfoldSubclassRel : List<Set<Type>> ~> SubclassDeclSet .

  eq parseSubsortRel('_<_[T, T']) 
    = _l_(parseSortSet(T), parseSubsortRel(T')) .
  eq parseSubsortRel('__[T, T']) = parseSortSet('__[T, T']) .
  eq parseSubsortRel('sortToken[T]) = downQid(T) .
  eq parseSubsortRel('_`{_`}['sortToken[T], T']) 
    = makeSort(downQid(T), parseParameterList(T')) .
  eq parseSubsortRel('_`{_`}['_`{_`}[T, T'], T''])
    = makeSort(parseSubsortRel('_`{_`}[T, T']), parseParameterList(T'')) .

  eq unfoldOpDecl((QI QIL), TyL, Ty, AtS)
    = ((op QI : TyL -> Ty [AtS] .) unfoldOpDecl(QIL, TyL, Ty, AtS)) .
  eq unfoldOpDecl(nil, TyL, Ty, AtS) = none .

  eq unfoldMultipleMsgDecl((QI QIL), TyL, Ty)
    = ((msg QI : TyL -> Ty .) unfoldMultipleMsgDecl(QIL, TyL, Ty)) .
  eq unfoldMultipleMsgDecl(nil, TyL, Ty) = none .

  eq unfoldSubsortRel(_l_((S ; SS), (S' ; SS'), TSL))
    = ((subsort S < S' .)
       unfoldSubsortRel(_l_(S, SS'))
       unfoldSubsortRel(_l_(SS, (S' ; SS')))
       unfoldSubsortRel(_l_((S' ; SS'), TSL))) .
  eq unfoldSubsortRel(_l_(SS, none)) = none .
  eq unfoldSubsortRel(_l_(none, SS)) = none .
  eq unfoldSubsortRel(SS) = none .
  eq unfoldSubsortRel(qidError(QIL)) = subsortDeclError(QIL) .

  eq unfoldSubclassRel(_l_((S ; SS), (S' ; SS'), TSL))
    = ((subclass S < S' .)
       unfoldSubclassRel(_l_(S, SS'))
       unfoldSubclassRel(_l_(SS, (S' ; SS')))
       unfoldSubclassRel(_l_((S' ; SS'), TSL))) .
  eq unfoldSubclassRel(_l_(SS, none)) = none .
  eq unfoldSubclassRel(_l_(none, SS)) = none .
  eq unfoldSubclassRel(SS) = none .
  eq unfoldSubclassRel(qidError(QIL)) = subclassDeclError(QIL) .

  eq parseVars((QI QIL), Tp) 
    = ((op QI : nil -> Tp [none] .) parseVars(QIL, Tp)) .
  eq parseVars(nil, Tp) = none .
  eq parseVars(QIL, qidError(QIL')) = opDeclError(QIL') .

  eq parsePreAttrs('__[T, T'], N) 
    = (parsePreAttrs(T, N) parsePreAttrs(T', N)) .
  eq parsePreAttrs('assoc.@Attr@, N) = assoc .
  eq parsePreAttrs('associative.@Attr@, N) = assoc .
  eq parsePreAttrs('comm.@Attr@, N) = comm .
  eq parsePreAttrs('commutative.@Attr@, N) = comm .
  eq parsePreAttrs('idem.@Attr@, N) = idem .
  eq parsePreAttrs('idempotent.@Attr@, N) = idem .
  eq parsePreAttrs('id:_[T], N) = id(T) .
  eq parsePreAttrs('identity:_[T], N) = id(T) .
  eq parsePreAttrs('left`id:_[T], N) = left-id(T) .
  eq parsePreAttrs('left`identity:_[T], N) = left-id(T) .
  eq parsePreAttrs('right`id:_[T], N) = right-id(T) .
  eq parsePreAttrs('right`identity:_[T], N) = right-id(T) .
  eq parsePreAttrs('poly`(_`)[T], N) = poly(parseInt(T)) .
  eq parsePreAttrs('strat`(_`)[T], N) = strat(parseInt(T)) .
  eq parsePreAttrs('strategy`(_`)[T], N) = strat(parseInt(T)) .
  eq parsePreAttrs('frozen.@Attr@, N) 
    = if N == 0 
      then none 
      else frozen(from 1 to N list)
      fi .
  eq parsePreAttrs('frozen`(_`)[T], N) = frozen(parseInt(T)) .
  eq parsePreAttrs('memo.@Attr@, N) = memo .
  eq parsePreAttrs('memoization.@Attr@, N) = memo .
  eq parsePreAttrs('ctor.@Attr@, N) = ctor .
  eq parsePreAttrs('constructor.@Attr@, N) = ctor .
  eq parsePreAttrs('prec_['token[T]], N) = prec(parseNat(T)) .
  eq parsePreAttrs('gather`(_`)['neTokenList[T]], N) = gather(downQidList(T)) .
  eq parsePreAttrs('special`(_`)[T], N) = special(parsePreHookList(T)) .
  eq parsePreAttrs('format`(_`)['neTokenList[T]], N) = format(downQidList(T)) .
  eq parsePreAttrs('iter.@Attr@, N) = iter .
  eq parsePreAttrs('ditto.@Attr@, N) = ditto .
  eq parsePreAttrs('config.@Attr@, N) = config .
  eq parsePreAttrs('object.@Attr@, N) = object .
  eq parsePreAttrs('msg.@Attr@, N) = msg .
  eq parsePreAttrs('message.@Attr@, N) = msg .

  eq parsePreHookList('__[T, TL]) = parsePreHookList(T) parsePreHookList(TL) .
  eq parsePreHookList('id-hook_['token[T]]) = id-hook(downQid(T), nil) .
  eq parsePreHookList('id-hook_`(_`)['token[T], 'neTokenList[T']])
    = id-hook(downQid(T), downQidList(T')) .
  eq parsePreHookList(
       'op-hook_`(_:_->_`)[
          'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]])
    = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) .
  eq parsePreHookList('op-hook_`(_:`->_`)['token[T], 'token[T'], 'token[T'']])
    = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) .
  eq parsePreHookList(
       'op-hook_`(_:_~>_`)[
          'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]])
    = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) .
  eq parsePreHookList('op-hook_`(_:`~>_`)['token[T], 'token[T'], 'token[T'']])
    = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) .
  eq parsePreHookList('term-hook_`(_`)['token[T], T']) 
    = term-hook(downQid(T), T') .

  eq parseAttrDeclList('_`,_[T, T']) 
    = (parseAttrDeclList(T), parseAttrDeclList(T')) .
  eq parseAttrDeclList('_:_['token[T], T']) 
    = (attr downQid(T) : parseType(T')) .

*** Given a term representing a declaration or a predeclaration, the function
*** \texttt{parseDecl} must generate and update both the unit and the preunit
*** that it takes as arguments. Note that in the case of rules, for example, 
*** only a prerule is generated.

*** Since the preunit and the unit may be modified, they have to be returned as
*** a pair, which will be used to extract the corresponding arguments for the
*** following calls. Note that the \texttt{parseDecl} functions are in fact
*** partial functions. Each parsing function assumes that it is possible to 
*** parse the given term.

  sort ParseDeclResult .
  op <_;_;_> : Module Module OpDeclSet -> ParseDeclResult .
  op preModule : ParseDeclResult -> Module .
  op unit : ParseDeclResult -> Module .
  op vars : ParseDeclResult -> OpDeclSet .

  eq preModule(< PU ; U ; VDS >) = PU .
  eq preModule(< unitError(QIL) ; V:[Module] ; V:[OpDeclSet] >) = unitError(QIL) .
  eq preModule(< V:[Module] ; unitError(QIL) ; V:[OpDeclSet] >) = unitError(QIL) .
  eq preModule(< V:[Module] ; V':[Module] ; opDeclError(QIL) >) = unitError(QIL) .
  eq unit(< PU ; U ; VDS >) = U .
  eq unit(< unitError(QIL) ; V':[Module] ; V:[OpDeclSet] >) = unitError(QIL) .
  eq unit(< V:[Module] ; unitError(QIL) ; V:[OpDeclSet] >) = unitError(QIL) .
  eq unit(< V:[Module] ; V':[Module] ; opDeclError(QIL) >) = unitError(QIL) .
  eq vars(< PU ; U ; VDS >) = VDS .
  eq vars(< unitError(QIL) ; V:[Module] ; V:[OpDeclSet] >) = opDeclError(QIL) .
  eq vars(< V:[Module] ; unitError(QIL) ; V:[OpDeclSet] >) = opDeclError(QIL) .
  eq vars(< V:[Module] ; V':[Module] ; opDeclError(QIL) >) = opDeclError(QIL) .

  op parseDecl : Term Module Module OpDeclSet -> ParseDeclResult .

*** changed 03/27/02
*** In the case of importation declarations, since internally only the 
*** \texttt{including} mode is handled, all importations are generated in 
*** this mode, independently of the keyword used in the input.

  eq parseDecl('inc_.[T], PU, U, VDS) 
    = parseDecl('including_.[T], PU, U, VDS) .
  eq parseDecl('ex_.[T], PU, U, VDS) 
    = parseDecl('extending_.[T], PU, U, VDS) .
  eq parseDecl('pr_.[T], PU, U, VDS) 
    = parseDecl('protecting_.[T], PU, U, VDS) .
  eq parseDecl('including_.[T], PU, U, VDS) 
    = < addImports((including parseModExp(T) .), PU) ; U ; VDS > .
  eq parseDecl('extending_.[T], PU, U, VDS) 
    = < addImports((extending parseModExp(T) .), PU) ; U ; VDS > .
  eq parseDecl('protecting_.[T], PU, U, VDS) 
    = < addImports((protecting parseModExp(T) .), PU) ; U ; VDS > .

  eq parseDecl('sort_.[T], PU, U, VDS) = parseDecl('sorts_.[T], PU, U, VDS) .
  eq parseDecl('sorts_.[T], PU, U, VDS)
    = < addSorts(parseSortSet(T), PU) ; addSorts(parseSortSet(T), U) ; VDS > .

  eq parseDecl('subsort_.[T], PU, U, VDS) 
    = parseDecl('subsorts_.[T], PU, U, VDS) .
  eq parseDecl('subsorts_.[T], PU, U, VDS) 
    = < addSubsorts(unfoldSubsortRel(parseSubsortRel(T)), PU) ;
        addSubsorts(unfoldSubsortRel(parseSubsortRel(T)), U) ; VDS > .

*** As pointed out in Section~\ref{SyntacticalRequirementsAndCaveats}, the 
*** name of operators in operator declaration has to be given as a single 
*** token identifier (see Section~\ref{order-sorted}). We assume that when 
*** declaring a multitoken operator, its name is given as a single quoted 
*** identifier in which each token is preceded by a backquote. Thus, the name 
*** of an operator \verb~_(_)~, for example, is given as \verb~_`(_`)~.

  eq parseDecl('op_:`->_.['token[T], T'], PU, U, VDS)
    = < addOps((op downQid(T) : nil -> parseType(T') [none] .), PU) ;
        addOps((op downQid(T) : nil -> parseType(T') [none] .), U) ; 
        VDS > .
  eq parseDecl('op_:`->_`[_`].['token[T], T', T''], PU, U, VDS)
    = < addOps(
          (op downQid(T) : nil -> parseType(T') [parsePreAttrs(T'', 0)] .), 
          PU) ;
        addOps(
          (op downQid(T) : nil -> parseType(T') [parseAttrs(T'')] .), 
          U) ; 
        VDS > .
  eq parseDecl('op_:_->_.['token[T], T', T''], PU, U, VDS)
    = < addOps(
          (op downQid(T) : parseTypeList(T') -> parseType(T'') [none] .), 
          PU) ;
        addOps(
          (op downQid(T) : parseTypeList(T') -> parseType(T'') [none] .), 
          U) ; 
        VDS > .
  eq parseDecl('op_:_->_`[_`].['token[T], T', T'', T3], PU, U, VDS)
    = < addOps(
          (op downQid(T) : parseTypeList(T') -> parseType(T'') 
               [parsePreAttrs(T3, size(parseTypeList(T')))] .), PU) ;
        addOps(
          (op downQid(T) : parseTypeList(T') -> parseType(T'') 
               [parseAttrs(T3)] .), U) ; 
        VDS > .

  ceq parseDecl('op_:`->_.[F[TL], T], PU, U, VDS)
    = < PU ; U ; VDS > 
    if F =/= 'token .
  ceq parseDecl('op_:`->_`[_`].[F[TL], T, T'], PU, U, VDS)
    = < PU ; U ; VDS > 
    if F =/= 'token .
  ceq parseDecl('op_:_->_.[F[TL], T, T'], PU, U, VDS)
    = < PU ; U ; VDS > 
    if F =/= 'token .
  ceq parseDecl('op_:_->_`[_`].[F[TL], T, T', T''], PU, U, VDS)
    = < PU ; U ; VDS > 
    if F =/= 'token .

  eq parseDecl('ops_:`->_.['neTokenList[T], T'], PU, U, VDS)
    = < addOps(
          unfoldOpDecl(downTypes(T), nil, parseType(T'), none), PU) ;
        addOps(
          unfoldOpDecl(downTypes(T), nil, parseType(T'), none), U) ; 
        VDS > .
  eq parseDecl('ops_:`->_`[_`].['neTokenList[T], T', T''], PU, U, VDS)
    = < addOps(
          unfoldOpDecl(downTypes(T), nil, parseType(T'), 
            parsePreAttrs(T'', 0)),
          PU) ;
        addOps(
          unfoldOpDecl(downTypes(T), nil, parseType(T'), 
            parseAttrs(T'')), 
          U) ; 
        VDS > .
  eq parseDecl('ops_:_->_.['neTokenList[T], T', T''], PU, U, VDS)
    = < addOps(
          unfoldOpDecl(downTypes(T), parseTypeList(T'), 
            parseType(T''), none), 
          PU) ;
        addOps(
          unfoldOpDecl(downTypes(T), parseTypeList(T'), 
            parseType(T''), none), 
          U) ; 
        VDS > .
  eq parseDecl('ops_:_->_`[_`].['neTokenList[T], T', T'', T3], PU, U, VDS)
    = < addOps(
          unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''),
            parsePreAttrs(T3, size(parseTypeList(T')))), PU) ;
        addOps(
          unfoldOpDecl(downTypes(T), 
            parseTypeList(T'), parseType(T''), parseAttrs(T3)), U) ; 
        VDS > .

  eq parseDecl('op_:`~>_.['token[T], T'], PU, U, VDS)
    = < addOps((op downQid(T) : nil -> kind(parseType(T')) [none] .), PU) ;
        addOps((op downQid(T) : nil -> kind(parseType(T')) [none] .), U) ; 
        VDS > .
  eq parseDecl('op_:`~>_`[_`].['token[T], T', T''], PU, U, VDS)
    = < addOps((op downQid(T) : nil -> kind(parseType(T')) 
                    [parsePreAttrs(T'', 0)] .), PU) ;
        addOps((op downQid(T) : nil -> kind(parseType(T')) 
                    [parseAttrs(T'')] .), U) ; 
        VDS > .
  eq parseDecl('op_:_~>_.['token[T], T', T''], PU, U, VDS)
    = < addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T''))
                    [none] .), PU) ;
        addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T''))
                    [none] .), U) ; 
        VDS > .
  eq parseDecl('op_:_~>_`[_`].['token[T], T', T'', T3], PU, U, VDS)
    = < addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T''))
                   [parsePreAttrs(T3, size(parseTypeList(T')))] .), PU) ;
        addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T''))
                   [parseAttrs(T3)] .), U) ; 
        VDS > .

  ceq parseDecl('op_:`~>_.[F[TL], T], PU, U, VDS)
    = < PU ; U ; VDS > 
    if F =/= 'token .
  ceq parseDecl('op_:`~>_`[_`].[F[TL], T, T'], PU, U, VDS)
    = < PU ; U ; VDS > 
    if F =/= 'token .
  ceq parseDecl('op_:_~>_.[F[TL], T, T'], PU, U, VDS)
    = < PU ; U ; VDS > 
    if F =/= 'token .
  ceq parseDecl('op_:_~>_`[_`].[F[TL], T, T', T''], PU, U, VDS)
    = < PU ; U ; VDS > 
    if F =/= 'token .

  eq parseDecl('ops_:`~>_.['neTokenList[T], T'], PU, U, VDS)
    = < addOps(
          unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), none), 
          PU) ;
        addOps(
          unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), none), 
          U) ; 
        VDS > .
  eq parseDecl('ops_:`~>_`[_`].['neTokenList[T], T', T''], PU, U, VDS)
    = < addOps(
          unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), 
            parsePreAttrs(T'', 0)), 
          PU) ;
        addOps(
          unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), 
            parseAttrs(T'')), U) ;
        VDS > .
  eq parseDecl('ops_:_~>_.['neTokenList[T], T', T''], PU, U, VDS)
    = < addOps(
          unfoldOpDecl(downTypes(T), parseTypeList(T'), 
            kind(parseType(T'')), none), 
          PU) ;
        addOps(
          unfoldOpDecl(downTypes(T), parseTypeList(T'), 
            kind(parseType(T'')), none), 
          U) ; 
        VDS > .
  eq parseDecl('ops_:_~>_`[_`].['neTokenList[T], T', T'', T3], PU, 
       U, VDS)
    = < addOps(
          unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''), 
            parsePreAttrs(T3, size(parseTypeList(T')))), 
          PU) ;
        addOps(
          unfoldOpDecl(downTypes(T), 
            parseTypeList(T'), parseType(T''), parseAttrs(T3)), U) ; 
        VDS > .

  eq parseDecl('var_:_.['neTokenList[T], T'], PU, U, VDS)
    = parseDecl('vars_:_.['neTokenList[T], T'], PU, U, VDS) .
  eq parseDecl('vars_:_.['neTokenList[T], T'], PU, U, VDS)
    = < PU ; U ; VDS parseVars(downQidList(T), parseType(T')) > .

  eq parseDecl('mb_:_.['bubble['__[''`[.Qid, L, ''`].Qid]], T], PU, U, VDS) 
    = < addMbs((mb getTerm(breakMb(T, VDS)) : getSort(breakMb(T, VDS)) 
                  [label(downQid(L)) getAttrSet(breakMb(T, VDS))] .), PU) ; U ; VDS > .
  eq parseDecl('mb_:_.[T, T'], PU, U, VDS) 
    = < addMbs((mb T : getSort(breakMb(T', VDS)) [getAttrSet(breakMb(T', VDS))] .), PU) ; U ; VDS > 
    [owise] .
  eq parseDecl('cmb_:_if_.[T, T', T''], PU, U, VDS)
    = < addMbs(
          (cmb T : getSort(breakMb(T', VDS)) 
             if term(pullStmtAttrOut(T'', VDS)) = 'true.Bool 
             [attrSet(pullStmtAttrOut(T'', VDS))] .), PU) ; U ; VDS > .
  eq parseDecl('cmb`[_`]:_:_if_.['token[T'''], T, T', T''], PU, U, VDS)
    = < addMbs(
          (cmb T : getSort(breakMb(T', VDS)) 
             if term(pullStmtAttrOut(T'', VDS)) = 'true.Bool 
             [attrSet(pullStmtAttrOut(T'', VDS)) label(downQid(T'''))] .), PU) ; U ; VDS > . 

  sort Tuple{Maybe{Term},Sort,AttrSet} .

  op breakMb : Term OpDeclSet -> [Tuple{Maybe{Term},Sort,AttrSet}] .
  op breakMbAux : Term TermList AttrSet OpDeclSet -> [Tuple{Maybe{Term},Sort,AttrSet}] .
  op {_,_,_} : Maybe{Term} Sort AttrSet -> Tuple{Maybe{Term},Sort,AttrSet} .
  op getTerm : Tuple{Maybe{Term},Sort,AttrSet} -> Maybe{Term} .
  op getSort : Tuple{Maybe{Term},Sort,AttrSet} -> Sort .
  op getAttrSet : Tuple{Maybe{Term},Sort,AttrSet} -> AttrSet .
  eq getTerm({MT, S, AtS}) = MT .
  eq getTerm({MT, qidError(QIL), AtS}) = MT .
  eq getSort({MT, S, AtS}) = S .
  eq getSort({MT, qidError(QIL), AtS}) = qidError(QIL) .
  eq getAttrSet({MT, S, AtS}) = AtS .
  eq getAttrSet({MT, qidError(QIL), AtS}) = AtS .

----  eq breakMb('bubble[QI]) = {maybe, downQidList(QI), none} .
----  eq breakMb('bubble['__[QI, QI']]) 
----    = {maybe, getType(parseTypeMb('bubble['__[QI, QI']])), none} .
----  eq breakMb('bubble['__[QI, QI', QI'']]) 
----    = {getTerm(parseTypeMb('bubble['__[QI, QI', QI'']])), 
----       getType(parseTypeMb('bubble['__[QI, QI', QI'']])), 
----       none} .
  eq breakMb('bubble['__[QI, QI', TL, QI'']], VDS) 
    = if QI'' =/= ''`].Qid 
      then {getTerm(parseTypeMb('bubble['__[QI, QI', TL, QI'']])), 
            getType(parseTypeMb('bubble['__[QI, QI', TL, QI'']])), 
            none}
      else breakMbAux('bubble['__[QI, QI', TL, QI'']], (QI, QI', TL), none, VDS) 
      fi .
  eq breakMb('sortToken[T], VDS) = {maybe, parseType('sortToken[T]), none} [owise] .
  eq breakMb('_`{_`}[T, T'], VDS) = {maybe, parseType('_`{_`}[T, T']), none} [owise] .
  eq breakMb(T, VDS) = {maybe, getType(parseTypeMb(T)), none} [owise] .

  eq breakMbAux(T, (TL, ''`[.Qid), AtS, VDS) 
    = if AtS =/= none 
      then {maybe, getType(parseTypeMb('bubble[TL])), AtS}
      else {maybe, T, none}
      fi . 
  eq breakMbAux(T, (TL, QI, QI', ''`[.Qid), AtS, VDS) 
    = if AtS =/= none 
      then {getTerm(parseTypeMb('bubble['__[TL, QI, QI']])), 
            getType(parseTypeMb('bubble['__[TL, QI, QI']])), AtS}
      else {getTerm(parseTypeMb(T)), getType(parseTypeMb(T)), none}
      fi . 
  eq breakMbAux(T, (TL, QI, ''nonexec.Qid), AtS, VDS) 
    = breakMbAux(T, (TL, QI), AtS nonexec, VDS) .
  eq breakMbAux(T, (TL, QI, ''owise.Qid), AtS, VDS) 
    = breakMbAux(T, (TL, QI), AtS owise, VDS) .
  eq breakMbAux(T, (TL, QI, ''otherwise.Qid), AtS, VDS) 
    = breakMbAux(T, (TL, QI), AtS owise, VDS) .
  eq breakMbAux(T, (TL, QI, ''label.Qid, QI'), AtS, VDS) 
    = if downQid(QI') :: Qid
      then breakMbAux(T, (TL, QI), AtS label(downQid(QI')), VDS)
      else {maybe, T, none}
      fi .
  eq breakMbAux(T, (TL, QI, ''metadata.Qid, QI'), AtS, VDS) 
    = if downString(downQid(QI')) :: String
      then breakMbAux(T, (TL, QI), AtS metadata(downString(downQid(QI'))), VDS)
      else {maybe, T, none}
      fi .
  ceq breakMbAux(T, (TL, QI, ''`[.Qid, TL',  ''print.Qid, TL''), AtS, VDS) 
    = breakMbAux(T, (TL, QI, ''`[.Qid, TL'), AtS print(printArg(TL'', VDS)), VDS) 
    if printArg(TL'', VDS) : QidList .
  eq breakMbAux(T, TL, AtS, VDS)  = {maybe, T, none} [owise] .

  op parseTypeMb : Term ~> ResultPair .
----  eq parseTypeMb('bubble[T])
----    = parseType(getTerm(metaParse(upModule('EXTENDED-SORTS, false), downQidList(T), '@Sort@))) .
  eq parseTypeMb('bubble[TL])
    = if metaParse(
           addOps(
             op '_:_ : '@Bubble@ '@Sort@ -> '@TermSort@ [none] .,
             addSorts('@TermSort@, GRAMMAR)), 
           downQidList(TL), '@TermSort@) :: ResultPair
      then breakTermSort(
             getTerm(  
               metaParse(
                 addOps(
                   op '_:_ : '@Bubble@ '@Sort@ -> '@TermSort@ [none] .,
                   addSorts('@TermSort@, GRAMMAR)), 
                 downQidList(TL), '@TermSort@)))
      else {maybe, parseType(getTerm(metaParse(GRAMMAR, downQidList(TL), '@Sort@)))}
      fi .
      
  op breakTermSort : Term ~> ResultPair .
  eq breakTermSort('_:_[T, T']) = {T, parseType(T')} .

  eq parseDecl('eq_=_.[T, T'], PU, U, VDS) 
    = < addEqs((eq T = T' [none] .), PU) ; U ; VDS > .
  eq parseDecl('ceq_=_if_.[T, T', T''], PU, U, VDS)
    = < addEqs((ceq T = T' if T'' = 'true.Bool [none] .), PU) ; U ; VDS > .
  eq parseDecl('cq_=_if_.[T, T', T''], PU, U, VDS)
    = < addEqs((ceq T = T' if T'' = 'true.Bool [none] .), PU) ; U ; VDS > .

  eq parseDecl('rl_=>_.[T, T'], PU, U, VDS)
    = < addRls((rl T => T' [none] .), PU) ; U ; VDS > .
  eq parseDecl('crl_=>_if_.[T, T', T''], PU, U, VDS)
    = < addRls((crl T => T' if T'' = 'true.Bool [none] .), PU) ; U ; VDS > .

  eq parseDecl('class_.[T], PU, U, VDS)
    = < addClasses((class parseType(T) | none .), PU) ; 
        addClasses((class parseType(T) | none .), U) ; VDS > .
  eq parseDecl('class_|_.[T, T'], PU, U, VDS)
    = < addClasses((class parseType(T) | parseAttrDeclList(T') .), PU) ; 
        addClasses((class parseType(T) | parseAttrDeclList(T') .), U) ; VDS > .

  eq parseDecl('subclass_.[T], PU, U, VDS)
    = < addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), PU) ;
        addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), U) ; VDS > .
  eq parseDecl('subclasses_.[T], PU, U, VDS)
    = < addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), PU) ;
        addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), U) ; VDS > .

  eq parseDecl('msg_:_->_.['token[T], T', T''], PU, U, VDS)
    = < addMsgs((msg downQid(T) : parseTypeList(T') -> parseType(T'') .), PU) 
        ;
        addMsgs((msg downQid(T) : parseTypeList(T') -> parseType(T'') .), U) 
        ;
        VDS > .
  eq parseDecl('msg_:`->_.['token[T], T'], PU, U, VDS)
    = < addMsgs((msg downQid(T) : nil -> parseType(T') .), PU) ;
        addMsgs((msg downQid(T) : nil -> parseType(T') .), U) ; VDS > .
  eq parseDecl('msgs_:_->_.['neTokenList[T], T', T''], PU, U, VDS)
    = < addMsgs(unfoldMultipleMsgDecl(downQidList(T), parseTypeList(T'), parseType(T'')), PU) ;
        addMsgs(unfoldMultipleMsgDecl(downQidList(T), parseTypeList(T'), parseType(T'')), U) ; 
        VDS > .
  eq parseDecl('msgs_:`->_.['neTokenList[T], T'], PU, U, VDS)
    = < addMsgs(unfoldMultipleMsgDecl(downQidList(T), nil, parseType(T')), PU) ;
        addMsgs(unfoldMultipleMsgDecl(downQidList(T), nil, parseType(T')), U) ; VDS > .

endfm

*******************************************************************************

***
*** 8.1.2 Parsing of View Declarations
***

*** A similar approach is followed for the parsing of declarations in views.

fmod VIEW-DECL-PARSING is
  pr PRE-VIEW .
  pr VIEW .
  pr UNIT .
  pr UNIT-DECL-PARSING .

  vars T T' : Term .
  var  OPDS : OpDeclSet .
  var  MDS : MsgDeclSet .
  var  M : Module .
  vars F F' : Qid .
  vars S S' : Sort .
  vars Ty Ty' : Type .
  vars TyL TyL' : TypeList .
  vars T'' T3 : Term .
  var  PV : PreView .
  var  OPD : OpDecl .
  var  OPDS' : OpDeclSet .
  var  AtS : AttrSet .
  var  MD : MsgDecl .
  var  MDS' : MsgDeclSet .
  var  VDS : OpDeclSet .

*** Operator and message name maps of the form \verb~F to F'~ are substituted
*** by an equivalent set of maps of the form \verb~F : TyL -> S to F'~. One
*** of these maps is added for each family of subsort-overloaded operators in 
*** the source theory of the view.

*** The following functions \texttt{genOpMaps} and \texttt{genMsgMaps}
*** take, respectively, an operator and a message map of the form
*** \verb~F to F'~, a set of operator or message declarations, and a term of
*** sort \texttt{Module}, and return, respectively, a set of operator maps and
*** a set of message maps, with each of the members of those sTS having the
*** general form \verb~F : TyL -> S to F'~. One of these maps is generated 
*** for each family of subsort-overloaded operators or messages with name 
*** \texttt{F} in the module given as argument.

  op genOpMaps : Renaming OpDeclSet Module -> RenamingSet .
  op genMsgMaps : Renaming MsgDeclSet Module -> RenamingSet .

  op genOpMapsAux : OpDeclSet Qid -> RenamingSet .
  op genMsgMapsAux : MsgDeclSet Qid -> RenamingSet .

  op getOpDeclSet : Qid Module -> OpDeclSet .
  op getOpDeclSetAux : Qid OpDeclSet -> OpDeclSet .
  *** getOpDeclSet(F, U) returns the set of declarations of operators with 
  *** name F in the unit U
  op getMsgDeclSet : Qid Module -> MsgDeclSet .
  op getMsgDeclSetAux : Qid MsgDeclSet -> MsgDeclSet .
  *** getMsgDeclSet(F, U) returns the set of declarations of messages with 
  *** name F in the unit U
  op gTSubsortOverloadedFamilies : 
       OpDeclSet OpDeclSet Module -> OpDeclSet .
  op gTSubsortOverloadedFamilies : 
       MsgDeclSet MsgDeclSet Module -> MsgDeclSet .
  *** gTSubsortOverloadedFamilies returns a declaration of operator or
  *** message for each family of subsort-overloaded operators or messages. 
  op selectOpDeclSet : Qid OpDeclSet -> OpDeclSet .
  op selectMsgDeclSet : Qid MsgDeclSet -> MsgDeclSet .
  *** selectOpDeclSet and selectMsgDeclSet returns, respectively, the subset
  *** of those declarations  of ops and msgs which name coincides with the 
  *** qid given ar argument.
  op opFamilyIn : OpDecl OpDeclSet Module -> Bool .
  op msgFamilyIn : MsgDecl MsgDeclSet Module -> Bool .
  *** Check whether the family of the subsort-overloaded operator given as
  *** argument has already a  representative in the set of declarations given.

  eq genOpMaps((op F to F' [none]), OPDS, M)
    = genOpMapsAux(
         gTSubsortOverloadedFamilies(selectOpDeclSet(F, OPDS), none, M), 
         F') .

  eq genMsgMaps((msg F to F'), MDS, M)
    = genMsgMapsAux(
         gTSubsortOverloadedFamilies(selectMsgDeclSet(F, MDS), none, M), 
         F') .

  eq selectOpDeclSet(F, ((op F' : TyL -> Ty [AtS] .) OPDS))
    = ((if F == F' 
        then (op F' : TyL -> Ty [AtS] .)
        else none 
        fi)
       selectOpDeclSet(F, OPDS)) .
  eq selectOpDeclSet(F, none) = none .

  eq selectMsgDeclSet(F, ((msg F' : TyL -> Ty .) MDS))
    = ((if F == F' 
        then (msg F' : TyL -> Ty .)
        else none 
        fi)
       selectMsgDeclSet(F, MDS)) .
  eq selectMsgDeclSet(F, none) = none .

  eq genOpMapsAux(((op F : TyL -> Ty [AtS] .) OPDS), F')
    = ((op F : TyL -> Ty to F' [none]), genOpMapsAux(OPDS, F')) .
  eq genOpMapsAux(none, F') = none .

  eq genMsgMapsAux(((msg F : TyL -> Ty .) MDS), F')
    = ((msg F : TyL -> Ty to F'), genMsgMapsAux(MDS, F')) .
  eq genMsgMapsAux(none, F') = none .

  eq gTSubsortOverloadedFamilies((OPD OPDS), OPDS', M)
    = if opFamilyIn(OPD, OPDS', M)
      then gTSubsortOverloadedFamilies(OPDS, OPDS', M)
      else gTSubsortOverloadedFamilies(OPDS, (OPD OPDS'), M)
      fi .
  eq gTSubsortOverloadedFamilies(none, OPDS, M) = OPDS .

  eq gTSubsortOverloadedFamilies((MD MDS), MDS', M)
    = if msgFamilyIn(MD, MDS', M)
      then gTSubsortOverloadedFamilies(MDS, MDS', M)
      else gTSubsortOverloadedFamilies(MDS, (MD MDS'), M)
      fi .
  eq gTSubsortOverloadedFamilies(none, MDS, M) = MDS .

  eq opFamilyIn(
       (op F : TyL -> Ty [AtS] .), ((op F' : TyL' -> Ty' [AtS] .) OPDS), M)
    = ((F == F') and-then sameKind(M, TyL, TyL')) or-else
      opFamilyIn((op F : TyL -> Ty [AtS] .), OPDS, M) .
  eq opFamilyIn((op F : TyL -> Ty [AtS] .), none, M) = false .

  eq msgFamilyIn((msg F : TyL -> Ty .), ((msg F' : TyL' -> Ty' .) MDS), M)
    = ((F == F') and-then sameKind(M, TyL, TyL')) 
      or-else
      msgFamilyIn((msg F : TyL -> Ty .), MDS, M) .
  eq msgFamilyIn((msg F : TyL -> Ty .), none, M) = false .

*** In the case of views, the \texttt{parseDecl} function takes the term
*** representing the corresponding declaration and a preview in which the
*** declarations are introduced. Note that in the case of views, the approach
*** followed in the evaluation is somewhat different. The only predeclarations
*** in a preview correspond to the term premaps of sort \texttt{PreTermMap},
*** for which, in addition to solving the bubbles in them, we have to convert
*** them into term maps of sort \texttt{TermMap} associating to them the set 
*** of declarations of variables in the view which are used in them (see 
*** Section~\ref{view-processing}).

*** The function \texttt{parseDecl} for declarations in views takes then the
*** term representing such declaration and a preview in which the result of
*** adding the declaration will be returned. To be able to generate the sTS
*** of equivalent operator and message maps as indicated above, the function
*** takes also as parameters the sTS of declarations of operators and messages
*** in the theory part of the source theory of the view in question, and the 
*** signature of such theory to make the necessary sort comparisons.

  op parseDecl : Term PreView OpDeclSet MsgDeclSet Module -> PreView .

  eq parseDecl('sort_to_.[T, T'], PV, OPDS, MDS, M)
    = addMaps((sort parseType(T) to parseType(T')), PV) .

  eq parseDecl('class_to_.[T, T'], PV, OPDS, MDS, M)
    = addMaps((class parseType(T) to parseType(T')), PV) .

  eq parseDecl('vars_:_.['neTokenList[T], T'], PV, OPDS, MDS, M)
    = addVars(parseVars(downQidList(T), parseType(T')), PV).
  eq parseDecl('var_:_.['neTokenList[T], T'], PV, OPDS, MDS, M)
    = addVars(parseVars(downQidList(T), parseType(T')), PV).

  eq parseDecl('op_to`term_.[T, T'], PV, OPDS, MDS, M) 
    = addMaps(preTermMap(T, T'), PV) .

  eq parseDecl('op_to_.['token[T], 'token[T']], PV, OPDS, MDS, M)
    = addMaps(genOpMaps((op downQid(T) to downQid(T') [none]), OPDS, M), PV) .
  eq parseDecl('op_:_->_to_.['token[T], T', T'', 'token[T3]], PV, OPDS, MDS, M)
    = addMaps(
        op downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3) 
          [none], 
        PV) .
  eq parseDecl('op_:`->_to_.['token[T], T', 'token[T'']], PV, OPDS, MDS, M)
    = addMaps((op downQid(T) : nil -> parseType(T') to downQid(T'') [none]), 
        PV) .

  eq parseDecl('msg_to_.['token[T], 'token[T']], PV, OPDS, MDS, M)
    = addMaps(genMsgMaps((msg downQid(T) to downQid(T')), MDS, M), PV) .
  eq parseDecl('msg_:_->_to_.['token[T], T', T'', 'token[T3]], 
       PV, OPDS, MDS, M)
    = addMaps(
        msg downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3), 
        PV) .
  eq parseDecl('msg_:`->_to_.['token[T], T', 'token[T'']], PV, OPDS, MDS, M)
    = addMaps((msg downQid(T) : nil -> parseType(T') to downQid(T'')), PV) .

  eq parseDecl('label_to_.['token[T], 'token[T']], PV, OPDS, MDS, M)
    = addMaps((label downQid(T) to downQid(T')), PV) .

  eq parseDecl('attr_._to_.[T', 'token[T], 'token[T'']], PV, OPDS, MDS, M)
    = addMaps((attr downQid(T) . parseType(T') to downQid(T'')), PV) .

  eq parseDecl(T, PV, OPDS, MDS, M) = PV [owise] .

endfm

*******************************************************************************

***
*** 8.2 Meta Pretty Printing
***

*** To be able to show to the user the modules, theories, views, and terms
*** resulting from the different commands, the built-in function
*** \texttt{meta-pretty-print} is extended in the modules in this section to 
*** deal with units and views.

***
*** 8.2.1 Meta Pretty Printing of Declarations
***

*** The predefined function \texttt{meta-pretty-print} is extended in the
*** following module \texttt{DECL-META-PRETTY-PRINT} to handle any declaration
*** that can appear in a unit. Note that the following
*** \texttt{meta-pretty-print} functions, as the built-in one, return a list
*** terms---such as equations, rules,* operator declarations with an identity
*** attribute, etc.---they have been defined with a term of operator 
*** declarations with an identity attribute, etc.---they have been defined 
*** with a term of sort \texttt{Module} as argument. In the other cases the 
*** module is not necessary.

fmod DECL-META-PRETTY-PRINT is
  pr EXT-DECL .
  pr O-O-DECL .
  pr UNIT .
  pr CONVERSION .
  pr INT-LIST .
  pr VIEW-EXPR-TO-QID .

  op eMetaPrettyPrint : Sort -> QidList .
  op eMetaPrettyPrint : SortSet -> QidList .
  op eMetaPrettyPrint : TypeList -> QidList .
  op eMetaPrettyPrint : SubsortDeclSet -> QidList .
  op eMetaPrettyPrint : ClassDeclSet -> QidList .
  op eMetaPrettyPrint : SubclassDeclSet -> QidList .
  op eMetaPrettyPrint : Module OpDeclSet -> QidList .
  op eMetaPrettyPrintVars : OpDeclSet -> QidList .
  op eMetaPrettyPrint : MsgDeclSet -> QidList .
  op eMetaPrettyPrint : Module MembAxSet -> QidList .
  op eMetaPrettyPrint : Module EquationSet -> QidList .
  op eMetaPrettyPrint : Module RuleSet -> QidList .
  op eMetaPrettyPrint : Module Condition -> QidList .
  op eMetaPrettyPrint : Module Term -> QidList .

  ---- error handling
  eq metaPrettyPrint(M, T, POS:PrintOptionSet) 
    = 'Module getName(M) 'contains 'errors. .

  eq eMetaPrettyPrint(U, T) = metaPrettyPrint(U, T) . ----, mixfix flat format) .
  eq eMetaPrettyPrint(U, qidError(QIL)) = QIL .
  eq eMetaPrettyPrint(qidError(QIL)) = QIL .
 
  op eMetaPrettyPrint : Module AttrSet -> QidList .
  op eMetaPrettyPrint : IntList -> QidList .
  op eMetaPrettyPrint : ViewExp -> QidList .
  op eMetaPrettyPrint : AttrDeclSet -> QidList .
  op eMetaPrettyPrint : Module HookList -> QidList .

  vars QI QI' QI'' F V L : Qid .
  var  QIL : QidList .
  var  St : String .
  var  M : Module .
  var  U : Module .
  vars VE VE' : ViewExp .
  vars SS : SortSet .
  vars S S' : Sort .
  var  TyL : TypeList .
  var  Ty : Type .
  var  SSDS : SubsortDeclSet .
  var  OPDS : OpDeclSet .
  var  AtS : AttrSet .
  var  MAS : MembAxSet .
  var  EqS : EquationSet .
  var  RlS : RuleSet .
  var  Hk : Hook .
  var  HkL : HookList .
  var  I : Int .
  var  NL : IntList .
  vars T T' T'' T3 : Term .
  var  CDS : ClassDeclSet .
  var  SCDS : SubclassDeclSet .
  var  MDS : MsgDeclSet .
  var  ADS : AttrDeclSet .
  var  Cond : Condition .
  var  K : Kind .

  ceq eMetaPrettyPrint(VE) = viewExp2QidList(VE) if not VE :: TypeList .

  --- eq eMetaPrettyPrint(Ty) = Ty .

  eq eMetaPrettyPrint(S)
    = if getPars(S) == empty
      then S
      else getName(S) '`{ parameterList2QidList(getPars(S)) '`}
      fi .
  eq eMetaPrettyPrint(K) = '`[ eMetaPrettyPrint(getSort(K)) '`] . 

  eq eMetaPrettyPrint((S ; SS)) 
    = (eMetaPrettyPrint(S) eMetaPrettyPrint(SS))
    [owise] .
  eq eMetaPrettyPrint((none).SortSet) = nil .

  eq eMetaPrettyPrint(Ty TyL) 
    = eMetaPrettyPrint(Ty) eMetaPrettyPrint(TyL) 
    [owise] .
  eq eMetaPrettyPrint((nil).TypeList) = nil .

  eq eMetaPrettyPrint(((subsort S < S' .) SSDS))
    = ('\n '\s '\s '\b 
       'subsort '\o eMetaPrettyPrint(S) '\b 
           '< '\o eMetaPrettyPrint(S') '\b '. '\o 
       eMetaPrettyPrint(SSDS)) .
  eq eMetaPrettyPrint((none).SubsortDeclSet) = nil .

  eq eMetaPrettyPrint(M, ((op F : TyL -> Ty [none] .) OPDS))
    = ('\n '\s '\s 
       '\b 'op '\o F '\b ': '\o eMetaPrettyPrint(TyL) 
       '\b '-> '\o eMetaPrettyPrint(Ty) '\b '. '\o 
       eMetaPrettyPrint(M, OPDS)) .
  eq eMetaPrettyPrint(M, ((op F : TyL -> Ty [AtS] .) OPDS))
    = ('\n '\s '\s 
       '\b 'op '\o F '\b ': '\o eMetaPrettyPrint(TyL) 
       '\b '-> '\o eMetaPrettyPrint(Ty) 
       '\n '\s '\s '\s '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '.
       '\o 
       eMetaPrettyPrint(M, OPDS))
    [owise] .
  eq eMetaPrettyPrint(M, (none).OpDeclSet)  = nil .

  eq eMetaPrettyPrintVars((op F : nil -> Ty [none] .) OPDS)
    = ('\n '\s '\s '\b 'var '\o F '\b ': '\o eMetaPrettyPrint(Ty) '\b '. '\o 
       eMetaPrettyPrintVars(OPDS)) .
  eq eMetaPrettyPrintVars((none).OpDeclSet)  = nil .

  eq eMetaPrettyPrint(M, (mb T : S [none] .) MAS)
    = ('\n '\s '\s '\b 'mb '\o eMetaPrettyPrint(M, T) 
                   '\b ': '\o eMetaPrettyPrint(S) '\b '. '\o 
       eMetaPrettyPrint(M, MAS)) .
  eq eMetaPrettyPrint(M, (mb T : S [AtS] .) MAS)
    = ('\n '\s '\s '\b 'mb '\o eMetaPrettyPrint(M, T) 
                   '\b ': '\o eMetaPrettyPrint(S) 
               '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o 
       eMetaPrettyPrint(M, MAS)) 
    [owise] .
  eq eMetaPrettyPrint(M, (cmb T : S if Cond [none] .) MAS)
    = ('\n '\s '\s '\b 'cmb '\o eMetaPrettyPrint(M, T) 
                   '\b ': '\o eMetaPrettyPrint(S) 
       '\n '\s '\s '\s '\s '\b 'if '\o eMetaPrettyPrint(M, Cond) '\b '. '\o 
       eMetaPrettyPrint(M, MAS)) .
  eq eMetaPrettyPrint(M, (cmb T : S if Cond [AtS] .) MAS)
    = ('\n '\s '\s '\b 'cmb '\o eMetaPrettyPrint(M, T) 
                   '\b ': '\o eMetaPrettyPrint(S) 
       '\n '\s '\s '\s '\s '\b 'if '\o eMetaPrettyPrint(M, Cond) 
           '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o 
       eMetaPrettyPrint(M, MAS)) 
    [owise] .
  eq eMetaPrettyPrint(M, (none).MembAxSet) = nil .

  eq eMetaPrettyPrint(M, ((eq T = T' [none] .) EqS))
    = ('\n '\s '\s '\b 'eq '\s '\o eMetaPrettyPrint(M, T) 
       '\n '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T') '\b '\s '. 
       '\o 
       eMetaPrettyPrint(M, EqS)) .
  eq eMetaPrettyPrint(M, ((eq T = T' [AtS] .) EqS))
    = ('\n '\s '\s '\b 'eq '\s '\o eMetaPrettyPrint(M, T) 
       '\n '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T') 
           '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o 
       eMetaPrettyPrint(M, EqS)) 
    [owise] .
  eq eMetaPrettyPrint(M, ((ceq T = T' if Cond [none] .) EqS))
    = ('\n '\s '\s '\b 'ceq '\s '\o eMetaPrettyPrint(M, T) 
       '\n '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T') 
       '\n '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) '\b '\s '.
       '\o
       eMetaPrettyPrint(M, EqS)) .
  eq eMetaPrettyPrint(M, ((ceq T = T' if Cond [AtS] .) EqS))
    = ('\n '\s '\s '\b 'ceq '\s '\o eMetaPrettyPrint(M, T) 
       '\n '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T') 
       '\n '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) 
           '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o
       eMetaPrettyPrint(M, EqS)) 
    [owise] .
  eq eMetaPrettyPrint(M, (none).EquationSet) = nil .

  eq eMetaPrettyPrint(M, ((rl T => T' [none] .) RlS))
    = ('\n '\s '\s '\b 'rl '\s '\o eMetaPrettyPrint(M, T) 
       '\n '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') '\b '\s '. 
       '\o
       eMetaPrettyPrint(M, RlS)) .
  eq eMetaPrettyPrint(M, ((rl T => T' [AtS] .) RlS))
    = ('\n '\s '\s '\b 'rl '\s '\o eMetaPrettyPrint(M, T) 
       '\n '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') 
           '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o
       eMetaPrettyPrint(M, RlS)) 
    [owise] .
  eq eMetaPrettyPrint(M, ((crl T => T' if Cond [none] .) RlS))
    = ('\n '\s '\s '\b 'crl '\s '\o eMetaPrettyPrint(M, T) 
       '\n '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') 
       '\n '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) '\b '\s '.
       '\o
       eMetaPrettyPrint(M, RlS)) .
  eq eMetaPrettyPrint(M, ((crl T => T' if Cond [AtS] .) RlS))
    = ('\n '\s '\s '\b 'crl '\s '\o eMetaPrettyPrint(M, T) 
       '\n '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') 
       '\n '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) 
           '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o
       eMetaPrettyPrint(M, RlS)) 
    [owise] .
  eq eMetaPrettyPrint(M, (none).RuleSet) = nil .

  eq eMetaPrettyPrint(M, T = T' /\ Cond)
    = (eMetaPrettyPrint(M, T) '\b '= '\o eMetaPrettyPrint(M, T') '\b 
      '/\ '\o eMetaPrettyPrint(M, Cond)) 
    [owise] .
  eq eMetaPrettyPrint(M, T : S /\ Cond)
    = (eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(S) '\b 
      '/\ '\o eMetaPrettyPrint(M, Cond)) 
    [owise] .
  eq eMetaPrettyPrint(M, T := T' /\ Cond)
    = (eMetaPrettyPrint(M, T) '\b ':= '\o eMetaPrettyPrint(M, T') '\b 
      '/\ '\o eMetaPrettyPrint(M, Cond)) 
    [owise] .
  eq eMetaPrettyPrint(M, T => T' /\ Cond)
    = (eMetaPrettyPrint(M, T) '\b '=> '\o eMetaPrettyPrint(M, T') '\b 
      '/\ '\o eMetaPrettyPrint(M, Cond)) 
    [owise] .
  eq eMetaPrettyPrint(M, T = T') 
    = (eMetaPrettyPrint(M, T) '\b '= '\o eMetaPrettyPrint(M, T')) .
  eq eMetaPrettyPrint(M, T : S) 
    = (eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(S)) .
  eq eMetaPrettyPrint(M, T := T') 
    = (eMetaPrettyPrint(M, T) '\b ':= '\o eMetaPrettyPrint(M, T')) .
  eq eMetaPrettyPrint(M, T => T') 
    = (eMetaPrettyPrint(M, T) '\b '=> '\o eMetaPrettyPrint(M, T')) .

  eq eMetaPrettyPrint(M, (assoc AtS))  
    = ('\b 'assoc '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (comm AtS))   
    = ('\b 'comm '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (memo AtS))   
    = ('\b 'memo '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (idem AtS))   
    = ('\b 'idem '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (id(T) AtS))
    = ('\b 'id: '\o eMetaPrettyPrint(M, T) eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (right-id(T) AtS))
    = ('\b 'right 'id: '\o eMetaPrettyPrint(M, T) eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (left-id(T) AtS))
    = ('\b 'left 'id: '\o eMetaPrettyPrint(M, T) eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (poly(NL) AtS))
    = ('\b 'poly '`( '\o eMetaPrettyPrint(NL) '\b '`) 
       '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (strat(NL) AtS))
    = ('\b 'strat '`( '\o eMetaPrettyPrint(NL) '\b '`) 
       '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (memo AtS))   
    = ('\b 'memo '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (prec(I) AtS))
    = ('\b 'prec '\o eMetaPrettyPrint(I) eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (gather(QIL) AtS))
    = ('\b 'gather '\o '`( QIL '`) eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (format(QIL) AtS))
    = ('\b 'format '\o '`( QIL '`) eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (ctor AtS))   
    = ('\b 'ctor '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (frozen(NL) AtS)) 
    = ('\b 'frozen '`( '\o eMetaPrettyPrint(NL) '\b '`) 
       '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (iter AtS))   
    = ('\b 'iter '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (special(HkL) AtS))
    = ('\b 'special '`( '\o eMetaPrettyPrint(M, HkL) '\b '`) 
       '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (config AtS))   
    = ('\b 'config '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (object AtS))   
    = ('\b 'object '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (msg AtS))   
    = ('\b 'msg '\o eMetaPrettyPrint(M, AtS)) .

  eq eMetaPrettyPrint(M, (label(QI) AtS))
    = ('\b 'label '\o QI '\b '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (metadata(St) AtS))
    = ('\b 'metadata '\o qid("\"" + St + "\"") '\b 
       '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (nonexec AtS))
    = ('\b 'nonexec '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (owise AtS))
    = ('\b 'owise '\o eMetaPrettyPrint(M, AtS)) .
  eq eMetaPrettyPrint(M, (print(QIL) AtS))
    = ('\b 'print QIL '\o eMetaPrettyPrint(M, AtS)) .

  eq eMetaPrettyPrint(M, (none).AttrSet) = nil .

  ceq eMetaPrettyPrint(M, (Hk HkL)) 
    = (eMetaPrettyPrint(M, Hk) eMetaPrettyPrint(M, HkL)) 
    if HkL =/= nil .
  eq eMetaPrettyPrint(M, id-hook(QI, nil)) = ('\b 'id-hook '\o QI) .
  eq eMetaPrettyPrint(M, id-hook(QI, QIL))
    = ('\b 'id-hook '\o QI '\b '`( '\o QIL '\b '`) '\o ) 
    [owise] .
  eq eMetaPrettyPrint(M, op-hook(QI, QI', nil, QI''))
    = ('\b 'op-hook '\o QI '\b '`( '\o QI' ': '~> QI'' '\b '`) '\o) .
  eq eMetaPrettyPrint(M, op-hook(QI, QI', QIL, QI''))
    = ('\b 'op-hook '\o QI '\b '`( '\o QI' ': QIL '~> QI'' '\b '`) '\o) 
    [owise] .
  eq eMetaPrettyPrint(M, term-hook(QI, T))
    = ('\b 'term-hook '\o QI '\b '`( '\o eMetaPrettyPrint(M, T) '\b '`) '\o) .

  eq eMetaPrettyPrint((I NL)) = (qid(string(I, 10)) eMetaPrettyPrint(NL)) .
  eq eMetaPrettyPrint((nil).NatList) = nil .

  eq eMetaPrettyPrint((class S | ADS .) CDS)
    = ((if ADS == none
        then ('\n '\s '\s '\b 'class '\o eMetaPrettyPrint(S) '\b '. '\o)
        else ('\n '\s '\s 
              '\b 'class '\o eMetaPrettyPrint(S) '\b 
              '| '\o eMetaPrettyPrint(ADS) '\b '. '\o)
        fi)
       eMetaPrettyPrint(CDS)) .
  eq eMetaPrettyPrint((none).ClassDeclSet) = nil .

  eq eMetaPrettyPrint((subclass S < S' .) SCDS)
    = ('\n '\s '\s  
       '\b 'subclass '\o eMetaPrettyPrint(S) '\b 
           '< '\o eMetaPrettyPrint(S') '\b '. '\o
       eMetaPrettyPrint(SCDS)) .
  eq eMetaPrettyPrint((none).SubclassDeclSet) = nil .

  eq eMetaPrettyPrint((msg F : TyL -> Ty .) MDS)
    = ('\n '\s '\s  
       '\b 'msg '\o F '\b ': 
       '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty) '\b '. '\o
       eMetaPrettyPrint(MDS)) .
  eq eMetaPrettyPrint((none).MsgDeclSet) = nil .

  eq eMetaPrettyPrint(((attr F : S), ADS))
    = (F '\b ': '\o eMetaPrettyPrint(S) '\b '`, '\o '\s eMetaPrettyPrint(ADS))
    [owise] .
  eq eMetaPrettyPrint((attr F : S)) = (F '\b ': '\o eMetaPrettyPrint(S)) .
  eq eMetaPrettyPrint((none).AttrDeclSet) = nil .

endfm

*******************************************************************************

***
*** 8.2.2 Meta Pretty Printing of Modules
***

*** In the following module, the \texttt{meta-pretty-print} function is
*** defined on sort \texttt{Module}.

fmod UNIT-META-PRETTY-PRINT is
  pr UNIT .
  pr RENAMING-EXPR-EVALUATION .
  pr DECL-META-PRETTY-PRINT .

  op eMetaPrettyPrint : Module Module -> QidList .

  op eMetaPrettyPrint : Module Module -> QidList .
  op eMetaPrettyPrint : Header -> QidList .
  op eMetaPrettyPrint : ParameterDeclList -> QidList .
  op eMetaPrettyPrint : ImportList -> QidList .

  var  M : Module .
  vars QI F F' L L' : Qid .
  var  QIL : QidList .
  var  ME : ModuleExpression .
  vars S S' : Sort .
  var  Ty : Type .
  var  TyL : TypeList .
  var  SS : SortSet .
  var  PD : ParameterDecl .
  var  PDL : ParameterDeclList .
  vars IL IL' : ImportList .
  var  SSDS : SubsortDeclSet .
  var  OPDS : OpDeclSet .
  var  MAS : MembAxSet .
  var  EqS : EquationSet .
  var  RlS : RuleSet .
  var  CDS : ClassDeclSet .
  var  SCDS : SubclassDeclSet .
  var  MDS : MsgDeclSet .
  var  U : Module .
  var  AtS : AttrSet .
  var  MN : ModuleName .

  ceq eMetaPrettyPrint(ME) 
    = if QI == '`) or QI == '`] or QI == '`} 
      then QIL QI '\s
      else QIL QI 
      fi
    if QIL QI := header2QidList(ME) .

  eq eMetaPrettyPrint(W:[Module], unitError(QIL)) = QIL .
  eq eMetaPrettyPrint(unitError(QIL), noModule) = QIL .
  eq eMetaPrettyPrint(noModule, noModule) = nil .
  eq eMetaPrettyPrint(M, mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm)
    = ('\n '\b          
       'mod '\o eMetaPrettyPrint(ME) '\b 'is '\o 
          eMetaPrettyPrint(IL) 
          (if SS == none
           then nil
           else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o)
           fi)
          eMetaPrettyPrint(SSDS) 
          eMetaPrettyPrint(M, OPDS)
          eMetaPrettyPrint(M, MAS) 
          eMetaPrettyPrint(M, EqS) 
          eMetaPrettyPrint(M, RlS) 
       '\n '\b 'endm '\o '\n) .
  eq eMetaPrettyPrint(M, mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm)
    = ('\n '\b 
       'mod '\o eMetaPrettyPrint(ME) (if PDL == nil 
                                      then nil
                                      else '`{ eMetaPrettyPrint(PDL) '`} '\s
                                      fi) '\b 'is '\o
          eMetaPrettyPrint(IL) 
          (if SS == none
           then nil
           else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o)
           fi) 
          eMetaPrettyPrint(SSDS) 
          eMetaPrettyPrint(M, OPDS) 
          eMetaPrettyPrint(M, MAS) 
          eMetaPrettyPrint(M, EqS) 
          eMetaPrettyPrint(M, RlS) 
       '\n '\b 'endm '\o '\n) .
  eq eMetaPrettyPrint(M, th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth)
    = ('\n '\b 
       'th '\o eMetaPrettyPrint(MN) '\b 'is '\o 
          eMetaPrettyPrint(IL) 
          (if SS == none
           then nil
           else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o)
           fi) 
          eMetaPrettyPrint(SSDS) 
          eMetaPrettyPrint(M, OPDS)
          eMetaPrettyPrint(M, MAS) 
          eMetaPrettyPrint(M, EqS) 
          eMetaPrettyPrint(M, RlS) 
       '\n '\b 'endth '\o '\n) .
  eq eMetaPrettyPrint(M, fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm)
    = ('\n '\b 
       'fmod '\o eMetaPrettyPrint(ME) '\b 'is '\o 
           eMetaPrettyPrint(IL) 
           (if SS == none
            then nil
            else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o)
            fi)  
           eMetaPrettyPrint(SSDS) 
           eMetaPrettyPrint(M, OPDS)
           eMetaPrettyPrint(M, MAS) 
           eMetaPrettyPrint(M, EqS) 
       '\n '\b 'endfm '\o '\n) .
  eq eMetaPrettyPrint(M, fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm)
    = ('\n '\b 
       'fmod '\o eMetaPrettyPrint(ME) (if PDL == nil 
                                       then nil
                                       else '`{ eMetaPrettyPrint(PDL) '`} '\s
                                       fi) '\b 'is '\o 
           eMetaPrettyPrint(IL) 
           (if SS == none
            then nil
            else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o)
            fi)  
           eMetaPrettyPrint(SSDS)          
           eMetaPrettyPrint(M, OPDS)
           eMetaPrettyPrint(M, MAS)          
           eMetaPrettyPrint(M, EqS) 
       '\n '\b 'endfm '\o '\n) .
  eq eMetaPrettyPrint(M, fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth)
    = ('\n '\b 
       'fth '\o eMetaPrettyPrint(MN) '\b 'is '\o 
          eMetaPrettyPrint(IL)
          (if SS == none
           then nil
           else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o)
           fi)  
          eMetaPrettyPrint(SSDS) 
          eMetaPrettyPrint(M, OPDS)
          eMetaPrettyPrint(M, MAS) 
          eMetaPrettyPrint(M, EqS) 
       '\n '\b 'endfth '\o '\n) .
  eq eMetaPrettyPrint(M, 
       omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
    = ('\n '\b 
       'omod '\o eMetaPrettyPrint(ME) '\b 'is '\o 
          eMetaPrettyPrint(IL) 
          (if SS == none
           then nil
           else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o)
           fi)   
          eMetaPrettyPrint(SSDS) eMetaPrettyPrint(CDS) 
          eMetaPrettyPrint(SCDS) eMetaPrettyPrint(M, OPDS) 
          eMetaPrettyPrint(MDS) eMetaPrettyPrint(M, MAS) 
          eMetaPrettyPrint(M, EqS) eMetaPrettyPrint(M, RlS) 
       '\n '\b 'endom '\o '\n) .
  eq eMetaPrettyPrint(M, omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
    = ('\n '\b 
       'omod '\o eMetaPrettyPrint(ME) (if PDL == nil
                                       then nil
                                       else ('`{ eMetaPrettyPrint(PDL) '`} '\s)
                                       fi) '\b 'is '\o 
          eMetaPrettyPrint(IL) 
          (if SS == none
           then nil
           else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o)
           fi)   
          eMetaPrettyPrint(SSDS) eMetaPrettyPrint(CDS) 
          eMetaPrettyPrint(SCDS) eMetaPrettyPrint(M, OPDS) 
          eMetaPrettyPrint(MDS) eMetaPrettyPrint(M, MAS) 
          eMetaPrettyPrint(M, EqS) eMetaPrettyPrint(M, RlS) 
       '\n '\b 'endom '\o '\n) .
  eq eMetaPrettyPrint(M, oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
    = ('\n '\b 
       'oth '\o eMetaPrettyPrint(MN) '\b 'is '\o 
          eMetaPrettyPrint(IL) 
          (if SS == none
           then nil
           else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o)
           fi)   
          eMetaPrettyPrint(SSDS) eMetaPrettyPrint(CDS) 
          eMetaPrettyPrint(SCDS) eMetaPrettyPrint(M, OPDS) 
          eMetaPrettyPrint(MDS) eMetaPrettyPrint(M, MAS) 
          eMetaPrettyPrint(M, EqS) eMetaPrettyPrint(M, RlS) '\n '\b 
       'endoth '\o '\n) .

  eq eMetaPrettyPrint((including ME .) IL)
    = ('\n '\s '\s '\b 'including '\o eMetaPrettyPrint(ME) '\b '. '\o 
       eMetaPrettyPrint(IL)) .
  eq eMetaPrettyPrint((extending ME .) IL)
    = ('\n '\s '\s '\b 'extending '\o eMetaPrettyPrint(ME) '\b '. '\o 
       eMetaPrettyPrint(IL)) .
  eq eMetaPrettyPrint((protecting ME .) IL)
    = ('\n '\s '\s '\b 
       'protecting '\o eMetaPrettyPrint(ME) '\b '. '\o eMetaPrettyPrint(IL)) .
  eq eMetaPrettyPrint((protecting pd(QI :: ME) .) IL)
    = eMetaPrettyPrint(IL) .
  eq eMetaPrettyPrint((nil).ImportList) = nil .

  eq eMetaPrettyPrint((QI :: ME, PDL))
    = (QI '::  eMetaPrettyPrint(ME) '`, eMetaPrettyPrint(PDL))
    [owise] .
  eq eMetaPrettyPrint((QI :: ME)) = (QI '::  eMetaPrettyPrint(ME)) .
  eq eMetaPrettyPrint((nil).ParameterDeclList) = (nil).QidList .

  op eMetaPrettyPrint : ModuleExpression -> QidList .
  eq eMetaPrettyPrint(QI + ME:ModuleExpression)
    = QI '+ eMetaPrettyPrint(ME:ModuleExpression) .
  eq eMetaPrettyPrint(QI * (RnS:RenamingSet))
    = QI '* '\s '`( renamingSet2QidList(RnS:RenamingSet) '`) .
  eq eMetaPrettyPrint(pd(PD)) = eMetaPrettyPrint(PD) .

  op renamingSet2QidList : RenamingSet -> QidList .
  eq renamingSet2QidList(((op F to F' [AtS]), RS:RenamingSet))
    = if AtS == none 
      then ('op F 'to F' '`, '\s renamingSet2QidList(RS:RenamingSet))
      else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`] '`, '\s 
            renamingSet2QidList(RS:RenamingSet))
      fi
    [owise] .
  eq renamingSet2QidList((op F to F' [AtS]))
    = if AtS == none 
      then ('op F 'to F')  
      else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`]) 
      fi .
  eq renamingSet2QidList(((op F : TyL -> Ty to F' [AtS]), RS:RenamingSet))
    = if AtS == none 
      then ('op F ': typeList2QidList(TyL) '-> Ty 'to F' '`, 
            '\s renamingSet2QidList(RS:RenamingSet))
      else ('op F ': typeList2QidList(TyL) '-> Ty 'to F' 
            '`[ attrSet2QidList(AtS) '`] '`, 
            '\s renamingSet2QidList(RS:RenamingSet))
      fi 
    [owise] .
  eq renamingSet2QidList((op F : TyL -> Ty to F' [AtS]))
    = if AtS == none 
      then ('op F ': typeList2QidList(TyL) '-> Ty 'to F')
      else ('op F ': typeList2QidList(TyL) '-> Ty 'to F' 
            '`[ attrSet2QidList(AtS) '`]) 
      fi .
  eq renamingSet2QidList(((sort S to S'), RS:RenamingSet))
    = ('sort S 'to S' '`, '\s 
       renamingSet2QidList(RS:RenamingSet))
    [owise] .
  eq renamingSet2QidList((sort S to S')) = ('sort S 'to S') .

  eq renamingSet2QidList(((label L to L'), RS:RenamingSet))
    = ('label L 'to L' '`, '\s renamingSet2QidList(RS:RenamingSet))
    [owise] .
  eq renamingSet2QidList((label L to L')) = ('label L 'to L') .
endfm

*******************************************************************************

*** The function \texttt{meta-pretty-print} on units is defined recursively,
*** calling the \texttt{meta-pretty-print} functions for the different
*** declarations in the unit defined in module \texttt{DECL-META-PRETTY-PRINT}.

***
*** 8.2.3 Meta Pretty Printing of Maps and Views
***

*** We define in the following module the function \texttt{meta-pretty-print} 
*** on maps.

fmod MAP-SET-META-PRETTY-PRINT is
  pr DECL-META-PRETTY-PRINT .
  pr FMAP .
  pr UNIT .

  op eMetaPrettyPrint : RenamingSet -> QidList .

  var  MAP : Renaming .
  var  MAPS : RenamingSet .
  vars QI QI' F F' L L' : Qid .
  var  AtS : AttrSet .
  vars S S' : Sort .
  var  Ty : Type .
  var  TyL : TypeList .

  eq eMetaPrettyPrint((MAP, MAPS))
    = (eMetaPrettyPrint(MAP) '`, '\s '\s eMetaPrettyPrint(MAPS))
    [owise] .
  eq eMetaPrettyPrint((none).RenamingSet) = nil .

  eq eMetaPrettyPrint(op F to F' [AtS])
    = if AtS == none
      then ('\b 'op '\o F '\b 'to '\o F') 
      else ('\b 'op F '\b 'to '\o F' '\b 
            '`[ '\o eMetaPrettyPrint(noModule, AtS) '\b '`] '\o) 
           *** In a map there should not be attributes requiring a module 
      fi .
  eq eMetaPrettyPrint(op F : TyL -> Ty to F' [AtS])
    = if AtS == none
      then ('\b 'op '\o F '\b ': 
            '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty) 
            '\b 'to '\o F') 
      else ('\b 'op '\o F '\b ': 
            '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty) 
            '\b 'to '\o F' 
            '\b '`[ '\o eMetaPrettyPrint(noModule, AtS) '\b '`] '\o) 
           *** In a map there should not be attributes requiring a module 
      fi .
  eq eMetaPrettyPrint(sort S to S') 
    = ('\b 'sort '\o eMetaPrettyPrint(S) '\b 'to '\o eMetaPrettyPrint(S')) .
  eq eMetaPrettyPrint(label L to L') = ('\b 'label '\o L '\b 'to '\o L') .
  eq eMetaPrettyPrint(class S to S')
    = ('\b 'class '\o eMetaPrettyPrint(S) '\b 'to '\o eMetaPrettyPrint(S')) .
  eq eMetaPrettyPrint(attr QI . S to QI') 
    = ('\b 'attr '\o eMetaPrettyPrint(S) '\b '. '\o QI '\b 'to '\o QI') .
  eq eMetaPrettyPrint(msg F to F') = ('\b 'msg '\o F '\b 'to '\o F') .
  eq eMetaPrettyPrint(msg F : TyL -> Ty to F')
    = ('\b 'msg '\o F '\b ': 
       '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty) 
       '\b 'to '\o F') .

endfm

*******************************************************************************

*** Finally, in the \texttt{VIEW-META-PRETTY-PRINT} module, the
*** \texttt{meta-pretty-print} function is defined on views.


fmod VIEW-META-PRETTY-PRINT is
  pr DATABASE .
  pr MAP-SET-META-PRETTY-PRINT .
  pr VIEW-MAP-SET-APPL-ON-UNIT .
  pr UNIT-META-PRETTY-PRINT .

  op eMetaPrettyPrint : Database View -> QidList .
  op eMetaPrettyPrint : ViewExp -> QidList .
  op eMetaPrettyPrint : ModuleExpression ModuleExpression Database RenamingSet 
       RenamingSet -> QidList .

  var  QI : Qid .
  var  QIL : QidList .
  var  DB : Database .
  vars ME ME' : ModuleExpression .
  var  MAP : Renaming .
  var  VMAP : ViewMap .
  vars VMAPS VMAPS' : Set{ViewMap} .
  vars T T' : Term .
  var  PDL : ParameterDeclList .
  vars VE VE' : ViewExp .
  var  DT : Default{Term} .

  ceq eMetaPrettyPrint(DB, view VE from ME to ME' is VMAPS endv)
    = ('\n '\b 'view '\o 
                 QIL QI 
                 if QI == '`) then '\s else nil fi
              '\b 'from '\o eMetaPrettyPrint(ME) 
              '\b 'to '\o eMetaPrettyPrint(ME') '\b 'is '\o
       '\n '\s '\s eMetaPrettyPrint(ME, ME', DB, VMAPS, VMAPS) 
       '\n '\b 'endv '\o) 
    if QIL QI := eMetaPrettyPrint(VE) .
  ceq eMetaPrettyPrint(DB, view VE{PDL} from ME to ME' is VMAPS endv)
    = ('\n '\b 'view '\o 
                 QIL QI 
                 (if PDL == nil 
                  then if QI == '`) then '\s else nil fi
                  else '`{ eMetaPrettyPrint(PDL) '`} '\s
                  fi) 
              '\b 'from '\o eMetaPrettyPrint(ME) 
              '\b 'to '\o eMetaPrettyPrint(ME') '\b 'is '\o
       '\n '\s '\s eMetaPrettyPrint(ME, ME', DB, VMAPS, VMAPS) 
       '\n '\b 'endv '\o) 
    if QIL QI := eMetaPrettyPrint(VE) .
  eq eMetaPrettyPrint(DB, viewError(QIL)) = QIL .

  ceq eMetaPrettyPrint(QI) = QI if not QI :: Type .
  ceq eMetaPrettyPrint(((VE, VE'))) 
    = eMetaPrettyPrint(VE) '`, '\s eMetaPrettyPrint(VE') 
    if VE =/= nil /\ VE' =/= nil .
  eq eMetaPrettyPrint(QI{VE}) = QI '`{ eMetaPrettyPrint(VE) '`} '\s .

  eq eMetaPrettyPrint(ME, ME', DB, (VMAP, VMAPS), VMAPS')
    = (eMetaPrettyPrint(ME, ME', DB, VMAP, VMAPS')
       '\n '\s '\s eMetaPrettyPrint(ME, ME', DB, VMAPS, VMAPS'))
    [owise] .     
  eq eMetaPrettyPrint(ME, ME', DB, none, VMAPS) = nil .

  eq eMetaPrettyPrint(ME, ME', DB, MAP, VMAPS) = eMetaPrettyPrint(MAP) '. .
  eq eMetaPrettyPrint(ME, ME', DB, termMap(T, T'), VMAPS)
    = ('\b 'op '\o eMetaPrettyPrint(getFlatModule(ME, DB), T) '\b 'to 
       'term '\o eMetaPrettyPrint(getFlatModule(ME', DB), T') '\b '. '\o) .

  eq eMetaPrettyPrint(termMap(T, T')) 
    = ('op eMetaPrettyPrint(T) '\b 'to '\o eMetaPrettyPrint(T')) .

endfm

*******************************************************************************

***
*** 8.3 Input Processing
***

*** The processing functions presented in the following modules are in charge
*** of taking each term generated by the \texttt{metaParse} function and,
*** after transforming it into an element of the data types \texttt{Module} or
*** \texttt{View}, or generating some output, returning the database resulting
*** from introducing in it such a term. We shall see in
*** Section~\ref{database-handling} how the appropriate function is called
*** after having performed a first analysis of the term, in which it is
*** detected whether the input corresponds to a unit, view, or command. In the
*** cases of units and views the processing is quite similar. After a 
*** preprocessing of the term, the function \texttt{parseDecl} is called with 
*** each of the subterms representing declarations, resulting in units or 
*** views with the parsed declarations in it.

***
*** 8.3.1 Module Processing
***

*** The processing of a term resulting from the parsing of some input
*** corresponding to a unit is accomplished by the \texttt{procModule} function.
*** This function takes as arguments a term of sort \texttt{Term}, which
*** represents some preunit, and a database. The function then enters into the
*** given database the unit obtained from the transformation of such term 
*** into a term of sort \texttt{Module}.

fmod UNIT-PROCESSING is
  pr DATABASE .
  pr UNIT-DECL-PARSING .
  pr EVALUATION .
  pr VIEW-MAP-SET-APPL-ON-UNIT .
  pr META-FULL-MAUDE-SIGN .
  pr MOD-EXP-PARSING .

  vars QI F X : Qid .
  var  M : Module .
  vars PU PU' U U' : Module .
  vars DB DB' : Database .
  vars T T' T'' T3 : Term .
  var  TL : TermList .
  vars PL PL' PL'' : ParameterList .
  var  PDL : ParameterDeclList .
  var  IL IL' : ImportList .
  var  ME : ModuleExpression .
  var  S : Sort .
  var  SS : SortSet .
  var  ME' : ModuleExpression .
  var  VMAPS : RenamingSet .
  var  B : Bool .
  var  VDS : OpDeclSet .
  var  QIL : QidList .
  var  PDR : ParseDeclResult .
  var  DT : Default{Term} .

*** The \texttt{parseParList} takes a term representing a list of parameters
*** and returns the corresponding list.

  op parseParList : Term -> ParameterDeclList .
  eq parseParList('_::_['token[T], T']) = downQid(T) :: parseModExp(T') .
  eq parseParList('_`,_[T, T']) = (parseParList(T), parseParList(T')) .

*** All the operators declared as constructors of sort \texttt{PreModule} in 
*** the signature of Full Maude, given in Appendix~\ref{signature-full-maude}, 
*** are declared with two arguments, namely, the name, or name and interface, 
*** of the unit, and the list of declarations of such units. The function
*** \texttt{procModule3} is called with the term corresponding to the name, or
*** name and interface, of the module as first argument, the term corresponding
*** to the set of declarations as second argument, and an empty module of the 
*** appropriate type, in which the different declarations will be accumulated, 
*** as third argument.

*** The task of the function \texttt{procModule4} is then to make a second 
*** level parsing of the input, building up, simultaneously, the preunit 
*** represented in the term passed as argument, and the unit resulting from the
*** declarations without bubbles. This unit without bubbles will be used by the
*** \texttt{evalPreModule} function to build the signature with which to 
*** analyze the bubbles in the preunit (see Section~\ref{evaluation}).

*** The case of parameterized modules requires a special treatment of the
*** parameters. These parameters are evaluated and are added as submodules in 
*** the appropriate way.

*** When the last declaration is parsed, the function \texttt{evalPreModule} is
*** called with the preunit (the top module with bubbles) as first argument,
*** the empty copy of it as second argument, the top module without bubbles as 
*** third argument, and the database.

*** Note that the \texttt{procModule} function adds a declaration importing the
*** module \texttt{CONFIGURATION+}, presented in
*** Section~\ref{non-built-in-predefined}, to the object-oriented modules, and
*** that \texttt{procModule4} adds a declaration importing the built-in module 
*** \texttt{BOOL} to all modules.

  op procModule : Term Database -> Database .
  ***  moved to MOD-EXPR-EVAL to solve dependency
  ***  op procModule : Qid Database -> Database .
  op procModule2 : Term Term Database -> Database .
  op procModule2 : Term Database -> Database .
  op procModule3 : Term Term Term Module Database -> Database .
  op procModule3 : Term Term Module Database -> Database .
  op procModule4 : Term Term Module Module OpDeclSet Database -> Database .
  op procModule4 : Term Module Module OpDeclSet Database -> Database .

  *** When recompiling a module, it's called with a Qid, and it's 
  *** not reentered into the database.

  ceq procModule(QI, DB) 
    = if DT == null
      then evalModule(U, VDS, DB)
      else procModule2(DT, DB) 
      fi 
    if < DT ; VDS ; U > := getTermModule(QI, DB) .
  eq procModule(T, DB) = procModule2(T, T, DB) .

  *** procModule2 just calls procModule3 with the name and the declarations of 
  *** the module, and an empty unit of the right type.

  eq procModule2(T, 'fmod_is_endfm[T', T''], DB) 
    = procModule3(T, T', T'', emptyFModule, DB) .
  eq procModule2(T, 'obj_is_endo[T', T''], DB) 
    = procModule3(T, T', T'', emptyFModule, DB) .
  eq procModule2(T, 'obj_is_jbo[T', T''], DB) 
    = procModule3(T, T', T'', emptyFModule, DB) .
  eq procModule2(T, 'mod_is_endm[T', T''], DB) 
    = procModule3(T, T', T'', emptySModule, DB) .
  eq procModule2(T, 'omod_is_endom[T', T''], DB)
    = procModule3(T, T', T'', 
        addImports((including 'CONFIGURATION . including 'CONFIGURATION+ .), 
          emptyOModule), 
        DB) .
  eq procModule2(T, 'fth_is_endfth[T', T''], DB) 
    = procModule3(T, T', T'', emptyFTheory, DB) .
  eq procModule2(T, 'th_is_endth[T', T''], DB) 
    = procModule3(T, T', T'', emptySTheory, DB) .
  eq procModule2(T, 'oth_is_endoth[T', T''], DB)
    = procModule3(T, T', T'', 
        addImports((including 'CONFIGURATION . including 'CONFIGURATION+ .), 
          emptyOTheory), 
        DB) .

  eq procModule2('fmod_is_endfm[T, T'], DB) 
    = procModule3(T, T', emptyFModule, DB) .
  eq procModule2('obj_is_endo[T, T'], DB) 
    = procModule3(T, T', emptyFModule, DB) .
  eq procModule2('obj_is_jbo[T, T'], DB) 
    = procModule3(T, T', emptyFModule, DB) .
  eq procModule2('mod_is_endm[T, T'], DB) 
    = procModule3(T, T', emptySModule, DB) .
  eq procModule2('omod_is_endom[T, T'], DB)
    = procModule3(T, T', 
        addImports((including 'CONFIGURATION+ .), 
          emptyOModule), 
        DB) .
  eq procModule2('fth_is_endfth[T, T'], DB) 
    = procModule3(T, T', emptyFTheory, DB) .
  eq procModule2('th_is_endth[T, T'], DB) 
    = procModule3(T, T', emptySTheory, DB) .
  eq procModule2('oth_is_endoth[T, T'], DB)
    = procModule3(T, T', 
        addImports((including 'CONFIGURATION+ .), 
          emptyOTheory), 
        DB) .

  *** procModule3 evaluates the name of the module and calls procModule4 
  *** with the declarations, two empty units (one to contain the declarations
  *** with bubbles and another one the declarations without bubbles), and
  *** a set of op decls initialy empty in which to store the variables

  ceq procModule3(T, 'token[T'], T'', U, DB)
    = procModule4(T, T'', setName(U, QI), setName(U, QI), none, DB) 
    if QI := downQid(T') .
  ceq procModule3(T, '_`{_`}['token[T'], T''], T3, U, DB)
    = procModule4(T, T3, setPars(setName(U, QI), parseParList(T'')), 
        setName(U, QI), none, DB)
    if QI := downQid(T') .

  ceq procModule3('token[T], T', U, DB)
    = procModule4(T', setName(U, QI), setName(U, QI), none, DB) 
    if QI := downQid(T) .
  ceq procModule3('_`{_`}['token[T], T'], T'', U, DB)
    = procModule4(T'', setPars(setName(U, QI), parseParList(T')), 
        setName(U, QI), none, DB)
    if QI := downQid(T) .

  *** procModule4 parses one by one each of the declarations in the module.
  *** Note that is parseDecl that adds the parsed declaration to the right 
  *** place. When it is done, it calls evalPreModule with the resulting 
  *** preModule-unit-vars triple.

  ceq procModule4(T, '__[T', T''], PU, U, VDS, DB)
    = procModule4(T, T'', preModule(PDR), unit(PDR), vars(PDR), DB) 
    if PDR := parseDecl(T', PU, U, VDS) .
  ceq procModule4(T, F[TL], PU, U, VDS, DB)
    = evalPreModule(preModule(PDR), unit(PDR), vars(PDR), 
        insTermModule(getName(U), T, DB))
    if F =/= '__ 
       /\ PDR := parseDecl(F[TL], PU, U, VDS) .
  eq procModule4(T, T', unitError(QIL), V:[Module], V:[OpDeclSet], DB) 
    = warning(DB, QIL) .
  eq procModule4(T, T', V:[Module], unitError(QIL), V:[OpDeclSet], DB) 
    = warning(DB, QIL) .
  eq procModule4(T, T', V:[Module], V':[Module], opDeclError(QIL), DB) 
    = warning(DB, QIL) .

  ceq procModule4('__[T, T'], PU, U, VDS, DB)
    = procModule4(T', preModule(PDR), unit(PDR), vars(PDR), DB) 
    if PDR := parseDecl(T, PU, U, VDS) .
  ceq procModule4(F[TL], PU, U, VDS, DB)
    = evalPreModule(preModule(PDR), unit(PDR), vars(PDR), DB)
    if F =/= '__ 
       /\ PDR := parseDecl(F[TL], PU, U, VDS) .
  eq procModule4(T, unitError(QIL), U, VDS, DB) = warning(DB, QIL) .
  eq procModule4(T, PU, unitError(QIL), VDS, DB) = warning(DB, QIL) .
  eq procModule4(T, PU, U, opDeclError(QIL), DB) = warning(DB, QIL) .

endfm

*******************************************************************************

***
*** 8.3.2 View Processing
***

*** A similar process is followed for views. Note that in case of operator
*** maps going to derived terms we have bubbles, which will have to be treated
*** using the signatures of the appropriate modules.

fmod VIEW-PROCESSING is
  pr UNIT-PROCESSING .
  pr VIEW-DECL-PARSING .
  pr VIEW-BUBBLE-PARSING .

  vars QI X F : Qid .
  var  QIL : QidList .
  vars T T' T'' T3 T4 : Term .
  var  M : Module .
  var  VE : ViewExp .
  vars PV PV' : PreView .
  vars ME ME' : ModuleExpression .
  vars DB DB' : Database .
  vars OPDS VDS VDS' VDS'' : OpDeclSet .
  var  MDS : MsgDeclSet .
  var  TL : TermList .
  vars PDL PDL' : ParameterDeclList .
  var  H : Header .
  var  IL : ImportList .
  var  PVMAPS : Set{PreViewMap} .

*** As the functions \texttt{getThSorts} and \texttt{getThClasses}
*** presented in Section~\ref{instantiation}, the functions
*** \texttt{getThOpDeclSet} and \texttt{getThMsgDeclSet} return, respectively,
*** the set of declarations of operators, and the set of declarations of 
*** messages in the theory part of the structure of the module given as 
*** argument.

  op getThOpDeclSet : Header Database -> OpDeclSet .
  op getThMsgDeclSet : Header Database -> MsgDeclSet .

  op getThOpDeclSetAux : ImportList Database -> OpDeclSet .
  op getThMsgDeclSetAux : ImportList Database -> MsgDeclSet .

  eq getThOpDeclSet(ME, DB)
    = if theory(getTopModule(ME, DB))
      then (getThOpDeclSetAux(getImports(getTopModule(ME, DB)), DB) 
            getOps(getTopModule(ME, DB)))
      else none
      fi .

  eq getThOpDeclSetAux(((including ME .) IL), DB)
    = (getThOpDeclSet(ME, DB) getThOpDeclSetAux(IL, DB)) .
  eq getThOpDeclSetAux(((extending ME .) IL), DB)
    = (getThOpDeclSet(ME, DB) getThOpDeclSetAux(IL, DB)) .
  eq getThOpDeclSetAux(((protecting ME .) IL), DB)
    = (getThOpDeclSet(ME, DB) getThOpDeclSetAux(IL, DB)) .
  eq getThOpDeclSetAux(nil, DB) = none .

  eq getThMsgDeclSet(ME, DB)
    = if theory(getTopModule(ME, DB))
      then (getThMsgDeclSetAux(getImports(getTopModule(ME, DB)), DB)  
            getMsgs(getTopModule(ME, DB)))
      else none
      fi .

  eq getThMsgDeclSetAux(((including ME .) IL), DB)
    = (getThMsgDeclSet(ME, DB) getThMsgDeclSetAux(IL, DB)) .
  eq getThMsgDeclSetAux(((extending ME .) IL), DB)
    = (getThMsgDeclSet(ME, DB) getThMsgDeclSetAux(IL, DB)) .
  eq getThMsgDeclSetAux(((protecting ME .) IL), DB)
    = (getThMsgDeclSet(ME, DB) getThMsgDeclSetAux(IL, DB)) .
  eq getThMsgDeclSetAux(nil, DB) = none .

*** The processing of terms representing previews accomplished by the function
*** \texttt{procView} is quite similar to the one accomplished by
*** \texttt{procModule} on terms representing preunits. The algorithms followed
*** are also quite similar. Both proceed recursively on the list of 
*** declarations, accumulating them in a preunit or in a preview.

*** The solving of bubbles in views requires the signatures of the source and
*** target units extended, respectively, with the declarations of variables in
*** the view and with the mappings of these declarations. As we shall see in
*** Section~\ref{databaseADT}, the signatures of the built-in modules are not
*** accesible at the metalevel, and thus built-in modules cannot be used
*** directly as arguments of built-in functions. Thus, to be able to use them
*** as targTS of views, a `dummy' module is created importing the 
*** corresponding predefined module. The source and target module expressions 
*** of the view are evaluated before the view processing itself starts.

*** As we saw in Section~\ref{view-decl-parsing}, parsing of terms representing
*** operator and message maps requires the set of operator and message
*** declarations in the theory part of the source theory.

  op procPars : ParameterDeclList Database -> Database .

  eq procPars((X :: ME, PDL), DB)
    = procPars(PDL, createCopy((X :: ME), database(evalModExp(ME, DB)))) .
  eq procPars((nil).ParameterDeclList, DB) = DB .

  op procView : Term Database -> Database .
  op procView2 : Term Database -> Database .
  op procView : Term PreView Database -> Database .
  op procViewAux :
       Term PreView OpDeclSet MsgDeclSet Module Database -> Database .

  eq procView(QI, DB) 
    = procView2(getTermView(QI, DB), DB) .

  eq procView2('view_from_to_is_endv['token[T], T', T'', T3], DB)
    = procView(T3, 
          emptyPreView(downQid(T), parseModExp(T'), parseModExp(T'')), 
          DB) .
  eq procView2('view_from_to_is_endv['_`{_`}['token[T], T'], T'', T3, T4], DB)
    = procView(T4, 
        setPars(
          emptyPreView(downQid(T), parseModExp(T''), parseModExp(T3)), 
          parseParList(T')),
        procPars(parseParList(T'), DB)) .

  eq procView('view_from_to_is_endv['token[T], T', T'', T3], DB)
    = procView(T3, 
        emptyPreView(downQid(T), parseModExp(T'), parseModExp(T'')), 
          insertTermView(downQid(T), 
            'view_from_to_is_endv['token[T], T', T'', T3], DB)) .
  eq procView('view_from_to_is_endv['_`{_`}['token[T], T'], T'', T3, T4], DB)
    = procView(T4, 
        setPars(
          emptyPreView(downQid(T), parseModExp(T''), parseModExp(T3)), 
          parseParList(T')),
        procPars(parseParList(T'), 
          insertTermView(downQid(T), 
            'view_from_to_is_endv['_`{_`}['token[T], T'], T'', T3, T4], 
            DB))) .

  ceq procView(T, PV, DB)
    = procViewAux(T, PV, 
        getThOpDeclSet(ME, DB'),
        getThMsgDeclSet(ME, DB'),
        getFlatModule(ME, DB'),
        DB')
    if preview_from_to_is__endpv(VE, ME, ME', none, none) := PV 
    /\ DB' := database(evalModExp(ME', nil, database(evalModExp(ME, nil, DB)))) .
  ceq procView(T, PV, DB)
    = procViewAux(T, PV, 
        getThOpDeclSet(ME, DB':[Database]),
        getThMsgDeclSet(ME, DB':[Database]),
        getFlatModule(ME, DB':[Database]),
        DB':[Database])
    if preview_from_to_is__endpv(VE{PDL}, ME, ME', none, none) := PV 
    /\ DB':[Database] := database(evalModExp(ME', PDL, database(evalModExp(ME, PDL, DB)))) .

  eq procViewAux('__[T, T'], PV, OPDS, MDS, M, DB)
  *** - OPDS and MDS are, respectively, the set of operation and 
  ***   message declarations in the theory part of the source. 
  *** - M is the signature of the source theory.
    = procViewAux(T', parseDecl(T, PV, OPDS, MDS, M), OPDS, MDS, M, DB) .
  ceq procViewAux(F[TL], PV, OPDS, MDS, M, DB)
    = insertView(
        view VE{PDL} from ME to ME' is
          solveBubbles(
            PVMAPS, 
            VDS, VDS', 
            addOps(VDS, M),
            addOps(VDS', getFlatModule(ME', DB)))
        endv,
        DB)
    if F =/= '__ 
       /\ preview_from_to_is__endpv(VE{PDL}, ME, ME', VDS, PVMAPS) 
          := parseDecl(F[TL], PV, OPDS, MDS, M)
       /\ VDS' := applyMapsToOps(sortMaps(PVMAPS), none, VDS, M) .
  ceq procViewAux(F[TL], PV, OPDS, MDS, M, DB)
    = insertView(
        view VE from ME to ME' is
          solveBubbles(
            PVMAPS, 
            VDS, VDS', 
            addOps(VDS, M),
            addOps(VDS', getFlatModule(ME', DB)))
        endv,
        DB)
    if F =/= '__ 
       /\ preview_from_to_is__endpv(VE, ME, ME', VDS, PVMAPS) 
          := parseDecl(F[TL], PV, OPDS, MDS, M)
       /\ VDS' := applyMapsToOps(sortMaps(PVMAPS), none, VDS, M) .
  eq procViewAux(T, PV, OPDS, MDS, unitError(QIL), DB) = warning(DB, QIL) .

endfm

*******************************************************************************

***
*** 8.3.3 Command Processing
***

*** The function \texttt{procCommand} only handles the \texttt{reduce},
*** \texttt{rewrite}, and \texttt{down} commands. The other commands are
*** directly evaluated by the rules for the top-level handling of the
*** database (see Section~\ref{database-handling}). The \texttt{procCommand}
*** function takes a term, which represents one of these commands, the name of
*** the default module, and a database. The result is a list of quoted
*** identifiers representing the result of the evaluation of the command that 
*** will be placed in the read-eval-print loop to be printed in the terminal.

*** The \texttt{reduce} and \texttt{rewrite} commands are basically evaluated
*** calling the built-in functions \texttt{metaReduce} and
*** \texttt{metaRewrite}, respectively. These functions are called with the
*** appropriate modules. In the case of commands in which an explicit module 
*** is not specified the default module is used.

*** The preparation of the output for these functions becomes more complex
*** when the \texttt{down} command is used. To deal with the \texttt{down}
*** command, an auxiliary function \texttt{procCommand2} is introduced,
*** returning the term resulting from the evaluation of the command.

view QidList from TRIV to QID-LIST is
  sort Elt to QidList .
endv

*******************************************************************************
***
*** Narrowing and Equational Unification
*** by Santiago Escobar
***

fmod UNIFICATIONTRIPLE is
  protecting META-LEVEL .
  protecting INT .

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

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

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

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

endfm

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


endfm

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

  var S S' Subst Subst' : Substitution .
  var V V' : Variable .
  var C C' : Constant .
  var Ct : Context .
  var T T' T1 T2 T1' T2' T1'' T2'' : Term .
  var F F' : Qid .
  var TL TL' TL1 TL2 TL1' TL2' : TermList .
  var Att : AttrSet .
  var RLS : RuleSet .
  var Rl : Rule .
  var TP : Type .
  var N : Nat .
  var NeTL : NeTermList .
  var CtL : NeCTermList .

  --- Apply Substitution to Term --------------------------------------------
  op _<<_ : Term Substitution -> Term .
  eq TL << none = TL .
  eq C << Subst = C .
  eq V << ((V <- T) ; Subst) = T .
  eq V << Subst = V [owise] .
  eq F[TL] << Subst = F[TL << Subst] .

  op _<<_ : TermList Substitution -> TermList .
  eq (T, NeTL) << Subst = (T << Subst, NeTL << Subst) .
  eq empty << Subst = empty .

  op _<<_ : Context Substitution -> Context .
  eq Ct << none = Ct .
  eq [] << Subst = [] .
  eq F[CtL,NeTL] << Subst = F[CtL << Subst,NeTL << Subst] .
  eq F[NeTL,CtL] << Subst = F[NeTL << Subst, CtL << Subst] .
  eq F[Ct] << Subst = F[Ct << Subst] .

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

  --- Combine Substitutions -------------------------------------------------
  op _.._ : Substitution Substitution -> Substitution .
  eq S .. S' = (S << S') ; S' .

  --- Restrict Assignments to Variables in a Term ----------------------
  op _|>_ : Substitution TermList -> Substitution .

  eq Subst |> TL = Subst |>* Vars(TL) .

  op _|>*_ : Substitution TermList -> Substitution .
  eq noMatch |>* TL = noMatch .
  eq none |>* TL = none .
  eq ((V <- V) ; Subst) |>* TL
   = Subst |>* TL .
  eq ((V <- T') ; Subst) |>* TL
    = if any V in TL
      then (V <- T')
      else none
      fi 
      ; (Subst |>* TL).

  --- Remove Variables from list ----------------------
  op _intersect_ : TermList TermList -> TermList .
  eq (TL1,T,TL2) intersect (TL1',T,TL2') 
   = (T,((TL1,TL2) intersect (TL1',TL2'))) .
  eq TL intersect TL' = empty [owise] .

  op _intersectVar_ : TermList TermList -> TermList .
  eq TL1 intersectVar TL2 
   = TL1 intersectVar* Vars(TL2) . 

  op _intersectVar*_ : TermList TermList -> TermList .
  eq (T,TL1) intersectVar* TL2 
   = (if any Vars(T) in TL2 then T else empty fi,TL1 intersectVar* TL2) .
  eq empty intersectVar* TL2 
   = empty .

  --- Variables ---
  op Vars : GTermList -> TermList .
  eq Vars((T,TL:GTermList)) = VarsTerm(T),Vars(TL:GTermList) .
  eq Vars((Ct,TL:GTermList)) = VarsTerm(Ct),Vars(TL:GTermList) .
  eq Vars(empty) = empty .
  
  op VarsTerm : Term -> TermList . ---warning memo
  eq VarsTerm(V) = V .
  eq VarsTerm(F[TL:TermList]) = Vars(TL:TermList) .
  eq VarsTerm(C) = empty .
  
  op VarsTerm : Context -> TermList . ---warning memo
  eq VarsTerm(F[TL:GTermList]) = Vars(TL:GTermList) .
  
  --- membership ---
  op _in_ : Term TermList -> Bool .
  eq T in (TL,T,TL') = true .
  eq T in TL = false [owise] .
  
  --- membership ---
  op any_in_ : TermList TermList -> Bool . --- [memo] .
  eq any empty in TL = false .
  eq any (TL1,T,TL2) in (TL1',T,TL2') = true .
  eq any TL in TL' = false [owise] .
  
  --- membership ---
  op all_in_ : TermList TermList -> Bool . --- [memo] .
  eq all empty in TL = true .
  eq all (TL1,T,TL2) in (TL1',T,TL2') = all (TL1,TL2) in (TL1',T,TL2') .
  eq all TL in TL' = false [owise] .
  
  --- Occur check ---
  op allVars_inVars_ : GTermList GTermList -> Bool .
  eq allVars TL:GTermList inVars TL':GTermList 
   = all Vars(TL:GTermList) in Vars(TL':GTermList) .

  op anyVars_inVars_ : GTermList GTermList -> Bool .
  eq anyVars TL:GTermList inVars TL':GTermList 
   = any Vars(TL:GTermList) in Vars(TL':GTermList) .

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

  op rangeVars : Substitution -> TermList .
  eq rangeVars(V <- T ; Subst) = (Vars(T),rangeVars(Subst)) .
  eq rangeVars(none) = empty .

  op dom_inVars_ : Substitution TermList -> Bool .
  eq dom Subst inVars TL = dom Subst in Vars(TL) .

  op dom_in_ : Substitution TermList -> Bool .
  eq dom (V <- T ; Subst) in (TL1,V,TL2) = true .
  eq dom Subst in TL = false [owise] .

  op range_inVars_ : Substitution TermList -> Bool .
  eq range Subst inVars TL = range Subst in Vars(TL) .

  op range_in_ : Substitution TermList -> Bool .
  eq range (V <- T ; Subst) in TL
   = any Vars(T) in TL or-else range Subst in TL .
  eq range none in TL
   = false .
endfm

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

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

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

endfm
---)

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

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

  var TPL : TypeList .

  --- Extra filter for substitutions ------
  op _|>_ : Substitution Nat -> Substitution .
  eq none |> N = none .
  eq ((V <- T') ; Subst) |> N
   = if highestVar(V) < N
     then (V <- T')
     else none
     fi
     ; (Subst |> N) .

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

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

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

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

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

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

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

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

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

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

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

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

endfm

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

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

  vars SS SS' : SubstitutionSet .
  vars S S' Subst : Substitution .
  vars T T' : Term .
  vars TL TL' : TermList .
  vars N N' : Nat .
  var V : Variable .

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

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

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

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

  eq S ...' empty
   = empty .

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

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

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

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

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

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

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

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

endfm

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

endfm

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

fmod MODULE-HANDLING is
  protecting INT .
  protecting META-LEVEL .
  protecting EXT-BOOL . *** From Full Maude
  protecting SUBSTITUTION-HANDLING .
  pr UNIT . ---- added by PD

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

endfm

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

  var M : Module .
  var T T' : Term .
  var TL : TermList .
  vars S S' S* S'* : Substitution .
  vars V V' : Variable .
  vars N N' NOld : Nat .
  var US : [UnificationTripleSet] .

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

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

  op minimizeBindingsTermE : Module TermList ---variables to minimize bindings
                             Nat --- or maximum index of variables 
                             UnificationTriple Substitution Substitution
                          -> UnificationTriple .
  eq minimizeBindingsTermE(M,TL,NOld,{S*,S'*,N},none,none) 
   = {S*,S'*,N} .
  eq minimizeBindingsTermE(M,TL,NOld,{S*,V <- V ; S'*,N},none,V <- V ; S') 
   = minimizeBindingsTermE(M,TL,NOld,{S*,S'*,N},none,S') .
  eq minimizeBindingsTermE(M,TL,NOld,{S*,V <- T' ; S'*,N},none,V <- T' ; S')
   = if T' :: Variable 
        and-then not (V in TL) and-then not (T' in TL)
        and-then highestVar(V) < NOld
        and-then highestVar(T') >= NOld
        and-then typeLeq(M,getTypes(M,V),getTypes(M,T'))
     then minimizeBindingsTermE(M,TL,NOld,
               {S* << (T' <- V),S'* .. (T' <- V),N},
                none,S' .. (T' <- V)) 
     else minimizeBindingsTermE(M,TL,NOld,{S*,V <- T' ; S'*,N},none,S')
     fi .
  eq minimizeBindingsTermE(M,TL,NOld,{V <- V ; S*,S'*,N},V <- V ; S,S') 
   = minimizeBindingsTermE(M,TL,NOld,{S*,S'*,N},S,S') .
  eq minimizeBindingsTermE(M,TL,NOld,{V <- T' ; S*,S'*,N},V <- T' ; S,S') 
   = if T' :: Variable 
        and-then V in TL and-then not (T' in TL)
        and-then typeLeq(M,getTypes(M,V),getTypes(M,T'))
     then minimizeBindingsTermE(M,TL,NOld,
               {S* << (T' <- V),S'* .. (T' <- V),N},
               S << (T' <- V),S' .. (T' <- V)) 
     else minimizeBindingsTermE(M,TL,NOld,{V <- T' ; S*,S'*,N},S,S')
     fi .
endfm

fmod TYPEOFNARROWING is
  pr QID .

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

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

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

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

  op _in_ : TypeOfNarrowingElem TypeOfNarrowing -> Bool .
  eq X:TypeOfNarrowingElem in X:TypeOfNarrowingElem XS:TypeOfNarrowing
   = true .
  eq X:TypeOfNarrowingElem in XS:TypeOfNarrowing
   = false [owise] .

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

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

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

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

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

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

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

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

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

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

  var RT : ResultTripleSet .

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

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

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

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

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

  --- Flag to know whether term is a end point or not
  op end : Bool -> Flag [ctor frozen] .
  
  op end : Bool Flags -> Flags .
  eq end(B:Bool, end(B':Bool) B:Flags) = end(B:Bool) B:Flags .
  eq end(B:Bool, B:Flags) = end(B:Bool) B:Flags [owise] .
  
  op end : Flags -> Bool .
  eq end(end(B:Bool) B:Flags) = B:Bool .
  eq end(B:Flags) = false [owise] .
  ---
  
  sorts ResultContext ResultContextSet .
  op {_,_,_,_,_,_,_,_,_,_} : 
      Term Type 
      Substitution Substitution --- computed subs and applied subst
      Context Context --- Original and WithSubst
      Term Term --- TermWithSubst and ContextWithTermAndSubt
      Nat --- highest index of variable
      Flags 
      -> ResultContext [ctor] .
		       
  subsort ResultContext < ResultContextSet .
  op empty : -> ResultContextSet [ctor] .
  op _|_ : ResultContextSet ResultContextSet -> ResultContextSet
    [ctor assoc comm id: empty prec 65 format (d n d d)] .
  eq X:ResultContext | X:ResultContext = X:ResultContext .

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

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

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

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

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

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

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

endfm

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

fmod EFLAGS is
  pr TYPEOFNARROWING .
  pr IRR-FLAGS .

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

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

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

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

fmod VARIANT is
  pr SUBSTITUTION-HANDLING .
  pr META-MINIMIZE-BINDINGS .
  pr RESULT-CONTEXT-SET .
  pr MODULE-HANDLING .
  pr META-LEVEL .

  var M : Module .
  vars T T' TS TS' CtTS CtTS' Lhs Rhs : Term .
  vars N N' NextVar NextVar' NextVar'' : Nat .
  var B : Bound .
  var TL TL' : TermList .
  var NeTL : NeTermList .
  var EqS : EquationSet .
  var AtS : AttrSet .
  var Q : Qid .
  vars S S' : Substitution .
  var V : Variable .
  var R RT : ResultContext .
  vars RTS RTS' : ResultContextSet .
  vars TP TP' : Type .
  vars Ct Ct' CtS CtS' : Context .
  var C : Constant .
  vars F F' : Qid .

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

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

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

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

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

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

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

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

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

endfm

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  --- metaEUnify --------------------------------------------------
  op metaEUnify& : Module Term Term Nat EFlags -> UnificationTripleSet .
  eq metaEUnify&(M,T,T',NextVar,EF)
   = if glbSorts(M,leastSort(M,T),leastSort(M,T')) =/= none
     then metaEUnify$(M,T,T',NextVar,EF)
     else empty
     fi .

  op metaEUnify&? : Module Term Term Nat EFlags -> Bool .
  eq metaEUnify&?(M,T,T',NextVar,EF)
   = metaEUnify$?(M,T,T',NextVar,EF) .

  op metaEUnify$ : Module Term Term Nat EFlags -> UnificationTripleSet .
                      --- Term Lhs
  eq metaEUnify$(M,T,T',NextVar,EF)
   = if howManyAC(M,(T,T')) > 0
     then metaEUnify-Variant(M,EF,NextVar,
            getVariantsTerm(M,T,NextVar,EF),
            getVariants(M,T',maxNextVar(getVariantsTerm(M,T,NextVar,EF)),EF)
          ) 
     else metaEUnify-Basic(M,T,T',NextVar,EF)
     fi .

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

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

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

  op metaEUnify-Variant* : Module EFlags Nat VariantFourSet VariantFourSet
                 -> UnificationTripleSet .
  eq metaEUnify-Variant*(M,EF,N, empty, VTS')
   = empty .
  eq metaEUnify-Variant*(M,EF,N, VT | VTS, VTS')
   = metaEUnify-Variant**(M,EF,N, VT, VTS') 
     | 
     if testUnifier in EF 
        and
        metaEUnify-Variant**(M,EF,N, VT, VTS') =/= empty
     then empty
     else metaEUnify-Variant*(M,EF,N, VTS, VTS')
     fi .

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

  op metaEUnify-Variant*** : Module EFlags Nat VariantFour VariantFour
                          -> UnificationTripleSet .
 ceq metaEUnify-Variant***(M,EF,N,{T,S,S*,NextVar},{T',S',S'*,NextVar'}) 
   = if X:[UnificationTripleSet] :: UnificationTripleSet 
        and-then 
        X:[UnificationTripleSet] =/= empty
     then {S,S',max(NextVar,NextVar')} ... X:[UnificationTripleSet]
     else empty
     fi 
  if X:[UnificationTripleSet] := metaEUV***(EF,N,M,T,T',max(NextVar,NextVar')) .

  op metaEUV*** : EFlags Nat Module Term Term Nat -> UnificationTripleSet .
---   eq metaEUV***(EF,N,M,T,T',NextVar)
---    = filter-variant-UP(minimal-unifiers EF,eqs2rls(clearAllFrozen(M)),N,
---         metaEUV****(EF,M,T,T',NextVar) 
---      ) .
  eq metaEUV***(EF,N,M,T,T',NextVar)
   = metaEUV****(EF,M,T,T',NextVar) .

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

  op getVariants : Module Term Nat EFlags -> VariantFourSet .
  eq getVariants(M,T,NextVar,EF)
   = if howMany(M,T) == 0 then {T,none,none,NextVar}
     else 
       filter-variant-VT(EF, ---minimal-unifiers EF,
        eqs2rls(clearAllFrozen(M)),NextVar,
        toVariants(NextVar,
          metaNarrowSearchGenAll(eqs2rls(clearAllFrozen(M)),
           T,newVar(NextVar,leastSort(M,T)),
           none,'*,howMany(M,T),unbounded,
           variant noStrategy [EF], ---do not use innermost!!!
           NextVar + 1) 
        )
       )
     fi .

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

endfm

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

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

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

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

  *** General Call for UnificationPairSet
  op metaACUnify : Module Term Term Nat -> UnificationTripleSet .
                      --- Term Lhs
  eq metaACUnify(M, T, T', N) 
   = if (root(T) =/= root(T') 
         and not (root(T) :: Variable) and not (root(T') :: Variable))
        or-else
        glbSorts(M,leastSort(M,T),leastSort(M,T')) == none
     then empty
     else minimizeBindingsTerm(M,Vars(T),N,metaACUnifyCollect(M, T, T',N,0)) 
     fi .

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

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

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

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

fmod META-ACU-UNIFICATION is
  pr META-AC-UNIFICATION .
  pr IRR-FLAGS .

  var M : Module .
  vars T T' Lhs Rhs : Term .
  var S : Substitution .
  var V : Variable .
  var C : Constant .
  vars N N' : Nat .
  var US : [UnificationPairSet] .
  vars F F' : Qid .
  var AtS : AttrSet .
  var At : Attr .
  var TP TP' : Type .
  var TPL TPL' : TypeList .
  var OPDS : OpDeclSet .
  var TL : NeTermList .
  var EqS : EquationSet .
  var IRR : IrrFlags .

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

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

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

  op metaACUUnifyIrr : Module Term Term Nat -> UnificationTripleSet .
  eq metaACUUnifyIrr(M, T, T',N) 
   = metaACUUnify*(M,T,T',N,irreducible) .

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

  op metaACUUnify-minimal : Module Term Term Nat -> UnificationTripleSet .
  eq metaACUUnify-minimal(M, T, T',N) 
   = metaACUUnify*(M,T,T',N,reducible minimal-unifiers) .

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

  op metaACUUnifyIrr-minimal : Module Term Term Nat -> UnificationTripleSet .
  eq metaACUUnifyIrr-minimal(M, T, T',N) 
   = metaACUUnify*(M,T,T',N,irreducible minimal-unifiers) .

  *** General Call for UnificationPairSet
  op metaACUUnify* : Module Term Term Nat IrrFlags -> UnificationTripleSet .
                       --- Term Lhs
  eq metaACUUnify*(M, T, T', N,IRR) 
   = if glbSorts(M,leastSort(M,T),leastSort(M,T')) == none
     then empty
     else minimizeBindingsTerm(M,Vars(T),metaACUUnifyAux(M,T,T',N,IRR)) 
     fi .

  op metaACUUnifyAux : Module Term Term Nat IrrFlags -> UnificationTripleSet .
  eq metaACUUnifyAux(M,T,T',N,IRR)
   = if getBound(eqsforIdSymbols(M,(T,T'))) > 0
     then filter-variant-UP(IRR,eqs2rls(clearAllFrozen(M)),N,
           metaEACUnify(
            keepOnlyACAttr(
              addEqs(getEqs(eqsforIdSymbols(M,(T,T'))),eraseEqs(eraseRls(M)))
            ),
            unflatten(M,T), unflatten(M,T'), N,
            IRR
           )
          )
     else metaACUnifyCollect(M, T, T',N,0)
     fi .

  *** Extra handy sort
  sort Eqs&Bound .
  op {_,_} : EquationSet Nat -> Eqs&Bound .
  op getEqs : Eqs&Bound -> EquationSet .
  eq getEqs({X:EquationSet,X:Nat}) = X:EquationSet .
  op getBound : Eqs&Bound -> Nat .
  eq getBound({X:EquationSet,X:Nat}) = X:Nat .
  op _+_ : Eqs&Bound Eqs&Bound -> Eqs&Bound .
  eq {X1:EquationSet,X1:Nat} + {X2:EquationSet,X2:Nat} 
   = {X1:EquationSet X2:EquationSet, X1:Nat + X2:Nat} .

  *** Extra code for ACU Unification
  op eqsforIdSymbols : Module NeTermList -> Eqs&Bound . ---[memo] .
  eq eqsforIdSymbols(M,TL) = eqsforIdSymbols*(M,getOps(M),TL) .

  op eqsforIdSymbols* : Module OpDeclSet NeTermList -> Eqs&Bound .
  eq eqsforIdSymbols*(M,
       (op F : TPL -> TP [special(X:NeHookList) AtS] .) OPDS,TL) 
   = eqsforIdSymbols*(M,OPDS,TL) .
  eq eqsforIdSymbols*(M,(op F : TPL -> TP [id(T) AtS] .) OPDS,TL) 
   = eqsforIdSymbols**(M,F,getKind(M,TP),id(T),TL) 
      + eqsforIdSymbols*(M,OPDS,TL) .
  eq eqsforIdSymbols*(M,(op F : TPL -> TP [left-id(T) AtS] .) OPDS,TL) 
   = eqsforIdSymbols**(M,F,getKind(M,TP),left-id(T),TL) 
      + eqsforIdSymbols*(M,OPDS,TL) .
  eq eqsforIdSymbols*(M,(op F : TPL -> TP [right-id(T) AtS] .) OPDS,TL) 
   = eqsforIdSymbols**(M,F,getKind(M,TP),right-id(T),TL) 
      + eqsforIdSymbols*(M,OPDS,TL) .
  eq eqsforIdSymbols*(M,OPDS,TL) 
   = {none,0} [owise] .

  op eqsforIdSymbols** : Module Qid Type Attr NeTermList -> Eqs&Bound .
  eq eqsforIdSymbols**(M,F,TP,At,C)
   = {none,0} .
  eq eqsforIdSymbols**(M,F,TP,At,V)
   = {none,0} .
  eq eqsforIdSymbols**(M,F',TP,id(T),F[TL])
   = if F == F' 
        and-then 
        getKind(M,leastSort(M,F[TL])) == TP
     then if isCommutative(M,F,getTypes(M,TL))
          then {(eq F[T,addType TP ToVar 'X] = addType TP ToVar 'X [none] .),1}
          else {(eq F[T,addType TP ToVar 'X] = addType TP ToVar 'X [none] .)
                (eq F[addType TP ToVar 'X,T] = addType TP ToVar 'X [none] .),1}
          fi 
     else {none,0}
     fi 
     + eqsforIdSymbols**(M,F',TP,id(T),TL) .
  eq eqsforIdSymbols**(M,F',TP,left-id(T),F[TL])
   = if F == F' 
        and-then 
        getKind(M,leastSort(M,F[TL])) == TP
        and-then
        not isCommutative(M,F,getTypes(M,TL))
     then {(eq F[T,addType TP ToVar 'X] = addType TP ToVar 'X [none] .),1} 
     else {none,0}
     fi 
     + eqsforIdSymbols**(M,F',TP,left-id(T),TL) .
  eq eqsforIdSymbols**(M,F',TP,right-id(T),F[TL])
   = if F == F' 
        and-then 
        getKind(M,leastSort(M,F[TL])) == TP
        and-then
        not isCommutative(M,F,getTypes(M,TL))
     then {(eq F[addType TP ToVar 'X,T] = addType TP ToVar 'X [none] .),1} 
     else {none,0}
     fi 
     + eqsforIdSymbols**(M,F',TP,right-id(T),TL) .
  eq eqsforIdSymbols**(M,F,TP,At,(T,TL))
   = eqsforIdSymbols**(M,F,TP,At,T) + eqsforIdSymbols**(M,F,TP,At,TL) .
endfm

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

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

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

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

endfm

fmod ORDERS-TERM-SUBSTITUTION is
  protecting TERM-HANDLING .
  protecting SUBSTITUTION-HANDLING .
  protecting META-LEVEL .
  protecting META-UNIFICATION .
  protecting META-E-UNIFICATION .
  protecting RENAMING .
  protecting SUBSTITUTIONSET .

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

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

  --- metaMatch(M,T,T') implies that T is an instance of T'
  op metaMatch : Module Term Term -> SubstitutionSet .
  eq metaMatch(M,T,T')
   = if glbSorts(M,leastSort(M,T),leastSort(M,T')) == none
     then empty
     else metaMatchCollect(eraseEqs(eraseRls(M)),T,T')
     fi .
   
  op metaMatch? : Module Term Term -> Bool .
  eq metaMatch?(M,T,T')
   = glbSorts(M,leastSort(M,T),leastSort(M,T')) =/= none
     and-then 
     metaMatch(eraseEqs(eraseRls(M)),T',T,nil,0) =/= noMatch .

  --- metaMatchCollect(M,T,T') calls Maude metaMatch
  op metaMatchCollect : Module Term Term -> SubstitutionSet . ---[memo] .
  eq metaMatchCollect(M,T,T')
   = metaMatchCollect*(M,T,T',empty,0) .
   
  op metaMatchCollect* : Module Term Term SubstitutionSet Nat 
                      -> SubstitutionSet .
  eq metaMatchCollect*(M,T,T',SS,N:Nat)
   = if metaMatch(M,T',T,nil,N:Nat) =/= noMatch
     then metaMatchCollect*(M,T,T',
                            SS | metaMatch(M,T',T,nil,N:Nat),
                            s(N:Nat))
     else SS
     fi .

  --- metaEMatch(M,T,T') implies that T is an instance of T' modulo E + axioms
  op metaEMatch : Module Term Term -> SubstitutionSet .
  eq metaEMatch(M,T,T')
   = if metaMatch(M,T,T') =/= empty
     then metaMatch(M,T,T')
     else if metaEACUUnifyIrr?(M,T,T')
          then metaMatchShared-filter(M,T,T',metaEACUUnifyIrr(M,T,T'))
          else empty
          fi
     fi .

  op metaEMatch? : Module Term Term -> Bool .
  eq metaEMatch?(M,T,T')
   = metaMatch(M,T,T') =/= empty
     or-else
     metaEACUUnifyIrr?(M,T,T') .

  --- Standard metaMatch does not deal with shared variables between T and T'  
  --- metaMatch(M,T,T') implies that T is an instance of T'

  op metaMatchShared : Module Term Term -> SubstitutionSet .
  eq metaMatchShared(M,T,T')
   = metaMatchShared-filter(M,T,T',metaMatch(M,T,T')) .

  op metaMatchShared-filter : Module Term Term SubstitutionSet 
                           -> SubstitutionSet .
  eq metaMatchShared-filter(M,T,T',empty)
   = empty .
  eq metaMatchShared-filter(M,T,T',S | SS)
   = if S |> T == none --- this is faster!!!
     then S
     else empty 
     fi
     | metaMatchShared-filter(M,T,T',SS) .

  --- order between terms ---------------------------
  --- T <=[M] T' implies that T' is an instance of T
  op _<=[_]_ : Term Module Term -> Bool .
  eq T <=[M] T' = (metaMatch(M,T',T) |> T) =/= empty .

  --- T <=[M] T' implies that T' is an instance of T
  --- T and T' can have shared variables
  op _*<=[_]*_ : Term Module Term -> Bool .
  eq T *<=[M]* T' 
   = (if anyVars T inVars T'
      then metaMatchShared(M,T',T)
      else metaMatch(M,T',T)
      fi |> T) 
     =/= empty .

  --- order between substitutions ---------------------------
  --- Subst <=[M] Subst' implies that Subst' is an instance of Subst
  op _<=[_]_ : SubstitutionSet Module SubstitutionSet -> Bool [ditto] .
  eq empty <=[M] SS'
   = false .
  eq SS <=[M] SS'
   = SS <=[M]$ SS' [owise] .

  op _<=[_]$_ : SubstitutionSet Module SubstitutionSet -> Bool .
  eq SS <=[M]$ empty
   = true .
  eq SS <=[M]$ (S' | SS')
   = (SS <=[M]* S') and-then SS <=[M]$ SS' .

  op _<=[_]*_ : SubstitutionSet Module Substitution -> Bool .
  eq empty <=[M]* S'
   = false .
  eq (S | SS) <=[M]* S'
   = S <=[M]** S' or-else SS <=[M]* S' .

  op _<=[_]**_ : Substitution Module Substitution -> Bool . ---[memo] .
  eq none <=[M]** S'
   = true . 
  eq S <=[M]** S' 
   = 'Q[1st(gen(S,S'))] 
     *<=[ 
       addSorts('XXX,
       addOps((op 'Q : 3rd(gen(S,S')) -> 'XXX [none] .),
         M)) 
     ]*
     'Q[2nd(gen(S,S'))] 
  [owise] .

  sort Triple . 
  op {{_`,_`,_}} : TermList TermList TypeList -> Triple .
  op 1st : Triple -> TermList .
  eq 1st({{TL,TL',TPL}}) = TL .
  op 2nd : Triple -> TermList .
  eq 2nd({{TL,TL',TPL}}) = TL' .
  op 3rd : Triple -> TypeList .
  eq 3rd({{TL,TL',TPL}}) = TPL .

  ops gen : Substitution Substitution -> Triple . ---[memo] .
  eq gen(none,none) 
   = {{empty,empty,nil}} .
  eq gen(none,V <- T ; S') 
   = {{(V,1st(gen(none,S'))),
       (T,2nd(gen(none,S'))),
       (getType(V) 3rd(gen(none,S')))}} .
  eq gen(V <- T ; S,V <- T' ; S')
   = {{(T,1st(gen(S,S'))),
       (T',2nd(gen(S,S'))),
       (getType(V) 3rd(gen(S,S')))}} .
  eq gen(V <- T ; S,S') 
   = {{(T,1st(gen(S,S'))),
       (V,2nd(gen(S,S'))),
       (getType(V) 3rd(gen(S,S')))}} 
   [owise] . 

  --- renaming -----------------------------------------------
  op metaRenaming : Module Term Term -> Bool .
  eq metaRenaming(M,T,T')
   = T =[M]= T' .

  op _=[_]=_ : TermSet Module TermSet -> Bool .
  eq emptyTermSet =[M:Module]= emptyTermSet
   = true . 
  ceq T:Term | T:TermSet =[M:Module]= T':Term | T':TermSet 
    = T:TermSet =[M:Module]= T':TermSet 
   if T:Term =[M:Module]$= T':Term .
  eq T:TermSet =[M:Module]= T':TermSet
   = false [owise] .

  op _=[_]$=_ : Term Module Term -> Bool .
  eq T =[M]$= T' = onlyRenaming(metaMatchShared(M,T',T) |> T) .

  op onlyRenaming : SubstitutionSet -> Bool .
  eq onlyRenaming(empty) 
   = false .
  eq onlyRenaming(S | SS)
   = onlyRenaming*(S) or-else onlyRenaming(SS) .

  op onlyRenaming* : Substitution -> Bool .
  eq onlyRenaming*((V <- T) ; (V' <- T) ; S)
   = false .
  eq onlyRenaming*(S) = onlyRenaming**(S) [owise] .

  op onlyRenaming** : Substitution -> Bool .
  eq onlyRenaming**(none) 
   = true .
  eq onlyRenaming**((V <- T) ; S)
   = T :: Variable and onlyRenaming**(S) .

  *** Normalize Substitutions
  op normalizedSubstitution? : Module SubstitutionSet -> Bool .
  eq normalizedSubstitution?(M, empty)
   = true .
  eq normalizedSubstitution?(M, S | SS)
   = normalizedSubstitution?*(M, S) and-then normalizedSubstitution?(M, SS) .

  op normalizedSubstitution?* : Module Substitution -> Bool . ---[memo] .
  eq normalizedSubstitution?*(M, none)
   = true .
  eq normalizedSubstitution?*(M, V <- T ; S:Substitution)
   = isNF$(clearAllFrozen(M),T) 
     and-then 
     normalizedSubstitution?*(M, S:Substitution) .

  *** Normalize Substitutions
  op |_|`(_`) : SubstitutionSet Module -> SubstitutionSet .
  eq | S:SubstitutionSet |(M)
   = eqNormalizeSubstitution(M,S:SubstitutionSet) .

  op eqNormalizeSubstitution : Module SubstitutionSet -> SubstitutionSet .
  eq eqNormalizeSubstitution(M, empty)
   = empty .
  eq eqNormalizeSubstitution(M, S | SS)
   = eqNormalizeSubstitution*(M, S) | eqNormalizeSubstitution(M, SS) .

  op eqNormalizeSubstitution* : Module Substitution -> Substitution .
  eq eqNormalizeSubstitution*(M, none)
   = none .
  eq eqNormalizeSubstitution*(M, V <- T ; S:Substitution)
   = V <- getTerm(metaReduce(eraseRls(M),T)) 
     ; eqNormalizeSubstitution*(M, S:Substitution) .
endfm

fmod META-NORMALIZE is
  protecting META-TERM .
  protecting META-LEVEL .
  protecting META-UNIFICATION .
  protecting RESULT-CONTEXT-SET .
  protecting ORDERS-TERM-SUBSTITUTION .
  protecting TYPEOFNARROWING .

  vars T T' TOrig Lhs Rhs TS TS' CtTS CtTS' : Term .
  var V : Variable .
  var C : Constant .
  var F : Qid .
  vars TL TL' : TermList .
  var M : Module .
  vars RTS RTS' RTS$ RTS$' : ResultContextSet .
  vars RT RT' : ResultContext .
  vars TP TP' : Type .
  vars S S' S* S'* Subst : Substitution .
  var RLS : RuleSet .
  var Att : AttrSet .
  vars B BN : Bound .
  vars N NextVar NextVar' : Nat .
  var NL : NatList .
  vars Ct CtS Ct' CtS' : Context .
  var ON : TypeOfNarrowing .
  var QQ : TypeOfRelation .

  *** Shortcut to Normalization by rewriting Search
  op metaNormalizeCollect$ : Module Term ~> ResultTripleSet .
  eq metaNormalizeCollect$(M,T)
   = metaNormalizeCollect$(M,{T,leastSort(M,T),none}) .

  op metaNormalizeCollect$ : Module Term Type ~> ResultTripleSet .
  eq metaNormalizeCollect$(M,T,TP)
   = metaNormalizeCollect$(M,{T,TP,none}) .

  op metaNormalizeCollect$ : Module ResultTriple ~> ResultTripleSet . ---[memo] .
  eq metaNormalizeCollect$(M,{T,TP,S})
   = metaSearchCollect(M, 
       T, (addType TP ToVar 'XXXXXXX),
       '!,unbounded) .
       
  *** Shortcut to One rewriting step
  op metaOneRewriting$ : Module Term ~> ResultTripleSet .
  eq metaOneRewriting$(M,T)
   = metaOneRewriting$(M,{T,leastSort(M,T),none}) .

  op metaOneRewriting$ : Module Term Type -> ResultTripleSet .
  eq metaOneRewriting$(M,T,TP)
   = metaOneRewriting$(M,{T,TP,none}) .

  op metaOneRewriting$ : Module ResultTriple -> ResultTripleSet . ---[memo] .
  
  eq metaOneRewriting$(M,{T,TP,S})
   = metaSearchCollect(M, 
       T, (addType TP ToVar 'XXXXXXX),
       '+,1) .
   
  *** Use Standard Maude metaSearch 
  op metaSearchCollect : Module Term Term TypeOfRelation Bound 
                      ~> ResultTripleSet .
  eq metaSearchCollect(M,T,T',QQ,B)
   = metaSearchCollect(clearNonExec(M),T,T',QQ,B,0) .
  
  op metaSearchCollect : Module Term Term TypeOfRelation Bound Nat 
                      ~> ResultTripleSet .
  eq metaSearchCollect(M,T,T',QQ,B,N:Nat)
   = if metaSearch(M,T,T',nil,[QQ],B,N:Nat) :: ResultTripleSet
        and
        metaSearch(M,T,T',nil,[QQ],B,N:Nat) =/= failure
     then metaSearch(M,T,T',nil,[QQ],B,N:Nat) 
          |
          metaSearchCollect(M,T,T',QQ,B,s(N:Nat)) 
     else empty
     fi .

  *** Shortcut to normal form detection
  op isNF$ : Module Term ~> Bool .
  eq isNF$(M,T) = isNF$$(M,T,leastSort(M,T)) .

  op isNF$$ : Module Term Type ~> Bool .
  eq isNF$$(M,T,TP)
   = metaSearch(M,T,(addType TP ToVar 'XXXXXXX),nil,'+,1,0) == failure .

  ***********************************************************************
  --- Not defined in this module-------------
  op metaNarrowSearchAll : Module Term Term SubstitutionCond TypeOfRelation
                            Bound Bound --- number steps / number solutions
                            TypeOfNarrowing
                            ResultContextSet
			 -> ResultContextSet .
  op oneMoreStep : Module SubstitutionCond TypeOfNarrowing
                   ResultContextSet -> ResultContextSet .
  --- Not defined in this module-------------

  op metaNormalizeCollect : Module Term ~> ResultTripleSet .
  eq metaNormalizeCollect(M,T)
   = metaNormalizeCollect(M,{T,leastSort(M,T),none}) .

  op metaNormalizeCollect : Module Term Type -> ResultTripleSet .
  eq metaNormalizeCollect(M,T,TP)
   = metaNormalizeCollect(M,{T,TP,none}) .

  ---metaSearch of Maude doesn't work for rules with extra vars  
  op metaNormalizeCollect : Module ResultTriple -> ResultTripleSet .
  eq metaNormalizeCollect(M,{T,TP,S})
   = toTriple(M,
     metaNarrowSearchAll(
       M,
       T, (addType TP ToVar 'XXXXXXX),
       none,'!,unbounded,unbounded,E-rewriting noStrategy,
       {T,TP,S,none,[],[],T << S,T << S,
        max(highestVar(S),highestVar((T,T << S))) + 1,
        empty}
     )) .

  op metaOneRewriting : Module Term ~> ResultTripleSet .
  eq metaOneRewriting(M,T)
   = metaOneRewriting(M,{T,leastSort(M,T),none}) .

  op metaOneRewriting : Module Term Type -> ResultTripleSet .
  eq metaOneRewriting(M,T,TP)
   = metaOneRewriting(M,{T,TP,none}) .

  op metaOneRewriting : Module ResultTriple -> ResultTripleSet . 
  eq metaOneRewriting(M,{T,TP,S})
   = toTriple(M,
     metaNarrowSearchAll(
       M,
       T, (addType TP ToVar 'XXXXXXX),
       none,'+,1,unbounded,E-rewriting noStrategy,
       {T,TP,S,none,[],[],T << S,T << S,
        max(highestVar(S),highestVar((T,T << S))) + 1,
        empty}
     )) .

  *** Remove itself
  op noSelf : ResultContextSet ResultContextSet -> ResultContextSet .
  eq noSelf(empty,RTS')
   = RTS' .
  eq noSelf({T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,B:Flags} | RTS,RTS')
   = noSelf(RTS,
      if TS == T and-then CtTS == T and-then Ct == [] and-then CtS == []
      then noSelf*({T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,B:Flags}, RTS')
      else RTS'
      fi
     ) .

  op noSelf* : ResultContext ResultContextSet -> ResultContextSet .
  eq noSelf*(RT,empty)
   = empty .
  eq noSelf*({T,TP,S,S*,[],[],T,T,NextVar,B:Flags}, 
             {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',B':Flags} | RTS)
   = if TS' == T' and-then CtTS' == T' and-then Ct' == [] and-then CtS' == []
        and-then 
        T == T' and-then TP == TP' 
        and-then 
        (S |> T) == (S' |> T) 
     then ---remove
          empty
     else ---keep
          {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',B':Flags}
     fi
     | noSelf*({T,TP,S,S*,[],[],T,T,NextVar,B:Flags},RTS) .

endfm

fmod META-E-NARROWING is
  protecting META-TERM .
  protecting META-LEVEL .
  protecting META-UNIFICATION .
  protecting META-E-UNIFICATION .
  protecting RESULT-CONTEXT-SET .
  protecting ORDERS-TERM-SUBSTITUTION .
  protecting TYPEOFNARROWING .
  protecting META-NORMALIZE .
  protecting UNIFICATIONTRIPLESET .

  var T T' T'' TOrig Lhs Lhs' Rhs Rhs'  : Term .
  var CT' TS TS' TS'' CtTS CtTS' CtTS'' : Term .
  var V : Variable .
  var C : Constant .
  var F : Qid .
  var M : Module .
  var RTS RTS' RTS$ RTS-Rls RTS-Sub : ResultContextSet .
  var RT RT' : ResultContext .
  vars S S' S'' Subst Subst' S* S'* : Substitution .
  var SS : SubstitutionSet .
  var RLS : RuleSet .
  var RL : Rule .
  vars Att Att' : AttrSet .
  var B BN : Bound .
  vars N N' N1 N2 : Nat .
  var NL : NatList .
  vars Ct CtS Ct' CtS' Ct'' CtS'' : Context .
  var NeTL NeTL' : NeTermList .
  vars TL TL' TL'' TL''' : TermList .
  vars TP TP' TP'' : Type .
  var ON : TypeOfNarrowing .
  vars NextVar NextVar' NextVar'' NVarPrev : Nat .
  var U : UnificationTriple .
  vars US US' : UnificationTripleSet .
  var IRR : IrrFlags .

  --- metaNarrow ---------------------------
  ---( We implement:
       * basic narrowing, where terms introduced
         by unifiers (substitutions) are never
         selected for narrowing, and
       * standard narrowing, where this
         restriction does not apply  )


  *** Shortcuts to Narrowing
  op metaNarrow : Module Term -> ResultTripleSet .
  eq metaNarrow(M,T) = metaNarrow(M,T,1) .

  op metaNarrow : Module Term Bound -> ResultTripleSet .
  eq metaNarrow(M,T,B) 
   = toTriple(M,metaENarrowShowAll(M,T,B,full noStrategy AC-unify)) |> T .

  *** Shortcuts to Basic Narrowing
  op metaBasicNarrow : Module Term -> ResultTripleSet .
  eq metaBasicNarrow(M,T) = metaBasicNarrow(M,T,1) .

  op metaBasicNarrow : Module Term Bound -> ResultTripleSet .
  eq metaBasicNarrow(M,T,B) 
   = toTriple(M,metaENarrowShowAll(M,T,B,basic noStrategy ACU-unify)) |> T .

  *** Shortcuts to Narrowing
  op metaENarrow : Module Term -> ResultTripleSet .
  eq metaENarrow(M,T) = metaENarrow(M,T,1) .

  op metaENarrow : Module Term Bound -> ResultTripleSet .
  eq metaENarrow(M,T,B)
   = toTriple(M,metaENarrowShowAll(M,T,B,full noStrategy E-ACU-unify)) |> T .

  *** Shortcuts to Narrowing
  op metaEACTopMostNarrow : Module Term -> ResultTripleSet .
  eq metaEACTopMostNarrow(M,T) 
   = metaETopMostNarrow(M,T,1,reducible, E-AC-unify) .
  op metaEACTopMostNarrowIrr : Module Term -> ResultTripleSet .
  eq metaEACTopMostNarrowIrr(M,T) 
   = metaETopMostNarrow(M,T,1,irreducible, E-AC-unify) .

  op metaEACUTopMostNarrow : Module Term -> ResultTripleSet .
  eq metaEACUTopMostNarrow(M,T) 
   = metaETopMostNarrow(M,T,1,reducible, E-ACU-unify) .
  op metaEACUTopMostNarrowIrr : Module Term -> ResultTripleSet .
  eq metaEACUTopMostNarrowIrr(M,T) 
   = metaETopMostNarrow(M,T,1,reducible, E-ACU-unify) .

  op metaETopMostNarrow : Module Term Bound IrrFlags TypeOfNarrowing -> ResultTripleSet .
  eq metaETopMostNarrow(M,T,B,IRR,ON) 
   = toTriple(M,metaENarrowShowAll(M,T,B,full topmost ON [IRR])) |> T .

  --- Auxiliary
  op [_,_] : TypeOfNarrowing IrrFlags ~> TypeOfNarrowing .
  eq [ E-ACU-unify, reducible ] = E-ACU-unify .
  eq [ E-ACU-unify, irreducible ] = E-ACU-unify-Irr .
  eq [ E-AC-unify, reducible ] = E-AC-unify .
  eq [ E-AC-unify, irreducible ] = E-AC-unify-Irr .

  *** Shortcuts to Basic Narrowing
  op metaEBasicNarrow : Module Term -> ResultTripleSet .
  eq metaEBasicNarrow(M,T)
   = metaEBasicNarrow(M,T,1) .

  *** Shortcuts for normalization
  op metaEBasicNarrow : Module Term Bound -> ResultTripleSet .
  eq metaEBasicNarrow(M,T,B)
   = toTriple(M,metaENarrowShowAll(M,T,B,E-ACU-unify noStrategy basic)) |> T .

  op metaBasicNarrowNormalize : Module Term -> ResultTripleSet .
  eq metaBasicNarrowNormalize(M,T)
   = toTriple(M,metaBasicNarrowNormalizeAll(M,T,highestVar(T) + 1)) |> T .

  op metaBasicNarrowNormalizeAll : Module Term Nat -> ResultContextSet .
  eq metaBasicNarrowNormalizeAll(M,T,NextVar)
   = metaENarrowShowAll(M,T,unbounded,
         basic ACU-unify 
         computed-normalized-subs applied-normalized-subs 
         normalize-terms noStrategy,NextVar) .

  op metaNarrowNormalize : Module Term -> ResultTripleSet .
  eq metaNarrowNormalize(M,T)
   = toTriple(M,metaNarrowNormalizeAll(M,T,highestVar(T) + 1)) |> T .

  op metaNarrowNormalizeAll : Module Term Nat -> ResultContextSet .
  eq metaNarrowNormalizeAll(M,T,NextVar)
   = metaENarrowShowAll(M,T,unbounded,
         full ACU-unify 
         computed-normalized-subs applied-normalized-subs 
         normalize-terms noStrategy,NextVar) .

  *** General Call
  op metaENarrowShowAll : Module Term Bound TypeOfNarrowing 
                       -> ResultContextSet .
  eq metaENarrowShowAll(M,T,B,ON)
   = metaENarrowShowAll(M,T,B,ON,highestVar(T) + 1) .

  op metaENarrowShowAll : Module Term Bound TypeOfNarrowing Bound
                       -> ResultContextSet .
  eq metaENarrowShowAll(M,T,B,ON,N)
   = metaENarrowGen(removeBoolEqs(M),B,ON, 
       {T,leastSort(M,T),none,none,[],[],T,T,N,empty}) .

  *** Call for ResultContextSet
  op metaENarrowGen : Module Bound TypeOfNarrowing
                      ResultContextSet  
                   -> ResultContextSet .

  eq metaENarrowGen(M,0,ON,RTS) --- Stop. Bound reached
   = RTS .
  eq metaENarrowGen(M,B,ON,RTS)
   = metaENarrowGen*(M,B,ON,empty,RTS) [owise] .

  op metaENarrowGen* : Module 
                       Bound TypeOfNarrowing 
                       ResultContextSet ResultContextSet
                    -> ResultContextSet .
  eq metaENarrowGen*(M,B,ON,RTS',(empty).ResultContextSet)
   = if RTS' == empty
     then RTS' --- Stop
     else metaENarrowGen(M,dec(B),ON,RTS')
     fi .
  eq metaENarrowGen*(M,B,ON,RTS',RT | RTS)
   = if isEND(normalize-terms?(M,ON,RT))
     then normalize-terms?(M,ON,RT) 
          | metaENarrowGen*(M,B,ON,RTS',RTS)
     else metaENarrowGen*(M,B,ON,RTS' | 
             filter-variant-RT(M,ON,normalize-terms?(M,ON,RT),
                metaENarrowGen**(M,B,ON,normalize-terms?(M,ON,RT))),
          RTS)
     fi .

  op testNonVarRedex : TypeOfNarrowing Term Term -> Bool .
  eq testNonVarRedex(basic ON,T,TS) = not(T :: Variable) .
  eq testNonVarRedex(ON,T,TS) = not(TS :: Variable) [owise] .

  op metaENarrowGen** : Module 
                        Bound TypeOfNarrowing 
                        ResultContext
                     -> ResultContextSet .
  eq metaENarrowGen**(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags})
   = if not testNonVarRedex(ON,T,TS) --- T is a variable
     then if CtS == []
          then *** Term CtTS is a normal form so we return it
               {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags}
	  else *** Term T is a rigid normal form inside a context Ct
	       *** but since no rewrite has been done and
               *** this can be part of a previous metaNarrowSub call,
               *** this path is discarded
               empty
          fi
     else if metaENarrowStra(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags})
	     =/= empty
          then metaENarrowStra(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags})
          else if CtS == []
               then *** Term CtTS is a normal form so we return it
                    {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,end(true,B:Flags)}
	       else *** Term T is a rigid normal form inside a context Ct
	            *** but since no rewrite has been done and
                    *** this can be part of a previous metaNarrowSub call,
                    *** this path is discarded
                    empty
               fi
          fi
     fi .

  *** Try all rules at top level of term T in context Ct with metaENarrowRls
  *** Try also inner subterms of T with metaENarrowSub
  *** Note that metaENarrowRls and metaENarrowSub 
  *** call to metaNarrow recursively
  op metaENarrowStra : Module Bound TypeOfNarrowing ResultContext 
                    -> ResultContextSet . ---[memo] .
  ---innermost
  eq metaENarrowStra(M,B,innermost ON,RT)
   = if metaENarrowSub(M,B,innermost ON,RT) =/= empty
     then metaENarrowSub(M,B,innermost ON,RT)
     else metaENarrowRls(M,B,innermost ON,getRls(M),RT)
     fi .

  ---outermost
  eq metaENarrowStra(M,B,outermost ON,RT)
   = if metaENarrowRls(M,B,outermost ON,getRls(M),RT) =/= empty
     then metaENarrowRls(M,B,outermost ON,getRls(M),RT)
     else metaENarrowSub(M,B,outermost ON,RT)
     fi .

  ---topmost
  eq metaENarrowStra(M,B,topmost ON,RT)
   = metaENarrowRls(M,B,topmost ON,getRls(M),RT) .

  ---noStrategy
  eq metaENarrowStra(M,B,noStrategy ON,RT)
   = metaENarrowRls(M,B,noStrategy ON,getRls(M),RT)
     | 
     metaENarrowSub(M,B,noStrategy ON,RT) .

  op dec : Bound -> Bound .
  eq dec(unbounded) = unbounded .
  eq dec(s(N)) = N .

  *** Generic call to metaUnification with different parameters
  op auxMetaUnify : Module TypeOfNarrowing 
                    Term Term Nat ~> UnificationTripleSet .
		--- Term Lhs
  eq auxMetaUnify(M,E-rewriting ON,T,T',N)
   = toUnificationTriple[N](metaMatch(M,T,T')) .
  eq auxMetaUnify(M,E-ACU-unify ON,T,T',N)
   = metaEACUUnify(removeBoolEqs(M),T,T',N,reducible) .
  eq auxMetaUnify(M,E-ACU-unify-Irr ON,T,T',N)
   = metaEACUUnify(removeBoolEqs(M),T,T',N,irreducible) .
  eq auxMetaUnify(M,E-AC-unify ON,T,T',N)
   = metaEACUnify(removeBoolEqs(M),T,T',N,reducible) .
  eq auxMetaUnify(M,E-AC-unify-Irr ON,T,T',N)
   = metaEACUnify(removeBoolEqs(M),T,T',N,irreducible) .
  eq auxMetaUnify(M,ACU-unify ON,T,T',N)
   = metaACUUnify(M,T,T',N) .
  eq auxMetaUnify(M,AC-unify ON,T,T',N)
   = metaACUnify(M,T,T',N) .

  *** Remove rigid normal forms
  op removeEND : ResultContextSet -> ResultContextSet .
  eq removeEND(RTS)
   = removeEND*(RTS,empty) .

  op removeEND* : ResultContextSet ResultContextSet -> ResultContextSet .
  eq removeEND*(empty,RTS')
   = RTS' .
  eq removeEND*(RT | RTS,RTS')
   = removeEND*(RTS,if isEND(RT) then RTS' else RTS' | RT fi) .

  op isEND : ResultContext -> Bool .
  eq isEND({T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags})
   = end(B:Flags) .

  *** Call for Rules ---> Returns empty if no rule is applied
  op metaENarrowRls : Module Bound TypeOfNarrowing
                      RuleSet ResultContext  
                   -> ResultContextSet .
  eq metaENarrowRls(M,B,ON,none,RT) 
   = empty .
  eq metaENarrowRls(M,B,ON,RL RLS,RT) 
   = filter-variant-RT(M,ON,RT,metaENarrowRls*(M,B,ON,RL,RT)) 
     | metaENarrowRls(M,B,ON,RLS,RT) .

  --- General case
  op metaENarrowRls* : Module Bound TypeOfNarrowing
                       Rule ResultContext  
                    -> ResultContextSet .
  eq metaENarrowRls*(M,B,ON, 
        (rl Lhs => Rhs [Att].), 
	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags})
   = metaENarrowRls**$(M,B,ON, 
        (rl Lhs => Rhs [Att].), 
	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags},
        'rl_=>_`[_`].[Lhs,Rhs,'none.AttrSet] <<{none,NextVar}<) . 
  eq metaENarrowRls*(M,B,ON, X:Rule, X:ResultContext)
   = empty [owise] .

  op metaENarrowRls**$ : Module Bound TypeOfNarrowing
                         Rule ResultContext  
                         UnificationPair
                      -> ResultContextSet .
  eq metaENarrowRls**$(M,B,ON,
        (rl Lhs => Rhs [Att].), 
	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags},
        {Subst,NextVar'})
   = metaENarrowRls**$$(M,B,ON, 
	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags},
        {Subst,NextVar'},
        'rl_=>_`[_`].[Lhs,Rhs,'none.AttrSet] << Subst) .

  op metaENarrowRls**$$ : Module Bound TypeOfNarrowing 
                          ResultContext  
                          UnificationPair Term
                       -> ResultContextSet .
  eq metaENarrowRls**$$(M,B,ON, 
	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags},
        {Subst,NextVar'},
        'rl_=>_`[_`].[Lhs',Rhs','none.AttrSet])
   = metaENarrowRls**$$$(M,B,ON, 
	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags},
        {Subst,NextVar'},
        'rl_=>_`[_`].[Lhs',Rhs','none.AttrSet],
        auxMetaUnify(M,ON,TS,Lhs',NextVar')) .

  op metaENarrowRls**$$$ : Module Bound TypeOfNarrowing
                           ResultContext  
                           UnificationPair Term UnificationTripleSet
                        -> ResultContextSet .
  eq metaENarrowRls**$$$(M,B,ON, 
	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags},
        {Subst,NextVar'},
        'rl_=>_`[_`].[Lhs',Rhs','none.AttrSet],US)
    = if US =/= empty
      then rebuildTypeAndDiscardErroneous(M,ON,
               {Ct[Rhs'],
	        TP,
		S,S',
		[],
		[],
		CtS[Rhs'],
		CtS[Rhs'],
		NextVar',
                B:Flags} 
               <<(M,ON) US
            )
      else empty
      fi .

  *** rebuild the context of the applied rule **********************
  op rebuildTypeAndDiscardErroneous : Module TypeOfNarrowing
                                      ResultContextSet -> ResultContextSet .
  eq rebuildTypeAndDiscardErroneous(M,ON,empty)
   = empty .
  eq rebuildTypeAndDiscardErroneous(M,ON,RT | RTS)
   = rebuildTypeAndDiscardErroneous*(M,ON,RT)
     | rebuildTypeAndDiscardErroneous(M,ON,RTS) .

  op rebuildTypeAndDiscardErroneous* : Module TypeOfNarrowing
                                       ResultContext -> ResultContextSet .
  eq rebuildTypeAndDiscardErroneous*(M,ON,
       {T,TP,S,S',[],[],TS,TS,NextVar,B:Flags})
   = if	leastSort(M,TS) :: Type
     then normalize-terms?(M,ON,
             {T,leastSort(M,TS),S,S',[],[],TS,TS,NextVar,B:Flags})
     else empty
     fi .

  *** auxiliary for variant narrowing **********************
  op _<<`(_`,_`)_ : ResultContext 
                    Module TypeOfNarrowing
                    UnificationTripleSet -> ResultContextSet .

  eq RT <<(M,ON) (empty).UnificationTripleSet
   = (empty).ResultContextSet .

  eq {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,B:Flags} 
     <<(M,ON) ({Subst,Subst',N} | SS:UnificationTripleSet)
   = {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,B:Flags} 
     <<((M,ON)) {Subst,Subst',N}
     |
     {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,B:Flags} 
     <<(M,ON) SS:UnificationTripleSet .

  op _<<`(`(_`,_`)`)_ : ResultContext 
                        Module TypeOfNarrowing
                        UnificationTriple -> ResultContextSet .

  eq {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,B:Flags} 
     <<((M,ON)) {Subst,Subst',N}
   = if (variant in ON 
         and-then 
         (Subst == none 
          or-else normalizedSubstitution?(M,Subst ; Subst')))
        or-else
        (computed-normalized-subs in ON 
         and-then normalizedSubstitution?(M,Subst))
        or-else
        (applied-normalized-subs in ON 
         and-then normalizedSubstitution?(M,Subst'))
        or-else 
        (not variant in ON 
         and-then 
         not applied-normalized-subs in ON 
         and-then
         not computed-normalized-subs in ON)
     then {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,B:Flags} 
           << {Subst,Subst',N}
     else (empty).ResultContextSet
     fi .

  *** test flag normalize-terms and normalize **********************
  *** !!!! This mustn't be combined with basic -> strange behavior
  op normalize-terms? : Module TypeOfNarrowing ResultContext 
                     -> ResultContext .
  eq normalize-terms?(M,E-normalize-terms ON,
     {T,TP,S,S',[],[],TS,TS,NextVar,B:Flags})
   = {getTerm(metaReduce(M,T)),
      getType(metaReduce(M,T)),
      S,S',[],[],
      getTerm(metaReduce(M,TS)),
      getTerm(metaReduce(M,TS)),
      NextVar,B:Flags} .
  eq normalize-terms?(M,normalize-terms ON,
     {T,TP,S,S',[],[],TS,TS,NextVar,B:Flags})
   = {getTerm(metaNormalizeCollect$(M,T)),
      getType(metaNormalizeCollect$(M,T)),
      S,S',[],[],
      getTerm(metaNormalizeCollect$(M,TS)),
      getTerm(metaNormalizeCollect$(M,TS)),
      NextVar,B:Flags} .
  eq normalize-terms?(M,ON,RT)
   = RT [owise] .

  *** Call at inner subterms
  op metaENarrowSub : Module Bound TypeOfNarrowing ResultContext  
                      -> ResultContextSet . ---[memo] .
  eq metaENarrowSub(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags}) 
   = metaENarrowSub#(M,B,ON,flatten(M,auxSplitTerm(ON,T,TS)),
            {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags}) .

  op auxSplitTerm : TypeOfNarrowing Term Term -> Term .
  eq auxSplitTerm(basic ON,T,TS) = T .
  eq auxSplitTerm(ON,T,TS) = TS [owise] .

  op metaENarrowSub# : Module Bound TypeOfNarrowing Term ResultContext  
                      -> ResultContextSet .
  eq metaENarrowSub#(M,B,ON,C,RT) = empty .
  eq metaENarrowSub#(M,B,ON,V,RT) = empty .
  eq metaENarrowSub#(M,B,ON,F[NeTL],RT)
   = metaENarrowSub#Gen(M,B,ON,
       splitTerm(M,F,
                 1,getFrozen(M,F,getTypes(M,NeTL)),
                 isAssociative(M,F,getTypes(M,NeTL)) 
                 or isCommutative(M,F,getTypes(M,NeTL)),
                 empty,NeTL,RT)) .

  op splitTerm : Module Qid
                 Nat NeNatList Bool
                 TermList TermList 
                 ResultContext -> ResultContextSet .

  eq splitTerm(M,F,
               N,NL,AC?:Bool,
               TL',empty,
               RT) 
   = empty .
               
  eq splitTerm(M,F,
               N,NL,AC?:Bool,
               TL',(T,TL),
               {T'',TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags})
   = if ((not AC?:Bool) and-then N inNatList NL)
        or-else
        (AC?:Bool and-then NL =/= 0)
     then empty
     else {T,leastSort(M,T),S,S',
           Ct[F[TL',[],TL]],
           CtS[F[TL' << (S ; S'),[],TL << (S ; S')]],T << (S ; S'),
           CtTS,NextVar,B:Flags}
     fi
     | splitTerm(M,F,
                 s(N),NL,AC?:Bool,
                 (TL',T),TL,
                 {T'',TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags}) .

  op metaENarrowSub#Gen : Module Bound TypeOfNarrowing ResultContextSet  
                       -> ResultContextSet .
  eq metaENarrowSub#Gen(M,B,ON,empty)
   = empty .
  eq metaENarrowSub#Gen(M,B,ON,RT | RTS)
   = metaENarrowGen**(M,B,ON,RT) | metaENarrowSub#Gen(M,B,ON,RTS) .

  *** Filter ResutlContextSet according to Variant narrowing strategy--- 
  op filter-variant-RT : Module TypeOfNarrowing ResultContext 
                      ResultContextSet -> ResultContextSet .
  eq filter-variant-RT(M,ON,
          {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags},RTS)
   = if variant in ON and testUnifier !in ON
     then filter-variant-RT*(M,Vars(TS),empty,RTS)
     else RTS
     fi .

  op filter-variant-RT* : 
       Module TermList ResultContextSet ResultContextSet -> ResultContextSet .
  eq filter-variant-RT*(M,TL,RTS$,empty)
   = RTS$ .
  eq filter-variant-RT*(M,TL,RTS$,RT | RTS)
   = filter-variant-RT**(M,TL,RTS$,RTS,RT,RTS) .  

  op filter-variant-RT** : 
        Module TermList ResultContextSet ResultContextSet
                        ResultContext ResultContextSet -> ResultContextSet .
  eq filter-variant-RT**(M,TL,RTS$,RTS',RT,empty)
   = --- RT is not implied by any in RTS'
     filter-variant-RT*(M,TL,RTS$ | RT,RTS') .
  eq filter-variant-RT**(M,TL,RTS$,RT | RTS',RT',RT | RTS)
   = if test-variant-RT(M,TL,RT,RT')
     then --- RT' is implied by RT in RTS'
          filter-variant-RT*(M,TL,RTS$,RT | RTS') 
     else if test-variant-RT(M,TL,RT',RT)
          then --- remove RT from the set RTS'
               filter-variant-RT**(M,TL,RTS$,RTS',RT',RTS)
          else --- continue searching in RTS
               filter-variant-RT**(M,TL,RTS$,RT | RTS',RT',RTS)
          fi
     fi .

  op test-variant-RT : Module TermList ResultContext ResultContext 
                    -> Bool . ---[memo] .
  eq test-variant-RT(M,TL,
         {T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,B:Flags},
         {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',B':Flags})
   = test-variant-RT*(M,TL,S |> TL,S' |> TL) .

  op test-variant-RT* : Module TermList Substitution Substitution -> Bool .
  eq test-variant-RT*(M,TL,S,S')
   = | S | <= | S' |
     and-then
     S <=[M] S' . --- keep T & remove T'

  op |_| : Substitution -> Nat .
  eq | (none).Substitution | = 0 .
  eq | V <- T ; S | = s(| S |) .

endfm

fmod META-NARROWING-SEARCH is
  protecting META-E-NARROWING .
  protecting META-TERM .
  protecting META-LEVEL .
  protecting META-UNIFICATION .
  protecting RESULT-CONTEXT-SET .
  protecting ORDERS-TERM-SUBSTITUTION .

  var T T' TOrig Lhs Rhs TS TS' CtTS CtTS' : Term .
  var V : Variable .
  var C : Constant .
  var F : Qid .
  vars TL TL' : TermList .
  var M : Module .
  var RTS RTS' RTSSol : ResultContextSet .
  var RT RT' : ResultContext .
  vars TP TP' : Type .
  vars S S' Subst S* S'* : Substitution .
  var RLS : RuleSet .
  var Att : AttrSet .
  var B BN : Bound .
  var N : Nat .
  var NL : NatList .
  vars Ct Ct' CtS CtS' : Context .
  var ON : TypeOfNarrowing .
  vars QQ QQ' : TypeOfRelation .
  vars NextVar NextVar' : Nat .

  var SCond : SubstitutionCond .

  --- metaNarrowSearch --------------------------------------------------------

  *** Shortcuts to Narrowing Search
  op metaNarrowSearch : Module Term Term -> ResultTripleSet .
  eq metaNarrowSearch(M,T,T') = metaNarrowSearch(M,T,T',unbounded) .

  op metaNarrowSearch : Module Term Term Bound -> ResultTripleSet .
  eq metaNarrowSearch(M,T,T',B) = metaNarrowSearch(M,T,T',B,1) .

  op metaNarrowSearch : Module Term Term Bound Bound -> ResultTripleSet .
  eq metaNarrowSearch(M,T,T',B,BN) = metaNarrowSearch(M,T,T','!,B,BN) .

  op metaNarrowSearch : Module Term Term TypeOfRelation Bound Bound 
                     -> ResultTripleSet .
  eq metaNarrowSearch(M,T,T',QQ,B,BN) 
   = metaNarrowSearch(M,T,T',none,QQ,B,BN) .

  op metaNarrowSearch : Module Term Term SubstitutionCond 
                        TypeOfRelation Bound Bound 
                        -> ResultTripleSet .
  eq metaNarrowSearch(M,T,T',SCond,QQ,B,BN)
   = metaNarrowSearchGen(M,T,T',SCond,QQ,B,BN,
         full AC-unify noStrategy E-normalize-terms) .

  *** General Call
  op metaNarrowSearchGen : Module Term Term SubstitutionCond 
                           TypeOfRelation 
                           Bound Bound 
                           --- steps sols
                           TypeOfNarrowing 
			-> ResultTripleSet .
  eq metaNarrowSearchGen(M,T,T',SCond,QQ,B,BN,ON)
   = toTriple(M,metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,ON)) .

  op metaNarrowSearchGenAll : Module Term Term SubstitutionCond 
                              TypeOfRelation Bound Bound TypeOfNarrowing
                           -> ResultContextSet .
  eq metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,ON)
   = metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,ON,highestVar((T,T')) + 1) .

  op metaNarrowSearchGenAll : Module Term Term SubstitutionCond 
                            TypeOfRelation Bound Bound TypeOfNarrowing Nat
                         -> ResultContextSet .
  eq metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,ON,N)
   = metaNarrowSearchAll(addSorts('Universal,M),
            T,T',SCond,QQ,B,BN,ON,
            {T,leastSort(M,T),none,none,[],[],T,T,N,empty}) .

  *** One Narrowing step in the search process (including possible filters)
  op metaNarrowStep : Module SubstitutionCond 
                      ResultContextSet TypeOfNarrowing 
		   -> ResultContextSet .
  eq metaNarrowStep(M,SCond,RTS,ON)
   = filterSCond(M,SCond,metaENarrowGen(M,1,ON,RTS)) .

  *** Filter and normal forms
  op filterSCond : Module SubstitutionCond ResultContextSet 
                   -> ResultContextSet .
  eq filterSCond(M,none,RTS)
   = RTS .
  eq filterSCond(M,SCond,RTS)
   = filterSCond*(M,SCond,RTS) [owise] .

  op filterSCond* : Module SubstitutionCond ResultContextSet 
                   -> ResultContextSet .
  eq filterSCond*(M,SCond,empty)
   = empty .
  eq filterSCond*(M,SCond,RT | RTS)
   = filterSCond**(M,SCond,RT) | filterSCond*(M,SCond,RTS) .

  op filterSCond** : Module SubstitutionCond ResultContext 
                   -> ResultContextSet . ---[memo] .
  eq filterSCond**(M,SCond,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags})
   = if SCond <=[M] S
     then {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags}
     else empty
     fi .

  *** Generate next successors in a breadth way
  --- We reuse the metaNarrowSearchAll function
  op metaNarrowSearchAll : Module Term Term SubstitutionCond TypeOfRelation
                            Bound Bound --- number steps / number solutions
                            TypeOfNarrowing
                            ResultContextSet
			 -> ResultContextSet .
  eq metaNarrowSearchAll(M,TOrig,T',SCond,QQ,B,BN,ON,RTS)
   = if QQ == '+
     then noSelf(RTS,
          metaNarrowSearchCheck(M,TOrig,T',SCond,'*,B,BN,ON,empty,RTS,empty) 
          )
     else metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,B,BN,ON,empty,RTS,RTS)
     fi .

  *** Take only normal forms
  op isNF : Module ResultContext -> Bool .
  eq isNF(M,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,B:Flags})
   = end(B:Flags) or-else metaOneRewriting(M,CtTS) == empty .
     
  *** Take only normal forms
  op isVariant : Module Nat ResultContextSet ResultContext -> Bool .
  eq isVariant(M,N,
        {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',B':Flags} | RTS,
        {T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,B:Flags})
    = not (
       (S' |> N ; (newVar(N + 1,TP') <- CtTS'))
           <=[M] 
       (S |> N ; (newVar(N + 1,TP) <- CtTS))
      )
      and-then
      isVariant(M,N,RTS,{T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,B:Flags}) .
  eq isVariant(M,N,RTS,RT)
   = true [owise] .


  *** Generate successors       
  op oneMoreStep : Module SubstitutionCond TypeOfNarrowing
                   ResultContextSet -> ResultContextSet .
  eq oneMoreStep(M,SCond,ON,RTS)
   = metaNarrowStep(M,SCond,removeEND(RTS),ON) .
   
  *** Check each next successor for conditions
  op metaNarrowSearchCheck : Module Term Term SubstitutionCond 
                             TypeOfRelation Bound Bound TypeOfNarrowing
                             ResultContextSet ResultContextSet ResultContextSet
			     -> ResultContextSet .

  eq metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,B,BN,ON,RTSSol,RTS',empty)
   = if B == 0 or-else BN == 0 or-else RTS' == empty
     then *** Stop the search
          RTSSol
     else *** Compute Next successors of RTS' with oneMoreStep
          metaNarrowSearchCheck(M, 
            TOrig,T',SCond,
            QQ,
            dec(B),BN,ON,
            RTSSol,
            oneMoreStep(M,SCond,ON,RTS'),
            oneMoreStep(M,SCond,ON,RTS')
          ) 
     fi .

  eq metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,B,BN,ON,RTSSol,RTS',
         RT | RTS)
   = if isSolution?(M,TOrig,T',QQ,BN,ON,RTSSol,RT)
     then if *** Is actual term an instance of T'?
             auxMetaUnify(M,ON,getCTTerm(RT),T',getNextVar(RT)) =/= empty
          then *** This is a solution
	       metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,
                  B,dec(BN),ON,
                  RT << auxMetaUnify(M,ON,getCTTerm(RT),T',getNextVar(RT))
                  | RTSSol,
                  RTS',RTS)
          else *** Continue with the rest
	       metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,
                  B,BN,ON,RTSSol,RTS',RTS)
          fi
     else *** Continue with the rest
	  metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,
             B,BN,ON,RTSSol,RTS',RTS)
     fi .

  op isSolution? : Module Term Term  
                   TypeOfRelation Bound TypeOfNarrowing
                   ResultContextSet ResultContext
	        -> Bool .
  eq isSolution?(M,TOrig,T',QQ,BN,ON,RTSSol,RT)
   = *** Is this the chosen solution?
     (BN == unbounded or-else BN > 0)
     and-then
     *** Is this step correct wrt relations <'!,'*,'+> ?
     ( QQ == '* or-else (QQ == '! and-then isEND(RT)) )
     and-then
     *** Is this a valid variant solution?
     (not (variant in ON) or-else 
      (isNF(M,RT) and-then isVariant(M,highestVar(TOrig) + 1,RTSSol,RT))) .

  op upDown : Module ResultTripleSet -> ResultTripleSet .
  eq upDown(M,RTS:ResultTripleSet)
   = upDown#(M,empty,RTS:ResultTripleSet) .
  op upDown# : Module ResultTripleSet ResultTripleSet -> ResultTripleSet .
  eq upDown#(M,RTS':ResultTripleSet, empty)
   = RTS':ResultTripleSet .
  eq upDown#(M,RTS':ResultTripleSet, {T,TP,S} | RTS:ResultTripleSet)
   = upDown#(M,{getTerm(metaReduce(M,T)),TP,upDown(M,S)} 
               | RTS':ResultTripleSet,RTS:ResultTripleSet) .

  op upDown : Module Substitution -> Substitution .
  eq upDown(M,S:Substitution)
   = upDown#(M,none,S:Substitution) .
  op upDown# : Module Substitution Substitution -> Substitution .
  eq upDown#(M,S':Substitution,none) 
   = S':Substitution .
  eq upDown#(M,S':Substitution,V <- T ; S:Substitution)
   = upDown#(M,S':Substitution ; V <- getTerm(metaReduce(M,T)),S:Substitution) .

endfm

*************************************
****** End of Santiago Escobar's code

fmod COMMAND-PROCESSING is
  pr UNIT-PROCESSING .
  pr UNIT-META-PRETTY-PRINT .
  inc (2TUPLE * (op `(_`,_`) to <<_;_>>, 
                 op p1_ to getDatabase, 
                 op p2_ to getQidList)) {Database, QidList} .
  pr META-FULL-MAUDE-SIGN .
  pr META-NARROWING-SEARCH . ---(* (sort TermSet to TermSetNarr,
                              op emptyTermSet to emptyTermSetNarr,
                              op addOps to addOpsNarr,
                              op addEqs to addEqsNarr,
                              op addSorts to addSortsNarr) .)
  
  eq getDatabase(<< DB ; qidError(QIL) >>) = warning(DB, QIL) . 
  eq getQidList(<< DB ; qidError(QIL) >>) = QIL . 

  op {_,_} : Term Type ~> ResultPair [ctor] .
  op {_,_,_} : Term Type Substitution ~> ResultTriple [ctor] .
  op {_,_,_,_} : Term Type Substitution Context ~> Result4Tuple [ctor] .
  op {_,_} : Substitution Context ~> MatchPair [ctor] .

*** projection functions (from prelude.maude)
  op getTerm : ResultPair ~> Term .
  eq getTerm({T:[Term], T':[Type]}) = T:[Term] .
  op getType : ResultPair ~> Type .
  eq getType({T:[Term], T':[Type]}) = T':[Type] .

  op getTerm : ResultTriple ~> Term .
  eq getTerm({T:[Term], T':[Type], S:[Substitution]}) = T:[Term] .
  op getType : ResultTriple ~> Type .
  eq getType({T:[Term], T':[Type], S:[Substitution]}) = T':[Type] .
  op gTSubstitution : ResultTriple ~> Substitution .
  eq gTSubstitution({T:[Term], T':[Type], S:[Substitution]}) 
    = S:[Substitution] .

  op getTerm : Result4Tuple ~> Term .
  eq getTerm({T:[Term], T':[Type], S:[Substitution], C:[Context]}) = T:[Term] .
  op getType : Result4Tuple ~> Type .
  eq getType({T:[Term], T':[Type], S:[Substitution], C:[Context]}) = T':[Type] .
  op gTSubstitution : Result4Tuple ~> Substitution .
  eq gTSubstitution({T:[Term], T':[Type], S:[Substitution], C:[Context]}) 
    = S:[Substitution] .
  op getContext : Result4Tuple ~> Context .
  eq getContext({T:[Term], T':[Type], S:[Substitution], C:[Context]}) 
    = C:[Context] .

  op gTSubstitution : MatchPair ~> Substitution .
  eq gTSubstitution({S:[Substitution], C:[Context]}) = S:[Substitution] .
  op getContext : MatchPair ~> Context .
  eq getContext({S:[Substitution], C:[Context]}) = C:[Context] .



  vars T T' T'' T''' : Term .
  var  TL : TermList .
  vars DB DB' DB'' : Database .
  var  DB? : [Database] .
  vars M M' : Module .
  var  M? : [Module] .
  vars ME ME' : ModuleExpression .
  vars H H' : Header .
  vars MNS MNS' MNS'' MNS3 MNS4 : Set{ModuleName} .
  var  VE : ViewExp .
  var  VES : Set{ViewExp} .
  vars N I J : Nat .
  var  I? : [Nat] .
  vars D D' : Bound .
  var  D? : [Bound] .
  var  B : Bool .
  var  B? : [Bool] .
  vars MIS MIS' : Set{ModuleInfo} .
  var  VIS : Set{ViewInfo} .
  vars PDS PDS' : Set{ParameterDecl} .
  var  QIL : QidList .
  var  SS : SortSet .
  var  SSDS : SubsortDeclSet .
  vars VS VDS OPDS : OpDeclSet .
  var  OPDS? : [OpDeclSet] .
  var  MAS : MembAxSet .
  var  EqS : EquationSet .
  var  RlS : RuleSet .
  vars QI QI' F V O : Qid .
  var  Ct : Constant .
  var  IL : ImportList .
  var  TM : [Tuple<Term|Module|Bool|OpDeclSet|Database>] .
  var  TMVB : [Tuple<Term|Module|Bool|OpDeclSet|Bound|Database>] .
  var  TMVBN : [Tuple<Term|Module|OpDeclSet|Bound|Nat>] .
  var  T? : [Term] .
  var  RP : [ResultPair] .
  var  RT : [ResultTriple] .
  var  Sb? : [Substitution] .
  var  MP? : [MatchPair] .
  var  CD : Condition .
  var  Sb : Substitution .
  var  UP? : [UnificationPair] .
  var  UP : UnificationProblem .

  sorts Tuple<Term|Module|Bool|OpDeclSet|Database> 
        Tuple<Term|Module|Bool|OpDeclSet|Bound|Database> 
        Tuple<Term|Module|OpDeclSet|Bound|Nat> .
  op `{_`,_`,_`,_`,_`} : Term Module Bool OpDeclSet Database 
       -> Tuple<Term|Module|Bool|OpDeclSet|Database> .
  op `{_`,_`,_`,_`,_`,_`} : Term Module Bool OpDeclSet Bound Database 
       -> Tuple<Term|Module|Bool|OpDeclSet|Bound|Database> .
  op `{_`,_`,_`,_`,_`} : Term Module OpDeclSet Bound Nat 
       -> Tuple<Term|Module|OpDeclSet|Bound|Nat> .
  op tuple<Term|Module|Bool|OpDeclSet|Database>Error : QidList 
       -> [Tuple<Term|Module|Bool|OpDeclSet|Database>] .
  op tuple<Term|Module|Bool|OpDeclSet|Bound|Database>Error : QidList 
       -> [Tuple<Term|Module|Bool|OpDeclSet|Bound|Database>] .
  op tuple<Term|Module|OpDeclSet|Bound|Nat>Error : QidList 
       -> [Tuple<Term|Module|OpDeclSet|Bound|Nat>] .
  op boundError  : QidList -> [Bound] .
  op getTerm     : Tuple<Term|Module|Bool|OpDeclSet|Database> ~> Term .
  op getModule   : Tuple<Term|Module|Bool|OpDeclSet|Database> ~> Module .
  op getVars     : Tuple<Term|Module|Bool|OpDeclSet|Database> ~> OpDeclSet .
  op getBool     : Tuple<Term|Module|Bool|OpDeclSet|Database> ~> Bool .
  op getDatabase : Tuple<Term|Module|Bool|OpDeclSet|Database> ~> Database .
  op getTerm     : Tuple<Term|Module|Bool|OpDeclSet|Bound|Database> ~> Term .
  op getModule   : Tuple<Term|Module|Bool|OpDeclSet|Bound|Database> ~> Module .
  op getVars     : Tuple<Term|Module|Bool|OpDeclSet|Bound|Database> ~> OpDeclSet .
  op getBound    : Tuple<Term|Module|Bool|OpDeclSet|Bound|Database> ~> Bound .
  op getBool     : Tuple<Term|Module|Bool|OpDeclSet|Bound|Database> ~> Bool .
  op getDatabase : Tuple<Term|Module|Bool|OpDeclSet|Bound|Database> ~> Database .
  op getTerm     : Tuple<Term|Module|OpDeclSet|Bound|Nat> ~> Term .
  op getModule   : Tuple<Term|Module|OpDeclSet|Bound|Nat> ~> Module .
  op getVars     : Tuple<Term|Module|OpDeclSet|Bound|Nat> ~> OpDeclSet .
  op getBound    : Tuple<Term|Module|OpDeclSet|Bound|Nat> ~> Bound .
  op getNat      : Tuple<Term|Module|OpDeclSet|Bound|Nat> ~> Nat .

  eq {qidError(QIL), M?, B?, OPDS?, DB?} 
    = tuple<Term|Module|Bool|OpDeclSet|Database>Error(QIL) .
  eq {qidError(QIL), M?, B?, OPDS?, D?, DB?} 
    = tuple<Term|Module|Bool|OpDeclSet|Bound|Database>Error(QIL) .
  eq {qidError(QIL), M?, OPDS?, D?, I?} 
    = tuple<Term|Module|OpDeclSet|Bound|Nat>Error(QIL) .

  eq getTerm({T, M, B, VDS, DB}) = T .
  eq getTerm(tuple<Term|Module|Bool|OpDeclSet|Database>Error(QIL)) = qidError(QIL) .
  eq getModule({T, M, B, VDS, DB}) = M .
  eq getModule(tuple<Term|Module|Bool|OpDeclSet|Database>Error(QIL)) = unitError(QIL) .
  eq getVars({T, M, B, VDS, DB}) = VDS .
  eq getVars(tuple<Term|Module|Bool|OpDeclSet|Database>Error(QIL)) = opDeclError(QIL) .
  eq getBool({T, M, B, VDS, DB}) = B .
  eq getBool(tuple<Term|Module|Bool|OpDeclSet|Database>Error(QIL)) = false .
  eq getDatabase({T, M, B, VDS, DB}) = DB .
  eq getDatabase(tuple<Term|Module|Bool|OpDeclSet|Database>Error(QIL)) = emptyDatabase .

  eq getTerm({T, M, B, VDS, D, DB}) = T .
  eq getTerm(tuple<Term|Module|Bool|OpDeclSet|Bound|Database>Error(QIL)) = qidError(QIL) .
  eq getModule({T, M, B, VDS, D, DB}) = M .
  eq getModule(tuple<Term|Module|Bool|OpDeclSet|Bound|Database>Error(QIL)) 
    = unitError(QIL) .
  eq getVars({T, M, B, VDS, D, DB}) = VDS .
  eq getVars(tuple<Term|Module|Bool|OpDeclSet|Bound|Database>Error(QIL)) 
    = opDeclError(QIL) .
  eq getBound({T, M, B, VDS, D, DB}) = D .
  eq getBound(tuple<Term|Module|Bool|OpDeclSet|Bound|Database>Error(QIL)) 
    = boundError(QIL) .
  eq getBool({T, M, B, VDS, D, DB}) = B .
  eq getBool(tuple<Term|Module|Bool|OpDeclSet|Bound|Database>Error(QIL)) 
    = false .
  eq getDatabase({T, M, B, VDS, D, DB}) = DB .
  eq getDatabase(tuple<Term|Module|Bool|OpDeclSet|Bound|Database>Error(QIL)) 
    = emptyDatabase .

  eq getTerm({T, M, VDS, D, I}) = T .
  eq getTerm(tuple<Term|Module|OpDeclSet|Bound|Nat>Error(QIL)) 
    = qidError(QIL) .
  eq getModule({T, M, VDS, D, I}) = M .
  eq getModule(tuple<Term|Module|OpDeclSet|Bound|Nat>Error(QIL)) 
    = unitError(QIL) .
  eq getVars({T, M, VDS, D, I}) = VDS .
  eq getVars(tuple<Term|Module|OpDeclSet|Bound|Nat>Error(QIL)) 
    = opDeclError(QIL) .
  eq getBound({T, M, VDS, D, I}) = D .
  eq getBound(tuple<Term|Module|OpDeclSet|Bound|Nat>Error(QIL)) 
    = boundError(QIL) .
  eq getNat({T, M, VDS, D, I}) = I .
  eq getNat(tuple<Term|Module|OpDeclSet|Bound|Nat>Error(QIL)) 
    = numberError(QIL) .
 
  ---- procLoad
  
  op procLoad : Term ModuleExpression Database -> Tuple{Database,QidList} .
  op procLoad : Term ModuleExpression Module OpDeclSet Database -> Tuple{Database,QidList} .

  eq procLoad(T, ME, DB)
   = if compiledModule(ME, DB)
     then procLoad(T, ME, getFlatModule(ME, DB), getVars(ME, DB), DB)
     else procLoad(T, modExp(evalModExp(ME, DB)), 
               getFlatModule(modExp(evalModExp(ME, DB)), 
                 database(evalModExp(ME, DB))), 
               getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 
               database(evalModExp(ME, DB)))
     fi 
     [owise] .

  ceq procLoad(T, ME, M, VDS, DB)
    = if downTerm(T:[Term], emptyFModule) =/= emptyFModule
      then << evalModule(downModule(T:[Term]), none, DB) ; 'Introduced 'module header2Qid(getName(downModule(T:[Term]))) '\n >> 
      else << DB ; '\r 'Error: '\o 'Incorrect 'metamodule. '\n >>
      fi 
    if T:[Term] := getTerm(metaReduce(M, solveBubbles(T, M, true, VDS, DB))) .
---(
  eq procLoad(T, ME, M, VDS, DB)
    = if downModule(getTerm(metaReduce(M, solveBubbles(T, M, true, VDS, DB)))) :: Module
      then << evalModule(downModule(getTerm(metaReduce(M, solveBubbles(T, M, true, VDS, DB)))), none, DB) ; 
             'Introduced 'module header2Qid(getName(downModule(getTerm(metaReduce(M, solveBubbles(T, M, true, VDS, DB)))))) '\n >> 
      else << DB ; '\r 'Error: '\o 'Incorrect 'metamodule. '\n >>
      fi .
)
  
  ---- procCommand
  
  op procCommand : Term ModuleExpression Database -> Tuple{Database,QidList} .
  op procCommand : Term ModuleExpression Module OpDeclSet Database -> QidList .
  op procDownCommand : Term ModuleExpression Database -> Tuple{Database,QidList} .

  op procParse : ModuleExpression Module Term OpDeclSet Database -> QidList .

  op procRed : ModuleExpression Module Term OpDeclSet Database -> QidList .
  op solveBubblesRed : Term Module Bool OpDeclSet Database 
       -> [Tuple<Term|Module|Bool|OpDeclSet|Database>] .
  op solveBubblesRed2 : Term Database -> [Tuple<Term|Module|Bool|OpDeclSet|Database>] .
  op solveBubblesRed3 : Term Module ModuleExpression OpDeclSet Database 
       -> [Tuple<Term|Module|Bool|OpDeclSet|Database>] .

  op procRew : ModuleExpression Module Term OpDeclSet Database -> QidList .
  op solveBubblesRew : Term Module Bool Bound OpDeclSet Database 
       -> [Tuple<Term|Module|Bool|OpDeclSet|Bound|Database>] .
  op solveBubblesRew2 : Term Module Bool OpDeclSet Database 
       -> [Tuple<Term|Module|Bool|OpDeclSet|Bound|Database>] .

  op procFrew : 
       ModuleExpression Module Term Bound Nat OpDeclSet Database -> QidList .
  op solveBubblesFrew : Term Module Bool Bound Nat OpDeclSet Database 
       -> [Tuple<Term|Module|OpDeclSet|Bound|Nat>] .
  op solveBubblesFrew2 : Term Module Bool Nat OpDeclSet Database 
       -> [Tuple<Term|Module|OpDeclSet|Bound|Nat>] .

  op procSearch : ModuleExpression Module Term Term Qid Bound Bound OpDeclSet Database -> QidList .
  op solveBubblesSearchL : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
  op solveBubblesSearchL1 : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
  op solveBubblesSearchR : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
  op solveBubblesSearchR1 : Module Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
  op solveBubblesSearchR2 : Module Term Term Qid Bound Bound OpDeclSet -> QidList .
  op procSearch2 : Module Term Term Condition Qid Bound Bound -> QidList .
  op procSearch3 : Module Term Term Condition Qid Bound Nat Bound -> QidList .

  op procNarrowSearch : ModuleExpression Module Term Term Qid Bound Bound OpDeclSet Database -> QidList .
  op solveBubblesNarrowSearchL : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
  op solveBubblesNarrowSearchL1 : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
  op solveBubblesNarrowSearchR : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
  op solveBubblesNarrowSearchR1 : Module Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
  op solveBubblesNarrowSearchR2 : Module Term Term Qid Bound Bound OpDeclSet -> QidList .
  op procNarrowSearch2 : Module Term Term Condition Qid Bound Bound -> QidList .
  op procNarrowSearch3 : Module Nat TermList ResultTripleSet -> QidList .

  op procMatch : ModuleExpression Module Term Term Qid Bound OpDeclSet Database
       -> QidList .
  op procMatch2 : Module Term Term Condition Qid Bound -> QidList .
  op procMatch3 : Module Term Term Condition Qid Bound Nat -> QidList .
  op solveBubblesMatch : Module Module Term Term Qid Bound Bool OpDeclSet 
       Database ~> QidList .
  op solveBubblesMatch2 :
       Module Term Term Qid Bound OpDeclSet ~> QidList .

  op procUnify : ModuleExpression Module Term Bound OpDeclSet Database -> QidList .
  op procUnify2 : ModuleExpression Module Term Bound OpDeclSet Database -> QidList .
  op addInfoUnify : Module -> [Module] .
  op parseUnify : Term OpDeclSet -> UnificationProblem .
  op procUnify2 : Module UnificationProblem Bound -> QidList .
  op eMetaPrettyPrint : Module UnificationProblem -> QidList .
  op procUnify3 : Module UnificationProblem Bound Nat -> QidList .
  op procUnify3Aux : Module UnificationPair Nat -> QidList .
  op unificationProblemError : QidList -> [UnificationProblem] .

  op procIdUnify : ModuleExpression Module Term Bound OpDeclSet Database -> QidList .
  op addInfoIdUnify : Module -> [Module] .
  op parseIdUnify : Term OpDeclSet -> UnificationProblem .
  op procIdUnify2 : Module UnificationProblem Bound -> QidList .
  op procIdUnify3 : Module UnificationProblem Nat SubstitutionSet -> QidList .

  op solveBubblesUnify : Module Term OpDeclSet ~> UnificationProblem .
  op solveBubblesRedUnify : Term Module Bool OpDeclSet Database 
       -> [Tuple<Term|Module|Bool|OpDeclSet|Database>] .
  op solveBubblesRedUnify2 : Term Database -> [Tuple<Term|Module|Bool|OpDeclSet|Database>] .
  op solveBubblesRedUnify3 : Term Module ModuleExpression OpDeclSet Database 
       -> [Tuple<Term|Module|Bool|OpDeclSet|Database>] .
  op procRewUnify : ModuleExpression Module Term OpDeclSet Database -> QidList .
  op solveBubblesRewUnify : Term Module Bool Bound OpDeclSet Database 
       -> [Tuple<Term|Module|Bool|OpDeclSet|Bound|Database>] .
  op solveBubblesRewUnify2 : Term Module Bool OpDeclSet Database 
       -> [Tuple<Term|Module|Bool|OpDeclSet|Bound|Database>] .

  op eMetaPrettyPrint : Module Substitution -> QidList .

  eq eMetaPrettyPrint(M, V <- T ; Sb:Substitution)
    = V '--> '\s eMetaPrettyPrint(M, T) 
      if eMetaPrettyPrint(M, Sb:Substitution) == nil
      then nil
      else '; eMetaPrettyPrint(M, Sb:Substitution)
      fi .
  eq eMetaPrettyPrint(M, (none).Substitution) = nil . 

  op procCommandUp : ModuleExpression Module Term OpDeclSet Database -> Term .
  op procRedUp : ModuleExpression Module Term OpDeclSet Database -> Term .
  op procRewUp : ModuleExpression Module Term Bound OpDeclSet Database -> Term .
  op procFrewUp : ModuleExpression Module Term Bound Nat OpDeclSet Database -> Term .

*** Processing of commands.

  ceq procDownCommand('down_:_[T, T'], ME, DB)
    = if T'':[Term] :: Term 
      then << DB'' ; 
              ('\b 'result '\o
               '\s eMetaPrettyPrint(leastSort(M, T'':[Term]))
               '\s '\b ': '\o '\n '\s '\s 
               eMetaPrettyPrint(M, T'':[Term])) >>
      else << DB ; ('\r 'Error: '\o 'Incorrect 'input. '\n) >>
      fi
    if DB' := database(evalModExp(ME, DB))  
    /\ < DB'' ; ME' > := evalModExp(parseModExp(T), DB')  
    /\ M := getFlatModule(ME', DB'') 
    /\ T'':[Term] := procCommandUp(ME, getFlatModule(ME, DB''), T', getVars(ME, DB''), DB'').

  eq procCommand(T, ME, DB)
   = if compiledModule(ME, DB)
     then << DB ; procCommand(T, ME, getFlatModule(ME, DB), getVars(ME, DB), DB) >>
     else << database(evalModExp(ME, DB)) ;
             procCommand(T, modExp(evalModExp(ME, DB)), 
               getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 
               getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 
               database(evalModExp(ME, DB))) >>
     fi 
     [owise] .

  eq procCommand(T, ME, unitError(QIL), VS, DB) = qidError(QIL) .

  eq procCommand('parse_.['bubble[T]], ME, M, VS, DB)
   = procParse(ME, M, 'bubble[T], VS, DB) .

  eq procCommand('reduce_.['bubble[T]], ME, M, VS, DB)
    = procCommand('red_.['bubble[T]], ME, M, VS, DB) .
  eq procCommand('red_.['bubble[T]], ME, M, VS, DB)
    = procRed(ME, M, 'bubble[T], VS, DB) .

  eq procCommand('rewrite_.['bubble[T]], ME, M, VS, DB) 
    = procCommand('rew_.['bubble[T]], ME, M, VS, DB) . 
  eq procCommand('rew_.['bubble[T]], ME, M, VS, DB)
    = procRew(ME, M, 'bubble[T], VS, DB) .

  eq procCommand('frewrite_.['bubble[T]], ME, M, VS, DB) 
    = procCommand('frew_.['bubble[T]], ME, M, VS, DB) . 
  eq procCommand('frew_.['bubble[T]], ME, M, VS, DB)
    = procFrew(ME, M, 'bubble[T], unbounded, 1, VS, DB) .

  eq procCommand('search_=>1_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 
    = procSearch(ME, M, 'bubble[T], 'bubble[T'], '+, unbounded, 1, VS, DB) .
  eq procCommand('search_=>*_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 
    = procSearch(ME, M, 'bubble[T], 'bubble[T'], '*, unbounded, unbounded, VS, DB) .
  eq procCommand('search_=>+_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 
    = procSearch(ME, M, 'bubble[T], 'bubble[T'], '+, unbounded, unbounded, VS, DB) .
  eq procCommand('search_=>!_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 
    = procSearch(ME, M, 'bubble[T], 'bubble[T'], '!, unbounded, unbounded, VS, DB) .

  eq procCommand('search_~>1_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 
    = procNarrowSearch(ME, M, 'bubble[T], 'bubble[T'], '+, unbounded, 1, VS, DB) .
  eq procCommand('search_~>*_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 
    = procNarrowSearch(ME, M, 'bubble[T], 'bubble[T'], '*, unbounded, unbounded, VS, DB) .
  eq procCommand('search_~>+_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 
    = procNarrowSearch(ME, M, 'bubble[T], 'bubble[T'], '+, unbounded, unbounded, VS, DB) .
  eq procCommand('search_~>!_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 
    = procNarrowSearch(ME, M, 'bubble[T], 'bubble[T'], '!, unbounded, unbounded, VS, DB) .

  eq procCommand('match_<=?_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 
    = procMatch(ME, M, 'bubble[T], 'bubble[T'], 'match, 0, VS, DB) .
  eq procCommand('xmatch_<=?_.['bubble[T], 'bubble[T']], ME, M, VS, DB) 
    = procMatch(ME, M, 'bubble[T], 'bubble[T'], 'xmatch, 0, VS, DB) .

  eq procCommand('unify_.['bubble[T]], ME, M, VS, DB) 
    = procUnify(ME, M, 'bubble[T], unbounded, VS, DB) .

  eq procCommand('id-unify_.['bubble[T]], ME, M, VS, DB) 
    = procIdUnify(ME, M, 'bubble[T], unbounded, VS, DB) .

  eq procCommandUp(ME, M, 'down_:_[T, T'], VDS, DB) 
    = downTerm(procCommandUp(ME, M, T', VDS, DB)) .
  eq procCommandUp(ME, M, 'red_.['bubble[T]], VDS, DB) 
    = downTerm(procRedUp(ME, M, 'bubble[T], VDS, DB)) .
  eq procCommandUp(ME, M, 'reduce_.['bubble[T]], VDS, DB)
    = downTerm(procRedUp(ME, M, 'bubble[T], VDS, DB)) .
  eq procCommandUp(ME, M, 'rew_.['bubble[T]], VDS, DB) 
    = downTerm(procRewUp(ME, M, 'bubble[T], unbounded, VDS, DB)) .
  eq procCommandUp(ME, M, 'rewrite_.['bubble[T]], VDS, DB)
    = downTerm(procRewUp(ME, M, 'bubble[T], unbounded, VDS, DB)) .
  eq procCommandUp(ME, M, 'frew_.['bubble[T]], VDS, DB) 
    = downTerm(procFrewUp(ME, M, 'bubble[T], unbounded, 0, VDS, DB)) .
  eq procCommandUp(ME, M, 'frewrite_.['bubble[T]], VDS, DB)
    = downTerm(procFrewUp(ME, M, 'bubble[T], unbounded, 0, VDS, DB)) .

  ceq procRedUp(ME, M, T, VDS, DB) 
    = if metaReduce(getModule(TM), getTerm(TM)) :: ResultPair
      then getTerm(metaReduce(getModule(TM), getTerm(TM)))
      else qidError('\r 'Error: '\o 'Incorrect 'command. '\n)
      fi
    if TM := solveBubblesRed(T, M, 
               included('META-MODULE, getImports(getTopModule(ME, DB)), DB), 
               VDS, DB) .

  ceq procRewUp(ME, M, T, D, VDS, DB) 
    = if metaRewrite(getModule(TMVB), getTerm(TMVB), getBound(TMVB)) 
           :: ResultPair
      then getTerm(metaRewrite(getModule(TMVB), getTerm(TMVB), getBound(TMVB)))
      else qidError('\r 'Error: '\o 'Incorrect 'command. '\n)
      fi
    if TMVB := solveBubblesRew(T, M, 
                included('META-MODULE, getImports(getTopModule(ME, DB)), DB), 
                D, VDS, DB) .

  ceq procFrewUp(ME, M, T, D, I, VDS, DB) 
    = if metaFrewrite(
           getModule(TMVBN), getTerm(TMVBN), getBound(TMVBN), getNat(TMVBN))
         :: ResultPair
      then getTerm(
             metaFrewrite(getModule(TMVBN), getTerm(TMVBN), 
               getBound(TMVBN), getNat(TMVBN)))
      else qidError('\r 'Error: '\o 'Incorrect 'command. '\n)
      fi
    if TMVBN := solveBubblesFrew(T, M, 
                 included('META-MODULE, getImports(getTopModule(ME, DB)), DB),
                 D, I, VDS, DB) .

  ceq procParse(ME, M, T, VDS, DB)
    = if leastSort(getModule(TM), getTerm(TM)) :: Type
      then (eMetaPrettyPrint(leastSort(getModule(TM), getTerm(TM)))
            '\s '\b ': '\o '\n '\s '\s 
            eMetaPrettyPrint(getModule(TM), getTerm(TM)) '\n)
      else getMsg(getTerm(TM))
      fi
    if TM := solveBubblesRed(T, M, 
               included('META-MODULE, getImports(getTopModule(ME, DB)), DB), 
               VDS, DB) .
  eq procParse(ME, unitError(QIL), T, VDS, DB) = QIL .
  eq procParse(ME, noModule, T, VDS, DB) = getMsg(DB) .

  ceq procRed(ME, M, T, VDS, DB)
    = if metaReduce(getModule(TM), getTerm(TM)) :: ResultPair
      then ('\b 'reduce 'in 
            '\o eMetaPrettyPrint(getName(getModule(TM))) '\b ': '\o '\n '\s '\s
            eMetaPrettyPrint(getModule(TM), getTerm(TM)) '\n 
            '\b 'result '\o '\s 
            eMetaPrettyPrint(getType(metaReduce(getModule(TM), getTerm(TM))))
            '\s '\b ': '\o '\n '\s '\s 
            eMetaPrettyPrint(getModule(TM), 
              getTerm(metaReduce(getModule(TM), getTerm(TM))))
            '\n)
      else getMsg(getTerm(metaReduce(getModule(TM), getTerm(TM))))
      fi 
    if TM := solveBubblesRed(T, M, 
               included('META-MODULE, getImports(getTopModule(ME, DB)), DB), 
               VDS, DB) .
  eq procRed(ME, unitError(QIL), T, VDS, DB) = QIL .
  eq procRed(ME, noModule, T, VDS, DB) = getMsg(DB) .

  eq metaReduce(unitError(QIL), T) = {qidError(QIL), '`[Term`]} .
  eq metaReduce(U:[Module], qidError(QIL)) = {qidError(QIL), '`[Term`]} .

  ceq solveBubblesRed('bubble[QI], M, B, VDS, DB) 
    = if T? :: Term
      then {T?, M, B, VDS, DB}
      else tuple<Term|Module|Bool|OpDeclSet|Database>Error(
             '\r 'Error: '\o 'no 'parse 'for downQidList(QI) '\n)
      fi 
    if T? := solveBubbles('bubble[QI], M, B, VDS, DB) .
  ceq solveBubblesRed('bubble['__[TL]], M, B, VDS, DB) 
    = if T? :: Term
      then {T?, M, B, VDS, DB}
      else if metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), '@RedInPart@) :: ResultPair
           then solveBubblesRed2(
                  getTerm(metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), '@RedInPart@)), 
                  DB) 
           else tuple<Term|Module|Bool|OpDeclSet|Database>Error('\r 'Warning: '\o 
                      printSyntaxError(
                        metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), 
                        '@RedInPart@), downQidList('__[TL, ''..Qid])) '\n
                      '\r 'Error: '\o 
                      'no 'parse 'for downQidList('__[TL, ''..Qid]) '\n)
           fi
      fi 
    if T? := solveBubbles('bubble['__[TL]], M, B, VDS, DB) .
  *** There is some problem parsing 'in_:_ in solveBubblesRed, but it 
  *** seems to work with the additional '.

  ceq solveBubblesRed2('in_:_.[T, T'], DB) 
    = if unitInDb(ME, DB')
      then solveBubblesRed3(T', getFlatModule(ME, DB'), ME, getVars(ME, DB'), DB')
      else tuple<Term|Module|Bool|OpDeclSet|Database>Error('\r 'Error: '\o 
             'It 'is 'not 'possible 'to 'compile eMetaPrettyPrint(ME) '. '\n)
      fi 
    if < DB' ; ME > := evalModExp(parseModExp(T), DB) .
  eq solveBubblesRed2('in_:_.[T, T'], DB) 
    = tuple<Term|Module|Bool|OpDeclSet|Database>Error('\r 'Error: '\o 
      'It 'isn't 'possible 'to 'compile eMetaPrettyPrint(parseModExp(T)) '. '\n)
    [owise] .

  eq solveBubblesRed3(T, M, ME, VDS, DB) 
    = {solveBubbles(T, M, 
         included('META-MODULE, getImports(getTopModule(ME, DB)), DB),
         VDS, DB),
       M, 
       included('META-MODULE, getImports(getTopModule(ME, DB)), DB), 
       VDS, 
       DB} .

  op GRAMMAR-RED : -> FModule [memo] .
  eq GRAMMAR-RED
    = addImports((including 'MOD-EXPRS .),
        addSorts('@RedInPart@,
          addOps((op 'in_:_. : '@ModExp@ '@Bubble@ -> '@RedInPart@ [none] .),
            BUBBLES))) .

  ceq procRew(ME, M, T, VDS, DB)
    = if RP :: ResultPair
      then ('\b 'rewrite 'in '\o eMetaPrettyPrint(getName(getModule(TMVB))) 
            '\b ': '\o '\n '\s '\s 
            eMetaPrettyPrint(getModule(TMVB), getTerm(TMVB)) '\n 
            '\b 'result '\o '\s 
            eMetaPrettyPrint(getType(RP))
            '\s '\b ': '\o '\n '\s '\s 
            eMetaPrettyPrint(getModule(TMVB), getTerm(RP))
            '\n)
      else getMsg(getTerm(TMVB))
      fi 
    if TMVB := solveBubblesRew(T, M, 
                included('META-MODULE, getImports(getTopModule(ME, DB)), DB),
                unbounded, VDS, DB) 
       /\ RP  := metaRewrite(getModule(TMVB), getTerm(TMVB), getBound(TMVB)) .
  eq procRew(ME, unitError(QIL), T, VDS, DB) = qidError(QIL) .

  eq solveBubblesRew('bubble[QI], M, B, D, VDS, DB) 
    = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term
      then {solveBubbles('bubble[QI], M, B, VDS, DB), M, B, VDS, unbounded, DB}
      else tuple<Term|Module|Bool|OpDeclSet|Bound|Database>Error(
             '\r 'Error: '\o 'no 'parsing 'for downQidList(QI) '\n)
      fi .
  eq solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB) 
    = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term
      then {solveBubbles('bubble['__[TL]], M, B, VDS, DB), M, B, VDS, unbounded, DB}
      else if metaParse(GRAMMAR-REW, downQidList('__[TL, ''..Qid]), '@RewNuPart@)
                :: ResultPair
           then solveBubblesRew2(
                  getTerm(
                    metaParse(GRAMMAR-REW, downQidList('__[TL, ''..Qid]), 
                      '@RewNuPart@)), 
                  M, B, VDS, DB) 
           else {getTerm(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), 
                 getModule(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), 
                 getBool(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), 
                 getVars(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)),
                 unbounded, 
                 getDatabase(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB))}
           fi
      fi .

  eq solveBubblesRew2('`[_`]_.['token[T], T'], M, B, VDS, DB) 
    = if downNat(downMetaNat(T)) :: Nat
         and-then solveBubblesRed(T', M, B, VDS, DB) 
                    :: Tuple<Term|Module|Bool|OpDeclSet|Database>
      then {getTerm(solveBubblesRed(T', M, B, VDS, DB)), 
            getModule(solveBubblesRed(T', M, B, VDS, DB)),
            getBool(solveBubblesRed(T', M, B, VDS, DB)),
            getVars(solveBubblesRed(T', M, B, VDS, DB)),
            downNat(downMetaNat(T)),
            getDatabase(solveBubblesRed(T', M, B, VDS, DB))}
      else tuple<Term|Module|Bool|OpDeclSet|Bound|Database>Error(
             '\r 'Error: '\o 'Incorrect 'command. '\n)
      fi .

  op GRAMMAR-REW : -> FModule [memo] .
  eq GRAMMAR-REW
    = addSorts('@RewNuPart@ ; '@Token@ ; '@SortToken@ ; '@ViewToken@ ; '@NeTokenList@ ; '@Bubble@,
        addOps((op '`[_`]_. : '@Token@ '@Bubble@ -> '@RewNuPart@ [none] .),
          BUBBLES)) .

----  eq metaRewrite(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T, D)
----    = metaReduce(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T) .
----  eq metaRewrite(M, T, 0) = {T, leastSort(M, T)} .

  *** FREW

  ceq procFrew(ME, M, T, D, I, VDS, DB)
    = if RP :: ResultPair
      then ('\b 'frewrite 'in '\o eMetaPrettyPrint(getName(getModule(TMVBN))) 
            '\b ': '\o  '\n '\s '\s 
            eMetaPrettyPrint(getModule(TMVBN), getTerm(TMVBN)) '\n 
            '\b 'result '\o '\s eMetaPrettyPrint(getType(RP)) 
            '\s '\b ': '\o '\n '\s '\s 
            eMetaPrettyPrint(getModule(TMVBN), getTerm(RP)) '\n)
      else ('\r 'Error: '\o 'Incorrect 'command. '\n)
      fi 
    if TMVBN := solveBubblesFrew(T, M, 
                 included('META-MODULE, getImports(getTopModule(ME, DB)), DB), 
                 D, I, VDS, DB) 
       /\ RP   := metaFrewrite(getModule(TMVBN), getTerm(TMVBN), 
                               getBound(TMVBN),  getNat(TMVBN)) .
  eq procFrew(ME, unitError(QIL), T, D, I, VDS, DB) = qidError(QIL) .

  eq solveBubblesFrew('bubble[QI], M, B, D, I, VDS, DB) 
    = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term
      then {solveBubbles('bubble[QI], M, B, VDS, DB), M, VDS, unbounded, I}
      else tuple<Term|Module|OpDeclSet|Bound|Nat>Error(
             '\r 'Error: '\o 'no 'parse 'for downQidList(QI) '\n)
      fi .
  eq solveBubblesFrew('bubble['__[TL]], M, B, D, I, VDS, DB) 
    = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term
      then {solveBubbles('bubble['__[TL]], M, B, VDS, DB), 
              M, VDS, unbounded, I}
      else if metaParse(GRAMMAR-FREW, downQidList('__[TL, ''..Qid]), 
                '@FrewNuPart@)
                :: ResultPair
           then solveBubblesFrew2(
                  getTerm(
                    metaParse(GRAMMAR-FREW, downQidList('__[TL, ''..Qid]), 
                      '@FrewNuPart@)), 
                  M, B, I, VDS, DB) 
           else {getTerm(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), 
                 getModule(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)),
                 getVars(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)),
                 unbounded, I}
           fi
      fi .
  *** There is some problem parsing _ in solveBubblesRed, but it 
  *** seems to work with the additional '.

  eq solveBubblesFrew2('`[_`]_.['token[T], T'], M, B, I, VDS, DB) 
    = if downNat(downMetaNat(T)) :: Nat
         and-then solveBubblesRed(T', M, B, VDS, DB) 
                    :: Tuple<Term|Module|Bool|OpDeclSet|Database>
      then {getTerm(solveBubblesRed(T', M, B, VDS, DB)), 
            getModule(solveBubblesRed(T', M, B, VDS, DB)),
            getVars(solveBubblesRed(T', M, B, VDS, DB)),
            downNat(downMetaNat(T)),
            I}
      else tuple<Term|Module|OpDeclSet|Bound|Nat>Error(
             '\r 'Error: '\o 'Incorrect 'command. '\n)
      fi .
  eq solveBubblesFrew2('`[_`,_`]_.['token[T], 'token[T'], T''], 
       M, B, I, VDS, DB) 
    = if downNat(downMetaNat(T)) :: Nat
         and-then downNat(downMetaNat(T')) :: Nat
         and-then solveBubblesRed(T'', M, B, VDS, DB) 
                    :: Tuple<Term|Module|Bool|OpDeclSet|Database>
      then {getTerm(solveBubblesRed(T'', M, B, VDS, DB)), 
            getModule(solveBubblesRed(T'', M, B, VDS, DB)),
            getVars(solveBubblesRed(T'', M, B, VDS, DB)),
            downNat(downMetaNat(T)),
            downNat(downMetaNat(T'))}
      else tuple<Term|Module|OpDeclSet|Bound|Nat>Error(
             '\r 'Error: '\o 'Incorrect 'command. '\n)
      fi .

  op GRAMMAR-FREW : -> FModule [memo] .
  eq GRAMMAR-FREW
    = addSorts('@FrewNuPart@ ; '@Token@ ; '@SortToken@ ; '@ViewToken@ ; '@NeTokenList@ ; '@Bubble@,
        addOps(
          (op '`[_`]_. : '@Token@ '@Bubble@ -> '@FrewNuPart@ [none] .
           op '`[_`,_`]_. : '@Token@ '@Token@ '@Bubble@ -> '@FrewNuPart@ [none] .),
          BUBBLES)) .

  eq metaFrewrite(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T, D, I)
    = metaReduce(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T) .
  eq metaFrewrite(M, T, 0, I) = {T, leastSort(M, T)} .
  eq metaFrewrite(M, T, D, 0) = {T, leastSort(M, T)} .

  *** SEARCH 

  op GRAMMAR-SEARCH : -> FModule [memo] .
  eq GRAMMAR-SEARCH
    = addSorts('@SearchNuPart@ ; '@Token@ ; '@SortToken@ ; '@ViewToken@ ; '@NeTokenList@ ; '@Bubble@,
        addOps((op '`[_`,_`]_. : '@Token@ '@Token@ '@Bubble@ -> '@SearchNuPart@ [none] .)
               (op '`[`,_`]_. : '@Token@ '@Bubble@ -> '@SearchNuPart@ [none] .),
          BUBBLES)) .

  ceq procSearch(ME, M, T, T', QI, D, D', VDS, DB)
    *** D is a bound on the number of solutions, and D' is a bound on the depth of the search
    = if solveBubblesRl(T, T', M, B, VDS, DB) :: Term
      then procSearch2(addOps(VDS, M), 
             lhs(solveBubblesRl(T, T', M, B, VDS, DB)), 
             rhs(solveBubblesRl(T, T', M, B, VDS, DB)), nil, QI, D, D')
      else solveBubblesSearchL(M, T, T', QI, D, D', B, VDS, DB)
      fi
    if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) .

  eq solveBubblesSearchL(M, 'bubble[QI], T, QI', D, D', B, VDS, DB) 
    = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term
      then solveBubblesSearchR(M, solveBubbles('bubble[QI], M, B, VDS, DB), T, QI', D, D', B, VDS, DB)
      else ('\r 'Error: '\o 'no 'parsing 'for downQidList(QI) '\n)
      fi .
  eq solveBubblesSearchL(M, 'bubble['__[TL]], T, QI, D, D', B, VDS, DB) 
    = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term
      then solveBubblesSearchR(M, solveBubbles('bubble['__[TL]], M, B, VDS, DB), T, QI, D, D', B, VDS, DB)
      else if metaParse(GRAMMAR-SEARCH, downQidList('__[TL, ''..Qid]), '@SearchNuPart@) :: ResultPair
           then solveBubblesSearchL1(
                  M,
                  getTerm(metaParse(GRAMMAR-SEARCH, downQidList('__[TL, ''..Qid]), '@SearchNuPart@)), 
                  T, QI, D, D', B, VDS, DB) 
           else solveBubblesSearchR(
                  getModule(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)), 
                  getTerm(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)), 
                  T,
                  QI, 
                  getBound(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
                  D',
                  getBool(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
                  getVars(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
                  getDatabase(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)))
           fi
      fi .

  eq solveBubblesSearchL1(M, '`[`,_`]_.['token[T], T'], T'', QI, D, D', B, VDS, DB)
    = if downNat(downMetaNat(T)) :: Nat
         and-then solveBubblesRed(T', M, B, VDS, DB) :: Tuple<Term|Module|Bool|OpDeclSet|Database>
      then solveBubblesSearchR(
             getModule(solveBubblesRed(T', M, B, VDS, DB)),
             getTerm(solveBubblesRed(T', M, B, VDS, DB)), 
             T'', QI, D,  
             downNat(downMetaNat(T)), 
             B, 
             getVars(solveBubblesRed(T', M, B, VDS, DB)), 
             DB) 
      else ('\r 'Error: '\o 'Incorrect 'command. '\n)
      fi .
  eq solveBubblesSearchL1(M, '`[_`,_`]_.['token[T], 'token[T'], T''], T''', QI, D, D', B, VDS, DB) 
    = if downNat(downMetaNat(T)) :: Nat
         and-then downNat(downMetaNat(T')) :: Nat
         and-then solveBubblesRed(T'', M, B, VDS, DB) :: Tuple<Term|Module|Bool|OpDeclSet|Database>
      then solveBubblesSearchR(
             getModule(solveBubblesRed(T'', M, B, VDS, DB)),
             getTerm(solveBubblesRed(T'', M, B, VDS, DB)), 
             T''', QI,  
             downNat(downMetaNat(T)), 
             downNat(downMetaNat(T')), 
             B, 
             getVars(solveBubblesRed(T'', M, B, VDS, DB)), 
             DB) 
      else ('\r 'Error: '\o 'Incorrect 'command. '\n)
      fi .

  eq solveBubblesSearchR(M, T, T', QI, D, D', B, VDS, DB)
    = solveBubblesSearchR1(
        M, 
        addOps(
          op '_s.t._. : leastSort(M, T) '@Condition@ -> 'PatternCondition [none] .
          op '_such`that_. : leastSort(M, T) '@Condition@ -> 'PatternCondition [none] .,
          addSorts('PatternCondition, addInfoConds(M))),
        T, 
        T', 
        QI, 
        D, 
        D', 
        B, 
        VDS, 
        DB) .
  eq solveBubblesSearchR(M:[Module], T:[Term], T':[Term], QI:[Qid], D:[Bound], D':[Bound], B:[Bool], VDS:[OpDeclSet], DB:[Database])
    = qidError('\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n) .
    
  ceq solveBubblesSearchR1(M, M', T, 'bubble[QI], QI', D, D', B, VDS, DB)
    = if T?:[Term] :: Term
      then procSearch2(M, T, T?:[Term], nil, QI', D, D')
      else ('\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n) 
      fi
    if T?:[Term] := solveBubbles('bubble[QI], M, B, VDS, DB) . 
  ceq solveBubblesSearchR1(M, M', T, 'bubble['__[TL]], QI, D, D', B, VDS, DB)
    = if T?:[Term] :: Term
      then procSearch2(M, T, T?:[Term], nil, QI, D, D')
      else if metaParse(M', downQidList('__[TL, ''..Qid]), 'PatternCondition) 
                :: ResultPair
           then solveBubblesSearchR2(M, T, 
                  getTerm(
                    metaParse(M', downQidList('__[TL, ''..Qid]), 
                      'PatternCondition)), 
                  QI, D, D', VDS)
           else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n
           fi
      fi 
    if T?:[Term] := solveBubbles('bubble['__[TL]], M, B, VDS, DB) .

  eq solveBubblesSearchR2(M, T, QI, QI', D, D', VDS)
    = procSearch2(M, T, constsToVars(QI, VDS), nil, QI', D, D') .
  eq solveBubblesSearchR2(M, T, F[T], QI, D, D', VDS)
    = procSearch2(M, T, constsToVars(F[T], VDS), nil, QI, D, D') .
  eq solveBubblesSearchR2(M, T, F[T', T''], QI, D, D', VDS)
    = if F == '_s.t._. or F == '_such`that_. 
      then procSearch2(M, T, T', parseCond(T'', VDS), QI, D, D')
      else procSearch2(M, T, constsToVars(F[T', T''], VDS), nil, QI, D, D')
      fi .
  eq solveBubblesSearchR2(M, T, F[T', T'', TL], QI, D, D', VDS)
    = procSearch2(M, T, constsToVars(F[T', T'', TL], VDS), nil, QI, D, D') .

  ceq procSearch2(M, T, T', CD, QI, D, D')
    = if RT :: ResultTriple
      then ('search 
            if D == unbounded and D' == unbounded
            then nil
            else '\s '`[ 
                 if D == unbounded 
                 then nil 
                 else qid(string(D, 10)) 
                 fi
                 if D' == unbounded
                 then nil
                 else '`, qid(string(D', 10))  
                 fi
                 '`] '\s
            fi 
            'in eMetaPrettyPrint(getName(M)) ':
            eMetaPrettyPrint(M, T) '\s qid("=>" + string(QI)) '\s 
            eMetaPrettyPrint(M, T'') '.
            '\n '\n 'Solution '1
            if gTSubstitution(RT) == none
            then '\n 'empty 'substitution
            else '\n eMetaPrettyPrint(M, gTSubstitution(RT))
            fi
            procSearch3(M, T, T'', CD, QI, D, 1, D'))
      else if RT == failure
           then ('search 
           if D == unbounded and D' == unbounded
            then nil
            else '\s '`[ 
                 if D == unbounded 
                 then nil 
                 else qid(string(D, 10)) 
                 fi
                 if D' == unbounded
                 then nil
                 else '`, qid(string(D', 10))  
                 fi
                 '`] '\s
            fi 
            'in eMetaPrettyPrint(getName(M)) ':
                 eMetaPrettyPrint(M, T) 
                 '\s qid("=>" + string(QI)) '\s 
                 eMetaPrettyPrint(M, T'') '.
                 '\n '\n 'No 'solution. '\n) 
           else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n 
           fi
      fi 
    if T'' := prepSearchPattern(T')
       /\ RT := metaSearch(M, T, T'', CD, QI, D', 0) .


  eq procSearch3(M, T, T', CD, QI, D, I, D')
    = if D == unbounded or-else (D == 0 or-else I < D) 
      then if metaSearch(M, T, T', CD, QI, D', I) :: ResultTriple
           then ('\n '\n 'Solution qid(string(I + 1, 10))
                 if gTSubstitution(metaSearch(M, T, T', CD, QI, D', I)) == none
                 then '\n 'empty 'substitution
                 else '\n eMetaPrettyPrint(M, 
                            gTSubstitution(
                              metaSearch(M, T, T', CD, QI, D', I)))
                 fi
                 procSearch3(M, T, T', CD, QI, D, I + 1, D'))
           else ('\n '\n 'No 'more 'solutions.)
           fi
      else nil
      fi .  

-------------------
*** Equal to procSearch except replacing metaSearch by metaNarrowSearch

  ceq procNarrowSearch(ME, M, T, T', QI, D, D', VDS, DB)
    *** D is a bound on the number of solutions, and D' is a bound on the depth of the search
    = if solveBubblesRl(T, T', M, B, VDS, DB) :: Term
      then procNarrowSearch2(addOps(VDS, M), 
             lhs(solveBubblesRl(T, T', M, B, VDS, DB)), 
             rhs(solveBubblesRl(T, T', M, B, VDS, DB)), nil, QI, D, D')
      else solveBubblesNarrowSearchL(M, T, T', QI, D, D', B, VDS, DB)
      fi
    if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) .

  eq solveBubblesNarrowSearchL(M, 'bubble[QI], T, QI, D, D', B, VDS, DB) 
    = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term
      then solveBubblesNarrowSearchR(M, solveBubbles('bubble[QI], M, B, VDS, DB), T, QI, D, D', B, VDS, DB)
      else ('\r 'Error: '\o 'no 'parsing 'for downQidList(QI) '\n)
      fi .
  eq solveBubblesNarrowSearchL(M, 'bubble['__[TL]], T, QI, D, D', B, VDS, DB) 
    = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term
      then solveBubblesNarrowSearchR(M, solveBubbles('bubble['__[TL]], M, B, VDS, DB), T, QI, D, D', B, VDS, DB)
      else if metaParse(GRAMMAR-SEARCH, downQidList('__[TL, ''..Qid]), '@SearchNuPart@) :: ResultPair
           then solveBubblesNarrowSearchL1(
                  M,
                  getTerm(
                    metaParse(GRAMMAR-SEARCH, downQidList('__[TL, ''..Qid]), 
                      '@SearchNuPart@)), 
                  T, QI, D, D', B, VDS, DB) 
           else solveBubblesNarrowSearchR(
                  getModule(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)), 
                  getTerm(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)), 
                  T,
                  QI, 
                  getBound(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
                  D',
                  getBool(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
                  getVars(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
                  getDatabase(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)))
           fi
      fi .

  eq solveBubblesNarrowSearchL1(M, '`[`,_`]_.['token[T], T'], T'', QI, D, D', B, VDS, DB)
    = if downNat(downMetaNat(T)) :: Nat
         and-then solveBubblesRed(T', M, B, VDS, DB) :: Tuple<Term|Module|Bool|OpDeclSet|Database>
      then solveBubblesNarrowSearchR(
             getModule(solveBubblesRed(T', M, B, VDS, DB)),
             getTerm(solveBubblesRed(T', M, B, VDS, DB)), 
             T'', QI, D,  
             downNat(downMetaNat(T)), 
             B, 
             getVars(solveBubblesRed(T', M, B, VDS, DB)), 
             DB) 
      else ('\r 'Error: '\o 'Incorrect 'command. '\n)
      fi .
  eq solveBubblesNarrowSearchL1(M, '`[_`,_`]_.['token[T], 'token[T'], T''], T''', QI, D, D', B, VDS, DB) 
    = if downNat(downMetaNat(T)) :: Nat
         and-then downNat(downMetaNat(T')) :: Nat
         and-then solveBubblesRed(T'', M, B, VDS, DB) :: Tuple<Term|Module|Bool|OpDeclSet|Database>
      then solveBubblesNarrowSearchR(
             getModule(solveBubblesRed(T'', M, B, VDS, DB)),
             getTerm(solveBubblesRed(T'', M, B, VDS, DB)), 
             T''', QI,  
             downNat(downMetaNat(T)), 
             downNat(downMetaNat(T')), 
             B, 
             getVars(solveBubblesRed(T'', M, B, VDS, DB)), 
             DB) 
      else ('\r 'Error: '\o 'Incorrect 'command. '\n)
      fi .

  eq solveBubblesNarrowSearchR(M, T, T', QI, D, D', B, VDS, DB)
    = solveBubblesNarrowSearchR1(
        M, 
        addOps(
          op '_s.t._. : leastSort(M, T) '@Condition@ -> 'PatternCondition [none] .
          op '_such`that_. : leastSort(M, T) '@Condition@ -> 'PatternCondition [none] .,
          addSorts('PatternCondition, addInfoConds(M))),
        T, 
        T', 
        QI, 
        D, 
        D', 
        B, 
        VDS, 
        DB) .
  eq solveBubblesNarrowSearchR(M:[Module], T:[Term], T':[Term], QI:[Qid], D:[Bound], D':[Bound], B:[Bool], VDS:[OpDeclSet], DB:[Database])
    = qidError('\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n) .
    
  ceq solveBubblesNarrowSearchR1(M, M', T, 'bubble[QI], QI', D, D', B, VDS, DB)
    = if T?:[Term] :: Term
      then procNarrowSearch2(M, T, T?:[Term], nil, QI', D, D')
      else ('\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n) 
      fi
    if T?:[Term] := solveBubbles('bubble[QI], M, B, VDS, DB) . 
  ceq solveBubblesNarrowSearchR1(M, M', T, 'bubble['__[TL]], QI, D, D', B, VDS, DB)
    = if T?:[Term] :: Term
      then procNarrowSearch2(M, T, T?:[Term], nil, QI, D, D')
      else if metaParse(M', downQidList('__[TL, ''..Qid]), 'PatternCondition) 
                :: ResultPair
           then solveBubblesNarrowSearchR2(M, T, 
                  getTerm(
                    metaParse(M', downQidList('__[TL, ''..Qid]), 
                      'PatternCondition)), 
                  QI, D, D', VDS)
           else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n
           fi
      fi 
    if T?:[Term] := solveBubbles('bubble['__[TL]], M, B, VDS, DB) .

  eq solveBubblesNarrowSearchR2(M, T, QI, QI', D, I, VDS)
    = procNarrowSearch2(M, T, constsToVars(QI, VDS), nil, QI', D, I) .
  eq solveBubblesNarrowSearchR2(M, T, F[T], QI, D, I, VDS)
    = procNarrowSearch2(M, T, constsToVars(F[T], VDS), nil, QI, D, I) .
  eq solveBubblesNarrowSearchR2(M, T, F[T', T''], QI, D, I, VDS)
    = if F == '_s.t._. or F == '_such`that_. 
      then procNarrowSearch2(M, T, T', parseCond(T'', VDS), QI, D, I)
      else procNarrowSearch2(M, T, constsToVars(F[T', T''], VDS), nil, QI, D, I)
      fi .
  eq solveBubblesNarrowSearchR2(M, T, F[T', T'', TL], QI, D, I, VDS)
    = procNarrowSearch2(M, T, constsToVars(F[T', T'', TL], VDS), nil, QI, D, I) .

  ceq procNarrowSearch2(M, T, T', CD, QI, D, D')
    = if RTS:[ResultTripleSet] :: ResultTripleSet
      then ('search 
            if D == unbounded and D' == unbounded
            then nil
            else '\s '`[ 
                 if D == unbounded 
                 then nil 
                 else qid(string(D, 10)) 
                 fi
                 if D' == unbounded
                 then nil
                 else '`, qid(string(D', 10))  
                 fi
                 '`] '\s
            fi 
            'in eMetaPrettyPrint(getName(M)) ':
            eMetaPrettyPrint(M, T) '\s qid("~>" + string(QI)) '\s 
            eMetaPrettyPrint(M, T'') '.
            procNarrowSearch3(M, 0, Vars((T,T')), RTS:[ResultTripleSet]))
      else if RTS:[ResultTripleSet] == empty
           then ('search 
           if D == unbounded and D' == unbounded
            then nil
            else '\s '`[ 
                 if D == unbounded 
                 then nil 
                 else qid(string(D, 10)) 
                 fi
                 if D' == unbounded
                 then nil
                 else '`, qid(string(D', 10))  
                 fi
                 '`] '\s
            fi 
            'in eMetaPrettyPrint(getName(M)) ':
                 eMetaPrettyPrint(M, T) 
                 '\s qid("~>" + string(QI)) '\s 
                 eMetaPrettyPrint(M, T'') '.
                 '\n '\n 'No 'solution. '\n) 
           else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n 
           fi
      fi 
    if T'' := prepSearchPattern(T')
       /\ RTS:[ResultTripleSet]
          := upDown(M,
              metaNarrowSearchGen(M, T, T'', none, typeOfRelation(QI), D', D, 
                                 full AC-unify noStrategy E-normalize-terms) 
              |> (T,T'') 
             ) .
  eq procNarrowSearch3(M, I, TL:TermList, empty)
   = ('\n '\n 'No 'more 'solutions.) .
  eq procNarrowSearch3(M, I, TL:TermList, {T:Term,TP:Type,S:Substitution} | RTS:ResultTripleSet)
    = ('\n '\n 'Solution qid(string(I + 1, 10))
       if (S:Substitution |> TL:TermList) == none
       then '\n 'empty 'substitution
       else '\n eMetaPrettyPrint(M, S:Substitution |> TL:TermList)
       fi
       procNarrowSearch3(M, I + 1, TL:TermList, RTS:ResultTripleSet)) .

-------------------

  sort Tuple{TermList, Nat} .
  op <_;_> : Term Nat -> Tuple{TermList, Nat} .
  op term : Tuple{TermList, Nat} -> TermList .
  op index : Tuple{TermList, Nat} -> Nat .
  eq term(< TL ; I >) = TL .
  eq index(< TL ; I >) = I .

  op prepSearchPattern : Term -> Term .
  op prepSearchPattern : TermList Nat -> Tuple{TermList, Nat} .

  eq prepSearchPattern(T) = term(prepSearchPattern(T, 0)) .

  eq prepSearchPattern('<_:_|_>[O, Ct, T], I)
    = < '<_:_|_>[O, qid("V#" + string(I, 10) + ":" + string(getName(Ct))),
           '_`,_[term(prepSearchPattern(T, s s I)), 
                 qid("V#" + string(s I, 10) + ":AttributeSet")]] ;
        index(prepSearchPattern(T, s s I)) > .
  eq prepSearchPattern('<_:_|`>[O, Ct], I)
    = < '<_:_|_>[O, qid("V#" + string(I, 10) + ":" + string(getName(Ct))),
           qid("V#" + string(s I, 10) + ".AttributeSet")] ;
        s I > .
  eq prepSearchPattern(F[TL], I)
    = < F[term(prepSearchPattern(TL, I))] ;
        index(prepSearchPattern(TL, I)) >
    [owise] .

  eq prepSearchPattern(F, I) = < F ; I > .
  eq prepSearchPattern(Ct, I) = < Ct ; I > .

  ceq prepSearchPattern((T, TL), I)
    = < (term(prepSearchPattern(T, I)), 
         term(prepSearchPattern(TL, index(prepSearchPattern(T, I))))) ;
        index(prepSearchPattern(TL, index(prepSearchPattern(T, I)))) > 
    if TL =/= empty .

  *** MATCH 

  ceq procMatch(ME, M, T, T', QI, I, VDS, DB)
    *** the number I in search is not a bound, but the number of solutions
    = if solveBubblesRl(T, T', M, B, VDS, DB) :: Term
      then procMatch2(addOps(VDS, M), 
             lhs(solveBubblesRl(T, T', M, B, VDS, DB)), 
             rhs(solveBubblesRl(T, T', M, B, VDS, DB)), nil, QI, I)
      else if solveBubblesRew(T, M, B, I, VDS, DB)
                :: Tuple<Term|Module|Bool|OpDeclSet|Bound|Database>
           then solveBubblesMatch(
                  getModule(solveBubblesRew(T, M, B, I, VDS, DB)), 
                  addOps(
                    op '_s.t._. : 
                       leastSort(
                         getModule(solveBubblesRew(T, M, B, I, VDS, DB)),
                         getTerm(solveBubblesRew(T, M, B, I, VDS, DB)))
                       '@Condition@ -> 'PatternCondition [none] .
                    op '_such`that_. : 
                       leastSort(
                         getModule(solveBubblesRew(T, M, B, I, VDS, DB)),
                         getTerm(solveBubblesRew(T, M, B, I, VDS, DB)))
                       '@Condition@ -> 'PatternCondition [none] .,
                    addSorts('PatternCondition, 
                      addInfoConds(
                        getModule(solveBubblesRew(T, M, B, I, VDS, DB))))),
                  getTerm(solveBubblesRew(T, M, B, I, VDS, DB)), 
                  T', 
                  QI, 
                  (if getBound(solveBubblesRew(T, M, B, I, VDS, DB)) 
                         == unbounded
                   then 0
                   else getBound(solveBubblesRew(T, M, B, I, VDS, DB))
                   fi), 
                  B, 
                  getVars(solveBubblesRew(T, M, B, I, VDS, DB)), 
                  DB)
           else getMsg(getTerm(solveBubblesRew(T, M, B, I, VDS, DB)))
                ----('\r 'Error: '\o 'Incorrect 'match 'command. '\n)
           fi
      fi
    if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) .

  ceq solveBubblesMatch(M, M', T, 'bubble[QI], QI', I, B, VDS, DB)
    = if T?:[Term] :: Term
      then procMatch2(M, T, T?:[Term], nil, QI', I)
      else ('\r 'Error: '\o 'Incorrect 'use 'of 'the 'match 'command. '\n) 
      fi
    if T?:[Term] := solveBubbles('bubble[QI], M, B, VDS, DB) . 
  ceq solveBubblesMatch(M, M', T, 'bubble['__[TL]], QI, I, B, VDS, DB)
    = if T?:[Term] :: Term
      then procMatch2(M, T, T?:[Term], nil, QI, I)
      else if metaParse(M', downQidList('__[TL, ''..Qid]), 'PatternCondition) 
                :: ResultPair
           then solveBubblesMatch2(M, T, 
                  getTerm(
                    metaParse(M', downQidList('__[TL, ''..Qid]), 
                      'PatternCondition)), 
                  QI, I, VDS)
           else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'match 'command. '\n
           fi
      fi 
    if T?:[Term] := solveBubbles('bubble['__[TL]], M, B, VDS, DB) .

  eq solveBubblesMatch2(M, T, QI, QI', I, VDS)
    = procMatch2(M, T, constsToVars(QI, VDS), nil, QI', I) .
  eq solveBubblesMatch2(M, T, F[T], QI, I, VDS)
    = procMatch2(M, T, constsToVars(F[T], VDS), nil, QI, I) .
  eq solveBubblesMatch2(M, T, F[T', T''], QI, I, VDS)
    = if F == '_s.t._. or F == '_such`that_. 
      then procMatch2(M, T, T', parseCond(T'', VDS), QI, I)
      else procMatch2(M, T, constsToVars(F[T', T''], VDS), nil, QI, I)
      fi .
  eq solveBubblesMatch2(M, T, F[T', T'', TL], QI, I, VDS)
    = procMatch2(M, T, constsToVars(F[T', T'', TL], VDS), nil, QI, I) .

  ceq procMatch2(M, T, T', CD, 'match, I)
    = if Sb? :: Substitution
      then ('match 
            if I == 0 then nil else '\s '`[ qid(string(I, 10)) '`] '\s fi 
            'in eMetaPrettyPrint(getName(M)) ':
            eMetaPrettyPrint(M, T) '\s '<=? '\s eMetaPrettyPrint(M, T') '.
            '\n '\n 'Solution '1
            if Sb? == none
            then '\n 'empty 'substitution
            else '\n eMetaPrettyPrint(M, Sb?)
            fi
            procMatch3(M, T, T', CD, 'match, I, 1))
      else if Sb? == noMatch
           then ('match 
                 if I == 0
                 then nil
                 else '\s '`[ qid(string(I, 10)) '`] '\s 
                 fi 
                 'in eMetaPrettyPrint(getName(M)) ':
                       eMetaPrettyPrint(M, T) '\s '<=? '\s 
                       eMetaPrettyPrint(M, T') '.
                       '\n '\n 'No 'solution. '\n) 
           else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'match 'command. '\n 
           fi
      fi 
    if Sb? := metaMatch(M, T, T', CD, 0) .
  ceq procMatch2(M, T, T', CD, 'xmatch, I)
    = if MP? :: MatchPair
      then ('xmatch 
            if I == 0 then nil else '\s '`[ qid(string(I, 10)) '`] '\s fi 
            'in eMetaPrettyPrint(getName(M)) ':
            eMetaPrettyPrint(M, T) '\s '<=? '\s eMetaPrettyPrint(M, T') '.
            '\n '\n 'Solution '1
            if gTSubstitution(MP?) == none
            then '\n 'empty 'substitution
            else '\n eMetaPrettyPrint(M, gTSubstitution(MP?))
            fi
            procMatch3(M, T, T', CD, 'xmatch, I, 1))
      else if MP? == noMatch
           then ('xmatch 
                 if I == 0
                 then nil
                 else '\s '`[ qid(string(I, 10)) '`] '\s 
                 fi 
                 'in eMetaPrettyPrint(getName(M)) ':
                      eMetaPrettyPrint(M, T) '\s '<=? '\s 
                      eMetaPrettyPrint(M, T') '.
                      '\n '\n 'No 'solution. '\n) 
           else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'xmatch 'command. '\n 
           fi
      fi 
    if MP? := metaXmatch(M, T, T', CD, 0, unbounded, 0) .

  eq procMatch3(M, T, T', CD, 'match, I, J)
    = if I == 0 or J < I 
      then if metaMatch(M, T, T', CD, J) :: Substitution
           then ('\n '\n 'Solution qid(string(J + 1, 10))
                 if metaMatch(M, T, T', CD, J) == none
                 then '\n 'empty 'substitution
                 else '\n eMetaPrettyPrint(M, metaMatch(M, T, T', CD, J))
                 fi
                 procMatch3(M, T, T', CD, 'match, I, J + 1))
           else ('\n '\n 'No 'more 'solutions.)
           fi
      else nil
      fi .
  eq procMatch3(M, T, T', CD, 'xmatch, I, J)
    = if I == 0 or J < I 
      then if metaXmatch(M, T, T', CD, 0, unbounded, J) :: MatchPair
           then ('\n '\n 'Solution qid(string(J + 1, 10))
                 if gTSubstitution(metaXmatch(M, T, T', CD, 0, unbounded, J))
                      == none
                 then '\n 'empty 'substitution
                 else '\n eMetaPrettyPrint(M, 
                            gTSubstitution(
                               metaXmatch(M, T, T', CD, 0, unbounded, J)))
                 fi
                 procMatch3(M, T, T', CD, 'xmatch, I, J + 1))
           else ('\n '\n 'No 'more 'solutions.)
           fi
      else nil
      fi .

  *** UNIFY 
  
  ceq procUnify(ME, M, T, D, VDS, DB)
    *** D is a bound on the number of solutions
    = if solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)
           :: Tuple<Term|Module|Bool|OpDeclSet|Bound|Database>
      then procUnify2(
             getModule(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)),
             parseUnify(
               getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)), 
               getVars(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))), 
             getBound(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)))
      else getMsg(getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)))
                ----('\r 'Error: '\o 'Incorrect 'match 'command. '\n)
      fi
    if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) .

  eq addInfoUnify(M) 
    = addOps(op '_/\_ : '@UnificationProblem@ '@UnificationProblem@ -> '@UnificationProblem@ 
                               [ctor assoc prec(73)] .
             op '_=?_  : 'Universal 'Universal -> '@UnificationProblem@ 
                               [ctor poly(1 2) prec(71)] .,
        addSorts('@UnificationProblem@, M)) .

  eq parseUnify('_/\_[T, T'], VDS) = parseUnify(T, VDS) /\ parseUnify(T', VDS) .
  eq parseUnify('_=?_[T, T'], VDS) = constsToVars(T, VDS) =? constsToVars(T', VDS) .

  ceq procUnify2(M, UP, D)
    = if UP? :: UnificationPair?
      then ('unify 
            if D == unbounded then nil else '\s '`[ qid(string(D, 10)) '`] '\s fi 
            'in eMetaPrettyPrint(getName(M)) ':
            eMetaPrettyPrint(M, UP)
            if UP? == noUnifier
            then '\n 'No 'unifier
            else procUnify3Aux(M, UP?, 0)
                 procUnify3(M, UP, D, 1)
            fi)
      else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'unify 'command. '\n 
      fi 
    if UP? := metaUnify(M, UP, 0, 0) .
  eq procUnify2(M?, UP??:[UnificationProblem], D?) = getMsg(M?) [owise] .
    
  eq eMetaPrettyPrint(M, T =? T')
    = eMetaPrettyPrint(M, T) '\s '=? '\s eMetaPrettyPrint(M, T') '. .
  eq eMetaPrettyPrint(M, T =? T' /\ UP)
    = eMetaPrettyPrint(M, T =? T') '\s '/\ '\s eMetaPrettyPrint(M, UP) '. .

  eq procUnify3Aux(M, {Sb, N}, I)
    = '\n '\n 'Solution qid(string(I + 1, 10))
      if Sb == none
      then '\n 'empty 'substitution
      else '\n eMetaPrettyPrint(M, Sb)
      fi .

  eq procUnify3(M, UP, D, I)
    = if D == unbounded or-else I < D 
      then if metaUnify(M, UP, 0, I) :: UnificationPair
           then (procUnify3Aux(M, metaUnify(M, UP, 0, I), I)
                 procUnify3(M, UP, D, I + 1))
           else ('\n '\n 'No 'more 'solutions.)
           fi
      else nil
      fi .
      
  ceq solveBubblesUnify(M, 'bubble[T], VDS)
    = if metaParse(M, QIL, '@UnificationProblem@) :: ResultPair
      then parseUnify(getTerm(metaParse(M, QIL, '@UnificationProblem@)), VDS)
      else unificationProblemError('\r 'Warning: '\o 
             printSyntaxError(metaParse(M, QIL, '@UnificationProblem@), QIL) '\n)
      fi 
    if QIL := downQidList(T) .

  eq solveBubblesRewUnify('bubble[QI], M, B, D, VDS, DB) 
    = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term
      then {solveBubbles('bubble[QI], M, B, VDS, DB), M, B, VDS, unbounded, DB}
      else tuple<Term|Module|Bool|OpDeclSet|Bound|Database>Error(
             '\r 'Error: '\o 'no 'parsing 'for downQidList(QI) '\n)
      fi .
  eq solveBubblesRewUnify('bubble['__[TL]], M, B, D, VDS, DB) 
    = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term
      then {solveBubbles('bubble['__[TL]], M, B, VDS, DB), M, B, VDS, unbounded, DB}
      else if metaParse(GRAMMAR-REW, downQidList('__[TL, ''..Qid]), '@RewNuPart@)
                :: ResultPair
           then solveBubblesRewUnify2(
                  getTerm(
                    metaParse(GRAMMAR-REW, downQidList('__[TL, ''..Qid]), 
                      '@RewNuPart@)), 
                  M, B, VDS, DB) 
           else {getTerm(solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB)), 
                 getModule(solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB)), 
                 getBool(solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB)), 
                 getVars(solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB)),
                 unbounded, 
                 getDatabase(solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB))}
           fi
      fi .

  eq solveBubblesRewUnify2('`[_`]_.['token[T], T'], M, B, VDS, DB) 
    = if downNat(downMetaNat(T)) :: Nat
         and-then solveBubblesRedUnify(T', M, B, VDS, DB) 
                    :: Tuple<Term|Module|Bool|OpDeclSet|Database>
      then {getTerm(solveBubblesRedUnify(T', M, B, VDS, DB)), 
            getModule(solveBubblesRedUnify(T', M, B, VDS, DB)),
            getBool(solveBubblesRedUnify(T', M, B, VDS, DB)),
            getVars(solveBubblesRedUnify(T', M, B, VDS, DB)),
            downNat(downMetaNat(T)),
            getDatabase(solveBubblesRedUnify(T', M, B, VDS, DB))}
      else tuple<Term|Module|Bool|OpDeclSet|Bound|Database>Error(
             '\r 'Error: '\o 'Incorrect 'command. '\n)
      fi .

  ceq solveBubblesRedUnify('bubble[QI], M, B, VDS, DB) 
    = if T? :: Term
      then {T?, M, B, VDS, DB}
      else tuple<Term|Module|Bool|OpDeclSet|Database>Error(
             '\r 'Error: '\o 'no 'parse 'for downQidList(QI) '\n)
      fi 
    if T? := solveBubbles('bubble[QI], M, B, VDS, DB) .
  ceq solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB) 
    = if T? :: Term
      then {T?, M, B, VDS, DB}
      else if metaParse(GRAMMAR-RED, 
                downQidList('__[TL, ''..Qid]), '@RedInPart@)
                :: ResultPair
           then solveBubblesRedUnify2(
                  getTerm(
                    metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), 
                      '@RedInPart@)), 
                  DB) 
           else tuple<Term|Module|Bool|OpDeclSet|Database>Error('\r 'Warning: '\o 
                      printSyntaxError(
                        metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), 
                        '@RedInPart@), downQidList('__[TL, ''..Qid])) '\n
                      '\r 'Error: '\o 
                      'no 'parse 'for downQidList('__[TL, ''..Qid]) '\n)
           fi
      fi 
    if T? := solveBubbles('bubble['__[TL]], M, B, VDS, DB) .
  *** There is some problem parsing 'in_:_ in solveBubblesRed, but it 
  *** seems to work with the additional '.

  ceq solveBubblesRedUnify2('in_:_.[T, T'], DB) 
    = if unitInDb(ME, DB')
      then solveBubblesRed3(T', addInfoUnify(getFlatModule(ME, DB')), ME, getVars(ME, DB'), DB')
      else tuple<Term|Module|Bool|OpDeclSet|Database>Error('\r 'Error: '\o 
             'The 'module eMetaPrettyPrint(ME) 'is 'not 'in 'the 'database '. '\n)
      fi 
    if < DB' ; ME > := evalModExp(parseModExp(T), DB) .
  eq solveBubblesRedUnify2('in_:_.[T, T'], DB) 
    = tuple<Term|Module|Bool|OpDeclSet|Database>Error('\r 'Error: '\o 
      'It 'isn't 'possible 'to 'compile eMetaPrettyPrint(parseModExp(T)) '. '\n)
    [owise] .

  *** ID-UNIFY 
  
  ceq procIdUnify(ME, M, T, D, VDS, DB)
    *** D is a bound on the number of solutions
    = if solveBubblesRewUnify(T, addInfoIdUnify(M), B, D, VDS, DB)
           :: Tuple<Term|Module|Bool|OpDeclSet|Bound|Database>
      then procIdUnify2(
             getModule(solveBubblesRewUnify(T, addInfoIdUnify(M), B, D, VDS, DB)),
             parseIdUnify(
               getTerm(solveBubblesRewUnify(T, addInfoIdUnify(M), B, D, VDS, DB)), 
               getVars(solveBubblesRewUnify(T, addInfoIdUnify(M), B, D, VDS, DB))), 
             getBound(solveBubblesRewUnify(T, addInfoIdUnify(M), B, D, VDS, DB)))
      else getMsg(getTerm(solveBubblesRewUnify(T, addInfoIdUnify(M), B, D, VDS, DB)))
                ----('\r 'Error: '\o 'Incorrect 'match 'command. '\n)
      fi
    if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) .

  eq addInfoIdUnify(M) 
    = addOps(---op '_/\_ : '@UnificationProblem@ '@UnificationProblem@ -> '@UnificationProblem@ 
             ---                  [ctor assoc prec(73)] .
             op '_=?_  : 'Universal 'Universal -> '@UnificationProblem@ 
                               [ctor poly(1 2) prec(71)] .,
        addSorts('@UnificationProblem@, M)) .

---  eq parseIdUnify('_/\_[T, T'], VDS) = parseUnify(T, VDS) /\ parseUnify(T', VDS) .
  eq parseIdUnify('_=?_[T, T'], VDS) = constsToVars(T, VDS) =? constsToVars(T', VDS) .

  ceq procIdUnify2(M, T =? T', D)
    = if X:[SubstitutionSet] :: SubstitutionSet
      then ('id-unify 
            if D == unbounded then nil else '\s '`[ qid(string(D, 10)) '`] '\s fi 
            'in eMetaPrettyPrint(getName(M)) ':
            eMetaPrettyPrint(M, T =? T')
            if X:[SubstitutionSet] == empty
            then '\n 'No 'unifier
            else procIdUnify3(M, T =? T', 0, X:[SubstitutionSet])
            fi)
      else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'id-unify 'command. '\n 
      fi 
    if X:[SubstitutionSet] := metaACUUnify(M, T, T') .
  eq procIdUnify2(M?, UP??:[UnificationProblem], D?) = getMsg(M?) [owise] .
    
  eq procIdUnify3(M, UP, I, empty)
   = ('\n '\n 'No 'more 'solutions.) .
  eq procIdUnify3(M, UP, I, S:Substitution | SS:SubstitutionSet)
   = '\n '\n 'Solution qid(string(I + 1, 10))
      if S:Substitution == none
      then '\n 'empty 'substitution
      else '\n eMetaPrettyPrint(M, S:Substitution)
      fi
     procIdUnify3(M, UP, I + 1, SS:SubstitutionSet) .
      
endfm

---- no assoc without comm is assumed

----load check-input-module.maude

---- Input modules are assumed not to have:
---- - idem
---- - assoc without comm
---- - variable alone in lhs
---- - owise
---- - iter
---- - built-ins
---- - something else? 

fmod CHECK-INPUT-MODULE is
  inc EXT-DECL .
  inc MODULE-HANDLING .
  
  op checkModule : Module -> Bool .
  ops checkNonValidAttrs checkAssocWithoutComm : OpDeclSet -> Bool .
  op checkSingleVbleInLHS : RuleSet -> Bool .
  op checkSingleVbleInLHS : EquationSet -> Bool .
  
  var  M : Module .
  var  F : Qid .
  var  TpL : TypeList .
  var  Tp : Type .
  var  AtS : AttrSet .
  var  ODS : OpDeclSet .
  var  V : Variable .
  var  RlS : RuleSet .
  var  EqS : EquationSet .
  var  RHS : Term .
  var  Cond : Condition .
  
  eq checkModule(M)
    = checkNonValidAttrs(getOps(M))
      and-then checkAssocWithoutComm(getOps(M))
      and-then checkSingleVbleInLHS(getRls(M))
      and-then checkSingleVbleInLHS(getEqs(M)) .
  
  eq checkNonValidAttrs(op F : TpL -> Tp [idem AtS] . ODS) = false .
  eq checkNonValidAttrs(op F : TpL -> Tp [iter AtS] . ODS) = false .
  eq checkNonValidAttrs(op F : TpL -> Tp [owise AtS] . ODS) = false .
  eq checkNonValidAttrs(ODS) = true [owise] .
  
  eq checkAssocWithoutComm(op F : TpL -> Tp [assoc AtS] . ODS) 
    = comm in AtS and-then checkAssocWithoutComm(ODS) .
  eq checkAssocWithoutComm(ODS) = true [owise] .
  
  eq checkSingleVbleInLHS(rl V => RHS [AtS] . RlS) = false .
  eq checkSingleVbleInLHS(crl V => RHS if Cond [AtS] . RlS) = false .
  eq checkSingleVbleInLHS(RlS) = true [owise] .

  eq checkSingleVbleInLHS(eq V = RHS [AtS] . EqS) = false .
  eq checkSingleVbleInLHS(ceq V = RHS if Cond [AtS] . EqS) = false .
  eq checkSingleVbleInLHS(EqS) = true [owise] .
endfm

----load term-variants.maude

mod MODULE-VARIANTS is 
  inc CHECK-INPUT-MODULE .
  ----inc SUBSTITUTION-HANDLING .
  inc META-NARROWING-SEARCH .
  inc UNIT .
  inc MODULE-HANDLING .
  ----inc TERM-VARIANTS .
  ----inc FULL-MAUDE .

  vars V W : Variable .
  var  C : Constant .
  var  M : Module .
  var  N : Nat .
  vars T T' T'' LHS RHS : Term .
  vars Subst Subst' : Substitution .
  var  F : Qid .
  var  TL : TermList .
  var  AtS : AttrSet .
  var  VFS : VariantFourSet .
  vars Tp Tp' Tp'' : Type .
  var  TpL : TypeList .
  var  Rl : Rule .
  var  RlS : RuleSet .
  var  Eq : Equation .
  var  EqS : EquationSet .
  var  ODS : OpDeclSet .
  var  Cond : Condition .
  var  S : Sort .

  ------------------------------------------------------------------------------
  ---- Given a module \mathcal{R} = (\Sigma, E, R) 
  ---- getVariants(\mathcal{R}) = getVariants((\widehat{\Sigma}, B, \widetilde{U}), R)
  ---- where 
  ---- - \widehat{\Sigma} is obtained by 
  ----   - adding to $\Sigma$ a fresh new sort [Tuple] and 
  ----   - a tupling operator <_,...,_> : [s] [s_1] ... [s_n] -> [Tuple]
  ----     for each rule l -> r if u_1 -> v_1 /\ ... /\ u_n -> v_n in R, 
  ----     where l has sort s and v_i has sort s_i, 1 <= i <= n,
  ---- - B_f = E_f \cap {A_f, C_f} 
  ---- - U_f = E_f \cap {LU_f, RU_f}, 
  ----   with LU_f and RU_f rewrite rules f(e,x) -> x and f(x,e) -> x, and 
  ----   where \widetilde{U} is the B-coherence completion of U, 
  ----   which is described as \widetilde{U} = \bigcup_{f:[s_1]...[s_n] -> [s] \in \Sigma} \widetilde{U}_f.
  ----   If A_f \not \in B_f, or A_f, C_f \in B_f, then \widetilde{U}_f = U_f.
  ----   Otherwise, if A_f \in B_f, but C_f \not \in B_f, then, 
  ----     if LU_f \in U_f, then we add the rule f(x,f(e,y)) -> f(x,y) and 
  ----     if RU_f \in U_f, then we add the rule f(f(x,e'),y) -> f(x,y).
  ---- makeIdsModule computes (\widehat{\Sigma}, B, \widetilde{U})
  ------------------------------------------------------------------------------
  
  op getVariants : Module ~> Module . 
  ---- given a module returns an equivalent module without ids but with variants of eqs and rls
  op getVariants : Module RuleSet -> RuleSet .
  ---- given a (\widehat{\Sigma}, B, \widetilde{U}) returns the variants of the given set of rules
  op getVariants : Module EquationSet -> EquationSet .
  ---- given a (\widehat{\Sigma}, B, \widetilde{U}) returns the variants of the given set of equations
  op getVariants : Module Term -> VariantFourSet .
  ---- given a (\widehat{\Sigma}, B, \widetilde{U}) returns the variants of a term (a tuple)
  op getRlVariants : VariantFourSet Term Condition AttrSet -> RuleSet .
  ---- given the variants of a tuple < LHS, target terms in condition >, a RHS, a condition, and an attribute set,
  ---- it constructs the corresponding variant rules
  op getEqVariants : VariantFourSet Term Condition AttrSet -> EquationSet .
  ---- given the variants of a tuple < LHS, target terms in condition >, a RHS, a condition, and an attribute set,
  ---- it constructs the corresponding variant equations
  
  eq getVariants(M) 
    = if checkModule(M)
      then setRls(
             setEqs(M,
                getVariants(makeIdsModule(M), getEqs(M))),
             (idRls(M, getOps(M)) getVariants(makeIdsModule(M), getRls(M)))) 
      else unitError('The 'module 'contains 'non-supported 'features '`(owise`, 'idem`, 'assoc 'without 'comm`, 'single 'variable 'in 'lhs`, '... '`)) 
      fi .
  
  eq getVariants(M, Rl RlS) 
    = getRlVariants(getVariants(M, makeTuple(lhs(Rl), cond(Rl))), rhs(Rl), cond(Rl), atts(Rl)) 
      getVariants(M, RlS) .
  eq getVariants(M, (none).RuleSet) = none .
    
  eq getVariants(M, Eq EqS) 
    = getEqVariants(getVariants(M, makeTuple(lhs(Eq), cond(Eq))), rhs(Eq), cond(Eq), atts(Eq)) 
      getVariants(M, EqS) .
  eq getVariants(M, (none).EquationSet) = none .
    
  eq getVariants(M, T) = getVariants(M, T, 1, irreducible ACUnify) .
  
  eq getRlVariants({'<_>[T], Subst, Subst', N} | VFS, T', nil, AtS)
    = (rl T => _<<_(T', Subst) [AtS] .)
      getRlVariants(VFS, T', nil, AtS) .
  eq getRlVariants({F[T, TL], Subst, Subst', N} | VFS, T', Cond, AtS)
    = (crl T => _<<_(T', Subst) if makeCond(TL, Cond, Subst) [AtS] .)
      getRlVariants(VFS, T', nil, AtS) .
  eq getRlVariants(empty, T', Cond, AtS) = none .

  eq getEqVariants({'<_>[T], Subst, Subst', N} | VFS, T', nil, AtS)
    = (eq T = _<<_(T', Subst) [AtS] .)
      getEqVariants(VFS, T', nil, AtS) .
  eq getEqVariants({F[T, TL], Subst, Subst', N} | VFS, T', Cond, AtS)
    = (ceq T = _<<_(T', Subst) if makeCond(TL, Cond, Subst) [AtS] .)
      getEqVariants(VFS, T', nil, AtS) .
  eq getEqVariants(empty, T', Cond, AtS) = none .

  ------------------------------------------------------------------------------

  op makeTuple : Term Condition -> Term .
  op tupleTermList : Condition -> TermList .
  eq makeTuple(T, Cond) 
    = if Cond == nil
      then qid("<_>")[T]
      else qid("<_" + tupleId(Cond) + ">")[T, tupleTermList(Cond)]
      fi .
  eq tupleTermList(T' => T'' /\ Cond) = (T'', tupleTermList(Cond)) . 
  eq tupleTermList(T' = T'' /\ Cond) = tupleTermList(Cond) . 
  eq tupleTermList(T' : S /\ Cond) = tupleTermList(Cond) . 
  eq tupleTermList(T' := T'' /\ Cond) = (T', tupleTermList(Cond)) . 
  eq tupleTermList(nil) = empty .

  op makeCond : TermList Condition Substitution -> Condition .
  eq makeCond((T, TL), T' => T'' /\ Cond, Subst)
    = (T' << Subst) => T /\ makeCond(TL, Cond, Subst) .
  eq makeCond((T, TL), T' := T'' /\ Cond, Subst)
    = T := (T'' << Subst) /\ makeCond(TL, Cond, Subst) .
  eq makeCond(TL, T' = T'' /\ Cond, Subst)
    = (T' << Subst) = (T'' << Subst) /\ makeCond(TL, Cond, Subst) .
  eq makeCond(TL, T' : S /\ Cond, Subst)
    = (T' << Subst) : S /\ makeCond(TL, Cond, Subst) .
  eq makeCond(empty, nil, Subst) = nil .
    
  ------------------------------------------------------------------------------
  ---- makeIdsModule((\Sigma, E, R)) computes (\widehat{\Sigma}, B, \widetilde{U})
  ------------------------------------------------------------------------------
  op makeIdsModule : Module -> Module .
  eq makeIdsModule(M) 
    = setEqs(
        setOps(
          addSorts('Tuple, 
            setRls(M, none)),
          (tuplingOps(M, getEqs(M), getRls(M))
           removeIds(getOps(M)))),
        idEqs(M, getOps(M))) .
  
  op idEqs : Module OpDeclSet -> EquationSet .
  eq idEqs(M, op F : Tp Tp' -> Tp'' [left-id(T) AtS] . ODS)
    = (eq F[T, qid("X:" + string(getKind(M, Tp)))] = qid("X:" + string(getKind(M, Tp))) [none] .)
      if assoc in AtS and not comm in AtS 
      then (eq F[qid("X:" + string(getKind(M, Tp))), F[T, qid("Y:" + string(getKind(M, Tp)))]] 
              = F[qid("X:" + string(getKind(M, Tp))), qid("Y:" + string(getKind(M, Tp)))] 
              [none] .)
      else none 
      fi
      idEqs(M, ODS) . 
  eq idEqs(M, op F : Tp Tp' -> Tp'' [right-id(T) AtS] . ODS)
    = (eq F[qid("X:" + string(getKind(M, Tp))), T] = qid("X:" + string(getKind(M, Tp))) [none] .)
      if assoc in AtS and not comm in AtS 
      then (eq F[F[qid("X:" + string(getKind(M, Tp))), T], qid("Y:" + string(getKind(M, Tp)))] 
              = F[qid("X:" + string(getKind(M, Tp))), qid("Y:" + string(getKind(M, Tp)))] 
              [none] .)
      else none 
      fi
      idEqs(M, ODS) . 
  eq idEqs(M, op F : Tp Tp' -> Tp'' [id(T) AtS] . ODS)
    = (eq F[T, qid("X:" + string(getKind(M, Tp)))] = qid("X:" + string(getKind(M, Tp))) [none] .)
      (eq F[qid("X:" + string(getKind(M, Tp))), T] = qid("X:" + string(getKind(M, Tp))) [none] .)
      if assoc in AtS and not comm in AtS 
      then (eq F[qid("X:" + string(getKind(M, Tp))), F[T, qid("Y:" + string(getKind(M, Tp)))]] 
              = F[qid("X:" + string(getKind(M, Tp))), qid("Y:" + string(getKind(M, Tp)))] 
              [none] .)
           (eq F[F[qid("X:" + string(getKind(M, Tp))), T], qid("Y:" + string(getKind(M, Tp)))] 
              = F[qid("X:" + string(getKind(M, Tp))), qid("Y:" + string(getKind(M, Tp)))] 
              [none] .)
      else none 
      fi
      idEqs(M, ODS) . 
  eq idEqs(M, ODS) = none [owise] . 

  op idRls : Module OpDeclSet -> RuleSet .
  eq idRls(M, op F : Tp Tp' -> Tp'' [left-id(T) AtS] . ODS)
    = (rl F[T, qid("X:" + string(getKind(M, Tp)))] => qid("X:" + string(getKind(M, Tp))) [none] .)
      idRls(M, ODS) . 
  eq idRls(M, op F : Tp Tp' -> Tp'' [right-id(T) AtS] . ODS)
    = (rl F[qid("X:" + string(getKind(M, Tp))), T] => qid("X:" + string(getKind(M, Tp))) [none] .)
      idRls(M, ODS) . 
  eq idRls(M, op F : Tp Tp' -> Tp'' [id(T) AtS] . ODS)
    = (rl F[T, qid("X:" + string(getKind(M, Tp)))] => qid("X:" + string(getKind(M, Tp))) [none] .)
      if comm in AtS 
      then none
      else (rl F[qid("X:" + string(getKind(M, Tp))), T] => qid("X:" + string(getKind(M, Tp))) [none] .)
      fi
      idRls(M, ODS) . 
  eq idRls(M, ODS) = none [owise] . 

  op removeIds : OpDeclSet -> OpDeclSet .
  eq removeIds(op F : TpL -> Tp [id(T) AtS] . ODS)
    = (op F : TpL -> Tp [AtS] .) removeIds(ODS) .
  eq removeIds(op F : TpL -> Tp [left-id(T) AtS] . ODS)
    = (op F : TpL -> Tp [AtS] .) removeIds(ODS) .
  eq removeIds(op F : TpL -> Tp [right-id(T) AtS] . ODS)
    = (op F : TpL -> Tp [AtS] .) removeIds(ODS) .
  eq removeIds(op F : TpL -> Tp [AtS] . ODS)
    = (op F : TpL -> Tp [AtS] .) removeIds(ODS)
    [owise] .
  eq removeIds(none) = none .
  
  op tuplingOps : Module EquationSet RuleSet -> OpDeclSet .
  op tuplingOps : Module EquationSet -> OpDeclSet .
  op tuplingOps : Module RuleSet -> OpDeclSet .
  eq tuplingOps(M, EqS, RlS) = tuplingOps(M, EqS) tuplingOps(M, RlS) .
  eq tuplingOps(M, eq LHS = RHS [AtS] . EqS)
    = (op qid("<_>") : getKind(M, leastSort(M, LHS)) -> '`[Tuple`] [none] .)
      tuplingOps(M, EqS) .
  eq tuplingOps(M, ceq LHS = RHS if Cond [AtS] . EqS)
    = (op qid("<_" + tupleId(Cond) + ">") : getKind(M, leastSort(M, LHS)) arityCond(M, Cond) -> '`[Tuple`] [none] .)
      tuplingOps(M, EqS) .
  eq tuplingOps(M, (none).EquationSet) = none .
  eq tuplingOps(M, rl LHS => RHS [AtS] . RlS)
    = (op qid("<_>") : getKind(M, leastSort(M, LHS)) -> '`[Tuple`] [none] .)
      tuplingOps(M, RlS) .
  eq tuplingOps(M, crl LHS => RHS if Cond [AtS] . RlS)
    = (op qid("<_" + tupleId(Cond) + ">") : getKind(M, leastSort(M, LHS)) arityCond(M, Cond) -> '`[Tuple`] [none] .)
      tuplingOps(M, RlS) .
  eq tuplingOps(M, (none).RuleSet) = none .
  
  op arityCond : Module Condition -> TypeList .
  eq arityCond(M, T => T' /\ Cond) = getKind(M, leastSort(M, T')) arityCond(M, Cond) .
  eq arityCond(M, T := T' /\ Cond) = getKind(M, leastSort(M, T)) arityCond(M, Cond) .
  eq arityCond(M, T = T' /\ Cond) = arityCond(M, Cond) .
  eq arityCond(M, T : S /\ Cond) = arityCond(M, Cond) .
  eq arityCond(M, nil) = nil .
  
  op tupleId : Condition -> String .
  eq tupleId(T => T' /\ Cond) = ",_" + tupleId(Cond) .
  eq tupleId(T := T' /\ Cond) = ",_" + tupleId(Cond) .
  eq tupleId(T = T' /\ Cond) = tupleId(Cond) .
  eq tupleId(T : S /\ Cond) = tupleId(Cond) .
  eq tupleId(Cond) = "" .

endm


*******************************************************************************

***
*** Interaction with the Persistent Database
***

*** In the case of Full Maude, the persistent state of the system is given by
*** a single object which maintains the database of the system. This object
*** has an attribute \texttt{db}, to keep the actual database in which all the
*** modules being entered are stored, an attribute \texttt{default}, to keep
*** the identifier of the current module by default, and attributes
*** \texttt{input} and \texttt{output} to simplify the communication of the
*** read-eval-print loop given by the \texttt{LOOP-MODE} module with the
*** database. Using the notation for classes in object-oriented modules (see 
*** Section~\ref{object-oriented-modules}) we can declare the class 
*** \texttt{database} as follows:
*** 
***   class database | db : Database, input : TermList, 
***                    output : QidList, default : ModId .
*** 
*** Since we assume that \texttt{database} is the only object class that has
*** been defined---so that the only objects of sort \texttt{Object} will
*** belong to the \texttt{database} class---to specify the admissible states
*** in the persistent state of \texttt{LOOP-MODE} for Full Maude, it is enough 
*** to give the subsort declaration
*** 
***   subsort Object < State .

*** 
*** \subsection{The \texttt{CONFIGURATION+} Module}
*** 

*** change (2/20/2002): CONFIGURATION is now part of the prelude
***
*** fmod CONFIGURATION is
***   sort Oid Cid Attribute AttributeSet Configuration Object Msg .
*** 
***   subsort Attribute < AttributeSet .
***   subsorts Object Msg < Configuration .
*** 
***   op none : -> AttributeSet .
***   op _,_ : AttributeSet AttributeSet -> AttributeSet 
***       [assoc comm id: none] .
***   op none : -> Configuration .
***   op __ : Configuration Configuration -> Configuration 
***       [assoc comm id: none] .
***   op <_:_|_> : Oid Cid AttributeSet -> Object .
***   op <_:_| > : Oid Cid -> Object .
*** 
***   var O : Oid .
***   var C : Cid .
*** 
***   eq < O : C | > = < O : C | none > .
*** endfm

*******************************************************************************

***
*** Top Level Handling of the Persistent Database
***

*** Note that, since the Full Maude specification is given as a system module
***Core Maude, object-oriented declarations cannot be given directly.
*** Instead, the equivalent declarations desugaring the desired
*** object-oriented declarations have to be specified. We use also the same
*** conventions discussed in Section~\ref{omod2mod} regarding the use of
*** variables instead of class names in the objects and in the addition of
*** variables of sort \texttt{AttributeSet} to range over the additional 
*** attributes. As we shall see in Chapter~\ref{crc}, this convention will 
*** allow us to extend the Full Maude system in a very simple and clean way.

*** To allow the use of the object-oriented notation the predefined module
*** \texttt{CONFIGURATION}, presented in Section~\ref{omod2mod}, is included
*** in the following module \texttt{DATABASE-HANDLING}.


mod DATABASE-HANDLING is
  inc META-LEVEL .
  inc CONFIGURATION .
  pr VIEW-META-PRETTY-PRINT .
  pr VIEW-PROCESSING .
  pr COMMAND-PROCESSING .
  pr PREDEF-UNITS .
  pr MODULE-VARIANTS .

  var  F : Qid .
  var  QIL : QidList .
  var  NQIL NQIL' NQIL'' : NeQidList .
  vars T T' T'' T3 : Term .
  var  TL : TermList .
  var  DB DB' : Database .
  vars ME ME' ME'' : ModuleExpression .
  vars QIL' QIL'' : QidList .
  vars MNS MNS' MNS'' MNS3 MNS4 : Set{ModuleName} .
  var  VE : ViewExp .
  var  VES : Set{ViewExp} .
  vars MIS MIS' : Set{ModuleInfo} .
  var  VIS : Set{ViewInfo} .
  vars PDS PDS' : Set{ParameterDecl} .
  var  B : Bool .
  var  I : Import .
  var  IL : ImportList .
  var  MN : ModuleName .

  op initialDatabase : -> Database .
  eq initialDatabase
    = insTermModule('META-MODULE, 
        addOps(getOps(#UP#),
          addSorts(getSorts(#UP#), 
            addImports(getImports(#UP#), upModule('META-MODULE, false)))),
      insertTermView('TRIV,
        ('view_from_to_is_endv['token[''TRIV.Qid],'token[''TRIV.Qid],'token[
         ''TRIV.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
         ''Elt.Qid]]]),
      insertTermView('Bool,
        ('view_from_to_is_endv['token[''Bool.Qid],'token[''TRIV.Qid],'token[
         ''BOOL.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Bool.Qid]]]),
      insertTermView('Nat,
        ('view_from_to_is_endv['token[''Nat.Qid],'token[''TRIV.Qid],'token[
         ''NAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Nat.Qid]]]),
      insertTermView('Int,
        ('view_from_to_is_endv['token[''Int.Qid],'token[''TRIV.Qid],'token[
         ''INT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Int.Qid]]]),
      insertTermView('Rat,
        ('view_from_to_is_endv['token[''Rat.Qid],'token[''TRIV.Qid],'token[
         ''RAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Rat.Qid]]]),
      insertTermView('Float,
        ('view_from_to_is_endv['token[''Float.Qid],'token[''TRIV.Qid],'token[
         ''FLOAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
         ''Float.Qid]]]),
      insertTermView('String,
        ('view_from_to_is_endv['token[''String.Qid],'token[''TRIV.Qid],'token[
         ''STRING.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
         ''String.Qid]]]),
      insertTermView('Qid,
        ('view_from_to_is_endv['token[''Qid.Qid],'token[''TRIV.Qid],'token[
         ''QID.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Qid.Qid]]]),
      insertTermView('STRICT-WEAK-ORDER,
        ('view_from_to_is_endv['token[''STRICT-WEAK-ORDER.Qid],'token[''TRIV.Qid],
         'token[''STRICT-WEAK-ORDER.Qid],'sort_to_.['sortToken[''Elt.Qid],
         'sortToken[''Elt.Qid]]]),
      insertTermView('STRICT-TOTAL-ORDER,
        ('view_from_to_is_endv['token[''STRICT-TOTAL-ORDER.Qid],
         'token[''STRICT-WEAK-ORDER.Qid],'token[''STRICT-TOTAL-ORDER.Qid],
         'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Elt.Qid]]]),
      insertTermView('Nat<,
        ('view_from_to_is_endv['token[''Nat<.Qid],'token[''STRICT-TOTAL-ORDER.Qid],
         'token[''NAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Nat.Qid]]]),
      insertTermView('Int<,
        ('view_from_to_is_endv['token[''Int<.Qid],'token[''STRICT-TOTAL-ORDER.Qid],
         'token[''INT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Int.Qid]]]),
      insertTermView('Rat<,
        ('view_from_to_is_endv['token[''Rat<.Qid],'token[''STRICT-TOTAL-ORDER.Qid],'token[
         ''RAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Rat.Qid]]]),
      insertTermView('Float<,
        ('view_from_to_is_endv['token[''Float<.Qid],'token[''STRICT-TOTAL-ORDER.Qid],
         'token[''FLOAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
         ''Float.Qid]]]),
      insertTermView('String<,
        ('view_from_to_is_endv['token[''String<.Qid],'token[''STRICT-TOTAL-ORDER.Qid],
         'token[''STRING.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
         ''String.Qid]]]),
      insertTermView('TOTAL-PREORDER,
        ('view_from_to_is_endv['token[''TOTAL-PREORDER.Qid],'token[''TRIV.Qid],'token[
         ''TOTAL-PREORDER.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
         ''Elt.Qid]]]),
      insertTermView('TOTAL-ORDER,
        ('view_from_to_is_endv['token[''TOTAL-ORDER.Qid],'token[''TOTAL-PREORDER.Qid],
         'token[''TOTAL-ORDER.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
         ''Elt.Qid]]]),
      insertTermView('Nat<=,
        ('view_from_to_is_endv['token[''Nat<=.Qid],'token[''STRICT-TOTAL-ORDER.Qid],
         'token[''NAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Nat.Qid]]]),
      insertTermView('Int<=,
        ('view_from_to_is_endv['token[''Int<=.Qid],'token[''STRICT-TOTAL-ORDER.Qid],
         'token[''INT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Int.Qid]]]),
      insertTermView('Rat<=,
        ('view_from_to_is_endv['token[''Rat<=.Qid],'token[''STRICT-TOTAL-ORDER.Qid],'token[
         ''RAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Rat.Qid]]]),
      insertTermView('Float<=,
        ('view_from_to_is_endv['token[''Float<=.Qid],'token[''STRICT-TOTAL-ORDER.Qid],
         'token[''FLOAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
         ''Float.Qid]]]),
      insertTermView('String<=,
        ('view_from_to_is_endv['token[''String<=.Qid],'token[''STRICT-TOTAL-ORDER.Qid],
         'token[''STRING.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
         ''String.Qid]]]),
      insertTermView('DEFAULT,
        ('view_from_to_is_endv['token[''DEFAULT.Qid],'token[''TRIV.Qid],'token[
         ''DEFAULT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
         ''Elt.Qid]]]),
      insertTermView('Nat0,
        ('view_from_to_is_endv['token[''Nat0.Qid],'token[''DEFAULT.Qid],'token[
         ''NAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Nat.Qid]]]),
      insertTermView('Int0,
        ('view_from_to_is_endv['token[''Int0.Qid],'token[''DEFAULT.Qid],'token[
         ''INT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Int.Qid]]]),
      insertTermView('Rat0,
        ('view_from_to_is_endv['token[''Rat0.Qid],'token[''DEFAULT.Qid],'token[
         ''RAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Rat.Qid]]]),
      insertTermView('Float0,
        ('view_from_to_is_endv['token[''Float0.Qid],'token[''DEFAULT.Qid],
         'token[''FLOAT.Qid],'__['sort_to_.['sortToken[''Elt.Qid],'sortToken[
         ''Float.Qid]], 'op_to`term_.['bubble[''0.Qid],'bubble[''0.0.Qid]]]]),
      insertTermView('String0,
        ('view_from_to_is_endv['token[''String0.Qid],'token[''DEFAULT.Qid],
         'token[''STRING.Qid],'__['sort_to_.['sortToken[''Elt.Qid],'sortToken[
         ''String.Qid]],'op_to`term_.['bubble[''0.Qid],'bubble[''"".Qid]]]]),
      insertTermView('Qid0,
        ('view_from_to_is_endv['token[''Qid0.Qid],'token[''DEFAULT.Qid],'token[
         ''QID.Qid],'__['sort_to_.['sortToken[''Elt.Qid],'sortToken[''Qid.Qid]],
         'op_to`term_.['bubble[''0.Qid],'bubble['''.Qid]]]]),
      emptyDatabase)))))))))))))))))))))))))))))) .

*** We start by introducing a subsort \texttt{DatabaseClass} of sort
*** \texttt{Cid}, the operator declarations necessary for representing objects
*** in class \texttt{DatabaseClass} as defined above, and variables to range
*** over subclasses of class \texttt{DatabaseClass} and over attributes.

  sort DatabaseClass .
  subsort DatabaseClass < Cid .
  op Database : -> DatabaseClass .
  op db :_ : Database -> Attribute .
  op input :_ : TermList -> Attribute .
  op output :_ : QidList -> Attribute .
  op default :_ : Header -> Attribute .

  var Atts : AttributeSet .
  var X@DatabaseClass : DatabaseClass .
  var O : Oid .

*** Next, we introduce an auxiliary function \texttt{parseHeader} to parse
*** names of user-defined modules, and a constant \texttt{nilTermList} of sort
*** \texttt{TermList}. Note that the name of a user-defined module must be a
*** single identifier (a token) or, for parameterized modules, its name---a 
*** single identifier---and its interface.

  op parseHeader : Term -> Qid .
  eq parseHeader('token[T]) = downQid(T) .
  ----eq parseHeader('_`(_`)['token[T], T']) = downQid(T) .
  eq parseHeader('_`{_`}['token[T], T']) = downQid(T) .

  op nilTermList : -> TermList .

*** Finally, we present the rules processing the inputs of the database. These
*** rules define the behavior of the system for the different commands,
*** modules, theories, and views entered into the system. For example, the
*** first rule processes the different types of modules entered to the system.
*** Note that the operators declared as constructors of sort \texttt{PreModule}
*** in the signature of Full Maude, given in
*** Appendix~\ref{signature-full-maude}, are declared with two arguments, 
*** namely the name of the unit, or its name + its interface, and the list 
*** of declarations of such a unit.

  crl [module] :
     < O : X@DatabaseClass | db : DB, input : (F[T, T']), output : nil, default : ME, Atts >
     => < O : X@DatabaseClass | 
           db : procModule(F[T, T'], DB), input : nilTermList, 
           output : ('Introduced 'module header2Qid(parseHeader(T)) '\n),
           default : parseHeader(T), Atts > 
     if  (F == 'fmod_is_endfm) or-else 
        ((F == 'obj_is_endo)   or-else 
        ((F == 'obj_is_jbo)    or-else 
        ((F == 'mod_is_endm)   or-else 
         (F == 'omod_is_endom)))) .

*** Notice the message placed in the output channel, and the change in the
*** current module by default, which is now the new module just processed.
*** Since the name of the module \texttt{T} can be complex---a parameterized
*** module---some extra parsing has to be performed by the auxiliary function
*** \texttt{parseHeader}. Similar rules are given for the processing of 
*** theories and views.

  crl [theory] :
     < O : X@DatabaseClass | db : DB, input : (F[T, T']), output : nil, default : ME, Atts >
     => < O : X@DatabaseClass | 
           db : procModule(F[T, T'], DB), input : nilTermList, 
           output : ('Introduced 'theory header2Qid(parseHeader(T)) '\n),
           default : parseHeader(T), Atts > 
     if  (F == 'fth_is_endfth) or-else 
        ((F == 'th_is_endth)   or-else 
         (F == 'oth_is_endoth)) .

  rl [view] :
     < O : X@DatabaseClass | db : DB, 
        input : ('view_from_to_is_endv[T, T', T'', T3]), 
        output : nil, default : ME, Atts >
     => < O : X@DatabaseClass | 
           db : procView('view_from_to_is_endv[T, T', T'', T3], DB),
           input : nilTermList, 
           output : ('Introduced 'view header2Qid(parseHeader(T)) '\n),
           default : ME, Atts > .

*** Commands are handled by rules as well. For example, the \texttt{down},
*** \texttt{reduce}, and \texttt{rewrite} commands are handled by the 
*** following rules.

  rl [down] :
     < O : X@DatabaseClass | db : DB, input : ('down_:_[T, T']), output : nil, default : ME, Atts >
     => < O : X@DatabaseClass | 
           db : getDatabase(procDownCommand('down_:_[T, T'], ME, DB)), 
           input : nilTermList, 
           output : getQidList(procDownCommand('down_:_[T, T'], ME, DB)), 
           default : ME, Atts > .

  crl [red/rew/frew] :
     < O : X@DatabaseClass | db : DB, input : (F[T]), output : QIL, default : ME, Atts >
     => < O : X@DatabaseClass | 
           db : getDatabase(procCommand(F[T], ME, DB)), 
           input : nilTermList, 
           output : getQidList(procCommand(F[T], ME, DB)), 
           default : ME, Atts > 
     if  (F == 'parse_.)    or-else 
        ((F == 'red_.)      or-else 
        ((F == 'reduce_.)   or-else 
        ((F == 'rew_.)      or-else 
        ((F == 'rewrite_.)  or-else 
        ((F == 'frew_.)     or-else  
        ((F == 'frewrite_.) or-else 
        ((F == 'unify_.) or-else 
         (F == 'id-unify_.)))))))) .

  crl [search] :
     < O : X@DatabaseClass | db : DB, input : (F[T, T']), output : QIL, default : ME, Atts >
     => < O : X@DatabaseClass | 
           db : getDatabase(procCommand(F[T, T'], ME, DB)), 
           input : nilTermList, 
           output : getQidList(procCommand(F[T, T'], ME, DB)), 
           default : ME, Atts > 
     if  (F == 'search_=>_.)  or-else 
        ((F == 'search_=>1_.) or-else 
        ((F == 'search_=>*_.) or-else 
        ((F == 'search_=>+_.) or-else  
        ((F == 'search_=>!_.) or-else
        ((F == 'search_~>_.)  or-else 
        ((F == 'search_~>1_.) or-else 
        ((F == 'search_~>*_.) or-else 
        ((F == 'search_~>+_.) or-else  
        ((F == 'search_~>!_.) or-else
        ((F == 'match_<=?_.)  or-else 
         (F == 'xmatch_<=?_.))))))))))) .

  rl [select] :
     < O : X@DatabaseClass | db : DB, input : ('select_.[T]), output : nil, default : ME, Atts >
     => < O : X@DatabaseClass | db : DB, input : nilTermList, output : nil, default : parseModExp(T), Atts > .

  rl [show-modules] :
     < O : X@DatabaseClass | db : DB, 
        input : ('show`modules`..@Command@), 
        output : nil, default : ME, Atts >
     => < O : X@DatabaseClass | db : DB, input : nilTermList, 
           output : showModules(DB), default : ME, Atts > .
  rl [show-views] :
     < O : X@DatabaseClass | db : DB, 
        input : ('show`views`..@Command@), 
        output : nil, default : ME, Atts >
     => < O : X@DatabaseClass | db : DB, input : nilTermList, 
           output : showViews(DB), default : ME, Atts >  .

*** The \texttt{show module} command, which prints the specified module, or
*** the current one if no module name is specified, is handled by the 
*** following rules.

  crl [show-module] :
    < O : X@DatabaseClass | db : DB, 
       input : ('show`module`..@Command@), 
       output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getTopModule(ME', DB')),
          default : ME', Atts > 
    if < DB' ; ME' > := evalModExp(ME, DB) .
  crl [show-module] :
    < O : X@DatabaseClass | db : DB, input : ('show`module_.[T]), output : nil, default : ME,   Atts >
    => < O : X@DatabaseClass | 
          db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME'', DB'), getTopModule(ME'', DB')),
          default : ME, Atts > 
    if < DB' ; ME'' > := evalModExp(parseModExp(T), DB) .

  crl [show-all] :
    < O : X@DatabaseClass | db : DB, input : ('show`all`..@Command@), 
       output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getFlatModule(ME', DB')),
          default : ME', Atts > 
    if < DB' ; ME' > := evalModExp(ME, DB) .
  crl [show-all] :
    < O : X@DatabaseClass | db : DB, input : ('show`all_.[T]), output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getFlatModule(ME', DB')),
          default : ME, Atts > 
    if ME'' := parseModExp(T) 
    /\ < DB' ; ME' > := evalModExp(ME'', DB) .

  crl [show-vars] :
    < O : X@DatabaseClass | db : DB, input : ('show`vars`..@Command@), 
       output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | db : DB', input : nilTermList, 
          output : eMetaPrettyPrintVars(getVars(ME', DB')),
          default : ME', Atts >  
    if DB' := database(evalModExp(ME, DB)) 
       /\ ME' := modExp(evalModExp(ME, DB)) .
  crl [show-vars] :
    < O : X@DatabaseClass | db : DB, input : ('show`vars_.[T]), 
       output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | db : DB', input : nilTermList, 
          output : eMetaPrettyPrintVars(getVars(ME', DB')),
          default : ME, Atts > 
    if ME'' := parseModExp(T) 
       /\ DB' := database(evalModExp(ME'', DB))
       /\ ME' := modExp(evalModExp(ME'', DB)) .

  crl [show-sorts] :
    < O : X@DatabaseClass | db : DB, input : ('show`sorts`..@Command@), output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getSorts(getFlatModule(ME', DB'))),
          default : ME', Atts >  
    if DB' := database(evalModExp(ME, DB)) 
       /\ ME' := modExp(evalModExp(ME, DB)) .
  crl [show-sorts] :
    < O : X@DatabaseClass | db : DB, input : ('show`sorts_.[T]), output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getSorts(getFlatModule(ME', DB'))),
          default : ME, Atts > 
    if ME'' := parseModExp(T) 
       /\ DB' := database(evalModExp(ME'', DB))
       /\ ME' := modExp(evalModExp(ME'', DB)) .

  crl [show-ops] :
    < O : X@DatabaseClass | db : DB, input : ('show`ops`..@Command@), output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getOps(getFlatModule(ME', DB'))),
          default : ME', Atts >  
    if DB' := database(evalModExp(ME, DB)) 
       /\ ME' := modExp(evalModExp(ME, DB)) .
  crl [show-ops] :
    < O : X@DatabaseClass | db : DB, input : ('show`ops_.[T]), output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getOps(getFlatModule(ME', DB'))),
          default : ME, Atts > 
    if ME'' := parseModExp(T) 
       /\ DB' := database(evalModExp(ME'', DB))
       /\ ME' := modExp(evalModExp(ME'', DB)) .

  crl [show-mbs] :
    < O : X@DatabaseClass | db : DB, input : ('show`mbs`..@Command@), output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getMbs(getFlatModule(ME', DB'))),
          default : ME', Atts >  
    if DB' := database(evalModExp(ME, DB)) 
       /\ ME' := modExp(evalModExp(ME, DB)) .
  crl [show-mbs] :
    < O : X@DatabaseClass | db : DB, input : ('show`mbs_.[T]), output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getMbs(getFlatModule(ME', DB'))),
          default : ME, Atts > 
    if ME := parseModExp(T) 
       /\ DB' := database(evalModExp(ME, DB))
       /\ ME' := modExp(evalModExp(ME, DB)) .

  crl [show-eqns] :
    < O : X@DatabaseClass | db : DB, input : ('show`eqs`..@Command@), output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | 
          db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getEqs(getFlatModule(ME', DB'))),
         default : ME', Atts >  
    if DB' := database(evalModExp(ME, DB)) 
       /\ ME' := modExp(evalModExp(ME, DB)) .
  crl [show-eqns] :
    < O : X@DatabaseClass | db : DB, input : ('show`eqs_.[T]), output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | 
          db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getEqs(getFlatModule(ME', DB'))),
          default : ME, Atts > 
    if ME'' := parseModExp(T) 
       /\ DB' := database(evalModExp(ME'', DB))
       /\ ME' := modExp(evalModExp(ME'', DB)) .

  crl [show-rls] :
    < O : X@DatabaseClass | db : DB, input : ('show`rls`..@Command@), output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getRls(getFlatModule(ME', DB'))),
          default : ME', Atts >  
    if DB' := database(evalModExp(ME, DB)) 
       /\ ME' := modExp(evalModExp(ME, DB)) .
  crl [show-rls] :
    < O : X@DatabaseClass | db : DB, input : ('show`rls_.[T]), output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getRls(getFlatModule(ME', DB'))),
          default : ME, Atts > 
    if ME'' := parseModExp(T) 
       /\ DB' := database(evalModExp(ME'', DB))
       /\ ME' := modExp(evalModExp(ME'', DB)) .

  crl [show-view] :
     < O : X@DatabaseClass | db : DB, input : ('show`view_.[T]), output : nil, default : ME, Atts >
     => < O : X@DatabaseClass | db : DB', input : nilTermList, 
           output : eMetaPrettyPrint(DB', getView(parseViewExp(T), DB')),
           default : ME, Atts > 
     if DB' := evalViewExp(parseViewExp(T), nil, DB) .

  crl [set`protect_on] :
     < O : X@DatabaseClass | 
           db : DB,  
           input : ('set`protect_on`.[T]), 
           output : QIL', 
           default : ME, Atts >
     => < O : X@DatabaseClass | 
           db : db(MIS, MNS, VIS, VES,  
                   MNS' ME', MNS'', MNS3, QIL), 
           input : nilTermList, 
           output : (QIL' 'set 'protect header2QidList(ME') 'on '\n), 
           default : ME, Atts > 
     if ME' := parseModExp(T) 
        /\ unitInDb(ME', DB)
        /\ db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL) := DB .
  crl [set`protect_off] :
     < O : X@DatabaseClass | 
           db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL),  
           input : ('set`protect_off`.[T]), 
           output : QIL', 
           default : ME, Atts >
     => < O : X@DatabaseClass | 
           db : db(MIS, MNS, VIS, VES, remove(MNS', ME'), MNS'', MNS3, QIL),  
           input : nilTermList, 
           output : (QIL' 'set 'protect header2QidList(ME') 'off '\n), 
           default : ME, Atts > 
     if ME' := parseModExp(T) .

  crl [set`extend_on] :
     < O : X@DatabaseClass | 
           db : DB,  
           input : ('set`extend_on`.[T]), 
           output : QIL', 
           default : ME, Atts >
     => < O : X@DatabaseClass | 
           db : db(MIS, MNS, VIS, VES,  
                   MNS', MNS'' ME', MNS3, QIL), 
           input : nilTermList, 
           output : (QIL' 'set 'extend header2QidList(ME') 'on '\n), 
           default : ME, Atts > 
     if ME' := parseModExp(T) 
        /\ unitInDb(ME', DB)
        /\ db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL) := DB .
  crl [set`extend_off] :
     < O : X@DatabaseClass | 
           db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL),  
           input : ('set`extend_off`.[T]), 
           output : QIL', 
           default : ME, Atts >
     => < O : X@DatabaseClass | 
           db : db(MIS, MNS, VIS, VES, MNS', remove(MNS'', ME'), MNS3, QIL),  
           input : nilTermList, 
           output : (QIL' 'set 'extend header2QidList(ME') 'off '\n), 
           default : ME, Atts > 
     if ME' := parseModExp(T) .

  crl [set`include_on] :
     < O : X@DatabaseClass | 
           db : DB,  
           input : ('set`include_on`.[T]), 
           output : QIL', 
           default : ME, Atts >
     => < O : X@DatabaseClass | 
           db : db(MIS, MNS, VIS, VES,  
                   MNS', MNS'', MNS3 . ME', QIL), 
           input : nilTermList, 
           output : (QIL' 'set 'include header2QidList(ME') 'on '\n), 
           default : ME, Atts > 
     if ME' := parseModExp(T) 
        ----/\ unitInDb(ME', DB)
        /\ db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL) := DB .
  crl [set`include_off] :
     < O : X@DatabaseClass | 
           db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL),  
           input : ('set`include_off`.[T]), 
           output : QIL', 
           default : ME, Atts >
     => < O : X@DatabaseClass | 
           db : db(MIS, MNS, VIS, VES, MNS', MNS'', remove(MNS3, ME'), QIL),  
           input : nilTermList, 
           output : (QIL' 'set 'include header2QidList(ME') 'off '\n), 
           default : ME, Atts > 
     if ME' := parseModExp(T) .

  crl [load] :
     < O : X@DatabaseClass | 
           db : DB,  
           input : ('load_.[T]), 
           output : QIL', 
           default : ME, Atts >
     => < O : X@DatabaseClass | 
           db : getDatabase(procLoad(T, ME, DB)), 
           input : nilTermList, 
           output : getQidList(procLoad(T, ME, DB)), 
           default : ME, Atts > 
     if ME' := parseModExp(T) .

  crl [show-variants] :
    < O : X@DatabaseClass | db : DB, 
       input : ('show`variants`..@Command@), 
       output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getVariants(getTopModule(ME', DB'))),
          default : ME', Atts > 
    if < DB' ; ME' > := evalModExp(ME, DB) .
  crl [show-variants] :
    < O : X@DatabaseClass | db : DB, input : ('show`variants_.[T]), output : nil, default : ME,   Atts >
    => < O : X@DatabaseClass | 
          db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME'', DB'), getVariants(getTopModule(ME'', DB'))),
          default : ME, Atts > 
    if < DB' ; ME'' > := evalModExp(parseModExp(T), DB) .

  crl [show-all-variants] :
    < O : X@DatabaseClass | db : DB, 
       input : ('show`all`variants`..@Command@), 
       output : nil, default : ME, Atts >
    => < O : X@DatabaseClass | db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getVariants(getFlatModule(ME', DB'))),
          default : ME', Atts > 
    if < DB' ; ME' > := evalModExp(ME, DB) .
  crl [show-all-variants] :
    < O : X@DatabaseClass | db : DB, input : ('show`all`variants_.[T]), output : nil, default : ME,   Atts >
    => < O : X@DatabaseClass | 
          db : DB', input : nilTermList, 
          output : eMetaPrettyPrint(getFlatModule(ME'', DB'), getVariants(getFlatModule(ME'', DB'))),
          default : ME, Atts > 
    if < DB' ; ME'' > := evalModExp(parseModExp(T), DB) .

  rl [error] :
     < O : X@DatabaseClass | 
        db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, NQIL), 
        input : TL, output : nil, default : ME, Atts >
     => < O : X@DatabaseClass | 
           db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, nil), 
           input : TL, output : NQIL, default : ME, Atts > .

  *** Auxiliary Functions

  op showViews : Database -> QidList .
  op showModules : Database -> QidList .

  eq showViews(db(MIS, MNS, VIS, (VE # VES), MNS', MNS'', MNS3, QIL))
    = (eMetaPrettyPrint(VE) '\n 
       showViews(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))) .
  eq showViews(
       db(MIS, MNS, VIS, emptyViewExpSet, MNS', MNS'', MNS3, QIL)) 
    = nil .

  eq showModules(
       db(MIS, (MN . MNS), VIS, VES, MNS', MNS'', MNS3, QIL))
    = (eMetaPrettyPrint(MN) '\n 
       showModules(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))) .
  eq showModules(
    db(MIS, emptyModuleNameSet, VIS, VES, MNS', MNS'', MNS3, QIL))
    = nil .
endm

*******************************************************************************

***
*** The Full Maude Module
***

*** We now give the rules to initialize the loop, and to specify the
*** communication between the loop---the input/output of the system---and the
*** database.  Depending on the kind of input that the database receives, its 
*** state will be changed, or some output will be generated.

mod FULL-MAUDE is
  pr META-FULL-MAUDE-SIGN .
  pr DATABASE-HANDLING .
  inc LOOP-MODE .
  pr BANNER .

*** The state of the persistent system, which is supported by the built-in
*** module \texttt{LOOP-MODE}, described in Section~\ref{loop}, is represented 
*** as a single object.

  subsort Object < State .

  op o : -> Oid .
  op init : -> System .

  var  Atts : AttributeSet .
  var  X@DatabaseClass : DatabaseClass .
  var  O : Oid .
  var  DB : Database .
  var  ME : Header .
  var  QI : Qid .
  vars QIL QIL' QIL'' : QidList .
  var  TL : TermList .
  var  N : Nat .
  vars RP RP' : ResultPair .

  rl [init] :
     init
     => [nil,
         < o : Database | 
            db : initialDatabase,
            input : nilTermList, output : nil, 
            default : 'CONVERSION >,
         ('\n '\t '\s '\s '\s '\s string2qidList(banner) '\n)] .

*** When some text has been introduced in the loop, the first argument of the
*** operator \verb~[_,_,_,]~ is different from \texttt{nil}, and we can use
*** this fact to activate the following rule, that enters an input such as a
*** module or a command from the user into the database.  The constant
*** \texttt{GRAMMAR} names the module containing the signature defining the
*** top level syntax of Full Maude (see Section~\ref{sec:signature} and
*** Appendix~\ref{signature-full-maude}). This signature is used by the
*** \texttt{metaParse} function to parse the input. PD the input is
*** syntactically valid\footnote{Of course, the input may be syntactically
*** valid, but not semantically valid, since further processing---for example,
*** of bubbles---may reveal a semantic inconsistency.}, the parsed input is 
*** placed in the \texttt{input} attribute of the database object; otherwise, 
*** an error message is placed in the output channel of the loop.

  rl [in] :
    [QI QIL, 
     < O : X@DatabaseClass | 
         db : DB, input : nilTermList, output : nil, default : ME, Atts >, 
     QIL']
    => if metaParse(GRAMMAR, QI QIL, '@Input@) :: ResultPair
       then [nil, 
             < O : X@DatabaseClass | db : DB, 
                 input : getTerm(metaParse(GRAMMAR, QI QIL, '@Input@)),
                 output : nil, default : ME, Atts >, 
              QIL'] 
       else [nil, 
             < O : X@DatabaseClass | db : DB, input : nilTermList, 
                 output : ('\r 'Warning: 
                           printSyntaxError(metaParse(GRAMMAR, QI QIL, '@Input@), 
                             QI QIL) 
                           '\n
                           '\r 'Error: '\o 'No 'parse 'for 'input. '\n), 
                 default : ME, Atts >, 
             QIL'] 
       fi .

*** When the \texttt{output} attribute of the persistent object contains a
*** nonempty list of quoted identifiers, the \texttt{out} rule moves it to the
*** third argument of the loop. Then the Core Maude system displays it in the 
*** terminal.

  rl [out] :
    [QIL, 
     < O : X@DatabaseClass | 
         db : DB, input : TL, output : (QI QIL'), default : ME, Atts >, 
     QIL'']
    => [QIL, 
        < O : X@DatabaseClass | 
            db : DB, input : TL, output : nil, default : ME, Atts >, 
        (QI QIL' QIL'')] .
endm

*******************************************************************************

loop init .

trace exclude FULL-MAUDE .

set show loop stats on .
set show loop timing on .
set show advisories on .