merge brach: changing type of classfier names from "Path" to "OclType".
git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@5773 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
parent
17094f471e
commit
0ed1a82b2e
|
@ -239,8 +239,8 @@ fun ActGraph_of_classif_from_list(C:Classifier list) = let fun isFull l = (fn x
|
|||
end
|
||||
|
||||
|
||||
fun name_of_classif(Class{name=[a,b,c],...}) = c
|
||||
| name_of_classif(Primitive{name=[a,b],...}) = "PRIMITIVE"
|
||||
fun name_of_classif(C as Class c) = Rep.short_name_of C
|
||||
| name_of_classif(Primitive p) = "PRIMITIVE"
|
||||
| name_of_classif(_) = "XXX"
|
||||
|
||||
(*return list of subertices ot the given Classifier (Class, Primitive,...)*)
|
||||
|
|
|
@ -239,31 +239,31 @@ fun operation2string ({name,arguments,result,precondition,postcondition,...}:Rep
|
|||
fun attribute2string ({name,attr_type,...}:Rep.attribute) =
|
||||
" "^name^" : "^(Rep_OclType.string_of_OclType attr_type)^"\n"
|
||||
|
||||
fun parent2string (SOME p) = " extends "^Rep.string_of_path p
|
||||
|parent2string NONE = ""
|
||||
fun parent2string (SOME (p)) = " extends "^Rep_OclType.string_of_OclType p
|
||||
| parent2string _ = ""
|
||||
|
||||
fun classifier2string (Rep.Class x) =
|
||||
fun classifier2string (C as Rep.Class x) =
|
||||
String.concat (map stereotype2string (#stereotypes x))^
|
||||
"class "^Rep.string_of_path (#name x)^
|
||||
"class "^Rep.string_of_path (Rep.name_of C)^
|
||||
parent2string (#parent x)^
|
||||
" {\n"^
|
||||
String.concat (map inv2string (#invariant x))^
|
||||
String.concat (map attribute2string (#attributes x))^
|
||||
String.concat (map operation2string (#operations x))^
|
||||
"}\n"
|
||||
| classifier2string (Rep.Interface x) =
|
||||
| classifier2string (C as Rep.Interface x) =
|
||||
String.concat (map stereotype2string (#stereotypes x))^
|
||||
"interface "^Rep.string_of_path (#name x)^"{\n"^
|
||||
"interface "^Rep.string_of_path (Rep.name_of C)^"{\n"^
|
||||
String.concat (map operation2string (#operations x))^
|
||||
"}\n"
|
||||
| classifier2string (Rep.Primitive x) =
|
||||
| classifier2string (C as Rep.Primitive x) =
|
||||
String.concat (map stereotype2string (#stereotypes x))^
|
||||
"primitive "^Rep.string_of_path (#name x)^"{\n"^
|
||||
"primitive "^Rep.string_of_path (Rep.name_of C)^"{\n"^
|
||||
String.concat (map operation2string (#operations x))^
|
||||
"}\n"
|
||||
| classifier2string (Rep.Enumeration x) =
|
||||
| classifier2string (C as Rep.Enumeration x) =
|
||||
String.concat (map stereotype2string (#stereotypes x))^
|
||||
"enum "^Rep.string_of_path (#name x)^"{\n"^
|
||||
"enum "^Rep.string_of_path (Rep.name_of C)^"{\n"^
|
||||
String.concat (map operation2string (#operations x))^
|
||||
"}\n"
|
||||
|
||||
|
|
|
@ -46,10 +46,10 @@ val oclLib =
|
|||
associationends=[],
|
||||
activity_graphs=[],
|
||||
invariant=[],
|
||||
name=["Sequence(T)"],
|
||||
name=Sequence (TemplateParameter "T"),
|
||||
operations=[
|
||||
{
|
||||
arguments=[("object",Classifier [OclLibPackage,"T"])],
|
||||
arguments=[("object",TemplateParameter "T")],
|
||||
isQuery=true,
|
||||
name="count",
|
||||
postcondition=[],
|
||||
|
@ -154,7 +154,7 @@ val oclLib =
|
|||
visibility=XMI.public
|
||||
},
|
||||
{
|
||||
arguments=[("object", Classifier [OclLibPackage,"T"])],
|
||||
arguments=[("object", TemplateParameter "T")],
|
||||
isQuery=true,
|
||||
name="append",
|
||||
postcondition=[],
|
||||
|
@ -164,7 +164,7 @@ val oclLib =
|
|||
visibility=XMI.public
|
||||
},
|
||||
{
|
||||
arguments=[("object",Classifier [OclLibPackage,"T"])],
|
||||
arguments=[("object",TemplateParameter "T")],
|
||||
isQuery=true,
|
||||
name="prepend",
|
||||
postcondition=[],
|
||||
|
@ -175,7 +175,7 @@ val oclLib =
|
|||
},
|
||||
{
|
||||
arguments=[("index",Classifier [OclLibPackage,"Integer"]),
|
||||
("object",Classifier [OclLibPackage,"T"])],
|
||||
("object",TemplateParameter "T")],
|
||||
isQuery=true,name="insertAt",
|
||||
postcondition=[],
|
||||
precondition=[],
|
||||
|
@ -199,12 +199,12 @@ val oclLib =
|
|||
name="at",
|
||||
postcondition=[],
|
||||
precondition=[],
|
||||
result=Classifier [OclLibPackage,"T"],
|
||||
result=TemplateParameter "T",
|
||||
scope=XMI.InstanceScope,
|
||||
visibility=XMI.public
|
||||
},
|
||||
{
|
||||
arguments=[("obj",Classifier [OclLibPackage,"T"])],
|
||||
arguments=[("obj",TemplateParameter "T")],
|
||||
isQuery=true,
|
||||
name="indexOf",
|
||||
postcondition=[],
|
||||
|
@ -219,7 +219,7 @@ val oclLib =
|
|||
name="first",
|
||||
postcondition=[],
|
||||
precondition=[],
|
||||
result=Classifier [OclLibPackage,"T"],
|
||||
result=TemplateParameter "T",
|
||||
scope=XMI.InstanceScope,
|
||||
visibility=XMI.public
|
||||
},
|
||||
|
@ -229,11 +229,11 @@ val oclLib =
|
|||
name="last",
|
||||
postcondition=[],
|
||||
precondition=[],
|
||||
result=Classifier [OclLibPackage,"T"],
|
||||
result=TemplateParameter "T",
|
||||
scope=XMI.InstanceScope,visibility=XMI.public
|
||||
},
|
||||
{
|
||||
arguments=[("object",Classifier [OclLibPackage,"T"])],
|
||||
arguments=[("object",TemplateParameter "T")],
|
||||
isQuery=true,
|
||||
name="including",
|
||||
postcondition=[],
|
||||
|
@ -243,7 +243,7 @@ val oclLib =
|
|||
visibility=XMI.public
|
||||
},
|
||||
{
|
||||
arguments=[("object",Classifier [OclLibPackage,"T"])],
|
||||
arguments=[("object",TemplateParameter "T")],
|
||||
isQuery=true,
|
||||
name="excluding",
|
||||
postcondition=[],
|
||||
|
@ -296,7 +296,7 @@ val oclLib =
|
|||
activity_graphs=[],
|
||||
interfaces=[],
|
||||
invariant=[],
|
||||
name=["Bag(T)"],
|
||||
name=Bag (TemplateParameter "T"),
|
||||
operations=[
|
||||
{
|
||||
arguments=[("bag",Classifier [OclLibPackage,"Bag(T)"])],
|
||||
|
@ -368,19 +368,19 @@ val oclLib =
|
|||
scope=XMI.InstanceScope,visibility=XMI.public
|
||||
},
|
||||
{
|
||||
arguments=[("object",Classifier [OclLibPackage,"T"])],
|
||||
arguments=[("object",TemplateParameter "T")],
|
||||
isQuery=true,name="including",postcondition=[],
|
||||
precondition=[],result=Classifier [OclLibPackage,"Bag(T)"],
|
||||
scope=XMI.InstanceScope,visibility=XMI.public
|
||||
},
|
||||
{
|
||||
arguments=[("object",Classifier [OclLibPackage,"T"])],
|
||||
arguments=[("object",TemplateParameter "T")],
|
||||
isQuery=true,name="excluding",postcondition=[],
|
||||
precondition=[],result=Classifier [OclLibPackage,"Bag(T)"],
|
||||
scope=XMI.InstanceScope,visibility=XMI.public
|
||||
},
|
||||
{
|
||||
arguments=[("object",Classifier [OclLibPackage,"T"])],
|
||||
arguments=[("object",TemplateParameter "T")],
|
||||
isQuery=true,name="count",postcondition=[],precondition=[],
|
||||
result=Classifier [OclLibPackage,"Integer"],scope=XMI.InstanceScope,
|
||||
visibility=XMI.public
|
||||
|
@ -416,7 +416,8 @@ val oclLib =
|
|||
attributes=[],
|
||||
associationends=[],
|
||||
activity_graphs=[],
|
||||
interfaces=[],invariant=[],name=["Set(T)"],
|
||||
interfaces=[],invariant=[],
|
||||
name=Set (TemplateParameter "T"),
|
||||
operations=[
|
||||
{
|
||||
arguments=[("s",Classifier [OclLibPackage,"Set(T)"])],
|
||||
|
@ -501,13 +502,13 @@ val oclLib =
|
|||
scope=XMI.InstanceScope,visibility=XMI.public
|
||||
},
|
||||
{
|
||||
arguments=[("object",Classifier [OclLibPackage,"T"])],
|
||||
arguments=[("object",TemplateParameter "T")],
|
||||
isQuery=true,name="including",postcondition=[],
|
||||
precondition=[],result=Classifier [OclLibPackage,"Set(T)"],
|
||||
scope=XMI.InstanceScope,visibility=XMI.public
|
||||
},
|
||||
{
|
||||
arguments=[("object",Classifier [OclLibPackage,"T"])],
|
||||
arguments=[("object",TemplateParameter "T")],
|
||||
isQuery=true,name="excluding",postcondition=[],
|
||||
precondition=[],result=Classifier [OclLibPackage,"Set(T)"],
|
||||
scope=XMI.InstanceScope,visibility=XMI.public
|
||||
|
@ -519,7 +520,7 @@ val oclLib =
|
|||
scope=XMI.InstanceScope,visibility=XMI.public
|
||||
},
|
||||
{
|
||||
arguments=[("object",Classifier [OclLibPackage,"T"])],
|
||||
arguments=[("object",TemplateParameter "T")],
|
||||
isQuery=true,name="count",postcondition=[],precondition=[],
|
||||
result=Classifier [OclLibPackage,"Integer"],scope=XMI.InstanceScope,
|
||||
visibility=XMI.public
|
||||
|
@ -563,7 +564,7 @@ val oclLib =
|
|||
attributes=[],
|
||||
associationends=[],
|
||||
activity_graphs=[],
|
||||
interfaces=[],invariant=[],name=["Collection(T)"],
|
||||
interfaces=[],invariant=[],name=Collection (TemplateParameter "T"),
|
||||
operations=[
|
||||
{
|
||||
arguments=[],isQuery=true,name="size",postcondition=[],
|
||||
|
@ -577,19 +578,19 @@ val oclLib =
|
|||
visibility=XMI.public
|
||||
},
|
||||
{
|
||||
arguments=[("object",Classifier [OclLibPackage,"T"])],
|
||||
arguments=[("object",TemplateParameter "T")],
|
||||
isQuery=true,name="includes",postcondition=[],
|
||||
precondition=[],result=Classifier [OclLibPackage,"Boolean"],
|
||||
scope=XMI.InstanceScope,visibility=XMI.public
|
||||
},
|
||||
{
|
||||
arguments=[("object",Classifier [OclLibPackage,"T"])],
|
||||
arguments=[("object",TemplateParameter "T")],
|
||||
isQuery=true,name="excludes",postcondition=[],
|
||||
precondition=[],result=Classifier [OclLibPackage,"Boolean"],
|
||||
scope=XMI.InstanceScope,visibility=XMI.public
|
||||
},
|
||||
{
|
||||
arguments=[("object",Classifier [OclLibPackage,"T"])],
|
||||
arguments=[("object",TemplateParameter "T")],
|
||||
isQuery=true,name="count",postcondition=[],precondition=[],
|
||||
result=Classifier [OclLibPackage,"Integer"],scope=XMI.InstanceScope,
|
||||
visibility=XMI.public
|
||||
|
@ -618,7 +619,7 @@ val oclLib =
|
|||
},
|
||||
{
|
||||
arguments=[],isQuery=true,name="sum",postcondition=[],
|
||||
precondition=[],result=Classifier [OclLibPackage,"T"],
|
||||
precondition=[],result=TemplateParameter "T",
|
||||
scope=XMI.InstanceScope,visibility=XMI.public
|
||||
},
|
||||
{
|
||||
|
@ -635,13 +636,13 @@ val oclLib =
|
|||
attributes=[],
|
||||
associationends=[],
|
||||
activity_graphs=[],
|
||||
interfaces=[],invariant=[],name=["OclVoid"],operations=[],
|
||||
interfaces=[],invariant=[],name=OclVoid,operations=[],
|
||||
parent=NONE,stereotypes=[],thyname=NONE
|
||||
},
|
||||
|
||||
Primitive
|
||||
{
|
||||
associationends=[],interfaces=[],invariant=[],name=[OclLibPackage,"OclAny"],
|
||||
associationends=[],interfaces=[],invariant=[],name=OclAny,
|
||||
operations=[
|
||||
{
|
||||
arguments=[("object",Classifier [OclLibPackage,"OclAny"])],
|
||||
|
@ -698,7 +699,7 @@ val oclLib =
|
|||
},
|
||||
{
|
||||
arguments=[],isQuery=true,name="asSet",postcondition=[],
|
||||
precondition=[],result=Classifier [OclLibPackage,"Set(OclAny)"],
|
||||
precondition=[],result=Classifier [OclLibPackage,"Set(T)"],
|
||||
scope=XMI.InstanceScope,visibility=XMI.public
|
||||
},
|
||||
{
|
||||
|
@ -721,7 +722,7 @@ val oclLib =
|
|||
},
|
||||
Primitive
|
||||
{
|
||||
associationends=[],interfaces=[],invariant=[],name=[OclLibPackage,"String"],
|
||||
associationends=[],interfaces=[],invariant=[],name=String,
|
||||
operations=[
|
||||
{
|
||||
arguments=[],isQuery=true,name="size",postcondition=[],
|
||||
|
@ -765,7 +766,7 @@ val oclLib =
|
|||
},
|
||||
Primitive
|
||||
{
|
||||
associationends=[],interfaces=[],invariant=[],name=[OclLibPackage,"Boolean"],
|
||||
associationends=[],interfaces=[],invariant=[],name=Boolean,
|
||||
operations=[
|
||||
{
|
||||
arguments=[("b",Classifier [OclLibPackage,"Boolean"])],
|
||||
|
@ -835,7 +836,7 @@ val oclLib =
|
|||
},
|
||||
Primitive
|
||||
{
|
||||
associationends=[],interfaces=[],invariant=[],name=[OclLibPackage,"Integer"],
|
||||
associationends=[],interfaces=[],invariant=[],name=Integer,
|
||||
operations=[
|
||||
{
|
||||
arguments=[("i",Classifier [OclLibPackage,"Integer"])],
|
||||
|
@ -898,7 +899,7 @@ val oclLib =
|
|||
},
|
||||
Primitive
|
||||
{
|
||||
associationends=[],interfaces=[],invariant=[],name=[OclLibPackage,"Real"],
|
||||
associationends=[],interfaces=[],invariant=[],name=Real,
|
||||
operations=[
|
||||
{
|
||||
arguments=[("r",Classifier [OclLibPackage,"Real"])],
|
||||
|
|
156
src/rep_core.sml
156
src/rep_core.sml
|
@ -56,43 +56,43 @@ type attribute = {
|
|||
|
||||
datatype Classifier =
|
||||
Class of
|
||||
{ name : Rep_OclType.Path,
|
||||
parent : Rep_OclType.Path option,
|
||||
{ name : Rep_OclType.OclType,
|
||||
parent : Rep_OclType.OclType option,
|
||||
attributes : attribute list,
|
||||
operations : operation list,
|
||||
associationends : associationend list,
|
||||
invariant : (string option * Rep_OclTerm.OclTerm) list,
|
||||
stereotypes : string list,
|
||||
interfaces : Rep_OclType.Path list,
|
||||
interfaces : Rep_OclType.OclType list,
|
||||
thyname : string option,
|
||||
activity_graphs : Rep_ActivityGraph.ActivityGraph list
|
||||
}
|
||||
| Interface of (* not supported yet *)
|
||||
{ name : Rep_OclType.Path,
|
||||
parents : Rep_OclType.Path list,
|
||||
{ name : Rep_OclType.OclType,
|
||||
parents : Rep_OclType.OclType list,
|
||||
operations : operation list,
|
||||
stereotypes : string list,
|
||||
invariant : (string option * Rep_OclTerm.OclTerm) list,
|
||||
thyname : string option
|
||||
}
|
||||
| Enumeration of (* not really supported yet? *)
|
||||
{ name : Rep_OclType.Path,
|
||||
parent : Rep_OclType.Path option,
|
||||
{ name : Rep_OclType.OclType,
|
||||
parent : Rep_OclType.OclType option,
|
||||
operations : operation list,
|
||||
literals : string list,
|
||||
invariant : (string option * Rep_OclTerm.OclTerm) list,
|
||||
stereotypes : string list,
|
||||
interfaces : Rep_OclType.Path list,
|
||||
interfaces : Rep_OclType.OclType list,
|
||||
thyname : string option
|
||||
}
|
||||
| Primitive of (* not really supported yet *)
|
||||
{ name : Rep_OclType.Path,
|
||||
parent : Rep_OclType.Path option,
|
||||
{ name : Rep_OclType.OclType,
|
||||
parent : Rep_OclType.OclType option,
|
||||
operations : operation list,
|
||||
associationends : associationend list,
|
||||
invariant : (string option * Rep_OclTerm.OclTerm) list,
|
||||
stereotypes : string list,
|
||||
interfaces : Rep_OclType.Path list,
|
||||
interfaces : Rep_OclType.OclType list,
|
||||
thyname : string option
|
||||
}
|
||||
| Template of
|
||||
|
@ -106,6 +106,7 @@ val normalize : Classifier -> Classifier
|
|||
val normalize_init : Classifier -> Classifier
|
||||
|
||||
val name_of : Classifier -> Rep_OclType.Path
|
||||
val type_of : Classifier -> Rep_OclType.OclType
|
||||
val package_of : Classifier -> Rep_OclType.Path
|
||||
val short_name_of : Classifier -> string
|
||||
|
||||
|
@ -174,43 +175,43 @@ type attribute = {
|
|||
|
||||
datatype Classifier =
|
||||
Class of
|
||||
{ name : Rep_OclType.Path,
|
||||
parent : Rep_OclType.Path option,
|
||||
{ name : Rep_OclType.OclType,
|
||||
parent : Rep_OclType.OclType option,
|
||||
attributes : attribute list,
|
||||
operations : operation list,
|
||||
associationends : associationend list,
|
||||
invariant : (string option * Rep_OclTerm.OclTerm) list,
|
||||
stereotypes : string list,
|
||||
interfaces : Rep_OclType.Path list,
|
||||
interfaces : Rep_OclType.OclType list,
|
||||
thyname : string option,
|
||||
activity_graphs : Rep_ActivityGraph.ActivityGraph list
|
||||
}
|
||||
| Interface of (* not supported yet *)
|
||||
{ name : Rep_OclType.Path,
|
||||
parents : Rep_OclType.Path list,
|
||||
{ name : Rep_OclType.OclType,
|
||||
parents : Rep_OclType.OclType list,
|
||||
operations : operation list,
|
||||
stereotypes : string list,
|
||||
invariant : (string option * Rep_OclTerm.OclTerm) list,
|
||||
thyname : string option
|
||||
}
|
||||
| Enumeration of (* not really supported yet? *)
|
||||
{ name : Rep_OclType.Path,
|
||||
parent : Rep_OclType.Path option,
|
||||
{ name : Rep_OclType.OclType,
|
||||
parent : Rep_OclType.OclType option,
|
||||
operations : operation list,
|
||||
literals : string list,
|
||||
invariant : (string option * Rep_OclTerm.OclTerm) list,
|
||||
stereotypes : string list,
|
||||
interfaces : Rep_OclType.Path list,
|
||||
interfaces : Rep_OclType.OclType list,
|
||||
thyname : string option
|
||||
}
|
||||
| Primitive of (* not really supported yet *)
|
||||
{ name : Rep_OclType.Path,
|
||||
parent : Rep_OclType.Path option,
|
||||
{ name : Rep_OclType.OclType,
|
||||
parent : Rep_OclType.OclType option,
|
||||
operations : operation list,
|
||||
associationends : associationend list,
|
||||
invariant : (string option * Rep_OclTerm.OclTerm) list,
|
||||
stereotypes : string list,
|
||||
interfaces : Rep_OclType.Path list,
|
||||
interfaces : Rep_OclType.OclType list,
|
||||
thyname : string option
|
||||
}
|
||||
| Template of
|
||||
|
@ -303,7 +304,19 @@ fun assoc_to_inv cls_name (aend:associationend) =
|
|||
then (SOME inv_name, Rep_OclTerm.Literal ("true",Rep_OclType.Boolean))
|
||||
else (SOME inv_name, foldr1 ocl_or range_constraints)
|
||||
end
|
||||
|
||||
|
||||
|
||||
fun path_of_OclType (Rep_OclType.Classifier p) = p
|
||||
| path_of_OclType Rep_OclType.Integer = ["oclLib","Integer"]
|
||||
| path_of_OclType Rep_OclType.Real = ["oclLib","Real"]
|
||||
| path_of_OclType Rep_OclType.String = ["oclLib","String"]
|
||||
| path_of_OclType Rep_OclType.Boolean = ["oclLib","Boolean"]
|
||||
| path_of_OclType Rep_OclType.OclAny = ["oclLib","OclAny"]
|
||||
| path_of_OclType Rep_OclType.OclVoid = ["oclLib","OclVoid"]
|
||||
| path_of_OclType Rep_OclType.DummyT = ["oclLib","OclDummy"]
|
||||
|
||||
|
||||
|
||||
(* convert association ends into attributes + invariants *)
|
||||
fun normalize (Class {name,parent,attributes,operations,associationends,invariant,
|
||||
stereotypes,interfaces,thyname,activity_graphs}) =
|
||||
|
@ -313,7 +326,7 @@ fun normalize (Class {name,parent,attributes,operations,associationends,invarian
|
|||
attributes),
|
||||
operations = operations,
|
||||
associationends = nil,
|
||||
invariant = append (map (assoc_to_inv name) associationends)
|
||||
invariant = append (map (assoc_to_inv (path_of_OclType name)) associationends)
|
||||
invariant,
|
||||
stereotypes = stereotypes,
|
||||
interfaces = interfaces,
|
||||
|
@ -377,7 +390,7 @@ fun normalize_init (Class {name,parent,attributes,operations,associationends,inv
|
|||
attributes = (map rm_init_attr attributes),
|
||||
operations = operations,
|
||||
associationends = nil,
|
||||
invariant = append (map (init_to_inv name) attributes)
|
||||
invariant = append (map (init_to_inv (path_of_OclType name)) attributes)
|
||||
invariant,
|
||||
stereotypes = stereotypes,
|
||||
interfaces = interfaces,
|
||||
|
@ -389,7 +402,7 @@ fun normalize_init (Class {name,parent,attributes,operations,associationends,inv
|
|||
|
||||
|
||||
|
||||
val OclAnyC = Class{name=["OclAny"],parent=NONE,attributes=[],
|
||||
val OclAnyC = Class{name=Rep_OclType.OclAny,parent=NONE,attributes=[],
|
||||
operations=[], interfaces=[],
|
||||
invariant=[],stereotypes=[], associationends=[],
|
||||
thyname=NONE,
|
||||
|
@ -422,86 +435,89 @@ fun update_thyname tname (Class{name,parent,attributes,operations,invariant,
|
|||
stereotypes=stereotypes,interfaces=interfaces,thyname=(SOME tname)}
|
||||
|
||||
|
||||
fun name_of (Class{name,...}) = name
|
||||
| name_of (Interface{name,...}) = name
|
||||
| name_of (Enumeration{name,...}) = name
|
||||
| name_of (Primitive{name,...}) = name
|
||||
| name_of (Template{classifier,...}) = name_of classifier
|
||||
|
||||
fun short_name_of (Class{name,...}) = (hd o rev) name
|
||||
| short_name_of (Interface{name,...}) = (hd o rev) name
|
||||
| short_name_of (Enumeration{name,...}) = (hd o rev) name
|
||||
| short_name_of (Primitive{name,...}) = (hd o rev) name
|
||||
|
||||
fun type_of (Class{name,...}) = name
|
||||
| type_of (Interface{name,...}) = name
|
||||
| type_of (Enumeration{name,...}) = name
|
||||
| type_of (Primitive{name,...}) = name
|
||||
| type_of (Template{classifier,...}) = type_of classifier
|
||||
|
||||
|
||||
fun name_of (Class{name,...}) = path_of_OclType name
|
||||
| name_of (Interface{name,...}) = path_of_OclType name
|
||||
| name_of (Enumeration{name,...}) = path_of_OclType name
|
||||
| name_of (Primitive{name,...}) = path_of_OclType name
|
||||
| name_of _ = error "no name represenation for this classifier"
|
||||
|
||||
fun short_name_of C = case (name_of C) of
|
||||
[] => error "empty type in short name"
|
||||
| p => (hd o rev) p
|
||||
|
||||
fun stereotypes_of (Class{stereotypes,...}) = stereotypes
|
||||
| stereotypes_of (Interface{stereotypes,...}) = stereotypes
|
||||
| stereotypes_of (Enumeration{stereotypes,...}) = stereotypes
|
||||
| stereotypes_of (Primitive{stereotypes,...}) = stereotypes
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
fun package_of (Class{name,...}) = if (length name) > 1
|
||||
then take (((length name) -1),name)
|
||||
fun package_of (Class{name,...}) = if (length (path_of_OclType name)) > 1
|
||||
then take (((length (path_of_OclType name)) -1),(path_of_OclType name))
|
||||
else []
|
||||
| package_of (Interface{name,...}) = if (length name) > 1
|
||||
then take (((length name) -1),name)
|
||||
| package_of (Interface{name,...}) = if (length (path_of_OclType name)) > 1
|
||||
then take (((length (path_of_OclType name)) -1),(path_of_OclType name))
|
||||
else []
|
||||
| package_of (Enumeration{name,...}) = if (length name) > 1
|
||||
then take (((length name) -1),name)
|
||||
| package_of (Enumeration{name,...}) = if (length (path_of_OclType name)) > 1
|
||||
then take (((length (path_of_OclType name)) -1),(path_of_OclType name))
|
||||
else []
|
||||
| package_of (Primitive{name,...}) = if (length name) > 1
|
||||
then take (((length name) -1),name)
|
||||
| package_of (Primitive{name,...}) = if (length (path_of_OclType name)) > 1
|
||||
then take (((length (path_of_OclType name)) -1),(path_of_OclType name))
|
||||
else []
|
||||
| package_of (Template{classifier,...}) = package_of classifier
|
||||
|
||||
fun parent_name_of (C as Class{parent,...}) =
|
||||
(case parent of NONE => name_of OclAnyC
|
||||
|SOME p => p )
|
||||
|SOME p => path_of_OclType p )
|
||||
| parent_name_of (Interface{...}) =
|
||||
error "parent_name_of <Interface> not supported"
|
||||
| parent_name_of (E as Enumeration{parent,...}) =
|
||||
(case parent of NONE => error ("Enumeration "^((string_of_path o name_of) E)
|
||||
^" has no parent")
|
||||
| SOME p => p )
|
||||
| SOME p => path_of_OclType p )
|
||||
| parent_name_of (D as Primitive{parent,...}) =
|
||||
(case parent of NONE => name_of OclAnyC
|
||||
(* error ("Primitive "^((string_of_path o name_of) D)^" has no parent") *)
|
||||
| SOME p => p )
|
||||
| SOME p => path_of_OclType p )
|
||||
|
||||
fun short_parent_name_of (C as Class{parent,...}) =
|
||||
(case parent of NONE => short_name_of OclAnyC
|
||||
| SOME p => (hd o rev) p )
|
||||
| short_parent_name_of (Interface{...}) =
|
||||
error "parent_name_of <Interface> not supported"
|
||||
| short_parent_name_of (E as Enumeration{parent,...}) =
|
||||
(case parent of NONE => error ("Enumeration "^((string_of_path o name_of) E)^
|
||||
" has no parent")
|
||||
| SOME p => (hd o rev) p )
|
||||
| short_parent_name_of (D as Primitive{parent,...}) =
|
||||
(case parent of NONE => short_name_of OclAnyC
|
||||
(* error ("Primitive "^((string_of_path o name_of) D)^" has no parent") *)
|
||||
| SOME p => (hd o rev) p )
|
||||
|
||||
fun short_parent_name_of C = case (parent_name_of C) of
|
||||
[] => error "empty type in short parent name"
|
||||
| p => (hd o rev) p
|
||||
|
||||
fun parent_package_of (Class{parent,...}) =
|
||||
(case parent of NONE => package_of OclAnyC
|
||||
| SOME p =>if (length p) > 1
|
||||
then (take (((length p) -1),p))
|
||||
else [])
|
||||
| SOME q => let val p = path_of_OclType q in
|
||||
if (length p) > 1
|
||||
then (take (((length p) -1),p))
|
||||
else []
|
||||
end)
|
||||
| parent_package_of (Interface{...}) =
|
||||
error "parent_package_of <Interface> not supported"
|
||||
| parent_package_of (Enumeration{parent,...}) =
|
||||
(case parent of NONE => error "Enumeration has no parent"
|
||||
| SOME p => if (length p) > 1
|
||||
then (take (((length p) -1),p))
|
||||
else [])
|
||||
| SOME q => let val p = path_of_OclType q in
|
||||
if (length p) > 1
|
||||
then (take (((length p) -1),p))
|
||||
else []
|
||||
end )
|
||||
| parent_package_of (Primitive{parent,...}) =
|
||||
(case parent of NONE => package_of OclAnyC
|
||||
(* NONE => error "Primitive has no parent" *)
|
||||
| SOME p => if (length p) > 1
|
||||
then (take (((length p) -1),p))
|
||||
else [])
|
||||
| SOME q => let val p = path_of_OclType q in
|
||||
if (length p) > 1
|
||||
then (take (((length p) -1),p))
|
||||
else []
|
||||
end)
|
||||
|
||||
|
||||
fun attributes_of (Class{attributes,...}) = attributes
|
||||
|
|
|
@ -343,10 +343,10 @@ fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf,
|
|||
val filtered_parents = filter (fn x => x <> Rep_OclType.OclAny) parents
|
||||
val checked_invariants = filter_exists t invariant
|
||||
in
|
||||
Rep.Class {name = path_of_classifier (find_classifier_type t xmiid),
|
||||
Rep.Class {name = (* path_of_classifier *) (find_classifier_type t xmiid),
|
||||
parent = case filtered_parents
|
||||
of [] => NONE
|
||||
| xs => SOME (path_of_classifier (hd xs)),
|
||||
| xs => SOME ((* path_of_classifier *) (hd xs)),
|
||||
attributes = map (transform_attribute t) attributes,
|
||||
operations = map (transform_operation t) operations,
|
||||
invariant = map ((transform_constraint t) o
|
||||
|
@ -369,10 +369,10 @@ fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf,
|
|||
val filtered_parents = filter (fn x => x <> Rep_OclType.OclAny) parents
|
||||
val checked_invariants = filter_exists t invariant
|
||||
in
|
||||
Rep.Class {name = path_of_classifier (find_classifier_type t xmiid),
|
||||
Rep.Class {name = (* path_of_classifier *) (find_classifier_type t xmiid),
|
||||
parent = case filtered_parents
|
||||
of [] => NONE
|
||||
| xs => SOME (path_of_classifier (hd xs)),
|
||||
| xs => SOME ((*path_of_classifier *) (hd xs)),
|
||||
attributes = map (transform_attribute t) attributes,
|
||||
operations = map (transform_operation t) operations,
|
||||
invariant = map ((transform_constraint t) o
|
||||
|
@ -388,8 +388,8 @@ fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf,
|
|||
operations,invariant}) =
|
||||
let val checked_invariants = filter_exists t invariant
|
||||
in
|
||||
Rep.Primitive {name = case find_classifier_type t xmiid of Rep_OclType.Classifier x => x
|
||||
| _ => raise Option,
|
||||
Rep.Primitive {name = (* case *) find_classifier_type t xmiid (*of Rep_OclType.Classifier x => x
|
||||
| _ => raise Option*) ,
|
||||
parent = NONE, (* FIX *)
|
||||
operations = map (transform_operation t) operations,
|
||||
associationends = map (transform_aend t)
|
||||
|
@ -404,8 +404,8 @@ fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf,
|
|||
operations,literals,invariant}) =
|
||||
let val checked_invariants = filter_exists t invariant
|
||||
in
|
||||
Rep.Enumeration {name = case find_classifier_type t xmiid of Rep_OclType.Classifier x => x
|
||||
| _ => raise Option,
|
||||
Rep.Enumeration {name = (* case *) find_classifier_type t xmiid (* of Rep_OclType.Classifier x => x
|
||||
| _ => raise Option *),
|
||||
parent = NONE, (* FIX *)
|
||||
literals = literals,
|
||||
operations = map (transform_operation t) operations,
|
||||
|
|
|
@ -473,7 +473,7 @@ val role =
|
|||
visibility=public}],
|
||||
interfaces=[],
|
||||
invariant=[],
|
||||
name=["AuthorizationEnvironment","Role"],
|
||||
name=Classifier ["AuthorizationEnvironment","Role"],
|
||||
operations=[{arguments=[("s",String)],
|
||||
isQuery=false,
|
||||
name="getRoleByName",
|
||||
|
@ -508,7 +508,7 @@ val identity =
|
|||
visibility=public}],
|
||||
interfaces=[],
|
||||
invariant=[],
|
||||
name=["AuthorizationEnvironment","Identity"],
|
||||
name=Classifier ["AuthorizationEnvironment","Identity"],
|
||||
operations=[],
|
||||
parent=NONE,
|
||||
stereotypes=[],
|
||||
|
@ -528,7 +528,7 @@ val static_auth_env = [
|
|||
attributes=[],
|
||||
interfaces=[],
|
||||
invariant=[],
|
||||
name=["AuthorizationEnvironment","Context"],
|
||||
name=Classifier ["AuthorizationEnvironment","Context"],
|
||||
operations=[],
|
||||
parent=NONE,
|
||||
stereotypes=[],
|
||||
|
@ -552,7 +552,7 @@ val static_auth_env = [
|
|||
attributes=[],
|
||||
interfaces=[],
|
||||
invariant=[],
|
||||
name=["AuthorizationEnvironment","Principal"],
|
||||
name=Classifier ["AuthorizationEnvironment","Principal"],
|
||||
operations=[{arguments=[("s",String)],
|
||||
isQuery=false,
|
||||
name="isInRole",
|
||||
|
|
|
@ -136,15 +136,15 @@ fun filter_subject cs = List.filter (classifier_has_stereotype "secuml.user") cs
|
|||
fun filter_role cs = List.filter (classifier_has_stereotype "secuml.role") cs
|
||||
|
||||
|
||||
fun mkRole (Rep.Class c) = Rep.string_of_path (#name c)
|
||||
fun mkRole (C as Rep.Class c) = Rep.string_of_path (Rep.name_of C)
|
||||
| mkRole _ = library.error "mkRole called on something that is \
|
||||
\not a class"
|
||||
|
||||
(* FIXME: handle groups also *)
|
||||
fun mkSubject (Rep.Class c) = User (Rep.string_of_path (#name c))
|
||||
fun mkSubject (C as Rep.Class c) = User (Rep.string_of_path (Rep.name_of C))
|
||||
| mkSubject _ = library.error "mkSubject called on something that is not a class"
|
||||
|
||||
fun mkPermission cs (Rep.Class c) =
|
||||
fun mkPermission cs (C as Rep.Class c) =
|
||||
let val atts = Rep.attributes_of (Rep.Class c)
|
||||
val classifiers = List.mapPartial (fn (Rep_OclType.Classifier p)
|
||||
=> SOME (Rep.class_of p cs)
|
||||
|
@ -158,7 +158,7 @@ fun mkPermission cs (Rep.Class c) =
|
|||
classifiers
|
||||
val root_resource = hd root_classes
|
||||
handle Empty => library.error ("no root resource found for permission "^
|
||||
Rep.string_of_path (#name c))
|
||||
Rep.string_of_path (Rep.name_of C))
|
||||
val action_attributes =
|
||||
List.filter (fn x => List.exists
|
||||
(fn y => List.exists
|
||||
|
@ -167,13 +167,13 @@ fun mkPermission cs (Rep.Class c) =
|
|||
Design.action_stereotypes) atts
|
||||
handle _ => library.error "could not parse permission attributes"
|
||||
in
|
||||
{ name = (Rep.string_of_path (#name c)),
|
||||
{ name = (Rep.string_of_path (Rep.name_of C)),
|
||||
roles = (map (Rep.string_of_path o Rep.name_of) role_classes),
|
||||
(* FIXME: find attached constraints *)
|
||||
constraints = nil,
|
||||
actions = if action_attributes = []
|
||||
then library.error ("no action attributes found in permission "^
|
||||
(Rep.string_of_path (#name c)))
|
||||
(Rep.string_of_path (Rep.name_of C)))
|
||||
else map (Design.parse_action root_resource) action_attributes }
|
||||
end
|
||||
| mkPermission _ _ = library.error "mkPermission called on something \
|
||||
|
|
Loading…
Reference in New Issue