From 0211494494aa04a54c99add12ca96e830e566bae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=BCrgen=20Doser?= Date: Fri, 28 Oct 2005 14:39:09 +0000 Subject: [PATCH] rudimentary support for parsing ArgoUML 0.19.7 activity diagrams into rep_statemachines. Needs to be cleaned up and consolidated with Poseidon support (which should still work however, as far as it worked before) git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@3263 3260e6d1-4efc-4170-b0a7-36055960796d --- src/ROOT.ML | 18 +- src/rep.sig | 3 - src/rep.sml | 7 +- src/rep_state_machines.sig | 2 +- src/rep_state_machines.sml | 2 +- src/xmi.sml | 3 +- src/xmi2rep.sml | 9 +- src/xmi_core.sml | 136 +-------- src/xmi_datatypes.sml | 104 +++++++ src/xmi_extension_mechanisms.sml | 77 +++++ src/xmi_state_machines.sml | 4 +- src/xml2xmi.sml | 466 ++++++++++++++++--------------- 12 files changed, 456 insertions(+), 375 deletions(-) create mode 100644 src/xmi_datatypes.sml create mode 100644 src/xmi_extension_mechanisms.sml diff --git a/src/ROOT.ML b/src/ROOT.ML index 7d8990c..19da799 100644 --- a/src/ROOT.ML +++ b/src/ROOT.ML @@ -49,9 +49,11 @@ OS.FileSys.chDir "../../../src"; (although the supported Poseidon is apparantly based on Version 1.4 or something ...). *) use "xmi_ocl.sml"; -use "xmi_core.sml"; +use "xmi_datatypes.sml"; +use "xmi_extension_mechanisms.sml"; use "xmi_state_machines.sml"; use "xmi_activity_graphs.sml"; +use "xmi_core.sml"; use "xmi.sml"; @@ -70,16 +72,17 @@ use "rep_activity_graphs.sig"; use "rep_activity_graphs.sml"; use "rep_core.sig"; use "rep_core.sml"; -use "rep_secureuml.sig"; -use "rep_secureuml.sml"; +(* use "rep_secureuml.sig"; *) +(* use "rep_secureuml.sml"; *) use "rep.sig"; use "rep.sml"; + (* support functions *) -use "ocl2string.sml"; +(* use "ocl2string.sml";*) (* ****************************************************** *) (* Main Conversion Processes *) @@ -90,3 +93,10 @@ use "xml2xmi.sml"; (* conversion XML to XMI *); use "xmi_idtable.sml"; (* auxiliary table to store and dereference xmi.id's *) use "xmi2rep.sml"; (* conversion XMI to Rep *) + +(* use "mds.sig"; +use "component_uml.sml"; +use "secure_uml.sml"; +use "rep_secure.sig"; +use "rep_secure.sml"; +*) diff --git a/src/rep.sig b/src/rep.sig index 8187763..423771e 100644 --- a/src/rep.sig +++ b/src/rep.sig @@ -27,8 +27,5 @@ sig include REP_CORE include REP_ACTIVITY_GRAPH -include REP_SECUREUML - -type Model end diff --git a/src/rep.sml b/src/rep.sml index 3aca8e2..016decd 100644 --- a/src/rep.sml +++ b/src/rep.sml @@ -25,10 +25,5 @@ structure Rep : REP = struct -open Rep_Core Rep_StateMachine Rep_ActivityGraph Rep_SecureUML -type Model = { classifiers: Classifier list, - permissions: Permission list, - role_inheritance: RoleHierarchy - } - +open Rep_Core Rep_StateMachine Rep_ActivityGraph end diff --git a/src/rep_state_machines.sig b/src/rep_state_machines.sig index 735d4e9..caf81d2 100644 --- a/src/rep_state_machines.sig +++ b/src/rep_state_machines.sig @@ -51,7 +51,7 @@ datatype Event = SignalEvent of Parameter list (* | ChangeEvent of Parameter list *) -datatype Transition = T_ml of {source : StateVertex_Id, +datatype Transition = T_mk of {source : StateVertex_Id, target : StateVertex_Id, guard : Guard option, trigger : Event option, diff --git a/src/rep_state_machines.sml b/src/rep_state_machines.sml index 9a41956..c99b300 100644 --- a/src/rep_state_machines.sml +++ b/src/rep_state_machines.sml @@ -51,7 +51,7 @@ datatype Event = SignalEvent of Parameter list (* | ChangeEvent of Parameter list *) -datatype Transition = T_ml of {source : StateVertex_Id, +datatype Transition = T_mk of {source : StateVertex_Id, target : StateVertex_Id, guard : Guard option, trigger : Event option, diff --git a/src/xmi.sml b/src/xmi.sml index d9faea6..5598b9a 100644 --- a/src/xmi.sml +++ b/src/xmi.sml @@ -64,7 +64,8 @@ datatype Package = Package of { xmiid : string, dependencies : Dependency list, tag_definitions: TagDefinition list, stereotype : string list, (* idref to stereotype of this package *) - taggedValue : TaggedValue list} + taggedValue : TaggedValue list, + events: Event list} end diff --git a/src/xmi2rep.sml b/src/xmi2rep.sml index 95bda67..c6c9ae8 100644 --- a/src/xmi2rep.sml +++ b/src/xmi2rep.sml @@ -155,12 +155,15 @@ fun transform_aend t ({xmiid,name,ordering,multiplicity,participant_id, val filter_named_aends = List.filter (fn {name=SOME _,...}:XMI.AssociationEnd => true | _ => false) - + +(* FIX *) +fun transform_activitygraph t act = Rep_StateMachine.SM_mk {top = "???????????????????????", transition = nil } + fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf, generalizations,attributes,operations, invariant,stereotype,clientDependency, supplierDependency,taggedValue, - classifierInState}) = + classifierInState,activity_graphs}) = let val parents = map ((find_classifier_type t) o (find_parent t)) generalizations val filtered_parents = filter (fn x => x <> Rep_OclType.OclAny) parents @@ -177,7 +180,7 @@ fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf, ((filter_named_aends (find_aends t xmiid))), stereotypes = map (find_stereotype t) stereotype, interfaces = nil, (* FIX *) - activity_graphs = nil, + activity_graphs = map (transform_activitygraph t) activity_graphs, thyname = NONE} end | transform_classifier t (XMI.AssociationClass {xmiid,name,isActive,visibility, diff --git a/src/xmi_core.sml b/src/xmi_core.sml index e0857f1..d58b9fb 100644 --- a/src/xmi_core.sml +++ b/src/xmi_core.sml @@ -25,124 +25,6 @@ -structure XMI_DataTypes = -(* from UML 1.5 Core Overview: ---------------------------------------------- - * The Data Types package is the subpackage that specifies the different data - * types that are used to define UML. - * - * the following constructs are currently not represented: ArgListsExpression, - * Boolean, BooleanExpression, CallConcurrencyKind, Expression, Geometry, - * Integer, LocationReference, Mapping, MappingExpression, Name, - * ProcedureExpression, PseudostateKind, ScopeKind, String, TimeExpression, - * TypeExpression, UnlimitedInteger - * --------------------------------------------------------------------------*) -struct -open XMI_OCL - -datatype AggregationKind = NoAggregation | Aggregate | Composite - -datatype ScopeKind = InstanceScope | ClassifierScope - -(* from UML 1.5 Core: -------------------------------------------------------- - * ChangeableKind defines an enumeration that denotes how an AttributeLink or - * LinkEnd may be modified. - * --------------------------------------------------------------------------*) -datatype ChangeableKind = Changeable (* No restrictions on modification. *) - | Frozen (* The value may not be changed from the*) - (* source end after the creation and *) - (* initialization of the source object. *) - (* Operations on the other end may *) - (* change a value. *) - | AddOnly (* If the multiplicity is not fixed, *) - (* values may be added at any time from *) - (* the source object, but once created a*) - (* value may not be removed from the *) - (* source end. Operations on the other *) - (* end may change a value. *) - -(* from UML 1.5 Data Types: -------------------------------------------------- - * a Multiplicity [consists of a list of MultiplicityRanges and] defines a - * non-empty set of non-negative integers. - * a MultiplicityRange defines a range of integers. The upper bound of the - * range cannot be below the lower bound. The lower bound must be a - * nonnegative integer. The upper bound must be a nonnegative integer or the - * special value unlimited, which indicates there is no upper bound on the - * range. - * --------------------------------------------------------------------------*) -(* provisionally, we denote the upper bound 'unlimited' by "-1" *) -type Multiplicity = (int * int) list - -datatype OrderingKind = Unordered | Ordered -datatype ParameterDirectionKind = In | Out | Inout | Return - - -(* from UML 1.5 Core: -------------------------------------------------------- - * VisibilityKind defines an enumeration that denotes how the element to which - * it refers is seen outside the enclosing name space. - * --------------------------------------------------------------------------*) -datatype VisibilityKind = public (* Other elements may see and use the target*) - (* element. *) - | private (* Only the source element may see and use *) - (* the target element. *) - | protected (* Descendants of the source element may see *) - (* and use the target element. *) - | package (* Elements declared in the same package as *) - (* the target element may see and use the *) - (* target *) - - -end - - -structure XMI_ExtensionMechanisms = -(* from UML 1.5 Extension Mechanisms Overview:-------------------------------- - * The Extension Mechanisms package is the subpackage that specifies how - * specific UML model elements are customized and extended with new semantics - * by using stereotypes, constraints, tag definitions, and tagged values. - * A coherent set of such extensions, defined for specific purposes, - * constitutes a UML profile. - * --------------------------------------------------------------------------*) -struct -open XMI_DataTypes - -(* from UML 1.5 Extension Mechanisms:----------------------------------------- - * The stereotype concept provides a way of branding (classifying) model - * elements so that they behave in some respects as if they were instances of - * new virtual metamodel constructs. These model elements have the same - * structure (attributes, associations, operations) as similar non-stereotyped - * model elements of the same kind. The stereotype may specify additional - * constraints and tag definitions that apply to model elements. In addition, - * a stereotype may be used to indicate a difference in meaning or usage - * between two model elements with identical structure. - * --------------------------------------------------------------------------*) -type Stereotype = {xmiid: string, - name: string, - (* extendedElement: string list *) - (* definedTag: string list *) - stereotypeConstraint: Constraint option, - baseClass: string option} - -(* from UML 1.5 Extension Mechanisms:----------------------------------------- - * A tag definition specifies the tagged values that can be attached to a kind - * of model element. - * --------------------------------------------------------------------------*) -type TagDefinition = {xmiid: string, - name: string, - multiplicity: Multiplicity} - -(* from UML 1.5 Extension Mechanisms:----------------------------------------- - * A tagged value allows information to be attached to any model element in - * conformance with its tag definition. Although a tagged value, being an - * instance of a kind of ModelElement, automatically inherits the name - * attribute, the name that is actually used in the tagged value is the name - * of the associated tag definition. - * --------------------------------------------------------------------------*) -type TaggedValue = {xmiid: string, - dataValue: string, (* the value of the tag *) - tag_type: string (* xmi.idref to TagDefinition *) - } -end - structure XMI_Core = @@ -171,7 +53,7 @@ structure XMI_Core = * TemplateArgument, TemplateParameter, Usage * --------------------------------------------------------------------------*) struct -open XMI_ExtensionMechanisms +open XMI_ExtensionMechanisms XMI_ActivityGraphs (* UML distinguishes between different kinds of dependencies: *) @@ -221,18 +103,7 @@ type Attribute = { xmiid : string, } -(* from UML 1.5 Core: -------------------------------------------------------- - * A parameter is an unbound variable that can be changed, passed, or - * returned. A parameter may include a name, type, and direction of - * communication. Parameters are used in the specification of operations, - * messages and events, templates, etc. - * not supported: attribute defaultValue - * --------------------------------------------------------------------------*) -type Parameter = { xmiid : string, - name : string, - kind : ParameterDirectionKind, - (* defaultValue : ..., *) - type_id : string (* xmi.idref to type *)} + (* fom UML 1.5 Core: --------------------------------------------------------- * An operation is a service that can be requested from an object to effect @@ -288,7 +159,8 @@ type Class = { xmiid : string, clientDependency: string list, supplierDependency: string list, (* xmi.id's of contained ClassifierInStates: *) - classifierInState: string list } + classifierInState: string list, + activity_graphs: ActivityGraph list} (* from UML 1.5 Core: -------------------------------------------------------- * A data type is a type whose values have no identity (i.e., they are diff --git a/src/xmi_datatypes.sml b/src/xmi_datatypes.sml new file mode 100644 index 0000000..ee1b145 --- /dev/null +++ b/src/xmi_datatypes.sml @@ -0,0 +1,104 @@ +(***************************************************************************** + * su4sml - a SecureUML repository for SML + * + * xmi_datatypes.sml - XMI-UML basic datatypes for the import interface for su4sml + * Copyright (C) 2005 Achim D. Brucker + * Jürgen Doser + * + * This file is part of su4sml. + * + * su4sml 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. + * + * su4sml 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. + ******************************************************************************) + +structure XMI_DataTypes = +(* from UML 1.5 Core Overview: ---------------------------------------------- + * The Data Types package is the subpackage that specifies the different data + * types that are used to define UML. + * + * the following constructs are currently not represented: ArgListsExpression, + * Boolean, BooleanExpression, CallConcurrencyKind, Expression, Geometry, + * Integer, LocationReference, Mapping, MappingExpression, Name, + * ProcedureExpression, PseudostateKind, ScopeKind, String, TimeExpression, + * TypeExpression, UnlimitedInteger + * --------------------------------------------------------------------------*) +struct + +datatype AggregationKind = NoAggregation | Aggregate | Composite + +datatype ScopeKind = InstanceScope | ClassifierScope + +(* from UML 1.5 Core: -------------------------------------------------------- + * ChangeableKind defines an enumeration that denotes how an AttributeLink or + * LinkEnd may be modified. + * --------------------------------------------------------------------------*) +datatype ChangeableKind = Changeable (* No restrictions on modification. *) + | Frozen (* The value may not be changed from the*) + (* source end after the creation and *) + (* initialization of the source object. *) + (* Operations on the other end may *) + (* change a value. *) + | AddOnly (* If the multiplicity is not fixed, *) + (* values may be added at any time from *) + (* the source object, but once created a*) + (* value may not be removed from the *) + (* source end. Operations on the other *) + (* end may change a value. *) + +(* from UML 1.5 Data Types: -------------------------------------------------- + * a Multiplicity [consists of a list of MultiplicityRanges and] defines a + * non-empty set of non-negative integers. + * a MultiplicityRange defines a range of integers. The upper bound of the + * range cannot be below the lower bound. The lower bound must be a + * nonnegative integer. The upper bound must be a nonnegative integer or the + * special value unlimited, which indicates there is no upper bound on the + * range. + * --------------------------------------------------------------------------*) +(* provisionally, we denote the upper bound 'unlimited' by "-1" *) +type Multiplicity = (int * int) list + +datatype OrderingKind = Unordered | Ordered +datatype ParameterDirectionKind = In | Out | Inout | Return + + +(* from UML 1.5 Core: -------------------------------------------------------- + * VisibilityKind defines an enumeration that denotes how the element to which + * it refers is seen outside the enclosing name space. + * --------------------------------------------------------------------------*) +datatype VisibilityKind = public (* Other elements may see and use the target*) + (* element. *) + | private (* Only the source element may see and use *) + (* the target element. *) + | protected (* Descendants of the source element may see *) + (* and use the target element. *) + | package (* Elements declared in the same package as *) + (* the target element may see and use the *) + (* target *) + + +(* from UML 1.5 Core: -------------------------------------------------------- + * A parameter is an unbound variable that can be changed, passed, or + * returned. A parameter may include a name, type, and direction of + * communication. Parameters are used in the specification of operations, + * messages and events, templates, etc. + * not supported: attribute defaultValue + * --------------------------------------------------------------------------*) +type Parameter = { xmiid : string, + name : string, + kind : ParameterDirectionKind, + (* defaultValue : ..., *) + type_id : string (* xmi.idref to type *)} + + +end diff --git a/src/xmi_extension_mechanisms.sml b/src/xmi_extension_mechanisms.sml new file mode 100644 index 0000000..bfb7a91 --- /dev/null +++ b/src/xmi_extension_mechanisms.sml @@ -0,0 +1,77 @@ +(***************************************************************************** + * su4sml - a SecureUML repository for SML + * + * xmi_extensionmechanisms.sml - XMI-UML Extension mechanisms datatypes for + * the import interface for su4sml + * Copyright (C) 2005 Achim D. Brucker + * Jürgen Doser + * + * This file is part of su4sml. + * + * su4sml 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. + * + * su4sml 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. + ******************************************************************************) + + +structure XMI_ExtensionMechanisms = +(* from UML 1.5 Extension Mechanisms Overview:-------------------------------- + * The Extension Mechanisms package is the subpackage that specifies how + * specific UML model elements are customized and extended with new semantics + * by using stereotypes, constraints, tag definitions, and tagged values. + * A coherent set of such extensions, defined for specific purposes, + * constitutes a UML profile. + * --------------------------------------------------------------------------*) +struct +open XMI_DataTypes XMI_OCL + +(* from UML 1.5 Extension Mechanisms:----------------------------------------- + * The stereotype concept provides a way of branding (classifying) model + * elements so that they behave in some respects as if they were instances of + * new virtual metamodel constructs. These model elements have the same + * structure (attributes, associations, operations) as similar non-stereotyped + * model elements of the same kind. The stereotype may specify additional + * constraints and tag definitions that apply to model elements. In addition, + * a stereotype may be used to indicate a difference in meaning or usage + * between two model elements with identical structure. + * --------------------------------------------------------------------------*) +type Stereotype = {xmiid: string, + name: string, + (* extendedElement: string list *) + (* definedTag: string list *) + stereotypeConstraint: Constraint option, + baseClass: string option} + +(* from UML 1.5 Extension Mechanisms:----------------------------------------- + * A tag definition specifies the tagged values that can be attached to a kind + * of model element. + * --------------------------------------------------------------------------*) +type TagDefinition = {xmiid: string, + name: string, + multiplicity: Multiplicity} + +(* from UML 1.5 Extension Mechanisms:----------------------------------------- + * A tagged value allows information to be attached to any model element in + * conformance with its tag definition. Although a tagged value, being an + * instance of a kind of ModelElement, automatically inherits the name + * attribute, the name that is actually used in the tagged value is the name + * of the associated tag definition. + * --------------------------------------------------------------------------*) +type TaggedValue = {xmiid: string, + dataValue: string, (* the value of the tag *) + tag_type: string (* xmi.idref to TagDefinition *) + } +end + + + diff --git a/src/xmi_state_machines.sml b/src/xmi_state_machines.sml index 9a449a1..645acb7 100644 --- a/src/xmi_state_machines.sml +++ b/src/xmi_state_machines.sml @@ -37,8 +37,8 @@ end structure XMI_StateMachines = struct -open XMI_Core XMI_CommonBehavior - +open XMI_ExtensionMechanisms XMI_CommonBehavior +exception IllFormed of string type StateVertex_Id = string type Transition_Id = string diff --git a/src/xml2xmi.sml b/src/xml2xmi.sml index 5f5b8eb..bd3f49d 100644 --- a/src/xml2xmi.sml +++ b/src/xml2xmi.sml @@ -158,6 +158,19 @@ fun getKind atts = | "return" => XMI.Return | _ => raise IllFormed ("in getKind: found unexpected attribute value "^att) end + +fun getPseudoStateKindAttr atts = + let val att = getStringAtt "kind" atts + in (case att of "initial" => XMI.initial + | "deep" => XMI.deep + | "shallow" => XMI.shallow + | "join" => XMI.join + | "fork" => XMI.fork + | "junction" => XMI.junction + | "choice" => XMI.choice + | _ => raise IllFormed ("in getPseudoStateKind: found unexpected attribute value "^att)) + end + fun getRange atts = (getIntAtt "lower" atts, getIntAtt "upper" atts) @@ -166,6 +179,7 @@ fun mkMultiplicity tree = map (getRange o XmlTree.attributes_of) (XmlTree.skip "UML:Multiplicity.range") o hd o (XmlTree.skip "UML:Multiplicity")) tree) + fun mkAssociationEnd tree = let fun f atts trees = { xmiid = getXmiId atts, @@ -515,179 +529,6 @@ fun mkTagDefinition tree = (XmlTree.follow "UML:TagDefinition.multiplicity")) trees } in XmlTree.apply_on "UML:TagDefinition" f tree end - -fun mkClass atts trees - = XMI.Class { xmiid = getXmiId atts, - name = getName atts, - isActive = getBoolAtt "isActive" atts, - visibility = getVisibility atts, - isLeaf = getBoolAtt "isLeaf" atts, - generalizations = (map (getXmiIdref o XmlTree.attributes_of o hd) - (XmlTree.follow_all - "UML:GeneralizableElement.generalization" - trees)), - attributes = (map mkAttribute - ((XmlTree.filter "UML:Attribute") - (XmlTree.follow "UML:Classifier.feature" - trees))), - operations = (map mkOperation - ((XmlTree.filter "UML:Operation") - (XmlTree.follow "UML:Classifier.feature" - trees))), - invariant = (map (getXmiIdref o XmlTree.attributes_of) - (XmlTree.follow "UML:ModelElement.constraint" - trees)), - stereotype = (map (getXmiIdref o XmlTree.attributes_of) - (XmlTree.follow "UML:ModelElement.stereotype" - trees)), - taggedValue = (map mkTaggedValue - (XmlTree.follow "UML:ModelElement.taggedValue" - trees)), - clientDependency = (map (getXmiIdref o XmlTree.attributes_of) - (XmlTree.follow "UML:ModelElement.clientDependency" - trees)), - supplierDependency = (map (getXmiIdref o XmlTree.attributes_of) - (XmlTree.follow "UML:ModelElement.supplierDependency" - trees)), - classifierInState = (map (getXmiId o XmlTree.attributes_of) - (XmlTree.filter "UML:ClassifierInState" - (XmlTree.follow "UML:Namespace.ownedElement" - trees)))} - -fun mkAssociationClass atts trees - = XMI.AssociationClass { xmiid = getXmiId atts, - name = getName atts, - isActive = getBoolAtt "isActive" atts, - visibility = getVisibility atts, - isLeaf = getBoolAtt "isLeaf" atts, - generalizations = (map (getXmiIdref o XmlTree.attributes_of o hd) - (XmlTree.follow_all - "UML:GeneralizableElement.generalization" - trees)), - attributes = (map mkAttribute - ((XmlTree.filter "UML:Attribute") - (XmlTree.follow "UML:Classifier.feature" - trees))), - operations = (map mkOperation - ((XmlTree.filter "UML:Operation") - (XmlTree.follow "UML:Classifier.feature" - trees))), - invariant = (map (getXmiIdref o XmlTree.attributes_of) - (XmlTree.follow "UML:ModelElement.constraint" - trees)), - stereotype = (map (getXmiIdref o XmlTree.attributes_of) - (XmlTree.follow "UML:ModelElement.stereotype" - trees)), - taggedValue = (map mkTaggedValue - (XmlTree.follow "UML:ModelElement.taggedValue" - trees)), - clientDependency = (map (getXmiIdref o XmlTree.attributes_of) - (XmlTree.follow "UML:ModelElement.clientDependency" - trees)), - supplierDependency = (map (getXmiIdref o XmlTree.attributes_of) - (XmlTree.follow "UML:ModelElement.supplierDependency" - trees)), - connection = (map mkAssociationEnd (XmlTree.follow "UML:Association.connection" - trees))} - - -fun mkPrimitive atts trees - = XMI.Primitive { xmiid = getXmiId atts, - name = getName atts, - operations = (map mkOperation - ((XmlTree.filter "UML:Operation") - (XmlTree.follow "UML:Classifier.feature" - trees))), - generalizations = (map (getXmiIdref o XmlTree.attributes_of o hd) - (XmlTree.follow_all - "UML:GeneralizableElement.generalization" - trees)), - invariant = (map (getXmiIdref o XmlTree.attributes_of) - (XmlTree.follow "UML:ModelElement.constraint" - trees)) - } - handle XmlTree.IllFormed msg => raise IllFormed ("in mkPrimitive: "^msg) - -fun mkInterface atts trees - = XMI.Interface { xmiid = getXmiId atts, - name = getName atts, - operations = (map mkOperation - ((XmlTree.filter "UML:Operation") - (XmlTree.follow "UML:Classifier.feature" - trees))), - generalizations = (map (getXmiIdref o XmlTree.attributes_of o hd) - (XmlTree.follow_all - "UML:GeneralizableElement.generalization" - trees)), - invariant = (map (getXmiIdref o XmlTree.attributes_of) - (XmlTree.follow "UML:ModelElement.constraint" - trees)), - clientDependency = (map (getXmiIdref o XmlTree.attributes_of) - (XmlTree.follow "UML:ModelElement.clientDependency" - trees)), - supplierDependency = (map (getXmiIdref o XmlTree.attributes_of) - (XmlTree.follow "UML:ModelElement.supplierDependency" - trees)) - } - handle XmlTree.IllFormed msg => raise IllFormed ("in mkPrimitive: "^msg) - -fun mkEnumeration atts trees - = XMI.Enumeration { xmiid = getXmiId atts, - name = getName atts, - operations = (map mkOperation - ((XmlTree.filter "UML:Operation") - (XmlTree.follow "UML:Classifier.feature" - trees))), - generalizations = (map (getXmiIdref o XmlTree.attributes_of o hd) - (XmlTree.follow_all - "UML:GeneralizableElement.generalization" - trees)), - literals = nil, (* FIX *) - invariant = (map (getXmiIdref o XmlTree.attributes_of) - (XmlTree.follow "UML:ModelElement.constraint" - trees) - )} - handle XmlTree.IllFormed msg => raise IllFormed ("in mkEnumeration: "^msg) - -fun mkVoid atts trees = XMI.Void { xmiid = getXmiId atts, - name = getName atts } - handle XmlTree.IllFormed msg => raise IllFormed ("in mkVoid: "^msg) - - -fun mkGenericCollection atts trees = - { xmiid = getXmiId atts, - name = getName atts, - operations = (map mkOperation - ((XmlTree.filter "UML:Operation") - (XmlTree.follow "UML:Classifier.feature" - trees))), - generalizations = (map (getXmiIdref o XmlTree.attributes_of o hd) - (XmlTree.follow_all - "UML:GeneralizableElement.generalization" - trees)), - elementtype = ((getXmiIdref o XmlTree.attributes_of o hd) - (XmlTree.follow - "OCL.Types.CollectionType.elementType" - trees)) - } - handle XmlTree.IllFormed msg => raise IllFormed ("in mkGenericCollection: "^msg) - - -fun mkCollection atts trees = XMI.Collection (mkGenericCollection atts trees) -fun mkSequence atts trees = XMI.Sequence (mkGenericCollection atts trees) -fun mkSet atts trees = XMI.Set (mkGenericCollection atts trees) -fun mkBag atts trees = XMI.Bag (mkGenericCollection atts trees) -fun mkOrderedSet atts trees = XMI.OrderedSet (mkGenericCollection atts trees) - -fun mkStereotype tree = - let fun f atts trees = { xmiid = getXmiId atts, - name = getName atts, - baseClass = NONE, (*FIX*) - stereotypeConstraint = NONE (*FIX*) - } - in XmlTree.apply_on "UML:Stereotype" f tree - handle XmlTree.IllFormed msg => raise IllFormed ("in mkStereotype: "^msg) - end fun mkStereotypeR tree = let fun f atts trees = getXmiIdref atts @@ -695,39 +536,6 @@ fun mkStereotypeR tree = handle XmlTree.IllFormed msg => raise IllFormed ("in mkStereotype: "^msg) end -fun mkClassifier tree = - let val elem = XmlTree.tagname_of tree - val atts = XmlTree.attributes_of tree - val trees = XmlTree.node_children_of tree - in - case elem of "UML:Class" => mkClass atts trees - | "UML:AssociationClass" => mkAssociationClass atts trees - | "UML:Interface" => mkInterface atts trees - | "UML:DataType" => mkPrimitive atts trees - | "UML:Primitive" => mkPrimitive atts trees - | "UML:Enumeration" => mkEnumeration atts trees - | "UML15OCL.Types.VoidType" => mkVoid atts trees - | "UML15OCL.Types.CollectionType" => mkCollection atts trees - | "UML15OCL.Types.SequenceType" => mkSequence atts trees - | "UML15OCL.Types.SetType" => mkSet atts trees - | "UML15OCL.Types.BagType" => mkBag atts trees - | "UML15OCL.Types.OrderedSetType" => mkOrderedSet atts trees - | _ => raise IllFormed ("in mkClassifier: found unexpected element "^elem) - end - - - -fun mkGeneralization tree = - let fun f atts trees = - { xmiid = getXmiId atts, - child_id = (getXmiIdref o XmlTree.attributes_of o hd o - (XmlTree.follow "UML:Generalization.child")) trees, - parent_id = (getXmiIdref o XmlTree.attributes_of o hd o - (XmlTree.follow "UML:Generalization.parent")) trees } - in XmlTree.apply_on "UML:Generalization" f tree - handle XmlTree.IllFormed msg => raise IllFormed ("in mkGeneralization: "^msg) - end - fun mkProcedure tree = let fun get_AttrL x = (XmlTree.attributes_of o (XmlTree.find "UML:ActionExpression") o XmlTree.node_children_of o (XmlTree.find "UML:Action.script")) x @@ -743,6 +551,7 @@ fun mkProcedure tree = (* POSEIDON specific ! According to UML 1.5, should be: "UML:Method" *) end + fun mkGuard tree = let val getExpr = XmlTree.attributes_of o (XmlTree.find "UML:BooleanExpression") o XmlTree.node_children_of o (XmlTree.find "UML:Guard.expression") @@ -758,8 +567,6 @@ fun mkGuard tree = end - - fun mkTransition tree = let val getGuard = (Option.map (mkGuard o (XmlTree.find "UML:Guard") o @@ -789,19 +596,6 @@ fun mkTransition tree = end -fun getPseudoStateKindAttr atts = - let val att = getStringAtt "kind" atts - in (case att of "initial" => XMI.initial - | "deep" => XMI.deep - | "shallow" => XMI.shallow - | "join" => XMI.join - | "fork" => XMI.fork - | "junction" => XMI.junction - | "choice" => XMI.choice - | _ => raise IllFormed ("in getPseudoStateKind: found unexpected attribute value "^att)) - end - - fun mkState tree = let val elem = XmlTree.tagname_of tree @@ -941,6 +735,9 @@ and mkStateMachine tree = end; + + + fun mkActivityGraph tree = let fun f atts trees = XMI.mk_ActivityGraph {isSpecification = getBoolAtt "isSpecification" atts, @@ -959,6 +756,230 @@ fun mkActivityGraph tree = in XmlTree.apply_on "UML:ActivityGraph" f tree end; + +fun mkClass atts trees + = XMI.Class { xmiid = getXmiId atts, + name = getName atts, + isActive = getBoolAtt "isActive" atts, + visibility = getVisibility atts, + isLeaf = getBoolAtt "isLeaf" atts, + generalizations = (map (getXmiIdref o XmlTree.attributes_of o hd) + (XmlTree.follow_all + "UML:GeneralizableElement.generalization" + trees)), + attributes = (map mkAttribute + ((XmlTree.filter "UML:Attribute") + (XmlTree.follow "UML:Classifier.feature" + trees))), + operations = (map mkOperation + ((XmlTree.filter "UML:Operation") + (XmlTree.follow "UML:Classifier.feature" + trees))), + invariant = (map (getXmiIdref o XmlTree.attributes_of) + (XmlTree.follow "UML:ModelElement.constraint" + trees)), + stereotype = (map (getXmiIdref o XmlTree.attributes_of) + (XmlTree.follow "UML:ModelElement.stereotype" + trees)), + taggedValue = (map mkTaggedValue + (XmlTree.follow "UML:ModelElement.taggedValue" + trees)), + clientDependency = (map (getXmiIdref o XmlTree.attributes_of) + (XmlTree.follow "UML:ModelElement.clientDependency" + trees)), + supplierDependency = (map (getXmiIdref o XmlTree.attributes_of) + (XmlTree.follow "UML:ModelElement.supplierDependency" + trees)), + classifierInState = (map (getXmiId o XmlTree.attributes_of) + (XmlTree.filter "UML:ClassifierInState" + (XmlTree.follow "UML:Namespace.ownedElement" + trees))), + activity_graphs = (map mkActivityGraph (XmlTree.filter "UML:ActivityGraph" + (XmlTree.follow "UML:Namespace.ownedElement" trees))) } + +fun mkAssociationClass atts trees + = XMI.AssociationClass { xmiid = getXmiId atts, + name = getName atts, + isActive = getBoolAtt "isActive" atts, + visibility = getVisibility atts, + isLeaf = getBoolAtt "isLeaf" atts, + generalizations = (map (getXmiIdref o XmlTree.attributes_of o hd) + (XmlTree.follow_all + "UML:GeneralizableElement.generalization" + trees)), + attributes = (map mkAttribute + ((XmlTree.filter "UML:Attribute") + (XmlTree.follow "UML:Classifier.feature" + trees))), + operations = (map mkOperation + ((XmlTree.filter "UML:Operation") + (XmlTree.follow "UML:Classifier.feature" + trees))), + invariant = (map (getXmiIdref o XmlTree.attributes_of) + (XmlTree.follow "UML:ModelElement.constraint" + trees)), + stereotype = (map (getXmiIdref o XmlTree.attributes_of) + (XmlTree.follow "UML:ModelElement.stereotype" + trees)), + taggedValue = (map mkTaggedValue + (XmlTree.follow "UML:ModelElement.taggedValue" + trees)), + clientDependency = (map (getXmiIdref o XmlTree.attributes_of) + (XmlTree.follow "UML:ModelElement.clientDependency" + trees)), + supplierDependency = (map (getXmiIdref o XmlTree.attributes_of) + (XmlTree.follow "UML:ModelElement.supplierDependency" + trees)), + connection = (map mkAssociationEnd (XmlTree.follow "UML:Association.connection" + trees))} + + +fun mkPrimitive atts trees + = XMI.Primitive { xmiid = getXmiId atts, + name = getName atts, + operations = (map mkOperation + ((XmlTree.filter "UML:Operation") + (XmlTree.follow "UML:Classifier.feature" + trees))), + generalizations = (map (getXmiIdref o XmlTree.attributes_of o hd) + (XmlTree.follow_all + "UML:GeneralizableElement.generalization" + trees)), + invariant = (map (getXmiIdref o XmlTree.attributes_of) + (XmlTree.follow "UML:ModelElement.constraint" + trees)) + } + handle XmlTree.IllFormed msg => raise IllFormed ("in mkPrimitive: "^msg) + +fun mkInterface atts trees + = XMI.Interface { xmiid = getXmiId atts, + name = getName atts, + operations = (map mkOperation + ((XmlTree.filter "UML:Operation") + (XmlTree.follow "UML:Classifier.feature" + trees))), + generalizations = (map (getXmiIdref o XmlTree.attributes_of o hd) + (XmlTree.follow_all + "UML:GeneralizableElement.generalization" + trees)), + invariant = (map (getXmiIdref o XmlTree.attributes_of) + (XmlTree.follow "UML:ModelElement.constraint" + trees)), + clientDependency = (map (getXmiIdref o XmlTree.attributes_of) + (XmlTree.follow "UML:ModelElement.clientDependency" + trees)), + supplierDependency = (map (getXmiIdref o XmlTree.attributes_of) + (XmlTree.follow "UML:ModelElement.supplierDependency" + trees)) + } + handle XmlTree.IllFormed msg => raise IllFormed ("in mkPrimitive: "^msg) + +fun mkEnumeration atts trees + = XMI.Enumeration { xmiid = getXmiId atts, + name = getName atts, + operations = (map mkOperation + ((XmlTree.filter "UML:Operation") + (XmlTree.follow "UML:Classifier.feature" + trees))), + generalizations = (map (getXmiIdref o XmlTree.attributes_of o hd) + (XmlTree.follow_all + "UML:GeneralizableElement.generalization" + trees)), + literals = nil, (* FIX *) + invariant = (map (getXmiIdref o XmlTree.attributes_of) + (XmlTree.follow "UML:ModelElement.constraint" + trees) + )} + handle XmlTree.IllFormed msg => raise IllFormed ("in mkEnumeration: "^msg) + +fun mkVoid atts trees = XMI.Void { xmiid = getXmiId atts, + name = getName atts } + handle XmlTree.IllFormed msg => raise IllFormed ("in mkVoid: "^msg) + + +fun mkGenericCollection atts trees = + { xmiid = getXmiId atts, + name = getName atts, + operations = (map mkOperation + ((XmlTree.filter "UML:Operation") + (XmlTree.follow "UML:Classifier.feature" + trees))), + generalizations = (map (getXmiIdref o XmlTree.attributes_of o hd) + (XmlTree.follow_all + "UML:GeneralizableElement.generalization" + trees)), + elementtype = ((getXmiIdref o XmlTree.attributes_of o hd) + (XmlTree.follow + "OCL.Types.CollectionType.elementType" + trees)) + } + handle XmlTree.IllFormed msg => raise IllFormed ("in mkGenericCollection: "^msg) + + +fun mkCollection atts trees = XMI.Collection (mkGenericCollection atts trees) +fun mkSequence atts trees = XMI.Sequence (mkGenericCollection atts trees) +fun mkSet atts trees = XMI.Set (mkGenericCollection atts trees) +fun mkBag atts trees = XMI.Bag (mkGenericCollection atts trees) +fun mkOrderedSet atts trees = XMI.OrderedSet (mkGenericCollection atts trees) + +fun mkStereotype tree = + let fun f atts trees = { xmiid = getXmiId atts, + name = getName atts, + baseClass = NONE, (*FIX*) + stereotypeConstraint = NONE (*FIX*) + } + in XmlTree.apply_on "UML:Stereotype" f tree + handle XmlTree.IllFormed msg => raise IllFormed ("in mkStereotype: "^msg) + end + + +fun mkClassifier tree = + let val elem = XmlTree.tagname_of tree + val atts = XmlTree.attributes_of tree + val trees = XmlTree.node_children_of tree + in + case elem of "UML:Class" => mkClass atts trees + | "UML:AssociationClass" => mkAssociationClass atts trees + | "UML:Interface" => mkInterface atts trees + | "UML:DataType" => mkPrimitive atts trees + | "UML:Primitive" => mkPrimitive atts trees + | "UML:Enumeration" => mkEnumeration atts trees + | "UML15OCL.Types.VoidType" => mkVoid atts trees + | "UML15OCL.Types.CollectionType" => mkCollection atts trees + | "UML15OCL.Types.SequenceType" => mkSequence atts trees + | "UML15OCL.Types.SetType" => mkSet atts trees + | "UML15OCL.Types.BagType" => mkBag atts trees + | "UML15OCL.Types.OrderedSetType" => mkOrderedSet atts trees + | _ => raise IllFormed ("in mkClassifier: found unexpected element "^elem) + end + + + +fun mkGeneralization tree = + let fun f atts trees = + { xmiid = getXmiId atts, + child_id = (getXmiIdref o XmlTree.attributes_of o hd o + (XmlTree.follow "UML:Generalization.child")) trees, + parent_id = (getXmiIdref o XmlTree.attributes_of o hd o + (XmlTree.follow "UML:Generalization.parent")) trees } + in XmlTree.apply_on "UML:Generalization" f tree + handle XmlTree.IllFormed msg => raise IllFormed ("in mkGeneralization: "^msg) + end + + +(* TODO: + +fun mkSignalEvent + +fun mkCallEvent + +fun mkEvent + +fun filterEvents + +*) + + @@ -994,7 +1015,8 @@ fun mkPackage tree = direct_childs)), taggedValue = (map mkTaggedValue (XmlTree.follow "UML:ModelElement.taggedValue" - direct_childs)) + direct_childs)), + events = nil (* map mkEvent (filterEvents trees)*) } end else raise IllFormed "did not find a UML:Model or UML: Package")