From 4bd8124d0310d7a50bd03ad7c6886cc4e09c8a71 Mon Sep 17 00:00:00 2001 From: "Achim D. Brucker" Date: Mon, 12 Mar 2007 10:33:47 +0000 Subject: [PATCH] merged final version of Manfred's semester thesis git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@6239 3260e6d1-4efc-4170-b0a7-36055960796d --- src/codegen/ROOT.ML | 1 + src/codegen/codegen.cm | 1 + src/codegen/codegen.mlb | 1 + src/codegen/codegen.sml | 3 +- src/codegen/java_cartridge.sml | 17 +- src/codegen/junit_cartridge.sml | 6 +- src/codegen/maven_pom_cartridge.sml | 56 ++++ src/codegen/templates/java.tpl | 26 +- src/codegen/templates/java_ocl.tpl | 116 +++++-- src/codegen/templates/junit.tpl | 109 +++--- src/codegen/templates/maven_pom.tpl | 45 +++ src/codegen/templates/tpl.el | 2 +- src/codegen/tpl_parser.sml | 2 +- src/ocl2dresdenjava.sml | 497 +++++++++++++++++++++------- src/ocl2string.sml | 11 +- 15 files changed, 669 insertions(+), 224 deletions(-) create mode 100644 src/codegen/maven_pom_cartridge.sml create mode 100644 src/codegen/templates/maven_pom.tpl 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@tab1.5 +@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^")"