-- -- Copyright 2014 Alessandro Gerlinger Romero -- -- This file is part of Hybrid fUML. -- -- Hybrid fUML 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 3 of the License, or -- (at your option) any later version. -- -- Hybrid fUML 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 Hybrid fUML. If not, see . -- ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- APPROACH -- operation is a Rule -- attribute is a function -- elements needed are mapped as is -- RULES DEFINITION ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- CLASS FUML_Semantics_Loci_LociL1_Locus -- -- defined by symmetric relation, otherwise it was not possible because it would always cause inconsistent updates in the ASM -- function_Locus_extensionalValues :: FUML_Semantics_Loci_LociL1_Locus -> {FUML_Semantics_Classes_Kernel_Value} function_Locus_extensionalValues l = mkSet $ filter (\v -> (function_Value_ExtensionalValue_locus v) == l ) $ expr2list $ dom function_Value_ExtensionalValue_locus -- -- operatio_Locus_add :: FUML_Semantics_Loci_LociL1_Locus -> FUML_Semantics_Classes_Kernel_Value -> Rule() operatio_Locus_add l v = function_Value_ExtensionalValue_locus(v) := l operatio_Locus_remove :: FUML_Semantics_Loci_LociL1_Locus -> FUML_Semantics_Classes_Kernel_Value -> Rule() operatio_Locus_remove l v = function_Value_ExtensionalValue_locus(v) := FUML_Semantics_Loci_LociL1_LocusEmpty operatio_Locus_instantiate :: FUML_Semantics_Loci_LociL1_Locus -> FUML_Syntax_Classes_Kernel_Classifier -> Rule FUML_Semantics_Classes_Kernel_Value operatio_Locus_instantiate l cl = let ct = function_Classifier_type cl in if ct == FUML_Syntax_Activities_IntermediateActivities_Activity || ct == FUML_Syntax_Classes_Kernel_Class then let vt = if ct == FUML_Syntax_Activities_IntermediateActivities_Activity then FUML_Semantics_Activities_IntermediateActivities_ActivityExecution else FUML_Semantics_Classes_Kernel_Object in do nv <- (rule_FUML_Semantics_Classes_Kernel_Value_create vt) function_Value_Object_types(nv) := {cl} operatio_Locus_add l nv result(nv) else do result(FUML_Semantics_Classes_Kernel_ValueEmpty) ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- CLASS FUML_Semantics_Loci_LociL1_ExecutionFactory operatio_ExecutionFactory_createExecution :: FUML_Semantics_Loci_LociL1_ExecutionFactory -> FUML_Syntax_Classes_Kernel_Classifier -> FUML_Semantics_Classes_Kernel_Value -> Rule FUML_Semantics_Classes_Kernel_Value operatio_ExecutionFactory_createExecution f cl c = let l = function_ExecutionFactory_locus f in let ct = function_Classifier_type cl in if ct == FUML_Syntax_Activities_IntermediateActivities_Activity then do nv <- (rule_FUML_Semantics_Classes_Kernel_Value_create FUML_Semantics_Activities_IntermediateActivities_ActivityExecution) function_Value_Object_types(nv) := {cl} function_Value_Execution_context(nv) := c operatio_Locus_add l nv result(nv) else do obe <- (operatio_ExecutionFactory_instantiateOpaqueBehaviorExecution f cl) result(obe) operatio_ExecutionFactory_addPrimitiveBehaviorPrototype :: FUML_Semantics_Loci_LociL1_ExecutionFactory -> FUML_Semantics_Classes_Kernel_Value -> Rule() operatio_ExecutionFactory_addPrimitiveBehaviorPrototype f v = function_ExecutionFactory_primitiveBehaviorPrototypes(f):= function_ExecutionFactory_primitiveBehaviorPrototypes(f) `union` {v} operatio_ExecutionFactory_addBuiltInType :: FUML_Semantics_Loci_LociL1_ExecutionFactory -> FUML_Syntax_Classes_Kernel_Classifier -> Rule() operatio_ExecutionFactory_addBuiltInType f c = function_ExecutionFactory_builtInTypes(f) := function_ExecutionFactory_builtInTypes(f) `union` {c} operatio_ExecutionFactory_instantiateOpaqueBehaviorExecution :: FUML_Semantics_Loci_LociL1_ExecutionFactory -> FUML_Syntax_Classes_Kernel_Classifier -> Rule FUML_Semantics_Classes_Kernel_Value operatio_ExecutionFactory_instantiateOpaqueBehaviorExecution f c = let vs = filter (\v -> (function_fUML_oneClassifierType v) == c) (expr2list(function_ExecutionFactory_primitiveBehaviorPrototypes f)) in let v = head vs in if length vs == 1 then do nv <- operatio_Value_copy v result(nv) else result(FUML_Semantics_Classes_Kernel_ValueEmpty) ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- CLASS FUML_Semantics_Loci_LociL1_Executor operatio_Executor_evaluate :: FUML_Semantics_Loci_LociL1_Executor -> FUML_Syntax_Classes_Kernel_ValueSpecification -> Rule FUML_Semantics_Classes_Kernel_Value operatio_Executor_evaluate e vs = case function_ValueSpecification_type(vs) of FUML_Syntax_Classes_Kernel_LiteralInteger -> do nv <- (rule_FUML_Semantics_Classes_Kernel_Value_create FUML_Semantics_Classes_Kernel_IntegerValue) function_Value_PrimitiveValue_type(nv) := integer function_Value_IntegerValue_value(nv):= function_ValueSpecification_LiteralInteger_value vs result(nv) FUML_Syntax_Classes_Kernel_LiteralBoolean -> do nv <- (rule_FUML_Semantics_Classes_Kernel_Value_create FUML_Semantics_Classes_Kernel_BooleanValue) function_Value_PrimitiveValue_type(nv) := boolean function_Value_BooleanValue_value(nv):= function_ValueSpecification_LiteralBoolean_value vs result(nv) FUML_Syntax_Classes_Kernel_LiteralReal -> do nv <- (rule_FUML_Semantics_Classes_Kernel_Value_create FUML_Semantics_Classes_Kernel_RealValue) function_Value_PrimitiveValue_type(nv) := real function_Value_RealValue_value(nv):= function_ValueSpecification_LiteralReal_value vs result(nv) FUML_Syntax_Classes_Kernel_LiteralNull -> result(FUML_Semantics_Classes_Kernel_ValueEmpty) FUML_Syntax_Classes_Kernel_InstanceValue -> let is = function_ValueSpecification_InstanceValue_instance vs in let cl = one $ function_InstanceSpecification_classifier is in let vt = if function_Classifier_type cl == FUML_Syntax_CommonBehaviors_Communications_Signal then FUML_Semantics_Classes_Kernel_DataValue else FUML_Semantics_CommonBehaviors_Communications_SignalInstance in do -- new value nv <- (rule_FUML_Semantics_Classes_Kernel_Value_create vt) case vt of FUML_Semantics_Classes_Kernel_DataValue -> function_Value_DataValue_type(nv) := cl FUML_Semantics_CommonBehaviors_Communications_SignalInstance -> function_Value_SignalInstance_type(nv) := cl _ -> error("operatio_Executor_evaluate - invalid classiifer type") -- VERY IMPORTANT -- IT MUST USE EVALUATION OF RULES IN SEQUENCE due to the fact of concurrent change in a function with domain object if card (function_InstanceSpecification_slot is) > 0 then foldl1 (seq) $ (map (\s -> do nvf <- operatio_Executor_evaluate e (one $ function_Slot_value s) -- for all feature values add to new object a new one -- sequentially due to update in the same location rule_fUML_addStructuralFeatureStringWithClassifier cl nv (function_Feature_NamedElement_name $ function_Slot_definingFeature s) nvf ) (expr2list (function_InstanceSpecification_slot is))) else skip result(nv) _ -> error("operatio_Executor_evaluate - unsupported valuespecification " ++ show vs) ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- CLASS FUML_Semantics_Classes_Kernel_Value -- -- copy a value to allow modification -- IMPORTANT: consider only featured values; must not be used for primitive types operatio_Value_copy :: FUML_Semantics_Classes_Kernel_Value -> Rule FUML_Semantics_Classes_Kernel_Value operatio_Value_copy o = let vt = function_Value_type o in let cl = (function_fUML_oneClassifierType o) in if o /= FUML_Semantics_Classes_Kernel_ValueEmpty && cl /= FUML_Syntax_Classes_Kernel_ClassifierEmpty && function_Classifier_type(cl) /= FUML_Syntax_Classes_Kernel_PrimitiveType then -- allowing copy of whatever object -- && (vt == FUML_Semantics_CommonBehaviors_Communications_SignalInstance || vt == FUML_Semantics_Classes_Kernel_DataValue ) then do -- new value onew <- (rule_FUML_Semantics_Classes_Kernel_Value_create vt) case vt of FUML_Semantics_Classes_Kernel_DataValue -> function_Value_DataValue_type(onew) := cl FUML_Semantics_CommonBehaviors_Communications_SignalInstance -> function_Value_SignalInstance_type(onew) := cl _ -> function_Value_Object_types(onew) := {cl} -- VERY IMPORTANT -- IT MUST USE EVALUATION OF RULES IN SEQUENCE due to the fact of concurrent change in a function with domain object if card (function_Value_CompoundValue_featureValues o) > 0 then foldl1 (seq) $ (map (\fv -> do -- for all feature values add to new object a new one -- sequentially due to update in the same location rule_fUML_addStructuralFeature onew (function_FeatureValue_feature fv) (function_fUML_readStructuralFeature o (function_FeatureValue_feature fv)) ) (expr2list (function_Value_CompoundValue_featureValues o))) else skip result(onew) else result(FUML_Semantics_Classes_Kernel_ValueEmpty) -- -- remove object and also data values operatio_Value_Object_destroy :: FUML_Semantics_Classes_Kernel_Value -> Rule() operatio_Value_Object_destroy o = do -- removing extensional value operatio_Locus_remove (function_Value_ExtensionalValue_locus o) o -- removing type function_Value_Object_types(o):= {} -- removing parameters and context function_Value_Execution_context(o) := FUML_Semantics_Classes_Kernel_ValueEmpty function_Value_Execution_parameterValues(o) := {} forall pv <- (expr2list (function_Value_Execution_parameterValues o)) do function_ParameterValue_parameter(pv):=FUML_Syntax_Classes_Kernel_ParameterEmpty function_ParameterValue_values(pv):={} -- removing compoundvalue rule_fUML_Value_CompoundValue_destroy o -- removing activity execution related elements if (dom function_fUML_Agents) `intersect` {o} /= {} then do -- -- CLEARING -- -- agent -- function_fUML_Agents(o):= rule_fUML_AgentEmpty -- terminated function_fUML_Agents_mode(o) := FUML_Status_Undef -- parent function_fUML_Agents_parent(o):= FUML_Semantics_Classes_Kernel_ValueEmpty -- causality analysis support function_fUML_Agents_causalAnalysis(o):=(0, [(FUML_Semantics_Classes_Kernel_ValueEmpty, FUML_Syntax_Activities_IntermediateActivities_ActivityNodeEmpty)]) -- -- token flow -- -- no running node forall n <- (expr2list an) do function_ActivityNodeActivation_isRunning(o,n) := False -- no tokens forall n <- (expr2list allCanHaveToken) do function_ActivityNodeActivation_heldTokens(o,n) := {} forall t <- expr2list(function_ActivityNodeActivation_heldTokens(o,n)) do function_Token_ObjectToken_value(t) := FUML_Semantics_Classes_Kernel_ValueEmpty -- no offers forall n <- (expr2list en) do function_ActivityEdgeInstance_offers(o,n) := {} forall off <- expr2list(function_ActivityEdgeInstance_offers(o,n)) do function_Offer_offeredTokens(off) := {} else skip where cl = function_fUML_oneClassifierType o an = function_Activity_node cl en = function_Activity_edge cl alon = bigUnion (mkSet (map function_ActivityNode_Action_output (expr2list an))) alin = bigUnion (mkSet (map function_ActivityNode_Action_input (expr2list an))) allCanHaveToken = an `union` alon `union` alin -- -- compare two values -- removed the rule behavior because there is no change operatio_Value_equals :: FUML_Semantics_Classes_Kernel_Value -> FUML_Semantics_Classes_Kernel_Value -> Bool operatio_Value_equals v1 v2 | v1 == FUML_Semantics_Classes_Kernel_ValueEmpty && v2 == FUML_Semantics_Classes_Kernel_ValueEmpty = True | v1 == FUML_Semantics_Classes_Kernel_ValueEmpty && v2 /= FUML_Semantics_Classes_Kernel_ValueEmpty = False | v1 /= FUML_Semantics_Classes_Kernel_ValueEmpty && v2 == FUML_Semantics_Classes_Kernel_ValueEmpty = False | otherwise = function_Value_type v1 == function_Value_type v2 && case (function_Value_type v1) of FUML_Semantics_Classes_Kernel_IntegerValue -> function_Value_IntegerValue_value v1 == function_Value_IntegerValue_value v2 FUML_Semantics_Classes_Kernel_RealValue -> function_Value_RealValue_value v1 == function_Value_RealValue_value v2 FUML_Semantics_Classes_Kernel_BooleanValue -> function_Value_BooleanValue_value v1 == function_Value_BooleanValue_value v2 FUML_Semantics_Classes_Kernel_UnlimitedNaturalValue -> function_Value_UnlimitedNaturalValue_value v1 == function_Value_UnlimitedNaturalValue_value v2 FUML_Semantics_Classes_Kernel_StringValue -> function_Value_StringValue_value v1 == function_Value_StringValue_value v2 FUML_Semantics_Classes_Kernel_Reference -> function_Value_Reference_referent v1 == function_Value_Reference_referent v2 FUML_Semantics_CommonBehaviors_Communications_SignalInstance-> function_Value_SignalInstance_type v1 == function_Value_SignalInstance_type v2 && valeq v1 v2 FUML_Semantics_Classes_Kernel_DataValue -> function_Value_DataValue_type v1 == function_Value_DataValue_type v2 && valeq v1 v2 FUML_Semantics_Classes_Kernel_Object -> function_Value_Object_types v1 == function_Value_Object_types v2 && valeq v1 v2 && function_Value_Execution_context v1 == function_Value_Execution_context v2 _ -> error("operatio_Value_equals - Not defined for the type. " ++ show v1) where retTupleFV v = [(function_FeatureValue_feature fv, function_FeatureValue_values fv, function_FeatureValue_position fv)|fv <- expr2list (function_Value_CompoundValue_featureValues v) ] lvaleq vv = not $ elem False $ map(\(vv1, vv2) -> operatio_Value_equals vv1 vv2) vv sameSize v1 v2 = length(retTupleFV v1) == length( retTupleFV v2) -- check if it has the same number of features valeq v1 v2 = sameSize v1 v2 && length (filter (\(f1,v1,p1) -> -- check if each feature of v1 has a corresponding feature in v2 length (filter (\(f2,v2,p2) -> f1 == f2 && (lvaleq (zip v1 v2)) && p1 == p2) (retTupleFV v2)) == 1 ) (retTupleFV v1)) == length (retTupleFV v1) ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- SUPPORT RULES -- -- remove data value rule_fUML_Value_CompoundValue_destroy :: FUML_Semantics_Classes_Kernel_Value -> Rule() rule_fUML_Value_CompoundValue_destroy o = do -- removing type function_Value_DataValue_type(o) := FUML_Syntax_Classes_Kernel_ClassifierEmpty function_Value_SignalInstance_type(o) := FUML_Syntax_Classes_Kernel_ClassifierEmpty -- removing features function_Value_CompoundValue_featureValues(o) := {} -- removing feature value forall fv <- (expr2list (function_Value_CompoundValue_featureValues o)) do function_FeatureValue_feature(fv) := FUML_Syntax_Classes_Kernel_FeatureEmpty function_FeatureValue_values(fv) := [] function_FeatureValue_position(fv) := 0 -- -- remove data value rule_fUML_out :: String -> Rule() rule_fUML_out str = function_fUML_output(show(head $ newIntegers 1)):=str ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- SUPPORT FUNCTIONS function_fUML_locus :: FUML_Semantics_Loci_LociL1_Locus function_fUML_locus = one $ dom function_Locus_executor -- -- HELPER FUNCTIONS -- function_fUML_output :: Dynamic (String -> String) function_fUML_output = initAssocsStdout False "output"