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

parse Iterate expressions (needed to change oclterm type for that, so please check) 

git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@3330 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Jürgen Doser 2005-11-09 18:06:29 +00:00
parent ba702bdaf1
commit 06871fd6ee
6 changed files with 133 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/ocl2string.sml
View File

@ -170,7 +170,7 @@ fun ocl2string show_types oclterm =
(* Iterate *)
(**************************************)
(* Error *)
| Iterate (_,s,_,src,_,c,_,_) => error ("error: unknown Iterate '"^(s)^"' in in ocl2string")
| Iterate (_,s,_,_,src,_,c,_,_) => error ("error: unknown Iterate '"^(s)^"' in in ocl2string")
(**************************************)
(* Iterator *)
(**************************************)

47
src/rep_ocl.sig
View File

@ -43,19 +43,36 @@ sig
include REP_OCL_TYPE
datatype OclTerm =
Literal of string * OclType
| If of OclTerm * OclType
* OclTerm * OclType
* OclTerm * OclType * OclType
| AssociationEndCall of OclTerm * OclType * Path * OclType
| AttributeCall of OclTerm * OclType * Path * OclType
| OperationCall of OclTerm * OclType * Path
* (OclTerm * OclType) list * OclType
| OperationWithType of OclTerm * OclType * string * OclType * OclType
| Variable of string * OclType
| Let of string * OclType * OclTerm * OclType * OclTerm * OclType
| Iterate of (string * OclType) list * string * OclType
* OclTerm * OclType * OclTerm * OclType * OclType
| Iterator of string * (string * OclType) list
* OclTerm * OclType * OclTerm * OclType * OclType
Literal of string * OclType (* Literal with type *)
| If of OclTerm * OclType (* condition *)
* OclTerm * OclType (* then *)
* OclTerm * OclType (* else *)
* OclType (* result type *)
| AssociationEndCall of OclTerm * OclType (* source *)
* Path (* assoc.-enc *)
* OclType (* result type *)
| AttributeCall of OclTerm * OclType (* source *)
* Path (* attribute *)
* OclType (* result type *)
| OperationCall of OclTerm * OclType (* source *)
* Path (* operation *)
* (OclTerm * OclType) list (* parameters *)
* OclType (* result tupe *)
| OperationWithType of OclTerm * OclType (* source *)
* string * OclType (* type parameter *)
* OclType (* result type *)
| Variable of string * OclType (* name with type *)
| Let of string * OclType (* variable *)
* OclTerm * OclType (* rhs *)
* OclTerm * OclType (* in *)
| Iterate of (string * OclType) list (* iterator variables *)
* string * OclType * OclTerm (* result variable *)
* OclTerm * OclType (* source *)
* OclTerm * OclType (* iterator body *)
* OclType (* result type *)
| Iterator of string (* name of iterator *)
* (string * OclType) list (* iterator variables *)
* OclTerm * OclType (* source *)
* OclTerm * OclType (* iterator-body *)
* OclType (* result type *)
end

47
src/rep_ocl.sml
View File

@ -61,20 +61,37 @@ struct
open Rep_OclType
datatype OclTerm =
Literal of string * OclType
| If of OclTerm * OclType
* OclTerm * OclType
* OclTerm * OclType * OclType
| AssociationEndCall of OclTerm * OclType * Path * OclType
| AttributeCall of OclTerm * OclType * Path * OclType
| OperationCall of OclTerm * OclType * Path
* (OclTerm * OclType) list * OclType
| OperationWithType of OclTerm * OclType * string * OclType * OclType
| Variable of string * OclType
| Let of string * OclType * OclTerm * OclType * OclTerm * OclType
| Iterate of (string * OclType) list * string * OclType
* OclTerm * OclType * OclTerm * OclType * OclType
| Iterator of string * (string * OclType) list
* OclTerm * OclType * OclTerm * OclType * OclType
Literal of string * OclType (* Literal with type *)
| If of OclTerm * OclType (* condition *)
* OclTerm * OclType (* then *)
* OclTerm * OclType (* else *)
* OclType (* result type *)
| AssociationEndCall of OclTerm * OclType (* source *)
* Path (* assoc.-enc *)
* OclType (* result type *)
| AttributeCall of OclTerm * OclType (* source *)
* Path (* attribute *)
* OclType (* result type *)
| OperationCall of OclTerm * OclType (* source *)
* Path (* operation *)
* (OclTerm * OclType) list (* parameters *)
* OclType (* result tupe *)
| OperationWithType of OclTerm * OclType (* source *)
* string * OclType (* type parameter *)
* OclType (* result type *)
| Variable of string * OclType (* name with type *)
| Let of string * OclType (* variable *)
* OclTerm * OclType (* rhs *)
* OclTerm * OclType (* in *)
| Iterate of (string * OclType) list (* iterator variables *)
* string * OclType * OclTerm (* result variable *)
* OclTerm * OclType (* source *)
* OclTerm * OclType (* iterator body *)
* OclType (* result type *)
| Iterator of string (* name of iterator *)
* (string * OclType) list (* iterator variables *)
* OclTerm * OclType (* source *)
* OclTerm * OclType (* iterator-body *)
* OclType (* result type *)
end

