2005-08-17 15:45:10 +00:00
|
|
|
(*****************************************************************************
|
2005-08-18 05:55:15 +00:00
|
|
|
* su4sml - a SecureUML repository for SML
|
2005-08-17 15:45:10 +00:00
|
|
|
*
|
|
|
|
* mdr_core.sig - generic meta data repository import signature for su4sml
|
|
|
|
* Copyright (C) 2001-2005 Achim D. Brucker <brucker@inf.ethz.ch>
|
|
|
|
* Burkhart Wolff <bwolff@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.
|
|
|
|
******************************************************************************)
|
|
|
|
|
2005-09-07 18:23:24 +00:00
|
|
|
structure Rep_Core : REP_CORE =
|
2005-08-17 15:45:10 +00:00
|
|
|
struct
|
2005-09-14 13:24:57 +00:00
|
|
|
open library
|
2005-10-20 13:03:44 +00:00
|
|
|
|
|
|
|
type Visibility = XMI_DataTypes.VisibilityKind
|
|
|
|
type Scope = XMI_DataTypes.ScopeKind
|
|
|
|
|
2005-08-17 15:45:10 +00:00
|
|
|
type operation = { name : string,
|
2005-09-07 18:23:24 +00:00
|
|
|
precondition : (string option * Rep_OclTerm.OclTerm) list,
|
|
|
|
postcondition : (string option * Rep_OclTerm.OclTerm) list,
|
|
|
|
arguments : (string * Rep_OclType.OclType) list,
|
|
|
|
result : Rep_OclType.OclType,
|
2005-10-20 13:03:44 +00:00
|
|
|
isQuery : bool,
|
|
|
|
visibility : Visibility,
|
|
|
|
scope : Scope }
|
2005-08-17 15:45:10 +00:00
|
|
|
|
|
|
|
type associationend = {name : string,
|
2005-09-07 18:23:24 +00:00
|
|
|
aend_type: Rep_OclType.OclType,
|
2005-08-17 15:45:10 +00:00
|
|
|
multiplicity: (int*int) list,
|
2005-10-20 13:03:44 +00:00
|
|
|
visibility: Visibility,
|
2005-08-17 17:22:10 +00:00
|
|
|
ordered: bool }
|
2005-08-17 15:45:10 +00:00
|
|
|
|
|
|
|
datatype Classifier =
|
|
|
|
Class of
|
2005-09-07 18:23:24 +00:00
|
|
|
{ name : Rep_OclType.Path,
|
|
|
|
parent : Rep_OclType.Path option,
|
2005-10-20 13:03:44 +00:00
|
|
|
attributes : (string * Rep_OclType.OclType * Visibility * Scope) list,
|
2005-08-17 15:45:10 +00:00
|
|
|
operations : operation list,
|
|
|
|
associationends : associationend list,
|
2005-09-07 18:23:24 +00:00
|
|
|
invariant : (string option * Rep_OclTerm.OclTerm) list,
|
2005-08-17 15:45:10 +00:00
|
|
|
stereotypes : string list,
|
2005-09-07 18:23:24 +00:00
|
|
|
interfaces : Rep_OclType.Path list,
|
2005-09-07 17:02:47 +00:00
|
|
|
thyname : string option,
|
2005-09-07 17:44:26 +00:00
|
|
|
activity_graphs : Rep_ActivityGraph.ActivityGraph list
|
2005-08-17 15:45:10 +00:00
|
|
|
}
|
|
|
|
| Interface of (* not supported yet *)
|
2005-09-07 18:23:24 +00:00
|
|
|
{ name : Rep_OclType.Path,
|
|
|
|
parents : Rep_OclType.Path list,
|
2005-08-17 15:45:10 +00:00
|
|
|
operations : operation list,
|
|
|
|
stereotypes : string list,
|
2005-09-07 18:23:24 +00:00
|
|
|
invariant : (string option * Rep_OclTerm.OclTerm) list,
|
2005-08-17 15:45:10 +00:00
|
|
|
thyname : string option
|
|
|
|
}
|
|
|
|
| Enumeration of (* not really supported yet? *)
|
2005-09-07 18:23:24 +00:00
|
|
|
{ name : Rep_OclType.Path,
|
|
|
|
parent : Rep_OclType.Path option,
|
2005-08-17 15:45:10 +00:00
|
|
|
operations : operation list,
|
|
|
|
literals : string list,
|
2005-09-07 18:23:24 +00:00
|
|
|
invariant : (string option * Rep_OclTerm.OclTerm) list,
|
2005-08-17 15:45:10 +00:00
|
|
|
stereotypes : string list,
|
2005-09-07 18:23:24 +00:00
|
|
|
interfaces : Rep_OclType.Path list,
|
2005-08-17 15:45:10 +00:00
|
|
|
thyname : string option
|
|
|
|
}
|
|
|
|
| Primitive of (* not really supported yet *)
|
2005-09-07 18:23:24 +00:00
|
|
|
{ name : Rep_OclType.Path,
|
|
|
|
parent : Rep_OclType.Path option,
|
2005-08-17 15:45:10 +00:00
|
|
|
operations : operation list,
|
|
|
|
associationends : associationend list,
|
2005-09-07 18:23:24 +00:00
|
|
|
invariant : (string option * Rep_OclTerm.OclTerm) list,
|
2005-08-17 15:45:10 +00:00
|
|
|
stereotypes : string list,
|
2005-09-07 18:23:24 +00:00
|
|
|
interfaces : Rep_OclType.Path list,
|
2005-08-17 15:45:10 +00:00
|
|
|
thyname : string option
|
|
|
|
}
|
2005-08-20 20:50:18 +00:00
|
|
|
|
2005-08-17 17:22:10 +00:00
|
|
|
(* convert an association end into the corresponding collection type *)
|
2005-10-20 13:03:44 +00:00
|
|
|
fun assoc_to_attr_type {name,aend_type,multiplicity,ordered,visibility} =
|
2005-10-24 19:51:49 +00:00
|
|
|
case multiplicity of
|
|
|
|
[(0,1)] => aend_type
|
|
|
|
| [(1,1)] => aend_type
|
|
|
|
| _ =>if ordered then Rep_OclType.Sequence aend_type (* OrderedSet? *)
|
|
|
|
else Rep_OclType.Set aend_type
|
2005-08-17 17:22:10 +00:00
|
|
|
|
|
|
|
(* convert an association end into an attribute of the *)
|
|
|
|
(* corresponding collection type *)
|
2005-10-20 13:03:44 +00:00
|
|
|
fun assoc_to_attr (assoc:associationend) = (#name assoc,
|
|
|
|
assoc_to_attr_type assoc,
|
|
|
|
#visibility assoc,
|
|
|
|
XMI.InstanceScope)
|
2005-08-17 15:45:10 +00:00
|
|
|
|
2005-08-17 17:22:10 +00:00
|
|
|
(* convert a multiplicity range into an invariant of the form *)
|
|
|
|
(* size > lowerBound and size < upperBound ) *)
|
|
|
|
fun range_to_inv cls_name aend (a,b) =
|
2005-09-07 18:23:24 +00:00
|
|
|
let val cls = Rep_OclType.Classifier cls_name
|
2005-08-17 17:22:10 +00:00
|
|
|
val attr_type = assoc_to_attr_type aend
|
|
|
|
val attr_name = cls_name@[#name aend]
|
2005-09-07 18:23:24 +00:00
|
|
|
val literal_a = Rep_OclTerm.Literal (Int.toString a, Rep_OclType.Integer)
|
|
|
|
val literal_b = Rep_OclTerm.Literal (Int.toString b, Rep_OclType.Integer)
|
|
|
|
val self = Rep_OclTerm.Variable ("self",cls)
|
|
|
|
val attribute = Rep_OclTerm.AttributeCall (self,cls,attr_name,attr_type)
|
2005-08-17 17:22:10 +00:00
|
|
|
val attribute_size =
|
2005-09-07 18:23:24 +00:00
|
|
|
Rep_OclTerm.OperationCall (attribute,attr_type,
|
2005-08-17 17:22:10 +00:00
|
|
|
["oclLib","Collection","size"],[],
|
2005-09-07 18:23:24 +00:00
|
|
|
Rep_OclType.Integer)
|
2005-08-17 17:22:10 +00:00
|
|
|
val lower_bound =
|
2005-09-07 18:23:24 +00:00
|
|
|
Rep_OclTerm.OperationCall (attribute_size,Rep_OclType.Integer,
|
2005-08-17 17:22:10 +00:00
|
|
|
["oclLib","Real",">="],
|
2005-09-07 18:23:24 +00:00
|
|
|
[(literal_a,Rep_OclType.Integer)],Rep_OclType.Boolean)
|
2005-08-17 17:22:10 +00:00
|
|
|
val upper_bound =
|
2005-09-07 18:23:24 +00:00
|
|
|
Rep_OclTerm.OperationCall (attribute_size,Rep_OclType.Integer,
|
2005-08-17 17:22:10 +00:00
|
|
|
["oclLib","Real","<="],
|
2005-09-07 18:23:24 +00:00
|
|
|
[(literal_b,Rep_OclType.Integer)],Rep_OclType.Boolean)
|
2005-08-17 17:22:10 +00:00
|
|
|
val equal =
|
2005-09-07 18:23:24 +00:00
|
|
|
Rep_OclTerm.OperationCall (attribute_size,Rep_OclType.Integer,
|
2005-08-17 17:22:10 +00:00
|
|
|
["oclLib","OclAny","="],
|
2005-09-07 18:23:24 +00:00
|
|
|
[(literal_a,Rep_OclType.Integer)],Rep_OclType.Boolean)
|
2005-08-17 17:22:10 +00:00
|
|
|
in
|
|
|
|
if a = b then equal
|
|
|
|
else if b = ~1 then lower_bound
|
2005-09-07 18:23:24 +00:00
|
|
|
else Rep_OclTerm.OperationCall (lower_bound,Rep_OclType.Boolean,
|
2005-08-17 17:22:10 +00:00
|
|
|
["oclLib","Boolean","and"],
|
2005-09-07 18:23:24 +00:00
|
|
|
[(upper_bound,Rep_OclType.Boolean)],
|
|
|
|
Rep_OclType.Boolean)
|
2005-08-17 17:22:10 +00:00
|
|
|
end
|
|
|
|
|
|
|
|
(* calculate the invariants of an association end: *)
|
|
|
|
(* 1. multiplicity constraints *)
|
|
|
|
(* 2. consistency constraints between opposing association ends *)
|
|
|
|
(* i.e., A.b.a->includes(A) *)
|
|
|
|
(* FIXME: 2. is not implemented yet... *)
|
|
|
|
fun assoc_to_inv cls_name (aend:associationend) =
|
2005-08-23 15:38:39 +00:00
|
|
|
let val inv_name = "multiplicity_constraint_for_association_end_"^(#name aend)
|
2005-10-24 19:51:49 +00:00
|
|
|
val range_constraints = case (#multiplicity aend) of
|
|
|
|
[(0,1)] => let
|
|
|
|
val attr_name = cls_name@[#name aend]
|
|
|
|
val attr_type = assoc_to_attr_type aend
|
|
|
|
val cls = Rep_OclType.Classifier cls_name
|
|
|
|
val self = Rep_OclTerm.Variable ("self",cls)
|
|
|
|
val attribute = Rep_OclTerm.AttributeCall (self,cls,attr_name,attr_type)
|
|
|
|
in
|
|
|
|
[Rep_OclTerm.OperationCall (attribute,attr_type,
|
|
|
|
["oclIsDefined"],[],
|
|
|
|
Rep_OclType.Boolean)]
|
|
|
|
end
|
|
|
|
| [(1,1)] => [] (* FIXME: should be aend->OclIsDefined() *)
|
|
|
|
| _ => map (range_to_inv cls_name aend)
|
|
|
|
(#multiplicity aend)
|
2005-08-17 17:22:10 +00:00
|
|
|
fun ocl_or (x,y) =
|
2005-09-07 18:23:24 +00:00
|
|
|
Rep_OclTerm.OperationCall (x,Rep_OclType.Boolean,
|
2005-08-17 17:22:10 +00:00
|
|
|
["oclLib","Boolean","or"],
|
2005-09-07 18:23:24 +00:00
|
|
|
[(y,Rep_OclType.Boolean)],Rep_OclType.Boolean)
|
2005-08-17 17:22:10 +00:00
|
|
|
in if range_constraints = []
|
2005-09-07 18:23:24 +00:00
|
|
|
then (SOME inv_name, Rep_OclTerm.Literal ("true",Rep_OclType.Boolean))
|
2005-08-17 17:22:10 +00:00
|
|
|
else (SOME inv_name, foldr1 ocl_or range_constraints)
|
|
|
|
end
|
|
|
|
|
|
|
|
(* convert association ends into attributes + invariants *)
|
|
|
|
fun normalize (Class {name,parent,attributes,operations,associationends,invariant,
|
2005-09-07 17:02:47 +00:00
|
|
|
stereotypes,interfaces,thyname,activity_graphs}) =
|
2005-08-17 17:22:10 +00:00
|
|
|
Class {name = name,
|
|
|
|
parent = parent,
|
|
|
|
attributes = (append (map assoc_to_attr associationends)
|
|
|
|
attributes),
|
|
|
|
operations = operations,
|
|
|
|
associationends = nil,
|
|
|
|
invariant = append (map (assoc_to_inv name) associationends)
|
|
|
|
invariant,
|
|
|
|
stereotypes = stereotypes,
|
|
|
|
interfaces = interfaces,
|
2005-09-07 17:02:47 +00:00
|
|
|
thyname = thyname,
|
|
|
|
activity_graphs=activity_graphs}
|
2005-08-17 17:22:10 +00:00
|
|
|
| normalize (Primitive p) =
|
|
|
|
(* Primitive's do not have attributes, so we have to convert *)
|
|
|
|
(* them into Classes... *)
|
|
|
|
if (#associationends p) = []
|
|
|
|
then Primitive p
|
|
|
|
else normalize (Class {name = #name p, parent = #parent p, attributes=[],
|
|
|
|
operations = #operations p, invariant = #invariant p,
|
|
|
|
associationends = #associationends p,
|
|
|
|
stereotypes = #stereotypes p,
|
|
|
|
interfaces = #interfaces p,
|
2005-09-07 17:02:47 +00:00
|
|
|
thyname = #thyname p,
|
|
|
|
activity_graphs=nil})
|
2005-08-17 17:22:10 +00:00
|
|
|
| normalize c = c
|
2005-08-17 15:45:10 +00:00
|
|
|
|
|
|
|
val OclAnyC = Class{name=["OclAny"],parent=NONE,attributes=[],
|
|
|
|
operations=[], interfaces=[],
|
|
|
|
invariant=[],stereotypes=[], associationends=[],
|
2005-09-07 17:02:47 +00:00
|
|
|
thyname=NONE,
|
|
|
|
activity_graphs=nil}
|
2005-08-17 15:45:10 +00:00
|
|
|
|
2005-08-17 17:22:10 +00:00
|
|
|
|
2005-09-07 18:23:24 +00:00
|
|
|
fun string_of_path (path:Rep_OclType.Path) = case path of
|
2005-08-17 15:45:10 +00:00
|
|
|
[] => ""
|
|
|
|
| p => foldr1 (fn (a,b) => a^"."^b) p
|
|
|
|
|
|
|
|
|
|
|
|
|
2005-09-07 17:02:47 +00:00
|
|
|
fun update_thyname tname (Class{name,parent,attributes,operations,invariant,
|
|
|
|
stereotypes,interfaces,associationends,activity_graphs,...})
|
|
|
|
= Class{name=name,parent=parent,attributes=attributes,operations=operations,
|
|
|
|
associationends=associationends,invariant=invariant,stereotypes=stereotypes,
|
|
|
|
interfaces=interfaces,thyname=(SOME tname),activity_graphs=activity_graphs }
|
2005-08-17 15:45:10 +00:00
|
|
|
| update_thyname tname (Interface{name,parents,operations,stereotypes,invariant,...})
|
2005-09-07 17:02:47 +00:00
|
|
|
= Interface{name=name,parents=parents,operations=operations,stereotypes=stereotypes,
|
|
|
|
invariant=invariant,thyname=(SOME tname)}
|
|
|
|
| update_thyname tname (Enumeration{name,parent,operations,literals,invariant,
|
|
|
|
stereotypes,interfaces,...})
|
|
|
|
= Enumeration{name=name,parent=parent,operations=operations,literals=literals,
|
|
|
|
invariant=invariant,stereotypes=stereotypes,interfaces=interfaces,
|
|
|
|
thyname=(SOME tname)}
|
|
|
|
| update_thyname tname (Primitive{name,parent,operations,associationends,invariant,
|
|
|
|
stereotypes,interfaces,...})
|
|
|
|
= Primitive{name=name,parent=parent,operations=operations,
|
|
|
|
associationends=associationends,invariant=invariant,
|
|
|
|
stereotypes=stereotypes,interfaces=interfaces,thyname=(SOME tname)}
|
2005-08-17 15:45:10 +00:00
|
|
|
|
|
|
|
|
|
|
|
fun name_of (Class{name,...}) = name
|
|
|
|
| name_of (Interface{name,...}) = name
|
|
|
|
| name_of (Enumeration{name,...}) = name
|
|
|
|
| name_of (Primitive{name,...}) = name
|
|
|
|
|
|
|
|
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
|
|
|
|
|
|
|
|
|
|
|
|
|
2005-09-07 17:02:47 +00:00
|
|
|
fun package_of (Class{name,...}) = if (length name) > 1
|
|
|
|
then take (((length name) -1),name)
|
|
|
|
else []
|
|
|
|
| package_of (Interface{name,...}) = if (length name) > 1
|
|
|
|
then take (((length name) -1),name)
|
|
|
|
else []
|
|
|
|
| package_of (Enumeration{name,...}) = if (length name) > 1
|
|
|
|
then take (((length name) -1),name)
|
|
|
|
else []
|
|
|
|
| package_of (Primitive{name,...}) = if (length name) > 1
|
|
|
|
then take (((length name) -1),name)
|
|
|
|
else []
|
|
|
|
|
|
|
|
fun parent_name_of (C as Class{parent,...}) =
|
|
|
|
(case parent of NONE => name_of OclAnyC
|
|
|
|
|SOME p => 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 )
|
|
|
|
| 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 )
|
2005-08-17 15:45:10 +00:00
|
|
|
|
2005-09-07 17:02:47 +00:00
|
|
|
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 )
|
2005-08-17 15:45:10 +00:00
|
|
|
|
|
|
|
|
2005-09-07 17:02:47 +00:00
|
|
|
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 [])
|
|
|
|
| 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 [])
|
|
|
|
| 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 [])
|
2005-08-17 15:45:10 +00:00
|
|
|
|
|
|
|
|
|
|
|
fun attributes_of (Class{attributes,...}) = attributes
|
2005-09-07 17:02:47 +00:00
|
|
|
| attributes_of (Interface{...}) =
|
|
|
|
error "attributes_of <Interface> not supported"
|
|
|
|
| attributes_of (Enumeration{...}) =
|
|
|
|
error "attributes_of <Enumeration> not supported"
|
|
|
|
| attributes_of (Primitive{...}) = []
|
|
|
|
(* error "attributes_of <Primitive> not supported" *)
|
2005-08-17 15:45:10 +00:00
|
|
|
|
|
|
|
fun operations_of (Class{operations,...}) = operations
|
2005-09-07 17:02:47 +00:00
|
|
|
| operations_of (Interface{...}) =
|
|
|
|
error "operations_of <Interface> not supported"
|
|
|
|
| operations_of (Enumeration{...}) =
|
|
|
|
error "operations_of <Enumeration> not supported"
|
|
|
|
| operations_of (Primitive{...}) = []
|
|
|
|
(* error "operations_of <Primitive> not supported" *)
|
2005-08-17 15:45:10 +00:00
|
|
|
|
|
|
|
|
|
|
|
fun p_invariant_of (Class{invariant,...}) = invariant
|
|
|
|
| p_invariant_of (Interface{invariant,...}) = invariant
|
|
|
|
| p_invariant_of (Enumeration{invariant,...}) = invariant
|
|
|
|
| p_invariant_of (Primitive{invariant,...}) = invariant
|
|
|
|
|
|
|
|
fun invariant_of C = case p_invariant_of C of
|
2005-09-07 18:23:24 +00:00
|
|
|
[] => [(NONE, Rep_OclTerm.Literal ("true",Rep_OclType.Boolean))]
|
2005-08-17 15:45:10 +00:00
|
|
|
| il => il
|
|
|
|
|
|
|
|
|
|
|
|
fun precondition_of_op ({precondition,...}:operation) = case precondition of
|
2005-09-07 18:23:24 +00:00
|
|
|
[] => [(NONE, Rep_OclTerm.Literal ("true",Rep_OclType.Boolean))]
|
2005-08-17 15:45:10 +00:00
|
|
|
| il => il
|
|
|
|
|
|
|
|
|
|
|
|
fun postcondition_of_op ({postcondition, ...}:operation) = case postcondition of
|
2005-09-07 18:23:24 +00:00
|
|
|
[] => [(NONE, Rep_OclTerm.Literal ("true",Rep_OclType.Boolean))]
|
2005-08-17 15:45:10 +00:00
|
|
|
| il => il
|
|
|
|
|
|
|
|
fun name_of_op ({name,...}:operation) = name
|
|
|
|
|
2005-08-24 11:47:57 +00:00
|
|
|
fun mangled_name_of_op ({name,arguments,result,...}:operation) =
|
2005-08-17 15:45:10 +00:00
|
|
|
let
|
2005-09-26 16:20:14 +00:00
|
|
|
val arg_typestrs = map (fn a => (Rep_OclType.string_of_OclType o #2 ) a ) arguments
|
2005-08-17 15:45:10 +00:00
|
|
|
in
|
2005-09-07 17:02:47 +00:00
|
|
|
foldr1 (fn (a,b) =>(a^"_"^b))
|
2005-09-07 18:23:24 +00:00
|
|
|
((name::arg_typestrs)@[Rep_OclType.string_of_OclType result])
|
2005-08-17 15:45:10 +00:00
|
|
|
end
|
|
|
|
|
|
|
|
fun result_of_op ({result,...}:operation) = result
|
|
|
|
|
|
|
|
fun arguments_of_op ({arguments,...}:operation) = arguments
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
2005-09-07 17:02:47 +00:00
|
|
|
fun thy_name_of (C as Class{thyname,...}) =
|
|
|
|
(case thyname of SOME tname => tname
|
|
|
|
| NONE => error ("Class "^((string_of_path o name_of) C)^
|
|
|
|
" has no thyname"))
|
|
|
|
| thy_name_of (I as Interface{thyname,...}) =
|
|
|
|
(case thyname of SOME tname => tname
|
|
|
|
| NONE => error ("Interface "^((string_of_path o name_of) I)
|
|
|
|
^" has no thyname"))
|
|
|
|
| thy_name_of (E as Enumeration{thyname,...}) =
|
|
|
|
(case thyname of SOME tname => tname
|
|
|
|
| NONE => error ("Enumeration "^((string_of_path o name_of) E)
|
|
|
|
^" has no thyname"))
|
|
|
|
| thy_name_of (P as Primitive{thyname,...}) =
|
|
|
|
(case thyname of SOME tname => tname
|
|
|
|
| NONE => error ("Primitive "^((string_of_path o name_of) P)^
|
|
|
|
" has no thyname"))
|
2005-08-17 15:45:10 +00:00
|
|
|
|
|
|
|
end
|