1----                                      To be run on Maude 2.7.1 (alpha 110b)
2----                                                    author: Francisco Duran
3----                           printSyntaxError functionality by Peter Olveczky
4----                                       narrowing search by Santiago Escobar
5
6set show loop stats off .
7set show loop timing off .
8set show advisories off .
9
10fmod BANNER is
11  pr STRING .
12  op banner : -> String .
13  eq banner = "Full Maude 2.7.1 June 30th 2016" .
14endfm
15
16***(
17    This file is part of the Maude 2 interpreter.
18
19    Copyright 1997-2003 SRI International, Menlo Park, CA 94025, USA.
20
21    This program is free software; you can redistribute it and/or modify
22    it under the terms of the GNU General Public License as published by
23    the Free Software Foundation; either version 2 inclof the License, or
24    (at your option) any later version.
25
26    This program is distributed in the hope that it will be useful,
27    but WITHOUT ANY WARRANTY; without even the implied warranty of
28    MERCHANTABILITY or FITNSS FOR A PARTICULAR PURPOSE.  See the
29    GNU General Public License for more details.
30
31    You should have received a copy of the GNU General Public Leicense
32    along with this program; if not, write to the Free Software
33    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
34)
35
36---- to do:
37---- - continue .
38---- - show search graph .
39---- - show path <number> .
40---- - show path labels <number> .
41---- - show components .
42
43---- Main changes and bugs fixed:
44----
45---- - May 19th, 2016
46----   - Adapted to the new syntax for variants in Alpha109
47---- - Feb 4th, 2016
48----   - The MOD-EXPRS module is renamed to FM-MOD-EXPRS, and a MOD-EXPRS is later
49----     introduced. Now, new module expressions can be used anywhere by redefining
50----     this new MOD-EXPRS module. Although FM could be extended to handle new
51----     module expressions, these were not supported inside "in" sections of
52----     commands.
53---- - Oct 19th, 2015
54----   - bug in the search command on OO modules (reported by Pete Olveczky)
55---- - Oct 12th, 2015
56----   - iter supported by built-in unification, checks adjusted accordingly
57---- - Feb 18th, 2015
58----   - An operator <_[,_]*> was added to the modules for narrowing. It has been
59----     renamed as @<@_[,_]*@>@ to avoid clashes with user-defined operators.
60----   - acu coherence completion has been renamed to ax coherence completion.
61----     This applies to the acu coherence completion [<module-name>] ., to the
62----     metalevel operation axCohComplete and to the module AX-COHERENCE-COMPLETION.
63----     The completion was already performed for the different combinations of
64----     attributes, but the name was the original one.
65---- - Nov 12th, 2014
66----   - Classes without attributes may be defined as class Foo . or class Foo | .
67----     Requested by A. Riesco.
68----   - Parameter sorts used in sort constraints were not appropriately instantiated.
69----     Reported by A. Riesco.
70---- - July 14th, 2014
71----   - Fixed bug in the parsing of terms with operators '=' or '=>'. Although the first-level
72----     parsing was done correctly, to solve bubbles an operator = (resp. =>) was introduced
73----     to handle equations (resp. rules). Reported by Adrian Riesco.
74----   - Fixed bug on the pretty printing of views. Typical error on structures with id elements.
75----     Probably due to changes in the definion of map sets. Reported by Adrian Riesco.
76---- - September 12th, 2013
77----   - Bug in ACU completion when handling modules with explicit use of kinds. Reported
78----     by Luis Aguirre
79---- - December 12th, 2013
80----   - Bug in the renaming of operators with explicit arity where parameterized sorts
81----     are used.
82----   - Bug in the renaming of ac operators fixed. Given an acu operator __, a term
83----     card(E E S, C) was not renamed.
84---- - July 24th, 2012
85----   - commands remove ids and remove non-handled ids available
86---- - July 7th, 2012
87----   - A bug in the removal of identity attributes has been fixed. A metadata("variant")
88----     was expected in all equations to be used to generate the variants. To be consistent
89----     to the new built-in getVariants function I'm using the attribute variant instead
90----     of the metadata.
91---- - March 20th, 2012
92----   - Core Maude views are now accessible from Full Maude. Full Maude do not require
93----     explicit sort maps any more.
94----   - The set of more general eqs and rls (moreGeneralEqs and moreGeneralRls ops)
95----     is now correctly calculated. These functions are used in several places, for
96----     example, in the functions and commands to eliminate identity attributes and in
97----     the completion procedures.
98----     Reported by Santiago Escobar.
99---- - October 24th, 2011
100----   - format attribute was not correctly handled. Equation missing in the downAttr op.
101---- - July 13th, 2011
102----   - A bug on the load metamodule command making it fail when loading a metamodule
103----     with a metadata attribute has been fixed.
104----     Reported by Tobias Muhlbauer and Jonas Eckhardt.
105---- - December 5th, 2009
106----   - New command (remove id attributes [<module-expr.>] .) that shows the
107----     module with the id attributes removed using variants.
108----   - New command (remove assoc attributes [<module-expr.>] .) that shows the
109----     module with the assoc (if not with comm) attributes removed using variants.
110---- - November 22nd, 2009
111----   - A new version of the narrowing/unification stuff by S. Escobar fixing a bug in the
112----     getVariants function and incorporating some other changes.
113----     To integrate it into Full Maude:
114----     - The TERMSET module is moved, so that now Full Maude uses it instead of its
115----       definition of term sets. In the original module by Santiago this module imported
116----       the SUBSTITUTION-HANDLING module; this importation is now commented out.
117---- - October 4th, 2009
118----   - New (acu coherence completion .) / (acu coherence completion <Module> .) command.
119----     It shows result of completing the flatten version of the module for acu coherence.
120---- - Setember 11th, 2009
121----   - sort Set<List<Type>> replaced by the TypeListSet sort from META-MODULE
122----   - sort List<Set<Type>> renamed as TypeSetList
123----   - MAYBE removed, DEFAULT-VALUE used instead. MAYBE{TERM} replaced by DEFAULT-VALUE{Term}
124---- - July 28th, 2009
125----   - Some cleaning up. Some of the changes may break other applications.
126---- - April 18th, 2009
127----   - The metadata attribute is now available for operation declarations. Reported by A. Riesco.
128----   - Fixed bug in the handling of ditto. ctor and metadata attributes were copied.
129---- - March 9th, 2009
130----   - Bug in the search command. The number of solutions argument was used as depth bound. Reported by P. Olveczky.
131----   - New (remove id attributes .) / (remove id attributes <Module> .) command
132----     It shows an equivalent version of the flatten module without ids using variants.
133---- - March 9th, 2009
134----   - Bug in the handling of mbs/cmbs. Sorts in bubbles were not handled correctly. Reported by T. Serbanuta.
135---- - February 12th, 2009
136----   - The summation module expression now generates a module
137----        fmod A + B + C is
138----          inc A .
139----          inc B .
140----          inc C .
141----        endfm
142----     for a module expression A + B + C.
143---- - February 6th, 2009
144----   - Fixed a bug in the id-unify command. Fixed by Santiago Escobar
145---- - February 3rd, 2009
146----   - Missing equation for downAttr, for the case of nonexec
147----   - Missing declaration in the CONFIGURATION+ module to handle class declarations with no attributes
148---- - January 29th, 2009
149----   - The downModule operation has been extended to be able to handle oo metamodules.
150----     Note that omod metamodules are defined in the UNIT Full Maude module. Therefore,
151----     to be able to do things like
152----        (load omod ... endm .)
153----     the current module must be the FM UNIT module or one extending it.
154---- - January 28th, 2009
155----   - A bug in downAttr. Found thanks to a problem with metamodule load. Reported by Peter Olveczky.
156---- - January 8th, 2009
157----   - A bug in the narrowing functionality. It was narrowing on frozen positions.
158----     (fixed by Santiago Escobar)
159---- - December 20th, 2008
160----   - Fixed a bug in the handling of the such-that part of search commands.
161----     Reported by Enrique Martin.
162---- - December 17th, 2008
163----   - A new search_~>_ family of commands (as for search_=>_) is now available.
164----     The commands are implemented by Santiago Escobar.
165---- - December 8th, 2008
166----   - A new meta-module load command is available.
167----     It enters a metamodule into Full Maude's database of modules.
168----     Asked by Peter Olveczky and Jose Meseguer.
169----     The syntax for the new command is (load <meta-module> .), where <meta-module is any term of sort
170----     Module, either a term of the form fmod...endfm or any other expression reducing to a module.
171----     Thus, you can write things like
172----
173----     (select META-LEVEL .)
174----
175----     (load fmod 'FOO is
176----             including 'BOOL .
177----             sorts 'Foo .
178----             none
179----             op 'f : nil -> 'Foo [none] .
180----             op 'g : nil -> 'Foo [none] .
181----             none
182----             eq 'f.Foo = 'g.Foo [none] .
183----           endfm .)
184----
185----     or
186----
187----     (load upModule('NAT, true) .)
188----
189---- - September 18th, 2008
190----   The search command now supports its complete generality (maximum depth couln't be given). Bug reported by Zhang Min.
191----   The unify command is now supported.
192----   Bug in the renaming of partial operations fixed. Reported by Edu Rivera.
193---- - April 2nd, 2008
194----   Bug in the application of views (and renamings) with kinds in the specification
195----   of op renamings. It appears in an example in which the sort was coming from a theory.
196----   Reported by A. Boronat.
197---- - March 24th, 2008
198----   Bug in the application of renamings to op hooks. Reported by A. Boronat
199---- - March 17th, 2008
200----   Bug in the instantiation of parameterized sorts in sort memberships.
201----   Reported by A. Boronat
202---- - March 14th, 2008
203----   Bug in the handling of parameterized module expressions. When the parameterers
204----   are not right, the system hangs. Reported by A. Verdejo.
205---- - March 9th, 2008
206----   Statement attributes of membership axioms were not correctly handled.
207----   Reported by A. Riesco & A. Verdejo
208---- - Feb 18th, 2008
209----   Bug in the renaming of operators
210---- - Feb 14th, 2008
211----   Statement attributes of membership axioms were not correctly handled.
212----   Reported by A. Riesco & A. Verdejo
213---- - Dec 17th, 2007
214----   Rule in CONFIGURATION+ was causing non-termination
215---- - Dec 13th, 2007
216----   Change in the specification of the transform function to allow new types of modules
217---- - Nov 23rd, 2007
218----   Bug in the evaluation of expressions in commands (red in FOO + BAR : ...)
219---- - Oct 5th, 2007
220----   Bug in down of modules (reported by Pedro Ojeda)
221---- - July 31st, 2007
222----   bug in the application of maps to terms
223---- - July 31st, 2007
224----   bug in getThClasses
225----   (reported by Marisol)
226---- - (october 17th, 2006)
227----   Changes in Alpha88a's prelude are now correctly handled
228---- - (july 22nd, 2006)
229----   Bug in the meta-pretty-print of types.
230---- - (july 21st, 2006)
231----   Object-oriented messages where not given the attribute msg
232----   (from a comment by Peter).
233---- - (reported by Radestock)
234----   getSort was not handling parameterized sorts appropriately.
235---- - the set protect/extend/include off commands didn't work if the
236----   module not importing was not among the imported ones
237----
238---- Last changes:
239----
240---- - May 21st, 2007
241----   GRAMMAR now extends a module BUBBLES with all bubble delcarations.
242----   This BUBBLES module is also used to define the GRAMMAR-RED, GRAMMAR-REW, ...
243----   modules.
244----
245---- - May 19th, 2007
246----   procCommand changed. It now returns a Tuple{Database, QidList} instead of
247----   just a QidList. Since some modules may need to be compiled for the
248----   execution of a command, the resulting database is returned and used as
249----   new database.
250----
251---- - May 19th, 2007
252----   proRew takes now one argument less. The Bound (4th arg.) was unnecessary.
253----
254---- - BOOL is included, instead of protected, into any entered module.
255----
256---- - A new module expression POWER[n] is now available. A module expression
257----   POWER[n]{Nat} produces a module
258----
259----    fmod POWER[n]{X :: TRIV} is
260----      inc TUPLE[n]{X, X, ..., X} .
261----    endfm
262----
263----   which is then instantiated by the Nat view.
264
265---- - (July 18th, 2006)
266----   The summation module expression now generates a module
267----   that includes (instead of protect) its summands.
268----
269---- - All sorts declared in modules used for parsing have been renamed.
270----   Any sort S in one of these modules is nos called @S@.
271----   Since some of these modules where added to the user defined modules
272----   for dealing with ups, conditions, etc., he was getting error when
273----   using sorts like Token or OpDecl in his specs.
274----
275---- - Syntax for parameterization has been changed (again) !!! :
276----     - module definition: FOO{X :: TRIV, Y :: TRIV}
277----     - module instantiation: FOO{Bar,Baz}
278----     - parameterized sorts: Foo{Bar,Baz}
279----
280---- - Any module loaded in Core Maude can be used in Full Maude.
281----   This may be particularly useful in the case of using the model checker.
282----
283----   (mod CHECK-RESP is
284----      protecting MODEL-CHECKER .
285----      ...
286----    endm)
287----
288----   (red p(0) |= (<> Qstate) .)
289----
290---- - Module renaming and summation consistent with Core Maude's. Built-ins
291----   are now handled at the metalevel, instead of leaving the inclusions to
292----   Core Maude. In this way, they can be renamed and redefined, as in
293----   Core Maude. This makes Full Maude slower.
294----
295---- - The lazy evaluation of modules is working. When a module is redefined
296----   its dependent modules are removed only if generated internally. Those
297----   introduced by the user save their term representation, from which the
298----   whole processing can take place. They will be recompiled by need.
299----
300---- - The form of qualifying sorts coming from the parameters in
301----   parameterized modules has changed AGAIN: The sort Elt coming from
302----   X :: TRIV is now written as X$Elt (Note that sort names cannot contain
303----   dots anymore).
304----
305---- - Tuples are built with the syntax
306----     TUPLE[size]{comma_separated_list_of_views}
307----   For example, given a view Nat from TRIV to NAT we can define pairs of
308----   nats with TUPLE[2]{Nat, Nat}.
309----
310---- - The model-checker is loaded before the full maude modules, so that
311----   it can be used.
312----
313---- - Object-oriented modules include a module CONFIGURATION+, which
314----   imports CONFIGURATION, defines a function
315----     op class : Object -> Cid .
316----   returning the actual class of the given object, and add syntax
317----   for objects with no attributes <_:_| >. Classes without attributes
318----   are defined with syntax class CLASS-NAME .
319----
320---- Things to come:
321----
322---- - Commands missing: continue ...
323----
324---- - On parameterized theories and views: linked parameters, composed and
325----   lifted views, and default views.
326----
327---- - ops names in op declarations
328----
329---- known bugs:
330----
331---- - error messages could be given in down commands
332----
333---- - Check: perhaps we need to convert constants back into vbles in
334----   procViewAux
335----
336---- - Parameterized sorts don't work in sort constraints (nor by themselves,
337----   nor in the conditions of axioms. They are accepted in their equivalent
338----   single token form but do not get instantiated
339----     cmb (A, B) S : PFun(X, Y) if not(A in dom(S)) /\ S : PFun`(X`,Y`) .
340----
341
342set include BOOL off .
343set include TRUTH-VALUE on .
344set show advisories off .
345
346mod CONFIGURATION is
347  sorts Attribute AttributeSet .
348  subsort Attribute < AttributeSet .
349  op none : -> AttributeSet  [ctor] .
350  op _,_ : AttributeSet AttributeSet -> AttributeSet [ctor assoc comm id: none] .
351
352  sorts Oid Cid Object Msg Portal Configuration .
353  subsort Object Msg Portal < Configuration .
354  op <_:_|_> : Oid Cid AttributeSet -> Object [ctor object] .
355  op none : -> Configuration [ctor] .
356  op __ : Configuration Configuration -> Configuration [ctor config assoc comm id: none] .
357  op <> : -> Portal [ctor] .
358endm
359
360mod CONFIGURATION+ is
361  including CONFIGURATION .
362  op <_:_|`> : Oid Cid -> Object .
363  op class : Object -> Cid .
364  ---- eq < O:Oid : C:Cid | > = < O:Oid : C:Cid | none > .
365  eq class(< O:Oid : C:Cid | A:AttributeSet >) = C:Cid .
366endm
367
368set include BOOL on .
369set include TRUTH-VALUE off .
370
371*******************************************************************************
372*******************************************************************************
373***
374*** Narrowing and Equational Unification
375*** by Santiago Escobar
376***
377fmod META-LEVEL-MNPA is
378  pr META-LEVEL * (op `{_`,_`} : Term Nat -> SmtResult to `{_`,_`}Smt )  .
379endfm
380
381fmod UNIFICATIONTRIPLE is
382  protecting META-LEVEL-MNPA .
383  protecting INT .
384
385  --- UnificationPair --------------------------------------------
386  ---sorts UnificationPair UnificationPair? .
387  ---op {_,_} : Substitution Nat -> UnificationPair [ctor] .
388  ---subsort UnificationPair < UnificationPair? .
389  ---op noUnifier : -> UnificationPair? [ctor] .
390
391  op getSubst : UnificationPair -> Substitution .
392  eq getSubst({S1:Substitution, N:Nat}) = S1:Substitution .
393  op getNextVar : UnificationPair -> Nat .
394  eq getNextVar({S1:Substitution, N:Nat}) = N:Nat .
395
396  --- UnificationTriple --------------------------------------------
397  ---sorts UnificationTriple UnificationTriple? .
398  ---op {_,_,_} : Substitution Substitution Nat -> UnificationTriple [ctor] .
399  ---subsort UnificationTriple < UnificationTriple? .
400  ---op noUnifier : -> UnificationTriple? [ctor] .
401
402  op getLSubst : UnificationTriple -> Substitution .
403  eq getLSubst({S1:Substitution, S2:Substitution, N:Nat}) = S1:Substitution .
404  op getRSubst : UnificationTriple -> Substitution .
405  eq getRSubst({S1:Substitution, S2:Substitution, N:Nat}) = S2:Substitution .
406  op getNextVar : UnificationTriple -> Nat .
407  eq getNextVar({S1:Substitution, S2:Substitution, N:Nat}) = N:Nat .
408
409endfm
410
411fmod TERM-HANDLING is
412  protecting META-TERM .
413  protecting META-LEVEL-MNPA .
414  protecting EXT-BOOL . *** For and-then
415
416  var T T' T'' : Term .
417  var C C' : Constant .
418  var QIL : QidList .
419  var N N' : Nat .
420  var NL NL' : NatList .
421  var Q F F' : Qid .
422  var AtS : AttrSet .
423  var EqS : EquationSet .
424  var Eq : Equation .
425  var Cond : Condition .
426  var TP : Type .
427  var TPL TPL' : TypeList .
428  var TL TL' TL'' : TermList .
429  var B : Bool .
430  var V V' : Variable .
431  var Ct : Context .
432  var CtL : NeCTermList .
433  var NeTL : NeTermList .
434  var M : Module .
435
436  *** root  ******************************
437  op root : Term -> Qid .
438  eq root(V) = V .
439  eq root(C) = C .
440  eq root(F[TL]) = F .
441
442  *** size  ******************************
443  op size : TermList -> Nat .
444  eq size(empty) = 0 .
445  eq size((T,TL)) = s(size(TL)) .
446
447  *** elem_of_ *****************************************************
448  op elem_of_ : Nat TermList ~> Term .
449  eq elem 1 of (T,TL) = T .
450  eq elem s(s(N)) of (T,TL) = elem s(N) of TL .
451
452  *** subTerm_of_ *****************************************************
453  op subTerm_of_ : NatList Term ~> Term .
454  eq subTerm NL of T = subTerm* NL of T  .
455
456  op subTerm*_of_ : NatList Term ~> Term .
457  eq subTerm* nil of T = T .
458  eq subTerm* N NL of (F[TL]) = subTerm* NL of (elem N of TL) .
459
460  *** ToDo: UPGRADE THIS NOTION TO MODULO AC *********************
461  *** is_subTermOf_ *****************************************************
462  op is_subTermOf_ : Term TermList -> Bool .
463  eq is T subTermOf (T',NeTL) = is T subTermOf T'
464                                or-else is T subTermOf NeTL .
465  eq is T subTermOf T = true .
466  eq is T subTermOf T' = is T subTermOf* T' [owise] .
467
468  op is_subTermOf*_ : Term TermList -> Bool .
469  eq is T subTermOf* (F[TL]) = is T subTermOf TL .
470  eq is T subTermOf* T' = false [owise] .
471
472  *** noVarOfSort_In_ *****************************************************
473  op noVarOfSort_In_ : Type TermList -> Bool .
474  eq noVarOfSort T:Type In V = getType(V) =/= T:Type .
475  eq noVarOfSort T:Type In (F[TL]) = noVarOfSort T:Type In TL .
476  eq noVarOfSort T:Type In (T',NeTL)
477   = noVarOfSort T:Type In T' and noVarOfSort T:Type In NeTL .
478  eq noVarOfSort T:Type In X:TermList = true [owise] .
479
480  *** findSubTermOf_In_ ***********************************************
481  op findSubTermOf_In_ : NeCTermList TermList ~> Term .
482  eq findSubTermOf (TL, [], TL') In (TL, T, TL') = T .
483  eq findSubTermOf (TL, F[CtL], TL'') In (TL, F[TL'], TL'')
484   = findSubTermOf CtL In TL' .
485
486  *** replaceElem_of_by_ ****************************************************
487  op replaceElem_of_by_ : Nat TermList Term ~> TermList .
488  eq replaceElem 1 of (T,TL) by T' = (T',TL) .
489  eq replaceElem s(s(N)) of (T,TL) by T' = (T,replaceElem s(N) of TL by T') .
490
491  *** replaceSubTerm_of_by_ *************************************************
492  op replaceSubTerm_of_by_ : NatList TermList Term ~> TermList .
493  eq replaceSubTerm nil of T by T' = T' .
494  eq replaceSubTerm N NL of (F[TL]) by T'
495   = F[replaceSubTermL N NL of TL by T'] .
496
497  op replaceSubTermL_of_by_ : NatList TermList Term ~> TermList .
498  eq replaceSubTermL 1 NL of (T,TL) by T'
499   = (replaceSubTerm NL of T by T', TL) .
500  eq replaceSubTermL s(s(N)) NL of (T,TL) by T'
501   = (T,replaceSubTermL s(N) NL of TL by T') .
502
503  op replaceTerm_by_in_ : Term Term TermList ~> TermList .
504  eq replaceTerm T by T' in T = T' .
505  eq replaceTerm T by T' in (F[TL]) = F[replaceTerm T by T' in TL] .
506  eq replaceTerm T by T' in T'' = T'' [owise] .
507  eq replaceTerm T by T' in (T'',NeTL)
508   = (replaceTerm T by T' in T'',replaceTerm T by T' in NeTL) .
509
510  *** context replacement **************************************************
511
512  op _[_] : Context Context -> Context .
513  op _[_] : NeCTermList Context -> NeCTermList .
514  eq [] [ Ct ] = Ct .
515  eq (F[CtL])[ Ct ] = F[ CtL [ Ct ] ] .
516  eq (CtL,NeTL) [Ct] = (CtL [Ct] ), NeTL .
517  eq (NeTL,CtL) [Ct] = NeTL, (CtL [Ct] ) .
518
519  op _[_] : Context Term -> Term .
520  op _[_] : NeCTermList Term -> TermList .
521  eq [] [ T ] = T .
522  eq (F[CtL])[ T ] = F[ CtL [ T ] ] .
523  eq (CtL,NeTL) [T] = (CtL [T] ), NeTL .
524  eq (NeTL,CtL) [T] = NeTL, (CtL [T] ) .
525
526  *** is_substring_ *****************************************
527  op is_substring_ : Qid Qid -> Bool [memo] .
528  eq is F:Qid substring F':Qid
529   = rfind(string(F':Qid), string(F:Qid), length(string(F':Qid))) =/= notFound .
530
531  *** addprefix_To_ addsufix_To_ *****************************************
532  op addprefix_To_ : Qid Variable -> Variable [memo] .
533  eq addprefix Q To V
534   = qid(string(Q) + string(getName(V)) + ":" + string(getType(V))) .
535
536  op addprefix_To_ : Qid Constant -> Constant [ditto] .
537  eq addprefix Q To F
538   = if noUnderBar(F) and getName(F) :: Qid then
539       if getType(F) :: Type then
540         qid(string(Q) + string(getName(F)) + "." + string(getType(F)))
541       else
542         qid(string(Q) + string(getName(F)))
543       fi
544     else
545       qid(string(Q) + string(F))
546     fi .
547
548  op addsufix_To_ : Qid Variable -> Variable [memo] .
549  eq addsufix Q To V
550   = qid(string(getName(V)) + string(Q) + ":" + string(getType(V))) .
551
552  op addsufix_To_ : Qid Constant -> Constant [ditto] .
553  eq addsufix Q To F
554   = if noUnderBar(F) and getName(F) :: Qid then
555       if getType(F) :: Type then
556         qid(string(getName(F)) + string(Q) + "." + string(getType(F)))
557       else
558         qid(string(getName(F)) + string(Q))
559       fi
560     else
561       qid(string(F) + string(Q))
562     fi .
563
564  op addType_ToVar_ : Type Qid -> Variable [memo] .
565  eq addType TP:Qid ToVar V:Qid
566   = qid(string(V:Qid) + ":" + string(TP:Qid)) .
567
568  *** noUnderBar (auxiliary) ****************************
569  op noUnderBar : Qid -> Bool .
570  eq noUnderBar(F)
571   = rfind(string(F), "_", length(string(F))) == notFound .
572
573  *** addType  ******************************
574  op addType : Qid Type -> Qid .
575  eq addType(F,TP)
576   = if noUnderBar(F) and getName(F) :: Qid then
577       qid( string(getName(F)) + "." + string(TP) )
578     else
579       qid( string(F) + "." + string(TP) )
580     fi .
581
582  *** addTypeVar  ******************************
583  op addTypeVar : Qid Type -> Qid .
584  eq addTypeVar(F,TP)
585   = qid( string(F) + ":" + string(TP) ) .
586
587endfm
588
589fmod SUBSTITUTION-HANDLING is
590  protecting META-TERM .
591  protecting META-LEVEL-MNPA .
592  protecting TERM-HANDLING .
593
594  var S S' Subst Subst' : Substitution .
595  var V V' : Variable .
596  var C C' : Constant .
597  var Ct : Context .
598  var T T' T1 T2 T1' T2' T1'' T2'' : Term .
599  var F F' : Qid .
600  var TL TL' TL1 TL2 TL1' TL2' : TermList .
601  var Att : AttrSet .
602  var RLS : RuleSet .
603  var Rl : Rule .
604  var TP : Type .
605  var N : Nat .
606  var NeTL : NeTermList .
607  var CtL : NeCTermList .
608
609  --- Apply Substitution to Term --------------------------------------------
610  op _<<_ : Term Substitution -> Term .
611  eq TL << none = TL .
612  eq C << Subst = C .
613  eq V << ((V <- T) ; Subst) = T .
614  eq V << Subst = V [owise] .
615  eq F[TL] << Subst = F[TL << Subst] .
616
617  op _<<_ : TermList Substitution -> TermList .
618  eq (T, NeTL) << Subst = (T << Subst, NeTL << Subst) .
619  eq empty << Subst = empty .
620
621  op _<<_ : Context Substitution -> Context .
622  eq Ct << none = Ct .
623  eq [] << Subst = [] .
624  eq F[CtL,NeTL] << Subst = F[CtL << Subst,NeTL << Subst] .
625  eq F[NeTL,CtL] << Subst = F[NeTL << Subst, CtL << Subst] .
626  eq F[Ct] << Subst = F[Ct << Subst] .
627
628  op _<<_ : Substitution Substitution -> Substitution .
629  eq S << (none).Substitution = S .
630  eq (none).Substitution << S = (none).Substitution .
631  eq ((V' <- T) ; S') <<  S
632   = (V' <- (T << S))
633     ;
634     (S' << S) .
635
636  --- Combine Substitutions -------------------------------------------------
637  op _.._ : Substitution Substitution -> Substitution .
638  eq S .. S' = (S << S') ; S' .
639
640  --- Restrict Assignments to Variables in a Term ----------------------
641  op _|>_ : Substitution TermList -> Substitution .
642
643  eq Subst |> TL = Subst |>* Vars(TL) .
644
645  op _|>*_ : Substitution TermList -> Substitution .
646---   eq noMatch |>* TL = noMatch .
647  eq Subst |>* TL = Subst |>** TL [none] .
648
649  op _|>**_[_] : Substitution TermList
650                 Substitution -> Substitution .
651  eq none |>** TL [Subst']
652   = Subst' .
653  eq ((V <- V) ; Subst) |>** TL [Subst']
654   = Subst |>** TL [Subst'] .
655  eq ((V <- T') ; Subst) |>** TL [Subst']
656    = Subst |>** TL
657      [Subst' ; if any V in TL then (V <- T') else none fi] .
658
659  --- Remove Variables from list ----------------------
660  op _intersect_ : TermList TermList -> TermList .
661  eq (TL1,T,TL2) intersect (TL1',T,TL2')
662   = (T,((TL1,TL2) intersect (TL1',TL2'))) .
663  eq TL intersect TL' = empty [owise] .
664
665  op _intersectVar_ : TermList TermList -> TermList .
666  eq TL1 intersectVar TL2
667   = TL1 intersectVar* Vars(TL2) .
668
669  op _intersectVar*_ : TermList TermList -> TermList .
670  eq (T,TL1) intersectVar* TL2
671   = (if any Vars(T) in TL2 then T else empty fi,TL1 intersectVar* TL2) .
672  eq empty intersectVar* TL2
673   = empty .
674
675  --- Remove Variables from list ----------------------
676  op _setMinus_ : TermList TermList -> TermList .
677  eq (TL1,T,TL2) setMinus (TL1',T,TL2')
678   = (TL1,TL2) setMinus (TL1',T,TL2') .
679  eq TL setMinus TL' = TL [owise] .
680
681  --- Variables ---
682  op Vars : GTermList -> TermList .
683  eq Vars((T,TL:GTermList)) = VarsTerm(T),Vars(TL:GTermList) .
684  eq Vars((Ct,TL:GTermList)) = VarsTerm(Ct),Vars(TL:GTermList) .
685  eq Vars(empty) = empty .
686
687  op VarsTerm : Term -> TermList . ---warning memo
688  eq VarsTerm(V) = V .
689  eq VarsTerm(F[TL:TermList]) = Vars(TL:TermList) .
690  eq VarsTerm(C) = empty .
691
692  op VarsTerm : Context -> TermList . ---warning memo
693  eq VarsTerm(F[TL:GTermList]) = Vars(TL:GTermList) .
694
695  --- membership ---
696  op _in_ : Term TermList -> Bool .
697  eq T in (TL,T,TL') = true .
698  eq T in TL = false [owise] .
699
700  --- membership ---
701  op any_in_ : TermList TermList -> Bool . --- [memo] .
702  eq any empty in TL = false .
703  eq any (TL1,T,TL2) in (TL1',T,TL2') = true .
704  eq any TL in TL' = false [owise] .
705
706  --- membership ---
707  op all_in_ : TermList TermList -> Bool . --- [memo] .
708  eq all empty in TL = true .
709  eq all (TL1,T,TL2) in (TL1',T,TL2') = all (TL1,TL2) in (TL1',T,TL2') .
710  eq all TL in TL' = false [owise] .
711
712  --- Occur check ---
713  op allVars_inVars_ : GTermList GTermList -> Bool .
714  eq allVars TL:GTermList inVars TL':GTermList
715   = all Vars(TL:GTermList) in Vars(TL':GTermList) .
716
717  op anyVars_inVars_ : GTermList GTermList -> Bool .
718  eq anyVars TL:GTermList inVars TL':GTermList
719   = any Vars(TL:GTermList) in Vars(TL':GTermList) .
720
721  op rangeVars : Substitution -> TermList .
722  eq rangeVars(V <- T ; Subst) = (Vars(T),rangeVars(Subst)) .
723  eq rangeVars(none) = empty .
724
725  op dom_inVars_ : Substitution TermList -> Bool .
726  eq dom Subst inVars TL = dom Subst in Vars(TL) .
727
728  op dom_in_ : Substitution TermList -> Bool .
729  eq dom (V <- T ; Subst) in (TL1,V,TL2) = true .
730  eq dom Subst in TL = false [owise] .
731
732  op dom_notInVars_ : Substitution TermList -> Bool .
733  eq dom Subst notInVars TL = dom Subst notIn Vars(TL) .
734
735  op dom_notIn_ : Substitution TermList -> Bool .
736  eq dom none notIn TL = true .
737 ceq dom (V <- T ; Subst) notIn TL = true if not (V in TL) .
738  eq dom Subst notIn TL = false [owise] .
739
740  op range_inVars_ : Substitution TermList -> Bool .
741  eq range Subst inVars TL = range Subst in Vars(TL) .
742
743  op range_in_ : Substitution TermList -> Bool .
744  eq range (V <- T ; Subst) in TL
745   = any Vars(T) in TL or-else range Subst in TL .
746  eq range none in TL
747   = false .
748
749  op valid-occur-check? : Substitution -> Bool .
750  eq valid-occur-check?(Subst)
751   = not (dom Subst inVars (rangeVars(Subst))) .
752
753  op extract-bindings : Substitution -> TermList .
754  eq extract-bindings(none) = empty .
755  eq extract-bindings(V <- T ; Subst) = (T,extract-bindings(Subst)) .
756endfm
757
758fmod TERMSET is
759  protecting META-LEVEL-MNPA .
760  protecting SUBSTITUTION-HANDLING .
761
762  sort TermSet .
763  subsort Term < TermSet .
764  op emptyTermSet : -> TermSet [ctor] .
765  op _|_ : TermSet TermSet -> TermSet
766    [ctor assoc comm id: emptyTermSet format (d n d d)] .
767  eq X:Term | X:Term = X:Term .
768
769  op _in_ : Term TermSet -> Bool .
770  eq T:Term in (T:Term | TS:TermSet) = true .
771  eq T:Term in TS:TermSet = false [owise] .
772
773  op TermSet : TermList -> TermSet .
774  eq TermSet(empty)
775   = emptyTermSet .
776  eq TermSet((T:Term,TL:TermList))
777   = T:Term | TermSet(TL:TermList) .
778
779endfm
780
781fmod RENAMING is
782  protecting META-TERM .
783  protecting META-LEVEL-MNPA .
784  protecting TERM-HANDLING .
785  protecting SUBSTITUTION-HANDLING .
786  protecting TERMSET .
787  protecting CONVERSION .
788  protecting QID .
789  protecting INT .
790  protecting UNIFICATIONTRIPLE .
791
792  var S S' Subst Subst' : Substitution .
793  var V V' : Variable .
794  var C C' : Constant .
795  var CtL : NeCTermList .
796  var Ct : Context .
797  var T T' T1 T2 T1' T2' T1'' T2'' : Term .
798  var F F' : Qid .
799  var TL TL' TL'' TL''' : TermList .
800  var Att : AttrSet .
801  var RLS : RuleSet .
802  var Rl : Rule .
803  var TP : Type .
804  var N N' : Nat .
805  var NeTL : NeTermList .
806
807  var Q Q' : Qid .
808  var IL : ImportList .
809  var SS : SortSet .
810  var SSDS : SubsortDeclSet .
811  var OPDS : OpDeclSet .
812  var MAS : MembAxSet .
813  var EQS : EquationSet .
814
815  var TPL : TypeList .
816
817  --- Extra filter for substitutions ------
818  op _|>_ : Substitution Nat -> Substitution .
819  eq Subst |> N
820   = Subst |>* N [none] .
821
822  op _|>*_[_] : Substitution Nat Substitution -> Substitution .
823  eq none |>* N [Subst']
824   = Subst' .
825  eq ((V <- T') ; Subst) |>* N [Subst']
826   = Subst |>* N
827     [Subst' ; if highestVar(V) < N then (V <- T') else none fi ] .
828
829  --- instantiatesAbove -----------------------------------
830  op _instantiatesAbove_ : Substitution Nat -> Bool .
831  eq none instantiatesAbove N = false .
832  eq ((V <- T') ; Subst) instantiatesAbove N
833   = highestVar(V) >= N
834     or-else
835     Subst instantiatesAbove N .
836
837  ----------------------------------------------
838  --- New Renaming Utilities -------------------
839  op highestVar : GTermList -> Nat .
840  eq highestVar(TL:GTermList)
841   = highestVar(TL:GTermList,0) .
842
843  op highestVarTerm : Term -> Nat . ---warning memo
844  op highestVarTerm : Context -> Nat . ---warning memo
845  eq highestVarTerm([]) = 0 .
846  eq highestVarTerm(C) = 0 .
847  eq highestVarTerm(V)
848   = if rfind(string(V), "#", length(string(V))) =/= notFound
849        and
850        rfind(string(V), ":", length(string(V))) =/= notFound
851        and
852        rat(substr(string(V),
853                   rfind(string(V), "#", length(string(V))) + 1,
854                   rfind(string(V), ":", length(string(V))) + (- 1))
855            ,10)
856        :: Nat
857     then rat(substr(string(V),
858                   rfind(string(V), "#", length(string(V))) + 1,
859                   rfind(string(V), ":", length(string(V))) + (- 1))
860              ,10)
861     else
862         if rfind(string(V), "%", length(string(V))) =/= notFound
863            and
864            rfind(string(V), ":", length(string(V))) =/= notFound
865            and
866            rat(substr(string(V),
867                       rfind(string(V), "%", length(string(V))) + 1,
868                       rfind(string(V), ":", length(string(V))) + (- 1))
869                ,10)
870            :: Nat
871         then rat(substr(string(V),
872                         rfind(string(V), "%", length(string(V))) + 1,
873                         rfind(string(V), ":", length(string(V))) + (- 1))
874                  ,10)
875         else 0
876         fi
877     fi .
878
879  eq highestVarTerm(F[TL:GTermList])
880   = highestVar(TL:GTermList,0) .
881
882  op highestVar : GTermList Nat -> Nat .
883  eq highestVar(empty,N)
884   = N .
885  eq highestVar((Ct,TL:GTermList),N)
886   = highestVar(TL:GTermList,
887       if highestVarTerm(Ct) > N then highestVarTerm(Ct) else N fi
888     ) .
889  eq highestVar((T,TL:GTermList),N)
890   = highestVar(TL:GTermList,
891       if highestVarTerm(T) > N then highestVarTerm(T) else N fi
892     ) .
893
894  --- For substitutions
895  op highestVar : Substitution -> Nat . --- [memo] .
896  eq highestVar(Subst)
897   = highestVar(Subst,0) .
898
899  op highestVar : Substitution Nat -> Nat .
900  eq highestVar((none).Substitution,N) = N .
901  eq highestVar(V <- T ; Subst,N)
902   = highestVar(Subst,highestVar((T,V),N)) .
903
904  --- Renaming ------------------------------------------------------
905  op newVar : Nat TypeList -> TermList .
906  eq newVar(N,nil) = empty .
907  eq newVar(N,TP TPL) = (newVar*(N,TP),newVar(s(N),TPL)) .
908
909  op newVar* : Nat Type -> Variable .
910  eq newVar*(N,TP)
911   = qid("#" + string(N,10) + ":" + string(TP)) .
912
913  op simplifyVars : TermList -> TermList .
914  eq simplifyVars(TL) = TL << 0 < .
915
916  op _<<`(_`)< : TermList GTermList -> TermList .
917  eq X:TermList <<(TL:GTermList)<
918   = X:TermList << highestVar(TL:GTermList) + 1 < .
919
920  op _<<_ : TermList UnificationPair -> TermList .
921  eq TL << {Subst,N} = TL << Subst .
922
923  op _<<_ : TermList UnificationTriple -> TermList .
924  eq TL << {Subst,Subst',N} = TL << (Subst ; Subst') .
925
926  op _<<_ : Substitution UnificationTriple -> Substitution .
927  eq S:Substitution << {Subst,Subst',N} = S:Substitution << (Subst ; Subst') .
928
929  op _<<_< : TermList Nat -> TermList .
930  eq TL << N < = TL << (TL << { none, N } <) .
931
932  op _<<_< : TermList UnificationPair -> UnificationPair . ***Huge [memo] .
933  eq C << {S,N} < = {S,N} .
934  eq F[TL] << {S,N} < = TL << {S,N} < .
935  eq V << {S,N} <
936   = if not (dom S inVars V)
937     then {S ; V <- newVar(N,getType(V)), N + 1}
938     else {S,N}
939     fi .
940
941  eq (T,TL:NeTermList) << {S,N} <
942   = TL:NeTermList << (T << {S,N} < ) < .
943  eq empty << {S,N} <
944   = {S,N} .
945
946endfm
947
948fmod SUBSTITUTIONSET is
949  protecting SUBSTITUTION-HANDLING .
950  protecting META-LEVEL-MNPA .
951  protecting TERMSET .
952  protecting RENAMING .
953
954  sort SubstitutionSet NeSubstitutionSet .
955  subsort Substitution < NeSubstitutionSet < SubstitutionSet .
956  op empty : -> SubstitutionSet [ctor] .
957  op _|_ : SubstitutionSet SubstitutionSet -> SubstitutionSet
958    [ctor assoc comm id: empty format (d n d d)] .
959  op _|_ : NeSubstitutionSet SubstitutionSet -> NeSubstitutionSet
960    [ctor ditto] .
961  eq X:Substitution | X:Substitution = X:Substitution .
962
963  vars SS SS' : SubstitutionSet .
964  vars S S' Subst : Substitution .
965  vars T T' : Term .
966  vars TL TL' : TermList .
967  vars N N' : Nat .
968  var V : Variable .
969
970  op _<<_ : Substitution SubstitutionSet -> SubstitutionSet .
971  eq S << empty = empty .
972  ceq S << (S' | SS') = (S << S') | (S << SS') if SS' =/= empty .
973
974  op _..._ : SubstitutionSet [SubstitutionSet]
975          -> SubstitutionSet [strat (1) gather (e E)] .
976
977  eq empty ... SS':[SubstitutionSet] = empty .
978  eq (S | SS) ... SS':[SubstitutionSet]
979   = (S ...' SS':[SubstitutionSet])
980     |
981     (SS ... SS':[SubstitutionSet]) .
982
983  op _...'_ : Substitution SubstitutionSet -> SubstitutionSet .
984
985  eq S ...' empty
986   = empty .
987
988  eq S ...' (S' | SS')
989   = (S .. S')
990     |
991     (S ...' SS') .
992
993  op _|>_ : SubstitutionSet TermList -> SubstitutionSet .
994  eq (empty).SubstitutionSet |> TL = empty .
995  eq (S | SS:NeSubstitutionSet) |> TL
996   = (S |> TL) | (SS:NeSubstitutionSet |> TL) .
997
998  op _|>_ : SubstitutionSet Nat -> SubstitutionSet .
999  eq SS:NeSubstitutionSet |> N
1000   = SS:NeSubstitutionSet |> (0,N) .
1001
1002  op _|>`(_,_`) : SubstitutionSet Nat Nat -> SubstitutionSet .
1003  eq (empty).SubstitutionSet |> (N,N') = empty .
1004  eq (S | SS:NeSubstitutionSet) |> (N,N')
1005   = (S |> (N,N')) | (SS:NeSubstitutionSet |> (N,N')) .
1006
1007  op _|>`(_,_`) : Substitution Nat Nat -> Substitution .
1008  eq none |> (N,N') = none .
1009  eq ((V <- T') ; Subst) |> (N,N')
1010   = if N <= highestVar(V) and highestVar(V) <= N'
1011     then (V <- T')
1012     else none
1013     fi
1014     ; (Subst |> (N,N')) .
1015
1016  op filter_by!InVars_ : SubstitutionSet TermList -> SubstitutionSet .
1017  eq filter (empty).SubstitutionSet by!InVars TL
1018   = (empty).SubstitutionSet .
1019  eq filter (S | SS) by!InVars TL
1020   = if dom S inVars TL
1021     then empty
1022     else S
1023     fi
1024     | filter SS by!InVars TL .
1025
1026  op _==* none : SubstitutionSet -> Bool .
1027  eq (none | SS) ==* none = SS ==* none .
1028  eq (empty).SubstitutionSet ==* none = true .
1029  eq SS ==* none = false [owise] .
1030
1031  op |_| : SubstitutionSet -> Nat .
1032  eq | (empty).SubstitutionSet | = 0 .
1033  eq | (S | SS) | = s(| SS |) .
1034
1035endfm
1036
1037fmod UNIFICATIONPAIRSET is
1038  protecting SUBSTITUTIONSET .
1039  protecting RENAMING .
1040  protecting UNIFICATIONTRIPLE .
1041
1042  vars V V' : Variable .
1043  vars U U' : UnificationPair .
1044  vars US US' : UnificationPairSet .
1045  vars S S' S1 S1' S2 S2' : Substitution .
1046  var SS : SubstitutionSet .
1047  vars N N' N1 N2 : Nat .
1048  vars T T' : Term .
1049  var TL : TermList .
1050  var M : Module .
1051
1052  --- Combine UnificationPair ---------------------------------------------
1053  op _.._ : UnificationPair UnificationPair -> UnificationPair .
1054  eq {S,N} .. {S',N'} = {S .. S',max(N,N')} .
1055
1056  --- Detect used variables ----------------------------------------------
1057  op dom_inVars_ : UnificationPair TermList -> Bool . --- [memo] .
1058  eq dom {S,N} inVars TL = dom S inVars TL .
1059
1060  --- UnificationPairSet --------------------------------------------------
1061  sort UnificationPairSet .
1062  subsort UnificationPair < UnificationPairSet .
1063  op empty : -> UnificationPairSet [ctor] .
1064  op _|_ : UnificationPairSet UnificationPairSet -> UnificationPairSet
1065    [ctor assoc comm id: empty format (d n d d)] .
1066  eq X:UnificationPair | X:UnificationPair = X:UnificationPair .
1067
1068  op _..._ : UnificationPairSet [UnificationPairSet]
1069          -> UnificationPairSet [strat (1) gather (e E)] .
1070
1071  eq (empty).UnificationPairSet ... US':[UnificationPairSet]
1072   = (empty).UnificationPairSet .
1073  eq (U | US) ... US':[UnificationPairSet]
1074   = (U ...' US':[UnificationPairSet])
1075     |
1076     (US ... US':[UnificationPairSet]) .
1077
1078  op _...'_ : UnificationPair UnificationPairSet -> UnificationPairSet .
1079
1080  eq U ...' (empty).UnificationPairSet
1081   = (empty).UnificationPairSet .
1082
1083  eq U ...' (U' | US')
1084   = (U .. U')
1085     |
1086     (U ...' US') .
1087
1088  --- Restriction -----------------------
1089  op _|>_ : UnificationPairSet TermList -> UnificationPairSet .
1090  eq (empty).UnificationPairSet |> TL = empty .
1091  eq ({S,N} | US) |> TL = {(S |> TL),N} | (US |> TL) .
1092
1093  op filter_by!InVars_ : UnificationPairSet TermList
1094                      -> UnificationPairSet .
1095  eq filter (empty).UnificationPairSet by!InVars TL
1096   = (empty).UnificationPairSet .
1097  eq filter (U | US) by!InVars TL
1098   = if dom U inVars TL
1099     then empty
1100     else U
1101     fi
1102     | filter US by!InVars TL .
1103
1104  op toUnificationPair[_]`(_`) : Nat SubstitutionSet -> UnificationPairSet .
1105  eq toUnificationPair[N](empty)
1106   = empty .
1107  eq toUnificationPair[N](S | SS)
1108   = {S,highestVar(S,N)}
1109     | toUnificationPair[N](SS) .
1110
1111  op toSubstitution : UnificationPairSet -> SubstitutionSet .
1112  eq toSubstitution((empty).UnificationPairSet)
1113   = empty .
1114  eq toSubstitution({S,N} | US)
1115   = S | toSubstitution(US) .
1116
1117  op _in_ : UnificationPair UnificationPairSet -> Bool .
1118  eq X:UnificationPair in (X:UnificationPair | XS:UnificationPairSet) = true .
1119  eq X:UnificationPair in XS:UnificationPairSet = false [owise] .
1120
1121endfm
1122
1123fmod UNIFICATIONTRIPLESET is
1124  protecting SUBSTITUTIONSET .
1125  protecting RENAMING .
1126  protecting UNIFICATIONPAIRSET .
1127
1128  vars V V' : Variable .
1129  var C : Constant .
1130  var F : Qid .
1131  vars U U' : UnificationTriple .
1132  vars US US' : UnificationTripleSet .
1133  vars S S' S1 S1' S2 S2' : Substitution .
1134  var SS : SubstitutionSet .
1135  var SSe : NeSubstitutionSet .
1136  vars N N' N1 N2 NextVar : Nat .
1137  vars T T' : Term .
1138  var TL : TermList .
1139  var NeTL : NeTermList .
1140  var M : Module .
1141  var UPS : UnificationPairSet .
1142
1143  --- Combine UnificationPair ---------------------------------------------
1144  op _.._ : UnificationTriple UnificationTriple -> UnificationTriple .
1145  eq {S1,S1',N1} .. {S2,S2',N2} = {S1 .. S2,S1' .. S2',max(N1,N2)} .
1146
1147  --- UnificationPairSet --------------------------------------------------
1148  sort UnificationTripleSet .
1149  subsort UnificationTriple < UnificationTripleSet .
1150  op empty : -> UnificationTripleSet [ctor] .
1151  op _|_ : UnificationTripleSet UnificationTripleSet
1152        -> UnificationTripleSet
1153    [ctor assoc comm id: empty format (d n d d)] .
1154  eq X:UnificationTriple | X:UnificationTriple = X:UnificationTriple .
1155
1156  op _..._ : UnificationTripleSet [UnificationTripleSet]
1157          -> UnificationTripleSet [strat (1) gather (e E)] .
1158
1159  eq (empty).UnificationTripleSet ... US':[UnificationTripleSet]
1160   = (empty).UnificationTripleSet .
1161  eq (U | US) ... US':[UnificationTripleSet]
1162   = (U ...' US':[UnificationTripleSet])
1163     |
1164     (US ... US':[UnificationTripleSet]) .
1165
1166  op _...'_ : UnificationTriple UnificationTripleSet
1167           -> UnificationTripleSet .
1168
1169  eq U ...' (empty).UnificationTripleSet
1170   = (empty).UnificationTripleSet .
1171
1172  eq U ...' (U' | US')
1173   = (U .. U')
1174     |
1175     (U ...' US') .
1176
1177  --- convert  -----------------------------------------------------
1178  op split : UnificationPair Nat -> UnificationTriple .
1179  eq split({none,N},N') = {none,none,N} .
1180  eq split({(V <- T') ; S,N},N')
1181   = if highestVar(V) < N'
1182     then {(V <- T'),none,N}
1183     else {none,(V <- T'),N}
1184     fi
1185     .. split({S,N},N') .
1186
1187  op split : UnificationPairSet Term Term -> UnificationTripleSet .
1188  eq split(empty,T,T') = empty .
1189  eq split({S,N} | UPS,T,T') = {S |> T, S |> T',N} | split(UPS,T,T') .
1190
1191  op toUnificationTriple[_]`(_`) :
1192             Nat SubstitutionSet -> UnificationTripleSet .
1193  eq toUnificationTriple[N](SS)
1194   = toUnificationTriple*[N](SS,empty) .
1195
1196  op toUnificationTriple*[_]`(_,_`) :
1197             Nat SubstitutionSet
1198             UnificationTripleSet -> UnificationTripleSet .
1199  eq toUnificationTriple*[N](empty,US)
1200   = US .
1201  eq toUnificationTriple*[N](S | SS,US)
1202   = toUnificationTriple*[N](SS, US | {none,S,highestVar(S,N)}) .
1203
1204  op toUnificationTriple[_,_]`(_`) :
1205             Nat Nat SubstitutionSet -> UnificationTripleSet .
1206  eq toUnificationTriple[NextVar,N](SS)
1207   = toUnificationTriple*[NextVar,N](SS,empty) .
1208
1209  op toUnificationTriple*[_,_]`(_,_`) :
1210             Nat Nat SubstitutionSet
1211             UnificationTripleSet -> UnificationTripleSet .
1212  eq toUnificationTriple*[NextVar,N](empty,US)
1213   = US .
1214  eq toUnificationTriple*[NextVar,N](S | SS,US)
1215   = toUnificationTriple*[NextVar,N](SS,
1216             US | split({S,highestVar(S,N)},NextVar)) .
1217
1218  op toUnificationTriple[_,_,_]`(_`) :
1219             Term Term Nat SubstitutionSet -> UnificationTripleSet .
1220  eq toUnificationTriple[T,T',N](SS)
1221   = toUnificationTriple*[T,T',N](SS,empty) .
1222
1223  op toUnificationTriple*[_,_,_]`(_,_`) :
1224             Term Term Nat SubstitutionSet
1225             UnificationTripleSet -> UnificationTripleSet .
1226  eq toUnificationTriple*[T,T',N](empty,US)
1227   = US .
1228  eq toUnificationTriple*[T,T',N](S | SS,US)
1229   = toUnificationTriple*[T,T',N](SS, US | {S |> T,S |> T',highestVar(S,N)}) .
1230
1231  op toSubstitution : UnificationTripleSet -> SubstitutionSet .
1232  eq toSubstitution(US)
1233   = toSubstitution*(US,empty) .
1234
1235  op toSubstitution* : UnificationTripleSet
1236                       SubstitutionSet -> SubstitutionSet .
1237  eq toSubstitution*((empty).UnificationTripleSet,SS)
1238   = SS .
1239  eq toSubstitution*({S,S',N} | US,SS)
1240   = toSubstitution*(US,SS | (S ; S')) .
1241
1242  op _in_ : UnificationTriple UnificationTripleSet -> Bool .
1243  eq X:UnificationTriple
1244     in (X:UnificationTriple | XS:UnificationTripleSet) = true .
1245  eq X:UnificationTriple in XS:UnificationTripleSet = false [owise] .
1246
1247  --- restriction ---------------------------------------------------
1248  op _|>_ : UnificationTripleSet TermList -> UnificationTripleSet .
1249  eq US |> TL
1250   = US *|> TL [empty] .
1251
1252  op _*|>_[_] : UnificationTripleSet TermList
1253               UnificationTripleSet -> UnificationTripleSet .
1254  eq (empty).UnificationTripleSet *|> TL [US']
1255   = US' .
1256  eq ({S,S',N} | US) *|> TL [US']
1257   = US *|> TL [US' | {(S |> TL),(S' |> TL),N} ] .
1258
1259  op _filterBy_ : UnificationTripleSet Nat -> UnificationTripleSet .
1260  eq US filterBy NextVar
1261   = US filterBy* NextVar [empty] .
1262
1263  op _filterBy*_[_] : UnificationTripleSet Nat
1264                     UnificationTripleSet -> UnificationTripleSet .
1265  eq empty filterBy* NextVar [US']
1266   = US' .
1267  eq ({S,S',N} | US) filterBy* NextVar [US']
1268   = US filterBy* NextVar
1269     [US' | if S instantiatesAbove NextVar then empty else {S,S',N} fi ] .
1270endfm
1271
1272fmod MODULE-HANDLING is
1273  protecting INT .
1274  protecting META-LEVEL-MNPA .
1275  protecting EXT-BOOL . *** From Full Maude
1276  protecting SUBSTITUTION-HANDLING .
1277  protecting UNIFICATIONTRIPLESET .
1278
1279  var T T' T'' T1 T2 Lhs Rhs : Term .
1280  var C C' : Constant .
1281  var QIL : QidList .
1282  var N N' : Nat .
1283  var NL NL' : NatList .
1284  var Q F F' : Qid .
1285  vars AtS AtS' : AttrSet .
1286  var EqS : EquationSet .
1287  var Eq : Equation .
1288  var RlS : RuleSet .
1289  var Rl : Rule .
1290  var Cond : Condition .
1291  var TP TP' : Type .
1292  var TPL TPL' : TypeList .
1293  ---var TPL TPL' : ETypeList .
1294  ---var ET ET' : EType .
1295  var VDS OPDS : OpDeclSet .
1296  var OPD : OpDecl .
1297  var M : Module .
1298  var TL TL' TL'' : TermList .
1299  var B : Bool .
1300  var V V' : Variable .
1301  var I  : Int .
1302  vars S S' : Substitution .
1303  var US : UnificationTripleSet .
1304
1305  *** canonice  ******************************
1306  op canonice : Module Term -> Term .
1307---  eq canonice(M,T) = getTerm(metaReduce(eraseRls(eraseEqs(M)),T)) .
1308  eq canonice(M,T) = getTerm(metaNormalize(M,T)) .
1309
1310  op canonice : Module Substitution -> Substitution .
1311  eq canonice(M,(none).Substitution) = none .
1312  eq canonice(M,V <- T ; S) = V <- canonice(M,T) ; canonice(M,S)  .
1313
1314  op canonice : Module UnificationTripleSet -> UnificationTripleSet .
1315  eq canonice(M,(empty).UnificationTripleSet) = (empty).UnificationTripleSet .
1316  eq canonice(M,{S,S',N} | US) = {canonice(M,S),canonice(M,S'),N} | canonice(M,US) .
1317
1318
1319  *** normalize  ******************************
1320  op normalize : Module Term -> Term .
1321  eq normalize(M,T) = getTerm(metaReduce(eraseRls(M),T)) .
1322
1323  op normalize : Module Substitution -> Substitution .
1324  eq normalize(M,(none).Substitution) = none .
1325  eq normalize(M,V <- T ; S) = V <- normalize(M,T) ; normalize(M,S)  .
1326
1327  *** normalizeRls  ******************************
1328  op normalizeRls : Module Term -> Term .
1329  eq normalizeRls(M,T) = getTerm(metaReduce(rls2eqs(M),T)) .
1330
1331  op normalizeRls : Module Substitution -> Substitution .
1332  eq normalizeRls(M,(none).Substitution) = none .
1333  eq normalizeRls(M,V <- T ; S) = V <- normalizeRls(M,T) ; normalizeRls(M,S)  .
1334
1335  *** typeLeq **************************************************
1336  op typeLeq : Module TypeList TypeList ~> Bool [memo] .
1337
1338  eq typeLeq(M,TP:Sort TPL,TP':Sort TPL')
1339   = sortLeq(M,TP:Sort,TP':Sort) and typeLeq(M,TPL,TPL') .
1340  eq typeLeq(M,TP:Sort TPL,TP':Kind TPL')
1341   = getKind(M,TP:Sort) == TP':Kind
1342     and typeLeq(M,TPL,TPL') .
1343  eq typeLeq(M,TP:Kind TPL,TP':Sort TPL')
1344   = false .
1345  eq typeLeq(M,TP:Kind TPL,TP':Kind TPL')
1346   = TP:Kind == TP':Kind and typeLeq(M,TPL,TPL') .
1347  eq typeLeq(M,nil,nil)
1348   = true .
1349
1350  *** getTypes **************************************************
1351  op getTypes : Module TermList -> TypeList . ---Memo is huge
1352  eq getTypes(M, (T, TL)) = leastSort(M, T) getTypes(M, TL) .
1353  eq getTypes(M, empty) = nil .
1354
1355  *** getFrozen ************************************************
1356  op getFrozen : Module Qid TypeList -> NatList [memo] .
1357  eq getFrozen(M,F,TPL) = getFrozen(getOpsOfQid(M,F,TPL)) .
1358
1359  op getFrozen : OpDeclSet -> NatList .
1360  eq getFrozen((op F : TPL -> TP [frozen(NL) AtS] .) OPDS) = NL .
1361  eq getFrozen(OPDS) = 0 [owise] .
1362
1363  *** inNatList ************************************************
1364  op _inNatList_ : Nat NatList -> Bool .
1365  eq N inNatList (NL N NL') = true .
1366  eq N inNatList NL = false [owise] .
1367
1368  *** membership ************************************************
1369  op _in_ : Type TypeList ~> Bool .
1370  eq TP in (TPL TP TPL') = true .
1371  eq TP in TPL = false [owise] .
1372
1373  *** isConstructor  ******************************
1374  op isConstructor : Module Term -> Bool .
1375  op isConstructor : Module Qid TypeList -> Bool [memo] .
1376  op isConstructor : OpDeclSet -> Bool .
1377
1378  eq isConstructor(M,V) = false .
1379  eq isConstructor(M,C) = isConstructor(M,C,nil) .
1380  eq isConstructor(M,F[TL]) = isConstructor(M,F,getTypes(M,TL)) .
1381
1382  eq isConstructor(M,F,TPL)
1383   = getEqsOfQid(M,F,TPL) == none or-else isConstructor(getOpsOfQid(M,F,TPL)) .
1384
1385  eq isConstructor((op F : TPL -> TP [ctor AtS] .) OPDS) = true .
1386  eq isConstructor(OPDS) = false [owise] .
1387
1388  *** getOpsOfType ***********************************************
1389  op getOpsOfType : Module Type -> OpDeclSet [memo] .
1390  op getOpsOfType : Module OpDeclSet Type -> OpDeclSet .
1391
1392  eq getOpsOfType(M,TP) = getOpsOfType(M,getOps(M),TP) .
1393
1394  eq getOpsOfType(M,((op F : TPL -> TP [AtS] .) OPDS),TP')
1395    = if TP == TP'
1396      then (op F : TPL -> TP [AtS] .)
1397           getOpsOfType(M,OPDS,TP')
1398      else getOpsOfType(M,OPDS,TP')
1399      fi .
1400
1401  eq getOpsOfType(M,OPDS,TP)
1402   = none
1403     [owise] .
1404
1405  *** getOpsOfQid ***********************************************
1406  op getOpsOfQid : Module Qid -> OpDeclSet [memo] .
1407  op getOpsOfQid : Module Qid TypeList -> OpDeclSet [memo] .
1408  op getOpsOfQid : Module OpDeclSet Qid -> OpDeclSet .
1409  op getOpsOfQid : Module OpDeclSet Qid TypeList -> OpDeclSet .
1410
1411  eq getOpsOfQid(M,F)
1412   = getOpsOfQid(M,getOps(M),F) .
1413
1414  eq getOpsOfQid(M,F,TPL)
1415   = if getOpsOfQid(M,getOps(M),F,TPL) =/= none
1416     then getOpsOfQid(M,getOps(M),F,TPL)
1417     else getOpsOfQid(M,getOps(M),F,restrict TPL To 2)
1418     fi .
1419
1420  eq getOpsOfQid(M,((op F : TPL -> TP [AtS] .) OPDS),F)
1421    = (op F : TPL -> TP [AtS] .)
1422      getOpsOfQid(M,OPDS,F) .
1423
1424  eq getOpsOfQid(M,OPDS,F')
1425   = none
1426     [owise] .
1427
1428  eq getOpsOfQid(M,((op F : TPL -> TP [AtS] .) OPDS),F,TPL')
1429    = if eSameKind(M,TPL,TPL')
1430      then (op F : TPL -> TP [AtS] .)
1431           getOpsOfQid(M,OPDS,F,TPL')
1432      else getOpsOfQid(M,OPDS,F,TPL')
1433      fi .
1434
1435  eq getOpsOfQid(M,OPDS,F',TPL')
1436   = none
1437     [owise] .
1438
1439  op restrict_To_ : TypeList Nat -> TypeList .
1440  eq restrict nil To NL = nil .
1441  eq restrict TPL To 0 = nil .
1442  eq restrict (TP,TPL) To s(N) = (TP, restrict TPL To N) .
1443
1444  *** getOpsOfEqs ******************************************************
1445  op getOpsOfEqs : EquationSet -> QidList [memo] .
1446  eq getOpsOfEqs((eq C = T' [AtS] .) EqS )
1447   = C getOpsOfEqs(EqS) .
1448  eq getOpsOfEqs((eq F[TL] = T' [AtS] .) EqS )
1449   = F getOpsOfEqs(EqS) .
1450  eq getOpsOfEqs((none).EquationSet)
1451   = nil .
1452
1453  *** getEqsOfQid ******************************************************
1454  op getEqsOfQid : Module Qid TypeList -> EquationSet [memo] .
1455  op getEqsOfQid : Module Qid TypeList EquationSet -> EquationSet .
1456
1457  eq getEqsOfQid(M, F,TPL) = getEqsOfQid(M, F, TPL, getEqs(M)) .
1458
1459  ceq getEqsOfQid(M, F, TPL, (eq C = T' [AtS] .) EqS )
1460   = (eq C = T' [AtS] .) getEqsOfQid(M, F, TPL, EqS)
1461   if F == C .
1462  ceq getEqsOfQid(M, F, TPL, (eq F[TL] = T' [AtS] .) EqS )
1463   = (eq F[TL] = T' [AtS] .) getEqsOfQid(M, F, TPL, EqS)
1464   if eSameKind(M,getTypes(M,TL),TPL) .
1465  ceq getEqsOfQid(M, F, TPL, (ceq C = T' if Cond [AtS] .) EqS )
1466   = (ceq C = T' if Cond [AtS] .) getEqsOfQid(M, F, TPL, EqS)
1467   if F == C .
1468  ceq getEqsOfQid(M, F, TPL, (ceq F[TL] = T' if Cond [AtS] .) EqS )
1469   = (ceq F[TL] = T' if Cond [AtS] .) getEqsOfQid(M, F, TPL, EqS)
1470   if eSameKind(M,getTypes(M,TL),TPL) .
1471  eq getEqsOfQid(M, F, TPL, Eq EqS )
1472   = getEqsOfQid(M, F, TPL, EqS) [owise] .
1473  eq getEqsOfQid(M, F, TPL, (none).EquationSet )
1474   = (none).EquationSet .
1475
1476  *** getTypesOfQid  ****************************************
1477  op getTypesOfQid : Module Qid TypeList -> TypeSet [memo] .
1478  op getTypesOfQid : OpDeclSet -> TypeSet .
1479
1480  eq getTypesOfQid(M,F,TPL) = getTypesOfQid(getOpsOfQid(M,F,TPL)) .
1481  eq getTypesOfQid((op F : TPL -> TP [AtS] .) OPDS)
1482   = TP ; getTypesOfQid(OPDS) .
1483  eq getTypesOfQid((none).OpDeclSet) = (none).TypeSet .
1484
1485  *** filterConstructorSymbols ************************************
1486  op filterConstructorSymbols : OpDeclSet -> OpDeclSet .
1487  eq filterConstructorSymbols(((op F : TPL -> TP [AtS] .) OPDS))
1488    = if isConstructor((op F : TPL -> TP [AtS] .) none)
1489      then (op F : TPL -> TP [AtS] .)
1490           filterConstructorSymbols(OPDS)
1491      else filterConstructorSymbols(OPDS)
1492      fi .
1493  eq filterConstructorSymbols(none)
1494    = none .
1495
1496  *** filterDefinedSymbols *****************************************
1497  op filterDefinedSymbols : OpDeclSet -> OpDeclSet .
1498  eq filterDefinedSymbols(((op F : TPL -> TP [ctor AtS] .) OPDS))
1499    = filterDefinedSymbols(OPDS) .
1500  eq filterDefinedSymbols(((op F : TPL -> TP [AtS] .) OPDS))
1501    = (op F : TPL -> TP [AtS] .) filterDefinedSymbols(OPDS) [owise] .
1502  eq filterDefinedSymbols(none)
1503    = none .
1504
1505  *** isCommutative ******************************
1506  op isCommutative : Module Term -> Bool .
1507  op isCommutative : Module Qid TypeList -> Bool [memo] .
1508  op isCommutative : OpDeclSet -> Bool .
1509
1510  eq isCommutative(M,V) = false .
1511  eq isCommutative(M,C) = false .
1512  eq isCommutative(M,F[TL]) = isCommutative(M,F,getTypes(M,TL)) .
1513
1514  eq isCommutative(M,F,TPL) = isCommutative(getOpsOfQid(M,F,TPL)) .
1515
1516  eq isCommutative((op F : TPL -> TP [comm AtS] .) OPDS) = true .
1517  eq isCommutative(OPDS) = false [owise] .
1518
1519  *** isAssociative ******************************
1520  op isAssociative : Module Term -> Bool .
1521  op isAssociative : Module Qid TypeList -> Bool [memo] .
1522  op isAssociative : OpDeclSet -> Bool .
1523
1524  eq isAssociative(M,V) = false .
1525  eq isAssociative(M,C) = false .
1526  eq isAssociative(M,F[TL]) = isAssociative(M,F,getTypes(M,TL)) .
1527
1528  eq isAssociative(M,F,TPL) = isAssociative(getOpsOfQid(M,F,TPL)) .
1529
1530  eq isAssociative((op F : TPL -> TP [assoc AtS] .) OPDS) = true .
1531  eq isAssociative(OPDS) = false [owise] .
1532
1533  *** getIdSymbol ******************************
1534  op getIdSymbol : Module Term ~> Term .
1535  eq getIdSymbol(M,F[TL]) = getIdSymbol(M,F,getTypes(M,TL)) .
1536
1537  op getIdSymbol : Module Qid TypeList ~> Term [memo] .
1538  eq getIdSymbol(M,F,TPL) = getIdSymbol(getOpsOfQid(M,F,TPL)) .
1539
1540  op getIdSymbol : OpDeclSet ~> Term .
1541  eq getIdSymbol((op F : TPL -> TP [id(T) AtS] .) OPDS) = T .
1542
1543  op getLeftIdSymbol : Module Term ~> Term .
1544  eq getLeftIdSymbol(M,F[TL]) = getLeftIdSymbol(M,F,getTypes(M,TL)) .
1545
1546  op getLeftIdSymbol : Module Qid TypeList ~> Term .
1547  eq getLeftIdSymbol(M,F,TPL) = getLeftIdSymbol(getOpsOfQid(M,F,TPL)) .
1548
1549  op getLeftIdSymbol : OpDeclSet ~> Term .
1550  eq getLeftIdSymbol((op F : TPL -> TP [left-id(T) AtS] .) OPDS) = T .
1551
1552  op getRightIdSymbol : Module Term ~> Term .
1553  eq getRightIdSymbol(M,F[TL]) = getRightIdSymbol(M,F,getTypes(M,TL)) .
1554
1555  op getRightIdSymbol : Module Qid TypeList ~> Term .
1556  eq getRightIdSymbol(M,F,TPL) = getRightIdSymbol(getOpsOfQid(M,F,TPL)) .
1557
1558  op getRightIdSymbol : OpDeclSet ~> Term .
1559  eq getRightIdSymbol((op F : TPL -> TP [right-id(T) AtS] .) OPDS) = T .
1560
1561  *** anyIdSymbol ******************************
1562  op anyIdSymbol : Module Term -> Bool .
1563  eq anyIdSymbol(M,C:Constant)
1564   = false .
1565  eq anyIdSymbol(M,V:Variable)
1566   = false .
1567  eq anyIdSymbol(M,F:Qid[TL:TermList])
1568   = getIdSymbol(M,F:Qid[TL:TermList]) :: Term
1569     or-else
1570     anyIdSymbol*(M,TL:TermList) .
1571
1572  op anyIdSymbol* : Module TermList -> Bool .
1573  eq anyIdSymbol*(M,empty)
1574   = false .
1575  eq anyIdSymbol*(M,(T:Term,TL:TermList))
1576   = anyIdSymbol(M,T:Term)
1577     or-else
1578     anyIdSymbol*(M,TL:TermList) .
1579
1580  ****
1581  op anyIdSymbol : Module Substitution -> Bool .
1582  eq anyIdSymbol(M,(none).Substitution) = false .
1583  eq anyIdSymbol(M,V:Variable <- T:Term ; S:Substitution)
1584   = anyIdSymbol(M,T:Term)
1585     or-else
1586     anyIdSymbol(M,S:Substitution) .
1587
1588  *** eSameKind ******************************
1589  op eSameKind : Module TypeList TypeList -> Bool [memo] .
1590  eq eSameKind(M,TP TPL, TP' TPL')
1591   = sameKind(M,TP,TP') and eSameKind(M,TPL,TPL') .
1592  eq eSameKind(M,nil,nil) = true .
1593  eq eSameKind(M,TPL,nil) = true .
1594  eq eSameKind(M,nil,TPL') = true .
1595  ---eq eSameKind(M,TPL,TPL') = false [owise] .
1596
1597  *** eqs2rls *******************************
1598  sort EqSet&RlsSet .
1599  op {_,_} : EquationSet RuleSet -> EqSet&RlsSet .
1600  op getEqs : EqSet&RlsSet -> EquationSet .
1601  eq getEqs({EqS,RlS}) = EqS .
1602  op getRls : EqSet&RlsSet -> RuleSet .
1603  eq getRls({EqS,RlS}) = RlS .
1604
1605  op eqs2rls# : EquationSet -> EqSet&RlsSet [memo] .
1606  eq eqs2rls#(none) = {none,none} .
1607  eq eqs2rls#((eq Lhs = Rhs [AtS] .) EqS)
1608   = {getEqs(eqs2rls#(EqS)),
1609      (rl Lhs => Rhs [AtS] .) getRls(eqs2rls#(EqS))
1610     } .
1611  eq eqs2rls#((ceq Lhs = Rhs if Cond [AtS] .) EqS)
1612   = {getEqs(eqs2rls#(EqS)),
1613      (crl Lhs => Rhs if Cond [AtS] .) getRls(eqs2rls#(EqS))
1614     } .
1615
1616  op eqs2rls : SModule -> SModule .
1617  eq eqs2rls(
1618      mod Q:Qid is
1619       IL:ImportList
1620       sorts S:SortSet .
1621       S:SubsortDeclSet
1622       O:OpDeclSet
1623       M:MembAxSet
1624       E:EquationSet
1625       R:RuleSet
1626      endm)
1627   = mod (addsufix '-EQS2RLS To Q:Qid) is
1628       IL:ImportList
1629       sorts S:SortSet .
1630       S:SubsortDeclSet
1631       O:OpDeclSet
1632       M:MembAxSet
1633       getEqs(eqs2rls#(E:EquationSet))
1634       getRls(eqs2rls#(E:EquationSet))
1635     endm .
1636
1637  op eqs2rls : FModule -> FModule .
1638  eq eqs2rls(
1639      fmod Q:Qid is
1640       IL:ImportList
1641       sorts S:SortSet .
1642       S:SubsortDeclSet
1643       O:OpDeclSet
1644       M:MembAxSet
1645       E:EquationSet
1646      endfm)
1647   = mod (addsufix '-EQS2RLS To Q:Qid) is
1648       IL:ImportList
1649       sorts S:SortSet .
1650       S:SubsortDeclSet
1651       O:OpDeclSet
1652       M:MembAxSet
1653       getEqs(eqs2rls#(E:EquationSet))
1654       getRls(eqs2rls#(E:EquationSet))
1655     endm .
1656
1657  op eqsNoBuiltInUnify2rls : SModule -> SModule .
1658  eq eqsNoBuiltInUnify2rls(
1659      mod Q:Qid is
1660       IL:ImportList
1661       sorts S:SortSet .
1662       S:SubsortDeclSet
1663       O:OpDeclSet
1664       M:MembAxSet
1665       E:EquationSet
1666       R:RuleSet
1667      endm)
1668   = mod (addsufix '-EQS2RLS To Q:Qid) is
1669       IL:ImportList
1670       sorts S:SortSet .
1671       S:SubsortDeclSet
1672       O:OpDeclSet
1673       M:MembAxSet
1674       (getEqs(eqs2rls#(getEqsNoBuiltInUnify(E:EquationSet))) getEqsBuiltInUnify(E:EquationSet))
1675       getRls(eqs2rls#(getEqsNoBuiltInUnify(E:EquationSet)))
1676     endm .
1677
1678  op eqsNoBuiltInUnify2rls : FModule -> SModule .
1679  eq eqsNoBuiltInUnify2rls(
1680      fmod Q:Qid is
1681       IL:ImportList
1682       sorts S:SortSet .
1683       S:SubsortDeclSet
1684       O:OpDeclSet
1685       M:MembAxSet
1686       E:EquationSet
1687      endfm)
1688   = mod (addsufix '-EQS2RLS To Q:Qid) is
1689       IL:ImportList
1690       sorts S:SortSet .
1691       S:SubsortDeclSet
1692       O:OpDeclSet
1693       M:MembAxSet
1694       (getEqs(eqs2rls#(getEqsNoBuiltInUnify(E:EquationSet))) getEqsBuiltInUnify(E:EquationSet))
1695       getRls(eqs2rls#(getEqsNoBuiltInUnify(E:EquationSet)))
1696     endm .
1697
1698  op eqsNoVariant2rls : SModule -> SModule .
1699  eq eqsNoVariant2rls(
1700      mod Q:Qid is
1701       IL:ImportList
1702       sorts S:SortSet .
1703       S:SubsortDeclSet
1704       O:OpDeclSet
1705       M:MembAxSet
1706       E:EquationSet
1707       R:RuleSet
1708      endm)
1709   = mod (addsufix '-EQS2RLS To Q:Qid) is
1710       IL:ImportList
1711       sorts S:SortSet .
1712       S:SubsortDeclSet
1713       O:OpDeclSet
1714       M:MembAxSet
1715       (getEqs(eqs2rls#(getEqsNoVariant(E:EquationSet))) getEqsVariant(E:EquationSet))
1716       getRls(eqs2rls#(getEqsNoVariant(E:EquationSet)))
1717     endm .
1718
1719  op eqsNoVariant2rls : FModule -> SModule .
1720  eq eqsNoVariant2rls(
1721      fmod Q:Qid is
1722       IL:ImportList
1723       sorts S:SortSet .
1724       S:SubsortDeclSet
1725       O:OpDeclSet
1726       M:MembAxSet
1727       E:EquationSet
1728      endfm)
1729   = mod (addsufix '-EQS2RLS To Q:Qid) is
1730       IL:ImportList
1731       sorts S:SortSet .
1732       S:SubsortDeclSet
1733       O:OpDeclSet
1734       M:MembAxSet
1735       (getEqs(eqs2rls#(getEqsNoVariant(E:EquationSet))) getEqsVariant(E:EquationSet))
1736       getRls(eqs2rls#(getEqsNoVariant(E:EquationSet)))
1737     endm .
1738
1739  op eqsVariant2rls : SModule -> SModule .
1740  eq eqsVariant2rls(
1741      mod Q:Qid is
1742       IL:ImportList
1743       sorts S:SortSet .
1744       S:SubsortDeclSet
1745       O:OpDeclSet
1746       M:MembAxSet
1747       E:EquationSet
1748       R:RuleSet
1749      endm)
1750   = mod (addsufix '-EQS2RLS To Q:Qid) is
1751       IL:ImportList
1752       sorts S:SortSet .
1753       S:SubsortDeclSet
1754       O:OpDeclSet
1755       M:MembAxSet
1756       (getEqs(eqs2rls#(getEqsVariant(E:EquationSet))) getEqsNoVariant(E:EquationSet))
1757       getRls(eqs2rls#(getEqsVariant(E:EquationSet)))
1758     endm .
1759
1760  op eqsVariant2rls : FModule -> SModule .
1761  eq eqsVariant2rls(
1762      fmod Q:Qid is
1763       IL:ImportList
1764       sorts S:SortSet .
1765       S:SubsortDeclSet
1766       O:OpDeclSet
1767       M:MembAxSet
1768       E:EquationSet
1769      endfm)
1770   = mod (addsufix '-EQS2RLS To Q:Qid) is
1771       IL:ImportList
1772       sorts S:SortSet .
1773       S:SubsortDeclSet
1774       O:OpDeclSet
1775       M:MembAxSet
1776       (getEqs(eqs2rls#(getEqsVariant(E:EquationSet))) getEqsNoVariant(E:EquationSet))
1777       getRls(eqs2rls#(getEqsVariant(E:EquationSet)))
1778     endm .
1779
1780  op removeVariantLabel : SModule -> SModule .
1781  eq removeVariantLabel(
1782      mod Q:Qid is
1783       IL:ImportList
1784       sorts S:SortSet .
1785       S:SubsortDeclSet
1786       O:OpDeclSet
1787       M:MembAxSet
1788       E:EquationSet
1789       R:RuleSet
1790      endm)
1791   = mod (addsufix '-EQSV2EQSNV To Q:Qid) is
1792       IL:ImportList
1793       sorts S:SortSet .
1794       S:SubsortDeclSet
1795       O:OpDeclSet
1796       M:MembAxSet
1797       removeVariantLabel(E:EquationSet)
1798       R:RuleSet
1799      endm .
1800
1801  op removeVariantLabel : FModule -> SModule .
1802  eq removeVariantLabel(
1803      fmod Q:Qid is
1804       IL:ImportList
1805       sorts S:SortSet .
1806       S:SubsortDeclSet
1807       O:OpDeclSet
1808       M:MembAxSet
1809       E:EquationSet
1810      endfm)
1811   = fmod (addsufix '-EQSV2EQSNV To Q:Qid) is
1812       IL:ImportList
1813       sorts S:SortSet .
1814       S:SubsortDeclSet
1815       O:OpDeclSet
1816       M:MembAxSet
1817       removeVariantLabel(E:EquationSet)
1818     endfm .
1819
1820  op removeVariantLabel : EquationSet -> EquationSet .
1821  eq removeVariantLabel((eq Lhs = Rhs [AtS variant] .) EqS)
1822   = (eq Lhs = Rhs [AtS] .)
1823     removeVariantLabel(EqS) .
1824  eq removeVariantLabel(EqS)
1825   = EqS [owise] .
1826
1827  *** getEqsNoBuiltInUnify *******************************
1828  op getEqsNoBuiltInUnify : Module -> EquationSet .
1829  eq getEqsNoBuiltInUnify(
1830      fmod Q:Qid is
1831       IL:ImportList
1832       sorts S:SortSet .
1833       S:SubsortDeclSet
1834       O:OpDeclSet
1835       M:MembAxSet
1836       E:EquationSet
1837      endfm)
1838   = getEqsNoBuiltInUnify(E:EquationSet) .
1839  eq getEqsNoBuiltInUnify(
1840      mod Q:Qid is
1841       IL:ImportList
1842       sorts S:SortSet .
1843       S:SubsortDeclSet
1844       O:OpDeclSet
1845       M:MembAxSet
1846       E:EquationSet
1847       R:RuleSet
1848      endm)
1849   = getEqsNoBuiltInUnify(E:EquationSet) .
1850
1851  op getEqsNoBuiltInUnify : EquationSet -> EquationSet [memo] .
1852  eq getEqsNoBuiltInUnify(none) = none .
1853  eq getEqsNoBuiltInUnify((eq Lhs = Rhs [AtS metadata("builtin-unify")] .) EqS)
1854   = getEqsNoBuiltInUnify(EqS) .
1855  eq getEqsNoBuiltInUnify((eq Lhs = Rhs [AtS] .) EqS)
1856   = (eq Lhs = Rhs [AtS] .) getEqsNoBuiltInUnify(EqS)
1857  [owise] .
1858  eq getEqsNoBuiltInUnify((ceq Lhs = Rhs if Cond [AtS] .) EqS)
1859   = (ceq Lhs = Rhs if Cond [AtS] .) getEqsNoBuiltInUnify(EqS) .
1860
1861  *** getEqsNoVariant *******************************
1862  op getEqsNoVariant : Module -> EquationSet .
1863  eq getEqsNoVariant(
1864      fmod Q:Qid is
1865       IL:ImportList
1866       sorts S:SortSet .
1867       S:SubsortDeclSet
1868       O:OpDeclSet
1869       M:MembAxSet
1870       E:EquationSet
1871      endfm)
1872   = getEqsNoVariant(E:EquationSet) .
1873  eq getEqsNoVariant(
1874      mod Q:Qid is
1875       IL:ImportList
1876       sorts S:SortSet .
1877       S:SubsortDeclSet
1878       O:OpDeclSet
1879       M:MembAxSet
1880       E:EquationSet
1881       R:RuleSet
1882      endm)
1883   = getEqsNoVariant(E:EquationSet) .
1884
1885  op getEqsNoVariant : EquationSet -> EquationSet [memo] .
1886  eq getEqsNoVariant(none) = none .
1887  eq getEqsNoVariant((eq Lhs = Rhs [AtS variant] .) EqS)
1888   = getEqsNoVariant(EqS) .
1889  eq getEqsNoVariant((eq Lhs = Rhs [AtS] .) EqS)
1890   = (eq Lhs = Rhs [AtS] .) getEqsNoVariant(EqS)
1891  [owise] .
1892  eq getEqsNoVariant((ceq Lhs = Rhs if Cond [AtS] .) EqS)
1893   = (ceq Lhs = Rhs if Cond [AtS] .) getEqsNoVariant(EqS) .
1894
1895  *** getEqsVariant *******************************
1896  op getEqsVariant : Module -> EquationSet .
1897  eq getEqsVariant(
1898      fmod Q:Qid is
1899       IL:ImportList
1900       sorts S:SortSet .
1901       S:SubsortDeclSet
1902       O:OpDeclSet
1903       M:MembAxSet
1904       E:EquationSet
1905      endfm)
1906   = getEqsVariant(E:EquationSet) .
1907  eq getEqsVariant(
1908      mod Q:Qid is
1909       IL:ImportList
1910       sorts S:SortSet .
1911       S:SubsortDeclSet
1912       O:OpDeclSet
1913       M:MembAxSet
1914       E:EquationSet
1915       R:RuleSet
1916      endm)
1917   = getEqsVariant(E:EquationSet) .
1918
1919  op getEqsVariant : EquationSet -> EquationSet [memo] .
1920  eq getEqsVariant(none) = none .
1921  eq getEqsVariant((eq Lhs = Rhs [AtS variant] .) EqS)
1922   = (eq Lhs = Rhs [AtS variant] .)
1923     getEqsVariant(EqS) .
1924  eq getEqsVariant((eq Lhs = Rhs [AtS] .) EqS)
1925   = getEqsVariant(EqS)
1926  [owise] .
1927  eq getEqsVariant((ceq Lhs = Rhs if Cond [AtS] .) EqS)
1928   = (ceq Lhs = Rhs if Cond [AtS] .) getEqsVariant(EqS) .
1929
1930  *** onlyEqsNoBuiltInUnify *******************************
1931  op onlyEqsNoBuiltInUnify : Module -> Module .
1932  eq onlyEqsNoBuiltInUnify(
1933      fmod Q:Qid is
1934       IL:ImportList
1935       sorts S:SortSet .
1936       S:SubsortDeclSet
1937       O:OpDeclSet
1938       M:MembAxSet
1939       E:EquationSet
1940      endfm)
1941   = fmod (addsufix '-OnlyEqsNoBuiltInUnify To Q:Qid) is
1942       IL:ImportList
1943       sorts S:SortSet .
1944       S:SubsortDeclSet
1945       O:OpDeclSet
1946       M:MembAxSet
1947       getEqsNoBuiltInUnify(E:EquationSet)
1948     endfm .
1949  eq onlyEqsNoBuiltInUnify(
1950      mod Q:Qid is
1951       IL:ImportList
1952       sorts S:SortSet .
1953       S:SubsortDeclSet
1954       O:OpDeclSet
1955       M:MembAxSet
1956       E:EquationSet
1957       R:RuleSet
1958      endm)
1959   = mod (addsufix '-OnlyEqsNoBuiltInUnify To Q:Qid) is
1960       IL:ImportList
1961       sorts S:SortSet .
1962       S:SubsortDeclSet
1963       O:OpDeclSet
1964       M:MembAxSet
1965       getEqsNoBuiltInUnify(E:EquationSet)
1966       R:RuleSet
1967     endm .
1968
1969  *** onlyEqsNoVariant *******************************
1970  op onlyEqsNoVariant : Module -> Module .
1971  eq onlyEqsNoVariant(
1972      fmod Q:Qid is
1973       IL:ImportList
1974       sorts S:SortSet .
1975       S:SubsortDeclSet
1976       O:OpDeclSet
1977       M:MembAxSet
1978       E:EquationSet
1979      endfm)
1980   = fmod (addsufix '-OnlyEqsNoVariant To Q:Qid) is
1981       IL:ImportList
1982       sorts S:SortSet .
1983       S:SubsortDeclSet
1984       O:OpDeclSet
1985       M:MembAxSet
1986       getEqsNoVariant(E:EquationSet)
1987     endfm .
1988  eq onlyEqsNoVariant(
1989      mod Q:Qid is
1990       IL:ImportList
1991       sorts S:SortSet .
1992       S:SubsortDeclSet
1993       O:OpDeclSet
1994       M:MembAxSet
1995       E:EquationSet
1996       R:RuleSet
1997      endm)
1998   = mod (addsufix '-OnlyEqsNoVariant To Q:Qid) is
1999       IL:ImportList
2000       sorts S:SortSet .
2001       S:SubsortDeclSet
2002       O:OpDeclSet
2003       M:MembAxSet
2004       getEqsNoVariant(E:EquationSet)
2005       R:RuleSet
2006     endm .
2007
2008  *** getEqsBuiltInUnify *******************************
2009  op getEqsBuiltInUnify : Module -> EquationSet .
2010  eq getEqsBuiltInUnify(
2011      fmod Q:Qid is
2012       IL:ImportList
2013       sorts S:SortSet .
2014       S:SubsortDeclSet
2015       O:OpDeclSet
2016       M:MembAxSet
2017       E:EquationSet
2018      endfm)
2019   = getEqsBuiltInUnify(E:EquationSet) .
2020  eq getEqsBuiltInUnify(
2021      mod Q:Qid is
2022       IL:ImportList
2023       sorts S:SortSet .
2024       S:SubsortDeclSet
2025       O:OpDeclSet
2026       M:MembAxSet
2027       E:EquationSet
2028       R:RuleSet
2029      endm)
2030   = getEqsBuiltInUnify(E:EquationSet) .
2031
2032  op getEqsBuiltInUnify : EquationSet -> EquationSet [memo] .
2033  eq getEqsBuiltInUnify(none) = none .
2034  eq getEqsBuiltInUnify((eq Lhs = Rhs [AtS metadata("builtin-unify")] .) EqS)
2035   = (eq Lhs = Rhs [AtS metadata("builtin-unify")] .) getEqsBuiltInUnify(EqS) .
2036  eq getEqsBuiltInUnify((eq Lhs = Rhs [AtS] .) EqS)
2037   = getEqsBuiltInUnify(EqS)
2038  [owise] .
2039  eq getEqsBuiltInUnify((ceq Lhs = Rhs if Cond [AtS] .) EqS)
2040   = getEqsBuiltInUnify(EqS) .
2041
2042  *** getEqsVariant *******************************
2043  op getEqsVariant : Module -> EquationSet .
2044  eq getEqsVariant(
2045      fmod Q:Qid is
2046       IL:ImportList
2047       sorts S:SortSet .
2048       S:SubsortDeclSet
2049       O:OpDeclSet
2050       M:MembAxSet
2051       E:EquationSet
2052      endfm)
2053   = getEqsVariant(E:EquationSet) .
2054  eq getEqsVariant(
2055      mod Q:Qid is
2056       IL:ImportList
2057       sorts S:SortSet .
2058       S:SubsortDeclSet
2059       O:OpDeclSet
2060       M:MembAxSet
2061       E:EquationSet
2062       R:RuleSet
2063      endm)
2064   = getEqsVariant(E:EquationSet) .
2065
2066  op getEqsVariant : EquationSet -> EquationSet [memo] .
2067  eq getEqsVariant(none) = none .
2068  eq getEqsVariant((eq Lhs = Rhs [AtS variant] .) EqS)
2069   = (eq Lhs = Rhs [AtS variant] .) getEqsVariant(EqS) .
2070  eq getEqsVariant((eq Lhs = Rhs [AtS] .) EqS)
2071   = getEqsVariant(EqS)
2072  [owise] .
2073  eq getEqsVariant((ceq Lhs = Rhs if Cond [AtS] .) EqS)
2074   = getEqsVariant(EqS) .
2075
2076  *** onlyEqsBuiltInUnify *******************************
2077  op onlyEqsBuiltInUnify : Module -> Module .
2078  eq onlyEqsBuiltInUnify(
2079      fmod Q:Qid is
2080       IL:ImportList
2081       sorts S:SortSet .
2082       S:SubsortDeclSet
2083       O:OpDeclSet
2084       M:MembAxSet
2085       E:EquationSet
2086      endfm)
2087   = fmod Q:Qid is
2088       IL:ImportList
2089       sorts S:SortSet .
2090       S:SubsortDeclSet
2091       O:OpDeclSet
2092       M:MembAxSet
2093       getEqsBuiltInUnify(E:EquationSet)
2094     endfm .
2095  eq onlyEqsBuiltInUnify(
2096      mod Q:Qid is
2097       IL:ImportList
2098       sorts S:SortSet .
2099       S:SubsortDeclSet
2100       O:OpDeclSet
2101       M:MembAxSet
2102       E:EquationSet
2103       R:RuleSet
2104      endm)
2105   = mod Q:Qid is
2106       IL:ImportList
2107       sorts S:SortSet .
2108       S:SubsortDeclSet
2109       O:OpDeclSet
2110       M:MembAxSet
2111       getEqsBuiltInUnify(E:EquationSet)
2112       R:RuleSet
2113     endm .
2114
2115  *** onlyEqsVariant *******************************
2116  op onlyEqsVariant : Module -> Module .
2117  eq onlyEqsVariant(
2118      fmod Q:Qid is
2119       IL:ImportList
2120       sorts S:SortSet .
2121       S:SubsortDeclSet
2122       O:OpDeclSet
2123       M:MembAxSet
2124       E:EquationSet
2125      endfm)
2126   = fmod Q:Qid is
2127       IL:ImportList
2128       sorts S:SortSet .
2129       S:SubsortDeclSet
2130       O:OpDeclSet
2131       M:MembAxSet
2132       getEqsVariant(E:EquationSet)
2133     endfm .
2134  eq onlyEqsVariant(
2135      mod Q:Qid is
2136       IL:ImportList
2137       sorts S:SortSet .
2138       S:SubsortDeclSet
2139       O:OpDeclSet
2140       M:MembAxSet
2141       E:EquationSet
2142       R:RuleSet
2143      endm)
2144   = mod Q:Qid is
2145       IL:ImportList
2146       sorts S:SortSet .
2147       S:SubsortDeclSet
2148       O:OpDeclSet
2149       M:MembAxSet
2150       getEqsVariant(E:EquationSet)
2151       R:RuleSet
2152     endm .
2153
2154  *** rls2eqs *******************************
2155  op rls2eqs# : RuleSet -> EquationSet [memo] .
2156  eq rls2eqs#(none) = none .
2157  eq rls2eqs#((rl Lhs => Rhs [AtS] .) RlS)
2158   = (eq Lhs = Rhs [AtS] .) rls2eqs#(RlS) .
2159  eq rls2eqs#((crl Lhs => Rhs if Cond [AtS] .) RlS)
2160   = (ceq Lhs = Rhs if Cond [AtS] .) rls2eqs#(RlS) .
2161
2162  op rls2eqs : SModule -> SModule .
2163  eq rls2eqs(
2164      mod Q:Qid is
2165       IL:ImportList
2166       sorts S:SortSet .
2167       S:SubsortDeclSet
2168       O:OpDeclSet
2169       M:MembAxSet
2170       E:EquationSet
2171       R:RuleSet
2172      endm)
2173   = mod (addsufix '-RLS2EQS To Q:Qid) is
2174       IL:ImportList
2175       sorts S:SortSet .
2176       S:SubsortDeclSet
2177       O:OpDeclSet
2178       M:MembAxSet
2179       E:EquationSet rls2eqs#(R:RuleSet)
2180       none
2181     endm .
2182
2183  *** flipRls *******************************
2184  op flipRls : RuleSet -> RuleSet [memo] .
2185  eq flipRls(none) = none .
2186  eq flipRls((rl Lhs => Rhs [AtS] .) RlS:RuleSet)
2187   = if all Vars(Lhs) in Vars(Rhs)
2188     then (rl Rhs => Lhs [removeNonExec(AtS)] .)
2189     else (rl Rhs => Lhs [nonexec removeNonExec(AtS)] .)
2190     fi
2191     flipRls(RlS:RuleSet) .
2192  eq flipRls((crl Lhs => Rhs if Cond [AtS] .) RlS:RuleSet)
2193   = if all Vars(Lhs) in Vars(Rhs)
2194     then (crl Rhs => Lhs if Cond [removeNonExec(AtS)] .)
2195     else (crl Rhs => Lhs if Cond [nonexec removeNonExec(AtS)] .)
2196     fi
2197     flipRls(RlS:RuleSet) .
2198
2199  op removeNonExec : AttrSet -> AttrSet .
2200  eq removeNonExec(nonexec AtS) = AtS .
2201  eq removeNonExec(AtS) = AtS [owise] .
2202
2203  op flipRls : SModule -> SModule .
2204  eq flipRls(mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2205             O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)
2206   = mod (addsufix '-FLIPPEDRLS To Q:Qid)
2207     is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2208     O:OpDeclSet M:MembAxSet E:EquationSet flipRls(R:RuleSet) endm .
2209
2210  *** addOp *******************************
2211  op addOps : OpDeclSet SModule -> SModule .
2212  eq addOps(OO:OpDeclSet,mod Q:Qid is IL:ImportList sorts S:SortSet .
2213      S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)
2214   = mod (addsufix '-ADDEDOPS To Q:Qid)
2215     is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2216     override(O:OpDeclSet,OO:OpDeclSet)
2217     M:MembAxSet E:EquationSet R:RuleSet endm .
2218  op addOps : OpDeclSet FModule -> FModule .
2219  eq addOps(OO:OpDeclSet,fmod Q:Qid is IL:ImportList sorts S:SortSet .
2220      S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet endfm)
2221   = fmod (addsufix '-ADDEDOPS To Q:Qid)
2222     is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2223     override(O:OpDeclSet,OO:OpDeclSet)
2224     M:MembAxSet E:EquationSet endfm .
2225
2226  op override : OpDeclSet OpDeclSet -> OpDeclSet .
2227  eq override(
2228      (op F : TPL -> TP [AtS] .)  O:OpDeclSet,
2229      (op F : TPL -> TP [AtS'] .) O':OpDeclSet)
2230   = override(O:OpDeclSet,(op F : TPL -> TP [AtS'] .) O':OpDeclSet) .
2231  eq override(O:OpDeclSet,O':OpDeclSet)
2232   = O:OpDeclSet O':OpDeclSet [owise] .
2233
2234  *** addRules *******************************
2235  op addRules : RuleSet SModule -> SModule [memo] .
2236  eq addRules(RR:RuleSet,mod Q:Qid is IL:ImportList sorts S:SortSet .
2237          S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)
2238   = mod (addsufix '-ADDEDRLS To Q:Qid)
2239      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2240      O:OpDeclSet M:MembAxSet E:EquationSet (R:RuleSet RR:RuleSet) endm .
2241
2242  *** addEqs *******************************
2243  op addEqs : EquationSet SModule -> SModule .
2244  op addEqs : EquationSet FModule -> FModule .
2245  eq addEqs(ES:EquationSet,mod Q:Qid is IL:ImportList sorts S:SortSet .
2246          S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)
2247   = mod (addsufix '-ADDEDEQS To Q:Qid)
2248      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2249      O:OpDeclSet M:MembAxSet (E:EquationSet ES:EquationSet) R:RuleSet endm .
2250  eq addEqs(ES:EquationSet,fmod Q:Qid is IL:ImportList sorts S:SortSet .
2251          S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet endfm)
2252   = fmod (addsufix '-ADDEDEQS To Q:Qid)
2253      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2254      O:OpDeclSet M:MembAxSet (E:EquationSet ES:EquationSet) endfm .
2255
2256  *** addSorts *******************************
2257  op addSorts : SortSet SModule -> SModule .
2258  op addSorts : SortSet FModule -> FModule .
2259  eq addSorts(X:SortSet,
2260       mod Q:Qid is IL:ImportList sorts S:SortSet .
2261       S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm)
2262   = mod Q:Qid is IL:ImportList sorts (X:SortSet ; S:SortSet) .
2263       S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm .
2264  eq addSorts(X:SortSet,
2265       fmod Q:Qid is IL:ImportList sorts S:SortSet .
2266       S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet endfm)
2267   = fmod Q:Qid is IL:ImportList sorts (X:SortSet ; S:SortSet) .
2268       S:SubsortDeclSet O:OpDeclSet M:MembAxSet E:EquationSet endfm .
2269
2270  *** putFrozen *******************************
2271  op putFrozen : NatList Qid TypeList SModule -> SModule [memo] .
2272  eq putFrozen(NL,F,TPL,
2273     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2274      ((op F : TPL -> TP [frozen(NL') AtS] .) O:OpDeclSet)
2275      M:MembAxSet E:EquationSet R:RuleSet endm))
2276   = (mod (addsufix F To (addsufix '-FROZEN# To Q:Qid))
2277      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2278      ((op F : TPL -> TP [frozen(NL) AtS] .) O:OpDeclSet)
2279      M:MembAxSet E:EquationSet R:RuleSet endm) .
2280  eq putFrozen(NL,F,TPL,
2281     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2282      ((op F : TPL -> TP [AtS] .) O:OpDeclSet)
2283      M:MembAxSet E:EquationSet R:RuleSet endm))
2284   = (mod (addsufix F To (addsufix '-FROZEN# To Q:Qid))
2285      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2286      ((op F : TPL -> TP [frozen(NL) AtS] .) O:OpDeclSet)
2287      M:MembAxSet E:EquationSet R:RuleSet endm) [owise] .
2288
2289  *** putStrat *******************************
2290  op putStrat : NatList Qid TypeList SModule -> SModule [memo] .
2291  eq putStrat(NL,F,TPL,
2292     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2293      ((op F : TPL -> TP [strat(NL') AtS] .) O:OpDeclSet)
2294      M:MembAxSet E:EquationSet R:RuleSet endm))
2295   = (mod (addsufix F To (addsufix '-STRAT#EQ# To Q:Qid))
2296      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2297      ((op F : TPL -> TP [strat(NL) AtS] .) O:OpDeclSet)
2298      M:MembAxSet E:EquationSet R:RuleSet endm) .
2299  eq putStrat(NL,F,TPL,
2300     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2301      ((op F : TPL -> TP [AtS] .) O:OpDeclSet)
2302      M:MembAxSet E:EquationSet R:RuleSet endm))
2303   = (mod (addsufix F To (addsufix '-STRAT#EQ# To Q:Qid))
2304      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2305      ((op F : TPL -> TP [strat(NL) AtS] .) O:OpDeclSet)
2306      M:MembAxSet E:EquationSet R:RuleSet endm) [owise] .
2307
2308  op putStrat : NatList Qid TypeList FModule -> FModule [memo] .
2309  eq putStrat(NL,F,TPL,
2310     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2311      ((op F : TPL -> TP [strat(NL') AtS] .) O:OpDeclSet)
2312      M:MembAxSet E:EquationSet endfm))
2313   = (fmod (addsufix F To (addsufix '-STRAT#EQ# To Q:Qid))
2314      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2315      ((op F : TPL -> TP [strat(NL) AtS] .) O:OpDeclSet)
2316      M:MembAxSet E:EquationSet endfm) .
2317  eq putStrat(NL,F,TPL,
2318     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2319      ((op F : TPL -> TP [AtS] .) O:OpDeclSet)
2320      M:MembAxSet E:EquationSet endfm))
2321   = (fmod (addsufix F To (addsufix '-STRAT#EQ# To Q:Qid))
2322      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2323      ((op F : TPL -> TP [strat(NL) AtS] .) O:OpDeclSet)
2324      M:MembAxSet E:EquationSet endfm) [owise] .
2325
2326  *** clearFrozen *******************************
2327  op clearFrozen : NatList Qid TypeList SModule -> SModule [memo] .
2328  eq clearFrozen(NL,F,TPL,
2329     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2330      ((op F : TPL -> TP [frozen(NL') AtS] .) O:OpDeclSet)
2331      M:MembAxSet E:EquationSet R:RuleSet endm))
2332   = (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2333      ((op F : TPL -> TP [AtS] .) O:OpDeclSet)
2334      M:MembAxSet E:EquationSet R:RuleSet endm) .
2335  eq clearFrozen(NL,F,TPL,M)
2336   = M [owise] .
2337
2338  *** clearEqsFrozen *******************************
2339  op clearEqsFrozen : SModule -> SModule [memo] .
2340  eq clearEqsFrozen(M)
2341   = clearEqsFrozen*(M) .
2342
2343  op clearEqsFrozen* : SModule -> SModule .
2344  eq clearEqsFrozen*(
2345     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2346      ((op F : TPL -> TP [frozen(NL') AtS] .) O:OpDeclSet)
2347      M:MembAxSet
2348      ((eq F[TL] = Rhs [AtS'] .) E:EquationSet)
2349      R:RuleSet endm))
2350   = clearEqsFrozen*(
2351     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2352      ((op F : TPL -> TP [AtS] .) O:OpDeclSet)
2353      M:MembAxSet
2354      ((eq F[TL] = Rhs [AtS'] .) E:EquationSet)
2355      R:RuleSet endm)) .
2356  eq clearEqsFrozen*(M)
2357   = M [owise] .
2358
2359  *** clearAllFrozen *******************************
2360  op clearAllFrozen : SModule -> SModule [memo] .
2361  eq clearAllFrozen(
2362     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2363      O:OpDeclSet
2364      M:MembAxSet E:EquationSet R:RuleSet endm))
2365   = (mod (addsufix '-CLEARFROZEN To Q:Qid)
2366      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2367      clearAllFrozen(O:OpDeclSet)
2368      M:MembAxSet E:EquationSet R:RuleSet endm) .
2369
2370  op clearAllFrozen : FModule -> FModule [memo] .
2371  eq clearAllFrozen(
2372     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2373      O:OpDeclSet
2374      M:MembAxSet E:EquationSet endfm))
2375   = (fmod (addsufix '-CLEARFROZEN To Q:Qid)
2376      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2377      clearAllFrozen(O:OpDeclSet)
2378      M:MembAxSet E:EquationSet endfm) .
2379
2380  op clearAllFrozen : OpDeclSet -> OpDeclSet .
2381  eq clearAllFrozen(none)
2382   = none .
2383  eq clearAllFrozen(
2384      (op F : TPL -> TP [frozen(NL) AtS] .) O:OpDeclSet)
2385   = (op F : TPL -> TP [AtS] .)
2386     clearAllFrozen(O:OpDeclSet) .
2387  eq clearAllFrozen(
2388      (op F : TPL -> TP [AtS] .) O:OpDeclSet)
2389   = (op F : TPL -> TP [AtS] .)
2390     clearAllFrozen(O:OpDeclSet) [owise] .
2391
2392  *** anyNonExec *******************************
2393  op anyNonExec : SModule -> Bool [memo] .
2394  eq anyNonExec(
2395     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2396      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
2397   = anyNonExec(E:EquationSet) or-else anyNonExec(R:RuleSet) .
2398
2399  op anyNonExec : RuleSet -> Bool .
2400  eq anyNonExec(
2401      (rl Lhs => Rhs [nonexec AtS] .) R:RuleSet)
2402   = true .
2403  eq anyNonExec(
2404      (crl Lhs => Rhs if Cond [nonexec AtS] .) R:RuleSet)
2405   = true .
2406  eq anyNonExec(R:RuleSet)
2407   = false [owise] .
2408
2409  op anyNonExec : EquationSet -> Bool .
2410  eq anyNonExec(
2411      (eq Lhs = Rhs [nonexec AtS] .) R:EquationSet)
2412   = true .
2413  eq anyNonExec(
2414      (ceq Lhs = Rhs if Cond [nonexec AtS] .) R:EquationSet)
2415   = true .
2416  eq anyNonExec(R:EquationSet)
2417   = false [owise] .
2418
2419  *** clearNonExec *******************************
2420  op clearNonExecRls&Eqs : SModule -> SModule [memo] .
2421  eq clearNonExecRls&Eqs(M:SModule)
2422   = clearNonExecRls(clearNonExecEqs(M:SModule)) .
2423
2424  op clearNonExecRls : SModule -> SModule [memo] .
2425  eq clearNonExecRls(
2426     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2427      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
2428   = (mod (addsufix '-CLEARNONEXEC To Q:Qid)
2429      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2430      O:OpDeclSet M:MembAxSet
2431        E:EquationSet clearNonExec(R:RuleSet) endm) .
2432
2433  op clearNonExecEqs : SModule -> SModule [memo] .
2434  eq clearNonExecEqs(
2435     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2436      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
2437   = (mod (addsufix '-CLEARNONEXEC To Q:Qid)
2438      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2439      O:OpDeclSet M:MembAxSet
2440        clearNonExec(E:EquationSet) R:RuleSet endm) .
2441
2442  op clearNonExecEqs : FModule -> FModule [memo] .
2443  eq clearNonExecEqs(
2444     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2445      O:OpDeclSet M:MembAxSet E:EquationSet endfm))
2446   = (fmod (addsufix '-CLEARNONEXEC To Q:Qid)
2447      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2448      O:OpDeclSet M:MembAxSet
2449        clearNonExec(E:EquationSet) endfm) .
2450
2451  op clearNonExec : RuleSet -> RuleSet .
2452  eq clearNonExec((none).RuleSet)
2453   = (none).RuleSet .
2454  eq clearNonExec(
2455      (rl Lhs => Rhs [nonexec AtS] .) R:RuleSet)
2456   = (rl Lhs => Rhs [AtS] .)
2457     clearNonExec(R:RuleSet) .
2458  eq clearNonExec(
2459      (rl Lhs => Rhs [AtS] .) R:RuleSet)
2460   = (rl Lhs => Rhs [AtS] .)
2461     clearNonExec(R:RuleSet) [owise] .
2462
2463  op clearNonExec : EquationSet -> EquationSet .
2464  eq clearNonExec((none).EquationSet)
2465   = (none).EquationSet .
2466  eq clearNonExec(
2467      (eq Lhs = Rhs [nonexec AtS] .) R:EquationSet)
2468   = (eq Lhs = Rhs [AtS] .)
2469     clearNonExec(R:EquationSet) .
2470  eq clearNonExec(
2471      (eq Lhs = Rhs [AtS] .) R:EquationSet)
2472   = (eq Lhs = Rhs [AtS] .)
2473     clearNonExec(R:EquationSet) [owise] .
2474
2475  *** eraseRls *******************************
2476  op eraseRls : Module -> Module [memo] .
2477  eq eraseRls(
2478     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2479      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
2480   = (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2481      O:OpDeclSet M:MembAxSet E:EquationSet none endm) .
2482  eq eraseRls(
2483     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2484      O:OpDeclSet M:MembAxSet E:EquationSet endfm))
2485   = (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2486      O:OpDeclSet M:MembAxSet E:EquationSet endfm) .
2487
2488  *** eraseEqs *******************************
2489  op eraseEqs : Module -> Module [memo] .
2490  eq eraseEqs(
2491     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2492      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
2493   = (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2494      O:OpDeclSet M:MembAxSet none R:RuleSet endm) .
2495  eq eraseEqs(
2496     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2497      O:OpDeclSet M:MembAxSet E:EquationSet endfm))
2498   = (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2499      O:OpDeclSet M:MembAxSet none endfm) .
2500
2501  *** flatten  ******************************
2502  op flatten : Module TermList -> TermList .
2503  eq flatten(M,V) = V .
2504  eq flatten(M,C) = C .
2505  eq flatten(M,F[TL:NeTermList])
2506   = if isAssociative(M,F,getTypes(M,TL:NeTermList))
2507     then F[aliens(TL:NeTermList,F)]
2508     else F[flatten(M,TL:NeTermList)]
2509     fi .
2510  eq flatten(M,(T:Term,TL:NeTermList))
2511   = (flatten(M,T:Term),flatten(M,TL:NeTermList)) .
2512
2513  op aliens : TermList Qid -> TermList .
2514  eq aliens(empty,F) = empty .
2515  eq aliens((F[TL':NeTermList],TL:TermList),F)
2516   = aliens((TL':NeTermList,TL:TermList),F) .
2517  eq aliens((T:Term,TL:TermList),F)
2518   = (T:Term,aliens(TL:TermList,F)) [owise] .
2519
2520  *** unflatten  ******************************
2521  op unflatten : Module TermList -> TermList .
2522  eq unflatten(M,T) = unflatten*(M,T) .
2523
2524  op unflatten* : Module TermList -> TermList .
2525  eq unflatten*(M,V) = V .
2526  eq unflatten*(M,C) = C .
2527  eq unflatten*(M,F[TL:NeTermList])
2528   = if isAssociative(M,F,getTypes(M,TL:NeTermList))
2529     then unflatten**(M,F,TL:NeTermList)
2530     else F[unflatten*(M,TL:NeTermList)]
2531     fi .
2532  eq unflatten*(M,(T:Term,TL:NeTermList))
2533   = (unflatten*(M,T:Term),unflatten*(M,TL:NeTermList)) .
2534
2535  op unflatten** : Module Qid TermList -> TermList .
2536  eq unflatten**(M,F,(T1:Term,TL:NeTermList))
2537   = F[unflatten*(M,T1:Term),unflatten**(M,F,TL:NeTermList)] .
2538  eq unflatten**(M,F,T:Term)
2539   = unflatten*(M,T:Term) .
2540
2541  *** wrapRules_bySymbol_ *******************************
2542  op wrapRules_bySymbol_ : SModule Qid -> SModule [memo] .
2543  eq wrapRules
2544     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2545      O:OpDeclSet
2546      M:MembAxSet E:EquationSet R:RuleSet endm)
2547     bySymbol F:Qid
2548   = (mod (addsufix F:Qid To (addsufix '-WRAPPED# To Q:Qid))
2549       is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2550      O:OpDeclSet
2551      M:MembAxSet E:EquationSet
2552      wrapRules R:RuleSet bySymbol F:Qid endm) .
2553
2554  op wrapRules_bySymbol_ : RuleSet Qid -> RuleSet .
2555  eq wrapRules none bySymbol F:Qid = none .
2556  eq wrapRules ((rl Lhs => Rhs [AtS] .) RlS:RuleSet) bySymbol F:Qid
2557   = (rl F:Qid[Lhs] => F:Qid[Rhs] [AtS] .)
2558     wrapRules RlS:RuleSet bySymbol F:Qid .
2559  eq wrapRules ((crl Lhs => Rhs if Cond [AtS] .) RlS:RuleSet) bySymbol F:Qid
2560   = (crl F:Qid[Lhs] => F:Qid[Rhs] if Cond [AtS] .)
2561     wrapRules RlS:RuleSet bySymbol F:Qid .
2562
2563  op toSModule : FModule -> SModule .
2564  eq toSModule(
2565      fmod Q:Qid is
2566       IL:ImportList
2567       sorts S:SortSet .
2568       S:SubsortDeclSet
2569       O:OpDeclSet
2570       M:MembAxSet
2571       E:EquationSet
2572      endfm)
2573   =  mod (addsufix '-CONVERTED#SMODULE To Q:Qid) is
2574       IL:ImportList
2575       sorts S:SortSet .
2576       S:SubsortDeclSet
2577       O:OpDeclSet
2578       M:MembAxSet
2579       E:EquationSet
2580       none
2581      endm .
2582
2583  op newName : Qid SModule -> SModule .
2584  op newName : Qid FModule -> FModule .
2585  eq newName(F:Qid,
2586      fmod Q:Qid is
2587       IL:ImportList
2588       sorts S:SortSet .
2589       S:SubsortDeclSet
2590       O:OpDeclSet
2591       M:MembAxSet
2592       E:EquationSet
2593      endfm)
2594   = fmod F:Qid is
2595       IL:ImportList
2596       sorts S:SortSet .
2597       S:SubsortDeclSet
2598       O:OpDeclSet
2599       M:MembAxSet
2600       E:EquationSet
2601      endfm .
2602  eq newName(F:Qid,
2603      mod Q:Qid is
2604       IL:ImportList
2605       sorts S:SortSet .
2606       S:SubsortDeclSet
2607       O:OpDeclSet
2608       M:MembAxSet
2609       E:EquationSet
2610       R:RuleSet
2611      endm)
2612   = mod F:Qid is
2613       IL:ImportList
2614       sorts S:SortSet .
2615       S:SubsortDeclSet
2616       O:OpDeclSet
2617       M:MembAxSet
2618       E:EquationSet
2619       R:RuleSet
2620      endm .
2621
2622  ***
2623  op removeBoolEqs : Module -> Module [memo] .
2624  eq removeBoolEqs(
2625     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2626      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
2627   = (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2628      O:OpDeclSet M:MembAxSet
2629      removeBoolEqs(E:EquationSet)
2630      R:RuleSet endm) .
2631  eq removeBoolEqs(
2632     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2633      O:OpDeclSet M:MembAxSet E:EquationSet endfm))
2634   = (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2635      O:OpDeclSet M:MembAxSet
2636      removeBoolEqs(E:EquationSet) endfm) .
2637
2638  op removeBoolEqs : EquationSet -> EquationSet .
2639  eq removeBoolEqs((eq '_and_[TL] = Rhs [AtS] .) EqS)
2640   = removeBoolEqs(EqS) .
2641  eq removeBoolEqs((eq 'not_[TL] = Rhs [AtS] .) EqS)
2642   = removeBoolEqs(EqS) .
2643  eq removeBoolEqs((eq '_or_[TL] = Rhs [AtS] .) EqS)
2644   = removeBoolEqs(EqS) .
2645  eq removeBoolEqs((eq '_xor_[TL] = Rhs [AtS] .) EqS)
2646   = removeBoolEqs(EqS) .
2647  eq removeBoolEqs((eq '_implies_[TL] = Rhs [AtS] .) EqS)
2648   = removeBoolEqs(EqS) .
2649  eq removeBoolEqs(EqS)
2650   = EqS [owise] .
2651
2652  *******************************************
2653  op keepOnlyACAttr : Module -> Module [memo] .
2654  eq keepOnlyACAttr(
2655     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2656      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
2657   = (mod (addsufix '-REMOVED-ID-SYMBOLS To Q:Qid)
2658      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2659      keepOnlyACAttr*(O:OpDeclSet)
2660      M:MembAxSet E:EquationSet R:RuleSet endm) .
2661  eq keepOnlyACAttr(
2662     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2663      O:OpDeclSet M:MembAxSet E:EquationSet endfm))
2664   = (fmod (addsufix '-REMOVED-ID-SYMBOLS To Q:Qid)
2665      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2666      keepOnlyACAttr*(O:OpDeclSet)
2667      M:MembAxSet E:EquationSet endfm) .
2668
2669  op keepOnlyACAttr* : OpDeclSet -> OpDeclSet .
2670  eq keepOnlyACAttr*((op F : TPL -> TP [id(T) AtS] .) OPDS)
2671   = keepOnlyACAttr*((op F : TPL -> TP [AtS] .) OPDS) .
2672  eq keepOnlyACAttr*((op F : TPL -> TP [left-id(T) AtS] .) OPDS)
2673   = keepOnlyACAttr*((op F : TPL -> TP [AtS] .) OPDS) .
2674  eq keepOnlyACAttr*((op F : TPL -> TP [right-id(T) AtS] .) OPDS)
2675   = keepOnlyACAttr*((op F : TPL -> TP [AtS] .) OPDS) .
2676  eq keepOnlyACAttr*(OPDS)
2677   = removeAssocAttr(OPDS) [owise] .
2678
2679  op _in#_ : Attr AttrSet -> Bool .
2680  eq X:Attr in# X:Attr X:AttrSet = true .
2681  eq X:Attr in# X:AttrSet = false [owise] .
2682
2683  op removeAssocAttr : OpDeclSet -> OpDeclSet .
2684  eq removeAssocAttr((op F : TPL -> TP [assoc AtS] .) OPDS)
2685   = if comm in# AtS
2686     then (op F : TPL -> TP [assoc AtS] .) removeAssocAttr(OPDS)
2687     else removeAssocAttr((op F : TPL -> TP [AtS] .) OPDS)
2688     fi .
2689  eq removeAssocAttr(OPDS)
2690   = OPDS [owise] .
2691
2692  *******************************************
2693  op keepOnlyACUAttr : Module -> Module [memo] .
2694  eq keepOnlyACUAttr(
2695     (mod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2696      O:OpDeclSet M:MembAxSet E:EquationSet R:RuleSet endm))
2697   = (mod (addsufix '-REMOVED-ID-SYMBOLS To Q:Qid)
2698      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2699      keepOnlyACUAttr*(O:OpDeclSet)
2700      M:MembAxSet E:EquationSet R:RuleSet endm) .
2701  eq keepOnlyACUAttr(
2702     (fmod Q:Qid is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2703      O:OpDeclSet M:MembAxSet E:EquationSet endfm))
2704   = (fmod (addsufix '-REMOVED-ID-SYMBOLS To Q:Qid)
2705      is IL:ImportList sorts S:SortSet . S:SubsortDeclSet
2706      keepOnlyACUAttr*(O:OpDeclSet)
2707      M:MembAxSet E:EquationSet endfm) .
2708
2709  op keepOnlyACUAttr* : OpDeclSet -> OpDeclSet .
2710  eq keepOnlyACUAttr*(OPDS)
2711   = removeAssocAttr(OPDS) .
2712
2713endfm
2714
2715fmod VARIANT is
2716  pr SUBSTITUTION-HANDLING .
2717  pr MODULE-HANDLING .
2718  pr META-LEVEL-MNPA .
2719
2720  var M : Module .
2721  vars T T' TS TS' CtTS CtTS' Lhs Rhs : Term .
2722  vars N N' NextVar NextVar' NextVar'' : Nat .
2723  var B : Bound .
2724  var TL TL' : TermList .
2725  var NeTL : NeTermList .
2726  var EqS : EquationSet .
2727  var AtS : AttrSet .
2728  var Q : Qid .
2729  vars S S' : Substitution .
2730  var V : Variable .
2731  vars TP TP' : Type .
2732  var C : Constant .
2733  vars F F' : Qid .
2734
2735  --- Variants ----------------------------------------------------------
2736---  sort VariantTriple .
2737---  op {_,_,_} : Term Substitution Nat -> VariantTriple [ctor] .
2738
2739  sort VariantTripleSet .
2740---  subsort VariantTriple < VariantTripleSet .
2741  subsort Variant < VariantTripleSet .
2742  op empty : -> VariantTripleSet [ctor] .
2743  op _|_ : VariantTripleSet VariantTripleSet -> VariantTripleSet
2744    [ctor assoc comm id: empty prec 65 format (d d n d)] .
2745---  eq X:VariantTriple | X:VariantTriple = X:VariantTriple .
2746  eq X:Variant | X:Variant = X:Variant .
2747
2748  op getTerms : VariantTripleSet -> TermSet .
2749  eq getTerms({T:Term,S:Substitution,NextVar:Nat,Parent:Parent,B:Bool}
2750              | R:VariantTripleSet)
2751   = T:Term | getTerms(R:VariantTripleSet) .
2752  eq getTerms((empty).VariantTripleSet)
2753   = emptyTermSet .
2754
2755  op getSubstitutions : VariantTripleSet -> SubstitutionSet .
2756  eq getSubstitutions({T:Term,S:Substitution,NextVar:Nat,Parent:Parent,B:Bool}
2757              | R:VariantTripleSet)
2758   = S:Substitution | getSubstitutions(R:VariantTripleSet) .
2759  eq getSubstitutions((empty).VariantTripleSet)
2760   = empty .
2761
2762  --- Variants ----------------------------------------------------------
2763  sort VariantFour .
2764  op {_,_,_,_} : Term Substitution Substitution Nat -> VariantFour [ctor] .
2765
2766  sort VariantFourSet .
2767  subsort VariantFour < VariantFourSet .
2768  op empty : -> VariantFourSet [ctor] .
2769  op _|_ : VariantFourSet VariantFourSet -> VariantFourSet
2770    [ctor assoc comm id: empty prec 65 format (d d n d)] .
2771  eq X:VariantFour | X:VariantFour = X:VariantFour .
2772
2773endfm
2774
2775fmod META-MINIMIZE-BINDINGS is
2776  pr SUBSTITUTION-HANDLING .
2777  pr MODULE-HANDLING .
2778  pr SUBSTITUTIONSET .
2779  pr UNIFICATIONTRIPLESET .
2780  pr CONVERSION .
2781  pr META-LEVEL-MNPA .
2782  pr VARIANT .
2783
2784  vars M : Module .
2785  vars T T' T1 T2 T3 : Term .
2786  vars TL TL' TL1 TL2 TL3 : TermList .
2787  vars F F' : Qid .
2788  vars S S' S* S'* : Substitution .
2789  vars V V' V1 V2 : Variable .
2790  vars N N' NOld : Nat .
2791  var US? : [UnificationTripleSet] .
2792  vars US US' : UnificationTripleSet .
2793  vars VTS VTS' : VariantFourSet .
2794
2795  --- minimizeBindings ---
2796  op minimizeBindingsTerm : Module TermList UnificationTripleSet
2797                         -> UnificationTripleSet .
2798  eq minimizeBindingsTerm(M,TL,US)
2799   = minimizeBindingsTerm(M,TL,highestVar(TL),US) .
2800
2801  op minimizeBindingsTerm : Module TermList Nat UnificationTripleSet
2802                         -> UnificationTripleSet .
2803  eq minimizeBindingsTerm(M,TL,NOld,US)
2804   = minimizeBindingsTerm*(M,TL,NOld,US,empty) .
2805
2806  op minimizeBindingsTerm* : Module TermList Nat UnificationTripleSet
2807                             UnificationTripleSet -> UnificationTripleSet .
2808  eq minimizeBindingsTerm*(M,TL,NOld,empty,US')
2809   = US' .
2810  eq minimizeBindingsTerm*(M,TL,NOld,{S,S',N} | US,US')
2811   = minimizeBindingsTerm*(M,TL,NOld,US,
2812        US' | minimizeBindingsTerm**(M,TL,NOld,{S,S',N},S,S')
2813     ) .
2814
2815  ****************
2816  op minimizeBindingsTerm** : Module TermList ---variables to minimize bindings
2817                             Nat --- or maximum index of variables
2818                             UnificationTriple Substitution Substitution
2819                          -> UnificationTriple .
2820  eq minimizeBindingsTerm**(M,TL',NOld,{S*,S'*,N},none,none)
2821   = {remDup(S*),remDup(S'*),N} .
2822
2823 ceq minimizeBindingsTerm**(M,TL',NOld,{S*,V <- V' ; S'*,N},none,V <- V' ; S')
2824   = minimizeBindingsTerm**(M,TL',NOld,
2825         {  S* << (V' <- V),    S'* .. (V' <- V),  N},
2826         none,
2827         S' .. (V' <- V)
2828     )
2829  if V' =/= V and-then not (V in TL') and-then not (V' in TL')
2830     and-then highestVar(V) < NOld
2831     and-then highestVar(V') >= NOld
2832     and-then typeLeq(M,getTypes(M,V),getTypes(M,V')) .
2833
2834  eq minimizeBindingsTerm**(M,TL',NOld,{S*,V <- T' ; S'*,N},none,V <- T' ; S')
2835   = minimizeBindingsTerm**(M,TL',NOld,{S*,V <- T' ; S'*,N},none,S')
2836  [owise] .
2837
2838 ceq minimizeBindingsTerm**(M,TL',NOld,{V <- V' ; S*,S'*,N},V <- V' ; S,S')
2839   = minimizeBindingsTerm**(M,TL',NOld,
2840         { S* << (V' <- V),   S'* .. (V' <- V),   N},
2841         S << (V' <- V),
2842         S' .. (V' <- V)
2843     )
2844  if V' =/= V and-then V in TL' and-then not (V' in TL')
2845     and-then typeLeq(M,getTypes(M,V),getTypes(M,V')) .
2846
2847  eq minimizeBindingsTerm**(M,TL',NOld,{V <- T' ; S*,S'*,N},V <- T' ; S,S')
2848   = minimizeBindingsTerm**(M,TL',NOld,{V <- T' ; S*,S'*,N},S,S')
2849  [owise] .
2850
2851  --- minimizeBindings ---
2852  op minimizeBindingsTerm : Module TermList VariantFourSet
2853                         -> VariantFourSet .
2854  eq minimizeBindingsTerm(M,TL,VTS)
2855   = minimizeBindingsTerm(M,TL,highestVar(TL),VTS) .
2856
2857  op minimizeBindingsTerm : Module TermList Nat VariantFourSet
2858                         -> VariantFourSet .
2859  eq minimizeBindingsTerm(M,TL,NOld,VTS)
2860   = minimizeBindingsTerm*(M,TL,NOld,VTS,empty) .
2861
2862  op minimizeBindingsTerm* : Module TermList Nat VariantFourSet
2863                             VariantFourSet -> VariantFourSet .
2864  eq minimizeBindingsTerm*(M,TL,NOld,empty,VTS')
2865   = VTS' .
2866  eq minimizeBindingsTerm*(M,TL,NOld,{T,S,S',N} | VTS,VTS')
2867   = minimizeBindingsTerm*(M,TL,NOld,VTS,
2868        VTS' | minimizeBindingsTerm**(M,TL,NOld,{T,S,S',N},S,S')
2869     ) .
2870
2871  ****************
2872  op minimizeBindingsTerm** : Module TermList ---variables to minimize bindings
2873                             Nat --- or maximum index of variables
2874                             VariantFour Substitution Substitution
2875                          -> VariantFour .
2876  eq minimizeBindingsTerm**(M,TL',NOld,{T,S*,S'*,N},none,none)
2877   = {T,remDup(S*),remDup(S'*),N} .
2878
2879 ceq minimizeBindingsTerm**(M,TL',NOld,{T,S*,V <- V' ; S'*,N},none,V <- V' ; S')
2880   = minimizeBindingsTerm**(M,TL',NOld,
2881         { T << (V' <- V), S* << (V' <- V),    S'* .. (V' <- V),  N},
2882         none,
2883         S' .. (V' <- V)
2884     )
2885  if V' =/= V and-then not (V in TL') and-then not (V' in TL')
2886     and-then highestVar(V) < NOld
2887     and-then highestVar(V') >= NOld
2888     and-then typeLeq(M,getTypes(M,V),getTypes(M,V')) .
2889
2890  eq minimizeBindingsTerm**(M,TL',NOld,{T,S*,V <- T' ; S'*,N},none,V <- T' ; S')
2891   = minimizeBindingsTerm**(M,TL',NOld,{T,S*,V <- T' ; S'*,N},none,S')
2892  [owise] .
2893
2894 ceq minimizeBindingsTerm**(M,TL',NOld,{T,V <- V' ; S*,S'*,N},V <- V' ; S,S')
2895   = minimizeBindingsTerm**(M,TL',NOld,
2896         { T << (V' <- V), S* << (V' <- V),   S'* .. (V' <- V),   N},
2897         S << (V' <- V),
2898         S' .. (V' <- V)
2899     )
2900  if V' =/= V and-then V in TL' and-then not (V' in TL')
2901     and-then typeLeq(M,getTypes(M,V),getTypes(M,V')) .
2902
2903  eq minimizeBindingsTerm**(M,TL',NOld,{T,V <- T' ; S*,S'*,N},V <- T' ; S,S')
2904   = minimizeBindingsTerm**(M,TL',NOld,{T,V <- T' ; S*,S'*,N},S,S')
2905  [owise] .
2906
2907  ****
2908  op remDup : Substitution -> Substitution .
2909  eq remDup(V <- V ; S) = remDup(S) .
2910  eq remDup(S) = S [owise] .
2911
2912endfm
2913fmod TYPEOFNARROWING is
2914  pr QID .
2915  pr META-TERM .
2916
2917  --- TypeOfNarrowing ----------------------------------
2918  sorts TypeOfNarrowingElem TypeOfNarrowing .
2919  subsort TypeOfNarrowingElem < TypeOfNarrowing .
2920  op none : -> TypeOfNarrowing [ctor] .
2921  op __ : TypeOfNarrowing TypeOfNarrowing -> TypeOfNarrowing
2922          [ctor assoc comm id: none] .
2923  ---eq X:TypeOfNarrowingElem X:TypeOfNarrowingElem = X:TypeOfNarrowingElem .
2924
2925  *** select one and only one of the following
2926  op full : -> TypeOfNarrowingElem [ctor] .
2927  op basic : -> TypeOfNarrowingElem [ctor] .
2928  op variant : -> TypeOfNarrowingElem [ctor] .
2929  op variant : Nat -> TypeOfNarrowingElem [ctor] .
2930  op E-rewriting : -> TypeOfNarrowingElem [ctor] .
2931
2932  *** Extra flags
2933  op rigidife : Qid -> TypeOfNarrowingElem [ctor] .
2934
2935  *** Irreducible terms for equational unification to check
2936  op irrTerms : TermList -> TypeOfNarrowingElem [ctor] .
2937
2938  op getIrrTerms : TypeOfNarrowing -> TermList .
2939  eq getIrrTerms(X:TypeOfNarrowing irrTerms(TL:TermList)) = TL:TermList .
2940  eq getIrrTerms(X:TypeOfNarrowing) = empty [owise] .
2941
2942  *** select one and only one of the following
2943  op E-ACU-unify : -> TypeOfNarrowingElem [ctor] .
2944  op E-ACU-unify-Irr : -> TypeOfNarrowingElem [ctor] .
2945  op ACU-unify : -> TypeOfNarrowingElem [ctor] .
2946  op BuiltIn-unify : -> TypeOfNarrowingElem [ctor] .
2947  op E-BuiltIn-unify : -> TypeOfNarrowingElem [ctor] .
2948  op E-BuiltIn-unify-Irr : -> TypeOfNarrowingElem [ctor] .
2949
2950  *** select one and only one of the following
2951  op noStrategy : -> TypeOfNarrowingElem [ctor] .
2952  op topmost : -> TypeOfNarrowingElem [ctor] .
2953  op innermost : -> TypeOfNarrowingElem [ctor] .
2954  op outermost : -> TypeOfNarrowingElem [ctor] .
2955
2956  *** select any combination of the following
2957  op E-normalize-terms : -> TypeOfNarrowingElem [ctor] .
2958  op normalize-terms : -> TypeOfNarrowingElem [ctor] .
2959  op computed-normalized-subs : -> TypeOfNarrowingElem [ctor] .
2960  op applied-normalized-subs : -> TypeOfNarrowingElem [ctor] .
2961  op minimal-unifiers : -> TypeOfNarrowingElem [ctor] .
2962  op testUnifier : -> TypeOfNarrowingElem [ctor] .
2963  op alsoAtVarPosition : -> TypeOfNarrowingElem [ctor] .
2964
2965  op _in_ : TypeOfNarrowingElem TypeOfNarrowing -> Bool .
2966  eq X:TypeOfNarrowingElem in X:TypeOfNarrowingElem XS:TypeOfNarrowing
2967   = true .
2968  eq variant in variant(N:Nat) XS:TypeOfNarrowing
2969   = true .
2970  eq X:TypeOfNarrowingElem in XS:TypeOfNarrowing
2971   = false [owise] .
2972
2973  op _!in_ : TypeOfNarrowingElem TypeOfNarrowing -> Bool .
2974  eq X:TypeOfNarrowingElem !in XS:TypeOfNarrowing
2975   = not (X:TypeOfNarrowingElem in XS:TypeOfNarrowing) .
2976  -------------------------------------------------------
2977
2978  sort TypeOfRelation .
2979  ops '* '! '+ : -> TypeOfRelation .
2980
2981  op [_] : TypeOfRelation -> Qid .
2982  eq [ '+ ] = qid("+") .
2983  eq [ '* ] = qid("*") .
2984  eq [ '! ] = qid("!") .
2985
2986  op typeOfRelation : Qid ~> TypeOfRelation .
2987  eq typeOfRelation( '+ ) = '+ .
2988  eq typeOfRelation( '* ) = '* .
2989  eq typeOfRelation( '! ) = '! .
2990endfm
2991
2992fmod IRR-FLAGS is
2993  sort IrrFlags .
2994  op __ : IrrFlags IrrFlags -> IrrFlags [assoc comm id: none] .
2995  op none : -> IrrFlags [ctor] .
2996  op irreducible : -> IrrFlags [ctor] .
2997  op reducible : -> IrrFlags [ctor] .
2998  op minimal-unifiers : -> IrrFlags [ctor] .
2999endfm
3000
3001fmod EFLAGS is
3002  pr TYPEOFNARROWING .
3003  pr IRR-FLAGS .
3004
3005  sort EFlags .
3006  subsort IrrFlags < EFlags .
3007  op __ : EFlags EFlags -> EFlags [assoc comm id: none] .
3008  op none : -> EFlags [ctor] .
3009  op ACUUnify : -> EFlags [ctor] .
3010  op BuiltInUnify : -> EFlags [ctor] .
3011  op testUnifier : -> EFlags [ctor] .
3012
3013  op _in_ : EFlags EFlags -> Bool .
3014  eq X:EFlags in X:EFlags Y:EFlags = true .
3015  eq X:EFlags in Y:EFlags = false [owise] .
3016
3017  op _!in_ : EFlags EFlags -> Bool .
3018  eq X:EFlags !in Y:EFlags = not (X:EFlags in Y:EFlags) .
3019
3020  op [_] : EFlags -> TypeOfNarrowing .
3021  eq [ ACUUnify X:EFlags ] = ACU-unify [ X:EFlags ] .
3022  eq [ BuiltInUnify X:EFlags ] = BuiltIn-unify [ X:EFlags ] .
3023  eq [ minimal-unifiers X:EFlags ] = minimal-unifiers [ X:EFlags ] .
3024  eq [ testUnifier X:EFlags ] = testUnifier [ X:EFlags ] .
3025  eq [ X:EFlags ] = none [owise] .
3026endfm
3027
3028fmod RESULT-CONTEXT-SET is
3029  protecting META-TERM .
3030  protecting META-LEVEL-MNPA .
3031  protecting TERM-HANDLING .
3032  protecting SUBSTITUTION-HANDLING .
3033  protecting RENAMING .
3034  protecting SUBSTITUTIONSET .
3035  protecting UNIFICATIONTRIPLESET .
3036  protecting MODULE-HANDLING .
3037
3038  vars T T' TS CtTS : Term .
3039  var TP : Type .
3040  vars S S' Subst Subst' : Substitution .
3041  var NL : NatList .
3042  var M : Module .
3043  vars Ct CtS : Context .
3044  vars RTS RTS' : ResultContextSet .
3045  vars NextVar N : Nat .
3046  var TL : TermList .
3047
3048  op subTerm_of_ : NatList ResultTriple ~> ResultTriple .
3049  eq subTerm NL of {T,TP,S} = {subTerm NL of T,TP,S} .
3050
3051  op replaceSubTerm_of_by_ : NatList ResultTriple Term ~> ResultTriple .
3052  eq replaceSubTerm NL of {T,TP,S} by T' = {replaceSubTerm NL of T by T',TP,S} .
3053
3054  --- ResultTriple ---------------------------
3055  --- op {_,_,_} : Term Type Substitution -> ResultTriple [ctor] .
3056
3057  sort ResultTripleSet .
3058  subsort ResultTriple < ResultTripleSet .
3059  op empty : -> ResultTripleSet [ctor] .
3060  op _|_ : ResultTripleSet ResultTripleSet -> ResultTripleSet
3061    [ctor assoc comm id: empty prec 65 format (d d n d)] .
3062  eq X:ResultTriple | X:ResultTriple = X:ResultTriple .
3063
3064  var RT : ResultTripleSet .
3065
3066  op _|>_ : ResultTripleSet TermList -> ResultTripleSet .
3067  eq (empty).ResultTripleSet |> TL = (empty).ResultTripleSet .
3068  eq ({T,TP,S} | RT) |> TL = {T,TP,S |> TL} | (RT |> TL) .
3069  eq (failure | RT ) |> TL = failure | (RT |> TL) .
3070
3071  op getTerms : ResultTripleSet -> TermSet .
3072  eq getTerms({T:Term,TP:Type,S:Substitution} | R:ResultTripleSet)
3073   = T:Term | getTerms(R:ResultTripleSet) .
3074  eq getTerms((empty).ResultTripleSet)
3075   = emptyTermSet .
3076
3077  op getSubstitutions : ResultTripleSet -> SubstitutionSet .
3078  eq getSubstitutions({T,TP,S} | R:ResultTripleSet)
3079   = S | getSubstitutions(R:ResultTripleSet) .
3080  eq getSubstitutions((empty).ResultTripleSet)
3081   = (empty).SubstitutionSet .
3082
3083  --- ResultContextSet ---------------------------
3084
3085  --- Flags
3086  sort Flags Flag .
3087  subsort Flag < Flags .
3088
3089  op empty : -> Flags [ctor] .
3090  op __ : Flags Flags -> Flags [ctor assoc comm id: empty] .
3091  eq X:Flag X:Flag = X:Flag .
3092
3093  --- Flag to know whether term is a end point or not
3094  op end : Bool -> Flag [ctor frozen] .
3095
3096  op end : Bool Flags -> Flags .
3097  eq end(B:Bool, end(B':Bool) B:Flags) = end(B:Bool) B:Flags .
3098  eq end(B:Bool, B:Flags) = end(B:Bool) B:Flags [owise] .
3099
3100  op end : Flags -> Bool .
3101  eq end(end(B:Bool) B:Flags) = B:Bool .
3102  eq end(B:Flags) = false [owise] .
3103  ---
3104
3105  sorts TraceNarrowStep TraceNarrow TraceNarrowSet .
3106  subsort TraceNarrowStep < TraceNarrow < TraceNarrowSet .
3107  op {_,_,_,_} : Term Substitution Type Rule -> TraceNarrowStep [ctor format (d d d d d n d n d d)] .
3108  op nil : -> TraceNarrow [ctor] .
3109  op __ : TraceNarrow TraceNarrow -> TraceNarrow [ctor assoc id: nil format (d n d)] .
3110  op empty : -> TraceNarrowSet [ctor] .
3111  op _|_ : TraceNarrowSet TraceNarrowSet -> TraceNarrowSet [ctor assoc comm id: empty format (d n n d)] .
3112
3113  ---
3114  sorts ResultContext ResultContextSet ResultContextNeSet .
3115  op {_,_,_,_,_,_,_,_,_,_,_} :
3116      Term Type
3117      Substitution Substitution --- computed subs and applied subst
3118      Context Context --- Original and WithSubst
3119      Term Term --- TermWithSubst and ContextWithTermAndSubt
3120      Nat --- highest index of variable
3121      TraceNarrow
3122      Flags
3123      -> ResultContext [ctor] .
3124
3125  subsort ResultContext < ResultContextNeSet < ResultContextSet .
3126  op empty : -> ResultContextSet [ctor] .
3127  op _|_ : ResultContextSet ResultContextSet -> ResultContextSet
3128    [ctor assoc comm id: empty prec 65 format (d n d d)] .
3129  op _|_ : ResultContextNeSet ResultContextSet -> ResultContextNeSet
3130    [ctor ditto] .
3131  eq X:ResultContext | X:ResultContext = X:ResultContext .
3132
3133  op getCTTerm : ResultContext -> Term .
3134  eq getCTTerm(
3135      {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags})
3136   = CtTS:Term .
3137  op getNextVar : ResultContext -> Nat .
3138  eq getNextVar(
3139      {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags})
3140   = NextVar .
3141  op getLSubst : ResultContext -> Substitution .
3142  eq getLSubst(
3143      {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags})
3144   = S .
3145  op getRSubst : ResultContext -> Substitution .
3146  eq getRSubst(
3147      {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags})
3148   = S' .
3149
3150  op _<<_ : ResultContext UnificationTripleSet -> ResultContextSet .
3151  eq {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags}
3152     << (empty).UnificationTripleSet
3153   = (empty).ResultContextSet .
3154  eq {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags}
3155     << ({Subst,Subst',N} | SS:UnificationTripleSet)
3156   = {T,
3157      TP,
3158      (S .. Subst) << Subst', (S' .. Subst') << Subst,
3159      Ct:Context,
3160      CtS:Context << (Subst ; Subst'),
3161      TS:Term << (Subst ; Subst'),
3162      CtTS:Term << (Subst ; Subst'),
3163      max(NextVar,N + 1),
3164      (Tr:TraceNarrow << T TP <) << {Subst,Subst',N},
3165      B:Flags}
3166     | {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags}
3167         << SS:UnificationTripleSet .
3168
3169  op _<<__< : TraceNarrow Term Type -> TraceNarrow .
3170  eq (nil).TraceNarrow << T:Term TP:Type <
3171   = (nil).TraceNarrow .
3172  eq (Tr:TraceNarrow {T$:Term,none,TP$:Type,R:Rule}) --- Subst none here is special
3173     << T:Term TP:Type <
3174   = (Tr:TraceNarrow {T:Term,none,TP:Type,R:Rule}) .
3175  eq (Tr:TraceNarrow {T$:Term,S:Substitution,TP$:Type,R:Rule})
3176     << T:Term TP:Type <
3177   = (Tr:TraceNarrow {T$:Term,S:Substitution,TP$:Type,R:Rule}) [owise] .
3178
3179  op _<<_ : TraceNarrow UnificationTriple -> TraceNarrow .
3180  eq (nil).TraceNarrow << {Subst,Subst',N}
3181   = (nil).TraceNarrow .
3182  eq (Tr:TraceNarrow {T$:Term,S:Substitution,TP$:Type,R:Rule}) --- Subst none here is special
3183     << {Subst,Subst',N}
3184   = (Tr:TraceNarrow {T$:Term << (Subst ; Subst'),S:Substitution .. (Subst ; Subst'),TP$:Type,R:Rule}) .
3185
3186  op canonice : Module TraceNarrow -> TraceNarrow .
3187  eq canonice(M, (nil).TraceNarrow) = nil .
3188  eq canonice(M, Tr:TraceNarrow {T$:Term,S:Substitution,TP$:Type,R:Rule})
3189   = {canonice(M,T$:Term),canonice(M,S:Substitution),TP$:Type,R:Rule} canonice(M, Tr:TraceNarrow) .
3190
3191  op toTriple : Module ResultContextSet -> ResultTripleSet .
3192  eq toTriple(M, empty ) = empty .
3193  eq toTriple(M, {T,TP,S,S',Ct,CtS,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} | RTS )
3194   = {CtTS:Term, leastSort(M,CtTS:Term), S .. S'}
3195     | toTriple(M,RTS) .
3196
3197  op _|>_ : ResultContextSet TermList -> ResultContextSet .
3198  eq (empty).ResultContextSet |> TL = (empty).ResultContextSet .
3199  eq ({T,TP,S,S',Ct,CtS,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags}
3200      | RTS:ResultContextSet) |> TL
3201   = {T,TP,S |> TL,S' |> TL,Ct,CtS,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags}
3202     | (RTS:ResultContextSet |> TL) .
3203
3204  op getTerms : ResultContextSet -> TermSet .
3205  eq getTerms({T,TP,S,S',Ct,CtS,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags} | RTS)
3206   = CtTS:Term | getTerms(RTS) .
3207  eq getTerms((empty).ResultContextSet)
3208   = emptyTermSet .
3209
3210  op toUnificationTriples : ResultContextSet -> UnificationTripleSet .
3211  eq toUnificationTriples(
3212      {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} | R:ResultContextSet)
3213   = {S,S',NextVar}
3214     | toUnificationTriples(R:ResultContextSet) .
3215  eq toUnificationTriples((empty).ResultContextSet)
3216   = (empty).UnificationTripleSet .
3217
3218  *** auxiliary Sort SubstitutionCond for metaNarrowSearch *****
3219  sort SubstitutionCond .
3220  subsort Substitution < SubstitutionCond .
3221
3222  op |_| : ResultTripleSet -> Nat .
3223  eq | (empty).ResultTripleSet | = 0 .
3224  eq | (RT:ResultTriple | RTS:ResultTripleSet) |
3225   = | RTS:ResultTripleSet | + 1 .
3226
3227  op |_| : ResultContextSet -> Nat .
3228  eq | (empty).ResultContextSet | = 0 .
3229  eq | (RT:ResultContext | RTS:ResultContextSet) |
3230   = | RTS:ResultContextSet | + 1 .
3231
3232endfm
3233
3234fmod META-MATCH is
3235  protecting TERM-HANDLING .
3236  protecting MODULE-HANDLING .
3237  protecting SUBSTITUTION-HANDLING .
3238  protecting META-LEVEL-MNPA .
3239  protecting RENAMING .
3240  protecting SUBSTITUTIONSET .
3241
3242  vars T T' : Term .
3243  vars TL TL' : TermList .
3244  var M : Module .
3245  vars S S' : Substitution .
3246  var S? : Substitution? .
3247  vars SS SS' : SubstitutionSet .
3248  vars V V' : Variable .
3249  vars TPL TPL' : TypeList .
3250  vars N N' : Nat .
3251
3252  --- Not defined in this module ----------------------------------------
3253  op isNF$ : Module Term ~> Bool .
3254  --- Not defined in this module ----------------------------------------
3255
3256  --- metaCoreMatch(M,T,T') implies that T is an instance of T'
3257  op metaCoreMatch : Module Term Term -> SubstitutionSet .
3258  eq metaCoreMatch(M,T,T')
3259   = metaCoreMatch$(M,canonice(M,T),canonice(M,T')) .
3260
3261  op metaCoreMatch$ : Module Term Term -> SubstitutionSet .
3262  eq metaCoreMatch$(M,T,T')
3263   = if glbSorts(M,leastSort(M,T),leastSort(M,T')) == none
3264     then empty
3265     else metaCoreMatchCollect(eraseEqs(eraseRls(M)),T,T')
3266     fi .
3267
3268  op metaCoreMatch? : Module Term Term -> Bool .
3269  eq metaCoreMatch?(M,T,T')
3270   = metaCoreMatch?$(M,canonice(M,T),canonice(M,T')) .
3271
3272  op metaCoreMatch?$ : Module Term Term -> Bool .
3273  eq metaCoreMatch?$(M,T,T')
3274   = glbSorts(M,leastSort(M,T),leastSort(M,T')) =/= none
3275     and-then
3276     metaMatch(eraseEqs(eraseRls(M)),T',T,nil,0) =/= noMatch .
3277
3278  --- metaCoreMatchCollect(M,T,T') calls Maude metaMatch
3279  op metaCoreMatchCollect : Module Term Term -> SubstitutionSet .
3280  eq metaCoreMatchCollect(M,T,T')
3281   = metaCoreMatchCollect*(M,T,T',empty,0) .
3282
3283  op metaCoreMatchCollect* : Module Term Term SubstitutionSet Nat
3284                             -> SubstitutionSet .
3285  eq metaCoreMatchCollect*(M,T,T',SS,N:Nat)
3286   = if metaMatch(M,T',T,nil,N:Nat) =/= noMatch
3287     then metaCoreMatchCollect*(M,T,T',
3288                            SS | metaMatch(M,T',T,nil,N:Nat),
3289                            s(N:Nat))
3290     else SS
3291     fi .
3292
3293  op metaBuiltInEqual : Module TermList Term Term -> Bool .
3294  eq metaBuiltInEqual(M,TL,T,T')
3295   = canonice(M,T) == canonice(M,T') .
3296
3297endfm
3298fmod VARIANT-HANDLING is
3299  pr SUBSTITUTION-HANDLING .
3300  pr META-MINIMIZE-BINDINGS .
3301  pr RESULT-CONTEXT-SET .
3302  pr MODULE-HANDLING .
3303  pr META-LEVEL-MNPA .
3304  pr VARIANT .
3305
3306  var M : Module .
3307  vars T T' TS TS' CtTS CtTS' Lhs Rhs : Term .
3308  vars N N' NextVar NextVar' NextVar'' : Nat .
3309  var B : Bound .
3310  var TL TL' : TermList .
3311  var NeTL : NeTermList .
3312  var EqS : EquationSet .
3313  var AtS : AttrSet .
3314  var Q : Qid .
3315  vars S S' : Substitution .
3316  var V : Variable .
3317  var R RT : ResultContext .
3318  vars RTS RTS' : ResultContextSet .
3319  vars TP TP' : Type .
3320  vars Ct Ct' CtS CtS' : Context .
3321  var C : Constant .
3322  vars F F' : Qid .
3323
3324  var VTS : VariantFourSet .
3325
3326  op toVariants : Nat ResultContextSet -> VariantFourSet .
3327  eq toVariants(OldNextVar:Nat,empty)
3328   = empty .
3329  eq toVariants(OldNextVar:Nat,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} | RTS)
3330   = {CtTS,S |> OldNextVar:Nat,S' |> OldNextVar:Nat,NextVar}
3331      | toVariants(OldNextVar:Nat,RTS) .
3332
3333  op _|>_ : VariantFourSet TermList -> VariantFourSet .
3334  eq (empty).VariantFourSet |> TL = empty .
3335  eq ({T,S,S',N} | VTS) |> TL = {T,(S |> TL),(S' |> TL),N} | (VTS |> TL) .
3336
3337  op getTerms : VariantFourSet -> TermSet .
3338  eq getTerms({T:Term,S:Substitution,S':Substitution,NextVar:Nat}
3339              | R:VariantFourSet)
3340   = T:Term | getTerms(R:VariantFourSet) .
3341  eq getTerms((empty).VariantFourSet)
3342   = emptyTermSet .
3343
3344  op toVariantTripleSet : VariantFourSet -> VariantTripleSet .
3345  eq toVariantTripleSet(empty)
3346   = empty .
3347  eq toVariantTripleSet({T,S,S',NextVar} | VTS)
3348---    = {T,S ; S',NextVar} | toVariantTripleSet(VTS) .
3349   = {T,S,NextVar,none,false} | toVariantTripleSet(VTS) . ---- ",none,false" added without much understanding
3350
3351endfm
3352
3353fmod RIGIDIFE is
3354  protecting UNIFICATIONTRIPLESET .
3355  protecting MODULE-HANDLING .
3356  protecting RESULT-CONTEXT-SET .
3357  protecting VARIANT .
3358
3359  vars V V' : Variable .
3360  var C : Constant .
3361  vars F Q : Qid .
3362  vars U U' : UnificationTriple .
3363  vars US US' : UnificationTripleSet .
3364  vars S S' S1 S1' S2 S2' S* : Substitution .
3365  vars Ct CtS Ct' CtS' : Context .
3366  vars TS TS' CtTS CtTS' : Term .
3367  var SS : SubstitutionSet .
3368  var SSe : NeSubstitutionSet .
3369  vars N N' N1 N2 NextVar : Nat .
3370  vars T T' : Term .
3371  vars TL TL' : TermList .
3372  var NeTL : NeTermList .
3373  var M : Module .
3374  var RTS : ResultTripleSet .
3375  var TP : Type .
3376
3377  sort PairRigidife .
3378  op {_,_} : Module TermList -> PairRigidife .
3379  op getM : PairRigidife -> Module .
3380  eq getM({M,TL}) = M .
3381  op getTL : PairRigidife -> TermList .
3382  eq getTL({M,TL}) = TL .
3383
3384  *** Transform variables in TermList into constants
3385  op rigidifeList : Module Qid TermList TermList -> PairRigidife .
3386  eq rigidifeList(M,Q,TL,empty)
3387   = {M,TL} .
3388  eq rigidifeList(M,Q,(T,NeTL),TL)
3389   = { getM(rigidifeList(getM(rigidifeList(M,Q,T,TL)),Q,NeTL,TL)),
3390       (getTL(rigidifeList(M,Q,T,TL)),
3391        getTL(rigidifeList(getM(rigidifeList(M,Q,T,TL)),Q,NeTL,TL))) } .
3392  eq rigidifeList(M,Q,C,TL)
3393   = {M,C} .
3394  eq rigidifeList(M,Q,F[NeTL],TL)
3395   = {getM(rigidifeList(M,Q,NeTL,TL)),
3396      F[getTL(rigidifeList(M,Q,NeTL,TL))]} .
3397  eq rigidifeList(M,Q,V,TL)
3398   = if V in TL then rigidifeVar***(M,Q,V) else {M,V} fi .
3399
3400  *** Transform all variables into constants
3401  op rigidifeAllVar : Module Qid TermList -> PairRigidife .
3402  eq rigidifeAllVar(M,Q,TL)
3403   = rigidifeNat(M,Q,TL,0) .
3404
3405  *** Transform variables above Nat into constants
3406  op rigidifeNat : Module Qid TermList Nat -> PairRigidife .
3407  eq rigidifeNat(M,Q,(T,NeTL),N)
3408   = { getM(rigidifeNat(getM(rigidifeNat(M,Q,T,N)),Q,NeTL,N)),
3409       (getTL(rigidifeNat(M,Q,T,N)),
3410        getTL(rigidifeNat(getM(rigidifeNat(M,Q,T,N)),Q,NeTL,N))) } .
3411  eq rigidifeNat(M,Q,C,N)
3412   = {M,C} .
3413  eq rigidifeNat(M,Q,F[NeTL],N)
3414   = {getM(rigidifeNat(M,Q,NeTL,N)),
3415      F[getTL(rigidifeNat(M,Q,NeTL,N))]} .
3416  eq rigidifeNat(M,Q,V,N)
3417   = if highestVar(V) >= N then rigidifeVar***(M,Q,V) else {M,V} fi .
3418
3419  *** Transform variables with rigid# into constants
3420  op rigidifeRigid : Module Qid TermList -> PairRigidife .
3421  eq rigidifeRigid(M,Q,(T,NeTL))
3422   = { getM(rigidifeRigid(getM(rigidifeRigid(M,Q,T)),Q,NeTL)),
3423       (getTL(rigidifeRigid(M,Q,T)),
3424        getTL(rigidifeRigid(getM(rigidifeRigid(M,Q,T)),Q,NeTL))) } .
3425  eq rigidifeRigid(M,Q,C)
3426   = {M,C} .
3427  eq rigidifeRigid(M,Q,F[NeTL])
3428   = {getM(rigidifeRigid(M,Q,NeTL)),
3429      F[getTL(rigidifeRigid(M,Q,NeTL))]} .
3430  eq rigidifeRigid(M,Q,V)
3431   = if rfind(string(V), "rigid#", length(string(V))) =/= notFound
3432     then rigidifeVar***(M,Q,V)
3433     else {M,V}
3434     fi .
3435
3436  *** Basic case for transforming variables into constants
3437  op rigidifeVar*** : Module Qid Variable -> PairRigidife .
3438  ceq rigidifeVar***(M,Q,V)
3439    = {addOps((op qid(F:String) : nil -> getType(V) [none].), M),
3440       qid(F:String + "." + string(getType(V)))}
3441   if F:String := "rigid@" + string(Q)
3442                     + "@" + string(getName(V)) + "@" + string(getType(V)) .
3443
3444  *** Undo the transformation of variables into constants
3445  op unrigidife : Qid TermList -> TermList .
3446  eq unrigidife(Q,(T,NeTL))
3447   = (unrigidife(Q,T),unrigidife(Q,NeTL)) .
3448  eq unrigidife(Q,V) = V .
3449  eq unrigidife(Q,F[TL]) = F[unrigidife(Q,TL)] .
3450  eq unrigidife(Q,C)
3451   = if rfind(string(C), "rigid@" + string(Q) + "@", length(string(C)))
3452          =/= notFound
3453     then qid(
3454           string(
3455             qid(
3456              substr(string(C),
3457               rfind(string(C), "rigid@" + string(Q) + "@", length(string(C)))
3458                + 7 + length(string(Q)),
3459               rfind(
3460                substr(string(C),
3461                  rfind(string(C), "rigid@" + string(Q) + "@", length(string(C)))
3462                   + 7 + length(string(Q)),
3463                  length(string(C))),
3464                "@",length(string(C))
3465               )
3466              )
3467             )
3468           )
3469           + ":" +
3470           string(getType(qid(
3471                   substr(string(C),
3472                   rfind(string(C), "rigid@" + string(Q) + "@",
3473                           length(string(C))) + 7 + length(string(Q)),
3474                   length(string(C)))
3475           )))
3476          )
3477     else C
3478     fi .
3479
3480  op unrigidife : Qid Substitution -> Substitution .
3481  eq unrigidife(Q,(none).Substitution) = none .
3482  eq unrigidife(Q,V <- T ; S)
3483   = unrigidife(Q,V) <- unrigidife(Q,T) ; unrigidife(Q,S) .
3484
3485  op unrigidife : Qid SubstitutionSet -> SubstitutionSet .
3486  eq unrigidife(Q,(empty).SubstitutionSet) = empty .
3487  eq unrigidife(Q,S | SSe)
3488   = unrigidife(Q,S) | unrigidife(Q,SSe) .
3489
3490  op unrigidife : Qid UnificationTripleSet -> UnificationTripleSet .
3491  eq unrigidife(Q,(empty).UnificationTripleSet) = empty .
3492  eq unrigidife(Q,{S1,S2,N'} | US)
3493   = {unrigidife(Q,S1),unrigidife(Q,S2),N'}
3494     | unrigidife(Q,US) .
3495
3496  op unrigidife : Qid ResultTripleSet -> ResultTripleSet .
3497  eq unrigidife(Q,(empty).ResultTripleSet) = empty .
3498  eq unrigidife(Q,{T,TP,S} | RTS)
3499   = {unrigidife(Q,T),TP,unrigidife(Q,S)}
3500     | unrigidife(Q,RTS) .
3501
3502  op unrigidife : Qid VariantFourSet -> VariantFourSet  .
3503  eq unrigidife(Q,(empty).VariantFourSet) = empty .
3504  eq unrigidife(Q,{T,S,S',N} | R:VariantFourSet)
3505   = {unrigidife(Q,T),unrigidife(Q,S),unrigidife(Q,S'),N}
3506     | unrigidife(Q,R:VariantFourSet) .
3507
3508  *** Label variables with rigid
3509  op rigidLabel : Module TermList TermList -> TermList .
3510  eq rigidLabel(M,TL,empty)
3511   = TL .
3512  eq rigidLabel(M,(T,NeTL),TL)
3513   = rigidLabel(M,T,TL), rigidLabel(M,NeTL,TL) .
3514  eq rigidLabel(M,C,TL)
3515   = C .
3516  eq rigidLabel(M,F[NeTL],TL)
3517   = F[rigidLabel(M,NeTL,TL)] .
3518  eq rigidLabel(M,V,TL)
3519   = if V in TL then rigidLabel***(M,V) else V fi .
3520
3521  op rigidLabel*** : Module Variable -> Variable .
3522  eq rigidLabel***(M,V)
3523   = qid("rigid#" + string(getName(V)) + ":" + string(getType(V))) .
3524
3525  *** Undo the transformation of variables into constants
3526  op unrigidLabel : TermList -> TermList .
3527  eq unrigidLabel((T,NeTL))
3528   = (unrigidLabel(T),unrigidLabel(NeTL)) .
3529  eq unrigidLabel(C) = C .
3530  eq unrigidLabel(F[TL]) = F[unrigidLabel(TL)] .
3531  eq unrigidLabel(V)
3532   = if rfind(string(V), "rigid#", length(string(V)))
3533          =/= notFound
3534     then qid(
3535          string(getName(qid(
3536                   substr(string(V),
3537                   rfind(string(V), "rigid#",
3538                           length(string(V))) + 6,
3539                   length(string(V)))
3540          )))
3541          + ":" +
3542          string(getType(qid(
3543                   substr(string(V),
3544                   rfind(string(V), "rigid#",
3545                           length(string(V))) + 6,
3546                   length(string(V)))
3547          )))
3548          )
3549     else V
3550     fi .
3551
3552  op unrigidLabel : Substitution -> Substitution .
3553  eq unrigidLabel((none).Substitution) = none .
3554  eq unrigidLabel(V <- T ; S)
3555   = unrigidLabel(V) <- unrigidLabel(T) ; unrigidLabel(S) .
3556
3557  op unrigidLabel : SubstitutionSet -> SubstitutionSet .
3558  eq unrigidLabel((empty).SubstitutionSet) = empty .
3559  eq unrigidLabel(S | SSe)
3560   = unrigidLabel(S) | unrigidLabel(SSe) .
3561
3562  op unrigidLabel : UnificationTripleSet -> UnificationTripleSet .
3563  eq unrigidLabel((empty).UnificationTripleSet) = empty .
3564  eq unrigidLabel({S1,S2,N'} | US)
3565   = {unrigidLabel(S1),unrigidLabel(S2),N'}
3566     | unrigidLabel(US) .
3567
3568  op unrigidLabel : ResultTripleSet -> ResultTripleSet .
3569  eq unrigidLabel((empty).ResultTripleSet) = empty .
3570  eq unrigidLabel({T,TP,S} | RTS)
3571   = {unrigidLabel(T),TP,unrigidLabel(S)}
3572     | unrigidLabel(RTS) .
3573
3574  op unrigidLabel : ResultContextSet -> ResultContextSet .
3575  eq unrigidLabel((empty).ResultContextSet) = empty .
3576  eq unrigidLabel({T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} | RTS:ResultContextSet)
3577   = {unrigidLabel(T),TP,unrigidLabel(S),unrigidLabel(S*),Ct,CtS,unrigidLabel(TS),unrigidLabel(CtTS),NextVar,unrigidLabel(Tr:TraceNarrow),B:Flags}
3578     | unrigidLabel(RTS:ResultContextSet) .
3579
3580  op unrigidLabel : TraceNarrow -> TraceNarrow .
3581  eq unrigidLabel((nil).TraceNarrow) = nil .
3582  eq unrigidLabel(Tr:TraceNarrow {CtTS:Term,Subst:Substitution,TP:Type,R:Rule})
3583   = unrigidLabel(Tr:TraceNarrow)
3584     {unrigidLabel(CtTS:Term),unrigidLabel(Subst:Substitution),TP:Type,R:Rule} .
3585
3586  op unrigidLabel : VariantFourSet -> VariantFourSet  .
3587  eq unrigidLabel((empty).VariantFourSet) = empty .
3588  eq unrigidLabel({T,S,S',N} | R:VariantFourSet)
3589   = {unrigidLabel(T),unrigidLabel(S),unrigidLabel(S'),N}
3590     | unrigidLabel(R:VariantFourSet) .
3591
3592  op qid : Nat -> Qid .
3593  eq qid(N:Nat) = qid(string(N:Nat,10)) .
3594
3595endfm
3596
3597fmod META-E-UNIFICATION is
3598  pr TYPEOFNARROWING .
3599  pr EFLAGS .
3600  pr RESULT-CONTEXT-SET .
3601  pr SUBSTITUTION-HANDLING .
3602  pr META-MINIMIZE-BINDINGS .
3603  pr RESULT-CONTEXT-SET .
3604  pr MODULE-HANDLING .
3605  pr META-LEVEL-MNPA .
3606  pr VARIANT .
3607  pr RIGIDIFE .
3608
3609  *** Repeated definitions to avoid cross calls between modules ************
3610  op normalizedSubstitution? : Module SubstitutionSet -> Bool .
3611  op metaACUUnify : Module Term Term Nat -> UnificationTripleSet .
3612  op metaACUUnify? : Module Term Term Nat -> Bool .
3613  op metaACUUnify* : Module UnificandPair Nat Nat ~> UnificationTriple? .
3614  op metaCoreUnify : Module Term Term Nat -> UnificationTripleSet .
3615  op metaCoreUnify? : Module Term Term Nat -> Bool .
3616  op metaBuiltInUnify : Module TermList Term Term Nat -> UnificationTripleSet .
3617  op metaBuiltInUnify? : Module TermList Term Term Nat -> Bool .
3618  op _<=[_]_ : SubstitutionSet Module SubstitutionSet -> Bool .
3619  op _<=[_]_ : Term Module Term -> Bool .
3620  *** Repeated definitions to avoid cross calls between modules ************
3621
3622  var M : Module .
3623  vars T T' TS TS' CtTS CtTS' Lhs Rhs : Term .
3624  vars N N' NextVar NextVar' NextVar'' NextVar1 NextVar2 NextVar3 : Nat .
3625  var B : Bound .
3626  var TL TL' : TermList .
3627  var NeTL : NeTermList .
3628  var EqS : EquationSet .
3629  var AtS : AttrSet .
3630  var ON : TypeOfNarrowing .
3631  var Q : Qid .
3632  vars US US' US$ : UnificationTripleSet .
3633  vars U U' : UnificationTriple .
3634  vars S S' S* S'* S1 S1' S2 S2' S3 S3' : Substitution .
3635  var V : Variable .
3636  var R RT : ResultContext .
3637  vars RTS RTS' : ResultContextSet .
3638  vars TP TP' : Type .
3639  vars Ct Ct' CtS CtS' : Context .
3640  var C : Constant .
3641  vars F F' : Qid .
3642  var EF : EFlags .
3643  vars VT VT' : VariantFour .
3644  vars VTS VTS' VTS$ : VariantFourSet .
3645  var IRR : IrrFlags .
3646
3647  --- metaECoreUnify --------------------------------------------------
3648  op metaECoreUnify : Module Term Term TermList -> SubstitutionSet .
3649                     --- Term Lhs
3650  eq metaECoreUnify(M, T, T',TL)
3651   = metaEACUUnify(M, T, T',TL) .
3652
3653  op metaECoreUnify? : Module Term Term TermList -> Bool .
3654  eq metaECoreUnify?(M, T, T', TL)
3655   = metaEACUUnify?(M, T, T', TL) .
3656
3657  --- metaVariantUnify --------------------------------------------------
3658  op metaVariantUnify : Module Term Term -> SubstitutionSet .
3659  eq metaVariantUnify(M, T, T') = metaEACUUnify(M, T, T', empty) .
3660
3661  op metaVariantUnify : Module Term Term TermList -> SubstitutionSet .
3662  eq metaVariantUnify(M, T, T', TL) = metaEACUUnify(M, T, T', TL) .
3663
3664  op metaVariantUnify? : Module Term Term TermList -> Bool .
3665  eq metaVariantUnify?(M, T, T', TL) = metaEACUUnify?(M, T, T', TL) .
3666
3667  op metaVariantUnify : Module Term Term Nat IrrFlags -> UnificationTripleSet .
3668  eq metaVariantUnify(M, T, T',NextVar,IRR) = metaEACUUnify(M, T, T',empty,NextVar,IRR) .
3669
3670  op metaVariantUnify : Module Term Term TermList Nat IrrFlags -> UnificationTripleSet .
3671  eq metaVariantUnify(M, T, T',TL,NextVar,IRR) = metaEACUUnify(M, T, T',TL,NextVar,IRR) .
3672
3673  op metaVariantUnify? : Module Term Term TermList Nat IrrFlags -> Bool .
3674  eq metaVariantUnify?(M, T, T',TL,NextVar,IRR) = metaEACUUnify?(M, T, T',TL,NextVar,IRR) .
3675
3676  --- metaEACUUnify --------------------------------------------------
3677  op metaEACUUnify : Module Term Term TermList -> SubstitutionSet .
3678  eq metaEACUUnify(M, T, T', TL)
3679   = toSubstitution(metaEACUUnify(M,T,T',TL,highestVar((T,T')) + 1,reducible)) .
3680
3681  op metaEACUUnify? : Module Term Term TermList -> Bool .
3682  eq metaEACUUnify?(M, T, T', TL)
3683   = metaEACUUnify?(M,T,T',TL,highestVar((T,T')) + 1,reducible) .
3684
3685  op metaEACUUnifyIrr : Module Term Term TermList -> SubstitutionSet .
3686                    --- T irreducible T' reducible
3687  eq metaEACUUnifyIrr(M, T, T',TL)
3688   = toSubstitution(metaEACUUnify(M,T,T',TL,highestVar((T,T')) + 1,irreducible)) .
3689
3690  op metaEACUUnifyIrr? : Module Term Term TermList -> Bool .
3691  eq metaEACUUnifyIrr?(M, T, T', TL)
3692   = metaEACUUnify?(M,T,T',TL,highestVar((T,T')) + 1,irreducible) .
3693
3694  op metaEACUUnify : Module Term Term TermList Nat IrrFlags -> UnificationTripleSet .
3695  eq metaEACUUnify(M, T, T',TL,NextVar,IRR)
3696   = minimizeBindingsTerm(M,Vars(T),NextVar,
3697          metaEUnify&(M, T, T',TL,NextVar,ACUUnify IRR)
3698     ) |> (T,T',TL) .
3699
3700  op metaEACUUnify? : Module Term Term TermList Nat IrrFlags -> Bool .
3701  eq metaEACUUnify?(M, T, T',TL,NextVar,IRR)
3702   = metaEUnify&?(M, T, T',TL,NextVar,ACUUnify IRR) .
3703
3704  --- metaEBuiltInUnify --------------------------------------------------
3705  op metaEBuiltInUnify : Module Term Term -> SubstitutionSet .
3706  eq metaEBuiltInUnify(M, T, T') = metaEBuiltInUnify(M, T, T',empty) .
3707
3708  op metaEBuiltInUnify : Module Term Term TermList -> SubstitutionSet .
3709  eq metaEBuiltInUnify(M, T, T', TL)
3710   = toSubstitution(metaEBuiltInUnify(M,T,T',TL,highestVar((T,T')) + 1,reducible)) .
3711
3712  op metaEBuiltInUnify? : Module Term Term -> Bool .
3713  eq metaEBuiltInUnify?(M, T, T') = metaEBuiltInUnify?(M, T, T',empty) .
3714
3715  op metaEBuiltInUnify? : Module Term Term TermList -> Bool .
3716  eq metaEBuiltInUnify?(M, T, T',TL)
3717   = metaEBuiltInUnify?(M,T,T',TL,highestVar((T,T')) + 1,reducible) .
3718
3719  op metaEBuiltInUnifyIrr : Module Term Term -> SubstitutionSet .
3720  eq metaEBuiltInUnifyIrr(M, T, T') = metaEBuiltInUnifyIrr(M, T, T', empty) .
3721
3722  op metaEBuiltInUnifyIrr : Module Term Term TermList -> SubstitutionSet .
3723                          --- T irreducible T' reducible
3724  eq metaEBuiltInUnifyIrr(M, T, T', TL)
3725   = toSubstitution(
3726       metaEBuiltInUnify(M,T,T',TL,highestVar((T,T')) + 1,irreducible)
3727     ) .
3728
3729  op metaEBuiltInUnifyIrr? : Module Term Term  -> Bool .
3730  eq metaEBuiltInUnifyIrr?(M, T, T') = metaEBuiltInUnifyIrr?(M, T, T', empty) .
3731
3732  op metaEBuiltInUnifyIrr? : Module Term Term TermList -> Bool .
3733                          --- T irreducible T' reducible
3734  eq metaEBuiltInUnifyIrr?(M, T, T', TL)
3735   = metaEBuiltInUnify?(M,T,T',TL,highestVar((T,T')) + 1,irreducible) .
3736
3737  op metaEBuiltInUnify : Module Term Term TermList Nat IrrFlags
3738                         -> UnificationTripleSet .
3739  eq metaEBuiltInUnify(M, T, T',TL,NextVar,IRR)
3740   = minimizeBindingsTerm(M,Vars(T),NextVar,
3741        metaEUnify&(M, T, T',TL,NextVar,BuiltInUnify IRR)
3742     ) |> (T,T') .
3743
3744  op metaEBuiltInUnify? : Module Term Term TermList Nat IrrFlags -> Bool .
3745  eq metaEBuiltInUnify?(M, T, T',TL,NextVar,IRR)
3746   = metaEUnify&?(M, T, T',TL,NextVar,BuiltInUnify IRR) .
3747
3748  --- metaEUnify --------------------------------------------------
3749  op metaEUnify& : Module Term Term TermList Nat EFlags -> UnificationTripleSet .
3750                      --- Term Lhs
3751  eq metaEUnify&(M,T,T',TL,NextVar,EF)
3752   = if sameKind(M,leastSort(M,T),leastSort(M,T'))
3753     then metaEUnify&*(removeBoolEqs(M),T,T',TL,NextVar,EF)
3754     else empty
3755     fi .
3756
3757  op metaEUnify&? : Module Term Term TermList Nat EFlags -> Bool .
3758                      --- Term Lhs
3759  eq metaEUnify&?(M,T,T',TL,NextVar,EF)
3760   = sameKind(M,leastSort(M,T),leastSort(M,T'))
3761     and-then
3762     metaEUnify&*?(removeBoolEqs(M),T,T',TL,NextVar,EF) .
3763
3764  op metaEUnify&* : Module Term Term TermList Nat EFlags -> UnificationTripleSet .
3765                      --- Term Lhs
3766  eq metaEUnify&*(M,T,T',TL,NextVar,EF)
3767   = if metaBuiltInUnify?(M,TL,
3768          fst(generalize(onlyEqsVariant(M),NextVar,T)),
3769          fst(generalize(onlyEqsVariant(M),
3770                         snd(generalize(onlyEqsVariant(M),NextVar,T)),T')),
3771          snd(generalize(onlyEqsVariant(M),
3772                         snd(generalize(onlyEqsVariant(M),NextVar,T)),T'))
3773        )
3774     then if T == fst(generalize(onlyEqsVariant(M),NextVar,T))
3775             and
3776             T' == fst(
3777                    generalize(onlyEqsVariant(M),
3778                               snd(generalize(onlyEqsVariant(M),NextVar,T)),T'))
3779          then --- no narrowing is necessary to unify
3780               metaBuiltInUnify(M,TL,T,T',NextVar)
3781          else metaEUnify$(M,T,T',TL,NextVar,EF)
3782          fi
3783     else empty
3784     fi .
3785
3786  op metaEUnify&*? : Module Term Term TermList Nat EFlags -> Bool .
3787                      --- Term Lhs
3788  eq metaEUnify&*?(M,T,T',TL,NextVar,EF)
3789   = if metaBuiltInUnify?(M,TL,
3790          fst(generalize(onlyEqsVariant(M),NextVar,T)),
3791          fst(generalize(onlyEqsVariant(M),
3792                         snd(generalize(onlyEqsVariant(M),NextVar,T)),T')),
3793          snd(generalize(onlyEqsVariant(M),
3794                         snd(generalize(onlyEqsVariant(M),NextVar,T)),T'))
3795        )
3796     then if T == fst(generalize(onlyEqsVariant(M),NextVar,T))
3797             and
3798             T' == fst(
3799                    generalize(onlyEqsVariant(M),
3800                               snd(generalize(onlyEqsVariant(M),NextVar,T)),T'))
3801          then --- no narrowing is necessary to unify
3802               metaBuiltInUnify?(M,TL,T,T',NextVar)
3803          else metaEUnify$?(M,T,T',TL,NextVar,EF)
3804          fi
3805     else false
3806     fi .
3807
3808  op metaEUnify$ : Module Term Term TermList Nat EFlags -> UnificationTripleSet .
3809                      --- Term Lhs
3810  eq metaEUnify$(M,T,T',TL,NextVar,irreducible EF)
3811   = metaEUnifyCollect(M,T,T',(T,TL),NextVar,0,empty) .
3812  eq metaEUnify$(M,T,T',TL,NextVar,EF)
3813   = metaEUnifyCollect(M,T,T',TL,NextVar,0,empty) [owise] .
3814
3815  op metaEUnify$? : Module Term Term TermList Nat EFlags -> Bool .
3816                      --- Term Lhs
3817  eq metaEUnify$?(M,T,T',TL,NextVar,irreducible EF)
3818   = metaEUnifyCollect?(M,T,T',(T,TL),NextVar,0) .
3819  eq metaEUnify$?(M,T,T',TL,NextVar,EF)
3820   = metaEUnifyCollect?(M,T,T',TL,NextVar,0) [owise] .
3821
3822  op metaEUnifyCollect : Module Term Term TermList Nat Nat
3823                          UnificationTripleSet
3824                       -> UnificationTripleSet  .
3825  eq metaEUnifyCollect(M,T,T',TL,N,N',US)
3826   = if metaEUnify*(M,T =? T',TL,N,N') :: UnificationTriple?
3827        and
3828        metaEUnify*(M,T =? T',TL,N,N') =/= noUnifier
3829     then metaEUnifyCollect(M,T,T',TL,N,s(N'),
3830             US | metaEUnify*(M,T =? T',TL,N,N') )
3831     else US
3832     fi .
3833
3834  op metaEUnifyCollect? : Module Term Term TermList Nat Nat
3835                       -> Bool .
3836  eq metaEUnifyCollect?(M,T,T',TL,N,N')
3837   = metaEUnify*(M,T =? T',TL,N,N') :: UnificationTriple?
3838     and
3839     metaEUnify*(M,T =? T',TL,N,N') =/= noUnifier .
3840
3841  *** Code for collection all unifiers
3842  op metaEUnify* : Module UnificandPair TermList Nat Nat ~> UnificationTriple? .
3843  eq metaEUnify*(M, T =? T',TL,N,N')
3844   = metaEUnifyTriple(
3845       M,
3846       unflatten(M,T) =? unflatten(M,T'),
3847       TL,N,N') .
3848
3849  op metaEUnifyTriple : Module UnificationProblem TermList Nat Nat ~> UnificationTriple? .
3850  eq metaEUnifyTriple(M,T =? T',TL,N,N')
3851   = if metaVariantUnify(M,T =? T',TL,N,N') == noUnifier
3852     then noUnifier
3853     else {getSubst(metaVariantUnify(M,T =? T',TL,N,N')) |> T,
3854           getSubst(metaVariantUnify(M,T =? T',TL,N,N')) |> T',
3855           getNextVar(metaVariantUnify(M,T =? T',TL,N,N'))}
3856     fi .
3857
3858  **************************************
3859  ***** Variant Generation
3860
3861  op getVariants : Module Term -> VariantFourSet .
3862  eq getVariants(M,T) = getVariants(M,T,highestVar(T) + 1) .
3863
3864  op getVariants : Module Term Nat -> VariantFourSet .
3865  eq getVariants(M,T,NextVar) = getVariants(M,T,NextVar,reducible BuiltInUnify) .
3866
3867  op getVariants : Module Term Nat TermList -> VariantFourSet .
3868  eq getVariants(M,T,NextVar,TL) = getVariants(M,T,NextVar,reducible BuiltInUnify,TL) .
3869
3870  op getVariants : Module Term Nat EFlags -> VariantFourSet .
3871  eq getVariants(M,T,NextVar,EF) = getVariants(M,T,NextVar,EF,empty) .
3872
3873  op getVariants : Module Term Nat EFlags TermList -> VariantFourSet .
3874  eq getVariants(M,T,NextVar,EF,TL)
3875   = unrigidife(qid(NextVar),
3876      getVariants*(
3877          getM(rigidifeRigid(M,qid(NextVar),T)),
3878          getTL(rigidifeRigid(M,qid(NextVar),T)),
3879          NextVar + 1,EF,TL
3880      )
3881     ) .
3882
3883  op getVariants* : Module Term Nat EFlags TermList -> VariantFourSet .
3884  eq getVariants*(M,T,NextVar,EF,TL)
3885   = if howMany(onlyEqsVariant(M),T) == 0
3886     then {T,none,none,NextVar}
3887     else if getVariants**(M,T,NextVar,EF,TL) :: VariantFourSet
3888             and
3889             getVariants**(M,T,NextVar,EF,TL) =/= empty
3890          then getVariants**(M,T,NextVar,EF,TL)
3891          else {T,none,none,NextVar}
3892          fi
3893     fi .
3894
3895  op getVariants** : Module Term Nat EFlags TermList -> VariantFourSet .
3896  eq getVariants**(M,T,NextVar,EF,TL)
3897   = minimizeBindingsTerm(M,Vars(T),NextVar,
3898            getVariants***(M,T,NextVar,empty,0,TL)
3899     ) .
3900
3901  op getVariants*** : Module Term Nat VariantFourSet Nat TermList -> VariantFourSet .
3902  eq getVariants***(M,T,NextVar,VTS,N,TL)
3903   = if metaGetVariant(M,T,TL,NextVar,N) == noVariant
3904     then VTS
3905     else getVariants***$(M,T,NextVar,VTS,N,
3906             metaGetVariant(M,T,TL,NextVar,N),TL)
3907     fi .
3908
3909  op getVariants***$ : Module Term Nat VariantFourSet Nat Variant TermList -> VariantFourSet .
3910  eq getVariants***$(M,T,NextVar,VTS,N,{T2:Term,S:Substitution,NV2:Nat, P:Parent, B:Bool},TL)
3911   = getVariants***$$(M,T,NextVar,VTS,N,{T2:Term,S:Substitution,NV2:Nat, P:Parent, B:Bool},
3912           split({S:Substitution,NV2:Nat},NextVar),TL) .
3913
3914  op getVariants***$$ : Module Term Nat VariantFourSet Nat Variant UnificationTriple TermList -> VariantFourSet .
3915  eq getVariants***$$(M,T,NextVar,VTS,N,
3916         {T2:Term,S:Substitution,NV2:Nat, P:Parent, B:Bool},
3917         {S1:Substitution,S2:Substitution,NV2:Nat},TL)
3918   = getVariants***(M,T,NextVar,
3919             VTS | {T2:Term,S1:Substitution,S2:Substitution,NV2:Nat},
3920             N + 1,TL) .
3921
3922  sort PairGeneralize .
3923  op {_,_} : TermList Nat -> PairGeneralize .
3924  op fst : PairGeneralize -> TermList .
3925  eq fst({X:TermList,Y:Nat}) = X:TermList .
3926  op snd : PairGeneralize -> Nat .
3927  eq snd({X:TermList,Y:Nat}) = Y:Nat .
3928
3929  op generalize : Module Nat NeTermList -> PairGeneralize .
3930  eq generalize(M,NextVar,NeTL)
3931   = generalize*(M,NextVar,getEqs(M),NeTL) .
3932
3933  op generalize* : Module Nat EquationSet TermList -> PairGeneralize .
3934  eq generalize*(M,NextVar,EqS,empty)
3935   = {empty,NextVar} .
3936  eq generalize*(M,NextVar,EqS,(T,TL))
3937   = {(fst(generalize**(M,NextVar,EqS,T)),
3938       fst(generalize*(M,snd(generalize**(M,NextVar,EqS,T)),EqS,TL))),
3939      snd(generalize*(M,snd(generalize**(M,NextVar,EqS,T)),EqS,TL))
3940     } .
3941
3942  op generalize** : Module Nat EquationSet Term -> PairGeneralize .
3943  eq generalize**(M,NextVar,EqS,C)
3944   = {C,NextVar} .
3945  eq generalize**(M,NextVar,EqS,V)
3946   = {V,NextVar} .
3947  ceq generalize**(M,NextVar,(eq F'[TL'] = Rhs [AtS] .) EqS,F[TL])
3948    = {newVar(NextVar,getKind(M,leastSort(M,F[TL]))),NextVar + 1}
3949   if F == F'
3950      and-then
3951      glbSorts(M,leastSort(M,TL),leastSort(M,TL')) =/= none .
3952  eq generalize**(M,NextVar,EqS,F[TL])
3953   = {F[fst(generalize*(M,NextVar,EqS,TL))],
3954      snd(generalize*(M,NextVar,EqS,TL))}
3955  [owise] .
3956
3957  *** Identify bound for terms
3958  op howMany : Module NeTermList -> Nat .
3959  eq howMany(M,NeTL)
3960   = howMany*(M,getEqs(M),NeTL << 0 < ) .
3961
3962  op howMany* : Module EquationSet TermList -> Nat .
3963  eq howMany*(M,EqS,empty)
3964   = 0 .
3965  eq howMany*(M,EqS,(T,TL))
3966   = howMany**(M,EqS,T) + howMany*(M,EqS,TL) .
3967
3968  op howMany** : Module EquationSet Term -> Nat .
3969  eq howMany**(M,EqS,C)
3970   = 0 .
3971  eq howMany**(M,EqS,V)
3972   = 0 .
3973  ceq howMany**(M,(eq F'[TL'] = Rhs [AtS] .) EqS,F[TL])
3974    = 1 + howMany*(M,(eq F'[TL'] = Rhs [AtS] .) EqS,TL)
3975   if F == F'
3976      and-then
3977      glbSorts(M,leastSort(M,TL),leastSort(M,TL')) =/= none
3978      and-then not isAssociative(M,F,getTypes(M,TL)) .
3979  ceq howMany**(M,(eq F'[TL'] = Rhs [AtS] .) EqS,F[TL])
3980    = sd(length(TL),1) + howMany*(M,(eq F'[TL'] = Rhs [AtS] .) EqS,TL)
3981   if F == F'
3982      and-then
3983      glbSorts(M,leastSort(M,TL),leastSort(M,TL')) =/= none
3984      and-then isCommutative(M,F,getTypes(M,TL))
3985      and-then isAssociative(M,F,getTypes(M,TL)) .
3986  eq howMany**(M,EqS,F[TL])
3987   = howMany*(M,EqS,TL) [owise] .
3988
3989
3990  *** Identify whether basic or variant narrowing should be used
3991  op howManyAC : Module NeTermList -> Nat .
3992  eq howManyAC(M,NeTL)
3993   = if howManyAC$(M,getEqs(M)) == 0
3994     then 0
3995     else howManyAC*(M,getEqs(M),NeTL << 0 < )
3996     fi .
3997
3998  op howManyAC* : Module EquationSet TermList -> Nat .
3999  eq howManyAC*(M,EqS,empty)
4000   = 0 .
4001  eq howManyAC*(M,EqS,(T,TL))
4002   = howManyAC**(M,EqS,T) + howManyAC*(M,EqS,TL) .
4003
4004  op howManyAC** : Module EquationSet Term -> Nat .
4005  eq howManyAC**(M,EqS,C)
4006   = 0 .
4007  eq howManyAC**(M,EqS,V)
4008   = 0 .
4009  ceq howManyAC**(M,(eq F'[TL'] = Rhs [AtS] .) EqS,F[TL])
4010    = sd(length(TL),1) + howManyAC*(M,(eq F'[TL'] = Rhs [AtS] .) EqS,TL)
4011   if F == F'
4012      and-then
4013      glbSorts(M,leastSort(M,TL),leastSort(M,TL')) =/= none
4014      and-then isCommutative(M,F,getTypes(M,TL))
4015      and-then isAssociative(M,F,getTypes(M,TL)) .
4016  eq howManyAC**(M,EqS,F[TL])
4017   = howManyAC*(M,EqS,TL) [owise] .
4018
4019  op length : TermList -> Nat .
4020  eq length((empty).TermList) = 0 .
4021  eq length((T:Term,TL:TermList)) = 1 + length(TL:TermList) .
4022
4023  op howManyAC$ : Module EquationSet -> Nat [memo] .
4024  eq howManyAC$(M,EqS)
4025   = howManyAC$$(M,EqS) .
4026
4027  op howManyAC$$ : Module EquationSet -> Nat .
4028  eq howManyAC$$(M,none)
4029   = 0 .
4030  eq howManyAC$$(M,(eq F[TL] = Rhs [AtS] .) EqS)
4031    = if isCommutative(M,F,getTypes(M,TL))
4032         and isAssociative(M,F,getTypes(M,TL))
4033      then 1 else 0 fi
4034      + howManyAC$$(M,EqS) .
4035
4036endfm
4037
4038fmod META-ACU-UNIFICATION is
4039  pr TERM-HANDLING .
4040  pr SUBSTITUTION-HANDLING .
4041  pr MODULE-HANDLING .
4042  pr SUBSTITUTIONSET .
4043  pr UNIFICATIONPAIRSET .
4044  pr CONVERSION .
4045  pr META-LEVEL-MNPA .
4046  pr META-MINIMIZE-BINDINGS .
4047  pr META-E-UNIFICATION .
4048
4049  var M : Module .
4050  vars T T' : Term .
4051  vars N N' : Nat .
4052  vars US : UnificationTripleSet .
4053
4054  --- metaACUUnify --------------------------------------------------
4055  op metaACUUnify : Module Term Term -> SubstitutionSet .
4056  eq metaACUUnify(M, T, T')
4057   = toSubstitution(metaACUUnify(M, T, T', highestVar((T,T')) + 1)) .
4058
4059  op metaACUUnify? : Module Term Term -> Bool .
4060  eq metaACUUnify?(M, T, T')
4061   = metaACUUnify?(M, T, T', highestVar((T,T')) + 1) .
4062
4063  *** General Call for UnificationPairSet
4064  op metaACUUnify : Module Term Term Nat -> UnificationTripleSet .
4065  eq metaACUUnify(M, T, T', N)
4066   = metaACUUnify$(M, canonice(M,T), canonice(M,T'), N) .
4067
4068  op metaACUUnify$ : Module Term Term Nat -> UnificationTripleSet .
4069                      --- Term Lhs
4070  eq metaACUUnify$(M, T, T', N)
4071   = if (root(T) =/= root(T')
4072         and not (root(T) :: Variable) and not (root(T') :: Variable))
4073        or-else
4074        glbSorts(M,leastSort(M,T),leastSort(M,T')) == none
4075     then empty
4076     else minimizeBindingsTerm(M,Vars(T),N,
4077              metaACUUnifyCollect(M, T, T',N,0,empty))
4078     fi .
4079
4080  op metaACUUnify? : Module Term Term Nat -> Bool .
4081  eq metaACUUnify?(M, T, T', N)
4082   = metaACUUnify?$(M, canonice(M,T), canonice(M,T'), N) .
4083
4084  op metaACUUnify?$ : Module Term Term Nat -> Bool .
4085  eq metaACUUnify?$(M, T, T', N)
4086   = glbSorts(M,leastSort(M,T),leastSort(M,T')) =/= none
4087     and-then
4088     (metaACUUnify*(M,T =? T',N,0) :: UnificationTriple?
4089      and
4090      metaACUUnify*(M,T =? T',N,0) =/= noUnifier) .
4091
4092  op metaACUUnifyCollect : Module Term Term Nat Nat
4093                          UnificationTripleSet
4094                       -> UnificationTripleSet .
4095  eq metaACUUnifyCollect(M,T,T',N,N',US)
4096   = if metaACUUnify*(M,T =? T',N,N') :: UnificationTriple?
4097        and
4098        metaACUUnify*(M,T =? T',N,N') =/= noUnifier
4099     then metaACUUnifyCollect(M,T,T',N,s(N'),
4100             US | metaACUUnify*(M,T =? T',N,N') )
4101     else US
4102     fi .
4103
4104  *** Code for collection all unifiers
4105  op metaACUUnify* : Module UnificandPair Nat Nat ~> UnificationTriple? .
4106  eq metaACUUnify*(M, T =? T',N,N')
4107   = metaUnifyTriple(
4108       keepOnlyACUAttr(eraseEqs(eraseRls(M))),
4109       unflatten(M,T) =? unflatten(M,T'),
4110       N,N') .
4111
4112  op metaUnifyTriple : Module UnificationProblem Nat Nat ~> UnificationTriple? .
4113  eq metaUnifyTriple(M,T =? T',N,N')
4114   = if metaUnify(M,T =? T',N,N') == noUnifier
4115     then noUnifier
4116     else {getSubst(metaUnify(M,T =? T',N,N')) |> T,
4117           getSubst(metaUnify(M,T =? T',N,N')) |> T',
4118           getNextVar(metaUnify(M,T =? T',N,N'))}
4119     fi .
4120endfm
4121
4122fmod META-UNIFICATION is
4123  pr META-ACU-UNIFICATION .
4124
4125  var M : Module .
4126  var T T' : Term .
4127  var N : Nat .
4128
4129  --- metaUnify --------------------------------------------------
4130  op metaCoreUnify : Module Term Term -> SubstitutionSet .
4131  eq metaCoreUnify(M, T, T')
4132   = toSubstitution(metaCoreUnify(M, T, T', highestVar((T,T')) + 1)) .
4133
4134  op metaCoreUnify : Module Term Term Nat -> UnificationTripleSet .
4135                    --- Term Lhs
4136  eq metaCoreUnify(M, T, T', N)
4137   = metaACUUnify(M, T, T', N)  .
4138
4139  op metaCoreUnify? : Module Term Term Nat -> Bool .
4140                    --- Term Lhs
4141  eq metaCoreUnify?(M, T, T', N)
4142   = metaACUUnify?(M, T, T', N)  .
4143
4144endfm
4145
4146fmod META-MSG-UNIFICATION is
4147  pr META-ACU-UNIFICATION .
4148  pr META-MATCH .
4149
4150  var M : Module .
4151  vars T T' T1# T2# T1$ T2$ T1 T2 : Term .
4152  vars N N' N'' N1# N2# : Nat .
4153  vars S S' S1# S2# LSubst RSubst : Substitution .
4154  var UP : UnificationProblem .
4155  vars UTS UTS' : UnificationTripleSet .
4156  var C : Constant .
4157  vars V V' V1 V2 V3 : Variable .
4158  vars F F1 F2 : Qid .
4159  vars TL TL1 TL1' TL1'' TL2 TL2' TL2'' : TermList .
4160  var NeTL : NeTermList .
4161
4162  var U : UnificationPair .
4163  vars US US' : UnificationPairSet .
4164  var SS SS' : SubstitutionSet .
4165  vars TP TP' : Type .
4166  var TPS : TypeSet .
4167  var TPL : TypeList .
4168  var AtS : AttrSet .
4169  var OPDS : OpDeclSet .
4170
4171  ******* metaBuiltInMatch ***********************************************
4172  op metaBuiltInMatch : Module Term Term -> SubstitutionSet .
4173                           *** T1 instance of T2
4174  eq metaBuiltInMatch(M, T1, T2)
4175   = metaCoreMatch(M, T1, T2) .
4176
4177  op metaBuiltInMatch? : Module Term Term -> Bool .
4178                           *** T1 instance of T2
4179  eq metaBuiltInMatch?(M, T1, T2)
4180   = metaCoreMatch?(M, T1, T2) .
4181
4182  ******* metaBuiltInUnify ***********************************************
4183  op metaBuiltInUnify : Module Term Term -> SubstitutionSet .
4184  eq metaBuiltInUnify(M, T, T')
4185   = metaBuiltInUnify(M, empty, T, T') .
4186
4187  op metaBuiltInUnify : Module TermList Term Term -> SubstitutionSet .
4188  eq metaBuiltInUnify(M, TL T, T')
4189   = toSubstitution(metaBuiltInUnify(M, TL, T, T', highestVar((T,T')) + 1)) .
4190
4191  *** General Call for UnificationPairSet
4192  op metaBuiltInUnify : Module TermList Term Term Nat -> UnificationTripleSet .
4193                       --- Term Lhs
4194  eq metaBuiltInUnify(M, TL, T1, T2, N)
4195   = metaBuiltInUnify(M, T1, T2, N) .
4196
4197  op metaBuiltInUnify : Module Term Term Nat -> UnificationTripleSet .
4198  eq metaBuiltInUnify(M, T1, T2, N)
4199   = metaCoreUnify(M, T1, T2, N) .
4200
4201  op metaBuiltInUnify? : Module Term Term -> Bool .
4202  eq metaBuiltInUnify?(M, T, T')
4203   = metaBuiltInUnify?(M, empty, T, T') .
4204
4205  op metaBuiltInUnify? : Module TermList Term Term -> Bool .
4206  eq metaBuiltInUnify?(M, TL, T, T')
4207   = metaBuiltInUnify?(M, TL, T, T',highestVar((T,T')) + 1) .
4208
4209  op metaBuiltInUnify? : Module TermList Term Term Nat -> Bool .
4210  eq metaBuiltInUnify?(M, TL, T1, T2, N)
4211   = metaBuiltInUnify?(M, T1, T2, N)  .
4212
4213  op metaBuiltInUnify? : Module Term Term Nat -> Bool .
4214  eq metaBuiltInUnify?(M, T1, T2, N)
4215   = metaCoreUnify?(M, T1, T2, N) .
4216
4217
4218endfm
4219fmod ORDERS-TERM-SUBSTITUTION is
4220  protecting TERM-HANDLING .
4221  protecting SUBSTITUTION-HANDLING .
4222  protecting META-MATCH .
4223  protecting META-LEVEL-MNPA .
4224  protecting META-UNIFICATION .
4225  protecting META-E-UNIFICATION .
4226  protecting RENAMING .
4227  protecting SUBSTITUTIONSET .
4228  protecting META-MSG-UNIFICATION .
4229
4230  vars T T' : Term .
4231  vars TL TL' TL1 TL2 TL3 : TermList .
4232  var M : Module .
4233  vars S S' : Substitution .
4234  vars SS SS' SS'' : SubstitutionSet .
4235  vars V V' V1 V2 V3 : Variable .
4236  vars TPL TPL' : TypeList .
4237  vars N N' : Nat .
4238  vars F : Qid .
4239  var C : Constant .
4240
4241  --- metaEMatch(M,T,T') implies that T is an instance of T' modulo E + axioms
4242  op metaEMatch : Module Term Term -> SubstitutionSet .
4243  eq metaEMatch(M,T,T')
4244   = if metaCoreMatch(M,T,T') =/= empty
4245     then metaCoreMatch(M,T,T')
4246     else if metaEBuiltInUnifyIrr?(M,T,T')
4247          then metaShared-filter(M,T,T',metaEBuiltInUnifyIrr(M,T,T'))
4248          else empty
4249          fi
4250     fi .
4251
4252  op metaEMatch? : Module Term Term -> Bool .
4253  eq metaEMatch?(M,T,T')
4254   = metaCoreMatch?(M,T,T')
4255     or-else
4256     metaEBuiltInUnifyIrr?(M,T,T') .
4257
4258  --- order between terms ---------------------------
4259  --- T <=[M] T' implies that T' is an instance of T
4260  op _<=[_]_ : Term Module Term -> Bool .
4261  eq T <=[M] T' = (metaCoreMatch(M,T',T) |> T) =/= empty .
4262
4263  --- order between substitutions ---------------------------
4264  --- Subst <=[M] Subst' implies that Subst' is an instance of Subst
4265  op _<=[_]_ : SubstitutionSet Module SubstitutionSet -> Bool [ditto] .
4266  eq SS <=[M] SS'
4267   = SS <=[empty,M] SS' .
4268
4269  op _<=[_`,_]_ : SubstitutionSet TermList Module SubstitutionSet -> Bool .
4270  eq empty <=[TL,M] SS'
4271   = false .
4272  eq SS <=[TL,M] SS'
4273   = SS <=[TL,M]$ SS' [owise] .
4274
4275  op _<=[_`,_]$_ : SubstitutionSet TermList Module SubstitutionSet -> Bool .
4276  eq SS <=[TL,M]$ empty
4277   = true .
4278  eq SS <=[TL,M]$ (S' | SS')
4279   = (SS <=[TL,M]* S') and-then SS <=[TL,M]$ SS' .
4280
4281  op _<=[_`,_]*_ : SubstitutionSet TermList Module Substitution -> Bool .
4282  eq empty <=[TL,M]* S'
4283   = false .
4284  eq (S | SS) <=[TL,M]* S'
4285   = S <=[TL,M]** S' or-else SS <=[TL,M]* S' .
4286
4287  op _<=[_`,_]**_ : Substitution TermList Module Substitution -> Bool .
4288  eq none <=[TL,M]** S'
4289   = true .
4290  eq S <=[TL,M]** S'
4291   = 'Q[1st(gen(TL,S,S'))]
4292     *<=[
4293       addSorts('XXX,
4294       addOps((op 'Q : 3rd(gen(TL,S,S')) -> 'XXX [none] .),
4295         M))
4296     ]*
4297     'Q[2nd(gen(TL,S,S'))]
4298  [owise] .
4299
4300  --- T <=[M] T' implies that T' is an instance of T
4301  --- T and T' can have shared variables
4302  op _*<=[_]*_ : Term Module Term -> Bool .
4303  eq T *<=[M]* T'
4304   = (if anyVars T inVars T'
4305      then metaCoreMatchShared(M,T',T)
4306      else metaCoreMatch(M,T',T)
4307      fi |> T)
4308     =/= empty .
4309
4310  sort Triple .
4311  op {{_`,_`,_}} : TermList TermList TypeList -> Triple .
4312  op 1st : Triple -> TermList .
4313  eq 1st({{TL,TL',TPL}}) = TL .
4314  op 2nd : Triple -> TermList .
4315  eq 2nd({{TL,TL',TPL}}) = TL' .
4316  op 3rd : Triple -> TypeList .
4317  eq 3rd({{TL,TL',TPL}}) = TPL .
4318
4319  ops gen : TermList Substitution Substitution -> Triple . ---[memo] .
4320  eq gen(empty,none,none)
4321   = {{empty,empty,nil}} .
4322  eq gen((V,TL),none,none)
4323   = {{(V,1st(gen(TL,none,none))),
4324       (V,2nd(gen(TL,none,none))),
4325       (getType(V) 3rd(gen(TL,none,none)))}} .
4326  eq gen(TL,none,V <- T ; S')
4327   = {{(V,1st(gen(TL \\ V,none,S'))),
4328       (T,2nd(gen(TL \\ V,none,S'))),
4329       (getType(V) 3rd(gen(TL \\ V,none,S')))}} .
4330  eq gen(TL,V <- T ; S,V <- T' ; S')
4331   = {{(T,1st(gen(TL \\ V,S,S'))),
4332       (T',2nd(gen(TL \\ V,S,S'))),
4333       (getType(V) 3rd(gen(TL \\ V,S,S')))}} .
4334  eq gen(TL,V <- T ; S,S')
4335   = {{(T,1st(gen(TL \\ V,S,S'))),
4336       (V,2nd(gen(TL \\ V,S,S'))),
4337       (getType(V) 3rd(gen(TL \\ V,S,S')))}}
4338   [owise] .
4339
4340  op _\\_ : TermList Variable -> TermList .
4341  eq (TL,V,TL') \\ V = (TL,TL') .
4342  eq TL \\ V = TL [owise] .
4343
4344  --- renaming -----------------------------------------------
4345  op _=[_]=_ : TermSet Module TermSet -> Bool .
4346  eq T1:TermSet =[M]= T2:TermSet
4347   = metaBuiltInRenaming(M,T1:TermSet,T2:TermSet) .
4348
4349  *****
4350  op metaBuiltInRenaming : Module TermSet TermSet -> Bool .
4351  eq metaBuiltInRenaming(M,emptyTermSet,emptyTermSet)
4352   = true .
4353 ceq metaBuiltInRenaming(M,T:Term | T:TermSet,T':Term | T':TermSet)
4354    = metaBuiltInRenaming(M,T:TermSet,T':TermSet)
4355   if metaBuiltInRenaming$(M,T:Term,T':Term) .
4356  eq metaBuiltInRenaming(M,T:TermSet,T':TermSet)
4357   = false [owise] .
4358
4359  op metaBuiltInRenaming$ : Module Term Term -> Bool .
4360  eq metaBuiltInRenaming$(M,T:Term,T':Term)
4361   = canonice(M,nullVars(T)) == canonice(M,nullVars(T'))
4362     and-then
4363     (metaBuiltInRenaming$$1(M,canonice(M,T),canonice(M,T'))
4364      or-else
4365      metaBuiltInRenaming$$2(M,canonice(M,T),canonice(M,T'))
4366      ) .
4367
4368  op metaBuiltInRenaming$$1 : Module Term Term -> Bool .
4369  eq metaBuiltInRenaming$$1(M,T:Term,T':Term)
4370   = metaBuiltInRenaming$$1*(
4371         canonice(M,totalOrder(M,flatten(M,T:Term)) <<( 0 )<),
4372         canonice(M,totalOrder(M,flatten(M,T':Term)) <<( 0 )<) ) .
4373
4374  op metaBuiltInRenaming$$1* : Term Term -> Bool .
4375  eq metaBuiltInRenaming$$1*(T:Term,T':Term) = T:Term == T':Term .
4376
4377  op totalOrder : Module Term -> Term .
4378  eq totalOrder(M,C) = C .
4379  eq totalOrder(M,V) = V .
4380  eq totalOrder(M,F[TL])
4381   = if not isCommutative(M,F[TL])
4382     then F[totalOrderTL(M,TL)]
4383     else F[reorderTL(M,F,totalOrderTL(M,TL))]
4384     fi .
4385
4386  op totalOrderTL : Module TermList -> TermList .
4387  eq totalOrderTL(M,empty) = empty .
4388  eq totalOrderTL(M,(T,TL)) = (totalOrder(M,T),totalOrderTL(M,TL)) .
4389
4390  op reorderTL : Module Qid TermList -> TermList .
4391  eq reorderTL(M,F,empty) = empty .
4392  eq reorderTL(M,F,(T,TL))
4393   = if insertTL(M,F,T,TL) =/= (T,TL)
4394     then reorderTL(M,F,insertTL(M,F,T,TL))
4395     else (T,reorderTL(M,F,TL))
4396     fi .
4397
4398  op insertTL : Module Qid Term TermList -> TermList .
4399  eq insertTL(M,F,T',empty) = T' .
4400  eq insertTL(M,F,T',(T,TL))
4401   = if canonice(M,F[nullVars(T'),nullVars(T)]) == F[canonice(M,nullVars(T')),canonice(M,nullVars(T))]
4402     then (T',T,TL)
4403     else (T,insertTL(M,F,T',TL))
4404     fi .
4405
4406  op nullVars : Term -> Term .
4407  eq nullVars(C) = C .
4408  eq nullVars(V) = qid("#0:" + string(getType(V))) .
4409  eq nullVars(F[TL]) = F[nullVarsTL(TL)] .
4410
4411  op nullVarsTL : TermList -> TermList .
4412  eq nullVarsTL(empty) = empty .
4413  eq nullVarsTL((T,TL)) = (nullVars(T),nullVarsTL(TL)) .
4414
4415  *****
4416  op metaBuiltInRenaming$$2 : Module Term Term -> Bool .
4417  eq metaBuiltInRenaming$$2(M,T:Term,T':Term)
4418   = T == T'
4419     or-else
4420     onlyRenamingAny(M,metaBuiltInMatchShared(M,T',T) |> T) .
4421
4422  *****
4423  op onlyRenamingAll : Module SubstitutionSet -> Bool .
4424  eq onlyRenamingAll(M,empty)
4425   = true .
4426  eq onlyRenamingAll(M,S | SS)
4427   = onlyRenaming*(M,S)
4428     and-then
4429     onlyRenamingAll(M,SS) .
4430
4431  op onlyRenamingAny : Module SubstitutionSet -> Bool .
4432  eq onlyRenamingAny(M,empty)
4433   = false .
4434  eq onlyRenamingAny(M,S | SS)
4435   = onlyRenaming*(M,S)
4436     or-else
4437     onlyRenamingAny(M,SS) .
4438
4439  op onlyRenaming* : Module Substitution -> Bool .
4440  eq onlyRenaming*(M,(V <- T) ; (V' <- T) ; S)
4441   = false .
4442  eq onlyRenaming*(M,S)
4443   = onlyRenaming**(M,S) [owise] .
4444
4445  op onlyRenaming** : Module Substitution -> Bool .
4446 ceq onlyRenaming**(M,(V <- F[TL]) ; S)
4447   = onlyRenaming*(M,
4448        canonice(M, S << (V1 <- getIdSymbol(M,F[TL])))
4449     )
4450  if getIdSymbol(M,F[TL]) :: Term
4451  /\ TL1,V1,TL2,V2,TL3 := TL
4452  /\ typeLeq(M,getType(getIdSymbol(M,F[TL])),getType(V1))
4453     and-then
4454     not (V1 in Vars((TL1,TL2,V2,TL3)))
4455  /\ typeLeq(M,getType(getIdSymbol(M,F[TL])),getType(V2))
4456     and-then
4457     not (V2 in Vars((TL1,V1,TL2,TL3))) .
4458  eq onlyRenaming**(M,S)
4459   = onlyRenaming***(S) [owise] .
4460
4461  op onlyRenaming*** : Substitution -> Bool .
4462  eq onlyRenaming***(none)
4463   = true .
4464  eq onlyRenaming***((V <- T) ; S)
4465   = T :: Variable
4466     and-then
4467     getType(V) == getType(T)
4468     and-then
4469     onlyRenaming***(S) .
4470
4471  --- Standard metaMatch does not deal with shared variables between T and T'
4472  --- metaCoreMatch(M,T,T') implies that T is an instance of T'
4473
4474  op metaCoreMatchShared : Module Term Term -> SubstitutionSet .
4475  eq metaCoreMatchShared(M,T,T')
4476   = metaShared-filter(M,T,T',metaCoreMatch(M,T,T')) .
4477
4478  op metaBuiltInMatchShared : Module Term Term -> SubstitutionSet .
4479  eq metaBuiltInMatchShared(M,T,T')
4480   = metaShared-filter(M,T,T',metaBuiltInMatch(M,T,T')) .
4481
4482  *******
4483  op metaShared-filter : Module Term Term SubstitutionSet
4484                           -> SubstitutionSet .
4485  eq metaShared-filter(M,T,T',SS)
4486   = metaShared-filter*(M,T,T',empty,SS) .
4487
4488  op metaShared-filter* : Module Term Term SubstitutionSet SubstitutionSet
4489                           -> SubstitutionSet .
4490  eq metaShared-filter*(M,T,T',SS',empty)
4491   = SS' .
4492  eq metaShared-filter*(M,T,T',SS',S | SS)
4493   = metaShared-filter*(M,T,T',
4494        if S |> T == none
4495        then SS' | S
4496        else SS'
4497        fi,
4498     SS ) .
4499
4500
4501  *** Normalize Substitutions
4502  op normalizedSubstitution? : Module SubstitutionSet -> Bool .
4503  eq normalizedSubstitution?(M, empty)
4504   = true .
4505  eq normalizedSubstitution?(M, S | SS)
4506   = normalizedSubstitution?*(M, S) and-then normalizedSubstitution?(M, SS) .
4507
4508  op normalizedSubstitution?* : Module Substitution -> Bool . ---[memo] .
4509  eq normalizedSubstitution?*(M, none)
4510   = true .
4511  eq normalizedSubstitution?*(M, V <- T ; S:Substitution)
4512   = isNF$(clearAllFrozen(M),T)
4513     and-then
4514     normalizedSubstitution?*(M, S:Substitution) .
4515
4516  *** Normalize Substitutions
4517  op |_|`(_`) : SubstitutionSet Module -> SubstitutionSet .
4518  eq | S:SubstitutionSet |(M)
4519   = eqNormalizeSubstitution(M,S:SubstitutionSet) .
4520
4521  op eqNormalizeSubstitution : Module SubstitutionSet -> SubstitutionSet .
4522  eq eqNormalizeSubstitution(M, empty)
4523   = empty .
4524  eq eqNormalizeSubstitution(M, S | SS)
4525   = eqNormalizeSubstitution*(M, S) | eqNormalizeSubstitution(M, SS) .
4526
4527  op eqNormalizeSubstitution* : Module Substitution -> Substitution .
4528  eq eqNormalizeSubstitution*(M, none)
4529   = none .
4530  eq eqNormalizeSubstitution*(M, V <- T ; S:Substitution)
4531   = V <- getTerm(metaReduce(eraseRls(M),T))
4532     ; eqNormalizeSubstitution*(M, S:Substitution) .
4533
4534endfm
4535fmod META-NORMALIZE is
4536  protecting META-TERM .
4537  protecting META-LEVEL-MNPA .
4538  protecting META-UNIFICATION .
4539  protecting RESULT-CONTEXT-SET .
4540  protecting ORDERS-TERM-SUBSTITUTION .
4541  protecting TYPEOFNARROWING .
4542
4543  vars T T' TOrig Lhs Rhs TS TS' CtTS CtTS' : Term .
4544  var V : Variable .
4545  var C : Constant .
4546  var F : Qid .
4547  vars TL TL' : TermList .
4548  var M : Module .
4549  vars RTS RTS' RTS$ RTS$' : ResultContextSet .
4550  vars RT RT' : ResultContext .
4551  vars TP TP' : Type .
4552  vars S S' S* S'* Subst : Substitution .
4553  var RLS : RuleSet .
4554  var Att : AttrSet .
4555  vars B BN : Bound .
4556  vars N NextVar NextVar' : Nat .
4557  var NL : NatList .
4558  vars Ct CtS Ct' CtS' : Context .
4559  var ON : TypeOfNarrowing .
4560  var QQ : TypeOfRelation .
4561
4562  op |_| : ResultTripleSet -> Nat .
4563  eq | (empty).ResultTripleSet | = 0 .
4564  eq | {T,TP,S} | RTS:ResultTripleSet | = s(| RTS:ResultTripleSet |) .
4565
4566  *** Shortcut to Normalization by rewriting Search
4567  op metaNormalizeCollect$ : Module Term ~> ResultTripleSet .
4568  eq metaNormalizeCollect$(M,T)
4569   = metaNormalizeCollect$(M,{T,leastSort(M,T),none}) .
4570
4571  op metaNormalizeCollect$ : Module Term Type ~> ResultTripleSet .
4572  eq metaNormalizeCollect$(M,T,TP)
4573   = metaNormalizeCollect$(M,{T,TP,none}) .
4574
4575  op metaNormalizeCollect$ : Module ResultTriple ~> ResultTripleSet .
4576  eq metaNormalizeCollect$(M,{T,TP,S})
4577   = metaSearchCollect(M,
4578       T, (addType TP ToVar 'XXXXXXX),
4579       '!,unbounded) .
4580
4581  *** Shortcut to One rewriting step
4582  op metaOneRewriting$ : Module Term ~> ResultTripleSet .
4583  eq metaOneRewriting$(M,T)
4584   = metaOneRewriting$(M,{T,leastSort(M,T),none}) .
4585
4586  op metaOneRewriting$ : Module Term Type -> ResultTripleSet .
4587  eq metaOneRewriting$(M,T,TP)
4588   = metaOneRewriting$(M,{T,TP,none}) .
4589
4590  op metaOneRewriting$ : Module ResultTriple -> ResultTripleSet .
4591
4592  eq metaOneRewriting$(M,{T,TP,S})
4593   = metaSearchCollect(M,
4594       T, (addType TP ToVar 'XXXXXXX),
4595       '+,1) .
4596
4597  *** Use Standard Maude metaSearch
4598  op metaSearchCollect : Module Term Term TypeOfRelation Bound
4599                      ~> ResultTripleSet .
4600  eq metaSearchCollect(M,T,T',QQ,B)
4601   = metaSearchCollect(M,T,T',QQ,B,0) .
4602
4603  op metaSearchCollect : Module Term Term TypeOfRelation Bound Nat
4604                      ~> ResultTripleSet .
4605  eq metaSearchCollect(M,T,T',QQ,B,N:Nat)
4606   = if metaSearch(M,T,T',nil,[QQ],B,N:Nat) :: ResultTripleSet
4607        and
4608        metaSearch(M,T,T',nil,[QQ],B,N:Nat) =/= failure
4609     then metaSearch(M,T,T',nil,[QQ],B,N:Nat)
4610          |
4611          metaSearchCollect(M,T,T',QQ,B,s(N:Nat))
4612     else empty
4613     fi .
4614
4615  *** Shortcut to normal form detection
4616  op isNF$ : Module Substitution ~> Bool .
4617  eq isNF$(M, (none).Substitution)
4618   = true .
4619  eq isNF$(M, V:Variable <- T:Term ; S:Substitution)
4620   = isNF$(M,T) and-then isNF$(M, S:Substitution) .
4621
4622  op isNF$ : Module Term ~> Bool .
4623  eq isNF$(M,T) = isNF$$(M,T,leastSort(M,T)) .
4624
4625  op isNF$$ : Module Term Type ~> Bool .
4626  eq isNF$$(M,T,TP)
4627   = metaSearch(M,T,(addType TP ToVar 'XXXXXXX),nil,'+,1,0) == failure .
4628
4629  ***********************************************************************
4630  --- Not defined in this module-------------
4631  op metaNarrowSearchAll : Module Term Term SubstitutionCond TypeOfRelation
4632                            Bound Bound --- number steps / number solutions
4633                            Bound --- chosen solution
4634                            TypeOfNarrowing
4635                            ResultContextSet
4636			 -> ResultContextSet .
4637  --- Not defined in this module-------------
4638
4639  op metaNormalizeCollect : Module Term ~> ResultTripleSet .
4640  eq metaNormalizeCollect(M,T)
4641   = if anyNonExec(M)
4642     then metaNormalizeCollect#(M,T)
4643     else metaNormalizeCollect$(M,T)
4644     fi .
4645
4646  op metaNormalizeCollect : Module Term Type -> ResultTripleSet .
4647  eq metaNormalizeCollect(M,T,TP)
4648   = if anyNonExec(M)
4649     then metaNormalizeCollect#(M,T,TP)
4650     else metaNormalizeCollect$(M,T,TP)
4651     fi .
4652
4653  op metaNormalizeCollect : Module ResultTriple -> ResultTripleSet .
4654  eq metaNormalizeCollect(M,{T,TP,S})
4655   = if anyNonExec(M)
4656     then metaNormalizeCollect#(M,{T,TP,S})
4657     else metaNormalizeCollect$(M,{T,TP,S})
4658     fi .
4659
4660  op metaOneRewriting : Module Term ~> ResultTripleSet .
4661  eq metaOneRewriting(M,T)
4662   = if anyNonExec(M)
4663     then metaOneRewriting#(M,T)
4664     else metaOneRewriting$(M,T)
4665     fi .
4666
4667  op metaOneRewriting : Module Term Type -> ResultTripleSet .
4668  eq metaOneRewriting(M,T,TP)
4669   = if anyNonExec(M)
4670     then metaOneRewriting#(M,T,TP)
4671     else metaOneRewriting$(M,T,TP)
4672     fi .
4673
4674  op metaOneRewriting : Module ResultTriple -> ResultTripleSet .
4675  eq metaOneRewriting(M,{T,TP,S})
4676   = if anyNonExec(M)
4677     then metaOneRewriting#(M,{T,TP,S})
4678     else metaOneRewriting$(M,{T,TP,S})
4679     fi .
4680
4681  --- Based on narrowing -----------------------------
4682  op metaNormalizeCollect# : Module Term ~> ResultTripleSet .
4683  eq metaNormalizeCollect#(M,T)
4684   = metaNormalizeCollect#(M,{T,leastSort(M,T),none}) .
4685
4686  op metaNormalizeCollect# : Module Term Type -> ResultTripleSet .
4687  eq metaNormalizeCollect#(M,T,TP)
4688   = metaNormalizeCollect#(M,{T,TP,none}) .
4689
4690  ---metaSearch of Maude doesn't work for rules with extra vars
4691  op metaNormalizeCollect# : Module ResultTriple -> ResultTripleSet .
4692  eq metaNormalizeCollect#(M,{T,TP,S})
4693   = toTriple(M,
4694     metaNarrowSearchAll(
4695       M,
4696       T, (addType TP ToVar 'XXXXXXX),
4697       none,'!,unbounded,unbounded,unbounded,E-rewriting noStrategy,
4698       {T,TP,S,none,[],[],T << S,T << S,
4699        max(highestVar(S),highestVar((T,T << S))) + 1,
4700        nil,
4701        empty}
4702     )) .
4703
4704  op metaOneRewriting# : Module Term ~> ResultTripleSet .
4705  eq metaOneRewriting#(M,T)
4706   = metaOneRewriting#(M,{T,leastSort(M,T),none}) .
4707
4708  op metaOneRewriting# : Module Term Type -> ResultTripleSet .
4709  eq metaOneRewriting#(M,T,TP)
4710   = metaOneRewriting#(M,{T,TP,none}) .
4711
4712  op metaOneRewriting# : Module ResultTriple -> ResultTripleSet .
4713  eq metaOneRewriting#(M,{T,TP,S})
4714   = toTriple(M,
4715     metaNarrowSearchAll(
4716       M,
4717       T, (addType TP ToVar 'XXXXXXX),
4718       none,'+,1,unbounded,unbounded,E-rewriting noStrategy,
4719       {T,TP,S,none,[],[],T << S,T << S,
4720        max(highestVar(S),highestVar((T,T << S))) + 1,
4721        nil,
4722        empty}
4723     )) .
4724
4725  *** Remove itself
4726  op noSelf : ResultContextSet ResultContextSet -> ResultContextSet .
4727  eq noSelf(empty,RTS')
4728   = RTS' .
4729  eq noSelf({T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} | RTS,RTS')
4730   = noSelf(RTS,
4731      if TS == T and-then CtTS == T and-then Ct == [] and-then CtS == []
4732      then noSelf*({T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}, RTS')
4733      else RTS'
4734      fi
4735     ) .
4736
4737  op noSelf* : ResultContext ResultContextSet -> ResultContextSet .
4738  eq noSelf*(RT,empty)
4739   = empty .
4740  eq noSelf*({T,TP,S,S*,[],[],T,T,NextVar,Tr:TraceNarrow,B:Flags},
4741             {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',Tr':TraceNarrow,B':Flags} | RTS)
4742   = if TS' == T' and-then CtTS' == T' and-then Ct' == [] and-then CtS' == []
4743        and-then
4744        T == T' and-then TP == TP'
4745        and-then
4746        (S |> T) == (S' |> T)
4747     then ---remove
4748          empty
4749     else ---keep
4750          {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',Tr:TraceNarrow,B':Flags}
4751     fi
4752     | noSelf*({T,TP,S,S*,[],[],T,T,NextVar,Tr':TraceNarrow,B:Flags},RTS) .
4753
4754endfm
4755
4756fmod META-E-NARROWING is
4757  protecting META-TERM .
4758  protecting META-LEVEL-MNPA .
4759  protecting META-UNIFICATION .
4760  protecting META-MSG-UNIFICATION .
4761  protecting META-E-UNIFICATION .
4762  protecting RESULT-CONTEXT-SET .
4763  protecting ORDERS-TERM-SUBSTITUTION .
4764  protecting TYPEOFNARROWING .
4765  protecting META-NORMALIZE .
4766  protecting UNIFICATIONTRIPLESET .
4767  protecting RIGIDIFE .
4768
4769  var T T' T'' TOrig Lhs Lhs' Rhs Rhs'  : Term .
4770  var CT' TS TS' TS'' CtTS CtTS' CtTS'' : Term .
4771  var V : Variable .
4772  var C : Constant .
4773  var F : Qid .
4774  var M : Module .
4775  var RTS RTS' RTS$ RTS-Rls RTS-Sub RTSSol : ResultContextSet .
4776  var RTNeS : ResultContextNeSet .
4777  var RT RT' : ResultContext .
4778  vars S S' S'' Subst Subst' S* S'* : Substitution .
4779  var SS : SubstitutionSet .
4780  var RLS : RuleSet .
4781  var RL : Rule .
4782  vars Att Att' : AttrSet .
4783  var B BN : Bound .
4784  vars N N' N1 N2 : Nat .
4785  var NL : NatList .
4786  vars Ct CtS Ct' CtS' Ct'' CtS'' : Context .
4787  var NeTL NeTL' : NeTermList .
4788  vars TL TL' TL'' TL''' : TermList .
4789  vars TP TP' TP'' : Type .
4790  var ON : TypeOfNarrowing .
4791  vars NextVar NextVar' NextVar'' NVarPrev : Nat .
4792  var U : UnificationTriple .
4793  vars US US' : UnificationTripleSet .
4794  var IRR : IrrFlags .
4795
4796  --- metaNarrow ---------------------------
4797  ---( We implement:
4798       * basic narrowing, where terms introduced
4799         by unifiers (substitutions) are never
4800         selected for narrowing, and
4801       * standard narrowing, where this
4802         restriction does not apply  )
4803
4804
4805  *** Shortcuts to Narrowing
4806  op metaNarrow : Module Term -> ResultTripleSet .
4807  eq metaNarrow(M,T) = metaNarrow(M,T,1) .
4808
4809  op metaNarrow : Module Term Bound -> ResultTripleSet .
4810  eq metaNarrow(M,T,B)
4811   = toTriple(M,metaENarrowShowAll(M,T,B,full noStrategy BuiltIn-unify)) |> T .
4812
4813  *** Shortcuts to Basic Narrowing
4814  op metaBasicNarrow : Module Term -> ResultTripleSet .
4815  eq metaBasicNarrow(M,T) = metaBasicNarrow(M,T,1) .
4816
4817  op metaBasicNarrow : Module Term Bound -> ResultTripleSet .
4818  eq metaBasicNarrow(M,T,B)
4819   = toTriple(M,metaENarrowShowAll(M,T,B,basic noStrategy BuiltIn-unify)) |> T .
4820
4821  *** Shortcuts to Narrowing
4822  op metaENarrow : Module Term -> ResultTripleSet .
4823  eq metaENarrow(M,T) = metaENarrow(M,T,1) .
4824
4825  op metaENarrow : Module Term Bound -> ResultTripleSet .
4826  eq metaENarrow(M,T,B)
4827   = toTriple(M,metaENarrowShowAll(M,T,B,full noStrategy E-BuiltIn-unify))
4828     |> T .
4829
4830  *** Shortcuts to Narrowing
4831  op metaEBuiltInTopMostNarrow : Module Term Nat -> ResultTripleSet .
4832  eq metaEBuiltInTopMostNarrow(M,T,N)
4833   = metaETopMostNarrow(M,T,1,reducible, E-BuiltIn-unify,N) .
4834  op metaEBuiltInTopMostNarrowIrr : Module Term Nat -> ResultTripleSet .
4835  eq metaEBuiltInTopMostNarrowIrr(M,T,N)
4836   = metaETopMostNarrow(M,T,1,irreducible, E-BuiltIn-unify,N) .
4837
4838  op metaEACUTopMostNarrow : Module Term Nat -> ResultTripleSet .
4839  eq metaEACUTopMostNarrow(M,T,N)
4840   = metaETopMostNarrow(M,T,1,reducible, E-ACU-unify,N) .
4841  op metaEACUTopMostNarrowIrr : Module Term Nat -> ResultTripleSet .
4842  eq metaEACUTopMostNarrowIrr(M,T,N)
4843   = metaETopMostNarrow(M,T,1,irreducible, E-ACU-unify,N) .
4844
4845  op metaETopMostNarrow : Module Term Bound IrrFlags TypeOfNarrowing Nat
4846                       -> ResultTripleSet .
4847  eq metaETopMostNarrow(M,T,B,IRR,ON,N)
4848   = toTriple(M,metaENarrowShowAll(M,T,B,full topmost ON [IRR],N)) |> T .
4849
4850  op metaEBuiltInTopMostNarrowRC : Module Term TermList Nat -> ResultContextSet .
4851  eq metaEBuiltInTopMostNarrowRC(M,T,TL,N)
4852   = metaETopMostNarrowRC(M,T,1,reducible, E-BuiltIn-unify irrTerms(TL),N) .
4853  op metaEBuiltInTopMostNarrowRCIrr : Module Term TermList Nat -> ResultContextSet .
4854  eq metaEBuiltInTopMostNarrowRCIrr(M,T,TL,N)
4855   = metaETopMostNarrowRC(M,T,1,irreducible, E-BuiltIn-unify irrTerms(TL),N) .
4856
4857  op metaEACUTopMostNarrowRC : Module Term Nat -> ResultContextSet .
4858  eq metaEACUTopMostNarrowRC(M,T,N)
4859   = metaETopMostNarrowRC(M,T,1,reducible, E-ACU-unify,N) .
4860  op metaEACUTopMostNarrowRCIrr : Module Term Nat -> ResultContextSet .
4861  eq metaEACUTopMostNarrowRCIrr(M,T,N)
4862   = metaETopMostNarrowRC(M,T,1,irreducible, E-ACU-unify,N) .
4863
4864  op metaETopMostNarrowRC : Module Term Bound IrrFlags TypeOfNarrowing Nat
4865                       -> ResultContextSet .
4866  eq metaETopMostNarrowRC(M,T,B,IRR,ON,N)
4867   = metaENarrowShowAll(M,T,B,full topmost ON [IRR],N) |> T .
4868
4869  --- Auxiliary
4870  op [_,_] : TypeOfNarrowing IrrFlags ~> TypeOfNarrowing .
4871  eq [ E-ACU-unify, reducible ] = E-ACU-unify .
4872  eq [ E-ACU-unify, irreducible ] = E-ACU-unify-Irr .
4873  eq [ E-BuiltIn-unify, reducible ] = E-BuiltIn-unify .
4874  eq [ E-BuiltIn-unify, irreducible ] = E-BuiltIn-unify-Irr .
4875
4876  *** Shortcuts to Basic Narrowing
4877  op metaEBasicNarrow : Module Term -> ResultTripleSet .
4878  eq metaEBasicNarrow(M,T)
4879   = metaEBasicNarrow(M,T,1) .
4880
4881  *** Shortcuts for normalization
4882  op metaEBasicNarrow : Module Term Bound -> ResultTripleSet .
4883  eq metaEBasicNarrow(M,T,B)
4884   = toTriple(M,metaENarrowShowAll(M,T,B,E-BuiltIn-unify noStrategy basic)) |> T .
4885
4886  op metaBasicNarrowNormalize : Module Term -> ResultTripleSet .
4887  eq metaBasicNarrowNormalize(M,T)
4888   = toTriple(M,metaBasicNarrowNormalizeAll(M,T,highestVar(T) + 1)) |> T .
4889
4890  op metaBasicNarrowNormalizeAll : Module Term Nat -> ResultContextSet .
4891  eq metaBasicNarrowNormalizeAll(M,T,NextVar)
4892   = metaENarrowShowAll(M,T,unbounded,
4893         basic BuiltIn-unify
4894         computed-normalized-subs applied-normalized-subs
4895         normalize-terms noStrategy,NextVar) .
4896
4897  op metaNarrowNormalize : Module Term -> ResultTripleSet .
4898  eq metaNarrowNormalize(M,T)
4899   = toTriple(M,metaNarrowNormalizeAll(M,T,highestVar(T) + 1)) |> T .
4900
4901  op metaNarrowNormalizeAll : Module Term Nat -> ResultContextSet .
4902  eq metaNarrowNormalizeAll(M,T,NextVar)
4903   = metaENarrowShowAll(M,T,unbounded,
4904         full BuiltIn-unify
4905         computed-normalized-subs applied-normalized-subs
4906         normalize-terms noStrategy,NextVar) .
4907
4908  *** General Call
4909  op metaENarrowShowAll : Module Term Bound TypeOfNarrowing
4910                       -> ResultContextSet .
4911  eq metaENarrowShowAll(M,T,B,ON)
4912   = metaENarrowShowAll(M,T,B,ON,highestVar(T) + 1) .
4913
4914  op metaENarrowShowAll : Module Term Bound TypeOfNarrowing Nat
4915                       -> ResultContextSet .
4916  eq metaENarrowShowAll(M,T,B,ON,N)
4917   = metaENarrowGen(removeBoolEqs(M),B,ON,
4918       {T,leastSort(M,T),none,none,[],[],T,T,N,nil,empty}) .
4919
4920  *** Call for ResultContextSet
4921  op metaENarrowGen : Module Bound TypeOfNarrowing
4922                      ResultContextSet
4923                   -> ResultContextSet .
4924
4925  eq metaENarrowGen(M,B,ON,RTS)
4926   = if B == 0
4927     then RTS
4928     else metaENarrowGen*(M,B,ON,empty,empty,RTS)
4929     fi .
4930
4931  op metaENarrowGen* : Module
4932                       Bound TypeOfNarrowing
4933                       ResultContextSet ResultContextSet ResultContextSet
4934                    -> ResultContextSet .
4935  eq metaENarrowGen*(M,B,ON,RTSSol,RTS',empty)
4936   = if RTS' == empty
4937        or-else
4938        (B =/= unbounded and-then B <= 1)
4939     then RTSSol | RTS' --- Stop
4940     else metaENarrowGen*(M,dec(B),ON,RTSSol,empty,RTS')
4941     fi .
4942  eq metaENarrowGen*(M,B,ON,RTSSol,RTS',RT | RTS)
4943   = if isEND(normalize-terms?(M,ON,RT))
4944     then metaENarrowGen*(M,B,ON,
4945          RTSSol | normalize-terms?(M,ON,RT),
4946          RTS',RTS)
4947     else metaENarrowGen*(M,B,ON,RTSSol,
4948          RTS' |
4949             filter-variant-RT(M,ON,normalize-terms?(M,ON,RT),
4950                metaENarrowGen**(M,B,ON,normalize-terms?(M,ON,RT))),
4951          RTS)
4952     fi .
4953
4954  op testNonVarRedex : TypeOfNarrowing Term Term -> Bool .
4955  eq testNonVarRedex(alsoAtVarPosition ON,T,TS) = true .
4956  eq testNonVarRedex(ON,T,TS) = testNonVarRedex*(ON,T,TS) [owise] .
4957
4958  op testNonVarRedex* : TypeOfNarrowing Term Term -> Bool .
4959  eq testNonVarRedex*(basic ON,T,TS) = not(T :: Variable) .
4960  eq testNonVarRedex*(ON,T,TS)       = not(TS :: Variable) [owise] .
4961
4962  op metaENarrowGen** : Module
4963                        Bound TypeOfNarrowing
4964                        ResultContext
4965                     -> ResultContextSet .
4966  eq metaENarrowGen**(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
4967   = if not testNonVarRedex(ON,T,TS) --- T is a variable
4968     then if CtS == []
4969          then *** Term CtTS is a normal form so we return it
4970               {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}
4971	  else *** Term T is a rigid normal form inside a context Ct
4972	       *** but since no rewrite has been done and
4973               *** this can be part of a previous metaNarrowSub call,
4974               *** this path is discarded
4975               empty
4976          fi
4977     else if metaENarrowStra(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
4978	     =/= empty
4979          then metaENarrowStra(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
4980          else if CtS == []
4981               then *** Term CtTS is a normal form so we return it
4982                    {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,end(true,B:Flags)}
4983	       else *** Term T is a rigid normal form inside a context Ct
4984	            *** but since no rewrite has been done and
4985                    *** this can be part of a previous metaNarrowSub call,
4986                    *** this path is discarded
4987                    empty
4988               fi
4989          fi
4990     fi .
4991
4992  *** Try all rules at top level of term T in context Ct with metaENarrowRls
4993  *** Try also inner subterms of T with metaENarrowSub
4994  *** Note that metaENarrowRls and metaENarrowSub
4995  *** call to metaNarrow recursively
4996  op metaENarrowStra : Module Bound TypeOfNarrowing ResultContext
4997                    -> ResultContextSet .
4998  ---innermost
4999  eq metaENarrowStra(M,B,innermost ON,RT)
5000   = if metaENarrowSub(M,B,innermost ON,RT) =/= empty
5001     then metaENarrowSub(M,B,innermost ON,RT)
5002     else metaENarrowRls(M,B,innermost ON,getRls(M),RT)
5003     fi .
5004
5005  ---outermost
5006  eq metaENarrowStra(M,B,outermost ON,RT)
5007   = if metaENarrowRls(M,B,outermost ON,getRls(M),RT) =/= empty
5008     then metaENarrowRls(M,B,outermost ON,getRls(M),RT)
5009     else metaENarrowSub(M,B,outermost ON,RT)
5010     fi .
5011
5012  ---topmost
5013  eq metaENarrowStra(M,B,topmost ON,RT)
5014   = metaENarrowRls(M,B,topmost ON,getRls(M),RT) .
5015
5016  ---noStrategy
5017  eq metaENarrowStra(M,B,noStrategy ON,RT)
5018   = metaENarrowRls(M,B,noStrategy ON,getRls(M),RT)
5019     |
5020     metaENarrowSub(M,B,noStrategy ON,RT) .
5021
5022  op dec : Bound -> Bound .
5023  eq dec(unbounded) = unbounded .
5024  eq dec(s(N)) = N .
5025
5026  *** Generic call to metaUnification with different parameters
5027  op auxMetaUnify : Module TypeOfNarrowing
5028                    Term Term Nat ~> UnificationTripleSet .
5029		--- Term Lhs
5030  eq auxMetaUnify(M,variant(N') ON,T,T',N)
5031   = unrigidife(qid(N'),
5032       auxMetaUnify*(getM(rigidifeNat(M,qid(N'),T,N')),
5033                     variant(N') ON,
5034                     getTL(rigidifeNat(M,qid(N'),T,N')),
5035                     T',
5036                     N)
5037     ) .
5038
5039  eq auxMetaUnify(M,ON,T,T',N)
5040   = auxMetaUnify*(M,ON,T,T',N) [owise] .
5041
5042  op auxMetaUnify* : Module TypeOfNarrowing
5043                    Term Term Nat ~> UnificationTripleSet .
5044		--- Term Lhs
5045 ceq auxMetaUnify*(M,rigidife(F:Qid) ON,T,T',N)
5046   = unrigidife(Q:Qid,
5047       auxMetaUnify**(M#:Module,rigidife(F:Qid) ON,T#:Term,T',N)
5048     )
5049  if F:Qid[TL:TermList] := T
5050  /\ Q:Qid := 'auxMetaUnify
5051  /\ X:PairRigidife := rigidifeRigid(M,Q:Qid,T)
5052  /\ M#:Module := getM(X:PairRigidife)
5053  /\ T#:Term := getTL(X:PairRigidife) .
5054
5055  eq auxMetaUnify*(M,ON,T,T',N)
5056   = auxMetaUnify**(M,ON,T,T',N) [owise] .
5057
5058  op auxMetaUnify** : Module TypeOfNarrowing
5059                     Term Term Nat ~> UnificationTripleSet .
5060		 --- Term Lhs
5061                 --- [memo] . --- Very useful but huge space use
5062  eq auxMetaUnify**(M,E-rewriting ON,T,T',N)
5063   = toUnificationTriple[N](metaCoreMatch(removeBoolEqs(M),T,T')) .
5064  eq auxMetaUnify**(M,E-ACU-unify ON,T,T',N)
5065   = metaEACUUnify(removeBoolEqs(M),T,T',getIrrTerms(ON),N,reducible) .
5066  eq auxMetaUnify**(M,E-ACU-unify-Irr ON,T,T',N)
5067   = metaEACUUnify(removeBoolEqs(M),T,T',getIrrTerms(ON),N,irreducible) .
5068  eq auxMetaUnify**(M,E-BuiltIn-unify ON,T,T',N)
5069   = metaEBuiltInUnify(removeBoolEqs(M),T,T',getIrrTerms(ON),N,reducible) .
5070  eq auxMetaUnify**(M,E-BuiltIn-unify-Irr ON,T,T',N)
5071   = metaEBuiltInUnify(removeBoolEqs(M),T,T',getIrrTerms(ON),N,irreducible) .
5072  eq auxMetaUnify**(M,ACU-unify ON,T,T',N)
5073   = metaACUUnify(removeBoolEqs(M),T,T',N) .
5074  eq auxMetaUnify**(M,BuiltIn-unify ON,T,T',N)
5075   = metaBuiltInUnify(removeBoolEqs(M),getIrrTerms(ON),T,T',N) .
5076
5077  *** Remove rigid normal forms
5078  op removeEND : ResultContextSet -> ResultContextSet .
5079  eq removeEND(RTS)
5080   = removeEND*(RTS,empty) .
5081
5082  op removeEND* : ResultContextSet ResultContextSet -> ResultContextSet .
5083  eq removeEND*(empty,RTS')
5084   = RTS' .
5085  eq removeEND*(RT | RTS,RTS')
5086   = removeEND*(RTS,if isEND(RT) then RTS' else RTS' | RT fi) .
5087
5088  op remove_From_ : ResultContextSet ResultContextSet -> ResultContextSet .
5089  eq remove(RT | RTS) From (RT | RTS')
5090   = remove(RTS) From (RT | RTS') .
5091  eq remove(RTS) From (RTS')
5092   = RTS [owise] .
5093
5094  op isEND : ResultContext -> Bool .
5095  eq isEND({T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
5096   = end(B:Flags) .
5097
5098  *** Call for Rules ---> Returns empty if no rule is applied
5099  op metaENarrowRls : Module Bound TypeOfNarrowing
5100                      RuleSet ResultContext
5101                   -> ResultContextSet .
5102  eq metaENarrowRls(M,B,ON,RL RLS,RT)
5103   = metaENarrowRls#(M,B,ON,RL RLS,RT,empty) .
5104  eq metaENarrowRls(M,B,ON,none,RT)
5105   = empty .
5106
5107  op metaENarrowRls# : Module Bound TypeOfNarrowing
5108                      RuleSet ResultContext ResultContextSet
5109                   -> ResultContextSet .
5110  eq metaENarrowRls#(M,B,ON,none,RT,RTS)
5111   = RTS .
5112  eq metaENarrowRls#(M,B,ON,RL RLS,RT,RTS)
5113   = metaENarrowRls#(M,B,ON,RLS,RT,
5114      RTS |
5115        filter-variant-RT(M,ON,RT,
5116           metaENarrowRls*(M,B,ON,RL,RT)
5117        )
5118     ) .
5119
5120  --- General case
5121  op metaENarrowRls* : Module Bound TypeOfNarrowing
5122                       Rule ResultContext
5123                    -> ResultContextSet .
5124  eq metaENarrowRls*(M,B,ON,
5125        (rl Lhs => Rhs [Att].),
5126	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
5127   = metaENarrowRls**$(M,B,ON,
5128        (rl Lhs => Rhs [Att].),
5129	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,
5130           Tr:TraceNarrow {CtTS,none,leastSort(M,CtTS),(rl Lhs => Rhs [Att].)},
5131                          --- Subst none here is key to write the real stuff
5132                          --- later in function _<<_
5133           B:Flags},
5134        'rl_=>_`[_`].[Lhs,Rhs,'none.AttrSet] <<{none,NextVar}<) .
5135  eq metaENarrowRls*(M,B,ON, X:Rule, X:ResultContext)
5136   = empty [owise] .
5137
5138  op metaENarrowRls**$ : Module Bound TypeOfNarrowing
5139                         Rule ResultContext
5140                         UnificationPair
5141                      -> ResultContextSet .
5142  eq metaENarrowRls**$(M,B,ON,
5143        (rl Lhs => Rhs [Att].),
5144	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags},
5145        {Subst,NextVar'})
5146   = metaENarrowRls**$$(M,B,ON,
5147	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags},
5148        {Subst,NextVar'},
5149        'rl_=>_`[_`].[Lhs,Rhs,'none.AttrSet] << Subst) .
5150
5151  op metaENarrowRls**$$ : Module Bound TypeOfNarrowing
5152                          ResultContext
5153                          UnificationPair Term
5154                       -> ResultContextSet .
5155  eq metaENarrowRls**$$(M,B,ON,
5156	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,
5157          Tr:TraceNarrow {CtTS,none,TP$:Type,(rl Lhs => Rhs [Att].)},
5158          B:Flags},
5159        {Subst,NextVar'},
5160        'rl_=>_`[_`].[Lhs',Rhs','none.AttrSet])
5161   = metaENarrowRls**$$$(M,B,ON,
5162	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,
5163           Tr:TraceNarrow {CtTS,none,TP$:Type,(rl Lhs' => Rhs' [Att].)},
5164           B:Flags},
5165        {Subst,NextVar'},
5166        'rl_=>_`[_`].[Lhs',Rhs','none.AttrSet],
5167        auxMetaUnify(M,ON,TS,Lhs',NextVar')) .
5168
5169  op metaENarrowRls**$$$ : Module Bound TypeOfNarrowing
5170                           ResultContext
5171                           UnificationPair Term UnificationTripleSet
5172                        -> ResultContextSet .
5173  eq metaENarrowRls**$$$(M,B,ON,
5174	{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags},
5175        {Subst,NextVar'},
5176        'rl_=>_`[_`].[Lhs',Rhs','none.AttrSet],US)
5177    = if US =/= empty
5178      then rebuildTypeAndDiscardErroneous(M,ON,
5179               {Ct[Rhs'],
5180	        TP,
5181		S,S',
5182		[],
5183		[],
5184		CtS[Rhs'],
5185		CtS[Rhs'],
5186		NextVar',
5187                Tr:TraceNarrow,
5188                B:Flags}
5189               <<(M,ON) US
5190            )
5191      else empty
5192      fi .
5193
5194  *** rebuild the context of the applied rule **********************
5195  op rebuildTypeAndDiscardErroneous : Module TypeOfNarrowing
5196                                      ResultContextSet -> ResultContextSet .
5197  eq rebuildTypeAndDiscardErroneous(M,ON,empty)
5198   = empty .
5199  eq rebuildTypeAndDiscardErroneous(M,ON,RT | RTS)
5200   = rebuildTypeAndDiscardErroneous*(M,ON,RT)
5201     | rebuildTypeAndDiscardErroneous(M,ON,RTS) .
5202
5203  op rebuildTypeAndDiscardErroneous* : Module TypeOfNarrowing
5204                                       ResultContext -> ResultContextSet .
5205  eq rebuildTypeAndDiscardErroneous*(M,ON,
5206       {T,TP,S,S',[],[],TS,TS,NextVar,Tr:TraceNarrow,B:Flags})
5207   = if	leastSort(M,TS) :: Type
5208     then normalize-terms?(M,ON,
5209             {canonice(M,T),leastSort(M,TS),
5210              canonice(M,S),canonice(M,S'),
5211              [],[],canonice(M,TS),canonice(M,TS),
5212              NextVar,
5213              canonice(M,Tr:TraceNarrow),B:Flags})
5214     else empty
5215     fi .
5216
5217  *** auxiliary for variant narrowing **********************
5218  op _<<`(_`,_`)_ : ResultContext
5219                    Module TypeOfNarrowing
5220                    UnificationTripleSet -> ResultContextSet .
5221
5222  eq RT <<(M,ON) (empty).UnificationTripleSet
5223   = (empty).ResultContextSet .
5224
5225  eq {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags}
5226     <<(M,ON) ({Subst,Subst',N} | SS:UnificationTripleSet)
5227   = {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags}
5228     <<((M,ON)) {Subst,Subst',N}
5229     |
5230     {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags}
5231     <<(M,ON) SS:UnificationTripleSet .
5232
5233  op _<<`(`(_`,_`)`)_ : ResultContext
5234                        Module TypeOfNarrowing
5235                        UnificationTriple -> ResultContextSet .
5236
5237  eq {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags}
5238     <<((M,ON)) {Subst,Subst',N}
5239   = if (variant in ON
5240         and-then
5241         (Subst == none
5242          or-else
5243          (not anyIdSymbol(M,Subst ; Subst')
5244           and-then
5245           normalizedSubstitution?(M,Subst ; Subst'))
5246          or-else
5247          anyIdSymbol(M,Subst ; Subst')
5248         )
5249        )
5250        or-else
5251        (computed-normalized-subs in ON
5252         and-then normalizedSubstitution?(M,Subst))
5253        or-else
5254        (applied-normalized-subs in ON
5255         and-then normalizedSubstitution?(M,Subst'))
5256        or-else
5257        (not variant in ON
5258         and-then
5259         not applied-normalized-subs in ON
5260         and-then
5261         not computed-normalized-subs in ON)
5262     then {T,TP,S,S',Ct:Context,CtS:Context,TS:Term,CtTS:Term,NextVar,Tr:TraceNarrow,B:Flags}
5263           << if anyIdSymbol(M,Subst ; Subst')
5264              ---then {normalizeRls(M,Subst),normalizeRls(M,Subst'),N}
5265              then {canonice(M,Subst),canonice(M,Subst'),N}
5266              else {Subst,Subst',N}
5267              fi
5268     else (empty).ResultContextSet
5269     fi .
5270
5271  *** test flag normalize-terms and normalize **********************
5272  *** !!!! This mustn't be combined with basic -> strange behavior
5273  op normalize-terms? : Module TypeOfNarrowing ResultContext
5274                     -> ResultContext .
5275  eq normalize-terms?(M,E-normalize-terms ON,
5276     {T,TP,S,S',[],[],TS,TS,NextVar,Tr:TraceNarrow,B:Flags})
5277   = {getTerm(metaReduce(M,T)),
5278      getType(metaReduce(M,T)),
5279      S,S',[],[],
5280      getTerm(metaReduce(M,TS)),
5281      getTerm(metaReduce(M,TS)),
5282      NextVar,Tr:TraceNarrow,B:Flags} .
5283  eq normalize-terms?(M,normalize-terms ON,
5284     {T,TP,S,S',[],[],TS,TS,NextVar,Tr:TraceNarrow,B:Flags})
5285   = {getTerm(metaNormalizeCollect(M,T)),
5286      getType(metaNormalizeCollect(M,T)),
5287      S,S',[],[],
5288      getTerm(metaNormalizeCollect(M,TS)),
5289      getTerm(metaNormalizeCollect(M,TS)),
5290      NextVar,Tr:TraceNarrow,B:Flags} .
5291  eq normalize-terms?(M,ON,RT)
5292   = RT [owise] .
5293
5294  *** Call at inner subterms
5295  op metaENarrowSub : Module Bound TypeOfNarrowing ResultContext
5296                      -> ResultContextSet .
5297  eq metaENarrowSub(M,B,ON,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
5298   = metaENarrowSub#(M,B,ON,flatten(M,auxSplitTerm(ON,T,TS)),
5299            {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) .
5300
5301  op auxSplitTerm : TypeOfNarrowing Term Term -> Term .
5302  eq auxSplitTerm(basic ON,T,TS) = T .
5303  eq auxSplitTerm(ON,T,TS) = TS [owise] .
5304
5305  op metaENarrowSub# : Module Bound TypeOfNarrowing Term ResultContext
5306                      -> ResultContextSet .
5307  eq metaENarrowSub#(M,B,ON,C,RT) = empty .
5308  eq metaENarrowSub#(M,B,ON,V,RT) = empty .
5309  eq metaENarrowSub#(M,B,ON,F[NeTL],RT)
5310   = metaENarrowSub#Gen(M,B,ON,
5311       splitTerm(M,F,
5312                 1,getFrozen(M,F,getTypes(M,NeTL)),
5313                 isAssociative(M,F,getTypes(M,NeTL))
5314                 or isCommutative(M,F,getTypes(M,NeTL)),
5315                 empty,NeTL,RT)) .
5316
5317  op splitTerm : Module Qid
5318                 Nat NeNatList Bool
5319                 TermList TermList
5320                 ResultContext -> ResultContextSet .
5321
5322  eq splitTerm(M,F,
5323               N,NL,AC?:Bool,
5324               TL',empty,
5325               RT)
5326   = empty .
5327
5328  eq splitTerm(M,F,
5329               N,NL,AC?:Bool,
5330               TL',(T,TL),
5331               {T'',TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
5332   = if ((not AC?:Bool) and-then N inNatList NL)
5333        or-else
5334        (AC?:Bool and-then NL =/= 0)
5335     then empty
5336     else {T,leastSort(M,T),S,S',
5337           Ct[F[TL',[],TL]],
5338           CtS[F[TL' << (S ; S'),[],TL << (S ; S')]],T << (S ; S'),
5339           CtTS,NextVar,Tr:TraceNarrow,B:Flags}
5340     fi
5341     | splitTerm(M,F,
5342                 s(N),NL,AC?:Bool,
5343                 (TL',T),TL,
5344                 {T'',TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) .
5345
5346  op metaENarrowSub#Gen : Module Bound TypeOfNarrowing ResultContextSet
5347                       -> ResultContextSet .
5348  eq metaENarrowSub#Gen(M,B,ON,empty)
5349   = empty .
5350  eq metaENarrowSub#Gen(M,B,ON,RT | RTS)
5351   = metaENarrowGen**(M,B,ON,RT) | metaENarrowSub#Gen(M,B,ON,RTS) .
5352
5353  op filter-variant-RT : Module TypeOfNarrowing ResultContext
5354                      ResultContextSet -> ResultContextSet .
5355  eq filter-variant-RT(M,ON,
5356          {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags},RTS)
5357   = if variant in ON and testUnifier !in ON
5358     then filter-variant-RT*(M,Vars(TS),empty,RTS)
5359     else RTS
5360     fi .
5361
5362  op filter-variant-RT* :
5363       Module TermList ResultContextSet ResultContextSet -> ResultContextSet .
5364  eq filter-variant-RT*(M,TL,RTS$,empty)
5365   = RTS$ .
5366  eq filter-variant-RT*(M,TL,RTS$,RT | RTS)
5367   = filter-variant-RT**(M,TL,RTS$,RTS,RT,RTS) .
5368
5369  op filter-variant-RT** :
5370        Module TermList ResultContextSet ResultContextSet
5371                        ResultContext ResultContextSet -> ResultContextSet .
5372  eq filter-variant-RT**(M,TL,RTS$,RTS',RT,empty)
5373   = --- RT is not implied by any in RTS'
5374     filter-variant-RT*(M,TL,RTS$ | RT,RTS') .
5375  eq filter-variant-RT**(M,TL,RTS$,RT | RTS',RT',RT | RTS)
5376   = if test-variant-RT(M,TL,RT,RT')
5377     then --- RT' is implied by RT in RTS'
5378          filter-variant-RT*(M,TL,RTS$,RT | RTS')
5379     else if test-variant-RT(M,TL,RT',RT)
5380          then --- remove RT from the set RTS'
5381               filter-variant-RT**(M,TL,RTS$,RTS',RT',RTS)
5382          else --- continue searching in RTS
5383               filter-variant-RT**(M,TL,RTS$,RT | RTS',RT',RTS)
5384          fi
5385     fi .
5386
5387  op test-variant-RT : Module TermList ResultContext ResultContext
5388                    -> Bool .
5389  eq test-variant-RT(M,TL,
5390         {T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags},
5391         {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',Tr':TraceNarrow,B':Flags})
5392   = test-variant-RT*(M,TL,S |> TL,S' |> TL) .
5393
5394  op test-variant-RT* : Module TermList Substitution Substitution -> Bool .
5395  eq test-variant-RT*(M,TL,S,S')
5396   = | S | <= | S' |
5397     and-then
5398     S <=[TL,M] S' . --- keep T & remove T'
5399
5400  op |_| : Substitution -> Nat .
5401  eq | (none).Substitution | = 0 .
5402  eq | V <- T ; S | = s(| S |) .
5403
5404endfm
5405
5406fmod META-NARROWING-SEARCH is
5407  protecting META-E-NARROWING .
5408  protecting META-TERM .
5409  protecting META-LEVEL-MNPA .
5410  protecting META-UNIFICATION .
5411  protecting RESULT-CONTEXT-SET .
5412  protecting ORDERS-TERM-SUBSTITUTION .
5413
5414  var T T' TOrig Lhs Rhs TS TS' CtTS CtTS' : Term .
5415  var V : Variable .
5416  var C : Constant .
5417  var F : Qid .
5418  vars TL TL' : TermList .
5419  var M : Module .
5420  var RTS RTS' RTSSol : ResultContextSet .
5421  var RT RT' : ResultContext .
5422  vars TP TP' : Type .
5423  vars S S' Subst S* S'* : Substitution .
5424  var RLS : RuleSet .
5425  var Att : AttrSet .
5426  var B BN Sol : Bound .
5427  var N : Nat .
5428  var NL : NatList .
5429  vars Ct Ct' CtS CtS' : Context .
5430  var ON : TypeOfNarrowing .
5431  vars QQ QQ' : TypeOfRelation .
5432  vars NextVar NextVar' : Nat .
5433
5434  var SCond : SubstitutionCond .
5435
5436  --- metaNarrowSearch --------------------------------------------------------
5437
5438  *** Shortcuts to Narrowing Search
5439  op metaNarrowSearch : Module Term Term SubstitutionCond
5440                        TypeOfRelation Bound Bound Bound
5441                        -> ResultTripleSet .
5442  eq metaNarrowSearch(M,T,T',SCond,QQ,BN,B,Sol)
5443   = if (BN == unbounded and-then Sol =/= unbounded)
5444        or-else
5445        (BN =/= unbounded and-then Sol =/= unbounded and-then BN < Sol)
5446     then metaNarrowSearch*(M,T,T',SCond,QQ,Sol,B,Sol)
5447     else metaNarrowSearch*(M,T,T',SCond,QQ,BN,B,Sol)
5448     fi .
5449
5450  op metaNarrowSearch* : Module Term Term SubstitutionCond
5451                         TypeOfRelation Bound Bound Bound
5452                         -> ResultTripleSet .
5453  eq metaNarrowSearch*(M,T,T',SCond,QQ,BN,B,Sol)
5454   = metaNarrowSearchGen(M,T,T',SCond,QQ,BN,B,Sol,
5455         full E-BuiltIn-unify noStrategy E-normalize-terms) .
5456
5457  *** Shortcuts to Paramodulation Search
5458  op metaParamodulationSearch : Module Term Term SubstitutionCond
5459                                TypeOfRelation Bound Bound Bound
5460                             -> ResultTripleSet .
5461  eq metaParamodulationSearch(M,T,T',SCond,QQ,BN,B,Sol)
5462   = if (BN == unbounded and-then Sol =/= unbounded)
5463        or-else
5464        (BN =/= unbounded and-then Sol =/= unbounded and-then BN < Sol)
5465     then metaParamodulationSearch*(M,T,T',SCond,QQ,Sol,B,Sol)
5466     else metaParamodulationSearch*(M,T,T',SCond,QQ,BN,B,Sol)
5467     fi .
5468
5469  op metaParamodulationSearch* : Module Term Term SubstitutionCond
5470                         TypeOfRelation Bound Bound Bound
5471                         -> ResultTripleSet .
5472  eq metaParamodulationSearch*(M,T,T',SCond,QQ,BN,B,Sol)
5473   = metaNarrowSearchGen(M,T,T',SCond,QQ,BN,B,Sol,
5474         full E-BuiltIn-unify noStrategy E-normalize-terms alsoAtVarPosition) .
5475
5476  *** General Call
5477  op metaNarrowSearchGen : Module Term Term SubstitutionCond
5478                           TypeOfRelation
5479                           Bound --- number of steps
5480                           Bound --- number of solutions
5481                           Bound --- chosen solution
5482                           TypeOfNarrowing
5483			-> ResultTripleSet .
5484  eq metaNarrowSearchGen(M,T,T',SCond,QQ,B,BN,Sol,ON)
5485   = toTriple(M,metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol,ON)) .
5486
5487  *** Shortcuts to Narrowing Search Path
5488  op metaNarrowSearchPath : Module Term Term SubstitutionCond
5489                            TypeOfRelation Bound Bound Bound
5490                         -> TraceNarrowSet .
5491  eq metaNarrowSearchPath(M,T,T',SCond,QQ,B,BN,Sol)
5492   = if (BN == unbounded and-then Sol =/= unbounded)
5493        or-else
5494        (BN =/= unbounded and-then Sol =/= unbounded and-then BN < Sol)
5495     then metaNarrowSearchPath*(M,T,T',SCond,QQ,Sol,B,Sol)
5496     else metaNarrowSearchPath*(M,T,T',SCond,QQ,BN,B,Sol)
5497     fi .
5498
5499  op metaNarrowSearchPath* : Module Term Term SubstitutionCond
5500                             TypeOfRelation Bound Bound Bound
5501                          -> TraceNarrowSet .
5502  eq metaNarrowSearchPath*(M,T,T',SCond,QQ,BN,B,Sol)
5503   = extractTraces(
5504       metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol,
5505         full E-BuiltIn-unify noStrategy E-normalize-terms)) .
5506
5507  op extractTraces : ResultContextSet -> TraceNarrowSet .
5508  eq extractTraces(empty) = empty .
5509  eq extractTraces({T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags} | RTS)
5510   = if Tr:TraceNarrow == nil then empty else Tr:TraceNarrow fi
5511     | extractTraces(RTS) .
5512
5513  *** Starting Call
5514  op metaNarrowSearchGenAll : Module Term Term SubstitutionCond
5515                              TypeOfRelation Bound Bound Bound TypeOfNarrowing
5516                           -> ResultContextSet .
5517  eq metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol,ON)
5518   = metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol,ON,highestVar((T,T')) + 1) .
5519
5520  op metaNarrowSearchGenAll : Module Term Term SubstitutionCond
5521                            TypeOfRelation Bound Bound Bound TypeOfNarrowing Nat
5522                         -> ResultContextSet .
5523  eq metaNarrowSearchGenAll(M,T,T',SCond,QQ,B,BN,Sol,ON,N)
5524   = metaNarrowSearchAll(addSorts('Universal,M),
5525            T,T',SCond,QQ,B,BN,Sol,ON,
5526            {T,leastSort(M,T),none,none,[],[],T,T,N,nil,empty}) .
5527
5528  *** One Narrowing step in the search process (including possible filters)
5529  op metaNarrowStep : Module SubstitutionCond
5530                      ResultContextSet TypeOfNarrowing
5531		   -> ResultContextSet .
5532  eq metaNarrowStep(M,SCond,RTS,ON)
5533   = filterSCond(M,SCond,metaENarrowGen(M,1,ON,RTS)) .
5534
5535  *** Filter and normal forms
5536  op filterSCond : Module SubstitutionCond ResultContextSet
5537                   -> ResultContextSet .
5538  eq filterSCond(M,none,RTS)
5539   = RTS .
5540  eq filterSCond(M,SCond,RTS)
5541   = filterSCond*(M,SCond,RTS) [owise] .
5542
5543  op filterSCond* : Module SubstitutionCond ResultContextSet
5544                   -> ResultContextSet .
5545  eq filterSCond*(M,SCond,empty)
5546   = empty .
5547  eq filterSCond*(M,SCond,RT | RTS)
5548   = filterSCond**(M,SCond,RT) | filterSCond*(M,SCond,RTS) .
5549
5550  op filterSCond** : Module SubstitutionCond ResultContext
5551                   -> ResultContextSet .
5552  eq filterSCond**(M,SCond,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
5553   = if SCond <=[M] S
5554     then {T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}
5555     else empty
5556     fi .
5557
5558  *** Generate next successors in a breadth way
5559  --- We reuse the metaNarrowSearchAll function
5560  op metaNarrowSearchAll : Module Term Term SubstitutionCond TypeOfRelation
5561                            Bound --- number steps
5562                            Bound --- number solutions
5563                            Bound --- chosen solution
5564                            TypeOfNarrowing
5565                            ResultContextSet
5566			 -> ResultContextSet .
5567  eq metaNarrowSearchAll(M,TOrig,T',SCond,QQ,B,BN,Sol,ON,RTS)
5568   = if QQ == '+
5569     then noSelf(RTS,
5570          metaNarrowSearchCheck(M,TOrig,T',SCond,'*,B,BN,Sol,ON,empty,RTS,empty)
5571          )
5572     else metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,B,BN,Sol,ON,empty,RTS,RTS)
5573     fi .
5574
5575  *** Take only normal forms
5576  op isNF : Module ResultContext -> Bool .
5577  eq isNF(M,{T,TP,S,S',Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
5578   = end(B:Flags) or-else metaOneRewriting(M,CtTS) == empty .
5579
5580  *** Take only normal forms
5581  op isVariant : Module Nat ResultContextSet ResultContext -> Bool .
5582  eq isVariant(M,N,
5583        {T',TP',S',S'*,Ct',CtS',TS',CtTS',NextVar',Tr':TraceNarrow,B':Flags} | RTS,
5584        {T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags})
5585    = not (
5586       (S' |> N ; (newVar(N + 1,TP') <- CtTS'))
5587           <=[M]
5588       (S |> N ; (newVar(N + 1,TP) <- CtTS))
5589      )
5590      and-then
5591      isVariant(M,N,RTS,{T,TP,S,S*,Ct,CtS,TS,CtTS,NextVar,Tr:TraceNarrow,B:Flags}) .
5592  eq isVariant(M,N,RTS,RT)
5593   = true [owise] .
5594
5595
5596  *** Generate successors
5597  op oneMoreStep : Module SubstitutionCond TypeOfNarrowing
5598                   ResultContextSet -> ResultContextSet [memo] .
5599  eq oneMoreStep(M,SCond,ON,RTS)
5600   = remove metaNarrowStep(M,SCond,removeEND(RTS),ON) From RTS .
5601
5602  *** Check each next successor for conditions
5603  op metaNarrowSearchCheck : Module Term Term SubstitutionCond
5604                             TypeOfRelation Bound Bound Bound TypeOfNarrowing
5605                             ResultContextSet ResultContextSet ResultContextSet
5606			     -> ResultContextSet .
5607
5608  eq metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,B,BN,Sol,ON,RTSSol,RTS',empty)
5609   = if B == 0 or-else BN == 0 or-else Sol == 0 or-else RTS' == empty
5610     then *** Stop the search
5611          RTSSol
5612     else *** Compute Next successors of RTS' with oneMoreStep
5613          metaNarrowSearchCheck(M,
5614            TOrig,T',SCond,
5615            QQ,
5616            dec(B),BN,Sol,
5617            ON,
5618            RTSSol,
5619            oneMoreStep(M,SCond,ON,RTS'),
5620            oneMoreStep(M,SCond,ON,RTS')
5621          )
5622     fi .
5623
5624  eq metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,B,BN,Sol,ON,RTSSol,RTS',
5625         RT | RTS)
5626   = if isSolution?(M,TOrig,T',QQ,BN,Sol,ON,RTSSol,RT)
5627        and-then
5628        auxMetaUnifyCheck(M,ON,getCTTerm(RT),T',getNextVar(RT)) =/= empty *** Is actual term an instance of T'?
5629     then *** This is a solution
5630          metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,
5631                  B,dec(BN),dec(Sol),
5632                  ON,
5633                  if Sol == unbounded or-else Sol == 1
5634                  then rebuildTypeAndDiscardErroneousCheck(M,ON,
5635                          RT <<(M,ON) auxMetaUnifyCheck(M,ON,getCTTerm(RT),T',getNextVar(RT)))
5636                  else empty
5637                  fi
5638                  | RTSSol,
5639                  RTS',RTS)
5640     else *** Continue with the remaining
5641	  metaNarrowSearchCheck(M,TOrig,T',SCond,QQ,
5642             B,BN,Sol,ON,RTSSol,RTS',RTS)
5643     fi .
5644
5645  op auxMetaUnifyCheck : Module TypeOfNarrowing Term Term Nat ~> UnificationTripleSet .
5646  eq auxMetaUnifyCheck(M,ON,T,T',N) = auxMetaUnify(M,ON,T,T',N) .
5647
5648  op rebuildTypeAndDiscardErroneousCheck : Module TypeOfNarrowing ResultContextSet -> ResultContextSet .
5649  eq rebuildTypeAndDiscardErroneousCheck(M,ON,RTS) = rebuildTypeAndDiscardErroneous(M,ON,RTS) .
5650
5651  op isSolution? : Module Term Term
5652                   TypeOfRelation Bound Bound TypeOfNarrowing
5653                   ResultContextSet ResultContext
5654	        -> Bool .
5655  eq isSolution?(M,TOrig,T',QQ,BN,Sol,ON,RTSSol,RT)
5656   = *** Is this the chosen solution?
5657     (BN == unbounded or-else BN > 0)
5658     and-then
5659     *** Is this step correct wrt relations <'!,'*,'+> ?
5660     ( QQ == '* or-else (QQ == '! and-then isEND(RT)) )
5661     and-then
5662     *** Is this a valid variant solution?
5663     (not (variant in ON) or-else
5664      (isNF(M,RT) and-then isVariant(M,highestVar(TOrig) + 1,RTSSol,RT))) .
5665
5666  op upDown : Module ResultTripleSet -> ResultTripleSet .
5667  eq upDown(M,RTS:ResultTripleSet)
5668   = upDown#(M,empty,RTS:ResultTripleSet) .
5669  op upDown# : Module ResultTripleSet ResultTripleSet -> ResultTripleSet .
5670  eq upDown#(M,RTS':ResultTripleSet, empty)
5671   = RTS':ResultTripleSet .
5672  eq upDown#(M,RTS':ResultTripleSet, {T,TP,S} | RTS:ResultTripleSet)
5673   = upDown#(M,{getTerm(metaReduce(M,T)),TP,upDown(M,S)}
5674               | RTS':ResultTripleSet,RTS:ResultTripleSet) .
5675
5676  op upDown : Module Substitution -> Substitution .
5677  eq upDown(M,S:Substitution)
5678   = upDown#(M,none,S:Substitution) .
5679  op upDown# : Module Substitution Substitution -> Substitution .
5680  eq upDown#(M,S':Substitution,none)
5681   = S':Substitution .
5682  eq upDown#(M,S':Substitution,V <- T ; S:Substitution)
5683   = upDown#(M,S':Substitution ; V <- getTerm(metaReduce(M,T)),S:Substitution) .
5684
5685endfm
5686*************************************
5687****** End of Santiago Escobar's code
5688*******************************************************************************
5689*******************************************************************************
5690
5691fmod 2TUPLE{X :: TRIV, Y :: TRIV} is
5692  sorts Tuple{X, Y} .
5693  op ((_,_)) : X$Elt Y$Elt -> Tuple{X, Y} .
5694  op p1_ : Tuple{X, Y} -> X$Elt .
5695  op p2_ : Tuple{X, Y} -> Y$Elt .
5696  eq p1(V1:[X$Elt],V2:[Y$Elt]) = V1:[X$Elt] .
5697  eq p2(V1:[X$Elt],V2:[Y$Elt]) = V2:[Y$Elt] .
5698endfm
5699
5700fmod 3TUPLE{X :: TRIV, Y :: TRIV, Z :: TRIV} is
5701  sort Tuple{X, Y, Z} .
5702  op ((_,_,_)) : X$Elt Y$Elt Z$Elt -> Tuple{X, Y, Z} .
5703  op p1_ : Tuple{X, Y, Z} -> X$Elt .
5704  op p2_ : Tuple{X, Y, Z} -> Y$Elt .
5705  op p3_ : Tuple{X, Y, Z} -> Z$Elt .
5706  eq p1((A:[X$Elt], B:[Y$Elt], C:[Z$Elt])) = A:[X$Elt] .
5707  eq p2((A:[X$Elt], B:[Y$Elt], C:[Z$Elt])) = B:[Y$Elt] .
5708  eq p3((A:[X$Elt], B:[Y$Elt], C:[Z$Elt])) = C:[Z$Elt] .
5709endfm
5710
5711fmod 4TUPLE{W :: TRIV, X :: TRIV, Y :: TRIV, Z :: TRIV} is
5712  sort Tuple{W, X, Y, Z} .
5713  op ((_,_,_,_)) : W$Elt X$Elt Y$Elt Z$Elt -> Tuple{W, X, Y, Z} .
5714  op p1_ : Tuple{W, X, Y, Z} -> W$Elt .
5715  op p2_ : Tuple{W, X, Y, Z} -> X$Elt .
5716  op p3_ : Tuple{W, X, Y, Z} -> Y$Elt .
5717  op p4_ : Tuple{W, X, Y, Z} -> Z$Elt .
5718  eq p1((A:[W$Elt], B:[X$Elt], C:[Y$Elt], D:[Z$Elt])) = A:[W$Elt] .
5719  eq p2((A:[W$Elt], B:[X$Elt], C:[Y$Elt], D:[Z$Elt])) = B:[X$Elt] .
5720  eq p3((A:[W$Elt], B:[X$Elt], C:[Y$Elt], D:[Z$Elt])) = C:[Y$Elt] .
5721  eq p4((A:[W$Elt], B:[X$Elt], C:[Y$Elt], D:[Z$Elt])) = D:[Z$Elt] .
5722endfm
5723
5724fmod 5TUPLE{V :: TRIV, W :: TRIV, X :: TRIV, Y :: TRIV, Z :: TRIV} is
5725  sort Tuple{V, W, X, Y, Z} .
5726  op ((_,_,_,_,_)) : V$Elt W$Elt X$Elt Y$Elt Z$Elt -> Tuple{V, W, X, Y, Z} .
5727  op p1_ : Tuple{V, W, X, Y, Z} -> V$Elt .
5728  op p2_ : Tuple{V, W, X, Y, Z} -> W$Elt .
5729  op p3_ : Tuple{V, W, X, Y, Z} -> X$Elt .
5730  op p4_ : Tuple{V, W, X, Y, Z} -> Y$Elt .
5731  op p5_ : Tuple{V, W, X, Y, Z} -> Z$Elt .
5732  eq p1((A:[V$Elt], B:[W$Elt], C:[X$Elt], D:[Y$Elt], E:[Z$Elt])) = A:[V$Elt] .
5733  eq p2((A:[V$Elt], B:[W$Elt], C:[X$Elt], D:[Y$Elt], E:[Z$Elt])) = B:[W$Elt] .
5734  eq p3((A:[V$Elt], B:[W$Elt], C:[X$Elt], D:[Y$Elt], E:[Z$Elt])) = C:[X$Elt] .
5735  eq p4((A:[V$Elt], B:[W$Elt], C:[X$Elt], D:[Y$Elt], E:[Z$Elt])) = D:[Y$Elt] .
5736  eq p5((A:[V$Elt], B:[W$Elt], C:[X$Elt], D:[Y$Elt], E:[Z$Elt])) = E:[Z$Elt] .
5737endfm
5738
5739fmod 6TUPLE{U :: TRIV, V :: TRIV, W :: TRIV, X :: TRIV, Y :: TRIV, Z :: TRIV} is
5740  sort Tuple{U, V, W, X, Y, Z} .
5741  op ((_,_,_,_,_,_)) : U$Elt V$Elt W$Elt X$Elt Y$Elt Z$Elt -> Tuple{U, V, W, X, Y, Z} .
5742  op p1_ : Tuple{U, V, W, X, Y, Z} -> U$Elt .
5743  op p2_ : Tuple{U, V, W, X, Y, Z} -> V$Elt .
5744  op p3_ : Tuple{U, V, W, X, Y, Z} -> W$Elt .
5745  op p4_ : Tuple{U, V, W, X, Y, Z} -> X$Elt .
5746  op p5_ : Tuple{U, V, W, X, Y, Z} -> Y$Elt .
5747  op p6_ : Tuple{U, V, W, X, Y, Z} -> Z$Elt .
5748  eq p1((A:[U$Elt], B:[V$Elt], C:[W$Elt], D:[X$Elt], E:[Y$Elt], F:[Z$Elt])) = A:[U$Elt] .
5749  eq p2((A:[U$Elt], B:[V$Elt], C:[W$Elt], D:[X$Elt], E:[Y$Elt], F:[Z$Elt])) = B:[V$Elt] .
5750  eq p3((A:[U$Elt], B:[V$Elt], C:[W$Elt], D:[X$Elt], E:[Y$Elt], F:[Z$Elt])) = C:[W$Elt] .
5751  eq p4((A:[U$Elt], B:[V$Elt], C:[W$Elt], D:[X$Elt], E:[Y$Elt], F:[Z$Elt])) = D:[X$Elt] .
5752  eq p5((A:[U$Elt], B:[V$Elt], C:[W$Elt], D:[X$Elt], E:[Y$Elt], F:[Z$Elt])) = E:[Y$Elt] .
5753  eq p6((A:[U$Elt], B:[V$Elt], C:[W$Elt], D:[X$Elt], E:[Y$Elt], F:[Z$Elt])) = F:[Z$Elt] .
5754endfm
5755
5756view QidList from TRIV to QID-LIST is
5757  sort Elt to QidList .
5758endv
5759
5760view TermList from TRIV to META-MODULE is
5761  sort Elt to TermList .
5762endv
5763
5764view RuleSet from TRIV to META-MODULE is
5765  sort Elt to RuleSet .
5766endv
5767
5768view EquationSet from TRIV to META-MODULE is
5769  sort Elt to EquationSet .
5770endv
5771
5772view OpDeclSet from TRIV to META-MODULE is
5773  sort Elt to OpDeclSet .
5774endv
5775
5776view ImportList from TRIV to META-MODULE is
5777  sort Elt to ImportList .
5778endv
5779
5780view Condition from TRIV to META-MODULE is
5781  sort Elt to Condition .
5782endv
5783
5784view QidSet from TRIV to META-MODULE is
5785  sort Elt to QidSet .
5786endv
5787
5788view Module from TRIV to META-MODULE is
5789  sort Elt to Module .
5790endv
5791
5792view ParameterDeclList from TRIV to META-MODULE is
5793  sort Elt to ParameterDeclList .
5794endv
5795
5796view Bound from TRIV to META-LEVEL is
5797  sort Elt to Bound .
5798endv
5799
5800view Oid from TRIV to CONFIGURATION is
5801  sort Elt to Oid .
5802endv
5803
5804-------------------------------------------------------------------------------
5805*******************************************************************************
5806***
5807*** 2 The Signature of Full Maude
5808***
5809*******************************************************************************
5810-------------------------------------------------------------------------------
5811
5812fmod EXTENDED-SORTS is
5813  ---- Any modification in this module must be reflected in the metamodule
5814  ---- used in eq addInfoConds in module UNIT-BUBBLE-PARSING
5815  sorts @SortToken@ @ViewToken@ @Sort@ @Kind@ @Type@ @SortList@
5816        @TypeList@ @ViewExp@ @ModExp@ .
5817
5818  subsorts @SortToken@ < @Sort@ < @SortList@ < @TypeList@ .
5819  subsorts @Sort@ @Kind@ < @Type@ < @TypeList@ .
5820  subsort @ViewToken@ < @ViewExp@ .
5821
5822  op _`{_`} : @Sort@ @ViewExp@ -> @Sort@ [prec 40] .
5823  op __ : @SortList@ @SortList@ -> @SortList@ [assoc] .
5824  op __ : @TypeList@ @TypeList@ -> @TypeList@ [assoc] .
5825  op `[_`] : @Sort@ -> @Kind@ .
5826
5827  op _`,_ : @ViewExp@ @ViewExp@ -> @ViewExp@ [assoc] .
5828  op _`{_`} : @ViewExp@ @ViewExp@ -> @ViewExp@ [prec 40] .
5829endfm
5830
5831-------------------------------------------------------------------------------
5832******************************************************************************
5833-------------------------------------------------------------------------------
5834
5835fmod OPERATOR-ATTRIBUTES is
5836  sorts @Attr@ @AttrList@ @Hook@ @HookList@ @Bubble@ @Token@ @NeTokenList@ .
5837  subsort @Attr@ < @AttrList@ .
5838  subsort @Hook@ < @HookList@ .
5839
5840  op __ : @AttrList@ @AttrList@ -> @AttrList@ [assoc] .
5841  ops assoc associative : -> @Attr@ .
5842  ops comm commutative : -> @Attr@ .
5843  ops idem idempotent : -> @Attr@ .
5844  ops id:_ identity:_ : @Bubble@ -> @Attr@ .
5845  ops left`id:_ left`identity:_ : @Bubble@ -> @Attr@ .
5846  ops right`id:_ right`identity:_ : @Bubble@ -> @Attr@ .
5847  ops frozen`(_`) poly`(_`) strat`(_`) strategy`(_`) :
5848        @NeTokenList@ -> @AttrList@ .
5849  ops memo memoization : -> @Attr@ .
5850  ops prec_ precedence_ : @Token@ -> @Attr@ .
5851  ops gather`(_`) gathering`(_`) : @NeTokenList@ -> @Attr@ .
5852  ops format`(_`) : @NeTokenList@ -> @Attr@ .
5853  ops ctor constructor : -> @Attr@ .
5854  ops frozen ditto iter : -> @Attr@ .
5855  ops object msg message config : -> @Attr@ .
5856  op metadata_ : @Token@ -> @Attr@ .
5857
5858  op special`(_`) : @HookList@ -> @Attr@ .
5859  op __ : @HookList@ @HookList@ -> @HookList@ [assoc] .
5860  op id-hook_ : @Token@ -> @Hook@ .
5861  op id-hook_`(_`) : @Token@ @NeTokenList@ -> @Hook@ .
5862  op op-hook_`(_:_->_`) : @Token@ @Token@ @NeTokenList@ @Token@ -> @Hook@ .
5863  op op-hook_`(_:`->_`) : @Token@ @Token@ @Token@ -> @Hook@ .
5864  op op-hook_`(_:_~>_`) : @Token@ @Token@ @NeTokenList@ @Token@ -> @Hook@ .
5865  op op-hook_`(_:`~>_`) : @Token@ @Token@ @Token@ -> @Hook@ .
5866  op term-hook_`(_`) : @Token@ @Bubble@ -> @Hook@ .
5867endfm
5868
5869-------------------------------------------------------------------------------
5870*******************************************************************************
5871-------------------------------------------------------------------------------
5872
5873fmod FM-MOD-EXPRS is
5874  including OPERATOR-ATTRIBUTES .
5875  including EXTENDED-SORTS .
5876
5877  sorts @Map@ @MapList@ .
5878  subsort @Map@ < @MapList@ .
5879  subsorts @Token@ < @ModExp@ .
5880
5881  *** module expression
5882  op _*`(_`) : @ModExp@ @MapList@ -> @ModExp@ .
5883  op _`{_`} : @ModExp@ @ViewExp@ -> @ModExp@ .
5884  op TUPLE`[_`] : @Token@ -> @ModExp@ .
5885  op POWER`[_`] : @Token@ -> @ModExp@ .
5886  op _+_ : @ModExp@ @ModExp@ -> @ModExp@ [assoc prec 42] .
5887
5888  *** renaming maps
5889  op op_to_ : @Token@ @Token@ -> @Map@ .
5890  op op_:_->_to_ : @Token@ @TypeList@ @Type@ @Token@ -> @Map@ .
5891  op op_: ->_to_ : @Token@ @Type@ @Token@ -> @Map@ .
5892  op op_:_~>_to_ : @Token@ @TypeList@ @Type@ @Token@ -> @Map@ .
5893  op op_: ~>_to_ : @Token@ @Type@ @Token@ -> @Map@ .
5894  op op_to_`[_`] : @Token@ @Token@ @AttrList@ -> @Map@ .
5895  op op_:_->_to_`[_`] : @Token@ @TypeList@ @Type@ @Token@ @AttrList@ -> @Map@ .
5896  op op_:`->_to_`[_`] : @Token@ @Type@ @Token@ @AttrList@ -> @Map@ .
5897  op op_:_~>_to_`[_`] : @Token@ @TypeList@ @Type@ @Token@ @AttrList@ -> @Map@ .
5898  op op_:`~>_to_`[_`] : @Token@ @Type@ @Token@ @AttrList@ -> @Map@ .
5899  op sort_to_ : @Sort@ @Sort@ -> @Map@ .
5900  op label_to_ : @Token@ @Token@ -> @Map@ .
5901  op class_to_ : @Sort@ @Sort@ -> @Map@ .
5902  op attr_._to_ : @Sort@ @Token@ @Token@ -> @Map@ .
5903  op msg_to_ : @Token@ @Token@ -> @Map@ .
5904  op msg_:_->_to_ : @Token@ @TypeList@ @Type@ @Token@ -> @Map@ .
5905  op msg_:`->_to_ : @Token@ @Type@ @Token@ -> @Map@ .
5906
5907  op _`,_ : @MapList@ @MapList@ -> @MapList@ [assoc prec 42] .
5908endfm
5909
5910-------------------------------------------------------------------------------
5911*******************************************************************************
5912-------------------------------------------------------------------------------
5913
5914fmod SIGNATURES is
5915  inc FM-MOD-EXPRS .
5916
5917  sorts @SortDecl@ @SubsortRel@ @SubsortDecl@ @OpDecl@ .
5918
5919  op `(_`) : @Token@ -> @Token@ .
5920
5921  *** sort declaration
5922  op sorts_. : @SortList@ -> @SortDecl@ .
5923  op sort_. : @SortList@ -> @SortDecl@ .
5924
5925  *** subsort declaration
5926  op subsort_. : @SubsortRel@ -> @SubsortDecl@ .
5927  op subsorts_. : @SubsortRel@ -> @SubsortDecl@ .
5928  op _<_ : @SortList@ @SortList@ -> @SubsortRel@ .
5929  op _<_ : @SortList@ @SubsortRel@ -> @SubsortRel@ .
5930
5931  *** operator declaration
5932  op op_:`->_. : @Token@ @Type@ -> @OpDecl@ .
5933  op op_:`->_`[_`]. : @Token@ @Type@ @AttrList@ -> @OpDecl@ .
5934  op op_:_->_. : @Token@ @TypeList@ @Type@ -> @OpDecl@ .
5935  op op_:_->_`[_`]. : @Token@ @TypeList@ @Type@ @AttrList@ -> @OpDecl@ .
5936  op ops_:`->_. : @NeTokenList@ @Type@ -> @OpDecl@ .
5937  op ops_:`->_`[_`]. : @NeTokenList@ @Type@ @AttrList@ -> @OpDecl@ .
5938  op ops_:_->_. : @NeTokenList@ @TypeList@ @Type@ -> @OpDecl@ .
5939  op ops_:_->_`[_`]. : @NeTokenList@ @TypeList@ @Type@ @AttrList@ -> @OpDecl@ .
5940
5941  op op_:`~>_. : @Token@ @Sort@ -> @OpDecl@ .
5942  op op_:`~>_`[_`]. : @Token@ @Sort@ @AttrList@ -> @OpDecl@ .
5943  op op_:_~>_. : @Token@ @TypeList@ @Sort@ -> @OpDecl@ .
5944  op op_:_~>_`[_`]. : @Token@ @TypeList@ @Sort@ @AttrList@ -> @OpDecl@ .
5945  op ops_:`~>_. : @NeTokenList@ @Sort@ -> @OpDecl@ .
5946  op ops_:`~>_`[_`]. : @NeTokenList@ @Sort@ @AttrList@ -> @OpDecl@ .
5947  op ops_:_~>_. : @NeTokenList@ @TypeList@ @Sort@ -> @OpDecl@ .
5948  op ops_:_~>_`[_`]. : @NeTokenList@ @TypeList@ @Sort@ @AttrList@ -> @OpDecl@ .
5949endfm
5950
5951-------------------------------------------------------------------------------
5952*******************************************************************************
5953-------------------------------------------------------------------------------
5954
5955fmod F&S-MODS&THS is
5956  including SIGNATURES .
5957  including QID-LIST .
5958
5959  sorts @FDeclList@ @SDeclList@ @Module@ @ImportDecl@ @Parameter@
5960        @List<Parameter>@ @EqDecl@ @RlDecl@ @MbDecl@ @VarDecl@ @VarDeclList@ .
5961
5962  subsort @VarDecl@ < @VarDeclList@ .
5963  subsorts @VarDecl@ @ImportDecl@ @SortDecl@ @SubsortDecl@ @OpDecl@ @MbDecl@
5964           @EqDecl@ @VarDeclList@ < @FDeclList@ .
5965  subsorts @RlDecl@ @FDeclList@ < @SDeclList@ .
5966
5967  *** variable declaration
5968  op vars_:_. : @NeTokenList@ @Type@ -> @VarDecl@ .
5969  op var_:_. : @NeTokenList@ @Type@ -> @VarDecl@ .
5970
5971  *** membership axiom declaration
5972  op mb_:_. : @Bubble@ @Bubble@ -> @MbDecl@ .
5973  ----op mb[_]:_:_. : @Token@ @Bubble@ @Bubble@ -> @MbDecl@ .
5974  op cmb_:_if_. : @Bubble@ @Sort@ @Bubble@ -> @MbDecl@ .
5975  op cmb[_]:_:_if_. : @Token@ @Bubble@ @Sort@ @Bubble@ -> @MbDecl@ .
5976
5977  *** equation declaration
5978  op eq_=_. : @Bubble@ @Bubble@ -> @EqDecl@ .
5979  op ceq_=_if_. : @Bubble@ @Bubble@ @Bubble@ -> @EqDecl@ .
5980  op cq_=_if_. : @Bubble@ @Bubble@ @Bubble@ -> @EqDecl@ .
5981
5982  *** rule declaration
5983  *** op rl`[_`]:_=>_. : @Token@ @Bubble@ @Bubble@ -> @RlDecl@ .
5984  op rl_=>_. : @Bubble@ @Bubble@ -> @RlDecl@ .
5985  *** op crl`[_`]:_=>_if_. : @Token@ @Bubble@ @Bubble@ @Bubble@ -> @RlDecl@ .
5986  op crl_=>_if_. : @Bubble@ @Bubble@ @Bubble@ -> @RlDecl@ .
5987
5988  *** importation declaration
5989  ops including_. inc_. : @ModExp@ -> @ImportDecl@ .
5990  ops extending_. ex_. : @ModExp@ -> @ImportDecl@ .
5991  ops protecting_. pr_. : @ModExp@ -> @ImportDecl@ .
5992
5993  sorts @Interface@ .
5994  subsort @Parameter@ < @List<Parameter>@ .
5995  subsorts @Token@ < @Interface@ .
5996
5997  *** parameterized module interface
5998  op _::_ : @Token@ @ModExp@ -> @Parameter@ [prec 40 gather (e &)] .
5999  op _::_ : @Token@ @Interface@ -> @Parameter@ [prec 40 gather (e &)] .
6000
6001  op _`,_ : @List<Parameter>@ @List<Parameter>@ -> @List<Parameter>@ [assoc] .
6002
6003  op _`{_`} : @ModExp@ @List<Parameter>@ -> @Interface@ .
6004
6005  *** declaration list
6006  op __ : @VarDeclList@ @VarDeclList@ -> @VarDeclList@ [assoc] .
6007  op __ : @SDeclList@ @SDeclList@ -> @SDeclList@ [assoc] .
6008  op __ : @FDeclList@ @FDeclList@ -> @FDeclList@ [assoc] .
6009
6010  *** functional and system module and theory
6011  op fmod_is_endfm : @Interface@ @FDeclList@ -> @Module@ .
6012  op obj_is_jbo : @Interface@ @FDeclList@ -> @Module@ .
6013  op obj_is_endo : @Interface@ @FDeclList@ -> @Module@ .
6014  op mod_is_endm : @Interface@ @SDeclList@ -> @Module@ .
6015  op fth_is_endfth : @Interface@ @FDeclList@ -> @Module@ .
6016  op th_is_endth : @Interface@ @SDeclList@ -> @Module@ .
6017endfm
6018
6019-------------------------------------------------------------------------------
6020*******************************************************************************
6021-------------------------------------------------------------------------------
6022
6023fmod O-MODS&THS is
6024  including F&S-MODS&THS .
6025
6026  sorts @ClassDecl@ @AttrDecl@ @AttrDeclList@ @SubclassDecl@ @MsgDecl@
6027        @ODeclList@ .
6028  subsorts @SDeclList@ @MsgDecl@ @SubclassDecl@ @ClassDecl@ < @ODeclList@ .
6029  subsort @AttrDecl@ < @AttrDeclList@ .
6030
6031  op __ : @ODeclList@ @ODeclList@ -> @ODeclList@ [assoc] .
6032
6033  *** object-oriented module and theory
6034  op omod_is_endom : @Interface@ @ODeclList@ -> @Module@ .
6035  op oth_is_endoth : @Interface@ @ODeclList@ -> @Module@ .
6036
6037  *** class declaration
6038  op class_|_. : @Sort@ @AttrDeclList@ -> @ClassDecl@ .
6039  op class_|`. : @Sort@ -> @ClassDecl@ .
6040  op class_. : @Sort@ -> @ClassDecl@ .
6041  op _`,_ : @AttrDeclList@ @AttrDeclList@ -> @AttrDeclList@ [assoc] .
6042  op _:_ : @Token@ @Sort@ -> @AttrDecl@ [prec 40] .
6043
6044  *** subclass declaration
6045  op subclass_. : @SubsortRel@ -> @SubclassDecl@ .
6046  op subclasses_. : @SubsortRel@ -> @SubclassDecl@ .
6047
6048  *** message declaration
6049  op msg_:_->_. : @Token@ @SortList@ @Sort@ -> @MsgDecl@ .
6050  op msgs_:_->_. : @NeTokenList@ @SortList@ @Sort@ -> @MsgDecl@ .
6051  op msg_:`->_. : @Token@ @Sort@ -> @MsgDecl@ .
6052  op msgs_:`->_. : @NeTokenList@ @Sort@ -> @MsgDecl@ .
6053endfm
6054
6055-------------------------------------------------------------------------------
6056*******************************************************************************
6057-------------------------------------------------------------------------------
6058
6059fmod VIEWS is
6060  including O-MODS&THS .
6061
6062  sorts @ViewDecl@ @ViewDeclList@ @View@ .
6063  subsorts @VarDecl@ < @ViewDecl@ < @ViewDeclList@ .
6064  subsort @VarDeclList@ < @ViewDeclList@ .
6065
6066  *** view maps
6067  op op_to`term_. : @Bubble@ @Bubble@ -> @ViewDecl@ .
6068  op op_to_. : @Token@ @Token@ -> @ViewDecl@ .
6069  op op_:_->_to_. : @Token@ @TypeList@ @Type@ @Token@ -> @ViewDecl@ .
6070  op op_:`->_to_. : @Token@ @Type@ @Token@ -> @ViewDecl@ .
6071  op op_:_~>_to_. : @Token@ @TypeList@ @Type@ @Token@ -> @ViewDecl@ .
6072  op op_:`~>_to_. : @Token@ @Type@ @Token@ -> @ViewDecl@ .
6073  op sort_to_. : @Sort@ @Sort@ -> @ViewDecl@ .
6074  op class_to_. : @Sort@ @Sort@ -> @ViewDecl@ .
6075  op attr_._to_. : @Sort@ @Token@ @Token@ -> @ViewDecl@ .
6076  op msg_to_. : @Token@ @Token@ -> @ViewDecl@ .
6077  op msg_:_->_to_. : @Token@ @TypeList@ @Type@ @Token@ -> @ViewDecl@ .
6078  op msg_:`->_to_. : @Token@ @Type@ @Token@ -> @ViewDecl@ .
6079
6080  *** view
6081  op view_from_to_is_endv : @Interface@ @ModExp@ @ModExp@ @ViewDeclList@ -> @View@ .
6082  op view_from_to_is endv : @Interface@ @ModExp@ @ModExp@ -> @View@ .
6083  op __ : @ViewDeclList@ @ViewDeclList@ -> @ViewDeclList@ [assoc] .
6084endfm
6085
6086-------------------------------------------------------------------------------
6087*******************************************************************************
6088-------------------------------------------------------------------------------
6089
6090fmod COMMANDS is
6091  including FM-MOD-EXPRS .
6092
6093  sorts @Command@ .
6094
6095  *** down function
6096  op down_:_ : @ModExp@ @Command@ -> @Command@ .
6097
6098  *** parse commands
6099  op parse_. : @Bubble@ -> @Command@ .
6100
6101  *** reduce commands
6102  op red_. : @Bubble@ -> @Command@ .
6103  op reduce_. : @Bubble@ -> @Command@ .
6104
6105  *** rewrite commands
6106  op rew_. : @Bubble@ -> @Command@ .
6107  op rewrite_. : @Bubble@ -> @Command@ .
6108
6109  *** frewrite commands
6110  op frew_. : @Bubble@ -> @Command@ .
6111  op frewrite_. : @Bubble@ -> @Command@ .
6112
6113  *** search commands
6114  op search_=>1_. : @Bubble@ @Bubble@ -> @Command@ .
6115  op search_=>*_. : @Bubble@ @Bubble@ -> @Command@ .
6116  op search_=>+_. : @Bubble@ @Bubble@ -> @Command@ .
6117  op search_=>!_. : @Bubble@ @Bubble@ -> @Command@ .
6118
6119  *** search commands
6120  op search_~>1_. : @Bubble@ @Bubble@ -> @Command@ .
6121  op search_~>*_. : @Bubble@ @Bubble@ -> @Command@ .
6122  op search_~>+_. : @Bubble@ @Bubble@ -> @Command@ .
6123  op search_~>!_. : @Bubble@ @Bubble@ -> @Command@ .
6124
6125  *** matching commands
6126  op match_<=?_. : @Bubble@ @Bubble@ -> @Command@ .
6127  op xmatch_<=?_. : @Bubble@ @Bubble@ -> @Command@ .
6128
6129  *** unifying command
6130  op unify_. : @Bubble@ -> @Command@ .
6131
6132  *** unifying command
6133  op id-unify_. : @Bubble@ -> @Command@ .
6134
6135  *** unifying command
6136  op variant`unify_. : @Bubble@ -> @Command@ .
6137
6138  *** unifying command
6139  op asymmetric`variant`unify_. : @Bubble@ -> @Command@ .
6140
6141  *** unifying command
6142  op get`variants_. : @Bubble@ -> @Command@ .
6143
6144  *** select command
6145  op select_. : @ModExp@ -> @Command@ .
6146
6147  *** show commands
6148  op show`module`. : -> @Command@ .
6149  op show`module_. : @ModExp@ -> @Command@ .
6150  op show`all`. : -> @Command@ .
6151  op show`all_. : @ModExp@ -> @Command@ .
6152  op show`vars`. : -> @Command@ .
6153  op show`vars_. : @ModExp@ -> @Command@ .
6154  op show`sorts`. : -> @Command@ .
6155  op show`sorts_. : @ModExp@ -> @Command@ .
6156  op show`ops`. : -> @Command@ .
6157  op show`ops_. : @ModExp@ -> @Command@ .
6158  op show`mbs`. : -> @Command@ .
6159  op show`mbs_. : @ModExp@ -> @Command@ .
6160  op show`eqs`. : -> @Command@ .
6161  op show`eqs_. : @ModExp@ -> @Command@ .
6162  op show`rls`. : -> @Command@ .
6163  op show`rls_. : @ModExp@ -> @Command@ .
6164  op show`view_. : @ViewExp@ -> @Command@ .
6165  op show`modules`. : -> @Command@ .
6166  op show`views`. : -> @Command@ .
6167
6168  *** set commands
6169  op set`protect_on`. : @ModExp@ -> @Command@ .
6170  op set`protect_off`. : @ModExp@ -> @Command@ .
6171  op set`include_on`. : @ModExp@ -> @Command@ .
6172  op set`include_off`. : @ModExp@ -> @Command@ .
6173  op set`extend_on`. : @ModExp@ -> @Command@ .
6174  op set`extend_off`. : @ModExp@ -> @Command@ .
6175
6176  *** miscellaneous
6177  op load_. : @Bubble@ -> @Command@ .
6178  ops remove`identity`attributes`. rm`ids`. : -> @Command@ .
6179  ops remove`identity`attributes_. rm`ids_. : @ModExp@ -> @Command@ .
6180  op remove`assoc`attributes`. : -> @Command@ .
6181  op remove`assoc`attributes_. : @ModExp@ -> @Command@ .
6182  op ax`coherence`completion`. : -> @Command@ .
6183  op ax`coherence`completion_. : @ModExp@ -> @Command@ .
6184  op help`. : -> @Command@ .
6185endfm
6186
6187-------------------------------------------------------------------------------
6188*******************************************************************************
6189-------------------------------------------------------------------------------
6190
6191fmod FULL-MAUDE-SIGN is
6192  including VIEWS .
6193  including COMMANDS .
6194
6195  sort @Input@ .
6196  subsorts @Command@ @Module@ @View@ < @Input@ .
6197endfm
6198
6199-------------------------------------------------------------------------------
6200*******************************************************************************
6201-------------------------------------------------------------------------------
6202
6203
6204*******
6205******* ERROR HANDLING, by Peter Olveczky
6206*******
6207
6208*** The following module defines a function which prints up to n characters
6209*** of a bubble, followed by the usual arrow <---*HERE* which points to the
6210*** erroneous token:
6211
6212-------------------------------------------------------------------------------
6213*******************************************************************************
6214-------------------------------------------------------------------------------
6215
6216fmod PRINT-SYNTAX-ERROR is
6217---  protecting META-LEVEL + PRE-VARIANT .
6218  protecting META-LEVEL .
6219  protecting INT .
6220
6221  var  QIL : QidList .
6222  var  Q : Qid .
6223  var  N : Nat .
6224  vars RP RP' : ResultPair .
6225  var  RP? : [ResultPair?] .
6226
6227  op printN : Nat QidList -> QidList .  *** first N qid's in a qidList
6228  eq printN(N, nil) = nil .
6229  eq printN(0, QIL) = nil .
6230  eq printN(s N, Q QIL) = Q printN(N, QIL) .
6231
6232  op removeFront : Nat QidList -> QidList .  *** removes first N qid's
6233  eq removeFront(N, nil) = nil .
6234  eq removeFront(0, QIL) = QIL .
6235  eq removeFront(s N, Q QIL) = removeFront(N, QIL) .
6236
6237  op printSyntaxError : [ResultPair?] QidList -> QidList .
6238  eq printSyntaxError(noParse(N), QIL)
6239    = '\r 'Parse 'error 'in '\o '\s printN(N + 1, QIL) '\r '<---*HERE* '\o .
6240  eq printSyntaxError(ambiguity(RP, RP'), QIL)
6241    = '\r 'Ambiguous 'parsing 'for '\o '\s QIL '\o .
6242  eq printSyntaxError(RP?, QIL) = QIL [owise] .
6243
6244endfm
6245
6246-------------------------------------------------------------------------------
6247*******************************************************************************
6248-------------------------------------------------------------------------------
6249***
6250*** The Abstract Data Type \texttt{Module}
6251***
6252-------------------------------------------------------------------------------
6253*******************************************************************************
6254-------------------------------------------------------------------------------
6255
6256*** In this section we present the abstract data type \texttt{Module}, which
6257*** can be seen as an extension of the predefined sort \texttt{Module} in
6258*** several ways. There are constructors for functional, system, and object-
6259*** oriented modules and theories, which can be parameterized and can import
6260*** module expressions. There can also be parameterized sorts in Full Maude
6261*** modules, and therefore, the constructors for the different declarations
6262*** that can appear in a module have to be appropriately extended.
6263
6264*** The section is structured as follows. After introducing some modules
6265*** defining some functions on the predefined sorts \texttt{Bool} and
6266*** \texttt{QidList} in Section~\ref{BOOL-QID-LIST}, we present in
6267*** Sections~\ref{EXT-SORT} and~\ref{EXT-DECL} the data types for extended
6268*** sorts and extended declarations. In Section~\ref{mod-exp-mod-id} we
6269*** introduce module expressions and module names, and in
6270*** Section~\ref{unitADT} the abstract data type \texttt{Module} itself.
6271
6272***
6273*** Extension \texttt{QID-LIST}
6274***
6275
6276*** The conversion of lists of quoted identifiers into single quoted
6277*** identifiers by concatenating them is heavily used in the coming modules.
6278*** This is the task of the \texttt{} function, which is
6279*** introduced in the following module \texttt{EXT-QID-LIST} extending the
6280*** predefined module \texttt{QID-LIST}.
6281
6282-------------------------------------------------------------------------------
6283*******************************************************************************
6284-------------------------------------------------------------------------------
6285
6286fmod EXT-QID-LIST is
6287  pr QID-LIST .
6288
6289  op qidList2Qid : QidList -> Qid .
6290
6291  vars QI QI' QI'' : Qid .
6292  var  QIL : QidList .
6293  vars St St' : String .
6294  var  N : Nat .
6295  var  F : FindResult .
6296
6297  eq qidList2Qid(('\s QIL)) = qid(" " + string(qidList2Qid(QIL))) .
6298  eq qidList2Qid((QI QIL))
6299    = qid(string(QI) + " " + string(qidList2Qid(QIL)))
6300    [owise] .
6301  eq qidList2Qid(nil) = qid("") .
6302
6303  op trimQidList : QidList -> QidList .
6304  eq trimQidList(' QIL) = trimQidList(QIL) .
6305  eq trimQidList(QI QIL) = QI trimQidList(QIL) [owise] .
6306  eq trimQidList(nil) = nil .
6307
6308  op qidList2string : QidList -> String .
6309  eq qidList2string('`( QIL) = "(" + " " + qidList2string(QIL) .
6310  eq qidList2string('`) QIL) = ")" + " " + qidList2string(QIL) .
6311  eq qidList2string('`{ QIL) = "{" + " " + qidList2string(QIL) .
6312  eq qidList2string('`} QIL) = "}" + " " + qidList2string(QIL) .
6313  eq qidList2string('`[ QIL) = "[" + " " + qidList2string(QIL) .
6314  eq qidList2string('`] QIL) = "]" + " " + qidList2string(QIL) .
6315  eq qidList2string('`, QIL) = "," + " " + qidList2string(QIL) .
6316  eq qidList2string(QI QIL) = string(QI) + " " + qidList2string(QIL) [owise] .
6317  eq qidList2string(nil) = "" .
6318
6319  op string2qidList : String -> QidList .
6320  op string2qidListAux : String -> QidList .
6321
6322  eq string2qidList(St) = trimQidList(string2qidListAux(St)) .
6323
6324  eq string2qidListAux("") = nil .
6325  ceq string2qidListAux(St)
6326    = if F == notFound
6327      then qid(substr(St, findNonSpace(St), length(St)))
6328      else qid(substr(St, findNonSpace(St), F))
6329           if substr(St, findNonSpace(St) + F, 1) =/= " "
6330           then qid(substr(St, findNonSpace(St) + F, 1))
6331           else nil
6332           fi
6333           string2qidListAux(substr(St, findNonSpace(St) + F + 1, length(St)))
6334      fi
6335    if F := myfind(substr(St, findNonSpace(St), length(St)), " (){}[],", 0)
6336    [owise] .
6337
6338  op findNonSpace : String -> Nat .
6339  op findNonSpace : String Nat -> Nat .
6340  ---- returns the length of the string if not found
6341  eq findNonSpace(St) = findNonSpace(St, 0) .
6342
6343  eq findNonSpace(St, N)
6344    = if N < length(St)
6345      then if substr(St, N, 1) == " "
6346           then findNonSpace(St, N + 1)
6347           else N
6348           fi
6349      else length(St)
6350      fi .
6351
6352  op myfind : String String Nat -> FindResult .
6353  eq myfind(St, St', N)
6354    = if N < length(St)
6355      then if find(St', substr(St, N, 1), 0) =/= notFound
6356           then N
6357           else myfind(St, St', N + 1)
6358           fi
6359      else notFound
6360      fi .
6361
6362  op replace : QidList Qid Qid -> QidList .
6363  eq replace(QI QIL, QI', QI'')
6364    = if QI == QI'
6365      then QI'' replace(QIL, QI', QI'')
6366      else QI replace(QIL, QI', QI'')
6367      fi .
6368  eq replace(nil, QI, QI') = nil .
6369endfm
6370
6371fmod HELP is
6372  pr EXT-QID-LIST .
6373  op fm-help : -> QidList .
6374  eq fm-help
6375    = string2qidList("Additional commands available:") '\n
6376      '\t string2qidList("(load <meta-module> .)") '\n
6377      '\t '\t string2qidList("Takes as argument a term of sort Module,") '\s string2qidList("i.e.,") '\s string2qidList("a metaterm.") '\n
6378      '\t '`( 'remove 'identity 'attributes '\s '`[ '<module-expr.> '`] '\s  '. '`) '\s  '| '\s '`( 'rm 'ids '\s '`[ '<module-expr.> '`] '\s  '. '`) '\n
6379      '\t '\t string2qidList("Shows the module with the id attributes removed using a variant-based transformation.") '\n
6380      '\t string2qidList("(remove assoc attributes") '\s string2qidList("[<module-expr.>]") '\s string2qidList(".)") '\n
6381      '\t '\t string2qidList("Shows the module with the assoc (if not with comm) attributes removed using a variant-based transformation.") '\n
6382      '\t string2qidList("(ax coherence completion") '\s string2qidList("[<module-expr.>]") '\s string2qidList(".)") '\n
6383      '\t '\t string2qidList("Shows the module resulting from completing for coherence for the different combinations of axioms.") '\n .
6384endfm
6385
6386
6387-------------------------------------------------------------------------------
6388*******************************************************************************
6389-------------------------------------------------------------------------------
6390
6391*** 3.2 View Expressions and Extended Sorts
6392
6393*** To allow the use of parameterized sorts, or sorts qualified by the view
6394*** expression with which the parameterized module in which the given sorts
6395*** appear is instantiated, we add the sort Sort of ``extended sorts'' as a
6396*** supersort of the predefined sort Sort.  View expressions and extended
6397*** sorts are introduced in the following modules.
6398
6399*** 3.2.1 View Expressions
6400
6401*** A view expression is given by a single quoted identifier, by a sequence of
6402*** view expressions (at the user level, separated by commas), or by the
6403*** composition of view expressions. In the current version, the composition
6404*** of view expressions is only used internally; we plan to make it available
6405*** to the user with syntax \verb~_;_~ in the future. View expressions are
6406*** used in the instantiation of parameterized modules and in parameterized
6407*** sorts.  We plan to support parameterized views in the future as well. We
6408*** use operators \verb~_|_~ and \verb~_;;_~ to represent, respectively,
6409*** sequences and composition of view expressions.
6410
6411-------------------------------------------------------------------------------
6412*******************************************************************************
6413-------------------------------------------------------------------------------
6414
6415fmod VIEW-EXPR is
6416  pr META-MODULE .
6417
6418  sort ViewExp .
6419  subsorts Sort < ViewExp < ModuleExpression NeParameterList .
6420
6421  op mtViewExp : -> ViewExp .
6422  op _{_} : Sort ParameterList -> ViewExp [ctor prec 37].
6423  op _;;_ : ViewExp ViewExp -> ViewExp
6424       [assoc id: mtViewExp] .                       *** view composition  _;_
6425
6426endfm
6427
6428-------------------------------------------------------------------------------
6429*******************************************************************************
6430-------------------------------------------------------------------------------
6431
6432*** Since the Core Maude engine does not know about view expressions, or, as
6433*** we shall see, about extended sorts, extended module expressions, extended
6434*** modules, and other declarations that we introduce, to be able to use them
6435*** with built-in functions such as \texttt{sameComponent},
6436*** \texttt{leastSort}, \texttt{metaReduce}, etc., we shall have to convert
6437*** them into terms which only use the built-in constructors.  Thus, for
6438*** example, view expressions in sort \texttt{ViewExp} will be converted
6439*** into quoted identifiers of sort \texttt{Qid} by means of function
6440*** \texttt{parameter2Qid}, or, similarly, elements of sorts \texttt{Sort},
6441*** \texttt{SortList}, and \texttt{SortSet} are transformed into elements
6442*** of sorts \texttt{Qid}, \texttt{QidList}, and  \texttt{QidSet},
6443*** respectively, with functions \texttt{eSortToQid} defined  on the
6444*** appropriate sorts.
6445
6446-------------------------------------------------------------------------------
6447*******************************************************************************
6448-------------------------------------------------------------------------------
6449
6450fmod VIEW-EXPR-TO-QID is
6451  pr VIEW-EXPR .
6452  pr EXT-QID-LIST .
6453
6454  op viewExp2Qid : ViewExp -> Qid .
6455  op parameterList2Qid : ParameterList -> Qid .
6456  op viewExp2QidList : ViewExp -> QidList .
6457  op parameterList2QidList : ParameterList -> QidList .
6458
6459  op eMetaPrettyPrint : ViewExp -> QidList .
6460  ceq eMetaPrettyPrint(VE) = viewExp2QidList(VE) if not VE :: TypeList .
6461
6462  var  V : Sort .
6463  var  QI : Qid .
6464  var  QIL : QidList .
6465  var  P : ViewExp .
6466  var  PL : NeParameterList .
6467  vars VE VE' : ViewExp .
6468
6469  eq parameterList2QidList(P) = viewExp2QidList(P) .
6470  ceq parameterList2QidList((P, PL))
6471    = (if QI == '`) then QIL QI '\s else QIL QI fi)
6472      '`, parameterList2QidList(PL)
6473    if QIL QI := viewExp2QidList(P).
6474
6475  eq viewExp2QidList(V{PL})
6476    = (viewExp2QidList(V) '`{ parameterList2QidList(PL) '`}) .
6477  ceq viewExp2QidList(VE ;; VE')
6478    = (viewExp2QidList(VE) '; viewExp2QidList(VE'))
6479    if VE =/= mtViewExp /\ VE' =/= mtViewExp .
6480  eq viewExp2QidList(V) = V .
6481
6482  eq parameterList2Qid(P) = viewExp2Qid(P) .
6483  eq parameterList2Qid((P, PL))
6484    = qid(string(viewExp2Qid(P)) + ", " + string(parameterList2Qid(PL))) .
6485
6486  eq viewExp2Qid(VE) = qidList2Qid(viewExp2QidList(VE)) .
6487endfm
6488
6489-------------------------------------------------------------------------------
6490*******************************************************************************
6491-------------------------------------------------------------------------------
6492
6493***
6494*** Parameterized Sorts
6495***
6496
6497*** In addition to the \texttt{Sort} sort, in the following module
6498*** \texttt{EXT-SORT} we also define sorts \texttt{SortList} and
6499*** \texttt{SortSet}.
6500
6501*** The operator \texttt{eSort} is declared to be a constructor for extended
6502*** sorts.
6503
6504*** As for lists and sTS of quoted identifiers, we declare \verb~__~ and
6505*** \verb~_;_~ as constructors for sorts \texttt{SortList} and
6506*** \texttt{SortList}, and \texttt{SortSet}, respectively.
6507
6508-------------------------------------------------------------------------------
6509*******************************************************************************
6510-------------------------------------------------------------------------------
6511
6512fmod EXT-SORT is
6513---  pr META-LEVEL + PRE-VARIANT .
6514  pr META-LEVEL .
6515  pr EXT-BOOL .
6516  pr VIEW-EXPR-TO-QID .
6517  pr EXT-QID-LIST .
6518  pr TERMSET .
6519
6520*** We define operations extending the built-in functions \texttt{sameKind}
6521*** and \texttt{leastSort}, respectively, to lists of sorts and
6522*** to lists of extended terms. The function \texttt{sameKind} takes
6523*** a module and two lists of extended sorts as arguments, and returns
6524*** \texttt{true} if the $i$-th elements of both lists are in the same
6525*** connected component of sorts. This function will be used, for example, to
6526*** check whether two operators are in the same family of subsort overloaded
6527*** operators. \texttt{leastSort} returns a list of sorts where the $i$-th
6528*** element of the list is the least sort, computed by the homonymous built-in
6529*** function, of the $i$-th term in the list of terms given as argument.
6530*** Moreover, we define a function \verb~_in_~ to check whether an
6531*** extended sort is in a given set of extended sorts.  Note that before
6532*** calling the built-in function \texttt{sameComponent}, extended sorts of
6533*** sort \texttt{Sort} have to be `desugared' into sorts of sort
6534*** \texttt{Sort} as defined in the predefined \texttt{META-LEVEL} module.
6535*** This conversion is done by the \texttt{eTypeToType} function. Basically,
6536*** user-defined sorts are converted into quoted identifiers by concatenating
6537*** the list of identifiers composing the name of the sort. For example, sorts
6538*** \texttt{'Nat} and \texttt{'List['Nat]} are converted, respectively, into
6539*** \texttt{'Nat} and \texttt{'List`[Nat`]}. Error
6540*** sorts~\cite{ClavelDuranEkerLincolnMarti-OlietMeseguerQuesada99} are left
6541*** as such.
6542
6543  vars Tp Tp' Tp'' Tp''' : Type .
6544  vars TpL TpL' : TypeList .
6545  var  M : Module .
6546
6547  op sameKind : Module TypeList TypeList -> Bool [ditto] .
6548  eq sameKind(M, (Tp Tp' TpL), (Tp'' Tp''' TpL'))
6549    = sameKind(M, Tp, Tp'')
6550      and-then sameKind(M, Tp' TpL, Tp''' TpL') .
6551  eq sameKind(M, nil, nil) = true .
6552  eq sameKind(M, TpL, TpL') = false [owise] .
6553
6554  eq sameKind(M, cc(S:Sort ; SS:SortSet), Tp)
6555    = sameKind(M, S:Sort, Tp) .
6556  eq sameKind(M, Tp, cc(S:Sort ; SS:SortSet))
6557    = sameKind(M, Tp, S:Sort) .
6558  eq sameKind(M, cc(S:Sort ; SS:SortSet), cc(S':Sort ; SS':SortSet))
6559    = sameKind(M, S:Sort, S':Sort) .
6560
6561  op sameKindAll : Module Type TypeList -> Bool .
6562  eq sameKindAll(M, Tp, Tp' TpL) = sameKind(M, Tp, Tp') and-then sameKindAll(M, Tp, TpL) .
6563  eq sameKindAll(M, Tp, nil) = true .
6564
6565  op eLeastSort : Module TermList ~> TypeList .
6566  eq eLeastSort(M, (T:Term, TL:TermList))
6567    = (leastSort(M, T:Term) eLeastSort(M, TL:TermList)) .
6568  eq eLeastSort(M, empty) = nil .
6569  eq eLeastSort(M, qidError(QIL)) = qidError(QIL) .
6570
6571  op eLeastSort : Module TermSet ~> TypeSet .
6572  eq eLeastSort(M, (T:Term | TS:TermSet))
6573    = (leastSort(M, T:Term) ; eLeastSort(M, TS:TermSet)) .
6574  eq eLeastSort(M, emptyTermSet) = none .
6575  eq eLeastSort(M, qidError(QIL)) = qidError(QIL) .
6576
6577  op qidError : QidList -> [Sort] .
6578  op stringError : QidList -> [String] .
6579  eq string(qidError(QIL)) = stringError(QIL) .
6580  eq qid(stringError(QIL)) = qidError(QIL) .
6581  eq stringError(QIL) + St:String = stringError(QIL) .
6582
6583  op getMsg : [Sort] -> QidList .
6584  eq getMsg(qidError(QIL:QidList)) = QIL:QidList .
6585
6586  op kind : TypeList -> Type .
6587
6588  eq kind(S:Sort TL:TypeList)
6589    = qid("[" + string(S:Sort) + "]") kind(TL:TypeList) .
6590  eq kind(K:Kind TL:TypeList) = K:Kind kind(TL:TypeList) .
6591  eq kind(nil) = nil .
6592
6593  op kind : SortSet -> Type .
6594  eq kind(S:Sort ; SS:SortSet) = qid("[" + string(S:Sort) + "]") .
6595
6596  op cc : SortSet -> Type .
6597
6598  op getSort : Kind -> Sort .
6599  eq getSort(K:Kind)
6600    = if findOut(string(K:Kind), "`,", "{", "}", 0) == notFound
6601      then qid(substr(string(K:Kind),
6602                      2,
6603                      sd(length(string(K:Kind)), 4)))
6604      else qid(substr(string(K:Kind),
6605                      2,
6606                      sd(findOut(string(K:Kind), "`,", "{", "}", 0), 2)))
6607      fi .
6608
6609  op getSorts : Kind -> SortSet .
6610  eq getSorts(K:Kind)
6611    = if findOut(string(K:Kind), "`,", "{", "}", 0) == notFound
6612      then qid(substr(string(K:Kind),
6613                      2,
6614                      sd(length(string(K:Kind)), 4)))
6615      else qid(substr(string(K:Kind),
6616                      2,
6617                      sd(findOut(string(K:Kind), "`,", "{", "}", 0), 2)))
6618           ;
6619           getSorts(qid("[" + substr(string(K:Kind),
6620                                     sd(findOut(string(K:Kind), "`,", "{", "}", 0), 1),
6621                                     length(string(K:Kind)))))
6622      fi .
6623
6624----  op qid2Sort : Sort -> Sort .
6625----  eq qid2Sort(S:Sort) = getName{S:Sort} { getPars(S:Sort) } .
6626
6627  ---- name of a sort (the name of S{P1, ..., Pn} is S)
6628  op getName : Sort -> Qid .
6629  eq getName(S:Sort)
6630    = if findOpening(string(S:Sort), "{", "}", sd(length(string(S:Sort)), 2))
6631           == notFound
6632      then S:Sort
6633      else qid(substr(string(S:Sort),
6634                      0,
6635                      findOpening(string(S:Sort),
6636                        "{", "}",
6637                        sd(length(string(S:Sort)), 2))))
6638      fi .
6639
6640  ---- parameters of a sort (the parameters of S{P1, ..., Pn} are P1 ... Pn)
6641  op getPars : Sort -> ParameterList [memo] .
6642  op getParsAux : String Nat Nat -> ParameterList .
6643
6644  eq getPars(S:Sort)
6645    = if findOpening(string(S:Sort), "{", "}", sd(length(string(S:Sort)), 2))
6646           == notFound
6647      then empty
6648      else getParsAux(string(S:Sort),
6649             findOpening(string(S:Sort),
6650               "{", "}", sd(length(string(S:Sort)), 2)) + 1,
6651             length(string(S:Sort)))
6652      fi .
6653
6654  var  St Pattern OpenPar ClosingPar : String .
6655  vars L R N OpenPars ClosingPars : Nat .
6656
6657  eq getParsAux(St, L, R)
6658    = if findOut(St, ",", "{", "}", L) == notFound
6659      then qid(substr(St, L, sd(findClosing(St, "{", "}", L), L)))
6660      else (qid(substr(St, L, sd(findOut(St, ",", "{", "}", L), L))),
6661            getParsAux(St, findOut(St, ",", "{", "}", L) + 1, R))
6662      fi .
6663
6664  ---- finds a pattern out of balanced parentheses
6665  ---- findOut("S{P1, P2{P21, P22}, P3}", ",", "{", "}", 6) returns 18, not 12
6666  op findOut : String String String String Nat -> FindResult .
6667  op findOut : String String String String Nat Nat -> FindResult .
6668
6669  eq findOut(St, Pattern, OpenPar, ClosingPar, N)
6670    = findOut(St, Pattern, OpenPar, ClosingPar, 0, N) .
6671
6672  eq findOut(St, Pattern, OpenPar, ClosingPar, OpenPars, N)
6673    = if N >= length(St)
6674      then notFound
6675      else if OpenPars == 0 and-then substr(St, N, length(Pattern)) == Pattern
6676           then N
6677           else if substr(St, N, length(OpenPar)) == OpenPar
6678                then findOut(St, Pattern, OpenPar, ClosingPar,
6679                       OpenPars + 1, N + 1)
6680                else if substr(St, N, length(ClosingPar)) == ClosingPar
6681                     then findOut(St, Pattern, OpenPar, ClosingPar,
6682                            sd(OpenPars, 1), N + 1)
6683                     else findOut(St, Pattern, OpenPar, ClosingPar,
6684                            OpenPars, N + 1)
6685                     fi
6686                fi
6687           fi
6688      fi .
6689
6690  ---- finds the first closing unbalanced parenthesis
6691  ---- findOut("P1, P2{P21, P22}, P3}", "{", "}", 6) returns 21, not 16
6692  op findClosing : String String String Nat -> FindResult .
6693  op findClosing : String String String Nat Nat -> FindResult .
6694
6695  eq findClosing(St, OpenPar, ClosingPar, N)
6696    = findClosing(St, OpenPar, ClosingPar, 0, N) .
6697
6698  eq findClosing(St, OpenPar, ClosingPar, OpenPars, N)
6699    = if N >= length(St)
6700      then notFound
6701      else if OpenPars == 0
6702              and-then substr(St, N, length(ClosingPar)) == ClosingPar
6703           then N
6704           else if substr(St, N, length(OpenPar)) == OpenPar
6705                then findClosing(St, OpenPar, ClosingPar,
6706                       OpenPars + 1, N + 1)
6707                else if substr(St, N, length(ClosingPar)) == ClosingPar
6708                     then findClosing(St, OpenPar, ClosingPar,
6709                            sd(OpenPars, 1), N + 1)
6710                     else findClosing(St, OpenPar, ClosingPar,
6711                            OpenPars, N + 1)
6712                     fi
6713                fi
6714           fi
6715      fi .
6716
6717  ---- finds the last opening unbalanced parenthesis
6718  ---- findOpening("S{P1, P2{P21, P22}, P3}", "{", "}", 21) returns 1, not 8
6719  op findOpening : String String String Nat -> FindResult .
6720  op findOpening : String String String Nat Nat -> FindResult .
6721
6722  eq findOpening(St, OpenPar, ClosingPar, N)
6723    = findOpening(St, OpenPar, ClosingPar, 0, N) .
6724
6725  eq findOpening(St, OpenPar, ClosingPar, ClosingPars, N)
6726    = if N == 0
6727      then notFound
6728      else if ClosingPars == 0
6729              and-then substr(St, N, length(ClosingPar)) == OpenPar
6730           then N
6731           else if substr(St, N, length(OpenPar)) == ClosingPar
6732                then findOpening(St, OpenPar, ClosingPar,
6733                       ClosingPars + 1, sd(N, 1))
6734                else if substr(St, N, length(ClosingPar)) == OpenPar
6735                     then findOpening(St, OpenPar, ClosingPar,
6736                            sd(ClosingPars, 1), sd(N, 1))
6737                     else findOpening(St, OpenPar, ClosingPar,
6738                            ClosingPars, sd(N, 1))
6739                     fi
6740                fi
6741           fi
6742      fi .
6743
6744  op makeSort : Sort ParameterList -> Sort .
6745  op makeSort : Sort ParameterList ParameterList ParameterList -> Sort .
6746  op makeSort2 : Sort ParameterList -> Sort .
6747  op makePars : ParameterList -> String .
6748
6749  vars S P : Sort .
6750  vars PL PL' PL'' PL3 : ParameterList .
6751  var  VE : ViewExp .
6752  var  QIL : QidList .
6753  var  K : Kind .
6754
6755  eq makeSort(S, PL)
6756    = if PL == empty
6757      then S
6758      else makeSort(S, PL, empty, empty)
6759      fi .
6760
6761  ----eq makeSort(S, P, PL, PL') = makeSort(S, empty, (PL, P), PL') .
6762  eq makeSort(S, (P, PL), PL', PL'') = makeSort(S, PL, (PL', P), PL'') .
6763  eq makeSort(S, (P{PL}, PL'), PL'', PL3)
6764    = makeSort(S, PL', (PL'', makeSort(P, PL)), PL3) .
6765  ----eq makeSort(S, (P ;; VE), PL, PL')
6766  ----  = makeSort(S, empty, (PL, P), (PL', VE))
6767  ----  [owise] .
6768  eq makeSort(S, ((P ;; VE), PL), PL', PL'')
6769    = makeSort(S, PL, (PL', P), (PL'', VE))
6770    [owise] .
6771  eq makeSort(S, empty, PL, PL')
6772    = if PL' == empty
6773      then makeSort2(S, PL)
6774      else makeSort(makeSort2(S, PL), PL')
6775      fi .
6776
6777  eq makeSort2(S, empty) = S:Sort .
6778  eq makeSort2(S, P) = qid(string(S) + "{" + string(P) + "}") .
6779  eq makeSort2(S, (P, PL))
6780    = qid(string(S) + "{" + string(P) + makePars(PL))
6781    [owise] .
6782
6783  eq makePars((P, PL)) = "," + string(P) + makePars(PL) .
6784  eq makePars(P) = "," + string(P) + "}" .
6785  eq makePars(empty) = "}" .
6786
6787  op list2set : TypeList -> TypeSet .
6788  eq list2set(Tp TpL) = Tp ; list2set(TpL) .
6789  eq list2set(nil) = none .
6790
6791  op type2qid : Type -> Qid .
6792  eq type2qid(S)
6793    = if getPars(S) == empty
6794      then S
6795      else qid(string(getName(S)) + "{" + string(qidList2Qid(parameterList2QidList(getPars(S)))) + "}")
6796      fi .
6797  eq type2qid(K) = qid("[" + string(type2qid(getSort(K))) + "]") .
6798
6799  op size : TypeList -> Nat .
6800  eq size(Tp TpL) = 1 + size(TpL) .
6801  eq size((nil).TypeList) = 0 .
6802endfm
6803
6804-------------------------------------------------------------------------------
6805*******************************************************************************
6806-------------------------------------------------------------------------------
6807
6808fmod DEFAULT-VALUE{X :: TRIV} is
6809  sort Default{X} .
6810  subsort X$Elt < Default{X} .
6811  op null : -> Default{X} .
6812endfm
6813
6814view Term from TRIV to META-TERM is
6815  sort Elt to Term .
6816endv
6817
6818-------------------------------------------------------------------------------
6819*******************************************************************************
6820-------------------------------------------------------------------------------
6821
6822***
6823*** Extended Declarations
6824***
6825
6826*** In this section we discuss modules \texttt{EXT-DECL} and \texttt{O-O-DECL}
6827*** which introduce, respectively, the declarations extending the sorts and
6828*** constructors for declarations of the predefined data type \texttt{Module}
6829*** in the \texttt{META-LEVEL} module to allow the use of extended sorts in
6830*** them, and the declarations appearing in object-oriented units, namely
6831*** class declarations, subclass relation declarations, and message
6832*** declarations.
6833
6834***
6835*** Declarations of Functional and System Modules
6836***
6837
6838*** In the following module \texttt{EXT-DECL}, we introduce the declarations
6839*** extending those in \texttt{META-LEVEL} to allow the use of extended sorts
6840*** in declarations of sorts, subsort relations, operators, variables, and
6841*** membership axioms.
6842
6843*** \begin{comment}
6844*** \footnote{In the future, the declarations for operators,
6845*** membership axioms, equations, and rules will be extended to allow
6846*** the use of extended sorts in sort tests, that is, terms of the
6847*** form \mbox{\verb~T : S~} and \mbox{\verb~T :: S~}.}
6848*** \end{comment}
6849
6850*** The extension is accomplished by adding new supersorts for each of the
6851*** sorts in \texttt{META-LEVEL} involved, and by adding new constructors for
6852*** these new sorts.
6853
6854*** We start introducing the declarations for the supersorts and their
6855*** corresponding constructors. The \texttt{EXT-DECL} module also contains the
6856*** declarations for sTS of such declarations.
6857
6858-------------------------------------------------------------------------------
6859*******************************************************************************
6860-------------------------------------------------------------------------------
6861
6862fmod INT-LIST is
6863  pr META-MODULE .
6864  pr INT .
6865  sort IntList .
6866  subsort Int NatList < IntList .
6867  op __ : IntList IntList -> IntList [ctor ditto] .
6868
6869  op numberError : QidList -> [Nat] .
6870
6871  vars N M : Nat .
6872
6873  op from_to_list : Nat Nat ~> NatList .
6874  ceq from N to M list
6875    = if N == M
6876      then N
6877      else N from N + 1 to M list
6878      fi
6879    if N <= M .
6880endfm
6881
6882-------------------------------------------------------------------------------
6883*******************************************************************************
6884-------------------------------------------------------------------------------
6885
6886fmod EXT-DECL is
6887  pr EXT-SORT .
6888  pr INT-LIST .
6889
6890  var  QI : Qid .
6891  vars QIL QIL' : QidList .
6892  var  At : Attr .
6893  var  AtS : AttrSet .
6894  var  OPD OPD' : OpDecl .
6895  var  OPDS : OpDeclSet .
6896  vars LHS RHS T T' : Term .
6897  var  S : Sort .
6898  var  Cond : Condition .
6899  var  EqS : EquationSet .
6900  var  RlS : RuleSet .
6901  var  MbS : MembAxSet .
6902  var  M : Module .
6903
6904  op variant : -> Attr [ctor] .
6905
6906*** subsort declarations error
6907  op subsortDeclError : QidList -> [SubsortDeclSet] [ctor format (r o)] .
6908  eq subsortDeclError(QIL) subsortDeclError(QIL')
6909    = subsortDeclError(QIL QIL') .
6910
6911*** extended attribute declarations
6912  op strat : IntList -> Attr [ditto] .   *** to handle on-demand strategies
6913  op ditto : -> Attr [ctor] .
6914
6915  op _in_ : Attr AttrSet -> Bool .
6916  eq At in At AtS = true .
6917  eq At in AtS = false [owise] .
6918
6919*** extended operation declarations
6920  op opDeclError : QidList -> [OpDeclSet] [ctor format (r o)] .
6921  eq opDeclError(QIL) opDeclError(QIL') = opDeclError(QIL QIL') .
6922
6923*** extended membership axioms
6924  op membAxError : QidList -> [MembAxSet] [ctor format (r o)] .
6925  eq membAxError(QIL) membAxError(QIL') = membAxError(QIL QIL') .
6926
6927*** extended equations
6928  op equationError : QidList -> [EquationSet] [ctor format (r o)] .
6929  eq equationError(QIL) equationError(QIL') = equationError(QIL QIL') .
6930
6931*** extended rules
6932  op ruleError : QidList -> [RuleSet] [ctor format (r o)] .
6933  eq ruleError(QIL) ruleError(QIL') = ruleError(QIL QIL') .
6934
6935*** The function \verb~_in_~ checks whether a given operator
6936*** declaration is in a set of operator declarations.
6937
6938  op _in_ : OpDecl OpDeclSet -> Bool .
6939
6940  eq OPD in (OPD OPDS) = true .
6941  eq OPD in OPDS = false [owise] .
6942
6943  ops lhs rhs : Rule -> Term .
6944  op cond : Rule -> Condition .
6945  op atts : Rule -> AttrSet .
6946  op label : Rule -> [Qid] .
6947  eq lhs(rl LHS => RHS [AtS] .) = LHS .
6948  eq lhs(crl LHS => RHS if Cond [AtS] .) = LHS .
6949  eq rhs(rl LHS => RHS [AtS] .) = RHS .
6950  eq rhs(crl LHS => RHS if Cond [AtS] .) = RHS .
6951  eq cond(rl LHS => RHS [AtS] .) = nil .
6952  eq cond(crl LHS => RHS if Cond [AtS] .) = Cond .
6953  eq atts(rl LHS => RHS [AtS] .) = AtS .
6954  eq atts(crl LHS => RHS if Cond [AtS] .) = AtS .
6955  eq label(rl LHS => RHS [label(QI) AtS] .) = QI .
6956  eq label(crl LHS => RHS if Cond [label(QI) AtS] .) = QI .
6957
6958  ops lhs rhs : Equation -> Term .
6959  op cond : Equation -> Condition .
6960  op atts : Equation -> AttrSet .
6961  op label : Equation -> [Qid] .
6962  eq lhs(eq LHS = RHS [AtS] .) = LHS .
6963  eq lhs(ceq LHS = RHS if Cond [AtS] .) = LHS .
6964  eq rhs(eq LHS = RHS [AtS] .) = RHS .
6965  eq rhs(ceq LHS = RHS if Cond [AtS] .) = RHS .
6966  eq cond(eq LHS = RHS [AtS] .) = nil .
6967  eq cond(ceq LHS = RHS if Cond [AtS] .) = Cond .
6968  eq atts(eq LHS = RHS [AtS] .) = AtS .
6969  eq atts(ceq LHS = RHS if Cond [AtS] .) = AtS .
6970  eq label(eq LHS = RHS [label(QI) AtS] .) = QI .
6971  eq label(ceq LHS = RHS if Cond [label(QI) AtS] .) = QI .
6972
6973  op cond : MembAx -> Condition .
6974  op atts : MembAx -> AttrSet .
6975  eq cond(mb T : S [AtS] .) = nil .
6976  eq cond(cmb T : S if Cond [AtS] .) = Cond .
6977  eq atts(mb T : S [AtS] .) = AtS .
6978  eq atts(cmb T : S if Cond [AtS] .) = AtS .
6979
6980  op rulify : EquationSet -> RuleSet .
6981  ---- takes a set of equations and turn them into rules
6982  eq rulify(eq LHS = RHS [AtS] . EqS) = (rl LHS => RHS [AtS] .) rulify(EqS) .
6983  eq rulify(ceq LHS = RHS if Cond [AtS] . EqS) = (crl LHS => RHS if Cond [AtS] .) rulify(EqS) .
6984  eq rulify((none).EquationSet) = none .
6985endfm
6986
6987**** The module EXT-TERM extends META-LEVEL with definitions of several
6988**** operations that manipulate terms: definitions for positions and operations
6989**** to get the subterm of a given term at a given position, to replace the
6990**** subterm of a term at a given position by another term, to get all the
6991**** nonvariable positions in a term, to apply a substitution to a term, and to
6992**** get a copy of a term in which all the variables in it have been renamed.
6993
6994fmod EXT-TERM is
6995---  pr META-LEVEL + PRE-VARIANT .
6996  pr META-LEVEL .
6997  pr EXT-BOOL .
6998  pr EXT-DECL .
6999
7000  vars T T' : Term .
7001  vars F X : Qid .
7002  var  TL : TermList .
7003  var  N : Nat .
7004  vars NL NL' : NatList .
7005  vars V V' W : Variable .
7006  var  Subst : Substitution .
7007  vars C Ct : Constant .
7008  var  NTL : NeTermList .
7009  var  M : Module .
7010  var  Tp : Type .
7011  vars TpL TpL' : TypeList .
7012  vars AtS AtS' : AttrSet .
7013  var  ODS : OpDeclSet .
7014  var  Cd : Condition .
7015  var  S : Sort .
7016
7017  **** vars returns the set of variables in a term
7018  op vars : Term -> QidSet .
7019  op vars : TermList -> QidSet .
7020
7021  eq vars(V) = V .
7022  eq vars(C) = none .
7023  eq vars(F[TL]) = vars(TL) .
7024  eq vars(empty) = none .
7025  eq vars((T, TL)) = vars(T) ; vars(TL) .
7026
7027  **** varlist returns the list of variables in a term
7028  op varlist : Term -> QidList .
7029  op varlist : TermList -> QidList .
7030
7031  eq varlist(V) = V .
7032  eq varlist(C) = nil .
7033  eq varlist(F[TL]) = varlist(TL) .
7034  eq varlist(empty) = nil .
7035  eq varlist((T, TL)) = varlist(T) varlist(TL) .
7036
7037  **** occurs? checks whether a variable name occurs in a term or not.
7038  op occurs? : Variable Term -> Bool .
7039  op occurs? : Variable TermList -> Bool .
7040  eq occurs?(V, V') = V == V' .
7041  eq occurs?(V, C) = false .
7042  eq occurs?(V, F[TL]) = occurs?(V, TL) .
7043  eq occurs?(V, (T, TL)) = occurs?(V, T) or-else  occurs?(V, TL) .
7044
7045  **** occurrences checks whether a variable name occurs in a term or not.
7046  op occurrences : Variable Term -> Nat .
7047  op occurrences : Variable TermList -> Nat .
7048  eq occurrences(V, V') = if V == V' then 1 else 0 fi .
7049  eq occurrences(V, C) = 0 .
7050  eq occurrences(V, F[TL]) = occurrences(V, TL) .
7051  eq occurrences(V, (T, TL)) = occurrences(V, T) + occurrences(V, TL) .
7052
7053  op frozen : Module Term Nat -> Bool .
7054  op frozen : Module OpDeclSet Qid TypeList Nat -> Bool .
7055  eq frozen(M, F[TL], N)
7056    = frozen(M, getOps(M), F, eLeastSort(M, TL), N) .
7057
7058  ceq frozen(M, op F : TpL -> Tp [AtS] . ODS, F, TpL', N)
7059    = true
7060    if sameKind(M, TpL, TpL')
7061       /\ not ctor(M, op F : TpL -> Tp [AtS] . ODS, F, TpL') .
7062  ceq frozen(M, op F : TpL -> Tp [AtS] . ODS, F, TpL', N)
7063    = true
7064    if sameKind(M, TpL, TpL')
7065       /\ ctor(M, op F : TpL -> Tp [AtS] . ODS, F, TpL')
7066       /\ frozen(NL N NL') AtS' := AtS .
7067  eq frozen(M, ODS, F, TpL, N) = false [owise] .
7068
7069  ---- ctor check whether the operator at the top is a constructor
7070  ---- in any of its overloadings
7071  op ctor : Module OpDeclSet Term -> Bool .
7072  op ctor : Module OpDeclSet Qid TypeList -> Bool .
7073
7074  eq ctor(M, ODS, Ct) = ctor(M, ODS, Ct, nil) .
7075  eq ctor(M, ODS, F[TL]) = ctor(M, ODS, F, eLeastSort(M, TL)) .
7076  eq ctor(M, ODS, T) = false [owise] .
7077
7078  ceq ctor(M, op F : TpL -> Tp [AtS] . ODS, F, TpL')
7079    = ctor in AtS or-else ctor(M, ODS, F, TpL')
7080    if sameKind(M, TpL, TpL') .
7081  eq ctor(M, ODS, F, TpL) = false [owise] .
7082
7083**** The function \texttt{substitute} takes a term $t$ and a substitution
7084**** $\sigma$ and returns the term $t\sigma$.
7085
7086  op substitute : Module Term Substitution -> Term .
7087  op substitute : Module TermList Substitution -> TermList .
7088
7089  eq substitute(M, T, none) = T .
7090  eq substitute(M, V, ((W <- T) ; Subst))
7091    = if getName(V) == getName(W) and-then sameKind(M, getType(V), getType(W))
7092      then T
7093      else substitute(M, V, Subst)
7094      fi .
7095  eq substitute(M, C, ((W <- T); Subst)) = C .
7096  eq substitute(M, F[TL], Subst) = F[substitute(M, TL, Subst)] .
7097  eq substitute(M, (T, TL), Subst)
7098    = (substitute(M, T, Subst), substitute(M, TL, Subst)) .
7099
7100  op substitute : Module EqCondition Substitution -> EqCondition .
7101  eq substitute(M, T = T' /\ Cd, Subst)
7102    = substitute(M, T, Subst) = substitute(M, T', Subst) /\ substitute(M, Cd, Subst) .
7103  eq substitute(M, T := T' /\ Cd, Subst)
7104    = substitute(M, T, Subst) := substitute(M, T', Subst) /\ substitute(M, Cd, Subst) .
7105  eq substitute(M, T : S /\ Cd, Subst)
7106    = substitute(M, T, Subst) : S /\ substitute(M, Cd, Subst) .
7107  eq substitute(M, (nil).EqCondition, Subst) = nil .
7108endfm
7109
7110***(
7111red substitute('f['X:Foo, 'g['Y:Foo, 'Z:Foo]], ('Y:Foo <- 'h['W:Foo])) .
7112red rename('f['X:Foo, 'g['Y:Foo, 'Z:Foo]]) .
7113red allNonVarPos(
7114      substitute('f['X:Foo, 'g['Y:Foo, 'Z:Foo]], ('Y:Foo <- 'h['W:Foo]))) .
7115)
7116
7117-------------------------------------------------------------------------------
7118*******************************************************************************
7119-------------------------------------------------------------------------------
7120
7121***
7122*** Declarations for Object-Oriented Modules
7123***
7124
7125*** In the \texttt{O-O-DECL} module we introduce the sorts and constructors
7126*** for declarations of classes, subclass relations, and messages in
7127*** object-oriented units.
7128
7129*** Note that we follow the same naming conventions for classes as for
7130*** extended sorts (see Section~\ref{parameterized-modules}), and therefore
7131*** we use the sort \texttt{Sort} for class identifiers, and
7132*** \texttt{TypeList} and \texttt{SortSet} for lists and sTS of class
7133*** identifiers, respectively.  We use the operator \verb~attr_:_~ as a
7134*** constructor for declarations of attributes. Since the operator name
7135*** \texttt{\_\,:\_\,} is used for sort  tests in the \texttt{META-LEVEL}
7136*** module, we use \texttt{attr\_\,:\_\,} as  constructor for declarations of
7137*** attributes to satisfy the preregularity  condition.
7138
7139-------------------------------------------------------------------------------
7140*******************************************************************************
7141-------------------------------------------------------------------------------
7142
7143fmod O-O-DECL is
7144  pr EXT-SORT .
7145
7146  vars QIL QIL' : QidList .
7147
7148  sorts AttrDecl AttrDeclSet .
7149  subsort AttrDecl < AttrDeclSet .
7150  op attr_:_ : Qid Sort -> AttrDecl .
7151  op none : -> AttrDeclSet .
7152  op _`,_ : AttrDeclSet AttrDeclSet -> AttrDeclSet [assoc comm id: none] .
7153
7154  eq AD:AttrDecl, AD:AttrDecl = AD:AttrDecl .
7155
7156  sorts ClassDecl ClassDeclSet .
7157  subsort ClassDecl < ClassDeclSet .
7158  op class_|_. : Sort AttrDeclSet -> ClassDecl .
7159  op none : -> ClassDeclSet .
7160  op __ : ClassDeclSet ClassDeclSet -> ClassDeclSet [assoc comm id: none] .
7161
7162  op classDeclError : QidList -> [ClassDeclSet] [ctor format (r o)] .
7163  eq classDeclError(QIL) classDeclError(QIL') = classDeclError(QIL QIL') .
7164
7165  eq CD:ClassDecl CD:ClassDecl = CD:ClassDecl .
7166
7167  sorts SubclassDecl SubclassDeclSet .
7168  subsort SubclassDecl < SubclassDeclSet .
7169  op subclass_<_. : Sort Sort -> SubclassDecl .
7170  op none : -> SubclassDeclSet .
7171  op __ : SubclassDeclSet SubclassDeclSet -> SubclassDeclSet
7172     [assoc comm id: none] .
7173
7174  eq SCD:SubclassDecl SCD:SubclassDecl = SCD:SubclassDecl .
7175
7176  op subclassDeclError : QidList -> [SubclassDeclSet] [ctor format (r o)] .
7177  eq subclassDeclError(QIL) subclassDeclError(QIL')
7178    = subclassDeclError(QIL QIL') .
7179
7180  sorts MsgDecl MsgDeclSet .
7181  subsort MsgDecl < MsgDeclSet .
7182  op msg_:_->_. : Qid TypeList Sort -> MsgDecl .
7183  op none : -> MsgDeclSet .
7184  op __ : MsgDeclSet MsgDeclSet -> MsgDeclSet [assoc comm id: none] .
7185
7186  eq MD:MsgDecl MD:MsgDecl = MD:MsgDecl .
7187
7188  op msgDeclError : QidList -> [MsgDeclSet] [ctor format (r o)] .
7189  eq msgDeclError(QIL) msgDeclError(QIL') = msgDeclError(QIL QIL') .
7190
7191*** The function \texttt{classSet} returns the set of class identifiers in
7192*** the set of class declarations given as argument.
7193
7194  op classSet : ClassDeclSet -> SortSet .
7195
7196  eq classSet((class S:Sort | ADS:AttrDeclSet .) CDS:ClassDeclSet)
7197    = (S:Sort ; classSet(CDS:ClassDeclSet)) .
7198  eq classSet(none) = none .
7199endfm
7200
7201-------------------------------------------------------------------------------
7202*******************************************************************************
7203-------------------------------------------------------------------------------
7204
7205***
7206*** Renaming Maps
7207***
7208
7209*** We introduce the different types of renaming maps in the module
7210*** \texttt{FMAP} below. A sort is introduced for each of these types of maps,
7211*** with the appropriate constructors for each sort (see
7212*** Section~\ref{module-expressions}). All these sorts are declared to be
7213*** subsorts of the sort \texttt{Map}. A sort for sTS of
7214*** maps (\texttt{RenamingSet}) is then declared as supersort of \texttt{Map}
7215*** with constructors \texttt{none} and \verb~_,_~.
7216
7217-------------------------------------------------------------------------------
7218*******************************************************************************
7219-------------------------------------------------------------------------------
7220
7221fmod FMAP is
7222  inc META-MODULE .
7223  pr EXT-SORT .
7224
7225  *** renamings
7226  op class_to_ : Sort Sort -> Renaming .
7227  op attr_._to_ : Qid Sort Qid -> Renaming .
7228  op msg_to_ : Qid Qid -> Renaming .
7229  op msg_:_->_to_ : Qid TypeList Sort Qid -> Renaming .
7230  op op_to term_ : Term Term -> Renaming .
7231
7232  op none : -> RenamingSet .
7233  eq (MAP, MAP) = MAP .
7234  eq (MAPS, none) = MAPS .
7235
7236----  eq attr A . qidError(QIL) to A' = none .
7237
7238*** Given a set of maps, the function \texttt{sortMaps} returns the
7239*** subset of sort maps in it.
7240
7241  var  MAP : Renaming .
7242  var  MAPS : RenamingSet .
7243  vars S S' A A' : Sort .
7244  var  QIL : QidList .
7245
7246  op sortMaps : RenamingSet -> RenamingSet .
7247
7248  eq sortMaps(sort S to S') = sort S to S' .
7249  eq sortMaps(((sort S to S'), MAPS))
7250    = ((sort S to S'), sortMaps(MAPS)) .
7251  eq sortMaps(MAP) = none [owise] .
7252  eq sortMaps((MAP, MAPS)) = sortMaps(MAPS) [owise] .
7253  eq sortMaps(none) = none .
7254endfm
7255
7256-------------------------------------------------------------------------------
7257*******************************************************************************
7258-------------------------------------------------------------------------------
7259
7260***
7261*** Module Expressions and Module Names
7262***
7263
7264*** The abstract syntax for writing specifications in Maude can be seen as
7265*** given by module expressions, where the notion of module expression is
7266*** understood as an expression that defines a new module out of previously
7267*** defined modules by combining and/or modifying them according to a specific
7268*** set of operations.  All module expressions will be evaluated generating
7269*** modules with such module expressions as names. In the case of parameterized
7270*** modules, each of the parameters in an interface will be used as the name
7271*** of a new module created as a renamed copy of the parameter theory.
7272
7273***
7274*** Module Expressions
7275***
7276
7277*** The \texttt{TUPLE} and \texttt{POWER} are declared to be new types of
7278*** \texttt{ModuleExpression}s.
7279
7280-------------------------------------------------------------------------------
7281*******************************************************************************
7282-------------------------------------------------------------------------------
7283
7284fmod MOD-EXPR is
7285  inc META-MODULE .
7286  pr FMAP .
7287
7288  op TUPLE`[_`] : NzNat -> ModuleExpression .
7289  op POWER`[_`] : NzNat -> ModuleExpression .
7290
7291  eq ME:ModuleExpression * ( none ) = ME:ModuleExpression .
7292
7293endfm
7294
7295-------------------------------------------------------------------------------
7296*******************************************************************************
7297-------------------------------------------------------------------------------
7298
7299***
7300*** Module Names
7301***
7302
7303*** As we shall see in the coming sections, the evaluation of module
7304*** expressions may produce the creation of new modules, whose \emph{names}
7305*** are given by the module expressions themselves. If there is already a
7306*** module in the database with the module expression being evaluated as name,
7307*** the evaluation of such module expression does not produce any change in
7308*** the database. However, the evaluation of a module expression may involve
7309*** the evaluation of some other module expressions contained in the modules
7310*** involved, which in turn may generate new modules.
7311
7312*** Given a parameterized module $\texttt{N\{L}_1\texttt{\ ::\ T}_1
7313*** \texttt{\ ,\ }\ldots\texttt{\ ,\ L}_n\texttt{\ ::\ T}_n\texttt{\}}$, with
7314*** $\texttt{L}_1\ldots\texttt{L}_n$ labels and
7315*** $\texttt{T}_1\ldots\texttt{T}_n$ theory identifiers, we say that
7316*** \texttt{N} is the name of the module and that
7317*** $\texttt{\{L}_1\texttt{\ ::\ T}_1\texttt{\ ,\ }
7318*** \ldots\texttt{\ ,\ L}_n\texttt{\ ::\ T}_n\texttt{\}}$
7319*** is its \emph{interface}.
7320*** As we shall see in Sections~\ref{instantiation} and~\ref{unit-processing},
7321*** for each parameter $\texttt{L}_i\texttt{\ ::\ T}_i$ in the interface of a
7322*** module, a new module is generated with such a parameter expression as its
7323*** name, and a declaration importing it in the parameterized module is added.
7324***  We regard the relationship between the body of a parameterized module and
7325*** the parameters in its interface, not as an inclusion, but as mediated by
7326*** a module constructor that generates renamed copies of the parameters,
7327*** which are then included. Therefore, the sort \texttt{ViewExp} is
7328*** declared as a subsort of \texttt{Header}, that is, terms of sort
7329*** \texttt{ViewExp} are considered to be module names. The constructor
7330*** operator for the sort \texttt{ViewExp} is \verb~par_::_~.
7331
7332-------------------------------------------------------------------------------
7333*******************************************************************************
7334-------------------------------------------------------------------------------
7335
7336fmod MOD-NAME is
7337  inc MOD-EXPR .
7338  pr EXT-BOOL .
7339  op parameterError : QidList -> [ParameterDecl] .
7340
7341  sort ModuleName .
7342  subsorts ModuleExpression < ModuleName < Header .
7343  op _{_}  : ModuleExpression ParameterDeclList -> Header .
7344  op pd : ParameterDecl -> ModuleName .
7345  op nullHeader : -> Header .
7346
7347  op getName : Header -> ModuleExpression .
7348  op getParDecls : Header -> ParameterDeclList .
7349
7350  vars QI QI' : Qid .
7351  var  ME : ModuleExpression .
7352  vars PDL PDL' : ParameterDeclList .
7353  var  PL : NeParameterList .
7354  var  MN : ModuleName .
7355
7356  eq getName(ME{PDL}) = ME .
7357  eq getName(MN) = MN .
7358  eq getParDecls(ME{PDL}) = PDL .
7359  eq getParDecls(MN) = nil .
7360
7361  op including_. : ModuleName -> Import [ctor] .
7362  op extending_. : ModuleName -> Import [ctor] .
7363  op protecting_. : ModuleName -> Import [ctor] .
7364
7365  op fth_is_sorts_.____endfth : Header ImportList SortSet SubsortDeclSet
7366    OpDeclSet MembAxSet EquationSet -> FTheory [ctor gather (& & & & & & &)
7367     format (d d d n++i ni d d ni ni ni ni n--i d)] .
7368  op th_is_sorts_._____endth : Header ImportList SortSet SubsortDeclSet
7369    OpDeclSet MembAxSet EquationSet RuleSet -> STheory
7370    [ctor gather (& & & & & & & &)
7371     format (d d d n++i ni d d ni ni ni ni ni n--i d)] .
7372
7373*** The function \texttt{labelInParameterDeclList} checks whether the quoted
7374*** identifier given as first argument is used as a label in the list of
7375*** parameters given as second argument.
7376
7377  op labelInParameterDeclList : Sort ParameterDeclList -> Bool .
7378  eq labelInParameterDeclList(QI, (PDL, (QI :: ME), PDL')) = true .
7379  eq labelInParameterDeclList(QI, PDL) = false [owise] .
7380
7381endfm
7382
7383-------------------------------------------------------------------------------
7384*******************************************************************************
7385-------------------------------------------------------------------------------
7386
7387*** Since the Core Maude engine assumes that module names are identifiers and
7388*** does not know about term-structured module names (such as parameterized
7389*** module interfaces or module expressions), for evaluation purposes we need
7390*** to transform them into quoted identifiers. The functions
7391*** \texttt{header2Qid} and \texttt{header2QidList} in the module
7392*** \texttt{MOD-NAME-TO-QID} below accomplish this transformation. In any
7393*** language extensions, new equations for the function
7394*** \texttt{header2QidList} should be added for each new module expression
7395*** constructor introduced. In Sections~\ref{renaming} and~\ref{instantiation}
7396*** we shall see how the corresponding equalities are added for renaming and
7397*** instantiation expressions, and in Section~\ref{extension} for other new
7398*** module expressions in extensions of Full Maude.
7399
7400-------------------------------------------------------------------------------
7401*******************************************************************************
7402-------------------------------------------------------------------------------
7403
7404fmod MOD-NAME-TO-QID is
7405  pr MOD-NAME .
7406  pr EXT-QID-LIST .
7407
7408  op header2Qid : Header -> Qid .
7409  op header2QidList : Header -> QidList .
7410  op parameterDecl2Qid : ParameterDecl -> Qid .
7411  op parameterDecl2QidList : ParameterDecl -> QidList .
7412  op parameterDeclList2Qid : ParameterDeclList -> Qid .
7413  op parameterDeclList2QidList : ParameterDeclList -> QidList .
7414
7415  vars QI X : Qid .
7416  var  QIL : QidList .
7417  vars ME ME' : ModuleExpression .
7418  var  PDL : ParameterDeclList .
7419  var  PD : ParameterDecl .
7420
7421  eq header2Qid(QI) = QI .
7422  eq header2Qid(nullHeader) = ' .
7423  eq header2Qid(pd(X :: ME)) = qidList2Qid(header2QidList(pd(X :: ME))) .
7424  eq header2QidList(pd(X :: ME)) = X ':: header2QidList(ME) .
7425
7426  eq header2QidList(QI) = QI .
7427  eq header2QidList(nullHeader) = ' .
7428
7429  eq header2Qid((ME { PDL })) = qidList2Qid(header2QidList((ME { PDL }))) .
7430  ceq header2QidList((ME { PDL }))
7431    = (if QI == '\s then QIL else QIL QI fi
7432       '`{ parameterDecl2QidList(PDL) '`} '\s)
7433    if QIL QI := header2QidList(ME) .
7434
7435  eq parameterDecl2Qid(X :: ME) = qidList2Qid(X ':: header2Qid(ME)) .
7436
7437  eq parameterDeclList2Qid(PDL)
7438    = qidList2Qid(parameterDeclList2QidList(PDL)) .
7439
7440  eq parameterDeclList2QidList(X :: ME) = X ':: header2QidList(ME) .
7441  eq parameterDeclList2QidList((X :: ME, PDL))
7442    = parameterDeclList2QidList(X :: ME) '`, parameterDeclList2QidList(PDL)
7443    [owise] .
7444endfm
7445
7446-------------------------------------------------------------------------------
7447*******************************************************************************
7448-------------------------------------------------------------------------------
7449
7450***
7451*** Modules
7452***
7453
7454*** We handle six different types of units: functional, system, and
7455*** object-oriented modules, and functional, system, and object-oriented
7456*** theories.  Modules and theories of any kind are considered to be elements
7457*** in specific subsorts of the sort \texttt{Module}. A constructor
7458*** \texttt{error} is also included to represent incorrect units.
7459*** \texttt{error} has a list of quoted identifiers as argument, which is
7460*** used to report the error. Besides considering functional and system
7461*** theories and object-oriented theories and modules, the declarations
7462*** presented in the following module extend the declarations for sort
7463*** \texttt{Module} in the \texttt{META-LEVEL} module in three different ways:
7464
7465*** \begin{itemize}
7466*** \item the name of a module can be any term of sort \texttt{Header},
7467*** \item parameterized modules are handled, for which a list of
7468***       parameters is added to the constructors of modules,
7469*** \item the importation declaration is extended to module names, and
7470*** \item parameterized sorts are supported.
7471*** \end{itemize}
7472
7473-------------------------------------------------------------------------------
7474*******************************************************************************
7475-------------------------------------------------------------------------------
7476
7477fmod UNIT is
7478  pr EXT-DECL .
7479  pr O-O-DECL .
7480  pr MOD-NAME-TO-QID .
7481---  inc META-LEVEL + PRE-VARIANT .
7482  inc META-LEVEL .
7483
7484  op moduleName : Import -> ModuleName .
7485  eq moduleName(protecting MN .) = MN .
7486  eq moduleName(protecting ME{PL} .) = ME .
7487  eq moduleName(extending MN .) = MN .
7488  eq moduleName(extending ME{PL} .) = ME .
7489  eq moduleName(including MN .) = MN .
7490  eq moduleName(including ME{PL} .) = ME .
7491
7492  op importError : QidList -> [ImportList] [ctor format (r o)] .
7493  eq importError(QIL) importError(QIL') = importError(QIL QIL') .
7494
7495  sorts OModule OTheory .
7496  subsorts SModule < OModule < Module .
7497  subsorts STheory < OTheory < Module .
7498
7499  op noModule : -> Module .   *** Module
7500  op unitError : QidList -> [Module] [ctor format (r o)] .
7501  op getMsg : [Module] -> QidList .
7502  eq getMsg(unitError(QIL)) = QIL .
7503
7504  op omod_is_sorts_.________endom : Header ImportList
7505        SortSet SubsortDeclSet ClassDeclSet SubclassDeclSet OpDeclSet
7506        MsgDeclSet MembAxSet EquationSet RuleSet -> OModule
7507        [ctor
7508         gather (& & & & & & & & & & &)
7509         format (r! o r! n++io ni d d ni ni ni ni ni ni ni ni n--ir! o)] .
7510  op oth_is_sorts_.________endoth : Header ImportList
7511        SortSet SubsortDeclSet ClassDeclSet SubclassDeclSet OpDeclSet
7512        MsgDeclSet MembAxSet EquationSet RuleSet -> OTheory
7513        [ctor
7514         gather (& & & & & & & & & & &)
7515         format (r! o r! n++io ni d d ni ni ni ni ni ni ni ni n--ir! o)] .
7516
7517*** In addition to the constructor operators, the following functions are
7518*** introduced in the \texttt{UNIT} module:
7519*** \begin{itemize}
7520*** \item A function \verb~_in_~ to check whether a given importation
7521***       declaration is in a set of importation declarations or not.
7522
7523  op _in_ : Import ImportList -> Bool .
7524
7525*** \item Selector functions for the different components of a Module.
7526
7527  op getName : Module -> Header .
7528  op getPars : Module -> ParameterDeclList .
7529  op getClasses : Module -> ClassDeclSet .
7530  op getSubclasses : Module -> SubclassDeclSet .
7531  op getMsgs : Module -> MsgDeclSet .
7532
7533*** \item Functions to change the value of each of the components of a Module.
7534
7535  op setName : Module ModuleExpression -> Module .
7536  op setName : Module ParameterDecl -> Module .
7537  op setPars : Module ParameterDeclList -> Module .
7538  op setImports : Module ImportList -> Module .
7539  op setSorts : Module SortSet -> Module .
7540  op setSubsorts : Module SubsortDeclSet -> Module .
7541  op setOps : Module OpDeclSet -> Module .
7542  op setMbs : Module MembAxSet -> Module .
7543  op setEqs : Module EquationSet -> Module .
7544  op setRls : Module RuleSet ~> Module .
7545  op setClasses : Module ClassDeclSet -> Module .
7546  op setSubclasses : Module SubclassDeclSet -> Module .
7547  op setMsgs : Module MsgDeclSet -> Module .
7548
7549*** \item Functions to add new declarations to the set of declarations
7550*** already in a unit.
7551
7552  op addImports : ImportList Module -> Module .
7553  op addSorts : SortSet Module -> Module .
7554  op addSubsorts : [SubsortDeclSet] Module -> Module .
7555  op addOps : [OpDeclSet] Module -> Module .
7556  op addMbs : MembAxSet Module -> Module .
7557  op addEqs : EquationSet Module -> Module .
7558  op addRls : RuleSet Module -> Module .
7559  op addClasses : ClassDeclSet Module -> Module .
7560  op addSubclasses : SubclassDeclSet Module -> Module .
7561  op addMsgs : MsgDeclSet Module -> Module .
7562
7563*** \item There are functions and constants to create empty modules of the
7564***       different types. For example, the function \texttt{emptyFTheory}
7565***       returns an empty functional theory. There is also a
7566***       function \texttt{empty} which takes a module as argument and returns
7567***       an empty module of the same type.
7568
7569  op emptyFModule : Header -> FModule .
7570  op emptyFModule : -> FModule .
7571  op emptySModule : -> SModule .
7572  op emptyOModule : -> OModule .
7573  op emptyFTheory : -> FModule .
7574  op emptySTheory : -> SModule .
7575  op emptyOTheory : -> OModule .
7576  op empty : Module -> Module .
7577
7578*** \item A function \texttt{addDecls} which returns the module resulting from
7579***       adding all the declarations in the module passed as second argument
7580***       to the module passed as first argument.
7581
7582  op addDecls : Module Module -> Module .
7583
7584*** \end{itemize}
7585
7586*** Note that some of the `set' and `add' functions are partial functions.
7587
7588  vars M M' M'' : Module .
7589  vars QI V : Qid .
7590  var  S : Sort .
7591  vars SSDS SSDS' SSDS'' : SubsortDeclSet .
7592  vars OPD OPD' : OpDecl .
7593  vars OPDS OPDS' : OpDeclSet .
7594  var  OPDS? : [OpDeclSet] .
7595  var  At : Attr .
7596  var  AtS : AttrSet .
7597  vars MAS MAS' MbS : MembAxSet .
7598  vars Eq Eq' : Equation .
7599  vars EqS EqS' : EquationSet .
7600  vars Rl Rl' : Rule .
7601  vars RlS RlS' : RuleSet .
7602  vars SS SS' : SortSet .
7603  vars IL IL' : ImportList .
7604  vars QIL QIL' : QidList .
7605  vars PL PL' : ParameterList .
7606  vars CDS CDS' : ClassDeclSet .
7607  vars SCD SCD' : SubclassDecl .
7608  vars SCDS SCDS' : SubclassDeclSet .
7609  vars U U' : Module .
7610  vars MDS MDS' : MsgDeclSet .
7611  vars I I' : Import .
7612  vars T T' T1 T1' T2 T2' : Term .
7613  vars ME ME' : ModuleExpression .
7614  vars PD PD' : ParameterDecl .
7615  vars PDL PDL' : ParameterDeclList .
7616  var  H : Header .
7617  vars MN MN' : ModuleName .
7618  var  Cd Cond Cond1 Cond2 : Condition .
7619
7620  eq I in (IL I IL') = true .
7621  eq I in IL = false [owise] .
7622
7623  op theory : Module -> Bool .
7624  eq theory(unitError(QIL)) = false .
7625  eq theory(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = false .
7626  eq theory(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = true .
7627  eq theory(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = false .
7628  eq theory(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) = true .
7629  eq theory(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
7630    = false .
7631  eq theory(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
7632    = true .
7633
7634*** Selection functions for units
7635
7636  eq getName(unitError(QIL)) = ' .
7637  eq getName(noModule) = ' .
7638  eq getName(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = ME .
7639  eq getName(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = ME .
7640  eq getName(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = MN .
7641  ----eq getName(th PD is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = PD .
7642  eq getName(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm) = ME .
7643  eq getName(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm) = ME .
7644  eq getName(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) = MN .
7645  eq getName(
7646       omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
7647    = ME .
7648  eq getName(
7649       omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
7650    = ME .
7651  eq getName(
7652       oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
7653    = MN .
7654
7655  eq getImports(unitError(QIL)) = nil .
7656  eq getImports(noModule) = nil .
7657  eq getImports(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = IL .
7658  eq getImports(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = IL .
7659  eq getImports(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = IL .
7660  eq getImports(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = IL .
7661  eq getImports(
7662       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
7663    = IL .
7664  eq getImports(
7665       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
7666    = IL .
7667
7668  eq getPars(unitError(QIL)) = nil .
7669  eq getPars(noModule) = nil .
7670  eq getPars(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = nil .
7671  eq getPars(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = PDL .
7672  eq getPars(mod nullHeader is IL sorts SS . SSDS OPDS MAS EqS RlS endm)
7673    = nil .
7674  eq getPars(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = nil .
7675  eq getPars(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = nil .
7676  eq getPars(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm) = nil .
7677  eq getPars(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm) = PDL .
7678  eq getPars(fmod nullHeader is IL sorts SS . SSDS OPDS MAS EqS endfm) = nil .
7679  eq getPars(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) = nil .
7680  eq getPars(
7681       omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
7682    = nil .
7683  eq getPars(
7684        omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS
7685        endom)
7686    = PDL .
7687  eq getPars(
7688        omod nullHeader is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS
7689        endom)
7690    = nil .
7691  eq getPars(
7692       oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
7693    = nil .
7694
7695  eq getSorts(unitError(QIL)) = none .
7696  eq getSorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = SS .
7697  eq getSorts(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = SS .
7698  eq getSorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = SS .
7699  eq getSorts(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = SS .
7700  eq getSorts(
7701       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
7702    = SS .
7703  eq getSorts(
7704       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
7705    = SS .
7706
7707  op getAllSorts : Module -> SortSet .
7708  eq getAllSorts(M) = getSorts(M) .
7709
7710  eq getSubsorts(unitError(QIL)) = none .
7711  eq getSubsorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = SSDS .
7712  eq getSubsorts(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = SSDS .
7713  eq getSubsorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = SSDS .
7714  eq getSubsorts(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = SSDS .
7715  eq getSubsorts(
7716       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
7717    = SSDS .
7718  eq getSubsorts(
7719       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
7720    = SSDS .
7721
7722  eq getOps(unitError(QIL)) = none .
7723  eq getOps(noModule) = none .
7724  eq getOps(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = OPDS .
7725  eq getOps(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = OPDS .
7726  eq getOps(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = OPDS .
7727  eq getOps(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = OPDS .
7728  eq getOps(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
7729    = OPDS .
7730  eq getOps(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
7731    = OPDS .
7732
7733  eq getMbs(unitError(QIL)) = none .
7734  eq getMbs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = MAS .
7735  eq getMbs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = MAS .
7736  eq getMbs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = MAS .
7737  eq getMbs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = MAS .
7738  eq getMbs(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
7739    = MAS .
7740  eq getMbs(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
7741    = MAS .
7742
7743  eq getEqs(unitError(QIL)) = none .
7744  eq getEqs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = EqS .
7745  eq getEqs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = EqS .
7746  eq getEqs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = EqS .
7747  eq getEqs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = EqS .
7748  eq getEqs(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
7749    = EqS .
7750  eq getEqs(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
7751    = EqS .
7752
7753  eq getRls(unitError(QIL)) = none .
7754  eq getRls(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = RlS .
7755  eq getRls(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = RlS .
7756  eq getRls(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none .
7757  eq getRls(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none .
7758  eq getRls(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
7759    = RlS .
7760  eq getRls(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
7761    = RlS .
7762
7763  eq getClasses(unitError(QIL)) = none .
7764  eq getClasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = none .
7765  eq getClasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = none .
7766  eq getClasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none .
7767  eq getClasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none .
7768  eq getClasses(
7769       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
7770    = CDS .
7771  eq getClasses(
7772       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
7773    = CDS .
7774
7775  eq getSubclasses(unitError(QIL)) = none .
7776  eq getSubclasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = none .
7777  eq getSubclasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = none .
7778  eq getSubclasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none .
7779  eq getSubclasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none .
7780  eq getSubclasses(
7781       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
7782    = SCDS .
7783  eq getSubclasses(
7784       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
7785    = SCDS .
7786
7787  eq getMsgs(unitError(QIL)) = none .
7788  eq getMsgs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = none .
7789  eq getMsgs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = none .
7790  eq getMsgs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none .
7791  eq getMsgs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none .
7792  eq getMsgs(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
7793    = MDS .
7794  eq getMsgs(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
7795    = MDS .
7796
7797*** Set functions
7798
7799  eq setImports(unitError(QIL), IL) = unitError(QIL) .
7800  eq setImports(noModule, IL) = noModule .
7801  eq setImports(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, IL')
7802    = mod H is IL' sorts SS . SSDS OPDS MAS EqS RlS endm .
7803  eq setImports(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, IL')
7804    = th H is IL' sorts SS . SSDS OPDS MAS EqS RlS endth .
7805  eq setImports(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, IL')
7806    = fmod H is IL' sorts SS . SSDS OPDS MAS EqS endfm .
7807  eq setImports(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, IL')
7808    = fth H is IL' sorts SS . SSDS OPDS MAS EqS endfth .
7809  eq setImports(
7810       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, IL')
7811    = omod H is IL' sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom .
7812  eq setImports(
7813       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, IL')
7814    = oth H is IL' sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth .
7815
7816  eq setOps(unitError(QIL), OPDS) = unitError(QIL) .
7817  eq setOps(noModule, OPDS) = noModule .
7818  eq setOps(U, opDeclError(QIL) OPDS) = unitError(QIL) .
7819  eq setOps(unitError(QIL), opDeclError(QIL') OPDS) = unitError(QIL QIL') .
7820  eq setOps(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, OPDS')
7821    = mod H is IL sorts SS . SSDS OPDS' MAS EqS RlS endm .
7822  eq setOps(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, OPDS')
7823    = th MN is IL sorts SS . SSDS OPDS' MAS EqS RlS endth .
7824  eq setOps(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, OPDS')
7825    = fmod H is IL sorts SS . SSDS OPDS' MAS EqS endfm .
7826  eq setOps(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, OPDS')
7827    = fth MN is IL sorts SS . SSDS OPDS' MAS EqS endfth .
7828  eq setOps(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom,
7829       OPDS')
7830    = omod H is IL sorts SS . SSDS CDS SCDS OPDS' MDS MAS EqS RlS endom .
7831  eq setOps(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth,
7832       OPDS')
7833    = oth MN is IL sorts SS . SSDS CDS SCDS OPDS' MDS MAS EqS RlS endoth .
7834
7835  eq setSubsorts(unitError(QIL), SSDS) = unitError(QIL) .
7836  eq setSubsorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SSDS')
7837    = mod H is IL sorts SS . SSDS' OPDS MAS EqS RlS endm .
7838  eq setSubsorts(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, SSDS')
7839    = th MN is IL sorts SS . SSDS' OPDS MAS EqS RlS endth .
7840  eq setSubsorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, SSDS')
7841    = fmod H is IL sorts SS . SSDS' OPDS MAS EqS endfm .
7842  eq setSubsorts(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, SSDS')
7843    = fth MN is IL sorts SS . SSDS' OPDS MAS EqS endfth .
7844  eq setSubsorts(
7845       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom,
7846       SSDS')
7847    = omod H is IL sorts SS . SSDS' CDS SCDS OPDS MDS MAS EqS RlS endom .
7848  eq setSubsorts(
7849       oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth,
7850       SSDS')
7851    = oth MN is IL sorts SS . SSDS' CDS SCDS OPDS MDS MAS EqS RlS endoth .
7852
7853  eq setMbs(unitError(QIL), membAxError(QIL') MAS) = unitError(QIL QIL') .
7854  eq setMbs(unitError(QIL), MAS) = unitError(QIL) .
7855  eq setMbs(U, membAxError(QIL) MAS) = unitError(QIL) .
7856  eq setMbs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, MAS')
7857    = mod H is IL sorts SS . SSDS OPDS MAS' EqS RlS endm .
7858  eq setMbs(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MAS')
7859    = th MN is IL sorts SS . SSDS OPDS MAS' EqS RlS endth .
7860  eq setMbs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, MAS')
7861    = fmod H is IL sorts SS . SSDS OPDS MAS' EqS endfm .
7862  eq setMbs(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, MAS')
7863    = fth MN is IL sorts SS . SSDS OPDS MAS' EqS endfth .
7864  eq setMbs(
7865       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, MAS')
7866    = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS' EqS RlS endom .
7867  eq setMbs(
7868       oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, MAS')
7869    = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS' EqS RlS endoth .
7870
7871  eq setEqs(unitError(QIL), EqS) = unitError(QIL) .
7872  eq setEqs(U, equationError(QIL) EqS?:[EquationSet]) = unitError(QIL) .
7873  eq setEqs(unitError(QIL), equationError(QIL') EqS?:[EquationSet])
7874    = unitError(QIL QIL') .
7875  eq setEqs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, EqS')
7876    = mod H is IL sorts SS . SSDS OPDS MAS EqS' RlS endm .
7877  eq setEqs(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, EqS')
7878    = th MN is IL sorts SS . SSDS OPDS MAS EqS' RlS endth .
7879  eq setEqs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, EqS')
7880    = fmod H is IL sorts SS . SSDS OPDS MAS EqS' endfm .
7881  eq setEqs(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, EqS')
7882    = fth MN is IL sorts SS . SSDS OPDS MAS EqS' endfth .
7883  eq setEqs(
7884       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, EqS')
7885    = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS' RlS endom .
7886  eq setEqs(
7887       oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, EqS')
7888    = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS' RlS endoth .
7889
7890  var U? : [Module] .
7891  var RlS? : [RuleSet] .
7892
7893  eq setRls(unitError(QIL), RlS?) = unitError(QIL) .
7894  eq setRls(U?, ruleError(QIL) RlS?) = unitError(QIL) .
7895  eq setRls(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, RlS')
7896    = mod H is IL sorts SS . SSDS OPDS MAS EqS RlS' endm .
7897  eq setRls(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, RlS')
7898    = th MN is IL sorts SS . SSDS OPDS MAS EqS RlS' endth .
7899  eq setRls(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, RlS)
7900    = if RlS == none
7901      then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm
7902      else mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm
7903      fi .
7904  eq setRls(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, RlS)
7905    = if RlS == none
7906      then fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth
7907      else th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth
7908      fi .
7909  eq setRls(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom,
7910       RlS')
7911    = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS' endom .
7912  eq setRls(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth,
7913       RlS')
7914    = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS' endoth .
7915
7916  eq setSorts(unitError(QIL), SS) = unitError(QIL) .
7917  eq setSorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SS')
7918    = mod H is IL sorts SS' . SSDS OPDS MAS EqS RlS endm .
7919  eq setSorts(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, SS')
7920    = th MN is IL sorts SS' . SSDS OPDS MAS EqS RlS endth .
7921  eq setSorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, SS')
7922    = fmod H is IL sorts SS' . SSDS OPDS MAS EqS endfm .
7923  eq setSorts(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, SS')
7924    = fth MN is IL sorts SS' . SSDS OPDS MAS EqS endfth .
7925  eq setSorts(
7926        omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, SS')
7927    = omod H is IL sorts SS' . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom .
7928  eq setSorts(
7929        oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, SS')
7930    = oth MN is IL sorts SS' . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth .
7931
7932  eq setPars(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm, PDL)
7933    = if PDL == nil
7934      then mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm
7935      else mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm
7936      fi .
7937  eq setPars(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm, PDL')
7938    = if PDL' == nil
7939      then mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm
7940      else mod ME{PDL'} is IL sorts SS . SSDS OPDS MAS EqS RlS endm
7941      fi .
7942  eq setPars(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, PDL)
7943    = th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth .
7944  eq setPars(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm, PDL)
7945    = if PDL == nil
7946      then fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm
7947      else fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm
7948      fi .
7949  eq setPars(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm, PDL')
7950    = if PDL' == nil
7951      then fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm
7952      else fmod ME{PDL'} is IL sorts SS . SSDS OPDS MAS EqS endfm
7953      fi .
7954  eq setPars(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, PDL)
7955    = fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth .
7956  eq setPars(
7957        omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom,
7958        PDL)
7959    = if PDL == nil
7960      then omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom
7961      else omod ME{PDL} is
7962             IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS
7963           endom
7964      fi .
7965  eq setPars(
7966       omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom,
7967       PDL')
7968    = if PDL' == nil
7969      then omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom
7970      else omod ME{PDL'} is
7971             IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS
7972           endom
7973      fi .
7974  eq setPars(
7975        oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth,
7976        PDL)
7977    = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth .
7978
7979  eq setClasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, CDS)
7980    = if CDS == none
7981      then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm
7982      else omod H is IL sorts SS . SSDS CDS none OPDS none MAS EqS none endom
7983      fi .
7984  eq setClasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, CDS)
7985    = if CDS == none
7986      then fth H is IL sorts SS . SSDS OPDS MAS EqS endfth
7987      else oth H is IL sorts SS . SSDS CDS none OPDS none MAS EqS none endoth
7988      fi .
7989  eq setClasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, CDS)
7990    = if CDS == none
7991      then mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm
7992      else omod H is IL sorts SS . SSDS CDS none OPDS none MAS EqS RlS endom
7993      fi .
7994  eq setClasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, CDS)
7995    = if CDS == none
7996      then th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth
7997      else oth H is IL sorts SS . SSDS CDS none OPDS none MAS EqS RlS endoth
7998      fi .
7999  eq setClasses(
8000        omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom,
8001        CDS')
8002    = omod H is IL sorts SS . SSDS CDS' SCDS OPDS MDS MAS EqS RlS endom .
8003  eq setClasses(
8004        oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth,
8005        CDS')
8006    = oth H is IL sorts SS . SSDS CDS' SCDS OPDS MDS MAS EqS RlS endoth .
8007  eq setClasses(M, CDS)
8008    = unitError(header2QidList(getName(M)) 'not 'an 'object-oriented 'module)
8009    [owise] .
8010
8011  eq setSubclasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, SCDS)
8012    = if SCDS == none
8013      then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm
8014      else omod H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS none endom
8015      fi .
8016  eq setSubclasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, SCDS)
8017    = if SCDS == none
8018      then fth H is IL sorts SS . SSDS OPDS MAS EqS endfth
8019      else oth H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS none endoth
8020      fi .
8021  eq setSubclasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SCDS)
8022    = if SCDS == none
8023      then mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm
8024      else omod H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS RlS endom
8025      fi .
8026  eq setSubclasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, SCDS)
8027    = if SCDS == none
8028      then th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth
8029      else oth H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS RlS endoth
8030      fi .
8031  eq setSubclasses(
8032       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, SCDS')
8033    = omod H is IL sorts SS . SSDS CDS SCDS' OPDS MDS MAS EqS RlS endom .
8034  eq setSubclasses(
8035       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth,
8036       SCDS')
8037    = oth H is IL sorts SS . SSDS CDS SCDS' OPDS MDS MAS EqS RlS endoth .
8038  eq setSubclasses(M, SCDS)
8039    = unitError(header2QidList(getName(M)) 'not 'an 'object-oriented 'module)
8040    [owise] .
8041
8042  eq setMsgs(
8043       fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, MDS)
8044    = if MDS == none
8045      then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm
8046      else omod H is IL sorts SS . SSDS none none OPDS MDS MAS EqS none endom
8047      fi .
8048  eq setMsgs(
8049       fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, MDS)
8050    = if MDS == none
8051      then fth H is IL sorts SS . SSDS OPDS MAS EqS endfth
8052      else oth H is IL sorts SS . SSDS none none OPDS MDS MAS EqS none endoth
8053      fi .
8054  eq setMsgs(
8055       mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, MDS)
8056    = if MDS == none
8057      then mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm
8058      else omod H is IL sorts SS . SSDS none none OPDS MDS MAS EqS RlS endom
8059      fi .
8060  eq setMsgs(
8061       th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MDS)
8062    = if MDS == none
8063      then th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth
8064      else oth H is IL sorts SS . SSDS none none OPDS MDS MAS EqS RlS endoth
8065      fi .
8066  eq setMsgs(
8067       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, MDS')
8068    = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS' MAS EqS RlS endom .
8069  eq setMsgs(
8070       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, MDS')
8071    = oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS' MAS EqS RlS endoth .
8072  eq setMsgs(M, MDS)
8073    = unitError(header2QidList(getName(M)) 'not 'an 'object-oriented 'module)
8074    [owise] .
8075
8076  eq setName(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm, ME')
8077    = mod ME' is IL sorts SS . SSDS OPDS MAS EqS RlS endm .
8078  eq setName(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm, ME')
8079    = mod ME'{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm .
8080  eq setName(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm, ME')
8081    = fmod ME' is IL sorts SS . SSDS OPDS MAS EqS endfm .
8082  eq setName(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm, ME')
8083    = fmod ME'{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm .
8084  eq setName(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, MN')
8085    = fth MN' is IL sorts SS . SSDS OPDS MAS EqS endfth .
8086  eq setName(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MN')
8087    = th MN' is IL sorts SS . SSDS OPDS MAS EqS RlS endth .
8088  eq setName(omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, ME')
8089    = omod ME' is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom .
8090  eq setName(omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, ME')
8091    = omod ME'{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom .
8092  eq setName(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, MN')
8093    = oth MN' is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth .
8094  eq setName(noModule, ME) = noModule .
8095  eq setName(unitError(QIL), ME) = unitError(QIL) .
8096
8097  eq setName(mod nullHeader is IL sorts SS . SSDS OPDS MAS EqS RlS endm, ME')
8098    = mod ME' is IL sorts SS . SSDS OPDS MAS EqS RlS endm .
8099  eq setName(fmod nullHeader is IL sorts SS . SSDS OPDS MAS EqS endfm, ME')
8100    = fmod ME' is IL sorts SS . SSDS OPDS MAS EqS endfm .
8101  eq setName(fth nullHeader is IL sorts SS . SSDS OPDS MAS EqS endfth, MN)
8102    = fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth .
8103  eq setName(th nullHeader is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MN)
8104    = th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth .
8105  eq setName(
8106       omod nullHeader is
8107         IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS
8108       endom,
8109       ME')
8110    = omod ME' is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom .
8111  eq setName(
8112       oth nullHeader is
8113         IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth,
8114       MN)
8115    = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth .
8116  eq setName(noModule, ME) = noModule .
8117  eq setName(unitError(QIL), ME) = unitError(QIL) .
8118
8119*** Add functions
8120
8121  eq addSorts(SS, U) = setSorts(U, (SS ; getSorts(U))) .
8122  eq addSorts(SS, unitError(QIL)) = unitError(QIL) .
8123
8124  eq addSubsorts(SSDS, U) = setSubsorts(U, (SSDS getSubsorts(U))) .
8125  eq addSubsorts(subsortDeclError(QIL), U) = unitError(QIL) .
8126  eq addSubsorts(SSDS, unitError(QIL)) = unitError(QIL) .
8127
8128  eq addOps(OPDS, U) = setOps(U, (OPDS getOps(U))) .
8129  eq addOps(OPDS?, unitError(QIL)) = unitError(QIL) .
8130  eq addOps(OPDS?, U) = U [owise] .
8131
8132  eq addMbs(MAS, U) = setMbs(U, (MAS getMbs(U))) .
8133  eq addMbs(MAS, unitError(QIL)) = unitError(QIL) .
8134  eq addEqs(EqS, U) = setEqs(U, (EqS getEqs(U))) .
8135  eq addEqs(EqS, unitError(QIL)) = unitError(QIL) .
8136  eq addRls(RlS, U) = setRls(U, (RlS getRls(U))) .
8137  eq addRls(RlS, unitError(QIL)) = unitError(QIL) .
8138  eq addRls(ruleError(QIL), U) = unitError(QIL) .
8139  eq addImports(IL, U) = setImports(U, (getImports(U) IL)) .
8140  eq addImports(IL, unitError(QIL)) = unitError(QIL) .
8141  eq addClasses(CDS, U) = setClasses(U, (getClasses(U) CDS)) .
8142  eq addClasses(CDS, unitError(QIL)) = unitError(QIL) .
8143  eq addSubclasses(SCDS, U) = setSubclasses(U, (getSubclasses(U) SCDS)) .
8144  eq addSubclasses(SCDS, unitError(QIL)) = unitError(QIL) .
8145  eq addMsgs(MDS, U) = setMsgs(U, (getMsgs(U) MDS)) .
8146  eq addMsgs(MDS, unitError(QIL)) = unitError(QIL) .
8147
8148*** Creation of empty units
8149
8150  eq emptyFModule(ME)
8151    = fmod header2Qid(ME) is nil sorts none . none none none none endfm .
8152  eq emptyFModule
8153    = fmod nullHeader is nil sorts none . none none none none endfm .
8154  eq emptySModule
8155    = mod nullHeader is nil sorts none . none none none none none endm .
8156  eq emptyOModule
8157    = omod nullHeader is
8158        nil sorts none . none none none none none none none none
8159      endom .
8160  eq emptyFTheory
8161    = fth nullHeader is nil sorts none . none none none none endfth .
8162  eq emptySTheory
8163    = th nullHeader is nil sorts none . none none none none none endth .
8164  eq emptyOTheory
8165    = oth nullHeader is
8166         nil sorts none . none none none none none none none none
8167      endoth .
8168
8169*** \texttt{empty} returns an empty unit of the same type of the one given as
8170*** argument.
8171
8172  eq empty(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm)
8173    = (mod H is nil sorts none . none none none none none endm) .
8174  eq empty(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth)
8175    = (th MN is nil sorts none . none none none none none endth) .
8176  eq empty(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm)
8177    = (fmod H is nil sorts none . none none none none endfm) .
8178  eq empty(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth)
8179    = (fth MN is nil sorts none . none none none none endfth) .
8180  eq empty(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
8181    = (omod H is
8182         nil sorts none . none none none none none none none none
8183       endom) .
8184  eq empty(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
8185    = (oth MN is
8186         nil sorts none . none none none none none none none none
8187       endoth) .
8188
8189*** In the following \texttt{addDecls} function, the declarations of the unit
8190*** given as second argument are added to the unit given as first argument.
8191
8192  eq addDecls(noModule, U) = U .
8193  eq addDecls(U, noModule) = U .
8194  eq addDecls(unitError(QIL), U) = unitError(QIL) .
8195  eq addDecls(U, unitError(QIL)) = unitError(QIL) .
8196  eq addDecls(U, U')
8197    = addImports(getImports(U'),
8198        addSorts(getSorts(U'),
8199          addSubsorts(getSubsorts(U'),
8200            addOps(getOps(U'),
8201              addMbs(getMbs(U'),
8202                addEqs(getEqs(U'),
8203                  if U' :: FModule or U' :: FTheory
8204                  then U
8205                  else addRls(getRls(U'),
8206                         if U' :: SModule or U' :: STheory
8207                         then U
8208                         else addClasses(getClasses(U'),
8209                                addSubclasses(getSubclasses(U'),
8210                                  addMsgs(getMsgs(U'), U)))
8211                         fi)
8212                  fi))))))
8213    [owise] .
8214
8215  op removeNonExecs : Module -> Module .
8216  op removeNonExecs : MembAxSet -> MembAxSet .
8217  op removeNonExecs : EquationSet -> EquationSet .
8218  op removeNonExecs : RuleSet -> RuleSet .
8219
8220  ceq removeNonExecs(M)
8221    = setRls(M'', removeNonExecs(getRls(M)))
8222    if M' := setMbs(M, removeNonExecs(getMbs(M)))
8223    /\ M'' := setEqs(M', removeNonExecs(getEqs(M))) .
8224  eq removeNonExecs(unitError(QIL)) = unitError(QIL) .
8225
8226  eq removeNonExecs(mb T : S [nonexec AtS] . MbS) = removeNonExecs(MbS) .
8227  eq removeNonExecs(cmb T : S if Cd [nonexec AtS] . MbS) = removeNonExecs(MbS) .
8228  eq removeNonExecs(MbS) = MbS [owise] .
8229
8230  eq removeNonExecs(eq T = T' [nonexec AtS] . EqS) = removeNonExecs(EqS) .
8231  eq removeNonExecs(ceq T = T' if Cd [nonexec AtS] . EqS) = removeNonExecs(EqS) .
8232  eq removeNonExecs(EqS) = EqS [owise] .
8233
8234  eq removeNonExecs(rl T => T' [nonexec AtS] . RlS) = removeNonExecs(RlS) .
8235  eq removeNonExecs(crl T => T' if Cd [nonexec AtS] . RlS) = removeNonExecs(RlS) .
8236  eq removeNonExecs(RlS) = RlS [owise] .
8237
8238  *** moreGeneralEqs  ******************************
8239  ---- An equation is more general than other if there is a substitution such that
8240  ---- the more general equation with such a substitution applied is equal to the
8241  ---- less general one.
8242  op moreGeneralEqs : Module -> Module .
8243  op moreGeneralRls : Module -> Module .
8244  op $moreGeneralEqs : Module Module EquationSet EquationSet -> Module .
8245  op $moreGeneralRls : Module Module RuleSet RuleSet -> Module .
8246  op $moreGeneral : Module Equation Equation -> Bool .
8247  op $moreGeneral : Module Rule Rule -> Bool .
8248  op $moreGeneral : Module Condition Condition Term Term -> Bool .
8249
8250  eq moreGeneralEqs(M)
8251    = $moreGeneralEqs(
8252        M,
8253        addOps((op '@/\@ : '@@@ '@@@ -> '@@@ [assoc] .
8254                op '@--@ : 'Universal -> '@@@ [poly(1)] .
8255                op '@--@ : 'Universal 'Universal -> '@@@ [poly(1 2)] .),
8256               addSorts('@@@, M)),
8257        getEqs(M), getEqs(M)) .
8258  eq moreGeneralRls(M)
8259    = $moreGeneralRls(
8260        M,
8261        addOps((op '@/\@ : '@@@ '@@@ -> '@@@ [assoc] .
8262                op '@--@ : 'Universal -> '@@@ [poly(1)] .
8263                op '@--@ : 'Universal 'Universal -> '@@@ [poly(1 2)] .),
8264               addSorts('@@@, M)),
8265        getRls(M), getRls(M)) .
8266
8267 ceq $moreGeneralEqs(M, M', Eq EqS, Eq Eq' EqS')
8268    = $moreGeneralEqs(M, M', EqS, Eq' EqS')
8269    if $moreGeneral(M', Eq', Eq) .
8270  eq $moreGeneralEqs(M, M', EqS, EqS') = setEqs(M, EqS') [owise] .
8271
8272 ceq $moreGeneralRls(M, M', Rl RlS, Rl Rl' RlS')
8273    = $moreGeneralRls(M, M', RlS, Rl' RlS')
8274    if $moreGeneral(M', Rl', Rl) .
8275  eq $moreGeneralRls(M, M', RlS, RlS') = setRls(M, RlS') [owise] .
8276
8277  eq $moreGeneral(M, Eq, Eq')
8278    = sameKind(M, leastSort(M, lhs(Eq)), leastSort(M, lhs(Eq')))
8279      and-then
8280      $moreGeneral(M, cond(Eq), cond(Eq'), '@--@[lhs(Eq), rhs(Eq)], '@--@[lhs(Eq'), rhs(Eq')]) .
8281
8282  eq $moreGeneral(M, Rl, Rl')
8283    = sameKind(M, leastSort(M, lhs(Rl)), leastSort(M, lhs(Rl')))
8284      and-then
8285      $moreGeneral(M, cond(Rl), cond(Rl'), '@--@[lhs(Rl), rhs(Rl)], '@--@[lhs(Rl'), rhs(Rl')]) .
8286
8287  eq $moreGeneral(M, T1 = T1' /\ Cond1, T2 = T2' /\ Cond2, T, T')
8288    = sameKind(M, leastSort(M, T1), leastSort(M, T2))
8289      and-then
8290      $moreGeneral(M, Cond1, Cond2, '@/\@['@--@[T1, T1'], T], '@/\@['@--@[T2, T2'], T']) .
8291  eq $moreGeneral(M, T1 := T1' /\ Cond1, T2 := T2' /\ Cond2, T, T')
8292    = sameKind(M, leastSort(M, T1), leastSort(M, T2))
8293      and-then
8294      $moreGeneral(M, Cond1, Cond2, '@/\@['@--@[T1, T1'], T], '@/\@['@--@[T2, T2'], T']) .
8295  eq $moreGeneral(M, T1 => T1' /\ Cond1, T2 => T2' /\ Cond2, T, T')
8296    = sameKind(M, leastSort(M, T1), leastSort(M, T2))
8297      and-then
8298      $moreGeneral(M, Cond1, Cond2, '@/\@['@--@[T1, T1'], T], '@/\@['@--@[T2, T2'], T']) .
8299  eq $moreGeneral(M, T1 : S /\ Cond1, T2 : S /\ Cond2, T, T')
8300    = $moreGeneral(M, Cond1, Cond2, '@/\@['@--@[T1], T], '@/\@['@--@[T2], T']) .
8301
8302  eq $moreGeneral(M, nil, nil, T, T') = metaMatch(M, T, T', nil, 0) =/= noMatch .
8303  eq $moreGeneral(M, Cond1, Cond2, T, T') = false [owise] .
8304
8305  op rmVariantAttrs : Module -> Module .
8306  op $rmVariants : EquationSet -> EquationSet .
8307  op $rmVariants : RuleSet -> RuleSet .
8308  op $rmVariants : MembAxSet -> MembAxSet .
8309  eq rmVariantAttrs(M) = setRls(setEqs(setMbs(M, $rmVariants(getMbs(M))), $rmVariants(getEqs(M))), $rmVariants(getRls(M))) .
8310  eq rmVariantAttrs(unitError(QIL)) = unitError(QIL) .
8311
8312  eq $rmVariants(eq T = T' [variant AtS] . EqS) = (eq T = T' [variant AtS] .) $rmVariants(EqS) .
8313  eq $rmVariants(ceq T = T' if Cond [variant AtS] . EqS) = (ceq T = T' if Cond [variant AtS] .) $rmVariants(EqS) .
8314  eq $rmVariants(EqS) = EqS [owise] .
8315
8316  eq $rmVariants(rl T => T' [variant AtS] . RlS) = (rl T => T' [variant AtS] .) $rmVariants(RlS) .
8317  eq $rmVariants(crl T => T' if Cond [variant AtS] . RlS) = (crl T => T' if Cond [variant AtS] .) $rmVariants(RlS) .
8318  eq $rmVariants(RlS) = RlS [owise] .
8319
8320  eq $rmVariants(mb T : S [variant AtS] . MbS) = (mb T : S [variant AtS] .) $rmVariants(MbS) .
8321  eq $rmVariants(cmb T : S if Cond [variant AtS] . MbS) = (cmb T : S if Cond [variant AtS] .) $rmVariants(MbS) .
8322  eq $rmVariants(MbS) = MbS [owise] .
8323endfm
8324
8325-------------------------------------------------------------------------------
8326
8327fmod AX-COHERENCE-COMPLETION is
8328  inc UNIT .
8329----  inc MODULE-HANDLING * (op addOps to addOpsSE, op addEqs to addEqsSE, op addSorts to addSortsSE) .
8330
8331  vars V W : Variable .
8332  var  C : Constant .
8333  var  FM : FModule .
8334  var  SM : SModule .
8335  var  M : Module .
8336  var  N : Nat .
8337  vars T T' T'' LHS RHS : Term .
8338  vars Subst Subst' : Substitution .
8339  var  F : Qid .
8340  var  TL : TermList .
8341  vars AtS AtS' : AttrSet .
8342----  var  VFS : VariantFourSet .
8343  vars Tp Tp' Tp'' : Type .
8344  var  TpL : TypeList .
8345  var  Rl : Rule .
8346  var  RlS : RuleSet .
8347  var  Eq : Equation .
8348  var  EqS : EquationSet .
8349  var  ODS : OpDeclSet .
8350  var  Cond : Condition .
8351  var  QIL : QidList .
8352
8353  ------------------------------------------------------------------------------
8354  ---- coherence completion
8355  ------------------------------------------------------------------------------
8356
8357  op axCohComplete : SModule -> SModule .
8358  op axCohComplete : SModule OpDeclSet RuleSet -> RuleSet .
8359  op axCohCompleteAux : SModule OpDeclSet RuleSet -> RuleSet .
8360  op axCohComplete : SModule Type AttrSet Rule -> RuleSet .
8361  op axCohComplete : SModule OpDeclSet EquationSet -> EquationSet .
8362  op axCohCompleteAux : SModule OpDeclSet EquationSet -> EquationSet .
8363  op axCohComplete : SModule Type AttrSet Equation -> EquationSet .
8364
8365  eq axCohComplete(FM)
8366    = moreGeneralEqs(setEqs(FM, axCohComplete(FM, getOps(FM), getEqs(FM)))) .
8367  eq axCohComplete(SM)
8368    = moreGeneralEqs(
8369        moreGeneralRls(
8370          setRls(
8371            setEqs(SM,
8372              axCohComplete(SM, getOps(SM), getEqs(SM))),
8373            axCohComplete(SM, getOps(SM), getRls(SM)))))
8374    [owise] .
8375  eq axCohComplete(unitError(QIL)) = unitError(QIL) .
8376
8377  ceq axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, rl F[TL] => RHS [AtS'] . RlS)
8378    = axCohComplete(M, Tp, assoc AtS, rl F[TL] => RHS [AtS'] .)
8379      axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, RlS)
8380    if sameKindAll(M, Tp, eLeastSort(M, TL)) .
8381  ceq axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, crl F[TL] => RHS if Cond [AtS'] . RlS)
8382    = axCohComplete(M, Tp, assoc AtS, crl F[TL] => RHS if Cond [AtS'] .)
8383      axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, RlS)
8384    if sameKindAll(M, Tp, eLeastSort(M, TL)) .
8385  eq axCohComplete(M, ODS, RlS) = axCohCompleteAux(M, ODS, RlS) [owise] .
8386
8387  ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, rl LHS => RHS [AtS'] . RlS)
8388    = axCohComplete(M, Tp, assoc id(T) AtS, rl F[LHS] => RHS [AtS'] .)
8389      axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, RlS)
8390    if sameKindAll(M, Tp, leastSort(M, LHS)) .
8391  ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, crl LHS => RHS if Cond [AtS'] . RlS)
8392    = axCohComplete(M, Tp, assoc id(T) AtS, crl F[LHS] => RHS if Cond [AtS'] .)
8393      axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, RlS)
8394    if sameKindAll(M, Tp, leastSort(M, LHS)) .
8395  ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, rl LHS => RHS [AtS'] . RlS)
8396    = axCohComplete(M, Tp, assoc left-id(T) AtS, rl F[LHS] => RHS [AtS'] .)
8397      axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, RlS)
8398    if sameKindAll(M, Tp, leastSort(M, LHS)) .
8399  ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, crl LHS => RHS if Cond [AtS'] . RlS)
8400    = axCohComplete(M, Tp, assoc left-id(T) AtS, crl F[LHS] => RHS if Cond [AtS'] .)
8401      axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, RlS)
8402    if sameKindAll(M, Tp, leastSort(M, LHS)) .
8403  ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, rl LHS => RHS [AtS'] . RlS)
8404    = axCohComplete(M, Tp, assoc right-id(T) AtS, rl F[LHS] => RHS [AtS'] .)
8405      axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, RlS)
8406    if sameKindAll(M, Tp, leastSort(M, LHS)) .
8407  ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, crl LHS => RHS if Cond [AtS'] . RlS)
8408    = axCohComplete(M, Tp, assoc right-id(T) AtS, crl F[LHS] => RHS if Cond [AtS'] .)
8409      axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, RlS)
8410    if sameKindAll(M, Tp, leastSort(M, LHS)) .
8411  eq axCohCompleteAux(M, ODS, RlS) = RlS [owise] .
8412
8413  ceq axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, eq F[TL] = RHS [AtS'] . EqS)
8414    = axCohComplete(M, Tp, assoc AtS, eq F[TL] = RHS [AtS'] .)
8415      axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, EqS)
8416    if sameKindAll(M, Tp, eLeastSort(M, TL)) .
8417  ceq axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, ceq F[TL] = RHS if Cond [AtS'] . EqS)
8418    = axCohComplete(M, Tp, assoc AtS, ceq F[TL] = RHS if Cond [AtS'] .)
8419      axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, EqS)
8420    if sameKindAll(M, Tp, eLeastSort(M, TL)) .
8421  eq axCohComplete(M, ODS, EqS) = axCohCompleteAux(M, ODS, EqS) [owise] .
8422
8423  ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, eq LHS = RHS [AtS'] . EqS)
8424    = axCohComplete(M, Tp, assoc id(T) AtS, eq F[LHS] = RHS [AtS'] .)
8425      axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, EqS)
8426    if sameKindAll(M, Tp, leastSort(M, LHS)) .
8427  ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, ceq LHS = RHS if Cond [AtS'] . EqS)
8428    = axCohComplete(M, Tp, assoc id(T) AtS, ceq F[LHS] = RHS if Cond [AtS'] .)
8429      axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc id(T) AtS] . ODS, EqS)
8430    if sameKindAll(M, Tp, leastSort(M, LHS)) .
8431  ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, eq LHS = RHS [AtS'] . EqS)
8432    = axCohComplete(M, Tp, assoc left-id(T) AtS, eq F[LHS] = RHS [AtS'] .)
8433      axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, EqS)
8434    if sameKindAll(M, Tp, leastSort(M, LHS)) .
8435  ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, ceq LHS = RHS if Cond [AtS'] . EqS)
8436    = axCohComplete(M, Tp, assoc left-id(T) AtS, ceq F[LHS] = RHS if Cond [AtS'] .)
8437      axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc left-id(T) AtS] . ODS, EqS)
8438    if sameKindAll(M, Tp, leastSort(M, LHS)) .
8439  ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, eq LHS = RHS [AtS'] . EqS)
8440    = axCohComplete(M, Tp, assoc right-id(T) AtS, eq F[LHS] = RHS [AtS'] .)
8441      axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, EqS)
8442    if sameKindAll(M, Tp, leastSort(M, LHS)) .
8443  ceq axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, ceq LHS = RHS if Cond [AtS'] . EqS)
8444    = axCohComplete(M, Tp, assoc right-id(T) AtS, ceq F[LHS] = RHS if Cond [AtS'] .)
8445      axCohCompleteAux(M, op F : Tp Tp' -> Tp'' [assoc right-id(T) AtS] . ODS, EqS)
8446    if sameKindAll(M, Tp, leastSort(M, LHS)) .
8447  eq axCohCompleteAux(M, ODS, EqS) = EqS [owise] .
8448
8449  ceq axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, eq F[TL] = RHS [AtS'] . EqS)
8450    = axCohComplete(M, Tp, assoc AtS, eq F[TL] = RHS [AtS'] .)
8451      axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, EqS)
8452    if sameKind(M, Tp, Tp')
8453    /\ sameKind(M, Tp', Tp'')
8454    /\ sameKindAll(M, Tp, eLeastSort(M, TL)) .
8455  ceq axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, ceq F[TL] = RHS if Cond [AtS'] . EqS)
8456    = axCohComplete(M, Tp, assoc AtS, ceq F[TL] = RHS if Cond [AtS'] .)
8457      axCohComplete(M, op F : Tp Tp' -> Tp'' [assoc AtS] . ODS, EqS)
8458    if sameKind(M, Tp, Tp')
8459    /\ sameKind(M, Tp', Tp'')
8460    /\ sameKindAll(M, Tp, eLeastSort(M, TL)) .
8461  eq axCohComplete(M, ODS, eq LHS = RHS [AtS] . EqS)
8462    = eq LHS = RHS [AtS] . axCohComplete(M, ODS, EqS)
8463    [owise] .
8464  eq axCohComplete(M, ODS, ceq LHS = RHS if Cond [AtS] . EqS)
8465    = ceq LHS = RHS if Cond [AtS] . axCohComplete(M, ODS, EqS)
8466    [owise] .
8467  eq axCohComplete(M, ODS, (none).EquationSet) = none .
8468
8469  ---- Given f(t1,...,tn) -> r if C
8470  ---- if f AC add f(t1,...,tn,x:[s]) -> f(r,x:[s]) if C
8471  eq axCohComplete(M, Tp, assoc comm AtS, rl F[TL] => RHS [AtS'] .)
8472    = (rl F[TL] => RHS [AtS'] .)
8473      (rl F[TL, qid("X@@@:" + string(getKind(M, Tp)))] => getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) [AtS'] .)
8474    [owise] .
8475  eq axCohComplete(M, Tp, assoc comm AtS, crl F[TL] => RHS if Cond [AtS'] .)
8476    = (crl F[TL] => RHS if Cond [AtS'] .)
8477      (crl F[TL, qid("X@@@:" + string(getKind(M, Tp)))] => getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .)
8478    [owise] .
8479  ---- if f ACU replace by f(t1,...,tn,x:[s]) -> f(r,x:[s]) if C
8480  eq axCohComplete(M, Tp, assoc comm id(T) AtS, rl F[TL] => RHS [AtS'] .)
8481    = (rl F[TL, qid("X@@@:" + string(getKind(M, Tp)))] => getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) [AtS'] .) .
8482  eq axCohComplete(M, Tp, assoc comm id(T) AtS, crl F[TL] => RHS if Cond [AtS'] .)
8483    = (crl F[TL, qid("X@@@:" + string(getKind(M, Tp)))] => getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) .
8484  ---- if f AU replace by f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C
8485  ceq axCohComplete(M, Tp, assoc id(T) AtS, rl F[TL] => RHS [AtS'] .)
8486    = (rl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8487         => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .)
8488    if not comm in AtS .
8489  ceq axCohComplete(M, Tp, assoc id(T) AtS, crl F[TL] => RHS if Cond [AtS'] .)
8490    = (crl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8491         => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .)
8492    if not comm in AtS .
8493  ---- if f ALU replace by f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C
8494  ----             and add f(x:[s],t1,...,tn) -> f(x:[s],r) if C
8495  eq axCohComplete(M, Tp, assoc left-id(T) AtS, rl F[TL] => RHS [AtS'] .)
8496    = (rl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8497         => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .)
8498      (rl F[qid("X@@@:" + string(getKind(M, Tp))), TL]
8499         => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) [AtS'] .)  .
8500  eq axCohComplete(M, Tp, assoc left-id(T) AtS, crl F[TL] => RHS if Cond [AtS'] .)
8501    = (crl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8502         => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .)
8503      (crl F[qid("X@@@:" + string(getKind(M, Tp))), TL]
8504         => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) if Cond [AtS'] .)  .
8505  ---- if f ARU replace by f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C
8506  ----             and add f(t1,...,tn,y:[s]) -> f(r,y:[s]) if C
8507  eq axCohComplete(M, Tp, assoc right-id(T) AtS, rl F[TL] => RHS [AtS'] .)
8508    = (rl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8509         => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .)
8510      (rl F[TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8511         => getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .) .
8512  eq axCohComplete(M, Tp, assoc right-id(T) AtS, crl F[TL] => RHS if Cond [AtS'] .)
8513    = (crl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8514         => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .)
8515      (crl F[TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8516         => getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) .
8517  ---- if f A add f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C
8518  ----            f(x:[s],t1,...,tn) -> f(x:[s],r) if C
8519  ----            f(t1,...,tn,y:[s]) -> f(r,y:[s]) if C
8520  ceq axCohComplete(M, Tp, assoc AtS, rl F[TL] => RHS [AtS'] .)
8521    = (rl F[TL] => RHS [AtS'] .)
8522      (rl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8523         => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .)
8524      (rl F[qid("X@@@:" + string(getKind(M, Tp))), TL]
8525         => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) [AtS'] .)
8526      (rl F[TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8527         => getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .)
8528    if not comm in AtS
8529    [owise] .
8530  ceq axCohComplete(M, Tp, assoc AtS, crl F[TL] => RHS if Cond [AtS'] .)
8531    = (crl F[TL] => RHS if Cond [AtS'] .)
8532      (crl F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8533         => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .)
8534      (crl F[qid("X@@@:" + string(getKind(M, Tp))), TL]
8535         => getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) if Cond [AtS'] .)
8536      (crl F[TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8537         => getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .)
8538    if not comm in AtS
8539    [owise] .
8540
8541  ---- Given f(t1,...,tn) -> r if C
8542  ---- if f AC add f(t1,...,tn,x:[s]) -> f(r,x:[s]) if C
8543  eq axCohComplete(M, Tp, assoc comm AtS, eq F[TL] = RHS [AtS'] .)
8544    = (eq F[TL] = RHS [AtS'] .)
8545      (eq F[TL, qid("X@@@:" + string(getKind(M, Tp)))] = getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) [AtS'] .)
8546    [owise] .
8547  eq axCohComplete(M, Tp, assoc comm AtS, ceq F[TL] = RHS if Cond [AtS'] .)
8548    = (ceq F[TL] = RHS if Cond [AtS'] .)
8549      (ceq F[TL, qid("X@@@:" + string(getKind(M, Tp)))] = getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .)
8550    [owise] .
8551  ---- if f ACU replace by f(t1,...,tn,x:[s]) -> f(r,x:[s]) if C
8552  eq axCohComplete(M, Tp, assoc comm id(T) AtS, eq F[TL] = RHS [AtS'] .)
8553    = (eq F[TL, qid("X@@@:" + string(getKind(M, Tp)))] = getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) [AtS'] .) .
8554  eq axCohComplete(M, Tp, assoc comm id(T) AtS, ceq F[TL] = RHS if Cond [AtS'] .)
8555    = (ceq F[TL, qid("X@@@:" + string(getKind(M, Tp)))] = getTerm(metaNormalize(M, F[RHS, qid("X@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) .
8556  ---- if f AU replace by f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C
8557  ceq axCohComplete(M, Tp, assoc id(T) AtS, eq F[TL] = RHS [AtS'] .)
8558    = (eq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8559         = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .)
8560    if not comm in AtS .
8561  ceq axCohComplete(M, Tp, assoc id(T) AtS, ceq F[TL] = RHS if Cond [AtS'] .)
8562    = (ceq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8563         = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .)
8564    if not comm in AtS .
8565  ---- if f ALU replace by f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C
8566  ----             and add f(x:[s],t1,...,tn) -> f(x:[s],r) if C
8567  eq axCohComplete(M, Tp, assoc left-id(T) AtS, eq F[TL] = RHS [AtS'] .)
8568    = (eq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8569         = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .)
8570      (eq F[qid("X@@@:" + string(getKind(M, Tp))), TL]
8571         = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) [AtS'] .)  .
8572  eq axCohComplete(M, Tp, assoc left-id(T) AtS, ceq F[TL] = RHS if Cond [AtS'] .)
8573    = (ceq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8574         = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .)
8575      (ceq F[qid("X@@@:" + string(getKind(M, Tp))), TL]
8576         = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) if Cond [AtS'] .)  .
8577  ---- if f ARU replace by f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C
8578  ----             and add f(t1,...,tn,y:[s]) -> f(r,y:[s]) if C
8579  eq axCohComplete(M, Tp, assoc right-id(T) AtS, eq F[TL] = RHS [AtS'] .)
8580    = (eq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8581         = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .)
8582      (eq F[TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8583         = getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .) .
8584  eq axCohComplete(M, Tp, assoc right-id(T) AtS, ceq F[TL] = RHS if Cond [AtS'] .)
8585    = (ceq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8586         = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .)
8587      (ceq F[TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8588         = getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .) .
8589  ---- if f A add f(x:[s],t1,...,tn,y:[s]) -> f(x:[s],r,y:[s]) if C
8590  ----            f(x:[s],t1,...,tn) -> f(x:[s],r) if C
8591  ----            f(t1,...,tn,y:[s]) -> f(r,y:[s]) if C
8592  ceq axCohComplete(M, Tp, assoc AtS, eq F[TL] = RHS [AtS'] .)
8593    = (eq F[TL] = RHS [AtS'] .)
8594      (eq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8595         = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .)
8596      (eq F[qid("X@@@:" + string(getKind(M, Tp))), TL]
8597         = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) [AtS'] .)
8598      (eq F[TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8599         = getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) [AtS'] .)
8600    if not comm in AtS
8601    [owise] .
8602  ceq axCohComplete(M, Tp, assoc AtS, ceq F[TL] = RHS if Cond [AtS'] .)
8603    = (ceq F[TL] = RHS if Cond [AtS'] .)
8604      (ceq F[qid("X@@@:" + string(getKind(M, Tp))), TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8605         = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .)
8606      (ceq F[qid("X@@@:" + string(getKind(M, Tp))), TL]
8607         = getTerm(metaNormalize(M, F[qid("X@@@:" + string(getKind(M, Tp))), RHS])) if Cond [AtS'] .)
8608      (ceq F[TL, qid("Y@@@:" + string(getKind(M, Tp)))]
8609         = getTerm(metaNormalize(M, F[RHS, qid("Y@@@:" + string(getKind(M, Tp)))])) if Cond [AtS'] .)
8610    if not comm in AtS
8611    [owise] .
8612endfm
8613
8614*** To parse some input using the built-in function \texttt{metaParse}, we
8615*** need to give the metarepresentation of the signature in which the input is
8616*** going to be parsed.
8617
8618*** But we do not need to give the complete metarepresentation of such a
8619*** module. In modules including \texttt{META-LEVEL} it is possible to define
8620*** terms of sort \texttt{Module} that import built-in modules or any module
8621*** introduced at the ``object level'' of Core Maude. In this way, it is
8622*** possible to get the equivalent effect of having the explicit
8623*** metarepresentation of a module by declaring a constant and adding an
8624*** equation identifying such a constant with the metarepresentation of an
8625*** extended module that imports the original module at the object level.
8626
8627*** The declaration of constructors for bubble sorts at the object level is
8628*** not supported in the current version of Core Maude. The \texttt{special}
8629*** attributes linking the constructors for the bubble sorts to the built-in
8630*** ones are only supported at the metalevel, that is, the declarations of the
8631*** constructor operators for bubble sorts have to be given in the
8632*** metarepresentation of a module.
8633
8634*** To allow the greatest generality and flexibility in future extensions of
8635*** Full Maude, we have declared its signature as a module
8636*** \texttt{FULL-MAUDE-SIGN}. Then, in the following module
8637*** \texttt{META-FULL-MAUDE-SIGN} we declare a constant \texttt{GRAMMAR} of
8638*** sort \texttt{FModule}, and we give an equation identifying such constant
8639*** with the metarepresentation of a module \texttt{GRAMMAR} in which there is
8640*** a declaration importing \texttt{FULL-MAUDE-SIGN}. Declarations for the
8641*** constructors of the bubble sorts are also included in this module. Note
8642*** that the bubble sorts \texttt{@Token@}, \texttt{@Bubble@},
8643*** \texttt{@SortToken@}, and \texttt{@NeTokenList@} are declared in the
8644*** module \texttt{SIGN\&VIEW-EXPR}, which is imported by
8645*** \texttt{FULL-MAUDE-SIGN}. These sorts are used in the declarations
8646*** describing the syntax of the system.
8647
8648-------------------------------------------------------------------------------
8649*******************************************************************************
8650-------------------------------------------------------------------------------
8651
8652fmod META-FULL-MAUDE-SIGN is
8653---  including META-LEVEL + PRE-VARIANT .
8654  including META-LEVEL .
8655  including UNIT .
8656
8657  op BUBBLES : -> FModule .
8658  op GRAMMAR : -> FModule [memo] .
8659
8660  eq BUBBLES
8661    = (fmod 'GRAMMAR is
8662        including 'QID-LIST .
8663        sorts none .
8664        none
8665        op 'token : 'Qid -> '@Token@
8666             [special(
8667               (id-hook('Bubble, '1 '1)
8668                op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] .
8669        op 'viewToken : 'Qid -> '@ViewToken@
8670             [special(
8671               (id-hook('Bubble, '1 '1)
8672                op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] .
8673        op 'sortToken : 'Qid -> '@SortToken@
8674             [special(
8675               (id-hook('Bubble, '1 '1)
8676                op-hook('qidSymbol, '<Qids>, nil, 'Qid)
8677                id-hook('Exclude, '`[ '`] '< 'to '`, '. '`( '`) '`{ '`} ': '|
8678                                  'ditto 'precedence 'prec 'gather
8679                                  'assoc 'associative 'comm 'commutative
8680                                  'ctor 'constructor 'id: 'strat 'strategy
8681                                  'poly 'memo 'memoization 'iter 'frozen
8682                                  'config 'object 'msg 'metadata 'nonexec 'variant)))] .
8683        op 'neTokenList : 'QidList -> '@NeTokenList@
8684             [special(
8685               (id-hook('Bubble, '1 '-1 '`( '`))
8686                op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList)
8687                op-hook('qidSymbol, '<Qids>, nil, 'Qid)
8688                id-hook('Exclude, '.)))] .
8689        op 'bubble : 'QidList -> '@Bubble@
8690             [special(
8691               (id-hook('Bubble, '1 '-1 '`( '`))
8692                op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList)
8693                op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] .
8694        none
8695        none
8696     endfm) .
8697
8698  eq GRAMMAR = addImports((including 'FULL-MAUDE-SIGN .), BUBBLES) .
8699
8700endfm
8701
8702-------------------------------------------------------------------------------
8703*******************************************************************************
8704-------------------------------------------------------------------------------
8705
8706
8707*** The \texttt{GRAMMAR} module will be used in calls to the \texttt{metaParse}
8708*** function in order to get the input parsed in this signature. Note that
8709*** this module is not the data type in which we shall represent the inputs.
8710*** From the call to \texttt{metaParse} we shall get a term representing the
8711*** parse tree of the input. This term will then be transformed into terms of
8712*** other appropriate data types if necessary.
8713
8714*** Future extensions to Full Maude will require extending the signature as
8715*** well. The addition of new commands, new module expressions, or additions
8716*** of any other kind will require adding new declarations to the present Full
8717*** Maude signature and defining the corresponding extensions to the data
8718*** types and functions to deal with the new cases introduced by the
8719*** extensions.
8720
8721-------------------------------------------------------------------------------
8722*******************************************************************************
8723-------------------------------------------------------------------------------
8724
8725***
8726*** The Abstract Data Type \texttt{View}
8727***
8728
8729*** In this section we present the data type \texttt{View} for views.
8730*** Basically, the data elements of sort \texttt{View} are composed by the
8731*** name of the view, the names of the source and target units, and a set of
8732*** maps representing the maps asserting how the given target unit is claimed
8733*** to satisfy the source theory (see Section~\ref{Views}).
8734
8735*** Internally, renaming maps are considered to be a particular case of view
8736*** maps. The sort \texttt{ViewMap} is declared as a supersort of
8737*** \texttt{Map}. The only kind of maps in sort \texttt{ViewMap} not in sort
8738*** \texttt{Map} are maps of operators going to derived operators. We start
8739*** introducing the declarations for renaming maps and sTS of renaming maps
8740*** in Section~\ref{renaming-maps}, we then introduce view maps and sTS of
8741*** view maps in Section~\ref{view-maps}, and finally we introduce the sort
8742*** \texttt{View}, its constructor, and some operations on it in
8743*** Section~\ref{viewADT}.
8744
8745***
8746*** View Maps
8747***
8748
8749*** In addition to the maps of sort \texttt{Renaming},
8750*** in views there can also be maps from operators to derived
8751*** operators, that is, terms with variables (see Section~\ref{Views}). Maps
8752*** of this kind are given with the constructor \texttt{op_to`term_}, which, in
8753*** addition to the source and target terms, takes the set of variable
8754*** declarations for the variables used in the map. The source term must be of
8755*** the form $\texttt{F(X}_1\texttt{,}\ldots,\texttt{X}_n\texttt{)}$, where
8756*** \texttt{F} is an operator name declared with $n$ arguments of sorts in the
8757*** connected components of the variables $\texttt{X}_1\ldots\texttt{X}_n$,
8758*** respectively. We will see in Section~\ref{view-processing} how in the
8759*** initial processing of a view the variables declared in it are associated
8760*** to each of the maps in which they are used.
8761
8762
8763***
8764*** Views
8765***
8766
8767*** The \texttt{View} sort is introduced in the following module
8768*** \texttt{VIEW}.  In addition to the constructor for views (\texttt{view}),
8769*** selector functions are added for each of the components of a
8770*** view (\texttt{name}, \texttt{source}, \texttt{target}, and
8771*** \texttt{mapSet}), and a constant \texttt{emptyView}, which is identified
8772*** in an equation with the empty view, is defined.
8773
8774*** Although the declaration of the constructor for views includes an argument
8775*** for the list of parameters, parameterized views are not handled yet, so at
8776*** present this argument must be set to the \texttt{nil}.
8777
8778-------------------------------------------------------------------------------
8779*******************************************************************************
8780-------------------------------------------------------------------------------
8781
8782fmod EXT-RENAMING is
8783  pr META-MODULE .
8784
8785  op op_to term_ : Term Term -> Renaming .
8786endfm
8787
8788-------------------------------------------------------------------------------
8789*******************************************************************************
8790-------------------------------------------------------------------------------
8791
8792fmod VIEW is
8793  ex META-VIEW .
8794  pr VIEW-EXPR .
8795  inc FMAP .
8796
8797  *** mappings
8798  op class_to_. : Sort Sort -> SortMapping .
8799  op attr_._to_. : Qid Sort Qid -> OpMapping .
8800  op msg_to_. : Qid Qid -> OpMapping .
8801  op msg_:_->_to_. : Qid TypeList Sort Qid -> OpMapping .
8802
8803  subsort ViewExp < Header .
8804
8805  op null : -> View [ctor] .
8806  op viewError : QidList -> [View] [ctor format (r o)] .
8807
8808  eq VE{(nil).ParameterDeclList} = VE .
8809
8810  vars A A' F F' Q Q' : Qid .
8811  var QIL : QidList .
8812  var VH : Header .
8813  var VE : ViewExp .
8814  vars PDL PDL' : ParameterDeclList .
8815  vars ME ME' ME'' : ModuleExpression .
8816  vars SMS SMS' : SortMappingSet .
8817  vars OMS OMS' : OpMappingSet .
8818  vars S S' C : Sort .
8819  var  Ty : Type .
8820  var  TyL : TypeList .
8821  vars T T' : Term .
8822
8823  op maps2rens : SortMappingSet -> RenamingSet .
8824  op maps2rens : OpMappingSet -> RenamingSet .
8825  eq maps2rens(sort S to S' . SMS) = sort S to S', maps2rens(SMS) .
8826  eq maps2rens(class S to S' . SMS) = class S to S', maps2rens(SMS) .
8827  eq maps2rens((none).SortMappingSet) = none .
8828
8829  eq maps2rens(op F to F' . OMS) = op F to F' [none], maps2rens(OMS) .
8830  eq maps2rens(op F : TyL -> Ty to F' . OMS) = op F : TyL -> Ty to F' [none], maps2rens(OMS) .
8831  eq maps2rens(op T to  term T' . OMS) = op T to term T', maps2rens(OMS) .
8832  eq maps2rens(msg F to F' . OMS) = msg F to F' [none], maps2rens(OMS) .
8833  eq maps2rens(msg F : TyL -> Ty to F' . OMS) = msg F : TyL -> Ty to F' [none], maps2rens(OMS) .
8834  eq maps2rens(attr A . C to A' . OMS) = attr A . C to A', maps2rens(OMS) .
8835  eq maps2rens((none).OpMappingSet) = none .
8836
8837*** projection functions
8838  op getName : View -> Qid .
8839  eq getName(view VE from ME to ME' is SMS OMS endv) = VE [owise] .
8840  eq getName(view VE{PDL} from ME to ME' is SMS OMS endv) = VE .
8841
8842  op getPars : [View] -> ParameterDeclList .
8843  eq getPars(view VE from ME to ME' is SMS OMS endv) = nil [owise] .
8844  eq getPars(view VE{PDL} from ME to ME' is SMS OMS endv) = PDL .
8845  eq getPars(viewError(QIL)) = nil .
8846
8847  eq getFrom(view VH from ME to ME' is SMS OMS endv) = ME .
8848  eq getTo(view VH from ME to ME' is SMS OMS endv) = ME' .
8849  eq getSortMappings(view VH from ME to ME' is SMS OMS endv) = SMS .
8850  eq getOpMappings(view VH from ME to ME' is SMS OMS endv) = OMS .
8851
8852*** injection functions
8853  op setName : View Qid -> View .
8854  eq setName(view Q from ME to ME' is SMS OMS endv, Q')
8855    = view Q' from ME to ME' is SMS OMS endv .
8856  eq setName(view Q{PDL} from ME to ME' is SMS OMS endv, VH) = view VH{PDL} from ME to ME' is SMS OMS endv .
8857  eq setName(viewError(QIL), VE) = viewError(QIL) .
8858
8859  op setPars : [View] ParameterDeclList -> [View] .
8860  eq setPars(view VH from ME to ME' is SMS OMS endv, PDL)
8861    = view VH{PDL} from ME to ME' is SMS OMS endv [owise] .
8862  eq setPars(view VH{PDL} from ME to ME' is SMS OMS endv, PDL') = view VH{PDL'} from ME to ME' is SMS OMS endv .
8863  eq setPars(viewError(QIL), PDL) = viewError(QIL) .
8864
8865  op setFrom : View ModuleExpression -> View .
8866  eq setFrom(view VH from ME to ME' is SMS OMS endv, ME'')
8867    = view VH from ME'' to ME' is SMS OMS endv .
8868  eq setFrom(viewError(QIL), ME) = viewError(QIL) .
8869
8870  op setTo : View ModuleExpression -> View .
8871  eq setTo(view VH from ME to ME' is SMS OMS endv, ME'')
8872    = view VH from ME to ME'' is SMS OMS endv .
8873  eq setTo(viewError(QIL), ME) = viewError(QIL) .
8874
8875  op setSortMappings : View SortMappingSet -> View .
8876  eq setSortMappings(view VH from ME to ME' is SMS OMS endv, SMS')
8877    = view VH from ME to ME' is SMS' OMS endv .
8878  eq setSortMappings(viewError(QIL), SMS') = viewError(QIL) .
8879
8880  op setOpMappings : View OpMappingSet -> View .
8881  eq setOpMappings(view VH from ME to ME' is SMS OMS endv, OMS')
8882    = view VH from ME to ME' is SMS OMS' endv .
8883  eq setOpMappings(viewError(QIL), OMS') = viewError(QIL) .
8884
8885  op emptyView : Qid ModuleExpression ModuleExpression -> View .
8886  eq emptyView(VH, ME, ME') = view VH from ME to ME' is none none endv .
8887endfm
8888
8889-------------------------------------------------------------------------------
8890*******************************************************************************
8891-------------------------------------------------------------------------------
8892
8893***
8894*** The Abstract Data Type \texttt{Database}
8895***
8896
8897*** In this section we present the data type \texttt{Database}, which will be
8898*** used to store information about the units and views in the system. Before
8899*** discussing this data type in Section~\ref{databaseADT}, we present the
8900*** predefined units added in Full Maude to those already available in Core
8901*** Maude.
8902
8903***
8904*** Non-Built-In Predefined Modules
8905***
8906
8907*** As we shall see in the following section, except for the
8908*** \texttt{LOOP-MODE} module, all the predefined modules that are available
8909*** in Core Maude are also available in Full Maude. In addition to these Core
8910*** Maude predefined modules, in Full Maude there are some additional
8911*** predefined units. In the present system, the only units with which the
8912*** database is initialized are the functional theory \texttt{TRIV}, the
8913*** module \texttt{CONFIGURATION}, and the module \texttt{UP}, which will be
8914*** used to evaluate the \texttt{up} functions. We shall see in
8915*** Section~\ref{main-module} how new predefined modules can be added to the
8916*** initial database.
8917
8918-------------------------------------------------------------------------------
8919*******************************************************************************
8920-------------------------------------------------------------------------------
8921
8922fmod PREDEF-UNITS is
8923  pr UNIT .
8924
8925*** The following module \texttt{UP} contains the necessary declarations to
8926*** be able to parse the \texttt{up} functions presented in
8927*** Section~\ref{structured-specifications}. We shall see in
8928*** Section~\ref{evaluation} how a declaration importing the following module
8929*** \texttt{UP} is added to all the modules importing the predefined module
8930*** \texttt{META-LEVEL}. With this declaration, it is possible to parse the
8931*** \texttt{up} commands in the bubbles of such modules or in commands being
8932*** evaluated in such modules. We shall see in Section~\ref{bubble-parsing}
8933*** how these commands are then evaluated.
8934
8935  op #UP# : -> FModule [memo] .
8936  eq #UP#
8937    = (fmod '#UP# is
8938        including 'QID-LIST .
8939        including 'MOD-EXPRS .
8940        sorts none .
8941        none
8942        op 'upTerm : '@ModExp@ '@Bubble@ -> 'Term [none] .
8943        op 'upModule : '@ModExp@ -> 'Module [none] .
8944        op '`[_`] : '@Token@ -> 'Module [none] .
8945        op 'token : 'Qid -> '@Token@
8946             [special(
8947               (id-hook('Bubble, '1 '1)
8948                op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] .
8949        op 'viewToken : 'Qid -> '@ViewToken@
8950             [special(
8951               (id-hook('Bubble, '1 '1)
8952                op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] .
8953        op 'sortToken : 'Qid -> '@SortToken@
8954             [special(
8955               (id-hook('Bubble, '1 '1)
8956                op-hook('qidSymbol, '<Qids>, nil, 'Qid)
8957                id-hook('Exclude, '`[ '`] '< 'to '`, '. '`( '`) '`{ '`} ':
8958                                  'ditto 'precedence 'prec 'gather
8959                                  'assoc 'associative 'comm 'commutative
8960                                  'ctor 'constructor 'id: 'strat 'strategy
8961                                  'poly 'memo 'memoization 'iter 'frozen
8962                                  'config 'object 'msg 'metadata 'nonexec 'variant)))] .
8963        op 'neTokenList : 'QidList -> '@NeTokenList@
8964             [special(
8965               (id-hook('Bubble, '1 '-1 '`( '`))
8966                op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList)
8967                op-hook('qidSymbol, '<Qids>, nil, 'Qid)
8968                id-hook('Exclude, '.)))] .
8969        op 'bubble : 'QidList -> '@Bubble@
8970             [special(
8971               (id-hook('Bubble, '1 '-1 '`( '`))
8972                op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList)
8973                op-hook('qidSymbol, '<Qids>, nil, 'Qid)))] .
8974        none
8975        none
8976     endfm) .
8977endfm
8978
8979-------------------------------------------------------------------------------
8980*******************************************************************************
8981-------------------------------------------------------------------------------
8982
8983***
8984*** 7 The Evaluation of Views
8985***
8986
8987*** Before being entered into the database, besides containing bubbles, views
8988*** have a somewhat different structure from that of the views given in
8989*** Section~\ref{viewADT}. We introduce in the following module a sort
8990*** \texttt{PreView} with constructor \texttt{view}, which is declared as the
8991*** constructor for views of sort \texttt{View}, but with an additional
8992*** argument, namely, a set of variable declarations to hold the declarations
8993*** of variables in the view. During the processing of views (see
8994*** Section~\ref{view-processing}), which takes place once the parsing process
8995*** has concluded, these variables are associated with the corresponding maps
8996*** where they are used, generating a term of sort \texttt{View}.
8997
8998-------------------------------------------------------------------------------
8999*******************************************************************************
9000-------------------------------------------------------------------------------
9001
9002fmod PRE-VIEW is
9003  pr VIEW .
9004
9005  sort PreView .
9006  op preview_from_to_is___endpv : Header ModuleExpression
9007       ModuleExpression OpDeclSet SortMappingSet OpMappingSet -> PreView
9008       [ctor format (nir! o r! o r! o r! o o o r! o)] .
9009  op null : -> PreView .
9010
9011  op getName : PreView -> ViewExp .
9012  op getPars : PreView -> ParameterDeclList .
9013  op getFrom : PreView -> ModuleExpression .
9014  op getTo : PreView -> ModuleExpression .
9015  op getVars : PreView -> OpDeclSet .
9016  op getSortMappings : PreView -> SortMappingSet .
9017  op getOpMappings : PreView -> OpMappingSet .
9018
9019  var  QI : Qid .
9020  vars ME ME' : ModuleExpression .
9021  var  VE : ViewExp .
9022  var  VH : Header .
9023  vars PDL PDL' : ParameterDeclList .
9024  vars VDS VDS' : OpDeclSet .
9025  vars SMS SMS' : SortMappingSet .
9026  vars OMS OMS' : OpMappingSet .
9027
9028  eq getName(preview VE from ME to ME' is VDS SMS OMS endpv) = VE .
9029  eq getName(preview VE{PDL} from ME to ME' is VDS SMS OMS endpv) = VE .
9030  eq getPars(preview VE from ME to ME' is VDS SMS OMS endpv) = nil .
9031  eq getPars(preview VE{PDL} from ME to ME' is VDS SMS OMS endpv) = PDL .
9032  eq getFrom(preview VH from ME to ME' is VDS SMS OMS endpv) = ME .
9033  eq getTo(preview VH from ME to ME' is VDS SMS OMS endpv) = ME' .
9034  eq getVars(preview VH from ME to ME' is VDS SMS OMS endpv) = VDS .
9035  eq getSortMappings(preview VH from ME to ME' is VDS SMS OMS endpv) = SMS .
9036  eq getOpMappings(preview VH from ME to ME' is VDS SMS OMS endpv) = OMS .
9037
9038*** The following functions can be used to add new declarations to the set of
9039*** declarations already in a preview.
9040
9041  op addMaps : SortMappingSet PreView -> PreView .
9042  op addMaps : OpMappingSet PreView -> PreView .
9043  op addVars : OpDeclSet PreView -> PreView .
9044
9045  eq addMaps(SMS, preview VH from ME to ME' is VDS SMS' OMS endpv)
9046    = preview VH from ME to ME' is VDS (SMS SMS') OMS endpv .
9047  eq addMaps(OMS, preview VH from ME to ME' is VDS SMS OMS' endpv)
9048    = preview VH from ME to ME' is VDS SMS (OMS OMS') endpv .
9049
9050  eq addVars(VDS, preview VH from ME to ME' is VDS' SMS OMS endpv)
9051    = preview VH from ME to ME' is (VDS VDS') SMS OMS endpv .
9052
9053  op setPars : PreView ParameterDeclList -> PreView .
9054  eq setPars(preview VE from ME to ME' is VDS SMS OMS endpv, PDL)
9055    = preview VE{PDL} from ME to ME' is VDS SMS OMS endpv .
9056  eq setPars(preview VE{PDL} from ME to ME' is VDS SMS OMS endpv, PDL')
9057    = preview VE{PDL'} from ME to ME' is VDS SMS OMS endpv .
9058
9059  op emptyPreView : Qid ModuleExpression ModuleExpression -> PreView .
9060  eq emptyPreView(QI, ME, ME')
9061    = preview QI from ME to ME' is none none none endpv .
9062endfm
9063
9064-------------------------------------------------------------------------------
9065*******************************************************************************
9066-------------------------------------------------------------------------------
9067
9068***
9069*** The Database
9070***
9071
9072*** In order to be able to refer to modules by name, which is extremely useful
9073*** for module definition purposes at the user level, the evaluation of module
9074*** expressions takes place in the context of a database, in which we keep
9075*** information about the modules already introduced in the system, and also
9076*** about those modules generated internally.  This information is stored as
9077*** a set of elements of sort \texttt{ModuleInfo} and \texttt{ViewInfo}, in
9078*** which we hold, respectively, the information concerning units and views.
9079*** For each unit we save:
9080*** \begin{itemize}
9081*** \item Its original form, as introduced by the user, or, in case of an
9082***       internally generated unit, as generated from the original form of
9083***       some other unit.
9084*** \item Its internal representation, in which variables have been renamed
9085***       to avoid collisions with the names of variables in other units in
9086***       the same hierarchy.  In the case of object-oriented units, we store
9087***       its equivalent system module, that is, the result of transforming
9088***       it into a system module.
9089*** \item Its signature, which is given as a functional module of sort
9090***       \texttt{FModule} with no axioms, ready to be used in calls to
9091***       \texttt{metaParse}. There can only be importation declarations
9092***       including built-in modules in this module. These are the only
9093***       inclusions handled by the Core Maude engine.
9094*** \item Its flattened version, for which, as for signatures, only the
9095***       importation of built-in modules is left unevaluated.
9096*** \end{itemize}
9097*** For each view we keep its name and the view itself.
9098
9099*** As a simple mechanism to keep the database consistent, for each unit we
9100*** maintain the list of names of all the units and views ``depending'' on it.
9101*** Similarly, for each view we maintain the list of names of all the units
9102*** ``depending'' on it. The idea is that if a unit or view is redefined or
9103*** removed, all those units and/or views depending on it will also be
9104*** removed. This dependency does not only mean direct importation. For
9105*** example, the module resulting from the renaming of some module also
9106*** depends on the module being renamed; the instantiation of a parameterized
9107*** module also depends on the parameterized module and on all the views used
9108*** in its instantiation; a view depends on its source and target units, etc.
9109*** This dependency is transitive: if a module, theory, or view has to be
9110*** removed, all the units and/or views depending on them will be removed as
9111*** well. The dependencies derived from the module expressions themselves are
9112*** established by the function \texttt{setUpModExpDeps}. The function
9113*** \texttt{setUpModuleDeps} calls \texttt{setUpModExpDeps},
9114*** and then \texttt{setUpImportSetDeps} to add the \emph{back
9115*** references} in the modules being imported. The function
9116*** \texttt{setUpViewDeps} sTS up the back references for the views
9117*** being introduced.
9118
9119*** In addition to this set of information cells for units and views, we also
9120*** keep lists with the names of all the units and views in the database, and
9121*** a list of quoted identifiers in which we store the messages generated
9122*** during the process of treatment of the inputs in order to simplify the
9123*** communication with the read-eval-print loop process.
9124
9125-------------------------------------------------------------------------------
9126*******************************************************************************
9127-------------------------------------------------------------------------------
9128
9129view ModuleName from TRIV to MOD-NAME is
9130  sort Elt to ModuleName .
9131endv
9132
9133view ViewExp from TRIV to VIEW-EXPR is
9134  sort Elt to ViewExp .
9135endv
9136
9137view ParameterDecl from TRIV to META-MODULE is
9138  sort Elt to ParameterDecl .
9139endv
9140
9141fmod INFO is
9142  pr VIEW .
9143  pr DEFAULT-VALUE{Term} .
9144  pr (SET * (op _`,_ to _._,
9145             op empty to emptyModuleNameSet,
9146             op insert to insertModuleNameSet,
9147             op delete to deleteModuleNameSet,
9148             op _in_ to _inModuleNameSet_,
9149             op |_| to |_|ModuleNameSet,
9150             op $card to $cardModuleNameSet,
9151             op union to unionModuleNameSet,
9152             op intersection to intersectionModuleNameSet,
9153             op $intersect to $intersectModuleNameSet,
9154             op _\_ to _\ModuleNameSet_,
9155             op $diff to $diffModuleNameSet,
9156             op _subset_ to _subsetModuleNameSet_,
9157             op _psubset_ to _psubsetModuleNameSet_)){ModuleName} .
9158  pr (SET * (op _`,_ to _#_,
9159             op empty to emptyViewExpSet,
9160             op insert to insertViewExpSet,
9161             op delete to deleteViewExpSet,
9162             op _in_ to _inViewExpSet_,
9163             op |_| to |_|ViewExprSet,
9164             op $card to $cardViewExprSet,
9165             op union to unionViewExprSet,
9166             op intersection to intersectionViewExprSet,
9167             op $intersect to $intersectViewExprSet,
9168             op _\_ to _\ViewExprSet_,
9169             op $diff to $diffViewExprSet,
9170             op _subset_ to _subsetViewExprSet_,
9171             op _psubset_ to _psubsetViewExprSet_)){ViewExp} .
9172  pr (SET * (op _`,_ to _._)){ParameterDecl} .
9173
9174  var  MN : ModuleName .
9175  var  MNS : Set{ModuleName} .
9176
9177  op remove : Set{ModuleName} ModuleName -> Set{ModuleName} .
9178  eq remove(MN . MNS, MN) = remove(MNS, MN) .
9179  eq remove(MNS, MN) = MNS [owise] .
9180
9181  sort ModuleInfo .
9182  op <_;_;_;_;_;_;_;_> : ModuleName Default{Term} Module Module Module
9183       OpDeclSet Set{ModuleName} Set{ViewExp} -> ModuleInfo
9184     [ctor
9185      format
9186        (nig o g n+++io g nio g nio g nio g nio g nio g nio n---ig o)] .
9187  op <_;_;_;_;_;_;_;_> : ModuleName Module Module Module Module
9188       OpDeclSet Set{ModuleName} Set{ViewExp} -> ModuleInfo
9189     [ctor
9190      format
9191      (nig ur! g n+++io g nio g nio g nio g nio g nio g nio n---ig o)] .
9192
9193  *** - Modules can be introduced by the user or can be generated internally.
9194  ***   When introduced by the user the 2nd arg. keeps the term representation
9195  ***   of the module as given, so that it can be recompiled later. If the
9196  ***   module is generated internally as the result of the evaluation of a
9197  ***   module expression, then this second arg. will be null, the default
9198  ***   term value. The user can also enter modules with the procModule
9199  ***   function, providing then the metarepresentation of a module, which
9200  ***   is directly stored in the database as the 2nd arg. of one of these
9201  ***   ModuleInfo units of the second kind. This is useful for the ITP for
9202  ***   example, where the interaction with the database takes place at the
9203  ***   metalevel and the modules given by the "user" are already at the
9204  ***   metalevel but still wants the same treatment.
9205  *** - The sixth arg. stores the variables (corresponding ops.) in the top
9206  ***   module.
9207
9208  sort ViewInfo .
9209  op <_;_;_;_;_> : ViewExp Default{Term} View Set{ModuleName}
9210       Set{ViewExp} -> ViewInfo
9211       [ctor format (nig o g n+++io g nio g nio g nio n---ig o)] .
9212  op <_;_;_;_;_> :
9213       ViewExp View View Set{ModuleName} Set{ViewExp} -> ViewInfo
9214       [ctor format (nig o g n+++io g nio g nio g nio n---ig o)] .
9215
9216endfm
9217
9218view ModuleInfo from TRIV to INFO is
9219  sort Elt to ModuleInfo .
9220endv
9221
9222view ViewInfo from TRIV to INFO is
9223  sort Elt to ViewInfo .
9224endv
9225
9226fmod DATABASE-DECLS is
9227  pr (SET * (op _`,_ to __, op empty to emptyInfoSet)){ModuleInfo} .
9228  pr (SET * (op _`,_ to __, op empty to emptyInfoSet)){ViewInfo} .
9229
9230  sort Database .
9231  op db :
9232     Set{ModuleInfo}  *** module info tuples
9233     Set{ModuleName}  *** names of the modules in the database
9234     Set{ViewInfo}    *** view info tuples
9235     Set{ViewExp}     *** names of the views in the db
9236     Set{ModuleName}  *** modules with set protect on (by default empty)
9237     Set{ModuleName}  *** modules with set extend on (by default empty)
9238     Set{ModuleName}  *** modules with set include on (by default empty)
9239     QidList
9240       -> Database
9241     [ctor
9242      format (nib i++o)] .
9243
9244  ops getDefPrs getDefExs getDefIncs : Database -> Set{ModuleName} .
9245  eq getDefPrs(
9246        db(MIS:Set{ModuleInfo}, MNS:Set{ModuleName}, VIS:Set{ViewInfo},
9247           VES:Set{ViewExp}, MNS':Set{ModuleName}, MNS'':Set{ModuleName},
9248           MNS3:Set{ModuleName}, QIL:QidList))
9249    = MNS':Set{ModuleName} .
9250  eq getDefExs(
9251        db(MIS:Set{ModuleInfo}, MNS:Set{ModuleName}, VIS:Set{ViewInfo},
9252           VES:Set{ViewExp}, MNS':Set{ModuleName}, MNS'':Set{ModuleName},
9253           MNS3:Set{ModuleName}, QIL:QidList))
9254    = MNS'':Set{ModuleName} .
9255  eq getDefIncs(
9256        db(MIS:Set{ModuleInfo}, MNS:Set{ModuleName}, VIS:Set{ViewInfo},
9257           VES:Set{ViewExp}, MNS':Set{ModuleName}, MNS'':Set{ModuleName},
9258           MNS3:Set{ModuleName}, QIL:QidList))
9259    = MNS3:Set{ModuleName} .
9260endfm
9261
9262view Database from TRIV to DATABASE-DECLS is
9263  sort Elt to Database .
9264endv
9265
9266view ModuleExpression from TRIV to META-MODULE is
9267  sort Elt to ModuleExpression .
9268endv
9269
9270fmod DATABASE is
9271  pr (2TUPLE * (op `(_`,_`) to <_;_>,
9272                op p1_ to database,
9273                op p2_ to modExp)) {Database, ModuleExpression} .
9274  pr PRE-VIEW .
9275  pr UNIT .
9276  pr VIEW-EXPR-TO-QID .
9277
9278  op evalModule : Module OpDeclSet Database -> Database .
9279  *** its definition is in the module EVALUATION
9280
9281  op procModule : Qid Database -> Database .
9282  op procView : Qid Database -> Database .
9283  op procView : View Database -> Database .
9284  *** their definitions are in the modules UNIT-PROCESSING and VIEW-PROCESSING
9285
9286  op evalModExp : ModuleExpression Database -> Tuple{Database, ModuleExpression} .
9287  *** its definition is in the module MOD-EXPR-EVAL
9288
9289  vars QI X Y F : Qid .
9290  vars QIL QIL' : QidList .
9291  vars NQIL NQIL' : NeQidList .
9292  vars VE VE' VE'' : ViewExp .
9293  vars VES VES' VES'' VES3 : Set{ViewExp} .
9294  vars MIS MIS' : Set{ModuleInfo} .
9295  var  VIS : Set{ViewInfo} .
9296  vars MNS MNS' MNS'' MNS3 MNS4 MNS5 MNS6 : Set{ModuleName} .
9297  vars PL PL' : ParameterList .
9298  vars PDS PDS' PDS'' : Set{ParameterDecl} .
9299  var  PDL : ParameterDeclList .
9300  var  PD : ParameterDecl .
9301  vars ME ME' : ModuleExpression .
9302  vars VI VI' : View .
9303  var  SMS : SortMappingSet .
9304  var  OMS : OpMappingSet .
9305  vars PU PU' U U' U'' U3 U4 : Module .
9306  var  M : Module .
9307  var  DB : Database .
9308  vars IL IL' : ImportList .
9309  var  VIf : ViewInfo .
9310  var  UIf : ModuleInfo .
9311  vars OPDS VDS VDS' : OpDeclSet .
9312  var  PV : PreView .
9313  vars T T' : Term .
9314  var  DT : Default{Term} .
9315  var  NL : IntList .
9316  var  TyL : TypeList .
9317  var  Ty : Type .
9318  var  AtS : AttrSet .
9319  var  B : Bool .
9320  var  I : Import .
9321  var  MN MN' : ModuleName .
9322
9323  ops dincluded : ModuleExpression ImportList -> Bool .
9324
9325  eq dincluded(ME, IL (protecting ME .) IL') = true .
9326  eq dincluded(ME, IL (extending ME .) IL') = true .
9327  eq dincluded(ME, IL (including ME .) IL') = true .
9328  eq dincluded(ME, IL) = false [owise] .
9329
9330  ops included includedAux : ModuleExpression ImportList Database -> Bool .
9331
9332  eq included(ME, IL (protecting ME .) IL', DB) = true .
9333  eq included(ME, IL (extending ME .) IL', DB) = true .
9334  eq included(ME, IL (including ME .) IL', DB) = true .
9335  eq included(ME, nil, DB) = false .
9336  eq included(ME, IL, DB) = includedAux(ME, IL, DB) [owise] .
9337
9338  eq includedAux(ME, I IL, DB)
9339    = included(ME, getImports(getTopModule(moduleName(I), DB)), DB)
9340      or-else includedAux(ME, IL, DB) .
9341  eq includedAux(ME, nil, DB) = false .
9342
9343  op defImports : Module Database -> ImportList .
9344  op defImports : ImportList ImportList Set{ModuleName} Set{ModuleName}
9345       Set{ModuleName} -> ImportList .
9346
9347  eq defImports(M, DB)
9348    = if theory(M)
9349      then nil
9350      else defImports(getImports(M), nil,
9351             getDefPrs(DB), getDefExs(DB), getDefIncs(DB))
9352      fi .
9353
9354  eq defImports(IL, IL', MN . MNS, MNS', MNS'')
9355    = if dincluded(MN, IL IL')
9356      then defImports(IL, IL', MNS, MNS', MNS'')
9357      else defImports(IL, IL' (protecting MN .), MNS, MNS', MNS'')
9358      fi .
9359  eq defImports(IL, IL', MNS, MN . MNS', MNS'')
9360    = if dincluded(MN, IL IL')
9361      then defImports(IL, IL', MNS, MNS', MNS'')
9362      else defImports(IL, IL' (extending MN .), MNS, MNS', MNS'')
9363      fi .
9364  eq defImports(IL, IL', MNS, MNS', MN . MNS'')
9365    = if dincluded(MN, IL IL')
9366      then defImports(IL, IL', MNS, MNS', MNS'')
9367      else defImports(IL, IL' (including MN .), MNS, MNS', MNS'')
9368      fi .
9369  eq defImports(IL, IL',
9370       emptyModuleNameSet, emptyModuleNameSet, emptyModuleNameSet)
9371    = IL' .
9372
9373*** The constant \texttt{emptyDatabase} denotes the empty database, and there
9374*** are predicates \texttt{viewInDatabase} and \texttt{unitInDb} to check,
9375*** respectively, whether a view and a unit are in a database or not.
9376
9377  op emptyDatabase : -> Database .
9378  eq emptyDatabase
9379    = db(emptyInfoSet, emptyModuleNameSet, emptyInfoSet, emptyViewExpSet,
9380         emptyModuleNameSet, emptyModuleNameSet, 'BOOL, nil) .
9381
9382  op unitInDb : ModuleName Database -> Bool .
9383  eq unitInDb(MN, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
9384    = MN inModuleNameSet MNS .
9385
9386  op viewInDb : ViewExp Database -> Bool .
9387  eq viewInDb(VE, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
9388    = VE inViewExpSet VES .
9389
9390  op includeBOOL : Database -> Bool .
9391  eq includeBOOL(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
9392    = 'BOOL inModuleNameSet MNS' .
9393
9394*** If a module, theory, or view is being redefined, that is, if there was
9395*** already in the database a module, theory, or view with the same name,
9396*** then all the units and/or views depending on it are removed using the
9397*** functions \texttt{delModules} and \texttt{delViews}. Removing a view
9398*** or a unit from the database means removing its info cell from the set of
9399*** cells in the database. Those entered by the user are not completely
9400*** removed, their term form is saved so that it can be recompiled later.
9401
9402  op delModules : Set{ModuleName} Database -> Database .
9403  op delViews : Set{ViewExp} Database -> Database .
9404
9405  eq delModules((MN . MNS),
9406       db(< MN ; T ; U ; U' ; U'' ; VDS ; MNS' ; VES > MIS,
9407          MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))
9408    = delModules((MNS . MNS'),
9409          delViews(VES,
9410            db(< MN ; T ; noModule ; noModule ; noModule ; VDS ;
9411                 emptyModuleNameSet ; emptyViewExpSet > MIS,
9412               MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))) .
9413  eq delModules((MN . MNS),
9414       db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS' ; VES > MIS,
9415          MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))
9416    = delModules((MNS . MNS'),
9417          delViews(VES,
9418            db(< MN ; U ; noModule ; noModule ; noModule ; VDS ;
9419                 emptyModuleNameSet ; emptyViewExpSet > MIS,
9420               MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))) .
9421  eq delModules((MN . MNS),
9422       db(< MN ; null ; U ; U' ; U'' ; VDS ; MNS' ; VES > MIS,
9423          MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))
9424    = delModules((MNS . MNS'),
9425        delViews(VES,
9426            db(MIS, MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))) .
9427  eq delModules(emptyModuleNameSet, DB) = DB .
9428  eq delModules((MN . MNS), DB) = delModules(MNS, DB) [owise] .
9429
9430  eq delViews(VE # VES,
9431       db(MIS, MNS, < VE ; T ; VI ; MNS' ; VES' > VIS, VE # VES'',
9432          MNS'', MNS3, MNS4, QIL))
9433    = delViews(VES # VES',
9434        delModules(MNS',
9435          db(MIS, MNS,
9436             < VE ; T ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS,
9437             VE # VES'', MNS'', MNS3, MNS4, QIL))) .
9438  eq delViews(VE # VES,
9439       db(MIS, MNS,
9440          < VE ; (null).Default{Term} ; VI ; MNS' ; VES' > VIS, VE # VES'',
9441          MNS'', MNS3, MNS4, QIL))
9442    = delViews(VES # VES',
9443        delModules(MNS',
9444          db(MIS, MNS, VIS, VES'', MNS'', MNS3, MNS4, QIL))) .
9445  eq delViews(VE # VES,
9446       db(MIS, MNS, < VE ; VI ; VI' ; MNS' ; VES' > VIS, VE # VES'',
9447          MNS'', MNS3, MNS4, QIL))
9448    = delViews(VES # VES',
9449        delModules(MNS',
9450          db(MIS, MNS,
9451             < VE ; VI ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS,
9452             VE # VES'', MNS'', MNS3, MNS4, QIL))) .
9453  eq delViews(emptyViewExpSet, DB) = DB .
9454  eq delViews(VE # VES, DB) = delViews(VES, DB) [owise] .
9455
9456*** The \texttt{warning} function allows us to place messages (warning, error,
9457*** or any other kind of messages) in the last argument of the database
9458*** constructor. These messages are given in the form of quoted identifier
9459*** lists, and will be passed to the third argument of the read-eval-print
9460*** loop, to be printed in the terminal.
9461
9462  op warning : Database QidList -> Database .
9463  eq warning(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, nil), QIL)
9464    = db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL) .
9465  eq warning(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, NQIL), QIL)
9466    = db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, NQIL QIL) .
9467
9468  op getMsg : Database -> QidList .
9469  eq getMsg(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) = QIL .
9470
9471*** Core Maude built-in modules are handled in a special way in the current
9472*** version of the system. They are not explicitly defined in the Full Maude
9473*** database; their importation is directly handled by Core Maude. This has
9474*** some drawbacks: Core Maude built-in modules cannot be renamed; they cannot
9475*** be directly used with built-in functions, such as \texttt{metaReduce} or
9476*** \texttt{sameComponent}, although they can be imported in modules being
9477*** used in the calls to these functions; and, in general, any function taking
9478*** as argument or returning as result the metarepresentation of a module
9479*** cannot take one of these built-in modules as argument. This is the case,
9480*** for example, for the \texttt{up} function presented in
9481*** Section~\ref{changing-levels}, or for functions or commands in which the
9482*** name of a module has to be specified, as the \texttt{select} or
9483*** \texttt{down} commands, or the \texttt{up} function presented in
9484*** Section~\ref{structured-specifications}. Nevertheless, there are also
9485*** some advantages: The flattening of the built-in part of the structure is
9486*** accomplished more efficiently, and, since these modules do not have to be
9487*** stored in the database of Full Maude, the size of the database is reduced.
9488
9489*** Our plan is to have in the future a hybrid solution. Once we have some way
9490*** of storing the modules entered to Full Maude in Core Maude's database, it
9491*** will be enough to keep in the Full Maude database just the original form
9492*** of the top of all the modules, including built-ins, leaving all the
9493*** importation declarations to be resolved by the engine. The structures will
9494*** be normalized as they are now, so that the engine will have to deal just
9495*** with inclusions, but it will be possible to use the predefined modules as
9496*** any other module. Moreover, the Full Maude database will be relatively
9497*** smaller and the flattening will be computed more efficiently.
9498
9499*** When a new module or theory is entered, the names of all the modules,
9500*** theories, and views depending on it are included in its lists of
9501*** dependencies with functions \texttt{setUpModuleDeps} and
9502*** \texttt{setUpViewDeps}. Notice that if new module expressions are
9503*** defined, the function \texttt{setUpModExpDeps} will have to be
9504*** extended accordingly.
9505
9506  op setUpModuleDeps : Module Database -> Database .
9507  op setUpModExpDeps : ModuleName Database -> Database .
9508  op setUpModExpDeps : ModuleName Header Database -> Database .
9509  op setUpModExpDeps : ModuleName ViewExp Database -> Database .
9510  op setUpImportDeps : ModuleName ImportList Database -> Database .
9511
9512  eq setUpModuleDeps(U, DB)
9513    = setUpImportDeps(getName(U), getImports(U),
9514        setUpModExpDeps(getName(U), DB)) .
9515
9516  eq setUpModExpDeps(QI, DB) = DB .
9517
9518  eq setUpModExpDeps(pd(X :: ME),
9519       db(< ME ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS,
9520          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9521    = db(< ME ; DT ; U ; U' ; U'' ; VDS ; (MNS . pd(X :: ME)) ; VES > MIS,
9522          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
9523  eq setUpModExpDeps(pd(X :: ME),
9524       db(< ME ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS,
9525          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9526    = db(< ME ; U ; U' ; U'' ; U3 ; VDS ; (MNS . pd(X :: ME)) ; VES > MIS,
9527          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
9528  eq setUpModExpDeps(pd(X :: ME), DB)
9529    = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n))
9530    [owise] .
9531
9532---- This could be a bug in Core Maude.
9533---- It should work if the next 6 equations are replaced by this single equation.
9534----  ceq setUpImportDeps(MN, (I IL),
9535----       db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS),
9536----          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9537----    = setUpImportDeps(MN, IL,
9538----        db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MN . MNS ; VES > MIS),
9539----           MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9540----    if MN' := moduleName(I) .
9541  eq setUpImportDeps(MN, ((including MN' .) IL),
9542       db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9543    = setUpImportDeps(MN, IL,
9544        db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
9545  eq setUpImportDeps(MN, ((including MN' .) IL),
9546       db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9547    = setUpImportDeps(MN, IL,
9548        db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
9549  eq setUpImportDeps(MN, ((extending MN' .) IL),
9550       db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9551    = setUpImportDeps(MN, IL,
9552        db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
9553  eq setUpImportDeps(MN, ((extending MN' .) IL),
9554       db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9555    = setUpImportDeps(MN, IL,
9556        db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
9557  eq setUpImportDeps(MN, ((protecting MN' .) IL),
9558       db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9559    = setUpImportDeps(MN, IL,
9560        db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
9561  eq setUpImportDeps(MN, ((protecting MN' .) IL),
9562       db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9563    = setUpImportDeps(MN, IL,
9564        db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
9565  eq setUpImportDeps(MN, I IL, DB)
9566    = warning(DB, '\r 'Error: '\o 'Module header2QidList(moduleName(I)) 'not 'in 'database. '\n)
9567    [owise] .
9568  eq setUpImportDeps(MN, nil, DB) = DB .
9569
9570  op setUpViewDeps : ModuleExpression ViewExp Database -> Database .
9571  op setUpViewExpDeps : ViewExp Database -> Database .
9572  op setUpViewExpDeps : ViewExp ParameterList Database -> Database .
9573
9574  eq setUpViewDeps(ME, VE,
9575       db((< ME ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9576    = db((< ME ; DT ; U ; U' ; U'' ; VDS ; MNS ; VE # VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
9577  eq setUpViewDeps(ME, VE,
9578       db((< ME ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9579    = db((< ME ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VE # VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
9580  eq setUpViewDeps(ME, VE, DB)
9581    = warning(DB, '\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n)
9582    [owise] .
9583
9584  eq setUpViewExpDeps(QI, DB) = DB .
9585  eq setUpViewExpDeps(QI{PL}, DB) = setUpViewExpDeps(QI{PL}, PL, DB) .
9586
9587  eq setUpViewExpDeps(VE, (QI, PL),
9588       db(MIS, MNS, < QI ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
9589    = setUpViewExpDeps(VE, PL,
9590        db(MIS, MNS, < QI ; DT ; VI ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) .
9591  eq setUpViewExpDeps(VE, (QI, PL),
9592       db(MIS, MNS, < QI ; VI ; VI' ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
9593    = setUpViewExpDeps(VE, PL,
9594        db(MIS, MNS, < QI ; VI ; VI' ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) .
9595  eq setUpViewExpDeps(QI{PL}, PL',
9596       db(MIS, MNS, < QI ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
9597    = db(MIS, MNS, < QI ; DT ; VI ; MNS' ; QI{PL} # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)
9598    [owise] .
9599  eq setUpViewExpDeps(QI{PL}, PL',
9600       db(MIS, MNS, < QI ; VI ; VI' ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
9601    = db(MIS, MNS, < QI ; VI ; VI' ; MNS' ; QI{PL} # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)
9602    [owise] .
9603
9604  eq setUpViewExpDeps(VE, (QI{PL}, PL'),
9605       db(MIS, MNS, < QI{PL} ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
9606    = setUpViewExpDeps(VE, PL',
9607        db(MIS, MNS, < QI{PL} ; DT ; VI ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) .
9608  eq setUpViewExpDeps(VE, (QI{PL}, PL'),
9609       db(MIS, MNS, < QI{PL} ; VI ; VI' ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
9610    = setUpViewExpDeps(VE, PL',
9611        db(MIS, MNS, < QI{PL} ; VI ; VI' ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) .
9612  eq setUpViewExpDeps(VE, (QI{PL}, PL'), DB)
9613    = setUpViewExpDeps(VE, PL', DB)
9614    [owise] .
9615  eq setUpViewExpDeps(VE, empty, DB) = DB .
9616
9617  op compiledModule : ModuleExpression Database -> Bool .
9618  op compiledModule : ParameterDecl Database -> Bool .
9619  op compiledView : ViewExp Database -> Bool .
9620
9621  eq compiledView(VE,
9622       db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
9623    = VI =/= null .
9624  eq compiledView(ME, DB) = false [owise] .
9625
9626  eq compiledModule(MN,
9627       db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, MNS',
9628          VIS, VES', MNS'', MNS3, MNS4, QIL))
9629    = U'' =/= noModule .
9630  eq compiledModule(MN,
9631       db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS',
9632          VIS, VES', MNS'', MNS3, MNS4, QIL))
9633    = U3 =/= noModule .
9634  eq compiledModule(MN, DB) = false [owise] .
9635
9636  op insertTermView : ViewExp Term Database -> Database .
9637  op insertView : View Database -> Database .
9638  op getTermView : ViewExp Database -> Default{Term} .
9639  op getView : ViewExp Database -> View .
9640
9641  eq insertTermView(VE, T,
9642       db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES',
9643          MNS'', MNS3, MNS4, QIL))
9644    = delViews(VES,
9645        delModules(MNS',
9646          db(MIS, MNS,
9647            < VE ; T ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS, VES',
9648            MNS'', MNS3, MNS4,
9649            QIL
9650            '\g 'Advisory: '\o 'View viewExp2QidList(VE) 'redefined. '\n))) .
9651  eq insertTermView(VE, T,
9652       db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
9653    = db(MIS, MNS,
9654         < VE ; T ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS,
9655         (VE # VES), MNS', MNS'', MNS3, QIL)
9656    [owise] .
9657
9658  eq insertView(view VE from ME to ME' is SMS OMS endv,
9659       db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
9660    = setUpViewExpDeps(VE,
9661        setUpViewDeps(ME, VE,
9662          setUpViewDeps(ME', VE,
9663            db(MIS, MNS,
9664               < VE ; DT ;
9665                 view VE from ME to ME' is SMS OMS endv ;
9666                 MNS' ; VES > VIS,
9667                 VES', MNS'', MNS3, MNS4, QIL)))) .
9668  eq insertView(view VE{PDL} from ME to ME' is SMS OMS endv,
9669       db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
9670    = setUpViewExpDeps(VE,
9671        setUpViewDeps(ME, VE,
9672          setUpViewDeps(ME', VE,
9673            db(MIS, MNS,
9674               < VE ; DT ;
9675                 view VE{PDL} from ME to ME' is SMS OMS endv ;
9676                 MNS' ; VES > VIS,
9677                 VES', MNS'', MNS3, MNS4, QIL)))) .
9678  eq insertView(view VE from ME to ME' is SMS OMS endv,
9679       db(MIS, MNS, VIS, VES', MNS'', MNS3, MNS4, QIL))
9680    = setUpViewExpDeps(VE,
9681        setUpViewDeps(ME, VE,
9682          setUpViewDeps(ME', VE,
9683            db(MIS, MNS,
9684               < VE ; (null).Default{Term} ;
9685                 view VE from ME to ME' is SMS OMS endv ;
9686                 emptyModuleNameSet ; emptyViewExpSet > VIS,
9687                 VE # VES', MNS'', MNS3, MNS4, QIL))))
9688    [owise] .
9689  eq insertView(view VE{PDL} from ME to ME' is SMS OMS endv, db(MIS, MNS, VIS, VES', MNS'', MNS3, MNS4, QIL))
9690    = setUpViewExpDeps(VE,
9691        setUpViewDeps(ME, VE,
9692          setUpViewDeps(ME', VE,
9693            db(MIS, MNS,
9694               < VE ; (null).Default{Term} ;
9695                 view VE{PDL} from ME to ME' is SMS OMS endv ;
9696                 emptyModuleNameSet ; emptyViewExpSet > VIS,
9697                 VE # VES', MNS'', MNS3, MNS4, QIL))))
9698    [owise] .
9699  eq insertView(viewError(QIL), DB) = warning(DB, QIL) .
9700  ceq insertView(view VE:[ViewExp] from ME:[ModuleExpression] to ME':[ModuleExpression] is SMS:[SortMappingSet] OMS:[OpMappingSet] endv, DB)
9701    = warning(DB, 'The 'view QIL QI if QI == '`) then '\s else nil fi 'contains 'errors.)
9702    if not view VE:[ViewExp] from ME:[ModuleExpression] to ME':[ModuleExpression] is SMS:[SortMappingSet] OMS:[OpMappingSet] endv :: View
9703    /\ QIL QI := eMetaPrettyPrint(VE:[ViewExp])
9704    [owise] .
9705  ceq insertView(view VE:[ViewExp]{PDL:[ParameterDeclList]} from ME:[ModuleExpression] to ME':[ModuleExpression] is SMS:[SortMappingSet] OMS:[OpMappingSet] endv, DB)
9706    = warning(DB, 'The 'view QIL QI if QI == '`) then '\s else nil fi 'contains 'errors.)
9707    if not view VE:[ViewExp]{PDL:[ParameterDeclList]} from ME:[ModuleExpression] to ME':[ModuleExpression] is SMS:[SortMappingSet] OMS:[OpMappingSet] endv :: View
9708    /\ QIL QI := eMetaPrettyPrint(VE:[ViewExp])
9709    [owise] .
9710
9711  eq getTermView(VE,
9712       db(MIS, MNS, (< VE ; DT ; VI ; MNS' ; VES > VIS), VES', MNS'', MNS3, MNS4, QIL))
9713    = DT .
9714  eq getTermView(VE, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
9715    = qidError('\r 'Error: '\o 'View viewExp2QidList(VE) 'not 'in 'database. '\n)
9716    [owise] .
9717
9718  eq getView(VE,
9719       db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
9720    = VI .
9721  eq getView(VE,
9722       db(MIS, MNS, < VE ; VI ; VI' ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL))
9723    = VI' .
9724  eq getView(VE, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
9725    = viewError('\r 'Error: '\o 'View viewExp2QidList(VE) 'not 'in 'database. '\n)
9726    [owise] .
9727
9728*** There are functions to insert the different versions of a unit, and to
9729*** extract them.  We only give here the equations for the insertion of top
9730*** units to illustrate the way in which the consistency of the database is
9731*** maintained.  We assume that when the internal version, the signature, or
9732*** the flat version of a module is entered in the database, its corresponding
9733*** top module is already present in it.
9734
9735  pr 3TUPLE{Term,OpDeclSet,Module}
9736       * (op ((_,_,_)) to <_;_;_>) .
9737
9738----  sort Tuple{Term,OpDeclSet,Module} .
9739----  op <_;_;_> : Default{Term} OpDeclSet Module -> Tuple{Term,OpDeclSet,Module} .
9740  op error : QidList -> [Tuple{Term,OpDeclSet,Module}] .
9741
9742  op insTermModule : ModuleName Module Database -> Database .
9743  op insTermModule : ModuleName Term Database -> Database .
9744  op insertTopModule : ModuleExpression [Module] Database -> Database .
9745  op insertInternalModule : ModuleExpression [Module] Database -> Database .
9746  op insertFlatModule : ModuleExpression [Module] Database -> Database .
9747  op insertVars : ModuleExpression [OpDeclSet] Database -> Database .
9748  op getTermModule : ModuleExpression Database -> [Tuple{Term,OpDeclSet,Module}] .
9749  op getTopModule : ModuleExpression Database -> [Module] .
9750  op getInternalModule : ModuleExpression Database -> [Module] .
9751  op getFlatModule : ModuleExpression Database -> [Module] .
9752  op getFlatModuleNeg : ModuleExpression Database -> [Module] .
9753  op getVars : ModuleExpression Database -> [OpDeclSet] .
9754  op insertTopModule : ParameterDecl [Module] Database -> Database .
9755  op insertInternalModule : ParameterDecl [Module] Database -> Database .
9756  op insertFlatModule : ParameterDecl [Module] Database -> Database .
9757  op insertVars : ParameterDecl [OpDeclSet] Database -> Database .
9758  op getTermModule : ParameterDecl Database -> [Tuple{Term,OpDeclSet,Module}] .
9759  op getTopModule : ParameterDecl Database -> [Module] .
9760  op getInternalModule : ParameterDecl Database -> [Module] .
9761  op getFlatModule : ParameterDecl Database -> [Module] .
9762  op getFlatModuleNeg : ParameterDecl Database -> [Module] .
9763  op getVars : ParameterDecl Database -> [OpDeclSet] .
9764
9765  eq insTermModule(MN, T,
9766       db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, MNS',
9767          VIS, VES', MNS'', MNS3, MNS4, QIL))
9768    = delModules(MNS,
9769          delViews(VES,
9770            db(< MN ; T ; noModule ; noModule ; noModule ; none ;
9771                 emptyModuleNameSet ; emptyViewExpSet > MIS,
9772               MNS', VIS, VES', MNS'', MNS3, MNS4,
9773               QIL
9774               '\g 'Advisory: '\o 'Module header2QidList(MN) 'redefined. '\n))).
9775  eq insTermModule(MN, T,
9776       db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS',
9777          VIS, VES', MNS'', MNS3, MNS4, QIL))
9778    = delModules(MNS,
9779          delViews(VES,
9780            db(< MN ; T ; noModule ; noModule ; noModule ; none ;
9781                 emptyModuleNameSet ; emptyViewExpSet > MIS,
9782               MNS', VIS, VES', MNS'', MNS3, MNS4,
9783               QIL
9784               '\g 'Advisory: '\o 'Module header2QidList(MN) 'redefined. '\n))).
9785  eq insTermModule(MN, T,
9786       db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
9787    = db(< MN ; T ; noModule ; noModule ; noModule ; none ;
9788           emptyModuleNameSet ; emptyViewExpSet > MIS,
9789         MN . MNS, VIS, VES, MNS', MNS'', MNS3, QIL)
9790    [owise] .
9791  eq insTermModule(MN, qidError(QIL), DB) = warning(DB, QIL) .
9792  eq insTermModule(MN, unitError(QIL), DB) = warning(DB, QIL) .
9793
9794  eq insTermModule(MN, U,
9795       db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS',
9796          VIS, VES', MNS'', MNS3, MNS4, QIL))
9797    = delModules(MNS,
9798          delViews(VES,
9799            db(< MN ; U ; noModule ; noModule ; noModule ; none ;
9800                 emptyModuleNameSet ; emptyViewExpSet > MIS,
9801               MNS', VIS, VES', MNS'', MNS3, MNS4,
9802               QIL
9803               '\g 'Advisory:
9804               '\o 'Module header2QidList(MN) 'redefined. '\n))).
9805  eq insTermModule(MN, U,
9806       db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, MNS',
9807          VIS, VES', MNS'', MNS3, MNS4, QIL))
9808    = delModules(MNS,
9809          delViews(VES,
9810            db(< MN ; U ; noModule ; noModule ; noModule ; none ;
9811                 emptyModuleNameSet ; emptyViewExpSet > MIS,
9812               MNS', VIS, VES', MNS'', MNS3, MNS4,
9813               QIL
9814               '\g 'Advisory:
9815               '\o 'Module header2QidList(MN) 'redefined. '\n))).
9816  eq insTermModule(MN, U,
9817       db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
9818    = db(< MN ; U ; noModule ; noModule ; noModule ; none ;
9819           emptyModuleNameSet ; emptyViewExpSet > MIS,
9820         MN . MNS, VIS, VES, MNS', MNS'', MNS3, QIL)
9821    [owise] .
9822  eq insTermModule(MN, qidError(QIL), DB) = warning(DB, QIL) .
9823  eq insTermModule(MN, unitError(QIL), DB) = warning(DB, QIL) .
9824
9825  eq insertTopModule(MN, U,
9826       db(< MN ; null ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS,
9827          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9828    = db(< MN ; null ; U ; noModule ; noModule ; VDS ; MNS ; VES > MIS,
9829         MNS', VIS, VES', MNS'', MNS3, MNS4,
9830         QIL
9831         '\r 'Advisory: '\o
9832         'Internally 'generated 'module header2QidList(MN) 'redefined. '\n) .
9833  eq insertTopModule(MN, U,
9834       db(< MN ; T ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS,
9835          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9836    = setUpModuleDeps(U,
9837        db(< MN ; T ; U ; noModule ; noModule ; VDS ; MNS ; VES > MIS,
9838          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
9839  eq insertTopModule(MN, U,
9840       db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS,
9841          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9842    = setUpModuleDeps(U,
9843        db(< MN ; U' ; U ; noModule ; noModule ; VDS ; MNS ; VES > MIS,
9844          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
9845  eq insertTopModule(MN, U,
9846       db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
9847    = setUpModuleDeps(U,
9848        db(< MN ; null ; U ; noModule ; noModule ;
9849              none ; emptyModuleNameSet ; emptyViewExpSet > MIS,
9850           MN . MNS, VIS, VES, MNS', MNS'', MNS3, QIL))
9851    [owise] .
9852  eq insertTopModule(MN, unitError(QIL), DB) = warning(DB, QIL) .
9853
9854  eq insertInternalModule(MN, U,
9855       db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS,
9856          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9857    = db(< MN ; DT ; U' ; U ; U3 ; VDS ; MNS ; VES > MIS,
9858         MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
9859  eq insertInternalModule(MN, U,
9860       db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS,
9861          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9862    = db(< MN ; U' ; U'' ; U ; U4 ; VDS ; MNS ; VES > MIS,
9863          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
9864  eq insertInternalModule(MN, unitError(QIL), DB) = warning(DB, QIL) .
9865
9866  eq insertFlatModule(MN, U,
9867       db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS,
9868          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9869    = db(< MN ; DT ; U' ; U'' ; U ; VDS ; MNS ; VES > MIS,
9870         MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
9871  eq insertFlatModule(MN, U,
9872       db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS,
9873          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9874    = db(< MN ; U' ; U'' ; U3 ; U ; VDS ; MNS ; VES > MIS,
9875          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
9876  eq insertFlatModule(MN, unitError(QIL), DB) = warning(DB, QIL) .
9877
9878  eq insertVars(MN, VDS,
9879       db(< MN ; DT ; U' ; U'' ; U3 ; VDS' ; MNS ; VES > MIS,
9880          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9881    = db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS,
9882         MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
9883  eq insertVars(MN, VDS,
9884       db(< MN ; U' ; U'' ; U3 ; U4 ; VDS' ; MNS ; VES > MIS,
9885          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9886    = db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS,
9887         MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
9888  eq insertVars(MN, opDeclError(QIL), DB) = warning(DB, QIL) .
9889
9890  eq getTermModule(MN,
9891       db(< MN ; null ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS,
9892          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9893    = error('\r 'Error: '\o header2QidList(MN) 'is 'an 'internal 'module. '\n) .
9894  eq getTermModule(MN,
9895       db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS,
9896          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9897    = < DT ; none ; noModule > .
9898  eq getTermModule(MN,
9899       db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS,
9900          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9901    = < null ; VDS ; U > .
9902  eq getTermModule(MN, DB)
9903    = error('\r 'Error: '\o 'Module header2QidList(MN)  '\n)
9904    [owise] .
9905
9906  eq getTopModule(MN,
9907      db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS,
9908          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9909    = U .
9910  eq getTopModule(MN,
9911       db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS,
9912          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9913    = U' .
9914  eq getTopModule(MN, DB)
9915    = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n)
9916    [owise] .
9917
9918  eq getInternalModule(MN,
9919       db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS,
9920          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9921    = U' .
9922  eq getInternalModule(MN,
9923       db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS,
9924          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9925    = U'' .
9926  eq getInternalModule(MN, DB)
9927    = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n)
9928    [owise] .
9929
9930  eq getVars(MN,
9931       db(< MN ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS,
9932          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9933    = VDS .
9934  eq getVars(MN,
9935       db(< MN ; U ; U' ; U'' ; M ; VDS ; MNS ; VES > MIS,
9936          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9937    = VDS .
9938  eq getVars(MN, DB) = none [owise] .
9939
9940*** The name of the signature and the flattened module is not the
9941*** module expression used as the name of the module but the result of
9942*** converting it into a quoted identifier.
9943
9944  eq getFlatModule(MN,
9945       db(< MN ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9946    = if M == noModule
9947      then unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'compiled. '\n)
9948      else remNegAnns(M)
9949      fi .
9950  eq getFlatModule(MN,
9951       db(< MN ; U ; U' ; U'' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9952    = if M == noModule
9953      then unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'compiled. '\n)
9954      else remNegAnns(M)
9955      fi .
9956  eq getFlatModule(MN, DB)
9957    = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n)
9958    [owise] .
9959
9960  *** Handling of negative annotations (by Santiago Escobar)
9961
9962  eq getFlatModuleNeg(MN,
9963       db(< MN ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS,
9964          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9965    = M .
9966  eq getFlatModuleNeg(MN,
9967       db(< MN ; U ; U' ; U'' ; M ; VDS ; MNS ; VES > MIS,
9968          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9969    = M .
9970  eq getFlatModuleNeg(MN,
9971       db(< MN ; DT ; U ; U' ; noModule ; VDS ; MNS ; VES > MIS,
9972          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9973    = unitError('\r 'Error: '\o
9974                'Module header2QidList(MN) 'not 'compiled. '\n) .
9975  eq getFlatModuleNeg(MN,
9976      db(< MN ; U ; U' ; U'' ; noModule ; VDS ; MNS ; VES > MIS,
9977          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
9978    = unitError('\r 'Error: '\o
9979                'Module header2QidList(MN) 'not 'compiled. '\n) .
9980  eq getFlatModuleNeg(MN, DB)
9981    = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n)
9982    [owise] .
9983
9984  *** removeNegAnnotations
9985  op remNegAnns : Module -> Module .
9986  op remNegAnns : OpDeclSet -> OpDeclSet .
9987  op remNegAnns : AttrSet -> AttrSet .
9988  op remNegAnns : IntList -> IntList .
9989
9990  eq remNegAnns(M) = setOps(M, remNegAnns(getOps(M))) .
9991
9992  eq remNegAnns(op F : TyL -> Ty [AtS] . OPDS)
9993    = op F : TyL -> Ty [remNegAnns(AtS)] . remNegAnns(OPDS) .
9994  eq remNegAnns((none).OpDeclSet) = (none).OpDeclSet .
9995
9996  eq remNegAnns(strat(NL:NatList) AtS) = strat(NL:NatList) AtS .
9997  eq remNegAnns(strat(IL:IntList) AtS) = AtS [owise] .
9998  eq remNegAnns(AtS) = AtS [owise] .
9999
10000endfm
10001
10002-------------------------------------------------------------------------------
10003*******************************************************************************
10004-------------------------------------------------------------------------------
10005
10006***
10007*** The Evaluation of Modules
10008***
10009
10010*** The general principle for the evaluation of units in our design consists in
10011*** first evaluating any module expression, reducing it to a canonical form in
10012*** which only unit inclusions appear, that is, to a unit hierarchy, which can
10013*** be seen as a partial order of unit inclusions. The design of the Full Maude
10014*** system has been based upon the principle of evaluating all module
10015*** expressions to irreducible structured units, and on using the flat version
10016*** of the units only for execution purposes. We have then two different
10017*** processes clearly distinguished: a first step in which the structured unit
10018*** is evaluated and reduced to its normal form, and a second step in which
10019*** this normal form is flattened.
10020
10021*** As explained in Section~\ref{execution-environment}, the process of
10022*** evaluation to normal form is also responsible for the parsing of the
10023*** bubbles in the premodules, which is accomplished once the signature has
10024*** been built. The parsing of bubbles is discussed in
10025*** Section~\ref{bubble-parsing}. To be able to handle the \texttt{up}
10026*** function and the \texttt{down} command presented in
10027*** Section~\ref{structured-specifications}, it is necessary to be able to
10028*** move terms and modules from one level of reflection to another. The
10029*** functionality to move between levels is presented in
10030*** Section~\ref{changing-levels}, where functions \texttt{up} and
10031*** \texttt{down} on sorts \texttt{Module} and \texttt{Term} are defined. The
10032*** transformation of object-oriented modules into system modules in discussed
10033*** in Section~\ref{omod2modfunction}. The evaluation of module expressions is
10034*** discussed in Sections~\ref{evalModExp}, \ref{application-of-maps},
10035*** \ref{instantiation}, and~\ref{renaming}.
10036
10037***
10038*** Changing Levels
10039***
10040
10041*** Moving terms of sorts \texttt{Term} and \texttt{Module} from one
10042*** level of reflection to another is possible thanks to the
10043*** \texttt{up} and \texttt{down} functions, which are defined,
10044*** respectively, in the following modules \texttt{MOVE-UP} and
10045*** \texttt{MOVE-DOWN}.
10046
10047***
10048*** The \texttt{up} Function
10049***
10050
10051*** Given a term of sort \texttt{Module} or \texttt{Term}, the
10052*** \texttt{up} function, defined in the following module
10053*** \texttt{MOVE-UP}, returns the term metarepresenting it. The
10054*** function is just call the \texttt{upTerm} predefined function.
10055
10056*** We shall see in Section~\ref{bubble-parsing} how the \texttt{up} function
10057*** is used to evaluate the homonymous function discussed in
10058*** Section~\ref{structured-specifications}. In Section~\ref{instantiation} we
10059*** shall discuss how the \texttt{up} function is used to evaluate the
10060*** \texttt{META-LEVEL} module expression (see
10061*** Section~\ref{structured-specifications}).
10062
10063-------------------------------------------------------------------------------
10064*******************************************************************************
10065-------------------------------------------------------------------------------
10066
10067fmod MOVE-UP is
10068---  pr META-LEVEL + PRE-VARIANT .
10069  pr META-LEVEL .
10070  pr CONVERSION .
10071  op up : Module -> Term .
10072  op up : Term -> Term .
10073  op up : EquationSet -> Term .
10074
10075  eq up(M:Module) = upTerm(M:Module) .
10076  eq up(T:Term) = upTerm(T:Term) .
10077  eq up(EqS:EquationSet) = upTerm(EqS:EquationSet) .
10078
10079endfm
10080
10081-------------------------------------------------------------------------------
10082*******************************************************************************
10083-------------------------------------------------------------------------------
10084
10085***
10086*** The \texttt{down} Function
10087***
10088
10089*** Given a term of sort \texttt{Term} metarepresenting a term of sort
10090*** \texttt{Term} or \texttt{Module}, the \texttt{down} function can be seen
10091*** as the inverse of the \texttt{up} function discussed in the previous
10092*** section, that is, it returns the original term that had been
10093*** metarepresented. There are also \texttt{down} functions for terms
10094*** metarepresenting terms in other sorts. We present here only some of them.
10095
10096*** We assume that the \texttt{down} functions are called with valid
10097*** metarepresentations. In fact, these functions should be declared as
10098*** partial functions going to error sorts when their arguments are invalid.
10099
10100*** The main application of the \texttt{down} functions is in the evaluation
10101*** of the \texttt{down} command (see
10102*** Section~\ref{structured-specifications}).  However, they are also used in
10103*** other tasks, as for example in the parsing of some inputs.
10104
10105-------------------------------------------------------------------------------
10106*******************************************************************************
10107-------------------------------------------------------------------------------
10108
10109fmod MOVE-DOWN is
10110  pr UNIT .
10111  pr CONVERSION .
10112  pr INT-LIST .
10113
10114  op downTerm : Term -> [Term] .
10115  op downModule : Term -> [Module] .
10116  op downQid : Term -> [Qid] [memo] .
10117  op downQidList : Term -> [QidList] .
10118  op downTypes : Term -> [TypeList] .
10119  op downSorts : Term -> [SortSet] .
10120  op downSort : Term -> [Sort] .
10121  op downModExp : Constant -> [Header] .
10122  op downNat : Term -> [Int] .
10123  op downString : Term -> [String] .
10124
10125  op downResultPair : Term -> [ResultPair] .
10126  op downTerm : TermList -> [Term] .
10127  op downImports : TermList -> [ImportList] .
10128  op downSubsorts : TermList -> [SubsortDeclSet] .
10129  op downOps : TermList -> [OpDeclSet] .
10130  op downEqCond : TermList -> [EqCondition] .
10131  op downCond : TermList -> [Condition] .
10132  op downMbs : TermList -> [MembAxSet] .
10133  op downEqs : TermList -> [EquationSet] .
10134  op downRls : TermList -> [RuleSet] .
10135  op downAttrs : TermList -> [AttrSet] .
10136  op downAttr : Term -> [Attr] .
10137  op downHooks : TermList -> [HookList] .
10138  op downMetaNat : Term -> [Term] .
10139  op downNat : TermList -> [IntList] .
10140
10141  op downClasses : TermList -> [ClassDeclSet] .
10142  op downMsgs : TermList -> [MsgDeclSet] .
10143  op downSubclasses : TermList -> [SubclassDeclSet] .
10144  op downClassAttrs : TermList -> [AttrDeclSet] .
10145
10146  vars T T' T'' T1 T2 T3 T4 T5 T6 T7 T8 T9 T10 T11 T12 : Term .
10147  vars TL TL' : TermList .
10148  vars QI QI' F V L : Qid .
10149  var  Ct : Constant .
10150  var  M : Module .
10151  var  Tp : Type .
10152
10153  eq downResultPair('`{_`,_`}[T, T']) = {downTerm(T), downTerm(T')} .
10154
10155  eq downModule('fmod_is_sorts_.____endfm[T1, T2, T3, T4, T5, T6, T7])
10156    = (fmod downModExp(T1) is
10157         downImports(T2)
10158         sorts downSorts(T3) .
10159         downSubsorts(T4)
10160         downOps(T5)
10161         downMbs(T6)
10162         downEqs(T7)
10163       endfm) .
10164  eq downModule('mod_is_sorts_._____endm[T1, T2, T3, T4, T5, T6, T7, T8])
10165    = (mod downModExp(T1) is
10166         downImports(T2)
10167         sorts downSorts(T3) .
10168         downSubsorts(T4)
10169         downOps(T5)
10170         downMbs(T6)
10171         downEqs(T7)
10172         downRls(T8)
10173       endm) .
10174  eq downModule('omod_is_sorts_.________endom[T1, T2, T3, T4, T5, T6, T7, T8, T9, T10, T11])
10175    = (omod downModExp(T1) is
10176         downImports(T2)
10177         sorts downSorts(T3) .
10178         downSubsorts(T4)
10179         downClasses(T5)
10180         downSubclasses(T6)
10181         downOps(T7)
10182         downMsgs(T8)
10183         downMbs(T9)
10184         downEqs(T10)
10185         downRls(T11)
10186       endom) .
10187
10188  eq downModExp(Ct) = downQid(Ct) .
10189
10190  eq downImports('nil.ImportList) = nil .
10191  eq downImports('__[TL]) = downImports(TL) .
10192  eq downImports('including_.[T]) = (including downModExp(T) .) .
10193  eq downImports('extending_.[T]) = (extending downModExp(T) .) .
10194  eq downImports('protecting_.[T]) = (protecting downModExp(T) .) .
10195  ceq downImports((TL, TL')) = (downImports(TL) downImports(TL')) if TL =/= empty /\ TL' =/= empty .
10196
10197  eq downSubsorts('none.SubsortDeclSet) = none .
10198  eq downSubsorts('__[TL]) = downSubsorts(TL) .
10199  eq downSubsorts('subsort_<_.[T, T']) = (subsort downQid(T) < downQid(T') .) .
10200  ceq downSubsorts((TL, TL')) = (downSubsorts(TL) downSubsorts(TL')) if TL =/= empty /\ TL' =/= empty .
10201
10202  eq downOps('none.OpDeclSet) = none .
10203  eq downOps('__[TL]) = downOps(TL) .
10204  eq downOps('op_:_->_`[_`].[Ct, T, T', T''])
10205    = (op downQid(Ct) : downTypes(T) -> downQid(T') [downAttrs(T'')] .) .
10206  ceq downOps((TL, TL')) = (downOps(TL) downOps(TL')) if TL =/= empty /\ TL' =/= empty .
10207
10208  eq downAttrs('none.AttrSet) = none .
10209  eq downAttrs('__[TL]) = downAttrs(TL) .
10210  ceq downAttrs((TL, TL')) = (downAttr(TL) downAttrs(TL')) if TL =/= empty /\ TL' =/= empty .
10211  ceq downAttrs(T)
10212    = downAttr(T)
10213    if T =/= 'none.AttrSet .
10214
10215  eq downAttr('assoc.Attr) = assoc .
10216  eq downAttr('comm.Attr) = comm .
10217  eq downAttr('idem.Attr) = idem .
10218  eq downAttr('id[T]) = id(downTerm(T)) .
10219  eq downAttr('left-id[T]) = left-id(downTerm(T)) .
10220  eq downAttr('right-id[T]) = right-id(downTerm(T)) .
10221  eq downAttr('poly[T]) = poly(downNat(T)) .
10222  eq downAttr('strat[T]) = strat(downNat(T)) .
10223  eq downAttr('memo.Attr) = memo .
10224  eq downAttr('prec[T]) = prec(downNat(T)) .
10225  eq downAttr('gather[T]) = gather(downQidList(T)) .
10226  eq downAttr('ctor.Attr) = ctor .
10227  eq downAttr('special[T]) = special(downHooks(T)) .
10228  eq downAttr('iter.Attr) = iter .
10229  eq downAttr('frozen[T]) = frozen(downNat(T)) .
10230  eq downAttr('label[T]) = label(downQid(T)) .
10231  eq downAttr('config.Attr) = config .
10232  eq downAttr('object.Attr) = object .
10233  eq downAttr('msg.Attr) = msg .
10234  eq downAttr('nonexec.Attr) = nonexec .
10235  eq downAttr('variant.Attr) = variant .
10236----  eq downAttr('metadata`(_`)['token[T]]) = metadata(downString(downQid(T))) .
10237  eq downAttr('owise.Attr) = owise .
10238  eq downAttr('metadata[T]) = metadata(substr(string(T), 1, find(string(T), "\".String", 0) + (- 1))) .
10239  eq downAttr('format[T]) = format(downQidList(T)) .
10240
10241  eq downHooks('__[TL]) = downHooks(TL) .
10242  eq downHooks('id-hook[T, T']) = id-hook(downQid(T), downQidList(T')) .
10243  eq downHooks('op-hook[T, T', T'', T3])
10244    = op-hook(downQid(T), downQid(T'), downQidList(T''), downQid(T3)) .
10245  eq downHooks('term-hook[T, T']) = term-hook(downQid(T), downTerm(T')) .
10246  ceq downHooks((TL, TL')) = downHooks(TL) downHooks(TL') if TL =/= empty /\ TL' =/= empty .
10247
10248----  eq downTerm(T) = downTerm(T, qidError('\r 'Error: '\o 'Incorrect 'term. '\n)) .
10249  eq downTerm(QI) = downQid(QI) .
10250  eq downTerm('_`[_`][T, T']) = downQid(T)[downTerm(T')] .
10251  eq downTerm('_`,_[T, TL]) = (downTerm(T), downTerm(TL)) .
10252  ceq downTerm((T, TL)) = (downTerm(T), downTerm(TL)) if TL =/= empty .
10253  eq downTerm(F[TL])
10254    = qidError('\r 'Error: '\o 'Incorrect 'term. '\n) [owise] .
10255
10256  eq downEqCond('_/\_[TL]) = downEqCond(TL) .
10257  eq downEqCond('_=_[T, T']) = downTerm(T) = downTerm(T') .
10258  eq downEqCond('_:_[T, T']) = downTerm(T) : downSort(T') .
10259  eq downEqCond('_:=_[T, T']) = downTerm(T) := downTerm(T') .
10260  ceq downEqCond((TL, TL')) = downEqCond(TL) /\ downEqCond(TL') if TL =/= empty /\ TL' =/= empty .
10261
10262  eq downCond('_/\_[TL]) = downCond(TL) .
10263  eq downCond('_=_[T, T']) = downEqCond('_=_[T, T']) .
10264  eq downCond('_:_[T, T']) = downEqCond('_:_[T, T']) .
10265  eq downCond('_:=_[T, T']) = downEqCond('_:=_[T, T']) .
10266  eq downCond('_=>_[T, T']) = downTerm(T) => downTerm(T') .
10267  ceq downCond((TL, TL')) = downCond(TL) /\ downCond(TL') if TL =/= empty /\ TL' =/= empty .
10268
10269  eq downMbs('none.MembAxSet) = none .
10270  eq downMbs('__[TL]) = downMbs(TL) .
10271  eq downMbs('mb_:_`[_`].[T, T', T''])
10272    = (mb downTerm(T) : downSort(T') [downAttrs(T'')] .) .
10273  eq downMbs('cmb_:_if_`[_`].[T, T', T'', T3])
10274    = (cmb downTerm(T) : downSort(T') if downEqCond(T'') [downAttrs(T3)] .) .
10275  ceq downMbs((TL, TL')) = (downMbs(TL) downMbs(TL')) if TL =/= empty /\ TL' =/= empty .
10276
10277  eq downEqs('none.EquationSet) = none .
10278  eq downEqs('__[TL]) = downEqs(TL) .
10279  eq downEqs('eq_=_`[_`].[T, T', T''])
10280    = (eq downTerm(T) = downTerm(T') [downAttrs(T'')] .) .
10281  eq downEqs('ceq_=_if_`[_`].[T, T', T'', T3])
10282    = (ceq downTerm(T) = downTerm(T') if downEqCond(T'') [downAttrs(T3)] .) .
10283  ceq downEqs((TL, TL')) = (downEqs(TL) downEqs(TL')) if TL =/= empty /\ TL' =/= empty .
10284
10285  eq downRls('none.RuleSet) = none .
10286  eq downRls('__[TL]) = downRls(TL) .
10287  eq downRls('rl_=>_`[_`].[T, T', T''])
10288    = (rl downTerm(T) => downTerm(T') [downAttrs(T'')] .) .
10289  eq downRls('crl_=>_if_`[_`].[T, T', T'', T3])
10290    = (crl downTerm(T) => downTerm(T') if downCond(T'') [downAttrs(T3)] .) .
10291  ceq downRls((TL, TL')) = (downRls(TL) downRls(TL')) if TL =/= empty /\ TL' =/= empty .
10292
10293  eq downSorts('none.EmptyTypeSet) = none .
10294----  eq downSorts('none.SortSet) = none .
10295  eq downSorts('_;_[TL]) = downSorts(TL) .
10296  ceq downSorts((TL, TL')) = (downSorts(TL) ; downSorts(TL')) if TL =/= empty /\ TL' =/= empty .
10297  eq downSorts(QI) = downSort(QI) [owise] .
10298
10299  eq downSort(Ct) = downQid(Ct) .
10300
10301  eq downTypes('nil.TypeList) = nil .
10302  eq downTypes('__[TL]) = downTypes(TL) .
10303  ceq downTypes((TL, TL'))
10304    = (downTypes(TL) downTypes(TL'))
10305    if TL =/= empty /\ TL' =/= empty .
10306  eq downTypes(QI) = downSort(QI) [owise] .
10307
10308  eq downQidList('nil.TypeList) = nil .
10309  eq downQidList('__[TL]) = downQidList(TL) .
10310  ceq downQidList((TL, TL')) = (downQidList(TL) downQidList(TL')) if TL =/= empty /\ TL' =/= empty .
10311  eq downQidList(QI) = downQid(QI) [owise] .
10312
10313  eq downQid(Ct)
10314    = qid(substr(string(getName(Ct)), 1, length(string(getName(Ct))))) .
10315----  eq downQid(Ct) = downTerm(Ct) .
10316
10317  eq downMetaNat(QI)
10318    = qid(substr(string(getName(QI)), 1, length(string(getName(QI))))
10319          + ".Nat") .
10320
10321----  eq downNat(T) = downTerm(T, numberError('Error: 'non 'valid 'metaterm)) .
10322  ceq downNat(QI)
10323    = trunc(rat(string(getName(QI)), 10))
10324    if getType(QI) == 'Nat or getType(QI) == 'NzNat .
10325  ceq downNat(QI)
10326    = if substr(string(getName(QI)), 0 ,1) == "-"
10327      then - trunc(rat(substr(string(getName(QI)), 1,
10328                            length(string(getName(QI)))), 10))
10329      else trunc(rat(string(getName(QI)), 10))
10330      fi
10331    if getType(QI) == 'Int or getType(QI) == 'NzInt .
10332  eq downNat('0.Zero) = 0 .
10333  eq downNat('s_['0.Zero]) = 1 .
10334  ceq downNat(F['0.Zero])
10335    = trunc(rat(substr(string(F), 3, 2), 10))
10336    if substr(string(F), 0, 3) = "s_^" .
10337
10338  eq downString(QI) = substr(string(QI), 1, _-_(length(string(QI)), 2)) .
10339
10340  eq downNat('__[TL]) = downNat(TL) .
10341  ceq downNat((TL, TL')) = (downNat(TL) downNat(TL')) if TL =/= empty /\ TL' =/= empty .
10342
10343  eq downClasses('none.ClassDeclSet) = none .
10344  eq downClasses('__[TL]) = downClasses(TL) .
10345  ceq downClasses((TL, TL')) = (downClasses(TL) downClasses(TL')) if TL =/= empty /\ TL' =/= empty .
10346  eq downClasses('class_|_.[T, T']) = (class downSort(T) | downClassAttrs(T') .) .
10347
10348  eq downClassAttrs('none.AttrDeclSet) = none .
10349  eq downClassAttrs('_`,_[TL]) = downClassAttrs(TL) .
10350  ceq downClassAttrs((TL, TL')) = (downClassAttrs(TL), downClassAttrs(TL')) if TL =/= empty /\ TL' =/= empty .
10351  eq downClassAttrs('attr_:_[T, T']) = (attr downQid(T) : downSort(T')) .
10352
10353  eq downSubclasses('none.SubclassDeclSet) = none .
10354  eq downSubclasses('__[TL]) = downSubclasses(TL) .
10355  ceq downSubclasses((TL, TL')) = (downSubclasses(TL) downSubclasses(TL')) if TL =/= empty /\ TL' =/= empty .
10356  eq downSubclasses('subclass_<_.[T, T']) = (subclass downQid(T) < downQid(T') .) .
10357
10358  eq downMsgs('none.MsgDeclSet) = none .
10359  eq downMsgs('__[TL]) = downMsgs(TL) .
10360  ceq downMsgs((TL, TL')) = (downMsgs(TL) downMsgs(TL')) if TL =/= empty /\ TL' =/= empty .
10361  eq downMsgs('msg_:_->_.[Ct, T, T'])
10362    = (msg downQid(Ct) : downTypes(T) -> downQid(T') .) .
10363
10364endfm
10365
10366-------------------------------------------------------------------------------
10367*******************************************************************************
10368-------------------------------------------------------------------------------
10369
10370***
10371*** Parsing of Bubbles
10372***
10373
10374*** As discussed in Section~\ref{implementation-introduction}, in Full Maude,
10375*** the parsing process is split into two phases. In a first stage, the input
10376*** is parsed using the top-level grammar for Full Maude modules, theories,
10377*** views, and commands. Once this first stage is completed, we get a term
10378*** with bubbles in it, which is converted into a module, theory, or view.
10379*** This unit or view may still have the bubbles in it. We say that a module
10380*** with bubbles is a premodule, a view with bubbles a preview, and so on. The
10381*** second stage of the process consists in taking this preunit or preview and
10382*** converting the bubbles in it into terms by parsing them in the appropriate
10383*** signatures, obtaining a `valid' unit or view out of it, or otherwise a
10384*** parsing error. In the case of commands, if they contain any bubble, the
10385*** same will have to be done. All bubbles have to be parsed in the
10386*** appropriate signature before any further processing can be done with the
10387*** module, view, or command in which they appear.
10388
10389***
10390*** Parsing of Module Expressions
10391***
10392
10393*** Before introducing the \texttt{parseDecl} function, we present some
10394*** auxiliary functions. For example, the following functions
10395*** \texttt{parseType}, \texttt{parseSortSet}, and \texttt{parseTypeList}
10396*** return, respectively, the sort, set of sorts, and list of sorts
10397*** represented by the term given as argument. Note that these functions, as
10398*** most of the functions in this module, are partial functions. We assume
10399*** that the term given as argument is in fact the representation of, for
10400*** example, a valid sort, or set of sorts, etc. In the case of
10401*** \texttt{parseDecl} we assume that the term is the representation of a
10402*** predeclaration.
10403
10404-------------------------------------------------------------------------------
10405*******************************************************************************
10406-------------------------------------------------------------------------------
10407
10408fmod MOD-EXP-PARSING is
10409  pr MOVE-DOWN .
10410  pr INT-LIST .
10411  pr VIEW-EXPR-TO-QID .
10412
10413  vars T T' T'' T3 T4 : Term .
10414  vars T? T?' : [Term] .
10415  var  TL TL' : TermList .
10416  var  QIL  : QidList .
10417  var  Ct : Constant .
10418  var  AtS : AttrSet .
10419  vars QI F : Qid .
10420  var  CD? : [Condition] .
10421  vars S S' : Sort .
10422  var  TyL : TypeList .
10423
10424  op parseSort : Term ~> Sort .
10425  op parseType : Term ~> Type .
10426  op parseSortSet : Term ~> SortSet .
10427  op parseTypeList : Term ~> TypeList .
10428  op parseViewExp : Term ~> ViewExp .
10429  op parseParameterList : Term ~> ParameterList .
10430
10431  eq parseSort('sortToken[T])
10432    = if downQid(T) :: Type
10433      then downQid(T)
10434      else qidError('\r 'Warning: '\o downQid(T) 'is 'not 'a 'valid 'sort. '\n)
10435      fi .
10436  eq parseSort('_`{_`}[T, T'])
10437    = qid(string(parseSort(T))
10438          + "{" + string(parameterList2Qid(parseParameterList(T'))) + "}") .
10439  eq parseSort(T) = qidError('\r 'Warning: '\o 'invalid 'sort. '\n) [owise] .
10440
10441  eq parseType('`[_`][T])
10442    ---- = kind(parseSort(T)) .
10443    = qid("[" + string(parseSort(T)) + "]") .
10444  eq parseType(T) = parseSort(T) [owise] .
10445
10446  eq parseSortSet('__[T, T']) = (parseSort(T) ; parseSortSet(T')) .
10447  eq parseSortSet(T) = parseSort(T) [owise].
10448
10449  eq parseTypeList('__[T, T']) = (parseType(T) parseTypeList(T')) .
10450  eq parseTypeList(T) = parseType(T) [owise] .
10451
10452  eq parseViewExp('viewToken[T])
10453    = if downQid(T) :: Sort
10454      then downQid(T)
10455      else qidError('\r 'Warning: '\o downQid(T) 'is 'not 'a 'valid 'sort. '\n)
10456      fi .
10457  eq parseViewExp('_`{_`}[T, T'])
10458    = parseViewExp(T){parseParameterList(T')} .
10459  eq parseViewExp(T)
10460    = qidError('\r 'Warning: '\o 'invalid 'view 'expression. '\n)
10461    [owise] .
10462
10463  eq parseParameterList('_`,_[T, T'])
10464    = parseViewExp(T), parseParameterList(T') .
10465  eq parseParameterList(T) = parseViewExp(T) [owise] .
10466
10467*** The function \texttt{parseModExp} takes a term representing a
10468*** module expression and returns the corresponding term in sort
10469*** \texttt{ModuleExpression}. In case of adding new constructors for module
10470*** expressions, as it will be done in Section~\ref{extension}, new equations d
10471*** efining the semantics of the function on them will have to be given.
10472
10473  op parseModExp : Term -> ModuleExpression .
10474  op parseMaps : Term -> RenamingSet .
10475
10476  op parseAttrs : Term -> AttrSet .
10477
10478  eq parseModExp('token[T]) = downQid(T) .
10479  eq parseModExp('`(_`)[T]) = parseModExp(T) .
10480  eq parseModExp('_`{_`}[T, T'])
10481    = _`{_`}(parseModExp(T), parseParameterList(T')) .
10482  eq parseModExp('_*`(_`)[T, T']) = _*`(_`)(parseModExp(T), parseMaps(T')) .
10483  eq parseModExp('_+_[T, T']) = parseModExp(T) + parseModExp(T') .
10484  eq parseModExp('TUPLE`[_`]['token[T]]) = TUPLE[parseNat(T)] .
10485  eq parseModExp('POWER`[_`]['token[T]]) = POWER[parseNat(T)] .
10486
10487  eq parseMaps('_`,_[T, T']) = (parseMaps(T), parseMaps(T')) .
10488
10489  eq parseMaps('sort_to_[T, T']) = (sort parseType(T) to parseType(T')) .
10490  eq parseMaps('label_to_['token[T], 'token[T']])
10491    = (label downQid(T) to downQid(T')) .
10492  eq parseMaps('class_to_[T, T']) = (class parseType(T) to parseType(T')) .
10493  eq parseMaps('attr_._to_[T, 'token[T'], 'token[T'']])
10494    = (attr downQid(T') . parseType(T) to downQid(T'')) .
10495  eq parseMaps('msg_to_['token[T], 'token[T']])
10496    = (msg downQid(T) to downQid(T')) .
10497  eq parseMaps('msg_:_->_to_['token[T], T', T'', 'token[T3]])
10498    = (msg downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3)) .
10499  eq parseMaps('msg_:`->_to_['token[T], T', 'token[T'']])
10500    = (msg downQid(T) : nil -> parseType(T') to downQid(T'')) .
10501  eq parseMaps('op_to_`[_`]['token[T], 'token[T'], T''])
10502    = (op downQid(T) to downQid(T') [parseAttrs(T'')]) .
10503  eq parseMaps('op_:_->_to_`[_`]['token[T], T', T'', 'token[T3], T4])
10504    = (op downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3)
10505            [parseAttrs(T4)]) .
10506  eq parseMaps('op_:`->_to_`[_`]['token[T], T', 'token[T''], T3])
10507    = (op downQid(T) : nil -> parseType(T') to downQid(T'')
10508          [parseAttrs(T3)]) .
10509  eq parseMaps('op_:_~>_to_`[_`]['token[T], T', T'', 'token[T3], T4])
10510    = (op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T''))
10511            to downQid(T3) [parseAttrs(T4)]) .
10512  eq parseMaps('op_:`~>_to_`[_`]['token[T], T', 'token[T''], T3])
10513    = (op downQid(T) : nil -> kind(parseType(T')) to downQid(T'')
10514          [parseAttrs(T3)]) .
10515  eq parseMaps('op_to_['token[T], 'token[T']])
10516    = (op downQid(T) to downQid(T') [none]) .
10517  eq parseMaps('op_:_->_to_['token[T], T', T'', 'token[T3]])
10518    = (op downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3)
10519          [none]) .
10520  eq parseMaps('op_:`->_to_['token[T], T', 'token[T'']])
10521    = (op downQid(T) : nil -> parseType(T') to downQid(T'') [none]) .
10522  eq parseMaps('op_:_~>_to_['token[T], T', T'', 'token[T3]])
10523    = (op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T''))
10524          to downQid(T3) [none]) .
10525  eq parseMaps('op_:`~>_to_['token[T], T', 'token[T'']])
10526    = (op downQid(T) : nil -> kind(parseType(T')) to downQid(T'') [none]) .
10527
10528  eq parseAttrs('__[T, T']) = (parseAttrs(T) parseAttrs(T')) .
10529  eq parseAttrs('assoc.@Attr@) = assoc .
10530  eq parseAttrs('associative.@Attr@) = assoc .
10531  eq parseAttrs('comm.@Attr@) = comm .
10532  eq parseAttrs('commutative.@Attr@) = comm .
10533  eq parseAttrs('idem.@Attr@) = idem .
10534  eq parseAttrs('idempotent.@Attr@) = idem .
10535  eq parseAttrs('id:_[T]) = none .
10536  eq parseAttrs('identity:_[T]) = none .
10537  eq parseAttrs('left`id:_[T]) = none .
10538  eq parseAttrs('left`identity:_[T]) = none .
10539  eq parseAttrs('right`id:_[T]) = none .
10540  eq parseAttrs('right`identity:_[T]) = none .
10541  eq parseAttrs('poly`(_`)[T]) = poly(parseInt(T)) .
10542  eq parseAttrs('strat`(_`)[T]) = none .
10543  eq parseAttrs('strategy`(_`)[T]) = none .
10544  eq parseAttrs('memo.@Attr@) = none .
10545  eq parseAttrs('memoization.@Attr@) = none .
10546  eq parseAttrs('prec_['token[T]]) = prec(parseNat(T)) .
10547  eq parseAttrs('precedence_['token[T]]) = prec(parseNat(T)) .
10548  eq parseAttrs('prec_['`(_`)['token[T]]]) = prec(parseNat(T)) .
10549  eq parseAttrs('precedence_['`(_`)['token[T]]]) = prec(parseNat(T)) .
10550  eq parseAttrs('gather`(_`)['neTokenList[T]]) = gather(downQidList(T)) .
10551  eq parseAttrs('gathering`(_`)['neTokenList[T]]) = gather(downQidList(T)) .
10552  eq parseAttrs('format`(_`)['neTokenList[T]]) = none .
10553  eq parseAttrs('ctor.@Attr@) = ctor .
10554  eq parseAttrs('constructor.@Attr@) = ctor .
10555  eq parseAttrs('frozen.@Attr@) = none .
10556  eq parseAttrs('frozen`(_`)[T]) = none .
10557  eq parseAttrs('iter.@Attr@) = iter .
10558  eq parseAttrs('ditto.@Attr@) = ditto .
10559  eq parseAttrs('special`(_`)[T]) = parseSpecial(parseHookList(T)) .
10560  eq parseAttrs('config.@Attr@) = config .
10561  eq parseAttrs('object.@Attr@) = object .
10562  eq parseAttrs('msg.@Attr@) = msg .
10563  eq parseAttrs('message.@Attr@) = msg .
10564  eq parseAttrs('metadata_['token[T]]) = metadata(downString(downQid(T))) .
10565  eq parseAttrs('variant.@Attr@) = variant .
10566  eq parseAttrs('nonexec.@Attr@) = nonexec .
10567
10568  op parseSpecial : Set<Hook> -> Attr .
10569  op parseHookList : Term -> Set<Hook> .
10570  op hookList : Set<Hook> -> HookList .
10571  sort Set<Hook> .
10572  subsort Hook < Set<Hook> .
10573  op none : -> Set<Hook> .
10574  op _._ : Set<Hook> Set<Hook> -> Set<Hook> [assoc comm id: none] .
10575  var  SH : Set<Hook> .
10576  var  H : Hook .
10577
10578  eq parseSpecial(none) = none .
10579  eq parseSpecial(SH) = special(hookList(SH)) [owise] .
10580
10581  eq parseHookList('__[T, TL]) = parseHookList(T) . parseHookList(TL) .
10582  eq parseHookList('id-hook_['token[T]]) = id-hook(downQid(T), nil) .
10583  eq parseHookList('id-hook_`(_`)['token[T], 'neTokenList[T']])
10584    = id-hook(downQid(T), downQidList(T')) .
10585  eq parseHookList(
10586       'op-hook_`(_:_->_`)[
10587          'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]])
10588    = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) .
10589  eq parseHookList('op-hook_`(_:`->_`)['token[T], 'token[T'], 'token[T'']])
10590    = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) .
10591  eq parseHookList(
10592       'op-hook_`(_:_~>_`)[
10593          'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]])
10594    = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) .
10595  eq parseHookList('op-hook_`(_:`~>_`)['token[T], 'token[T'], 'token[T'']])
10596    = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) .
10597  eq parseHookList('term-hook_`(_`)['token[T], T']) = none .
10598
10599  eq hookList(H) = H .
10600  eq hookList(H . SH) = H hookList(SH) [owise] .
10601
10602*** Given a term representing a machine integer, the function
10603*** \texttt{parseInt} returns the corresponding integer.
10604
10605  op parseNat : Term -> Nat .
10606
10607  op parseInt : Term -> Int .
10608  op parseInt : TermList -> IntList .
10609
10610  eq parseInt(('neTokenList['__[TL]], TL')) = parseInt(TL) parseInt(TL') .
10611  eq parseInt(('neTokenList[QI], TL)) = parseInt(QI) parseInt(TL) .
10612  eq parseInt(empty) = nil .
10613
10614  eq parseInt((T, TL)) = parseInt(T) parseInt(TL) [owise] .
10615  eq parseInt(nil) = nil .
10616
10617  eq parseInt(Ct)
10618    = downNat(
10619        qid(substr(string(getName(Ct)), 1, length(string(getName(Ct))))
10620            + ".Int")) .
10621
10622  eq parseNat(Ct)
10623    = downNat(
10624        qid(substr(string(getName(Ct)), 1, length(string(getName(Ct))))
10625            + ".Nat")) .
10626
10627endfm
10628
10629-------------------------------------------------------------------------------
10630*******************************************************************************
10631-------------------------------------------------------------------------------
10632
10633***
10634*** Parsing of Bubbles
10635***
10636
10637*** In the following module \texttt{BUBBLE-PARSING}, the definitions for the
10638*** basic processing of bubbles are introduced. In it we declare a function
10639*** \texttt{solveBubbles} which takes a bubble and some other arguments and
10640*** returns the term resulting from parsing it.
10641
10642
10643-------------------------------------------------------------------------------
10644*******************************************************************************
10645-------------------------------------------------------------------------------
10646
10647fmod BUBBLE-PARSING is
10648  pr DATABASE .
10649  pr MOVE-UP .
10650  pr MOVE-DOWN .
10651  pr MOD-EXP-PARSING .
10652  pr PRINT-SYNTAX-ERROR .
10653
10654  vars T T' : Term .
10655  vars M M' : Module .
10656  var  B : Bool .
10657  var  QIL : QidList .
10658  vars DB DB' : Database .
10659  var  TL : TermList .
10660  var  S : Sort .
10661  vars QI QI' F : Qid .
10662  var  VDS : OpDeclSet .
10663  var  C : Constant .
10664  var  V : Variable .
10665  var  N : Nat .
10666  var  Tp : Type .
10667  var  RP : [ResultPair] .
10668  var  MN : ModuleName .
10669  var  ME : ModuleExpression .
10670  var  U : Module .
10671  var  Cond : Condition .
10672
10673  op resultPairError : QidList -> [ResultPair] [ctor] .
10674
10675*** As we shall see in Section~\ref{evaluation}, a declaration importing the
10676*** predefined module \texttt{UP} (see Section~\ref{non-built-in-predefined})
10677*** is added to all modules importing the \texttt{META-LEVEL} module. The
10678*** \texttt{solveBubbles} function is called with a `flag' indicating whether
10679*** the module can contain calls to the \texttt{up} function or not. Thus,
10680*** when we call \texttt{metaParse} with some bubble and the module in which
10681*** such bubble has to be parsed, if there are occurrences of the function
10682*** \texttt{up} in it, they will be of the form \verb~'token[T]]~ or
10683*** \verb~'up['token[T], 'bubble[T']]~ for terms \texttt{T} and \texttt{T'}.
10684*** The function \texttt{solveUps} will evaluate them.
10685
10686  op solveBubbles : Term Module Bool OpDeclSet Database -> [Term] .
10687  op solveUps : TermList Database -> [TermList] .
10688  op solveUpsCondition : Condition Database -> Condition .
10689  op solveUpsModExp : TermList Database -> [TermList] .
10690  op constsToVars : Term OpDeclSet -> Term [memo] .
10691  op constsToVars : TermList OpDeclSet -> TermList [memo] .
10692  op constsToVarsAux : Constant OpDeclSet -> Qid [memo] .
10693
10694  eq constsToVars(F[TL], VDS) = F[constsToVars(TL, VDS)] .
10695  eq constsToVars(C, VDS) = constsToVarsAux(C, VDS) .
10696  eq constsToVars(V, VDS) = V .
10697  eq constsToVars(qidError(QIL), VDS) = qidError(QIL) .
10698  ceq constsToVars((T, TL), VDS)
10699    = (constsToVars(T, VDS), constsToVars(TL, VDS))
10700    if TL =/= empty .
10701
10702  eq constsToVarsAux(C, (op F : nil -> Tp [none] .) VDS)
10703    = if getName(C) == F
10704      then qid(string(F) + ":" + string(Tp))
10705      else constsToVarsAux(C, VDS)
10706      fi .
10707  eq constsToVarsAux(C, none) = C .
10708
10709  ceq solveBubbles('bubble[T], M, true, VDS, DB)
10710    *** if META-LEVEL is a submodule the ups need to be solved
10711    = if RP :: ResultPair
10712      then solveUps(constsToVars(getTerm(RP), VDS), DB)
10713      else qidError('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n
10714                    '\r 'Error: '\o 'no 'parse 'for QIL '\n)
10715      fi
10716    if M' := addOps(VDS, M)
10717       /\ QIL := downQidList(T)
10718       /\ RP := metaParse(M', QIL, anyType) .
10719
10720  ceq solveBubbles('bubble[T], M, false, VDS, DB)
10721    = if RP :: ResultPair
10722      then constsToVars(getTerm(RP), VDS)
10723      else qidError('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n
10724                    '\r 'Error: '\o 'no 'parse 'for QIL '\n)
10725      fi
10726    if M' := addOps(VDS, M)
10727       /\ QIL := downQidList(T)
10728       /\ RP := metaParse(M', QIL, anyType) .
10729
10730*** The \texttt{solveBubbles1} function is in charge of calling the function
10731*** \texttt{metaParse}. The flag indicating the inclusion of the module
10732*** \texttt{META-LEVEL} in the module in which the term appears decides
10733*** whether the function \texttt{solveUps} is called or not, so the extra
10734*** price of searching for calls to the \texttt{up} function is paid only
10735*** when an occurrence of the function is possible. This function takes care
10736*** of the occurrences of the \texttt{up} function that may exist in such
10737*** bubbles.
10738
10739*** The function \texttt{solveUps} goes through the term looking for a term
10740*** with \texttt{'up} as top operator and \texttt{'token} as top operator of
10741*** its unique argument if there is only one argument, or with \texttt{'token}
10742*** and \texttt{'bubble} as top operators of its first and second arguments,
10743*** respectively, if there are two. If a term of the form
10744*** \mbox{\texttt{'up['token[T]]}} is reached, it is replaced by the
10745*** metarepresentation of the flat version of the module in the database with
10746*** the name given by the token. If a term of form
10747*** \mbox{\texttt{'up['token[T], 'bubble[T']]}} is reached, the
10748*** metarepresentation of the result of parsing the bubble in the signature
10749*** of the module with the name given by the token, after solving possible
10750*** nested calls to the \texttt{up} function, is returned.
10751
10752  eq solveUps(QI, DB) = QI .
10753  eq solveUps(F[TL], DB) = F[solveUps(TL, DB)] [owise] .
10754  ceq solveUps((T, TL), DB)
10755    = (solveUps(T, DB), solveUps(TL, DB))
10756    if TL =/= empty .
10757
10758  eq solveUps('upModule['token[T]], DB)
10759    = solveUpsModExp('upModule['token[T]], DB) .
10760  eq solveUps('upModule['`(_`)[T]], DB)
10761    = solveUpsModExp('upModule['`(_`)[T]], DB) .
10762  eq solveUps('upModule['_`{_`}[T, T']], DB)
10763    = solveUpsModExp('upModule['_`{_`}[T, T']], DB) .
10764  eq solveUps('upModule['_*`(_`)[T, T']], DB)
10765    = solveUpsModExp('upModule['_*`(_`)[T, T']], DB) .
10766  eq solveUps('upModule['_+_[T, T']], DB)
10767    = solveUpsModExp('upModule['_+_[T, T']], DB) .
10768  eq solveUps('upModule['TUPLE`[_`]['token[T]]], DB)
10769    = solveUpsModExp('upModule['TUPLE`[_`]['token[T]]], DB) .
10770  eq solveUps('upModule['POWER`[_`]['token[T]]], DB)
10771    = solveUpsModExp('upModule['POWER`[_`]['token[T]]], DB) .
10772
10773  eq solveUpsCondition(T = T' /\ Cond, DB)
10774    = solveUps(T, DB) = solveUps(T', DB) /\ solveUpsCondition(Cond, DB) .
10775  eq solveUpsCondition(T : S /\ Cond, DB)
10776    = solveUps(T, DB) : S /\ solveUpsCondition(Cond, DB) .
10777  eq solveUpsCondition(T := T' /\ Cond, DB)
10778    = T := solveUps(T', DB) /\ solveUpsCondition(Cond, DB) .
10779  eq solveUpsCondition(T => T' /\ Cond, DB)
10780    = solveUps(T, DB) => solveUps(T', DB) /\ solveUpsCondition(Cond, DB) .
10781  eq solveUpsCondition(nil, DB) = nil .
10782
10783  ceq solveUpsModExp('upModule[T], DB)
10784    = up(getFlatModule(MN, DB'))
10785    if < DB' ; MN > := evalModExp(parseModExp(T), DB)
10786    /\ unitInDb(MN, DB') .
10787  ceq solveUpsModExp('upModule[T], DB)
10788    = qidError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n)
10789    if MN := parseModExp(T)
10790    [owise] .
10791
10792  eq solveUps('upTerm['token[T], 'bubble[T']], DB)
10793    = solveUpsModExp('upTerm['token[T], 'bubble[T']], DB) .
10794  eq solveUps('upTerm['`(_`)[T], 'bubble[T']], DB)
10795    = solveUpsModExp('upTerm['`(_`)[T], 'bubble[T']], DB) .
10796  eq solveUps('upTerm['_`{_`}[T, T'], 'bubble[T']], DB)
10797    = solveUpsModExp('upTerm['_`{_`}[T, T'], 'bubble[T']], DB) .
10798  eq solveUps('upTerm['_*`(_`)[T, T'], 'bubble[T']], DB)
10799    = solveUpsModExp('upTerm['_*`(_`)[T, T'], 'bubble[T']], DB) .
10800  eq solveUps('upTerm['_+_[T, T'], 'bubble[T']], DB)
10801    = solveUpsModExp('upTerm['_+_[T, T'], 'bubble[T']], DB) .
10802  eq solveUps('upTerm['TUPLE`[_`]['token[T]], 'bubble[T']], DB)
10803    = solveUpsModExp('upTerm['TUPLE`[_`]['token[T]], 'bubble[T']], DB) .
10804  eq solveUps('upTerm['POWER`[_`]['token[T]], 'bubble[T']], DB)
10805    = solveUpsModExp('upTerm['POWER`[_`]['token[T]], 'bubble[T']], DB) .
10806
10807  ceq solveUpsModExp('upTerm[T, 'bubble[T']], DB)
10808    = if included('META-MODULE, getImports(getInternalModule(MN, DB')), DB')
10809      then if metaParse(U, QIL, anyType) :: ResultPair
10810           then up(solveUps(getTerm(metaParse(U, QIL, anyType)), DB'))
10811           else qidError('\r 'Warning: '\o
10812                  'No 'parse 'for 'argument 'of 'up
10813                  printSyntaxError(metaParse(U, QIL, anyType), QIL)
10814                  '\n)
10815           fi
10816      else if metaParse(U, QIL, anyType) :: ResultPair
10817           then up(getTerm(metaParse(U, QIL, anyType)))
10818           else qidError('\r 'Warning: '\o
10819                  'No 'parse 'for 'argument 'of 'up
10820                  printSyntaxError(metaParse(U, QIL, anyType), QIL)
10821                  '\n)
10822           fi
10823      fi
10824    if < DB' ; MN > := evalModExp(parseModExp(T), DB)
10825       /\ U := getFlatModule(MN, DB')
10826       /\ QIL := downQidList(T').
10827  ceq solveUpsModExp('upTerm[T, 'bubble[T']], DB)
10828    = qidError('\r 'Error: 'op '\o 'Module header2QidList(ME) 'not 'in 'database. '\n)
10829    if ME := parseModExp(T)
10830    [owise] .
10831
10832  eq solveUps('`[_`][QI], DB) = '`[_`][QI] .
10833  ceq solveUps('`[_`]['token[T]], DB)
10834    = up(getFlatModule(QI, database(evalModExp(QI, DB))))
10835    if QI := downQid(T) .
10836  eq solveUps('`[_`][F[TL]], DB) = '`[_`][F[solveUps(TL, DB)]] [owise] .
10837
10838endfm
10839
10840-------------------------------------------------------------------------------
10841*******************************************************************************
10842-------------------------------------------------------------------------------
10843
10844***
10845*** Parsing the Bubbles in a Module
10846***
10847
10848*** The \texttt{solveBubbles} function defined in the
10849*** \texttt{UNIT-BUBBLE-PARSING} module takes a term of sort \texttt{Module} (a
10850*** preunit in fact) and a signature, and returns the unit resulting from the
10851*** evaluation (parsing) of all the bubbles in it.
10852
10853-------------------------------------------------------------------------------
10854*******************************************************************************
10855-------------------------------------------------------------------------------
10856
10857view AttrSet from TRIV to META-LEVEL is
10858  sort Elt to AttrSet .
10859endv
10860
10861
10862fmod UNIT-BUBBLE-PARSING is
10863  pr BUBBLE-PARSING .
10864  pr DATABASE .
10865  pr MOVE-UP .
10866  pr MOVE-DOWN .
10867  pr PRINT-SYNTAX-ERROR .
10868
10869  vars T T' T'' T3 T4 : Term .
10870  vars T? T?' : [Term] .
10871  vars TL TL' TL'' : TermList .
10872  vars TL? TL?' : [TermList] .
10873  var  B : Bool .
10874  vars M M' M'' : Module .
10875  var  DB : Database .
10876  vars PU U U' : Module .
10877  var  K : Kind .
10878  var  KS : KindSet .
10879  vars S S' : Sort .
10880  var  SS : SortSet .
10881  var  VE : ViewExp .
10882  vars Ty Ty' Tp : Type .
10883  vars TyL TyL' : TypeList .
10884  var  At : Attr .
10885  vars AtS AtS' AtS'' : AttrSet .
10886  var  NL : IntList .
10887  var  QI QI' QI'' QI3 QI4 QI5 F L : Qid .
10888  vars QIL QIL' : QidList .
10889  var  I : Nat .
10890  var  Hk : Hook .
10891  var  HkL : HookList .
10892  var  MAS : MembAxSet .
10893  var  Eq : Equation .
10894  var  EqS : EquationSet .
10895  var  Rl : Rule .
10896  var  RlS : RuleSet .
10897  var  OPD : OpDecl .
10898  vars OPDS OPDS' OPDS'' VDS : OpDeclSet .
10899  var  CD? : [Condition] .
10900  var  Ct : Constant .
10901  var  RP : [ResultPair] .
10902  var  St : String .
10903
10904*** In the parsing of bubbles themselves, we consider three different cases:
10905*** The case of having one single bubble in which no context is
10906*** considered (used to parse bubbles in term maps in views and in the
10907*** special attributes of operators); the case of two bubbles to be parsed in
10908*** the same connected component (used for bubbles in equations and rules),
10909*** and the case of one bubble to be parsed in a specific sort (used for the
10910*** bubbles appearing in the identity element attributes in the declarations
10911*** of operators, and in membership axioms). These three cases are reduced to
10912*** the case of one single bubble without context, which is handled by the
10913*** function \texttt{solveBubbles3}.
10914
10915  op solveBubblesEq : Term Term Module Bool OpDeclSet Database -> Term .
10916  op solveBubblesCEq : Term Term Module Bool OpDeclSet Database -> Term .
10917  op solveBubblesRl : Term Term Module Bool OpDeclSet Database -> Term .
10918  op solveBubblesCRl : Term Term Module Bool OpDeclSet Database -> Term .
10919  op solveBubbles2 : Term [Type] Module Bool OpDeclSet Database -> Term .
10920  op solveBubblesCond : Term Module Module Bool OpDeclSet Database -> [Condition] .
10921
10922  op conditionError : QidList -> [Condition] [ctor format (r o)] .
10923
10924*** The case of two bubbles, generated in the case of equations and rules, is
10925*** reduced to the case with one single bubble using the polymorphic operator
10926*** \verb~_==_~ and enclosing each of the bubbles in parentheses. Below, we
10927*** shall see how after calling this function the terms corresponding to each
10928*** of the bubbles is extracted.
10929
10930  ceq solveBubblesEq('bubble[T], 'bubble[T'], M, B, VDS, DB)
10931    = if RP :: ResultPair
10932      then if B
10933           then solveUps(constsToVars(getTerm(RP), VDS), DB)
10934           else constsToVars(getTerm(RP), VDS)
10935           fi
10936      else qidError('\r 'Warning:
10937                 '\o printSyntaxError(RP, '`( QIL '`) '= '`( QIL' '`)) '\n
10938                 '\r 'Error: '\o 'no 'parse 'for 'eq QIL '\s '= '\s QIL' '\n)
10939      fi
10940    if M' := addOps((VDS
10941                     op '_@@@=@@@_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .),
10942               addSorts('@@@, M))
10943       /\ QIL := downQidList(T)
10944       /\ QIL' := downQidList(T')
10945       /\ RP := metaParse(M', '`( QIL '`) '@@@=@@@ '`( QIL' '`), '@@@) .
10946
10947  ceq solveBubblesCEq('bubble[T], 'bubble[T'], M, B, VDS, DB)
10948    = if RP :: ResultPair
10949      then if B
10950           then solveUps(constsToVars(getTerm(RP), VDS), DB)
10951           else constsToVars(getTerm(RP), VDS)
10952           fi
10953      else qidError('\r 'Warning:
10954                 '\o printSyntaxError(RP, '`( QIL '`) '= '`( QIL' '`)) '\n
10955                 '\r 'Error: '\o 'no 'parse 'for 'ceq QIL '\s '= '\s QIL' '\n)
10956      fi
10957    if M' := addOps((VDS
10958                     op '_@@@=@@@_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .),
10959               addSorts('@@@, M))
10960       /\ QIL := downQidList(T)
10961       /\ QIL' := downQidList(T')
10962       /\ RP := metaParse(M', '`( QIL '`) '@@@=@@@ '`( QIL' '`), '@@@) .
10963
10964  ceq solveBubblesRl('bubble[T], 'bubble[T'], M, B, VDS, DB)
10965    = if RP :: ResultPair
10966      then if B
10967           then solveUps(constsToVars(getTerm(RP), VDS), DB)
10968           else constsToVars(getTerm(RP), VDS)
10969           fi
10970      else qidError('\r 'Warning:
10971                 '\o printSyntaxError(RP, '`( QIL '`) '=> '`( QIL' '`)) '\n
10972                 '\r 'Error: '\o 'no 'parse 'for 'rl QIL '\s '=> '\s QIL' '\n)
10973      fi
10974    if M' := addOps((VDS
10975                     op '_@@@=>@@@_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .),
10976               addSorts('@@@, M))
10977       /\ QIL := downQidList(T)
10978       /\ QIL' := downQidList(T')
10979       /\ RP := metaParse(M', '`( QIL '`) '@@@=>@@@ '`( QIL' '`), '@@@) .
10980  ceq solveBubblesCRl('bubble[T], 'bubble[T'], M, B, VDS, DB)
10981    = if RP :: ResultPair
10982      then if B
10983           then solveUps(constsToVars(getTerm(RP), VDS), DB)
10984           else constsToVars(getTerm(RP), VDS)
10985           fi
10986      else qidError('\r 'Warning:
10987                 '\o printSyntaxError(RP, '`( QIL '`) '=> '`( QIL' '`)) '\n
10988                 '\r 'Error: '\o 'no 'parse 'for 'crl QIL '\s '=> '\s QIL' '\n)
10989      fi
10990    if M' := addOps((VDS
10991                     op '_@@@=>@@@_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .),
10992               addSorts('@@@, M))
10993       /\ QIL := downQidList(T)
10994       /\ QIL' := downQidList(T')
10995       /\ RP := metaParse(M', '`( QIL '`) '@@@=>@@@ '`( QIL' '`), '@@@) .
10996
10997
10998  ceq solveBubbles2('bubble[T], T?:Type?, M, true, VDS, DB)
10999    = if RP :: ResultPair
11000      then solveUps(constsToVars(getTerm(RP), VDS), DB)
11001      else qidError('\r 'Warning:
11002                 '\o printSyntaxError(RP, QIL) '\n
11003                 '\r 'Error: 'No 'parse 'for QIL '\n)
11004      fi
11005    if QIL := downQidList(T)
11006       /\ RP := metaParse(M, QIL, T?:Type?) .
11007  ceq solveBubbles2('bubble[T], T?:Type?, M, false, VDS, DB)
11008    = if RP :: ResultPair
11009      then constsToVars(getTerm(RP), VDS)
11010      else qidError('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n
11011                 '\r 'Error: 'No 'parse 'for QIL '\n)
11012      fi
11013    if QIL := downQidList(T)
11014       /\ RP := metaParse(M, QIL, T?:Type?) .
11015
11016  op addInfoConds : Module -> [Module] .
11017  op addInfoConds : Module SortSet -> Module .
11018
11019  eq addInfoConds(M) = addInfoConds(M, getAllSorts(M)) .
11020
11021  eq addInfoConds(M, '@Token@ ; SS) = addInfoConds(M, SS) .
11022  eq addInfoConds(M, '@Bubble@ ; SS) = addInfoConds(M, SS) .
11023  eq addInfoConds(M, S ; SS)
11024    = addInfoConds(
11025        addOps(op qid(string(S)) : nil -> '@Sort@ [ctor] .
11026               op '_:_ : S '@Sort@ -> '@Condition@ [ctor prec(71)] ., M),
11027        SS)
11028    [owise] .
11029  eq addInfoConds(M, none)
11030    = addOps(op '_/\_ : '@Condition@ '@Condition@ -> '@Condition@
11031                               [ctor assoc prec(73)] .
11032             op '_=_  : 'Universal 'Universal -> '@Condition@
11033                               [ctor poly(1 2) prec(71)] .
11034             op '_:=_ : 'Universal 'Universal -> '@Condition@
11035                               [ctor poly(1 2) prec(71)] .
11036             op '_=>_ : 'Universal 'Universal -> '@Condition@
11037                               [ctor poly(1 2) prec(71)] .,
11038        addSorts('@Condition@ ; '@Sort@,
11039          if 'Bool in getSorts(M)
11040          then addSubsorts(subsort 'Bool < '@Condition@ ., M)
11041          else M
11042          fi)) .
11043
11044  ceq solveBubblesCond('bubble[T], M, M', B, VDS, DB)
11045    = if 'Bool in getSorts(M)
11046         and-then metaParse(M, QIL, 'Bool) :: ResultPair
11047      then if B
11048           then solveUps(constsToVars(getTerm(metaParse(M, QIL, 'Bool)), VDS), DB)
11049                = 'true.Bool
11050           else constsToVars(getTerm(metaParse(M, QIL, 'Bool)), VDS)
11051                = 'true.Bool
11052           fi
11053      else if metaParse(M', QIL, '@Condition@) :: ResultPair
11054           then if B
11055                then solveUpsCondition(
11056                       parseCond(getTerm(metaParse(M', QIL, '@Condition@)), VDS), DB)
11057                else parseCond(getTerm(metaParse(M', QIL, '@Condition@)), VDS)
11058                fi
11059           else conditionError('\r 'Warning: '\o
11060                  printSyntaxError(metaParse(M', QIL, '@Condition@), QIL) '\n)
11061           fi
11062      fi
11063    if QIL := downQidList(T) .
11064
11065  op parseCond : Term OpDeclSet -> Condition .
11066
11067  eq parseCond('_/\_[T, T'], VDS) = parseCond(T, VDS) /\ parseCond(T', VDS) .
11068  eq parseCond('_=_[T, T'], VDS)
11069    = constsToVars(T, VDS) = constsToVars(T', VDS) .
11070  eq parseCond('_:_[T, T'], VDS) = constsToVars(T, VDS) : getName(T') .
11071  eq parseCond('_:=_[T, T'], VDS)
11072    = constsToVars(T, VDS) := constsToVars(T', VDS) .
11073  eq parseCond('_=>_[T, T'], VDS)
11074    = constsToVars(T, VDS) => constsToVars(T', VDS) .
11075  eq parseCond(T, VDS) = constsToVars(T, VDS) = 'true.Bool [owise] .
11076
11077*** Since bubbles can only appear in the identity or special attributes in the
11078*** declaration of operators, in equations, membership axioms, and rules, the
11079*** evaluation of bubbles on a preunit is reduced to calls to the
11080*** \texttt{solveBubbles} functions on each of these sTS of declarations.
11081
11082  op solveBubblesMod : Module OpDeclSet Module Bool OpDeclSet Database -> Module .
11083
11084  op solveBubbles : EquationSet Module [Module] Bool OpDeclSet Database -> EquationSet .
11085  op solveBubbles : RuleSet Module [Module] Bool OpDeclSet Database -> RuleSet .
11086  op solveBubbles : MembAxSet Module [Module] Bool OpDeclSet Database -> MembAxSet .
11087  op solveBubbles : Condition Module Bool OpDeclSet Database -> Condition .
11088  op solveBubblesOps : OpDeclSet OpDeclSet Module Module -> OpDeclSet .
11089  op solveBubblesOps : OpDeclSet OpDeclSet Module -> OpDeclSet .
11090  op solveBubblesOpsAux : OpDeclSet Module -> OpDeclSet .
11091  op solveBubblesAts : AttrSet TypeList Type Module -> AttrSet .
11092  op solveBubblesHooks : HookList Type Module -> HookList .
11093
11094  ceq solveBubblesMod(PU, OPDS, M, B, VDS, DB)
11095    = setOps(
11096       (if getMbs(PU) == none and getEqs(PU) == none and getRls(PU) == none
11097        then PU
11098        else setEqs(
11099               setMbs(
11100                 setRls(PU,
11101                   solveBubbles(getRls(PU), M', addInfoConds(M'), B, VDS, DB)),
11102                 solveBubbles(getMbs(PU), M', addInfoConds(M'), B, VDS, DB)),
11103               solveBubbles(getEqs(PU), M', addInfoConds(M'), B, VDS, DB))
11104        fi),
11105       solveBubblesOps(getOps(PU), OPDS, M'))
11106    if M' := addOps(VDS, M) .
11107
11108*** To avoid the parsing ambiguities in the identity elements we add the sort
11109*** of the operator to be used as context in which doing the parsing. We
11110*** assume that the term given as identity element of an operator is in the
11111*** kind of the sort of such operator.
11112
11113  eq solveBubblesOps(OPDS, OPDS', M)
11114    = solveBubblesOps(OPDS, OPDS',
11115        setSubsorts(
11116          setSorts(emptyFModule('DUMMY), getSorts(M)), getSubsorts(M)), M) .
11117
11118  ceq solveBubblesOps(op F : TyL -> Ty [ditto AtS] . op F : TyL' -> Ty' [AtS'] . OPDS, OPDS', M, M')
11119    = solveBubblesOps(
11120        op F : TyL -> Ty [AtS removeCtorMetadata(AtS'')] . op F : TyL' -> Ty' [AtS''] . OPDS,
11121        OPDS', M, M')
11122    if not ditto in AtS'
11123    /\ sameKind(M, TyL Ty, TyL' Ty')
11124----    /\ AtS'' := solveBubblesAts(AtS', TyL', Ty', M') .
11125    /\ AtS'' := AtS' .
11126  ceq solveBubblesOps(op F : TyL -> Ty [ditto AtS] . OPDS, op F : TyL' -> Ty' [AtS'] . OPDS', M, M')
11127    = solveBubblesOps(op F : TyL -> Ty [AtS removeCtorMetadata(AtS'')] . OPDS, op F : TyL' -> Ty' [AtS''] . OPDS', M, M')
11128    if not ditto in AtS'
11129    /\ sameKind(M, TyL Ty, TyL' Ty')
11130----       /\ AtS'' := solveBubblesAts(AtS', TyL, Ty, M')
11131    /\ AtS'' := AtS' .
11132----    [owise] .
11133  eq solveBubblesOps(OPDS, OPDS', M, M')
11134    = solveBubblesOpsAux(OPDS, M')
11135    [owise] .
11136
11137  op removeCtorMetadata : AttrSet -> AttrSet .
11138  eq removeCtorMetadata(ctor AtS) = removeCtorMetadata(AtS) .
11139  eq removeCtorMetadata(metadata(St) AtS) = removeCtorMetadata(AtS) .
11140  eq removeCtorMetadata(AtS) = AtS [owise] .
11141
11142  eq solveBubblesOpsAux(op F : TyL -> Ty [AtS] . OPDS, M)
11143    = op F : TyL -> Ty [solveBubblesAts(AtS, TyL, Ty, M)] .
11144      solveBubblesOpsAux(OPDS, M) .
11145  eq solveBubblesOpsAux(none, M) = none .
11146
11147  eq solveBubblesAts(id('bubble[T]) AtS, TyL, Ty, M)
11148    = (id(solveBubbles2('bubble[T], Ty, M, false, none, emptyDatabase))
11149       solveBubblesAts(AtS, TyL, Ty, M)) .
11150  eq solveBubblesAts(left-id('bubble[T]) AtS, Ty TyL, Ty', M)
11151    = (left-id(solveBubbles2('bubble[T], Ty, M, false, none, emptyDatabase))
11152       solveBubblesAts(AtS, Ty TyL, Ty', M)) .
11153  eq solveBubblesAts(right-id('bubble[T]) AtS, TyL Ty, Ty', M)
11154    = (right-id(solveBubbles2('bubble[T], Ty, M, false, none, emptyDatabase))
11155       solveBubblesAts(AtS, TyL Ty, Ty', M)) .
11156  eq solveBubblesAts(special(HkL) AtS, TyL, Ty, M)
11157    = (special(solveBubblesHooks(HkL, Ty, M))
11158       solveBubblesAts(AtS, TyL, Ty, M)) .
11159  eq solveBubblesAts(AtS, TyL, Ty, M) = AtS [owise] .
11160
11161  eq solveBubblesHooks(term-hook(QI, 'bubble[T]) HkL, Ty, M)
11162    = term-hook(QI,
11163        solveBubbles2('bubble[T], anyType, M, false, none, emptyDatabase))
11164      solveBubblesHooks(HkL, Ty, M) .
11165  eq solveBubblesHooks(Hk HkL, Ty, M)
11166    = Hk solveBubblesHooks(HkL, Ty, M)
11167    [owise] .
11168  eq solveBubblesHooks(nil, Ty, M) = nil .
11169
11170*** Since both sides of any equation or rule have to be in the same connected
11171*** component of sorts, we parse the two bubbles together using the
11172*** polymorphic operator \verb~_==_~\footnote{Note that if including
11173*** \texttt{BOOL} the operator \texttt{\_\,==\_\,} is added for each kind.}.
11174*** That is, given for example an equation as \verb~eq T = T' .~, we parse
11175*** \verb~T == T'~, forcing them to be parsed in the same connected component,
11176*** if possible. We add functions \texttt{lhs} and \texttt{rhs} to extract,
11177*** respectively, the lefthand and righthand side terms from the result. Note
11178*** that these are partial functions.
11179
11180  pr 2TUPLE{Term,AttrSet}
11181       * (op p1_ to term, op p2_ to attrSet,
11182          op `(_`,_`) : Term AttrSet -> Tuple{Term,AttrSet} to `{_`,_`}) .
11183
11184  op pullStmtAttrOut : Term OpDeclSet -> [Tuple{Term,AttrSet}] .
11185  op pullStmtAttrOutAux : Term TermList AttrSet OpDeclSet -> [Tuple{Term,AttrSet}] .
11186  op pullLabelOut : Term -> [Tuple{Term,AttrSet}] .
11187
11188  eq pullStmtAttrOut('bubble[QI], VDS) = {'bubble[QI], none} .
11189  eq pullStmtAttrOut('bubble['__[QI, QI']], VDS) = {'bubble['__[QI, QI']], none} .
11190  eq pullStmtAttrOut('bubble['__[QI, QI', QI'']], VDS)
11191    = {'bubble['__[QI, QI', QI'']], none} .
11192  eq pullStmtAttrOut('bubble['__[QI, QI', TL, QI'']], VDS)
11193    = if QI'' =/= ''`].Qid
11194      then {'bubble['__[QI, QI', TL, QI'']], none}
11195      else pullStmtAttrOutAux('bubble['__[QI, QI', TL, QI'']], (QI, QI', TL), none, VDS)
11196      fi .
11197
11198  eq pullStmtAttrOutAux(T, (TL, ''`[.Qid), AtS, VDS)
11199    = if AtS =/= none
11200      then {'bubble['__[TL]], AtS}
11201      else {T, none}
11202      fi .
11203  eq pullStmtAttrOutAux(T, (TL, QI, ''nonexec.Qid), AtS, VDS)
11204    = pullStmtAttrOutAux(T, (TL, QI), AtS nonexec, VDS) .
11205  eq pullStmtAttrOutAux(T, (TL, QI, ''variant.Qid), AtS, VDS)
11206    = pullStmtAttrOutAux(T, (TL, QI), AtS variant, VDS) .
11207  eq pullStmtAttrOutAux(T, (TL, QI, ''owise.Qid), AtS, VDS)
11208    = pullStmtAttrOutAux(T, (TL, QI), AtS owise, VDS) .
11209  eq pullStmtAttrOutAux(T, (TL, QI, ''otherwise.Qid), AtS, VDS)
11210    = pullStmtAttrOutAux(T, (TL, QI), AtS owise, VDS) .
11211  eq pullStmtAttrOutAux(T, (TL, QI, ''label.Qid, QI'), AtS, VDS)
11212    = if downQid(QI') :: Qid
11213      then pullStmtAttrOutAux(T, (TL, QI), AtS label(downQid(QI')), VDS)
11214      else {T, none}
11215      fi .
11216  eq pullStmtAttrOutAux(T, (TL, QI, ''metadata.Qid, QI'), AtS, VDS)
11217    = if downString(downQid(QI')) :: String
11218      then pullStmtAttrOutAux(T, (TL, QI), AtS metadata(downString(downQid(QI'))), VDS)
11219      else {T, none}
11220      fi .
11221  ceq pullStmtAttrOutAux(T, (TL, QI, ''`[.Qid, TL',  ''print.Qid, TL''), AtS, VDS)
11222    = pullStmtAttrOutAux(T, (TL, QI, ''`[.Qid, TL'), AtS print(printArg(TL'', VDS)), VDS)
11223    if printArg(TL'', VDS) : QidList .
11224  eq pullStmtAttrOutAux(T, TL, AtS, VDS) = {T, none} [owise] .
11225
11226  op printArg : TermList OpDeclSet ~> QidList .
11227  ceq printArg((T, TL), op QI : nil -> Tp [AtS] . VDS)
11228    = qid(string(downQid(T)) + ":" + string(Tp)) printArg(TL, VDS)
11229    if QI = downQid(T) .
11230  ceq printArg((T, TL), VDS)
11231    = downQid(T) printArg(TL, VDS)
11232    if downString(downQid(T)) : String .
11233  eq printArg(empty, VDS) = nil .
11234
11235  eq pullLabelOut('bubble[QI]) = {'bubble[QI], none} .
11236  eq pullLabelOut('bubble['__[QI, QI']]) = {'bubble['__[QI, QI']], none} .
11237  eq pullLabelOut('bubble['__[QI, QI', QI'']])
11238    = {'bubble['__[QI, QI', QI'']], none} .
11239  eq pullLabelOut('bubble['__[QI, QI', QI'', QI3]])
11240    = {'bubble['__[QI, QI', QI'', QI3]], none} .
11241  eq pullLabelOut('bubble['__[QI, QI', QI'', QI3, TL]])
11242    = if QI == ''`[.Qid and-then (QI'' == ''`].Qid and-then QI3 == '':.Qid)
11243      then {'bubble['__[TL]], label(downQid(QI'))}
11244      else {'bubble['__[QI, QI', QI'', QI3, TL]], none}
11245      fi .
11246
11247  ops lhs rhs : Term -> Term .
11248  eq lhs(F[T, T']) = T .
11249  eq lhs(F[T, T']) = T .
11250  eq rhs(F[T, T']) = T' .
11251  eq rhs(F[T, T']) = T' .
11252  eq lhs(qidError(QIL)) = qidError(QIL) .
11253  eq rhs(qidError(QIL)) = qidError(QIL) .
11254
11255  eq solveBubbles(EqS, M, unitError(QIL), B, VDS, DB) = equationError(QIL) .
11256  eq solveBubbles(RlS, M, unitError(QIL), B, VDS, DB) = ruleError(QIL) .
11257  eq solveBubbles(MAS, M, unitError(QIL), B, VDS, DB) = membAxError(QIL) .
11258
11259  eq solveBubbles(((eq T = T' [AtS] .) EqS), M, M', B, VDS, DB)
11260    = ((eq lhs(solveBubblesEq(term(pullLabelOut(T)), term(pullStmtAttrOut(T', VDS)),
11261                 M, B, VDS, DB))
11262          = rhs(solveBubblesEq(term(pullLabelOut(T)), term(pullStmtAttrOut(T', VDS)),
11263                  M, B, VDS, DB))
11264            [attrSet(pullLabelOut(T)) attrSet(pullStmtAttrOut(T', VDS)) AtS] .)
11265       solveBubbles(EqS, M, M', B, VDS, DB)) .
11266  eq solveBubbles(((ceq T = T' if T'' = 'true.Bool [AtS] .) EqS),
11267       M, M', B, VDS, DB)
11268    = ((ceq lhs(solveBubblesCEq(term(pullLabelOut(T)), T', M, B, VDS, DB))
11269          = rhs(solveBubblesCEq(term(pullLabelOut(T)), T', M, B, VDS, DB))
11270          if solveBubblesCond(term(pullStmtAttrOut(T'', VDS)), M, M', B, VDS, DB)
11271          [attrSet(pullLabelOut(T)) attrSet(pullStmtAttrOut(T'', VDS)) AtS] .)
11272       solveBubbles(EqS, M, M', B, VDS, DB)) .
11273  eq solveBubbles((none).EquationSet, M, M', B, VDS, DB) = none .
11274
11275  eq solveBubbles(((rl T => T' [AtS] .) RlS), M, M', B, VDS, DB)
11276    = ((rl lhs(solveBubblesRl(term(pullLabelOut(T)),
11277                 term(pullStmtAttrOut(T', VDS)), M, B, VDS, DB))
11278        => rhs(solveBubblesRl(term(pullLabelOut(T)),
11279                 term(pullStmtAttrOut(T', VDS)), M, B, VDS, DB))
11280             [attrSet(pullLabelOut(T)) attrSet(pullStmtAttrOut(T', VDS)) AtS] .)
11281       solveBubbles(RlS, M, M', B, VDS, DB)) .
11282  eq solveBubbles(
11283       ((crl T => T' if T'' = 'true.Bool [AtS] .) RlS), M, M', B, VDS, DB)
11284    = ((crl lhs(solveBubblesCRl(term(pullLabelOut(T)), T', M, B, VDS, DB))
11285          => rhs(solveBubblesCRl(term(pullLabelOut(T)), T', M, B, VDS, DB))
11286          if solveBubblesCond(term(pullStmtAttrOut(T'', VDS)), M, M', B, VDS, DB)
11287          [attrSet(pullLabelOut(T)) attrSet(pullStmtAttrOut(T'', VDS)) AtS] .)
11288       solveBubbles(RlS, M, M', B, VDS, DB)) .
11289  eq solveBubbles((none).RuleSet, M, M', B, VDS, DB) = none .
11290
11291*** In the call to solve the bubbles in membership axioms we add the sort to
11292*** which it is constrained to be used as context.
11293
11294  eq solveBubbles(((mb T : S [AtS] .) MAS), M, M', B, VDS, DB)
11295    = ((mb solveBubbles2(term(pullLabelOut(T)), S, M, B, VDS, DB) : S
11296           [attrSet(pullLabelOut(T)) AtS] .)
11297       solveBubbles(MAS, M, M', B, VDS, DB)) .
11298  eq solveBubbles(((cmb T : S if T' = 'true.Bool [AtS] .) MAS),
11299       M, M', B, VDS, DB)
11300    = ((cmb solveBubbles2(term(pullLabelOut(T)), S, M, B, VDS, DB) : S
11301          if solveBubblesCond(T', M, M', B, VDS, DB)
11302          [attrSet(pullLabelOut(T)) AtS] .)
11303       solveBubbles(MAS, M, M', B, VDS, DB)) .
11304  eq solveBubbles((none).MembAxSet, M, M', B, VDS, DB) = none .
11305
11306*** The parsing process may generate error terms. Since in the
11307*** current version of the system Core Maude is generating the appropriate
11308*** error messages, we just have to worry about the elimination of these
11309*** terms. The effect is the same one as introducing a module at the object
11310*** level of Core Maude: If there is any term in an identity attribute in an
11311*** operator declaration, equation, rule, or membership axiom with a parsing
11312*** error a message is generated and the axiom is eliminated.
11313
11314  eq (op F : TyL -> Ty [id(qidError(QIL)) AtS] .) = opDeclError(QIL) .
11315  eq (op F : TyL -> Ty [left-id(qidError(QIL)) AtS] .) = opDeclError(QIL) .
11316  eq (op F : TyL -> Ty [right-id(qidError(QIL)) AtS] .) = opDeclError(QIL) .
11317
11318  eq (conditionError(QIL) /\ T = T' /\ CD?) = conditionError(QIL) .
11319  eq (conditionError(QIL) /\ T : S /\ CD?) = conditionError(QIL) .
11320  eq (conditionError(QIL) /\ T := T' /\ CD?) = conditionError(QIL) .
11321  eq (conditionError(QIL) /\ T => T' /\ CD?) = conditionError(QIL) .
11322
11323  eq (eq qidError(QIL) = T? [AtS] .) = equationError(QIL) .
11324  eq (eq T? = qidError(QIL) [AtS] .) = equationError(QIL) .
11325  eq (ceq qidError(QIL) = T? if CD? [AtS] .) = equationError(QIL) .
11326  eq (ceq T? = qidError(QIL) if CD? [AtS] .) = equationError(QIL) .
11327  eq (ceq T? = T?' if conditionError(QIL) [AtS] .) = equationError(QIL) .
11328
11329  eq (mb qidError(QIL) : S [AtS] .) = membAxError(QIL) .
11330  eq (cmb qidError(QIL) : S if CD? [AtS] .) = membAxError(QIL) .
11331  eq (cmb T? : S if conditionError(QIL) [AtS] .) = membAxError(QIL) .
11332
11333  eq (rl qidError(QIL) => T? [AtS] .) = ruleError(QIL) .
11334  eq (rl T? => qidError(QIL) [AtS] .) = ruleError(QIL) .
11335  eq (crl qidError(QIL) => T? if CD? [AtS] .) = ruleError(QIL) .
11336  eq (crl T? => qidError(QIL) if CD? [AtS] .) = ruleError(QIL) .
11337  eq (crl T? => T?' if conditionError(QIL) [AtS] .) = ruleError(QIL) .
11338
11339  eq F[qidError(QIL), TL?] = qidError(QIL) .
11340  eq F[TL?, qidError(QIL)] = qidError(QIL) .
11341  eq F[TL?, qidError(QIL), TL?'] = qidError(QIL) .
11342endfm
11343
11344-------------------------------------------------------------------------------
11345*******************************************************************************
11346-------------------------------------------------------------------------------
11347
11348*** The function \texttt{solveBubbles} defined in the following
11349*** \texttt{VIEW-BUBBLE-PARSING} module parses the bubbles in a set of preview
11350*** maps. It takes two modules, the signature of the view's source theory,
11351*** with the variables declared in the view, to parse the source term in the
11352*** term maps, and the target theory, with the mappings of the variable
11353*** declarations in the view, to parse the target terms.
11354
11355-------------------------------------------------------------------------------
11356*******************************************************************************
11357-------------------------------------------------------------------------------
11358
11359fmod VIEW-BUBBLE-PARSING is
11360  pr BUBBLE-PARSING .
11361  pr PRE-VIEW .
11362
11363  var  OMS : OpMappingSet .
11364  vars T T' : Term .
11365  vars M M' : Module .
11366  var  U : Module .
11367  var  QIL : QidList .
11368  vars VDS VDS' : OpDeclSet .
11369
11370  op solveBubbles : OpMappingSet OpDeclSet OpDeclSet Module Module -> OpMappingSet .
11371
11372  eq solveBubbles(OMS, VDS, VDS', U, unitError(QIL)) = none .
11373  eq solveBubbles(OMS, VDS, VDS', unitError(QIL), U) = none .
11374  eq solveBubbles(OMS, VDS, VDS', M, M') = OMS [owise] .
11375  eq solveBubbles((op_to`term_.(T, T') OMS), VDS, VDS', M, M')
11376    = (op_to`term_.(
11377         solveBubbles(T, M, false, VDS, emptyDatabase),
11378         solveBubbles(T', M', false, VDS', emptyDatabase))
11379      solveBubbles(OMS, VDS, VDS', M, M')) .
11380endfm
11381
11382-------------------------------------------------------------------------------
11383*******************************************************************************
11384-------------------------------------------------------------------------------
11385
11386***
11387*** Module Expression Evaluation
11388***
11389
11390*** So far we have not introduced more module expressions than those given by
11391*** simple quoted identifiers. We will introduce some later, but the scheme
11392*** followed for evaluating them is very simple and can be presented in a
11393*** generic way. Given a module expression and a database state, the
11394*** evaluation of a module expression results in the generation of a new
11395*** module, which is introduced in the database, with the module expression
11396*** as its name. The resulting database is then returned. If there is already
11397*** a module in the database with that name, the function returns the original
11398*** database without any change. The evaluation of a module expression may
11399*** produce the evaluation of other module expressions contained in the
11400*** modules involved in the process. This is the case, for example, for the
11401*** renaming of modules, in which not only the top module is renamed but,
11402*** perhaps, some of its submodules as well; it is also the case for the
11403*** instantiation of parameterized modules, where the module being
11404*** instantiated may contain submodules which are parameterized by some of
11405*** the parameter theories of the parameterized module in which are imported.
11406*** We shall discuss in more detail the renaming and instantiation of module
11407*** expressions in Sections~\ref{renaming} and~\ref{instantiation},
11408*** respectively.
11409
11410*** We saw in Section~\ref{module-expressions} how it is possible to import a
11411*** module expression in which a parameterized module is instantiated by some
11412*** of the formal parameters of the parameterized module into which it is
11413*** imported. To be able to evaluate this kind of module expression, the list
11414*** of parameters of the module in which the module expression appears has to
11415*** be given.
11416
11417-------------------------------------------------------------------------------
11418*******************************************************************************
11419-------------------------------------------------------------------------------
11420
11421fmod MOD-EXPR-EVAL is
11422  pr DATABASE .
11423
11424  *** decl. moved to module DATABASE
11425  *** op evalModExp : ModuleExpression Database -> Database .
11426  op evalModExp : ModuleExpression ParameterDeclList Database -> Tuple{Database, ModuleExpression} .
11427  op evalViewExp : ViewExp ParameterDeclList Database -> Database .
11428  op evalViewExp : ParameterList ParameterDeclList Database -> Database .
11429
11430  var  S : Sort .
11431  var  QI : Qid .
11432  var  ME : ModuleExpression .
11433  var  PDL : ParameterDeclList .
11434  var  DB : Database .
11435  vars VE VE' VE'' : ViewExp .
11436  vars PL PL' : ParameterList .
11437
11438  eq evalModExp(ME, DB) = evalModExp(ME, nil, DB) .
11439
11440  eq evalModExp(ME, PDL, DB) = < DB ; ME > [owise] .
11441
11442  eq evalModExp(QI, PDL, DB)
11443    = if unitInDb(QI, DB)
11444      then if compiledModule(QI, DB)
11445           then < DB ; QI >
11446           else < procModule(QI, DB) ; QI >
11447           fi
11448      else if upModule(QI, false) :: Module
11449           then < procModule(QI, insTermModule(QI, upModule(QI, false), DB)) ; QI >
11450           else < warning(DB, '\r 'Error: '\o 'Module QI 'not 'in 'database. '\n) ; QI >
11451           fi
11452      fi .
11453
11454  eq evalViewExp(QI, PDL, DB)
11455    = if labelInParameterDeclList(QI, PDL)
11456      then DB
11457      else if viewInDb(QI, DB)
11458           then if compiledView(QI, DB)
11459                then DB
11460                else procView(QI, DB)
11461                fi
11462           else if upView(QI) :: View
11463                then procView(upView(QI), DB)
11464                else warning(DB, ('\r 'Error: '\o 'View QI 'not 'in 'database. '\n))
11465                fi
11466           fi
11467      fi .
11468  eq evalViewExp(S{PL}, PDL, DB)
11469    = if viewInDb(S{PL}, DB)
11470      then DB
11471      else viewInst(S, PL, PDL, evalViewExp(S, PDL, evalViewExp(PL, PDL, DB)))
11472      fi .
11473  ceq evalViewExp(VE ;; VE', PDL, DB)
11474    = evalViewExp(VE, PDL, evalViewExp(VE', PDL, DB))
11475    if VE =/= mtViewExp /\ VE' =/= mtViewExp .
11476  eq evalViewExp((S, PL), PDL, DB)
11477    = evalViewExp(S, PDL, evalViewExp(PL, PDL, DB))
11478    [owise] .
11479  eq evalViewExp((S{PL}, PL'), PDL, DB)
11480    = evalViewExp(S{PL}, PDL, evalViewExp(PL', PDL, DB))
11481    [owise] .
11482  eq evalViewExp(nil, PDL, DB) = DB .
11483
11484  op viewInst : ViewExp ViewExp ParameterDeclList Database -> Database .
11485
11486*******************************************************************************
11487*** The equations specifying its behavior are later, in INST-EXPR-EVALUATION **
11488*******************************************************************************
11489
11490endfm
11491
11492-------------------------------------------------------------------------------
11493*******************************************************************************
11494-------------------------------------------------------------------------------
11495
11496***
11497*** The Transformation of Object-Oriented Modules to System Modules
11498***
11499
11500*** The transformation of object-oriented modules into system modules has
11501*** already been discussed in Section~\ref{omod2mod}, and also in
11502*** \cite{Meseguer93b,ClavelDuranEkerLincolnMarti-OlietMeseguerQuesada99}.
11503*** We focus here on the part of the process accomplished by each of the main
11504
11505*** functions involved in the transformation. The transformation discussed
11506*** in~\cite{DuranMeseguer98} assumed that object-oriented modules were
11507*** flattened before being transformed into system modules. However, doing it
11508*** in this way, the transformations already made for the modules in the
11509*** structure were not reused. In the current system, the transformation is
11510*** done only for the module being introduced, the top of the structure, and
11511*** dusing the `internal' representations of the submodules stored in the
11512*** ddatabase for the rest of the structure.
11513
11514*** This approach requires gathering all class and subclass relation
11515*** declarations in the structure before starting with the transformation
11516*** process itself. The function \texttt{prepClasses} collects all these
11517*** declarations in the structure, and completes all the declarations of
11518*** classes with the attributes inherited from their superclasses.
11519*** \begin{comment}
11520*** This function makes use of a `dummy' module, in which the classes are
11521*** introduced as sorts and the subclass relations as subsort relations to be
11522*** able to compute all the operations on the subclass relation using the
11523*** built-in functions on sorts.
11524*** \end{comment}
11525
11526*** Once all the class declarations in the structure have been collected and
11527*** completed, the transformation is accomplished in two stages. First, the
11528*** function \texttt{omod2modAux} carries out the
11529*** following tasks:
11530*** \begin{itemize}
11531*** \item For each class declaration of the form
11532***       $\texttt{class }C\texttt{ | }a_1\texttt{:} S_1\texttt{,}
11533***       \ldots\texttt{,} a_n\texttt{:} S_n$, the following items are
11534***       introduced: a subsort $C$ of sort \texttt{Cid}, a constant
11535***       $C$ of sort $C$, and declarations of operations $a_i
11536***       \texttt{\ :\_} \texttt{ :\,\,} S_i \texttt{ -> Attribute}$
11537***       for each attribute $a_i$ (the function
11538***       \texttt{ops4Attr} creates these declarations).
11539*** \item For each subclass relation of the form
11540***       $\texttt{subclass\ }C\texttt{\ <\ }C'$, a subsort
11541***       declaration $\texttt{subsort\ }C\texttt{\ <\ }C'$ is
11542***       introduced.
11543*** \item For each message declaration of the form \verb~msg F : TyL
11544***       -> S~, an operator declaration \verb~op F : TyL -> S~ is added.
11545*** \end{itemize}
11546*** When this process has been completed, the function \texttt{prepAxs} is
11547***  called.  This function applies to the membership axioms, equations, and
11548*** rewriting rules in the module the transformations indicated in
11549*** Section~\ref{omod2mod}, so that they become applicable to all the objects
11550*** of the given class and of their subclasses. The set of attributes of the
11551*** objects appearing in the membership axioms, equations, and rewriting rules
11552*** are completed, so that the default convention of not having to
11553*** exhaustively mention the set of attributes of a class is supported.
11554
11555*** Note that in Meseguer's paper~\cite{Meseguer93b} a parallel hierarchy of
11556*** sorts was defined to deal with objects in different classes, and membership
11557*** axioms constraining the objects to their corresponding sorts were added.
11558*** The transformation could be easily completed with sorts, subsort relations,
11559*** and membership constraints as indicated there. In fact, these declarations
11560*** were added in an initial version and were then removed because they were
11561*** computationally expensive. However, there are examples in which it would
11562*** be interesting to have them; when needed, these declarations can be
11563*** explicitly added by the user in the current version.
11564
11565-------------------------------------------------------------------------------
11566*******************************************************************************
11567-------------------------------------------------------------------------------
11568
11569fmod EXT-TERMSET is
11570  protecting TERMSET .
11571  op |_| : TermSet -> Nat .
11572  eq | X:Term | T:TermSet | = 1 + | T:TermSet | .
11573  eq | emptyTermSet | = 0 .
11574endfm
11575
11576view TermSet from TRIV to EXT-TERMSET is
11577  sort Elt to TermSet .
11578endv
11579
11580fmod O-O-TO-SYSTEM-MOD-TRANSF is
11581  pr DATABASE .
11582  pr CONVERSION .
11583  pr EXT-TERMSET .
11584
11585  var  DB : Database .
11586  var  I : Nat .
11587  var  ME : Header .
11588  vars S S' S'' C C' : Sort .
11589  vars SS SS' SS'' : SortSet .
11590  var  Ty : Type .
11591  var  TyL : TypeList .
11592  vars T T' T'' T3 : Term .
11593  vars TL TL' : TermList .
11594  var  PL : ParameterList .
11595  vars IL IL' IL'' : ImportList .
11596  vars CDS CDS' : ClassDeclSet .
11597  vars ADS ADS' : AttrDeclSet .
11598  var  SSDS : SubsortDeclSet .
11599  vars SCDS SCDS' : SubclassDeclSet .
11600  var  OPDS : OpDeclSet .
11601  var  MDS : MsgDeclSet .
11602  vars MAS MAS' : MembAxSet .
11603  vars EqS EqS' : EquationSet .
11604  vars RlS RlS' : RuleSet .
11605  var  QIL : QidList .
11606  var  NQIL : NeQidList .
11607  vars O O' : Term .
11608  vars M U : Module .
11609  vars QI A A' L F : Qid .
11610  var  V V' : Variable .
11611  var  CD : ClassDecl .
11612  vars SCD SCD' : SubclassDecl .
11613  vars Ct Ct' Ct'' : Constant .
11614  var  Cond : Condition .
11615  var  AtS : AttrSet .
11616  var  H : Header .
11617  var  PD : ParameterDecl .
11618  var  PDL : ParameterDeclList .
11619  var  MN : ModuleName .
11620  var  CH : ClassHierarchy .
11621  var  C'' : Sort .
11622  vars TS TS' : TermSet .
11623
11624
11625  op newVar : Sort Nat -> Variable .
11626  eq newVar(S, I) = qid("V#" + string(I, 10) + ":" + string(S)) .
11627
11628*** The function \texttt{prepClasses} completes all classes in the module with
11629*** all the attributes they inherit from their superclasses.
11630
11631  op prepClasses : ClassDeclSet SubclassDeclSet ImportList ParameterDeclList
11632       Database -> ClassDeclSet .
11633  op prepClasses2 : ClassDeclSet SubclassDeclSet ImportList
11634       ImportList Database -> ClassDeclSet .
11635  op prepClasses3 : ClassDeclSet SubclassDeclSet -> ClassDeclSet .
11636
11637  eq prepClasses(CDS, SCDS, IL, (PD, PDL), DB)
11638    = prepClasses(CDS, SCDS, (IL protecting pd(PD) .), PDL, DB) .
11639  eq prepClasses(CDS, SCDS, IL, nil, DB)
11640    = prepClasses2(CDS, SCDS, IL, nil, DB) .
11641
11642  eq prepClasses2(CDS, SCDS, ((including MN .) IL), IL', DB)
11643    = if (including MN . ) in IL'
11644      then prepClasses2(CDS, SCDS, IL, IL', DB)
11645      else prepClasses2(
11646             (getClasses(getTopModule(MN, DB)) CDS),
11647             (getSubclasses(getTopModule(MN, DB)) SCDS),
11648             (getImports(getTopModule(MN, DB)) IL),
11649             ((including MN .) IL'), DB)
11650      fi .
11651  eq prepClasses2(CDS, SCDS, ((extending MN .) IL), IL', DB)
11652    = if (extending MN . ) in IL'
11653      then prepClasses2(CDS, SCDS, IL, IL', DB)
11654      else prepClasses2(
11655             (getClasses(getTopModule(MN, DB)) CDS),
11656             (getSubclasses(getTopModule(MN, DB)) SCDS),
11657             (getImports(getTopModule(MN, DB)) IL),
11658             ((extending MN .) IL'), DB)
11659      fi .
11660  eq prepClasses2(CDS, SCDS, ((protecting MN .) IL), IL', DB)
11661    = if (protecting MN . ) in IL'
11662      then prepClasses2(CDS, SCDS, IL, IL', DB)
11663      else prepClasses2(
11664             (getClasses(getTopModule(MN, DB)) CDS),
11665             (getSubclasses(getTopModule(MN, DB)) SCDS),
11666             (getImports(getTopModule(MN, DB)) IL),
11667             ((protecting MN .) IL'), DB)
11668      fi .
11669  eq prepClasses2(CDS, SCDS, nil, IL, DB) = prepClasses3(CDS, SCDS) .
11670
11671  eq prepClasses3(CDS, SCDS)
11672    = addAttrs(buildHierarchy(CDS, SCDS, none, empty), SCDS) .
11673
11674  sort ClassHierarchy ClassStruct .
11675  subsort ClassStruct < ClassHierarchy .
11676
11677  op [_,_] : ClassDecl SortSet -> ClassStruct .
11678
11679  op empty : -> ClassHierarchy .
11680  op __ : ClassHierarchy ClassHierarchy -> ClassHierarchy
11681       [assoc comm id: empty] .
11682
11683  op buildHierarchy :
11684       ClassDeclSet SubclassDeclSet SortSet ClassHierarchy -> ClassHierarchy .
11685  op addAttrs : ClassHierarchy SubclassDeclSet -> ClassDeclSet .
11686  op addAttrsToItsSons :
11687       ClassDecl ClassHierarchy SubclassDeclSet -> ClassHierarchy .
11688
11689  eq buildHierarchy(((class C | ADS .) CDS), SCDS, SS, CH)
11690    = if C in SS
11691      then buildHierarchy(CDS, SCDS, SS, CH)
11692      else buildHierarchy(CDS, SCDS, C ; SS, [(class C | ADS .), none] CH)
11693      fi .
11694  eq buildHierarchy(none, (subclass C < C' .) SCDS, SS,
11695       [(class C | ADS .), SS'] [(class C' | ADS' .), SS''] CH)
11696    = buildHierarchy(none, SCDS, SS,
11697        [(class C | ADS .), C' ; SS'] [(class C' | ADS' .), SS''] CH) .
11698  eq buildHierarchy(none, none, SS, CH) = CH .
11699
11700  eq addAttrs([(class C | ADS .), none] CH, SCDS)
11701    = (class C | ADS .)
11702      addAttrs(addAttrsToItsSons((class C | ADS .), CH, SCDS), SCDS) .
11703  eq addAttrs(empty, SCDS) = none .
11704
11705  eq addAttrsToItsSons((class C | ADS .), [(class C' | ADS' .), C ; SS] CH,
11706       (subclass C' < C .) SCDS)
11707    = addAttrsToItsSons((class C | ADS .), [(class C' | ADS, ADS' .), SS] CH,
11708        SCDS) .
11709  ceq addAttrsToItsSons((class C | ADS .), CH, (subclass C' < C'' .) SCDS)
11710    = addAttrsToItsSons((class C | ADS .), CH, SCDS)
11711    if C =/= C'' .
11712  eq addAttrsToItsSons((class C | ADS .), CH, none) = CH .
11713
11714----  op inAttrDeclSet : Qid AttrDeclSet -> Bool .
11715----
11716----  eq inAttrDeclSet(A, ((attr A' : S), ADS))
11717----    = (A == A') or-else inAttrDeclSet(A, ADS) .
11718----  eq inAttrDeclSet(A, none) = false .
11719
11720*** Given a set of attribute declarations, the \texttt{ops4Attr}
11721*** function returns a set of operator declarations as indicated above. That
11722*** is, for each attribute $a\texttt{:} S$, an operator of the form
11723*** $a \texttt{\ :\_} \texttt{ :\,\,} S \texttt{ -> Attribute}$ is declared.
11724
11725  op ops4Attr : AttrDeclSet -> OpDeclSet .
11726
11727  eq ops4Attr(((attr A : S), ADS))
11728    = ((op qid(string(A) + "`:_") : S -> 'Attribute [gather('&)] .)
11729       ops4Attr(ADS)) .
11730  eq ops4Attr(none) = none .
11731
11732*** The function \texttt{prepLHS} takes the term in the lefthand side of a
11733*** rule, equation, or membership axiom, and replaces each object
11734***
11735***   $\texttt{<\ }O\texttt{\ :\ }C\texttt{\ |\ }ADS\texttt{\ >}$
11736***
11737*** in it---with $O$ of sort \texttt{Oid}, $C$ the name of a class, and $ADS$
11738*** a set of attributes with their corresponding values---by an object
11739***
11740***   $\texttt{<\ }O\texttt{\ :\ }V\texttt{\ |\ }ADS\ ADS'\ Atts\texttt{\ >}$
11741***
11742*** where the identifier of the class is replaced by a variable $V$ of sort
11743*** $C$, which is not used in the axiom, and where the set of attributes is
11744*** completed with attributes $ADS'$ as indicated in Section~\ref{omod2mod}, so
11745*** that each attribute declared in class $C$ or in any of its superclasses is
11746*** added with a new variable as value. $Atts$ is a new variable of sort
11747*** \texttt{AttributeSet}, which is used to range over the additional
11748*** attributes that may appear in objects of a subclass.
11749
11750*** The function \texttt{prepLHS} takes as arguments a term (in the initial
11751*** call, the term in the lefthand side of a rule, equation, or membership
11752*** axiom), the set of variable declarations of those variables declared in the
11753*** module that are not used in the axiom---new variables are created only if
11754*** there are no variables in the module with the appropriate sort---the set of
11755*** attributes in the* occurrences of the objects---and an index---to make sure
11756*** that the variables being added have not occurrences of the objects---and an
11757*** index---to make sure that the variables being added have not been added
11758*** previously. In the initial call this index is set to zero. \texttt{prepLHS}
11759*** gives as result a tuple composed of the resulting term, the set of objects
11760*** in the term (so that the modification of the objects in the righthand side
11761*** of the rule is simplified), the set of variable declarations corresponding
11762*** to the new added variables, the set of variable declarations of the
11763*** variables in the module that have not been used, and the index for the
11764*** creation of new variables.
11765
11766*** change (03/20/2002): a new variable is created everytime one is needed
11767
11768*** The set of objects in the lefthand side will be given as a set of terms.
11769
11770  pr 4TUPLE{TermList, TermSet, Nat, QidList}
11771       * (op p1_ to term, op p2_ to objects, op p3_ to index, op p4_ to messages,
11772          op ((_,_,_,_)) : TermList TermSet Nat QidList -> Tuple{TermList,TermSet,Nat,QidList} to <_;_;_;_>) .
11773
11774  op prepLHS : TermList ClassDeclSet Nat -> Tuple{TermList, TermSet, Nat, QidList} .
11775
11776  op crtObject : Term Sort AttrDeclSet Tuple{TermList, TermSet, Nat, QidList} -> Tuple{TermList, TermSet, Nat, QidList} .
11777  op crtObject2 : Term Variable TermList TermList AttrDeclSet TermSet Nat QidList -> Tuple{TermList, TermSet, Nat, QidList} .
11778  op crtObject3 : Term Qid TermList AttrDeclSet TermSet Nat QidList -> Tuple{TermList, TermSet, Nat, QidList} .
11779
11780  eq prepLHS(qidError(QIL), CDS, I) = < qidError(QIL) ; emptyTermSet ; I ; nil > .
11781  eq prepLHS(F, CDS, I) = < F ; emptyTermSet ; I ; nil > .
11782  eq prepLHS(Ct, CDS, I) = < Ct ; emptyTermSet ; I ; nil > .
11783
11784*** \texttt{prepLHS} on a list of terms $\texttt{(}T\texttt{,\ }TL\texttt{)}$,
11785*** with $T$ a term and $TL$ a list of terms, has to make a call to itself with
11786*** $T$ and with $TL$. The call with $TL$ has to be made with the result of
11787*** the call with $T$ so that the variables and the index are right.
11788
11789  ceq prepLHS((T, TL), CDS, I)
11790    = < (term(prepLHS(T, CDS, I)),
11791         term(prepLHS(TL, CDS, index(prepLHS(T, CDS, I))))) ;
11792        _|_(objects(prepLHS(T, CDS, I)),
11793                objects(prepLHS(TL, CDS, index(prepLHS(T, CDS, I))))) ;
11794        index(prepLHS(TL, CDS, index(prepLHS(T, CDS, I)))) ;
11795        (messages(prepLHS(T, CDS, I))
11796         messages(prepLHS(TL, CDS, index(prepLHS(T, CDS, I))))) >
11797    if TL =/= empty .
11798  ceq prepLHS(F[TL], CDS, I)
11799    = < F[term(prepLHS(TL, CDS, I))] ;
11800        objects(prepLHS(TL, CDS, I)) ;
11801        index(prepLHS(TL, CDS, I)) ;
11802        messages(prepLHS(TL, CDS, I)) >
11803      if (F =/= '<_:_|_>) /\ (F =/= '<_:_|`>) .
11804
11805  ceq prepLHS('<_:_|_>[O, Ct, T], ((class C | ADS .) CDS), I)
11806    = crtObject(O, C, ADS, prepLHS(T, ((class C | ADS .) CDS), I))
11807    if getName(Ct) == C .
11808  ceq prepLHS('<_:_|`>[O, Ct], ((class C | ADS .) CDS), I)
11809    = crtObject(O, C, ADS,
11810        prepLHS('none.AttributeSet, ((class C | ADS .) CDS), I))
11811    if getName(Ct) == C .
11812  eq prepLHS('<_:_|_>[O, V, T], CDS, I)
11813    = < '<_:_|_>[O, V, T] ; emptyTermSet ; I ; nil > .
11814                                                      *** is this eq necessary?
11815  eq prepLHS('<_:_|`>[O, T], CDS, I)
11816    = prepLHS('<_:_|_>[O, T, 'none.AttributeSet], CDS, I) .
11817
11818  eq prepLHS('<_:_|_>[O, T, T'], none, I)
11819    = < qidError('Error: 'undefined 'class T '\n) ; emptyTermSet ; I ; nil > .
11820
11821  eq crtObject(O, C, ADS, < T ; TS ; I ; QIL >)
11822    = crtObject2(O, newVar(C, I), T, 'none.AttributeSet, ADS, TS, (I + 1), QIL) .
11823
11824*** The function \texttt{crtObject2} is called with the metarepresentation of
11825*** the list of attributes appearing in the current object (third argument)
11826*** and the set of attribute declarations of the class to which such object
11827*** belongs + all the attributes declared in its superclasses (fifth
11828*** argument). The function proceeds recursively removing the attribute
11829*** declarations from the set of declarations of attributes for those
11830*** attributes that appear in the object. Each time an attribute is found, it
11831*** is passed with its actual value to the fourth argument of
11832*** \texttt{crtObject2}, which initially has value \verb~'none.AttributeSet~,
11833*** composing a list of terms with them.
11834
11835*** We assume that:
11836*** \begin{itemize}
11837*** \item The metarepresentation of a list of attributes is always given with
11838***       form \verb~'_`,_[F[T], T]~, \verb~F[T]~, or
11839***       \verb~'none.AttributeSet~, where \texttt{TL} is the
11840***       metarepresentation of a list of attributes with the same form (this
11841***       is ensured by the \verb~(e E)~ gathering pattern in the corresponding
11842***       declaration in the signature in which the parsing is done), and
11843*** \item that all the attributes appearing in an object have been declared in
11844***       the corresponding class declaration or in one of its superclasses.
11845*** \end{itemize}
11846
11847  eq crtObject2(O, V, '_`,_[F[T], TL], TL', ADS, TS, I, QIL)
11848    = crtObject2(O, V, (F[T], TL), TL', ADS, TS, I, QIL) .
11849
11850  ceq crtObject2(O, V, (F[T], TL), TL', ((attr A : S), ADS), TS, I, QIL)
11851    = crtObject2(O, V, TL, (F[T], TL'), ADS, TS, I, QIL)
11852    if qid(string(A) + "`:_") == F .
11853  eq crtObject2(O, V, (F[T], TL), TL', ADS, TS, I, QIL)
11854    = crtObject2(O, V, TL, TL', ADS, TS, I,
11855        (QIL '\r 'Warning: '\o 'Attribute F 'not 'valid '\n))
11856    [owise] .
11857
11858  ceq crtObject2(O, V, F[T], TL, ((attr A : S), ADS), TS, I, QIL)
11859    = crtObject3(O, V, (F[T], TL), ADS, TS, I, QIL)
11860    if qid(string(A) + "`:_") == F .
11861  eq crtObject2(O, V, F[T], TL, ADS, TS, I, QIL)
11862    = crtObject3(O, V, TL, ADS, TS, I,
11863        (QIL '\r 'Warning: '\o 'Attribute F 'not 'valid '\n))
11864    [owise] .
11865
11866  eq crtObject2(O, V, V', TL, ADS, TS, I, QIL)
11867    = crtObject3(O, V, TL, ADS, TS, I,
11868        QIL '\r 'Warning: '\o
11869            'Variables 'are 'not 'allowed 'in 'the 'set 'of 'attributes
11870            'of 'an 'object '`( V' '`) '\n) .
11871
11872  eq crtObject2(O, V, 'none.AttributeSet, TL, ADS, TS, I, QIL)
11873    = crtObject3(O, V, TL, ADS, TS, I, QIL) .
11874  eq crtObject2(O, V, empty, TL, ADS, TS, I, QIL)
11875    = crtObject3(O, V, TL, ADS, TS, I, QIL) .
11876
11877*** When the function \texttt{crtObject2} has gone through all the
11878*** attributes in the current object, the function \texttt{crtObject3} is
11879*** in charge of returning the metarepresentation of the current object
11880*** completed with the attributes that did not appear in it. These attributes
11881*** are added with new variables not used in the axiom as value.
11882*** \texttt{crtObject3} returns a pair composed by this resulting object,
11883*** and the set of terms representing all the objects in the lefthand
11884*** side (the current object is added to this set).
11885
11886  eq crtObject3(O, V, TL, ((attr A : S), ADS), TS, I, QIL)
11887    = crtObject3(O, V, (qid(string(A) + "`:_")[newVar(S, I)], TL),
11888        ADS, TS, (I + 1), QIL) .
11889
11890  eq crtObject3(O, V, TL, none, TS, I, QIL)
11891    = < '<_:_|_>[O, V, '_`,_[TL, newVar('AttributeSet, I)]] ;
11892        _|_('<_:_|_>[O, V, '_`,_[TL, newVar('AttributeSet, I)]], TS) ;
11893        (I + 1) ;
11894        QIL > .
11895
11896*** Once the lefthand side of a rule or equation has been `prepared', the
11897*** function \texttt{prepRHS} is called with the set of objects returned by
11898*** \texttt{prepLHS} and the term in the righthand side of such rule or
11899*** equation. The function \texttt{prepRHS} proceeds recursively throughout the
11900*** term looking for objects. Each time an object is found, its set of
11901*** attributes is completed with those in the modified object of the lefthand
11902*** side which do not appear in it.
11903
11904  op prepRHS : TermSet TermList -> TermList .
11905  op prepRHS : TermSet Condition -> Condition .
11906
11907  op adjustObject : TermSet Term -> Term .
11908
11909  op adjustObjectRHS : TermSet Term -> [Term] .
11910  op adjustAttrsObjectRHS : Term Term -> [Term] .
11911  op adjustAttrsObjectRHSAux : TermSet Term -> [Term] .
11912
11913  op termAttrListToTermSet : TermList -> TermSet .
11914  op _attrInTermSet_ : Qid TermSet -> Bool .
11915
11916  eq prepRHS(TS, T = T' /\ Cond)
11917    = prepRHS(TS, T) = prepRHS(TS, T') /\ prepRHS(TS, Cond) .
11918  eq prepRHS(TS, T : S /\ Cond)  = prepRHS(TS, T) : S /\ prepRHS(TS, Cond) .
11919  eq prepRHS(TS, T := T' /\ Cond)
11920    = prepRHS(TS, T) := prepRHS(TS, T') /\ prepRHS(TS, Cond) .
11921  eq prepRHS(TS, T => T' /\ Cond)
11922    = prepRHS(TS, T) => prepRHS(TS, T') /\ prepRHS(TS, Cond) .
11923  eq prepRHS(TS, (nil).Condition) = nil .
11924
11925  eq prepRHS(TS, qidError(QIL)) = qidError(QIL) .
11926  eq prepRHS(TS, F) = F .
11927  eq prepRHS(TS, Ct) = Ct .
11928  ceq prepRHS(TS, F[TL])
11929    = F[prepRHS(TS, TL)]
11930    if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) .
11931  eq prepRHS(TS, '<_:_|_>[O, Ct, T])
11932    = adjustObjectRHS(TS, '<_:_|_>[O, Ct, prepRHS(TS, T)]) .
11933  eq prepRHS(TS, '<_:_|_>[O, V, T]) = '<_:_|_>[O, V, prepRHS(TS, T)] .
11934  eq prepRHS(TS, '<_:_|`>[O, Ct])
11935    = adjustObjectRHS(TS, '<_:_|_>[O, Ct, prepRHS(TS, 'none.AttributeSet)]) .
11936  eq prepRHS(TS, '<_:_|`>[O, V])
11937    = '<_:_|_>[O, V, prepRHS(TS, 'none.AttributeSet)] .
11938  ceq prepRHS(TS, (T, TL))
11939    = (prepRHS(TS, T), prepRHS(TS, TL))
11940    if TL =/= empty .
11941
11942  eq adjustObjectRHS(_|_('<_:_|_>[O, V, T], TS), '<_:_|_>[O', Ct, T'])
11943    = if O == O'
11944      then if getType(V) == getType(Ct)
11945           then '<_:_|_>[O, V, adjustAttrsObjectRHS(T, T')]
11946           else '<_:_|_>[O', Ct, T']
11947           fi
11948      else adjustObjectRHS(TS, '<_:_|_>[O', Ct, T'])
11949      fi .
11950  eq adjustObjectRHS(emptyTermSet, '<_:_|_>[O, Ct, T]) = '<_:_|_>[O, Ct, T] .
11951
11952***  eq adjustObjectRHS(_|_('<_:_|_>[Ct, C, T], TS), '<_:_|_>[O, Ct', T'])
11953***    = adjustObjectRHS(TS, '<_:_|_>[O, Ct', T']) .
11954***  eq adjustObjectRHS(
11955***       _|_('<_:_|_>[Ct, C, T], TS), '<_:_|_>[Ct', Ct'', T'])
11956***    = if Ct == Ct'
11957***      then '<_:_|_>[Ct, Ct'', adjustAttrsObjectRHS(T, T')]
11958***      else adjustObjectRHS(TS, '<_:_|_>[Ct', Ct'', T'])
11959***      fi .
11960***  eq adjustObjectRHS(emptyTermSet, '<_:_|_>[Ct, Ct', T])
11961***    = '<_:_|_>[Ct, Ct', T] .
11962
11963*** The function \texttt{adjustAttrsObjectRHS} completes the set of
11964*** attributes of an object in the righthand side with those in the object in
11965*** the lefthand side or in the class not used in the lefthand side, which
11966*** have been completed by the function \texttt{crtObject}.
11967
11968  eq adjustAttrsObjectRHS('_`,_[TL], T)
11969    = adjustAttrsObjectRHSAux(termAttrListToTermSet(TL), T) .
11970
11971  eq adjustAttrsObjectRHSAux(_|_(A[T], TS), '_`,_[A[T'], T''])
11972    = '_`,_[A[T'], adjustAttrsObjectRHSAux(TS, T'')] .
11973  ceq adjustAttrsObjectRHSAux(TS, '_`,_[A[T], T'])
11974    = qidError(A 'is 'not 'a 'valid 'attribute)
11975    if not A attrInTermSet TS .
11976  eq adjustAttrsObjectRHSAux(_|_(A[T], TS), A[T'])
11977    = '_`,_[A[T'], adjustAttrsObjectRHSAux(TS, 'none.AttributeSet)] .
11978  ceq adjustAttrsObjectRHSAux(TS, A[T])
11979    = qidError(A 'is 'not 'a 'valid 'attribute)
11980    if not A attrInTermSet TS .
11981  eq adjustAttrsObjectRHSAux(_|_(A[T], TS), 'none.AttributeSet)
11982    = '_`,_[A[T], adjustAttrsObjectRHSAux(TS, 'none.AttributeSet)] .
11983  eq adjustAttrsObjectRHSAux(V, 'none.AttributeSet) = V .
11984
11985  eq A attrInTermSet _|_(V, TS) = A attrInTermSet TS .
11986  eq A attrInTermSet _|_(A'[T], TS)
11987    = (A == A') or-else (A attrInTermSet TS) .
11988  eq A attrInTermSet emptyTermSet = false .
11989
11990  ceq termAttrListToTermSet((T, TL))
11991    = if T == 'none.AttributeSet
11992      then termAttrListToTermSet(TL)
11993      else _|_(T, termAttrListToTermSet(TL))
11994      fi
11995    if TL =/= empty .
11996  eq termAttrListToTermSet(T)
11997    = if T == 'none.AttributeSet
11998      then emptyTermSet
11999      else T
12000      fi .
12001
12002*** In the case of equations and rules, the function \texttt{prepAxs} calls the
12003*** function \texttt{prepLHS} with the term in the lefthand side of the axiom,
12004*** and then use the generated set of objects to call the \texttt{prepRHS}
12005*** function. For conditional equations, rules, and membership axioms, this set
12006*** of terms representing the objects in the lefthand side is also used in the
12007*** calls to \texttt{prepRHS} with each of the terms in the conditions. The
12008*** term in the lefthand side of the equation, rule, or membership axiom is
12009*** replaced by the term returned by \texttt{prepLHS}. The index is used in
12010*** the recursive calls to \texttt{prepAxs}.
12011
12012*** \texttt{prepLHS} returns as second argument the set of objects (as a set of
12013*** terms) appearing in it. These objects are returned after extending their
12014*** set of attributes by those of the class to which they belong not already
12015*** specified.
12016
12017  op prepAxs : Module MembAxSet EquationSet RuleSet ClassDeclSet Nat QidList
12018       -> Module .
12019
12020  eq prepAxs(U, ((mb T : S [AtS] .) MAS), EqS, RlS, CDS, I, QIL)
12021    = prepAxs(
12022        addMbs(mb term(prepLHS(T, CDS, I)) : S [AtS] ., U),
12023        MAS, EqS, RlS, CDS,
12024        index(prepLHS(T, CDS, I)),
12025        (QIL messages(prepLHS(T, CDS, I)))) .
12026  eq prepAxs(U, ((cmb T : S if Cond [AtS] .) MAS), EqS, RlS, CDS, I, QIL)
12027    = prepAxs(
12028        addMbs(cmb term(prepLHS(T, CDS, I)) : S
12029                 if prepRHS(objects(prepLHS(T, CDS, I)), Cond) [AtS] ., U),
12030        MAS, EqS, RlS, CDS,
12031        index(prepLHS(T, CDS, I)),
12032        (QIL messages(prepLHS(T, CDS, I)))) .
12033  eq prepAxs(U, MAS, ((eq T = T' [AtS] .) EqS), RlS, CDS, I, QIL)
12034    = prepAxs(
12035        addEqs(eq term(prepLHS(T, CDS, I))
12036                 = prepRHS(objects(prepLHS(T, CDS, I)), T') [AtS] ., U),
12037        MAS, EqS, RlS, CDS,
12038        index(prepLHS(T, CDS, I)),
12039        (QIL messages(prepLHS(T, CDS, I)))) .
12040  eq prepAxs(U, MAS, ((ceq T = T' if Cond [AtS] .) EqS), RlS, CDS, I, QIL)
12041    = prepAxs(
12042        addEqs(ceq term(prepLHS(T, CDS, I))
12043                 = prepRHS(objects(prepLHS(T, CDS, I)), T')
12044                 if prepRHS(objects(prepLHS(T, CDS, I)), Cond) [AtS] ., U),
12045        MAS, EqS, RlS, CDS,
12046        index(prepLHS(T, CDS, I)),
12047        (QIL messages(prepLHS(T, CDS, I)))) .
12048
12049  eq prepAxs(U, MAS, EqS, ((rl T => T' [AtS] .) RlS), CDS, I, QIL)
12050    = prepAxs(
12051        addRls(rl term(prepLHS(T, CDS, I))
12052                 => prepRHS(objects(prepLHS(T, CDS, I)), T') [AtS] ., U),
12053        MAS, EqS, RlS, CDS,
12054        index(prepLHS(T, CDS, I)),
12055        (QIL messages(prepLHS(T, CDS, I)))) .
12056  eq prepAxs(U, MAS, EqS, ((crl T => T' if Cond [AtS] .) RlS), CDS, I, QIL)
12057    = prepAxs(
12058        addRls(crl term(prepLHS(T, CDS, I))
12059                 => prepRHS(objects(prepLHS(T, CDS, I)), T')
12060                 if prepRHS(objects(prepLHS(T, CDS, I)), Cond) [AtS] ., U),
12061        MAS, EqS, RlS, CDS,
12062        index(prepLHS(T, CDS, I)),
12063        (QIL messages(prepLHS(T, CDS, I)))) .
12064  eq prepAxs(U, none, none, none, CDS, I, nil) = U .
12065  eq prepAxs(U, none, none, none, CDS, I, NQIL) = unitError(NQIL) .
12066  eq prepAxs(unitError(QIL), MAS, EqS, RlS:[RuleSet], CDS, I, QIL':QidList) = unitError(QIL':QidList QIL) .
12067
12068*** After completing the set of classes in the module with the attributes from
12069*** their superclasses, the function \texttt{omod2mod} calls the function
12070*** \texttt{omod2modAux} with the same module and the set of class
12071*** declarations. The definition of the \texttt{omod2mod} function is given by
12072*** the five equations below.
12073
12074  op omod2mod : OModule Database -> SModule .
12075  op omod2modAux : OModule ClassDeclSet -> SModule .
12076  op omod2mod : OTheory Database -> SModule .
12077  op omod2modAux : OTheory ClassDeclSet -> SModule .
12078
12079  eq omod2mod(
12080       omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom,
12081       DB)
12082    = omod2modAux(
12083        omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom,
12084        prepClasses(CDS, SCDS, IL, getParDecls(H), DB)) .
12085  eq omod2mod(
12086       oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth,
12087       DB)
12088    = omod2modAux(
12089        oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth,
12090        prepClasses(CDS, SCDS, IL, getParDecls(H), DB)) .
12091
12092  eq omod2modAux(
12093       omod H is
12094          IL sorts SS . SSDS ((class C | ADS .) CDS) SCDS OPDS MDS MAS EqS RlS
12095       endom,
12096       CDS')
12097    = omod2modAux(
12098        omod H is
12099           IL sorts (SS ; C) .
12100           (subsort C < 'Cid . SSDS)
12101           CDS SCDS
12102           ((op C : nil -> C [none] .)
12103            ops4Attr(ADS) OPDS)
12104           MDS MAS EqS RlS
12105        endom,
12106        CDS') .
12107  eq omod2modAux(
12108       omod H is
12109          IL sorts SS . SSDS CDS ((subclass C < C' .) SCDS)
12110          OPDS MDS MAS EqS RlS
12111       endom,
12112       CDS')
12113    = omod2modAux(
12114        omod H is
12115           IL sorts SS . ((subsort C < C' .) SSDS)
12116           CDS SCDS OPDS MDS MAS EqS RlS
12117        endom,
12118        CDS') .
12119  eq omod2modAux(
12120        omod H is
12121           IL sorts SS . SSDS CDS SCDS OPDS
12122           ((msg F : TyL -> Ty .) MDS) MAS EqS RlS
12123        endom,
12124        CDS')
12125    = omod2modAux(
12126         omod H is
12127            IL sorts SS . SSDS CDS SCDS
12128            ((op F : TyL -> Ty [msg] .) OPDS) MDS MAS EqS RlS
12129         endom,
12130         CDS') .
12131  eq omod2modAux(
12132       omod H is IL sorts SS . SSDS none none OPDS none MAS EqS RlS endom,
12133       CDS)
12134    = prepAxs(mod H is IL sorts SS . SSDS OPDS none none none endm,
12135        MAS, EqS, RlS, CDS, 0, nil) .
12136
12137  eq omod2modAux(
12138       oth H is
12139          IL sorts SS . SSDS ((class C | ADS .) CDS)
12140          SCDS OPDS MDS MAS EqS RlS
12141       endoth,
12142       CDS')
12143    = omod2modAux(
12144        oth H is
12145           IL sorts (SS ; C) .
12146           (subsort C < 'Cid . SSDS)
12147           CDS SCDS
12148           ((op C : nil -> C [none] .)
12149            ops4Attr(ADS) OPDS)
12150           MDS MAS EqS RlS
12151        endoth,
12152        CDS') .
12153  eq omod2modAux(
12154       oth H is
12155          IL sorts SS . SSDS CDS ((subclass C < C' .) SCDS)
12156          OPDS MDS MAS EqS RlS
12157       endoth,
12158       CDS')
12159    = omod2modAux(
12160        oth H is
12161           IL sorts SS . ((subsort C < C' .) SSDS)
12162           CDS SCDS OPDS MDS MAS EqS RlS
12163        endoth,
12164        CDS') .
12165  eq omod2modAux(
12166        oth H is
12167           IL sorts SS . SSDS CDS SCDS OPDS
12168           ((msg F : TyL -> Ty .) MDS) MAS EqS RlS
12169        endoth,
12170        CDS')
12171    = omod2modAux(
12172         oth H is
12173            IL sorts SS . SSDS CDS SCDS
12174            ((op F : TyL -> Ty [msg] .) OPDS) MDS MAS EqS RlS
12175         endoth,
12176         CDS') .
12177  eq omod2modAux(
12178       oth H is IL sorts SS . SSDS none none OPDS none MAS EqS RlS endoth,
12179       CDS)
12180    = prepAxs(
12181        th H is IL sorts SS . SSDS OPDS none none none endth,
12182        MAS, EqS, RlS, CDS, 0, nil) .
12183endfm
12184
12185-------------------------------------------------------------------------------
12186*******************************************************************************
12187-------------------------------------------------------------------------------
12188
12189***
12190*** Evaluation of Modules and Theories
12191***
12192
12193*** As explained in Section~\ref{evaluation-overview}, in our approach
12194*** transforming a module from its possibly complex structured version to its
12195*** unstructured form is a two-step process.  First, all module expressions
12196*** are evaluated, generating an intermediate form in which there are only
12197*** simple inclusion relationships among the modules. This first step can be
12198*** seen as the reduction of a structured specification to its structured
12199*** \emph{normal form}. Then, in a second step, this structured normal form is
12200*** flattened into an unstructured specification.  Note, however, that the
12201*** importation of built-in modules is left explicit in the flattened form.
12202*** The function \texttt{normalize} is in charge of normalizing the
12203*** structure.
12204
12205*** The process of evaluation of a preunit has to take into account the
12206*** possibility of bubbles being contained in it. Depending on whether it is
12207*** dealing with a preunit or with a unit, the evaluation process is
12208*** accomplished by two different functions, namely, \texttt{evalPreModule} and
12209*** \texttt{evalModule}. One function or the other will be called in each case.
12210*** Evaluating a module already in the database, which is done by
12211*** \texttt{evalModule}, does not require bubble handling. Besides this
12212*** difference, both functions proceed in a similar way. Before presenting the
12213*** functions \texttt{evalPreModule} and \texttt{evalModule} we introduce some
12214*** auxiliary declarations.
12215
12216-------------------------------------------------------------------------------
12217*******************************************************************************
12218-------------------------------------------------------------------------------
12219
12220fmod EVALUATION is
12221  pr O-O-TO-SYSTEM-MOD-TRANSF .
12222  pr MOD-EXPR-EVAL .
12223  pr UNIT-BUBBLE-PARSING .
12224
12225  sort List<Module> .
12226  subsort Module < List<Module> .
12227
12228  op nil : -> List<Module> .
12229  op __ : List<Module> List<Module> -> List<Module> [assoc id: nil] .
12230  eq unitError(QIL) UL unitError(QIL') = unitError(QIL QIL') UL .
12231
12232  vars M PU U U' U'' : Module .
12233  vars UL UL' : List<Module> .
12234  vars DB  DB' : Database .
12235  vars ME ME' : ModuleExpression .
12236  var  P : ViewExp .
12237  var  PD : ParameterDecl .
12238  vars PL PL' PL'' : ParameterList .
12239  vars IL IL' IL'' : ImportList .
12240  var  I : Import .
12241  var  CDS : ClassDeclSet .
12242  var  SSDS : SubsortDeclSet .
12243  var  SCDS : SubclassDeclSet .
12244  var  OPD : OpDecl .
12245  vars OPDS VDS : OpDeclSet .
12246  var  MDS : MsgDeclSet .
12247  var  MAS : MembAxSet .
12248  var  EqS : EquationSet .
12249  var  RlS : RuleSet .
12250  var  B : Bool .
12251  vars QI QI' V L L' L'' A A' A'' F F' F'' X Y W Z : Qid .
12252  vars QIL QIL' SL : QidList .
12253  vars S S' S'' C C' C'' : Sort .
12254  vars SS SS' : SortSet .
12255  vars Ty Ty' : Type .
12256  vars TyL TyL' : TypeList .
12257  vars AtS AtS' : AttrSet .
12258  var  Rl : Rule .
12259  var  CD : ClassDecl .
12260  var  ADS : AttrDeclSet .
12261  var  MD : MsgDecl .
12262  vars T T' T'' T3 : Term .
12263  var  TL : TermList .
12264  var  MAP : Renaming .
12265  var  MAPS : RenamingSet .
12266  vars VE VE' VE'' : ViewExp .
12267  var  HkL : HookList .
12268  vars PDL PDL' : ParameterDeclList .
12269  var  St : String .
12270
12271*** The \texttt{subunitImports} function returns the list of all the
12272*** subunits of a given unit. It is called with the list of importations of
12273*** the given unit as first argument, and proceeds recursively through its
12274*** structure collecting all the subunits in it.
12275
12276*** The function \texttt{subunitImports} proceeds storing the importations
12277*** considered up to that point, so it does not have to go through the same
12278*** part of the structure more than once. When the function is initially
12279*** called the second argument is set to \texttt{nil}.
12280
12281  op subunitImports : ParameterDeclList ImportList Database -> ImportList .
12282  op subunitImports : ImportList ImportList Database -> ImportList .
12283
12284  eq subunitImports((PD, PDL), IL, DB)
12285    = subunitImports(PDL, IL (protecting pd(PD) .), DB) .
12286  eq subunitImports((nil).ParameterDeclList, IL, DB)
12287    = subunitImports(IL, nil, DB) .
12288
12289  eq subunitImports(I IL, IL' I IL'', DB)
12290    = subunitImports(IL, IL' I IL'', DB)  .
12291  eq subunitImports(I IL, IL', DB)
12292    = subunitImports(getImports(getTopModule(moduleName(I), DB)) IL, I IL', DB)
12293    [owise] .
12294  eq subunitImports((nil).ImportList, IL, DB) = IL .
12295
12296*** The function \texttt{getModules} returns the list of those units
12297*** in the list of importations given as argument which are not built-in.
12298
12299  op getModules : ImportList Database -> List<Module> .
12300  op getModules : ImportList List<Module> Database -> List<Module> .
12301
12302  eq getModules(IL, DB) = getModules(IL, nil, DB) .
12303
12304  eq getModules(((including ME .) IL), UL, DB)
12305    = getModules(IL, (UL getInternalModule(ME, DB)), DB) .
12306  eq getModules(((including pd(PD) .) IL), UL, DB)
12307    = getModules(IL, (UL getInternalModule(pd(PD), DB)), DB) .
12308  eq getModules(((extending ME .) IL), UL, DB)
12309    = getModules(IL, (UL getInternalModule(ME, DB)), DB) .
12310  eq getModules(((extending pd(PD) .) IL), UL, DB)
12311    = getModules(IL, (UL getInternalModule(pd(PD), DB)), DB) .
12312  eq getModules(((protecting ME .) IL), UL, DB)
12313    = getModules(IL, (UL getInternalModule(ME, DB)), DB) .
12314  eq getModules(((protecting pd(PD) .) IL), UL, DB)
12315    = getModules(IL, (UL getInternalModule(pd(PD), DB)), DB) .
12316  eq getModules(IL, UL unitError(QIL) UL', DB) = unitError(QIL) .
12317  eq getModules(nil, UL, DB) = UL .
12318
12319*** The normalization of a structure consists in evaluating each of the module
12320*** expressions appearing in it. Note that, if the \texttt{evalModExp} function
12321*** generates new modules, they will be evaluated using the \texttt{evalModule}
12322*** function, producing recursive calls on the part of the structure not
12323*** previously normalized. Parameters are handled separatedly. They are
12324*** folded out when analyzing the interface of a module.
12325
12326  pr 3TUPLE{ImportList,ParameterDeclList,Database}
12327       * (op ((_,_,_)) to <_;_;_>,
12328          op p1_ to importList,
12329          op p2_ to parameterDeclList,
12330          op p3_ to database) .
12331
12332----  sort Tuple{ImportList,ParameterDeclList,Database} .
12333----  op <_;_;_> : ImportList ParameterDeclList Database
12334----       -> Tuple{ImportList,ParameterDeclList,Database} .
12335----  op importList : Tuple{ImportList,ParameterDeclList,Database} -> ImportList .
12336----  op parameterDeclList :
12337----       Tuple{ImportList,ParameterDeclList,Database} -> ParameterDeclList .
12338----  op database : Tuple{ImportList,ParameterDeclList,Database} -> Database .
12339----  eq importList(< IL ; PDL ; DB >) = IL .
12340----  eq parameterDeclList(< IL ; PDL ; DB >) = PDL .
12341----  eq database(< IL ; PDL ; DB >) = DB .
12342
12343  op normalize : ImportList ParameterDeclList Database
12344       -> Tuple{ImportList,ParameterDeclList,Database} .
12345  op normalize : ImportList ImportList ParameterDeclList ParameterDeclList
12346       Database -> Tuple{ImportList,ParameterDeclList,Database} .
12347  op createCopy : ParameterDecl Database -> Database .
12348  ---- its definition is in INST-EXPR-EVALUATION
12349
12350  eq normalize(IL, PDL, DB) = normalize(nil, IL, nil, PDL, DB) .
12351
12352  eq normalize(IL, IL', PDL, (X :: ME, PDL'), DB)
12353    = normalize(IL, IL',
12354        (PDL, X :: modExp(evalModExp(ME, nil, DB))), PDL',
12355        createCopy((X :: modExp(evalModExp(ME, nil, DB))),
12356          database(evalModExp(ME, nil, DB)))) .
12357  eq normalize(IL, (including ME .) IL', PDL, PDL', DB)
12358    = normalize(IL (including modExp(evalModExp(ME, PDL, DB)) .), IL',
12359        PDL, PDL', database(evalModExp(ME, PDL, DB))) .
12360  eq normalize(IL, (extending ME .) IL', PDL, PDL', DB)
12361    = normalize(IL (extending modExp(evalModExp(ME, PDL, DB)) .), IL',
12362        PDL, PDL', database(evalModExp(ME, PDL, DB))) .
12363  eq normalize(IL, (protecting ME .) IL', PDL, PDL', DB)
12364    = normalize(IL (protecting modExp(evalModExp(ME, PDL, DB)) .), IL',
12365        PDL, PDL', database(evalModExp(ME, PDL, DB))) .
12366  eq normalize(IL, I IL', PDL, PDL', DB)
12367    = normalize(IL I, IL', PDL, PDL', DB)
12368    [owise] .
12369  eq normalize(IL, nil, PDL, nil, DB) = < IL ; PDL ; DB > .
12370
12371*** \texttt{checkSortClashes} checks whether the intersection of the two sTS
12372*** of sorts given as arguments is empty or not. If it is nonempty, then there
12373*** is a clash of names, and a warning message is passed to the database.  The
12374*** check is very simple, and only reports the name of one of the modules from
12375*** which the sorts come. Only the name of the module from which the sorts
12376*** given as second argument come is known at this point. This is the module
12377*** name given as first argument.
12378***
12379***   op checkSortClashes : Header SortSet SortSet Database -> Database .
12380***
12381***   eq checkSortClashes(ME, (S ; SS), (S ; SS'), DB)
12382***     = checkSortClashes(ME, SS, SS',
12383***         warning(DB,
12384***           '\g 'Advisory: '\o
12385***           'Clash 'of 'sort eSortToSort(S) 'from header2Qid(ME) '\n)) .
12386***   ceq checkSortClashes(ME, (S ; SS), SS', DB)
12387***     = checkSortClashes(ME, SS, SS', DB)
12388***     if not (S in SS') .
12389***   eq check(ME, none, SS, DB) = DB .
12390
12391*** In the current system, the only transformation handled by the
12392*** \texttt{transform} function is the one from object-oriented modules to
12393*** system modules, which is accomplished by the
12394*** \texttt{omod2mod} function presented in
12395*** Section~\ref{omod2modfunction}. However, \texttt{transform} has been
12396*** defined as a general transformation that could affect other kinds of
12397*** modules in a future extension.
12398
12399  op transform : Module Database -> Module .
12400
12401  eq transform(unitError(QIL), DB) = unitError(QIL) .
12402  ceq transform(U, DB) = rmVariantAttrs(U) if U :: SModule or U :: STheory .
12403  ceq transform(U, DB) = rmVariantAttrs(omod2mod(U, DB))
12404    if not U :: SModule /\ not U :: STheory /\ U :: OModule or U :: OTheory .
12405
12406*** The function \texttt{signature} generates a functional module of sort
12407*** \texttt{FModule}, without equations, by ``forgetting'' the appropriate
12408*** declarations and converting extended sorts and module names into quoted
12409*** identifiers.
12410
12411  op removeIds : OpDeclSet Module -> OpDeclSet .
12412  eq removeIds(op F : TyL -> Ty [id(T) AtS] . OPDS, M)
12413    = removeIds(op F : TyL -> Ty [AtS] . OPDS, M) .
12414  eq removeIds(op F : TyL -> Ty [right-id(T) AtS] . OPDS, M)
12415    = removeIds(op F : TyL -> Ty [AtS] . OPDS, M) .
12416  eq removeIds(op F : TyL -> Ty [left-id(T) AtS] . OPDS, M)
12417    = removeIds(op F : TyL -> Ty [AtS] . OPDS, M) .
12418  eq removeIds(op F : TyL -> Ty [special(term-hook(QI, T) HkL) AtS] . OPDS, M)
12419    = removeIds(op F : TyL -> Ty [special(HkL) AtS] . OPDS, M) .
12420  eq removeIds(OPDS, M) = OPDS [owise] .
12421
12422  op removeDittos : OpDeclSet Module -> OpDeclSet .
12423  ceq removeDittos(
12424        op F : TyL -> Ty [ditto AtS] . op F : TyL' -> Ty' [AtS'] . OPDS, M)
12425    = removeDittos(
12426        op F : TyL -> Ty [AtS removeCtorMetadata(AtS')] . op F : TyL' -> Ty' [AtS'] . OPDS, M)
12427    if not ditto in AtS' /\ sameKind(M, TyL Ty, TyL' Ty') .
12428  eq removeDittos(OPDS, M) = OPDS [owise] .
12429
12430  op signature : Module -> Module .
12431  eq signature(unitError(QIL)) = unitError(QIL) .
12432  eq signature(U)
12433    = fmod header2Qid(getName(U)) is
12434         convertModuleExpressions(getImports(U))
12435         sorts getSorts(U) .
12436         getSubsorts(U)
12437         removeIds(
12438           removeDittos(getOps(U),
12439             setSubsorts(
12440               setSorts(emptyFModule('DUMMY), getSorts(U)),
12441               getSubsorts(U))),
12442           setSubsorts(
12443             setSorts(emptyFModule('DUMMY), getSorts(U)),
12444             getSubsorts(U)))
12445         none
12446         none
12447      endfm
12448    [owise] .
12449
12450*** The function \texttt{flatModule} generates a module of sort \texttt{Module}
12451*** by ``forgetting'' declarations and converting extended sorts and module
12452*** identifiers into quoted identifiers.
12453
12454  op flatModule : Module -> Module .
12455  eq flatModule(unitError(QIL)) = unitError(QIL) .
12456  eq flatModule(U)
12457    = if U :: FModule or U :: FTheory
12458      then (fmod header2Qid(getName(U)) is
12459               getImports(U)
12460               sorts getSorts(U) .
12461               getSubsorts(U)
12462               getOps(U)
12463               getMbs(U)
12464               getEqs(U)
12465            endfm)
12466      else (mod header2Qid(getName(U)) is
12467               getImports(U)
12468               sorts getSorts(U) .
12469               getSubsorts(U)
12470               getOps(U)
12471               getMbs(U)
12472               getEqs(U)
12473               getRls(U)
12474            endm)
12475      fi
12476    [owise] .
12477
12478  op convertModuleExpressions : ImportList -> ImportList .
12479  eq convertModuleExpressions(((protecting ME * (MAPS) .) IL))
12480    = (protecting ME * (renamings(MAPS)) .) convertModuleExpressions(IL) .
12481  eq convertModuleExpressions(((extending ME * (MAPS) .) IL))
12482    = (extending ME * (renamings(MAPS)) .) convertModuleExpressions(IL) .
12483  eq convertModuleExpressions(((including ME * (MAPS) .) IL))
12484    = (including ME * (renamings(MAPS)) .) convertModuleExpressions(IL) .
12485  eq convertModuleExpressions(I IL) = I convertModuleExpressions(IL) [owise] .
12486  eq convertModuleExpressions(nil) = nil .
12487
12488  op renamings : RenamingSet -> RenamingSet .
12489  eq renamings(op F to F' [AtS]) = op F to F' [AtS] .
12490  eq renamings((op F to F' [AtS], MAPS))
12491    = (op F to F' [AtS], renamings(MAPS))
12492    [owise] .
12493  eq renamings(op F : TyL -> Ty to F' [AtS])
12494    = op F : TyL -> Ty to F' [AtS] .
12495  eq renamings((op F : TyL -> Ty to F' [AtS], MAPS))
12496    = (op F : TyL -> Ty to F' [AtS],
12497       renamings(MAPS))
12498    [owise] .
12499  eq renamings(sort S to S') = sort S to S' .
12500  eq renamings(((sort S to S'), MAPS))
12501    = ((sort S to S'), renamings(MAPS))
12502    [owise] .
12503  eq renamings(label L to L') = label L to L' .
12504  eq renamings(((label L to L'), MAPS))
12505    = ((label L to L'), renamings(MAPS))
12506    [owise] .
12507  eq renamings((MAP, MAPS)) = renamings(MAPS) [owise] .
12508  eq renamings(none) = none .
12509
12510*** The evaluation process for units without bubbles is as follows. After
12511*** normalizing the structure, the function \texttt{evalModule} calls
12512*** \texttt{evalModule1} with an empty copy of the module to which the list of
12513*** declarations of importations of built-in modules is added, and with the
12514*** list of its nonbuilt-in subunits.
12515
12516*** \texttt{evalModule1} accumulates all the declarations in all the
12517*** nonbuilt-insubmodules in the copy of the module passed as second argument.
12518*** The top module is then introduced in the database, and, after calling the
12519*** \texttt{transform} function and renaming all the variables in it, the
12520*** internal version of such a module is entered in the database as well.
12521
12522*** Finally, \texttt{evalModule2} generates the signature and the flat version
12523*** of the module and enters them in the database.
12524
12525  *** op evalModule : Module Database -> Database .
12526  ***  moved to MOD-EXPR-EVAL to solve dependency
12527  op evalModule1 : Module Module List<Module> OpDeclSet Database -> Database .
12528  op evalModule2 : Module Module Database -> Database .
12529
12530  ceq evalModule(U, VDS, DB)
12531    = evalModule1(setPars(setImports(U, IL), PDL), empty(U),
12532        getModules(IL', DB'), VDS, DB')
12533    if < IL ; PDL ; DB' > := normalize(getImports(U), getPars(U), DB)
12534    /\ IL' := subunitImports(PDL, IL, DB') .
12535   eq evalModule(U, VDS, DB) = DB [owise] .
12536
12537  eq evalModule1(U, U', (U'' UL), VDS, DB)
12538    = evalModule1(U, addDecls(U', setImports(U'', nil)), UL, VDS, DB) .
12539  eq evalModule1(U, U', nil, VDS, DB)
12540    = evalModule2(
12541        setImports(transform(U, DB), nil),
12542        U',
12543        insertVars(getName(U), VDS,
12544          insertInternalModule(getName(U), transform(U, DB),
12545            insertTopModule(getName(U), U, DB)))) .
12546  eq evalModule1(U, U', unitError(QIL), VDS, DB) = warning(DB, QIL) .
12547
12548  eq evalModule2(U, U', DB)
12549    = insertFlatModule(getName(U), flatModule(addDecls(U, U')), DB) .
12550  eq evalModule2(unitError(QIL), U, DB) = warning(DB, QIL) .
12551
12552*** The function \texttt{evalPreModule} has to take care of the bubbles in the
12553*** unit. As we explained in Section~\ref{evaluation-overview}, both the
12554*** signature and the flattened version of the module are created
12555*** simultaneously, completing the parsing of the bubbles once the signature
12556*** has been built, and then completing the flattened module.
12557
12558*** The \texttt{evalPreModule} function takes as arguments two copies of the
12559*** module and a database. We shall see in Section~\ref{unit-processing} how
12560*** these two modules are generated; the one passed as first argument has
12561*** still bubbles in it, while the other one, which will be used to build the
12562*** signature, does not contain any bubbles. This module without bubbles is
12563*** the result of removing the bubbles from the declarations in it, or of
12564*** removing the declarations themselves when they contain bubbles, as in the
12565*** case of equations, for example.
12566
12567*** The \texttt{evalPreModule} function is quite similar to the function
12568*** \texttt{evalModule}. First, the structure is normalized by calling the
12569*** \texttt{normalize} function, and then all the subunits in the
12570*** structure are collected (accomplished by \texttt{subunitImports} and
12571*** \texttt{getModules}) and the list of importations is updated
12572*** with the sublist of importations of built-in
12573*** modules (\texttt{selectBuiltInImports}). Second, the structure of all the
12574*** subunits below the top is flattened to a single unit. This unit is used to
12575*** create a first version of the signature (without identity elements of
12576*** operators) in which all the bubbles in the top preunit are
12577*** parsed (\texttt{solveBubbles}). The final version of the signature and
12578*** the flat unit are generated once the bubbles have been parsed. The
12579*** `internal' version of the module is also generated by renaming the
12580*** variables in it (\texttt{renameVars}). All these versions of the module
12581*** are finally entered in the database.
12582
12583*** Note that if the \texttt{META-LEVEL} module is imported in the module
12584*** being evaluated, a declaration importing the predefined module
12585*** \texttt{UP} Section~\ref{non-built-in-predefined}) is added. With the
12586*** declarations in this module it will be possible to parse bubbles
12587*** containing calls to the \texttt{up} functions (see
12588*** Section~\ref{structured-specifications}) in them.
12589
12590  op evalPreModule : Module Module OpDeclSet Database -> Database .
12591  op evalPreModule1 :
12592       Module Module List<Module> Module OpDeclSet Database -> Database .
12593  op evalPreModule2 : Module Module Module OpDeclSet Database -> Database .
12594  op evalPreModule3 : Module Module Module Database -> Database .
12595
12596  *** evalPreModule just calls evalPreModule1 with a set of the units in the
12597  *** structure of the given module. Depending on whether the module is
12598  *** importing META-LEVEL or not UP will be added. BOOL will be added if
12599  *** the include BOOL flag is set and the module doesn't include it already.
12600
12601  ceq evalPreModule(PU, U, VDS, DB)
12602    *** PU  : top unit with bubbles (preunit)
12603    *** U   : top unit without bubbles (decls with bubbles were removed)
12604    *** VDS : ops corresponding to the vbles in the top unit
12605    = evalPreModule1(
12606        setPars(setImports(PU, IL'), PDL'),
12607        setName(empty(U), getName(U)),
12608        getModules(IL'', DB'),
12609        setImports(U, nil),
12610        VDS,
12611        DB')
12612    if IL := getImports(PU)
12613    /\ PDL := getPars(PU)
12614    /\ < IL' ; PDL' ; DB' > := normalize(defImports(PU, DB) IL, PDL, DB)
12615    /\ IL'' := subunitImports(PDL, IL', DB') .
12616  eq evalPreModule(PU, U, VDS, DB) = DB [owise] .
12617
12618  *** evalPreModule1 joins all the units in the structure into a single unit,
12619  *** the one given as second argument; recall that the fourth one is the
12620  *** top module without bubbles but with the complete list of subunits
12621  *** being imported explicitly
12622
12623  eq evalPreModule1(PU, U, (U' UL), U'', VDS, DB)
12624    = evalPreModule1(PU, addDecls(U, U'), UL, U'', VDS, DB) .
12625  eq evalPreModule1(PU, U, nil, U', VDS, DB)
12626    = evalPreModule2(PU, U, signature(transform(addDecls(U', setImports(U, nil)), DB)), VDS, DB)
12627    [owise] .
12628  eq evalPreModule1(PU, unitError(QIL), UL, U', VDS, DB) = warning(DB, QIL) .
12629  eq evalPreModule1(unitError(QIL), U, UL, U', VDS, DB) = warning(DB, QIL) .
12630  eq evalPreModule1(PU, U, unitError(QIL), U', VDS, DB) = warning(DB, QIL) .
12631
12632  eq evalPreModule2(PU, U, M, VDS, DB)
12633    *** PU : top module with bubbles
12634    *** U  : everything below
12635    *** M  : complete signature
12636    = evalPreModule3(
12637        solveBubblesMod(PU, getOps(U), M,
12638          included('META-MODULE, getImports(PU), DB), VDS, DB),
12639        U, M,
12640        insertVars(getName(PU), VDS,
12641          insertTopModule(getName(PU),
12642            solveBubblesMod(PU, getOps(U), M,
12643              included('META-MODULE, getImports(PU), DB), VDS, DB), DB))) .
12644
12645  eq evalPreModule3(PU, U, M, DB)
12646    *** PU : top module without bubbles
12647    *** U  : everything below
12648    *** M  : complete signature
12649    = insertFlatModule(getName(PU),
12650        flatModule(setImports(transform(addDecls(PU, U), DB), nil)),
12651        insertInternalModule(getName(PU), transform(PU, DB), DB)) .
12652  eq evalPreModule3(unitError(QIL), U, M, DB) = warning(DB, QIL) .
12653endfm
12654
12655-------------------------------------------------------------------------------
12656*******************************************************************************
12657-------------------------------------------------------------------------------
12658
12659*** Note that in both \texttt{evalModule} and \texttt{evalPreModule}, the function
12660*** \texttt{transform} has to be invoked to transform the module into a
12661*** functional or system module. In the current system, the only
12662*** transformation available is from object-oriented modules to system modules.
12663
12664***
12665*** 6.8 Application of Map STS
12666***
12667
12668*** The following two modules deal with the application of a set of renaming
12669*** maps to a module. Except for the proof obligations and additional checks
12670*** associated with views---almost none of these checks are performed, and
12671*** none of these proof obligations is generated in the current version---the
12672*** way of applying a renaming map and a view map on a module is the same.
12673*** Internally, they are treated in the same way; the only difference between
12674*** them consists in the way of calling the function to accomplish this
12675*** application.
12676
12677*** Note that there might be some `interference' between sort maps, and
12678*** operator maps and message maps when they are applied. Let us consider for
12679*** example a module with an operator declaration
12680***
12681***  op f : Foo -> Foo .
12682***
12683*** and a renaming map set
12684***
12685***  (sort Foo to Bar, op f : Foo -> Foo to g)
12686***
12687*** These renamings have to be applied carefully to avoid unintended behaviors.
12688*** Depending on which of the maps is applied first, the other will be
12689*** applicable or not.  All the maps must be applied to the original module.
12690*** To avoid the interference between the sort maps and other maps, the map set
12691*** is divided into two sTS: The first one contains the sort maps, and the
12692*** second one contains the other maps.
12693
12694*** We assume that there are no ambiguous mappings, that is, that we do not
12695*** have, for example, maps \verb~op f to g~ and \verb~op f to h~. In case of
12696*** such ambiguity, one of the maps will be arbitrarily chosen.
12697
12698***
12699*** 6.8.1 Map STS on Terms
12700***
12701
12702*** The application of a set of view maps to a term is defined in the following
12703*** module \texttt{RENAMING-SET-APPL-ON-TERM}. The function
12704*** \texttt{applyMapsToTerm} is used to apply a given view map set to terms
12705*** appearing in equations, rules, identity element declarations, and
12706*** membership axioms, as part of the process of applying a map set to a unit.
12707
12708*** Some of the auxiliary functions introduced in this module will also be used
12709*** in the application of maps to operator and message declarations in the
12710*** \texttt{RENAMING-SET-APPL-ON-UNIT} module.
12711
12712-------------------------------------------------------------------------------
12713*******************************************************************************
12714-------------------------------------------------------------------------------
12715
12716fmod RENAMING-SET-APPL-ON-TERM is
12717  pr UNIT .
12718  pr FMAP .
12719  pr EXT-SORT .
12720
12721  var  R : Renaming .
12722  vars RS RS' RS'' SRS ORS : RenamingSet .
12723  var  M : Module .
12724  vars F F' F'' A A' A'' : Qid .
12725  vars T T' T'' O : Term .
12726  vars TL TL' TL'' TL3 : TermList .
12727  vars S S' S'' C C' C'' : Sort .
12728  var  SS : SortSet .
12729  var  K : Kind .
12730  vars TyL TyL' : TypeList .
12731  vars Ty Ty' : Type .
12732  vars Subst Subst' Subst'' : Substitution .
12733  var  AtS : AttrSet .
12734  var  OPDS : OpDeclSet .
12735  vars V V' : Variable .
12736  vars Ct Ct' : Constant .
12737  var  QIL : QidList .
12738  var  Cd : Condition .
12739
12740*** The following functions \texttt{applyMapsToSort} and
12741*** \texttt{applyMapsToClassSort} apply a set of maps, respectively, to a
12742*** sort a to a class name in its single identifier form, that is, when they
12743*** appear qualifying constants. Functions \texttt{applyMapsToType} and
12744*** \texttt{applyMapsToClassName} are similar but being applied to sort or
12745*** class names in their normal form.
12746
12747  op applyMapsToSort : RenamingSet Sort -> Sort .
12748  eq applyMapsToSort((sort S to S'), S) = S' .
12749  eq applyMapsToSort((sort S to S'), S'') = S'' [owise] .
12750  eq applyMapsToSort(((sort S to S'), SRS), S) = S' .
12751  eq applyMapsToSort(((sort S to S'), SRS), S'')
12752    = applyMapsToSort(SRS, S'')
12753    [owise] .
12754  eq applyMapsToSort(R, S) = S [owise].
12755  eq applyMapsToSort((R, SRS), S) = applyMapsToSort(SRS, S) [owise].
12756  eq applyMapsToSort(none, S) = S .
12757
12758  op applyMapsToSortSet : RenamingSet SortSet -> SortSet .
12759  eq applyMapsToSortSet(SRS, (S ; SS))
12760    = (applyMapsToType(SRS, S) ; applyMapsToSortSet(SRS, SS)) .
12761  eq applyMapsToSortSet(SRS, none) = none .
12762
12763  op applyMapsToType : RenamingSet Type -> Type .
12764  eq applyMapsToType((sort S to S'), S) = S' .
12765  eq applyMapsToType(((sort S to S'), SRS), S) = S' .
12766  eq applyMapsToType((sort S to S'), K)
12767    = qid("[" + string(applyMapsToType(sort S to S', getSort(K))) + "]") .
12768  eq applyMapsToType(((sort S to S'), SRS), K)
12769    = qid("["
12770       + string(applyMapsToType(((sort S to S'), SRS), getSort(K)))
12771       + "]") .
12772  eq applyMapsToType(SRS, Ty) = Ty [owise] .
12773
12774  op applyMapsToClassName : RenamingSet Sort -> Sort .
12775  eq applyMapsToClassName((class C to C'), C) = C' .
12776  eq applyMapsToClassName(((class C to C'), SRS), C) = C' .
12777  eq applyMapsToClassName(SRS, C) = C [owise] .
12778
12779*** \texttt{applyOpMapsToOpId} applies a map set to an operator name.
12780
12781  op applyOpMapsToOpId : Qid RenamingSet -> Qid .
12782  eq applyOpMapsToOpId(F, (op F to F' [AtS])) = F' .
12783  eq applyOpMapsToOpId(F, (op F : TyL -> Ty to F' [AtS])) = F' .
12784  eq applyOpMapsToOpId(F, RS) = F [owise] .
12785
12786*** Note that all maps introduced in Sections~\ref{renaming-maps}
12787*** and~\ref{view-maps}, except for label maps, may affect a term. For example,
12788*** sort maps will be applied to the qualifications of terms, and class and
12789*** attribute maps have to be applied to the objects appearing in the term.
12790*** Operator and message maps in which an explicit arity and coarity is given,
12791*** and operator maps going to derived operators (see Section~\ref{Views})
12792*** must be applied to the complete family of subsort-overloaded operators.
12793
12794*** The function \texttt{applyMapsToTerm} takes as arguments two sTS of
12795*** view maps (the first set for sort maps, and the second for the other maps),
12796*** the term to which the maps will be applied, and a module to be used in the
12797*** matching of terms, sort comparisons, etc. Its declaration is as follows.
12798
12799  op applyMapsToTerm2 : RenamingSet RenamingSet Term Module -> Term .
12800
12801*** If the term on which the maps have to be applied is not an object,
12802*** different cases have to be considered for each of the possible forms of a
12803*** term. If it is a variable or \texttt{error*}, the same term is returned
12804*** without change (term maps are a special case for this). If it is a sort
12805*** test or a lazy sort test, with forms \verb~T : S~ and \verb~T :: S~,
12806*** respectively, the maps are applied to the term \texttt{T} and to the sort
12807*** \texttt{S}.  In case of being of forms \verb~F.S~ or \verb~F[TL]~ with
12808*** \texttt{F} an operator name, \texttt{S} a sort, and \texttt{TL} a list of
12809*** terms, the function \texttt{getRightOpMaps} will return the subset of
12810*** maps which are applicable on such term. If \texttt{none} is returned then
12811*** no map is applicable. If more than one map is returned then there is an
12812*** ambiguity, and any of them will be arbitrarily taken. The function
12813*** \texttt{imagTerm} is called with the term and the maps applicable on
12814*** it and return the image of the term. In case of a term of the form
12815*** \texttt{F[TL]}, \texttt{imageOfTerm} will make recursive calls with the
12816*** arguments in \texttt{TL}.
12817
12818*** The application of a term map to a term requires the `matching' of the
12819*** source term in the map with the term on which the map is applied, and then
12820*** the application of the obtained substitution. Note, however, that a
12821*** complete matching algorithm is not required. Given the form of the pattern
12822*** we can choose beforehand the appropriate map, that is, we know that in
12823*** fact there is a match when the function is called. Note also that the map
12824*** has to be applied to the whole family of subsort overloaded operators. We
12825*** just have to check that the sort of the given variable and the
12826*** corresponding term are in the same connected component of sorts.  In
12827*** addition to getting the appropriate substitution, the only thing we need
12828*** to check is that there are no variables with different assignments, that
12829*** is, that in case of having a nonlinear pattern, the terms being assigned
12830*** to each variable are equal. We call \texttt{pseudoMatch} to the function
12831*** doing this task.
12832
12833  op applyMapsToTerm2 : RenamingSet RenamingSet TermList Module -> TermList .
12834
12835  op imageOfTerm : RenamingSet RenamingSet Term RenamingSet Module -> Term .
12836  op applyMapsToSubst : RenamingSet RenamingSet Substitution Module -> Substitution .
12837  op pseudoMatch : TermList TermList Module Substitution -> Substitution .
12838  op pseudoMatch2 : TermList TermList Module Substitution -> Substitution .
12839  op pseudoMatchResult : Substitution -> Substitution .
12840  op pseudoMatchResult : Substitution Assignment Substitution Substitution -> Substitution .
12841
12842  op getRightOpMaps : Qid TypeList Type RenamingSet Module -> RenamingSet .
12843  op applyMapsToObjectAttrSet : RenamingSet RenamingSet Sort Term Module -> Term .
12844  op applyMapsToAttrNameInTerm : RenamingSet Sort Qid Module -> Qid .
12845
12846  eq applyMapsToTerm2(SRS, ORS, Ct, M)
12847    = imageOfTerm(SRS, ORS, Ct,
12848        getRightOpMaps(getName(Ct), nil, getType(Ct), ORS, M), M) .
12849  eq applyMapsToTerm2(SRS, ORS, V, M)
12850    = qid(string(getName(V)) + ":"
12851          + string(applyMapsToType(SRS, getType(V)))) .
12852  eq applyMapsToTerm2(SRS, ORS, qidError(QIL), M) = qidError(QIL) .
12853  eq applyMapsToTerm2(SRS, ORS, F[TL], M)
12854    = imageOfTerm(SRS, ORS, F[TL],
12855        getRightOpMaps(F, eLeastSort(M, TL), leastSort(M, F[TL]), ORS, M),
12856        M)
12857    [owise] .
12858    ---- if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) .
12859  eq applyMapsToTerm2(SRS, ORS, '<_:_|_>[O, Ct, T], M)
12860    = '<_:_|_>[applyMapsToTerm2(SRS, ORS, O, M),
12861               qid(string(applyMapsToClassName(SRS, getName(Ct)))
12862                  + "." + string(applyMapsToClassName(SRS, getType(Ct)))),
12863               applyMapsToObjectAttrSet(SRS, ORS, getName(Ct), T, M)].
12864  ceq applyMapsToTerm2(SRS, ORS, '<_:_|_>[O, C, T], M)
12865    = '<_:_|_>[applyMapsToTerm2(SRS, ORS, O, M),
12866               applyMapsToClassName(SRS, C),
12867               applyMapsToObjectAttrSet(SRS, ORS, C, T, M)]
12868    if not C :: Constant .
12869  eq applyMapsToTerm2(SRS, ORS, '<_:_|`>[O, Ct], M)
12870    = '<_:_|_>[applyMapsToTerm2(SRS, ORS, O, M),
12871               qid(string(applyMapsToClassName(SRS, getName(Ct)))
12872                 + "." + string(applyMapsToClassName(SRS, getType(Ct)))),
12873               'none.AttributeSet] .
12874  ceq applyMapsToTerm2(SRS, ORS, '<_:_|`>[O, C], M)
12875    = '<_:_|_>[applyMapsToTerm2(SRS, ORS, O, M),
12876         applyMapsToClassName(SRS, C), 'none.AttributeSet]
12877    if not C :: Constant .
12878  ceq applyMapsToTerm2(SRS, ORS, F[TL], M)
12879    = qid("_::`" + string(applyMapsToType(SRS, qid(substr(string(F), 4, length(string(F))))))) [
12880        applyMapsToTerm2(SRS, ORS, TL, M)]
12881    if substr(string(F), 0, 4) == "_::`" .
12882----    /\ substr(string(F), sd(length(string(F)), 2), 2) = "`}" .
12883
12884  ceq applyMapsToTerm2(SRS, ORS, (T, TL), M)
12885    = (applyMapsToTerm2(SRS, ORS, T, M),
12886       applyMapsToTerm2(SRS, ORS, TL, M))
12887    if TL =/= empty .
12888
12889*** Application of a map set to the name of an attribute in an object
12890
12891  eq applyMapsToAttrNameInTerm((attr A . S to A'), C, A'', M)
12892    = if sameKind(M, S, C) and-then (qid(string(A) + "`:_") == A'')
12893      then qid(string(A') + "`:_")
12894      else A''
12895      fi .
12896  eq applyMapsToAttrNameInTerm(((attr A . S to A'), ORS), C, A'', M)
12897    = if sameKind(M, S, C) and-then (qid(string(A) + "`:_") == A'')
12898      then qid(string(A') + "`:_")
12899      else applyMapsToAttrNameInTerm(ORS, C, A'', M)
12900      fi .
12901  eq applyMapsToAttrNameInTerm(R, C, A, M) = A [owise] .
12902  eq applyMapsToAttrNameInTerm((R, ORS), C, A, M)
12903    = applyMapsToAttrNameInTerm(ORS, C, A, M)
12904    [owise] .
12905  eq applyMapsToAttrNameInTerm(none, S, A, M) = A .
12906
12907*** Selection of all the operator or message maps that are applicable on an
12908*** operator with a given arity and coarity.
12909
12910  eq getRightOpMaps(F, TyL, Ty, (msg F' to F''), M)
12911    = getRightOpMaps(F, TyL, Ty, (op F' to F'' [none]), M) .
12912  eq getRightOpMaps(F, TyL, Ty, ((msg F' to F''), RS), M)
12913    = getRightOpMaps(F, TyL, Ty, ((op F' to F'' [none]), RS), M) .
12914  eq getRightOpMaps(F, TyL, Ty, (msg F' : TyL' -> Ty' to F''), M)
12915    = getRightOpMaps(F, TyL, Ty, op F' : TyL' -> Ty' to F'' [none], M) .
12916  eq getRightOpMaps(F, TyL, Ty, ((msg F' : TyL' -> Ty' to F''), RS), M)
12917    = getRightOpMaps(F, TyL, Ty,
12918        (op F' : TyL' -> Ty' to F'' [none], RS), M) .
12919  eq getRightOpMaps(F, TyL, Ty, (op F to F' [AtS]), M) = (op F to F' [AtS]) .
12920  eq getRightOpMaps(F, TyL, Ty, (op F to F' [AtS], RS), M)
12921    = (op F to F' [AtS], getRightOpMaps(F, TyL, Ty, RS, M)) .
12922  eq getRightOpMaps(F, TyL, Ty, op F : TyL' -> Ty' to F' [AtS], M)
12923    = if (size(TyL') == 2 and-then (sameKindAll(M, Ty', TyL) and-then assoc in attrs2SameKind(F, TyL, M)))
12924         or-else
12925         sameKind(M, TyL Ty, TyL' Ty')
12926      then (op F : TyL' -> Ty' to F' [AtS])
12927      else none
12928      fi .
12929  eq getRightOpMaps(F, TyL, Ty, (op F : TyL' -> Ty' to F' [AtS], RS), M)
12930    = if (size(TyL') == 2 and-then (sameKindAll(M, Ty', TyL) and-then assoc in attrs2SameKind(F, TyL, M)))
12931         or-else
12932         sameKind(M, TyL Ty, TyL' Ty')
12933      then (op F : TyL' -> Ty' to F' [AtS],
12934            getRightOpMaps(F, TyL, Ty, RS, M))
12935      else getRightOpMaps(F, TyL, Ty, RS, M)
12936      fi .
12937  eq getRightOpMaps(F, TyL, Ty, op_to`term_(F[TL], T), M)
12938    = if sameKind(M, TyL, varListSort(TL))
12939      then (op_to`term_(F[TL], T))
12940      else none
12941      fi .
12942  eq getRightOpMaps(F, TyL, Ty, (op_to`term_(F[TL], T), RS), M)
12943    = if sameKind(M, TyL, varListSort(TL))
12944      then (op_to`term_(F[TL], T), getRightOpMaps(F, TyL, Ty, RS, M))
12945      else getRightOpMaps(F, TyL, Ty, RS, M)
12946      fi .
12947  eq getRightOpMaps(F, TyL, Ty, (op_to`term_(Ct, T)), M)
12948    = if TyL == nil
12949         and-then (F == getName(Ct)
12950         and-then sameKind(M, Ty, getType(Ct)))
12951      then (op_to`term_(Ct, T))
12952      else none
12953      fi .
12954  eq getRightOpMaps(F, TyL, Ty, (op_to`term_(Ct, T), RS), M)
12955    = if TyL == nil
12956         and-then (F == getName(Ct)
12957         and-then sameKind(M, Ty, getType(Ct)))
12958      then (op_to`term_(Ct, T), getRightOpMaps(F, TyL, Ty, RS, M))
12959      else getRightOpMaps(F, TyL, Ty, RS, M)
12960      fi .
12961  eq getRightOpMaps(F, TyL:[Type], Ty:[Type], RS, M) = none [owise].
12962
12963  op varListSort : TermList -> TypeList .
12964  eq varListSort((V, TL)) = (getType(V) varListSort(TL)) .
12965  eq varListSort(empty) = nil .
12966
12967  op attrs2SameKind : Qid TypeList Module -> AttrSet .
12968  op attrs2SameKind : Qid TypeList OpDeclSet Module -> AttrSet .
12969  eq attrs2SameKind(F, Ty Ty' TyL, M) = attrs2SameKind(F, Ty Ty', getOps(M), M) .
12970 ceq attrs2SameKind(F, TyL, op F : TyL' -> Ty' [AtS] . OPDS, M) ---- all subsort overloaded operators have the same equational attributes
12971    = AtS
12972    if sameKind(M, TyL, TyL') .
12973  eq attrs2SameKind(F, TyL, OPDS, M) = none [owise] .
12974
12975*** Application of a map set to the set of attributes in an object
12976
12977  eq applyMapsToObjectAttrSet(RS, RS', C, '_`,_[A[T], TL], M)
12978    = '_`,_[applyMapsToAttrNameInTerm(RS', C, A, M)
12979              [applyMapsToTerm2(RS, RS', T, M)],
12980            applyMapsToObjectAttrSet(RS, RS', C, TL, M)] .
12981  eq applyMapsToObjectAttrSet(RS, RS', C, A[T], M)
12982    = applyMapsToAttrNameInTerm(RS', C, A, M)
12983        [applyMapsToTerm2(RS, RS', T, M)] .
12984  eq applyMapsToObjectAttrSet(RS, RS', C,
12985       '_`,_['none.AttributeSet, TL], M)
12986    = '_`,_['none.AttributeSet,
12987            applyMapsToObjectAttrSet(RS, RS', C, TL, M)] .
12988  eq applyMapsToObjectAttrSet(RS, RS', C, 'none.AttributeSet, M)
12989    = 'none.AttributeSet .
12990
12991*** Image of a term
12992
12993  eq imageOfTerm(RS, RS', Ct, none, M)
12994    = qid(string(getName(Ct)) + "."
12995          + string(applyMapsToType(RS, getType(Ct)))) .
12996  eq imageOfTerm(RS, RS', F[TL], none, M)
12997    = F [ applyMapsToTerm2(RS, RS', TL, M) ] .
12998
12999  eq imageOfTerm(RS, RS', F[TL], (op F to F' [AtS]), M)
13000    = F' [ applyMapsToTerm2(RS, RS', TL, M) ] .
13001  eq imageOfTerm(RS, RS', F[TL], ((op F to F' [AtS]), RS''), M)
13002    = F' [ applyMapsToTerm2(RS, RS', TL, M) ] .
13003  eq imageOfTerm(RS, RS', F[TL], (op F : TyL -> Ty to F'[AtS]), M)
13004    = F' [ applyMapsToTerm2(RS, RS', TL, M) ] .
13005  eq imageOfTerm(RS, RS', F[TL], (op F : TyL -> Ty to F'[AtS], RS''),M)
13006    = F' [ applyMapsToTerm2(RS, RS', TL, M) ] .
13007  eq imageOfTerm(RS, RS', T, op_to`term_(T', T''), M)
13008    = applySubst(T'',
13009        applyMapsToSubst(RS, RS', pseudoMatch(T', T, M, none), M)) .
13010  eq imageOfTerm(RS, RS', T, (op_to`term_(T', T''), RS''), M)
13011    = applySubst(T'',
13012        applyMapsToSubst(RS, RS', pseudoMatch(T', T, M, none), M)) .
13013  ceq imageOfTerm(RS, RS', Ct, (op F to F' [AtS]), M)
13014    = qid(string(F') + "." + string(applyMapsToType(RS, getType(Ct))))
13015    if getName(Ct) = F .
13016  ceq imageOfTerm(RS, RS', Ct, ((op F to F' [AtS]), RS''), M)
13017    = qid(string(F') + "." + string(applyMapsToType(RS, getType(Ct))))
13018    if getName(Ct) = F .
13019  ceq imageOfTerm(RS, RS', Ct, (op F : TyL -> Ty to F' [AtS]), M)
13020    = qid(string(F') + "." + string(applyMapsToType(RS, getType(Ct))))
13021    if getName(Ct) = F .
13022  ceq imageOfTerm(RS, RS', Ct, (op F : TyL -> Ty to F' [AtS], RS''),M)
13023    = qid(string(F') + "." + string(applyMapsToType(RS, getType(Ct))))
13024    if getName(Ct) = F .
13025
13026*** Application of a Substitution on a term
13027
13028  op applySubst : TermList Substitution -> TermList .
13029  eq applySubst(T, none) = T .
13030  eq applySubst(V, ((V' <- T) ; Subst))
13031    = if getName(V) == getName(V')
13032      then T
13033      else applySubst(V, Subst)
13034      fi .
13035  eq applySubst(F[TL], Subst) = F[applySubst(TL, Subst)] .
13036  eq applySubst(Ct, Subst) = Ct .
13037  ceq applySubst((T, TL), Subst)
13038    = (applySubst(T, Subst), applySubst(TL,Subst))
13039    if TL =/= empty .
13040
13041*** Application of a Substitution to a condition
13042
13043  op applySubst : Condition Substitution -> Condition .
13044  eq applySubst(T = T' /\ Cd, Subst)
13045    = (applySubst(T, Subst) = applySubst(T', Subst)) /\ applySubst(Cd, Subst) .
13046  eq applySubst(T => T' /\ Cd, Subst)
13047    = (applySubst(T, Subst) => applySubst(T', Subst)) /\ applySubst(Cd, Subst) .
13048  eq applySubst(T : S /\ Cd, Subst)
13049    = (applySubst(T, Subst) : S) /\ applySubst(Cd, Subst) .
13050  eq applySubst((nil).EqCondition, Subst) = nil .
13051
13052*** PseudoMatch
13053
13054  eq pseudoMatch(T, T', M, Subst)
13055    = pseudoMatchResult(pseudoMatch2(T, T', M, Subst)) .
13056
13057  eq pseudoMatch2(Ct, Ct', M, Subst) = none .
13058  eq pseudoMatch2(F[TL], F'[TL'], M, Subst)
13059    = if F == F'
13060      then pseudoMatch2(TL, TL', M, Subst)
13061      else none
13062      fi .
13063  eq pseudoMatch2((V, TL), (T, TL'), M, Subst)
13064    = if sameKind(M, getType(V), leastSort(M, T))
13065      then pseudoMatch2(TL, TL', M, (V <- T ; Subst))
13066      else none
13067      fi .
13068  eq pseudoMatch2(V, T, M, Subst)
13069    = if sameKind(M, getType(V), leastSort(M, T))
13070      then (V <- T ; Subst)
13071      else none
13072      fi .
13073
13074  eq pseudoMatch2((V, TL), (T, TL'), M, Subst)
13075    = if sameKind(M, getType(V), leastSort(M, T))
13076      then pseudoMatch2(TL, TL', M, (V <- T ; Subst))
13077      else none
13078      fi .
13079  eq pseudoMatch2((Ct, TL), (Ct', TL'), M, Subst)
13080    = if getName(Ct) == getName(Ct')
13081      then pseudoMatch2(TL, TL', M, Subst)
13082      else none
13083      fi .
13084  eq pseudoMatch2((F[TL], TL'), (F'[TL''], TL3), M, Subst)
13085    = if F == F'
13086      then pseudoMatch2(TL', TL3, M, pseudoMatch2(TL, TL'', M, none) ; Subst)
13087      else none
13088      fi .
13089  eq pseudoMatch2(empty, empty, M, Subst) = Subst .
13090
13091  *** pseudoMatchResult detects conflicts and eliminates duplicates
13092
13093  eq pseudoMatchResult((V <- T) ; Subst)
13094    = pseudoMatchResult(none, (V <- T), none, Subst) .
13095  eq pseudoMatchResult(none) = none .
13096
13097  eq pseudoMatchResult(Subst, (V <- T), Subst', (V' <- T') ; Subst'')
13098    = if V == V'
13099      then if T == T'
13100           then pseudoMatchResult(Subst, (V <- T), Subst', Subst'')
13101           else none
13102           fi
13103      else pseudoMatchResult(Subst, (V <- T), Subst' ; (V' <- T'), Subst'')
13104      fi .
13105  eq pseudoMatchResult(Subst, (V <- T), (V' <- T') ; Subst', none)
13106    = pseudoMatchResult(Subst ; (V <- T), (V' <- T'), none, Subst') .
13107  eq pseudoMatchResult(Subst, (V <- T), none, none) = (Subst ; (V <- T)) .
13108
13109*** Application of a set of maps to a substitution
13110
13111  eq applyMapsToSubst(RS, RS', ((V <- T) ; Subst), M)
13112    = ((applyMapsToTerm2(RS, RS', V, M) <- applyMapsToTerm2(RS, RS', T, M)) ;
13113       applyMapsToSubst(RS, RS', Subst, M)) .
13114  eq applyMapsToSubst(RS, RS', none, M) = none .
13115
13116endfm
13117
13118-------------------------------------------------------------------------------
13119*******************************************************************************
13120-------------------------------------------------------------------------------
13121
13122*** We do not include here the equations defining the semantics of the function
13123*** \texttt{applyMapsToTerm}. Instead, we present an example illustrating
13124*** the meaning of the function. Renaming maps and view maps were already
13125*** discussed in Sections~\ref{Views} and~\ref{module-expressions}.
13126
13127*** Let us consider the following configuration in the module
13128*** \texttt{STACK2[Accnt]} presented in Section~\ref{module-expressions}. In
13129*** this configuration we have objects in the class \texttt{Accnt} which
13130*** represent the accounts of different clients of a bank, which is
13131*** represented as an object \texttt{'bank} of class \texttt{Stack[Accnt]}.
13132*** The object \texttt{'bank} in the example configuration below keeps a stack
13133*** with the accounts of the bank represented as a linked list of nodes, each
13134*** of which corresponds to the account of one of the clients.
13135
13136***   ('bank push 'john)
13137***   ('peter elt 2000)
13138***   < 'bank : Stack[Accnt] | first : o ('bank, 1) >
13139***   < 'paul : Accnt | bal : 5000 >
13140***   < 'peter : Accnt | bal : 2000 >
13141***   < 'mary : Accnt | bal : 7200 >
13142***   < 'john : Accnt | bal : 100 >
13143***   < o('bank, 0) : Node[Accnt] | node : 'peter, next : null >
13144***   < o('bank, 1) : Node[Accnt] | node : 'mary, next : o('bank, 0) > .
13145***
13146*** Let us apply the following renaming to the previous term.
13147***
13148***   (op o to id,
13149***    class Stack[Accnt] to Bank,
13150***    msg _push_ : Oid Oid -> Msg to open`account`in_to_,
13151***    msg _pop to close`account`of_,
13152***    msg _elt_ to _owns_dollars,
13153***    attr node . Node[Accnt] to client,
13154***    attr bal . Accnt to balance)
13155***
13156*** The resulting term is as follows.
13157***
13158***   (open account in 'bank to 'john)
13159***   ('peter owns 2000 dollars)
13160***   < 'bank : Bank | first : id('bank, 1) >
13161***   < 'paul : Accnt | balance : 5000 >
13162***   < 'peter : Accnt | balance : 2000 >
13163***   < 'mary : Accnt | balance : 7200 >
13164***   < 'john : Accnt | balance : 100 >
13165***   < id('bank, 0) : Node[Accnt] | client : 'peter, next : null >
13166***   < id('bank, 1) : Node[Accnt] | client : 'mary, next : id('bank, 0) >
13167
13168*** The function \texttt{applyMapsToTerm} treats the object constructor
13169*** \verb~<_:_|_>~ in a special way. It cannot be renamed, and, when an
13170*** occurrence of such a constructor is found, class and attribute maps require
13171*** a particular handling. Inside terms these maps are only triggered when
13172*** this constructor is found, and they are applied in a very restricted way,
13173*** according to the general pattern for objects.  We assume that the operator
13174*** \verb~<_:_|_>~ is only used for objects and that objects constructed using
13175*** it are well-formed.
13176
13177***
13178*** 6.8.2 Map STS on Modules
13179***
13180
13181*** The application of view maps to modules and theories of the different types
13182*** is defined in the following module \texttt{RENAMING-SET-APPL-ON-UNIT}. The
13183*** function \texttt{applyMapsToModule} is defined recursively by applying it
13184*** to the different components of a unit. When the terms in the different
13185*** declarations are reached, the function \texttt{applyMapsToTerm} is
13186*** called. This call is made with the set of maps split conveniently, as
13187*** explained above.
13188
13189-------------------------------------------------------------------------------
13190*******************************************************************************
13191-------------------------------------------------------------------------------
13192
13193fmod RENAMING-SET-APPL-ON-UNIT is
13194  pr RENAMING-SET-APPL-ON-TERM .
13195  pr INT-LIST .
13196  pr VIEW-EXPR .
13197
13198  op applyMapsToModule : RenamingSet Module Module -> Module .
13199  op applyMapsToModuleAux : RenamingSet RenamingSet Module Module -> Module .
13200  op splitMaps : RenamingSet -> Tuple{RenamingSet,RenamingSet} .
13201  op splitMapsAux : RenamingSet RenamingSet RenamingSet
13202       -> Tuple{RenamingSet,RenamingSet} .
13203
13204  op applyMapsToTypeList : RenamingSet TypeList -> TypeList .
13205  op applyMapsToSubsorts : RenamingSet SubsortDeclSet -> SubsortDeclSet .
13206  op applyMapsToOps : RenamingSet RenamingSet OpDeclSet Module -> OpDeclSet .
13207  op applyMapsToOp : RenamingSet RenamingSet RenamingSet OpDecl Module -> OpDecl .
13208  op applyMapsToAttrs : RenamingSet RenamingSet AttrSet Module -> AttrSet .
13209  op applyMapToAttrs : Renaming AttrSet -> AttrSet .
13210  op applyMapToAttrsAux : AttrSet AttrSet AttrSet -> AttrSet .
13211  op applyMapsToHooks : RenamingSet RenamingSet HookList Module -> HookList .
13212  op applyMapsToHooksAux : RenamingSet RenamingSet Hook Module -> Hook .
13213  op applyMapsToMbs : RenamingSet RenamingSet MembAxSet Module -> MembAxSet .
13214  op applyMapsToEqs : RenamingSet RenamingSet EquationSet Module -> EquationSet .
13215  op applyMapsToRls : RenamingSet RenamingSet RuleSet Module -> RuleSet .
13216  op applyMapsToCond : RenamingSet RenamingSet Condition Module -> Condition .
13217  op applyMapsToLabel : RenamingSet Qid -> Qid .
13218  op applyMapsToClassDeclSet : RenamingSet RenamingSet ClassDeclSet -> ClassDeclSet .
13219  op applyMapsToSubclassDeclSet : RenamingSet SubclassDeclSet -> SubclassDeclSet .
13220  op applyMapsToMsgDeclSet : RenamingSet RenamingSet MsgDeclSet Module -> MsgDeclSet .
13221  op applyMapsToMsgDecl : RenamingSet RenamingSet MsgDecl Module -> MsgDecl .
13222  op applyMapsToAttrName : RenamingSet Sort Qid -> Qid .
13223  op applyMapsToAttrDeclSet : RenamingSet RenamingSet Sort AttrDeclSet -> AttrDeclSet .
13224
13225  vars M U : Module .
13226  vars QI QI' QI'' L L' L'' F F' F'' A A' A'' : Qid .
13227  vars V V' : Variable .
13228  vars QIL QIL' : QidList .
13229  var  VE : ViewExp .
13230  var  H : Header .
13231  var  ME : ModuleExpression .
13232  var  PDL : ParameterDeclList .
13233  var  IL : ImportList .
13234  vars S S' S'' C C' C'' : Sort .
13235  var  Ty : Type .
13236  vars TyL TyL' : TypeList .
13237  var  SS : SortSet .
13238  var  SSDS : SubsortDeclSet .
13239  var  OPDS : OpDeclSet .
13240  var  MAS : MembAxSet .
13241  var  EqS : EquationSet .
13242  var  RlS : RuleSet .
13243  var  CDS : ClassDeclSet .
13244  var  SCDS : SubclassDeclSet .
13245  var  MDS : MsgDeclSet .
13246  var  ADS : AttrDeclSet .
13247  vars T T' T'' T3 O : Term .
13248  vars TL TL' : TermList .
13249  var  At : Attr .
13250  vars AtS AtS' AtS'' : AttrSet .
13251  vars I I' : Nat .
13252  vars NL NL' : IntList .
13253  var  Hk : Hook .
13254  var  HkL : HookList .
13255  var  R : Renaming .
13256  vars RS RS' RS'' SRS ORS : RenamingSet .
13257  var  Subst : Substitution .
13258  var  Cond : Condition .
13259  var  St : String .
13260  var  MN : ModuleName .
13261
13262  sort Tuple{RenamingSet,RenamingSet} .
13263  op <_;_> : RenamingSet RenamingSet -> Tuple{RenamingSet, RenamingSet} .
13264  ops sortMaps otherMaps : Tuple{RenamingSet, RenamingSet} -> RenamingSet .
13265  eq sortMaps(< RS ; RS' >) = RS .
13266  eq otherMaps(< RS ; RS' >) = RS' .
13267
13268  eq splitMaps(RS) = splitMapsAux(RS, none, none) .
13269  eq splitMapsAux((sort S to S'), RS', RS'')
13270    = splitMapsAux(none, ((sort S to S'), RS'), RS'') .
13271  eq splitMapsAux(((sort S to S'), RS), RS', RS'')
13272    = splitMapsAux(RS, ((sort S to S'), RS'), RS'') .
13273  eq splitMapsAux((class S to S'), RS', RS'')
13274    = splitMapsAux(none, ((class S to S'), RS'), RS'') .
13275  eq splitMapsAux(((class S to S'), RS), RS', RS'')
13276    = splitMapsAux(RS, ((class S to S'), RS'), RS'') .
13277  eq splitMapsAux(R, RS', RS'')
13278    = splitMapsAux(none, RS', (R, RS'')) [owise] .
13279  eq splitMapsAux((R, RS), RS', RS'')
13280    = splitMapsAux(RS, RS', (R, RS'')) [owise] .
13281  eq splitMapsAux(none, RS, RS') = < RS ; RS' > .
13282
13283*** To avoid the interference between the sort and class maps with other maps, the map
13284*** set is divided in two sets.
13285
13286  ceq applyMapsToModule(RS, U, M)
13287    = applyMapsToModuleAux(SRS, ORS, U, M)
13288    if < SRS ; ORS > := splitMaps(RS) .
13289  eq applyMapsToModule(RS, U, unitError(QIL)) = unitError(QIL) .
13290
13291  eq applyMapsToModuleAux(SRS, ORS, mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, M)
13292    = mod H is
13293          IL
13294          sorts applyMapsToSortSet(SRS, SS) .
13295          applyMapsToSubsorts(SRS, SSDS)
13296          applyMapsToOps(SRS, ORS, OPDS, M)
13297          applyMapsToMbs(SRS, ORS, MAS, M)
13298          applyMapsToEqs(SRS, ORS, EqS, M)
13299          applyMapsToRls(SRS, ORS, RlS, M)
13300      endm .
13301  eq applyMapsToModuleAux(SRS, ORS, th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, M)
13302    = th MN is
13303          IL sorts applyMapsToSortSet(SRS, SS) .
13304          applyMapsToSubsorts(SRS, SSDS)
13305          applyMapsToOps(SRS, ORS, OPDS, M)
13306          applyMapsToMbs(SRS, ORS, MAS, M)
13307          applyMapsToEqs(SRS, ORS, EqS, M)
13308          applyMapsToRls(SRS, ORS, RlS, M)
13309      endth .
13310  eq applyMapsToModuleAux(SRS, ORS, fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, M)
13311    = fmod H is
13312          IL
13313          sorts applyMapsToSortSet(SRS, SS) .
13314          applyMapsToSubsorts(SRS, SSDS)
13315          applyMapsToOps(SRS, ORS, OPDS, M)
13316          applyMapsToMbs(SRS, ORS, MAS, M)
13317          applyMapsToEqs(SRS, ORS, EqS, M)
13318      endfm .
13319  eq applyMapsToModuleAux(SRS, ORS, fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, M)
13320    = fth MN is
13321          IL
13322          sorts applyMapsToSortSet(SRS, SS) .
13323          applyMapsToSubsorts(SRS, SSDS)
13324          applyMapsToOps(SRS, ORS, OPDS, M)
13325          applyMapsToMbs(SRS, ORS, MAS, M)
13326          applyMapsToEqs(SRS, ORS, EqS, M)
13327      endfth .
13328  eq applyMapsToModuleAux(SRS, ORS, omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, M)
13329    = omod H is
13330           IL
13331           sorts applyMapsToSortSet(SRS, SS) .
13332           applyMapsToSubsorts(SRS, SSDS)
13333           applyMapsToClassDeclSet(SRS, ORS, CDS)
13334           applyMapsToSubclassDeclSet(SRS, SCDS)
13335           applyMapsToOps(SRS, ORS, OPDS, M)
13336           applyMapsToMsgDeclSet(SRS, ORS, MDS, M)
13337           applyMapsToMbs(SRS, ORS, MAS, M)
13338           applyMapsToEqs(SRS, ORS, EqS, M)
13339           applyMapsToRls(SRS, ORS, RlS, M)
13340      endom .
13341  eq applyMapsToModuleAux(SRS, ORS, oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, M)
13342    = oth MN is
13343           IL
13344           sorts applyMapsToSortSet(SRS, SS) .
13345           applyMapsToSubsorts(SRS, SSDS)
13346           applyMapsToClassDeclSet(SRS, ORS, CDS)
13347           applyMapsToSubclassDeclSet(SRS, SCDS)
13348           applyMapsToOps(SRS, ORS, OPDS, M)
13349           applyMapsToMsgDeclSet(SRS, ORS, MDS, M)
13350           applyMapsToMbs(SRS, ORS, MAS, M)
13351           applyMapsToEqs(SRS, ORS, EqS, M)
13352           applyMapsToRls(SRS, ORS, RlS, M)
13353      endoth .
13354
13355  eq applyMapsToOps(RS, RS', (op F : TyL -> Ty [AtS] . OPDS), M)
13356    = (applyMapsToOp(RS, getRightOpMaps(F, TyL, Ty, RS', M), RS', (op F : TyL -> Ty [AtS] .), M)
13357       applyMapsToOps(RS, RS', OPDS, M)) .
13358  eq applyMapsToOps(RS, RS', none, M) = none .
13359
13360  eq applyMapsToOp(RS, R, RS', (op F : TyL -> Ty [AtS] .), M)
13361    = (op applyOpMapsToOpId(F, R) : applyMapsToTypeList(RS, TyL) -> applyMapsToType(RS, Ty)
13362         [applyMapsToAttrs(RS, RS', applyMapToAttrs(R, AtS), M)] .) .
13363  eq applyMapsToOp(RS, (R, RS'), RS'', (op F : TyL -> Ty [AtS] .), M)
13364    *** In case of ambiguous mappings we take one of them arbitrarily
13365    = (op applyOpMapsToOpId(F, R) : applyMapsToTypeList(RS, TyL) -> applyMapsToType(RS, Ty)
13366         [applyMapsToAttrs(RS, RS'', applyMapToAttrs(R, AtS), M)] .) .
13367  eq applyMapsToOp(RS, none, RS', (op F : TyL -> Ty [AtS] .), M)
13368    *** No map for this declaration
13369    = (op F : applyMapsToTypeList(RS, TyL) -> applyMapsToType(RS, Ty)
13370         [applyMapsToAttrs(RS, RS', AtS, M)] .) .
13371
13372  eq applyMapsToMsgDeclSet(RS, RS', ((msg F : TyL -> Ty .) MDS), M)
13373    = (applyMapsToMsgDecl(RS, getRightOpMaps(F, TyL, Ty, RS', M), (msg F : TyL -> Ty .), M)
13374       applyMapsToMsgDeclSet(RS, RS', MDS, M)) .
13375  eq applyMapsToMsgDeclSet(RS, RS', none, M) = none .
13376
13377  eq applyMapsToMsgDecl(RS, R, (msg F : TyL -> Ty .), M)
13378    = (msg applyOpMapsToOpId(F, R) : applyMapsToTypeList(RS, TyL) -> applyMapsToType(RS, Ty) .) .
13379  eq applyMapsToMsgDecl(RS, (R, RS'), (msg F : TyL -> Ty .), M)
13380    *** In case of ambiguous mappings we take one of them arbitrarily
13381    = (msg applyOpMapsToOpId(F, R) : applyMapsToTypeList(RS, TyL) -> applyMapsToType(RS, Ty) .) .
13382  eq applyMapsToMsgDecl(RS, none, (msg F : TyL -> Ty .), M)
13383    *** No map for this declaration
13384    = (msg F : applyMapsToTypeList(RS, TyL) -> applyMapsToType(RS, Ty) .) .
13385
13386*** The function \texttt{applyMapToAttrs} just takes care of changing the
13387*** attributes of the operators as indicated in the renamings. The renamings
13388*** properly said is accomplished by the function
13389*** \texttt{applyMapsToAttrs}.
13390
13391  eq applyMapToAttrs((msg F to F'), AtS) = AtS .
13392  eq applyMapToAttrs((msg F : TyL -> Ty to F'), AtS) = AtS .
13393  eq applyMapToAttrs(op_to`term_(T, T'), AtS) = AtS .
13394  eq applyMapToAttrs((op F to F' [AtS]), AtS')
13395    = applyMapToAttrsAux(AtS, AtS', none) .
13396  eq applyMapToAttrs((op F : TyL -> Ty to F' [AtS]), AtS')
13397    = applyMapToAttrsAux(AtS, AtS', none) .
13398
13399  *** add the new syntactic attributes
13400  eq applyMapToAttrsAux((gather(QIL) AtS), AtS', AtS'')
13401    = applyMapToAttrsAux(AtS, AtS', (gather(QIL) AtS'')) .
13402  eq applyMapToAttrsAux((format(QIL) AtS), AtS', AtS'')
13403    = applyMapToAttrsAux(AtS, AtS', (format(QIL) AtS'')) .
13404  eq applyMapToAttrsAux((prec(I) AtS), AtS', AtS'')
13405    = applyMapToAttrsAux(AtS, AtS', (prec(I) AtS'')) .
13406  eq applyMapToAttrsAux((At AtS), AtS', AtS'')
13407    = applyMapToAttrsAux(AtS, AtS', AtS'')
13408    [owise] .
13409
13410  *** remove the old syntactic attributes
13411  eq applyMapToAttrsAux(AtS, (format(QIL) AtS'), AtS'')
13412    = applyMapToAttrsAux(AtS, AtS', AtS'') .
13413  eq applyMapToAttrsAux(AtS, (gather(QIL) AtS'), AtS'')
13414    = applyMapToAttrsAux(AtS, AtS', AtS'') .
13415  eq applyMapToAttrsAux(AtS, (prec(I) AtS'), AtS'')
13416    = applyMapToAttrsAux(AtS, AtS', AtS'') .
13417
13418  eq applyMapToAttrsAux(none, (At AtS), AtS')
13419    = applyMapToAttrsAux(none, AtS, (At AtS')) .
13420  eq applyMapToAttrsAux(none, none, AtS) = AtS .
13421
13422  eq applyMapsToTypeList(RS, (Ty TyL))
13423    = (applyMapsToType(RS, Ty) applyMapsToTypeList(RS, TyL)) .
13424  eq applyMapsToTypeList(RS, nil) = nil .
13425
13426  eq applyMapsToSubsorts(RS, ((subsort S < S' .) SSDS))
13427    = ((subsort applyMapsToType(RS, S) < applyMapsToType(RS, S') .)
13428       applyMapsToSubsorts(RS, SSDS)) .
13429  eq applyMapsToSubsorts(RS, none) = none .
13430
13431  eq applyMapsToAttrs(RS, RS', (id(T) AtS), M)
13432    = (id(applyMapsToTerm2(RS, RS', T, M))
13433       applyMapsToAttrs(RS, RS', AtS, M)) .
13434  eq applyMapsToAttrs(RS, RS', (left-id(T) AtS), M)
13435    = (left-id(applyMapsToTerm2(RS, RS', T, M))
13436       applyMapsToAttrs(RS, RS', AtS, M)) .
13437  eq applyMapsToAttrs(RS, RS', (right-id(T) AtS), M)
13438    = (right-id(applyMapsToTerm2(RS, RS', T, M))
13439       applyMapsToAttrs(RS, RS', AtS, M)) .
13440  eq applyMapsToAttrs(RS, RS', (special(HkL) AtS), M)
13441    = (special(applyMapsToHooks(RS, RS', HkL, M))
13442       applyMapsToAttrs(RS, RS', AtS, M)) .
13443  eq applyMapsToAttrs(RS, RS', (label(L) AtS), M)
13444    = (label(applyMapsToLabel(RS, L))
13445       applyMapsToAttrs(RS, RS', AtS, M)) .
13446  eq applyMapsToAttrs(RS, RS', AtS, M) = AtS [owise] .
13447
13448  eq applyMapsToHooks(RS, RS', id-hook(QI, QIL) HkL, M)
13449    = id-hook(QI, QIL)
13450      applyMapsToHooks(RS, RS', HkL, M).
13451  eq applyMapsToHooks(RS, RS', op-hook(QI, QI', QIL, QI'') HkL, M)
13452    = applyMapsToHooksAux(RS,
13453         getRightOpMaps(QI', QIL, QI'', RS', M),
13454         op-hook(QI, QI', QIL, QI''), M)
13455      applyMapsToHooks(RS, RS', HkL, M).
13456  eq applyMapsToHooks(RS, RS', term-hook(QI, T) HkL, M)
13457    = term-hook(QI, applyMapsToTerm2(RS, RS', T, M))
13458      applyMapsToHooks(RS, RS', HkL, M).
13459  eq applyMapsToHooks(RS, RS', nil, M) = nil .
13460
13461  eq applyMapsToHooksAux(RS, R, op-hook(QI, F, TyL, Ty), M)
13462    = op-hook(QI, applyOpMapsToOpId(F, R),
13463         applyMapsToTypeList(RS, TyL), applyMapsToType(RS, Ty)) .
13464  eq applyMapsToHooksAux(RS, (R, RS'), op-hook(QI, F, TyL, Ty), M)
13465    *** In case of ambiguous mappings we take any of them arbitrarily
13466    = op-hook(QI, applyOpMapsToOpId(F, R),
13467         applyMapsToTypeList(RS, TyL), applyMapsToType(RS, Ty)) .
13468  eq applyMapsToHooksAux(RS, none, op-hook(QI, F, TyL, Ty), M)
13469    = op-hook(QI, F, applyMapsToTypeList(RS, TyL),
13470        applyMapsToType(RS, Ty)) .
13471
13472  eq applyMapsToMbs(RS, RS', ((mb T : S [AtS] .) MAS), M)
13473    = ((mb applyMapsToTerm2(RS, RS', T, M) : applyMapsToType(RS, S)
13474          [applyMapsToAttrs(RS, RS', AtS, M)] .)
13475       applyMapsToMbs(RS, RS', MAS, M)) .
13476  eq applyMapsToMbs(RS, RS', ((cmb T : S if Cond [AtS] .) MAS), M)
13477    = ((cmb applyMapsToTerm2(RS, RS', T, M) : applyMapsToType(RS, S)
13478          if applyMapsToCond(RS, RS', Cond, M)
13479          [applyMapsToAttrs(RS, RS', AtS, M)] .)
13480       applyMapsToMbs(RS, RS', MAS, M)) .
13481  eq applyMapsToMbs(RS, RS', none, M) = none .
13482
13483  eq applyMapsToEqs(RS, RS', ((ceq T = T' if Cond [AtS] .) EqS), M)
13484    = ((ceq applyMapsToTerm2(RS, RS', T, M)
13485          = applyMapsToTerm2(RS, RS', T', M)
13486          if applyMapsToCond(RS, RS', Cond, M)
13487        [applyMapsToAttrs(RS, RS', AtS, M)] .)
13488       applyMapsToEqs(RS, RS', EqS, M)) .
13489  eq applyMapsToEqs(RS, RS', ((eq T = T' [AtS] .) EqS), M)
13490    = ((eq applyMapsToTerm2(RS, RS', T, M)
13491          = applyMapsToTerm2(RS, RS', T', M)
13492          [applyMapsToAttrs(RS, RS', AtS, M)] .)
13493       applyMapsToEqs(RS, RS', EqS, M)) .
13494  eq applyMapsToEqs(RS, RS', none, M) = none .
13495
13496  eq applyMapsToRls(RS, RS', ((crl T => T' if Cond [AtS] .) RlS), M)
13497    = ((crl applyMapsToTerm2(RS, RS', T, M)
13498          => applyMapsToTerm2(RS, RS', T', M)
13499          if applyMapsToCond(RS, RS', Cond, M)
13500          [applyMapsToAttrs(RS, RS', AtS, M)] .)
13501       applyMapsToRls(RS, RS', RlS, M)) .
13502  eq applyMapsToRls(RS, RS', ((rl T => T' [AtS] .) RlS), M)
13503    = ((rl applyMapsToTerm2(RS, RS', T, M)
13504          => applyMapsToTerm2(RS, RS', T', M)
13505          [applyMapsToAttrs(RS, RS', AtS, M)] .)
13506       applyMapsToRls(RS, RS', RlS, M)) .
13507  eq applyMapsToRls(RS, RS', none, M) = none .
13508
13509  eq applyMapsToCond(RS, RS', T = T' /\ Cond, M)
13510    = applyMapsToTerm2(RS, RS', T, M) = applyMapsToTerm2(RS, RS', T', M)
13511      /\ applyMapsToCond(RS, RS', Cond, M) .
13512  eq applyMapsToCond(RS, RS', T : S /\ Cond, M)
13513    = applyMapsToTerm2(RS, RS', T, M) : applyMapsToSort(RS, S)
13514      /\ applyMapsToCond(RS, RS', Cond, M) .
13515  eq applyMapsToCond(RS, RS', T := T' /\ Cond, M)
13516    = applyMapsToTerm2(RS, RS', T, M) := applyMapsToTerm2(RS, RS', T', M)
13517      /\ applyMapsToCond(RS, RS', Cond, M) .
13518  eq applyMapsToCond(RS, RS', T => T' /\ Cond, M)
13519    = applyMapsToTerm2(RS, RS', T, M) => applyMapsToTerm2(RS, RS', T', M)
13520      /\ applyMapsToCond(RS, RS', Cond, M) .
13521  eq applyMapsToCond(RS, RS', nil, M) = nil .
13522
13523  eq applyMapsToLabel((label L to L'), L'')
13524    = if L == L''
13525      then L'
13526      else L''
13527      fi .
13528  eq applyMapsToLabel(((label L to L'), RS), L'')
13529    = if L == L''
13530      then L'
13531      else applyMapsToLabel(RS, L'')
13532      fi .
13533  eq applyMapsToLabel(R, L) = L [owise] .
13534  eq applyMapsToLabel((R, RS), L)
13535    = applyMapsToLabel(RS, L)
13536    [owise] .
13537  eq applyMapsToLabel(none, L) = L .
13538
13539  eq applyMapsToClassDeclSet(RS, RS', class C | ADS . CDS)
13540    = (class applyMapsToClassName(RS, C) | applyMapsToAttrDeclSet(RS, RS', C, ADS) .
13541       applyMapsToClassDeclSet(RS, RS', CDS)) .
13542  eq applyMapsToClassDeclSet(RS, RS', none) = none .
13543
13544  eq applyMapsToAttrDeclSet(RS, RS', C, ((attr A : Ty), ADS))
13545    = ((attr applyMapsToAttrName(RS', C, A) : applyMapsToType(RS, Ty)),
13546       applyMapsToAttrDeclSet(RS, RS', C, ADS)) .
13547  eq applyMapsToAttrDeclSet(RS, RS', C, none) = none .
13548
13549  eq applyMapsToAttrName((attr A . C to A'), C', A'')
13550    = if (C == C') and (A == A'')
13551      then A'
13552      else A''
13553      fi .
13554  eq applyMapsToAttrName(((attr A . C to A'), RS), C', A'')
13555    = if (C == C') and (A == A'')
13556      then A'
13557      else applyMapsToAttrName(RS, C', A'')
13558      fi .
13559  eq applyMapsToAttrName(R, C, A) = A [owise] .
13560  eq applyMapsToAttrName((R, RS), C, A)
13561    = applyMapsToAttrName(RS, C, A)
13562    [owise] .
13563  eq applyMapsToAttrName(none, C, A) = A .
13564
13565  eq applyMapsToSubclassDeclSet(RS, subclass C < C' . SCDS)
13566    = (subclass applyMapsToClassName(RS, C) < applyMapsToClassName(RS, C') .
13567       applyMapsToSubclassDeclSet(RS, SCDS)) .
13568  eq applyMapsToSubclassDeclSet(RS, none) = none .
13569endfm
13570
13571*******************************************************************************
13572
13573***
13574*** 6.9 Instantiation of Parameterized Modules and the
13575***     \texttt{META-LEVEL} Module Expression
13576
13577*** A parameterized module
13578*** $\texttt{M[L}_1\texttt{\ ::\ T}_1\texttt{,\}\ldots\texttt{, L}_n
13579*** \texttt{ :: T}_n\texttt{]}$, with \mbox{$\texttt{L}_1\ldots\texttt{L}_n$}
13580*** labels and \mbox{$\texttt{T}_1\ldots\texttt{T}_n$} theory identifiers, is
13581*** represented as a module with name \texttt{M} which contains parameter
13582*** declarations  \mbox{$\texttt{par\ L}_i\texttt{\ ::\ T}_i$} for
13583*** $1\leq i\leq n$, and an importation declaration
13584*** \mbox{$\texttt{inc\ par\ L}_i\texttt{\ ::\ T}_i\texttt{\ .}$} for each
13585*** parameter \mbox{$\texttt{L}_i\texttt{\ ::\ T}_i$} in its interface.  Note
13586*** that all modules are handled in a uniform way: nonparameterized modules
13587*** and theories have their list of parameters set to \texttt{nil}.
13588
13589*** The instantiation of the formal parameters of a parameterized module with
13590*** actual modules or theories requires a view from each formal parameter
13591*** theory to its corresponding actual unit. The process of instantiation
13592*** results in the replacement of each interface theory by its corresponding
13593*** actual parameter, using the views to bind actual names to formal names.
13594
13595*** The naming conventions for sorts have to be taken into account in the
13596*** instantiation process: every occurrence of a sort coming from a theory in
13597*** the interface of a module must be qualified by its theory's label, and
13598*** sorts defined in the body of a parameterized module can be parameterized
13599*** by the labels in the interface of the module (see
13600*** Section~\ref{parameterized-modules}).
13601
13602*** The labeling convention for theories and for the sorts coming from them is
13603*** very useful to avoid collisions of sort names coming from the parameter
13604*** theories, and also to allow different uses of the same theory several
13605*** times in the interface of a module. We assume that all sorts coming from
13606*** the theory part of the parameter theories are used in their qualified form
13607*** to manipulate the maps defined in the views before being applied to the
13608*** body of the module being instantiated. If the target of a view is a
13609*** theory, the sorts from the theory part of the target theory appearing in
13610*** the targTS of the maps in the view will be qualified as well, following
13611*** the same convention.
13612
13613*** When a parameterized module
13614*** $\texttt{M[L}_1\texttt{\ ::\ T}_1\texttt{,\ }
13615***            \ldots\texttt{,\ L}_n\texttt{\ ::\ T}_n\texttt{]}$
13616*** is instantiated with views $\texttt{V}_1\ldots\texttt{V}_n$, each
13617*** parameterized sort $\texttt{S[L}_1\texttt{,}\ldots\texttt{,L}_n\texttt{]}$
13618*** in the body of the parameterized module is renamed to
13619*** $\texttt{S[V}_1\texttt{,}\ldots\texttt{,V}_n\texttt{]}$.
13620
13621*** The discussion on the qualification of sorts in views before being used in
13622*** the instantiation process applies in a completely similar way to class
13623*** names in parameterized object-oriented modules.
13624
13625*** As we saw in Section~\ref{module-expressions}, it is possible to import a
13626*** module expression in which a parameterized module is instantiated by some
13627*** of the formal parameters of the parameterized module in which it is
13628*** imported. This is done by using the label of some of the parameters in the
13629*** interface of a module, say \mbox{$\texttt{L}_k\texttt{\ ::\ T}_k$}, in a
13630*** module expression in which some parameterized module \texttt{N} with formal
13631*** parameter $\texttt{T}_k$ is instantiated with $\texttt{L}_k$, that is, we
13632*** have the module expression $\texttt{N[}\ldots\texttt{L}_k\ldots\texttt{]}$.
13633*** In this case, $\texttt{L}_k$ is considered as the identity view for the
13634*** theory $\texttt{T}_k$ with $\texttt{L}_k$ as name. Note that to be able to
13635*** check whether a label in the interface of a module is used in an
13636*** instantiation of this form, in the evaluation of a module expression the
13637*** list of parameters of the module in which the module expression appears
13638*** must be available. This is the reason why the \texttt{evalModExp} function
13639*** was defined with \texttt{ParameterList} as one of the sorts in its
13640*** arity (see Section~\ref{evalModExp}). For module expressions appearing
13641*** outside of any module, that is, in commands, etc., this list will be set
13642*** to \texttt{nil}.
13643
13644*** Note that this kind of instantiation may produce a `cascade' effect. The
13645*** module being instantiated may itself import other module expressions in
13646*** which labels of some of its parameter theories are used in the
13647*** instantiation of some of these imported module expressions. This is handled
13648*** by `preparing' the module expressions appearing in the importation
13649*** declarations of the module (\texttt{prepImports}). This process
13650*** consists in changing the labels of the interface of the module being
13651*** instantiated which are used in the importations of module expressions by
13652*** the corresponding view names (\texttt{prepHeader}). After completing the
13653*** generation of the module resulting from the evaluation of the module
13654*** expression, this module will be evaluated with the \texttt{evalModule}
13655*** function, producing the evaluation of these new module expressions. In any
13656*** extension of the language, new equations for the function
13657*** \texttt{prepHeader} will have to be added for each new kind of module
13658*** expression being defined.
13659
13660*** In Sections~\ref{renaming} and~\ref{extension} we shall see how new
13661*** equations completing the semantics of \texttt{prepHeader} are added for
13662*** each new module expression being defined. In the case of the renaming
13663*** module expression, the renaming maps will have to be prepared as well, to
13664*** adjust the sort names being renamed to the conventions discussed above.
13665
13666*** As for any other module expression being defined, in addition to the
13667*** operator declaration for the constructor of the instantiation module
13668*** expression, equations completing the semantics of operators
13669*** \texttt{evalModExp}, \texttt{header2QidList}, and
13670*** \texttt{setUpModExpDeps} have to be given.
13671
13672fmod INST-EXPR-EVALUATION is
13673  pr EVALUATION .
13674  pr RENAMING-SET-APPL-ON-UNIT .
13675  inc MOD-EXPR .
13676  inc MOD-NAME .
13677  pr DATABASE .
13678
13679*** We start by giving the new constructor for sort \texttt{ModuleExpression}.
13680*** Note thatthe modules \texttt{MOD-EXPR} and \texttt{MOD-NAME} have been
13681*** imported in \texttt{including} mode.
13682
13683  vars QI QI' QI'' X Y W Z C F F' A A' L L' : Qid .
13684  var  QIL : QidList .
13685  vars M M' PU U U' U'' DM : Module .
13686  var  Th : OTheory .
13687  vars ME ME' ME'' : ModuleExpression .
13688  var  H : Header .
13689  vars MN MN' : ModuleName .
13690  vars MNS MNS' MNS'' MNS3 MNS4 MNS5 : Set{ModuleName} .
13691  vars VE VE' VE'' VE3 VE4 : ViewExp .
13692  vars VES VES' : Set{ViewExp} .
13693  vars MIS MIS' : Set{ModuleInfo} .
13694  var  VIS : Set{ViewInfo} .
13695  vars DB DB' DB'' : Database .
13696  var  PD : ParameterDecl .
13697  vars PDL PDL' PDL'' PDL3 PDL4 PDL5 : ParameterDeclList .
13698  var  PDS : Set{ParameterDecl} .
13699  vars PL PL' PL'' PL3 : ParameterList .
13700  vars S S' P P' P'' : Sort .
13701  vars IL IL' IL'' IL3 : ImportList .
13702  vars SMS SMS' SMS'' SMS3 : SortMappingSet .
13703  vars OMS OMS' OMS'' OMS3 : OpMappingSet .
13704  var  V : Variable .
13705  var  Ct : Constant .
13706  var  SL : QidList .
13707  var  Ty : Type .
13708  var  TyL : TypeList .
13709  vars SS SS' SS'' : SortSet .
13710  var  K : Kind .
13711  vars T T' O : Term .
13712  var  DT : Default{Term} .
13713  var  TL : TermList .
13714  var  CDS : ClassDeclSet .
13715  var  ADS : AttrDeclSet .
13716  var  B : Bool .
13717  var  AtS : AttrSet .
13718  var  N : Nat .
13719  var  PV : PreView .
13720  var  VI : View .
13721  var  VDS : OpDeclSet .
13722  vars RS RS' RS'' SRS SRS' ORS ORS' : RenamingSet .
13723
13724*** In the input given by the user, the operator \verb~_(_)~ is used both for
13725*** the instantiation of module expressions, and for expressions
13726*** parameterizing the module \texttt{META-LEVEL} with a list of module names.
13727*** The function \texttt{evalModExp} distinguishes these two cases, calling
13728*** the function \texttt{unitInst} in the former and the function
13729*** \texttt{prepMetalevel} in the latter.
13730
13731  op unitInst : Header ParameterList ParameterDeclList Database -> Database .
13732  op prepMetalevel : ParameterList Database -> Database .
13733
13734  eq evalModExp(ME{PL}, PDL, DB)
13735    = if unitInDb(ME{PL}, DB)
13736      then < DB ; ME{PL} >
13737      else if ME == 'META-LEVEL
13738           then < prepMetalevel(PL, DB) ; ME{PL} >
13739           else < unitInst(
13740                    modExp(evalModExp(ME, PDL, evalViewExp(PL, PDL, DB))),
13741                    PL, PDL,
13742                    database(evalModExp(ME, PDL, evalViewExp(PL, PDL, DB))))
13743                  ;
13744                  modExp(evalModExp(ME, PDL, evalViewExp(PL, PDL, DB))){PL} >
13745           fi
13746      fi .
13747
13748*** The function \texttt{prepMetalevel} creates a new module with the
13749*** module expression being evaluated as name, which imports the predefined
13750*** \texttt{META-LEVEL} module. For each module name \texttt{I} in the list
13751*** given as parameter of the expression, the declaration of a constant
13752*** \texttt{I} of sort \texttt{Module} and an equation identifying such
13753*** constant with the metarepresentation of the module with such name in the
13754*** database are added to the module being created.
13755
13756  op prepMetalevelAux : ParameterList Module Database -> Database .
13757
13758  eq prepMetalevel(PL, DB)
13759    = prepMetalevelAux(PL,
13760        addImports((including 'META-LEVEL .),
13761          setName(emptyFModule, 'META-LEVEL{PL})), DB) .
13762
13763  eq prepMetalevelAux((QI), U, DB)
13764    = prepMetalevelAux(nil,
13765        addOps((op qid("META-" + string(QI)) : nil -> 'Module [none] .),
13766          addEqs((eq qid("META-" + string(QI) + ".Module")
13767                    = up(getFlatModule(QI, database(evalModExp(QI, DB))))
13768                    [none] .),
13769            U)),
13770        DB) .
13771  eq prepMetalevelAux((QI, PL), U, DB)
13772    = prepMetalevelAux(PL,
13773        addOps((op qid("META-" + string(QI)) : nil -> 'Module [none] .),
13774          addEqs((eq qid("META-" + string(QI) + ".Module")
13775                    = up(getFlatModule(QI, database(evalModExp(QI, DB))))
13776                    [none] .),
13777            U)),
13778        DB) .
13779  eq prepMetalevelAux(nil, U, DB) = evalModule(U, none, DB) .
13780
13781*** The function \texttt{getClassNames} returns the set of the names of
13782*** the classes in a set of class declarations.
13783
13784  op getClassNames : ClassDeclSet -> SortSet .
13785
13786  eq getClassNames(((class S | ADS .) CDS))
13787    = (S ; getClassNames(CDS)) .
13788  eq getClassNames(none) = none .
13789
13790*** The following `getTh' functions return the corresponding elements in the
13791*** theory part of the structure of the given unit. For example, the function
13792*** \texttt{getThSorts} returns the set of sorts declared in the ``loose
13793*** part'' of the structure of the unit in the database having the name
13794*** indicated as first argument.
13795
13796  op getThSorts : ModuleExpression Database -> SortSet .
13797  op getThClasses : ModuleExpression Database -> SortSet .
13798  op getThSortsAux : ImportList Database -> SortSet .
13799  op getThClassesAux : ImportList Database -> SortSet .
13800
13801  eq getThSorts(ME, DB)
13802    = if theory(getTopModule(ME, DB))
13803      then (getThSortsAux(getImports(getTopModule(ME, DB)), DB) ;
13804            getSorts(getTopModule(ME, DB)))
13805      else none
13806      fi .
13807
13808  eq getThSortsAux(((including MN .) IL), DB)
13809    = (getThSorts(MN, DB) ; getThSortsAux(IL, DB)) .
13810  eq getThSortsAux(((extending MN .) IL), DB)
13811    = (getThSorts(MN, DB) ; getThSortsAux(IL, DB)) .
13812  eq getThSortsAux(((protecting MN .) IL), DB)
13813    = (getThSorts(MN, DB) ; getThSortsAux(IL, DB)) .
13814  eq getThSortsAux(nil, DB) = none .
13815
13816  eq getThClasses(ME, DB)
13817    = if getTopModule(ME, DB) :: OTheory
13818         and-then not getTopModule(ME, DB) :: STheory
13819      then (getThClassesAux(getImports(getTopModule(ME, DB)), DB) ;
13820            getClassNames(getClasses(getTopModule(ME, DB))))
13821      else none
13822      fi .
13823
13824  eq getThClassesAux(((including MN .) IL), DB)
13825    = (getThClasses(MN, DB) ; getThClassesAux(IL, DB)) .
13826  eq getThClassesAux(((extending MN .) IL), DB)
13827    = (getThClasses(MN, DB) ; getThClassesAux(IL, DB)) .
13828  eq getThClassesAux(((protecting MN .) IL), DB)
13829    = (getThClasses(MN, DB) ; getThClassesAux(IL, DB)) .
13830  eq getThClassesAux(nil, DB) = none .
13831
13832*** The `get' functions return the corresponding elements in the structure of
13833*** the given unit. For example, \texttt{getSortSet} returns all the sorts
13834*** declared in the structure of the unit in the database having the name
13835*** given as first argument.
13836
13837  op getSortSet : ModuleName Database -> SortSet .
13838  op getClassSet : ModuleName Database -> SortSet .
13839
13840  op getSortSetAux : ImportList Database -> SortSet .
13841  op getClassSetAux : ImportList Database -> SortSet .
13842
13843  eq getSortSet(MN, DB)
13844    = (getSortSetAux(getImports(getTopModule(MN, DB)), DB) ;
13845       getSorts(getTopModule(MN, DB))) .
13846
13847  eq getSortSetAux(((including MN .) IL), DB)
13848    = (getSortSet(MN, DB) ; getSortSetAux(IL, DB)) .
13849  eq getSortSetAux(((extending MN .) IL), DB)
13850    = (getSortSet(MN, DB) ; getSortSetAux(IL, DB)) .
13851  eq getSortSetAux(((protecting MN .) IL), DB)
13852    = (getSortSet(MN, DB) ; getSortSetAux(IL, DB)) .
13853  eq getSortSetAux(nil, DB) = none .
13854
13855  eq getClassSet(MN, DB)
13856    = (getClassSetAux(getImports(getTopModule(MN, DB)), DB) ;
13857       getClassNames(getClasses(getTopModule(MN, DB)))) .
13858
13859  eq getClassSetAux(((including MN .) IL), DB)
13860    = (getClassSet(MN, DB) ; getClassSetAux(IL, DB)) .
13861  eq getClassSetAux(((extending MN .) IL), DB)
13862    = (getClassSet(MN, DB) ; getClassSetAux(IL, DB)) .
13863  eq getClassSetAux(((protecting MN .) IL), DB)
13864    = (getClassSet(MN, DB) ; getClassSetAux(IL, DB)) .
13865  eq getClassSetAux(nil, DB) = none .
13866
13867*** As pointed out in Section~\ref{parameterized-modules}, in a parameterized
13868*** module all occurrences of sorts or classes coming from the parameter
13869*** theories have to be qualified. \texttt{createCopy} is the function used
13870*** for creating these renamed copies of the parameters. As also explained in
13871*** Section~\ref{parameterized-modules}, if a parameter theory is structured,
13872*** the renaming is carried out not only at the top level, but for the entire
13873*** ``theory part'' in the structure.
13874
13875*** The function \texttt{createCopy} calls an auxiliary function,
13876*** \texttt{prepPar}, which recursively proceeds through all the subtheories
13877*** of the given theory. For each theory in the structure, the required set of
13878*** maps is generated and applied to such a theory using the
13879*** \texttt{applyMapsToModule} function discussed in
13880*** Section~\ref{applyMapsToModule}, which is then evaluated and entered into
13881*** the database. Note that the renamings to which a theory is subjected must
13882*** also be applied to the theories importing it. The new database and the
13883*** renaming maps applied to the theory will have to be returned by the
13884*** function.
13885
13886*** The function \texttt{prepPar} makes a copy of the theory specified by the
13887*** name given as first argument and of all its subtheories (only theories, no
13888*** modules), and qualifies all the sorts appearing in it with the label given
13889*** in the declaration of the parameter, which is given as second argument.
13890
13891  pr 2TUPLE{ViewExp,ViewExp}
13892       * (op ((_,_)) to <_;_>,
13893          op p1_ to 1st,
13894          op p2_ to 2nd).
13895
13896  sorts ---- Tuple{ViewExp,ViewExp}
13897        Set{Tuple{ViewExp,ViewExp}}
13898        prepParResult  .
13899  subsort Tuple{ViewExp,ViewExp} < Set{Tuple{ViewExp,ViewExp}} .
13900----  op <_;_> : ViewExp ViewExp -> Tuple{ViewExp,ViewExp} .
13901----  ops 1st 2nd : Tuple{ViewExp,ViewExp} -> ViewExp .
13902  op none : -> Set{Tuple{ViewExp,ViewExp}} .
13903  op __ : Set{Tuple{ViewExp,ViewExp}} Set{Tuple{ViewExp,ViewExp}}
13904      -> Set{Tuple{ViewExp,ViewExp}} [assoc comm id: none] .
13905
13906  vars VEPS VEPS' : Set{Tuple{ViewExp,ViewExp}} .
13907
13908----  eq 1st(< VE ; VE' >) = VE .
13909----  eq 2nd(< VE ; VE' >) = VE' .
13910
13911  op prepPar : Qid Qid ModuleExpression Database -> prepParResult .
13912  op prepParImports : ImportList ImportList Qid Qid SortMappingSet OpMappingSet
13913        Set{Tuple{ViewExp,ViewExp}} ParameterDeclList Database -> prepParResult .
13914
13915  op <_;_;_;_;_;_;_;_> : SortMappingSet OpMappingSet Database ViewExp ViewExp Set{Tuple{ViewExp,ViewExp}} Bool ImportList -> prepParResult .
13916  op sortMappingSet : prepParResult -> SortMappingSet .
13917  op opMappingSet : prepParResult -> OpMappingSet .
13918  op database : prepParResult -> Database .
13919  op sourceViewExp : prepParResult -> ViewExp .
13920  op targetViewExp : prepParResult -> ViewExp .
13921  op viewExpPairSet : prepParResult -> Set{Tuple{ViewExp,ViewExp}} .
13922  op theoryFlag : prepParResult -> Bool .
13923  op getImports : prepParResult -> ImportList .
13924  eq opMappingSet(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = OMS .
13925  eq sortMappingSet(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = SMS .
13926  eq database(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = DB .
13927  eq sourceViewExp(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = VE .
13928  eq targetViewExp(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = VE' .
13929  eq viewExpPairSet(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = VEPS .
13930  eq theoryFlag(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = B .
13931  eq getImports(< SMS ; OMS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = IL .
13932
13933  ----op createCopy : ParameterDecl Database -> Database .
13934  op prepPar : Qid ModuleExpression Database  -> prepParResult .
13935  op prepParImports : ImportList ImportList Qid SortMappingSet OpMappingSet
13936        Set{Tuple{ViewExp,ViewExp}} ParameterDeclList Database -> prepParResult .
13937
13938  eq createCopy(X :: ME, DB)
13939    = if unitInDb(pd(X :: ME), DB)
13940      then DB
13941      else database(prepPar(X, ME, database(evalModExp(ME, DB))))
13942      fi .
13943
13944  ceq prepPar(X, ME, DB)
13945    = < SMS' ;
13946        OMS ;
13947        (if unitInDb(pd(X :: ME), DB)
13948         then DB
13949         else evalModule(
13950                setImports(
13951                  setName(
13952                    applyMapsToModule(maps2rens(SMS'), maps2rens(OMS), Th, getFlatModule(ME, DB)),
13953                    pd(X :: ME)),
13954                  IL),
13955                applyMapsToOps(maps2rens(SMS'), maps2rens(OMS), getVars(ME, DB), getFlatModule(ME, DB)),
13956                DB')
13957         fi) ;
13958        mtViewExp ; mtViewExp ; none ; true ; nil >
13959    if Th := getTopModule(ME, DB)
13960       /\ < SMS ; OMS ; DB' ; VE ; VE' ; VEPS ; B ; IL > := prepParImports(getImports(Th), nil, X, none, none, none, X :: ME, DB)
13961       /\ SMS' := (SMS
13962                   sortMapsPar(X, getSorts(Th), none)
13963                   classMapsPar(X, classSet(getClasses(Th)), none)) .
13964  eq prepPar(X, ME, DB)
13965    = < none ; none ; warning(DB, '\r 'Error: '\o 'Incorrect 'parameter '\n) ;
13966        mtViewExp ; mtViewExp ; none ; false ; nil >
13967      [owise] .
13968
13969  ceq prepParImports(((including ME .) IL), IL', X, SMS, OMS, VEPS, PDL, DB)
13970    = if B
13971      then prepParImports(IL, (IL' (including pd(X :: ME') .)), X, (SMS SMS'), (OMS OMS'), VEPS, PDL, DB')
13972      else prepParImports(IL, (IL' (including ME .)), X, SMS, OMS, VEPS, PDL, DB)
13973      fi
13974    if ME' := prepModExp(ME, VEPS)
13975    /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) .
13976  ceq prepParImports(((extending ME .) IL), IL', X, SMS, OMS, VEPS, PDL, DB)
13977    = if B
13978      then *** A theory shouldn't be imported in protecting mode
13979           prepParImports(IL, (IL' (extending pd(X :: ME') .)), X, (SMS SMS'), (OMS OMS'), VEPS, PDL, DB')
13980      else prepParImports(IL, (IL' (extending ME .)), X, SMS, OMS, VEPS, PDL, DB)
13981      fi
13982    if ME' := prepModExp(ME, VEPS)
13983    /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) .
13984  ceq prepParImports(((protecting ME .) IL), IL', X, SMS, OMS, VEPS, PDL, DB)
13985    = if B
13986      then *** A theory shouldn't be imported in protecting mode
13987           prepParImports(IL, (IL' (protecting pd(X :: ME') .)), X, (SMS SMS'), (OMS OMS'), VEPS, PDL, DB')
13988      else prepParImports(IL, (IL' (protecting ME .)), X, SMS, OMS, VEPS, PDL, DB)
13989      fi
13990    if ME' := prepModExp(ME, VEPS)
13991    /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) .
13992  ceq prepParImports(((including pd(X :: ME) .) IL), IL', Y, SMS, OMS, (< X ; Z > VEPS), PDL, DB)
13993    = prepParImports(IL, (IL' (including pd(Z :: ME') .)), Y, (SMS SMS'), (OMS OMS'), (< X ; Z > VEPS), PDL, DB')
13994    if ME' := prepModExp(ME, VEPS)
13995    /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) .
13996  ceq prepParImports(((extending pd(X :: ME) .) IL), IL', Y, SMS, OMS, (< X ; Z > VEPS), PDL, DB)
13997    = prepParImports(IL, (IL' (extending pd(Z :: ME') .)), Y, (SMS SMS'), (OMS OMS'), (< X ; Z > VEPS), PDL, DB')
13998    if ME' := prepModExp(ME, VEPS)
13999    /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) .
14000  ceq prepParImports(((protecting pd(X :: ME) .) IL), IL', Y, SMS, OMS, (< X ; Z > VEPS), PDL, DB)
14001    = prepParImports(IL, (IL' (protecting pd(Z :: ME') .)), Y, (SMS SMS'), (OMS OMS'), (< X ; Z > VEPS), PDL, DB')
14002    if ME' := prepModExp(ME, VEPS)
14003    /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) .
14004  eq prepParImports(nil, IL, X, SMS, OMS, VEPS, PDL, DB)
14005    = < SMS ; OMS ; DB ; mtViewExp ; mtViewExp ; none ; false ; IL > .
14006
14007  ceq prepPar(X, Y, ME, DB)
14008    = (< SMS' ; OMS ;
14009        (if unitInDb(pd(Y :: ME), DB)
14010         then DB
14011         else evalModule(
14012                setImports(
14013                  setName(
14014                    applyMapsToModule(maps2rens(SMS'), maps2rens(OMS), getTopModule(pd(X :: ME), DB), getFlatModule(pd(X :: ME), DB)),
14015                    pd(Y :: ME)),
14016                  IL),
14017                applyMapsToOps(maps2rens(SMS'), maps2rens(OMS), getVars(pd(X :: ME), DB), getFlatModule(pd(X :: ME), DB)),
14018                DB')
14019         fi) ;
14020        X ; Y ; < X ; Y > ; true ; nil >)
14021    if Th := getTopModule(ME, DB)
14022    /\ (< SMS ; OMS ; DB' ; VE ; VE' ; VEPS ; B ; IL >) := prepParImports(getImports(Th), nil, X, Y, none, none, < X ; Y >, X :: ME, DB)
14023    /\ SMS' := (SMS
14024                genMapsQualSorts(X, Y, getSorts(Th), none)
14025                genMapsQualClasses(X, Y, classSet(getClasses(Th)), none)) .
14026
14027  eq prepParImports(((including ME .) IL), IL', X, Y, SMS, OMS, VEPS, PDL, DB)
14028    = prepParImports(IL, (IL' including ME .), X, Y, SMS, OMS, VEPS, PDL, DB) .
14029  eq prepParImports(((extending ME .) IL), IL', X, Y, SMS, OMS, VEPS, PDL, DB)
14030    = prepParImports(IL, (IL' extending ME .), X, Y, SMS, OMS, VEPS, PDL, DB) .
14031  eq prepParImports(((protecting ME .) IL), IL', X, Y, SMS, OMS, VEPS, PDL, DB)
14032    = prepParImports(IL, (IL' protecting ME .), X, Y, SMS, OMS, VEPS, PDL, DB) .
14033  ceq prepParImports(including pd(X :: ME) . IL, IL', Y, Z, SMS, OMS, VEPS, PDL, DB)
14034    = prepParImports(IL, IL' including pd(X :: ME') ., Y, Z, (SMS SMS'), (OMS OMS'), VEPS, PDL, DB')
14035    if ME' := prepModExp(ME, VEPS)
14036    /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(Y, Z, ME', database(evalModExp(ME', PDL, DB))) .
14037  ceq prepParImports(extending pd(X :: ME) . IL, IL', Y, Z, SMS, OMS, VEPS, PDL, DB)
14038    = prepParImports(IL, IL' extending pd(X :: ME') ., Y, Z, (SMS SMS'), (OMS OMS'), VEPS, PDL, DB')
14039    if ME' := prepModExp(ME, VEPS)
14040    /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(Y, Z, ME', database(evalModExp(ME', PDL, DB))) .
14041  ceq prepParImports(protecting pd(X :: ME) . IL, IL', Y, Z, SMS, OMS, VEPS, PDL, DB)
14042    = prepParImports(IL, IL' protecting pd(X :: ME') ., Y, Z, (SMS SMS'), (OMS OMS'), VEPS, PDL, DB')
14043    if ME' := prepModExp(ME, VEPS)
14044    /\ < SMS' ; OMS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(Y, Z, ME', database(evalModExp(ME', PDL, DB))) .
14045  eq prepParImports(nil, IL, X, Y, SMS, OMS, VEPS, PDL, DB)
14046    = < SMS ; OMS ; DB ; mtViewExp ; mtViewExp ; none ; false ; IL > .
14047
14048  op sortMapsPar : Qid SortSet Set{Tuple{ViewExp,ViewExp}} -> SortMappingSet .
14049  op classMapsPar : Qid SortSet Set{Tuple{ViewExp,ViewExp}} -> SortMappingSet .
14050
14051  op qualify : Qid Sort -> Sort .
14052  op qualify : Qid Sort Set{Tuple{ViewExp,ViewExp}} -> Sort .
14053  op qualify : Qid Sort ParameterList ParameterList Set{Tuple{ViewExp,ViewExp}} -> Sort .
14054
14055  eq qualify(X, S) = qualify(X, getName(S), getPars(S), empty, none) .
14056
14057  eq qualify(X, S, VEPS) = qualify(X, getName(S), getPars(S), empty, VEPS) .
14058
14059  eq qualify(X, S, (P, PL), PL', < P ; P' > VEPS)
14060    = qualify(X, S, PL, PL' P', < P ; P' > VEPS) .
14061  eq qualify(X, S, (P, PL), PL', VEPS)
14062    = qualify(X, S, PL, PL' P, VEPS)
14063    [owise] .
14064  eq qualify(X, S, empty, PL, VEPS)
14065    = qid(string(X) + "$" + string(makeSort(S, PL))) .
14066
14067  eq sortMapsPar(X, (S ; SS), VEPS)
14068    = (sort S to qualify(X, S, VEPS) . sortMapsPar(X, SS, VEPS)) .
14069  eq sortMapsPar(X, none, VEPS) = none .
14070
14071  eq classMapsPar(X, (S ; SS), VEPS)
14072    = (class S to qualify(X, S, VEPS) . classMapsPar(X, SS, VEPS)) .
14073  eq classMapsPar(X, none, VEPS) = none .
14074
14075*** When one of the labels of the interface of a module is being used in a
14076*** module expression to instantiate some formal parameter of a module, then,
14077*** in the evaluation of such module expression the qualification of all sorts
14078*** and class names coming from the theory part of the parameter theory have
14079*** to be changed according to such a label. In the evaluation of an
14080*** instantiation module expression this is done by generating the
14081*** corresponding renaming maps, which are then applied to the module being
14082*** instantiated. Given labels \texttt{L} and \texttt{L'}, for each sort or
14083*** class name \texttt{S} in the set given as argument, a map of the form
14084*** \verb~L$S to L'$S~ is generated.
14085
14086  op genMapsQualSorts : Qid Qid SortSet Set{Tuple{ViewExp,ViewExp}} -> SortMappingSet .
14087  op genMapsQualClasses : Qid Qid SortSet Set{Tuple{ViewExp,ViewExp}} -> SortMappingSet .
14088
14089  eq genMapsQualSorts(X, Y, (S ; SS), VEPS)
14090    = (sort qualify(X, S, VEPS) to qualify(Y, S, VEPS) .
14091       genMapsQualSorts(X, Y, SS, VEPS)) .
14092  eq genMapsQualSorts(X, Y, none, VEPS) = none .
14093
14094  eq genMapsQualClasses(X, Y, (S ; SS), VEPS)
14095    = (class qualify(X, S, VEPS) to qualify(Y, S, VEPS) .
14096       genMapsQualClasses(X, Y, SS, VEPS)) .
14097  eq genMapsQualClasses(X, Y, none, VEPS) = none .
14098
14099*** The function \texttt{prepare} takes the map set of a view and
14100*** prepares it to be used in an instantiation by transforming sort and class
14101*** names into their qualified form, if required (sorts and class names in a
14102*** view have to be qualified only if they were defined in a theory).
14103
14104*** The \texttt{prepare} function takes six arguments: The sets of maps
14105*** to be prepared, the label with which the sorts to be renamed have to be
14106*** qualified, the set of sorts in the theory part of the source of the view,
14107*** and the set of sorts and class names in the theory part of the target of
14108*** the view.
14109
14110*** Note that we assume that there is a sort map and a class map for each sort
14111*** and class in the theory part of the source of the view. Therefore, sorts
14112*** and class names appearing as sources of sort and class maps are
14113*** systematically qualified. The sorts or class names used in the targets of
14114*** the maps will be qualified only if they were declared in a theory. In maps
14115*** for operators in which the arity and coarity are specified, or for those
14116*** going to derived terms, the sorts appearing in the arity or coarity of an
14117*** operator and those used to qualify terms, or in sort tests in terms, must
14118*** also be qualified. However, in these cases the qualification cannot be
14119*** done on all sorts, but only on those defined in the theory parts. This is
14120*** the reason why the sets of sorts in the theory parts of the source and
14121*** target and the set of class names in the target of the view are given when
14122*** calling \texttt{prepare}.
14123
14124  op prepare : SortMappingSet Qid SortSet SortSet SortSet -> SortMappingSet .
14125  op prepare : OpMappingSet Qid SortSet SortSet SortSet -> OpMappingSet .
14126
14127  op prepare : TypeList Qid SortSet -> TypeList .
14128  op prepTerm : TermList Qid SortSet -> TermList .
14129
14130  eq prepare(sort S to S' . SMS, X, SS, SS', SS'')
14131    = (if S' in SS'
14132       then sort qualify(X, S) to qualify(X, S') .
14133       else sort qualify(X, S) to S' .
14134       fi
14135       prepare(SMS, X, SS, SS', SS'')) .
14136  eq prepare(class S to S' . SMS, X, SS, SS', SS'')
14137    = (if S' in SS''
14138       then (class qualify(X, S) to qualify(X, S') .)
14139       else (class qualify(X, S) to S' .)
14140       fi
14141       prepare(SMS, X, SS, SS', SS'')) .
14142  eq prepare((none).SortMappingSet, X, SS, SS', SS'') = none .
14143
14144  eq prepare(op F to F' . OMS, X, SS, SS', SS'')
14145    = (op F to F' .
14146       prepare(OMS, X, SS, SS', SS'')) .
14147  eq prepare(op F : TyL -> Ty to F' . OMS, X, SS, SS', SS'')
14148    = (op F : prepare(TyL, X, SS) -> prepare(Ty, X, SS) to F' .
14149       prepare(OMS, X, SS, SS', SS'')) .
14150  eq prepare(op T to term T' . OMS, X, SS, SS', SS'')
14151    = (op prepTerm(T, X, SS) to term prepTerm(T', X, SS') .
14152       prepare(OMS, X, SS, SS', SS'')) .
14153  eq prepare(msg F to F' . OMS, X, SS, SS', SS'')
14154    = (msg F to F' .
14155       prepare(OMS, X, SS, SS', SS'')) .
14156  eq prepare(msg F : TyL -> Ty to F' . OMS, X, SS, SS', SS'')
14157    = (msg F : prepare(TyL, X, SS) -> prepare(Ty, X, SS) to F' .
14158       prepare(OMS, X, SS, SS', SS'')) .
14159  eq prepare(attr A . S to A' . OMS, X, SS, SS', SS'')
14160    = (attr A . qualify(X, S) to A' .
14161       prepare(OMS, X, SS, SS', SS'')) .
14162  eq prepare((none).OpMappingSet, X, SS, SS', SS'') = none .
14163
14164  eq prepare((S TyL), X, (S ; SS)) = (qualify(X, S) prepare(TyL, X, (S ; SS))) .
14165  eq prepare((K TyL), X, SS) = prepare((getSort(K) TyL), X, SS) .
14166  eq prepare((S TyL), X, SS) = (S prepare(TyL, X, SS)) [owise] .
14167  eq prepare(nil, X, SS) = nil .
14168
14169  eq prepTerm(F[TL], X, SS) = F[prepTerm(TL, X, SS)] .
14170  eq prepTerm(V, X, SS)
14171    = if getType(V) in SS
14172      then qid(string(getName(V)) + ":" + string(qualify(X, getType(V))))
14173      else qid(string(getName(V)) + ":" + string(getType(V)))
14174      fi .
14175  eq prepTerm(Ct, X, SS)
14176    = if getType(Ct) in SS
14177      then qid(string(getName(Ct)) + "." + string(qualify(X, getType(Ct))))
14178      else qid(string(getName(Ct)) + "." + string(getType(Ct)))
14179      fi .
14180  ceq prepTerm((T, TL), X, SS)
14181    = (prepTerm(T, X, SS), prepTerm(TL, X, SS))
14182    if TL =/= empty .
14183  eq prepTerm(qidError(QIL), X, SS) = qidError(QIL) .
14184
14185*** For each parameterized sort
14186*** $\texttt{S[L}_1\texttt{,}\ldots\texttt{,L}_n\texttt{]}$ in the
14187*** body of a parameterized module with
14188*** $\texttt{L}_1\ldots\texttt{L}_n$ the labels of the parameters in
14189*** the interface of the module, a map of the form 9
14190*** $\texttt{sort\ S[L}_1\texttt{,}\ldots\texttt{,L}_n\texttt{]\
14191***      to\ S[V}_1\texttt{,}\ldots\texttt{,V}_n\texttt{]}$
14192*** is generated, where $\texttt{V}_i$ is the name of the view associated to
14193*** the label $\texttt{L}_i$ in the set of pairs given as argument.
14194
14195  op genMapsSorts : SortSet Set{Tuple{ViewExp,ViewExp}} -> SortMappingSet .
14196  op genMapsClasses : SortSet Set{Tuple{ViewExp,ViewExp}} -> SortMappingSet .
14197
14198  op prepSort : Sort Set{Tuple{ViewExp,ViewExp}} -> Sort .
14199  op prepSort : Sort ParameterList ParameterList Set{Tuple{ViewExp,ViewExp}} -> Sort .
14200
14201  eq genMapsSorts((S ; SS), VEPS)
14202    = (if prepSort(S, VEPS) == S
14203       then none
14204       else (sort S to prepSort(S, VEPS) .)
14205       fi)
14206      genMapsSorts(SS, VEPS) .
14207  eq genMapsSorts(none, VEPS) = none .
14208
14209  eq genMapsClasses((S ; SS), VEPS)
14210    = (if prepSort(S, VEPS) == S
14211       then none
14212       else (class S to prepSort(S, VEPS) .)
14213       fi)
14214      genMapsClasses(SS, VEPS) .
14215  eq genMapsClasses(none, VEPS) = none .
14216
14217  eq prepSort(S, VEPS) = prepSort(getName(S), empty, getPars(S), VEPS) .
14218  eq prepSort(Ty, VEPS) = Ty [owise] .
14219
14220  eq prepSort(S, PL, P, < P ; VE > VEPS)
14221    = prepSort(S, (PL, VE), empty, < P ; VE > VEPS) .
14222  eq prepSort(S, PL, (P, PL'), < P ; VE > VEPS)
14223    = prepSort(S, (PL, VE), PL', < P ; VE > VEPS) .
14224  eq prepSort(S, PL, P, VEPS)
14225    = prepSort(S, (PL, prepSort(P, VEPS)), empty, VEPS)
14226    [owise] .
14227  eq prepSort(S, PL, (P, PL'), VEPS)
14228    = prepSort(S, (PL, prepSort(P, VEPS)), PL', VEPS)
14229    [owise] .
14230  eq prepSort(S, PL, empty, VEPS)
14231    = if getPars(S) == empty
14232      then makeSort(S, PL)
14233      else makeSort(prepSort(S, VEPS), PL)
14234      fi .
14235
14236*** The function \texttt{prepImports} takes a list of importation
14237*** declarations and a set of pairs composed of a label and a view name, and
14238*** returns the list of importations resulting from changing in each of the
14239*** module expressions the occurrences of the labels of the interface of the
14240*** module being instantiated by the names of the views associated to them in
14241*** the list of pairs.
14242
14243  op prepImports : ImportList Set{Tuple{ViewExp,ViewExp}} -> ImportList .
14244
14245  op prepModExp :
14246       ModuleExpression Set{Tuple{ViewExp,ViewExp}} -> ModuleExpression .
14247  op prepModExp : ModuleExpression ViewExp ViewExp ViewExp
14248       Set{Tuple{ViewExp,ViewExp}} -> ModuleExpression .
14249  op prepParameterDecl :
14250       ParameterDecl Set{Tuple{ViewExp,ViewExp}} -> ParameterDecl .
14251  op prepViewExp : ViewExp Set{Tuple{ViewExp,ViewExp}} -> ViewExp .
14252  op prepViewExp : ParameterList Set{Tuple{ViewExp,ViewExp}} -> ParameterList .
14253
14254  eq prepImports(((including ME .) IL), VEPS)
14255    = (including prepModExp(ME, VEPS) .)
14256      prepImports(IL, VEPS) .
14257  eq prepImports(((including pd(PD) .) IL), VEPS)
14258    = (including pd(prepParameterDecl(PD, VEPS)) .)
14259      prepImports(IL, VEPS) .
14260  eq prepImports(((extending ME .) IL), VEPS)
14261    = (extending prepModExp(ME, VEPS) .)
14262      prepImports(IL, VEPS) .
14263  eq prepImports(((extending pd(PD) .) IL), VEPS)
14264    = (extending pd(prepParameterDecl(PD, VEPS)) .)
14265      prepImports(IL, VEPS) .
14266  eq prepImports(((protecting ME .) IL), VEPS)
14267    = (protecting prepModExp(ME, VEPS) .)
14268      prepImports(IL, VEPS) .
14269  eq prepImports(((protecting pd(PD) .) IL), VEPS)
14270    = (protecting pd(prepParameterDecl(PD, VEPS)) .)
14271      prepImports(IL, VEPS) .
14272  eq prepImports(nil, VEPS) = nil .
14273
14274  eq prepModExp(QI, VEPS) = QI .
14275  eq prepModExp(ME{PL}, VEPS) = prepModExp(ME, empty, empty, PL, VEPS) .
14276  eq prepModExp(ME + ME', VEPS)
14277    = prepModExp(ME, VEPS) + prepModExp(ME', VEPS) .
14278  eq prepModExp(ME, VEPS) = ME [owise] .
14279
14280  eq prepModExp(ME, PL, PL', (P, PL''), < P ; S > VEPS)
14281    = prepModExp(ME, (PL, S), PL', PL'', < P ; S > VEPS) .
14282  eq prepModExp(ME, PL, PL', (P, PL''), < P ; S{PL3} > VEPS)
14283    = prepModExp(ME, (PL, S{PL3}), PL', PL'', < P ; S{PL3} > VEPS) .
14284  ceq prepModExp(ME, PL, PL', (P, PL''), < P ; P' ;; VE > VEPS)
14285    = prepModExp(ME, (PL, P'), (PL', VE), PL'', < P ; P' ;; VE > VEPS)
14286    if VE =/= mtViewExp .
14287  eq prepModExp(ME, PL, PL', (P, PL''), VEPS)
14288    = prepModExp(ME, (PL, P), PL', PL'', VEPS)
14289    [owise] .
14290  eq prepModExp(ME, PL, PL', (QI{PL''}, PL3), VEPS)
14291    = prepModExp(ME, (PL, prepViewExp(QI{PL''}, VEPS)), PL', PL3, VEPS) .
14292  eq prepModExp(ME, PL, empty, empty, VEPS) = ME{PL} .
14293  eq prepModExp(ME, PL, PL', empty, VEPS) = ME{PL}{PL'} [owise] .
14294
14295  eq prepParameterDecl(X :: ME, < Y ; Z > VEPS)
14296    = if X == Y
14297      then (Z :: ME)
14298      else prepParameterDecl(X :: ME, VEPS)
14299      fi .
14300  eq prepParameterDecl(X :: ME, none) = X :: ME .
14301
14302  eq prepViewExp(VE, < VE ; VE' > VEPS) = VE' .
14303  eq prepViewExp(QI, VEPS) = QI [owise] .
14304  eq prepViewExp(X{PL}, VEPS) = X{prepViewExp(PL, VEPS)} [owise] .
14305  ceq prepViewExp((VE, PL), VEPS)
14306    = prepViewExp(VE, VEPS), prepViewExp(PL, VEPS)
14307    if VE =/= nil /\ PL =/= nil [owise] .
14308
14309*** The function \texttt{unitInst} calls the auxiliary function
14310*** \texttt{unitInstAux}, which proceeds recursively on each of the parameters
14311*** in the interface of the module being instantiated. For each view, a set of
14312*** maps to be applied to the module is generated, which are accumulated in
14313*** the third argument of the function.
14314
14315*** In the base case, when there are no more parameters and no more views, the
14316*** maps for the parameterized sorts are also generated, and all maps are
14317*** then applied.
14318
14319*** \texttt{unitInstAux} proceeds accumulating also the list of parameters
14320*** being modified, the list of importations, and a list of label-view
14321*** pairs (\texttt{QidTuple{ViewExp,ViewExp}}) associating each label in
14322*** the interface to the view used in the instantiation of the theory with
14323*** such label. This list of pairs is used to generate the set of maps of the
14324*** parameterized  sorts and to `prepare' the list of importations as
14325***  indicated above.
14326
14327  sort TreatParResult .
14328
14329  op <_;_;_;_;_;_> : SortMappingSet OpMappingSet ParameterDeclList ImportList
14330       Set{Tuple{ViewExp,ViewExp}} Database -> TreatParResult .
14331  op getSortMappings : TreatParResult -> SortMappingSet .
14332  op getOpMappings : TreatParResult -> OpMappingSet .
14333  op getPars : TreatParResult -> ParameterDeclList .
14334  op getImports : TreatParResult -> ImportList .
14335  op viewExpPairSet : TreatParResult -> Set{Tuple{ViewExp,ViewExp}} .
14336  op db : TreatParResult -> Database .
14337
14338  eq getSortMappings(< SMS ; OMS ; PDL ; IL ; VEPS ; DB >) = SMS .
14339  eq getOpMappings(< SMS ; OMS ; PDL ; IL ; VEPS ; DB >) = OMS .
14340  eq getPars(< SMS ; OMS ; PDL ; IL ; VEPS ; DB >) = PDL .
14341  eq getImports(< SMS ; OMS ; PDL ; IL ; VEPS ; DB >) = IL .
14342  eq viewExpPairSet(< SMS ; OMS ; PDL ; IL ; VEPS ; DB >) = VEPS .
14343  eq db(< SMS ; OMS ; PDL ; IL ; VEPS ; DB >) = DB .
14344
14345  op unitInstAux : Module Module OpDeclSet SortMappingSet OpMappingSet ParameterDeclList
14346        ParameterDeclList  ImportList  ImportList  ParameterList
14347        Set{Tuple{ViewExp,ViewExp}}  ParameterDeclList  Database
14348        ->  Database .
14349  op treatPar : ParameterDecl ViewExp  Set{Tuple{ViewExp,ViewExp}}
14350        ParameterDeclList  Database  ->  TreatParResult .
14351  op treatPar2 : ParameterDecl ViewExp  Set{Tuple{ViewExp,ViewExp}}
14352        ParameterDeclList  Database  ->  TreatParResult .
14353  op treatParAux : Qid ModuleExpression ParameterDeclList ViewExp Qid ViewExp
14354        ViewExp  ParameterDeclList  SortMappingSet OpMappingSet  ParameterDeclList
14355        ImportList  Set{Tuple{ViewExp,ViewExp}}  Database
14356        -> TreatParResult .
14357  op treatParAux2 : Qid ModuleExpression ParameterDeclList ViewExp Qid ViewExp
14358        ViewExp ParameterDeclList SortMappingSet OpMappingSet ParameterDeclList ImportList
14359        Set{Tuple{ViewExp,ViewExp}} Database -> TreatParResult .
14360
14361  eq unitInst(ME, PL, PDL, DB)
14362    = unitInstAux(setName(getTopModule(ME, DB), ME{PL}),
14363        signature(getFlatModule(ME, DB)), getVars(ME, DB), none, none,
14364        getPars(getTopModule(ME, DB)), nil,
14365        getImports(getTopModule(ME, DB)), nil, PL, none, PDL, DB) .
14366
14367  ceq unitInstAux(U, M, VDS, SMS, OMS, (X :: ME, PDL), PDL', IL, IL'', (QI, PL), VEPS, PDL'', DB)
14368    = unitInstAux(U, M, VDS, (SMS SMS'), (OMS OMS'), PDL, (PDL', PDL3), IL, (IL'' IL3), PL, (VEPS VEPS'), PDL'', DB')
14369    if < SMS' ; OMS' ; PDL3 ; IL3 ; VEPS' ; DB' > := treatPar(X :: ME, QI, VEPS, PDL'', DB) .
14370  ceq unitInstAux(U, M, VDS, SMS, OMS, (X :: ME, PDL), PDL', IL, IL'', (QI{PL}, PL'), VEPS, PDL'', DB)
14371    = unitInstAux(U, M, VDS, (SMS SMS'), (OMS OMS'), PDL, (PDL', PDL3), IL, (IL'' IL3), PL', (VEPS VEPS'), PDL'', DB')
14372    if < SMS' ; OMS' ; PDL3 ; IL3 ; VEPS' ; DB' > := treatPar(X :: ME, QI{PL}, VEPS, PDL'', DB) .
14373  ceq unitInstAux(U, M, VDS, SMS, OMS, nil, PDL, IL, IL', empty, VEPS, PDL', DB)
14374    = evalModule(
14375        setImports(setPars(applyMapsToModule(maps2rens(SMS'), maps2rens(OMS), U, M), PDL), (prepImports(IL, VEPS) IL')),
14376        applyMapsToOps(maps2rens(SMS'), maps2rens(OMS), VDS, M),
14377        DB)
14378    if SMS' := (SMS
14379                genMapsSorts((getSorts(U) ; getSortSetAux(getImports(U), DB)), VEPS)
14380                genMapsClasses((getClassNames(getClasses(U)) ; getClassSetAux(getImports(U), DB)), VEPS)) .
14381  eq unitInstAux(unitError(QIL), UK:[Module], SDV:[OpDeclSet], SMS, OMS, PDL, PDL', IL, IL', PL, VEPS, PDL'', DB)
14382    = warning(DB, QIL) .
14383  eq unitInstAux(noModule, unitError(QIL), VDS, SMS, OMS, PDL, PDL', IL, IL', VE, VEPS, PDL'', DB)
14384    = warning(DB, QIL) .
14385  eq unitInstAux(U, M, VDS, SMS, OMS, (X :: ME, PDL), PDL', IL, IL', empty, VEPS, PDL'', DB)
14386    = warning(DB, '\r 'Error: '\o 'Incorrect 'module header2QidList(getName(U)) '. '\n) .
14387  eq unitInstAux(U, M, VDS, SMS, OMS, nil, PDL, IL, IL', (QI, VE, PL), VEPS, PDL', DB)
14388    = warning(DB, '\r 'Error: '\o 'Incorrect 'module header2QidList(getName(U)) '. '\n) .
14389  eq unitInstAux(U, M, VDS, SMS, OMS, PDL, PDL', IL, IL', PL, VEPS, PDL'', DB)
14390    = DB
14391    [owise] .
14392
14393  eq treatParView(X :: ME, VE, ME', VEPS, PDL, DB)
14394    = if labelInModExp(X, ME')
14395      then treatPar(X :: ME, VE, VEPS, PDL, DB)
14396      else < none ;
14397             none ;
14398             getPars(treatPar(X :: ME, VE, VEPS, PDL, DB)) ;
14399             getImports(treatPar(X :: ME, VE, VEPS, PDL, DB)) ;
14400             viewExpPairSet(treatPar(X :: ME, VE, VEPS, PDL, DB)) ;
14401             db(treatPar(X :: ME, VE, VEPS, PDL, DB)) >
14402      fi .
14403
14404  op labelInModExp : Qid ModuleExpression -> Bool .
14405  op labelInViewExp : Qid ViewExp -> Bool .
14406
14407  eq labelInModExp(X, QI) = X == QI .
14408  eq labelInModExp(X, ME{VE}) = labelInViewExp(X, VE) .
14409  eq labelInModExp(X, TUPLE[N]) = false .
14410  eq labelInModExp(X, POWER[N]) = false .
14411
14412  eq labelInViewExp(X, QI) = X == QI .
14413  eq labelInViewExp(X, ((VE, VE')))
14414    = labelInViewExp(X, VE) or-else labelInViewExp(X, VE') .
14415  eq labelInViewExp(X, QI{VE}) = X == QI or-else labelInViewExp(X, VE) .
14416
14417  eq treatPar(X :: ME, VE, VEPS, PDL, DB)
14418    = if VE :: Qid and-then labelInParameterDeclList(VE, PDL)
14419      then < (genMapsQualSorts(X, VE, getThSorts(ME, DB), VEPS)
14420              genMapsQualClasses(X, VE, getThClasses(ME, DB), VEPS)) ;
14421             none ;
14422             VE :: ME ;
14423             nil ;
14424             < X ; VE > ;
14425             createCopy((VE :: ME), DB) >
14426      else if viewInDb(VE, DB)
14427           then if theory(getTopModule(getTo(getView(VE, DB)), DB))
14428                then < prepare(
14429                         getSortMappings(getView(VE, DB)),
14430                         X,
14431                         getThSorts(ME, DB),
14432                         getThSorts(getTo(getView(VE, DB)), DB),
14433                         getThClasses(getTo(getView(VE, DB)), DB)) ;
14434                       prepare(
14435                         getOpMappings(getView(VE, DB)),
14436                         X,
14437                         getThSorts(ME, DB),
14438                         getThSorts(getTo(getView(VE, DB)), DB),
14439                         getThClasses(getTo(getView(VE, DB)), DB)) ;
14440                       X :: getTo(getView(VE, DB)) ;
14441                       nil ;
14442                       < X ; (VE ;; X) > ;
14443                       createCopy((X :: getTo(getView(VE, DB))), DB) >
14444                else < prepare(
14445                         getSortMappings(getView(VE, DB)),
14446                         X,
14447                         getThSorts(ME, DB), none, none) ;
14448                       prepare(
14449                         getOpMappings(getView(VE, DB)),
14450                         X,
14451                         getThSorts(ME, DB), none, none) ;
14452                       getPars(getTopModule(getTo(getView(VE, DB)), DB)) ;
14453                       (protecting getTo(getView(VE, DB)) .) ;
14454                       < X ; VE > ;
14455                       DB >
14456                fi
14457           else < none ; none ; nil ; nil ; none ; warning(DB, '\r 'Error: '\o 'View VE 'not 'in 'database. '\n) >
14458           fi
14459      fi .
14460
14461  op viewInstAux : View SortMappingSet OpMappingSet ParameterDeclList ParameterDeclList
14462       ParameterList Set{Tuple{ViewExp,ViewExp}} ParameterDeclList Database
14463       -> Database .
14464  op treatParView : ParameterDecl ParameterList ModuleExpression
14465       Set{Tuple{ViewExp,ViewExp}} ParameterDeclList Database
14466       -> TreatParResult .
14467  op treatParAux : Qid ModuleExpression ParameterList Qid ViewExp ViewExp
14468       ParameterList SortMappingSet OpMappingSet ParameterList ImportList
14469       Set{Tuple{ViewExp,ViewExp}} Database -> TreatParResult .
14470
14471  eq viewInst(VE, PL, PDL, DB)
14472    = viewInstAux(setName(getView(VE, DB), VE{PL}),
14473        none, none, getPars(getView(VE, DB)), nil, PL, none, PDL, DB) .
14474
14475  ceq viewInstAux(VI, SMS, OMS, (X :: ME, PDL), PDL', (QI, PL), VEPS, PDL'', DB)
14476    = viewInstAux(VI, (SMS SMS'), (OMS OMS'), PDL, (PDL', PDL3), PL, (VEPS VEPS'), PDL'', DB')
14477    if < SMS' ; OMS' ; PDL3 ; IL ; VEPS' ; DB' > := treatParView(X :: ME, QI, getFrom(VI), VEPS, PDL'', DB) .
14478  ceq viewInstAux(VI, SMS, OMS, (X :: ME, PDL), PDL', (QI{PL}, PL'), VEPS, PDL'', DB)
14479    = viewInstAux(VI, SMS SMS', OMS OMS', PDL, (PDL', PDL3), PL', (VEPS VEPS'), PDL'', DB')
14480    if < SMS' ; OMS' ; PDL3 ; IL ; VEPS' ; DB' > := treatParView(X :: ME, QI{PL}, getFrom(VI), VEPS, PDL'', DB) .
14481  ceq viewInstAux(VI, SMS, OMS, nil, PDL, empty, VEPS, PDL', DB)
14482    = insertView(
14483        setPars(
14484          setFrom(
14485            setTo(
14486              setSortMappings(
14487                setOpMappings(VI,
14488                  applyMapsToMaps(
14489                    maps2rens(genMapsSorts(getSortSet(getFrom(VI), DB''), VEPS)
14490                              genMapsClasses(getClassSet(getFrom(VI), DB''), VEPS)),
14491                    maps2rens(SMS
14492                              genMapsSorts(getSortSet(getTo(VI), DB''), VEPS)
14493                              genMapsClasses(getClassSet(getTo(VI), DB''), VEPS)),
14494                    getOpMappings(VI))),
14495                applyMapsToMaps(
14496                  maps2rens(genMapsSorts(getSortSet(getFrom(VI), DB''), VEPS)
14497                            genMapsClasses(getClassSet(getFrom(VI), DB''), VEPS)),
14498                  maps2rens(SMS
14499                            genMapsSorts(getSortSet(getTo(VI), DB''), VEPS)
14500                            genMapsClasses(getClassSet(getTo(VI), DB''), VEPS)),
14501                  getSortMappings(VI))),
14502              prepModExp(getTo(VI), VEPS)),
14503            prepModExp(getFrom(VI), VEPS)),
14504          PDL),
14505        DB'')
14506    if < DB'  ; ME'  > := evalModExp(prepModExp(getFrom(VI), VEPS), PDL', DB)
14507    /\ < DB'' ; ME'' > := evalModExp(prepModExp(getTo(VI), VEPS), PDL', DB') .
14508  eq viewInstAux(viewError(QIL), SMS, OMS, PDL0:[ParameterDeclList], PDL, PL, VEPS, PDL', DB)
14509    = warning(DB, QIL) .
14510  eq viewInstAux(VI, SMS, OMS, (X :: ME, PDL), PDL', empty, VEPS, PDL'', DB)
14511    = warning(DB, ('\r 'Error: '\o 'Incorrect 'view getName(VI) '. '\n)) .
14512  eq viewInstAux(VI, SMS, OMS, nil, PDL, (QI, PL), VEPS, PDL', DB)
14513    = warning(DB, ('\r 'Error: '\o 'Incorrect 'view getName(VI) '. '\n)) .
14514  eq viewInstAux(VI, SMS, OMS, (X :: ME, PDL), PDL', (QI{PL}, PL'), VEPS, PDL'', DB)
14515    = warning(DB, ('\r 'Error: '\o 'Wrong 'instantiation getName(VI) '. '\n)) .
14516
14517  op applyMapsToMaps : RenamingSet RenamingSet SortMappingSet -> SortMappingSet .
14518  op applyMapsToMaps : RenamingSet RenamingSet OpMappingSet -> OpMappingSet .
14519  op applyMapsToTerm : RenamingSet TermList -> TermList .
14520
14521  eq applyMapsToMaps(SRS, SRS', sort S to S' . SMS)
14522    = (sort applyMapsToType(SRS, S) to applyMapsToType(SRS', S') .
14523       applyMapsToMaps(SRS, SRS', SMS)) .
14524  eq applyMapsToMaps(SRS, SRS', class S to S' . SMS)
14525    = (class applyMapsToType(SRS, S) to applyMapsToType(SRS',S') .
14526       applyMapsToMaps(SRS, SRS', SMS)) .
14527  eq applyMapsToMaps(SRS, SRS', SMS) = SMS [owise] .
14528
14529  eq applyMapsToMaps(SRS, SRS', op_to`term_.(T, T') OMS)
14530    = (op_to`term_.(applyMapsToTerm(SRS, T), applyMapsToTerm(SRS', T'))
14531       applyMapsToMaps(SRS, SRS', OMS)) .
14532  eq applyMapsToMaps(SRS, SRS', op F : TyL -> Ty to F' . OMS)
14533    = (op F : applyMapsToTypeList(SRS, TyL) -> applyMapsToType(SRS, Ty) to F' .
14534       applyMapsToMaps(SRS, SRS', OMS)) .
14535  eq applyMapsToMaps(SRS, SRS', msg F : TyL -> S to F' . OMS)
14536    = (msg F : applyMapsToTypeList(SRS, TyL) -> applyMapsToType(SRS, S) to F' .
14537       applyMapsToMaps(SRS, SRS', OMS)) .
14538  eq applyMapsToMaps(SRS, SRS', attr A . S to A' . OMS)
14539    = (attr A . applyMapsToType(SRS, S) to A' .
14540       applyMapsToMaps(SRS, SRS', OMS)) .
14541  eq applyMapsToMaps(SRS, SRS', OMS) = OMS [owise] .
14542
14543  eq applyMapsToTerm(SRS, Ct)
14544    = qid(string(getName(Ct)) + "." + string(applyMapsToType(SRS, getType(Ct)))) .
14545  eq applyMapsToTerm(SRS, V)
14546    = qid(string(getName(V)) + "." + string(applyMapsToType(SRS, getType(V)))) .
14547  eq applyMapsToTerm(SRS, qidError(QIL)) = qidError(QIL) .
14548  ceq applyMapsToTerm(SRS, F[TL])
14549    = F[applyMapsToTerm(SRS, TL)]
14550    if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) .
14551  eq applyMapsToTerm(SRS, '<_:_|_>[O, Ct, T])
14552    = '<_:_|_>[applyMapsToTerm(SRS, O),
14553               qid(string(applyMapsToClassName(SRS, getName(Ct)))
14554                   + "." + string(applyMapsToClassName(SRS, getType(Ct)))),
14555               applyMapsToTerm(SRS, T)] .
14556  ceq applyMapsToTerm(SRS, '<_:_|_>[O, C, T])
14557    = '<_:_|_>[applyMapsToTerm(SRS, O),
14558               applyMapsToClassName(SRS, C),
14559               applyMapsToTerm(SRS, T)]
14560    if not C :: Constant .
14561  eq applyMapsToTerm(SRS, '<_:_|`>[O, Ct])
14562    = '<_:_|_>[applyMapsToTerm(SRS, O),
14563               qid(string(applyMapsToClassName(SRS, getName(Ct)))
14564                   + "." + string(applyMapsToClassName(SRS, getType(Ct)))),
14565               'none.AttributeSet] .
14566  ceq applyMapsToTerm(SRS, '<_:_|`>[O, C])
14567    = '<_:_|_>[applyMapsToTerm(SRS, O),
14568               applyMapsToClassName(SRS, C),
14569               'none.AttributeSet]
14570    if not C :: Constant .
14571
14572  ceq applyMapsToTerm(SRS, (T, TL))
14573    = (applyMapsToTerm(SRS, T), applyMapsToTerm(SRS, TL))
14574    if TL =/= empty .
14575
14576*** As pointed out in Section~\ref{module-names}, for each new module
14577*** expression constructor being introduced, we need to add equations for the
14578*** operator \texttt{header2Qid}. Since the function to transform view
14579*** expressions into lists of quoted identifiers was already defined in
14580*** Section~\ref{VIEW-EXPR}, we just need to add the following equation.
14581
14582  eq header2Qid((ME { PL }))
14583    = qidList2Qid(header2Qid(ME) '`{ parameterList2Qid(PL) '`}) .
14584  ceq header2QidList((ME { PL }))
14585    = (if QI == '\s then QIL else QIL QI fi
14586       '`{ parameterList2QidList(PL) '`} '\s)
14587    if QIL QI := header2QidList(ME) .
14588
14589*** Given a module expression of the form \verb~ME{VE}~ such that
14590*** \texttt{ME} is in the database, we need to add \verb~ME{VE}~ to the set
14591*** of names of the modules depending on \texttt{ME} and on \texttt{VE}.
14592*** Since \texttt{VE} may be a composed view expression, we have to add the
14593*** name of the module  to each of the views in it. In this way, if \texttt{ME}
14594*** or any of the  views in \texttt{VE} is redefined or removed from the
14595*** database,  \verb~ME{VE}~ will be removed as well.
14596
14597  eq setUpModExpDeps(ME{PL},
14598      db(< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS',
14599          VIS, VES', MNS'', MNS3, MNS4, QIL))
14600    = viewExpDeps(ME{PL}, PL,
14601        db(< ME ; DT ; U ; U' ; M ; VDS ; (MNS . ME{PL}) ; VES > MIS,
14602           MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
14603  eq setUpModExpDeps(ME{PL},
14604      db(< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS',
14605         VIS, VES', MNS'', MNS3, MNS4, QIL))
14606    = viewExpDeps(ME{PL}, PL,
14607        db(< ME ; DM ; U ; U' ; M ; VDS ; (MNS . ME{PL}) ; VES > MIS,
14608           MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
14609  eq setUpModExpDeps('META-LEVEL{PL}, DB)
14610    = setUpModExpDeps('META-LEVEL{PL}, PL, DB) .
14611  eq setUpModExpDeps('META-LEVEL{QI},
14612       db(< QI ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS',
14613          VIS, VES', MNS'', MNS3, MNS4, QIL))
14614    = db(< QI ; DT ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{QI} ; VES >
14615          MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
14616  eq setUpModExpDeps('META-LEVEL{QI},
14617       db(< QI ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS',
14618          VIS, VES', MNS'', MNS3, MNS4, QIL))
14619    = db(< QI ; DM ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{QI} ; VES >
14620          MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
14621  ceq setUpModExpDeps(ME{PL}, DB)
14622    = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n))
14623    if (ME =/= 'META-LEVEL) /\ (not unitInDb(ME, DB)) .
14624
14625  eq setUpModExpDeps('META-LEVEL{PL}, (QI, PL'),
14626       db(< QI ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS',
14627          VIS, VES', MNS'', MNS3, MNS4, QIL))
14628    = setUpModExpDeps('META-LEVEL{PL}, PL',
14629        db(< QI ; DT ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{PL} ; VES >
14630           MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
14631  eq setUpModExpDeps('META-LEVEL{PL}, (QI, PL'),
14632       db(< QI ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS',
14633          VIS, VES', MNS'', MNS3, MNS4, QIL))
14634    = setUpModExpDeps('META-LEVEL{PL}, PL',
14635        db(< QI ; DM ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{PL} ; VES >
14636           MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) .
14637  eq setUpModExpDeps('META-LEVEL{PL}, nil, DB) = DB .
14638
14639  op viewExpDeps : Header ViewExp Database -> Database .
14640
14641----  eq viewExpDeps(ME, VE,
14642----        db(MIS, MNS,
14643----           < VE ; DT ; VI ; MNS' ; VES > VIS, VES',
14644----           MNS'', MNS3, MNS4, QIL))
14645----    = db(MIS, MNS, < VE ; DT ; VI ; MNS' . ME ; VES > VIS, VES',
14646----         MNS'', MNS3, MNS4, QIL) .
14647  eq viewExpDeps(ME, (VE, PL),
14648        db(MIS, MNS,
14649           < VE ; DT ; VI ; MNS' ; VES > VIS, VES',
14650           MNS'', MNS3, MNS4, QIL))
14651    = viewExpDeps(ME, PL,
14652        db(MIS, MNS,
14653           < VE ; DT ; VI ; MNS' . ME ; VES > VIS, VES',
14654           MNS'', MNS3, MNS4, QIL)) .
14655----  eq viewExpDeps(ME, VE, DB) = DB [owise] .
14656  eq viewExpDeps(ME, (VE, PL), DB) = viewExpDeps(ME, PL, DB) [owise] .
14657  eq viewExpDeps(ME, empty, DB) = DB .
14658
14659endfm
14660
14661*******************************************************************************
14662
14663***
14664*** 6.10 Renaming of Modules
14665***
14666
14667*** In addition to the declaration of the constructor for renaming module
14668*** expressions, the following module \texttt{RENAMING-EXPR-EVALUATION}
14669*** introduces equations to treat this new case in the definition of functions
14670*** \texttt{evalModExp}, \texttt{header2QidList}, \texttt{prepHeader}, and
14671*** \texttt{setUpModuleDeps}.
14672
14673*** A renaming expression is evaluated by applying the renaming maps, not only
14674*** to the top unit, but also to the part of the structure \emph{affected} by
14675*** the maps. The renaming process propagates downwards in the unit hierarchy
14676*** while the units in the structure are affected by the renamings. We say that
14677*** a unit is affected by a set of maps (checked by the \texttt{modAffd}
14678*** function) when any of the maps is applicable to any of the declarations in
14679*** the unit, or in any of its subunits. The application of a set of maps to a
14680*** single unit is accomplished by the \texttt{applyMapsToModule} function,
14681*** discussed in Section~\ref{applyMapsToModule}.
14682
14683fmod RENAMING-EXPR-EVALUATION is
14684  pr DATABASE .
14685  pr RENAMING-SET-APPL-ON-UNIT .
14686  pr EVALUATION .
14687  inc MOD-EXPR .
14688  pr MOD-EXPR-EVAL .
14689  pr INST-EXPR-EVALUATION .
14690  pr FMAP .
14691
14692  vars ME ME' : ModuleExpression .
14693  var  MNS MNS' MNS'' MNS3 MNS4 : Set{ModuleName} .
14694  vars MIS MIS' : Set{ModuleInfo} .
14695  var  VIS : Set{ViewInfo} .
14696  vars M M' : Module .
14697  vars PU U U' DM : Module .
14698  vars DB DB' : Database .
14699  var  QIL : QidList .
14700  vars VES VES' : Set{ViewExp} .
14701  var  PL : ParameterList .
14702  var  PDL : ParameterDeclList .
14703  vars PDS PDS' : Set{ParameterDecl} .
14704  var  I : Import .
14705  vars IL IL' : ImportList .
14706  var  R : Renaming .
14707  vars RS RS' RS'' RS3 : RenamingSet .
14708  var  VEPS : Set{Tuple{ViewExp,ViewExp}} .
14709  vars X QI QI' QI'' F F' F'' L L' L'' A A' A'' : Qid .
14710  vars S S' S'' C C' C'' : Sort .
14711  var  K : Kind .
14712  vars SS : SortSet .
14713  vars TyL TyL' : TypeList .
14714  vars Ty Ty' : Type .
14715  vars T T' T'' T3 : Term .
14716  var  DT : Default{Term} .
14717  var  TL : TermList .
14718  var  OPD : OpDeclSet .
14719  vars OPDS VDS : OpDeclSet .
14720  vars AtS AtS' : AttrSet .
14721  var  Rl : Rule .
14722  var  RlS : RuleSet .
14723  var  CD : ClassDecl .
14724  var  CDS : ClassDeclSet .
14725  var  ADS : AttrDeclSet .
14726  var  MD : MsgDecl .
14727  var  MDS : MsgDeclSet .
14728  var  N : Nat .
14729  var  NL : IntList .
14730  var  Hk : Hook .
14731  var  HkL : HookList .
14732  var  B : Bool .
14733  var  St : String .
14734
14735*** The function \texttt{crtCopyRen} creates a copy of the part of the
14736*** structure of the specified module which is affected by the renaming,
14737*** applying to each of the generated modules in the new structure the subset
14738*** of maps affecting each one of them. The equation extending the
14739*** \texttt{evalModExp} function to the renaming module expression is then
14740*** reduced to a call to \texttt{crtCopyRen} with the appropriate
14741*** arguments.
14742
14743  eq labelInModExp(X, ME * (RS)) = labelInModExp(X, ME) .
14744
14745  op crtCopyRen : ModuleExpression RenamingSet Database -> Database .
14746
14747  ceq evalModExp(ME * (RS), PDL, DB)
14748    = if unitInDb(ME' * (RS''), DB')
14749      then < DB' ; ME' * (RS'') >
14750      else < crtCopyRen(ME', RS', DB') ; ME' * (RS'') >
14751      fi
14752    if < DB' ; ME' > := evalModExp(ME, PDL, DB)
14753       /\ RS' := fixMaps(RS, ME', DB')
14754       /\ RS'' := canMaps(RS', getFlatModule(ME', DB')) .
14755
14756  eq crtCopyRen(ME, none, DB) = DB .
14757  ceq crtCopyRen(ME, RS, DB)
14758    = if unitInDb(_*`(_`)(ME, RS'), DB)
14759      then DB
14760      else applyMapsRec(
14761             RS,
14762             getImports(getTopModule(ME, DB)),
14763             nil,
14764             setName(
14765               applyMapsToModuleAux(RS'', RS3,
14766                 getTopModule(ME, DB), getFlatModule(ME, DB)),
14767               _*`(_`)(ME, RS')),
14768             applyMapsToOps(RS'', RS3,
14769               getVars(ME, DB), getFlatModule(ME, DB)),
14770             DB)
14771      fi
14772    if RS' := canMaps(RS, getFlatModule(ME, DB))
14773       /\ < RS'' ; RS3 > := splitMaps(RS') .
14774
14775  op canMaps : RenamingSet Module -> RenamingSet .
14776  eq canMaps(op F : TyL -> Ty to F' [AtS], M)
14777    = op F : canKinds(TyL, M) -> canKinds(Ty, M) to F' [AtS] .
14778  eq canMaps((op F : TyL -> Ty to F' [AtS], RS), M)
14779    = (op F : canKinds(TyL, M) -> canKinds(Ty, M) to F' [AtS],
14780       canMaps(RS, M)) .
14781  eq canMaps(msg F : TyL -> Ty to F', M)
14782    = msg F : canKinds(TyL, M) -> canKinds(Ty, M) to F' .
14783  eq canMaps((msg F : TyL -> Ty to F', RS), M)
14784    = (msg F : canKinds(TyL, M) -> canKinds(Ty, M) to F',
14785       canMaps(RS, M)) .
14786  eq canMaps(R:Renaming, M) = R:Renaming [owise] .
14787  eq canMaps((R:Renaming, RS), M)
14788    = (R:Renaming, canMaps(RS, M))
14789    [owise] .
14790  eq canMaps(none, M) = none .
14791
14792  op canKinds : TypeList Module -> [TypeList] .
14793  ---- eq canKinds(K:Kind TyL, M)
14794  ----   = kind(maximalSorts(M, K:Kind)) canKinds(TyL, M) .
14795  eq canKinds(nil, M) = nil .
14796  eq canKinds(cc(S ; SS) TyL, M)
14797    = kind(maximalSorts(M, getKind(M, S))) canKinds(TyL, M) .
14798  ----eq canKinds(TyL, M) = nil [owise] .
14799
14800*** We proceed downwards while the set of maps affects the module, but we do so
14801*** restricting the set of maps to the subset affecting the module. Since
14802*** operator and message maps in which arity and coarity are specified must be
14803*** applied to the whole subsort-overloaded family of operators or messages, we
14804*** have to carry along the signature of the module at the top to make all the
14805*** calls to the engine. Note that we may have maps of operations or messages
14806*** with the domain given by sorts that are not in the submodules but which
14807*** have other sorts in the submodules in the same connected components.
14808
14809  op applyMapsRec : RenamingSet ImportList ImportList Module OpDeclSet Database -> Database .
14810
14811  eq applyMapsRec(RS, ((including ME .) IL), IL', U, VDS, DB)
14812   = applyMapsRec(
14813       RS, IL,
14814       including ME *( canMaps(fixMaps(RS, ME, DB),
14815                               getFlatModule(ME, DB)) ) . IL',
14816       U, VDS,
14817       crtCopyRen(ME, fixMaps(RS, ME, DB), DB)) .
14818  eq applyMapsRec(RS, ((extending ME .) IL), IL', U, VDS, DB)
14819   = applyMapsRec(
14820       RS, IL,
14821       extending ME *( canMaps(fixMaps(RS, ME, DB),
14822                               getFlatModule(ME, DB)) ) . IL',
14823       U, VDS,
14824       crtCopyRen(ME, fixMaps(RS, ME, DB), DB)) .
14825  eq applyMapsRec(RS, ((protecting ME .) IL), IL', U, VDS, DB)
14826   = applyMapsRec(
14827       RS, IL,
14828       protecting ME *( canMaps(fixMaps(RS, ME, DB),
14829                               getFlatModule(ME, DB)) ) . IL',
14830       U, VDS,
14831       crtCopyRen(ME, fixMaps(RS, ME, DB), DB)) .
14832  eq applyMapsRec(RS, (I IL), IL', U, VDS, DB)
14833    = applyMapsRec(RS, IL, (I IL'), U, VDS, DB)
14834    [owise] .
14835  eq applyMapsRec(RS, nil, IL, U, VDS, DB)
14836    = evalModule(setImports(U, IL), VDS, DB) .
14837  eq applyMapsRec(RS, IL, IL', unitError(QIL), VDS, DB)
14838    = warning(DB, QIL) .
14839
14840  op fixMaps : [RenamingSet] ModuleExpression Database -> RenamingSet .
14841  op fixMaps2 : [RenamingSet] Module ClassDeclSet MsgDeclSet -> RenamingSet .
14842
14843  ceq fixMaps(RS, ME, DB)
14844    = fixMaps2(RS, getFlatModule(ME, DB), CDS, MDS)
14845    if < CDS ; MDS > := getAllClassesAndMsgs(ME, DB) .
14846
14847  eq fixMaps2(op F to F' [AtS], M, CDS, MDS)
14848    = opsAffd(getOps(M), op F to F' [AtS], M) .
14849  eq fixMaps2((op F to F' [AtS], RS), M, CDS, MDS)
14850    = (opsAffd(getOps(M), op F to F' [AtS], M),
14851       fixMaps2(RS, M, CDS, MDS)) .
14852  eq fixMaps2(op F : TyL -> Ty to F' [AtS], M, CDS, MDS)
14853    = opsAffd(getOps(M), op F : TyL -> Ty to F' [AtS], M) .
14854  eq fixMaps2((op F : TyL -> Ty to F' [AtS], RS), M, CDS, MDS)
14855    = (opsAffd(getOps(M), op F : TyL -> Ty to F' [AtS], M),
14856       fixMaps2(RS, M, CDS, MDS)) .
14857  eq fixMaps2(msg F to F', M, CDS, MDS)
14858    = msgsAffd(MDS, msg F to F', M) .
14859  eq fixMaps2((msg F to F', RS), M, CDS, MDS)
14860    = (msgsAffd(MDS, msg F to F', M), fixMaps2(RS, M, CDS, MDS)) .
14861  eq fixMaps2(msg F : TyL -> Ty to F', M, CDS, MDS)
14862    = msgsAffd(MDS, msg F : TyL -> Ty to F', M) .
14863  eq fixMaps2((msg F : TyL -> Ty to F', RS), M, CDS, MDS)
14864    = (msgsAffd(MDS, msg F : TyL -> Ty to F', M),
14865       fixMaps2(RS, M, CDS, MDS)) .
14866  eq fixMaps2(sort Ty to Ty', M, CDS, MDS)
14867    = if sortsAffd(getSorts(M), sort Ty to Ty')
14868      then (sort Ty to Ty')
14869      else none
14870      fi .
14871  eq fixMaps2(((sort Ty to Ty'), RS), M, CDS, MDS)
14872    = (if sortsAffd(getSorts(M), sort Ty to Ty')
14873       then (sort Ty to Ty')
14874       else none
14875       fi,
14876       fixMaps2(RS, M, CDS, MDS)) .
14877  eq fixMaps2(class Ty to Ty', M, CDS, MDS)
14878    = if classesAffd(CDS, class Ty to Ty')
14879      then (class Ty to Ty')
14880      else none
14881      fi .
14882  eq fixMaps2(((class Ty to Ty'), RS), M, CDS, MDS)
14883    = (if classesAffd(CDS, class Ty to Ty')
14884       then (class Ty to Ty')
14885       else none
14886       fi,
14887       fixMaps2(RS, M, CDS, MDS)) .
14888  eq fixMaps2(attr A . Ty to Ty', M, CDS, MDS)
14889    = if classesAffd(CDS, attr A . Ty to Ty')
14890      then (attr A . Ty to Ty')
14891      else none
14892      fi .
14893  eq fixMaps2(((class A . Ty to Ty'), RS), M, CDS, MDS)
14894    = (if classesAffd(CDS, attr A . Ty to Ty')
14895       then (attr A . Ty to Ty')
14896       else none
14897       fi,
14898       fixMaps2(RS, M, CDS, MDS)) .
14899  eq fixMaps2(R:Renaming, M, CDS, MDS) = R:Renaming [owise] .
14900  eq fixMaps2((R:Renaming, RS), M, CDS, MDS)
14901    = (R:Renaming, fixMaps2(RS, M, CDS, MDS))
14902    [owise] .
14903  eq fixMaps2(none, M, CDS, MDS) = none .
14904
14905  sort Tuple{ClassDeclSet, MsgDeclSet} .
14906  op <_;_> : ClassDeclSet MsgDeclSet -> Tuple{ClassDeclSet, MsgDeclSet} .
14907  op getClasses : Tuple{ClassDeclSet, MsgDeclSet} -> ClassDeclSet .
14908  op getMsgs : Tuple{ClassDeclSet, MsgDeclSet} -> MsgDeclSet .
14909  eq getClasses(< CDS ; MDS >) = CDS .
14910  eq getMsgs(< CDS ; MDS >) = MDS .
14911
14912  op getAllClassesAndMsgs :
14913       ModuleExpression Database -> Tuple{ClassDeclSet, MsgDeclSet} .
14914  op getAllClassesAndMsgs :
14915       ImportList Database -> Tuple{ClassDeclSet, MsgDeclSet} .
14916
14917  eq getAllClassesAndMsgs(ME, DB)
14918    = if getTopModule(ME, DB) :: OModule
14919         and-then not getTopModule(ME, DB) :: SModule
14920      then < getClasses(
14921               getAllClassesAndMsgs(getImports(getTopModule(ME, DB)), DB))
14922             getClasses(getTopModule(ME, DB))
14923             ;
14924             getMsgs(
14925               getAllClassesAndMsgs(getImports(getTopModule(ME, DB)), DB))
14926             getMsgs(getTopModule(ME, DB)) >
14927      else < none ; none >
14928      fi .
14929
14930  eq getAllClassesAndMsgs(I IL, DB)
14931    = < getClasses(getAllClassesAndMsgs(moduleName(I), DB))
14932        getClasses(getAllClassesAndMsgs(IL, DB))
14933        ;
14934        getMsgs(getAllClassesAndMsgs(moduleName(I), DB))
14935        getMsgs(getAllClassesAndMsgs(IL, DB)) > .
14936  eq getAllClassesAndMsgs((nil).ImportList, DB) = < none ; none > .
14937
14938----  sorts NeSet<TypeList> Set<TypeList> .
14939----  subsort TypeList < NeSet<TypeList> < Set<TypeList> .
14940----  op noneTLS : -> Set<TypeList> [ctor] .
14941----  op _!_ : Set<TypeList> Set<TypeList> -> Set<TypeList>
14942----     [ctor assoc comm id: noneTLS] .
14943----  op _!_ : NeSet<TypeList> NeSet<TypeList> -> NeSet<TypeList>
14944----     [ctor assoc comm id: noneTLS] .
14945
14946----  sort Set<Type> .
14947----  subsorts Type SortSet < Set<Type> .
14948----  op _o_ : Set<Type> Set<Type> -> Set<Type> [ctor assoc comm id: none] .
14949----
14950----  eq Ty o Ty = Ty .
14951
14952  sort TypeSetList .
14953  subsort TypeSet < TypeSetList .
14954  op nilTSL : -> TypeSetList [ctor] .
14955  op _l_ : TypeSetList TypeSetList -> TypeSetList
14956     [ctor assoc id: nilTSL] .
14957
14958  var  TS : TypeSet .
14959  var  TSL : TypeSetList .
14960  var  TLS : TypeListSet .
14961----  var  NTLS : NeTypeListSet .
14962
14963----  eq TyL ! TyL = TyL .
14964
14965  ----eq _!_(qidError(QIL), NTLS) = qidError(QIL) .
14966
14967  op fixKinds : TypeList Module -> TypeListSet .
14968  op fixKinds : TypeList TypeSetList Module -> TypeListSet .
14969  op fixKindsAux : Type Module -> TypeSet .
14970  op fixKindsAux2 : SortSet Module -> TypeSet .
14971  op unfold : TypeSetList -> TypeListSet .
14972  op add : TypeSet TypeListSet -> TypeListSet .
14973
14974  eq fixKinds(TyL, M) = fixKinds(TyL, nilTSL, M) .
14975
14976  eq fixKinds(Ty TyL, TSL, M)
14977    = if fixKindsAux(Ty, M) == nil
14978      then none
14979      else fixKinds(TyL, TSL l fixKindsAux(Ty, M), M)
14980      fi .
14981  eq fixKinds(nil, TSL, M) = unfold(TSL) .
14982
14983  eq fixKindsAux(S, M)
14984    = if S in getSorts(M)
14985      then cc(connectedSorts(M, S))
14986      else none
14987      fi .
14988  eq fixKindsAux(K, M) = fixKindsAux2(getSorts(K), M) .
14989  eq fixKindsAux(cc(SS), M) = fixKindsAux2(SS, M) .
14990
14991  eq fixKindsAux2((S ; SS), M)
14992    = (if S in getSorts(M)
14993       then cc(connectedSorts(M, S))
14994       else none
14995       fi
14996       ;
14997       fixKindsAux2(SS, M)) .
14998  eq fixKindsAux2(none, M) = none .
14999
15000  ceq unfold(TS l TSL) = add(TS, unfold(TSL)) if TS =/= none .
15001  eq unfold(nilTSL) = none .
15002
15003  ceq add(Ty, TyL ; TLS) = add(Ty, TyL) ; add(Ty, TLS) if TLS =/= none .
15004  eq add(Ty ; Ty' ; TS, TLS) = add(Ty, TLS) ; add(Ty' ; TS, TLS) .
15005  eq add(none, TLS) = nilTSL .
15006  eq add(Ty, none) = Ty .
15007  eq add(Ty, TyL) = Ty TyL .
15008
15009  op connectedSorts : Module Type -> SortSet .
15010  op connectedSorts : Module SortSet Type -> SortSet .
15011  eq connectedSorts(M, Ty) = connectedSorts(M, getSorts(M), Ty) .
15012  eq connectedSorts(M, S ; SS, Ty)
15013    = if sameKind(M, S, Ty)
15014      then S
15015      else none
15016      fi ; connectedSorts(M, SS, Ty) .
15017  eq connectedSorts(M, none, Ty) = none .
15018
15019  op sortsAffd : SortSet Renaming -> Bool .
15020  op opsAffd : OpDeclSet Renaming Module -> RenamingSet .
15021  op opsAffdAux : OpDeclSet Qid TypeListSet Qid AttrSet Module -> RenamingSet .
15022
15023  eq sortsAffd((S ; SS), (sort S to S')) = true .
15024  eq sortsAffd(SS, (sort S to S')) = false [owise] .
15025
15026  eq opsAffd(op F : TyL -> Ty [AtS] . OPDS, op F to F' [AtS'], M)
15027    = op F to F' [AtS'] .
15028  eq opsAffd(OPDS, op F : TyL -> Ty to F' [AtS], M)
15029    = opsAffdAux(OPDS, F, fixKinds(TyL Ty, M), F', AtS, M) .
15030  eq opsAffd(OPDS, RS:[RenamingSet], M) = none [owise] .
15031
15032  eq opsAffdAux(op F : TyL -> Ty [AtS] . OPDS,
15033       F, (TyL' Ty') ; TLS, F', AtS', M)
15034    = if sameKind(M, (TyL Ty), (TyL' Ty'))
15035      then (op F : TyL' -> Ty' to F' [AtS'],
15036            opsAffdAux(OPDS, F, TLS, F', AtS', M))
15037      else (opsAffdAux(OPDS, F, (TyL' Ty') ; TLS, F', AtS', M),
15038            opsAffdAux(op F : TyL -> Ty [AtS] . OPDS, F, TLS, F', AtS', M))
15039      fi .
15040  eq opsAffdAux(OPDS, F, TLS, F', AtS, M) = none [owise] .
15041
15042*** The predicate \texttt{modAffd} checks whether the module with the
15043*** name given as first argument in the database is affected by the set of maps
15044*** given as second argument. A module is affected by a map set if any of the
15045*** maps is applicable to the module or to any of its submodules.
15046
15047  op modAffd : Header RenamingSet Module Database -> Bool .
15048
15049  op modAffdAux : Module RenamingSet Module Database -> Bool .
15050  op rlsAffd : RuleSet RenamingSet -> Bool .
15051  op importsAffd : ImportList RenamingSet Module Database -> Bool .
15052  op classesAffd : ClassDeclSet RenamingSet -> Bool .
15053  op msgsAffd : MsgDeclSet RenamingSet Module -> RenamingSet .
15054  op msgsAffdAux : MsgDeclSet Qid TypeListSet Qid Module -> RenamingSet .
15055
15056  eq modAffd(ME, RS, M, DB)
15057    = modAffdAux(getTopModule(ME, DB), RS, M, DB) .
15058
15059  eq modAffdAux(U, RS, M, DB)
15060    = sortsAffd(getSorts(U), RS)
15061      or-else
15062      (opsAffd(getOps(U), RS, M) == none
15063       or-else
15064       ((not U :: FModule
15065         and-then
15066         (rlsAffd(getRls(U), RS)
15067          or-else
15068          (not U :: SModule
15069           and-then
15070           (classesAffd(getClasses(U), RS)
15071            or-else
15072            msgsAffd(getMsgs(U), RS, M) == none))))
15073        or-else
15074        importsAffd(getImports(U), RS, M, DB))) .
15075
15076  eq importsAffd(((including ME .) IL), RS, M, DB)
15077    = modAffd(ME, RS, M, DB)
15078      or-else importsAffd(IL, RS, M, DB) .
15079  eq importsAffd(((extending ME .) IL), RS, M, DB)
15080    = modAffd(ME, RS, M, DB)
15081      or-else importsAffd(IL, RS, M, DB) .
15082  eq importsAffd(((protecting ME .) IL), RS, M, DB)
15083    = modAffd(ME, RS, M, DB)
15084      or-else importsAffd(IL, RS, M, DB) .
15085  eq importsAffd(nil, RS, M, DB) = false .
15086
15087  eq rlsAffd(((rl T => T' [label(L) AtS] .) RlS), (label L' to L''))
15088    = (L == L') or-else rlsAffd(RlS, label L' to L'') .
15089  eq rlsAffd(((rl T => T' [label(L) AtS] .) RlS),
15090       ((label L' to L''), RS))
15091    = (L == L') or-else
15092      (rlsAffd((rl T => T' [label(L) AtS] .), RS) or-else
15093       rlsAffd(RlS, ((label L' to L''), RS))) .
15094  eq rlsAffd(((crl T => T' if T'' = T3 [label(L) AtS] .) RlS),
15095       (label L' to L''))
15096    = (L == L') or-else rlsAffd(RlS, (label L' to L'')) .
15097  eq rlsAffd(((crl T => T' if T'' = T3 [label(L) AtS] .) RlS),
15098       ((label L' to L''), RS))
15099    = (L == L')
15100      or-else
15101      (rlsAffd((crl T => T' if T'' = T3 [label(L) AtS] .), RS)
15102      or-else
15103      rlsAffd(RlS, ((label L' to L''), RS))) .
15104  eq rlsAffd(RlS, RS) = false [owise] .
15105
15106  eq classesAffd(((class C | ADS .) CDS), (class C' to C''))
15107    = (C == C')
15108      or-else
15109      classesAffd(CDS, (class C' to C'')) .
15110  eq classesAffd(((class C | ADS .) CDS), ((class C' to C''), RS))
15111    = (C == C')
15112      or-else
15113      (classesAffd((class C | ADS .), RS)
15114      or-else
15115      classesAffd(CDS, ((class C' to C''), RS))) .
15116  eq classesAffd(((class C | ((attr A : S), ADS) .) CDS),
15117       (attr A' . C' to A''))
15118    = if C == C'
15119      then (A == A')
15120           or-else
15121           classesAffd(((class C | ADS .) CDS), (attr A' . C' to A''))
15122      else classesAffd(CDS, (attr A' . C' to A''))
15123      fi .
15124  eq classesAffd(((class C | ((attr A : S), ADS) .) CDS),
15125       ((attr A' . C' to A''), RS))
15126    = if C == C'
15127      then (A == A')
15128           or-else
15129           (classesAffd(((class C | ADS .) CDS),
15130              ((attr A' . C' to A''), RS))
15131           or-else
15132           classesAffd(CDS, RS))
15133      else classesAffd((class C | ((attr A : S), ADS) .), RS)
15134           or-else
15135           classesAffd(CDS, ((attr A' . C' to A''), RS))
15136      fi .
15137  eq classesAffd(CDS, RS) = false [owise] .
15138
15139  eq msgsAffd(msg F : TyL -> Ty . MDS, msg F to F', M) = msg F to F' .
15140  eq msgsAffd(MDS, msg F : TyL -> Ty to F', M)
15141    = msgsAffdAux(MDS, F, fixKinds(TyL Ty, M), F', M) .
15142  eq msgsAffd(MDS, RS:[RenamingSet], M) = none [owise] .
15143
15144  eq msgsAffdAux(msg F : TyL -> Ty . MDS, F, (TyL' Ty') ; TLS, F', M)
15145    = if sameKind(M, (TyL Ty), (TyL' Ty'))
15146      then (msg F : TyL' -> Ty' to F',
15147            msgsAffdAux(MDS, F, TLS, F', M))
15148      else (msgsAffdAux(MDS, F, (TyL' Ty') ; TLS, F', M),
15149            msgsAffdAux(msg F : TyL -> Ty . MDS, F, TLS, F', M))
15150      fi .
15151  eq msgsAffdAux(MDS, F, TLS, F', M) = none [owise] .
15152
15153*** The function \texttt{mapsRestrict} returns the subset of the view
15154*** maps given as second argument that affect the given module.
15155
15156  op mapsRestrict : Module RenamingSet Module Database -> RenamingSet .
15157  op mapsRestrict : Header RenamingSet Module Database -> RenamingSet .
15158
15159  eq mapsRestrict(ME, RS, M, DB)
15160    = mapsRestrict(getTopModule(ME, DB), RS, M, DB) .
15161
15162  eq mapsRestrict(U, R, M, DB)
15163    = if modAffdAux(U, R, M, DB)
15164      then R
15165      else none
15166      fi .
15167  eq mapsRestrict(U, (R, RS), M, DB)
15168    = if modAffdAux(U, R, M, DB)
15169      then (R, mapsRestrict(U, RS, M, DB))
15170      else mapsRestrict(U, RS, M, DB)
15171      fi .
15172  eq mapsRestrict(U, none, M, DB) = none .
15173
15174*** The definition of the function \texttt{header2QidList} on the renaming
15175*** module expression has to take care of transforming into a quoted identifier
15176*** list the set of view maps given in the module expression.
15177
15178  op maps2QidList : RenamingSet -> QidList .
15179
15180  op attrSet2QidList : AttrSet -> QidList .
15181  op hookList2QidList : HookList -> QidList .
15182  op termList2QidList : TermList -> QidList .
15183  op intList2QidList : IntList -> QidList .
15184  op typeList2QidList : TypeList -> QidList .
15185
15186  eq maps2QidList(((op F to F' [AtS]), RS))
15187    = if AtS == none
15188      then ('op F 'to F' '`, '\s maps2QidList(RS))
15189      else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`] '`, '\s
15190            maps2QidList(RS))
15191      fi
15192    [owise] .
15193  eq maps2QidList((op F to F' [AtS]))
15194    = if AtS == none
15195      then ('op F 'to F')
15196      else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`])
15197      fi .
15198  eq maps2QidList(((op F : TyL -> Ty to F' [AtS]), RS))
15199    = if AtS == none
15200      then ('op F ': typeList2QidList(TyL) '-> Ty 'to F' '`,
15201            '\s maps2QidList(RS))
15202      else ('op F ': typeList2QidList(TyL) '-> Ty 'to F'
15203            '`[ attrSet2QidList(AtS) '`] '`, '\s maps2QidList(RS))
15204      fi
15205    [owise] .
15206  eq maps2QidList((op F : TyL -> Ty to F' [AtS]))
15207    = if AtS == none
15208      then ('op F ': typeList2QidList(TyL) '-> Ty 'to F')
15209      else ('op F ': typeList2QidList(TyL) '-> Ty 'to F'
15210            '`[ attrSet2QidList(AtS) '`])
15211      fi .
15212  eq maps2QidList(((sort S to S'), RS))
15213    = ('sort S 'to S' '`, '\s maps2QidList(RS))
15214    [owise] .
15215  eq maps2QidList((sort S to S')) = ('sort S 'to S') .
15216
15217  eq maps2QidList(((label L to L'), RS))
15218    = ('label L 'to L' '`, '\s maps2QidList(RS))
15219    [owise] .
15220  eq maps2QidList((label L to L')) = ('label L 'to L') .
15221
15222  eq maps2QidList(((msg F to F'), RS))
15223    = ('msg F 'to F' '`, '\s maps2QidList(RS))
15224    [owise] .
15225  eq maps2QidList((msg F to F')) = ('msg F 'to F') .
15226
15227  eq maps2QidList(((msg F : TyL  -> Ty to F'), RS))
15228    = ('msg F ': typeList2QidList(TyL) '-> Ty 'to F' '`, '\s
15229       maps2QidList(RS))
15230    [owise] .
15231  eq maps2QidList((msg F : TyL -> Ty to F'))
15232    = ('msg F ': typeList2QidList(TyL) '-> Ty 'to F') .
15233
15234  eq maps2QidList(((class S to S'), RS))
15235    = ('class S 'to S' '`, '\s maps2QidList(RS))
15236    [owise] .
15237  eq maps2QidList((class S to S')) = ('class S 'to S') .
15238
15239  eq maps2QidList(((attr QI . S to QI'), RS))
15240    = ('attr S '. QI 'to QI' '`, '\s maps2QidList(RS))
15241    [owise] .
15242  eq maps2QidList((attr QI . S to QI')) = ('attr S '. QI 'to QI') .
15243
15244  eq maps2QidList(none) = nil .
15245
15246  eq attrSet2QidList(none) = nil .
15247  eq attrSet2QidList((assoc AtS)) = ('assoc attrSet2QidList(AtS)) .
15248  eq attrSet2QidList((comm AtS))  = ('comm attrSet2QidList(AtS)) .
15249  eq attrSet2QidList((idem AtS))  = ('idem attrSet2QidList(AtS)) .
15250  eq attrSet2QidList((iter AtS))  = ('iter attrSet2QidList(AtS)) .
15251  eq attrSet2QidList((id(T) AtS))
15252    = ('id: termList2QidList(T) attrSet2QidList(AtS)) .
15253  eq attrSet2QidList((right-id(T) AtS))
15254    = ('right-id: termList2QidList(T) attrSet2QidList(AtS)) .
15255  eq attrSet2QidList((left-id(T) AtS))
15256    = ('left-id: termList2QidList(T) attrSet2QidList(AtS)) .
15257  eq attrSet2QidList((poly(NL) AtS))
15258    = ('poly '`( intList2QidList(NL) '`) attrSet2QidList(AtS)) .
15259  eq attrSet2QidList((strat(NL) AtS))
15260    = ('strat '`( intList2QidList(NL) '`) attrSet2QidList(AtS)) .
15261  eq attrSet2QidList((memo AtS))  = ('memo attrSet2QidList(AtS)) .
15262  eq attrSet2QidList((prec(N) AtS))
15263    = ('prec intList2QidList(N) attrSet2QidList(AtS)) .
15264  eq attrSet2QidList((gather(QIL) AtS))
15265    = ('gather QIL attrSet2QidList(AtS)) .
15266  eq attrSet2QidList((format(QIL) AtS))
15267    = ('format QIL attrSet2QidList(AtS)) .
15268  eq attrSet2QidList((ctor AtS))  = ('ctor attrSet2QidList(AtS)) .
15269  eq attrSet2QidList((frozen(NL) AtS))
15270    = ('frozen '`( intList2QidList(NL) '`) attrSet2QidList(AtS)) .
15271  eq attrSet2QidList((config AtS))  = ('config attrSet2QidList(AtS)) .
15272  eq attrSet2QidList((object AtS))  = ('object attrSet2QidList(AtS)) .
15273  eq attrSet2QidList((msg AtS))  = ('msg attrSet2QidList(AtS)) .
15274  eq attrSet2QidList((special(HkL) AtS))
15275    = ('special '`( hookList2QidList(HkL) '`) attrSet2QidList(AtS)) .
15276  eq attrSet2QidList((none).AttrSet) = nil .
15277  eq attrSet2QidList((metadata(St) AtS)) = (('metadata qid("\"" + St + "\"")) attrSet2QidList(AtS)) .
15278  eq attrSet2QidList((nonexec AtS))  = ('nonexec attrSet2QidList(AtS)) .
15279  eq attrSet2QidList((variant AtS))  = ('variant attrSet2QidList(AtS)) .
15280
15281  eq hookList2QidList((id-hook(QI, QIL) HkL))
15282    = ('id-hook QI '`, '`( QIL '`) hookList2QidList(HkL)) .
15283  eq hookList2QidList((op-hook(QI, QI', QIL, QI'') HkL))
15284    = ('op-hook QI '`( QI' ': QIL '-> QI'' '`) hookList2QidList(HkL)) .
15285  eq hookList2QidList((term-hook(QI, T) HkL))
15286    = ('term-hook '`( QI '`, termList2QidList(T) '`) hookList2QidList(HkL)) .
15287
15288  eq termList2QidList(QI) = QI .
15289  eq termList2QidList(F[TL]) = (F '`( termList2QidList(TL) '`)) .
15290  ceq termList2QidList((T, TL))
15291    = (termList2QidList(T) '`, termList2QidList(TL))
15292    if TL =/= empty .
15293
15294  eq intList2QidList((N NL)) = (qid(string(N, 10)) intList2QidList(NL)) .
15295  eq intList2QidList(nil) = nil .
15296
15297  eq typeList2QidList(Ty TyL) = type2qid(Ty) typeList2QidList(TyL) .
15298  eq typeList2QidList(nil) = nil .
15299
15300*** Let us now give the equations for \texttt{setUpModExpDeps} on the
15301*** renaming module expression.  Given a module expression of the form
15302*** \verb~ME *< RS >~ such that \texttt{ME} is in the database, we just need
15303*** to add \verb~ME *< RS >~ to the set of names of the modules depending on
15304*** \texttt{ME}. In this way, if \texttt{ME} is redefined or removed from the
15305*** database, \verb~ME *< RS >~ will be removed as well.
15306
15307  eq setUpModExpDeps(ME * (RS),
15308       db(< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS,
15309          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
15310    = db(< ME ; DT ; U ; U' ; M ; VDS ; MNS . ME * (RS) ; VES > MIS,
15311         MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
15312  eq setUpModExpDeps(ME * (RS),
15313       db(< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS,
15314          MNS', VIS, VES', MNS'', MNS3, MNS4, QIL))
15315    = db(< ME ; DM ; U ; U' ; M ; VDS ; MNS . ME * (RS) ; VES > MIS,
15316         MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) .
15317  ceq setUpModExpDeps(ME * (RS), DB)
15318    = warning(DB, '\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n)
15319    if not unitInDb(ME, DB) .
15320
15321*** The definition of the \texttt{prepHeader} function on a renaming module
15322*** expression must take into account the possibility of having parameterized
15323*** sorts or parameterized class names in the maps of a renaming module
15324*** expression.  The preparation of a renaming module expression must take
15325*** into account this fact and prepare accordingly all parameterized sorts and
15326*** classes appearing in it.
15327
15328  op prepare : RenamingSet Set{Tuple{ViewExp,ViewExp}} -> RenamingSet .
15329
15330  op prepare : TypeList Set{Tuple{ViewExp,ViewExp}} -> TypeList .
15331
15332  eq prepModExp(ME * (RS), VEPS)
15333    = _*`(_`)(prepModExp(ME, VEPS), prepare(RS, VEPS)) .
15334
15335*** For example, for sort maps the equation is as follows.
15336
15337  eq prepare((sort S to S'), VEPS)
15338    = (sort prepSort(S, VEPS) to prepSort(S', VEPS)) .
15339  eq prepare(((sort S to S'), RS), VEPS)
15340    = ((sort prepSort(S, VEPS) to prepSort(S', VEPS)),
15341       prepare(RS, VEPS)) .
15342
15343
15344  eq prepare((class S to S'), VEPS)
15345    = (class prepSort(S, VEPS) to prepSort(S', VEPS)) .
15346  eq prepare(((class S to S'), RS), VEPS)
15347    = ((class prepSort(S, VEPS) to prepSort(S', VEPS)),
15348       prepare(RS, VEPS)) .
15349  eq prepare((attr QI . S to QI'), VEPS)
15350    = (attr QI . prepSort(S, VEPS) to QI') .
15351  eq prepare(((attr QI . S to QI'), RS), VEPS)
15352    = ((attr QI . prepSort(S, VEPS) to QI'), prepare(RS, VEPS)) .
15353  eq prepare((op F to F' [AtS]), VEPS) = (op F to F' [AtS]) .
15354  eq prepare(((op F to F' [AtS]), RS), VEPS)
15355    = ((op F to F' [AtS]), prepare(RS, VEPS)) .
15356  eq prepare((op F : TyL -> Ty to F' [AtS]), VEPS)
15357    = (op F : prepare(TyL, VEPS) -> prepSort(Ty, VEPS) to F' [AtS]) .
15358  eq prepare(((op F : TyL -> Ty to F' [AtS]), RS), VEPS)
15359    = (op F : prepare(TyL, VEPS) -> prepSort(Ty, VEPS) to F' [AtS],
15360       prepare(RS, VEPS)) .
15361  eq prepare((label L to L'), VEPS) = (label L to L') .
15362  eq prepare(((label L to L'), RS), VEPS)
15363    = ((label L to L'), prepare(RS, VEPS)) .
15364  eq prepare((msg F to F'), VEPS) = (msg F to F') .
15365  eq prepare(((msg F to F'), RS), VEPS)
15366    = ((msg F to F'), prepare(RS, VEPS)) .
15367  eq prepare((msg F : TyL -> Ty to F'), VEPS)
15368    = (msg F : prepare(TyL, VEPS) -> prepSort(Ty, VEPS) to F') .
15369  eq prepare(((msg F : TyL -> Ty to F'), RS), VEPS)
15370    = ((msg F : prepare(TyL, VEPS) -> prepSort(Ty, VEPS) to F'),
15371       prepare(RS, VEPS)) .
15372  eq prepare((none).RenamingSet, VEPS) = none .
15373
15374  eq prepare((Ty TyL), VEPS) = (prepSort(Ty, VEPS) prepare(TyL, VEPS)) .
15375  eq prepare(nil, VEPS) = nil .
15376
15377  eq header2Qid(ME * (RS))
15378    = qid(string(header2Qid(ME))
15379          + " * (" + string(qidList2Qid(maps2QidList(RS))) + ")")
15380    [owise] .
15381
15382  ceq header2QidList(ME * (RS))
15383    = (if QI == '\s then QIL QI else QIL QI '\s fi
15384       '* '\s '`( maps2QidList(RS) '`))
15385    if QIL QI := header2QidList(ME)
15386    [owise] .
15387
15388endfm
15389
15390*******************************************************************************
15391
15392***
15393*** The Union Module Expression
15394***
15395
15396*** The syntax used for the union of module expressions is
15397
15398***   op _+_ : ModuleExpression ModuleExpression -> ModuleExpression
15399***       [assoc prec 42] .
15400
15401*** Its evaluation consists in generating a unit importing the two module
15402*** expressions given as arguments~\cite{Winkler91,OBJ92}.
15403
15404*** As we explained in Sections~\ref{instantiation} and~\ref{renaming} for the
15405*** cases of the instantiation and the renaming module expressions,
15406*** respectively, the declaration of any new kind of module expression must
15407*** come together with the definition of the functions \texttt{evalModExp},
15408*** \texttt{header2QidList}, and \texttt{setUpModExpDeps} on the new
15409*** module operator. As discussed in Sections~\ref{instantiation}
15410*** and~\ref{parsing-unit-declarations}, equations for the \texttt{prepHeader}
15411*** and \texttt{parseModExp} functions have to be given as well.
15412
15413fmod UNION-EXPR is
15414  inc MOD-EXPR .
15415  pr INST-EXPR-EVALUATION .
15416  pr RENAMING-EXPR-EVALUATION .
15417  pr EVALUATION .
15418
15419  vars QI X : Qid .
15420  var  PDL : ParameterDeclList .
15421  vars DB DB' DB'' : Database .
15422  vars T T' : Term .
15423  vars DT DT' : Default{Term} .
15424  var  IL : ImportList .
15425  var  VEPS : Set{Tuple{ViewExp,ViewExp}} .
15426  vars ME ME' ME'' ME3 : ModuleExpression .
15427  vars PU PU' U U' U'' U3 DM DM' : Module .
15428  vars M M' M'' M3 : Module .
15429  vars MNS MNS' MNS'' MNS3 MNS4 MNS5 : Set{ModuleName} .
15430  vars VES VES' VES'' : Set{ViewExp} .
15431  vars PDS PDS' PDS'' : Set{ParameterDecl} .
15432  vars MIS MIS' : Set{ModuleInfo} .
15433  var  VIS : Set{ViewInfo} .
15434  vars QIL QIL' : QidList .
15435  var  VDS VDS' : OpDeclSet .
15436  var  B : Bool .
15437  var  MAPS : RenamingSet .
15438
15439*** As mentioned above, the evaluation of a union module expression consists
15440*** in the creation of a new unit, with such a module expression as name,
15441*** which imports the two module expressions being united. Note, however,
15442*** that the unit being created has to be of the right type. The new unit
15443*** will be generated having one type or another, depending on the types of
15444*** the arguments of the union module expression.
15445
15446*** The function \texttt{rightEmptyModule} generates an empty unit of the
15447*** lowest of the sorts of its two arguments. In case of having a nonstructured
15448*** module as argument, the corresponding structured one is considered. If one
15449*** of the two module expressions corresponds to a theory, then a theory is
15450*** generated, and the lowest sort is taken between the sort of such a theory
15451*** and the \texttt{Module} sort immediately above the sort of the other unit;
15452*** that is, sorts \texttt{FModule}, \texttt{SModule}, or \texttt{OModule} are
15453*** considered to do the comparison.
15454
15455----  ceq evalModExpAux(ME + ME', PDL, DB)
15456----    = if unitInDb(ME'' + ME3, DB'') or-else not (unitInDb(ME'', DB'') and-then unitInDb(ME3, DB''))
15457----      then < DB'' ; ME'' + ME3 >
15458----      else < evalModule(
15459----                    addImports(including ME'' . including ME3 .,
15460----                      setName(
15461----                        rightEmptyModule(
15462----                          getTopModule(ME'', DB''),
15463----                          getTopModule(ME3, DB'')),
15464----                        ME'' +  ME3)),
15465----                    none,
15466----                    DB'') ;
15467----                  ME'' +  ME3 >
15468----      fi
15469----    if < DB' ; ME3 > := evalModExpAux(ME', PDL, DB)
15470----    /\ < DB'' ; ME'' > := evalModExpAux(ME, PDL, DB') .
15471
15472  ceq evalModExp(ME + ME', PDL, DB)
15473    = if unitInDb(ME'', DB') or-else not summandsInDB(ME'', DB')
15474      then < DB' ; ME'' >
15475      else < evalModule(
15476               addImports(unfoldSummands(ME''),
15477                 setName(rightEmptyModule(ME'', DB'), ME'')),
15478               none,
15479               DB')
15480             ; ME'' >
15481      fi
15482    if < DB' ; ME'' > := evalModExp+(ME + ME', PDL, DB) .
15483
15484  op summandsInDB : ModuleExpression Database -> Bool .
15485  eq summandsInDB(ME + ME', DB)
15486    = summandsInDB(ME, DB) and-then summandsInDB(ME', DB) .
15487  eq summandsInDB(ME, DB) = unitInDb(ME, DB) [owise] .
15488
15489  op unfoldSummands : ModuleExpression -> ImportList .
15490  eq unfoldSummands(ME + ME') = unfoldSummands(ME) unfoldSummands(ME') .
15491  eq unfoldSummands(ME) = (including ME .) [owise] .
15492
15493  op rightEmptyModule : ModuleExpression Database -> Module .
15494  eq rightEmptyModule(ME, DB) = emptyModule(kindOfModule(ME, DB)) .
15495
15496  op evalModExp+ : ModuleExpression ParameterDeclList Database -> Tuple{Database, ModuleExpression} .
15497  eq evalModExp+(ME + ME', PDL, DB)
15498    = < database(evalModExp+(ME', PDL, database(evalModExp+(ME, PDL, DB))))
15499      ; modExp(evalModExp+(ME', PDL, database(evalModExp+(ME, PDL, DB))))
15500        + modExp(evalModExp+(ME, PDL, DB)) > .
15501  eq evalModExp+(ME, PDL, DB) = evalModExp(ME, PDL, DB) [owise] .
15502
15503  op kindOfModule : ModuleExpression Database -> Qid .
15504  eq kindOfModule(ME + ME', DB) = greaterLowest(kindOfModule(ME, DB), kindOfModule(ME', DB)) .
15505  eq kindOfModule(ME, DB) = kindOfModule(getTopModule(ME, DB)) [owise] .
15506
15507  op kindOfModule : Module -> Qid .
15508  eq kindOfModule(U:OModule)
15509    = if U:OModule :: FModule
15510      then 'fmod
15511      else if U:OModule :: SModule
15512           then 'mod
15513           else 'omod
15514           fi
15515      fi .
15516  eq kindOfModule(U:OTheory)
15517    = if U:OTheory :: FTheory
15518      then 'fmod
15519      else if U:OTheory :: STheory
15520           then 'mod
15521           else 'omod
15522           fi
15523      fi .
15524  eq kindOfModule(unitError(QIL)) = qidError(QIL) .
15525
15526  op greaterLowest : Qid Qid ~> Qid [comm] .
15527  eq greaterLowest('fmod, 'fmod) = 'fmod .
15528  eq greaterLowest('fmod, 'fth) = 'fth .
15529  eq greaterLowest('fth, 'fth) = 'fth .
15530  eq greaterLowest('mod, 'fmod) = 'mod .
15531  eq greaterLowest('mod, 'mod) = 'mod .
15532  eq greaterLowest('mod, 'fth) = 'th .
15533  eq greaterLowest('fmod, 'th) = 'th .
15534  eq greaterLowest('mod, 'th) = 'th .
15535  eq greaterLowest('th, 'th) = 'th .
15536  eq greaterLowest('omod, 'fmod) = 'omod .
15537  eq greaterLowest('omod, 'mod) = 'omod .
15538  eq greaterLowest('omod, 'omod) = 'omod .
15539  eq greaterLowest('omod, 'fth) = 'oth .
15540  eq greaterLowest('omod, 'th) = 'oth .
15541  eq greaterLowest('omod, 'oth) = 'oth .
15542  eq greaterLowest('fmod, 'oth) = 'oth .
15543  eq greaterLowest('mod, 'oth) = 'oth .
15544  eq greaterLowest('oth, 'th) = 'oth .
15545  eq greaterLowest('oth, 'fth) = 'oth .
15546  eq greaterLowest('oth, 'oth) = 'oth .
15547
15548  op emptyModule : Qid ~> Module .
15549  eq emptyModule('fmod) = emptyFModule .
15550  eq emptyModule('fth) = emptyFTheory .
15551  eq emptyModule('mod) = emptySModule .
15552  eq emptyModule('th) = emptySTheory .
15553  eq emptyModule('omod) = emptyOModule .
15554  eq emptyModule('oth) = emptyOTheory .
15555
15556----  op rightEmptyModule : Module Module -> Module [comm] .
15557----
15558----  eq rightEmptyModule(U1:FModule, U2:FModule) = emptyFModule .
15559----  eq rightEmptyModule(U1:FModule, U2:FTheory) = emptyFTheory .
15560----  eq rightEmptyModule(U1:FTheory, U2:FModule) = emptyFTheory .
15561----  eq rightEmptyModule(U1:FTheory, U2:FTheory) = emptyFTheory .
15562----  ceq rightEmptyModule(U1:SModule, U2:SModule) = emptySModule if not U1:SModule :: FModule or not U2:SModule :: FModule .
15563----  ceq rightEmptyModule(U1:STheory, U2:SModule) = emptySTheory if not U1:STheory :: FTheory or not U2:SModule :: FModule .
15564----  ceq rightEmptyModule(U1:SModule, U2:STheory) = emptySTheory if not U1:SModule :: FModule or not U2:STheory :: FTheory .
15565----  ceq rightEmptyModule(U1:STheory, U2:STheory) = emptySTheory if not U1:STheory :: FTheory or not U2:STheory :: FTheory .
15566----  ceq rightEmptyModule(U1:OModule, U2:OModule) = emptyOModule if not U1:OModule :: SModule or not U2:OModule :: SModule .
15567----  ceq rightEmptyModule(U1:OTheory, U2:OModule) = emptyOTheory if not U1:OTheory :: STheory or not U2:OModule :: SModule .
15568----  ceq rightEmptyModule(U1:OModule, U2:OTheory) = emptyOTheory if not U1:OModule :: SModule or not U2:OTheory :: STheory .
15569----  ceq rightEmptyModule(U1:OTheory, U2:OTheory) = emptyOTheory if not U1:OTheory :: STheory or not U2:OTheory :: STheory .
15570----  eq rightEmptyModule(unitError(QIL), U) = unitError(QIL) .
15571----  eq rightEmptyModule(U, unitError(QIL)) = unitError(QIL) .
15572----  eq rightEmptyModule(unitError(QIL), unitError(QIL')) = unitError(QIL QIL') .
15573
15574*** As pointed out in Section~\ref{module-names}, for each new module
15575*** expression operator being introduced, we need to add equations for the
15576*** \texttt{header2Qid} function. For the union module expression we only
15577*** need the following equation:
15578
15579  eq header2Qid(ME + ME')
15580    = qidList2Qid(header2QidList(ME) '+ header2QidList(ME')) .
15581  eq header2Qid(_*`(_`)(ME + ME', MAPS))
15582    = qid("(" + string(header2Qid(ME + ME')) + ")"
15583          + " * (" + string(qidList2Qid(maps2QidList(MAPS))) + ")") .
15584
15585  eq header2QidList(ME + ME')
15586    = (header2QidList(ME) '+ header2QidList(ME')) .
15587  ceq header2QidList(_*`(_`)(ME + ME', MAPS))
15588    = (if QI == '\s then '`( QIL '`) QI else '`( QIL QI '`) '\s fi
15589       '* '\s '`( maps2QidList(MAPS) '`))
15590    if QIL QI := header2QidList(ME + ME') .
15591
15592*** Given a module
15593*** expression of the form \verb~ME + ME'~ such that \texttt{ME} and
15594*** \texttt{ME'} are in the database, we need to add \verb~ME + ME'~ to
15595*** the set of names of the modules depending on \texttt{ME} and \texttt{ME'}.
15596*** In this way, if \texttt{ME} or \texttt{ME'} are redefined or removed from
15597*** the database, \verb~ME + ME'~ will be removed as well.
15598
15599  op setUpModExpDepsAux : ModuleExpression ModuleExpression Database -> Database .
15600  eq setUpModExpDeps(ME + ME', DB) = setUpModExpDepsAux(ME + ME', ME + ME', DB) .
15601
15602  eq setUpModExpDepsAux(ME, ME' + ME'', DB)
15603   = setUpModExpDepsAux(ME, ME', setUpModExpDepsAux(ME, ME'', DB)) .
15604  eq setUpModExpDepsAux(ME, ME',
15605      db(< ME' ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL))
15606   = db(< ME' ; DT ; U ; U' ; M ; VDS ; MNS . ME ; VES > MIS, MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL)
15607   [owise] .
15608  eq setUpModExpDepsAux(ME, ME',
15609      db(< ME' ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL))
15610   = db(< ME' ; DM ; U ; U' ; M ; VDS ; MNS . ME ; VES > MIS, MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL)
15611   [owise] .
15612
15613---(  eq setUpModExpDeps((ME + ME'),
15614      db((< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES >
15615          < ME' ; DT' ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS),
15616         MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL))
15617   = db((< ME ; DT ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES >
15618         < ME' ; DT' ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' >
15619         MIS),
15620        MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) .
15621  eq setUpModExpDeps((ME + ME'),
15622      db((< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES >
15623          < ME' ; DM ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS),
15624         MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL))
15625   = db((< ME ; DT ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES >
15626         < ME' ; DM ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' >
15627         MIS),
15628        MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) .
15629  eq setUpModExpDeps((ME + ME'),
15630      db((< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES >
15631          < ME' ; DT ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS),
15632         MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL))
15633   = db((< ME ; DM ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES >
15634         < ME' ; DT ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' >
15635         MIS),
15636        MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) .
15637  eq setUpModExpDeps((ME + ME'),
15638      db((< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES >
15639          < ME' ; DM' ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS),
15640         MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL))
15641   = db((< ME ; DM ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES >
15642         < ME' ; DM' ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' >
15643         MIS),
15644        MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) .
15645  ceq setUpModExpDeps((ME + ME'), DB)
15646    = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n))
15647    if not unitInDb(ME, DB) .
15648  ceq setUpModExpDeps((ME + ME'), DB)
15649    = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME') 'not 'in 'database. '\n))
15650    if not unitInDb(ME', DB) .
15651---)
15652
15653*** The \texttt{prepHeader} function on a union module expression makes
15654*** recursive calls with each of the module expressions given as arguments.
15655
15656  eq prepModExp(ME + ME', VEPS)
15657    = prepModExp(ME, VEPS) + prepModExp(ME', VEPS) .
15658
15659*** Finally, the equation for the \texttt{parseModExp} function is as follows:
15660
15661  eq labelInModExp(X, ME + ME')
15662    = labelInModExp(X, ME) or-else labelInModExp(X, ME') .
15663endfm
15664
15665*******************************************************************************
15666
15667***
15668*** The $n$-tuple Module Expression
15669***
15670
15671*** The syntax used for the $n$-tuple module expression is as follows:
15672
15673***   op TUPLE[_] : Token -> ModuleExpression .
15674
15675*** Its evaluation consists in the generation of a parameterized functional
15676*** module with the number of \texttt{TRIV} parameters specified by the
15677*** argument. A sort for tuples of such size, and the corresponding constructor
15678*** and selector operators, are also defined. Note that the \texttt{TRIV}
15679*** theory is predefined in Full Maude (see Sections~\ref{main-module}
15680*** and~\ref{non-built-in-predefined}). For example, the module expression
15681*** \verb~TUPLE[3]~ produces the following module.
15682
15683*** fmod TUPLE[3][C1 :: TRIV, C2 :: TRIV, C3 :: TRIV] is
15684***    sorts 3Tuple .
15685***    op (_,_,_) : Elt.C1 Elt.C2 Elt.C3 -> 3Tuple .
15686***    op p1_ : 3Tuple -> Elt.C1 .
15687***    op p2_ : 3Tuple -> Elt.C2 .
15688***    op p3_ : 3Tuple -> Elt.C3 .
15689***    var E1 : Elt.C1 .
15690***    var E2 : Elt.C2 .
15691***    var E3 : Elt.C3 .
15692***    eq p1(E1, E2, E3) = E1 .
15693***    eq p2(E1, E2, E3) = E2 .
15694***    eq p3(E1, E2, E3) = E3 .
15695*** endfm
15696
15697*** Even though the $n$-tuple module expression is in principle of a completely
15698*** different nature, the way of handling it is the same as the way of handling
15699*** any other module expression. Its evaluation produces a new unit, a
15700*** parameterized functional module in this case, wtupleParList(N)ith the module expression as
15701*** name. New equations defining the semantics of functions
15702*** \texttt{evalModExp}, \texttt{header2QidList},
15703*** \texttt{setUpModExpDeps}, \texttt{prepHeader}, and
15704*** \texttt{parseModExp} are given for this module expression.
15705
15706
15707fmod N-TUPLE-EXPR is
15708  inc MOD-EXPR .
15709  pr INST-EXPR-EVALUATION .
15710  pr EVALUATION .
15711
15712  vars N N' : NzNat .
15713  var  PDL : ParameterDeclList .
15714  var  DB : Database .
15715  var  T : Term .
15716  var  IL : ImportList .
15717  var  VEPS : Set{Tuple{ViewExp,ViewExp}} .
15718  var  X : Qid .
15719  var  S : Sort .
15720
15721*** The equation for the \texttt{evalModExp} is reduced to the creation of a
15722*** module as indicated above. Some auxiliary functions are defined in order
15723*** to generate the different declarations in the module.
15724
15725  op tupleParList : NzNat -> ParameterDeclList .
15726  op tupleImportList : NzNat -> ImportList .
15727  op createCopyPars : NzNat Database -> Database .
15728  op tupleOps : NzNat -> OpDeclSet .
15729  op tupleOpsCtor : NzNat -> OpDecl .
15730  op tupleOpsCtorName : NzNat -> String .
15731  op tupleOpsCtorArity : NzNat -> QidList .
15732  op tupleOpsSelectors : NzNat NzNat -> OpDeclSet .
15733  op tupleEqSet : NzNat -> EquationSet .
15734  op tupleEqSetAux : NzNat Term -> EquationSet .
15735  op tupleTermArgs : NzNat -> TermList .
15736  ops tupleSort tupleSortAux : NzNat -> Sort .
15737
15738  eq evalModExp(TUPLE[N], PDL, DB)
15739    = if unitInDb(TUPLE[N], DB)
15740      then < DB ; TUPLE[N] >
15741      else < evalModule(
15742               fmod TUPLE[N]{tupleParList(N)} is
15743                 nil  ---- tupleImportList(N)
15744                 sorts tupleSort(N) .
15745                 none
15746                 tupleOps(N)
15747                 none
15748                 tupleEqSet(N)
15749               endfm,
15750               none,
15751               createCopyPars(N, DB)) ;
15752             TUPLE[N] >
15753      fi .
15754
15755  eq createCopyPars(N, DB)
15756    = if N == 1
15757      then createCopy((qid("C" + string(N, 10)) :: 'TRIV), DB)
15758      else createCopyPars(_-_(N, 1),
15759             createCopy((qid("C" + string(N, 10)) :: 'TRIV), DB))
15760      fi .
15761
15762  eq tupleParList(N)
15763    = if N == 1
15764      then (qid("C" + string(N, 10)) :: 'TRIV)
15765      else (tupleParList(_-_(N, 1)), (qid("C" + string(N, 10)) :: 'TRIV))
15766      fi .
15767
15768  eq tupleImportList(N)
15769    = if N == 1
15770      then (including pd(qid("C" + string(N, 10)) :: 'TRIV) .)
15771      else (tupleImportList(_-_(N, 1))
15772            (including pd(qid("C" + string(N, 10)) :: 'TRIV) .))
15773      fi .
15774
15775  eq tupleSort(N) = makeSort('Tuple, tupleSortAux(N)) .
15776
15777  eq tupleSortAux(N)
15778    = if N == 1
15779      then qid("C" + string(N, 10))
15780      else (tupleSortAux(_-_(N, 1)), qid("C" + string(N, 10)))
15781      fi .
15782
15783  eq tupleOps(N)
15784    = (tupleOpsCtor(N) tupleOpsSelectors(N, N)) .
15785
15786  eq tupleOpsCtor(N)
15787    = (op qid("(" + tupleOpsCtorName(N) + ")") :
15788            tupleOpsCtorArity(N) -> tupleSort(N) [none] .) .
15789
15790  eq tupleOpsCtorName(N)
15791    = if N == 1
15792      then "_"
15793      else "_," + tupleOpsCtorName(_-_(N, 1))
15794      fi .
15795
15796  eq tupleOpsCtorArity(N)
15797    = if N == 1
15798      then qid("C" + string(N, 10) + "$Elt")
15799      else tupleOpsCtorArity(_-_(N, 1)) qid("C" + string(N, 10) + "$Elt")
15800      fi .
15801
15802  eq tupleOpsSelectors(N, N')
15803    = if N == 1
15804      then (op qid("p" + string(N, 10) + "_") :
15805                 tupleSort(N') -> qid("C" + string(N, 10) + "$Elt") [none] .)
15806      else (tupleOpsSelectors(_-_(N, 1), N')
15807            (op qid("p" + string(N, 10) + "_") :
15808                  tupleSort(N') -> qid("C" + string(N, 10) + "$Elt") [none] .))
15809      fi .
15810
15811  eq tupleEqSet(N)
15812    = tupleEqSetAux(N,
15813        (qid("(" + tupleOpsCtorName(N) + ")") [ tupleTermArgs(N) ])) .
15814
15815  eq tupleTermArgs(N)
15816    = if N == 1
15817      then qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt")
15818      else (tupleTermArgs(_-_(N, 1)),
15819            qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt"))
15820      fi .
15821
15822  eq tupleEqSetAux(N, T)
15823    = if N == 1
15824      then (eq qid("p" + string(N, 10) + "_")[T]
15825              = qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt")
15826              [none] .)
15827      else (tupleEqSetAux(_-_(N, 1), T)
15828            (eq qid("p" + string(N, 10) + "_")[T]
15829               = qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt")
15830               [none] .))
15831      fi .
15832
15833*** The equations for the \texttt{header2QidList},
15834*** \texttt{parseModExp}, \texttt{prepHeader}, and
15835*** \texttt{setUpModExpDeps} functions on the $n$-tuple module
15836*** expression are as follows:
15837
15838  eq header2Qid(TUPLE[N]) = qid("TUPLE[" + string(N, 10) + "]") .
15839  eq header2QidList(TUPLE[N]) = ('TUPLE '`[ qid(string(N, 10)) '`]) .
15840
15841  eq prepModExp(TUPLE[N], VEPS) = TUPLE[N] .
15842
15843  eq setUpModExpDeps(TUPLE[N], DB) = DB .
15844
15845endfm
15846
15847fmod N-POWER-EXPR is
15848  inc MOD-EXPR .
15849  pr INST-EXPR-EVALUATION .
15850  pr EVALUATION .
15851
15852  vars N N' : NzNat .
15853  var  PDL : ParameterDeclList .
15854  var  DB : Database .
15855  var  T : Term .
15856  var  IL : ImportList .
15857  var  VEPS : Set{Tuple{ViewExp,ViewExp}} .
15858  var  X : Qid .
15859  var  S : Sort .
15860
15861*** As for TUPLE, the equation for the \texttt{evalModExp} is reduced to the
15862*** creation of a new module. A module expression POWER[n]{Nat} produces a
15863*** module
15864***
15865*** fmod POWER[n]{X :: TRIV} is
15866***   inc TUPLE[n]{X, X, ..., X} .
15867*** endfm
15868***
15869*** which is then instantiated by the Nat view.
15870
15871*** Some auxiliary functions are defined in order
15872*** to generate the different declarations in the module.
15873
15874  op powImportList : NzNat -> ImportList .
15875  op powTupleImportation : NzNat -> ViewExp .
15876
15877  eq evalModExp(POWER[N], PDL, DB)
15878    = if unitInDb(POWER[N], DB)
15879      then < DB ; POWER[N] >
15880      else < evalModule(
15881               fmod POWER[N]{'X :: 'TRIV} is
15882                 powImportList(N)
15883                 sorts none .
15884                 none
15885                 none
15886                 none
15887                 none
15888               endfm,
15889               none,
15890               createCopy('X :: 'TRIV, DB)) ;
15891             POWER[N] >
15892      fi .
15893
15894  eq powImportList(N)
15895    = (including TUPLE[N]{powTupleImportation(N)} .) .
15896
15897  eq powTupleImportation(N)
15898    = if N == 1
15899      then 'X
15900      else ('X, powTupleImportation(sd(N, 1)))
15901      fi .
15902
15903*** The equations for the \texttt{header2QidList},
15904*** \texttt{parseModExp}, \texttt{prepHeader}, and
15905*** \texttt{setUpModExpDeps} functions on the $n$-tuple module
15906*** expression are as follows:
15907
15908  eq header2Qid(POWER[N]) = qid("POWER[" + string(N, 10) + "]") .
15909  eq header2QidList(POWER[N]) = ('POWER '`[ qid(string(N, 10)) '`]) .
15910
15911  eq prepModExp(POWER[N], VEPS) = POWER[N] .
15912
15913  eq setUpModExpDeps(POWER[N], DB) = DB .
15914
15915endfm
15916
15917*******************************************************************************
15918
15919***
15920*** 8 Input/Output Processing
15921***
15922
15923*** In this section we discuss how the preterm resulting from the call to the
15924*** function \texttt{metaParse} with the input and the top-level signature of
15925*** Full Maude is transformed into a term of sort \texttt{Module}, representing
15926*** a preunit or a term of sort \texttt{PreView}. In the case of commands,
15927*** they are evaluated giving the corresponding results in the appropriate
15928*** form.
15929
15930***
15931*** 8.1 Input Parsing
15932***
15933
15934*** Let us recall here the example presented in Section~\ref{bubbles}. Calling
15935*** \texttt{metaParse} with the module \texttt{NAT3} given there and the
15936*** signature of Full Maude presented in Section~\ref{sec:signature}, we
15937*** obtain the following term.
15938
15939***    'fmod_is_endfm[
15940***       'token[{''NAT3}'Qid],
15941***       '__['sort_.['token[{''Nat3}'Qid]],
15942***           '__['op_:_->_.['token[{''s_}'Qid],
15943***                          'neTokenList[{''Nat3}'Qid],
15944***                          'token[{''Nat3}'Qid]],
15945***               '__['op_:`->_.['token[{''0}'Qid],
15946***                              'token[{''Nat3}'Qid]],
15947***                   'eq_=_.['bubble['__[{''s}'Qid, {''s}'Qid,
15948***                                       {''s}'Qid, {''0}'Qid]],
15949***                           'bubble[{''0}'Qid]]]]]]
15950
15951*** Given each one of the subterms representing declarations in terms
15952*** representing modules as the previous one, the function \texttt{parseDecl}
15953*** generates the corresponding declaration, with no bubbles in it, and the
15954*** corresponding predeclaration, with the bubbles appearing in the term. For
15955*** example, for the term
15956***
15957***   'op_:_->_.['token[{''s_}'Qid],
15958***              'neTokenList[{''Nat3}'Qid],
15959***              'token[{''Nat3}'Qid]]
15960***
15961*** the following operator declaration is generated:
15962***
15963***   op 's_ : 'Nat3 -> 'Nat3 [none] .
15964***
15965*** Note that in this case, since the operator is declared without identity
15966*** element (the only place a bubble might appear), the declaration and the
15967*** predeclaration generated by \texttt{parseDecl} coincide.
15968
15969*** In the following sections we shall see how this approach is followed for
15970*** declarations appearing in units and in views.
15971
15972***
15973*** 8.1.1 Parsing of Module Declarations
15974***
15975
15976*** The \texttt{parseDecl} function takes a term (which corresponds to a
15977*** declaration to be parsed), a preunit (to which the parsed declaration with
15978*** its bubbles in it will be added), and a unit (to which the parsed
15979*** declaration without bubbles will be added to build up the signature). For
15980*** example, a term corresponding to an unconditional equation, that is, a term
15981*** of the form \verb~'eq_=_.[T, T']~ will be added to the set of equations of
15982*** the preunit as \verb~eq T = T' .~, but nothing will be added to the unit.
15983*** Note that according to the signature used in the call to
15984*** \texttt{metaParse} (see Sections~\ref{sec:signature}
15985*** and~\ref{main-module}), \texttt{T} and \texttt{T'} are bubbles.
15986*** Declarations of sorts, subsort relations, operators, classes, subclass
15987*** relations, messages, and variables will be added to both of them. In the
15988*** case of operator declarations, identity element attributes, which in
15989*** general can be terms, are not included in the added declaration.
15990
15991*** As in Core Maude, declarations in a module can be given in any order, and
15992*** therefore we follow a two-step approach consisting in first building the
15993*** signature to parse the bubbles, and then generating the unit without
15994*** bubbles in it. It could be different for other languages. For example, in
15995*** some languages we may be able to assume that each operator and sort has
15996*** been defined before being used, allowing then an incremental processing of
15997*** the input.
15998
15999---- fmod MAYBE{X :: TRIV} is
16000----   sort Maybe{X} .
16001----   subsort X$Elt < Maybe{X} .
16002----   op maybe : -> Maybe{X} .
16003---- endfm
16004
16005fmod UNIT-DECL-PARSING is
16006  pr DATABASE .
16007  pr MOVE-DOWN .
16008  pr INST-EXPR-EVALUATION .
16009  pr RENAMING-EXPR-EVALUATION .
16010  pr UNION-EXPR .
16011  pr N-TUPLE-EXPR .
16012  pr N-POWER-EXPR .
16013  pr DEFAULT-VALUE{Term} .
16014  pr META-FULL-MAUDE-SIGN .
16015  pr UNIT-BUBBLE-PARSING .
16016
16017  vars PU U : Module .
16018  vars T T' T'' T''' T3 T4 : Term .
16019  vars QI QI' QI'' L F : Qid .
16020  vars QIL QIL' : QidList .
16021  vars S S' : Sort .
16022  vars SS SS' : TypeSet .
16023  vars TyL TyL' : TypeList .
16024  var  TSL : TypeSetList .
16025  var  AtS : AttrSet .
16026  vars TL TL' TL'' : TermList .
16027  var  Ct : Constant .
16028  var  VDS : OpDeclSet .
16029  vars Ty Tp : Type .
16030  var  N : Nat .
16031  var  DT : Default{Term} .
16032
16033*** Similarly, auxiliary functions parsing other elements in units
16034*** are defined.
16035
16036  op parsePreAttrs : Term Nat -> AttrSet .
16037  op parsePreHookList : Term -> HookList .
16038  op parseVars : QidList [Type] -> OpDeclSet .
16039  op parseSubsortRel : Term -> TypeListSet .
16040
16041  op parseAttrDeclList : Term -> AttrDeclSet .
16042  op unfoldOpDecl : QidList TypeList Sort AttrSet -> OpDeclSet .
16043  op unfoldMultipleMsgDecl : QidList TypeList Sort -> MsgDeclSet .
16044  op unfoldSubsortRel : TypeSetList ~> SubsortDeclSet .
16045  op unfoldSubclassRel : TypeSetList ~> SubclassDeclSet .
16046
16047  eq parseSubsortRel('_<_[T, T'])
16048    = _l_(parseSortSet(T), parseSubsortRel(T')) .
16049  eq parseSubsortRel('__[T, T']) = parseSortSet('__[T, T']) .
16050  eq parseSubsortRel('sortToken[T]) = downQid(T) .
16051  eq parseSubsortRel('_`{_`}['sortToken[T], T'])
16052    = makeSort(downQid(T), parseParameterList(T')) .
16053  eq parseSubsortRel('_`{_`}['_`{_`}[T, T'], T''])
16054    = makeSort(parseSubsortRel('_`{_`}[T, T']), parseParameterList(T'')) .
16055
16056  eq unfoldOpDecl((QI QIL), TyL, Ty, AtS)
16057    = ((op QI : TyL -> Ty [AtS] .) unfoldOpDecl(QIL, TyL, Ty, AtS)) .
16058  eq unfoldOpDecl(nil, TyL, Ty, AtS) = none .
16059
16060  eq unfoldMultipleMsgDecl((QI QIL), TyL, Ty)
16061    = ((msg QI : TyL -> Ty .) unfoldMultipleMsgDecl(QIL, TyL, Ty)) .
16062  eq unfoldMultipleMsgDecl(nil, TyL, Ty) = none .
16063
16064  eq unfoldSubsortRel(_l_((S ; SS), (S' ; SS'), TSL))
16065    = ((subsort S < S' .)
16066       unfoldSubsortRel(_l_(S, SS'))
16067       unfoldSubsortRel(_l_(SS, (S' ; SS')))
16068       unfoldSubsortRel(_l_((S' ; SS'), TSL))) .
16069  eq unfoldSubsortRel(_l_(SS, none)) = none .
16070  eq unfoldSubsortRel(_l_(none, SS)) = none .
16071  eq unfoldSubsortRel(SS) = none .
16072  eq unfoldSubsortRel(qidError(QIL)) = subsortDeclError(QIL) .
16073
16074  eq unfoldSubclassRel(_l_((S ; SS), (S' ; SS'), TSL))
16075    = ((subclass S < S' .)
16076       unfoldSubclassRel(_l_(S, SS'))
16077       unfoldSubclassRel(_l_(SS, (S' ; SS')))
16078       unfoldSubclassRel(_l_((S' ; SS'), TSL))) .
16079  eq unfoldSubclassRel(_l_(SS, none)) = none .
16080  eq unfoldSubclassRel(_l_(none, SS)) = none .
16081  eq unfoldSubclassRel(SS) = none .
16082  eq unfoldSubclassRel(qidError(QIL)) = subclassDeclError(QIL) .
16083
16084  eq parseVars((QI QIL), Tp)
16085    = ((op QI : nil -> Tp [none] .) parseVars(QIL, Tp)) .
16086  eq parseVars(nil, Tp) = none .
16087  eq parseVars(QIL, qidError(QIL')) = opDeclError(QIL') .
16088
16089  eq parsePreAttrs('__[T, T'], N)
16090    = (parsePreAttrs(T, N) parsePreAttrs(T', N)) .
16091  eq parsePreAttrs('assoc.@Attr@, N) = assoc .
16092  eq parsePreAttrs('associative.@Attr@, N) = assoc .
16093  eq parsePreAttrs('comm.@Attr@, N) = comm .
16094  eq parsePreAttrs('commutative.@Attr@, N) = comm .
16095  eq parsePreAttrs('idem.@Attr@, N) = idem .
16096  eq parsePreAttrs('idempotent.@Attr@, N) = idem .
16097  eq parsePreAttrs('id:_[T], N) = id(T) .
16098  eq parsePreAttrs('identity:_[T], N) = id(T) .
16099  eq parsePreAttrs('left`id:_[T], N) = left-id(T) .
16100  eq parsePreAttrs('left`identity:_[T], N) = left-id(T) .
16101  eq parsePreAttrs('right`id:_[T], N) = right-id(T) .
16102  eq parsePreAttrs('right`identity:_[T], N) = right-id(T) .
16103  eq parsePreAttrs('poly`(_`)[T], N) = poly(parseInt(T)) .
16104  eq parsePreAttrs('strat`(_`)[T], N) = strat(parseInt(T)) .
16105  eq parsePreAttrs('strategy`(_`)[T], N) = strat(parseInt(T)) .
16106  eq parsePreAttrs('frozen.@Attr@, N)
16107    = if N == 0
16108      then none
16109      else frozen(from 1 to N list)
16110      fi .
16111  eq parsePreAttrs('frozen`(_`)[T], N) = frozen(parseInt(T)) .
16112  eq parsePreAttrs('memo.@Attr@, N) = memo .
16113  eq parsePreAttrs('memoization.@Attr@, N) = memo .
16114  eq parsePreAttrs('ctor.@Attr@, N) = ctor .
16115  eq parsePreAttrs('constructor.@Attr@, N) = ctor .
16116  eq parsePreAttrs('prec_['token[T]], N) = prec(parseNat(T)) .
16117  eq parsePreAttrs('gather`(_`)['neTokenList[T]], N) = gather(downQidList(T)) .
16118  eq parsePreAttrs('special`(_`)[T], N) = special(parsePreHookList(T)) .
16119  eq parsePreAttrs('format`(_`)['neTokenList[T]], N) = format(downQidList(T)) .
16120  eq parsePreAttrs('iter.@Attr@, N) = iter .
16121  eq parsePreAttrs('ditto.@Attr@, N) = ditto .
16122  eq parsePreAttrs('config.@Attr@, N) = config .
16123  eq parsePreAttrs('object.@Attr@, N) = object .
16124  eq parsePreAttrs('msg.@Attr@, N) = msg .
16125  eq parsePreAttrs('message.@Attr@, N) = msg .
16126  eq parsePreAttrs('metadata_['token[T]], N) = metadata(downString(downQid(T))) .
16127  eq parsePreAttrs('nonexec.@Attr@, N) = nonexec .
16128  eq parsePreAttrs('variant.@Attr@, N) = variant .
16129
16130  eq parsePreHookList('__[T, TL]) = parsePreHookList(T) parsePreHookList(TL) .
16131  eq parsePreHookList('id-hook_['token[T]]) = id-hook(downQid(T), nil) .
16132  eq parsePreHookList('id-hook_`(_`)['token[T], 'neTokenList[T']])
16133    = id-hook(downQid(T), downQidList(T')) .
16134  eq parsePreHookList(
16135       'op-hook_`(_:_->_`)[
16136          'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]])
16137    = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) .
16138  eq parsePreHookList('op-hook_`(_:`->_`)['token[T], 'token[T'], 'token[T'']])
16139    = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) .
16140  eq parsePreHookList(
16141       'op-hook_`(_:_~>_`)[
16142          'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]])
16143    = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) .
16144  eq parsePreHookList('op-hook_`(_:`~>_`)['token[T], 'token[T'], 'token[T'']])
16145    = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) .
16146  eq parsePreHookList('term-hook_`(_`)['token[T], T'])
16147    = term-hook(downQid(T), T') .
16148
16149  eq parseAttrDeclList('_`,_[T, T'])
16150    = (parseAttrDeclList(T), parseAttrDeclList(T')) .
16151  eq parseAttrDeclList('_:_['token[T], T'])
16152    = (attr downQid(T) : parseType(T')) .
16153
16154*** Given a term representing a declaration or a predeclaration, the function
16155*** \texttt{parseDecl} must generate and update both the unit and the preunit
16156*** that it takes as arguments. Note that in the case of rules, for example,
16157*** only a prerule is generated.
16158
16159*** Since the preunit and the unit may be modified, they have to be returned as
16160*** a pair, which will be used to extract the corresponding arguments for the
16161*** following calls. Note that the \texttt{parseDecl} functions are in fact
16162*** partial functions. Each parsing function assumes that it is possible to
16163*** parse the given term.
16164
16165  sort ParseDeclResult .
16166  op <_;_;_> : Module Module OpDeclSet -> ParseDeclResult .
16167  op preModule : ParseDeclResult -> Module .
16168  op unit : ParseDeclResult -> Module .
16169  op vars : ParseDeclResult -> OpDeclSet .
16170
16171  eq preModule(< PU ; U ; VDS >) = PU .
16172  eq preModule(< unitError(QIL) ; V:[Module] ; V:[OpDeclSet] >) = unitError(QIL) .
16173  eq preModule(< V:[Module] ; unitError(QIL) ; V:[OpDeclSet] >) = unitError(QIL) .
16174  eq preModule(< V:[Module] ; V':[Module] ; opDeclError(QIL) >) = unitError(QIL) .
16175  eq unit(< PU ; U ; VDS >) = U .
16176  eq unit(< unitError(QIL) ; V':[Module] ; V:[OpDeclSet] >) = unitError(QIL) .
16177  eq unit(< V:[Module] ; unitError(QIL) ; V:[OpDeclSet] >) = unitError(QIL) .
16178  eq unit(< V:[Module] ; V':[Module] ; opDeclError(QIL) >) = unitError(QIL) .
16179  eq vars(< PU ; U ; VDS >) = VDS .
16180  eq vars(< unitError(QIL) ; V:[Module] ; V:[OpDeclSet] >) = opDeclError(QIL) .
16181  eq vars(< V:[Module] ; unitError(QIL) ; V:[OpDeclSet] >) = opDeclError(QIL) .
16182  eq vars(< V:[Module] ; V':[Module] ; opDeclError(QIL) >) = opDeclError(QIL) .
16183
16184  op parseDecl : Term Module Module OpDeclSet -> ParseDeclResult .
16185
16186*** changed 03/27/02
16187*** In the case of importation declarations, since internally only the
16188*** \texttt{including} mode is handled, all importations are generated in
16189*** this mode, independently of the keyword used in the input.
16190
16191  eq parseDecl('inc_.[T], PU, U, VDS)
16192    = parseDecl('including_.[T], PU, U, VDS) .
16193  eq parseDecl('ex_.[T], PU, U, VDS)
16194    = parseDecl('extending_.[T], PU, U, VDS) .
16195  eq parseDecl('pr_.[T], PU, U, VDS)
16196    = parseDecl('protecting_.[T], PU, U, VDS) .
16197  eq parseDecl('including_.[T], PU, U, VDS)
16198    = < addImports((including parseModExp(T) .), PU) ; U ; VDS > .
16199  eq parseDecl('extending_.[T], PU, U, VDS)
16200    = < addImports((extending parseModExp(T) .), PU) ; U ; VDS > .
16201  eq parseDecl('protecting_.[T], PU, U, VDS)
16202    = < addImports((protecting parseModExp(T) .), PU) ; U ; VDS > .
16203
16204  eq parseDecl('sort_.[T], PU, U, VDS) = parseDecl('sorts_.[T], PU, U, VDS) .
16205  eq parseDecl('sorts_.[T], PU, U, VDS)
16206    = < addSorts(parseSortSet(T), PU) ; addSorts(parseSortSet(T), U) ; VDS > .
16207
16208  eq parseDecl('subsort_.[T], PU, U, VDS)
16209    = parseDecl('subsorts_.[T], PU, U, VDS) .
16210  eq parseDecl('subsorts_.[T], PU, U, VDS)
16211    = < addSubsorts(unfoldSubsortRel(parseSubsortRel(T)), PU) ;
16212        addSubsorts(unfoldSubsortRel(parseSubsortRel(T)), U) ; VDS > .
16213
16214*** As pointed out in Section~\ref{SyntacticalRequirementsAndCaveats}, the
16215*** name of operators in operator declaration has to be given as a single
16216*** token identifier (see Section~\ref{order-sorted}). We assume that when
16217*** declaring a multitoken operator, its name is given as a single quoted
16218*** identifier in which each token is preceded by a backquote. Thus, the name
16219*** of an operator \verb~_(_)~, for example, is given as \verb~_`(_`)~.
16220
16221  eq parseDecl('op_:`->_.['token[T], T'], PU, U, VDS)
16222    = < addOps((op downQid(T) : nil -> parseType(T') [none] .), PU) ;
16223        addOps((op downQid(T) : nil -> parseType(T') [none] .), U) ;
16224        VDS > .
16225  eq parseDecl('op_:`->_`[_`].['token[T], T', T''], PU, U, VDS)
16226    = < addOps(
16227          (op downQid(T) : nil -> parseType(T') [parsePreAttrs(T'', 0)] .),
16228          PU) ;
16229        addOps(
16230          (op downQid(T) : nil -> parseType(T') [parseAttrs(T'')] .),
16231          U) ;
16232        VDS > .
16233  eq parseDecl('op_:_->_.['token[T], T', T''], PU, U, VDS)
16234    = < addOps(
16235          (op downQid(T) : parseTypeList(T') -> parseType(T'') [none] .),
16236          PU) ;
16237        addOps(
16238          (op downQid(T) : parseTypeList(T') -> parseType(T'') [none] .),
16239          U) ;
16240        VDS > .
16241  eq parseDecl('op_:_->_`[_`].['token[T], T', T'', T3], PU, U, VDS)
16242    = < addOps(
16243          (op downQid(T) : parseTypeList(T') -> parseType(T'')
16244               [parsePreAttrs(T3, size(parseTypeList(T')))] .), PU) ;
16245        addOps(
16246          (op downQid(T) : parseTypeList(T') -> parseType(T'')
16247               [parseAttrs(T3)] .), U) ;
16248        VDS > .
16249
16250  ceq parseDecl('op_:`->_.[F[TL], T], PU, U, VDS)
16251    = < PU ; U ; VDS >
16252    if F =/= 'token .
16253  ceq parseDecl('op_:`->_`[_`].[F[TL], T, T'], PU, U, VDS)
16254    = < PU ; U ; VDS >
16255    if F =/= 'token .
16256  ceq parseDecl('op_:_->_.[F[TL], T, T'], PU, U, VDS)
16257    = < PU ; U ; VDS >
16258    if F =/= 'token .
16259  ceq parseDecl('op_:_->_`[_`].[F[TL], T, T', T''], PU, U, VDS)
16260    = < PU ; U ; VDS >
16261    if F =/= 'token .
16262
16263  eq parseDecl('ops_:`->_.['neTokenList[T], T'], PU, U, VDS)
16264    = < addOps(
16265          unfoldOpDecl(downTypes(T), nil, parseType(T'), none), PU) ;
16266        addOps(
16267          unfoldOpDecl(downTypes(T), nil, parseType(T'), none), U) ;
16268        VDS > .
16269  eq parseDecl('ops_:`->_`[_`].['neTokenList[T], T', T''], PU, U, VDS)
16270    = < addOps(
16271          unfoldOpDecl(downTypes(T), nil, parseType(T'),
16272            parsePreAttrs(T'', 0)),
16273          PU) ;
16274        addOps(
16275          unfoldOpDecl(downTypes(T), nil, parseType(T'),
16276            parseAttrs(T'')),
16277          U) ;
16278        VDS > .
16279  eq parseDecl('ops_:_->_.['neTokenList[T], T', T''], PU, U, VDS)
16280    = < addOps(
16281          unfoldOpDecl(downTypes(T), parseTypeList(T'),
16282            parseType(T''), none),
16283          PU) ;
16284        addOps(
16285          unfoldOpDecl(downTypes(T), parseTypeList(T'),
16286            parseType(T''), none),
16287          U) ;
16288        VDS > .
16289  eq parseDecl('ops_:_->_`[_`].['neTokenList[T], T', T'', T3], PU, U, VDS)
16290    = < addOps(
16291          unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''),
16292            parsePreAttrs(T3, size(parseTypeList(T')))), PU) ;
16293        addOps(
16294          unfoldOpDecl(downTypes(T),
16295            parseTypeList(T'), parseType(T''), parseAttrs(T3)), U) ;
16296        VDS > .
16297
16298  eq parseDecl('op_:`~>_.['token[T], T'], PU, U, VDS)
16299    = < addOps((op downQid(T) : nil -> kind(parseType(T')) [none] .), PU) ;
16300        addOps((op downQid(T) : nil -> kind(parseType(T')) [none] .), U) ;
16301        VDS > .
16302  eq parseDecl('op_:`~>_`[_`].['token[T], T', T''], PU, U, VDS)
16303    = < addOps((op downQid(T) : nil -> kind(parseType(T'))
16304                    [parsePreAttrs(T'', 0)] .), PU) ;
16305        addOps((op downQid(T) : nil -> kind(parseType(T'))
16306                    [parseAttrs(T'')] .), U) ;
16307        VDS > .
16308  eq parseDecl('op_:_~>_.['token[T], T', T''], PU, U, VDS)
16309    = < addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T''))
16310                    [none] .), PU) ;
16311        addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T''))
16312                    [none] .), U) ;
16313        VDS > .
16314  eq parseDecl('op_:_~>_`[_`].['token[T], T', T'', T3], PU, U, VDS)
16315    = < addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T''))
16316                   [parsePreAttrs(T3, size(parseTypeList(T')))] .), PU) ;
16317        addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T''))
16318                   [parseAttrs(T3)] .), U) ;
16319        VDS > .
16320
16321  ceq parseDecl('op_:`~>_.[F[TL], T], PU, U, VDS)
16322    = < PU ; U ; VDS >
16323    if F =/= 'token .
16324  ceq parseDecl('op_:`~>_`[_`].[F[TL], T, T'], PU, U, VDS)
16325    = < PU ; U ; VDS >
16326    if F =/= 'token .
16327  ceq parseDecl('op_:_~>_.[F[TL], T, T'], PU, U, VDS)
16328    = < PU ; U ; VDS >
16329    if F =/= 'token .
16330  ceq parseDecl('op_:_~>_`[_`].[F[TL], T, T', T''], PU, U, VDS)
16331    = < PU ; U ; VDS >
16332    if F =/= 'token .
16333
16334  eq parseDecl('ops_:`~>_.['neTokenList[T], T'], PU, U, VDS)
16335    = < addOps(
16336          unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), none),
16337          PU) ;
16338        addOps(
16339          unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), none),
16340          U) ;
16341        VDS > .
16342  eq parseDecl('ops_:`~>_`[_`].['neTokenList[T], T', T''], PU, U, VDS)
16343    = < addOps(
16344          unfoldOpDecl(downTypes(T), nil, kind(parseType(T')),
16345            parsePreAttrs(T'', 0)),
16346          PU) ;
16347        addOps(
16348          unfoldOpDecl(downTypes(T), nil, kind(parseType(T')),
16349            parseAttrs(T'')), U) ;
16350        VDS > .
16351  eq parseDecl('ops_:_~>_.['neTokenList[T], T', T''], PU, U, VDS)
16352    = < addOps(
16353          unfoldOpDecl(downTypes(T), parseTypeList(T'),
16354            kind(parseType(T'')), none),
16355          PU) ;
16356        addOps(
16357          unfoldOpDecl(downTypes(T), parseTypeList(T'),
16358            kind(parseType(T'')), none),
16359          U) ;
16360        VDS > .
16361  eq parseDecl('ops_:_~>_`[_`].['neTokenList[T], T', T'', T3], PU,
16362       U, VDS)
16363    = < addOps(
16364          unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''),
16365            parsePreAttrs(T3, size(parseTypeList(T')))),
16366          PU) ;
16367        addOps(
16368          unfoldOpDecl(downTypes(T),
16369            parseTypeList(T'), parseType(T''), parseAttrs(T3)), U) ;
16370        VDS > .
16371
16372  eq parseDecl('var_:_.['neTokenList[T], T'], PU, U, VDS)
16373    = parseDecl('vars_:_.['neTokenList[T], T'], PU, U, VDS) .
16374  eq parseDecl('vars_:_.['neTokenList[T], T'], PU, U, VDS)
16375    = < PU ; U ; VDS parseVars(downQidList(T), parseType(T')) > .
16376
16377  eq parseDecl('mb_:_.['bubble['__[''`[.Qid, L, ''`].Qid]], T], PU, U, VDS)
16378    = < addMbs((mb getTerm(breakMb(T, VDS)) : getSort(breakMb(T, VDS))
16379                  [label(downQid(L)) getAttrSet(breakMb(T, VDS))] .), PU) ; U ; VDS > .
16380  eq parseDecl('mb_:_.[T, T'], PU, U, VDS)
16381    = < addMbs((mb T : getSort(breakMb(T', VDS)) [getAttrSet(breakMb(T', VDS))] .), PU) ; U ; VDS >
16382    [owise] .
16383  eq parseDecl('cmb_:_if_.[T, T', T''], PU, U, VDS)
16384    = < addMbs(
16385          (cmb T : getSort(breakMb(T', VDS))
16386             if term(pullStmtAttrOut(T'', VDS)) = 'true.Bool
16387             [attrSet(pullStmtAttrOut(T'', VDS))] .), PU) ; U ; VDS > .
16388  eq parseDecl('cmb`[_`]:_:_if_.['token[T'''], T, T', T''], PU, U, VDS)
16389    = < addMbs(
16390          (cmb T : getSort(breakMb(T', VDS))
16391             if term(pullStmtAttrOut(T'', VDS)) = 'true.Bool
16392             [attrSet(pullStmtAttrOut(T'', VDS)) label(downQid(T'''))] .), PU) ; U ; VDS > .
16393
16394  sort Tuple{Default{Term},Sort,AttrSet} .
16395
16396  op breakMb : Term OpDeclSet -> [Tuple{Default{Term},Sort,AttrSet}] .
16397  op breakMbAux : Term TermList AttrSet OpDeclSet -> [Tuple{Default{Term},Sort,AttrSet}] .
16398  op {_,_,_} : Default{Term} Sort AttrSet -> Tuple{Default{Term},Sort,AttrSet} .
16399  op getTerm : Tuple{Default{Term},Sort,AttrSet} -> Default{Term} .
16400  op getSort : Tuple{Default{Term},Sort,AttrSet} -> Sort .
16401  op getAttrSet : Tuple{Default{Term},Sort,AttrSet} -> AttrSet .
16402  eq getTerm({DT, S, AtS}) = DT .
16403  eq getTerm({DT, qidError(QIL), AtS}) = DT .
16404  eq getSort({DT, S, AtS}) = S .
16405  eq getSort({DT, qidError(QIL), AtS}) = qidError(QIL) .
16406  eq getAttrSet({DT, S, AtS}) = AtS .
16407  eq getAttrSet({DT, qidError(QIL), AtS}) = AtS .
16408
16409----  eq breakMb('bubble[QI]) = {maybe, downQidList(QI), none} .
16410----  eq breakMb('bubble['__[QI, QI']])
16411----    = {maybe, getType(parseTypeMb('bubble['__[QI, QI']])), none} .
16412----  eq breakMb('bubble['__[QI, QI', QI'']])
16413----    = {getTerm(parseTypeMb('bubble['__[QI, QI', QI'']])),
16414----       getType(parseTypeMb('bubble['__[QI, QI', QI'']])),
16415----       none} .
16416  eq breakMb('bubble['__[QI, QI', TL, QI'']], VDS)
16417    = if QI'' =/= ''`].Qid
16418      then {getTerm(parseTypeMb('bubble['__[QI, QI', TL, QI'']])),
16419            getType(parseTypeMb('bubble['__[QI, QI', TL, QI'']])),
16420            none}
16421      else breakMbAux('bubble['__[QI, QI', TL, QI'']], (QI, QI', TL), none, VDS)
16422      fi .
16423  eq breakMb('sortToken[T], VDS) = {null, parseType('sortToken[T]), none} [owise] .
16424  eq breakMb('_`{_`}[T, T'], VDS) = {null, parseType('_`{_`}[T, T']), none} [owise] .
16425  eq breakMb(T, VDS) = {null, getType(parseTypeMb(T)), none} [owise] .
16426
16427  eq breakMbAux(T, (TL, ''`[.Qid), AtS, VDS)
16428    = if AtS =/= none
16429      then {null, getType(parseTypeMb('bubble[TL])), AtS}
16430      else {null, T, none}
16431      fi .
16432  eq breakMbAux(T, (TL, QI, QI', ''`[.Qid), AtS, VDS)
16433    = if AtS =/= none
16434      then {getTerm(parseTypeMb('bubble['__[TL, QI, QI']])),
16435            getType(parseTypeMb('bubble['__[TL, QI, QI']])), AtS}
16436      else {getTerm(parseTypeMb(T)), getType(parseTypeMb(T)), none}
16437      fi .
16438  eq breakMbAux(T, (TL, QI, ''nonexec.Qid), AtS, VDS)
16439    = breakMbAux(T, (TL, QI), AtS nonexec, VDS) .
16440  eq breakMbAux(T, (TL, QI, ''variant.Qid), AtS, VDS)
16441    = breakMbAux(T, (TL, QI), AtS variant, VDS) .
16442  eq breakMbAux(T, (TL, QI, ''owise.Qid), AtS, VDS)
16443    = breakMbAux(T, (TL, QI), AtS owise, VDS) .
16444  eq breakMbAux(T, (TL, QI, ''otherwise.Qid), AtS, VDS)
16445    = breakMbAux(T, (TL, QI), AtS owise, VDS) .
16446  eq breakMbAux(T, (TL, QI, ''label.Qid, QI'), AtS, VDS)
16447    = if downQid(QI') :: Qid
16448      then breakMbAux(T, (TL, QI), AtS label(downQid(QI')), VDS)
16449      else {null, T, none}
16450      fi .
16451  eq breakMbAux(T, (TL, QI, ''metadata.Qid, QI'), AtS, VDS)
16452    = if downString(downQid(QI')) :: String
16453      then breakMbAux(T, (TL, QI), AtS metadata(downString(downQid(QI'))), VDS)
16454      else {null, T, none}
16455      fi .
16456  ceq breakMbAux(T, (TL, QI, ''`[.Qid, TL',  ''print.Qid, TL''), AtS, VDS)
16457    = breakMbAux(T, (TL, QI, ''`[.Qid, TL'), AtS print(printArg(TL'', VDS)), VDS)
16458    if printArg(TL'', VDS) : QidList .
16459  eq breakMbAux(T, TL, AtS, VDS)  = {null, T, none} [owise] .
16460
16461  op parseTypeMb : Term ~> ResultPair .
16462----  eq parseTypeMb('bubble[T])
16463----    = parseType(getTerm(metaParse(upModule('EXTENDED-SORTS, false), downQidList(T), '@Sort@))) .
16464  eq parseTypeMb('bubble[TL])
16465    = if metaParse(
16466           addOps(
16467             op '_:_ : '@Bubble@ '@Sort@ -> '@TermSort@ [none] .,
16468             addSorts('@TermSort@, GRAMMAR)),
16469           downQidList(TL), '@TermSort@) :: ResultPair
16470      then breakTermSort(
16471             getTerm(
16472               metaParse(
16473                 addOps(
16474                   op '_:_ : '@Bubble@ '@Sort@ -> '@TermSort@ [none] .,
16475                   addSorts('@TermSort@, GRAMMAR)),
16476                 downQidList(TL), '@TermSort@)))
16477      else {null, parseType(getTerm(metaParse(GRAMMAR, downQidList(TL), '@Sort@)))}
16478      fi .
16479
16480  op breakTermSort : Term ~> ResultPair .
16481  eq breakTermSort('_:_[T, T']) = {T, parseType(T')} .
16482
16483  eq parseDecl('eq_=_.[T, T'], PU, U, VDS)
16484    = < addEqs((eq T = T' [none] .), PU) ; U ; VDS > .
16485  eq parseDecl('ceq_=_if_.[T, T', T''], PU, U, VDS)
16486    = < addEqs((ceq T = T' if T'' = 'true.Bool [none] .), PU) ; U ; VDS > .
16487  eq parseDecl('cq_=_if_.[T, T', T''], PU, U, VDS)
16488    = < addEqs((ceq T = T' if T'' = 'true.Bool [none] .), PU) ; U ; VDS > .
16489
16490  eq parseDecl('rl_=>_.[T, T'], PU, U, VDS)
16491    = < addRls((rl T => T' [none] .), PU) ; U ; VDS > .
16492  eq parseDecl('crl_=>_if_.[T, T', T''], PU, U, VDS)
16493    = < addRls((crl T => T' if T'' = 'true.Bool [none] .), PU) ; U ; VDS > .
16494
16495  eq parseDecl('class_|`.[T], PU, U, VDS)
16496    = parseDecl('class_.[T], PU, U, VDS) .
16497  eq parseDecl('class_.[T], PU, U, VDS)
16498    = < addClasses((class parseType(T) | none .), PU) ;
16499        addClasses((class parseType(T) | none .), U) ; VDS > .
16500  eq parseDecl('class_|_.[T, T'], PU, U, VDS)
16501    = < addClasses((class parseType(T) | parseAttrDeclList(T') .), PU) ;
16502        addClasses((class parseType(T) | parseAttrDeclList(T') .), U) ; VDS > .
16503
16504  eq parseDecl('subclass_.[T], PU, U, VDS)
16505    = < addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), PU) ;
16506        addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), U) ; VDS > .
16507  eq parseDecl('subclasses_.[T], PU, U, VDS)
16508    = < addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), PU) ;
16509        addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), U) ; VDS > .
16510
16511  eq parseDecl('msg_:_->_.['token[T], T', T''], PU, U, VDS)
16512    = < addMsgs((msg downQid(T) : parseTypeList(T') -> parseType(T'') .), PU)
16513        ;
16514        addMsgs((msg downQid(T) : parseTypeList(T') -> parseType(T'') .), U)
16515        ;
16516        VDS > .
16517  eq parseDecl('msg_:`->_.['token[T], T'], PU, U, VDS)
16518    = < addMsgs((msg downQid(T) : nil -> parseType(T') .), PU) ;
16519        addMsgs((msg downQid(T) : nil -> parseType(T') .), U) ; VDS > .
16520  eq parseDecl('msgs_:_->_.['neTokenList[T], T', T''], PU, U, VDS)
16521    = < addMsgs(unfoldMultipleMsgDecl(downQidList(T), parseTypeList(T'), parseType(T'')), PU) ;
16522        addMsgs(unfoldMultipleMsgDecl(downQidList(T), parseTypeList(T'), parseType(T'')), U) ;
16523        VDS > .
16524  eq parseDecl('msgs_:`->_.['neTokenList[T], T'], PU, U, VDS)
16525    = < addMsgs(unfoldMultipleMsgDecl(downQidList(T), nil, parseType(T')), PU) ;
16526        addMsgs(unfoldMultipleMsgDecl(downQidList(T), nil, parseType(T')), U) ; VDS > .
16527
16528endfm
16529
16530*******************************************************************************
16531
16532***
16533*** 8.1.2 Parsing of View Declarations
16534***
16535
16536*** A similar approach is followed for the parsing of declarations in views.
16537
16538fmod VIEW-DECL-PARSING is
16539  pr PRE-VIEW .
16540  pr VIEW .
16541  pr UNIT .
16542  pr UNIT-DECL-PARSING .
16543
16544  vars T T' : Term .
16545  var  OPDS : OpDeclSet .
16546  var  MDS : MsgDeclSet .
16547  var  M : Module .
16548  vars F F' : Qid .
16549  vars S S' : Sort .
16550  vars Ty Ty' : Type .
16551  vars TyL TyL' : TypeList .
16552  vars T'' T3 : Term .
16553  var  PV : PreView .
16554  var  OPD : OpDecl .
16555  var  OPDS' : OpDeclSet .
16556  var  AtS : AttrSet .
16557  var  MD : MsgDecl .
16558  var  MDS' : MsgDeclSet .
16559  var  VDS : OpDeclSet .
16560
16561*** Operator and message name maps of the form \verb~F to F'~ are substituted
16562*** by an equivalent set of maps of the form \verb~F : TyL -> S to F'~. One
16563*** of these maps is added for each family of subsort-overloaded operators in
16564*** the source theory of the view.
16565
16566*** The following functions \texttt{genOpMaps} and \texttt{genMsgMaps}
16567*** take, respectively, an operator and a message map of the form
16568*** \verb~F to F'~, a set of operator or message declarations, and a term of
16569*** sort \texttt{Module}, and return, respectively, a set of operator maps and
16570*** a set of message maps, with each of the members of those sTS having the
16571*** general form \verb~F : TyL -> S to F'~. One of these maps is generated
16572*** for each family of subsort-overloaded operators or messages with name
16573*** \texttt{F} in the module given as argument.
16574
16575  op genOpMaps : OpMapping OpDeclSet Module -> OpMappingSet .
16576  op genMsgMaps : OpMapping MsgDeclSet Module -> OpMappingSet .
16577
16578  op genOpMapsAux : OpDeclSet Qid -> OpMappingSet .
16579  op genMsgMapsAux : MsgDeclSet Qid -> OpMappingSet .
16580
16581  op getOpDeclSet : Qid Module -> OpDeclSet .
16582  op getOpDeclSetAux : Qid OpDeclSet -> OpDeclSet .
16583  *** getOpDeclSet(F, U) returns the set of declarations of operators with
16584  *** name F in the unit U
16585  op getMsgDeclSet : Qid Module -> MsgDeclSet .
16586  op getMsgDeclSetAux : Qid MsgDeclSet -> MsgDeclSet .
16587  *** getMsgDeclSet(F, U) returns the set of declarations of messages with
16588  *** name F in the unit U
16589  op gTSubsortOverloadedFamilies : OpDeclSet OpDeclSet Module -> OpDeclSet .
16590  op gTSubsortOverloadedFamilies : MsgDeclSet MsgDeclSet Module -> MsgDeclSet .
16591  *** gTSubsortOverloadedFamilies returns a declaration of operator or
16592  *** message for each family of subsort-overloaded operators or messages.
16593  op selectOpDeclSet : Qid OpDeclSet -> OpDeclSet .
16594  op selectMsgDeclSet : Qid MsgDeclSet -> MsgDeclSet .
16595  *** selectOpDeclSet and selectMsgDeclSet returns, respectively, the subset
16596  *** of those declarations  of ops and msgs which name coincides with the
16597  *** qid given ar argument.
16598  op opFamilyIn : OpDecl OpDeclSet Module -> Bool .
16599  op msgFamilyIn : MsgDecl MsgDeclSet Module -> Bool .
16600  *** Check whether the family of the subsort-overloaded operator given as
16601  *** argument has already a  representative in the set of declarations given.
16602
16603  eq genOpMaps(op F to F' ., OPDS, M)
16604    = genOpMapsAux(
16605         gTSubsortOverloadedFamilies(selectOpDeclSet(F, OPDS), none, M),
16606         F') .
16607
16608  eq genMsgMaps(msg F to F' ., MDS, M)
16609    = genMsgMapsAux(
16610         gTSubsortOverloadedFamilies(selectMsgDeclSet(F, MDS), none, M),
16611         F') .
16612
16613  eq selectOpDeclSet(F, ((op F' : TyL -> Ty [AtS] .) OPDS))
16614    = ((if F == F'
16615        then (op F' : TyL -> Ty [AtS] .)
16616        else none
16617        fi)
16618       selectOpDeclSet(F, OPDS)) .
16619  eq selectOpDeclSet(F, none) = none .
16620
16621  eq selectMsgDeclSet(F, ((msg F' : TyL -> Ty .) MDS))
16622    = ((if F == F'
16623        then (msg F' : TyL -> Ty .)
16624        else none
16625        fi)
16626       selectMsgDeclSet(F, MDS)) .
16627  eq selectMsgDeclSet(F, none) = none .
16628
16629  eq genOpMapsAux(op F : TyL -> Ty [AtS] . OPDS, F')
16630    = (op F : TyL -> Ty to F' . genOpMapsAux(OPDS, F')) .
16631  eq genOpMapsAux(none, F') = none .
16632
16633  eq genMsgMapsAux(((msg F : TyL -> Ty .) MDS), F')
16634    = (msg F : TyL -> Ty to F' . genMsgMapsAux(MDS, F')) .
16635  eq genMsgMapsAux(none, F') = none .
16636
16637  eq gTSubsortOverloadedFamilies((OPD OPDS), OPDS', M)
16638    = if opFamilyIn(OPD, OPDS', M)
16639      then gTSubsortOverloadedFamilies(OPDS, OPDS', M)
16640      else gTSubsortOverloadedFamilies(OPDS, (OPD OPDS'), M)
16641      fi .
16642  eq gTSubsortOverloadedFamilies(none, OPDS, M) = OPDS .
16643
16644  eq gTSubsortOverloadedFamilies((MD MDS), MDS', M)
16645    = if msgFamilyIn(MD, MDS', M)
16646      then gTSubsortOverloadedFamilies(MDS, MDS', M)
16647      else gTSubsortOverloadedFamilies(MDS, (MD MDS'), M)
16648      fi .
16649  eq gTSubsortOverloadedFamilies(none, MDS, M) = MDS .
16650
16651  eq opFamilyIn(
16652       (op F : TyL -> Ty [AtS] .), ((op F' : TyL' -> Ty' [AtS] .) OPDS), M)
16653    = ((F == F') and-then sameKind(M, TyL, TyL')) or-else
16654      opFamilyIn((op F : TyL -> Ty [AtS] .), OPDS, M) .
16655  eq opFamilyIn((op F : TyL -> Ty [AtS] .), none, M) = false .
16656
16657  eq msgFamilyIn((msg F : TyL -> Ty .), ((msg F' : TyL' -> Ty' .) MDS), M)
16658    = ((F == F') and-then sameKind(M, TyL, TyL'))
16659      or-else
16660      msgFamilyIn((msg F : TyL -> Ty .), MDS, M) .
16661  eq msgFamilyIn((msg F : TyL -> Ty .), none, M) = false .
16662
16663*** In the case of views, the \texttt{parseDecl} function takes the term
16664*** representing the corresponding declaration and a preview in which the
16665*** declarations are introduced. Note that in the case of views, the approach
16666*** followed in the evaluation is somewhat different. The only predeclarations
16667*** in a preview correspond to the term premaps of sort \texttt{PreTermMap},
16668*** for which, in addition to solving the bubbles in them, we have to convert
16669*** them into term maps of sort \texttt{TermMap} associating to them the set
16670*** of declarations of variables in the view which are used in them (see
16671*** Section~\ref{view-processing}).
16672
16673*** The function \texttt{parseDecl} for declarations in views takes then the
16674*** term representing such declaration and a preview in which the result of
16675*** adding the declaration will be returned. To be able to generate the sTS
16676*** of equivalent operator and message maps as indicated above, the function
16677*** takes also as parameters the sTS of declarations of operators and messages
16678*** in the theory part of the source theory of the view in question, and the
16679*** signature of such theory to make the necessary sort comparisons.
16680
16681  op parseDecl : Term PreView OpDeclSet MsgDeclSet Module -> PreView .
16682
16683  eq parseDecl('sort_to_.[T, T'], PV, OPDS, MDS, M)
16684    = addMaps(sort parseType(T) to parseType(T') ., PV) .
16685
16686  eq parseDecl('class_to_.[T, T'], PV, OPDS, MDS, M)
16687    = addMaps(class parseType(T) to parseType(T') ., PV) .
16688
16689  eq parseDecl('vars_:_.['neTokenList[T], T'], PV, OPDS, MDS, M)
16690    = addVars(parseVars(downQidList(T), parseType(T')), PV).
16691  eq parseDecl('var_:_.['neTokenList[T], T'], PV, OPDS, MDS, M)
16692    = addVars(parseVars(downQidList(T), parseType(T')), PV).
16693
16694  eq parseDecl('op_to`term_.[T, T'], PV, OPDS, MDS, M)
16695    = addMaps(op_to`term_.(T, T'), PV) .
16696
16697  eq parseDecl('op_to_.['token[T], 'token[T']], PV, OPDS, MDS, M)
16698    = addMaps(genOpMaps(op downQid(T) to downQid(T') ., OPDS, M), PV) .
16699  eq parseDecl('op_:_->_to_.['token[T], T', T'', 'token[T3]], PV, OPDS, MDS, M)
16700    = addMaps(op downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3) ., PV) .
16701  eq parseDecl('op_:`->_to_.['token[T], T', 'token[T'']], PV, OPDS, MDS, M)
16702    = addMaps(op downQid(T) : nil -> parseType(T') to downQid(T'') ., PV) .
16703
16704  eq parseDecl('msg_to_.['token[T], 'token[T']], PV, OPDS, MDS, M)
16705    = addMaps(genMsgMaps(msg downQid(T) to downQid(T') ., MDS, M), PV) .
16706  eq parseDecl('msg_:_->_to_.['token[T], T', T'', 'token[T3]], PV, OPDS, MDS, M)
16707    = addMaps(msg downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3) ., PV) .
16708  eq parseDecl('msg_:`->_to_.['token[T], T', 'token[T'']], PV, OPDS, MDS, M)
16709    = addMaps(msg downQid(T) : nil -> parseType(T') to downQid(T'') ., PV) .
16710
16711  eq parseDecl('attr_._to_.[T', 'token[T], 'token[T'']], PV, OPDS, MDS, M)
16712    = addMaps(attr downQid(T) . parseType(T') to downQid(T'') ., PV) .
16713
16714  eq parseDecl(T, PV, OPDS, MDS, M) = PV [owise] .
16715endfm
16716
16717*******************************************************************************
16718
16719***
16720*** 8.2 Meta Pretty Printing
16721***
16722
16723*** To be able to show to the user the modules, theories, views, and terms
16724*** resulting from the different commands, the built-in function
16725*** \texttt{meta-pretty-print} is extended in the modules in this section to
16726*** deal with units and views.
16727
16728***
16729*** 8.2.1 Meta Pretty Printing of Declarations
16730***
16731
16732*** The predefined function \texttt{meta-pretty-print} is extended in the
16733*** following module \texttt{DECL-META-PRETTY-PRINT} to handle any declaration
16734*** that can appear in a unit. Note that the following
16735*** \texttt{meta-pretty-print} functions, as the built-in one, return a list
16736*** terms---such as equations, rules,* operator declarations with an identity
16737*** attribute, etc.---they have been defined with a term of operator
16738*** declarations with an identity attribute, etc.---they have been defined
16739*** with a term of sort \texttt{Module} as argument. In the other cases the
16740*** module is not necessary.
16741
16742fmod DECL-META-PRETTY-PRINT is
16743  pr EXT-DECL .
16744  pr O-O-DECL .
16745  pr UNIT .
16746  pr CONVERSION .
16747  pr INT-LIST .
16748  pr VIEW-EXPR-TO-QID .
16749
16750  op eMetaPrettyPrint : Sort -> QidList .
16751  op eMetaPrettyPrint : SortSet -> QidList .
16752  op eMetaPrettyPrint : TypeList -> QidList .
16753  op eMetaPrettyPrint : SubsortDeclSet -> QidList .
16754  op eMetaPrettyPrint : ClassDeclSet -> QidList .
16755  op eMetaPrettyPrint : SubclassDeclSet -> QidList .
16756  op eMetaPrettyPrint : Module OpDeclSet -> QidList .
16757  op eMetaPrettyPrintVars : OpDeclSet -> QidList .
16758  op eMetaPrettyPrint : MsgDeclSet -> QidList .
16759  op eMetaPrettyPrint : Module MembAxSet -> QidList .
16760  op eMetaPrettyPrint : Module EquationSet -> QidList .
16761  op eMetaPrettyPrint : Module RuleSet -> QidList .
16762  op eMetaPrettyPrint : Module Condition -> QidList .
16763  op eMetaPrettyPrint : Module Term -> QidList .
16764
16765  ---- error handling
16766---(
16767  eq metaPrettyPrint(M, T, POS:PrintOptionSet)
16768    = 'Module getName(M) 'contains 'errors. .
16769---)
16770
16771  eq eMetaPrettyPrint(U, T) = metaPrettyPrint(U, T) . ----, mixfix flat format) .
16772  eq eMetaPrettyPrint(U, qidError(QIL)) = QIL .
16773  eq eMetaPrettyPrint(qidError(QIL)) = QIL .
16774
16775  op eMetaPrettyPrint : Module AttrSet -> QidList .
16776  op eMetaPrettyPrint : IntList -> QidList .
16777  op eMetaPrettyPrint : AttrDeclSet -> QidList .
16778  op eMetaPrettyPrint : Module HookList -> QidList .
16779
16780  vars QI QI' QI'' F V L : Qid .
16781  var  QIL : QidList .
16782  var  St : String .
16783  var  M : Module .
16784  var  U : Module .
16785  vars VE VE' : ViewExp .
16786  vars SS : SortSet .
16787  vars S S' : Sort .
16788  var  TyL : TypeList .
16789  var  Ty : Type .
16790  var  SSDS : SubsortDeclSet .
16791  var  OPDS : OpDeclSet .
16792  var  AtS : AttrSet .
16793  var  MAS : MembAxSet .
16794  var  EqS : EquationSet .
16795  var  RlS : RuleSet .
16796  var  Hk : Hook .
16797  var  HkL : HookList .
16798  var  I : Int .
16799  var  NL : IntList .
16800  vars T T' T'' T3 : Term .
16801  var  CDS : ClassDeclSet .
16802  var  SCDS : SubclassDeclSet .
16803  var  MDS : MsgDeclSet .
16804  var  ADS : AttrDeclSet .
16805  var  Cond : Condition .
16806  var  K : Kind .
16807
16808  --- eq eMetaPrettyPrint(Ty) = Ty .
16809
16810  eq eMetaPrettyPrint(S)
16811    = if getPars(S) == empty
16812      then S
16813      else getName(S) '`{ parameterList2QidList(getPars(S)) '`}
16814      fi .
16815  eq eMetaPrettyPrint(K) = '`[ eMetaPrettyPrint(getSort(K)) '`] .
16816
16817  eq eMetaPrettyPrint((S ; SS))
16818    = (eMetaPrettyPrint(S) eMetaPrettyPrint(SS))
16819    [owise] .
16820  eq eMetaPrettyPrint((none).SortSet) = nil .
16821
16822  eq eMetaPrettyPrint(Ty TyL)
16823    = eMetaPrettyPrint(Ty) eMetaPrettyPrint(TyL)
16824    [owise] .
16825  eq eMetaPrettyPrint((nil).TypeList) = nil .
16826
16827  eq eMetaPrettyPrint(((subsort S < S' .) SSDS))
16828    = ('\s '\s '\b
16829       'subsort '\o eMetaPrettyPrint(S) '\b
16830           '< '\o eMetaPrettyPrint(S') '\b '. '\o '\n
16831       eMetaPrettyPrint(SSDS)) .
16832  eq eMetaPrettyPrint((none).SubsortDeclSet) = nil .
16833
16834  eq eMetaPrettyPrint(M, ((op F : TyL -> Ty [none] .) OPDS))
16835    = ('\s '\s
16836       '\b 'op '\o F '\b ': '\o eMetaPrettyPrint(TyL)
16837       '\b '-> '\o eMetaPrettyPrint(Ty) '\b '. '\o '\n
16838       eMetaPrettyPrint(M, OPDS)) .
16839  eq eMetaPrettyPrint(M, ((op F : TyL -> Ty [AtS] .) OPDS))
16840    = ('\s '\s
16841       '\b 'op '\o F '\b ': '\o eMetaPrettyPrint(TyL)
16842       '\b '-> '\o eMetaPrettyPrint(Ty) '\n
16843       '\s '\s '\s '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o '\n
16844       eMetaPrettyPrint(M, OPDS))
16845    [owise] .
16846  eq eMetaPrettyPrint(M, (none).OpDeclSet)  = nil .
16847
16848  eq eMetaPrettyPrintVars((op F : nil -> Ty [none] .) OPDS)
16849    = ('\s '\s '\b 'var '\o F '\b ': '\o eMetaPrettyPrint(Ty) '\b '. '\o '\n
16850       eMetaPrettyPrintVars(OPDS)) .
16851  eq eMetaPrettyPrintVars((none).OpDeclSet)  = nil .
16852
16853  eq eMetaPrettyPrint(M, (mb T : S [none] .) MAS)
16854    = ('\s '\s '\b 'mb '\o eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(S) '\b '. '\o '\n
16855       eMetaPrettyPrint(M, MAS)) .
16856  eq eMetaPrettyPrint(M, (mb T : S [AtS] .) MAS)
16857    = ('\s '\s '\b 'mb '\o eMetaPrettyPrint(M, T)
16858                   '\b ': '\o eMetaPrettyPrint(S)
16859               '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o '\n
16860       eMetaPrettyPrint(M, MAS))
16861    [owise] .
16862  eq eMetaPrettyPrint(M, (cmb T : S if Cond [none] .) MAS)
16863    = ('\s '\s '\b 'cmb '\o eMetaPrettyPrint(M, T)
16864                   '\b ': '\o eMetaPrettyPrint(S) '\n
16865       '\s '\s '\s '\s '\b 'if '\o eMetaPrettyPrint(M, Cond) '\b '. '\o '\n
16866       eMetaPrettyPrint(M, MAS)) .
16867  eq eMetaPrettyPrint(M, (cmb T : S if Cond [AtS] .) MAS)
16868    = ('\s '\s '\b 'cmb '\o eMetaPrettyPrint(M, T)
16869                   '\b ': '\o eMetaPrettyPrint(S) '\n
16870       '\s '\s '\s '\s '\b 'if '\o eMetaPrettyPrint(M, Cond)
16871           '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o '\n
16872       eMetaPrettyPrint(M, MAS))
16873    [owise] .
16874  eq eMetaPrettyPrint(M, (none).MembAxSet) = nil .
16875
16876  eq eMetaPrettyPrint(M, ((eq T = T' [none] .) EqS))
16877    = ('\s '\s '\b 'eq '\s '\o eMetaPrettyPrint(M, T) '\n
16878       '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T') '\b '\s '. '\n
16879       '\o
16880       eMetaPrettyPrint(M, EqS)) .
16881  eq eMetaPrettyPrint(M, ((eq T = T' [AtS] .) EqS))
16882    = ('\s '\s '\b 'eq '\s '\o eMetaPrettyPrint(M, T) '\n
16883       '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T')
16884           '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o '\n
16885       eMetaPrettyPrint(M, EqS))
16886    [owise] .
16887  eq eMetaPrettyPrint(M, ((ceq T = T' if Cond [none] .) EqS))
16888    = ('\s '\s '\b 'ceq '\s '\o eMetaPrettyPrint(M, T) '\n
16889       '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T') '\n
16890       '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) '\b '\s '. '\o '\n
16891       eMetaPrettyPrint(M, EqS)) .
16892  eq eMetaPrettyPrint(M, ((ceq T = T' if Cond [AtS] .) EqS))
16893    = ('\s '\s '\b 'ceq '\s '\o eMetaPrettyPrint(M, T) '\n
16894       '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T') '\n
16895       '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond)
16896           '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o '\n
16897       eMetaPrettyPrint(M, EqS))
16898    [owise] .
16899  eq eMetaPrettyPrint(M, (none).EquationSet) = nil .
16900
16901  eq eMetaPrettyPrint(M, ((rl T => T' [none] .) RlS))
16902    = ('\s '\s '\b 'rl '\s '\o eMetaPrettyPrint(M, T) '\n
16903       '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') '\b '\s '. '\n '\o
16904       eMetaPrettyPrint(M, RlS)) .
16905  eq eMetaPrettyPrint(M, ((rl T => T' [AtS] .) RlS))
16906    = ('\s '\s '\b 'rl '\s '\o eMetaPrettyPrint(M, T) '\n
16907       '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T')
16908           '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o '\n
16909       eMetaPrettyPrint(M, RlS))
16910    [owise] .
16911  eq eMetaPrettyPrint(M, ((crl T => T' if Cond [none] .) RlS))
16912    = ('\s '\s '\b 'crl '\s '\o eMetaPrettyPrint(M, T) '\n
16913       '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') '\n
16914       '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) '\b '\s '. '\o '\n
16915       eMetaPrettyPrint(M, RlS)) .
16916  eq eMetaPrettyPrint(M, ((crl T => T' if Cond [AtS] .) RlS))
16917    = ('\s '\s '\b 'crl '\s '\o eMetaPrettyPrint(M, T) '\n
16918       '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') '\n
16919       '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond)
16920           '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o '\n
16921       eMetaPrettyPrint(M, RlS))
16922    [owise] .
16923  eq eMetaPrettyPrint(M, (none).RuleSet) = nil .
16924
16925  eq eMetaPrettyPrint(M, T = T' /\ Cond)
16926    = (eMetaPrettyPrint(M, T) '\b '= '\o eMetaPrettyPrint(M, T') '\b
16927      '/\ '\o eMetaPrettyPrint(M, Cond))
16928    [owise] .
16929  eq eMetaPrettyPrint(M, T : S /\ Cond)
16930    = (eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(S) '\b
16931      '/\ '\o eMetaPrettyPrint(M, Cond))
16932    [owise] .
16933  eq eMetaPrettyPrint(M, T := T' /\ Cond)
16934    = (eMetaPrettyPrint(M, T) '\b ':= '\o eMetaPrettyPrint(M, T') '\b
16935      '/\ '\o eMetaPrettyPrint(M, Cond))
16936    [owise] .
16937  eq eMetaPrettyPrint(M, T => T' /\ Cond)
16938    = (eMetaPrettyPrint(M, T) '\b '=> '\o eMetaPrettyPrint(M, T') '\b
16939      '/\ '\o eMetaPrettyPrint(M, Cond))
16940    [owise] .
16941  eq eMetaPrettyPrint(M, T = T')
16942    = (eMetaPrettyPrint(M, T) '\b '= '\o eMetaPrettyPrint(M, T')) .
16943  eq eMetaPrettyPrint(M, T : S)
16944    = (eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(S)) .
16945  eq eMetaPrettyPrint(M, T := T')
16946    = (eMetaPrettyPrint(M, T) '\b ':= '\o eMetaPrettyPrint(M, T')) .
16947  eq eMetaPrettyPrint(M, T => T')
16948    = (eMetaPrettyPrint(M, T) '\b '=> '\o eMetaPrettyPrint(M, T')) .
16949  eq eMetaPrettyPrint(M, (nil).EqCondition) = nil .
16950
16951  eq eMetaPrettyPrint(M, (assoc AtS))
16952    = ('\b 'assoc '\o eMetaPrettyPrint(M, AtS)) .
16953  eq eMetaPrettyPrint(M, (comm AtS))
16954    = ('\b 'comm '\o eMetaPrettyPrint(M, AtS)) .
16955  eq eMetaPrettyPrint(M, (memo AtS))
16956    = ('\b 'memo '\o eMetaPrettyPrint(M, AtS)) .
16957  eq eMetaPrettyPrint(M, (idem AtS))
16958    = ('\b 'idem '\o eMetaPrettyPrint(M, AtS)) .
16959  eq eMetaPrettyPrint(M, (id(T) AtS))
16960    = ('\b 'id: '\o eMetaPrettyPrint(M, T) eMetaPrettyPrint(M, AtS)) .
16961  eq eMetaPrettyPrint(M, (right-id(T) AtS))
16962    = ('\b 'right 'id: '\o eMetaPrettyPrint(M, T) eMetaPrettyPrint(M, AtS)) .
16963  eq eMetaPrettyPrint(M, (left-id(T) AtS))
16964    = ('\b 'left 'id: '\o eMetaPrettyPrint(M, T) eMetaPrettyPrint(M, AtS)) .
16965  eq eMetaPrettyPrint(M, (poly(NL) AtS))
16966    = ('\b 'poly '`( '\o eMetaPrettyPrint(NL) '\b '`)
16967       '\o eMetaPrettyPrint(M, AtS)) .
16968  eq eMetaPrettyPrint(M, (strat(NL) AtS))
16969    = ('\b 'strat '`( '\o eMetaPrettyPrint(NL) '\b '`)
16970       '\o eMetaPrettyPrint(M, AtS)) .
16971  eq eMetaPrettyPrint(M, (memo AtS))
16972    = ('\b 'memo '\o eMetaPrettyPrint(M, AtS)) .
16973  eq eMetaPrettyPrint(M, (prec(I) AtS))
16974    = ('\b 'prec '\o eMetaPrettyPrint(I) eMetaPrettyPrint(M, AtS)) .
16975  eq eMetaPrettyPrint(M, (gather(QIL) AtS))
16976    = ('\b 'gather '\o '`( QIL '`) eMetaPrettyPrint(M, AtS)) .
16977  eq eMetaPrettyPrint(M, (format(QIL) AtS))
16978    = ('\b 'format '\o '`( QIL '`) eMetaPrettyPrint(M, AtS)) .
16979  eq eMetaPrettyPrint(M, (ctor AtS))
16980    = ('\b 'ctor '\o eMetaPrettyPrint(M, AtS)) .
16981  eq eMetaPrettyPrint(M, (frozen(NL) AtS))
16982    = ('\b 'frozen '`( '\o eMetaPrettyPrint(NL) '\b '`)
16983       '\o eMetaPrettyPrint(M, AtS)) .
16984  eq eMetaPrettyPrint(M, (iter AtS))
16985    = ('\b 'iter '\o eMetaPrettyPrint(M, AtS)) .
16986  eq eMetaPrettyPrint(M, (special(HkL) AtS))
16987    = ('\b 'special '`( '\o eMetaPrettyPrint(M, HkL) '\b '`)
16988       '\o eMetaPrettyPrint(M, AtS)) .
16989  eq eMetaPrettyPrint(M, (config AtS))
16990    = ('\b 'config '\o eMetaPrettyPrint(M, AtS)) .
16991  eq eMetaPrettyPrint(M, (object AtS))
16992    = ('\b 'object '\o eMetaPrettyPrint(M, AtS)) .
16993  eq eMetaPrettyPrint(M, (msg AtS))
16994    = ('\b 'msg '\o eMetaPrettyPrint(M, AtS)) .
16995
16996  eq eMetaPrettyPrint(M, (label(QI) AtS))
16997    = ('\b 'label '\o QI '\b '\o eMetaPrettyPrint(M, AtS)) .
16998  eq eMetaPrettyPrint(M, (metadata(St) AtS))
16999    = ('\b 'metadata '\o qid("\"" + St + "\"") '\b
17000       '\o eMetaPrettyPrint(M, AtS)) .
17001  eq eMetaPrettyPrint(M, (nonexec AtS))
17002    = ('\b 'nonexec '\o eMetaPrettyPrint(M, AtS)) .
17003  eq eMetaPrettyPrint(M, (variant AtS))
17004    = ('\b 'variant '\o eMetaPrettyPrint(M, AtS)) .
17005  eq eMetaPrettyPrint(M, (owise AtS))
17006    = ('\b 'owise '\o eMetaPrettyPrint(M, AtS)) .
17007  eq eMetaPrettyPrint(M, (print(QIL) AtS))
17008    = ('\b 'print QIL '\o eMetaPrettyPrint(M, AtS)) .
17009
17010  eq eMetaPrettyPrint(M, (none).AttrSet) = nil .
17011
17012  ceq eMetaPrettyPrint(M, (Hk HkL))
17013    = (eMetaPrettyPrint(M, Hk) eMetaPrettyPrint(M, HkL))
17014    if HkL =/= nil .
17015  eq eMetaPrettyPrint(M, id-hook(QI, nil)) = ('\b 'id-hook '\o QI) .
17016  eq eMetaPrettyPrint(M, id-hook(QI, QIL))
17017    = ('\b 'id-hook '\o QI '\b '`( '\o QIL '\b '`) '\o )
17018    [owise] .
17019  eq eMetaPrettyPrint(M, op-hook(QI, QI', nil, QI''))
17020    = ('\b 'op-hook '\o QI '\b '`( '\o QI' ': '~> QI'' '\b '`) '\o) .
17021  eq eMetaPrettyPrint(M, op-hook(QI, QI', QIL, QI''))
17022    = ('\b 'op-hook '\o QI '\b '`( '\o QI' ': QIL '~> QI'' '\b '`) '\o)
17023    [owise] .
17024  eq eMetaPrettyPrint(M, term-hook(QI, T))
17025    = ('\b 'term-hook '\o QI '\b '`( '\o eMetaPrettyPrint(M, T) '\b '`) '\o) .
17026
17027  eq eMetaPrettyPrint((I NL)) = (qid(string(I, 10)) eMetaPrettyPrint(NL)) .
17028  eq eMetaPrettyPrint((nil).NatList) = nil .
17029
17030  eq eMetaPrettyPrint((class S | ADS .) CDS)
17031    = ((if ADS == none
17032        then ('\s '\s '\b 'class '\o eMetaPrettyPrint(S) '\b '. '\o '\n)
17033        else ('\s '\s '\b 'class '\o eMetaPrettyPrint(S) '\b '| '\o eMetaPrettyPrint(ADS) '\b '. '\o '\n)
17034        fi)
17035       eMetaPrettyPrint(CDS)) .
17036  eq eMetaPrettyPrint((none).ClassDeclSet) = nil .
17037
17038  eq eMetaPrettyPrint((subclass S < S' .) SCDS)
17039    = ('\s '\s '\b 'subclass '\o eMetaPrettyPrint(S) '\b
17040           '< '\o eMetaPrettyPrint(S') '\b '. '\o '\n
17041       eMetaPrettyPrint(SCDS)) .
17042  eq eMetaPrettyPrint((none).SubclassDeclSet) = nil .
17043
17044  eq eMetaPrettyPrint((msg F : TyL -> Ty .) MDS)
17045    = ('\s '\s '\b 'msg '\o F '\b ': '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty) '\b '. '\o '\n
17046       eMetaPrettyPrint(MDS)) .
17047  eq eMetaPrettyPrint((none).MsgDeclSet) = nil .
17048
17049  eq eMetaPrettyPrint(((attr F : S), ADS))
17050    = (F '\b ': '\o eMetaPrettyPrint(S) '\b '`, '\o '\s eMetaPrettyPrint(ADS))
17051    [owise] .
17052  eq eMetaPrettyPrint((attr F : S)) = (F '\b ': '\o eMetaPrettyPrint(S)) .
17053  eq eMetaPrettyPrint((none).AttrDeclSet) = nil .
17054
17055endfm
17056
17057*******************************************************************************
17058
17059***
17060*** 8.2.2 Meta Pretty Printing of Modules
17061***
17062
17063*** In the following module, the \texttt{meta-pretty-print} function is
17064*** defined on sort \texttt{Module}.
17065
17066fmod UNIT-META-PRETTY-PRINT is
17067  pr UNIT .
17068  pr RENAMING-EXPR-EVALUATION .
17069  pr DECL-META-PRETTY-PRINT .
17070
17071  op eMetaPrettyPrint : Module Module -> QidList .
17072
17073  op eMetaPrettyPrint : Module Module -> QidList .
17074  op eMetaPrettyPrint : Header -> QidList .
17075  op eMetaPrettyPrint : ParameterDeclList -> QidList .
17076  op eMetaPrettyPrint : ImportList -> QidList .
17077
17078  var  M : Module .
17079  vars QI F F' L L' : Qid .
17080  var  QIL : QidList .
17081  var  ME : ModuleExpression .
17082  vars S S' : Sort .
17083  var  Ty : Type .
17084  var  TyL : TypeList .
17085  var  SS : SortSet .
17086  var  PD : ParameterDecl .
17087  var  PDL : ParameterDeclList .
17088  vars IL IL' : ImportList .
17089  var  SSDS : SubsortDeclSet .
17090  var  OPDS : OpDeclSet .
17091  var  MAS : MembAxSet .
17092  var  EqS : EquationSet .
17093  var  RlS : RuleSet .
17094  var  CDS : ClassDeclSet .
17095  var  SCDS : SubclassDeclSet .
17096  var  MDS : MsgDeclSet .
17097  var  U : Module .
17098  var  AtS : AttrSet .
17099  var  MN : ModuleName .
17100
17101  ceq eMetaPrettyPrint(ME)
17102    = if QI == '`) or QI == '`] or QI == '`}
17103      then QIL QI '\s
17104      else QIL QI
17105      fi
17106    if QIL QI := header2QidList(ME) .
17107
17108  eq eMetaPrettyPrint(W:[Module], unitError(QIL)) = QIL .
17109  eq eMetaPrettyPrint(unitError(QIL), noModule) = QIL .
17110  eq eMetaPrettyPrint(noModule, noModule) = nil .
17111  eq eMetaPrettyPrint(M, mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm)
17112    = ('\b
17113       'mod '\o eMetaPrettyPrint(ME) '\b 'is '\o '\n
17114          eMetaPrettyPrint(IL)
17115          (if SS == none
17116           then nil
17117           else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n)
17118           fi)
17119          eMetaPrettyPrint(SSDS)
17120          eMetaPrettyPrint(M, OPDS)
17121          eMetaPrettyPrint(M, MAS)
17122          eMetaPrettyPrint(M, EqS)
17123          eMetaPrettyPrint(M, RlS)
17124       '\b 'endm '\o '\n) .
17125  eq eMetaPrettyPrint(M, mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm)
17126    = ('\b
17127       'mod '\o eMetaPrettyPrint(ME) (if PDL == nil
17128                                      then nil
17129                                      else '`{ eMetaPrettyPrint(PDL) '`} '\s
17130                                      fi) '\b 'is '\o '\n
17131          eMetaPrettyPrint(IL)
17132          (if SS == none
17133           then nil
17134           else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n)
17135           fi)
17136          eMetaPrettyPrint(SSDS)
17137          eMetaPrettyPrint(M, OPDS)
17138          eMetaPrettyPrint(M, MAS)
17139          eMetaPrettyPrint(M, EqS)
17140          eMetaPrettyPrint(M, RlS)
17141       '\b 'endm '\o '\n) .
17142  eq eMetaPrettyPrint(M, th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth)
17143    = ('\b
17144       'th '\o eMetaPrettyPrint(MN) '\b 'is '\o '\n
17145          eMetaPrettyPrint(IL)
17146          (if SS == none
17147           then nil
17148           else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n)
17149           fi)
17150          eMetaPrettyPrint(SSDS)
17151          eMetaPrettyPrint(M, OPDS)
17152          eMetaPrettyPrint(M, MAS)
17153          eMetaPrettyPrint(M, EqS)
17154          eMetaPrettyPrint(M, RlS)
17155       '\b 'endth '\o '\n) .
17156  eq eMetaPrettyPrint(M, fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm)
17157    = ('\b
17158       'fmod '\o eMetaPrettyPrint(ME) '\b 'is '\o '\n
17159           eMetaPrettyPrint(IL)
17160           (if SS == none
17161            then nil
17162            else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n)
17163            fi)
17164           eMetaPrettyPrint(SSDS)
17165           eMetaPrettyPrint(M, OPDS)
17166           eMetaPrettyPrint(M, MAS)
17167           eMetaPrettyPrint(M, EqS)
17168       '\b 'endfm '\o '\n) .
17169  eq eMetaPrettyPrint(M, fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm)
17170    = ('\b
17171       'fmod '\o eMetaPrettyPrint(ME) (if PDL == nil
17172                                       then nil
17173                                       else '`{ eMetaPrettyPrint(PDL) '`} '\s
17174                                       fi) '\b 'is '\o '\n
17175           eMetaPrettyPrint(IL)
17176           (if SS == none
17177            then nil
17178            else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n)
17179            fi)
17180           eMetaPrettyPrint(SSDS)
17181           eMetaPrettyPrint(M, OPDS)
17182           eMetaPrettyPrint(M, MAS)
17183           eMetaPrettyPrint(M, EqS)
17184       '\b 'endfm '\o '\n) .
17185  eq eMetaPrettyPrint(M, fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth)
17186    = ('\b
17187       'fth '\o eMetaPrettyPrint(MN) '\b 'is '\o '\n
17188          eMetaPrettyPrint(IL)
17189          (if SS == none
17190           then nil
17191           else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n)
17192           fi)
17193          eMetaPrettyPrint(SSDS)
17194          eMetaPrettyPrint(M, OPDS)
17195          eMetaPrettyPrint(M, MAS)
17196          eMetaPrettyPrint(M, EqS)
17197       '\b 'endfth '\o '\n) .
17198  eq eMetaPrettyPrint(M,
17199       omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
17200    = ('\b
17201       'omod '\o eMetaPrettyPrint(ME) '\b 'is '\o '\n
17202          eMetaPrettyPrint(IL)
17203          (if SS == none
17204           then nil
17205           else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n )
17206           fi)
17207          eMetaPrettyPrint(SSDS) eMetaPrettyPrint(CDS)
17208          eMetaPrettyPrint(SCDS) eMetaPrettyPrint(M, OPDS)
17209          eMetaPrettyPrint(MDS) eMetaPrettyPrint(M, MAS)
17210          eMetaPrettyPrint(M, EqS) eMetaPrettyPrint(M, RlS)
17211       '\b 'endom '\o '\n) .
17212  eq eMetaPrettyPrint(M, omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom)
17213    = ('\b
17214       'omod '\o eMetaPrettyPrint(ME) (if PDL == nil
17215                                       then nil
17216                                       else ('`{ eMetaPrettyPrint(PDL) '`} '\s)
17217                                       fi) '\b 'is '\o '\n
17218          eMetaPrettyPrint(IL)
17219          (if SS == none
17220           then nil
17221           else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n )
17222           fi)
17223          eMetaPrettyPrint(SSDS) eMetaPrettyPrint(CDS)
17224          eMetaPrettyPrint(SCDS) eMetaPrettyPrint(M, OPDS)
17225          eMetaPrettyPrint(MDS) eMetaPrettyPrint(M, MAS)
17226          eMetaPrettyPrint(M, EqS) eMetaPrettyPrint(M, RlS)
17227       '\b 'endom '\o '\n) .
17228  eq eMetaPrettyPrint(M, oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth)
17229    = ('\b
17230       'oth '\o eMetaPrettyPrint(MN) '\b 'is '\o '\n
17231          eMetaPrettyPrint(IL)
17232          (if SS == none
17233           then nil
17234           else ('\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o '\n )
17235           fi)
17236          eMetaPrettyPrint(SSDS) eMetaPrettyPrint(CDS)
17237          eMetaPrettyPrint(SCDS) eMetaPrettyPrint(M, OPDS)
17238          eMetaPrettyPrint(MDS) eMetaPrettyPrint(M, MAS)
17239          eMetaPrettyPrint(M, EqS) eMetaPrettyPrint(M, RlS) '\n '\b
17240       'endoth '\o '\n) .
17241
17242  eq eMetaPrettyPrint((including ME .) IL)
17243    = ('\s '\s '\b 'including '\o eMetaPrettyPrint(ME) '\b '. '\o '\n
17244       eMetaPrettyPrint(IL)) .
17245  eq eMetaPrettyPrint((extending ME .) IL)
17246    = ('\s '\s '\b 'extending '\o eMetaPrettyPrint(ME) '\b '. '\o '\n
17247       eMetaPrettyPrint(IL)) .
17248  eq eMetaPrettyPrint((protecting ME .) IL)
17249    = ('\s '\s '\b 'protecting '\o eMetaPrettyPrint(ME) '\b '. '\o '\n
17250       eMetaPrettyPrint(IL)) .
17251  eq eMetaPrettyPrint((protecting pd(QI :: ME) .) IL)
17252    = eMetaPrettyPrint(IL) .
17253  eq eMetaPrettyPrint((nil).ImportList) = nil .
17254
17255  eq eMetaPrettyPrint((QI :: ME, PDL))
17256    = (QI '::  eMetaPrettyPrint(ME) '`, eMetaPrettyPrint(PDL))
17257    [owise] .
17258  eq eMetaPrettyPrint((QI :: ME)) = (QI '::  eMetaPrettyPrint(ME)) .
17259  eq eMetaPrettyPrint((nil).ParameterDeclList) = (nil).QidList .
17260
17261  op eMetaPrettyPrint : ModuleExpression -> QidList .
17262  eq eMetaPrettyPrint(QI + ME:ModuleExpression)
17263    = QI '+ eMetaPrettyPrint(ME:ModuleExpression) .
17264  eq eMetaPrettyPrint(QI * (RnS:RenamingSet))
17265    = QI '* '\s '`( renamingSet2QidList(RnS:RenamingSet) '`) .
17266  eq eMetaPrettyPrint(pd(PD)) = eMetaPrettyPrint(PD) .
17267
17268  op renamingSet2QidList : RenamingSet -> QidList .
17269  eq renamingSet2QidList(((op F to F' [AtS]), RS:RenamingSet))
17270    = if AtS == none
17271      then ('op F 'to F' '`, '\s renamingSet2QidList(RS:RenamingSet))
17272      else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`] '`, '\s
17273            renamingSet2QidList(RS:RenamingSet))
17274      fi
17275    [owise] .
17276  eq renamingSet2QidList((op F to F' [AtS]))
17277    = if AtS == none
17278      then ('op F 'to F')
17279      else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`])
17280      fi .
17281  eq renamingSet2QidList(((op F : TyL -> Ty to F' [AtS]), RS:RenamingSet))
17282    = if AtS == none
17283      then ('op F ': typeList2QidList(TyL) '-> Ty 'to F' '`,
17284            '\s renamingSet2QidList(RS:RenamingSet))
17285      else ('op F ': typeList2QidList(TyL) '-> Ty 'to F'
17286            '`[ attrSet2QidList(AtS) '`] '`,
17287            '\s renamingSet2QidList(RS:RenamingSet))
17288      fi
17289    [owise] .
17290  eq renamingSet2QidList((op F : TyL -> Ty to F' [AtS]))
17291    = if AtS == none
17292      then ('op F ': typeList2QidList(TyL) '-> Ty 'to F')
17293      else ('op F ': typeList2QidList(TyL) '-> Ty 'to F'
17294            '`[ attrSet2QidList(AtS) '`])
17295      fi .
17296  eq renamingSet2QidList(((sort S to S'), RS:RenamingSet))
17297    = ('sort S 'to S' '`, '\s
17298       renamingSet2QidList(RS:RenamingSet))
17299    [owise] .
17300  eq renamingSet2QidList((sort S to S')) = ('sort S 'to S') .
17301
17302  eq renamingSet2QidList(((label L to L'), RS:RenamingSet))
17303    = ('label L 'to L' '`, '\s renamingSet2QidList(RS:RenamingSet))
17304    [owise] .
17305  eq renamingSet2QidList((label L to L')) = ('label L 'to L') .
17306endfm
17307
17308*******************************************************************************
17309
17310*** The function \texttt{meta-pretty-print} on units is defined recursively,
17311*** calling the \texttt{meta-pretty-print} functions for the different
17312*** declarations in the unit defined in module \texttt{DECL-META-PRETTY-PRINT}.
17313
17314***
17315*** 8.2.3 Meta Pretty Printing of Maps and Views
17316***
17317
17318*** We define in the following module the function \texttt{meta-pretty-print}
17319*** on maps.
17320
17321fmod MAP-SET-META-PRETTY-PRINT is
17322  pr DECL-META-PRETTY-PRINT .
17323  pr FMAP .
17324  pr UNIT .
17325
17326  op eMetaPrettyPrint : RenamingSet -> QidList .
17327
17328  var  MAP : Renaming .
17329  var  MAPS : RenamingSet .
17330  vars QI QI' F F' L L' : Qid .
17331  var  AtS : AttrSet .
17332  vars S S' : Sort .
17333  var  Ty : Type .
17334  var  TyL : TypeList .
17335
17336  eq eMetaPrettyPrint((MAP, MAPS))
17337    = (eMetaPrettyPrint(MAP) '`, '\s '\s eMetaPrettyPrint(MAPS))
17338    [owise] .
17339  eq eMetaPrettyPrint((none).RenamingSet) = nil .
17340
17341  eq eMetaPrettyPrint(op F to F' [AtS])
17342    = if AtS == none
17343      then ('\b 'op '\o F '\b 'to '\o F')
17344      else ('\b 'op F '\b 'to '\o F' '\b
17345            '`[ '\o eMetaPrettyPrint(noModule, AtS) '\b '`] '\o)
17346           *** In a map there should not be attributes requiring a module
17347      fi .
17348  eq eMetaPrettyPrint(op F : TyL -> Ty to F' [AtS])
17349    = if AtS == none
17350      then ('\b 'op '\o F '\b ':
17351            '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty)
17352            '\b 'to '\o F')
17353      else ('\b 'op '\o F '\b ':
17354            '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty)
17355            '\b 'to '\o F'
17356            '\b '`[ '\o eMetaPrettyPrint(noModule, AtS) '\b '`] '\o)
17357           *** In a map there should not be attributes requiring a module
17358      fi .
17359  eq eMetaPrettyPrint(sort S to S')
17360    = ('\b 'sort '\o eMetaPrettyPrint(S) '\b 'to '\o eMetaPrettyPrint(S')) .
17361  eq eMetaPrettyPrint(label L to L') = ('\b 'label '\o L '\b 'to '\o L') .
17362  eq eMetaPrettyPrint(class S to S')
17363    = ('\b 'class '\o eMetaPrettyPrint(S) '\b 'to '\o eMetaPrettyPrint(S')) .
17364  eq eMetaPrettyPrint(attr QI . S to QI')
17365    = ('\b 'attr '\o eMetaPrettyPrint(S) '\b '. '\o QI '\b 'to '\o QI') .
17366  eq eMetaPrettyPrint(msg F to F') = ('\b 'msg '\o F '\b 'to '\o F') .
17367  eq eMetaPrettyPrint(msg F : TyL -> Ty to F')
17368    = ('\b 'msg '\o F '\b ':
17369       '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty)
17370       '\b 'to '\o F') .
17371
17372endfm
17373
17374*******************************************************************************
17375
17376*** Finally, in the \texttt{VIEW-META-PRETTY-PRINT} module, the
17377*** \texttt{meta-pretty-print} function is defined on views.
17378
17379
17380fmod VIEW-META-PRETTY-PRINT is
17381  pr DATABASE .
17382  pr MAP-SET-META-PRETTY-PRINT .
17383  pr RENAMING-SET-APPL-ON-UNIT .
17384  pr UNIT-META-PRETTY-PRINT .
17385
17386  op eMetaPrettyPrint : Database View -> QidList .
17387  op eMetaPrettyPrint : ViewExp -> QidList .
17388  op eMetaPrettyPrint : ModuleExpression ModuleExpression Database SortMappingSet SortMappingSet OpMappingSet -> QidList .
17389  op eMetaPrettyPrint : ModuleExpression ModuleExpression Database OpMappingSet SortMappingSet OpMappingSet -> QidList .
17390  op eMetaPrettyPrint : SortMapping -> QidList .
17391  op eMetaPrettyPrint : OpMapping -> QidList .
17392
17393  vars QI QI' F F' : Qid .
17394  vars S S' : Sort .
17395  var  TyL : TypeList .
17396  var  Ty : Type .
17397  var  QIL : QidList .
17398  var  DB : Database .
17399  vars ME ME' : ModuleExpression .
17400  var  SM : SortMapping .
17401  var  OM : OpMapping .
17402  vars SMS SMS' : SortMappingSet .
17403  vars OMS OMS' : OpMappingSet .
17404  vars T T' : Term .
17405  var  PDL : ParameterDeclList .
17406  vars VE VE' : ViewExp .
17407  var  DT : Default{Term} .
17408
17409  ceq eMetaPrettyPrint(DB, view VE from ME to ME' is SMS OMS endv)
17410    = ('\b 'view '\o
17411                 QIL QI
17412                 if QI == '`) then '\s else nil fi
17413              '\b 'from '\o eMetaPrettyPrint(ME)
17414              '\b 'to '\o eMetaPrettyPrint(ME') '\b 'is '\o '\n
17415       if SMS =/= none then '\s '\s eMetaPrettyPrint(ME, ME', DB, SMS, SMS, OMS) else nil fi
17416       if OMS =/= none then '\s '\s eMetaPrettyPrint(ME, ME', DB, OMS, SMS, OMS) else nil fi
17417       '\b 'endv '\o '\n)
17418    if QIL QI := eMetaPrettyPrint(VE) .
17419  ceq eMetaPrettyPrint(DB, view VE{PDL} from ME to ME' is SMS OMS endv)
17420    = ('\b 'view '\o
17421                 QIL QI
17422                 (if PDL == nil
17423                  then if QI == '`) then '\s else nil fi
17424                  else '`{ eMetaPrettyPrint(PDL) '`} '\s
17425                  fi)
17426              '\b 'from '\o eMetaPrettyPrint(ME)
17427              '\b 'to '\o eMetaPrettyPrint(ME') '\b 'is '\o '\n
17428       if OMS =/= none then '\s '\s eMetaPrettyPrint(ME, ME', DB, SMS, SMS, OMS) else nil fi
17429       if OMS =/= none then '\s '\s eMetaPrettyPrint(ME, ME', DB, OMS, SMS, OMS) else nil fi
17430       '\b 'endv '\o '\n )
17431    if QIL QI := eMetaPrettyPrint(VE) .
17432  eq eMetaPrettyPrint(DB, viewError(QIL)) = QIL .
17433
17434  ceq eMetaPrettyPrint(QI) = QI if not QI :: Type .
17435  ceq eMetaPrettyPrint(((VE, VE')))
17436    = eMetaPrettyPrint(VE) '`, '\s eMetaPrettyPrint(VE')
17437    if VE =/= nil /\ VE' =/= nil .
17438  eq eMetaPrettyPrint(QI{VE}) = QI '`{ eMetaPrettyPrint(VE) '`} '\s .
17439
17440 ceq eMetaPrettyPrint(ME, ME', DB, SM SMS, SMS', OMS')
17441    = (eMetaPrettyPrint(ME, ME', DB, SM, SMS', OMS') '\n
17442       '\s '\s eMetaPrettyPrint(ME, ME', DB, SMS, SMS', OMS'))
17443    if SMS =/= none .
17444 ceq eMetaPrettyPrint(ME, ME', DB, OM OMS, SMS', OMS')
17445    = (eMetaPrettyPrint(ME, ME', DB, OM, SMS', OMS') '\n
17446       '\s '\s eMetaPrettyPrint(ME, ME', DB, OMS, SMS', OMS'))
17447    if OMS =/= none .
17448  eq eMetaPrettyPrint(ME, ME', DB, (none).SortMappingSet, SMS, OMS) = nil .
17449  eq eMetaPrettyPrint(ME, ME', DB, (none).OpMappingSet, SMS, OMS) = nil .
17450
17451  eq eMetaPrettyPrint(ME, ME', DB, op_to`term_.(T, T'), SMS, OMS)
17452    = ('\b 'op '\o eMetaPrettyPrint(getFlatModule(ME, DB), T) '\b 'to
17453               'term '\o eMetaPrettyPrint(getFlatModule(ME', DB), T') '\b '. '\o) .
17454
17455  eq eMetaPrettyPrint(ME, ME', DB, op_to`term_.(T, T'), SMS, OMS)
17456    = ('op eMetaPrettyPrint(T) '\b 'to 'term '\o eMetaPrettyPrint(T') '. '\n) .
17457  eq eMetaPrettyPrint(ME, ME', DB, op F to F' ., SMS, OMS)
17458    = ('\b 'op '\o F '\b 'to '\o F' '. '\n) .
17459  eq eMetaPrettyPrint(ME, ME', DB, op F : TyL -> Ty to F' ., SMS, OMS)
17460    = ('\b 'op '\o F '\b ':
17461       '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty)
17462       '\b 'to '\o F' '. '\n) .
17463  eq eMetaPrettyPrint(ME, ME', DB, sort S to S' ., SMS, OMS)
17464    = ('\b 'sort '\o eMetaPrettyPrint(S) '\b 'to '\o eMetaPrettyPrint(S') '. '\n) .
17465  eq eMetaPrettyPrint(ME, ME', DB, class S to S' ., SMS, OMS)
17466    = ('\b 'class '\o eMetaPrettyPrint(S) '\b 'to '\o eMetaPrettyPrint(S') '. '\n) .
17467  eq eMetaPrettyPrint(ME, ME', DB, attr QI . S to QI' ., SMS, OMS)
17468    = ('\b 'attr '\o eMetaPrettyPrint(S) '\b '. '\o QI '\b 'to '\o QI' '. '\n) .
17469  eq eMetaPrettyPrint(ME, ME', DB, msg F to F' ., SMS, OMS)
17470    = ('\b 'msg '\o F '\b 'to '\o F' '. '\n) .
17471  eq eMetaPrettyPrint(ME, ME', DB, msg F : TyL -> Ty to F' ., SMS, OMS)
17472    = ('\b 'msg '\o F '\b ':
17473       '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty)
17474       '\b 'to '\o F' '. '\n) .
17475endfm
17476
17477*******************************************************************************
17478
17479***
17480*** 8.3 Input Processing
17481***
17482
17483*** The processing functions presented in the following modules are in charge
17484*** of taking each term generated by the \texttt{metaParse} function and,
17485*** after transforming it into an element of the data types \texttt{Module} or
17486*** \texttt{View}, or generating some output, returning the database resulting
17487*** from introducing in it such a term. We shall see in
17488*** Section~\ref{database-handling} how the appropriate function is called
17489*** after having performed a first analysis of the term, in which it is
17490*** detected whether the input corresponds to a unit, view, or command. In the
17491*** cases of units and views the processing is quite similar. After a
17492*** preprocessing of the term, the function \texttt{parseDecl} is called with
17493*** each of the subterms representing declarations, resulting in units or
17494*** views with the parsed declarations in it.
17495
17496***
17497*** 8.3.1 Module Processing
17498***
17499
17500*** The processing of a term resulting from the parsing of some input
17501*** corresponding to a unit is accomplished by the \texttt{procModule} function.
17502*** This function takes as arguments a term of sort \texttt{Term}, which
17503*** represents some preunit, and a database. The function then enters into the
17504*** given database the unit obtained from the transformation of such term
17505*** into a term of sort \texttt{Module}.
17506
17507fmod UNIT-PROCESSING is
17508  pr DATABASE .
17509  pr UNIT-DECL-PARSING .
17510  pr EVALUATION .
17511  pr RENAMING-SET-APPL-ON-UNIT .
17512  pr META-FULL-MAUDE-SIGN .
17513  pr MOD-EXP-PARSING .
17514
17515  vars QI F X : Qid .
17516  var  M : Module .
17517  vars PU PU' U U' : Module .
17518  vars DB DB' : Database .
17519  vars T T' T'' T3 : Term .
17520  var  TL : TermList .
17521  vars PL PL' PL'' : ParameterList .
17522  var  PDL : ParameterDeclList .
17523  var  IL IL' : ImportList .
17524  var  ME : ModuleExpression .
17525  var  S : Sort .
17526  var  SS : SortSet .
17527  var  ME' : ModuleExpression .
17528  var  VMAPS : RenamingSet .
17529  var  B : Bool .
17530  var  VDS : OpDeclSet .
17531  var  QIL : QidList .
17532  var  PDR : ParseDeclResult .
17533  var  DT : Default{Term} .
17534
17535*** The \texttt{parseParList} takes a term representing a list of parameters
17536*** and returns the corresponding list.
17537
17538  op parseParList : Term -> ParameterDeclList .
17539  eq parseParList('_::_['token[T], T']) = downQid(T) :: parseModExp(T') .
17540  eq parseParList('_`,_[T, T']) = (parseParList(T), parseParList(T')) .
17541
17542*** All the operators declared as constructors of sort \texttt{PreModule} in
17543*** the signature of Full Maude, given in Appendix~\ref{signature-full-maude},
17544*** are declared with two arguments, namely, the name, or name and interface,
17545*** of the unit, and the list of declarations of such units. The function
17546*** \texttt{procModule3} is called with the term corresponding to the name, or
17547*** name and interface, of the module as first argument, the term corresponding
17548*** to the set of declarations as second argument, and an empty module of the
17549*** appropriate type, in which the different declarations will be accumulated,
17550*** as third argument.
17551
17552*** The task of the function \texttt{procModule4} is then to make a second
17553*** level parsing of the input, building up, simultaneously, the preunit
17554*** represented in the term passed as argument, and the unit resulting from the
17555*** declarations without bubbles. This unit without bubbles will be used by the
17556*** \texttt{evalPreModule} function to build the signature with which to
17557*** analyze the bubbles in the preunit (see Section~\ref{evaluation}).
17558
17559*** The case of parameterized modules requires a special treatment of the
17560*** parameters. These parameters are evaluated and are added as submodules in
17561*** the appropriate way.
17562
17563*** When the last declaration is parsed, the function \texttt{evalPreModule} is
17564*** called with the preunit (the top module with bubbles) as first argument,
17565*** the empty copy of it as second argument, the top module without bubbles as
17566*** third argument, and the database.
17567
17568*** Note that the \texttt{procModule} function adds a declaration importing the
17569*** module \texttt{CONFIGURATION+}, presented in
17570*** Section~\ref{non-built-in-predefined}, to the object-oriented modules, and
17571*** that \texttt{procModule4} adds a declaration importing the built-in module
17572*** \texttt{BOOL} to all modules.
17573
17574  op procModule : Term Database -> Database .
17575  ***  moved to MOD-EXPR-EVAL to solve dependency
17576  ***  op procModule : Qid Database -> Database .
17577  op procModule2 : Term Term Database -> Database .
17578  op procModule2 : Term Database -> Database .
17579  op procModule3 : Term Term Term Module Database -> Database .
17580  op procModule3 : Term Term Module Database -> Database .
17581  op procModule4 : Term Term Module Module OpDeclSet Database -> Database .
17582  op procModule4 : Term Module Module OpDeclSet Database -> Database .
17583
17584  *** When recompiling a module, it's called with a Qid, and it's
17585  *** not reentered into the database.
17586
17587  ceq procModule(QI, DB)
17588    = if DT == null
17589      then evalModule(U, VDS, DB)
17590      else procModule2(DT, DB)
17591      fi
17592    if < DT ; VDS ; U > := getTermModule(QI, DB) .
17593  eq procModule(T, DB) = procModule2(T, T, DB) .
17594
17595  *** procModule2 just calls procModule3 with the name and the declarations of
17596  *** the module, and an empty unit of the right type.
17597
17598  eq procModule2(T, 'fmod_is_endfm[T', T''], DB)
17599    = procModule3(T, T', T'', emptyFModule, DB) .
17600  eq procModule2(T, 'obj_is_endo[T', T''], DB)
17601    = procModule3(T, T', T'', emptyFModule, DB) .
17602  eq procModule2(T, 'obj_is_jbo[T', T''], DB)
17603    = procModule3(T, T', T'', emptyFModule, DB) .
17604  eq procModule2(T, 'mod_is_endm[T', T''], DB)
17605    = procModule3(T, T', T'', emptySModule, DB) .
17606  eq procModule2(T, 'omod_is_endom[T', T''], DB)
17607    = procModule3(T, T', T'',
17608        addImports((including 'CONFIGURATION . including 'CONFIGURATION+ .),
17609          emptyOModule),
17610        DB) .
17611  eq procModule2(T, 'fth_is_endfth[T', T''], DB)
17612    = procModule3(T, T', T'', emptyFTheory, DB) .
17613  eq procModule2(T, 'th_is_endth[T', T''], DB)
17614    = procModule3(T, T', T'', emptySTheory, DB) .
17615  eq procModule2(T, 'oth_is_endoth[T', T''], DB)
17616    = procModule3(T, T', T'',
17617        addImports((including 'CONFIGURATION . including 'CONFIGURATION+ .),
17618          emptyOTheory),
17619        DB) .
17620
17621  eq procModule2('fmod_is_endfm[T, T'], DB)
17622    = procModule3(T, T', emptyFModule, DB) .
17623  eq procModule2('obj_is_endo[T, T'], DB)
17624    = procModule3(T, T', emptyFModule, DB) .
17625  eq procModule2('obj_is_jbo[T, T'], DB)
17626    = procModule3(T, T', emptyFModule, DB) .
17627  eq procModule2('mod_is_endm[T, T'], DB)
17628    = procModule3(T, T', emptySModule, DB) .
17629  eq procModule2('omod_is_endom[T, T'], DB)
17630    = procModule3(T, T',
17631        addImports((including 'CONFIGURATION+ .),
17632          emptyOModule),
17633        DB) .
17634  eq procModule2('fth_is_endfth[T, T'], DB)
17635    = procModule3(T, T', emptyFTheory, DB) .
17636  eq procModule2('th_is_endth[T, T'], DB)
17637    = procModule3(T, T', emptySTheory, DB) .
17638  eq procModule2('oth_is_endoth[T, T'], DB)
17639    = procModule3(T, T',
17640        addImports((including 'CONFIGURATION+ .),
17641          emptyOTheory),
17642        DB) .
17643
17644  *** procModule3 evaluates the name of the module and calls procModule4
17645  *** with the declarations, two empty units (one to contain the declarations
17646  *** with bubbles and another one the declarations without bubbles), and
17647  *** a set of op decls initialy empty in which to store the variables
17648
17649  ceq procModule3(T, 'token[T'], T'', U, DB)
17650    = procModule4(T, T'', setName(U, QI), setName(U, QI), none, DB)
17651    if QI := downQid(T') .
17652  ceq procModule3(T, '_`{_`}['token[T'], T''], T3, U, DB)
17653    = procModule4(T, T3, setPars(setName(U, QI), parseParList(T'')),
17654        setName(U, QI), none, DB)
17655    if QI := downQid(T') .
17656
17657  ceq procModule3('token[T], T', U, DB)
17658    = procModule4(T', setName(U, QI), setName(U, QI), none, DB)
17659    if QI := downQid(T) .
17660  ceq procModule3('_`{_`}['token[T], T'], T'', U, DB)
17661    = procModule4(T'', setPars(setName(U, QI), parseParList(T')),
17662        setName(U, QI), none, DB)
17663    if QI := downQid(T) .
17664
17665  *** procModule4 parses one by one each of the declarations in the module.
17666  *** Note that is parseDecl that adds the parsed declaration to the right
17667  *** place. When it is done, it calls evalPreModule with the resulting
17668  *** preModule-unit-vars triple.
17669
17670  ceq procModule4(T, '__[T', T''], PU, U, VDS, DB)
17671    = procModule4(T, T'', preModule(PDR), unit(PDR), vars(PDR), DB)
17672    if PDR := parseDecl(T', PU, U, VDS) .
17673  ceq procModule4(T, F[TL], PU, U, VDS, DB)
17674    = evalPreModule(preModule(PDR), unit(PDR), vars(PDR),
17675        insTermModule(getName(U), T, DB))
17676    if F =/= '__
17677       /\ PDR := parseDecl(F[TL], PU, U, VDS) .
17678  eq procModule4(T, T', unitError(QIL), V:[Module], V:[OpDeclSet], DB)
17679    = warning(DB, QIL) .
17680  eq procModule4(T, T', V:[Module], unitError(QIL), V:[OpDeclSet], DB)
17681    = warning(DB, QIL) .
17682  eq procModule4(T, T', V:[Module], V':[Module], opDeclError(QIL), DB)
17683    = warning(DB, QIL) .
17684  eq procModule4(T, F[TL], PU, U, VDS, DB)
17685    = warning(DB,'Error: 'no 'parse 'for F 'declaration)
17686    [owise] .
17687
17688  ceq procModule4('__[T, T'], PU, U, VDS, DB)
17689    = procModule4(T', preModule(PDR), unit(PDR), vars(PDR), DB)
17690    if PDR := parseDecl(T, PU, U, VDS) .
17691  ceq procModule4(F[TL], PU, U, VDS, DB)
17692    = evalPreModule(preModule(PDR), unit(PDR), vars(PDR), DB)
17693    if F =/= '__
17694       /\ PDR := parseDecl(F[TL], PU, U, VDS) .
17695  eq procModule4(T, unitError(QIL), U, VDS, DB) = warning(DB, QIL) .
17696  eq procModule4(T, PU, unitError(QIL), VDS, DB) = warning(DB, QIL) .
17697  eq procModule4(T, PU, U, opDeclError(QIL), DB) = warning(DB, QIL) .
17698  eq procModule4(F[TL], PU, U, VDS, DB)
17699    = warning(DB,'Error: 'no 'parse 'for F 'declaration)
17700    [owise] .
17701
17702endfm
17703
17704*******************************************************************************
17705
17706***
17707*** 8.3.2 View Processing
17708***
17709
17710*** A similar process is followed for views. Note that in case of operator
17711*** maps going to derived terms we have bubbles, which will have to be treated
17712*** using the signatures of the appropriate modules.
17713
17714fmod VIEW-PROCESSING is
17715  pr UNIT-PROCESSING .
17716  pr VIEW-DECL-PARSING .
17717  pr VIEW-BUBBLE-PARSING .
17718
17719  vars QI X F : Qid .
17720  var  QIL : QidList .
17721  vars T T' T'' T3 T4 : Term .
17722  var  M : Module .
17723  var  VE : ViewExp .
17724  var  V : View .
17725  vars PV PV' : PreView .
17726  vars ME ME' : ModuleExpression .
17727  vars DB DB' : Database .
17728  vars OPDS VDS VDS' VDS'' : OpDeclSet .
17729  var  MDS : MsgDeclSet .
17730  var  TL : TermList .
17731  vars PDL PDL' : ParameterDeclList .
17732  var  H : Header .
17733  var  IL : ImportList .
17734  var  SMS : SortMappingSet .
17735  var  OMS : OpMappingSet .
17736
17737*** As the functions \texttt{getThSorts} and \texttt{getThClasses}
17738*** presented in Section~\ref{instantiation}, the functions
17739*** \texttt{getThOpDeclSet} and \texttt{getThMsgDeclSet} return, respectively,
17740*** the set of declarations of operators, and the set of declarations of
17741*** messages in the theory part of the structure of the module given as
17742*** argument.
17743
17744  op getThOpDeclSet : Header Database -> OpDeclSet .
17745  op getThMsgDeclSet : Header Database -> MsgDeclSet .
17746
17747  op getThOpDeclSetAux : ImportList Database -> OpDeclSet .
17748  op getThMsgDeclSetAux : ImportList Database -> MsgDeclSet .
17749
17750  eq getThOpDeclSet(ME, DB)
17751    = if theory(getTopModule(ME, DB))
17752      then (getThOpDeclSetAux(getImports(getTopModule(ME, DB)), DB)
17753            getOps(getTopModule(ME, DB)))
17754      else none
17755      fi .
17756
17757  eq getThOpDeclSetAux(((including ME .) IL), DB)
17758    = (getThOpDeclSet(ME, DB) getThOpDeclSetAux(IL, DB)) .
17759  eq getThOpDeclSetAux(((extending ME .) IL), DB)
17760    = (getThOpDeclSet(ME, DB) getThOpDeclSetAux(IL, DB)) .
17761  eq getThOpDeclSetAux(((protecting ME .) IL), DB)
17762    = (getThOpDeclSet(ME, DB) getThOpDeclSetAux(IL, DB)) .
17763  eq getThOpDeclSetAux(nil, DB) = none .
17764
17765  eq getThMsgDeclSet(ME, DB)
17766    = if theory(getTopModule(ME, DB))
17767      then (getThMsgDeclSetAux(getImports(getTopModule(ME, DB)), DB)
17768            getMsgs(getTopModule(ME, DB)))
17769      else none
17770      fi .
17771
17772  eq getThMsgDeclSetAux(((including ME .) IL), DB)
17773    = (getThMsgDeclSet(ME, DB) getThMsgDeclSetAux(IL, DB)) .
17774  eq getThMsgDeclSetAux(((extending ME .) IL), DB)
17775    = (getThMsgDeclSet(ME, DB) getThMsgDeclSetAux(IL, DB)) .
17776  eq getThMsgDeclSetAux(((protecting ME .) IL), DB)
17777    = (getThMsgDeclSet(ME, DB) getThMsgDeclSetAux(IL, DB)) .
17778  eq getThMsgDeclSetAux(nil, DB) = none .
17779
17780*** The processing of terms representing previews accomplished by the function
17781*** \texttt{procView} is quite similar to the one accomplished by
17782*** \texttt{procModule} on terms representing preunits. The algorithms followed
17783*** are also quite similar. Both proceed recursively on the list of
17784*** declarations, accumulating them in a preunit or in a preview.
17785
17786*** The solving of bubbles in views requires the signatures of the source and
17787*** target units extended, respectively, with the declarations of variables in
17788*** the view and with the mappings of these declarations. As we shall see in
17789*** Section~\ref{databaseADT}, the signatures of the built-in modules are not
17790*** accesible at the metalevel, and thus built-in modules cannot be used
17791*** directly as arguments of built-in functions. Thus, to be able to use them
17792*** as targTS of views, a `dummy' module is created importing the
17793*** corresponding predefined module. The source and target module expressions
17794*** of the view are evaluated before the view processing itself starts.
17795
17796*** As we saw in Section~\ref{view-decl-parsing}, parsing of terms representing
17797*** operator and message maps requires the set of operator and message
17798*** declarations in the theory part of the source theory.
17799
17800  op procPars : ParameterDeclList Database -> Database .
17801
17802  eq procPars((X :: ME, PDL), DB)
17803    = procPars(PDL, createCopy((X :: ME), database(evalModExp(ME, DB)))) .
17804  eq procPars((nil).ParameterDeclList, DB) = DB .
17805
17806  op procView : Term Database -> Database .
17807  op procView2 : Term Database -> Database .
17808  op procView : Term PreView Database -> Database .
17809  op procViewAux : Term PreView OpDeclSet MsgDeclSet Module Database -> Database .
17810
17811  eq procView(QI, DB)
17812    = procView2(getTermView(QI, DB), DB) .
17813
17814  eq procView2('view_from_to_is_endv['token[T], T', T'', T3], DB)
17815    = procView(T3,
17816          emptyPreView(downQid(T), parseModExp(T'), parseModExp(T'')),
17817          DB) .
17818  eq procView2('view_from_to_is_endv['_`{_`}['token[T], T'], T'', T3, T4], DB)
17819    = procView(T4,
17820        setPars(
17821          emptyPreView(downQid(T), parseModExp(T''), parseModExp(T3)),
17822          parseParList(T')),
17823        procPars(parseParList(T'), DB)) .
17824
17825  eq procView('view_from_to_is_endv['token[T], T', T'', T3], DB)
17826    = procView(T3,
17827        emptyPreView(downQid(T), parseModExp(T'), parseModExp(T'')),
17828          insertTermView(downQid(T),
17829            'view_from_to_is_endv['token[T], T', T'', T3], DB)) .
17830  eq procView('view_from_to_is_endv['_`{_`}['token[T], T'], T'', T3, T4], DB)
17831    = procView(T4,
17832        setPars(
17833          emptyPreView(downQid(T), parseModExp(T''), parseModExp(T3)),
17834          parseParList(T')),
17835        procPars(parseParList(T'),
17836          insertTermView(downQid(T),
17837            'view_from_to_is_endv['_`{_`}['token[T], T'], T'', T3, T4],
17838            DB))) .
17839
17840  ceq procView(V, DB)
17841    = insertView(V, DB')
17842    if DB' := database(evalModExp(getFrom(V), nil, database(evalModExp(getTo(V), nil, DB)))) .
17843
17844  ceq procView(T, PV, DB)
17845    = procViewAux(T, PV,
17846        getThOpDeclSet(ME, DB'),
17847        getThMsgDeclSet(ME, DB'),
17848        getFlatModule(ME, DB'),
17849        DB')
17850    if preview_from_to_is___endpv(VE, ME, ME', none, none, none) := PV
17851    /\ DB' := database(evalModExp(ME', nil, database(evalModExp(ME, nil, DB)))) .
17852  ceq procView(T, PV, DB)
17853    = procViewAux(T, PV,
17854        getThOpDeclSet(ME, DB':[Database]),
17855        getThMsgDeclSet(ME, DB':[Database]),
17856        getFlatModule(ME, DB':[Database]),
17857        DB':[Database])
17858    if preview_from_to_is___endpv(VE{PDL}, ME, ME', none, none, none) := PV
17859    /\ DB':[Database] := database(evalModExp(ME', PDL, database(evalModExp(ME, PDL, DB)))) .
17860
17861  eq procViewAux('none.ViewDeclSet, preview_from_to_is___endpv(VE{PDL}, ME, ME', VDS, SMS, OMS), OPDS, MDS, M, DB)
17862    = insertView(view VE{PDL} from ME to ME' is none none endv, DB) .
17863  eq procViewAux('none.ViewDeclSet, preview_from_to_is___endpv(VE, ME, ME', VDS, SMS, OMS), OPDS, MDS, M, DB)
17864    = insertView(view VE from ME to ME' is none none endv, DB) .
17865  eq procViewAux('__[T, T'], PV, OPDS, MDS, M, DB)
17866  *** - OPDS and MDS are, respectively, the set of operation and
17867  ***   message declarations in the theory part of the source.
17868  *** - M is the signature of the source theory.
17869    = procViewAux(T', parseDecl(T, PV, OPDS, MDS, M), OPDS, MDS, M, DB) .
17870  ceq procViewAux(F[TL], PV, OPDS, MDS, M, DB)
17871    = insertView(
17872        view VE{PDL} from ME to ME' is
17873          SMS
17874          solveBubbles(
17875            OMS,
17876            VDS, VDS',
17877            addOps(VDS, M),
17878            addOps(VDS', getFlatModule(ME', DB)))
17879        endv,
17880        DB)
17881    if F =/= '__
17882       /\ preview_from_to_is___endpv(VE{PDL}, ME, ME', VDS, SMS, OMS) := parseDecl(F[TL], PV, OPDS, MDS, M)
17883       /\ VDS' := applyMapsToOps(maps2rens(SMS), none, VDS, M) .
17884  ceq procViewAux(F[TL], PV, OPDS, MDS, M, DB)
17885    = insertView(
17886        view VE from ME to ME' is
17887          SMS
17888          solveBubbles(
17889            OMS,
17890            VDS, VDS',
17891            addOps(VDS, M),
17892            addOps(VDS', getFlatModule(ME', DB)))
17893        endv,
17894        DB)
17895    if F =/= '__
17896       /\ preview_from_to_is___endpv(VE, ME, ME', VDS, SMS, OMS) := parseDecl(F[TL], PV, OPDS, MDS, M)
17897       /\ VDS' := applyMapsToOps(maps2rens(SMS), none, VDS, M) .
17898  eq procViewAux(T, PV, OPDS, MDS, unitError(QIL), DB) = warning(DB, QIL) .
17899endfm
17900
17901*******************************************************************************
17902
17903***
17904*** 8.3.3 Command Processing
17905***
17906
17907*** The function \texttt{procCommand} only handles the \texttt{reduce},
17908*** \texttt{rewrite}, and \texttt{down} commands. The other commands are
17909*** directly evaluated by the rules for the top-level handling of the
17910*** database (see Section~\ref{database-handling}). The \texttt{procCommand}
17911*** function takes a term, which represents one of these commands, the name of
17912*** the default module, and a database. The result is a list of quoted
17913*** identifiers representing the result of the evaluation of the command that
17914*** will be placed in the read-eval-print loop to be printed in the terminal.
17915
17916*** The \texttt{reduce} and \texttt{rewrite} commands are basically evaluated
17917*** calling the built-in functions \texttt{metaReduce} and
17918*** \texttt{metaRewrite}, respectively. These functions are called with the
17919*** appropriate modules. In the case of commands in which an explicit module
17920*** is not specified the default module is used.
17921
17922*** The preparation of the output for these functions becomes more complex
17923*** when the \texttt{down} command is used. To deal with the \texttt{down}
17924*** command, an auxiliary function \texttt{procCommand2} is introduced,
17925*** returning the term resulting from the evaluation of the command.
17926
17927fmod COMMAND-PROCESSING is
17928  pr AX-COHERENCE-COMPLETION .
17929  pr UNIT-PROCESSING .
17930  pr UNIT-META-PRETTY-PRINT .
17931  inc (2TUPLE * (op `(_`,_`) to <<_;_>>,
17932                 op p1_ to getDatabase,
17933                 op p2_ to getQidList)) {Database, QidList} .
17934  pr META-FULL-MAUDE-SIGN .
17935  pr META-NARROWING-SEARCH * (op addOps to addOpsSE, op addEqs to addEqsSE, op addSorts to addSortsSE) .
17936
17937  eq getDatabase(<< DB ; qidError(QIL) >>) = warning(DB, QIL) .
17938  eq getQidList(<< DB ; qidError(QIL) >>) = QIL .
17939
17940  op {_,_} : Term Type ~> ResultPair [ctor] .
17941  op {_,_,_} : Term Type Substitution ~> ResultTriple [ctor] .
17942  op {_,_,_,_} : Term Type Substitution Context ~> Result4Tuple [ctor] .
17943  op {_,_} : Substitution Context ~> MatchPair [ctor] .
17944
17945*** projection functions (from prelude.maude)
17946  op getTerm : ResultPair ~> Term .
17947  eq getTerm({T:[Term], T':[Type]}) = T:[Term] .
17948  op getType : ResultPair ~> Type .
17949  eq getType({T:[Term], T':[Type]}) = T':[Type] .
17950
17951  op getTerm : ResultTriple ~> Term .
17952  eq getTerm({T:[Term], T':[Type], S:[Substitution]}) = T:[Term] .
17953  op getType : ResultTriple ~> Type .
17954  eq getType({T:[Term], T':[Type], S:[Substitution]}) = T':[Type] .
17955  op gTSubstitution : ResultTriple ~> Substitution .
17956  eq gTSubstitution({T:[Term], T':[Type], S:[Substitution]})
17957    = S:[Substitution] .
17958
17959  op getTerm : Result4Tuple ~> Term .
17960  eq getTerm({T:[Term], T':[Type], S:[Substitution], C:[Context]}) = T:[Term] .
17961  op getType : Result4Tuple ~> Type .
17962  eq getType({T:[Term], T':[Type], S:[Substitution], C:[Context]}) = T':[Type] .
17963  op gTSubstitution : Result4Tuple ~> Substitution .
17964  eq gTSubstitution({T:[Term], T':[Type], S:[Substitution], C:[Context]})
17965    = S:[Substitution] .
17966  op getContext : Result4Tuple ~> Context .
17967  eq getContext({T:[Term], T':[Type], S:[Substitution], C:[Context]})
17968    = C:[Context] .
17969
17970  op gTSubstitution : MatchPair ~> Substitution .
17971  eq gTSubstitution({S:[Substitution], C:[Context]}) = S:[Substitution] .
17972  op getContext : MatchPair ~> Context .
17973  eq getContext({S:[Substitution], C:[Context]}) = C:[Context] .
17974
17975  vars T T' T'' T''' OT : Term .
17976  var  TL : TermList .
17977  vars DB DB' DB'' : Database .
17978  var  DB? : [Database] .
17979  vars M M' : Module .
17980  var  M? : [Module] .
17981  vars ME ME' : ModuleExpression .
17982  vars H H' : Header .
17983  vars MNS MNS' MNS'' MNS3 MNS4 : Set{ModuleName} .
17984  var  VE : ViewExp .
17985  var  VES : Set{ViewExp} .
17986  vars N I J : Nat .
17987  var  I? : [Nat] .
17988  vars D D' : Bound .
17989  var  D? : [Bound] .
17990  var  B : Bool .
17991  var  B? : [Bool] .
17992  vars MIS MIS' : Set{ModuleInfo} .
17993  var  VIS : Set{ViewInfo} .
17994  vars PDS PDS' : Set{ParameterDecl} .
17995  var  QIL : QidList .
17996  var  SS : SortSet .
17997  var  SSDS : SubsortDeclSet .
17998  vars VS VDS OPDS : OpDeclSet .
17999  var  OPDS? : [OpDeclSet] .
18000  var  MAS : MembAxSet .
18001  var  EqS : EquationSet .
18002  var  RlS : RuleSet .
18003  vars QI QI' F V O : Qid .
18004  var  Ct : Constant .
18005  var  IL : ImportList .
18006  var  TM : [Tuple{Term,Module,Bool,OpDeclSet,Database}] .
18007  var  TMVB : [Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}] .
18008  var  TMVBN : [Tuple{Term,Module,OpDeclSet,Bound,Nat}] .
18009  var  T? : [Term] .
18010  var  RP : [ResultPair] .
18011  var  RT : [ResultTriple] .
18012  var  Sb? : [Substitution] .
18013  var  MP? : [MatchPair] .
18014  var  CD : Condition .
18015  var  Sb : Substitution .
18016  var  UP? : [UnificationPair] .
18017  var  UP : UnificationProblem .
18018
18019----  sorts Tuple{Term,Module,Bool,OpDeclSet,Database}
18020----        Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}
18021----        Tuple{Term,Module,OpDeclSet,Bound,Nat} .
18022----  op `{_`,_`,_`,_`,_`} : Term Module Bool OpDeclSet Database
18023----       -> Tuple{Term,Module,Bool,OpDeclSet,Database} .
18024----  op `{_`,_`,_`,_`,_`,_`} : Term Module Bool OpDeclSet Bound Database
18025----       -> Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} .
18026----  op `{_`,_`,_`,_`,_`} : Term Module OpDeclSet Bound Nat
18027----       -> Tuple{Term,Module,OpDeclSet,Bound,Nat} .
18028  op tupleTMBODerror : QidList -> [Tuple{Term,Module,Bool,OpDeclSet,Database}] .
18029  op tupleTMBOBDerror : QidList -> [Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}] .
18030  op tupleTMOBNerror : QidList -> [Tuple{Term,Module,OpDeclSet,Bound,Nat}] .
18031
18032  pr 5TUPLE{Term,Module,Bool,OpDeclSet,Database}
18033       * (op ((_,_,_,_,_)) to `{_`,_`,_`,_`,_`},
18034          op p1_ to getTerm,
18035          op p2_ to getModule,
18036          op p3_ to getBool,
18037          op p4_ to getVars,
18038          op p5_ to getDatabase) .
18039  pr 6TUPLE{Term,Module,Bool,OpDeclSet,Bound,Database}
18040       * (op ((_,_,_,_,_,_)) to `{_`,_`,_`,_`,_`,_`},
18041          op p1_ to getTerm,
18042          op p2_ to getModule,
18043          op p3_ to getBool,
18044          op p4_ to getVars,
18045          op p5_ to getBound,
18046          op p6_ to getDatabase) .
18047  pr 5TUPLE{Term,Module,OpDeclSet,Bound,Nat}
18048       * (op ((_,_,_,_,_)) to `{_`,_`,_`,_`,_`},
18049          op p1_ to getTerm,
18050          op p2_ to getModule,
18051          op p3_ to getVars,
18052          op p4_ to getBound,
18053          op p5_ to getNat) .
18054
18055  op boundError  : QidList -> [Bound] .
18056----  op getTerm     : Tuple{Term,Module,Bool,OpDeclSet,Database} ~> Term .
18057----  op getModule   : Tuple{Term,Module,Bool,OpDeclSet,Database} ~> Module .
18058----  op getVars     : Tuple{Term,Module,Bool,OpDeclSet,Database} ~> OpDeclSet .
18059----  op getBool     : Tuple{Term,Module,Bool,OpDeclSet,Database} ~> Bool .
18060----  op getDatabase : Tuple{Term,Module,Bool,OpDeclSet,Database} ~> Database .
18061
18062----  op getTerm     : Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} ~> Term .
18063----  op getModule   : Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} ~> Module .
18064----  op getVars     : Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} ~> OpDeclSet .
18065----  op getBound    : Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} ~> Bound .
18066----  op getBool     : Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} ~> Bool .
18067----  op getDatabase : Tuple{Term,Module,Bool,OpDeclSet,Bound,Database} ~> Database .
18068
18069----  op getTerm     : Tuple{Term,Module,OpDeclSet,Bound,Nat} ~> Term .
18070----  op getModule   : Tuple{Term,Module,OpDeclSet,Bound,Nat} ~> Module .
18071----  op getVars     : Tuple{Term,Module,OpDeclSet,Bound,Nat} ~> OpDeclSet .
18072----  op getBound    : Tuple{Term,Module,OpDeclSet,Bound,Nat} ~> Bound .
18073----  op getNat      : Tuple{Term,Module,OpDeclSet,Bound,Nat} ~> Nat .
18074
18075----  eq {qidError(QIL), M?, B?, OPDS?, DB?} = tupleTMBODerror(QIL) .
18076----  eq {qidError(QIL), M?, B?, OPDS?, D?, DB?} = tupleTMBOBDerror(QIL) .
18077----  eq {qidError(QIL), M?, OPDS?, D?, I?} = tupleTMOBNerror(QIL) .
18078
18079  eq getTerm({T, M, B, VDS, DB}) = T .
18080  eq getTerm(tupleTMBODerror(QIL)) = qidError(QIL) .
18081  eq getModule({T, M, B, VDS, DB}) = M .
18082  eq getModule(tupleTMBODerror(QIL)) = unitError(QIL) .
18083  eq getVars({T, M, B, VDS, DB}) = VDS .
18084  eq getVars(tupleTMBODerror(QIL)) = opDeclError(QIL) .
18085  eq getBool({T, M, B, VDS, DB}) = B .
18086  eq getBool(tupleTMBODerror(QIL)) = false .
18087  eq getDatabase({T, M, B, VDS, DB}) = DB .
18088  eq getDatabase(tupleTMBODerror(QIL)) = emptyDatabase .
18089
18090  eq getTerm({T, M, B, VDS, D, DB}) = T .
18091----  eq getTerm(error(QIL)) = qidError(QIL) .
18092  eq getModule({T, M, B, VDS, D, DB}) = M .
18093----  eq getModule(error(QIL)) = unitError(QIL) .
18094  eq getVars({T, M, B, VDS, D, DB}) = VDS .
18095----  eq getVars(error(QIL)) = opDeclError(QIL) .
18096  eq getBound({T, M, B, VDS, D, DB}) = D .
18097----  eq getBound(error(QIL)) = boundError(QIL) .
18098  eq getBool({T, M, B, VDS, D, DB}) = B .
18099----  eq getBool(error(QIL)) = false .
18100  eq getDatabase({T, M, B, VDS, D, DB}) = DB .
18101----  eq getDatabase(error(QIL)) = emptyDatabase .
18102
18103  eq getTerm({T, M, VDS, D, I}) = T .
18104----  eq getTerm(error(QIL)) = qidError(QIL) .
18105  eq getModule({T, M, VDS, D, I}) = M .
18106----  eq getModule(error(QIL)) = unitError(QIL) .
18107  eq getVars({T, M, VDS, D, I}) = VDS .
18108----  eq getVars(error(QIL)) = opDeclError(QIL) .
18109  eq getBound({T, M, VDS, D, I}) = D .
18110----  eq getBound(error(QIL)) = boundError(QIL) .
18111  eq getNat({T, M, VDS, D, I}) = I .
18112----  eq getNat(error(QIL)) = numberError(QIL) .
18113
18114  ---- procLoad
18115
18116  op procLoad : Term ModuleExpression Database -> Tuple{Database,QidList} .
18117  op procLoad : Term ModuleExpression Module OpDeclSet Database -> Tuple{Database,QidList} .
18118
18119  eq procLoad(T, ME, DB)
18120   = if compiledModule(ME, DB)
18121     then procLoad(T, ME, getFlatModule(ME, DB), getVars(ME, DB), DB)
18122     else procLoad(T, modExp(evalModExp(ME, DB)),
18123               getFlatModule(modExp(evalModExp(ME, DB)),
18124                 database(evalModExp(ME, DB))),
18125               getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))),
18126               database(evalModExp(ME, DB)))
18127     fi .
18128
18129  ceq procLoad(T, ME, M, VDS, DB)
18130    = if downTerm(T:[Term], emptyFModule) =/= emptyFModule
18131      then << evalModule(downModule(T:[Term]), none, DB) ;
18132              'Introduced 'module header2Qid(getName(downModule(T:[Term]))) '\n >>
18133      else << DB ; '\r 'Error: '\o 'Incorrect 'metamodule. '\n >>
18134      fi
18135    if T:[Term] := getTerm(metaReduce(M, solveBubbles(T, M, true, VDS, DB))) .
18136
18137  ---- procCommand
18138
18139  op procCommand : Term ModuleExpression Database -> Tuple{Database,QidList} .
18140  op procCommand : Term ModuleExpression Module OpDeclSet Database -> QidList .
18141  op procDownCommand : Term ModuleExpression Database -> Tuple{Database,QidList} .
18142
18143  op procParse : ModuleExpression Module Term OpDeclSet Database -> QidList .
18144
18145  op procRed : ModuleExpression Module Term OpDeclSet Database -> QidList .
18146  op solveBubblesRed : Term Module Bool OpDeclSet Database
18147       -> [Tuple{Term,Module,Bool,OpDeclSet,Database}] .
18148  op solveBubblesRed2 : Term Database -> [Tuple{Term,Module,Bool,OpDeclSet,Database}] .
18149  op solveBubblesRed3 : Term Module ModuleExpression OpDeclSet Database -> [Tuple{Term,Module,Bool,OpDeclSet,Database}] .
18150
18151  op procRew : ModuleExpression Module Term OpDeclSet Database -> QidList .
18152  op solveBubblesRew : Term Module Bool Bound OpDeclSet Database -> [Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}] .
18153  op solveBubblesRew2 : Term Module Bool OpDeclSet Database -> [Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}] .
18154
18155  op procFrew : ModuleExpression Module Term Bound Nat OpDeclSet Database -> QidList .
18156  op solveBubblesFrew : Term Module Bool Bound Nat OpDeclSet Database -> [Tuple{Term,Module,OpDeclSet,Bound,Nat}] .
18157  op solveBubblesFrew2 : Term Module Bool Nat OpDeclSet Database -> [Tuple{Term,Module,OpDeclSet,Bound,Nat}] .
18158
18159  op procSearch : ModuleExpression Module Term Term Qid Bound Bound OpDeclSet Database -> QidList .
18160  op solveBubblesSearchL : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
18161  op solveBubblesSearchL1 : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
18162  op solveBubblesSearchR : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
18163  op solveBubblesSearchR1 : Module Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
18164  op solveBubblesSearchR2 : Module Term Term Qid Bound Bound OpDeclSet -> QidList .
18165  op procSearch2 : Module Term Term Condition Qid Bound Bound -> QidList .
18166  op procSearch3 : Module Term Term Condition Qid Bound Nat Bound -> QidList .
18167
18168  op procNarrowSearch : ModuleExpression Module Term Term Qid Bound Bound OpDeclSet Database -> QidList .
18169  op solveBubblesNarrowSearchL : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
18170  op solveBubblesNarrowSearchL1 : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
18171  op solveBubblesNarrowSearchR : Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
18172  op solveBubblesNarrowSearchR1 : Module Module Term Term Qid Bound Bound Bool OpDeclSet Database -> QidList .
18173  op solveBubblesNarrowSearchR2 : Module Term Term Qid Bound Bound OpDeclSet -> QidList .
18174  op procNarrowSearch2 : Module Term Term Condition Qid Bound Bound -> QidList .
18175  op procNarrowSearch3 : Module Nat TermList ResultTripleSet -> QidList .
18176
18177  op procMatch : ModuleExpression Module Term Term Qid Bound OpDeclSet Database -> QidList .
18178  op procMatch2 : Module Term Term Condition Qid Bound -> QidList .
18179  op procMatch3 : Module Term Term Condition Qid Bound Nat -> QidList .
18180  op solveBubblesMatch : Module Module Term Term Qid Bound Bool OpDeclSet Database ~> QidList .
18181  op solveBubblesMatch2 : Module Term Term Qid Bound OpDeclSet ~> QidList .
18182
18183  op procUnify : ModuleExpression Module Term Bound OpDeclSet Database -> QidList .
18184  op procUnify2 : ModuleExpression Module Term Bound OpDeclSet Database -> QidList .
18185  op addInfoUnify : Module -> [Module] .
18186  op parseUnify : Term OpDeclSet -> UnificationProblem .
18187  op procUnify2 : Module UnificationProblem Bound -> QidList .
18188  op eMetaPrettyPrint : Module UnificationProblem -> QidList .
18189  op procUnify3 : Module UnificationProblem Bound Nat -> QidList .
18190  op procUnify3Aux : Module UnificationPair Nat -> QidList .
18191  op unificationProblemError : QidList -> [UnificationProblem] .
18192
18193  op procIdUnify : ModuleExpression Module Term Bound OpDeclSet Database -> QidList .
18194  op procIdUnify2 : Module UnificationProblem Bound -> QidList .
18195  op procIdUnify3 : Module UnificationProblem Nat SubstitutionSet -> QidList .
18196
18197  op procVariantUnify : ModuleExpression Module Term Bound OpDeclSet Database -> QidList .
18198  op procVariantUnify2 : Module UnificationProblem Bound -> QidList .
18199  op procVariantUnify3 : Module UnificationProblem Nat SubstitutionSet -> QidList .
18200
18201  op procAsymmetricVariantUnify : ModuleExpression Module Term Bound OpDeclSet Database -> QidList .
18202  op procAsymmetricVariantUnify2 : Module UnificationProblem Bound -> QidList .
18203  op procAsymmetricVariantUnify3 : Module UnificationProblem Nat SubstitutionSet -> QidList .
18204
18205  op procGetVariants : ModuleExpression Module Term Bound OpDeclSet Database -> QidList .
18206  op parseGetVariants : Term OpDeclSet -> Term .
18207  op procGetVariants2 : Module Term Bound -> QidList .
18208  op procGetVariants3 : Module Term Nat VariantFourSet -> QidList .
18209
18210  op solveBubblesUnify : Module Term OpDeclSet ~> UnificationProblem .
18211  op solveBubblesRedUnify : Term Module Bool OpDeclSet Database
18212       -> [Tuple{Term,Module,Bool,OpDeclSet,Database}] .
18213  op solveBubblesRedUnify2 : Term Database -> [Tuple{Term,Module,Bool,OpDeclSet,Database}] .
18214  op solveBubblesRedUnify3 : Term Module ModuleExpression OpDeclSet Database
18215       -> [Tuple{Term,Module,Bool,OpDeclSet,Database}] .
18216  op procRewUnify : ModuleExpression Module Term OpDeclSet Database -> QidList .
18217  op solveBubblesRewUnify : Term Module Bool Bound OpDeclSet Database
18218       -> [Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}] .
18219  op solveBubblesRewUnify2 : Term Module Bool OpDeclSet Database
18220       -> [Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}] .
18221
18222  op eMetaPrettyPrint : Module Substitution -> QidList .
18223
18224  eq eMetaPrettyPrint(M, V <- T ; Sb:Substitution)
18225    = V '--> '\s eMetaPrettyPrint(M, T)
18226      if eMetaPrettyPrint(M, Sb:Substitution) == nil
18227      then nil
18228      else '; '\n eMetaPrettyPrint(M, Sb:Substitution)
18229      fi .
18230  eq eMetaPrettyPrint(M, (none).Substitution) = nil .
18231
18232  op procCommandUp : ModuleExpression Module Term OpDeclSet Database -> Term .
18233  op procRedUp : ModuleExpression Module Term OpDeclSet Database -> Term .
18234  op procRewUp : ModuleExpression Module Term Bound OpDeclSet Database -> Term .
18235  op procFrewUp : ModuleExpression Module Term Bound Nat OpDeclSet Database -> Term .
18236
18237*** Processing of commands.
18238
18239  ceq procDownCommand('down_:_[T, T'], ME, DB)
18240    = if T'':[Term] :: Term
18241      then << DB'' ;
18242              ('\b 'result '\o
18243               '\s eMetaPrettyPrint(leastSort(M, T'':[Term]))
18244               '\s '\b ': '\o '\n '\s '\s
18245               eMetaPrettyPrint(M, T'':[Term]) '\n) >>
18246      else << DB ; ('\r 'Error: '\o 'Incorrect 'input. '\n) >>
18247      fi
18248    if DB' := database(evalModExp(ME, DB))
18249    /\ < DB'' ; ME' > := evalModExp(parseModExp(T), DB')
18250    /\ M := getFlatModule(ME', DB'')
18251    /\ T'':[Term] := procCommandUp(ME, getFlatModule(ME, DB''), T', getVars(ME, DB''), DB'').
18252
18253  eq procCommand(T, ME, DB)
18254   = if compiledModule(ME, DB)
18255     then << DB ; procCommand(T, ME, getFlatModule(ME, DB), getVars(ME, DB), DB) >>
18256     else << database(evalModExp(ME, DB)) ;
18257             procCommand(T, modExp(evalModExp(ME, DB)),
18258               getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))),
18259               getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))),
18260               database(evalModExp(ME, DB))) >>
18261     fi
18262     [owise] .
18263
18264----  eq procCommand(T, ME, unitError(QIL), VS, DB) = qidError(QIL) .
18265  eq procCommand(T, ME, unitError(QIL), VS, DB) = QIL .
18266
18267  eq procCommand('parse_.['bubble[T]], ME, M, VS, DB)
18268   = procParse(ME, M, 'bubble[T], VS, DB) .
18269
18270  eq procCommand('reduce_.['bubble[T]], ME, M, VS, DB)
18271    = procCommand('red_.['bubble[T]], ME, M, VS, DB) .
18272  eq procCommand('red_.['bubble[T]], ME, M, VS, DB)
18273    = procRed(ME, M, 'bubble[T], VS, DB) .
18274
18275  eq procCommand('rewrite_.['bubble[T]], ME, M, VS, DB)
18276    = procCommand('rew_.['bubble[T]], ME, M, VS, DB) .
18277  eq procCommand('rew_.['bubble[T]], ME, M, VS, DB)
18278    = procRew(ME, M, 'bubble[T], VS, DB) .
18279
18280  eq procCommand('frewrite_.['bubble[T]], ME, M, VS, DB)
18281    = procCommand('frew_.['bubble[T]], ME, M, VS, DB) .
18282  eq procCommand('frew_.['bubble[T]], ME, M, VS, DB)
18283    = procFrew(ME, M, 'bubble[T], unbounded, 1, VS, DB) .
18284
18285  eq procCommand('search_=>1_.['bubble[T], 'bubble[T']], ME, M, VS, DB)
18286    = procSearch(ME, M, 'bubble[T], 'bubble[T'], '+, unbounded, 1, VS, DB) .
18287  eq procCommand('search_=>*_.['bubble[T], 'bubble[T']], ME, M, VS, DB)
18288    = procSearch(ME, M, 'bubble[T], 'bubble[T'], '*, unbounded, unbounded, VS, DB) .
18289  eq procCommand('search_=>+_.['bubble[T], 'bubble[T']], ME, M, VS, DB)
18290    = procSearch(ME, M, 'bubble[T], 'bubble[T'], '+, unbounded, unbounded, VS, DB) .
18291  eq procCommand('search_=>!_.['bubble[T], 'bubble[T']], ME, M, VS, DB)
18292    = procSearch(ME, M, 'bubble[T], 'bubble[T'], '!, unbounded, unbounded, VS, DB) .
18293
18294  eq procCommand('search_~>1_.['bubble[T], 'bubble[T']], ME, M, VS, DB)
18295    = procNarrowSearch(ME, M, 'bubble[T], 'bubble[T'], '+, unbounded, 1, VS, DB) .
18296  eq procCommand('search_~>*_.['bubble[T], 'bubble[T']], ME, M, VS, DB)
18297    = procNarrowSearch(ME, M, 'bubble[T], 'bubble[T'], '*, unbounded, unbounded, VS, DB) .
18298  eq procCommand('search_~>+_.['bubble[T], 'bubble[T']], ME, M, VS, DB)
18299    = procNarrowSearch(ME, M, 'bubble[T], 'bubble[T'], '+, unbounded, unbounded, VS, DB) .
18300  eq procCommand('search_~>!_.['bubble[T], 'bubble[T']], ME, M, VS, DB)
18301    = procNarrowSearch(ME, M, 'bubble[T], 'bubble[T'], '!, unbounded, unbounded, VS, DB) .
18302
18303  eq procCommand('match_<=?_.['bubble[T], 'bubble[T']], ME, M, VS, DB)
18304    = procMatch(ME, M, 'bubble[T], 'bubble[T'], 'match, 0, VS, DB) .
18305  eq procCommand('xmatch_<=?_.['bubble[T], 'bubble[T']], ME, M, VS, DB)
18306    = procMatch(ME, M, 'bubble[T], 'bubble[T'], 'xmatch, 0, VS, DB) .
18307
18308  eq procCommand('unify_.['bubble[T]], ME, M, VS, DB)
18309    = procUnify(ME, M, 'bubble[T], unbounded, VS, DB) .
18310
18311  eq procCommand('id-unify_.['bubble[T]], ME, M, VS, DB)
18312    = procIdUnify(ME, M, 'bubble[T], unbounded, VS, DB) .
18313
18314  eq procCommand('variant`unify_.['bubble[T]], ME, M, VS, DB)
18315    = procVariantUnify(ME, M, 'bubble[T], unbounded, VS, DB) .
18316
18317  eq procCommand('asymmetric`variant`unify_.['bubble[T]], ME, M, VS, DB)
18318    = procAsymmetricVariantUnify(ME, M, 'bubble[T], unbounded, VS, DB) .
18319
18320  eq procCommand('get`variants_.['bubble[T]], ME, M, VS, DB)
18321    = procGetVariants(ME, M, 'bubble[T], unbounded, VS, DB) .
18322
18323  eq procCommandUp(ME, M, 'down_:_[T, T'], VDS, DB)
18324    = downTerm(procCommandUp(ME, M, T', VDS, DB)) .
18325  eq procCommandUp(ME, M, 'red_.['bubble[T]], VDS, DB)
18326    = downTerm(procRedUp(ME, M, 'bubble[T], VDS, DB)) .
18327  eq procCommandUp(ME, M, 'reduce_.['bubble[T]], VDS, DB)
18328    = downTerm(procRedUp(ME, M, 'bubble[T], VDS, DB)) .
18329  eq procCommandUp(ME, M, 'rew_.['bubble[T]], VDS, DB)
18330    = downTerm(procRewUp(ME, M, 'bubble[T], unbounded, VDS, DB)) .
18331  eq procCommandUp(ME, M, 'rewrite_.['bubble[T]], VDS, DB)
18332    = downTerm(procRewUp(ME, M, 'bubble[T], unbounded, VDS, DB)) .
18333  eq procCommandUp(ME, M, 'frew_.['bubble[T]], VDS, DB)
18334    = downTerm(procFrewUp(ME, M, 'bubble[T], unbounded, 0, VDS, DB)) .
18335  eq procCommandUp(ME, M, 'frewrite_.['bubble[T]], VDS, DB)
18336    = downTerm(procFrewUp(ME, M, 'bubble[T], unbounded, 0, VDS, DB)) .
18337
18338  ceq procRedUp(ME, M, T, VDS, DB)
18339    = if metaReduce(getModule(TM), getTerm(TM)) :: ResultPair
18340      then getTerm(metaReduce(getModule(TM), getTerm(TM)))
18341      else qidError('\r 'Error: '\o 'Incorrect 'command. '\n)
18342      fi
18343    if TM := solveBubblesRed(T, M,
18344               included('META-MODULE, getImports(getTopModule(ME, DB)), DB),
18345               VDS, DB) .
18346
18347  ceq procRewUp(ME, M, T, D, VDS, DB)
18348    = if metaRewrite(getModule(TMVB), getTerm(TMVB), getBound(TMVB))
18349           :: ResultPair
18350      then getTerm(metaRewrite(getModule(TMVB), getTerm(TMVB), getBound(TMVB)))
18351      else qidError('\r 'Error: '\o 'Incorrect 'command. '\n)
18352      fi
18353    if TMVB := solveBubblesRew(T, M,
18354                included('META-MODULE, getImports(getTopModule(ME, DB)), DB),
18355                D, VDS, DB) .
18356
18357  ceq procFrewUp(ME, M, T, D, I, VDS, DB)
18358    = if metaFrewrite(
18359           getModule(TMVBN), getTerm(TMVBN), getBound(TMVBN), getNat(TMVBN))
18360         :: ResultPair
18361      then getTerm(
18362             metaFrewrite(getModule(TMVBN), getTerm(TMVBN),
18363               getBound(TMVBN), getNat(TMVBN)))
18364      else qidError('\r 'Error: '\o 'Incorrect 'command. '\n)
18365      fi
18366    if TMVBN := solveBubblesFrew(T, M,
18367                 included('META-MODULE, getImports(getTopModule(ME, DB)), DB),
18368                 D, I, VDS, DB) .
18369
18370  ceq procParse(ME, M, T, VDS, DB)
18371    = if leastSort(getModule(TM), getTerm(TM)) :: Type
18372      then (eMetaPrettyPrint(leastSort(getModule(TM), getTerm(TM)))
18373            '\s '\b ': '\o '\n '\s '\s
18374            eMetaPrettyPrint(getModule(TM), getTerm(TM)) '\n)
18375      else getMsg(getTerm(TM))
18376      fi
18377    if TM := solveBubblesRed(T, M,
18378               included('META-MODULE, getImports(getTopModule(ME, DB)), DB),
18379               VDS, DB) .
18380  eq procParse(ME, unitError(QIL), T, VDS, DB) = QIL .
18381  eq procParse(ME, noModule, T, VDS, DB) = getMsg(DB) .
18382
18383  ceq procRed(ME, M, T, VDS, DB)
18384    = if metaReduce(getModule(TM), getTerm(TM)) :: ResultPair
18385      then ('\b 'reduce 'in
18386            '\o eMetaPrettyPrint(getName(getModule(TM))) '\b ': '\o '\n '\s '\s
18387            eMetaPrettyPrint(getModule(TM), getTerm(TM)) '\n
18388            '\b 'result '\o '\s
18389            eMetaPrettyPrint(getType(metaReduce(getModule(TM), getTerm(TM))))
18390            '\s '\b ': '\o '\n '\s '\s
18391            eMetaPrettyPrint(getModule(TM),
18392              getTerm(metaReduce(getModule(TM), getTerm(TM))))
18393            '\n)
18394      else getMsg(getTerm(metaReduce(getModule(TM), getTerm(TM))))
18395      fi
18396    if TM := solveBubblesRed(T, M,
18397               included('META-MODULE, getImports(getTopModule(ME, DB)), DB),
18398               VDS, DB) .
18399  eq procRed(ME, unitError(QIL), T, VDS, DB) = QIL .
18400  eq procRed(ME, noModule, T, VDS, DB) = getMsg(DB) .
18401
18402  eq metaReduce(unitError(QIL), T) = {qidError(QIL), '`[Term`]} .
18403  eq metaReduce(U:[Module], qidError(QIL)) = {qidError(QIL), '`[Term`]} .
18404
18405  ceq solveBubblesRed('bubble[QI], M, B, VDS, DB)
18406    = if T? :: Term
18407      then {T?, M, B, VDS, DB}
18408      else tupleTMBODerror('\r 'Error: '\o 'no 'parse 'for downQidList(QI) '\n)
18409      fi
18410    if T? := solveBubbles('bubble[QI], M, B, VDS, DB) .
18411  ceq solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)
18412    = if T? :: Term
18413      then {T?, M, B, VDS, DB}
18414      else if metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), '@RedInPart@) :: ResultPair
18415           then solveBubblesRed2(
18416                  getTerm(metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), '@RedInPart@)),
18417                  DB)
18418           else tupleTMBODerror(
18419                  '\r 'Warning: '\o
18420                    printSyntaxError(
18421                      metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]),
18422                       '@RedInPart@), downQidList('__[TL, ''..Qid])) '\n
18423                    '\r 'Error: '\o
18424                    'no 'parse 'for downQidList('__[TL, ''..Qid]) '\n)
18425           fi
18426      fi
18427    if T? := solveBubbles('bubble['__[TL]], M, B, VDS, DB) .
18428  *** There is some problem parsing 'in_:_ in solveBubblesRed, but it
18429  *** seems to work with the additional '.
18430
18431  ceq solveBubblesRed2('in_:_.[T, T'], DB)
18432    = if unitInDb(ME, DB')
18433      then solveBubblesRed3(T', getFlatModule(ME, DB'), ME, getVars(ME, DB'), DB')
18434      else tupleTMBODerror('\r 'Error: '\o 'It 'is 'not 'possible 'to 'compile eMetaPrettyPrint(ME) '. '\n)
18435      fi
18436    if < DB' ; ME > := evalModExp(parseModExp(T), DB) .
18437  eq solveBubblesRed2('in_:_.[T, T'], DB)
18438    = tupleTMBODerror('\r 'Error: '\o 'It 'isn't 'possible 'to 'compile eMetaPrettyPrint(parseModExp(T)) '. '\n)
18439    [owise] .
18440
18441  eq solveBubblesRed3(T, M, ME, VDS, DB)
18442    = {solveBubbles(T, M,
18443         included('META-MODULE, getImports(getTopModule(ME, DB)), DB),
18444         VDS, DB),
18445       M,
18446       included('META-MODULE, getImports(getTopModule(ME, DB)), DB),
18447       VDS,
18448       DB} .
18449
18450  op GRAMMAR-RED : -> FModule [memo] .
18451  eq GRAMMAR-RED
18452    = addImports((including 'MOD-EXPRS .),
18453        addSorts('@RedInPart@,
18454          addOps((op 'in_:_. : '@ModExp@ '@Bubble@ -> '@RedInPart@ [none] .),
18455            BUBBLES))) .
18456
18457  ceq procRew(ME, M, T, VDS, DB)
18458    = if RP :: ResultPair
18459      then ('\b 'rewrite 'in '\o eMetaPrettyPrint(getName(getModule(TMVB)))
18460            '\b ': '\o '\n '\s '\s
18461            eMetaPrettyPrint(getModule(TMVB), getTerm(TMVB)) '\n
18462            '\b 'result '\o '\s
18463            eMetaPrettyPrint(getType(RP))
18464            '\s '\b ': '\o '\n '\s '\s
18465            eMetaPrettyPrint(getModule(TMVB), getTerm(RP))
18466            '\n)
18467      else getMsg(getTerm(TMVB))
18468      fi
18469    if TMVB := solveBubblesRew(T, M,
18470                included('META-MODULE, getImports(getTopModule(ME, DB)), DB),
18471                unbounded, VDS, DB)
18472       /\ RP  := metaRewrite(getModule(TMVB), getTerm(TMVB), getBound(TMVB)) .
18473  eq procRew(ME, unitError(QIL), T, VDS, DB) = qidError(QIL) .
18474
18475  eq solveBubblesRew('bubble[QI], M, B, D, VDS, DB)
18476    = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term
18477      then {solveBubbles('bubble[QI], M, B, VDS, DB), M, B, VDS, unbounded, DB}
18478      else tupleTMBOBDerror(
18479             '\r 'Error: '\o 'no 'parsing 'for downQidList(QI) '\n)
18480      fi .
18481  eq solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)
18482    = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term
18483      then {solveBubbles('bubble['__[TL]], M, B, VDS, DB), M, B, VDS, unbounded, DB}
18484      else if metaParse(GRAMMAR-REW, downQidList('__[TL, ''..Qid]), '@RewNuPart@)
18485                :: ResultPair
18486           then solveBubblesRew2(
18487                  getTerm(
18488                    metaParse(GRAMMAR-REW, downQidList('__[TL, ''..Qid]),
18489                      '@RewNuPart@)),
18490                  M, B, VDS, DB)
18491           else {getTerm(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)),
18492                 getModule(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)),
18493                 getBool(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)),
18494                 getVars(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)),
18495                 unbounded,
18496                 getDatabase(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB))}
18497           fi
18498      fi .
18499
18500  eq solveBubblesRew2('`[_`]_.['token[T], T'], M, B, VDS, DB)
18501    = if downNat(downMetaNat(T)) :: Nat
18502         and-then solveBubblesRed(T', M, B, VDS, DB)
18503                    :: Tuple{Term,Module,Bool,OpDeclSet,Database}
18504      then {getTerm(solveBubblesRed(T', M, B, VDS, DB)),
18505            getModule(solveBubblesRed(T', M, B, VDS, DB)),
18506            getBool(solveBubblesRed(T', M, B, VDS, DB)),
18507            getVars(solveBubblesRed(T', M, B, VDS, DB)),
18508            downNat(downMetaNat(T)),
18509            getDatabase(solveBubblesRed(T', M, B, VDS, DB))}
18510      else tupleTMBOBDerror(
18511             '\r 'Error: '\o 'Incorrect 'command. '\n)
18512      fi .
18513
18514  op GRAMMAR-REW : -> FModule [memo] .
18515  eq GRAMMAR-REW
18516    = addSorts('@RewNuPart@ ; '@Token@ ; '@SortToken@ ; '@ViewToken@ ; '@NeTokenList@ ; '@Bubble@,
18517        addOps((op '`[_`]_. : '@Token@ '@Bubble@ -> '@RewNuPart@ [none] .),
18518          BUBBLES)) .
18519
18520----  eq metaRewrite(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T, D)
18521----    = metaReduce(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T) .
18522----  eq metaRewrite(M, T, 0) = {T, leastSort(M, T)} .
18523
18524  *** FREW
18525
18526  ceq procFrew(ME, M, T, D, I, VDS, DB)
18527    = if RP :: ResultPair
18528      then ('\b 'frewrite 'in '\o eMetaPrettyPrint(getName(getModule(TMVBN)))
18529            '\b ': '\o  '\n '\s '\s
18530            eMetaPrettyPrint(getModule(TMVBN), getTerm(TMVBN)) '\n
18531            '\b 'result '\o '\s eMetaPrettyPrint(getType(RP))
18532            '\s '\b ': '\o '\n '\s '\s
18533            eMetaPrettyPrint(getModule(TMVBN), getTerm(RP)) '\n)
18534      else ('\r 'Error: '\o 'Incorrect 'command. '\n)
18535      fi
18536    if TMVBN := solveBubblesFrew(T, M,
18537                 included('META-MODULE, getImports(getTopModule(ME, DB)), DB),
18538                 D, I, VDS, DB)
18539       /\ RP   := metaFrewrite(getModule(TMVBN), getTerm(TMVBN),
18540                               getBound(TMVBN),  getNat(TMVBN)) .
18541  eq procFrew(ME, unitError(QIL), T, D, I, VDS, DB) = qidError(QIL) .
18542
18543  eq solveBubblesFrew('bubble[QI], M, B, D, I, VDS, DB)
18544    = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term
18545      then {solveBubbles('bubble[QI], M, B, VDS, DB), M, VDS, unbounded, I}
18546      else tupleTMOBNerror(
18547             '\r 'Error: '\o 'no 'parse 'for downQidList(QI) '\n)
18548      fi .
18549  eq solveBubblesFrew('bubble['__[TL]], M, B, D, I, VDS, DB)
18550    = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term
18551      then {solveBubbles('bubble['__[TL]], M, B, VDS, DB),
18552              M, VDS, unbounded, I}
18553      else if metaParse(GRAMMAR-FREW, downQidList('__[TL, ''..Qid]),
18554                '@FrewNuPart@)
18555                :: ResultPair
18556           then solveBubblesFrew2(
18557                  getTerm(
18558                    metaParse(GRAMMAR-FREW, downQidList('__[TL, ''..Qid]),
18559                      '@FrewNuPart@)),
18560                  M, B, I, VDS, DB)
18561           else {getTerm(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)),
18562                 getModule(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)),
18563                 getVars(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)),
18564                 unbounded, I}
18565           fi
18566      fi .
18567  *** There is some problem parsing _ in solveBubblesRed, but it
18568  *** seems to work with the additional '.
18569
18570  eq solveBubblesFrew2('`[_`]_.['token[T], T'], M, B, I, VDS, DB)
18571    = if downNat(downMetaNat(T)) :: Nat
18572         and-then solveBubblesRed(T', M, B, VDS, DB)
18573                    :: Tuple{Term,Module,Bool,OpDeclSet,Database}
18574      then {getTerm(solveBubblesRed(T', M, B, VDS, DB)),
18575            getModule(solveBubblesRed(T', M, B, VDS, DB)),
18576            getVars(solveBubblesRed(T', M, B, VDS, DB)),
18577            downNat(downMetaNat(T)),
18578            I}
18579      else tupleTMOBNerror(
18580             '\r 'Error: '\o 'Incorrect 'command. '\n)
18581      fi .
18582  eq solveBubblesFrew2('`[_`,_`]_.['token[T], 'token[T'], T''],
18583       M, B, I, VDS, DB)
18584    = if downNat(downMetaNat(T)) :: Nat
18585         and-then downNat(downMetaNat(T')) :: Nat
18586         and-then solveBubblesRed(T'', M, B, VDS, DB)
18587                    :: Tuple{Term,Module,Bool,OpDeclSet,Database}
18588      then {getTerm(solveBubblesRed(T'', M, B, VDS, DB)),
18589            getModule(solveBubblesRed(T'', M, B, VDS, DB)),
18590            getVars(solveBubblesRed(T'', M, B, VDS, DB)),
18591            downNat(downMetaNat(T)),
18592            downNat(downMetaNat(T'))}
18593      else tupleTMOBNerror('\r 'Error: '\o 'Incorrect 'command. '\n)
18594      fi .
18595
18596  op GRAMMAR-FREW : -> FModule [memo] .
18597  eq GRAMMAR-FREW
18598    = addSorts('@FrewNuPart@ ; '@Token@ ; '@SortToken@ ; '@ViewToken@ ; '@NeTokenList@ ; '@Bubble@,
18599        addOps(
18600          (op '`[_`]_. : '@Token@ '@Bubble@ -> '@FrewNuPart@ [none] .
18601           op '`[_`,_`]_. : '@Token@ '@Token@ '@Bubble@ -> '@FrewNuPart@ [none] .),
18602          BUBBLES)) .
18603
18604  eq metaFrewrite(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T, D, I)
18605    = metaReduce(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T) .
18606  eq metaFrewrite(M, T, 0, I) = {T, leastSort(M, T)} .
18607  eq metaFrewrite(M, T, D, 0) = {T, leastSort(M, T)} .
18608
18609  *** SEARCH
18610
18611  op GRAMMAR-SEARCH : -> FModule [memo] .
18612  eq GRAMMAR-SEARCH
18613    = addSorts('@SearchNuPart@ ; '@Token@ ; '@SortToken@ ; '@ViewToken@ ; '@NeTokenList@ ; '@Bubble@,
18614        addOps((op '`[_`,_`]_. : '@Token@ '@Token@ '@Bubble@ -> '@SearchNuPart@ [none] .)
18615               (op '`[`,_`]_. : '@Token@ '@Bubble@ -> '@SearchNuPart@ [none] .),
18616          BUBBLES)) .
18617
18618  ceq procSearch(ME, M, T, T', QI, D, D', VDS, DB)
18619    *** D is a bound on the number of solutions, and D' is a bound on the depth of the search
18620    = if solveBubblesRl(T, T', M, B, VDS, DB) :: Term
18621      then procSearch2(addOps(VDS, M),
18622             lhs(solveBubblesRl(T, T', M, B, VDS, DB)),
18623             rhs(solveBubblesRl(T, T', M, B, VDS, DB)), nil, QI, D, D')
18624      else solveBubblesSearchL(M, T, T', QI, D, D', B, VDS, DB)
18625      fi
18626    if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) .
18627
18628  eq solveBubblesSearchL(M, 'bubble[QI], T, QI', D, D', B, VDS, DB)
18629    = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term
18630      then solveBubblesSearchR(M, solveBubbles('bubble[QI], M, B, VDS, DB), T, QI', D, D', B, VDS, DB)
18631      else ('\r 'Error: '\o 'no 'parsing 'for downQidList(QI) '\n)
18632      fi .
18633  eq solveBubblesSearchL(M, 'bubble['__[TL]], T, QI, D, D', B, VDS, DB)
18634    = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term
18635      then solveBubblesSearchR(M, solveBubbles('bubble['__[TL]], M, B, VDS, DB), T, QI, D, D', B, VDS, DB)
18636      else if metaParse(GRAMMAR-SEARCH, downQidList('__[TL, ''..Qid]), '@SearchNuPart@) :: ResultPair
18637           then solveBubblesSearchL1(
18638                  M,
18639                  getTerm(metaParse(GRAMMAR-SEARCH, downQidList('__[TL, ''..Qid]), '@SearchNuPart@)),
18640                  T, QI, D, D', B, VDS, DB)
18641           else solveBubblesSearchR(
18642                  getModule(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
18643                  getTerm(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
18644                  T,
18645                  QI,
18646                  getBound(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
18647                  D',
18648                  getBool(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
18649                  getVars(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
18650                  getDatabase(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)))
18651           fi
18652      fi .
18653
18654  eq solveBubblesSearchL1(M, '`[`,_`]_.['token[T], T'], T'', QI, D, D', B, VDS, DB)
18655    = if downNat(downMetaNat(T)) :: Nat
18656         and-then solveBubblesRed(T', M, B, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Database}
18657      then solveBubblesSearchR(
18658             getModule(solveBubblesRed(T', M, B, VDS, DB)),
18659             getTerm(solveBubblesRed(T', M, B, VDS, DB)),
18660             T'', QI, D,
18661             downNat(downMetaNat(T)),
18662             B,
18663             getVars(solveBubblesRed(T', M, B, VDS, DB)),
18664             DB)
18665      else ('\r 'Error: '\o 'Incorrect 'command. '\n)
18666      fi .
18667  eq solveBubblesSearchL1(M, '`[_`,_`]_.['token[T], 'token[T'], T''], T''', QI, D, D', B, VDS, DB)
18668    = if downNat(downMetaNat(T)) :: Nat
18669         and-then downNat(downMetaNat(T')) :: Nat
18670         and-then solveBubblesRed(T'', M, B, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Database}
18671      then solveBubblesSearchR(
18672             getModule(solveBubblesRed(T'', M, B, VDS, DB)),
18673             getTerm(solveBubblesRed(T'', M, B, VDS, DB)),
18674             T''', QI,
18675             downNat(downMetaNat(T)),
18676             downNat(downMetaNat(T')),
18677             B,
18678             getVars(solveBubblesRed(T'', M, B, VDS, DB)),
18679             DB)
18680      else ('\r 'Error: '\o 'Incorrect 'command. '\n)
18681      fi .
18682
18683  eq solveBubblesSearchR(M, T, T', QI, D, D', B, VDS, DB)
18684    = solveBubblesSearchR1(
18685        M,
18686        addOps(
18687          op '_s.t._. : leastSort(M, T) '@Condition@ -> 'PatternCondition [none] .
18688          op '_such`that_. : leastSort(M, T) '@Condition@ -> 'PatternCondition [none] .,
18689          addSorts('PatternCondition, addInfoConds(M))),
18690        T,
18691        T',
18692        QI,
18693        D,
18694        D',
18695        B,
18696        VDS,
18697        DB) .
18698  eq solveBubblesSearchR(M:[Module], T:[Term], T':[Term], QI:[Qid], D:[Bound], D':[Bound], B:[Bool], VDS:[OpDeclSet], DB:[Database])
18699    = ('\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n) .
18700
18701  ceq solveBubblesSearchR1(M, M', T, 'bubble[QI], QI', D, D', B, VDS, DB)
18702    = if T?:[Term] :: Term
18703      then procSearch2(M, T, T?:[Term], nil, QI', D, D')
18704      else ('\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n)
18705      fi
18706    if T?:[Term] := solveBubbles('bubble[QI], M, B, VDS, DB) .
18707  ceq solveBubblesSearchR1(M, M', T, 'bubble['__[TL]], QI, D, D', B, VDS, DB)
18708    = if T?:[Term] :: Term
18709      then procSearch2(M, T, T?:[Term], nil, QI, D, D')
18710      else if metaParse(M', downQidList('__[TL, ''..Qid]), 'PatternCondition)
18711                :: ResultPair
18712           then solveBubblesSearchR2(M, T,
18713                  getTerm(
18714                    metaParse(M', downQidList('__[TL, ''..Qid]),
18715                      'PatternCondition)),
18716                  QI, D, D', VDS)
18717           else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n
18718           fi
18719      fi
18720    if T?:[Term] := solveBubbles('bubble['__[TL]], M, B, VDS, DB) .
18721
18722  eq solveBubblesSearchR2(M, T, QI, QI', D, D', VDS)
18723    = procSearch2(M, T, constsToVars(QI, VDS), nil, QI', D, D') .
18724  eq solveBubblesSearchR2(M, T, F[T], QI, D, D', VDS)
18725    = procSearch2(M, T, constsToVars(F[T], VDS), nil, QI, D, D') .
18726  eq solveBubblesSearchR2(M, T, F[T', T''], QI, D, D', VDS)
18727    = if F == '_s.t._. or F == '_such`that_.
18728      then procSearch2(M, T, T', parseCond(T'', VDS), QI, D, D')
18729      else procSearch2(M, T, constsToVars(F[T', T''], VDS), nil, QI, D, D')
18730      fi .
18731  eq solveBubblesSearchR2(M, T, F[T', T'', TL], QI, D, D', VDS)
18732    = procSearch2(M, T, constsToVars(F[T', T'', TL], VDS), nil, QI, D, D') .
18733
18734  ceq procSearch2(M, T, T', CD, QI, D, D')
18735    = if RT :: ResultTriple
18736      then ('search
18737            if D == unbounded and D' == unbounded
18738            then nil
18739            else '\s '`[
18740                 if D == unbounded
18741                 then nil
18742                 else qid(string(D, 10))
18743                 fi
18744                 if D' == unbounded
18745                 then nil
18746                 else '`, qid(string(D', 10))
18747                 fi
18748                 '`] '\s
18749            fi
18750            'in eMetaPrettyPrint(getName(M)) ':
18751            eMetaPrettyPrint(M, T) '\s qid("=>" + string(QI)) '\s
18752            eMetaPrettyPrint(M, T'') '. '\n '\n
18753            'Solution '1 '\n
18754            if gTSubstitution(RT) == none
18755            then 'empty 'substitution '\n '\n
18756            else eMetaPrettyPrint(M, gTSubstitution(RT)) '\n '\n
18757            fi
18758            procSearch3(M, T, T'', CD, QI, D, 1, D'))
18759      else if RT == failure
18760           then ('search
18761           if D == unbounded and D' == unbounded
18762            then nil
18763            else '\s '`[
18764                 if D == unbounded
18765                 then nil
18766                 else qid(string(D, 10))
18767                 fi
18768                 if D' == unbounded
18769                 then nil
18770                 else '`, qid(string(D', 10))
18771                 fi
18772                 '`] '\s
18773            fi
18774            'in eMetaPrettyPrint(getName(M)) ':
18775                 eMetaPrettyPrint(M, T)
18776                 '\s qid("=>" + string(QI)) '\s
18777                 eMetaPrettyPrint(M, T'') '. '\n '\n
18778                'No 'solution. '\n)
18779           else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n
18780           fi
18781      fi
18782    if T'' := prepSearchPattern(T')
18783       /\ RT := metaSearch(M, T, T'', CD, QI, D', 0) .
18784
18785
18786  eq procSearch3(M, T, T', CD, QI, D, I, D')
18787    = if D == unbounded or-else (D == 0 or-else I < D)
18788      then if metaSearch(M, T, T', CD, QI, D', I) :: ResultTriple
18789           then ('Solution qid(string(I + 1, 10)) '\n
18790                 if gTSubstitution(metaSearch(M, T, T', CD, QI, D', I)) == none
18791                 then 'empty 'substitution '\n '\n
18792                 else eMetaPrettyPrint(M,
18793                            gTSubstitution(
18794                              metaSearch(M, T, T', CD, QI, D', I))) '\n '\n
18795                 fi
18796                 procSearch3(M, T, T', CD, QI, D, I + 1, D'))
18797           else ('No 'more 'solutions. '\n)
18798           fi
18799      else nil
18800      fi .
18801
18802-------------------
18803*** Equal to procSearch except replacing metaSearch by metaNarrowSearch
18804
18805  ceq procNarrowSearch(ME, M, T, T', QI, D, D', VDS, DB)
18806    *** D is a bound on the number of solutions, and D' is a bound on the depth of the search
18807    = if solveBubblesRl(T, T', M, B, VDS, DB) :: Term
18808      then procNarrowSearch2(addOps(VDS, M),
18809             lhs(solveBubblesRl(T, T', M, B, VDS, DB)),
18810             rhs(solveBubblesRl(T, T', M, B, VDS, DB)), nil, QI, D, D')
18811      else solveBubblesNarrowSearchL(M, T, T', QI, D, D', B, VDS, DB)
18812      fi
18813    if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) .
18814
18815  eq solveBubblesNarrowSearchL(M, 'bubble[QI], T, QI, D, D', B, VDS, DB)
18816    = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term
18817      then solveBubblesNarrowSearchR(M, solveBubbles('bubble[QI], M, B, VDS, DB), T, QI, D, D', B, VDS, DB)
18818      else ('\r 'Error: '\o 'no 'parsing 'for downQidList(QI) '\n)
18819      fi .
18820  eq solveBubblesNarrowSearchL(M, 'bubble['__[TL]], T, QI, D, D', B, VDS, DB)
18821    = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term
18822      then solveBubblesNarrowSearchR(M, solveBubbles('bubble['__[TL]], M, B, VDS, DB), T, QI, D, D', B, VDS, DB)
18823      else if metaParse(GRAMMAR-SEARCH, downQidList('__[TL, ''..Qid]), '@SearchNuPart@) :: ResultPair
18824           then solveBubblesNarrowSearchL1(
18825                  M,
18826                  getTerm(
18827                    metaParse(GRAMMAR-SEARCH, downQidList('__[TL, ''..Qid]),
18828                      '@SearchNuPart@)),
18829                  T, QI, D, D', B, VDS, DB)
18830           else solveBubblesNarrowSearchR(
18831                  getModule(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
18832                  getTerm(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
18833                  T,
18834                  QI,
18835                  getBound(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
18836                  D',
18837                  getBool(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
18838                  getVars(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)),
18839                  getDatabase(solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB)))
18840           fi
18841      fi .
18842
18843  eq solveBubblesNarrowSearchL1(M, '`[`,_`]_.['token[T], T'], T'', QI, D, D', B, VDS, DB)
18844    = if downNat(downMetaNat(T)) :: Nat
18845         and-then solveBubblesRed(T', M, B, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Database}
18846      then solveBubblesNarrowSearchR(
18847             getModule(solveBubblesRed(T', M, B, VDS, DB)),
18848             getTerm(solveBubblesRed(T', M, B, VDS, DB)),
18849             T'', QI, D,
18850             downNat(downMetaNat(T)),
18851             B,
18852             getVars(solveBubblesRed(T', M, B, VDS, DB)),
18853             DB)
18854      else ('\r 'Error: '\o 'Incorrect 'command. '\n)
18855      fi .
18856  eq solveBubblesNarrowSearchL1(M, '`[_`,_`]_.['token[T], 'token[T'], T''], T''', QI, D, D', B, VDS, DB)
18857    = if downNat(downMetaNat(T)) :: Nat
18858         and-then downNat(downMetaNat(T')) :: Nat
18859         and-then solveBubblesRed(T'', M, B, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Database}
18860      then solveBubblesNarrowSearchR(
18861             getModule(solveBubblesRed(T'', M, B, VDS, DB)),
18862             getTerm(solveBubblesRed(T'', M, B, VDS, DB)),
18863             T''', QI,
18864             downNat(downMetaNat(T)),
18865             downNat(downMetaNat(T')),
18866             B,
18867             getVars(solveBubblesRed(T'', M, B, VDS, DB)),
18868             DB)
18869      else ('\r 'Error: '\o 'Incorrect 'command. '\n)
18870      fi .
18871
18872  eq solveBubblesNarrowSearchR(M, T, T', QI, D, D', B, VDS, DB)
18873    = solveBubblesNarrowSearchR1(
18874        M,
18875        addOps(
18876          op '_s.t._. : leastSort(M, T) '@Condition@ -> 'PatternCondition [none] .
18877          op '_such`that_. : leastSort(M, T) '@Condition@ -> 'PatternCondition [none] .,
18878          addSorts('PatternCondition, addInfoConds(M))),
18879        T,
18880        T',
18881        QI,
18882        D,
18883        D',
18884        B,
18885        VDS,
18886        DB) .
18887  eq solveBubblesNarrowSearchR(M:[Module], T:[Term], T':[Term], QI:[Qid], D:[Bound], D':[Bound], B:[Bool], VDS:[OpDeclSet], DB:[Database])
18888    = qidError('\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n) .
18889
18890  ceq solveBubblesNarrowSearchR1(M, M', T, 'bubble[QI], QI', D, D', B, VDS, DB)
18891    = if T?:[Term] :: Term
18892      then procNarrowSearch2(M, T, T?:[Term], nil, QI', D, D')
18893      else ('\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n)
18894      fi
18895    if T?:[Term] := solveBubbles('bubble[QI], M, B, VDS, DB) .
18896  ceq solveBubblesNarrowSearchR1(M, M', T, 'bubble['__[TL]], QI, D, D', B, VDS, DB)
18897    = if T?:[Term] :: Term
18898      then procNarrowSearch2(M, T, T?:[Term], nil, QI, D, D')
18899      else if metaParse(M', downQidList('__[TL, ''..Qid]), 'PatternCondition)
18900                :: ResultPair
18901           then solveBubblesNarrowSearchR2(M, T,
18902                  getTerm(
18903                    metaParse(M', downQidList('__[TL, ''..Qid]),
18904                      'PatternCondition)),
18905                  QI, D, D', VDS)
18906           else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n
18907           fi
18908      fi
18909    if T?:[Term] := solveBubbles('bubble['__[TL]], M, B, VDS, DB) .
18910
18911  eq solveBubblesNarrowSearchR2(M, T, QI, QI', D, I, VDS)
18912    = procNarrowSearch2(M, T, constsToVars(QI, VDS), nil, QI', D, I) .
18913  eq solveBubblesNarrowSearchR2(M, T, F[T], QI, D, I, VDS)
18914    = procNarrowSearch2(M, T, constsToVars(F[T], VDS), nil, QI, D, I) .
18915  eq solveBubblesNarrowSearchR2(M, T, F[T', T''], QI, D, I, VDS)
18916    = if F == '_s.t._. or F == '_such`that_.
18917      then procNarrowSearch2(M, T, T', parseCond(T'', VDS), QI, D, I)
18918      else procNarrowSearch2(M, T, constsToVars(F[T', T''], VDS), nil, QI, D, I)
18919      fi .
18920  eq solveBubblesNarrowSearchR2(M, T, F[T', T'', TL], QI, D, I, VDS)
18921    = procNarrowSearch2(M, T, constsToVars(F[T', T'', TL], VDS), nil, QI, D, I) .
18922
18923----  op axCohComplete : SModule -> SModule .       ---- Defined later in module AX-COHERENCE-COMPLETION
18924
18925  sort IdsToRemove .                             ---- moved from VARIANTS
18926  ops all non-handled : -> IdsToRemove .         ---- moved from VARIANTS
18927  op removeIds : Module IdsToRemove ~> Module .  ---- moved from VARIANTS
18928
18929  ceq procNarrowSearch2(M, T, T', CD, QI, D, D')
18930    = if Mx:[Module] :: Module and RTS:[ResultTripleSet] :: ResultTripleSet
18931      then ('search
18932            if D == unbounded and D' == unbounded
18933            then nil
18934            else '\s '`[
18935                 if D == unbounded
18936                 then nil
18937                 else qid(string(D, 10))
18938                 fi
18939                 if D' == unbounded
18940                 then nil
18941                 else '`, qid(string(D', 10))
18942                 fi
18943                 '`] '\s
18944            fi
18945            'in eMetaPrettyPrint(getName(M)) ':
18946            eMetaPrettyPrint(M, T) '\s qid("~>" + string(QI)) '\s
18947            eMetaPrettyPrint(M, T'') '.
18948            procNarrowSearch3(M, 0, Vars((T,T')), RTS:[ResultTripleSet])
18949            if D =/= unbounded and-then D' == unbounded and-then | RTS:[ResultTripleSet] | < D
18950            then procNarrowSearch2RT(M, T, T', CD, QI, D, D',RTS:[ResultTripleSet],1)
18951            else nil
18952            fi
18953            ('\n '\n 'No 'more 'solutions. '\n))
18954      else if RTS:[ResultTripleSet] == empty
18955           then ('search
18956                if D == unbounded and D' == unbounded
18957                then nil
18958                else '\s '`[
18959                     if D == unbounded
18960                     then nil
18961                     else qid(string(D, 10))
18962                     fi
18963                     if D' == unbounded
18964                     then nil
18965                     else '`, qid(string(D', 10))
18966                     fi
18967                     '`] '\s
18968                fi
18969                'in eMetaPrettyPrint(getName(M)) ':
18970                   eMetaPrettyPrint(M, T)
18971                   '\s qid("~>" + string(QI)) '\s
18972                   eMetaPrettyPrint(M, T'') '. '\n '\n
18973                   'No 'solution. '\n)
18974           else if getMsg(Mx:[Module]) :: QidList
18975	        then getMsg(Mx:[Module])
18976		else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n
18977		fi
18978           fi
18979      fi
18980    if T'' := prepSearchPattern(T')
18981       /\ Mx:[Module] := removeIds(axCohComplete(M), non-handled)
18982       /\ RTS:[ResultTripleSet]
18983          := upDown(M,
18984              metaNarrowSearchGen(
18985                 Mx:[Module],
18986                 T,
18987                 T'',
18988                 none,
18989                 typeOfRelation(QI),
18990                 D',
18991                 D,
18992                 unbounded,
18993                 full E-ACU-unify noStrategy E-normalize-terms)
18994              |> (T,T'')
18995             ) .
18996
18997  var RTS' : ResultTripleSet .
18998
18999  op procNarrowSearch2RT : Module Term Term Condition Qid Bound Bound ResultTripleSet Nat -> QidList .
19000  ceq procNarrowSearch2RT(M, T, T', CD, QI, D, D',RTS',J)
19001    = nil
19002   if | RTS' | == D .
19003  ceq procNarrowSearch2RT(M, T, T', CD, QI, D, D',RTS',J)
19004    = if RTS:[ResultTripleSet] :: ResultTripleSet
19005      then (procNarrowSearch3(M, | RTS' |, Vars((T,T')), RTS:[ResultTripleSet])
19006            procNarrowSearch2RT(M, T, T', CD, QI, D, D',RTS' | RTS:[ResultTripleSet],J + 1) )
19007      else nil
19008      fi
19009    if | RTS' | < D
19010       /\ T'' := prepSearchPattern(T')
19011       /\ (RTS' | RTS:[ResultTripleSet])
19012          := upDown(M,
19013              metaNarrowSearchGen(
19014                 removeIds(axCohComplete(M), non-handled),
19015                 T,
19016                 T'',
19017                 none,
19018                 typeOfRelation(QI),
19019                 D',
19020                 D + J,
19021                 unbounded,
19022                 full E-ACU-unify noStrategy E-normalize-terms)
19023              |> (T,T'')
19024             ) .
19025
19026  eq procNarrowSearch3(M, I, TL:TermList, empty)
19027   = nil .
19028  eq procNarrowSearch3(M, I, TL:TermList, {T:Term,TP:Type,S:Substitution} | RTS:ResultTripleSet)
19029    = ('\n '\n 'Solution qid(string(I + 1, 10))
19030       if (S:Substitution |> TL:TermList) == none
19031       then '\n 'empty 'substitution
19032       else '\n eMetaPrettyPrint(M, S:Substitution |> TL:TermList)
19033       fi
19034       procNarrowSearch3(M, I + 1, TL:TermList, RTS:ResultTripleSet)) .
19035
19036-------------------
19037
19038  sort Tuple{TermList, Nat} .
19039  op <_;_> : Term Nat -> Tuple{TermList, Nat} .
19040  op term : Tuple{TermList, Nat} -> TermList .
19041  op index : Tuple{TermList, Nat} -> Nat .
19042  eq term(< TL:[TermList] ; I:[Nat] >) = TL:[TermList] .
19043  eq index(< TL:[TermList] ; I:[Nat] >) = I:[Nat] .
19044
19045  op prepSearchPattern : Term -> Term .
19046  op prepSearchPattern : TermList Nat -> Tuple{TermList, Nat} .
19047
19048  eq prepSearchPattern(T) = term(prepSearchPattern(T, 0)) .
19049
19050  eq prepSearchPattern('<_:_|_>[OT, Ct, T], I)
19051    = < '<_:_|_>[OT, qid("V#" + string(I, 10) + ":" + string(getName(Ct))),
19052           '_`,_[term(prepSearchPattern(T, s s I)),
19053                 qid("V#" + string(s I, 10) + ":AttributeSet")]] ;
19054        index(prepSearchPattern(T, s s I)) > .
19055  eq prepSearchPattern('<_:_|`>[OT, Ct], I)
19056    = < '<_:_|_>[OT, qid("V#" + string(I, 10) + ":" + string(getName(Ct))),
19057           qid("V#" + string(s I, 10) + ".AttributeSet")] ;
19058        s I > .
19059  eq prepSearchPattern(F[TL], I)
19060    = < F[term(prepSearchPattern(TL, I))] ; index(prepSearchPattern(TL, I)) >
19061    [owise] .
19062
19063  eq prepSearchPattern(F, I) = < F ; I > .
19064  ----eq prepSearchPattern(Ct, I) = < Ct ; I > .
19065
19066  ceq prepSearchPattern((T, TL), I)
19067    = < (term(prepSearchPattern(T, I)),
19068         term(prepSearchPattern(TL, index(prepSearchPattern(T, I))))) ;
19069        index(prepSearchPattern(TL, index(prepSearchPattern(T, I)))) >
19070    if TL =/= empty .
19071
19072  *** MATCH
19073
19074  ceq procMatch(ME, M, T, T', QI, I, VDS, DB)
19075    *** the number I the number of solutions
19076    = if solveBubblesRl(T, T', M, B, VDS, DB) :: Term
19077      then procMatch2(addOps(VDS, M),
19078             lhs(solveBubblesRl(T, T', M, B, VDS, DB)),
19079             rhs(solveBubblesRl(T, T', M, B, VDS, DB)), nil, QI, I)
19080      else if solveBubblesRew(T, M, B, I, VDS, DB)
19081                :: Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}
19082           then solveBubblesMatch(
19083                  getModule(solveBubblesRew(T, M, B, I, VDS, DB)),
19084                  addOps(
19085                    op '_s.t._. :
19086                       leastSort(
19087                         getModule(solveBubblesRew(T, M, B, I, VDS, DB)),
19088                         getTerm(solveBubblesRew(T, M, B, I, VDS, DB)))
19089                       '@Condition@ -> 'PatternCondition [none] .
19090                    op '_such`that_. :
19091                       leastSort(
19092                         getModule(solveBubblesRew(T, M, B, I, VDS, DB)),
19093                         getTerm(solveBubblesRew(T, M, B, I, VDS, DB)))
19094                       '@Condition@ -> 'PatternCondition [none] .,
19095                    addSorts('PatternCondition,
19096                      addInfoConds(
19097                        getModule(solveBubblesRew(T, M, B, I, VDS, DB))))),
19098                  getTerm(solveBubblesRew(T, M, B, I, VDS, DB)),
19099                  T',
19100                  QI,
19101                  (if getBound(solveBubblesRew(T, M, B, I, VDS, DB))
19102                         == unbounded
19103                   then 0
19104                   else getBound(solveBubblesRew(T, M, B, I, VDS, DB))
19105                   fi),
19106                  B,
19107                  getVars(solveBubblesRew(T, M, B, I, VDS, DB)),
19108                  DB)
19109           else getMsg(getTerm(solveBubblesRew(T, M, B, I, VDS, DB)))
19110                ----('\r 'Error: '\o 'Incorrect 'match 'command. '\n)
19111           fi
19112      fi
19113    if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) .
19114
19115  ceq solveBubblesMatch(M, M', T, 'bubble[QI], QI', I, B, VDS, DB)
19116    = if T?:[Term] :: Term
19117      then procMatch2(M, T, T?:[Term], nil, QI', I)
19118      else ('\r 'Error: '\o 'Incorrect 'use 'of 'the 'match 'command. '\n)
19119      fi
19120    if T?:[Term] := solveBubbles('bubble[QI], M, B, VDS, DB) .
19121  ceq solveBubblesMatch(M, M', T, 'bubble['__[TL]], QI, I, B, VDS, DB)
19122    = if T?:[Term] :: Term
19123      then procMatch2(M, T, T?:[Term], nil, QI, I)
19124      else if metaParse(M', downQidList('__[TL, ''..Qid]), 'PatternCondition)
19125                :: ResultPair
19126           then solveBubblesMatch2(M, T,
19127                  getTerm(
19128                    metaParse(M', downQidList('__[TL, ''..Qid]),
19129                      'PatternCondition)),
19130                  QI, I, VDS)
19131           else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'match 'command. '\n
19132           fi
19133      fi
19134    if T?:[Term] := solveBubbles('bubble['__[TL]], M, B, VDS, DB) .
19135
19136  eq solveBubblesMatch2(M, T, QI, QI', I, VDS)
19137    = procMatch2(M, T, constsToVars(QI, VDS), nil, QI', I) .
19138  eq solveBubblesMatch2(M, T, F[T], QI, I, VDS)
19139    = procMatch2(M, T, constsToVars(F[T], VDS), nil, QI, I) .
19140  eq solveBubblesMatch2(M, T, F[T', T''], QI, I, VDS)
19141    = if F == '_s.t._. or F == '_such`that_.
19142      then procMatch2(M, T, T', parseCond(T'', VDS), QI, I)
19143      else procMatch2(M, T, constsToVars(F[T', T''], VDS), nil, QI, I)
19144      fi .
19145  eq solveBubblesMatch2(M, T, F[T', T'', TL], QI, I, VDS)
19146    = procMatch2(M, T, constsToVars(F[T', T'', TL], VDS), nil, QI, I) .
19147
19148  ceq procMatch2(M, T, T', CD, 'match, I)
19149    = if Sb? :: Substitution
19150      then ('match
19151            if I == 0 then nil else '\s '`[ qid(string(I, 10)) '`] '\s fi
19152            'in eMetaPrettyPrint(getName(M)) ':
19153            eMetaPrettyPrint(M, T) '\s '<=? '\s eMetaPrettyPrint(M, T') '. '\n '\n
19154            'Solution '1 '\n
19155            if Sb? == none
19156            then 'empty 'substitution
19157            else eMetaPrettyPrint(M, Sb?)
19158            fi '\n '\n
19159            procMatch3(M, T, T', CD, 'match, I, 1))
19160      else if Sb? == noMatch
19161           then ('match
19162                 if I == 0
19163                 then nil
19164                 else '\s '`[ qid(string(I, 10)) '`] '\s
19165                 fi
19166                 'in eMetaPrettyPrint(getName(M)) ':
19167                       eMetaPrettyPrint(M, T) '\s '<=? '\s
19168                       eMetaPrettyPrint(M, T') '. '\n '\n
19169                       'No 'solution. '\n)
19170           else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'match 'command. '\n
19171           fi
19172      fi
19173    if Sb? := metaMatch(M, T, T', CD, 0) .
19174  ceq procMatch2(M, T, T', CD, 'xmatch, I)
19175    = if MP? :: MatchPair
19176      then ('xmatch
19177            if I == 0 then nil else '\s '`[ qid(string(I, 10)) '`] '\s fi
19178            'in eMetaPrettyPrint(getName(M)) ':
19179            eMetaPrettyPrint(M, T) '\s '<=? '\s eMetaPrettyPrint(M, T') '. '\n '\n
19180            'Solution '1 '\n
19181            if gTSubstitution(MP?) == none
19182            then 'empty 'substitution
19183            else eMetaPrettyPrint(M, gTSubstitution(MP?))
19184            fi '\n '\n
19185            procMatch3(M, T, T', CD, 'xmatch, I, 1))
19186      else if MP? == noMatch
19187           then ('xmatch
19188                 if I == 0
19189                 then nil
19190                 else '\s '`[ qid(string(I, 10)) '`] '\s
19191                 fi
19192                 'in eMetaPrettyPrint(getName(M)) ':
19193                      eMetaPrettyPrint(M, T) '\s '<=? '\s
19194                      eMetaPrettyPrint(M, T') '. '\n '\n
19195                      'No 'solution. '\n)
19196           else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'xmatch 'command. '\n
19197           fi
19198      fi
19199    if MP? := metaXmatch(M, T, T', CD, 0, unbounded, 0) .
19200
19201  eq procMatch3(M, T, T', CD, 'match, I, J)
19202    = if I == 0 or J < I
19203      then if metaMatch(M, T, T', CD, J) :: Substitution
19204           then ('Solution qid(string(J + 1, 10)) '\n
19205                 if metaMatch(M, T, T', CD, J) == none
19206                 then 'empty 'substitution
19207                 else eMetaPrettyPrint(M, metaMatch(M, T, T', CD, J))
19208                 fi '\n '\n
19209                 procMatch3(M, T, T', CD, 'match, I, J + 1))
19210           else ('No 'more 'solutions. '\n)
19211           fi
19212      else nil
19213      fi .
19214  eq procMatch3(M, T, T', CD, 'xmatch, I, J)
19215    = if I == 0 or J < I
19216      then if metaXmatch(M, T, T', CD, 0, unbounded, J) :: MatchPair
19217           then ('Solution qid(string(J + 1, 10)) '\n
19218                 if gTSubstitution(metaXmatch(M, T, T', CD, 0, unbounded, J))
19219                      == none
19220                 then 'empty 'substitution
19221                 else eMetaPrettyPrint(M,
19222                            gTSubstitution(
19223                               metaXmatch(M, T, T', CD, 0, unbounded, J)))
19224                 fi '\n '\n
19225                 procMatch3(M, T, T', CD, 'xmatch, I, J + 1))
19226           else ('No 'more 'solutions. '\n)
19227           fi
19228      else nil
19229      fi .
19230
19231  *** UNIFY
19232
19233  ceq procUnify(ME, M, T, D, VDS, DB)
19234    *** D is a bound on the number of solutions
19235    = if solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)
19236           :: Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}
19237      then procUnify2(
19238             getModule(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)),
19239             parseUnify(
19240               getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)),
19241               getVars(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))),
19242             getBound(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)))
19243      else getMsg(getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)))
19244                ----('\r 'Error: '\o 'Incorrect 'match 'command. '\n)
19245      fi
19246    if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) .
19247
19248  eq addInfoUnify(M)
19249    = addOps(op '_/\_ : '@UnificationProblem@ '@UnificationProblem@ -> '@UnificationProblem@
19250                               [ctor assoc prec(73)] .
19251             op '_=?_  : 'Universal 'Universal -> '@UnificationProblem@
19252                               [ctor poly(1 2) prec(71)] .,
19253        addSorts('@UnificationProblem@, M)) .
19254
19255  eq parseUnify('_/\_[T, T'], VDS) = parseUnify(T, VDS) /\ parseUnify(T', VDS) .
19256  eq parseUnify('_=?_[T, T'], VDS) = constsToVars(T, VDS) =? constsToVars(T', VDS) .
19257
19258  ceq procUnify2(M, UP, D)
19259    = if UP? :: UnificationPair?
19260      then ('unify
19261            if D == unbounded then nil else '\s '`[ qid(string(D, 10)) '`] '\s fi
19262            'in eMetaPrettyPrint(getName(M)) ':
19263            eMetaPrettyPrint(M, UP) '\n '\n
19264            if UP? == noUnifier
19265            then 'No 'unifier
19266            else procUnify3Aux(M, UP?, 0) '\n '\n
19267                 procUnify3(M, UP, D, 1)
19268            fi)
19269      else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'unify 'command. '\n
19270      fi
19271    if UP? := metaUnify(M, UP, 0, 0) .
19272  eq procUnify2(M?, UP??:[UnificationProblem], D?) = getMsg(M?) [owise] .
19273
19274  eq eMetaPrettyPrint(M, T =? T')
19275    = eMetaPrettyPrint(M, T) '\s '=? '\s eMetaPrettyPrint(M, T') '. .
19276  eq eMetaPrettyPrint(M, T =? T' /\ UP)
19277    = eMetaPrettyPrint(M, T =? T') '\s '/\ '\s eMetaPrettyPrint(M, UP) '. .
19278
19279  eq procUnify3Aux(M, {Sb, N}, I)
19280    = 'Solution qid(string(I + 1, 10)) '\n
19281      if Sb == none
19282      then 'empty 'substitution '\n '\n
19283      else eMetaPrettyPrint(M, Sb) '\n '\n
19284      fi .
19285
19286  eq procUnify3(M, UP, D, I)
19287    = if D == unbounded or-else I < D
19288      then if metaUnify(M, UP, 0, I) :: UnificationPair
19289           then (procUnify3Aux(M, metaUnify(M, UP, 0, I), I)
19290                 procUnify3(M, UP, D, I + 1))
19291           else ('No 'more 'solutions. '\n)
19292           fi
19293      else nil
19294      fi .
19295
19296  ceq solveBubblesUnify(M, 'bubble[T], VDS)
19297    = if metaParse(M, QIL, '@UnificationProblem@) :: ResultPair
19298      then parseUnify(getTerm(metaParse(M, QIL, '@UnificationProblem@)), VDS)
19299      else unificationProblemError('\r 'Warning: '\o
19300             printSyntaxError(metaParse(M, QIL, '@UnificationProblem@), QIL) '\n)
19301      fi
19302    if QIL := downQidList(T) .
19303
19304  eq solveBubblesRewUnify('bubble[QI], M, B, D, VDS, DB)
19305    = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term
19306      then {solveBubbles('bubble[QI], M, B, VDS, DB), M, B, VDS, unbounded, DB}
19307      else tupleTMBOBDerror(
19308             '\r 'Error: '\o 'no 'parsing 'for downQidList(QI) '\n)
19309      fi .
19310  eq solveBubblesRewUnify('bubble['__[TL]], M, B, D, VDS, DB)
19311    = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term
19312      then {solveBubbles('bubble['__[TL]], M, B, VDS, DB), M, B, VDS, unbounded, DB}
19313      else if metaParse(GRAMMAR-REW, downQidList('__[TL, ''..Qid]), '@RewNuPart@)
19314                :: ResultPair
19315           then solveBubblesRewUnify2(
19316                  getTerm(
19317                    metaParse(GRAMMAR-REW, downQidList('__[TL, ''..Qid]),
19318                      '@RewNuPart@)),
19319                  M, B, VDS, DB)
19320           else {getTerm(solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB)),
19321                 getModule(solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB)),
19322                 getBool(solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB)),
19323                 getVars(solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB)),
19324                 unbounded,
19325                 getDatabase(solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB))}
19326           fi
19327      fi .
19328
19329  eq solveBubblesRewUnify2('`[_`]_.['token[T], T'], M, B, VDS, DB)
19330    = if downNat(downMetaNat(T)) :: Nat
19331         and-then solveBubblesRedUnify(T', M, B, VDS, DB)
19332                    :: Tuple{Term,Module,Bool,OpDeclSet,Database}
19333      then {getTerm(solveBubblesRedUnify(T', M, B, VDS, DB)),
19334            getModule(solveBubblesRedUnify(T', M, B, VDS, DB)),
19335            getBool(solveBubblesRedUnify(T', M, B, VDS, DB)),
19336            getVars(solveBubblesRedUnify(T', M, B, VDS, DB)),
19337            downNat(downMetaNat(T)),
19338            getDatabase(solveBubblesRedUnify(T', M, B, VDS, DB))}
19339      else tupleTMBOBDerror('\r 'Error: '\o 'Incorrect 'command. '\n)
19340      fi .
19341
19342  ceq solveBubblesRedUnify('bubble[QI], M, B, VDS, DB)
19343    = if T? :: Term
19344      then {T?, M, B, VDS, DB}
19345      else tupleTMBODerror('\r 'Error: '\o 'no 'parse 'for downQidList(QI) '\n)
19346      fi
19347    if T? := solveBubbles('bubble[QI], M, B, VDS, DB) .
19348  ceq solveBubblesRedUnify('bubble['__[TL]], M, B, VDS, DB)
19349    = if T? :: Term
19350      then {T?, M, B, VDS, DB}
19351      else if metaParse(GRAMMAR-RED,
19352                downQidList('__[TL, ''..Qid]), '@RedInPart@)
19353                :: ResultPair
19354           then solveBubblesRedUnify2(
19355                  getTerm(
19356                    metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), '@RedInPart@)),
19357                  DB)
19358           else tupleTMBODerror('\r 'Warning: '\o
19359                      printSyntaxError(
19360                        metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]),
19361                        '@RedInPart@), downQidList('__[TL, ''..Qid])) '\n
19362                      '\r 'Error: '\o
19363                      'no 'parse 'for downQidList('__[TL, ''..Qid]) '\n)
19364           fi
19365      fi
19366    if T? := solveBubbles('bubble['__[TL]], M, B, VDS, DB) .
19367  *** There is some problem parsing 'in_:_ in solveBubblesRed, but it
19368  *** seems to work with the additional '.
19369
19370  ceq solveBubblesRedUnify2('in_:_.[T, T'], DB)
19371    = if unitInDb(ME, DB')
19372      then solveBubblesRed3(T', addInfoUnify(getFlatModule(ME, DB')), ME, getVars(ME, DB'), DB')
19373      else tupleTMBODerror('\r 'Error: '\o 'The 'module eMetaPrettyPrint(ME) 'is 'not 'in 'the 'database '. '\n)
19374      fi
19375    if < DB' ; ME > := evalModExp(parseModExp(T), DB) .
19376  eq solveBubblesRedUnify2('in_:_.[T, T'], DB)
19377    = tupleTMBODerror('\r 'Error: '\o 'It 'isn't 'possible 'to 'compile eMetaPrettyPrint(parseModExp(T)) '. '\n)
19378    [owise] .
19379
19380  *** ID-UNIFY
19381
19382  ceq procIdUnify(ME, M, T, D, VDS, DB)
19383    *** D is a bound on the number of solutions
19384    = if solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}
19385      then procIdUnify2(
19386             getModule(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)),
19387             parseUnify(
19388               getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)),
19389               getVars(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))),
19390             getBound(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)))
19391      else getMsg(getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)))
19392                ----('\r 'Error: '\o 'Incorrect 'id-unify 'command. '\n)
19393      fi
19394    if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) .
19395
19396  ceq procIdUnify2(M, T =? T', D)
19397    = if X:[SubstitutionSet] :: SubstitutionSet
19398      then ('id-unify
19399            if D == unbounded then nil else '\s '`[ qid(string(D, 10)) '`] '\s fi
19400            'in eMetaPrettyPrint(getName(M)) ':
19401            eMetaPrettyPrint(M, T =? T')
19402            if X:[SubstitutionSet] == empty
19403            then '\n 'No 'unifier
19404            else procIdUnify3(M, T =? T', 0, X:[SubstitutionSet])
19405            fi)
19406      else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'id-unify 'command. '\n
19407      fi
19408    if X:[SubstitutionSet] := metaACUUnify(M, T, T') .
19409  eq procIdUnify2(M?, UP??:[UnificationProblem], D?) = getMsg(M?) [owise] .
19410
19411  eq procIdUnify3(M, UP, I, empty)
19412   = ('\n '\n 'No 'more 'solutions. '\n) .
19413  eq procIdUnify3(M, UP, I, S:Substitution | SS:SubstitutionSet)
19414   = '\n '\n 'Solution qid(string(I + 1, 10))
19415      if S:Substitution == none
19416      then '\n 'empty 'substitution
19417      else '\n eMetaPrettyPrint(M, S:Substitution)
19418      fi
19419     procIdUnify3(M, UP, I + 1, SS:SubstitutionSet) .
19420
19421  *** VARIANT-UNIFY
19422
19423  ceq procVariantUnify(ME, M, T, D, VDS, DB)
19424    *** D is a bound on the number of solutions
19425    = if solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}
19426      then procVariantUnify2(
19427             getModule(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)),
19428             parseUnify(
19429               getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)),
19430               getVars(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))),
19431             getBound(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)))
19432      else getMsg(getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)))
19433                ----('\r 'Error: '\o 'Incorrect 'variant 'unify 'command. '\n)
19434      fi
19435    if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) .
19436
19437  ceq procVariantUnify2(M, T =? T', D)
19438    = if X:[SubstitutionSet] :: SubstitutionSet
19439      then ('variant 'unify
19440            if D == unbounded then nil else '\s '`[ qid(string(D, 10)) '`] '\s fi
19441            'in eMetaPrettyPrint(getName(M)) ':
19442            eMetaPrettyPrint(M, T =? T')
19443            if X:[SubstitutionSet] == empty
19444            then '\n 'No 'variant 'unifier
19445            else procVariantUnify3(M, T =? T', 0, X:[SubstitutionSet])
19446            fi)
19447      else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'variant 'unify 'command. '\n
19448      fi
19449    if X:[SubstitutionSet]
19450       := toSubstitution(
19451            metaVariantUnify(
19452               removeIds(axCohComplete(M), non-handled),
19453               T,
19454               T',
19455               highestVar((T,T')) + 1,
19456               minimal-unifiers reducible
19457            )
19458          ) .
19459  eq procVariantUnify2(M?, UP??:[UnificationProblem], D?) = getMsg(M?) [owise] .
19460
19461  eq procVariantUnify3(M, UP, I, empty)
19462   = ('\n '\n 'No 'more 'solutions. '\n) .
19463  eq procVariantUnify3(M, UP, I, S:Substitution | SS:SubstitutionSet)
19464   = '\n '\n 'Solution qid(string(I + 1, 10))
19465      if S:Substitution == none
19466      then '\n 'empty 'substitution
19467      else '\n eMetaPrettyPrint(M, S:Substitution)
19468      fi
19469     procVariantUnify3(M, UP, I + 1, SS:SubstitutionSet) .
19470
19471  *** ASYMMETRIC-VARIANT-UNIFY
19472
19473  ceq procAsymmetricVariantUnify(ME, M, T, D, VDS, DB)
19474    *** D is a bound on the number of solutions
19475    = if solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}
19476      then procAsymmetricVariantUnify2(
19477             getModule(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)),
19478             parseUnify(
19479               getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)),
19480               getVars(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB))),
19481             getBound(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)))
19482      else getMsg(getTerm(solveBubblesRewUnify(T, addInfoUnify(M), B, D, VDS, DB)))
19483                ----('\r 'Error: '\o 'Incorrect 'asymmetric 'variant 'unify 'command. '\n)
19484      fi
19485    if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) .
19486
19487  ---op axCohComplete : SModule -> SModule . --- Defined later in module AX-COHERENCE-COMPLETION
19488  ---op removeIds : Module ~> Module . ---Defined later in module VARIANTS
19489
19490  ceq procAsymmetricVariantUnify2(M, T =? T', D)
19491    = if X:[SubstitutionSet] :: SubstitutionSet
19492      then ('variant 'unify
19493            if D == unbounded then nil else '\s '`[ qid(string(D, 10)) '`] '\s fi
19494            'in eMetaPrettyPrint(getName(M)) ':
19495            eMetaPrettyPrint(M, T =? T')
19496            if X:[SubstitutionSet] == empty
19497            then '\n 'No 'asymmetric 'unifier
19498            else procAsymmetricVariantUnify3(M, T =? T', 0, X:[SubstitutionSet])
19499            fi)
19500      else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'asymmetric 'variant 'unify 'command. '\n
19501      fi
19502    if X:[SubstitutionSet]
19503       := toSubstitution(
19504            metaVariantUnify(
19505               removeIds(axCohComplete(M), non-handled),
19506               T,
19507               T',
19508               highestVar((T,T')) + 1,
19509               minimal-unifiers irreducible
19510            )
19511          ) .
19512  eq procAsymmetricVariantUnify2(M?, UP??:[UnificationProblem], D?) = getMsg(M?) [owise] .
19513
19514  eq procAsymmetricVariantUnify3(M, UP, I, empty)
19515   = ('\n '\n 'No 'more 'solutions. '\n) .
19516  eq procAsymmetricVariantUnify3(M, UP, I, S:Substitution | SS:SubstitutionSet)
19517   = '\n '\n 'Solution qid(string(I + 1, 10))
19518      if S:Substitution == none
19519      then '\n 'empty 'substitution
19520      else '\n eMetaPrettyPrint(M, S:Substitution)
19521      fi
19522     procAsymmetricVariantUnify3(M, UP, I + 1, SS:SubstitutionSet) .
19523
19524  *** GET-VARIANTS
19525
19526  ceq procGetVariants(ME, M, T, D, VDS, DB)
19527    *** D is a bound on the number of solutions
19528    = if solveBubblesRewUnify(T, M, B, D, VDS, DB) :: Tuple{Term,Module,Bool,OpDeclSet,Bound,Database}
19529      then procGetVariants2(
19530             getModule(solveBubblesRewUnify(T, M, B, D, VDS, DB)),
19531             parseGetVariants(
19532               getTerm(solveBubblesRewUnify(T, M, B, D, VDS, DB)),
19533               getVars(solveBubblesRewUnify(T, M, B, D, VDS, DB))),
19534             getBound(solveBubblesRewUnify(T, M, B, D, VDS, DB)))
19535      else getMsg(getTerm(solveBubblesRewUnify(T, M, B, D, VDS, DB)))
19536                ----('\r 'Error: '\o 'Incorrect 'get 'variants 'command. '\n)
19537      fi
19538    if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) .
19539
19540  eq parseGetVariants(T, VDS) = constsToVars(T, VDS) .
19541
19542  ceq procGetVariants2(M, T, D)
19543    = if X:[VariantFourSet] :: VariantFourSet
19544      then ('get 'variants
19545            if D == unbounded then nil else '\s '`[ qid(string(D, 10)) '`] '\s fi
19546            'in eMetaPrettyPrint(getName(M)) ':
19547            eMetaPrettyPrint(M, T)
19548            if X:[VariantFourSet] == empty
19549            then '\n 'No 'variant
19550            else procGetVariants3(M, T, 0, X:[VariantFourSet])
19551            fi)
19552      else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'get 'variants 'command. '\n
19553      fi
19554    if X:[VariantFourSet]
19555         := getVariants(
19556              removeIds(axCohComplete(M), non-handled),
19557              T,
19558              highestVar(T) + 1,
19559              ACUUnify irreducible minimal-unifiers
19560            ) .
19561  eq procGetVariants2(M?, UP??:[Term], D?) = getMsg(M?) [owise] .
19562
19563  eq procGetVariants3(M, T, I, (empty).VariantFourSet)
19564   = ('\n '\n 'No 'more 'variants. '\n) .
19565  eq procGetVariants3(M, T, I, {T1:Term,S:Substitution,S*:Substitution,NextVar:Nat} | VS:VariantFourSet)
19566   = '\n '\n 'Variant qid(string(I + 1, 10))
19567      '\n
19568      '`{
19569      eMetaPrettyPrint(M, T1:Term) '`,
19570      if S:Substitution == none
19571      then 'empty 'substitution
19572      else eMetaPrettyPrint(M, S:Substitution)
19573      fi
19574      '`}
19575     procGetVariants3(M, T, I + 1, VS:VariantFourSet) .
19576endfm
19577
19578----load check-input-module.maude
19579
19580---- Input modules are assumed not to have:
19581---- - idem
19582---- - assoc without comm
19583---- - variable alone in lhs
19584---- - owise
19585---- - iter
19586---- - built-ins
19587---- - something else?
19588
19589fmod CHECK-INPUT-MODULE is
19590  inc EXT-TERM .
19591  inc MODULE-HANDLING  * (op addOps to addOpsSE, op addEqs to addEqsSE, op addSorts to addSortsSE) .
19592  inc COMMAND-PROCESSING .
19593
19594  op checkModule : Module -> Bool .
19595  op attr : OpDeclSet Attr -> Bool .
19596  ops assocWithoutComm specialAttr : OpDeclSet -> Bool .
19597  op nonValidAttrs : OpDeclSet AttrSet -> Bool .
19598  op singleVbleInLHSs : RuleSet -> Bool .
19599  op singleVbleInLHSs : EquationSet -> Bool .
19600
19601  var  M : Module .
19602  var  F : Qid .
19603  var  TpL : TypeList .
19604  vars Tp Tp' Tp'' Tp''' : Type .
19605  var  TpS : TypeSet .
19606  var  At : Attr .
19607  vars AtS AtS' : AttrSet .
19608  vars ODS ODS' : OpDeclSet .
19609  var  V : Variable .
19610  var  VS : QidSet .
19611  var  RlS : RuleSet .
19612  var  EqS : EquationSet .
19613  vars T LHS RHS : Term .
19614  var  Cond : Condition .
19615
19616  eq attr(op F : TpL -> Tp [owise AtS] . ODS, At AtS) = true .
19617  eq attr(op F : TpL -> Tp [idem AtS] . ODS, idem) = true .
19618  eq attr(op F : TpL -> Tp [iter AtS] . ODS, iter) = true .
19619  eq attr(ODS, At) = false [owise] .
19620
19621  eq nonValidAttrs(op F : TpL -> Tp [At AtS] . ODS, At AtS') = true .
19622  eq nonValidAttrs(ODS, AtS) = false [owise] .
19623
19624  ---- special attributes only allowed for constants
19625  eq specialAttr(op F : TpL -> Tp [special(NEHL:NeHookList) AtS] . ODS) = TpL =/= nil .
19626  eq specialAttr(ODS) = false [owise] .
19627
19628  eq assocWithoutComm(op F : TpL -> Tp [assoc AtS] . ODS)
19629    = (not comm in AtS) or-else assocWithoutComm(ODS) .
19630  eq assocWithoutComm(ODS) = false [owise] .
19631
19632  eq singleVbleInLHSs(rl V => RHS [AtS] . RlS) = true .
19633  eq singleVbleInLHSs(crl V => RHS if Cond [AtS] . RlS) = true .
19634  eq singleVbleInLHSs(RlS) = false [owise] .
19635
19636  eq singleVbleInLHSs(eq V = RHS [AtS] . EqS) = true .
19637  eq singleVbleInLHSs(ceq V = RHS if Cond [AtS] . EqS) = true .
19638  eq singleVbleInLHSs(EqS) = false [owise] .
19639
19640  op isRegular : EquationSet -> Bool .
19641  op isRegular : RuleSet -> Bool .
19642  eq isRegular(eq LHS = RHS [AtS] . EqS) = (vars(LHS) == vars(RHS)) and isRegular(EqS) .
19643  eq isRegular(ceq LHS = RHS if Cond [AtS] . EqS) = (vars(LHS) == vars(RHS)) and isRegular(EqS) .
19644  eq isRegular(rl LHS => RHS [AtS] . RlS) = (vars(LHS) == vars(RHS)) and isRegular(RlS) .
19645  eq isRegular(crl LHS => RHS if Cond [AtS] . RlS) = (vars(LHS) == vars(RHS)) and isRegular(RlS) .
19646
19647  ---- We say that a term l is linear iff all its variables appear only once in it.
19648
19649  op linear : Term -> Bool .
19650  eq linear(T) = | vars(T) | == size(varlist(T)) .
19651
19652  ---- We say that a term l is C-nonlinear iff all its variables are c-nonlinear.
19653  ---- A variable x : s in vars(l) is c-nonlinear if it is nonlinear in l and
19654  ---- there is a \Sigma-subterm t with ls[t]_B <= s with a position p such that
19655  ---- t|_p = f(u,v) with B_f = {C_f}.
19656
19657  op c-nonlinear : Qid Term Module -> Bool . ---- the variable (1st arg.) is c-linear in the term (2nd arg.)
19658  op c-nonlinear : Term Module -> Bool . ---- no repeated variables and all such varaibles are c-linear
19659  op c-nonlinearAux : QidSet Module -> Bool .
19660  op c-nonlinearAux : Type Module -> Bool .
19661  op c-nonlinearAux : Type TypeSet OpDeclSet OpDeclSet Module -> Bool .
19662  op c-nonlinearAux2 : TypeList TypeSet OpDeclSet Module -> Bool .
19663
19664  eq c-nonlinear(V, T, M) = occurrences(V, T) > 1 and-then c-nonlinearAux(V, M) .
19665
19666  eq c-nonlinear(T, M) = not linear(T) and-then c-nonlinearAux(vars(T), M) .
19667
19668  eq c-nonlinearAux(V ; VS, M) = c-nonlinearAux(getType(V), M) or-else c-nonlinearAux(VS, M) .
19669  eq c-nonlinearAux(none, M) = false .
19670
19671  eq c-nonlinearAux(Tp, M) = c-nonlinearAux(Tp, Tp, getOps(M), getOps(M), M) .
19672
19673  ceq c-nonlinearAux(Tp, TpS, op F : Tp' Tp'' -> Tp''' [comm AtS] . ODS, ODS', M)
19674    = true
19675    if sortLeq(M, Tp''', Tp) .
19676  eq c-nonlinearAux(Tp, TpS, op F : TpL -> Tp' [AtS] . ODS, ODS', M)
19677    = if not comm in AtS and-then (not Tp in TpS and-then sortLeq(M, Tp', Tp))
19678      then c-nonlinearAux2(TpL, TpS, ODS', M) ---- all the sorts in that declarations have already been checked
19679      else c-nonlinearAux(Tp, TpS, ODS, ODS', M)
19680      fi
19681    [owise] .
19682  eq c-nonlinearAux(Tp, TpS, none, ODS, M)
19683    = false .
19684
19685  eq c-nonlinearAux2(Tp TpL, TpS, ODS, M)
19686    = if Tp in TpS
19687      then false
19688      else c-nonlinearAux(Tp, Tp ; TpS, ODS, ODS, M)
19689      fi
19690      or-else c-nonlinearAux2(TpL, TpS, ODS, M) .
19691  eq c-nonlinearAux2(nil, TpS, ODS, M) = false .
19692
19693---(
19694  eq c-permute(C, M) = C .
19695  eq c-permute(V, M) = V .
19696  ceq c-permute(F[T, T'], M)
19697    = c-combine(F, c-permute((T, T'), M)) # c-combine(F, c-permute((T', T), M))
19698    if isCommutative(M, F, getTypes(M, (T, T'))) .
19699  eq c-permute(F[TL], M)
19700    = c-combine(F, c-permute(TL, M))
19701    [owise] .
19702
19703  eq c-permute((T, T'), M)
19704    = c-permute(T, M) .
19705---)
19706endfm
19707
19708--------------------------------------------------------------------------------
19709
19710view SubstitutionSet from TRIV to SUBSTITUTIONSET is
19711  sort Elt to SubstitutionSet .
19712endv
19713
19714fmod MODULE-VARIANTS is
19715  inc CHECK-INPUT-MODULE .
19716  inc META-NARROWING-SEARCH * (op addOps to addOpsSE, op addEqs to addEqsSE, op addSorts to addSortsSE) .
19717  inc UNIT .
19718  pr 2TUPLE{SubstitutionSet, Nat}
19719      * (op `(_`,_`) : SubstitutionSet Nat -> Tuple{SubstitutionSet, Nat} to <_;_>,
19720         op p1_ : Tuple{SubstitutionSet, Nat} -> SubstitutionSet to getSubst,
19721         op p2_ : Tuple{SubstitutionSet, Nat} -> Nat to getIndex) .
19722  pr CONVERSION .
19723  pr EXT-TERM .
19724  pr EXT-DECL .
19725  pr 2TUPLE{Module,Module}
19726      * (op `(_`,_`) : Module Module -> Tuple{Module, Module} to <_;_>) .
19727
19728  vars V W : Variable .
19729  var  C : Constant .
19730  vars M M' M'' : Module .
19731  var  N : Nat .
19732  vars T T' T'' LHS RHS : Term .
19733  var  F : Qid .
19734  var  TL : TermList .
19735  var  AtS : AttrSet .
19736  var  VFS : VariantFourSet .
19737  var  VtS : VariantTripleSet .
19738  vars Tp Tp' Tp'' : Type .
19739  var  TpL : TypeList .
19740  var  Rl : Rule .
19741  var  RlS : RuleSet .
19742  var  Eq : Equation .
19743  var  EqS : EquationSet .
19744  var  ODS : OpDeclSet .
19745  var  Cond : Condition .
19746  var  S : Sort .
19747  var  VS : QidSet .
19748  vars Subst Subst' : Substitution .
19749  vars SubstS SubstS' : SubstitutionSet .
19750  var  H : Header .
19751  var  SS : SortSet .
19752  var  SSDS : SubsortDeclSet .
19753  vars OPDS OPDS' : OpDeclSet .
19754  var  MAS : MembAxSet .
19755  var  IL : ImportList .
19756
19757  ------------------------------------------------------------------------------
19758  ---- Given a module \mathcal{R} = (\Sigma, E, R)
19759  ---- removeIds(\mathcal{R}) = removeIds((\widehat{\Sigma}, B, \widetilde{U}), R)
19760  ---- where
19761  ---- - \widehat{\Sigma} is obtained by
19762  ----   - adding to $\Sigma$ a fresh new sort [Tuple] and
19763  ----   - a tupling operator <_,...,_> : [s] [s_1] ... [s_n] -> [Tuple]
19764  ----     for each rule l -> r if u_1 -> v_1 /\ ... /\ u_n -> v_n in R,
19765  ----     where l has sort s and v_i has sort s_i, 1 <= i <= n,
19766  ---- - B_f = E_f \cap {A_f, C_f}
19767  ---- - U_f = E_f \cap {LU_f, RU_f},
19768  ----   with LU_f and RU_f rewrite rules f(e,x) -> x and f(x,e) -> x, and
19769  ----   where \widetilde{U} is the B-coherence completion of U,
19770  ----   which is described as \widetilde{U} = \bigcup_{f:[s_1]...[s_n] -> [s] \in \Sigma} \widetilde{U}_f.
19771  ----   If A_f \not \in B_f, or A_f, C_f \in B_f, then \widetilde{U}_f = U_f.
19772  ----   Otherwise, if A_f \in B_f, but C_f \not \in B_f, then,
19773  ----     if LU_f \in U_f, then we add the rule f(x,f(e,y)) -> f(x,y) and
19774  ----     if RU_f \in U_f, then we add the rule f(f(x,e'),y) -> f(x,y).
19775  ---- makeIdsModule computes (\widehat{\Sigma}, B, \widetilde{U})
19776  ------------------------------------------------------------------------------
19777
19778  sort VariantProcedure .
19779  ops narrowing ad-hoc built-in : -> VariantProcedure .
19780  var VP : VariantProcedure .
19781----  sort IdsToRemove .                             ---- moved to COMMAND-PROCESSING
19782----  ops all non-handled : -> IdsToRemove .         ---- moved to COMMAND-PROCESSING
19783  var Which : IdsToRemove .
19784
19785  op removeIds : Module IdsToRemove ~> Module .  ---- moved to COMMAND-PROCESSING
19786  ---- given a module returns an equivalent module without ids but with variants of eqs and rls
19787  ---- the second argument may be either all (all id attributes are removed) or non-handled (only those not directly handled by Maude's unification are removed)
19788  op removeIds : Module IdsToRemove VariantProcedure ~> Module .
19789  ---- given a module returns an equivalent module without ids but with variants
19790  ---- of eqs and rls using the specified procedure for calculating variants
19791  op getVariants : Module Module RuleSet VariantProcedure -> RuleSet .
19792  ---- given a (\widehat{\Sigma}, B, \widetilde{U}) returns the variants of the given set of rules
19793  ---- It takes the modules without and with ids. The module with id attributes is used to normalize.
19794  op getVariants : Module Module EquationSet VariantProcedure -> EquationSet .
19795  ---- given a (\widehat{\Sigma}, B, \widetilde{U}) returns the variants of the given set of equations
19796  ---- It takes the modules without and with ids. The module with id attributes is used to normalize.
19797  op getVariants# : Module Module Term VariantProcedure -> VariantTripleSet .
19798  ---- given a (\widehat{\Sigma}, B, \widetilde{U}) returns the variants of a term (a tuple)
19799  op getRlVariants : Module VariantTripleSet Term Condition AttrSet -> RuleSet .
19800  ---- given the variants of a tuple < LHS, target terms in condition >, a RHS, a condition, and an attribute set,
19801  ---- it constructs the corresponding variant rules
19802  op getEqVariants : Module VariantTripleSet Term Condition AttrSet -> EquationSet .
19803  ---- given the variants of a tuple < LHS, target terms in condition >, a RHS, a condition, and an attribute set,
19804  ---- it constructs the corresponding variant equations
19805
19806  eq removeIds(M, Which) ---- Which may be either all or non-handled
19807    = if nonValidAttrs(getOps(M), owise idem) ----  iter
19808      then unitError('The 'module 'uses 'non-supported 'attributes '`(owise 'or 'idem`). '\n)
19809      else if singleVbleInLHSs(getRls(M))
19810           then unitError('The 'module 'contains 'rules 'with 'single 'variables 'in 'their 'left-hand 'sides. '\n)
19811           else if singleVbleInLHSs(getEqs(M))
19812                then unitError('The 'module 'contains 'equations 'with 'single 'variables 'in 'their 'left-hand 'sides. '\n)
19813                else if assocWithoutComm(getOps(M))
19814                     then moreGeneralEqs(moreGeneralRls(removeIds(M, Which, ad-hoc)))
19815                     else moreGeneralEqs(moreGeneralRls(removeIds(M, Which, narrowing))) ---- built-in
19816                     fi
19817                fi
19818           fi
19819      fi .
19820
19821  eq removeIds(M, Which, VP)
19822    ---- the narrowing based getVariant function requires a module with id attributes turned into eqs
19823    ---- and sort Tuple and tuple operators in; the ad-hoc getVariant (FroCos th 2) only needs the
19824    ---- tuple declarations.
19825    = setRls(
19826        addEqs(
19827          getVariants(makeIdsTuplingModule(M, Which), addTupling(M, M), getEqs(M), VP),
19828          makeIdsModule(M, Which)),
19829        getVariants(makeIdsTuplingModule(M, Which), addTupling(M, M), getRls(M), VP)) .
19830
19831  eq getVariants(M, M', Rl RlS, VP)
19832    = getRlVariants(M', getVariants#(M, M', makeTuple(lhs(Rl), cond(Rl)), VP), rhs(Rl), cond(Rl), atts(Rl))
19833      getVariants(M, M', RlS, VP) .
19834  eq getVariants(M, M', (none).RuleSet, VP) = none .
19835
19836  eq getVariants(M, M', Eq EqS, VP)
19837    = getEqVariants(M', getVariants#(M, M', makeTuple(lhs(Eq), cond(Eq)), VP), rhs(Eq), cond(Eq), atts(Eq))
19838      getVariants(M, M', EqS, VP) .
19839  eq getVariants(M, M', (none).EquationSet, VP) = none .
19840
19841  eq getVariants#(M, M', T, narrowing) = makeVariantSet(getVariants(M, T, 1, irreducible ACUUnify minimal-unifiers)) .
19842
19843  op makeVariantSet : VariantFourSet -> VariantTripleSet .
19844  eq makeVariantSet({T, Subst, Subst', N} | VFS) = {T, Subst, N, none, false} | makeVariantSet(VFS) .
19845  eq makeVariantSet(empty) = empty .
19846
19847  eq getRlVariants(M, ({'@<@_@>@[T], Subst, N, P:Parent, B:Bool} | VtS), T', nil, AtS)
19848    = (rl getTerm(metaNormalize(M, T))
19849         => getTerm(metaNormalize(M, _<<_(T', Subst))) [AtS] .)
19850      getRlVariants(M, VtS, T', nil, AtS) .
19851  eq getRlVariants(M, ({F[T, TL], Subst, N, P:Parent, B:Bool} | VtS), T', Cond, AtS)
19852    = (crl getTerm(metaNormalize(M, T))
19853         => getTerm(metaNormalize(M, _<<_(T', Subst)))
19854         if makeCond(TL, Cond, Subst) [AtS] .)
19855      getRlVariants(M, VtS, T', Cond, AtS) .
19856  eq getRlVariants(M, empty, T', Cond, AtS) = none .
19857
19858  eq getEqVariants(M, ({'@<@_@>@[T], Subst, N, P:Parent, B:Bool} | VtS), T', nil, AtS)
19859    = (eq getTerm(metaNormalize(M, T))
19860         = getTerm(metaNormalize(M, _<<_(T', Subst))) [AtS] .)
19861      getEqVariants(M, VtS, T', nil, AtS) .
19862  eq getEqVariants(M, ({F[T, TL], Subst, N, P:Parent, B:Bool} | VtS), T', Cond, AtS)
19863    = (ceq getTerm(metaNormalize(M, T))
19864         = getTerm(metaNormalize(M, _<<_(T', Subst)))
19865         if makeCond(TL, Cond, Subst) [AtS] .)
19866      getEqVariants(M, VtS, T', Cond, AtS) .
19867  eq getEqVariants(M, empty, T', Cond, AtS) = none .
19868
19869  ------------------------------------------------------------------------------
19870
19871  op makeTuple : Term Condition -> Term .
19872  op tupleTermList : Condition -> TermList .
19873  eq makeTuple(T, Cond)
19874    = if Cond == nil
19875      then qid("@<@_@>@")[T]
19876      else qid("@<@_" + tupleId(Cond) + "@>@")[T, tupleTermList(Cond)]
19877      fi .
19878  eq tupleTermList(T' => T'' /\ Cond) = (T'', tupleTermList(Cond)) .
19879  eq tupleTermList(T' = T'' /\ Cond) = tupleTermList(Cond) .
19880  eq tupleTermList(T' : S /\ Cond) = tupleTermList(Cond) .
19881  eq tupleTermList(T' := T'' /\ Cond) = (T', tupleTermList(Cond)) .
19882  eq tupleTermList(nil) = empty .
19883
19884  op makeCond : TermList Condition Substitution -> Condition .
19885  eq makeCond((T, TL), T' => T'' /\ Cond, Subst)
19886    = (T' << Subst) => T /\ makeCond(TL, Cond, Subst) .
19887  eq makeCond((T, TL), T' := T'' /\ Cond, Subst)
19888    = T := (T'' << Subst) /\ makeCond(TL, Cond, Subst) .
19889  eq makeCond(TL, T' = T'' /\ Cond, Subst)
19890    = (T' << Subst) = (T'' << Subst) /\ makeCond(TL, Cond, Subst) .
19891  eq makeCond(TL, T' : S /\ Cond, Subst)
19892    = (T' << Subst) : S /\ makeCond(TL, Cond, Subst) .
19893  eq makeCond(empty, nil, Subst) = nil .
19894
19895  ------------------------------------------------------------------------------
19896  ---- makeIdsTuplingModule((\Sigma, E, R)) computes (\widehat{\Sigma}, B, \widetilde{U})
19897  ------------------------------------------------------------------------------
19898  op makeIdsTuplingModule : Module IdsToRemove -> Module .
19899  op makeIdsModule : Module IdsToRemove -> Module .
19900  op addTupling : Module Module -> Module .
19901  ---- addTupling is called after makeIdsModule, which removes the eqs in it
19902  ---- the first module is the oiginal one, with the original eqs and rls
19903
19904  eq makeIdsTuplingModule(M, Which) = addTupling(M, makeIdsModule(M, Which)) .
19905
19906  eq makeIdsModule(M, Which)
19907    = setEqs(
19908        setOps(
19909          setRls(M, none),
19910          removeIds(getOps(M), Which)),
19911        idEqs(M, getOps(M), Which)) .
19912
19913  eq addTupling(M, M')
19914    = addOps(
19915        tuplingOps(M, getEqs(M), getRls(M)),
19916        addSorts('Tuple, M')) .
19917
19918  op idEqs : Module OpDeclSet IdsToRemove -> EquationSet .
19919  ---- the 3rd arguments indicates whether all the id attributes are to be removed (all), or only those not handled by the Maude unification algorithm (non-handled)
19920  eq idEqs(M, op F : Tp Tp' -> Tp'' [left-id(T) AtS] . ODS, Which)
19921    = (eq F[T, qid("X:" + string(type2qid(getKind(M, Tp))))] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('lIdEq1)
19922      if assoc in AtS and not comm in AtS
19923      then (eq F[qid("X:" + string(type2qid(getKind(M, Tp)))), F[T, qid("Y:" + string(type2qid(getKind(M, Tp))))]]
19924              = F[qid("X:" + string(type2qid(getKind(M, Tp)))), qid("Y:" + string(type2qid(getKind(M, Tp))))]
19925              [variant] .) ---- label('lIdEq2)
19926      else none
19927      fi
19928      idEqs(M, ODS, Which) .
19929  eq idEqs(M, op F : Tp Tp' -> Tp'' [right-id(T) AtS] . ODS, Which)
19930    = (eq F[qid("X:" + string(type2qid(getKind(M, Tp)))), T] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('rIdEq1)
19931      if assoc in AtS and not comm in AtS
19932      then (eq F[F[qid("X:" + string(type2qid(getKind(M, Tp)))), T], qid("Y:" + string(type2qid(getKind(M, Tp))))]
19933              = F[qid("X:" + string(type2qid(getKind(M, Tp)))), qid("Y:" + string(type2qid(getKind(M, Tp))))]
19934              [variant] .) ---- label('rIdEq2)
19935      else none
19936      fi
19937      idEqs(M, ODS, Which) .
19938  eq idEqs(M, op F : Tp Tp' -> Tp'' [id(T) AtS] . ODS, all)
19939    = if comm in AtS
19940      then (eq F[T, qid("X:" + string(type2qid(getKind(M, Tp))))] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('idEq1)
19941      else (eq F[qid("X:" + string(type2qid(getKind(M, Tp)))), T] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('idEq2)
19942           (eq F[T, qid("X:" + string(type2qid(getKind(M, Tp))))] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('idEq3)
19943      fi
19944      if assoc in AtS and not comm in AtS
19945      then (eq F[qid("X:" + string(type2qid(getKind(M, Tp)))), F[T, qid("Y:" + string(type2qid(getKind(M, Tp))))]]
19946              = F[qid("X:" + string(type2qid(getKind(M, Tp)))), qid("Y:" + string(type2qid(getKind(M, Tp))))]
19947              [variant] .)
19948           (eq F[F[qid("X:" + string(type2qid(getKind(M, Tp)))), T], qid("Y:" + string(type2qid(getKind(M, Tp))))]
19949              = F[qid("X:" + string(type2qid(getKind(M, Tp)))), qid("Y:" + string(type2qid(getKind(M, Tp))))]
19950              [variant] .)
19951      else none
19952      fi
19953      idEqs(M, ODS, all) .
19954  eq idEqs(M, op F : Tp Tp' -> Tp'' [id(T) AtS] . ODS, non-handled)
19955    ---- modified on Jan 13th, 2011
19956    ---- The ACU case is now handled, the id attributes are left if also AC
19957    = if assoc in AtS and comm in AtS
19958      then none
19959      else if comm in AtS
19960           then (eq F[T, qid("X:" + string(type2qid(getKind(M, Tp))))] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('idEq1)
19961           else (eq F[qid("X:" + string(type2qid(getKind(M, Tp)))), T] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('idEq2)
19962                (eq F[T, qid("X:" + string(type2qid(getKind(M, Tp))))] = qid("X:" + string(type2qid(getKind(M, Tp)))) [variant] .) ---- label('idEq3)
19963           fi
19964           if assoc in AtS and not comm in AtS
19965           then (eq F[qid("X:" + string(type2qid(getKind(M, Tp)))), F[T, qid("Y:" + string(type2qid(getKind(M, Tp))))]]
19966                   = F[qid("X:" + string(type2qid(getKind(M, Tp)))), qid("Y:" + string(type2qid(getKind(M, Tp))))]
19967                   [variant] .)
19968                (eq F[F[qid("X:" + string(type2qid(getKind(M, Tp)))), T], qid("Y:" + string(type2qid(getKind(M, Tp))))]
19969                   = F[qid("X:" + string(type2qid(getKind(M, Tp)))), qid("Y:" + string(type2qid(getKind(M, Tp))))]
19970                   [variant] .)
19971           else none
19972           fi
19973      fi
19974      idEqs(M, ODS, non-handled) .
19975  eq idEqs(M, ODS, Which) = none [owise] .
19976
19977  op removeIds : OpDeclSet IdsToRemove -> OpDeclSet .
19978  eq removeIds(op F : TpL -> Tp [id(T) AtS] . ODS, all)
19979    = removeIds(op F : TpL -> Tp [AtS] . ODS, all) .
19980 ceq removeIds(op F : TpL -> Tp [id(T) AtS] . ODS, non-handled)
19981    = removeIds(op F : TpL -> Tp [AtS] . ODS, non-handled)
19982    if not (assoc in AtS and comm in AtS) .
19983  eq removeIds(op F : TpL -> Tp [left-id(T) AtS] . ODS, Which)
19984    = removeIds(op F : TpL -> Tp [AtS] . ODS, Which) .
19985  eq removeIds(op F : TpL -> Tp [right-id(T) AtS] . ODS, Which)
19986    = removeIds(op F : TpL -> Tp [AtS] . ODS, Which) .
19987  eq removeIds(ODS, Which) = ODS [owise] .
19988
19989  op tuplingOps : Module EquationSet RuleSet -> OpDeclSet .
19990  op tuplingOps : Module EquationSet -> OpDeclSet .
19991  op tuplingOps : Module RuleSet -> OpDeclSet .
19992  eq tuplingOps(M, EqS, RlS) = tuplingOps(M, EqS) tuplingOps(M, RlS) .
19993  eq tuplingOps(M, eq LHS = RHS [AtS] . EqS)
19994    = (op qid("@<@_@>@") : getKind(M, leastSort(M, LHS)) -> '`[Tuple`] [none] .)
19995      tuplingOps(M, EqS) .
19996  eq tuplingOps(M, ceq LHS = RHS if Cond [AtS] . EqS)
19997    = (op qid("@<@_" + tupleId(Cond) + "@>@") : getKind(M, leastSort(M, LHS)) arityCond(M, Cond) -> '`[Tuple`] [none] .)
19998      tuplingOps(M, EqS) .
19999  eq tuplingOps(M, (none).EquationSet) = none .
20000  eq tuplingOps(M, rl LHS => RHS [AtS] . RlS)
20001    = (op qid("@<@_@>@") : getKind(M, leastSort(M, LHS)) -> '`[Tuple`] [none] .)
20002      tuplingOps(M, RlS) .
20003  eq tuplingOps(M, crl LHS => RHS if Cond [AtS] . RlS)
20004    = (op qid("@<@_" + tupleId(Cond) + "@>@") : getKind(M, leastSort(M, LHS)) arityCond(M, Cond) -> '`[Tuple`] [none] .)
20005      tuplingOps(M, RlS) .
20006  eq tuplingOps(M, (none).RuleSet) = none .
20007
20008  op arityCond : Module Condition -> TypeList .
20009  eq arityCond(M, T => T' /\ Cond) = getKind(M, leastSort(M, T')) arityCond(M, Cond) .
20010  eq arityCond(M, T := T' /\ Cond) = getKind(M, leastSort(M, T)) arityCond(M, Cond) .
20011  eq arityCond(M, T = T' /\ Cond) = arityCond(M, Cond) .
20012  eq arityCond(M, T : S /\ Cond) = arityCond(M, Cond) .
20013  eq arityCond(M, nil) = nil .
20014
20015  op tupleId : Condition -> String .
20016  eq tupleId(T => T' /\ Cond) = ",_" + tupleId(Cond) .
20017  eq tupleId(T := T' /\ Cond) = ",_" + tupleId(Cond) .
20018  eq tupleId(T = T' /\ Cond) = tupleId(Cond) .
20019  eq tupleId(T : S /\ Cond) = tupleId(Cond) .
20020  eq tupleId(Cond) = "" .
20021
20022  ------------------------------------------------------------------------------
20023  ---- See Th. 2, FroCos'09
20024  ---- TO DO: it doesn't give the minimal set of variants
20025
20026  op getVariants : Module Term SubstitutionSet -> VariantTripleSet .
20027  op getSubstitutions : Module QidSet OpDeclSet Nat -> Tuple{SubstitutionSet,Nat} .
20028  op getSubstitutions1 : Module Variable OpDeclSet Nat -> Tuple{SubstitutionSet,Nat} .
20029  op combineSubsts : SubstitutionSet SubstitutionSet -> SubstitutionSet .
20030
20031  eq getVariants#(M, M', T, ad-hoc)
20032    = getVariants(M', T, getSubst(getSubstitutions(M', vars(T), getOps(M'), 0))) .
20033
20034  eq getVariants(M, T, Subst | SubstS)
20035    = {getTerm(metaNormalize(M, T << Subst)), Subst, 0, none, false} | getVariants(M, T, SubstS) .
20036  eq getVariants(M, T, empty) = {T, none, 0, none, false} .
20037
20038  eq getSubstitutions(M, V ; VS, ODS, N)
20039    = < combineSubsts(
20040          getSubst(getSubstitutions1(M, V, ODS, N)),
20041          getSubst(getSubstitutions(M, VS, ODS, getIndex(getSubstitutions1(M, V, ODS, N))))) ;
20042        getIndex(getSubstitutions(M, VS, ODS, getIndex(getSubstitutions1(M, V, ODS, N)))) > .
20043  eq getSubstitutions(M, none, ODS, N) = < empty ; N > .
20044
20045  eq combineSubsts(Subst | SubstS, Subst' | SubstS')
20046    = (Subst ; Subst') | combineSubsts(SubstS, Subst' | SubstS') | combineSubsts(Subst, SubstS') .
20047  eq combineSubsts(SubstS, empty) = SubstS .
20048  eq combineSubsts(empty, SubstS) = SubstS .
20049
20050  ceq getSubstitutions1(M, V, op F : TpL -> Tp [id(T) AtS] . ODS, N)
20051    = < (V <- T) |
20052        if (assoc in AtS and-then not comm in AtS)
20053           and-then sortLeq(M, leastSort(M, F[qid("X@" + string(N, 10) + ":" + string(Tp)), T]), getType(V))
20054        then (V <- (F[qid("X@" + string(N, 10) + ":" + string(Tp)), T]))
20055           | (V <- (F[T, qid("X@" + string(s N, 10) + ":" + string(Tp))]))
20056        else empty
20057        fi |
20058        getSubst(getSubstitutions1(M, V, ODS, s s N)) ;
20059        getIndex(getSubstitutions1(M, V, ODS, s s N)) >
20060    if sortLeq(M, leastSort(M, T), getType(V)) . ----  ls[e] <= s ls[f(y,e)] <= s
20061  ceq getSubstitutions1(M, V, op F : TpL -> Tp [right-id(T) AtS] . ODS, N)
20062    = < (V <- T) |
20063        if (assoc in AtS and-then not comm in AtS)
20064           and-then sortLeq(M, leastSort(M, F[qid("X@" + string(N, 10) + ":" + string(Tp)), T]), getType(V))
20065        then (V <- F[T, qid("X@" + string(N, 10) + ":" + string(Tp))])
20066        else empty
20067        fi |
20068        getSubst(getSubstitutions1(M, V, ODS, s s N)) ;
20069        getIndex(getSubstitutions1(M, V, ODS, s s N)) >
20070    if sortLeq(M, leastSort(M, T), getType(V)) . ----  ls[e] <= s ls[f(y,e)] <= s
20071  ceq getSubstitutions1(M, V, op F : TpL -> Tp [left-id(T) AtS] . ODS, N)
20072    = < (V <- T) |
20073        if (assoc in AtS and-then not comm in AtS)
20074           and-then sortLeq(M, leastSort(M, F[qid("X@" + string(N, 10) + ":" + string(Tp)), T]), getType(V))
20075        then (V <- F[qid("X@" + string(s N, 10) + ":" + string(Tp)), T])
20076        else empty
20077        fi |
20078        getSubst(getSubstitutions1(M, V, ODS, s s N)) ;
20079        getIndex(getSubstitutions1(M, V, ODS, s s N)) >
20080    if sortLeq(M, leastSort(M, T), getType(V)) . ----  ls[e] <= s ls[f(y,e)] <= s
20081  eq getSubstitutions1(M, V, ODS, N) = < empty ; N > [owise] .
20082
20083  ------------------------------------------------------------------------------
20084  ---- Given a module with axioms B where for each f we have B_f \in {A_f,C_f},
20085  ---- we now define a rewrite theory (\Sigma, B', A), where for each f we have
20086  ---- B'_f = B_f if B_f =/= {A_f}, and B'_f = \emptyset if B_f == {A_f}, and
20087  ---- where A consists of rules of either the form
20088  ----  f(f(x, y), z) -> f(x, f(y, z))
20089  ---- or the form
20090  ----  f(x, f(y, z)) -> f(f(x, y), z)
20091  ---- for each f such that B_f == {A_f}. That is, for any such f we "choose" a
20092  ---- rule asociating f to the right or to the left (but only "one" of these possibilities).
20093
20094  ---- TO DO: I cannot set a timeout. If the first one doesn't work it hangs up!
20095  ---- TO DO: All terms are in their flatten form, when removing the assoc atributes I get error messages.
20096
20097  op removeLonelyAssocs : Module -> Module .
20098  ---- removes all assoc with no comm, returning an equivalent module
20099  op $removeLonelyAssocs : OpDeclSet -> OpDeclSet .
20100  ---- removes those assoc attributes that are not with the comm one
20101  op $removeLonelyAssocs : Module OpDeclSet OpDeclSet EquationSet ~> Module .
20102  ---- arg. 1 (Module): the module with assoc attribute removed
20103  ---- arg. 2 (OpDeclSet): initially all op. decls.; they are evaluated one by one,
20104  ----   adding the corresponding equation to the 4th arg. in the recursive call
20105  ---- arg. 3 (OpDeclSet): initially empty; evaluated op. decls. are added to this set
20106  ---- arg. 4 (EquationSet): assoc. eq. to be added to the module
20107  op $checkAEq : Module Equation -> Bool .
20108  ---- checks whether the assoc. eq. given as argument unifies with any lhs in the module
20109  ---- arg. 1 (Module): the module with assoc attribute removed
20110  ---- arg. 2 (Equation): tentative assoc. eq. to evaluate
20111  op $checkAEqAux : Module EquationSet -> Bool .
20112  ---- tries to narrow with the assoc. eq. (as a rule) on each lhs in the module.
20113  ---- arg. 1 (Module): module with assoc attribute removed, with the assoc. eq.
20114  ----   turned into a rule as single rule (no eqs.)
20115  ---- arg. 2 (EquationSet): eqs. in the original module
20116  op $anyLonelyAssoc : OpDeclSet -> Bool .
20117  ---- checks whether the module contains an operator with assoc and no comm
20118
20119  eq removeLonelyAssocs(M)
20120    = if $anyLonelyAssoc(getOps(M))
20121      then if nonValidAttrs(getOps(M), owise idem) ---- iter
20122           then unitError('The 'module 'uses 'non-supported 'attributes '`(owise 'or 'idem`). '`))
20123           else if singleVbleInLHSs(getRls(M))
20124                then unitError('The 'module 'contains 'rules 'with 'single 'variables 'in 'their 'left-hand 'sides. '`))
20125                else if singleVbleInLHSs(getEqs(M))
20126                     then unitError('The 'module 'contains 'equations 'with 'single 'variables 'in 'their 'left-hand 'sides. '`))
20127                     else $removeLonelyAssocs(setOps(M, $removeLonelyAssocs(getOps(M))), getOps(M), none, none)
20128                     fi
20129                fi
20130           fi
20131      else M
20132      fi .
20133
20134  ceq $removeLonelyAssocs(op F : Tp Tp -> Tp [assoc AtS] . OPDS)
20135    = op F : Tp Tp -> Tp [AtS] . $removeLonelyAssocs(OPDS)
20136    if not comm in AtS .
20137  eq $removeLonelyAssocs(OPDS) = OPDS [owise] .
20138
20139  ceq $removeLonelyAssocs(M, op F : TpL -> Tp [AtS] . OPDS, OPDS', EqS)
20140    = $removeLonelyAssocs(M, OPDS, op F : TpL -> Tp [AtS] . OPDS', EqS)
20141    if size(TpL) =/= 2 or not assoc in AtS or comm in AtS .
20142  ceq $removeLonelyAssocs(M, op F : Tp Tp -> Tp [assoc AtS] . OPDS, OPDS', EqS)
20143    = $removeLonelyAssocs(M, OPDS, op F : Tp Tp -> Tp [AtS] . OPDS', Eq EqS)
20144    if not comm in AtS
20145    /\ Str:String := string(type2qid(getKind(M, Tp)))
20146    /\ Eq := (eq F[F[qid("X:" + Str:String), qid("Y:" + Str:String)], qid("Z:" + Str:String)]
20147                = F[qid("X:" + Str:String), F[qid("Y:" + Str:String), qid("Z:" + Str:String)]] [label('assocEq)] .)
20148    /\ $checkAEq(M, Eq) .
20149  ceq $removeLonelyAssocs(M, op F : Tp Tp -> Tp [assoc AtS] . OPDS, OPDS', EqS)
20150    = $removeLonelyAssocs(M, OPDS, op F : Tp Tp -> Tp [AtS] . OPDS', Eq EqS)
20151    if not comm in AtS
20152    /\ Str:String := string(type2qid(getKind(M, Tp)))
20153    /\ Eq := (eq F[qid("X:" + Str:String), F[qid("Y:" + Str:String), qid("Z:" + Str:String)]]
20154                = F[F[qid("X:" + Str:String), qid("Y:" + Str:String)], qid("Z:" + Str:String)] [label('assocEq)] .)
20155    /\ $checkAEq(M, Eq) .
20156  eq $removeLonelyAssocs(M, none, OPDS', EqS) = addEqs(EqS, M) .
20157  eq $removeLonelyAssocs(M, op F : TpL -> Tp [AtS] . OPDS, OPDS', EqS) = unitError('assoc 'attributes 'cannot 'be 'removed 'for F) [owise] .
20158
20159  eq $checkAEq(M, Eq) = $checkAEqAux(setRls(setEqs(M, none), rulify(Eq)), getEqs(M)) .
20160
20161  ceq $checkAEqAux(M, Eq EqS)
20162    = T:Term == lhs(Eq) ---- the assoc eq doesn't unify with the equation's lhs
20163      and
20164      Subst:Substitution == none
20165      and-then
20166      $checkAEqAux(M, EqS)
20167    if {T:Term, Tp:Type, Subst:Substitution} := metaNarrow(M, lhs(Eq), 1) .
20168  eq $checkAEqAux(M, none) = true .
20169
20170  ceq $anyLonelyAssoc(op F : Tp Tp -> Tp [assoc AtS] . OPDS)
20171    = true
20172    if not comm in AtS .
20173  eq $anyLonelyAssoc(OPDS) = false [owise] .
20174endfm
20175
20176*******************************************************************************
20177
20178***
20179*** Interaction with the Persistent Database
20180***
20181
20182*** In the case of Full Maude, the persistent state of the system is given by
20183*** a single object which maintains the database of the system. This object
20184*** has an attribute \texttt{db}, to keep the actual database in which all the
20185*** modules being entered are stored, an attribute \texttt{default}, to keep
20186*** the identifier of the current module by default, and attributes
20187*** \texttt{input} and \texttt{output} to simplify the communication of the
20188*** read-eval-print loop given by the \texttt{LOOP-MODE} module with the
20189*** database. Using the notation for classes in object-oriented modules (see
20190*** Section~\ref{object-oriented-modules}) we can declare the class
20191*** \texttt{database} as follows:
20192***
20193***   class database | db : Database, input : TermList,
20194***                    output : QidList, default : ModId .
20195***
20196*** Since we assume that \texttt{database} is the only object class that has
20197*** been defined---so that the only objects of sort \texttt{Object} will
20198*** belong to the \texttt{database} class---to specify the admissible states
20199*** in the persistent state of \texttt{LOOP-MODE} for Full Maude, it is enough
20200*** to give the subsort declaration
20201***
20202***   subsort Object < State .
20203
20204***
20205*** \subsection{The \texttt{CONFIGURATION+} Module}
20206***
20207
20208*** change (2/20/2002): CONFIGURATION is now part of the prelude
20209***
20210*** fmod CONFIGURATION is
20211***   sort Oid Cid Attribute AttributeSet Configuration Object Msg .
20212***
20213***   subsort Attribute < AttributeSet .
20214***   subsorts Object Msg < Configuration .
20215***
20216***   op none : -> AttributeSet .
20217***   op _,_ : AttributeSet AttributeSet -> AttributeSet
20218***       [assoc comm id: none] .
20219***   op none : -> Configuration .
20220***   op __ : Configuration Configuration -> Configuration
20221***       [assoc comm id: none] .
20222***   op <_:_|_> : Oid Cid AttributeSet -> Object .
20223***   op <_:_| > : Oid Cid -> Object .
20224***
20225***   var O : Oid .
20226***   var C : Cid .
20227***
20228***   eq < O : C | > = < O : C | none > .
20229*** endfm
20230
20231*******************************************************************************
20232
20233***
20234*** Top Level Handling of the Persistent Database
20235***
20236
20237*** Note that, since the Full Maude specification is given as a system module
20238***Core Maude, object-oriented declarations cannot be given directly.
20239*** Instead, the equivalent declarations desugaring the desired
20240*** object-oriented declarations have to be specified. We use also the same
20241*** conventions discussed in Section~\ref{omod2mod} regarding the use of
20242*** variables instead of class names in the objects and in the addition of
20243*** variables of sort \texttt{AttributeSet} to range over the additional
20244*** attributes. As we shall see in Chapter~\ref{crc}, this convention will
20245*** allow us to extend the Full Maude system in a very simple and clean way.
20246
20247*** To allow the use of the object-oriented notation the predefined module
20248*** \texttt{CONFIGURATION}, presented in Section~\ref{omod2mod}, is included
20249*** in the following module \texttt{DATABASE-HANDLING}.
20250
20251
20252mod DATABASE-HANDLING is
20253---  inc META-LEVEL + PRE-VARIANT .
20254  inc META-LEVEL .
20255  inc CONFIGURATION .
20256  pr VIEW-META-PRETTY-PRINT .
20257  pr VIEW-PROCESSING .
20258  pr COMMAND-PROCESSING .
20259  pr PREDEF-UNITS .
20260  pr MODULE-VARIANTS .
20261  pr AX-COHERENCE-COMPLETION .
20262  pr HELP .
20263
20264  var  F : Qid .
20265  var  QIL : QidList .
20266  var  NQIL NQIL' NQIL'' : NeQidList .
20267  vars T T' T'' T3 : Term .
20268  var  TL : TermList .
20269  var  DB DB' : Database .
20270  vars ME ME' ME'' : ModuleExpression .
20271  vars QIL' QIL'' : QidList .
20272  vars MNS MNS' MNS'' MNS3 MNS4 : Set{ModuleName} .
20273  var  VE : ViewExp .
20274  var  VES : Set{ViewExp} .
20275  vars MIS MIS' : Set{ModuleInfo} .
20276  var  VIS : Set{ViewInfo} .
20277  vars PDS PDS' : Set{ParameterDecl} .
20278  var  B : Bool .
20279  var  I : Import .
20280  var  IL : ImportList .
20281  var  MN : ModuleName .
20282
20283  op initialDatabase : -> Database .
20284  eq initialDatabase
20285    = insTermModule('META-MODULE,
20286        addOps(getOps(#UP#),
20287          addSorts(getSorts(#UP#),
20288            addImports(getImports(#UP#), upModule('META-MODULE, false)))),
20289        emptyDatabase) .
20290---(
20291  eq initialDatabase
20292    = insTermModule('META-MODULE,
20293        addOps(getOps(#UP#),
20294          addSorts(getSorts(#UP#),
20295            addImports(getImports(#UP#), upModule('META-MODULE, false)))),
20296      insertTermView('TRIV,
20297        ('view_from_to_is_endv['token[''TRIV.Qid],'token[''TRIV.Qid],'token[
20298         ''TRIV.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
20299         ''Elt.Qid]]]),
20300      insertTermView('Bool,
20301        ('view_from_to_is_endv['token[''Bool.Qid],'token[''TRIV.Qid],'token[
20302         ''BOOL.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Bool.Qid]]]),
20303      insertTermView('Nat,
20304        ('view_from_to_is_endv['token[''Nat.Qid],'token[''TRIV.Qid],'token[
20305         ''NAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Nat.Qid]]]),
20306      insertTermView('Int,
20307        ('view_from_to_is_endv['token[''Int.Qid],'token[''TRIV.Qid],'token[
20308         ''INT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Int.Qid]]]),
20309      insertTermView('Rat,
20310        ('view_from_to_is_endv['token[''Rat.Qid],'token[''TRIV.Qid],'token[
20311         ''RAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Rat.Qid]]]),
20312      insertTermView('Float,
20313        ('view_from_to_is_endv['token[''Float.Qid],'token[''TRIV.Qid],'token[
20314         ''FLOAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
20315         ''Float.Qid]]]),
20316      insertTermView('String,
20317        ('view_from_to_is_endv['token[''String.Qid],'token[''TRIV.Qid],'token[
20318         ''STRING.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
20319         ''String.Qid]]]),
20320      insertTermView('Qid,
20321        ('view_from_to_is_endv['token[''Qid.Qid],'token[''TRIV.Qid],'token[
20322         ''QID.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Qid.Qid]]]),
20323      insertTermView('STRICT-WEAK-ORDER,
20324        ('view_from_to_is_endv['token[''STRICT-WEAK-ORDER.Qid],'token[''TRIV.Qid],
20325         'token[''STRICT-WEAK-ORDER.Qid],'sort_to_.['sortToken[''Elt.Qid],
20326         'sortToken[''Elt.Qid]]]),
20327      insertTermView('STRICT-TOTAL-ORDER,
20328        ('view_from_to_is_endv['token[''STRICT-TOTAL-ORDER.Qid],
20329         'token[''STRICT-WEAK-ORDER.Qid],'token[''STRICT-TOTAL-ORDER.Qid],
20330         'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Elt.Qid]]]),
20331      insertTermView('Nat<,
20332        ('view_from_to_is_endv['token[''Nat<.Qid],'token[''STRICT-TOTAL-ORDER.Qid],
20333         'token[''NAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Nat.Qid]]]),
20334      insertTermView('Int<,
20335        ('view_from_to_is_endv['token[''Int<.Qid],'token[''STRICT-TOTAL-ORDER.Qid],
20336         'token[''INT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Int.Qid]]]),
20337      insertTermView('Rat<,
20338        ('view_from_to_is_endv['token[''Rat<.Qid],'token[''STRICT-TOTAL-ORDER.Qid],'token[
20339         ''RAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Rat.Qid]]]),
20340      insertTermView('Float<,
20341        ('view_from_to_is_endv['token[''Float<.Qid],'token[''STRICT-TOTAL-ORDER.Qid],
20342         'token[''FLOAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
20343         ''Float.Qid]]]),
20344      insertTermView('String<,
20345        ('view_from_to_is_endv['token[''String<.Qid],'token[''STRICT-TOTAL-ORDER.Qid],
20346         'token[''STRING.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
20347         ''String.Qid]]]),
20348      insertTermView('TOTAL-PREORDER,
20349        ('view_from_to_is_endv['token[''TOTAL-PREORDER.Qid],'token[''TRIV.Qid],'token[
20350         ''TOTAL-PREORDER.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
20351         ''Elt.Qid]]]),
20352      insertTermView('TOTAL-ORDER,
20353        ('view_from_to_is_endv['token[''TOTAL-ORDER.Qid],'token[''TOTAL-PREORDER.Qid],
20354         'token[''TOTAL-ORDER.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
20355         ''Elt.Qid]]]),
20356      insertTermView('Nat<=,
20357        ('view_from_to_is_endv['token[''Nat<=.Qid],'token[''TOTAL-ORDER.Qid],
20358         'token[''NAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Nat.Qid]]]),
20359      insertTermView('Int<=,
20360        ('view_from_to_is_endv['token[''Int<=.Qid],'token[''TOTAL-ORDER.Qid],
20361         'token[''INT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Int.Qid]]]),
20362      insertTermView('Rat<=,
20363        ('view_from_to_is_endv['token[''Rat<=.Qid],'token[''TOTAL-ORDER.Qid],'token[
20364         ''RAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Rat.Qid]]]),
20365      insertTermView('Float<=,
20366        ('view_from_to_is_endv['token[''Float<=.Qid],'token[''TOTAL-ORDER.Qid],
20367         'token[''FLOAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
20368         ''Float.Qid]]]),
20369      insertTermView('String<=,
20370        ('view_from_to_is_endv['token[''String<=.Qid],'token[''TOTAL-ORDER.Qid],
20371         'token[''STRING.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
20372         ''String.Qid]]]),
20373      insertTermView('DEFAULT,
20374        ('view_from_to_is_endv['token[''DEFAULT.Qid],'token[''TRIV.Qid],'token[
20375         ''DEFAULT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[
20376         ''Elt.Qid]]]),
20377      insertTermView('Nat0,
20378        ('view_from_to_is_endv['token[''Nat0.Qid],'token[''DEFAULT.Qid],'token[
20379         ''NAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Nat.Qid]]]),
20380      insertTermView('Int0,
20381        ('view_from_to_is_endv['token[''Int0.Qid],'token[''DEFAULT.Qid],'token[
20382         ''INT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Int.Qid]]]),
20383      insertTermView('Rat0,
20384        ('view_from_to_is_endv['token[''Rat0.Qid],'token[''DEFAULT.Qid],'token[
20385         ''RAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Rat.Qid]]]),
20386      insertTermView('Float0,
20387        ('view_from_to_is_endv['token[''Float0.Qid],'token[''DEFAULT.Qid],
20388         'token[''FLOAT.Qid],'__['sort_to_.['sortToken[''Elt.Qid],'sortToken[
20389         ''Float.Qid]], 'op_to`term_.['bubble[''0.Qid],'bubble[''0.0.Qid]]]]),
20390      insertTermView('String0,
20391        ('view_from_to_is_endv['token[''String0.Qid],'token[''DEFAULT.Qid],
20392         'token[''STRING.Qid],'__['sort_to_.['sortToken[''Elt.Qid],'sortToken[
20393         ''String.Qid]],'op_to`term_.['bubble[''0.Qid],'bubble[''"".Qid]]]]),
20394      insertTermView('Qid0,
20395        ('view_from_to_is_endv['token[''Qid0.Qid],'token[''DEFAULT.Qid],'token[
20396         ''QID.Qid],'__['sort_to_.['sortToken[''Elt.Qid],'sortToken[''Qid.Qid]],
20397         'op_to`term_.['bubble[''0.Qid],'bubble['''.Qid]]]]),
20398      emptyDatabase)))))))))))))))))))))))))))))) .
20399---)
20400
20401*** We start by introducing a subsort \texttt{DatabaseClass} of sort
20402*** \texttt{Cid}, the operator declarations necessary for representing objects
20403*** in class \texttt{DatabaseClass} as defined above, and variables to range
20404*** over subclasses of class \texttt{DatabaseClass} and over attributes.
20405
20406  sort DatabaseClass .
20407  subsort DatabaseClass < Cid .
20408  op Database : -> DatabaseClass .
20409  op db :_ : Database -> Attribute .
20410  op input :_ : TermList -> Attribute .
20411  op output :_ : QidList -> Attribute .
20412  op default :_ : Header -> Attribute .
20413
20414  var Atts : AttributeSet .
20415  var X@DatabaseClass : DatabaseClass .
20416  var O : Oid .
20417
20418*** Next, we introduce an auxiliary function \texttt{parseHeader} to parse
20419*** names of user-defined modules, and a constant \texttt{nilTermList} of sort
20420*** \texttt{TermList}. Note that the name of a user-defined module must be a
20421*** single identifier (a token) or, for parameterized modules, its name---a
20422*** single identifier---and its interface.
20423
20424  op parseHeader : Term -> Qid .
20425  eq parseHeader('token[T]) = downQid(T) .
20426  ----eq parseHeader('_`(_`)['token[T], T']) = downQid(T) .
20427  eq parseHeader('_`{_`}['token[T], T']) = downQid(T) .
20428
20429  op nilTermList : -> TermList .
20430
20431*** Finally, we present the rules processing the inputs of the database. These
20432*** rules define the behavior of the system for the different commands,
20433*** modules, theories, and views entered into the system. For example, the
20434*** first rule processes the different types of modules entered to the system.
20435*** Note that the operators declared as constructors of sort \texttt{PreModule}
20436*** in the signature of Full Maude, given in
20437*** Appendix~\ref{signature-full-maude}, are declared with two arguments,
20438*** namely the name of the unit, or its name + its interface, and the list
20439*** of declarations of such a unit.
20440
20441  crl [module] :
20442     < O : X@DatabaseClass | db : DB, input : (F[T, T']), output : nil, default : ME, Atts >
20443     => < O : X@DatabaseClass |
20444           db : procModule(F[T, T'], DB), input : nilTermList,
20445           output : ('Introduced 'module header2Qid(parseHeader(T)) '\n),
20446           default : parseHeader(T), Atts >
20447     if  (F == 'fmod_is_endfm) or-else
20448        ((F == 'obj_is_endo)   or-else
20449        ((F == 'obj_is_jbo)    or-else
20450        ((F == 'mod_is_endm)   or-else
20451         (F == 'omod_is_endom)))) .
20452
20453*** Notice the message placed in the output channel, and the change in the
20454*** current module by default, which is now the new module just processed.
20455*** Since the name of the module \texttt{T} can be complex---a parameterized
20456*** module---some extra parsing has to be performed by the auxiliary function
20457*** \texttt{parseHeader}. Similar rules are given for the processing of
20458*** theories and views.
20459
20460  crl [theory] :
20461     < O : X@DatabaseClass | db : DB, input : (F[T, T']), output : nil, default : ME, Atts >
20462     => < O : X@DatabaseClass |
20463           db : procModule(F[T, T'], DB), input : nilTermList,
20464           output : ('Introduced 'theory header2Qid(parseHeader(T)) '\n),
20465           default : parseHeader(T), Atts >
20466     if  (F == 'fth_is_endfth) or-else
20467        ((F == 'th_is_endth)   or-else
20468         (F == 'oth_is_endoth)) .
20469
20470  rl [view] :
20471     < O : X@DatabaseClass | db : DB,
20472        input : ('view_from_to_is`endv[T, T', T'']),
20473        output : nil, default : ME, Atts >
20474     => < O : X@DatabaseClass |
20475           db : procView('view_from_to_is_endv[T, T', T'', 'none.ViewDeclSet], DB),
20476           input : nilTermList,
20477           output : ('Introduced 'view header2Qid(parseHeader(T)) '\n),
20478           default : ME, Atts > .
20479  rl [view] :
20480     < O : X@DatabaseClass | db : DB,
20481        input : ('view_from_to_is_endv[T, T', T'', T3]),
20482        output : nil, default : ME, Atts >
20483     => < O : X@DatabaseClass |
20484           db : procView('view_from_to_is_endv[T, T', T'', T3], DB),
20485           input : nilTermList,
20486           output : ('Introduced 'view header2Qid(parseHeader(T)) '\n),
20487           default : ME, Atts > .
20488
20489*** Commands are handled by rules as well. For example, the \texttt{down},
20490*** \texttt{reduce}, and \texttt{rewrite} commands are handled by the
20491*** following rules.
20492
20493  rl [down] :
20494     < O : X@DatabaseClass | db : DB, input : ('down_:_[T, T']), output : nil, default : ME, Atts >
20495     => < O : X@DatabaseClass |
20496           db : getDatabase(procDownCommand('down_:_[T, T'], ME, DB)),
20497           input : nilTermList,
20498           output : getQidList(procDownCommand('down_:_[T, T'], ME, DB)),
20499           default : ME, Atts > .
20500
20501  crl [red/rew/frew] :
20502     < O : X@DatabaseClass | db : DB, input : (F[T]), output : QIL, default : ME, Atts >
20503     => < O : X@DatabaseClass |
20504           db : getDatabase(procCommand(F[T], ME, DB)),
20505           input : nilTermList,
20506           output : getQidList(procCommand(F[T], ME, DB)),
20507           default : ME, Atts >
20508     if  (F == 'parse_.)    or-else
20509        ((F == 'red_.)      or-else
20510        ((F == 'reduce_.)   or-else
20511        ((F == 'rew_.)      or-else
20512        ((F == 'rewrite_.)  or-else
20513        ((F == 'frew_.)     or-else
20514        ((F == 'frewrite_.) or-else
20515        ((F == 'unify_.) or-else
20516         (F == 'id-unify_.) or-else
20517         (F == 'variant`unify_.) or-else
20518         (F == 'asymmetric`variant`unify_.) or-else
20519         (F == 'get`variants_.)
20520         ))))))) .
20521
20522  crl [search] :
20523     < O : X@DatabaseClass | db : DB, input : (F[T, T']), output : QIL, default : ME, Atts >
20524     => < O : X@DatabaseClass |
20525           db : getDatabase(procCommand(F[T, T'], ME, DB)),
20526           input : nilTermList,
20527           output : getQidList(procCommand(F[T, T'], ME, DB)),
20528           default : ME, Atts >
20529     if  (F == 'search_=>_.)  or-else
20530        ((F == 'search_=>1_.) or-else
20531        ((F == 'search_=>*_.) or-else
20532        ((F == 'search_=>+_.) or-else
20533        ((F == 'search_=>!_.) or-else
20534        ((F == 'search_~>_.)  or-else
20535        ((F == 'search_~>1_.) or-else
20536        ((F == 'search_~>*_.) or-else
20537        ((F == 'search_~>+_.) or-else
20538        ((F == 'search_~>!_.) or-else
20539        ((F == 'match_<=?_.)  or-else
20540         (F == 'xmatch_<=?_.))))))))))) .
20541
20542  rl [select] :
20543     < O : X@DatabaseClass | db : DB, input : ('select_.[T]), output : QIL, default : ME, Atts >
20544     => < O : X@DatabaseClass | db : DB, input : nilTermList, output : (QIL 'The eMetaPrettyPrint(parseModExp(T)) 'has 'been 'set 'as 'current 'module. '\n), default : parseModExp(T), Atts > .
20545
20546  rl [show-modules] :
20547     < O : X@DatabaseClass | db : DB,
20548        input : ('show`modules`..@Command@),
20549        output : nil, default : ME, Atts >
20550     => < O : X@DatabaseClass | db : DB, input : nilTermList,
20551           output : showModules(DB), default : ME, Atts > .
20552  rl [show-views] :
20553     < O : X@DatabaseClass | db : DB,
20554        input : ('show`views`..@Command@),
20555        output : nil, default : ME, Atts >
20556     => < O : X@DatabaseClass | db : DB, input : nilTermList,
20557           output : showViews(DB), default : ME, Atts >  .
20558
20559*** The \texttt{show module} command, which prints the specified module, or
20560*** the current one if no module name is specified, is handled by the
20561*** following rules.
20562
20563  crl [show-module] :
20564    < O : X@DatabaseClass | db : DB,
20565       input : ('show`module`..@Command@),
20566       output : nil, default : ME, Atts >
20567    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20568          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getTopModule(ME', DB')),
20569          default : ME', Atts >
20570    if < DB' ; ME' > := evalModExp(ME, DB) .
20571  crl [show-module] :
20572    < O : X@DatabaseClass | db : DB, input : ('show`module_.[T]), output : nil, default : ME,   Atts >
20573    => < O : X@DatabaseClass |
20574          db : DB', input : nilTermList,
20575          output : eMetaPrettyPrint(getFlatModule(ME'', DB'), getTopModule(ME'', DB')),
20576          default : ME, Atts >
20577    if < DB' ; ME'' > := evalModExp(parseModExp(T), DB) .
20578  crl [show-module] :
20579    < O : X@DatabaseClass | db : DB, input : ('show`module_.[T]), output : nil, Atts >
20580    => < O : X@DatabaseClass | db : DB, input : nil,
20581          output : ('Error 'evaluating 'the 'given 'module 'expression.), Atts >
20582    if evalModExp(ME:[ModuleExpression], DB':[Database]) := evalModExp(parseModExp(T), DB) .
20583
20584  crl [show-all] :
20585    < O : X@DatabaseClass | db : DB, input : ('show`all`..@Command@),
20586       output : nil, default : ME, Atts >
20587    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20588          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getFlatModule(ME', DB')),
20589          default : ME', Atts >
20590    if < DB' ; ME' > := evalModExp(ME, DB) .
20591  crl [show-all] :
20592    < O : X@DatabaseClass | db : DB, input : ('show`all_.[T]), output : nil, default : ME, Atts >
20593    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20594          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getFlatModule(ME', DB')),
20595          default : ME, Atts >
20596    if ME'' := parseModExp(T)
20597    /\ < DB' ; ME' > := evalModExp(ME'', DB) .
20598
20599  crl [show-vars] :
20600    < O : X@DatabaseClass | db : DB, input : ('show`vars`..@Command@),
20601       output : nil, default : ME, Atts >
20602    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20603          output : eMetaPrettyPrintVars(getVars(ME', DB')),
20604          default : ME', Atts >
20605    if DB' := database(evalModExp(ME, DB))
20606       /\ ME' := modExp(evalModExp(ME, DB)) .
20607  crl [show-vars] :
20608    < O : X@DatabaseClass | db : DB, input : ('show`vars_.[T]),
20609       output : nil, default : ME, Atts >
20610    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20611          output : eMetaPrettyPrintVars(getVars(ME', DB')),
20612          default : ME, Atts >
20613    if ME'' := parseModExp(T)
20614       /\ DB' := database(evalModExp(ME'', DB))
20615       /\ ME' := modExp(evalModExp(ME'', DB)) .
20616
20617  crl [show-sorts] :
20618    < O : X@DatabaseClass | db : DB, input : ('show`sorts`..@Command@), output : nil, default : ME, Atts >
20619    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20620          output : eMetaPrettyPrint(getSorts(getFlatModule(ME', DB'))),
20621          default : ME', Atts >
20622    if DB' := database(evalModExp(ME, DB))
20623       /\ ME' := modExp(evalModExp(ME, DB)) .
20624  crl [show-sorts] :
20625    < O : X@DatabaseClass | db : DB, input : ('show`sorts_.[T]), output : nil, default : ME, Atts >
20626    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20627          output : eMetaPrettyPrint(getSorts(getFlatModule(ME', DB'))),
20628          default : ME, Atts >
20629    if ME'' := parseModExp(T)
20630       /\ DB' := database(evalModExp(ME'', DB))
20631       /\ ME' := modExp(evalModExp(ME'', DB)) .
20632
20633  crl [show-ops] :
20634    < O : X@DatabaseClass | db : DB, input : ('show`ops`..@Command@), output : nil, default : ME, Atts >
20635    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20636          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getOps(getFlatModule(ME', DB'))),
20637          default : ME', Atts >
20638    if DB' := database(evalModExp(ME, DB))
20639       /\ ME' := modExp(evalModExp(ME, DB)) .
20640  crl [show-ops] :
20641    < O : X@DatabaseClass | db : DB, input : ('show`ops_.[T]), output : nil, default : ME, Atts >
20642    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20643          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getOps(getFlatModule(ME', DB'))),
20644          default : ME, Atts >
20645    if ME'' := parseModExp(T)
20646       /\ DB' := database(evalModExp(ME'', DB))
20647       /\ ME' := modExp(evalModExp(ME'', DB)) .
20648
20649  crl [show-mbs] :
20650    < O : X@DatabaseClass | db : DB, input : ('show`mbs`..@Command@), output : nil, default : ME, Atts >
20651    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20652          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getMbs(getFlatModule(ME', DB'))),
20653          default : ME', Atts >
20654    if DB' := database(evalModExp(ME, DB))
20655       /\ ME' := modExp(evalModExp(ME, DB)) .
20656  crl [show-mbs] :
20657    < O : X@DatabaseClass | db : DB, input : ('show`mbs_.[T]), output : nil, default : ME, Atts >
20658    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20659          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getMbs(getFlatModule(ME', DB'))),
20660          default : ME, Atts >
20661    if ME := parseModExp(T)
20662       /\ DB' := database(evalModExp(ME, DB))
20663       /\ ME' := modExp(evalModExp(ME, DB)) .
20664
20665  crl [show-eqns] :
20666    < O : X@DatabaseClass | db : DB, input : ('show`eqs`..@Command@), output : nil, default : ME, Atts >
20667    => < O : X@DatabaseClass |
20668          db : DB', input : nilTermList,
20669          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getEqs(getFlatModule(ME', DB'))),
20670         default : ME', Atts >
20671    if DB' := database(evalModExp(ME, DB))
20672       /\ ME' := modExp(evalModExp(ME, DB)) .
20673  crl [show-eqns] :
20674    < O : X@DatabaseClass | db : DB, input : ('show`eqs_.[T]), output : nil, default : ME, Atts >
20675    => < O : X@DatabaseClass |
20676          db : DB', input : nilTermList,
20677          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getEqs(getFlatModule(ME', DB'))),
20678          default : ME, Atts >
20679    if ME'' := parseModExp(T)
20680       /\ DB' := database(evalModExp(ME'', DB))
20681       /\ ME' := modExp(evalModExp(ME'', DB)) .
20682
20683  crl [show-rls] :
20684    < O : X@DatabaseClass | db : DB, input : ('show`rls`..@Command@), output : nil, default : ME, Atts >
20685    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20686          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getRls(getFlatModule(ME', DB'))),
20687          default : ME', Atts >
20688    if DB' := database(evalModExp(ME, DB))
20689       /\ ME' := modExp(evalModExp(ME, DB)) .
20690  crl [show-rls] :
20691    < O : X@DatabaseClass | db : DB, input : ('show`rls_.[T]), output : nil, default : ME, Atts >
20692    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20693          output : eMetaPrettyPrint(getFlatModule(ME', DB'), getRls(getFlatModule(ME', DB'))),
20694          default : ME, Atts >
20695    if ME'' := parseModExp(T)
20696       /\ DB' := database(evalModExp(ME'', DB))
20697       /\ ME' := modExp(evalModExp(ME'', DB)) .
20698
20699  crl [show-view] :
20700     < O : X@DatabaseClass | db : DB, input : ('show`view_.[T]), output : nil, default : ME, Atts >
20701     => < O : X@DatabaseClass | db : DB', input : nilTermList,
20702           output : eMetaPrettyPrint(DB', getView(parseViewExp(T), DB')),
20703           default : ME, Atts >
20704     if DB' := evalViewExp(parseViewExp(T), nil, DB) .
20705
20706  crl [set`protect_on] :
20707     < O : X@DatabaseClass |
20708           db : DB,
20709           input : ('set`protect_on`.[T]),
20710           output : QIL',
20711           default : ME, Atts >
20712     => < O : X@DatabaseClass |
20713           db : db(MIS, MNS, VIS, VES,
20714                   MNS' ME', MNS'', MNS3, QIL),
20715           input : nilTermList,
20716           output : (QIL' 'set 'protect header2QidList(ME') 'on '\n),
20717           default : ME, Atts >
20718     if ME' := parseModExp(T)
20719        /\ unitInDb(ME', DB)
20720        /\ db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL) := DB .
20721  crl [set`protect_off] :
20722     < O : X@DatabaseClass |
20723           db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL),
20724           input : ('set`protect_off`.[T]),
20725           output : QIL',
20726           default : ME, Atts >
20727     => < O : X@DatabaseClass |
20728           db : db(MIS, MNS, VIS, VES, remove(MNS', ME'), MNS'', MNS3, QIL),
20729           input : nilTermList,
20730           output : (QIL' 'set 'protect header2QidList(ME') 'off '\n),
20731           default : ME, Atts >
20732     if ME' := parseModExp(T) .
20733
20734  crl [set`extend_on] :
20735     < O : X@DatabaseClass |
20736           db : DB,
20737           input : ('set`extend_on`.[T]),
20738           output : QIL',
20739           default : ME, Atts >
20740     => < O : X@DatabaseClass |
20741           db : db(MIS, MNS, VIS, VES,
20742                   MNS', MNS'' ME', MNS3, QIL),
20743           input : nilTermList,
20744           output : (QIL' 'set 'extend header2QidList(ME') 'on '\n),
20745           default : ME, Atts >
20746     if ME' := parseModExp(T)
20747        /\ unitInDb(ME', DB)
20748        /\ db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL) := DB .
20749  crl [set`extend_off] :
20750     < O : X@DatabaseClass |
20751           db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL),
20752           input : ('set`extend_off`.[T]),
20753           output : QIL',
20754           default : ME, Atts >
20755     => < O : X@DatabaseClass |
20756           db : db(MIS, MNS, VIS, VES, MNS', remove(MNS'', ME'), MNS3, QIL),
20757           input : nilTermList,
20758           output : (QIL' 'set 'extend header2QidList(ME') 'off '\n),
20759           default : ME, Atts >
20760     if ME' := parseModExp(T) .
20761
20762  crl [set`include_on] :
20763     < O : X@DatabaseClass |
20764           db : DB,
20765           input : ('set`include_on`.[T]),
20766           output : QIL',
20767           default : ME, Atts >
20768     => < O : X@DatabaseClass |
20769           db : db(MIS, MNS, VIS, VES,
20770                   MNS', MNS'', MNS3 . ME', QIL),
20771           input : nilTermList,
20772           output : (QIL' 'set 'include header2QidList(ME') 'on '\n),
20773           default : ME, Atts >
20774     if ME' := parseModExp(T)
20775        ----/\ unitInDb(ME', DB)
20776        /\ db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL) := DB .
20777  crl [set`include_off] :
20778     < O : X@DatabaseClass |
20779           db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL),
20780           input : ('set`include_off`.[T]),
20781           output : QIL',
20782           default : ME, Atts >
20783     => < O : X@DatabaseClass |
20784           db : db(MIS, MNS, VIS, VES, MNS', MNS'', remove(MNS3, ME'), QIL),
20785           input : nilTermList,
20786           output : (QIL' 'set 'include header2QidList(ME') 'off '\n),
20787           default : ME, Atts >
20788     if ME' := parseModExp(T) .
20789
20790  crl [load] :
20791     < O : X@DatabaseClass |
20792           db : DB,
20793           input : ('load_.[T]),
20794           output : QIL',
20795           default : ME, Atts >
20796     => < O : X@DatabaseClass |
20797           db : getDatabase(procLoad(T, ME, DB)),
20798           input : nilTermList,
20799           output : getQidList(procLoad(T, ME, DB)),
20800           default : ME, Atts >
20801     if ME' := parseModExp(T) .
20802
20803  eq 'rm`ids`..@Command@ = 'remove`identity`attributes`..@Command@ .
20804  eq 'rm`ids_.[T] = 'remove`identity`attributes_.[T] .
20805
20806  crl [remove-id-attributes] :
20807    < O : X@DatabaseClass | db : DB,
20808       input : ('remove`identity`attributes`..@Command@),
20809       output : nil, default : ME, Atts >
20810    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20811          output : (eMetaPrettyPrint(getFlatModule(ME', DB'), removeIds(getFlatModule(ME', DB'), all))),
20812          default : ME', Atts >
20813    if < DB' ; ME' > := evalModExp(ME, DB) .
20814  crl [remove-id-attributes] :
20815    < O : X@DatabaseClass | db : DB, input : ('remove`identity`attributes_.[T]), output : nil, default : ME,   Atts >
20816    => < O : X@DatabaseClass |
20817          db : DB', input : nilTermList,
20818          output : (eMetaPrettyPrint(getFlatModule(ME'', DB'), removeIds(axCohComplete(getFlatModule(ME'', DB')), all))),
20819          default : ME, Atts >
20820    if < DB' ; ME'' > := evalModExp(parseModExp(T), DB) .
20821
20822  eq 'rm`nh`ids`..@Command@ = 'remove`non-handled`identity`attributes`..@Command@ .
20823  eq 'rm`nh`ids_.[T] = 'remove`non-handled`identity`attributes_.[T] .
20824
20825  crl [remove-id-attributes] :
20826    < O : X@DatabaseClass | db : DB,
20827       input : ('remove`non-handled`identity`attributes`..@Command@),
20828       output : nil, default : ME, Atts >
20829    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20830          output : (eMetaPrettyPrint(getFlatModule(ME', DB'), removeIds(getFlatModule(ME', DB'), non-handled))),
20831          default : ME', Atts >
20832    if < DB' ; ME' > := evalModExp(ME, DB) .
20833  crl [remove-id-attributes] :
20834    < O : X@DatabaseClass | db : DB, input : ('remove`non-handled`identity`attributes_.[T]), output : nil, default : ME,   Atts >
20835    => < O : X@DatabaseClass |
20836          db : DB', input : nilTermList,
20837          output : (eMetaPrettyPrint(getFlatModule(ME'', DB'), removeIds(getFlatModule(ME'', DB'), non-handled))),
20838          default : ME, Atts >
20839    if < DB' ; ME'' > := evalModExp(parseModExp(T), DB) .
20840
20841  crl [remove-assoc-attributes] :
20842    < O : X@DatabaseClass | db : DB,
20843       input : ('remove`assoc`attributes`..@Command@),
20844       output : nil, default : ME, Atts >
20845    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20846          output : (eMetaPrettyPrint(getFlatModule(ME', DB'), removeLonelyAssocs(getFlatModule(ME', DB')))),
20847          default : ME', Atts >
20848    if < DB' ; ME' > := evalModExp(ME, DB) .
20849  crl [remove-assoc-attributes] :
20850    < O : X@DatabaseClass | db : DB, input : ('remove`assoc`attributes_.[T]), output : nil, default : ME,   Atts >
20851    => < O : X@DatabaseClass |
20852          db : DB', input : nilTermList,
20853          output : (eMetaPrettyPrint(getFlatModule(ME'', DB'), removeLonelyAssocs(getFlatModule(ME'', DB')))),
20854          default : ME, Atts >
20855    if < DB' ; ME'' > := evalModExp(parseModExp(T), DB) .
20856
20857  crl [acu-coherence-completion] :
20858    < O : X@DatabaseClass | db : DB,
20859       input : ('ax`coherence`completion`..@Command@),
20860       output : nil, default : ME, Atts >
20861    => < O : X@DatabaseClass | db : DB', input : nilTermList,
20862          output : (eMetaPrettyPrint(getFlatModule(ME', DB'), axCohComplete(getFlatModule(ME', DB')))),
20863          default : ME', Atts >
20864    if < DB' ; ME' > := evalModExp(ME, DB) .
20865  crl [acu-coherence-completion] :
20866    < O : X@DatabaseClass | db : DB, input : ('ax`coherence`completion_.[T]), output : nil, default : ME,   Atts >
20867    => < O : X@DatabaseClass |
20868          db : DB', input : nilTermList,
20869          output : (eMetaPrettyPrint(getFlatModule(ME'', DB'), axCohComplete(getFlatModule(ME'', DB')))),
20870          default : ME, Atts >
20871    if < DB' ; ME'' > := evalModExp(parseModExp(T), DB) .
20872
20873  rl [error] :
20874     < O : X@DatabaseClass |
20875        db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, NQIL),
20876        input : TL, output : nil, default : ME, Atts >
20877     => < O : X@DatabaseClass |
20878           db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, nil),
20879           input : TL, output : NQIL, default : ME, Atts > .
20880
20881  *** Auxiliary Functions
20882
20883  op showViews : Database -> QidList .
20884  op showModules : Database -> QidList .
20885
20886  eq showViews(db(MIS, MNS, VIS, (VE # VES), MNS', MNS'', MNS3, QIL))
20887    = (eMetaPrettyPrint(VE) '\n
20888       showViews(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))) .
20889  eq showViews(
20890       db(MIS, MNS, VIS, emptyViewExpSet, MNS', MNS'', MNS3, QIL))
20891    = nil .
20892
20893  eq showModules(
20894       db(MIS, (MN . MNS), VIS, VES, MNS', MNS'', MNS3, QIL))
20895    = (eMetaPrettyPrint(MN) '\n
20896       showModules(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))) .
20897  eq showModules(
20898    db(MIS, emptyModuleNameSet, VIS, VES, MNS', MNS'', MNS3, QIL))
20899    = nil .
20900
20901  rl [help] :
20902     < O : X@DatabaseClass | input : ('help`..@Command@), output : QIL, Atts >
20903     => < O : X@DatabaseClass | input : nilTermList, output : fm-help, Atts > .
20904endm
20905
20906*******************************************************************************
20907fmod TEXT-STYLE is
20908--- pr META-LEVEL + PRE-VARIANT .
20909 pr META-LEVEL .
20910
20911 var QL : QidList .
20912
20913 op green : QidList -> QidList .
20914 eq green(QL) = '\g QL '\o .
20915
20916 op yellow : QidList -> QidList .
20917 eq yellow(QL) = '\y QL '\o .
20918
20919 op red : QidList -> QidList .
20920 eq red(QL) = '\r QL '\o .
20921
20922 op bold : QidList -> QidList .
20923 eq bold(QL) = '\! QL '\o .
20924endfm
20925
20926*******************************************************************************
20927
20928***
20929*** The Full Maude Module
20930***
20931
20932*** We now give the rules to initialize the loop, and to specify the
20933*** communication between the loop---the input/output of the system---and the
20934*** database.  Depending on the kind of input that the database receives, its
20935*** state will be changed, or some output will be generated.
20936
20937fmod MOD-EXPRS is
20938  pr FM-MOD-EXPRS .
20939endfm
20940
20941mod FULL-MAUDE is
20942  pr META-FULL-MAUDE-SIGN .
20943  pr DATABASE-HANDLING .
20944  inc LOOP-MODE .
20945  pr BANNER .
20946
20947*** The state of the persistent system, which is supported by the built-in
20948*** module \texttt{LOOP-MODE}, described in Section~\ref{loop}, is represented
20949*** as a single object.
20950
20951  subsort Object < State .
20952
20953  op o : -> Oid .
20954  op init : -> System .
20955
20956  var  Atts : AttributeSet .
20957  var  X@DatabaseClass : DatabaseClass .
20958  var  O : Oid .
20959  var  DB : Database .
20960  var  ME : Header .
20961  var  QI : Qid .
20962  vars QIL QIL' QIL'' : QidList .
20963  var  TL : TermList .
20964  var  N : Nat .
20965  vars RP RP' : ResultPair .
20966
20967  rl [init] :
20968     init
20969     => [nil,
20970         < o : Database |
20971            db : initialDatabase,
20972            input : nilTermList, output : nil,
20973            default : 'CONVERSION >,
20974         ('\n '\t '\s '\s '\s '\s string2qidList(banner) '\n)] .
20975
20976*** When some text has been introduced in the loop, the first argument of the
20977*** operator \verb~[_,_,_,]~ is different from \texttt{nil}, and we can use
20978*** this fact to activate the following rule, that enters an input such as a
20979*** module or a command from the user into the database.  The constant
20980*** \texttt{GRAMMAR} names the module containing the signature defining the
20981*** top level syntax of Full Maude (see Section~\ref{sec:signature} and
20982*** Appendix~\ref{signature-full-maude}). This signature is used by the
20983*** \texttt{metaParse} function to parse the input. PD the input is
20984*** syntactically valid\footnote{Of course, the input may be syntactically
20985*** valid, but not semantically valid, since further processing---for example,
20986*** of bubbles---may reveal a semantic inconsistency.}, the parsed input is
20987*** placed in the \texttt{input} attribute of the database object; otherwise,
20988*** an error message is placed in the output channel of the loop.
20989
20990  rl [in] :
20991    [QI QIL,
20992     < O : X@DatabaseClass |
20993         db : DB, input : nilTermList, output : nil, default : ME, Atts >,
20994     QIL']
20995    => if metaParse(GRAMMAR, QI QIL, '@Input@) :: ResultPair
20996       then [nil,
20997             < O : X@DatabaseClass | db : DB,
20998                 input : getTerm(metaParse(GRAMMAR, QI QIL, '@Input@)),
20999                 output : nil, default : ME, Atts >,
21000              QIL']
21001       else [nil,
21002             < O : X@DatabaseClass | db : DB, input : nilTermList,
21003                 output : ('\r 'Warning:
21004                           printSyntaxError(metaParse(GRAMMAR, QI QIL, '@Input@),
21005                             QI QIL)
21006                           '\n
21007                           '\r 'Error: '\o 'No 'parse 'for 'input. '\n),
21008                 default : ME, Atts >,
21009             QIL']
21010       fi .
21011
21012*** When the \texttt{output} attribute of the persistent object contains a
21013*** nonempty list of quoted identifiers, the \texttt{out} rule moves it to the
21014*** third argument of the loop. Then the Core Maude system displays it in the
21015*** terminal.
21016
21017  rl [out] :
21018    [QIL,
21019     < O : X@DatabaseClass |
21020         db : DB, input : TL, output : (QI QIL'), default : ME, Atts >,
21021     QIL'']
21022    => [QIL,
21023        < O : X@DatabaseClass |
21024            db : DB, input : TL, output : nil, default : ME, Atts >,
21025        (QI QIL' QIL'')] .
21026endm
21027
21028*******************************************************************************
21029
21030loop init .
21031
21032--- trace exclude FULL-MAUDE .
21033
21034---- set show loop stats on .
21035---- set show loop timing on .
21036set show advisories on .
21037
21038