12
src/xmi2rep.sml
View File

@ -101,6 +101,18 @@ fun transform_expression t (XMI.LiteralExp {symbol,expression_type}) =
find_classifier_type t expression_type
)
end
| transform_expression t (XMI.IterateExp {result,iterators,body,source,expression_type}) =
let val _ = map (insert_variable_dec t) (result::iterators )
in
Rep_OclTerm.Iterate ( map (fn x => (#name x, find_classifier_type t (#declaration_type x))) iterators,
#name result,
find_classifier_type t (#declaration_type result),
transform_expression t (valOf (#init result)),
transform_expression t source, find_classifier_type t (XMI.expression_type_of source),
transform_expression t body, find_classifier_type t (XMI.expression_type_of body),
find_classifier_type t expression_type
)
end
| transform_expression t _ = raise NotYetImplemented

32
src/xmi_ocl.sml
View File

@ -32,24 +32,12 @@
structure XMI_OCL =
struct
(* from OCL 2.0 Expressions: -------------------------------------------------
* A VariableDeclaration declares a variable name and binds it to a type. The
* variable can be used in expressions where the variable is in scope. This
* metaclass represents amongst others the variables self and result and the
* variables defined using the Let expression.
* not supported: initExpression
* --------------------------------------------------------------------------*)
type VariableDeclaration = { xmiid: string,
name: string,
declaration_type: string }
datatype 'a ptr = IdRef of string | P of 'a
(* FIX: LiteralExp should probably be renamed to PrimitiveLiteralExp *)
(* FIX: there should be also EnumLiteralExp and TupleLiteralExp *)
datatype OCLExpression = LiteralExp of { symbol : string,
expression_type : string }
| CollectionLiteralExp of { parts: CollectionLiteralPart ptr list,
| CollectionLiteralExp of { parts: CollectionLiteralPart list,
expression_type : string}
| IfExp of { condition : OCLExpression,
thenExpression : OCLExpression,
@ -75,7 +63,6 @@ datatype OCLExpression = LiteralExp of { symbol : string,
| VariableExp of { referredVariable: string,
expression_type : string }
| LetExp of { variable : VariableDeclaration,
initExpression : OCLExpression,
inExpression : OCLExpression,
expression_type : string }
| IterateExp of { iterators : VariableDeclaration list,
@ -88,11 +75,22 @@ datatype OCLExpression = LiteralExp of { symbol : string,
body : OCLExpression,
source : OCLExpression,
expression_type : string}
and CollectionLiteralPart = CollectionItem of { item : OCLExpression ptr,
and CollectionLiteralPart = CollectionItem of { item : OCLExpression,
expression_type: string }
| CollectionRange of { first: OCLExpression ptr,
last: OCLExpression ptr,
| CollectionRange of { first: OCLExpression,
last: OCLExpression,
expression_type: string}
(* from OCL 2.0 Expressions: -------------------------------------------------
* A VariableDeclaration declares a variable name and binds it to a type. The
* variable can be used in expressions where the variable is in scope. This
* metaclass represents amongst others the variables self and result and the
* variables defined using the Let expression.
* not supported: initExpression
* --------------------------------------------------------------------------*)
withtype VariableDeclaration = { xmiid: string,
name: string,
declaration_type: string,
init: OCLExpression option}
fun expression_type_of (LiteralExp{expression_type,...}) = expression_type

64
src/xml2xmi.sml
View File

@ -232,18 +232,6 @@ fun mkAssociation tree =
handle XmlTree.IllFormed msg => raise IllFormed ("in mkAssociation: "^msg)
end
fun mkVariableDec tree =
let fun f atts trees =
{ xmiid = getXmiId atts,
name = getName atts,
declaration_type = (getXmiIdref o XmlTree.attributes_of o hd o
(XmlTree.follow "OCL.Expressions.VariableDeclaration.type")) trees
}
in XmlTree.apply_on "UML15OCL.Expressions.VariableDeclaration" f tree
handle XmlTree.IllFormed msg => raise IllFormed ("in mkVariableDec: "^msg)
end
(* find the xmi.idref attribute of an element pinted to by name *)
fun findXmiIdRef name trees = (getXmiIdref o XmlTree.attributes_of o hd)
(XmlTree.follow name trees)
@ -261,7 +249,7 @@ val triv_expr = XMI.LiteralExp {symbol = "true",
expression_type = "bool" }
(* FIX: this is only a dummy implementation *)
fun mkCollectionLiteralPart x = XMI_OCL.IdRef (getXmiIdref (XmlTree.attributes_of x))
fun mkCollectionLiteralPart x = (getXmiIdref (XmlTree.attributes_of x))
fun mkOCLExpression tree =
let val elem = XmlTree.tagname_of tree
@ -281,7 +269,7 @@ fun mkOCLExpression tree =
XMI.LiteralExp { symbol = getStringAtt "realSymbol" atts,
expression_type = findExpressionType trees }
else if elem = "UML15OCL.Expressions.CollectionLiteralExp" then
XMI.CollectionLiteralExp { parts = map mkCollectionLiteralPart (XmlTree.follow "OCL.Expressions.CollectionLiteralExp.parts" trees),
XMI.CollectionLiteralExp { parts = nil, (* map mkCollectionLiteralPart (XmlTree.follow "OCL.Expressions.CollectionLiteralExp.parts" trees), *)
expression_type = findExpressionType trees }
else if elem = "UML15OCL.Expressions.OperationCallExp" then
let val op_src = hd (XmlTree.follow
@ -373,13 +361,29 @@ fun mkOCLExpression tree =
in XMI.LetExp
{ variable = { xmiid = var_xmiid,
name = var_name,
declaration_type = var_type_ref },
initExpression = mkOCLExpression init_exp ,
declaration_type = var_type_ref,
init = SOME (mkOCLExpression init_exp)},
inExpression = mkOCLExpression in_exp,
expression_type = findExpressionType trees }
end
else if elem = "UML15OCL.Expressions.IterateExp" then
raise NotYetImplemented
let val iterator_src = (hd o XmlTree.follow
"OCL.Expressions.PropertyCallExp.source")
trees
val iterator_body = (hd o XmlTree.follow
"OCL.Expressions.LoopExp.body")
trees
val iterators = XmlTree.follow "OCL.Expressions.LoopExp.iterators"
trees
val iterate_result = (hd o XmlTree.follow "OCL.Expressions.IterateExp.result")
trees
in
XMI.IterateExp { result = mkVariableDec iterate_result,
iterators = map mkVariableDec iterators,
body = mkOCLExpression iterator_body,
source = mkOCLExpression iterator_src,
expression_type = findExpressionType trees }
end
else if elem = "UML15OCL.Expressions.IteratorExp" then
let val iterator_src = (hd o XmlTree.follow
"OCL.Expressions.PropertyCallExp.source")
@ -391,13 +395,27 @@ fun mkOCLExpression tree =
trees
in
XMI.IteratorExp { name = getName atts,
iterators = map mkVariableDec iterators,
body = mkOCLExpression iterator_body,
source = mkOCLExpression iterator_src,
expression_type = findExpressionType trees }
iterators = map mkVariableDec iterators,
body = mkOCLExpression iterator_body,
source = mkOCLExpression iterator_src,
expression_type = findExpressionType trees }
end
else raise OCLIllFormed ("in mkOCLExpression: found unexpected element "^elem)
else raise IllFormed ("in mkOCLExpression: found unexpected element "^elem)
end
and mkVariableDec vtree =
let fun f atts trees =
{ xmiid = getXmiId atts,
name = getName atts,
init = Option.map (mkOCLExpression o hd o XmlTree.node_children_of)
(XmlTree.find_some "OCL.Expressions.VariableDeclaration.initExpression" trees),
declaration_type = (getXmiIdref o XmlTree.attributes_of o hd o
(XmlTree.follow "OCL.Expressions.VariableDeclaration.type")) trees
}
in XmlTree.apply_on "UML15OCL.Expressions.VariableDeclaration" f vtree
handle XmlTree.IllFormed msg => raise IllFormed ("in mkVariableDec: "^msg)
end
fun getAssociations t = (map mkAssociation (XmlTree.filter "UML:Association" t))@
(map mkAssociationFromAssociationClass
@ -1049,7 +1067,7 @@ fun mkXmiContent tree =
constraints = (map mkConstraint (filterConstraints trees)),
classifiers = (map mkClassifier (filterClassifiers trees)),
stereotypes = (map mkStereotype (filterStereotypes trees)),
variable_declarations = map mkVariableDec (filterVariableDecs trees),
variable_declarations = map mkVariableDec (filterVariableDecs trees),
activity_graphs = map mkActivityGraph(filterActivityGraphs trees),
state_machines = map mkStateMachine (filterStateMachines trees)}
in XmlTree.apply_on "XMI.content" f tree