HOL-OCL
/
su4sml
1
0
Fork 0
Code Issues Pull Requests Releases Activity

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
This commit is contained in:
Jürgen Doser 2005-10-28 14:39:09 +00:00
parent f27239f22a
commit 0211494494
12 changed files with 456 additions and 375 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/ROOT.ML
View File

@ -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";
*)

3
src/rep.sig
View File

@ -27,8 +27,5 @@ sig
include REP_CORE
include REP_ACTIVITY_GRAPH
include REP_SECUREUML
type Model
end

7
src/rep.sml
View File

@ -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

2
src/rep_state_machines.sig
View File

@ -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,

2
src/rep_state_machines.sml
View File

@ -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,

3
src/xmi.sml
View File

@ -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

9
src/xmi2rep.sml
View File

@ -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,

136
src/xmi_core.sml
View File

@ -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

104
src/xmi_datatypes.sml Normal file
View File

@ -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 <brucker@inf.ethz.ch>
* Jürgen Doser <doserj@inf.ethz.ch>
*
* 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

77
src/xmi_extension_mechanisms.sml Normal file
View File

@ -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 <brucker@inf.ethz.ch>
* Jürgen Doser <doserj@inf.ethz.ch>
*
* 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

4
src/xmi_state_machines.sml
View File

@ -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

466
src/xml2xmi.sml
View File

@ -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")