***( Real-Time Maude 2.2 interpreter extension of Full Maude 2.2. Real-Time Maude built by Peter Olveczky on top of Full Maude built by Francisco Duran. This file just modifies the file full-maude.maude from December 1, 2005 Copyright 1997-2005 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. )*** ***( Main changes from Real-Time Maude 2.1 to the current Real-Time Maude 2.2: 1. Adapted to Maude version 2.2 and to Full Maude version 2.2. 2. As before, variables occurring in the conditions on the patterns in timed and untimed search, find latest/earliest, and check commands should be given explicitly of the form "VAR:SORT". 3. The comparison operators >, >=, <, <= are extended to the sort TimeInf in the predefined modules NAT-TIME-DOMAIN-WITH-INF and POSRAT-TIME-DOMAIN-WITH-INF, so that numbers can be compared also with the infinity value INF using these comparison operators. Furthermore, the built-in _+_ is extended to TimeInf in the predefined time domains. 4. The "abstract" versions of maximal and minimal operators on linear time are now "maximum" and "minimum". This is because "max" and "min" are now built-in in Maude's NAT and RAT modules. Of course, the user can use "max" and "min" in concrete instances, since their built-in version are extended also to INF. 5. The sort 'PosRat' in Real-Time Maude 2.1 used to refer to the non-negative rational numbers. However, in Maude 2.2 this became a built-in sort, but for the non-zero positive rationals. Therefore, I needed to introduce a sort 'NNegRat' for what USED to be 'PosRat'. Needless to say, the sort 'NzPosRat' has been omitted, and is now just the new 'PosRat'. Note that since this is a crucial sort, one may want to check specifications to make sure this is right. 6. In Full Maude searches for OO systems, a match will NOT be found if you search for an object of class C, but where an object of a subclass D of C otherwise the search criteria. Furthermore, the pattern in a Full Maude search must mention ALL attributes in a class to get a match. The current version of Real-Time Maude fixes these inconveniences. )*** ***( Bug fix w.r.t. Full Maude: 1. In Full Maude, the use of classes with no attributes leads to nontermination when trying to reduce or rewrite an object with no attributes. That is fixed in Real-Time Maude. )*** ***( Content: 1. The "timed prelude" which contains the various abstract and concrete specifications of the time domain, of support for objects, the timed extension of the model checker, etc. The module TIMED-PRELUDE is automatically imported by all timed modules, and TIMED-OO-PRELUDE is automatically imported by all timed object-oriented modules. The rest of the modules can be imported by any RTM module. 2. Most of the Maude specification of Full Maude version 2.2 from December 1, 2005. This specification is modified for RTM and shortened by removing the final module "FULL-MAUDE". 3. The Real-Time Maude extension of Full Maude. Includes the syntax of Real-Time Maude modules, command handling, and data types and strategies needed to execute timed modules. )*** load model-checker --- to be removed when in combo! --- ------------------------------------------------------------- --- ------------------------------------------------------------- --- Real-Time Maude Part 1: The timed prelude --- ------------------------------------------------------------- --- ------------------------------------------------------------- ---( Weird parts, changes, etc, in the prelude: * Due to crash with 'min' and 'max' in NAT in prelude.maude, we must change the function 'min' to minimum' and 'max' to 'maximum' in LTIME and modules importing them. Nevertheless, in NAT-...-INF and POSRAT-...-INF, we also extend the built-in 'min' and 'max' to INF! * In Maude 2.2, the built-in sort 'PosRat' is the positive rationals NOT including 0! This contradicts the Real-Time Maude 2.1 sort 'PosRat' with also included zero. What USED to be 'NzPosRat' in Real-Time Maude 2.1 now becomes 'PosRat'. The OLD 'PosRat' now becomes 'NNegRat' ... )--- fmod TIME is sorts Time NzTime . subsort NzTime < Time . op zero : -> Time . op _plus_ : Time Time -> Time [assoc comm prec 33 gather (E e)] . op _monus_ : Time Time -> Time [prec 33 gather (E e)] . op _le_ : Time Time -> Bool [prec 37] . op _lt_ : Time Time -> Bool [prec 37] . op _ge_ : Time Time -> Bool [prec 37] . op _gt_ : Time Time -> Bool [prec 37] . eq zero plus R:Time = R:Time . eq R:Time le R':Time = (R:Time lt R':Time) or (R:Time == R':Time) . eq R:Time ge R':Time = R':Time le R:Time . eq R:Time gt R':Time = R':Time lt R:Time . endfm fmod TIMED-PRELUDE is including TIME . sorts System GlobalSystem ClockedSystem . subsort GlobalSystem < ClockedSystem . op {_} : System -> GlobalSystem [format (g o g so)] . op _in time_ : GlobalSystem Time -> ClockedSystem [format (o g g y o)] . eq (CLS:ClockedSystem in time R:Time) in time R':Time = CLS:ClockedSystem in time (R:Time plus R':Time) . endfm *** Module TIME-INF: fmod TIME-INF is including TIME . sort TimeInf . subsort Time < TimeInf . op INF : -> TimeInf . op _plus_ : TimeInf TimeInf -> TimeInf [ditto] . op _monus_ : TimeInf Time -> TimeInf [ditto] . op _le_ : TimeInf TimeInf -> Bool [prec 37] . op _lt_ : TimeInf TimeInf -> Bool [prec 37] . op _ge_ : TimeInf TimeInf -> Bool [prec 37] . op _gt_ : TimeInf TimeInf -> Bool [prec 37] . var TI TI' : TimeInf . var R : Time . eq INF plus TI = INF . eq INF monus R = INF . eq TI le INF = true . eq INF le R = false . eq INF lt TI = false . eq R lt INF = true . eq TI gt TI' = TI' lt TI . eq TI ge TI' = TI' le TI . endfm *** Now for linear time ... fmod LTIME is including TIME . ops minimum maximum : Time Time -> Time [assoc comm] . vars R R' : Time . ceq maximum(R, R') = R if R' le R . ceq minimum(R, R') = R' if R' le R . endfm *** Linear time with infinity value: fmod LTIME-INF is including LTIME . including TIME-INF . ops minimum maximum : TimeInf TimeInf -> TimeInf [ditto] . eq maximum(INF, TI:TimeInf) = INF . eq minimum(INF, TI:TimeInf) = TI:TimeInf . endfm *** Discrete time domain, the natural numbers ... fmod NAT-TIME-DOMAIN is inc LTIME . protecting NAT . subsort Nat < Time . subsort NzNat < NzTime . vars N N' : Nat . eq zero = 0 . eq N plus N' = N + N' . eq N monus N' = if N > N' then sd(N, N') else 0 fi . eq N lt N' = N < N' . endfm fmod NAT-TIME-DOMAIN-WITH-INF is protecting NAT-TIME-DOMAIN . including LTIME-INF . --- should for simplicity extend <, >=, etc., AND _+_ to infinity: op _<_ : TimeInf TimeInf -> Bool [ditto] . op _<=_ : TimeInf TimeInf -> Bool [ditto] . op _>_ : TimeInf TimeInf -> Bool [ditto] . op _>=_ : TimeInf TimeInf -> Bool [ditto] . op _+_ : TimeInf TimeInf -> TimeInf [ditto] . var N : Nat . var TI : TimeInf . eq INF < TI = false . eq N < INF = true . eq TI <= INF = true . eq INF <= N = false . eq INF >= TI = true . eq N >= INF = false . eq TI > INF = false . eq INF > N = true . eq INF + TI = INF . --- NEW: must also extend the built-in 'min' and'max' to TimeInf: ops min max : TimeInf TimeInf -> TimeInf [ditto] . eq max(INF, TI:TimeInf) = INF . eq min(INF, TI:TimeInf) = TI:TimeInf . endfm --- changed! *** -------------------------- fmod POSITIVE-RAT is protecting RAT . sort NNegRat . --- non-negative rationals! subsorts Zero PosRat Nat < NNegRat < Rat . endfm fmod POSRAT-TIME-DOMAIN is inc LTIME . protecting POSITIVE-RAT . subsort NNegRat < Time . subsort PosRat < NzTime . vars R R' : NNegRat . eq zero = 0 . eq R plus R' = R + R' . eq R monus R' = if R > R' then R - R' else 0 fi . eq R lt R' = R < R' . endfm fmod POSRAT-TIME-DOMAIN-WITH-INF is protecting POSRAT-TIME-DOMAIN . including LTIME-INF . --- again, we should extend the comparison operators to infinity: op _<_ : TimeInf TimeInf -> Bool [ditto] . op _<=_ : TimeInf TimeInf -> Bool [ditto] . op _>_ : TimeInf TimeInf -> Bool [ditto] . op _>=_ : TimeInf TimeInf -> Bool [ditto] . op _+_ : TimeInf TimeInf -> TimeInf [ditto] . op _+_ : NNegRat NNegRat -> NNegRat [ditto] . var R : NNegRat . var TI : TimeInf . eq INF < TI = false . eq R < INF = true . eq TI <= INF = true . eq INF <= R = false . eq INF >= TI = true . eq R >= INF = false . eq TI > INF = false . eq INF > R = true . eq INF + TI = INF . --- NEW: must also extend the built-in 'min' and'max' to TimeInf: ops min max : TimeInf TimeInf -> TimeInf [ditto] . eq max(INF, TI:TimeInf) = INF . eq min(INF, TI:TimeInf) = TI:TimeInf . --- Some additional declarations for preregularity: ops min max : NNegRat NNegRat -> NNegRat [ditto] . ops min max : Zero Zero -> Zero [ditto] . op min : Zero NzNat -> Zero [ditto] . op max : Zero NzNat -> NzNat [ditto] . op max : Rat TimeInf -> TimeInf [ditto] . op max : Rat NNegRat -> NNegRat [ditto] . endfm *** ****************************************** *** Object-oriented prelude ... *** ****************************************** mod TIMED-OO-PRELUDE is including CONFIGURATION . including TIMED-PRELUDE . sorts EmptyConfiguration NEConfiguration MsgConfiguration NEMsgConfiguration ObjectConfiguration NEObjectConfiguration . subsorts EmptyConfiguration < MsgConfiguration ObjectConfiguration < Configuration . subsorts Msg < NEMsgConfiguration < MsgConfiguration NEConfiguration . subsorts Object < NEObjectConfiguration < ObjectConfiguration NEConfiguration . subsort NEConfiguration < Configuration . subsort Configuration < System . --- op none : -> EmptyConfiguration . --- crashes w/ none for Configuration op __ : EmptyConfiguration EmptyConfiguration -> EmptyConfiguration [ditto] . op __ : NEConfiguration NEConfiguration -> NEConfiguration [ditto] . op __ : MsgConfiguration MsgConfiguration -> MsgConfiguration [ditto] . op __ : NEMsgConfiguration NEMsgConfiguration -> NEMsgConfiguration [ditto] . op __ : ObjectConfiguration ObjectConfiguration -> ObjectConfiguration [ditto] . op __ : NEObjectConfiguration NEObjectConfiguration -> NEObjectConfiguration [ditto] . endm *** ****************************************** *** Timed model checker *** ****************************************** fmod TIMED-MODEL-CHECKER is including TIMED-PRELUDE . including MODEL-CHECKER . subsort ClockedSystem < State . endfm --- -------------------------------------------------------------------- --- -------------------------------------------------------------- --- The following part is all of Duran's Full Maude code, with the --- slight bug fix, and the final module "FULL-MAUDE" removed: --- -------------------------------------------------------------- ---- restore conditions for evalModule ---- restore conditions for evalPreModule ---- restore conditions for procModule3 ---- Full Maude specification version 2.1.2l ---- To be run on Maude Alpha86e fmod BANNER is pr STRING . op banner : -> String . eq banner = "Full Maude 2.2 (December 1st, 2005)" . endfm ---- last modification: December 1st, 2005 ---- 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 inclof the License, or (at your option) any later veq resersion. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNSS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public Leicense along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. ) ---- to do: ---- - continue . ---- - show search path . ---- - show path labels . ---- - show components . ---- - (alpha85a) Operator declarations may now take the metadata attribute ---- that was previously reserved for mbs/eqs/rls. ---- Last changes: ---- ---- - All sorts declared in modules used for parsing have been renamed. ---- Any sort S in one of these modules is nos called @S@. ---- Since some of these modules where added to the user defined modules ---- for dealing with ups, conditions, etc., he was getting error when ---- using sorts like Token or OpDecl in his specs. ---- ---- - Syntax for parameterization has been changed (again) !!! : ---- - module definition: FOO{X :: TRIV, Y :: TRIV} ---- - module instantiation: FOO{Bar,Baz} ---- - parameterized sorts: Foo{Bar,Baz} ---- ---- - Any module loaded in Core Maude can be used in Full Maude. ---- This may be particularly useful in the case of using the model checker. ---- ---- (mod CHECK-RESP is ---- protecting MODEL-CHECKER . ---- ... ---- endm) ---- ---- (red p(0) |= (<> Qstate) .) ---- ---- - Module renaming and summation consistent with Core Maude's. Built-ins ---- are now handled at the metalevel, instead of leaving the inclusions to ---- Core Maude. In this way, they can be renamed and redefined, as in ---- Core Maude. This makes Full Maude slower. ---- ---- - The lazy evaluation of modules is working. When a module is redefined ---- its dependent modules are removed only if generated internally. Those ---- introduced by the user save their term representation, from which the ---- whole processing can take place. They will be recompiled by need. ---- ---- - The form of qualifying sorts coming from the parameters in ---- parameterized modules has changed AGAIN: The sort Elt coming from ---- X :: TRIV is now written as X$Elt (Note that sort names cannot contain ---- dots anymore). ---- ---- - Tuples are built with the syntax ---- TUPLE[size]{comma_separated_list_of_views} ---- For example, given a view Nat from TRIV to NAT we can define pairs of ---- nats with TUPLE[2]{Nat, Nat}. ---- ---- - The model-checker is loaded before the full maude modules, so that ---- it can be used. ---- ---- - Object-oriented modules include a module CONFIGURATION+, which ---- imports CONFIGURATION, defines a function ---- op class : Object -> Cid . ---- returning the actual class of the given object, and add syntax ---- for objects with no attributes <_:_| >. Classes without attributes ---- are defined with syntax class CLASS-NAME . ---- ---- Things to come: ---- ---- - Commands missing: continue ... ---- ---- - On parameterized theories and views: linked parameters, composed and ---- lifted views, and default views. ---- ---- - ops names in op declarations ---- ---- known bugs: ---- ---- - error messages could be given in down commands ---- ---- - Check: perhaps we need to convert constants back into vbles in ---- procViewAux ---- ---- - Parameterized sorts don't work in sort constraints (nor by themselves, ---- nor in the conditions of axioms. They are accepted in their equivalent ---- single token form but do not get instantiated ---- cmb (A, B) S : PFun(X, Y) if not(A in dom(S)) /\ S : PFun`(X`,Y`) . ---- ----load model-checker.maude ------------------------------------------------------------------------------- ******************************************************************************* *** *** 2 The Signature of Full Maude *** ******************************************************************************* ------------------------------------------------------------------------------- fmod EXTENDED-SORTS is ---- Any modification in this module must be reflected in the metamodule ---- used in eq addInfoConds in module UNIT-BUBBLE-PARSING sorts @SortToken@ @ViewToken@ @Sort@ @Kind@ @Type@ @SortList@ @TypeList@ @ViewExp@ @ModExp@ . subsorts @SortToken@ < @Sort@ < @SortList@ < @TypeList@ . subsorts @Sort@ @Kind@ < @Type@ < @TypeList@ . subsort @ViewToken@ < @ViewExp@ . op _`{_`} : @Sort@ @ViewExp@ -> @Sort@ [prec 40] . op __ : @SortList@ @SortList@ -> @SortList@ [assoc] . op __ : @TypeList@ @TypeList@ -> @TypeList@ [assoc] . op `[_`] : @Sort@ -> @Kind@ . op _`,_ : @ViewExp@ @ViewExp@ -> @ViewExp@ [assoc] . op _`{_`} : @ViewExp@ @ViewExp@ -> @ViewExp@ [prec 40] . endfm ------------------------------------------------------------------------------- ****************************************************************************** ------------------------------------------------------------------------------- fmod OPERATOR-ATTRIBUTES is sorts @Attr@ @AttrList@ @Hook@ @HookList@ @Bubble@ @Token@ @NeTokenList@ . subsort @Attr@ < @AttrList@ . subsort @Hook@ < @HookList@ . op __ : @AttrList@ @AttrList@ -> @AttrList@ [assoc] . ops assoc associative : -> @Attr@ . ops comm commutative : -> @Attr@ . ops idem idempotent : -> @Attr@ . ops id:_ identity:_ : @Bubble@ -> @Attr@ . ops left`id:_ left`identity:_ : @Bubble@ -> @Attr@ . ops right`id:_ right`identity:_ : @Bubble@ -> @Attr@ . ops frozen`(_`) poly`(_`) strat`(_`) strategy`(_`) : @NeTokenList@ -> @AttrList@ . ops memo memoization : -> @Attr@ . ops prec_ precedence_ : @Token@ -> @Attr@ . ops gather`(_`) gathering`(_`) : @NeTokenList@ -> @Attr@ . ops format`(_`) : @NeTokenList@ -> @Attr@ . ops ctor constructor : -> @Attr@ . ops frozen ditto iter : -> @Attr@ . ops object msg message config : -> @Attr@ . op special`(_`) : @HookList@ -> @Attr@ . op __ : @HookList@ @HookList@ -> @HookList@ [assoc] . op id-hook_ : @Token@ -> @Hook@ . op id-hook_`(_`) : @Token@ @NeTokenList@ -> @Hook@ . op op-hook_`(_:_->_`) : @Token@ @Token@ @NeTokenList@ @Token@ -> @Hook@ . op op-hook_`(_:`->_`) : @Token@ @Token@ @Token@ -> @Hook@ . op op-hook_`(_:_~>_`) : @Token@ @Token@ @NeTokenList@ @Token@ -> @Hook@ . op op-hook_`(_:`~>_`) : @Token@ @Token@ @Token@ -> @Hook@ . op term-hook_`(_`) : @Token@ @Bubble@ -> @Hook@ . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod MOD-EXPRS is including OPERATOR-ATTRIBUTES . including EXTENDED-SORTS . sorts @Map@ @MapList@ . subsort @Map@ < @MapList@ . subsorts @Token@ < @ModExp@ . *** module expression op _*`(_`) : @ModExp@ @MapList@ -> @ModExp@ . op _`{_`} : @ModExp@ @ViewExp@ -> @ModExp@ . op TUPLE`[_`] : @Token@ -> @ModExp@ . op _+_ : @ModExp@ @ModExp@ -> @ModExp@ [assoc prec 42] . *** renaming maps op op_to_ : @Token@ @Token@ -> @Map@ . op op_:_->_to_ : @Token@ @TypeList@ @Type@ @Token@ -> @Map@ . op op_: ->_to_ : @Token@ @Type@ @Token@ -> @Map@ . op op_:_~>_to_ : @Token@ @TypeList@ @Type@ @Token@ -> @Map@ . op op_: ~>_to_ : @Token@ @Type@ @Token@ -> @Map@ . op op_to_`[_`] : @Token@ @Token@ @AttrList@ -> @Map@ . op op_:_->_to_`[_`] : @Token@ @TypeList@ @Type@ @Token@ @AttrList@ -> @Map@ . op op_:`->_to_`[_`] : @Token@ @Type@ @Token@ @AttrList@ -> @Map@ . op op_:_~>_to_`[_`] : @Token@ @TypeList@ @Type@ @Token@ @AttrList@ -> @Map@ . op op_:`~>_to_`[_`] : @Token@ @Type@ @Token@ @AttrList@ -> @Map@ . op sort_to_ : @Sort@ @Sort@ -> @Map@ . op label_to_ : @Token@ @Token@ -> @Map@ . op class_to_ : @Sort@ @Sort@ -> @Map@ . op attr_._to_ : @Sort@ @Token@ @Token@ -> @Map@ . op msg_to_ : @Token@ @Token@ -> @Map@ . op msg_:_->_to_ : @Token@ @TypeList@ @Type@ @Token@ -> @Map@ . op msg_:`->_to_ : @Token@ @Type@ @Token@ -> @Map@ . op _`,_ : @MapList@ @MapList@ -> @MapList@ [assoc prec 42] . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod SIGNATURES is inc MOD-EXPRS . sorts @SortDecl@ @SubsortRel@ @SubsortDecl@ @OpDecl@ . op `(_`) : @Token@ -> @Token@ . *** sort declaration op sorts_. : @SortList@ -> @SortDecl@ . op sort_. : @SortList@ -> @SortDecl@ . *** subsort declaration op subsort_. : @SubsortRel@ -> @SubsortDecl@ . op subsorts_. : @SubsortRel@ -> @SubsortDecl@ . op _<_ : @SortList@ @SortList@ -> @SubsortRel@ . op _<_ : @SortList@ @SubsortRel@ -> @SubsortRel@ . *** operator declaration op op_:`->_. : @Token@ @Type@ -> @OpDecl@ . op op_:`->_`[_`]. : @Token@ @Type@ @AttrList@ -> @OpDecl@ . op op_:_->_. : @Token@ @TypeList@ @Type@ -> @OpDecl@ . op op_:_->_`[_`]. : @Token@ @TypeList@ @Type@ @AttrList@ -> @OpDecl@ . op ops_:`->_. : @NeTokenList@ @Type@ -> @OpDecl@ . op ops_:`->_`[_`]. : @NeTokenList@ @Type@ @AttrList@ -> @OpDecl@ . op ops_:_->_. : @NeTokenList@ @TypeList@ @Type@ -> @OpDecl@ . op ops_:_->_`[_`]. : @NeTokenList@ @TypeList@ @Type@ @AttrList@ -> @OpDecl@ . op op_:`~>_. : @Token@ @Sort@ -> @OpDecl@ . op op_:`~>_`[_`]. : @Token@ @Sort@ @AttrList@ -> @OpDecl@ . op op_:_~>_. : @Token@ @TypeList@ @Sort@ -> @OpDecl@ . op op_:_~>_`[_`]. : @Token@ @TypeList@ @Sort@ @AttrList@ -> @OpDecl@ . op ops_:`~>_. : @NeTokenList@ @Sort@ -> @OpDecl@ . op ops_:`~>_`[_`]. : @NeTokenList@ @Sort@ @AttrList@ -> @OpDecl@ . op ops_:_~>_. : @NeTokenList@ @TypeList@ @Sort@ -> @OpDecl@ . op ops_:_~>_`[_`]. : @NeTokenList@ @TypeList@ @Sort@ @AttrList@ -> @OpDecl@ . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod F&S-MODS&THS is including SIGNATURES . including QID-LIST . sorts @FDeclList@ @SDeclList@ @Module@ @ImportDecl@ @Parameter@ @List@ @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@ < @List@ . subsorts @Token@ < @Interface@ . *** parameterized module interface op _::_ : @Token@ @ModExp@ -> @Parameter@ [prec 40 gather (e &)] . op _::_ : @Token@ @Interface@ -> @Parameter@ [prec 40 gather (e &)] . op _`,_ : @List@ @List@ -> @List@ [assoc] . op _`{_`} : @ModExp@ @List@ -> @Interface@ . *** declaration list op __ : @VarDeclList@ @VarDeclList@ -> @VarDeclList@ [assoc] . op __ : @SDeclList@ @SDeclList@ -> @SDeclList@ [assoc] . op __ : @FDeclList@ @FDeclList@ -> @FDeclList@ [assoc] . *** functional and system module and theory op fmod_is_endfm : @Interface@ @FDeclList@ -> @Module@ . op obj_is_jbo : @Interface@ @FDeclList@ -> @Module@ . op obj_is_endo : @Interface@ @FDeclList@ -> @Module@ . op mod_is_endm : @Interface@ @SDeclList@ -> @Module@ . op fth_is_endfth : @Interface@ @FDeclList@ -> @Module@ . op th_is_endth : @Interface@ @SDeclList@ -> @Module@ . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod O-MODS&THS is including F&S-MODS&THS . sorts @ClassDecl@ @AttrDecl@ @AttrDeclList@ @SubclassDecl@ @MsgDecl@ @ODeclList@ . subsorts @SDeclList@ @MsgDecl@ @SubclassDecl@ @ClassDecl@ < @ODeclList@ . subsort @AttrDecl@ < @AttrDeclList@ . op __ : @ODeclList@ @ODeclList@ -> @ODeclList@ [assoc] . *** object-oriented module and theory op omod_is_endom : @Interface@ @ODeclList@ -> @Module@ . op oth_is_endoth : @Interface@ @ODeclList@ -> @Module@ . *** class declaration op class_|_. : @Sort@ @AttrDeclList@ -> @ClassDecl@ . op class_. : @Sort@ -> @ClassDecl@ . op _`,_ : @AttrDeclList@ @AttrDeclList@ -> @AttrDeclList@ [assoc] . op _:_ : @Token@ @Sort@ -> @AttrDecl@ [prec 40] . *** subclass declaration op subclass_. : @SubsortRel@ -> @SubclassDecl@ . op subclasses_. : @SubsortRel@ -> @SubclassDecl@ . *** message declaration op msg_:_->_. : @Token@ @SortList@ @Sort@ -> @MsgDecl@ . op msgs_:_->_. : @NeTokenList@ @SortList@ @Sort@ -> @MsgDecl@ . op msg_:`->_. : @Token@ @Sort@ -> @MsgDecl@ . op msgs_:`->_. : @NeTokenList@ @Sort@ -> @MsgDecl@ . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod VIEWS is including O-MODS&THS . sorts @ViewDecl@ @ViewDeclList@ @View@ . subsorts @VarDecl@ < @ViewDecl@ < @ViewDeclList@ . subsort @VarDeclList@ < @ViewDeclList@ . *** view maps op op_to`term_. : @Bubble@ @Bubble@ -> @ViewDecl@ . op op_to_. : @Token@ @Token@ -> @ViewDecl@ . op op_:_->_to_. : @Token@ @TypeList@ @Type@ @Token@ -> @ViewDecl@ . op op_:`->_to_. : @Token@ @Type@ @Token@ -> @ViewDecl@ . op op_:_~>_to_. : @Token@ @TypeList@ @Type@ @Token@ -> @ViewDecl@ . op op_:`~>_to_. : @Token@ @Type@ @Token@ -> @ViewDecl@ . op sort_to_. : @Sort@ @Sort@ -> @ViewDecl@ . op class_to_. : @Sort@ @Sort@ -> @ViewDecl@ . op attr_._to_. : @Sort@ @Token@ @Token@ -> @ViewDecl@ . op msg_to_. : @Token@ @Token@ -> @ViewDecl@ . op msg_:_->_to_. : @Token@ @TypeList@ @Type@ @Token@ -> @ViewDecl@ . op msg_:`->_to_. : @Token@ @Type@ @Token@ -> @ViewDecl@ . *** view op view_from_to_is_endv : @Interface@ @ModExp@ @ModExp@ @ViewDeclList@ -> @View@ . op __ : @ViewDeclList@ @ViewDeclList@ -> @ViewDeclList@ [assoc] . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod COMMANDS is including MOD-EXPRS . sorts @Command@ . *** down function op down_:_ : @ModExp@ @Command@ -> @Command@ . *** parse commands op parse_. : @Bubble@ -> @Command@ . *** reduce commands op red_. : @Bubble@ -> @Command@ . op reduce_. : @Bubble@ -> @Command@ . *** rewrite commands op rew_. : @Bubble@ -> @Command@ . op rewrite_. : @Bubble@ -> @Command@ . *** frewrite commands op frew_. : @Bubble@ -> @Command@ . op frewrite_. : @Bubble@ -> @Command@ . *** search commands op search_=>1_. : @Bubble@ @Bubble@ -> @Command@ . op search_=>*_. : @Bubble@ @Bubble@ -> @Command@ . op search_=>+_. : @Bubble@ @Bubble@ -> @Command@ . op search_=>!_. : @Bubble@ @Bubble@ -> @Command@ . *** 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`vars`. : -> @Command@ . op show`vars_. : @ModExp@ -> @Command@ . op show`sorts`. : -> @Command@ . op show`sorts_. : @ModExp@ -> @Command@ . op show`ops`. : -> @Command@ . op show`ops_. : @ModExp@ -> @Command@ . op show`mbs`. : -> @Command@ . op show`mbs_. : @ModExp@ -> @Command@ . op show`eqs`. : -> @Command@ . op show`eqs_. : @ModExp@ -> @Command@ . op show`rls`. : -> @Command@ . op show`rls_. : @ModExp@ -> @Command@ . op show`view_. : @ViewExp@ -> @Command@ . op show`modules`. : -> @Command@ . op show`views`. : -> @Command@ . *** set commands op set`protect_on`. : @ModExp@ -> @Command@ . op set`protect_off`. : @ModExp@ -> @Command@ . op set`include_on`. : @ModExp@ -> @Command@ . op set`include_off`. : @ModExp@ -> @Command@ . op set`extend_on`. : @ModExp@ -> @Command@ . op set`extend_off`. : @ModExp@ -> @Command@ . *** miscellaneous op load_. : @ModExp@ -> @Command@ . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod FULL-MAUDE-SIGN is including VIEWS . including COMMANDS . sort @Input@ . subsorts @Command@ @Module@ @View@ < @Input@ . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** To parse some input using the built-in function \texttt{metaParse}, we *** need to give the metarepresentation of the signature in which the input is *** going to be parsed. *** But we do not need to give the complete metarepresentation of such a *** module. In modules including \texttt{META-LEVEL} it is possible to define *** terms of sort \texttt{Module} that import built-in modules or any module *** introduced at the ``object level'' of Core Maude. In this way, it is *** possible to get the equivalent effect of having the explicit *** metarepresentation of a module by declaring a constant and adding an *** equation identifying such a constant with the metarepresentation of an *** extended module that imports the original module at the object level. *** The declaration of constructors for bubble sorts at the object level is *** not supported in the current version of Core Maude. The \texttt{special} *** attributes linking the constructors for the bubble sorts to the built-in *** ones are only supported at the metalevel, that is, the declarations of the *** constructor operators for bubble sorts have to be given in the *** metarepresentation of a module. *** To allow the greatest generality and flexibility in future extensions of *** Full Maude, we have declared its signature as a module *** \texttt{FULL-MAUDE-SIGN}. Then, in the following module *** \texttt{META-FULL-MAUDE-SIGN} we declare a constant \texttt{GRAMMAR} of *** sort \texttt{FModule}, and we give an equation identifying such constant *** with the metarepresentation of a module \texttt{GRAMMAR} in which there is *** a declaration importing \texttt{FULL-MAUDE-SIGN}. Declarations for the *** constructors of the bubble sorts are also included in this module. Note *** that the bubble sorts \texttt{@Token@}, \texttt{@Bubble@}, *** \texttt{@SortToken@}, and \texttt{@NeTokenList@} are declared in the *** module \texttt{SIGN\&VIEW-EXPR}, which is imported by *** \texttt{FULL-MAUDE-SIGN}. These sorts are used in the declarations *** describing the syntax of the system. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod META-FULL-MAUDE-SIGN is including META-LEVEL . op GRAMMAR : -> FModule [memo] . 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 'poly 'memo 'memoization 'iter 'frozen 'config 'object 'msg)))] . op 'neTokenList : 'QidList -> '@NeTokenList@ [special( (id-hook('Bubble, '1 '-1 '`( '`)) op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList) op-hook('qidSymbol, ', 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. ******* ******* ERROR HANDLING, by Peter Olveczky ******* *** The following module defines a function which prints up to n characters *** of a bubble, followed by the usual arrow <---*HERE* which points to the *** erroneous token: ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod PRINT-SYNTAX-ERROR is protecting META-LEVEL . protecting INT . var QIL : QidList . var Q : Qid . var N : Nat . vars RP RP' : ResultPair . var RP? : [ResultPair?] . op printN : Nat QidList -> QidList . *** first N qid's in a qidList eq printN(N, nil) = nil . eq printN(0, QIL) = nil . eq printN(s N, Q QIL) = Q printN(N, QIL) . op removeFront : Nat QidList -> QidList . *** removes first N qid's eq removeFront(N, nil) = nil . eq removeFront(0, QIL) = QIL . eq removeFront(s N, Q QIL) = removeFront(N, QIL) . op printSyntaxError : [ResultPair?] QidList -> QidList . eq printSyntaxError(noParse(N), QIL) = '\r 'Parse 'error 'in '\o '\s printN(N + 1, QIL) '\r '<---*HERE* '\o . eq printSyntaxError(ambiguity(RP, RP'), QIL) = '\r 'Ambiguous 'parsing 'for '\o '\s QIL '\o . eq printSyntaxError(RP?, QIL) = QIL [owise] . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** The Abstract Data Type \texttt{Module} *** ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** In this section we present the abstract data type \texttt{Module}, which *** can be seen as an extension of the predefined sort \texttt{Module} in *** several ways. There are constructors for functional, system, and object- *** oriented modules and theories, which can be parameterized and can import *** module expressions. There can also be parameterized sorts in Full Maude *** modules, and therefore, the constructors for the different declarations *** that can appear in a module have to be appropriately extended. *** The section is structured as follows. After introducing some modules *** defining some functions on the predefined sorts \texttt{Bool} and *** \texttt{QidList} in Section~\ref{BOOL-QID-LIST}, we present in *** Sections~\ref{EXT-SORT} and~\ref{EXT-DECL} the data types for extended *** sorts and extended declarations. In Section~\ref{mod-exp-mod-id} we *** introduce module expressions and module names, and in *** Section~\ref{unitADT} the abstract data type \texttt{Module} itself. *** *** Extension \texttt{QID-LIST} *** *** The conversion of lists of quoted identifiers into single quoted *** identifiers by concatenating them is heavily used in the coming modules. *** This is the task of the \texttt{} function, which is *** introduced in the following module \texttt{EXT-QID-LIST} extending the *** predefined module \texttt{QID-LIST}. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod EXT-QID-LIST is pr QID-LIST . op qidList2Qid : QidList -> Qid . var QI : Qid . var QIL : QidList . var St : String . var N : Nat . var F : FindResult . eq qidList2Qid(('\s QIL)) = qid(" " + string(qidList2Qid(QIL))) . eq qidList2Qid((QI QIL)) = qid(string(QI) + " " + string(qidList2Qid(QIL))) [owise] . eq qidList2Qid(nil) = qid("") . op string2qidList : String -> QidList . eq string2qidList("") = nil . ceq string2qidList(St) = if F == notFound then qid(substr(St, findNonSpace(St), length(St))) else qid(substr(St, findNonSpace(St), F + 1)) string2qidList(substr(St, F + 1, length(St))) fi if F := find(substr(St, findNonSpace(St), length(St)), " ", 0) [owise] . op findNonSpace : String -> Nat . op findNonSpace : String Nat -> Nat . ---- returns the length of the string if not found eq findNonSpace(St) = findNonSpace(St, 0) . eq findNonSpace(St, N) = if substr(St, N, 1) =/= "" and substr(St, N, 1) == " " then findNonSpace(St, N + 1) else N fi . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** 3.2 View Expressions and Extended Sorts *** To allow the use of parameterized sorts, or sorts qualified by the view *** expression with which the parameterized module in which the given sorts *** appear is instantiated, we add the sort Sort of ``extended sorts'' as a *** supersort of the predefined sort Sort. View expressions and extended *** sorts are introduced in the following modules. *** 3.2.1 View Expressions *** A view expression is given by a single quoted identifier, by a sequence of *** view expressions (at the user level, separated by commas), or by the *** composition of view expressions. In the current version, the composition *** of view expressions is only used internally; we plan to make it available *** to the user with syntax \verb~_;_~ in the future. View expressions are *** used in the instantiation of parameterized modules and in parameterized *** sorts. We plan to support parameterized views in the future as well. We *** use operators \verb~_|_~ and \verb~_;;_~ to represent, respectively, *** sequences and composition of view expressions. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod VIEW-EXPR is pr META-MODULE . sort ViewExp . subsorts Sort < ViewExp < ModuleExpression NeParameterList . op mtViewExp : -> ViewExp . op _{_} : Sort ParameterList -> ViewExp [ctor prec 37]. op _;;_ : ViewExp ViewExp -> ViewExp [assoc id: mtViewExp] . *** view composition _;_ endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** Since the Core Maude engine does not know about view expressions, or, as *** we shall see, about extended sorts, extended module expressions, extended *** modules, and other declarations that we introduce, to be able to use them *** with built-in functions such as \texttt{sameComponent}, *** \texttt{leastSort}, \texttt{metaReduce}, etc., we shall have to convert *** them into terms which only use the built-in constructors. Thus, for *** example, view expressions in sort \texttt{ViewExp} will be converted *** into quoted identifiers of sort \texttt{Qid} by means of function *** \texttt{parameter2Qid}, or, similarly, elements of sorts \texttt{Sort}, *** \texttt{SortList}, and \texttt{SortSet} are transformed into elements *** of sorts \texttt{Qid}, \texttt{QidList}, and \texttt{QidSet}, *** respectively, with functions \texttt{eSortToQid} defined on the *** appropriate sorts. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod VIEW-EXPR-TO-QID is pr VIEW-EXPR . pr EXT-QID-LIST . op viewExp2Qid : ViewExp -> Qid . op parameterList2Qid : ParameterList -> Qid . op viewExp2QidList : ViewExp -> QidList . op parameterList2QidList : ParameterList -> QidList . var V : Sort . var QI : Qid . var QIL : QidList . var P : ViewExp . var PL : NeParameterList . vars VE VE' : ViewExp . eq parameterList2QidList(P) = viewExp2QidList(P) . ceq parameterList2QidList((P, PL)) = (if QI == '`) then QIL QI '\s else QIL QI fi) '`, parameterList2QidList(PL) if QIL QI := viewExp2QidList(P). eq viewExp2QidList(V{PL}) = (viewExp2QidList(V) '`{ parameterList2QidList(PL) '`}) . ceq viewExp2QidList(VE ;; VE') = (viewExp2QidList(VE) '; viewExp2QidList(VE')) if VE =/= mtViewExp /\ VE' =/= mtViewExp . eq viewExp2QidList(V) = V . eq parameterList2Qid(P) = viewExp2Qid(P) . eq parameterList2Qid((P, PL)) = qid(string(viewExp2Qid(P)) + ", " + string(parameterList2Qid(PL))) . eq viewExp2Qid(VE) = qidList2Qid(viewExp2QidList(VE)) . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** Parameterized Sorts *** *** In addition to the \texttt{Sort} sort, in the following module *** \texttt{EXT-SORT} we also define sorts \texttt{SortList} and *** \texttt{SortSet}. *** The operator \texttt{eSort} is declared to be a constructor for extended *** sorts. *** As for lists and sTS of quoted identifiers, we declare \verb~__~ and *** \verb~_;_~ as constructors for sorts \texttt{SortList} and *** \texttt{SortList}, and \texttt{SortSet}, respectively. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod EXT-SORT is pr META-LEVEL . pr EXT-BOOL . pr VIEW-EXPR . op size : TypeList -> Nat . eq size((nil).TypeList) = 0 . eq size(T:Type TL:TypeList) = 1 + size(TL:TypeList) . *** We define operations extending the built-in functions \texttt{sameKind} *** and \texttt{leastSort}, respectively, to lists of sorts and *** to lists of extended terms. The function \texttt{sameKind} takes *** a module and two lists of extended sorts as arguments, and returns *** \texttt{true} if the $i$-th elements of both lists are in the same *** connected component of sorts. This function will be used, for example, to *** check whether two operators are in the same family of subsort overloaded *** operators. \texttt{leastSort} returns a list of sorts where the $i$-th *** element of the list is the least sort, computed by the homonymous built-in *** function, of the $i$-th term in the list of terms given as argument. *** Moreover, we define a function \verb~_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{Sort} have to be `desugared' into sorts of sort *** \texttt{Sort} as defined in the predefined \texttt{META-LEVEL} module. *** This conversion is done by the \texttt{eTypeToType} function. Basically, *** user-defined sorts are converted into quoted identifiers by concatenating *** the list of identifiers composing the name of the sort. For example, sorts *** \texttt{'Nat} and \texttt{'List['Nat]} are converted, respectively, into *** \texttt{'Nat} and \texttt{'List`[Nat`]}. Error *** sorts~\cite{ClavelDuranEkerLincolnMarti-OlietMeseguerQuesada99} are left *** as such. op sameKind : Module TypeList TypeList -> Bool [ditto] . ceq sameKind(M:Module, (T:Type TL:TypeList), (T':Type TL':TypeList)) = sameKind(M:Module, T:Type, T':Type) and-then sameKind(M:Module, TL:TypeList, TL':TypeList) if TL:TypeList =/= nil or TL':TypeList =/= nil . eq sameKind(M:Module, (T:Type TL:TypeList), nil) = false . eq sameKind(M:Module, nil, (T:Type TL:TypeList)) = false . eq sameKind(M:Module, nil, nil) = true . eq sameKind(M:Module, cc(S:Sort ; SS:SortSet), S':Sort) = sameKind(M:Module, S:Sort, S':Sort) . eq sameKind(M:Module, S:Sort, cc(S':Sort ; SS:SortSet)) = sameKind(M:Module, S:Sort, S':Sort) . eq sameKind(M:Module, cc(S:Sort ; SS:SortSet), cc(S':Sort ; SS':SortSet)) = sameKind(M:Module, S:Sort, S':Sort) . op leastSort : Module TermList ~> TypeList [ditto] . op qidError : QidList -> [Sort] . op stringError : QidList -> [String] . eq string(qidError(QIL)) = stringError(QIL) . eq qid(stringError(QIL)) = qidError(QIL) . eq stringError(QIL) + St:String = stringError(QIL) . op getMsg : [Sort] -> QidList . eq getMsg(qidError(QIL:QidList)) = QIL:QidList . eq leastSort(M:Module, (T:Term, TL:TermList)) = (leastSort(M:Module, T:Term) leastSort(M:Module, TL:TermList)) . eq leastSort(M:Module, T:Term) = qidError('Error: 'non-valid 'module) . op _inSortSet_ : Sort SortSet -> Bool . eq S:Sort inSortSet (S:Sort ; SS:SortSet) = true . eq S:Sort inSortSet (S':Sort ; SS:SortSet) = (S:Sort == S':Sort) or-else (S:Sort inSortSet SS:SortSet) . eq S:Sort inSortSet none = false . op kind : TypeList -> Type . eq kind(S:Sort TL:TypeList) = qid("[" + string(S:Sort) + "]") kind(TL:TypeList) . eq kind(K:Kind TL:TypeList) = K:Kind kind(TL:TypeList) . eq kind(nil) = nil . op kind : SortSet -> Type . eq kind(S:Sort ; SS:SortSet) = qid("[" + string(S:Sort) + "]") . op cc : SortSet -> Type . op getSort : Kind -> Sort . eq getSort(K:Kind) = if find(string(K:Kind), "`,", 0) == notFound then qid(substr(string(K:Kind), 2, sd(length(string(K:Kind)), 4))) else qid(substr(string(K:Kind), 2, sd(find(string(K:Kind), "`,", 0), 2))) fi . op getSorts : Kind -> SortSet . eq getSorts(K:Kind) = if find(string(K:Kind), "`,", 0) == notFound then qid(substr(string(K:Kind), 2, sd(length(string(K:Kind)), 4))) else qid(substr(string(K:Kind), 2, sd(find(string(K:Kind), "`,", 0), 2))) ; getSorts(qid("[" + substr(string(K:Kind), sd(find(string(K:Kind), "`,", 0), 1), length(string(K:Kind))))) fi . ---- name of a sort (the name of S{P1, ..., Pn} is S) op getName : Sort -> Qid . eq getName(S:Sort) = if findOpening(string(S:Sort), "{", "}", sd(length(string(S:Sort)), 2)) == notFound then S:Sort else qid(substr(string(S:Sort), 0, findOpening(string(S:Sort), "{", "}", sd(length(string(S:Sort)), 2)))) fi . ---- parameters of a sort (the parameters of S{P1, ..., Pn} are P1 ... Pn) op getPars : Sort -> ParameterList . op getParsAux : String Nat Nat -> ParameterList . eq getPars(S:Sort) = if findOpening(string(S:Sort), "{", "}", sd(length(string(S:Sort)), 2)) == notFound then empty else getParsAux(string(S:Sort), findOpening(string(S:Sort), "{", "}", sd(length(string(S:Sort)), 2)) + 1, length(string(S:Sort))) fi . var St Pattern OpenPar ClosingPar : String . vars L R N OpenPars ClosingPars : Nat . eq getParsAux(St, L, R) = if findOut(St, ",", "{", "}", L) == notFound then qid(substr(St, L, sd(findClosing(St, "{", "}", L), L))) else (qid(substr(St, L, sd(findOut(St, ",", "{", "}", L), L))), getParsAux(St, findOut(St, ",", "{", "}", L) + 1, R)) fi . ---- finds a pattern out of balanced parentheses ---- findOut("S{P1, P2{P21, P22}, P3}", ",", "{", "}", 6) returns 18, not 12 op findOut : String String String String Nat -> FindResult . op findOut : String String String String Nat Nat -> FindResult . eq findOut(St, Pattern, OpenPar, ClosingPar, N) = findOut(St, Pattern, OpenPar, ClosingPar, 0, N) . eq findOut(St, Pattern, OpenPar, ClosingPar, OpenPars, N) = if N >= length(St) then notFound else if OpenPars == 0 and-then substr(St, N, length(Pattern)) == Pattern then N else if substr(St, N, length(OpenPar)) == OpenPar then findOut(St, Pattern, OpenPar, ClosingPar, OpenPars + 1, N + 1) else if substr(St, N, length(ClosingPar)) == ClosingPar then findOut(St, Pattern, OpenPar, ClosingPar, sd(OpenPars, 1), N + 1) else findOut(St, Pattern, OpenPar, ClosingPar, OpenPars, N + 1) fi fi fi fi . ---- finds the first closing unbalanced parenthesis ---- findOut("P1, P2{P21, P22}, P3}", "{", "}", 6) returns 21, not 16 op findClosing : String String String Nat -> FindResult . op findClosing : String String String Nat Nat -> FindResult . eq findClosing(St, OpenPar, ClosingPar, N) = findClosing(St, OpenPar, ClosingPar, 0, N) . eq findClosing(St, OpenPar, ClosingPar, OpenPars, N) = if N >= length(St) then notFound else if OpenPars == 0 and-then substr(St, N, length(ClosingPar)) == ClosingPar then N else if substr(St, N, length(OpenPar)) == OpenPar then findClosing(St, OpenPar, ClosingPar, OpenPars + 1, N + 1) else if substr(St, N, length(ClosingPar)) == ClosingPar then findClosing(St, OpenPar, ClosingPar, sd(OpenPars, 1), N + 1) else findClosing(St, OpenPar, ClosingPar, OpenPars, N + 1) fi fi fi fi . ---- finds the last opening unbalanced parenthesis ---- findOpening("S{P1, P2{P21, P22}, P3}", "{", "}", 21) returns 1, not 8 op findOpening : String String String Nat -> FindResult . op findOpening : String String String Nat Nat -> FindResult . eq findOpening(St, OpenPar, ClosingPar, N) = findOpening(St, OpenPar, ClosingPar, 0, N) . eq findOpening(St, OpenPar, ClosingPar, ClosingPars, N) = if N == 0 then notFound else if ClosingPars == 0 and-then substr(St, N, length(ClosingPar)) == OpenPar then N else if substr(St, N, length(OpenPar)) == ClosingPar then findOpening(St, OpenPar, ClosingPar, ClosingPars + 1, sd(N, 1)) else if substr(St, N, length(ClosingPar)) == OpenPar then findOpening(St, OpenPar, ClosingPar, sd(ClosingPars, 1), sd(N, 1)) else findOpening(St, OpenPar, ClosingPar, ClosingPars, sd(N, 1)) fi fi fi fi . ***( eq getParsAux(St, L, R) = if find(St, ",", L) == notFound then qid(substr(St, L, sd(find(St, "}", L), L))) else qid(substr(St, L, sd(find(St, ",", L), L))) getParsAux(St, find(St, ",", L) + 1, R) fi . ) op makeSort : Sort ParameterList -> Sort . op makeSort : Sort ParameterList ParameterList ParameterList -> Sort . op makeSort2 : Sort ParameterList -> Sort . op makePars : ParameterList -> String . vars S P : Sort . vars PL PL' PL'' PL3 : ParameterList . var VE : ViewExp . var QIL : QidList . eq makeSort(S, PL) = if PL == empty then S else makeSort(S, PL, empty, empty) fi . ----eq makeSort(S, P, PL, PL') = makeSort(S, empty, (PL, P), PL') . eq makeSort(S, (P, PL), PL', PL'') = makeSort(S, PL, (PL', P), PL'') . eq makeSort(S, (P{PL}, PL'), PL'', PL3) = makeSort(S, PL', (PL'', makeSort(P, PL)), PL3) . ----eq makeSort(S, (P ;; VE), PL, PL') ---- = makeSort(S, empty, (PL, P), (PL', VE)) ---- [owise] . eq makeSort(S, ((P ;; VE), PL), PL', PL'') = makeSort(S, PL, (PL', P), (PL'', VE)) [owise] . eq makeSort(S, empty, PL, PL') = if PL' == empty then makeSort2(S, PL) else makeSort(makeSort2(S, PL), PL') fi . eq makeSort2(S, empty) = S:Sort . eq makeSort2(S, P) = qid(string(S) + "{" + string(P) + "}") . eq makeSort2(S, (P, PL)) = qid(string(S) + "{" + string(P) + makePars(PL)) [owise] . eq makePars((P, PL)) = "," + string(P) + makePars(PL) . eq makePars(P) = "," + string(P) + "}" . eq makePars(empty) = "}" . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod DEFAULT-VALUE{X :: TRIV} is sort Default{X} . subsort X$Elt < Default{X} . op null : -> Default{X} . endfm view Term from TRIV to META-TERM is sort Elt to Term . endv ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** Extended Declarations *** *** In this section we discuss modules \texttt{EXT-DECL} and \texttt{O-O-DECL} *** which introduce, respectively, the declarations extending the sorts and *** constructors for declarations of the predefined data type \texttt{Module} *** in the \texttt{META-LEVEL} module to allow the use of extended sorts in *** them, and the declarations appearing in object-oriented units, namely *** class declarations, subclass relation declarations, and message *** declarations. *** *** Declarations of Functional and System Modules *** *** In the following module \texttt{EXT-DECL}, we introduce the declarations *** extending those in \texttt{META-LEVEL} to allow the use of extended sorts *** in declarations of sorts, subsort relations, operators, variables, and *** membership axioms. *** \begin{comment} *** \footnote{In the future, the declarations for operators, *** membership axioms, equations, and rules will be extended to allow *** the use of extended sorts in sort tests, that is, terms of the *** form \mbox{\verb~T : S~} and \mbox{\verb~T :: S~}.} *** \end{comment} *** The extension is accomplished by adding new supersorts for each of the *** sorts in \texttt{META-LEVEL} involved, and by adding new constructors for *** these new sorts. *** We start introducing the declarations for the supersorts and their *** corresponding constructors. The \texttt{EXT-DECL} module also contains the *** declarations for sTS of such declarations. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod INT-LIST is pr META-MODULE . pr INT . sort IntList . subsort Int NatList < IntList . op __ : IntList IntList -> IntList [ctor ditto] . op numberError : QidList -> [Nat] . vars N M : Nat . op from_to_list : Nat Nat ~> NatList . ceq from N to M list = if N == M then N else N from N + 1 to M list fi if N <= M . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod EXT-DECL is pr EXT-SORT . pr INT-LIST . vars QIL QIL' : QidList . var At : Attr . var AtS : AttrSet . var OPD OPD' : OpDecl . var OPDS : OpDeclSet . *** subsort declarations error op subsortDeclError : QidList -> [SubsortDeclSet] [ctor format (r o)] . eq subsortDeclError(QIL) subsortDeclError(QIL') = subsortDeclError(QIL QIL') . *** extended attribute declarations op strat : IntList -> Attr [ditto] . *** to handle on-demand strategies op ditto : -> Attr [ctor] . op _in_ : Attr AttrSet -> Bool . eq At in At AtS = true . *** extended operation declarations op opDeclError : QidList -> [OpDeclSet] [ctor format (r o)] . eq opDeclError(QIL) opDeclError(QIL') = opDeclError(QIL QIL') . *** extended membership axioms op membAxError : QidList -> [MembAxSet] [ctor format (r o)] . eq membAxError(QIL) membAxError(QIL') = membAxError(QIL QIL') . *** extended equations op equationError : QidList -> [EquationSet] [ctor format (r o)] . eq equationError(QIL) equationError(QIL') = equationError(QIL QIL') . *** extended rules op ruleError : QidList -> [RuleSet] [ctor format (r o)] . eq ruleError(QIL) ruleError(QIL') = ruleError(QIL QIL') . *** The function \verb~_in_~ checks whether a given operator *** declaration is in a set of operator declarations. op _in_ : OpDecl OpDeclSet -> Bool . eq OPD in (OPD OPDS) = true . eq OPD in (OPD' OPDS) = (OPD == OPD') or-else (OPD in OPDS) . eq OPD in none = false . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** Declarations for Object-Oriented Modules *** *** In the \texttt{O-O-DECL} module we introduce the sorts and constructors *** for declarations of classes, subclass relations, and messages in *** object-oriented units. *** Note that we follow the same naming conventions for classes as for *** extended sorts (see Section~\ref{parameterized-modules}), and therefore *** we use the sort \texttt{Sort} for class identifiers, and *** \texttt{TypeList} and \texttt{SortSet} for lists and sTS of class *** identifiers, respectively. We use the operator \verb~attr_:_~ as a *** constructor for declarations of attributes. Since the operator name *** \texttt{\_\,:\_\,} is used for sort tests in the \texttt{META-LEVEL} *** module, we use \texttt{attr\_\,:\_\,} as constructor for declarations of *** attributes to satisfy the preregularity condition. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod O-O-DECL is pr EXT-SORT . vars QIL QIL' : QidList . sorts AttrDecl AttrDeclSet . subsort AttrDecl < AttrDeclSet . op attr_:_ : Qid Sort -> AttrDecl . op none : -> AttrDeclSet . op _`,_ : AttrDeclSet AttrDeclSet -> AttrDeclSet [assoc comm id: none] . eq AD:AttrDecl, AD:AttrDecl = AD:AttrDecl . sorts ClassDecl ClassDeclSet . subsort ClassDecl < ClassDeclSet . op class_|_. : Sort AttrDeclSet -> ClassDecl . op none : -> ClassDeclSet . op __ : ClassDeclSet ClassDeclSet -> ClassDeclSet [assoc comm id: none] . op classDeclError : QidList -> [ClassDeclSet] [ctor format (r o)] . eq classDeclError(QIL) classDeclError(QIL') = classDeclError(QIL QIL') . eq CD:ClassDecl CD:ClassDecl = CD:ClassDecl . sorts SubclassDecl SubclassDeclSet . subsort SubclassDecl < SubclassDeclSet . op subclass_<_. : Sort Sort -> SubclassDecl . op none : -> SubclassDeclSet . op __ : SubclassDeclSet SubclassDeclSet -> SubclassDeclSet [assoc comm id: none] . eq SCD:SubclassDecl SCD:SubclassDecl = SCD:SubclassDecl . op subclassDeclError : QidList -> [SubclassDeclSet] [ctor format (r o)] . eq subclassDeclError(QIL) subclassDeclError(QIL') = subclassDeclError(QIL QIL') . sorts MsgDecl MsgDeclSet . subsort MsgDecl < MsgDeclSet . op msg_:_->_. : Qid TypeList Sort -> MsgDecl . op none : -> MsgDeclSet . op __ : MsgDeclSet MsgDeclSet -> MsgDeclSet [assoc comm id: none] . eq MD:MsgDecl MD:MsgDecl = MD:MsgDecl . op msgDeclError : QidList -> [MsgDeclSet] [ctor format (r o)] . eq msgDeclError(QIL) msgDeclError(QIL') = msgDeclError(QIL QIL') . *** The function \texttt{classSet} returns the set of class identifiers in *** the set of class declarations given as argument. op classSet : ClassDeclSet -> SortSet . eq classSet((class S:Sort | ADS:AttrDeclSet .) CDS:ClassDeclSet) = (S:Sort ; classSet(CDS:ClassDeclSet)) . eq classSet(none) = none . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** Renaming Maps *** *** We introduce the different types of renaming maps in the module *** \texttt{FMAP} below. A sort is introduced for each of these types of maps, *** with the appropriate constructors for each sort (see *** Section~\ref{module-expressions}). All these sorts are declared to be *** subsorts of the sort \texttt{Map}. A sort for sTS of *** maps (\texttt{RenamingSet}) is then declared as supersort of \texttt{Map} *** with constructors \texttt{none} and \verb~_,_~. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod FMAP is inc META-MODULE . pr EXT-SORT . *** renamings op class_to_ : Sort Sort -> Renaming . op attr_._to_ : Qid Sort Qid -> Renaming . op msg_to_ : Qid Qid -> Renaming . op msg_:_->_to_ : Qid TypeList Sort Qid -> Renaming . op none : -> RenamingSet . eq (MAP, MAP) = MAP . eq (MAPS, none) = MAPS . ---- eq attr A . qidError(QIL) to A' = none . *** Given a set of maps, the function \texttt{sortMaps} returns the *** subset of sort maps in it. var MAP : Renaming . var MAPS : RenamingSet . vars S S' A A' : Sort . var QIL : QidList . op sortMaps : RenamingSet -> RenamingSet . eq sortMaps(sort S to S') = sort S to S' . eq sortMaps(((sort S to S'), MAPS)) = ((sort S to S'), sortMaps(MAPS)) . eq sortMaps(MAP) = none [owise] . eq sortMaps((MAP, MAPS)) = sortMaps(MAPS) [owise] . eq sortMaps(none) = none . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** Module Expressions and Module Names *** *** The abstract syntax for writing specifications in Maude can be seen as *** given by module expressions, where the notion of module expression is *** understood as an expression that defines a new module out of previously *** defined modules by combining and/or modifying them according to a specific *** set of operations. All module expressions will be evaluated generating *** modules with such module expressions as names. In the case of parameterized *** modules, each of the parameters in an interface will be used as the name *** of a new module created as a renamed copy of the parameter theory. *** *** Module Expressions *** *** The \texttt{TUPLE} is declared to be a new type of *** \texttt{ModuleExpression}. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod MOD-EXPR is inc META-MODULE . pr FMAP . op TUPLE`[_`] : NzNat -> ModuleExpression . eq ME:ModuleExpression * ( none ) = ME:ModuleExpression . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** Module Names *** *** As we shall see in the coming sections, the evaluation of module *** expressions may produce the creation of new modules, whose \emph{names} *** are given by the module expressions themselves. If there is already a *** module in the database with the module expression being evaluated as name, *** the evaluation of such module expression does not produce any change in *** the database. However, the evaluation of a module expression may involve *** the evaluation of some other module expressions contained in the modules *** involved, which in turn may generate new modules. *** Given a parameterized module $\texttt{N\{L}_1\texttt{\ ::\ T}_1 *** \texttt{\ ,\ }\ldots\texttt{\ ,\ L}_n\texttt{\ ::\ T}_n\texttt{\}}$, with *** $\texttt{L}_1\ldots\texttt{L}_n$ labels and *** $\texttt{T}_1\ldots\texttt{T}_n$ theory identifiers, we say that *** \texttt{N} is the name of the module and that *** $\texttt{\{L}_1\texttt{\ ::\ T}_1\texttt{\ ,\ } *** \ldots\texttt{\ ,\ L}_n\texttt{\ ::\ T}_n\texttt{\}}$ *** is its \emph{interface}. *** As we shall see in Sections~\ref{instantiation} and~\ref{unit-processing}, *** for each parameter $\texttt{L}_i\texttt{\ ::\ T}_i$ in the interface of a *** module, a new module is generated with such a parameter expression as its *** name, and a declaration importing it in the parameterized module is added. *** We regard the relationship between the body of a parameterized module and *** the parameters in its interface, not as an inclusion, but as mediated by *** a module constructor that generates renamed copies of the parameters, *** which are then included. Therefore, the sort \texttt{ViewExp} is *** declared as a subsort of \texttt{Header}, that is, terms of sort *** \texttt{ViewExp} are considered to be module names. The constructor *** operator for the sort \texttt{ViewExp} is \verb~par_::_~. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod MOD-NAME is inc MOD-EXPR . pr EXT-BOOL . op parameterError : QidList -> [ParameterDecl] . sort ModuleName . subsorts ModuleExpression < ModuleName < Header . op _{_} : ModuleExpression ParameterDeclList -> Header . op pd : ParameterDecl -> ModuleName . op nullHeader : -> Header . op getName : Header -> ModuleExpression . op getParDecls : Header -> ParameterDeclList . vars QI QI' : Qid . var ME : ModuleExpression . vars PDL PDL' : ParameterDeclList . var PL : NeParameterList . var MN : ModuleName . eq getName(ME{PDL}) = ME . eq getName(MN) = MN . eq getParDecls(ME{PDL}) = PDL . eq getParDecls(MN) = nil . op including_. : ModuleName -> Import [ctor] . op extending_. : ModuleName -> Import [ctor] . op protecting_. : ModuleName -> Import [ctor] . op fth_is_sorts_.____endfth : Header ImportList SortSet SubsortDeclSet OpDeclSet MembAxSet EquationSet -> FTheory [ctor gather (& & & & & & &) format (d d d n++i ni d d ni ni ni ni n--i d)] . op th_is_sorts_._____endth : Header ImportList SortSet SubsortDeclSet OpDeclSet MembAxSet EquationSet RuleSet -> STheory [ctor gather (& & & & & & & &) format (d d d n++i ni d d ni ni ni ni ni n--i d)] . *** The function \texttt{labelInParameterDeclList} checks whether the quoted *** identifier given as first argument is used as a label in the list of *** parameters given as second argument. op labelInParameterDeclList : Sort ParameterDeclList -> Bool . eq labelInParameterDeclList(QI, (PDL, (QI :: ME), PDL')) = true . eq labelInParameterDeclList(QI, PDL) = false [owise] . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** Since the Core Maude engine assumes that module names are identifiers and *** does not know about term-structured module names (such as parameterized *** module interfaces or module expressions), for evaluation purposes we need *** to transform them into quoted identifiers. The functions *** \texttt{header2Qid} and \texttt{header2QidList} in the module *** \texttt{MOD-NAME-TO-QID} below accomplish this transformation. In any *** language extensions, new equations for the function *** \texttt{header2QidList} should be added for each new module expression *** constructor introduced. In Sections~\ref{renaming} and~\ref{instantiation} *** we shall see how the corresponding equalities are added for renaming and *** instantiation expressions, and in Section~\ref{extension} for other new *** module expressions in extensions of Full Maude. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod MOD-NAME-TO-QID is pr MOD-NAME . pr EXT-QID-LIST . op header2Qid : -> Qid . op header2QidList : Header -> QidList . op parameterDecl2Qid : ParameterDecl -> Qid . op parameterDecl2QidList : ParameterDecl -> QidList . op parameterDeclList2Qid : ParameterDeclList -> Qid . op parameterDeclList2QidList : ParameterDeclList -> QidList . vars QI X : Qid . var QIL : QidList . vars ME ME' : ModuleExpression . var PDL : ParameterDeclList . var PD : ParameterDecl . eq header2Qid(QI) = QI . eq header2Qid(nullHeader) = ' . eq header2Qid(pd(X :: ME)) = qidList2Qid(header2QidList(pd(X :: ME))) . eq header2QidList(pd(X :: ME)) = X ':: header2QidList(ME) . eq header2QidList(QI) = QI . eq header2QidList(nullHeader) = ' . eq header2Qid((ME { PDL })) = qidList2Qid(header2QidList((ME { PDL }))) . ceq header2QidList((ME { PDL })) = (if QI == '\s then QIL else QIL QI fi '`{ parameterDecl2QidList(PDL) '`} '\s) if QIL QI := header2QidList(ME) . eq parameterDecl2Qid(X :: ME) = qidList2Qid(X ':: header2Qid(ME)) . eq parameterDeclList2Qid(PDL) = qidList2Qid(parameterDeclList2QidList(PDL)) . eq parameterDeclList2QidList(X :: ME) = X ':: header2QidList(ME) . eq parameterDeclList2QidList((X :: ME, PDL)) = parameterDeclList2QidList(X :: ME) '`, parameterDeclList2QidList(PDL) [owise] . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** Modules *** *** We handle six different types of units: functional, system, and *** object-oriented modules, and functional, system, and object-oriented *** theories. Modules and theories of any kind are considered to be elements *** in specific subsorts of the sort \texttt{Module}. A constructor *** \texttt{error} is also included to represent incorrect units. *** \texttt{error} has a list of quoted identifiers as argument, which is *** used to report the error. Besides considering functional and system *** theories and object-oriented theories and modules, the declarations *** presented in the following module extend the declarations for sort *** \texttt{Module} in the \texttt{META-LEVEL} module in three different ways: *** \begin{itemize} *** \item the name of a module can be any term of sort \texttt{Header}, *** \item parameterized modules are handled, for which a list of *** parameters is added to the constructors of modules, *** \item the importation declaration is extended to module names, and *** \item parameterized sorts are supported. *** \end{itemize} ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod UNIT is pr EXT-DECL . pr O-O-DECL . pr MOD-NAME-TO-QID . inc META-LEVEL . op moduleName : Import -> ModuleName . eq moduleName(protecting MN .) = MN . eq moduleName(protecting ME{PL} .) = ME . eq moduleName(extending MN .) = MN . eq moduleName(extending ME{PL} .) = ME . eq moduleName(including MN .) = MN . eq moduleName(including ME{PL} .) = ME . op importError : QidList -> [ImportList] [ctor format (r o)] . eq importError(QIL) importError(QIL') = importError(QIL QIL') . sorts OModule OTheory . subsorts SModule < OModule < Module . subsorts STheory < OTheory < Module . op noModule : -> Module . *** Module op unitError : QidList -> [Module] [ctor format (r o)] . op omod_is_sorts_.________endom : Header ImportList SortSet SubsortDeclSet ClassDeclSet SubclassDeclSet OpDeclSet MsgDeclSet MembAxSet EquationSet RuleSet -> OModule [ctor gather (& & & & & & & & & & &) format (r! o r! n++io ni d d ni ni ni ni ni ni ni ni n--ir! o)] . op oth_is_sorts_.________endoth : Header ImportList SortSet SubsortDeclSet ClassDeclSet SubclassDeclSet OpDeclSet MsgDeclSet MembAxSet EquationSet RuleSet -> OTheory [ctor gather (& & & & & & & & & & &) format (r! o r! n++io ni d d ni ni ni ni ni ni ni ni n--ir! o)] . *** In addition to the constructor operators, the following functions are *** introduced in the \texttt{UNIT} module: *** \begin{itemize} *** \item A function \verb~_in_~ to check whether a given importation *** declaration is in a set of importation declarations or not. op _in_ : Import ImportList -> Bool . *** \item Selector functions for the different components of a Module. op getName : Module -> Header . op getPars : Module -> ParameterDeclList . op getClasses : Module -> ClassDeclSet . op getSubclasses : Module -> SubclassDeclSet . op getMsgs : Module -> MsgDeclSet . *** \item Functions to change the value of each of the components of a Module. op setName : Module ModuleExpression -> Module . op setName : Module ParameterDecl -> Module . op setPars : Module ParameterDeclList -> Module . op setImports : Module ImportList -> Module . op setSorts : Module SortSet -> Module . op setSubsorts : Module SubsortDeclSet -> Module . op setOps : Module OpDeclSet -> Module . op setMbs : Module MembAxSet -> Module . op setEqs : Module EquationSet -> Module . op setRls : Module RuleSet -> Module . op setClasses : Module ClassDeclSet -> Module . op setSubclasses : Module SubclassDeclSet -> Module . op setMsgs : Module MsgDeclSet -> Module . *** \item Functions to add new declarations to the set of declarations *** already in a unit. op addImports : ImportList Module -> Module . op addSorts : SortSet Module -> Module . op addSubsorts : [SubsortDeclSet] Module -> Module . op addOps : [OpDeclSet] Module -> Module . op addMbs : MembAxSet Module -> Module . op addEqs : EquationSet Module -> Module . op addRls : RuleSet Module -> Module . op addClasses : ClassDeclSet Module -> Module . op addSubclasses : SubclassDeclSet Module -> Module . op addMsgs : MsgDeclSet Module -> Module . *** \item There are functions and constants to create empty modules of the *** different types. For example, the function \texttt{emptyFTheory} *** returns an empty functional theory. There is also a *** function \texttt{empty} which takes a module as argument and returns *** an empty module of the same type. op emptyFModule : Header -> FModule . op emptyFModule : -> FModule . op emptySModule : -> SModule . op emptyOModule : -> OModule . op emptyFTheory : -> FModule . op emptySTheory : -> SModule . op emptyOTheory : -> OModule . op empty : Module -> Module . *** \item A function \texttt{addDecls} which returns the module resulting from *** adding all the declarations in the module passed as second argument *** to the module passed as first argument. op addDecls : Module Module -> Module . *** \end{itemize} *** Note that some of the `set' and `add' functions are partial functions. var M : Module . vars QI V : Qid . var S : Sort . vars SSDS SSDS' SSDS'' : SubsortDeclSet . vars OPD OPD' : OpDecl . vars OPDS OPDS' : OpDeclSet . var OPDS? : [OpDeclSet] . var At : Attr . vars MAS MAS' : MembAxSet . vars EqS EqS' : EquationSet . vars RlS RlS' : RuleSet . vars SS SS' : SortSet . vars IL IL' : ImportList . vars QIL QIL' : QidList . vars PL PL' : ParameterList . vars CDS CDS' : ClassDeclSet . vars SCD SCD' : SubclassDecl . vars SCDS SCDS' : SubclassDeclSet . vars U U' : Module . vars MDS MDS' : MsgDeclSet . vars I I' : Import . var T : Term . vars ME ME' : ModuleExpression . vars PD PD' : ParameterDecl . vars PDL PDL' : ParameterDeclList . var H : Header . vars MN MN' : ModuleName . eq I in (IL I IL') = true . eq I in IL = false [owise] . op eLeastSort : Module Term -> [Type] . eq eLeastSort(U, T) = leastSort(U, T) . eq eLeastSort(U, qidError(QIL)) = qidError(QIL) . op theory : Module -> Bool . eq theory(unitError(QIL)) = false . eq theory(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = false . eq theory(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = true . eq theory(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = false . eq theory(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) = true . eq theory(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = false . eq theory(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) = true . *** Selection functions for units eq getName(unitError(QIL)) = ' . eq getName(noModule) = ' . eq getName(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = ME . eq getName(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = ME . eq getName(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = MN . ----eq getName(th PD is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = PD . eq getName(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm) = ME . eq getName(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm) = ME . eq getName(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) = MN . eq getName( omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = ME . eq getName( omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = ME . eq getName( oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) = MN . eq getImports(unitError(QIL)) = nil . eq getImports(noModule) = nil . eq getImports(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = IL . eq getImports(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = IL . eq getImports(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = IL . eq getImports(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = IL . eq getImports( omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = IL . eq getImports( oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) = IL . eq getPars(unitError(QIL)) = nil . eq getPars(noModule) = nil . eq getPars(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = nil . eq getPars(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = PDL . eq getPars(mod nullHeader is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = nil . eq getPars(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = nil . eq getPars(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = nil . eq getPars(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm) = nil . eq getPars(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm) = PDL . eq getPars(fmod nullHeader is IL sorts SS . SSDS OPDS MAS EqS endfm) = nil . eq getPars(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) = nil . eq getPars( omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = nil . eq getPars( omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = PDL . eq getPars( omod nullHeader is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = nil . eq getPars( oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) = nil . eq getSorts(unitError(QIL)) = none . eq getSorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = SS . eq getSorts(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = SS . eq getSorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = SS . eq getSorts(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = SS . eq getSorts( omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = SS . eq getSorts( oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) = SS . op getAllSorts : Module -> SortSet . eq getAllSorts(M) = getSorts(M) . eq getSubsorts(unitError(QIL)) = none . eq getSubsorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = SSDS . eq getSubsorts(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = SSDS . eq getSubsorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = SSDS . eq getSubsorts(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = SSDS . eq getSubsorts( omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = SSDS . eq getSubsorts( oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) = SSDS . eq getOps(unitError(QIL)) = none . eq getOps(noModule) = none . eq getOps(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = OPDS . eq getOps(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = OPDS . eq getOps(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = OPDS . eq getOps(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = OPDS . eq getOps(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = OPDS . eq getOps(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) = OPDS . eq getMbs(unitError(QIL)) = none . eq getMbs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = MAS . eq getMbs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = MAS . eq getMbs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = MAS . eq getMbs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = MAS . eq getMbs(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = MAS . eq getMbs(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) = MAS . eq getEqs(unitError(QIL)) = none . eq getEqs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = EqS . eq getEqs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = EqS . eq getEqs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = EqS . eq getEqs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = EqS . eq getEqs(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = EqS . eq getEqs(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) = EqS . eq getRls(unitError(QIL)) = none . eq getRls(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = RlS . eq getRls(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = RlS . eq getRls(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none . eq getRls(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none . eq getRls(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = RlS . eq getRls(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) = RlS . eq getClasses(unitError(QIL)) = none . eq getClasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = none . eq getClasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = none . eq getClasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none . eq getClasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none . eq getClasses( omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = CDS . eq getClasses( oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) = CDS . eq getSubclasses(unitError(QIL)) = none . eq getSubclasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = none . eq getSubclasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = none . eq getSubclasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none . eq getSubclasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none . eq getSubclasses( omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = SCDS . eq getSubclasses( oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) = SCDS . eq getMsgs(unitError(QIL)) = none . eq getMsgs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = none . eq getMsgs(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = none . eq getMsgs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = none . eq getMsgs(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth) = none . eq getMsgs(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = MDS . eq getMsgs(oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) = MDS . *** Set functions eq setImports(unitError(QIL), IL) = unitError(QIL) . eq setImports(noModule, IL) = noModule . eq setImports(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, IL') = mod H is IL' sorts SS . SSDS OPDS MAS EqS RlS endm . eq setImports(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, IL') = th H is IL' sorts SS . SSDS OPDS MAS EqS RlS endth . eq setImports(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, IL') = fmod H is IL' sorts SS . SSDS OPDS MAS EqS endfm . eq setImports(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, IL') = fth H is IL' sorts SS . SSDS OPDS MAS EqS endfth . eq setImports( omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, IL') = omod H is IL' sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom . eq setImports( oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, IL') = oth H is IL' sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth . eq setOps(unitError(QIL), OPDS) = unitError(QIL) . eq setOps(noModule, OPDS) = noModule . eq setOps(U, opDeclError(QIL) OPDS) = unitError(QIL) . eq setOps(unitError(QIL), opDeclError(QIL') OPDS) = unitError(QIL QIL') . eq setOps(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, OPDS') = mod H is IL sorts SS . SSDS OPDS' MAS EqS RlS endm . eq setOps(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, OPDS') = th MN is IL sorts SS . SSDS OPDS' MAS EqS RlS endth . eq setOps(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, OPDS') = fmod H is IL sorts SS . SSDS OPDS' MAS EqS endfm . eq setOps(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, OPDS') = fth MN is IL sorts SS . SSDS OPDS' MAS EqS endfth . eq setOps(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, OPDS') = omod H is IL sorts SS . SSDS CDS SCDS OPDS' MDS MAS EqS RlS endom . eq setOps(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, OPDS') = oth MN is IL sorts SS . SSDS CDS SCDS OPDS' MDS MAS EqS RlS endoth . eq setSubsorts(unitError(QIL), SSDS) = unitError(QIL) . eq setSubsorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SSDS') = mod H is IL sorts SS . SSDS' OPDS MAS EqS RlS endm . eq setSubsorts(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, SSDS') = th MN is IL sorts SS . SSDS' OPDS MAS EqS RlS endth . eq setSubsorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, SSDS') = fmod H is IL sorts SS . SSDS' OPDS MAS EqS endfm . eq setSubsorts(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, SSDS') = fth MN is IL sorts SS . SSDS' OPDS MAS EqS endfth . eq setSubsorts( omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, SSDS') = omod H is IL sorts SS . SSDS' CDS SCDS OPDS MDS MAS EqS RlS endom . eq setSubsorts( oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, SSDS') = oth MN is IL sorts SS . SSDS' CDS SCDS OPDS MDS MAS EqS RlS endoth . eq setMbs(unitError(QIL), MAS) = unitError(QIL) . eq setMbs(U, membAxError(QIL) MAS) = unitError(QIL) . eq setMbs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, MAS') = mod H is IL sorts SS . SSDS OPDS MAS' EqS RlS endm . eq setMbs(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MAS') = th MN is IL sorts SS . SSDS OPDS MAS' EqS RlS endth . eq setMbs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, MAS') = fmod H is IL sorts SS . SSDS OPDS MAS' EqS endfm . eq setMbs(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, MAS') = fth MN is IL sorts SS . SSDS OPDS MAS' EqS endfth . eq setMbs( omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, MAS') = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS' EqS RlS endom . eq setMbs( oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, MAS') = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS' EqS RlS endoth . eq setEqs(unitError(QIL), EqS) = unitError(QIL) . eq setEqs(U, equationError(QIL) EqS?:[EquationSet]) = unitError(QIL) . eq setEqs(unitError(QIL), equationError(QIL') EqS?:[EquationSet]) = unitError(QIL QIL') . eq setEqs(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, EqS') = mod H is IL sorts SS . SSDS OPDS MAS EqS' RlS endm . eq setEqs(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, EqS') = th MN is IL sorts SS . SSDS OPDS MAS EqS' RlS endth . eq setEqs(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, EqS') = fmod H is IL sorts SS . SSDS OPDS MAS EqS' endfm . eq setEqs(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, EqS') = fth MN is IL sorts SS . SSDS OPDS MAS EqS' endfth . eq setEqs( omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, EqS') = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS' RlS endom . eq setEqs( oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, EqS') = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS' RlS endoth . op setRls : [Module] [RuleSet] -> [Module] . var U? : [Module] . var RlS? : [RuleSet] . eq setRls(unitError(QIL), RlS?) = unitError(QIL) . eq setRls(U?, ruleError(QIL) RlS?) = unitError(QIL) . eq setRls(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, RlS') = mod H is IL sorts SS . SSDS OPDS MAS EqS RlS' endm . eq setRls(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, RlS') = th MN is IL sorts SS . SSDS OPDS MAS EqS RlS' endth . eq setRls(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, RlS) = if RlS == none then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm else mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm fi . eq setRls(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, RlS) = if RlS == none then fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth else th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth fi . eq setRls(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, RlS') = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS' endom . eq setRls(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, RlS') = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS' endoth . eq setSorts(unitError(QIL), SS) = unitError(QIL) . eq setSorts(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SS') = mod H is IL sorts SS' . SSDS OPDS MAS EqS RlS endm . eq setSorts(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, SS') = th MN is IL sorts SS' . SSDS OPDS MAS EqS RlS endth . eq setSorts(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, SS') = fmod H is IL sorts SS' . SSDS OPDS MAS EqS endfm . eq setSorts(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, SS') = fth MN is IL sorts SS' . SSDS OPDS MAS EqS endfth . eq setSorts( omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, SS') = omod H is IL sorts SS' . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom . eq setSorts( oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, SS') = oth MN is IL sorts SS' . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth . eq setPars(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm, PDL) = if PDL == nil then mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm else mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm fi . eq setPars(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm, PDL') = if PDL' == nil then mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm else mod ME{PDL'} is IL sorts SS . SSDS OPDS MAS EqS RlS endm fi . eq setPars(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, PDL) = th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth . eq setPars(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm, PDL) = if PDL == nil then fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm else fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm fi . eq setPars(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm, PDL') = if PDL' == nil then fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm else fmod ME{PDL'} is IL sorts SS . SSDS OPDS MAS EqS endfm fi . eq setPars(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, PDL) = fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth . eq setPars( omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, PDL) = if PDL == nil then omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom else omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom fi . eq setPars( omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, PDL') = if PDL' == nil then omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom else omod ME{PDL'} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom fi . eq setPars( oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, PDL) = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth . eq setClasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, CDS) = if CDS == none then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm else omod H is IL sorts SS . SSDS CDS none OPDS none MAS EqS none endom fi . eq setClasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, CDS) = if CDS == none then fth H is IL sorts SS . SSDS OPDS MAS EqS endfth else oth H is IL sorts SS . SSDS CDS none OPDS none MAS EqS none endoth fi . eq setClasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, CDS) = if CDS == none then mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm else omod H is IL sorts SS . SSDS CDS none OPDS none MAS EqS RlS endom fi . eq setClasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, CDS) = if CDS == none then th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth else oth H is IL sorts SS . SSDS CDS none OPDS none MAS EqS RlS endoth fi . eq setClasses( omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, CDS') = omod H is IL sorts SS . SSDS CDS' SCDS OPDS MDS MAS EqS RlS endom . eq setClasses( oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, CDS') = oth H is IL sorts SS . SSDS CDS' SCDS OPDS MDS MAS EqS RlS endoth . eq setClasses(M, CDS) = unitError(header2QidList(getName(M)) 'not 'an 'object-oriented 'module) [owise] . eq setSubclasses(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, SCDS) = if SCDS == none then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm else omod H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS none endom fi . eq setSubclasses(fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, SCDS) = if SCDS == none then fth H is IL sorts SS . SSDS OPDS MAS EqS endfth else oth H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS none endoth fi . eq setSubclasses(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, SCDS) = if SCDS == none then mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm else omod H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS RlS endom fi . eq setSubclasses(th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, SCDS) = if SCDS == none then th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth else oth H is IL sorts SS . SSDS none SCDS OPDS none MAS EqS RlS endoth fi . eq setSubclasses( omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, SCDS') = omod H is IL sorts SS . SSDS CDS SCDS' OPDS MDS MAS EqS RlS endom . eq setSubclasses( oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, SCDS') = oth H is IL sorts SS . SSDS CDS SCDS' OPDS MDS MAS EqS RlS endoth . eq setSubclasses(M, SCDS) = unitError(header2QidList(getName(M)) 'not 'an 'object-oriented 'module) [owise] . eq setMsgs( fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, MDS) = if MDS == none then fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm else omod H is IL sorts SS . SSDS none none OPDS MDS MAS EqS none endom fi . eq setMsgs( fth H is IL sorts SS . SSDS OPDS MAS EqS endfth, MDS) = if MDS == none then fth H is IL sorts SS . SSDS OPDS MAS EqS endfth else oth H is IL sorts SS . SSDS none none OPDS MDS MAS EqS none endoth fi . eq setMsgs( mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, MDS) = if MDS == none then mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm else omod H is IL sorts SS . SSDS none none OPDS MDS MAS EqS RlS endom fi . eq setMsgs( th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MDS) = if MDS == none then th H is IL sorts SS . SSDS OPDS MAS EqS RlS endth else oth H is IL sorts SS . SSDS none none OPDS MDS MAS EqS RlS endoth fi . eq setMsgs( omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, MDS') = omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS' MAS EqS RlS endom . eq setMsgs( oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, MDS') = oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS' MAS EqS RlS endoth . eq setMsgs(M, MDS) = unitError(header2QidList(getName(M)) 'not 'an 'object-oriented 'module) [owise] . eq setName(mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm, ME') = mod ME' is IL sorts SS . SSDS OPDS MAS EqS RlS endm . eq setName(mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm, ME') = mod ME'{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm . eq setName(fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm, ME') = fmod ME' is IL sorts SS . SSDS OPDS MAS EqS endfm . eq setName(fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm, ME') = fmod ME'{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm . eq setName(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, MN') = fth MN' is IL sorts SS . SSDS OPDS MAS EqS endfth . eq setName(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MN') = th MN' is IL sorts SS . SSDS OPDS MAS EqS RlS endth . eq setName( omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, ME') = omod ME' is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom . eq setName( omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, ME') = omod ME'{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom . eq setName( oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, MN') = oth MN' is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth . eq setName(noModule, ME) = noModule . eq setName(unitError(QIL), ME) = unitError(QIL) . eq setName(mod nullHeader is IL sorts SS . SSDS OPDS MAS EqS RlS endm, ME') = mod ME' is IL sorts SS . SSDS OPDS MAS EqS RlS endm . eq setName(fmod nullHeader is IL sorts SS . SSDS OPDS MAS EqS endfm, ME') = fmod ME' is IL sorts SS . SSDS OPDS MAS EqS endfm . eq setName(fth nullHeader is IL sorts SS . SSDS OPDS MAS EqS endfth, MN) = fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth . eq setName(th nullHeader is IL sorts SS . SSDS OPDS MAS EqS RlS endth, MN) = th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth . eq setName( omod nullHeader is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, ME') = omod ME' is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom . eq setName( oth nullHeader is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, MN) = oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth . eq setName(noModule, ME) = noModule . eq setName(unitError(QIL), ME) = unitError(QIL) . *** Add functions eq addSorts(SS, U) = setSorts(U, (SS ; getSorts(U))) . eq addSubsorts(SSDS, U) = setSubsorts(U, (SSDS getSubsorts(U))) . eq addSubsorts(subsortDeclError(QIL), U) = unitError(QIL) . eq addOps(OPDS, U) = setOps(U, (OPDS getOps(U))) . eq addOps(OPDS?, unitError(QIL)) = unitError(QIL) . eq addOps(OPDS?, U) = U [owise] . eq addMbs(MAS, U) = setMbs(U, (MAS getMbs(U))) . eq addMbs(MAS, unitError(QIL)) = unitError(QIL) . eq addEqs(EqS, U) = setEqs(U, (EqS getEqs(U))) . eq addEqs(EqS, unitError(QIL)) = unitError(QIL) . eq addRls(RlS, U) = setRls(U, (RlS getRls(U))) . eq addRls(RlS, unitError(QIL)) = unitError(QIL) . eq addImports(IL, U) = setImports(U, (getImports(U) IL)) . eq addImports(IL, unitError(QIL)) = unitError(QIL) . eq addClasses(CDS, U) = setClasses(U, (getClasses(U) CDS)) . eq addClasses(CDS, unitError(QIL)) = unitError(QIL) . eq addSubclasses(SCDS, U) = setSubclasses(U, (getSubclasses(U) SCDS)) . eq addSubclasses(SCDS, unitError(QIL)) = unitError(QIL) . eq addMsgs(MDS, U) = setMsgs(U, (getMsgs(U) MDS)) . eq addMsgs(MDS, unitError(QIL)) = unitError(QIL) . *** Creation of empty units eq emptyFModule(ME) = fmod header2Qid(ME) is nil sorts none . none none none none endfm . eq emptyFModule = fmod nullHeader is nil sorts none . none none none none endfm . eq emptySModule = mod nullHeader is nil sorts none . none none none none none endm . eq emptyOModule = omod nullHeader is nil sorts none . none none none none none none none none endom . eq emptyFTheory = fth nullHeader is nil sorts none . none none none none endfth . eq emptySTheory = th nullHeader is nil sorts none . none none none none none endth . eq emptyOTheory = oth nullHeader is nil sorts none . none none none none none none none none endoth . *** \texttt{empty} returns an empty unit of the same type of the one given as *** argument. eq empty(mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = (mod H is nil sorts none . none none none none none endm) . eq empty(th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = (th MN is nil sorts none . none none none none none endth) . eq empty(fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm) = (fmod H is nil sorts none . none none none none endfm) . eq empty(fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) = (fth MN is nil sorts none . none none none none endfth) . eq empty(omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = (omod H is nil sorts none . none none none none none none none none endom) . eq empty(oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) = (oth MN is nil sorts none . none none none none none none none none endoth) . *** In the following \texttt{addDecls} function, the declarations of the unit *** given as second argument are added to the unit given as first argument. eq addDecls(noModule, U) = U . eq addDecls(U, noModule) = U . eq addDecls(unitError(QIL), U) = unitError(QIL) . eq addDecls(U, unitError(QIL)) = unitError(QIL) . eq addDecls(U, U') = addImports(getImports(U'), addSorts(getSorts(U'), addSubsorts(getSubsorts(U'), addOps(getOps(U'), addMbs(getMbs(U'), addEqs(getEqs(U'), if U' :: FModule or U' :: FTheory then U else addRls(getRls(U'), if U' :: SModule or U' :: STheory then U else addClasses(getClasses(U'), addSubclasses(getSubclasses(U'), addMsgs(getMsgs(U'), U))) fi) fi)))))) [owise] . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** The Abstract Data Type \texttt{View} *** *** In this section we present the data type \texttt{View} for views. *** Basically, the data elements of sort \texttt{View} are composed by the *** name of the view, the names of the source and target units, and a set of *** maps representing the maps asserting how the given target unit is claimed *** to satisfy the source theory (see Section~\ref{Views}). *** Internally, renaming maps are considered to be a particular case of view *** maps. The sort \texttt{ViewMap} is declared as a supersort of *** \texttt{Map}. The only kind of maps in sort \texttt{ViewMap} not in sort *** \texttt{Map} are maps of operators going to derived operators. We start *** introducing the declarations for renaming maps and sTS of renaming maps *** in Section~\ref{renaming-maps}, we then introduce view maps and sTS of *** view maps in Section~\ref{view-maps}, and finally we introduce the sort *** \texttt{View}, its constructor, and some operations on it in *** Section~\ref{viewADT}. *** *** View Maps *** *** In addition to the maps of sort \texttt{Renaming}, *** in views there can also be maps from operators to derived *** operators, that is, terms with variables (see Section~\ref{Views}). Maps *** of this kind are given with the constructor \texttt{termMap}, which, in *** addition to the source and target terms, takes the set of variable *** declarations for the variables used in the map. The source term must be of *** the form $\texttt{F(X}_1\texttt{,}\ldots,\texttt{X}_n\texttt{)}$, where *** \texttt{F} is an operator name declared with $n$ arguments of sorts in the *** connected components of the variables $\texttt{X}_1\ldots\texttt{X}_n$, *** respectively. We will see in Section~\ref{view-processing} how in the *** initial processing of a view the variables declared in it are associated *** to each of the maps in which they are used. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod VIEW-MAP is pr FMAP . pr EXT-DECL . op termMap : Term Term -> ViewMap . sorts ViewMap Set{ViewMap} . subsorts Renaming < ViewMap . subsorts ViewMap RenamingSet < Set{ViewMap} . op _`,_ : Set{ViewMap} Set{ViewMap} -> Set{ViewMap} [ditto] . eq (VMAP, none) = VMAP . eq (VMAP, VMAP) = VMAP . var MAP : Renaming . var VMAP : ViewMap . var VMAPS : Set{ViewMap} . vars T T' : Term . vars S S' : Sort . *** As for sTS of maps, \texttt{SortRenamingSet} returns the subset of sort *** maps in a set of view maps. op sortMaps : Set{ViewMap} -> RenamingSet . eq sortMaps((sort S to S')) = (sort S to S') . eq sortMaps(((sort S to S'), VMAPS)) = ((sort S to S'), sortMaps(VMAPS)) . eq sortMaps(VMAP) = none [owise] . eq sortMaps((VMAP, VMAPS)) = none [owise] . eq sortMaps(none) = none . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** Views *** *** The \texttt{View} sort is introduced in the following module *** \texttt{VIEW}. In addition to the constructor for views (\texttt{view}), *** selector functions are added for each of the components of a *** view (\texttt{name}, \texttt{source}, \texttt{target}, and *** \texttt{mapSet}), and a constant \texttt{emptyView}, which is identified *** in an equation with the empty view, is defined. *** Although the declaration of the constructor for views includes an argument *** for the list of parameters, parameterized views are not handled yet, so at *** present this argument must be set to the \texttt{nil}. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod VIEW is pr META-MODULE . pr VIEW-EXPR . pr VIEW-MAP . sorts View ViewHeader . subsort ViewExp Header < ViewHeader . op view_from_to_is_endv : ViewHeader ModuleExpression ModuleExpression Set{ViewMap} -> View [ctor format (nir! o r! o r! o r! o r! o)] . op null : -> View [ctor] . op viewError : QidList -> [View] [ctor format (r o)] . eq VE{(nil).ParameterDeclList} = VE . var QI : Qid . vars VE VE' : ViewExp . vars PDL PDL' : ParameterDeclList . vars ME ME' ME'' : ModuleExpression . vars VMAPS VMAPS' : Set{ViewMap} . var QIL : QidList . var VH : ViewHeader . op name : View -> ViewExp . op getPars : [View] -> ParameterDeclList . op source : View -> ModuleExpression . op target : View -> ModuleExpression . op mapSet : View -> RenamingSet . eq name(view VE from ME to ME' is VMAPS endv) = VE . eq name(view VE{PDL} from ME to ME' is VMAPS endv) = VE . eq getPars(view VE from ME to ME' is VMAPS endv) = nil . eq getPars(view VE{PDL} from ME to ME' is VMAPS endv) = PDL . eq getPars(viewError(QIL)) = nil . eq source(view VH from ME to ME' is VMAPS endv) = ME . eq target(view VH from ME to ME' is VMAPS endv) = ME' . eq mapSet(view VH from ME to ME' is VMAPS endv) = VMAPS . op setName : View ViewExp ~> View . op setPars : View ParameterDeclList ~> View . op setTarget : View ModuleExpression ~> View . op sTSource : View ModuleExpression ~> View . op setMaps : View RenamingSet ~> View . eq setName(view VE from ME to ME' is VMAPS endv, VE') = view VE' from ME to ME' is VMAPS endv . eq setName(view VE{PDL} from ME to ME' is VMAPS endv, VE') = view VE'{PDL} from ME to ME' is VMAPS endv . eq setName(viewError(QIL), VE) = viewError(QIL) . eq setPars(view VE from ME to ME' is VMAPS endv, PDL) = view VE{PDL} from ME to ME' is VMAPS endv . eq setPars(view VE{PDL} from ME to ME' is VMAPS endv, PDL') = view VE{PDL'} from ME to ME' is VMAPS endv . eq setPars(viewError(QIL), PDL) = viewError(QIL) . eq sTSource(view VH from ME to ME' is VMAPS endv, ME'') = view VH from ME'' to ME' is VMAPS endv . eq sTSource(viewError(QIL), ME) = viewError(QIL) . eq setTarget(view VH from ME to ME' is VMAPS endv, ME'') = view VH from ME to ME'' is VMAPS endv . eq setTarget(viewError(QIL), ME) = viewError(QIL) . eq setMaps(view VH from ME to ME' is VMAPS endv, VMAPS') = view VH from ME to ME' is VMAPS' endv . eq setMaps(viewError(QIL), VMAPS) = viewError(QIL) . op emptyView : Qid ModuleExpression ModuleExpression -> View . eq emptyView(QI, ME, ME') = view QI from ME to ME' is none endv . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** The Abstract Data Type \texttt{Database} *** *** In this section we present the data type \texttt{Database}, which will be *** used to store information about the units and views in the system. Before *** discussing this data type in Section~\ref{databaseADT}, we present the *** predefined units added in Full Maude to those already available in Core *** Maude. *** *** Non-Built-In Predefined Modules *** *** As we shall see in the following section, except for the *** \texttt{LOOP-MODE} module, all the predefined modules that are available *** in Core Maude are also available in Full Maude. In addition to these Core *** Maude predefined modules, in Full Maude there are some additional *** predefined units. In the present system, the only units with which the *** database is initialized are the functional theory \texttt{TRIV}, the *** module \texttt{CONFIGURATION}, and the module \texttt{UP}, which will be *** used to evaluate the \texttt{up} functions. We shall see in *** Section~\ref{main-module} how new predefined modules can be added to the *** initial database. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod PREDEF-UNITS is pr UNIT . op CONFIGURATION+ : -> SModule [memo] . eq CONFIGURATION+ = (mod 'CONFIGURATION+ is including 'CONFIGURATION . sorts none . none op '<_:_|`> : 'Oid 'Cid -> 'Object [none] . op 'class : 'Object -> 'Cid [none] . none --- Real-Time Maude comment: --- The following equation has been commented away, since --- it leads to nontermination for empty classes. --- RTM eq '<_:_|`>['O:Oid, 'C:Cid] --- RTM = '<_:_|_>['O:Oid, 'C:Cid, 'none.AttributeSet] --- RTM [none] . eq 'class['<_:_|_>['O:Oid, 'C:Cid, 'A:AttributeSet]] = '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 : -> FModule [memo] . eq UP = (fmod 'UP is including 'QID-LIST . including 'MOD-EXPRS . sorts none . none op 'upTerm : '@ModExp@ '@Bubble@ -> 'Term [none] . op 'upModule : '@ModExp@ -> 'Module [none] . op '`[_`] : '@Token@ -> 'Module [none] . op 'token : 'Qid -> '@Token@ [special( (id-hook('Bubble, '1 '1) op-hook('qidSymbol, ', 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 'poly 'memo 'memoization 'iter 'frozen 'config 'object 'msg)))] . op 'neTokenList : 'QidList -> '@NeTokenList@ [special( (id-hook('Bubble, '1 '-1 '`( '`)) op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList) op-hook('qidSymbol, ', 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 ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** 7 The Evaluation of Views *** *** Before being entered into the database, besides containing bubbles, views *** have a somewhat different structure from that of the views given in *** Section~\ref{viewADT}. We introduce in the following module a sort *** \texttt{PreView} with constructor \texttt{view}, which is declared as the *** constructor for views of sort \texttt{View}, but with an additional *** argument, namely, a set of variable declarations to hold the declarations *** of variables in the view. During the processing of views (see *** Section~\ref{view-processing}), which takes place once the parsing process *** has concluded, these variables are associated with the corresponding maps *** where they are used, generating a term of sort \texttt{View}. *** We start by introducing in the following module \texttt{PRE-VIEW-MAP} the *** sorts \texttt{TermPreMap}, \texttt{PreViewMap}, and *** \texttt{Set{PreViewMap}}. A preview map is a view map with bubbles. Note *** that the bubbles can only appear in term maps. Elements of sort *** \texttt{TermPreMap} are built with the constructor \texttt{preTermMap}, *** which takes two terms of sort \texttt{Term}, that is, two bubbles. In the *** processing of views (see Section~\ref{view-processing}), elements of sort *** \texttt{PreTermMap} will be converted into elements of sort *** \texttt{TermMap} by parsing the bubbles in them, and by associating to *** them the variables in them defined in the view in which the maps appear. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod PRE-VIEW-MAP is pr VIEW-MAP . sort PreViewMap . subsorts Renaming < PreViewMap . op preTermMap : Term Term -> PreViewMap . sort Set{PreViewMap} . subsorts PreViewMap RenamingSet < Set{PreViewMap} . op _`,_ : Set{PreViewMap} Set{PreViewMap} -> Set{PreViewMap} [ditto] . eq (PVMAPS, none) = PVMAPS . var PVMAP : PreViewMap . var PVMAPS : Set{PreViewMap} . vars S S' : Sort . *** Given a set of maps, the function \texttt{sortMaps} returns the subset *** of sort maps in it. op sortMaps : Set{PreViewMap} -> RenamingSet . eq sortMaps(((sort S to S'), PVMAPS)) = ((sort S to S'), sortMaps(PVMAPS)) . eq sortMaps((PVMAP, PVMAPS)) = none [owise] . eq sortMaps(none) = none . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod PRE-VIEW is pr VIEW . pr PRE-VIEW-MAP . sort PreView . op preview_from_to_is__endpv : ViewHeader ModuleExpression ModuleExpression OpDeclSet Set{PreViewMap} -> PreView [ctor format (nir! o r! o r! o r! o o r! o)] . op null : -> PreView . op name : PreView -> ViewExp . op getPars : PreView -> ParameterDeclList . op source : PreView -> ModuleExpression . op target : PreView -> ModuleExpression . op vars : PreView -> OpDeclSet . op mapSet : PreView -> Set{PreViewMap} . var QI : Qid . vars ME ME' : ModuleExpression . var VE : ViewExp . var VH : ViewHeader . vars PDL PDL' : ParameterDeclList . vars VDS VDS' : OpDeclSet . vars PVMAPS PVMAPS' : Set{PreViewMap} . eq name(preview VE from ME to ME' is VDS PVMAPS endpv) = VE . eq name(preview VE{PDL} from ME to ME' is VDS PVMAPS endpv) = VE . eq getPars(preview VE from ME to ME' is VDS PVMAPS endpv) = nil . eq getPars(preview VE{PDL} from ME to ME' is VDS PVMAPS endpv) = PDL . eq source(preview VH from ME to ME' is VDS PVMAPS endpv) = ME . eq target(preview VH from ME to ME' is VDS PVMAPS endpv) = ME' . eq vars(preview VH from ME to ME' is VDS PVMAPS endpv) = VDS . eq mapSet(preview VH from ME to ME' is VDS PVMAPS endpv) = PVMAPS . *** The following functions can be used to add new declarations to the set of *** declarations already in a preview. op addMaps : Set{PreViewMap} PreView -> PreView . op addVars : OpDeclSet PreView -> PreView . eq addMaps(PVMAPS, preview VH from ME to ME' is VDS PVMAPS' endpv) = preview VH from ME to ME' is VDS (PVMAPS, PVMAPS') endpv . eq addVars(VDS, preview VH from ME to ME' is VDS' PVMAPS' endpv) = preview VH from ME to ME' is (VDS VDS') PVMAPS' endpv . op setPars : PreView ParameterDeclList -> PreView . eq setPars(preview VE from ME to ME' is VDS PVMAPS endpv, PDL) = preview VE{PDL} from ME to ME' is VDS PVMAPS endpv . eq setPars(preview VE{PDL} from ME to ME' is VDS PVMAPS endpv, PDL') = preview VE{PDL'} from ME to ME' is VDS PVMAPS endpv . op emptyPreView : Qid ModuleExpression ModuleExpression -> PreView . eq emptyPreView(QI, ME, ME') = preview QI from ME to ME' is none none endpv . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** The Database *** *** In order to be able to refer to modules by name, which is extremely useful *** for module definition purposes at the user level, the evaluation of module *** expressions takes place in the context of a database, in which we keep *** information about the modules already introduced in the system, and also *** about those modules generated internally. This information is stored as *** a set of elements of sort \texttt{ModuleInfo} and \texttt{ViewInfo}, in *** which we hold, respectively, the information concerning units and views. *** For each unit we save: *** \begin{itemize} *** \item Its original form, as introduced by the user, or, in case of an *** internally generated unit, as generated from the original form of *** some other unit. *** \item Its internal representation, in which variables have been renamed *** to avoid collisions with the names of variables in other units in *** the same hierarchy. In the case of object-oriented units, we store *** its equivalent system module, that is, the result of transforming *** it into a system module. *** \item Its signature, which is given as a functional module of sort *** \texttt{FModule} with no axioms, ready to be used in calls to *** \texttt{metaParse}. There can only be importation declarations *** including built-in modules in this module. These are the only *** inclusions handled by the Core Maude engine. *** \item Its flattened version, for which, as for signatures, only the *** importation of built-in modules is left unevaluated. *** \end{itemize} *** For each view we keep its name and the view itself. *** As a simple mechanism to keep the database consistent, for each unit we *** maintain the list of names of all the units and views ``depending'' on it. *** Similarly, for each view we maintain the list of names of all the units *** ``depending'' on it. The idea is that if a unit or view is redefined or *** removed, all those units and/or views depending on it will also be *** removed. This dependency does not only mean direct importation. For *** example, the module resulting from the renaming of some module also *** depends on the module being renamed; the instantiation of a parameterized *** module also depends on the parameterized module and on all the views used *** in its instantiation; a view depends on its source and target units, etc. *** This dependency is transitive: if a module, theory, or view has to be *** removed, all the units and/or views depending on them will be removed as *** well. The dependencies derived from the module expressions themselves are *** established by the function \texttt{setUpModExpDeps}. The function *** \texttt{setUpModuleDeps} calls \texttt{setUpModExpDeps}, *** and then \texttt{setUpImportSetDeps} to add the \emph{back *** references} in the modules being imported. The function *** \texttt{setUpViewDeps} sTS up the back references for the views *** being introduced. *** In addition to this set of information cells for units and views, we also *** keep lists with the names of all the units and views in the database, and *** a list of quoted identifiers in which we store the messages generated *** during the process of treatment of the inputs in order to simplify the *** communication with the read-eval-print loop process. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod 2TUPLE{X :: TRIV, Y :: TRIV} is sorts Tuple{X, Y} . op `(_`,_`) : X$Elt Y$Elt -> Tuple{X, Y} . op p1_ : Tuple{X, Y} -> X$Elt . op p2_ : Tuple{X, Y} -> Y$Elt . eq p1(V1:X$Elt,V2:Y$Elt) = V1:X$Elt . eq p2(V1:X$Elt,V2:Y$Elt) = V2:Y$Elt . endfm view ModuleName from TRIV to MOD-NAME is sort Elt to ModuleName . endv view ViewExp from TRIV to VIEW-EXPR is sort Elt to ViewExp . endv view ParameterDecl from TRIV to META-MODULE is sort Elt to ParameterDecl . endv fmod INFO is pr VIEW . pr DEFAULT-VALUE{Term} . pr (SET * (op _`,_ to _._, op empty to emptyModuleNameSet, op insert to insertModuleNameSet, op delete to deleteModuleNameSet, op _in_ to _inModuleNameSet_, op |_| to |_|ModuleNameSet, op $card to $cardModuleNameSet, op union to unionModuleNameSet, op intersection to intersectionModuleNameSet, op $intersect to $intersectModuleNameSet, op _\_ to _\ModuleNameSet_, op $diff to $diffModuleNameSet)){ModuleName} . pr (SET * (op _`,_ to _#_, op empty to emptyViewExpSet, op insert to insertViewExpSet, op delete to deleteViewExpSet, op _in_ to _inViewExpSet_, op |_| to |_|ViewExprSet, op $card to $cardViewExprSet, op union to unionViewExprSet, op intersection to intersectionViewExprSet, op $intersect to $intersectViewExprSet, op _\_ to _\ViewExprSet_, op $diff to $diffViewExprSet)){ViewExp} . pr (SET * (op _`,_ to _._)){ParameterDecl} . sort ModuleInfo . op <_;_;_;_;_;_;_;_> : ModuleName Default{Term} Module Module Module OpDeclSet Set{ModuleName} Set{ViewExp} -> ModuleInfo [ctor format (nig o g n+++io g nio g nio g nio g nio g nio g nio n---ig o)] . op <_;_;_;_;_;_;_;_> : ModuleName Module Module Module Module OpDeclSet Set{ModuleName} Set{ViewExp} -> ModuleInfo [ctor format (nig ur! g n+++io g nio g nio g nio g nio g nio g nio n---ig o)] . *** - Modules can be introduced by the user or can be generated internally. *** When introduced by the user the 2nd arg. keeps the term representation *** of the module as given, so that it can be recompiled later. If the *** module is generated internally as the result of the evaluation of a *** module expression, then this second arg. will be null, the default *** term value. The user can also enter modules with the procModule *** function, providing then the metarepresentation of a module, which *** is directly stored in the database as the 2nd arg. of one of these *** ModuleInfo units of the second kind. This is useful for the ITP for *** example, where the interaction with the database takes place at the *** metalevel and the modules given by the "user" are already at the *** metalevel but still wants the same treatment. *** - The sixth arg. stores the variables (corresponding ops.) in the top *** module. sort ViewInfo . op <_;_;_;_;_> : ViewExp Default{Term} View Set{ModuleName} Set{ViewExp} -> ViewInfo [ctor format (nig o g n+++io g nio g nio g nio n---ig o)] . op <_;_;_;_;_> : ViewExp View View Set{ModuleName} Set{ViewExp} -> ViewInfo [ctor format (nig o g n+++io g nio g nio g nio n---ig o)] . endfm view ModuleInfo from TRIV to INFO is sort Elt to ModuleInfo . endv view ViewInfo from TRIV to INFO is sort Elt to ViewInfo . endv fmod DATABASE-DECLS is pr (SET * (op _`,_ to __, op empty to emptyInfoSet)){ModuleInfo} . pr (SET * (op _`,_ to __, op empty to emptyInfoSet)){ViewInfo} . sort Database . op db : Set{ModuleInfo} *** module info tuples Set{ModuleName} *** names of the modules in the database Set{ViewInfo} *** view info tuples Set{ViewExp} *** names of the views in the db Set{ModuleName} *** modules with set protect on (by default empty) Set{ModuleName} *** modules with set extend on (by default empty) Set{ModuleName} *** modules with set include on (by default empty) QidList -> Database [ctor format (nib i++o)] . ops getDefPrs getDefExs getDefIncs : Database -> Set{ModuleName} . eq getDefPrs( db(MIS:Set{ModuleInfo}, MNS:Set{ModuleName}, VIS:Set{ViewInfo}, VES:Set{ViewExp}, MNS':Set{ModuleName}, MNS'':Set{ModuleName}, MNS3:Set{ModuleName}, QIL:QidList)) = MNS':Set{ModuleName} . eq getDefExs( db(MIS:Set{ModuleInfo}, MNS:Set{ModuleName}, VIS:Set{ViewInfo}, VES:Set{ViewExp}, MNS':Set{ModuleName}, MNS'':Set{ModuleName}, MNS3:Set{ModuleName}, QIL:QidList)) = MNS'':Set{ModuleName} . eq getDefIncs( db(MIS:Set{ModuleInfo}, MNS:Set{ModuleName}, VIS:Set{ViewInfo}, VES:Set{ViewExp}, MNS':Set{ModuleName}, MNS'':Set{ModuleName}, MNS3:Set{ModuleName}, QIL:QidList)) = MNS3:Set{ModuleName} . endfm view Database from TRIV to DATABASE-DECLS is sort Elt to Database . endv view ModuleExpression from TRIV to META-MODULE is sort Elt to ModuleExpression . endv fmod DATABASE is pr (2TUPLE * (op `(_`,_`) to <_;_>, op p1_ to database, op p2_ to modExp)) {Database, ModuleExpression} . pr PRE-VIEW . pr UNIT . pr VIEW-EXPR-TO-QID . op evalModule : Module OpDeclSet Database -> Database . *** its definition is in the module EVALUATION op procModule : Qid Database -> Database . op procView : Qid Database -> Database . *** their definitions are in the modules UNIT-PROCESSING and VIEW-PROCESSING op evalModExp : ModuleExpression Database -> Tuple{Database, ModuleExpression} . *** its definition is in the module MOD-EXPR-EVAL vars QI X Y F : Qid . vars QIL QIL' : QidList . vars VE VE' VE'' : ViewExp . vars VES VES' VES'' VES3 : Set{ViewExp} . vars MIS MIS' : Set{ModuleInfo} . var VIS : Set{ViewInfo} . vars MNS MNS' MNS'' MNS3 MNS4 MNS5 MNS6 : Set{ModuleName} . vars PL PL' : ParameterList . vars PDS PDS' PDS'' : Set{ParameterDecl} . var PDL : ParameterDeclList . var PD : ParameterDecl . vars ME ME' : ModuleExpression . vars VI VI' : View . var VMAPS : Set{ViewMap} . var PVMAPS : Set{PreViewMap} . vars PU PU' U U' U'' U3 U4 : Module . var M : Module . var DB : Database . vars IL IL' : ImportList . var VIf : ViewInfo . var UIf : ModuleInfo . vars OPDS VDS VDS' : OpDeclSet . var PV : PreView . vars T T' : Term . var DT : Default{Term} . var NL : IntList . var TyL : TypeList . var Ty : Type . var AtS : AttrSet . var B : Bool . var I : Import . var MN MN' : ModuleName . ops dincluded : ModuleExpression ImportList -> Bool . eq dincluded(ME, IL (protecting ME .) IL') = true . eq dincluded(ME, IL (extending ME .) IL') = true . eq dincluded(ME, IL (including ME .) IL') = true . eq dincluded(ME, IL) = false [owise] . ops included includedAux : ModuleExpression ImportList Database -> Bool . eq included(ME, IL (protecting ME .) IL', DB) = true . eq included(ME, IL (extending ME .) IL', DB) = true . eq included(ME, IL (including ME .) IL', DB) = true . eq included(ME, nil, DB) = false . eq included(ME, IL, DB) = includedAux(ME, IL, DB) [owise] . eq includedAux(ME, I IL, DB) = included(ME, getImports(getTopModule(moduleName(I), DB)), DB) or-else includedAux(ME, IL, DB) . eq includedAux(ME, nil, DB) = false . op defImports : Module Database -> ImportList . op defImports : ImportList ImportList Set{ModuleName} Set{ModuleName} Set{ModuleName} -> ImportList . eq defImports(M, DB) = if theory(M) then nil else defImports(getImports(M), nil, getDefPrs(DB), getDefExs(DB), getDefIncs(DB)) fi . eq defImports(IL, IL', MN . MNS, MNS', MNS'') = if dincluded(MN, IL IL') then defImports(IL, IL', MNS, MNS', MNS'') else defImports(IL, IL' (protecting MN .), MNS, MNS', MNS'') fi . eq defImports(IL, IL', MNS, MN . MNS', MNS'') = if dincluded(MN, IL IL') then defImports(IL, IL', MNS, MNS', MNS'') else defImports(IL, IL' (extending MN .), MNS, MNS', MNS'') fi . eq defImports(IL, IL', MNS, MNS', MN . MNS'') = if dincluded(MN, IL IL') then defImports(IL, IL', MNS, MNS', MNS'') else defImports(IL, IL' (including MN .), MNS, MNS', MNS'') fi . eq defImports(IL, IL', emptyModuleNameSet, emptyModuleNameSet, emptyModuleNameSet) = IL' . *** The constant \texttt{emptyDatabase} denotes the empty database, and there *** are predicates \texttt{viewInDatabase} and \texttt{unitInDb} to check, *** respectively, whether a view and a unit are in a database or not. op emptyDatabase : -> Database . eq emptyDatabase = db(emptyInfoSet, emptyModuleNameSet, emptyInfoSet, emptyViewExpSet, 'BOOL, emptyModuleNameSet, emptyModuleNameSet, nil) . op unitInDb : ModuleName Database -> Bool . eq unitInDb(MN, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) = MN inModuleNameSet MNS . op viewInDb : ViewExp Database -> Bool . eq viewInDb(VE, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) = VE inViewExpSet VES . op includeBOOL : Database -> Bool . eq includeBOOL(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) = 'BOOL inModuleNameSet MNS' . *** If a module, theory, or view is being redefined, that is, if there was *** already in the database a module, theory, or view with the same name, *** then all the units and/or views depending on it are removed using the *** functions \texttt{delModules} and \texttt{delViews}. Removing a view *** or a unit from the database means removing its info cell from the set of *** cells in the database. Those entered by the user are not completely *** removed, their term form is saved so that it can be recompiled later. op delModules : Set{ModuleName} Database -> Database . op delViews : Set{ViewExp} Database -> Database . eq delModules((MN . MNS), db(< MN ; T ; U ; U' ; U'' ; VDS ; MNS' ; VES > MIS, MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL)) = delModules((MNS . MNS'), delViews(VES, db(< MN ; T ; noModule ; noModule ; noModule ; VDS ; emptyModuleNameSet ; emptyViewExpSet > MIS, MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))) . eq delModules((MN . MNS), db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS' ; VES > MIS, MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL)) = delModules((MNS . MNS'), delViews(VES, db(< MN ; U ; noModule ; noModule ; noModule ; VDS ; emptyModuleNameSet ; emptyViewExpSet > MIS, MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))) . eq delModules((MN . MNS), db(< MN ; null ; U ; U' ; U'' ; VDS ; MNS' ; VES > MIS, MN . MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL)) = delModules((MNS . MNS'), delViews(VES, db(MIS, MNS'', VIS, VES', MNS3, MNS4, MNS5, QIL))) . eq delModules(emptyModuleNameSet, DB) = DB . eq delModules((MN . MNS), DB) = delModules(MNS, DB) [owise] . eq delViews(VE # VES, db(MIS, MNS, < VE ; T ; VI ; MNS' ; VES' > VIS, VE # VES'', MNS'', MNS3, MNS4, QIL)) = delViews(VES # VES', delModules(MNS', db(MIS, MNS, < VE ; T ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS, VE # VES'', MNS'', MNS3, MNS4, QIL))) . eq delViews(VE # VES, db(MIS, MNS, < VE ; (null).Default{Term} ; VI ; MNS' ; VES' > VIS, VE # VES'', MNS'', MNS3, MNS4, QIL)) = delViews(VES # VES', delModules(MNS', db(MIS, MNS, VIS, VES'', MNS'', MNS3, MNS4, QIL))) . eq delViews(VE # VES, db(MIS, MNS, < VE ; VI ; VI' ; MNS' ; VES' > VIS, VE # VES'', MNS'', MNS3, MNS4, QIL)) = delViews(VES # VES', delModules(MNS', db(MIS, MNS, < VE ; VI ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS, VE # VES'', MNS'', MNS3, MNS4, QIL))) . eq delViews(emptyViewExpSet, DB) = DB . eq delViews(VE # VES, DB) = delViews(VES, DB) [owise] . *** The \texttt{warning} function allows us to place messages (warning, error, *** or any other kind of messages) in the last argument of the database *** constructor. These messages are given in the form of quoted identifier *** lists, and will be passed to the third argument of the read-eval-print *** loop, to be printed in the terminal. op warning : Database QidList -> Database . eq warning(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL), QIL') = if QIL == nil then db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL') else db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL QIL') fi . op getMsg : Database -> QidList . eq getMsg(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) = QIL . *** Core Maude built-in modules are handled in a special way in the current *** version of the system. They are not explicitly defined in the Full Maude *** database; their importation is directly handled by Core Maude. This has *** some drawbacks: Core Maude built-in modules cannot be renamed; they cannot *** be directly used with built-in functions, such as \texttt{metaReduce} or *** \texttt{sameComponent}, although they can be imported in modules being *** used in the calls to these functions; and, in general, any function taking *** as argument or returning as result the metarepresentation of a module *** cannot take one of these built-in modules as argument. This is the case, *** for example, for the \texttt{up} function presented in *** Section~\ref{changing-levels}, or for functions or commands in which the *** name of a module has to be specified, as the \texttt{select} or *** \texttt{down} commands, or the \texttt{up} function presented in *** Section~\ref{structured-specifications}. Nevertheless, there are also *** some advantages: The flattening of the built-in part of the structure is *** accomplished more efficiently, and, since these modules do not have to be *** stored in the database of Full Maude, the size of the database is reduced. *** Our plan is to have in the future a hybrid solution. Once we have some way *** of storing the modules entered to Full Maude in Core Maude's database, it *** will be enough to keep in the Full Maude database just the original form *** of the top of all the modules, including built-ins, leaving all the *** importation declarations to be resolved by the engine. The structures will *** be normalized as they are now, so that the engine will have to deal just *** with inclusions, but it will be possible to use the predefined modules as *** any other module. Moreover, the Full Maude database will be relatively *** smaller and the flattening will be computed more efficiently. *** When a new module or theory is entered, the names of all the modules, *** theories, and views depending on it are included in its lists of *** dependencies with functions \texttt{setUpModuleDeps} and *** \texttt{setUpViewDeps}. Notice that if new module expressions are *** defined, the function \texttt{setUpModExpDeps} will have to be *** extended accordingly. op setUpModuleDeps : Module Database -> Database . op setUpModExpDeps : ModuleName Database -> Database . op setUpModExpDeps : ModuleName Header Database -> Database . op setUpModExpDeps : ModuleName ViewExp Database -> Database . op setUpImportDeps : ModuleName ImportList Database -> Database . eq setUpModuleDeps(U, DB) = setUpImportDeps(getName(U), getImports(U), setUpModExpDeps(getName(U), DB)) . eq setUpModExpDeps(QI, DB) = DB . eq setUpModExpDeps(pd(X :: ME), db(< ME ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = db(< ME ; DT ; U ; U' ; U'' ; VDS ; (MNS . pd(X :: ME)) ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . eq setUpModExpDeps(pd(X :: ME), db(< ME ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = db(< ME ; U ; U' ; U'' ; U3 ; VDS ; (MNS . pd(X :: ME)) ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . eq setUpModExpDeps(pd(X :: ME), DB) = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n)) [owise] . eq setUpImportDeps(MN, ((including MN' .) IL), db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpImportDeps(MN, IL, db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq setUpImportDeps(MN, ((including MN' .) IL), db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpImportDeps(MN, IL, db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq setUpImportDeps(MN, ((extending MN' .) IL), db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpImportDeps(MN, IL, db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq setUpImportDeps(MN, ((extending MN' .) IL), db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpImportDeps(MN, IL, db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq setUpImportDeps(MN, ((protecting MN' .) IL), db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpImportDeps(MN, IL, db((< MN' ; DT ; U ; U' ; U'' ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq setUpImportDeps(MN, ((protecting MN' .) IL), db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpImportDeps(MN, IL, db((< MN' ; U ; U' ; U'' ; U3 ; VDS ; MN . MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq setUpImportDeps(MN, I IL, DB) = warning(DB, '\r 'Error: '\o 'Module header2QidList(moduleName(I)) 'not 'in 'database. '\n) [owise] . eq setUpImportDeps(MN, nil, DB) = DB . op setUpViewDeps : ModuleExpression ViewExp Database -> Database . op setUpViewExpDeps : ViewExp Database -> Database . op setUpViewExpDeps : ViewExp ParameterList Database -> Database . eq setUpViewDeps(ME, VE, db((< ME' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = db((< ME' ; DT ; U ; U' ; U'' ; VDS ; MNS ; VE # VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . eq setUpViewDeps(ME, VE, db((< ME' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = db((< ME' ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VE # VES > MIS), MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . eq setUpViewDeps(ME, VE, DB) = warning(DB, '\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n) [owise] . eq setUpViewExpDeps(QI, DB) = DB . eq setUpViewExpDeps(QI{PL}, DB) = setUpViewExpDeps(QI{PL}, PL, DB) . eq setUpViewExpDeps(VE, (QI, PL), db(MIS, MNS, < QI ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpViewExpDeps(VE, PL, db(MIS, MNS, < QI ; DT ; VI ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq setUpViewExpDeps(VE, (QI, PL), db(MIS, MNS, < QI ; VI ; VI' ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpViewExpDeps(VE, PL, db(MIS, MNS, < QI ; VI ; VI' ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq setUpViewExpDeps(VE, (QI, PL), DB) = setUpViewExpDeps(VE, PL, DB) [owise] . eq setUpViewExpDeps(VE, (QI{PL}, PL'), db(MIS, MNS, < QI{PL} ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpViewExpDeps(VE, PL', db(MIS, MNS, < QI{PL} ; DT ; VI ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq setUpViewExpDeps(VE, (QI{PL}, PL'), db(MIS, MNS, < QI{PL} ; VI ; VI' ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpViewExpDeps(VE, PL', db(MIS, MNS, < QI{PL} ; VI ; VI' ; MNS' ; VE # VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq setUpViewExpDeps(VE, (QI{PL}, PL'), DB) = setUpViewExpDeps(VE, PL', DB) [owise] . eq setUpViewExpDeps(VE, empty, DB) = DB . op compiledModule : ModuleExpression Database -> Bool . op compiledModule : ParameterDecl Database -> Bool . op compiledView : ViewExp Database -> Bool . eq compiledView(VE, db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) = VI =/= null . eq compiledView(ME, DB) = false [owise] . eq compiledModule(MN, db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = U'' =/= noModule . eq compiledModule(MN, db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = U3 =/= noModule . eq compiledModule(MN, DB) = false [owise] . op insertTermView : ViewExp Term Database -> Database . op insertView : View Database -> Database . op getTermView : ViewExp Database -> Default{Term} . op getView : ViewExp Database -> [View] . eq insertTermView(VE, T, db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) = delViews(VES, delModules(MNS', db(MIS, MNS, < VE ; T ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS, VES', MNS'', MNS3, MNS4, QIL '\g 'Advisory: '\o 'View viewExp2QidList(VE) 'redefined. '\n))) . eq insertTermView(VE, T, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) = db(MIS, MNS, < VE ; T ; null ; emptyModuleNameSet ; emptyViewExpSet > VIS, (VE # VES), MNS', MNS'', MNS3, QIL) [owise] . eq insertView(view VE from ME to ME' is VMAPS endv, db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpViewExpDeps(VE, setUpViewDeps(ME, VE, setUpViewDeps(ME', VE, db(MIS, MNS, < VE ; DT ; view VE from ME to ME' is VMAPS endv ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)))) . eq insertView(view VE{PDL} from ME to ME' is VMAPS endv, db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpViewExpDeps(VE, setUpViewDeps(ME, VE, setUpViewDeps(ME', VE, db(MIS, MNS, < VE ; DT ; view VE{PDL} from ME to ME' is VMAPS endv ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)))) . eq insertView(view VE from ME to ME' is VMAPS endv, db(MIS, MNS, VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpViewExpDeps(VE, setUpViewDeps(ME, VE, setUpViewDeps(ME', VE, db(MIS, MNS, < VE ; (null).Default{Term} ; view VE from ME to ME' is VMAPS endv ; emptyModuleNameSet ; emptyViewExpSet > VIS, VE # VES', MNS'', MNS3, MNS4, QIL)))) [owise] . eq insertView(view VE{PDL} from ME to ME' is VMAPS endv, db(MIS, MNS, VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpViewExpDeps(VE, setUpViewDeps(ME, VE, setUpViewDeps(ME', VE, db(MIS, MNS, < VE ; (null).Default{Term} ; view VE{PDL} from ME to ME' is VMAPS endv ; emptyModuleNameSet ; emptyViewExpSet > VIS, VE # VES', MNS'', MNS3, MNS4, QIL)))) [owise] . eq insertView(viewError(QIL), DB) = warning(DB, QIL) . eq getTermView(VE, db(MIS, MNS, (< VE ; DT ; VI ; MNS' ; VES > VIS), VES', MNS'', MNS3, MNS4, QIL)) = DT . eq getTermView(VE, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) = qidError('\r 'Error: '\o 'View viewExp2QidList(VE) 'not 'in 'database. '\n) [owise] . eq getView(VE, db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) = VI . eq getView(VE, db(MIS, MNS, < VE ; VI ; VI' ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) = VI' . eq getView(VE, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) = viewError('\r 'Error: '\o 'View viewExp2QidList(VE) 'not 'in 'database. '\n) [owise] . *** There are functions to insert the different versions of a unit, and to *** extract them. We only give here the equations for the insertion of top *** units to illustrate the way in which the consistency of the database is *** maintained. We assume that when the internal version, the signature, or *** the flat version of a module is entered in the database, its corresponding *** top module is already present in it. sort Tuple . op <_;_;_> : Default{Term} OpDeclSet Module -> Tuple . op tupleError : QidList -> [Tuple] . op insTermModule : ModuleName Module Database -> Database . op insTermModule : ModuleName Term Database -> Database . op insertTopModule : ModuleExpression [Module] Database -> Database . op insertInternalModule : ModuleExpression [Module] Database -> Database . op insertFlatModule : ModuleExpression [Module] Database -> Database . op insertVars : ModuleExpression [OpDeclSet] Database -> Database . op getTermModule : ModuleExpression Database -> [Tuple] . op getTopModule : ModuleExpression Database -> [Module] . op getInternalModule : ModuleExpression Database -> [Module] . op getFlatModule : ModuleExpression Database -> [Module] . op getFlatModuleNeg : ModuleExpression Database -> [Module] . op getVars : ModuleExpression Database -> [OpDeclSet] . op insertTopModule : ParameterDecl [Module] Database -> Database . op insertInternalModule : ParameterDecl [Module] Database -> Database . op insertFlatModule : ParameterDecl [Module] Database -> Database . op insertVars : ParameterDecl [OpDeclSet] Database -> Database . op getTermModule : ParameterDecl Database -> [Tuple] . op getTopModule : ParameterDecl Database -> [Module] . op getInternalModule : ParameterDecl Database -> [Module] . op getFlatModule : ParameterDecl Database -> [Module] . op getFlatModuleNeg : ParameterDecl Database -> [Module] . op getVars : ParameterDecl Database -> [OpDeclSet] . eq insTermModule(MN, T, db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = delModules(MNS, delViews(VES, db(< MN ; T ; noModule ; noModule ; noModule ; none ; emptyModuleNameSet ; emptyViewExpSet > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL '\g 'Advisory: '\o 'Module header2QidList(MN) 'redefined. '\n))). eq insTermModule(MN, T, db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = delModules(MNS, delViews(VES, db(< MN ; T ; noModule ; noModule ; noModule ; none ; emptyModuleNameSet ; emptyViewExpSet > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL '\g 'Advisory: '\o 'Module header2QidList(MN) 'redefined. '\n))). eq insTermModule(MN, T, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) = db(< MN ; T ; noModule ; noModule ; noModule ; none ; emptyModuleNameSet ; emptyViewExpSet > MIS, MN . MNS, VIS, VES, MNS', MNS'', MNS3, QIL) [owise] . eq insTermModule(MN, qidError(QIL), DB) = warning(DB, QIL) . eq insTermModule(MN, unitError(QIL), DB) = warning(DB, QIL) . eq insTermModule(MN, U, db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = delModules(MNS, delViews(VES, db(< MN ; U ; noModule ; noModule ; noModule ; none ; emptyModuleNameSet ; emptyViewExpSet > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL '\g 'Advisory: '\o 'Module header2QidList(MN) 'redefined. '\n))). eq insTermModule(MN, U, db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = delModules(MNS, delViews(VES, db(< MN ; U ; noModule ; noModule ; noModule ; none ; emptyModuleNameSet ; emptyViewExpSet > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL '\g 'Advisory: '\o 'Module header2QidList(MN) 'redefined. '\n))). eq insTermModule(MN, U, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) = db(< MN ; U ; noModule ; noModule ; noModule ; none ; emptyModuleNameSet ; emptyViewExpSet > MIS, MN . MNS, VIS, VES, MNS', MNS'', MNS3, QIL) [owise] . eq insTermModule(MN, qidError(QIL), DB) = warning(DB, QIL) . eq insTermModule(MN, unitError(QIL), DB) = warning(DB, QIL) . eq insertTopModule(MN, U, db(< MN ; null ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = db(< MN ; null ; U ; noModule ; noModule ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL '\r 'ERROR: '\o 'Internally 'generated 'module header2QidList(MN) 'redefined. '\n) . eq insertTopModule(MN, U, db(< MN ; T ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpModuleDeps(U, db(< MN ; T ; U ; noModule ; noModule ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq insertTopModule(MN, U, db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpModuleDeps(U, db(< MN ; U' ; U ; noModule ; noModule ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq insertTopModule(MN, U, db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) = setUpModuleDeps(U, db(< MN ; null ; U ; noModule ; noModule ; none ; emptyModuleNameSet ; emptyViewExpSet > MIS, MN . MNS, VIS, VES, MNS', MNS'', MNS3, QIL)) [owise] . eq insertTopModule(MN, unitError(QIL), DB) = warning(DB, QIL) . eq insertInternalModule(MN, U, db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = db(< MN ; DT ; U' ; U ; U3 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . eq insertInternalModule(MN, U, db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = db(< MN ; U' ; U'' ; U ; U4 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . eq insertInternalModule(MN, unitError(QIL), DB) = warning(DB, QIL) . eq insertFlatModule(MN, U, db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = db(< MN ; DT ; U' ; U'' ; U ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . eq insertFlatModule(MN, U, db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = db(< MN ; U' ; U'' ; U3 ; U ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . eq insertFlatModule(MN, unitError(QIL), DB) = warning(DB, QIL) . eq insertVars(MN, VDS, db(< MN ; DT ; U' ; U'' ; U3 ; VDS' ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = db(< MN ; DT ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . eq insertVars(MN, VDS, db(< MN ; U' ; U'' ; U3 ; U4 ; VDS' ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = db(< MN ; U' ; U'' ; U3 ; U4 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . eq insertVars(MN, opDeclError(QIL), DB) = warning(DB, QIL) . eq getTermModule(MN, db(< MN ; null ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = tupleError('\r 'Error: '\o header2QidList(MN) 'is 'an 'internal 'module. '\n) . eq getTermModule(MN, db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = < DT ; none ; noModule > . eq getTermModule(MN, db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = < null ; VDS ; U > . eq getTermModule(MN, DB) = tupleError('\r 'Error: '\o 'Module header2QidList(MN) '\n) [owise] . eq getTopModule(MN, db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = U . eq getTopModule(MN, db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = U' . eq getTopModule(MN, DB) = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n) [owise] . eq getInternalModule(MN, db(< MN ; DT ; U ; U' ; U'' ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = U' . eq getInternalModule(MN, db(< MN ; U ; U' ; U'' ; U3 ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = U'' . eq getInternalModule(MN, DB) = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n) [owise] . eq getVars(MN, db(< MN ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = VDS . eq getVars(MN, db(< MN ; U ; U' ; U'' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = VDS . eq getVars(MN, DB) = none [owise] . *** The name of the signature and the flattened module is not the *** module expression used as the name of the module but the result of *** converting it into a quoted identifier. eq getFlatModule(MN, db(< MN ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = remNegAnns(M) . eq getFlatModule(MN, db(< MN ; U ; U' ; U'' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = remNegAnns(M) . eq getFlatModule(MN, db(< MN ; DT ; U ; U' ; noModule ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'compiled. '\n) . eq getFlatModule(MN, db(< MN ; U ; U' ; U'' ; noModule ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'compiled. '\n) . eq getFlatModule(MN, DB) = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n) [owise] . *** Handling of negative annotations (by Santiago Escobar) eq getFlatModuleNeg(MN, db(< MN ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = M . eq getFlatModuleNeg(MN, db(< MN ; U ; U' ; U'' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = M . eq getFlatModuleNeg(MN, db(< MN ; DT ; U ; U' ; noModule ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'compiled. '\n) . eq getFlatModuleNeg(MN, db(< MN ; U ; U' ; U'' ; noModule ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'compiled. '\n) . eq getFlatModuleNeg(MN, DB) = unitError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n) [owise] . *** removeNegAnnotations op remNegAnns : Module -> Module . op remNegAnns : OpDeclSet -> OpDeclSet . op remNegAnns : AttrSet -> AttrSet . op remNegAnns : IntList -> IntList . eq remNegAnns(M) = setOps(M, remNegAnns(getOps(M))) . eq remNegAnns(op F : TyL -> Ty [AtS] . OPDS) = op F : TyL -> Ty [remNegAnns(AtS)] . remNegAnns(OPDS) . eq remNegAnns((none).OpDeclSet) = (none).OpDeclSet . eq remNegAnns(strat(NL:NatList) AtS) = strat(NL:NatList) AtS . eq remNegAnns(strat(IL:IntList) AtS) = AtS [owise] . eq remNegAnns(AtS) = AtS [owise] . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** The Evaluation of Modules *** *** The general principle for the evaluation of units in our design consists in *** first evaluating any module expression, reducing it to a canonical form in *** which only unit inclusions appear, that is, to a unit hierarchy, which can *** be seen as a partial order of unit inclusions. The design of the Full Maude *** system has been based upon the principle of evaluating all module *** expressions to irreducible structured units, and on using the flat version *** of the units only for execution purposes. We have then two different *** processes clearly distinguished: a first step in which the structured unit *** is evaluated and reduced to its normal form, and a second step in which *** this normal form is flattened. *** As explained in Section~\ref{execution-environment}, the process of *** evaluation to normal form is also responsible for the parsing of the *** bubbles in the premodules, which is accomplished once the signature has *** been built. The parsing of bubbles is discussed in *** Section~\ref{bubble-parsing}. To be able to handle the \texttt{up} *** function and the \texttt{down} command presented in *** Section~\ref{structured-specifications}, it is necessary to be able to *** move terms and modules from one level of reflection to another. The *** functionality to move between levels is presented in *** Section~\ref{changing-levels}, where functions \texttt{up} and *** \texttt{down} on sorts \texttt{Module} and \texttt{Term} are defined. The *** transformation of object-oriented modules into system modules in discussed *** in Section~\ref{omod2modfunction}. The evaluation of module expressions is *** discussed in Sections~\ref{evalModExp}, \ref{application-of-maps}, *** \ref{instantiation}, and~\ref{renaming}. *** *** Changing Levels *** *** Moving terms of sorts \texttt{Term} and \texttt{Module} from one *** level of reflection to another is possible thanks to the *** \texttt{up} and \texttt{down} functions, which are defined, *** respectively, in the following modules \texttt{MOVE-UP} and *** \texttt{MOVE-DOWN}. *** *** The \texttt{up} Function *** *** Given a term of sort \texttt{Module} or \texttt{Term}, the *** \texttt{up} function, defined in the following module *** \texttt{MOVE-UP}, returns the term metarepresenting it. The *** function is just call the \texttt{upTerm} predefined function. *** We shall see in Section~\ref{bubble-parsing} how the \texttt{up} function *** is used to evaluate the homonymous function discussed in *** Section~\ref{structured-specifications}. In Section~\ref{instantiation} we *** shall discuss how the \texttt{up} function is used to evaluate the *** \texttt{META-LEVEL} module expression (see *** Section~\ref{structured-specifications}). ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod MOVE-UP is pr META-LEVEL . pr CONVERSION . op up : Module -> Term . op up : Term -> Term . eq up(M:Module) = upTerm(M:Module) . eq up(T:Term) = upTerm(T:Term) . 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 downModExp : Constant -> [Header] . op downNat : Term -> [Int] . op downString : Term -> [String] . op downResultPair : Term -> [ResultPair] . op downTerm : TermList -> [Term] . op downImports : TermList -> [ImportList] . op downSubsorts : TermList -> [SubsortDeclSet] . op downOps : TermList -> [OpDeclSet] . op downEqCond : TermList -> [EqCondition] . op downCond : TermList -> [Condition] . op downMbs : TermList -> [MembAxSet] . op downEqs : TermList -> [EquationSet] . op downRls : TermList -> [RuleSet] . op downAttrs : TermList -> [AttrSet] . op downAttr : Term -> [Attr] . op downHooks : TermList -> [HookList] . op downMetaNat : Term -> [Term] . op downNat : TermList -> [IntList] . vars 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('`{_`,_`}[T, T']) = {downTerm(T), downTerm(T')} . eq downModule('fmod_is_sorts_.____endfm[T1, T2, T3, T4, T5, T6, T7]) = (fmod downModExp(T1) is downImports(T2) sorts downSorts(T3) . downSubsorts(T4) downOps(T5) downMbs(T6) downEqs(T7) endfm) . eq downModule('mod_is_sorts_._____endm[T1, T2, T3, T4, T5, T6, T7, T8]) = (mod downModExp(T1) is downImports(T2) sorts downSorts(T3) . downSubsorts(T4) downOps(T5) downMbs(T6) downEqs(T7) downRls(T8) endm) . eq downModExp(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 downModExp(T) .) . eq downImports('extending_.[T]) = (extending downModExp(T) .) . eq downImports('protecting_.[T]) = (protecting downModExp(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('poly[T]) = poly(downNat(T)) . eq downAttr('strat[T]) = strat(downNat(T)) . eq downAttr('memo.Attr) = memo . eq downAttr('prec[T]) = prec(downNat(T)) . eq downAttr('gather[T]) = gather(downQidList(T)) . eq downAttr('ctor.Attr) = ctor . eq downAttr('special[T]) = special(downHooks(T)) . eq downAttr('iter.Attr) = iter . eq downAttr('frozen[T]) = frozen(downNat(T)) . eq downAttr('config.Attr) = config . eq downAttr('object.Attr) = object . eq downAttr('msg.Attr) = msg . 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'', T3]) = op-hook(downQid(T), downQid(T'), downQidList(T''), downQid(T3)) . 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)) . ceq downTerm((T, TL)) = (downTerm(T), downTerm(TL)) if TL =/= empty . eq downTerm(F[TL]) = qidError('\r 'Error: '\o 'Incorrect 'term. '\n) [owise] . eq downEqCond('_/\_[TL]) = downEqCond(TL) . eq downEqCond((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'', T3]) = (cmb downTerm(T) : downSort(T') if downEqCond(T'') [downAttrs(T3)] .) . 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'', T3]) = (ceq downTerm(T) = downTerm(T') if downEqCond(T'') [downAttrs(T3)] .) . 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'', T3]) = (crl downTerm(T) => downTerm(T') if downCond(T'') [downAttrs(T3)] .) . 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) . ceq downTypes((TL, TL')) = (downTypes(TL) downTypes(TL')) if TL =/= empty /\ TL' =/= empty . eq downTypes(QI) = downSort(QI) . eq downQidList('nil.QidList) = nil . eq downQidList('__[TL]) = downQidList(TL) . eq downQidList((QI, TL)) = (downQid(QI) downQidList(TL)) . eq downQidList(empty) = nil . eq downQid(Ct) = qid(substr(string(getName(Ct)), 1, length(string(getName(Ct))))) . eq downMetaNat(QI) = qid(substr(string(getName(QI)), 1, length(string(getName(QI)))) + ".Nat") . ceq downNat(QI) = trunc(rat(string(getName(QI)), 10)) if getType(QI) == 'Nat or getType(QI) == 'NzNat . ceq downNat(QI) = if substr(string(getName(QI)), 0 ,1) == "-" then - trunc(rat(substr(string(getName(QI)), 1, length(string(getName(QI)))), 10)) else trunc(rat(string(getName(QI)), 10)) fi if getType(QI) == 'Int or getType(QI) == 'NzInt . eq 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 . pr VIEW-EXPR-TO-QID . vars T T' T'' T3 T4 : Term . vars T? T?' : [Term] . var TL TL' : TermList . var QIL : QidList . var Ct : Constant . var AtS : AttrSet . vars QI F : Qid . var CD? : [Condition] . vars S S' : Sort . var TyL : TypeList . op parseSort : Term ~> Sort . op parseType : Term ~> Type . op parseSortSet : Term ~> SortSet . op parseTypeList : Term ~> TypeList . op parseViewExp : Term ~> ViewExp . op parseParameterList : Term ~> ParameterList . eq parseSort('sortToken[T]) = if downQid(T) :: Type then downQid(T) else qidError('\r 'Warning: '\o downQid(T) 'is 'not 'a 'valid 'sort. '\n) fi . eq parseSort('_`{_`}[T, T']) = qid(string(parseSort(T)) + "{" + string(parameterList2Qid(parseParameterList(T'))) + "}") . eq parseSort(T) = qidError('\r 'Warning: '\o 'invalid 'sort. '\n) [owise] . eq parseType('`[_`][T]) ---- = kind(parseSort(T)) . = qid("[" + string(parseSort(T)) + "]") . eq parseType(T) = parseSort(T) [owise] . eq parseSortSet('__[T, T']) = (parseSort(T) ; parseSortSet(T')) . eq parseSortSet(T) = parseSort(T) [owise]. eq parseTypeList('__[T, T']) = (parseType(T) parseTypeList(T')) . eq parseTypeList(T) = parseType(T) [owise] . eq parseViewExp('viewToken[T]) = if downQid(T) :: Sort then downQid(T) else qidError('\r 'Warning: '\o downQid(T) 'is 'not 'a 'valid 'sort. '\n) fi . eq parseViewExp('_`{_`}[T, T']) = parseViewExp(T){parseParameterList(T')} . eq parseViewExp(T) = qidError('\r 'Warning: '\o 'invalid 'view 'expression. '\n) [owise] . eq parseParameterList('_`,_[T, T']) = parseViewExp(T), parseParameterList(T') . eq parseParameterList(T) = parseViewExp(T) [owise] . *** The function \texttt{parseModExp} takes a term representing a *** module expression and returns the corresponding term in sort *** \texttt{ModuleExpression}. In case of adding new constructors for module *** expressions, as it will be done in Section~\ref{extension}, new equations d *** efining the semantics of the function on them will have to be given. op parseModExp : Term -> ModuleExpression . op parseMaps : Term -> RenamingSet . op parseAttrs : Term -> AttrSet . eq parseModExp('token[T]) = downQid(T) . eq parseModExp('`(_`)[T]) = parseModExp(T) . eq parseModExp('_`{_`}[T, T']) = _`{_`}(parseModExp(T), parseParameterList(T')) . eq parseModExp('_*`(_`)[T, T']) = _*`(_`)(parseModExp(T), parseMaps(T')) . eq parseModExp('_+_[T, T']) = parseModExp(T) + parseModExp(T') . eq parseModExp('TUPLE`[_`]['token[T]]) = TUPLE[parseNat(T)] . eq parseMaps('_`,_[T, T']) = (parseMaps(T), parseMaps(T')) . eq parseMaps('sort_to_[T, T']) = (sort parseType(T) to parseType(T')) . eq parseMaps('label_to_['token[T], 'token[T']]) = (label downQid(T) to downQid(T')) . eq parseMaps('class_to_[T, T']) = (class parseType(T) to parseType(T')) . eq parseMaps('attr_._to_[T, 'token[T'], 'token[T'']]) = (attr downQid(T') . parseType(T) to downQid(T'')) . eq parseMaps('msg_to_['token[T], 'token[T']]) = (msg downQid(T) to downQid(T')) . eq parseMaps('msg_:_->_to_['token[T], T', T'', 'token[T3]]) = (msg downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3)) . eq parseMaps('msg_:`->_to_['token[T], T', 'token[T'']]) = (msg downQid(T) : nil -> parseType(T') to downQid(T'')) . eq parseMaps('op_to_`[_`]['token[T], 'token[T'], T'']) = (op downQid(T) to downQid(T') [parseAttrs(T'')]) . eq parseMaps('op_:_->_to_`[_`]['token[T], T', T'', 'token[T3], T4]) = (op downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3) [parseAttrs(T4)]) . eq parseMaps('op_:`->_to_`[_`]['token[T], T', 'token[T''], T3]) = (op downQid(T) : nil -> parseType(T') to downQid(T'') [parseAttrs(T3)]) . eq parseMaps('op_:_~>_to_`[_`]['token[T], T', T'', 'token[T3], T4]) = (op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) to downQid(T3) [parseAttrs(T4)]) . eq parseMaps('op_:`~>_to_`[_`]['token[T], T', 'token[T''], T3]) = (op downQid(T) : nil -> kind(parseType(T')) to downQid(T'') [parseAttrs(T3)]) . eq parseMaps('op_to_['token[T], 'token[T']]) = (op downQid(T) to downQid(T') [none]) . eq parseMaps('op_:_->_to_['token[T], T', T'', 'token[T3]]) = (op downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3) [none]) . eq parseMaps('op_:`->_to_['token[T], T', 'token[T'']]) = (op downQid(T) : nil -> parseType(T') to downQid(T'') [none]) . eq parseMaps('op_:_~>_to_['token[T], T', T'', 'token[T3]]) = (op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) to downQid(T3) [none]) . eq parseMaps('op_:`~>_to_['token[T], T', 'token[T'']]) = (op downQid(T) : nil -> kind(parseType(T')) to downQid(T'') [none]) . eq parseAttrs('__[T, T']) = (parseAttrs(T) parseAttrs(T')) . eq parseAttrs('assoc.@Attr@) = assoc . eq parseAttrs('associative.@Attr@) = assoc . eq parseAttrs('comm.@Attr@) = comm . eq parseAttrs('commutative.@Attr@) = comm . eq parseAttrs('idem.@Attr@) = idem . eq parseAttrs('idempotent.@Attr@) = idem . eq parseAttrs('id:_[T]) = none . eq parseAttrs('identity:_[T]) = none . eq parseAttrs('left`id:_[T]) = none . eq parseAttrs('left`identity:_[T]) = none . eq parseAttrs('right`id:_[T]) = none . eq parseAttrs('right`identity:_[T]) = none . eq parseAttrs('poly`(_`)[T]) = poly(parseInt(T)) . eq parseAttrs('strat`(_`)[T]) = none . eq parseAttrs('strategy`(_`)[T]) = none . eq parseAttrs('memo.@Attr@) = none . eq parseAttrs('memoization.@Attr@) = none . eq parseAttrs('prec_['token[T]]) = prec(parseNat(T)) . eq parseAttrs('precedence_['token[T]]) = prec(parseNat(T)) . eq parseAttrs('prec_['`(_`)['token[T]]]) = prec(parseNat(T)) . eq parseAttrs('precedence_['`(_`)['token[T]]]) = prec(parseNat(T)) . eq parseAttrs('gather`(_`)['neTokenList[T]]) = gather(downQidList(T)) . eq parseAttrs('gathering`(_`)['neTokenList[T]]) = gather(downQidList(T)) . eq parseAttrs('format`(_`)['neTokenList[T]]) = none . eq parseAttrs('ctor.@Attr@) = ctor . eq parseAttrs('constructor.@Attr@) = ctor . eq parseAttrs('frozen.@Attr@) = none . eq parseAttrs('frozen`(_`)[T]) = none . eq parseAttrs('iter.@Attr@) = iter . eq parseAttrs('ditto.@Attr@) = ditto . eq parseAttrs('special`(_`)[T]) = parseSpecial(parseHookList(T)) . eq parseAttrs('config.@Attr@) = config . eq parseAttrs('object.@Attr@) = object . eq parseAttrs('msg.@Attr@) = msg . eq parseAttrs('message.@Attr@) = msg . op parseSpecial : Set -> Attr . op parseHookList : Term -> Set . op hookList : Set -> HookList . sort Set . subsort Hook < Set . op none : -> Set . op _._ : Set Set -> Set [assoc comm id: none] . var SH : Set . var H : Hook . eq parseSpecial(none) = none . eq parseSpecial(SH) = special(hookList(SH)) [owise] . eq parseHookList('__[T, TL]) = parseHookList(T) . parseHookList(TL) . eq parseHookList('id-hook_['token[T]]) = id-hook(downQid(T), nil) . eq parseHookList('id-hook_`(_`)['token[T], 'neTokenList[T']]) = id-hook(downQid(T), downQidList(T')) . eq parseHookList( 'op-hook_`(_:_->_`)[ 'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]]) = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) . eq parseHookList('op-hook_`(_:`->_`)['token[T], 'token[T'], 'token[T'']]) = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) . eq parseHookList( 'op-hook_`(_:_~>_`)[ 'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]]) = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) . eq parseHookList('op-hook_`(_:`~>_`)['token[T], 'token[T'], 'token[T'']]) = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) . eq parseHookList('term-hook_`(_`)['token[T], T']) = none . eq hookList(H) = H . eq hookList(H . SH) = H hookList(SH) [owise] . *** Given a term representing a machine integer, the function *** \texttt{parseInt} returns the corresponding integer. op parseNat : Term -> Nat . op parseInt : Term -> Int . op parseInt : TermList -> IntList . eq parseInt(('neTokenList['__[TL]], TL')) = parseInt(TL) parseInt(TL') . eq parseInt(('neTokenList[QI], TL)) = parseInt(QI) parseInt(TL) . eq parseInt(empty) = nil . eq parseInt(Ct) = downNat( qid(substr(string(getName(Ct)), 1, length(string(getName(Ct)))) + ".Int")) . eq parseNat(Ct) = downNat( qid(substr(string(getName(Ct)), 1, length(string(getName(Ct)))) + ".Nat")) . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** Parsing of Bubbles *** *** In the following module \texttt{BUBBLE-PARSING}, the definitions for the *** basic processing of bubbles are introduced. In it we declare a function *** \texttt{solveBubbles} which takes a bubble and some other arguments and *** returns the term resulting from parsing it. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod BUBBLE-PARSING is pr DATABASE . pr MOVE-UP . pr MOVE-DOWN . pr MOD-EXP-PARSING . pr PRINT-SYNTAX-ERROR . vars T T' : Term . vars M M' : Module . var B : Bool . var QIL : QidList . vars DB DB' : Database . var TL : TermList . var S : Sort . vars QI QI' F : Qid . var VDS : OpDeclSet . var C : Constant . var V : Variable . var N : Nat . var Tp : Type . var RP : [ResultPair] . var MN : ModuleName . var ME : ModuleExpression . var U : Module . var Cond : Condition . op resultPairError : QidList -> [ResultPair] [ctor] . *** As we shall see in Section~\ref{evaluation}, a declaration importing the *** predefined module \texttt{UP} (see Section~\ref{non-built-in-predefined}) *** is added to all modules importing the \texttt{META-LEVEL} module. The *** \texttt{solveBubbles} function is called with a `flag' indicating whether *** the module can contain calls to the \texttt{up} function or not. Thus, *** when we call \texttt{metaParse} with some bubble and the module in which *** such bubble has to be parsed, if there are occurrences of the function *** \texttt{up} in it, they will be of the form \verb~'token[T]]~ or *** \verb~'up['token[T], 'bubble[T']]~ for terms \texttt{T} and \texttt{T'}. *** The function \texttt{solveUps} will evaluate them. op solveBubbles : Term Module Bool OpDeclSet Database -> [Term] . op solveUps : TermList Database -> [TermList] . op solveUpsCondition : Condition Database -> Condition . op solveUpsModExp : TermList Database -> [TermList] . op constsToVars : Term OpDeclSet -> Term [memo] . op constsToVars : TermList OpDeclSet -> TermList [memo] . op constsToVarsAux : Constant OpDeclSet -> Qid [memo] . eq constsToVars(F[TL], VDS) = F[constsToVars(TL, VDS)] . ceq constsToVars((T, TL), VDS) = (constsToVars(T, VDS), constsToVars(TL, VDS)) if TL =/= empty . eq constsToVars(C, VDS) = constsToVarsAux(C, VDS) . eq constsToVars(V, VDS) = V . eq constsToVars(qidError(QIL), VDS) = qidError(QIL) . eq constsToVarsAux(C, (op F : nil -> Tp [none] .) VDS) = if getName(C) == F then qid(string(F) + ":" + string(Tp)) else constsToVarsAux(C, VDS) fi . eq constsToVarsAux(C, none) = C . ceq solveBubbles('bubble[T], M, true, VDS, DB) *** if META-LEVEL is a submodule the ups need to be solved = if RP :: ResultPair then solveUps(constsToVars(getTerm(RP), VDS), DB) else qidError('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n '\r 'Error: '\o 'no 'parse 'for QIL '\n) fi if M' := addOps(VDS, M) /\ QIL := downQidList(T) /\ RP := metaParse(M', QIL, anyType) . ceq solveBubbles('bubble[T], M, false, VDS, DB) = if RP :: ResultPair then constsToVars(getTerm(RP), VDS) else qidError('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n '\r 'Error: '\o 'no 'parse 'for QIL '\n) fi if M' := addOps(VDS, M) /\ QIL := downQidList(T) /\ RP := metaParse(M', QIL, anyType) . *** The \texttt{solveBubbles1} function is in charge of calling the function *** \texttt{metaParse}. The flag indicating the inclusion of the module *** \texttt{META-LEVEL} in the module in which the term appears decides *** whether the function \texttt{solveUps} is called or not, so the extra *** price of searching for calls to the \texttt{up} function is paid only *** when an occurrence of the function is possible. This function takes care *** of the occurrences of the \texttt{up} function that may exist in such *** bubbles. *** The function \texttt{solveUps} goes through the term looking for a term *** with \texttt{'up} as top operator and \texttt{'token} as top operator of *** its unique argument if there is only one argument, or with \texttt{'token} *** and \texttt{'bubble} as top operators of its first and second arguments, *** respectively, if there are two. If a term of the form *** \mbox{\texttt{'up['token[T]]}} is reached, it is replaced by the *** metarepresentation of the flat version of the module in the database with *** the name given by the token. If a term of form *** \mbox{\texttt{'up['token[T], 'bubble[T']]}} is reached, the *** metarepresentation of the result of parsing the bubble in the signature *** of the module with the name given by the token, after solving possible *** nested calls to the \texttt{up} function, is returned. eq solveUps(QI, DB) = QI . eq solveUps(F[TL], DB) = F[solveUps(TL, DB)] [owise] . ceq solveUps((T, TL), DB) = (solveUps(T, DB), solveUps(TL, DB)) if TL =/= empty . eq solveUps('upModule['token[T]], DB) = solveUpsModExp('upModule['token[T]], DB) . eq solveUps('upModule['`(_`)[T]], DB) = solveUpsModExp('upModule['`(_`)[T]], DB) . eq solveUps('upModule['_`{_`}[T, T']], DB) = solveUpsModExp('upModule['_`{_`}[T, T']], DB) . eq solveUps('upModule['_*`(_`)[T, T']], DB) = solveUpsModExp('upModule['_*`(_`)[T, T']], DB) . eq solveUps('upModule['_+_[T, T']], DB) = solveUpsModExp('upModule['_+_[T, T']], DB) . eq solveUps('upModule['TUPLE`[_`]['token[T]]], DB) = solveUpsModExp('upModule['TUPLE`[_`]['token[T]]], DB) . eq solveUpsCondition(T = T' /\ Cond, DB) = solveUps(T, DB) = solveUps(T', DB) /\ solveUpsCondition(Cond, DB) . eq solveUpsCondition(T : S /\ Cond, DB) = solveUps(T, DB) : S /\ solveUpsCondition(Cond, DB) . eq solveUpsCondition(T := T' /\ Cond, DB) = T := solveUps(T', DB) /\ solveUpsCondition(Cond, DB) . eq solveUpsCondition(T => T' /\ Cond, DB) = solveUps(T, DB) => solveUps(T', DB) /\ solveUpsCondition(Cond, DB) . eq solveUpsCondition(nil, DB) = nil . ceq solveUpsModExp('upModule[T], DB) = up(getFlatModule(MN, DB')) if < DB' ; MN > := evalModExp(parseModExp(T), DB) /\ unitInDb(MN, DB') . ceq solveUpsModExp('upModule[T], DB) = qidError('\r 'Error: '\o 'Module header2QidList(MN) 'not 'in 'database. '\n) if MN := parseModExp(T) [owise] . eq solveUps('upTerm['token[T], 'bubble[T']], DB) = solveUpsModExp('upTerm['token[T], 'bubble[T']], DB) . eq solveUps('upTerm['`(_`)[T], 'bubble[T']], DB) = solveUpsModExp('upTerm['`(_`)[T], 'bubble[T']], DB) . eq solveUps('upTerm['_`{_`}[T, T'], 'bubble[T']], DB) = solveUpsModExp('upTerm['_`{_`}[T, T'], 'bubble[T']], DB) . eq solveUps('upTerm['_*`(_`)[T, T'], 'bubble[T']], DB) = solveUpsModExp('upTerm['_*`(_`)[T, T'], 'bubble[T']], DB) . eq solveUps('upTerm['_+_[T, T'], 'bubble[T']], DB) = solveUpsModExp('upTerm['_+_[T, T'], 'bubble[T']], DB) . eq solveUps('upTerm['TUPLE`[_`]['token[T]], 'bubble[T']], DB) = solveUpsModExp('upTerm['TUPLE`[_`]['token[T]], 'bubble[T']], DB) . ceq solveUpsModExp('upTerm[T, 'bubble[T']], DB) = if included('META-MODULE, getImports(getInternalModule(MN, DB')), DB') then if metaParse(U, QIL, anyType) :: ResultPair then up(solveUps(getTerm(metaParse(U, QIL, anyType)), DB')) else qidError('\r 'Warning: '\o 'No 'parse 'for 'argument 'of 'up printSyntaxError(metaParse(U, QIL, anyType), QIL) '\n) fi else if metaParse(U, QIL, anyType) :: ResultPair then up(getTerm(metaParse(U, QIL, anyType))) else qidError('\r 'Warning: '\o 'No 'parse 'for 'argument 'of 'up printSyntaxError(metaParse(U, QIL, anyType), QIL) '\n) fi fi if < DB' ; MN > := evalModExp(parseModExp(T), DB) /\ U := getFlatModule(MN, DB') /\ QIL := downQidList(T'). ceq solveUpsModExp('upTerm[T, 'bubble[T']], DB) = qidError('\r 'Error: 'op '\o 'Module header2QidList(ME) 'not 'in 'database. '\n) if ME := parseModExp(T) [owise] . eq solveUps('`[_`][QI], DB) = '`[_`][QI] . ceq solveUps('`[_`]['token[T]], DB) = up(getFlatModule(QI, database(evalModExp(QI, DB)))) if QI := downQid(T) . eq solveUps('`[_`][F[TL]], DB) = '`[_`][F[solveUps(TL, DB)]] [owise] . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** Parsing the Bubbles in a Module *** *** The \texttt{solveBubbles} function defined in the *** \texttt{UNIT-BUBBLE-PARSING} module takes a term of sort \texttt{Module} (a *** preunit in fact) and a signature, and returns the unit resulting from the *** evaluation (parsing) of all the bubbles in it. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod UNIT-BUBBLE-PARSING is pr BUBBLE-PARSING . pr DATABASE . pr MOVE-UP . pr MOVE-DOWN . pr PRINT-SYNTAX-ERROR . vars T T' T'' T3 T4 : Term . vars T? T?' : [Term] . var TL TL' : TermList . vars TL? TL?' : [TermList] . var B : Bool . vars M M' M'' : Module . var DB : Database . vars PU U U' : Module . var K : Kind . var KS : KindSet . vars S S' : Sort . var SS : SortSet . var VE : ViewExp . vars Ty Ty' : Type . vars TyL TyL' : TypeList . var At : Attr . vars AtS AtS' AtS'' : AttrSet . var NL : IntList . var QI QI' QI'' QI3 QI4 QI5 F L : Qid . vars QIL QIL' : QidList . var I : Nat . var Hk : Hook . var HkL : HookList . var MAS : MembAxSet . var Eq : Equation . var EqS : EquationSet . var Rl : Rule . var RlS : RuleSet . var OPD : OpDecl . vars OPDS OPDS' OPDS'' VDS : OpDeclSet . var CD? : [Condition] . var Ct : Constant . var RP : [ResultPair] . *** In the parsing of bubbles themselves, we consider three different cases: *** The case of having one single bubble in which no context is *** considered (used to parse bubbles in term maps in views and in the *** special attributes of operators); the case of two bubbles to be parsed in *** the same connected component (used for bubbles in equations and rules), *** and the case of one bubble to be parsed in a specific sort (used for the *** bubbles appearing in the identity element attributes in the declarations *** of operators, and in membership axioms). These three cases are reduced to *** the case of one single bubble without context, which is handled by the *** function \texttt{solveBubbles3}. op solveBubblesEq : Term Term Module Bool OpDeclSet Database -> Term . op solveBubblesCEq : Term Term Module Bool OpDeclSet Database -> Term . op solveBubblesRl : Term Term Module Bool OpDeclSet Database -> Term . op solveBubblesCRl : Term Term Module Bool OpDeclSet Database -> Term . op solveBubbles2 : Term [Type] Module Bool OpDeclSet Database -> Term . op solveBubblesCond : Term Module Module Bool OpDeclSet Database -> [Condition] . op conditionError : QidList -> [Condition] [ctor format (r o)] . *** The case of two bubbles, generated in the case of equations and rules, is *** reduced to the case with one single bubble using the polymorphic operator *** \verb~_==_~ and enclosing each of the bubbles in parentheses. Below, we *** shall see how after calling this function the terms corresponding to each *** of the bubbles is extracted. ceq solveBubblesEq('bubble[T], 'bubble[T'], M, B, VDS, DB) = if RP :: ResultPair then if B then solveUps(constsToVars(getTerm(RP), VDS), DB) else constsToVars(getTerm(RP), VDS) fi else qidError('\r 'Warning: '\o printSyntaxError(RP, '`( QIL '`) '= '`( QIL' '`)) '\n '\r 'Error: '\o 'no 'parse 'for 'eq QIL '\s '~ '\s QIL' '\n) fi if M' := addOps((VDS op '_=_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .), addSorts('@@@, M)) /\ QIL := downQidList(T) /\ QIL' := downQidList(T') /\ RP := metaParse(M', '`( QIL '`) '= '`( QIL' '`), '@@@) . ceq solveBubblesCEq('bubble[T], 'bubble[T'], M, B, VDS, DB) = if RP :: ResultPair then if B then solveUps(constsToVars(getTerm(RP), VDS), DB) else constsToVars(getTerm(RP), VDS) fi else qidError('\r 'Warning: '\o printSyntaxError(RP, '`( QIL '`) '= '`( QIL' '`)) '\n '\r 'Error: '\o 'no 'parse 'for 'ceq QIL '\s '~ '\s QIL' '\n) fi if M' := addOps((VDS op '_=_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .), addSorts('@@@, M)) /\ QIL := downQidList(T) /\ QIL' := downQidList(T') /\ RP := metaParse(M', '`( QIL '`) '= '`( QIL' '`), '@@@) . ceq solveBubblesRl('bubble[T], 'bubble[T'], M, B, VDS, DB) = if RP :: ResultPair then if B then solveUps(constsToVars(getTerm(RP), VDS), DB) else constsToVars(getTerm(RP), VDS) fi else qidError('\r 'Warning: '\o printSyntaxError(RP, '`( QIL '`) '=> '`( QIL' '`)) '\n '\r 'Error: '\o 'no 'parse 'for 'rl QIL '\s '=> '\s QIL' '\n) fi if M' := addOps((VDS op '_=>_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .), addSorts('@@@, M)) /\ QIL := downQidList(T) /\ QIL' := downQidList(T') /\ RP := metaParse(M', '`( QIL '`) '=> '`( QIL' '`), '@@@) . ceq solveBubblesCRl('bubble[T], 'bubble[T'], M, B, VDS, DB) = if RP :: ResultPair then if B then solveUps(constsToVars(getTerm(RP), VDS), DB) else constsToVars(getTerm(RP), VDS) fi else qidError('\r 'Warning: '\o printSyntaxError(RP, '`( QIL '`) '=> '`( QIL' '`)) '\n '\r 'Error: '\o 'no 'parse 'for 'crl QIL '\s '=> '\s QIL' '\n) fi if M' := addOps((VDS op '_=>_ : 'Universal 'Universal -> '@@@ [poly(1 2)] .), addSorts('@@@, M)) /\ QIL := downQidList(T) /\ QIL' := downQidList(T') /\ RP := metaParse(M', '`( QIL '`) '=> '`( QIL' '`), '@@@) . ceq solveBubbles2('bubble[T], T?:Type?, M, true, VDS, DB) = if RP :: ResultPair then solveUps(constsToVars(getTerm(RP), VDS), DB) else qidError('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n '\r 'Error: 'No 'parse 'for QIL '\n) fi if QIL := downQidList(T) /\ RP := metaParse(M, QIL, T?:Type?) . ceq solveBubbles2('bubble[T], T?:Type?, M, false, VDS, DB) = if RP :: ResultPair then constsToVars(getTerm(RP), VDS) else qidError('\r 'Warning: '\o printSyntaxError(RP, QIL) '\n '\r 'Error: 'No 'parse 'for QIL '\n) fi if QIL := downQidList(T) /\ RP := metaParse(M, QIL, T?:Type?) . op addInfoConds : Module -> [Module] . op addInfoConds : Module SortSet -> Module . eq addInfoConds(M) = addInfoConds(M, getAllSorts(M)) . eq addInfoConds(M, '@Token@ ; SS) = addInfoConds(M, SS) . eq addInfoConds(M, '@Bubble@ ; SS) = addInfoConds(M, SS) . eq addInfoConds(M, S ; SS) = addInfoConds( addOps(op qid(string(S)) : nil -> '@Sort [ctor] . op '_:_ : S '@Sort -> '@Condition [ctor prec(71)] ., M), SS) [owise]. eq addInfoConds(M, none) = addOps(op '_/\_ : '@Condition '@Condition -> '@Condition [ctor assoc prec(73)] . op '_=_ : 'Universal 'Universal -> '@Condition [ctor poly(1 2) prec(71)] . op '_:=_ : 'Universal 'Universal -> '@Condition [ctor poly(1 2) prec(71)] . op '_=>_ : 'Universal 'Universal -> '@Condition [ctor poly(1 2) prec(71)] ., addSorts('@Condition ; '@Sort, if 'Bool inSortSet getSorts(M) then addSubsorts(subsort 'Bool < '@Condition ., M) else M fi)) . ceq solveBubblesCond('bubble[T], M, M', B, VDS, DB) = if 'Bool inSortSet getSorts(M) and-then metaParse(M, QIL, 'Bool) :: ResultPair then if B then solveUps(constsToVars(getTerm(metaParse(M, QIL, 'Bool)), VDS), DB) = 'true.Bool else constsToVars(getTerm(metaParse(M, QIL, 'Bool)), VDS) = 'true.Bool fi else if metaParse(M', QIL, '@Condition) :: ResultPair then if B then solveUpsCondition( parseCond(getTerm(metaParse(M', QIL, '@Condition)), VDS), DB) else parseCond(getTerm(metaParse(M', QIL, '@Condition)), VDS) fi else conditionError('\r 'Warning: '\o printSyntaxError(metaParse(M', QIL, '@Condition), QIL) '\n) fi fi if QIL := downQidList(T) . op parseCond : Term OpDeclSet -> Condition . eq parseCond('_/\_[T, T'], VDS) = parseCond(T, VDS) /\ parseCond(T', VDS) . eq parseCond('_=_[T, T'], VDS) = constsToVars(T, VDS) = constsToVars(T', VDS) . eq parseCond('_:_[T, T'], VDS) = constsToVars(T, VDS) : getName(T') . eq parseCond('_:=_[T, T'], VDS) = constsToVars(T, VDS) := constsToVars(T', VDS) . eq parseCond('_=>_[T, T'], VDS) = constsToVars(T, VDS) => constsToVars(T', VDS) . eq parseCond(T, VDS) = constsToVars(T, VDS) = 'true.Bool [owise] . *** Since bubbles can only appear in the identity or special attributes in the *** declaration of operators, in equations, membership axioms, and rules, the *** evaluation of bubbles on a preunit is reduced to calls to the *** \texttt{solveBubbles} functions on each of these sTS of declarations. op solveBubblesMod : Module OpDeclSet Module Bool OpDeclSet Database -> Module . op solveBubbles : EquationSet Module [Module] Bool OpDeclSet Database -> EquationSet . op solveBubbles : RuleSet Module [Module] Bool OpDeclSet Database -> RuleSet . op solveBubbles : MembAxSet Module [Module] Bool OpDeclSet Database -> MembAxSet . op solveBubbles : Condition Module Bool OpDeclSet Database -> Condition . op solveBubblesOps : OpDeclSet OpDeclSet Module Module -> OpDeclSet . op solveBubblesOps : OpDeclSet OpDeclSet Module -> OpDeclSet . op solveBubblesOpsAux : OpDeclSet Module -> OpDeclSet . op solveBubblesAts : AttrSet TypeList Type Module -> AttrSet . op solveBubblesHooks : HookList Type Module -> HookList . ceq solveBubblesMod(PU, OPDS, M, B, VDS, DB) = setOps( (if getMbs(PU) == none and getEqs(PU) == none and getRls(PU) == none then PU else setEqs( setMbs( setRls(PU, solveBubbles(getRls(PU), M', addInfoConds(M'), B, VDS, DB)), solveBubbles(getMbs(PU), M', addInfoConds(M'), B, VDS, DB)), solveBubbles(getEqs(PU), M', addInfoConds(M'), B, VDS, DB)) fi), solveBubblesOps(getOps(PU), OPDS, M')) if M' := addOps(VDS, M) . *** To avoid the parsing ambiguities in the identity elements we add the sort *** of the operator to be used as context in which doing the parsing. We *** assume that the term given as identity element of an operator is in the *** kind of the sort of such operator. eq solveBubblesOps(OPDS, OPDS', M) = solveBubblesOps(OPDS, OPDS', setSubsorts( setSorts(emptyFModule('DUMMY), getSorts(M)), getSubsorts(M)), M) . ceq solveBubblesOps( op F : TyL -> Ty [ditto AtS] . op F : TyL' -> Ty' [AtS'] . OPDS, OPDS', M, M') = solveBubblesOps( op F : TyL -> Ty [AtS AtS''] . op F : TyL' -> Ty' [AtS''] . OPDS, OPDS', M, M') if ditto in AtS' =/= true /\ sameKind(M, TyL Ty, TyL' Ty') /\ AtS'' := solveBubblesAts(AtS', TyL', Ty', M') . ceq solveBubblesOps(op F : TyL -> Ty [ditto AtS] . OPDS, op F : TyL' -> Ty' [AtS'] . OPDS', M, M') = solveBubblesOps(op F : TyL -> Ty [AtS''] . OPDS, op F : TyL' -> Ty' [AtS''] . OPDS', M, M') if ditto in AtS' =/= true /\ sameKind(M, TyL Ty, TyL' Ty') ---- /\ AtS'' := solveBubblesAts(AtS', TyL, Ty, M') /\ AtS'' := AtS' [owise] . eq solveBubblesOps(OPDS, OPDS', M, M') = solveBubblesOpsAux(OPDS, M') [owise] . eq solveBubblesOpsAux(op F : TyL -> Ty [AtS] . OPDS, M) = op F : TyL -> Ty [solveBubblesAts(AtS, TyL, Ty, M)] . solveBubblesOpsAux(OPDS, M) . eq solveBubblesOpsAux(none, M) = none . eq solveBubblesAts(id('bubble[T]) AtS, TyL, Ty, M) = (id(solveBubbles2('bubble[T], Ty, M, false, none, emptyDatabase)) solveBubblesAts(AtS, TyL, Ty, M)) . eq solveBubblesAts(left-id('bubble[T]) AtS, Ty TyL, Ty', M) = (left-id(solveBubbles2('bubble[T], Ty, M, false, none, emptyDatabase)) solveBubblesAts(AtS, Ty TyL, Ty', M)) . eq solveBubblesAts(right-id('bubble[T]) AtS, TyL Ty, Ty', M) = (right-id(solveBubbles2('bubble[T], Ty, M, false, none, emptyDatabase)) solveBubblesAts(AtS, TyL Ty, Ty', M)) . eq solveBubblesAts(special(HkL) AtS, TyL, Ty, M) = (special(solveBubblesHooks(HkL, Ty, M)) solveBubblesAts(AtS, TyL, Ty, M)) . eq solveBubblesAts(AtS, TyL, Ty, M) = AtS [owise] . eq solveBubblesHooks(term-hook(QI, 'bubble[T]) HkL, Ty, M) = term-hook(QI, solveBubbles2('bubble[T], anyType, M, false, none, emptyDatabase)) solveBubblesHooks(HkL, Ty, M) . eq solveBubblesHooks(Hk HkL, Ty, M) = Hk solveBubblesHooks(HkL, Ty, M) [owise] . eq solveBubblesHooks(nil, Ty, M) = nil . *** Since both sides of any equation or rule have to be in the same connected *** component of sorts, we parse the two bubbles together using the *** polymorphic operator \verb~_==_~\footnote{Note that if including *** \texttt{BOOL} the operator \texttt{\_\,==\_\,} is added for each kind.}. *** That is, given for example an equation as \verb~eq T = T' .~, we parse *** \verb~T == T'~, forcing them to be parsed in the same connected component, *** if possible. We add functions \texttt{lhs} and \texttt{rhs} to extract, *** respectively, the lefthand and righthand side terms from the result. Note *** that these are partial functions. sort 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'', QI3]]) = {'bubble['__[QI, QI', QI'', QI3]], none} . eq pullLabelOut('bubble['__[QI, QI', QI'', QI3, TL]]) = if QI == ''`[.Qid and-then (QI'' == ''`].Qid and-then QI3 == '':.Qid) then {'bubble['__[TL]], label(downQid(QI'))} else {'bubble['__[QI, QI', QI'', QI3, TL]], none} fi . ops lhs rhs : Term -> Term . eq lhs('_=_[T, T']) = T . eq lhs('_=>_[T, T']) = T . eq rhs('_=_[T, T']) = T' . eq rhs('_=>_[T, T']) = T' . eq lhs(qidError(QIL)) = qidError(QIL) . eq rhs(qidError(QIL)) = qidError(QIL) . eq solveBubbles(EqS, M, unitError(QIL), B, VDS, DB) = equationError(QIL) . eq solveBubbles(RlS, M, unitError(QIL), B, VDS, DB) = ruleError(QIL) . eq solveBubbles(MAS, M, unitError(QIL), B, VDS, DB) = membAxError(QIL) . eq solveBubbles(((eq T = T' [none] .) EqS), M, M', B, VDS, DB) = ((eq lhs(solveBubblesEq(T, term(pullStmtAttrOut(T')), M, B, VDS, DB)) = rhs(solveBubblesEq(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(solveBubblesCEq(T, T', M, B, VDS, DB)) = rhs(solveBubblesCEq(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(solveBubblesRl(term(pullLabelOut(T)), term(pullStmtAttrOut(T')), M, B, VDS, DB)) => rhs(solveBubblesRl(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(solveBubblesCRl(term(pullLabelOut(T)), T', M, B, VDS, DB)) => rhs(solveBubblesCRl(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 : S [AtS] .) MAS), M, M', B, VDS, DB) = ((mb solveBubbles2(T, S, M, B, VDS, DB) : S [AtS] .) solveBubbles(MAS, M, M', B, VDS, DB)) . eq solveBubbles(((cmb T : S if T' = 'true.Bool [AtS] .) MAS), M, M', B, VDS, DB) = ((cmb solveBubbles2(T, S, M, B, VDS, DB) : S if solveBubblesCond(T', M, M', B, VDS, DB) [AtS] .) solveBubbles(MAS, M, M', B, VDS, DB)) . eq solveBubbles((none).MembAxSet, M, M', B, VDS, DB) = none . *** The parsing process may generate error terms. Since in the *** current version of the system Core Maude is generating the appropriate *** error messages, we just have to worry about the elimination of these *** terms. The effect is the same one as introducing a module at the object *** level of Core Maude: If there is any term in an identity attribute in an *** operator declaration, equation, rule, or membership axiom with a parsing *** error a message is generated and the axiom is eliminated. eq (op F : TyL -> Ty [id(qidError(QIL)) AtS] .) = opDeclError(QIL) . eq (op F : TyL -> Ty [left-id(qidError(QIL)) AtS] .) = opDeclError(QIL) . eq (op F : TyL -> Ty [right-id(qidError(QIL)) AtS] .) = opDeclError(QIL) . eq (conditionError(QIL) /\ T = T' /\ CD?) = conditionError(QIL) . eq (conditionError(QIL) /\ T : S /\ CD?) = conditionError(QIL) . eq (conditionError(QIL) /\ T := T' /\ CD?) = conditionError(QIL) . eq (conditionError(QIL) /\ T => T' /\ CD?) = conditionError(QIL) . eq (eq qidError(QIL) = T? [AtS] .) = equationError(QIL) . eq (eq T? = qidError(QIL) [AtS] .) = equationError(QIL) . eq (ceq qidError(QIL) = T? if CD? [AtS] .) = equationError(QIL) . eq (ceq T? = qidError(QIL) if CD? [AtS] .) = equationError(QIL) . eq (ceq T? = T?' if conditionError(QIL) [AtS] .) = equationError(QIL) . eq (mb qidError(QIL) : S [AtS] .) = membAxError(QIL) . eq (cmb qidError(QIL) : S if CD? [AtS] .) = membAxError(QIL) . eq (cmb T? : S if conditionError(QIL) [AtS] .) = membAxError(QIL) . eq (rl qidError(QIL) => T? [AtS] .) = ruleError(QIL) . eq (rl T? => qidError(QIL) [AtS] .) = ruleError(QIL) . eq (crl qidError(QIL) => T? if CD? [AtS] .) = ruleError(QIL) . eq (crl T? => qidError(QIL) if CD? [AtS] .) = ruleError(QIL) . eq (crl T? => T?' if conditionError(QIL) [AtS] .) = ruleError(QIL) . eq F[qidError(QIL), TL?] = qidError(QIL) . eq F[TL?, qidError(QIL)] = qidError(QIL) . eq F[TL?, qidError(QIL), TL?'] = qidError(QIL) . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** The function \texttt{solveBubbles} defined in the following *** \texttt{VIEW-BUBBLE-PARSING} module parses the bubbles in a set of preview *** maps. It takes two modules, the signature of the view's source theory, *** with the variables declared in the view, to parse the source term in the *** term maps, and the target theory, with the mappings of the variable *** declarations in the view, to parse the target terms. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod VIEW-BUBBLE-PARSING is pr BUBBLE-PARSING . pr PRE-VIEW . var PVMAPS : Set{PreViewMap} . var VMAP : ViewMap . vars T T' : Term . vars M M' : Module . var U : Module . var QIL : QidList . vars VDS VDS' : OpDeclSet . op solveBubbles : Set{PreViewMap} OpDeclSet OpDeclSet Module Module -> RenamingSet . eq solveBubbles(PVMAPS, VDS, VDS', U, unitError(QIL)) = none . eq solveBubbles(PVMAPS, VDS, VDS', unitError(QIL), U) = none . eq solveBubbles(VMAP, VDS, VDS', M, M') = VMAP [owise] . eq solveBubbles((VMAP, PVMAPS), VDS, VDS', M, M') = (VMAP, solveBubbles(PVMAPS, VDS, VDS', M, M')) [owise] . eq solveBubbles(preTermMap(T, T'), VDS, VDS', M, M') = termMap( solveBubbles(T, M, false, VDS, emptyDatabase), solveBubbles(T', M', false, VDS', emptyDatabase)) . eq solveBubbles((preTermMap(T, T'), PVMAPS), VDS, VDS', M, M') = (termMap( solveBubbles(T, M, false, VDS, emptyDatabase), solveBubbles(T', M', false, VDS', emptyDatabase)), solveBubbles(PVMAPS, VDS, VDS', M, M')) . eq solveBubbles(none, VDS, VDS', M, M') = none . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** Module Expression Evaluation *** *** So far we have not introduced more module expressions than those given by *** simple quoted identifiers. We will introduce some later, but the scheme *** followed for evaluating them is very simple and can be presented in a *** generic way. Given a module expression and a database state, the *** evaluation of a module expression results in the generation of a new *** module, which is introduced in the database, with the module expression *** as its name. The resulting database is then returned. If there is already *** a module in the database with that name, the function returns the original *** database without any change. The evaluation of a module expression may *** produce the evaluation of other module expressions contained in the *** modules involved in the process. This is the case, for example, for the *** renaming of modules, in which not only the top module is renamed but, *** perhaps, some of its submodules as well; it is also the case for the *** instantiation of parameterized modules, where the module being *** instantiated may contain submodules which are parameterized by some of *** the parameter theories of the parameterized module in which are imported. *** We shall discuss in more detail the renaming and instantiation of module *** expressions in Sections~\ref{renaming} and~\ref{instantiation}, *** respectively. *** We saw in Section~\ref{module-expressions} how it is possible to import a *** module expression in which a parameterized module is instantiated by some *** of the formal parameters of the parameterized module into which it is *** imported. To be able to evaluate this kind of module expression, the list *** of parameters of the module in which the module expression appears has to *** be given. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod MOD-EXPR-EVAL is pr DATABASE . *** decl. moved to module DATABASE *** op evalModExp : ModuleExpression Database -> Database . op evalModExp : ModuleExpression ParameterDeclList Database -> Tuple{Database, ModuleExpression} . op evalViewExp : ViewExp ParameterDeclList Database -> Database . op evalViewExp : ParameterList ParameterDeclList Database -> Database . var S : Sort . var QI : Qid . var ME : ModuleExpression . var PDL : ParameterDeclList . var DB : Database . vars VE VE' VE'' : ViewExp . vars PL PL' : ParameterList . eq evalModExp(ME, DB) = evalModExp(ME, nil, DB) . eq evalModExp(ME, PDL, DB) = < DB ; ME > [owise] . eq evalModExp(QI, PDL, DB) = if unitInDb(QI, DB) then if compiledModule(QI, DB) then < DB ; QI > else < procModule(QI, DB) ; QI > fi else if upModule(QI, false) :: Module then < procModule(QI, insTermModule(QI, upModule(QI, false), DB)) ; QI > else < warning(DB, '\r 'Error: '\o 'Module QI 'not 'in 'database. '\n) ; QI > fi fi . eq evalViewExp(QI, PDL, DB) = if labelInParameterDeclList(QI, PDL) then DB else if viewInDb(QI, DB) then if compiledView(QI, DB) then DB else procView(QI, DB) fi else warning(DB, ('\r 'Error: '\o 'View QI 'not 'in 'database. '\n)) fi fi . ceq evalViewExp(VE ;; VE', PDL, DB) = evalViewExp(VE, PDL, evalViewExp(VE', PDL, DB)) if VE =/= mtViewExp /\ VE' =/= mtViewExp . eq evalViewExp(S{PL}, PDL, DB) = if viewInDb(S{PL}, DB) then DB else viewInst(S, PL, PDL, evalViewExp(S, PDL, evalViewExp(PL, PDL, DB))) fi . eq evalViewExp((S, PL), PDL, DB) = evalViewExp(S, PDL, evalViewExp(PL, PDL, DB)) [owise] . eq evalViewExp((S{PL}, PL'), PDL, DB) = evalViewExp(S{PL}, PDL, evalViewExp(PL', PDL, DB)) [owise] . eq evalViewExp(nil, PDL, DB) = DB . op viewInst : ViewExp ViewExp ParameterDeclList Database -> Database . ******************************************************************************* *** The equations specifying its behavior are later, in INST-EXPR-EVALUATION ** ******************************************************************************* endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** The Transformation of Object-Oriented Modules to System Modules *** *** The transformation of object-oriented modules into system modules has *** already been discussed in Section~\ref{omod2mod}, and also in *** \cite{Meseguer93b,ClavelDuranEkerLincolnMarti-OlietMeseguerQuesada99}. *** We focus here on the part of the process accomplished by each of the main *** functions involved in the transformation. The transformation discussed *** in~\cite{DuranMeseguer98} assumed that object-oriented modules were *** flattened before being transformed into system modules. However, doing it *** in this way, the transformations already made for the modules in the *** structure were not reused. In the current system, the transformation is *** done only for the module being introduced, the top of the structure, and *** dusing the `internal' representations of the submodules stored in the *** ddatabase for the rest of the structure. *** This approach requires gathering all class and subclass relation *** declarations in the structure before starting with the transformation *** process itself. The function \texttt{prepClasses} collects all these *** declarations in the structure, and completes all the declarations of *** classes with the attributes inherited from their superclasses. *** \begin{comment} *** This function makes use of a `dummy' module, in which the classes are *** introduced as sorts and the subclass relations as subsort relations to be *** able to compute all the operations on the subclass relation using the *** built-in functions on sorts. *** \end{comment} *** Once all the class declarations in the structure have been collected and *** completed, the transformation is accomplished in two stages. First, the *** function \texttt{omod2modAux} carries out the *** following tasks: *** \begin{itemize} *** \item For each class declaration of the form *** $\texttt{class }C\texttt{ | }a_1\texttt{:} S_1\texttt{,} *** \ldots\texttt{,} a_n\texttt{:} S_n$, the following items are *** introduced: a subsort $C$ of sort \texttt{Cid}, a constant *** $C$ of sort $C$, and declarations of operations $a_i *** \texttt{\ :\_} \texttt{ :\,\,} S_i \texttt{ -> Attribute}$ *** for each attribute $a_i$ (the function *** \texttt{ops4Attr} creates these declarations). *** \item For each subclass relation of the form *** $\texttt{subclass\ }C\texttt{\ <\ }C'$, a subsort *** declaration $\texttt{subsort\ }C\texttt{\ <\ }C'$ is *** introduced. *** \item For each message declaration of the form \verb~msg F : TyL *** -> S~, an operator declaration \verb~op F : TyL -> S~ is added. *** \end{itemize} *** When this process has been completed, the function \texttt{prepAxs} is *** called. This function applies to the membership axioms, equations, and *** rewriting rules in the module the transformations indicated in *** Section~\ref{omod2mod}, so that they become applicable to all the objects *** of the given class and of their subclasses. The set of attributes of the *** objects appearing in the membership axioms, equations, and rewriting rules *** are completed, so that the default convention of not having to *** exhaustively mention the set of attributes of a class is supported. *** Note that in Meseguer's paper~\cite{Meseguer93b} a parallel hierarchy of *** sorts was defined to deal with objects in different classes, and membership *** axioms constraining the objects to their corresponding sorts were added. *** The transformation could be easily completed with sorts, subsort relations, *** and membership constraints as indicated there. In fact, these declarations *** were added in an initial version and were then removed because they were *** computationally expensive. However, there are examples in which it would *** be interesting to have them; when needed, these declarations can be *** explicitly added by the user in the current version. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod O-O-TO-SYSTEM-MOD-TRANSF is pr DATABASE . pr CONVERSION . var DB : Database . var I : Nat . var ME : Header . vars S S' S'' C C' : Sort . vars SS SS' SS'' : SortSet . var Ty : Type . var TyL : TypeList . vars T T' T'' T3 : Term . vars TL TL' : TermList . var PL : ParameterList . vars IL IL' IL'' : ImportList . vars CDS CDS' : ClassDeclSet . vars ADS ADS' : AttrDeclSet . var SSDS : SubsortDeclSet . vars SCDS SCDS' : SubclassDeclSet . var OPDS : OpDeclSet . var MDS : MsgDeclSet . vars MAS MAS' : MembAxSet . vars EqS EqS' : EquationSet . vars RlS RlS' : RuleSet . var QIL : QidList . vars O O' : Term . vars M U : Module . vars QI A A' L F : Qid . var V V' : Variable . var CD : ClassDecl . vars SCD SCD' : SubclassDecl . vars Ct Ct' Ct'' : Constant . var Cond : Condition . var AtS : AttrSet . var H : Header . var PD : ParameterDecl . var PDL : ParameterDeclList . var MN : ModuleName . op newVar : Sort Nat -> Variable . eq newVar(S, I) = qid("V#" + string(I, 10) + ":" + string(S)) . *** The function \texttt{prepClasses} completes all classes in the module with *** all the attributes they inherit from their superclasses. op prepClasses : ClassDeclSet SubclassDeclSet ImportList ParameterDeclList Database -> ClassDeclSet . op prepClasses2 : ClassDeclSet SubclassDeclSet ImportList ImportList Database -> ClassDeclSet . op prepClasses3 : ClassDeclSet SubclassDeclSet -> ClassDeclSet . eq prepClasses(CDS, SCDS, IL, (PD, PDL), DB) = prepClasses(CDS, SCDS, (IL protecting pd(PD) .), PDL, DB) . eq prepClasses(CDS, SCDS, IL, nil, DB) = prepClasses2(CDS, SCDS, IL, nil, DB) . eq prepClasses2(CDS, SCDS, ((including MN .) IL), IL', DB) = if (including MN . ) in IL' then prepClasses2(CDS, SCDS, IL, IL', DB) else prepClasses2( (getClasses(getTopModule(MN, DB)) CDS), (getSubclasses(getTopModule(MN, DB)) SCDS), (getImports(getTopModule(MN, DB)) IL), ((including MN .) IL'), DB) fi . eq prepClasses2(CDS, SCDS, ((extending MN .) IL), IL', DB) = if (extending MN . ) in IL' then prepClasses2(CDS, SCDS, IL, IL', DB) else prepClasses2( (getClasses(getTopModule(MN, DB)) CDS), (getSubclasses(getTopModule(MN, DB)) SCDS), (getImports(getTopModule(MN, DB)) IL), ((extending MN .) IL'), DB) fi . eq prepClasses2(CDS, SCDS, ((protecting MN .) IL), IL', DB) = if (protecting MN . ) in IL' then prepClasses2(CDS, SCDS, IL, IL', DB) else prepClasses2( (getClasses(getTopModule(MN, DB)) CDS), (getSubclasses(getTopModule(MN, DB)) SCDS), (getImports(getTopModule(MN, DB)) IL), ((protecting MN .) IL'), DB) fi . eq prepClasses2(CDS, SCDS, nil, IL, DB) = prepClasses3(CDS, SCDS) . eq prepClasses3(CDS, SCDS) = addAttrs(buildHierarchy(CDS, SCDS, none, empty), SCDS) . sort ClassHierarchy ClassStruct . subsort ClassStruct < ClassHierarchy . op [_,_] : ClassDecl SortSet -> ClassStruct . op empty : -> ClassHierarchy . op __ : ClassHierarchy ClassHierarchy -> ClassHierarchy [assoc comm id: empty] . op buildHierarchy : ClassDeclSet SubclassDeclSet SortSet ClassHierarchy -> ClassHierarchy . op addAttrs : ClassHierarchy SubclassDeclSet -> ClassDeclSet . op addAttrsToItsSons : ClassDecl ClassHierarchy SubclassDeclSet -> ClassHierarchy . var CH : ClassHierarchy . var C'' : Sort . eq buildHierarchy(((class C | ADS .) CDS), SCDS, SS, CH) = if C inSortSet SS then buildHierarchy(CDS, SCDS, SS, CH) else buildHierarchy(CDS, SCDS, C ; SS, [(class C | ADS .), none] CH) fi . eq buildHierarchy(none, (subclass C < C' .) SCDS, SS, [(class C | ADS .), SS'] [(class C' | ADS' .), SS''] CH) = buildHierarchy(none, SCDS, SS, [(class C | ADS .), C' ; SS'] [(class C' | ADS' .), SS''] CH) . eq buildHierarchy(none, none, SS, CH) = CH . eq addAttrs([(class C | ADS .), none] CH, SCDS) = (class C | ADS .) addAttrs(addAttrsToItsSons((class C | ADS .), CH, SCDS), SCDS) . eq addAttrs(empty, SCDS) = none . eq addAttrsToItsSons((class C | ADS .), [(class C' | ADS' .), C ; SS] CH, (subclass C' < C .) SCDS) = addAttrsToItsSons((class C | ADS .), [(class C' | ADS, ADS' .), SS] CH, SCDS) . ceq addAttrsToItsSons((class C | ADS .), CH, (subclass C' < C'' .) SCDS) = addAttrsToItsSons((class C | ADS .), CH, SCDS) if C =/= C'' . eq addAttrsToItsSons((class C | ADS .), CH, none) = CH . op inAttrDeclSet : Qid AttrDeclSet -> Bool . eq inAttrDeclSet(A, ((attr A' : S), ADS)) = (A == A') or-else inAttrDeclSet(A, ADS) . eq inAttrDeclSet(A, none) = false . *** Given a set of attribute declarations, the \texttt{ops4Attr} *** function returns a set of operator declarations as indicated above. That *** is, for each attribute $a\texttt{:} S$, an operator of the form *** $a \texttt{\ :\_} \texttt{ :\,\,} S \texttt{ -> Attribute}$ is declared. op ops4Attr : AttrDeclSet -> OpDeclSet . eq ops4Attr(((attr A : S), ADS)) = ((op qid(string(A) + "`:_") : S -> 'Attribute [gather('&)] .) ops4Attr(ADS)) . eq ops4Attr(none) = none . *** The function \texttt{prepLHS} takes the term in the lefthand side of a *** rule, equation, or membership axiom, and replaces each object *** *** $\texttt{<\ }O\texttt{\ :\ }C\texttt{\ |\ }ADS\texttt{\ >}$ *** *** in it---with $O$ of sort \texttt{Oid}, $C$ the name of a class, and $ADS$ *** a set of attributes with their corresponding values---by an object *** *** $\texttt{<\ }O\texttt{\ :\ }V\texttt{\ |\ }ADS\ ADS'\ Atts\texttt{\ >}$ *** *** where the identifier of the class is replaced by a variable $V$ of sort *** $C$, which is not used in the axiom, and where the set of attributes is *** completed with attributes $ADS'$ as indicated in Section~\ref{omod2mod}, so *** that each attribute declared in class $C$ or in any of its superclasses is *** added with a new variable as value. $Atts$ is a new variable of sort *** \texttt{AttributeSet}, which is used to range over the additional *** attributes that may appear in objects of a subclass. *** The function \texttt{prepLHS} takes as arguments a term (in the initial *** call, the term in the lefthand side of a rule, equation, or membership *** axiom), the set of variable declarations of those variables declared in the *** module that are not used in the axiom---new variables are created only if *** there are no variables in the module with the appropriate sort---the set of *** attributes in the* occurrences of the objects---and an index---to make sure *** that the variables being added have not occurrences of the objects---and an *** index---to make sure that the variables being added have not been added *** previously. In the initial call this index is set to zero. \texttt{prepLHS} *** gives as result a tuple composed of the resulting term, the set of objects *** in the term (so that the modification of the objects in the righthand side *** of the rule is simplified), the set of variable declarations corresponding *** to the new added variables, the set of variable declarations of the *** variables in the module that have not been used, and the index for the *** creation of new variables. *** change (03/20/2002): a new variable is created everytime one is needed *** The set of objects in the lefthand side will be given as a set of terms. *** The sort \texttt{TermSet} is defined as a supersort of the sort *** \texttt{Term}, and with constructors \texttt{emptyTermSet} and *** \texttt{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 Sort AttrDeclSet PrepLHSResult -> PrepLHSResult . op crtObject2 : Term Variable TermList TermList AttrDeclSet TermSet Nat QidList -> PrepLHSResult . op crtObject3 : Term Qid TermList AttrDeclSet TermSet Nat QidList -> PrepLHSResult . eq prepLHS(qidError(QIL), CDS, I) = < qidError(QIL) ; emptyTermSet ; I ; nil > . eq prepLHS(F, CDS, I) = < F ; emptyTermSet ; I ; nil > . eq prepLHS(Ct, CDS, I) = < Ct ; emptyTermSet ; I ; nil > . *** \texttt{prepLHS} on a list of terms $\texttt{(}T\texttt{,\ }TL\texttt{)}$, *** with $T$ a term and $TL$ a list of terms, has to make a call to itself with *** $T$ and with $TL$. The call with $TL$ has to be made with the result of *** the call with $T$ so that the variables and the index are right. ceq prepLHS((T, TL), CDS, I) = < (term(prepLHS(T, CDS, I)), term(prepLHS(TL, CDS, index(prepLHS(T, CDS, I))))) ; 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))))) > if TL =/= empty . ceq prepLHS(F[TL], CDS, I) = < F[term(prepLHS(TL, CDS, I))] ; objects(prepLHS(TL, CDS, I)) ; index(prepLHS(TL, CDS, I)) ; messages(prepLHS(TL, CDS, I)) > if (F =/= '<_:_|_>) /\ (F =/= '<_:_|`>) . ceq prepLHS('<_:_|_>[O, Ct, T], ((class C | ADS .) CDS), I) = crtObject(O, C, ADS, prepLHS(T, ((class C | ADS .) CDS), I)) if getName(Ct) == C . ceq prepLHS('<_:_|`>[O, Ct], ((class C | ADS .) CDS), I) = crtObject(O, C, ADS, prepLHS('none.AttributeSet, ((class C | ADS .) CDS), I)) if getName(Ct) == C . eq prepLHS('<_:_|_>[O, V, T], CDS, I) = < '<_:_|_>[O, V, T] ; emptyTermSet ; I ; nil > . *** is this eq necessary? eq prepLHS('<_:_|`>[O, V], CDS, I) = < '<_:_|_>[O, V, 'none.AttributeSet] ; emptyTermSet ; I ; nil > . *** is this eq necessary? eq crtObject(O, C, ADS, < T ; TS ; I ; QIL >) = crtObject2(O, newVar(C, I), T, 'none.AttributeSet, ADS, TS, (I + 1), QIL) . *** The function \texttt{crtObject2} is called with the metarepresentation of *** the list of attributes appearing in the current object (third argument) *** and the set of attribute declarations of the class to which such object *** belongs + all the attributes declared in its superclasses (fifth *** argument). The function proceeds recursively removing the attribute *** declarations from the set of declarations of attributes for those *** attributes that appear in the object. Each time an attribute is found, it *** is passed with its actual value to the fourth argument of *** \texttt{crtObject2}, which initially has value \verb~'none.AttributeSet~, *** composing a list of terms with them. *** We assume that: *** \begin{itemize} *** \item The metarepresentation of a list of attributes is always given with *** form \verb~'_`,_[F[T], T]~, \verb~F[T]~, or *** \verb~'none.AttributeSet~, where \texttt{TL} is the *** metarepresentation of a list of attributes with the same form (this *** is ensured by the \verb~(e E)~ gathering pattern in the corresponding *** declaration in the signature in which the parsing is done), and *** \item that all the attributes appearing in an object have been declared in *** the corresponding class declaration or in one of its superclasses. *** \end{itemize} eq crtObject2(O, V, '_`,_[F[T], TL], TL', ADS, TS, I, QIL) = crtObject2(O, V, (F[T], TL), TL', ADS, TS, I, QIL) . ceq crtObject2(O, V, (F[T], TL), TL', ((attr A : S), ADS), TS, I, QIL) = crtObject2(O, V, TL, (F[T], TL'), ADS, TS, I, QIL) if qid(string(A) + "`:_") == F . eq crtObject2(O, V, (F[T], TL), TL', ADS, TS, I, QIL) = crtObject2(O, V, TL, TL', ADS, TS, I, (QIL '\r 'Warning: '\o 'Attribute F 'not 'valid '\n)) [owise] . ceq crtObject2(O, V, F[T], TL, ((attr A : S), ADS), TS, I, QIL) = crtObject3(O, V, (F[T], TL), ADS, TS, I, QIL) if qid(string(A) + "`:_") == F . eq crtObject2(O, V, F[T], TL, ADS, TS, I, QIL) = crtObject3(O, V, TL, ADS, TS, I, (QIL '\r 'Warning: '\o 'Attribute F 'not 'valid '\n)) [owise] . eq crtObject2(O, V, V', TL, ADS, TS, I, QIL) = crtObject3(O, V, TL, ADS, TS, I, QIL '\r 'Warning: '\o 'Variables 'are 'not 'allowed 'in 'the 'set 'of 'attributes 'of 'an 'object '`( V' '`) '\n) . eq crtObject2(O, V, 'none.AttributeSet, TL, ADS, TS, I, QIL) = crtObject3(O, V, TL, ADS, TS, I, QIL) . eq crtObject2(O, V, empty, TL, ADS, TS, I, QIL) = crtObject3(O, V, TL, ADS, TS, I, QIL) . *** When the function \texttt{crtObject2} has gone through all the *** attributes in the current object, the function \texttt{crtObject3} is *** in charge of returning the metarepresentation of the current object *** completed with the attributes that did not appear in it. These attributes *** are added with new variables not used in the axiom as value. *** \texttt{crtObject3} returns a pair composed by this resulting object, *** and the set of terms representing all the objects in the lefthand *** side (the current object is added to this set). eq crtObject3(O, V, TL, ((attr A : S), ADS), TS, I, QIL) = crtObject3(O, V, (qid(string(A) + "`:_")[newVar(S, I)], TL), ADS, TS, (I + 1), QIL) . eq crtObject3(O, V, TL, none, TS, I, QIL) = < '<_:_|_>[O, V, '_`,_[TL, newVar('AttributeSet, I)]] ; 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 : S /\ Cond) = prepRHS(TS, T) : S /\ prepRHS(TS, Cond) . eq prepRHS(TS, T := T' /\ Cond) = prepRHS(TS, T) := prepRHS(TS, T') /\ prepRHS(TS, Cond) . eq prepRHS(TS, T => T' /\ Cond) = prepRHS(TS, T) => prepRHS(TS, T') /\ prepRHS(TS, Cond) . eq prepRHS(TS, (nil).Condition) = nil . eq prepRHS(TS, qidError(QIL)) = qidError(QIL) . eq prepRHS(TS, F) = F . eq prepRHS(TS, Ct) = Ct . ceq prepRHS(TS, F[TL]) = F[prepRHS(TS, TL)] if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) . eq prepRHS(TS, '<_:_|_>[O, Ct, T]) = adjustObjectRHS(TS, '<_:_|_>[O, Ct, prepRHS(TS, T)]) . eq prepRHS(TS, '<_:_|_>[O, V, T]) = '<_:_|_>[O, V, prepRHS(TS, T)] . eq prepRHS(TS, '<_:_|`>[O, Ct]) = adjustObjectRHS(TS, '<_:_|_>[O, Ct, prepRHS(TS, 'none.AttributeSet)]) . eq prepRHS(TS, '<_:_|`>[O, V]) = '<_:_|_>[O, V, prepRHS(TS, 'none.AttributeSet)] . ceq prepRHS(TS, (T, TL)) = (prepRHS(TS, T), prepRHS(TS, TL)) if TL =/= empty . eq adjustObjectRHS(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']) = qidError(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]) = qidError(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 . ceq termAttrListToTermSet((T, TL)) = if T == 'none.AttributeSet then termAttrListToTermSet(TL) else termSet(T, termAttrListToTermSet(TL)) fi if TL =/= empty . eq termAttrListToTermSet(T) = if T == 'none.AttributeSet then emptyTermSet else T fi . *** In the case of equations and rules, the function \texttt{prepAxs} calls the *** function \texttt{prepLHS} with the term in the lefthand side of the axiom, *** and then use the generated set of objects to call the \texttt{prepRHS} *** function. For conditional equations, rules, and membership axioms, this set *** of terms representing the objects in the lefthand side is also used in the *** calls to \texttt{prepRHS} with each of the terms in the conditions. The *** term in the lefthand side of the equation, rule, or membership axiom is *** replaced by the term returned by \texttt{prepLHS}. The index is used in *** the recursive calls to \texttt{prepAxs}. *** \texttt{prepLHS} returns as second argument the set of objects (as a set of *** terms) appearing in it. These objects are returned after extending their *** set of attributes by those of the class to which they belong not already *** specified. op prepAxs : Module MembAxSet EquationSet RuleSet ClassDeclSet Nat QidList -> Module . eq prepAxs(U, ((mb T : S [AtS] .) MAS), EqS, RlS, CDS, I, QIL) = prepAxs( addMbs(mb term(prepLHS(T, CDS, I)) : S [AtS] ., U), MAS, EqS, RlS, CDS, index(prepLHS(T, CDS, I)), (QIL messages(prepLHS(T, CDS, I)))) . eq prepAxs(U, ((cmb T : S if Cond [AtS] .) MAS), EqS, RlS, CDS, I, QIL) = prepAxs( addMbs(cmb term(prepLHS(T, CDS, I)) : S if prepRHS(objects(prepLHS(T, CDS, I)), Cond) [AtS] ., U), MAS, EqS, RlS, CDS, index(prepLHS(T, CDS, I)), (QIL messages(prepLHS(T, CDS, I)))) . eq prepAxs(U, MAS, ((eq T = T' [AtS] .) EqS), RlS, CDS, I, QIL) = prepAxs( addEqs(eq term(prepLHS(T, CDS, I)) = prepRHS(objects(prepLHS(T, CDS, I)), T') [AtS] ., U), MAS, EqS, RlS, CDS, index(prepLHS(T, CDS, I)), (QIL messages(prepLHS(T, CDS, I)))) . eq prepAxs(U, MAS, ((ceq T = T' if Cond [AtS] .) EqS), RlS, CDS, I, QIL) = prepAxs( addEqs(ceq term(prepLHS(T, CDS, I)) = prepRHS(objects(prepLHS(T, CDS, I)), T') if prepRHS(objects(prepLHS(T, CDS, I)), Cond) [AtS] ., U), MAS, EqS, RlS, CDS, index(prepLHS(T, CDS, I)), (QIL messages(prepLHS(T, CDS, I)))) . eq prepAxs(U, MAS, EqS, ((rl T => T' [AtS] .) RlS), CDS, I, QIL) = prepAxs( addRls(rl term(prepLHS(T, CDS, I)) => prepRHS(objects(prepLHS(T, CDS, I)), T') [AtS] ., U), MAS, EqS, RlS, CDS, index(prepLHS(T, CDS, I)), (QIL messages(prepLHS(T, CDS, I)))) . eq prepAxs(U, MAS, EqS, ((crl T => T' if Cond [AtS] .) RlS), CDS, I, QIL) = prepAxs( addRls(crl term(prepLHS(T, CDS, I)) => prepRHS(objects(prepLHS(T, CDS, I)), T') if prepRHS(objects(prepLHS(T, CDS, I)), Cond) [AtS] ., U), MAS, EqS, RlS, CDS, index(prepLHS(T, CDS, I)), (QIL messages(prepLHS(T, CDS, I)))) . eq prepAxs(U, none, none, none, CDS, I, QIL) = if QIL == nil then U else unitError(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 : OModule Database -> SModule . op omod2modAux : OModule ClassDeclSet -> SModule . eq omod2mod( omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, DB) = omod2modAux( omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, prepClasses(CDS, SCDS, IL, getParDecls(H), DB)) . eq omod2mod( oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, DB) = omod2modAux( oth H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, prepClasses(CDS, SCDS, IL, getParDecls(H), DB)) . eq omod2modAux( omod H is IL sorts SS . SSDS ((class C | ADS .) CDS) SCDS OPDS MDS MAS EqS RlS endom, CDS') = omod2modAux( omod H is IL sorts (SS ; C) . (subsort C < 'Cid . SSDS) CDS SCDS ((op C : nil -> C [none] .) ops4Attr(ADS) OPDS) MDS MAS EqS RlS endom, CDS') . eq omod2modAux( omod H is IL sorts SS . SSDS CDS ((subclass C < C' .) SCDS) OPDS MDS MAS EqS RlS endom, CDS') = omod2modAux( omod H is IL sorts SS . ((subsort C < C' .) SSDS) CDS SCDS OPDS MDS MAS EqS RlS endom, CDS') . eq omod2modAux( omod H is IL sorts SS . SSDS CDS SCDS OPDS ((msg F : TyL -> Ty .) MDS) MAS EqS RlS endom, CDS') = omod2modAux( omod H is IL sorts SS . SSDS CDS SCDS ((op F : TyL -> Ty [none] .) OPDS) MDS MAS EqS RlS endom, CDS') . eq omod2modAux( omod H is IL sorts SS . SSDS none none OPDS none MAS EqS RlS endom, CDS) = prepAxs(mod H is IL sorts SS . SSDS OPDS none none none endm, MAS, EqS, RlS, CDS, 0, nil) . eq omod2modAux( oth H is IL sorts SS . SSDS ((class C | ADS .) CDS) SCDS OPDS MDS MAS EqS RlS endoth, CDS') = omod2modAux( oth H is IL sorts (SS ; C) . (subsort C < 'Cid . SSDS) CDS SCDS ((op C : nil -> C [none] .) ops4Attr(ADS) OPDS) MDS MAS EqS RlS endoth, CDS') . eq omod2modAux( oth H is IL sorts SS . SSDS CDS ((subclass C < C' .) SCDS) OPDS MDS MAS EqS RlS endoth, CDS') = omod2modAux( oth H is IL sorts SS . ((subsort C < C' .) SSDS) CDS SCDS OPDS MDS MAS EqS RlS endoth, CDS') . eq omod2modAux( oth H is IL sorts SS . SSDS CDS SCDS OPDS ((msg F : TyL -> Ty .) MDS) MAS EqS RlS endoth, CDS') = omod2modAux( oth H is IL sorts SS . SSDS CDS SCDS ((op F : TyL -> Ty [none] .) OPDS) MDS MAS EqS RlS endoth, CDS') . eq omod2modAux( oth H is IL sorts SS . SSDS none none OPDS none MAS EqS RlS endoth, CDS) = prepAxs( th H is IL sorts SS . SSDS OPDS none none none endth, MAS, EqS, RlS, CDS, 0, nil) . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** *** Evaluation of Modules and Theories *** *** As explained in Section~\ref{evaluation-overview}, in our approach *** transforming a module from its possibly complex structured version to its *** unstructured form is a two-step process. First, all module expressions *** are evaluated, generating an intermediate form in which there are only *** simple inclusion relationships among the modules. This first step can be *** seen as the reduction of a structured specification to its structured *** \emph{normal form}. Then, in a second step, this structured normal form is *** flattened into an unstructured specification. Note, however, that the *** importation of built-in modules is left explicit in the flattened form. *** The function \texttt{normalize} is in charge of normalizing the *** structure. *** The process of evaluation of a preunit has to take into account the *** possibility of bubbles being contained in it. Depending on whether it is *** dealing with a preunit or with a unit, the evaluation process is *** accomplished by two different functions, namely, \texttt{evalPreModule} and *** \texttt{evalModule}. One function or the other will be called in each case. *** Evaluating a module already in the database, which is done by *** \texttt{evalModule}, does not require bubble handling. Besides this *** difference, both functions proceed in a similar way. Before presenting the *** functions \texttt{evalPreModule} and \texttt{evalModule} we introduce some *** auxiliary declarations. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod EVALUATION is pr O-O-TO-SYSTEM-MOD-TRANSF . pr MOD-EXPR-EVAL . pr UNIT-BUBBLE-PARSING . sort List . subsort Module < List . op nil : -> List . op __ : List List -> List [assoc id: nil] . eq unitError(QIL) UL unitError(QIL') = unitError(QIL QIL') UL . vars M PU U U' U'' : Module . vars UL UL' : List . vars DB DB' : Database . vars ME ME' : ModuleExpression . var P : ViewExp . var PD : ParameterDecl . vars PL PL' PL'' : ParameterList . vars IL IL' IL'' : ImportList . var I : Import . var CDS : ClassDeclSet . var SSDS : SubsortDeclSet . var SCDS : SubclassDeclSet . var OPD : OpDecl . vars OPDS VDS : OpDeclSet . var MDS : MsgDeclSet . var MAS : MembAxSet . var EqS : EquationSet . var RlS : RuleSet . var B : Bool . vars QI QI' V L L' L'' A A' A'' F F' F'' X Y W Z : Qid . vars QIL QIL' SL : QidList . vars S S' S'' C C' C'' : Sort . vars SS SS' : SortSet . vars Ty Ty' : Type . vars TyL TyL' : TypeList . vars AtS AtS' : AttrSet . var Rl : Rule . var CD : ClassDecl . var ADS : AttrDeclSet . var MD : MsgDecl . vars T T' T'' T3 : Term . var TL : TermList . var VMAP : ViewMap . var VMAPS : RenamingSet . var MAP : Renaming . var MAPS : RenamingSet . vars VE VE' VE'' : ViewExp . var HkL : HookList . vars PDL PDL' : ParameterDeclList . *** The \texttt{subunitImports} function returns the list of all the *** subunits of a given unit. It is called with the list of importations of *** the given unit as first argument, and proceeds recursively through its *** structure collecting all the subunits in it. *** The function \texttt{subunitImports} proceeds storing the importations *** considered up to that point, so it does not have to go through the same *** part of the structure more than once. When the function is initially *** called the second argument is set to \texttt{nil}. op subunitImports : ParameterDeclList ImportList Database -> ImportList . op subunitImports : ImportList ImportList Database -> ImportList . eq subunitImports((PD, PDL), IL, DB) = subunitImports(PDL, IL (protecting pd(PD) .), DB) . eq subunitImports((nil).ParameterDeclList, IL, DB) = subunitImports(IL, nil, DB) . eq subunitImports(I IL, IL' I IL'', DB) = subunitImports(IL, IL' I IL'', DB) . eq subunitImports(I IL, IL', DB) = subunitImports(getImports(getTopModule(moduleName(I), DB)) IL, I IL', DB) [owise] . eq subunitImports((nil).ImportList, IL, DB) = IL . *** The function \texttt{getModules} returns the list of those units *** in the list of importations given as argument which are not built-in. op getModules : ImportList Database -> List . op getModules : ImportList List Database -> List . eq getModules(IL, DB) = getModules(IL, nil, DB) . eq getModules(((including ME .) IL), UL, DB) = getModules(IL, (UL getInternalModule(ME, DB)), DB) . eq getModules(((including pd(PD) .) IL), UL, DB) = getModules(IL, (UL getInternalModule(pd(PD), DB)), DB) . eq getModules(((extending ME .) IL), UL, DB) = getModules(IL, (UL getInternalModule(ME, DB)), DB) . eq getModules(((extending pd(PD) .) IL), UL, DB) = getModules(IL, (UL getInternalModule(pd(PD), DB)), DB) . eq getModules(((protecting ME .) IL), UL, DB) = getModules(IL, (UL getInternalModule(ME, DB)), DB) . eq getModules(((protecting pd(PD) .) IL), UL, DB) = getModules(IL, (UL getInternalModule(pd(PD), DB)), DB) . eq getModules(IL, UL unitError(QIL) UL', DB) = unitError(QIL) . eq getModules(nil, UL, DB) = UL . *** The normalization of a structure consists in evaluating each of the module *** expressions appearing in it. Note that, if the \texttt{evalModExp} function *** generates new modules, they will be evaluated using the \texttt{evalModule} *** function, producing recursive calls on the part of the structure not *** previously normalized. Parameters are handled separatedly. They are *** folded out when analyzing the interface of a module. sort Tuple . op <_;_;_> : ImportList ParameterDeclList Database -> Tuple . op importList : Tuple -> ImportList . op parameterDeclList : Tuple -> ParameterDeclList . op database : Tuple -> Database . eq importList(< IL ; PDL ; DB >) = IL . eq parameterDeclList(< IL ; PDL ; DB >) = PDL . eq database(< IL ; PDL ; DB >) = DB . op normalize : ImportList ParameterDeclList Database -> Tuple . op normalize : ImportList ImportList ParameterDeclList ParameterDeclList Database -> Tuple . op createCopy : ParameterDecl Database -> Database . ---- its definition is in INST-EXPR-EVALUATION eq normalize(IL, PDL, DB) = normalize(nil, IL, nil, PDL, DB) . eq normalize(IL, IL', PDL, (X :: ME, PDL'), DB) = normalize(IL, IL', (PDL, X :: modExp(evalModExp(ME, nil, DB))), PDL', createCopy((X :: modExp(evalModExp(ME, nil, DB))), database(evalModExp(ME, nil, DB)))) . eq normalize(IL, (including ME .) IL', PDL, PDL', DB) = normalize(IL (including modExp(evalModExp(ME, PDL, DB)) .), IL', PDL, PDL', database(evalModExp(ME, PDL, DB))) . eq normalize(IL, (extending ME .) IL', PDL, PDL', DB) = normalize(IL (extending modExp(evalModExp(ME, PDL, DB)) .), IL', PDL, PDL', database(evalModExp(ME, PDL, DB))) . eq normalize(IL, (protecting ME .) IL', PDL, PDL', DB) = normalize(IL (protecting modExp(evalModExp(ME, PDL, DB)) .), IL', PDL, PDL', database(evalModExp(ME, PDL, DB))) . eq normalize(IL, I IL', PDL, PDL', DB) = normalize(IL I, IL', PDL, PDL', DB) [owise] . eq normalize(IL, nil, PDL, nil, DB) = < IL ; PDL ; DB > . *** \texttt{checkSortClashes} checks whether the intersection of the two sTS *** of sorts given as arguments is empty or not. If it is nonempty, then there *** is a clash of names, and a warning message is passed to the database. The *** check is very simple, and only reports the name of one of the modules from *** which the sorts come. Only the name of the module from which the sorts *** given as second argument come is known at this point. This is the module *** name given as first argument. *** *** op checkSortClashes : Header SortSet SortSet Database -> Database . *** *** eq checkSortClashes(ME, (S ; SS), (S ; SS'), DB) *** = checkSortClashes(ME, SS, SS', *** warning(DB, *** '\g 'Advisory: '\o *** 'Clash 'of 'sort eSortToSort(S) 'from header2Qid(ME) '\n)) . *** ceq checkSortClashes(ME, (S ; SS), SS', DB) *** = checkSortClashes(ME, SS, SS', DB) *** if not (S inSortSet SS') . *** eq check(ME, none, SS, DB) = DB . *** In the current system, the only transformation handled by the *** \texttt{transform} function is the one from object-oriented modules to *** system modules, which is accomplished by the *** \texttt{omod2mod} function presented in *** Section~\ref{omod2modfunction}. However, \texttt{transform} has been *** defined as a general transformation that could affect other kinds of *** modules in a future extension. *** Changed 5/5/03: theories are handled internally op transform : Module Database -> Module . eq transform(unitError(QIL), DB) = unitError(QIL) . ceq transform(U, DB) = U if U :: SModule or U :: STheory . eq transform(U, DB) = omod2mod(U, DB) [owise] . *** The function \texttt{signature} generates a functional module of sort *** \texttt{FModule}, without equations, by ``forgetting'' the appropriate *** declarations and converting extended sorts and module names into quoted *** identifiers. op removeIds : OpDeclSet Module -> OpDeclSet . eq removeIds(op F : TyL -> Ty [id(T) AtS] . OPDS, M) = removeIds(op F : TyL -> Ty [AtS] . OPDS, M) . eq removeIds(op F : TyL -> Ty [right-id(T) AtS] . OPDS, M) = removeIds(op F : TyL -> Ty [AtS] . OPDS, M) . eq removeIds(op F : TyL -> Ty [left-id(T) AtS] . OPDS, M) = removeIds(op F : TyL -> Ty [AtS] . OPDS, M) . eq removeIds(op F : TyL -> Ty [special(term-hook(QI, T) HkL) AtS] . OPDS, M) = removeIds(op F : TyL -> Ty [special(HkL) AtS] . OPDS, M) . eq removeIds(OPDS, M) = OPDS [owise] . op removeDittos : OpDeclSet Module -> OpDeclSet . ceq removeDittos( op F : TyL -> Ty [ditto AtS] . op F : TyL' -> Ty' [AtS'] . OPDS, M) = removeDittos( op F : TyL -> Ty [AtS AtS'] . op F : TyL' -> Ty' [AtS'] . OPDS, M) if ditto in AtS' =/= true /\ sameKind(M, TyL Ty, TyL' Ty') . eq removeDittos(OPDS, M) = OPDS [owise] . op signature : Module -> Module . eq signature(unitError(QIL)) = unitError(QIL) . eq signature(U) = fmod header2Qid(getName(U)) is convertModuleExpressions(getImports(U)) sorts getSorts(U) . getSubsorts(U) removeIds( removeDittos(getOps(U), setSubsorts( setSorts(emptyFModule('DUMMY), getSorts(U)), getSubsorts(U))), setSubsorts( setSorts(emptyFModule('DUMMY), getSorts(U)), getSubsorts(U))) none none endfm [owise] . *** The function \texttt{flatModule} generates a module of sort \texttt{Module} *** by ``forgetting'' declarations and converting extended sorts and module *** identifiers into quoted identifiers. op flatModule : Module -> Module . eq flatModule(unitError(QIL)) = unitError(QIL) . eq flatModule(U) = if U :: FModule or U :: FTheory then (fmod header2Qid(getName(U)) is getImports(U) sorts getSorts(U) . getSubsorts(U) getOps(U) getMbs(U) getEqs(U) endfm) else (mod header2Qid(getName(U)) is getImports(U) sorts getSorts(U) . getSubsorts(U) getOps(U) getMbs(U) getEqs(U) getRls(U) endm) fi [owise] . op convertModuleExpressions : ImportList -> ImportList . eq convertModuleExpressions(((protecting ME * (MAPS) .) IL)) = (protecting ME * (renamings(MAPS)) .) convertModuleExpressions(IL) . eq convertModuleExpressions(((extending ME * (MAPS) .) IL)) = (extending ME * (renamings(MAPS)) .) convertModuleExpressions(IL) . eq convertModuleExpressions(((including ME * (MAPS) .) IL)) = (including ME * (renamings(MAPS)) .) convertModuleExpressions(IL) . eq convertModuleExpressions(I IL) = I convertModuleExpressions(IL) [owise] . eq convertModuleExpressions(nil) = nil . op renamings : RenamingSet -> RenamingSet . eq renamings(op F to F' [AtS]) = op F to F' [AtS] . eq renamings((op F to F' [AtS], MAPS)) = (op F to F' [AtS], renamings(MAPS)) [owise] . eq renamings(op F : TyL -> Ty to F' [AtS]) = op F : TyL -> Ty to F' [AtS] . eq renamings((op F : TyL -> Ty to F' [AtS], MAPS)) = (op F : TyL -> Ty to F' [AtS], renamings(MAPS)) [owise] . eq renamings(sort S to S') = sort S to S' . eq renamings(((sort S to S'), MAPS)) = ((sort S to S'), renamings(MAPS)) [owise] . eq renamings(label L to L') = label L to L' . eq renamings(((label L to L'), MAPS)) = ((label L to L'), renamings(MAPS)) [owise] . eq renamings((MAP, MAPS)) = renamings(MAPS) [owise] . eq renamings(none) = none . *** The evaluation process for units without bubbles is as follows. After *** normalizing the structure, the function \texttt{evalModule} calls *** \texttt{evalModule1} with an empty copy of the module to which the list of *** declarations of importations of built-in modules is added, and with the *** list of its nonbuilt-in subunits. *** \texttt{evalModule1} accumulates all the declarations in all the *** nonbuilt-insubmodules in the copy of the module passed as second argument. *** The top module is then introduced in the database, and, after calling the *** \texttt{transform} function and renaming all the variables in it, the *** internal version of such a module is entered in the database as well. *** Finally, \texttt{evalModule2} generates the signature and the flat version *** of the module and enters them in the database. *** op evalModule : Module Database -> Database . *** moved to MOD-EXPR-EVAL to solve dependency op evalModule1 : Module Module List OpDeclSet Database -> Database . op evalModule2 : Module Module Database -> Database . ***( ceq evalModule(U, VDS, DB) = evalModule1(setPars(setImports(U, IL), PDL), empty(U), getModules(IL', DB'), VDS, DB') if IL := importList(normalize(getImports(U), getPars(U), DB)) /\ PDL := parameterDeclList(normalize(getImports(U), getPars(U), DB)) /\ DB' := database(normalize(getImports(U), getPars(U), DB)) /\ IL' := subunitImports(PDL, IL, DB') . ) eq evalModule(U, VDS, DB) = evalModule1(setPars(setImports(U, importList(normalize(getImports(U), getPars(U), DB))), parameterDeclList(normalize(getImports(U), getPars(U), DB))), empty(U), getModules(subunitImports(parameterDeclList(normalize(getImports(U), getPars(U), DB)), importList(normalize(getImports(U), getPars(U), DB)), database(normalize(getImports(U), getPars(U), DB))), database(normalize(getImports(U), getPars(U), DB))), VDS, database(normalize(getImports(U), getPars(U), DB))) . eq evalModule(unitError(QIL), VDS, DB) = warning(DB, QIL) . eq evalModule1(U, U', (U'' UL), VDS, DB) = evalModule1(U, addDecls(U', setImports(U'', nil)), UL, VDS, DB) . eq evalModule1(U, U', nil, VDS, DB) = evalModule2( setImports(transform(U, DB), nil), U', insertVars(getName(U), VDS, insertInternalModule(getName(U), transform(U, DB), insertTopModule(getName(U), U, DB)))) . eq evalModule1(U, U', unitError(QIL), VDS, DB) = warning(DB, QIL) . eq evalModule2(U, U', DB) = insertFlatModule(getName(U), flatModule(addDecls(U, U')), DB) . eq evalModule2(unitError(QIL), U, DB) = warning(DB, QIL) . *** The function \texttt{evalPreModule} has to take care of the bubbles in the *** unit. As we explained in Section~\ref{evaluation-overview}, both the *** signature and the flattened version of the module are created *** simultaneously, completing the parsing of the bubbles once the signature *** has been built, and then completing the flattened module. *** The \texttt{evalPreModule} function takes as arguments two copies of the *** module and a database. We shall see in Section~\ref{unit-processing} how *** these two modules are generated; the one passed as first argument has *** still bubbles in it, while the other one, which will be used to build the *** signature, does not contain any bubbles. This module without bubbles is *** the result of removing the bubbles from the declarations in it, or of *** removing the declarations themselves when they contain bubbles, as in the *** case of equations, for example. *** The \texttt{evalPreModule} function is quite similar to the function *** \texttt{evalModule}. First, the structure is normalized by calling the *** \texttt{normalize} function, and then all the subunits in the *** structure are collected (accomplished by \texttt{subunitImports} and *** \texttt{getModules}) and the list of importations is updated *** with the sublist of importations of built-in *** modules (\texttt{selectBuiltInImports}). Second, the structure of all the *** subunits below the top is flattened to a single unit. This unit is used to *** create a first version of the signature (without identity elements of *** operators) in which all the bubbles in the top preunit are *** parsed (\texttt{solveBubbles}). The final version of the signature and *** the flat unit are generated once the bubbles have been parsed. The *** `internal' version of the module is also generated by renaming the *** variables in it (\texttt{renameVars}). All these versions of the module *** are finally entered in the database. *** Note that if the \texttt{META-LEVEL} module is imported in the module *** being evaluated, a declaration importing the predefined module *** \texttt{UP} Section~\ref{non-built-in-predefined}) is added. With the *** declarations in this module it will be possible to parse bubbles *** containing calls to the \texttt{up} functions (see *** Section~\ref{structured-specifications}) in them. op evalPreModule : Module Module OpDeclSet Database -> Database . op evalPreModule1 : Module Module List Module OpDeclSet Database -> Database . op evalPreModule2 : Module Module Module OpDeclSet Database -> Database . op evalPreModule3 : Module Module Module Database -> Database . *** evalPreModule just calls evalPreModule1 with a set of the units in the *** structure of the given module. Depending on whether the module is *** importing META-LEVEL or not UP will be added. BOOL will be added if *** the include BOOL flag is set and the module doesn't include it already. ***( ceq evalPreModule(PU, U, VDS, DB) *** PU : top unit with bubbles (preunit) *** U : top unit without bubbles (decls with bubbles were removed) *** VDS : ops corresponding to the vbles in the top unit = evalPreModule1( setPars(setImports(PU, IL'), PDL'), setName(empty(U), getName(U)), getModules(IL'', DB'), setImports(U, nil), VDS, DB') if IL := getImports(PU) /\ PDL := getPars(PU) /\ IL' := importList(normalize(defImports(PU, DB) IL, PDL, DB)) /\ PDL' := parameterDeclList(normalize(defImports(PU, DB) IL, PDL, DB)) /\ DB' := database(normalize(defImports(PU, DB) IL, PDL, DB)) /\ IL'' := subunitImports(PDL, IL', DB') . ) eq evalPreModule(PU, U, VDS, DB) *** PU : top unit with bubbles (preunit) *** U : top unit without bubbles (decls with bubbles were removed) *** VDS : ops corresponding to the vbles in the top unit = evalPreModule1( setPars(setImports(PU, importList(normalize(defImports(PU, DB) getImports(PU), getPars(PU), DB))), parameterDeclList(normalize(defImports(PU, DB) getImports(PU), getPars(PU), DB))), setName(empty(U), getName(U)), getModules(subunitImports(getPars(PU), importList(normalize(defImports(PU, DB) getImports(PU), getPars(PU), DB)), database(normalize(defImports(PU, DB) getImports(PU), getPars(PU), DB))), database(normalize(defImports(PU, DB) getImports(PU), getPars(PU), DB))), setImports(U, nil), VDS, database(normalize(defImports(PU, DB) getImports(PU), getPars(PU), DB))) . eq evalPreModule(PU, U, VDS, DB) = DB [owise] . *** evalPreModule1 joins all the units in the structure into a single unit, *** the one given as second argument; recall that the fourth one is the *** top module without bubbles but with the complete list of subunits *** being imported explicitly eq evalPreModule1(PU, U, (U' UL), U'', VDS, DB) = evalPreModule1(PU, addDecls(U, U'), UL, U'', VDS, DB) . eq evalPreModule1(PU, U, nil, U', VDS, DB) = evalPreModule2(PU, U, signature(transform(addDecls(U', setImports(U, nil)), DB)), VDS, DB) [owise] . eq evalPreModule1(PU, unitError(QIL), UL, U', VDS, DB) = warning(DB, QIL) . eq evalPreModule1(unitError(QIL), U, UL, U', VDS, DB) = warning(DB, QIL) . eq evalPreModule1(PU, U, unitError(QIL), U', VDS, DB) = warning(DB, QIL) . eq evalPreModule2(PU, U, M, VDS, DB) *** PU : top module with bubbles *** U : everything below *** M : complete signature = evalPreModule3( solveBubblesMod(PU, getOps(U), M, included('META-MODULE, getImports(PU), DB), VDS, DB), U, M, insertVars(getName(PU), VDS, insertTopModule(getName(PU), solveBubblesMod(PU, getOps(U), M, included('META-MODULE, getImports(PU), DB), VDS, DB), DB))) . eq evalPreModule3(PU, U, M, DB) *** PU : top module without bubbles *** U : everything below *** M : complete signature = insertFlatModule(getName(PU), flatModule(setImports(transform(addDecls(PU, U), DB), nil)), insertInternalModule(getName(PU), transform(PU, DB), DB)) . eq evalPreModule3(unitError(QIL), U, M, DB) = warning(DB, QIL) . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** Note that in both \texttt{evalModule} and \texttt{evalPreModule}, the function *** \texttt{transform} has to be invoked to transform the module into a *** functional or system module. In the current system, the only *** transformation available is from object-oriented modules to system modules. *** *** 6.8 Application of Map STS *** *** The following two modules deal with the application of a set of renaming *** maps to a module. Except for the proof obligations and additional checks *** associated with views---almost none of these checks are performed, and *** none of these proof obligations is generated in the current version---the *** way of applying a renaming map and a view map on a module is the same. *** Internally, they are treated in the same way; the only difference between *** them consists in the way of calling the function to accomplish this *** application. *** Note that there might be some `interference' between sort maps, and *** operator maps and message maps when they are applied. Let us consider for *** example a module with an operator declaration *** *** op f : Foo -> Foo . *** *** and a renaming map set *** *** (sort Foo to Bar, op f : Foo -> Foo to g) *** *** These renamings have to be applied carefully to avoid unintended behaviors. *** Depending on which of the maps is applied first, the other will be *** applicable or not. All the maps must be applied to the original module. *** To avoid the interference between the sort maps and other maps, the map set *** is divided into two sTS: The first one contains the sort maps, and the *** second one contains the other maps. *** We assume that there are no ambiguous mappings, that is, that we do not *** have, for example, maps \verb~op f to g~ and \verb~op f to h~. In case of *** such ambiguity, one of the maps will be arbitrarily chosen. *** *** 6.8.1 Map STS on Terms *** *** The application of a set of view maps to a term is defined in the following *** module \texttt{VIEW-MAP-SET-APPL-ON-TERM}. The function *** \texttt{applyMapsToTerm} is used to apply a given view map set to terms *** appearing in equations, rules, identity element declarations, and *** membership axioms, as part of the process of applying a map set to a unit. *** Some of the auxiliary functions introduced in this module will also be used *** in the application of maps to operator and message declarations in the *** \texttt{VIEW-MAP-SET-APPL-ON-UNIT} module. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod VIEW-MAP-SET-APPL-ON-TERM is pr UNIT . pr VIEW-MAP . pr EXT-SORT . var VMAP : ViewMap . vars VMAPS VMAPS' VMAPS'' : Set{ViewMap} . var M : Module . vars F F' F'' A A' A'' : Qid . vars T T' T'' O : Term . vars TL TL' TL'' TL3 : TermList . vars S S' S'' C C' C'' : Sort . var SS : SortSet . var K : Kind . vars TyL TyL' : TypeList . vars Ty Ty' : Type . vars Subst Subst' Subst'' : Substitution . var AtS : AttrSet . var OPDS : OpDeclSet . vars V V' : Variable . vars Ct Ct' : Constant . var QIL : QidList . *** The following functions \texttt{applyMapsToSort} and *** \texttt{applyMapsToClassSort} apply a set of maps, respectively, to a *** sort a to a class name in its single identifier form, that is, when they *** appear qualifying constants. Functions \texttt{applyMapsToType} and *** \texttt{applyMapsToClassName} are similar but being applied to sort or *** class names in their normal form. op applyMapsToSort : Set{ViewMap} Sort -> Sort . eq applyMapsToSort((sort S to S'), S) = S' . eq applyMapsToSort((sort S to S'), S'') = S'' [owise] . eq applyMapsToSort(((sort S to S'), VMAPS), S) = S' . eq applyMapsToSort(((sort S to S'), VMAPS), S'') = applyMapsToSort(VMAPS, S'') [owise] . eq applyMapsToSort(VMAP, S) = S [owise]. eq applyMapsToSort((VMAP, VMAPS), S) = applyMapsToSort(VMAPS, S) [owise]. eq applyMapsToSort(none, S) = S . op applyMapsToSortSet : Set{ViewMap} SortSet -> SortSet . eq applyMapsToSortSet(VMAPS, (S ; SS)) = (applyMapsToType(VMAPS, S) ; applyMapsToSortSet(VMAPS, SS)) . eq applyMapsToSortSet(VMAPS, none) = none . op applyMapsToType : Set{ViewMap} Type -> Type . eq applyMapsToType((sort S to S'), S) = S' . eq applyMapsToType((sort S to S'), S'') = S'' [owise] . eq applyMapsToType(((sort S to S'), VMAPS), S) = S' . eq applyMapsToType(((sort S to S'), VMAPS), S'') = applyMapsToType(VMAPS, S'') [owise] . eq applyMapsToType((sort S to S'), K) = qid("[" + string(applyMapsToType(sort S to S', getSort(K))) + "]") . eq applyMapsToType(((sort S to S'), VMAPS), K) = qid("[" + string(applyMapsToType(((sort S to S'), VMAPS), getSort(K))) + "]") . eq applyMapsToType(none, Ty) = Ty . op applyMapsToClassName : Set{ViewMap} Sort -> Sort . eq applyMapsToClassName((class C to C'), C) = C' . eq applyMapsToClassName((class C to C'), C'') = C'' [owise] . eq applyMapsToClassName(((class C to C'), VMAPS), C) = C' . eq applyMapsToClassName(((class C to C'), VMAPS), C'') = applyMapsToClassName(VMAPS, C'') [owise] . eq applyMapsToClassName(VMAP, C) = C [owise] . eq applyMapsToClassName((VMAP, VMAPS), C) = applyMapsToClassName(VMAPS, C) [owise] . eq applyMapsToClassName(none, C) = C . *** \texttt{} applies a map set to an operator name. op applyOpMapsToOpId : Qid Set{ViewMap} -> Qid . eq applyOpMapsToOpId(F, (op F to F' [AtS])) = F' . eq applyOpMapsToOpId(F, (op F : TyL -> Ty to F' [AtS])) = F' . eq applyOpMapsToOpId(F, VMAPS) = F [owise] . *** Note that all maps introduced in Sections~\ref{renaming-maps} *** and~\ref{view-maps}, except for label maps, may affect a term. For example, *** sort maps will be applied to the qualifications of terms, and class and *** attribute maps have to be applied to the objects appearing in the term. *** Operator and message maps in which an explicit arity and coarity is given, *** and operator maps going to derived operators (see Section~\ref{Views}) *** must be applied to the complete family of subsort-overloaded operators. *** The function \texttt{applyMapsToTerm} takes as arguments two sTS of *** view maps (the first set for sort maps, and the second for the other maps), *** the term to which the maps will be applied, and a module to be used in the *** matching of terms, sort comparisons, etc. Its declaration is as follows. op applyMapsToTerm2 : Set{ViewMap} Set{ViewMap} Term Module -> Term . *** If the term on which the maps have to be applied is not an object, *** different cases have to be considered for each of the possible forms of a *** term. If it is a variable or \texttt{error*}, the same term is returned *** without change (term maps are a special case for this). If it is a sort *** test or a lazy sort test, with forms \verb~T : S~ and \verb~T :: S~, *** respectively, the maps are applied to the term \texttt{T} and to the sort *** \texttt{S}. In case of being of forms \verb~F.S~ or \verb~F[TL]~ with *** \texttt{F} an operator name, \texttt{S} a sort, and \texttt{TL} a list of *** terms, the function \texttt{getRightOpMaps} will return the subset of *** maps which are applicable on such term. If \texttt{none} is returned then *** no map is applicable. If more than one map is returned then there is an *** ambiguity, and any of them will be arbitrarily taken. The function *** \texttt{imagTerm} is called with the term and the maps applicable on *** it and return the image of the term. In case of a term of the form *** \texttt{F[TL]}, \texttt{imageOfTerm} will make recursive calls with the *** arguments in \texttt{TL}. *** The application of a term map to a term requires the `matching' of the *** source term in the map with the term on which the map is applied, and then *** the application of the obtained substitution. Note, however, that a *** complete matching algorithm is not required. Given the form of the pattern *** we can choose before hand the appropriate map, that is, we know that in *** fact there is a match when the function is called. Note also that the map *** has to be applied to the whole family of subsort overloaded operators. We *** just have to check that the sort of the given variable and the *** corresponding term are in the same connected component of sorts. In *** addition to getting the appropriate substitution, the only thing we need *** to check is that there are no variables with different assignments, that *** is, that in case of having a nonlinear pattern, the terms being assigned *** to each variable are equal. We call \texttt{pseudoMatch} to the function *** doing this task. op applyMapsToTerm2 : Set{ViewMap} Set{ViewMap} TermList Module -> TermList . op imageOfTerm : Set{ViewMap} Set{ViewMap} Term Set{ViewMap} Module -> Term . op applyMapsToSubst : Set{ViewMap} Set{ViewMap} Substitution Module -> Substitution . op pseudoMatch : TermList TermList Module Substitution -> Substitution . op pseudoMatch2 : TermList TermList Module Substitution -> Substitution . op pseudoMatchResult : Substitution -> Substitution . op pseudoMatchResult : Substitution Assignment Substitution Substitution -> Substitution . op applySubst : TermList Substitution -> TermList . op getRightOpMaps : Qid TypeList Type Set{ViewMap} Module -> Set{ViewMap} . op applyMapsToObjectAttrSet : Set{ViewMap} Set{ViewMap} Sort Term Module -> Term . op applyMapsToAttrNameInTerm : Set{ViewMap} Sort Qid Module -> Qid . eq applyMapsToTerm2(VMAPS, VMAPS', Ct, M) = imageOfTerm(VMAPS, VMAPS', Ct, getRightOpMaps(getName(Ct), nil, getType(Ct), VMAPS', M), M) . eq applyMapsToTerm2(VMAPS, VMAPS', V, M) = qid(string(getName(V)) + ":" + string(applyMapsToSort(VMAPS, getType(V)))) . eq applyMapsToTerm2(VMAPS, VMAPS', qidError(QIL), M) = qidError(QIL) . ceq applyMapsToTerm2(VMAPS, VMAPS', F[TL], M) = imageOfTerm(VMAPS, VMAPS', F[TL], getRightOpMaps(F, leastSort(M, TL), eLeastSort(M, F[TL]), VMAPS', M), M) if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) . eq applyMapsToTerm2(VMAPS, VMAPS', '<_:_|_>[O, Ct, T], M) = '<_:_|_>[applyMapsToTerm2(VMAPS, VMAPS', O, M), qid(string(applyMapsToClassName(VMAPS', getName(Ct))) + "." + string(applyMapsToClassName(VMAPS', getType(Ct)))), applyMapsToObjectAttrSet(VMAPS, VMAPS', getName(Ct), T, M)]. ceq applyMapsToTerm2(VMAPS, VMAPS', '<_:_|_>[O, C, T], M) = '<_:_|_>[applyMapsToTerm2(VMAPS, VMAPS', O, M), applyMapsToClassName(VMAPS', C), applyMapsToObjectAttrSet(VMAPS, VMAPS', C, T, M)] if not C :: Constant . eq applyMapsToTerm2(VMAPS, VMAPS', '<_:_|`>[O, Ct], M) = '<_:_|_>[applyMapsToTerm2(VMAPS, VMAPS', O, M), qid(string(applyMapsToClassName(VMAPS', getName(Ct))) + "." + string(applyMapsToClassName(VMAPS', getType(Ct)))), 'none.AttributeSet] . ceq applyMapsToTerm2(VMAPS, VMAPS', '<_:_|`>[O, C], M) = '<_:_|_>[applyMapsToTerm2(VMAPS, VMAPS', O, M), applyMapsToClassName(VMAPS', C), 'none.AttributeSet] if not C :: Constant . ceq applyMapsToTerm2(VMAPS, VMAPS', (T, TL), M) = (applyMapsToTerm2(VMAPS, VMAPS', T, M), applyMapsToTerm2(VMAPS, VMAPS', TL, M)) if TL =/= empty . *** Application of a map set to the name of an attribute in an object eq applyMapsToAttrNameInTerm((attr A . S to A'), C, A'', M) = if sameKind(M, S, C) and-then (qid(string(A) + "`:_") == A'') then qid(string(A') + "`:_") else A'' fi . eq applyMapsToAttrNameInTerm(((attr A . S to A'), VMAPS), C, A'', M) = if sameKind(M, S, C) and-then (qid(string(A) + "`:_") == A'') then qid(string(A') + "`:_") else applyMapsToAttrNameInTerm(VMAPS, C, A'', M) fi . eq applyMapsToAttrNameInTerm(VMAP, C, A, M) = A [owise] . eq applyMapsToAttrNameInTerm((VMAP, VMAPS), C, A, M) = applyMapsToAttrNameInTerm(VMAPS, C, A, M) [owise] . eq applyMapsToAttrNameInTerm(none, S, A, M) = A . *** Selection of all the operator or message maps that are applicable on an *** operator with a given arity and coarity. eq getRightOpMaps(F, TyL, Ty, (msg F' to F''), M) = getRightOpMaps(F, TyL, Ty, (op F' to F'' [none]), M) . eq getRightOpMaps(F, TyL, Ty, ((msg F' to F''), VMAPS), M) = getRightOpMaps(F, TyL, Ty, ((op F' to F'' [none]), VMAPS), M) . eq getRightOpMaps(F, TyL, Ty, (msg F' : TyL' -> Ty' to F''), M) = getRightOpMaps(F, TyL, Ty, op F' : TyL' -> Ty' to F'' [none], M) . eq getRightOpMaps(F, TyL, Ty, ((msg F' : TyL' -> Ty' to F''), VMAPS), M) = getRightOpMaps(F, TyL, Ty, (op F' : TyL' -> Ty' to F'' [none], VMAPS), M) . eq getRightOpMaps(F, TyL, Ty, (op F to F' [AtS]), M) = (op F to F' [AtS]) . eq getRightOpMaps(F, TyL, Ty, (op F to F' [AtS], VMAPS), M) = (op F to F' [AtS], getRightOpMaps(F, TyL, Ty, VMAPS, M)) . eq getRightOpMaps(F, TyL, Ty, op F : TyL' -> Ty' to F' [AtS], M) = if sameKind(M, TyL Ty, TyL' Ty') then (op F : TyL' -> Ty' to F' [AtS]) else none fi . eq getRightOpMaps(F, TyL, Ty, (op F : TyL' -> Ty' to F' [AtS], VMAPS), M) = if sameKind(M, TyL Ty, TyL' Ty') then (op F : TyL' -> Ty' to F' [AtS], getRightOpMaps(F, TyL, Ty, VMAPS, M)) else getRightOpMaps(F, TyL, Ty, VMAPS, M) fi . eq getRightOpMaps(F, TyL, Ty, termMap(F[TL], T), M) = if sameKind(M, TyL, varListSort(TL)) then (termMap(F[TL], T)) else none fi . eq getRightOpMaps(F, TyL, Ty, (termMap(F[TL], T), VMAPS), M) = if sameKind(M, TyL, varListSort(TL)) then (termMap(F[TL], T), getRightOpMaps(F, TyL, Ty, VMAPS, M)) else getRightOpMaps(F, TyL, Ty, VMAPS, M) fi . eq getRightOpMaps(F, TyL, Ty, (termMap(Ct, T)), M) = if TyL == nil and-then (F == getName(Ct) and-then sameKind(M, Ty, getType(Ct))) then (termMap(Ct, T)) else none fi . eq getRightOpMaps(F, TyL, Ty, (termMap(Ct, T), VMAPS), M) = if TyL == nil and-then (F == getName(Ct) and-then sameKind(M, Ty, getType(Ct))) then (termMap(Ct, T), getRightOpMaps(F, TyL, Ty, VMAPS, M)) else getRightOpMaps(F, TyL, Ty, VMAPS, M) fi . eq getRightOpMaps(F, TyL:[Type], Ty:[Type], VMAPS, M) = none [owise]. op varListSort : TermList -> TypeList . eq varListSort((V, TL)) = (getType(V) varListSort(TL)) . eq varListSort(empty) = nil . *** Application of a map set to the set of attributes in an object eq applyMapsToObjectAttrSet(VMAPS, VMAPS', C, '_`,_[A[T], TL], M) = '_`,_[applyMapsToAttrNameInTerm(VMAPS', C, A, M) [applyMapsToTerm2(VMAPS, VMAPS', T, M)], applyMapsToObjectAttrSet(VMAPS, VMAPS', C, TL, M)] . eq applyMapsToObjectAttrSet(VMAPS, VMAPS', C, A[T], M) = applyMapsToAttrNameInTerm(VMAPS', C, A, M) [applyMapsToTerm2(VMAPS, VMAPS', T, M)] . eq applyMapsToObjectAttrSet(VMAPS, VMAPS', C, '_`,_['none.AttributeSet, TL], M) = '_`,_['none.AttributeSet, applyMapsToObjectAttrSet(VMAPS, VMAPS', C, TL, M)] . eq applyMapsToObjectAttrSet(VMAPS, VMAPS', C, 'none.AttributeSet, M) = 'none.AttributeSet . *** Image of a term eq imageOfTerm(VMAPS, VMAPS', Ct, none, M) = qid(string(getName(Ct)) + "." + string(applyMapsToSort(VMAPS, getType(Ct)))) . eq imageOfTerm(VMAPS, VMAPS', F[TL], none, M) = F [ applyMapsToTerm2(VMAPS, VMAPS', TL, M) ] . eq imageOfTerm(VMAPS, VMAPS', F[TL], (op F to F' [AtS]), M) = F' [ applyMapsToTerm2(VMAPS, VMAPS', TL, M) ] . eq imageOfTerm(VMAPS, VMAPS', F[TL], ((op F to F' [AtS]), VMAPS''), M) = F' [ applyMapsToTerm2(VMAPS, VMAPS', TL, M) ] . eq imageOfTerm(VMAPS, VMAPS', F[TL], (op F : TyL -> Ty to F'[AtS]), M) = F' [ applyMapsToTerm2(VMAPS, VMAPS', TL, M) ] . eq imageOfTerm(VMAPS, VMAPS', F[TL], (op F : TyL -> Ty to F'[AtS], VMAPS''),M) = F' [ applyMapsToTerm2(VMAPS, VMAPS', TL, M) ] . eq imageOfTerm(VMAPS, VMAPS', T, termMap(T', T''), M) = applySubst(T'', applyMapsToSubst(VMAPS, VMAPS', pseudoMatch(T', T, M, none), M)) . eq imageOfTerm(VMAPS, VMAPS', T, (termMap(T', T''), VMAPS''), M) = applySubst(T'', applyMapsToSubst(VMAPS, VMAPS', pseudoMatch(T', T, M, none), M)) . ceq imageOfTerm(VMAPS, VMAPS', Ct, (op F to F' [AtS]), M) = qid(string(F') + "." + string(applyMapsToSort(VMAPS, getType(Ct)))) if getName(Ct) = F . ceq imageOfTerm(VMAPS, VMAPS', Ct, ((op F to F' [AtS]), VMAPS''), M) = qid(string(F') + "." + string(applyMapsToSort(VMAPS, getType(Ct)))) if getName(Ct) = F . ceq imageOfTerm(VMAPS, VMAPS', Ct, (op F : TyL -> Ty to F' [AtS]), M) = qid(string(F') + "." + string(applyMapsToSort(VMAPS, getType(Ct)))) if getName(Ct) = F . ceq imageOfTerm(VMAPS, VMAPS', Ct, (op F : TyL -> Ty to F' [AtS], VMAPS''),M) = qid(string(F') + "." + string(applyMapsToSort(VMAPS, getType(Ct)))) if getName(Ct) = F . *** Application of a Substitution on a term eq applySubst(T, none) = T . eq applySubst(V, ((V' <- T) ; Subst)) = if getName(V) == getName(V') then T else applySubst(V, Subst) fi . eq applySubst(F[TL], Subst) = F[applySubst(TL, Subst)] . eq applySubst(Ct, Subst) = Ct . ceq applySubst((T, TL), Subst) = (applySubst(T, Subst), applySubst(TL,Subst)) if TL =/= empty . *** PseudoMatch eq pseudoMatch(T, T', M, Subst) = pseudoMatchResult(pseudoMatch2(T, T', M, Subst)) . eq pseudoMatch2(Ct, Ct', M, Subst) = none . eq pseudoMatch2(F[TL], F'[TL'], M, Subst) = if F == F' then pseudoMatch2(TL, TL', M, Subst) else none fi . eq pseudoMatch2((V, TL), (T, TL'), M, Subst) = if sameKind(M, getType(V), leastSort(M, T)) then pseudoMatch2(TL, TL', M, (V <- T ; Subst)) else none fi . eq pseudoMatch2(V, T, M, Subst) = if sameKind(M, getType(V), leastSort(M, T)) then (V <- T ; Subst) else none fi . eq pseudoMatch2((V, TL), (T, TL'), M, Subst) = if sameKind(M, getType(V), leastSort(M, T)) then pseudoMatch2(TL, TL', M, (V <- T ; Subst)) else none fi . eq pseudoMatch2((Ct, TL), (Ct', TL'), M, Subst) = if getName(Ct) == getName(Ct') then pseudoMatch2(TL, TL', M, Subst) else none fi . eq pseudoMatch2((F[TL], TL'), (F'[TL''], TL3), M, Subst) = if F == F' then pseudoMatch2(TL', TL3, M, pseudoMatch2(TL, TL'', M, none) ; Subst) else none fi . eq pseudoMatch2(empty, empty, M, Subst) = Subst . *** pseudoMatchResult detects conflicts and eliminates duplicates eq pseudoMatchResult((V <- T) ; Subst) = pseudoMatchResult(none, (V <- T), none, Subst) . eq pseudoMatchResult(none) = none . eq pseudoMatchResult(Subst, (V <- T), Subst', (V' <- T') ; Subst'') = if V == V' then if T == T' then pseudoMatchResult(Subst, (V <- T), Subst', Subst'') else none fi else pseudoMatchResult(Subst, (V <- T), Subst' ; (V' <- T'), Subst'') fi . eq pseudoMatchResult(Subst, (V <- T), (V' <- T') ; Subst', none) = pseudoMatchResult(Subst ; (V <- T), (V' <- T'), none, Subst') . eq pseudoMatchResult(Subst, (V <- T), none, none) = (Subst ; (V <- T)) . *** Application of a set of maps to a substitution eq applyMapsToSubst(VMAPS, VMAPS', ((V <- T) ; Subst), M) = ((applyMapsToTerm2(VMAPS, VMAPS', V, M) <- applyMapsToTerm2(VMAPS, VMAPS', T, M)) ; applyMapsToSubst(VMAPS, VMAPS', Subst, M)) . eq applyMapsToSubst(VMAPS, VMAPS', none, M) = none . endfm ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- *** We do not include here the equations defining the semantics of the function *** \texttt{applyMapsToTerm}. Instead, we present an example illustrating *** the meaning of the function. Renaming maps and view maps were already *** discussed in Sections~\ref{Views} and~\ref{module-expressions}. *** Let us consider the following configuration in the module *** \texttt{STACK2[Accnt]} presented in Section~\ref{module-expressions}. In *** this configuration we have objects in the class \texttt{Accnt} which *** represent the accounts of different clients of a bank, which is *** represented as an object \texttt{'bank} of class \texttt{Stack[Accnt]}. *** The object \texttt{'bank} in the example configuration below keeps a stack *** with the accounts of the bank represented as a linked list of nodes, each *** of which corresponds to the account of one of the clients. *** ('bank push 'john) *** ('peter elt 2000) *** < 'bank : Stack[Accnt] | first : o ('bank, 1) > *** < 'paul : Accnt | bal : 5000 > *** < 'peter : Accnt | bal : 2000 > *** < 'mary : Accnt | bal : 7200 > *** < 'john : Accnt | bal : 100 > *** < o('bank, 0) : Node[Accnt] | node : 'peter, next : null > *** < o('bank, 1) : Node[Accnt] | node : 'mary, next : o('bank, 0) > . *** *** Let us apply the following renaming to the previous term. *** *** (op o to id, *** class Stack[Accnt] to Bank, *** msg _push_ : Oid Oid -> Msg to open`account`in_to_, *** msg _pop to close`account`of_, *** msg _elt_ to _owns_dollars, *** attr node . Node[Accnt] to client, *** attr bal . Accnt to balance) *** *** The resulting term is as follows. *** *** (open account in 'bank to 'john) *** ('peter owns 2000 dollars) *** < 'bank : Bank | first : id('bank, 1) > *** < 'paul : Accnt | balance : 5000 > *** < 'peter : Accnt | balance : 2000 > *** < 'mary : Accnt | balance : 7200 > *** < 'john : Accnt | balance : 100 > *** < id('bank, 0) : Node[Accnt] | client : 'peter, next : null > *** < id('bank, 1) : Node[Accnt] | client : 'mary, next : id('bank, 0) > *** The function \texttt{applyMapsToTerm} treats the object constructor *** \verb~<_:_|_>~ in a special way. It cannot be renamed, and, when an *** occurrence of such a constructor is found, class and attribute maps require *** a particular handling. Inside terms these maps are only triggered when *** this constructor is found, and they are applied in a very restricted way, *** according to the general pattern for objects. We assume that the operator *** \verb~<_:_|_>~ is only used for objects and that objects constructed using *** it are well-formed. *** *** 6.8.2 Map STS on Modules *** *** The application of view maps to modules and theories of the different types *** is defined in the following module \texttt{VIEW-MAP-SET-APPL-ON-UNIT}. The *** function \texttt{applyMapsToModule} is defined recursively by applying it *** to the different components of a unit. When the terms in the different *** declarations are reached, the function \texttt{applyMapsToTerm} is *** called. This call is made with the set of maps split conveniently, as *** explained above. ------------------------------------------------------------------------------- ******************************************************************************* ------------------------------------------------------------------------------- fmod VIEW-MAP-SET-APPL-ON-UNIT is pr VIEW-MAP-SET-APPL-ON-TERM . pr INT-LIST . pr VIEW-EXPR . op applyMapsToModule : Set{ViewMap} Module Module -> Module . op applyMapsToModuleAux : Set{ViewMap} Set{ViewMap} Module Module -> Module . op splitMaps : Set{ViewMap} -> Tuple{Set{ViewMap},Set{ViewMap}} . op splitMapsAux : Set{ViewMap} Set{ViewMap} Set{ViewMap} -> Tuple{Set{ViewMap},Set{ViewMap}} . op applyMapsToTypeList : Set{ViewMap} TypeList -> TypeList . op applyMapsToSubsorts : Set{ViewMap} SubsortDeclSet -> SubsortDeclSet . op applyMapsToOps : Set{ViewMap} Set{ViewMap} OpDeclSet Module -> OpDeclSet . op applyMapsToOp : Set{ViewMap} Set{ViewMap} Set{ViewMap} OpDecl Module -> OpDecl . op applyMapsToAttrs : Set{ViewMap} Set{ViewMap} AttrSet Module -> AttrSet . op applyMapToAttrs : ViewMap AttrSet -> AttrSet . op applyMapToAttrsAux : AttrSet AttrSet AttrSet -> AttrSet . op applyMapsToHooks : Set{ViewMap} Set{ViewMap} HookList Module -> HookList . op applyMapsToHooksAux : Set{ViewMap} Set{ViewMap} Hook Module -> Hook . op applyMapsToMbs : Set{ViewMap} Set{ViewMap} MembAxSet Module -> MembAxSet . op applyMapsToEqs : Set{ViewMap} Set{ViewMap} EquationSet Module -> EquationSet . op applyMapsToRls : Set{ViewMap} Set{ViewMap} RuleSet Module -> RuleSet . op applyMapsToCond : Set{ViewMap} Set{ViewMap} Condition Module -> Condition . op applyMapsToLabel : Set{ViewMap} Qid -> Qid . op applyMapsToClassDeclSet : Set{ViewMap} Set{ViewMap} ClassDeclSet -> ClassDeclSet . op applyMapsToSubclassDeclSet : Set{ViewMap} SubclassDeclSet -> SubclassDeclSet . op applyMapsToMsgDeclSet : Set{ViewMap} Set{ViewMap} MsgDeclSet Module -> MsgDeclSet . op applyMapsToMsgDecl : Set{ViewMap} Set{ViewMap} MsgDecl Module -> MsgDecl . op applyMapsToAttrName : Set{ViewMap} Sort Qid -> Qid . op applyMapsToAttrDeclSet : Set{ViewMap} Set{ViewMap} Sort AttrDeclSet -> AttrDeclSet . vars M U : Module . vars QI QI' QI'' L L' L'' F F' F'' A A' A'' : Qid . vars V V' : Variable . vars QIL QIL' : QidList . var VE : ViewExp . var H : Header . var ME : ModuleExpression . var PDL : ParameterDeclList . var IL : ImportList . vars S S' S'' C C' C'' : Sort . var Ty : Type . vars TyL TyL' : TypeList . var SS : SortSet . var SSDS : SubsortDeclSet . var OPDS : OpDeclSet . var MAS : MembAxSet . var EqS : EquationSet . var RlS : RuleSet . var CDS : ClassDeclSet . var SCDS : SubclassDeclSet . var MDS : MsgDeclSet . var ADS : AttrDeclSet . vars T T' T'' T3 O : Term . vars TL TL' : TermList . var At : Attr . vars AtS AtS' AtS'' : AttrSet . vars I I' : Nat . vars NL NL' : IntList . var Hk : Hook . var HkL : HookList . var VMAP : ViewMap . vars VMAPS VMAPS' VMAPS'' : Set{ViewMap} . var Subst : Substitution . var Cond : Condition . var St : String . var MN : ModuleName . sort Tuple{Set{ViewMap},Set{ViewMap}} . op <_;_> : Set{ViewMap} Set{ViewMap} -> Tuple{Set{ViewMap},Set{ViewMap}} . ops sortMaps otherMaps : Tuple{Set{ViewMap},Set{ViewMap}} -> Set{ViewMap} . eq sortMaps(< VMAPS ; VMAPS' >) = VMAPS . eq otherMaps(< VMAPS ; VMAPS' >) = VMAPS' . eq splitMaps(VMAPS) = splitMapsAux(VMAPS, none, none) . eq splitMapsAux((sort S to S'), VMAPS', VMAPS'') = splitMapsAux(none, ((sort S to S'), VMAPS'), VMAPS'') . eq splitMapsAux(((sort S to S'), VMAPS), VMAPS', VMAPS'') = splitMapsAux(VMAPS, ((sort S to S'), VMAPS'), VMAPS'') . eq splitMapsAux(VMAP, VMAPS', VMAPS'') = splitMapsAux(none, VMAPS', (VMAP, VMAPS'')) [owise] . eq splitMapsAux((VMAP, VMAPS), VMAPS', VMAPS'') = splitMapsAux(VMAPS, VMAPS', (VMAP, VMAPS'')) [owise] . eq splitMapsAux(none, VMAPS, VMAPS') = < VMAPS ; VMAPS' > . *** To avoid the interference between the sort maps with other maps, the map *** set is divided in two sTS. ceq applyMapsToModule(VMAPS, U, M) = applyMapsToModuleAux(VMAPS', VMAPS'', U, M) if < VMAPS' ; VMAPS'' > := splitMaps(VMAPS) . eq applyMapsToModule(VMAPS, U, unitError(QIL)) = unitError(QIL) . eq applyMapsToModuleAux(VMAPS, VMAPS', mod H is IL sorts SS . SSDS OPDS MAS EqS RlS endm, M) = mod H is IL sorts applyMapsToSortSet(VMAPS, SS) . applyMapsToSubsorts(VMAPS, SSDS) applyMapsToOps(VMAPS, VMAPS', OPDS, M) applyMapsToMbs(VMAPS, VMAPS', MAS, M) applyMapsToEqs(VMAPS, VMAPS', EqS, M) applyMapsToRls(VMAPS, VMAPS', RlS, M) endm . eq applyMapsToModuleAux(VMAPS, VMAPS', th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth, M) = th MN is IL sorts applyMapsToSortSet(VMAPS, SS) . applyMapsToSubsorts(VMAPS, SSDS) applyMapsToOps(VMAPS, VMAPS', OPDS, M) applyMapsToMbs(VMAPS, VMAPS', MAS, M) applyMapsToEqs(VMAPS, VMAPS', EqS, M) applyMapsToRls(VMAPS, VMAPS', RlS, M) endth . eq applyMapsToModuleAux(VMAPS, VMAPS', fmod H is IL sorts SS . SSDS OPDS MAS EqS endfm, M) = fmod H is IL sorts applyMapsToSortSet(VMAPS, SS) . applyMapsToSubsorts(VMAPS, SSDS) applyMapsToOps(VMAPS, VMAPS', OPDS, M) applyMapsToMbs(VMAPS, VMAPS', MAS, M) applyMapsToEqs(VMAPS, VMAPS', EqS, M) endfm . eq applyMapsToModuleAux(VMAPS, VMAPS', fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth, M) = fth MN is IL sorts applyMapsToSortSet(VMAPS, SS) . applyMapsToSubsorts(VMAPS, SSDS) applyMapsToOps(VMAPS, VMAPS', OPDS, M) applyMapsToMbs(VMAPS, VMAPS', MAS, M) applyMapsToEqs(VMAPS, VMAPS', EqS, M) endfth . eq applyMapsToModuleAux(VMAPS, VMAPS', omod H is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom, M) = omod H is IL sorts applyMapsToSortSet(VMAPS, SS) . applyMapsToSubsorts(VMAPS, SSDS) applyMapsToClassDeclSet(VMAPS, VMAPS', CDS) applyMapsToSubclassDeclSet(VMAPS', SCDS) applyMapsToOps(VMAPS, VMAPS', OPDS, M) applyMapsToMsgDeclSet(VMAPS, VMAPS', MDS, M) applyMapsToMbs(VMAPS, VMAPS', MAS, M) applyMapsToEqs(VMAPS, VMAPS', EqS, M) applyMapsToRls(VMAPS, VMAPS', RlS, M) endom . eq applyMapsToModuleAux(VMAPS, VMAPS', oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth, M) = oth MN is IL sorts applyMapsToSortSet(VMAPS, SS) . applyMapsToSubsorts(VMAPS, SSDS) applyMapsToClassDeclSet(VMAPS, VMAPS', CDS) applyMapsToSubclassDeclSet(VMAPS', SCDS) applyMapsToOps(VMAPS, VMAPS', OPDS, M) applyMapsToMsgDeclSet(VMAPS, VMAPS', MDS, M) applyMapsToMbs(VMAPS, VMAPS', MAS, M) applyMapsToEqs(VMAPS, VMAPS', EqS, M) applyMapsToRls(VMAPS, VMAPS', RlS, M) endoth . eq applyMapsToOps(VMAPS, VMAPS', (op F : TyL -> Ty [AtS] . OPDS), M) = (applyMapsToOp(VMAPS, getRightOpMaps(F, TyL, Ty, VMAPS', M), VMAPS', (op F : TyL -> Ty [AtS] .), M) applyMapsToOps(VMAPS, VMAPS', OPDS, M)) . eq applyMapsToOps(VMAPS, VMAPS', none, M) = none . eq applyMapsToOp(VMAPS, VMAP, VMAPS', (op F : TyL -> Ty [AtS] .), M) = (op applyOpMapsToOpId(F, VMAP) : applyMapsToTypeList(VMAPS, TyL) -> applyMapsToType(VMAPS, Ty) [applyMapsToAttrs(VMAPS, VMAPS', applyMapToAttrs(VMAP, AtS), M)] .) . eq applyMapsToOp(VMAPS, (VMAP, VMAPS'), VMAPS'', (op F : TyL -> Ty [AtS] .), M) *** In case of ambiguous mappings we take one of them arbitrarily = (op applyOpMapsToOpId(F, VMAP) : applyMapsToTypeList(VMAPS, TyL) -> applyMapsToType(VMAPS, Ty) [applyMapsToAttrs(VMAPS, VMAPS'', applyMapToAttrs(VMAP, AtS), M)] .) . eq applyMapsToOp(VMAPS, none, VMAPS', (op F : TyL -> Ty [AtS] .), M) *** No map for this declaration = (op F : applyMapsToTypeList(VMAPS, TyL) -> applyMapsToType(VMAPS, Ty) [applyMapsToAttrs(VMAPS, VMAPS', AtS, M)] .) . eq applyMapsToMsgDeclSet(VMAPS, VMAPS', ((msg F : TyL -> Ty .) MDS), M) = (applyMapsToMsgDecl(VMAPS, getRightOpMaps(F, TyL, Ty, VMAPS', M), (msg F : TyL -> Ty .), M) applyMapsToMsgDeclSet(VMAPS, VMAPS', MDS, M)) . eq applyMapsToMsgDeclSet(VMAPS, VMAPS', none, M) = none . eq applyMapsToMsgDecl(VMAPS, VMAP, (msg F : TyL -> Ty .), M) = (msg applyOpMapsToOpId(F, VMAP) : applyMapsToTypeList(VMAPS, TyL) -> applyMapsToType(VMAPS, Ty) .) . eq applyMapsToMsgDecl(VMAPS, (VMAP, VMAPS'), (msg F : TyL -> Ty .), M) *** In case of ambiguous mappings we take one of them arbitrarily = (msg applyOpMapsToOpId(F, VMAP) : applyMapsToTypeList(VMAPS, TyL) -> applyMapsToType(VMAPS, Ty) .) . eq applyMapsToMsgDecl(VMAPS, none, (msg F : TyL -> Ty .), M) *** No map for this declaration = (msg F : applyMapsToTypeList(VMAPS, TyL) -> applyMapsToType(VMAPS, Ty) .) . *** The function \texttt{applyMapToAttrs} just takes care of changing the *** attributes of the operators as indicated in the renamings. The renamings *** properly said is accomplished by the function *** \texttt{applyMapsToAttrs}. eq applyMapToAttrs((msg F to F'), AtS) = AtS . eq applyMapToAttrs((msg F : TyL -> Ty to F'), AtS) = AtS . eq applyMapToAttrs(termMap(T, T'), AtS) = AtS . eq applyMapToAttrs((op F to F' [AtS]), AtS') = applyMapToAttrsAux(AtS, AtS', none) . eq applyMapToAttrs((op F : TyL -> Ty to F' [AtS]), AtS') = applyMapToAttrsAux(AtS, AtS', none) . *** add the new syntactic attributes eq applyMapToAttrsAux((gather(QIL) AtS), AtS', AtS'') = applyMapToAttrsAux(AtS, AtS', (gather(QIL) AtS'')) . eq applyMapToAttrsAux((format(QIL) AtS), AtS', AtS'') = applyMapToAttrsAux(AtS, AtS', (format(QIL) AtS'')) . eq applyMapToAttrsAux((prec(I) AtS), AtS', AtS'') = applyMapToAttrsAux(AtS, AtS', (prec(I) AtS'')) . eq applyMapToAttrsAux((At AtS), AtS', AtS'') = applyMapToAttrsAux(AtS, AtS', AtS'') [owise] . *** remove the old syntactic attributes eq applyMapToAttrsAux(AtS, (format(QIL) AtS'), AtS'') = applyMapToAttrsAux(AtS, AtS', AtS'') . eq applyMapToAttrsAux(AtS, (gather(QIL) AtS'), AtS'') = applyMapToAttrsAux(AtS, AtS', AtS'') . eq applyMapToAttrsAux(AtS, (prec(I) AtS'), AtS'') = applyMapToAttrsAux(AtS, AtS', AtS'') . eq applyMapToAttrsAux(none, (At AtS), AtS') = applyMapToAttrsAux(none, AtS, (At AtS')) . eq applyMapToAttrsAux(none, none, AtS) = AtS . eq applyMapsToTypeList(VMAPS, (Ty TyL)) = (applyMapsToType(VMAPS, Ty) applyMapsToTypeList(VMAPS, TyL)) . eq applyMapsToTypeList(VMAPS, nil) = nil . eq applyMapsToSubsorts(VMAPS, ((subsort S < S' .) SSDS)) = ((subsort applyMapsToType(VMAPS, S) < applyMapsToType(VMAPS, S') .) applyMapsToSubsorts(VMAPS, SSDS)) . eq applyMapsToSubsorts(VMAPS, none) = none . eq applyMapsToAttrs(VMAPS, VMAPS', (id(T) AtS), M) = (id(applyMapsToTerm2(VMAPS, VMAPS', T, M)) applyMapsToAttrs(VMAPS, VMAPS', AtS, M)) . eq applyMapsToAttrs(VMAPS, VMAPS', (left-id(T) AtS), M) = (left-id(applyMapsToTerm2(VMAPS, VMAPS', T, M)) applyMapsToAttrs(VMAPS, VMAPS', AtS, M)) . eq applyMapsToAttrs(VMAPS, VMAPS', (right-id(T) AtS), M) = (right-id(applyMapsToTerm2(VMAPS, VMAPS', T, M)) applyMapsToAttrs(VMAPS, VMAPS', AtS, M)) . eq applyMapsToAttrs(VMAPS, VMAPS', (special(HkL) AtS), M) = (special(applyMapsToHooks(VMAPS, VMAPS', HkL, M)) applyMapsToAttrs(VMAPS, VMAPS', AtS, M)) . eq applyMapsToAttrs(VMAPS, VMAPS', (label(L) AtS), M) = (label(applyMapsToLabel(VMAPS, L)) applyMapsToAttrs(VMAPS, VMAPS', AtS, M)) . eq applyMapsToAttrs(VMAPS, VMAPS', AtS, M) = AtS [owise] . eq applyMapsToHooks(VMAPS, VMAPS', id-hook(QI, QIL) HkL, M) = id-hook(QI, QIL) applyMapsToHooks(VMAPS, VMAPS', HkL, M). eq applyMapsToHooks(VMAPS, VMAPS', op-hook(QI, QI', QIL, QI'') HkL, M) = applyMapsToHooksAux(VMAPS, getRightOpMaps(QI', QIL, QI'', VMAPS', M), op-hook(QI, QI', QIL, QI''), M) applyMapsToHooks(VMAPS, VMAPS', HkL, M). eq applyMapsToHooks(VMAPS, VMAPS', term-hook(QI, T) HkL, M) = term-hook(QI, applyMapsToTerm2(VMAPS, VMAPS', T, M)) applyMapsToHooks(VMAPS, VMAPS', HkL, M). eq applyMapsToHooks(VMAPS, VMAPS', nil, M) = nil . eq applyMapsToHooksAux(VMAPS, (VMAP, VMAPS'), op-hook(QI, F, TyL, Ty), M) *** In case of ambiguous mappings we take any of them arbitrarily = op-hook(QI, applyOpMapsToOpId(F, VMAP), applyMapsToTypeList(VMAPS, TyL), applyMapsToType(VMAPS, Ty)) . eq applyMapsToHooksAux(VMAPS, none, op-hook(QI, F, TyL, Ty), M) = op-hook(QI, F, applyMapsToTypeList(VMAPS, TyL), applyMapsToType(VMAPS, Ty)) . eq applyMapsToMbs(VMAPS, VMAPS', ((mb T : S [AtS] .) MAS), M) = ((mb applyMapsToTerm2(VMAPS, VMAPS', T, M) : applyMapsToType(VMAPS, S) [applyMapsToAttrs(VMAPS, VMAPS', AtS, M)] .) applyMapsToMbs(VMAPS, VMAPS', MAS, M)) . eq applyMapsToMbs(VMAPS, VMAPS', ((cmb T : S if Cond [AtS] .) MAS), M) = ((cmb applyMapsToTerm2(VMAPS, VMAPS', T, M) : applyMapsToType(VMAPS, S) if applyMapsToCond(VMAPS, VMAPS', Cond, M) [applyMapsToAttrs(VMAPS, VMAPS', AtS, M)] .) applyMapsToMbs(VMAPS, VMAPS', MAS, M)) . eq applyMapsToMbs(VMAPS, VMAPS', none, M) = none . eq applyMapsToEqs(VMAPS, VMAPS', ((ceq T = T' if Cond [AtS] .) EqS), M) = ((ceq applyMapsToTerm2(VMAPS, VMAPS', T, M) = applyMapsToTerm2(VMAPS, VMAPS', T', M) if applyMapsToCond(VMAPS, VMAPS', Cond, M) [applyMapsToAttrs(VMAPS, VMAPS', AtS, M)] .) applyMapsToEqs(VMAPS, VMAPS', EqS, M)) . eq applyMapsToEqs(VMAPS, VMAPS', ((eq T = T' [AtS] .) EqS), M) = ((eq applyMapsToTerm2(VMAPS, VMAPS', T, M) = applyMapsToTerm2(VMAPS, VMAPS', T', M) [applyMapsToAttrs(VMAPS, VMAPS', AtS, M)] .) applyMapsToEqs(VMAPS, VMAPS', EqS, M)) . eq applyMapsToEqs(VMAPS, VMAPS', none, M) = none . eq applyMapsToRls(VMAPS, VMAPS', ((crl T => T' if Cond [AtS] .) RlS), M) = ((crl applyMapsToTerm2(VMAPS, VMAPS', T, M) => applyMapsToTerm2(VMAPS, VMAPS', T', M) if applyMapsToCond(VMAPS, VMAPS', Cond, M) [applyMapsToAttrs(VMAPS, VMAPS', AtS, M)] .) applyMapsToRls(VMAPS, VMAPS', RlS, M)) . eq applyMapsToRls(VMAPS, VMAPS', ((rl T => T' [AtS] .) RlS), M) = ((rl applyMapsToTerm2(VMAPS, VMAPS', T, M) => applyMapsToTerm2(VMAPS, VMAPS', T', M) [applyMapsToAttrs(VMAPS, VMAPS', AtS, M)] .) applyMapsToRls(VMAPS, VMAPS', RlS, M)) . eq applyMapsToRls(VMAPS, VMAPS', none, M) = none . eq applyMapsToCond(VMAPS, VMAPS', T = T' /\ Cond, M) = applyMapsToTerm2(VMAPS, VMAPS', T, M) = applyMapsToTerm2(VMAPS, VMAPS', T', M) /\ applyMapsToCond(VMAPS, VMAPS', Cond, M) . eq applyMapsToCond(VMAPS, VMAPS', T : S /\ Cond, M) = applyMapsToTerm2(VMAPS, VMAPS', T, M) : applyMapsToSort(VMAPS, S) /\ applyMapsToCond(VMAPS, VMAPS', Cond, M) . eq applyMapsToCond(VMAPS, VMAPS', T := T' /\ Cond, M) = applyMapsToTerm2(VMAPS, VMAPS', T, M) := applyMapsToTerm2(VMAPS, VMAPS', T', M) /\ applyMapsToCond(VMAPS, VMAPS', Cond, M) . eq applyMapsToCond(VMAPS, VMAPS', T => T' /\ Cond, M) = applyMapsToTerm2(VMAPS, VMAPS', T, M) => applyMapsToTerm2(VMAPS, VMAPS', T', M) /\ applyMapsToCond(VMAPS, VMAPS', Cond, M) . eq applyMapsToCond(VMAPS, VMAPS', nil, M) = nil . eq applyMapsToLabel((label L to L'), L'') = if L == L'' then L' else L'' fi . eq applyMapsToLabel(((label L to L'), VMAPS), L'') = if L == L'' then L' else applyMapsToLabel(VMAPS, L'') fi . eq applyMapsToLabel(VMAP, L) = L [owise] . eq applyMapsToLabel((VMAP, VMAPS), L) = applyMapsToLabel(VMAPS, L) [owise] . eq applyMapsToLabel(none, L) = L . eq applyMapsToClassDeclSet(VMAPS, VMAPS', ((class C | ADS .) CDS)) = ((class applyMapsToClassName(VMAPS', C) | applyMapsToAttrDeclSet(VMAPS, VMAPS', C, ADS) .) applyMapsToClassDeclSet(VMAPS, VMAPS', CDS)) . eq applyMapsToClassDeclSet(VMAPS, VMAPS', none) = none . eq applyMapsToAttrDeclSet(VMAPS, VMAPS', C, ((attr A : Ty), ADS)) = ((attr applyMapsToAttrName(VMAPS', C, A) : applyMapsToType(VMAPS, Ty)), applyMapsToAttrDeclSet(VMAPS, VMAPS', C, ADS)) . eq applyMapsToAttrDeclSet(VMAPS, VMAPS', C, none) = none . eq applyMapsToAttrName((attr A . C to A'), C', A'') = if (C == C') and (A == A'') then A' else A'' fi . eq applyMapsToAttrName(((attr A . C to A'), VMAPS), C', A'') = if (C == C') and (A == A'') then A' else applyMapsToAttrName(VMAPS, C', A'') fi . eq applyMapsToAttrName(VMAP, C, A) = A [owise] . eq applyMapsToAttrName((VMAP, VMAPS), C, A) = applyMapsToAttrName(VMAPS, C, A) [owise] . eq applyMapsToAttrName(none, C, A) = A . eq applyMapsToSubclassDeclSet(VMAPS, ((subclass C < C' .) SCDS)) = ((subclass applyMapsToClassName(VMAPS, C) < applyMapsToClassName(VMAPS, C') .) applyMapsToSubclassDeclSet(VMAPS, SCDS)) . eq applyMapsToSubclassDeclSet(VMAPS, none) = none . endfm ******************************************************************************* *** *** 6.9 Instantiation of Parameterized Modules and the *** \texttt{META-LEVEL} Module Expression *** A parameterized module *** $\texttt{M[L}_1\texttt{\ ::\ T}_1\texttt{,\}\ldots\texttt{, L}_n *** \texttt{ :: T}_n\texttt{]}$, with \mbox{$\texttt{L}_1\ldots\texttt{L}_n$} *** labels and \mbox{$\texttt{T}_1\ldots\texttt{T}_n$} theory identifiers, is *** represented as a module with name \texttt{M} which contains parameter *** declarations \mbox{$\texttt{par\ L}_i\texttt{\ ::\ T}_i$} for *** $1\leq i\leq n$, and an importation declaration *** \mbox{$\texttt{inc\ par\ L}_i\texttt{\ ::\ T}_i\texttt{\ .}$} for each *** parameter \mbox{$\texttt{L}_i\texttt{\ ::\ T}_i$} in its interface. Note *** that all modules are handled in a uniform way: nonparameterized modules *** and theories have their list of parameters set to \texttt{nil}. *** The instantiation of the formal parameters of a parameterized module with *** actual modules or theories requires a view from each formal parameter *** theory to its corresponding actual unit. The process of instantiation *** results in the replacement of each interface theory by its corresponding *** actual parameter, using the views to bind actual names to formal names. *** The naming conventions for sorts have to be taken into account in the *** instantiation process: every occurrence of a sort coming from a theory in *** the interface of a module must be qualified by its theory's label, and *** sorts defined in the body of a parameterized module can be parameterized *** by the labels in the interface of the module (see *** Section~\ref{parameterized-modules}). *** The labeling convention for theories and for the sorts coming from them is *** very useful to avoid collisions of sort names coming from the parameter *** theories, and also to allow different uses of the same theory several *** times in the interface of a module. We assume that all sorts coming from *** the theory part of the parameter theories are used in their qualified form *** to manipulate the maps defined in the views before being applied to the *** body of the module being instantiated. If the target of a view is a *** theory, the sorts from the theory part of the target theory appearing in *** the targTS of the maps in the view will be qualified as well, following *** the same convention. *** When a parameterized module *** $\texttt{M[L}_1\texttt{\ ::\ T}_1\texttt{,\ } *** \ldots\texttt{,\ L}_n\texttt{\ ::\ T}_n\texttt{]}$ *** is instantiated with views $\texttt{V}_1\ldots\texttt{V}_n$, each *** parameterized sort $\texttt{S[L}_1\texttt{,}\ldots\texttt{,L}_n\texttt{]}$ *** in the body of the parameterized module is renamed to *** $\texttt{S[V}_1\texttt{,}\ldots\texttt{,V}_n\texttt{]}$. *** The discussion on the qualification of sorts in views before being used in *** the instantiation process applies in a completely similar way to class *** names in parameterized object-oriented modules. *** As we saw in Section~\ref{module-expressions}, it is possible to import a *** module expression in which a parameterized module is instantiated by some *** of the formal parameters of the parameterized module in which it is *** imported. This is done by using the label of some of the parameters in the *** interface of a module, say \mbox{$\texttt{L}_k\texttt{\ ::\ T}_k$}, in a *** module expression in which some parameterized module \texttt{N} with formal *** parameter $\texttt{T}_k$ is instantiated with $\texttt{L}_k$, that is, we *** have the module expression $\texttt{N[}\ldots\texttt{L}_k\ldots\texttt{]}$. *** In this case, $\texttt{L}_k$ is considered as the identity view for the *** theory $\texttt{T}_k$ with $\texttt{L}_k$ as name. Note that to be able to *** check whether a label in the interface of a module is used in an *** instantiation of this form, in the evaluation of a module expression the *** list of parameters of the module in which the module expression appears *** must be available. This is the reason why the \texttt{evalModExp} function *** was defined with \texttt{ParameterList} as one of the sorts in its *** arity (see Section~\ref{evalModExp}). For module expressions appearing *** outside of any module, that is, in commands, etc., this list will be set *** to \texttt{nil}. *** Note that this kind of instantiation may produce a `cascade' effect. The *** module being instantiated may itself import other module expressions in *** which labels of some of its parameter theories are used in the *** instantiation of some of these imported module expressions. This is handled *** by `preparing' the module expressions appearing in the importation *** declarations of the module (\texttt{prepImports}). This process *** consists in changing the labels of the interface of the module being *** instantiated which are used in the importations of module expressions by *** the corresponding view names (\texttt{prepHeader}). After completing the *** generation of the module resulting from the evaluation of the module *** expression, this module will be evaluated with the \texttt{evalModule} *** function, producing the evaluation of these new module expressions. In any *** extension of the language, new equations for the function *** \texttt{prepHeader} will have to be added for each new kind of module *** expression being defined. *** In Sections~\ref{renaming} and~\ref{extension} we shall see how new *** equations completing the semantics of \texttt{prepHeader} are added for *** each new module expression being defined. In the case of the renaming *** module expression, the renaming maps will have to be prepared as well, to *** adjust the sort names being renamed to the conventions discussed above. *** As for any other module expression being defined, in addition to the *** operator declaration for the constructor of the instantiation module *** expression, equations completing the semantics of operators *** \texttt{evalModExp}, \texttt{header2QidList}, and *** \texttt{setUpModExpDeps} have to be given. fmod INST-EXPR-EVALUATION is pr EVALUATION . pr VIEW-MAP-SET-APPL-ON-UNIT . inc MOD-EXPR . inc MOD-NAME . pr DATABASE . *** We start by giving the new constructor for sort \texttt{ModuleExpression}. *** Note thatthe modules \texttt{MOD-EXPR} and \texttt{MOD-NAME} have been *** imported in \texttt{including} mode. vars QI QI' QI'' X Y W Z C F F' A A' L L' : Qid . var QIL : QidList . vars M M' PU U U' U'' DM : Module . var Th : OTheory . vars ME ME' ME'' : ModuleExpression . var H : Header . vars MN MN' : ModuleName . vars MNS MNS' MNS'' MNS3 MNS4 MNS5 : Set{ModuleName} . vars VE VE' VE'' VE3 VE4 : ViewExp . vars VES VES' : Set{ViewExp} . vars MIS MIS' : Set{ModuleInfo} . var VIS : Set{ViewInfo} . vars DB DB' : Database . var PD : ParameterDecl . vars PDL PDL' PDL'' PDL3 PDL4 PDL5 : ParameterDeclList . var PDS : Set{ParameterDecl} . vars PL PL' PL'' PL3 : ParameterList . vars S S' P P' P'' : Sort . vars IL IL' IL'' IL3 : ImportList . vars VMAPS VMAPS' VMAPS'' VMAPS3 : Set{ViewMap} . var V : Variable . var Ct : Constant . var SL : QidList . var TyL : TypeList . vars SS SS' SS'' : SortSet . vars T T' O : Term . var DT : Default{Term} . var TL : TermList . var CDS : ClassDeclSet . var ADS : AttrDeclSet . var B : Bool . var AtS : AttrSet . var VMAP : ViewMap . var N : Nat . var PV : PreView . var VI : View . var VDS : OpDeclSet . *** In the input given by the user, the operator \verb~_(_)~ is used both for *** the instantiation of module expressions, and for expressions *** parameterizing the module \texttt{META-LEVEL} with a list of module names. *** The function \texttt{evalModExp} distinguishes these two cases, calling *** the function \texttt{unitInst} in the former and the function *** \texttt{prepMetalevel} in the latter. op unitInst : Header ParameterList ParameterDeclList Database -> Database . op prepMetalevel : ParameterList Database -> Database . eq evalModExp(ME{PL}, PDL, DB) = if unitInDb(ME{PL}, DB) then < DB ; ME{PL} > else if ME == 'META-LEVEL then < prepMetalevel(PL, DB) ; ME{PL} > else < unitInst( modExp(evalModExp(ME, PDL, evalViewExp(PL, PDL, DB))), PL, PDL, database(evalModExp(ME, PDL, evalViewExp(PL, PDL, DB)))) ; modExp(evalModExp(ME, PDL, evalViewExp(PL, PDL, DB))){PL} > fi fi . *** The function \texttt{prepMetalevel} creates a new module with the *** module expression being evaluated as name, which imports the predefined *** \texttt{META-LEVEL} module. For each module name \texttt{I} in the list *** given as parameter of the expression, the declaration of a constant *** \texttt{I} of sort \texttt{Module} and an equation identifying such *** constant with the metarepresentation of the module with such name in the *** database are added to the module being created. op prepMetalevelAux : ParameterList Module Database -> Database . eq prepMetalevel(PL, DB) = prepMetalevelAux(PL, addImports((including 'META-LEVEL .), setName(emptyFModule, 'META-LEVEL{PL})), DB) . eq prepMetalevelAux((QI), U, DB) = prepMetalevelAux(nil, addOps((op qid("META-" + string(QI)) : nil -> 'Module [none] .), addEqs((eq qid("META-" + string(QI) + ".Module") = up(getFlatModule(QI, database(evalModExp(QI, DB)))) [none] .), U)), DB) . eq prepMetalevelAux((QI, PL), U, DB) = prepMetalevelAux(PL, addOps((op qid("META-" + string(QI)) : nil -> 'Module [none] .), addEqs((eq qid("META-" + string(QI) + ".Module") = up(getFlatModule(QI, database(evalModExp(QI, DB)))) [none] .), U)), DB) . eq prepMetalevelAux(nil, U, DB) = evalModule(U, none, DB) . *** The function \texttt{getClassNames} returns the set of the names of *** the classes in a set of class declarations. op getClassNames : ClassDeclSet -> SortSet . eq getClassNames(((class S | ADS .) CDS)) = (S ; getClassNames(CDS)) . eq getClassNames(none) = none . *** The following `getTh' functions return the corresponding elements in the *** theory part of the structure of the given unit. For example, the function *** \texttt{getThSorts} returns the set of sorts declared in the ``loose *** part'' of the structure of the unit in the database having the name *** indicated as first argument. op getThSorts : ModuleExpression Database -> SortSet . op getThClasses : ModuleExpression Database -> SortSet . op getThSortsAux : ImportList Database -> SortSet . op getThClassesAux : ImportList Database -> SortSet . eq getThSorts(ME, DB) = if theory(getTopModule(ME, DB)) then (getThSortsAux(getImports(getTopModule(ME, DB)), DB) ; getSorts(getTopModule(ME, DB))) else none fi . eq getThSortsAux(((including MN .) IL), DB) = (getThSorts(MN, DB) ; getThSortsAux(IL, DB)) . eq getThSortsAux(((extending MN .) IL), DB) = (getThSorts(MN, DB) ; getThSortsAux(IL, DB)) . eq getThSortsAux(((protecting MN .) IL), DB) = (getThSorts(MN, DB) ; getThSortsAux(IL, DB)) . eq getThSortsAux(nil, DB) = none . eq getThClasses(ME, DB) = if getTopModule(ME, DB) :: OModule and-then theory(getTopModule(ME, DB)) and-then not getTopModule(ME, DB) :: SModule then (getThClassesAux(getImports(getTopModule(ME, DB)), DB) ; getClassNames(getClasses(getTopModule(ME, DB)))) else none fi . eq getThClassesAux(((including MN .) IL), DB) = (getThClasses(MN, DB) ; getThClassesAux(IL, DB)) . eq getThClassesAux(((extending MN .) IL), DB) = (getThClasses(MN, DB) ; getThClassesAux(IL, DB)) . eq getThClassesAux(((protecting MN .) IL), DB) = (getThClasses(MN, DB) ; getThClassesAux(IL, DB)) . eq getThClassesAux(nil, DB) = none . *** The `get' functions return the corresponding elements in the structure of *** the given unit. For example, \texttt{getSortSet} returns all the sorts *** declared in the structure of the unit in the database having the name *** given as first argument. op getSortSet : ModuleName Database -> SortSet . op getClassSet : ModuleName Database -> SortSet . op getSortSetAux : ImportList Database -> SortSet . op getClassSetAux : ImportList Database -> SortSet . eq getSortSet(MN, DB) = (getSortSetAux(getImports(getTopModule(MN, DB)), DB) ; getSorts(getTopModule(MN, DB))) . eq getSortSetAux(((including MN .) IL), DB) = (getSortSet(MN, DB) ; getSortSetAux(IL, DB)) . eq getSortSetAux(((extending MN .) IL), DB) = (getSortSet(MN, DB) ; getSortSetAux(IL, DB)) . eq getSortSetAux(((protecting MN .) IL), DB) = (getSortSet(MN, DB) ; getSortSetAux(IL, DB)) . eq getSortSetAux(nil, DB) = none . eq getClassSet(MN, DB) = (getClassSetAux(getImports(getTopModule(MN, DB)), DB) ; getClassNames(getClasses(getTopModule(MN, DB)))) . eq getClassSetAux(((including MN .) IL), DB) = (getClassSet(MN, DB) ; getClassSetAux(IL, DB)) . eq getClassSetAux(((extending MN .) IL), DB) = (getClassSet(MN, DB) ; getClassSetAux(IL, DB)) . eq getClassSetAux(((protecting MN .) IL), DB) = (getClassSet(MN, DB) ; getClassSetAux(IL, DB)) . eq getClassSetAux(nil, DB) = none . *** As pointed out in Section~\ref{parameterized-modules}, in a parameterized *** module all occurrences of sorts or classes coming from the parameter *** theories have to be qualified. \texttt{createCopy} is the function used *** for creating these renamed copies of the parameters. As also explained in *** Section~\ref{parameterized-modules}, if a parameter theory is structured, *** the renaming is carried out not only at the top level, but for the entire *** ``theory part'' in the structure. *** The function \texttt{createCopy} calls an auxiliary function, *** \texttt{prepPar}, which recursively proceeds through all the subtheories *** of the given theory. For each theory in the structure, the required set of *** maps is generated and applied to such a theory using the *** \texttt{applyMapsToModule} function discussed in *** Section~\ref{applyMapsToModule}, which is then evaluated and entered into *** the database. Note that the renamings to which a theory is subjected must *** also be applied to the theories importing it. The new database and the *** renaming maps applied to the theory will have to be returned by the *** function. *** The function \texttt{prepPar} makes a copy of the theory specified by the *** name given as first argument and of all its subtheories (only theories, no *** modules), and qualifies all the sorts appearing in it with the label given *** in the declaration of the parameter, which is given as second argument. sorts Tuple Set> prepParResult . subsort Tuple < Set> . op <_;_> : ViewExp ViewExp -> Tuple . ops 1st 2nd : Tuple -> ViewExp . op none : -> Set> . op __ : Set> Set> -> Set> [assoc comm id: none] . vars VEPS VEPS' : Set> . eq 1st(< VE ; VE' >) = VE . eq 2nd(< VE ; VE' >) = VE' . op prepPar : Qid Qid ModuleExpression Database -> prepParResult . op prepParImports : ImportList ImportList Qid Qid RenamingSet Set> ParameterDeclList Database -> prepParResult . op <_;_;_;_;_;_;_> : RenamingSet Database ViewExp ViewExp Set> Bool ImportList -> prepParResult . op mapSet : prepParResult -> RenamingSet . op database : prepParResult -> Database . op sourceViewExp : prepParResult -> ViewExp . op targetViewExp : prepParResult -> ViewExp . op viewExpPairSet : prepParResult -> Set> . op theoryFlag : prepParResult -> Bool . op getImports : prepParResult -> ImportList . eq mapSet(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = VMAPS . eq database(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = DB . eq sourceViewExp(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = VE . eq targetViewExp(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = VE' . eq viewExpPairSet(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = VEPS . eq theoryFlag(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = B . eq getImports(< VMAPS ; DB ; VE ; VE' ; VEPS ; B ; IL >) = IL . ----op createCopy : ParameterDecl Database -> Database . op prepPar : Qid ModuleExpression Database -> prepParResult . op prepParImports : ImportList ImportList Qid RenamingSet Set> ParameterDeclList Database -> prepParResult . eq createCopy(X :: ME, DB) = if unitInDb(pd(X :: ME), DB) then DB else database(prepPar(X, ME, database(evalModExp(ME, DB)))) fi . ceq prepPar(X, ME, DB) = < (VMAPS'', VMAPS3) ; (if unitInDb(pd(X :: ME), DB) then DB else evalModule( setImports( setName( applyMapsToModule( (VMAPS'', VMAPS3), Th, getFlatModule(ME, DB)), pd(X :: ME)), IL), applyMapsToOps( VMAPS'', VMAPS3, getVars(ME, DB), getFlatModule(ME, DB)), DB') fi) ; mtViewExp ; mtViewExp ; none ; true ; nil > if Th := getTopModule(ME, DB) /\ < VMAPS ; DB' ; VE ; VE' ; VEPS ; B ; IL > := prepParImports(getImports(Th), nil, X, none, none, X :: ME, DB) /\ < VMAPS'' ; VMAPS3 > := splitMaps( (VMAPS, sortMapsPar(X, getSorts(Th), none), classMapsPar(X, classSet(getClasses(Th)), none))) . eq prepPar(X, ME, DB) = < none ; warning(DB, '\r 'Error3: '\o 'Incorrect 'parameter '\n) ; mtViewExp ; mtViewExp ; none ; false ; nil > [owise] . ceq prepParImports(((including ME .) IL), IL', X, VMAPS, VEPS, PDL, DB) = if B then prepParImports(IL, (IL' (including pd(X :: ME') .)), X, (VMAPS, VMAPS'), VEPS, PDL, DB') else prepParImports(IL, (IL' (including ME .)), X, VMAPS, VEPS, PDL, DB) fi if ME' := prepModExp(ME, VEPS) /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) . ceq prepParImports(((extending ME .) IL), IL', X, VMAPS, VEPS, PDL, DB) = if B then *** A theory shouldn't be imported in protecting mode prepParImports(IL, (IL' (extending pd(X :: ME') .)), X, (VMAPS, VMAPS'), VEPS, PDL, DB') else prepParImports(IL, (IL' (extending ME .)), X, VMAPS, VEPS, PDL, DB) fi if ME' := prepModExp(ME, VEPS) /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) . ceq prepParImports(((protecting ME .) IL), IL', X, VMAPS, VEPS, PDL, DB) = if B then *** A theory shouldn't be imported in protecting mode prepParImports(IL, (IL' (protecting pd(X :: ME') .)), X, (VMAPS, VMAPS'), VEPS, PDL, DB') else prepParImports(IL, (IL' (protecting ME .)), X, VMAPS, VEPS, PDL, DB) fi if ME' := prepModExp(ME, VEPS) /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) . ceq prepParImports(((including pd(X :: ME) .) IL), IL', Y, VMAPS, (< X ; Z > VEPS), PDL, DB) = prepParImports(IL, (IL' (including pd(Z :: ME') .)), Y, (VMAPS, VMAPS'), (< X ; Z > VEPS), PDL, DB') if ME' := prepModExp(ME, VEPS) /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) . ceq prepParImports(((extending pd(X :: ME) .) IL), IL', Y, VMAPS, (< X ; Z > VEPS), PDL, DB) = prepParImports(IL, (IL' (extending pd(Z :: ME') .)), Y, (VMAPS, VMAPS'), (< X ; Z > VEPS), PDL, DB') if ME' := prepModExp(ME, VEPS) /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) . ceq prepParImports(((protecting pd(X :: ME) .) IL), IL', Y, VMAPS, (< X ; Z > VEPS), PDL, DB) = prepParImports(IL, (IL' (protecting pd(Z :: ME') .)), Y, (VMAPS, VMAPS'), (< X ; Z > VEPS), PDL, DB') if ME' := prepModExp(ME, VEPS) /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(X, ME', database(evalModExp(ME', PDL, DB))) . eq prepParImports(nil, IL, X, VMAPS, VEPS, PDL, DB) = < VMAPS ; DB ; mtViewExp ; mtViewExp ; none ; false ; IL > . ceq prepPar(X, Y, ME, DB) = < (VMAPS'', VMAPS3) ; (if unitInDb(pd(Y :: ME), DB) then DB else evalModule( setImports( setName( applyMapsToModule( (VMAPS'', VMAPS3), getTopModule(pd(X :: ME), DB), getFlatModule(pd(X :: ME), DB)), pd(Y :: ME)), IL), applyMapsToOps( VMAPS'', VMAPS3, getVars(pd(X :: ME), DB), getFlatModule(pd(X :: ME), DB)), DB') fi) ; X ; Y ; < X ; Y > ; true ; nil > if Th := getTopModule(ME, DB) /\ < VMAPS ; DB' ; VE ; VE' ; VEPS ; B ; IL > := prepParImports(getImports(Th), nil, X, Y, none, < X ; Y >, X :: ME, DB) /\ < VMAPS'' ; VMAPS3 > := splitMaps( (VMAPS, genMapsQualSorts(X, Y, getSorts(Th), none), genMapsQualClasses(X, Y, classSet(getClasses(Th)), none))) . eq prepParImports(((including ME .) IL), IL', X, Y, VMAPS, VEPS, PDL, DB) = prepParImports(IL, (IL' including ME .), X, Y, VMAPS, VEPS, PDL, DB) . eq prepParImports(((extending ME .) IL), IL', X, Y, VMAPS, VEPS, PDL, DB) = prepParImports(IL, (IL' extending ME .), X, Y, VMAPS, VEPS, PDL, DB) . eq prepParImports(((protecting ME .) IL), IL', X, Y, VMAPS, VEPS, PDL, DB) = prepParImports(IL, (IL' protecting ME .), X, Y, VMAPS, VEPS, PDL, DB) . ceq prepParImports(including pd(X :: ME) . IL, IL', Y, Z, VMAPS, VEPS, PDL, DB) = prepParImports(IL, IL' including pd(X :: ME') ., Y, Z, (VMAPS, VMAPS'), VEPS, PDL, DB') if ME' := prepModExp(ME, VEPS) /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(Y, Z, ME', database(evalModExp(ME', PDL, DB))) . ceq prepParImports(extending pd(X :: ME) . IL, IL', Y, Z, VMAPS, VEPS, PDL, DB) = prepParImports(IL, IL' extending pd(X :: ME') ., Y, Z, (VMAPS, VMAPS'), VEPS, PDL, DB') if ME' := prepModExp(ME, VEPS) /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(Y, Z, ME', database(evalModExp(ME', PDL, DB))) . ceq prepParImports(protecting pd(X :: ME) . IL, IL', Y, Z, VMAPS, VEPS, PDL, DB) = prepParImports(IL, IL' protecting pd(X :: ME') ., Y, Z, (VMAPS, VMAPS'), VEPS, PDL, DB') if ME' := prepModExp(ME, VEPS) /\ < VMAPS' ; DB' ; VE ; VE' ; VEPS' ; B ; IL'' > := prepPar(Y, Z, ME', database(evalModExp(ME', PDL, DB))) . eq prepParImports(nil, IL, X, Y, VMAPS, VEPS, PDL, DB) = < VMAPS ; DB ; mtViewExp ; mtViewExp ; none ; false ; IL > . op sortMapsPar : Qid SortSet Set> -> RenamingSet . op classMapsPar : Qid SortSet Set> -> RenamingSet . op qualify : Qid Sort -> Sort . op qualify : Qid Sort Set> -> Sort . op qualify : Qid Sort ParameterList ParameterList Set> -> Sort . eq qualify(X, S) = qualify(X, getName(S), getPars(S), empty, none) . eq qualify(X, S, VEPS) = qualify(X, getName(S), getPars(S), empty, VEPS) . eq qualify(X, S, (P, PL), PL', < P ; P' > VEPS) = qualify(X, S, PL, PL' P', < P ; P' > VEPS) . eq qualify(X, S, (P, PL), PL', VEPS) = qualify(X, S, PL, PL' P, VEPS) [owise] . eq qualify(X, S, empty, PL, VEPS) = qid(string(X) + "$" + string(makeSort(S, PL))) . eq sortMapsPar(X, (S ; SS), VEPS) = ((sort S to qualify(X, S, VEPS)), sortMapsPar(X, SS, VEPS)) . eq sortMapsPar(X, none, VEPS) = none . eq classMapsPar(X, (S ; SS), VEPS) = ((class S to qualify(X, S, VEPS)), classMapsPar(X, SS, VEPS)) . eq classMapsPar(X, none, VEPS) = none . *** When one of the labels of the interface of a module is being used in a *** module expression to instantiate some formal parameter of a module, then, *** in the evaluation of such module expression the qualification of all sorts *** and class names coming from the theory part of the parameter theory have *** to be changed according to such a label. In the evaluation of an *** instantiation module expression this is done by generating the *** corresponding renaming maps, which are then applied to the module being *** instantiated. Given labels \texttt{L} and \texttt{L'}, for each sort or *** class name \texttt{S} in the set given as argument, a map of the form *** \verb~L$S to L'$S~ is generated. op genMapsQualSorts : Qid Qid SortSet Set> -> RenamingSet . op genMapsQualClasses : Qid Qid SortSet Set> -> RenamingSet . eq genMapsQualSorts(X, Y, (S ; SS), VEPS) = ((sort qualify(X, S, VEPS) to qualify(Y, S, VEPS)), genMapsQualSorts(X, Y, SS, VEPS)) . eq genMapsQualSorts(X, Y, none, VEPS) = none . eq genMapsQualClasses(X, Y, (S ; SS), VEPS) = ((class qualify(X, S, VEPS) to qualify(Y, S, VEPS)), genMapsQualClasses(X, Y, SS, VEPS)) . eq genMapsQualClasses(X, Y, none, VEPS) = none . *** The function \texttt{prepare} takes the map set of a view and *** prepares it to be used in an instantiation by transforming sort and class *** names into their qualified form, if required (sorts and class names in a *** view have to be qualified only if they were defined in a theory). *** The \texttt{prepare} function takes five arguments: The set of maps *** to be prepared, the label with which the sorts to be renamed have to be *** qualified, the set of sorts in the theory part of the source of the view, *** and the set of sorts and class names in the theory part of the target of *** the view. *** Note that we assume that there is a sort map and a class map for each sort *** and class in the theory part of the source of the view. Therefore, sorts *** and class names appearing as sources of sort and class maps are *** systematically qualified. The sorts or class names used in the targTS of *** the maps will be qualified only if they were declared in a theory. In maps *** for operators in which the arity and coarity are specified, or for those *** going to derived terms, the sorts appearing in the arity or coarity of an *** operator and those used to qualify terms, or in sort tests in terms, must *** also be qualified. However, in these cases the qualification cannot be *** done on all sorts, but only on those defined in the theory parts. This is *** the reason why the sTS of sorts in the theory parts of the source and *** target and the set of class names in the target of the view are given when *** calling \texttt{prepare}. op prepare : Set{ViewMap} Qid SortSet SortSet SortSet -> RenamingSet . op prepare : TypeList Qid SortSet -> TypeList . op prepTerm : TermList Qid SortSet -> TermList . eq prepare((sort S to S'), X, SS, SS', SS'') = if S' inSortSet SS' then (sort qualify(X, S) to qualify(X, S')) else (sort qualify(X, S) to S') fi . eq prepare(((sort S to S'), VMAPS), X, SS, SS', SS'') = ((if S' inSortSet SS' then (sort qualify(X, S) to qualify(X, S')) else (sort qualify(X, S) to S') fi), prepare(VMAPS, X, SS, SS', SS'')) . eq prepare((op F : TyL -> S to F' [AtS]), X, SS, SS', SS'') = (op F : prepare(TyL, X, SS) -> prepare(S, X, SS) to F' [AtS]) . eq prepare(((op F : TyL -> S to F' [AtS]), VMAPS), X, SS, SS', SS'') = ((op F : prepare(TyL, X, SS) -> prepare(S, X, SS) to F' [AtS]), prepare(VMAPS, X, SS, SS', SS'')) . eq prepare((op F to F' [AtS]), X, SS, SS', SS'') = (op F to F' [AtS]) . eq prepare(((op F to F' [AtS]), VMAPS), X, SS, SS', SS'') = ((op F to F' [AtS]), prepare(VMAPS, X, SS, SS', SS'')) . eq prepare(termMap(T, T'), X, SS, SS', SS'') = termMap(prepTerm(T, X, SS), prepTerm(T', X, SS')) . eq prepare((termMap(T, T'), VMAPS), X, SS, SS', SS'') = (termMap(prepTerm(T, X, SS), prepTerm(T', X, SS')), prepare(VMAPS, X, SS, SS', SS'')) . eq prepare((msg F : TyL -> S to F'), X, SS, SS', SS'') = (msg F : prepare(TyL, X, SS) -> prepare(S, X, SS) to F') . eq prepare(((msg F : TyL -> S to F'), VMAPS), X, SS, SS', SS'') = ((msg F : prepare(TyL, X, SS) -> prepare(S, X, SS) to F'), prepare(VMAPS, X, SS, SS', SS'')) . eq prepare((msg F to F'), X, SS, SS', SS'') = (msg F to F') . eq prepare(((msg F to F'), VMAPS), X, SS, SS', SS'') = ((msg F to F'), prepare(VMAPS, X, SS, SS', SS'')) . eq prepare((class S to S'), X, SS, SS', SS'') = if S' inSortSet SS'' then (class qualify(X, S) to qualify(X, S')) else (class qualify(X, S) to S') fi . eq prepare(((class S to S'), VMAPS), X, SS, SS', SS'') = ((if S' inSortSet SS'' then (class qualify(X, S) to qualify(X, S')) else (class qualify(X, S) to S') fi), prepare(VMAPS, X, SS, SS', SS'')) . eq prepare((attr A . S to A'), X, SS, SS', SS'') = (attr A . qualify(X, S) to A') . eq prepare(((attr A . S to A'), VMAPS), X, SS, SS', SS'') = ((attr A . qualify(X, S) to A'), prepare(VMAPS, X, SS, SS', SS'')) . eq prepare((label L to L'), X, SS, SS', SS'') = (label L to L') . eq prepare(none, X, SS, SS', SS'') = none . eq prepare((S TyL), X, (S ; SS)) = (qualify(X, S) prepare(TyL, X, (S ; SS))) . ceq prepare((S TyL), X, SS) = (S prepare(TyL, X, SS)) if not (S inSortSet SS) . eq prepare(nil, X, SS) = nil . eq prepTerm(F[TL], X, SS) = F[prepTerm(TL, X, SS)] . eq prepTerm(V, X, SS) = if getType(V) inSortSet SS then qid(string(getName(V)) + ":" + string(qualify(X, getType(V)))) else qid(string(getName(V)) + ":" + string(getType(V))) fi . eq prepTerm(Ct, X, SS) = if getType(Ct) inSortSet SS then qid(string(getName(Ct)) + "." + string(qualify(X, getType(Ct)))) else qid(string(getName(Ct)) + "." + string(getType(Ct))) fi . ceq prepTerm((T, TL), X, SS) = (prepTerm(T, X, SS), prepTerm(TL, X, SS)) if TL =/= empty . eq prepTerm(qidError(QIL), X, SS) = qidError(QIL) . *** For each parameterized sort *** $\texttt{S[L}_1\texttt{,}\ldots\texttt{,L}_n\texttt{]}$ in the *** body of a parameterized module with *** $\texttt{L}_1\ldots\texttt{L}_n$ the labels of the parameters in *** the interface of the module, a map of the form 9 *** $\texttt{sort\ S[L}_1\texttt{,}\ldots\texttt{,L}_n\texttt{]\ *** to\ S[V}_1\texttt{,}\ldots\texttt{,V}_n\texttt{]}$ *** is generated, where $\texttt{V}_i$ is the name of the view associated to *** the label $\texttt{L}_i$ in the set of pairs given as argument. op genMapsSorts : SortSet Set> -> RenamingSet . op genMapsClasses : SortSet Set> -> RenamingSet . op prepSort : Sort Set> -> Sort . op prepSort : Sort ParameterList ParameterList Set> -> Sort . eq genMapsSorts((S ; SS), VEPS) = (if prepSort(S, VEPS) == S then none else (sort S to prepSort(S, VEPS)) fi), genMapsSorts(SS, VEPS) . eq genMapsSorts(none, VEPS) = none . eq genMapsClasses((S ; SS), VEPS) = (if prepSort(S, VEPS) == S then none else (class S to prepSort(S, VEPS)) fi), genMapsClasses(SS, VEPS) . eq genMapsClasses(none, VEPS) = none . eq prepSort(S, VEPS) = prepSort(getName(S), empty, getPars(S), VEPS) . eq prepSort(S, PL, P, < P ; VE > VEPS) = prepSort(S, (PL, VE), empty, < P ; VE > VEPS) . eq prepSort(S, PL, (P, PL'), < P ; VE > VEPS) = prepSort(S, (PL, VE), PL', < P ; VE > VEPS) . eq prepSort(S, PL, P, VEPS) = prepSort(S, (PL, prepSort(P, VEPS)), empty, VEPS) [owise] . eq prepSort(S, PL, (P, PL'), VEPS) = prepSort(S, (PL, prepSort(P, VEPS)), PL', VEPS) [owise] . eq prepSort(S, PL, empty, VEPS) = if getPars(S) == empty then makeSort(S, PL) else makeSort(prepSort(S, VEPS), PL) fi . *** The function \texttt{prepImports} takes a list of importation *** declarations and a set of pairs composed of a label and a view name, and *** returns the list of importations resulting from changing in each of the *** module expressions the occurrences of the labels of the interface of the *** module being instantiated by the names of the views associated to them in *** the list of pairs. op prepImports : ImportList Set> -> ImportList . op prepModExp : ModuleExpression Set> -> ModuleExpression . op prepModExp : ModuleExpression ViewExp ViewExp ViewExp Set> -> ModuleExpression . op prepParameterDecl : ParameterDecl Set> -> ParameterDecl . op prepViewExp : ViewExp Set> -> ViewExp . eq prepImports(((including ME .) IL), VEPS) = (including prepModExp(ME, VEPS) .) prepImports(IL, VEPS) . eq prepImports(((including pd(PD) .) IL), VEPS) = (including pd(prepParameterDecl(PD, VEPS)) .) prepImports(IL, VEPS) . eq prepImports(((extending ME .) IL), VEPS) = (extending prepModExp(ME, VEPS) .) prepImports(IL, VEPS) . eq prepImports(((extending pd(PD) .) IL), VEPS) = (extending pd(prepParameterDecl(PD, VEPS)) .) prepImports(IL, VEPS) . eq prepImports(((protecting ME .) IL), VEPS) = (protecting prepModExp(ME, VEPS) .) prepImports(IL, VEPS) . eq prepImports(((protecting pd(PD) .) IL), VEPS) = (protecting pd(prepParameterDecl(PD, VEPS)) .) prepImports(IL, VEPS) . eq prepImports(nil, VEPS) = nil . eq prepModExp(QI, VEPS) = QI . eq prepModExp(ME{PL}, VEPS) = prepModExp(ME, empty, empty, PL, VEPS) . eq prepModExp(ME + ME', VEPS) = prepModExp(ME, VEPS) + prepModExp(ME', VEPS) . eq prepModExp(ME, VEPS) = ME [owise] . eq prepModExp(ME, PL, PL', (P, PL''), < P ; S > VEPS) = prepModExp(ME, (PL, S), PL', PL'', < P ; S > VEPS) . eq prepModExp(ME, PL, PL', (P, PL''), < P ; S{PL3} > VEPS) = prepModExp(ME, (PL, S{PL3}), PL', PL'', < P ; S{PL3} > VEPS) . ceq prepModExp(ME, PL, PL', (P, PL''), < P ; P' ;; VE > VEPS) = prepModExp(ME, (PL, P'), (PL', VE), PL'', < P ; P' ;; VE > VEPS) if VE =/= mtViewExp . eq prepModExp(ME, PL, PL', (P, PL''), VEPS) = prepModExp(ME, (PL, P), PL', PL'', VEPS) [owise] . eq prepModExp(ME, PL, PL', (QI{PL''}, PL3), VEPS) = prepModExp(ME, (PL, prepViewExp(QI{PL''}, VEPS)), PL', PL3, VEPS) . eq prepModExp(ME, PL, empty, empty, VEPS) = ME{PL} . eq prepModExp(ME, PL, PL', empty, VEPS) = ME{PL}{PL'} [owise] . eq prepParameterDecl(X :: ME, < Y ; Z > VEPS) = if X == Y then (Z :: ME) else prepParameterDecl(X :: ME, VEPS) fi . eq prepParameterDecl(X :: ME, none) = X :: ME . eq prepViewExp(VE, < VE ; VE' > VEPS) = VE' . eq prepViewExp(QI, VEPS) = QI [owise] . eq prepViewExp(X{PL}, VEPS) = X{prepViewExp(PL, VEPS)} [owise] . ceq prepViewExp((VE, VE'), VEPS) = prepViewExp(VE, VEPS), prepViewExp(VE', VEPS) if VE =/= nil /\ VE' =/= nil [owise] . *** The function \texttt{unitInst} calls the auxiliary function *** \texttt{unitInstAux}, which proceeds recursively on each of the parameters *** in the interface of the module being instantiated. For each view, a set of *** maps to be applied to the module is generated, which are accumulated in *** the third argument of the function. *** In the base case, when there are no more parameters and no more views, the *** maps for the parameterized sorts are also generated, and all maps are *** then applied. *** \texttt{unitInstAux} proceeds accumulating also the list of parameters *** being modified, the list of importations, and a list of label-view *** pairs (\texttt{QidTuple}) associating each label in *** the interface to the view used in the instantiation of the theory with *** such label. This list of pairs is used to generate the set of maps of the *** parameterized sorts and to `prepare' the list of importations as *** indicated above. sort TreatParResult . op <_;_;_;_;_> : Set{ViewMap} ParameterDeclList ImportList Set> Database -> TreatParResult . op mapSet : TreatParResult -> Set{ViewMap} . op getPars : TreatParResult -> ParameterDeclList . op getImports : TreatParResult -> ImportList . op viewExpPairSet : TreatParResult -> Set> . op db : TreatParResult -> Database . eq mapSet(< VMAPS ; PDL ; IL ; VEPS ; DB >) = VMAPS . eq getPars(< VMAPS ; PDL ; IL ; VEPS ; DB >) = PDL . eq getImports(< VMAPS ; PDL ; IL ; VEPS ; DB >) = IL . eq viewExpPairSet(< VMAPS ; PDL ; IL ; VEPS ; DB >) = VEPS . eq db(< VMAPS ; PDL ; IL ; VEPS ; DB >) = DB . op unitInstAux : Module Module OpDeclSet RenamingSet ParameterDeclList ParameterDeclList ImportList ImportList ParameterList Set> ParameterDeclList Database -> Database . op treatPar : ParameterDecl ViewExp Set> ParameterDeclList Database -> TreatParResult . op treatPar2 : ParameterDecl ViewExp Set> ParameterDeclList Database -> TreatParResult . op treatParAux : Qid ModuleExpression ParameterDeclList ViewExp Qid ViewExp ViewExp ParameterDeclList RenamingSet ParameterDeclList ImportList Set> Database -> TreatParResult . op treatParAux2 : Qid ModuleExpression ParameterDeclList ViewExp Qid ViewExp ViewExp ParameterDeclList RenamingSet ParameterDeclList ImportList Set> Database -> TreatParResult . eq unitInst(ME, PL, PDL, DB) = unitInstAux(setName(getTopModule(ME, DB), ME{PL}), signature(getFlatModule(ME, DB)), getVars(ME, DB), none, getPars(getTopModule(ME, DB)), nil, getImports(getTopModule(ME, DB)), nil, PL, none, PDL, DB) . ceq unitInstAux(U, M, VDS, VMAPS, (X :: ME, PDL), PDL', IL, IL'', (QI, PL), VEPS, PDL'', DB) = unitInstAux(U, M, VDS, (VMAPS, VMAPS'), PDL, (PDL', PDL3), IL, (IL'' IL3), PL, (VEPS VEPS'), PDL'', DB') if < VMAPS' ; PDL3 ; IL3 ; VEPS' ; DB' > := treatPar(X :: ME, QI, VEPS, PDL'', DB) . ceq unitInstAux(U, M, VDS, VMAPS, (X :: ME, PDL), PDL', IL, IL'', (QI{PL}, PL'), VEPS, PDL'', DB) = unitInstAux(U, M, VDS, (VMAPS, VMAPS'), PDL, (PDL', PDL3), IL, (IL'' IL3), PL', (VEPS VEPS'), PDL'', DB') if < VMAPS' ; PDL3 ; IL3 ; VEPS' ; DB' > := treatPar(X :: ME, QI{PL}, VEPS, PDL'', DB) . ceq unitInstAux(U, M, VDS, VMAPS, nil, PDL, IL, IL', empty, VEPS, PDL', DB) = evalModule( setImports( setPars(applyMapsToModule((VMAPS', VMAPS''), U, M), PDL), (prepImports(IL, VEPS) IL')), applyMapsToOps(VMAPS', VMAPS'', VDS, M), DB) if < VMAPS' ; VMAPS'' > := splitMaps( (VMAPS, genMapsSorts( (getSorts(U) ; getSortSetAux(getImports(U), DB)), VEPS), genMapsClasses( (getClassNames(getClasses(U)) ; getClassSetAux(getImports(U), DB)), VEPS))) . eq unitInstAux(unitError(QIL), UK:[Module], SDV:[OpDeclSet], VMAPS, PDL, PDL', IL, IL', VE, VEPS, PDL'', DB) = warning(DB, QIL) . eq unitInstAux(noModule, unitError(QIL), VDS, VMAPS, PDL, PDL', IL, IL', VE, VEPS, PDL'', DB) = warning(DB, QIL) . eq unitInstAux(U, M, VDS, VMAPS, (X :: ME, PDL), PDL', IL, IL', empty, VEPS, PDL'', DB) = warning(DB, '\r 'Error: '\o 'Incorrect 'module header2QidList(getName(U)) '. '\n) . eq unitInstAux(U, M, VDS, VMAPS, nil, PDL, IL, IL', (QI, VE), VEPS, PDL', DB) = warning(DB, '\r 'Error: '\o 'Incorrect 'module header2QidList(getName(U)) '. '\n) . eq unitInstAux(U, M, VDS, VMAPS, PDL, PDL', IL, IL', PL, VEPS, PDL'', DB) = DB [owise] . eq treatParView(X :: ME, VE, ME', VEPS, PDL, DB) = if labelInModExp(X, ME') then treatPar(X :: ME, VE, VEPS, PDL, DB) else < none ; getPars(treatPar(X :: ME, VE, VEPS, PDL, DB)) ; getImports(treatPar(X :: ME, VE, VEPS, PDL, DB)) ; viewExpPairSet(treatPar(X :: ME, VE, VEPS, PDL, DB)) ; db(treatPar(X :: ME, VE, VEPS, PDL, DB)) > fi . op labelInModExp : Qid ModuleExpression -> Bool . op labelInViewExp : Qid ViewExp -> Bool . eq labelInModExp(X, QI) = X == QI . eq labelInModExp(X, ME{VE}) = labelInViewExp(X, VE) . eq labelInModExp(X, TUPLE[N]) = false . eq labelInViewExp(X, QI) = X == QI . eq labelInViewExp(X, ((VE, VE'))) = labelInViewExp(X, VE) or-else labelInViewExp(X, VE') . eq labelInViewExp(X, QI{VE}) = X == QI or-else labelInViewExp(X, VE) . eq treatPar(X :: ME, VE, VEPS, PDL, DB) = if VE :: Qid and-then labelInParameterDeclList(VE, PDL) then < (genMapsQualSorts(X, VE, getThSorts(ME, DB), VEPS), genMapsQualClasses(X, VE, getThClasses(ME, DB), VEPS)) ; VE :: ME ; nil ; < X ; VE > ; createCopy((VE :: ME), DB) > else if viewInDb(VE, DB) then if theory(getTopModule(target(getView(VE, DB)), DB)) then < prepare( mapSet(getView(VE, DB)), X, getThSorts(ME, DB), getThSorts(target(getView(VE, DB)), DB), getThClasses(target(getView(VE, DB)), DB)) ; X :: target(getView(VE, DB)) ; nil ; < X ; (VE ;; X) > ; createCopy((X :: target(getView(VE, DB))), DB) > else < prepare( mapSet(getView(VE, DB)), X, getThSorts(ME, DB), none, none) ; getPars(getTopModule(target(getView(VE, DB)), DB)) ; (protecting target(getView(VE, DB)) .) ; < X ; VE > ; DB > fi else < none ; nil ; nil ; none ; warning(DB, '\r 'Error: '\o 'View VE 'not 'in 'database. '\n) > fi fi . op viewInstAux : View Set{ViewMap} ParameterDeclList ParameterDeclList ParameterList Set> ParameterDeclList Database -> Database . op treatParView : ParameterDecl ParameterList ModuleExpression Set> ParameterDeclList Database -> TreatParResult . op treatParAux : Qid ModuleExpression ParameterList Qid ViewExp ViewExp ParameterList RenamingSet ParameterList ImportList Set> Database -> TreatParResult . eq viewInst(VE, PL, PDL, DB) = viewInstAux(setName(getView(VE, DB), VE{PL}), none, getPars(getView(VE, DB)), nil, PL, none, PDL, DB) . ceq viewInstAux(VI, VMAPS, (X :: ME, PDL), PDL', (QI, PL), VEPS, PDL'', DB) = viewInstAux(VI, (VMAPS, VMAPS'), PDL, (PDL', PDL3), PL, (VEPS VEPS'), PDL'', DB') if < VMAPS' ; PDL3 ; IL ; VEPS' ; DB' > := treatParView(X :: ME, QI, source(VI), VEPS, PDL'', DB) . ceq viewInstAux(VI, VMAPS, (X :: ME, PDL), PDL', (QI{PL}, PL'), VEPS, PDL'', DB) = viewInstAux(VI, (VMAPS, VMAPS'), PDL, (PDL', PDL3), PL', (VEPS VEPS'), PDL'', DB') if < VMAPS' ; PDL3 ; IL ; VEPS' ; DB' > := treatParView(X :: ME, QI{PL}, source(VI), VEPS, PDL'', DB) . eq viewInstAux(VI, VMAPS, nil, PDL, empty, VEPS, PDL', DB) = insertView( setPars( sTSource( setTarget( setMaps(VI, applyMapsToMaps( (genMapsSorts(getSortSet(source(VI), DB), VEPS), genMapsClasses(getClassSet(source(VI), DB), VEPS)), (VMAPS, genMapsSorts(getSortSet(target(VI), DB), VEPS), genMapsClasses(getClassSet(target(VI), DB), VEPS)), mapSet(VI))), prepModExp(target(VI), VEPS)), prepModExp(source(VI), VEPS)), PDL), database(evalModExp(prepModExp(target(VI), VEPS), PDL', database(evalModExp(prepModExp(source(VI), VEPS), PDL', DB))))) . eq viewInstAux(viewError(QIL), VMAPS, PDL0:[ParameterDeclList], PDL, VE, VEPS, PDL', DB) = warning(DB, QIL) . eq viewInstAux(VI, VMAPS, (X :: ME, PDL), PDL', empty, VEPS, PDL'', DB) = warning(DB, ('\r 'Error: '\o 'Incorrect 'view name(VI) '. '\n)) . eq viewInstAux(VI, VMAPS, nil, PDL, (QI, VE), VEPS, PDL', DB) = warning(DB, ('\r 'Error: '\o 'Incorrect 'view name(VI) '. '\n)) . eq viewInstAux(VI, VMAPS, (X :: ME, PDL), PDL', (QI{VE}, VE'), VEPS, PDL'', DB) = warning(DB, ('\r 'Error: '\o 'Wrong 'instantiation name(VI) '. '\n)) . op applyMapsToMaps : Set{ViewMap} Set{ViewMap} Set{ViewMap} -> Set{ViewMap} . op applyMapsToTerm : Set{ViewMap} TermList -> TermList . eq applyMapsToMaps(VMAPS, VMAPS', op F to F' [AtS]) = (op F to F' [AtS]) . eq applyMapsToMaps(VMAPS, VMAPS', (op F to F' [AtS], VMAPS'')) = (op F to F' [AtS], applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) . eq applyMapsToMaps(VMAPS, VMAPS', op F : TyL -> S to F' [AtS]) = (op F : applyMapsToTypeList(VMAPS, TyL) -> applyMapsToType(VMAPS, S) to F' [AtS]) . eq applyMapsToMaps(VMAPS, VMAPS', (op F : TyL -> S to F' [AtS], VMAPS'')) = (op F : applyMapsToTypeList(VMAPS, TyL) -> applyMapsToType(VMAPS, S) to F' [AtS], applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) . eq applyMapsToMaps(VMAPS, VMAPS', (sort S to S')) = (sort applyMapsToType(VMAPS, S) to applyMapsToType(VMAPS', S')) . eq applyMapsToMaps(VMAPS, VMAPS', ((sort S to S'), VMAPS'')) = ((sort applyMapsToType(VMAPS, S) to applyMapsToType(VMAPS', S')), applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) . eq applyMapsToMaps(VMAPS, VMAPS', (label L to L')) = (label L to L') . eq applyMapsToMaps(VMAPS, VMAPS', ((label L to L'), VMAPS'')) = ((label L to L'), applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) . eq applyMapsToMaps(VMAPS, VMAPS', (class S to S')) = (class applyMapsToType(VMAPS, S) to applyMapsToType(VMAPS',S')) . eq applyMapsToMaps(VMAPS, VMAPS', ((class S to S'), VMAPS'')) = ((class applyMapsToType(VMAPS, S) to applyMapsToType(VMAPS',S')), applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) . eq applyMapsToMaps(VMAPS, VMAPS', (attr A . S to A')) = (attr A . applyMapsToType(VMAPS, S) to A') . eq applyMapsToMaps(VMAPS, VMAPS', ((attr A . S to A'), VMAPS'')) = ((attr A . applyMapsToType(VMAPS, S) to A'), applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) . eq applyMapsToMaps(VMAPS, VMAPS', (msg F to F')) = (msg F to F') . eq applyMapsToMaps(VMAPS, VMAPS', ((msg F to F'), VMAPS'')) = ((msg F to F'), applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) . eq applyMapsToMaps(VMAPS, VMAPS', (msg F : TyL -> S to F')) = (msg F : applyMapsToTypeList(VMAPS, TyL) -> applyMapsToType(VMAPS, S) to F') . eq applyMapsToMaps(VMAPS, VMAPS', ((msg F : TyL -> S to F'), VMAPS'')) = ((msg F : applyMapsToTypeList(VMAPS, TyL) -> applyMapsToType(VMAPS, S) to F'), applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) . eq applyMapsToMaps(VMAPS, VMAPS', termMap(T, T')) = termMap(applyMapsToTerm(VMAPS, T), applyMapsToTerm(VMAPS', T')) . eq applyMapsToMaps(VMAPS, VMAPS', (termMap(T, T'), VMAPS'')) = (termMap(applyMapsToTerm(VMAPS, T), applyMapsToTerm(VMAPS', T')), applyMapsToMaps(VMAPS, VMAPS', VMAPS'')) . eq applyMapsToMaps(VMAPS, VMAPS', none) = none . eq applyMapsToTerm(VMAPS, Ct) = qid(string(getName(Ct)) + "." + string(applyMapsToSort(VMAPS, getType(Ct)))) . eq applyMapsToTerm(VMAPS, V) = V . eq applyMapsToTerm(VMAPS, qidError(QIL)) = qidError(QIL) . ceq applyMapsToTerm(VMAPS, F[TL]) = F[applyMapsToTerm(VMAPS, TL)] if (F =/= '<_:_|_>) and (F =/= '<_:_|`>) . eq applyMapsToTerm(VMAPS, '<_:_|_>[O, Ct, T]) = '<_:_|_>[applyMapsToTerm(VMAPS, O), qid(string(applyMapsToClassName(VMAPS, getName(Ct))) + "." + string(applyMapsToClassName(VMAPS, getType(Ct)))), applyMapsToTerm(VMAPS, T)] . ceq applyMapsToTerm(VMAPS, '<_:_|_>[O, C, T]) = '<_:_|_>[applyMapsToTerm(VMAPS, O), applyMapsToClassName(VMAPS, C), applyMapsToTerm(VMAPS, T)] if not C :: Constant . eq applyMapsToTerm(VMAPS, '<_:_|`>[O, Ct]) = '<_:_|_>[applyMapsToTerm(VMAPS, O), qid(string(applyMapsToClassName(VMAPS, getName(Ct))) + "." + string(applyMapsToClassName(VMAPS, getType(Ct)))), 'none.AttributeSet] . ceq applyMapsToTerm(VMAPS, '<_:_|`>[O, C]) = '<_:_|_>[applyMapsToTerm(VMAPS, O), applyMapsToClassName(VMAPS, C), 'none.AttributeSet] if not C :: Constant . ceq applyMapsToTerm(VMAPS, (T, TL)) = (applyMapsToTerm(VMAPS, T), applyMapsToTerm(VMAPS, TL)) if TL =/= empty . *** As pointed out in Section~\ref{module-names}, for each new module *** expression constructor being introduced, we need to add equations for the *** operator \texttt{header2Qid}. Since the function to transform view *** expressions into lists of quoted identifiers was already defined in *** Section~\ref{VIEW-EXPR}, we just need to add the following equation. eq header2Qid((ME { PL })) = qidList2Qid(header2Qid(ME) '`{ parameterList2Qid(PL) '`}) . ceq header2QidList((ME { PL })) = (if QI == '\s then QIL else QIL QI fi '`{ parameterList2QidList(PL) '`} '\s) if QIL QI := header2QidList(ME) . *** Given a module expression of the form \verb~ME{VE}~ such that *** \texttt{ME} is in the database, we need to add \verb~ME{VE}~ to the set *** of names of the modules depending on \texttt{ME} and on \texttt{VE}. *** Since \texttt{VE} may be a composed view expression, we have to add the *** name of the module to each of the views in it. In this way, if \texttt{ME} *** or any of the views in \texttt{VE} is redefined or removed from the *** database, \verb~ME{VE}~ will be removed as well. eq setUpModExpDeps(ME{PL}, db(< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = viewExpDeps(ME{PL}, PL, db(< ME ; DT ; U ; U' ; M ; VDS ; (MNS . ME{PL}) ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq setUpModExpDeps(ME{PL}, db(< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = viewExpDeps(ME{PL}, PL, db(< ME ; DM ; U ; U' ; M ; VDS ; (MNS . ME{PL}) ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq setUpModExpDeps('META-LEVEL{PL}, DB) = setUpModExpDeps('META-LEVEL{PL}, PL, DB) . eq setUpModExpDeps('META-LEVEL{QI}, db(< QI ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = db(< QI ; DT ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{QI} ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . eq setUpModExpDeps('META-LEVEL{QI}, db(< QI ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = db(< QI ; DM ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{QI} ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . ceq setUpModExpDeps(ME{PL}, DB) = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n)) if (ME =/= 'META-LEVEL) /\ (not unitInDb(ME, DB)) . eq setUpModExpDeps('META-LEVEL{PL}, (QI, PL'), db(< QI ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpModExpDeps('META-LEVEL{PL}, PL', db(< QI ; DT ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{PL} ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq setUpModExpDeps('META-LEVEL{PL}, (QI, PL'), db(< QI ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = setUpModExpDeps('META-LEVEL{PL}, PL', db(< QI ; DM ; U ; U' ; M ; VDS ; MNS . 'META-LEVEL{PL} ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) . eq setUpModExpDeps('META-LEVEL{PL}, nil, DB) = DB . op viewExpDeps : Header ViewExp Database -> Database . ---- eq viewExpDeps(ME, VE, ---- db(MIS, MNS, ---- < VE ; DT ; VI ; MNS' ; VES > VIS, VES', ---- MNS'', MNS3, MNS4, QIL)) ---- = db(MIS, MNS, < VE ; DT ; VI ; MNS' . ME ; VES > VIS, VES', ---- MNS'', MNS3, MNS4, QIL) . eq viewExpDeps(ME, (VE, PL), db(MIS, MNS, < VE ; DT ; VI ; MNS' ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) = viewExpDeps(ME, PL, db(MIS, MNS, < VE ; DT ; VI ; MNS' . ME ; VES > VIS, VES', MNS'', MNS3, MNS4, QIL)) . ---- eq viewExpDeps(ME, VE, DB) = DB [owise] . eq viewExpDeps(ME, (VE, PL), DB) = viewExpDeps(ME, PL, DB) [owise] . eq viewExpDeps(ME, empty, DB) = DB . endfm ******************************************************************************* *** *** 6.10 Renaming of Modules *** *** In addition to the declaration of the constructor for renaming module *** expressions, the following module \texttt{RENAMING-EXPR-EVALUATION} *** introduces equations to treat this new case in the definition of functions *** \texttt{evalModExp}, \texttt{header2QidList}, \texttt{prepHeader}, and *** \texttt{setUpModuleDeps}. *** A renaming expression is evaluated by applying the renaming maps, not only *** to the top unit, but also to the part of the structure \emph{affected} by *** the maps. The renaming process propagates downwards in the unit hierarchy *** while the units in the structure are affected by the renamings. We say that *** a unit is affected by a set of maps (checked by the \texttt{modAffd} *** function) when any of the maps is applicable to any of the declarations in *** the unit, or in any of its subunits. The application of a set of maps to a *** single unit is accomplished by the \texttt{applyMapsToModule} function, *** discussed in Section~\ref{applyMapsToModule}. fmod RENAMING-EXPR-EVALUATION is pr DATABASE . pr VIEW-MAP-SET-APPL-ON-UNIT . pr EVALUATION . inc MOD-EXPR . pr MOD-EXPR-EVAL . pr INST-EXPR-EVALUATION . pr FMAP . vars ME ME' : ModuleExpression . var MNS MNS' MNS'' MNS3 MNS4 : Set{ModuleName} . vars MIS MIS' : Set{ModuleInfo} . var VIS : Set{ViewInfo} . vars M M' : Module . vars PU U U' DM : Module . vars DB DB' : Database . var QIL : QidList . vars VES VES' : Set{ViewExp} . var PL : ParameterList . var PDL : ParameterDeclList . vars PDS PDS' : Set{ParameterDecl} . var I : Import . vars IL IL' : ImportList . var VMAP : ViewMap . vars VMAPS VMAPS' VMAPS'' VMAPS3 : RenamingSet . var VEPS : Set> . vars X QI QI' QI'' F F' F'' L L' L'' A A' A'' : Qid . vars S S' S'' C C' C'' : Sort . var K : Kind . vars SS : SortSet . vars TyL TyL' : TypeList . vars Ty Ty' : Type . vars T T' T'' T3 : Term . var DT : Default{Term} . var TL : TermList . var OPD : OpDeclSet . vars OPDS VDS : OpDeclSet . vars AtS AtS' : AttrSet . var Rl : Rule . var RlS : RuleSet . var CD : ClassDecl . var CDS : ClassDeclSet . var ADS : AttrDeclSet . var MD : MsgDecl . var MDS : MsgDeclSet . var MAP : Renaming . vars MAPS MAPS' MAPS'' : RenamingSet . var N : Nat . var NL : IntList . var Hk : Hook . var HkL : HookList . var B : Bool . *** The function \texttt{crtCopyRen} creates a copy of the part of the *** structure of the specified module which is affected by the renaming, *** applying to each of the generated modules in the new structure the subset *** of maps affecting each one of them. The equation extending the *** \texttt{evalModExp} function to the renaming module expression is then *** reduced to a call to \texttt{crtCopyRen} with the appropriate *** arguments. eq labelInModExp(X, ME * (MAPS)) = labelInModExp(X, ME) . op crtCopyRen : ModuleExpression RenamingSet Database -> Database . ceq evalModExp(ME * (MAPS), PDL, DB) = if unitInDb(ME' * (MAPS''), DB') then < DB' ; ME' * (MAPS'') > else < crtCopyRen(ME', MAPS', DB') ; ME' * (MAPS'') > fi if < DB' ; ME' > := evalModExp(ME, PDL, DB) /\ MAPS' := fixMaps(MAPS, ME', DB') /\ MAPS'' := canMaps(MAPS', getFlatModule(ME', DB')) . eq crtCopyRen(ME, none, DB) = DB . ceq crtCopyRen(ME, VMAPS, DB) = if unitInDb(_*`(_`)(ME, VMAPS'), DB) then DB else applyMapsRec( VMAPS, getImports(getTopModule(ME, DB)), nil, setName( applyMapsToModuleAux(VMAPS'', VMAPS3, getTopModule(ME, DB), getFlatModule(ME, DB)), _*`(_`)(ME, VMAPS')), applyMapsToOps(VMAPS'', VMAPS3, getVars(ME, DB), getFlatModule(ME, DB)), DB) fi if VMAPS' := canMaps(VMAPS, getFlatModule(ME, DB)) /\ < VMAPS'' ; VMAPS3 > := splitMaps(VMAPS') . op canMaps : RenamingSet Module -> RenamingSet . eq canMaps(op F : TyL -> Ty to F' [AtS], M) = op F : canKinds(TyL, M) -> canKinds(Ty, M) to F' [AtS] . eq canMaps((op F : TyL -> Ty to F' [AtS], MAPS), M) = (op F : canKinds(TyL, M) -> canKinds(Ty, M) to F' [AtS], canMaps(MAPS, M)) . eq canMaps(msg F : TyL -> Ty to F', M) = msg F : canKinds(TyL, M) -> canKinds(Ty, M) to F' . eq canMaps((msg F : TyL -> Ty to F', MAPS), M) = (msg F : canKinds(TyL, M) -> canKinds(Ty, M) to F', canMaps(MAPS, M)) . eq canMaps(MAP:Renaming, M) = MAP:Renaming [owise] . eq canMaps((MAP:Renaming, MAPS), M) = (MAP:Renaming, canMaps(MAPS, M)) [owise] . eq canMaps(none, M) = none . op canKinds : TypeList Module -> [TypeList] . ---- eq canKinds(K:Kind TyL, M) ---- = kind(maximalSorts(M, K:Kind)) canKinds(TyL, M) . eq canKinds(nil, M) = nil . eq canKinds(cc(S ; SS) TyL, M) = kind(maximalSorts(M, getKind(M, S))) canKinds(TyL, M) . ----eq canKinds(TyL, M) = nil [owise] . *** We proceed downwards while the set of maps affects the module, but we do so *** restricting the set of maps to the subset affecting the module. Since *** operator and message maps in which arity and coarity are specified must be *** applied to the whole subsort-overloaded family of operators or messages, we *** have to carry along the signature of the module at the top to make all the *** calls to the engine. Note that we may have maps of operations or messages *** with the domain given by sorts that are not in the submodules but which *** have other sorts in the submodules in the same connected components. op applyMapsRec : Set{ViewMap} ImportList ImportList Module OpDeclSet Database -> Database . eq applyMapsRec(VMAPS, ((including ME .) IL), IL', U, VDS, DB) = applyMapsRec( VMAPS, IL, including ME *( canMaps(fixMaps(VMAPS, ME, DB), getFlatModule(ME, DB)) ) . IL', U, VDS, crtCopyRen(ME, fixMaps(VMAPS, ME, DB), DB)) . eq applyMapsRec(VMAPS, ((extending ME .) IL), IL', U, VDS, DB) = applyMapsRec( VMAPS, IL, extending ME *( canMaps(fixMaps(VMAPS, ME, DB), getFlatModule(ME, DB)) ) . IL', U, VDS, crtCopyRen(ME, fixMaps(VMAPS, ME, DB), DB)) . eq applyMapsRec(VMAPS, ((protecting ME .) IL), IL', U, VDS, DB) = applyMapsRec( VMAPS, IL, protecting ME *( canMaps(fixMaps(VMAPS, ME, DB), getFlatModule(ME, DB)) ) . IL', U, VDS, crtCopyRen(ME, fixMaps(VMAPS, ME, DB), DB)) . eq applyMapsRec(VMAPS, (I IL), IL', U, VDS, DB) = applyMapsRec(VMAPS, IL, (I IL'), U, VDS, DB) [owise] . eq applyMapsRec(VMAPS, nil, IL, U, VDS, DB) = evalModule(setImports(U, IL), VDS, DB) . eq applyMapsRec(VMAPS, IL, IL', unitError(QIL), VDS, DB) = warning(DB, QIL) . op fixMaps : [RenamingSet] ModuleExpression Database -> RenamingSet . op fixMaps2 : [RenamingSet] Module ClassDeclSet MsgDeclSet -> RenamingSet . ceq fixMaps(MAPS, ME, DB) = fixMaps2(MAPS, getFlatModule(ME, DB), CDS, MDS) if < CDS ; MDS > := getAllClassesAndMsgs(ME, DB) . eq fixMaps2(op F to F' [AtS], M, CDS, MDS) = opsAffd(getOps(M), op F to F' [AtS], M) . eq fixMaps2((op F to F' [AtS], MAPS), M, CDS, MDS) = (opsAffd(getOps(M), op F to F' [AtS], M), fixMaps2(MAPS, M, CDS, MDS)) . eq fixMaps2(op F : TyL -> Ty to F' [AtS], M, CDS, MDS) = opsAffd(getOps(M), op F : TyL -> Ty to F' [AtS], M) . eq fixMaps2((op F : TyL -> Ty to F' [AtS], MAPS), M, CDS, MDS) = (opsAffd(getOps(M), op F : TyL -> Ty to F' [AtS], M), fixMaps2(MAPS, M, CDS, MDS)) . eq fixMaps2(msg F to F', M, CDS, MDS) = msgsAffd(MDS, msg F to F', M) . eq fixMaps2((msg F to F', MAPS), M, CDS, MDS) = (msgsAffd(MDS, msg F to F', M), fixMaps2(MAPS, M, CDS, MDS)) . eq fixMaps2(msg F : TyL -> Ty to F', M, CDS, MDS) = msgsAffd(MDS, msg F : TyL -> Ty to F', M) . eq fixMaps2((msg F : TyL -> Ty to F', MAPS), M, CDS, MDS) = (msgsAffd(MDS, msg F : TyL -> Ty to F', M), fixMaps2(MAPS, M, CDS, MDS)) . eq fixMaps2(sort Ty to Ty', M, CDS, MDS) = if sortsAffd(getSorts(M), sort Ty to Ty') then (sort Ty to Ty') else none fi . eq fixMaps2(((sort Ty to Ty'), MAPS), M, CDS, MDS) = (if sortsAffd(getSorts(M), sort Ty to Ty') then (sort Ty to Ty') else none fi, fixMaps2(MAPS, M, CDS, MDS)) . eq fixMaps2(class Ty to Ty', M, CDS, MDS) = if classesAffd(CDS, class Ty to Ty') then (class Ty to Ty') else none fi . eq fixMaps2(((class Ty to Ty'), MAPS), M, CDS, MDS) = (if classesAffd(CDS, class Ty to Ty') then (class Ty to Ty') else none fi, fixMaps2(MAPS, M, CDS, MDS)) . eq fixMaps2(attr A . Ty to Ty', M, CDS, MDS) = if classesAffd(CDS, attr A . Ty to Ty') then (attr A . Ty to Ty') else none fi . eq fixMaps2(((class A . Ty to Ty'), MAPS), M, CDS, MDS) = (if classesAffd(CDS, attr A . Ty to Ty') then (attr A . Ty to Ty') else none fi, fixMaps2(MAPS, M, CDS, MDS)) . eq fixMaps2(MAP:Renaming, M, CDS, MDS) = MAP:Renaming [owise] . eq fixMaps2((MAP:Renaming, MAPS), M, CDS, MDS) = (MAP:Renaming, fixMaps2(MAPS, M, CDS, MDS)) [owise] . eq fixMaps2(none, M, CDS, MDS) = none . sort Tuple{ClassDeclSet, MsgDeclSet} . op <_;_> : ClassDeclSet MsgDeclSet -> Tuple{ClassDeclSet, MsgDeclSet} . op getClasses : Tuple{ClassDeclSet, MsgDeclSet} -> ClassDeclSet . op getMsgs : Tuple{ClassDeclSet, MsgDeclSet} -> MsgDeclSet . eq getClasses(< CDS ; MDS >) = CDS . eq getMsgs(< CDS ; MDS >) = MDS . op getAllClassesAndMsgs : ModuleExpression Database -> Tuple{ClassDeclSet, MsgDeclSet} . op getAllClassesAndMsgs : ImportList Database -> Tuple{ClassDeclSet, MsgDeclSet} . eq getAllClassesAndMsgs(ME, DB) = if getTopModule(ME, DB) :: OModule and-then not getTopModule(ME, DB) :: SModule then < getClasses( getAllClassesAndMsgs(getImports(getTopModule(ME, DB)), DB)) getClasses(getTopModule(ME, DB)) ; getMsgs( getAllClassesAndMsgs(getImports(getTopModule(ME, DB)), DB)) getMsgs(getTopModule(ME, DB)) > else < none ; none > fi . eq getAllClassesAndMsgs(I IL, DB) = < getClasses(getAllClassesAndMsgs(moduleName(I), DB)) getClasses(getAllClassesAndMsgs(IL, DB)) ; getMsgs(getAllClassesAndMsgs(moduleName(I), DB)) getMsgs(getAllClassesAndMsgs(IL, DB)) > . eq getAllClassesAndMsgs((nil).ImportList, DB) = < none ; none > . sorts NeSet Set . subsort TypeList < NeSet < Set . op noneTLS : -> Set [ctor] . op _!_ : Set Set -> Set [ctor assoc comm id: noneTLS] . op _!_ : NeSet NeSet -> NeSet [ctor assoc comm id: noneTLS] . sort Set . subsorts Type SortSet < Set . op _o_ : Set Set -> Set [ctor assoc comm id: none] . eq Ty o Ty = Ty . sort List> . subsort Set < List> . op nilTSL : -> List> [ctor] . op _l_ : List> List> -> List> [ctor assoc id: nilTSL] . var TS : Set . var TSL : List> . var TLS : Set . var NTLS : NeSet . eq TyL ! TyL = TyL . ----eq _!_(qidError(QIL), NTLS) = qidError(QIL) . op fixKinds : TypeList Module -> Set . op fixKinds : TypeList List> Module -> Set . op fixKindsAux : Type Module -> Set . op fixKindsAux2 : SortSet Module -> Set . op unfold : List> -> Set . op add : Set Set -> Set . eq fixKinds(TyL, M) = fixKinds(TyL, nilTSL, M) . eq fixKinds(Ty TyL, TSL, M) = if fixKindsAux(Ty, M) == nil then noneTLS else fixKinds(TyL, TSL l fixKindsAux(Ty, M), M) fi . eq fixKinds(nil, TSL, M) = unfold(TSL) . eq fixKindsAux(S, M) = if S inSortSet getSorts(M) then cc(connectedSorts(M, S)) else none fi . eq fixKindsAux(K, M) = fixKindsAux2(getSorts(K), M) . eq fixKindsAux(cc(SS), M) = fixKindsAux2(SS, M) . eq fixKindsAux2((S ; SS), M) = (if S inSortSet getSorts(M) then cc(connectedSorts(M, S)) else none fi o fixKindsAux2(SS, M)) . eq fixKindsAux2(none, M) = none . ceq unfold(TS l TSL) = add(TS, unfold(TSL)) if TS =/= none . eq unfold(nilTSL) = noneTLS . eq add(Ty, TyL ! NTLS) = add(Ty, TyL) ! add(Ty, NTLS) . eq add(Ty o Ty' o TS, TLS) = add(Ty, TLS) ! add(Ty' o TS, TLS) . eq add(none, TLS) = nilTSL . eq add(Ty, noneTLS) = Ty . eq add(Ty, TyL) = Ty TyL . op connectedSorts : Module Type -> SortSet . op connectedSorts : Module SortSet Type -> SortSet . eq connectedSorts(M, Ty) = connectedSorts(M, getSorts(M), Ty) . eq connectedSorts(M, S ; SS, Ty) = if sameKind(M, S, Ty) then S else none fi ; connectedSorts(M, SS, Ty) . eq connectedSorts(M, none, Ty) = none . op sortsAffd : SortSet ViewMap -> Bool . op opsAffd : OpDeclSet ViewMap Module -> RenamingSet . op opsAffdAux : OpDeclSet Qid Set Qid AttrSet Module -> RenamingSet . eq sortsAffd((S ; SS), (sort S to S')) = true . eq sortsAffd(SS, (sort S to S')) = false [owise] . eq opsAffd(op F : TyL -> Ty [AtS] . OPDS, op F to F' [AtS'], M) = op F to F' [AtS'] . eq opsAffd(OPDS, op F : TyL -> Ty to F' [AtS], M) = opsAffdAux(OPDS, F, fixKinds(TyL Ty, M), F', AtS, M) . eq opsAffd(OPDS, VMAPS:[RenamingSet], M) = none [owise] . eq opsAffdAux(op F : TyL -> Ty [AtS] . OPDS, F, (TyL' Ty') ! TLS, F', AtS', M) = if sameKind(M, (TyL Ty), (TyL' Ty')) then (op F : TyL' -> Ty' to F' [AtS'], opsAffdAux(OPDS, F, TLS, F', AtS', M)) else (opsAffdAux(OPDS, F, (TyL' Ty') ! TLS, F', AtS', M), opsAffdAux(op F : TyL -> Ty [AtS] . OPDS, F, TLS, F', AtS', M)) fi . eq opsAffdAux(OPDS, F, TLS, F', AtS, M) = none [owise] . *** The predicate \texttt{modAffd} checks whether the module with the *** name given as first argument in the database is affected by the set of maps *** given as second argument. A module is affected by a map set if any of the *** maps is applicable to the module or to any of its submodules. op modAffd : Header RenamingSet Module Database -> Bool . op modAffdAux : Module RenamingSet Module Database -> Bool . op rlsAffd : RuleSet RenamingSet -> Bool . op importsAffd : ImportList RenamingSet Module Database -> Bool . op classesAffd : ClassDeclSet RenamingSet -> Bool . op msgsAffd : MsgDeclSet RenamingSet Module -> RenamingSet . op msgsAffdAux : MsgDeclSet Qid Set Qid Module -> RenamingSet . eq modAffd(ME, VMAPS, M, DB) = modAffdAux(getTopModule(ME, DB), VMAPS, M, DB) . eq modAffdAux(U, VMAPS, M, DB) = sortsAffd(getSorts(U), VMAPS) or-else (opsAffd(getOps(U), VMAPS, M) == none or-else ((not U :: FModule and-then (rlsAffd(getRls(U), VMAPS) or-else (not U :: SModule and-then (classesAffd(getClasses(U), VMAPS) or-else msgsAffd(getMsgs(U), VMAPS, M) == none)))) or-else importsAffd(getImports(U), VMAPS, M, DB))) . eq importsAffd(((including ME .) IL), VMAPS, M, DB) = modAffd(ME, VMAPS, M, DB) or-else importsAffd(IL, VMAPS, M, DB) . eq importsAffd(((extending ME .) IL), VMAPS, M, DB) = modAffd(ME, VMAPS, M, DB) or-else importsAffd(IL, VMAPS, M, DB) . eq importsAffd(((protecting ME .) IL), VMAPS, M, DB) = modAffd(ME, VMAPS, M, DB) or-else importsAffd(IL, VMAPS, M, DB) . eq importsAffd(nil, VMAPS, M, DB) = false . eq rlsAffd(((rl T => T' [label(L) AtS] .) RlS), (label L' to L'')) = (L == L') or-else rlsAffd(RlS, label L' to L'') . eq rlsAffd(((rl T => T' [label(L) AtS] .) RlS), ((label L' to L''), VMAPS)) = (L == L') or-else (rlsAffd((rl T => T' [label(L) AtS] .), VMAPS) or-else rlsAffd(RlS, ((label L' to L''), VMAPS))) . eq rlsAffd(((crl T => T' if T'' = T3 [label(L) AtS] .) RlS), (label L' to L'')) = (L == L') or-else rlsAffd(RlS, (label L' to L'')) . eq rlsAffd(((crl T => T' if T'' = T3 [label(L) AtS] .) RlS), ((label L' to L''), VMAPS)) = (L == L') or-else (rlsAffd((crl T => T' if T'' = T3 [label(L) AtS] .), VMAPS) or-else rlsAffd(RlS, ((label L' to L''), VMAPS))) . eq rlsAffd(RlS, VMAPS) = false [owise] . eq classesAffd(((class C | ADS .) CDS), (class C' to C'')) = (C == C') or-else classesAffd(CDS, (class C' to C'')) . eq classesAffd(((class C | ADS .) CDS), ((class C' to C''), VMAPS)) = (C == C') or-else (classesAffd((class C | ADS .), VMAPS) or-else classesAffd(CDS, ((class C' to C''), VMAPS))) . eq classesAffd(((class C | ((attr A : S), ADS) .) CDS), (attr A' . C' to A'')) = if C == C' then (A == A') or-else classesAffd(((class C | ADS .) CDS), (attr A' . C' to A'')) else classesAffd(CDS, (attr A' . C' to A'')) fi . eq classesAffd(((class C | ((attr A : S), ADS) .) CDS), ((attr A' . C' to A''), VMAPS)) = if C == C' then (A == A') or-else (classesAffd(((class C | ADS .) CDS), ((attr A' . C' to A''), VMAPS)) or-else classesAffd(CDS, VMAPS)) else classesAffd((class C | ((attr A : S), ADS) .), VMAPS) or-else classesAffd(CDS, ((attr A' . C' to A''), VMAPS)) fi . eq classesAffd(CDS, VMAPS) = false [owise] . eq msgsAffd(msg F : TyL -> Ty . MDS, msg F to F', M) = msg F to F' . eq msgsAffd(MDS, msg F : TyL -> Ty to F', M) = msgsAffdAux(MDS, F, fixKinds(TyL Ty, M), F', M) . eq msgsAffd(MDS, VMAPS:[RenamingSet], M) = none [owise] . eq msgsAffdAux(msg F : TyL -> Ty . MDS, F, (TyL' Ty') ! TLS, F', M) = if sameKind(M, (TyL Ty), (TyL' Ty')) then (msg F : TyL' -> Ty' to F', msgsAffdAux(MDS, F, TLS, F', M)) else (msgsAffdAux(MDS, F, (TyL' Ty') ! TLS, F', M), msgsAffdAux(msg F : TyL -> Ty . MDS, F, TLS, F', M)) fi . eq msgsAffdAux(MDS, F, TLS, F', M) = none [owise] . *** The function \texttt{mapsRestrict} returns the subset of the view *** maps given as second argument that affect the given module. op mapsRestrict : Module RenamingSet Module Database -> RenamingSet . op mapsRestrict : Header RenamingSet Module Database -> RenamingSet . eq mapsRestrict(ME, VMAPS, M, DB) = mapsRestrict(getTopModule(ME, DB), VMAPS, M, DB) . eq mapsRestrict(U, VMAP, M, DB) = if modAffdAux(U, VMAP, M, DB) then VMAP else none fi . eq mapsRestrict(U, (VMAP, VMAPS), M, DB) = if modAffdAux(U, VMAP, M, DB) then (VMAP, mapsRestrict(U, VMAPS, M, DB)) else mapsRestrict(U, VMAPS, M, DB) fi . eq mapsRestrict(U, none, M, DB) = none . *** The definition of the function \texttt{header2QidList} on the renaming *** module expression has to take care of transforming into a quoted identifier *** list the set of view maps given in the module expression. op maps2QidList : RenamingSet -> QidList . op attrSet2QidList : AttrSet -> QidList . op hookList2QidList : HookList -> QidList . op termList2QidList : TermList -> QidList . op intList2QidList : IntList -> QidList . op typeList2QidList : TypeList -> QidList . eq maps2QidList(((op F to F' [AtS]), MAPS)) = if AtS == none then ('op F 'to F' '`, '\s maps2QidList(MAPS)) else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`] '`, '\s maps2QidList(MAPS)) fi [owise] . eq maps2QidList((op F to F' [AtS])) = if AtS == none then ('op F 'to F') else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`]) fi . eq maps2QidList(((op F : TyL -> Ty to F' [AtS]), MAPS)) = if AtS == none then ('op F ': typeList2QidList(TyL) '-> Ty 'to F' '`, '\s maps2QidList(MAPS)) else ('op F ': typeList2QidList(TyL) '-> Ty 'to F' '`[ attrSet2QidList(AtS) '`] '`, '\s maps2QidList(MAPS)) fi [owise] . eq maps2QidList((op F : TyL -> Ty to F' [AtS])) = if AtS == none then ('op F ': typeList2QidList(TyL) '-> Ty 'to F') else ('op F ': typeList2QidList(TyL) '-> Ty 'to F' '`[ attrSet2QidList(AtS) '`]) fi . eq maps2QidList(((sort S to S'), MAPS)) = ('sort S 'to S' '`, '\s maps2QidList(MAPS)) [owise] . eq maps2QidList((sort S to S')) = ('sort S 'to S') . eq maps2QidList(((label L to L'), MAPS)) = ('label L 'to L' '`, '\s maps2QidList(MAPS)) [owise] . eq maps2QidList((label L to L')) = ('label L 'to L') . eq maps2QidList(((msg F to F'), MAPS)) = ('msg F 'to F' '`, '\s maps2QidList(MAPS)) [owise] . eq maps2QidList((msg F to F')) = ('msg F 'to F') . eq maps2QidList(((msg F : TyL -> Ty to F'), MAPS)) = ('msg F ': typeList2QidList(TyL) '-> Ty 'to F' '`, '\s maps2QidList(MAPS)) [owise] . eq maps2QidList((msg F : TyL -> Ty to F')) = ('msg F ': typeList2QidList(TyL) '-> Ty 'to F') . eq maps2QidList(((class S to S'), MAPS)) = ('class S 'to S' '`, '\s maps2QidList(MAPS)) [owise] . eq maps2QidList((class S to S')) = ('class S 'to S') . eq maps2QidList(((attr QI . S to QI'), MAPS)) = ('attr S '. QI 'to QI' '`, '\s maps2QidList(MAPS)) [owise] . eq maps2QidList((attr QI . S to QI')) = ('attr S '. QI 'to QI') . eq maps2QidList(none) = nil . eq attrSet2QidList(none) = nil . eq attrSet2QidList((assoc AtS)) = ('assoc attrSet2QidList(AtS)) . eq attrSet2QidList((comm AtS)) = ('comm attrSet2QidList(AtS)) . eq attrSet2QidList((idem AtS)) = ('idem attrSet2QidList(AtS)) . eq attrSet2QidList((iter AtS)) = ('iter attrSet2QidList(AtS)) . eq attrSet2QidList((id(T) AtS)) = ('id: termList2QidList(T) attrSet2QidList(AtS)) . eq attrSet2QidList((right-id(T) AtS)) = ('right-id: termList2QidList(T) attrSet2QidList(AtS)) . eq attrSet2QidList((left-id(T) AtS)) = ('left-id: termList2QidList(T) attrSet2QidList(AtS)) . eq attrSet2QidList((poly(NL) AtS)) = ('poly '`( intList2QidList(NL) '`) attrSet2QidList(AtS)) . eq attrSet2QidList((strat(NL) AtS)) = ('strat '`( intList2QidList(NL) '`) attrSet2QidList(AtS)) . eq attrSet2QidList((memo AtS)) = ('memo attrSet2QidList(AtS)) . eq attrSet2QidList((prec(N) AtS)) = ('prec intList2QidList(N) attrSet2QidList(AtS)) . eq attrSet2QidList((gather(QIL) AtS)) = ('gather QIL attrSet2QidList(AtS)) . eq attrSet2QidList((format(QIL) AtS)) = ('format QIL attrSet2QidList(AtS)) . eq attrSet2QidList((ctor AtS)) = ('ctor attrSet2QidList(AtS)) . eq attrSet2QidList((frozen(NL) AtS)) = ('frozen '`( intList2QidList(NL) '`) attrSet2QidList(AtS)) . eq attrSet2QidList((config AtS)) = ('config attrSet2QidList(AtS)) . eq attrSet2QidList((object AtS)) = ('object attrSet2QidList(AtS)) . eq attrSet2QidList((msg AtS)) = ('msg attrSet2QidList(AtS)) . eq attrSet2QidList((special(HkL) AtS)) = ('special '`( hookList2QidList(HkL) '`) attrSet2QidList(AtS)) . eq attrSet2QidList((none).AttrSet) = nil . eq hookList2QidList((id-hook(QI, QIL) HkL)) = ('id-hook QI '`, '`( QIL '`) hookList2QidList(HkL)) . eq hookList2QidList((op-hook(QI, QI', QIL, QI'') HkL)) = ('op-hook QI '`( QI' ': QIL '-> QI'' '`) hookList2QidList(HkL)) . eq hookList2QidList((term-hook(QI, T) HkL)) = ('term-hook '`( QI '`, termList2QidList(T) '`) hookList2QidList(HkL)) . eq termList2QidList(QI) = QI . eq termList2QidList(F[TL]) = (F '`( termList2QidList(TL) '`)) . ceq termList2QidList((T, TL)) = (termList2QidList(T) '`, termList2QidList(TL)) if TL =/= empty . eq intList2QidList((N NL)) = (qid(string(N, 10)) intList2QidList(NL)) . eq intList2QidList(nil) = nil . eq typeList2QidList(Ty TyL) = Ty typeList2QidList(TyL) . eq typeList2QidList(nil) = nil . *** Let us now give the equations for \texttt{setUpModExpDeps} on the *** renaming module expression. Given a module expression of the form *** \verb~ME *< VMAPS >~ such that \texttt{ME} is in the database, we just need *** to add \verb~ME *< VMAPS >~ to the set of names of the modules depending on *** \texttt{ME}. In this way, if \texttt{ME} is redefined or removed from the *** database, \verb~ME *< VMAPS >~ will be removed as well. eq setUpModExpDeps(ME * (VMAPS), db(< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = db(< ME ; DT ; U ; U' ; M ; VDS ; MNS . ME * (VMAPS) ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . eq setUpModExpDeps(ME * (VMAPS), db(< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL)) = db(< ME ; DM ; U ; U' ; M ; VDS ; MNS . ME * (VMAPS) ; VES > MIS, MNS', VIS, VES', MNS'', MNS3, MNS4, QIL) . ceq setUpModExpDeps(ME * (VMAPS), DB) = warning(DB, '\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n) if not unitInDb(ME, DB) . *** The definition of the \texttt{prepHeader} function on a renaming module *** expression must take into account the possibility of having parameterized *** sorts or parameterized class names in the maps of a renaming module *** expression. The preparation of a renaming module expression must take *** into account this fact and prepare accordingly all parameterized sorts and *** classes appearing in it. op prepare : RenamingSet Set> -> RenamingSet . op prepare : TypeList Set> -> TypeList . eq prepModExp(ME * (VMAPS), VEPS) = _*`(_`)(prepModExp(ME, VEPS), prepare(VMAPS, VEPS)) . *** For example, for sort maps the equation is as follows. eq prepare((sort S to S'), VEPS) = (sort prepSort(S, VEPS) to prepSort(S', VEPS)) . eq prepare(((sort S to S'), VMAPS), VEPS) = ((sort prepSort(S, VEPS) to prepSort(S', VEPS)), prepare(VMAPS, VEPS)) . eq prepare((class S to S'), VEPS) = (class prepSort(S, VEPS) to prepSort(S', VEPS)) . eq prepare(((class S to S'), VMAPS), VEPS) = ((class prepSort(S, VEPS) to prepSort(S', VEPS)), prepare(VMAPS, VEPS)) . eq prepare((attr QI . S to QI'), VEPS) = (attr QI . prepSort(S, VEPS) to QI') . eq prepare(((attr QI . S to QI'), VMAPS), VEPS) = ((attr QI . prepSort(S, VEPS) to QI'), prepare(VMAPS, VEPS)) . eq prepare((op F to F' [AtS]), VEPS) = (op F to F' [AtS]) . eq prepare(((op F to F' [AtS]), VMAPS), VEPS) = ((op F to F' [AtS]), prepare(VMAPS, VEPS)) . eq prepare((op F : TyL -> S to F' [AtS]), VEPS) = (op F : prepare(TyL, VEPS) -> prepSort(S, VEPS) to F' [AtS]) . eq prepare(((op F : TyL -> S to F' [AtS]), VMAPS), VEPS) = (op F : prepare(TyL, VEPS) -> prepSort(S, VEPS) to F' [AtS], prepare(VMAPS, VEPS)) . eq prepare((label L to L'), VEPS) = (label L to L') . eq prepare(((label L to L'), VMAPS), VEPS) = ((label L to L'), prepare(VMAPS, VEPS)) . eq prepare((msg F to F'), VEPS) = (msg F to F') . eq prepare(((msg F to F'), VMAPS), VEPS) = ((msg F to F'), prepare(VMAPS, VEPS)) . eq prepare((msg F : TyL -> S to F'), VEPS) = (msg F : prepare(TyL, VEPS) -> prepSort(S, VEPS) to F') . eq prepare(((msg F : TyL -> S to F'), VMAPS), VEPS) = ((msg F : prepare(TyL, VEPS) -> prepSort(S, VEPS) to F'), prepare(VMAPS, VEPS)) . eq prepare((none).RenamingSet, VEPS) = none . eq prepare((S TyL), VEPS) = (prepSort(S, VEPS) prepare(TyL, VEPS)) . eq prepare(nil, VEPS) = nil . eq header2Qid(ME * (MAPS)) = qid(string(header2Qid(ME)) + " * (" + string(qidList2Qid(maps2QidList(MAPS))) + ")") [owise] . ceq header2QidList(ME * (MAPS)) = (if QI == '\s then QIL QI else QIL QI '\s fi '* '\s '`( maps2QidList(MAPS) '`)) if QIL QI := header2QidList(ME) [owise] . endfm ******************************************************************************* *** *** The Union Module Expression *** *** The syntax used for the union of module expressions is *** op _+_ : ModuleExpression ModuleExpression -> ModuleExpression *** [assoc prec 42] . *** Its evaluation consists in generating a unit importing the two module *** expressions given as arguments~\cite{Winkler91,OBJ92}. *** As we explained in Sections~\ref{instantiation} and~\ref{renaming} for the *** cases of the instantiation and the renaming module expressions, *** respectively, the declaration of any new kind of module expression must *** come together with the definition of the functions \texttt{evalModExp}, *** \texttt{header2QidList}, and \texttt{setUpModExpDeps} on the new *** module operator. As discussed in Sections~\ref{instantiation} *** and~\ref{parsing-unit-declarations}, equations for the \texttt{prepHeader} *** and \texttt{parseModExp} functions have to be given as well. fmod UNION-EXPR is inc MOD-EXPR . pr INST-EXPR-EVALUATION . pr RENAMING-EXPR-EVALUATION . pr EVALUATION . vars QI X : Qid . var PDL : ParameterDeclList . vars DB DB' : Database . vars T T' : Term . vars DT DT' : Default{Term} . var IL : ImportList . var VEPS : Set> . vars ME ME' ME'' ME3 : ModuleExpression . vars PU PU' U U' U'' U3 DM DM' : Module . vars M M' M'' M3 : Module . vars MNS MNS' MNS'' MNS3 MNS4 MNS5 : Set{ModuleName} . vars VES VES' VES'' : Set{ViewExp} . vars PDS PDS' PDS'' : Set{ParameterDecl} . vars MIS MIS' : Set{ModuleInfo} . var VIS : Set{ViewInfo} . vars QIL QIL' : QidList . var VDS VDS' : OpDeclSet . var B : Bool . var MAPS : RenamingSet . *** As mentioned above, the evaluation of a union module expression consists *** in the creation of a new unit, with such a module expression as name, *** which imports the two module expressions being united. Note, however, *** that the unit being created has to be of the right type. The new unit *** will be generated having one type or another, depending on the types of *** the arguments of the union module expression. *** The function \texttt{rightEmptyModule} generates an empty unit of the *** lowest of the sorts of its two arguments. In case of having a nonstructured *** module as argument, the corresponding structured one is considered. If one *** of the two module expressions corresponds to a theory, then a theory is *** generated, and the lowest sort is taken between the sort of such a theory *** and the \texttt{Module} sort immediately above the sort of the other unit; *** that is, sorts \texttt{FModule}, \texttt{SModule}, or \texttt{OModule} are *** considered to do the comparison. ceq evalModExp(ME + ME', PDL, DB) = if unitInDb(ME'' + ME3, DB) then < DB ; ME'' + ME3 > else < evalModule( addImports(protecting ME'' . protecting ME3 ., setName( rightEmptyModule( getTopModule(ME'', DB'), getTopModule(ME3, DB')), ME'' + ME3)), none, DB') ; ME'' + ME3 > fi if ME'' := modExp(evalModExp(ME, PDL, database(evalModExp(ME', PDL, DB)))) /\ ME3 := modExp(evalModExp(ME', PDL, DB)) /\ DB' := database(evalModExp(ME, PDL, database(evalModExp(ME', PDL, DB)))) . op rightEmptyModule : Module Module -> Module [comm] . eq rightEmptyModule(U1:FModule, U2:FModule) = emptyFModule . eq rightEmptyModule(U1:FModule, U2:FTheory) = emptyFTheory . eq rightEmptyModule(U1:FTheory, U2:FModule) = emptyFTheory . eq rightEmptyModule(U1:FTheory, U2:FTheory) = emptyFTheory . eq rightEmptyModule(U1:SModule, U2:SModule) = emptySModule [owise] . eq rightEmptyModule(U1:STheory, U2:SModule) = emptySTheory [owise] . eq rightEmptyModule(U1:SModule, U2:STheory) = emptySTheory [owise] . eq rightEmptyModule(U1:STheory, U2:STheory) = emptySTheory [owise] . eq rightEmptyModule(U1:OModule, U2:OModule) = emptyOModule [owise] . eq rightEmptyModule(U1:OTheory, U2:OModule) = emptyOTheory [owise] . eq rightEmptyModule(U1:OModule, U2:OTheory) = emptyOTheory [owise] . eq rightEmptyModule(U1:OTheory, U2:OTheory) = emptyOTheory [owise] . eq rightEmptyModule(unitError(QIL), U) = unitError(QIL) . eq rightEmptyModule(U, unitError(QIL)) = unitError(QIL) . eq rightEmptyModule(unitError(QIL), unitError(QIL')) = unitError(QIL QIL') . *** As pointed out in Section~\ref{module-names}, for each new module *** expression operator being introduced, we need to add equations for the *** \texttt{header2Qid} function. For the union module expression we only *** need the following equation: eq header2Qid(ME + ME') = qidList2Qid(header2QidList(ME) '+ header2QidList(ME')) . eq header2Qid(_*`(_`)(ME + ME', MAPS)) = qid("(" + string(header2Qid(ME + ME')) + ")" + " * (" + string(qidList2Qid(maps2QidList(MAPS))) + ")") . eq header2QidList(ME + ME') = (header2QidList(ME) '+ header2QidList(ME')) . ceq header2QidList(_*`(_`)(ME + ME', MAPS)) = (if QI == '\s then '`( QIL '`) QI else '`( QIL QI '`) '\s fi '* '\s '`( maps2QidList(MAPS) '`)) if QIL QI := header2QidList(ME + ME') . *** Given a module *** expression of the form \verb~ME + ME'~ such that \texttt{ME} and *** \texttt{ME'} are in the database, we need to add \verb~ME + ME'~ to *** the set of names of the modules depending on \texttt{ME} and \texttt{ME'}. *** In this way, if \texttt{ME} or \texttt{ME'} are redefined or removed from *** the database, \verb~ME + ME'~ will be removed as well. eq setUpModExpDeps((ME + ME'), db((< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > < ME' ; DT' ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS), MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL)) = db((< ME ; DT ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES > < ME' ; DT' ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' > MIS), MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) . eq setUpModExpDeps((ME + ME'), db((< ME ; DT ; U ; U' ; M ; VDS ; MNS ; VES > < ME' ; DM ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS), MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL)) = db((< ME ; DT ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES > < ME' ; DM ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' > MIS), MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) . eq setUpModExpDeps((ME + ME'), db((< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > < ME' ; DT ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS), MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL)) = db((< ME ; DM ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES > < ME' ; DT ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' > MIS), MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) . eq setUpModExpDeps((ME + ME'), db((< ME ; DM ; U ; U' ; M ; VDS ; MNS ; VES > < ME' ; DM' ; U'' ; U3 ; M' ; VDS' ; MNS' ; VES' > MIS), MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL)) = db((< ME ; DM ; U ; U' ; M ; VDS ; MNS . (ME + ME') ; VES > < ME' ; DM' ; U'' ; U3 ; M' ; VDS' ; MNS' . (ME + ME') ; VES' > MIS), MNS'', VIS, VES'', MNS3, MNS4, MNS5, QIL) . ceq setUpModExpDeps((ME + ME'), DB) = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME) 'not 'in 'database. '\n)) if not unitInDb(ME, DB) . ceq setUpModExpDeps((ME + ME'), DB) = warning(DB, ('\r 'Error: '\o 'Module header2QidList(ME') 'not 'in 'database. '\n)) if not unitInDb(ME', DB) . *** The \texttt{prepHeader} function on a union module expression makes *** recursive calls with each of the module expressions given as arguments. eq prepModExp(ME + ME', VEPS) = prepModExp(ME, VEPS) + prepModExp(ME', VEPS) . *** Finally, the equation for the \texttt{parseModExp} function is as follows: eq labelInModExp(X, ME + ME') = labelInModExp(X, ME) or-else labelInModExp(X, ME') . endfm ******************************************************************************* *** *** The $n$-tuple Module Expression *** *** The syntax used for the $n$-tuple module expression is as follows: *** op TUPLE[_] : Token -> ModuleExpression . *** Its evaluation consists in the generation of a parameterized functional *** module with the number of \texttt{TRIV} parameters specified by the *** argument. A sort for tuples of such size, and the corresponding constructor *** and selector operators, are also defined. Note that the \texttt{TRIV} *** theory is predefined in Full Maude (see Sections~\ref{main-module} *** and~\ref{non-built-in-predefined}). For example, the module expression *** \verb~TUPLE[3]~ produces the following module. *** fmod TUPLE[3][C1 :: TRIV, C2 :: TRIV, C3 :: TRIV] is *** sorts 3Tuple . *** op (_,_,_) : Elt.C1 Elt.C2 Elt.C3 -> 3Tuple . *** op p1_ : 3Tuple -> Elt.C1 . *** op p2_ : 3Tuple -> Elt.C2 . *** op p3_ : 3Tuple -> Elt.C3 . *** var E1 : Elt.C1 . *** var E2 : Elt.C2 . *** var E3 : Elt.C3 . *** eq p1(E1, E2, E3) = E1 . *** eq p2(E1, E2, E3) = E2 . *** eq p3(E1, E2, E3) = E3 . *** endfm *** Even though the $n$-tuple module expression is in principle of a completely *** different nature, the way of handling it is the same as the way of handling *** any other module expression. Its evaluation produces a new unit, a *** parameterized functional module in this case, wtupleParList(N)ith the module expression as *** name. New equations defining the semantics of functions *** \texttt{evalModExp}, \texttt{header2QidList}, *** \texttt{setUpModExpDeps}, \texttt{prepHeader}, and *** \texttt{parseModExp} are given for this module expression. fmod N-TUPLE-EXPR is inc MOD-EXPR . pr INST-EXPR-EVALUATION . pr EVALUATION . vars N N' : NzNat . var PDL : ParameterDeclList . var DB : Database . var T : Term . var IL : ImportList . var VEPS : Set> . var X : Qid . var S : Sort . *** The equation for the \texttt{evalModExp} is reduced to the creation of a *** module as indicated above. Some auxiliary functions are defined in order *** to generate the different declarations in the module. op tupleParList : NzNat -> ParameterDeclList . op tupleImportList : NzNat -> ImportList . op createCopyPars : NzNat Database -> Database . op tupleOps : NzNat -> OpDeclSet . op tupleOpsCtor : NzNat -> OpDecl . op tupleOpsCtorName : NzNat -> String . op tupleOpsCtorArity : NzNat -> QidList . op tupleOpsSelectors : NzNat NzNat -> OpDeclSet . op tupleEqSet : NzNat -> EquationSet . op tupleEqSetAux : NzNat Term -> EquationSet . op tupleTermArgs : NzNat -> TermList . ops tupleSort tupleSortAux : NzNat -> Sort . eq evalModExp(TUPLE[N], PDL, DB) = if unitInDb(TUPLE[N], DB) then < DB ; TUPLE[N] > else < evalModule( fmod TUPLE[N]{tupleParList(N)} is nil ---- tupleImportList(N) sorts tupleSort(N) . none tupleOps(N) none tupleEqSet(N) endfm, none, createCopyPars(N, DB)) ; TUPLE[N] > fi . eq createCopyPars(N, DB) = if N == 1 then createCopy((qid("C" + string(N, 10)) :: 'TRIV), DB) else createCopyPars(_-_(N, 1), createCopy((qid("C" + string(N, 10)) :: 'TRIV), DB)) fi . eq tupleParList(N) = if N == 1 then (qid("C" + string(N, 10)) :: 'TRIV) else (tupleParList(_-_(N, 1)), (qid("C" + string(N, 10)) :: 'TRIV)) fi . eq tupleImportList(N) = if N == 1 then (protecting pd(qid("C" + string(N, 10)) :: 'TRIV) .) else (tupleImportList(_-_(N, 1)) (protecting pd(qid("C" + string(N, 10)) :: 'TRIV) .)) fi . eq tupleSort(N) = makeSort('Tuple, tupleSortAux(N)) . eq tupleSortAux(N) = if N == 1 then qid("C" + string(N, 10)) else (tupleSortAux(_-_(N, 1)), qid("C" + string(N, 10))) fi . eq tupleOps(N) = (tupleOpsCtor(N) tupleOpsSelectors(N, N)) . eq tupleOpsCtor(N) = (op qid("(" + tupleOpsCtorName(N) + ")") : tupleOpsCtorArity(N) -> tupleSort(N) [none] .) . eq tupleOpsCtorName(N) = if N == 1 then "_" else "_," + tupleOpsCtorName(_-_(N, 1)) fi . eq tupleOpsCtorArity(N) = if N == 1 then qid("C" + string(N, 10) + "$Elt") else tupleOpsCtorArity(_-_(N, 1)) qid("C" + string(N, 10) + "$Elt") fi . eq tupleOpsSelectors(N, N') = if N == 1 then (op qid("p" + string(N, 10) + "_") : tupleSort(N') -> qid("C" + string(N, 10) + "$Elt") [none] .) else (tupleOpsSelectors(_-_(N, 1), N') (op qid("p" + string(N, 10) + "_") : tupleSort(N') -> qid("C" + string(N, 10) + "$Elt") [none] .)) fi . eq tupleEqSet(N) = tupleEqSetAux(N, (qid("(" + tupleOpsCtorName(N) + ")") [ tupleTermArgs(N) ])) . eq tupleTermArgs(N) = if N == 1 then qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt") else (tupleTermArgs(_-_(N, 1)), qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt")) fi . eq tupleEqSetAux(N, T) = if N == 1 then (eq qid("p" + string(N, 10) + "_")[T] = qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt") [none] .) else (tupleEqSetAux(_-_(N, 1), T) (eq qid("p" + string(N, 10) + "_")[T] = qid("V" + string(N, 10) + ":C" + string(N, 10) + "$Elt") [none] .)) fi . *** The equations for the \texttt{header2QidList}, *** \texttt{parseModExp}, \texttt{prepHeader}, and *** \texttt{setUpModExpDeps} functions on the $n$-tuple module *** expression are as follows: eq header2Qid(TUPLE[N]) = qid("TUPLE[" + string(N, 10) + "]") . eq header2QidList(TUPLE[N]) = ('TUPLE '`[ qid(string(N, 10)) '`]) . eq prepModExp(TUPLE[N], VEPS) = TUPLE[N] . eq setUpModExpDeps(TUPLE[N], DB) = DB . endfm ******************************************************************************* *** *** 8 Input/Output Processing *** *** In this section we discuss how the preterm resulting from the call to the *** function \texttt{metaParse} with the input and the top-level signature of *** Full Maude is transformed into a term of sort \texttt{Module}, representing *** a preunit or a term of sort \texttt{PreView}. In the case of commands, *** they are evaluated giving the corresponding results in the appropriate *** form. *** *** 8.1 Input Parsing *** *** Let us recall here the example presented in Section~\ref{bubbles}. Calling *** \texttt{metaParse} with the module \texttt{NAT3} given there and the *** signature of Full Maude presented in Section~\ref{sec:signature}, we *** obtain the following term. *** 'fmod_is_endfm[ *** 'token[{''NAT3}'Qid], *** '__['sort_.['token[{''Nat3}'Qid]], *** '__['op_:_->_.['token[{''s_}'Qid], *** 'neTokenList[{''Nat3}'Qid], *** 'token[{''Nat3}'Qid]], *** '__['op_:`->_.['token[{''0}'Qid], *** 'token[{''Nat3}'Qid]], *** 'eq_=_.['bubble['__[{''s}'Qid, {''s}'Qid, *** {''s}'Qid, {''0}'Qid]], *** 'bubble[{''0}'Qid]]]]]] *** Given each one of the subterms representing declarations in terms *** representing modules as the previous one, the function \texttt{parseDecl} *** generates the corresponding declaration, with no bubbles in it, and the *** corresponding predeclaration, with the bubbles appearing in the term. For *** example, for the term *** *** 'op_:_->_.['token[{''s_}'Qid], *** 'neTokenList[{''Nat3}'Qid], *** 'token[{''Nat3}'Qid]] *** *** the following operator declaration is generated: *** *** op 's_ : 'Nat3 -> 'Nat3 [none] . *** *** Note that in this case, since the operator is declared without identity *** element (the only place a bubble might appear), the declaration and the *** predeclaration generated by \texttt{parseDecl} coincide. *** In the following sections we shall see how this approach is followed for *** declarations appearing in units and in views. *** *** 8.1.1 Parsing of Module Declarations *** *** The \texttt{parseDecl} function takes a term (which corresponds to a *** declaration to be parsed), a preunit (to which the parsed declaration with *** its bubbles in it will be added), and a unit (to which the parsed *** declaration without bubbles will be added to build up the signature). For *** example, a term corresponding to an unconditional equation, that is, a term *** of the form \verb~'eq_=_.[T, T']~ will be added to the set of equations of *** the preunit as \verb~eq T = T' .~, but nothing will be added to the unit. *** Note that according to the signature used in the call to *** \texttt{metaParse} (see Sections~\ref{sec:signature} *** and~\ref{main-module}), \texttt{T} and \texttt{T'} are bubbles. *** Declarations of sorts, subsort relations, operators, classes, subclass *** relations, messages, and variables will be added to both of them. In the *** case of operator declarations, identity element attributes, which in *** general can be terms, are not included in the added declaration. *** As in Core Maude, declarations in a module can be given in any order, and *** therefore we follow a two-step approach consisting in first building the *** signature to parse the bubbles, and then generating the unit without *** bubbles in it. It could be different for other languages. For example, in *** some languages we may be able to assume that each operator and sort has *** been defined before being used, allowing then an incremental processing of *** the input. fmod 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 : Module . vars T T' : Term . vars QI QI' L F : Qid . vars QIL QIL' : QidList . vars S S' : Sort . vars SS SS' : Set . vars TyL TyL' : TypeList . var TSL : List> . var AtS : AttrSet . vars T'' T3 T4 : Term . var TL : TermList . var Ct : Constant . var VDS : OpDeclSet . vars Ty Tp : Type . var N : Nat . *** Similarly, auxiliary functions parsing other elements in units *** are defined. op parsePreAttrs : Term Nat -> AttrSet . op parsePreHookList : Term -> HookList . op parseVars : QidList [Type] -> OpDeclSet . op parseSubsortRel : Term -> Set . op parseAttrDeclList : Term -> AttrDeclSet . op unfoldOpDecl : QidList TypeList Sort AttrSet -> OpDeclSet . op unfoldMultipleMsgDecl : QidList TypeList Sort -> MsgDeclSet . op unfoldSubsortRel : List> ~> SubsortDeclSet . op unfoldSubclassRel : List> ~> SubclassDeclSet . eq parseSubsortRel('_<_[T, T']) = _l_(parseSortSet(T), parseSubsortRel(T')) . eq parseSubsortRel('__[T, T']) = parseSortSet('__[T, T']) . eq parseSubsortRel('sortToken[T]) = downQid(T) . eq parseSubsortRel('_`{_`}['sortToken[T], T']) = makeSort(downQid(T), parseParameterList(T')) . eq parseSubsortRel('_`{_`}['_`{_`}[T, T'], T'']) = makeSort(parseSubsortRel('_`{_`}[T, T']), parseParameterList(T'')) . eq unfoldOpDecl((QI QIL), TyL, Ty, AtS) = ((op QI : TyL -> Ty [AtS] .) unfoldOpDecl(QIL, TyL, Ty, AtS)) . eq unfoldOpDecl(nil, TyL, Ty, AtS) = none . eq unfoldMultipleMsgDecl((QI QIL), TyL, Ty) = ((msg QI : TyL -> Ty .) unfoldMultipleMsgDecl(QIL, TyL, Ty)) . eq unfoldMultipleMsgDecl(nil, TyL, Ty) = none . eq unfoldSubsortRel(_l_((S ; SS), (S' ; SS'), TSL)) = ((subsort S < S' .) unfoldSubsortRel(_l_(S, SS')) unfoldSubsortRel(_l_(SS, (S' ; SS'))) unfoldSubsortRel(_l_((S' ; SS'), TSL))) . eq unfoldSubsortRel(_l_(SS, none)) = none . eq unfoldSubsortRel(_l_(none, SS)) = none . eq unfoldSubsortRel(SS) = none . eq unfoldSubsortRel(qidError(QIL)) = subsortDeclError(QIL) . eq unfoldSubclassRel(_l_((S ; SS), (S' ; SS'), TSL)) = ((subclass S < S' .) unfoldSubclassRel(_l_(S, SS')) unfoldSubclassRel(_l_(SS, (S' ; SS'))) unfoldSubclassRel(_l_((S' ; SS'), TSL))) . eq unfoldSubclassRel(_l_(SS, none)) = none . eq unfoldSubclassRel(_l_(none, SS)) = none . eq unfoldSubclassRel(SS) = none . eq unfoldSubclassRel(qidError(QIL)) = subclassDeclError(QIL) . eq parseVars((QI QIL), Tp) = ((op QI : nil -> Tp [none] .) parseVars(QIL, Tp)) . eq parseVars(nil, Tp) = none . eq parseVars(QIL, qidError(QIL')) = opDeclError(QIL') . eq parsePreAttrs('__[T, T'], N) = (parsePreAttrs(T, N) parsePreAttrs(T', N)) . eq parsePreAttrs('assoc.@Attr@, N) = assoc . eq parsePreAttrs('associative.@Attr@, N) = assoc . eq parsePreAttrs('comm.@Attr@, N) = comm . eq parsePreAttrs('commutative.@Attr@, N) = comm . eq parsePreAttrs('idem.@Attr@, N) = idem . eq parsePreAttrs('idempotent.@Attr@, N) = idem . eq parsePreAttrs('id:_[T], N) = id(T) . eq parsePreAttrs('identity:_[T], N) = id(T) . eq parsePreAttrs('left`id:_[T], N) = left-id(T) . eq parsePreAttrs('left`identity:_[T], N) = left-id(T) . eq parsePreAttrs('right`id:_[T], N) = right-id(T) . eq parsePreAttrs('right`identity:_[T], N) = right-id(T) . eq parsePreAttrs('poly`(_`)[T], N) = poly(parseInt(T)) . eq parsePreAttrs('strat`(_`)[T], N) = strat(parseInt(T)) . eq parsePreAttrs('strategy`(_`)[T], N) = strat(parseInt(T)) . eq parsePreAttrs('frozen.@Attr@, N) = if N == 0 then none else frozen(from 1 to N list) fi . eq parsePreAttrs('frozen`(_`)[T], N) = frozen(parseInt(T)) . eq parsePreAttrs('memo.@Attr@, N) = memo . eq parsePreAttrs('memoization.@Attr@, N) = memo . eq parsePreAttrs('ctor.@Attr@, N) = ctor . eq parsePreAttrs('constructor.@Attr@, N) = ctor . eq parsePreAttrs('prec_['token[T]], N) = prec(parseNat(T)) . eq parsePreAttrs('gather`(_`)['neTokenList[T]], N) = gather(downQidList(T)) . eq parsePreAttrs('special`(_`)[T], N) = special(parsePreHookList(T)) . eq parsePreAttrs('format`(_`)['neTokenList[T]], N) = format(downQidList(T)) . eq parsePreAttrs('iter.@Attr@, N) = iter . eq parsePreAttrs('ditto.@Attr@, N) = ditto . eq parsePreAttrs('config.@Attr@, N) = config . eq parsePreAttrs('object.@Attr@, N) = object . eq parsePreAttrs('msg.@Attr@, N) = msg . eq parsePreAttrs('message.@Attr@, N) = msg . eq parsePreHookList('__[T, TL]) = parsePreHookList(T) parsePreHookList(TL) . eq parsePreHookList('id-hook_['token[T]]) = id-hook(downQid(T), nil) . eq parsePreHookList('id-hook_`(_`)['token[T], 'neTokenList[T']]) = id-hook(downQid(T), downQidList(T')) . eq parsePreHookList( 'op-hook_`(_:_->_`)[ 'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]]) = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) . eq parsePreHookList('op-hook_`(_:`->_`)['token[T], 'token[T'], 'token[T'']]) = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) . eq parsePreHookList( 'op-hook_`(_:_~>_`)[ 'token[T], 'token[T'], 'neTokenList[T''], 'token[T3]]) = op-hook(downQid(T), downQid(T'), downTypes(T''), downQid(T3)) . eq parsePreHookList('op-hook_`(_:`~>_`)['token[T], 'token[T'], 'token[T'']]) = op-hook(downQid(T), downQid(T'), nil, downQid(T'')) . eq parsePreHookList('term-hook_`(_`)['token[T], T']) = term-hook(downQid(T), T') . eq parseAttrDeclList('_`,_[T, T']) = (parseAttrDeclList(T), parseAttrDeclList(T')) . eq parseAttrDeclList('_:_['token[T], T']) = (attr downQid(T) : parseType(T')) . *** Given a term representing a declaration or a predeclaration, the function *** \texttt{parseDecl} must generate and update both the unit and the preunit *** that it takes as arguments. Note that in the case of rules, for example, *** only a prerule is generated. *** Since the preunit and the unit may be modified, they have to be returned as *** a pair, which will be used to extract the corresponding arguments for the *** following calls. Note that the \texttt{parseDecl} functions are in fact *** partial functions. Each parsing function assumes that it is possible to *** parse the given term. sort ParseDeclResult . op <_;_;_> : Module Module OpDeclSet -> ParseDeclResult . op preModule : ParseDeclResult -> Module . op unit : ParseDeclResult -> Module . op vars : ParseDeclResult -> OpDeclSet . eq preModule(< PU ; U ; VDS >) = PU . eq preModule(< unitError(QIL) ; V:[Module] ; V:[OpDeclSet] >) = unitError(QIL) . eq preModule(< V:[Module] ; unitError(QIL) ; V:[OpDeclSet] >) = unitError(QIL) . eq preModule(< V:[Module] ; V':[Module] ; opDeclError(QIL) >) = unitError(QIL) . eq unit(< PU ; U ; VDS >) = U . eq unit(< unitError(QIL) ; V':[Module] ; V:[OpDeclSet] >) = unitError(QIL) . eq unit(< V:[Module] ; unitError(QIL) ; V:[OpDeclSet] >) = unitError(QIL) . eq unit(< V:[Module] ; V':[Module] ; opDeclError(QIL) >) = unitError(QIL) . eq vars(< PU ; U ; VDS >) = VDS . eq vars(< unitError(QIL) ; V:[Module] ; V:[OpDeclSet] >) = opDeclError(QIL) . eq vars(< V:[Module] ; unitError(QIL) ; V:[OpDeclSet] >) = opDeclError(QIL) . eq vars(< V:[Module] ; V':[Module] ; opDeclError(QIL) >) = opDeclError(QIL) . op parseDecl : Term Module Module OpDeclSet -> ParseDeclResult . *** changed 03/27/02 *** In the case of importation declarations, since internally only the *** \texttt{including} mode is handled, all importations are generated in *** this mode, independently of the keyword used in the input. eq parseDecl('inc_.[T], PU, U, VDS) = parseDecl('including_.[T], PU, U, VDS) . eq parseDecl('ex_.[T], PU, U, VDS) = parseDecl('extending_.[T], PU, U, VDS) . eq parseDecl('pr_.[T], PU, U, VDS) = parseDecl('protecting_.[T], PU, U, VDS) . eq parseDecl('including_.[T], PU, U, VDS) = < addImports((including parseModExp(T) .), PU) ; U ; VDS > . eq parseDecl('extending_.[T], PU, U, VDS) = < addImports((extending parseModExp(T) .), PU) ; U ; VDS > . eq parseDecl('protecting_.[T], PU, U, VDS) = < addImports((protecting parseModExp(T) .), PU) ; U ; VDS > . eq parseDecl('sort_.[T], PU, U, VDS) = parseDecl('sorts_.[T], PU, U, VDS) . eq parseDecl('sorts_.[T], PU, U, VDS) = < addSorts(parseSortSet(T), PU) ; addSorts(parseSortSet(T), U) ; VDS > . eq parseDecl('subsort_.[T], PU, U, VDS) = parseDecl('subsorts_.[T], PU, U, VDS) . eq parseDecl('subsorts_.[T], PU, U, VDS) = < addSubsorts(unfoldSubsortRel(parseSubsortRel(T)), PU) ; addSubsorts(unfoldSubsortRel(parseSubsortRel(T)), U) ; VDS > . *** As pointed out in Section~\ref{SyntacticalRequirementsAndCaveats}, the *** name of operators in operator declaration has to be given as a single *** token identifier (see Section~\ref{order-sorted}). We assume that when *** declaring a multitoken operator, its name is given as a single quoted *** identifier in which each token is preceded by a backquote. Thus, the name *** of an operator \verb~_(_)~, for example, is given as \verb~_`(_`)~. eq parseDecl('op_:`->_.['token[T], T'], PU, U, VDS) = < addOps((op downQid(T) : nil -> parseType(T') [none] .), PU) ; addOps((op downQid(T) : nil -> parseType(T') [none] .), U) ; VDS > . eq parseDecl('op_:`->_`[_`].['token[T], T', T''], PU, U, VDS) = < addOps( (op downQid(T) : nil -> parseType(T') [parsePreAttrs(T'', 0)] .), PU) ; addOps( (op downQid(T) : nil -> parseType(T') [parseAttrs(T'')] .), U) ; VDS > . eq parseDecl('op_:_->_.['token[T], T', T''], PU, U, VDS) = < addOps( (op downQid(T) : parseTypeList(T') -> parseType(T'') [none] .), PU) ; addOps( (op downQid(T) : parseTypeList(T') -> parseType(T'') [none] .), U) ; VDS > . eq parseDecl('op_:_->_`[_`].['token[T], T', T'', T3], PU, U, VDS) = < addOps( (op downQid(T) : parseTypeList(T') -> parseType(T'') [parsePreAttrs(T3, size(parseTypeList(T')))] .), PU) ; addOps( (op downQid(T) : parseTypeList(T') -> parseType(T'') [parseAttrs(T3)] .), U) ; VDS > . ceq parseDecl('op_:`->_.[F[TL], T], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . ceq parseDecl('op_:`->_`[_`].[F[TL], T, T'], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . ceq parseDecl('op_:_->_.[F[TL], T, T'], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . ceq parseDecl('op_:_->_`[_`].[F[TL], T, T', T''], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . eq parseDecl('ops_:`->_.['neTokenList[T], T'], PU, U, VDS) = < addOps( unfoldOpDecl(downTypes(T), nil, parseType(T'), none), PU) ; addOps( unfoldOpDecl(downTypes(T), nil, parseType(T'), none), U) ; VDS > . eq parseDecl('ops_:`->_`[_`].['neTokenList[T], T', T''], PU, U, VDS) = < addOps( unfoldOpDecl(downTypes(T), nil, parseType(T'), parsePreAttrs(T'', 0)), PU) ; addOps( unfoldOpDecl(downTypes(T), nil, parseType(T'), parseAttrs(T'')), U) ; VDS > . eq parseDecl('ops_:_->_.['neTokenList[T], T', T''], PU, U, VDS) = < addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''), none), PU) ; addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''), none), U) ; VDS > . eq parseDecl('ops_:_->_`[_`].['neTokenList[T], T', T'', T3], PU, U, VDS) = < addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''), parsePreAttrs(T3, size(parseTypeList(T')))), PU) ; addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''), parseAttrs(T3)), U) ; VDS > . eq parseDecl('op_:`~>_.['token[T], T'], PU, U, VDS) = < addOps((op downQid(T) : nil -> kind(parseType(T')) [none] .), PU) ; addOps((op downQid(T) : nil -> kind(parseType(T')) [none] .), U) ; VDS > . eq parseDecl('op_:`~>_`[_`].['token[T], T', T''], PU, U, VDS) = < addOps((op downQid(T) : nil -> kind(parseType(T')) [parsePreAttrs(T'', 0)] .), PU) ; addOps((op downQid(T) : nil -> kind(parseType(T')) [parseAttrs(T'')] .), U) ; VDS > . eq parseDecl('op_:_~>_.['token[T], T', T''], PU, U, VDS) = < addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) [none] .), PU) ; addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) [none] .), U) ; VDS > . eq parseDecl('op_:_~>_`[_`].['token[T], T', T'', T3], PU, U, VDS) = < addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) [parsePreAttrs(T3, size(parseTypeList(T')))] .), PU) ; addOps((op downQid(T) : kind(parseTypeList(T')) -> kind(parseType(T'')) [parseAttrs(T3)] .), U) ; VDS > . ceq parseDecl('op_:`~>_.[F[TL], T], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . ceq parseDecl('op_:`~>_`[_`].[F[TL], T, T'], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . ceq parseDecl('op_:_~>_.[F[TL], T, T'], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . ceq parseDecl('op_:_~>_`[_`].[F[TL], T, T', T''], PU, U, VDS) = < PU ; U ; VDS > if F =/= 'token . eq parseDecl('ops_:`~>_.['neTokenList[T], T'], PU, U, VDS) = < addOps( unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), none), PU) ; addOps( unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), none), U) ; VDS > . eq parseDecl('ops_:`~>_`[_`].['neTokenList[T], T', T''], PU, U, VDS) = < addOps( unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), parsePreAttrs(T'', 0)), PU) ; addOps( unfoldOpDecl(downTypes(T), nil, kind(parseType(T')), parseAttrs(T'')), U) ; VDS > . eq parseDecl('ops_:_~>_.['neTokenList[T], T', T''], PU, U, VDS) = < addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), kind(parseType(T'')), none), PU) ; addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), kind(parseType(T'')), none), U) ; VDS > . eq parseDecl('ops_:_~>_`[_`].['neTokenList[T], T', T'', T3], PU, U, VDS) = < addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''), parsePreAttrs(T3, size(parseTypeList(T')))), PU) ; addOps( unfoldOpDecl(downTypes(T), parseTypeList(T'), parseType(T''), parseAttrs(T3)), U) ; VDS > . eq parseDecl('var_:_.['neTokenList[T], T'], PU, U, VDS) = parseDecl('vars_:_.['neTokenList[T], T'], PU, U, VDS) . eq parseDecl('vars_:_.['neTokenList[T], T'], PU, U, VDS) = < PU ; U ; VDS parseVars(downQidList(T), parseType(T')) > . eq parseDecl('mb_:_.[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 OPDS : OpDeclSet . var MDS : MsgDeclSet . var M : Module . vars F F' : Qid . vars S S' : Sort . vars TyL TyL' : TypeList . vars T'' T3 : Term . var PV : PreView . var OPD : OpDecl . var OPDS' : OpDeclSet . var AtS : AttrSet . var MD : MsgDecl . var MDS' : MsgDeclSet . var VDS : OpDeclSet . *** Operator and message name maps of the form \verb~F to F'~ are substituted *** by an equivalent set of maps of the form \verb~F : TyL -> S to F'~. One *** of these maps is added for each family of subsort-overloaded operators in *** the source theory of the view. *** The following functions \texttt{genOpMaps} and \texttt{genMsgMaps} *** take, respectively, an operator and a message map of the form *** \verb~F to F'~, a set of operator or message declarations, and a term of *** sort \texttt{Module}, and return, respectively, a set of operator maps and *** a set of message maps, with each of the members of those sTS having the *** general form \verb~F : TyL -> S to F'~. One of these maps is generated *** for each family of subsort-overloaded operators or messages with name *** \texttt{F} in the module given as argument. op genOpMaps : Renaming OpDeclSet Module -> RenamingSet . op genMsgMaps : Renaming MsgDeclSet Module -> RenamingSet . op genOpMapsAux : OpDeclSet Qid -> RenamingSet . op genMsgMapsAux : MsgDeclSet Qid -> RenamingSet . op getOpDeclSet : Qid Module -> OpDeclSet . op getOpDeclSetAux : Qid OpDeclSet -> OpDeclSet . *** getOpDeclSet(F, U) returns the set of declarations of operators with *** name F in the unit U op getMsgDeclSet : Qid Module -> MsgDeclSet . op getMsgDeclSetAux : Qid MsgDeclSet -> MsgDeclSet . *** getMsgDeclSet(F, U) returns the set of declarations of messages with *** name F in the unit U op gTSubsortOverloadedFamilies : OpDeclSet OpDeclSet Module -> OpDeclSet . op gTSubsortOverloadedFamilies : MsgDeclSet MsgDeclSet Module -> MsgDeclSet . *** gTSubsortOverloadedFamilies returns a declaration of operator or *** message for each family of subsort-overloaded operators or messages. op selectOpDeclSet : Qid OpDeclSet -> OpDeclSet . op selectMsgDeclSet : Qid MsgDeclSet -> MsgDeclSet . *** selectOpDeclSet and selectMsgDeclSet returns, respectively, the subset *** of those declarations of ops and msgs which name coincides with the *** qid given ar argument. op opFamilyIn : OpDecl OpDeclSet Module -> Bool . op msgFamilyIn : MsgDecl MsgDeclSet Module -> Bool . *** Check whether the family of the subsort-overloaded operator given as *** argument has already a representative in the set of declarations given. eq genOpMaps((op F to F' [none]), OPDS, M) = genOpMapsAux( gTSubsortOverloadedFamilies(selectOpDeclSet(F, OPDS), none, M), F') . eq genMsgMaps((msg F to F'), MDS, M) = genMsgMapsAux( gTSubsortOverloadedFamilies(selectMsgDeclSet(F, MDS), none, M), F') . eq selectOpDeclSet(F, ((op F' : TyL -> S [AtS] .) OPDS)) = ((if F == F' then (op F' : TyL -> S [AtS] .) else none fi) selectOpDeclSet(F, OPDS)) . eq selectOpDeclSet(F, none) = none . eq selectMsgDeclSet(F, ((msg F' : TyL -> S .) MDS)) = ((if F == F' then (msg F' : TyL -> S .) else none fi) selectMsgDeclSet(F, MDS)) . eq selectMsgDeclSet(F, none) = none . eq genOpMapsAux(((op F : TyL -> S [AtS] .) OPDS), F') = ((op F : TyL -> S to F' [none]), genOpMapsAux(OPDS, F')) . eq genOpMapsAux(none, F') = none . eq genMsgMapsAux(((msg F : TyL -> S .) MDS), F') = ((msg F : TyL -> S to F'), genMsgMapsAux(MDS, F')) . eq genMsgMapsAux(none, F') = none . eq gTSubsortOverloadedFamilies((OPD OPDS), OPDS', M) = if opFamilyIn(OPD, OPDS', M) then gTSubsortOverloadedFamilies(OPDS, OPDS', M) else gTSubsortOverloadedFamilies(OPDS, (OPD OPDS'), M) fi . eq gTSubsortOverloadedFamilies(none, OPDS, M) = OPDS . eq gTSubsortOverloadedFamilies((MD MDS), MDS', M) = if msgFamilyIn(MD, MDS', M) then gTSubsortOverloadedFamilies(MDS, MDS', M) else gTSubsortOverloadedFamilies(MDS, (MD MDS'), M) fi . eq gTSubsortOverloadedFamilies(none, MDS, M) = MDS . eq opFamilyIn( (op F : TyL -> S [AtS] .), ((op F' : TyL' -> S' [AtS] .) OPDS), M) = ((F == F') and-then sameKind(M, TyL, TyL')) or-else opFamilyIn((op F : TyL -> S [AtS] .), OPDS, M) . eq opFamilyIn((op F : TyL -> S [AtS] .), none, M) = false . eq msgFamilyIn((msg F : TyL -> S .), ((msg F' : TyL' -> S' .) MDS), M) = ((F == F') and-then sameKind(M, TyL, TyL')) or-else msgFamilyIn((msg F : TyL -> S .), MDS, M) . eq msgFamilyIn((msg F : TyL -> S .), none, M) = false . *** In the case of views, the \texttt{parseDecl} function takes the term *** representing the corresponding declaration and a preview in which the *** declarations are introduced. Note that in the case of views, the approach *** followed in the evaluation is somewhat different. The only predeclarations *** in a preview correspond to the term premaps of sort \texttt{PreTermMap}, *** for which, in addition to solving the bubbles in them, we have to convert *** them into term maps of sort \texttt{TermMap} associating to them the set *** of declarations of variables in the view which are used in them (see *** Section~\ref{view-processing}). *** The function \texttt{parseDecl} for declarations in views takes then the *** term representing such declaration and a preview in which the result of *** adding the declaration will be returned. To be able to generate the sTS *** of equivalent operator and message maps as indicated above, the function *** takes also as parameters the sTS of declarations of operators and messages *** in the theory part of the source theory of the view in question, and the *** signature of such theory to make the necessary sort comparisons. op parseDecl : Term PreView OpDeclSet MsgDeclSet Module -> PreView . eq parseDecl('sort_to_.[T, T'], PV, OPDS, MDS, M) = addMaps((sort parseType(T) to parseType(T')), PV) . eq parseDecl('class_to_.[T, T'], PV, OPDS, MDS, M) = addMaps((class parseType(T) to parseType(T')), PV) . eq parseDecl('vars_:_.['neTokenList[T], T'], PV, OPDS, MDS, M) = addVars(parseVars(downQidList(T), parseType(T')), PV). eq parseDecl('var_:_.['neTokenList[T], T'], PV, OPDS, MDS, M) = addVars(parseVars(downQidList(T), parseType(T')), PV). eq parseDecl('op_to`term_.[T, T'], PV, OPDS, MDS, M) = addMaps(preTermMap(T, T'), PV) . eq parseDecl('op_to_.['token[T], 'token[T']], PV, OPDS, MDS, M) = addMaps(genOpMaps((op downQid(T) to downQid(T') [none]), OPDS, M), PV) . eq parseDecl('op_:_->_to_.['token[T], T', T'', 'token[T3]], PV, OPDS, MDS, M) = addMaps( op downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3) [none], PV) . eq parseDecl('op_:`->_to_.['token[T], T', 'token[T'']], PV, OPDS, MDS, M) = addMaps((op downQid(T) : nil -> parseType(T') to downQid(T'') [none]), PV) . eq parseDecl('msg_to_.['token[T], 'token[T']], PV, OPDS, MDS, M) = addMaps(genMsgMaps((msg downQid(T) to downQid(T')), MDS, M), PV) . eq parseDecl('msg_:_->_to_.['token[T], T', T'', 'token[T3]], PV, OPDS, MDS, M) = addMaps( msg downQid(T) : parseTypeList(T') -> parseType(T'') to downQid(T3), PV) . eq parseDecl('msg_:`->_to_.['token[T], T', 'token[T'']], PV, OPDS, MDS, M) = addMaps((msg downQid(T) : nil -> parseType(T') to downQid(T'')), PV) . eq parseDecl('label_to_.['token[T], 'token[T']], PV, OPDS, MDS, M) = addMaps((label downQid(T) to downQid(T')), PV) . eq parseDecl('attr_._to_.[T', 'token[T], 'token[T'']], PV, OPDS, MDS, M) = addMaps((attr downQid(T) . parseType(T') to downQid(T'')), PV) . eq parseDecl(T, PV, OPDS, MDS, M) = PV [owise] . endfm ******************************************************************************* *** *** 8.2 Meta Pretty Printing *** *** To be able to show to the user the modules, theories, views, and terms *** resulting from the different commands, the built-in function *** \texttt{meta-pretty-print} is extended in the modules in this section to *** deal with units and views. *** *** 8.2.1 Meta Pretty Printing of Declarations *** *** The predefined function \texttt{meta-pretty-print} is extended in the *** following module \texttt{DECL-META-PRETTY-PRINT} to handle any declaration *** that can appear in a unit. Note that the following *** \texttt{meta-pretty-print} functions, as the built-in one, return a list *** terms---such as equations, rules,* operator declarations with an identity *** attribute, etc.---they have been defined with a term of operator *** declarations with an identity attribute, etc.---they have been defined *** with a term of sort \texttt{Module} as argument. In the other cases the *** module is not necessary. fmod DECL-META-PRETTY-PRINT is pr EXT-DECL . pr O-O-DECL . pr UNIT . pr CONVERSION . pr INT-LIST . pr VIEW-EXPR-TO-QID . op eMetaPrettyPrint : Sort -> QidList . op eMetaPrettyPrint : SortSet -> QidList . op eMetaPrettyPrint : TypeList -> QidList . op eMetaPrettyPrint : SubsortDeclSet -> QidList . op eMetaPrettyPrint : ClassDeclSet -> QidList . op eMetaPrettyPrint : SubclassDeclSet -> QidList . op eMetaPrettyPrint : Module OpDeclSet -> QidList . op eMetaPrettyPrintVars : OpDeclSet -> QidList . op eMetaPrettyPrint : MsgDeclSet -> QidList . op eMetaPrettyPrint : Module MembAxSet -> QidList . op eMetaPrettyPrintEq : Module EquationSet -> QidList . op eMetaPrettyPrint : Module RuleSet -> QidList . op eMetaPrettyPrint : Module Condition -> QidList . op eMetaPrettyPrint : Module Term -> QidList . ---- error handling eq metaPrettyPrint(M, T, POS:PrintOptionSet) = 'module getName(M) 'contains 'errors . eq eMetaPrettyPrint(U, T) = metaPrettyPrint(U, T) . eq eMetaPrettyPrint(U, qidError(QIL)) = QIL . eq eMetaPrettyPrint(qidError(QIL)) = QIL . op eMetaPrettyPrint : Module AttrSet -> QidList . op eMetaPrettyPrint : IntList -> QidList . op eMetaPrettyPrint : ViewExp -> QidList . op eMetaPrettyPrint : AttrDeclSet -> QidList . op eMetaPrettyPrint : Module HookList -> QidList . vars QI QI' QI'' F V L : Qid . var QIL : QidList . var St : String . var M : Module . var U : Module . vars VE VE' : ViewExp . vars SS : SortSet . vars S S' : Sort . var TyL : TypeList . var Ty : Type . var SSDS : SubsortDeclSet . var OPDS : OpDeclSet . var AtS : AttrSet . var MAS : MembAxSet . var EqS : EquationSet . var RlS : RuleSet . var Hk : Hook . var HkL : HookList . var I : Int . var NL : IntList . vars T T' T'' T3 : Term . var CDS : ClassDeclSet . var SCDS : SubclassDeclSet . var MDS : MsgDeclSet . var ADS : AttrDeclSet . var Cond : Condition . ceq eMetaPrettyPrint(VE) = viewExp2QidList(VE) if not VE :: TypeList . eq eMetaPrettyPrint(Ty) = Ty . eq eMetaPrettyPrint((S ; SS)) = (eMetaPrettyPrint(S) eMetaPrettyPrint(SS)) [owise] . eq eMetaPrettyPrint((none).SortSet) = nil . eq eMetaPrettyPrint(Ty TyL) = eMetaPrettyPrint(Ty) eMetaPrettyPrint(TyL) [owise] . eq eMetaPrettyPrint((nil).TypeList) = nil . eq eMetaPrettyPrint(((subsort S < S' .) SSDS)) = ('\n '\s '\s '\b 'subsort '\o eMetaPrettyPrint(S) '\b '< '\o eMetaPrettyPrint(S') '\b '. '\o eMetaPrettyPrint(SSDS)) . eq eMetaPrettyPrint((none).SubsortDeclSet) = nil . eq eMetaPrettyPrint(M, ((op F : TyL -> Ty [none] .) OPDS)) = ('\n '\s '\s '\b 'op '\o F '\b ': '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty) '\b '. '\o eMetaPrettyPrint(M, OPDS)) . eq eMetaPrettyPrint(M, ((op F : TyL -> Ty [AtS] .) OPDS)) = ('\n '\s '\s '\b 'op '\o F '\b ': '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(Ty) '\n '\s '\s '\s '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o eMetaPrettyPrint(M, OPDS)) [owise] . eq eMetaPrettyPrint(M, (none).OpDeclSet) = nil . eq eMetaPrettyPrintVars((op F : nil -> Ty [none] .) OPDS) = ('\n '\s '\s '\b 'var '\o F '\b ': '\o eMetaPrettyPrint(Ty) '\b '. '\o eMetaPrettyPrintVars(OPDS)) . eq eMetaPrettyPrintVars((none).OpDeclSet) = nil . eq eMetaPrettyPrint(M, (mb T : S [none] .) MAS) = ('\n '\s '\s '\b 'mb '\o eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(S) '\b '. '\o eMetaPrettyPrint(M, MAS)) . eq eMetaPrettyPrint(M, (mb T : S [AtS] .) MAS) = ('\n '\s '\s '\b 'mb '\o eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(S) '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o eMetaPrettyPrint(M, MAS)) [owise] . eq eMetaPrettyPrint(M, (cmb T : S if Cond [none] .) MAS) = ('\n '\s '\s '\b 'cmb '\o eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(S) '\n '\s '\s '\s '\s '\b 'if '\o eMetaPrettyPrint(M, Cond) '\b '. '\o eMetaPrettyPrint(M, MAS)) . eq eMetaPrettyPrint(M, (cmb T : S if Cond [AtS] .) MAS) = ('\n '\s '\s '\b 'cmb '\o eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(S) '\n '\s '\s '\s '\s '\b 'if '\o eMetaPrettyPrint(M, Cond) '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o eMetaPrettyPrint(M, MAS)) [owise] . eq eMetaPrettyPrint(M, (none).MembAxSet) = nil . eq eMetaPrettyPrintEq(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 eMetaPrettyPrintEq(M, EqS)) . eq eMetaPrettyPrintEq(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 eMetaPrettyPrintEq(M, EqS)) [owise] . eq eMetaPrettyPrintEq(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 eMetaPrettyPrintEq(M, EqS)) . eq eMetaPrettyPrintEq(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 eMetaPrettyPrintEq(M, EqS)) [owise] . eq eMetaPrettyPrintEq(M, (none).EquationSet) = nil . eq eMetaPrettyPrint(M, ((rl T => T' [none] .) RlS)) = ('\n '\s '\s '\b 'rl '\s '\o eMetaPrettyPrint(M, T) '\n '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') '\b '\s '. '\o eMetaPrettyPrint(M, RlS)) . eq eMetaPrettyPrint(M, ((rl T => T' [AtS] .) RlS)) = ('\n '\s '\s '\b 'rl '\s '\o eMetaPrettyPrint(M, T) '\n '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o eMetaPrettyPrint(M, RlS)) [owise] . eq eMetaPrettyPrint(M, ((crl T => T' if Cond [none] .) RlS)) = ('\n '\s '\s '\b 'crl '\s '\o eMetaPrettyPrint(M, T) '\n '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') '\n '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) '\b '\s '. '\o eMetaPrettyPrint(M, RlS)) . eq eMetaPrettyPrint(M, ((crl T => T' if Cond [AtS] .) RlS)) = ('\n '\s '\s '\b 'crl '\s '\o eMetaPrettyPrint(M, T) '\n '\s '\s '\s '\s '\b '=> '\o '\s eMetaPrettyPrint(M, T') '\n '\s '\s '\s '\s '\b 'if '\o '\s eMetaPrettyPrint(M, Cond) '\s '\b '`[ '\o eMetaPrettyPrint(M, AtS) '\b '`] '\s '. '\o eMetaPrettyPrint(M, RlS)) [owise] . eq eMetaPrettyPrint(M, (none).RuleSet) = nil . eq eMetaPrettyPrint(M, T = T' /\ Cond) = (eMetaPrettyPrint(M, T) '\b '= '\o eMetaPrettyPrint(M, T') '\b '/\ '\o eMetaPrettyPrint(M, Cond)) [owise] . eq eMetaPrettyPrint(M, T : S /\ Cond) = (eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(S) '\b '/\ '\o eMetaPrettyPrint(M, Cond)) [owise] . eq eMetaPrettyPrint(M, T := T' /\ Cond) = (eMetaPrettyPrint(M, T) '\b ':= '\o eMetaPrettyPrint(M, T') '\b '/\ '\o eMetaPrettyPrint(M, Cond)) [owise] . eq eMetaPrettyPrint(M, T => T' /\ Cond) = (eMetaPrettyPrint(M, T) '\b '=> '\o eMetaPrettyPrint(M, T') '\b '/\ '\o eMetaPrettyPrint(M, Cond)) [owise] . eq eMetaPrettyPrint(M, T = T') = (eMetaPrettyPrint(M, T) '\b '= '\o eMetaPrettyPrint(M, T')) . eq eMetaPrettyPrint(M, T : S) = (eMetaPrettyPrint(M, T) '\b ': '\o eMetaPrettyPrint(S)) . eq eMetaPrettyPrint(M, T := T') = (eMetaPrettyPrint(M, T) '\b ':= '\o eMetaPrettyPrint(M, T')) . eq eMetaPrettyPrint(M, T => T') = (eMetaPrettyPrint(M, T) '\b '=> '\o eMetaPrettyPrint(M, T')) . eq eMetaPrettyPrint(M, (assoc AtS)) = ('\b 'assoc '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (comm AtS)) = ('\b 'comm '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (memo AtS)) = ('\b 'memo '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (idem AtS)) = ('\b 'idem '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (id(T) AtS)) = ('\b 'id: '\o eMetaPrettyPrint(M, T) eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (right-id(T) AtS)) = ('\b 'right 'id: '\o eMetaPrettyPrint(M, T) eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (left-id(T) AtS)) = ('\b 'left 'id: '\o eMetaPrettyPrint(M, T) eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (poly(NL) AtS)) = ('\b 'poly '`( '\o eMetaPrettyPrint(NL) '\b '`) '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (strat(NL) AtS)) = ('\b 'strat '`( '\o eMetaPrettyPrint(NL) '\b '`) '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (memo AtS)) = ('\b 'memo '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (prec(I) AtS)) = ('\b 'prec '\o eMetaPrettyPrint(I) eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (gather(QIL) AtS)) = ('\b 'gather '\o '`( QIL '`) eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (format(QIL) AtS)) = ('\b 'format '\o '`( QIL '`) eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (ctor AtS)) = ('\b 'ctor '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (frozen(NL) AtS)) = ('\b 'frozen '`( '\o eMetaPrettyPrint(NL) '\b '`) '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (iter AtS)) = ('\b 'iter '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (special(HkL) AtS)) = ('\b 'special '`( '\o eMetaPrettyPrint(M, HkL) '\b '`) '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (config AtS)) = ('\b 'config '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (object AtS)) = ('\b 'object '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (msg AtS)) = ('\b 'msg '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (label(QI) AtS)) = ('\b 'label '\o QI '\b '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (metadata(St) AtS)) = ('\b 'metadata '\o qid("\"" + St + "\"") '\b '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (nonexec AtS)) = ('\b 'nonexec '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (owise AtS)) = ('\b 'owise '\o eMetaPrettyPrint(M, AtS)) . eq eMetaPrettyPrint(M, (none).AttrSet) = nil . ceq eMetaPrettyPrint(M, (Hk HkL)) = (eMetaPrettyPrint(M, Hk) eMetaPrettyPrint(M, HkL)) if HkL =/= nil . eq eMetaPrettyPrint(M, id-hook(QI, nil)) = ('\b 'id-hook '\o QI) . eq eMetaPrettyPrint(M, id-hook(QI, QIL)) = ('\b 'id-hook '\o QI '\b '`( '\o QIL '\b '`) '\o ) [owise] . eq eMetaPrettyPrint(M, op-hook(QI, QI', nil, QI'')) = ('\b 'op-hook '\o QI '\b '`( '\o QI' ': '~> QI'' '\b '`) '\o) . eq eMetaPrettyPrint(M, op-hook(QI, QI', QIL, QI'')) = ('\b 'op-hook '\o QI '\b '`( '\o QI' ': QIL '~> QI'' '\b '`) '\o) [owise] . eq eMetaPrettyPrint(M, term-hook(QI, T)) = ('\b 'term-hook '\o QI '\b '`( '\o eMetaPrettyPrint(M, T) '\b '`) '\o) . eq eMetaPrettyPrint((I NL)) = (qid(string(I, 10)) eMetaPrettyPrint(NL)) . eq eMetaPrettyPrint((nil).NatList) = nil . eq eMetaPrettyPrint((class S | ADS .) CDS) = ((if ADS == none then ('\n '\s '\s '\b 'class '\o eMetaPrettyPrint(S) '\b '. '\o) else ('\n '\s '\s '\b 'class '\o eMetaPrettyPrint(S) '\b '| '\o eMetaPrettyPrint(ADS) '\b '. '\o) fi) eMetaPrettyPrint(CDS)) . eq eMetaPrettyPrint((none).ClassDeclSet) = nil . eq eMetaPrettyPrint((subclass S < S' .) SCDS) = ('\n '\s '\s '\b 'subclass '\o eMetaPrettyPrint(S) '\b '< '\o eMetaPrettyPrint(S') '\b '. '\o eMetaPrettyPrint(SCDS)) . eq eMetaPrettyPrint((none).SubclassDeclSet) = nil . eq eMetaPrettyPrint((msg F : TyL -> S .) MDS) = ('\n '\s '\s '\b 'msg '\o F '\b ': '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(S) '\b '. '\o eMetaPrettyPrint(MDS)) . eq eMetaPrettyPrint((none).MsgDeclSet) = nil . eq eMetaPrettyPrint(((attr F : S), ADS)) = (F '\b ': '\o eMetaPrettyPrint(S) '\b '`, '\o '\s eMetaPrettyPrint(ADS)) [owise] . eq eMetaPrettyPrint((attr F : S)) = (F '\b ': '\o eMetaPrettyPrint(S)) . eq eMetaPrettyPrint((none).AttrDeclSet) = nil . endfm ******************************************************************************* *** *** 8.2.2 Meta Pretty Printing of Modules *** *** In the following module, the \texttt{meta-pretty-print} function is *** defined on sort \texttt{Module}. fmod UNIT-META-PRETTY-PRINT is pr UNIT . pr RENAMING-EXPR-EVALUATION . pr DECL-META-PRETTY-PRINT . op eMetaPrettyPrint : Module Module -> QidList . op eMetaPrettyPrint : Module Module -> QidList . op eMetaPrettyPrint : Header -> QidList . op eMetaPrettyPrint : ParameterDeclList -> QidList . op eMetaPrettyPrint : ImportList -> QidList . var M : Module . vars QI F F' L L' : Qid . var QIL : QidList . var ME : ModuleExpression . vars S S' : Sort . var Ty : Type . var TyL : TypeList . var SS : SortSet . var PD : ParameterDecl . var PDL : ParameterDeclList . vars IL IL' : ImportList . var SSDS : SubsortDeclSet . var OPDS : OpDeclSet . var MAS : MembAxSet . var EqS : EquationSet . var RlS : RuleSet . var CDS : ClassDeclSet . var SCDS : SubclassDeclSet . var MDS : MsgDeclSet . var U : Module . var AtS : AttrSet . var MN : ModuleName . ceq eMetaPrettyPrint(ME) = if QI == '`) or QI == '`] or QI == '`} then QIL QI '\s else QIL QI fi if QIL QI := header2QidList(ME) . eq eMetaPrettyPrint(W:[Module], unitError(QIL)) = QIL . eq eMetaPrettyPrint(unitError(QIL), noModule) = QIL . eq eMetaPrettyPrint(noModule, noModule) = nil . eq eMetaPrettyPrint(M, mod ME is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = ('\n '\b 'mod '\o eMetaPrettyPrint(ME) '\b 'is '\o eMetaPrettyPrint(IL) (if SS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o) fi) eMetaPrettyPrint(SSDS) eMetaPrettyPrint(M, OPDS) eMetaPrettyPrint(M, MAS) eMetaPrettyPrintEq(M, EqS) eMetaPrettyPrint(M, RlS) '\n '\b 'endm '\o '\n) . eq eMetaPrettyPrint(M, mod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS RlS endm) = ('\n '\b 'mod '\o eMetaPrettyPrint(ME) (if PDL == nil then nil else '`{ eMetaPrettyPrint(PDL) '`} '\s fi) '\b 'is '\o eMetaPrettyPrint(IL) (if SS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o) fi) eMetaPrettyPrint(SSDS) eMetaPrettyPrint(M, OPDS) eMetaPrettyPrint(M, MAS) eMetaPrettyPrintEq(M, EqS) eMetaPrettyPrint(M, RlS) '\n '\b 'endm '\o '\n) . eq eMetaPrettyPrint(M, th MN is IL sorts SS . SSDS OPDS MAS EqS RlS endth) = ('\n '\b 'th '\o eMetaPrettyPrint(MN) '\b 'is '\o eMetaPrettyPrint(IL) (if SS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o) fi) eMetaPrettyPrint(SSDS) eMetaPrettyPrint(M, OPDS) eMetaPrettyPrint(M, MAS) eMetaPrettyPrintEq(M, EqS) eMetaPrettyPrint(M, RlS) '\n '\b 'endth '\o '\n) . eq eMetaPrettyPrint(M, fmod ME is IL sorts SS . SSDS OPDS MAS EqS endfm) = ('\n '\b 'fmod '\o eMetaPrettyPrint(ME) '\b 'is '\o eMetaPrettyPrint(IL) (if SS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o) fi) eMetaPrettyPrint(SSDS) eMetaPrettyPrint(M, OPDS) eMetaPrettyPrint(M, MAS) eMetaPrettyPrintEq(M, EqS) '\n '\b 'endfm '\o '\n) . eq eMetaPrettyPrint(M, fmod ME{PDL} is IL sorts SS . SSDS OPDS MAS EqS endfm) = ('\n '\b 'fmod '\o eMetaPrettyPrint(ME) (if PDL == nil then nil else '`{ eMetaPrettyPrint(PDL) '`} '\s fi) '\b 'is '\o eMetaPrettyPrint(IL) (if SS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o) fi) eMetaPrettyPrint(SSDS) eMetaPrettyPrint(M, OPDS) eMetaPrettyPrint(M, MAS) eMetaPrettyPrintEq(M, EqS) '\n '\b 'endfm '\o '\n) . eq eMetaPrettyPrint(M, fth MN is IL sorts SS . SSDS OPDS MAS EqS endfth) = ('\n '\b 'fth '\o eMetaPrettyPrint(MN) '\b 'is '\o eMetaPrettyPrint(IL) (if SS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o) fi) eMetaPrettyPrint(SSDS) eMetaPrettyPrint(M, OPDS) eMetaPrettyPrint(M, MAS) eMetaPrettyPrintEq(M, EqS) '\n '\b 'endfth '\o '\n) . eq eMetaPrettyPrint(M, omod ME is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = ('\n '\b 'omod '\o eMetaPrettyPrint(ME) '\b 'is '\o eMetaPrettyPrint(IL) (if SS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o) fi) eMetaPrettyPrint(SSDS) eMetaPrettyPrint(CDS) eMetaPrettyPrint(SCDS) eMetaPrettyPrint(M, OPDS) eMetaPrettyPrint(MDS) eMetaPrettyPrint(M, MAS) eMetaPrettyPrintEq(M, EqS) eMetaPrettyPrint(M, RlS) '\n '\b 'endom '\o '\n) . eq eMetaPrettyPrint(M, omod ME{PDL} is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endom) = ('\n '\b 'omod '\o eMetaPrettyPrint(ME) (if PDL == nil then nil else ('`{ eMetaPrettyPrint(PDL) '`} '\s) fi) '\b 'is '\o eMetaPrettyPrint(IL) (if SS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o) fi) eMetaPrettyPrint(SSDS) eMetaPrettyPrint(CDS) eMetaPrettyPrint(SCDS) eMetaPrettyPrint(M, OPDS) eMetaPrettyPrint(MDS) eMetaPrettyPrint(M, MAS) eMetaPrettyPrintEq(M, EqS) eMetaPrettyPrint(M, RlS) '\n '\b 'endom '\o '\n) . eq eMetaPrettyPrint(M, oth MN is IL sorts SS . SSDS CDS SCDS OPDS MDS MAS EqS RlS endoth) = ('\n '\b 'oth '\o eMetaPrettyPrint(MN) '\b 'is '\o eMetaPrettyPrint(IL) (if SS == none then nil else ('\n '\s '\s '\b 'sorts '\o eMetaPrettyPrint(SS) '\b '. '\o) fi) eMetaPrettyPrint(SSDS) eMetaPrettyPrint(CDS) eMetaPrettyPrint(SCDS) eMetaPrettyPrint(M, OPDS) eMetaPrettyPrint(MDS) eMetaPrettyPrint(M, MAS) eMetaPrettyPrintEq(M, EqS) eMetaPrettyPrint(M, RlS) '\n '\b 'endoth '\o '\n) . eq eMetaPrettyPrint((including ME .) IL) = ('\n '\s '\s '\b 'including '\o eMetaPrettyPrint(ME) '\b '. '\o eMetaPrettyPrint(IL)) . eq eMetaPrettyPrint((extending ME .) IL) = ('\n '\s '\s '\b 'extending '\o eMetaPrettyPrint(ME) '\b '. '\o eMetaPrettyPrint(IL)) . eq eMetaPrettyPrint((protecting ME .) IL) = ('\n '\s '\s '\b 'protecting '\o eMetaPrettyPrint(ME) '\b '. '\o eMetaPrettyPrint(IL)) . eq eMetaPrettyPrint((protecting pd(QI :: ME) .) IL) = eMetaPrettyPrint(IL) . eq eMetaPrettyPrint((nil).ImportList) = nil . eq eMetaPrettyPrint((QI :: ME, PDL)) = (QI ':: eMetaPrettyPrint(ME) '`, eMetaPrettyPrint(PDL)) [owise] . eq eMetaPrettyPrint((QI :: ME)) = (QI ':: eMetaPrettyPrint(ME)) . eq eMetaPrettyPrint((nil).ParameterDeclList) = (nil).QidList . op eMetaPrettyPrint : ModuleExpression -> QidList . eq eMetaPrettyPrint(QI + ME:ModuleExpression) = QI '+ eMetaPrettyPrint(ME:ModuleExpression) . eq eMetaPrettyPrint(QI *(RnS:RenamingSet)) = QI '* '\s '`( renamingSet2QidList(RnS:RenamingSet) '`) . eq eMetaPrettyPrint(pd(PD)) = eMetaPrettyPrint(PD) . op renamingSet2QidList : RenamingSet -> QidList . eq renamingSet2QidList(((op F to F' [AtS]), RS:RenamingSet)) = if AtS == none then ('op F 'to F' '`, '\s renamingSet2QidList(RS:RenamingSet)) else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`] '`, '\s renamingSet2QidList(RS:RenamingSet)) fi [owise] . eq renamingSet2QidList((op F to F' [AtS])) = if AtS == none then ('op F 'to F') else ('op F 'to F' '\s '`[ attrSet2QidList(AtS) '`]) fi . eq renamingSet2QidList(((op F : TyL -> Ty to F' [AtS]), RS:RenamingSet)) = if AtS == none then ('op F ': typeList2QidList(TyL) '-> Ty 'to F' '`, '\s renamingSet2QidList(RS:RenamingSet)) else ('op F ': typeList2QidList(TyL) '-> Ty 'to F' '`[ attrSet2QidList(AtS) '`] '`, '\s renamingSet2QidList(RS:RenamingSet)) fi [owise] . eq renamingSet2QidList((op F : TyL -> Ty to F' [AtS])) = if AtS == none then ('op F ': typeList2QidList(TyL) '-> Ty 'to F') else ('op F ': typeList2QidList(TyL) '-> Ty 'to F' '`[ attrSet2QidList(AtS) '`]) fi . eq renamingSet2QidList(((sort S to S'), RS:RenamingSet)) = ('sort S 'to S' '`, '\s renamingSet2QidList(RS:RenamingSet)) [owise] . eq renamingSet2QidList((sort S to S')) = ('sort S 'to S') . eq renamingSet2QidList(((label L to L'), RS:RenamingSet)) = ('label L 'to L' '`, '\s renamingSet2QidList(RS:RenamingSet)) [owise] . eq renamingSet2QidList((label L to L')) = ('label L 'to L') . endfm ******************************************************************************* *** The function \texttt{meta-pretty-print} on units is defined recursively, *** calling the \texttt{meta-pretty-print} functions for the different *** declarations in the unit defined in module \texttt{DECL-META-PRETTY-PRINT}. *** *** 8.2.3 Meta Pretty Printing of Maps and Views *** *** We define in the following module the function \texttt{meta-pretty-print} *** on maps. fmod MAP-SET-META-PRETTY-PRINT is pr DECL-META-PRETTY-PRINT . pr FMAP . pr UNIT . op eMetaPrettyPrint : RenamingSet -> QidList . var MAP : Renaming . var MAPS : RenamingSet . vars QI QI' F F' L L' : Qid . var AtS : AttrSet . vars S S' : Sort . var TyL : TypeList . eq eMetaPrettyPrint((MAP, MAPS)) = (eMetaPrettyPrint(MAP) '`, '\t eMetaPrettyPrint(MAPS)) [owise] . eq eMetaPrettyPrint((none).RenamingSet) = nil . eq eMetaPrettyPrint(op F to F' [AtS]) = if AtS == none then ('\b 'op '\o F '\b 'to '\o F') else ('\b 'op F '\b 'to '\o F' '\b '`[ '\o eMetaPrettyPrint(noModule, AtS) '\b '`] '\o) *** In a map there should not be attributes requiring a module fi . eq eMetaPrettyPrint(op F : TyL -> S to F' [AtS]) = if AtS == none then ('\b 'op '\o F '\b ': '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(S) '\b 'to '\o F') else ('\b 'op '\o F '\b ': '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(S) '\b 'to '\o F' '\b '`[ '\o eMetaPrettyPrint(noModule, AtS) '\b '`] '\o) *** In a map there should not be attributes requiring a module fi . eq eMetaPrettyPrint(sort S to S') = ('\b 'sort '\o eMetaPrettyPrint(S) '\b 'to '\o eMetaPrettyPrint(S')) . eq eMetaPrettyPrint(label L to L') = ('\b 'label '\o L '\b 'to '\o L') . eq eMetaPrettyPrint(class S to S') = ('\b 'class '\o eMetaPrettyPrint(S) '\b 'to '\o eMetaPrettyPrint(S')) . eq eMetaPrettyPrint(attr QI . S to QI') = ('\b 'attr '\o eMetaPrettyPrint(S) '\b '. '\o QI '\b 'to '\o QI') . eq eMetaPrettyPrint(msg F to F') = ('\b 'msg '\o F '\b 'to '\o F') . eq eMetaPrettyPrint(msg F : TyL -> S to F') = ('\b 'msg '\o F '\b ': '\o eMetaPrettyPrint(TyL) '\b '-> '\o eMetaPrettyPrint(S) '\b 'to '\o F') . endfm ******************************************************************************* *** Finally, in the \texttt{VIEW-META-PRETTY-PRINT} module, the *** \texttt{meta-pretty-print} function is defined on views. fmod VIEW-META-PRETTY-PRINT is pr DATABASE . pr MAP-SET-META-PRETTY-PRINT . pr VIEW-MAP-SET-APPL-ON-UNIT . pr UNIT-META-PRETTY-PRINT . op eMetaPrettyPrint : Database View -> QidList . op eMetaPrettyPrint : ViewExp -> QidList . op eMetaPrettyPrint : ModuleExpression ModuleExpression Database RenamingSet RenamingSet -> QidList . var QI : Qid . var QIL : QidList . var DB : Database . vars ME ME' : ModuleExpression . var MAP : Renaming . var VMAP : ViewMap . vars VMAPS VMAPS' : Set{ViewMap} . vars T T' : Term . var PDL : ParameterDeclList . vars VE VE' : ViewExp . var DT : Default{Term} . ceq eMetaPrettyPrint(DB, view VE from ME to ME' is VMAPS endv) = ('\n '\b 'view '\o QIL QI if QI == '`) then '\s else nil fi '\b 'from '\o eMetaPrettyPrint(ME) '\b 'to '\o eMetaPrettyPrint(ME') '\b 'is '\o '\n '\s '\s eMetaPrettyPrint(ME, ME', DB, VMAPS, VMAPS) '\n '\b 'endv '\o) if QIL QI := eMetaPrettyPrint(VE) . ceq eMetaPrettyPrint(DB, view VE{PDL} from ME to ME' is VMAPS endv) = ('\n '\b 'view '\o QIL QI (if PDL == nil then if QI == '`) then '\s else nil fi else '`{ eMetaPrettyPrint(PDL) '`} '\s fi) '\b 'from '\o eMetaPrettyPrint(ME) '\b 'to '\o eMetaPrettyPrint(ME') '\b 'is '\o '\n '\s '\s eMetaPrettyPrint(ME, ME', DB, VMAPS, VMAPS) '\n '\b 'endv '\o) if QIL QI := eMetaPrettyPrint(VE) . eq eMetaPrettyPrint(DB, viewError(QIL)) = QIL . ceq eMetaPrettyPrint(QI) = QI if not QI :: Type . ceq eMetaPrettyPrint(((VE, VE'))) = eMetaPrettyPrint(VE) '`, '\s eMetaPrettyPrint(VE') if VE =/= nil /\ VE' =/= nil . eq eMetaPrettyPrint(QI{VE}) = QI '`{ eMetaPrettyPrint(VE) '`} '\s . eq eMetaPrettyPrint(ME, ME', DB, (VMAP, VMAPS), VMAPS') = (eMetaPrettyPrint(ME, ME', DB, VMAP, VMAPS') '\n '\s '\s eMetaPrettyPrint(ME, ME', DB, VMAPS, VMAPS')) [owise] . eq eMetaPrettyPrint(ME, ME', DB, none, VMAPS) = nil . eq eMetaPrettyPrint(ME, ME', DB, MAP, VMAPS) = eMetaPrettyPrint(MAP) '. . eq eMetaPrettyPrint(ME, ME', DB, termMap(T, T'), VMAPS) = ('\b 'op '\o eMetaPrettyPrint(getFlatModule(ME, DB), T) '\b 'to 'term '\o eMetaPrettyPrint(getFlatModule(ME', DB), T') '\b '. '\o) . eq eMetaPrettyPrint(termMap(T, T')) = ('op eMetaPrettyPrint(T) '\b 'to '\o eMetaPrettyPrint(T')) . endfm ******************************************************************************* *** *** 8.3 Input Processing *** *** The processing functions presented in the following modules are in charge *** of taking each term generated by the \texttt{metaParse} function and, *** after transforming it into an element of the data types \texttt{Module} or *** \texttt{View}, or generating some output, returning the database resulting *** from introducing in it such a term. We shall see in *** Section~\ref{database-handling} how the appropriate function is called *** after having performed a first analysis of the term, in which it is *** detected whether the input corresponds to a unit, view, or command. In the *** cases of units and views the processing is quite similar. After a *** preprocessing of the term, the function \texttt{parseDecl} is called with *** each of the subterms representing declarations, resulting in units or *** views with the parsed declarations in it. *** *** 8.3.1 Module Processing *** *** The processing of a term resulting from the parsing of some input *** corresponding to a unit is accomplished by the \texttt{procModule} function. *** This function takes as arguments a term of sort \texttt{Term}, which *** represents some preunit, and a database. The function then enters into the *** given database the unit obtained from the transformation of such term *** into a term of sort \texttt{Module}. fmod UNIT-PROCESSING is pr DATABASE . pr UNIT-DECL-PARSING . pr EVALUATION . pr VIEW-MAP-SET-APPL-ON-UNIT . pr META-FULL-MAUDE-SIGN . pr MOD-EXP-PARSING . vars QI F X : Qid . var M : Module . vars PU PU' U U' : Module . vars DB DB' : Database . vars T T' T'' T3 : Term . var TL : TermList . vars PL PL' PL'' : ParameterList . var PDL : ParameterDeclList . var IL IL' : ImportList . var ME : ModuleExpression . var S : Sort . var SS : SortSet . var ME' : ModuleExpression . var VMAPS : RenamingSet . var B : Bool . var VDS : OpDeclSet . var QIL : QidList . var PDR : ParseDeclResult . var DT : Default{Term} . *** The \texttt{parseParList} takes a term representing a list of parameters *** and returns the corresponding list. op parseParList : Term -> ParameterDeclList . eq parseParList('_::_['token[T], T']) = downQid(T) :: parseModExp(T') . eq parseParList('_`,_[T, T']) = (parseParList(T), parseParList(T')) . *** All the operators declared as constructors of sort \texttt{PreModule} in *** the signature of Full Maude, given in Appendix~\ref{signature-full-maude}, *** are declared with two arguments, namely, the name, or name and interface, *** of the unit, and the list of declarations of such units. The function *** \texttt{procModule3} is called with the term corresponding to the name, or *** name and interface, of the module as first argument, the term corresponding *** to the set of declarations as second argument, and an empty module of the *** appropriate type, in which the different declarations will be accumulated, *** as third argument. *** The task of the function \texttt{procModule4} is then to make a second *** level parsing of the input, building up, simultaneously, the preunit *** represented in the term passed as argument, and the unit resulting from the *** declarations without bubbles. This unit without bubbles will be used by the *** \texttt{evalPreModule} function to build the signature with which to *** analyze the bubbles in the preunit (see Section~\ref{evaluation}). *** The case of parameterized modules requires a special treatment of the *** parameters. These parameters are evaluated and are added as submodules in *** the appropriate way. *** When the last declaration is parsed, the function \texttt{evalPreModule} is *** called with the preunit (the top module with bubbles) as first argument, *** the empty copy of it as second argument, the top module without bubbles as *** third argument, and the database. *** Note that the \texttt{procModule} function adds a declaration importing the *** module \texttt{CONFIGURATION+}, presented in *** Section~\ref{non-built-in-predefined}, to the object-oriented modules, and *** that \texttt{procModule4} adds a declaration importing the built-in module *** \texttt{BOOL} to all modules. op procModule : Term Database -> Database . *** moved to MOD-EXPR-EVAL to solve dependency *** op procModule : Qid Database -> Database . op procModule2 : Term Term Database -> Database . op procModule2 : Term Database -> Database . op procModule3 : Term Term Term Module Database -> Database . op procModule3 : Term Term Module Database -> Database . op procModule4 : Term Term Module Module OpDeclSet Database -> Database . op procModule4 : Term Module Module OpDeclSet Database -> Database . *** When recompiling a module, it's called with a Qid, and it's *** not reentered into the database. ceq procModule(QI, DB) = if DT == null then evalModule(U, VDS, DB) else procModule2(DT, DB) fi if < DT ; VDS ; U > := getTermModule(QI, DB) . eq procModule(T, DB) = procModule2(T, T, DB) . *** procModule2 just calls procModule3 with the name and the declarations of *** the module, and an empty unit of the right type. eq procModule2(T, 'fmod_is_endfm[T', T''], DB) = procModule3(T, T', T'', emptyFModule, DB) . eq procModule2(T, 'obj_is_endo[T', T''], DB) = procModule3(T, T', T'', emptyFModule, DB) . eq procModule2(T, 'obj_is_jbo[T', T''], DB) = procModule3(T, T', T'', emptyFModule, DB) . eq procModule2(T, 'mod_is_endm[T', T''], DB) = procModule3(T, T', T'', emptySModule, DB) . eq procModule2(T, 'omod_is_endom[T', T''], DB) = procModule3(T, T', T'', addImports((including 'CONFIGURATION+ .), emptyOModule), DB) . eq procModule2(T, 'fth_is_endfth[T', T''], DB) = procModule3(T, T', T'', emptyFTheory, DB) . eq procModule2(T, 'th_is_endth[T', T''], DB) = procModule3(T, T', T'', emptySTheory, DB) . eq procModule2(T, 'oth_is_endoth[T', T''], DB) = procModule3(T, T', T'', addImports((including 'CONFIGURATION+ .), emptyOTheory), DB) . eq procModule2('fmod_is_endfm[T, T'], DB) = procModule3(T, T', emptyFModule, DB) . eq procModule2('obj_is_endo[T, T'], DB) = procModule3(T, T', emptyFModule, DB) . eq procModule2('obj_is_jbo[T, T'], DB) = procModule3(T, T', emptyFModule, DB) . eq procModule2('mod_is_endm[T, T'], DB) = procModule3(T, T', emptySModule, DB) . eq procModule2('omod_is_endom[T, T'], DB) = procModule3(T, T', addImports((including 'CONFIGURATION+ .), emptyOModule), DB) . eq procModule2('fth_is_endfth[T, T'], DB) = procModule3(T, T', emptyFTheory, DB) . eq procModule2('th_is_endth[T, T'], DB) = procModule3(T, T', emptySTheory, DB) . eq procModule2('oth_is_endoth[T, T'], DB) = procModule3(T, T', addImports((including 'CONFIGURATION+ .), emptyOTheory), DB) . *** procModule3 evaluates the name of the module and calls procModule4 *** with the declarations, two empty units (one to contain the declarations *** with bubbles and another one the declarations without bubbles), and *** a set of op decls initialy empty in which to store the variables ceq procModule3(T, 'token[T'], T'', U, DB) = procModule4(T, T'', setName(U, QI), setName(U, QI), none, DB) if QI := downQid(T') . ceq procModule3(T, '_`{_`}['token[T'], T''], T3, U, DB) = procModule4(T, T3, setPars(setName(U, QI), parseParList(T'')), setName(U, QI), none, DB) if QI := downQid(T') . ceq procModule3('token[T], T', U, DB) = procModule4(T', setName(U, QI), setName(U, QI), none, DB) if QI := downQid(T) . ceq procModule3('_`{_`}['token[T], T'], T'', U, DB) = procModule4(T'', setPars(setName(U, QI), parseParList(T')), setName(U, QI), none, DB) if QI := downQid(T) . *** procModule4 parses one by one each of the declarations in the module. *** Note that is parseDecl that adds the parsed declaration to the right *** place. When it is done, it calls evalPreModule with the resulting *** preModule, unit, vars. ceq procModule4(T, '__[T', T''], PU, U, VDS, DB) = procModule4(T, T'', preModule(PDR), unit(PDR), vars(PDR), DB) if PDR := parseDecl(T', PU, U, VDS) . ceq procModule4(T, F[TL], PU, U, VDS, DB) = evalPreModule(preModule(PDR), unit(PDR), vars(PDR), insTermModule(getName(U), T, DB)) if F =/= '__ /\ PDR := parseDecl(F[TL], PU, U, VDS) . eq procModule4(T, T', unitError(QIL), V:[Module], V:[OpDeclSet], DB) = warning(DB, QIL) . eq procModule4(T, T', V:[Module], unitError(QIL), V:[OpDeclSet], DB) = warning(DB, QIL) . eq procModule4(T, T', V:[Module], V':[Module], opDeclError(QIL), DB) = warning(DB, QIL) . ceq procModule4('__[T, T'], PU, U, VDS, DB) = procModule4(T', preModule(PDR), unit(PDR), vars(PDR), DB) if PDR := parseDecl(T, PU, U, VDS) . ceq procModule4(F[TL], PU, U, VDS, DB) = evalPreModule(preModule(PDR), unit(PDR), vars(PDR), DB) if F =/= '__ /\ PDR := parseDecl(F[TL], PU, U, VDS) . eq procModule4(T, unitError(QIL), U, VDS, DB) = warning(DB, QIL) . eq procModule4(T, PU, unitError(QIL), VDS, DB) = warning(DB, QIL) . eq procModule4(T, PU, U, opDeclError(QIL), DB) = warning(DB, QIL) . endfm ******************************************************************************* *** *** 8.3.2 View Processing *** *** A similar process is followed for views. Note that in case of operator *** maps going to derived terms we have bubbles, which will have to be treated *** using the signatures of the appropriate modules. fmod VIEW-PROCESSING is pr UNIT-PROCESSING . pr VIEW-DECL-PARSING . pr VIEW-BUBBLE-PARSING . vars QI X F : Qid . var QIL : QidList . vars T T' T'' T3 T4 : Term . var M : Module . var VE : ViewExp . vars PV PV' : PreView . vars ME ME' : ModuleExpression . vars DB DB' : Database . vars OPDS VDS VDS' VDS'' : OpDeclSet . var MDS : MsgDeclSet . var TL : TermList . vars PDL PDL' : ParameterDeclList . var H : Header . var IL : ImportList . var PVMAPS : Set{PreViewMap} . *** As the functions \texttt{getThSorts} and \texttt{getThClasses} *** presented in Section~\ref{instantiation}, the functions *** \texttt{getThOpDeclSet} and \texttt{getThMsgDeclSet} return, respectively, *** the set of declarations of operators, and the set of declarations of *** messages in the theory part of the structure of the module given as *** argument. op getThOpDeclSet : Header Database -> OpDeclSet . op getThMsgDeclSet : Header Database -> MsgDeclSet . op getThOpDeclSetAux : ImportList Database -> OpDeclSet . op getThMsgDeclSetAux : ImportList Database -> MsgDeclSet . eq getThOpDeclSet(ME, DB) = if theory(getTopModule(ME, DB)) then (getThOpDeclSetAux(getImports(getTopModule(ME, DB)), DB) getOps(getTopModule(ME, DB))) else none fi . eq getThOpDeclSetAux(((including ME .) IL), DB) = (getThOpDeclSet(ME, DB) getThOpDeclSetAux(IL, DB)) . eq getThOpDeclSetAux(((extending ME .) IL), DB) = (getThOpDeclSet(ME, DB) getThOpDeclSetAux(IL, DB)) . eq getThOpDeclSetAux(((protecting ME .) IL), DB) = (getThOpDeclSet(ME, DB) getThOpDeclSetAux(IL, DB)) . eq getThOpDeclSetAux(nil, DB) = none . eq getThMsgDeclSet(ME, DB) = if theory(getTopModule(ME, DB)) then (getThMsgDeclSetAux(getImports(getTopModule(ME, DB)), DB) getMsgs(getTopModule(ME, DB))) else none fi . eq getThMsgDeclSetAux(((including ME .) IL), DB) = (getThMsgDeclSet(ME, DB) getThMsgDeclSetAux(IL, DB)) . eq getThMsgDeclSetAux(((extending ME .) IL), DB) = (getThMsgDeclSet(ME, DB) getThMsgDeclSetAux(IL, DB)) . eq getThMsgDeclSetAux(((protecting ME .) IL), DB) = (getThMsgDeclSet(ME, DB) getThMsgDeclSetAux(IL, DB)) . eq getThMsgDeclSetAux(nil, DB) = none . *** The processing of terms representing previews accomplished by the function *** \texttt{procView} is quite similar to the one accomplished by *** \texttt{procModule} on terms representing preunits. The algorithms followed *** are also quite similar. Both proceed recursively on the list of *** declarations, accumulating them in a preunit or in a preview. *** The solving of bubbles in views requires the signatures of the source and *** target units extended, respectively, with the declarations of variables in *** the view and with the mappings of these declarations. As we shall see in *** Section~\ref{databaseADT}, the signatures of the built-in modules are not *** accesible at the metalevel, and thus built-in modules cannot be used *** directly as arguments of built-in functions. Thus, to be able to use them *** as targTS of views, a `dummy' module is created importing the *** corresponding predefined module. The source and target module expressions *** of the view are evaluated before the view processing itself starts. *** As we saw in Section~\ref{view-decl-parsing}, parsing of terms representing *** operator and message maps requires the set of operator and message *** declarations in the theory part of the source theory. op procPars : ParameterDeclList Database -> Database . eq procPars((X :: ME, PDL), DB) = procPars(PDL, createCopy((X :: ME), database(evalModExp(ME, DB)))) . eq procPars((nil).ParameterDeclList, DB) = DB . op procView : Term Database -> Database . op procView2 : Term Database -> Database . op procView : Term PreView Database -> Database . op procViewAux : Term PreView OpDeclSet MsgDeclSet Module Database -> Database . eq procView(QI, DB) = procView2(getTermView(QI, DB), DB) . eq procView2('view_from_to_is_endv['token[T], T', T'', T3], DB) = procView(T3, emptyPreView(downQid(T), parseModExp(T'), parseModExp(T'')), DB) . eq procView2('view_from_to_is_endv['_`{_`}['token[T], T'], T'', T3, T4], DB) = procView(T4, setPars( emptyPreView(downQid(T), parseModExp(T''), parseModExp(T3)), parseParList(T')), procPars(parseParList(T'), DB)) . eq procView('view_from_to_is_endv['token[T], T', T'', T3], DB) = procView(T3, emptyPreView(downQid(T), parseModExp(T'), parseModExp(T'')), insertTermView(downQid(T), 'view_from_to_is_endv['token[T], T', T'', T3], DB)) . eq procView('view_from_to_is_endv['_`{_`}['token[T], T'], T'', T3, T4], DB) = procView(T4, setPars( emptyPreView(downQid(T), parseModExp(T''), parseModExp(T3)), parseParList(T')), procPars(parseParList(T'), insertTermView(downQid(T), 'view_from_to_is_endv['_`{_`}['token[T], T'], T'', T3, T4], DB))) . ceq procView(T, PV, DB) = procViewAux(T, PV, getThOpDeclSet(ME, DB'), getThMsgDeclSet(ME, DB'), getFlatModule(ME, DB'), DB') if preview_from_to_is__endpv(VE, ME, ME', none, none) := PV /\ DB' := database( evalModExp(ME', nil, database(evalModExp(ME, nil, DB)))) . ceq procView(T, PV, DB) = procViewAux(T, PV, getThOpDeclSet(ME, DB':[Database]), getThMsgDeclSet(ME, DB':[Database]), getFlatModule(ME, DB':[Database]), DB':[Database]) if preview_from_to_is__endpv(VE{PDL}, ME, ME', none, none) := PV /\ DB':[Database] := database( evalModExp(ME', PDL, database(evalModExp(ME, PDL, DB)))) . eq procViewAux('__[T, T'], PV, OPDS, MDS, M, DB) *** - OPDS and MDS are, respectively, the set of operation and *** message declarations in the theory part of the source. *** - M is the signature of the source theory. = procViewAux(T', parseDecl(T, PV, OPDS, MDS, M), OPDS, MDS, M, DB) . ceq procViewAux(F[TL], PV, OPDS, MDS, M, DB) = insertView( view VE{PDL} from ME to ME' is solveBubbles( PVMAPS, VDS, VDS', addOps(VDS, M), addOps(VDS', getFlatModule(ME', DB))) endv, DB) if F =/= '__ /\ preview_from_to_is__endpv(VE{PDL}, ME, ME', VDS, PVMAPS) := parseDecl(F[TL], PV, OPDS, MDS, M) /\ VDS' := applyMapsToOps(sortMaps(PVMAPS), none, VDS, M) . ceq procViewAux(F[TL], PV, OPDS, MDS, M, DB) = insertView( view VE from ME to ME' is solveBubbles( PVMAPS, VDS, VDS', addOps(VDS, M), addOps(VDS', getFlatModule(ME', DB))) endv, DB) if F =/= '__ /\ preview_from_to_is__endpv(VE, ME, ME', VDS, PVMAPS) := parseDecl(F[TL], PV, OPDS, MDS, M) /\ VDS' := applyMapsToOps(sortMaps(PVMAPS), none, VDS, M) . eq procViewAux(T, PV, OPDS, MDS, unitError(QIL), DB) = warning(DB, QIL) . endfm ******************************************************************************* *** *** 8.3.3 Command Processing *** *** The function \texttt{procCommand} only handles the \texttt{reduce}, *** \texttt{rewrite}, and \texttt{down} commands. The other commands are *** directly evaluated by the rules for the top-level handling of the *** database (see Section~\ref{database-handling}). The \texttt{procCommand} *** function takes a term, which represents one of these commands, the name of *** the default module, and a database. The result is a list of quoted *** identifiers representing the result of the evaluation of the command that *** will be placed in the read-eval-print loop to be printed in the terminal. *** The \texttt{reduce} and \texttt{rewrite} commands are basically evaluated *** calling the built-in functions \texttt{metaReduce} and *** \texttt{metaRewrite}, respectively. These functions are called with the *** appropriate modules. In the case of commands in which an explicit module *** is not specified the default module is used. *** The preparation of the output for these functions becomes more complex *** when the \texttt{down} command is used. To deal with the \texttt{down} *** command, an auxiliary function \texttt{procCommand2} is introduced, *** returning the term resulting from the evaluation of the command. fmod COMMAND-PROCESSING is pr UNIT-PROCESSING . pr UNIT-META-PRETTY-PRINT . op {_,_} : Term Type ~> ResultPair [ctor] . op {_,_,_} : Term Type Substitution ~> ResultTriple [ctor] . op {_,_,_,_} : Term Type Substitution Context ~> Result4Tuple [ctor] . op {_,_} : Substitution Context ~> MatchPair [ctor] . *** projection functions (from prelude.maude) op getTerm : ResultPair ~> Term . eq getTerm({T:[Term], T':[Type]}) = T:[Term] . op getType : ResultPair ~> Type . eq getType({T:[Term], T':[Type]}) = T':[Type] . op getTerm : ResultTriple ~> Term . eq getTerm({T:[Term], T':[Type], S:[Substitution]}) = T:[Term] . op getType : ResultTriple ~> Type . eq getType({T:[Term], T':[Type], S:[Substitution]}) = T':[Type] . op gTSubstitution : ResultTriple ~> Substitution . eq gTSubstitution({T:[Term], T':[Type], S:[Substitution]}) = S:[Substitution] . op getTerm : Result4Tuple ~> Term . eq getTerm({T:[Term], T':[Type], S:[Substitution], C:[Context]}) = T:[Term] . op getType : Result4Tuple ~> Type . eq getType({T:[Term], T':[Type], S:[Substitution], C:[Context]}) = T':[Type] . op gTSubstitution : Result4Tuple ~> Substitution . eq gTSubstitution({T:[Term], T':[Type], S:[Substitution], C:[Context]}) = S:[Substitution] . op getContext : Result4Tuple ~> Context . eq getContext({T:[Term], T':[Type], S:[Substitution], C:[Context]}) = C:[Context] . op gTSubstitution : MatchPair ~> Substitution . eq gTSubstitution({S:[Substitution], C:[Context]}) = S:[Substitution] . op getContext : MatchPair ~> Context . eq getContext({S:[Substitution], C:[Context]}) = C:[Context] . vars T T' T'' : Term . var TL : TermList . vars DB DB' DB'' : Database . vars M M' : Module . var M? : [Module] . vars ME ME' : ModuleExpression . vars H H' : Header . vars MNS MNS' MNS'' MNS3 MNS4 : Set{ModuleName} . var VE : ViewExp . var VES : Set{ViewExp} . vars I J : Nat . var I? : [Nat] . vars D D' : Bound . var D? : [Bound] . var B : Bool . vars MIS MIS' : Set{ModuleInfo} . var VIS : Set{ViewInfo} . vars PDS PDS' : Set{ParameterDecl} . var QIL : QidList . var SS : SortSet . var SSDS : SubsortDeclSet . var OPDS : OpDeclSet . var OPDS? : [OpDeclSet] . var VDS : OpDeclSet . var MAS : MembAxSet . var EqS : EquationSet . var RlS : RuleSet . vars QI QI' F V : Qid . var IL : ImportList . var TM : [Tuple] . var TMVB : [Tuple] . var TMVBN : [Tuple] . var T? : [Term] . var RP : [ResultPair] . var RT : [ResultTriple] . var Sb? : [Substitution] . var MP? : [MatchPair] . var CD : Condition . sorts Tuple Tuple Tuple . op `{_`,_`,_`} : Term Module OpDeclSet -> Tuple . op `{_`,_`,_`,_`} : Term Module OpDeclSet Bound -> Tuple . op `{_`,_`,_`,_`,_`} : Term Module OpDeclSet Bound Nat -> Tuple . op tupleError : QidList -> [Tuple] . op tupleError : QidList -> [Tuple] . op tupleError : QidList -> [Tuple] . op boundError : QidList -> [Bound] . op getTerm : Tuple ~> Term . op getModule : Tuple ~> Module . op getVars : Tuple ~> OpDeclSet . op getTerm : Tuple ~> Term . op getModule : Tuple ~> Module . op getVars : Tuple ~> OpDeclSet . op getBound : Tuple ~> Bound . op getTerm : Tuple ~> Term . op getModule : Tuple ~> Module . op getVars : Tuple ~> OpDeclSet . op getBound : Tuple ~> Bound . op getNat : Tuple ~> Nat . eq {qidError(QIL), M?, OPDS?} = tupleError(QIL) . eq {qidError(QIL), M?, OPDS?, D?} = tupleError(QIL) . eq {qidError(QIL), M?, OPDS?, D?, I?} = tupleError(QIL) . eq getTerm({T, M, VDS}) = T . eq getTerm(tupleError(QIL)) = qidError(QIL) . eq getModule({T, M, VDS}) = M . eq getModule(tupleError(QIL)) = unitError(QIL) . eq getVars({T, M, VDS}) = VDS . eq getVars(tupleError(QIL)) = opDeclError(QIL) . eq getTerm({T, M, VDS, D}) = T . eq getTerm(tupleError(QIL)) = qidError(QIL) . eq getModule({T, M, VDS, D}) = M . eq getModule(tupleError(QIL)) = unitError(QIL) . eq getVars({T, M, VDS, D}) = VDS . eq getVars(tupleError(QIL)) = opDeclError(QIL) . eq getBound({T, M, VDS, D}) = D . eq getBound(tupleError(QIL)) = boundError(QIL) . eq getTerm({T, M, VDS, D, I}) = T . eq getTerm(tupleError(QIL)) = qidError(QIL) . eq getModule({T, M, VDS, D, I}) = M . eq getModule(tupleError(QIL)) = unitError(QIL) . eq getVars({T, M, VDS, D, I}) = VDS . eq getVars(tupleError(QIL)) = opDeclError(QIL) . eq getBound({T, M, VDS, D, I}) = D . eq getBound(tupleError(QIL)) = boundError(QIL) . eq getNat({T, M, VDS, D, I}) = I . eq getNat(tupleError(QIL)) = numberError(QIL) . op procCommand : Term ModuleExpression Database -> QidList . op procParse : ModuleExpression Module Term OpDeclSet Database -> QidList . op procRed : ModuleExpression Module Term OpDeclSet Database -> QidList . op solveBubblesRed : Term Module Bool OpDeclSet Database -> [Tuple] . op solveBubblesRed2 : Term Database -> [Tuple] . op solveBubblesRed3 : Term Module OpDeclSet Database -> [Tuple] . op procRew : ModuleExpression Module Term Bound OpDeclSet Database -> QidList . op solveBubblesRew : Term Module Bool Bound OpDeclSet Database -> [Tuple] . op solveBubblesRew2 : Term Module Bool OpDeclSet Database -> [Tuple] . op procFrew : ModuleExpression Module Term Bound Nat OpDeclSet Database -> QidList . op solveBubblesFrew : Term Module Bool Bound Nat OpDeclSet Database -> [Tuple] . op solveBubblesFrew2 : Term Module Bool Nat OpDeclSet Database -> [Tuple] . op procSearch : ModuleExpression 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 procMatch : ModuleExpression Module Term Term Qid Bound OpDeclSet Database -> QidList . op procMatch2 : Module Term Term Condition Qid Bound -> QidList . op procMatch3 : Module Term Term Condition Qid Bound Nat -> QidList . op solveBubblesMatch : Module Module Term Term Qid Bound Bool OpDeclSet Database ~> QidList . op solveBubblesMatch2 : Module Term Term Qid Bound OpDeclSet ~> QidList . op eMetaPrettyPrint : Module Substitution -> QidList . eq eMetaPrettyPrint(M, V <- T ; Sb:Substitution) = V '--> '\s eMetaPrettyPrint(M, T) if eMetaPrettyPrint(M, Sb:Substitution) == nil then nil else '; eMetaPrettyPrint(M, Sb:Substitution) fi . eq eMetaPrettyPrint(M, (none).Substitution) = nil . op procCommandUp : ModuleExpression Module Term Module OpDeclSet Database -> Term . op procRedUp : ModuleExpression Module Term OpDeclSet Database -> Term . op procRewUp : ModuleExpression Module Term Bound OpDeclSet Database -> Term . op procFrewUp : ModuleExpression Module Term Bound Nat OpDeclSet Database -> Term . *** Processing of commands. eq procCommand('parse_.['bubble[T]], ME, DB) = if compiledModule(ME, DB) then procParse(ME, getFlatModule(ME, DB), 'bubble[T], getVars(ME, DB), DB) else procParse(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 'bubble[T], getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB))) fi . eq procCommand('reduce_.['bubble[T]], ME, DB) = procCommand('red_.['bubble[T]], ME, DB) . eq procCommand('red_.['bubble[T]], ME, DB) = if compiledModule(ME, DB) then procRed(ME, getFlatModule(ME, DB), 'bubble[T], getVars(ME, DB), DB) else procRed(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 'bubble[T], getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB))) fi . eq procCommand('rewrite_.['bubble[T]], ME, DB) = procCommand('rew_.['bubble[T]], ME, DB) . eq procCommand('rew_.['bubble[T]], ME, DB) = if compiledModule(ME, DB) then procRew(ME, getFlatModule(ME, DB), 'bubble[T], unbounded, getVars(ME, DB), DB) else procRew(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 'bubble[T], unbounded, getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB))) fi . eq procCommand('frewrite_.['bubble[T]], ME, DB) = procCommand('frew_.['bubble[T]], ME, DB) . eq procCommand('frew_.['bubble[T]], ME, DB) = if compiledModule(ME, DB) then procFrew(ME, getFlatModule(ME, DB), 'bubble[T], unbounded, 1, getVars(ME, DB), DB) else procFrew(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 'bubble[T], unbounded, 1, getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB))) fi . eq procCommand('search_=>1_.['bubble[T], 'bubble[T']], ME, DB) = if compiledModule(ME, DB) then procSearch(ME, getFlatModule(ME, DB), 'bubble[T], 'bubble[T'], '*, 1, 0, getVars(ME, DB), DB) else procSearch(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 'bubble[T], 'bubble[T'], '*, 1, 0, getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB))) fi . eq procCommand('search_=>*_.['bubble[T], 'bubble[T']], ME, DB) = if compiledModule(ME, DB) then procSearch(ME, getFlatModule(ME, DB), 'bubble[T], 'bubble[T'], '*, unbounded, 0, getVars(ME, DB), DB) else procSearch(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 'bubble[T], 'bubble[T'], '*, unbounded, 0, getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB))) fi . eq procCommand('search_=>+_.['bubble[T], 'bubble[T']], ME, DB) = if compiledModule(ME, DB) then procSearch(ME, getFlatModule(ME, DB), 'bubble[T], 'bubble[T'], '+, unbounded, 0, getVars(ME, DB), DB) else procSearch(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 'bubble[T], 'bubble[T'], '+, unbounded, 0, getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB))) fi . eq procCommand('search_=>!_.['bubble[T], 'bubble[T']], ME, DB) = if compiledModule(ME, DB) then procSearch(ME, getFlatModule(ME, DB), 'bubble[T], 'bubble[T'], '!, unbounded, 0, getVars(ME, DB), DB) else procSearch(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 'bubble[T], 'bubble[T'], '!, unbounded, 0, getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB))) fi . eq procCommand('match_<=?_.['bubble[T], 'bubble[T']], ME, DB) = if compiledModule(ME, DB) then procMatch(ME, getFlatModule(ME, DB), 'bubble[T], 'bubble[T'], 'match, 0, getVars(ME, DB), DB) else procMatch(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 'bubble[T], 'bubble[T'], 'match, 0, getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB))) fi . eq procCommand('xmatch_<=?_.['bubble[T], 'bubble[T']], ME, DB) = if compiledModule(ME, DB) then procMatch(ME, getFlatModule(ME, DB), 'bubble[T], 'bubble[T'], 'xmatch, 0, getVars(ME, DB), DB) else procMatch(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), 'bubble[T], 'bubble[T'], 'xmatch, 0, getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB))) fi . ceq procCommand('down_:_[T, T'], ME, DB) = if T'':[Term] :: Term then ('\b 'result '\o '\s eMetaPrettyPrint(leastSort(M, T'':[Term])) '\s '\b ': '\o '\n '\s '\s eMetaPrettyPrint(M, T'':[Term])) else ('\r 'Error: '\o 'Incorrect 'input. '\n) fi if DB' := database(evalModExp(ME, DB)) /\ DB'' := database(evalModExp(parseModExp(T), DB')) /\ ME' := modExp(evalModExp(parseModExp(T), DB')) /\ M := getFlatModule(ME', DB'') /\ T'':[Term] := procCommandUp(ME, M, T', getFlatModule(ME, DB''), getVars(ME, DB''), DB''). eq procCommandUp(ME, M, 'down_:_[T, T'], M', VDS, DB) = downTerm( procCommandUp(ME, getFlatModule(parseModExp(T), database(evalModExp(parseModExp(T), DB))), T', M', VDS, DB)) . eq procCommandUp(ME, M, 'red_.['bubble[T]], M', VDS, DB) = downTerm(procRedUp(ME, M', 'bubble[T], VDS, DB)) . eq procCommandUp(ME, M, 'reduce_.['bubble[T]], M', VDS, DB) = downTerm(procRedUp(ME, M', 'bubble[T], VDS, DB)) . eq procCommandUp(ME, M, 'rew_.['bubble[T]], M', VDS, DB) = downTerm(procRewUp(ME, M', 'bubble[T], unbounded, VDS, DB)) . eq procCommandUp(ME, M, 'rewrite_.['bubble[T]], M', VDS, DB) = downTerm(procRewUp(ME, M, 'bubble[T], unbounded, VDS, DB)) . eq procCommandUp(ME, M, 'frew_.['bubble[T]], M', VDS, DB) = downTerm(procFrewUp(ME, M', 'bubble[T], unbounded, 0, VDS, DB)) . eq procCommandUp(ME, M, 'frewrite_.['bubble[T]], M', VDS, DB) = downTerm(procFrewUp(ME, M, 'bubble[T], unbounded, 0, VDS, DB)) . ceq procRedUp(ME, M, T, VDS, DB) = if metaReduce(getModule(TM), getTerm(TM)) :: ResultPair then getTerm(metaReduce(getModule(TM), getTerm(TM))) else qidError('\r 'Error: '\o 'Incorrect 'command. '\n) fi if TM := solveBubblesRed(T, M, included('META-MODULE, getImports(getTopModule(ME, DB)), DB), VDS, DB) . ceq procRewUp(ME, M, T, D, VDS, DB) = if metaRewrite(getModule(TMVB), getTerm(TMVB), getBound(TMVB)) :: ResultPair then getTerm(metaRewrite(getModule(TMVB), getTerm(TMVB), getBound(TMVB))) else qidError('\r 'Error: '\o 'Incorrect 'command. '\n) fi if TMVB := solveBubblesRew(T, M, included('META-MODULE, getImports(getTopModule(ME, DB)), DB), D, VDS, DB) . ceq procFrewUp(ME, M, T, D, I, VDS, DB) = if metaFrewrite( getModule(TMVBN), getTerm(TMVBN), getBound(TMVBN), getNat(TMVBN)) :: ResultPair then getTerm( metaFrewrite(getModule(TMVBN), getTerm(TMVBN), getBound(TMVBN), getNat(TMVBN))) else qidError('\r 'Error: '\o 'Incorrect 'command. '\n) fi if TMVBN := solveBubblesFrew(T, M, included('META-MODULE, getImports(getTopModule(ME, DB)), DB), D, I, VDS, DB) . ceq procParse(ME, M, T, VDS, DB) = if leastSort(getModule(TM), getTerm(TM)) :: Type then (eMetaPrettyPrint(leastSort(getModule(TM), getTerm(TM))) '\s '\b ': '\o '\n '\s '\s eMetaPrettyPrint(getModule(TM), getTerm(TM)) '\n) else getMsg(getTerm(TM)) fi if TM := solveBubblesRed(T, M, included('META-MODULE, getImports(getTopModule(ME, DB)), DB), VDS, DB) . eq procParse(ME, unitError(QIL), T, VDS, DB) = QIL . eq procParse(ME, noModule, T, VDS, DB) = getMsg(DB) . ceq procRed(ME, M, T, VDS, DB) = if metaReduce(getModule(TM), getTerm(TM)) :: ResultPair then ('\b 'reduce 'in '\o eMetaPrettyPrint(getName(getModule(TM))) '\b ': '\o '\n '\s '\s eMetaPrettyPrint(getModule(TM), getTerm(TM)) '\n '\b 'result '\o '\s eMetaPrettyPrint(getType(metaReduce(getModule(TM), getTerm(TM)))) '\s '\b ': '\o '\n '\s '\s eMetaPrettyPrint(getModule(TM), getTerm(metaReduce(getModule(TM), getTerm(TM)))) '\n) else getMsg(getTerm(metaReduce(getModule(TM), getTerm(TM)))) fi if TM := solveBubblesRed(T, M, included('META-MODULE, getImports(getTopModule(ME, DB)), DB), VDS, DB) . eq procRed(ME, unitError(QIL), T, VDS, DB) = QIL . eq procRed(ME, noModule, T, VDS, DB) = getMsg(DB) . eq metaReduce(unitError(QIL), T) = {qidError(QIL), '`[Term`]} . eq metaReduce(U:[Module], qidError(QIL)) = {qidError(QIL), '`[Term`]} . ceq solveBubblesRed('bubble[QI], M, B, VDS, DB) = if T? :: Term then {T?, M, VDS} else tupleError( '\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, VDS} else if metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), '@RedInPart@) :: ResultPair then solveBubblesRed2( getTerm( metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), '@RedInPart@)), DB) else tupleError('\r 'Warning: '\o printSyntaxError( metaParse(GRAMMAR-RED, downQidList('__[TL, ''..Qid]), '@RedInPart@), downQidList('__[TL, ''..Qid])) '\n '\r 'Error: '\o 'no 'parse 'for downQidList('__[TL, ''..Qid]) '\n) fi fi if T? := solveBubbles('bubble['__[TL]], M, B, VDS, DB) . *** There is some problem parsing 'in_:_ in solveBubblesRed, but it *** seems to work with the additional '. ceq solveBubblesRed2('in_:_.[T, T'], DB) = if unitInDb(ME, DB') then solveBubblesRed3(T', getFlatModule(ME, DB'), getVars(ME, DB'), DB') else tupleError('\r 'Error: '\o 'It 'is 'not 'possible 'to 'compile eMetaPrettyPrint(ME) '. '\n) fi if < DB' ; ME > := evalModExp(parseModExp(T), DB) . eq solveBubblesRed2('in_:_.[T, T'], DB) = tupleError('\r 'Error: '\o 'It 'isn't 'possible 'to 'compile eMetaPrettyPrint(parseModExp(T)) '. '\n) [owise] . eq solveBubblesRed3(T, M, VDS, DB) = {solveBubbles(T, M, included('META-MODULE, getImports(getTopModule(getName(M), DB)), DB), VDS, DB), M, VDS} . op GRAMMAR-RED : -> FModule [memo] . 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 'poly 'memo 'memoization 'iter 'frozen 'config 'object 'msg)))] . op 'neTokenList : 'QidList -> '@NeTokenList@ [special( (id-hook('Bubble, '1 '-1 '`( '`)) op-hook('qidListSymbol, '__, 'QidList 'QidList, 'QidList) op-hook('qidSymbol, ', 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(ME, M, T, D, VDS, DB) = if RP :: ResultPair then ('\b 'rewrite 'in '\o eMetaPrettyPrint(getName(getModule(TMVB))) '\b ': '\o '\n '\s '\s eMetaPrettyPrint(getModule(TMVB), getTerm(TMVB)) '\n '\b 'result '\o '\s eMetaPrettyPrint(getType(RP)) '\s '\b ': '\o '\n '\s '\s eMetaPrettyPrint(getModule(TMVB), getTerm(RP)) '\n) else getMsg(getTerm(TMVB)) fi if TMVB := solveBubblesRew(T, M, included('META-MODULE, getImports(getTopModule(ME, DB)), DB), D, VDS, DB) /\ RP := metaRewrite(getModule(TMVB), getTerm(TMVB), getBound(TMVB)) . eq procRew(ME, unitError(QIL), T, D, VDS, DB) = qidError(QIL) . eq solveBubblesRew('bubble[QI], M, B, D, VDS, DB) = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term then {solveBubbles('bubble[QI], M, B, VDS, DB), M, VDS, unbounded} else tupleError( '\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, VDS, 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)), getVars(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) :: Tuple then {getTerm(solveBubblesRed(T', M, B, VDS, DB)), getModule(solveBubblesRed(T', M, B, VDS, DB)), getVars(solveBubblesRed(T', M, B, VDS, DB)), downNat(downMetaNat(T))} else tupleError( '\r 'Error: '\o 'Incorrect 'command. '\n) fi . op GRAMMAR-REW : -> FModule [memo] . 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(ME, M, T, D, I, VDS, DB) = if RP :: ResultPair then ('\b 'frewrite 'in '\o eMetaPrettyPrint(getName(getModule(TMVBN))) '\b ': '\o '\n '\s '\s eMetaPrettyPrint(getModule(TMVBN), getTerm(TMVBN)) '\n '\b 'result '\o '\s eMetaPrettyPrint(getType(RP)) '\s '\b ': '\o '\n '\s '\s eMetaPrettyPrint(getModule(TMVBN), getTerm(RP)) '\n) else ('\r 'Error: '\o 'Incorrect 'command. '\n) fi if TMVBN := solveBubblesFrew(T, M, included('META-MODULE, getImports(getTopModule(ME, DB)), DB), D, I, VDS, DB) /\ RP := metaFrewrite(getModule(TMVBN), getTerm(TMVBN), getBound(TMVBN), getNat(TMVBN)) . eq procFrew(ME, unitError(QIL), T, D, I, VDS, DB) = qidError(QIL) . eq solveBubblesFrew('bubble[QI], M, B, D, I, VDS, DB) = if solveBubbles('bubble[QI], M, B, VDS, DB) :: Term then {solveBubbles('bubble[QI], M, B, VDS, DB), M, VDS, unbounded, I} else tupleError( '\r 'Error: '\o 'no 'parse 'for downQidList(QI) '\n) fi . eq solveBubblesFrew('bubble['__[TL]], M, B, D, I, VDS, DB) = if solveBubbles('bubble['__[TL]], M, B, VDS, DB) :: Term then {solveBubbles('bubble['__[TL]], M, B, VDS, DB), M, VDS, unbounded, I} else if metaParse(GRAMMAR-FREW, downQidList('__[TL, ''..Qid]), '@FrewNuPart@) :: ResultPair then solveBubblesFrew2( getTerm( metaParse(GRAMMAR-FREW, downQidList('__[TL, ''..Qid]), '@FrewNuPart@)), M, B, I, VDS, DB) else {getTerm(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), getModule(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), getVars(solveBubblesRed('bubble['__[TL]], M, B, VDS, DB)), unbounded, I} fi fi . *** There is some problem parsing _ in solveBubblesRed, but it *** seems to work with the additional '. eq solveBubblesFrew2('`[_`]_.['token[T], T'], M, B, I, VDS, DB) = if downNat(downMetaNat(T)) :: Nat and-then solveBubblesRed(T', M, B, VDS, DB) :: Tuple then {getTerm(solveBubblesRed(T', M, B, VDS, DB)), getModule(solveBubblesRed(T', M, B, VDS, DB)), getVars(solveBubblesRed(T', M, B, VDS, DB)), downNat(downMetaNat(T)), I} else tupleError( '\r 'Error: '\o 'Incorrect 'command. '\n) fi . eq solveBubblesFrew2('`[_`,_`]_.['token[T], 'token[T'], T''], M, B, I, VDS, DB) = if downNat(downMetaNat(T)) :: Nat and-then downNat(downMetaNat(T')) :: Nat and-then solveBubblesRed(T'', M, B, VDS, DB) :: Tuple then {getTerm(solveBubblesRed(T'', M, B, VDS, DB)), getModule(solveBubblesRed(T'', M, B, VDS, DB)), getVars(solveBubblesRed(T'', M, B, VDS, DB)), downNat(downMetaNat(T)), downNat(downMetaNat(T'))} else tupleError( '\r 'Error: '\o 'Incorrect 'command. '\n) fi . op GRAMMAR-FREW : -> FModule [memo] . 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)} . *** SEARCH ceq procSearch(ME, M, T, T', QI, D, I, VDS, DB) *** the number I in search is not a bound, but the solution number = if solveBubblesRl(T, T', M, B, VDS, DB) :: Term then procSearch2(addOps(VDS, M), lhs(solveBubblesRl(T, T', M, B, VDS, DB)), rhs(solveBubblesRl(T, T', M, B, VDS, DB)), nil, QI, D, I) else if solveBubblesRew(T, M, B, I, VDS, DB) :: Tuple 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( getModule(solveBubblesRew(T, M, B, I, VDS, DB))))), getTerm(solveBubblesRew(T, M, B, I, VDS, DB)), T', QI, D, (if getBound(solveBubblesRew(T, M, B, I, VDS, DB)) == unbounded then 0 else getBound(solveBubblesRew(T, M, B, I, VDS, DB)) fi), B, getVars(solveBubblesRew(T, M, B, I, VDS, DB)), DB) else ('\r 'Error: '\o 'Incorrect 'search 'command. '\n) fi fi if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) . ceq solveBubblesSearch(M, M', T, 'bubble[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('bubble[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 solveBubblesSearch2(M, T, QI, QI', D, I, VDS) = procSearch2(M, T, constsToVars(QI, VDS), nil, QI', D, I) . eq solveBubblesSearch2(M, T, F[T], QI, D, I, VDS) = procSearch2(M, T, constsToVars(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, constsToVars(F[T', T''], VDS), nil, QI, D, I) fi . eq solveBubblesSearch2(M, T, F[T', T'', TL], QI, D, I, VDS) = procSearch2(M, T, constsToVars(F[T', T'', TL], VDS), nil, QI, D, I) . ceq procSearch2(M, T, T', CD, QI, D, I) = if RT :: ResultTriple then ('search if I == 0 then nil else '\s '`[ qid(string(I, 10)) '`] '\s fi 'in eMetaPrettyPrint(getName(M)) ': eMetaPrettyPrint(M, T) '\s qid("=>" + string(QI)) '\s eMetaPrettyPrint(M, T') '. '\n '\n 'Solution '1 if gTSubstitution(RT) == none then '\n 'empty 'substitution else '\n eMetaPrettyPrint(M, gTSubstitution(RT)) fi procSearch3(M, T, T', CD, QI, D, 1, I)) else if RT == failure then ('search if I == 0 then nil else '\s '`[ qid(string(I, 10)) '`] '\s fi 'in eMetaPrettyPrint(getName(M)) ': eMetaPrettyPrint(M, T) '\s qid("=>" + string(QI)) '\s eMetaPrettyPrint(M, T') '. '\n '\n 'No 'solution. '\n) else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'search 'command. '\n fi fi if 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 gTSubstitution(metaSearch(M, T, T', CD, QI, D, I)) == none then '\n 'empty 'substitution else '\n eMetaPrettyPrint(M, gTSubstitution( metaSearch(M, T, T', CD, QI, D, I))) fi procSearch3(M, T, T', CD, QI, D, I + 1, J)) else ('\n '\n 'No 'more 'solutions.) fi else nil fi . *** MATCH ceq procMatch(ME, M, T, T', QI, I, VDS, DB) *** the number I in search is not a bound, but the number of solutions = if solveBubblesRl(T, T', M, B, VDS, DB) :: Term then procMatch2(addOps(VDS, M), lhs(solveBubblesRl(T, T', M, B, VDS, DB)), rhs(solveBubblesRl(T, T', M, B, VDS, DB)), nil, QI, I) else if solveBubblesRew(T, M, B, I, VDS, DB) :: Tuple then solveBubblesMatch( getModule(solveBubblesRew(T, M, B, I, VDS, DB)), addOps( op '_s.t._. : leastSort( getModule(solveBubblesRew(T, M, B, I, VDS, DB)), getTerm(solveBubblesRew(T, M, B, I, VDS, DB))) '@Condition -> 'PatternCondition [none] . op '_such`that_. : leastSort( getModule(solveBubblesRew(T, M, B, I, VDS, DB)), getTerm(solveBubblesRew(T, M, B, I, VDS, DB))) '@Condition -> 'PatternCondition [none] ., addSorts('PatternCondition, addInfoConds( getModule(solveBubblesRew(T, M, B, I, VDS, DB))))), getTerm(solveBubblesRew(T, M, B, I, VDS, DB)), T', QI, (if getBound(solveBubblesRew(T, M, B, I, VDS, DB)) == unbounded then 0 else getBound(solveBubblesRew(T, M, B, I, VDS, DB)) fi), B, getVars(solveBubblesRew(T, M, B, I, VDS, DB)), DB) else getMsg(getTerm(solveBubblesRew(T, M, B, I, VDS, DB))) ----('\r 'Error: '\o 'Incorrect 'match 'command. '\n) fi fi if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) . ceq solveBubblesMatch(M, M', T, 'bubble[QI], QI', I, B, VDS, DB) = if T?:[Term] :: Term then procMatch2(M, T, T?:[Term], nil, QI', I) else ('\r 'Error: '\o 'Incorrect 'use 'of 'the 'match 'command. '\n) fi if T?:[Term] := solveBubbles('bubble[QI], M, B, VDS, DB) . ceq solveBubblesMatch(M, M', T, 'bubble['__[TL]], QI, I, B, VDS, DB) = if T?:[Term] :: Term then procMatch2(M, T, T?:[Term], nil, QI, I) else if metaParse(M', downQidList('__[TL, ''..Qid]), 'PatternCondition) :: ResultPair then solveBubblesMatch2(M, T, getTerm( metaParse(M', downQidList('__[TL, ''..Qid]), 'PatternCondition)), QI, I, VDS) else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'match 'command. '\n fi fi if T?:[Term] := solveBubbles('bubble['__[TL]], M, B, VDS, DB) . eq solveBubblesMatch2(M, T, QI, QI', I, VDS) = procMatch2(M, T, constsToVars(QI, VDS), nil, QI', I) . eq solveBubblesMatch2(M, T, F[T], QI, I, VDS) = procMatch2(M, T, constsToVars(F[T], VDS), nil, QI, I) . eq solveBubblesMatch2(M, T, F[T', T''], QI, I, VDS) = if F == '_s.t._. or F == '_such`that_. then procMatch2(M, T, T', parseCond(T'', VDS), QI, I) else procMatch2(M, T, constsToVars(F[T', T''], VDS), nil, QI, I) fi . eq solveBubblesMatch2(M, T, F[T', T'', TL], QI, I, VDS) = procMatch2(M, T, constsToVars(F[T', T'', TL], VDS), nil, QI, I) . ceq procMatch2(M, T, T', CD, 'match, I) = if Sb? :: Substitution then ('match if I == 0 then nil else '\s '`[ qid(string(I, 10)) '`] '\s fi 'in eMetaPrettyPrint(getName(M)) ': eMetaPrettyPrint(M, T) '\s '<=? '\s eMetaPrettyPrint(M, T') '. '\n '\n 'Solution '1 if Sb? == none then '\n 'empty 'substitution else '\n eMetaPrettyPrint(M, Sb?) fi procMatch3(M, T, T', CD, 'match, I, 1)) else if Sb? == noMatch then ('match if I == 0 then nil else '\s '`[ qid(string(I, 10)) '`] '\s fi 'in eMetaPrettyPrint(getName(M)) ': eMetaPrettyPrint(M, T) '\s '<=? '\s eMetaPrettyPrint(M, T') '. '\n '\n 'No 'solution. '\n) else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'match 'command. '\n fi fi if Sb? := metaMatch(M, T, T', CD, 0) . ceq procMatch2(M, T, T', CD, 'xmatch, I) = if MP? :: MatchPair then ('xmatch if I == 0 then nil else '\s '`[ qid(string(I, 10)) '`] '\s fi 'in eMetaPrettyPrint(getName(M)) ': eMetaPrettyPrint(M, T) '\s '<=? '\s eMetaPrettyPrint(M, T') '. '\n '\n 'Solution '1 if gTSubstitution(MP?) == none then '\n 'empty 'substitution else '\n eMetaPrettyPrint(M, gTSubstitution(MP?)) fi procMatch3(M, T, T', CD, 'xmatch, I, 1)) else if MP? == noMatch then ('xmatch if I == 0 then nil else '\s '`[ qid(string(I, 10)) '`] '\s fi 'in eMetaPrettyPrint(getName(M)) ': eMetaPrettyPrint(M, T) '\s '<=? '\s eMetaPrettyPrint(M, T') '. '\n '\n 'No 'solution. '\n) else '\r 'Error: '\o 'Incorrect 'use 'of 'the 'xmatch 'command. '\n fi fi if MP? := metaXmatch(M, T, T', CD, 0, unbounded, 0) . eq procMatch3(M, T, T', CD, 'match, I, J) = if I == 0 or J < I then if metaMatch(M, T, T', CD, J) :: Substitution then ('\n '\n 'Solution qid(string(J + 1, 10)) if metaMatch(M, T, T', CD, J) == none then '\n 'empty 'substitution else '\n eMetaPrettyPrint(M, metaMatch(M, T, T', CD, J)) fi procMatch3(M, T, T', CD, 'match, I, J + 1)) else ('\n '\n 'No 'more 'solutions.) fi else nil fi . eq procMatch3(M, T, T', CD, 'xmatch, I, J) = if I == 0 or J < I then if metaXmatch(M, T, T', CD, 0, unbounded, J) :: MatchPair then ('\n '\n 'Solution qid(string(J + 1, 10)) if gTSubstitution(metaXmatch(M, T, T', CD, 0, unbounded, J)) == none then '\n 'empty 'substitution else '\n eMetaPrettyPrint(M, gTSubstitution( metaXmatch(M, T, T', CD, 0, unbounded, J))) fi procMatch3(M, T, T', CD, 'xmatch, I, J + 1)) else ('\n '\n 'No 'more 'solutions.) fi else nil fi . 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 ***Core Maude, object-oriented declarations cannot be given directly. *** Instead, the equivalent declarations desugaring the desired *** object-oriented declarations have to be specified. We use also the same *** conventions discussed in Section~\ref{omod2mod} regarding the use of *** variables instead of class names in the objects and in the addition of *** variables of sort \texttt{AttributeSet} to range over the additional *** attributes. As we shall see in Chapter~\ref{crc}, this convention will *** allow us to extend the Full Maude system in a very simple and clean way. *** To allow the use of the object-oriented notation the predefined module *** \texttt{CONFIGURATION}, presented in Section~\ref{omod2mod}, is included *** in the following module \texttt{DATABASE-HANDLING}. mod DATABASE-HANDLING is inc META-LEVEL . inc CONFIGURATION . pr VIEW-META-PRETTY-PRINT . pr VIEW-PROCESSING . pr COMMAND-PROCESSING . pr PREDEF-UNITS . var F : Qid . var QIL : QidList . vars T T' T'' T3 : Term . var TL : TermList . var DB DB' : Database . vars ME ME' ME'' : ModuleExpression . vars QIL' QIL'' : QidList . vars MNS MNS' MNS'' MNS3 MNS4 : Set{ModuleName} . var VE : ViewExp . var VES : Set{ViewExp} . vars MIS MIS' : Set{ModuleInfo} . var VIS : Set{ViewInfo} . vars PDS PDS' : Set{ParameterDecl} . var B : Bool . var I : Import . var IL : ImportList . var MN : ModuleName . op initialDatabase : -> Database . eq initialDatabase = insTermModule('CONFIGURATION+, CONFIGURATION+, insTermModule('META-MODULE, addOps(getOps(UP), addSorts(getSorts(UP), addImports(getImports(UP), upModule('META-MODULE, false)))), insertTermView('Bool, ('view_from_to_is_endv['token[''Bool.Qid],'token[''TRIV.Qid],'token[ ''BOOL.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Bool.Qid]]]), insertTermView('DEFAULT, ('view_from_to_is_endv['token[''DEFAULT.Qid],'token[''TRIV.Qid],'token[ ''DEFAULT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ ''Elt.Qid]]]), insertTermView('Float, ('view_from_to_is_endv['token[''Float.Qid],'token[''TRIV.Qid],'token[ ''FLOAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ ''Float.Qid]]]), insertTermView('Float0, ('view_from_to_is_endv['token[''Float0.Qid],'token[''DEFAULT.Qid], 'token[''FLOAT.Qid],'__['sort_to_.['sortToken[''Elt.Qid],'sortToken[ ''Float.Qid]], 'op_to`term_.['bubble[''0.Qid],'bubble[''0.0.Qid]]]]), insertTermView('Float<, ('view_from_to_is_endv['token[''Float<.Qid],'token[''TAO-SET.Qid], 'token[''FLOAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ ''Float.Qid]]]), insertTermView('Int, ('view_from_to_is_endv['token[''Int.Qid],'token[''TRIV.Qid],'token[ ''INT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Int.Qid]]]), insertTermView('Int0, ('view_from_to_is_endv['token[''Int0.Qid],'token[''DEFAULT.Qid],'token[ ''INT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Int.Qid]]]), insertTermView('Int<, ('view_from_to_is_endv['token[''Int<.Qid],'token[''TAO-SET.Qid],'token[ ''INT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Int.Qid]]]), insertTermView('Nat, ('view_from_to_is_endv['token[''Nat.Qid],'token[''TRIV.Qid],'token[ ''NAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Nat.Qid]]]), insertTermView('Nat0, ('view_from_to_is_endv['token[''Nat0.Qid],'token[''DEFAULT.Qid],'token[ ''NAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Nat.Qid]]]), insertTermView('Nat<, ('view_from_to_is_endv['token[''Nat<.Qid],'token[''TAO-SET.Qid],'token[ ''NAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Nat.Qid]]]), insertTermView('Qid, ('view_from_to_is_endv['token[''Qid.Qid],'token[''TRIV.Qid],'token[ ''QID.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Qid.Qid]]]), insertTermView('Qid0, ('view_from_to_is_endv['token[''Qid0.Qid],'token[''DEFAULT.Qid],'token[ ''QID.Qid],'__['sort_to_.['sortToken[''Elt.Qid],'sortToken[''Qid.Qid]], 'op_to`term_.['bubble[''0.Qid],'bubble['''.Qid]]]]), insertTermView('Rat, ('view_from_to_is_endv['token[''Rat.Qid],'token[''TRIV.Qid],'token[ ''RAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Rat.Qid]]]), insertTermView('Rat0, ('view_from_to_is_endv['token[''Rat0.Qid],'token[''DEFAULT.Qid],'token[ ''RAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Rat.Qid]]]), insertTermView('Rat<, ('view_from_to_is_endv['token[''Rat<.Qid],'token[''TAO-SET.Qid],'token[ ''RAT.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[''Rat.Qid]]]), insertTermView('String, ('view_from_to_is_endv['token[''String.Qid],'token[''TRIV.Qid],'token[ ''STRING.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ ''String.Qid]]]), insertTermView('String0, ('view_from_to_is_endv['token[''String0.Qid],'token[''DEFAULT.Qid], 'token[''STRING.Qid],'__['sort_to_.['sortToken[''Elt.Qid],'sortToken[ ''String.Qid]],'op_to`term_.['bubble[''0.Qid],'bubble[''"".Qid]]]]), insertTermView('String<, ('view_from_to_is_endv['token[''String<.Qid],'token[''TAO-SET.Qid], 'token[''STRING.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ ''String.Qid]]]), insertTermView('TAO-SET, ('view_from_to_is_endv['token[''TAO-SET.Qid],'token[''TRIV.Qid],'token[ ''TAO-SET.Qid],'sort_to_.['sortToken[''Elt.Qid],'sortToken[ ''Elt.Qid]]]), emptyDatabase)))))))))))))))))))))) . ***( eq initialDatabase = insTermModule('CONFIGURATION+, CONFIGURATION+, insTermModule('TRIV, upModule('TRIV, false), insTermModule('CONFIGURATION, upModule('CONFIGURATION, false), insTermModule('META-LEVEL, upModule('META-LEVEL, false), insTermModule('META-MODULE, addDecls(upModule('META-MODULE, false), UP), insTermModule('MOD-EXPRS, upModule('MOD-EXPRS, false), insTermModule('OPERATOR-ATTRIBUTES, upModule('OPERATOR-ATTRIBUTES, false), insTermModule('EXTENDED-SORTS, upModule('EXTENDED-SORTS, false), insTermModule('META-TERM, upModule('META-TERM, false), insTermModule('QID-LIST, upModule('QID-LIST, false), insTermModule('QID, upModule('QID, false), insTermModule('CONVERSION, upModule('CONVERSION, false), insTermModule('STRING, upModule('STRING, false), insTermModule('FLOAT, upModule('FLOAT, false), insTermModule('RAT, upModule('RAT, false), insTermModule('INT, upModule('INT, false), insTermModule('NAT, upModule('NAT, false), insTermModule('IDENTICAL, upModule('IDENTICAL, false), insTermModule('EXT-BOOL, upModule('EXT-BOOL, false), insTermModule('TRUTH-VALUE, upModule('TRUTH-VALUE, false), insTermModule('TRUTH, upModule('TRUTH, false), insTermModule('BOOL, upModule('BOOL, false), emptyDatabase)))))))))))))))))))))) . ) *** 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 :_ : Header -> Attribute . var Atts : AttributeSet . var X@Database : DatabaseClass . var O : Oid . *** Next, we introduce an auxiliary function \texttt{parseHeader} to parse *** names of user-defined modules, and a constant \texttt{nilTermList} of sort *** \texttt{TermList}. Note that the name of a user-defined module must be a *** single identifier (a token) or, for parameterized modules, its name---a *** single identifier---and its interface. op parseHeader : Term -> Qid . eq parseHeader('token[T]) = downQid(T) . ----eq parseHeader('_`(_`)['token[T], T']) = downQid(T) . eq parseHeader('_`{_`}['token[T], T']) = downQid(T) . op nilTermList : -> TermList . *** Finally, we present the rules processing the inputs of the database. These *** rules define the behavior of the system for the different commands, *** modules, theories, and views entered into the system. For example, the *** first rule processes the different types of modules entered to the system. *** Note that the operators declared as constructors of sort \texttt{PreModule} *** in the signature of Full Maude, given in *** Appendix~\ref{signature-full-maude}, are declared with two arguments, *** namely the name of the unit, or its name + its interface, and the list *** of declarations of such a unit. crl [module] : < O : X@Database | db : DB, input : (F[T, T']), output : nil, default : ME, Atts > => < O : X@Database | db : procModule(F[T, T'], DB), input : nilTermList, output : ('Introduced 'module header2Qid(parseHeader(T)) '\n), default : parseHeader(T), Atts > if (F == 'fmod_is_endfm) or-else ((F == 'obj_is_endo) or-else ((F == 'obj_is_jbo) or-else ((F == 'mod_is_endm) or-else (F == 'omod_is_endom)))) . *** Notice the message placed in the output channel, and the change in the *** current module by default, which is now the new module just processed. *** Since the name of the module \texttt{T} can be complex---a parameterized *** module---some extra parsing has to be performed by the auxiliary function *** \texttt{parseHeader}. Similar rules are given for the processing of *** theories and views. crl [theory] : < O : X@Database | db : DB, input : (F[T, T']), output : nil, default : ME, Atts > => < O : X@Database | db : procModule(F[T, T'], DB), input : nilTermList, output : ('Introduced 'theory header2Qid(parseHeader(T)) '\n), default : parseHeader(T), Atts > if (F == 'fth_is_endfth) or-else ((F == 'th_is_endth) or-else (F == 'oth_is_endoth)) . rl [view] : < O : X@Database | db : DB, input : ('view_from_to_is_endv[T, T', T'', T3]), output : nil, default : ME, Atts > => < O : X@Database | db : procView('view_from_to_is_endv[T, T', T'', T3], DB), input : nilTermList, output : ('Introduced 'view header2Qid(parseHeader(T)) '\n), default : ME, Atts > . *** Commands are handled by rules as well. For example, the \texttt{down}, *** \texttt{reduce}, and \texttt{rewrite} commands are handled by the *** following rules. rl [down] : < O : X@Database | db : DB, input : ('down_:_[T, T']), output : nil, default : ME, Atts > => < O : X@Database | db : DB, input : nilTermList, output : procCommand('down_:_[T, T'], ME, DB), default : ME, Atts > . crl [red/rew/frew] : < O : X@Database | db : DB, input : (F[T]), output : QIL, default : ME, Atts > => < O : X@Database | db : DB, input : nilTermList, output : procCommand(F[T], ME, DB), default : ME, Atts > if (F == 'parse_.) or-else ((F == 'red_.) or-else ((F == 'reduce_.) or-else ((F == 'rew_.) or-else ((F == 'rewrite_.) or-else ((F == 'frew_.) or-else (F == 'frewrite_.)))))) . crl [search] : < O : X@Database | db : DB, input : (F[T, T']), output : QIL, default : ME, Atts > => < O : X@Database | db : DB, input : nilTermList, output : procCommand(F[T, T'], ME, DB), default : ME, Atts > if (F == 'search_=>_.) or-else ((F == 'search_=>*_.) or-else ((F == 'search_=>+_.) or-else (F == 'search_=>!_.))) . crl [match] : < O : X@Database | db : DB, input : (F[T, T']), output : QIL, default : ME, Atts > => < O : X@Database | db : DB, input : nilTermList, output : procCommand(F[T, T'], ME, DB), default : ME, Atts > if (F == 'match_<=?_.) or-else (F == 'xmatch_<=?_.) . rl [select] : < O : X@Database | db : DB, input : ('select_.[T]), output : nil, default : ME, 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 : ME, Atts > => < O : X@Database | db : DB, input : nilTermList, output : showModules(DB), default : ME, Atts > . rl [show-views] : < O : X@Database | db : DB, input : ('show`views`..@Command@), output : nil, default : ME, Atts > => < O : X@Database | db : DB, input : nilTermList, output : showViews(DB), default : ME, Atts > . *** The \texttt{show module} command, which prints the specified module, or *** the current one if no module name is specified, is handled by the *** following rules. crl [show-module] : < O : X@Database | db : DB, input : ('show`module`..@Command@), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatModule(ME', DB'), getTopModule(ME', DB')), default : ME', Atts > if < DB' ; ME' > := evalModExp(ME, DB) . crl [show-module] : < O : X@Database | db : DB, input : ('show`module_.[T]), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatModule(ME'', DB'), getTopModule(ME'', DB')), default : ME, Atts > if < DB' ; ME'' > := evalModExp(parseModExp(T), DB) . crl [show-all] : < O : X@Database | db : DB, input : ('show`all`..@Command@), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatModule(ME', DB'), getFlatModule(ME', DB')), default : ME', Atts > if DB' := database(evalModExp(ME, DB)) /\ ME' := modExp(evalModExp(ME, DB)) . crl [show-all] : < O : X@Database | db : DB, input : ('show`all_.[T]), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatModule(ME', DB'), getFlatModule(ME', DB')), default : ME, Atts > if ME'' := parseModExp(T) /\ DB' := database(evalModExp(ME'', DB)) /\ ME' := modExp(evalModExp(ME'', DB)) . crl [show-vars] : < O : X@Database | db : DB, input : ('show`vars`..@Command@), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrintVars(getVars(ME', DB')), default : ME', Atts > if DB' := database(evalModExp(ME, DB)) /\ ME' := modExp(evalModExp(ME, DB)) . crl [show-vars] : < O : X@Database | db : DB, input : ('show`vars_.[T]), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrintVars(getVars(ME', DB')), default : ME, Atts > if ME'' := parseModExp(T) /\ DB' := database(evalModExp(ME'', DB)) /\ ME' := modExp(evalModExp(ME'', DB)) . crl [show-sorts] : < O : X@Database | db : DB, input : ('show`sorts`..@Command@), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getSorts(getFlatModule(ME', DB'))), default : ME', Atts > if DB' := database(evalModExp(ME, DB)) /\ ME' := modExp(evalModExp(ME, DB)) . crl [show-sorts] : < O : X@Database | db : DB, input : ('show`sorts_.[T]), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getSorts(getFlatModule(ME', DB'))), default : ME, Atts > if ME'' := parseModExp(T) /\ DB' := database(evalModExp(ME'', DB)) /\ ME' := modExp(evalModExp(ME'', DB)) . crl [show-ops] : < O : X@Database | db : DB, input : ('show`ops`..@Command@), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatModule(ME', DB'), getOps(getFlatModule(ME', DB'))), default : ME', Atts > if DB' := database(evalModExp(ME, DB)) /\ ME' := modExp(evalModExp(ME, DB)) . crl [show-ops] : < O : X@Database | db : DB, input : ('show`ops_.[T]), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatModule(ME', DB'), getOps(getFlatModule(ME', DB'))), default : ME, Atts > if ME'' := parseModExp(T) /\ DB' := database(evalModExp(ME'', DB)) /\ ME' := modExp(evalModExp(ME'', DB)) . crl [show-mbs] : < O : X@Database | db : DB, input : ('show`mbs`..@Command@), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatModule(ME', DB'), getMbs(getFlatModule(ME', DB'))), default : ME', Atts > if DB' := database(evalModExp(ME, DB)) /\ ME' := modExp(evalModExp(ME, DB)) . crl [show-mbs] : < O : X@Database | db : DB, input : ('show`mbs_.[T]), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatModule(ME', DB'), getMbs(getFlatModule(ME', DB'))), default : ME, Atts > if ME := parseModExp(T) /\ DB' := database(evalModExp(ME, DB)) /\ ME' := modExp(evalModExp(ME, DB)) . crl [show-eqns] : < O : X@Database | db : DB, input : ('show`eqs`..@Command@), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrintEq(getFlatModule(ME', DB'), getEqs(getFlatModule(ME', DB'))), default : ME', Atts > if DB' := database(evalModExp(ME, DB)) /\ ME' := modExp(evalModExp(ME, DB)) . crl [show-eqns] : < O : X@Database | db : DB, input : ('show`eqs_.[T]), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrintEq(getFlatModule(ME', DB'), getEqs(getFlatModule(ME', DB'))), default : ME, Atts > if ME'' := parseModExp(T) /\ DB' := database(evalModExp(ME'', DB)) /\ ME' := modExp(evalModExp(ME'', DB)) . crl [show-rls] : < O : X@Database | db : DB, input : ('show`rls`..@Command@), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatModule(ME', DB'), getRls(getFlatModule(ME', DB'))), default : ME', Atts > if DB' := database(evalModExp(ME, DB)) /\ ME' := modExp(evalModExp(ME, DB)) . crl [show-rls] : < O : X@Database | db : DB, input : ('show`rls_.[T]), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(getFlatModule(ME', DB'), getRls(getFlatModule(ME', DB'))), default : ME, Atts > if ME'' := parseModExp(T) /\ DB' := database(evalModExp(ME'', DB)) /\ ME' := modExp(evalModExp(ME'', DB)) . crl [show-view] : < O : X@Database | db : DB, input : ('show`view_.[T]), output : nil, default : ME, Atts > => < O : X@Database | db : DB', input : nilTermList, output : eMetaPrettyPrint(DB', getView(parseViewExp(T), DB')), default : ME, Atts > if DB' := evalViewExp(parseViewExp(T), nil, DB) . crl [set`protect_on] : < O : X@Database | db : DB, input : ('set`protect_on`.[T]), output : QIL', default : ME, Atts > => < O : X@Database | db : db(MIS, MNS, VIS, VES, MNS' ME', MNS'', MNS3, QIL), input : nilTermList, output : (QIL' 'set 'protect header2QidList(ME') 'on '\n), default : ME, Atts > if ME' := parseModExp(T) /\ unitInDb(ME', DB) /\ db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL) := DB . crl [set`protect_off] : < O : X@Database | db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL), input : ('set`protect_off`.[T]), output : QIL', default : ME, Atts > => < O : X@Database | db : db(MIS, MNS, VIS, VES, MNS4, MNS'', MNS3, QIL), input : nilTermList, output : (QIL' 'set 'protect header2QidList(ME') 'off '\n), default : ME, Atts > if ME' := parseModExp(T) /\ ME' . MNS4 := MNS' . crl [set`extend_on] : < O : X@Database | db : DB, input : ('set`extend_on`.[T]), output : QIL', default : ME, Atts > => < O : X@Database | db : db(MIS, MNS, VIS, VES, MNS', MNS'' ME', MNS3, QIL), input : nilTermList, output : (QIL' 'set 'extend header2QidList(ME') 'on '\n), default : ME, Atts > if ME' := parseModExp(T) /\ unitInDb(ME', DB) /\ db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL) := DB . crl [set`extend_off] : < O : X@Database | db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL), input : ('set`extend_off`.[T]), output : QIL', default : ME, Atts > => < O : X@Database | db : db(MIS, MNS, VIS, VES, MNS', MNS4, MNS3, QIL), input : nilTermList, output : (QIL' 'set 'extend header2QidList(ME') 'off '\n), default : ME, Atts > if ME' := parseModExp(T) /\ ME' . MNS4 := MNS'' . crl [set`include_on] : < O : X@Database | db : DB, input : ('set`include_on`.[T]), output : QIL', default : ME, Atts > => < O : X@Database | db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3 ME', QIL), input : nilTermList, output : (QIL' 'set 'include header2QidList(ME') 'on '\n), default : ME, Atts > if ME' := parseModExp(T) /\ unitInDb(ME', DB) /\ db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL) := DB . crl [set`include_off] : < O : X@Database | db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL), input : ('set`include_off`.[T]), output : QIL', default : ME, Atts > => < O : X@Database | db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS4, QIL), input : nilTermList, output : (QIL' 'set 'include header2QidList(ME') 'off '\n), default : ME, Atts > if ME' := parseModExp(T) /\ ME' . MNS4 := MNS3 . crl [error] : < O : X@Database | db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL), input : TL, output : nil, default : ME, Atts > => < O : X@Database | db : db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, nil), input : TL, output : QIL, default : ME, Atts > if QIL =/= nil . *** Auxiliary Functions op showViews : Database -> QidList . op showModules : Database -> QidList . eq showViews(db(MIS, MNS, VIS, (VE # VES), MNS', MNS'', MNS3, QIL)) = (eMetaPrettyPrint(VE) '\n showViews(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))) . eq showViews( db(MIS, MNS, VIS, emptyViewExpSet, MNS', MNS'', MNS3, QIL)) = nil . eq showModules( db(MIS, (MN . MNS), VIS, VES, MNS', MNS'', MNS3, QIL)) = (eMetaPrettyPrint(MN) '\n showModules(db(MIS, MNS, VIS, VES, MNS', MNS'', MNS3, QIL))) . eq showModules( db(MIS, emptyModuleNameSet, VIS, VES, MNS', MNS'', MNS3, QIL)) = nil . endm ******************************************************************************* --- end of "Full Maude part". --- Back to Real-Time Maude-specific parts: *** ************************************************ *** ************************************************ *** *** REAL-TIME MAUDE *** *** ************************************************ *** ************************************************ *** ********************************************************************** --- ---------------------------------------------------------------------- --- PART I. Define the user-level syntax for modules and commands. **************************************************** *** USER-LEVEL SYNTAX, first of modules, *** then of commands *** ************************************************ fmod TIMED-MODULE-SYNTAX is including VIEWS . *** Timed modules and theories: op tmod_is_endtm : @Interface@ @SDeclList@ -> @Module@ . op tth_is_endtth : @Interface@ @SDeclList@ -> @Module@ . *** Object-oriented timed modules and theories: op tomod_is_endtom : @Interface@ @ODeclList@ -> @Module@ . op toth_is_endtoth : @Interface@ @ODeclList@ -> @Module@ . endfm ---Define Real-Time Maude's user-level command syntax: fmod RTM-COMMAND-SYNTAX is including COMMANDS . *** Help commands: op help_. : @Token@ -> @Command@ . op man_. : @Token@ -> @Command@ . op help . : -> @Command@ . op show timed modules . : -> @Command@ . *** "Default" timed rewrite op trew_with no time limit . : @Bubble@ -> @Command@ . op trew_in time <=_. : @Bubble@ @Bubble@ -> @Command@ . op trew_in time <_. : @Bubble@ @Bubble@ -> @Command@ . *** Default "fair" timed rewrite op tfrew_with no time limit . : @Bubble@ -> @Command@ . op tfrew_in time <=_. : @Bubble@ @Bubble@ -> @Command@ . op tfrew_in time <_. : @Bubble@ @Bubble@ -> @Command@ . *** Timed search commands: *** I use the different versions so that it is slightly easier for *** the parser, since if the search pattern contains *** "in time" then it could become ambiguous parses. Now, that's *** only a remote possibility! op tsearch_=>1_with no time limit . : @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>*_with no time limit . : @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>!_with no time limit . : @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>+_with no time limit . : @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>1_in time <_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>*_in time <_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>!_in time <_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>+_in time <_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>1_in time <=_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>*_in time <=_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>!_in time <=_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>+_in time <=_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>1_in time >_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>*_in time >_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>!_in time >_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>+_in time >_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>1_in time >=_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>*_in time >=_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>!_in time >=_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>+_in time >=_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op tsearch_=>1_in time-interval between__and__. : @Bubble@ @Bubble@ @Token@ @Bubble@ @Token@ @Bubble@ -> @Command@ . op tsearch_=>!_in time-interval between__and__. : @Bubble@ @Bubble@ @Token@ @Bubble@ @Token@ @Bubble@ -> @Command@ . op tsearch_=>*_in time-interval between__and__. : @Bubble@ @Bubble@ @Token@ @Bubble@ @Token@ @Bubble@ -> @Command@ . op tsearch_=>+_in time-interval between__and__. : @Bubble@ @Bubble@ @Token@ @Bubble@ @Token@ @Bubble@ -> @Command@ . *** Untimed search: remove all clocks: op utsearch_=>1_. : @Bubble@ @Bubble@ -> @Command@ . op utsearch_=>*_. : @Bubble@ @Bubble@ -> @Command@ . op utsearch_=>!_. : @Bubble@ @Bubble@ -> @Command@ . op utsearch_=>+_. : @Bubble@ @Bubble@ -> @Command@ . op find earliest_=>*_. : @Bubble@ @Bubble@ -> @Command@ . *** A kind of model checking of |=<> and |=<>__<=r. *** It is implemented "directly" using the meta-level using *** breadth-first search techniques. op find latest_=>*_with no time limit . : @Bubble@ @Bubble@ -> @Command@ . op find latest_=>*_in time <_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op find latest_=>*_in time <=_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . *** "Check" commands. *** I guess that these are subsumed by the model checker, *** but they are provided anyways, because there are some *** cases in which they terminate where the model checker, *** using a depth-first-search like automaton-construction technique *** would not terminate. op check_|= <>_with no time limit . : @Bubble@ @Bubble@ -> @Command@ . op check_|= <>_in time <_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op check_|= <>_in time <=_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op check_|=_until_with no time limit . : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op check_|=_until_in time <_. : @Bubble@ @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op check_|=_until_in time <=_. : @Bubble@ @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op check_|=_untilStable_with no time limit . : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op check_|=_untilStable_in time <_. : @Bubble@ @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op check_|=_untilStable_in time <=_. : @Bubble@ @Bubble@ @Bubble@ @Bubble@ -> @Command@ . *** [Possibly time-bounded] linear temporal logic model checking commands: op mc_|=u_. : @Bubble@ @Bubble@ -> @Command@ . *** Untimed model checking *** clocks are removed *** Timed model checking! Untimed properties are valid in *** all clocked states if they are valid in the state part ... op mc_|=t_with no time limit . : @Bubble@ @Bubble@ -> @Command@ . op mc_|=t_in time <=_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . op mc_|=t_in time <_. : @Bubble@ @Bubble@ @Bubble@ -> @Command@ . *** Commands for setting the "mode" which describes how to treat *** some kinds of "nondeterministic" tick rules: op set tick def_. : @Bubble@ -> @Command@ . *** Default time increase. op set tick max . : -> @Command@ . *** Max time increase op set tick max def_. : @Bubble@ -> @Command@ . *** maximal time increase, but with a given value if max is INF op set tick det . : -> @Command@ . *** Deterministic. op get tick mode . : -> @Command@ . *** Print tick mode op show tick mode . : -> @Command@ . *** Same as above endfm fmod REAL-TIME-MAUDE-SYNTAX is inc FULL-MAUDE-SIGN . inc TIMED-MODULE-SYNTAX . inc RTM-COMMAND-SYNTAX . endfm *** The user text is parsed in the grammar TIMED-GRAMMAR: fmod META-RTM-SIGN is inc META-FULL-MAUDE-SIGN . inc UNIT . *** To get the addImports function op TIMED-GRAMMAR : -> FModule [memo] . eq TIMED-GRAMMAR = addImports((including 'REAL-TIME-MAUDE-SYNTAX .), GRAMMAR) . endfm --- This ends our definition of the user-level module and command syntax. *** ********************************************************************** --- ---------------------------------------------------------------------- --- PART II. Define the various built-in modules which are included --- automatically by timed modules and object-oriented timed --- modules, as well as some built-in standard time domains. --- Done in the top of this file! *** ********************************************************************** --- ---------------------------------------------------------------------- --- PART III. The various meta-level operations on timed modules, --- including operations on modules as well as all --- the meta-functions corresponding to the Real-Time Maude --- commands. *** We start with some basic, non-time functions at the meta-level. --- Define a data type of sets of terms. The names of the sort and operators --- are changed from Full Maude to avoid collision. fmod TERM-SET is protecting META-TERM . sort Termset . subsort Term < Termset . op noterm : -> Termset [ctor] . op _||_ : Termset Termset -> Termset [format (d t nt d) ctor assoc comm id: noterm] . eq T:Term || T:Term = T:Term . endfm --- OK up to here! fmod VARIABLES is --- protecting MY-QID-SET . protecting META-MODULE . op vars : TermList -> QidSet . --- variables in a term(list) op vars : Condition -> QidSet . --- variables in a condition op vars : Rule -> QidSet . op initializedVars : Condition -> QidSet . op _subseteq_ : QidSet QidSet -> Bool [prec 122] . var Q : Qid . vars QS QS' : QidSet . var TL : TermList . var NETL : NeTermList . vars T T' : Term . vars C C' : Condition . var S : Sort . var AS : AttrSet . eq QS subseteq (QS , QS') = true . ceq (Q , QS) subseteq QS' = false if not Q in QS' . eq vars(Q) = if Q :: Variable then Q else none fi . eq vars(Q[TL]) = vars(TL) . eq vars((T , NETL)) = vars(T) ; vars(NETL) . eq vars((nil).Condition) = none . ceq vars(C /\ C') = vars(C) ; vars(C') if C =/= nil /\ C' =/= nil . eq vars(T = T') = vars(T) ; vars(T') . eq vars(T : S) = vars(T) . eq vars(T := T') = vars(T) ; vars(T') . eq vars(T => T') = vars(T) ; vars(T') . eq vars((rl T => T' [AS] .)) = vars(T) ; vars(T') . eq vars((crl T => T' if C [AS] .)) = vars(T) ; vars(T') ; vars(C) . eq initializedVars(nil) = none . eq initializedVars(T = T') = none . eq initializedVars(T : S) = none . eq initializedVars(T := T') = vars(T) . eq initializedVars(T => T') = none . ceq initializedVars(C /\ C') = initializedVars(C) ; initializedVars(C') if C =/= nil /\ C' =/= nil . endfm --- Extend the Qid's with some previously common and useful functions. fmod EXT-QID is pr QID . pr CONVERSION . op conc : Qid Qid -> Qid . op index : Qid Int -> Qid . op strip : Qid -> Qid . op convert : Qid ~> Int . op _<_ : Qid Qid -> Bool . vars Q P : Qid . var M : Int . eq conc(Q, P) = qid(string(Q) + string(P)) . eq index(Q, M) = qid(string(Q) + string(M, 10)) . eq strip(Q) = qid(substr(string(Q), 1, length(string(Q)))) . eq convert(Q) = trunc(rat(string(Q), 10)) . eq Q < P = string(Q) < string(P) . endfm --- Fins all states reachable in ONE rewrite step from a certain term --- using the built-in metaSearch function: fmod ALL-ONE-STEP-REWRITES is protecting TERM-SET . protecting META-LEVEL . protecting CONVERSION . op allNextStates : Module Term -> Termset . op allNextStates : Module Term Term Nat -> Termset . *** The third argument here is a dummy search term. var M : Module . vars T T' : Term . var N : Nat . eq allNextStates(M, T) = allNextStates(M, T, qid(string('V:) + string(getKind(M, leastSort(M, T)))), 0) . eq allNextStates(M, T, T', N) = if metaSearch(M, T, T', nil, '+, 1, N) :: ResultTriple then getTerm(metaSearch(M, T, T', nil, '+, 1, N)) || allNextStates(M, T, T', N + 1) else noterm fi . endfm --- ---------------------------------------------------------- --- Now, we are ready for functions on timed modules, that is, --- on ordinary modules which are transformed from timed modules. --- Throughout Real-Time Maude, we will for efficiency purposes --- assume that the user does not use an operator called {_} and --- does not use an operator called _in time_. --- The structure of this part is: --- 1. Some generic useful functions on timed modules --- 2. Define the different module transformations given in the WRLA 2004 --- paper. --- 3. Define the meta-level commands corresponding to the user --- execution/analysis/model-checking commands --- Module transformations: --- ----------------------- --- In our WRLA 2004 paper, we identified four classes of module --- transformations from a real-time rewrite theory into an ordinary --- rewrite theory. And we defined two endofunctors on real-time rewrite --- theories. --- The four transformations from a RTRTh into an ordinary RTh are: --- i. The basic translation R -> R^C which adds a clock component --- to the state. --- ii. The transformation R -> R^<=r (or R -> R^ R^hat(<=r), which is as above, with the --- exception that an explicit self-loop is added for tick in place --- of tick application which would have taken the total time --- elapse beyond the time limit. --- iv. The transformation R -> R^U which just ignores duration information. --- --- The endofunctors on real-time rewrite theories are: --- a. The transformation R -> R_nz so that zero-time ticks are not --- performed. --- b. The transformation R -> R_s which applies the time sampling --- strategy s on R. --- The first transformation, i, is implicit, since it is performed --- when the module is entered into the Full Maude/Real-Time Maude database. --- Therefore, both transformations a and b are really applied to R^C --- and not to R. --- First, the following is a data type for internally representing tick modes: fmod TICK-MODES is protecting META-TERM . sort TickMode . op det : -> TickMode . *** Deterministic tick mode. op max : -> TickMode . *** Maximal time increase, no default value for INF ops def maxDef : Term -> TickMode . endfm --- Data types for "comparison operators" in time bounds of commands: fmod COMPARISON-OPERATORS is protecting QID . sort ComparisonOp . ops le lt gt ge : -> ComparisonOp [ctor] . op comparisonOpSymbol : ComparisonOp -> Qid . eq comparisonOpSymbol(le) = '_le_ . eq comparisonOpSymbol(lt) = '_lt_ . eq comparisonOpSymbol(ge) = '_ge_ . eq comparisonOpSymbol(gt) = '_gt_ . endfm --- We start by defining a module which performsa the FIRST part --- of translations ii and iii, namely, which adds the operator --- op global : ClockedSystem -> ClockedSystem --- and changes all tick rules t => t' in time u if C to --- global(t in time X) => global(T' in time X plus u) if C, --- where X is a new variable of sort Time which does not --- appear in the original rule. This variable X is created by the --- function myNewVar, and is TIME_ELAPSED:Time if OK, otherwise it --- tries TIME_ELAPSED#1:Time, and TIME_ELAPSED#2:Time until it --- finds a fresh variable. fmod GLOBALIZATION is protecting META-LEVEL . protecting VARIABLES . protecting EXT-QID . op globalizeMod : Module -> Module . op globalizeRls : RuleSet -> RuleSet . *** Makes tick rules global, but without changing them semantically op globalizeTerm : Term Term -> Term . *** globalizes a term. ONLY IN CASE it is a GlobalSystem term, will *** the initial time elapse term be the second argument. op globalizeTerm : Module Term Term -> Term . *** First reduces the initial term (in case it is an abbreviation) and *** then applies the Module-less globalizeTerm op globalTerm : Term -> Bool . op globalRule : Rule -> Bool . op removeGlobal : Term -> Term . op removeGlobal : ResultPair -> ResultPair . op removeGlobal : ResultTriple? -> ResultTriple? . *** Removes the final 'global operator from a term, but *** only if it has the sort 'ClockedSystem. Note that it does NOT *** remove possible in time 0 part of a term! op myNewVar : Rule -> Variable . op myNewVar : Term -> Variable . *** Gives a new Time variable which does not occur in the rule/term. *** Tries first 'TIME_ELAPSED:Time, and if that doesn't work, *** then 'TIME_ELAPSED#1:Time, and then 'TIME_ELAPSED#2:Time etc. Uses op myNewVar : Rule Nat -> Variable . op myNewVar : Term Nat -> Variable . --- notice that we for convenience add the myNewVar function here, --- even though it will not be needed until timedMetaSearch functions ops tickRule globalRule : Rule -> Bool . --- the former checks only an UNGLOBALIZED rule! ops globalSystemTerm inTimeTerm : Module Term -> Bool . ops globalSystemTerm inTimeTerm : Term -> Bool . --- Is the term a term of sort GlobalSystem or of the form T in time T'?? var N : Nat . var M : Module . vars T T' T'' T''' T'''' : Term . var F : Qid . vars Q Q' : Qid . var IL : ImportList . var SS : SortSet . var SSDS : SubsortDeclSet . var OPDS : OpDeclSet . var MAS : MembAxSet . var EQS : EquationSet . vars RLS RLS' : RuleSet . var RULE : Rule . vars V VAR VAR' : Variable . vars COND COND' : Condition . var AS : AttrSet . vars TL TL' : TermList . var NETL : NeTermList . var C : Constant . var H : Header . eq globalizeMod(FM:FModule) = FM:FModule . eq globalizeMod(mod H is IL sorts SS . SSDS OPDS MAS EQS RLS endm) = (mod H is IL sorts SS . SSDS (op 'global : 'ClockedSystem -> 'ClockedSystem [none] . OPDS) MAS EQS globalizeRls(RLS) endm) . ceq globalizeRls(RLS RLS') = globalizeRls(RLS) globalizeRls(RLS') if RLS =/= none /\ RLS' =/= none . eq globalizeRls(none) = none . eq globalizeRls((rl '`{_`}[T] => '_in`time_[T', T''] [AS] .)) = (rl 'global['_in`time_['`{_`}[T], myNewVar((rl '`{_`}[T] => '_in`time_[T', T''] [AS] .))]] => 'global['_in`time_[T', '_plus_[T'', myNewVar((rl '`{_`}[T] => '_in`time_[T', T''] [AS] .))]]] [AS] .) . eq globalizeRls((crl '`{_`}[T] => '_in`time_[T', T''] if COND [AS] .)) = (crl 'global['_in`time_['`{_`}[T], myNewVar((rl '`{_`}[T] => '_in`time_[T', T''] [AS] .))]] => 'global['_in`time_[T', '_plus_[T'', myNewVar((crl '`{_`}[T] => '_in`time_[T', T''] if COND [AS] .))]]] if COND [AS] .) . *** if rule, but not tick rule: ceq globalizeRls(RULE) = RULE if not tickRule(RULE) . eq inTimeTerm(M, T) = inTimeTerm(T) and leastSort(M, T) == 'ClockedSystem . eq inTimeTerm(F[TL]) = F == '_in`time_ . *** Because strictly speaking, T could be a variable of sort GlobalSystem, *** so no need to check whether it is a term of sort GlobalSystem. eq inTimeTerm(V) = false . *** Note, does not recognize a variable ... eq inTimeTerm(C) = false . *** ... or constant od sort ClockedSystem!!! eq globalSystemTerm(F[TL]) = F == '`{_`} . eq globalSystemTerm(C) = getType(C) == 'GlobalSystem . eq globalSystemTerm(V) = getType(V) == 'GlobalSystem . eq globalSystemTerm(M, T) = globalSystemTerm(T) and leastSort(M, T) == 'GlobalSystem . eq tickRule(rl T => T' [AS] .) = globalSystemTerm(T) and inTimeTerm(T') . eq tickRule(crl T => T' if COND [AS] .) = tickRule(rl T => T' [AS] .) . eq globalTerm(F[T]) = F == 'global and inTimeTerm(T) . eq globalTerm(F[T , NETL]) = false . eq globalTerm(V) = false . eq globalTerm(C) = false . eq globalRule(rl T => T' [AS] .) = globalTerm(T) and globalTerm(T') . eq globalRule(crl T => T' if COND [AS] .) = globalRule(rl T => T' [AS] .) . eq globalizeTerm('`{_`}[T], T') = 'global['_in`time_['`{_`}[T], T']] . eq globalizeTerm('_in`time_[T, T'], T'') = 'global['_in`time_[T, T']] . ceq globalizeTerm(F[TL], T) = F[TL] if F =/= '`{_`} /\ F =/= '_in`time_ . eq globalizeTerm(V, T) = if getType(V) == 'GlobalSystem then 'global['_in`time_[V, T]] else V fi . eq globalizeTerm(C, T) = if getType(C) == 'GlobalSystem then 'global['_in`time_[C, T]] else C fi . eq globalizeTerm(M, T, T') = globalizeTerm(getTerm(metaReduce(M, T)), T') . eq removeGlobal({T, TY:Type}) = {removeGlobal(T), TY:Type} . eq removeGlobal('global[T]) = T . ceq removeGlobal(F[TL]) = F[TL] if F =/= 'global . eq removeGlobal(V) = V . eq removeGlobal(C) = C . eq removeGlobal({T, TY:Type, S:Substitution}) = {removeGlobal(T), TY:Type, S:Substitution} . eq removeGlobal(failure) = failure . eq myNewVar(RULE) = if 'TIME_ELAPSED:Time in vars(RULE) then myNewVar(RULE, 1) else 'TIME_ELAPSED:Time fi . eq myNewVar(RULE, N) = if conc(index('TIME_ELAPSED#, N), ':Time) in vars(RULE) then myNewVar(RULE, N + 1) else conc(index('TIME_ELAPSED#, N), ':Time) fi . eq myNewVar(T) = if 'TIME_ELAPSED:Time in vars(T) then myNewVar(T, 1) else 'TIME_ELAPSED:Time fi . eq myNewVar(T, N) = if conc(index('TIME_ELAPSED#, N), ':Time) in vars(T) then myNewVar(T, N + 1) else conc(index('TIME_ELAPSED#, N), ':Time) fi . endfm --- Now, we should be able to define the translation R -> R^<=r --- or R -> R^ R^<=r. fmod DONT-TICK-PAST-TIME-TRANSFORMATION is protecting GLOBALIZATION . protecting COMPARISON-OPERATORS . op dontTickPastTime : Module ComparisonOp Term -> Module . --- usage dontTickPastTime(R-C, le or lt, r) --- dontTickPastTime2 assumes that the module is already globalized. op dontTickPastTime2 : Module ComparisonOp Term -> Module . op dontTickPastTime : RuleSet ComparisonOp Term -> RuleSet . var M : Module . vars T T' T'' T''' : Term . var COMP : ComparisonOp . var H : Header . var IL : ImportList . var SS : SortSet . var SSDS : SubsortDeclSet . var OPDS : OpDeclSet . var MAS : MembAxSet . var EQS : EquationSet . vars RLS RLS' : RuleSet . var RULE : Rule . var COND : Condition . var AS : AttrSet . --- start by globalizing the incoming module: eq dontTickPastTime(M, COMP, T) = dontTickPastTime2(globalizeMod(M), COMP, T) . eq dontTickPastTime2(FM:FModule, COMP, T) = FM:FModule . eq dontTickPastTime2(mod H is IL sorts SS . SSDS OPDS MAS EQS RLS endm, COMP, T) = (mod H is IL sorts SS . SSDS OPDS MAS EQS dontTickPastTime(RLS, COMP, T) endm) . eq dontTickPastTime((rl 'global[T] => 'global['_in`time_[T', T'']] [AS] .), COMP, T''') = (crl 'global[T] => 'global['_in`time_[T', T'']] if comparisonOpSymbol(COMP)[T'', T'''] = 'true.Bool [AS] .) . eq dontTickPastTime((crl 'global[T] => 'global['_in`time_[T', T'']] if COND [AS] .), COMP, T''') = (crl 'global[T] => 'global['_in`time_[T', T'']] if COND /\ comparisonOpSymbol(COMP)[T'', T'''] = 'true.Bool [AS] .) . ceq dontTickPastTime(RULE, COMP, T) = RULE if not globalRule(RULE) . ceq dontTickPastTime(RLS RLS', COMP, T) = dontTickPastTime(RLS, COMP, T) dontTickPastTime(RLS', COMP, T) if RLS =/= none /\ RLS' =/= none . eq dontTickPastTime(none, COMP, T) = none . endfm --- Now, we define the translation R (=R^C) -> R^hat(<=r). --- Again, the argument to the main function should preferably --- NOT be a globalized module, so that we are more in synch --- with the WRLA 2004 treatment. fmod LOOP-WHEN-LIMIT-TRANSFORMATION is protecting GLOBALIZATION . protecting COMPARISON-OPERATORS . op loopWhenLimit : Module ComparisonOp Term -> Module . --- main function --- the following takes a globalized module: op loopWhenLimit2 : Module ComparisonOp Term -> Module . op loopWhenLimit : RuleSet ComparisonOp Term -> RuleSet . var M : Module . vars T T' T'' T''' T'''' : Term . var COMP : ComparisonOp . var H : Header . var IL : ImportList . var SS : SortSet . var SSDS : SubsortDeclSet . var OPDS : OpDeclSet . var MAS : MembAxSet . var EQS : EquationSet . vars RLS RLS' : RuleSet . var RULE : Rule . var COND : Condition . var AS : AttrSet . eq loopWhenLimit(M, COMP, T) = loopWhenLimit2(globalizeMod(M), COMP, T) . eq loopWhenLimit2(mod H is IL sorts SS . SSDS OPDS MAS EQS RLS endm, COMP, T) = (mod H is IL sorts SS . SSDS OPDS MAS EQS loopWhenLimit(RLS, COMP, T) endm) . eq loopWhenLimit2(FM:FModule, COMP, T) = FM:FModule . ceq loopWhenLimit(RLS RLS', COMP, T) = loopWhenLimit(RLS, COMP, T) loopWhenLimit(RLS', COMP, T) if RLS =/= none /\ RLS' =/= none . eq loopWhenLimit(none, COMP, T) = none . ceq loopWhenLimit(RULE, COMP, T) = RULE if not globalRule(RULE) . eq loopWhenLimit((rl 'global['_in`time_[T, T']] => 'global['_in`time_[T'', T''']] [AS] .), COMP, T'''') = (rl 'global['_in`time_[T, T']] => 'if_then_else_fi[comparisonOpSymbol(COMP)[T''', T''''], 'global['_in`time_[T'', T''']], 'global['_in`time_[T, T']]] [AS] .) . eq loopWhenLimit((crl 'global['_in`time_[T, T']] => 'global['_in`time_[T'', T''']] if COND [AS] .), COMP, T'''') = (crl 'global['_in`time_[T, T']] => 'if_then_else_fi[comparisonOpSymbol(COMP)[T''', T''''], 'global['_in`time_[T'', T''']], 'global['_in`time_[T, T']]] if COND [AS] .) . endfm --- The next transformation should be the forget functor R -> R^U, --- which just ignores duration information. The functions assume, --- in accordance to the theory, that the module is not a globalized one! fmod REMOVE-CLOCKS-TRANSFORMATION is protecting GLOBALIZATION . --- function "tickRule" op removeClocks : Module -> Module . --- main transformation op removeClocks : RuleSet -> RuleSet . op removeClocks : Term -> Term . vars T T' T'' : Term . var F : Qid . var H : Header . var IL : ImportList . var SS : SortSet . var SSDS : SubsortDeclSet . var OPDS : OpDeclSet . var MAS : MembAxSet . var EQS : EquationSet . vars RLS RLS' : RuleSet . var RULE : Rule . var COND : Condition . var AS : AttrSet . var TL : TermList . eq removeClocks(FM:FModule) = FM:FModule . eq removeClocks(mod H is IL sorts SS . SSDS OPDS MAS EQS RLS endm) = (mod H is IL sorts SS . SSDS OPDS MAS EQS removeClocks(RLS) endm) . ceq removeClocks(RLS RLS') = removeClocks(RLS) removeClocks(RLS') if RLS =/= none /\ RLS' =/= none . eq removeClocks((none).RuleSet) = (none).RuleSet . ceq removeClocks(RULE) = RULE if not tickRule(RULE) . eq removeClocks(rl '`{_`}[T] => '_in`time_['`{_`}[T'], T''] [AS] .) = (rl '`{_`}[T] => '`{_`}[T'] [AS] .) . eq removeClocks(crl '`{_`}[T] => '_in`time_['`{_`}[T'], T''] if COND [AS] .) = (crl '`{_`}[T] => '`{_`}[T'] if COND [AS] .) . eq removeClocks('_in`time_[T, T']) = T . ceq removeClocks(F[TL]) = F[TL] if F =/= '_in`time_ . eq removeClocks(C:Constant) = C:Constant . eq removeClocks(V:Variable) = V:Variable . endfm --- Now, it is time to define the transformations on real-time rewrite --- theories, that is, in our case, on R^C's, namely "noZeroTick" and --- "modeify", the latter which changes the rewrite theory according --- to the given time sampling strategy (aka "mode"). --- First, the simpler ... R -> R^nz fmod NO-ZERO-TICK-TRANSFORMATION is protecting GLOBALIZATION . --- function "tickRule" op noZeroTick : Module -> Module . op noZeroTick : RuleSet -> RuleSet . *** Adds an extra condition to the tick rules that *** does not allow a tick rule to advance time just zero time! *** Applies only to UNglobalized systems! vars T T' T'' : Term . var H : Header . var IL : ImportList . var SS : SortSet . var SSDS : SubsortDeclSet . var OPDS : OpDeclSet . var MAS : MembAxSet . var EQS : EquationSet . vars RLS RLS' : RuleSet . var RULE : Rule . var COND : Condition . var AS : AttrSet . eq noZeroTick(FM:FModule) = FM:FModule . eq noZeroTick(mod H is IL sorts SS . SSDS OPDS MAS EQS RLS endm) = (mod H is IL sorts SS . SSDS OPDS MAS EQS noZeroTick(RLS) endm) . ceq noZeroTick(RULE) = RULE if not tickRule(RULE) . ceq noZeroTick(RLS RLS') = noZeroTick(RLS) noZeroTick(RLS') if RLS =/= none /\ RLS' =/= none . eq noZeroTick(none) = none . eq noZeroTick(rl '`{_`}[T] => '_in`time_[T', T''] [AS] .) = (crl '`{_`}[T] => '_in`time_[T', T''] if '_=/=_[T'', 'zero.Time] = 'true.Bool [AS] .) . eq noZeroTick(crl '`{_`}[T] => '_in`time_[T', T''] if COND [AS] .) = (crl '`{_`}[T] => '_in`time_[T', T''] if COND /\ '_=/=_[T'', 'zero.Time] = 'true.Bool [AS] .) . endfm --- Now, we define the transformation R -> R^tss which applies a given --- time sampling strategy (aka "tick mode") to a real-time rewrite theory. --- In a change from the previous version of Real-Time Maude, this --- implementation follows very closely the transformation given in --- the WRLA 2004 paper, and makes the assumptions from --- that paper. --- Notice also that the TSS should be applied, as in the paper, --- on "unglobalized" modules. fmod APPLY-TIME-SAMPLING-STRATEGY-TRANSFORMATION is protecting GLOBALIZATION . --- function tickRule protecting TICK-MODES . --- the main transformation function: op applyTSS : Module TickMode -> Module . op applyTSS : RuleSet TickMode -> RuleSet . --- some helpful functions: op ndTicks : Rule -> Bool . --- Investigates whether the tick in some tick rule is "nondeterministic" op removeNonexec : AttrSet -> AttrSet . --- Removes the "nonexec" attribute when we modeify a nondet tick rule var N : Nat . var M : Module . vars T T' T'' T''' U : Term . vars Q Q' : Qid . var IL : ImportList . var SS : SortSet . var SSDS : SubsortDeclSet . var OPDS : OpDeclSet . var MAS : MembAxSet . var EQS : EquationSet . vars RLS RLS' : RuleSet . var RULE : Rule . vars VAR VAR' : Variable . vars COND COND' : Condition . var AS : AttrSet . vars TL TL' : TermList . var C : Constant . var TM : TickMode . var H : Header . var NETL : NeTermList . eq ndTicks(rl T => '_in`time_[T', T''] [AS] .) = not(vars(T'') subseteq vars(T)) . eq ndTicks(crl '`{_`}[T] => '_in`time_['`{_`}[T'], T''] if COND [AS] .) = not(vars(T'') subseteq (vars(T) ; initializedVars(COND))) . eq removeNonexec(none) = none . eq removeNonexec(ATTR:Attr AS) = if ATTR:Attr == nonexec then AS else (ATTR:Attr AS) fi . eq applyTSS(FM:FModule, TM) = FM:FModule . eq applyTSS(M, det) = M . eq applyTSS(RLS, det) = RLS . ceq applyTSS(mod H is IL sorts SS . SSDS OPDS MAS EQS RLS endm, TM) = (mod H is IL sorts SS . SSDS OPDS MAS EQS applyTSS(RLS, TM) endm) if TM =/= det . eq applyTSS(none, TM) = none . ceq applyTSS(RLS RLS', TM) = applyTSS(RLS, TM) applyTSS(RLS', TM) if RLS =/= none /\ RLS' =/= none . ceq applyTSS(RULE, TM) = RULE if not tickRule(RULE) . --- rules not of the given forms are not changed: ceq applyTSS(RULE, TM) = RULE if not ndTicks(RULE) . ceq applyTSS(rl T => '_in`time_[T', T''] [AS] ., TM) = (rl T => '_in`time_[T', T''] [AS] .) if (not (T'' :: Variable)) or (vars(T'') subseteq vars(T)) . ceq applyTSS(crl T => '_in`time_[T', T''] if COND [AS] ., TM) = (crl T => '_in`time_[T', T''] if COND [AS] .) if (not (T'' :: Variable)) or (vars(T'') subseteq (vars(T) ; initializedVars(COND))) . --- first, we apply the tss def(T) to a tick rule as given in the WRLA --- paper: ceq applyTSS(crl T => '_in`time_[T', VAR] if COND /\ '_le_[VAR, U] = 'true.Bool /\ COND' [AS] ., def(T'')) = (crl T => '_in`time_[T', VAR] if COND /\ VAR := 'if_then_else_fi['_le_[U, T''], U, T''] /\ '_le_[VAR, U] = 'true.Bool /\ COND' [removeNonexec(AS)] .) if not VAR in (vars(T) ; initializedVars(COND /\ COND')) . *** same, but for '_<=_: ceq applyTSS(crl T => '_in`time_[T', VAR] if COND /\ '_<=_[VAR, U] = 'true.Bool /\ COND' [AS] ., def(T'')) = (crl T => '_in`time_[T', VAR] if COND /\ VAR := 'if_then_else_fi['_le_[U, T''], U, T''] /\ '_<=_[VAR, U] = 'true.Bool /\ COND' [removeNonexec(AS)] .) if not VAR in (vars(T) ; initializedVars(COND /\ COND')) . --- now, for the cases in which there is no fixed upper bound: ceq applyTSS(crl T => '_in`time_[T', VAR] if COND [AS] ., def(T'')) = (crl T => '_in`time_[T', VAR] if VAR := T'' /\ COND [removeNonexec(AS)] .) if not VAR in (vars(T) ; initializedVars(COND)) /\ not (VAR exactlyBoundIn COND) . ceq applyTSS(rl T => '_in`time_[T', VAR] [AS] ., def(T'')) = (crl T => '_in`time_[T', VAR] if VAR := T'' [removeNonexec(AS)] .) if not VAR in vars(T) . --- is the time variable given a <=/le-bound? op _exactlyBoundIn_ : Variable Condition -> Bool . eq VAR exactlyBoundIn nil = false . ceq VAR exactlyBoundIn (COND /\ COND') = (VAR exactlyBoundIn COND) or (VAR exactlyBoundIn COND') if COND =/= nil /\ COND' =/= nil . eq VAR exactlyBoundIn (T : S:Sort) = false . eq VAR exactlyBoundIn (T := T') = (T == VAR) and not (VAR in vars(T')) . eq VAR exactlyBoundIn (T => T') = false . eq VAR exactlyBoundIn (VAR = T) = false . eq VAR exactlyBoundIn (C:Constant = T) = false . eq VAR exactlyBoundIn (Q[T] = T') = false . eq VAR exactlyBoundIn (Q[T, T'] = T'') = --- main case (Q == '_le_ or Q == '_<=_) and (T == VAR) and (T'' == 'true.Bool) and (not VAR in vars(T')) . eq VAR exactlyBoundIn (Q[T, T', NETL] = T'') = false . --- Now, we apply the TSS "max" ceq applyTSS(crl T => '_in`time_[T', VAR] if COND /\ '_le_[VAR, U] = 'true.Bool /\ COND' [AS] ., max) = (crl T => '_in`time_[T', VAR] if COND /\ VAR := U /\ COND' [removeNonexec(AS)] .) if not VAR in (vars(T) ; initializedVars(COND /\ COND')) . ceq applyTSS(crl T => '_in`time_[T', VAR] if COND /\ '_<=_[VAR, U] = 'true.Bool /\ COND' [AS] ., max) = (crl T => '_in`time_[T', VAR] if COND /\ VAR := U /\ COND' [removeNonexec(AS)] .) if not VAR in (vars(T) ; initializedVars(COND /\ COND')) . --- all other kinds of nondet tick rules: ceq applyTSS(crl T => '_in`time_[T', VAR] if COND [AS] ., max) = (crl T => '_in`time_[T', VAR] if COND [AS] .) if ndTicks(crl T => '_in`time_[T', VAR] if COND [AS] .) and not (VAR exactlyBoundIn COND) . ceq applyTSS(rl T => '_in`time_[T', VAR] [AS] ., max) = (rl T => '_in`time_[T', VAR] [AS] .) if ndTicks(rl T => '_in`time_[T', VAR] [AS] .) . --- maxDef ceq applyTSS(crl T => '_in`time_[T', VAR] if COND /\ '_le_[VAR, U] = 'true.Bool /\ COND' [AS] ., maxDef(T'')) = (crl T => '_in`time_[T', VAR] if COND /\ VAR := 'if_then_else_fi['_::`Time[U], U, T''] /\ '_le_[VAR, U] = 'true.Bool /\ COND' [removeNonexec(AS)] .) if not VAR in (vars(T) ; initializedVars(COND /\ COND')) . *** same, but for '_<=_: ceq applyTSS(crl T => '_in`time_[T', VAR] if COND /\ '_<=_[VAR, U] = 'true.Bool /\ COND' [AS] ., maxDef(T'')) = (crl T => '_in`time_[T', VAR] if COND /\ VAR := 'if_then_else_fi['_::`Time[U], U, T''] /\ '_<=_[VAR, U] = 'true.Bool /\ COND' [removeNonexec(AS)] .) if not VAR in (vars(T) ; initializedVars(COND /\ COND')) . --- now, for the cases in which there is no fixed upper bound: ceq applyTSS(crl T => '_in`time_[T', VAR] if COND [AS] ., maxDef(T'')) = (crl T => '_in`time_[T', VAR] if VAR := T'' /\ COND [removeNonexec(AS)] .) if not VAR in (vars(T) ; initializedVars(COND)) /\ not (VAR exactlyBoundIn COND) . ceq applyTSS(rl T => '_in`time_[T', VAR] [AS] ., maxDef(T'')) = (crl T => '_in`time_[T', VAR] if VAR := T'' [removeNonexec(AS)] .) if not VAR in vars(T) . endfm --- All the transformations: fmod TIMED-MODULE-TRANSFORMATIONS is protecting DONT-TICK-PAST-TIME-TRANSFORMATION . protecting LOOP-WHEN-LIMIT-TRANSFORMATION . protecting REMOVE-CLOCKS-TRANSFORMATION . protecting NO-ZERO-TICK-TRANSFORMATION . protecting APPLY-TIME-SAMPLING-STRATEGY-TRANSFORMATION . endfm --- Timed rewriting. --- ---------------- --- For implementation purposes, an important difference is --- that the time sampling strategy must now be given as a parameter. fmod TIMED-META-REWRITE is protecting TIMED-MODULE-TRANSFORMATIONS . op timedMetaRewrite : Module Term Bound ComparisonOp Term TickMode -> ResultPair . op timedMetaFRewrite : Module Term Bound Nat ComparisonOp Term TickMode -> ResultPair . *** unfair and fair rewrite! *** Without time limits: op timedMetaRewrite : Module Term Bound TickMode -> ResultPair . op timedMetaFRewrite : Module Term Bound Nat TickMode -> ResultPair . *** Does not apply tick rules with time increase zero! *** The comparisonOp must in this case be le or lt of course. var M : Module . vars T T' : Term . var B : Bound . var N : Nat . var COMP : ComparisonOp . var TM : TickMode . eq timedMetaRewrite(M, T, B, COMP, T', TM) = removeGlobal(metaRewrite(dontTickPastTime(noZeroTick(applyTSS(M, TM)), COMP, T'), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), B)) . eq timedMetaFRewrite(M, T, B, N, COMP, T', TM) = removeGlobal(metaFrewrite(dontTickPastTime(noZeroTick(applyTSS(M, TM)), COMP, T'), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), B, N)) . *** Limit-less versions: eq timedMetaRewrite(M, T, B, TM) = removeGlobal(metaRewrite(globalizeMod(noZeroTick(applyTSS(M, TM))), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), B)) . eq timedMetaFRewrite(M, T, B, N, TM) = removeGlobal(metaFrewrite(globalizeMod(noZeroTick(applyTSS(M, TM))), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), B, N)) . endfm --- Timed Search. --- First, we define a module which expands an OO pattern by changing --- a constant class name C in a pattern to a variable --- CLASS_OF_o:C for 'o' the identifier of the object in the pattern. --- Furthermore, for each object in a pattern which does not come with --- a variable of sort AttributeSet, we adds such a variable --- REMAINING_ATTRIBUTES_OF_o:AttributeSet. --- Notice that this is done on "flat" OO modules, since they --- are the ones for which we have spec tech's in the real-time case: --- --------------------------------------------------------- --- Expands a pattern for object-oriented search by changing --- each object in the search pattern as follows: --- 1. if the class identifier of the object is just a class C, --- it is changed to a variable CLASS_OF_O:C, where O is the --- object identifier in the pattern (which is often a variable). --- 2. Since a subclass may have more attributes, we also add --- an attribute variable ATTRIBUTES_OF_O:AttributeSet --- IF the attribute set of the object pattern --- already does not have a variable of sort AttributeSet. --- * Does NOT change the condition. So if someone --- has a pattern a la "< O : C | ... > such that (not C :: D) ..." --- then BAD LUCK. Of course, then the person should explicitly --- write "< O : X:C | ... > such that (not X:C :: D)", since she --- clearly understands what is going on. --- * Only performed for FLAT OO systems, since they are the only systems --- so far for which we have developed spec techniques in the timed case. --- * Notice the name of the new variables. It is NOT tested whether --- these are unique names, which they of course should be in any --- non-pathological setting ... fmod EXPAND-OBJECT-PATTERN is protecting META-LEVEL . --- metaprettyprint protecting EXT-QID . --- conc op expandObjectPattern : Module Term ~> Term . op expandObjectPattern : Module TermList -> TermList . vars F Q Q' : Qid . var M : Module . var TL : TermList . var NETL : NeTermList . vars T T1 T2 T3 : Term . var QL : QidList . ceq expandObjectPattern(M, F[TL]) = F[expandObjectPattern(M, TL)] if F =/= '<_:_|_> and F =/= '<_:_|`> . eq expandObjectPattern(M, (T , NETL)) = expandObjectPattern(M, T) , expandObjectPattern(M, NETL) . eq expandObjectPattern(M, C:Constant) = C:Constant . eq expandObjectPattern(M, V:Variable) = V:Variable . eq expandObjectPattern(M, '<_:_|_>[T1, T2, T3]) = '<_:_|_>[T1, expandClass(M, T1, T2), expandAttributes(M, T1, T3)] . eq expandObjectPattern(M, '<_:_|`>[T1, T2]) = expandObjectPattern(M, '<_:_|_>[T1, T2, 'none.AttributeSet]) . op expandClass : Module Term Term -> Term . --- usage: expandClass(Mod, Oid, Class) eq expandClass(M, T1, T2) = if T2 :: Constant then --- change class id: makeVariable('CLASS_OF_, M, T1, getName(T2)) else --- leave as is ... T2 fi . op makeVariable : Qid Module Term Type ~> Variable . --- usage: makeVariable(nameOfVar, mod, oid, typeForVar) eq makeVariable(Q, M, C:Constant, Q') = conc(conc(conc(Q, getName(C:Constant)), ':), Q') . eq makeVariable(Q, M, V:Variable, Q') = conc(conc(conc(Q, getName(V:Variable)), ':), Q') . eq makeVariable(Q, M, F[NETL], Q') = conc(conc(conc(Q, qidlistToQid(metaPrettyPrint(M, F[NETL]))), ':), Q') . op qidlistToQid : QidList -> Qid . eq qidlistToQid(nil) = ' . eq qidlistToQid(Q QL) = conc(Q, qidlistToQid(QL)) . op expandAttributes : Module Term Term -> Term . --- usage: expandAttributes(Mod, Oid, Attributes) eq expandAttributes(M, T1, T2) = if containsAttsVar(T2) then T2 else (if T2 == 'none.AttributeSet then makeVariable('ATTRIBUTES_OF_, M, T1, 'AttributeSet) else '_`,_[T2, makeVariable('REMAINING_ATTRIBUTES_OF_, M, T1, 'AttributeSet)] fi) fi . op containsAttsVar : Term -> Bool . eq containsAttsVar(V:Variable) = getType(V:Variable) == 'AttributeSet . eq containsAttsVar(C:Constant) = false . eq containsAttsVar('_`,_[T1, T2]) = containsAttsVar(T1) or containsAttsVar(T2) . eq containsAttsVar('_:_[T1, T2]) = false . eq containsAttsVar(T) = false [owise] . endfm --- -------------------------------------------------------- fmod TIMED-META-SEARCH is protecting TIMED-MODULE-TRANSFORMATIONS . protecting EXPAND-OBJECT-PATTERN . --- NEW!!! op timedMetaSearch : Module Term Term Condition Qid Bound Nat ComparisonOp Term TickMode ~> ResultTriple? . *** The next-to-last two ones are the time limit ... op timedMetaSearch : Module Term Term Condition Qid Bound Nat ComparisonOp Term ComparisonOp Term TickMode ~> ResultTriple? . *** For search in a time interval! var M : Module . vars T T' T'' T''' : Term . var COND : Condition . var Q : Qid . var B : Bound . var N : Nat . vars COMP COMP' : ComparisonOp . var TM : TickMode . ceq timedMetaSearch(M, T, T', COND, Q, B, N, COMP, T'', TM) = removeGlobal( metaSearch( dontTickPastTime(noZeroTick(applyTSS(M, TM)), COMP, T''), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), expandObjectPattern(M, globalizeTerm(T', myNewVar(T'))), COND, Q, B, N)) if (Q == ') or (Q == '+) or (Q == '*) /\ (COMP == le) or (COMP == lt) . ceq timedMetaSearch(M, T, T', COND, Q, B, N, COMP, T'', TM) = removeGlobal( metaSearch( globalizeMod(noZeroTick(applyTSS(M, TM))), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), expandObjectPattern(M, globalizeTerm(T', myNewVar(T'))), COND /\ searchTimeConstraint(globalizeTerm(T', myNewVar(T')), COMP, T''), Q, B, N)) if (COMP == ge) or (COMP == gt) . op searchTimeConstraint : Term ComparisonOp Term -> Condition . *** Adds a constraint that relates the global time elapse, WHICH MUST *** be in GLOBALIZED form. searchTimeConstraint(t0, ge, timelimit) *** gives a condition that ensures that time elapse is ge timelimit! eq searchTimeConstraint('global['_in`time_[T, T']], COMP, T'') = (comparisonOpSymbol(COMP)[T', T''] = 'true.Bool) . *** Now, we find normal forms within a time frame!!! ceq timedMetaSearch(M, T, T', COND, '!, B, N, COMP, T'', TM) = removeGlobal( metaSearch( loopWhenLimit(noZeroTick(applyTSS(M, TM)), COMP, T''), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), expandObjectPattern(M, globalizeTerm(T', myNewVar(T'))), COND /\ searchTimeConstraint(globalizeTerm(T', myNewVar(T')), COMP, T''), '!, B, N)) if (COMP == le) or (COMP == lt) . *** *** Interval search: form: the last four arguments are denote the *** interval: eg [r, r'> is "ge r lt r'" ceq timedMetaSearch(M, T, T', COND, Q, B, N, COMP, T'', COMP', T''', TM) = removeGlobal( metaSearch( dontTickPastTime(noZeroTick(applyTSS(M, TM)), COMP', T'''), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), expandObjectPattern(M, globalizeTerm(T', myNewVar(T'))), COND /\ searchTimeConstraint(globalizeTerm(T', myNewVar(T')), COMP, T''), Q, B, N)) if (Q == ') or (Q == '+) or (Q == '*) . eq timedMetaSearch(M, T, T', COND, '!, B, N, COMP, T'', COMP', T''', TM) = removeGlobal( metaSearch( loopWhenLimit(noZeroTick(applyTSS(M, TM)), COMP', T'''), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), expandObjectPattern(M, globalizeTerm(T', myNewVar(T'))), COND /\ searchTimeConstraint(globalizeTerm(T', myNewVar(T')), COMP, T'') /\ searchTimeConstraint(globalizeTerm(T', myNewVar(T')), COMP', T'''), '!, B, N)) . endfm --- We may be interested in UNTIMED metaSearch in the sense --- that the clocks should be removed from the module: fmod UNTIMED-SEARCH is protecting TIMED-MODULE-TRANSFORMATIONS . protecting EXPAND-OBJECT-PATTERN . op untimedMetaSearch : Module Term Term Condition Qid Bound Nat TickMode ~> ResultTriple? . eq untimedMetaSearch(M:Module, T:Term, T':Term, COND:Condition, Q:Qid, B:Bound, N:Nat, TM:TickMode) = metaSearch(removeClocks(noZeroTick(applyTSS(M:Module, TM:TickMode))), T:Term, expandObjectPattern(M:Module, T':Term), COND:Condition, Q:Qid, B:Bound, N:Nat) . endfm fmod FIND-EARLIEST is including TIMED-MODULE-TRANSFORMATIONS . protecting EXPAND-OBJECT-PATTERN . *** Find the earliest time something (a search condition) *** can happen. Assumes of course linear time! op findEarliest : Module Term Term Condition TickMode ~> ResultTriple? . op findEarliestGlobal : Module Term Term Condition ~> ResultTriple? . op findEarliestGlobal : Module Term Term Condition Term ~> ResultTriple? . *** The last one is the time term. --- auxiliary function: op timePart : Term -> Term . *** Gives the total time elapse in a term, which is either a *** GlobalSystem or Clockedsystem or a "global" term, or 'zero.Time if *** it is not a ClockedSystem term. Should give error instead?? vars THIS_SEARCH SEARCH_EARLIER : ResultTriple? . *** Should these even be of the KIND?? var M : Module . vars T T' T'' : Term . var COND : Condition . var TM : TickMode . var TL : TermList . var F : Qid . eq findEarliest(M, T, T', COND, TM) = removeGlobal( findEarliestGlobal(globalizeMod(noZeroTick(applyTSS(M, TM))), globalizeTerm(M, T, getTerm(metaReduce(M,'zero.Time))), expandObjectPattern(M, globalizeTerm(T', myNewVar(T'))), COND)) . ceq findEarliestGlobal(M, T, T', COND) = if THIS_SEARCH == failure then failure else (if SEARCH_EARLIER == failure then THIS_SEARCH else SEARCH_EARLIER fi) fi if THIS_SEARCH := metaSearch(M, T, T', COND, '*, unbounded, 0) /\ SEARCH_EARLIER := (if THIS_SEARCH == failure then failure else findEarliestGlobal(M, T, T', COND, timePart(getTerm(THIS_SEARCH))) fi) . *** Cannot find a state in time less than zero: ceq findEarliestGlobal(M, T, T', COND, T'') = failure if getTerm(metaReduce(M, '_==_[T'', 'zero.Time])) = 'true.Bool . ceq findEarliestGlobal(M, T, T', COND, T'') = if THIS_SEARCH == failure then failure else (if SEARCH_EARLIER == failure then THIS_SEARCH else SEARCH_EARLIER fi) fi if getTerm(metaReduce(M, '_lt_['zero.Time, T''])) == 'true.Bool /\ THIS_SEARCH := metaSearch(dontTickPastTime(M, lt, T''), T, T', COND, '*, unbounded, 0) /\ SEARCH_EARLIER := (if THIS_SEARCH == failure then failure else findEarliestGlobal(M, T, T', COND, timePart(getTerm(THIS_SEARCH))) fi) . eq timePart('global[T]) = timePart(T) . eq timePart('_in`time_[T, T']) = T' . eq timePart('`{_`}[T]) = 'zero.Time . ceq timePart(F[TL]) = 'zero.Time if (F =/= 'global) and (F =/= '_in`time_) and (F =/= '`{_`}) . eq timePart(C:Constant) = 'zero.Time . eq timePart(V:Variable) = 'zero.Time . endfm --- The next module is a search-based model checker which --- model checks |= <> P, and returns "noterm" if the property does --- NOT hold, and returns the LATEST path otherwise, i.e., --- for each path, it takes the first state matching the proeprty, --- and among those it outputs the one with the longest time elapse. --- Guarantee that within time we will always --- be able to reach a desired state. fmod FIND-LATEST is protecting FIND-EARLIEST . protecting ALL-ONE-STEP-REWRITES . op findLatest : Module Term Term Condition Bool TickMode -> Termset . --- returns either noterm or a term. The Bool argument indicates whether --- we are looking for terms matching the pattern or not. op findLatest : Module Term Term Condition Bool ComparisonOp Term TickMode -> Termset . --- Same as above, just with additional time constraints. --- Essentially model checks |= <>__<=r properties --- helpful auxiliary function op tooOld : Module Term ComparisonOp Term -> Bool . --- This holds if NOT the time part of first term COMP second term. op matches : Module Term Term Condition Bool -> Bool . --- Does [or does not, depending on the last argument] the third argument --- [the pattern] match the second argument [the ground term]? var M : Module . vars T T' T'' : Term . vars TS TS' TS'' : Termset . var COND : Condition . var B : Bool . var COMP : ComparisonOp . var TM : TickMode . eq findLatest(M, T, T', COND, B, TM) = removeGlobal( findLatest(globalizeMod(noZeroTick(applyTSS(M,TM))), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), noterm, expandObjectPattern(M, globalizeTerm(T', myNewVar(T'))), COND, B, noterm)) . op removeGlobal : Termset -> Termset . eq removeGlobal(noterm) = noterm . eq findLatest(M, T, T', COND, B, COMP, T'', TM) = removeGlobal( findLatest(globalizeMod(noZeroTick(applyTSS(M, TM))), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), noterm, expandObjectPattern(M, globalizeTerm(T', myNewVar(T'))), COND, B, noterm, COMP, T'')) . op findLatest : Module Termset Termset Term Condition Bool Termset -> Termset . *** findLatest[Mod, termsToCheckInThisRound, termsToCheckInNextRound, *** Pattern, Condition, match/notMatch?, resultTillNow] eq findLatest(M, T || TS, TS', T', COND, B, TS'') = if matches(M, T, T', COND, B) then findLatest(M, TS, TS', T', COND, B, if TS'' == noterm or getTerm(metaReduce(M, '_lt_[timePart(TS''), timePart(T)])) == 'true.Bool then T else TS'' fi) else (if allNextStates(M, T) == noterm then noterm *** failure else findLatest(M, TS, TS' || allNextStates(M, T), T', COND, B, TS'') fi) fi . eq findLatest(M, noterm, TS', T', COND, B, TS'') = if TS' == noterm then TS'' else findLatest(M, TS', noterm, T', COND, B, TS'') fi . *** new round *** Now, for timebounded search: op findLatest : Module Termset Termset Term Condition Bool Termset ComparisonOp Term -> Termset . *** findLatest[Mod, termsToCheckInThisRound, termsToCheckInNextRound, *** Pattern, Condition, match/notMatch?, resultTillNow, timeLimit] eq findLatest(M, T || TS, TS', T', COND, B, TS'', COMP, T'') = if tooOld(M, T, COMP, T'') then noterm ***failure else (if matches(M, T, T', COND, B) then findLatest(M, TS, TS', T', COND, B, if TS'' == noterm or getTerm(metaReduce(M, '_lt_[timePart(TS''), timePart(T)])) == 'true.Bool then T else TS'' fi, COMP, T'') else (if allNextStates(M, T) == noterm then noterm *** failure else findLatest(M, TS, TS' || allNextStates(M, T), T', COND, B, TS'', COMP, T'') fi) fi) fi . eq findLatest(M, noterm, TS', T', COND, B, TS'', COMP, T'') = if TS' == noterm then TS'' else findLatest(M, TS', noterm, T', COND, B, TS'', COMP, T'') fi . *** new round eq tooOld(M, T, COMP, T') = getTerm(metaReduce(M, comparisonOpSymbol(COMP)[timePart(T), T'])) == 'false.Bool . eq matches(M, T, T', COND, B:Bool) = (metaMatch(M, T', T, COND, 0) :: Substitution) == B:Bool . endfm *** The next module model checks by search for *** diamond properties, be it with or without time. *** A counterexample term is returned, or noterm in case the property *** holds. *** One may also provide a bound on the depth of the search tree. fmod MODEL-CHECK-DIAMOND is protecting FIND-LATEST . op diamond : Module Term Term Condition Bool -> Termset . *** init pattern cond not match? op diamond : Module Term Term Condition Bool Bound -> Termset . *** max depth op timedDiamond : Module Term Term Condition Bool TickMode -> Termset . *** init pattern cond not match? op timedDiamond : Module Term Term Condition Bool Bound TickMode -> Termset . *** max depth *** The difference between diamond and timedDiamond in the cases *** above is that timedDiamond does a timed search, *** that is, the pattern may throughout be a system-term *** and is checked accordingly. diamond is PLAIN untimed search. op timedDiamond : Module Term Term Condition Bool ComparisonOp Term TickMode -> Termset . *** within time op timedDiamond : Module Term Term Condition Bool Bound ComparisonOp Term TickMode -> Termset . var M : Module . vars T T' T'' : Term . var COND : Condition . var COMP : ComparisonOp . var N : Nat . var B : Bool . var BOUND : Bound . vars TS TS' : Termset . var TM : TickMode . eq diamond(M, T, T', COND, B) = diamond(M, T, T', COND, B, unbounded) . eq timedDiamond(M, T, T', COND, B, TM) = timedDiamond(M, T, T', COND, B, unbounded, TM) . eq timedDiamond(M, T, T', COND, B, BOUND, TM) = removeGlobal(diamond(globalizeMod(noZeroTick(applyTSS(M, TM))), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), expandObjectPattern(M, globalizeTerm(T', myNewVar(T'))), COND, B, BOUND)) . eq timedDiamond(M, T, T', COND, B, COMP, T'', TM) = timedDiamond(M, T, T', COND, B, unbounded, COMP, T'', TM) . *** The following is PROBABLY not what we want: ***( eq timedDiamond(M, T, T', COND, B, BOUND, COMP, T'', TM) = removeGlobal( diamond(dontTickPastTime(noZeroTick(applyTSS(M, TM)), COMP, T''), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), globalizeTerm(T', myNewVar(T')), COND, B, BOUND)) . )*** *** Instead we use the following: eq timedDiamond(M, T, T', COND, B, BOUND, COMP, T'', TM) = removeGlobal( timedDiamond(globalizeMod(noZeroTick(applyTSS(M, TM))), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), noterm, expandObjectPattern(M, globalizeTerm(T', myNewVar(T'))), COND, B, 0, BOUND, COMP, T'')) . *** Main starting call: eq diamond(M, T, T', COND, B, BOUND) = diamond(M, T, noterm, T', COND, B, 0, BOUND) . *** This is the engine of the thing: op diamond : Module Termset Termset Term Condition Bool Nat Bound -> Termset . *** termsInthisround termsinnext round ... pattern ... *** currentroundnumber maximal depth eq diamond(M, T || TS, TS', T', COND, B, N, BOUND) = if matches(M, T, T', COND, B) then diamond(M, TS, TS', T', COND, B, N, BOUND) else (if (N == BOUND) or allNextStates(M, T) == noterm then T *** last state in a counterexample else diamond(M, TS, TS' || allNextStates(M, T), T', COND, B, N, BOUND) fi) fi . eq diamond(M, noterm, noterm, T', COND, B, N, BOUND) = noterm . eq diamond(M, noterm, T || TS, T', COND, B, N, BOUND) = diamond(M, T || TS, noterm, T', COND, B, N + 1, BOUND) . *** New round *** This is the engine of timedDiamond: op timedDiamond : Module Termset Termset Term Condition Bool Nat Bound ComparisonOp Term -> Termset . *** termsInthisround termsinnext round ... pattern ... *** currentroundnumber maximal depth ... timelimit eq timedDiamond(M, T || TS, TS', T', COND, B, N, BOUND, COMP, T'') = if tooOld(M, T, COMP, T'') then T else (if matches(M, T, T', COND, B) then timedDiamond(M, TS, TS', T', COND, B, N, BOUND, COMP, T'') else (if (N == BOUND) or allNextStates(M, T) == noterm then T *** last state in a counterexample else timedDiamond(M, TS, TS' || allNextStates(M, T), T', COND, B, N, BOUND, COMP, T'') fi) fi) fi . eq timedDiamond(M, noterm, noterm, T', COND, B, N, BOUND, COMP, T'') = noterm . *** New round: eq timedDiamond(M, noterm, T || TS, T', COND, B, N, BOUND, COMP, T'') = timedDiamond(M, T || TS, noterm, T', COND, B, N + 1, BOUND, COMP, T'') . endfm fmod MODEL-CHECK-UNTIL is protecting MODEL-CHECK-DIAMOND . *** untimed versions. Do not use for time ... op until : Module Term Term Condition Bool Term Condition Bool -> Termset . op until : Module Term Term Condition Bool Term Condition Bool Bound -> Termset . *** until init PATTERN1 PATTERN2 var M : Module . vars T T' T'' T''' : Term . vars TS TS' : Termset . vars COND COND' : Condition . vars B B' : Bool . var BOUND : Bound . var N : Nat . var COMP : ComparisonOp . var TM : TickMode . eq until(M, T, T', COND, B, T'', COND', B') = until(M, T, T', COND, B, T'', COND', B', unbounded) . eq until(M, T, T', COND, B, T'', COND', B', BOUND) = until(M, T, noterm, expandObjectPattern(M, T'), COND, B, expandObjectPattern(M, T''), COND', B', 0, BOUND) . *** real engine: op until : Module Termset Termset Term Condition Bool Term Condition Bool Nat Bound -> Termset . *** main part of loop: eq until(M, T || TS, TS', T', COND, B, T'', COND', B', N, BOUND) = if matches(M, T, T'', COND', B') then until(M, TS, TS', T', COND, B, T'', COND', B', N, BOUND) else (if (N == BOUND or (not matches(M, T, T', COND, B)) or allNextStates(M, T) == noterm) then T else until(M, TS, TS' || allNextStates(M, T), T', COND, B, T'', COND', B', N, BOUND) fi) fi . *** No more states to check: [Can this happen?] eq until(M, noterm, noterm, T', COND, B, T'', COND', B', N, BOUND) = noterm . *** New round: eq until(M, noterm, TS, T', COND, B, T'', COND', B', N, BOUND) = until(M, TS, noterm, T', COND, B, T'', COND', B', N + 1, BOUND) . *** This checks also for timed pattern, and can be given time constraints *** in which the property should hold ... op timedUntil : Module Term Term Condition Bool Term Condition Bool TickMode -> Termset . op timedUntil : Module Term Term Condition Bool Term Condition Bool Bound TickMode -> Termset . op timedUntil : Module Term Term Condition Bool Term Condition Bool ComparisonOp Term TickMode -> Termset . op timedUntil : Module Term Term Condition Bool Term Condition Bool Bound ComparisonOp Term TickMode -> Termset . eq timedUntil(M, T, T', COND, B, T'', COND', B', TM) = timedUntil(M, T, T', COND, B, T'', COND', B', unbounded, TM) . eq timedUntil(M, T, T', COND, B, T'', COND', B', BOUND, TM) = removeGlobal(until(globalizeMod(noZeroTick(applyTSS(M, TM))), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), expandObjectPattern(M, globalizeTerm(T', myNewVar(T'))), COND, B, expandObjectPattern(M, globalizeTerm(T'', myNewVar(T''))), COND', B', BOUND)) . eq timedUntil(M, T, T', COND, B, T'', COND', B', COMP, T''', TM) = timedUntil(M, T, T', COND, B, T'', COND', B', unbounded, COMP, T''', TM) . eq timedUntil(M, T, T', COND, B, T'', COND', B', BOUND, COMP, T''', TM) = removeGlobal( timedUntil(globalizeMod(noZeroTick(applyTSS(M, TM))), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), noterm, expandObjectPattern(M, globalizeTerm(T', myNewVar(T'))), COND, B, expandObjectPattern(M, globalizeTerm(T'', myNewVar(T''))), COND', B', 0, BOUND, COMP, T''')) . op timedUntil : Module Termset Termset Term Condition Bool Term Condition Bool Nat Bound ComparisonOp Term -> Termset . eq timedUntil(M, T || TS, TS', T', COND, B, T'', COND', B', N, BOUND, COMP, T''') = if tooOld(M, T, COMP, T''') then T else --- in principle the --- wrong answer, since --- T is too old. It's --- predecessor should --- be shown (if matches(M, T, T'', COND', B') then timedUntil(M, TS, TS', T', COND, B, T'', COND', B', N, BOUND, COMP, T''') else (if (N == BOUND or (not matches(M, T, T', COND, B)) or allNextStates(M, T) == noterm) then T else timedUntil(M, TS, TS' || allNextStates(M, T), T', COND, B, T'', COND', B', N, BOUND, COMP, T''') fi) fi) fi . *** No more states to check: [Can this happen?] eq timedUntil(M, noterm, noterm, T', COND, B, T'', COND', B', N, BOUND, COMP, T''') = noterm . *** New round: eq timedUntil(M, noterm, TS, T', COND, B, T'', COND', B', N, BOUND, COMP, T''') = timedUntil(M, TS, noterm, T', COND, B, T'', COND', B', N + 1, BOUND, COMP, T''') . endfm fmod MODEL-CHECK-UNTIL-STABLE is protecting MODEL-CHECK-DIAMOND . *** untimed versions. Do not use for time ... op untilStable : Module Term Term Condition Bool Term Condition Bool -> Termset . op untilStable : Module Term Term Condition Bool Term Condition Bool Bound -> Termset . *** until init PATTERN1 PATTERN2 var M : Module . vars T T' T'' T''' : Term . vars TS TS' TS'' TS''' : Termset . vars COND COND' : Condition . vars B B' : Bool . var BOUND : Bound . var N : Nat . var COMP : ComparisonOp . var TM : TickMode . eq untilStable(M, T, T', COND, B, T'', COND', B') = untilStable(M, T, T', COND, B, T'', COND', B', unbounded) . eq untilStable(M, T, T', COND, B, T'', COND', B', BOUND) = untilStable(M, T, noterm, noterm, noterm, expandObjectPattern(M, T'), COND, B, expandObjectPattern(M, T''), COND', B', 0, BOUND) . *** real engine: op untilStable : Module Termset Termset Termset Termset Term Condition Bool Term Condition Bool Nat Bound -> Termset . *** main part of loop: eq untilStable(M, T || TS, TS', TS'', TS''', T', COND, B, T'', COND', B', N, BOUND) = if matches(M, T, T'', COND', B') then untilStable(M, TS, TS', TS'', TS''' || (if N == BOUND then noterm else allNextStates(M, T) fi), T', COND, B, T'', COND', B', N, BOUND) else (if (N == BOUND or (not matches(M, T, T', COND, B)) or allNextStates(M, T) == noterm) then T else untilStable(M, TS, TS' || allNextStates(M, T), TS'', TS''', T', COND, B, T'', COND', B', N, BOUND) fi) fi . *** Treat term which has already satisfied q in p US q: eq untilStable(M, noterm, TS, T || TS', TS'', T', COND, B, T'', COND', B', N, BOUND) = if not matches(M, T, T'', COND', B') then T else untilStable(M, noterm, TS, TS', TS'' || (if N == BOUND then noterm else allNextStates(M, T) fi), T', COND, B, T'', COND', B', N, BOUND) fi . *** No more states to check: eq untilStable(M, noterm, noterm, noterm, noterm, T', COND, B, T'', COND', B', N, BOUND) = noterm . *** New round: ceq untilStable(M, noterm, TS, noterm, TS', T', COND, B, T'', COND', B', N, BOUND) = untilStable(M, TS, noterm, TS', noterm, T', COND, B, T'', COND', B', N + 1, BOUND) if TS =/= noterm or TS' =/= noterm . *** This checks also for timed pattern, and can be given time constraints *** in which the property should hold ... op timedUntilStable : Module Term Term Condition Bool Term Condition Bool TickMode -> Termset . op timedUntilStable : Module Term Term Condition Bool Term Condition Bool Bound TickMode -> Termset . op timedUntilStable : Module Term Term Condition Bool Term Condition Bool ComparisonOp Term TickMode -> Termset . op timedUntilStable : Module Term Term Condition Bool Term Condition Bool Bound ComparisonOp Term TickMode -> Termset . eq timedUntilStable(M, T, T', COND, B, T'', COND', B', TM) = timedUntilStable(M, T, T', COND, B, T'', COND', B', unbounded, TM) . eq timedUntilStable(M, T, T', COND, B, T'', COND', B', BOUND, TM) = removeGlobal(untilStable(globalizeMod(noZeroTick(applyTSS(M, TM))), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), expandObjectPattern(M, globalizeTerm(T', myNewVar(T'))), COND, B, expandObjectPattern(M, globalizeTerm(T'', myNewVar(T''))), COND', B', BOUND)) . eq timedUntilStable(M, T, T', COND, B, T'', COND', B', COMP, T''', TM) = timedUntilStable(M, T, T', COND, B, T'', COND', B', unbounded, COMP, T''', TM) . eq timedUntilStable(M, T, T', COND, B, T'', COND', B', BOUND, COMP, T''', TM) = removeGlobal( timedUntilStable(globalizeMod(noZeroTick(applyTSS(M, TM))), globalizeTerm(M, T, getTerm(metaReduce(M, 'zero.Time))), noterm, noterm, noterm, expandObjectPattern(M, globalizeTerm(T', myNewVar(T'))), COND, B, expandObjectPattern(M, globalizeTerm(T'', myNewVar(T''))), COND', B', 0, BOUND, COMP, T''')) . op timedUntilStable : Module Termset Termset Termset Termset Term Condition Bool Term Condition Bool Nat Bound ComparisonOp Term -> Termset . eq timedUntilStable(M, T || TS, TS', TS'', TS''', T', COND, B, T'', COND', B', N, BOUND, COMP, T''') = if tooOld(M, T, COMP, T''') then T else (if matches(M, T, T'', COND', B') then timedUntilStable(M, TS, TS', TS'', TS''' || (if N == BOUND then noterm else allNextStates(M, T) fi), T', COND, B, T'', COND', B', N, BOUND, COMP, T''') else (if (N == BOUND or (not matches(M, T, T', COND, B)) or allNextStates(M, T) == noterm) then T else timedUntilStable(M, TS, TS' || allNextStates(M, T), TS'', TS''', T', COND, B, T'', COND', B', N, BOUND, COMP, T''') fi) fi) fi . eq timedUntilStable(M, noterm, TS, T || TS', TS'', T', COND, B, T'', COND', B', N, BOUND, COMP, T''') = if tooOld(M, T, COMP, T''') then timedUntilStable(M, noterm, TS, TS', TS'', T', COND, B, T'', COND', B', N, BOUND, COMP, T''') else (if (not matches(M, T, T'', COND', B')) then T else timedUntilStable(M, noterm, TS, TS', TS'' || (if N == BOUND then noterm else allNextStates(M, T) fi), T', COND, B, T'', COND', B', N, BOUND, COMP, T''') fi) fi . *** No more states to check: eq timedUntilStable(M, noterm, noterm, noterm, noterm, T', COND, B, T'', COND', B', N, BOUND, COMP, T''') = noterm . *** New round: ceq timedUntilStable(M, noterm, TS, noterm, TS', T', COND, B, T'', COND', B', N, BOUND, COMP, T''') = timedUntilStable(M, TS, noterm, TS', noterm, T', COND, B, T'', COND', B', N + 1, BOUND, COMP, T''') if TS =/= noterm or TS' =/= noterm . endfm *** ******************************** *** Timed model checking *** ******************************** *** Two different kinds of model checking: *** 1. untimed: forget about time, clocks, etc. *** 2. timed: here we are dragging along the clocks, *** and propositions may be unclocked, in which case *** they are valid for any time [use time 0 for properties which *** are only valid at that time], and clocked properties where *** the user herself defines the times at which a property *** should hold. fmod TIMED-MODEL-CHECKING is protecting TIMED-MODULE-TRANSFORMATIONS . *** The following are the main functions: op metaMC : Module Term Term Qid TickMode ~> ResultPair . *** metaMC(mod, initTerm, formula, mode (which is 'u or 't), tickMode) *** no time limit, 'u denotes untimed model checking, and *** 't denotes timed model checking op metaMC : Module Term Term ComparisonOp Term TickMode ~> ResultPair . *** Here, the next-to-last two parameters are the time limit, *** where we should have lt or le, so we are in the timed model checking *** domain. vars T T' T'' : Term . var TL : TermList . var NETL : NeTermList . var M : Module . var COMP : ComparisonOp . var Q : Qid . var IL : ImportList . var SS : SortSet . var SSDS : SubsortDeclSet . var OPDS : OpDeclSet . var MAS : MembAxSet . var EQS : EquationSet . var RLS : RuleSet . var RULE : Rule . var COND : Condition . var AS : AttrSet . var TM : TickMode . var H : Header . *** Unbounded UNtimed model checking. Just remove the *** explicit clocks: eq metaMC(M, T, T', 'u, TM) = metaReduce(removeClocks(noZeroTick(applyTSS(M, TM))), 'modelCheck[removeClocks(T), T']) . *** Timed model checking with no bound: eq metaMC(M, T, T', 't, TM) = metaReduce(clockProperties(noZeroTick(applyTSS(M, TM))), 'modelCheck[T, T']) . *** Bounded timed model checking. *** Need to add a self-loop for each state which could proceed *** too far in time. *** Need to globalize the systems as well and therefore change *** some properties: eq metaMC(M, T, T', COMP, T'', TM) = removeGlobalFromMCResult( metaReduce(globalizeProperties( loopWhenLimit(noZeroTick(applyTSS(M, TM)), COMP, T'')), 'modelCheck[globalizeTerm(M,T, getTerm(metaReduce(M,'zero.Time))), T'])) . op globalizeProperties : Module -> Module . *** A property, be it clocked or not, should also work when we have to *** globalize it! eq globalizeProperties(mod H is IL sorts SS . SSDS OPDS MAS EQS RLS endm) = (mod H is IL sorts SS . SSDS OPDS MAS (EQS (ceq '_|=_['global['_in`time_['S:GlobalSystem, 'R:Time]], 'P:Prop] = 'true.Bool if '_|=_['_in`time_['S:GlobalSystem, 'R:Time], 'P:Prop] = 'true.Bool [none] . ) (ceq '_|=_['global['_in`time_['S:GlobalSystem, 'R:Time]], 'P:Prop] = 'true.Bool if '_|=_['S:GlobalSystem, 'P:Prop] = 'true.Bool [none] . )) RLS endm) . *** Also for functional modules, even though that should *** not happen! eq globalizeProperties(fmod H is IL sorts SS . SSDS OPDS MAS EQS endfm) = (fmod H is IL sorts SS . SSDS OPDS MAS (EQS (ceq '_|=_['global['_in`time_['S:GlobalSystem, 'R:Time]], 'P:Prop] = 'true.Bool if '_|=_['_in`time_['S:GlobalSystem, 'R:Time], 'P:Prop] = 'true.Bool [none] . ) (ceq '_|=_['global['_in`time_['S:GlobalSystem, 'R:Time]], 'P:Prop] = 'true.Bool if '_|=_['S:GlobalSystem, 'P:Prop] = 'true.Bool [none] . )) endfm) . op clockProperties : Module -> Module . *** The following makes an unclocked property hold for any time *** if it holds on the state part. eq clockProperties(mod H is IL sorts SS . SSDS OPDS MAS EQS RLS endm) = (mod H is IL sorts SS . SSDS OPDS MAS (EQS (ceq '_|=_['_in`time_['S:GlobalSystem, 'R:Time], 'P:Prop] = 'true.Bool if '_|=_['S:GlobalSystem, 'P:Prop] = 'true.Bool [none] . )) RLS endm) . *** Should strictly speaking not apply to functional modules: eq clockProperties(fmod H is IL sorts SS . SSDS OPDS MAS EQS endfm) = (fmod H is IL sorts SS . SSDS OPDS MAS (EQS (ceq '_|=_['_in`time_['S:GlobalSystem, 'R:Time], 'P:Prop] = 'true.Bool if '_|=_['S:GlobalSystem, 'P:Prop] = 'true.Bool [none] . )) endfm) . *** In case we get a counterexample, we need to remove the "global" *** operator! op removeGlobalFromMCResult : ResultPair -> ResultPair . eq removeGlobalFromMCResult({'true.Bool , TY:Type}) = {'true.Bool , TY:Type} . eq removeGlobalFromMCResult({'counterexample[T, T'], TY:Type}) = {'counterexample[removeGlobalFromTransitionList(T), removeGlobalFromTransitionList(T')], TY:Type} . op removeGlobalFromTransitionList : TermList -> TermList . eq removeGlobalFromTransitionList('nil.TransitionList) = 'nil.TransitionList . eq removeGlobalFromTransitionList('__[TL]) = '__[removeGlobalFromTransitionList(TL)] . eq removeGlobalFromTransitionList((T , NETL)) = (removeGlobalFromTransitionList(T) , removeGlobalFromTransitionList(NETL)) . eq removeGlobalFromTransitionList('`{_`,_`}[T, T']) = '`{_`,_`}[removeGlobal(T), T'] . endfm *** ********************************************************************** --- ---------------------------------------------------------------------- --- Module which defines the "library" of strategies that --- can be imported by a timed module just like META-LEVEL: fmod TIMED-META-LEVEL is protecting TIMED-META-REWRITE . protecting TIMED-META-SEARCH . protecting TIMED-MODEL-CHECKING . protecting UNTIMED-SEARCH . protecting MODEL-CHECK-UNTIL . protecting MODEL-CHECK-UNTIL-STABLE . endfm --- We define a module defining the data type --- "TimedData" which stores various timed data in the --- database. This should change many times! fmod TIMED-DATA is protecting QID-LIST . protecting META-LEVEL . protecting TICK-MODES . sort TimedData . *** In the beginning, TimedData will have the form *** < timedModules, tickMode > *** where timedModules is a qidlist of the names of the timed *** modules in the system, tick mode is the mode to use when *** we encounter nondeterministic tick rules, and the tickAmount *** is the corresponding tick amount. op <_,_> : QidList TickMode -> TimedData [ctor] . var QL : QidList . var TM TM' : TickMode . var Q : Qid . op initTimedData : -> TimedData . eq initTimedData = < nil , det > . op addModName : TimedData Qid -> TimedData . eq addModName(< QL , TM >, Q) = < QL Q , TM > . op setTickMode : TimedData TickMode -> TimedData . eq setTickMode(< QL , TM >, TM') = < QL , TM' > . op getTickMode : TimedData -> TickMode . eq getTickMode(< QL , TM >) = TM . op getModNames : TimedData -> QidList . eq getModNames(< QL , TM >) = QL . endfm --- ------------------------------------------------- --- ------------------------------------------------------ --- Processing of a "timed module": --- Make a timed PreModule into a premodule by --- 1. importing TIMED-PRELUDE/TIMED-OO-PRELUDE, and --- 2. fiks importation of TIMED-META-LEVEL --- ----------------------------------------------------- fmod TIMED-UNIT-PROCESSING is protecting VIEW-PROCESSING . protecting TIMED-DATA . op timedPreModuleToPreModule : Term -> Term . vars T T' T'' T''' : Term . vars F F' : Qid . var TL : TermList . var TD : TimedData . eq timedPreModuleToPreModule('tmod_is_endtm[T, T']) = 'mod_is_endm[T, '__['including_.['token[''TIMED-PRELUDE.Qid]], T']] . eq timedPreModuleToPreModule('tomod_is_endtom[T, T']) = 'omod_is_endom[T, '__['including_.['token[''TIMED-OO-PRELUDE.Qid]], T']] . eq timedPreModuleToPreModule('tth_is_endtth[T, T']) = 'th_is_endth[T, '__['including_.['token[''TIMED-PRELUDE.Qid]], T']] . eq timedPreModuleToPreModule('toth_is_endtoth[T, T']) = 'oth_is_endoth[T, '__['including_.['token[''TIMED-OO-PRELUDE.Qid]], T']] . *** Including TIMED-META-LEVEL is the same as including *** META-LEVEL with the parameters and then including *** TIMED-META-LEVEL: op processTimedMetaLevel : Term TimedData -> Term . ceq processTimedMetaLevel(F['_`(_`)['token[''TIMED-META-LEVEL.Qid], T]], TD) = '__[F['_`(_`)['token[''META-LEVEL.Qid], T]], 'protecting_.['token[''TIMED-META-LEVEL.Qid]]] if (F == 'including_.) or (F == 'inc_.) or (F == 'protecting_.) or (F == 'pr_.) . ceq processTimedMetaLevel(F['_`(_`)['token[Q:Qid], T]], TD) = F['_`(_`)['token[Q:Qid], T]] if (Q:Qid =/= ''TIMED-META-LEVEL.Qid) and (F == 'including_.) or (F == 'inc_.) or (F == 'protecting_.) or (F == 'pr_.) . ceq processTimedMetaLevel(F[T, T'], TD) = F[T, processTimedMetaLevel(T', TD)] if (F == 'fmod_is_endfm) or (F == 'mod_is_endm) or (F == 'omod_is_endom) or (F == 'tmod_is_endtm) or (F == 'tomod_is_endtom) or (F == 'fth_is_endfth) or (F == 'th_is_endth) or (F == 'oth_is_endoth) or (F == 'obj_is_jbo) or (F == 'obj_is_endo) or (F == 'view_from_to_is_endv) or (F == 'tth_is_endtth) or (F == 'toth_is_endtoth) . eq processTimedMetaLevel('__[T, T'], TD) = '__[processTimedMetaLevel(T, TD), processTimedMetaLevel(T', TD)] . ceq processTimedMetaLevel(F[F'[TL]], TD) = F[F'[TL]] if (F' =/= '_`(_`)) and ((F == 'including_.) or (F == 'inc_.) or (F == 'protecting_.) or (F == 'pr_.)) . ceq processTimedMetaLevel(F['token[T]], TD) = F['token[T]] if (F == 'including_.) or (F == 'inc_.) or (F == 'protecting_.) or (F == 'pr_.) . ceq processTimedMetaLevel(F[TL], TD) = F[TL] if not((F == 'including_.) or (F == 'inc_.) or (F == 'protecting_.) or (F == 'pr_.) or (F == 'fmod_is_endfm) or (F == 'mod_is_endm) or (F == 'omod_is_endom) or (F == 'tmod_is_endtm) or (F == 'tomod_is_endtom) or (F == 'fth_is_endfth) or (F == 'th_is_endth) or (F == 'oth_is_endoth) or (F == 'obj_is_jbo) or (F == 'obj_is_endo) or (F == 'view_from_to_is_endv) or (F == 'tth_is_endtth) or (F == 'toth_is_endtoth) or (F == '__)) . endfm --- ------------------------------------------------------- --- TIMED COMMAND PROCESSING --- We get a "semi-parsed" metaterm which represents a Real-Time Maude --- command, and parse it further and execute the command --- by calling the appropriate meta-level functions. --- ------------------------------------------------------ fmod TIMED-COMMAND-PROCESSING is including COMMAND-PROCESSING . protecting TIMED-META-REWRITE . protecting TIMED-META-SEARCH . protecting TIMED-MODEL-CHECKING . protecting UNTIMED-SEARCH . protecting MODEL-CHECK-UNTIL . protecting MODEL-CHECK-UNTIL-STABLE . protecting TIMED-DATA . *** These are the main functions which are called to *** interpret timed commands: op procTimedCommand : Term ModuleExpression Database -> QidList . op procTimedCommand : Term ModuleExpression Database TickMode -> QidList . vars T T' T'' T''' T1 T2 T3 T4 T5 T6 PROPTERM TIMEBOUND LIMIT LIMIT' TERM : Term . var Q : Qid . var ME : ModuleExpression . var DB : Database . var B : Bool . var ODS : OpDeclSet . var TMB : [Tuple] . var TM : [Tuple] . var RP : [ResultPair] . var RT : [ResultTriple] . var TS : Termset . var TL : TermList . vars COMP COMP' : ComparisonOp . vars M M' MOD : Module . var QIL : QidList . var D BOUND : Bound . var VDS : OpDeclSet . vars TiM SOLVEDTICKMODE : TickMode . vars I J N : Nat . vars COND COND' : Condition . vars SEARCHPATTERN SEARCHPATTERN' : TermCondition . var B? : [Bool] . *** Some minor helpful functions: *** Take a "bubbled" tick mode and prints its "tick amount": op printTickAmount : TickMode -> QidList . eq printTickAmount(maxDef('bubble[T])) = downQidList(T) . eq printTickAmount(def('bubble[T])) = downQidList(T) . *** Find the "arrowmode" from a command qid: op searchQid : Qid ~> Qid . ceq searchQid(Q) = '1 if find(string(Q), "_=>1_", 2) =/= notFound . ceq searchQid(Q) = '* if find(string(Q), "_=>*_", 2) =/= notFound . ceq searchQid(Q) = '+ if find(string(Q), "_=>+_", 2) =/= notFound . ceq searchQid(Q) = '! if find(string(Q), "_=>!_", 2) =/= notFound . *** Given a command Qid, we can find the comparison operator: op commandToComp : Qid ~> ComparisonOp . ceq commandToComp(Q) = le if find(string(Q), "in`time`<=_", 5) =/= notFound . ceq commandToComp(Q) = lt if find(string(Q), "in`time`<_", 5) =/= notFound . ceq commandToComp(Q) = gt if find(string(Q), "in`time`>_", 5) =/= notFound . ceq commandToComp(Q) = le if find(string(Q), "in`time`>=_", 5) =/= notFound . *** Write '< or '> or ... op commandToCompSymb : Qid ~> Qid . ceq commandToCompSymb(Q) = '<= if find(string(Q), "in`time`<=_", 5) =/= notFound . ceq commandToCompSymb(Q) = '< if find(string(Q), "in`time`<_", 5) =/= notFound . ceq commandToCompSymb(Q) = '> if find(string(Q), "in`time`>_", 5) =/= notFound . ceq commandToCompSymb(Q) = '>= if find(string(Q), "in`time`>=_", 5) =/= notFound . *** takes a tick mode in bubble form and gives the corresponding *** tick modes with terms: op solveTickMode : TickMode Module Bool OpDeclSet Database ~> TickMode . eq solveTickMode(max, M, B, VDS, DB) = max . eq solveTickMode(det, M, B, VDS, DB) = det . eq solveTickMode(def(T), M, B, VDS, DB) = def(solveBubbles(T, M, B, VDS, DB)) . eq solveTickMode(maxDef(T), M, B, VDS, DB) = maxDef(solveBubbles(T, M, B, VDS, DB)) . *** prints a tick mode: op printMode : TickMode Module -> QidList . eq printMode(max, M) = 'maximal 'time 'increase . eq printMode(det, M) = 'deterministic 'time 'increase . eq printMode(def(T), M) = 'default 'time 'increase eMetaPrettyPrint(M, T) . eq printMode(maxDef(T), M) = 'maximal 'time 'increase 'with 'default eMetaPrettyPrint(M, T) . *** Use of "double" solveBubbles failed. Uses single. Disadvantage: *** cannot ensure same CC on both term and Pattern: op searchPattern : Term Term Module Bool Bound OpDeclSet Database ~> Term . eq searchPattern(T, T', M, B, D, VDS, DB) = solveBubbles(T', M, B, VDS, DB) . *** Gives the comparison operator of a token: op comp : Term ~> ComparisonOp . eq comp('token[''<.Qid]) = lt . eq comp('token[''<=.Qid]) = le . eq comp('token[''>.Qid]) = gt . eq comp('token[''>=.Qid]) = ge . *** Most of the command treatment is fairly similar: *** Extract bound/depth, extract module and term to rewrite/search, *** and then either a time limit or a pattern, or more than one time limit. *** Therefore, in this new stage I add a preprocessing layer *** which does these things ... *** First we preprocess a command with only a term: ceq procTimedCommand(Q[T], ME, DB, TiM) = (if compiledModule(ME, DB) then preprocessTimedCommandT(ME, getFlatModule(ME, DB), unbounded, getVars(ME, DB), DB, Q, T, TiM) else preprocessTimedCommandT(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), unbounded, getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB)), Q, T, TiM) fi) if (Q == 'trew_with`no`time`limit`.) or (Q == 'tfrew_with`no`time`limit`.). op preprocessTimedCommandT : ModuleExpression Module Bound OpDeclSet Database Qid Term TickMode -> QidList . ceq preprocessTimedCommandT(ME, M, D, VDS, DB, Q, T, TiM) = ('\n '\r 'Error '\c 'in 'timed 'rewrite 'command: 'Command/module/initterm 'does 'not 'parse. '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ not solveBubblesRew(T, M, B, D, VDS, DB) :: Tuple . ceq preprocessTimedCommandT(ME, M, D, VDS, DB, Q, T, TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Tick 'mode 'amount printTickAmount(TiM) 'does 'not 'parse 'in 'module '\y eMetaPrettyPrint(getName(MOD)) '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ not solveTickMode(TiM, MOD, B, getVars(getName(MOD), DB), DB) :: TickMode . *** Now, we pass over all parsed stuff to procParsedTimedCommand: op procParsedTimedCommandT : Qid Module Term Bound TickMode -> QidList . *** procParsedTimedCommandT(command, mod, initTerm, bound, mode) ceq preprocessTimedCommandT(ME, M, D, VDS, DB, Q, T, TiM) = procParsedTimedCommandT(Q, MOD, TERM, BOUND, SOLVEDTICKMODE) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ SOLVEDTICKMODE := solveTickMode(TiM, MOD, B, getVars(getName(MOD), DB), DB) . eq preprocessTimedCommandT(ME, unitError(QIL), D, VDS, DB, Q, T, TiM) = qidError(QIL) . *** Now we treat commands with an initial term and a time limit ... ceq procTimedCommand(Q[T, T'], ME, DB, TiM) = (if compiledModule(ME, DB) then preprocessTimedCommandTL(ME, getFlatModule(ME, DB), unbounded, getVars(ME, DB), DB, Q, T, T', TiM) else preprocessTimedCommandTL(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME,DB))), unbounded, getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME,DB))), database(evalModExp(ME,DB)), Q, T, T', TiM) fi) if (Q == 'trew_in`time`<=_.) or (Q == 'trew_in`time`<_.) or (Q == 'tfrew_in`time`<=_.) or (Q == 'tfrew_in`time`<_.) . op preprocessTimedCommandTL : ModuleExpression Module Bound OpDeclSet Database Qid Term Term TickMode -> QidList . ceq preprocessTimedCommandTL(ME, M, D, VDS, DB, Q, T, T', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Command/module/initterm 'does 'not 'parse. '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ not solveBubblesRew(T, M, B, D, VDS, DB) :: Tuple . ceq preprocessTimedCommandTL(ME, M, D, VDS, DB, Q, T, T', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Time 'limit 'term 'does 'not 'parse 'in 'module '\y eMetaPrettyPrint(getName(MOD)) '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ not solveBubbles(T', MOD, B, getVars(getName(MOD), DB), DB) :: Term . ceq preprocessTimedCommandTL(ME, M, D, VDS, DB, Q, T, T', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Tick 'mode 'amount printTickAmount(TiM) 'does 'not 'parse 'in 'module '\y eMetaPrettyPrint(getName(MOD)) '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ solveBubbles(T', MOD, B, getVars(getName(MOD), DB), DB) :: Term /\ not solveTickMode(TiM, MOD, B, getVars(getName(MOD), DB), DB) :: TickMode . *** Now, we pass over all parsed stuff to procParsedTimedCommand: op procParsedTimedCommandTL : Qid Module Term Bound Term TickMode -> QidList . *** procParsedTimedCommandTL(command, mod, initTerm, bound, timeLimit, mode) ceq preprocessTimedCommandTL(ME, M, D, VDS, DB, Q, T, T', TiM) = procParsedTimedCommandTL(Q, MOD, TERM, BOUND, LIMIT, SOLVEDTICKMODE) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ LIMIT := solveBubbles(T', MOD, B, getVars(getName(MOD), DB), DB) /\ SOLVEDTICKMODE := solveTickMode(TiM, MOD, B, getVars(getName(MOD), DB), DB) . eq preprocessTimedCommandTL(ME, unitError(QIL), D, VDS, DB, Q, T, T', TiM) = qidError(QIL) . *** Next case treats the case with initTerm, searchPattern and one time *** limit: ceq procTimedCommand(Q[T, T', T''], ME, DB, TiM) = (if compiledModule(ME, DB) then preprocessTimedCommandTPL(ME, getFlatModule(ME, DB), unbounded, getVars(ME, DB), DB, Q, T, T', T'',TiM) else preprocessTimedCommandTPL(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), unbounded, getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB)), Q, T, T', T'', TiM) fi) if find(string(Q), "in`time`<", 0) =/= notFound or find(string(Q), "in`time`>", 0) =/= notFound /\ (find(string(Q), "tsearch", 0) =/= notFound or find(string(Q), "find`latest", 0) =/= notFound or find(string(Q), "|=`<>", 0) =/= notFound or find(string(Q), "mc_|=", 0) =/= notFound) . op preprocessTimedCommandTPL : ModuleExpression Module Bound OpDeclSet Database Qid Term Term Term TickMode -> QidList . --- ------------- --- Parsing of patterns. We pause at this point to try to tackle --- the heavy task of dealing with such that conditions in --- searches and other commands. This is nontrivial, and ... --- First we define a data type for terms and conditions: sort TermCondition . op _suchThat_ : Term Condition -> TermCondition [ctor] . op termPart : TermCondition -> Term . eq termPart(T suchThat COND) = T . op condPart : TermCondition -> Condition . eq condPart(T suchThat COND) = COND . --- The following function tries to squeeze out a term and a condition --- from a bubble: op searchPattern : Term Term Module Bool OpDeclSet Database ~> TermCondition . --- Notice that the SECOND parameter is the condition. The first --- one is the parsed initial state. eq searchPattern(T, T', MOD, B, VDS, DB) = if solveBubbles(T', MOD, B, VDS, DB) :: Term then solveBubbles(T', MOD, B, VDS, DB) suchThat nil else searchPattern2(addOps( op '_s.t._. : leastSort(MOD, T) '@Condition -> 'PatternCondition [none] . op '_such`that_. : leastSort(MOD, T) '@Condition -> 'PatternCondition [none] ., addSorts('PatternCondition, addInfoConds(MOD))), T', VDS) fi . op searchPattern2 : Module Term OpDeclSet ~> TermCondition . eq searchPattern2(M', 'bubble['__[TL]], VDS) = searchPattern3(getTerm(metaParse(addOps(VDS, M'), downQidList('__[TL, ''..Qid]), 'PatternCondition)), VDS) . op searchPattern3 : Term OpDeclSet ~> TermCondition . eq searchPattern3(Q, VDS) = constsToVars(Q, VDS) suchThat nil . eq searchPattern3(Q[T], VDS) = constsToVars(Q[T], VDS) suchThat nil . eq searchPattern3(Q[T, T'], VDS) = if (Q == '_s.t._. or Q == '_such`that_.) then (T suchThat parseCond(T', VDS)) else (constsToVars(Q[T, T'], VDS) suchThat nil) fi . eq searchPattern3(Q[T, T', TL], VDS) = constsToVars(Q[T, T', TL], VDS) suchThat nil . --- ---------------------------- end of parsing of condition-bubbles ceq preprocessTimedCommandTPL(ME, M, D, VDS, DB, Q, T, T', T'', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Command/module/initterm 'does 'not 'parse. '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ not solveBubblesRew(T, M, B, D, VDS, DB) :: Tuple . ceq preprocessTimedCommandTPL(ME, M, D, VDS, DB, Q, T, T', T'', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Search 'pattern 'does 'not 'parse 'in 'module '\o eMetaPrettyPrint(getName(MOD))'\s '\c '. '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ not searchPattern(TERM, T', MOD, B, getVars(getName(MOD), DB), DB) :: TermCondition . ceq preprocessTimedCommandTPL(ME, M, D, VDS, DB, Q, T, T', T'', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Time 'limit 'term 'does 'not 'parse 'in 'module '\y eMetaPrettyPrint(getName(MOD)) '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ searchPattern(TERM, T', MOD, B, getVars(getName(MOD), DB), DB) :: TermCondition /\ not solveBubbles(T'', MOD, B, getVars(getName(MOD),DB), DB) :: Term . ceq preprocessTimedCommandTPL(ME, M, D, VDS, DB, Q, T, T', T'', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Tick 'mode 'amount printTickAmount(TiM) 'does 'not 'parse 'in 'module '\y eMetaPrettyPrint(getName(MOD)) '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ searchPattern(TERM, T', MOD, B, getVars(getName(MOD), DB), DB) :: TermCondition /\ solveBubbles(T'', MOD, B, getVars(getName(MOD), DB), DB) :: Term /\ not solveTickMode(TiM, MOD, B, getVars(getName(MOD), DB), DB) :: TickMode . op procParsedTimedCommandTPL : Qid Module Term Bound Term Condition Term TickMode -> QidList . *** procParsedTimedCommandTPL(command, mod, initTerm, bound, pattern, cond, *** timeLimit, mode) ceq preprocessTimedCommandTPL(ME, M, D, VDS, DB, Q, T, T', T'', TiM) = procParsedTimedCommandTPL(Q, MOD, TERM, BOUND, termPart(SEARCHPATTERN), condPart(SEARCHPATTERN), LIMIT, SOLVEDTICKMODE) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ SEARCHPATTERN := searchPattern(TERM, T', MOD, B, getVars(getName(MOD), DB), DB) /\ LIMIT := solveBubbles(T'', MOD, B, getVars(getName(MOD), DB), DB) /\ SOLVEDTICKMODE := solveTickMode(TiM, MOD, B, getVars(getName(MOD), DB), DB) . eq preprocessTimedCommandTPL(ME, unitError(QIL), D, VDS, DB, Q, T, T', T'', TiM) = qidError(QIL) . *** Now, we have initTerm searchPattern comparisonOp TimeLimit *** comparisonOp TimeLimit, for "in-between" searches ceq procTimedCommand(Q[T1, T2, T3, T4, T5, T6], ME, DB, TiM) = (if compiledModule(ME, DB) then preprocessTimedCommandTPCLCL(ME, getFlatModule(ME, DB), unbounded, getVars(ME, DB), DB, Q, T1, T2, T3, T4, T5, T6, TiM) else preprocessTimedCommandTPCLCL(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), unbounded, getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB)), Q, T1, T2, T3, T4, T5, T6, TiM) fi) if find(string(Q), "tsearch", 0) =/= notFound and find(string(Q), "time-interval", 0) =/= notFound . op preprocessTimedCommandTPCLCL : ModuleExpression Module Bound OpDeclSet Database Qid Term Term Term Term Term Term TickMode -> QidList . ceq preprocessTimedCommandTPCLCL(ME, M, D, VDS, DB, Q, T1, T2, T3, T4, T5, T6, TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Command/module/initterm 'does 'not 'parse. '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ not solveBubblesRew(T1, M, B, D, VDS, DB) :: Tuple . ceq preprocessTimedCommandTPCLCL(ME, M, D, VDS, DB, Q, T1, T2, T3, T4, T5, T6, TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Search 'pattern 'does 'not 'parse 'in 'module '\o eMetaPrettyPrint(getName(MOD)) '\s '\c '. '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T1, M, B, D, VDS, DB) /\ not searchPattern(TERM, T2, MOD, B, getVars(getName(MOD), DB), DB) :: TermCondition . ceq preprocessTimedCommandTPCLCL(ME, M, D, VDS, DB, Q, T1, T2, T3, T4, T5, T6, TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Time 'limit 'term 'does 'not 'parse 'in 'module '\y eMetaPrettyPrint(getName(MOD)) '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T1, M, B, D, VDS, DB) /\ searchPattern(TERM, T2, MOD, B, getVars(getName(MOD), DB), DB) :: TermCondition /\ not (solveBubbles(T4, MOD, B, getVars(getName(MOD), DB), DB) :: Term and solveBubbles(T6, MOD, B, getVars(getName(MOD),DB), DB) :: Term) . ceq preprocessTimedCommandTPCLCL(ME, M, D, VDS, DB, Q,T1, T2, T3, T4, T5, T6, TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'wrong 'comparison 'operator '\o '\n) if not (comp(T3) :: ComparisonOp and comp(T5) :: ComparisonOp) . ceq preprocessTimedCommandTPCLCL(ME, M, D, VDS, DB, Q,T1, T2, T3, T4, T5, T6, TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Tick 'mode 'amount printTickAmount(TiM) 'does 'not 'parse 'in 'module '\y eMetaPrettyPrint(getName(MOD)) '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T1, M, B, D, VDS, DB) /\ searchPattern(TERM, T2, MOD, B, getVars(getName(MOD), DB), DB) :: TermCondition /\ solveBubbles(T4, MOD, B, getVars(getName(MOD), DB), DB) :: Term /\ solveBubbles(T6, MOD, B, getVars(getName(MOD), DB), DB) :: Term /\ not solveTickMode(TiM, MOD, B, getVars(getName(MOD), DB), DB) :: TickMode . op procParsedTimedCommandTPCLCL : Qid Module Term Bound Term Condition ComparisonOp Term ComparisonOp Term TickMode -> QidList . *** procParsedTimedCommandTPCLCL(command, mod, initTerm, bound, pattern, *** condition, comp1, timeLimit1, comp2, *** limit2, mode) ceq preprocessTimedCommandTPCLCL(ME, M, D, VDS, DB, Q, T1, T2, T3, T4, T5, T6, TiM) = procParsedTimedCommandTPCLCL(Q, MOD, TERM, BOUND, termPart(SEARCHPATTERN), condPart(SEARCHPATTERN), COMP, LIMIT, COMP', LIMIT', SOLVEDTICKMODE) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T1, M, B, D, VDS, DB) /\ SEARCHPATTERN := searchPattern(TERM, T2, MOD, B, getVars(getName(MOD), DB), DB) /\ COMP := comp(T3) /\ LIMIT := solveBubbles(T4, MOD, B, getVars(getName(MOD), DB), DB) /\ COMP' := comp(T5) /\ LIMIT' := solveBubbles(T6, MOD, B, getVars(getName(MOD),DB), DB) /\ SOLVEDTICKMODE := solveTickMode(TiM, MOD, B, getVars(getName(MOD), DB), DB) . eq preprocessTimedCommandTPCLCL(ME, unitError(QIL), D, VDS, DB, Q, T1, T2, T3, T4, T5, T6, TiM) = qidError(QIL) . *** Now, only a term and a pattern: ceq procTimedCommand(Q[T, T'], ME, DB, TiM) = (if compiledModule(ME, DB) then preprocessTimedCommandTP(ME, getFlatModule(ME, DB), unbounded, getVars(ME, DB), DB, Q, T, T', TiM) else preprocessTimedCommandTP(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), unbounded, getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB)), Q, T, T', TiM) fi) if (Q == 'tsearch_=>1_with`no`time`limit`.) or (Q == 'tsearch_=>+_with`no`time`limit`.) or (Q == 'tsearch_=>*_with`no`time`limit`.) or (Q == 'tsearch_=>!_with`no`time`limit`.) or (find(string(Q), "utsearch", 0) =/= notFound) or (Q == 'find`earliest_=>*_.) or (Q == 'check_|=`<>_with`no`time`limit`.) or (Q == 'find`latest_=>*_with`no`time`limit`.) or (Q == 'mc_|=u_.) or (Q == 'mc_|=t_with`no`time`limit`.) . op preprocessTimedCommandTP : ModuleExpression Module Bound OpDeclSet Database Qid Term Term TickMode -> QidList . ceq preprocessTimedCommandTP(ME, M, D, VDS, DB, Q, T, T', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Command/module/initterm 'does 'not 'parse. '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ not solveBubblesRew(T, M, B, D, VDS, DB) :: Tuple . ceq preprocessTimedCommandTP(ME, M, D, VDS, DB, Q, T, T', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Search 'pattern 'does 'not 'parse 'in 'module '\o eMetaPrettyPrint(getName(MOD))'\s '\c '. '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ not searchPattern(TERM, T', MOD, B, getVars(getName(MOD), DB), DB) :: TermCondition . ceq preprocessTimedCommandTP(ME, M, D, VDS, DB, Q, T, T', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Tick 'mode 'amount printTickAmount(TiM) 'does 'not 'parse 'in 'module '\y eMetaPrettyPrint(getName(MOD)) '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ searchPattern(TERM, T', MOD, B, getVars(getName(MOD), DB), DB) :: TermCondition /\ not solveTickMode(TiM, MOD, B, getVars(getName(MOD), DB), DB) :: TickMode . op procParsedTimedCommandTP : Qid Module Term Bound Term Condition TickMode -> QidList . *** procParsedTimedCommandTP(command, mod, initTerm, bound, pattern, cond, *** mode) ceq preprocessTimedCommandTP(ME, M, D, VDS, DB, Q, T, T', TiM) = procParsedTimedCommandTP(Q, MOD, TERM, BOUND, termPart(SEARCHPATTERN), condPart(SEARCHPATTERN), SOLVEDTICKMODE) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ SEARCHPATTERN := searchPattern(TERM, T', MOD, B, getVars(getName(MOD), DB), DB) /\ SOLVEDTICKMODE := solveTickMode(TiM, MOD, B, getVars(getName(MOD), DB), DB) . eq preprocessTimedCommandTP(ME, unitError(QIL), D, VDS, DB, Q, T, T', TiM) = qidError(QIL) . *** Now, a term and two patterns (for until and untilStable): ceq procTimedCommand(Q[T, T', T''], ME, DB, TiM) = (if compiledModule(ME, DB) then preprocessTimedCommandTPP(ME, getFlatModule(ME, DB), unbounded, getVars(ME, DB), DB, Q, T, T', T'',TiM) else preprocessTimedCommandTPP(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), unbounded, getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB)), Q, T, T', T'', TiM) fi) if (Q == 'check_|=_until_with`no`time`limit`.) or (Q == 'check_|=_untilStable_with`no`time`limit`.) . op preprocessTimedCommandTPP : ModuleExpression Module Bound OpDeclSet Database Qid Term Term Term TickMode -> QidList . ceq preprocessTimedCommandTPP(ME, M, D, VDS, DB, Q, T, T', T'', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Command/module/initterm 'does 'not 'parse. '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ not solveBubblesRew(T, M, B, D, VDS, DB) :: Tuple . ceq preprocessTimedCommandTPP(ME, M, D, VDS, DB, Q, T, T', T'', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'second 'search 'pattern 'does 'not 'parse 'in 'module '\y eMetaPrettyPrint(getName(MOD)) '. '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ searchPattern(TERM, T', MOD, B, getVars(getName(MOD), DB), DB) :: TermCondition /\ not searchPattern(TERM, T'', MOD, B, getVars(getName(MOD), DB),DB) :: TermCondition . ceq preprocessTimedCommandTPP(ME, M, D, VDS, DB, Q, T, T', T'', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'first 'search 'pattern 'does 'not 'parse 'in 'module '\y eMetaPrettyPrint(getName(MOD)) '. '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ not searchPattern(TERM, T', MOD, B, getVars(getName(MOD),DB), DB) :: TermCondition . ceq preprocessTimedCommandTPP(ME, M, D, VDS, DB, Q, T, T', T'', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Tick 'mode 'amount printTickAmount(TiM) 'does 'not 'parse 'in 'module '\y eMetaPrettyPrint(getName(MOD)) '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ searchPattern(TERM, T', MOD, B, getVars(getName(MOD),DB), DB) :: TermCondition /\ searchPattern(TERM, T'', MOD, B, getVars(getName(MOD), DB), DB) :: TermCondition /\ not solveTickMode(TiM, MOD, B, getVars(getName(MOD), DB), DB) :: TickMode . op procParsedTimedCommandTPP : Qid Module Term Bound Term Condition Term Condition TickMode -> QidList . *** procParsedTimedCommandTPP(command, mod, initTerm, bound, pat, *** pattern1Cond, pat2, pat2Cond, mode) ceq preprocessTimedCommandTPP(ME, M, D, VDS, DB, Q, T, T', T'', TiM) = procParsedTimedCommandTPP(Q, MOD, TERM, BOUND, termPart(SEARCHPATTERN), condPart(SEARCHPATTERN), termPart(SEARCHPATTERN'), condPart(SEARCHPATTERN'), SOLVEDTICKMODE) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ SEARCHPATTERN := searchPattern(TERM, T', MOD, B, getVars(getName(MOD), DB), DB) /\ SEARCHPATTERN' := searchPattern(TERM, T'', MOD, B, getVars(getName(MOD), DB), DB) /\ SOLVEDTICKMODE := solveTickMode(TiM, MOD, B, getVars(getName(MOD), DB), DB) . eq preprocessTimedCommandTPP(ME, unitError(QIL), D, VDS, DB, Q, T, T', T'', TiM) = qidError(QIL) . *** Now term pattern pattern2 limit: ceq procTimedCommand(Q[T, T', T'', T'''], ME, DB, TiM) = (if compiledModule(ME, DB) then preprocessTimedCommandTPPL(ME, getFlatModule(ME, DB), unbounded, getVars(ME, DB), DB, Q, T, T', T'', T''', TiM) else preprocessTimedCommandTPPL(modExp(evalModExp(ME, DB)), getFlatModule(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), unbounded, getVars(modExp(evalModExp(ME, DB)), database(evalModExp(ME, DB))), database(evalModExp(ME, DB)), Q, T, T', T'', T''', TiM) fi) if (Q == 'check_|=_until_in`time`<_.) or (Q == 'check_|=_until_in`time`<=_.) or (Q == 'check_|=_untilStable_in`time`<_.) or (Q == 'check_|=_untilStable_in`time`<=_.) . op preprocessTimedCommandTPPL : ModuleExpression Module Bound OpDeclSet Database Qid Term Term Term Term TickMode -> QidList . ceq preprocessTimedCommandTPPL(ME, M, D, VDS, DB, Q, T, T', T'', T''', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Command/module/initterm 'does 'not 'parse. '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ not solveBubblesRew(T, M, B, D, VDS, DB) :: Tuple . ceq preprocessTimedCommandTPPL(ME, M, D, VDS, DB, Q, T, T', T'', T''', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'first 'search 'pattern 'does 'not 'parse 'in 'module '\y eMetaPrettyPrint(getName(MOD)) '. '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ not searchPattern(TERM, T', MOD, B, getVars(getName(MOD), DB), DB) :: TermCondition . ceq preprocessTimedCommandTPPL(ME, M, D, VDS, DB, Q, T, T', T'', T''', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'second 'search 'pattern 'does 'not 'parse 'in 'module '\y eMetaPrettyPrint(getName(MOD)) '. '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ searchPattern(TERM, T', MOD, B, D, getVars(getName(MOD), DB), DB) :: Term /\ not searchPattern(TERM, T'', MOD, B, getVars(getName(MOD),DB), DB) :: TermCondition . ceq preprocessTimedCommandTPPL(ME, M, D, VDS, DB, Q, T, T', T'', T''', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Time 'limit 'term 'does 'not 'parse 'in 'module '\y eMetaPrettyPrint(getName(MOD)) '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ searchPattern(TERM, T', MOD, B, getVars(getName(MOD), DB), DB) :: TermCondition /\ searchPattern(TERM, T'', MOD, B, getVars(getName(MOD), DB), DB) :: TermCondition /\ not solveBubbles(T''', MOD, B, getVars(getName(MOD), DB), DB) :: Term . ceq preprocessTimedCommandTPPL(ME, M, D, VDS, DB, Q, T, T', T'', T''', TiM) = ('\n '\r 'Error '\c 'in 'timed 'command: 'Tick 'mode 'amount printTickAmount(TiM) 'does 'not 'parse 'in 'module '\y eMetaPrettyPrint(getName(MOD)) '\o '\n) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ searchPattern(TERM, T', MOD, B, getVars(getName(MOD), DB), DB) :: TermCondition /\ solveBubbles(T'', MOD, B, getVars(getName(MOD), DB), DB) :: Term /\ not solveTickMode(TiM, MOD, B, getVars(getName(MOD), DB), DB) :: TickMode . op procParsedTimedCommandTPPL : Qid Module Term Bound Term Condition Term Condition Term TickMode -> QidList . *** procParsedTimedCommandTPPL(command, mod, initTerm, bound, pattern, *** cond1, pat2, cond2, *** timeLimit, mode) ceq preprocessTimedCommandTPPL(ME, M, D, VDS, DB, Q, T, T', T'', T''', TiM) = procParsedTimedCommandTPPL(Q, MOD, TERM, BOUND, termPart(SEARCHPATTERN), condPart(SEARCHPATTERN), termPart(SEARCHPATTERN'), condPart(SEARCHPATTERN'), LIMIT, SOLVEDTICKMODE) if B := included('META-MODULE, getImports(getTopModule(ME, DB)), DB) /\ {TERM, MOD, ODS, BOUND} := solveBubblesRew(T, M, B, D, VDS, DB) /\ SEARCHPATTERN := searchPattern(TERM, T', MOD, B, getVars(getName(MOD), DB), DB) /\ SEARCHPATTERN' := searchPattern(TERM, T'', MOD, B, getVars(getName(MOD), DB), DB) /\ LIMIT := solveBubbles(T''', MOD, B, getVars(getName(MOD),DB), DB) /\ SOLVEDTICKMODE := solveTickMode(TiM, MOD, B, getVars(getName(MOD), DB), DB) . eq preprocessTimedCommandTPPL(ME, unitError(QIL), D, VDS, DB, Q, T, T', T'', T''', TiM) = qidError(QIL) . --- TIMED REWRITING --- -------------------------------- *** First, trew_with`no`time`limit`. : ceq procParsedTimedCommandT(Q, MOD, TERM, BOUND, SOLVEDTICKMODE) = if RP :: ResultPair then ('\n '\c 'Timed 'rewrite (if BOUND =/= unbounded *** write [13] etc then ('\s '`[ qid(string(BOUND, 10)) '`] ) else nil fi) '\o '\s '\s eMetaPrettyPrint(MOD, TERM) '\c 'in '\o eMetaPrettyPrint(getName(MOD)) '\c 'with 'mode printMode(SOLVEDTICKMODE, MOD) '\n '\c '\n 'Result '\o eMetaPrettyPrint(getType(RP)) '\c ': '\o '\n '\s '\s eMetaPrettyPrint(MOD, getTerm(RP)) '\n) else ('\r 'Error 'in 'timed 'rewrite. '\o '\n) fi if (Q == 'trew_with`no`time`limit`.) /\ RP := timedMetaRewrite(MOD, TERM, BOUND, SOLVEDTICKMODE) . *** Now, fair timed rewrite without time limit: ceq procParsedTimedCommandT(Q, MOD, TERM, BOUND, SOLVEDTICKMODE) = if RP :: ResultPair then ('\n '\c 'Timed 'fair 'rewrite (if BOUND =/= unbounded *** write [13] etc then ('\s '`[ qid(string(BOUND, 10)) '`] ) else nil fi) '\o '\s '\s eMetaPrettyPrint(MOD, TERM) '\c 'in '\o eMetaPrettyPrint(getName(MOD)) '\c 'with 'mode printMode(SOLVEDTICKMODE, MOD) '\n '\c '\n 'Result '\o eMetaPrettyPrint(getType(RP)) '\c ': '\o '\n '\s '\s eMetaPrettyPrint(MOD, getTerm(RP)) '\n) else ('\n '\r 'Error 'in 'timed 'rewrite. '\o '\n) fi if (Q == 'tfrew_with`no`time`limit`.) /\ RP := timedMetaFRewrite(MOD, TERM, BOUND, 1, SOLVEDTICKMODE) . *** Now, trew_in`time`<_. and trew_in`time`<=_. ceq procParsedTimedCommandTL(Q, MOD, TERM, BOUND, LIMIT, SOLVEDTICKMODE) = if RP :: ResultPair then ('\n '\c 'Timed 'rewrite (if BOUND =/= unbounded *** write [13] etc then ('\s '`[ qid(string(BOUND, 10)) '`] ) else nil fi) '\o '\s '\s eMetaPrettyPrint(MOD, TERM) '\c 'in '\o eMetaPrettyPrint(getName(MOD)) '\c 'with 'mode printMode(SOLVEDTICKMODE, MOD) 'in 'time (if Q == 'trew_in`time`<_. then '< else '<= fi) eMetaPrettyPrint(MOD, LIMIT) '\n '\c '\n 'Result '\o eMetaPrettyPrint(getType(RP)) '\c ': '\o '\n '\s '\s eMetaPrettyPrint(MOD, getTerm(RP)) '\n) else ('\n '\r 'Error 'in 'timed 'rewrite. '\o '\n) fi if (Q == 'trew_in`time`<_.) or (Q == 'trew_in`time`<=_.) /\ RP := timedMetaRewrite(MOD, TERM, BOUND, if Q == 'trew_in`time`<_. then lt else le fi, LIMIT, SOLVEDTICKMODE) . *** Now, fair timed rewrite: ceq procParsedTimedCommandTL(Q, MOD, TERM, BOUND, LIMIT, SOLVEDTICKMODE) = if RP :: ResultPair then ('\n '\c 'Timed 'fair 'rewrite (if BOUND =/= unbounded *** write [13] etc then ('\s '`[ qid(string(BOUND, 10)) '`] ) else nil fi) '\o '\s '\s eMetaPrettyPrint(MOD, TERM) '\c 'in '\o eMetaPrettyPrint(getName(MOD)) '\c 'with 'mode printMode(SOLVEDTICKMODE, MOD) 'in 'time (if Q == 'tfrew_in`time`<_. then '< else '<= fi) eMetaPrettyPrint(MOD, LIMIT) '\n '\c '\n 'Result '\o eMetaPrettyPrint(getType(RP)) '\c ': '\o '\n '\s '\s eMetaPrettyPrint(MOD, getTerm(RP)) '\n) else ('\r 'Error 'in 'timed 'rewrite. '\o '\n) fi if (Q == 'tfrew_in`time`<_.) or (Q == 'tfrew_in`time`<=_.) /\ RP := timedMetaFRewrite(MOD, TERM, BOUND, 1,if Q == 'tfrew_in`time`<_. then lt else le fi, LIMIT, SOLVEDTICKMODE) . --- TIMED SEARCH --- ---------------------------------- *** tsearch with no time limit: ceq procParsedTimedCommandTP(Q, MOD, TERM, BOUND, T, COND, SOLVEDTICKMODE) = ('\n '\c 'Timed 'search (if BOUND =/= unbounded *** write [13] etc then ('\s '`[ qid(string(BOUND, 10)) '`] '\s ) else nil fi) 'in '\o eMetaPrettyPrint(getName(MOD)) '\c '\s '\n '\t eMetaPrettyPrint(MOD, TERM) qid("=>" + string(searchQid(Q))) '\s eMetaPrettyPrint(MOD, T) '\n '\c 'with 'no 'time 'limit 'and 'with 'mode printMode(SOLVEDTICKMODE, MOD) ': '\n '\o *** Here comes the real call: procTimedSearch2(MOD, TERM, T, COND, if searchQid(Q) == '1 then '+ else searchQid(Q) fi, if searchQid(Q) == '1 then 1 else unbounded fi, 0, ge , 'zero.Time, BOUND, SOLVEDTICKMODE)) if (Q == 'tsearch_=>1_with`no`time`limit`.) or (Q == 'tsearch_=>*_with`no`time`limit`.) or (Q == 'tsearch_=>+_with`no`time`limit`.) or (Q == 'tsearch_=>!_with`no`time`limit`.) . *** procTimedSearch2 calles timedMetaSearch and does the job. *** In this first version, timedMetaSearch does all the module *** transformations. Therefore it can be slightly slow *** if we are looking for many solutions. However, that is a trivial *** improvement if needed. op procTimedSearch2 : Module Term Term Condition Qid Bound Nat ComparisonOp Term Bound TickMode -> QidList . *** procTimedSearch2(module, initterm, pattern, condition, *** arrowkind, depthOfRewrites, solNo, limit, *** noOfSolsSought, tickMode) eq procTimedSearch2(MOD, TERM, T, COND, Q, D, N, COMP, LIMIT, BOUND, SOLVEDTICKMODE) = if timedMetaSearch(MOD, TERM, T, COND, Q, D, N, COMP, LIMIT, SOLVEDTICKMODE) :: ResultTriple then ('\n '\c 'Solution qid(string(N + 1, 10)) '\n '\o eMetaPrettyPrint(MOD, getSubstitution(timedMetaSearch(MOD, TERM, T, COND, Q, D, N, COMP, LIMIT, SOLVEDTICKMODE))) '\n (if N + 1 < BOUND then procTimedSearch2(MOD, TERM, T, COND, Q, D, N + 1, COMP, LIMIT, BOUND, SOLVEDTICKMODE) else nil fi) ) else (if N == 0 then '\n '\c 'No 'solution '\o '\n else '\n '\c 'No 'more 'solutions '\o '\n fi) fi . op _<_ : Nat Bound -> Bool [ditto] . eq N < unbounded = true . *** Untimed search: ceq procParsedTimedCommandTP(Q, MOD, TERM, BOUND, T, COND, SOLVEDTICKMODE) = ('\n '\c 'Untimed 'search (if BOUND =/= unbounded *** write [13] etc then ('\s '`[ qid(string(BOUND, 10)) '`] '\s) else nil fi) 'in '\o eMetaPrettyPrint(getName(MOD)) '\c '\s '\n '\t eMetaPrettyPrint(MOD, TERM) qid("=>" + string(searchQid(Q))) '\s eMetaPrettyPrint(MOD, T)'\n '\c 'with 'mode printMode(SOLVEDTICKMODE, MOD) ': '\n '\o *** Here comes the real call: procUnTimedSearch2(MOD, TERM, T, COND, if searchQid(Q) == ' then '* else searchQid(Q) fi, if searchQid(Q) == ' then 1 else unbounded fi, 0, BOUND, SOLVEDTICKMODE)) if (Q == 'utsearch_=>1_.) or (Q == 'utsearch_=>*_.) or (Q == 'utsearch_=>+_.) or (Q == 'utsearch_=>!_.) . op procUnTimedSearch2 : Module Term Term Condition Qid Bound Nat Bound TickMode -> QidList . *** procUnTimedSearch2(module, initterm, pattern, condition, *** arrowkind, depthOfRewrites, solNo, noOfSolsSought) eq procUnTimedSearch2(MOD, TERM, T, COND, Q, D, N, BOUND, SOLVEDTICKMODE) = if untimedMetaSearch(MOD, TERM, T, COND, Q, D, N, SOLVEDTICKMODE) :: ResultTriple then ('\n '\c 'Solution qid(string(N + 1, 10)) '\n '\o eMetaPrettyPrint(MOD, getSubstitution(untimedMetaSearch(MOD, TERM, T, COND, Q, D, N, SOLVEDTICKMODE))) '\n (if N + 1 < BOUND then procUnTimedSearch2(MOD, TERM, T, COND, Q, D, N + 1, BOUND, SOLVEDTICKMODE) else nil fi) ) else (if N == 0 then '\n '\c 'No 'solution '\o '\n else '\n '\c 'No 'more 'solutions '\o '\n fi) fi . *** Now, search with time limits: ceq procParsedTimedCommandTPL(Q, MOD, TERM, BOUND, T, COND, LIMIT, SOLVEDTICKMODE) = ('\n '\c 'Timed 'search (if BOUND =/= unbounded *** write [13] etc then ('\s '`[ qid(string(BOUND, 10)) '`] '\s ) else nil fi) 'in '\o eMetaPrettyPrint(getName(MOD)) '\c '\s '\n '\t eMetaPrettyPrint(MOD, TERM) qid("=>" + string(searchQid(Q))) '\s eMetaPrettyPrint(MOD, T) '\n '\c 'in 'time commandToCompSymb(Q) eMetaPrettyPrint(MOD, LIMIT) 'and 'with 'mode printMode(SOLVEDTICKMODE, MOD) ': '\n '\o *** Here comes the real call: procTimedSearch2(MOD, TERM, T, COND, if searchQid(Q) == '1 then '+ else searchQid(Q) fi, if searchQid(Q) == '1 then 1 else unbounded fi, 0, commandToComp(Q), LIMIT, BOUND, SOLVEDTICKMODE)) if (Q == 'tsearch_=>1_in`time`<_.) or (Q == 'tsearch_=>*_in`time`<_.) or (Q == 'tsearch_=>+_in`time`<_.) or (Q == 'tsearch_=>!_in`time`<_.) or (Q == 'tsearch_=>1_in`time`<=_.) or (Q == 'tsearch_=>*_in`time`<=_.) or (Q == 'tsearch_=>+_in`time`<=_.) or (Q == 'tsearch_=>!_in`time`<=_.) or (Q == 'tsearch_=>1_in`time`>=_.) or (Q == 'tsearch_=>*_in`time`>=_.) or (Q == 'tsearch_=>+_in`time`>=_.) or (Q == 'tsearch_=>!_in`time`>=_.) or (Q == 'tsearch_=>1_in`time`>_.) or (Q == 'tsearch_=>*_in`time`>_.) or (Q == 'tsearch_=>+_in`time`>_.) or (Q == 'tsearch_=>!_in`time`>_.) . *** Now for in-between searches! ceq procParsedTimedCommandTPCLCL(Q, MOD, TERM, BOUND, T, COND, COMP, LIMIT, COMP', LIMIT', SOLVEDTICKMODE) = ('\n '\c 'Timed 'search (if BOUND =/= unbounded *** write [13] etc then ('\s '`[ qid(string(BOUND, 10)) '`] '\s ) else nil fi) 'in '\o eMetaPrettyPrint(getName(MOD)) '\s '\n '\t eMetaPrettyPrint(MOD, TERM) qid("=>" + string(searchQid(Q))) '\s eMetaPrettyPrint(MOD, T) '\n '\c 'in 'time 'between (if COMP == lt then '< else (if COMP == le then '<= else (if COMP == gt then '> else '>= fi) fi) fi) eMetaPrettyPrint(MOD, LIMIT) '\c 'and (if COMP' == lt then '< else (if COMP' == le then '<= else (if COMP' == gt then '> else '>= fi) fi) fi) eMetaPrettyPrint(MOD, LIMIT') '\c 'and 'with 'mode printMode(SOLVEDTICKMODE, MOD) ': '\n '\o *** Here comes the real call: procTimedSearch2(MOD, TERM, T, COND, if searchQid(Q) == '1 then '+ else searchQid(Q) fi, if searchQid(Q) == '1 then 1 else unbounded fi, 0, COMP, LIMIT, COMP', LIMIT', BOUND, SOLVEDTICKMODE)) if (Q == 'tsearch_=>1_in`time-interval`between__and__.) or (Q == 'tsearch_=>*_in`time-interval`between__and__.) or (Q == 'tsearch_=>+_in`time-interval`between__and__.) or (Q == 'tsearch_=>!_in`time-interval`between__and__.) . op procTimedSearch2 : Module Term Term Condition Qid Bound Nat ComparisonOp Term ComparisonOp Term Bound TickMode -> QidList . eq procTimedSearch2(MOD, TERM, T, COND, Q, D, N, COMP, LIMIT, COMP', LIMIT', BOUND, SOLVEDTICKMODE) = if timedMetaSearch(MOD, TERM, T, COND, Q, D, N, COMP, LIMIT, COMP', LIMIT', SOLVEDTICKMODE) :: ResultTriple then ('\c '\n 'Solution qid(string(N + 1, 10)) '\n '\o eMetaPrettyPrint(MOD, getSubstitution(timedMetaSearch(MOD, TERM, T, COND, Q, D, N, COMP, LIMIT, COMP', LIMIT', SOLVEDTICKMODE))) '\n (if N + 1 < BOUND then procTimedSearch2(MOD, TERM, T, COND, Q, D, N + 1, COMP, LIMIT, COMP', LIMIT', BOUND, SOLVEDTICKMODE) else nil fi) ) else (if N == 0 then '\n '\c 'No 'solution '\n '\o else '\n '\c 'No 'more 'solutions '\n '\o fi) fi . *** Find earliest: no time limit. ceq procParsedTimedCommandTP('find`earliest_=>*_., MOD, TERM, BOUND, T, COND, SOLVEDTICKMODE) = ('\n '\c 'Find 'earliest '\s '\o eMetaPrettyPrint(MOD, T) '\c 'in '\o eMetaPrettyPrint(getName(MOD)) '\c 'such 'that '\s '\n '\t '\o eMetaPrettyPrint(MOD, TERM) '=>* '\s eMetaPrettyPrint(MOD, T) '\n '\c 'with 'mode printMode(SOLVEDTICKMODE, MOD) '\c ': '\n '\o *** Here comes the real call: (if RT :: ResultTriple then ('\c '\n 'Result: '\o '\t eMetaPrettyPrint(MOD, getTerm(RT)) '\o '\n ) else (if RT == failure then ('\c '\n 'Result: 'state 'not 'reachable. '\o '\n) else ('\n '\r 'Error: 'something 'went 'wrong. '\o '\n) fi) fi) ) if RT := findEarliest(MOD, TERM, T, COND, SOLVEDTICKMODE) . *** Find latest: *** First, no time limit ceq procParsedTimedCommandTP('find`latest_=>*_with`no`time`limit`., MOD, TERM, BOUND, T, COND, SOLVEDTICKMODE) = ('\n '\c 'Find 'latest '\s '\o eMetaPrettyPrint(MOD, T) '\c 'in '\o eMetaPrettyPrint(getName(MOD)) '\c 'such 'that '\n '\t '\o eMetaPrettyPrint(MOD, TERM) '=>* '\s eMetaPrettyPrint(MOD, T) '\n '\c 'with 'no 'time 'limit 'with 'mode printMode(SOLVEDTICKMODE, MOD) '\c ': '\n '\o *** Here comes the real call: (if TS :: Term then ('\c '\n 'Result: '\o '\t eMetaPrettyPrint(MOD, TS) '\o '\n ) else (if TS == noterm then ('\c '\n 'Result: 'there 'is 'a 'path 'in 'which 'the 'pattern 'is 'not 'reachable. '\o '\n) else ('\r 'Error: 'something 'went 'wrong. '\o '\n) fi) fi) ) if TS := findLatest(MOD, TERM, T, COND, true, SOLVEDTICKMODE) . *** Now with time constraints: ceq procParsedTimedCommandTPL(Q, MOD, TERM, BOUND, T, COND, LIMIT, SOLVEDTICKMODE) = ('\n '\c 'Find 'latest '\s '\o eMetaPrettyPrint(MOD, T) '\c 'in '\o eMetaPrettyPrint(getName(MOD)) '\c 'such 'that '\n '\t '\o eMetaPrettyPrint(MOD, TERM) '=>* '\s eMetaPrettyPrint(MOD, T) '\n '\c 'in 'time commandToCompSymb(Q) eMetaPrettyPrint(MOD, LIMIT) '\c 'with 'mode printMode(SOLVEDTICKMODE, MOD) '\c ': '\n '\o *** Here comes the real call: (if TS :: Term then ('\c '\n 'Result: '\o '\t eMetaPrettyPrint(MOD, TS) '\o '\n) else (if TS == noterm then ('\c '\n 'Result: 'there 'is 'a 'path 'in 'which 'the 'pattern 'is 'not 'reachable 'in 'time commandToCompSymb(Q) eMetaPrettyPrint(MOD, LIMIT) '\o '\n) else ('\r '\n 'Error: 'something 'went 'wrong. '\o '\n) fi) fi) ) if (Q == 'find`latest_=>*_in`time`<_.) or (Q == 'find`latest_=>*_in`time`<=_.) /\ TS := findLatest(MOD, TERM, T, COND, true, commandToComp(Q), LIMIT, SOLVEDTICKMODE) . *** Homemade diamond check: *** First, no time limit ceq procParsedTimedCommandTP('check_|=`<>_with`no`time`limit`., MOD, TERM, BOUND, T, COND, SOLVEDTICKMODE) = ('\n '\c 'Check '\s '\o eMetaPrettyPrint(MOD, TERM) '\c '|= '\y '<> '\o '\s eMetaPrettyPrint(MOD, T) '\c 'in '\o eMetaPrettyPrint(getName(MOD)) '\c 'with 'no 'time 'limit 'with 'mode printMode(SOLVEDTICKMODE, MOD) '\c ': '\n '\o *** Here comes the real call: (if TS :: Term then ('\c '\n 'Result: 'the 'property 'does 'not 'hold. 'Counterexample: '\n '\o '\t eMetaPrettyPrint(MOD, TS) '\o '\n ) else (if TS == noterm then ('\c '\n 'Result: 'the 'property 'holds. '\o '\n) else ('\r '\n 'Error: 'something 'went 'wrong. '\o '\n) fi) fi) ) if TS := timedDiamond(MOD, TERM, T, COND, true, SOLVEDTICKMODE) . *** Now with time constraints: ceq procParsedTimedCommandTPL(Q, MOD, TERM, BOUND, T, COND, LIMIT, SOLVEDTICKMODE) = ('\n '\c 'Check '\s '\o eMetaPrettyPrint(MOD, TERM) '\c '|= '\y '<> '\o '\s eMetaPrettyPrint(MOD, T) '\c 'in '\o eMetaPrettyPrint(getName(MOD)) '\c 'in 'time commandToCompSymb(Q) eMetaPrettyPrint(MOD, LIMIT) '\c 'with 'mode printMode(SOLVEDTICKMODE, MOD) '\c ': '\n '\o *** Here comes the real call: (if TS :: Term then ('\c '\n 'Result: 'the 'property 'does 'not 'hold. 'Counterexample: '\n '\o '\t eMetaPrettyPrint(MOD, TS) '\o '\n ) else (if TS == noterm then ('\c '\n 'Result: 'The 'property 'holds. '\o '\n) else ('\r '\n 'Error: 'something 'went 'wrong. '\o '\n) fi) fi) ) if (Q == 'check_|=`<>_in`time`<_.) or (Q == 'check_|=`<>_in`time`<=_.) /\ TS := timedDiamond(MOD, TERM, T, COND, true, commandToComp(Q), LIMIT, SOLVEDTICKMODE) . *** Homemade "until". This also exists with an untimed version which *** I do not provide here! *** First without time constraints: ceq procParsedTimedCommandTPP('check_|=_until_with`no`time`limit`., MOD, TERM, BOUND, T, COND, T', COND', SOLVEDTICKMODE) = ('\n '\c 'Check '\s '\o eMetaPrettyPrint(MOD, TERM) '\c '|= '\s '\o eMetaPrettyPrint(MOD, T) '\y 'until '\o '\s eMetaPrettyPrint(MOD, T') '\c 'in '\o eMetaPrettyPrint(getName(MOD)) '\c 'with 'no 'time 'limit 'with 'mode printMode(SOLVEDTICKMODE, MOD) '\c ': '\n '\o *** Here comes the real call: (if TS :: Term then ('\c '\n 'Result: 'the 'property 'does 'not 'hold. 'Counterexample: '\n '\o '\t eMetaPrettyPrint(MOD, TS) '\o '\n ) else (if TS == noterm then ('\c '\n 'Result: 'The 'property 'holds. '\o '\n) else ('\r '\n 'Error: 'something 'went 'wrong. '\o '\n) fi) fi) ) if TS := timedUntil(MOD, TERM, T, COND, true, T', COND', true, SOLVEDTICKMODE) . *** Now with time constraints: ceq procParsedTimedCommandTPPL(Q, MOD, TERM, BOUND, T, COND, T', COND', LIMIT, SOLVEDTICKMODE) = ('\n '\c 'Check '\s '\o eMetaPrettyPrint(MOD, TERM) '\c '|= '\s '\o eMetaPrettyPrint(MOD, T) '\y 'until '\o '\s eMetaPrettyPrint(MOD, T') '\c 'in '\o eMetaPrettyPrint(getName(MOD)) '\c 'in 'time commandToCompSymb(Q) eMetaPrettyPrint(MOD, LIMIT) '\c 'with 'mode printMode(SOLVEDTICKMODE, MOD) '\c ': '\n '\o *** Here comes the real call: (if TS :: Term then ('\c '\n 'Result: 'the 'property 'does 'not 'hold. 'Counterexample: '\n '\o '\t eMetaPrettyPrint(MOD, TS) '\o '\n ) else (if TS == noterm then ('\c '\n 'Result: 'The 'property 'holds. '\o '\n) else ('\r '\n 'Error: 'something 'went 'wrong. '\o '\n) fi) fi) ) if (Q == 'check_|=_until_in`time`<_.) or (Q == 'check_|=_until_in`time`<=_.) /\ TS := timedUntil(MOD, TERM, T, COND, true, T', COND', true, commandToComp(Q), LIMIT, SOLVEDTICKMODE) . *** Timed untilstable: *** First without time constraints: ceq procParsedTimedCommandTPP('check_|=_untilStable_with`no`time`limit`., MOD, TERM, BOUND, T, COND, T', COND', SOLVEDTICKMODE) = ('\n '\c 'Check '\s '\o eMetaPrettyPrint(MOD, TERM) '\c '|= '\o '\s eMetaPrettyPrint(MOD, T) '\y 'untilStable '\o '\s eMetaPrettyPrint(MOD, T') '\c 'in '\o eMetaPrettyPrint(getName(MOD)) '\c 'with 'no 'time 'limit 'with 'mode printMode(SOLVEDTICKMODE, MOD) '\c ': '\n '\o *** Here comes the real call: (if TS :: Term then ('\c '\n 'Result: 'the 'property 'does 'not 'hold. 'Counterexample: '\n '\o '\t eMetaPrettyPrint(MOD, TS) '\o '\n ) else (if TS == noterm then ('\c '\n 'Result: 'the 'property 'holds. '\o '\n) else ('\r '\n 'Error: 'something 'went 'wrong. '\o '\n) fi) fi) ) if TS := timedUntilStable(MOD, TERM, T, COND, true, T', COND', true, SOLVEDTICKMODE) . *** Now with time constraints: ceq procParsedTimedCommandTPPL(Q, MOD, TERM, BOUND, T, COND, T', COND', LIMIT, SOLVEDTICKMODE) = ('\n '\c 'Check '\o '\s eMetaPrettyPrint(MOD, TERM) '\c '|= '\o '\s eMetaPrettyPrint(MOD,T) '\y 'untilStable '\o '\s eMetaPrettyPrint(MOD, T') '\c 'in '\o eMetaPrettyPrint(getName(MOD)) '\c 'in 'time commandToCompSymb(Q) eMetaPrettyPrint(MOD, LIMIT) '\c 'with 'mode printMode(SOLVEDTICKMODE, MOD) '\c ': '\n '\o *** Here comes the real call: (if TS :: Term then ('\c '\n 'Result: 'the 'property 'does 'not 'hold. 'Counterexample: '\n '\o '\t eMetaPrettyPrint(MOD, TS) '\o '\n ) else (if TS == noterm then ('\c '\n 'Result: 'the 'property 'holds. '\o '\n) else ('\r '\n 'Error: 'something 'went 'wrong. '\o '\n) fi) fi) ) if (Q == 'check_|=_untilStable_in`time`<_.) or (Q == 'check_|=_untilStable_in`time`<=_.) /\ TS := timedUntilStable(MOD, TERM, T, COND, true, T', COND', true, commandToComp(Q), LIMIT, SOLVEDTICKMODE) . *** Model checking! First mc_|=u_. Untimed model checking. ceq procParsedTimedCommandTP('mc_|=u_., MOD, TERM, BOUND, T, nil, SOLVEDTICKMODE) = if RP :: ResultPair then ('\n '\c 'Untimed 'model 'check '\s '\o eMetaPrettyPrint(MOD, TERM) '\c '\s '|=u '\o '\s eMetaPrettyPrint(MOD, T) '\c '\s 'in '\o eMetaPrettyPrint(getName(MOD)) '\c 'with 'mode printMode(SOLVEDTICKMODE, MOD) '\c '\n '\c '\n 'Result '\o eMetaPrettyPrint(getType(RP)) '\c ': '\n '\o '\s '\s eMetaPrettyPrint(MOD, getTerm(RP)) '\n '\o ) else ('\n '\r 'Untimed 'model 'checking: 'Something 'went 'wrong! '\o '\n) fi if RP := metaMC(MOD, TERM, T, 'u, SOLVEDTICKMODE) . ceq procParsedTimedCommandTP('mc_|=u_., MOD, TERM, BOUND, T, COND, SOLVEDTICKMODE) = ('\n '\r 'Error: 'No 'condition 'in 'temporal 'logic 'model 'checking! '\o '\n) if COND =/= nil . *** "Timed", maybe slightly misnamed, model checking. *** Properties valied for GlobalSystems are valid at all times. ceq procParsedTimedCommandTP('mc_|=t_with`no`time`limit`., MOD, TERM, BOUND, T, nil, SOLVEDTICKMODE) = if RP :: ResultPair then ('\n '\c 'Model 'check '\o eMetaPrettyPrint(MOD, TERM) '\s '\c '|=t '\o eMetaPrettyPrint(MOD, T) '\c '\s 'in '\o eMetaPrettyPrint(getName(MOD)) '\c 'with 'mode printMode(SOLVEDTICKMODE, MOD) '\c '\n '\c '\n 'Result '\o eMetaPrettyPrint(getType(RP)) '\c ': '\n '\o '\s '\s eMetaPrettyPrint(MOD, getTerm(RP)) '\o '\n) else ('\n '\r 'Model 'checking: 'something 'went 'wrong! '\o '\n) fi if RP := metaMC(MOD, TERM, T, 't, SOLVEDTICKMODE) . ceq procParsedTimedCommandTP('mc_|=t_with`no`time`limit`., MOD, TERM, BOUND, T, COND, SOLVEDTICKMODE) = ('\n '\r 'Error: 'No 'condition 'in 'temporal 'logic 'model 'checking! '\o '\n) if COND =/= nil . *** Timed model checking with limit: ceq procParsedTimedCommandTPL(Q, MOD, TERM, BOUND, T, nil, LIMIT, SOLVEDTICKMODE) = if RP :: ResultPair then ('\n '\c 'Model 'check '\o eMetaPrettyPrint(MOD, TERM) '\c '\s '|=t '\o eMetaPrettyPrint(MOD, T) '\c 'in '\o eMetaPrettyPrint(getName(MOD)) '\c '\s 'in 'time commandToCompSymb(Q) eMetaPrettyPrint(MOD, LIMIT) '\c 'with 'mode printMode(SOLVEDTICKMODE, MOD) '\c '\n '\c '\n 'Result '\o eMetaPrettyPrint(getType(RP)) '\c ': '\n '\o '\s '\s eMetaPrettyPrint(MOD, getTerm(RP)) '\o '\n) else ('\n '\r 'Model 'checking: 'something 'went 'wrong! '\n '\o) fi if (Q == 'mc_|=t_in`time`<_.) or (Q == 'mc_|=t_in`time`<=_.) /\ RP := metaMC(MOD, TERM, T, commandToComp(Q), LIMIT, SOLVEDTICKMODE) . ceq procParsedTimedCommandTPL(Q, MOD, TERM, BOUND, T, COND, LIMIT, SOLVEDTICKMODE) = ('\n '\r 'Error: 'No 'condition 'in 'temporal 'logic 'model 'checking! '\o '\n) if (Q == 'mc_|=t_in`time`<_.) or (Q == 'mc_|=t_in`time`<=_.) /\ COND =/= nil . endfm --- --------------------------------------------------------- fmod HELP-MENU is protecting QID-LIST . protecting STRING . op help : String ~> QidList . eq help("help") = ('\n '\t '\c 'Real-Time 'Maude 'help 'menu. '\o '\n '\n '\s '\s 'Provides 'the 'syntax 'and '\r 'short '\o 'description 'of '\y 'time-specific '\o 'commands. '\n '\s '\s 'Please 'choose 'between 'the 'following 'help 'commands: '\n '\n '\s '\s 'help 'rewrite '. '\s '\t 'help 'trew '. '\s '\s '\s '\s '\s '\s '\t 'help 'tfrew '. '\n '\s '\s 'help 'search '. '\s '\s '\t 'help 'tsearch '. '\s '\s '\s '\s '\t 'help 'utsearch '. '\n '\s '\s 'help 'check '. '\s '\s '\s '\t 'help 'diamond '. '\s '\s '\s '\s '\s '\t 'help 'until '. '\n '\s '\s 'help 'until-stable '. '\s '\s '\s '\t '\n '\s '\s 'help 'find '. '\s '\s '\s '\s '\t 'help 'earliest '. '\s '\s '\t 'help 'latest '. '\n '\s '\s 'help 'mc '. '\s '\s '\s '\s '\s '\s '\t 'help 'model-check '. '\n '\s '\s 'help 'tick-mode '. '\s '\t 'help 'set '. '\s '\s '\s '\s '\s '\s '\s '\t 'help 'get '. '\n) . eq help("trew") = ('\n '\s '\s '\c 'Command '\r 'trew: '\o 'Timed 'rewrite. '\n '\n '\s '\s 'Rewrite 'a 'given 'initial 'state 'up 'to 'a 'given 'time 'limit 'using 'a '\y 'default '\n '\s '\s 'interpreter 'strategy. '\o 'Uses 'the 'previously 'given '\y 'tick 'mode '\o 'to 'apply '\n '\s '\s 'nondeterministic 'tick 'rules. '\n '\n '\s '\s '\c 'Usage: '\o '\n '\t '\o '`( 'trew '\y 'initState '\o 'in 'time '< '\y 'timeLimitTerm '\o '. '`) '\n '\t '\t 'or '\n '\t '`( 'trew '\y 'initState '\o 'in 'time '<= '\y 'timeLimitTerm '\o '. '`) '\n '\t '\t 'or '\n '\t '`( 'trew '\y 'initState '\o 'with 'no 'time 'limit '. '`) '\n '\s '\s 'where '\y 'initState '\o 'is 'the 'initial 'state 'and '\y 'timeLimitTerm '\o 'is 'a 'time 'value. '\n '\n '\s '\s 'Like 'the 'usual 'rewrite 'command '`, '\s 'this 'command 'can 'also 'be 'provided 'with 'an '\n '\s '\s 'upper 'bound 'on 'the 'number 'of 'rewrites 'to 'perform 'and/or 'with 'a 'module '\n '\s '\s 'in 'which 'the 'command 'should 'be 'executed: '\n '\n '\t '\o '`( 'trew '\s '`[ '\y 'n '\o '`] '\s '\y 'initState '\o '... '`) '\n '\t '\t 'or '\n '\t '\o '`( 'trew 'in '\y 'mod '\o ': '\y 'initState '\o '... '`) '\n '\t '\t 'or '\n '\t '\o '`( 'trew '\s '`[ '\y 'n '\o '`] '\s 'in '\y 'mod '\o ': '\y 'initState '\o '... '`) '\. '\n) . eq help("tfrew") = ('\n '\s '\s '\c 'Command '\r 'tfrew: '\o 'Timed '\r 'fair '\o 'rewrite. '\n '\n '\s '\s 'Rewrite 'a 'given 'initial 'state 'up 'to 'a 'given 'time 'limit 'using 'a '\y '"fair" '\n '\s '\s 'interpreter 'strategy. '\o 'Uses 'the 'previously 'given '\y 'tick 'mode '\o 'to 'apply '\n '\s '\s 'nondeterministic 'tick 'rules. '\n '\n '\s '\s '\c 'Usage: '\o '\n '\t '\o '`( 'tfrew '\y 'initState '\o 'in 'time '< '\y 'timeLimitTerm '\o '. '`) '\n '\t '\t 'or '\n '\t '`( 'tfrew '\y 'initState '\o 'in 'time '<= '\y 'timeLimitTerm '\o '. '`) '\n '\t '\t 'or '\n '\t '`( 'tfrew '\y 'initState '\o 'with 'no 'time 'limit '. '`) '\n '\s '\s 'where '\y 'initState '\o 'is 'the 'initial 'state 'and '\y 'timeLimitTerm '\o 'is 'a 'time 'value. '\n '\n '\s '\s 'Like 'the 'usual 'rewrite 'command '`, '\s 'this 'command 'can 'also 'be 'provided 'with 'an '\n '\s '\s 'upper 'bound 'on 'the 'number 'of 'rewrites 'to 'perform 'and/or 'with 'a 'module '\n '\s '\s 'in 'which 'the 'command 'should 'be 'executed: '\n '\n '\t '\o '`( 'tfrew '\s '`[ '\y 'n '\o '`] '\s '\y 'initState '\o '... '`) '\n '\t '\t 'or '\n '\t '\o '`( 'tfrew 'in '\y 'mod '\o ': '\y 'initState '\o '... '`) '\n '\t '\t 'or '\n '\t '\o '`( 'tfrew '\s '`[ '\y 'n '\o '`] '\s 'in '\y 'mod '\o ': '\y 'initState '\o '... '`) '\. '\n) . eq help("rewrite") = ('\n '\s '\s '\c 'Rewriting 'in 'Real-Time 'Maude. '\n '\n '\o '\s '\s 'Real-Time 'Maude 'provides 'Maude's 'usual 'rew '`( 'rite '`) '\s 'and 'frew '`( 'rite '`) '\s 'commands '`, '\n '\s '\s 'as 'well 'as 'their 'timed 'versions '\y 'trew '\o 'and '\y 'tfrew. '\o '\n '\n '\o '\s '\s 'The 'difference 'is 'that 'the 'latter 'two 'handle 'nondeterministic 'tick 'rules '\n '\s '\s 'according 'to 'the 'current '\c 'tick 'mode '\o '`, 'and 'that 'the 'rewriting 'can 'be 'bounded '\n '\s '\s 'by 'the '`( 'simulated '`) '\s 'time 'elapse 'and 'not 'just 'by 'the '\c 'number '\o 'of 'rewrites. '\n '\n '\o '\s '\s 'See '\y 'help 'trew '\o 'and '\y 'help 'tfrew '\o 'for 'further 'explanation 'of 'these 'commands. '\n ) . eq help("search") = ('\n '\s '\s '\c 'Search 'in 'Real-Time 'Maude. '\n '\n '\o '\s '\s 'Real-Time 'Maude's '\y 'tsearch '\o 'command 'extends '\s '`( 'Full '`) '\s 'Maude's '\y 'search '\o 'command 'by '\n '\s '\s '\s '* 'searching 'for 'states 'reachable 'in 'a 'given 'time 'interval '\n '\s '\s '\s '* 'handling 'nondeterministic 'tick 'rules 'by 'taking 'the 'current '\c 'tick 'mode '\o '\n '\s '\s '\s '\s '\s 'into 'account 'when 'applying 'the 'tick 'rules '\n '\s '\s '\s '* 'allowing 'the 'user 'to 'search 'for 'both '"clocked" 'and '"unclocked" 'patterns. '\n '\n '\s '\s 'Adding 'a 'time/clock 'component 'measuring 'the 'total 'duration 'of 'the '\n '\s '\s '"current" 'rewrite 'makes 'an 'otherwise 'finite-state 'system 'into 'an '\n '\s '\s 'infinite-state 'system. 'Real-Time 'Maude's '\y 'utsearch '\o 'command 'ignores 'all '\n '\s '\s 'duration 'information 'and 'performs 'an '"untimed" 'search. 'Nondeterministic '\n '\s '\s 'tick 'rules 'are 'treated 'according 'to 'the 'current 'rewrite 'mode 'also '\n '\s '\s 'in 'an 'untimed 'search. '\n '\n '\o '\s '\s '\r 'Known '"problem:" '\o 'Variables 'in '\c 'such 'that '\o 'conditions 'must 'be 'written 'using '\n '\s '\s 'their '"direct form," 'i.e. '`, '\s 'they 'must 'be 'written 'in 'the 'form '\c 'VAR:SORT. '\n '\n '\o '\s '\s 'See '\y 'help 'tsearch '\o 'and '\y 'help 'utsearch '\o 'for 'further 'explanation 'of 'these '\n '\s '\s 'commands. '\n ) . eq help("tsearch") = ('\n '\s '\s '\c 'Command '\r 'tsearch: '\o 'Timed 'search. '\n '\n '\s '\s 'Performs 'a '"timed" 'search 'from 'a 'given 'initial 'state 'within 'a 'user-defined '\n '\s '\s 'time 'interval 'and 'with 'the 'given 'tick 'mode. 'The '\s '`( 'initial 'state 'and 'the '`) '\s '\n '\s '\s 'search 'pattern 'may 'be 'a '"clock-less" 'term 'of 'sort '\c 'GlobalSystem '\o 'or 'a '"clocked" '\n '\s '\s 'term 'of 'the 'form '\s '\c '`{ '\y 'pattern '\c '`} '\s 'in 'time '\y 'r '\o 'of 'sort '\c 'ClockedSystem. '\o 'In 'each 'case '\n '\s '\s 'we 'may 'add 'a '\r 'condition '\o 'to 'the 'search. '\o '\n '\n '\s '\s '\c 'Usage: '\n '\n '\s '\s '\s '\s '\s '\s '\s '\s '\o '`( 'tsearch '\y 'initState 'searchKind 'searchPattern '\o 'with 'no 'time 'limit '. '`) '\n '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s 'or '\n '\s '\s '\s '\s '\s '\s '\s '\s '`( 'tsearch '\y 'initState 'searchKind 'searchPattern '\o 'in 'time '\y 'op 'time '\o '. '`) '\n '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s '\s 'or '\n '\s '\s '\s '\s '\s '\s '\s '\s '`( 'tsearch '\y 'initState 'searchKind 'searchPattern '\o 'in 'time-interval '\n '\s '\s '\s '\s '\s '\s '\s '\s '\s 'between '\y 'op1 'time1 '\o 'and '\y 'op2 'time2 '\o '. '`) '\n '\n '\s '\s 'where '\y 'searchKind '\o 'is 'either '\c '=>1 '\o '\s '`( 'search 'for 'states 'reachable 'in 'exactly '\n '\s '\s 'one 'rewrite 'step '`) '`, '\s '\c '=>* '\o '\s '`( 'search 'for 'states 'reachable 'in 'zero 'or 'more '\n '\s '\s 'rewrite 'steps '`) '`, '\s '\c '=>+ '\o '\s '`( 'search 'for 'states 'reachable 'in 'one 'or 'more 'rewrite '\n '\s '\s 'steps '`) '`, '\s 'or '\c '=>! '\o '\s '`( 'search 'for 'states 'which 'cannot 'be 'further 'rewritten '`) '`, '\s 'and '\n '\s '\s 'each '\y 'op '\o '`, '\y '\s 'op1 '\o '`, '\s 'and '\y 'op2 '\o 'is 'either 'of '\c '< '\o '`, '\s '\c '<= '\o '`, '\s '\c '> '\o '`, '\s 'or '\c '>= '\o '. '\r 'searchPattern '\o 'has '\n '\s '\s 'either 'of 'the 'forms '\r '\s '\s 't '\o '`, '\s '\s '\r 't '\c 'in 'time '\r 'r '\o '`, '\s '\s '\r 't '\c 'such 'that '\r 'cond '\o '`, '\s 'or '\n '\s '\s '\r 't '\c 'in 'time '\r 'r '\c 'such 'that '\r 'cond '\o '`, '\s '\s 'where '\r 't '\o 'is 'a 'term 'of 'sort '\c 'GlobalSystem. '\o '\n '\s '\s '`( '\c 'such 'that '\o 'can 'also 'be 'written '\c 's.t. '\o '`) '. '\n '\n '\s '\s 'This 'command 'can 'also 'be 'provided 'with 'an 'upper 'bound 'on '\n '\s '\s 'the 'number 'of 'solutions 'to 'look 'for 'and/or 'with 'a 'module 'in 'which 'the '\n '\s '\s 'command 'should 'be 'executed: '\n '\n '\t '\o '`( 'tsearch '\s '`[ '\y 'n '\o '`] '\s '\y 'initState '\o '... '`) '\n '\t '\t 'or '\n '\t '\o '`( 'tsearch 'in '\y 'mod '\o ': '\y 'initState '\o '... '`) '\n '\t '\t 'or '\n '\t '\o '`( 'tsearch '\s '`[ '\y 'n '\o '`] '\s 'in '\y 'mod '\o ': '\y 'initState '\o '... '`) '. '\n '\n '\o '\s '\s '\r 'Known '"problem:" '\o 'Variables 'in '\c 'such 'that '\o 'conditions 'must 'be 'written 'using '\n '\s '\s 'their '"direct form," 'i.e. '`, '\s 'they 'must 'be 'written 'in 'the 'form '\c 'VAR:SORT. '\s '\o '\n) . eq help("utsearch") = ('\n '\s '\s '\c 'Command '\r 'utsearch: '\o 'Untimed 'search. '\n '\n '\s '\s 'Performs 'an '"untimed" 'search 'from 'a 'given 'initial 'state 'with 'the 'given '\n '\s '\s 'tick 'mode. '\n '\n '\s '\s '\c 'Usage: '\n '\n '\s '\s '\s '\s '\s '\s '\s '\s '\o '`( 'utsearch '\y 'initState 'searchKind 'searchPattern '\o '. '`) '\n '\n '\s '\s 'where '\y 'searchKind '\o 'is 'either '\c '=>1 '\o '\s '`( 'search 'for 'states 'reachable 'in 'exactly '\n '\s '\s 'one 'rewrite 'step '`) '`, '\s '\c '=>* '\o '\s '`( 'search 'for 'states 'reachable 'in 'zero 'or 'more '\n '\s '\s 'rewrite 'steps '`) '`, '\s '\c '=>+ '\o '\s '`( 'search 'for 'states 'reachable 'in 'one 'or 'more 'rewrite '\n '\s '\s 'steps '`) '`, '\s 'or '\c '=>! '\o '\s '`( 'search 'for 'states 'which 'cannot 'be 'further 'rewritten '`) '. '\n '\s '\s '\r 'searchPattern '\o 'has 'either 'of 'the 'forms '\r '\s '\s 't '\o '\s 'or '\s '\s '\r 't '\c 'such 'that '\r 'cond '\o '\n '\s '\s 'for 'a 'term '\r 't. '\o '\s '`( '\c 'such 'that '\o 'can 'also 'be 'written '\c 's.t. '\o '`) '. '\n '\n '\s '\s 'This 'command 'can 'also 'be 'provided 'with 'an 'upper 'bound 'on '\n '\s '\s 'the 'number 'of 'solutions 'to 'look 'for 'and/or 'with 'a 'module 'in 'which 'the '\n '\s '\s 'command 'should 'be 'executed: '\n '\n '\t '\o '`( 'utsearch '\s '`[ '\y 'n '\o '`] '\s '\y 'initState '\o '... '`) '\n '\t '\t 'or '\n '\t '\o '`( 'utsearch 'in '\y 'mod '\o ': '\y 'initState '\o '... '`) '\n '\t '\t 'or '\n '\t '\o '`( 'utsearch '\s '`[ '\y 'n '\o '`] '\s 'in '\y 'mod '\o ': '\y 'initState '\o '... '`) '\n '\n '\o '\s '\s '\r 'Known '"problem:" '\o 'Variables 'in '\c 'such 'that '\o 'conditions 'must 'be 'written 'using '\n '\s '\s 'their '"direct form," 'i.e. '`, '\s 'they 'must 'be 'written 'in 'the 'form '\c 'VAR:SORT. '\s '\o '\n) . eq help("find") = ('\n '\s '\s '\c 'Find 'the 'earliest 'and '"latest" 'time 'in 'which 'a 'desired 'state 'can 'be 'reached. '\o '\n '\n '\s '\s 'The 'command '\y 'find 'earliest '\o 'finds 'the 'earliest 'time 'in 'which 'a 'desired '\n '\s '\s 'pattern '\s '`( 'i.e. '`, '\s 'a 'term 'of 'sort '\c 'GlobalSystem '\o 'which 'may 'contain 'variables '\n '\s '\s 'and '\c 'such 'that '\o 'conditions '`) '\s 'can 'be 'reached. '\n '\n '\s '\s 'The 'command '\y 'find 'latest '\o 'searches 'through 'all 'paths 'from 'the 'initial '\n '\s '\s 'state 'and 'finds 'the 'path 'in 'which 'it 'takes 'the 'most 'time 'to 'reach 'a '\n '\s '\s 'desired 'pattern '`, '\s 'and 'returns 'a 'negative 'answer 'if 'there 'is 'a 'path 'in '\n '\s '\s 'which 'a 'desired 'state 'cannot 'be 'found. 'This 'command 'is 'therefore '\n '\s '\s 'also 'a 'model 'checking 'command 'for '"diamond" 'properties. '\n '\s '\s 'The '\y 'find 'latest '\o 'command 'is 'implemented 'directly 'in 'the 'meta-level 'and '\n '\s '\s 'is 'not 'very 'efficient. '\n '\n '\s '\s 'See '\y 'help 'earliest '\o 'and '\y 'help 'latest '\o 'for 'further 'explanation 'of '\n '\s '\s 'these 'commands. '\n ) . eq help("latest") = ('\n '\s '\s '\c 'Command '\r 'find 'latest. '\o '\n '\n '\s '\s 'Find 'the 'latest '"first" 'state 'in 'paths 'satisfying 'the 'given 'pattern '\n '\s '\s '`( 'which 'may 'be 'equipped 'with 'a '\c 'such 'that '\o 'condition '`) '`, '\s 'possibly 'within '\n '\s '\s 'given 'time 'bounds. 'If 'there 'is 'a 'path 'in 'which 'a 'desired 'state '\n '\s '\s 'is 'not 'reached 'an 'error 'message 'will 'be 'given. '\n '\n '\s '\s '\c 'Usage: '\o '\n '\n '\t '\o '`( 'find 'latest '\y 'initState '\o '=>* '\y 'searchPattern '\o 'with 'no 'time 'limit '. '`) '\n '\t '\t '\t 'or '\n '\t '\o '`( 'find 'latest '\y 'initState '\o '=>* '\y 'searchPattern '\o 'in 'time '<= '\y 'timeLimitTerm '\o '. '`) '\n '\t '\t '\t 'or '\n '\t '\o '`( 'find 'latest '\y 'initState '\o '=>* '\y 'searchPattern '\o 'in 'time '< '\y 'timeLimitTerm '\o '. '`) '\n '\n '\s '\s 'This 'command 'can 'also 'be 'provided 'with 'a 'module 'in 'which 'the '\n '\s '\s 'command 'should 'be 'executed: '\n '\n '\t '\o '`( 'find 'latest 'in '\y 'mod '\o ': '\y 'initState '\o '... '`) '\n '\n '\o '\s '\s '\r 'Known 'problem: '\o 'Variables 'in '\c 'such 'that '\o 'conditions 'must 'be 'written 'using 'their '\n '\s '\s '"direct form," 'i.e. '`, '\s 'they 'must 'be 'written 'in 'the 'form '\c 'VAR:SORT. '\s '\o '\n ) . eq help("earliest") = ('\n '\s '\s '\c 'Command '\r 'find 'earliest. '\o '\n '\n '\s '\s 'Find 'the '"earliest" 'state 'satisfying 'a 'given 'pattern '\s '`( 'which 'may 'be '\n '\s '\s 'equipped 'with 'a '\c 'such 'that '\o 'condition '`) '. '\s '\n '\n '\s '\s '\c 'Usage: '\o '\n '\n '\t '\o '`( 'find 'earliest '\y 'initState '\o '=>* '\y 'searchPattern '\o '. '`) '\n '\n '\s '\s 'This 'command 'can 'also 'be 'provided 'with 'a 'module 'in 'which 'the '\n '\s '\s 'command 'should 'be 'executed: '\n '\n '\t '\o '`( 'find 'earliest 'in '\y 'mod '\o ': '\y 'initState '\o '... '`) '\n '\n '\o '\s '\s '\r 'Known 'problem: '\o 'Variables 'in '\c 'such 'that '\o 'conditions 'must 'be 'written 'using 'their '\n '\s '\s '"direct form," 'i.e. '`, '\s 'they 'must 'be 'written 'in 'the 'form '\c 'VAR:SORT. '\s '\o '\n ) . eq help("check") = ('\n '\s '\s '\c '"Explicit" 'breadth-first 'checking 'for 'some 'simple 'temporal 'properties. '\o '\n '\n '\s '\s 'Uses 'hand-coded 'breadth-first 'search 'techniques 'to 'check '\n '\s '\s '\s '* 'diamond '\s '`( '"eventually" '`) '\n '\s '\s '\s '* 'until '\n '\s '\s '\s '* '"until-stable" '\n '\s '\s 'properties 'where 'the 'arguments 'to 'the 'temporal 'operators 'are '\n '\s '\s 'state 'patterns '`, '\s 'possibly 'with '\c 'such 'that '\o 'conditions. '\n '\n '\s '\s 'Since 'the 'search 'is 'performed 'in 'a 'breadth-first 'way '`, '\s 'there 'are 'cases '\n '\s '\s 'in 'which '\y 'check '\o 'can 'validate 'a '\y 'diamond '\o 'property '`, '\s 'validate '\c 'and '\o '\n '\s '\s 'invalidate 'an '\y 'until '\o 'property '`, '\s 'and 'invalidate 'an '\y 'until-stable '\o 'property '\n '\s '\s 'where 'the 'corresponding 'temporal 'logic 'check 'would 'not 'terminate. '\n '\n '\s '\s 'Disadvantages 'are 'the 'lack 'of 'expressiveness 'of 'properties 'and '\n '\s '\s 'slow 'execution. '\n '\n '\s '\s 'See '\y 'help 'diamond '\o '`, '\s '\y 'help 'until '\o '`, '\s 'and '\y 'help 'until-stable '\o 'for 'further '\n '\s '\s 'explanation 'of 'these 'commands. '\n ) . eq help("diamond") = ('\n '\s '\s '\c 'Command '\r 'check '_ '|= '_ '<> '... '\o ': '\n '\n '\s '\s 'Checks 'whether 'a 'state 'matching 'the 'given 'pattern '\s '`( 'which 'may 'have 'a '\n '\s '\s '\c 'such 'that '\o 'condition '`) '\s 'is 'reachable '\s '`( 'within 'given 'time '`) '\s 'in '\y 'all '\o '\n '\s '\s 'rewrite 'sequences 'from 'the 'given 'initial 'state. '\n '\n '\s '\s '\c 'Usage: '\o '\n '\n '\t '`( 'check '\y 'initState '\o '|= '<> '\y 'pattern '\o 'with 'no 'time 'limit '. '`) '\n '\t '\t 'or '\n '\t '`( 'check '\y 'initState '\o '|= '<> '\y 'pattern '\o 'in 'time '<= '\y 'timeLimit '\o '. '`) '\n '\t '\t 'or '\n '\t '`( 'check '\y 'initState '\o '|= '<> '\y 'pattern '\o 'in 'time '< '\y 'timeLimit '\o '. '`) '\n '\n '\s '\s 'This 'command 'can 'also 'be 'provided 'with 'a 'module 'in 'which 'the '\n '\s '\s 'command 'should 'be 'executed: '\n '\n '\t '\o '`( 'check 'in '\y 'mod '\o ': '\y 'initState '\o '... '`) '\n '\n '\o '\s '\s '\r 'Known 'problem: '\o 'Variables 'in '\c 'such 'that '\o 'conditions 'must 'be 'written 'using 'their '\n '\s '\s '"direct form," 'i.e. '`, '\s 'they 'must 'be 'written 'in 'the 'form '\c 'VAR:SORT. '\s '\o '\n ) . eq help("until") = ('\n '\s '\s '\c 'Command '\r 'check '_ '|= '_ 'until '_ '... '\o ': '\n '\n '\s '\s 'Checks 'whether 'a 'state 'matching 'the 'second 'pattern 'is 'reachable '\s '`( 'within '\n '\s '\s 'given 'time '`) '\s 'in '\y 'all '\o 'rewrite 'sequences 'from 'the 'given 'initial 'state '`, '\s '\n '\s '\s 'so 'that 'in 'addition 'the 'first 'pattern 'holds 'until 'the 'second '\n '\s '\s 'pattern 'holds. 'Each 'pattern 'may 'be 'equipped 'with 'a '\c 'such 'that '\o 'condition. '\n '\n '\s '\s '\c 'Usage: '\o '\n '\n '\t '`( 'check '\y 'initState '\o '|= '\y 'pattern1 '\o 'until '\y 'pattern2 '\o 'with 'no 'time 'limit '. '`) '\n '\t '\t 'or '\n '\t '`( 'check '\y 'initState '\o '|= '\y 'pattern1 '\o 'until '\y 'pattern2 '\o 'in 'time '<= '\y 'timeLimit '\o '. '`) '\n '\t '\t 'or '\n '\t '`( 'check '\y 'initState '\o '|= '\y 'pattern1 '\o 'until '\y 'pattern2 '\o 'in 'time '< '\y 'timeLimit '\o '. '`) '\n '\n '\s '\s 'This 'command 'can 'also 'be 'provided 'with 'a 'module 'in 'which 'the '\n '\s '\s 'command 'should 'be 'executed: '\n '\n '\t '\o '`( 'check 'in '\y 'mod '\o ': '\y 'initState '\o '... '`) '\n '\n '\o '\s '\s '\r 'Known 'problem '1: '\o 'Variables 'in '\c 'such 'that '\o 'conditions 'must 'be 'written 'using '\n '\s '\s '\s '\s 'their '"direct form," 'i.e. '`, '\s 'they 'must 'be 'written 'in 'the 'form '\c 'VAR:SORT. '\n '\o '\s '\s '\r 'Known 'problem '2: '\o 'In 'time-bounded 'checking 'the 'first 'term '\r 'AFTER '\o 'the 'time 'limit 'is 'shown 'when 'the 'property 'does 'not 'hold. '\s '\o '\n ) . eq help("until-stable") = ('\n '\s '\s '\c 'Command '\r 'check '_ '|= '_ 'untilStable '_ '... '\o ': '\n '\n '\s '\s 'Checks 'whether 'a 'state 'matching 'the 'second 'pattern 'is 'reachable '\s '`( 'within '\n '\s '\s 'given 'time '`) '\s 'in '\y 'all '\o 'rewrite 'sequences 'from 'the 'given 'initial 'state '`, '\s '\n '\s '\s 'so 'that 'in 'addition 'the 'first 'pattern 'holds 'until 'the 'second '\n '\s '\s 'pattern 'holds. '\s '`( 'Each 'pattern 'may 'be 'equipped 'with 'a '\c 'such 'that '\o '\n '\s '\s 'condition. '`) '\s 'Furthermore '`, '\s 'once 'the 'second 'pattern 'starts 'to 'hold '`, '\n '\s '\s 'it 'should 'continue 'to 'do 'so. '\n '\n '\s '\s '\c 'Usage: '\o '\n '\n '\s '\s '\s '\s '`( 'check '\y 'initState '\o '|= '\y 'pattern1 '\o 'untilStable '\y 'pattern2 '\o 'with 'no 'time 'limit '. '`) '\n '\t '\t 'or '\n '\s '\s '\s '\s '`( 'check '\y 'initState '\o '|= '\y 'pattern1 '\o 'untilStable '\y 'pattern2 '\o 'in 'time '<= '\y 'timeLimit '\o '. '`) '\n '\t '\t 'or '\n '\s '\s '\s '\s '`( 'check '\y 'initState '\o '|= '\y 'pattern1 '\o 'untilStable '\y 'pattern2 '\o 'in 'time '< '\y 'timeLimit '\o '. '`) '\n '\n '\s '\s 'This 'command 'can 'also 'be 'provided 'with 'a 'module 'in 'which 'the '\n '\s '\s 'command 'should 'be 'executed: '\n '\n '\t '\o '`( 'check 'in '\y 'mod '\o ': '\y 'initState '\o '... '`) '\n '\n '\o '\s '\s '\r 'Known 'problem: '\o 'Variables 'in '\c 'such 'that '\o 'conditions 'must 'be 'written 'using 'their '\n '\s '\s '"direct form," 'i.e. '`, '\s 'they 'must 'be 'written 'in 'the 'form '\c 'VAR:SORT. '\s '\o '\n ) . eq help("mc") = help("model-check") . eq help("model-check") = ( '\n '\s '\s '\c 'Linear 'temporal 'logic 'model 'checking 'using 'Maude's 'built-in 'model 'checker. '\o '\n '\n '\s '\s 'The 'model 'checking 'command 'has 'an '\c '"untimed" '\o 'version 'which 'forgets '\n '\s '\s 'the 'clock 'information 'in 'order 'not 'to 'increase 'the 'state 'space '`, '\s 'and '\n '\s '\s 'a '\c '"timed" '\o 'version 'which 'includes 'the 'clock '`, '\s 'which 'makes 'the '\s '`( 'reachable '`) '\n '\s '\s 'state 'space 'infinite 'but 'allows 'to 'cut 'off 'the 'search 'at 'a 'certain 'time. '\n '\s '\s '\c 'Timed '\o 'model 'checking 'allows 'both '\c 'clocked '\o 'and '\c 'unclocked '\o 'propositions. '\n '\n '\s '\s 'Nondeterministic 'tick 'rules 'are 'in 'both 'cases 'handled 'according 'to '\n '\s '\s 'the 'current 'tick 'mode. 'The '"current" 'module 'should 'include 'both 'the '\n '\s '\s 'module '\y 'TIMED-MODEL-CHECKER '\o 'and 'the 'specification 'to 'be 'checked. '\n '\n '\s '\s '\c 'Usage: '\o '\n '\n '\s '\s '\s '\s 'The 'untimed 'model 'checking 'command 'has 'syntax '\n '\n '\t '`( 'mc '\y 'initState '\o '|=u '\y 'temporalFormula '\o '. '`) '\n '\n '\s '\s '\s '\s 'and 'timed 'model 'checking 'has 'syntax '\n '\n '\t '`( 'mc '\y 'initState '\o '|=t '\y 'temporalFormula '\o 'with 'no 'time 'limit '. '`) '\n '\t '\t '\t 'or '\n '\t '`( 'mc '\y 'initState '\o '|=t '\y 'temporalFormula '\o 'in 'time '<= '\y 'timeLimit '\o '. '`) '\n '\t '\t '\t 'or '\n '\t '`( 'mc '\y 'initState '\o '|=t '\y 'temporalFormula '\o 'in 'time '< '\y 'timeLimit '\o '. '`) '\n '\n '\s '\s 'This 'command 'can 'also 'be 'provided 'with 'a 'module 'in 'which 'the '\n '\s '\s 'command 'should 'be 'executed: '\n '\n '\t '\o '`( 'mc 'in '\y 'mod '\o ': '\y 'initState '\o '... '`) '\n ) . eq help("tick-mode") = ( '\n '\s '\s '\c 'Handling 'of 'the '\y 'tick 'mode '\s '\o '`( 'also 'known 'as '\r '"time sampling strategies" '\o '`) '. '\o '\n '\n '\s '\s 'Real-Time 'Maude 'currently 'offers 'three 'built-in 'strategies 'for '\n '\s '\s 'applying 'nondeterministic 'tick 'rules: '\n '\s '\s '\s '1. '\y '"Default" '\o 'strategy: 'advance 'time 'by 'by 'a 'given '"default" 'time '\n '\s '\s '\s '\s '\s '\s 'value 'if 'possible. '\n '\s '\s '\s '2. '\y '"Maximal" '\o 'strategy: 'advance 'time 'by 'by 'the 'maximum 'possible '\n '\s '\s '\s '\s '\s '\s 'time 'amount. '\n '\s '\s '\s '3. '\y '"Maximal strategy with default" '\o 'where 'time 'is 'advanced 'by 'the '\n '\s '\s '\s '\s '\s '\s 'maximum 'possible 'time 'amount 'and 'where 'time 'is 'advanced 'by 'a 'given '\n '\s '\s '\s '\s '\s '\s 'default 'value 'if 'maximum 'possible 'time 'increase 'is 'infinity. '\n '\s '\s '\s '4. '\y '"Deterministic" '\o 'strategy: 'assume 'that 'all 'tick 'rules 'are '\n '\s '\s '\s '\s '\s '\s 'deterministic 'and 'ignore 'those 'that 'are 'not. '\n '\n '\s '\s '\c 'Usage: '\o 'The 'current 'tick 'mode 'can 'be 'set 'by 'the 'following 'commands: '\n '\n '\t '`( 'set 'tick 'def '\y 'tickAmount '\o '. '`) '\n '\t '`( 'set 'tick 'max '. '`) '\n '\t '`( 'set 'tick 'max 'def '\y 'tickAmount '\o '. '`) '\n '\t '`( 'set 'tick 'det '. '`) '\n '\n '\s '\s 'The 'command '\n '\n '\t '`( 'get 'tick 'mode '. '`) '\n '\n '\s '\s 'returns 'the 'current 'tick 'mode. '\n) . eq help("set") = help("tick-mode") . eq help("get") = help("tick-mode") . var STR : String . ceq help(STR) = help("help") if STR =/= "trew" /\ STR =/= "rewrite" /\ STR =/= "tfrew" /\ STR =/= "tsearch" /\ STR =/= "utsearch" /\ STR =/= "search" /\ STR =/= "latest" /\ STR =/= "earliest" /\ STR =/= "find" /\ STR =/= "check" /\ STR =/= "help" /\ STR =/= "diamond" /\ STR =/= "until" /\ STR =/= "until-stable" /\ STR =/= "model-check" /\ STR =/= "mc" /\ STR =/= "tick-mode" /\ STR =/= "set" /\ STR =/= "get" . endfm --- ----------------------------------------------------------------- *** ******************************************************** *** *** Database handling *** *** i.e., first treatment of input ... *** ******************************************************** mod TIMED-DATABASE-HANDLING is including DATABASE-HANDLING . protecting TIMED-UNIT-PROCESSING . protecting TIMED-COMMAND-PROCESSING . protecting TIMED-DATA . protecting HELP-MENU . *** First, we define an additional attribute *** timedModuleData which is used to store whatever *** we need to store about timed stuff. In this first prototype, *** it is just the list of all names of timed modules ... sort TimedDatabaseClass . subsort TimedDatabaseClass < DatabaseClass . op TimedDatabase : -> TimedDatabaseClass [ctor] . op timedData :_ : TimedData -> Attribute [ctor] . var ATTS : AttributeSet . var DATABASE : DatabaseClass . var TIMEDDATABASE : TimedDatabaseClass . var DB : Database . vars F Q : Qid . vars T T' T'' T''' : Term . var TL : TermList . var O : Oid . var MN : ModuleName . var TIMEDDATA : TimedData . var ME : ModuleExpression . var QIL : QidList . *** First, read timed module when we are not in a timed database, and *** will have to change into a timed database ... crl [databaseToTimedDatabase] : < O : DATABASE | input : (F[T, T']), ATTS > => < O : TimedDatabase | input : (F[T, T']), ATTS, timedData : initTimedData > if ((F == 'tmod_is_endtm) or-else (F == 'tomod_is_endtom) or-else (F == 'tth_is_endtth) or-else (F == 'toth_is_endtoth)) and not (DATABASE :: TimedDatabaseClass) . *** Now, read timed stuff ... crl [readTimedModule] : < O : TIMEDDATABASE | db : DB, input : (F[T, T']), output : nil, default : ME, timedData : TIMEDDATA, ATTS > => < O : TIMEDDATABASE | db : procModule( timedPreModuleToPreModule( processTimedMetaLevel(F[T, T'], TIMEDDATA)), DB), input : nilTermList, output : ('\n '\c 'Introduced 'timed 'module: '\o header2Qid(parseHeader(T)) '\n), default : parseHeader(T), timedData : addModName(TIMEDDATA, pureModName(T)), ATTS > if (F == 'tmod_is_endtm) or-else (F == 'tomod_is_endtom) . *** The same treatment for time theories, just change one output word: crl [readTimedTheory] : < O : TIMEDDATABASE | db : DB, input : (F[T, T']), output : nil, default : ME, timedData : TIMEDDATA, ATTS > => < O : TIMEDDATABASE | db : procModule( timedPreModuleToPreModule( processTimedMetaLevel(F[T, T'], TIMEDDATA)), DB), input : nilTermList, output : ('\n '\c 'Introduced 'timed 'theory: '\o header2Qid(parseHeader(T)) '\n), default : parseHeader(T), timedData : addModName(TIMEDDATA, pureModName(T)), ATTS > if (F == 'tth_is_endtth) or-else (F == 'toth_is_endtoth) . *** If we are in a TimedDatabase, there could be a possibility *** that the user has imported a TIMED-META-LEVEL. *** It could also be the case otherwise, but in that *** case we do not do anything to ensure that RTM behaves *** as Full Maude when no timing is entered by the user ... crl [preprocessTimedMetaLevel] : < O : TIMEDDATABASE | db : DB, input : (F[T, T']), output : nil, default : ME, timedData : TIMEDDATA, ATTS > => < O : TIMEDDATABASE | db : procModule( processTimedMetaLevel(F[T, T'], TIMEDDATA), DB), input : nilTermList, output : ('\n '\c 'Introduced 'module '\o header2Qid(parseHeader(T)) '\n), default : parseHeader(T), timedData : TIMEDDATA, 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) . crl [preprocessTimedMetaLevel2] : < O : TIMEDDATABASE | db : DB, input : (F[T, T']), output : nil, default : MN, timedData : TIMEDDATA, ATTS > => < O : TIMEDDATABASE | db : procModule( processTimedMetaLevel(F[T, T'], TIMEDDATA), DB), input : nilTermList, output : ('\n '\c 'Introduced 'theory: '\o header2Qid(parseHeader(T)) '\n), default : parseHeader(T), timedData : TIMEDDATA, ATTS > if (F == 'fth_is_endfth) or-else (F == 'th_is_endth) or-else (F == 'oth_is_endoth) . rl [showTimedModules] : < O : TIMEDDATABASE | db : DB, input : ('show`timed`modules`..@Command@), output : nil, timedData : TIMEDDATA, ATTS > => < O : TIMEDDATABASE | db : DB, input : nilTermList, output : ('\n '\c 'Timed 'modules 'are: '\y getModNames(TIMEDDATA) '\o '\n), timedData : TIMEDDATA, ATTS > . op pureModName : Term -> Qid . *** No parameters ... eq pureModName('token[T]) = strip(getName(T)) . eq pureModName('_`(_`)[T, T']) = pureModName(T) . eq pureModName('_*`(_`)[T, T']) = pureModName(T) . eq pureModName('_+_[T, T']) = pureModName(T) . eq pureModName('TUPLE[T]) = pureModName(T) . crl [timedExecution] : < O : TIMEDDATABASE | db : DB, input : (F[TL]), output : QIL, default : ME, timedData : TIMEDDATA, ATTS > => < O : TIMEDDATABASE | db : DB, input : nilTermList, output : procTimedCommand(F[TL], ME, DB, getTickMode(TIMEDDATA)), default : ME, timedData : TIMEDDATA, ATTS > if F == 'trew_with`no`time`limit`. or F == 'trew_in`time`<_. or F == 'trew_in`time`<=_. or F == 'tfrew_with`no`time`limit`. or F == 'tfrew_in`time`<_. or F == 'tfrew_in`time`<=_. or F == 'tsearch_=>1_with`no`time`limit`. or F == 'tsearch_=>*_with`no`time`limit`. or F == 'tsearch_=>+_with`no`time`limit`. or F == 'tsearch_=>!_with`no`time`limit`. or F == 'tsearch_=>1_in`time`<_. or F == 'tsearch_=>*_in`time`<_. or F == 'tsearch_=>!_in`time`<_. or F == 'tsearch_=>+_in`time`<_. or F == 'tsearch_=>1_in`time`<=_. or F == 'tsearch_=>*_in`time`<=_. or F == 'tsearch_=>!_in`time`<=_. or F == 'tsearch_=>+_in`time`<=_. or F == 'tsearch_=>1_in`time`>_. or F == 'tsearch_=>*_in`time`>_. or F == 'tsearch_=>!_in`time`>_. or F == 'tsearch_=>+_in`time`>_. or F == 'tsearch_=>1_in`time`>=_. or F == 'tsearch_=>*_in`time`>=_. or F == 'tsearch_=>!_in`time`>=_. or F == 'tsearch_=>+_in`time`>=_. or F == 'tsearch_=>1_in`time-interval`between__and__. or F == 'tsearch_=>*_in`time-interval`between__and__. or F == 'tsearch_=>!_in`time-interval`between__and__. or F == 'tsearch_=>+_in`time-interval`between__and__. or F == 'utsearch_=>1_. or F == 'utsearch_=>+_. or F == 'utsearch_=>*_. or F == 'utsearch_=>!_. or F == 'find`earliest_=>*_. or F == 'find`latest_=>*_with`no`time`limit`. or F == 'find`latest_=>*_in`time`<_. or F == 'find`latest_=>*_in`time`<=_. or F == 'check_|=`<>_with`no`time`limit`. or F == 'check_|=`<>_in`time`<_. or F == 'check_|=`<>_in`time`<=_. or F == 'check_|=_until_with`no`time`limit`. or F == 'check_|=_until_in`time`<_. or F == 'check_|=_until_in`time`<=_. or F == 'check_|=_untilStable_with`no`time`limit`. or F == 'check_|=_untilStable_in`time`<_. or F == 'check_|=_untilStable_in`time`<=_. or F == 'mc_|=u_. or F == 'mc_|=t_with`no`time`limit`. or F == 'mc_|=t_in`time`<_. or F == 'mc_|=t_in`time`<=_. . *** Setting of tick modes: rl [defMode] : < O : TIMEDDATABASE | db : DB, input : ('set`tick`def_.[T]), output : nil, timedData : TIMEDDATA, ATTS > => < O : TIMEDDATABASE | db : DB, input : nilTermList, output : ('\n '\c 'Tick 'mode 'set 'to 'default 'mode '\o '\n), timedData : setTickMode(TIMEDDATA, def(T)), ATTS > . rl [detMode] : < O : TIMEDDATABASE | db : DB, input : ('set`tick`det`..@Command@), output : nil, timedData : TIMEDDATA, ATTS > => < O : TIMEDDATABASE | db : DB, input : nilTermList, output : ('\n '\c 'Tick 'mode 'set 'back 'to 'deterministic 'mode '\o '\n), timedData : setTickMode(TIMEDDATA, det), ATTS > . rl [maxMode] : < O : TIMEDDATABASE | db : DB, input : ('set`tick`max`..@Command@), output : nil, timedData : TIMEDDATA, ATTS > => < O : TIMEDDATABASE | db : DB, input : nilTermList, output : ('\n '\c 'Tick 'mode 'set 'to 'maximal 'time 'increase 'mode '\o '\n), timedData : setTickMode(TIMEDDATA, max), ATTS > . rl [maxDefMode] : < O : TIMEDDATABASE | db : DB, input : ('set`tick`max`def_.[T]), output : nil, timedData : TIMEDDATA, ATTS > => < O : TIMEDDATABASE | db : DB, input : nilTermList, output : ('\n '\c 'Tick 'mode 'set 'to 'maximal 'time 'increase 'mode 'with 'default 'for 'INF '\o '\n), timedData : setTickMode(TIMEDDATA, maxDef(T)), ATTS > . rl [getMode] : < O : TIMEDDATABASE | input : ('get`tick`mode`..@Command@), output : nil, timedData : TIMEDDATA, ATTS > => < O : TIMEDDATABASE | input : nilTermList, output : ('\n '\c 'Tick 'mode 'is printModeBubble(getTickMode(TIMEDDATA)) '\o '\n), timedData : TIMEDDATA, ATTS > . rl [showMode] : < O : TIMEDDATABASE | input : ('show`tick`mode`..@Command@), output : nil, timedData : TIMEDDATA, ATTS > => < O : TIMEDDATABASE | input : nilTermList, output : ('\n '\c 'Tick 'mode 'is printModeBubble(getTickMode(TIMEDDATA)) '\o '\n), timedData : TIMEDDATA, ATTS > . op printModeBubble : TickMode -> QidList . eq printModeBubble(max) = 'max . eq printModeBubble(det) = 'deterministic . eq printModeBubble(maxDef('bubble[T])) = 'maximal 'time 'increase 'with 'default 'value downQidList(T) . eq printModeBubble(def('bubble[T])) = 'default 'time 'increase 'with 'default 'value downQidList(T) . rl [help] : < O : DATABASE | input : ('help`..@Command@), output : nil, ATTS > => < O : DATABASE | input : nilTermList, output : help("help"), ATTS > . rl [help] : < O : DATABASE | input : ('help_.['token[Q]]), output : nil, ATTS > => < O : DATABASE | input : nilTermList, output : help(string(downQid(Q))), ATTS > . rl [help] : < O : DATABASE | input : ('man_.['token[Q]]), output : nil, ATTS > => < O : DATABASE | input : nilTermList, output : help(string(downQid(Q))), ATTS > . *** We parse for grammatical correctness wrt. TIMED-GRAMMAR, *** but most command are only interpreted after some timed *** theory or module has been introduced! Therefore, in what follows, *** we provide these error messages: crl [timedCommandInDatabaseMode] : < O : DATABASE | input : C:Constant, output : nil, ATTS > => < O : DATABASE | input : nilTermList, output : ('\n '\r 'Error: '\c 'Timed 'command 'cannot 'be 'used 'before 'timed 'module 'or 'timed 'theory 'has 'been 'introduced. '\o '\n), ATTS > if not (DATABASE :: TimedDatabaseClass) /\ C:Constant == 'get`tick`mode`..@Command@ or C:Constant == 'set`tick`max`..@Command@ or C:Constant == 'set`tick`det`..@Command@ or C:Constant == 'show`tick`mode`..@Command@ or C:Constant == 'show`timed`modules`..@Command@ . crl [timedExecution] : < O : DATABASE | db : DB, input : (F[TL]), output : nil, default : ME, ATTS > => < O : DATABASE | db : DB, input : nilTermList, output : ('\n '\r 'Error: '\c 'Timed 'command 'cannot 'be 'used 'before 'timed 'module 'or 'timed 'theory 'has 'been 'introduced. '\o '\n), default : ME, ATTS > if not (DATABASE :: TimedDatabaseClass) /\ F == 'trew_with`no`time`limit`. or F == 'trew_in`time`<_. or F == 'trew_in`time`<=_. or F == 'tfrew_with`no`time`limit`. or F == 'tfrew_in`time`<_. or F == 'tfrew_in`time`<=_. or F == 'tsearch_=>1_with`no`time`limit`. or F == 'tsearch_=>*_with`no`time`limit`. or F == 'tsearch_=>+_with`no`time`limit`. or F == 'tsearch_=>!_with`no`time`limit`. or F == 'tsearch_=>1_in`time`<_. or F == 'tsearch_=>*_in`time`<_. or F == 'tsearch_=>!_in`time`<_. or F == 'tsearch_=>+_in`time`<_. or F == 'tsearch_=>1_in`time`<=_. or F == 'tsearch_=>*_in`time`<=_. or F == 'tsearch_=>!_in`time`<=_. or F == 'tsearch_=>+_in`time`<=_. or F == 'tsearch_=>1_in`time`>_. or F == 'tsearch_=>*_in`time`>_. or F == 'tsearch_=>!_in`time`>_. or F == 'tsearch_=>+_in`time`>_. or F == 'tsearch_=>1_in`time`>=_. or F == 'tsearch_=>*_in`time`>=_. or F == 'tsearch_=>!_in`time`>=_. or F == 'tsearch_=>+_in`time`>=_. or F == 'tsearch_=>1_in`time-interval`between__and__. or F == 'tsearch_=>*_in`time-interval`between__and__. or F == 'tsearch_=>!_in`time-interval`between__and__. or F == 'tsearch_=>+_in`time-interval`between__and__. or F == 'utsearch_=>1_. or F == 'utsearch_=>+_. or F == 'utsearch_=>*_. or F == 'utsearch_=>!_. or F == 'find`earliest_=>*_. or F == 'find`latest_=>*_with`no`time`limit`. or F == 'find`latest_=>*_in`time`<_. or F == 'find`latest_=>*_in`time`<=_. or F == 'check_|=`<>_with`no`time`limit`. or F == 'check_|=`<>_in`time`<_. or F == 'check_|=`<>_in`time`<=_. or F == 'check_|=_until_with`no`time`limit`. or F == 'check_|=_until_in`time`<_. or F == 'check_|=_until_in`time`<=_. or F == 'check_|=_untilStable_with`no`time`limit`. or F == 'check_|=_untilStable_in`time`<_. or F == 'check_|=_untilStable_in`time`<=_. or F == 'mc_|=u_. or F == 'mc_|=t_with`no`time`limit`. or F == 'mc_|=t_in`time`<_. or F == 'mc_|=t_in`time`<=_. or F == 'set`tick`max`def_. or F == 'set`tick`def_. . endm *** ************************************************************ *** This is Duran's FULL-MAUDE module, with slight modifications *** to handle also future extensions to real-time systems. *** The idea is that until a real-time module/command *** has been introduced, we should do the FULL-MAUDE stuff *** until we first get a timed module. How do we know that *** we are in the timed world? *** We have as particular subclass TIMEDDATABASE of *** DATABASE, and whenever we read a timed module, we enter *** that class ... *** ************************************************************ mod REAL-TIME-MAUDE is pr META-RTM-SIGN . pr TIMED-DATABASE-HANDLING . inc LOOP-MODE . pr BANNER . --- pr PRINT-SYNTAX-ERROR . --- State for LOOP mode: subsort Object < State . op o : -> Oid . op init : -> System . var Atts : AttributeSet . var X@Database : DatabaseClass . var O : Oid . var DB : Database . var ME : Header . vars QIL QIL' QIL'' : QidList . var TL : TermList . var N : Nat . vars RP RP' : ResultPair . rl [init] : init => [nil, < o : Database | db : initialDatabase, input : nilTermList, output : nil, default : 'CONVERSION >, ('\n '\t '\s '\s '\s '\s '\s string2qidList(banner) '\n '\n '\t '\s '\! '\m 'Real-Time 'Maude '2.2 '\o '\c 'extension 'October '6 '`, '\s '2006 '\o '\n)] . crl [in] : [QIL, < O : X@Database | db : DB, input : nilTermList, output : nil, default : ME, Atts >, QIL'] => [nil, < O : X@Database | db : DB, input : getTerm(metaParse(TIMED-GRAMMAR, QIL, '@Input@)), output : nil, default : ME, Atts >, QIL'] if QIL =/= nil /\ metaParse(TIMED-GRAMMAR, QIL, '@Input@) : ResultPair . crl [in] : [QIL, < O : X@Database | db : DB, input : nilTermList, output : nil, default : ME, Atts >, QIL'] => [nil, < O : X@Database | db : DB, input : nilTermList, output : ('\r 'Warning: printSyntaxError(metaParse(TIMED-GRAMMAR, QIL, '@Input@), QIL) '\n '\r 'Error: '\o 'No 'parse 'for 'input. '\n), default : ME, Atts >, QIL'] if QIL =/= nil /\ noParse(N) := metaParse(TIMED-GRAMMAR, QIL, '@Input@) . crl [in] : [QIL, < O : X@Database | db : DB, input : nilTermList, output : nil, default : ME, Atts >, QIL'] => [nil, < O : X@Database | db : DB, input : nilTermList, output : ('\r 'Error: 'Ambiguous 'input. '\n), default : ME, Atts >, QIL'] if QIL =/= nil /\ ambiguity(RP, RP') := metaParse(TIMED-GRAMMAR, QIL, '@Input@) . crl [out] : [QIL, < O : X@Database | db : DB, input : TL, output : QIL', default : ME, Atts >, QIL''] => [QIL, < O : X@Database | db : DB, input : TL, output : nil, default : ME, Atts >, (QIL' QIL'')] if QIL' =/= nil . endm ******************************************************************************* loop init . trace exclude REAL-TIME-MAUDE . set show loop stats on . set show loop timing on . set show advisories on .