diff --git a/src/codegen/ROOT.ML b/src/codegen/ROOT.ML
index 4718722..1341b4f 100644
--- a/src/codegen/ROOT.ML
+++ b/src/codegen/ROOT.ML
@@ -45,6 +45,7 @@ use "componentuml_cartridge.sml";
use "java_cartridge.sml";
use "junit_cartridge.sml";
+use "maven_pom_cartridge.sml";
(* Statemachines *)
diff --git a/src/codegen/codegen.cm b/src/codegen/codegen.cm
index 50f1c92..fc56ade 100644
--- a/src/codegen/codegen.cm
+++ b/src/codegen/codegen.cm
@@ -23,5 +23,6 @@ Group is
c#sm_cartridge.sml
java_cartridge.sml
junit_cartridge.sml
+ maven_pom_cartridge.sml
gcg_core.sml
codegen.sml
diff --git a/src/codegen/codegen.mlb b/src/codegen/codegen.mlb
index 292d4a0..70f8c4d 100644
--- a/src/codegen/codegen.mlb
+++ b/src/codegen/codegen.mlb
@@ -23,6 +23,7 @@ in
"c#sm_cartridge.sml"
java_cartridge.sml
junit_cartridge.sml
+ maven_pom_cartridge.sml
secureuml_cartridge.sig
secureuml_cartridge.sml
design_cartridge.sig
diff --git a/src/codegen/codegen.sml b/src/codegen/codegen.sml
index 9732eee..6c63392 100644
--- a/src/codegen/codegen.sml
+++ b/src/codegen/codegen.sml
@@ -54,11 +54,12 @@ structure Java_Ocl_Gcg = GCG_Core (Java_Cartridge(Base_Cartridge))
structure SecureMova_Gcg = GCG_Core (ComponentUML_Cartridge(Base_Cartridge))
+ structure Maven_POM_Gcg = GCG_Core (Maven_POM_Cartridge(Base_Cartridge))
+
(*
structure JavaSecure_Gcg = GCG_Core (Java_Cartridge(SecureUML_Cartridge(Base_Cartridge)));
*)
-
(* maybe this should also hav a "description" field? *)
type cartridge = {lang : string, (* identifier (for input) *)
name : string, (* short description (for output) *)
diff --git a/src/codegen/java_cartridge.sml b/src/codegen/java_cartridge.sml
index 9d5372d..93b772a 100644
--- a/src/codegen/java_cartridge.sml
+++ b/src/codegen/java_cartridge.sml
@@ -70,11 +70,19 @@ fun super2Native "ClassifierScope" = "static"
| super2Native s = ( if ((String.extract (s,0,SOME 8)) = "Sequence")
then (super2Native (String.substring(s,9,size s -10)))^"[]"
else if ((String.extract (s,0,SOME 3)) = "Set")
- then "System.Collections.Generic.List<"
+ then "java.util.List<"
^(super2Native (String.substring(s,4,size s - 5)))^">"
else s )
handle Subscript => s
+(* Get a stub for the return value of an operation - eg. null for objects *)
+fun rvstub operation = case (Rep.result_of_op operation) of
+ Integer => "0"
+ | Real => "0"
+ | String => "\"\""
+ | Boolean => "false"
+ | _ => "null"
+
(* lookup environment -> string -> string
* overrides some lookup entries of the base cartridge
*)
@@ -90,9 +98,10 @@ fun lookup (env : environment) "attribute_name_small_letter"
| lookup (env : environment) (s as "operation_scope") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "argument_type") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "parent_interface") = List.last (Option.valOf (#curParent env))
- | lookup (env : environment) (s as "preconditions") = Ocl2DresdenJava.precondString env "this" (curOperation' env)
- | lookup (env : environment) (s as "postconditions") = Ocl2DresdenJava.postcondString env "this" (curOperation' env)
- | lookup (env : environment) (s as "invariants") = Ocl2DresdenJava.invString env "this" (curClassifier' env)
+ | lookup (env : environment) (s as "preconditions") = Ocl2DresdenJava.precondString env "this" (curOperation' env) "OclException"
+ | lookup (env : environment) (s as "postconditions") = Ocl2DresdenJava.postcondString env "this" (curOperation' env) "OclException"
+ | lookup (env : environment) (s as "invariants") = Ocl2DresdenJava.invString env "this" (curClassifier' env) "OclException"
+ | lookup (env : environment) (s as "returnvalue_stub") = rvstub (curOperation' env)
| lookup (env : environment) s = SuperCart.lookup (unpack env) s
diff --git a/src/codegen/junit_cartridge.sml b/src/codegen/junit_cartridge.sml
index 662ef68..2e38d44 100644
--- a/src/codegen/junit_cartridge.sml
+++ b/src/codegen/junit_cartridge.sml
@@ -52,9 +52,9 @@ fun curOperation' env = Option.valOf(curOperation env)
(* any special variables? *)
-fun lookup (env : environment) (s as "preconditions") = Ocl2DresdenJava.precondString env "testObject" (curOperation' env)
- | lookup (env : environment) (s as "postconditions") = Ocl2DresdenJava.postcondString env "testObject" (curOperation' env)
- | lookup (env : environment) (s as "invariants") = Ocl2DresdenJava.invString env "testObject" (curClassifier' env)
+fun lookup (env : environment) (s as "preconditions") = Ocl2DresdenJava.precondString env "testObject" (curOperation' env) "PreconditionFailedException"
+ | lookup (env : environment) (s as "postconditions") = Ocl2DresdenJava.postcondString env "testObject" (curOperation' env) "PostconditionFailedException"
+ | lookup (env : environment) (s as "invariants") = Ocl2DresdenJava.invString env "testObject" (curClassifier' env) "InvariantFailedException"
| lookup (env : environment) s = SuperCart.lookup (unpack env) s
(* any special predicates?*)
diff --git a/src/codegen/maven_pom_cartridge.sml b/src/codegen/maven_pom_cartridge.sml
new file mode 100644
index 0000000..be624fd
--- /dev/null
+++ b/src/codegen/maven_pom_cartridge.sml
@@ -0,0 +1,56 @@
+(*****************************************************************************
+ * su4sml - a SecureUML repository for SML
+ *
+ * maven_pom_cartridge.sml - a maven POM cartridge for gcg
+ * Copyright (C) 2007 Manfred Stock
+ *
+ * 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.
+ ******************************************************************************)
+
+
+functor Maven_POM_Cartridge(SuperCart : BASE_CARTRIDGE) : BASE_CARTRIDGE =
+struct
+
+type Model = SuperCart.Model
+
+type environment = { extension : SuperCart.environment }
+
+fun initEnv model = { extension = SuperCart.initEnv model } : environment
+fun unpack (env : environment) = #extension env
+fun pack superEnv = {extension = superEnv} : environment
+
+(* for BASE_CARTRIDGE *)
+fun curClassifier env = SuperCart.curClassifier (unpack env)
+fun curArgument env = SuperCart.curArgument (unpack env)
+fun curOperation env = SuperCart.curOperation (unpack env)
+fun curAttribute env = SuperCart.curAttribute (unpack env)
+fun curAssociationEnd env = SuperCart.curAssociationEnd (unpack env)
+
+fun curClassifier' env = Option.valOf(curClassifier env)
+fun curOperation' env = Option.valOf(curOperation env)
+
+
+(* any special variables? *)
+fun lookup (env : environment) s = SuperCart.lookup (unpack env) s
+
+(* any special predicates?*)
+fun test (env : environment) s = SuperCart.test (unpack env) s
+
+(* any special lists? *)
+fun foreach listType (env : environment) = map pack (SuperCart.foreach listType (unpack env))
+
+end
diff --git a/src/codegen/templates/java.tpl b/src/codegen/templates/java.tpl
index ffbd3d0..2e50586 100644
--- a/src/codegen/templates/java.tpl
+++ b/src/codegen/templates/java.tpl
@@ -1,5 +1,4 @@
-@// Example template for Java
-@// assumption: all classifiers are classes
+@// Simple template for Java
@foreach nonprimitive_classifier_list
@openfileifnotexists generated/src/main/java/$classifier_package_path$/$classifier_name$.java
@@ -16,14 +15,14 @@
@end
@if notInterface
@if hasParent
- @tab extends $classifier_parent$
+ @spcextends $classifier_parent$
@end
@end
@if hasParentInterfaces
@if isInterface
- @tab extends
+ @spcextends
@else
- @tab implements
+ @spcimplements
@end
@foreach parent_interface_list
@if last_interface
@@ -33,27 +32,32 @@
@end
@end
@end
- {
+ @spc{
@if notInterface
@foreach attribute_list
- @nl @tab $attribute_visibility$ $attribute_type$ $attribute_name$ ;
+ @nl@tab$attribute_visibility$ $attribute_type$ $attribute_name$;
@end
+ @nl
@end
@foreach operation_list
- @nl @tab $operation_visibility$ $operation_result_type$ $operation_name$(
+ @nl@tab$operation_visibility$ $operation_result_type$ $operation_name$(
@foreach argument_list
@if last_argument
$argument_type$ $argument_name$
@else
- $argument_type$ $argument_name$,
+ $argument_type$ $argument_name$,@spc
@end
@end
)
@if notInterface
- {@nl@nl@tab}
+ @spc{@nl
+ @if operation_non_void
+ @tab@tabreturn $returnvalue_stub$;
+ @end
+ @nl@tab}@nl
@else
;
@end
@end
- @nl }
+ @nl}
@end
diff --git a/src/codegen/templates/java_ocl.tpl b/src/codegen/templates/java_ocl.tpl
index f0f3509..98ffbdd 100644
--- a/src/codegen/templates/java_ocl.tpl
+++ b/src/codegen/templates/java_ocl.tpl
@@ -1,26 +1,30 @@
-@// Example template for Java
-@// assumption: all classifiers are classes
+@// Simple template for Java
-@foreach classifier_list
- @openfile generated/$classifier_package_path$/$classifier_name$.java
- package $classifier_package$ ;
+@foreach nonprimitive_classifier_list
+ @openfileifnotexists generated/src/main/java/$classifier_package_path$/$classifier_name$.java
+ package $classifier_package$;
@nl@nl
+ import tudresden.ocl20.core.lib.*;
+ @nl
@if isClass
public class $classifier_name$
@end
@if isInterface
public interface $classifier_name$
@end
+ @if isEnumeration
+ public enum $classifier_name$
+ @end
@if notInterface
@if hasParent
- extends $classifier_parent$
+ @spcextends $classifier_parent$
@end
@end
@if hasParentInterfaces
@if isInterface
- extends
+ @spcextends
@else
- implements
+ @spcimplements
@end
@foreach parent_interface_list
@if last_interface
@@ -30,32 +34,88 @@
@end
@end
@end
- @nl {
+ @spc{
@if notInterface
@foreach attribute_list
- @nl @tab public $attribute_type$ $attribute_name$ ;
+ @nl@tab$attribute_visibility$ $attribute_type$ $attribute_name$;
@end
+ @nl
@end
+ @// Operations of the class
@foreach operation_list
- @nl @tab public $operation_result_type$ $operation_name$(
+ @// The actual Operation, which is called by the wrapper below
+ @nl@tab/**@nl@tab
+ @spc* Actual implementation of $operation_name$. @nl@tab
+ @spc*/
+ @nl@tabprivate $operation_result_type$ wrapped_$operation_name$(
@foreach argument_list
- $argument_type$ $argument_name$
+ @if last_argument
+ $argument_type$ $argument_name$
+ @else
+ $argument_type$ $argument_name$,@spc
+ @end
+ @end
+ )
+ @if notInterface
+ @spc{@nl
+ @if operation_non_void
+ @tab@tabreturn $returnvalue_stub$;
+ @end
+ @nl@tab}@nl
+ @else
+ ;
+ @end
+ @// The wrapper which calls the actual operation above
+ @nl@tab/**@nl@tab
+ @spc* Wrapper to call $operation_name$ and check pre-/postconditions and invariants. @nl@tab
+ @spc*/
+ @nl@tab$operation_visibility$ $operation_result_type$ $operation_name$(
+ @foreach argument_list
+ @if last_argument
+ $argument_type$ $argument_name$
+ @else
+ $argument_type$ $argument_name$,@spc
+ @end
+ @end
+ )
+ @if notInterface
+ @spc{
+ @if operation_non_void
+ @nl@tab@tab$operation_result_type$ result;@nl
+ @end
+ @nl@tab@tab// Check preconditions
+ @nl$preconditions$
+ @nl@tab@tab// Execute method @nl@tab@tab
+ @if operation_non_void
+ result =@spc
+ @end
+ wrapped_$operation_name$(
+ @foreach argument_list
+ @if last_argument
+ $argument_name$
+ @else
+ $argument_name$,@spc
+ @end
+ @end
+ );
+ @nl@nl@tab@tab// Check postconditions
+ @nl$postconditions$
+ @nl@tab@tab// Check invariant
+ @nl@tab@tabcheckInvariant();
+ @if operation_non_void
+ @nl@tab@tabreturn result;
+ @end
+ @nl@tab}@nl
+ @else
+ ;
@end
- )
- @if notInterface
- {
- @nl @tab @tab // Preconditions
- @nl $preconditions$
- @nl @tab @tab // Your Code
- @nl @tab @tab // Postconditions
- @nl $postconditions$
- @nl@tab }
- @else
- ;
@end
- @end
- @nl // Invariant
- @nl $invariants$
- @nl
- @nl }
+
+ @nl@tab/**
+ @nl@tab@spc* Invariant
+ @nl@tab@spc*/
+ @nl@tabpublic void checkInvariant() {
+ @nl$invariants$
+ @nl@tab}
+ @nl}
@end
diff --git a/src/codegen/templates/junit.tpl b/src/codegen/templates/junit.tpl
index 06037bc..edb3a14 100644
--- a/src/codegen/templates/junit.tpl
+++ b/src/codegen/templates/junit.tpl
@@ -8,46 +8,46 @@
@openfile generated/src/test/java/$classifier_package_path$/$classifier_name$Test.java
package $classifier_package$;
@nl@nl
- @nl import java.io.FileNotFoundException;
- @nl import org.junit.BeforeClass;
- @nl import org.junit.Test;
- @nl import ch.ethz.infsec.jtestdataaccessor.TestDataAccessor;
- @nl import ch.ethz.infsec.jtestdataaccessor.TestDataParseException;
- @nl import ch.ethz.infsec.jtestdataaccessor.TestDataUser;
- @nl import ch.ethz.infsec.jtestdataaccessor.TestHelper;
- @nl import antlr.RecognitionException;
- @nl import antlr.TokenStreamException;
- @nl import tudresden.ocl20.core.lib.*;
- @nl import ch.ethz.infsec.jtestdataaccessor.oclexceptions.*;
+ @nlimport java.io.FileNotFoundException;
+ @nlimport org.junit.BeforeClass;
+ @nlimport org.junit.Test;
+ @nlimport ch.ethz.infsec.jtestdataaccessor.TestDataAccessor;
+ @nlimport ch.ethz.infsec.jtestdataaccessor.TestDataParseException;
+ @nlimport ch.ethz.infsec.jtestdataaccessor.TestDataUser;
+ @nlimport ch.ethz.infsec.jtestdataaccessor.TestHelper;
+ @nlimport antlr.RecognitionException;
+ @nlimport antlr.TokenStreamException;
+ @nlimport tudresden.ocl20.core.lib.*;
+ @nlimport ch.ethz.infsec.jtestdataaccessor.oclexceptions.*;
@nl
- @nl public class $classifier_name$Test extends Abstract$classifier_name$Test implements TestDataUser {
+ @nlpublic class $classifier_name$Test extends Abstract$classifier_name$Test implements TestDataUser {
- @nl@tab public static String classUnderTest = "$classifier_package$.$classifier_name$";
+ @nl@tabpublic static String classUnderTest = "$classifier_package$.$classifier_name$";
- @nl@nl@tab private static TestDataAccessor tda;
+ @nl@nl@tabprivate static TestDataAccessor tda;
- @nl@nl@tab private static TestHelper th;
+ @nl@nl@tabprivate static TestHelper th;
- @nl@nl@tab public String getClassUnderTest() {
- @nl@tab@tab return classUnderTest;
+ @nl@nl@tabpublic String getClassUnderTest() {
+ @nl@tab@tabreturn classUnderTest;
@nl@tab}
@nl@nl@tabpublic Object getTestObject() {
- @nl@tab@tab return testObject;
+ @nl@tab@tabreturn testObject;
@nl@tab}
- @nl@nl@tab \@BeforeClass
- @nl@tab public static void basicEnvSetup() throws FileNotFoundException, RecognitionException, TokenStreamException, TestDataParseException {
- @nl@tab@tab tda = new TestDataAccessor("src/test/resources/$classifier_package_path$/Testdata$classifier_name$");
- @nl@tab@tab th = new TestHelper(classUnderTest,tda);
+ @nl@nl@tab\@BeforeClass
+ @nl@tabpublic static void basicEnvSetup() throws FileNotFoundException, RecognitionException, TokenStreamException, TestDataParseException {
+ @nl@tab@tabtda = new TestDataAccessor("src/test/resources/$classifier_package_path$/Testdata$classifier_name$");
+ @nl@tab@tabth = new TestHelper(classUnderTest,tda);
@nl@tab }
@foreach unique_operation_list
@if operation_isNotPrivate
@nl@nl@tab\@Test
- @nl@tab public void $operation_name$Test() throws Throwable {
- @nl@tab@tab String methodname = "$operation_name$";
- @nl@tab@tab th.doTest(methodname, this);
+ @nl@tabpublic void $operation_name$Test() throws Throwable {
+ @nl@tab@tabString methodname = "$operation_name$";
+ @nl@tab@tabth.doTest(methodname, this);
@nl@tab }
@end
@end
@@ -55,14 +55,14 @@
@foreach operation_list
@nl@nl@tab
/**@nl@tab
- * Wrapper to call $operation_name$ and check pre-/postconditions and invariants. @nl@tab
- */
- @nl@tab public $operation_result_type$ wrapped_$operation_name$(
+ @spc* Wrapper to call $operation_name$ and check pre-/postconditions and invariants. @nl@tab
+ @spc*/
+ @nl@tabpublic $operation_result_type$ wrapped_$operation_name$(
@foreach argument_list
@if last_argument
$argument_type$ $argument_name$
@else
- $argument_type$ $argument_name$,
+ $argument_type$ $argument_name$,@spc
@end
@end
) throws Throwable {@nl
@@ -70,24 +70,24 @@
@tab@tab$operation_result_type$ result;@nl
@end
@tab@tab// Check preconditions @nl
- $preconditions$@nl@tab@tab
- // Execute method @nl@tab@tab
+ $preconditions$@nl
+ @tab@tab// Execute method @nl@tab@tab
@if operation_non_void
- result =
+ result =@spc
@end
testObject.$operation_name$(
@foreach argument_list
@if last_argument
$argument_name$
@else
- $argument_name$,
+ $argument_name$,@spc
@end
@end
);@nl
@tab@tab// Check postconditions @nl
$postconditions$@nl
@tab@tab// Check invariants @nl
- @tab@tab checkInvariant();
+ @tab@tabcheckInvariant();
@nl@tab@tab
@if operation_non_void
return result;
@@ -98,8 +98,8 @@
@nl@nl@tab
/**@nl@tab
- * Check invariants of the class @nl@tab
- */@nl@tab
+ @spc* Check invariants of the class @nl@tab
+ @spc*/@nl@tab
public void checkInvariant() throws InvariantFailedException {@nl
$invariants$
@nl@tab}
@@ -111,12 +111,12 @@
@//--------------------------
@openfileifnotexists generated/src/test/java/$classifier_package_path$/Abstract$classifier_name$Test.java
package $classifier_package$;
- @nl import $classifier_package$.$classifier_name$;
- @nl@nl public abstract class Abstract$classifier_name$Test {
+ @nl@nlimport $classifier_package$.$classifier_name$;
+ @nl@nlpublic abstract class Abstract$classifier_name$Test {
- @nl@nl@tab static $classifier_name$ testObject;
+ @nl@nl@tabstatic $classifier_name$ testObject;
- @nl@nl }
+ @nl@nl}
@//----------------------
@@ -127,27 +127,34 @@
@foreach operation_list
@if operation_isNotPrivate
[$operation_name$]
- @nl resulttype = $operation_result_type$;
+ @if operation_non_void
+ @nlresulttype = $operation_result_type$;
+ @end
@if operation_has_arguments
- @nl inputtypes =
+ @nlinputtypes = @spc
@foreach argument_list
$argument_type$
@if not_last_argument
- ,
+ ,@spc
@end
@end
;
@end
- @nl #setup = ;
- @nl #teardown = ;
- @nl #{
- @nl #@tab input = ;
- @nl #@tab result = ;
- @nl #@tab checker = ;
- @nl #@tab comment = ;
- @nl #}
+ @nl#setup = ;
+ @nl#teardown = ;
+ @nl#{
+ @if operation_has_arguments
+ @nl#@tab input = ;
+ @end
+ @if operation_non_void
+ @nl#@tab result = ;
+ @end
+ @nl#@tab checker = ;
+ @nl#@tab comment = ;
+ @nl#}
@nl@nl
@end
@end
@end
@end
+
diff --git a/src/codegen/templates/maven_pom.tpl b/src/codegen/templates/maven_pom.tpl
new file mode 100644
index 0000000..7a21b9e
--- /dev/null
+++ b/src/codegen/templates/maven_pom.tpl
@@ -0,0 +1,45 @@
+@// Template for a maven Project Object Model (POM) file
+
+@openfileifnotexists generated/pom.xml
+
+@nl
+@nl@tab4.0.0
+@nl@tabgroupId
+@nl@tabartifactId
+@nl@tabname
+@nl@tab1.0-SNAPSHOT
+@nl@tab
+@nl@tab@tab
+@nl@tab@tab@tab
+@nl@tab@tab@tab@tabmaven-compiler-plugin
+@nl@tab@tab@tab@tab
+@nl@tab@tab@tab@tab@tab
+@nl@tab@tab@tab@tab@tab1.5
+@nl@tab@tab@tab@tab
+@nl@tab@tab@tab
+@nl@tab@tab@tab
+@nl@tab@tab@tab@taborg.apache.maven.plugins
+@nl@tab@tab@tab@tabmaven-surefire-plugin
+@nl@tab@tab@tab@tab2.3-SNAPSHOT
+@nl@tab@tab@tab@tab
+@nl@tab@tab@tab@tab@tabpertest
+@nl@tab@tab@tab@tab
+@nl@tab@tab@tab
+@nl@tab@tab
+@nl@tab
+@nl@tab
+@nl@tab@tab
+@nl@tab@tab@tabch.ethz.infsec.jtestdataaccessor
+@nl@tab@tab@tabjtestdataaccessor
+@nl@tab@tab@tab1.0-SNAPSHOT
+@nl@tab@tab@tabtest
+@nl@tab@tab
+@nl@tab@tab
+@nl@tab@tab@tabtudresden.ocl20
+@nl@tab@tab@tabstdlib
+@nl@tab@tab@tab1.0-SNAPSHOT
+@nl@tab@tab@tab
+@nl@tab@tab@tabtest
+@nl@tab@tab
+@nl@tab
+@nl@nl
diff --git a/src/codegen/templates/tpl.el b/src/codegen/templates/tpl.el
index b638ade..26de1ef 100644
--- a/src/codegen/templates/tpl.el
+++ b/src/codegen/templates/tpl.el
@@ -6,7 +6,7 @@
(list
)
(list
- (list "@nl\\|@tab"
+ (list "@nl\\|@tab\\|@spc"
'(0 font-lock-builtin-face))
(list "\\W\\(@if\\|@elsif\\)[ \t]*\\([a-zA-Z_-]*\\)\\W"
'(1 font-lock-keyword-face)
diff --git a/src/codegen/tpl_parser.sml b/src/codegen/tpl_parser.sml
index d49cacd..913f327 100644
--- a/src/codegen/tpl_parser.sml
+++ b/src/codegen/tpl_parser.sml
@@ -154,7 +154,7 @@ fun getContent l = let val sl = tokenize l
handle ex => error ("in Tpl_Parser.getContent: "^General.exnMessage ex)
(** cleans line, replaces nl and tabs so that no space char is left out. *)
-fun preprocess s = replaceSafely "@tab" "\t" (replaceSafely "@nl" "\n" (cleanLine s))
+fun preprocess s = replaceSafely "@spc" " " (replaceSafely "@tab" "\t" (replaceSafely "@nl" "\n" (cleanLine s)))
(**
diff --git a/src/ocl2dresdenjava.sml b/src/ocl2dresdenjava.sml
index 731ef5a..9773788 100644
--- a/src/ocl2dresdenjava.sml
+++ b/src/ocl2dresdenjava.sml
@@ -1,28 +1,88 @@
+(**
+ * A counter for the variables which returns a new number on each
+ * next()/nextstr() call.
+ *)
+structure varcounter = struct
+val count = ref ~1
+
+(** Increment and return the counter value. *)
+fun next() = (count := !count + 1; !count)
+
+(** Increment and return the counter value as a string. *)
+fun nextStr() = Int.toString (next())
+
+(** Reset the counter to -1. *)
+fun reset() = (count := ~1)
+
+(** Get the current value. *)
+fun current() = !count
+
+(** Get the current value as a string. *)
+fun currentStr() = Int.toString(current())
+end
+
+
+(**
+ * A map to store the relation of values calculated before the function
+ * call which are used in @pre terms.
+ *)
+structure preMap = struct open library
+val entries : (string * int) list ref = ref nil
+
+(** Insert a new entry - if an entry with the same key already exists, it will be removed. *)
+fun put (key : string) (value : int) = entries := (key,value)::(List.filter (fn (entry) => (fst entry) <> key) (!entries))
+
+(** Get the entry with the given key. *)
+fun get (key : string) = case (List.filter (fn (entry) => (fst entry) = key) (!entries)) of
+ [result] => snd result
+ | _ => ~1
+
+(** Check if an entry with the given key exists. *)
+fun has (key : string) = foldr (fn (a,b) => ((fst a) = key) orelse b) false (!entries)
+
+(** Clear the list. *)
+fun clear () = entries := nil
+
+(** Get the current size of the list. *)
+fun size () = List.length (!entries)
+end
+
+
(**
* Conversion of OCL expressions to Java code which makes use of the
* Dresden standard ocl library.
*)
+structure Ocl2DresdenJava = struct open library open Rep_OclType open Rep_OclTerm open Rep_Core open Ocl2String
-structure varcounter = struct
-val count = ref ~1
-fun next() = (count := !count + 1; !count)
-fun nextStr() = Int.toString (next())
-fun reset() = (count := ~1)
-fun current() = !count
-fun currentStr() = Int.toString(current())
-end
-
-structure Ocl2DresdenJava = struct open library open Rep_OclType open Rep_OclTerm open Rep_Core
-
-fun ocl2java' oclterm on =
+(**
+ * Convert an oclterm to Java. 'on' should be the object which represents
+ * self, so in most cases it will be 'this'. The result is string * int
+ * where string is the generated code and int is the id of the oclNode which
+ * contains the result of the generated code (ie. the last node which got
+ * assigned a value in the generated code).
+ *)
+fun ocl2java' oclterm on =
let
+ (* Get the oclNode number as a string. *)
fun count res = Int.toString(snd res)
+
+ (* Get the generated code. *)
fun code res = fst res
+
+ (* Generate a new node of type ntype which gets assigned the result of ncode. *)
fun newNode ntype ncode = "final "^ntype^" oclNode"^(varcounter.nextStr())^" = "^ncode^";\n"
+
+ (* Generate a new UmlOclFactory. *)
fun newFact () = ("final UmlOclFactory oclFact"^(varcounter.nextStr())^" = UmlOclFactory.getInstance();\n",
varcounter.current())
+
+ (* Convert a node id to oclNode. *)
fun node nid = "oclNode"^(count nid)
+
+ (* Convert a node id to oclFact. *)
fun fact fid = "oclFact"^(count fid)
+
+ (* Generate code for an if statement by evaluating condition and the two branches. *)
fun ifStmt cond thenb elseb rest =
let
val condition = ocl2java' cond on
@@ -35,58 +95,82 @@ fun ocl2java' oclterm on =
(newNode ("Ocl"^(string_of_OclType rest)) ("Ocl.toOcl"^(string_of_OclType rest)^"("^(node condition)^".ifThenElse("^(node thenbranch)^", "^(node elsebranch)^"))")),
varcounter.current())
end
+
+ (* Get an object which represents the given OclType. *)
+ fun typeObj ptype =
+ case ptype of (Classifier p) =>
+ let
+ val factory = newFact ()
+ val oclmodeltype = newNode "OclModelType" ((fact factory)^".getOclModelTypeFor(\""^(string_of_OclType_colon ptype)^"\")")
+ in
+ ((code factory)^
+ oclmodeltype,
+ varcounter.current())
+ end
+ | (Set s) =>
+ let
+ val setType = typeObj s
+ in
+ ((code setType)^
+ (newNode "OclCollectionType" ((node setType)^".getOclSetType()")),
+ varcounter.current())
+ end
+ | OclAny =>
+ ((newNode "OclType" ("OclType.getOclAny()")),
+ varcounter.current())
+ | _ =>
+ (newNode "OclPrimitiveType" ("OclPrimitiveType.getOcl"^(string_of_OclType ptype)^"()"),varcounter.current())
+
+ (* Get the node id of the node which stores the result of src which was used in an @pre expression. *)
+ fun atPre src = ("", preMap.get(ocl2string true src))
+
+ (* Generate code for an attribute/association end call. *)
fun attrCall src path ptype =
- let
- val target = ocl2java' src on
- fun node' typ typobj = (newNode ("Ocl"^typ) ("Ocl.toOcl"^typ^"("^(node target)^".getFeature("^(node typobj)^", \""^(hd (rev path))^"\"))"))
- in
- case ptype of (Classifier p) =>
- let
- val factory = newFact ()
- val oclmodeltype = (newNode "OclModelType" ((fact factory)^".getOclModelTypeFor(\""^(string_of_OclType_colon ptype)^"\")"),varcounter.current())
- in
- ((code factory)^
- (code target)^
- (code oclmodeltype)^
- (node' "ModelObject" oclmodeltype),
- varcounter.current())
- end
- | _ =>
- let
- val oclprimtype = (newNode "OclPrimitiveType" ("OclPrimitiveType.getOcl"^(string_of_OclType ptype)^"()"),varcounter.current())
- in
- ((code target)^
- (code oclprimtype)^
- (node' (string_of_OclType ptype) oclprimtype),
- varcounter.current())
- end
- end
-
+ case src of OperationCall (osrc,styp,["oclLib","OclAny","atPre"],[],_) => atPre oclterm
+ | _ =>
+ let
+ val target = ocl2java' src on
+ val typeObject = typeObj ptype
+ fun node' typ typobj = (newNode ("Ocl"^typ) ("Ocl.toOcl"^typ^"("^(node target)^".getFeature("^(node typobj)^", \""^(hd (rev path))^"\"))"))
+ in
+ case ptype of (Classifier p) =>
+ ((code target)^
+ (code typeObject)^
+ (node' "ModelObject" typeObject),
+ varcounter.current())
+ | (Set s) =>
+ ((code target)^
+ (code typeObject)^
+ (node' "Set" typeObject),
+ varcounter.current())
+ | _ =>
+ ((code target)^
+ (code typeObject)^
+ (node' (string_of_OclType ptype) typeObject),
+ varcounter.current())
+ end
+
+ (* Access to a variable - this is either self, result or an argument to the function call. *)
fun var name t =
let
val factory = newFact ()
val vname = if name = "self" then on else name
+ val vtype = typeObj t
+ fun node' typ typobj = newNode ("Ocl"^typ) ("(Ocl"^typ^")"^(fact factory)^".getOclRepresentationFor("^(node typobj)^", "^vname^")")
in
- case t of Integer =>
- let
- val integertype = (newNode "OclPrimitiveType" "OclPrimitiveType.getOclInteger()",varcounter.current())
- in
- ((code factory)^
- (code integertype)^
- (newNode "OclInteger" ("(OclInteger)"^(fact factory)^".getOclRepresentationFor("^(node integertype)^", "^vname^")")),
- varcounter.current())
- end
- | _ =>
- let
- val modeltype = (newNode "OclModelType" ((fact factory)^".getOclModelTypeFor(\""^(string_of_OclType_colon t)^"\")"),
- varcounter.current())
- in
- ((code factory)^
- (code modeltype)^
- (newNode "OclModelObject" ("(OclModelObject)"^(fact factory)^".getOclRepresentationFor("^(node modeltype)^", "^vname^")")),
- varcounter.current())
- end
+ case t of (Classifier p) =>
+ ((code factory)^
+ (code vtype)^
+ (node' "ModelObject" vtype),
+ varcounter.current())
+ | _ =>
+ ((code factory)^
+ (code vtype)^
+ (node' (string_of_OclType t) vtype),
+ varcounter.current())
end
+
+ (* Generate code for binary operations on basic types. *)
fun string_of_binop src bop arg rtype =
let
val left = ocl2java' src on
@@ -97,6 +181,8 @@ fun ocl2java' oclterm on =
(newNode ("Ocl"^(string_of_OclType rtype)) ((node left)^"."^bop^"("^(node right)^")")),
varcounter.current())
end
+
+ (* Generate code for unary operations on basic types. *)
fun string_of_unop src sop rtype =
let
val right = ocl2java' src on
@@ -105,8 +191,12 @@ fun ocl2java' oclterm on =
(newNode ("Ocl"^(string_of_OclType rtype)) ((node right)^"."^sop^"()")),
varcounter.current())
end
+
+ (* Get an empty set. *)
fun emptySet () = (newNode "OclSet" "OclSet.getEmptyOclSet()",
varcounter.current())
+
+ (* Insert the result of src into an empty set. *)
fun oclset src =
let
val src' = ocl2java' src on
@@ -117,6 +207,8 @@ fun ocl2java' oclterm on =
(node set)^".setToInclude("^(node src')^");\n",
varcounter.current())
end
+
+ (* Generate code for the ->notEmpty() operation. *)
fun oclnotempty src =
let
val src' = ocl2java' src on
@@ -125,6 +217,8 @@ fun ocl2java' oclterm on =
(newNode "OclBoolean" ((node src')^".notEmpty()")),
varcounter.current())
end
+
+ (* Generate code for the ->isEmpty() operation. *)
fun oclempty src =
let
val src' = ocl2java' src on
@@ -133,6 +227,8 @@ fun ocl2java' oclterm on =
(newNode "OclBoolean" ((node src')^".isEmpty()")),
varcounter.current())
end
+
+ (* Generate code for the ->size() operation. *)
fun oclsize src =
let
val src' = ocl2java' src on
@@ -141,96 +237,257 @@ fun ocl2java' oclterm on =
(newNode "OclInteger" ((node src')^".size()")),
varcounter.current())
end
-
+
+ (* Generate code for a function call. Evaluate parameters and pass them to the call. *)
+ fun opCall src op_name args rtype =
+ let
+ val src' = ocl2java' src on
+ val resultTypeObj = typeObj rtype
+ (* Evaluate arguments, generate new node with the result. *)
+ fun evalArg (arg,atype) =
+ let
+ val acode = ocl2java' arg on
+ fun umltype utype = case utype of
+ Integer => "UmlType.INT"
+ | Real => "UmlType.REAL"
+ | String => "UmlType.STRING"
+ | Boolean => "UmlType.BOOLEAN"
+ | _ => "UmlType.MODELTYPE"
+ in
+ ((code acode)^
+ (newNode "OclParameter" ("new OclParameter("^(umltype atype)^", "^(node acode)^")")),
+ varcounter.current())
+ end
+ val arguments = map evalArg args
+ val argcode = join "" (map fst arguments)
+ (* Evaluated arguments *)
+ val argsEvald = join ", " (map (fn a => node a) arguments)
+ fun node' typ typobj = argcode^(newNode ("Ocl"^typ) ("Ocl.toOcl"^typ^"("^(node src')^".getFeature("^(node typobj)^", \""^(hd (rev op_name))^"\", new OclParameter[]{"^argsEvald^"}))"))
+ in
+ case rtype of (Classifier p) =>
+ ((code src')^
+ (code resultTypeObj)^
+ (node' "ModelObject" resultTypeObj),
+ varcounter.current())
+ | _ =>
+ ((code src')^
+ (code resultTypeObj)^
+ (node' (string_of_OclType rtype) resultTypeObj),
+ varcounter.current())
+ end
+
+ (* Generate code for the ->oclAsType() operation. *)
+ fun oclAsType src oclType rtyp =
+ let
+ val src' = ocl2java' src on
+ val typeObject = typeObj rtyp
+ in
+ case oclType of
+ OclAny =>
+ ((code src')^
+ (code typeObject)^
+ (newNode "OclAny" ("Ocl.toOclAny("^(node src')^".oclAsType("^(node typeObject)^"))")),
+ varcounter.current())
+ | _ =>
+ ((code src')^
+ (code typeObject)^
+ (newNode "OclModelObject" ("Ocl.toOclModelObject("^(node src')^".oclAsType("^(node typeObject)^"))")),
+ varcounter.current())
+ end
+
+ (* Generate code for the ->oclIsUndefined() operation. *)
+ fun oclIsUndefined src =
+ let
+ val src' = ocl2java' src on
+ in
+ ((code src')^
+ (newNode "OclBoolean" ("OclBoolean.getOclRepresentationFor("^(node src')^".isUndefined())")),
+ varcounter.current())
+ end
+
+ (* Generate code for the ->oclIsDefined() operation. *)
+ fun oclIsDefined src =
+ let
+ val src' = oclIsUndefined src
+ in
+ ((code src')^
+ (newNode "OclBoolean" ((node src')^".not()")),
+ varcounter.current())
+ end
in
- case oclterm of
- Literal ("true",Boolean) => (newNode "OclBoolean" "OclBoolean.TRUE",varcounter.current())
- | Literal ("false",Boolean) => (newNode "OclBoolean" "OclBoolean.FALSE",varcounter.current())
- | Literal (l,Integer) => (newNode "OclInteger" ("new OclInteger("^l^")"),varcounter.current())
- (* Logical operators *)
- | OperationCall (src,Boolean,["oclLib","Boolean","and"],[(arg,Boolean)],rtype) => string_of_binop src "and" arg rtype
- | OperationCall (src,Boolean,["oclLib","Boolean","or"],[(arg,Boolean)],rtype) => string_of_binop src "or" arg rtype
- | OperationCall (src,Boolean,["oclLib","Boolean","xor"],[(arg,Boolean)],rtype) => string_of_binop src "xor" arg rtype
- | OperationCall (src,Boolean,["oclLib","Boolean","not"],[],rtype) => string_of_unop src "not" rtype
- | OperationCall (src,Boolean,["oclLib","Boolean","implies"],[(arg,Boolean)],rtype) => string_of_binop src "implies" arg rtype
- (* Comparison operators *)
- | OperationCall (src,styp,["oclLib",classifier,"="],[(arg,atyp)],rtype) => string_of_binop src "isEqualTo" arg rtype
- | OperationCall (src,styp,["oclLib",classifier,"<>"],[(arg,atyp)],rtype) => string_of_binop src "isNotEqualTo" arg rtype
- | OperationCall (src,styp,["oclLib",classifier,"=="],[(arg,atyp)],rtype) => string_of_binop src "isEqualTo" arg rtype
- | OperationCall (src,styp,["oclLib",classifier,"~="],[(arg,atyp)],rtype) => string_of_binop src "isNotEqualTo" arg rtype
- (* OCL Real *)
- | OperationCall (src,styp,["oclLib",classifier,"round"],[],rtype) => string_of_unop src "round" rtype
- | OperationCall (src,styp,["oclLib",classifier,"floor"],[],rtype) => string_of_unop src "floor" rtype
- | OperationCall (src,styp,["oclLib",classifier,"min"],[(arg,atyp)],rtype) => string_of_binop src "min" arg rtype
- | OperationCall (src,styp,["oclLib",classifier,"max"],[(arg,atyp)],rtype) => string_of_binop src "max" arg rtype
- | OperationCall (src,styp,["oclLib",classifier,"/"],[(arg,atyp)],rtype) => string_of_binop src "divide" arg rtype
- | OperationCall (src,styp,["oclLib",classifier,"abs"],[],rtype) => string_of_unop src "abs" rtype
- | OperationCall (src,styp,["oclLib",classifier,"-"],[(arg,atyp)],rtype) => string_of_binop src "subtract" arg rtype
- | OperationCall (src,styp,["oclLib",classifier,"+"],[(arg,atyp)],rtype) => string_of_binop src "add" arg rtype
- | OperationCall (src,styp,["oclLib",classifier,"*"],[(arg,atyp)],rtype) => string_of_binop src "multiply" arg rtype
- (* OCL Integer *)
- | OperationCall (src,styp,["oclLib",classifier,"mod"],[(arg,atyp)],rtyp) => string_of_binop src "mod" arg rtyp
- | OperationCall (src,styp,["oclLib",classifier,"div"],[(arg,atyp)],rtyp) => string_of_binop src "div" arg rtyp
- | OperationCall (src,styp,["oclLib",classifier,"-"],[],rtyp) => string_of_unop src "negative" rtyp
- (* OCL Numerals *)
- | OperationCall (src,styp,["oclLib",classifier,"<"],[(arg,atyp)],rtyp) => string_of_binop src "isLessThan" arg rtyp
- | OperationCall (src,styp,["oclLib",classifier,"<="],[(arg,atyp)],rtyp) => string_of_binop src "isLessEqual" arg rtyp
- | OperationCall (src,styp,["oclLib",classifier,">"],[(arg,atyp)],rtyp) => string_of_binop src "isGreaterThan" arg rtyp
- | OperationCall (src,styp,["oclLib",classifier,">="],[(arg,atyp)],rtyp) => string_of_binop src "isGreaterEqual" arg rtyp
- (* Some collection operations *)
- | OperationCall (src,styp,["oclLib",_,"asSet"],[],rtyp) => oclset src
- | OperationCall (src,styp,["oclLib",_,"notEmpty"],[],rtyp) => oclnotempty src
- | OperationCall (src,styp,["oclLib",_,"isEmpty"],[],rtyp) => oclempty src
- | OperationCall (src,styp,["oclLib",_,"size"],[],rtyp) => oclsize src
- (* If *)
- | If (cond,condt,thenb,thent,elseb,elset,rest) => ifStmt cond thenb elseb rest
- (* Access to attributes *)
- | AttributeCall (src,styp,path,ptype) => attrCall src path ptype
- (* Access to variables *)
- | Variable (name, t) => var name t
- | _ => (Ocl2String.ocl2string true oclterm, 0)
+ case oclterm of
+ (* Literals *)
+ Literal ("true",Boolean) => (newNode "OclBoolean" "OclBoolean.TRUE",varcounter.current())
+ | Literal ("false",Boolean) => (newNode "OclBoolean" "OclBoolean.FALSE",varcounter.current())
+ | Literal (l,Integer) => (newNode "OclInteger" ("new OclInteger("^l^")"),varcounter.current())
+ | Literal (s,String) => (newNode "OclString" ("new OclString(\""^s^"\")"),varcounter.current())
+ | Literal (r,Real) => (newNode "OclReal" ("new OclReal("^r^")"),varcounter.current())
+ (* Logical operators *)
+ | OperationCall (src,Boolean,["oclLib","Boolean","and"],[(arg,Boolean)],rtype) => string_of_binop src "and" arg rtype
+ | OperationCall (src,Boolean,["oclLib","Boolean","or"],[(arg,Boolean)],rtype) => string_of_binop src "or" arg rtype
+ | OperationCall (src,Boolean,["oclLib","Boolean","xor"],[(arg,Boolean)],rtype) => string_of_binop src "xor" arg rtype
+ | OperationCall (src,Boolean,["oclLib","Boolean","not"],[],rtype) => string_of_unop src "not" rtype
+ | OperationCall (src,Boolean,["oclLib","Boolean","implies"],[(arg,Boolean)],rtype) => string_of_binop src "implies" arg rtype
+ (* Comparison operators *)
+ | OperationCall (src,styp,["oclLib",classifier,"="],[(arg,atyp)],rtype) => string_of_binop src "isEqualTo" arg rtype
+ | OperationCall (src,styp,["oclLib",classifier,"<>"],[(arg,atyp)],rtype) => string_of_binop src "isNotEqualTo" arg rtype
+ | OperationCall (src,styp,["oclLib",classifier,"=="],[(arg,atyp)],rtype) => string_of_binop src "isEqualTo" arg rtype
+ | OperationCall (src,styp,["oclLib",classifier,"~="],[(arg,atyp)],rtype) => string_of_binop src "isNotEqualTo" arg rtype
+ (* OCL Real *)
+ | OperationCall (src,styp,["oclLib",classifier,"round"],[],rtype) => string_of_unop src "round" rtype
+ | OperationCall (src,styp,["oclLib",classifier,"floor"],[],rtype) => string_of_unop src "floor" rtype
+ | OperationCall (src,styp,["oclLib",classifier,"min"],[(arg,atyp)],rtype) => string_of_binop src "min" arg rtype
+ | OperationCall (src,styp,["oclLib",classifier,"max"],[(arg,atyp)],rtype) => string_of_binop src "max" arg rtype
+ | OperationCall (src,styp,["oclLib",classifier,"/"],[(arg,atyp)],rtype) => string_of_binop src "divide" arg rtype
+ | OperationCall (src,styp,["oclLib",classifier,"abs"],[],rtype) => string_of_unop src "abs" rtype
+ | OperationCall (src,styp,["oclLib",classifier,"-"],[(arg,atyp)],rtype) => string_of_binop src "subtract" arg rtype
+ | OperationCall (src,styp,["oclLib",classifier,"+"],[(arg,atyp)],rtype) => string_of_binop src "add" arg rtype
+ | OperationCall (src,styp,["oclLib",classifier,"*"],[(arg,atyp)],rtype) => string_of_binop src "multiply" arg rtype
+ (* OCL Integer *)
+ | OperationCall (src,styp,["oclLib",classifier,"mod"],[(arg,atyp)],rtyp) => string_of_binop src "mod" arg rtyp
+ | OperationCall (src,styp,["oclLib",classifier,"div"],[(arg,atyp)],rtyp) => string_of_binop src "div" arg rtyp
+ | OperationCall (src,styp,["oclLib",classifier,"-"],[],rtyp) => string_of_unop src "negative" rtyp
+ (* OCL Numerals *)
+ | OperationCall (src,styp,["oclLib",classifier,"<"],[(arg,atyp)],rtyp) => string_of_binop src "isLessThan" arg rtyp
+ | OperationCall (src,styp,["oclLib",classifier,"<="],[(arg,atyp)],rtyp) => string_of_binop src "isLessEqual" arg rtyp
+ | OperationCall (src,styp,["oclLib",classifier,">"],[(arg,atyp)],rtyp) => string_of_binop src "isGreaterThan" arg rtyp
+ | OperationCall (src,styp,["oclLib",classifier,">="],[(arg,atyp)],rtyp) => string_of_binop src "isGreaterEqual" arg rtyp
+ (* Some collection operations *)
+ | OperationCall (src,styp,["oclLib",_,"asSet"],[],rtyp) => oclset src
+ | OperationCall (src,styp,["oclLib",_,"notEmpty"],[],rtyp) => oclnotempty src
+ | OperationCall (src,styp,["oclLib",_,"isEmpty"],[],rtyp) => oclempty src
+ | OperationCall (src,styp,["oclLib",_,"size"],[],rtyp) => oclsize src
+ (* oclIs(Und|D)efined *)
+ | OperationCall (src,styp,["oclIsDefined"],[],rtyp) => oclIsDefined src
+ | OperationCall (src,styp,["oclIsUndefined"],[],rtyp) => oclIsUndefined src
+ (* @pre *)
+ | OperationCall (src,styp,["oclLib","OclAny","atPre"],[],_) => atPre src
+ (* Unsupported call - TODO: maybe replace by error "..."? *)
+ | OperationCall (src,styp,[opname],[],rtyp) => (("/* Unsupported OCL operation "^opname^". */\n"),varcounter.current())
+ (* If *)
+ | If (cond,condt,thenb,thent,elseb,elset,rest) => ifStmt cond thenb elseb rest
+ (* Access to attributes *)
+ | AttributeCall (src,stype,path,ptype) => attrCall src path ptype
+ (* Access association ends *)
+ | AssociationEndCall (src,stype,path,ptype) => attrCall src path ptype
+ (* Access to variables *)
+ | Variable (name, t) => var name t
+ (* Function calls *)
+ | OperationCall (src,styp,op_name,args,rtype) => opCall src op_name args rtype
+ (* oclAsType *)
+ | OperationWithType (src,styp,"oclAsType",oclType,rtyp) => oclAsType src oclType rtyp
+ (* Print currently unknown stuff using ocl2string. TODO: maybe replace by error "..."? *)
+ | _ => ("/* "^(ocl2string true oclterm)^" */\n", 0)
end
+(** Return the Java code which evaluates the oclterm. *)
fun ocl2java oclterm on = fst (ocl2java' oclterm on)
-(* Convert list of arguments ((string * Rep_OclType.OclType) list) to a comma separated string *)
+(** Convert list of arguments ((string * Rep_OclType.OclType) list) to a comma separated string. *)
fun opargs2string args =
let
fun arg2string (name,typ) = (Rep_OclType.string_of_OclType typ)^" "^name
in
join ", " (List.map arg2string args )
end
-
+
+(** Return ocl formula as a Java comment. *)
+fun oclComment formula = "/* "^(ocl2string false formula)^" */\n"
-(* Check the result of checking a condition *)
-fun checkConditionResult condition name condType uut =
+(** Check the result of checking a condition. *)
+fun checkConditionResult condition name condType ex uut =
let
val name' = case name of SOME t => " "^t
| NONE => ""
in
(fst condition)^
"if(!oclNode"^(Int.toString(snd condition))^".isTrue()){"^
- "\n\tthrow new "^condType^"FailedException(\""^condType^name'^" of "^uut^" failed!\");\n"^
+ "\n\tthrow new "^ex^"(\""^condType^name'^" of "^uut^" failed!\");\n"^
"}\n"
end
-
-(* Create the string which checks preconditions *)
-fun precondString env on curOp =
- let fun getPrecond precond = checkConditionResult (ocl2java' (snd precond) on) (fst precond) "Precondition" ((Rep_Core.name_of_op curOp)^"("^(opargs2string (Rep_Core.arguments_of_op curOp))^")")
+
+(** Extract @pre operations from the postconditions, generate code to save @pre values. *)
+fun preExtract env on curOp =
+ let
+ fun getPres precond =
+ let
+ (* Save the result of attribute/association end calls. *)
+ fun attSave src stype path ptype call = case src of OperationCall (asrc,styp,["oclLib","OclAny","atPre"],[],_) =>
+ let
+ val condstr = ocl2string true precond
+ in
+ if not (preMap.has(condstr)) then
+ let
+ val code = ocl2java' (call (asrc,stype,path,ptype)) on
+ in
+ ((preMap.put condstr (snd code));
+ (fst code))
+ end
+ else
+ ""
+ end
+ | _ => getPres src
+ (* Save the result of function calls. *)
+ fun resSave src styp op_name args rtype = case src of OperationCall (asrc,styp,["oclLib","OclAny","atPre"],[],_) =>
+ let
+ val condstr = ocl2string true asrc
+ in
+ if not (preMap.has(condstr)) then
+ let
+ val code = ocl2java' asrc on
+ in
+ ((preMap.put condstr (snd code));
+ (fst code))
+ end
+ else
+ ""
+ end
+ | _ => (getPres src)^(join "\n" (map (getPres o fst) args))
+ in
+ case precond of
+ OperationCall (src,styp,["oclLib","OclAny","atPre"],[],_) => error "atPre()-operation should not be reached."
+ | OperationCall (src,styp,op_name,args,rtype) => resSave src styp op_name args rtype
+ | Literal (_,_) => ""
+ | If (cond,_,thenb,_,elseb,_,_) => (getPres cond)^(getPres thenb)^(getPres elseb)
+ | AttributeCall (src,stype,path,ptype) => attSave src stype path ptype AttributeCall
+ | AssociationEndCall (src,stype,path,ptype) => attSave src stype path ptype AssociationEndCall
+ | Variable (_,_) => ""
+ | OperationWithType (src,_,_,_,_) => getPres src
+ | _ => ""
+ end
in
- join "\n" (List.map getPrecond (Rep_Core.precondition_of_op curOp))
+ join "\n" (List.map (getPres o snd) (Rep_Core.postcondition_of_op curOp))
end
-(* Create the string which checks postconditions *)
-fun postcondString env on curOp =
- let fun getPostcond postcond = checkConditionResult (ocl2java' (snd postcond) on) (fst postcond) "Postcondition" ((Rep_Core.name_of_op curOp)^"("^(opargs2string (Rep_Core.arguments_of_op curOp))^")")
+(** Create the string which checks preconditions. *)
+fun precondString env on curOp ex =
+ let
+ fun getPrecond precond =
+ (oclComment (snd precond))^
+ (checkConditionResult (ocl2java' (snd precond) on) (fst precond) "Precondition" ex ((Rep_Core.name_of_op curOp)^"("^(opargs2string (Rep_Core.arguments_of_op curOp))^")"))
+ in
+ (preMap.clear();
+ (join "\n" (List.map getPrecond (Rep_Core.precondition_of_op curOp)))^
+ ("\n/* Save values used in @pre-expressions of the postcondition */\n"^
+ (preExtract env on curOp)))
+ end
+
+(** Create the string which checks postconditions. *)
+fun postcondString env on curOp ex =
+ let
+ fun getPostcond postcond =
+ (oclComment (snd postcond))^
+ (checkConditionResult (ocl2java' (snd postcond) on) (fst postcond) "Postcondition" ex ((Rep_Core.name_of_op curOp)^"("^(opargs2string (Rep_Core.arguments_of_op curOp))^")"))
in
join "\n" (List.map getPostcond (Rep_Core.postcondition_of_op curOp))
end
-(* Create the string which checks invariants *)
-fun invString env on curCl =
- let fun getInvariant invariant = checkConditionResult (ocl2java' (snd invariant) on) (fst invariant) "Invariant" (Rep_Core.short_name_of curCl)
+(** Create the string which checks invariants. *)
+fun invString env on curCl ex =
+ let
+ fun getInvariant invariant =
+ (oclComment (snd invariant))^
+ (checkConditionResult (ocl2java' (snd invariant) on) (fst invariant) "Invariant" ex (Rep_Core.short_name_of curCl))
in
join "\n" (List.map getInvariant (Rep_Core.invariant_of curCl))
end
diff --git a/src/ocl2string.sml b/src/ocl2string.sml
index 515bb3f..69edd3b 100644
--- a/src/ocl2string.sml
+++ b/src/ocl2string.sml
@@ -82,7 +82,10 @@ fun ocl2string show_types oclterm =
(* Literal *)
(**************************************)
(* OCL Boolean *)
- Literal (lit, typ) => if show_types
+ Literal (s, String) => if show_types
+ then "(\""^s^"\":"^(string_of_OclType String)^")"
+ else "\""^s^"\""
+ | Literal (lit, typ) => if show_types
then "("^lit^":"^(string_of_OclType typ)^")"
else lit
| CollectionLiteral (parts, typ as Bag x) => "Bag{"^(collection_part_list show_types parts)^"}"
@@ -100,8 +103,8 @@ fun ocl2string show_types oclterm =
^" else "^(ocl2string show_types eterm)^" endif"
| AssociationEndCall(src,styp,path,ptyp) => if show_types
then "(("^(ocl2string show_types src)^":"^(string_of_OclType styp)^")."
- ^(string_of_path path)^":"^(string_of_OclType ptyp)^")"
- else (ocl2string show_types src)^"."^(string_of_path path)
+ ^(hd (rev path))^":"^(string_of_OclType ptyp)^")"
+ else (ocl2string show_types src)^"."^(hd (rev path))
| AttributeCall(src,styp,path,ptyp) => if show_types
then "(("^(ocl2string show_types src)^":"^(string_of_OclType styp)^")."
^(hd (rev path))^":"^(string_of_OclType ptyp)^")"
@@ -154,7 +157,7 @@ fun ocl2string show_types oclterm =
| OperationCall (src,styp,op_name,args,t) => if show_types
then "("^(ocl2string show_types src)^"."^(hd (rev op_name))
^"("^arglist show_types args^")"
- ^")"^(string_of_OclType t)
+ ^"):"^(string_of_OclType t)
else (ocl2string show_types src)^"."^(hd (rev op_name))
^"("^arglist show_types args^")"