added some signature definitions
git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@2955 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Jürgen Doser
parent
ab657b2ecf
commit
d2078029c1
|
|
@ -22,7 +22,10 @@
|
|||
* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
******************************************************************************)
|
||||
|
||||
structure ParseXMI =
|
||||
structure ParseXMI :
|
||||
sig
|
||||
val parseXMI: string -> XMI_UML.XmiContent
|
||||
end =
|
||||
struct
|
||||
|
||||
(* generic exception if something is wrong *)
|
||||
|
|
@ -31,14 +34,11 @@ exception IllFormed of string
|
|||
exception NotYetImplemented
|
||||
|
||||
|
||||
fun getAttValueMaybe string atts = Option.map #2 (find (fn (x,_) => x = string)
|
||||
atts)
|
||||
|
||||
fun getAttValue string atts = valOf (getAttValueMaybe string atts)
|
||||
fun getStringAtt string atts = valOf (XmlTreeData.getAttValueMaybe string atts)
|
||||
handle Option => raise IllFormed ("in getAttValue: did not find attribute "^string)
|
||||
|
||||
fun getBoolAtt string atts =
|
||||
let val att = getAttValue string atts
|
||||
let val att = getStringAtt string atts
|
||||
in
|
||||
(valOf o Bool.fromString) att
|
||||
handle Option => raise IllFormed ("in getBoolAtt: found attribute "^string^
|
||||
|
|
@ -47,19 +47,19 @@ fun getBoolAtt string atts =
|
|||
|
||||
|
||||
fun getIntAtt string atts =
|
||||
let val att = getAttValue string atts
|
||||
let val att = getStringAtt string atts
|
||||
in
|
||||
(valOf o Int.fromString) att
|
||||
handle Option => raise IllFormed ("in getIntAtt: found attribute "^string^
|
||||
" with unexpected value "^att)
|
||||
end
|
||||
|
||||
fun getXmiId a = getAttValue "xmi.id" a
|
||||
fun getName a = getAttValue "name" a
|
||||
fun getXmiIdref a = getAttValue "xmi.idref" a
|
||||
fun getXmiId a = getStringAtt "xmi.id" a
|
||||
fun getName a = getStringAtt "name" a
|
||||
fun getXmiIdref a = getStringAtt "xmi.idref" a
|
||||
|
||||
fun getVisibility atts =
|
||||
let val att = getAttValueMaybe "visibility" atts
|
||||
let val att = XmlTreeData.getAttValueMaybe "visibility" atts
|
||||
in
|
||||
case att of SOME "public" => XMI_UML.public
|
||||
| SOME "private" => XMI_UML.private
|
||||
|
|
@ -70,7 +70,7 @@ fun getVisibility atts =
|
|||
end
|
||||
|
||||
fun getOrdering atts =
|
||||
let val att = getAttValue "ordering" atts
|
||||
let val att = getStringAtt "ordering" atts
|
||||
in
|
||||
case att of "unordered" => XMI_UML.Unordered
|
||||
| "ordered" => XMI_UML.Ordered
|
||||
|
|
@ -78,7 +78,7 @@ fun getOrdering atts =
|
|||
end
|
||||
|
||||
fun getAggregation atts =
|
||||
let val att = getAttValue "aggregation" atts in
|
||||
let val att = getStringAtt "aggregation" atts in
|
||||
case att of "none" => XMI_UML.NoAggregation
|
||||
| "aggregate" => XMI_UML.Aggregate
|
||||
| "composite" => XMI_UML.Composite
|
||||
|
|
@ -86,7 +86,7 @@ fun getAggregation atts =
|
|||
end
|
||||
|
||||
fun getChangeability atts =
|
||||
let val att = getAttValue "changeability" atts in
|
||||
let val att = getStringAtt "changeability" atts in
|
||||
case att of "changeable" => XMI_UML.Changeable
|
||||
| "frozen" => XMI_UML.Frozen
|
||||
| "addonly" => XMI_UML.AddOnly
|
||||
|
|
@ -94,7 +94,7 @@ fun getChangeability atts =
|
|||
end
|
||||
|
||||
fun getKind atts =
|
||||
let val att = getAttValue "kind" atts in
|
||||
let val att = getStringAtt "kind" atts in
|
||||
case att of "in" => XMI_UML.In
|
||||
| "out" => XMI_UML.Out
|
||||
| "inout" => XMI_UML.Inout
|
||||
|
|
@ -177,10 +177,10 @@ fun tree2oclexpression tree =
|
|||
val trees = XmlTreeData.getTrees tree
|
||||
in
|
||||
if elem = "UML15OCL.Expressions.BooleanLiteralExp" then
|
||||
XMI_UML.LiteralExp { symbol = getAttValue "booleanSymbol" atts,
|
||||
XMI_UML.LiteralExp { symbol = getStringAtt "booleanSymbol" atts,
|
||||
expression_type = findExpressionType trees }
|
||||
else if elem = "UML15OCL.Expressions.IntegerLiteralExp" then
|
||||
XMI_UML.LiteralExp { symbol = getAttValue "integerSymbol" atts,
|
||||
XMI_UML.LiteralExp { symbol = getStringAtt "integerSymbol" atts,
|
||||
expression_type = findExpressionType trees }
|
||||
else if elem = "UML15OCL.Expressions.OperationCallExp" then
|
||||
let val op_src = hd (followByName
|
||||
|
|
@ -288,7 +288,7 @@ fun mkConstraint atts trees =
|
|||
val st_type = hd (followByName "UML:ModelElement.stereotype" trees)
|
||||
val st_type_ref = getXmiIdref (XmlTreeData.getAtts st_type)
|
||||
in { xmiid = getXmiId atts,
|
||||
name = case getAttValueMaybe "name" atts of SOME s => SOME s | _ => NONE,
|
||||
name = case XmlTreeData.getAttValueMaybe "name" atts of SOME s => SOME s | _ => NONE,
|
||||
constraint_type = st_type_ref,
|
||||
body = tree2oclexpression expr }
|
||||
end
|
||||
|
|
|
|||
|
|
@ -24,9 +24,13 @@
|
|||
|
||||
|
||||
|
||||
structure Xmi2Mdr =
|
||||
structure Xmi2Mdr :
|
||||
sig
|
||||
val transformXMI : XMI_UML.XmiContent -> mdr_core.Classifier list
|
||||
end =
|
||||
struct
|
||||
exception IllFormed
|
||||
exception NotYetImplemented
|
||||
|
||||
datatype HashTableEntry = Package of ocl_type.Path
|
||||
| Type of (ocl_type.OclType *
|
||||
|
|
@ -41,51 +45,60 @@ datatype HashTableEntry = Package of ocl_type.Path
|
|||
|
||||
fun find_generalization t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Generalization x => x)
|
||||
of Generalization x => x
|
||||
| _ => raise IllFormed)
|
||||
handle Option => error ("expected Generalization "^xmiid^" in table")
|
||||
|
||||
fun find_stereotype t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Stereotype x => x)
|
||||
of Stereotype x => x
|
||||
| _ => raise IllFormed)
|
||||
handle Option => error ("expected Stereotype "^xmiid^" in table")
|
||||
|
||||
fun find_attribute t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Attribute x => x)
|
||||
of Attribute x => x
|
||||
| _ => raise IllFormed)
|
||||
handle Option => error ("expected Attribute "^xmiid^" in table")
|
||||
|
||||
fun find_operation t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Operation x => x)
|
||||
of Operation x => x
|
||||
| _ => raise IllFormed)
|
||||
handle Option => error ("expected Operation "^xmiid^" in table")
|
||||
|
||||
fun find_type t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Type x => x)
|
||||
of Type x => x
|
||||
| _ => raise IllFormed)
|
||||
handle Option => error ("expected Type "^xmiid^" in table (find_type)")
|
||||
|
||||
fun find_aends t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of (Type (c,xs)) => xs)
|
||||
of (Type (c,xs)) => xs
|
||||
| _ => raise IllFormed)
|
||||
handle Option => error ("expected Type "^xmiid^" in table (find_aends)")
|
||||
|
||||
fun find_variable_dec t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Variable x => x)
|
||||
of Variable x => x
|
||||
| _ => raise IllFormed)
|
||||
handle Option => error ("expected VariableDeclaration "^xmiid^" in table")
|
||||
|
||||
fun find_parent t xmiid = #2 (find_generalization t xmiid)
|
||||
|
||||
fun find_package t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Package path => path)
|
||||
of Package path => path
|
||||
| _ => raise IllFormed)
|
||||
handle Option => error ("expected Path "^xmiid^" in table")
|
||||
|
||||
fun path_of_classifier (ocl_type.Classifier x) = x
|
||||
|
||||
fun find_constraint t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Constraint c => c)
|
||||
of Constraint c => c
|
||||
| _ => raise IllFormed)
|
||||
handle Option => error ("expected Constraint "^xmiid^" in table")
|
||||
|
||||
|
||||
|
|
@ -110,6 +123,7 @@ fun filter_postcondition t cs
|
|||
|
||||
fun find_classifier_type t xmiid
|
||||
= let val ocltype = case valOf (HashTable.find t xmiid) of (Type (x,xs)) => x
|
||||
| _ => raise IllFormed
|
||||
in
|
||||
case ocltype of ocl_type.Integer => ocltype
|
||||
| ocl_type.String => ocltype
|
||||
|
|
@ -123,6 +137,7 @@ fun find_classifier_type t xmiid
|
|||
| ocl_type.Set (ocl_type.Classifier [x]) => ocl_type.Set (find_classifier_type t x)
|
||||
| ocl_type.Bag (ocl_type.Classifier [x]) => ocl_type.Bag (find_classifier_type t x)
|
||||
| ocl_type.OrderedSet (ocl_type.Classifier [x]) => ocl_type.OrderedSet (find_classifier_type t x)
|
||||
| _ => raise IllFormed
|
||||
end
|
||||
handle Option => error ("expected Classifier "^xmiid^" in table")
|
||||
|
||||
|
|
@ -222,6 +237,7 @@ fun transform_expression t (XMI_UML.LiteralExp {symbol,expression_type}) =
|
|||
in
|
||||
ocl_term.Variable (#name var_dec,find_classifier_type t expression_type)
|
||||
end
|
||||
| transform_expression t _ = raise NotYetImplemented
|
||||
|
||||
fun transform_constraint t ({xmiid,name,body,...}:XMI_UML.Constraint) =
|
||||
(name,transform_expression t body)
|
||||
|
|
@ -280,7 +296,8 @@ fun transform_classifier t (XMI_UML.Class {xmiid,name,isActive,visibility,isLeaf
|
|||
end
|
||||
| transform_classifier t (XMI_UML.Primitive {xmiid,name,generalizations,
|
||||
operations,invariant}) =
|
||||
mdr_core.Primitive {name = case find_classifier_type t xmiid of ocl_type.Classifier x => x,
|
||||
mdr_core.Primitive {name = case find_classifier_type t xmiid of ocl_type.Classifier x => x
|
||||
| _ => raise IllFormed,
|
||||
parent = NONE, (* FIX *)
|
||||
operations = map (transform_operation t) operations,
|
||||
associationends = map (transform_aend t)
|
||||
|
|
@ -292,7 +309,8 @@ fun transform_classifier t (XMI_UML.Class {xmiid,name,isActive,visibility,isLeaf
|
|||
thyname = NONE}
|
||||
| transform_classifier t (XMI_UML.Enumeration {xmiid,name,generalizations,
|
||||
operations,literals,invariant}) =
|
||||
mdr_core.Enumeration {name = case find_classifier_type t xmiid of ocl_type.Classifier x => x,
|
||||
mdr_core.Enumeration {name = case find_classifier_type t xmiid of ocl_type.Classifier x => x
|
||||
| _ => raise IllFormed,
|
||||
parent = NONE, (* FIX *)
|
||||
literals = literals,
|
||||
operations = map (transform_operation t) operations,
|
||||
|
|
@ -351,7 +369,8 @@ fun insert_model table (XMI_UML.Package p) =
|
|||
(* 3. insert the mapping xmi.id to association end into the hashtable *)
|
||||
fun transform_assocation t (assoc:XMI_UML.Association) =
|
||||
let val aends = #connection assoc
|
||||
fun all_others x xs = List.filter (fn y => y <> x) xs
|
||||
fun all_others x xs = List.filter
|
||||
(fn (y:XMI_UML.AssociationEnd) => y <> x) xs
|
||||
fun pair_with ae aes =
|
||||
map (fn (x:XMI_UML.AssociationEnd) => (#participant_id x, ae)) aes
|
||||
val mappings = List.concat (map (fn x => pair_with x (all_others x aends)) aends)
|
||||
|
|
|
|||
|
|
@ -23,12 +23,25 @@
|
|||
******************************************************************************)
|
||||
|
||||
|
||||
structure XmlTreeData =
|
||||
structure XmlTreeData :
|
||||
sig
|
||||
type AttList
|
||||
type Tag
|
||||
datatype XmlTree = ELEM of Tag * XmlContent
|
||||
withtype XmlContent = XmlTree list
|
||||
|
||||
val getAtts : XmlTree -> AttList
|
||||
val getTrees: XmlTree -> XmlContent
|
||||
val getElem : XmlTree -> string
|
||||
val getAttValueMaybe : string -> AttList -> string option
|
||||
end =
|
||||
struct
|
||||
exception IllFormed
|
||||
|
||||
|
||||
type AttList = (string * string) list
|
||||
|
||||
(* Tags consist of element names, and a list of attribute name-value pairs *)
|
||||
type Tag = string * ((string * string) list)
|
||||
type Tag = string * AttList
|
||||
|
||||
(*datatype Tree = TEXT of UniChar.Vector
|
||||
| ELEM of Tag * Content
|
||||
|
|
@ -39,12 +52,15 @@ withtype XmlContent = XmlTree list
|
|||
fun getAtts (ELEM ((elem,atts),trees)) = atts
|
||||
fun getTrees (ELEM ((elem,atts),trees)) = trees
|
||||
fun getElem (ELEM ((elem,atts),trees)) = elem
|
||||
fun getAttValueMaybe string atts = Option.map #2 (find (fn (x,_) => x = string)
|
||||
atts)
|
||||
|
||||
end
|
||||
|
||||
structure XmlTreeHooks =
|
||||
structure XmlTreeHooks:Hooks =
|
||||
struct
|
||||
open IgnoreHooks XmlTreeData UniChar HookData
|
||||
exception IllFormed
|
||||
|
||||
type AppData = Dtd.Dtd * XmlContent * (Tag * XmlContent) list
|
||||
type AppFinal = XmlTree
|
||||
|
|
@ -92,10 +108,10 @@ fun hookFinish (dtd,[elem],nil) = elem
|
|||
|
||||
end
|
||||
|
||||
structure ParseXmlTree = (* :
|
||||
structure ParseXmlTree :
|
||||
sig
|
||||
val parseTree : Uri.Uri option -> Dtd.Dtd option -> TreeData.Tree
|
||||
end = *)
|
||||
val readFile : string -> XmlTreeData.XmlTree
|
||||
end =
|
||||
struct
|
||||
open XmlTreeData
|
||||
|
||||
|
|
@ -126,7 +142,10 @@ fun readFile filename =
|
|||
end
|
||||
|
||||
|
||||
structure WriteXmlTree =
|
||||
structure WriteXmlTree:
|
||||
sig
|
||||
val writeFile : string -> XmlTreeData.XmlTree -> unit
|
||||
end =
|
||||
struct
|
||||
open XmlTreeData
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue