*** before distributing: *** - restore evalPreUnit, procUnit4 *** - trace exclude FULL-MAUDE *** *** Full Maude specification version 2.0.1-9 *** To be run on Maude Alpha83a *** *** last modification: February 2nd, 2004 *** author: Francisco Duran *** ***( This file is part of the Maude 2 interpreter. Copyright 1997-2003 SRI International, Menlo Park, CA 94025, USA. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. ) *** Last changes: *** *** - Now works with Maude Alpha83a *** *** - The lazy evaluation of modules is working. When a module is redefined *** its dependent modules are removed only if generated internally. Those *** introduced by the user save their term representation, from which the *** whole processing can take place. They will be recompiled by need. *** *** - Bugs fixed: *** *** - bug in the handling of kinds in renamings *** *** - bug in the handling of up/down *** *** - bug in the evaluation of theories *** *** - memberships in conditions are now correctly handled *** *** - kinds can now appear in op decl *** *** - and many others (thanks go to Steven, Peter, Dilia, Nirman, ...) *** *** - The form of qualifying sorts coming from the parameters in *** parameterized modules has changed AGAIN: The sort Elt coming from *** X :: TRIV is now written as X@Elt (Note that sort names cannot contain *** dots anymore). *** *** - Parameters are enclosed in parentheses (Note that square brackets *** are now used for kinds, the unbiguity is unavoidable). Thus, for example, *** now a module LIST(X :: TRIV) can have a sort List(X). If there are *** multiple parameters, these must be separated by a vertical bar (|), *** instead of a comma. Commas are forbidden inside sort names because *** they are used as part of the syntax for kinds. And to be consistent we *** do the same for defining module interfaces. Thus, a module *** PAIR(X :: TRIV, Y :: TRIV) is now written PAIR(X :: TRIV | Y :: TRIV), *** and a sort Pair(X, Y) in it as Pair(X | Y). *** Note that | is not an special character, and therefore the white spaces *** around it are important. Note that inside terms ---in membership axioms *** and qualifications--- qualified sorts must appear in their equivalent *** single identifier form. That is, Pair(X | Y) should be used in these *** cases as Pair`(X`|`Y`). The metarepresentation of this sort is *** 'Pair`(X`|`Y`). *** *** - Tuples are built with the syntax TUPLE[size](|_separated_list_of_views). *** For example, given a view Nat from TRIV to NAT we can define pairs of *** nats with TUPLE[2](Nat | Nat). *** *** - The model-checker is loaded before the full maude modules, so that *** it can be used. *** *** - match, xmatch, search and frewrite work. *** *** - The syntax for red and rew is finally as their syntax in Maude, i.e, *** one can now write things like (rew [2] in FOO : foo .). *** *** - Statements attributes (metadata and label) and the new syntax for *** statements in supported. *** *** - The general case of conditions is handled. *** *** - ~> supported. *** *** - Kinds handled. *** *** - The format, iter, and frozen attributes are supported. *** *** - Object-oriented modules include a module CONFIGURATION+, which *** imports CONFIGURATION, defines a function *** op class : Object -> Cid . *** returning the actual class of the given object, and add syntax *** for objects with no attributes <_:_| >. Classes without attributes *** are defined with syntax class CLASS-NAME . *** *** Things to come: *** *** - Commands missing: continue ... *** *** - On parameterized theories and views: linked parameters, composed and *** lifted views, and default views. *** *** - The ditto attribute is not correctly handled. *** *** - ops names in op declarations *** *** known bugs: *** *** - Check: possibly it's necessary to convert constans back into vbles in *** procViewAux *** *** - Parameterized sorts don't work in sort constraints (nor by themselves, *** nor in the conditions of axioms. They are accepted in their equivalent *** single token form but do not get instantiated *** cmb (A, B) S : PFun(X, Y) if not(A in dom(S)) /\ S : PFun`(X`,Y`) . *** *** Internal changes to be done: *** *** - correct treatment of error terms *** *** - perhaps should be good to distinguish between modules and premodules load model-checker ******************************************************************************* *** *** 2 The Signature of Full Maude *** ******************************************************************************* fmod EXTENDED-SORTS is sorts SortToken ViewToken Sort Kind Type SortList TypeList ViewExp ModExp . subsorts SortToken < Sort < SortList < TypeList . subsorts Sort Kind < Type < TypeList . subsort ViewToken < ViewExp . op _`(_`) : Sort ViewExp -> Sort [prec 40] . op __ : SortList SortList -> SortList [assoc] . op __ : TypeList TypeList -> TypeList [assoc] . op `[_`] : Sort -> Kind . op _|_ : ViewExp ViewExp -> ViewExp [assoc] . op _;_ : ViewExp ViewExp -> ViewExp [assoc] . op _`{_`} : ModExp ViewExp -> ViewExp . op _`(_`) : ViewExp ViewExp -> ViewExp [prec 40] . endfm ****************************************************************************** fmod OPERATOR-ATTRIBUTES is sorts Attr AttrList Hook HookList Bubble Token NeTokenList . subsort Attr < AttrList . subsort Hook < HookList . op __ : AttrList AttrList -> AttrList [assoc] . ops assoc associative : -> Attr . ops comm commutative : -> Attr . ops idem idempotent : -> Attr . ops id:_ identity:_ : Bubble -> Attr . ops left`id:_ left`identity:_ : Bubble -> Attr . ops right`id:_ right`identity:_ : Bubble -> Attr . ops frozen`(_`) strat`(_`) strategy`(_`) : NeTokenList -> AttrList . ops memo memoization : -> Attr . ops prec_ precedence_ : Token -> Attr . ops gather`(_`) gathering`(_`) : NeTokenList -> Attr . ops format`(_`) : NeTokenList -> Attr . ops ctor constructor : -> Attr . ops ditto iter : -> Attr . op special`(_`) : HookList -> Attr . op __ : HookList HookList -> HookList [assoc] . op id-hook_ : Token -> Hook . op id-hook_`(_`) : Token NeTokenList -> Hook . op op-hook_`(_:_->_`) : Token Token NeTokenList Token -> Hook . op op-hook_`(_:`->_`) : Token Token Token -> Hook . op op-hook_`(_:_~>_`) : Token Token NeTokenList Token -> Hook . op op-hook_`(_:`~>_`) : Token Token Token -> Hook . op term-hook_`(_`) : Token Bubble -> Hook . endfm ******************************************************************************* fmod MOD-EXPRS is including OPERATOR-ATTRIBUTES . including EXTENDED-SORTS . sorts Map MapList . subsort Map < MapList . subsorts Token < ModExp . *** module expression op _*`(_`) : ModExp MapList -> ModExp . op _`(_`) : ModExp ViewExp -> ModExp . op TUPLE`[_`] : Token -> ModExp . op _+_ : ModExp ModExp -> ModExp [assoc prec 42] . *** renaming maps op op_to_ : Token Token -> Map . op op_:_->_to_ : Token TypeList Type Token -> Map . op op_: ->_to_ : Token Type Token -> Map . op op_:_~>_to_ : Token TypeList Type Token -> Map . op op_: ~>_to_ : Token Type Token -> Map . op op_to_`[_`] : Token Token AttrList -> Map . op op_:_->_to_`[_`] : Token TypeList Type Token AttrList -> Map . op op_:`->_to_`[_`] : Token Type Token AttrList -> Map . op op_:_~>_to_`[_`] : Token TypeList Type Token AttrList -> Map . op op_:`~>_to_`[_`] : Token Type Token AttrList -> Map . op sort_to_ : Sort Sort -> Map . op label_to_ : Token Token -> Map . op class_to_ : Sort Sort -> Map . op attr_._to_ : Token Sort Token -> Map . op msg_to_ : Token Token -> Map . op msg_:_->_to_ : Token TypeList Type Token -> Map . op msg_:`->_to_ : Token Type Token -> Map . op _`,_ : MapList MapList -> MapList [assoc prec 42] . endfm ******************************************************************************* fmod SIGNATURES is inc MOD-EXPRS . sorts SortDecl SubsortRel SubsortDecl OpDecl . op `(_`) : Token -> Token . *** sort declaration op sorts_. : SortList -> SortDecl . op sort_. : SortList -> SortDecl . *** subsort declaration op subsort_. : SubsortRel -> SubsortDecl . op subsorts_. : SubsortRel -> SubsortDecl . op _<_ : SortList SortList -> SubsortRel . op _<_ : SortList SubsortRel -> SubsortRel . *** operator declaration op op_:`->_. : Token Type -> OpDecl . op op_:`->_`[_`]. : Token Type AttrList -> OpDecl . op op_:_->_. : Token TypeList Type -> OpDecl . op op_:_->_`[_`]. : Token TypeList Type AttrList -> OpDecl . op ops_:`->_. : NeTokenList Type -> OpDecl . op ops_:`->_`[_`]. : NeTokenList Type AttrList -> OpDecl . op ops_:_->_. : NeTokenList TypeList Type -> OpDecl . op ops_:_->_`[_`]. : NeTokenList TypeList Type AttrList -> OpDecl . op op_:`~>_. : Token Sort -> OpDecl . op op_:`~>_`[_`]. : Token Sort AttrList -> OpDecl . op op_:_~>_. : Token TypeList Sort -> OpDecl . op op_:_~>_`[_`]. : Token TypeList Sort AttrList -> OpDecl . op ops_:`~>_. : NeTokenList Sort -> OpDecl . op ops_:`~>_`[_`]. : NeTokenList Sort AttrList -> OpDecl . op ops_:_~>_. : NeTokenList TypeList Sort -> OpDecl . op ops_:_~>_`[_`]. : NeTokenList TypeList Sort AttrList -> OpDecl . endfm ******************************************************************************* fmod F&S-MODS&THS is including SIGNATURES . sorts FDeclList SDeclList Module ImportDecl Parameter ParameterList EqDecl RlDecl MbDecl VarDecl VarDeclList . subsort VarDecl < VarDeclList . subsorts VarDecl ImportDecl SortDecl SubsortDecl OpDecl MbDecl EqDecl VarDeclList < FDeclList . subsorts RlDecl FDeclList < SDeclList . *** variable declaration op vars_:_. : NeTokenList Type -> VarDecl . op var_:_. : NeTokenList Type -> VarDecl . *** membership axiom declaration op mb_:_. : Bubble Sort -> MbDecl . op cmb_:_if_. : Bubble Sort Bubble -> MbDecl . *** equation declaration op eq_=_. : Bubble Bubble -> EqDecl . op ceq_=_if_. : Bubble Bubble Bubble -> EqDecl . op cq_=_if_. : Bubble Bubble Bubble -> EqDecl . *** rule declaration *** op rl`[_`]:_=>_. : Token Bubble Bubble -> RlDecl . op rl_=>_. : Bubble Bubble -> RlDecl . *** op crl`[_`]:_=>_if_. : Token Bubble Bubble Bubble -> RlDecl . op crl_=>_if_. : Bubble Bubble Bubble -> RlDecl . *** importation declaration ops including_. inc_. : ModExp -> ImportDecl . ops extending_. ex_. : ModExp -> ImportDecl . ops protecting_. pr_. : ModExp -> ImportDecl . sorts Interface . subsort Parameter < ParameterList . subsorts Token < Interface . *** parameterized module interface op _::_ : Token ModExp -> Parameter [prec 40 gather (e &)] . op _::_ : Token Interface -> Parameter [prec 40 gather (e &)] . op _|_ : ParameterList ParameterList -> ParameterList [assoc] . ***op _`(_`) : Token ParameterList -> Interface . op _`(_`) : ModExp ParameterList -> Interface . *** declaration list op __ : VarDeclList VarDeclList -> VarDeclList [assoc] . op __ : SDeclList SDeclList -> SDeclList [assoc] . op __ : FDeclList FDeclList -> FDeclList [assoc] . *** functional and system module and theory op fmod_is_endfm : Interface FDeclList -> Module . op obj_is_jbo : Interface FDeclList -> Module . op obj_is_endo : Interface FDeclList -> Module . op mod_is_endm : Interface SDeclList -> Module . op fth_is_endfth : Interface FDeclList -> Module . op th_is_endth : Interface SDeclList -> Module . endfm ******************************************************************************* fmod O-MODS&THS is including F&S-MODS&THS . sorts ClassDecl AttrDecl AttrDeclList SubclassDecl MsgDecl ODeclList . subsorts SDeclList MsgDecl SubclassDecl ClassDecl < ODeclList . subsort AttrDecl < AttrDeclList . op __ : ODeclList ODeclList -> ODeclList [assoc] . *** object-oriented module and theory op omod_is_endom : Interface ODeclList -> Module . op oth_is_endoth : Interface ODeclList -> Module . *** class declaration op class_|_. : Sort AttrDeclList -> ClassDecl . op class_. : Sort -> ClassDecl . op _`,_ : AttrDeclList AttrDeclList -> AttrDeclList [assoc] . op _:_ : Token Sort -> AttrDecl [prec 40] . *** subclass declaration op subclass_. : SubsortRel -> SubclassDecl . op subclasses_. : SubsortRel -> SubclassDecl . *** message declaration op msg_:_->_. : Token SortList Sort -> MsgDecl . op msgs_:_->_. : NeTokenList SortList Sort -> MsgDecl . op msg_:`->_. : Token Sort -> MsgDecl . op msgs_:`->_. : NeTokenList Sort -> MsgDecl . endfm ******************************************************************************* fmod VIEWS is including O-MODS&THS . sorts ViewDecl ViewDeclList View . subsorts VarDecl < ViewDecl < ViewDeclList . subsort VarDeclList < ViewDeclList . *** view maps op op_to`term_. : Bubble Bubble -> ViewDecl . op op_to_. : Token Token -> ViewDecl . op op_:_->_to_. : Token TypeList Type Token -> ViewDecl . op op_:`->_to_. : Token Type Token -> ViewDecl . op op_:_~>_to_. : Token TypeList Type Token -> ViewDecl . op op_:`~>_to_. : Token Type Token -> ViewDecl . op sort_to_. : Sort Sort -> ViewDecl . op class_to_. : Sort Sort -> ViewDecl . op attr_._to_. : Token Sort Token -> ViewDecl . op msg_to_. : Token Token -> ViewDecl . op msg_:_->_to_. : Token TypeList Type Token -> ViewDecl . op msg_:`->_to_. : Token Type Token -> ViewDecl . *** view op view_from_to_is_endv : Interface ModExp ModExp ViewDeclList -> View . op __ : ViewDeclList ViewDeclList -> ViewDeclList [assoc] . endfm ******************************************************************************* fmod COMMANDS is including MOD-EXPRS . sorts Command . *** down function op down_:_ : ModExp Command -> Command . *** reduce commands op red_. : Bubble -> Command . op reduce_. : Bubble -> Command . *** rewrite commands op rew_. : Bubble -> Command . op rewrite_. : Bubble -> Command . *** frewrite commands op frew_. : Bubble -> Command . op frewrite_. : Bubble -> Command . *** search commands op search_=>1_. : Bubble Bubble -> Command . op search_=>*_. : Bubble Bubble -> Command . op search_=>+_. : Bubble Bubble -> Command . op search_=>!_. : Bubble Bubble -> Command . *** matching commands op match_<=?_. : Bubble Bubble -> Command . op xmatch_<=?_. : Bubble Bubble -> Command . *** select command op select_. : ModExp -> Command . *** show commands op show`module`. : -> Command . op show`module_. : ModExp -> Command . op show`all`. : -> Command . op show`all_. : ModExp -> Command . op show`sorts`. : -> Command . op show`sorts_. : ModExp -> Command . op show`ops`. : -> Command . op show`ops_. : ModExp -> Command . op show`mbs`. : -> Command . op show`mbs_. : ModExp -> Command . op show`eqns`. : -> Command . op show`eqns_. : ModExp -> Command . op show`rls`. : -> Command . op show`rls_. : ModExp -> Command . op show`view_. : ViewExp -> Command . op show`modules`. : -> Command . op show`views`. : -> Command . endfm ******************************************************************************* fmod FULL-MAUDE-SIGN is including VIEWS . including COMMANDS . pr QID-LIST . sort Input . subsorts Command Module View < Input . --- can bubble operators be declared at the object level? --- --- op token : Qid -> Token --- [special( --- id-hook Bubble (1 1) --- op-hook qidSymbol ( : -> Qid))] . --- op viewToken : Qid -> ViewToken --- [special( --- id-hook Bubble (1 1) --- op-hook qidSymbol ( : -> Qid))] . --- op sortToken : Qid -> SortToken --- [special( --- id-hook Bubble (1 1) --- op-hook qidSymbol ( : -> Qid) --- id-hook Exclude ('`[ '`] '< 'to '`, '. '`( '`) '| ': --- 'ditto 'precedence 'prec 'gather --- 'assoc 'associative 'comm 'commutative --- 'ctor 'constructor 'id: 'strat 'strategy --- 'memo 'memoization 'iter 'frozen))] . --- op neTokenList : QidList -> NeTokenList --- [special( --- id-hook Bubble (1 -1 '`( '`)) --- op-hook qidListSymbol (__ : QidList QidList -> QidList) --- op-hook qidSymbol ( : -> Qid) --- id-hook Exclude ('.))] . --- --- op bubble : QidList -> Bubble --- [special( --- id-hook Bubble (1 -1 '`( '`)) --- op-hook qidListSymbol (__ : QidList QidList -> QidList) --- op-hook qidSymbol ( : -> Qid))] . endfm ******************************************************************************* *** As explained in Section~\ref{bubbles}, to parse some input using the *** built-in function \texttt{metaParse}, we need to give the *** metarepresentation of the signature in which the input is going to be *** parsed. *** But we do not need to give the complete metarepresentation of such a *** module. As we saw in Section~\ref{bubbles}, in modules including *** \texttt{META-LEVEL} it is possible to define terms of sort \texttt{Module} *** that import built-in modules or any module introduced at the ``object *** level'' of Core Maude. In this way, it is possible to get the equivalent *** effect of having the explicit metarepresentation of a module by declaring *** a constant and adding an equation identifying such a constant with the *** metarepresentation of an extended module that imports the original module *** at the object level. *** As also mentioned in Section~\ref{bubbles}, the declaration of *** constructors for bubble sorts at the object level is not supported in the *** current version of Core Maude. The \texttt{special} attributes linking the *** constructors for the bubble sorts to the built-in ones are only supported *** at the metalevel, that is, the declarations of the constructor operators *** for bubble sorts have to be given in the metarepresentation of a module. *** To allow the greatest generality and flexibility in future extensions of *** Full Maude, we have declared its signature as a module *** \texttt{FULL-MAUDE-SIGN}\ (see Appendix~\ref{signature-full-maude}). Then, *** in the following module \texttt{META-FULL-MAUDE-SIGN} we declare a *** constant \texttt{GRAMMAR} of sort \texttt{FModule}, and using the *** technique described in Section~\ref{bubbles} to import the *** metarepresentation of a module by name, we give an equation identifying *** such constant with the metarepresentation of a module \texttt{GRAMMAR} in *** which there is a declaration importing \texttt{FULL-MAUDE-SIGN}. *** Declarations for the constructors of the bubble sorts are also included in *** this module. Note that the bubble sorts \texttt{Token}, \texttt{Bubble}, *** \texttt{SortToken}, and \texttt{NeTokenList} are declared in the module *** \texttt{SIGN\&VIEW-EXPR}, which is imported by \texttt{FULL-MAUDE-SIGN}. *** These sorts are used in the declarations describing the syntax of the *** system. fmod META-FULL-MAUDE-SIGN is including META-LEVEL . op GRAMMAR : -> FModule . eq GRAMMAR = (fmod 'GRAMMAR is including 'QID-LIST . including 'FULL-MAUDE-SIGN . sorts none . none op 'token : 'Qid -> 'Token [special( (id-hook('Bubble, '1 '1) op-hook('qidSymbol, ', nil, 'Qid)))] . op 'viewToken : 'Qid -> 'ViewToken [special( (id-hook('Bubble, '1 '1) op-hook('qidSymbol, ', nil, 'Qid)))] . op 'sortToken : 'Qid -> 'SortToken [special( (id-hook('Bubble, '1 '1) op-hook('qidSymbol, ', nil, 'Qid) id-hook('Exclude, '`[ '`] '< 'to '`, '. '`( '`) '| ': 'ditto 'precedence 'prec 'gather 'assoc 'associative 'comm 'commutative 'ctor 'constructor 'id: 'strat 'strategy 'memo 'memoization 'iter 'frozen)))] . op 'neTokenList : 'QidList -> 'NeTokenList [special( (id-hook('Bubble, '1 '-1 '`( '`)) op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList) op-hook('qidSymbol, ', nil, 'Qid) id-hook('Exclude, '.)))] . op 'bubble : 'QidList -> 'Bubble [special( (id-hook('Bubble, '1 '-1 '`( '`)) op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList) op-hook('qidSymbol, ', nil, 'Qid)))] . none none endfm) . endfm ******************************************************************************* *** The \texttt{GRAMMAR} module will be used in calls to the \texttt{metaParse} *** function in order to get the input parsed in this signature. Note that *** this module is not the data type in which we shall represent the inputs. *** From the call to \texttt{metaParse} we shall get a term representing the *** parse tree of the input. This term will then be transformed into terms of *** other appropriate data types if necessary. *** Future extensions to Full Maude will require extending the signature as *** well. The addition of new commands, new module expressions, or additions *** of any other kind will require adding new declarations to the present Full *** Maude signature and defining the corresponding extensions to the data *** types and functions to deal with the new cases introduced by the *** extensions. We shall see in Section~\ref{extension} how the system can be *** easily extended to handle some new module expressions in addition to the *** renaming and instantiation module expressions presented in *** Section~\ref{module-expressions} and further discussed in *** Sections~\ref{renaming} and~\ref{instantiation}. In Chapter~\ref{crc} we *** shall explain how to combine a proving tool like a Church-Rosser *** checker~\cite{ClavelDuranEkerMeseguer98a,ClavelDuranEkerMeseguer98} with *** Full Maude. ******* ******* ERROR HANDLING, by Peter Olveczky ******* *** The following module defines a thing which prints up to n characters *** of a bubble, followed by the usual arrow <---*HERE* which points to the *** erroneous token: fmod PRINT-SYNTAX-ERROR is protecting META-LEVEL . protecting INT . var QIL : QidList . var Q : Qid . var N : Nat . vars RP RP' : ResultPair . var RP? : [ResultPair?] . op printN : Nat QidList -> QidList . *** first N qid's in a qidList eq printN(N, nil) = nil . eq printN(0, QIL) = nil . eq printN(s N, Q QIL) = Q printN(N, QIL) . op removeFront : Nat QidList -> QidList . *** removes first N qid's eq removeFront(N, nil) = nil . eq removeFront(0, QIL) = QIL . eq removeFront(s N, Q QIL) = removeFront(N, QIL) . op printSyntaxError : [ResultPair?] QidList -> QidList . eq printSyntaxError(noParse(N), QIL) = '\r 'Parse 'error 'in '\o '\s printN(N + 1, QIL) '\r '<---*HERE* '\o . eq printSyntaxError(ambiguity(RP, RP'), QIL) = '\r 'Ambiguous 'parsing 'for '\o '\s QIL '\o . eq printSyntaxError(RP, QIL) = QIL . endfm *** *** The Abstract Data Type \texttt{Unit} *** *** In this section we present the abstract data type \texttt{Unit}, which can *** be seen as an extension of the predefined sort \texttt{Module} in several *** ways. There are constructors for functional, system, and object-oriented *** modules and theories, which can be parameterized and can import module *** expressions. There can also be parameterized sorts in Full Maude modules, *** and therefore, the constructors for the different declarations that can *** appear in a module have to be appropriately extended. *** The section is structured as follows. After introducing some modules *** defining some functions on the predefined sorts \texttt{Bool} and *** \texttt{QidList} in Section~\ref{BOOL-QID-LIST}, we present in *** Sections~\ref{EXT-SORT} and~\ref{EXT-DECL} the data types for extended *** sorts and extended declarations. In Section~\ref{mod-exp-mod-id} we *** introduce module expressions and module names, and in *** Section~\ref{unitADT} the abstract data type \texttt{Unit} itself. *** *** Extension \texttt{QID-LIST} *** *** The conversion of lists of quoted identifiers into single quoted *** identifiers by concatenating them is heavily used in the coming modules. *** This is the task of the \texttt{qidListToQid} function, which is *** introduced in the following module \texttt{EXT-QID-LIST} extending the *** predefined module \texttt{QID-LIST}. fmod EXT-QID-LIST is pr QID-LIST . op qidListToQid : QidList -> Qid . var QI : Qid . var QIL : QidList . eq qidListToQid(('\s QIL)) = qid(" " + string(qidListToQid(QIL))) . eq qidListToQid((QI QIL)) = qid(string(QI) + " " + string(qidListToQid(QIL))) [owise] . eq qidListToQid(nil) = qid("") . endfm ******************************************************************************* *** 3.2 View Expressions and Extended Sorts *** To allow the use of parameterized sorts, or sorts qualified by the view *** expression with which the parameterized module in which the given sorts *** appear is instantiated, we add the sort ESort of ``extended sorts'' as a *** supersort of the predefined sort Sort. View expressions and extended *** sorts are introduced in the following modules. *** 3.2.1 View Expressions *** A view expression is given by a single quoted identifier, by a sequence of *** view expressions (at the user level, separated by commas), or by the *** composition of view expressions. In the current version, the composition *** of view expressions is only used internally; we plan to make it available *** to the user with syntax \verb~_;_~ in the future. View expressions are *** used in the instantiation of parameterized modules and in parameterized *** sorts. We plan to support parameterized views in the future as well. We *** use operators \verb~_|_~ and \verb~_;;_~ to represent, respectively, *** sequences and composition of view expressions. *** The \texttt{VIEW-EXPR} module below also includes declarations for sets of *** view expressions, which will be used in the database structure to hold the *** list of the names of the views in it. The elements of sort *** \texttt{ViewExpSet}, for sets of view expressions, are given using the *** constructor \verb~_#_~, which is declared to be associative, commutative, *** and with identity element \texttt{noneViewExpSet}. *** The function \verb~_inViewExpSet_~ checks whether the view expression given *** as first argument is in the set of view expressions given as second *** argument or not. fmod VIEW-EXPR is pr EXT-BOOL . pr QID . sort ViewExp . subsort Qid < ViewExp . op nullViewExp : -> ViewExp . op _|_ : ViewExp ViewExp -> ViewExp *** view sequence _|_ [assoc id: nullViewExp] . op _;;_ : ViewExp ViewExp -> ViewExp [assoc] . *** view composition _;_ op _<<_>> : Qid ViewExp -> ViewExp [prec 40] . *** view instantiation _(_) op _`{_`} : Qid ViewExp -> ViewExp . *** view lifting _{_} sort ViewExpSet . subsort ViewExp < ViewExpSet . op noneViewExpSet : -> ViewExpSet . op _#_ : ViewExpSet ViewExpSet -> ViewExpSet [assoc comm id: noneViewExpSet] . eq VE # VE = VE . vars VE VE' : ViewExp . var VES : ViewExpSet . op _inViewExpSet_ : ViewExp ViewExpSet -> Bool . eq VE inViewExpSet (VE' # VES) = (VE == VE') or-else (VE inViewExpSet VES) . eq VE inViewExpSet noneViewExpSet = false . endfm ***************************************************************************** *** Since the Core Maude engine does not know about view expressions, or, as *** we shall see, about extended sorts, extended module expressions, extended *** modules, and other declarations that we introduce, to be able to use them *** with built-in functions such as \texttt{sameComponent}, *** \texttt{leastSort}, \texttt{metaReduce}, etc., we shall have to convert *** them into terms which only use the built-in constructors. Thus, for *** example, view expressions in sort \texttt{ViewExp} will be converted *** into quoted identifiers of sort \texttt{Qid} by means of function *** \texttt{viewExpToQid}, or, similarly, elements of sorts \texttt{ESort}, *** \texttt{ESortList}, and \texttt{ESortSet} are transformed into elements *** of sorts \texttt{Qid}, \texttt{QidList}, and \texttt{QidSet}, *** respectively, with functions \texttt{eSortToQid} defined on the *** appropriate sorts. fmod VIEW-EXPR-TO-QID is pr VIEW-EXPR . pr EXT-QID-LIST . op viewExpToQid : ViewExp -> Qid [memo] . op viewExpToQidList : ViewExp -> QidList [memo] . var QI : Qid . var QIL : QidList . vars VE VE' : ViewExp . eq viewExpToQidList(QI) = QI . eq viewExpToQidList((VE ;; VE')) = (viewExpToQidList(VE) '; viewExpToQidList(VE')) . ceq viewExpToQidList((VE | VE')) = (if QI == '`) then QIL QI '\s else QIL QI fi) '| viewExpToQidList(VE') if (VE =/= nullViewExp) /\ (VE' =/= nullViewExp) /\ QIL QI := viewExpToQidList(VE). ceq viewExpToQidList(VE << VE' >>) = (viewExpToQidList(VE) '`( viewExpToQidList(VE') '`)) if (VE =/= nullViewExp) and (VE' =/= nullViewExp) . eq viewExpToQid(QI) = QI . eq viewExpToQid((VE ;; VE')) = qidListToQid(viewExpToQid(VE) '; viewExpToQid(VE')) . ceq viewExpToQid((VE | VE')) = qid(string(viewExpToQid(VE)) + " | " + string(viewExpToQid(VE'))) if (VE =/= nullViewExp) and (VE' =/= nullViewExp) . ceq viewExpToQid(VE << VE' >>) = qidListToQid(viewExpToQid(VE) '`( viewExpToQid(VE') '`)) if (VE =/= nullViewExp) and (VE' =/= nullViewExp) . *** eq viewExpToQid(VE) = qidListToQid(viewExpToQidList(VE)) . endfm ******************************************************************************* *** *** Parameterized Sorts *** *** In addition to the \texttt{ESort} sort, in the following module *** \texttt{EXT-SORT} we also define sorts \texttt{ESortList} and *** \texttt{ESortSet}. *** The operator \texttt{eSort} is declared to be a constructor for extended *** sorts. *** As for lists and sets of quoted identifiers, we declare \verb~__~ and *** \verb~_;_~ as constructors for sorts \texttt{SortList} and *** \texttt{ESortList}, and \texttt{ESortSet}, respectively. fmod EXT-SORT is pr META-LEVEL . pr VIEW-EXPR-TO-QID . sort ESort EType EKind . subsort Sort < ESort . subsort ESort EKind Type < EType . op eSort : ESort ViewExp -> ESort . op kind : ESortSet -> EKind . op error : QidList -> [ESort] [ctor format (r o)] . var QIL : QidList . var VE : ViewExp . eq eSort(error(QIL), VE) = error(QIL) . eq kind(ES ; ES' ; ESS) = kind(ES) . sort ETypeList . subsort EType TypeList < ETypeList . op __ : ETypeList ETypeList -> ETypeList [assoc id: nil] . op kind : ETypeList -> ETypeList . eq kind(ET ET' ETL) = kind(ET) kind(ET' ETL) . eq kind(nil) = nil . eq kind(kind(ET)) = kind(ET) . sort ESortSet . subsort ESort SortSet < ESortSet . op _;_ : ESortSet ESortSet -> ESortSet [assoc comm id: none] . eq (ES ; ES ; ESS) = (ES ; ESS) . *** We define operations extending the built-in functions \texttt{sameKind} *** and \texttt{leastSort}, respectively, to lists of *** sorts (\texttt{eSameKind}) and to lists of extended *** terms (\texttt{termListLeastSort}). The function \texttt{eSameKind} takes *** a module and two lists of extended sorts as arguments, and returns *** \texttt{true} if the $i$-th elements of both lists are in the same *** connected component of sorts. This function will be used, for example, to *** check whether two operators are in the same family of subsort overloaded *** operators. \texttt{leastSort} returns a list of sorts where the $i$-th *** element of the list is the least sort, computed by the homonymous built-in *** function, of the $i$-th term in the list of terms given as argument. *** Moreover, we define a function \verb~_inSortSet_~ to check whether an *** extended sort is in a given set of extended sorts. Note that before *** calling the built-in function \texttt{sameComponent}, extended sorts of *** sort \texttt{ESort} have to be `desugared' into sorts of sort *** \texttt{Sort} as defined in the predefined \texttt{META-LEVEL} module. *** This conversion is done by the \texttt{eTypeToType} function. Basically, *** user-defined sorts are converted into quoted identifiers by concatenating *** the list of identifiers composing the name of the sort. For example, sorts *** \texttt{'Nat} and \texttt{'List['Nat]} are converted, respectively, into *** \texttt{'Nat} and \texttt{'List`[Nat`]}. Error *** sorts~\cite{ClavelDuranEkerLincolnMarti-OlietMeseguerQuesada99} are left *** as such. vars QI S S' : Qid . var SS : SortSet . vars ES ES' : ESort . vars ESS ESS' : ESortSet . vars ETL ETL' : ETypeList . vars ET ET' : EType . var M : Module . var T : Term . var TL : TermList . var IL : ImportList . var SSDS : SubsortDeclSet . var OPDS : OpDeclSet . var MAS : MembAxSet . var EqS : EquationSet . var RlS : RuleSet . op eTypeToType : EType -> Type . eq eTypeToType(QI) = QI . eq eTypeToType(kind(ES ; ESS)) = qid("[" + string(eTypeToType(ES)) + "]") . eq eTypeToType(eSort(ES, VE)) = qid(string(eTypeToType(ES)) + "(" + string(viewExpToQid(VE)) + ")") . op eSameKind : Module ETypeList ETypeList -> Bool . eq eSameKind(M, (ET ETL), (ET' ETL')) = sameKind(M, eTypeToType(ET), eTypeToType(ET')) and-then eSameKind(M, ETL, ETL') . eq eSameKind(M, (ET ETL), nil) = false . eq eSameKind(M, nil, (ET ETL)) = false . eq eSameKind(M, nil, nil) = true . op termListLeastSort : Module TermList -> ETypeList . eq termListLeastSort(M, (T, TL)) = (leastSort(M, T) termListLeastSort(M, TL)) . eq termListLeastSort(M, T) = leastSort(M, T) . op _inSortSet_ : ESort ESortSet -> Bool . eq ES inSortSet (ES ; ESS) = true . eq ES inSortSet (ES' ; ESS) = (ES == ES') or-else (ES inSortSet ESS) . eq ES inSortSet none = false . endfm ******************************************************************************* *** *** Transforming Extended Sorts into Quoted Identifiers *** *** Since eventually all units will have to be given as arguments in some of *** the calls to the built-in functions, and since the engine does not know *** about parameterized sorts, we need to transform all parameterized sorts *** appearing in any of the declarations that can appear in a unit into quoted *** identifiers. This is the task of the \texttt{eSortToQid} function, which *** is defined in the module \texttt{EXT-SORT-TO-QID}. These functions will be *** used with terms not containing error sorts\footnote{The Core Maude system *** automatically adds error supersorts above each of the connected components *** of the poset of sorts declared by the user, using the set of maximal sorts *** in each connected component to qualify the corresponding error sort. Such *** error sorts are called {\em kinds} in the theory of membership *** algebras~\cite{Meseguer98,BouhoulaJouannaudMeseguer97a}.}. Although the *** user cannot use error sorts, calls to built-in functions may generate *** such error sorts, and some built-in functions can handle them. The *** function \texttt{eTypeToType} presented in the previous module will be *** used in the calls to the built-in functions that may use such error sorts. fmod EXT-SORT-TO-QID is pr INT . pr EXT-SORT . op eSortToQidList : ESort -> QidList . op eTypeListToQidList : ETypeList -> QidList . op eSortSetToQidList : ESortSet -> QidList . op eSortToSort : [ETypeList] -> [ETypeList] . op eSortToSort : ETypeList -> TypeList . op eSortToSort : EType -> Type . op eSortToSort : ESortSet -> SortSet . op eSortToSort : ESort -> Sort . var QI : Qid . var QIL : QidList . var T : Type . var SS : SortSet . var VE : ViewExp . var ES : ESort . var ET : EType . var ETL : ETypeList . var ESS : ESortSet . vars St St' : String . op tokenize : String String -> QidList . eq tokenize(St, St') = if find(St, St', 0) == notFound then qid(St) else qid(substr(St, 0, find(St, St', 0))) tokenize(substr(St, find(St, St', 0) + 1, length(St)), St') fi . eq eSortToSort(error(QIL)) = error(QIL) . eq eSortToQidList(T) = if T :: Kind then '`[ tokenize(substr(string(T), 2, length(string(T)) + - 4), ",") '`] else T fi . eq eSortToQidList(kind(ES ; ESS)) = '`[ eSortToQidList(ES) '`] . ceq eSortToQidList(eSort(ES, VE)) = (if QI == '\s then QIL else QIL QI fi '`( viewExpToQidList(VE) '`) '\s) if QIL QI := eSortToQidList(ES) . *** eq eSortToQidList(eSort(ES, VE)) *** = (eSortToQidList(ES) '`( viewExpToQidList(VE) '`)) . eq eTypeListToQidList((ET ETL)) = if ETL == nil then eSortToQidList(ET) else (eSortToQidList(ET) eTypeListToQidList(ETL)) fi . eq eTypeListToQidList(nil) = nil . eq eSortSetToQidList((ES ; ESS)) = if ESS == none then eSortToQidList(ES) else (eSortToQidList(ES) '; eSortSetToQidList(ESS)) fi . eq eSortSetToQidList(none) = nil . *** eq eSortToSort(ET) = qidListToQid(eSortToQidList(ET)) . eq eSortToSort(T) = T . eq eSortToSort(eSort(ES, VE)) = qidListToQid(eSortToSort(ES) '`( viewExpToQid(VE) '`)) . eq eSortToSort(kind(ES)) = qidListToQid('`[ eSortToSort(ES) '`]) . ceq eSortToSort((ET ETL)) = eSortToSort(ET) eSortToSort(ETL) if ETL =/= nil . eq eSortToSort((nil).ETypeList) = nil . ceq eSortToSort((ES ; ESS)) = eSortToSort(ES) ; eSortToSort(ESS) if ESS =/= none . eq eSortToSort((none).ESortSet) = none . endfm ******************************************************************************* fmod EXT-TERM is pr META-TERM . pr QID-LIST . *** pr EXT-SORT . *** sorts ETerm ETermList . *** subsorts EVariable EConstant < ETerm < ETermList . *** op _,_ : ETermList ETermList -> ETermList *** [ctor assoc gather (e E) prec 120] . *** op _[_] : Qid ETermList -> ETerm [ctor] . *** op const : Qid ESort -> EConstant [ctor] . *** op var : Qid ESort -> EVariable [ctor] . *** *** ops (_::_) (_:::_) : ETerm ESort -> ETerm . *** op error : QidList -> [Term] [ctor format (r o)] . sort Default`(Term`) . subsort Term < Default`(Term`) . ops noTerm noView : -> Default`(Term`) . var Ct : Constant . var V : Variable . op myGetName : Constant -> Qid [memo] . op myGetName : Variable -> Qid [memo] . eq myGetName(Ct) = getName(Ct) . eq myGetName(V) = getName(V) . endfm ******************************************************************************* *** *** Extended Declarations *** *** In this section we discuss modules \texttt{EXT-DECL} and \texttt{O-O-DECL} *** which introduce, respectively, the declarations extending the sorts and *** constructors for declarations of the predefined data type \texttt{Module} *** in the \texttt{META-LEVEL} module to allow the use of extended sorts in *** them, and the declarations appearing in object-oriented units, namely *** class declarations, subclass relation declarations, and message *** declarations. *** *** Declarations of Functional and System Units *** *** In the following module \texttt{EXT-DECL}, we introduce the declarations *** extending those in \texttt{META-LEVEL} to allow the use of extended sorts *** in declarations of sorts, subsort relations, operators, variables, and *** membership axioms. *** \begin{comment} *** \footnote{In the future, the declarations for operators, *** membership axioms, equations, and rules will be extended to allow *** the use of extended sorts in sort tests, that is, terms of the *** form \mbox{\verb~T : ES~} and \mbox{\verb~T :: ES~}.} *** \end{comment} *** The extension is accomplished by adding new supersorts for each of the *** sorts in \texttt{META-LEVEL} involved, and by adding new constructors for *** these new sorts. *** We start introducing the declarations for the supersorts and their *** corresponding constructors. The \texttt{EXT-DECL} module also contains the *** declarations for sets of such declarations. fmod INT-LIST is pr META-MODULE . pr INT . sort IntList . subsort Int NatList < IntList . op __ : IntList IntList -> IntList [ctor assoc] . endfm fmod EXT-DECL is pr EXT-SORT . pr EXT-TERM . pr INT-LIST . vars ES ES' : ESort . var ESS : ESortSet . var VE : ViewExp . vars F S : Qid . var C : Constant . vars V V' : Variable . var ETL : TermList . var ET : Term . vars QIL QIL' : QidList . *** extended subsort declarations sorts ESubsortDecl ESubsortDeclSet . subsort SubsortDecl < ESubsortDecl . subsorts SubsortDeclSet ESubsortDecl < ESubsortDeclSet . op subsort_<_. : ESort ESort -> ESubsortDecl . op __ : ESubsortDeclSet ESubsortDeclSet -> ESubsortDeclSet [ditto] . op error : QidList -> [ESubsortDeclSet] [ctor format (r o)] . eq ESSD:ESubsortDecl ESSD:ESubsortDecl = ESSD:ESubsortDecl . eq (error(QIL) error(QIL')).[ESubsortDeclSet] = error(QIL QIL') . *** extended attribute declarations (to handle on-demand strategies) op strat : IntList -> Attr [ditto] . *** extended operation declarations sorts EOpDecl EOpDeclSet . subsort OpDecl < EOpDecl . subsorts OpDeclSet EOpDecl < EOpDeclSet . op op_:_->_`[_`]. : Qid ETypeList EType AttrSet -> EOpDecl [ditto] . op __ : EOpDeclSet EOpDeclSet -> EOpDeclSet [ditto] . op error : QidList -> [EOpDeclSet] [ctor format (r o)] . vars EOPD EOPD' : EOpDecl . var EOPDS : EOpDeclSet . eq EOPD EOPD = EOPD . eq (error(QIL) error(QIL')).[EOpDeclSet] = error(QIL QIL') . *** extended conditions sorts EEqCondition ECondition . subsort EEqCondition < ECondition . subsort Condition < ECondition . subsort EqCondition < EEqCondition . op _:_ : Term ESort -> EEqCondition [ditto] . op _/\_ : EEqCondition EEqCondition -> EEqCondition [ditto] . op _/\_ : ECondition ECondition -> ECondition [ditto] . *** extended membership axioms sorts EMembAx EMembAxSet . subsort MembAx < EMembAx . subsorts EMembAx MembAxSet < EMembAxSet . op mb_:_`[_`]. : Term ESort AttrSet -> EMembAx [ditto] . op cmb_:_if_`[_`]. : Term ESort EEqCondition AttrSet -> EMembAx [ditto] . op __ : EMembAxSet EMembAxSet -> EMembAxSet [ditto] . op error : QidList -> [EMembAxSet] [ctor format (r o)] . eq MB:EMembAx MB:EMembAx = MB:EMembAx . eq (error(QIL) error(QIL')).[EMembAxSet] = error(QIL QIL') . *** extended equations sorts EEquation EEquationSet . subsort Equation < EEquation EquationSet < EEquationSet . op ceq_=_if_`[_`]. : Term Term EEqCondition AttrSet -> EEquation [ditto] . op __ : EEquationSet EEquationSet -> EEquationSet [ditto] . op error : QidList -> [EEquationSet] [ctor format (r o)] . eq EQ:EEquation EQ:EEquation = EQ:EEquation . eq (error(QIL) error(QIL')).[EEquationSet] = error(QIL QIL') . *** extended rules sorts ERule ERuleSet . subsort Rule < ERule RuleSet < ERuleSet . op crl_=>_if_`[_`]. : Term Term ECondition AttrSet -> ERule [ditto] . op __ : ERuleSet ERuleSet -> ERuleSet [ditto] . op error : QidList -> [ERuleSet] [ctor format (r o)] . eq RL:ERule RL:ERule = RL:ERule . eq (error(QIL) error(QIL')).[EEquationSet] = error(QIL QIL') . *** The function \verb~_in_~ checks whether a given operator *** declaration is in a set of operator declarations. op _in_ : EOpDecl EOpDeclSet -> Bool . eq EOPD in (EOPD EOPDS) = true . eq EOPD in (EOPD' EOPDS) = (EOPD == EOPD') or-else (EOPD in EOPDS) . eq EOPD in none = false . *** There are also some other functions to deal with variables. The function *** \texttt{getVarsInTerm} returns the set of the variable declarations in the *** given module for those variables that appear in the term given as second *** argument. The function \texttt{varDeclsDiff} computes the set-theoretic *** difference between the two sets of variables given as arguments. Note that *** the difference is not between the declarations themselves, but just *** between the names of the variables in the declarations; the sorts with *** which they are declared are not taken into consideration. *** The predicate \texttt{varInVarDeclSet} checks whether there is a variable *** with the name given as first argument in the set of variable declarations *** given as second argument. endfm ******************************************************************************* *** *** Declarations for Object-Oriented Units *** *** In the \texttt{O-O-DECL} module we introduce the sorts and constructors *** for declarations of classes, subclass relations, and messages in *** object-oriented units. *** Note that we follow the same naming conventions for classes as for *** extended sorts (see Section~\ref{parameterized-modules}), and therefore *** we use the sort \texttt{ESort} for class identifiers, and *** \texttt{ETypeList} and \texttt{ESortSet} for lists and sets of class *** identifiers, respectively. We use the operator \verb~attr_:_~ as a *** constructor for declarations of attributes. Since the operator name *** \texttt{\_\,:\_\,} is used for sort tests in the \texttt{META-LEVEL} *** module, we use \texttt{attr\_\,:\_\,} as constructor for declarations of *** attributes to satisfy the preregularity condition. fmod O-O-DECL is pr EXT-SORT . vars QIL QIL' : QidList . sorts AttrDecl AttrDeclSet . subsort AttrDecl < AttrDeclSet . op attr_:_ : Qid ESort -> AttrDecl . op none : -> AttrDeclSet . op _`,_ : AttrDeclSet AttrDeclSet -> AttrDeclSet [assoc comm id: none] . eq AD:AttrDecl, AD:AttrDecl = AD:AttrDecl . sorts ClassDecl ClassDeclSet . subsort ClassDecl < ClassDeclSet . op class_|_. : ESort AttrDeclSet -> ClassDecl . op none : -> ClassDeclSet . op __ : ClassDeclSet ClassDeclSet -> ClassDeclSet [assoc comm id: none] . op error : QidList -> [ClassDeclSet] [ctor format (r o)] . eq (error(QIL) error(QIL')).[ClassDeclSet] = error(QIL QIL') . eq CD:ClassDecl CD:ClassDecl = CD:ClassDecl . sorts SubclassDecl SubclassDeclSet . subsort SubclassDecl < SubclassDeclSet . op subclass_<_. : ESort ESort -> SubclassDecl . op none : -> SubclassDeclSet . op __ : SubclassDeclSet SubclassDeclSet -> SubclassDeclSet [assoc comm id: none] . eq SCD:SubclassDecl SCD:SubclassDecl = SCD:SubclassDecl . op error : QidList -> [SubclassDeclSet] [ctor format (r o)] . eq (error(QIL) error(QIL')).[SubclassDeclSet] = error(QIL QIL') . sorts MsgDecl MsgDeclSet . subsort MsgDecl < MsgDeclSet . op msg_:_->_. : Qid ETypeList ESort -> MsgDecl . op none : -> MsgDeclSet . op __ : MsgDeclSet MsgDeclSet -> MsgDeclSet [assoc comm id: none] . eq MD:MsgDecl MD:MsgDecl = MD:MsgDecl . op error : QidList -> [MsgDeclSet] [ctor format (r o)] . eq (error(QIL) error(QIL')).[MsgDeclSet] = error(QIL QIL') . *** The function \texttt{classSet} returns the set of class identifiers in *** the set of class declarations given as argument. op classSet : ClassDeclSet -> ESortSet . eq classSet((class ES:ESort | ADS:AttrDeclSet .) CDS:ClassDeclSet) = (ES:ESort ; classSet(CDS:ClassDeclSet)) . eq classSet(none) = none . endfm ******************************************************************************* *** *** `Desugaring' of Extended Sorts in Declarations *** *** In the following module we define the \texttt{eSortToSort} function on the *** sorts for the different declarations introduced in the previous modules. fmod DECL-EXT-SORT-TO-QID is pr EXT-SORT-TO-QID . pr EXT-DECL . pr O-O-DECL . op eSortToSort : ESubsortDeclSet -> SubsortDeclSet . op eSortToSort : EOpDeclSet -> OpDeclSet . op eSortToSort : EMembAxSet -> MembAxSet . op eSortToSort : EEquationSet -> EquationSet . op eSortToSort : ERuleSet -> RuleSet . op eSortToSort : ECondition -> Condition . op eSortToSort : ClassDeclSet -> ClassDeclSet . op eSortToSort : SubclassDeclSet -> SubclassDeclSet . op eSortToSort : MsgDeclSet -> MsgDeclSet . op eSortToSort : AttrDeclSet -> AttrDeclSet . vars QI F V : Qid . var SS : SortSet . vars VE VE' : ViewExp . vars ES ES' : ESort . var ETL : ETypeList . var ET : EType . var ESS : ESortSet . vars T T' T'' T''' : Term . var ESSDS : ESubsortDeclSet . var EOPDS : EOpDeclSet . var AtS : AttrSet . var EMAS : EMembAxSet . var EqS : EEquationSet . var RlS : ERuleSet . var CDS : ClassDeclSet . var ADS : AttrDeclSet . var MDS : MsgDeclSet . var SCDS : SubclassDeclSet . vars Cond Cond' : Condition . eq eSortToSort(((subsort ES < ES' .) ESSDS)) = ((subsort eSortToSort(ES) < eSortToSort(ES') .) eSortToSort(ESSDS)) . eq eSortToSort((none).ESubsortDeclSet) = none . eq eSortToSort(((op F : ETL -> ET [AtS] .) EOPDS)) = ((op F : eSortToSort(ETL) -> eSortToSort(ET) [AtS] .) eSortToSort(EOPDS)) . eq eSortToSort((none).EOpDeclSet) = none . eq eSortToSort(((eq T = T' [AtS] .) EqS)) = ((eq T = T' [AtS] .) eSortToSort(EqS)) . eq eSortToSort(((ceq T = T' if Cond [AtS] .) EqS)) = ((ceq T = T' if eSortToSort(Cond) [AtS] .) eSortToSort(EqS)) . eq eSortToSort((none).EEquationSet) = none . eq eSortToSort(((rl T => T' [AtS] .) RlS)) = ((rl T => T' [AtS] .) eSortToSort(RlS)) . eq eSortToSort(((crl T => T' if Cond [AtS] .) RlS)) = ((crl T => T' if eSortToSort(Cond) [AtS] .) eSortToSort(RlS)) . eq eSortToSort((none).ERuleSet) = none . eq eSortToSort(((mb T : ES [AtS] .) EMAS)) = ((mb T : eSortToSort(ES) [AtS] .) eSortToSort(EMAS)) . eq eSortToSort(((cmb T : ES if Cond [AtS] .) EMAS)) = ((cmb T : eSortToSort(ES) if eSortToSort(Cond) [AtS] .) eSortToSort(EMAS)) . eq eSortToSort((none).EMembAxSet) = none . eq eSortToSort(((class ES | ADS .) CDS)) = ((class eSortToSort(ES) | eSortToSort(ADS) .) eSortToSort(CDS)) . eq eSortToSort((none).ClassDeclSet) = none . eq eSortToSort(((attr F : ET), ADS)) = ((attr F : eSortToSort(ET)), eSortToSort(ADS)) . eq eSortToSort((none).AttrDeclSet) = none . eq eSortToSort(((subclass ES < ES' .) SCDS)) = ((subclass eSortToSort(ES) < eSortToSort(ES') .) eSortToSort(SCDS)) . eq eSortToSort((none).SubclassDeclSet) = none . eq eSortToSort(((msg F : ETL -> ET .) MDS)) = ((msg F : eSortToSort(ETL) -> eSortToSort(ET) .) eSortToSort(MDS)) . eq eSortToSort((none).MsgDeclSet) = none . ceq eSortToSort(Cond /\ Cond') = eSortToSort(Cond) /\ eSortToSort(Cond') if Cond =/= nil and Cond' =/= nil . eq eSortToSort(T = T') = T = T' . eq eSortToSort(T : ES) = T : eSortToSort(ES) . eq eSortToSort(T := T') = T := T' . eq eSortToSort(T => T') = T => T' . endfm ******************************************************************************* *** *** Renaming Maps *** *** We introduce the different types of renaming maps in the module *** \texttt{MAP} below. A sort is introduced for each of these types of maps, *** with the appropriate constructors for each sort (see *** Section~\ref{module-expressions}). All these sorts are declared to be *** subsorts of the sort \texttt{Map}. A sort for sets of *** maps (\texttt{MapSet}) is then declared as supersort of \texttt{Map} with *** constructors \texttt{none} and \verb~_,_~. fmod MAP is pr EXT-SORT . pr DECL-EXT-SORT-TO-QID . sorts OpMap SortMap LabelMap ClassMap MsgMap AttrMap Map . subsorts OpMap SortMap LabelMap ClassMap MsgMap AttrMap < Map . op op_to_`[_`] : Qid Qid AttrSet -> OpMap . op op_:_->_to_`[_`] : Qid ETypeList EType Qid AttrSet -> OpMap . op sort_to_ : ESort ESort -> SortMap . op label_to_ : Qid Qid -> LabelMap . op class_to_ : ESort ESort -> ClassMap . op attr_._to_ : Qid ESort Qid -> AttrMap . op msg_to_ : Qid Qid -> MsgMap . op msg_:_->_to_ : Qid ETypeList ESort Qid -> MsgMap . sort MapSet . subsort Map < MapSet . op none : -> MapSet . op _`,_ : MapSet MapSet -> MapSet [assoc comm id: none] . eq (MAP, MAP) = MAP . *** Given a set of maps, the function \texttt{sortMaps} returns the *** subset of sort maps in it. var MAP : Map . var MAPS : MapSet . vars F F' L L' : Qid . var AtS : AttrSet . vars ET ET' : EType . var ETL : ETypeList . vars ES ES' : ESort . op sortMaps : MapSet -> MapSet . eq sortMaps((MAP, MAPS)) = if MAP :: SortMap then (MAP, sortMaps(MAPS)) else sortMaps(MAPS) fi . eq sortMaps(none) = none . op eSortToSort : MapSet -> MapSet . eq eSortToSort(((op F : ETL -> ET to F' [AtS]), MAPS)) = (op F : eSortToSort(ETL) -> eSortToSort(ET) to F' [AtS], eSortToSort(MAPS)) . eq eSortToSort(((sort ES to ES'), MAPS)) = ((sort eSortToSort(ES) to eSortToSort(ES')), eSortToSort(MAPS)) . eq eSortToSort(((class ES to ES'), MAPS)) = ((class eSortToSort(ES) to eSortToSort(ES')), eSortToSort(MAPS)) . eq eSortToSort(((attr F . ES to F'), MAPS)) = ((attr F . eSortToSort(ES) to F'), eSortToSort(MAPS)) . eq eSortToSort(((msg F : ETL -> ET to F'), MAPS)) = ((msg F : eSortToSort(ETL) -> eSortToSort(ET) to F'), eSortToSort(MAPS)) . eq eSortToSort((MAP, MAPS)) = (MAP, eSortToSort(MAPS)) [owise] . eq eSortToSort((none).MapSet) = none . endfm ******************************************************************************* *** *** Module Expressions and Module Names *** *** The abstract syntax for writing specifications in Maude can be seen as *** given by module expressions, where the notion of module expression is *** understood as an expression that defines a new module out of previously *** defined modules by combining and/or modifying them according to a specific *** set of operations. All module expressions will be evaluated generating *** modules with such module expressions as names. In the case of parameterized *** modules, each of the parameters in an interface will be used as the name *** of a new module created as a renamed copy of the parameter theory. *** *** Module Expressions *** *** In the following \texttt{MOD-EXPR} module the sort \texttt{ModExp} is *** introduced as a supersort of \texttt{Qid}. Module expressions for module *** renaming and for module instantiation will be introduced, respectively, *** in the modules \texttt{RENAMING-EXPR-EVALUATION} and *** \texttt{INST-EXPR-EVALUATION}, in Sections~\ref{renaming} *** and~\ref{instantiation}, which will be defined as extensions of *** \texttt{MOD-EXPR}. We shall see in Section~\ref{extension} how new module *** combining and/or transforming operators can be easily added, showing the *** flexibility and extensibility of the module algebra being defined. fmod MOD-EXPR is pr QID . pr VIEW-EXPR . pr MAP . sort ModExp . subsort Qid < ModExp . op _<_> : ModExp ViewExp -> ModExp . *** Parameterization _(_) op _*<_> : ModExp MapSet -> ModExp . *** Renaming _*(_) op _plus_ : ModExp ModExp -> ModExp [assoc comm] . *** Union _+_ op TUPLE`[_`] : NzNat -> ModExp . endfm ******************************************************************************* *** *** Module Names *** *** As we shall see in the coming sections, the evaluation of module *** expressions may produce the creation of new modules, whose \emph{names} *** are given by the module expressions themselves. If there is already a *** module in the database with the module expression being evaluated as name, *** the evaluation of such module expression does not produce any change in *** the database. However, the evaluation of a module expression may involve *** the evaluation of some other module expressions contained in the modules *** involved, which in turn may generate new modules. *** Given a parameterized module $\texttt{N[L}_1\texttt{\ ::\ T}_1 *** \texttt{\ |\ }\ldots\texttt{\ |\ L}_n\texttt{\ ::\ T}_n\texttt{]}$, with *** $\texttt{L}_1\ldots\texttt{L}_n$ labels and *** $\texttt{T}_1\ldots\texttt{T}_n$ theory identifiers, we say that *** \texttt{N} is the name of the module and that *** $\texttt{[L}_1\texttt{\ ::\ T}_1\texttt{\ |\ } *** \ldots\texttt{\ |\ L}_n\texttt{\ ::\ T}_n\texttt{]}$ *** is its \emph{interface}. *** As we shall see in Sections~\ref{instantiation} and~\ref{unit-processing}, *** for each parameter $\texttt{L}_i\texttt{\ ::\ T}_i$ in the interface of a *** module, a new module is generated with such a parameter expression as its *** name, and a declaration importing it in the parameterized module is added. *** We regard the relationship between the body of a parameterized module and *** the parameters in its interface, not as an inclusion, but as mediated by *** a module constructor that generates renamed copies of the parameters, *** which are then included. Therefore, the sort \texttt{Parameter} is *** declared as a subsort of \texttt{ModName}, that is, terms of sort *** \texttt{Parameter} are considered to be module names. The constructor *** operator for the sort \texttt{Parameter} is \verb~par_::_~. *** The \texttt{MOD-NAME} module also includes a sort \texttt{ModNameSet}, for *** sets of module names. The constructors of sort \texttt{ModNameSet} are *** \texttt{noneModNameSet} and \verb~_._~. The function \verb~_inModNameSet_~ *** checks whether the module name given as first argument is in the set of *** module names given as second argument. *** The sort for lists of parameters is \texttt{ParameterList}, which is *** defined with constructors \texttt{parList} and \texttt{nilParList}. fmod MOD-NAME is pr MOD-EXPR . pr EXT-BOOL . pr EXT-SORT . inc META-LEVEL . sorts Parameter Interface ParameterList . subsort Parameter < ParameterList . op par_::_ : Qid ModExp -> Parameter . *** _::_ op par_::_ : Qid Interface -> Parameter . *** _::_ op par : ModExp ParameterList -> Interface . *** _(_) op nilParList : -> ParameterList . op parList : ParameterList ParameterList -> ParameterList [assoc id: nilParList] . *** For example, *** *** X1 :: T1[X11 :: T11 | ... | X1n :: Tmn] | ... | *** Xm :: Tm[Xm1 :: Tm1 | ... | Xmn :: Tmn] *** *** is represented as *** *** parList( *** par 'X1 :: par(up(T1), *** parList(par 'X11 :: up(T11), *** ..., *** par 'X1n :: up(T1n))), *** ..., *** par 'Xm :: par(up(Tm), *** parList(par 'Xm1 :: up(Tm1), *** ..., *** par 'Xmn :: up(Tmn)))) sorts ModName ModNameSet . subsorts Parameter ModExp < ModName < ModNameSet . op noneModNameSet : -> ModNameSet . op _._ : ModNameSet ModNameSet -> ModNameSet [assoc comm id: noneModNameSet] . op nullModName : -> ModName . eq MN . MN = MN . vars MN MN' : ModName . var MNS : ModNameSet . op _inModNameSet_ : ModName ModNameSet -> Bool . eq MN inModNameSet (MN . MNS) = true . eq MN inModNameSet MNS = false [owise] . *** The function \texttt{labelInParList} checks whether the quoted *** identifier given as first argument is used as a label in the list of *** parameters given as second argument. vars QI QI' : Qid . var ME : ModExp . vars PL PL' : ParameterList . var VE : ViewExp . op labelInParList : ViewExp ParameterList -> Bool . eq labelInParList(QI << VE >>, parList((par QI' :: ME), PL)) = labelInParList(QI << VE >>, PL) . eq labelInParList(QI << VE >>, parList((par QI' :: par(ME, PL)), PL')) = (QI == QI' and-then labelInParList(VE, PL)) or-else labelInParList(QI << VE >>, PL') . ceq labelInParList((QI | VE), PL) = labelInParList(QI, PL) if VE =/= nullViewExp . eq labelInParList(QI, parList((par QI' :: ME), PL)) = (QI == QI') or-else labelInParList(QI, PL) . eq labelInParList(QI, parList((par QI' :: par(ME, PL)), PL')) = (QI == QI') or-else (labelInParList(QI, PL) or-else labelInParList(QI, PL')) . eq labelInParList(VE, nilParList) = false . op DUMMY : ModName -> Module . eq DUMMY(MN) = (fmod 'DUMMY is including MN . sorts (if MN == 'META-LEVEL then 'Token ; 'Bubble else none fi) . none (if MN == 'META-LEVEL then op 'token : 'Qid -> 'Token [special( (id-hook('Bubble, '1 '1) op-hook('qidSymbol, ', nil, 'Qid)))] . op 'bubble : 'QidList -> 'Bubble [special( (id-hook('Bubble, '1 '-1 '`( '`)) op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList) op-hook('qidSymbol, ', nil, 'Qid)))] . op 'up : 'Token 'Bubble -> 'Term [none] . op 'up : 'Token -> 'Module [none] . op '`[_`] : 'Token -> 'Module [none] . else none fi) none none endfm) . endfm ******************************************************************************* *** Since the Core Maude engine assumes that module names are identifiers and *** does not know about term-structured module names (such as parameterized *** module interfaces or module expressions), for evaluation purposes we need *** to transform them into quoted identifiers. The functions *** \texttt{modNameToQid} and \texttt{modNameToQidList} in the module *** \texttt{MOD-NAME-TO-QID} below accomplish this transformation. In any *** language extensions, new equations for the function *** \texttt{modNameToQidList} should be added for each new module expression *** constructor introduced. In Sections~\ref{renaming} and~\ref{instantiation} *** we shall see how the corresponding equalities are added for renaming and *** instantiation expressions, and in Section~\ref{extension} for other new *** module expressions in extensions of Full Maude. fmod MOD-NAME-TO-QID is pr MOD-NAME . pr EXT-QID-LIST . op modNameToQid : ModName -> Qid . op modNameToQidList : ModName -> QidList . op parListToQid : ParameterList -> Qid . op parListToQidList : ParameterList -> QidList . vars QI X : Qid . vars ME ME' : ModExp . var MN : ModName . var PL : ParameterList . var If : Interface . eq modNameToQidList(QI) = QI . eq modNameToQidList(par X :: ME) = (X ':: modNameToQidList(ME)) . eq modNameToQidList(par X :: par(ME, PL)) = (X ':: modNameToQidList(ME) '`( parListToQidList(PL) '`)) . eq modNameToQidList(nullModName) = ' . ceq parListToQidList(parList((par X :: ME), PL)) = (modNameToQidList(par X :: ME) '| parListToQidList(PL)) if PL =/= nilParList . ceq parListToQidList(parList((par X :: If), PL)) = (modNameToQidList(par X :: If) '| parListToQidList(PL)) if PL =/= nilParList . eq parListToQidList((par X :: ME)) = modNameToQidList(par X :: ME) . eq parListToQidList((par X :: If)) = modNameToQidList(par X :: If) . eq modNameToQid(QI) = QI . eq modNameToQid(par X :: ME) = qidListToQid(X ':: modNameToQid(ME)) . eq modNameToQid(par X :: par(ME, PL)) = qidListToQid(X ':: modNameToQid(ME) '`( parListToQid(PL) '`)) . eq modNameToQid(nullModName) = ' . ceq parListToQid(parList((par X :: ME), PL)) = qidListToQid(modNameToQid(par X :: ME) '| parListToQid(PL)) if PL =/= nilParList . ceq parListToQid(parList((par X :: If), PL)) = qidListToQid(modNameToQid(par X :: If) '| parListToQid(PL)) if PL =/= nilParList . eq parListToQid((par X :: ME)) = modNameToQid(par X :: ME) . eq parListToQid((par X :: If)) = modNameToQid(par X :: If) . *** eq modNameToQid(MN) = qidListToQid(modNameToQidList(MN)) . endfm ******************************************************************************* *** *** Units *** *** We handle six different types of units: functional, system, and *** object-oriented modules, and functional, system, and object-oriented *** theories. Modules and theories of any kind are considered to be elements *** in specific subsorts of the sort \texttt{Unit}. A constructor *** \texttt{error} is also included to represent incorrect units. *** \texttt{error} has a list of quoted identifiers as argument, which is *** used to report the error. Besides considering functional and system *** theories and object-oriented theories and modules, the declarations *** presented in the following module extend the declarations for sort *** \texttt{Module} in the \texttt{META-LEVEL} module in three different ways: *** \begin{itemize} *** \item the name of a module can be any term of sort \texttt{ModName}, *** \item parameterized modules are handled, for which a list of *** parameters is added to the constructors of modules, *** \item the importation declaration is extended to module names, and *** \item parameterized sorts are supported. *** \end{itemize} fmod UNIT is pr EXT-DECL . pr O-O-DECL . pr MOD-NAME-TO-QID . inc META-LEVEL . *** We start by introducing declarations for sorts \texttt{EImport} and *** \texttt{EImportList}, which are declared as supersorts of *** \texttt{Import} and \texttt{ImportList}, respectively. We declare the *** constructor \verb~including_.~ for importation declarations on module *** names. We shall see in Section~\ref{parsing-unit-declarations} that *** importations in both \texttt{protecting} and \texttt{including} modes are *** represented using this constructor. sorts EImport EImportList . subsort Import < EImport . subsorts ImportList EImport < EImportList . op protecting_. : ModName -> EImport [ctor ditto] . op extending_. : ModName -> EImport [ctor ditto] . op including_. : ModName -> EImport [ctor ditto] . op __ : EImportList EImportList -> EImportList [ctor ditto] . op error : QidList -> [EImportList] [ctor format (r o)] . eq (error(QIL) error(QIL')).[EImportList] = error(QIL QIL') . *** eq (including MN:ModName .) EIL:EImportList (including MN:ModName .) *** = (including MN:ModName .) EIL:EImportList . *** eq (including MN:ModName .) EIL:EImportList (protecting MN:ModName .) *** = (including MN:ModName .) EIL:EImportList . *** eq (protecting MN:ModName .) EIL:EImportList (including MN:ModName .) *** = (including MN:ModName .) EIL:EImportList . *** Next, we introduce the different sorts for the different types of modules *** and theories, with the subsort relation among them, and their *** constructors. The structure of the hierarchy of sorts can be seen in *** Figure~\ref{unit-sort-hierarchy}. *** \begin{figure} *** \begin{center} *** \scalebox{.8}{ *** \includegraphics{module-sort-hierarchy.eps} *** } *** \end{center} *** \caption{\label{unit-sort-hierarchy}Hierarchy of Unit Sorts.} *** \end{figure} sorts Unit FUnit SUnit OUnit StrFModule StrSModule StrOModule StrModule StrFTheory StrSTheory StrOTheory StrTheory . subsorts FModule < StrFModule < FUnit StrSModule . subsorts Module < StrSModule < SUnit StrOModule . subsorts StrFTheory < StrSTheory FUnit . subsorts StrSTheory < StrOTheory SUnit . subsort FUnit < SUnit . subsort StrOTheory < StrTheory . subsorts StrOTheory SUnit StrOModule < OUnit . subsort StrOModule < StrModule . subsorts StrTheory OUnit StrModule < Unit . op noUnit : -> Unit . *** Module op error : QidList -> [Unit] [ctor format (r o)] . op fmod_is__sorts_.____endfm : ModName ParameterList EImportList ESortSet ESubsortDeclSet EOpDeclSet EMembAxSet EquationSet -> StrFModule [ctor gather (& & & & & & & &) format (r! o r! n++io ni ni d d ni ni ni ni n--ir! o)] . op fth_is__sorts_.____endfth : ModName ParameterList EImportList ESortSet ESubsortDeclSet EOpDeclSet EMembAxSet EquationSet -> StrFTheory [ctor gather (& & & & & & & &) format (r! o r! n++io ni ni d d ni ni ni ni n--ir! o)] . op mod_is__sorts_._____endm : ModName ParameterList EImportList ESortSet ESubsortDeclSet EOpDeclSet EMembAxSet EquationSet RuleSet -> StrSModule [ctor gather (& & & & & & & & &) format (r! o r! n++io ni ni d d ni ni ni ni ni n--ir! o)] . op th_is__sorts_._____endth : ModName ParameterList EImportList ESortSet ESubsortDeclSet EOpDeclSet EMembAxSet EquationSet RuleSet -> StrSTheory [ctor gather (& & & & & & & & &) format (r! o r! n++io ni ni d d ni ni ni ni ni n--ir! o)] . op omod_is__sorts_.________endom : ModName ParameterList EImportList ESortSet ESubsortDeclSet ClassDeclSet SubclassDeclSet EOpDeclSet MsgDeclSet EMembAxSet EquationSet RuleSet -> StrOModule [ctor gather (& & & & & & & & & & & &) format (r! o r! n++io ni ni d d ni ni ni ni ni ni ni ni n--ir! o)] . op oth_is__sorts_.________endoth : ModName ParameterList EImportList ESortSet ESubsortDeclSet ClassDeclSet SubclassDeclSet EOpDeclSet MsgDeclSet EMembAxSet EquationSet RuleSet -> StrOTheory [ctor gather (& & & & & & & & & & & &) format (r! o r! n++io ni ni d d ni ni ni ni ni ni ni ni n--ir! o)] . *** In addition to the constructor operators, the following functions are *** introduced in the \texttt{UNIT} module: *** \begin{itemize} *** \item A function \verb~_in_~ to check whether a given importation *** declaration is in a set of importation declarations or not. op _in_ : EImport EImportList -> Bool . *** \item Selector functions for the different components of a unit. op getName : Unit -> ModName . op getImports : Unit -> EImportList . op getParList : Unit -> ParameterList . op getSorts : Unit -> ESortSet . op getSubsorts : Unit -> ESubsortDeclSet . op getOps : Unit -> EOpDeclSet . op getMbs : Unit -> EMembAxSet . op getEqs : Unit -> EquationSet . op getRls : Unit -> RuleSet . op getClasses : Unit -> ClassDeclSet . op getSubclassDecls : Unit -> SubclassDeclSet . op getMsgs : Unit -> MsgDeclSet . *** \item Functions to change the value of each of the components of a unit. op setName : Unit ModName -> Unit . op setPars : Unit ParameterList -> Unit . op setImports : Unit EImportList -> Unit . op setSorts : Unit ESortSet -> Unit . op setSubsorts : Unit ESubsortDeclSet -> Unit . op setOps : Unit EOpDeclSet -> Unit . op setMbs : Unit EMembAxSet -> Unit . op setEqs : Unit EquationSet -> Unit . op setRls : Unit RuleSet -> Unit . op setClasses : Unit ClassDeclSet -> Unit . op setSubclasses : Unit SubclassDeclSet -> Unit . op setMsgs : Unit MsgDeclSet -> Unit . *** \item Functions to add new declarations to the set of declarations *** already in a unit. op addImports : EImportList Unit -> Unit . op addSorts : ESortSet Unit -> Unit . op addSubsorts : [ESubsortDeclSet] Unit -> Unit . op addOps : [EOpDeclSet] Unit -> Unit . op addMbs : EMembAxSet Unit -> Unit . op addEqs : EquationSet Unit -> Unit . op addRls : RuleSet Unit -> Unit . op addClasses : ClassDeclSet Unit -> Unit . op addSubclasses : SubclassDeclSet Unit -> Unit . op addMsgs : MsgDeclSet Unit -> Unit . *** \item There are functions and constants to create empty units of the *** different types. For example, the function \texttt{emptyStrFTheory} *** returns an empty structured functional theory. There is also a *** function \texttt{empty} which takes a unit as argument and returns *** an empty unit of the same type. op emptyFModule : ModName -> FModule . op emptyStrFModule : -> StrFModule . op emptyStrSModule : -> StrSModule . op emptyStrOModule : -> StrOModule . op emptyStrFTheory : -> StrFTheory . op emptyStrSTheory : -> StrSTheory . op emptyStrOTheory : -> StrOTheory . op empty : Unit -> Unit . *** \item A function \texttt{addDecls} which returns the unit resulting from *** adding all the declarations in the unit passed as second argument *** to the unit passed as first argument. op addDecls : Unit Unit -> Unit . *** \end{itemize} *** Note that some of the `set' and `add' functions are partial functions. var M : Module . vars QI V : Qid . var ES : ESort . vars SSDS SSDS' SSDS'' : SubsortDeclSet . vars ESSDS ESSDS' : ESubsortDeclSet . vars OPDS OPDS' : OpDeclSet . vars EOPD EOPD' : EOpDecl . vars EOPDS EOPDS' : EOpDeclSet . var EOPDS? : [EOpDeclSet] . var At : Attr . vars EMAS EMAS' : EMembAxSet . vars MAS MAS' : MembAxSet . vars EqS EqS' : EquationSet . vars RlS RlS' : RuleSet . vars ESS ESS' : ESortSet . vars SS SS' : SortSet . vars IL IL' : ImportList . vars MN MN' : ModName . vars QIL QIL' : QidList . vars PL PL' : ParameterList . vars CDS CDS' : ClassDeclSet . vars SCD SCD' : SubclassDecl . vars SCDS SCDS' : SubclassDeclSet . vars U U' : Unit . vars MDS MDS' : MsgDeclSet . vars EI EI' : EImport . vars EIL EIL' : EImportList . var T : Term . eq EI in (EIL EI EIL') = true . eq EI in EIL = false [owise] . op eLeastSort : Unit Term -> [Type] . eq eLeastSort(U, T) = leastSort(U, T) . eq eLeastSort(U, error(QIL)) = error(QIL) . *** = if (U : Module) *** and (T =/= error*) *** then leastSort(U, T) *** else errorSort(none) *** fi . *** Selection functions for units eq getName((error(QIL)).Unit) = nullModName . eq getName(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm) = MN . eq getName(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth) = MN . eq getName(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm) = MN . eq getName(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth) = MN . eq getName( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom) = MN . eq getName( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth) = MN . eq getImports(error(QIL)) = nil . eq getImports(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm) = EIL . eq getImports(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth) = EIL . eq getImports(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm) = EIL . eq getImports(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth) = EIL . eq getImports( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom) = EIL . eq getImports( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth) = EIL . eq getParList(error(QIL)) = nilParList . eq getParList(noUnit) = nilParList . eq getParList(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm) = PL . eq getParList(mod QI is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = nilParList . eq getParList(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth) = PL . eq getParList(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm) = PL . eq getParList(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm) = nilParList . eq getParList(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth) = PL . eq getParList( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom) = PL . eq getParList( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth) = PL . eq getSorts((error(QIL)).Unit) = none . eq getSorts(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm) = ESS . eq getSorts(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth) = ESS . eq getSorts(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm) = ESS . eq getSorts(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth) = ESS . eq getSorts( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom) = ESS . eq getSorts( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth) = ESS . op getAllSorts : Module -> SortSet . op getSortsIncld : ImportList -> SortSet . op getSorts : ModName -> SortSet . eq getAllSorts(M) = getSorts(M) ; getSortsIncld(getImports(M)) . *** only declared for flattened modules, which only imports built-ins eq getSortsIncld(including MN . EIL) = getSorts(MN) ; getSortsIncld(EIL) . eq getSortsIncld(extending MN . EIL) = getSorts(MN) ; getSortsIncld(EIL) . eq getSortsIncld(protecting MN . EIL) = getSorts(MN) ; getSortsIncld(EIL) . eq getSortsIncld(nil) = none . eq getSorts('TRUTH-VALUE) = 'Bool . eq getSorts('THUTH) = getSorts('TRUTH-VALUE) . eq getSorts('BOOL) = getSorts('THUTH) . eq getSorts('EXT-BOOL) = getSorts('BOOL) . eq getSorts('IDENTICAL) = getSorts('BOOL) . eq getSorts('NAT) = getSorts('BOOL) ; 'Zero ; 'NzNat ; 'Nat . eq getSorts('INT) = getSorts('NAT) ; 'NzInt ; 'Int . eq getSorts('RAT) = getSorts('INT) ; 'NzRat ; 'Rat . eq getSorts('FLOAT) = getSorts('INT) ; 'FiniteFloat ; 'Float . eq getSorts('STRING) = getSorts('NAT) ; 'String ; 'Char ; 'FindResult . eq getSorts('CONVERSION ) = getSorts('RAT) ; getSorts('FLOAT) ; getSorts('STRING) ; 'DecFloat . eq getSorts('QID) = getSorts('STRING) ; 'Qid . eq getSorts('QID-LIST) = getSorts('QID) ; 'QidList . eq getSorts('META-TERM) = getSorts('QID) ; 'Sort ; 'Kind ; 'Type ; 'Constant ; 'Variable ; 'GroundTerm ; 'Term ; 'GroundTermList ; 'TermList ; 'Assignment ; 'Substitution ; 'Context ; 'CTermList ; 'GTermList . eq getSorts('META-MODULE) = getSorts('META-TERM) ; getSorts('QID-LIST) ; 'ModuleExpression ; 'Import ; 'ImportList ; 'SortSet ; 'SubsortDecl ; 'SubsortDeclSet ; 'TypeList ; 'NatList ; 'Hook ; 'HookList ; 'Attr ; 'AttrSet ; 'OpDecl ; 'OpDeclSet ; 'EqCondition ; 'Condition ; 'MembAx ; 'MembAxSet ; 'Equation ; 'EquationSet ; 'Rule ; 'RuleSet ; 'FModule ; 'Module . eq getSorts('META-LEVEL) = getSorts('META-MODULE) ; 'Bound ; 'KindSet ; 'Type? ; 'ResultPair ; 'ResultTriple ; 'Result4Tuple ; 'MatchPair ; 'ResultPair? ; 'ResultTriple? ; 'Result4Tuple? ; 'MatchPair? ; 'Substitution? . eq getSorts('CONFIGURATION) = 'Attribute ; 'AttributeSet ; 'Oid ; 'Cid ; 'Object ; 'Msg ; 'Configuration . eq getSorts('LTL) = 'Prop ; 'Formula . eq getSorts('LTL-SIMPLIFIER) = getSorts('LTL) ; 'TrueFormula ; 'FalseFormula ; 'PureFormula ; 'PE-Formula ; 'PU-Formula . eq getSorts('SAT-SOLVER) = getSorts('LTL) ; 'FormulaList ; 'SatSolveResult ; 'TautCheckResult . eq getSorts('SATISFACTION) = getSorts('LTL) ; 'State . eq getSorts('MODEL-CHECKER) = getSorts('QID) ; getSorts('SATISFACTION) ; 'RuleName ; 'Transition ; 'TransitionList ; 'ModelCheckResult . eq getSubsorts(error(QIL)) = none . eq getSubsorts(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm) = ESSDS . eq getSubsorts(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth) = ESSDS . eq getSubsorts(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm) = ESSDS . eq getSubsorts(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth) = ESSDS . eq getSubsorts( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom) = ESSDS . eq getSubsorts( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth) = ESSDS . eq getOps(error(QIL)) = none . eq getOps(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm) = EOPDS . eq getOps(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth) = EOPDS . eq getOps(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm) = EOPDS . eq getOps(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth) = EOPDS . eq getOps( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom) = EOPDS . eq getOps( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth) = EOPDS . eq getMbs(error(QIL)) = none . eq getMbs(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm) = EMAS . eq getMbs(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth) = EMAS . eq getMbs(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm) = EMAS . eq getMbs(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth) = EMAS . eq getMbs( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom) = EMAS . eq getMbs( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth) = EMAS . eq getEqs(error(QIL)) = none . eq getEqs(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm) = EqS . eq getEqs(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth) = EqS . eq getEqs(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm) = EqS . eq getEqs(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth) = EqS . eq getEqs( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom) = EqS . eq getEqs( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth) = EqS . eq getRls(error(QIL)) = none . eq getRls(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm) = RlS . eq getRls(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth) = RlS . eq getRls(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm) = none . eq getRls(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth) = none . eq getRls( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom) = RlS . eq getRls( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth) = RlS . eq getClasses(error(QIL)) = none . eq getClasses(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm) = none . eq getClasses(mod MN is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = none . eq getClasses(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth) = none . eq getClasses(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm) = none . eq getClasses(fmod MN is IL sorts SS . SSDS OPDS MAS EqS endfm) = none . eq getClasses(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth) = none . eq getClasses( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom) = CDS . eq getClasses( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth) = CDS . eq getSubclassDecls(error(QIL)) = none . eq getSubclassDecls( mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm) = none . eq getSubclassDecls(mod MN is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = none . eq getSubclassDecls( th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth) = none . eq getSubclassDecls( fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm) = none . eq getSubclassDecls(fmod MN is IL sorts SS . SSDS OPDS MAS EqS endfm) = none . eq getSubclassDecls( fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth) = none . eq getSubclassDecls( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom) = SCDS . eq getSubclassDecls( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth) = SCDS . eq getMsgs(error(QIL)) = none . eq getMsgs(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm) = none . eq getMsgs(mod MN is IL sorts SS . SSDS OPDS EMAS EqS RlS endm) = none . eq getMsgs(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth) = none . eq getMsgs(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm) = none . eq getMsgs(fmod MN is IL sorts SS . SSDS OPDS MAS EqS endfm) = none . eq getMsgs(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth) = none . eq getMsgs( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom) = MDS . eq getMsgs( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth) = MDS . *** Set functions eq setImports(error(QIL), EIL) = error(QIL) . eq setImports(mod MN is IL sorts SS . SSDS OPDS MAS EqS RlS endm, IL') = mod MN is IL' sorts SS . SSDS OPDS MAS EqS RlS endm . eq setImports( mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm, EIL') = mod MN is PL EIL' sorts ESS . ESSDS EOPDS EMAS EqS RlS endm . eq setImports( th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth, EIL') = th MN is PL EIL' sorts ESS . ESSDS EOPDS EMAS EqS RlS endth . eq setImports(fmod MN is IL sorts SS . SSDS OPDS MAS EqS endfm, IL') = fmod MN is IL' sorts SS . SSDS OPDS MAS EqS endfm . eq setImports(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm, EIL') = fmod MN is PL EIL' sorts ESS . ESSDS EOPDS EMAS EqS endfm . eq setImports(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth, EIL') = fth MN is PL EIL' sorts ESS . ESSDS EOPDS EMAS EqS endfth . eq setImports( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom, EIL') = omod MN is PL EIL' sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom . eq setImports( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth, EIL') = oth MN is PL EIL' sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth . eq setOps(error(QIL), EOPDS) = error(QIL) . eq setOps(U, error(QIL) EOPDS) = error(QIL) . eq setOps(error(QIL), error(QIL') EOPDS) = error(QIL QIL') . eq setOps(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm, EOPDS') = mod MN is PL EIL sorts ESS . ESSDS EOPDS' EMAS EqS RlS endm . eq setOps(mod MN is IL sorts SS . SSDS OPDS MAS EqS RlS endm, OPDS') = mod MN is IL sorts SS . SSDS OPDS' MAS EqS RlS endm . eq setOps(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth, EOPDS') = th MN is PL EIL sorts ESS . ESSDS EOPDS' EMAS EqS RlS endth . eq setOps(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm, EOPDS') = fmod MN is PL EIL sorts ESS . ESSDS EOPDS' EMAS EqS endfm . eq setOps(fmod MN is IL sorts SS . SSDS OPDS MAS EqS endfm, OPDS') = fmod MN is IL sorts SS . SSDS OPDS' MAS EqS endfm . eq setOps(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth, EOPDS') = fth MN is PL EIL sorts ESS . ESSDS EOPDS' EMAS EqS endfth . eq setOps( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom, EOPDS') = omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS' MDS EMAS EqS RlS endom . eq setOps( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth, EOPDS') = oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS' MDS EMAS EqS RlS endoth . eq setSubsorts(error(QIL), ESSDS) = error(QIL) . eq setSubsorts(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm, ESSDS') = mod MN is PL EIL sorts ESS . ESSDS' EOPDS EMAS EqS RlS endm . eq setSubsorts(mod MN is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SSDS') = mod MN is IL sorts SS . SSDS' OPDS MAS EqS RlS endm . eq setSubsorts(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth, ESSDS') = th MN is PL EIL sorts ESS . ESSDS' EOPDS EMAS EqS RlS endth . eq setSubsorts(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm, ESSDS') = fmod MN is PL EIL sorts ESS . ESSDS' EOPDS EMAS EqS endfm . eq setSubsorts(fmod MN is IL sorts SS . SSDS OPDS MAS EqS endfm, SSDS') = fmod MN is IL sorts SS . SSDS' OPDS MAS EqS endfm . eq setSubsorts(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth, ESSDS') = fth MN is PL EIL sorts ESS . ESSDS' EOPDS EMAS EqS endfth . eq setSubsorts( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom, ESSDS') = omod MN is PL EIL sorts ESS . ESSDS' CDS SCDS EOPDS MDS EMAS EqS RlS endom . eq setSubsorts( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth, ESSDS') = oth MN is PL EIL sorts ESS . ESSDS' CDS SCDS EOPDS MDS EMAS EqS RlS endoth . eq setMbs(error(QIL), EMAS) = error(QIL) . eq setMbs(U, error(QIL) EMAS) = error(QIL) . eq setMbs(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm, EMAS') = mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS' EqS RlS endm . eq setMbs(mod MN is IL sorts SS . SSDS OPDS MAS EqS RlS endm, MAS') = mod MN is IL sorts SS . SSDS OPDS MAS' EqS RlS endm . eq setMbs(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth, EMAS') = th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS' EqS RlS endth . eq setMbs(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm, EMAS') = fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS' EqS endfm . eq setMbs(fmod MN is IL sorts SS . SSDS OPDS MAS EqS endfm, MAS') = fmod MN is IL sorts SS . SSDS OPDS MAS' EqS endfm . eq setMbs(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth, EMAS') = fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS' EqS endfth . eq setMbs( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom, EMAS') = omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS' EqS RlS endom . eq setMbs( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth, EMAS') = oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS' EqS RlS endoth . eq setEqs(error(QIL), EqS) = error(QIL) . eq setEqs(U, error(QIL) EqS?:[EquationSet]) = error(QIL) . eq setEqs(error(QIL), error(QIL') EqS?:[EquationSet]) = error(QIL QIL') . eq setEqs(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm, EqS') = mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS' RlS endm . eq setEqs(mod MN is IL sorts SS . SSDS OPDS MAS EqS RlS endm, EqS') = mod MN is IL sorts SS . SSDS OPDS MAS EqS' RlS endm . eq setEqs(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth, EqS') = th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS' RlS endth . eq setEqs(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm, EqS') = fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS' endfm . eq setEqs(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, EqS') = fmod QI is IL sorts SS . SSDS OPDS MAS EqS' endfm . eq setEqs(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth, EqS') = fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS' endfth . eq setEqs( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom, EqS') = omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS' RlS endom . eq setEqs( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth, EqS') = oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS' RlS endoth . op setRls : [Unit] [RuleSet] -> [Unit] . var U? : [Unit] . var RlS? : [RuleSet] . eq setRls(error(QIL), RlS?) = error(QIL) . eq setRls(U?, error(QIL) RlS?) = error(QIL) . eq setRls(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm, RlS') = mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS' endm . eq setRls(mod MN is IL sorts SS . SSDS OPDS MAS EqS RlS endm, RlS') = mod MN is IL sorts SS . SSDS OPDS MAS EqS RlS' endm . eq setRls(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth, RlS') = th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS' endth . eq setRls(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm, RlS) = if RlS == none then fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm else mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm fi . eq setRls(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, RlS) = if RlS == none then fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm else mod QI is IL sorts SS . SSDS OPDS MAS EqS RlS endm fi . eq setRls(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth, RlS) = if RlS == none then fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth else th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth fi . eq setRls(omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom, RlS') = omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS' endom . eq setRls(oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth, RlS') = oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS' endoth . eq setSorts(error(QIL), ESS) = error(QIL) . eq setSorts(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm, ESS') = mod MN is PL EIL sorts ESS' . ESSDS EOPDS EMAS EqS RlS endm . eq setSorts(mod MN is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SS') = mod MN is IL sorts SS' . SSDS OPDS MAS EqS RlS endm . eq setSorts(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth, ESS') = th MN is PL EIL sorts ESS' . ESSDS EOPDS EMAS EqS RlS endth . eq setSorts(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm, ESS') = fmod MN is PL EIL sorts ESS' . ESSDS EOPDS EMAS EqS endfm . eq setSorts(fmod MN is IL sorts SS . SSDS OPDS MAS EqS endfm, SS') = fmod MN is IL sorts SS' . SSDS OPDS MAS EqS endfm . eq setSorts(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth, ESS') = fth MN is PL EIL sorts ESS' . ESSDS EOPDS EMAS EqS endfth . eq setSorts( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom, ESS') = omod MN is PL EIL sorts ESS' . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom . eq setSorts( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth, ESS') = oth MN is PL EIL sorts ESS' . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth . eq setPars(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm, PL') = mod MN is PL' EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm . eq setPars(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth, PL') = th MN is PL' EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth . eq setPars(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm, PL') = fmod MN is PL' EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm . eq setPars(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth, PL') = fth MN is PL' EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth . eq setPars( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom, PL') = omod MN is PL' EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom . eq setPars( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth, PL') = oth MN is PL' EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth . eq setClasses( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom, CDS') = omod MN is PL EIL sorts ESS . ESSDS CDS' SCDS EOPDS MDS EMAS EqS RlS endom . eq setClasses( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth, CDS') = oth MN is PL EIL sorts ESS . ESSDS CDS' SCDS EOPDS MDS EMAS EqS RlS endoth . eq setSubclasses( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom, SCDS') = omod MN is PL EIL sorts ESS . ESSDS CDS SCDS' EOPDS MDS EMAS EqS RlS endom . eq setSubclasses( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth, SCDS') = oth MN is PL EIL sorts ESS . ESSDS CDS SCDS' EOPDS MDS EMAS EqS RlS endoth . eq setMsgs( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom, MDS') = omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS' EMAS EqS RlS endom . eq setMsgs( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth, MDS') = oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS' EMAS EqS RlS endoth . eq setName(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm, MN') = mod MN' is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm . eq setName(mod MN is IL sorts SS . SSDS OPDS MAS EqS RlS endm, MN') = mod MN' is IL sorts SS . SSDS OPDS MAS EqS RlS endm . eq setName(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm, MN') = fmod MN' is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm . eq setName(fmod MN is IL sorts SS . SSDS OPDS MAS EqS endfm, MN') = fmod MN' is IL sorts SS . SSDS OPDS MAS EqS endfm . eq setName(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth, MN') = fth MN' is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth . eq setName(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth, MN') = th MN' is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth . eq setName( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom, MN') = omod MN' is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom . eq setName( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth, MN') = oth MN' is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth . eq setName(noUnit, MN) = noUnit . eq setName(error(QIL), MN) = error(QIL) . *** Add functions eq addSorts(ESS, U) = setSorts(U, (ESS ; getSorts(U))) . eq addSubsorts(ESSDS, U) = setSubsorts(U, (ESSDS getSubsorts(U))) . eq addSubsorts(error(QIL), U) = error(QIL) . eq addOps(EOPDS, U) = setOps(U, (EOPDS getOps(U))) . eq addOps(EOPDS?, error(QIL)) = error(QIL) . eq addOps(EOPDS?, U) = U [owise] . eq addMbs(EMAS, U) = setMbs(U, (EMAS getMbs(U))) . eq addEqs(EqS, U) = setEqs(U, (EqS getEqs(U))) . eq addRls(RlS, U) = setRls(U, (RlS getRls(U))) . eq addImports(EIL, U) = setImports(U, (getImports(U) EIL)) . eq addClasses(CDS, U) = setClasses(U, (getClasses(U) CDS)) . eq addSubclasses(SCDS, U) = setSubclasses(U, (getSubclassDecls(U) SCDS)) . eq addMsgs(MDS, U) = setMsgs(U, (getMsgs(U) MDS)) . *** Creation of empty units eq emptyFModule(MN) = fmod modNameToQid(MN) is nil sorts none . none none none none endfm . eq emptyStrFModule = fmod nullModName is nilParList nil sorts none . none none none none endfm . eq emptyStrSModule = mod nullModName is nilParList nil sorts none . none none none none none endm . eq emptyStrOModule = omod nullModName is nilParList nil sorts none . none none none none none none none none endom . eq emptyStrFTheory = fth nullModName is nilParList nil sorts none . none none none none endfth . eq emptyStrSTheory = th nullModName is nilParList nil sorts none . none none none none none endth . eq emptyStrOTheory = oth nullModName is nilParList nil sorts none . none none none none none none none none endoth . *** \texttt{empty} returns an empty unit of the same type of the one given as *** argument. eq empty(mod MN is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = (mod MN is nil sorts none . none none none none none endm) . eq empty(mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm) = (mod MN is nilParList nil sorts none . none none none none none endm) . eq empty(th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth) = (th MN is nilParList nil sorts none . none none none none none endth) . eq empty(fmod MN is IL sorts SS . SSDS OPDS MAS EqS endfm) = (fmod MN is nil sorts none . none none none none endfm) . eq empty(fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm) = (fmod MN is nilParList nil sorts none . none none none none endfm) . eq empty(fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth) = (fth MN is nilParList nil sorts none . none none none none endfth) . eq empty( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom) = (omod MN is nilParList nil sorts none . none none none none none none none none endom) . eq empty( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth) = (oth MN is nilParList nil sorts none . none none none none none none none none endoth) . *** In the following \texttt{addDecls} function, the declarations of the unit *** given as second argument are added to the unit given as first argument. eq addDecls(error(QIL), U) = error(QIL) . eq addDecls(U, error(QIL)) = error(QIL) . ceq addDecls(U, U') = addImports(getImports(U'), addSorts(getSorts(U'), addSubsorts(getSubsorts(U'), addOps(getOps(U'), addMbs(getMbs(U'), addEqs(getEqs(U'), if U :: FUnit then U else addRls(getRls(U'), if U :: SUnit then U else addClasses(getClasses(U'), addSubclasses(getSubclassDecls(U'), addMsgs(getMsgs(U'), U))) fi) fi)))))) if ((U :: StrModule) or (U :: StrTheory)) and ((U' :: StrModule) or (U' :: StrTheory)) . endfm ******************************************************************************* *** *** The Abstract Data Type \texttt{View} *** *** In this section we present the data type \texttt{View} for views. *** Basically, the data elements of sort \texttt{View} are composed by the *** name of the view, the names of the source and target units, and a set of *** maps representing the maps asserting how the given target unit is claimed *** to satisfy the source theory (see Section~\ref{Views}). *** Internally, renaming maps are considered to be a particular case of view *** maps. The sort \texttt{ViewMap} is declared as a supersort of *** \texttt{Map}. The only kind of maps in sort \texttt{ViewMap} not in sort *** \texttt{Map} are maps of operators going to derived operators. We start *** introducing the declarations for renaming maps and sets of renaming maps *** in Section~\ref{renaming-maps}, we then introduce view maps and sets of *** view maps in Section~\ref{view-maps}, and finally we introduce the sort *** \texttt{View}, its constructor, and some operations on it in *** Section~\ref{viewADT}. *** *** View Maps *** *** In addition to the maps of sort \texttt{Map} declared in the \texttt{MAP} *** module, in views there can also be maps from operators to derived *** operators, that is, terms with variables (see Section~\ref{Views}). Maps *** of this kind are given with the constructor \texttt{termMap}, which, in *** addition to the source and target terms, takes the set of variable *** declarations for the variables used in the map. The source term must be of *** the form $\texttt{F(X}_1\texttt{,}\ldots,\texttt{X}_n\texttt{)}$, where *** \texttt{F} is an operator name declared with $n$ arguments of sorts in the *** connected components of the variables $\texttt{X}_1\ldots\texttt{X}_n$, *** respectively. We will see in Section~\ref{view-processing} how in the *** initial processing of a view the variables declared in it are associated *** to each of the maps in which they are used. fmod VIEW-MAP is pr MAP . pr EXT-DECL . sort TermMap . op termMap : Term Term -> TermMap . sorts ViewMap ViewMapSet . subsorts Map TermMap < ViewMap . subsorts ViewMap MapSet < ViewMapSet . op _`,_ : ViewMapSet ViewMapSet -> ViewMapSet [assoc comm id: none] . var MAP : Map . var VMAP : ViewMap . var VMAPS : ViewMapSet . vars T T' : Term . *** As for sets of maps, \texttt{SortMapSet} returns the subset of sort maps *** in a set of view maps. op sortMaps : ViewMapSet -> MapSet . eq sortMaps((VMAP, VMAPS)) = if VMAP :: SortMap then (VMAP, sortMaps(VMAPS)) else sortMaps(VMAPS) fi . eq sortMaps(none) = none . op eSortToSort : ViewMapSet -> ViewMapSet . eq eSortToSort((termMap(T, T'), VMAPS)) = (termMap(T, T'), eSortToSort(VMAPS)) . eq eSortToSort((MAP, VMAPS)) = (eSortToSort(MAP), eSortToSort(VMAPS)) [owise] . endfm ******************************************************************************* *** *** Views *** *** The \texttt{View} sort is introduced in the following module *** \texttt{VIEW}. In addition to the constructor for views (\texttt{view}), *** selector functions are added for each of the components of a *** view (\texttt{name}, \texttt{source}, \texttt{target}, and *** \texttt{mapSet}), and a constant \texttt{emptyView}, which is identified *** in an equation with the empty view, is defined. *** Although the declaration of the constructor for views includes an argument *** for the list of parameters, parameterized views are not handled yet, so at *** present this argument must be set to the \texttt{nilParList}. fmod VIEW is pr UNIT . pr VIEW-MAP . sort View . op view : ViewExp ParameterList ModExp ModExp ViewMapSet -> View [ctor format (nir! o)] . op noView : -> View [ctor] . op error : QidList -> [View] [ctor format (r o)] . var QI : Qid . vars VE VE' : ViewExp . vars PL PL' : ParameterList . vars ME ME' ME'' : ModExp . vars VMAPS VMAPS' : ViewMapSet . var QIL : QidList . op name : View -> ViewExp . op getParList : [View] -> ParameterList . op source : View -> ModExp . op target : View -> ModExp . op mapSet : View -> ViewMapSet . eq name(view(VE, PL, ME, ME', VMAPS)) = VE . eq getParList(view(VE, PL, ME, ME', VMAPS)) = PL . eq getParList((error(QIL)).View) = error(QIL) . eq target(view(VE, PL, ME, ME', VMAPS)) = ME' . eq source(view(VE, PL, ME, ME', VMAPS)) = ME . eq mapSet(view(VE, PL, ME, ME', VMAPS)) = VMAPS . op setName : View ViewExp ~> View . op setPars : View ParameterList ~> View . op setTarget : View ModExp ~> View . op setSource : View ModExp ~> View . op setMapSet : View ViewMapSet ~> View . eq setName(view(VE, PL, ME, ME', VMAPS), VE') = view(VE', PL, ME, ME', VMAPS) . eq setName((error(QIL)).[View], VE) = error(QIL) . eq setPars(view(VE, PL, ME, ME', VMAPS), PL') = view(VE, PL', ME, ME', VMAPS) . eq setPars((error(QIL)).[View], PL) = error(QIL) . eq setSource(view(VE, PL, ME, ME', VMAPS), ME'') = view(VE, PL, ME'', ME', VMAPS) . eq setSource(error(QIL), ME) = error(QIL) . eq setTarget(view(VE, PL, ME, ME', VMAPS), ME'') = view(VE, PL, ME, ME'', VMAPS) . eq setTarget(error(QIL), ME) = error(QIL) . eq setMapSet(view(VE, PL, ME, ME', VMAPS), VMAPS') = view(VE, PL, ME, ME', VMAPS') . eq setMapSet(error(QIL), VMAPS) = error(QIL) . op emptyView : Qid ModExp ModExp -> View . eq emptyView(QI, ME, ME') = view(QI, nilParList, ME, ME', none) . endfm ******************************************************************************* *** *** The Abstract Data Type \texttt{Database} *** *** In this section we present the data type \texttt{Database}, which will be *** used to store information about the units and views in the system. Before *** discussing this data type in Section~\ref{databaseADT}, we present the *** predefined units added in Full Maude to those already available in Core *** Maude. *** *** Non-Built-In Predefined Modules *** *** As we shall see in the following section, except for the *** \texttt{LOOP-MODE} module, all the predefined modules that are available *** in Core Maude are also available in Full Maude. In addition to these Core *** Maude predefined modules, in Full Maude there are some additional *** predefined units. In the present system, the only units with which the *** database is initialized are the functional theory \texttt{TRIV}, the *** module \texttt{CONFIGURATION}, and the module \texttt{UP}, which will be *** used to evaluate the \texttt{up} functions. We shall see in *** Section~\ref{main-module} how new predefined modules can be added to the *** initial database. fmod PREDEF-UNITS is pr UNIT . op TRIV : -> StrFTheory . eq TRIV = (fth 'TRIV is nilParList nil sorts 'Elt . none none none none endfth) . op CONFIGURATION+ : -> StrModule . eq CONFIGURATION+ = (mod 'CONFIGURATION+ is nilParList including 'CONFIGURATION . sorts none . none op '<_:_|`> : 'Oid 'Cid -> 'Object [none] . op 'class : 'Object -> 'Cid [none] . none eq '<_:_|`>['O:Oid, 'C:Cid] = '<_:_|_>['O:Oid, 'C:Cid, 'none.AttributeSet] [none] . eq 'class['<_:_|_>['O:Oid, 'C:Cid, 'A:AttributeSet]] = 'C:Cid [none] . none endm) . ***( eq CONFIGURATION+ = (mod 'CONFIGURATION+ is *** nilParList including 'CONFIGURATION . sorts none . none op '<_:_|`> : 'Oid 'Cid -> 'Object [none] . op 'class : 'Object -> 'Cid [none] . none eq 'bubble['< 'O:Oid ': 'C:Cid '| '>] = 'bubble['< 'O:Oid ': 'C:Cid '| 'none.AttributeSet '>] [none] . eq 'bubble['class '`( '< 'O:Oid ': 'C:Cid '| 'A:AttributeSet '>] = 'bubble['C:Cid] [none] . none endm) . ) *** The following module \texttt{UP} contains the necessary declarations to *** be able to parse the \texttt{up} functions presented in *** Section~\ref{structured-specifications}. We shall see in *** Section~\ref{evaluation} how a declaration importing the following module *** \texttt{UP} is added to all the modules importing the predefined module *** \texttt{META-LEVEL}. With this declaration, it is possible to parse the *** \texttt{up} commands in the bubbles of such modules or in commands being *** evaluated in such modules. We shall see in Section~\ref{bubble-parsing} *** how these commands are then evaluated. op UP : -> StrFModule . eq UP = (fmod 'UP is *** nilParList including 'QID-LIST . including 'META-LEVEL . sorts 'Token ; 'Bubble . none op 'token : 'Qid -> 'Token [special( (id-hook('Bubble, '1 '1) op-hook('qidSymbol, ', nil, 'Qid)))] . op 'bubble : 'QidList -> 'Bubble [special( (id-hook('Bubble, '1 '-1 '`( '`)) op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList) op-hook('qidSymbol, ', nil, 'Qid)))] . op 'up : 'Token 'Bubble -> 'Term [none] . op 'up : 'Token -> 'Module [none] . op '`[_`] : 'Token -> 'Module [none] . none none endfm) . op SET : -> StrFModule . eq SET = (fmod 'SET is par 'X :: 'TRIV protecting par 'X :: 'TRIV . protecting 'BOOL . sorts eSort('Set, 'X) . subsort 'X@Elt < eSort('Set, 'X) . op '__ : eSort('Set, 'X) eSort('Set, 'X) -> eSort('Set, 'X) [assoc comm ctor id('mt.Set`(X`))] . op 'mt : nil -> eSort('Set, 'X) [ctor] . none none endfm) . endfm ******************************************************************************* *** *** 7 The Evaluation of Views *** *** Before being entered into the database, besides containing bubbles, views *** have a somewhat different structure from that of the views given in *** Section~\ref{viewADT}. We introduce in the following module a sort *** \texttt{PreView} with constructor \texttt{view}, which is declared as the *** constructor for views of sort \texttt{View}, but with an additional *** argument, namely, a set of variable declarations to hold the declarations *** of variables in the view. During the processing of views (see *** Section~\ref{view-processing}), which takes place once the parsing process *** has concluded, these variables are associated with the corresponding maps *** where they are used, generating a term of sort \texttt{View}. *** We start by introducing in the following module \texttt{PRE-VIEW-MAP} the *** sorts \texttt{TermPreMap}, \texttt{PreViewMap}, and *** \texttt{PreViewMapSet}. A preview map is a view map with bubbles. Note *** that the bubbles can only appear in term maps. Elements of sort *** \texttt{TermPreMap} are built with the constructor \texttt{preTermMap}, *** which takes two terms of sort \texttt{Term}, that is, two bubbles. In the *** processing of views (see Section~\ref{view-processing}), elements of sort *** \texttt{PreTermMap} will be converted into elements of sort *** \texttt{TermMap} by parsing the bubbles in them, and by associating to *** them the variables in them defined in the view in which the maps appear. fmod PRE-VIEW-MAP is pr VIEW-MAP . sort TermPreMap . op preTermMap : Term Term -> TermPreMap . sorts PreViewMap PreViewMapSet . subsorts Map TermPreMap < PreViewMap . subsorts PreViewMap ViewMapSet < PreViewMapSet . op _`,_ : PreViewMapSet PreViewMapSet -> PreViewMapSet [assoc comm id: none] . var PVMAP : PreViewMap . var PVMAPS : PreViewMapSet . *** Given a set of maps, the function \texttt{sortMaps} returns the subset *** of sort maps in it. op sortMaps : PreViewMapSet -> MapSet . eq sortMaps((PVMAP, PVMAPS)) = if PVMAP :: SortMap then (PVMAP, sortMaps(PVMAPS)) else sortMaps(PVMAPS) fi . eq sortMaps(none) = none . endfm ******************************************************************************* fmod PRE-VIEW is pr UNIT . pr PRE-VIEW-MAP . sort PreView . op view : ViewExp ParameterList ModExp ModExp EOpDeclSet PreViewMapSet -> PreView . op noView : -> PreView . op name : PreView -> ViewExp . op getParList : PreView -> ParameterList . op source : PreView -> ModExp . op target : PreView -> ModExp . op vars : PreView -> EOpDeclSet . op mapSet : PreView -> PreViewMapSet . var QI : Qid . vars ME ME' : ModExp . var VE : ViewExp . vars PL PL' : ParameterList . vars VDS VDS' : EOpDeclSet . vars PVMAPS PVMAPS' : PreViewMapSet . eq name(view(VE, PL, ME, ME', VDS, PVMAPS)) = VE . eq getParList(view(VE, PL, ME, ME', VDS, PVMAPS)) = PL . eq target(view(VE, PL, ME, ME', VDS, PVMAPS)) = ME' . eq source(view(VE, PL, ME, ME', VDS, PVMAPS)) = ME . eq vars(view(VE, PL, ME, ME', VDS, PVMAPS)) = VDS . eq mapSet(view(VE, PL, ME, ME', VDS, PVMAPS)) = PVMAPS . *** The following functions can be used to add new declarations to the set of *** declarations already in a preview. op addMapSet : PreViewMapSet PreView -> PreView . op addVars : OpDeclSet PreView -> PreView . eq addMapSet(PVMAPS, view(VE, PL, ME, ME', VDS, PVMAPS')) = view(VE, PL, ME, ME', VDS, (PVMAPS, PVMAPS')) . eq addVars(VDS, view(VE, PL, ME, ME', VDS', PVMAPS)) = view(VE, PL, ME, ME', VDS VDS', PVMAPS) . op setPars : PreView ParameterList -> PreView . eq setPars(view(VE, PL, ME, ME', VDS, PVMAPS), PL') = view(VE, PL', ME, ME', VDS, PVMAPS) . op emptyPreView : Qid ModExp ModExp -> PreView . eq emptyPreView(QI, ME, ME') = view(QI, nilParList, ME, ME', none, none, none) . endfm ******************************************************************************* *** *** The Database *** *** In order to be able to refer to modules by name, which is extremely useful *** for module definition purposes at the user level, the evaluation of module *** expressions takes place in the context of a database, in which we keep *** information about the modules already introduced in the system, and also *** about those modules generated internally. This information is stored as *** a set of elements of sort \texttt{UnitInfo} and \texttt{ViewInfo}, in *** which we hold, respectively, the information concerning units and views. *** For each unit we save: *** \begin{itemize} *** \item Its original form, as introduced by the user, or, in case of an *** internally generated unit, as generated from the original form of *** some other unit. *** \item Its internal representation, in which variables have been renamed *** to avoid collisions with the names of variables in other units in *** the same hierarchy. In the case of object-oriented units, we store *** its equivalent system module, that is, the result of transforming *** it into a system module. *** \item Its signature, which is given as a functional module of sort *** \texttt{FModule} with no axioms, ready to be used in calls to *** \texttt{metaParse}. There can only be importation declarations *** including built-in modules in this module. These are the only *** inclusions handled by the Core Maude engine. *** \item Its flattened version, for which, as for signatures, only the *** importation of built-in modules is left unevaluated. *** \end{itemize} *** For each view we keep its name and the view itself. *** As a simple mechanism to keep the database consistent, for each unit we *** maintain the list of names of all the units and views ``depending'' on it. *** Similarly, for each view we maintain the list of names of all the units *** ``depending'' on it. The idea is that if a unit or view is redefined or *** removed, all those units and/or views depending on it will also be *** removed. This dependency does not only mean direct importation. For *** example, the module resulting from the renaming of some module also *** depends on the module being renamed; the instantiation of a parameterized *** module also depends on the parameterized module and on all the views used *** in its instantiation; a view depends on its source and target units, etc. *** This dependency is transitive: if a module, theory, or view has to be *** removed, all the units and/or views depending on them will be removed as *** well. The dependencies derived from the module expressions themselves are *** established by the function \texttt{setUpModExpDeps}. The function *** \texttt{setUpUnitDependencies} calls \texttt{setUpModExpDeps}, *** and then \texttt{setUpImportSetDependencies} to add the \emph{back *** references} in the modules being imported. The function *** \texttt{setUpViewDeps} sets up the back references for the views *** being introduced. *** In addition to this set of information cells for units and views, we also *** keep lists with the names of all the units and views in the database, and *** a list of quoted identifiers in which we store the messages generated *** during the process of treatment of the inputs in order to simplify the *** communication with the read-eval-print loop process. fmod DATABASE is pr VIEW . pr PRE-VIEW . op evalUnit : Unit Database -> Database . *** its definition is in EVALUATION op procUnit : Qid Database -> Database . op procView : Qid Database -> Database . *** their definitions are in UNIT-PROCESSING and VIEW-PROCESSING op evalModExp : ModExp Database -> Database . *** its definition is in MOD-EXPR-EVAL sort UnitInfo . op <_;_;_;_;_;_;_;_> : ModName Default`(Term`) Unit Unit Unit OpDeclSet ModNameSet ViewExpSet -> UnitInfo [ctor format (nig o g n+++io g nio g nio g nio g nio g nio g nio n---ig o)] . op <_;_;_;_;_;_;_;_> : ModName Unit Unit Unit Unit OpDeclSet ModNameSet ViewExpSet -> UnitInfo [ctor format (nig o g n+++io g nio g nio g nio g nio g nio g nio n---ig o)] . *** - Modules can be introduced by the user or can be generated internally. *** When introduced by the user the 2nd arg. keeps the term representation *** of the module as given, so that it can be recompiled later. If the *** module is generated internally as the result of the evaluation of a *** module expression, then this second arg. will be noTerm, the default *** term value. The user can also enter modules with the procUnit *** function, providing then the metarepresentation of a module, which *** is directly stored in the database as the 2nd arg. of one of these *** UnitInfo units of the second kind. This is useful for the ITP for *** example, where the interaction with the database takes place at the *** metalevel and the modules given by the "user" are already at the *** metalevel but still wants the same treatment. *** - The sixth arg. stores the variables (corresponding ops.) in the top *** module. sort ViewInfo . op <_;_;_;_;_> : ViewExp Default`(Term`) View ModNameSet ViewExpSet -> ViewInfo [ctor format (nig o g n+++io g nio g nio g nio n---ig o)] . op <_;_;_;_;_> : ViewExp View View ModNameSet ViewExpSet -> ViewInfo [ctor format (nig o g n+++io g nio g nio g nio n---ig o)] . sort InfoSet . subsort UnitInfo ViewInfo < InfoSet . op emptyInfoSet : -> InfoSet . op __ : InfoSet InfoSet -> InfoSet [assoc comm id: emptyInfoSet] . sort Database . op db : InfoSet ModNameSet ViewExpSet QidList -> Database [ctor format (nib i++o)] . vars QI X Y F : Qid . vars QIL QIL' : QidList . vars VE VE' VE'' : ViewExp . vars VES VES' VES'' VES''' : ViewExpSet . var IS : InfoSet . vars MNS MNS' MNS'' : ModNameSet . var PL : ParameterList . vars ME ME' : ModExp . vars VI VI' : View . var VMAPS : ViewMapSet . var PVMAPS : PreViewMapSet . vars PU PU' U U' U'' U''' U'''' : Unit . var M : Module . var DB : Database . var EIL : EImportList . vars MN MN' : ModName . var If : Interface . var VIf : ViewInfo . var UIf : UnitInfo . vars OPDS VDS VDS' : OpDeclSet . var PV : PreView . vars T T' : Term . var DT : Default`(Term`) . var NL : IntList . var TPL : TypeList . var TP : Type . var AtS : AttrSet . *** The constant \texttt{emptyDatabase} denotes the empty database, and there *** are predicates \texttt{viewInDatabase} and \texttt{unitInDb} to check, *** respectively, whether a view and a unit are in a database or not. op emptyDatabase : -> Database . eq emptyDatabase = db(emptyInfoSet, noneModNameSet, noneViewExpSet, nil) . op unitInDb : ModName Database -> Bool . op viewInDb : ViewExp Database -> Bool . eq viewInDb(VE, db(IS, MNS, VES, QIL)) = VE inViewExpSet VES . eq unitInDb(MN, db(IS, MNS, VES, QIL)) = MN inModNameSet MNS . *** If a module, theory, or view is being redefined, that is, if there was *** already in the database a module, theory, or view with the same name, *** then all the units and/or views depending on it are removed using the *** functions \texttt{delUnits} and \texttt{delViews}. Removing a view *** or a unit from the database means removing its info cell from the set of *** cells in the database. Those entered by the user are not completely *** removed, their term form is saved so that it can be recompiled later. op delUnits : ModNameSet Database -> Database . op delViews : ViewExpSet Database -> Database . eq delUnits((MN . MNS), db(< MN ; T ; U ; U' ; U'' ; VDS ; MNS' ; VES > IS, MN . MNS'', VES', QIL)) = delUnits((MNS . MNS'), delViews(VES, db(< MN ; T ; noUnit ; noUnit ; noUnit ; VDS ; noneModNameSet ; noneViewExpSet > IS, MN . MNS'', VES', QIL ))) . eq delUnits((MN . MNS), db(< MN ; noTerm ; U ; U' ; U'' ; VDS ; MNS' ; VES > IS, MN . MNS'', VES', QIL)) = delUnits((MNS . MNS'), delViews(VES, db(IS, MNS'', VES', QIL ))) . eq delUnits((MN . MNS), db(< MN ; U ; U' ; U'' ; U''' ; VDS ; MNS' ; VES > IS, MN . MNS'', VES', QIL)) = delUnits((MNS . MNS'), delViews(VES, db(< MN ; U ; noUnit ; noUnit ; noUnit ; VDS ; noneModNameSet ; noneViewExpSet > IS, MN . MNS'', VES', QIL ))) . eq delUnits(noneModNameSet, DB) = DB . eq delUnits((MN . MNS), DB) = delUnits(MNS, DB) [owise] . eq delViews(VE # VES, db(< VE ; T ; VI ; MNS ; VES' > IS, MNS', VES'', QIL)) = delViews(VES # VES', delUnits(MNS, db(< VE ; T ; noView ; noneModNameSet ; noneViewExpSet > IS, MNS', VES'', QIL ))) . eq delViews((VE # VES), db((< VE ; noTerm ; VI ; MNS ; VES' > IS), MNS', VE # VES'', QIL)) = delViews(VES # VES', delUnits(MNS, db(IS, MNS', VES'', QIL ))) . eq delViews(VE # VES, db(< VE ; VI ; VI' ; MNS ; VES' > IS, MNS', VES'',QIL)) = delViews(VES # VES', delUnits(MNS, db(< VE ; VI ; noView ; noneModNameSet ; noneViewExpSet > IS, MNS', VES'', QIL ))) . eq delViews(noneViewExpSet, DB) = DB . eq delViews(VE # VES, DB) = delViews(VES, DB) [owise] . *** The \texttt{warning} function allows us to place messages (warning, error, *** or any other kind of messages) in the last argument of the database *** constructor. These messages are given in the form of quoted identifier *** lists, and will be passed to the third argument of the read-eval-print *** loop, to be printed in the terminal. op warning : Database QidList -> Database . eq warning(db(IS, MNS, VES, QIL), QIL') = if QIL == nil then db(IS, MNS, VES, QIL') else db(IS, MNS, VES, QIL) fi . op getMsg : Database -> QidList . eq getMsg(db(IS, MNS, VES, QIL)) = QIL . *** The constant \texttt{builtIns} denotes the set of identifiers of the *** predefined modules of Core Maude. It will be used to check whether a *** particular module is a built-in Core Maude module or not. Note that *** LOOP-MODE is not included in this list, since it is not allowed in *** Full Maude. op builtIns : -> ModNameSet . eq builtIns = 'TRUTH-VALUE . 'THUTH . 'BOOL . 'EXT-BOOL . 'IDENTICAL . 'NAT . 'INT . 'RAT . 'FLOAT . 'STRING . 'CONVERSION . 'QID . 'QID-LIST . 'META-TERM . 'META-MODULE . 'META-LEVEL . 'CONFIGURATION . 'LTL . 'LTL-SIMPLIFIER . 'SAT-SOLVER . 'SATISFACTION . 'MODEL-CHECKER . *** Core Maude built-in modules are handled in a special way in the current *** version of the system. They are not explicitly defined in the Full Maude *** database; their importation is directly handled by Core Maude. This has *** some drawbacks: Core Maude built-in modules cannot be renamed; they cannot *** be directly used with built-in functions, such as \texttt{metaReduce} or *** \texttt{sameComponent}, although they can be imported in modules being *** used in the calls to these functions; and, in general, any function taking *** as argument or returning as result the metarepresentation of a module *** cannot take one of these built-in modules as argument. This is the case, *** for example, for the \texttt{up} function presented in *** Section~\ref{changing-levels}, or for functions or commands in which the *** name of a module has to be specified, as the \texttt{select} or *** \texttt{down} commands, or the \texttt{up} function presented in *** Section~\ref{structured-specifications}. Nevertheless, there are also *** some advantages: The flattening of the built-in part of the structure is *** accomplished more efficiently, and, since these modules do not have to be *** stored in the database of Full Maude, the size of the database is reduced. *** Our plan is to have in the future a hybrid solution. Once we have some way *** of storing the modules entered to Full Maude in Core Maude's database, it *** will be enough to keep in the Full Maude database just the original form *** of the top of all the modules, including built-ins, leaving all the *** importation declarations to be resolved by the engine. The structures will *** be normalized as they are now, so that the engine will have to deal just *** with inclusions, but it will be possible to use the predefined modules as *** any other module. Moreover, the Full Maude database will be relatively *** smaller and the flattening will be computed more efficiently. *** When a new module or theory is entered, the names of all the modules, *** theories, and views depending on it are included in its lists of *** dependencies with functions \texttt{setUpUnitDependencies} and *** \texttt{setUpViewDeps}. Notice that if new module expressions are *** defined, the function \texttt{setUpModExpDeps} will have to be *** extended accordingly. op setUpUnitDeps : Unit Database -> Database . op setUpModExpDeps : ModName Database -> Database . op setUpModExpDeps : ModName ModName Database -> Database . op setUpModExpDeps : ModName ViewExp Database -> Database . op setUpImportDeps : ModName EImportList Database -> Database . eq setUpUnitDeps(U, DB) = setUpImportDeps(getName(U), getImports(U), setUpModExpDeps(getName(U), DB)) . eq setUpModExpDeps(QI, DB) = DB . eq setUpModExpDeps((par X :: ME), db((< ME ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = db((< ME ; DT ; U ; U' ; U'' ; VDS ; MNS . (par X :: ME) ; VES > IS), MNS', VES', QIL) . eq setUpModExpDeps((par X :: ME), db(< ME ; U ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = db((< ME ; U ; U' ; U'' ; U''' ; VDS ; MNS . (par X :: ME) ; VES > IS), MNS', VES', QIL) . eq setUpModExpDeps((par X :: ME), DB) = warning(DB, ('\r 'Error: '\o 'Module modNameToQidList(ME) 'not 'in 'database. '\n)) [owise] . eq setUpModExpDeps((par X :: If), DB) = setUpModExpDeps((par X :: If), (par X :: If), DB) . eq setUpModExpDeps((par X :: par(ME, parList(par Y :: ME', PL))), MN, db((< ME' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = setUpModExpDeps((par X :: par(ME, PL)), MN, db(< ME' ; DT ; U ; U' ; U'' ; VDS ; MNS . MN ; VES > IS, MNS', VES', QIL)) . eq setUpModExpDeps((par X :: par(ME, parList(par Y :: ME', PL))), MN, db(< ME' ; U ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = setUpModExpDeps((par X :: par(ME, PL)), MN, db((< ME' ; U ; U' ; U'' ; U''' ; VDS ; MNS . MN ; VES > IS), MNS', VES', QIL)) . eq setUpModExpDeps((par X :: par(ME, parList(par Y :: ME', PL))), MN, DB) = setUpModExpDeps((par X :: par(ME, PL)), MN, warning(DB, ('\r 'Error: '\o 'Module modNameToQidList(ME') 'not 'in 'database. '\n))) [owise] . eq setUpModExpDeps((par X :: par(ME, nilParList)), MN, db((< ME ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = db(< ME ; DT ; U ; U' ; U'' ; VDS ; MNS . MN ; VES > IS, MNS', VES', QIL) . eq setUpModExpDeps((par X :: par(ME, nilParList)), MN, db((< ME ; U ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = db((< ME ; U ; U' ; U'' ; U''' ; VDS ; MNS . MN ; VES > IS), MNS', VES', QIL) . eq setUpModExpDeps((par X :: par(ME, nilParList)), MN, DB) = warning(DB, ('\r 'Error: '\o 'Module modNameToQidList(ME) 'not 'in 'database. '\n)) [owise] . eq setUpImportDeps(MN, ((including MN' .) EIL), db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = setUpImportDeps(MN, EIL, db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS . MN ; VES > IS), MNS', VES', QIL)) . eq setUpImportDeps(MN, ((including MN' .) EIL), db(< MN' ; U ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = setUpImportDeps(MN, EIL, db((< MN' ; U ; U' ; U'' ; U''' ; VDS ; MNS . MN ; VES > IS), MNS', VES', QIL)) . eq setUpImportDeps(MN, ((including MN' .) EIL), DB) = if MN' inModNameSet builtIns then setUpImportDeps(MN, EIL, DB) else warning(DB, '\r 'Error: '\o 'Module modNameToQidList(MN') 'not 'in 'database. '\n) fi [owise] . eq setUpImportDeps(MN, ((extending MN' .) EIL), db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = setUpImportDeps(MN, EIL, db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS . MN ; VES > IS), MNS', VES', QIL)) . eq setUpImportDeps(MN, ((extending MN' .) EIL), db(< MN' ; U ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = setUpImportDeps(MN, EIL, db((< MN' ; U ; U' ; U'' ; U''' ; VDS ; MNS . MN ; VES > IS), MNS', VES', QIL)) . eq setUpImportDeps(MN, ((extending MN' .) EIL), DB) = if MN' inModNameSet builtIns then setUpImportDeps(MN, EIL, DB) else warning(DB, '\r 'Error: '\o 'Module modNameToQidList(MN') 'not 'in 'database. '\n) fi [owise] . eq setUpImportDeps(MN, ((protecting MN' .) EIL), db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = setUpImportDeps(MN, EIL, db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS . MN ; VES > IS), MNS', VES', QIL)) . eq setUpImportDeps(MN, ((protecting MN' .) EIL), db(< MN' ; U ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = setUpImportDeps(MN, EIL, db((< MN' ; U ; U' ; U'' ; U''' ; VDS ; MNS . MN ; VES > IS), MNS', VES', QIL)) . eq setUpImportDeps(MN, ((protecting MN' .) EIL), DB) = if MN' inModNameSet builtIns then setUpImportDeps(MN, EIL, DB) else warning(DB, '\r 'Error: '\o 'Module modNameToQidList(MN') 'not 'in 'database. '\n) fi [owise] . eq setUpImportDeps(MN, nil, DB) = DB . op setUpViewDeps : ModExp ViewExp Database -> Database . op setUpViewExpDeps : ViewExp Database -> Database . op setUpViewExpDeps : ViewExp ViewExp Database -> Database . eq setUpViewDeps(ME, VE, db(< ME ; DT ; U ; U' ; U'' ; VDS ; MNS' ; VES > IS, MNS'', VES', QIL)) = db(< ME ; DT ; U ; U' ; U'' ; VDS ; MNS' ; VES # VE > IS, MNS'', VES', QIL) . eq setUpViewDeps(ME, VE, db(< ME ; U ; U' ; U'' ; U''' ; VDS ; MNS' ; VES > IS, MNS'', VES', QIL)) = db(< ME ; U ; U' ; U'' ; U''' ; VDS ; MNS' ; VES # VE > IS, MNS'', VES', QIL) . eq setUpViewDeps(ME, VE, DB) = if ME inModNameSet builtIns then DB else warning(DB, '\r 'Error: '\o 'Module modNameToQidList(ME) 'not 'in 'database. '\n) fi [owise] . eq setUpViewExpDeps(QI, DB) = DB . eq setUpViewExpDeps(QI << VE >>, DB) = setUpViewExpDeps(QI << VE >>, VE, DB) . *** eq setUpViewExpDeps(QI { VE }, DB) *** = setUpViewExpDeps(QI { VE }, VE, DB) . *** _;;_ eq setUpViewExpDeps(VE, QI | VE', db(< QI ; DT ; VI ; MNS ; VES > IS, MNS', VES', QIL)) = setUpViewExpDeps(VE, VE', db(< QI ; DT ; VI ; MNS ; VE # VES > IS, MNS', VES', QIL)) . eq setUpViewExpDeps(VE, QI | VE', db(< QI ; VI ; VI' ; MNS ; VES > IS, MNS', VES', QIL)) = setUpViewExpDeps(VE, VE', db(< QI ; VI ; VI' ; MNS ; VE # VES > IS, MNS', VES', QIL)) . eq setUpViewExpDeps(VE, QI | VE', DB) = setUpViewExpDeps(VE, VE', DB) [owise] . eq setUpViewExpDeps(VE, ((QI << VE' >>) | VE''), db(< QI << VE' >> ; DT ; VI ; MNS ; VES > IS, MNS', VES', QIL)) = setUpViewExpDeps(VE, VE'', db(< QI << VE' >> ; DT ; VI ; MNS ; VE # VES > IS, MNS', VES', QIL)) . eq setUpViewExpDeps(VE, ((QI << VE' >>) | VE''), db(< QI << VE' >> ; VI ; VI' ; MNS ; VES > IS, MNS', VES', QIL)) = setUpViewExpDeps(VE, VE'', db(< QI << VE' >> ; VI ; VI' ; MNS ; VE # VES > IS, MNS', VES', QIL)) . eq setUpViewExpDeps(VE, ((QI << VE' >>) | VE''), DB) = setUpViewExpDeps(VE, VE'', DB) [owise] . eq setUpViewExpDeps(VE, nullViewExp, DB) = DB . op compiledUnit : ModName Database -> Bool . op compiledView : ViewExp Database -> Bool . eq compiledView(VE, db(< VE ; DT ; VI ; MNS ; VES > IS, MNS', VES', QIL)) = VI =/= noView . eq compiledView(MN, DB) = false [owise] . eq compiledUnit(MN, db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = U'' =/= noUnit . eq compiledUnit(MN, db(< MN ; U ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = U''' =/= noUnit . eq compiledUnit(MN, DB) = false [owise] . op insertTermView : ViewExp Term Database -> Database . op insertView : View Database -> Database . op getTermView : ViewExp Database -> Default`(Term`) . op getView : ViewExp Database -> [View] . eq insertTermView(VE, T, db(< VE ; DT ; VI ; MNS ; VES > IS, MNS', VES',QIL)) = delViews(VES, delUnits(MNS, db(< VE ; T ; noView ; noneModNameSet ; noneViewExpSet > IS, MNS', VES', QIL '\g 'Advisory: '\o 'View viewExpToQidList(VE) 'redefined. '\n))) . eq insertTermView(VE, T, db(IS, MNS, VES, QIL)) = db(< VE ; T ; noView ; noneModNameSet ; noneViewExpSet > IS, MNS, (VE # VES), QIL) [owise] . eq insertView(view(VE, PL, ME, ME', VMAPS), db((< VE ; DT ; VI ; MNS ; VES > IS), MNS', VES', QIL)) = setUpViewExpDeps(VE, setUpViewDeps(ME, VE, setUpViewDeps(ME', VE, db(< VE ; DT ; view(VE, PL, ME, ME', VMAPS) ; MNS ; VES > IS, MNS', VES', QIL)))) . eq insertView(view(VE, PL, ME, ME', VMAPS), db(IS, MNS, VES, QIL)) = setUpViewExpDeps(VE, setUpViewDeps(ME, VE, setUpViewDeps(ME', VE, db((< VE ; noTerm ; view(VE, PL, ME, ME', VMAPS) ; noneModNameSet ; noneViewExpSet > IS), MNS, (VE # VES), QIL)))) [owise] . eq insertView(error(QIL), DB) = warning(DB, QIL) . eq getTermView(VE, db((< VE ; DT ; VI ; MNS ; VES > IS), MNS', VES', QIL)) = DT . eq getTermView(VE, db(IS, MNS, VES, QIL)) = error('\r 'Error: '\o 'View viewExpToQidList(VE) 'not 'in 'database. '\n) [owise] . eq getView(VE, db(< VE ; DT ; VI ; MNS ; VES > IS, MNS', VES', QIL)) = VI . eq getView(VE, db(< VE ; VI ; VI' ; MNS ; VES > IS, MNS', VES', QIL)) = VI' . eq getView(VE, db(IS, MNS, VES, QIL)) = error('\r 'Error: '\o 'View viewExpToQidList(VE) 'not 'in 'database. '\n) [owise] . *** There are functions to insert the different versions of a unit, and to *** extract them. We only give here the equations for the insertion of top *** units to illustrate the way in which the consistency of the database is *** maintained. We assume that when the internal version, the signature, or *** the flat version of a module is entered in the database, its corresponding *** top module is already present in it. sort TermUnit . op <_;_> : Default`(Term`) Unit -> TermUnit . op error : QidList -> [TermUnit] . op insertTermUnit : Qid Unit Database -> Database . op insertTermUnit : Qid Term Database -> Database . op insertTopUnit : ModName [Unit] Database -> Database . op insertInternalUnit : ModName [Unit] Database -> Database . op insertFlatUnit : ModName [Unit] Database -> Database . op insertVbles : ModName [OpDeclSet] Database -> Database . op getTermUnit : ModName Database -> [TermUnit] . op getTopUnit : ModName Database -> [Unit] . op getInternalUnit : ModName Database -> [Unit] . op getFlatUnit : ModName Database -> [Unit] . op getFlatUnitNeg : ModName Database -> [Unit] . op getVbles : ModName Database -> [OpDeclSet] . eq insertTermUnit(MN, T, db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = delUnits(MNS, delViews(VES, db(< MN ; T ; noUnit ; noUnit ; noUnit ; none ; noneModNameSet ; noneViewExpSet > IS, MNS', VES', QIL '\g 'Advisory: '\o 'Module modNameToQidList(MN) 'redefined. '\n))). eq insertTermUnit(MN, T, db(< MN ; U ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = delUnits(MNS, delViews(VES, db(< MN ; T ; noUnit ; noUnit ; noUnit ; none ; noneModNameSet ; noneViewExpSet > IS, MNS', VES', QIL '\g 'Advisory: '\o 'Module modNameToQidList(MN) 'redefined. '\n))). eq insertTermUnit(MN, T, db(IS, MNS, VES, QIL)) = db(< MN ; T ; noUnit ; noUnit ; noUnit ; none ; noneModNameSet ; noneViewExpSet > IS, MN . MNS, VES, QIL) [owise] . eq insertTermUnit(MN, (error(QIL)).Default`(Term`), DB) = warning(DB, QIL) . eq insertTermUnit(MN, (error(QIL)).[Unit], DB) = warning(DB, QIL) . eq insertTermUnit(MN, U, db(< MN ; DT ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = delUnits(MNS, delViews(VES, db(< MN ; U ; noUnit ; noUnit ; noUnit ; none ; noneModNameSet ; noneViewExpSet > IS, MNS', VES', QIL '\g 'Advisory: '\o 'Module modNameToQidList(MN) 'redefined. '\n))). eq insertTermUnit(MN, U, db(< MN ; U' ; U'' ; U''' ; U'''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = delUnits(MNS, delViews(VES, db(< MN ; U ; noUnit ; noUnit ; noUnit ; none ; noneModNameSet ; noneViewExpSet > IS, MNS', VES', QIL '\g 'Advisory: '\o 'Module modNameToQidList(MN) 'redefined. '\n))). eq insertTermUnit(MN, U, db(IS, MNS, VES, QIL)) = db(< MN ; U ; noUnit ; noUnit ; noUnit ; none ; noneModNameSet ; noneViewExpSet > IS, MN . MNS, VES, QIL) [owise] . eq insertTopUnit(MN, U, db(< MN ; noTerm ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = db(< MN ; noTerm ; U ; noUnit ; noUnit ; VDS ; MNS ; VES > IS, MNS', VES', QIL '\r 'ERROR: '\o 'Internally 'generated 'module modNameToQidList(MN) 'redefined. '\n) . eq insertTopUnit(MN, U, db(< MN ; T ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = setUpUnitDeps(U, db(< MN ; T ; U ; noUnit ; noUnit ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) . eq insertTopUnit(MN, U, db(< MN ; U' ; U'' ; U''' ; U'''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = setUpUnitDeps(U, db(< MN ; U' ; U ; noUnit ; noUnit ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) . eq insertTopUnit(MN, U, db(IS, MNS, VES, QIL)) = setUpUnitDeps(U, db(< MN ; noTerm ; U ; noUnit ; noUnit ; none ; noneModNameSet ; noneViewExpSet > IS, MN . MNS, VES, QIL)) [owise] . eq insertTopUnit(MN, error(QIL), DB) = warning(DB, QIL) . eq insertInternalUnit(MN, U, db(< MN ; DT ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = db(< MN ; DT ; U' ; U ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL) . eq insertInternalUnit(MN, U, db(< MN ; U' ; U'' ; U''' ; U'''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = db(< MN ; U' ; U'' ; U ; U'''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL) . eq insertInternalUnit(MN, error(QIL), DB) = warning(DB, QIL) . eq insertFlatUnit(MN, U''', db((< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = db((< MN ; DT ; U ; U' ; U''' ; VDS ; MNS ; VES > IS), MNS', VES', QIL) . eq insertFlatUnit(MN, U'''', db(< MN ; U ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = db((< MN ; U ; U' ; U'' ; U'''' ; VDS ; MNS ; VES > IS), MNS', VES', QIL). eq insertFlatUnit(MN, error(QIL), DB) = warning(DB, QIL) . eq insertVbles(MN, VDS, db((< MN ; DT ; U ; U' ; U'' ; VDS' ; MNS ; VES > IS), MNS', VES', QIL)) = db((< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > IS), MNS', VES', QIL) . eq insertVbles(MN, VDS, db(< MN ; U ; U' ; U'' ; U''' ; VDS' ; MNS ; VES > IS, MNS', VES', QIL)) = db(< MN ; U ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL) . eq insertVbles(MN, error(QIL), DB) = warning(DB, QIL) . eq getTermUnit(MN, db(< MN ; noTerm ; U ; U' ; U'' ; VDS ; MNS ; VES > IS, MNS', VES',QIL)) = error('\r 'Error: '\o modNameToQidList(MN) 'is 'an 'internal 'module. '\n) . eq getTermUnit(MN, db((< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = < DT ; noUnit > . eq getTermUnit(MN, db(< MN ; U ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = < noTerm ; U > . eq getTermUnit(MN, DB) = error('\r 'Error: '\o 'Module modNameToQidList(MN) 'not 'in 'database. '\n) [owise] . eq getTopUnit(MN, db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = U . eq getTopUnit(MN, db(< MN ; U ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = U' . eq getTopUnit(MN, DB) = error('\r 'Error: '\o 'Module modNameToQidList(MN) 'not 'in 'database. '\n) [owise] . eq getInternalUnit(MN, db((< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = U' . eq getInternalUnit(MN, db(< MN ; U ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = U'' . eq getInternalUnit(MN, db(IS, MNS, VES, QIL)) = error('\r 'Error: '\o 'Module modNameToQidList(MN) 'not 'in 'database. '\n) [owise] . *** The name of the signature and the flattened module is not the *** module expression used as the name of the module but the result of *** converting it into a quoted identifier. eq getFlatUnit(MN, db((< MN ; DT ; U ; U' ; M ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = remNegAnns(M) . eq getFlatUnit(MN, db((< MN ; U ; U' ; U'' ; M ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = remNegAnns(M) . eq getFlatUnit(MN, db(< MN ; DT ; U ; U' ; noUnit ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = error('\r 'Error: '\o 'Module modNameToQidList(MN) 'not 'compiled. '\n) . eq getFlatUnit(MN, db(< MN ; U ; U' ; U'' ; noUnit ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = error('\r 'Error: '\o 'Module modNameToQidList(MN) 'not 'compiled. '\n) . eq getFlatUnit(MN, DB) = error('\r 'Error: '\o 'Module modNameToQidList(MN) 'not 'in 'database. '\n) [owise] . eq getVbles(MN, db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = VDS . eq getVbles(MN, db(< MN ; U ; U' ; U'' ; U''' ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = VDS . eq getVbles(MN, DB) = error('\r 'Error: '\o 'Module modNameToQidList(MN) 'not 'in 'database. '\n) [owise] . eq getFlatUnitNeg(MN, db((< MN ; DT ; U ; U' ; M ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = M . eq getFlatUnitNeg(MN, db((< MN ; U ; U' ; U'' ; M ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = M . eq getFlatUnitNeg(MN, db(< MN ; DT ; U ; U' ; noUnit ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = error('\r 'Error: '\o 'Module modNameToQidList(MN) 'not 'compiled. '\n) . eq getFlatUnitNeg(MN, db(< MN ; U ; U' ; U'' ; noUnit ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = error('\r 'Error: '\o 'Module modNameToQidList(MN) 'not 'compiled. '\n) . eq getFlatUnitNeg(MN, DB) = error('\r 'Error: '\o 'Module modNameToQidList(MN) 'not 'in 'database. '\n) [owise] . *** removeNegAnnotations op remNegAnns : Module -> Module . op remNegAnns : OpDeclSet -> OpDeclSet . op remNegAnns : AttrSet -> AttrSet . op remNegAnns : IntList -> IntList . eq remNegAnns(M) = setOps(M, remNegAnns(getOps(M))) . eq remNegAnns(op F : TPL -> TP [AtS] . OPDS) = op F : TPL -> TP [remNegAnns(AtS)] . remNegAnns(OPDS) . eq remNegAnns((none).OpDeclSet) = (none).OpDeclSet . ceq remNegAnns(strat(NL) AtS) = AtS if not NL :: NatList . eq remNegAnns(AtS) = AtS [owise] . endfm ******************************************************************************* *** *** The Evaluation of Units *** *** The general principle for the evaluation of units in our design consists in *** first evaluating any module expression, reducing it to a canonical form in *** which only unit inclusions appear, that is, to a unit hierarchy, which can *** be seen as a partial order of unit inclusions. The design of the Full Maude *** system has been based upon the principle of evaluating all module *** expressions to irreducible structured units, and on using the flat version *** of the units only for execution purposes. We have then two different *** processes clearly distinguished: a first step in which the structured unit *** is evaluated and reduced to its normal form, and a second step in which *** this normal form is flattened. *** As explained in Section~\ref{execution-environment}, the process of *** evaluation to normal form is also responsible for the parsing of the *** bubbles in the premodules, which is accomplished once the signature has *** been built. The parsing of bubbles is discussed in *** Section~\ref{bubble-parsing}. To be able to handle the \texttt{up} *** function and the \texttt{down} command presented in *** Section~\ref{structured-specifications}, it is necessary to be able to *** move terms and modules from one level of reflection to another. The *** functionality to move between levels is presented in *** Section~\ref{changing-levels}, where functions \texttt{up} and *** \texttt{down} on sorts \texttt{Module} and \texttt{Term} are defined. The *** transformation of object-oriented modules into system modules in discussed *** in Section~\ref{omod2modfunction}. The evaluation of module expressions is *** discussed in Sections~\ref{evalModExp}, \ref{application-of-maps}, *** \ref{instantiation}, and~\ref{renaming}. *** *** Changing Levels *** *** Moving terms of sorts \texttt{Term} and \texttt{Module} from one *** level of reflection to another is possible thanks to the *** \texttt{up} and \texttt{down} functions, which are defined, *** respectively, in the following modules \texttt{MOVE-UP} and *** \texttt{MOVE-DOWN}. *** *** The \texttt{up} Function *** *** Given a term of sort \texttt{Module} or \texttt{Term}, the *** \texttt{up} function, defined in the following module *** \texttt{MOVE-UP}, returns the term metarepresenting it. The *** function is also defined on the different components of a *** unit. The \texttt{up} function on units is defined recursively by *** applying it to the different components of a unit. *** The semantics of the \texttt{up} functions can be inferred from *** the following example. The result of applying the \texttt{up} *** function to the metarepresentation of the flat form of the module *** \texttt{NAT3} presented in Section~\ref{evaluation-overview} is *** the following. *** *** red up(fmod 'NAT3 is *** nil *** sorts 'Nat3 . *** none *** op 'zero : nil -> 'Nat3 [none] . *** op 'suc : 'Nat3 -> 'Nat3 [none] . *** none *** none *** eq 'suc['suc['suc[{'zero}'Nat3]]] *** = {'zero}'Nat3 . *** endfm) . *** *** result Term: *** 'fmod_is_______endfm[ *** {''NAT3}'Qid, *** {'nil}'ImportList, *** 'sorts_.[{''Nat3}'Qid], *** {'none}'SubsortDeclSet, *** '__['op_:_->_`[_`].[{''zero}'Qid, {'nil}'QidList, {''Nat3}'Qid, *** {'none}'AttrSet], *** 'op_:_->_`[_`].[{''suc}'Qid, {''Nat3}'Qid, {''Nat3}'Qid, *** {'none}'AttrSet]], *** {'none}'VarDeclSet, *** {'none}'MembAxSet, *** 'eq_=_.['_`[_`][{''suc}'Qid, *** '_`[_`][{''suc}'Qid, *** '_`[_`][{''suc}'Qid, *** '`{_`}_[{''zero}'Qid, {''Nat3}'Qid]]]], *** '`{_`}_[{''zero}'Qid, {''Nat3}'Qid]]] *** We shall see in Section~\ref{bubble-parsing} how the \texttt{up} function *** is used to evaluate the homonymous function discussed in *** Section~\ref{structured-specifications}. In Section~\ref{instantiation} we *** shall discuss how the \texttt{up} function is used to evaluate the *** \texttt{META-LEVEL} module expression (see *** Section~\ref{structured-specifications}). fmod MOVE-UP is pr UNIT . pr CONVERSION . *** op up : Unit -> Term . op up : Module -> Term . op up : Term -> Term [memo] . op up : Qid -> Term [memo] . op up : TypeList -> Term [memo] . op up : SortSet -> Term [memo] . op up : ImportList -> Term . op up : SubsortDeclSet -> Term . op up : OpDeclSet -> Term . op up : Condition -> Term . op up : MembAxSet -> Term . op up : EquationSet -> Term . op up : RuleSet -> Term . op up : AttrSet -> Term . op up : Attr -> Term . op up : TermList -> Term [memo] . op up : HookList -> Term . op up : NatList -> Term . op up : String -> Term . var V : Variable . var C : Constant . vars QI QI' QI'' F L : Qid . var QIL : QidList . var S : Sort . vars SS SS' : SortSet . var TP : Type . var TPL : TypeList . var IL : ImportList . var SSDS : SubsortDeclSet . var OPDS : OpDeclSet . var MAS : MembAxSet . var EqS : EquationSet . var RlS : RuleSet . var At : Attr . var AtS : AttrSet . vars T T' T'' T''' : Term . var TL : TermList . var H : Hook . var HL : HookList . var I : Nat . var NL : NatList . vars CD CD' : Condition . var EQCD : EqCondition . var St : String . eq up(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm) = 'fmod_is_sorts_.____endfm[ up(QI), up(IL), up(SS), up(SSDS), up(OPDS), up(MAS), up(EqS)] . eq up(mod QI is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = 'mod_is_sorts_._____endm[up(QI), up(IL), up(SS), up(SSDS), up(OPDS), up(MAS), up(EqS), up(RlS)] . ceq up(((including QI .) IL)) = '__['including_.[up(QI)], up(IL)] if IL =/= nil . ceq up(((extending QI .) IL)) = '__['extending_.[up(QI)], up(IL)] if IL =/= nil . ceq up(((protecting QI .) IL)) = '__['protecting_.[up(QI)], up(IL)] if IL =/= nil . eq up((including QI .)) = 'including_.[up(QI)] . eq up((extending QI .)) = 'extending_.[up(QI)] . eq up((protecting QI .)) = 'protecting_.[up(QI)] . eq up((nil).ImportList) = 'nil.ImportList . ceq up(((subsort SS < SS' .) SSDS)) = '__['subsort_<_.[up(SS), up(SS')], up(SSDS)] if SSDS =/= none . eq up((subsort SS < SS' .)) = 'subsort_<_.[up(SS), up(SS')] . eq up((none).SubsortDeclSet) = 'none.SubsortDeclSet . ceq up(((op F : TPL -> TP [AtS] .) OPDS)) = '__['op_:_->_`[_`].[up(F), up(TPL), up(TP), up(AtS)], up(OPDS)] if OPDS =/= none . eq up((op F : TPL -> TP [AtS] .)) = 'op_:_->_`[_`].[up(F), up(TPL), up(TP), up(AtS)] . eq up((none).OpDeclSet) = 'none.OpDeclSet . ceq up((At AtS)) = '__[up(At), up(AtS)] if AtS =/= none . eq up((none).AttrSet) = 'none.AttrSet . eq up(assoc) = 'assoc.Attr . eq up(comm) = 'comm.Attr . eq up(idem) = 'idem.Attr . eq up(id(T)) = 'id[up(T)] . eq up(left-id(T)) = 'left-id[up(T)] . eq up(right-id(T)) = 'right-id[up(T)] . eq up(strat(NL)) = 'strat[up(NL)] . eq up(memo) = 'memo.Attr . eq up(prec(I)) = 'prec[up(I)] . eq up(gather(QIL)) = 'gather[up(QIL)] . eq up(format(QIL)) = 'format[up(QIL)] . eq up(ctor) = 'ctor.Attr . eq up(frozen(NL)) = 'frozen[up(NL)] . eq up(iter) = 'iter.Attr . eq up(special(HL)) = 'special[up(HL)] . eq up(label(QI)) = 'label[up(QI)] . eq up(metadata(St)) = 'metadata[up(St)] . eq up(nonexec) = 'nonexec.Attr . eq up(owise) = 'owise.Attr . eq up((H HL)) = '__[up(H), up(HL)] . eq up(id-hook(QI, QIL)) = 'id-hook[up(QI), up(QIL)] . eq up(op-hook(QI, QI', QIL, QI'')) = 'op-hook[up(QI), up(QI'), up(QIL), up(QI'')] . eq up(term-hook(QI, T)) = 'term-hook[up(QI), up(T)] . eq up(C) = qid("'" + string(C) + ".Constant") . eq up(V) = qid("'" + string(V) + ".Variable") . ceq up(QI) = qid("'" + string(QI) + ".Qid") if not (QI :: Constant or QI :: Variable) . eq up(F[TL]) = '_`[_`][up(F), up(TL)] . eq up((T, TL)) = '_`,_[up(T), up(TL)] . eq up(St) = qid("\"" + St + "\"") . ceq up(CD /\ CD') = '_/\_[up(CD), up(CD')] if CD =/= nil /\ CD' =/= nil . eq up(T = T') = '_=_[up(T), up(T')] . eq up(T : S) = '_:_[up(T), up(S)] . eq up(T := T') = '_:=_[up(T), up(T')] . eq up(T => T') = '_=>_[up(T), up(T')] . ceq up(((mb T : S [AtS] .) MAS)) = '__['mb_:_`[_`].[up(T), up(S), up(AtS)], up(MAS)] if MAS =/= none . ceq up(((cmb T : S if EQCD [AtS] .) MAS)) = '__['cmb_:_if_`[_`].[up(T), up(S), up(EQCD), up(AtS)], up(MAS)] if MAS =/= none . eq up((mb T : S [AtS] .)) = 'mb_:_`[_`].[up(T), up(S), up(AtS)] . eq up((cmb T : S if EQCD [AtS] .)) = 'cmb_:_if_`[_`].[up(T), up(S), up(EQCD), up(AtS)] . eq up((none).MembAxSet) = 'none.MembAxSet . ceq up(((eq T = T' [AtS] .) EqS)) = '__['eq_=_`[_`].[up(T), up(T'), up(AtS)], up(EqS)] if EqS =/= none . ceq up(((ceq T = T' if EQCD [AtS] .) EqS)) = '__['ceq_=_if_`[_`].[up(T), up(T'), up(EQCD), up(AtS)], up(EqS)] if EqS =/= none . eq up((eq T = T' [AtS] .)) = 'eq_=_`[_`].[up(T), up(T'), up(AtS)] . eq up((ceq T = T' if EQCD [AtS] .)) = 'ceq_=_if_`[_`].[up(T), up(T'), up(EQCD), up(AtS)] . eq up((none).EquationSet) = 'none.EquationSet . ceq up(((rl T => T' [AtS] .) RlS)) = '__['rl_=>_`[_`].[up(T), up(T'), up(AtS)], up(RlS)] if RlS =/= none . ceq up(((crl T => T' if CD [AtS] .) RlS)) = '__['crl_=>_if_`[_`].[up(T), up(T'), up(CD), up(AtS)], up(RlS)] if RlS =/= none . eq up((rl T => T' [AtS] .)) = 'rl_=>_`[_`].[up(T), up(T'), up(AtS)] . eq up((crl T => T' if CD [AtS] .)) = 'crl_=>_if_`[_`].[up(T), up(T'), up(CD), up(AtS)] . eq up((none).RuleSet) = 'none.RuleSet . ceq up((S ; SS)) = '_;_[up(S), up(SS)] if SS =/= none . eq up((none).SortSet) = 'none.SortSet . ceq up((TP TPL)) = '__[up(TP), up(TPL)] if TPL =/= nil . eq up((nil).TypeList) = 'nil.TypeList . eq up(I) = qid("s_^" + string(I, 10)) [ '0.Nat ] . eq up((I NL)) = '__[up(I), up(NL)] . endfm ******************************************************************************* *** *** The \texttt{down} Function *** *** Given a term of sort \texttt{Term} metarepresenting a term of sort *** \texttt{Term} or \texttt{Module}, the \texttt{down} function can be seen *** as the inverse of the \texttt{up} function discussed in the previous *** section, that is, it returns the original term that had been *** metarepresented. There are also \texttt{down} functions for terms *** metarepresenting terms in other sorts. We present here only some of them. *** We assume that the \texttt{down} functions are called with valid *** metarepresentations. In fact, these functions should be declared as *** partial functions going to error sorts when their arguments are invalid. *** The main application of the \texttt{down} functions is in the evaluation *** of the \texttt{down} command (see *** Section~\ref{structured-specifications}). However, they are also used in *** other tasks, as for example in the parsing of some inputs. fmod MOVE-DOWN is pr UNIT . pr CONVERSION . pr INT-LIST . op downTerm : Term -> [Term] . op downModule : Term -> [Module] . op downQid : Term -> [Qid] . op downQidList : Term -> [QidList] . op downTypes : Term -> [TypeList] . op downSorts : Term -> [SortSet] . op downSort : Term -> [Sort] . op downModName : Constant -> [ModName] . op downNat : Term -> [Int] . op downString : Term -> [String] . op downResultPair : Module ResultPair -> [ResultPair] . op downTerm : TermList -> [Term] . op downImports : TermList -> [ImportList] . op downSubsorts : TermList -> [SubsortDeclSet] . op downOps : TermList -> [OpDeclSet] . op downEqCond : TermList -> [EqCondition] . op downCond : TermList -> [Condition] . op downMbs : TermList -> [MembAxSet] . op downEqs : TermList -> [EquationSet] . op downRls : TermList -> [RuleSet] . op downAttrs : TermList -> [AttrSet] . op downAttr : Term -> [Attr] . op downHooks : TermList -> [HookList] . op downMetaNat : Term -> [Term] . op downNat : TermList -> [IntList] . vars T T' T'' T''' T1 T2 T3 T4 T5 T6 T7 T8 T9 : Term . vars TL TL' : TermList . vars QI QI' F V L : Qid . var Ct : Constant . var M : Module . var Tp : Type . eq downResultPair(M, {T, Tp}) = metaReduce(M, downTerm(T)) . eq downModule('fmod_is_sorts_.____endfm[T1, T2, T3, T4, T5, T6, T7]) = (fmod downModName(T1) is downImports(T2) sorts downSorts(T3) . downSubsorts(T4) downOps(T5) downMbs(T6) downEqs(T7) endfm) . eq downModule('mod_is_sorts_._____endm[T1, T2, T3, T4, T5, T6, T7, T8]) = (mod downModName(T1) is downImports(T2) sorts downSorts(T3) . downSubsorts(T4) downOps(T5) downMbs(T6) downEqs(T7) downRls(T8) endm) . eq downModName(Ct) = downQid(Ct) . eq downImports('nil.ImportList) = nil . eq downImports('__[TL]) = downImports(TL) . eq downImports((TL, TL')) = (downImports(TL) downImports(TL')) . eq downImports('including_.[T]) = (including downModName(T) .) . eq downImports('extending_.[T]) = (extending downModName(T) .) . eq downImports('protecting_.[T]) = (protecting downModName(T) .) . eq downSubsorts('none.SubsortDeclSet) = none . eq downSubsorts('__[TL]) = downSubsorts(TL) . eq downSubsorts((TL, TL')) = (downSubsorts(TL) downSubsorts(TL')) . eq downSubsorts('subsort_<_.[T, T']) = (subsort downQid(T) < downQid(T') .) . eq downOps('none.OpDeclSet) = none . eq downOps('__[TL]) = downOps(TL) . eq downOps((TL, TL')) = (downOps(TL) downOps(TL')) . eq downOps('op_:_->_`[_`].[Ct, T, T', T'']) = (op downQid(Ct) : downTypes(T) -> downQid(T') [downAttrs(T'')] .) . eq downAttrs('none.AttrSet) = none . eq downAttrs('__[TL]) = downAttrs(TL) . eq downAttrs((TL, TL')) = (downAttr(TL) downAttrs(TL')) . ceq downAttrs(T) = downAttr(T) if T =/= 'none.AttrSet . eq downAttr('assoc.Attr) = assoc . eq downAttr('comm.Attr) = comm . eq downAttr('idem.Attr) = idem . eq downAttr('id[T]) = id(downTerm(T)) . eq downAttr('left-id[T]) = left-id(downTerm(T)) . eq downAttr('right-id[T]) = right-id(downTerm(T)) . eq downAttr('strat[T]) = strat(downNat(T)) . eq downAttr('memo.Attr) = memo . eq downAttr('prec[T]) = prec(downNat(T)) . eq downAttr('gather[T]) = gather(downQidList(T)) . eq downAttr('ctor.Attr) = ctor . eq downAttr('special[T]) = special(downHooks(T)) . eq downAttr('iter.Attr) = iter . eq downAttr('frozen[T]) = frozen(downNat(T)) . eq downHooks('__[TL]) = downHooks(TL) . eq downHooks((TL, TL')) = downHooks(TL) downHooks(TL') . eq downHooks('id-hook[T, T']) = id-hook(downQid(T), downQidList(T')) . eq downHooks('op-hook[T, T', T'', T''']) = op-hook(downQid(T), downQid(T'), downQidList(T''), downQid(T''')) . eq downHooks('term-hook[T, T']) = term-hook(downQid(T), downTerm(T')) . eq downTerm(QI) = downQid(QI) . eq downTerm('_`[_`][T, T']) = downQid(T)[downTerm(T')] . eq downTerm('_`,_[T, TL]) = (downTerm(T), downTerm(TL)) . eq downTerm((T, TL)) = (downTerm(T), downTerm(TL)) . eq downTerm(F[TL]) = error('\r 'Error: '\o 'Incorrect 'term. '\n) [owise] . eq downEqCond('_/\_[TL]) = downEqCond(TL) . eq downEqCond((TL, TL')) = downEqCond(TL) /\ downEqCond(TL') . eq downEqCond('_=_[T, T']) = downTerm(T) = downTerm(T') . eq downEqCond('_:_[T, T']) = downTerm(T) : downSort(T') . eq downEqCond('_:=_[T, T']) = downTerm(T) := downTerm(T') . eq downCond('_/\_[TL]) = downCond(TL) . eq downCond((TL, TL')) = downCond(TL) /\ downCond(TL') . eq downCond('_=_[T, T']) = downEqCond('_=_[T, T']) . eq downCond('_:_[T, T']) = downEqCond('_:_[T, T']) . eq downCond('_:=_[T, T']) = downEqCond('_:=_[T, T']) . eq downCond('_=>_[T, T']) = downTerm(T) => downTerm(T') . eq downMbs('none.MembAxSet) = none . eq downMbs('__[TL]) = downMbs(TL) . eq downMbs((TL, TL')) = (downMbs(TL) downMbs(TL')) . eq downMbs('mb_:_`[_`].[T, T', T'']) = (mb downTerm(T) : downSort(T') [downAttrs(T'')] .) . eq downMbs('cmb_:_if_`[_`].[T, T', T'', T''']) = (cmb downTerm(T) : downSort(T') if downEqCond(T'') [downAttrs(T''')] .) . eq downEqs('none.EquationSet) = none . eq downEqs('__[TL]) = downEqs(TL) . eq downEqs((TL, TL')) = (downEqs(TL) downEqs(TL')) . eq downEqs('eq_=_`[_`].[T, T', T'']) = (eq downTerm(T) = downTerm(T') [downAttrs(T'')] .) . eq downEqs('ceq_=_if_`[_`].[T, T', T'', T''']) = (ceq downTerm(T) = downTerm(T') if downEqCond(T'') [downAttrs(T''')] .) . eq downRls('none.RuleSet) = none . eq downRls('__[TL]) = downRls(TL) . eq downRls((TL, TL')) = (downRls(TL) downRls(TL')) . eq downRls('rl_=>_`[_`].[T, T', T'']) = (rl downTerm(T) => downTerm(T') [downAttrs(T'')] .) . eq downRls('crl_=>_if_`[_`].[T, T', T'', T''']) = (crl downTerm(T) => downTerm(T') if downCond(T'') [downAttrs(T''')] .) . eq downSorts('none.SortSet) = none . eq downSorts('_;_[TL]) = downSorts(TL) . eq downSorts((TL, TL')) = (downSorts(TL) ; downSorts(TL')) . eq downSorts(QI) = downSort(QI) . eq downSort(Ct) = downQid(Ct) . eq downTypes('nil.QidList) = nil . eq downTypes('__[TL]) = downTypes(TL) . eq downTypes((TL, TL')) = (downTypes(TL) downTypes(TL')) . eq downTypes(QI) = downSort(QI) . eq downQidList('nil.QidList) = nil . eq downQidList('__[TL]) = downQidList(TL) . eq downQidList((TL, TL')) = (downQidList(TL) downQidList(TL')) . eq downQidList(QI) = downQid(QI) . eq downQid(Ct) = qid(substr(string(myGetName(Ct)), 1, length(string(myGetName(Ct))))) . eq downMetaNat(QI) = qid(substr(string(myGetName(QI)), 1, length(string(myGetName(QI)))) + ".Nat") . ceq downNat(QI) = trunc(rat(string(myGetName(QI)), 10)) if getType(QI) == 'Nat or getType(QI) == 'NzNat . ceq downNat(QI) = if substr(string(myGetName(QI)), 0 ,1) == "-" then - trunc(rat(substr(string(myGetName(QI)), 1, length(string(myGetName(QI)))), 10)) else trunc(rat(string(myGetName(QI)), 10)) fi if getType(QI) == 'Int or getType(QI) == 'NzInt . eq downString(QI) = substr(string(QI), 1, _-_(length(string(QI)), 2)) . eq downNat('__[TL]) = downNat(TL) . eq downNat((TL, TL')) = (downNat(TL) downNat(TL')) . endfm ******************************************************************************* *** *** Parsing of Bubbles *** *** As discussed in Section~\ref{implementation-introduction}, in Full Maude, *** the parsing process is split into two phases. In a first stage, the input *** is parsed using the top-level grammar for Full Maude modules, theories, *** views, and commands. Once this first stage is completed, we get a term *** with bubbles in it, which is converted into a module, theory, or view. *** This unit or view may still have the bubbles in it. We say that a module *** with bubbles is a premodule, a view with bubbles a preview, and so on. The *** second stage of the process consists in taking this preunit or preview and *** converting the bubbles in it into terms by parsing them in the appropriate *** signatures, obtaining a `valid' unit or view out of it, or otherwise a *** parsing error. In the case of commands, if they contain any bubble, the *** same will have to be done. All bubbles have to be parsed in the *** appropriate signature before any further processing can be done with the *** module, view, or command in which they appear. *** *** Parsing of Module Expressions *** *** Before introducing the \texttt{parseDecl} function, we present some *** auxiliary functions. For example, the following functions *** \texttt{parseType}, \texttt{parseSortSet}, and \texttt{parseTypeList} *** return, respectively, the sort, set of sorts, and list of sorts *** represented by the term given as argument. Note that these functions, as *** most of the functions in this module, are partial functions. We assume *** that the term given as argument is in fact the representation of, for *** example, a valid sort, or set of sorts, etc. In the case of *** \texttt{parseDecl} we assume that the term is the representation of a *** predeclaration. fmod MOD-EXP-PARSING is pr MOVE-DOWN . pr INT-LIST . vars T T' T'' T''' T'''' : Term . vars T? T?' : [Term] . var TL TL' : TermList . var QIL : QidList . var Ct : Constant . var AtS : AttrSet . vars QI F : Qid . var CD? : [Condition] . vars ES ES' : ESort . var ETL : ETypeList . op parseSort : Term ~> ESort . op parseType : Term ~> EType . op parseSortSet : Term ~> ESortSet . op parseTypeList : Term ~> ETypeList . op parseViewExp : Term ~> ViewExp . eq parseSort('sortToken[T]) = if downQid(T) :: Sort then downQid(T) else error('\r 'Warning: '\o downQid(T) 'is 'not 'a 'valid 'sort. '\n) fi . eq parseSort('_`(_`)[T, T']) = eSort(parseSort(T), parseViewExp(T')) . eq parseSort(T) = error('\r 'Warning: '\o 'invalid 'sort. '\n) [owise] . eq parseType('`[_`][T]) = kind(parseSort(T)) . eq parseType(T) = parseSort(T) [owise] . eq parseSortSet('__[T, T']) = (parseSort(T) ; parseSortSet(T')) . eq parseSortSet(T) = parseSort(T) [owise]. eq parseTypeList('__[T, T']) = (parseType(T) parseTypeList(T')) . eq parseTypeList(T) = parseType(T) [owise] . eq parseViewExp('viewToken[T]) = downQid(T) . eq parseViewExp('_|_[T, T']) = _|_(parseViewExp(T), parseViewExp(T')) . eq parseViewExp('_;_[T, T']) = _;;_(parseViewExp(T), parseViewExp(T')) . eq parseViewExp('_`(_`)[T, T']) = _<<_>>(parseViewExp(T), parseViewExp(T')) . *** eq parseViewExp('_`{_`}[T, T']) *** = _{_}(parseViewExp(T), parseViewExp(T')) . *** The function \texttt{parseModExp} takes a term representing a module *** expression and returns the corresponding term in sort \texttt{ModExp}. In *** case of adding new constructors for module expressions, as it will be *** done in Section~\ref{extension}, new equations defining the semantics of *** the function on them will have to be given. op parseModExp : Term -> ModExp . op parseMapSet : Term -> MapSet . op parseAttrSet : Term -> AttrSet . eq parseModExp('token[T]) = downQid(T) . eq parseModExp('`(_`)[T]) = parseModExp(T) . eq parseModExp('_`(_`)[T, T']) = _<_>(parseModExp(T), parseViewExp(T')) . eq parseModExp('_*`(_`)[T, T']) = _*<_>(parseModExp(T), parseMapSet(T')) . eq parseMapSet('_`,_[T, T']) = (parseMapSet(T), parseMapSet(T')) . eq parseMapSet('sort_to_[T, T']) = (sort parseType(T) to parseType(T')) . eq parseMapSet('label_to_['token[T], 'token[T']]) = (label downQid(T) to downQid(T')) . eq parseMapSet('class_to_[T, T']) = (class parseType(T) to parseType(T')) . eq parseMapSet('attr_._to_['token[T], T', 'token[T'']]) = (attr downQid(T) . parseType(T') to downQid(T'')) . eq parseMapSet('msg_to_['token[T], 'token[T']]) = (msg downQid(T) to downQid(T')) . eq parseMapSet('msg_:_->_to_['token[T], T', T'', 'token[T''']]) = (msg downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T''')) . eq parseMapSet('msg_:`->_to_['token[T], T', 'token[T'']]) = (msg downQid(T) : nil -> parseType(T') to downQid(T'')) . eq parseMapSet('op_to_`[_`]['token[T], 'token[T'], T'']) = (op downQid(T) to downQid(T') [parseAttrSet(T'')]) . eq parseMapSet('op_:_->_to_`[_`]['token[T], T', T'', 'token[T'''], T'''']) = (op downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T''') [parseAttrSet(T'''')]) . eq parseMapSet('op_:`->_to_`[_`]['token[T], T', 'token[T''], T''']) = (op downQid(T) : nil -> parseType(T') to downQid(T'') [parseAttrSet(T''')]) . eq parseMapSet('op_:_~>_to_`[_`]['token[T], T', T'', 'token[T'''], T'''']) = (op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) to downQid(T''') [parseAttrSet(T'''')]) . eq parseMapSet('op_:`~>_to_`[_`]['token[T], T', 'token[T''], T''']) = (op downQid(T) : nil -> kind(parseType(T')) to downQid(T'') [parseAttrSet(T''')]) . eq parseMapSet('op_to_['token[T], 'token[T']]) = (op downQid(T) to downQid(T') [none]) . eq parseMapSet('op_:_->_to_['token[T], T', T'', 'token[T''']]) = (op downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T''') [none]) . eq parseMapSet('op_:`->_to_['token[T], T', 'token[T'']]) = (op downQid(T) : nil -> parseType(T') to downQid(T'') [none]) . eq parseMapSet('op_:_~>_to_['token[T], T', T'', 'token[T''']]) = (op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) to downQid(T''') [none]) . eq parseMapSet('op_:`~>_to_['token[T], T', 'token[T'']]) = (op downQid(T) : nil -> kind(parseType(T')) to downQid(T'') [none]) . eq parseAttrSet('__[T, T']) = (parseAttrSet(T) parseAttrSet(T')) . eq parseAttrSet('assoc.Attr) = assoc . eq parseAttrSet('associative.Attr) = assoc . eq parseAttrSet('comm.Attr) = comm . eq parseAttrSet('commutative.Attr) = comm . eq parseAttrSet('idem.Attr) = idem . eq parseAttrSet('idempotent.Attr) = idem . eq parseAttrSet('id:_[T]) = none . eq parseAttrSet('identity:_[T]) = none . eq parseAttrSet('left`id:_[T]) = none . eq parseAttrSet('left`identity:_[T]) = none . eq parseAttrSet('right`id:_[T]) = none . eq parseAttrSet('right`identity:_[T]) = none . eq parseAttrSet('strat`(_`)[T]) = none . eq parseAttrSet('strategy`(_`)[T]) = none . eq parseAttrSet('memo.Attr) = none . eq parseAttrSet('memoization.Attr) = none . eq parseAttrSet('prec_['token[T]]) = prec(parseNat(T)) . eq parseAttrSet('precedence_['token[T]]) = prec(parseNat(T)) . eq parseAttrSet('gather`(_`)['neTokenList[T]]) = gather(downQidList(T)) . eq parseAttrSet('gathering`(_`)['neTokenList[T]]) = gather(downQidList(T)) . eq parseAttrSet('format`(_`)['neTokenList[T]]) = none . eq parseAttrSet('ctor.Attr) = ctor . eq parseAttrSet('constructor.Attr) = ctor . eq parseAttrSet('frozen`(_`)[T]) = none . eq parseAttrSet('iter.Attr) = iter . eq parseAttrSet('special`(_`)[T]) = none . *** Given a term representing a machine integer, the function *** \texttt{parseInt} returns the corresponding integer. op parseNat : Term -> Nat . op parseInt : Term -> Int . op parseInt : TermList -> IntList . eq parseInt('neTokenList['__[TL]]) = parseInt(TL) . eq parseInt('neTokenList[QI]) = parseInt(QI) . eq parseInt((T, TL)) = (parseInt(T) parseInt(TL)) . eq parseInt(Ct) = downNat( qid(substr(string(myGetName(Ct)), 1, length(string(myGetName(Ct)))) + ".Int")) . eq parseNat(Ct) = downNat( qid(substr(string(myGetName(Ct)), 1, length(string(myGetName(Ct)))) + ".Nat")) . endfm *** *** Parsing of Bubbles *** *** In the following module \texttt{BUBBLE-PARSING}, the definitions for the *** basic processing of bubbles are introduced. In it we declare a function *** \texttt{solveBubbles} which takes a bubble and some other arguments and *** returns the term resulting from parsing it. fmod BUBBLE-PARSING is pr DATABASE . pr MOVE-UP . pr MOVE-DOWN . pr EXT-SORT-TO-QID . pr MOD-EXP-PARSING . pr PRINT-SYNTAX-ERROR . vars T T' : Term . vars M M' : Module . var B : Bool . var QIL : QidList . var DB : Database . var TL : TermList . var S : Sort . vars QI QI' F : Qid . var VDS : OpDeclSet . var C : Constant . var V : Variable . var N : Nat . var Tp : Type . var RP : [ResultPair] . op error : QidList -> [ResultPair] [ctor] . *** As we shall see in Section~\ref{evaluation}, a declaration importing the *** predefined module \texttt{UP} (see Section~\ref{non-built-in-predefined}) *** is added to all modules importing the \texttt{META-LEVEL} module. The *** \texttt{solveBubbles} function is called with a `flag' indicating whether *** the module can contain calls to the \texttt{up} function or not. Thus, *** when we call \texttt{metaParse} with some bubble and the module in which *** such bubble has to be parsed, if there are occurrences of the function *** \texttt{up} in it, they will be of the form \verb~'up['token[T]]~ or *** \verb~'up['token[T], 'bubble[T']]~ for terms \texttt{T} and \texttt{T'}. *** The function \texttt{solveUps} will evaluate them. op solveBubbles : Term Module Bool EOpDeclSet Database -> [Term] . op solveUps : TermList Database -> [TermList] . op constsToVbles : Term OpDeclSet -> Term . op constsToVbles : TermList OpDeclSet -> TermList . op constsToVblesAux : Constant OpDeclSet -> Qid [memo] . eq constsToVbles(F[TL], VDS) = F[constsToVbles(TL, VDS)] . eq constsToVbles((T, TL), VDS) = (constsToVbles(T, VDS), constsToVbles(TL, VDS)) . eq constsToVbles(C, VDS) = constsToVblesAux(C, VDS) . eq constsToVbles(V, VDS) = V . eq constsToVbles(error(QIL), VDS) = error(QIL) . eq constsToVblesAux(C, (op F : nil -> Tp [none] .) VDS) = if myGetName(C) == F then qid(string(F) + ":" + string(Tp)) else constsToVblesAux(C, VDS) fi . eq constsToVblesAux(C, none) = C . ceq solveBubbles('bubble[T], M, B, VDS, DB) = if RP :: ResultPair then if B *** if META-LEVEL is a submodule the ups need to be solved then solveUps(constsToVbles(getTerm(RP), VDS), DB) else constsToVbles(getTerm(RP), VDS) fi else error('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n '\r 'Error: '\o 'no 'parse 'for QIL '\n) fi if M' := addOps(VDS, M) /\ QIL := downQidList(T) /\ RP := metaParse(M', QIL, anyType) . *** The \texttt{solveBubbles1} function is in charge of calling the function *** \texttt{metaParse}. The flag indicating the inclusion of the module *** \texttt{META-LEVEL} in the module in which the term appears decides *** whether the function \texttt{solveUps} is called or not, so the extra *** price of searching for calls to the \texttt{up} function is paid only *** when an occurrence of the function is possible. This function takes care *** of the occurrences of the \texttt{up} function that may exist in such *** bubbles. *** The function \texttt{solveUps} goes through the term looking for a term *** with \texttt{'up} as top operator and \texttt{'token} as top operator of *** its unique argument if there is only one argument, or with \texttt{'token} *** and \texttt{'bubble} as top operators of its first and second arguments, *** respectively, if there are two. If a term of the form *** \mbox{\texttt{'up['token[T]]}} is reached, it is replaced by the *** metarepresentation of the flat version of the module in the database with *** the name given by the token. If a term of form *** \mbox{\texttt{'up['token[T], 'bubble[T']]}} is reached, the *** metarepresentation of the result of parsing the bubble in the signature *** of the module with the name given by the token, after solving possible *** nested calls to the \texttt{up} function, is returned. eq solveUps(QI, DB) = QI . eq solveUps((T, TL), DB) = (solveUps(T, DB), solveUps(TL, DB)) . eq solveUps('up[QI], DB) = 'up[QI] . ceq solveUps('up['token[T]], DB) = if QI inModNameSet builtIns then up(DUMMY(QI)) else if unitInDb(QI, DB) then up(getFlatUnit(QI, DB)) else error('\r 'Error: '\o 'Module QI 'not 'in 'database. '\n) fi fi if QI := downQid(T) . eq solveUps('up[F[TL]], DB) = 'up[F[solveUps(TL, DB)]] [owise] . eq solveUps('`[_`][QI], DB) = '`[_`][QI] . ceq solveUps('`[_`]['token[T]], DB) = if QI inModNameSet builtIns then up(DUMMY(QI)) else if unitInDb(QI, DB) then up(getFlatUnit(QI, DB)) else error('\r 'Error: '\o 'Module QI 'not 'in 'database. '\n) fi fi if QI := downQid(T) . eq solveUps('`[_`][F[TL]], DB) = '`[_`][F[solveUps(TL, DB)]] [owise] . ceq solveUps('up['token[T], 'bubble[T']], DB) = if QI inModNameSet builtIns then if metaParse(DUMMY(QI), QIL, anyType) :: ResultPair then up(getTerm(metaParse(DUMMY(QI), QIL, anyType))) else error('\r 'Warning: '\o 'No 'parse 'for 'argument 'of 'up printSyntaxError(metaParse(DUMMY(QI), QIL, anyType), QIL) '\n) fi else if unitInDb(QI, DB) then if ((including 'UP .) in getImports(getInternalUnit(QI, DB))) then if metaParse(getFlatUnit(QI, DB), QIL, anyType) :: ResultPair then up( solveUps( getTerm( metaParse(getFlatUnit(QI, DB), QIL, anyType)), DB)) else error('\r 'Warning: '\o 'No 'parse 'for 'argument 'of 'up printSyntaxError( metaParse(getFlatUnit(QI, DB), QIL, anyType), QIL) '\n) fi else if metaParse(getFlatUnit(QI, DB), QIL, anyType) :: ResultPair then up(getTerm( metaParse(getFlatUnit(QI, DB), QIL, anyType))) else error('\r 'Warning: '\o 'No 'parse 'for 'argument 'of 'up printSyntaxError( metaParse(getFlatUnit(QI, DB), QIL, anyType), QIL) '\n) fi fi else error('\r 'Error: '\o 'Module QI 'not 'in 'database. '\n) fi fi if QI := downQid(T) /\ QIL := downQidList(T') . ceq solveUps('up['token[T], 'bubble[T']], DB) = if QI inModNameSet builtIns then if metaParse(DUMMY(QI), QIL, anyType) :: ResultPair then up(getTerm(metaParse(DUMMY(QI), QIL, anyType))) else error('\r 'Warning: '\o 'No 'parse 'for 'argument 'of 'up printSyntaxError(metaParse(DUMMY(QI), QIL, anyType), QIL) '\n) fi else if unitInDb(QI, DB) then if ((including 'UP .) in getImports(getInternalUnit(QI, DB))) then if metaParse(getFlatUnit(QI, DB), QIL, anyType) :: ResultPair then up(solveUps( getTerm( metaParse(getFlatUnit(QI, DB), QIL, anyType)), DB)) else error('\r 'Warning: '\o 'No 'parse 'for 'argument 'of 'up printSyntaxError( metaParse(getFlatUnit(QI, DB), QIL, anyType), QIL) '\n) fi else if metaParse(getFlatUnit(QI, DB), QIL, anyType) :: ResultPair then up(getTerm( metaParse(getFlatUnit(QI, DB), QIL, anyType))) else error('\r 'Warning: '\o 'No 'parse 'for 'argument 'of 'up printSyntaxError( metaParse(getFlatUnit(QI, DB), QIL, anyType), QIL) '\n) fi fi else error('\r 'Error: '\o 'Module QI 'not 'in 'database. '\n) fi fi if QI := downQid(T) /\ QIL := downQidList(T') . ceq solveUps('up[F[TL], T], DB) = 'up[F[solveUps(TL, DB)], solveUps(T, DB)] if F =/= 'token . eq solveUps('up[QI, T], DB) = 'up[QI, solveUps(T, DB)] . ceq solveUps('up[T, F[TL]], DB) = 'up[solveUps(T, DB), F[solveUps(TL, DB)]] if F =/= 'bubble . eq solveUps('up[T, QI], DB) = 'up[solveUps(T, DB), QI] . eq solveUps('up[T, (T', TL)], DB) = 'up[solveUps(T, DB), (solveUps(T', DB), solveUps(TL, DB))] . eq solveUps(F[TL], DB) = F[solveUps(TL, DB)] [owise] . endfm ******************************************************************************* *** *** Parsing the Bubbles in a Unit *** *** The \texttt{solveBubbles} function defined in the *** \texttt{UNIT-BUBBLE-PARSING} module takes a term of sort \texttt{Unit} (a *** preunit in fact) and a signature, and returns the unit resulting from the *** evaluation (parsing) of all the bubbles in it. fmod UNIT-BUBBLE-PARSING is pr BUBBLE-PARSING . pr DATABASE . pr MOVE-UP . pr MOVE-DOWN . pr EXT-SORT-TO-QID . pr PRINT-SYNTAX-ERROR . vars T T' T'' T''' T'''' : Term . vars T? T?' : [Term] . var TL TL' : TermList . vars TL? TL?' : [TermList] . var B : Bool . vars M M' : Module . var DB : Database . var PU : Unit . var S : Sort . var SS : SortSet . var K : Kind . var KS : KindSet . vars ES ES' : ESort . vars ET ET' : EType . var ETL : ETypeList . var AtS : AttrSet . var NL : IntList . var QI QI' QI'' QI''' QI'''' QI''''' F L : Qid . vars QIL QIL' : QidList . var I : Nat . var H : Hook . var HL : HookList . var MAS : MembAxSet . var Eq : Equation . var EqS : EquationSet . var Rl : Rule . var RlS : RuleSet . var EOPD : EOpDecl . vars EOPDS VDS : EOpDeclSet . var EMA : EMembAx . var EMAS : EMembAxSet . var CD? : [Condition] . var Ct : Constant . var RP : [ResultPair] . *** In the parsing of bubbles themselves, we consider three different cases: *** The case of having one single bubble in which no context is *** considered (used to parse bubbles in term maps in views and in the *** special attributes of operators); the case of two bubbles to be parsed in *** the same connected component (used for bubbles in equations and rules), *** and the case of one bubble to be parsed in a specific sort (used for the *** bubbles appearing in the identity element attributes in the declarations *** of operators, and in membership axioms). These three cases are reduced to *** the case of one single bubble without context, which is handled by the *** function \texttt{solveBubbles3}. op solveBubbles : Term Term Module Bool EOpDeclSet Database -> Term . op solveBubbles2 : Term EType Module Bool EOpDeclSet Database -> Term . op solveBubblesCond : Term Module Module Bool EOpDeclSet Database -> [Condition] . op error : QidList -> [Condition] [ctor format (r o)] . *** The case of two bubbles, generated in the case of equations and rules, is *** reduced to the case with one single bubble using the polymorphic operator *** \verb~_==_~ and enclosing each of the bubbles in parentheses. Below, we *** shall see how after calling this function the terms corresponding to each *** of the bubbles is extracted. ceq solveBubbles('bubble[T], 'bubble[T'], M, true, VDS, DB) = if RP :: ResultPair then solveUps(constsToVbles(getTerm(RP), VDS), DB) else error('\r 'Warning: '\o printSyntaxError(RP, '`( QIL '`) '== '`( QIL' '`)) '\n '\r 'Error: '\o 'no 'parse 'for QIL '\s '~ '\s QIL' '\n) fi if M' := addOps(VDS, M) /\ QIL := downQidList(T) /\ QIL' := downQidList(T') /\ RP := metaParse(M', '`( QIL '`) '== '`( QIL' '`), 'Bool) . ceq solveBubbles('bubble[T], 'bubble[T'], M, false, VDS, DB) = if RP :: ResultPair then constsToVbles(getTerm(RP), VDS) else error('\r 'Warning: '\o printSyntaxError(RP, '`( QIL '`) '== '`( QIL' '`)) '\n '\r 'No 'parse 'for QIL '\s '~ '\s QIL' '\n) fi if M' := addOps(VDS, M) /\ QIL := downQidList(T) /\ QIL' := downQidList(T') /\ RP := metaParse(M', '`( QIL '`) '== '`( QIL' '`), 'Bool) . ceq solveBubbles2('bubble[T], ET, M, true, VDS, DB) = if RP :: ResultPair then solveUps(constsToVbles(getTerm(RP), VDS), DB) else error('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n '\r 'Error: 'No 'parse 'for QIL '\n) fi if QIL := downQidList(T) /\ RP := metaParse(M, QIL, eSortToSort(ET)) . ceq solveBubbles2('bubble[T], ET, M, false, VDS, DB) = if RP :: ResultPair then constsToVbles(getTerm(RP), VDS) else error('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n '\r 'Error: 'No 'parse 'for QIL '\n) fi if QIL := downQidList(T) /\ RP := metaParse(M, QIL, eSortToSort(ET)) . op addInfoConds : Module -> [Module] . op addInfoConds : Module SortSet -> Module . eq addInfoConds(M) = addInfoConds(M, getAllSorts(M)) . eq addInfoConds(M, 'Token ; SS) = addInfoConds(M, SS) . eq addInfoConds(M, 'Bubble ; SS) = addInfoConds(M, SS) . eq addInfoConds(M, S ; SS) = addInfoConds( addOps(op qid("_: " + string(S)) : S -> '@Condition [ctor prec(71)] . op '_=_ : S S -> '@Condition [ctor prec(71)] . op '_:=_ : S S -> '@Condition [ctor prec(71)] . op '_=>_ : S S -> '@Condition [ctor prec(71)] ., M), SS) [owise]. eq addInfoConds(M, none) = addOps(op '_/\_ : '@Condition '@Condition -> '@Condition [ctor assoc prec(73)] ., addSorts('@Condition, addSubsorts(subsort 'Bool < '@Condition ., M))) . ceq solveBubblesCond('bubble[T], M, M', false, VDS, DB) = if metaParse(M, QIL, 'Bool) :: ResultPair then constsToVbles(getTerm(metaParse(M, QIL, 'Bool)), VDS) = 'true.Bool else if metaParse(M', QIL, '@Condition) :: ResultPair then parseCond(getTerm(metaParse(M', QIL, '@Condition)), VDS) else error('\r 'Warning: '\o printSyntaxError(metaParse(M', QIL, '@Condition), QIL) '\n) fi fi if QIL := downQidList(T) . ceq solveBubblesCond('bubble[T], M, M', true, VDS, DB) = if metaParse(M, QIL, 'Bool) :: ResultPair then solveUps(constsToVbles(getTerm(metaParse(M, QIL, 'Bool)), VDS), DB) = 'true.Bool else if metaParse(M', QIL, '@Condition) :: ResultPair then parseCond(getTerm(metaParse(M', QIL, '@Condition)), VDS) else error('\r 'Warning: '\o printSyntaxError(metaParse(M', QIL, '@Condition), QIL) '\n) fi fi if QIL := downQidList(T) . ceq solveBubblesCond('bubble[T], M, M', false, VDS, DB) = if metaParse(M, QIL, 'Bool) :: ResultPair then constsToVbles(getTerm(metaParse(M, QIL, 'Bool)), VDS) = 'true.Bool else if metaParse(M', QIL, '@Condition) :: ResultPair then parseCond(getTerm(metaParse(M', QIL, '@Condition)), VDS) else error('\r 'Warning: '\o printSyntaxError(metaParse(M', QIL, '@Condition), QIL) '\n) fi fi if QIL := downQidList(T) . ceq solveBubblesCond('bubble[T], M, M', true, VDS, DB) = if metaParse(M, QIL, 'Bool) :: ResultPair then solveUps(constsToVbles(getTerm(metaParse(M, QIL, 'Bool)), VDS), DB) = 'true.Bool else if metaParse(M', QIL, '@Condition) :: ResultPair then parseCond(getTerm(metaParse(M', QIL, '@Condition)), VDS) else error('\r 'Warning: '\o printSyntaxError(metaParse(M', QIL, '@Condition), QIL) '\n) fi fi if QIL := downQidList(T) . op parseCond : Term EOpDeclSet -> Condition . eq parseCond(QI, VDS) = constsToVbles(QI, VDS) = 'true.Bool . ceq parseCond(F[T], VDS) *** this solution may give problems if other unary ops starting *** with _:` are defined by the user. = if substr(string(F), 0, 3) == "_:`" then T' : qid(substr(string(F), 3, length(string(F)))) else F[T'] = 'true.Bool fi if T' := constsToVbles(T, VDS) . eq parseCond(F[T, T'], VDS) = if F == '_/\_ then parseCond(T, VDS) /\ parseCond(T', VDS) else if F == '_=_ then constsToVbles(T, VDS) = constsToVbles(T', VDS) else if F == '_:=_ then constsToVbles(T, VDS) := constsToVbles(T', VDS) else if F == '_=>_ then constsToVbles(T, VDS) => constsToVbles(T', VDS) else constsToVbles(F[T, T'], VDS) = 'true.Bool fi fi fi fi . eq parseCond(F[T, T', TL], VDS) = constsToVbles(F[T, T', TL], VDS) = 'true.Bool . *** eq parseCond('_/\_[T, T'], VDS) *** = parseCond(T, VDS) /\ parseCond(T', VDS) . *** eq parseCond('_=_[T, T'], VDS) *** = constsToVbles(T, VDS) = constsToVbles(T', VDS) . *** eq parseCond('_:_[T, T'], VDS) = constsToVbles(T, VDS) : myGetName(T') . *** eq parseCond('_:=_[T, T'], VDS) *** = constsToVbles(T, VDS) := constsToVbles(T', VDS) . *** eq parseCond('_=>_[T, T'], VDS) *** = constsToVbles(T, VDS) => constsToVbles(T', VDS) . *** Since bubbles can only appear in the identity or special attributes in the *** declaration of operators, in equations, membership axioms, and rules, the *** evaluation of bubbles on a preunit is reduced to calls to the *** \texttt{solveBubbles} functions on each of these sets of declarations. op solveBubbles : Unit Module Bool EOpDeclSet Database -> Unit . op solveBubbles : EquationSet Module [Module] Bool EOpDeclSet Database -> EquationSet . op solveBubbles : RuleSet Module [Module] Bool EOpDeclSet Database -> RuleSet . op solveBubbles : EMembAxSet Module [Module] Bool EOpDeclSet Database -> EMembAxSet . op solveBubbles : Condition Module Bool EOpDeclSet Database -> Condition . op solveBubbles : EOpDeclSet Module -> EOpDeclSet . op solveBubbles : AttrSet ETypeList ESort Module -> AttrSet . op solveBubbles : HookList Module -> HookList . ceq solveBubbles(PU, M, B, VDS, DB) = setOps( (if getMbs(PU) == none and getEqs(PU) == none and getRls(PU) == none then PU else setEqs( setMbs( setRls(PU, solveBubbles(getRls(PU), M', addInfoConds(M'), B, VDS, DB)), solveBubbles(getMbs(PU), M', addInfoConds(M'), B, VDS, DB)), solveBubbles(getEqs(PU), M', addInfoConds(M'), B, VDS, DB)) fi), solveBubbles(getOps(PU), M')) if M' := addOps(VDS, M) . *** To avoid the parsing ambiguities in the identity elements we add the sort *** of the operator to be used as context in which doing the parsing. We *** assume that the term given as identity element of an operator is in the *** kind of the sort of such operator. eq solveBubbles(((op F : ETL -> ET [AtS] .) EOPDS), M) = ((op F : ETL -> ET [solveBubbles(AtS, ETL, ET, M)] .) solveBubbles(EOPDS, M)) . eq solveBubbles((none).OpDeclSet, M) = none . eq solveBubbles((none).AttrSet, ETL, ET, M) = none . eq solveBubbles((assoc AtS), ETL, ET, M) = (assoc solveBubbles(AtS, ETL, ET, M)) . eq solveBubbles((comm AtS), ETL, ET, M) = (comm solveBubbles(AtS, ETL, ET, M)) . eq solveBubbles((idem AtS), ETL, ET, M) = (idem solveBubbles(AtS, ETL, ET, M)) . eq solveBubbles((id(T) AtS), ETL, ET, M) = (id(solveBubbles2(T, ET, M, false, none, emptyDatabase)) solveBubbles(AtS, ETL, ET, M)) . eq solveBubbles((left-id(T) AtS), ET ETL, ET', M) = (left-id(solveBubbles2(T, ET, M, false, none, emptyDatabase)) solveBubbles(AtS, ET ETL, ET', M)) . eq solveBubbles((right-id(T) AtS), ETL ET, ET', M) = (right-id(solveBubbles2(T, ET, M, false, none, emptyDatabase)) solveBubbles(AtS, ETL ET, ET', M)) . eq solveBubbles((strat(NL) AtS), ETL, ET, M) = (strat(NL) solveBubbles(AtS, ETL, ET, M)) . eq solveBubbles((memo AtS), ETL, ET, M) = (memo solveBubbles(AtS, ETL, ET, M)) . eq solveBubbles((prec(I) AtS), ETL, ET, M) = (prec(I) solveBubbles(AtS, ETL, ET, M)) . eq solveBubbles((gather(QIL) AtS), ETL, ET, M) = (gather(QIL) solveBubbles(AtS, ETL, ET, M)) . eq solveBubbles((format(QIL) AtS), ETL, ET, M) = (format(QIL) solveBubbles(AtS, ETL, ET, M)) . eq solveBubbles((ctor AtS), ETL, ET, M) = (ctor solveBubbles(AtS, ETL, ET, M)) . eq solveBubbles((frozen(NL) AtS), ETL, ET, M) = (frozen(NL) solveBubbles(AtS, ETL, ET, M)) . eq solveBubbles((iter AtS), ETL, ET, M) = (iter solveBubbles(AtS, ETL, ET, M)) . eq solveBubbles((special(HL) AtS), ETL, ET, M) = (special(solveBubbles(HL, M)) solveBubbles(AtS, ETL, ET, M)) . eq solveBubbles((H HL), M) = (solveBubbles(H, M) solveBubbles(HL, M)) . eq solveBubbles(id-hook(QI, QIL), M) = id-hook(QI, QIL) . eq solveBubbles(op-hook(QI, QI', QIL, QI''), M) = op-hook(QI, QI', QIL, QI'') . eq solveBubbles(term-hook(QI, T), M) = term-hook(QI, solveBubbles(T, M, false, none, emptyDatabase)) . *** Since both sides of any equation or rule have to be in the same connected *** component of sorts, we parse the two bubbles together using the *** polymorphic operator \verb~_==_~\footnote{Note that if including *** \texttt{BOOL} the operator \texttt{\_\,==\_\,} is added for each kind.}. *** That is, given for example an equation as \verb~eq T = T' .~, we parse *** \verb~T == T'~, forcing them to be parsed in the same connected component, *** if possible. We add functions \texttt{lhs} and \texttt{rhs} to extract, *** respectively, the lefthand and righthand side terms from the result. Note *** that these are partial functions. sort TermAttrSetPair . op pullStmtAttrOut : Term -> [TermAttrSetPair] . op pullStmtAttrOutAux : Term TermList AttrSet -> [TermAttrSetPair] . op pullLabelOut : Term -> [TermAttrSetPair] . op {_,_} : Term AttrSet -> TermAttrSetPair . op term : TermAttrSetPair -> Term . op attrSet : TermAttrSetPair -> AttrSet . eq term({T, AtS}) = T . eq attrSet({T, AtS}) = AtS . eq pullStmtAttrOut('bubble[QI]) = {'bubble[QI], none} . eq pullStmtAttrOut('bubble['__[QI, QI']]) = {'bubble['__[QI, QI']], none} . eq pullStmtAttrOut('bubble['__[QI, QI', QI'']]) = {'bubble['__[QI, QI', QI'']], none} . eq pullStmtAttrOut('bubble['__[QI, QI', TL, QI'']]) = if QI'' =/= ''`].Qid then {'bubble['__[QI, QI', TL, QI'']], none} else pullStmtAttrOutAux( 'bubble['__[QI, QI', TL, QI'']], (QI, QI', TL), none) fi . eq pullStmtAttrOutAux(T, (QI, QI'), AtS) = if QI' == ''`[.Qid and-then AtS =/= none then {'bubble[QI], AtS} else {T, none} fi . eq pullStmtAttrOutAux(T, (TL, QI, QI'), AtS) = if QI' == ''`[.Qid then if AtS =/= none then {'bubble['__[TL, QI]], AtS} else {T, none} fi else if QI' == ''nonexec.Qid then pullStmtAttrOutAux(T, (TL, QI), AtS nonexec) else if QI' == ''owise.Qid then pullStmtAttrOutAux(T, (TL, QI), AtS owise) else if QI == ''label.Qid and-then downQid(QI') :: Qid then pullStmtAttrOutAux(T, TL, AtS label(downQid(QI'))) else if QI == ''metadata.Qid and-then downString(downQid(QI')) :: String then pullStmtAttrOutAux(T, TL, AtS metadata(downString(downQid(QI')))) else {T, none} fi fi fi fi fi . eq pullStmtAttrOutAux(T, QI, AtS) = {T, none} . eq pullLabelOut('bubble[QI]) = {'bubble[QI], none} . eq pullLabelOut('bubble['__[QI, QI']]) = {'bubble['__[QI, QI']], none} . eq pullLabelOut('bubble['__[QI, QI', QI'']]) = {'bubble['__[QI, QI', QI'']], none} . eq pullLabelOut('bubble['__[QI, QI', QI'', QI''']]) = {'bubble['__[QI, QI', QI'', QI''']], none} . eq pullLabelOut('bubble['__[QI, QI', QI'', QI''', TL]]) = if QI == ''`[.Qid and-then (QI'' == ''`].Qid and-then QI''' == '':.Qid) then {'bubble['__[TL]], label(downQid(QI'))} else {'bubble['__[QI, QI', QI'', QI''', TL]], none} fi . ops lhs rhs : Term -> Term . eq lhs('_==_[T, T']) = T . eq rhs('_==_[T, T']) = T' . eq lhs(error(QIL)) = error(QIL) . eq rhs(error(QIL)) = error(QIL) . eq solveBubbles(EqS, M, error(QIL), B, VDS, DB) = error(QIL) . eq solveBubbles(RlS, M, error(QIL), B, VDS, DB) = error(QIL) . eq solveBubbles(EMAS, M, error(QIL), B, VDS, DB) = error(QIL) . eq solveBubbles(((eq T = T' [none] .) EqS), M, M', B, VDS, DB) = ((eq lhs(solveBubbles(T, term(pullStmtAttrOut(T')), M, B, VDS, DB)) = rhs(solveBubbles(T, term(pullStmtAttrOut(T')), M, B, VDS, DB)) [attrSet(pullStmtAttrOut(T'))] .) solveBubbles(EqS, M, M', B, VDS, DB)) . eq solveBubbles(((ceq T = T' if T'' = 'true.Bool [none] .) EqS), M, M', B, VDS, DB) = ((ceq lhs(solveBubbles(T, T', M, B, VDS, DB)) = rhs(solveBubbles(T, T', M, B, VDS, DB)) if solveBubblesCond(term(pullStmtAttrOut(T'')), M, M', B, VDS, DB) [attrSet(pullStmtAttrOut(T''))] .) solveBubbles(EqS, M, M', B, VDS, DB)) . eq solveBubbles((none).EquationSet, M, M', B, VDS, DB) = none . eq solveBubbles(((rl T => T' [AtS] .) RlS), M, M', B, VDS, DB) = ((rl lhs(solveBubbles(term(pullLabelOut(T)), term(pullStmtAttrOut(T')), M, B, VDS, DB)) => rhs(solveBubbles(term(pullLabelOut(T)), term(pullStmtAttrOut(T')), M, B, VDS, DB)) [attrSet(pullLabelOut(T)) attrSet(pullStmtAttrOut(T'))] .) solveBubbles(RlS, M, M', B, VDS, DB)) . eq solveBubbles( ((crl T => T' if T'' = 'true.Bool [none] .) RlS), M, M', B, VDS, DB) = ((crl lhs(solveBubbles(term(pullLabelOut(T)), T', M, B, VDS, DB)) => rhs(solveBubbles(term(pullLabelOut(T)), T', M, B, VDS, DB)) if solveBubblesCond(term(pullStmtAttrOut(T'')), M, M', B, VDS, DB) [attrSet(pullLabelOut(T)) attrSet(pullStmtAttrOut(T''))] .) solveBubbles(RlS, M, M', B, VDS, DB)) . eq solveBubbles((none).RuleSet, M, M', B, VDS, DB) = none . *** In the call to solve the bubbles in membership axioms we add the sort to *** which it is constrained to be used as context. eq solveBubbles(((mb T : ES [AtS] .) EMAS), M, M', B, VDS, DB) = ((mb solveBubbles2(T, ES, M, B, VDS, DB) : ES [AtS] .) solveBubbles(EMAS, M, M', B, VDS, DB)) . eq solveBubbles(((cmb T : ES if T' = 'true.Bool [AtS] .) EMAS), M, M', B, VDS, DB) = ((cmb solveBubbles2(T, ES, M, B, VDS, DB) : ES if solveBubblesCond(T', M, M', B, VDS, DB) [AtS] .) solveBubbles(EMAS, M, M', B, VDS, DB)) . eq solveBubbles((none).MembAxSet, M, M', B, VDS, DB) = none . *** The parsing process may generate error terms. Since in the *** current version of the system Core Maude is generating the appropriate *** error messages, we just have to worry about the elimination of these *** terms. The effect is the same one as introducing a module at the object *** level of Core Maude: If there is any term in an identity attribute in an *** operator declaration, equation, rule, or membership axiom with a parsing *** error a message is generated and the axiom is eliminated. eq (op F : ETL -> ET [id(error(QIL)) AtS] .) = error(QIL) . eq (op F : ETL -> ET [left-id(error(QIL)) AtS] .) = error(QIL) . eq (op F : ETL -> ET [right-id(error(QIL)) AtS] .) = error(QIL) . eq (error(QIL) /\ T = T' /\ CD?) = error(QIL) . eq (error(QIL) /\ T : ES /\ CD?) = error(QIL) . eq (error(QIL) /\ T := T' /\ CD?) = error(QIL) . eq (error(QIL) /\ T => T' /\ CD?) = error(QIL) . eq (eq error(QIL) = T? [AtS] .) = error(QIL) . eq (eq T? = error(QIL) [AtS] .) = error(QIL) . eq (ceq error(QIL) = T? if CD? [AtS] .) = error(QIL) . eq (ceq T? = error(QIL) if CD? [AtS] .) = error(QIL) . eq (ceq T? = T?' if error(QIL) [AtS] .) = error(QIL) . eq (mb error(QIL) : ES [AtS] .) = error(QIL) . eq (cmb error(QIL) : ES if CD? [AtS] .) = error(QIL) . eq (cmb T? : ES if error(QIL) [AtS] .) = error(QIL) . eq (rl error(QIL) => T? [AtS] .) = error(QIL) . eq (rl T? => error(QIL) [AtS] .) = error(QIL) . eq (crl error(QIL) => T? if CD? [AtS] .) = error(QIL) . eq (crl T? => error(QIL) if CD? [AtS] .) = error(QIL) . eq (crl T? => T?' if error(QIL) [AtS] .) = error(QIL) . eq F[error(QIL), TL?] = error(QIL) . eq F[TL?, error(QIL)] = error(QIL) . eq F[TL?, error(QIL), TL?'] = error(QIL) . endfm ******************************************************************************* *** The function \texttt{solveBubbles} defined in the following *** \texttt{VIEW-BUBBLE-PARSING} module parses the bubbles in a set of preview *** maps. It takes two modules, the signature of the view's source theory, *** with the variables declared in the view, to parse the source term in the *** term maps, and the target theory, with the mappings of the variable *** declarations in the view, to parse the target terms. fmod VIEW-BUBBLE-PARSING is pr BUBBLE-PARSING . pr PRE-VIEW . var PVMAPS : PreViewMapSet . var VMAP : ViewMap . vars T T' : Term . vars M M' : Module . var U : Unit . var QIL : QidList . vars VDS VDS' : EOpDeclSet . op solveBubbles : PreViewMapSet EOpDeclSet EOpDeclSet Unit Unit -> ViewMapSet . eq solveBubbles(PVMAPS, VDS, VDS', U, error(QIL)) = none . eq solveBubbles(PVMAPS, VDS, VDS', error(QIL), U) = none . ceq solveBubbles((VMAP, PVMAPS), VDS, VDS', M, M') = (VMAP, solveBubbles(PVMAPS, VDS, VDS', M, M')) if not (VMAP :: TermMap) . eq solveBubbles((preTermMap(T, T'), PVMAPS), VDS, VDS', M, M') = (termMap( solveBubbles(T, M, false, VDS, emptyDatabase), solveBubbles(T', M', false, VDS', emptyDatabase)), solveBubbles(PVMAPS, VDS, VDS', M, M')) . eq solveBubbles(none, VDS, VDS', M, M') = none . endfm ******************************************************************************* *** *** Module Expression Evaluation *** *** So far we have not introduced more module expressions than those given by *** simple quoted identifiers. We will introduce some later, but the scheme *** followed for evaluating them is very simple and can be presented in a *** generic way. Given a module expression and a database state, the *** evaluation of a module expression results in the generation of a new *** module, which is introduced in the database, with the module expression *** as its name. The resulting database is then returned. If there is already *** a module in the database with that name, the function returns the original *** database without any change. The evaluation of a module expression may *** produce the evaluation of other module expressions contained in the *** modules involved in the process. This is the case, for example, for the *** renaming of modules, in which not only the top module is renamed but, *** perhaps, some of its submodules as well; it is also the case for the *** instantiation of parameterized modules, where the module being *** instantiated may contain submodules which are parameterized by some of *** the parameter theories of the parameterized module in which are imported. *** We shall discuss in more detail the renaming and instantiation of module *** expressions in Sections~\ref{renaming} and~\ref{instantiation}, *** respectively. *** We saw in Section~\ref{module-expressions} how it is possible to import a *** module expression in which a parameterized module is instantiated by some *** of the formal parameters of the parameterized module into which it is *** imported. To be able to evaluate this kind of module expression, the list *** of parameters of the module in which the module expression appears has to *** be given. fmod MOD-EXPR-EVAL is pr DATABASE . *** decl. moved to module DATABASE *** op evalModExp : ModExp Database -> Database . op evalModExp : ModExp ParameterList Database -> Database . op evalViewExp : ViewExp ParameterList Database -> Database . var QI : Qid . var ME : ModExp . var PL : ParameterList . var DB : Database . vars VE VE' VE'' : ViewExp . eq evalModExp(ME, DB) = evalModExp(ME, nilParList, DB) . eq evalModExp(QI, PL, DB) = if unitInDb(QI, DB) then if compiledUnit(QI, DB) then DB else procUnit(QI, DB) fi else if QI inModNameSet builtIns then DB else warning(DB, '\r 'Error: '\o 'Module QI 'not 'in 'database. '\n) fi fi . eq evalViewExp(QI, PL, DB) = if labelInParList(QI, PL) then DB else if viewInDb(QI, DB) then if compiledView(QI, DB) then DB else procView(QI, DB) fi else warning(DB, ('\r 'Error: '\o 'View QI 'not 'in 'database. '\n)) fi fi . eq evalViewExp(VE << VE' >>, PL, DB) = if labelInParList(VE << VE' >>, PL) or-else viewInDb(VE << VE' >>, DB) then DB else viewInst(VE, VE', PL, evalViewExp(VE, PL, evalViewExp(VE', PL, DB))) fi . ceq evalViewExp(VE | VE', PL, DB) = evalViewExp(VE, PL, evalViewExp(VE', PL, DB)) if VE =/= nullViewExp . *** eq evalViewExp((VE ;; VE'), PL, DB) *** = viewComposition(VE, VE', PL, *** evalViewExp(VE, PL, evalViewExp(VE', PL, DB))) . eq evalViewExp(nullViewExp, PL, DB) = DB . op viewInst : ViewExp ViewExp ParameterList Database -> Database . var X : Qid . ceq evalViewExp((VE ;; X), PL, DB) = insertView(setName(getView(VE, evalViewExp(VE, PL, DB)), VE ;; X), evalViewExp(VE, PL, DB)) if labelInParList(X, PL) . ******************************************************************************* *** The equations specifying its behavior are later, in INST-EXPR-EVALUATION ** ******************************************************************************* endfm ******************************************************************************* *** *** The Transformation of Object-Oriented Modules to System Modules *** *** The transformation of object-oriented modules into system modules has *** already been discussed in Section~\ref{omod2mod}, and also in *** \cite{Meseguer93b,ClavelDuranEkerLincolnMarti-OlietMeseguerQuesada99}. *** We focus here on the part of the process accomplished by each of the main *** functions involved in the transformation. The transformation discussed *** in~\cite{DuranMeseguer98} assumed that object-oriented modules were *** flattened before being transformed into system modules. However, doing it *** in this way, the transformations already made for the modules in the *** structure were not reused. In the current system, the transformation is *** done only for the module being introduced, the top of the structure, and *** dusing the `internal' representations of the submodules stored in the *** ddatabase for the rest of the structure. *** This approach requires gathering all class and subclass relation *** declarations in the structure before starting with the transformation *** process itself. The function \texttt{prepClasses} collects all these *** declarations in the structure, and completes all the declarations of *** classes with the attributes inherited from their superclasses. *** \begin{comment} *** This function makes use of a `dummy' module, in which the classes are *** introduced as sorts and the subclass relations as subsort relations to be *** able to compute all the operations on the subclass relation using the *** built-in functions on sorts. *** \end{comment} *** Once all the class declarations in the structure have been collected and *** completed, the transformation is accomplished in two stages. First, the *** function \texttt{omod2modAux} carries out the *** following tasks: *** \begin{itemize} *** \item For each class declaration of the form *** $\texttt{class }C\texttt{ | }a_1\texttt{:} S_1\texttt{,} *** \ldots\texttt{,} a_n\texttt{:} S_n$, the following items are *** introduced: a subsort $C$ of sort \texttt{Cid}, a constant *** $C$ of sort $C$, and declarations of operations $a_i *** \texttt{\ :\_} \texttt{ :\,\,} S_i \texttt{ -> Attribute}$ *** for each attribute $a_i$ (the function *** \texttt{attributeOpDeclSet} creates these declarations). *** \item For each subclass relation of the form *** $\texttt{subclass\ }C\texttt{\ <\ }C'$, a subsort *** declaration $\texttt{subsort\ }C\texttt{\ <\ }C'$ is *** introduced. *** \item For each message declaration of the form \verb~msg F : ETL *** -> ES~, an operator declaration \verb~op F : ETL -> ES~ is added. *** \end{itemize} *** When this process has been completed, the function \texttt{prepAxs} is *** called. This function applies to the membership axioms, equations, and *** rewriting rules in the module the transformations indicated in *** Section~\ref{omod2mod}, so that they become applicable to all the objects *** of the given class and of their subclasses. The set of attributes of the *** objects appearing in the membership axioms, equations, and rewriting rules *** are completed, so that the default convention of not having to *** exhaustively mention the set of attributes of a class is supported. *** Note that in Meseguer's paper~\cite{Meseguer93b} a parallel hierarchy of *** sorts was defined to deal with objects in different classes, and membership *** axioms constraining the objects to their corresponding sorts were added. *** The transformation could be easily completed with sorts, subsort relations, *** and membership constraints as indicated there. In fact, these declarations *** were added in an initial version and were then removed because they were *** computationally expensive. However, there are examples in which it would *** be interesting to have them; when needed, these declarations can be *** explicitly added by the user in the current version. fmod O-O-TO-SYSTEM-MOD-TRANSF is pr DATABASE . pr DECL-EXT-SORT-TO-QID . pr CONVERSION . var DB : Database . var I : Nat . var MN : ModName . vars ES C C' : ESort . vars ESS ESS' ESS'' : ESortSet . var ETL : ETypeList . vars T T' T'' T''' : Term . var PL : ParameterList . vars EIL EIL' EIL'' : EImportList . vars CDS CDS' : ClassDeclSet . vars ADS ADS' : AttrDeclSet . var ESSDS : ESubsortDeclSet . vars SCDS SCDS' : SubclassDeclSet . var EOPDS : EOpDeclSet . var MDS : MsgDeclSet . vars EMAS EMAS' : EMembAxSet . vars EqS EqS' : EquationSet . vars RlS RlS' : RuleSet . var QIL : QidList . var SS : SortSet . var SSDS : SubsortDeclSet . vars TL TL' : TermList . vars O O' : Term . var U : Unit . var M : Module . vars QI A A' S S' S'' L F : Qid . var V V' : Variable . var CD : ClassDecl . vars SCD SCD' : SubclassDecl . vars Ct Ct' Ct'' : Constant . var Cond : Condition . var AtS : AttrSet . op newVar : ESort Nat -> Variable . eq newVar(ES, I) = qid("V#" + string(I, 10) + ":" + string(eSortToSort(ES))) . *** The function \texttt{prepClasses} completes all classes in the module with *** all the attributes they inherit from their superclasses. op prepClasses : ClassDeclSet SubclassDeclSet EImportList Database -> ClassDeclSet . op prepClasses2 : ClassDeclSet SubclassDeclSet EImportList EImportList Database -> ClassDeclSet . op prepClasses3 : ClassDeclSet SubclassDeclSet -> ClassDeclSet . eq prepClasses(CDS, SCDS, EIL, DB) = prepClasses2(CDS, SCDS, EIL, nil, DB) . eq prepClasses2(CDS, SCDS, ((including MN .) EIL), EIL', DB) = if MN inModNameSet builtIns then prepClasses2(CDS, SCDS, EIL, EIL', DB) else if (including MN . ) in EIL' then prepClasses2(CDS, SCDS, EIL, EIL', DB) else prepClasses2( (getClasses(getTopUnit(MN, DB)) CDS), (getSubclassDecls(getTopUnit(MN, DB)) SCDS), (getImports(getTopUnit(MN, DB)) EIL), ((including MN .) EIL'), DB) fi fi . eq prepClasses2(CDS, SCDS, ((extending MN .) EIL), EIL', DB) = if MN inModNameSet builtIns then prepClasses2(CDS, SCDS, EIL, EIL', DB) else if (extending MN . ) in EIL' then prepClasses2(CDS, SCDS, EIL, EIL', DB) else prepClasses2( (getClasses(getTopUnit(MN, DB)) CDS), (getSubclassDecls(getTopUnit(MN, DB)) SCDS), (getImports(getTopUnit(MN, DB)) EIL), ((extending MN .) EIL'), DB) fi fi . eq prepClasses2(CDS, SCDS, ((protecting MN .) EIL), EIL', DB) = if MN inModNameSet builtIns then prepClasses2(CDS, SCDS, EIL, EIL', DB) else if (protecting MN . ) in EIL' then prepClasses2(CDS, SCDS, EIL, EIL', DB) else prepClasses2( (getClasses(getTopUnit(MN, DB)) CDS), (getSubclassDecls(getTopUnit(MN, DB)) SCDS), (getImports(getTopUnit(MN, DB)) EIL), ((protecting MN .) EIL'), DB) fi fi . eq prepClasses2(CDS, SCDS, nil, EIL, DB) = prepClasses3(CDS, SCDS) . eq prepClasses3(CDS, SCDS) = addAttrs(buildHierarchy(CDS, SCDS, none, empty), SCDS) . sort ClassHierarchy ClassStruct . subsort ClassStruct < ClassHierarchy . op [_,_] : ClassDecl ESortSet -> ClassStruct . op empty : -> ClassHierarchy . op __ : ClassHierarchy ClassHierarchy -> ClassHierarchy [assoc comm id: empty] . op buildHierarchy : ClassDeclSet SubclassDeclSet ESortSet ClassHierarchy -> ClassHierarchy . op addAttrs : ClassHierarchy SubclassDeclSet -> ClassDeclSet . op addAttrsToItsSons : ClassDecl ClassHierarchy SubclassDeclSet -> ClassHierarchy . var CH : ClassHierarchy . var C'' : ESort . eq buildHierarchy(((class C | ADS .) CDS), SCDS, ESS, CH) = if C inSortSet ESS then buildHierarchy(CDS, SCDS, ESS, CH) else buildHierarchy(CDS, SCDS, C ; ESS, [(class C | ADS .), none] CH) fi . eq buildHierarchy(none, (subclass C < C' .) SCDS, ESS, [(class C | ADS .), ESS'] [(class C' | ADS' .), ESS''] CH) = buildHierarchy(none, SCDS, ESS, [(class C | ADS .), C' ; ESS'] [(class C' | ADS' .), ESS''] CH) . eq buildHierarchy(none, none, ESS, CH) = CH . eq addAttrs([(class C | ADS .), none] CH, SCDS) = (class C | ADS .) addAttrs(addAttrsToItsSons((class C | ADS .), CH, SCDS), SCDS) . eq addAttrs(empty, SCDS) = none . eq addAttrsToItsSons((class C | ADS .), [(class C' | ADS' .), C ; ESS] CH, (subclass C' < C .) SCDS) = addAttrsToItsSons((class C | ADS .), [(class C' | ADS, ADS' .), ESS] CH, SCDS) . ceq addAttrsToItsSons((class C | ADS .), CH, (subclass C' < C'' .) SCDS) = addAttrsToItsSons((class C | ADS .), CH, SCDS) if C =/= C'' . eq addAttrsToItsSons((class C | ADS .), CH, none) = CH . op inAttrDeclSet : Qid AttrDeclSet -> Bool . eq inAttrDeclSet(A, ((attr A' : ES), ADS)) = (A == A') or-else inAttrDeclSet(A, ADS) . eq inAttrDeclSet(A, none) = false . *** Given a set of attribute declarations, the \texttt{attributeOpDeclSet} *** function returns a set of operator declarations as indicated above. That *** is, for each attribute $a\texttt{:} S$, an operator of the form *** $a \texttt{\ :\_} \texttt{ :\,\,} S \texttt{ -> Attribute}$ is declared. op attributeOpDeclSet : AttrDeclSet -> OpDeclSet . eq attributeOpDeclSet(((attr A : ES), ADS)) = ((op qid(string(A) + "`:_") : ES -> 'Attribute [gather('&)] .) attributeOpDeclSet(ADS)) . eq attributeOpDeclSet(none) = none . *** The function \texttt{prepLHS} takes the term in the lefthand side of a *** rule, equation, or membership axiom, and replaces each object *** *** $\texttt{<\ }O\texttt{\ :\ }C\texttt{\ |\ }ADS\texttt{\ >}$ *** *** in it---with $O$ of sort \texttt{Oid}, $C$ the name of a class, and $ADS$ *** a set of attributes with their corresponding values---by an object *** *** $\texttt{<\ }O\texttt{\ :\ }V\texttt{\ |\ }ADS\ ADS'\ Atts\texttt{\ >}$ *** *** where the identifier of the class is replaced by a variable $V$ of sort *** $C$, which is not used in the axiom, and where the set of attributes is *** completed with attributes $ADS'$ as indicated in Section~\ref{omod2mod}, so *** that each attribute declared in class $C$ or in any of its superclasses is *** added with a new variable as value. $Atts$ is a new variable of sort *** \texttt{AttributeSet}, which is used to range over the additional *** attributes that may appear in objects of a subclass. *** The function \texttt{prepLHS} takes as arguments a term (in the initial *** call, the term in the lefthand side of a rule, equation, or membership *** axiom), the set of variable declarations of those variables declared in the *** module that are not used in the axiom---new variables are created only if *** there are no variables in the module with the appropriate sort---the set of *** attributes in the* occurrences of the objects---and an index---to make sure *** that the variables being added have not occurrences of the objects---and an *** index---to make sure that the variables being added have not been added *** previously. In the initial call this index is set to zero. \texttt{prepLHS} *** gives as result a tuple composed of the resulting term, the set of objects *** in the term (so that the modification of the objects in the righthand side *** of the rule is simplified), the set of variable declarations corresponding *** to the new added variables, the set of variable declarations of the *** variables in the module that have not been used, and the index for the *** creation of new variables. *** change (03/20/2002): a new variable is created everytime one is needed *** The set of objects in the lefthand side will be given as a set of terms. *** The sort \texttt{TermSet} is defined as a supersort of the sort *** \texttt{Term}, and with constructors \texttt{emptyTermSet} and *** \texttt{termSet} as follows. sort TermSet . subsort Term < TermSet . op emptyTermSet : -> TermSet . op termSet : TermSet TermSet -> TermSet [comm assoc id: emptyTermSet] . *** Terms of sort \texttt{PrepareLHSResult} are built with constructor *** \verb~<_;_;_;_;_>~, and have selectors for their different components. *** change (03/20/2002): <_;_;_;_;_> -> <_;_;_> sort PrepLHSResult . op <_;_;_;_> : TermList TermSet Nat QidList -> PrepLHSResult . op term : PrepLHSResult -> TermList . op objects : PrepLHSResult -> TermSet . op index : PrepLHSResult -> Nat . op messages : PrepLHSResult -> QidList . var TS TS' : TermSet . eq term(< TL ; TS ; I ; QIL >) = TL . eq objects(< TL ; TS ; I ; QIL >) = TS . eq index(< TL ; TS ; I ; QIL >) = I . eq messages(< TL ; TS ; I ; QIL >) = QIL . op prepLHS : TermList ClassDeclSet Nat -> PrepLHSResult . op crtObject : Term ESort AttrDeclSet PrepLHSResult -> PrepLHSResult . op crtObject2 : Term Variable TermList TermList AttrDeclSet TermSet Nat QidList -> PrepLHSResult . op crtObject3 : Term Qid TermList AttrDeclSet TermSet Nat QidList -> PrepLHSResult . eq prepLHS(error(QIL), CDS, I) = < error(QIL) ; emptyTermSet ; I ; nil > . eq prepLHS(F, CDS, I) = < F ; emptyTermSet ; I ; nil > . eq prepLHS(Ct, CDS, I) = < Ct ; emptyTermSet ; I ; nil > . *** \texttt{prepLHS} on a list of terms $\texttt{(}T\texttt{,\ }TL\texttt{)}$, *** with $T$ a term and $TL$ a list of terms, has to make a call to itself with *** $T$ and with $TL$. The call with $TL$ has to be made with the result of *** the call with $T$ so that the variables and the index are right. eq prepLHS((T, TL), CDS, I) = < (term(prepLHS(T, CDS, I)), term(prepLHS(TL, CDS, index(prepLHS(T, CDS, I))))) ; termSet(objects(prepLHS(T, CDS, I)), objects(prepLHS(TL, CDS, index(prepLHS(T, CDS, I))))) ; index(prepLHS(TL, CDS, index(prepLHS(T, CDS, I)))) ; (messages(prepLHS(T, CDS, I)) messages(prepLHS(TL, CDS, index(prepLHS(T, CDS, I))))) > . ceq prepLHS(F[TL], CDS, I) = < F[term(prepLHS(TL, CDS, I))] ; objects(prepLHS(TL, CDS, I)) ; index(prepLHS(TL, CDS, I)) ; messages(prepLHS(TL, CDS, I)) > if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) . ceq prepLHS('<_:_|_>[O, Ct, T], ((class C | ADS .) CDS), I) = crtObject(O, C, ADS, prepLHS(T, ((class C | ADS .) CDS), I)) if myGetName(Ct) == eSortToSort(C) . ceq prepLHS('<_:_|`>[O, Ct], ((class C | ADS .) CDS), I) = crtObject(O, C, ADS, prepLHS('none.AttributeSet, ((class C | ADS .) CDS), I)) if myGetName(Ct) == eSortToSort(C) . eq prepLHS('<_:_|_>[O, V, T], CDS, I) = < '<_:_|_>[O, V, T] ; emptyTermSet ; I ; nil > . *** is this eq necessary? eq prepLHS('<_:_|`>[O, V], CDS, I) = < '<_:_|_>[O, V, 'none.AttributeSet] ; emptyTermSet ; I ; nil > . *** is this eq necessary? eq crtObject(O, C, ADS, < T ; TS ; I ; QIL >) = crtObject2(O, newVar(C, I), T, 'none.AttributeSet, ADS, TS, (I + 1), QIL) . *** The function \texttt{crtObject2} is called with the metarepresentation of *** the list of attributes appearing in the current object (third argument) *** and the set of attribute declarations of the class to which such object *** belongs plus all the attributes declared in its superclasses (fifth *** argument). The function proceeds recursively removing the attribute *** declarations from the set of declarations of attributes for those *** attributes that appear in the object. Each time an attribute is found, it *** is passed with its actual value to the fourth argument of *** \texttt{crtObject2}, which initially has value \verb~'none.AttributeSet~, *** composing a list of terms with them. *** We assume that: *** \begin{itemize} *** \item The metarepresentation of a list of attributes is always given with *** form \verb~'_`,_[F[T], T]~, \verb~F[T]~, or *** \verb~'none.AttributeSet~, where \texttt{TL} is the *** metarepresentation of a list of attributes with the same form (this *** is ensured by the \verb~(e E)~ gathering pattern in the corresponding *** declaration in the signature in which the parsing is done), and *** \item that all the attributes appearing in an object have been declared in *** the corresponding class declaration or in one of its superclasses. *** \end{itemize} eq crtObject2(O, V, '_`,_[F[T], TL], TL', ADS, TS, I, QIL) = crtObject2(O, V, (F[T], TL), TL', ADS, TS, I, QIL) . ceq crtObject2(O, V, (F[T], TL), TL', ((attr A : ES), ADS), TS, I, QIL) = crtObject2(O, V, TL, (F[T], TL'), ADS, TS, I, QIL) if qid(string(A) + "`:_") == F . eq crtObject2(O, V, (F[T], TL), TL', ADS, TS, I, QIL) = crtObject2(O, V, TL, TL', ADS, TS, I, (QIL '\r 'Warning: '\o 'Attribute F 'not 'valid '\n)) [owise] . ceq crtObject2(O, V, F[T], TL, ((attr A : ES), ADS), TS, I, QIL) = crtObject3(O, V, (F[T], TL), ADS, TS, I, QIL) if qid(string(A) + "`:_") == F . eq crtObject2(O, V, F[T], TL, ADS, TS, I, QIL) = crtObject3(O, V, TL, ADS, TS, I, (QIL '\r 'Warning: '\o 'Attribute F 'not 'valid '\n)) [owise] . eq crtObject2(O, V, V', TL, ADS, TS, I, QIL) = crtObject3(O, V, TL, ADS, TS, I, QIL '\r 'Warning: '\o 'Variable 'are 'not 'allowed 'in 'the 'set 'of 'attributes 'of 'an 'object '`( V' '`) '\n) . eq crtObject2(O, V, 'none.AttributeSet, TL, ADS, TS, I, QIL) = crtObject3(O, V, TL, ADS, TS, I, QIL) . *** When the function \texttt{crtObject2} has gone through all the *** attributes in the current object, the function \texttt{crtObject3} is *** in charge of returning the metarepresentation of the current object *** completed with the attributes that did not appear in it. These attributes *** are added with new variables not used in the axiom as value. *** \texttt{crtObject3} returns a pair composed by this resulting object, *** and the set of terms representing all the objects in the lefthand *** side (the current object is added to this set). eq crtObject3(O, V, TL, ((attr A : ES), ADS), TS, I, QIL) = crtObject3(O, V, (qid(string(A) + "`:_")[newVar(ES, I)], TL), ADS, TS, (I + 1), QIL) . eq crtObject3(O, V, TL, none, TS, I, QIL) = < '<_:_|_>[O, V, '_`,_[TL, newVar('AttributeSet, I)]] ; termSet('<_:_|_>[O, V, '_`,_[TL, newVar('AttributeSet, I)]], TS) ; (I + 1) ; QIL > . *** Once the lefthand side of a rule or equation has been `prepared', the *** function \texttt{prepRHS} is called with the set of objects returned by *** \texttt{prepLHS} and the term in the righthand side of such rule or *** equation. The function \texttt{prepRHS} proceeds recursively throughout the *** term looking for objects. Each time an object is found, its set of *** attributes is completed with those in the modified object of the lefthand *** side which do not appear in it. op prepRHS : TermSet TermList -> TermList . op prepRHS : TermSet Condition -> Condition . op adjustObject : TermSet Term -> Term . op adjustObjectRHS : TermSet Term -> [Term] . op adjustAttrsObjectRHS : Term Term -> [Term] . op adjustAttrsObjectRHSAux : TermSet Term -> [Term] . op termAttrListToTermSet : TermList -> TermSet . op _attrInTermSet_ : Qid TermSet -> Bool . eq prepRHS(TS, T = T' /\ Cond) = prepRHS(TS, T) = prepRHS(TS, T') /\ prepRHS(TS, Cond) . eq prepRHS(TS, T : ES /\ Cond) = prepRHS(TS, T) : ES /\ prepRHS(TS, Cond) . eq prepRHS(TS, T := T' /\ Cond) = prepRHS(TS, T) := prepRHS(TS, T') /\ prepRHS(TS, Cond) . eq prepRHS(TS, T => T' /\ Cond) = prepRHS(TS, T) => prepRHS(TS, T') /\ prepRHS(TS, Cond) . eq prepRHS(TS, (nil).Condition) = nil . eq prepRHS(TS, error(QIL)) = error(QIL) . eq prepRHS(TS, F) = F . eq prepRHS(TS, Ct) = Ct . ceq prepRHS(TS, F[TL]) = F[prepRHS(TS, TL)] if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) . eq prepRHS(TS, '<_:_|_>[O, Ct, T]) = adjustObjectRHS(TS, '<_:_|_>[O, Ct, prepRHS(TS, T)]) . eq prepRHS(TS, '<_:_|_>[O, V, T]) = '<_:_|_>[O, V, prepRHS(TS, T)] . eq prepRHS(TS, '<_:_|`>[O, Ct]) = adjustObjectRHS(TS, '<_:_|_>[O, Ct, prepRHS(TS, 'none.AttributeSet)]) . eq prepRHS(TS, '<_:_|`>[O, V]) = '<_:_|_>[O, V, prepRHS(TS, 'none.AttributeSet)] . eq prepRHS(TS, (T, TL)) = (prepRHS(TS, T), prepRHS(TS, TL)) . eq adjustObjectRHS(termSet('<_:_|_>[O, V, T], TS), '<_:_|_>[O', Ct, T']) = if O == O' then if getType(V) == getType(Ct) then '<_:_|_>[O, V, adjustAttrsObjectRHS(T, T')] else '<_:_|_>[O', Ct, T'] fi else adjustObjectRHS(TS, '<_:_|_>[O', Ct, T']) fi . eq adjustObjectRHS(emptyTermSet, '<_:_|_>[O, Ct, T]) = '<_:_|_>[O, Ct, T] . *** eq adjustObjectRHS(termSet('<_:_|_>[Ct, C, T], TS), '<_:_|_>[O, Ct', T']) *** = adjustObjectRHS(TS, '<_:_|_>[O, Ct', T']) . *** eq adjustObjectRHS( *** termSet('<_:_|_>[Ct, C, T], TS), '<_:_|_>[Ct', Ct'', T']) *** = if Ct == Ct' *** then '<_:_|_>[Ct, Ct'', adjustAttrsObjectRHS(T, T')] *** else adjustObjectRHS(TS, '<_:_|_>[Ct', Ct'', T']) *** fi . *** eq adjustObjectRHS(emptyTermSet, '<_:_|_>[Ct, Ct', T]) *** = '<_:_|_>[Ct, Ct', T] . *** The function \texttt{adjustAttrsObjectRHS} completes the set of *** attributes of an object in the righthand side with those in the object in *** the lefthand side or in the class not used in the lefthand side, which *** have been completed by the function \texttt{crtObject}. eq adjustAttrsObjectRHS('_`,_[TL], T) = adjustAttrsObjectRHSAux(termAttrListToTermSet(TL), T) . eq adjustAttrsObjectRHSAux(termSet(A[T], TS), '_`,_[A[T'], T'']) = '_`,_[A[T'], adjustAttrsObjectRHSAux(TS, T'')] . ceq adjustAttrsObjectRHSAux(TS, '_`,_[A[T], T']) = error(A 'is 'not 'a 'valid 'attribute) if not A attrInTermSet TS . eq adjustAttrsObjectRHSAux(termSet(A[T], TS), A[T']) = '_`,_[A[T'], adjustAttrsObjectRHSAux(TS, 'none.AttributeSet)] . ceq adjustAttrsObjectRHSAux(TS, A[T]) = error(A 'is 'not 'a 'valid 'attribute) if not A attrInTermSet TS . eq adjustAttrsObjectRHSAux(termSet(A[T], TS), 'none.AttributeSet) = '_`,_[A[T], adjustAttrsObjectRHSAux(TS, 'none.AttributeSet)] . eq adjustAttrsObjectRHSAux(V, 'none.AttributeSet) = V . eq A attrInTermSet termSet(V, TS) = A attrInTermSet TS . eq A attrInTermSet termSet(A'[T], TS) = (A == A') or-else (A attrInTermSet TS) . eq A attrInTermSet emptyTermSet = false . eq termAttrListToTermSet((T, TL)) = if T == 'none.AttributeSet then termAttrListToTermSet(TL) else termSet(T, termAttrListToTermSet(TL)) fi . eq termAttrListToTermSet(T) = if T == 'none.AttributeSet then emptyTermSet else T fi . *** In the case of equations and rules, the function \texttt{prepAxs} calls the *** function \texttt{prepLHS} with the term in the lefthand side of the axiom, *** and then use the generated set of objects to call the \texttt{prepRHS} *** function. For conditional equations, rules, and membership axioms, this set *** of terms representing the objects in the lefthand side is also used in the *** calls to \texttt{prepRHS} with each of the terms in the conditions. The *** term in the lefthand side of the equation, rule, or membership axiom is *** replaced by the term returned by \texttt{prepLHS}. The index is used in *** the recursive calls to \texttt{prepAxs}. *** \texttt{prepLHS} returns as second argument the set of objects (as a set of *** terms) appearing in it. These objects are returned after extending their *** set of attributes by those of the class to which they belong not already *** specified. op prepAxs : Unit EMembAxSet EquationSet RuleSet ClassDeclSet Nat QidList -> Unit . eq prepAxs(U, ((mb T : ES [AtS] .) EMAS), EqS, RlS, CDS, I, QIL) = prepAxs( addMbs(mb term(prepLHS(T, CDS, I)) : ES [AtS] ., U), EMAS, EqS, RlS, CDS, index(prepLHS(T, CDS, I)), (QIL messages(prepLHS(T, CDS, I)))) . eq prepAxs(U, ((cmb T : ES if Cond [AtS] .) EMAS), EqS, RlS, CDS, I, QIL) = prepAxs( addMbs(cmb term(prepLHS(T, CDS, I)) : ES if prepRHS(objects(prepLHS(T, CDS, I)), Cond) [AtS] ., U), EMAS, EqS, RlS, CDS, index(prepLHS(T, CDS, I)), (QIL messages(prepLHS(T, CDS, I)))) . eq prepAxs(U, EMAS, ((eq T = T' [AtS] .) EqS), RlS, CDS, I, QIL) = prepAxs( addEqs(eq term(prepLHS(T, CDS, I)) = prepRHS(objects(prepLHS(T, CDS, I)), T') [AtS] ., U), EMAS, EqS, RlS, CDS, index(prepLHS(T, CDS, I)), (QIL messages(prepLHS(T, CDS, I)))) . eq prepAxs(U, EMAS, ((ceq T = T' if Cond [AtS] .) EqS), RlS, CDS, I, QIL) = prepAxs( addEqs(ceq term(prepLHS(T, CDS, I)) = prepRHS(objects(prepLHS(T, CDS, I)), T') if prepRHS(objects(prepLHS(T, CDS, I)), Cond) [AtS] ., U), EMAS, EqS, RlS, CDS, index(prepLHS(T, CDS, I)), (QIL messages(prepLHS(T, CDS, I)))) . eq prepAxs(U, EMAS, EqS, ((rl T => T' [AtS] .) RlS), CDS, I, QIL) = prepAxs( addRls(rl term(prepLHS(T, CDS, I)) => prepRHS(objects(prepLHS(T, CDS, I)), T') [AtS] ., U), EMAS, EqS, RlS, CDS, index(prepLHS(T, CDS, I)), (QIL messages(prepLHS(T, CDS, I)))) . eq prepAxs(U, EMAS, EqS, ((crl T => T' if Cond [AtS] .) RlS), CDS, I, QIL) = prepAxs( addRls(crl term(prepLHS(T, CDS, I)) => prepRHS(objects(prepLHS(T, CDS, I)), T') if prepRHS(objects(prepLHS(T, CDS, I)), Cond) [AtS] ., U), EMAS, EqS, RlS, CDS, index(prepLHS(T, CDS, I)), (QIL messages(prepLHS(T, CDS, I)))) . eq prepAxs(U, none, none, none, CDS, I, QIL) = if QIL == nil then U else error(QIL) fi . *** After completing the set of classes in the module with the attributes from *** their superclasses, the function \texttt{omod2mod} calls the function *** \texttt{omod2modAux} with the same module and the set of class *** declarations. The definition of the \texttt{omod2mod} function is given by *** the five equations below. op omod2mod : OUnit Database -> SUnit . op omod2modAux : OUnit ClassDeclSet -> SUnit . eq omod2mod( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom, DB) = omod2modAux( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom, prepClasses(CDS, SCDS, EIL, DB)) . eq omod2mod( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth, DB) = omod2modAux( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth, prepClasses(CDS, SCDS, EIL, DB)) . eq omod2modAux( omod MN is PL EIL sorts ESS . ESSDS ((class C | ADS .) CDS) SCDS EOPDS MDS EMAS EqS RlS endom, CDS') = omod2modAux( omod MN is PL EIL sorts (ESS ; C) . (subsort C < 'Cid . ESSDS) CDS SCDS ((op eSortToSort(C) : nil -> C [none] .) attributeOpDeclSet(ADS) EOPDS) MDS EMAS EqS RlS endom, CDS') . eq omod2modAux( omod MN is PL EIL sorts ESS . ESSDS CDS ((subclass C < C' .) SCDS) EOPDS MDS EMAS EqS RlS endom, CDS') = omod2modAux( omod MN is PL EIL sorts ESS . ((subsort C < C' .) ESSDS) CDS SCDS EOPDS MDS EMAS EqS RlS endom, CDS') . eq omod2modAux( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS ((msg F : ETL -> ES .) MDS) EMAS EqS RlS endom, CDS') = omod2modAux( omod MN is PL EIL sorts ESS . ESSDS CDS SCDS ((op F : ETL -> ES [none] .) EOPDS) MDS EMAS EqS RlS endom, CDS') . eq omod2modAux( omod MN is PL EIL sorts ESS . ESSDS none none EOPDS none EMAS EqS RlS endom, CDS) = prepAxs(mod MN is PL EIL sorts ESS . ESSDS EOPDS none none none endm, EMAS, EqS, RlS, CDS, 0, nil) . eq omod2modAux( oth MN is PL EIL sorts ESS . ESSDS ((class C | ADS .) CDS) SCDS EOPDS MDS EMAS EqS RlS endoth, CDS') = omod2modAux( oth MN is PL EIL sorts (ESS ; C) . (subsort C < 'Cid . ESSDS) CDS SCDS ((op eSortToSort(C) : nil -> C [none] .) attributeOpDeclSet(ADS) EOPDS) MDS EMAS EqS RlS endoth, CDS') . eq omod2modAux( oth MN is PL EIL sorts ESS . ESSDS CDS ((subclass C < C' .) SCDS) EOPDS MDS EMAS EqS RlS endoth, CDS') = omod2modAux( oth MN is PL EIL sorts ESS . ((subsort C < C' .) ESSDS) CDS SCDS EOPDS MDS EMAS EqS RlS endoth, CDS') . eq omod2modAux( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS ((msg F : ETL -> ES .) MDS) EMAS EqS RlS endoth, CDS') = omod2modAux( oth MN is PL EIL sorts ESS . ESSDS CDS SCDS ((op F : ETL -> ES [none] .) EOPDS) MDS EMAS EqS RlS endoth, CDS') . eq omod2modAux( oth MN is PL EIL sorts ESS . ESSDS none none EOPDS none EMAS EqS RlS endoth, CDS) = prepAxs( th MN is PL EIL sorts ESS . ESSDS EOPDS none none none endth, EMAS, EqS, RlS, CDS, 0, nil) . endfm ******************************************************************************* *** *** Evaluation of Modules and Theories *** *** As explained in Section~\ref{evaluation-overview}, in our approach *** transforming a module from its possibly complex structured version to its *** unstructured form is a two-step process. First, all module expressions *** are evaluated, generating an intermediate form in which there are only *** simple inclusion relationships among the modules. This first step can be *** seen as the reduction of a structured specification to its structured *** \emph{normal form}. Then, in a second step, this structured normal form is *** flattened into an unstructured specification. Note, however, that the *** importation of built-in modules is left explicit in the flattened form. *** The function \texttt{normalize} is in charge of normalizing the *** structure. *** The process of evaluation of a preunit has to take into account the *** possibility of bubbles being contained in it. Depending on whether it is *** dealing with a preunit or with a unit, the evaluation process is *** accomplished by two different functions, namely, \texttt{evalPreUnit} and *** \texttt{evalUnit}. One function or the other will be called in each case. *** Evaluating a module already in the database, which is done by *** \texttt{evalUnit}, does not require bubble handling. Besides this *** difference, both functions proceed in a similar way. Before presenting the *** functions \texttt{evalPreUnit} and \texttt{evalUnit} we introduce some *** auxiliary declarations. fmod EVALUATION is pr O-O-TO-SYSTEM-MOD-TRANSF . pr MOD-EXPR-EVAL . pr UNIT-BUBBLE-PARSING . pr DECL-EXT-SORT-TO-QID . sort UnitList . subsort Unit < UnitList . op nil : -> UnitList . op __ : UnitList UnitList -> UnitList [assoc id: nil] . var M : Module . vars PU U U' U'' : Unit . var UL : UnitList . vars DB DB' : Database . vars ME ME' : ModExp . var P : Parameter . vars PL PL' PL'' : ParameterList . vars EIL EIL' EIL'' : EImportList . var CDS : ClassDeclSet . var ESSDS : ESubsortDeclSet . var SCDS : SubclassDeclSet . var EOPD : EOpDecl . vars EOPDS VDS : EOpDeclSet . var MDS : MsgDeclSet . var EMAS : EMembAxSet . var EqS : EquationSet . var RlS : RuleSet . var B : Bool . vars QI QI' S S' V L L' L'' A A' A'' F F' F'' X Y W Z : Qid . vars QIL SL : QidList . var SS : SortSet . vars ES ES' ES'' C C' C'' : ESort . var ET : EType . vars ETL ETL' : ETypeList . vars ESS ESS' : ESortSet . var MN : ModName . var IL : ImportList . var SSDS : SubsortDeclSet . var OPDS : OpDeclSet . vars AtS AtS' : AttrSet . var MAS : MembAxSet . var Rl : Rule . var CD : ClassDecl . var ADS : AttrDeclSet . var MD : MsgDecl . vars T T' T'' T''' : Term . var TL : TermList . var VMAP : ViewMap . var VMAPS : ViewMapSet . vars VE VE' VE'' : ViewExp . *** The \texttt{subunitImports} function returns the list of all the *** subunits of a given unit. It is called with the list of importations of *** the given unit as first argument, and proceeds recursively through its *** structure collecting all the subunits in it. *** The function \texttt{subunitImports} proceeds storing the importations *** considered up to that point, so it does not have to go through the same *** part of the structure more than once. When the function is initially *** called the second argument is set to \texttt{nil}. op subunitImports : EImportList Database -> EImportList . op subunitImports : EImportList EImportList Database -> EImportList . eq subunitImports(EIL, DB) = subunitImports(EIL, nil, DB) . eq subunitImports((including MN . EIL), (EIL' including MN . EIL''), DB) = subunitImports(EIL, (EIL' (including MN .) EIL''), DB) . eq subunitImports((extending MN . EIL), (EIL' extending MN . EIL''), DB) = subunitImports(EIL, (EIL' (extending MN .) EIL''), DB) . eq subunitImports((protecting MN . EIL), (EIL' protecting MN . EIL''), DB) = subunitImports(EIL, (EIL' (protecting MN .) EIL''), DB) . eq subunitImports(((including MN .) EIL), EIL', DB) = if MN inModNameSet builtIns then subunitImports(EIL, ((including MN .) EIL'), DB) else if getTopUnit(MN, DB) :: Unit then subunitImports((getImports(getTopUnit(MN, DB)) EIL), ((including MN .) EIL'), DB) else subunitImports(EIL, EIL', DB) fi fi [owise] . eq subunitImports(((extending MN .) EIL), EIL', DB) = if MN inModNameSet builtIns then subunitImports(EIL, ((extending MN .) EIL'), DB) else if getTopUnit(MN, DB) :: Unit then subunitImports((getImports(getTopUnit(MN, DB)) EIL), ((extending MN .) EIL'), DB) else subunitImports(EIL, EIL', DB) fi fi [owise] . eq subunitImports(((protecting MN .) EIL), EIL', DB) = if MN inModNameSet builtIns then subunitImports(EIL, ((protecting MN .) EIL'), DB) else if getTopUnit(MN, DB) :: Unit then subunitImports((getImports(getTopUnit(MN, DB)) EIL), ((protecting MN .) EIL'), DB) else subunitImports(EIL, EIL', DB) fi fi [owise] . eq subunitImports(nil, EIL, DB) = EIL . *** The function \texttt{getNonBuiltInUnits} returns the list of those units *** in the list of importations given as argument which are not built-in. op getNonBuiltInUnits : EImportList Database -> UnitList . op getNonBuiltInUnits : EImportList UnitList Database -> UnitList . eq getNonBuiltInUnits(EIL, DB) = getNonBuiltInUnits(EIL, nil, DB) . eq getNonBuiltInUnits(((including MN .) EIL), UL, DB) = if MN inModNameSet builtIns then getNonBuiltInUnits(EIL, UL, DB) else getNonBuiltInUnits(EIL, (UL getInternalUnit(MN, DB)), DB) fi . eq getNonBuiltInUnits(((extending MN .) EIL), UL, DB) = if MN inModNameSet builtIns then getNonBuiltInUnits(EIL, UL, DB) else getNonBuiltInUnits(EIL, (UL getInternalUnit(MN, DB)), DB) fi . eq getNonBuiltInUnits(((protecting MN .) EIL), UL, DB) = if MN inModNameSet builtIns then getNonBuiltInUnits(EIL, UL, DB) else getNonBuiltInUnits(EIL, (UL getInternalUnit(MN, DB)), DB) fi . eq getNonBuiltInUnits(EIL, error(QIL), DB) = error(QIL) . eq getNonBuiltInUnits(nil, UL, DB) = UL . *** The function \texttt{selectBuiltInImports} returns the sublist of the *** importations of built-in modules. op selectBuiltInImports : EImportList -> EImportList . eq selectBuiltInImports(((including MN .) EIL)) = if MN inModNameSet builtIns then ((including MN .) selectBuiltInImports(EIL)) else selectBuiltInImports(EIL) fi . eq selectBuiltInImports(((extending MN .) EIL)) = if MN inModNameSet builtIns then ((extending MN .) selectBuiltInImports(EIL)) else selectBuiltInImports(EIL) fi . eq selectBuiltInImports(((protecting MN .) EIL)) = if MN inModNameSet builtIns then ((protecting MN .) selectBuiltInImports(EIL)) else selectBuiltInImports(EIL) fi . eq selectBuiltInImports(nil) = nil . *** The normalization of a structure consists in evaluating each of the module *** expressions appearing in it. Note that, if the \texttt{evalModExp} function *** generates new modules, they will be evaluated using the \texttt{evalUnit} *** function, producing recursive calls on the part of the structure not *** previously normalized. Parameters are handled separatedly. They are *** folded out when analyzing the interface of a module. op normalize : EImportList ParameterList Database -> Database . eq normalize(((including P .) EIL), PL, DB) = normalize(EIL, PL, DB) . eq normalize(((extending P .) EIL), PL, DB) = normalize(EIL, PL, DB) . eq normalize(((protecting P .) EIL), PL, DB) = normalize(EIL, PL, DB) . eq normalize(((including ME .) EIL), PL, DB) = normalize(EIL, PL, evalModExp(ME, PL, DB)) . eq normalize(((extending ME .) EIL), PL, DB) = normalize(EIL, PL, evalModExp(ME, PL, DB)) . eq normalize(((protecting ME .) EIL), PL, DB) = normalize(EIL, PL, evalModExp(ME, PL, DB)) . eq normalize(nil, PL, DB) = DB . *** \texttt{checkSortClashes} checks whether the intersection of the two sets *** of sorts given as arguments is empty or not. If it is nonempty, then there *** is a clash of names, and a warning message is passed to the database. The *** check is very simple, and only reports the name of one of the modules from *** which the sorts come. Only the name of the module from which the sorts *** given as second argument come is known at this point. This is the module *** name given as first argument. *** *** op checkSortClashes : ModName ESortSet ESortSet Database -> Database . *** *** eq checkSortClashes(MN, (ES ; ESS), (ES ; ESS'), DB) *** = checkSortClashes(MN, ESS, ESS', *** warning(DB, *** '\g 'Advisory: '\o *** 'Clash 'of 'sort eSortToSort(ES) 'from modNameToQid(MN) '\n)) . *** ceq checkSortClashes(MN, (ES ; ESS), ESS', DB) *** = checkSortClashes(MN, ESS, ESS', DB) *** if not (ES inSortSet ESS') . *** eq check(MN, none, ESS, DB) = DB . *** In the current system, the only transformation handled by the *** \texttt{transform} function is the one from object-oriented modules to *** system modules, which is accomplished by the *** \texttt{omod2mod} function presented in *** Section~\ref{omod2modfunction}. However, \texttt{transform} has been *** defined as a general transformation that could affect other kinds of *** modules in a future extension. *** Changed 5/5/03: theories are handled internally op transform : Unit Database -> Unit . eq transform(error(QIL), DB) = error(QIL) . ceq transform(U, DB) = U if U : SUnit . ceq transform(U, DB) = omod2mod(U, DB) if U : OUnit /\ not U :: SUnit . *** The function \texttt{signature} generates a functional module of sort *** \texttt{FModule}, without equations, by ``forgetting'' the appropriate *** declarations and converting extended sorts and module names into quoted *** identifiers. op removeIds : EOpDeclSet -> EOpDeclSet . eq removeIds((op F : ETL -> ET [id(T) AtS] .) EOPDS) = (op F : ETL -> ET [AtS] .) removeIds(EOPDS) . eq removeIds(EOPD EOPDS) = EOPD removeIds(EOPDS) [owise] . eq removeIds(none) = none . op signature : Unit -> FModule . eq signature(error(QIL)) = error(QIL) . eq signature(U) = fmod modNameToQid(getName(U)) is getImports(U) sorts eSortToSort(getSorts(U)) . eSortToSort(getSubsorts(U)) eSortToSort(removeIds(getOps(U))) none none endfm [owise] . *** The function \texttt{flatModule} generates a module of sort \texttt{Module} *** by ``forgetting'' declarations and converting extended sorts and module *** identifiers into quoted identifiers. op flatModule : Unit -> Module . eq flatModule(error(QIL)) = error(QIL) . ceq flatModule(U) = if U :: FUnit then (fmod modNameToQid(getName(U)) is getImports(U) sorts eSortToSort(getSorts(U)) . eSortToSort(getSubsorts(U)) eSortToSort(getOps(U)) eSortToSort(getMbs(U)) getEqs(U) endfm) else (mod modNameToQid(getName(U)) is getImports(U) sorts eSortToSort(getSorts(U)) . eSortToSort(getSubsorts(U)) eSortToSort(getOps(U)) eSortToSort(getMbs(U)) getEqs(U) getRls(U) endm) fi if U : Unit . *** error(QIL) is in [Unit] *** The evaluation process for units without bubbles is as follows. After *** normalizing the structure, the function \texttt{evalUnit} calls *** \texttt{evalUnit1} with an empty copy of the module to which the list of *** declarations of importations of built-in modules is added, and with the *** list of its nonbuilt-in subunits. *** \texttt{evalUnit1} accumulates all the declarations in all the nonbuilt-in *** submodules in the copy of the module passed as second argument. The top *** module is then introduced in the database, and, after calling the *** \texttt{transform} function and renaming all the variables in it, the *** internal version of such a module is entered in the database as well. *** Finally, \texttt{evalUnit2} generates the signature and the flat version *** of the module and enters them in the database. *** op evalUnit : Unit Database -> Database . *** moved to MOD-EXPR-EVAL to solve dependency op evalUnit1 : Unit Unit UnitList Database -> Database . op evalUnit2 : Unit Unit Database -> Database . ceq evalUnit(U, DB) = evalUnit1(U, setImports(empty(U), selectBuiltInImports(EIL)), getNonBuiltInUnits(EIL, DB'), DB') if DB' := normalize(getImports(U), getParList(U), DB) /\ EIL := subunitImports(getImports(U), DB') . eq evalUnit(error(QIL), DB) = warning(DB, QIL) . eq evalUnit1(U, U', (U'' UL), DB) = evalUnit1(U, addDecls(U', setImports(U'', nil)), UL, DB) . eq evalUnit1(U, U', nil, DB) = evalUnit2(setImports(transform(U, DB), nil), U', insertInternalUnit(getName(U), transform(U, DB), insertTopUnit(getName(U), U, DB))) . eq evalUnit2(U, U', DB) = insertFlatUnit(getName(U), flatModule(addDecls(U, U')), DB) . *** The function \texttt{evalPreUnit} has to take care of the bubbles in the *** unit. As we explained in Section~\ref{evaluation-overview}, both the *** signature and the flattened version of the module are created *** simultaneously, completing the parsing of the bubbles once the signature *** has been built, and then completing the flattened module. *** The \texttt{evalPreUnit} function takes as arguments two copies of the *** module and a database. We shall see in Section~\ref{unit-processing} how *** these two modules are generated; the one passed as first argument has *** still bubbles in it, while the other one, which will be used to build the *** signature, does not contain any bubbles. This module without bubbles is *** the result of removing the bubbles from the declarations in it, or of *** removing the declarations themselves when they contain bubbles, as in the *** case of equations, for example. *** The \texttt{evalPreUnit} function is quite similar to the function *** \texttt{evalUnit}. First, the structure is normalized by calling the *** \texttt{normalize} function, and then all the subunits in the *** structure are collected (accomplished by \texttt{subunitImports} and *** \texttt{getNonBuiltInUnits}) and the list of importations is updated *** with the sublist of importations of built-in *** modules (\texttt{selectBuiltInImports}). Second, the structure of all the *** subunits below the top is flattened to a single unit. This unit is used to *** create a first version of the signature (without identity elements of *** operators) in which all the bubbles in the top preunit are *** parsed (\texttt{solveBubbles}). The final version of the signature and *** the flat unit are generated once the bubbles have been parsed. The *** `internal' version of the module is also generated by renaming the *** variables in it (\texttt{renameVars}). All these versions of the module *** are finally entered in the database. *** Note that if the \texttt{META-LEVEL} module is imported in the module *** being evaluated, a declaration importing the predefined module *** \texttt{UP} Section~\ref{non-built-in-predefined}) is added. With the *** declarations in this module it will be possible to parse bubbles *** containing calls to the \texttt{up} functions (see *** Section~\ref{structured-specifications}) in them. op evalPreUnit : Unit Unit EOpDeclSet Database -> Database . op evalPreUnit1 : Unit Unit UnitList Unit EOpDeclSet Database -> Database . op evalPreUnit2 : Unit Unit Module EOpDeclSet Database -> Database . op evalPreUnit3 : Unit Unit Module Database -> Database . *** evalPreUnit just calls evalPreUnit1 with a set of the units in the *** structure of the given module. Depending on whether the module is *** importing META-LEVEL or not UP will be added. ***( ceq evalPreUnit(PU, U, VDS, DB) *** PU : top unit with bubbles (preunit) *** U : top unit without bubbles (decls with bubbles were removed) *** VDS : ops corresponding to the vbles in the top unit = if ((including 'META-LEVEL .) in EIL') or-else (((extending 'META-LEVEL .) in EIL') or-else ((protecting 'META-LEVEL .) in EIL')) then evalPreUnit1( addImports((including 'UP .), PU), setName(empty(U), getName(U)), getNonBuiltInUnits((including 'UP .) EIL', DB'), setImports(U, selectBuiltInImports(EIL')), VDS, DB') else evalPreUnit1( PU, setName(empty(U), getName(U)), getNonBuiltInUnits(EIL', DB'), setImports(U, selectBuiltInImports(EIL')), VDS, DB') fi if EIL := getImports(PU) /\ DB' := normalize(EIL, getParList(PU), DB) /\ EIL' := subunitImports(EIL, DB') . ) eq evalPreUnit(PU, U, VDS, DB) *** PU : top unit with bubbles (preunit) *** U : top unit without bubbles (decls with bubbles were removed) *** VDS : ops corresponding to the vbles in the top unit = if ((including 'META-LEVEL .) in subunitImports(getImports(PU), normalize(getImports(PU), getParList(PU), DB))) or-else (((extending 'META-LEVEL .) in subunitImports(getImports(PU), normalize(getImports(PU), getParList(PU), DB))) or-else ((protecting 'META-LEVEL .) in subunitImports(getImports(PU), normalize(getImports(PU), getParList(PU), DB)))) then evalPreUnit1( addImports((including 'UP .), PU), setName(empty(U), getName(U)), getNonBuiltInUnits((including 'UP .) subunitImports(getImports(PU), normalize(getImports(PU), getParList(PU), DB)), normalize(getImports(PU), getParList(PU), DB)), setImports(U, selectBuiltInImports(subunitImports(getImports(PU), normalize(getImports(PU), getParList(PU), DB)))), VDS, normalize(getImports(PU), getParList(PU), DB)) else evalPreUnit1( PU, setName(empty(U), getName(U)), getNonBuiltInUnits(subunitImports(getImports(PU), normalize(getImports(PU), getParList(PU), DB)), normalize(getImports(PU), getParList(PU), DB)), setImports(U, selectBuiltInImports(subunitImports(getImports(PU), normalize(getImports(PU), getParList(PU), DB)))), VDS, normalize(getImports(PU), getParList(PU), DB)) fi . *** evalPreUnit1 joins all the units in the structure into a single unit, *** the one given as second argument; recall that the fourth one is the *** top module without bubbles but with the complete list of subunits *** being imported explicitly eq evalPreUnit1(PU, U, (U' UL), U'', VDS, DB) = evalPreUnit1(PU, addDecls(U, U'), UL, U'', VDS, DB) . ceq evalPreUnit1(PU, U, nil, U', VDS, DB) = evalPreUnit2(PU, U, signature( transform( if protecting 'BOOL . in getImports(U') then addDecls(U', setImports(U, nil)) else addDecls(U', setImports(U, protecting 'BOOL .)) fi, DB)), VDS, DB) if (U :: StrTheory) or (U :: StrModule) . eq evalPreUnit1(PU, error(QIL), UL, U', VDS, DB) = warning(DB, QIL) . eq evalPreUnit1(error(QIL), U, UL, U', VDS, DB) = warning(DB, QIL) . eq evalPreUnit1(PU, U, error(QIL), U', VDS, DB) = warning(DB, QIL) . eq evalPreUnit2(PU, U, M, VDS, DB) *** PU : top module with bubbles *** U : everything below *** M : complete signature (with variables of the top module in it) = evalPreUnit3( solveBubbles(PU, M, ((including 'META-LEVEL .) in getImports(M)), VDS, DB), U, M, insertVbles(getName(PU), VDS, insertTopUnit(getName(PU), solveBubbles(PU, M, ((including 'META-LEVEL .) in getImports(M)), VDS, DB), DB))) . eq evalPreUnit3(PU, U, M, DB) *** PU : top module without bubbles *** U : everything below *** M : complete signature = insertFlatUnit(getName(PU), flatModule(setImports(addDecls(transform(PU, DB), U), getImports(M))), insertInternalUnit(getName(PU), transform(PU, DB), DB)) . eq evalPreUnit3(error(QIL), U, M, DB) = warning(DB, QIL) . endfm ******************************************************************************* *** Note that in both \texttt{evalUnit} and \texttt{evalPreUnit}, the function *** \texttt{transform} has to be invoked to transform the module into a *** functional or system module. In the current system, the only *** transformation available is from object-oriented modules to system modules. *** *** 6.8 Application of Map Sets *** *** The following two modules deal with the application of a set of renaming *** maps to a module. Except for the proof obligations and additional checks *** associated with views---almost none of these checks are performed, and *** none of these proof obligations is generated in the current version---the *** way of applying a renaming map and a view map on a module is the same. *** Internally, they are treated in the same way; the only difference between *** them consists in the way of calling the function to accomplish this *** application. *** Note that there might be some `interference' between sort maps, and *** operator maps and message maps when they are applied. Let us consider for *** example a module with an operator declaration *** *** op f : Foo -> Foo . *** *** and a renaming map set *** *** (sort Foo to Bar, op f : Foo -> Foo to g) *** *** These renamings have to be applied carefully to avoid unintended behaviors. *** Depending on which of the maps is applied first, the other will be *** applicable or not. All the maps must be applied to the original module. *** To avoid the interference between the sort maps and other maps, the map set *** is divided into two sets: The first one contains the sort maps, and the *** second one contains the other maps. *** We assume that there are no ambiguous mappings, that is, that we do not *** have, for example, maps \verb~op f to g~ and \verb~op f to h~. In case of *** such ambiguity, one of the maps will be arbitrarily chosen. *** *** 6.8.1 Map Sets on Terms *** *** The application of a set of view maps to a term is defined in the following *** module \texttt{VIEW-MAP-SET-APPL-ON-TERM}. The function *** \texttt{applyMapSetToTerm} is used to apply a given view map set to terms *** appearing in equations, rules, identity element declarations, and *** membership axioms, as part of the process of applying a map set to a unit. *** Some of the auxiliary functions introduced in this module will also be used *** in the application of maps to operator and message declarations in the *** \texttt{VIEW-MAP-SET-APPL-ON-UNIT} module. fmod VIEW-MAP-SET-APPL-ON-TERM is pr UNIT . pr VIEW-MAP . pr EXT-SORT-TO-QID . var VMAP : ViewMap . vars VMAPS VMAPS' VMAPS'' : ViewMapSet . var M : Module . vars F F' F'' S S' A A' A'' : Qid . vars T T' T'' O : Term . vars TL TL' : TermList . vars ES ES' ES'' C C' C'' : ESort . var ESS : ESortSet . vars ETL ETL' : ETypeList . vars ET ET' : EType . vars Subst Subst' Subst'' : Substitution . var AtS : AttrSet . var OPDS : OpDeclSet . vars V V' : Variable . vars Ct Ct' : Constant . var QIL : QidList . *** The following functions \texttt{applyMapSetToSort} and *** \texttt{applyMapSetToClassSort} apply a set of maps, respectively, to a *** sort a to a class name in its single identifier form, that is, when they *** appear qualifying constants. Functions \texttt{applyMapSetToEType} and *** \texttt{applyMapSetToClassName} are similar but being applied to sort or *** class names in their normal form. op applyMapSetToSort : ViewMapSet Sort -> Sort . eq applyMapSetToSort(((sort ES to ES'), VMAPS), S) = if eSortToSort(ES) == S then eSortToSort(ES') else applyMapSetToSort(VMAPS, S) fi . eq applyMapSetToSort((VMAP, VMAPS), S) = applyMapSetToSort(VMAPS, S) [owise]. eq applyMapSetToSort(none, S) = S . op applyMapSetToSortSet : ViewMapSet ESortSet -> ESortSet . eq applyMapSetToSortSet(VMAPS, (ES ; ESS)) = (applyMapSetToEType(VMAPS, ES) ; applyMapSetToSortSet(VMAPS, ESS)) . eq applyMapSetToSortSet(VMAPS, none) = none . op applyMapSetToEType : ViewMapSet EType -> EType . eq applyMapSetToEType(((sort ES to ES'), VMAPS), ES'') = if ES == ES'' then ES' else applyMapSetToEType(VMAPS, ES'') fi . eq applyMapSetToEType(((sort ES to ES'), VMAPS), kind(ESS)) = applyMapSetToEType(VMAPS, kind(applyMapSetToSortSet(sort ES to ES', ESS))) . eq applyMapSetToEType((VMAP, VMAPS), ET) = applyMapSetToEType(VMAPS, ET) [owise] . eq applyMapSetToEType(none, ET) = ET . op applyMapSetToClassName : ViewMapSet ESort -> ESort . eq applyMapSetToClassName(((class C to C'), VMAPS), C'') = if C == C'' then C' else if eSortToSort(C) == C'' then eSortToSort(C') else applyMapSetToClassName(VMAPS, C'') fi fi . eq applyMapSetToClassName((VMAP, VMAPS), C) = applyMapSetToClassName(VMAPS, C) [owise] . eq applyMapSetToClassName(none, C) = C . op applyMapSetToClassSort : ViewMapSet Sort -> Sort . eq applyMapSetToClassSort(((class C to C'), VMAPS), S) = if eTypeToType(C) == S then eTypeToType(C') else applyMapSetToClassSort(VMAPS, S) fi . eq applyMapSetToClassSort((VMAP, VMAPS), S) = applyMapSetToClassSort(VMAPS, S) [owise] . eq applyMapSetToClassSort(none, S) = S . *** \texttt{} applies a map set to an operator name. op applyOpMapSetToOpId : Qid ViewMapSet -> Qid . eq applyOpMapSetToOpId(F, (op F to F' [AtS])) = F' . eq applyOpMapSetToOpId(F, (op F : ETL -> ET to F' [AtS])) = F' . eq applyOpMapSetToOpId(F, VMAPS) = F [owise] . *** Note that all maps introduced in Sections~\ref{renaming-maps} *** and~\ref{view-maps}, except for label maps, may affect a term. For example, *** sort maps will be applied to the qualifications of terms, and class and *** attribute maps have to be applied to the objects appearing in the term. *** Operator and message maps in which an explicit arity and coarity is given, *** and operator maps going to derived operators (see Section~\ref{Views}) *** must be applied to the complete family of subsort-overloaded operators. *** The function \texttt{applyMapSetToTerm} takes as arguments two sets of *** view maps (the first set for sort maps, and the second for the other maps), *** the term to which the maps will be applied, and a module to be used in the *** matching of terms, sort comparisons, etc. Its declaration is as follows. op applyMapSetToTerm : ViewMapSet ViewMapSet Term Unit -> Term . *** If the term on which the maps have to be applied is not an object, *** different cases have to be considered for each of the possible forms of a *** term. If it is a variable or \texttt{error*}, the same term is returned *** without change (term maps are a special case for this). If it is a sort *** test or a lazy sort test, with forms \verb~T : ES~ and \verb~T :: ES~, *** respectively, the maps are applied to the term \texttt{T} and to the sort *** \texttt{ES}. In case of being of forms \verb~F.S~ or \verb~F[TL]~ with *** \texttt{F} an operator name, \texttt{S} a sort, and \texttt{TL} a list of *** terms, the function \texttt{getRightOpMapSet} will return the subset of *** maps which are applicable on such term. If \texttt{none} is returned then *** no map is applicable. If more than one map is returned then there is an *** ambiguity, and any of them will be arbitrarily taken. The function *** \texttt{imageOfTerm} is called with the term and the maps applicable on *** it and return the image of the term. In case of a term of the form *** \texttt{F[TL]}, \texttt{imageOfTerm} will make recursive calls with the *** arguments in \texttt{TL}. *** The application of a term map to a term requires the `matching' of the *** source term in the map with the term on which the map is applied, and then *** the application of the obtained substitution. Note, however, that a *** complete matching algorithm is not required. Given the form of the pattern *** we can choose before hand the appropriate map, that is, we know that in *** fact there is a match when the function is called. Note also that the map *** has to be applied to the whole family of subsort overloaded operators. We *** just have to check that the sort of the given variable and the *** corresponding term are in the same connected component of sorts. In *** addition to getting the appropriate substitution, the only thing we need *** to check is that there are no variables with different assignments, that *** is, that in case of having a nonlinear pattern, the terms being assigned *** to each variable are equal. We call \texttt{pseudoMatch} to the function *** doing this task. op applyMapSetToTerm : ViewMapSet ViewMapSet TermList Unit -> TermList . op imageOfTerm : ViewMapSet ViewMapSet Term ViewMapSet Module -> Term . op applyMapSetToSubst : ViewMapSet ViewMapSet Substitution Module -> Substitution . op pseudoMatch : TermList TermList Module Substitution -> Substitution . op pseudoMatch2 : TermList TermList Module Substitution -> Substitution . op pseudoMatchResult : Substitution -> Substitution . op pseudoMatchResult : Substitution Assignment Substitution Substitution -> Substitution . op applySubst : TermList Substitution -> TermList . op getRightOpMapSet : Qid ETypeList EType ViewMapSet Module -> ViewMapSet . op applyMapSetToObjectAttrSet : ViewMapSet ViewMapSet ESort Term Module -> Term . op applyMapSetToAttrNameInTerm : ViewMapSet ESort Qid Module -> Qid . eq applyMapSetToTerm(VMAPS, VMAPS', Ct, M) = imageOfTerm(VMAPS, VMAPS', Ct, getRightOpMapSet(myGetName(Ct), nil, getType(Ct), VMAPS', M), M) . eq applyMapSetToTerm(VMAPS, VMAPS', V, M) = qid(string(myGetName(V)) + ":" + string(applyMapSetToSort(VMAPS, getType(V)))) . eq applyMapSetToTerm(VMAPS, VMAPS', error(QIL), M) = error(QIL) . ceq applyMapSetToTerm(VMAPS, VMAPS', F[TL], M) = imageOfTerm(VMAPS, VMAPS', F[TL], getRightOpMapSet(F, termListLeastSort(M, TL), eLeastSort(M, F[TL]), VMAPS', M), M) if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) . eq applyMapSetToTerm(VMAPS, VMAPS', '<_:_|_>[O, Ct, T], M) = '<_:_|_>[applyMapSetToTerm(VMAPS, VMAPS', O, M), qid(string(applyMapSetToClassName(VMAPS', myGetName(Ct))) + "." + string(applyMapSetToClassSort(VMAPS', getType(Ct)))), applyMapSetToObjectAttrSet(VMAPS, VMAPS', myGetName(Ct), T, M)]. ceq applyMapSetToTerm(VMAPS, VMAPS', '<_:_|_>[O, C, T], M) = '<_:_|_>[applyMapSetToTerm(VMAPS, VMAPS', O, M), applyMapSetToClassName(VMAPS', C), applyMapSetToObjectAttrSet(VMAPS, VMAPS', C, T, M)] if not C :: Constant . eq applyMapSetToTerm(VMAPS, VMAPS', '<_:_|`>[O, Ct], M) = '<_:_|_>[applyMapSetToTerm(VMAPS, VMAPS', O, M), qid(string(applyMapSetToClassName(VMAPS', myGetName(Ct))) + "." + string(applyMapSetToClassSort(VMAPS', getType(Ct)))), 'none.AttributeSet] . ceq applyMapSetToTerm(VMAPS, VMAPS', '<_:_|`>[O, C], M) = '<_:_|_>[applyMapSetToTerm(VMAPS, VMAPS', O, M), applyMapSetToClassName(VMAPS', C), 'none.AttributeSet] if not C :: Constant . eq applyMapSetToTerm(VMAPS, VMAPS', (T, TL), M) = (applyMapSetToTerm(VMAPS, VMAPS', T, M), applyMapSetToTerm(VMAPS, VMAPS', TL, M)) . *** Application of a map set to the name of an attribute in an object eq applyMapSetToAttrNameInTerm(((attr A . ES to A'), VMAPS), C, A'', M) = if eSameKind(M, ES, C) and (qid(string(A) + "`:_") == A'') then qid(string(A') + "`:_") else applyMapSetToAttrNameInTerm(VMAPS, C, A'', M) fi . ceq applyMapSetToAttrNameInTerm((VMAP, VMAPS), C, A, M) = applyMapSetToAttrNameInTerm(VMAPS, C, A, M) if not (VMAP :: AttrMap) . eq applyMapSetToAttrNameInTerm(none, S, A, M) = A . *** Selection of all the operator or message maps that are applicable on an *** operator with a given arity and coarity. eq getRightOpMapSet(F, ETL, ET, ((msg F' to F''), VMAPS), M) = getRightOpMapSet(F, ETL, ET, ((op F' to F'' [none]), VMAPS), M) . eq getRightOpMapSet(F, ETL, ET, ((msg F' : ETL' -> ET' to F''), VMAPS), M) = getRightOpMapSet(F, ETL, ET, (op F' : ETL' -> ET' to F'' [none], VMAPS), M) . eq getRightOpMapSet(F, ETL, ET, (op F to F' [AtS], VMAPS), M) = (op F to F' [AtS], getRightOpMapSet(F, ETL, ET, VMAPS, M)) . eq getRightOpMapSet(F, ETL, ET, (op F : ETL' -> ET' to F' [AtS], VMAPS), M) = if eSameKind(M, ETL ET, ETL' ET') then (op F : ETL' -> ET' to F' [AtS], getRightOpMapSet(F, ETL, ET, VMAPS, M)) else getRightOpMapSet(F, ETL, ET, VMAPS, M) fi . eq getRightOpMapSet(F, ETL, ET, (termMap(F[TL], T), VMAPS), M) = if eSameKind(M, ETL, varListSort(TL)) then (termMap(F[TL], T), getRightOpMapSet(F, ETL, ET, VMAPS, M)) else getRightOpMapSet(F, ETL, ET, VMAPS, M) fi . eq getRightOpMapSet(F, ETL, ET, (termMap(Ct, T), VMAPS), M) = if ETL == nil and-then (F == myGetName(Ct) and-then eSameKind(M, ET, getType(Ct))) then (termMap(Ct, T), getRightOpMapSet(F, ETL, ET, VMAPS, M)) else getRightOpMapSet(F, ETL, ET, VMAPS, M) fi . eq getRightOpMapSet(F, ETL, ET, VMAPS, M) = none [owise]. op varListSort : TermList -> ETypeList . eq varListSort((V, TL)) = (getType(V) varListSort(TL)) . eq varListSort(V) = getType(V) . *** Application of a map set to the set of attributes in an object eq applyMapSetToObjectAttrSet(VMAPS, VMAPS', C, '_`,_[A[T], TL], M) = '_`,_[applyMapSetToAttrNameInTerm(VMAPS', C, A, M) [applyMapSetToTerm(VMAPS, VMAPS', T, M)], applyMapSetToObjectAttrSet(VMAPS, VMAPS', C, TL, M)] . eq applyMapSetToObjectAttrSet(VMAPS, VMAPS', C, A[T], M) = applyMapSetToAttrNameInTerm(VMAPS', C, A, M) [applyMapSetToTerm(VMAPS, VMAPS', T, M)] . eq applyMapSetToObjectAttrSet(VMAPS, VMAPS', C, '_`,_['none.AttributeSet, TL], M) = '_`,_['none.AttributeSet, applyMapSetToObjectAttrSet(VMAPS, VMAPS', C, TL, M)] . eq applyMapSetToObjectAttrSet(VMAPS, VMAPS', C, 'none.AttributeSet, M) = 'none.AttributeSet . *** Image of a term eq imageOfTerm(VMAPS, VMAPS', Ct, none, M) = qid(string(myGetName(Ct)) + "." + string(applyMapSetToSort(VMAPS, getType(Ct)))) . eq imageOfTerm(VMAPS, VMAPS', F[TL], none, M) = F [ applyMapSetToTerm(VMAPS, VMAPS', TL, M) ] . eq imageOfTerm(VMAPS, VMAPS', F[TL], ((op F to F' [AtS]), VMAPS''), M) = F' [ applyMapSetToTerm(VMAPS, VMAPS', TL, M) ] . eq imageOfTerm(VMAPS, VMAPS', F[TL], (op F : ETL -> ES to F'[AtS],VMAPS''),M) = F' [ applyMapSetToTerm(VMAPS, VMAPS', TL, M) ] . eq imageOfTerm(VMAPS, VMAPS', T, (termMap(T', T''), VMAPS''), M) = applySubst(T'', applyMapSetToSubst(VMAPS, VMAPS', pseudoMatch(T', T, M, none), M)) . ceq imageOfTerm(VMAPS, VMAPS', Ct, ((op F to F' [AtS]), VMAPS''), M) = qid(string(F') + "." + string(applyMapSetToSort(VMAPS, getType(Ct)))) if myGetName(Ct) = F . ceq imageOfTerm(VMAPS, VMAPS', Ct, (op F : ETL -> ES to F' [AtS], VMAPS''),M) = qid(string(F') + "." + string(applyMapSetToSort(VMAPS, getType(Ct)))) if myGetName(Ct) = F . *** Application of a Substitution on a term eq applySubst(T, none) = T . eq applySubst(V, ((V' <- T) ; Subst)) = if myGetName(V) == myGetName(V') then T else applySubst(V, Subst) fi . eq applySubst(F[TL], Subst) = F[applySubst(TL, Subst)] . eq applySubst(Ct, Subst) = Ct . eq applySubst((T, TL), Subst) = (applySubst(T, Subst), applySubst(TL,Subst)). *** PseudoMatch eq pseudoMatch(T, T', M, Subst) = pseudoMatchResult(pseudoMatch2(T, T', M, Subst)) . eq pseudoMatch2(Ct, Ct', M, Subst) = none . eq pseudoMatch2(F[TL], F'[TL'], M, Subst) = if F == F' then pseudoMatch2(TL, TL', M, Subst) else none fi . eq pseudoMatch2((V, TL), (T, TL'), M, Subst) = if sameKind(M, getType(V), leastSort(M, T)) then pseudoMatch2(TL, TL', M, (V <- T ; Subst)) else none fi . eq pseudoMatch2(V, T, M, Subst) = if sameKind(M, getType(V), leastSort(M, T)) then (V <- T ; Subst) else none fi . *** pseudoMatchResult detects conflicts and eliminates duplicates eq pseudoMatchResult((V <- T) ; Subst) = pseudoMatchResult(none, (V <- T), none, Subst) . eq pseudoMatchResult(Subst, (V <- T), Subst', (V' <- T') ; Subst'') = if V == V' then if T == T' then pseudoMatchResult(Subst, (V <- T), Subst', Subst'') else none fi else pseudoMatchResult(Subst, (V <- T), Subst' ; (V' <- T'), Subst'') fi . eq pseudoMatchResult(Subst, (V <- T), (V' <- T') ; Subst', none) = pseudoMatchResult(Subst ; (V <- T), (V' <- T'), none, Subst') . eq pseudoMatchResult(Subst, (V <- T), none, none) = (Subst ; (V <- T)) . *** Application of a set of maps to a substitution eq applyMapSetToSubst(VMAPS, VMAPS', ((V <- T) ; Subst), M) = ((applyMapSetToTerm(VMAPS, VMAPS', V, M) <- applyMapSetToTerm(VMAPS, VMAPS', T, M)) ; applyMapSetToSubst(VMAPS, VMAPS', Subst, M)) . eq applyMapSetToSubst(VMAPS, VMAPS', none, M) = none . endfm ******************************************************************************* *** We do not include here the equations defining the semantics of the function *** \texttt{applyMapSetToTerm}. Instead, we present an example illustrating *** the meaning of the function. Renaming maps and view maps were already *** discussed in Sections~\ref{Views} and~\ref{module-expressions}. *** Let us consider the following configuration in the module *** \texttt{STACK2[Accnt]} presented in Section~\ref{module-expressions}. In *** this configuration we have objects in the class \texttt{Accnt} which *** represent the accounts of different clients of a bank, which is *** represented as an object \texttt{'bank} of class \texttt{Stack[Accnt]}. *** The object \texttt{'bank} in the example configuration below keeps a stack *** with the accounts of the bank represented as a linked list of nodes, each *** of which corresponds to the account of one of the clients. *** ('bank push 'john) *** ('peter elt 2000) *** < 'bank : Stack[Accnt] | first : o ('bank, 1) > *** < 'paul : Accnt | bal : 5000 > *** < 'peter : Accnt | bal : 2000 > *** < 'mary : Accnt | bal : 7200 > *** < 'john : Accnt | bal : 100 > *** < o('bank, 0) : Node[Accnt] | node : 'peter, next : null > *** < o('bank, 1) : Node[Accnt] | node : 'mary, next : o('bank, 0) > . *** *** Let us apply the following renaming to the previous term. *** *** (op o to id, *** class Stack[Accnt] to Bank, *** msg _push_ : Oid Oid -> Msg to open`account`in_to_, *** msg _pop to close`account`of_, *** msg _elt_ to _owns_dollars, *** attr node . Node[Accnt] to client, *** attr bal . Accnt to balance) *** *** The resulting term is as follows. *** *** (open account in 'bank to 'john) *** ('peter owns 2000 dollars) *** < 'bank : Bank | first : id('bank, 1) > *** < 'paul : Accnt | balance : 5000 > *** < 'peter : Accnt | balance : 2000 > *** < 'mary : Accnt | balance : 7200 > *** < 'john : Accnt | balance : 100 > *** < id('bank, 0) : Node[Accnt] | client : 'peter, next : null > *** < id('bank, 1) : Node[Accnt] | client : 'mary, next : id('bank, 0) > *** The function \texttt{applyMapSetToTerm} treats the object constructor *** \verb~<_:_|_>~ in a special way. It cannot be renamed, and, when an *** occurrence of such a constructor is found, class and attribute maps require *** a particular handling. Inside terms these maps are only triggered when *** this constructor is found, and they are applied in a very restricted way, *** according to the general pattern for objects. We assume that the operator *** \verb~<_:_|_>~ is only used for objects and that objects constructed using *** it are well-formed. *** *** 6.8.2 Map Sets on Units *** *** The application of view maps to modules and theories of the different types *** is defined in the following module \texttt{VIEW-MAP-SET-APPL-ON-UNIT}. The *** function \texttt{applyMapSetToUnit} is defined recursively by applying it *** to the different components of a unit. When the terms in the different *** declarations are reached, the function \texttt{applyMapSetToTerm} is *** called. This call is made with the set of maps split conveniently, as *** explained above. fmod VIEW-MAP-SET-APPL-ON-UNIT is pr VIEW-MAP-SET-APPL-ON-TERM . pr INT-LIST . op applyMapSetToUnit : ViewMapSet Unit Unit -> Unit . op applyMapSetToUnit2 : ViewMapSet ViewMapSet ViewMapSet Unit Module -> Unit . op applyMapSetToUnit3 : ViewMapSet ViewMapSet Unit Module -> Unit . op applyMapSetToTypeList : ViewMapSet ETypeList -> ETypeList . op applyMapSetToSubsortDeclSet : ViewMapSet ESubsortDeclSet -> ESubsortDeclSet . op applyMapSetToOpDeclSet : ViewMapSet ViewMapSet EOpDeclSet Module -> EOpDeclSet . op applyMapSetToOpDecl : ViewMapSet ViewMapSet ViewMapSet EOpDecl Module -> EOpDecl . op applyMapSetToAttrSet : ViewMapSet ViewMapSet AttrSet Unit -> AttrSet . op applyMapToAttrSet : ViewMap AttrSet -> AttrSet . op applyMapToAttrSetAux : AttrSet AttrSet AttrSet -> AttrSet . op applyMapSetToHookList : ViewMapSet ViewMapSet HookList Module -> HookList . op applyMapSetToHookListAux : ViewMapSet ViewMapSet Hook Module -> Hook . op applyMapSetToMbSet : ViewMapSet ViewMapSet EMembAxSet Unit -> EMembAxSet . op applyMapSetToEqSet : ViewMapSet ViewMapSet EquationSet Unit -> EquationSet . op applyMapSetToRlSet : ViewMapSet ViewMapSet RuleSet Unit -> RuleSet . op applyMapSetToCond : ViewMapSet ViewMapSet Condition Unit -> Condition . op applyMapSetToLabel : ViewMapSet Qid -> Qid . op applyMapSetToClassDeclSet : ViewMapSet ViewMapSet ClassDeclSet -> ClassDeclSet . op applyMapSetToSubclassDeclSet : ViewMapSet SubclassDeclSet -> SubclassDeclSet . op applyMapSetToMsgDeclSet : ViewMapSet ViewMapSet MsgDeclSet Module -> MsgDeclSet . op applyMapSetToMsgDecl : ViewMapSet ViewMapSet MsgDecl Module -> MsgDecl . op applyMapSetToAttrName : ViewMapSet ESort Qid -> Qid . op applyMapSetToAttrDeclSet : ViewMapSet ViewMapSet ESort AttrDeclSet -> AttrDeclSet . var M : Module . var U : Unit . vars QI QI' QI'' S S' L L' L'' F F' F'' A A' A'' : Qid . vars V V' : Variable . vars QIL QIL' : QidList . var VE : ViewExp . var MN : ModName . var PL : ParameterList . var EIL : EImportList . var IL : ImportList . vars ES ES' ES'' C C' C'' : ESort . var ET : EType . vars ETL ETL' : ETypeList . var SS : ESortSet . var ESS : ESortSet . var SSDS : SubsortDeclSet . var ESSDS : ESubsortDeclSet . var OPDS : OpDeclSet . var EOPDS : EOpDeclSet . var MAS : MembAxSet . var EMAS : EMembAxSet . var EqS : EquationSet . var RlS : RuleSet . var CDS : ClassDeclSet . var SCDS : SubclassDeclSet . var MDS : MsgDeclSet . var ADS : AttrDeclSet . vars T T' T'' T''' O : Term . vars TL TL' : TermList . var At : Attr . vars AtS AtS' AtS'' : AttrSet . vars I I' : Nat . vars NL NL' : IntList . var H : Hook . var HL : HookList . var VMAP : ViewMap . vars VMAPS VMAPS' VMAPS'' : ViewMapSet . var Subst : Substitution . var Cond : Condition . var St : String . eq applyMapSetToUnit(VMAPS, U, M) = applyMapSetToUnit2(VMAPS, none, none, U, M) . eq applyMapSetToUnit(VMAPS, U, error(QIL)) = error(QIL) . *** To avoid the interference between the sort maps with other maps, the map *** set is divided in two sets by \texttt{applyMapSetToUnit2}. When *** \texttt{applyMapSetToUnit3} is called, its first argument contains the *** sort maps, and the second one contains the rest. eq applyMapSetToUnit2((VMAP, VMAPS), VMAPS', VMAPS'', U, M) = if VMAP :: SortMap then applyMapSetToUnit2(VMAPS, (VMAP, VMAPS'), VMAPS'', U, M) else applyMapSetToUnit2(VMAPS, VMAPS', (VMAP, VMAPS''), U, M) fi . eq applyMapSetToUnit2(none, VMAPS, VMAPS', U, M) = applyMapSetToUnit3(VMAPS, VMAPS', U, M) . eq applyMapSetToUnit3(VMAPS, VMAPS', mod MN is IL sorts SS . SSDS OPDS MAS EqS RlS endm, M) = mod MN is IL sorts applyMapSetToSortSet(VMAPS, SS) . applyMapSetToSubsortDeclSet(VMAPS, SSDS) applyMapSetToOpDeclSet(VMAPS, VMAPS', OPDS, M) applyMapSetToMbSet(VMAPS, VMAPS', MAS, M) applyMapSetToEqSet(VMAPS, VMAPS', EqS, M) applyMapSetToRlSet(VMAPS, VMAPS', RlS, M) endm . eq applyMapSetToUnit3(VMAPS, VMAPS', mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm, M) = mod MN is PL EIL sorts applyMapSetToSortSet(VMAPS, ESS) . applyMapSetToSubsortDeclSet(VMAPS, ESSDS) applyMapSetToOpDeclSet(VMAPS, VMAPS', EOPDS, M) applyMapSetToMbSet(VMAPS, VMAPS', EMAS, M) applyMapSetToEqSet(VMAPS, VMAPS', EqS, M) applyMapSetToRlSet(VMAPS, VMAPS', RlS, M) endm . eq applyMapSetToUnit3(VMAPS, VMAPS', th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth, M) = th MN is PL EIL sorts applyMapSetToSortSet(VMAPS, ESS) . applyMapSetToSubsortDeclSet(VMAPS, ESSDS) applyMapSetToOpDeclSet(VMAPS, VMAPS', EOPDS, M) applyMapSetToMbSet(VMAPS, VMAPS', EMAS, M) applyMapSetToEqSet(VMAPS, VMAPS', EqS, M) applyMapSetToRlSet(VMAPS, VMAPS', RlS, M) endth . eq applyMapSetToUnit3(VMAPS, VMAPS', fmod MN is IL sorts SS . SSDS OPDS MAS EqS endfm, M) = fmod MN is IL sorts applyMapSetToSortSet(VMAPS, SS) . applyMapSetToSubsortDeclSet(VMAPS, SSDS) applyMapSetToOpDeclSet(VMAPS, VMAPS', OPDS, M) applyMapSetToMbSet(VMAPS, VMAPS', MAS, M) applyMapSetToEqSet(VMAPS, VMAPS', EqS, M) endfm . eq applyMapSetToUnit3(VMAPS, VMAPS', fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm, M) = fmod MN is PL EIL sorts applyMapSetToSortSet(VMAPS, ESS) . applyMapSetToSubsortDeclSet(VMAPS, ESSDS) applyMapSetToOpDeclSet(VMAPS, VMAPS', EOPDS, M) applyMapSetToMbSet(VMAPS, VMAPS', EMAS, M) applyMapSetToEqSet(VMAPS, VMAPS', EqS, M) endfm . eq applyMapSetToUnit3(VMAPS, VMAPS', fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth, M) = fth MN is PL EIL sorts applyMapSetToSortSet(VMAPS, ESS) . applyMapSetToSubsortDeclSet(VMAPS, ESSDS) applyMapSetToOpDeclSet(VMAPS, VMAPS', EOPDS, M) applyMapSetToMbSet(VMAPS, VMAPS', EMAS, M) applyMapSetToEqSet(VMAPS, VMAPS', EqS, M) endfth . eq applyMapSetToUnit3(VMAPS, VMAPS', omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom, M) = omod MN is PL EIL sorts applyMapSetToSortSet(VMAPS, ESS) . applyMapSetToSubsortDeclSet(VMAPS, ESSDS) applyMapSetToClassDeclSet(VMAPS, VMAPS', CDS) applyMapSetToSubclassDeclSet(VMAPS', SCDS) applyMapSetToOpDeclSet(VMAPS, VMAPS', EOPDS, M) applyMapSetToMsgDeclSet(VMAPS, VMAPS', MDS, M) applyMapSetToMbSet(VMAPS, VMAPS', EMAS, M) applyMapSetToEqSet(VMAPS, VMAPS', EqS, M) applyMapSetToRlSet(VMAPS, VMAPS', RlS, M) endom . eq applyMapSetToUnit3(VMAPS, VMAPS', oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth, M) = oth MN is PL EIL sorts applyMapSetToSortSet(VMAPS, ESS) . applyMapSetToSubsortDeclSet(VMAPS, ESSDS) applyMapSetToClassDeclSet(VMAPS, VMAPS', CDS) applyMapSetToSubclassDeclSet(VMAPS', SCDS) applyMapSetToOpDeclSet(VMAPS, VMAPS', EOPDS, M) applyMapSetToMsgDeclSet(VMAPS, VMAPS', MDS, M) applyMapSetToMbSet(VMAPS, VMAPS', EMAS, M) applyMapSetToEqSet(VMAPS, VMAPS', EqS, M) applyMapSetToRlSet(VMAPS, VMAPS', RlS, M) endoth . eq applyMapSetToOpDeclSet(VMAPS, VMAPS', (op F : ETL -> ET [AtS] . EOPDS), M) = (applyMapSetToOpDecl(VMAPS, getRightOpMapSet(F, ETL, ET, VMAPS', M), VMAPS', (op F : ETL -> ET [AtS] .), M) applyMapSetToOpDeclSet(VMAPS, VMAPS', EOPDS, M)) . eq applyMapSetToOpDeclSet(VMAPS, VMAPS', none, M) = none . eq applyMapSetToOpDecl(VMAPS, (VMAP, VMAPS'), VMAPS'', (op F : ETL -> ET [AtS] .), M) *** In case of ambiguous mappings we take one of them arbitrarily = (op applyOpMapSetToOpId(F, VMAP) : applyMapSetToTypeList(VMAPS, ETL) -> applyMapSetToEType(VMAPS, ET) [applyMapSetToAttrSet(VMAPS, VMAPS'', applyMapToAttrSet(VMAP, AtS), M)] .) . eq applyMapSetToOpDecl(VMAPS, none, VMAPS', (op F : ETL -> ET [AtS] .), M) *** No map for this declaration = (op F : applyMapSetToTypeList(VMAPS, ETL) -> applyMapSetToEType(VMAPS, ET) [applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)] .) . eq applyMapSetToMsgDeclSet(VMAPS, VMAPS', ((msg F : ETL -> ET .) MDS), M) = (applyMapSetToMsgDecl(VMAPS, getRightOpMapSet(F, ETL, ET, VMAPS', M), (msg F : ETL -> ET .), M) applyMapSetToMsgDeclSet(VMAPS, VMAPS', MDS, M)) . eq applyMapSetToMsgDeclSet(VMAPS, VMAPS', none, M) = none . eq applyMapSetToMsgDecl(VMAPS, (VMAP, VMAPS'), (msg F : ETL -> ET .), M) *** In case of ambiguous mappings we take one of them arbitrarily = (msg applyOpMapSetToOpId(F, VMAP) : applyMapSetToTypeList(VMAPS, ETL) -> applyMapSetToEType(VMAPS, ET) .) . eq applyMapSetToMsgDecl(VMAPS, none, (msg F : ETL -> ET .), M) *** No map for this declaration = (msg F : applyMapSetToTypeList(VMAPS, ETL) -> applyMapSetToEType(VMAPS, ET) .) . *** The function \texttt{applyMapToAttrSet} just takes care of changing the *** attributes of the operators as indicated in the renamings. The renamings *** properly said is accomplished by the function *** \texttt{applyMapSetToAttrSet}. eq applyMapToAttrSet((msg F to F'), AtS) = AtS . eq applyMapToAttrSet((msg F : ETL -> ET to F'), AtS) = AtS . eq applyMapToAttrSet(termMap(T, T'), AtS) = AtS . eq applyMapToAttrSet((op F to F' [AtS]), AtS') = if AtS == none then AtS' else applyMapToAttrSetAux(AtS, AtS', none) fi . eq applyMapToAttrSet((op F : ETL -> ET to F' [AtS]), AtS') = if AtS == none then AtS' else applyMapToAttrSetAux(AtS, AtS', none) fi . eq applyMapToAttrSetAux((gather(QIL) AtS), (gather(QIL') AtS'), AtS'') = applyMapToAttrSetAux(AtS, (gather(QIL) AtS' AtS''), none) . eq applyMapToAttrSetAux((gather(QIL) AtS), (format(QIL') AtS'), AtS'') = applyMapToAttrSetAux((gather(QIL) AtS), AtS', (format(QIL') AtS'')) . eq applyMapToAttrSetAux((gather(QIL) AtS), (prec(I) AtS'), AtS'') = applyMapToAttrSetAux((gather(QIL) AtS), AtS', (prec(I) AtS'')) . eq applyMapToAttrSetAux((gather(QIL) AtS), (strat(NL) AtS'), AtS'') = applyMapToAttrSetAux((gather(QIL) AtS), AtS', (strat(NL) AtS'')) . eq applyMapToAttrSetAux((gather(QIL) AtS), (frozen(NL) AtS'), AtS'') = applyMapToAttrSetAux((gather(QIL) AtS), AtS', (frozen(NL) AtS'')) . eq applyMapToAttrSetAux((format(QIL) AtS), (format(QIL') AtS'), AtS'') = applyMapToAttrSetAux(AtS, (format(QIL) AtS' AtS''), none) . eq applyMapToAttrSetAux((format(QIL) AtS), (gather(QIL') AtS'), AtS'') = applyMapToAttrSetAux((format(QIL) AtS), AtS', (gather(QIL') AtS'')) . eq applyMapToAttrSetAux((format(QIL) AtS), (prec(I) AtS'), AtS'') = applyMapToAttrSetAux((format(QIL) AtS), AtS', (prec(I) AtS'')) . eq applyMapToAttrSetAux((format(QIL) AtS), (strat(NL) AtS'), AtS'') = applyMapToAttrSetAux((format(QIL) AtS), AtS', (strat(NL) AtS'')) . eq applyMapToAttrSetAux((format(QIL) AtS), (frozen(NL) AtS'), AtS'') = applyMapToAttrSetAux((format(QIL) AtS), AtS', (frozen(NL) AtS'')) . eq applyMapToAttrSetAux((prec(I) AtS), (prec(I') AtS'), AtS'') = applyMapToAttrSetAux(AtS, (prec(I) AtS' AtS''), none) . eq applyMapToAttrSetAux((prec(I) AtS), (format(QIL) AtS'), AtS'') = applyMapToAttrSetAux((prec(I) AtS), AtS', (format(QIL) AtS'')) . eq applyMapToAttrSetAux((prec(I) AtS), (gather(QIL) AtS'), AtS'') = applyMapToAttrSetAux((prec(I) AtS), AtS', (gather(QIL) AtS'')) . eq applyMapToAttrSetAux((prec(I) AtS), (strat(NL) AtS'), AtS'') = applyMapToAttrSetAux((prec(I) AtS), AtS', (strat(NL) AtS'')) . eq applyMapToAttrSetAux((prec(I) AtS), (frozen(NL) AtS'), AtS'') = applyMapToAttrSetAux((prec(I) AtS), AtS', (frozen(NL) AtS'')) . eq applyMapToAttrSetAux((strat(NL) AtS), (strat(NL') AtS'), AtS'') = applyMapToAttrSetAux(AtS, (strat(NL) AtS' AtS''), none) . eq applyMapToAttrSetAux((strat(NL) AtS), (gather(QIL) AtS'), AtS'') = applyMapToAttrSetAux((strat(NL) AtS), AtS', (gather(QIL) AtS'')) . eq applyMapToAttrSetAux((strat(NL) AtS), (prec(I) AtS'), AtS'') = applyMapToAttrSetAux((strat(NL) AtS), AtS', (prec(I) AtS'')) . eq applyMapToAttrSetAux((strat(NL) AtS), (format(QIL) AtS'), AtS'') = applyMapToAttrSetAux((strat(NL) AtS), AtS', (format(QIL) AtS'')) . eq applyMapToAttrSetAux((strat(NL) AtS), (frozen(NL) AtS'), AtS'') = applyMapToAttrSetAux((strat(NL) AtS), AtS', (frozen(NL) AtS'')) . eq applyMapToAttrSetAux((At AtS), (assoc AtS'), AtS'') = applyMapToAttrSetAux((At AtS), AtS', (assoc AtS'')) . eq applyMapToAttrSetAux((At AtS), (comm AtS'), AtS'') = applyMapToAttrSetAux((At AtS), AtS', (comm AtS'')) . eq applyMapToAttrSetAux((At AtS), (idem AtS'), AtS'') = applyMapToAttrSetAux((At AtS), AtS', (idem AtS'')) . eq applyMapToAttrSetAux((At AtS), (id(T) AtS'), AtS'') = applyMapToAttrSetAux((At AtS), AtS', (id(T) AtS'')) . eq applyMapToAttrSetAux((At AtS), (left-id(T) AtS'), AtS'') = applyMapToAttrSetAux((At AtS), AtS', (left-id(T) AtS'')) . eq applyMapToAttrSetAux((At AtS), (right-id(T) AtS'), AtS'') = applyMapToAttrSetAux((At AtS), AtS', (right-id(T) AtS'')) . eq applyMapToAttrSetAux((At AtS), (memo AtS'), AtS'') = applyMapToAttrSetAux((At AtS), AtS', (memo AtS'')) . eq applyMapToAttrSetAux((At AtS), (ctor AtS'), AtS'') = applyMapToAttrSetAux((At AtS), AtS', (ctor AtS'')) . eq applyMapToAttrSetAux((At AtS), (iter AtS'), AtS'') = applyMapToAttrSetAux((At AtS), AtS', (iter AtS'')) . *** eq applyMapToAttrSetAux((At AtS), (ditto AtS'), AtS'') *** = applyMapToAttrSetAux((At AtS), AtS', (ditto AtS'')) . eq applyMapToAttrSetAux((At AtS), (special(HL) AtS'), AtS'') = applyMapToAttrSetAux((At AtS), AtS', (special(HL) AtS'')) . eq applyMapToAttrSetAux((At AtS), none, AtS') = applyMapToAttrSetAux(AtS, (At AtS'), none) . eq applyMapToAttrSetAux(none, AtS, none) = AtS . eq applyMapSetToTypeList(VMAPS, (ET ETL)) = (applyMapSetToEType(VMAPS, ET) applyMapSetToTypeList(VMAPS, ETL)) . eq applyMapSetToTypeList(VMAPS, nil) = nil . eq applyMapSetToSubsortDeclSet(VMAPS, ((subsort ES < ES' .) ESSDS)) = ((subsort applyMapSetToEType(VMAPS, ES) < applyMapSetToEType(VMAPS, ES') .) applyMapSetToSubsortDeclSet(VMAPS, ESSDS)) . eq applyMapSetToSubsortDeclSet(VMAPS, none) = none . eq applyMapSetToAttrSet(VMAPS, VMAPS', (assoc AtS), M) = (assoc applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (ctor AtS), M) = (ctor applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (memo AtS), M) = (memo applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (frozen(NL) AtS), M) = (frozen(NL) applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (iter AtS), M) = (iter applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (idem AtS), M) = (idem applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (comm AtS), M) = (comm applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (id(T) AtS), M) = (id(applyMapSetToTerm(VMAPS, VMAPS', T, M)) applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (left-id(T) AtS), M) = (left-id(applyMapSetToTerm(VMAPS, VMAPS', T, M)) applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (right-id(T) AtS), M) = (right-id(applyMapSetToTerm(VMAPS, VMAPS', T, M)) applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (strat(NL) AtS), M) = (strat(NL) applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (prec(I) AtS), M) = (prec(I) applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (gather(QIL) AtS), M) = (gather(QIL) applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (format(QIL) AtS), M) = (format(QIL) applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (special(HL) AtS), M) = (special(applyMapSetToHookList(VMAPS, VMAPS', HL, M)) applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (label(L) AtS), M) = (label(applyMapSetToLabel(VMAPS, L)) applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (metadata(St) AtS), M) = (metadata(St) applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (nonexec AtS), M) = (nonexec applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', (owise AtS), M) = (owise applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)) . eq applyMapSetToAttrSet(VMAPS, VMAPS', none, M) = none . eq applyMapSetToHookList(VMAPS, VMAPS', (H HL), M) = (applyMapSetToHookList(VMAPS, VMAPS', H, M) applyMapSetToHookList(VMAPS, VMAPS', HL, M)) . eq applyMapSetToHookList(VMAPS, VMAPS', id-hook(QI, QIL), M) = id-hook(QI, QIL) . eq applyMapSetToHookList(VMAPS, VMAPS', op-hook(QI, QI', QIL, QI''), M) = applyMapSetToHookListAux(VMAPS, getRightOpMapSet(QI', QIL, QI'', VMAPS', M), op-hook(QI, QI', QIL, QI''), M) . eq applyMapSetToHookList(VMAPS, VMAPS', term-hook(QI, T), M) = term-hook(QI, applyMapSetToTerm(VMAPS, VMAPS', T, M)) . eq applyMapSetToHookListAux(VMAPS, (VMAP, VMAPS'), op-hook(QI, F, ETL, ET), M) *** In case of ambiguous mappings we take any of them arbitrarily = op-hook(QI, applyOpMapSetToOpId(F, VMAP), applyMapSetToTypeList(VMAPS, ETL), applyMapSetToEType(VMAPS, ET)) . eq applyMapSetToHookListAux(VMAPS, none, op-hook(QI, F, ETL, ET), M) = op-hook(QI, F, applyMapSetToTypeList(VMAPS, ETL), applyMapSetToEType(VMAPS, ET)) . eq applyMapSetToMbSet(VMAPS, VMAPS', ((mb T : ES [AtS] .) EMAS), M) = ((mb applyMapSetToTerm(VMAPS, VMAPS', T, M) : applyMapSetToEType(VMAPS, ES) [applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)] .) applyMapSetToMbSet(VMAPS, VMAPS', EMAS, M)) . eq applyMapSetToMbSet(VMAPS, VMAPS', ((cmb T : ES if Cond [AtS] .) EMAS), M) = ((cmb applyMapSetToTerm(VMAPS, VMAPS', T, M) : applyMapSetToEType(VMAPS, ES) if applyMapSetToCond(VMAPS, VMAPS', Cond, M) [applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)] .) applyMapSetToMbSet(VMAPS, VMAPS', EMAS, M)) . eq applyMapSetToMbSet(VMAPS, VMAPS', none, M) = none . eq applyMapSetToEqSet(VMAPS, VMAPS', ((ceq T = T' if Cond [AtS] .) EqS), M) = ((ceq applyMapSetToTerm(VMAPS, VMAPS', T, M) = applyMapSetToTerm(VMAPS, VMAPS', T', M) if applyMapSetToCond(VMAPS, VMAPS', Cond, M) [applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)] .) applyMapSetToEqSet(VMAPS, VMAPS', EqS, M)) . eq applyMapSetToEqSet(VMAPS, VMAPS', ((eq T = T' [AtS] .) EqS), M) = ((eq applyMapSetToTerm(VMAPS, VMAPS', T, M) = applyMapSetToTerm(VMAPS, VMAPS', T', M) [applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)] .) applyMapSetToEqSet(VMAPS, VMAPS', EqS, M)) . eq applyMapSetToEqSet(VMAPS, VMAPS', none, M) = none . eq applyMapSetToRlSet(VMAPS, VMAPS', ((crl T => T' if Cond [AtS] .) RlS), M) = ((crl applyMapSetToTerm(VMAPS, VMAPS', T, M) => applyMapSetToTerm(VMAPS, VMAPS', T', M) if applyMapSetToCond(VMAPS, VMAPS', Cond, M) [applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)] .) applyMapSetToRlSet(VMAPS, VMAPS', RlS, M)) . eq applyMapSetToRlSet(VMAPS, VMAPS', ((rl T => T' [AtS] .) RlS), M) = ((rl applyMapSetToTerm(VMAPS, VMAPS', T, M) => applyMapSetToTerm(VMAPS, VMAPS', T', M) [applyMapSetToAttrSet(VMAPS, VMAPS', AtS, M)] .) applyMapSetToRlSet(VMAPS, VMAPS', RlS, M)) . eq applyMapSetToRlSet(VMAPS, VMAPS', none, M) = none . eq applyMapSetToCond(VMAPS, VMAPS', T = T' /\ Cond, M) = applyMapSetToTerm(VMAPS, VMAPS', T, M) = applyMapSetToTerm(VMAPS, VMAPS', T', M) /\ applyMapSetToCond(VMAPS, VMAPS', Cond, M) . eq applyMapSetToCond(VMAPS, VMAPS', T : ES /\ Cond, M) = applyMapSetToTerm(VMAPS, VMAPS', T, M) : applyMapSetToEType(VMAPS, ES) /\ applyMapSetToCond(VMAPS, VMAPS', Cond, M) . eq applyMapSetToCond(VMAPS, VMAPS', T := T' /\ Cond, M) = applyMapSetToTerm(VMAPS, VMAPS', T, M) := applyMapSetToTerm(VMAPS, VMAPS', T', M) /\ applyMapSetToCond(VMAPS, VMAPS', Cond, M) . eq applyMapSetToCond(VMAPS, VMAPS', T => T' /\ Cond, M) = applyMapSetToTerm(VMAPS, VMAPS', T, M) => applyMapSetToTerm(VMAPS, VMAPS', T', M) /\ applyMapSetToCond(VMAPS, VMAPS', Cond, M) . eq applyMapSetToCond(VMAPS, VMAPS', nil, M) = nil . eq applyMapSetToLabel(((label L to L'), VMAPS), L'') = if L == L'' then L' else applyMapSetToLabel(VMAPS, L'') fi . ceq applyMapSetToLabel((VMAP, VMAPS), L) = applyMapSetToLabel(VMAPS, L) if not (VMAP :: LabelMap) . eq applyMapSetToLabel(none, L) = L . eq applyMapSetToClassDeclSet(VMAPS, VMAPS', ((class C | ADS .) CDS)) = ((class applyMapSetToClassName(VMAPS', C) | applyMapSetToAttrDeclSet(VMAPS, VMAPS', C, ADS) .) applyMapSetToClassDeclSet(VMAPS, VMAPS', CDS)) . eq applyMapSetToClassDeclSet(VMAPS, VMAPS', none) = none . eq applyMapSetToAttrDeclSet(VMAPS, VMAPS', C, ((attr A : ET), ADS)) = ((attr applyMapSetToAttrName(VMAPS', C, A) : applyMapSetToEType(VMAPS, ET)), applyMapSetToAttrDeclSet(VMAPS, VMAPS', C, ADS)) . eq applyMapSetToAttrDeclSet(VMAPS, VMAPS', C, none) = none . eq applyMapSetToAttrName(((attr A . C to A'), VMAPS), C', A'') = if (C == C') and (A == A'') then A' else applyMapSetToAttrName(VMAPS, C', A'') fi . ceq applyMapSetToAttrName((VMAP, VMAPS), C, A) = applyMapSetToAttrName(VMAPS, C, A) if not (VMAP :: AttrMap) . eq applyMapSetToAttrName(none, C, A) = A . eq applyMapSetToSubclassDeclSet(VMAPS, ((subclass C < C' .) SCDS)) = ((subclass applyMapSetToClassName(VMAPS, C) < applyMapSetToClassName(VMAPS, C') .) applyMapSetToSubclassDeclSet(VMAPS, SCDS)) . eq applyMapSetToSubclassDeclSet(VMAPS, none) = none . endfm ******************************************************************************* *** *** 6.9 Instantiation of Parameterized Modules and the *** \texttt{META-LEVEL} Module Expression *** A parameterized module *** $\texttt{M[L}_1\texttt{\ ::\ T}_1\texttt{,\}\ldots\texttt{, L}_n *** \texttt{ :: T}_n\texttt{]}$, with \mbox{$\texttt{L}_1\ldots\texttt{L}_n$} *** labels and \mbox{$\texttt{T}_1\ldots\texttt{T}_n$} theory identifiers, is *** represented as a module with name \texttt{M} which contains parameter *** declarations \mbox{$\texttt{par\ L}_i\texttt{\ ::\ T}_i$} for *** $1\leq i\leq n$, and an importation declaration *** \mbox{$\texttt{inc\ par\ L}_i\texttt{\ ::\ T}_i\texttt{\ .}$} for each *** parameter \mbox{$\texttt{L}_i\texttt{\ ::\ T}_i$} in its interface. Note *** that all modules are handled in a uniform way: nonparameterized modules *** and theories have their list of parameters set to \texttt{nilParList}. *** The instantiation of the formal parameters of a parameterized module with *** actual modules or theories requires a view from each formal parameter *** theory to its corresponding actual unit. The process of instantiation *** results in the replacement of each interface theory by its corresponding *** actual parameter, using the views to bind actual names to formal names. *** The naming conventions for sorts have to be taken into account in the *** instantiation process: every occurrence of a sort coming from a theory in *** the interface of a module must be qualified by its theory's label, and *** sorts defined in the body of a parameterized module can be parameterized *** by the labels in the interface of the module (see *** Section~\ref{parameterized-modules}). *** The labeling convention for theories and for the sorts coming from them is *** very useful to avoid collisions of sort names coming from the parameter *** theories, and also to allow different uses of the same theory several *** times in the interface of a module. We assume that all sorts coming from *** the theory part of the parameter theories are used in their qualified form *** to manipulate the maps defined in the views before being applied to the *** body of the module being instantiated. If the target of a view is a *** theory, the sorts from the theory part of the target theory appearing in *** the targets of the maps in the view will be qualified as well, following *** the same convention. *** When a parameterized module *** $\texttt{M[L}_1\texttt{\ ::\ T}_1\texttt{,\ } *** \ldots\texttt{,\ L}_n\texttt{\ ::\ T}_n\texttt{]}$ *** is instantiated with views $\texttt{V}_1\ldots\texttt{V}_n$, each *** parameterized sort $\texttt{S[L}_1\texttt{,}\ldots\texttt{,L}_n\texttt{]}$ *** in the body of the parameterized module is renamed to *** $\texttt{S[V}_1\texttt{,}\ldots\texttt{,V}_n\texttt{]}$. *** The discussion on the qualification of sorts in views before being used in *** the instantiation process applies in a completely similar way to class *** names in parameterized object-oriented modules. *** As we saw in Section~\ref{module-expressions}, it is possible to import a *** module expression in which a parameterized module is instantiated by some *** of the formal parameters of the parameterized module in which it is *** imported. This is done by using the label of some of the parameters in the *** interface of a module, say \mbox{$\texttt{L}_k\texttt{\ ::\ T}_k$}, in a *** module expression in which some parameterized module \texttt{N} with formal *** parameter $\texttt{T}_k$ is instantiated with $\texttt{L}_k$, that is, we *** have the module expression $\texttt{N[}\ldots\texttt{L}_k\ldots\texttt{]}$. *** In this case, $\texttt{L}_k$ is considered as the identity view for the *** theory $\texttt{T}_k$ with $\texttt{L}_k$ as name. Note that to be able to *** check whether a label in the interface of a module is used in an *** instantiation of this form, in the evaluation of a module expression the *** list of parameters of the module in which the module expression appears *** must be available. This is the reason why the \texttt{evalModExp} function *** was defined with \texttt{ParameterList} as one of the sorts in its *** arity (see Section~\ref{evalModExp}). For module expressions appearing *** outside of any module, that is, in commands, etc., this list will be set *** to \texttt{nilParList}. *** Note that this kind of instantiation may produce a `cascade' effect. The *** module being instantiated may itself import other module expressions in *** which labels of some of its parameter theories are used in the *** instantiation of some of these imported module expressions. This is handled *** by `preparing' the module expressions appearing in the importation *** declarations of the module (\texttt{prepImportList}). This process *** consists in changing the labels of the interface of the module being *** instantiated which are used in the importations of module expressions by *** the corresponding view names (\texttt{prepModName}). After completing the *** generation of the module resulting from the evaluation of the module *** expression, this module will be evaluated with the \texttt{evalUnit} *** function, producing the evaluation of these new module expressions. In any *** extension of the language, new equations for the function *** \texttt{prepModName} will have to be added for each new kind of module *** expression being defined. *** In Sections~\ref{renaming} and~\ref{extension} we shall see how new *** equations completing the semantics of \texttt{prepModName} are added for *** each new module expression being defined. In the case of the renaming *** module expression, the renaming maps will have to be prepared as well, to *** adjust the sort names being renamed to the conventions discussed above. *** As for any other module expression being defined, in addition to the *** operator declaration for the constructor of the instantiation module *** expression, equations completing the semantics of operators *** \texttt{evalModExp}, \texttt{modNameToQidList}, and *** \texttt{setUpModExpDeps} have to be given. fmod INST-EXPR-EVALUATION is pr EVALUATION . pr VIEW-MAP-SET-APPL-ON-UNIT . inc MOD-EXPR . inc MOD-NAME . *** We start by giving the new constructor for sort \texttt{ModExp}. Note that *** the modules \texttt{MOD-EXPR} and \texttt{MOD-NAME} have been imported in *** \texttt{including} mode. vars QI X Y W Z : Qid . var QIL : QidList . vars M M' : Module . vars PU U U' U'' DM : Unit . var STh : StrTheory . vars ME ME' ME'' : ModExp . var MN : ModName . vars MNS MNS' : ModNameSet . vars VE VE' VE'' VE''' VE'''' : ViewExp . vars VES VES' : ViewExpSet . var IS : InfoSet . vars DB DB' : Database . vars PL PL' PL'' PL''' PL'''' PL''''' : ParameterList . vars EIL EIL' EIL'' EIL''' : EImportList . vars VMAPS VMAPS' VMAPS'' : ViewMapSet . vars C QI' F F' S S' A A' L L' : Qid . var V : Variable . var Ct : Constant . var SL : QidList . var SS : SortSet . vars ES ES' : ESort . var ETL : ETypeList . vars ESS ESS' ESS'' : ESortSet . vars T T' O : Term . var DT : Default`(Term`) . var TL : TermList . var CDS : ClassDeclSet . var ADS : AttrDeclSet . var B : Bool . var AtS : AttrSet . var VMAP : ViewMap . var N : Nat . var PV : PreView . var VI : View . var P : Parameter . var VDS : OpDeclSet . *** In the input given by the user, the operator \verb~_(_)~ is used both for *** the instantiation of module expressions, and for expressions *** parameterizing the module \texttt{META-LEVEL} with a list of module names. *** The function \texttt{evalModExp} distinguishes these two cases, calling *** the function \texttt{unitInst} in the former and the function *** \texttt{prepMetalevel} in the latter. op unitInst : ModName ViewExp ParameterList Database -> Database . op prepMetalevel : ViewExp Database -> Database . eq evalModExp((ME < VE >), PL, DB) = if unitInDb((ME < VE >), DB) then DB else if ME == 'META-LEVEL then prepMetalevel(VE, DB) else unitInst(ME, VE, PL, evalModExp(ME, PL, evalViewExp(VE, PL, DB))) fi fi . *** The function \texttt{prepMetalevel} creates a new module with the *** module expression being evaluated as name, which imports the predefined *** \texttt{META-LEVEL} module. For each module name \texttt{I} in the list *** given as parameter of the expression, the declaration of a constant *** \texttt{I} of sort \texttt{Module} and an equation identifying such *** constant with the metarepresentation of the module with such name in the *** database are added to the module being created. op prepMetalevelAux : ViewExp Unit Database -> Database . eq prepMetalevel(VE, DB) = prepMetalevelAux(VE, addImports((including 'META-LEVEL .), setName(emptyStrFModule, ('META-LEVEL < VE >))), DB) . eq prepMetalevelAux((QI | VE), U, DB) = if QI inModNameSet builtIns then prepMetalevelAux(VE, U, warning(DB, '\r 'Warning: '\o 'META-LEVEL '`( QI '`) '\s 'not 'supported '\n)) else prepMetalevelAux(VE, addOps((op qid("META-" + string(QI)) : nil -> 'Module [none] .), addEqs((eq qid("META-" + string(QI) + ".Module") = up(getFlatUnit(QI, DB)) [none] .), U)), DB) fi . eq prepMetalevelAux(nullViewExp, U, DB) = evalUnit(U, DB) . *** The function \texttt{getClassesESortSet} returns the set of the names of *** the classes in a set of class declarations. op getClassesESortSet : ClassDeclSet -> ESortSet . eq getClassesESortSet(((class ES | ADS .) CDS)) = (ES ; getClassesESortSet(CDS)) . eq getClassesESortSet(none) = none . *** The following `getTh' functions return the corresponding elements in the *** theory part of the structure of the given unit. For example, the function *** \texttt{getThSortSet} returns the set of sorts declared in the ``loose *** part'' of the structure of the unit in the database having the name *** indicated as first argument. op getThSortSet : ModName Database -> ESortSet . op getThClassSet : ModName Database -> ESortSet . op getThSortSetAux : EImportList Database -> ESortSet . op getThClassSetAux : EImportList Database -> ESortSet . eq getThSortSet(ME, DB) = if getTopUnit(ME, DB) :: StrTheory then (getThSortSetAux(getImports(getTopUnit(ME, DB)), DB) ; getSorts(getTopUnit(ME, DB))) else none fi . eq getThSortSetAux(((including ME .) EIL), DB) = (getThSortSet(ME, DB) ; getThSortSetAux(EIL, DB)) . eq getThSortSetAux(((extending ME .) EIL), DB) = (getThSortSet(ME, DB) ; getThSortSetAux(EIL, DB)) . eq getThSortSetAux(((protecting ME .) EIL), DB) = (getThSortSet(ME, DB) ; getThSortSetAux(EIL, DB)) . eq getThSortSetAux(((protecting par X :: ME .) EIL), DB) = getThSortSetAux(EIL, DB) . eq getThSortSetAux(nil, DB) = none . eq getThClassSet(ME, DB) = if getTopUnit(ME, DB) :: StrOTheory and-then not getTopUnit(ME, DB) :: StrSTheory then (getThClassSetAux(getImports(getTopUnit(ME, DB)), DB) ; getClassesESortSet(getClasses(getTopUnit(ME, DB)))) else none fi . eq getThClassSetAux(((including ME .) EIL), DB) = (getThClassSet(ME,DB) ; getThClassSetAux(EIL, DB)) . eq getThClassSetAux(((extending ME .) EIL), DB) = (getThClassSet(ME,DB) ; getThClassSetAux(EIL, DB)) . eq getThClassSetAux(((protecting ME .) EIL), DB) = (getThClassSet(ME,DB) ; getThClassSetAux(EIL, DB)) . eq getThClassSetAux(((protecting par X :: ME .) EIL), DB) = getThClassSetAux(EIL, DB) . eq getThClassSetAux(nil, DB) = none . *** The `get' functions return the corresponding elements in the structure of *** the given unit. For example, \texttt{getSortSet} returns all the sorts *** declared in the structure of the unit in the database having the name *** given as first argument. op getSortSet : ModName Database -> ESortSet . op getClassSet : ModName Database -> ESortSet . op getSortSetAux : EImportList Database -> ESortSet . op getClassSetAux : EImportList Database -> ESortSet . eq getSortSet(MN, DB) = (getSortSetAux(getImports(getTopUnit(MN, DB)), DB) ; getSorts(getTopUnit(MN, DB))) . eq getSortSetAux(((including MN .) EIL), DB) = (getSortSet(MN, DB) ; getSortSetAux(EIL, DB)) . eq getSortSetAux(((extending MN .) EIL), DB) = (getSortSet(MN, DB) ; getSortSetAux(EIL, DB)) . eq getSortSetAux(((protecting MN .) EIL), DB) = (getSortSet(MN, DB) ; getSortSetAux(EIL, DB)) . eq getSortSetAux(nil, DB) = none . eq getClassSet(MN, DB) = (getClassSetAux(getImports(getTopUnit(MN, DB)), DB) ; getClassesESortSet(getClasses(getTopUnit(MN, DB)))) . eq getClassSetAux(((including MN .) EIL), DB) = (getClassSet(MN, DB) ; getClassSetAux(EIL, DB)) . eq getClassSetAux(((extending MN .) EIL), DB) = (getClassSet(MN, DB) ; getClassSetAux(EIL, DB)) . eq getClassSetAux(((protecting MN .) EIL), DB) = (getClassSet(MN, DB) ; getClassSetAux(EIL, DB)) . eq getClassSetAux(nil, DB) = none . *** As pointed out in Section~\ref{parameterized-modules}, in a parameterized *** module all occurrences of sorts or classes coming from the parameter *** theories have to be qualified. \texttt{createCopy} is the function used *** for creating these renamed copies of the parameters. As also explained in *** Section~\ref{parameterized-modules}, if a parameter theory is structured, *** the renaming is carried out not only at the top level, but for the entire *** ``theory part'' in the structure. *** The function \texttt{createCopy} calls an auxiliary function, *** \texttt{prepPar}, which recursively proceeds through all the subtheories *** of the given theory. For each theory in the structure, the required set of *** maps is generated and applied to such a theory using the *** \texttt{applyMapSetToUnit} function discussed in *** Section~\ref{applyMapSetToUnit}, which is then evaluated and entered into *** the database. Note that the renamings to which a theory is subjected must *** also be applied to the theories importing it. The new database and the *** renaming maps applied to the theory will have to be returned by the *** function. *** The function \texttt{prepPar} makes a copy of the theory specified by the *** name given as first argument and of all its subtheories (only theories, no *** modules), and qualifies all the sorts appearing in it with the label given *** in the declaration of the parameter, which is given as second argument. sorts Tuple`(ViewExp`,ViewExp`) Set`(Tuple`(ViewExp`|`ViewExp`)`) prepParResult . subsort Tuple`(ViewExp`,ViewExp`) < Set`(Tuple`(ViewExp`|`ViewExp`)`) . op <_`,_> : ViewExp ViewExp -> Tuple`(ViewExp`,ViewExp`) . ops 1st 2nd : Tuple`(ViewExp`,ViewExp`) -> ViewExp . op none : -> Set`(Tuple`(ViewExp`|`ViewExp`)`) . op __ : Set`(Tuple`(ViewExp`|`ViewExp`)`) Set`(Tuple`(ViewExp`|`ViewExp`)`) -> Set`(Tuple`(ViewExp`|`ViewExp`)`) [assoc comm id: none] . vars VEPS VEPS' : Set`(Tuple`(ViewExp`|`ViewExp`)`) . eq 1st(< VE, VE' >) = VE . eq 2nd(< VE, VE' >) = VE' . op <_;_;_;_;_;_;_> : ViewMapSet Database ViewExp ViewExp Set`(Tuple`(ViewExp`|`ViewExp`)`) Bool EImportList -> prepParResult . op mapSet : prepParResult -> ViewMapSet . op db : prepParResult -> Database . op sourceViewExp : prepParResult -> ViewExp . op targetViewExp : prepParResult -> ViewExp . op viewExpPairSet : prepParResult -> Set`(Tuple`(ViewExp`|`ViewExp`)`) . op theoryFlag : prepParResult -> Bool . op getImports : prepParResult -> EImportList . eq mapSet(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; EIL >) = VMAPS . eq db(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; EIL >) = DB . eq sourceViewExp(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; EIL >) = VE . eq targetViewExp(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; EIL >) = VE' . eq viewExpPairSet(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; EIL >) = VEPS . eq theoryFlag(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; EIL >) = B . eq getImports(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; EIL >) = EIL . op createCopy : Parameter Database -> Database . op prepPar : Qid ModExp Database -> prepParResult . op prepPar : Qid ModExp ParameterList ParameterList ParameterList ParameterList ViewExp ViewExp Set`(Tuple`(ViewExp`|`ViewExp`)`) ViewMapSet Database -> prepParResult . op prepPar : Qid Qid ModExp Database -> prepParResult . op prepPar : Qid Qid ModExp ParameterList ParameterList ParameterList ParameterList ViewMapSet ViewExp ViewExp Set`(Tuple`(ViewExp`|`ViewExp`)`) Database -> prepParResult . op prepParImports : EImportList EImportList Qid ViewMapSet Set`(Tuple`(ViewExp`|`ViewExp`)`) ParameterList Database -> prepParResult . op prepParImports : EImportList EImportList Qid Qid ViewMapSet Set`(Tuple`(ViewExp`|`ViewExp`)`) ParameterList Database -> prepParResult . eq createCopy(par X :: ME, DB) = if unitInDb(par X :: ME, DB) then DB else db(prepPar(X, ME, evalModExp(ME, DB))) fi . eq createCopy(par X :: par(ME, PL), DB) = if unitInDb(par X :: par(ME, PL), DB) then DB else db( prepPar(X, ME, getParList(getTopUnit(ME, evalModExp(ME, DB))), PL, getParList(getTopUnit(ME, evalModExp(ME, DB))), PL, nullViewExp, nullViewExp, none, none, evalModExp(ME, DB))) fi . ceq prepPar(X, ME, parList(par Y :: par(ME', PL), PL'), parList(par Z :: par(ME', PL''), PL'''), PL'''', PL''''', VE, VE', VEPS, VMAPS, DB) = prepPar(X, ME, PL', PL''', PL'''', PL''''', (VE | (Y << VE'' >>)), (VE' | (Z << VE''' >>)), (< Y << VE'' >>, Z << VE''' >> > VEPS' VEPS), (VMAPS, VMAPS'), DB') if < VMAPS' ; DB' ; VE'' ; VE''' ; VEPS' ; B ; EIL > := prepPar(Y, Z, ME', PL, PL'', PL, PL'', none, nullViewExp, nullViewExp, none, DB) . eq prepPar(X, ME, parList(par Y :: ME', PL), parList(par Z :: ME', PL'), PL'', PL''', VE, VE', VEPS, VMAPS, DB) = prepPar(X, ME, PL, PL', PL'', PL''', VE | Y, VE' | Z, < Y, Z > VEPS, (VMAPS, mapSet(prepPar(Y, Z, ME', DB))), db(prepPar(Y, Z, ME', DB))) . ceq prepPar(X, ME, nilParList, nilParList, PL, PL', VE, VE', VEPS, VMAPS, DB) = < (VMAPS, VMAPS', sortMapsPar(X, getSorts(STh), VEPS), classMapSetPar(X, classSet(getClasses(STh)), VEPS)) ; (if unitInDb((par X :: par(ME, PL')), DB) then DB else evalUnit( setPars( setImports( setName( applyMapSetToUnit( (VMAPS, VMAPS', sortMapsPar(X, getSorts(STh), VEPS), classMapSetPar(X, classSet(getClasses(STh)), VEPS)), STh, getFlatUnit(ME, DB)), (par X :: par(ME, PL'))), EIL), PL'), DB') fi) ; VE ; VE' ; VEPS ; true ; nil > if STh := getTopUnit(ME, DB) /\ < VMAPS' ; DB' ; VE'' ; VE''' ; VEPS' ; B ; EIL > := prepParImports(getImports(STh), nil, X, none, VEPS, PL', DB) . eq prepPar(X, ME, PL, PL', PL'', PL''', VE, VE', VEPS, VMAPS, DB) = < none ; warning(DB, '\r 'Error: '\o 'Incorrect 'parameter '\n) ; nullViewExp ; nullViewExp ; none ; false ; nil > [owise] . eq prepPar(W, X, ME, parList(par Y :: ME', PL), parList(par Z :: ME', PL'), PL'', PL''', VMAPS, VE, VE', VEPS, DB) = prepPar(W, X, ME, PL, PL', PL'', PL''', (mapSet(prepPar(Y, Z, ME', DB)), VMAPS), VE | Y, VE' | Z, < Y, Z > VEPS, db(prepPar(Y, Z, ME', DB))) . ceq prepPar(W, X, ME, nilParList, nilParList, PL, PL', VMAPS, VE, VE', VEPS, DB) = < (VMAPS', genMapSetQualSortSet(W, X, getSorts(STh), VEPS), genMapSetQualClassSet(W, X, classSet(getClasses(STh)), VEPS), VMAPS) ; (if unitInDb((par X :: par(ME, PL')), DB) then DB else evalUnit( setImports( setName( applyMapSetToUnit( (VMAPS', genMapSetQualSortSet(W, X, getSorts(STh), VEPS), genMapSetQualClassSet(W, X, classSet(getClasses(STh)), VEPS), VMAPS ), getTopUnit((par W :: par(ME, PL)), DB), getFlatUnit((par W :: par(ME, PL)), DB)), (par X :: par(ME, PL'))), EIL), DB') fi ) ; W << VE >> ; X << VE' >> ; < W << VE >>, X << VE' >> > VEPS ; true ; nil > if STh := getTopUnit(ME, DB) /\ < VMAPS' ; DB' ; VE'' ; VE''' ; VEPS' ; B ; EIL > := prepParImports(getImports(STh), nil, W, X, none, VEPS, PL', DB) . eq prepPar(W, X, ME, PL, PL', PL'', PL''', VMAPS, VE, VE', VEPS, DB) = < none ; warning(DB, '\r 'Error: '\o 'Incorrect 'parameter '\n) ; nullViewExp ; nullViewExp ; none ; false ; nil > [owise] . ceq prepPar(X, Y, ME, DB) = < (VMAPS, genMapSetQualSortSet(X, Y, getSorts(STh), none), genMapSetQualClassSet(X, Y, classSet(getClasses(STh)), none)) ; (if unitInDb((par Y :: ME), DB) then DB else evalUnit( setImports( setName( applyMapSetToUnit( (VMAPS, genMapSetQualSortSet(X, Y, getSorts(STh), none), genMapSetQualClassSet(X, Y, classSet(getClasses(STh)), none)), getTopUnit((par X :: ME), DB), getFlatUnit((par X :: ME), DB)), (par Y :: ME)), EIL), DB') fi) ; X ; Y ; < X, Y > ; true ; nil > if STh := getTopUnit(ME, DB) /\ < VMAPS ; DB' ; VE ; VE' ; VEPS ; B ; EIL > := prepParImports(getImports(STh), nil, X, Y, none, < X, Y >, par X :: ME, DB) . ceq prepPar(X, ME, DB) = < (VMAPS, sortMapsPar(X, getSorts(STh), none), classMapSetPar(X, classSet(getClasses(STh)), none)) ; (if unitInDb(par X :: ME, DB) then DB else evalUnit( setImports( setName( applyMapSetToUnit( (VMAPS, sortMapsPar(X, getSorts(STh), none), classMapSetPar(X, classSet(getClasses(STh)), none)), STh, getFlatUnit(ME, DB)), par X :: ME), EIL), DB') fi) ; nullViewExp ; nullViewExp ; none ; true ; nil > if STh := getTopUnit(ME, DB) /\ < VMAPS ; DB' ; VE ; VE' ; VEPS ; B ; EIL > := prepParImports(getImports(STh), nil, X, none, none, par X :: ME, DB) . eq prepPar(X, ME, DB) = < none ; warning(DB, '\r 'Error: '\o 'Incorrect 'parameter '\n) ; nullViewExp ; nullViewExp ; none ; false ; nil > [owise] . ceq prepParImports(((including ME .) EIL), EIL', X, VMAPS, VEPS, PL, DB) = if B then prepParImports(EIL, (EIL' (including (par X :: ME') .)), X, (VMAPS, VMAPS'), VEPS, PL, DB') else prepParImports(EIL, (EIL' (including ME .)), X, VMAPS, VEPS, PL, DB) fi if ME' := prepModName(ME, VEPS) /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; EIL'' > := prepPar(X, ME', evalModExp(ME', PL, DB)) . ceq prepParImports(((extending ME .) EIL), EIL', X, VMAPS, VEPS, PL, DB) = if B then *** A theory shouldn't be imported in protecting mode prepParImports(EIL, (EIL' (extending (par X :: ME') .)), X, (VMAPS, VMAPS'), VEPS, PL, DB') else prepParImports(EIL, (EIL' (extending ME .)), X, VMAPS, VEPS, PL, DB) fi if ME' := prepModName(ME, VEPS) /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; EIL'' > := prepPar(X, ME', evalModExp(ME', PL, DB)) . ceq prepParImports(((protecting ME .) EIL), EIL', X, VMAPS, VEPS, PL, DB) = if B then *** A theory shouldn't be imported in protecting mode prepParImports(EIL, (EIL' (protecting (par X :: ME') .)), X, (VMAPS, VMAPS'), VEPS, PL, DB') else prepParImports(EIL, (EIL' (protecting ME .)), X, VMAPS, VEPS, PL, DB) fi if ME' := prepModName(ME, VEPS) /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; EIL'' > := prepPar(X, ME', evalModExp(ME', PL, DB)) . ceq prepParImports(((protecting par X :: ME .) EIL), EIL', Y, VMAPS, (< X, Z > VEPS), PL, DB) = prepParImports(EIL, (EIL' (protecting (par Z :: ME') .)), Y, (VMAPS, VMAPS'), (< X, Z > VEPS), PL, DB') if ME' := prepModName(ME, VEPS) /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; EIL'' > := prepPar(X, ME', evalModExp(ME', PL, DB)) . eq prepParImports(nil, EIL, X, VMAPS, VEPS, PL, DB) = < VMAPS ; DB ; nullViewExp ; nullViewExp ; none ; false ; EIL > . eq prepParImports(((including ME .) EIL), EIL', X, Y, VMAPS, VEPS, PL, DB) = prepParImports(EIL, (EIL' (including ME .)), X, Y, VMAPS, VEPS, PL, DB) . eq prepParImports(((extending ME .) EIL), EIL', X, Y, VMAPS, VEPS, PL, DB) = prepParImports(EIL, (EIL' (extending ME .)), X, Y, VMAPS, VEPS, PL, DB) . eq prepParImports(((protecting ME .) EIL), EIL', X, Y, VMAPS, VEPS, PL, DB) = prepParImports(EIL, (EIL' (protecting ME .)), X, Y, VMAPS, VEPS, PL, DB) . ceq prepParImports(((protecting par X :: ME .) EIL), EIL', Y, Z, VMAPS, VEPS, PL, DB) = prepParImports(EIL, (EIL' (protecting par X :: ME' .)), Y, Z, (VMAPS, VMAPS'), VEPS, PL, DB') if ME' := prepModName(ME, VEPS) /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; EIL'' > := prepPar(Y, Z, ME', evalModExp(ME', PL, DB)) . eq prepParImports(nil, EIL, X, Y, VMAPS, VEPS, PL, DB) = < VMAPS ; DB ; nullViewExp ; nullViewExp ; none ; false ; EIL > . op sortMapsPar : Qid ESortSet Set`(Tuple`(ViewExp`|`ViewExp`)`) -> MapSet . op classMapSetPar : Qid ESortSet Set`(Tuple`(ViewExp`|`ViewExp`)`) -> MapSet . op qualify : Qid ESort -> ESort . op qualify : Qid ESort Set`(Tuple`(ViewExp`|`ViewExp`)`) -> ESort . eq qualify(X, ES) = qualify(X, ES, none) . eq qualify(X, S, VEPS) = qid(string(X) + "@" + string(S)) . eq qualify(X, eSort(ES, VE), VEPS) = eSort(qualify(X, ES, VEPS), prepViewExp(VE, VEPS)) . eq sortMapsPar(X, (ES ; ESS), VEPS) = ((sort ES to qualify(X, ES, VEPS)), sortMapsPar(X, ESS, VEPS)) . eq sortMapsPar(X, none, VEPS) = none . eq classMapSetPar(X, (ES ; ESS), VEPS) = ((class ES to qualify(X, ES, VEPS)), classMapSetPar(X, ESS, VEPS)) . eq classMapSetPar(X, none, VEPS) = none . *** When one of the labels of the interface of a module is being used in a *** module expression to instantiate some formal parameter of a module, then, *** in the evaluation of such module expression the qualification of all sorts *** and class names coming from the theory part of the parameter theory have *** to be changed according to such a label. In the evaluation of an *** instantiation module expression this is done by generating the *** corresponding renaming maps, which are then applied to the module being *** instantiated. Given labels \texttt{L} and \texttt{L'}, for each sort or *** class name \texttt{S} in the set given as argument, a map of the form *** \verb~L@S to L'@S~ is generated. op genMapSetQualSortSet : Qid Qid ESortSet Set`(Tuple`(ViewExp`|`ViewExp`)`) -> MapSet . op genMapSetQualClassSet : Qid Qid ESortSet Set`(Tuple`(ViewExp`|`ViewExp`)`) -> MapSet . eq genMapSetQualSortSet(X, Y, (ES ; ESS), VEPS) = ((sort qualify(X, ES, VEPS) to qualify(Y, ES, VEPS)), genMapSetQualSortSet(X, Y, ESS, VEPS)) . eq genMapSetQualSortSet(X, Y, none, VEPS) = none . eq genMapSetQualClassSet(X, Y, (ES ; ESS), VEPS) = ((class qualify(X, ES, VEPS) to qualify(Y, ES, VEPS)), genMapSetQualClassSet(X, Y, ESS, VEPS)) . eq genMapSetQualClassSet(X, Y, none, VEPS) = none . *** The function \texttt{prepViewMapSet} takes the map set of a view and *** prepares it to be used in an instantiation by transforming sort and class *** names into their qualified form, if required (sorts and class names in a *** view have to be qualified only if they were defined in a theory). *** The \texttt{prepViewMapSet} function takes five arguments: The set of maps *** to be prepared, the label with which the sorts to be renamed have to be *** qualified, the set of sorts in the theory part of the source of the view, *** and the set of sorts and class names in the theory part of the target of *** the view. *** Note that we assume that there is a sort map and a class map for each sort *** and class in the theory part of the source of the view. Therefore, sorts *** and class names appearing as sources of sort and class maps are *** systematically qualified. The sorts or class names used in the targets of *** the maps will be qualified only if they were declared in a theory. In maps *** for operators in which the arity and coarity are specified, or for those *** going to derived terms, the sorts appearing in the arity or coarity of an *** operator and those used to qualify terms, or in sort tests in terms, must *** also be qualified. However, in these cases the qualification cannot be *** done on all sorts, but only on those defined in the theory parts. This is *** the reason why the sets of sorts in the theory parts of the source and *** target and the set of class names in the target of the view are given when *** calling \texttt{prepViewMapSet}. op prepViewMapSet : ViewMapSet Qid ESortSet ESortSet ESortSet -> ViewMapSet . op prepETypeList : ETypeList Qid ESortSet -> ETypeList . op prepTerm : TermList Qid ESortSet -> TermList . eq prepViewMapSet(((sort ES to ES'), VMAPS), X, ESS, ESS', ESS'') = ((if ES' inSortSet ESS' then (sort qualify(X, ES) to qualify(X, ES')) else (sort qualify(X, ES) to ES') fi), prepViewMapSet(VMAPS, X, ESS, ESS', ESS'')) . eq prepViewMapSet(((op F : ETL -> ES to F' [AtS]), VMAPS), X, ESS, ESS', ESS'') = ((op F : prepETypeList(ETL, X, ESS) -> prepETypeList(ES, X, ESS) to F' [AtS]), prepViewMapSet(VMAPS, X, ESS, ESS', ESS'')) . eq prepViewMapSet(((op F to F' [AtS]), VMAPS), X, ESS, ESS', ESS'') = ((op F to F' [AtS]), prepViewMapSet(VMAPS, X, ESS, ESS', ESS'')) . eq prepViewMapSet((termMap(T, T'), VMAPS), X, ESS, ESS', ESS'') = (termMap(prepTerm(T, X, ESS), prepTerm(T', X, ESS')), prepViewMapSet(VMAPS, X, ESS, ESS', ESS'')) . eq prepViewMapSet(((msg F : ETL -> ES to F'), VMAPS), X, ESS, ESS', ESS'') = ((msg F : prepETypeList(ETL, X, ESS) -> prepETypeList(ES, X, ESS) to F'), prepViewMapSet(VMAPS, X, ESS, ESS', ESS'')) . eq prepViewMapSet(((msg F to F'), VMAPS), X, ESS, ESS', ESS'') = ((msg F to F'), prepViewMapSet(VMAPS, X, ESS, ESS', ESS'')) . eq prepViewMapSet(((class ES to ES'), VMAPS), X, ESS, ESS', ESS'') = ((if ES' inSortSet ESS'' then (class qualify(X, ES) to qualify(X, ES')) else (class qualify(X, ES) to ES') fi), prepViewMapSet(VMAPS, X, ESS, ESS', ESS'')) . eq prepViewMapSet(((attr A . ES to A'), VMAPS), X, ESS, ESS', ESS'') = ((attr A . qualify(X, ES) to A'), prepViewMapSet(VMAPS, X, ESS, ESS', ESS'')) . eq prepViewMapSet(((label L to L'), VMAPS), X, ESS, ESS', ESS'') = ((label L to L'), prepViewMapSet(VMAPS, X, ESS, ESS', ESS'')) . eq prepViewMapSet(none, X, ESS, ESS', ESS'') = none . eq prepETypeList((ES ETL), X, (ES ; ESS)) = (qualify(X, ES) prepETypeList(ETL, X, (ES ; ESS))) . ceq prepETypeList((ES ETL), X, ESS) = (ES prepETypeList(ETL, X, ESS)) if not (ES inSortSet ESS) . eq prepETypeList(nil, X, ESS) = nil . eq prepTerm(F[TL], X, ESS) = F[prepTerm(TL, X, ESS)] . eq prepTerm(V, X, ESS) = if getType(V) inSortSet ESS then qid(string(myGetName(V)) + ":" + string(qualify(X, getType(V)))) else qid(string(myGetName(V)) + ":" + string(getType(V))) fi . eq prepTerm(Ct, X, ESS) = if getType(Ct) inSortSet ESS then qid(string(myGetName(Ct)) + "." + string(qualify(X, getType(Ct)))) else qid(string(myGetName(Ct)) + "." + string(getType(Ct))) fi . eq prepTerm((T, TL), X, ESS) = (prepTerm(T, X, ESS), prepTerm(TL, X, ESS)) . eq prepTerm(error(QIL), X, ESS) = error(QIL) . *** For each parameterized sort *** $\texttt{S[L}_1\texttt{,}\ldots\texttt{,L}_n\texttt{]}$ in the *** body of a parameterized module with *** $\texttt{L}_1\ldots\texttt{L}_n$ the labels of the parameters in *** the interface of the module, a map of the form *** $\texttt{sort\ S[L}_1\texttt{,}\ldots\texttt{,L}_n\texttt{]\ *** to\ S[V}_1\texttt{,}\ldots\texttt{,V}_n\texttt{]}$ *** is generated, where $\texttt{V}_i$ is the name of the view associated to *** the label $\texttt{L}_i$ in the set of pairs given as argument. op genMapSetSortSet : ESortSet Set`(Tuple`(ViewExp`|`ViewExp`)`) -> MapSet . op genMapSetClassSet : ESortSet Set`(Tuple`(ViewExp`|`ViewExp`)`) -> MapSet . op prepESort : ESort Set`(Tuple`(ViewExp`|`ViewExp`)`) -> ESort . op prepESort : ESort ViewExp ViewExp ViewExp Set`(Tuple`(ViewExp`|`ViewExp`)`) Set`(Tuple`(ViewExp`|`ViewExp`)`) -> ESort . eq genMapSetSortSet((S ; ESS), VEPS) = genMapSetSortSet(ESS, VEPS) . eq genMapSetSortSet((eSort(ES, VE) ; ESS), VEPS) = ((sort eSort(ES, VE) to prepESort(eSort(ES, VE), VEPS)), genMapSetSortSet(ESS, VEPS)) . eq genMapSetSortSet(none, VEPS) = none . eq genMapSetClassSet((S ; ESS), VEPS) = genMapSetClassSet(ESS, VEPS) . eq genMapSetClassSet((eSort(ES, VE) ; ESS), VEPS) = ((class eSort(ES, VE) to prepESort(eSort(ES, VE), VEPS)), genMapSetClassSet(ESS, VEPS)) . eq genMapSetClassSet(none, VEPS) = none . eq prepESort(S, VEPS) = S . eq prepESort(eSort(ES, VE), VEPS) = eSort(ES, prepViewExp(VE, VEPS)) . *** The function \texttt{prepImportList} takes a list of importation *** declarations and a set of pairs composed of a label and a view name, and *** returns the list of importations resulting from changing in each of the *** module expressions the occurrences of the labels of the interface of the *** module being instantiated by the names of the views associated to them in *** the list of pairs. op prepImportList : EImportList Set`(Tuple`(ViewExp`|`ViewExp`)`) -> EImportList . op prepModName : ModName Set`(Tuple`(ViewExp`|`ViewExp`)`) -> ModName . op prepModName : ModName Set`(Tuple`(ViewExp`|`ViewExp`)`) Set`(Tuple`(ViewExp`|`ViewExp`)`) -> ModName . op prepModName : ParameterList Set`(Tuple`(ViewExp`|`ViewExp`)`) -> ModName . op prepViewExp : ViewExp Set`(Tuple`(ViewExp`|`ViewExp`)`) -> ViewExp . eq prepImportList(((including MN .) EIL), VEPS) = (if prepModName(MN, VEPS) == nullModName then nil else (including prepModName(MN, VEPS) .) fi prepImportList(EIL, VEPS)) . eq prepImportList(((extending MN .) EIL), VEPS) = (if prepModName(MN, VEPS) == nullModName then nil else (extending prepModName(MN, VEPS) .) fi prepImportList(EIL, VEPS)) . eq prepImportList(((protecting MN .) EIL), VEPS) = (if prepModName(MN, VEPS) == nullModName then nil else (protecting prepModName(MN, VEPS) .) fi prepImportList(EIL, VEPS)) . eq prepImportList(nil, VEPS) = nil . eq prepModName(ME < VE >, VEPS) = prepModName(ME, VEPS) < prepViewExp(VE, VEPS) > . eq prepModName(QI, VEPS) = QI . eq prepModName((par X :: ME), (< Y , Z > VEPS)) = if X == Y then (par Z :: ME) else prepModName((par X :: ME), VEPS) fi . eq prepModName((par X :: ME), none) = (par X :: ME) . eq prepModName((par X :: par(ME, PL)), VEPS) = prepModName((par X :: par(ME, PL)), VEPS, VEPS) . eq prepModName((par X :: par(ME, PL)), (< Y , Z > VEPS), VEPS') = if X == Y then (par Z :: par(ME, prepModName(PL, VEPS', VEPS'))) else prepModName((par X :: par(ME, PL)), VEPS, VEPS') fi . eq prepModName((par X :: par(ME, PL)), none, VEPS) = (par X :: par(ME, prepModName(PL, VEPS, VEPS))) . eq prepModName(parList(PAR:Parameter, PL), VEPS) = parList(prepModName(PAR:Parameter, VEPS), prepModName(PL, VEPS)) . eq prepModName(nilParList, VEPS) = nilParList . eq prepViewExp(VE, < VE, VE' > VEPS) = VE' . eq prepViewExp(QI, VEPS) = QI [owise] . eq prepViewExp(X << VE >>, VEPS) = X << prepViewExp(VE, VEPS) >> [owise] . eq prepViewExp(VE ;; VE', VEPS) = prepViewExp(VE, VEPS) ;; prepViewExp(VE', VEPS) [owise] . ceq prepViewExp(VE | VE', VEPS) = prepViewExp(VE, VEPS) | prepViewExp(VE', VEPS) if VE =/= nullViewExp /\ VE' =/= nullViewExp [owise] . *** lifted views missing *** The function \texttt{unitInst} calls the auxiliary function *** \texttt{unitInstAux}, which proceeds recursively on each of the parameters *** in the interface of the module being instantiated. For each view, a set of *** maps to be applied to the module is generated, which are accumulated in *** the third argument of the function. *** In the base case, when there are no more parameters and no more views, the *** maps for the parameterized sorts are also generated, and all maps are *** then applied. *** \texttt{unitInstAux} proceeds accumulating also the list of parameters *** being modified, the list of importations, and a list of label-view *** pairs (\texttt{QidTuple`(ViewExp`,ViewExp`)}) associating each label in *** the interface to the view used in the instantiation of the theory with *** such label. This list of pairs is used to generate the set of maps of the *** parameterized sorts and to `prepare' the list of importations as *** indicated above. sort TreatParResult . op <_;_;_;_;_> : ViewMapSet ParameterList EImportList Set`(Tuple`(ViewExp`|`ViewExp`)`) Database -> TreatParResult . op mapSet : TreatParResult -> ViewMapSet . op getParList : TreatParResult -> ParameterList . op getImports : TreatParResult -> EImportList . op viewExpPairSet : TreatParResult -> Set`(Tuple`(ViewExp`|`ViewExp`)`) . op db : TreatParResult -> Database . eq mapSet(< VMAPS ; PL ; EIL ; VEPS ; DB >) = VMAPS . eq getParList(< VMAPS ; PL ; EIL ; VEPS ; DB >) = PL . eq getImports(< VMAPS ; PL ; EIL ; VEPS ; DB >) = EIL . eq viewExpPairSet(< VMAPS ; PL ; EIL ; VEPS ; DB >) = VEPS . eq db(< VMAPS ; PL ; EIL ; VEPS ; DB >) = DB . op unitInstAux : Unit Unit ViewMapSet ParameterList ParameterList EImportList EImportList ViewExp Set`(Tuple`(ViewExp`|`ViewExp`)`) ParameterList Database -> Database . op treatPar : Parameter ViewExp Set`(Tuple`(ViewExp`|`ViewExp`)`) ParameterList Database -> TreatParResult . op treatParAux : Qid ModExp ParameterList ViewExp Qid ViewExp ViewExp ParameterList ViewMapSet ParameterList EImportList Set`(Tuple`(ViewExp`|`ViewExp`)`) Database -> TreatParResult . op treatParAux2 : Qid ModExp ParameterList ViewExp Qid ViewExp ViewExp ParameterList ViewMapSet ParameterList EImportList Set`(Tuple`(ViewExp`|`ViewExp`)`) Database -> TreatParResult . eq unitInst(ME, VE, PL, DB) = unitInstAux(setName(getTopUnit(ME, DB), (ME < VE >)), signature(getFlatUnit(ME, DB)), none, getParList(getTopUnit(ME, DB)), nilParList, getImports(getTopUnit(ME, DB)), nil, VE, none, PL, DB) . ceq unitInstAux(U, M, VMAPS, parList(par X :: ME, PL), PL', (EIL (protecting par X :: ME .) EIL'), EIL'', (QI | VE), VEPS, PL'', DB) = unitInstAux(U, M, (VMAPS, VMAPS'), PL, parList(PL', PL'''), (EIL EIL'), (EIL'' EIL'''), VE, (VEPS VEPS'), PL'', DB') if < VMAPS' ; PL''' ; EIL''' ; VEPS' ; DB' > := treatPar(par X :: ME, QI, VEPS, PL'', DB) . ceq unitInstAux(U, M, VMAPS, parList(par X :: ME, PL), PL', (EIL (protecting par X :: ME .) EIL'), EIL'', ((QI << VE >>) | VE'), VEPS, PL'', DB) = unitInstAux(U, M, (VMAPS, VMAPS'), PL, parList(PL', PL'''), (EIL EIL'), (EIL'' EIL'''), VE', (VEPS VEPS'), PL'', DB') if < VMAPS' ; PL''' ; EIL''' ; VEPS' ; DB' > := treatPar(par X :: ME, QI << VE >>, VEPS, PL'', DB) . ceq unitInstAux(U, M, VMAPS, parList(par X :: par(ME, PL), PL'), PL'', (EIL (protecting par X :: par(ME, PL) .) EIL'), EIL'', ((QI << VE >>) | VE'), VEPS, PL''', DB) = unitInstAux(U, M, (VMAPS, VMAPS'), PL', parList(PL'', PL''''), (EIL EIL'), (EIL'' EIL'''), VE', (VEPS VEPS'), PL''', DB') if < VMAPS' ; PL'''' ; EIL''' ; VEPS' ; DB' > := treatPar(par X :: par(ME, PL), QI << VE >>, VEPS, PL''', evalViewExp(QI << VE >>, PL''', DB)) . ceq unitInstAux(U, M, VMAPS, parList(par X :: par(ME, PL), PL'), PL'', (EIL (protecting par X :: par(ME, PL) .) EIL'), EIL'', QI | VE, VEPS, PL''', DB) = unitInstAux(U, M, (VMAPS, VMAPS'), PL', parList(PL'', PL''''), (EIL EIL'), (EIL'' EIL'''), VE, (VEPS VEPS'), PL''', DB') if < VMAPS' ; PL'''' ; EIL''' ; VEPS' ; DB' > := treatPar(par X :: par(ME, PL), QI, VEPS, PL''', DB) . eq unitInstAux( U, M, VMAPS, nilParList, PL, EIL, EIL', nullViewExp, VEPS, PL', DB) = evalUnit( setImports( setPars( applyMapSetToUnit( (VMAPS, genMapSetSortSet( (getSorts(U) ; getSortSetAux(getImports(U), DB)), VEPS), genMapSetClassSet( (getClassesESortSet(getClasses(U)) ; getClassSetAux(getImports(U), DB)), VEPS)), U, M), PL), (prepImportList(EIL, VEPS) EIL')), DB) . ---- eq unitInstAux( ---- U, M, VMAPS, nilParList, PL, EIL, EIL', nullViewExp, VEPS, PL', DB) ---- = evalUnit( ---- setImports( ---- setPars( ---- applyMapSetToUnit( ---- (VMAPS, ---- genMapSetSortSet( ---- (getSorts(U) ; getSortSetAux(getImports(U), DB)), VEPS), ---- genMapSetClassSet( ---- (getClassesESortSet(getClasses(U)) ; ---- getClassSetAux(getImports(U), DB)), VEPS)), ---- U, ---- applyMapSetToUnit3( ---- sortMaps( ---- eSortToSort( ---- (VMAPS, ---- genMapSetSortSet( ---- (getSorts(U) ; getSortSetAux(getImports(U), DB)), VEPS), ---- genMapSetClassSet( ---- (getClassesESortSet(getClasses(U)) ; ---- getClassSetAux(getImports(U), DB)), VEPS)))), none, ---- M, M)), ---- PL), ---- (prepImportList(EIL, VEPS) EIL')), ---- DB) . eq unitInstAux(error(QIL), UK:[Unit], VMAPS, PL, PL', EIL, EIL', VE, VEPS, PL'', DB) = warning(DB, QIL) . eq unitInstAux(noUnit, error(QIL), VMAPS, PL, PL', EIL, EIL', VE, VEPS, PL'', DB) = warning(DB, QIL) . eq unitInstAux(U, M, VMAPS, parList((par X :: ME), PL), PL', EIL, EIL', nullViewExp, VEPS, PL'', DB) = warning(DB, ('\r 'Error: '\o 'Incorrect 'module modNameToQidList(getName(U)) '. '\n)) . eq unitInstAux(U, M, VMAPS, nilParList, PL, EIL, EIL', (QI | VE), VEPS, PL', DB) = warning(DB, ('\r 'Error: '\o 'Incorrect 'module modNameToQidList(getName(U)) '. '\n)) . eq treatParView(par X :: ME, VE, ME', VEPS, PL, DB) = if labelInModExp(X, ME') then treatPar(par X :: ME, VE, VEPS, PL, DB) else < none ; getParList(treatPar(par X :: ME, VE, VEPS, PL, DB)) ; getImports(treatPar(par X :: ME, VE, VEPS, PL, DB)) ; viewExpPairSet(treatPar(par X :: ME, VE, VEPS, PL, DB)) ; db(treatPar(par X :: ME, VE, VEPS, PL, DB)) > fi . eq treatParView(par X :: par(ME, PL), Y << VE >>, ME', VEPS, PL', DB) = if labelInModExp(X, ME') then treatPar(par X :: par(ME, PL), Y << VE >>, VEPS, PL', DB) else < none ; getParList(treatPar(par X :: par(ME, PL), Y << VE >>, VEPS, PL', DB)) ; getImports(treatPar(par X :: par(ME, PL), Y << VE >>, VEPS, PL', DB)) ; viewExpPairSet(treatPar(par X :: par(ME, PL), Y << VE >>, VEPS, PL', DB)) ; db(treatPar(par X :: par(ME, PL), Y << VE >>, VEPS, PL', DB)) > fi . op labelInModExp : Qid ModExp -> Bool . op labelInViewExp : Qid ViewExp -> Bool . eq labelInModExp(X, QI) = X == QI . eq labelInModExp(X, (ME < VE >)) = labelInViewExp(X, VE) . eq labelInViewExp(X, QI) = X == QI . eq labelInViewExp(X, (VE | VE')) = labelInViewExp(X, VE) or-else labelInViewExp(X, VE') . eq labelInViewExp(X, (VE ;; VE')) = labelInViewExp(X, VE) or-else labelInViewExp(X, VE') . eq labelInViewExp(X, QI << VE >>) = X == QI or-else labelInViewExp(X, VE) . eq labelInViewExp(X, _`{_`}(QI, VE)) = X == QI or-else labelInViewExp(X, VE) . eq treatPar(par X :: ME, VE, VEPS, PL, DB) = if VE :: Qid and-then labelInParList(VE, PL) then < (genMapSetQualSortSet(X, VE, getThSortSet(ME, DB), VEPS), genMapSetQualClassSet(X, VE, getThClassSet(ME, DB), VEPS)) ; par VE :: ME ; (protecting (par VE :: ME) .) ; < X, VE > ; createCopy((par VE :: ME), DB) > else if viewInDb(VE, DB) then if getTopUnit(target(getView(VE, DB)), DB) :: StrTheory then < prepViewMapSet( mapSet(getView(VE, DB)), X, getThSortSet(ME, DB), getThSortSet(target(getView(VE, DB)), DB), getThClassSet(target(getView(VE, DB)), DB)) ; par X :: target(getView(VE, DB)) ; (protecting (par X :: target(getView(VE, DB))) .) ; < X , (VE ;; X) > ; createCopy((par X :: target(getView(VE, DB))), DB) > else < prepViewMapSet( mapSet(getView(VE, DB)), X, getThSortSet(ME, DB), none, none) ; getParList(getTopUnit(target(getView(VE, DB)), DB)) ; (protecting target(getView(VE, DB)) .) ; < X , VE > ; DB > fi else < none ; nilParList ; nil ; none ; warning(DB, '\r 'Error: '\o 'View viewExpToQid(VE) 'not 'in 'database. '\n) > fi fi . ceq treatPar(par X :: par(ME, PL), QI, VEPS, PL', DB) = if viewInDb(QI, DB) then treatParAux2(X, ME, PL, nullViewExp, ME', VE, VE, PL', mapSet(VI), nilParList, protecting target(VI) ., VEPS, DB) else < none ; nilParList ; nil ; none ; warning(DB, '\r 'Error: '\o 'View viewExpToQid(QI) 'not 'in 'database. '\n) > fi if VI := getView(QI, DB) /\ ME' < VE > := source(VI) . eq treatPar(par X :: par(ME, PL), VE << VE' >>, VEPS, PL', DB) = treatParAux(X, ME, PL, nullViewExp, VE, VE', VE', PL', none, nilParList, nil, VEPS, DB) . ceq treatParAux(X, ME, parList(P, PL), VE, Y, (QI | VE'), VE'', PL', VMAPS, PL'', EIL, VEPS, DB) = treatParAux(X, ME, PL, VE | QI, Y, VE', VE'', PL', (VMAPS, VMAPS'), parList(PL'', PL'''), (EIL EIL'), (VEPS VEPS'), DB') if < VMAPS' ; PL''' ; EIL' ; VEPS' ; DB' > := treatPar(P, QI, VEPS, PL', DB) . ceq treatParAux(X, ME, parList(P, PL), VE, Y, (VE''' << VE'''' >> | VE'), VE'', PL', VMAPS, PL'', EIL, VEPS, DB) = treatParAux(X, ME, PL, VE | VE''' << VE'''' >>, Y, VE', VE'', PL', (VMAPS, VMAPS'), parList(PL'', PL'''), (EIL EIL'), (VEPS VEPS'), DB') if < VMAPS' ; PL''' ; EIL' ; VEPS' ; DB' > := treatPar(P, VE''' << VE'''' >>, VEPS, PL', DB) . ceq treatParAux(X, ME, nilParList, VE, Y, nullViewExp, VE', PL', VMAPS, PL'', EIL, VEPS, DB) = if getTopUnit(target(getView(Y << VE' >>, DB)), DB) :: StrTheory then < prepViewMapSet( mapSet(getView(Y << VE' >>, DB)), X, getThSortSet(ME, DB), getThSortSet(target(getView(Y << VE' >>, DB)), DB), getThClassSet(target(getView(Y << VE' >>, DB)), DB)) ; par X :: target(getView(Y << VE' >>, DB)) ; EIL (protecting (par X :: target(getView(Y << VE' >>, DB))) .) ; < X << VE >>, Y << VE' << X >> >> > ; createCopy((par X :: target(getView(Y << VE' >>, DB))), DB) > else < (VMAPS, prepViewMapSet(mapSet(getView(Y << VE' >>, DB)), X, getThSortSet(source(getView(Y << VE' >>, DB)), DB), none, none)); getParList(getTopUnit(target(getView(Y << VE' >>, DB)), DB)) ; EIL (protecting target(getView(Y << VE' >>, DB)) .) ; < X << VE >>, Y << VE' >> > VEPS ; DB > fi if viewInDb(Y << VE' >>, DB) . eq treatParAux(X, ME, nilParList, VE, Y, nullViewExp, VE', PL', VMAPS, PL'', EIL, VEPS, DB) = < none ; nil ; nil ; none ; warning(DB, '\r 'Error: '\o 'View viewExpToQid(Y << VE' >>) 'not 'in 'database. '\n) > [owise] . ceq treatParAux2(X, ME, parList(P, PL), VE, Y, (QI | VE'), VE'', PL', VMAPS, PL'', EIL, VEPS, DB) = treatParAux2(X, ME, PL, VE | QI, Y, VE', VE'', PL', (VMAPS, VMAPS'), parList(PL'', PL'''), (EIL EIL'), (VEPS VEPS'), DB') if < VMAPS' ; PL''' ; EIL' ; VEPS' ; DB' > := treatPar(P, QI, VEPS, PL', DB) . ceq treatParAux2(X, ME, parList(P, PL), VE, Y, (VE''' << VE'''' >> | VE'), VE'', PL', VMAPS, PL'', EIL, VEPS, DB) = treatParAux2(X, ME, PL, VE | VE''' << VE'''' >>, Y, VE', VE'', PL', (VMAPS, VMAPS'), parList(PL'', PL'''), (EIL EIL'), (VEPS VEPS'), DB') if < VMAPS' ; PL''' ; EIL' ; VEPS' ; DB' > := treatPar(P, VE''' << VE'''' >>, VEPS, PL', DB) . eq treatParAux2(X, ME, nilParList, VE, Y, nullViewExp, VE', PL', VMAPS, PL'', EIL, VEPS, DB) = < VMAPS ; nilParList ; EIL ; VEPS ; DB > . eq treatParAux2(X, ME, PL, VE, Y, VE', VE'', PL', VMAPS, PL'', EIL, VEPS, DB) = < none ; nil ; nil ; none ; warning(DB, '\r 'Error: '\o 'Nonvalid 'View viewExpToQid(Y << VE' >>) '\n) > [owise] . op viewInstAux : View ViewMapSet ParameterList ParameterList ViewExp Set`(Tuple`(ViewExp`|`ViewExp`)`) ParameterList Database -> Database . op treatParView : Parameter ViewExp ModExp Set`(Tuple`(ViewExp`|`ViewExp`)`) ParameterList Database -> TreatParResult . op treatPar : Parameter ViewExp Set`(Tuple`(ViewExp`|`ViewExp`)`) ParameterList Database -> TreatParResult . op treatParAux : Qid ModExp ParameterList Qid ViewExp ViewExp ParameterList ViewMapSet ParameterList EImportList Set`(Tuple`(ViewExp`|`ViewExp`)`) Database -> TreatParResult . eq viewInst(VE, VE', PL, DB) = viewInstAux(setName(getView(VE, DB), VE << VE' >>), none, getParList(getView(VE, DB)), nilParList, VE', none, PL, DB) . eq viewInstAux(VI, VMAPS, parList(par X :: ME, PL), PL', (QI | VE), VEPS, PL'', DB) = viewInstAux(VI, (VMAPS, mapSet(treatParView(par X :: ME, QI, source(VI), VEPS, PL'', DB))), PL, parList(PL', getParList(treatParView(par X :: ME, QI, source(VI), VEPS, PL'', DB))), VE, (VEPS viewExpPairSet(treatParView(par X :: ME, QI, source(VI), VEPS, PL'', DB))), PL'', db(treatParView((par X :: ME), QI, source(VI), VEPS, PL'', DB))) . eq viewInstAux(VI, VMAPS, parList((par X :: ME), PL), PL', ((QI << VE >>) | VE'), VEPS, PL'', DB) = viewInstAux(VI, (VMAPS, mapSet(treatParView(par X :: ME, QI << VE >>, source(VI), VEPS, PL'', DB))), PL, parList(PL', getParList(treatParView(par X :: ME, QI << VE >>, source(VI), VEPS, PL'', DB))), VE', (VEPS viewExpPairSet(treatParView(par X :: ME, QI << VE >>, source(VI), VEPS, PL'', DB))), PL'', db(treatPar((par X :: ME), QI << VE >>, VEPS, PL'', DB))) . eq viewInstAux(VI, VMAPS, parList((par X :: par(ME, PL)), PL'), PL'', ((QI << VE >>) | VE'), VEPS, PL''', DB) = viewInstAux(VI, (VMAPS, mapSet(treatParView((par X :: par(ME, PL)), QI, source(VI), VEPS, PL''', DB))), PL', parList(PL'', getParList(treatParView((par X :: par(ME, PL)), QI, source(VI), VEPS, PL''', DB))), VE, (VEPS viewExpPairSet(treatParView((par X :: par(ME, PL)), QI, source(VI), VEPS, PL''', DB))), PL''', db(treatParView((par X :: par(ME, PL)), QI, source(VI), VEPS, PL''', DB))) . eq viewInstAux(VI, VMAPS, nilParList, PL, nullViewExp, VEPS, PL', DB) = insertView( setPars( setSource( setTarget( setMapSet(VI, applyMapSetToViewMapSet( (genMapSetSortSet(getSortSet(source(VI), DB), VEPS), genMapSetClassSet(getClassSet(source(VI), DB), VEPS)), (VMAPS, genMapSetSortSet(getSortSet(target(VI), DB), VEPS), genMapSetClassSet(getClassSet(target(VI), DB), VEPS)), mapSet(VI))), prepModName(target(VI), VEPS)), prepModName(source(VI), VEPS)), PL), evalModExp(prepModName(target(VI), VEPS), PL', evalModExp(prepModName(source(VI), VEPS), PL', DB))) . eq viewInstAux(error(QIL), VMAPS, PL0:[ParameterList], PL, VE, VEPS, PL', DB) = warning(DB, QIL) . eq viewInstAux(VI, VMAPS, parList((par X :: ME), PL), PL', nullViewExp, VEPS, PL'', DB) = warning(DB, ('\r 'Error: '\o 'Incorrect 'view viewExpToQidList(name(VI)) '. '\n)) . eq viewInstAux(VI, VMAPS, nilParList, PL, (QI | VE), VEPS, PL', DB) = warning(DB, ('\r 'Error: '\o 'Incorrect 'view viewExpToQidList(name(VI)) '. '\n)) . eq viewInstAux(VI, VMAPS, parList((par X :: par(ME, PL)), PL'), PL'', QI, VEPS, PL''', DB) = warning(DB, ('\r 'Error: '\o 'Wrong 'instantiation viewExpToQidList(name(VI)) '. '\n)) . eq viewInstAux(VI, VMAPS, parList((par X :: ME), PL), PL', ((QI << VE >>) | VE'), VEPS, PL'', DB) = warning(DB, ('\r 'Error: '\o 'Wrong 'instantiation viewExpToQidList(name(VI)) '. '\n)) . op applyMapSetToViewMapSet : ViewMapSet ViewMapSet ViewMapSet -> ViewMapSet . op applyMapSetToTerm : ViewMapSet TermList -> TermList . eq applyMapSetToViewMapSet(VMAPS, VMAPS', (op F to F' [AtS], VMAPS'')) = (op F to F' [AtS], applyMapSetToViewMapSet(VMAPS, VMAPS', VMAPS'')) . eq applyMapSetToViewMapSet(VMAPS, VMAPS', (op F : ETL -> ES to F' [AtS], VMAPS'')) = (op F : applyMapSetToTypeList(VMAPS, ETL) -> applyMapSetToEType(VMAPS, ES) to F' [AtS], applyMapSetToViewMapSet(VMAPS, VMAPS', VMAPS'')) . eq applyMapSetToViewMapSet(VMAPS, VMAPS', ((sort ES to ES'), VMAPS'')) = ((sort applyMapSetToEType(VMAPS, ES) to applyMapSetToEType(VMAPS', ES')), applyMapSetToViewMapSet(VMAPS, VMAPS', VMAPS'')) . eq applyMapSetToViewMapSet(VMAPS, VMAPS', ((label L to L'), VMAPS'')) = ((label L to L'), applyMapSetToViewMapSet(VMAPS, VMAPS', VMAPS'')) . eq applyMapSetToViewMapSet(VMAPS, VMAPS', ((class ES to ES'), VMAPS'')) = ((class applyMapSetToEType(VMAPS, ES) to applyMapSetToEType(VMAPS',ES')), applyMapSetToViewMapSet(VMAPS, VMAPS', VMAPS'')) . eq applyMapSetToViewMapSet(VMAPS, VMAPS', ((attr A . ES to A'), VMAPS'')) = ((attr A . applyMapSetToEType(VMAPS, ES) to A'), applyMapSetToViewMapSet(VMAPS, VMAPS', VMAPS'')) . eq applyMapSetToViewMapSet(VMAPS, VMAPS', ((msg F to F'), VMAPS'')) = ((msg F to F'), applyMapSetToViewMapSet(VMAPS, VMAPS', VMAPS'')) . eq applyMapSetToViewMapSet(VMAPS, VMAPS', ((msg F : ETL -> ES to F'), VMAPS'')) = ((msg F : applyMapSetToTypeList(VMAPS, ETL) -> applyMapSetToEType(VMAPS, ES) to F'), applyMapSetToViewMapSet(VMAPS, VMAPS', VMAPS'')) . eq applyMapSetToViewMapSet(VMAPS, VMAPS', (termMap(T, T'), VMAPS'')) = (termMap(applyMapSetToTerm(VMAPS, T), applyMapSetToTerm(VMAPS', T')), applyMapSetToViewMapSet(VMAPS, VMAPS', VMAPS'')) . eq applyMapSetToViewMapSet(VMAPS, VMAPS', none) = none . eq applyMapSetToTerm(VMAPS, Ct) = qid(string(myGetName(Ct)) + "." + string(applyMapSetToSort(VMAPS, getType(Ct)))) . eq applyMapSetToTerm(VMAPS, V) = V . eq applyMapSetToTerm(VMAPS, error(QIL)) = error(QIL) . ceq applyMapSetToTerm(VMAPS, F[TL]) = F[applyMapSetToTerm(VMAPS, TL)] if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) . eq applyMapSetToTerm(VMAPS, '<_:_|_>[O, Ct, T]) = '<_:_|_>[applyMapSetToTerm(VMAPS, O), qid(string(applyMapSetToClassName(VMAPS, myGetName(Ct))) + "." + string(applyMapSetToClassSort(VMAPS, getType(Ct)))), applyMapSetToTerm(VMAPS, T)] . ceq applyMapSetToTerm(VMAPS, '<_:_|_>[O, C, T]) = '<_:_|_>[applyMapSetToTerm(VMAPS, O), applyMapSetToClassName(VMAPS, C), applyMapSetToTerm(VMAPS, T)] if not C :: Constant . eq applyMapSetToTerm(VMAPS, '<_:_|`>[O, Ct]) = '<_:_|_>[applyMapSetToTerm(VMAPS, O), qid(string(applyMapSetToClassName(VMAPS, myGetName(Ct))) + "." + string(applyMapSetToClassSort(VMAPS, getType(Ct)))), 'none.AttributeSet] . ceq applyMapSetToTerm(VMAPS, '<_:_|`>[O, C]) = '<_:_|_>[applyMapSetToTerm(VMAPS, O), applyMapSetToClassName(VMAPS, C), 'none.AttributeSet] if not C :: Constant . eq applyMapSetToTerm(VMAPS, (T, TL)) = (applyMapSetToTerm(VMAPS, T), applyMapSetToTerm(VMAPS, TL)) . *** As pointed out in Section~\ref{module-names}, for each new module *** expression constructor being introduced, we need to add equations for the *** operator \texttt{modNameToQid}. Since the function to transform view *** expressions into lists of quoted identifiers was already defined in *** Section~\ref{VIEW-EXPR}, we just need to add the following equation. eq modNameToQid((ME < VE >)) = qidListToQid(modNameToQid(ME) '`( viewExpToQid(VE) '`)) . ceq modNameToQidList((ME < VE >)) = (if QI == '\s then QIL else QIL QI fi '`( viewExpToQidList(VE) '`) '\s) if QIL QI := modNameToQidList(ME) . *** Given a module expression of the form \verb~ME < VE >~ such that *** \texttt{ME} is in the database, we need to add \verb~ME < VE >~ to the set *** of names of the modules depending on \texttt{ME} and on \texttt{VE}. *** Since \texttt{VE} may be a composed view expression, we have to add the *** name of the module to each of the views in it. In this way, if \texttt{ME} *** or any of the views in \texttt{VE} is redefined or removed from the *** database, \verb~ME < VE >~ will be removed as well. eq setUpModExpDeps(ME < VE >, db((< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = viewExpDeps((ME < VE >), VE, db((< ME ; DT ; U ; U' ; M ; VDS ; (MNS . (ME < VE >)) ; VES > IS), MNS', VES', QIL)) . eq setUpModExpDeps(ME < VE >, db((< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = viewExpDeps((ME < VE >), VE, db((< ME ; DM ; U ; U' ; M ; VDS ; (MNS . (ME < VE >)) ; VES > IS), MNS', VES', QIL)) . eq setUpModExpDeps(('META-LEVEL < VE >), DB) = setUpModExpDeps(('META-LEVEL < VE >), VE, DB) . eq setUpModExpDeps(('META-LEVEL < QI >), db((< QI ; DT ; U ; U' ; M ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = db(< QI ; DT ; U ; U' ; M ; VDS ; MNS . ('META-LEVEL < QI >) ; VES > IS, MNS', VES', QIL) . eq setUpModExpDeps(('META-LEVEL < QI >), db((< QI ; DM ; U ; U' ; M ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = db(< QI ; DM ; U ; U' ; M ; VDS ; MNS . ('META-LEVEL < QI >) ; VES > IS, MNS', VES', QIL) . ceq setUpModExpDeps((ME < VE >), DB) = warning(DB, ('\r 'Error: '\o 'Module modNameToQidList(ME) 'not 'in 'database. '\n)) if (ME =/= 'META-LEVEL) /\ (not unitInDb(ME, DB)) . eq setUpModExpDeps(('META-LEVEL < VE >), (QI | VE'), db((< QI ; DT ; U ; U' ; M ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = setUpModExpDeps(('META-LEVEL < VE >), VE', db((< QI ; DT ; U ; U' ; M ; VDS ; (MNS . ('META-LEVEL < VE >)) ; VES > IS), MNS', VES', QIL)) . eq setUpModExpDeps(('META-LEVEL < VE >), (QI | VE'), db((< QI ; DM ; U ; U' ; M ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = setUpModExpDeps(('META-LEVEL < VE >), VE', db((< QI ; DM ; U ; U' ; M ; VDS ; (MNS . ('META-LEVEL < VE >)) ; VES > IS), MNS', VES', QIL)) . eq setUpModExpDeps(('META-LEVEL < VE >), nullViewExp, DB) = DB . op viewExpDeps : ModName ViewExp Database -> Database . eq viewExpDeps(MN, QI << VE >> | VE', db(< QI << VE >> ; DT ; VI ; MNS ; VES > IS, MNS', VES', QIL)) = viewExpDeps(MN, VE', db(< QI << VE >> ; DT ; VI ; MNS . MN ; VES > IS, MNS', VES', QIL)) . ceq viewExpDeps(MN, QI << VE >> | VE', DB) = viewExpDeps(MN, VE', DB) if not viewInDb(QI << VE >>, DB) . ceq viewExpDeps(MN, (QI | VE), db(< QI ; DT ; VI ; MNS ; VES > IS, MNS', VES', QIL)) = viewExpDeps(MN, VE, db(< QI ; DT ; VI ; MNS . MN ; VES > IS, MNS', VES', QIL)) if QI =/= nullViewExp . ceq viewExpDeps(MN, QI | VE, DB) = DB if not viewInDb(QI, DB) . eq viewExpDeps(MN, nullViewExp, DB) = DB . endfm ******************************************************************************* *** *** 6.10 Renaming of Units *** *** In addition to the declaration of the constructor for renaming module *** expressions, the following module \texttt{RENAMING-EXPR-EVALUATION} *** introduces equations to treat this new case in the definition of functions *** \texttt{evalModExp}, \texttt{modNameToQidList}, \texttt{prepModName}, and *** \texttt{setUpUnitDependencies}. *** A renaming expression is evaluated by applying the renaming maps, not only *** to the top unit, but also to the part of the structure \emph{affected} by *** the maps. The renaming process propagates downwards in the unit hierarchy *** while the units in the structure are affected by the renamings. We say that *** a unit is affected by a set of maps (checked by the \texttt{moduleAffected} *** function) when any of the maps is applicable to any of the declarations in *** the unit, or in any of its subunits. The application of a set of maps to a *** single unit is accomplished by the \texttt{applyMapSetToUnit} function, *** discussed in Section~\ref{applyMapSetToUnit}. fmod RENAMING-EXPR-EVALUATION is pr DATABASE . pr VIEW-MAP-SET-APPL-ON-UNIT . pr EVALUATION . inc MOD-EXPR . pr MOD-EXPR-EVAL . pr INST-EXPR-EVALUATION . pr MAP . pr DECL-EXT-SORT-TO-QID . vars ME ME' : ModExp . var MNS MNS' : ModNameSet . vars M M' : Module . vars PU U U' DM : Unit . var DB : Database . vars ES ES' : ESort . var QIL : QidList . vars VES VES' : ViewExpSet . var IS : InfoSet . var PL : ParameterList . vars EIL EIL' : EImportList . var VMAP : ViewMap . var VMAPS : ViewMapSet . var VEPS : Set`(Tuple`(ViewExp`|`ViewExp`)`) . var MN : ModName . vars X QI QI' QI'' S F F' F'' L L' L'' A A' A'' : Qid . vars ES'' C C' C'' : ESort . vars ESS : ESortSet . vars ETL ETL' : ETypeList . var ET : EType . vars T T' T'' T''' : Term . var DT : Default`(Term`) . var TL : TermList . var EOPD : EOpDeclSet . var EOPDS : EOpDeclSet . vars AtS AtS' : AttrSet . var Rl : Rule . var RlS : RuleSet . var CD : ClassDecl . var CDS : ClassDeclSet . var ADS : AttrDeclSet . var MD : MsgDecl . var MDS : MsgDeclSet . var MAP : Map . var MAPS : MapSet . var I : Nat . var NL : IntList . var H : Hook . var HL : HookList . var VDS : OpDeclSet . *** The function \texttt{createCopyRenaming} creates a copy of the part of the *** structure of the specified module which is affected by the renaming, *** applying to each of the generated modules in the new structure the subset *** of maps affecting each one of them. The equation extending the *** \texttt{evalModExp} function to the renaming module expression is then *** reduced to a call to \texttt{createCopyRenaming} with the appropriate *** arguments. eq labelInModExp(X, _*<_>(ME, MAPS)) = labelInModExp(X, ME) . op createCopyRenaming : ModExp ModExp Unit Database -> Database . eq evalModExp(_*<_>(ME, VMAPS), PL, DB) = if unitInDb(_*<_>(ME, VMAPS), DB) then DB else createCopyRenaming(ME, _*<_>(ME, VMAPS), getFlatUnit(ME, evalModExp(ME, PL, DB)), evalModExp(ME, PL, DB)) fi . *** The predicate \texttt{moduleAffected} checks whether the module with the *** name given as first argument in the database is affected by the set of maps *** given as second argument. A module is affected by a map set if any of the *** maps is applicable to the module or to any of its submodules. op moduleAffected : ModName ViewMapSet Module Database -> Bool . op moduleAffectedAux : Unit ViewMapSet Module Database -> Bool . op opsAffected : EOpDeclSet ViewMapSet Module -> Bool . op sortsAffected : ESortSet ViewMapSet -> Bool . op rlsAffected : RuleSet ViewMapSet -> Bool . op importsAffected : EImportList ViewMapSet Module Database -> Bool . op classesAffected : ClassDeclSet ViewMapSet -> Bool . op msgsAffected : MsgDeclSet ViewMapSet Module -> Bool . eq moduleAffected(MN, VMAPS, M, DB) = moduleAffectedAux(getTopUnit(MN, DB), VMAPS, M, DB) . eq moduleAffectedAux(U, VMAPS, M, DB) = sortsAffected(getSorts(U), VMAPS) or-else (opsAffected(getOps(U), VMAPS, M) or-else ((not U :: FUnit and-then (rlsAffected(getRls(U), VMAPS) or-else (not U :: SUnit and-then (classesAffected(getClasses(U), VMAPS) or-else msgsAffected(getMsgs(U), VMAPS, M))))) or-else importsAffected(getImports(U), VMAPS, M, DB))) . eq importsAffected(((including MN .) EIL), VMAPS, M, DB) = if (MN inModNameSet builtIns) then importsAffected(EIL, VMAPS, M, DB) else (moduleAffected(MN, VMAPS, M, DB) or-else importsAffected(EIL, VMAPS, M, DB)) fi . eq importsAffected(((extending MN .) EIL), VMAPS, M, DB) = if (MN inModNameSet builtIns) then importsAffected(EIL, VMAPS, M, DB) else (moduleAffected(MN, VMAPS, M, DB) or-else importsAffected(EIL, VMAPS, M, DB)) fi . eq importsAffected(((protecting MN .) EIL), VMAPS, M, DB) = if (MN inModNameSet builtIns) then importsAffected(EIL, VMAPS, M, DB) else (moduleAffected(MN, VMAPS, M, DB) or-else importsAffected(EIL, VMAPS, M, DB)) fi . eq importsAffected(nil, VMAPS, M, DB) = false . eq opsAffected(((op F : ETL -> ES [AtS] .) EOPDS), ((op F' to F'' [AtS']), VMAPS), M) = (F == F') or-else (opsAffected((op F : ETL -> ES [AtS] .), VMAPS, M) or-else opsAffected(EOPDS, ((op F' to F'' [AtS']), VMAPS), M)) . eq opsAffected(((op F : ETL -> ES [AtS] .) EOPDS), ((op F' : ETL' -> ES' to F'' [AtS']), VMAPS), M) = ((F == F') and-then eSameKind(M, (ETL ES), (ETL' ES'))) or-else (opsAffected((op F : ETL -> ES [AtS] .), VMAPS, M) or-else opsAffected(EOPDS, ((op F' : ETL' -> ES' to F'' [AtS']), VMAPS), M)) . ceq opsAffected((EOPD EOPDS), (VMAP, VMAPS), M) = opsAffected((EOPD EOPDS), VMAPS, M) if not (VMAP :: OpMap) . eq opsAffected(EOPDS, none, M) = false . eq opsAffected(none, VMAPS, M) = false . eq sortsAffected((ES ; ESS), ((sort ES' to ES''), VMAPS)) = (ES == ES') or-else (sortsAffected(ES, VMAPS) or-else sortsAffected(ESS, ((sort ES' to ES''), VMAPS))) . ceq sortsAffected((ES ; ESS), (VMAP, VMAPS)) = sortsAffected((ES ; ESS), VMAPS) if not (VMAP :: SortMap) . eq sortsAffected(ESS, none) = false . eq sortsAffected(none, VMAPS) = false . eq rlsAffected(((rl T => T' [label(L) AtS] .) RlS), ((label L' to L''), VMAPS)) = (L == L') or-else (rlsAffected((rl T => T' [label(L) AtS] .), VMAPS) or-else rlsAffected(RlS, ((label L' to L''), VMAPS))) . eq rlsAffected(((crl T => T' if T'' = T''' [label(L) AtS] .) RlS), ((label L' to L''), VMAPS)) = (L == L') or-else (rlsAffected((crl T => T' if T'' = T''' [label(L) AtS] .), VMAPS) or-else rlsAffected(RlS, ((label L' to L''), VMAPS))) . ceq rlsAffected((Rl RlS), (VMAP, VMAPS)) = rlsAffected((Rl RlS), VMAPS) if not (VMAP :: LabelMap) . eq rlsAffected(RlS, none) = false . eq rlsAffected(none, VMAPS) = false . eq classesAffected(((class C | ADS .) CDS), ((class C' to C''), VMAPS)) = (C == C') or-else (classesAffected((class C | ADS .), VMAPS) or-else classesAffected(CDS, ((class C' to C''), VMAPS))) . eq classesAffected(((class C | ((attr A : ES), ADS) .) CDS), ((attr A' . C' to A''), VMAPS)) = if C == C' then (A == A') or-else (classesAffected(((class C | ADS .) CDS), ((attr A' . C' to A''), VMAPS)) or-else classesAffected(CDS, VMAPS)) else classesAffected((class C | ((attr A : ES), ADS) .), VMAPS) or-else classesAffected(CDS, ((attr A' . C' to A''), VMAPS)) fi . ceq classesAffected((CD CDS), (VMAP, VMAPS)) = classesAffected((CD CDS), VMAPS) if not (VMAP :: ClassMap or VMAP :: AttrMap) . eq classesAffected(CDS, none) = false . eq classesAffected(none, VMAPS) = false . eq msgsAffected(((msg F : ETL -> ES .) MDS), ((msg F' to F''), VMAPS), M) = (F == F') or-else (msgsAffected((msg F : ETL -> ES .), VMAPS, M) or-else msgsAffected(MDS, ((msg F' to F''), VMAPS), M)) . eq msgsAffected(((msg F : ETL -> ES .) MDS), ((msg F' : ETL' -> ES' to F''), VMAPS), M) = ((F == F') and-then eSameKind(M, (ETL ES), (ETL' ES'))) or-else (msgsAffected((msg F : ETL -> ES .), VMAPS, M) or-else msgsAffected(MDS, ((msg F' : ETL' -> ES' to F''), VMAPS), M)) . ceq msgsAffected((MD MDS), (VMAP, VMAPS), M) = msgsAffected((MD MDS), VMAPS, M) if not (VMAP :: MsgMap) . eq msgsAffected(MDS, none, M) = false . eq msgsAffected(none, VMAPS, M) = false . *** The function \texttt{mapSetRestriction} returns the subset of the view *** maps given as second argument that affect the given module. op mapSetRestriction : Unit ViewMapSet Module Database -> ViewMapSet . eq mapSetRestriction(U, (VMAP, VMAPS), M, DB) = if moduleAffectedAux(U, VMAP, M, DB) then (VMAP, mapSetRestriction(U, VMAPS, M, DB)) else mapSetRestriction(U, VMAPS, M, DB) fi . eq mapSetRestriction(U, none, M, DB) = none . *** We proceed downwards while the set of maps affects the module, but we do so *** restricting the set of maps to the subset affecting the module. Since *** operator and message maps in which arity and coarity are specified must be *** applied to the whole subsort-overloaded family of operators or messages, we *** have to carry along the signature of the module at the top to make all the *** calls to the engine. Note that we may have maps of operations or messages *** with the domain given by sorts that are not in the submodules but which *** have other sorts in the submodules in the same connected components. op applyMapSetRecursively : MapSet EImportList EImportList Unit Module Database -> Database . eq createCopyRenaming(ME, _*<_>(ME, VMAPS), M, DB) = if not unitInDb(_*<_>(ME, VMAPS), DB) then applyMapSetRecursively( VMAPS, getImports(getTopUnit(ME, DB)), nil, setName(applyMapSetToUnit(VMAPS, getTopUnit(ME, DB), M), _*<_>(ME, VMAPS)), M, DB) else DB fi . eq createCopyRenaming(ME, ME', error(QIL), DB) = warning(DB, QIL) . eq applyMapSetRecursively(VMAPS, ((including MN .) EIL), EIL', U, M, DB) *** The vbles in MN where added to M in the calls to moduleAffectedAux and *** createCopyRenaming setVars(M, eSortToSort(getVars(getTopUnit(MN, DB)))) *** is replaced by M = if MN inModNameSet builtIns or-else not moduleAffectedAux(getTopUnit(MN, DB), VMAPS, M, DB) then applyMapSetRecursively(VMAPS, EIL, ((including MN .) EIL'), U, M, DB) else applyMapSetRecursively( VMAPS, EIL, ((including (MN *< mapSetRestriction(getTopUnit(MN, DB), VMAPS, M, DB) >) .) EIL'), U, M, createCopyRenaming(MN, (MN *< mapSetRestriction(getTopUnit(MN, DB), VMAPS, M, DB) >), M, DB)) fi . eq applyMapSetRecursively(VMAPS, ((extending MN .) EIL), EIL', U, M, DB) *** The vbles in MN where added to M in the calls to moduleAffectedAux and *** createCopyRenaming setVars(M, eSortToSort(getVars(getTopUnit(MN, DB)))) *** is replaced by M = if MN inModNameSet builtIns or-else not moduleAffectedAux(getTopUnit(MN, DB), VMAPS, M, DB) then applyMapSetRecursively(VMAPS, EIL, ((extending MN .) EIL'), U, M, DB) else applyMapSetRecursively( VMAPS, EIL, ((extending (MN *< mapSetRestriction(getTopUnit(MN, DB), VMAPS, M, DB) >) .) EIL'), U, M, createCopyRenaming(MN, (MN *< mapSetRestriction(getTopUnit(MN, DB), VMAPS, M, DB) >), M, DB)) fi . eq applyMapSetRecursively(VMAPS, ((protecting MN .) EIL), EIL', U, M, DB) *** The vbles in MN where added to M in the calls to moduleAffectedAux and *** createCopyRenaming setVars(M, eSortToSort(getVars(getTopUnit(MN, DB)))) *** is replaced by M = if MN inModNameSet builtIns or-else not moduleAffectedAux(getTopUnit(MN, DB), VMAPS, M, DB) then applyMapSetRecursively(VMAPS, EIL, (protecting MN . EIL'), U, M, DB) else applyMapSetRecursively( VMAPS, EIL, ((protecting (MN *< mapSetRestriction(getTopUnit(MN, DB), VMAPS, M, DB) >) .) EIL'), U, M, createCopyRenaming(MN, (MN *< mapSetRestriction(getTopUnit(MN, DB), VMAPS, M, DB) >), M, DB)) fi . eq applyMapSetRecursively(VMAPS, nil, EIL, U, M, DB) = evalUnit(setImports(U, EIL), DB) . eq applyMapSetRecursively(VMAPS, EIL, EIL', error(QIL), M, DB) = warning(DB, QIL) . *** The definition of the function \texttt{modNameToQidList} on the renaming *** module expression has to take care of transforming into a quoted identifier *** list the set of view maps given in the module expression. op mapSetToQidList : MapSet -> QidList . op attrSetToQidList : AttrSet -> QidList . op hookListToQidList : HookList -> QidList . op termListToQidList : TermList -> QidList . op intListToQidList : IntList -> QidList . ceq modNameToQidList(_*<_>(ME plus ME', MAPS)) = (if QI == '\s then '`( QIL '`) QI else '`( QIL QI '`) '\s fi '* '\s '`( mapSetToQidList(MAPS) '`)) if QIL QI := modNameToQidList(ME plus ME') . ceq modNameToQidList(_*<_>(ME, MAPS)) = (if QI == '\s then QIL QI else QIL QI '\s fi '* '\s '`( mapSetToQidList(MAPS) '`)) if QIL QI := modNameToQidList(ME) [owise] . eq modNameToQid(_*<_>(ME plus ME', MAPS)) = qid("(" + string(modNameToQid(ME plus ME')) + ")" + " * (" + string(qidListToQid(mapSetToQidList(MAPS))) + ")") . eq modNameToQid(_*<_>(ME, MAPS)) = qid(string(modNameToQid(ME)) + " * (" + string(qidListToQid(mapSetToQidList(MAPS))) + ")") [owise] . ceq mapSetToQidList(((op F to F' [AtS]), MAPS)) = if AtS == none then ('op F 'to F' '`, '\s mapSetToQidList(MAPS)) else ('op F 'to F' '\s '`[ attrSetToQidList(AtS) '`] '`, '\s mapSetToQidList(MAPS)) fi if MAPS =/= none . eq mapSetToQidList((op F to F' [AtS])) = if AtS == none then ('op F 'to F') else ('op F 'to F' '\s '`[ attrSetToQidList(AtS) '`]) fi . ceq mapSetToQidList(((op F : ETL -> ET to F' [AtS]), MAPS)) = if AtS == none then ('op F ': eTypeListToQidList(ETL) '-> eSortToQidList(ET) 'to F' '`, '\s mapSetToQidList(MAPS)) else ('op F ': eTypeListToQidList(ETL) '-> eSortToQidList(ET) 'to F' '`[ attrSetToQidList(AtS) '`] '`, '\s mapSetToQidList(MAPS)) fi if MAPS =/= none . eq mapSetToQidList((op F : ETL -> ET to F' [AtS])) = if AtS == none then ('op F ': eTypeListToQidList(ETL) '-> eSortToQidList(ET) 'to F') else ('op F ': eTypeListToQidList(ETL) '-> eSortToQidList(ET) 'to F' '`[ attrSetToQidList(AtS) '`]) fi . ceq mapSetToQidList(((sort ES to ES'), MAPS)) = ('sort eSortToQidList(ES) 'to eSortToQidList(ES') '`, '\s mapSetToQidList(MAPS)) if MAPS =/= none . eq mapSetToQidList((sort ES to ES')) = ('sort eSortToQidList(ES) 'to eSortToQidList(ES')) . ceq mapSetToQidList(((label L to L'), MAPS)) = ('label L 'to L' '`, '\s mapSetToQidList(MAPS)) if MAPS =/= none . eq mapSetToQidList((label L to L')) = ('label L 'to L') . ceq mapSetToQidList(((msg F to F'), MAPS)) = ('msg F 'to F' '`, '\s mapSetToQidList(MAPS)) if MAPS =/= none . eq mapSetToQidList((msg F to F')) = ('msg F 'to F') . ceq mapSetToQidList(((msg F : ETL -> ET to F'), MAPS)) = ('msg F ': eTypeListToQidList(ETL) '-> eSortToQidList(ET) 'to F' '`, '\s mapSetToQidList(MAPS)) if MAPS =/= none . eq mapSetToQidList((msg F : ETL -> ET to F')) = ('msg F ': eTypeListToQidList(ETL) '-> eSortToQidList(ET) 'to F') . ceq mapSetToQidList(((class ES to ES'), MAPS)) = ('class eSortToQidList(ES) 'to eSortToQidList(ES') '`, '\s mapSetToQidList(MAPS)) if MAPS =/= none . eq mapSetToQidList((class ES to ES')) = ('class eSortToQidList(ES) 'to eSortToQidList(ES')) . ceq mapSetToQidList(((attr QI . ES to QI'), MAPS)) = ('attr QI '. eSortToQidList(ES) 'to QI' '`, '\s mapSetToQidList(MAPS)) if MAPS =/= none . eq mapSetToQidList((attr QI . ES to QI')) = ('attribute QI 'in eSortToQidList(ES) 'to QI') . eq mapSetToQidList(none) = nil . eq attrSetToQidList(none) = nil . eq attrSetToQidList((assoc AtS)) = ('assoc attrSetToQidList(AtS)) . eq attrSetToQidList((comm AtS)) = ('comm attrSetToQidList(AtS)) . eq attrSetToQidList((idem AtS)) = ('idem attrSetToQidList(AtS)) . eq attrSetToQidList((iter AtS)) = ('iter attrSetToQidList(AtS)) . eq attrSetToQidList((id(T) AtS)) = ('id: termListToQidList(T) attrSetToQidList(AtS)) . eq attrSetToQidList((right-id(T) AtS)) = ('right-id: termListToQidList(T) attrSetToQidList(AtS)) . eq attrSetToQidList((left-id(T) AtS)) = ('left-id: termListToQidList(T) attrSetToQidList(AtS)) . eq attrSetToQidList((strat(NL) AtS)) = ('strat '`( intListToQidList(NL) '`) attrSetToQidList(AtS)) . eq attrSetToQidList((memo AtS)) = ('memo attrSetToQidList(AtS)) . eq attrSetToQidList((prec(I) AtS)) = ('prec intListToQidList(I) attrSetToQidList(AtS)) . eq attrSetToQidList((gather(QIL) AtS)) = ('gather QIL attrSetToQidList(AtS)) . eq attrSetToQidList((format(QIL) AtS)) = ('format QIL attrSetToQidList(AtS)) . eq attrSetToQidList((ctor AtS)) = ('ctor attrSetToQidList(AtS)) . eq attrSetToQidList((frozen(NL) AtS)) = ('frozen '`( intListToQidList(NL) '`) attrSetToQidList(AtS)) . *** eq attrSetToQidList((ditto AtS)) = ('ditto attrSetToQidList(AtS)) . eq attrSetToQidList((special(HL) AtS)) = ('special '`( hookListToQidList(HL) '`) attrSetToQidList(AtS)) . eq attrSetToQidList((none).AttrSet) = nil . eq hookListToQidList((id-hook(QI, QIL) HL)) = ('id-hook QI '`, '`( QIL '`) hookListToQidList(HL)) . eq hookListToQidList((op-hook(QI, QI', QIL, QI'') HL)) = ('op-hook QI '`( QI' ': QIL '-> QI'' '`) hookListToQidList(HL)) . eq hookListToQidList((term-hook(QI, T) HL)) = ('term-hook '`( QI '`, termListToQidList(T) '`) hookListToQidList(HL)) . eq termListToQidList(QI) = QI . eq termListToQidList(F[TL]) = (F '`( termListToQidList(TL) '`)) . eq termListToQidList((T, TL)) = (termListToQidList(T) '`, termListToQidList(TL)) . eq intListToQidList((I NL)) = (qid(string(I, 10)) intListToQidList(NL)) . eq intListToQidList(I) = qid(string(I, 10)) . *** Let us now give the equations for \texttt{setUpModExpDeps} on the *** renaming module expression. Given a module expression of the form *** \verb~ME *< VMAPS >~ such that \texttt{ME} is in the database, we just need *** to add \verb~ME *< VMAPS >~ to the set of names of the modules depending on *** \texttt{ME}. In this way, if \texttt{ME} is redefined or removed from the *** database, \verb~ME *< VMAPS >~ will be removed as well. eq setUpModExpDeps(_*<_>(ME, VMAPS), db((< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = db((< ME ; DT ; U ; U' ; M ; VDS ; MNS . _*<_>(ME, VMAPS) ; VES > IS), MNS', VES', QIL) . eq setUpModExpDeps(_*<_>(ME, VMAPS), db((< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > IS), MNS', VES', QIL)) = db((< ME ; DM ; U ; U' ; M ; VDS ; MNS . _*<_>(ME, VMAPS) ; VES > IS), MNS', VES', QIL) . ceq setUpModExpDeps(_*<_>(ME, VMAPS), DB) = warning(DB, '\r 'Error: '\o 'Module modNameToQidList(ME) 'not 'in 'database. '\n) if not unitInDb(ME, DB) . *** The definition of the \texttt{prepModName} function on a renaming module *** expression must take into account the possibility of having parameterized *** sorts or parameterized class names in the maps of a renaming module *** expression. The preparation of a renaming module expression must take *** into account this fact and prepare accordingly all parameterized sorts and *** classes appearing in it. op prepMapSet : ViewMapSet Set`(Tuple`(ViewExp`|`ViewExp`)`) -> ViewMapSet . op prepETypeList : ETypeList Set`(Tuple`(ViewExp`|`ViewExp`)`) -> ETypeList . eq prepModName(_*<_>(ME, VMAPS), VEPS) = _*<_>(prepModName(ME, VEPS), prepMapSet(VMAPS, VEPS)) . *** For example, for sort maps the equation is as follows. eq prepMapSet(((sort ES to ES'), VMAPS), VEPS) = ((sort prepESort(ES, VEPS) to prepESort(ES', VEPS)), prepMapSet(VMAPS, VEPS)) . eq prepMapSet(((class ES to ES'), VMAPS), VEPS) = ((class prepESort(ES, VEPS) to prepESort(ES', VEPS)), prepMapSet(VMAPS, VEPS)) . eq prepMapSet(((attr QI . ES to QI'), VMAPS), VEPS) = ((attr QI . prepESort(ES, VEPS) to QI'), prepMapSet(VMAPS, VEPS)) . eq prepMapSet(((op F to F' [AtS]), VMAPS), VEPS) = ((op F to F' [AtS]), prepMapSet(VMAPS, VEPS)) . eq prepMapSet(((op F : ETL -> ES to F' [AtS]), VMAPS), VEPS) = (op F : prepETypeList(ETL, VEPS) -> prepESort(ES, VEPS) to F' [AtS], prepMapSet(VMAPS, VEPS)) . eq prepMapSet(((label L to L'), VMAPS), VEPS) = ((label L to L'), prepMapSet(VMAPS, VEPS)) . eq prepMapSet(((msg F to F'), VMAPS), VEPS) = ((msg F to F'), prepMapSet(VMAPS, VEPS)) . eq prepMapSet(((msg F : ETL -> ES to F'), VMAPS), VEPS) = ((msg F : prepETypeList(ETL, VEPS) -> prepESort(ES, VEPS) to F'), prepMapSet(VMAPS, VEPS)) . eq prepMapSet(none, VEPS) = none . eq prepETypeList((ES ETL), VEPS) = (prepESort(ES, VEPS) prepETypeList(ETL, VEPS)) . eq prepETypeList(nil, VEPS) = nil . endfm ******************************************************************************* *** *** The Union Module Expression *** *** The syntax used for the union of module expressions is *** op _+_ : ModExp ModExp -> ModExp [assoc prec 42] . *** Its evaluation consists in generating a unit importing the two module *** expressions given as arguments~\cite{Winkler91,OBJ92}. *** As we explained in Sections~\ref{instantiation} and~\ref{renaming} for the *** cases of the instantiation and the renaming module expressions, *** respectively, the declaration of any new kind of module expression must *** come together with the definition of the functions \texttt{evalModExp}, *** \texttt{modNameToQidList}, and \texttt{setUpModExpDeps} on the new *** module operator. As discussed in Sections~\ref{instantiation} *** and~\ref{parsing-unit-declarations}, equations for the \texttt{prepModName} *** and \texttt{parseModExp} functions have to be given as well. fmod UNION-EXPR is inc MOD-EXPR . pr INST-EXPR-EVALUATION . pr EVALUATION . var X : Qid . var PL : ParameterList . var DB : Database . vars T T' : Term . vars DT DT' : Default`(Term`) . var EIL : EImportList . var VEPS : Set`(Tuple`(ViewExp`|`ViewExp`)`) . vars ME ME' : ModExp . vars PU PU' U U' U'' U''' DM : Unit . vars M M' M'' M''' : Module . vars MNS MNS' MNS'' : ModNameSet . vars VES VES' VES'' : ViewExpSet . var IS : InfoSet . var QIL : QidList . var VDS VDS' : OpDeclSet . *** As mentioned above, the evaluation of a union module expression consists *** in the creation of a new unit, with such a module expression as name, *** which imports the two module expressions being united. Note, however, *** that the unit being created has to be of the right type. The new unit *** will be generated having one type or another, depending on the types of *** the arguments of the union module expression. *** The function \texttt{rightEmptyUnit} generates an empty unit of the lowest *** of the sorts of its two arguments. In case of having a nonstructured *** module as argument, the corresponding structured one is considered. If one *** of the two module expressions corresponds to a theory, then a theory is *** generated, and the lowest sort is taken between the sort of such a theory *** and the \texttt{Unit} sort immediately above the sort of the other unit; *** that is, sorts \texttt{FUnit}, \texttt{SUnit}, or \texttt{OUnit} are *** considered to do the comparison. eq evalModExp(ME plus ME', PL, DB) = if unitInDb(ME plus ME', DB) then DB else evalUnit( addImports((protecting ME .) (protecting ME' .), setName( rightEmptyUnit( getTopUnit(ME, evalModExp(ME, PL, evalModExp(ME', PL, DB))), getTopUnit(ME', evalModExp(ME, PL, evalModExp(ME', PL, DB)))), ME plus ME')), evalModExp(ME, PL, evalModExp(ME', PL, DB))) fi . op rightEmptyUnit : Unit Unit -> Unit [comm] . ceq rightEmptyUnit(U, U') = emptyStrFModule if U : StrFModule /\ U' : StrFModule . ceq rightEmptyUnit(U, U') = emptyStrFTheory if U : StrFTheory /\ U' : FUnit . ceq rightEmptyUnit(U, U') = emptyStrSModule if U : StrSModule /\ U' : StrSModule /\ not (U :: StrFModule or U' :: StrFModule) . ceq rightEmptyUnit(U, U') = emptyStrSTheory if U : StrSTheory /\ U' : SUnit /\ not (U :: StrFTheory or U' :: StrFTheory) . ceq rightEmptyUnit(U, U') = emptyStrOModule if U : StrOModule /\ U' : StrOModule /\ not (U :: StrSModule or U' :: StrSModule) . ceq rightEmptyUnit(U, U') = emptyStrOTheory if U : StrOTheory /\ U' : OUnit /\ not (U :: StrSTheory or U' :: StrSTheory) . eq rightEmptyUnit(error(QIL), U) = error(QIL) . eq rightEmptyUnit(U, error(QIL)) = error(QIL) . *** As pointed out in Section~\ref{module-names}, for each new module *** expression operator being introduced, we need to add equations for the *** \texttt{modNameToQid} function. For the union module expression we only *** need the following equation: eq modNameToQid(ME plus ME') = qidListToQid(modNameToQidList(ME) '+ modNameToQidList(ME')) . eq modNameToQidList(ME plus ME') = (modNameToQidList(ME) '+ modNameToQidList(ME')) . *** Given a module *** expression of the form \verb~ME + ME'~ such that \texttt{ME} and *** \texttt{ME'} are in the database, we need to add \verb~ME + ME'~ to *** the set of names of the modules depending on \texttt{ME} and \texttt{ME'}. *** In this way, if \texttt{ME} or \texttt{ME'} are redefined or removed from *** the database, \verb~ME + ME'~ will be removed as well. eq setUpModExpDeps((ME plus ME), db(< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = db((< ME ; DT ; U ; U' ; M ; VDS ; MNS . (ME plus ME) ; VES > IS), MNS', VES', QIL) . eq setUpModExpDeps((ME plus ME), db(< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > IS, MNS', VES', QIL)) = db((< ME ; DM ; U ; U' ; M ; VDS ; MNS . (ME plus ME) ; VES > IS), MNS', VES', QIL) . eq setUpModExpDeps((ME plus ME'), db( (< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > < ME' ; DT' ; U'' ; U''' ; M' ; VDS' ; MNS' ; VES' > IS), MNS'', VES'', QIL)) = db( (< ME ; DT ; U ; U' ; M ; VDS ; MNS . (ME plus ME') ; VES > < ME' ; DT' ; U'' ; U''' ; M' ; VDS' ; MNS' . (ME plus ME') ; VES' > IS), MNS'', VES'', QIL) . eq setUpModExpDeps((ME plus ME'), db( (< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > < ME' ; DM ; U'' ; U''' ; M' ; VDS' ; MNS' ; VES' > IS), MNS'', VES'', QIL)) = db( (< ME ; DT ; U ; U' ; M ; VDS ; MNS . (ME plus ME') ; VES > < ME' ; DM ; U'' ; U''' ; M' ; VDS' ; MNS' . (ME plus ME') ; VES' > IS), MNS'', VES'', QIL) . eq setUpModExpDeps((ME plus ME'), db( (< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > < ME' ; DT ; U'' ; U''' ; M' ; VDS' ; MNS' ; VES' > IS), MNS'', VES'', QIL)) = db( (< ME ; DM ; U ; U' ; M ; VDS ; MNS . (ME plus ME') ; VES > < ME' ; DT ; U'' ; U''' ; M' ; VDS' ; MNS' . (ME plus ME') ; VES' > IS), MNS'', VES'', QIL) . eq setUpModExpDeps((ME plus ME'), db( (< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > < ME' ; DM ; U'' ; U''' ; M' ; VDS' ; MNS' ; VES' > IS), MNS'', VES'', QIL)) = db( (< ME ; DM ; U ; U' ; M ; VDS ; MNS . (ME plus ME') ; VES > < ME' ; DM ; U'' ; U''' ; M' ; VDS' ; MNS' . (ME plus ME') ; VES' > IS), MNS'', VES'', QIL) . ceq setUpModExpDeps((ME plus ME'), DB) = warning(DB, ('\r 'Error: '\o 'Module modNameToQidList(ME) 'not 'in 'database. '\n)) if not unitInDb(ME, DB) . ceq setUpModExpDeps((ME plus ME'), DB) = warning(DB, ('\r 'Error: '\o 'Module modNameToQidList(ME') 'not 'in 'database. '\n)) if not unitInDb(ME', DB) . *** The \texttt{prepModName} function on a union module expression makes *** recursive calls with each of the module expressions given as arguments. eq prepModName(ME plus ME', VEPS) = prepModName(ME, VEPS) plus prepModName(ME', VEPS) . *** Finally, the equation for the \texttt{parseModExp} function is as follows: eq parseModExp('_+_[T, T']) = parseModExp(T) plus parseModExp(T') . eq labelInModExp(X, ME plus ME') = labelInModExp(X, ME) or-else labelInModExp(X, ME') . endfm ******************************************************************************* *** *** The $n$-tuple Module Expression *** *** The syntax used for the $n$-tuple module expression is as follows: *** op TUPLE[_] : Token -> ModExp . *** Its evaluation consists in the generation of a parameterized functional *** module with the number of \texttt{TRIV} parameters specified by the *** argument. A sort for tuples of such size, and the corresponding constructor *** and selector operators, are also defined. Note that the \texttt{TRIV} *** theory is predefined in Full Maude (see Sections~\ref{main-module} *** and~\ref{non-built-in-predefined}). For example, the module expression *** \verb~TUPLE[3]~ produces the following module. *** fmod TUPLE[3][C1 :: TRIV, C2 :: TRIV, C3 :: TRIV] is *** sorts 3Tuple . *** op (_,_,_) : Elt.C1 Elt.C2 Elt.C3 -> 3Tuple . *** op p1_ : 3Tuple -> Elt.C1 . *** op p2_ : 3Tuple -> Elt.C2 . *** op p3_ : 3Tuple -> Elt.C3 . *** var E1 : Elt.C1 . *** var E2 : Elt.C2 . *** var E3 : Elt.C3 . *** eq p1(E1, E2, E3) = E1 . *** eq p2(E1, E2, E3) = E2 . *** eq p3(E1, E2, E3) = E3 . *** endfm *** Even though the $n$-tuple module expression is in principle of a completely *** different nature, the way of handling it is the same as the way of handling *** any other module expression. Its evaluation produces a new unit, a *** parameterized functional module in this case, with the module expression as *** name. New equations defining the semantics of functions *** \texttt{evalModExp}, \texttt{modNameToQidList}, *** \texttt{setUpModExpDeps}, \texttt{prepModName}, and *** \texttt{parseModExp} are given for this module expression. fmod N-TUPLE-EXPR is inc MOD-EXPR . pr INST-EXPR-EVALUATION . pr EVALUATION . vars N N' : NzNat . var PL : ParameterList . var DB : Database . var T : Term . var EIL : EImportList . var VEPS : Set`(Tuple`(ViewExp`|`ViewExp`)`) . var X : Qid . var S : Sort . *** The equation for the \texttt{evalModExp} is reduced to the creation of a *** module as indicated above. Some auxiliary functions are defined in order *** to generate the different declarations in the module. op tupleParList : NzNat -> ParameterList . op tupleImportList : NzNat -> ImportList . op createCopyPars : NzNat Database -> Database . op tupleOpDeclSet : NzNat -> OpDeclSet . op tupleOpDeclSetCtor : NzNat -> OpDecl . op tupleOpDeclSetCtorName : NzNat -> String . op tupleOpDeclSetCtorArity : NzNat -> QidList . op tupleOpDeclSetSelectors : NzNat NzNat -> OpDeclSet . op tupleEqSet : NzNat -> EquationSet . op tupleEqSetAux : NzNat Term -> EquationSet . op tupleTermArgs : NzNat -> TermList . ops tupleSort tupleSortAux : NzNat -> ESort . eq evalModExp(TUPLE[N], PL, DB) = if unitInDb(TUPLE[N], DB) then DB else evalUnit( fmod TUPLE[N] is tupleParList(N) tupleImportList(N) sorts tupleSort(N) . none tupleOpDeclSet(N) none tupleEqSet(N) endfm, createCopyPars(N, DB)) fi . eq createCopyPars(N, DB) = if N == 1 then createCopy((par qid("C" + string(N, 10)) :: 'TRIV), DB) else createCopyPars(_-_(N, 1), createCopy((par qid("C" + string(N, 10)) :: 'TRIV), DB)) fi . eq tupleParList(N) = if N == 1 then (par qid("C" + string(N, 10)) :: 'TRIV) else parList(tupleParList(_-_(N, 1)), (par qid("C" + string(N, 10)) :: 'TRIV)) fi . eq tupleImportList(N) = if N == 1 then (protecting par qid("C" + string(N, 10)) :: 'TRIV .) else (tupleImportList(_-_(N, 1)) (protecting par qid("C" + string(N, 10)) :: 'TRIV .)) fi . eq tupleSort(N)= eSort('Tuple, tupleSortAux(N)) . eq tupleSortAux(N) = if N == 1 then qid("C" + string(N, 10)) else _|_(tupleSortAux(_-_(N, 1)), qid("C" + string(N, 10))) fi . eq tupleOpDeclSet(N) = (tupleOpDeclSetCtor(N) tupleOpDeclSetSelectors(N, N)) . eq tupleOpDeclSetCtor(N) = (op qid("(" + tupleOpDeclSetCtorName(N) + ")") : tupleOpDeclSetCtorArity(N) -> tupleSort(N) [none] .) . eq tupleOpDeclSetCtorName(N) = if N == 1 then "_" else "_," + tupleOpDeclSetCtorName(_-_(N, 1)) fi . eq tupleOpDeclSetCtorArity(N) = if N == 1 then qid("C" + string(N, 10) + "@Elt") else tupleOpDeclSetCtorArity(_-_(N, 1)) qid("C" + string(N, 10) + "@Elt") fi . eq tupleOpDeclSetSelectors(N, N') = if N == 1 then (op qid("p" + string(N, 10) + "_") : tupleSort(N') -> qid("C" + string(N, 10) + "@Elt") [none] .) else (tupleOpDeclSetSelectors(_-_(N, 1), N') (op qid("p" + string(N, 10) + "_") : tupleSort(N') -> qid("C" + string(N, 10) + "@Elt") [none] .)) fi . eq tupleEqSet(N) = tupleEqSetAux(N, (qid("(" + tupleOpDeclSetCtorName(N) + ")") [ tupleTermArgs(N) ])) . eq tupleTermArgs(N) = if N == 1 then qid("V" + string(N, 10) + ":C" + string(N, 10) + "@Elt") else (tupleTermArgs(_-_(N, 1)), qid("V" + string(N, 10) + ":C" + string(N, 10) + "@Elt")) fi . eq tupleEqSetAux(N, T) = if N == 1 then (eq qid("p" + string(N, 10) + "_")[T] = qid("V" + string(N, 10) + ":C" + string(N, 10) + "@Elt") [none] .) else (tupleEqSetAux(_-_(N, 1), T) (eq qid("p" + string(N, 10) + "_")[T] = qid("V" + string(N, 10) + ":C" + string(N, 10) + "@Elt") [none] .)) fi . *** The equations for the \texttt{modNameToQidList}, \texttt{parseModExp}, *** \texttt{prepModName}, and \texttt{setUpModExpDeps} functions on *** the $n$-tuple module expression are as follows: eq modNameToQid(TUPLE[N]) = qid("TUPLE[" + string(N, 10) + "]") . eq modNameToQidList(TUPLE[N]) = ('TUPLE '`[ qid(string(N, 10)) '`]) . eq parseModExp('TUPLE`[_`]['token[T]]) = TUPLE[parseNat(T)] . eq prepModName(TUPLE[N], VEPS) = TUPLE[N] . eq setUpModExpDeps(TUPLE[N], DB) = DB . eq labelInModExp(X, TUPLE[N]) = false . endfm ******************************************************************************* *** *** 8 Input/Output Processing *** *** In this section we discuss how the preterm resulting from the call to the *** function \texttt{metaParse} with the input and the top-level signature of *** Full Maude is transformed into a term of sort \texttt{Unit}, representing *** a preunit or a term of sort \texttt{PreView}. In the case of commands, *** they are evaluated giving the corresponding results in the appropriate *** form. *** *** 8.1 Input Parsing *** *** Let us recall here the example presented in Section~\ref{bubbles}. Calling *** \texttt{metaParse} with the module \texttt{NAT3} given there and the *** signature of Full Maude presented in Section~\ref{sec:signature}, we *** obtain the following term. *** 'fmod_is_endfm[ *** 'token[{''NAT3}'Qid], *** '__['sort_.['token[{''Nat3}'Qid]], *** '__['op_:_->_.['token[{''s_}'Qid], *** 'neTokenList[{''Nat3}'Qid], *** 'token[{''Nat3}'Qid]], *** '__['op_:`->_.['token[{''0}'Qid], *** 'token[{''Nat3}'Qid]], *** 'eq_=_.['bubble['__[{''s}'Qid, {''s}'Qid, *** {''s}'Qid, {''0}'Qid]], *** 'bubble[{''0}'Qid]]]]]] *** Given each one of the subterms representing declarations in terms *** representing modules as the previous one, the function \texttt{parseDecl} *** generates the corresponding declaration, with no bubbles in it, and the *** corresponding predeclaration, with the bubbles appearing in the term. For *** example, for the term *** *** 'op_:_->_.['token[{''s_}'Qid], *** 'neTokenList[{''Nat3}'Qid], *** 'token[{''Nat3}'Qid]] *** *** the following operator declaration is generated: *** *** op 's_ : 'Nat3 -> 'Nat3 [none] . *** *** Note that in this case, since the operator is declared without identity *** element (the only place a bubble might appear), the declaration and the *** predeclaration generated by \texttt{parseDecl} coincide. *** In the following sections we shall see how this approach is followed for *** declarations appearing in units and in views. *** *** 8.1.1 Parsing of Unit Declarations *** *** The \texttt{parseDecl} function takes a term (which corresponds to a *** declaration to be parsed), a preunit (to which the parsed declaration with *** its bubbles in it will be added), and a unit (to which the parsed *** declaration without bubbles will be added to build up the signature). For *** example, a term corresponding to an unconditional equation, that is, a term *** of the form \verb~'eq_=_.[T, T']~ will be added to the set of equations of *** the preunit as \verb~eq T = T' .~, but nothing will be added to the unit. *** Note that according to the signature used in the call to *** \texttt{metaParse} (see Sections~\ref{sec:signature} *** and~\ref{main-module}), \texttt{T} and \texttt{T'} are bubbles. *** Declarations of sorts, subsort relations, operators, classes, subclass *** relations, messages, and variables will be added to both of them. In the *** case of operator declarations, identity element attributes, which in *** general can be terms, are not included in the added declaration. *** As in Core Maude, declarations in a module can be given in any order, and *** therefore we follow a two-step approach consisting in first building the *** signature to parse the bubbles, and then generating the unit without *** bubbles in it. It could be different for other languages. For example, in *** some languages we may be able to assume that each operator and sort has *** been defined before being used, allowing then an incremental processing of *** the input. fmod UNIT-DECL-PARSING is pr DATABASE . pr MOVE-DOWN . pr INST-EXPR-EVALUATION . pr RENAMING-EXPR-EVALUATION . pr UNION-EXPR . pr N-TUPLE-EXPR . vars PU U : Unit . vars T T' : Term . vars QI QI' L F : Qid . vars QIL QIL' : QidList . var S : Sort . vars ES ES' : ESort . vars ETL ETL' : ETypeList . var ETLL : ETypeListList . var AtS : AttrSet . vars T'' T''' T'''' : Term . var TL : TermList . var Ct : Constant . var VDS : OpDeclSet . var Tp : Type . *** Similarly, auxiliary functions parsing other elements in units are defined. sort NeETypeListList ETypeListList . subsort ETypeList < NeETypeListList < ETypeListList . op nilQidListList : -> ETypeListList . op eTypeListList : [ETypeListList] [ETypeListList] -> [ETypeListList] [assoc id: nilQidListList] . op eTypeListList : ETypeListList ETypeListList -> ETypeListList [assoc id: nilQidListList] . op eTypeListList : NeETypeListList NeETypeListList -> NeETypeListList [assoc id: nilQidListList] . op error : QidList -> [ETypeListList] [ctor format (r o)] . eq eTypeListList(error(QIL), NETLL:NeETypeListList) = error(QIL) . op parsePreAttrSet : Term -> AttrSet . op parseHookList : Term -> HookList . op parseVarDeclSet : QidList [Type] -> [EOpDeclSet] . op parseSubsortRel : Term -> ETypeListList . op parseAttrDeclList : Term -> AttrDeclSet . op unfoldOpDecl : QidList ETypeList ESort AttrSet -> EOpDeclSet . op unfoldMultipleMsgDecl : QidList ETypeList ESort -> MsgDeclSet . op unfoldSubsortRel : [ETypeListList] -> [ESubsortDeclSet] . op unfoldSubclassRel : [ETypeListList] -> [SubclassDeclSet] . eq parseSubsortRel('_<_[T, T']) = eTypeListList(parseTypeList(T), parseSubsortRel(T')) . eq parseSubsortRel('__[T, T']) = parseTypeList('__[T, T']) . eq parseSubsortRel('sortToken[T]) = downQid(T) . eq parseSubsortRel('_`(_`)['sortToken[T], T']) = eSort(downQid(T), parseViewExp(T')) . eq parseSubsortRel('_`(_`)['_`(_`)[T, T'], T'']) = eSort(parseSubsortRel('_`(_`)[T, T']), parseViewExp(T'')) . eq unfoldOpDecl((QI QIL), ETL, ES, AtS) = ((op QI : ETL -> ES [AtS] .) unfoldOpDecl(QIL, ETL, ES, AtS)) . eq unfoldOpDecl(nil, ETL, ES, AtS) = none . eq unfoldMultipleMsgDecl((QI QIL), ETL, ES) = ((msg QI : ETL -> ES .) unfoldMultipleMsgDecl(QIL, ETL, ES)) . eq unfoldMultipleMsgDecl(nil, ETL, ES) = none . eq unfoldSubsortRel(eTypeListList((ES ETL), (ES' ETL'), ETLL)) = ((subsort ES < ES' .) unfoldSubsortRel(eTypeListList(ES, ETL')) unfoldSubsortRel(eTypeListList(ETL, (ES' ETL'))) unfoldSubsortRel(eTypeListList((ES' ETL'), ETLL))) . eq unfoldSubsortRel(eTypeListList(ETL, nil)) = none . eq unfoldSubsortRel(eTypeListList(nil, ETL)) = none . eq unfoldSubsortRel(ETL) = none . eq unfoldSubsortRel(error(QIL)) = error(QIL) . eq unfoldSubclassRel(eTypeListList((ES ETL), (ES' ETL'), ETLL)) = ((subclass ES < ES' .) unfoldSubclassRel(eTypeListList(ES, ETL')) unfoldSubclassRel(eTypeListList(ETL, (ES' ETL'))) unfoldSubclassRel(eTypeListList((ES' ETL'), ETLL))) . eq unfoldSubclassRel(eTypeListList(ETL, nil)) = none . eq unfoldSubclassRel(eTypeListList(nil, ETL)) = none . eq unfoldSubclassRel(ETL) = none . eq unfoldSubclassRel(error(QIL)) = error(QIL) . eq parseVarDeclSet((QI QIL), Tp) = ((op QI : nil -> Tp [none] .) parseVarDeclSet(QIL, Tp)) . eq parseVarDeclSet(nil, Tp) = none . eq parseVarDeclSet(QIL, error(QIL')) = error(QIL') . eq parsePreAttrSet('__[T, T']) = (parsePreAttrSet(T) parsePreAttrSet(T')) . eq parsePreAttrSet('assoc.Attr) = assoc . eq parsePreAttrSet('associative.Attr) = assoc . eq parsePreAttrSet('comm.Attr) = comm . eq parsePreAttrSet('commutative.Attr) = comm . eq parsePreAttrSet('idem.Attr) = idem . eq parsePreAttrSet('idempotent.Attr) = idem . eq parsePreAttrSet('id:_[T]) = id(T) . eq parsePreAttrSet('identity:_[T]) = id(T) . eq parsePreAttrSet('left`id:_[T]) = left-id(T) . eq parsePreAttrSet('left`identity:_[T]) = left-id(T) . eq parsePreAttrSet('right`id:_[T]) = right-id(T) . eq parsePreAttrSet('right`identity:_[T]) = right-id(T) . eq parsePreAttrSet('strat`(_`)[T]) = strat(parseInt(T)) . eq parsePreAttrSet('strategy`(_`)[T]) = strat(parseInt(T)) . eq parsePreAttrSet('frozen`(_`)[T]) = frozen(parseInt(T)) . eq parsePreAttrSet('memo.Attr) = memo . eq parsePreAttrSet('memoization.Attr) = memo . eq parsePreAttrSet('ctor.Attr) = ctor . eq parsePreAttrSet('constructor.Attr) = ctor . eq parsePreAttrSet('prec_['token[T]]) = prec(parseNat(T)) . eq parsePreAttrSet('gather`(_`)['neTokenList[T]]) = gather(downQidList(T)) . eq parsePreAttrSet('special`(_`)[T]) = special(parseHookList(T)) . eq parsePreAttrSet('format`(_`)['neTokenList[T]]) = format(downQidList(T)) . eq parsePreAttrSet('iter.Attr) = iter . eq parseHookList('__[T, TL]) = parseHookList(T) parseHookList(TL) . eq parseHookList('id-hook_['token[T]]) = id-hook(downQid(T), nil) . eq parseHookList('id-hook_`(_`)['token[T], 'neTokenList[T']]) = id-hook(downQid(T), downQidList(T')) . eq parseHookList( 'op-hook_`(_:_->_`)[ 'token[T], 'token[T'], 'neTokenList[T''], 'token[T''']]) = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T''')) . eq parseHookList('op-hook_`(_:`->_`)['token[T], 'token[T'], 'token[T'']]) = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) . eq parseHookList( 'op-hook_`(_:_~>_`)[ 'token[T], 'token[T'], 'neTokenList[T''], 'token[T''']]) = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T''')) . eq parseHookList('op-hook_`(_:`~>_`)['token[T], 'token[T'], 'token[T'']]) = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) . eq parseHookList('term-hook_`(_`)['token[T], T']) = term-hook(downQid(T), T') . eq parseAttrDeclList('_`,_[T, T']) = (parseAttrDeclList(T), parseAttrDeclList(T')) . eq parseAttrDeclList('_:_['token[T], T']) = (attr downQid(T) : parseType(T')) . *** Given a term representing a declaration or a predeclaration, the function *** \texttt{parseDecl} must generate and update both the unit and the preunit *** that it takes as arguments. Note that in the case of rules, for example, *** only a prerule is generated. *** Since the preunit and the unit may be modified, they have to be returned as *** a pair, which will be used to extract the corresponding arguments for the *** following calls. Note that the \texttt{parseDecl} functions are in fact *** partial functions. Each parsing function assumes that it is possible to *** parse the given term. sort ParseDeclResult . op <_;_;_> : Unit Unit EOpDeclSet -> ParseDeclResult . op preUnit : ParseDeclResult -> Unit . op unit : ParseDeclResult -> Unit . op vars : ParseDeclResult -> EOpDeclSet . eq preUnit(< PU ; U ; VDS >) = PU . eq preUnit(< error(QIL) ; V:[Unit] ; V:[OpDeclSet] >) = error(QIL) . eq preUnit(< V:[Unit] ; error(QIL) ; V:[OpDeclSet] >) = error(QIL) . eq preUnit(< V:[Unit] ; V':[Unit] ; error(QIL) >) = error(QIL) . eq unit(< PU ; U ; VDS >) = U . eq unit(< error(QIL) ; V':[Unit] ; V:[OpDeclSet] >) = error(QIL) . eq unit(< V:[Unit] ; error(QIL) ; V:[OpDeclSet] >) = error(QIL) . eq unit(< V:[Unit] ; V':[Unit] ; error(QIL) >) = error(QIL) . eq vars(< PU ; U ; VDS >) = VDS . eq vars(< error(QIL) ; V:[Unit] ; V:[OpDeclSet] >) = error(QIL) . eq vars(< V:[Unit] ; error(QIL) ; V:[OpDeclSet] >) = error(QIL) . eq vars(< V:[Unit] ; V':[Unit] ; error(QIL) >) = error(QIL) . op parseDecl : Term Unit Unit EOpDeclSet -> ParseDeclResult . *** changed 03/27/02 *** In the case of importation declarations, since internally only the *** \texttt{including} mode is handled, all importations are generated in *** this mode, independently of the keyword used in the input. eq parseDecl('inc_.[T], PU, U, VDS) = parseDecl('including_.[T], PU, U, VDS) . eq parseDecl('ex_.[T], PU, U, VDS) = parseDecl('extending_.[T], PU, U, VDS) . eq parseDecl('pr_.[T], PU, U, VDS) = parseDecl('protecting_.[T], PU, U, VDS) . eq parseDecl('including_.[T], PU, U, VDS) = < addImports((including parseModExp(T) .), PU) ; U ; VDS > . eq parseDecl('extending_.[T], PU, U, VDS) = < addImports((extending parseModExp(T) .), PU) ; U ; VDS > . eq parseDecl('protecting_.[T], PU, U, VDS) = < addImports((protecting parseModExp(T) .), PU) ; U ; VDS > . eq parseDecl('sort_.[T], PU, U, VDS) = parseDecl('sorts_.[T], PU, U, VDS) . eq parseDecl('sorts_.[T], PU, U, VDS) = < addSorts(parseSortSet(T), PU) ; addSorts(parseSortSet(T), U) ; VDS > . eq parseDecl('subsort_.[T], PU, U, VDS) = parseDecl('subsorts_.[T], PU, U, VDS) . eq parseDecl('subsorts_.[T], PU, U, VDS) = < addSubsorts(unfoldSubsortRel(parseSubsortRel(T)), PU) ; addSubsorts(unfoldSubsortRel(parseSubsortRel(T)), U) ; VDS > . *** As pointed out in Section~\ref{SyntacticalRequirementsAndCaveats}, the *** name of operators in operator declaration has to be given as a single *** token identifier (see Section~\ref{order-sorted}). We assume that when *** declaring a multitoken operator, its name is given as a single quoted *** identifier in which each token is preceded by a backquote. Thus, the name *** of an operator \verb~_(_)~, for example, is given as \verb~_`(_`)~. eq parseDecl('op_:`->_.['token[T], T'], PU, U, VDS) = < addOps((op downQid(T) : nil -> parseType(T') [none] .), PU) ; addOps((op downQid(T) : nil -> parseType(T') [none] .), U) ; VDS > . eq parseDecl('op_:`->_`[_`].['token[T], T', T''], PU, U, VDS) = < addOps((op downQid(T) : nil -> parseType(T') [parsePreAttrSet(T'')] .), PU) ; addOps((op downQid(T) : nil -> parseType(T') [parseAttrSet(T'')] .), U) ; VDS > . eq parseDecl('op_:_->_.['token[T], T', T''], PU, U, VDS) = < addOps((op downQid(T) : parseTypeList(T') -> parseType(T'') [none] .), PU) ; addOps((op downQid(T) : parseTypeList(T') -> parseType(T'') [none] .), U) ; VDS > . eq parseDecl('op_:_->_`[_`].['token[T], T', T'', T'''], PU, U, VDS) = < addOps( (op downQid(T) : parseTypeList(T') -> parseType(T'') [parsePreAttrSet(T''')] .), PU) ; addOps((op downQid(T) : parseTypeList(T') -> parseType(T'') [parseAttrSet(T''')] .), U) ; VDS > . ceq parseDecl('op_:`->_.[F[TL], T], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . ceq parseDecl('op_:`->_`[_`].[F[TL], T, T'], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . ceq parseDecl('op_:_->_.[F[TL], T, T'], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . ceq parseDecl('op_:_->_`[_`].[F[TL], T, T', T''], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . eq parseDecl('ops_:`->_.['neTokenList[T], T'], PU, U, VDS) = < addOps(unfoldOpDecl(downTypes(T), nil, parseType(T'), none), PU) ; addOps(unfoldOpDecl(downTypes(T), nil, parseType(T'), none), U) ; VDS > . eq parseDecl('ops_:`->_`[_`].['neTokenList[T], T', T''], PU, U, VDS) = < addOps( unfoldOpDecl(downTypes(T), nil, parseType(T'), parsePreAttrSet(T'')), PU) ; addOps( unfoldOpDecl(downTypes(T), nil, parseType(T'), parseAttrSet(T'')), U) ; VDS > . eq parseDecl('ops_:_->_.['neTokenList[T], T', T''], PU, U, VDS) = < addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''), none), PU) ; addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''), none), U) ; VDS > . eq parseDecl('ops_:_->_`[_`].['neTokenList[T], T', T'', T'''], PU, U, VDS) = < addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''), parsePreAttrSet(T''')), PU) ; addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''), parseAttrSet(T''')), U) ; VDS > . eq parseDecl('op_:`~>_.['token[T], T'], PU, U, VDS) = < addOps((op downQid(T) : nil -> kind(parseType(T')) [none] .), PU) ; addOps((op downQid(T) : nil -> kind(parseType(T')) [none] .), U) ; VDS > . eq parseDecl('op_:`~>_`[_`].['token[T], T', T''], PU, U, VDS) = < addOps((op downQid(T) : nil -> kind(parseType(T')) [parsePreAttrSet(T'')] .), PU) ; addOps((op downQid(T) : nil -> kind(parseType(T')) [parseAttrSet(T'')] .), U) ; VDS > . eq parseDecl('op_:_~>_.['token[T], T', T''], PU, U, VDS) = < addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) [none] .), PU) ; addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) [none] .), U) ; VDS > . eq parseDecl('op_:_~>_`[_`].['token[T], T', T'', T'''], PU, U, VDS) = < addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) [parsePreAttrSet(T''')] .), PU) ; addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) [parseAttrSet(T''')] .), U) ; VDS > . ceq parseDecl('op_:`~>_.[F[TL], T], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . ceq parseDecl('op_:`~>_`[_`].[F[TL], T, T'], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . ceq parseDecl('op_:_~>_.[F[TL], T, T'], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . ceq parseDecl('op_:_~>_`[_`].[F[TL], T, T', T''], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . eq parseDecl('ops_:`~>_.['neTokenList[T], T'], PU, U, VDS) = < addOps( unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), none), PU) ; addOps( unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), none), U) ; VDS > . eq parseDecl('ops_:`~>_`[_`].['neTokenList[T], T', T''], PU, U, VDS) = < addOps( unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), parsePreAttrSet(T'')), PU) ; addOps( unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), parseAttrSet(T'')), U) ; VDS > . eq parseDecl('ops_:_~>_.['neTokenList[T], T', T''], PU, U, VDS) = < addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), kind(parseType(T'')), none), PU) ; addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), kind(parseType(T'')), none), U) ; VDS > . eq parseDecl('ops_:_~>_`[_`].['neTokenList[T], T', T'', T'''], PU, U, VDS) = < addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''), parsePreAttrSet(T''')), PU) ; addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''), parseAttrSet(T''')), U) ; VDS > . eq parseDecl('var_:_.['neTokenList[T], T'], PU, U, VDS) = parseDecl('vars_:_.['neTokenList[T], T'], PU, U, VDS) . eq parseDecl('vars_:_.['neTokenList[T], T'], PU, U, VDS) = < PU ; U ; VDS parseVarDeclSet(downQidList(T), eSortToSort(parseType(T'))) > . eq parseDecl('mb_:_.[T, T'], PU, U, VDS) = < addMbs((mb T : parseType(T') [none] .), PU) ; U ; VDS > . eq parseDecl('cmb_:_if_.[T, T', T''], PU, U, VDS) = < addMbs((cmb T : parseType(T') if T'' = 'true.Bool [none] .), PU) ; U ; VDS > . eq parseDecl('eq_=_.[T, T'], PU, U, VDS) = < addEqs((eq T = T' [none] .), PU) ; U ; VDS > . eq parseDecl('ceq_=_if_.[T, T', T''], PU, U, VDS) = < addEqs((ceq T = T' if T'' = 'true.Bool [none] .), PU) ; U ; VDS > . eq parseDecl('cq_=_if_.[T, T', T''], PU, U, VDS) = < addEqs((ceq T = T' if T'' = 'true.Bool [none] .), PU) ; U ; VDS > . eq parseDecl('rl_=>_.[T, T'], PU, U, VDS) = < addRls((rl T => T' [none] .), PU) ; U ; VDS > . eq parseDecl('crl_=>_if_.[T, T', T''], PU, U, VDS) = < addRls((crl T => T' if T'' = 'true.Bool [none] .), PU) ; U ; VDS > . eq parseDecl('class_.[T], PU, U, VDS) = < addClasses((class parseType(T) | none .), PU) ; addClasses((class parseType(T) | none .), U) ; VDS > . eq parseDecl('class_|_.[T, T'], PU, U, VDS) = < addClasses((class parseType(T) | parseAttrDeclList(T') .), PU) ; addClasses((class parseType(T) | parseAttrDeclList(T') .), U) ; VDS > . eq parseDecl('subclass_.[T], PU, U, VDS) = < addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), PU) ; addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), U) ; VDS > . eq parseDecl('subclasses_.[T], PU, U, VDS) = < addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), PU) ; addSubclasses(unfoldSubclassRel(parseSubsortRel(T)), U) ; VDS > . eq parseDecl('msg_:_->_.['token[T], T', T''], PU, U, VDS) = < addMsgs((msg downQid(T) : parseTypeList(T') -> parseType(T'') .), PU) ; addMsgs((msg downQid(T) : parseTypeList(T') -> parseType(T'') .), U) ; VDS > . eq parseDecl('msg_:`->_.['token[T], T'], PU, U, VDS) = < addMsgs((msg downQid(T) : nil -> parseType(T') .), PU) ; addMsgs((msg downQid(T) : nil -> parseType(T') .), U) ; VDS > . eq parseDecl('msgs_:_->_.['neTokenList[T], T', T''], PU, U, VDS) = < addMsgs(unfoldMultipleMsgDecl(downQidList(T), parseTypeList(T'), parseType(T'')), PU) ; addMsgs(unfoldMultipleMsgDecl(downQidList(T), parseTypeList(T'), parseType(T'')), U) ; VDS > . eq parseDecl('msgs_:`->_.['neTokenList[T], T'], PU, U, VDS) = < addMsgs(unfoldMultipleMsgDecl(downQidList(T), nil, parseType(T')), PU) ; addMsgs(unfoldMultipleMsgDecl(downQidList(T), nil, parseType(T')), U) ; VDS > . endfm ******************************************************************************* *** *** 8.1.2 Parsing of View Declarations *** *** A similar approach is followed for the parsing of declarations in views. fmod VIEW-DECL-PARSING is pr PRE-VIEW . pr VIEW . pr UNIT . pr UNIT-DECL-PARSING . vars T T' : Term . var EOPDS : EOpDeclSet . var MDS : MsgDeclSet . var M : Module . vars F F' : Qid . vars ES ES' : ESort . vars ETL ETL' : ETypeList . vars T'' T''' : Term . var PV : PreView . var EOPD : EOpDecl . var EOPDS' : EOpDeclSet . var AtS : AttrSet . var MD : MsgDecl . var MDS' : MsgDeclSet . var VDS : EOpDeclSet . *** Operator and message name maps of the form \verb~F to F'~ are substituted *** by an equivalent set of maps of the form \verb~F : ETL -> ES to F'~. One *** of these maps is added for each family of subsort-overloaded operators in *** the source theory of the view. *** The following functions \texttt{genOpMapSet} and \texttt{genMsgMapSet} *** take, respectively, an operator and a message map of the form *** \verb~F to F'~, a set of operator or message declarations, and a term of *** sort \texttt{Module}, and return, respectively, a set of operator maps and *** a set of message maps, with each of the members of those sets having the *** general form \verb~F : ETL -> ES to F'~. One of these maps is generated *** for each family of subsort-overloaded operators or messages with name *** \texttt{F} in the module given as argument. op genOpMapSet : Map EOpDeclSet Module -> MapSet . op genMsgMapSet : Map MsgDeclSet Module -> MapSet . op genOpMapSetAux : EOpDeclSet Qid -> MapSet . op genMsgMapSetAux : MsgDeclSet Qid -> MapSet . op getOpDeclSet : Qid Unit -> EOpDeclSet . op getOpDeclSetAux : Qid EOpDeclSet -> EOpDeclSet . *** getOpDeclSet(F, U) returns the set of declarations of operators with *** name F in the unit U op getMsgDeclSet : Qid Unit -> MsgDeclSet . op getMsgDeclSetAux : Qid MsgDeclSet -> MsgDeclSet . *** getMsgDeclSet(F, U) returns the set of declarations of messages with *** name F in the unit U op getSubsortOverloadedFamilies : EOpDeclSet EOpDeclSet Module -> EOpDeclSet . op getSubsortOverloadedFamilies : MsgDeclSet MsgDeclSet Module -> MsgDeclSet . *** getSubsortOverloadedFamilies returns a declaration of operator or *** message for each family of subsort-overloaded operators or messages. op selectOpDeclSet : Qid EOpDeclSet -> EOpDeclSet . op selectMsgDeclSet : Qid MsgDeclSet -> MsgDeclSet . *** selectOpDeclSet and selectMsgDeclSet returns, respectively, the subset *** of those declarations of ops and msgs which name coincides with the *** qid given ar argument. op opFamilyIn : EOpDecl EOpDeclSet Module -> Bool . op msgFamilyIn : MsgDecl MsgDeclSet Module -> Bool . *** Check whether the family of the subsort-overloaded operator given as *** argument has already a representative in the set of declarations given. eq genOpMapSet((op F to F' [none]), EOPDS, M) = genOpMapSetAux( getSubsortOverloadedFamilies(selectOpDeclSet(F, EOPDS), none, M), F') . eq genMsgMapSet((msg F to F'), MDS, M) = genMsgMapSetAux( getSubsortOverloadedFamilies(selectMsgDeclSet(F, MDS), none, M), F') . eq selectOpDeclSet(F, ((op F' : ETL -> ES [AtS] .) EOPDS)) = ((if F == F' then (op F' : ETL -> ES [AtS] .) else none fi) selectOpDeclSet(F, EOPDS)) . eq selectOpDeclSet(F, none) = none . eq selectMsgDeclSet(F, ((msg F' : ETL -> ES .) MDS)) = ((if F == F' then (msg F' : ETL -> ES .) else none fi) selectMsgDeclSet(F, MDS)) . eq selectMsgDeclSet(F, none) = none . eq genOpMapSetAux(((op F : ETL -> ES [AtS] .) EOPDS), F') = ((op F : ETL -> ES to F' [none]), genOpMapSetAux(EOPDS, F')) . eq genOpMapSetAux(none, F') = none . eq genMsgMapSetAux(((msg F : ETL -> ES .) MDS), F') = ((msg F : ETL -> ES to F'), genMsgMapSetAux(MDS, F')) . eq genMsgMapSetAux(none, F') = none . eq getSubsortOverloadedFamilies((EOPD EOPDS), EOPDS', M) = if opFamilyIn(EOPD, EOPDS', M) then getSubsortOverloadedFamilies(EOPDS, EOPDS', M) else getSubsortOverloadedFamilies(EOPDS, (EOPD EOPDS'), M) fi . eq getSubsortOverloadedFamilies(none, EOPDS, M) = EOPDS . eq getSubsortOverloadedFamilies((MD MDS), MDS', M) = if msgFamilyIn(MD, MDS', M) then getSubsortOverloadedFamilies(MDS, MDS', M) else getSubsortOverloadedFamilies(MDS, (MD MDS'), M) fi . eq getSubsortOverloadedFamilies(none, MDS, M) = MDS . eq opFamilyIn( (op F : ETL -> ES [AtS] .), ((op F' : ETL' -> ES' [AtS] .) EOPDS), M) = ((F == F') and-then eSameKind(M, ETL, ETL')) or-else opFamilyIn((op F : ETL -> ES [AtS] .), EOPDS, M) . eq opFamilyIn((op F : ETL -> ES [AtS] .), none, M) = false . eq msgFamilyIn((msg F : ETL -> ES .), ((msg F' : ETL' -> ES' .) MDS), M) = ((F == F') and-then eSameKind(M, ETL, ETL')) or-else msgFamilyIn((msg F : ETL -> ES .), MDS, M) . eq msgFamilyIn((msg F : ETL -> ES .), none, M) = false . *** In the case of views, the \texttt{parseDecl} function takes the term *** representing the corresponding declaration and a preview in which the *** declarations are introduced. Note that in the case of views, the approach *** followed in the evaluation is somewhat different. The only predeclarations *** in a preview correspond to the term premaps of sort \texttt{PreTermMap}, *** for which, in addition to solving the bubbles in them, we have to convert *** them into term maps of sort \texttt{TermMap} associating to them the set *** of declarations of variables in the view which are used in them (see *** Section~\ref{view-processing}). *** The function \texttt{parseDecl} for declarations in views takes then the *** term representing such declaration and a preview in which the result of *** adding the declaration will be returned. To be able to generate the sets *** of equivalent operator and message maps as indicated above, the function *** takes also as parameters the sets of declarations of operators and messages *** in the theory part of the source theory of the view in question, and the *** signature of such theory to make the necessary sort comparisons. op parseDecl : Term PreView EOpDeclSet MsgDeclSet Module -> PreView . eq parseDecl('sort_to_.[T, T'], PV, EOPDS, MDS, M) = addMapSet((sort parseType(T) to parseType(T')), PV) . eq parseDecl('class_to_.[T, T'], PV, EOPDS, MDS, M) = addMapSet((class parseType(T) to parseType(T')), PV) . eq parseDecl('vars_:_.['neTokenList[T], T'], PV, EOPDS, MDS, M) = addVars(parseVarDeclSet(downQidList(T), eSortToSort(parseType(T'))), PV). eq parseDecl('var_:_.['neTokenList[T], T'], PV, EOPDS, MDS, M) = addVars(parseVarDeclSet(downQidList(T), eSortToSort(parseType(T'))), PV). eq parseDecl('op_to`term_.[T, T'], PV, EOPDS, MDS, M) = addMapSet(preTermMap(T, T'), PV) . eq parseDecl('op_to_.['token[T], 'token[T']], PV, EOPDS, MDS, M) = addMapSet(genOpMapSet((op downQid(T) to downQid(T') [none]), EOPDS, M), PV) . eq parseDecl('op_:_->_to_.['token[T], T', T'', 'token[T''']], PV, EOPDS, MDS, M) = addMapSet( op downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T''') [none], PV) . eq parseDecl('op_:`->_to_.['token[T], T', 'token[T'']], PV, EOPDS, MDS, M) = addMapSet((op downQid(T) : nil -> parseType(T') to downQid(T'') [none]), PV) . eq parseDecl('msg_to_.['token[T], 'token[T']], PV, EOPDS, MDS, M) = addMapSet(genMsgMapSet((msg downQid(T) to downQid(T')), MDS, M), PV) . eq parseDecl('msg_:_->_to_.['token[T], T', T'', 'token[T''']], PV, EOPDS, MDS, M) = addMapSet( msg downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T'''), PV) . eq parseDecl('msg_:`->_to_.['token[T], T', 'token[T'']], PV, EOPDS, MDS, M) = addMapSet((msg downQid(T) : nil -> parseType(T') to downQid(T'')), PV) . eq parseDecl('label_to_.['token[T], 'token[T']], PV, EOPDS, MDS, M) = addMapSet((label downQid(T) to downQid(T')), PV) . eq parseDecl('attr_._to_.['token[T], T', 'token[T'']], PV, EOPDS, MDS, M) = addMapSet((attr downQid(T) . parseType(T') to downQid(T'')), PV) . eq parseDecl(T, PV, EOPDS, MDS, M) = PV [owise] . endfm ******************************************************************************* *** *** 8.2 Meta Pretty Printing *** *** To be able to show to the user the modules, theories, views, and terms *** resulting from the different commands, the built-in function *** \texttt{meta-pretty-print} is extended in the modules in this section to *** deal with units and views. *** *** 8.2.1 Meta Pretty Printing of Declarations *** *** The predefined function \texttt{meta-pretty-print} is extended in the *** following module \texttt{DECL-META-PRETTY-PRINT} to handle any declaration *** that can appear in a unit. Note that the following *** \texttt{meta-pretty-print} functions, as the built-in one, return a list *** terms---such as equations, rules,* operator declarations with an identity *** attribute, etc.---they have been defined with a term of operator *** declarations with an identity attribute, etc.---they have been defined *** with a term of sort \texttt{Module} as argument. In the other cases the *** module is not necessary. fmod DECL-META-PRETTY-PRINT is pr EXT-DECL . pr O-O-DECL . pr EXT-SORT-TO-QID . pr UNIT . pr CONVERSION . pr INT-LIST . op eMetaPrettyPrint : ESort -> QidList . op eMetaPrettyPrint : ESortSet -> QidList . op eMetaPrettyPrint : ETypeList -> QidList . op eMetaPrettyPrint : ESubsortDeclSet -> QidList . op eMetaPrettyPrint : ClassDeclSet -> QidList . op eMetaPrettyPrint : SubclassDeclSet -> QidList . op eMetaPrettyPrint : Module EOpDeclSet -> QidList . op eMetaPrettyPrint : MsgDeclSet -> QidList . op eMetaPrettyPrint : Module EMembAxSet -> QidList . op eMetaPrettyPrint : Module EquationSet -> QidList . op eMetaPrettyPrint : Module RuleSet -> QidList . op eMetaPrettyPrint : Module Condition -> QidList . op eMetaPrettyPrint : Unit Term -> QidList . eq eMetaPrettyPrint(U, T) = metaPrettyPrint(U, T) . ---= if metaPrettyPrint(U, T) :: QidList --- then metaPrettyPrint(U, T) --- else 'error* --- fi . eq eMetaPrettyPrint(U, (error(QIL)).QidList) = QIL . eq eMetaPrettyPrint((error(QIL)).QidList) = QIL . op eMetaPrettyPrint : Module AttrSet -> QidList . op eMetaPrettyPrint : IntList -> QidList . op eMetaPrettyPrint : ViewExp -> QidList . op eMetaPrettyPrint : AttrDeclSet -> QidList . op eMetaPrettyPrint : Module HookList -> QidList . vars QI QI' QI'' F V L : Qid . var QIL : QidList . var St : String . var M : Module . var U : Unit . vars VE VE' : ViewExp . vars SS : SortSet . vars ES ES' : ESort . var ESS : ESortSet . var ETL : ETypeList . var ET : EType . var ESSDS : ESubsortDeclSet . var EOPDS : EOpDeclSet . var AtS : AttrSet . var EMAS : EMembAxSet . var EqS : EquationSet . var RlS : RuleSet . var H : Hook . var HL : HookList . var I : Int . var NL : IntList . vars T T' T'' T''' : Term . var CDS : ClassDeclSet . var SCDS : SubclassDeclSet . var MDS : MsgDeclSet . var ADS : AttrDeclSet . var Cond : Condition . ceq eMetaPrettyPrint(VE) = viewExpToQidList(VE) if not VE :: Kind . ceq eMetaPrettyPrint(ET) = if QI == '`) then QIL QI '\s else QIL QI fi if QIL QI := eSortToQidList(ET) . ceq eMetaPrettyPrint((ES ; ESS)) = (eMetaPrettyPrint(ES) eMetaPrettyPrint(ESS)) if ESS =/= none . eq eMetaPrettyPrint((none).SortSet) = nil . ceq eMetaPrettyPrint(ET ETL) = eMetaPrettyPrint(ET) eMetaPrettyPrint(ETL) if ETL =/= nil . eq eMetaPrettyPrint((nil).ETypeList) = nil . eq eMetaPrettyPrint(((subsort ES < ES' .) ESSDS)) = ('\n '\s '\s '\b 'subsort '\o eMetaPrettyPrint(ES) '\b '< '\o eMetaPrettyPrint(ES') '\b '. '\o eMetaPrettyPrint(ESSDS)) . eq eMetaPrettyPrint((none).ESubsortDeclSet) = nil . ceq eMetaPrettyPrint(M, ((op F : ETL -> ET [AtS] .) EOPDS)) = ('\n '\s '\s '\b 'op '\o F '\b ': '\o eMetaPrettyPrint(ETL) '\b '-> '\o eMetaPrettyPrint(ET) '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o eMetaPrettyPrint(M, EOPDS)) if AtS =/= none . eq eMetaPrettyPrint(M, ((op F : ETL -> ET [none] .) EOPDS)) = ('\n '\s '\s '\b 'op '\o F '\b ': '\o eMetaPrettyPrint(ETL) '\b '-> '\o eMetaPrettyPrint(ET) '\b '. '\o eMetaPrettyPrint(M, EOPDS)) . eq eMetaPrettyPrint(M, (none).EOpDeclSet) = nil . eq eMetaPrettyPrint(M, (mb T : ES [none] .) EMAS) = ('\n '\s '\s '\b 'mb '\o eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(ES) '\b '. '\o eMetaPrettyPrint(M, EMAS)) . ceq eMetaPrettyPrint(M, (mb T : ES [AtS] .) EMAS) = ('\n '\s '\s '\b 'mb '\o eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(ES) '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o eMetaPrettyPrint(M, EMAS)) if AtS =/= none . eq eMetaPrettyPrint(M, (cmb T : ES if Cond [none] .) EMAS) = ('\n '\s '\s '\b 'cmb '\o eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(ES) '\n '\s '\s '\b 'if '\o eMetaPrettyPrint(M, Cond) '\b '. '\o eMetaPrettyPrint(M, EMAS)) . ceq eMetaPrettyPrint(M, (cmb T : ES if Cond [AtS] .) EMAS) = ('\n '\s '\s '\b 'cmb '\o eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(ES) '\n '\s '\s '\b 'if '\o eMetaPrettyPrint(M, Cond) '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o eMetaPrettyPrint(M, EMAS)) if AtS =/= none . eq eMetaPrettyPrint(M, (none).EMembAxSet) = nil . eq eMetaPrettyPrint(M, ((eq T = T' [none] .) EqS)) = ('\n '\s '\s '\b 'eq '\s '\o eMetaPrettyPrint(M, T) '\n '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T') '\b '\s '. '\o eMetaPrettyPrint(M, EqS)) . ceq eMetaPrettyPrint(M, ((eq T = T' [AtS] .) EqS)) = ('\n '\s '\s '\b 'eq '\s '\o eMetaPrettyPrint(M, T) '\n '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T') '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o eMetaPrettyPrint(M, EqS)) if AtS =/= none . eq eMetaPrettyPrint(M, ((ceq T = T' if Cond [none] .) EqS)) = ('\n '\s '\s '\b 'ceq '\s '\o eMetaPrettyPrint(M, T) '\n '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T') '\n '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) '\b '\s '. '\o eMetaPrettyPrint(M, EqS)) . ceq eMetaPrettyPrint(M, ((ceq T = T' if Cond [AtS] .) EqS)) = ('\n '\s '\s '\b 'ceq '\s '\o eMetaPrettyPrint(M, T) '\n '\s '\s '\s '\s '\b '= '\s '\o eMetaPrettyPrint(M, T') '\n '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o eMetaPrettyPrint(M, EqS)) if AtS =/= none . eq eMetaPrettyPrint(M, (none).EquationSet) = nil . eq eMetaPrettyPrint(M, ((rl T => T' [none] .) RlS)) = ('\n '\s '\s '\b 'rl '\s '\o eMetaPrettyPrint(M, T) '\n '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') '\b '\s '. '\o eMetaPrettyPrint(M, RlS)) . ceq eMetaPrettyPrint(M, ((rl T => T' [AtS] .) RlS)) = ('\n '\s '\s '\b 'rl '\s '\o eMetaPrettyPrint(M, T) '\n '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o eMetaPrettyPrint(M, RlS)) if AtS =/= none . eq eMetaPrettyPrint(M, ((crl T => T' if Cond [none] .) RlS)) = ('\n '\s '\s '\b 'crl '\s '\o eMetaPrettyPrint(M, T) '\n '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') '\n '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) '\b '\s '. '\o eMetaPrettyPrint(M, RlS)) . ceq eMetaPrettyPrint(M, ((crl T => T' if Cond [AtS] .) RlS)) = ('\n '\s '\s '\b 'crl '\s '\o eMetaPrettyPrint(M, T) '\n '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') '\n '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o eMetaPrettyPrint(M, RlS)) if AtS =/= none . eq eMetaPrettyPrint(M, (none).RuleSet) = nil . ceq eMetaPrettyPrint(M, T = T' /\ Cond) = (eMetaPrettyPrint(M, T) '\b '= '\o eMetaPrettyPrint(M, T') '\b '/\ '\o eMetaPrettyPrint(M, Cond)) if Cond =/= nil . ceq eMetaPrettyPrint(M, T : ES /\ Cond) = (eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(ES) '\b '/\ '\o eMetaPrettyPrint(M, Cond)) if Cond =/= nil . ceq eMetaPrettyPrint(M, T := T' /\ Cond) = (eMetaPrettyPrint(M, T) '\b ':= '\o eMetaPrettyPrint(M, T') '\b '/\ '\o eMetaPrettyPrint(M, Cond)) if Cond =/= nil . ceq eMetaPrettyPrint(M, T => T' /\ Cond) = (eMetaPrettyPrint(M, T) '\b '=> '\o eMetaPrettyPrint(M, T') '\b '/\ '\o eMetaPrettyPrint(M, Cond)) if Cond =/= nil . eq eMetaPrettyPrint(M, T = T') = (eMetaPrettyPrint(M, T) '\b '= '\o eMetaPrettyPrint(M, T')) . eq eMetaPrettyPrint(M, T : ES) = (eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(ES)) . eq eMetaPrettyPrint(M, T := T') = (eMetaPrettyPrint(M, T) '\b ':= '\o eMetaPrettyPrint(M, T')) . eq eMetaPrettyPrint(M, T => T') = (eMetaPrettyPrint(M, T) '\b '=> '\o eMetaPrettyPrint(M, T')) . eq eMetaPrettyPrint(M, (assoc AtS)) = ('\b 'assoc '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (comm AtS)) = ('\b 'comm '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (memo AtS)) = ('\b 'memo '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (idem AtS)) = ('\b 'idem '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (id(T) AtS)) = ('\b 'id: '\o eMetaPrettyPrint(M, T) eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (right-id(T) AtS)) = ('\b 'right 'id: '\o eMetaPrettyPrint(M, T) eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (left-id(T) AtS)) = ('\b 'left 'id: '\o eMetaPrettyPrint(M, T) eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (strat(NL) AtS)) = ('\b 'strat '`( '\o eMetaPrettyPrint(NL) '\b '`) '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (memo AtS)) = ('\b 'memo '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (prec(I) AtS)) = ('\b 'prec '\o eMetaPrettyPrint(I) eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (gather(QIL) AtS)) = ('\b 'gather '\o '`( QIL '`) eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (format(QIL) AtS)) = ('\b 'format '\o '`( QIL '`) eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (ctor AtS)) = ('\b 'ctor '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (frozen(NL) AtS)) = ('\b 'frozen '`( '\o eMetaPrettyPrint(NL) '\b '`) '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (iter AtS)) = ('\b 'iter '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (special(HL) AtS)) = ('\b 'special '`( '\o eMetaPrettyPrint(M, HL) '\b '`) '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (label(QI) AtS)) = ('\b 'label '\o QI '\b '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (metadata(St) AtS)) = ('\b 'metadata '\o qid("\"" + St + "\"") '\b '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (nonexec AtS)) = ('\b 'nonexec '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (owise AtS)) = ('\b 'owise '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (none).AttrSet) = nil . eq eMetaPrettyPrint(M, (H HL)) = (eMetaPrettyPrint(M, H) eMetaPrettyPrint(M, HL)) . eq eMetaPrettyPrint(M, id-hook(QI, nil)) = ('\b 'id-hook '\o QI) . ceq eMetaPrettyPrint(M, id-hook(QI, QIL)) = ('\b 'id-hook '\o QI '\b '`( '\o QIL '\b '`) '\o ) if QIL =/= nil . eq eMetaPrettyPrint(M, op-hook(QI, QI', nil, QI'')) = ('\b 'op-hook '\o QI '\b '`( '\o QI' ': '-> QI'' '\b '`) '\o) . ceq eMetaPrettyPrint(M, op-hook(QI, QI', QIL, QI'')) = ('\b 'op-hook '\o QI '\b '`( '\o QI' ': QIL '-> QI'' '\b '`) '\o) if QIL =/= nil . eq eMetaPrettyPrint(M, term-hook(QI, T)) = ('\b 'term-hook '\o QI '\b '`( '\o eMetaPrettyPrint(M, T) '\b '`) '\o) . eq eMetaPrettyPrint((I NL)) = (qid(string(I, 10)) eMetaPrettyPrint(NL)) . eq eMetaPrettyPrint(I) = qid(string(I, 10)) . eq eMetaPrettyPrint((class ES | ADS .) CDS) = ((if ADS == none then ('\n '\s '\s '\b 'class '\o eMetaPrettyPrint(ES) '\b '. '\o) else ('\n '\s '\s '\b 'class '\o eMetaPrettyPrint(ES) '\b '| '\o eMetaPrettyPrint(ADS) '\b '. '\o) fi) eMetaPrettyPrint(CDS)) . eq eMetaPrettyPrint((none).ClassDeclSet) = nil . eq eMetaPrettyPrint((subclass ES < ES' .) SCDS) = ('\n '\s '\s '\b 'subclass '\o eMetaPrettyPrint(ES) '\b '< '\o eMetaPrettyPrint(ES') '\b '. '\o eMetaPrettyPrint(SCDS)) . eq eMetaPrettyPrint((none).SubclassDeclSet) = nil . eq eMetaPrettyPrint((msg F : ETL -> ES .) MDS) = ('\n '\s '\s '\b 'msg '\o F '\b ': '\o eMetaPrettyPrint(ETL) '\b '-> '\o eMetaPrettyPrint(ES) '\b '. '\o eMetaPrettyPrint(MDS)) . eq eMetaPrettyPrint((none).MsgDeclSet) = nil . ceq eMetaPrettyPrint(((attr F : ES), ADS)) = (F '\b ': '\o eMetaPrettyPrint(ES) '\b '`, '\o '\s eMetaPrettyPrint(ADS)) if ADS =/= none . eq eMetaPrettyPrint((attr F : ES)) = (F '\b ': '\o eMetaPrettyPrint(ES)) . eq eMetaPrettyPrint((none).AttrDeclSet) = nil . endfm ******************************************************************************* *** *** 8.2.2 Meta Pretty Printing of Units *** *** In the following module, the \texttt{meta-pretty-print} function is *** defined on sort \texttt{Unit}. fmod UNIT-META-PRETTY-PRINT is pr UNIT . pr DECL-META-PRETTY-PRINT . op eMetaPrettyPrint : Unit Unit -> QidList . op eMetaPrettyPrint : Module Unit -> QidList . op eMetaPrettyPrint : ModName -> QidList . op eMetaPrettyPrint : ParameterList -> QidList . op eMetaPrettyPrint : EImportList -> QidList . var M : Module . var QI : Qid . var QIL : QidList . var ME : ModExp . var MN : ModName . var SS : SortSet . var ESS : ESortSet . var PL : ParameterList . var IL : ImportList . vars EIL EIL' : EImportList . var SSDS : SubsortDeclSet . var ESSDS : ESubsortDeclSet . var OPDS : OpDeclSet . var EOPDS : EOpDeclSet . var MAS : MembAxSet . var EMAS : EMembAxSet . var EqS : EquationSet . var RlS : RuleSet . var CDS : ClassDeclSet . var SCDS : SubclassDeclSet . var MDS : MsgDeclSet . var U : Unit . var If : Interface . ceq eMetaPrettyPrint(MN) = if QI == '`) or QI == '`] or QI == '`} then QIL QI '\s else QIL QI fi if QIL QI := modNameToQidList(MN) . eq eMetaPrettyPrint(W:[Unit], (error(QIL)).[Unit]) = QIL . eq eMetaPrettyPrint((error(QIL)).[Unit], noUnit) = QIL . eq eMetaPrettyPrint(noUnit, noUnit) = nil . eq eMetaPrettyPrint(M, mod QI is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = ('\n '\b 'mod '\o QI '\b 'is '\o eMetaPrettyPrint(IL) (if SS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o) fi) eMetaPrettyPrint(SSDS) eMetaPrettyPrint(M, OPDS) eMetaPrettyPrint(M, MAS) eMetaPrettyPrint(M, EqS) eMetaPrettyPrint(M, RlS) '\n '\b 'endm '\o '\n) . eq eMetaPrettyPrint(M, mod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endm) = ('\n '\b 'mod '\o eMetaPrettyPrint(MN) (if PL == nilParList then nil else '`( eMetaPrettyPrint(PL) '`) '\s fi) '\b 'is '\o eMetaPrettyPrint(EIL) (if ESS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(ESS) '\b '. '\o) fi) eMetaPrettyPrint(ESSDS) eMetaPrettyPrint(M, EOPDS) eMetaPrettyPrint(M, EMAS) eMetaPrettyPrint(M, EqS) eMetaPrettyPrint(M, RlS) '\n '\b 'endm '\o '\n) . eq eMetaPrettyPrint(M, th MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS RlS endth) = ('\n '\b 'th '\o eMetaPrettyPrint(MN) (if PL == nilParList then nil else '`( eMetaPrettyPrint(PL) '`) '\s fi) '\b 'is '\o eMetaPrettyPrint(EIL) (if ESS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(ESS) '\b '. '\o) fi) eMetaPrettyPrint(ESSDS) eMetaPrettyPrint(M, EOPDS) eMetaPrettyPrint(M, EMAS) eMetaPrettyPrint(M, EqS) eMetaPrettyPrint(M, RlS) '\n '\b 'endth '\o '\n) . eq eMetaPrettyPrint(M, fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm) = ('\n '\b 'fmod '\o QI '\b 'is '\o eMetaPrettyPrint(IL) (if SS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o) fi) eMetaPrettyPrint(SSDS) eMetaPrettyPrint(M, OPDS) eMetaPrettyPrint(M, MAS) eMetaPrettyPrint(M, EqS) '\n '\b 'endfm '\o '\n) . eq eMetaPrettyPrint(M, fmod MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfm) = ('\n '\b 'fmod '\o eMetaPrettyPrint(MN) (if PL == nilParList then nil else '`( eMetaPrettyPrint(PL) '`) '\s fi) '\b 'is '\o eMetaPrettyPrint(EIL) (if ESS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(ESS) '\b '. '\o) fi) eMetaPrettyPrint(ESSDS) eMetaPrettyPrint(M, EOPDS) eMetaPrettyPrint(M, EMAS) eMetaPrettyPrint(M, EqS) '\n '\b 'endfm '\o '\n) . eq eMetaPrettyPrint(M, fth MN is PL EIL sorts ESS . ESSDS EOPDS EMAS EqS endfth) = ('\n '\b 'fth '\o eMetaPrettyPrint(MN) (if PL == nilParList then nil else '`( eMetaPrettyPrint(PL) '`) '\s fi) '\b 'is '\o eMetaPrettyPrint(EIL) (if ESS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(ESS) '\b '. '\o) fi) eMetaPrettyPrint(ESSDS) eMetaPrettyPrint(M, EOPDS) eMetaPrettyPrint(M, EMAS) eMetaPrettyPrint(M, EqS) '\n '\b 'endfth '\o '\n) . eq eMetaPrettyPrint(M, omod MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endom) = ('\n '\b 'omod '\o eMetaPrettyPrint(MN) (if PL == nilParList then nil else ('`( eMetaPrettyPrint(PL) '`) '\s) fi) '\b 'is '\o eMetaPrettyPrint(EIL) (if ESS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(ESS) '\b '. '\o) fi) eMetaPrettyPrint(ESSDS) eMetaPrettyPrint(CDS) eMetaPrettyPrint(SCDS) eMetaPrettyPrint(M, EOPDS) eMetaPrettyPrint(MDS) eMetaPrettyPrint(M, EMAS) eMetaPrettyPrint(M, EqS) eMetaPrettyPrint(M, RlS) '\n '\b 'endom '\o '\n) . eq eMetaPrettyPrint(M, oth MN is PL EIL sorts ESS . ESSDS CDS SCDS EOPDS MDS EMAS EqS RlS endoth) = ('\n '\b 'oth '\o eMetaPrettyPrint(MN) (if PL == nilParList then nil else ('`( eMetaPrettyPrint(PL) '`) '\s) fi) '\b 'is '\o eMetaPrettyPrint(EIL) (if ESS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(ESS) '\b '. '\o) fi) eMetaPrettyPrint(ESSDS) eMetaPrettyPrint(CDS) eMetaPrettyPrint(SCDS) eMetaPrettyPrint(M, EOPDS) eMetaPrettyPrint(MDS) eMetaPrettyPrint(M, EMAS) eMetaPrettyPrint(M, EqS) eMetaPrettyPrint(M, RlS) '\n '\b 'endoth '\o '\n) . eq eMetaPrettyPrint((including ME .) EIL) = ('\n '\s '\s '\b 'including '\o eMetaPrettyPrint(ME) '\b '. '\o eMetaPrettyPrint(EIL)) . eq eMetaPrettyPrint((extending ME .) EIL) = ('\n '\s '\s '\b 'extending '\o eMetaPrettyPrint(ME) '\b '. '\o eMetaPrettyPrint(EIL)) . eq eMetaPrettyPrint((protecting ME .) EIL) = ('\n '\s '\s '\b 'protecting '\o eMetaPrettyPrint(ME) '\b '. '\o eMetaPrettyPrint(EIL)) . eq eMetaPrettyPrint((protecting (par QI :: ME) .) EIL) = eMetaPrettyPrint(EIL) . eq eMetaPrettyPrint((protecting (par QI :: par(ME, PL)) .) EIL) = eMetaPrettyPrint(EIL) . eq eMetaPrettyPrint((nil).EImportList) = nil . ceq eMetaPrettyPrint(parList((par QI :: ME), PL)) = (QI ':: eMetaPrettyPrint(ME) '| eMetaPrettyPrint(PL)) if PL =/= nilParList . eq eMetaPrettyPrint((par QI :: ME)) = (QI ':: eMetaPrettyPrint(ME)) . eq eMetaPrettyPrint(nilParList) = nil . endfm ******************************************************************************* *** The function \texttt{meta-pretty-print} on units is defined recursively, *** calling the \texttt{meta-pretty-print} functions for the different *** declarations in the unit defined in module \texttt{DECL-META-PRETTY-PRINT}. *** *** 8.2.3 Meta Pretty Printing of Maps and Views *** *** We define in the following module the function \texttt{meta-pretty-print} *** on maps. fmod MAP-SET-META-PRETTY-PRINT is pr DECL-META-PRETTY-PRINT . pr MAP . pr UNIT . op eMetaPrettyPrint : MapSet -> QidList . var MAP : Map . var MAPS : MapSet . vars QI QI' F F' L L' : Qid . var AtS : AttrSet . vars ES ES' : ESort . var ETL : ETypeList . ceq eMetaPrettyPrint((MAP, MAPS)) = (eMetaPrettyPrint(MAP) '`, '\t eMetaPrettyPrint(MAPS)) if MAPS =/= none . eq eMetaPrettyPrint((none).MapSet) = nil . eq eMetaPrettyPrint(op F to F' [AtS]) = if AtS == none then ('\b 'op '\o F '\b 'to '\o F') else ('\b 'op F '\b 'to '\o F' '\b '`[ '\o eMetaPrettyPrint(noUnit, AtS) '\b '`] '\o) *** In a map there should not be attributes requiring a module fi . eq eMetaPrettyPrint(op F : ETL -> ES to F' [AtS]) = if AtS == none then ('\b 'op '\o F '\b ': '\o eMetaPrettyPrint(ETL) '\b '-> '\o eMetaPrettyPrint(ES) '\b 'to '\o F') else ('\b 'op '\o F '\b ': '\o eMetaPrettyPrint(ETL) '\b '-> '\o eMetaPrettyPrint(ES) '\b 'to '\o F' '\b '`[ '\o eMetaPrettyPrint(noUnit, AtS) '\b '`] '\o) *** In a map there should not be attributes requiring a module fi . eq eMetaPrettyPrint(sort ES to ES') = ('\b 'sort '\o eMetaPrettyPrint(ES) '\b 'to '\o eMetaPrettyPrint(ES')) . eq eMetaPrettyPrint(label L to L') = ('\b 'label '\o L '\b 'to '\o L') . eq eMetaPrettyPrint(class ES to ES') = ('\b 'class '\o eMetaPrettyPrint(ES) '\b 'to '\o eMetaPrettyPrint(ES')) . eq eMetaPrettyPrint(attr QI . ES to QI') = ('\b 'attr '\o QI '\b '. '\o eMetaPrettyPrint(ES) '\b 'to '\o QI') . eq eMetaPrettyPrint(msg F to F') = ('\b 'msg '\o F '\b 'to '\o F') . eq eMetaPrettyPrint(msg F : ETL -> ES to F') = ('\b 'msg '\o F '\b ': '\o eMetaPrettyPrint(ETL) '\b '-> '\o eMetaPrettyPrint(ES) '\b 'to '\o F') . endfm ******************************************************************************* *** Finally, in the \texttt{VIEW-META-PRETTY-PRINT} module, the *** \texttt{meta-pretty-print} function is defined on views. fmod VIEW-META-PRETTY-PRINT is pr DATABASE . pr MAP-SET-META-PRETTY-PRINT . pr VIEW-MAP-SET-APPL-ON-UNIT . pr DECL-EXT-SORT-TO-QID . op eMetaPrettyPrint : Database View -> QidList . op eMetaPrettyPrint : ViewExp -> QidList . op eMetaPrettyPrint : ModExp ModExp Database ViewMapSet ViewMapSet -> QidList . var QI : Qid . var QIL : QidList . var DB : Database . vars ME ME' : ModExp . var MAP : Map . var VMAP : ViewMap . vars VMAPS VMAPS' : ViewMapSet . vars T T' : Term . var PL : ParameterList . vars VE VE' : ViewExp . var DT : Default`(Term`) . ceq eMetaPrettyPrint(DB, view(VE, PL, ME, ME', VMAPS)) = ('\n '\b 'view '\o QIL QI (if PL == nilParList then if QI == '`) then '\s else nil fi else '`( eMetaPrettyPrint(PL) '`) '\s fi) '\b 'from '\o eMetaPrettyPrint(ME) '\b 'to '\o eMetaPrettyPrint(ME') '\b 'is '\o '\n '\s '\s eMetaPrettyPrint(ME, ME', DB, VMAPS, VMAPS) '\n '\b 'endv '\o) if QIL QI := eMetaPrettyPrint(VE) . eq eMetaPrettyPrint(DB, error(QIL)) = QIL . ceq eMetaPrettyPrint(QI) = QI if not QI :: Type . ceq eMetaPrettyPrint((VE | VE')) = eMetaPrettyPrint(VE) '`, '\s eMetaPrettyPrint(VE') if VE =/= nullViewExp /\ VE' =/= nullViewExp . eq eMetaPrettyPrint((VE ;; VE')) = eMetaPrettyPrint(VE) '; eMetaPrettyPrint(VE') . eq eMetaPrettyPrint(QI << VE >>) = QI '`( eMetaPrettyPrint(VE) '`) '\s . eq eMetaPrettyPrint(_`{_`}(QI, VE)) = QI '`{ eMetaPrettyPrint(VE) '`} . ceq eMetaPrettyPrint(ME, ME', DB, (VMAP, VMAPS), VMAPS') = (eMetaPrettyPrint(ME, ME', DB, VMAP, VMAPS') '\n '\s '\s eMetaPrettyPrint(ME, ME', DB, VMAPS, VMAPS')) if VMAPS =/= none . eq eMetaPrettyPrint(ME, ME', DB, none, VMAPS) = nil . eq eMetaPrettyPrint(ME, ME', DB, MAP, VMAPS) = eMetaPrettyPrint(MAP) '. . eq eMetaPrettyPrint(ME, ME', DB, termMap(T, T'), VMAPS) = if ME' inModNameSet builtIns then ('\b 'op '\o eMetaPrettyPrint(getFlatUnit(ME, DB), T) '\b 'to 'term '\o eMetaPrettyPrint(DUMMY(ME'), T') '\b '. '\o) else ('\b 'op '\o eMetaPrettyPrint(getFlatUnit(ME, DB), T) '\b 'to 'term '\o eMetaPrettyPrint(getFlatUnit(ME', DB), T') '\b '. '\o) fi . eq eMetaPrettyPrint(termMap(T, T')) = ('op eMetaPrettyPrint(T) '\b 'to '\o eMetaPrettyPrint(T')) . endfm ******************************************************************************* *** *** 8.3 Input Processing *** *** The processing functions presented in the following modules are in charge *** of taking each term generated by the \texttt{metaParse} function and, *** after transforming it into an element of the data types \texttt{Unit} or *** \texttt{View}, or generating some output, returning the database resulting *** from introducing in it such a term. We shall see in *** Section~\ref{database-handling} how the appropriate function is called *** after having performed a first analysis of the term, in which it is *** detected whether the input corresponds to a unit, view, or command. In the *** cases of units and views the processing is quite similar. After a *** preprocessing of the term, the function \texttt{parseDecl} is called with *** each of the subterms representing declarations, resulting in units or *** views with the parsed declarations in it. *** *** 8.3.1 Unit Processing *** *** The processing of a term resulting from the parsing of some input *** corresponding to a unit is accomplished by the \texttt{procUnit} function. *** This function takes as arguments a term of sort \texttt{Term}, which *** represents some preunit, and a database. The function then enters into the *** given database the unit obtained from the transformation of such term *** into a term of sort \texttt{Unit}. fmod UNIT-PROCESSING is pr DATABASE . pr UNIT-DECL-PARSING . pr EVALUATION . pr VIEW-MAP-SET-APPL-ON-UNIT . pr META-FULL-MAUDE-SIGN . vars QI F X : Qid . var M : Module . vars PU PU' U U' : Unit . vars DB DB' : Database . vars T T' T'' T''' : Term . var TL : TermList . vars PL PL' PL'' : ParameterList . var EIL EIL' : EImportList . var ME : ModExp . var S : Sort . var SS : SortSet . var ME' : ModExp . var VMAPS : ViewMapSet . var B : Bool . var VDS : EOpDeclSet . var QIL : QidList . var PDR : ParseDeclResult . var DT : Default`(Term`) . *** The \texttt{parseParList} takes a term representing a list of parameters *** and returns the corresponding list. op parseParList : Term -> ParameterList . eq parseParList('_::_['token[T], T']) = if sortLeq(GRAMMAR, leastSort(GRAMMAR, T'), 'ModExp) then (par downQid(T) :: parseModExp(T')) else (par downQid(T) :: parseInterface(T')) fi . eq parseParList('_|_[T, T']) = parList(parseParList(T), parseParList(T')) . op parseInterface : Term -> Interface . eq parseInterface('_`(_`)[T, T']) = par(parseModExp(T), parseParList(T')) . *** The function \texttt{procPars} takes a preunit and a database and returns *** the resulting premodule and database, after processing each of the *** parameters in the parameter list of the preunit. For each of the parameters *** an importation declaration is added to the module, and the module *** expression used as parameter theory is evaluated in the database. The *** function returns a pair composed by a preunit and a *** database (\texttt{UnitDatabasePair}) as its result. *** The function \texttt{procParsAux} proceeds recursively on each of the *** parameters in the list of parameters of the given module. For each *** parameter of the form \verb~par X :: ME~, the module expression \texttt{ME} *** is evaluated using the \texttt{evalModExp} function, which was discussed in *** Section~\ref{evalModExp}, and then a copy of such a theory is created using *** the \texttt{createCopy} function, which applies to the unit the *** appropriate transformation, as explained in Section~\ref{instantiation}. sort UnitDatabasePair . op <_;_> : Unit Database -> UnitDatabasePair . op procPars : Unit Database -> UnitDatabasePair . op procParsAux : Unit ParameterList EImportList Database -> UnitDatabasePair . eq procPars(PU, DB) = procParsAux(PU, getParList(PU), nil, DB) . eq procParsAux(PU, parList((par X :: ME), PL), EIL, DB) = procParsAux(PU, PL, ((protecting (par X :: ME) .) EIL), createCopy((par X :: ME), evalModExp(ME, nilParList, DB))) . eq procParsAux(PU, parList((par X :: par(ME, PL')), PL), EIL, DB) = procParsAux(PU, PL, ((protecting (par X :: par(ME, PL')) .) EIL), createCopy((par X :: par(ME, PL')), evalModExp(ME, nilParList, DB))) . eq procParsAux(PU, nilParList, EIL, DB) = < addImports(EIL, PU) ; DB > . *** All the operators declared as constructors of sort \texttt{PreUnit} in the *** signature of Full Maude, given in Appendix~\ref{signature-full-maude}, are *** declared with two arguments, namely, the name, or name and interface, of *** the unit, and the list of declarations of such units. The function *** \texttt{procUnit3} is called with the term corresponding to the name, or *** name and interface, of the module as first argument, the term corresponding *** to the set of declarations as second argument, and an empty module of the *** appropriate type, in which the different declarations will be accumulated, *** as third argument. *** The task of the function \texttt{procUnit4} is then to make a second level *** parsing of the input, building up, simultaneously, the preunit represented *** in the term passed as argument, and the unit resulting from the *** declarations without bubbles. This unit without bubbles will be used by the *** \texttt{evalPreUnit} function to build the signature with which to analyze *** the bubbles in the preunit (see Section~\ref{evaluation}). *** The case of parameterized modules requires a special treatment of the *** parameters. These parameters are evaluated and are added as submodules in *** the appropriate way. *** When the last declaration is parsed, the function \texttt{evalPreUnit} is *** called with the preunit (the top module with bubbles) as first argument, *** the empty copy of it as second argument, the top module without bubbles as *** third argument, and the database. *** Note that the \texttt{procUnit} function adds a declaration importing the *** module \texttt{CONFIGURATION+}, presented in *** Section~\ref{non-built-in-predefined}, to the object-oriented modules, and *** that \texttt{procUnit4} adds a declaration importing the built-in module *** \texttt{BOOL} to all modules. op procUnit : Term Database -> Database . op procUnit : Unit Database -> Database . *** moved to MOD-EXPR-EVAL to solve dependency *** op procUnit : Qid Database -> Database . op procUnit2 : Term Term Database -> Database . op procUnit2 : Term Database -> Database . op procUnit3 : Term Term Term Unit Database -> Database . op procUnit3 : Term Term Unit Database -> Database . op procUnit4 : Term Term Unit Unit EOpDeclSet Database -> Database . op procUnit4 : Term Unit Unit EOpDeclSet Database -> Database . *** When recompiling a module, it's called with a Qid, and it's *** not reentered into the database. ceq procUnit(QI, DB) = if DT == noTerm then evalUnit(U, DB) else procUnit2(DT, DB) fi if < DT ; U > := getTermUnit(QI, DB) . eq procUnit(T, DB) = procUnit2(T, T, DB) . eq procUnit(U, DB) = evalUnit(U, insertTermUnit(getName(U), U, DB)) . *** procUnit2 just calls procUnit3 with the name and the declarations of *** the module, and an empty unit of the right type. eq procUnit2(T, 'fmod_is_endfm[T', T''], DB) = procUnit3(T, T', T'', emptyStrFModule, DB) . eq procUnit2(T, 'obj_is_endo[T', T''], DB) = procUnit3(T, T', T'', emptyStrFModule, DB) . eq procUnit2(T, 'obj_is_jbo[T', T''], DB) = procUnit3(T, T', T'', emptyStrFModule, DB) . eq procUnit2(T, 'mod_is_endm[T', T''], DB) = procUnit3(T, T', T'', emptyStrSModule, DB) . eq procUnit2(T, 'omod_is_endom[T', T''], DB) = procUnit3(T, T', T'', addImports((including 'CONFIGURATION+ .), emptyStrOModule), DB) . eq procUnit2(T, 'fth_is_endfth[T', T''], DB) = procUnit3(T, T', T'', emptyStrFTheory, DB) . eq procUnit2(T, 'th_is_endth[T', T''], DB) = procUnit3(T, T', T'', emptyStrSTheory, DB) . eq procUnit2(T, 'oth_is_endoth[T', T''], DB) = procUnit3(T, T', T'', addImports((including 'CONFIGURATION+ .), emptyStrOTheory), DB) . eq procUnit2('fmod_is_endfm[T, T'], DB) = procUnit3(T, T', emptyStrFModule, DB) . eq procUnit2('obj_is_endo[T, T'], DB) = procUnit3(T, T', emptyStrFModule, DB) . eq procUnit2('obj_is_jbo[T, T'], DB) = procUnit3(T, T', emptyStrFModule, DB) . eq procUnit2('mod_is_endm[T, T'], DB) = procUnit3(T, T', emptyStrSModule, DB) . eq procUnit2('omod_is_endom[T, T'], DB) = procUnit3(T, T', addImports((including 'CONFIGURATION+ .), emptyStrOModule), DB) . eq procUnit2('fth_is_endfth[T, T'], DB) = procUnit3(T, T', emptyStrFTheory, DB) . eq procUnit2('th_is_endth[T, T'], DB) = procUnit3(T, T', emptyStrSTheory, DB) . eq procUnit2('oth_is_endoth[T, T'], DB) = procUnit3(T, T', addImports((including 'CONFIGURATION+ .), emptyStrOTheory), DB) . *** procUnit3 evaluates the name of the module and calls procUnit4 *** with the declarations, two empty units (one to contain the declarations *** with bubbles and another one the declarations without bubbles), and *** a set of op decls initialy empty in which to store the variables ceq procUnit3(T, 'token[T'], T'', U, DB) = if QI inModNameSet builtIns then warning(DB, ('\r 'Error: '\o 'Built-in 'modules 'cannot 'be 'redefined. '\n)) else procUnit4(T, T'', setName(U, QI), setName(U, QI), none, DB) fi if QI := downQid(T') . ceq procUnit3(T, '_`(_`)['token[T'], T''], T''', U, DB) = if QI inModNameSet builtIns then warning(DB, ('\r 'Error: '\o 'Built-in 'modules 'cannot 'be 'redefined. '\n)) else procUnit4(T, T''', PU, setName(U, QI), none, DB') fi if QI := downQid(T') /\ < PU ; DB' > := procPars(setPars(setName(U, QI), parseParList(T'')), DB) . ceq procUnit3('token[T], T', U, DB) = if QI inModNameSet builtIns then warning(DB, ('\r 'Error: '\o 'Built-in 'modules 'cannot 'be 'redefined. '\n)) else procUnit4(T', setName(U, QI), setName(U, QI), none, DB) fi if QI := downQid(T) . ceq procUnit3('_`(_`)['token[T], T'], T'', U, DB) = if QI inModNameSet builtIns then warning(DB, ('\r 'Error: '\o 'Built-in 'modules 'cannot 'be 'redefined. '\n)) else procUnit4(T'', PU, setName(U, QI), none, DB') fi if QI := downQid(T) /\ < PU ; DB' > := procPars(setPars(setName(U, QI), parseParList(T')), DB) . *** procUnit4 parses one by one each of the declarations in the module. *** Note that is parseDecl that adds the parsed declaration to the right *** place. When it is done, it calls evalPreUnit with the resulting *** preModule, unit, vars. ceq procUnit4(T, '__[T', T''], PU, U, VDS, DB) = procUnit4(T, T'', preUnit(PDR), unit(PDR), vars(PDR), DB) if PDR := parseDecl(T', PU, U, VDS) . ceq procUnit4(T, F[TL], PU, U, VDS, DB) = evalPreUnit(preUnit(PDR), unit(PDR), vars(PDR), insertTermUnit(getName(U), T, DB)) if F =/= '__ /\ PU' := if (protecting 'BOOL .) in getImports(PU) then PU else addImports((protecting 'BOOL .), PU) fi /\ PDR := parseDecl(F[TL], PU', U, VDS) . eq procUnit4(T, T', error(QIL), V:[Unit], V:[OpDeclSet], DB) = warning(DB, QIL) . eq procUnit4(T, T', V:[Unit], error(QIL), V:[OpDeclSet], DB) = warning(DB, QIL) . eq procUnit4(T, T', V:[Unit], V':[Unit], error(QIL), DB) = warning(DB, QIL) . ceq procUnit4('__[T, T'], PU, U, VDS, DB) = procUnit4(T', preUnit(PDR), unit(PDR), vars(PDR), DB) if PDR := parseDecl(T, PU, U, VDS) . ceq procUnit4(F[TL], PU, U, VDS, DB) = evalPreUnit(preUnit(PDR), unit(PDR), vars(PDR), DB) if F =/= '__ /\ PU' := if (protecting 'BOOL .) in getImports(PU) then PU else addImports((protecting 'BOOL .), PU) fi /\ PDR := parseDecl(F[TL], PU', U, VDS) . eq procUnit4(T, error(QIL), U, VDS, DB) = warning(DB, QIL) . eq procUnit4(T, PU, error(QIL), VDS, DB) = warning(DB, QIL) . eq procUnit4(T, PU, U, error(QIL), DB) = warning(DB, QIL) . endfm ******************************************************************************* *** *** 8.3.2 View Processing *** *** A similar process is followed for views. Note that in case of operator *** maps going to derived terms we have bubbles, which will have to be treated *** using the signatures of the appropriate modules. fmod VIEW-PROCESSING is pr UNIT-PROCESSING . pr VIEW-DECL-PARSING . pr VIEW-BUBBLE-PARSING . vars QI X F : Qid . vars T T' T'' T''' T'''' : Term . var M : Module . var VE : ViewExp . vars PV PV' : PreView . vars ME ME' : ModExp . vars DB DB' : Database . vars EOPDS VDS VDS' VDS'' : EOpDeclSet . var MDS : MsgDeclSet . var TL : TermList . vars PL PL' : ParameterList . var IS : InfoSet . var MN : ModName . var EIL : EImportList . var PVMAPS : PreViewMapSet . *** As the functions \texttt{getThSortSet} and \texttt{getThClassSet} *** presented in Section~\ref{instantiation}, the functions *** \texttt{getThOpDeclSet} and \texttt{getThMsgDeclSet} return, respectively, *** the set of declarations of operators, and the set of declarations of *** messages in the theory part of the structure of the module given as *** argument. op getThOpDeclSet : ModName Database -> EOpDeclSet . op getThMsgDeclSet : ModName Database -> MsgDeclSet . op getThOpDeclSetAux : EImportList Database -> EOpDeclSet . op getThMsgDeclSetAux : EImportList Database -> MsgDeclSet . eq getThOpDeclSet(MN, DB) = if getTopUnit(MN, DB) :: StrTheory then (getThOpDeclSetAux(getImports(getTopUnit(MN, DB)), DB) getOps(getTopUnit(MN, DB))) else none fi . eq getThOpDeclSetAux(((including MN .) EIL), DB) = (getThOpDeclSet(MN, DB) getThOpDeclSetAux(EIL, DB)) . eq getThOpDeclSetAux(((extending MN .) EIL), DB) = (getThOpDeclSet(MN, DB) getThOpDeclSetAux(EIL, DB)) . eq getThOpDeclSetAux(((protecting MN .) EIL), DB) = (getThOpDeclSet(MN, DB) getThOpDeclSetAux(EIL, DB)) . eq getThOpDeclSetAux(nil, DB) = none . eq getThMsgDeclSet(MN, DB) = if getTopUnit(MN, DB) :: StrTheory then (getThMsgDeclSetAux(getImports(getTopUnit(MN, DB)), DB) getMsgs(getTopUnit(MN, DB))) else none fi . eq getThMsgDeclSetAux(((including MN .) EIL), DB) = (getThMsgDeclSet(MN, DB) getThMsgDeclSetAux(EIL, DB)) . eq getThMsgDeclSetAux(((extending MN .) EIL), DB) = (getThMsgDeclSet(MN, DB) getThMsgDeclSetAux(EIL, DB)) . eq getThMsgDeclSetAux(((protecting MN .) EIL), DB) = (getThMsgDeclSet(MN, DB) getThMsgDeclSetAux(EIL, DB)) . eq getThMsgDeclSetAux(nil, DB) = none . *** The processing of terms representing previews accomplished by the function *** \texttt{procView} is quite similar to the one accomplished by *** \texttt{procUnit} on terms representing preunits. The algorithms followed *** are also quite similar. Both proceed recursively on the list of *** declarations, accumulating them in a preunit or in a preview. *** The solving of bubbles in views requires the signatures of the source and *** target units extended, respectively, with the declarations of variables in *** the view and with the mappings of these declarations. As we shall see in *** Section~\ref{databaseADT}, the signatures of the built-in modules are not *** accesible at the metalevel, and thus built-in modules cannot be used *** directly as arguments of built-in functions. Thus, to be able to use them *** as targets of views, a `dummy' module is created importing the *** corresponding predefined module. The source and target module expressions *** of the view are evaluated before the view processing itself starts. *** As we saw in Section~\ref{view-decl-parsing}, parsing of terms representing *** operator and message maps requires the set of operator and message *** declarations in the theory part of the source theory. op procPars : ParameterList Database -> Database . eq procPars(parList((par X :: ME), PL), DB) = procPars(PL, createCopy((par X :: ME), evalModExp(ME, DB))) . eq procPars(parList((par X :: par(ME, PL')), PL), DB) = procPars(PL, createCopy((par X :: par(ME, PL')), evalModExp(ME, DB))) . eq procPars(nilParList, DB) = DB . op procView : Term Database -> Database . op procView : Term PreView Database -> Database . op procViewAux : Term PreView EOpDeclSet MsgDeclSet Module Database -> Database . eq procView(QI, DB) = procView(getTermView(QI, DB), DB) . eq procView('view_from_to_is_endv['token[T], T', T'', T'''], DB) = procView(T''', emptyPreView(downQid(T), parseModExp(T'), parseModExp(T'')), insertTermView(downQid(T), 'view_from_to_is_endv['token[T], T', T'', T'''], DB)) . eq procView( 'view_from_to_is_endv['_`(_`)['token[T], T'], T'', T''', T''''], DB) = procView(T'''', setPars( emptyPreView(downQid(T), parseModExp(T''), parseModExp(T''')), parseParList(T')), procPars(parseParList(T'), insertTermView(downQid(T), 'view_from_to_is_endv['_`(_`)['token[T], T'], T'', T''', T''''], DB))) . ceq procView(T, PV, DB) = procViewAux(T, PV, getThOpDeclSet(ME, DB'), getThMsgDeclSet(ME, DB'), getFlatUnit(ME, DB'), evalModExp(ME', PL, DB')) if view(VE, PL, ME, ME', none, none) := PV /\ DB' := evalModExp(ME, PL, DB) . eq procViewAux('__[T, T'], PV, EOPDS, MDS, M, DB) *** - EOPDS and MDS are, respectively, the set of operation and *** message declarations in the theory part of the source. *** - M is the signature of the source theory. = procViewAux(T', parseDecl(T, PV, EOPDS, MDS, M), EOPDS, MDS, M, DB) . ceq procViewAux(F[TL], PV, EOPDS, MDS, M, DB) = insertView( view(VE, PL, ME, ME', solveBubbles( PVMAPS, VDS, VDS', addOps(eSortToSort(VDS), M), (if ME' inModNameSet builtIns then (fmod 'DUMMY-2 is including ME' . sorts none . none VDS' none none endfm) else addOps(VDS', getFlatUnit(ME', DB)) fi))), DB) if F =/= '__ /\ view(VE, PL, ME, ME', VDS, PVMAPS) := parseDecl(F[TL], PV, EOPDS, MDS, M) /\ VDS' := eSortToSort( applyMapSetToOpDeclSet(sortMaps(PVMAPS), none, VDS, M)) . endfm ******************************************************************************* *** *** 8.3.3 Command Processing *** *** The function \texttt{procCommand} only handles the \texttt{reduce}, *** \texttt{rewrite}, and \texttt{down} commands. The other commands are *** directly evaluated by the rules for the top-level handling of the *** database (see Section~\ref{database-handling}). The \texttt{procCommand} *** function takes a term, which represents one of these commands, the name of *** the default module, and a database. The result is a list of quoted *** identifiers representing the result of the evaluation of the command that *** will be placed in the read-eval-print loop to be printed in the terminal. *** The \texttt{reduce} and \texttt{rewrite} commands are basically evaluated *** calling the built-in functions \texttt{metaReduce} and *** \texttt{metaRewrite}, respectively. These functions are called with the *** appropriate modules. In the case of commands in which an explicit module *** is not specified the default module is used. *** The preparation of the output for these functions becomes more complex *** when the \texttt{down} command is used. To deal with the \texttt{down} *** command, an auxiliary function \texttt{procCommand2} is introduced, *** returning the term resulting from the evaluation of the command. fmod COMMAND-PROCESSING is pr UNIT-PROCESSING . pr UNIT-META-PRETTY-PRINT . vars T T' T'' : Term . var TL : TermList . vars DB DB' : Database . vars M M' : Module . var MN : ModName . var MNS : ModNameSet . var VE : ViewExp . var VES : ViewExpSet . vars I J : Nat . vars D D' : Bound . var B : Bool . var IS : InfoSet . var QIL : QidList . var SS : SortSet . var SSDS : SubsortDeclSet . var OPDS : OpDeclSet . var VDS : EOpDeclSet . var MAS : MembAxSet . var EqS : EquationSet . var RlS : RuleSet . vars QI QI' F V : Qid . var IL : ImportList . var TM : [TermModule] . var TMB : [TermModuleBound] . var TMBN : [TermModuleBoundNat] . var T? : [Term] . var RP : [ResultPair] . var RT : [ResultTriple] . var CD : Condition . sorts TermModule TermModuleBound TermModuleBoundNat . op {_,_} : Term Module -> TermModule . op {_,_,_} : Term Module Bound -> TermModuleBound . op {_,_,_,_} : Term Module Bound Nat -> TermModuleBoundNat . op error : QidList -> [TermModule] . op error : QidList -> [TermModuleBound] . op error : QidList -> [TermModuleBoundNat] . op error : QidList -> [Bound] . op getTerm : TermModule -> Term . op getModule : TermModule -> Module . op getTerm : TermModuleBound -> Term . op getModule : TermModuleBound -> Module . op getBound : TermModuleBound -> Bound . op getTerm : TermModuleBoundNat -> Term . op getModule : TermModuleBoundNat -> Module . op getBound : TermModuleBoundNat -> Bound . op getNat : TermModuleBoundNat -> Nat . eq getTerm({T, M}) = T . eq getTerm((error(QIL)).TermModule) = error(QIL) . eq getModule({T, M}) = M . eq getModule((error(QIL)).TermModule) = error(QIL) . eq getTerm({T, M, D}) = T . eq getTerm((error(QIL)).TermModuleBound) = error(QIL) . eq getModule({T, M, D}) = M . eq getModule((error(QIL)).TermModuleBound) = error(QIL) . eq getBound({T, M, D}) = D . eq getBound((error(QIL)).TermModuleBound) = error(QIL) . eq getTerm({T, M, D, I}) = T . eq getTerm((error(QIL)).TermModuleBoundNat) = error(QIL) . eq getModule({T, M, D, I}) = M . eq getModule((error(QIL)).TermModuleBoundNat) = error(QIL) . eq getBound({T, M, D, I}) = D . eq getBound((error(QIL)).TermModuleBoundNat) = error(QIL) . eq getNat({T, M, D, I}) = I . eq getNat((error(QIL)).TermModuleBoundNat) = error(QIL) . op procCommand : Term ModExp Database -> QidList . op procRed : ModExp Module Term EOpDeclSet Database -> QidList . op procRed : ModExp Unit Term EOpDeclSet Database -> QidList . op solveBubblesRed : Term Module Bool EOpDeclSet Database -> [TermModule] . op solveBubblesRed2 : Term Database -> [TermModule] . op solveBubblesRed3 : Term Module OpDeclSet Database -> [TermModule] . op procRew : ModExp Module Term Bound EOpDeclSet Database -> QidList . op procRew : ModExp Unit Term Bound EOpDeclSet Database -> QidList . op solveBubblesRew : Term Module Bool Bound EOpDeclSet Database -> [TermModuleBound] . op solveBubblesRew2 : Term Module Bool EOpDeclSet Database -> [TermModuleBound] . op procFrew : ModExp Module Term Bound Nat EOpDeclSet Database -> QidList . op procFrew : ModExp Unit Term Bound Nat EOpDeclSet Database -> QidList . op solveBubblesFrew : Term Module Bool Bound Nat EOpDeclSet Database -> [TermModuleBoundNat] . op solveBubblesFrew2 : Term Module Bool Nat EOpDeclSet Database -> [TermModuleBoundNat] . op procSearch : ModExp Module Term Term Qid Bound Nat OpDeclSet Database -> QidList . op procSearch2 : Module Term Term Condition Qid Bound Nat -> QidList . op procSearch3 : Module Term Term Condition Qid Bound Nat Nat -> QidList . op solveBubblesSearch : Module Module Term Term Qid Bound Nat Bool OpDeclSet Database ~> QidList . op solveBubblesSearch2 : Module Term Term Qid Bound Nat OpDeclSet ~> QidList . op eMetaPrettyPrint : Unit Substitution -> QidList . eq eMetaPrettyPrint(M, V <- T ; Sb:Substitution) = V '<- '\s eMetaPrettyPrint(M, T) if eMetaPrettyPrint(M, Sb:Substitution) == nil then nil else '; eMetaPrettyPrint(M, Sb:Substitution) fi . eq eMetaPrettyPrint(M, (none).Substitution) = nil . op procCommandUp : ModExp Module Term Module OpDeclSet Database -> ResultPair . op procRedUp : ModExp Module Term OpDeclSet Database -> ResultPair . op procRewUp : ModExp Module Term Bound OpDeclSet Database -> ResultPair . op procFrewUp : ModExp Module Term Bound Nat OpDeclSet Database -> ResultPair . *** Processing of commands. eq procCommand('reduce_.['bubble[T]], MN, DB) = procCommand('red_.['bubble[T]], MN, DB) . eq procCommand('red_.['bubble[T]], MN, DB) = if MN inModNameSet builtIns then procRed(MN, DUMMY(MN), 'bubble[T], none, DB) else if compiledUnit(MN, DB) then procRed(MN, getFlatUnit(MN, DB), 'bubble[T], getVbles(MN, DB), DB) else procRed(MN, getFlatUnit(MN, evalModExp(MN, DB)), 'bubble[T], getVbles(MN, evalModExp(MN, DB)), evalModExp(MN, DB)) fi fi . eq procCommand('rewrite_.['bubble[T]], MN, DB) = procCommand('rew_.['bubble[T]], MN, DB) . eq procCommand('rew_.['bubble[T]], MN, DB) = if MN inModNameSet builtIns then procRew(MN, DUMMY(MN), 'bubble[T], unbounded, none, DB) else if compiledUnit(MN, DB) then procRew(MN, getFlatUnit(MN, DB), 'bubble[T], unbounded, getVbles(MN, DB), DB) else procRew(MN, getFlatUnit(MN, evalModExp(MN, DB)), 'bubble[T], unbounded, getVbles(MN, evalModExp(MN, DB)), evalModExp(MN, DB)) fi fi . eq procCommand('frewrite_.['bubble[T]], MN, DB) = procCommand('frew_.['bubble[T]], MN, DB) . eq procCommand('frew_.['bubble[T]], MN, DB) = if MN inModNameSet builtIns then procFrew(MN, DUMMY(MN), 'bubble[T], unbounded, 1, none, DB) else if compiledUnit(MN, DB) then procFrew(MN, getFlatUnit(MN, DB), 'bubble[T], unbounded, 1, getVbles(MN, DB), DB) else procFrew(MN, getFlatUnit(MN, evalModExp(MN, DB)), 'bubble[T], unbounded, 1, getVbles(MN, evalModExp(MN, DB)), evalModExp(MN, DB)) fi fi . eq procCommand('search_=>1_.['bubble[T], 'bubble[T']], MN, DB) = if MN inModNameSet builtIns then procSearch(MN, DUMMY(MN), 'bubble[T], 'bubble[T'], '*, 1, 0, none, DB) else if compiledUnit(MN, DB) then procSearch(MN, getFlatUnit(MN, DB), 'bubble[T], 'bubble[T'], '*, 1, 0, getVbles(MN, DB), DB) else procSearch(MN, getFlatUnit(MN, evalModExp(MN, DB)), 'bubble[T], 'bubble[T'], '*, 1, 0, getVbles(MN, evalModExp(MN, DB)), evalModExp(MN, DB)) fi fi . eq procCommand('search_=>*_.['bubble[T], 'bubble[T']], MN, DB) = if MN inModNameSet builtIns then procSearch(MN, DUMMY(MN), 'bubble[T], 'bubble[T'], '*, unbounded, 0, none, DB) else if compiledUnit(MN, DB) then procSearch(MN, getFlatUnit(MN, DB), 'bubble[T], 'bubble[T'], '*, unbounded, 0, getVbles(MN, DB), DB) else procSearch(MN, getFlatUnit(MN, evalModExp(MN, DB)), 'bubble[T], 'bubble[T'], '*, unbounded, 0, getVbles(MN, evalModExp(MN, DB)), evalModExp(MN, DB)) fi fi . eq procCommand('search_=>+_.['bubble[T], 'bubble[T']], MN, DB) = if MN inModNameSet builtIns then procSearch(MN, DUMMY(MN), 'bubble[T], 'bubble[T'], '+, unbounded, 0, none, DB) else if compiledUnit(MN, DB) then procSearch(MN, getFlatUnit(MN, DB), 'bubble[T], 'bubble[T'], '+, unbounded, 0, getVbles(MN, DB), DB) else procSearch(MN, getFlatUnit(MN, evalModExp(MN, DB)), 'bubble[T], 'bubble[T'], '+, unbounded, 0, getVbles(MN, evalModExp(MN, DB)), evalModExp(MN, DB)) fi fi . eq procCommand('search_=>!_.['bubble[T], 'bubble[T']], MN, DB) = if MN inModNameSet builtIns then procSearch(MN, DUMMY(MN), 'bubble[T], 'bubble[T'], '!, unbounded, 0, none, DB) else if compiledUnit(MN, DB) then procSearch(MN, getFlatUnit(MN, DB), 'bubble[T], 'bubble[T'], '!, unbounded, 0, getVbles(MN, DB), DB) else procSearch(MN, getFlatUnit(MN, evalModExp(MN, DB)), 'bubble[T], 'bubble[T'], '!, unbounded, 0, getVbles(MN, evalModExp(MN, DB)), evalModExp(MN, DB)) fi fi . ceq procCommand('down_:_[T, T'], MN, DB) = if RP:[ResultPair] :: ResultPair then ('\b 'result '\o '\s eMetaPrettyPrint(getType(RP:[ResultPair])) '\s '\b ': '\o '\n '\s '\s eMetaPrettyPrint(M, getTerm(RP:[ResultPair]))) else ('\r 'Error: '\o 'Incorrect 'input. '\n) fi if MN inModNameSet builtIns /\ parseModExp(T) inModNameSet builtIns /\ M := DUMMY(parseModExp(T)) /\ RP:[ResultPair] := procCommandUp(MN, M, T', DUMMY(MN), none, DB) . ceq procCommand('down_:_[T, T'], MN, DB) = if RP:[ResultPair] :: ResultPair then ('\b 'result '\o '\s eMetaPrettyPrint(getType(RP:[ResultPair])) '\s '\b ': '\o '\n '\s '\s eMetaPrettyPrint(M, getTerm(RP:[ResultPair]))) else ('\r 'Error: '\o 'Incorrect 'input. '\n) fi if MN inModNameSet builtIns /\ not parseModExp(T) inModNameSet builtIns /\ DB' := evalModExp(parseModExp(T), DB) /\ M := getFlatUnit(parseModExp(T), DB') /\ RP:[ResultPair] := procCommandUp(MN, M, T', DUMMY(MN), none, DB') . ceq procCommand('down_:_[T, T'], MN, DB) = if RP:[ResultPair] :: ResultPair then ('\b 'result '\o '\s eMetaPrettyPrint(getType(RP:[ResultPair])) '\s '\b ': '\o '\n '\s '\s eMetaPrettyPrint(M, getTerm(RP:[ResultPair]))) else ('\r 'Error: '\o 'Incorrect 'input. '\n) fi if not MN inModNameSet builtIns /\ parseModExp(T) inModNameSet builtIns /\ M := DUMMY(parseModExp(T)) /\ DB' := evalModExp(MN, DB) /\ RP:[ResultPair] := procCommandUp(MN, M, T', getFlatUnit(MN, DB'), getVbles(MN, DB'), DB'). ceq procCommand('down_:_[T, T'], MN, DB) = if RP:[ResultPair] :: ResultPair then ('\b 'result '\o '\s eMetaPrettyPrint(getType(RP:[ResultPair])) '\s '\b ': '\o '\n '\s '\s eMetaPrettyPrint(M, getTerm(RP:[ResultPair]))) else ('\r 'Error: '\o 'Incorrect 'input. '\n) fi if not MN inModNameSet builtIns /\ not parseModExp(T) inModNameSet builtIns /\ DB' := evalModExp(MN, DB) /\ M := getFlatUnit(parseModExp(T), evalModExp(parseModExp(T), DB')) /\ RP:[ResultPair] := procCommandUp(MN, M, T', getFlatUnit(MN, DB'), getVbles(MN, DB'), DB'). eq procCommandUp(MN, M, 'down_:_[T, T'], M', VDS, DB) = metaReduce(M, downTerm( getTerm( procCommandUp(MN, getFlatUnit(parseModExp(T), evalModExp(parseModExp(T), DB)), T', M', VDS, DB)))) . eq procCommandUp(MN, M, 'red_.['bubble[T]], M', VDS, DB) = downResultPair(M, procRedUp(MN, M', 'bubble[T], VDS, DB)) . eq procCommandUp(MN, M, 'reduce_.['bubble[T]], M', VDS, DB) = downResultPair(M, procRedUp(MN, M', 'bubble[T], VDS, DB)) . eq procCommandUp(MN, M, 'rew_.['bubble[T]], M', VDS, DB) = downResultPair(M, procRewUp(MN, M', 'bubble[T], unbounded, VDS, DB)) . eq procCommandUp(MN, M, 'rewrite_.['bubble[T]], M', VDS, DB) = downResultPair(M, procRewUp(MN, M, 'bubble[T], unbounded, VDS, DB)) . ceq procRedUp(MN, M, T, VDS, DB) = if metaReduce(getModule(TM), getTerm(TM)) :: ResultPair then metaReduce(getModule(TM), getTerm(TM)) else error('\r 'Error: '\o 'Incorrect 'command. '\n) fi if B := (protecting 'META-LEVEL . in getImports(M)) or-else (extending 'META-LEVEL . in getImports(M)) or-else (including 'META-LEVEL . in getImports(M)) or-else (protecting 'META-MODULE . in getImports(M)) or-else (extending 'META-MODULE . in getImports(M)) or-else (including 'META-MODULE . in getImports(M)) /\ TM := solveBubblesRed(T, M, B, VDS, DB) . ceq procRewUp(MN, M, T, D, VDS, DB) = if metaRewrite(getModule(TMB), getTerm(TMB), getBound(TMB)) :: ResultPair then metaRewrite(getModule(TMB), getTerm(TMB), getBound(TMB)) else error('\r 'Error: '\o 'Incorrect 'command. '\n) fi if B := (protecting 'META-LEVEL . in getImports(M)) or-else (extending 'META-LEVEL . in getImports(M)) or-else (including 'META-LEVEL . in getImports(M)) or-else (protecting 'META-MODULE . in getImports(M)) or-else (extending 'META-MODULE . in getImports(M)) or-else (including 'META-MODULE . in getImports(M)) /\ TMB := solveBubblesRew(T, M, B, D, VDS, DB) . ceq procFrewUp(MN, M, T, D, I, VDS, DB) = if metaFrewrite( getModule(TMBN), getTerm(TMBN), getBound(TMBN), getNat(TMBN)) :: ResultPair then metaFrewrite( getModule(TMBN), getTerm(TMBN), getBound(TMBN), getNat(TMBN)) else error('\r 'Error: '\o 'Incorrect 'command. '\n) fi if B := (protecting 'META-LEVEL . in getImports(M)) or-else (extending 'META-LEVEL . in getImports(M)) or-else (including 'META-LEVEL . in getImports(M)) or-else (protecting 'META-MODULE . in getImports(M)) or-else (extending 'META-MODULE . in getImports(M)) or-else (including 'META-MODULE . in getImports(M)) /\ TMBN := solveBubblesFrew(T, M, B, D, I, VDS, DB) . ceq procRed(MN, M, T, VDS, DB) = if metaReduce(getModule(TM), getTerm(TM)) :: ResultPair then ('\b 'reduce 'in '\o eMetaPrettyPrint(getName(getModule(TM))) '\b ': '\o '\n '\s '\s eMetaPrettyPrint(getModule(TM), getTerm(TM)) '\n '\b 'result '\o '\s eMetaPrettyPrint(getType(metaReduce(getModule(TM), getTerm(TM)))) '\s '\b ': '\o '\n '\s '\s eMetaPrettyPrint(getModule(TM), getTerm(metaReduce(getModule(TM), getTerm(TM)))) '\n) else ('\r 'Error: '\o 'Incorrect 'command. '\n) fi if B := (protecting 'META-LEVEL . in getImports(M)) or-else (extending 'META-LEVEL . in getImports(M)) or-else (including 'META-LEVEL . in getImports(M)) or-else (protecting 'META-MODULE . in getImports(M)) or-else (extending 'META-MODULE . in getImports(M)) or-else (including 'META-MODULE . in getImports(M)) /\ TM := solveBubblesRed(T, M, B, VDS, DB) . eq procRed(MN, error(QIL), T, VDS, DB) = error(QIL) . eq procRed(MN, noUnit, T, VDS, DB) = getMsg(DB) . ceq solveBubblesRed('bubble[QI], M, B, VDS, DB) = if T? :: Term then {T?, M} else error('\r 'Error: '\o 'no 'parse 'for downQidList(QI) '\n) fi if T? := solveBubbles('bubble[QI], M, B, VDS, DB) . ceq solveBubblesRed('bubble['__[TL]], M, B, VDS, DB) = if T? :: Term then {T?, M} else if metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), 'RedInPart) :: ResultPair then solveBubblesRed2( getTerm( metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), 'RedInPart)), DB) else error('\r 'Warning: '\o printSyntaxError( metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), 'RedInPart), downQidList('__[TL, ''..Qid])) '\n '\r 'Error: '\o 'no 'parse 'for downQidList('__[TL, ''..Qid]) '\n) fi fi if T? := solveBubbles('bubble['__[TL]], M, B, VDS, DB) . *** There is some problem parsing 'in_:_ in solveBubblesRed, but it *** seems to work with the additional '. eq solveBubblesRed2('in_:_.[T, T'], DB) = if parseModExp(T) inModNameSet builtIns then if parseModExp(T) == 'META-MODULE or parseModExp(T) == 'META-LEVEL then {solveBubbles(T', DUMMY(parseModExp(T)), true, none, DB), DUMMY(parseModExp(T))} else {solveBubbles(T', DUMMY(parseModExp(T)), false, none, DB), DUMMY(parseModExp(T))} fi else if unitInDb(parseModExp(T), evalModExp(parseModExp(T), DB)) then solveBubblesRed3(T', getFlatUnit(parseModExp(T), evalModExp(parseModExp(T), DB)), getVbles(parseModExp(T), evalModExp(parseModExp(T), DB)), evalModExp(parseModExp(T), DB)) else error('\r 'Error: '\o 'Module eMetaPrettyPrint(parseModExp(T)) 'not 'in 'database. '\n) fi fi . ceq solveBubblesRed3(T, M, VDS, DB) = {solveBubbles(T, M, B, VDS, DB), M} if B := (protecting 'META-LEVEL . in getImports(M)) or-else (extending 'META-LEVEL . in getImports(M)) or-else (including 'META-LEVEL . in getImports(M)) or-else (protecting 'META-MODULE . in getImports(M)) or-else (extending 'META-MODULE . in getImports(M)) or-else (including 'META-MODULE . in getImports(M)) . op GRAMMAR-RED : -> FModule . eq GRAMMAR-RED = (fmod 'GRAMMAR-RED is including 'QID-LIST . including 'MOD-EXPRS . sorts 'RedInPart . none op 'token : 'Qid -> 'Token [special( (id-hook('Bubble, '1 '1) op-hook('qidSymbol, ', nil, 'Qid)))] . op 'bubble : 'QidList -> 'Bubble [special( (id-hook('Bubble, '1 '-1 '`( '`)) op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList) op-hook('qidSymbol, ', nil, 'Qid)))] . op 'sortToken : 'Qid -> 'SortToken [special( (id-hook('Bubble, '1 '1) op-hook('qidSymbol, ', nil, 'Qid) id-hook('Exclude, '`[ '`] '< 'to ': '`, '. '`( '`) '| 'ditto 'precedence 'prec 'gather 'assoc 'associative 'comm 'commutative 'ctor 'constructor 'id: 'strat 'strategy 'memo 'memoization 'iter 'frozen)))] . op 'neTokenList : 'QidList -> 'NeTokenList [special( (id-hook('Bubble, '1 '-1 '`( '`)) op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList) op-hook('qidSymbol, ', nil, 'Qid) id-hook('Exclude, '.)))] . op 'viewToken : 'Qid -> 'ViewToken [special( (id-hook('Bubble, '1 '1) op-hook('qidSymbol, ', nil, 'Qid)))] . op 'in_:_. : 'ModExp 'Bubble -> 'RedInPart [none] . none none endfm) . ceq procRew(MN, M, T, D, VDS, DB) = if RP :: ResultPair then ('\b 'rewrite 'in '\o eMetaPrettyPrint(getName(getModule(TMB))) '\b ': '\o '\n '\s '\s eMetaPrettyPrint(getModule(TMB), getTerm(TMB)) '\n '\b 'result '\o '\s eMetaPrettyPrint( getType(metaRewrite(getModule(TMB),getTerm(TMB), getBound(TMB)))) '\s '\b ': '\o '\n '\s '\s eMetaPrettyPrint(getModule(TMB), getTerm(RP)) '\n) else ('\r 'Error: '\o 'Incorrect 'command. '\n) fi if B := (protecting 'META-LEVEL . in getImports(M)) or-else (extending 'META-LEVEL . in getImports(M)) or-else (including 'META-LEVEL . in getImports(M)) or-else (protecting 'META-MODULE . in getImports(M)) or-else (extending 'META-MODULE . in getImports(M)) or-else (including 'META-MODULE . in getImports(M)) /\ TMB := solveBubblesRew(T, M, B, D, VDS, DB) /\ RP := metaRewrite(getModule(TMB), getTerm(TMB), getBound(TMB)) . eq procRew(MN, error(QIL), T, D, VDS, DB) = error(QIL) . eq solveBubblesRew('bubble[QI], M, B, D, VDS, DB) = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term then {solveBubbles('bubble[QI], M, B, VDS, DB), M, unbounded} else error('\r 'Error: '\o 'no 'parsing 'for downQidList(QI) '\n) fi . eq solveBubblesRew('bubble['__[TL]], M, B, D, VDS, DB) = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term then {solveBubbles('bubble['__[TL]], M, B, VDS, DB), M, unbounded} else if metaParse(GRAMMAR-REW, downQidList('__[TL, ''..Qid]), 'RewNuPart) :: ResultPair then solveBubblesRew2( getTerm( metaParse(GRAMMAR-REW, downQidList('__[TL, ''..Qid]), 'RewNuPart)), M, B, VDS, DB) else {getTerm(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), getModule(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), unbounded} fi fi . *** There is some problem parsing 'in_:_ in solveBubblesRed, but it *** seems to work with the additional '. eq solveBubblesRew2('`[_`]_.['token[T], T'], M, B, VDS, DB) = if downNat(downMetaNat(T)) :: Nat and-then solveBubblesRed(T', M, B, VDS, DB) :: TermModule then {getTerm(solveBubblesRed(T', M, B, VDS, DB)), getModule(solveBubblesRed(T', M, B, VDS, DB)), downNat(downMetaNat(T))} else error('\r 'Error: '\o 'Incorrect 'command. '\n) fi . op GRAMMAR-REW : -> FModule . eq GRAMMAR-REW = (fmod 'GRAMMAR-REW is including 'QID-LIST . sorts 'Token ; 'Bubble ; 'RewNuPart . none op 'token : 'Qid -> 'Token [special( (id-hook('Bubble, '1 '1) op-hook('qidSymbol, ', nil, 'Qid)))] . op 'bubble : 'QidList -> 'Bubble [special( (id-hook('Bubble, '1 '-1 '`( '`)) op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList) op-hook('qidSymbol, ', nil, 'Qid)))] . op '`[_`]_. : 'Token 'Bubble -> 'RewNuPart [none] . none none endfm) . eq metaRewrite(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T, D) = metaReduce(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T) . eq metaRewrite(M, T, 0) = {T, leastSort(M, T)} . ceq procFrew(MN, M, T, D, I, VDS, DB) = if RP :: ResultPair then ('\b 'frewrite 'in '\o eMetaPrettyPrint(getName(getModule(TMBN))) '\b ': '\o '\n '\s '\s eMetaPrettyPrint(getModule(TMBN), getTerm(TMBN)) '\n '\b 'result '\o '\s eMetaPrettyPrint(getType(RP)) '\s '\b ': '\o '\n '\s '\s eMetaPrettyPrint(getModule(TMBN), getTerm(RP)) '\n) else ('\r 'Error: '\o 'Incorrect 'command. '\n) fi if B := (protecting 'META-LEVEL . in getImports(M)) or-else (extending 'META-LEVEL . in getImports(M)) or-else (including 'META-LEVEL . in getImports(M)) or-else (protecting 'META-MODULE . in getImports(M)) or-else (extending 'META-MODULE . in getImports(M)) or-else (including 'META-MODULE . in getImports(M)) /\ TMBN := solveBubblesFrew(T, M, B, D, I, VDS, DB) /\ RP := metaFrewrite(getModule(TMBN), getTerm(TMBN), getBound(TMBN), getNat(TMBN)) . eq procFrew(MN, error(QIL), T, D, I, VDS, DB) = error(QIL) . eq solveBubblesFrew('bubble[QI], M, B, D, I, VDS, DB) = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term then {solveBubbles('bubble[QI], M, B, VDS, DB), M, unbounded, I} else error('\r 'Error: '\o 'no 'parse 'for downQidList(QI) '\n) fi . eq solveBubblesFrew('bubble['__[TL]], M, B, D, I, VDS, DB) = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term then {solveBubbles('bubble['__[TL]], M, B, VDS, DB), M, unbounded, I} else if metaParse(GRAMMAR-FREW, downQidList('__[TL, ''..Qid]), 'FrewNuPart) :: ResultPair then solveBubblesFrew2( getTerm( metaParse(GRAMMAR-FREW, downQidList('__[TL, ''..Qid]), 'FrewNuPart)), M, B, I, VDS, DB) else {getTerm(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), getModule(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), unbounded, I} fi fi . *** There is some problem parsing 'in_:_ in solveBubblesRed, but it *** seems to work with the additional '. eq solveBubblesFrew2('`[_`]_.['token[T], T'], M, B, I, VDS, DB) = if downNat(downMetaNat(T)) :: Nat and-then solveBubblesRed(T', M, B, VDS, DB) :: TermModule then {getTerm(solveBubblesRed(T', M, B, VDS, DB)), getModule(solveBubblesRed(T', M, B, VDS, DB)), downNat(downMetaNat(T)), I} else error('\r 'Error: '\o 'Incorrect 'command. '\n) fi . eq solveBubblesFrew2('`[_`,_`]_.['token[T], 'token[T'], T''], M, B, I, VDS, DB) = if downNat(downMetaNat(T)) :: Nat and-then downNat(downMetaNat(T')) :: Nat and-then solveBubblesRed(T'', M, B, VDS, DB) :: TermModule then {getTerm(solveBubblesRed(T'', M, B, VDS, DB)), getModule(solveBubblesRed(T'', M, B, VDS, DB)), downNat(downMetaNat(T)), downNat(downMetaNat(T'))} else error('\r 'Error: '\o 'Incorrect 'command. '\n) fi . op GRAMMAR-FREW : -> FModule . eq GRAMMAR-FREW = (fmod 'GRAMMAR-FREW is including 'QID-LIST . sorts 'Token ; 'Bubble ; 'FrewNuPart . none op 'token : 'Qid -> 'Token [special( (id-hook('Bubble, '1 '1) op-hook('qidSymbol, ', nil, 'Qid)))] . op 'bubble : 'QidList -> 'Bubble [special( (id-hook('Bubble, '1 '-1 '`( '`)) op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList) op-hook('qidSymbol, ', nil, 'Qid)))] . op '`[_`]_. : 'Token 'Bubble -> 'FrewNuPart [none] . op '`[_`,_`]_. : 'Token 'Token 'Bubble -> 'FrewNuPart [none] . none none endfm) . eq metaFrewrite(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T, D, I) = metaReduce(fmod QI is IL sorts SS . SSDS OPDS MAS EqS endfm, T) . eq metaFrewrite(M, T, 0, I) = {T, leastSort(M, T)} . eq metaFrewrite(M, T, D, 0) = {T, leastSort(M, T)} . ceq procSearch(MN, M, T, T', QI, D, I, VDS, DB) *** the number I in search is not a bound, but the solution number = if solveBubbles(T, T', M, B, VDS, DB) :: Term then procSearch2(addOps(VDS, M), lhs(solveBubbles(T, T', M, B, VDS, DB)), rhs(solveBubbles(T, T', M, B, VDS, DB)), nil, QI, D, I) else if solveBubblesRew(T, M , B, I, VDS, DB) :: TermModuleBound then solveBubblesSearch( getModule(solveBubblesRew(T, M, B, I, VDS, DB)), addOps( op '_s.t._. : leastSort( getModule(solveBubblesRew(T, M, B, I, VDS, DB)), getTerm(solveBubblesRew(T, M, B, I, VDS, DB))) '@Condition -> 'PatternCondition [none] . op '_such`that_. : leastSort( getModule(solveBubblesRew(T, M, B, I, VDS, DB)), getTerm(solveBubblesRew(T, M, B, I, VDS, DB))) '@Condition -> 'PatternCondition [none] ., addSorts('PatternCondition, addInfoConds(M))), getTerm(solveBubblesRew(T, M, B, I, VDS, DB)), T', QI, getBound(solveBubblesRew(T, M, B, I, VDS, DB)), I, B, VDS, DB) else ('\r 'Error: '\o 'Incorrect 'command. '\n) fi fi if B := (protecting 'META-LEVEL . in getImports(M)) or-else (extending 'META-LEVEL . in getImports(M)) or-else (including 'META-LEVEL . in getImports(M)) . ceq solveBubblesSearch(M, M', T, QI, QI', D, I, B, VDS, DB) = if T?:[Term] :: Term then procSearch2(M, T, T?:[Term], nil, QI', D, I) else ('\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n) fi if T?:[Term] := solveBubbles(QI, M, B, VDS, DB) . ceq solveBubblesSearch(M, M', T, 'bubble['__[TL]], QI, D, I, B, VDS, DB) = if T?:[Term] :: Term then procSearch2(M, T, T?:[Term], nil, QI, D, I) else if metaParse(M', downQidList('__[TL, ''..Qid]), 'PatternCondition) :: ResultPair then solveBubblesSearch2(M, T, getTerm( metaParse(M', downQidList('__[TL, ''..Qid]), 'PatternCondition)), QI, D, I, VDS) else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n fi fi if T?:[Term] := solveBubbles('bubble['__[TL]], M, B, VDS, DB) . --- eq solveBubblesSearch(M, M', T, T', QI, D, D', B, VDS, DB) --- = '\r 'Error: '\o 'Invalid 'arguments 'for 'the 'search 'command. '\n --- [owise] . eq solveBubblesSearch2(M, T, QI, QI', D, I, VDS) = procSearch2(M, T, constsToVbles(QI, VDS), nil, QI', D, I) . eq solveBubblesSearch2(M, T, F[T], QI, D, I, VDS) = procSearch2(M, T, constsToVbles(F[T], VDS), nil, QI, D, I) . eq solveBubblesSearch2(M, T, F[T', T''], QI, D, I, VDS) = if F == '_s.t._. or F == '_such`that_. then procSearch2(M, T, T', parseCond(T'', VDS), QI, D, I) else procSearch2(M, T, constsToVbles(F[T', T''], VDS), nil, QI, D, I) fi . eq solveBubblesSearch2(M, T, F[T', T'', TL], QI, D, I, VDS) = procSearch2(M, T, constsToVbles(F[T', T'', TL], VDS), nil, QI, D, I) . ceq procSearch2(M, T, T', CD, QI, D, I) = if RT :: ResultTriple then ('search 'in eMetaPrettyPrint(getName(M)) ': eMetaPrettyPrint(M, T) '\s qid("=>" + string(QI)) '\s eMetaPrettyPrint(M, T') '. '\n '\n 'Solution '1 if getSubstitution(RT) == none then '\n 'empty 'substitution else '\n eMetaPrettyPrint(M, getSubstitution(RT)) fi procSearch3(M, T, T', CD, QI, D, 1, I)) else if RT == failure then ('search 'in eMetaPrettyPrint(getName(M)) ': eMetaPrettyPrint(M, T) '\s qid("=>" + string(QI)) '\s eMetaPrettyPrint(M, T') '. '\n '\n 'No 'solution. '\n) else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n fi fi if RT := metaSearch(M, T, T', CD, QI, D, 0) . eq procSearch3(M, T, T', CD, QI, D, I, J) = if J == 0 or I < J then if metaSearch(M, T, T', CD, QI, D, I) :: ResultTriple then ('\n '\n 'Solution qid(string(I + 1, 10)) if getSubstitution(metaSearch(M, T, T', CD, QI, D, I)) == none then '\n 'empty 'substitution else '\n eMetaPrettyPrint(M, getSubstitution( metaSearch(M, T, T', CD, QI, D, I))) fi procSearch3(M, T, T', CD, QI, D, I + 1, J)) else ('\n '\n 'No 'more 'solutions.) fi else nil fi . endfm ******************************************************************************* *** *** Interaction with the Persistent Database *** *** In the case of Full Maude, the persistent state of the system is given by *** a single object which maintains the database of the system. This object *** has an attribute \texttt{db}, to keep the actual database in which all the *** modules being entered are stored, an attribute \texttt{default}, to keep *** the identifier of the current module by default, and attributes *** \texttt{input} and \texttt{output} to simplify the communication of the *** read-eval-print loop given by the \texttt{LOOP-MODE} module with the *** database. Using the notation for classes in object-oriented modules (see *** Section~\ref{object-oriented-modules}) we can declare the class *** \texttt{database} as follows: *** *** class database | db : Database, input : TermList, *** output : QidList, default : ModId . *** *** Since we assume that \texttt{database} is the only object class that has *** been defined---so that the only objects of sort \texttt{Object} will *** belong to the \texttt{database} class---to specify the admissible states *** in the persistent state of \texttt{LOOP-MODE} for Full Maude, it is enough *** to give the subsort declaration *** *** subsort Object < State . *** *** \subsection{The \texttt{CONFIGURATION+} Module} *** *** change (2/20/2002): CONFIGURATION is now part of the prelude *** *** fmod CONFIGURATION is *** sort Oid Cid Attribute AttributeSet Configuration Object Msg . *** *** subsort Attribute < AttributeSet . *** subsorts Object Msg < Configuration . *** *** op none : -> AttributeSet . *** op _,_ : AttributeSet AttributeSet -> AttributeSet *** [assoc comm id: none] . *** op none : -> Configuration . *** op __ : Configuration Configuration -> Configuration *** [assoc comm id: none] . *** op <_:_|_> : Oid Cid AttributeSet -> Object . *** op <_:_| > : Oid Cid -> Object . *** *** var O : Oid . *** var C : Cid . *** *** eq < O : C | > = < O : C | none > . *** endfm ******************************************************************************* *** *** Top Level Handling of the Persistent Database *** *** Note that, since the Full Maude specification is given as a system module *** in Core Maude, object-oriented declarations cannot be given directly. *** Instead, the equivalent declarations desugaring the desired *** object-oriented declarations have to be specified. We use also the same *** conventions discussed in Section~\ref{omod2mod} regarding the use of *** variables instead of class names in the objects and in the addition of *** variables of sort \texttt{AttributeSet} to range over the additional *** attributes. As we shall see in Chapter~\ref{crc}, this convention will *** allow us to extend the Full Maude system in a very simple and clean way. *** To allow the use of the object-oriented notation the predefined module *** \texttt{CONFIGURATION}, presented in Section~\ref{omod2mod}, is included *** in the following module \texttt{DATABASE-HANDLING}. mod DATABASE-HANDLING is inc META-LEVEL . inc CONFIGURATION . pr VIEW-META-PRETTY-PRINT . pr VIEW-PROCESSING . pr COMMAND-PROCESSING . var F : Qid . var QIL : QidList . vars T T' T'' T''' : Term . var TL : TermList . var DB DB' : Database . var MN : ModName . var ME : ModExp . vars QIL' QIL'' : QidList . var MNS : ModNameSet . var VE : ViewExp . var VES : ViewExpSet . var IS : InfoSet . *** We start introducing a subsort \texttt{DatabaseClass} of sort *** \texttt{Cid}, the operator declarations necessary for representing objects *** in class \texttt{DatabaseClass} as defined above, and variables to range *** over subclasses of class \texttt{DatabaseClass} and over attributes. sort DatabaseClass . subsort DatabaseClass < Cid . op Database : -> DatabaseClass . op db :_ : Database -> Attribute . op input :_ : TermList -> Attribute . op output :_ : QidList -> Attribute . op default :_ : ModName -> Attribute . var Atts : AttributeSet . var X@Database : DatabaseClass . var O : Oid . *** Next, we introduce an auxiliary function \texttt{parseModName} to parse *** names of user-defined modules, and a constant \texttt{nilTermList} of sort *** \texttt{TermList}. Note that the name of a user-defined module must be a *** single identifier (a token) or, for parameterized modules, its name---a *** single identifier---and its interface. op parseModName : Term -> Qid . eq parseModName('token[T]) = downQid(T) . eq parseModName('_`(_`)['token[T], T']) = downQid(T) . op nilTermList : -> TermList . eq (nilTermList, TL) = TL . eq (TL, nilTermList) = TL . *** Finally, we present the rules processing the inputs of the database. These *** rules define the behavior of the system for the different commands, *** modules, theories, and views entered into the system. For example, the *** first rule processes the different types of modules entered to the system. *** Note that the operators declared as constructors of sort \texttt{PreUnit} *** in the signature of Full Maude, given in *** Appendix~\ref{signature-full-maude}, are declared with two arguments, *** namely the name of the unit, or its name plus its interface, and the list *** of declarations of such a unit. crl [module] : < O : X@Database | db : DB, input : (F[T, T']), output : nil, default : MN, Atts > => < O : X@Database | db : procUnit(F[T, T'], DB), input : nilTermList, output : ('Introduced 'module modNameToQid(parseModName(T)) '\n), default : parseModName(T), Atts > if (F == 'fmod_is_endfm) or-else ((F == 'obj_is_endo) or-else ((F == 'obj_is_jbo) or-else ((F == 'mod_is_endm) or-else (F == 'omod_is_endom)))) . *** Notice the message placed in the output channel, and the change in the *** current module by default, which is now the new module just processed. *** Since the name of the module \texttt{T} can be complex---a parameterized *** module---some extra parsing has to be performed by the auxiliary function *** \texttt{parseModName}. Similar rules are given for the processing of *** theories and views. crl [theory] : < O : X@Database | db : DB, input : (F[T, T']), output : nil, default : MN, Atts > => < O : X@Database | db : procUnit(F[T, T'], DB), input : nilTermList, output : ('Introduced 'theory modNameToQid(parseModName(T)) '\n), default : parseModName(T), Atts > if (F == 'fth_is_endfth) or-else ((F == 'th_is_endth) or-else (F == 'oth_is_endoth)) . rl [view] : < O : X@Database | db : DB, input : ('view_from_to_is_endv[T, T', T'', T''']), output : nil, default : MN, Atts > => < O : X@Database | db : procView('view_from_to_is_endv[T, T', T'', T'''], DB), input : nilTermList, output : ('Introduced 'view modNameToQid(parseModName(T)) '\n), default : MN, Atts > . *** Commands are handled by rules as well. For example, the \texttt{down}, *** \texttt{reduce}, and \texttt{rewrite} commands are handled by the *** following rules. rl [down] : < O : X@Database | db : DB, input : ('down_:_[T, T']), output : nil, default : MN, Atts > => < O : X@Database | db : DB, input : nilTermList, output : procCommand('down_:_[T, T'], MN, DB), default : MN, Atts > . crl [red/rew/frew] : < O : X@Database | db : DB, input : (F[T]), output : QIL, default : MN, Atts > => < O : X@Database | db : DB, input : nilTermList, output : procCommand(F[T], MN, DB), default : MN, Atts > if (F == 'red_.) or-else ((F == 'reduce_.) or-else ((F == 'rew_.) or-else ((F == 'rewrite_.) or-else ((F == 'frew_.) or-else (F == 'frewrite_.))))) . crl [search] : < O : X@Database | db : DB, input : (F[T, T']), output : QIL, default : MN, Atts > => < O : X@Database | db : DB, input : nilTermList, output : procCommand(F[T, T'], MN, DB), default : MN, Atts > if (F == 'search_=>_.) or-else ((F == 'search_=>*_.) or-else ((F == 'search_=>+_.) or-else (F == 'search_=>!_.))) . rl [select] : < O : X@Database | db : DB, input : ('select_.[T]), output : nil, default : MN, Atts > => < O : X@Database | db : DB, input : nilTermList, output : nil, default : parseModExp(T), Atts > . rl [show-modules] : < O : X@Database | db : DB, input : ('show`modules`..Command), output : nil, default : MN, Atts > => < O : X@Database | db : DB, input : nilTermList, output : showUnits(DB), default : MN, Atts > . rl [show-views] : < O : X@Database | db : DB, input : ('show`views`..Command), output : nil, default : MN, Atts > => < O : X@Database | db : DB, input : nilTermList, output : showViews(DB), default : MN, Atts > . *** The \texttt{show module} command, which prints the specified module, or *** the current one if no module name is specified, is handled by the *** following rules. crl [show-module] : < O : X@Database | db : DB, input : ('show`module`..Command), output : nil, default : MN, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatUnit(MN, DB'), getTopUnit(MN, DB')), default : MN, Atts > if DB' := evalModExp(MN, DB) . crl [show-module] : < O : X@Database | db : DB, input : ('show`module_.[T]), output : nil, default : MN, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatUnit(ME, DB'), getTopUnit(ME, DB')), default : MN, Atts > if ME := parseModExp(T) /\ DB' := evalModExp(ME, DB) . crl [show-all] : < O : X@Database | db : DB, input : ('show`all`..Command), output : nil, default : MN, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatUnit(MN, DB'),getFlatUnit(MN, DB')), default : MN, Atts > if DB' := evalModExp(MN, DB) . crl [show-all] : < O : X@Database | db : DB, input : ('show`all_.[T]), output : nil, default : MN, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatUnit(ME, DB'),getFlatUnit(ME, DB')), default : MN, Atts > if ME := parseModExp(T) /\ DB' := evalModExp(ME, DB) . crl [show-sorts] : < O : X@Database | db : DB, input : ('show`sorts`..Command), output : nil, default : MN, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getSorts(getFlatUnit(MN, DB'))), default : MN, Atts > if DB' := evalModExp(MN, DB) . crl [show-sorts] : < O : X@Database | db : DB, input : ('show`sorts_.[T]), output : nil, default : MN, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getSorts(getFlatUnit(ME, DB'))), default : MN, Atts > if ME := parseModExp(T) /\ DB' := evalModExp(ME, DB) . crl [show-ops] : < O : X@Database | db : DB, input : ('show`ops`..Command), output : nil, default : MN, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatUnit(MN, DB'), getOps(getFlatUnit(MN, DB'))), default : MN, Atts > if DB' := evalModExp(MN, DB) . crl [show-ops] : < O : X@Database | db : DB, input : ('show`ops_.[T]), output : nil, default : MN, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatUnit(ME, DB'), getOps(getFlatUnit(ME, DB'))), default : MN, Atts > if ME := parseModExp(T) /\ DB' := evalModExp(ME, DB) . crl [show-mbs] : < O : X@Database | db : DB, input : ('show`mbs`..Command), output : nil, default : MN, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatUnit(MN, DB'), getMbs(getFlatUnit(MN, DB'))), default : MN, Atts > if DB' := evalModExp(MN, DB) . crl [show-mbs] : < O : X@Database | db : DB, input : ('show`mbs_.[T]), output : nil, default : MN, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatUnit(ME, DB'), getMbs(getFlatUnit(ME, DB'))), default : MN, Atts > if ME := parseModExp(T) /\ DB' := evalModExp(ME, DB) . crl [show-eqns] : < O : X@Database | db : DB, input : ('show`eqns`..Command), output : nil, default : MN, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatUnit(MN, DB'), getEqs(getFlatUnit(MN, DB'))), default : MN, Atts > if DB' := evalModExp(MN, DB) . crl [show-eqns] : < O : X@Database | db : DB, input : ('show`eqns_.[T]), output : nil, default : MN, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatUnit(ME, DB'), getEqs(getFlatUnit(ME, DB'))), default : MN, Atts > if ME := parseModExp(T) /\ DB' := evalModExp(ME, DB) . crl [show-rls] : < O : X@Database | db : DB, input : ('show`rls`..Command), output : nil, default : MN, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatUnit(MN, DB'), getRls(getFlatUnit(MN, DB'))), default : MN, Atts > if DB' := evalModExp(MN, DB) . crl [show-rls] : < O : X@Database | db : DB, input : ('show`rls_.[T]), output : nil, default : MN, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatUnit(ME, DB'), getRls(getFlatUnit(ME, DB'))), default : MN, Atts > if ME := parseModExp(T) /\ DB' := evalModExp(ME, DB) . crl [show-view] : < O : X@Database | db : DB, input : ('show`view_.[T]), output : nil, default : MN, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(DB', getView(parseViewExp(T), DB')), default : MN, Atts > if DB' := evalViewExp(parseViewExp(T), nilParList, DB) . crl [error] : < O : X@Database | db : db(IS, MNS, VES, QIL), input : TL, output : nil, default : MN, Atts > => < O : X@Database | db : db(IS, MNS, VES, nil), input : TL, output : QIL, default : MN, Atts > if QIL =/= nil . *** Auxiliary Functions op showViews : Database -> QidList . op showUnits : Database -> QidList . eq showViews(db(IS, MNS, (VE # VES), QIL)) = (eMetaPrettyPrint(VE) '\n showViews(db(IS, MNS, VES, QIL))) . eq showViews(db(IS, MNS, noneViewExpSet, QIL)) = nil . eq showUnits(db(IS, (MN . MNS), VES, QIL)) = (eMetaPrettyPrint(MN) '\n showUnits(db(IS, MNS, VES, QIL))) . eq showUnits(db(IS, noneModNameSet, VES, QIL)) = nil . endm ******************************************************************************* *** *** The Full Maude Module *** *** We now give the rules to initialize the loop, and to specify the *** communication between the loop---the input/output of the system---and the *** database. Depending on the kind of input that the database receives, its *** state will be changed, or some output will be generated. mod FULL-MAUDE is pr META-FULL-MAUDE-SIGN . pr DATABASE-HANDLING . pr PREDEF-UNITS . inc LOOP-MODE . *** The state of the persistent system, which is supported by the built-in *** module \texttt{LOOP-MODE}, described in Section~\ref{loop}, is represented *** as a single object. subsort Object < State . op o : -> Oid . op init : -> System . var Atts : AttributeSet . var X@Database : DatabaseClass . var O : Oid . var DB : Database . var MN : ModName . vars QIL QIL' QIL'' : QidList . var TL : TermList . var N : Nat . vars RP RP' : ResultPair . *** The rule specifying the initial value of the loop is given below. We *** initialize the database with the predefined modules introduced in *** Section~\ref{non-built-in-predefined}. rl [init] : init => [nil, < o : Database | db : insertTermUnit('CONFIGURATION+, CONFIGURATION+, insertTermUnit('TRIV, TRIV, procUnit('UP, insertTermUnit('UP, UP, emptyDatabase)))), input : nilTermList, output : nil, default : 'CONVERSION >, ('\n '\t '\s '\s '\s '\s '\s 'Full 'Maude '2.0.1-9 '\s '`( 'March '2nd '`, '\s '2004 '`) '\n)] . *** When some text has been introduced in the loop, the first argument of the *** operator \verb~[_,_,_,]~ is different from \texttt{nil}, and we can use *** this fact to activate the following rule, that enters an input such as a *** module or a command from the user into the database. The constant *** \texttt{GRAMMAR} names the module containing the signature defining the *** top level syntax of Full Maude (see Section~\ref{sec:signature} and *** Appendix~\ref{signature-full-maude}). This signature is used by the *** \texttt{metaParse} function to parse the input. If the input is *** syntactically valid\footnote{Of course, the input may be syntactically *** valid, but not semantically valid, since further processing---for example, *** of bubbles---may reveal a semantic inconsistency.}, the parsed input is *** placed in the \texttt{input} attribute of the database object; otherwise, *** an error message is placed in the output channel of the loop. crl [in] : [QIL, < O : X@Database | db : DB, input : nilTermList, output : nil, default : MN, Atts >, QIL'] => [nil, < O : X@Database | db : DB, input : getTerm(metaParse(GRAMMAR, QIL, 'Input)), output : nil, default : MN, Atts >, QIL'] if QIL =/= nil /\ metaParse(GRAMMAR, QIL, 'Input) : ResultPair . crl [in] : [QIL, < O : X@Database | db : DB, input : nilTermList, output : nil, default : MN, Atts >, QIL'] => [nil, < O : X@Database | db : DB, input : nilTermList, output : ('\r 'Warning: printSyntaxError(metaParse(GRAMMAR, QIL, 'Input), QIL) '\n '\r 'Error: '\o 'No 'parse 'for 'input. '\n), default : MN, Atts >, QIL'] if QIL =/= nil /\ not metaParse(GRAMMAR, QIL, 'Input) :: ResultPair . *** When the \texttt{output} attribute of the persistent object contains a *** nonempty list of quoted identifiers, the \texttt{out} rule moves it to the *** third argument of the loop. Then the Core Maude system displays it in the *** terminal. crl [out] : [QIL, < O : X@Database | db : DB, input : TL, output : QIL', default : MN, Atts >, QIL''] => [QIL, < O : X@Database | db : DB, input : TL, output : nil, default : MN, Atts >, (QIL' QIL'')] if QIL' =/= nil . endm ******************************************************************************* loop init . ---trace exclude FULL-MAUDE . set show loop stats on . set show loop timing on .