From 47e8852dcb9694f113a8bb89d67775fe7633a596 Mon Sep 17 00:00:00 2001 From: "Achim D. Brucker" Date: Fri, 9 Feb 2007 11:14:53 +0000 Subject: [PATCH] merge with work of Manfred (based on rev. 35191) git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@6108 3260e6d1-4efc-4170-b0a7-36055960796d --- src/ROOT.ML | 1 + src/codegen/LIB.ML | 206 ++++----- src/codegen/ROOT.ML | 126 ++--- src/codegen/base_cartridge.sig | 92 ++-- src/codegen/base_cartridge.sml | 612 +++++++++++++------------ src/codegen/c#_cartridge.sml | 204 ++++----- src/codegen/c#_net1_cartridge.sml | 206 ++++----- src/codegen/c#sm_cartridge.sml | 522 ++++++++++----------- src/codegen/cartridge.sig | 124 ++--- src/codegen/codegen.mlb | 2 - src/codegen/codegen.sml | 194 ++++---- src/codegen/gcg_core.sig | 50 +- src/codegen/gcg_core.sml | 270 +++++------ src/codegen/gcg_helper.sml | 142 +++--- src/codegen/java_cartridge.sml | 224 +++++---- src/codegen/junit_cartridge.sml | 19 +- src/codegen/secureuml_cartridge.sig | 80 ++-- src/codegen/templates/C#.tpl | 134 +++--- src/codegen/templates/C#_SM.tpl | 364 +++++++-------- src/codegen/templates/C#_SecureUML.tpl | 332 +++++++------- src/codegen/templates/base.tpl | 54 +-- src/codegen/templates/java.tpl | 84 +++- src/codegen/templates/java_ocl.tpl | 61 +++ src/codegen/templates/junit.tpl | 76 ++- src/codegen/templates/tpl.el | 2 +- src/codegen/tpl_parser.sig | 80 ++-- src/codegen/tpl_parser.sml | 424 ++++++++--------- src/library.sml | 4 + src/ocl2dresdenjava.sml | 238 ++++++++++ src/rep_core.sml | 13 + src/rep_ocl.sml | 34 +- src/rep_state_machines.sml | 4 +- src/su4sml.cm | 1 + src/su4sml.mlb | 5 +- 34 files changed, 2730 insertions(+), 2254 deletions(-) create mode 100644 src/codegen/templates/java_ocl.tpl create mode 100644 src/ocl2dresdenjava.sml diff --git a/src/ROOT.ML b/src/ROOT.ML index 9d206fa..1a2312c 100644 --- a/src/ROOT.ML +++ b/src/ROOT.ML @@ -88,6 +88,7 @@ use "rep.sml"; (* support functions *) use "ocl2string.sml"; +use "ocl2dresdenjava.sml"; (* ****************************************************** *) (* Main Conversion Processes *) diff --git a/src/codegen/LIB.ML b/src/codegen/LIB.ML index 1a64151..99ed11b 100644 --- a/src/codegen/LIB.ML +++ b/src/codegen/LIB.ML @@ -1,103 +1,103 @@ -(***************************************************************************** - * su4sml - a SecureUML repository for SML - * - * ROOT.ML - main "ROOT.ML" file for ... - * Copyright (C) 2005 Raphael - * - * 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. - ******************************************************************************) - -OS.FileSys.chDir "../lib/su4sml/src"; - -use "library.sml"; - - -(* library should be opend locally for MLton compatibility... *) -(* open library; *) - - -(* ****************************************************** *) -(* Load the (foreign) fxp-module providing - an elemantary library in processing xml documents. *) -OS.FileSys.chDir "../lib/fxp/src"; -use "ROOT.ML"; -OS.FileSys.chDir "../../../src"; - - -(* ****************************************************** *) -(* Abstract Representation of an XMI File of a UML Model. - - References kept - - only "interesting" parts were represented - - structural simplifications whereever needed for - our applications. - - Layout Information skippedi - - the structure is oriented towards UML 1.5 - (although the supported Poseidon is apparantly based - on Version 1.4 or something ...). *) -use "xmi_ocl.sml"; -use "xmi_datatypes.sml"; -use "xmi_extension_mechanisms.sml"; -use "xmi_state_machines.sml"; -use "xmi_activity_graphs.sml"; -use "xmi_core.sml"; -use "xmi.sml"; - - - -(* ****************************************************** *) -(* Abstract Representation ("The Repository") of a UML model. - - References resolved - - only supported parts were represented - - structural simplifications whereever needed for - our applications. *) -use "rep_ocl.sig"; -use "rep_ocl.sml"; -use "rep_state_machines.sig"; -use "rep_state_machines.sml"; -use "rep_activity_graphs.sig"; -use "rep_activity_graphs.sml"; -use "rep_core.sig"; -use "rep_core.sml"; -(* use "rep_secureuml.sig"; *) -(* use "rep_secureuml.sml"; *) -use "rep.sig"; -use "rep.sml"; - - - - - -(* support functions *) -use "ocl2string.sml"; - -(* ****************************************************** *) -(* Main Conversion Processes *) -use "xmltree_parser.sml"; (* provides explicit xml-tree data structure, - abstracts away fxp package. *) -use "xml2xmi.sml"; (* conversion XML to XMI *); - -use "xmi_idtable.sml"; (* auxiliary table to store and dereference xmi.id's *) -use "xmi2rep.sml"; (* conversion XMI to Rep *) - -use "mds.sig"; -use "component_uml.sml"; -use "secure_uml.sml"; -use "rep_secure.sig"; -use "rep_secure.sml"; - - -OS.FileSys.chDir "../../../src"; +(***************************************************************************** + * su4sml - a SecureUML repository for SML + * + * ROOT.ML - main "ROOT.ML" file for ... + * Copyright (C) 2005 Raphael + * + * 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. + ******************************************************************************) + +OS.FileSys.chDir "../lib/su4sml/src"; + +use "library.sml"; + + +(* library should be opend locally for MLton compatibility... *) +(* open library; *) + + +(* ****************************************************** *) +(* Load the (foreign) fxp-module providing + an elemantary library in processing xml documents. *) +OS.FileSys.chDir "../lib/fxp/src"; +use "ROOT.ML"; +OS.FileSys.chDir "../../../src"; + + +(* ****************************************************** *) +(* Abstract Representation of an XMI File of a UML Model. + - References kept + - only "interesting" parts were represented + - structural simplifications whereever needed for + our applications. + - Layout Information skippedi + - the structure is oriented towards UML 1.5 + (although the supported Poseidon is apparantly based + on Version 1.4 or something ...). *) +use "xmi_ocl.sml"; +use "xmi_datatypes.sml"; +use "xmi_extension_mechanisms.sml"; +use "xmi_state_machines.sml"; +use "xmi_activity_graphs.sml"; +use "xmi_core.sml"; +use "xmi.sml"; + + + +(* ****************************************************** *) +(* Abstract Representation ("The Repository") of a UML model. + - References resolved + - only supported parts were represented + - structural simplifications whereever needed for + our applications. *) +use "rep_ocl.sig"; +use "rep_ocl.sml"; +use "rep_state_machines.sig"; +use "rep_state_machines.sml"; +use "rep_activity_graphs.sig"; +use "rep_activity_graphs.sml"; +use "rep_core.sig"; +use "rep_core.sml"; +(* use "rep_secureuml.sig"; *) +(* use "rep_secureuml.sml"; *) +use "rep.sig"; +use "rep.sml"; + + + + + +(* support functions *) +use "ocl2string.sml"; + +(* ****************************************************** *) +(* Main Conversion Processes *) +use "xmltree_parser.sml"; (* provides explicit xml-tree data structure, + abstracts away fxp package. *) +use "xml2xmi.sml"; (* conversion XML to XMI *); + +use "xmi_idtable.sml"; (* auxiliary table to store and dereference xmi.id's *) +use "xmi2rep.sml"; (* conversion XMI to Rep *) + +use "mds.sig"; +use "component_uml.sml"; +use "secure_uml.sml"; +use "rep_secure.sig"; +use "rep_secure.sml"; + + +OS.FileSys.chDir "../../../src"; diff --git a/src/codegen/ROOT.ML b/src/codegen/ROOT.ML index f6bba60..4718722 100644 --- a/src/codegen/ROOT.ML +++ b/src/codegen/ROOT.ML @@ -1,61 +1,65 @@ -(***************************************************************************** - * su4sml GCG - Generic Code Generator - * - * ROOT.ML - main "ROOT.ML" file for su4sml-GCG - * Copyright (C) 2005 Raphael Eidenbenz - * - * This file is part of su4sml-gcg. - * - * 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. - ******************************************************************************) - - -use "gcg_helper.sml"; -use "stringHandling.sml"; -(*use "examples/simple.sml"; *) -(*use "examples/ebank.sml";*) - -use "tpl_parser.sml"; - -(* Base *) -use "cartridge.sig"; -use "base_cartridge.sml"; - -(* C# *) -use "c#_cartridge.sml"; -use "c#_net1_cartridge.sml"; - -(* SecureUML *) -use "design_cartridge.sig"; -use "secureuml_cartridge.sml"; -use "componentuml_cartridge.sml"; - - -use "java_cartridge.sml"; -use "junit_cartridge.sml"; - - -(* Statemachines *) -use "SM_helper.sml"; -use "stateMachineTypes.sml"; -use "stateMachine.sml"; -use "c#sm_cartridge.sig"; -use "c#sm_cartridge.sml"; - -use "gcg_core.sig"; -use "gcg_core.sml"; - -use "codegen.sml"; - +(***************************************************************************** + * su4sml GCG - Generic Code Generator + * + * ROOT.ML - main "ROOT.ML" file for su4sml-GCG + * Copyright (C) 2005 Raphael Eidenbenz + * + * This file is part of su4sml-gcg. + * + * 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. + ******************************************************************************) + + +use "gcg_helper.sml"; +use "stringHandling.sml"; +(*use "examples/simple.sml"; *) +(*use "examples/ebank.sml";*) + +use "tpl_parser.sml"; + +(* Base *) +use "cartridge.sig"; +use "base_cartridge.sml"; + +(* C# *) +use "c#_cartridge.sml"; +use "c#_net1_cartridge.sml"; + +(* SecureUML *) +use "design_cartridge.sig"; +use "secureuml_cartridge.sml"; +use "componentuml_cartridge.sml"; + + +use "java_cartridge.sml"; +use "junit_cartridge.sml"; + + +(* Statemachines *) +use "SM_helper.sml"; +use "stateMachineTypes.sml"; +use "stateMachine.sml"; +use "c#sm_cartridge.sig"; +use "c#sm_cartridge.sml"; + +use "gcg_core.sig"; +use "gcg_core.sml"; + +use "codegen.sml"; + + + + + diff --git a/src/codegen/base_cartridge.sig b/src/codegen/base_cartridge.sig index 8d509ce..18b7840 100644 --- a/src/codegen/base_cartridge.sig +++ b/src/codegen/base_cartridge.sig @@ -1,46 +1,46 @@ -(***************************************************************************** - * su4sml - a SecureUML repository for SML - * - * base_cartridge.sig - an extended signature of CARTRIDGE specific - * for the base cartridge - * Copyright (C) 2005 Raphael Eidenbenz - * - * 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. - ******************************************************************************) - -(** - * This cartridge knows about the basic elements of UML class diagrams. - * The elements are classifiers, attributes, and operations with their - * parameters in terms of the Rep interface - *) -signature BASE_CARTRIDGE = -sig - include CARTRIDGE - -(** returns the current classifier. *) -val curClassifier: environment -> Rep.Classifier option - -(** returns the current attribute *) -val curAttribute: environment -> Rep.attribute option - -(** returns the current operation *) -val curOperation: environment -> Rep.operation option - -(** returns the current operation parameter *) -val curArgument : environment -> (string * Rep_OclType.OclType) option - -end +(***************************************************************************** + * su4sml - a SecureUML repository for SML + * + * base_cartridge.sig - an extended signature of CARTRIDGE specific + * for the base cartridge + * Copyright (C) 2005 Raphael Eidenbenz + * + * 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. + ******************************************************************************) + +(** + * This cartridge knows about the basic elements of UML class diagrams. + * The elements are classifiers, attributes, and operations with their + * parameters in terms of the Rep interface + *) +signature BASE_CARTRIDGE = +sig + include CARTRIDGE + +(** returns the current classifier. *) +val curClassifier: environment -> Rep.Classifier option + +(** returns the current attribute *) +val curAttribute: environment -> Rep.attribute option + +(** returns the current operation *) +val curOperation: environment -> Rep.operation option + +(** returns the current operation parameter *) +val curArgument : environment -> (string * Rep_OclType.OclType) option + +end diff --git a/src/codegen/base_cartridge.sml b/src/codegen/base_cartridge.sml index 3bb9725..c4a36a9 100644 --- a/src/codegen/base_cartridge.sml +++ b/src/codegen/base_cartridge.sml @@ -1,296 +1,316 @@ -(***************************************************************************** - * su4sml - a SecureUML repository for SML - * - * simple.sml - a simple test file for the core repository - * Copyright (C) 2005 Raphael Eidenbenz - * - * 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. - ******************************************************************************) - -(** - * This cartridge knows about the basic elements of UML class diagrams. - * The elements are classifiers, attributes, and operations with their - * parameters in terms of the Rep interface - *) -signature BASE_CARTRIDGE = -sig - include CARTRIDGE - -(** returns the current classifier. *) -val curClassifier: environment -> Rep.Classifier option - -(** returns the current attribute *) -val curAttribute: environment -> Rep.attribute option - -(** returns the current association end *) -val curAssociationEnd : environment -> Rep.associationend option - -(** returns the current operation *) -val curOperation: environment -> Rep.operation option - -(** returns the current operation parameter *) -val curArgument : environment -> (string * Rep_OclType.OclType) option - - -end - - -structure Base_Cartridge : BASE_CARTRIDGE = -struct -open library -(* translation functions *) -(* type translation table *) - - -fun oclType2Native t = Rep_OclType.string_of_OclType t - -fun visibility2Native XMI.public = "public" - | visibility2Native XMI.private = "private" - | visibility2Native XMI.protected = "protected" - | visibility2Native XMI.package = "package" - -fun scope2Native XMI.ClassifierScope = "ClassifierScope" - | scope2Native XMI.InstanceScope = "InstanceScope" - - -type Model = Rep.Classifier list - -type environment = { model : Model, - counter : int ref, - curClassifier: Rep_Core.Classifier option, - curAssocEnd : Rep_Core.associationend option, - curOperation : Rep_Core.operation option, - curAttribute : Rep_Core.attribute option , - curArgument : (string * Rep_OclType.OclType) option - } - -(* service functions for other cartridges to have access to the current - * list items - *) -fun getModel (env : environment) = #model env -fun curClassifier (env : environment) = (#curClassifier env) -fun curAttribute (env : environment) = (#curAttribute env) -fun curAssociationEnd (env : environment) = (#curAssocEnd env) -fun curOperation (env : environment) = (#curOperation env) -fun curArgument (env : environment) = (#curArgument env) - -fun curClassifier' (env : environment) = Option.valOf((#curClassifier env)) -fun curAttribute' (env : environment) = Option.valOf((#curAttribute env)) -fun curAssociationEnd' (env : environment) = Option.valOf((#curAssocEnd env)) -fun curOperation' (env : environment) = Option.valOf((#curOperation env)) -fun curArgument' (env : environment) = Option.valOf((#curArgument env)) - -fun initEnv model = { model = model, - counter = ref 0, - curClassifier = NONE, - curAssocEnd = NONE, - curOperation = NONE, - curAttribute = NONE, - curArgument = NONE } : environment - -fun curClassifierPackageToString env p2sfun = (case (#curClassifier env) of - NONE => p2sfun - (Rep.package_of - (hd (#model env))) - | SOME c => p2sfun - (Rep.package_of - (curClassifier' env))) - -(* FIX: check for NONEs in arguments environment *) -(** - * lookup base cartridge specific string-valued variables - * The base cartridge knows the following variables: - * classifier_name, classifier_package, classifier_parent, - * attribute_name, attribute_type, attribute_visibility, - * attribute_scope, operation_name, operation_result_type, - * operation_visibility, operation_scope, argument_name, argument_type - *) -fun lookup env "classifier_name" = Rep_Core.short_name_of (curClassifier' env) - | lookup env "classifier_package" = curClassifierPackageToString env Rep_OclType.string_of_path - | lookup env "classifier_package_path" = curClassifierPackageToString env Rep_OclType.pathstring_of_path - | lookup env "classifier_parent" = Rep_Core.short_parent_name_of (curClassifier' env) - | lookup env "attribute_name" = #name (curAttribute' env) - | lookup env "attribute_type" = oclType2Native (#attr_type - (curAttribute' env)) - | lookup env "attribute_visibility" = visibility2Native(#visibility - (curAttribute' env)) - | lookup env "attribute_scope" = scope2Native (#scope (curAttribute' env)) - | lookup env "assocend_name" = (#name o valOf o #curAssocEnd) env - | lookup env "assocend_type" = (oclType2Native o #aend_type o valOf o #curAssocEnd) env - | lookup env "operation_name" = Rep.name_of_op (curOperation' env) - | lookup env "operation_result_type" = oclType2Native (Rep.result_of_op - (curOperation' env)) - | lookup env "operation_visibility" = visibility2Native (#visibility - (curOperation' env)) - | lookup env "operation_scope" = scope2Native (#scope (curOperation' env)) - | lookup env "argument_name" = #1 (curArgument' env) - | lookup env "argument_type" = oclType2Native (#2 (curArgument' env)) - | lookup env "counter" = Int.toString (!(#counter env)) - | lookup env "counter_next" = ((#counter env) := !(#counter env)+1; - Int.toString (!(#counter env))) - | lookup _ s = (warn ("in Base_Cartridge.lookup: unknown variable \""^s^"\"."); "$"^s^"$") - - -(** - * evaluate base cartridge specific predicates. - * The base cartridge supports the following predicates: - * isClass, isInterface, isEnumeration, isPrimitive, hasParent, - * first_classifier, first_attribute, first_operation, first_argument, - * last_classifier, last_attribute, last_operation, last_argument, - * attribute_isPublic, attribute_isProtected, attribute_isPrivate, - * attribute_isPackage, attribute_isStatic, operation_isPublic, - * operation_isPrivate, operation_isProtected, operation_isPackage, - * operation_isStatic, - *) -fun test env "isClass" = (case (#curClassifier env) of - SOME (Rep.Class{...}) => true - | _ => false) - | test env "isInterface" = (case (#curClassifier env) of - SOME (Rep.Interface{...}) => true - | _ => false) - | test env "isEnumeration" = (case (#curClassifier env) of - SOME (Rep.Enumeration{...}) => true - | _ => false) - | test env "isPrimitive" = (case (#curClassifier env) of - SOME (Rep.Primitive{...}) => true - | _ => false) - | test env "hasParent" = let val parentName = - Rep_OclType.string_of_path - (Rep.parent_name_of (curClassifier' env)) - in - (parentName <> "oclLib.OclAny") - end - | test env "hasOperations" = (length (Rep_Core.operations_of (curClassifier' env))) > 0 - | test env "first_classifier" = (curClassifier' env = hd (#model env)) - | test env "first_attribute" = (curAttribute' env - = hd (Rep_Core.attributes_of (curClassifier' env))) - | test env "first_operation" = (curOperation' env - = hd (Rep_Core.operations_of (curClassifier' env))) - | test env "first_argument" = (curArgument' env - = hd (Rep_Core.arguments_of_op (curOperation' env))) - | test env "last_classifier" = (curClassifier' env = List.last (#model env)) - | test env "last_attribute" = (curAttribute' env = - List.last (Rep_Core.attributes_of - (curClassifier' env))) - | test env "last_operation" = (curOperation' env = - List.last (Rep_Core.operations_of - (curClassifier' env))) - | test env "last_argument" = (curArgument' env - = List.last (Rep_Core.arguments_of_op - (curOperation' env))) - | test env "attribute_isPublic" = ((#visibility (curAttribute' env)) = XMI.public) - | test env "attribute_isPrivate" = ((#visibility (curAttribute' env)) = XMI.private) - | test env "attribute_isProtected" = ((#visibility (curAttribute' env)) = XMI.protected) - | test env "attribute_isPackage" = ((#visibility (curAttribute' env)) = XMI.package) - | test env "attribute_isStatic" = ((#scope (curAttribute' env)) = XMI.ClassifierScope) - | test env "operation_isPublic" = ((#visibility (curOperation' env)) = XMI.public) - | test env "operation_isPrivate" = ((#visibility (curOperation' env)) = XMI.private) - | test env "operation_isProtected" = ((#visibility (curOperation' env)) = XMI.protected) - | test env "operation_isPackage" = ((#visibility (curOperation' env)) = XMI.package) - | test env "operation_isStatic" = ((#scope (curOperation' env)) = XMI.ClassifierScope) - | test env "operation_isQuery" = #isQuery (curOperation' env) - | test env s = error ("in Base_Cartridge.test: undefined predicate: \""^s^"\".") - - -(* fun foreach_classifier: environment -> environment list *) -fun foreach_classifier (env : environment) - = let val cl = (#model env) - fun env_from_classifier c = { model = #model env, - counter = #counter env, - curClassifier= SOME c, - curAssocEnd = NONE, - curOperation = NONE, - curAttribute = NONE, - curArgument = NONE } - in - List.map env_from_classifier cl - end - -fun foreach_attribute (env : environment) - = let val attrs = Rep_Core.attributes_of (curClassifier' env) - fun env_from_attr a = { model = #model env, - counter = #counter env, - curClassifier = SOME (curClassifier' env), - curAssocEnd = NONE, - curOperation = NONE, - curAttribute = SOME a, - curArgument = NONE } - in - List.map env_from_attr attrs - end - -fun foreach_operation (env : environment) - = let val ops = Rep_Core.operations_of (curClassifier' env) - fun env_from_op operation = { model = #model env, - counter = #counter env, - curClassifier = SOME (curClassifier' env), - curOperation = SOME operation, - curAssocEnd = NONE, - curAttribute = NONE, - curArgument = NONE } - in - List.map env_from_op ops - end - -fun foreach_argument (env : environment) - = let val args = Rep_Core.arguments_of_op (curOperation' env) - fun env_from_argument arg = { model = #model env, - counter = #counter env, - curClassifier = SOME (curClassifier' env), - curOperation = SOME (curOperation' env), - curAssocEnd = NONE, - curAttribute = NONE, - curArgument = SOME arg } - in - List.map env_from_argument args - end - -fun foreach_assocend (env : environment) - = let val aends = Rep_Core.associationends_of (curClassifier' env) - fun env_from_argument arg = { model = #model env, - counter = #counter env, - curClassifier = SOME (curClassifier' env), - curAssocEnd = SOME arg, - curOperation = NONE, - curAttribute = NONE, - curArgument = NONE } - in - List.map env_from_argument aends - end - -(** - * compute the base cartridge specific lists. - * The base cartridge supports the following lists: - * classifier_list iterates over all classifiers of the model, - * attribute_list iterates over all attributes of the current - * classifier, operation_list iterates over all operations of the - * current classifier, argument_list iterates over all arguments of - * the current operation - *) -fun foreach "classifier_list" env = foreach_classifier env - | foreach "attribute_list" env = foreach_attribute env - | foreach "operation_list" env = foreach_operation env - | foreach "argument_list" env = foreach_argument env - | foreach "assocend_list" env = foreach_assocend env - (* hier muss man das Environment noch etwas umpacken - | foreach listType env = map (pack env) - (.foreach name (unpack env)) - *) - | foreach s _ = (error_msg ("in Base_Cartridge.foreach: unknown list \""^s^"\"."); - []) - -end +(***************************************************************************** + * su4sml - a SecureUML repository for SML + * + * simple.sml - a simple test file for the core repository + * Copyright (C) 2005 Raphael Eidenbenz + * + * 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. + ******************************************************************************) + +(** + * This cartridge knows about the basic elements of UML class diagrams. + * The elements are classifiers, attributes, and operations with their + * parameters in terms of the Rep interface + *) +signature BASE_CARTRIDGE = +sig + include CARTRIDGE + +(** returns the current classifier. *) +val curClassifier: environment -> Rep.Classifier option + +(** returns the current attribute *) +val curAttribute: environment -> Rep.attribute option + +(** returns the current association end *) +val curAssociationEnd : environment -> Rep.associationend option + +(** returns the current operation *) +val curOperation: environment -> Rep.operation option + +(** returns the current operation parameter *) +val curArgument : environment -> (string * Rep_OclType.OclType) option + + +end + + +structure Base_Cartridge : BASE_CARTRIDGE = +struct +open library +(* translation functions *) +(* type translation table *) + + +fun oclType2Native t = Rep_OclType.string_of_OclType t + +fun visibility2Native XMI.public = "public" + | visibility2Native XMI.private = "private" + | visibility2Native XMI.protected = "protected" + | visibility2Native XMI.package = "package" + +fun scope2Native XMI.ClassifierScope = "ClassifierScope" + | scope2Native XMI.InstanceScope = "InstanceScope" + + +type Model = Rep.Classifier list + +type environment = { model : Model, + counter : int ref, + curClassifier: Rep_Core.Classifier option, + curAssocEnd : Rep_Core.associationend option, + curOperation : Rep_Core.operation option, + curAttribute : Rep_Core.attribute option , + curArgument : (string * Rep_OclType.OclType) option + } + +(* service functions for other cartridges to have access to the current + * list items + *) +fun getModel (env : environment) = #model env +fun curClassifier (env : environment) = (#curClassifier env) +fun curAttribute (env : environment) = (#curAttribute env) +fun curAssociationEnd (env : environment) = (#curAssocEnd env) +fun curOperation (env : environment) = (#curOperation env) +fun curArgument (env : environment) = (#curArgument env) + +fun curClassifier' (env : environment) = Option.valOf((#curClassifier env)) +fun curAttribute' (env : environment) = Option.valOf((#curAttribute env)) +fun curAssociationEnd' (env : environment) = Option.valOf((#curAssocEnd env)) +fun curOperation' (env : environment) = Option.valOf((#curOperation env)) +fun curArgument' (env : environment) = Option.valOf((#curArgument env)) + +fun initEnv model = { model = model, + counter = ref 0, + curClassifier = NONE, + curAssocEnd = NONE, + curOperation = NONE, + curAttribute = NONE, + curArgument = NONE } : environment + +fun curClassifierPackageToString env p2sfun = (case (#curClassifier env) of + NONE => p2sfun + (Rep.package_of + (hd (#model env))) + | SOME c => p2sfun + (Rep.package_of + (curClassifier' env))) + +(* FIX: check for NONEs in arguments environment *) +(** + * lookup base cartridge specific string-valued variables + * The base cartridge knows the following variables: + * classifier_name, classifier_package, classifier_parent, + * attribute_name, attribute_type, attribute_visibility, + * attribute_scope, operation_name, operation_result_type, + * operation_visibility, operation_scope, argument_name, argument_type + *) +fun lookup env "classifier_name" = Rep_Core.short_name_of (curClassifier' env) + | lookup env "classifier_package" = curClassifierPackageToString env Rep_OclType.string_of_path + | lookup env "classifier_package_path" = curClassifierPackageToString env Rep_OclType.pathstring_of_path + | lookup env "classifier_parent" = Rep_Core.short_parent_name_of (curClassifier' env) + | lookup env "attribute_name" = #name (curAttribute' env) + | lookup env "attribute_type" = oclType2Native (#attr_type + (curAttribute' env)) + | lookup env "attribute_visibility" = visibility2Native(#visibility + (curAttribute' env)) + | lookup env "attribute_scope" = scope2Native (#scope (curAttribute' env)) + | lookup env "assocend_name" = (#name o valOf o #curAssocEnd) env + | lookup env "assocend_type" = (oclType2Native o #aend_type o valOf o #curAssocEnd) env + | lookup env "operation_name" = Rep.name_of_op (curOperation' env) + | lookup env "operation_result_type" = oclType2Native (Rep.result_of_op + (curOperation' env)) + | lookup env "operation_visibility" = visibility2Native (#visibility + (curOperation' env)) + | lookup env "operation_scope" = scope2Native (#scope (curOperation' env)) + | lookup env "argument_name" = #1 (curArgument' env) + | lookup env "argument_type" = oclType2Native (#2 (curArgument' env)) + | lookup env "counter" = Int.toString (!(#counter env)) + | lookup env "counter_next" = ((#counter env) := !(#counter env)+1; + Int.toString (!(#counter env))) + | lookup _ s = (warn ("in Base_Cartridge.lookup: unknown variable \""^s^"\"."); "$"^s^"$") + + +(** + * evaluate base cartridge specific predicates. + * The base cartridge supports the following predicates: + * isClass, isInterface, isEnumeration, isPrimitive, hasParent, + * first_classifier, first_attribute, first_operation, first_argument, + * last_classifier, last_attribute, last_operation, last_argument, + * attribute_isPublic, attribute_isProtected, attribute_isPrivate, + * attribute_isPackage, attribute_isStatic, operation_isPublic, + * operation_isPrivate, operation_isProtected, operation_isPackage, + * operation_isStatic, + *) +fun test env "isClass" = (case (#curClassifier env) of + SOME (Rep.Class{...}) => true + | _ => false) + | test env "notClass" = not (test env "isClass") + | test env "isInterface" = (case (#curClassifier env) of + SOME (Rep.Interface{...}) => true + | _ => false) + | test env "notInterface" = not (test env "isInterface") + | test env "isEnumeration" = (case (#curClassifier env) of + SOME (Rep.Enumeration{...}) => true + | _ => false) + | test env "isPrimitive" = (case (#curClassifier env) of + SOME (Rep.Primitive{...}) => true + | _ => false) + | test env "hasParent" = let val parentName = + Rep_OclType.string_of_path + (Rep.parent_name_of (curClassifier' env)) + in + (parentName <> "oclLib.OclAny") + end + | test env "hasOperations" = (length (Rep_Core.operations_of (curClassifier' env))) > 0 + | test env "first_classifier" = (curClassifier' env = hd (#model env)) + | test env "first_attribute" = (curAttribute' env + = hd (Rep_Core.attributes_of (curClassifier' env))) + | test env "first_operation" = (curOperation' env + = hd (Rep_Core.operations_of (curClassifier' env))) + | test env "first_argument" = (curArgument' env + = hd (Rep_Core.arguments_of_op (curOperation' env))) + | test env "last_classifier" = (curClassifier' env = List.last (#model env)) + | test env "last_attribute" = (curAttribute' env = + List.last (Rep_Core.attributes_of + (curClassifier' env))) + | test env "last_operation" = (curOperation' env = + List.last (Rep_Core.operations_of + (curClassifier' env))) + | test env "last_argument" = (curArgument' env + = List.last (Rep_Core.arguments_of_op + (curOperation' env))) + | test env "attribute_isPublic" = ((#visibility (curAttribute' env)) = XMI.public) + | test env "attribute_isPrivate" = ((#visibility (curAttribute' env)) = XMI.private) + | test env "attribute_isProtected" = ((#visibility (curAttribute' env)) = XMI.protected) + | test env "attribute_isPackage" = ((#visibility (curAttribute' env)) = XMI.package) + | test env "attribute_isStatic" = ((#scope (curAttribute' env)) = XMI.ClassifierScope) + | test env "operation_isPublic" = ((#visibility (curOperation' env)) = XMI.public) + | test env "operation_isPrivate" = ((#visibility (curOperation' env)) = XMI.private) + | test env "operation_isProtected" = ((#visibility (curOperation' env)) = XMI.protected) + | test env "operation_isPackage" = ((#visibility (curOperation' env)) = XMI.package) + | test env "operation_isStatic" = ((#scope (curOperation' env)) = XMI.ClassifierScope) + | test env "operation_isQuery" = #isQuery (curOperation' env) + | test env s = error ("in Base_Cartridge.test: undefined predicate: \""^s^"\".") + + +(* fun foreach_classifier: environment -> environment list *) +fun foreach_classifier (env : environment) + = let val cl = (#model env) + fun env_from_classifier c = { model = #model env, + counter = #counter env, + curClassifier= SOME c, + curAssocEnd = NONE, + curOperation = NONE, + curAttribute = NONE, + curArgument = NONE } + in + List.map env_from_classifier cl + end + + +(* Only iterate over non-primitive classifiers such as Class, Interface, Enum *) +fun foreach_nonprimitive_classifier (env : environment) + = let val cl = List.filter (fn cenv => (case cenv of + Rep.Primitive{...} => false + | _ => true)) (#model env) + fun env_from_classifier c = { model = (#model env), + counter = #counter env, + curClassifier = SOME c, + curAssocEnd = NONE, + curOperation = NONE, + curAttribute = NONE, + curArgument = NONE } + in + List.map env_from_classifier cl + end + +fun foreach_attribute (env : environment) + = let val attrs = Rep_Core.attributes_of (curClassifier' env) + fun env_from_attr a = { model = #model env, + counter = #counter env, + curClassifier = SOME (curClassifier' env), + curAssocEnd = NONE, + curOperation = NONE, + curAttribute = SOME a, + curArgument = NONE } + in + List.map env_from_attr attrs + end + +fun foreach_operation (env : environment) + = let val ops = Rep_Core.operations_of (curClassifier' env) + fun env_from_op operation = { model = #model env, + counter = #counter env, + curClassifier = SOME (curClassifier' env), + curOperation = SOME operation, + curAssocEnd = NONE, + curAttribute = NONE, + curArgument = NONE } + in + List.map env_from_op ops + end + +fun foreach_argument (env : environment) + = let val args = Rep_Core.arguments_of_op (curOperation' env) + fun env_from_argument arg = { model = #model env, + counter = #counter env, + curClassifier = SOME (curClassifier' env), + curOperation = SOME (curOperation' env), + curAssocEnd = NONE, + curAttribute = NONE, + curArgument = SOME arg } + in + List.map env_from_argument args + end + +fun foreach_assocend (env : environment) + = let val aends = Rep_Core.associationends_of (curClassifier' env) + fun env_from_argument arg = { model = #model env, + counter = #counter env, + curClassifier = SOME (curClassifier' env), + curAssocEnd = SOME arg, + curOperation = NONE, + curAttribute = NONE, + curArgument = NONE } + in + List.map env_from_argument aends + end + +(** + * compute the base cartridge specific lists. + * The base cartridge supports the following lists: + * classifier_list iterates over all classifiers of the model, + * attribute_list iterates over all attributes of the current + * classifier, operation_list iterates over all operations of the + * current classifier, argument_list iterates over all arguments of + * the current operation + *) +fun foreach "classifier_list" env = foreach_classifier env + | foreach "attribute_list" env = foreach_attribute env + | foreach "operation_list" env = foreach_operation env + | foreach "argument_list" env = foreach_argument env + | foreach "nonprimitive_classifier_list" env = foreach_nonprimitive_classifier env + | foreach "assocend_list" env = foreach_assocend env + (* hier muss man das Environment noch etwas umpacken + | foreach listType env = map (pack env) + (.foreach name (unpack env)) + *) + | foreach s _ = (error_msg ("in Base_Cartridge.foreach: unknown list \""^s^"\"."); + []) + +end diff --git a/src/codegen/c#_cartridge.sml b/src/codegen/c#_cartridge.sml index 31c44f4..dbdd06b 100644 --- a/src/codegen/c#_cartridge.sml +++ b/src/codegen/c#_cartridge.sml @@ -1,102 +1,102 @@ -(***************************************************************************** - * su4sml GCG - Generic Code Generator - * - * c#_catridge.sml - a cartridge to gcg_core for C# .NET 2.0 - * Copyright (C) 2005 Raphael Eidenbenz - * - * This file is part of su4sml-gcg. - * - * 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 CSharp_Cartridge(SuperCart : BASE_CARTRIDGE) : BASE_CARTRIDGE = -struct -open Rep_OclType - - -type Model = SuperCart.Model - -type environment = { extension : SuperCart.environment } - -(* fun getModel (env:environment) = SuperCart.getModel (#extension env)*) - - - - -fun initEnv model = { extension = SuperCart.initEnv model } : environment - -fun unpack (env : environment) = #extension env - -fun pack superEnv = {extension = superEnv} : environment - -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) - -(* internal translation table *) -fun super2Native "ClassifierScope" = "static" - | super2Native "InstanceScope" = "" - | super2Native "package" = "public" - | super2Native "Integer" = "int" - | super2Native "Real" = "double" - | super2Native "String" = "string" - | super2Native "Boolean" = "bool" - | super2Native "OclVoid" = "void" - | 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<" - ^(super2Native (String.substring(s,4,size s - 5)))^">" - (*else (gcg_warning ("Couldn't lookup \""^s^ - "\" in c#_cartridge.super2Native !"); s) - *) - else s - ) - handle Subscript => - (*(gcg_warning ("Couldn't lookup \""^s^"\" in c#_cartridge.super2Native !");s)*) - s - -(* lookup environment -> string -> string - * overrides some lookup entries of the base cartridge - *) -fun lookup (env : environment) "attribute_name_small_letter" - = StringHandling.uncapitalize (SuperCart.lookup (unpack env) "attribute_name") - | lookup (env : environment) "attribute_name_capital" - = StringHandling.capitalize (SuperCart.lookup (unpack env) "attribute_name") - | lookup (env : environment) (s as "attribute_type") = super2Native (SuperCart.lookup (unpack env) s ) - | lookup (env : environment) (s as "attribute_visibility")= super2Native (SuperCart.lookup (unpack env) s) - | lookup (env : environment) (s as "attribute_scope") = super2Native (SuperCart.lookup (unpack env) s) - | lookup (env : environment) (s as "operation_result_type")=super2Native (SuperCart.lookup (unpack env) s) - | lookup (env : environment) (s as "operation_visibility")= super2Native (SuperCart.lookup (unpack env) s) - | 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 = SuperCart.lookup (unpack env) s - - - -fun test (env : environment) s = SuperCart.test (unpack env) s - -(* no further functionality to add - * just unpack the Supercartridge's environment, - * pass it to SuperCart.foreach, get back a SuperCart.environment list - * pack every item into a native environment - *) -fun foreach listType (env : environment) - = map pack (SuperCart.foreach listType (unpack env)) - - -end +(***************************************************************************** + * su4sml GCG - Generic Code Generator + * + * c#_catridge.sml - a cartridge to gcg_core for C# .NET 2.0 + * Copyright (C) 2005 Raphael Eidenbenz + * + * This file is part of su4sml-gcg. + * + * 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 CSharp_Cartridge(SuperCart : BASE_CARTRIDGE) : BASE_CARTRIDGE = +struct +open Rep_OclType + + +type Model = SuperCart.Model + +type environment = { extension : SuperCart.environment } + +(* fun getModel (env:environment) = SuperCart.getModel (#extension env)*) + + + + +fun initEnv model = { extension = SuperCart.initEnv model } : environment + +fun unpack (env : environment) = #extension env + +fun pack superEnv = {extension = superEnv} : environment + +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) + +(* internal translation table *) +fun super2Native "ClassifierScope" = "static" + | super2Native "InstanceScope" = "" + | super2Native "package" = "public" + | super2Native "Integer" = "int" + | super2Native "Real" = "double" + | super2Native "String" = "string" + | super2Native "Boolean" = "bool" + | super2Native "OclVoid" = "void" + | 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<" + ^(super2Native (String.substring(s,4,size s - 5)))^">" + (*else (gcg_warning ("Couldn't lookup \""^s^ + "\" in c#_cartridge.super2Native !"); s) + *) + else s + ) + handle Subscript => + (*(gcg_warning ("Couldn't lookup \""^s^"\" in c#_cartridge.super2Native !");s)*) + s + +(* lookup environment -> string -> string + * overrides some lookup entries of the base cartridge + *) +fun lookup (env : environment) "attribute_name_small_letter" + = StringHandling.uncapitalize (SuperCart.lookup (unpack env) "attribute_name") + | lookup (env : environment) "attribute_name_capital" + = StringHandling.capitalize (SuperCart.lookup (unpack env) "attribute_name") + | lookup (env : environment) (s as "attribute_type") = super2Native (SuperCart.lookup (unpack env) s ) + | lookup (env : environment) (s as "attribute_visibility")= super2Native (SuperCart.lookup (unpack env) s) + | lookup (env : environment) (s as "attribute_scope") = super2Native (SuperCart.lookup (unpack env) s) + | lookup (env : environment) (s as "operation_result_type")=super2Native (SuperCart.lookup (unpack env) s) + | lookup (env : environment) (s as "operation_visibility")= super2Native (SuperCart.lookup (unpack env) s) + | 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 = SuperCart.lookup (unpack env) s + + + +fun test (env : environment) s = SuperCart.test (unpack env) s + +(* no further functionality to add + * just unpack the Supercartridge's environment, + * pass it to SuperCart.foreach, get back a SuperCart.environment list + * pack every item into a native environment + *) +fun foreach listType (env : environment) + = map pack (SuperCart.foreach listType (unpack env)) + + +end diff --git a/src/codegen/c#_net1_cartridge.sml b/src/codegen/c#_net1_cartridge.sml index e1fabdb..57a7f3f 100644 --- a/src/codegen/c#_net1_cartridge.sml +++ b/src/codegen/c#_net1_cartridge.sml @@ -1,103 +1,103 @@ -(***************************************************************************** - * su4sml GCG - Generic Code Generator - * - * c#_catridge.sml - a cartridge to gcg_core for C# .NET 1.x - * Copyright (C) 2005 Raphael Eidenbenz - * - * This file is part of su4sml-gcg. - * - * 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 CSharp_NET1_Cartridge(SuperCart : CARTRIDGE) : CARTRIDGE = - struct - open Rep_OclType - - -type environment = { extension : SuperCart.environment } -type Model = SuperCart.Model - - -fun initEnv model = { extension = SuperCart.initEnv model } : environment - -fun unpack (env : environment) = #extension env - -fun pack superEnv = {extension = superEnv} : environment - -(* fun getModel (env:environment) = SuperCart.getModel (unpack env)*) - - (* internal translation table *) -fun super2Native "ClassifierScope" = "static" - | super2Native "InstanceScope" = "" - | super2Native "package" = "public" - | super2Native "Integer" = "int" - | super2Native "Real" = "double" - | super2Native "String" = "string" - | super2Native "Boolean" = "bool" - | super2Native "OclVoid" = "void" - | 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.ArrayList" - (*else (gcg_warning ("Couldn't lookup \""^s^ - "\" in c#_cartridge.super2Native !"); s) - *) - else s - ) - handle Subscript => - (*(gcg_warning ("Couldn't lookup \""^s^"\" in c#_cartridge.super2Native !");s)*) - s - -fun startWithSmallLetter s = let val sl = String.explode s - in - String.implode ((Char.toLower (hd sl))::(tl sl)) - end - -fun startWithCapital s = let val sl = String.explode s - in - String.implode ((Char.toUpper (hd sl))::(tl sl)) - end -(* lookup environment -> string -> string - * overrides some lookup entries of the base cartridge - *) -fun lookup (env : environment) "attribute_name_small_letter" - = startWithSmallLetter (SuperCart.lookup (unpack env) "attribute_name") - | lookup (env : environment) "attribute_name_capital" - = startWithCapital (SuperCart.lookup (unpack env) "attribute_name") - | lookup (env : environment) (s as "attribute_type") = super2Native (SuperCart.lookup (unpack env) s ) - | lookup (env : environment) (s as "attribute_visibility")= super2Native (SuperCart.lookup (unpack env) s) - | lookup (env : environment) (s as "attribute_scope") = super2Native (SuperCart.lookup (unpack env) s) - | lookup (env : environment) (s as "operation_result_type")=super2Native (SuperCart.lookup (unpack env) s) - | lookup (env : environment) (s as "operation_visibility")= super2Native (SuperCart.lookup (unpack env) s) - | 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 = SuperCart.lookup (unpack env) s - - - -fun test env s = SuperCart.test (unpack env) s - - - -(* no further functionality to add - * just unpack the Supercartridge's environment, - * pass it to SuperCart.foreach, get back a SuperCart.environment list - * pack every item into a native environment - *) -fun foreach listType (env : environment) - = map pack (SuperCart.foreach listType (unpack env)) - - -end +(***************************************************************************** + * su4sml GCG - Generic Code Generator + * + * c#_catridge.sml - a cartridge to gcg_core for C# .NET 1.x + * Copyright (C) 2005 Raphael Eidenbenz + * + * This file is part of su4sml-gcg. + * + * 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 CSharp_NET1_Cartridge(SuperCart : CARTRIDGE) : CARTRIDGE = + struct + open Rep_OclType + + +type environment = { extension : SuperCart.environment } +type Model = SuperCart.Model + + +fun initEnv model = { extension = SuperCart.initEnv model } : environment + +fun unpack (env : environment) = #extension env + +fun pack superEnv = {extension = superEnv} : environment + +(* fun getModel (env:environment) = SuperCart.getModel (unpack env)*) + + (* internal translation table *) +fun super2Native "ClassifierScope" = "static" + | super2Native "InstanceScope" = "" + | super2Native "package" = "public" + | super2Native "Integer" = "int" + | super2Native "Real" = "double" + | super2Native "String" = "string" + | super2Native "Boolean" = "bool" + | super2Native "OclVoid" = "void" + | 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.ArrayList" + (*else (gcg_warning ("Couldn't lookup \""^s^ + "\" in c#_cartridge.super2Native !"); s) + *) + else s + ) + handle Subscript => + (*(gcg_warning ("Couldn't lookup \""^s^"\" in c#_cartridge.super2Native !");s)*) + s + +fun startWithSmallLetter s = let val sl = String.explode s + in + String.implode ((Char.toLower (hd sl))::(tl sl)) + end + +fun startWithCapital s = let val sl = String.explode s + in + String.implode ((Char.toUpper (hd sl))::(tl sl)) + end +(* lookup environment -> string -> string + * overrides some lookup entries of the base cartridge + *) +fun lookup (env : environment) "attribute_name_small_letter" + = startWithSmallLetter (SuperCart.lookup (unpack env) "attribute_name") + | lookup (env : environment) "attribute_name_capital" + = startWithCapital (SuperCart.lookup (unpack env) "attribute_name") + | lookup (env : environment) (s as "attribute_type") = super2Native (SuperCart.lookup (unpack env) s ) + | lookup (env : environment) (s as "attribute_visibility")= super2Native (SuperCart.lookup (unpack env) s) + | lookup (env : environment) (s as "attribute_scope") = super2Native (SuperCart.lookup (unpack env) s) + | lookup (env : environment) (s as "operation_result_type")=super2Native (SuperCart.lookup (unpack env) s) + | lookup (env : environment) (s as "operation_visibility")= super2Native (SuperCart.lookup (unpack env) s) + | 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 = SuperCart.lookup (unpack env) s + + + +fun test env s = SuperCart.test (unpack env) s + + + +(* no further functionality to add + * just unpack the Supercartridge's environment, + * pass it to SuperCart.foreach, get back a SuperCart.environment list + * pack every item into a native environment + *) +fun foreach listType (env : environment) + = map pack (SuperCart.foreach listType (unpack env)) + + +end diff --git a/src/codegen/c#sm_cartridge.sml b/src/codegen/c#sm_cartridge.sml index 0065009..0751f54 100644 --- a/src/codegen/c#sm_cartridge.sml +++ b/src/codegen/c#sm_cartridge.sml @@ -1,261 +1,261 @@ -(*****************************************************************************************) -(* su4sml - State Machine generator (SMG) *) -(* based upon GCG *) -(* *) -(* c#sm_cartridge.sml - implementation of the Statechart->StateMachine cartridge. *) -(* *) -(* Copyright (C) 2005 by Rolf Simon Adelsberger (RSA) *) -(* *) -(* *) -(* This file is part of the StateMachine cartridge for 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. *) -(*****************************************************************************************) - -(* use "stateMachine.sml"; *) - - -functor CSSM_Cartridge(SuperCart : BASE_CARTRIDGE) : CARTRIDGE = - struct - - - open Rep_OclType - open Rep_StateMachine - open Gcg_Helper - (* open Rep_SecureUML_ComponentUML.Security*) - open ComponentUML - open SM_Helper - open StateMachineTypes -open StringHandling -open StateMachine - - val emptySM_Trans = { trans_id="", - source = "", - target = "", - guards = [], - triggers = [], - effects = [] - }:SM_Trans - - type environment = { - curState : StateVertex, - allTransitions: SM_Trans list, - curTransition : (SM_Trans*int), - curEvent: Event, - curGuard: (Guard*int), - curEffect: Procedure, - extension : SuperCart.environment - } - - - fun initEnv model = { - curState = emptyState, - allTransitions = [], - curTransition = (emptySM_Trans,0), - curEvent = emptyEvent, - curGuard = (emptyGuard,0), - curEffect = emptyEffect, - extension = SuperCart.initEnv model - } : environment - -(* unpack : environment -> SuperCart.environment *) -fun unpack (env:environment) = #extension env - -(* pack : environment -> SuperCart.environment -> environment *) -fun pack (env: environment) (new_env : SuperCart.environment) = { - curState = #curState env, - allTransitions = #allTransitions env, - curTransition = #curTransition env, - curEvent = #curEvent env, - curGuard = #curGuard env, - curEffect = #curEffect env, - extension=new_env - } - -(* fun getModel env = SuperCart.getModel (unpack env) *) - -(* - * lookup environment -> string -> string - * might override some lookup entries of the base cartridge - *) -fun lookup (env : environment) "state_name" = toUpper(name_of_state(#curState env)) - | lookup (env : environment) "state_ident" = id_of_state(#curState env) - | lookup (env : environment) "final_state_name" = toUpper(id_of_state(FinalState(states_of_classif(Option.valOf(SuperCart.curClassifier (unpack env)))))) - | lookup (env : environment) "transition_target" = target_of_SM_Trans(#1(#curTransition env)) - | lookup (env : environment) "guard_ident" = ident_of_guard(#1(#curGuard env)) - | lookup (env : environment) "event_name" = toUpper(name_of_event(#curEvent env)) - | lookup (env : environment) "cur_event_id" = toUpper(name_of_event(#curEvent env)) - | lookup (env : environment) "effect_ident" = #proc_id (#curEffect env) - | lookup (env : environment) "trigger_name" = name_of_event(#curEvent env) - | lookup (env : environment) "real_init" = id_of_state(realInit(Option.valOf(SuperCart.curClassifier (unpack env)))) - | lookup (env : environment) s = SuperCart.lookup (unpack env) s - - -fun evalCondition (env : environment) "hasAG" = hasAG(Option.valOf(SuperCart.curClassifier (unpack env))) - | evalCondition (env : environment) "isTrigger" = let val Transitions = transitions_of_classif(Option.valOf(SuperCart.curClassifier (unpack env))) - val oper = Option.valOf(SuperCart.curOperation (unpack env)) - in - acts_as_trigger oper Transitions - end - | evalCondition (env : environment) "isLastGuard" = (#2(#curGuard env)) = 0 - | evalCondition (env : environment) "isLastTrans" = (#2(#curTransition env)) = 0 -(* | evalCondition (env : environment) "isStart" = is_StartState(#curState env)*) - (* pass unknown condition types to Superior Cartridge *) - | evalCondition (env : environment) s = SuperCart.test (unpack env) s - - -val test = evalCondition - -fun foreach_event(env: environment) = let val eventList = events_of_classif(Option.valOf(SuperCart.curClassifier (unpack env))) - fun env_from_ev X = { - curState = #curState env, - allTransitions = #allTransitions env, - curTransition = (emptySM_Trans,0), - curEvent = X, - curGuard = (emptyGuard,0), - curEffect = emptyEffect, - extension = #extension env - } - in - List.map env_from_ev eventList - end - -fun foreach_events_of_state(env: environment) = let val TL = (#allTransitions env) - val SL = states_of_classif(Option.valOf(SuperCart.curClassifier (unpack env))) - val EVTList = events_of_state((#curState env), ref TL, ref SL) - fun env_from_EoS evt = - { - curEvent = evt, - curGuard = (emptyGuard,0), - curState = #curState env, - allTransitions = #allTransitions env, - curTransition = #curTransition env, - curEffect = emptyEffect, - extension = #extension env - } - in - List.map env_from_EoS EVTList - end - -fun foreach_state(env: environment) = let val stateList = states_of_classif(Option.valOf(SuperCart.curClassifier (unpack env))) - val realStates = List.filter (fn X => not(isPseudo(X))) stateList - fun env_from_state X = { - curState = X, - allTransitions = #allTransitions env, - curTransition = (emptySM_Trans,0), - curEvent = #curEvent env, - curGuard = (emptyGuard,0), - curEffect = emptyEffect, - extension = #extension env - } - in - List.map env_from_state realStates - end - -fun foreach_classifier (env : environment) - = let val envL = SuperCart.foreach "classifier_list" (unpack env) - fun env_from_classifier e = - { - curState = emptyState, - allTransitions = SM_Trans_of_classif(Option.valOf(SuperCart.curClassifier(e))),(* NOTE: here the SM_Trans are calculated *) - curTransition = (emptySM_Trans,0), - curEvent = (#curEvent env), - curGuard = (emptyGuard,0), - curEffect = emptyEffect, - extension = e - } - in - List.map env_from_classifier envL - end - - -fun foreach_transition(env: environment) = let val TransL = next_SM_Trans_4EV((#curState env),ref (#allTransitions env), (#curEvent env)) - val LEN = List.length(TransL) - fun env_from_TL T = { - curState = #curState env, - allTransitions = #allTransitions env, - curTransition = T, - curEvent = #curEvent env, - curGuard = (emptyGuard,0), - curEffect = emptyEffect, - extension = #extension env - } - fun transform([],_) = [] - | transform(h::t,n) = (h,n)::transform(t,(n-1)) - in - List.map env_from_TL (transform((sort_SM_TransL_withGAtEnd(TransL,lastGuard)),(LEN-1))) - end - -fun foreach_guard(env: environment) = let val GL = guards_of_SM_Trans(#1(#curTransition env)) - fun env_from_GL G = { - curState = #curState env, - allTransitions = #allTransitions env, - curTransition = #curTransition env, - curEvent = #curEvent env, - curGuard = G, - curEffect = emptyEffect, - extension = #extension env - } - val LEN = List.length(GL) - fun transform([],_) = [] - | transform(h::t,n) = (h,n)::transform(t,(n-1)) - in - List.map env_from_GL (transform(GL,(LEN-1))) - end - -fun all_guards(env: environment) = let val AGL = makeDistinct(List.concat (List.map guards_of_SM_Trans (#allTransitions env))) - fun env_from_GL G = { - curState = #curState env, - allTransitions = #allTransitions env, - curTransition = #curTransition env, - curEvent = #curEvent env, - curGuard = G, - curEffect = emptyEffect, - extension = #extension env - } - val LEN = List.length(AGL) - fun transform([],_) = [] - | transform(h::t,n) = (h,n)::transform(t,(n-1)) - in - List.map env_from_GL (transform(AGL,(LEN-1))) - end - -fun foreach_effect(env: environment) = let val EffL = effects_of_SM_Trans(#1(#curTransition env)) - fun env_from_EffL E = { - curState = #curState env, - allTransitions = #allTransitions env, - curTransition = #curTransition env, - curEvent = #curEvent env, - curEffect = E, - curGuard = #curGuard env, - extension = #extension env - } - in - List.map env_from_EffL EffL - end - - - - -fun foreach "event_list" env = foreach_event env - | foreach "state_list" env = foreach_state env - | foreach "transition_list" env = foreach_transition env - | foreach "guard_of_trans_list" env = foreach_guard env - | foreach "guard_list" env = all_guards env - | foreach "effect_list" env = foreach_effect env - | foreach "events_of_state" env = foreach_events_of_state env - | foreach (LT as "classifier_list") env = ListPair.map (uncurry pack) ((foreach_classifier env), (SuperCart.foreach LT (unpack env))) - | foreach L (env:environment) = map (pack env) (SuperCart.foreach L (unpack env)) -end +(*****************************************************************************************) +(* su4sml - State Machine generator (SMG) *) +(* based upon GCG *) +(* *) +(* c#sm_cartridge.sml - implementation of the Statechart->StateMachine cartridge. *) +(* *) +(* Copyright (C) 2005 by Rolf Simon Adelsberger (RSA) *) +(* *) +(* *) +(* This file is part of the StateMachine cartridge for 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. *) +(*****************************************************************************************) + +(* use "stateMachine.sml"; *) + + +functor CSSM_Cartridge(SuperCart : BASE_CARTRIDGE) : CARTRIDGE = + struct + + + open Rep_OclType + open Rep_StateMachine + open Gcg_Helper + (* open Rep_SecureUML_ComponentUML.Security*) + open ComponentUML + open SM_Helper + open StateMachineTypes +open StringHandling +open StateMachine + + val emptySM_Trans = { trans_id="", + source = "", + target = "", + guards = [], + triggers = [], + effects = [] + }:SM_Trans + + type environment = { + curState : StateVertex, + allTransitions: SM_Trans list, + curTransition : (SM_Trans*int), + curEvent: Event, + curGuard: (Guard*int), + curEffect: Procedure, + extension : SuperCart.environment + } + + + fun initEnv model = { + curState = emptyState, + allTransitions = [], + curTransition = (emptySM_Trans,0), + curEvent = emptyEvent, + curGuard = (emptyGuard,0), + curEffect = emptyEffect, + extension = SuperCart.initEnv model + } : environment + +(* unpack : environment -> SuperCart.environment *) +fun unpack (env:environment) = #extension env + +(* pack : environment -> SuperCart.environment -> environment *) +fun pack (env: environment) (new_env : SuperCart.environment) = { + curState = #curState env, + allTransitions = #allTransitions env, + curTransition = #curTransition env, + curEvent = #curEvent env, + curGuard = #curGuard env, + curEffect = #curEffect env, + extension=new_env + } + +(* fun getModel env = SuperCart.getModel (unpack env) *) + +(* + * lookup environment -> string -> string + * might override some lookup entries of the base cartridge + *) +fun lookup (env : environment) "state_name" = toUpper(name_of_state(#curState env)) + | lookup (env : environment) "state_ident" = id_of_state(#curState env) + | lookup (env : environment) "final_state_name" = toUpper(id_of_state(FinalState(states_of_classif(Option.valOf(SuperCart.curClassifier (unpack env)))))) + | lookup (env : environment) "transition_target" = target_of_SM_Trans(#1(#curTransition env)) + | lookup (env : environment) "guard_ident" = ident_of_guard(#1(#curGuard env)) + | lookup (env : environment) "event_name" = toUpper(name_of_event(#curEvent env)) + | lookup (env : environment) "cur_event_id" = toUpper(name_of_event(#curEvent env)) + | lookup (env : environment) "effect_ident" = #proc_id (#curEffect env) + | lookup (env : environment) "trigger_name" = name_of_event(#curEvent env) + | lookup (env : environment) "real_init" = id_of_state(realInit(Option.valOf(SuperCart.curClassifier (unpack env)))) + | lookup (env : environment) s = SuperCart.lookup (unpack env) s + + +fun evalCondition (env : environment) "hasAG" = hasAG(Option.valOf(SuperCart.curClassifier (unpack env))) + | evalCondition (env : environment) "isTrigger" = let val Transitions = transitions_of_classif(Option.valOf(SuperCart.curClassifier (unpack env))) + val oper = Option.valOf(SuperCart.curOperation (unpack env)) + in + acts_as_trigger oper Transitions + end + | evalCondition (env : environment) "isLastGuard" = (#2(#curGuard env)) = 0 + | evalCondition (env : environment) "isLastTrans" = (#2(#curTransition env)) = 0 +(* | evalCondition (env : environment) "isStart" = is_StartState(#curState env)*) + (* pass unknown condition types to Superior Cartridge *) + | evalCondition (env : environment) s = SuperCart.test (unpack env) s + + +val test = evalCondition + +fun foreach_event(env: environment) = let val eventList = events_of_classif(Option.valOf(SuperCart.curClassifier (unpack env))) + fun env_from_ev X = { + curState = #curState env, + allTransitions = #allTransitions env, + curTransition = (emptySM_Trans,0), + curEvent = X, + curGuard = (emptyGuard,0), + curEffect = emptyEffect, + extension = #extension env + } + in + List.map env_from_ev eventList + end + +fun foreach_events_of_state(env: environment) = let val TL = (#allTransitions env) + val SL = states_of_classif(Option.valOf(SuperCart.curClassifier (unpack env))) + val EVTList = events_of_state((#curState env), ref TL, ref SL) + fun env_from_EoS evt = + { + curEvent = evt, + curGuard = (emptyGuard,0), + curState = #curState env, + allTransitions = #allTransitions env, + curTransition = #curTransition env, + curEffect = emptyEffect, + extension = #extension env + } + in + List.map env_from_EoS EVTList + end + +fun foreach_state(env: environment) = let val stateList = states_of_classif(Option.valOf(SuperCart.curClassifier (unpack env))) + val realStates = List.filter (fn X => not(isPseudo(X))) stateList + fun env_from_state X = { + curState = X, + allTransitions = #allTransitions env, + curTransition = (emptySM_Trans,0), + curEvent = #curEvent env, + curGuard = (emptyGuard,0), + curEffect = emptyEffect, + extension = #extension env + } + in + List.map env_from_state realStates + end + +fun foreach_classifier (env : environment) + = let val envL = SuperCart.foreach "classifier_list" (unpack env) + fun env_from_classifier e = + { + curState = emptyState, + allTransitions = SM_Trans_of_classif(Option.valOf(SuperCart.curClassifier(e))),(* NOTE: here the SM_Trans are calculated *) + curTransition = (emptySM_Trans,0), + curEvent = (#curEvent env), + curGuard = (emptyGuard,0), + curEffect = emptyEffect, + extension = e + } + in + List.map env_from_classifier envL + end + + +fun foreach_transition(env: environment) = let val TransL = next_SM_Trans_4EV((#curState env),ref (#allTransitions env), (#curEvent env)) + val LEN = List.length(TransL) + fun env_from_TL T = { + curState = #curState env, + allTransitions = #allTransitions env, + curTransition = T, + curEvent = #curEvent env, + curGuard = (emptyGuard,0), + curEffect = emptyEffect, + extension = #extension env + } + fun transform([],_) = [] + | transform(h::t,n) = (h,n)::transform(t,(n-1)) + in + List.map env_from_TL (transform((sort_SM_TransL_withGAtEnd(TransL,lastGuard)),(LEN-1))) + end + +fun foreach_guard(env: environment) = let val GL = guards_of_SM_Trans(#1(#curTransition env)) + fun env_from_GL G = { + curState = #curState env, + allTransitions = #allTransitions env, + curTransition = #curTransition env, + curEvent = #curEvent env, + curGuard = G, + curEffect = emptyEffect, + extension = #extension env + } + val LEN = List.length(GL) + fun transform([],_) = [] + | transform(h::t,n) = (h,n)::transform(t,(n-1)) + in + List.map env_from_GL (transform(GL,(LEN-1))) + end + +fun all_guards(env: environment) = let val AGL = makeDistinct(List.concat (List.map guards_of_SM_Trans (#allTransitions env))) + fun env_from_GL G = { + curState = #curState env, + allTransitions = #allTransitions env, + curTransition = #curTransition env, + curEvent = #curEvent env, + curGuard = G, + curEffect = emptyEffect, + extension = #extension env + } + val LEN = List.length(AGL) + fun transform([],_) = [] + | transform(h::t,n) = (h,n)::transform(t,(n-1)) + in + List.map env_from_GL (transform(AGL,(LEN-1))) + end + +fun foreach_effect(env: environment) = let val EffL = effects_of_SM_Trans(#1(#curTransition env)) + fun env_from_EffL E = { + curState = #curState env, + allTransitions = #allTransitions env, + curTransition = #curTransition env, + curEvent = #curEvent env, + curEffect = E, + curGuard = #curGuard env, + extension = #extension env + } + in + List.map env_from_EffL EffL + end + + + + +fun foreach "event_list" env = foreach_event env + | foreach "state_list" env = foreach_state env + | foreach "transition_list" env = foreach_transition env + | foreach "guard_of_trans_list" env = foreach_guard env + | foreach "guard_list" env = all_guards env + | foreach "effect_list" env = foreach_effect env + | foreach "events_of_state" env = foreach_events_of_state env + | foreach (LT as "classifier_list") env = ListPair.map (uncurry pack) ((foreach_classifier env), (SuperCart.foreach LT (unpack env))) + | foreach L (env:environment) = map (pack env) (SuperCart.foreach L (unpack env)) +end diff --git a/src/codegen/cartridge.sig b/src/codegen/cartridge.sig index e278be1..466b496 100644 --- a/src/codegen/cartridge.sig +++ b/src/codegen/cartridge.sig @@ -1,62 +1,62 @@ -(***************************************************************************** - * su4sml - a SecureUML repository for SML - * - * cartridge.sig - the minimal signature every cartridge has to implement - * Copyright (C) 2005 Raphael Eidenbenz - * - * 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. - ******************************************************************************) - -(** the minimal signature every code-generator cartridge has to implement. *) -signature CARTRIDGE = -sig - - (** - * the environment in which template-file statements are to be evaluated. - * Ususally this will contain lists of model elements and - * "pointers" to the "current" elements - *) - type environment - - (** - * The particular model from which model element information is - * taken. - * This can be cartridge specific. - *) - type Model - - (** - * returns the model information as it is part of the current - * environment. - *) - (* val getModel : environment -> Model *) - - (** initialze the environment by parsing the given classifier list *) - val initEnv : Rep.Model -> environment - - (** look up string-valued variables in the environment by name. *) - val lookup : environment -> string -> string - - (** evaluate boolean-valued predicates in the environment by name. *) - val test : environment -> string -> bool - - (** - * return a list of environment, where the "current" element - * iterates over a given list. - *) - val foreach : string -> environment -> environment list -end +(***************************************************************************** + * su4sml - a SecureUML repository for SML + * + * cartridge.sig - the minimal signature every cartridge has to implement + * Copyright (C) 2005 Raphael Eidenbenz + * + * 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. + ******************************************************************************) + +(** the minimal signature every code-generator cartridge has to implement. *) +signature CARTRIDGE = +sig + + (** + * the environment in which template-file statements are to be evaluated. + * Ususally this will contain lists of model elements and + * "pointers" to the "current" elements + *) + type environment + + (** + * The particular model from which model element information is + * taken. + * This can be cartridge specific. + *) + type Model + + (** + * returns the model information as it is part of the current + * environment. + *) + (* val getModel : environment -> Model *) + + (** initialze the environment by parsing the given classifier list *) + val initEnv : Rep.Model -> environment + + (** look up string-valued variables in the environment by name. *) + val lookup : environment -> string -> string + + (** evaluate boolean-valued predicates in the environment by name. *) + val test : environment -> string -> bool + + (** + * return a list of environment, where the "current" element + * iterates over a given list. + *) + val foreach : string -> environment -> environment list +end diff --git a/src/codegen/codegen.mlb b/src/codegen/codegen.mlb index 2d00837..292d4a0 100644 --- a/src/codegen/codegen.mlb +++ b/src/codegen/codegen.mlb @@ -8,8 +8,6 @@ in $(MLTON_ROOT)/basis/basis.mlb ../su4sml.mlb in - compiler/compiler_ext.sig - compiler/mlton.sml stringHandling.sml gcg_helper.sml tpl_parser.sig diff --git a/src/codegen/codegen.sml b/src/codegen/codegen.sml index d5257ef..8c89aef 100644 --- a/src/codegen/codegen.sml +++ b/src/codegen/codegen.sml @@ -1,96 +1,98 @@ -(***************************************************************************** - * su4sml GCG - Generic Code Generator - * - * codegen.sml - control file for su4sml-GCG - * Copyright (C) 2005 Raphael Eidenbenz - * - * This file is part of su4sml-gcg. - * - * 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. - ******************************************************************************) - -(* -OS.FileSys.chDir "../../../src"; -*) - -structure Codegen = struct - - structure Base_Gcg = GCG_Core (Base_Cartridge) - - structure CSharp_Gcg = GCG_Core (CSharp_Cartridge(Base_Cartridge)) - - structure CSharpSecure_Gcg - = GCG_Core (CSharp_Cartridge( ComponentUML_Cartridge(Base_Cartridge))) - -structure CSharp_NET1_Gcg - = GCG_Core (CSharp_NET1_Cartridge(Base_Cartridge)) - -structure CSharpSecure_NET1_Gcg - = GCG_Core (CSharp_NET1_Cartridge(ComponentUML_Cartridge(Base_Cartridge))) - -structure SecureUML_Base_Gcg - = GCG_Core (ComponentUML_Cartridge(Base_Cartridge)) - -structure CSharpSM_Gcg = GCG_Core (CSSM_Cartridge(CSharp_Cartridge(Base_Cartridge))) - -structure Java_Gcg = GCG_Core (Java_Cartridge(Base_Cartridge)) - -structure Junit_Gcg = GCG_Core (Junit_Cartridge(Java_Cartridge(Base_Cartridge))) - -structure SecureMova_Gcg = GCG_Core (ComponentUML_Cartridge(Base_Cartridge)) - -(* -structure JavaSecure_Gcg = GCG_Core (Java_Cartridge(SecureUML_Cartridge(Base_Cartridge))); -*) - -fun generate xmi_file "base" = - Base_Gcg.generate ( RepParser.readFile xmi_file) "templates/base.tpl" - | generate xmi_file "c#" = - CSharp_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#.tpl" - | generate xmi_file "c#_secure" = - CSharpSecure_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#_SecureUML.tpl" - | generate xmi_file "c#_net1" = - CSharp_NET1_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#.tpl" - | generate xmi_file "c#_secure_net1" = - CSharpSecure_NET1_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#_SecureUML.tpl" - | generate xmi_file "c#sm" = - CSharpSM_Gcg.generate (RepParser.readFile xmi_file) "templates/C#_SM.tpl" - | generate xmi_file "java" = - Java_Gcg.generate (RepParser.readFile xmi_file) "templates/java.tpl" - | generate xmi_file "junit" = - Junit_Gcg.generate (RepParser.readFile xmi_file) "templates/junit.tpl" - (* - | generate "java_secure" = JavaSecure_Gcg.generate model "templates/java_SecureUML.tpl" - *) -(* | generate xmi_file "maude" = - Base_Gcg.generate ( RepParser.readFile xmi_file) "templates/maude.tpl" - | generate xmi_file "maude_secure" = - SecureUML_Base_Gcg.generate ( Rep_SecureUML_ComponentUML.readXMI xmi_file) "templates/maude.tpl" *) - | generate xmi_file "securemova" = - SecureMova_Gcg.generate (RepParser.transformXMI (XmiParser.readFile xmi_file)) - "templates/securemova.tpl" - | generate _ s = print ("target language unknown : "^s^"\n"^ - "usage: generate \"base\" | \"c#\" | \"c#_secure\" | \"c#_net1\" | \"c#_secure_net1\" | \"java\" | \"junit\"\n") - - - -fun main (_,[xmi_file,lang]) = (generate xmi_file lang ; OS.Process.success) - | main _ = (print ("usage: codegen \n"^ - "\tlanguage = \"base\" | \"c#\" | \"c#sm\" | \"c#_secure\" | \"c#_net1\" | \"c#_secure_net1\" | \"java\" | \"junit\" | \"maude\" | \"maude_secure\" \n"); OS.Process.success) - -end - - -val _ = Codegen.main(CommandLine.name(),CommandLine.arguments()) +(***************************************************************************** + * su4sml GCG - Generic Code Generator + * + * codegen.sml - control file for su4sml-GCG + * Copyright (C) 2005 Raphael Eidenbenz + * + * This file is part of su4sml-gcg. + * + * 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. + ******************************************************************************) + +(* +OS.FileSys.chDir "../../../src"; +*) + +structure Codegen = struct + + structure Base_Gcg = GCG_Core (Base_Cartridge) + + structure CSharp_Gcg = GCG_Core (CSharp_Cartridge(Base_Cartridge)) + + structure CSharpSecure_Gcg + = GCG_Core (CSharp_Cartridge( ComponentUML_Cartridge(Base_Cartridge))) + +structure CSharp_NET1_Gcg + = GCG_Core (CSharp_NET1_Cartridge(Base_Cartridge)) + +structure CSharpSecure_NET1_Gcg + = GCG_Core (CSharp_NET1_Cartridge(ComponentUML_Cartridge(Base_Cartridge))) + +structure SecureUML_Base_Gcg + = GCG_Core (ComponentUML_Cartridge(Base_Cartridge)) + +structure CSharpSM_Gcg = GCG_Core (CSSM_Cartridge(CSharp_Cartridge(Base_Cartridge))) + +structure Java_Gcg = GCG_Core (Java_Cartridge(Base_Cartridge)) + +structure Junit_Gcg = GCG_Core (Junit_Cartridge(Java_Cartridge(Base_Cartridge))) + +structure Java_Ocl_Gcg = GCG_Core (Java_Cartridge(Base_Cartridge)) + +structure SecureMova_Gcg = GCG_Core (ComponentUML_Cartridge(Base_Cartridge)) + +(* +structure JavaSecure_Gcg = GCG_Core (Java_Cartridge(SecureUML_Cartridge(Base_Cartridge))); +*) + +fun generate xmi_file "base" = + Base_Gcg.generate ( RepParser.readFile xmi_file) "templates/base.tpl" + | generate xmi_file "c#" = + CSharp_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#.tpl" + | generate xmi_file "c#_secure" = + CSharpSecure_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#_SecureUML.tpl" + | generate xmi_file "c#_net1" = + CSharp_NET1_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#.tpl" + | generate xmi_file "c#_secure_net1" = + CSharpSecure_NET1_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#_SecureUML.tpl" + | generate xmi_file "c#sm" = + CSharpSM_Gcg.generate (RepParser.readFile xmi_file) "templates/C#_SM.tpl" + | generate xmi_file "java" = + Java_Gcg.generate (RepParser.readFile xmi_file) "templates/java.tpl" + | generate xmi_file "junit" = + Junit_Gcg.generate (RepParser.readFile xmi_file) "templates/junit.tpl" + | generate xmi_file "javaocl" = + Java_Ocl_Gcg.generate (RepParser.readFile xmi_file) "templates/java_ocl.tpl" + (* + | generate "java_secure" = JavaSecure_Gcg.generate model "templates/java_SecureUML.tpl" + *) +(* | generate xmi_file "maude" = + Base_Gcg.generate ( RepParser.readFile xmi_file) "templates/maude.tpl" + | generate xmi_file "maude_secure" = + SecureUML_Base_Gcg.generate ( Rep_SecureUML_ComponentUML.readXMI xmi_file) "templates/maude.tpl" *) + | generate xmi_file "securemova" = + SecureMova_Gcg.generate (RepParser.transformXMI (XmiParser.readFile xmi_file)) + "templates/securemova.tpl" + | generate _ s = print ("target language unknown : "^s^"\n"^ + "usage: generate \"base\" | \"c#\" | \"c#_secure\" | \"c#_net1\" | \"c#_secure_net1\" | \"java\" | \"junit\"\n") + + +fun main (_,[xmi_file,lang]) = (generate xmi_file lang ; OS.Process.success) + | main _ = (print ("usage: codegen \n"^ + "\tlanguage = \"base\" | \"c#\" | \"c#sm\" | \"c#_secure\" | \"c#_net1\" | \"c#_secure_net1\" | \"java\" | \"junit\" | \"maude\" | \"maude_secure\" | \"javaocl\"\n"); OS.Process.success) + +end + +val _ = Codegen.main(CommandLine.name(),CommandLine.arguments()) diff --git a/src/codegen/gcg_core.sig b/src/codegen/gcg_core.sig index 6a638c5..c2dd4e4 100644 --- a/src/codegen/gcg_core.sig +++ b/src/codegen/gcg_core.sig @@ -1,25 +1,25 @@ -(***************************************************************************** - * su4sml GCG - Generic Code Generator - * - * gcg_core.sig - signature of functor GCG_Core - * transcribes a su4sml model according to a template tree - * into code specific to a target language cartridge C - * Copyright (C) 2005 Raphael Eidenbenz - * - * This file is part of su4sml-gcg. - * - * 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. - ******************************************************************************) - +(***************************************************************************** + * su4sml GCG - Generic Code Generator + * + * gcg_core.sig - signature of functor GCG_Core + * transcribes a su4sml model according to a template tree + * into code specific to a target language cartridge C + * Copyright (C) 2005 Raphael Eidenbenz + * + * This file is part of su4sml-gcg. + * + * 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. + ******************************************************************************) + diff --git a/src/codegen/gcg_core.sml b/src/codegen/gcg_core.sml index 50f5a90..46e47e3 100644 --- a/src/codegen/gcg_core.sml +++ b/src/codegen/gcg_core.sml @@ -1,135 +1,135 @@ -(***************************************************************************** - * su4sml GCG - Generic Code Generator - * - * gcg_core.sml - implements functor GCG_Core - * transcribes a su4sml model according to a template tree - * into code specific to a target language cartridge C - * Copyright (C) 2005 Raphael Eidenbenz - * - * This file is part of su4sml-gcg. - * - * 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. - ******************************************************************************) - -(** A Code generator *) -signature GCG = -sig - -val writeLine : string -> unit -val generate : Rep.Model -> string -> unit - -end - -(** builds a code generator from a cartridge chain. *) -functor GCG_Core (C: CARTRIDGE): GCG = -struct - -open library - -val curFile = ref "" -val out = ref TextIO.stdOut - -fun closeFile () = if (!curFile = "") - then () - else (TextIO.closeOut (!out); - info ("closing "^(!curFile)); - curFile := "") - - -fun openFile file = (closeFile (); - info ("opening "^file^"..."); - Gcg_Helper.assureDir file; - out := (TextIO.openOut file); - curFile := file - ) - -fun openFileIfNotExists file = (closeFile (); - (if ((OS.FileSys.fileSize file) > 0) - then openFile "/dev/null" - else openFile file - ) handle SysErr => ( openFile file )) - -fun initOut () = (out := TextIO.stdOut; - curFile := "") - -fun writeLine s = TextIO.output (!out,s) - -fun eval s = (info ""; CompilerExt.eval true s) - -(** applies f to every other element in l starting with the second - *) -fun map2EveryOther f [] = [] - | map2EveryOther f [a] = [a] - | map2EveryOther f (a::b::z) = a::(f b)::(map2EveryOther f z) - -fun substituteVars e s = - let val tkl = Gcg_Helper.joinEscapeSplitted "$" (Gcg_Helper.fieldSplit #"$" s) - in - String.concat (map2EveryOther (C.lookup e) tkl) - handle ex => (error_msg ("in GCG_Core.substituteVars: \ - \variable lookup failure in string \""^s^"\"."); - s) - end - -(** traverses a templateParseTree and executes the given instructions *) -fun write env (Tpl_Parser.RootNode(l)) = List.app (write env) l - | write env (Tpl_Parser.OpenFileLeaf(file)) = openFile (substituteVars env file) - | write env (Tpl_Parser.OpenFileIfNotExistsLeaf(file)) = - openFileIfNotExists (substituteVars env file) - | write env (Tpl_Parser.EvalLeaf(l)) = - let fun collectEval [] = "" - | collectEval ((Tpl_Parser.TextLeaf(expr))::t) = expr^"\n"^(collectEval t) - | collectEval _ = - error "in GCG_Core.write: No TextLeaf in EvalLeaf" - in - eval (substituteVars env (collectEval l)) - end - | write env (Tpl_Parser.TextLeaf(s)) = writeLine (substituteVars env s) - | write env (Tpl_Parser.IfNode(cond,l)) = - let fun writeThen _ [] = () - | writeThen _ [Tpl_Parser.ElseNode(_)] = () - | writeThen e (h::t) = (write e h ;writeThen e t) - in - (if (C.test env cond) - then writeThen env l - else case (List.last l) of nd as (Tpl_Parser.ElseNode(_)) => write env nd - | _ => ()) - handle ex => () (* ignore failed/unknown predicates *) - end - | write env (Tpl_Parser.ElseNode(l)) = List.app (write env) l - | write env (Tpl_Parser.ForEachNode(listType,children))= - let val list_of_environments = C.foreach listType env - fun write_children e = List.app (fn tree => write e tree) children - in - List.app (fn e => write_children e) list_of_environments - handle ex => (error_msg ("in GCG_Core.write: error in foreach node "^listType^ - ": "^General.exnMessage ex); - ()) - end - - -(** generate code according to the given template file for the given model *) -fun generate model template - = let val env = C.initEnv model - val tree = Tpl_Parser.parse template - in - (initOut(); - (*printTTree tree;*) - write env tree; - closeFile () ) - handle ex => (closeFile(); raise ex) - end - -end +(***************************************************************************** + * su4sml GCG - Generic Code Generator + * + * gcg_core.sml - implements functor GCG_Core + * transcribes a su4sml model according to a template tree + * into code specific to a target language cartridge C + * Copyright (C) 2005 Raphael Eidenbenz + * + * This file is part of su4sml-gcg. + * + * 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. + ******************************************************************************) + +(** A Code generator *) +signature GCG = +sig + +val writeLine : string -> unit +val generate : Rep.Model -> string -> unit + +end + +(** builds a code generator from a cartridge chain. *) +functor GCG_Core (C: CARTRIDGE): GCG = +struct + +open library + +val curFile = ref "" +val out = ref TextIO.stdOut + +fun closeFile () = if (!curFile = "") + then () + else (TextIO.closeOut (!out); + info ("closing "^(!curFile)); + curFile := "") + + +fun openFile file = (closeFile (); + info ("opening "^file^"..."); + Gcg_Helper.assureDir file; + out := (TextIO.openOut file); + curFile := file + ) + +fun openFileIfNotExists file = (closeFile (); + (if ((OS.FileSys.fileSize file) > 0) + then openFile "/dev/null" + else openFile file + ) handle SysErr => ( openFile file )) + +fun initOut () = (out := TextIO.stdOut; + curFile := "") + +fun writeLine s = TextIO.output (!out,s) + +fun eval s = (info ""; CompilerExt.eval true s) + +(** applies f to every other element in l starting with the second + *) +fun map2EveryOther f [] = [] + | map2EveryOther f [a] = [a] + | map2EveryOther f (a::b::z) = a::(f b)::(map2EveryOther f z) + +fun substituteVars e s = + let val tkl = Gcg_Helper.joinEscapeSplitted "$" (Gcg_Helper.fieldSplit #"$" s) + in + String.concat (map2EveryOther (C.lookup e) tkl) + handle ex => (error_msg ("in GCG_Core.substituteVars: \ + \variable lookup failure in string \""^s^"\"."); + s) + end + +(** traverses a templateParseTree and executes the given instructions *) +fun write env (Tpl_Parser.RootNode(l)) = List.app (write env) l + | write env (Tpl_Parser.OpenFileLeaf(file)) = openFile (substituteVars env file) + | write env (Tpl_Parser.OpenFileIfNotExistsLeaf(file)) = + openFileIfNotExists (substituteVars env file) + | write env (Tpl_Parser.EvalLeaf(l)) = + let fun collectEval [] = "" + | collectEval ((Tpl_Parser.TextLeaf(expr))::t) = expr^"\n"^(collectEval t) + | collectEval _ = + error "in GCG_Core.write: No TextLeaf in EvalLeaf" + in + eval (substituteVars env (collectEval l)) + end + | write env (Tpl_Parser.TextLeaf(s)) = writeLine (substituteVars env s) + | write env (Tpl_Parser.IfNode(cond,l)) = + let fun writeThen _ [] = () + | writeThen _ [Tpl_Parser.ElseNode(_)] = () + | writeThen e (h::t) = (write e h ;writeThen e t) + in + (if (C.test env cond) + then writeThen env l + else case (List.last l) of nd as (Tpl_Parser.ElseNode(_)) => write env nd + | _ => ()) + handle ex => () (* ignore failed/unknown predicates *) + end + | write env (Tpl_Parser.ElseNode(l)) = List.app (write env) l + | write env (Tpl_Parser.ForEachNode(listType,children))= + let val list_of_environments = C.foreach listType env + fun write_children e = List.app (fn tree => write e tree) children + in + List.app (fn e => write_children e) list_of_environments + handle ex => (error_msg ("in GCG_Core.write: error in foreach node "^listType^ + ": "^General.exnMessage ex); + ()) + end + + +(** generate code according to the given template file for the given model *) +fun generate model template + = let val env = C.initEnv model + val tree = Tpl_Parser.parse template + in + (initOut(); + (*printTTree tree;*) + write env tree; + closeFile () ) + handle ex => (closeFile(); raise ex) + end + +end diff --git a/src/codegen/gcg_helper.sml b/src/codegen/gcg_helper.sml index 877ff20..de50d03 100644 --- a/src/codegen/gcg_helper.sml +++ b/src/codegen/gcg_helper.sml @@ -1,71 +1,71 @@ -(***************************************************************************** - * su4sml GCG - Generic Code Generator - * - * gcg_helper.sml - helper library for su4sml-gcg - * Copyright (C) 2005 Raphael Eidenbenz - * - * This file is part of su4sml-gcg. - * - * 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. - ******************************************************************************) - - -structure Gcg_Helper = -struct - -fun fieldSplit d s = String.fields (fn c => (c = d)) s -fun tokenSplit d s = String.tokens (fn c => (c = d)) s - -local - fun endsWithEscape "" = false - | endsWithEscape s = (substring(s,size(s)-1,1) = "\\") -in - fun joinEscapeSplitted d [] = [] - | joinEscapeSplitted d [l] = [l] - | joinEscapeSplitted d (h::s::t) = if endsWithEscape(h) - then (substring(h,0,size(h)-1)^d^s)::t - else h::(joinEscapeSplitted d (s::t)) -end - -(* FIXME: move to library.sml? *) -val curry = fn f => fn x => fn y => f (x, y) -val uncurry = fn f => fn (x, y) => f x y - -(* FIXME: move to ListEq (and rename to isPrefix...) (is this even used somewhere?) *) -fun isSuffix [] _ = true - | isSuffix _ [] = false - | isSuffix (h1::t1) (h2::t2) = (h1=h2) andalso (isSuffix t1 t2) - -(* FIXME: cleanup *) -fun assureDir file = - let val dirList = rev (tl (rev (String.tokens (fn c => c = #"/") file))) - - fun assert1 "" d = ((if (OS.FileSys.isDir d) then () else ()) - handle SysErr => (OS.FileSys.mkDir d) ) - | assert1 prefix d = (if (OS.FileSys.isDir (prefix^"/"^d)) then () else ()) - handle SysErr => (OS.FileSys.mkDir (prefix^"/"^d)) - - - fun assertDList _ [] = () - | assertDList prefix [d] = assert1 prefix d - | assertDList "" (h::t) = (assert1 "" h ; assertDList h t) - | assertDList prefix (h::t) = (assert1 prefix h; - assertDList (prefix^"/"^h) t ) - in - assertDList "" dirList - end - - -end +(***************************************************************************** + * su4sml GCG - Generic Code Generator + * + * gcg_helper.sml - helper library for su4sml-gcg + * Copyright (C) 2005 Raphael Eidenbenz + * + * This file is part of su4sml-gcg. + * + * 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. + ******************************************************************************) + + +structure Gcg_Helper = +struct + +fun fieldSplit d s = String.fields (fn c => (c = d)) s +fun tokenSplit d s = String.tokens (fn c => (c = d)) s + +local + fun endsWithEscape "" = false + | endsWithEscape s = (substring(s,size(s)-1,1) = "\\") +in + fun joinEscapeSplitted d [] = [] + | joinEscapeSplitted d [l] = [l] + | joinEscapeSplitted d (h::s::t) = if endsWithEscape(h) + then (substring(h,0,size(h)-1)^d^s)::t + else h::(joinEscapeSplitted d (s::t)) +end + +(* FIXME: move to library.sml? *) +val curry = fn f => fn x => fn y => f (x, y) +val uncurry = fn f => fn (x, y) => f x y + +(* FIXME: move to ListEq (and rename to isPrefix...) (is this even used somewhere?) *) +fun isSuffix [] _ = true + | isSuffix _ [] = false + | isSuffix (h1::t1) (h2::t2) = (h1=h2) andalso (isSuffix t1 t2) + +(* FIXME: cleanup *) +fun assureDir file = + let val dirList = rev (tl (rev (String.tokens (fn c => c = #"/") file))) + + fun assert1 "" d = ((if (OS.FileSys.isDir d) then () else ()) + handle SysErr => (OS.FileSys.mkDir d) ) + | assert1 prefix d = (if (OS.FileSys.isDir (prefix^"/"^d)) then () else ()) + handle SysErr => (OS.FileSys.mkDir (prefix^"/"^d)) + + + fun assertDList _ [] = () + | assertDList prefix [d] = assert1 prefix d + | assertDList "" (h::t) = (assert1 "" h ; assertDList h t) + | assertDList prefix (h::t) = (assert1 prefix h; + assertDList (prefix^"/"^h) t ) + in + assertDList "" dirList + end + + +end diff --git a/src/codegen/java_cartridge.sml b/src/codegen/java_cartridge.sml index c7ac9cd..9d5372d 100644 --- a/src/codegen/java_cartridge.sml +++ b/src/codegen/java_cartridge.sml @@ -1,100 +1,124 @@ -(***************************************************************************** - * su4sml - a SecureUML repository for SML - * - * java_cartridge.sml - a java cartridge for gcg - * Copyright (C) 2005 Raphael Eidenbenz - * - * 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. - ******************************************************************************) - - -(* FIXME: This is blindly copied from the C#_Cartridge. *) -(* Probably, some things have to be adjusted to Java syntax *) -functor Java_Cartridge(SuperCart : BASE_CARTRIDGE) : BASE_CARTRIDGE = -struct -open Rep_OclType - - -type Model = SuperCart.Model - -type environment = { extension : SuperCart.environment } - -(* fun getModel (env:environment) = SuperCart.getModel (#extension env)*) - - - - -fun initEnv model = { extension = SuperCart.initEnv model } : environment - -fun unpack (env : environment) = #extension env - -fun pack superEnv = {extension = superEnv} : environment - -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) - -(* internal translation table, blindly copied from C# *) -fun super2Native "ClassifierScope" = "static" - | super2Native "InstanceScope" = "" - | super2Native "package" = "public" - | super2Native "Integer" = "int" - | super2Native "Real" = "double" - | super2Native "String" = "string" - | super2Native "Boolean" = "bool" - | super2Native "OclVoid" = "void" - | 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<" - ^(super2Native (String.substring(s,4,size s - 5)))^">" - else s ) - handle Subscript => s - -(* lookup environment -> string -> string - * overrides some lookup entries of the base cartridge - *) -fun lookup (env : environment) "attribute_name_small_letter" - = StringHandling.uncapitalize (SuperCart.lookup (unpack env) "attribute_name") - | lookup (env : environment) "attribute_name_capital" - = StringHandling.capitalize (SuperCart.lookup (unpack env) "attribute_name") - | lookup (env : environment) (s as "attribute_type") = super2Native (SuperCart.lookup (unpack env) s ) - | lookup (env : environment) (s as "attribute_visibility")= super2Native (SuperCart.lookup (unpack env) s) - | lookup (env : environment) (s as "attribute_scope") = super2Native (SuperCart.lookup (unpack env) s) - | lookup (env : environment) (s as "operation_result_type")=super2Native (SuperCart.lookup (unpack env) s) - | lookup (env : environment) (s as "operation_visibility")= super2Native (SuperCart.lookup (unpack env) s) - | 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 = SuperCart.lookup (unpack env) s - - - -fun test (env : environment) s = SuperCart.test (unpack env) s - -(* no further functionality to add - * just unpack the Supercartridge's environment, - * pass it to SuperCart.foreach, get back a SuperCart.environment list - * pack every item into a native environment - *) -fun foreach listType (env : environment) - = map pack (SuperCart.foreach listType (unpack env)) - - -end - +(***************************************************************************** + * su4sml - a SecureUML repository for SML + * + * java_cartridge.sml - a java cartridge for gcg + * Copyright (C) 2005 Raphael Eidenbenz + * + * 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. + ******************************************************************************) + + +(* FIXME: This is blindly copied from the C#_Cartridge. *) +(* Probably, some things have to be adjusted to Java syntax *) +functor Java_Cartridge(SuperCart : BASE_CARTRIDGE) : BASE_CARTRIDGE = +struct +open Rep_OclType +open library + + +type Model = SuperCart.Model + +type environment = { curParent : Rep_OclType.Path option, + extension : SuperCart.environment } + +(* fun getModel (env:environment) = SuperCart.getModel (#extension env)*) + + + + +fun initEnv model = { curParent = NONE, + extension = SuperCart.initEnv model } : environment + +fun unpack (env : environment) = #extension env + +fun pack (Env : environment) (superEnv : SuperCart.environment) = {curParent = #curParent Env, + extension = superEnv} : environment + +fun curClassifier env = SuperCart.curClassifier (unpack env) +fun curArgument env = SuperCart.curArgument (unpack env) +fun curAssociationEnd env = SuperCart.curAssociationEnd (unpack env) +fun curOperation env = SuperCart.curOperation (unpack env) +fun curAttribute env = SuperCart.curAttribute (unpack env) +fun curParent (env : environment) = #curParent env + +fun curClassifier' env = Option.valOf(curClassifier env) +fun curOperation' env = Option.valOf(curOperation env) +fun curParent' (env : environment) = Option.valOf(curParent env) + +(* internal translation table, blindly copied from C# *) +fun super2Native "ClassifierScope" = "static" + | super2Native "InstanceScope" = "" + | super2Native "package" = "" + | super2Native "Integer" = "int" + | super2Native "Real" = "double" + | super2Native "Boolean" = "Boolean" + | super2Native "OclVoid" = "void" + | 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<" + ^(super2Native (String.substring(s,4,size s - 5)))^">" + else s ) + handle Subscript => s + +(* lookup environment -> string -> string + * overrides some lookup entries of the base cartridge + *) +fun lookup (env : environment) "attribute_name_small_letter" + = StringHandling.uncapitalize (SuperCart.lookup (unpack env) "attribute_name") + | lookup (env : environment) "attribute_name_capital" + = StringHandling.capitalize (SuperCart.lookup (unpack env) "attribute_name") + | lookup (env : environment) (s as "attribute_type") = super2Native (SuperCart.lookup (unpack env) s ) + | lookup (env : environment) (s as "attribute_visibility")= super2Native (SuperCart.lookup (unpack env) s) + | lookup (env : environment) (s as "attribute_scope") = super2Native (SuperCart.lookup (unpack env) s) + | lookup (env : environment) (s as "operation_result_type")=super2Native (SuperCart.lookup (unpack env) s) + | lookup (env : environment) (s as "operation_visibility")= super2Native (SuperCart.lookup (unpack env) s) + | 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 = SuperCart.lookup (unpack env) s + + + +fun test (env : environment) "hasParentInterfaces" = (length (Rep_Core.parent_interface_names_of (curClassifier' env))) <> 0 + | test env "last_interface" = (List.last (Rep_Core.parent_interface_names_of (curClassifier' env))) = + curParent' env + | test env "operation_has_arguments" = (length (Rep_Core.arguments_of_op (curOperation' env))) > 0 + | test env "operation_is_void" = (lookup env "operation_result_type") = "void" + | test env "operation_non_void" = (lookup env "operation_result_type") <> "void" + | test (env : environment) s = SuperCart.test (unpack env) s + +fun foreach_parent_interface (env : environment) + = let val parents = Rep_Core.parent_interface_names_of (curClassifier' env) + fun env_from_parent p = { curParent = SOME p, + extension = #extension env } + in + List.map env_from_parent parents + end + +fun foreach "parent_interface_list" env = foreach_parent_interface env + (* no further functionality to add + * just unpack the Supercartridge's environment, + * pass it to SuperCart.foreach, get back a SuperCart.environment list + * pack every item into a native environment + *) + | foreach listType (env : environment) = map (pack env) (SuperCart.foreach listType (unpack env)) + +end diff --git a/src/codegen/junit_cartridge.sml b/src/codegen/junit_cartridge.sml index 45815d6..662ef68 100644 --- a/src/codegen/junit_cartridge.sml +++ b/src/codegen/junit_cartridge.sml @@ -47,18 +47,31 @@ 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 +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) + | lookup (env : environment) s = SuperCart.lookup (unpack env) s (* any special predicates?*) fun test (env : environment ) "operation_isNotPrivate" = not (test env "operation_isPrivate") | test (env : environment ) "not_last_argument" = not (test env "last_argument") - | test (env : environment) "isTestable" = (test env "hasOperations") andalso (not (test env "isInterface")) + | test (env : environment) "isTestable" = (not (test env "isInterface")) (* andalso (not (test env "isAbstract")) *) andalso (test env "hasOperations") | test (env : environment) s = SuperCart.test (unpack env) s +(* Check if operation is already in given list *) +fun opInList (operation : environment) oplist = foldr (fn (a,b) => if (lookup operation "operation_name") = (lookup a "operation_name") then (false andalso b) else (true andalso b)) true oplist + +(* Remove duplicate methods by comparing their names *) +fun unique_op oplist = foldl (fn (el,l) => if (opInList el l) then l @ [el] else l) [] oplist + (* any special lists? *) -fun foreach listType (env : environment) +fun foreach "unique_operation_list" (env : environment) = unique_op (foreach "operation_list" env) + | foreach listType (env : environment) = map pack (SuperCart.foreach listType (unpack env)) end diff --git a/src/codegen/secureuml_cartridge.sig b/src/codegen/secureuml_cartridge.sig index eaec2d6..b092f31 100644 --- a/src/codegen/secureuml_cartridge.sig +++ b/src/codegen/secureuml_cartridge.sig @@ -1,40 +1,40 @@ -(***************************************************************************** - * su4sml - a SecureUML repository for SML - * - * secureuml_cartridge.sig - an extended signature of CARTRIDGE specific - * for the SecureUML cartridge - * Copyright (C) 2005 Raphael Eidenbenz - * - * 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. - ******************************************************************************) - - -signature SECUREUML_CARTRIDGE = -sig - include BASE_CARTRIDGE - -(** the particular secureuml dialect used *) -structure Security:SECURITY_LANGUAGE - -val curPermissionSet: environment -> Security.Permission list option -val curPermission : environment -> Security.Permission option -val curRole : environment -> string option -val curConstraint : environment -> Rep_OclTerm.OclTerm option - -val isInPermission : Security.Design.Action -> Security.Permission -> bool - -end +(***************************************************************************** + * su4sml - a SecureUML repository for SML + * + * secureuml_cartridge.sig - an extended signature of CARTRIDGE specific + * for the SecureUML cartridge + * Copyright (C) 2005 Raphael Eidenbenz + * + * 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. + ******************************************************************************) + + +signature SECUREUML_CARTRIDGE = +sig + include BASE_CARTRIDGE + +(** the particular secureuml dialect used *) +structure Security:SECURITY_LANGUAGE + +val curPermissionSet: environment -> Security.Permission list option +val curPermission : environment -> Security.Permission option +val curRole : environment -> string option +val curConstraint : environment -> Rep_OclTerm.OclTerm option + +val isInPermission : Security.Design.Action -> Security.Permission -> bool + +end diff --git a/src/codegen/templates/C#.tpl b/src/codegen/templates/C#.tpl index 610e6ff..a4a6820 100644 --- a/src/codegen/templates/C#.tpl +++ b/src/codegen/templates/C#.tpl @@ -1,68 +1,68 @@ -@// Template for C# -@// (c) Copyright 2005 Raphael Eidenbenz eraphael-at-student.ethz.ch - -@openfile generated/csharp/$classifier_package$.cs -// generated by su4sml GCG - Generic Code Generator -@nl -@nl using System; -@nl -@nl namespace $classifier_package$ -@nl { - -@foreach classifier_list - - @nl@nl@nl - @if isPrimitive - @nl @tab // no support for primitive $classifier_name$ !! - @nl - @else - @if isClass - @nl @tab class $classifier_name$ - @elsif isInterface - @nl @tab interface $classifier_name$ - @end - @if hasParent - : $classifier_parent$ - @end - @nl @tab { - - @foreach attribute_list - - @nl@nl - @if attribute_isPublic @// PROPERTY! - - @nl @tab@tab private $attribute_scope$ $attribute_type$ $attribute_name_small_letter$ ; - @nl @tab@tab public $attribute_scope$ $attribute_type$ $attribute_name_capital$ - @nl @tab@tab { - @nl @tab@tab@tab get { return $attribute_name_small_letter$; } - @nl @tab@tab@tab set { $attribute_name_small_letter$ = value ; } - @nl @tab@tab } - @else - @nl @tab@tab $attribute_visibility$ $attribute_scope$ $attribute_type$ $attribute_name$ ; - @end - - @end - @nl - @foreach operation_list - @nl @tab@tab public $operation_scope$ $operation_result_type$ $operation_name$( - @foreach argument_list - @if last_argument - $argument_type$ $argument_name$ - @else - $argument_type$ $argument_name$ , - @end - @end - ) - @nl @tab@tab { - @nl @tab@tab@tab // ...toDo... - @nl @tab@tab } - @end - @// Konstruktor: - @// @nl @tab@tab $classifier_name$() - @// @nl @tab@tab {} - @nl @tab} - - @end - -@end +@// Template for C# +@// (c) Copyright 2005 Raphael Eidenbenz eraphael-at-student.ethz.ch + +@openfile generated/csharp/$classifier_package$.cs +// generated by su4sml GCG - Generic Code Generator +@nl +@nl using System; +@nl +@nl namespace $classifier_package$ +@nl { + +@foreach classifier_list + + @nl@nl@nl + @if isPrimitive + @nl @tab // no support for primitive $classifier_name$ !! + @nl + @else + @if isClass + @nl @tab class $classifier_name$ + @elsif isInterface + @nl @tab interface $classifier_name$ + @end + @if hasParent + : $classifier_parent$ + @end + @nl @tab { + + @foreach attribute_list + + @nl@nl + @if attribute_isPublic @// PROPERTY! + + @nl @tab@tab private $attribute_scope$ $attribute_type$ $attribute_name_small_letter$ ; + @nl @tab@tab public $attribute_scope$ $attribute_type$ $attribute_name_capital$ + @nl @tab@tab { + @nl @tab@tab@tab get { return $attribute_name_small_letter$; } + @nl @tab@tab@tab set { $attribute_name_small_letter$ = value ; } + @nl @tab@tab } + @else + @nl @tab@tab $attribute_visibility$ $attribute_scope$ $attribute_type$ $attribute_name$ ; + @end + + @end + @nl + @foreach operation_list + @nl @tab@tab public $operation_scope$ $operation_result_type$ $operation_name$( + @foreach argument_list + @if last_argument + $argument_type$ $argument_name$ + @else + $argument_type$ $argument_name$ , + @end + @end + ) + @nl @tab@tab { + @nl @tab@tab@tab // ...toDo... + @nl @tab@tab } + @end + @// Konstruktor: + @// @nl @tab@tab $classifier_name$() + @// @nl @tab@tab {} + @nl @tab} + + @end + +@end @nl} // End \ No newline at end of file diff --git a/src/codegen/templates/C#_SM.tpl b/src/codegen/templates/C#_SM.tpl index d1baed9..7145fbb 100644 --- a/src/codegen/templates/C#_SM.tpl +++ b/src/codegen/templates/C#_SM.tpl @@ -1,182 +1,182 @@ -@// Template for C# -@// (c) Rolf Adelsberger (rsa@student.ethz.ch) - -@openfile generated/csharp/StateMachine_$classifier_package$.cs -// generated by su4sml GCG - Generic Code Generator -@foreach classifier_list -@if hasAG -@nl -@nl using System; -@nl using System.Collections; -@nl -@nl namespace $classifier_package$ -@nl { -//State Class - @nl @tab public class State - @nl @tab { - @nl @tab@tab public string name; - @nl @tab@tab public Hashtable transitions; //this is indexed by the event IDs. - @nl - @nl @tab@tab public State(string n) - @nl @tab@tab { - @nl @tab@tab@tab transitions = new Hashtable(); - @nl @tab@tab@tab name = n; - @nl @tab@tab } - @nl @tab } - @nl - @nl - @nl @tab public delegate bool EventF(); - @nl @tab public delegate bool Guard(); - @nl @tab public delegate bool Effect(); -// Transition Class - @nl @tab public class Transition - @nl @tab { - @nl @tab@tab public State target; - @nl @tab@tab public Guard[] guards; - @nl @tab@tab public Effect[] effects; - @nl - @nl @tab@tab public Transition(State t, Guard[] ga, Effect[] e) - @nl @tab@tab { - @nl @tab@tab@tab target = t; - @nl @tab@tab@tab guards = ga; - @nl @tab@tab@tab effects = e; - @nl @tab@tab } - @nl @tab } - @nl -// State machine class - @nl @tab public class StateMachine - @nl @tab { - @nl @tab@tab public enum EVENTS - @nl @tab@tab { - @nl @tab@tab@tab ALWAYS = -1, - @foreach event_list - @nl @tab@tab@tab $event_name$, - @end - @nl @tab@tab@tab NUM_EV - @nl @tab@tab }; - @nl @tab@tab public State CUR_STATE; - @nl - @nl @tab@tab State START; - @foreach state_list - @nl @tab@tab State $state_ident$; - @end - @nl @tab@tab State END; - @nl - @nl - @nl @tab@tab private void init_states() - @nl @tab@tab { - @nl @tab@tab@tab START = new State("Initial"); - @foreach state_list - @nl @tab@tab@tab $state_ident$ = new State("$state_ident$"); - @end - @nl @tab@tab@tab END = new State("Final"); - @nl @tab@tab } - @nl - @nl @tab@tab public StateMachine() - @nl @tab@tab { - @nl @tab@tab init_states(); - @foreach state_list - @foreach events_of_state - @nl - @nl @tab@tab $state_ident$.transitions.Add(EVENTS.$cur_event_id$,new Transition[]{ - @foreach transition_list - @nl @tab@tab@tab@tab - new Transition($transition_target$, - @nl @tab@tab@tab@tab@tab new Guard[]{ - @foreach guard_of_trans_list - new Guard($guard_ident$) - @if isLastGuard - } @//closing guard array - @else - , @//between guards - @end - @end - , @//comma between guards and Effects - @nl @tab@tab@tab@tab@tab new Effect[] { - @foreach effect_list - new Effect($effect_ident$), - @end - }) - @if isLastTrans - }); @//endof transition array - @else - , @//separate transitions - @end - @end - @end @//endof events_of_state - @nl - @nl - @end @//endof state_list - @nl @tab@tab CUR_STATE = START = $real_init$; - @nl @tab@tab END = $final_state_name$; - @nl @tab@tab } - @nl - @nl @tab@tab //these three guards always exist - @nl @tab@tab public bool alwaysG(){return true;} - @nl @tab@tab public bool elseG(){return true;} - @nl @tab@tab public bool noneR(){return true;} - @nl - @nl - @nl @tab@tab private bool checkState(EVENTS E_ID) - @nl @tab@tab { - @nl @tab@tab@tab return (CUR_STATE.transitions.ContainsKey(E_ID)); - @nl @tab@tab } - @nl - @nl - @foreach event_list - @nl @tab@tab public void $trigger_name$() - @nl @tab@tab { - @nl @tab@tab@tab EVENTS E_ID = EVENTS.$event_name$; - @nl @tab@tab@tab if(checkState(E_ID)) { - @nl @tab@tab@tab@tab Console.WriteLine("Checkstate ok...\n"); - @nl @tab@tab@tab@tab Transition[] trans = (Transition[]) CUR_STATE.transitions[E_ID]; - @nl @tab@tab@tab@tab foreach(Transition t in trans){ - @nl @tab@tab@tab@tab@tab foreach(Guard g in t.guards){ - @nl @tab@tab@tab@tab@tab@tab if(g()){ - @nl @tab@tab@tab@tab@tab@tab@tab Console.WriteLine("Guard \"{0}\" in $event_name$ succeeded...\n",g.Method.ToString()); - @//@nl @tab@tab@tab@tab@tab@tab@tab CUR_STATE = t.target; - @//@nl @tab@tab@tab@tab@tab@tab@tab return; - @nl @tab@tab@tab@tab@tab@tab } else { - @nl @tab@tab@tab@tab@tab@tab@tab Console.WriteLine("Guard \"{0}\" in $event_name$ didn't hold...\n",g.Method.ToString()); - @nl @tab@tab@tab@tab@tab@tab@tab break; - @nl @tab@tab@tab@tab@tab@tab } - @nl @tab@tab@tab@tab@tab@tab //if we arrived here, all guards did hold --> - @nl @tab@tab@tab@tab@tab@tab CUR_STATE = t.target; - @nl @tab@tab@tab@tab@tab@tab //fire all effects - @nl @tab@tab@tab@tab@tab foreach(Effect e in t.effects) { - @nl @tab@tab@tab@tab@tab@tab e.eval(); - @nl @tab@tab@tab@tab@tab } - @nl @tab@tab@tab@tab@tab@tab //go back - @nl @tab@tab@tab@tab@tab@tab return; - @nl @tab@tab@tab@tab@tab } - @nl @tab@tab@tab@tab } - @nl @tab@tab@tab } else { - Console.WriteLine("Current state \"{0}\" does not accept Event \"{1}\"", CUR_STATE.name,E_ID.ToString()); - } - @nl @tab@tab } - @nl - @end - @nl @tab@tab private void auto() { - @nl @tab@tab@tab if(checkState(EVENTS.AUTO)){ - @nl @tab@tab@tab@tab Transitions[] trans = (Transition[]) CUR_STATE.transitions[EVENTS.AUTO]; - @nl @tab@tab@tab@tab foreach(Transition t in trans) { - @nl @tab@tab@tab@tab@tab foreach(Guard g in t.guards) { - @nl @tab@tab@tab@tab@tab if(!g()) { - @nl @tab@tab@tab@tab@tab@tab break; // break out of the iteration over the guards - @nl @tab@tab@tab@tab@tab } - @nl @tab@tab@tab@tab@tab CUR_STATE = t.target; - @nl @tab@tab@tab@tab@tab } - @nl @tab@tab@tab@tab foreach(Effect e in t.effects) { - @nl @tab@tab@tab@tab@tab e.eval(); - @nl @tab@tab@tab@tab } - @nl @tab@tab@tab@tab return; - @nl @tab@tab@tab } - @nl @tab@tab } - @nl @tab@tab else { - @nl @tab@tab@tab return; - @nl @tab@tab } - @nl @tab } - @nl @tab@tab } @//endof state machine -@nl} // End -@end -@end +@// Template for C# +@// (c) Rolf Adelsberger (rsa@student.ethz.ch) + +@openfile generated/csharp/StateMachine_$classifier_package$.cs +// generated by su4sml GCG - Generic Code Generator +@foreach classifier_list +@if hasAG +@nl +@nl using System; +@nl using System.Collections; +@nl +@nl namespace $classifier_package$ +@nl { +//State Class + @nl @tab public class State + @nl @tab { + @nl @tab@tab public string name; + @nl @tab@tab public Hashtable transitions; //this is indexed by the event IDs. + @nl + @nl @tab@tab public State(string n) + @nl @tab@tab { + @nl @tab@tab@tab transitions = new Hashtable(); + @nl @tab@tab@tab name = n; + @nl @tab@tab } + @nl @tab } + @nl + @nl + @nl @tab public delegate bool EventF(); + @nl @tab public delegate bool Guard(); + @nl @tab public delegate bool Effect(); +// Transition Class + @nl @tab public class Transition + @nl @tab { + @nl @tab@tab public State target; + @nl @tab@tab public Guard[] guards; + @nl @tab@tab public Effect[] effects; + @nl + @nl @tab@tab public Transition(State t, Guard[] ga, Effect[] e) + @nl @tab@tab { + @nl @tab@tab@tab target = t; + @nl @tab@tab@tab guards = ga; + @nl @tab@tab@tab effects = e; + @nl @tab@tab } + @nl @tab } + @nl +// State machine class + @nl @tab public class StateMachine + @nl @tab { + @nl @tab@tab public enum EVENTS + @nl @tab@tab { + @nl @tab@tab@tab ALWAYS = -1, + @foreach event_list + @nl @tab@tab@tab $event_name$, + @end + @nl @tab@tab@tab NUM_EV + @nl @tab@tab }; + @nl @tab@tab public State CUR_STATE; + @nl + @nl @tab@tab State START; + @foreach state_list + @nl @tab@tab State $state_ident$; + @end + @nl @tab@tab State END; + @nl + @nl + @nl @tab@tab private void init_states() + @nl @tab@tab { + @nl @tab@tab@tab START = new State("Initial"); + @foreach state_list + @nl @tab@tab@tab $state_ident$ = new State("$state_ident$"); + @end + @nl @tab@tab@tab END = new State("Final"); + @nl @tab@tab } + @nl + @nl @tab@tab public StateMachine() + @nl @tab@tab { + @nl @tab@tab init_states(); + @foreach state_list + @foreach events_of_state + @nl + @nl @tab@tab $state_ident$.transitions.Add(EVENTS.$cur_event_id$,new Transition[]{ + @foreach transition_list + @nl @tab@tab@tab@tab + new Transition($transition_target$, + @nl @tab@tab@tab@tab@tab new Guard[]{ + @foreach guard_of_trans_list + new Guard($guard_ident$) + @if isLastGuard + } @//closing guard array + @else + , @//between guards + @end + @end + , @//comma between guards and Effects + @nl @tab@tab@tab@tab@tab new Effect[] { + @foreach effect_list + new Effect($effect_ident$), + @end + }) + @if isLastTrans + }); @//endof transition array + @else + , @//separate transitions + @end + @end + @end @//endof events_of_state + @nl + @nl + @end @//endof state_list + @nl @tab@tab CUR_STATE = START = $real_init$; + @nl @tab@tab END = $final_state_name$; + @nl @tab@tab } + @nl + @nl @tab@tab //these three guards always exist + @nl @tab@tab public bool alwaysG(){return true;} + @nl @tab@tab public bool elseG(){return true;} + @nl @tab@tab public bool noneR(){return true;} + @nl + @nl + @nl @tab@tab private bool checkState(EVENTS E_ID) + @nl @tab@tab { + @nl @tab@tab@tab return (CUR_STATE.transitions.ContainsKey(E_ID)); + @nl @tab@tab } + @nl + @nl + @foreach event_list + @nl @tab@tab public void $trigger_name$() + @nl @tab@tab { + @nl @tab@tab@tab EVENTS E_ID = EVENTS.$event_name$; + @nl @tab@tab@tab if(checkState(E_ID)) { + @nl @tab@tab@tab@tab Console.WriteLine("Checkstate ok...\n"); + @nl @tab@tab@tab@tab Transition[] trans = (Transition[]) CUR_STATE.transitions[E_ID]; + @nl @tab@tab@tab@tab foreach(Transition t in trans){ + @nl @tab@tab@tab@tab@tab foreach(Guard g in t.guards){ + @nl @tab@tab@tab@tab@tab@tab if(g()){ + @nl @tab@tab@tab@tab@tab@tab@tab Console.WriteLine("Guard \"{0}\" in $event_name$ succeeded...\n",g.Method.ToString()); + @//@nl @tab@tab@tab@tab@tab@tab@tab CUR_STATE = t.target; + @//@nl @tab@tab@tab@tab@tab@tab@tab return; + @nl @tab@tab@tab@tab@tab@tab } else { + @nl @tab@tab@tab@tab@tab@tab@tab Console.WriteLine("Guard \"{0}\" in $event_name$ didn't hold...\n",g.Method.ToString()); + @nl @tab@tab@tab@tab@tab@tab@tab break; + @nl @tab@tab@tab@tab@tab@tab } + @nl @tab@tab@tab@tab@tab@tab //if we arrived here, all guards did hold --> + @nl @tab@tab@tab@tab@tab@tab CUR_STATE = t.target; + @nl @tab@tab@tab@tab@tab@tab //fire all effects + @nl @tab@tab@tab@tab@tab foreach(Effect e in t.effects) { + @nl @tab@tab@tab@tab@tab@tab e.eval(); + @nl @tab@tab@tab@tab@tab } + @nl @tab@tab@tab@tab@tab@tab //go back + @nl @tab@tab@tab@tab@tab@tab return; + @nl @tab@tab@tab@tab@tab } + @nl @tab@tab@tab@tab } + @nl @tab@tab@tab } else { + Console.WriteLine("Current state \"{0}\" does not accept Event \"{1}\"", CUR_STATE.name,E_ID.ToString()); + } + @nl @tab@tab } + @nl + @end + @nl @tab@tab private void auto() { + @nl @tab@tab@tab if(checkState(EVENTS.AUTO)){ + @nl @tab@tab@tab@tab Transitions[] trans = (Transition[]) CUR_STATE.transitions[EVENTS.AUTO]; + @nl @tab@tab@tab@tab foreach(Transition t in trans) { + @nl @tab@tab@tab@tab@tab foreach(Guard g in t.guards) { + @nl @tab@tab@tab@tab@tab if(!g()) { + @nl @tab@tab@tab@tab@tab@tab break; // break out of the iteration over the guards + @nl @tab@tab@tab@tab@tab } + @nl @tab@tab@tab@tab@tab CUR_STATE = t.target; + @nl @tab@tab@tab@tab@tab } + @nl @tab@tab@tab@tab foreach(Effect e in t.effects) { + @nl @tab@tab@tab@tab@tab e.eval(); + @nl @tab@tab@tab@tab } + @nl @tab@tab@tab@tab return; + @nl @tab@tab@tab } + @nl @tab@tab } + @nl @tab@tab else { + @nl @tab@tab@tab return; + @nl @tab@tab } + @nl @tab } + @nl @tab@tab } @//endof state machine +@nl} // End +@end +@end diff --git a/src/codegen/templates/C#_SecureUML.tpl b/src/codegen/templates/C#_SecureUML.tpl index 95838cb..0237b85 100644 --- a/src/codegen/templates/C#_SecureUML.tpl +++ b/src/codegen/templates/C#_SecureUML.tpl @@ -1,166 +1,166 @@ -@// Template for C# -@// (c) Copyright 2005 Raphael Eidenbenz eraphael-at-student.ethz.ch - - -@// write permissions into XML-file - -@openfile generated/csharp_secure/$classifier_package$.xml - -@nl -@nl -@nl@nl - -@foreach permission_list -@nl @tab - @foreach role_list - @nl @tab@tab - @end - @foreach constraint_list - @nl @tab@tab $constraint$ - @end -@nl @tab@tab -@nl @tab -@end -@nl - -@// write C#-code - -@openfile generated/csharp_secure/$classifier_package$.cs -// generated by su4sml GCG - Generic Code Generator -@nl -@nl using System; -@nl using Mds; -@nl -@nl namespace $classifier_package$ -@nl { - -@foreach classifier_list - - @nl@nl@nl - @if isPrimitive - @nl @tab // no support for primitive $classifier_name$ !! - @nl - @elsif isEnumeration - @nl @tab // no support for enumeration $classifier_name$ !! - @nl - @else - @if isClass - @nl @tab class $classifier_name$ - @elsif isInterface - @nl @tab interface $classifier_name$ - @end - @if hasParent - : $classifier_parent$ - @end - @nl @tab { - - @foreach attribute_list - - @nl - @if attribute_isPublic @// PROPERTY! - - @nl @tab@tab private $attribute_scope$ $attribute_type$ $attribute_name_small_letter$ ; - @nl @tab@tab public $attribute_scope$ $attribute_type$ $attribute_name_capital$ - @nl @tab@tab { - @nl @tab@tab@tab get - @nl @tab@tab@tab { - @foreach readPermission_list - @if first_permission - @nl @tab@tab@tab@tab - MdsEngine.Assert(this, new string[] { - @end - @if last_permission - "$permission_name$" }); - @else - "$permission_name$", - @end - @end - @nl @tab@tab@tab@tab return $attribute_name_small_letter$; - @nl @tab@tab@tab } - @nl @tab@tab@tab set - @nl @tab@tab@tab { - @foreach updatePermission_list - @if first_permission - @nl @tab@tab@tab@tab - MdsEngine.Assert(this, new string[] { - @end - @if last_permission - "$permission_name$" }); - @else - "$permission_name$", - @end - @end - @nl @tab@tab@tab@tab $attribute_name_small_letter$ = value ; - @nl @tab@tab@tab } - @nl @tab@tab } - @else - @nl @tab@tab $attribute_visibility$ $attribute_scope$ $attribute_type$ $attribute_name$ ; - @end - - @end - @nl - @foreach operation_list - @nl @tab@tab public $operation_scope$ $operation_result_type$ $operation_name$( - @foreach argument_list - @if last_argument - $argument_type$ $argument_name$ - @else - $argument_type$ $argument_name$ , - @end - @end - ) - @nl @tab@tab { - - @foreach executePermission_list - @if first_permission - @nl@tab@tab@tab - MdsEngine.Assert(this, new string[] { - @end - @if last_permission - "$permission_name$" }); - @else - "$permission_name$", - @end - @end - @nl @tab@tab@tab // ...toDo... - @nl @tab@tab } - @end - @nl - @// Constructor: - @nl @tab@tab // Constructor - @nl @tab@tab $classifier_name$() - @nl @tab@tab { - @foreach createPermission_list - @if first_permission - @nl @tab @tab @tab - MdsEngine.Assert(this, new string[] { - @end - @if last_permission - "$permission_name$" }); - @else - "$permission_name$", - @end - @end - @nl @tab@tab } - @nl - @// Destructor: - @nl @tab@tab // Destructor - @nl @tab@tab ~$classifier_name$() - @nl @tab@tab { - @foreach deletePermission_list - @if first_permission - @nl @tab @tab @tab - MdsEngine.Assert(this, new string[] { - @end - @if last_permission - "$permission_name$" }); - @else - "$permission_name$", - @end - @end - @nl @tab@tab } - - @nl @tab } - @end -@end -@nl} @// End +@// Template for C# +@// (c) Copyright 2005 Raphael Eidenbenz eraphael-at-student.ethz.ch + + +@// write permissions into XML-file + +@openfile generated/csharp_secure/$classifier_package$.xml + +@nl +@nl +@nl@nl + +@foreach permission_list +@nl @tab + @foreach role_list + @nl @tab@tab + @end + @foreach constraint_list + @nl @tab@tab $constraint$ + @end +@nl @tab@tab +@nl @tab +@end +@nl + +@// write C#-code + +@openfile generated/csharp_secure/$classifier_package$.cs +// generated by su4sml GCG - Generic Code Generator +@nl +@nl using System; +@nl using Mds; +@nl +@nl namespace $classifier_package$ +@nl { + +@foreach classifier_list + + @nl@nl@nl + @if isPrimitive + @nl @tab // no support for primitive $classifier_name$ !! + @nl + @elsif isEnumeration + @nl @tab // no support for enumeration $classifier_name$ !! + @nl + @else + @if isClass + @nl @tab class $classifier_name$ + @elsif isInterface + @nl @tab interface $classifier_name$ + @end + @if hasParent + : $classifier_parent$ + @end + @nl @tab { + + @foreach attribute_list + + @nl + @if attribute_isPublic @// PROPERTY! + + @nl @tab@tab private $attribute_scope$ $attribute_type$ $attribute_name_small_letter$ ; + @nl @tab@tab public $attribute_scope$ $attribute_type$ $attribute_name_capital$ + @nl @tab@tab { + @nl @tab@tab@tab get + @nl @tab@tab@tab { + @foreach readPermission_list + @if first_permission + @nl @tab@tab@tab@tab + MdsEngine.Assert(this, new string[] { + @end + @if last_permission + "$permission_name$" }); + @else + "$permission_name$", + @end + @end + @nl @tab@tab@tab@tab return $attribute_name_small_letter$; + @nl @tab@tab@tab } + @nl @tab@tab@tab set + @nl @tab@tab@tab { + @foreach updatePermission_list + @if first_permission + @nl @tab@tab@tab@tab + MdsEngine.Assert(this, new string[] { + @end + @if last_permission + "$permission_name$" }); + @else + "$permission_name$", + @end + @end + @nl @tab@tab@tab@tab $attribute_name_small_letter$ = value ; + @nl @tab@tab@tab } + @nl @tab@tab } + @else + @nl @tab@tab $attribute_visibility$ $attribute_scope$ $attribute_type$ $attribute_name$ ; + @end + + @end + @nl + @foreach operation_list + @nl @tab@tab public $operation_scope$ $operation_result_type$ $operation_name$( + @foreach argument_list + @if last_argument + $argument_type$ $argument_name$ + @else + $argument_type$ $argument_name$ , + @end + @end + ) + @nl @tab@tab { + + @foreach executePermission_list + @if first_permission + @nl@tab@tab@tab + MdsEngine.Assert(this, new string[] { + @end + @if last_permission + "$permission_name$" }); + @else + "$permission_name$", + @end + @end + @nl @tab@tab@tab // ...toDo... + @nl @tab@tab } + @end + @nl + @// Constructor: + @nl @tab@tab // Constructor + @nl @tab@tab $classifier_name$() + @nl @tab@tab { + @foreach createPermission_list + @if first_permission + @nl @tab @tab @tab + MdsEngine.Assert(this, new string[] { + @end + @if last_permission + "$permission_name$" }); + @else + "$permission_name$", + @end + @end + @nl @tab@tab } + @nl + @// Destructor: + @nl @tab@tab // Destructor + @nl @tab@tab ~$classifier_name$() + @nl @tab@tab { + @foreach deletePermission_list + @if first_permission + @nl @tab @tab @tab + MdsEngine.Assert(this, new string[] { + @end + @if last_permission + "$permission_name$" }); + @else + "$permission_name$", + @end + @end + @nl @tab@tab } + + @nl @tab } + @end +@end +@nl} @// End diff --git a/src/codegen/templates/base.tpl b/src/codegen/templates/base.tpl index 8f2ca1f..ee0313f 100644 --- a/src/codegen/templates/base.tpl +++ b/src/codegen/templates/base.tpl @@ -1,28 +1,28 @@ -@// base template -@// assumption: all classifiers are classes - -@openfile generated/base/$classifier_package$.base -// generated by su4sml GCG - Generic Code Generator - -@nl@nl package $classifier_package$ ; -@foreach classifier_list - - @nl@nl - class $classifier_name$ - @if hasParent - extends $classifier_parent$ - @end - @nl { - @foreach attribute_list - @nl @tab public $attribute_type$ $attribute_name$ ; - @end - @foreach operation_list - @nl @tab $operation_result_type$ $operation_name$( - @foreach argument_list - $argument_type$ $argument_name$ - @end - ) - @nl @tab {} - @end - @nl } +@// base template +@// assumption: all classifiers are classes + +@openfile generated/base/$classifier_package$.base +// generated by su4sml GCG - Generic Code Generator + +@nl@nl package $classifier_package$ ; +@foreach classifier_list + + @nl@nl + class $classifier_name$ + @if hasParent + extends $classifier_parent$ + @end + @nl { + @foreach attribute_list + @nl @tab public $attribute_type$ $attribute_name$ ; + @end + @foreach operation_list + @nl @tab $operation_result_type$ $operation_name$( + @foreach argument_list + $argument_type$ $argument_name$ + @end + ) + @nl @tab {} + @end + @nl } @end \ No newline at end of file diff --git a/src/codegen/templates/java.tpl b/src/codegen/templates/java.tpl index 4009af0..82f336d 100644 --- a/src/codegen/templates/java.tpl +++ b/src/codegen/templates/java.tpl @@ -1,25 +1,59 @@ -@// Example template for Java -@// assumption: all classifiers are classes - -@foreach classifier_list - @openfile generated/$classifier_name$.java - package $classifier_package$ ; - @nl@nl - public class $classifier_name$ - @if hasParent - extends $classifier_parent$ - @end - @nl { - @foreach attribute_list - @nl @tab public $attribute_type$ $attribute_name$ ; - @end - @foreach operation_list - @nl @tab public $operation_result_type$ $operation_name$( - @foreach argument_list - $argument_type$ $argument_name$ - @end - ) - @nl @tab {} - @end - @nl } -@end +@// Example template for Java +@// assumption: all classifiers are classes + +@foreach nonprimitive_classifier_list + @openfileifnotexists generated/src/main/java/$classifier_package_path$/$classifier_name$.java + package $classifier_package$; + @nl@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$ + @end + @end + @if hasParentInterfaces + @if isInterface + extends + @else + implements + @end + @foreach parent_interface_list + @if last_interface + $parent_interface$ + @else + $parent_interface$, + @end + @end + @end + { + @if notInterface + @foreach attribute_list + @nl @tab $attribute_visibility$ $attribute_type$ $attribute_name$ ; + @end + @end + @foreach operation_list + @nl @tab $operation_visibility$ $operation_result_type$ $operation_name$( + @foreach argument_list + @if last_argument + $argument_type$ $argument_name$ + @else + $argument_type$ $argument_name$, + @end + @end + ) + @if notInterface + {@nl@nl@tab} + @else + ; + @end + @end + @nl } +@end diff --git a/src/codegen/templates/java_ocl.tpl b/src/codegen/templates/java_ocl.tpl new file mode 100644 index 0000000..f0f3509 --- /dev/null +++ b/src/codegen/templates/java_ocl.tpl @@ -0,0 +1,61 @@ +@// Example template for Java +@// assumption: all classifiers are classes + +@foreach classifier_list + @openfile generated/$classifier_package_path$/$classifier_name$.java + package $classifier_package$ ; + @nl@nl + @if isClass + public class $classifier_name$ + @end + @if isInterface + public interface $classifier_name$ + @end + @if notInterface + @if hasParent + extends $classifier_parent$ + @end + @end + @if hasParentInterfaces + @if isInterface + extends + @else + implements + @end + @foreach parent_interface_list + @if last_interface + $parent_interface$ + @else + $parent_interface$, + @end + @end + @end + @nl { + @if notInterface + @foreach attribute_list + @nl @tab public $attribute_type$ $attribute_name$ ; + @end + @end + @foreach operation_list + @nl @tab public $operation_result_type$ $operation_name$( + @foreach argument_list + $argument_type$ $argument_name$ + @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 } +@end diff --git a/src/codegen/templates/junit.tpl b/src/codegen/templates/junit.tpl index 811ea8d..06037bc 100644 --- a/src/codegen/templates/junit.tpl +++ b/src/codegen/templates/junit.tpl @@ -17,6 +17,8 @@ @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.*; @nl @nl public class $classifier_name$Test extends Abstract$classifier_name$Test implements TestDataUser { @@ -40,7 +42,7 @@ @nl@tab@tab th = new TestHelper(classUnderTest,tda); @nl@tab } - @foreach operation_list + @foreach unique_operation_list @if operation_isNotPrivate @nl@nl@tab\@Test @nl@tab public void $operation_name$Test() throws Throwable { @@ -49,8 +51,60 @@ @nl@tab } @end @end - @nl} + @nl@nl + @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$( + @foreach argument_list + @if last_argument + $argument_type$ $argument_name$ + @else + $argument_type$ $argument_name$, + @end + @end + ) throws Throwable {@nl + @if operation_non_void + @tab@tab$operation_result_type$ result;@nl + @end + @tab@tab// Check preconditions @nl + $preconditions$@nl@tab@tab + // Execute method @nl@tab@tab + @if operation_non_void + result = + @end + testObject.$operation_name$( + @foreach argument_list + @if last_argument + $argument_name$ + @else + $argument_name$, + @end + @end + );@nl + @tab@tab// Check postconditions @nl + $postconditions$@nl + @tab@tab// Check invariants @nl + @tab@tab checkInvariant(); + @nl@tab@tab + @if operation_non_void + return result; + @end + @nl@tab + }@nl + @end + + @nl@nl@tab + /**@nl@tab + * Check invariants of the class @nl@tab + */@nl@tab + public void checkInvariant() throws InvariantFailedException {@nl + $invariants$ + @nl@tab} + @nl} @//-------------------------- @// Generate stub for abstract class @@ -60,7 +114,7 @@ @nl import $classifier_package$.$classifier_name$; @nl@nl public abstract class Abstract$classifier_name$Test { - @nl@nl@tab static Value testObject; + @nl@nl@tab static $classifier_name$ testObject; @nl@nl } @@ -74,14 +128,16 @@ @if operation_isNotPrivate [$operation_name$] @nl resulttype = $operation_result_type$; - @nl inputtypes = - @foreach argument_list - $argument_type$ - @if not_last_argument - , - @end + @if operation_has_arguments + @nl inputtypes = + @foreach argument_list + $argument_type$ + @if not_last_argument + , + @end + @end + ; @end - ; @nl #setup = ; @nl #teardown = ; @nl #{ diff --git a/src/codegen/templates/tpl.el b/src/codegen/templates/tpl.el index 4f08c13..b638ade 100644 --- a/src/codegen/templates/tpl.el +++ b/src/codegen/templates/tpl.el @@ -14,7 +14,7 @@ (list "\\W\\(@foreach\\)[ \t]*\\([a-zA-Z_-]*\\)\\W" '(1 font-lock-keyword-face) '(2 font-lock-variable-name-face)) - (list "\\W\\(@openfile\\|@else\\|@end\\)\\W" + (list "\\W\\(@openfile\\|@openfileifnotexists\\|@else\\|@end\\)\\W" '(0 font-lock-keyword-face)) ;; variables (list "\\$[a-zA-Z_-]*\\$" diff --git a/src/codegen/tpl_parser.sig b/src/codegen/tpl_parser.sig index 958af3d..ba9e3ec 100644 --- a/src/codegen/tpl_parser.sig +++ b/src/codegen/tpl_parser.sig @@ -1,40 +1,40 @@ -(***************************************************************************** - * su4sml GCG - Generic Code Generator - * - * tpl_parser.sig - template parser of a su4sml-gcg template - * Copyright (C) 2005 Raphael Eidenbenz - * - * This file is part of su4sml-gcg. - * - * 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. - ******************************************************************************) - -signature TPL_PARSER = -sig - -datatype TemplateTree - = ElseNode of TemplateTree list - | EvalLeaf of TemplateTree list - | ForEachNode of string * TemplateTree list - | IfNode of string * TemplateTree list - | OpenFileLeaf of string - | OpenFileIfNotExistsLeaf of string - | RootNode of TemplateTree list - | TextLeaf of string - -val printTTree : TemplateTree -> unit -val parse : string -> TemplateTree - -end +(***************************************************************************** + * su4sml GCG - Generic Code Generator + * + * tpl_parser.sig - template parser of a su4sml-gcg template + * Copyright (C) 2005 Raphael Eidenbenz + * + * This file is part of su4sml-gcg. + * + * 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. + ******************************************************************************) + +signature TPL_PARSER = +sig + +datatype TemplateTree + = ElseNode of TemplateTree list + | EvalLeaf of TemplateTree list + | ForEachNode of string * TemplateTree list + | IfNode of string * TemplateTree list + | OpenFileLeaf of string + | OpenFileIfNotExistsLeaf of string + | RootNode of TemplateTree list + | TextLeaf of string + +val printTTree : TemplateTree -> unit +val parse : string -> TemplateTree + +end diff --git a/src/codegen/tpl_parser.sml b/src/codegen/tpl_parser.sml index d9e19e7..6fba994 100644 --- a/src/codegen/tpl_parser.sml +++ b/src/codegen/tpl_parser.sml @@ -1,212 +1,212 @@ -(***************************************************************************** - * su4sml GCG - Generic Code Generator - * - * tpl_parser.sml - template parser of a su4sml-gcg template - * Copyright (C) 2005 Raphael Eidenbenz - * - * This file is part of su4sml-gcg. - * - * 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. - ******************************************************************************) - -(** A parser for template files. *) -signature TPL_PARSER = -sig - - datatype TemplateTree - = ElseNode of TemplateTree list - | EvalLeaf of TemplateTree list - | ForEachNode of string * TemplateTree list - | IfNode of string * TemplateTree list - | OpenFileLeaf of string - | OpenFileIfNotExistsLeaf of string - | RootNode of TemplateTree list - | TextLeaf of string - - val printTTree : TemplateTree -> unit - val parse : string -> TemplateTree - -end - - -structure Tpl_Parser : TPL_PARSER = -struct -open library -open Gcg_Helper - -val tplStream = ref (TextIO.openString "@// dummy template\n"); - -fun opentFile file = (TextIO.closeIn (!tplStream) ; - tplStream := (TextIO.openIn file)) - handle ex => error ("in Tpl_Parser.opentFile: \ - \couldn't open preprocessed template file: "^ - General.exnMessage ex) - -fun cleanUp tplFile = (TextIO.closeIn (!tplStream); - OS.FileSys.remove tplFile) - -fun readNextLine () = TextIO.inputLine (!tplStream) - - -(* FIXME: this currently uses a simple line-based template-file structure *) -(* (every line corresponds to exactly one node in this tree) *) -(* This should really be relaxed... *) -(* FIXME: add separate VariableLeaf *) -(* FIXME: merge If and Else Nodes *) -datatype TemplateTree = RootNode of TemplateTree list - | OpenFileLeaf of string - | OpenFileIfNotExistsLeaf of string - | EvalLeaf of TemplateTree list - | TextLeaf of string - | IfNode of string * TemplateTree list - (* FIXME: why a seperate ElseNode? should be part of IfNode *) - | ElseNode of TemplateTree list - | ForEachNode of string * TemplateTree list - - - -(** - * replaceSafely (s,v,x) replaces every v that occurs unescaped in s with x. - * if v occurs escaped with "\" in s, then the "\" is removed from s. - * FIXME: move to stringhandling? - *) -fun replaceSafely _ _ "" = "" - | replaceSafely v x s = - let val v_size = size v - val s_size = size s - in - if String.isPrefix (str #"\\"^v) s - then v^replaceSafely v x (String.extract (s, v_size + 1, NONE)) - else if String.isPrefix v s - then x^replaceSafely v x (String.extract (s, v_size, NONE)) - else str (String.sub (s,0))^replaceSafely v x (String.extract (s, 1, NONE)) - end - - -(** removes leading, trainling, and multiple consecutive whitespace chars. *) -(* FIXME: movev to StringHandling? *) -fun cleanLine s = String.concatWith " " (String.tokens Char.isSpace s) - - -(* debugging function - * prints ParseTree to stdOut - *) -fun printTplTree prefix (RootNode(l)) = (print (prefix^"root"^"\n"); List.app (printTplTree (prefix))l) - | printTplTree prefix (OpenFileLeaf(s))= print (prefix^"openfile:"^s^"\n") - | printTplTree prefix (OpenFileIfNotExistsLeaf(s))= print (prefix^"openfileifnotexists:"^s^"\n") - | printTplTree prefix (EvalLeaf(l)) = (print (prefix^"eval:\n"); List.app (printTplTree (prefix^"\t"))l) - | printTplTree prefix (TextLeaf(s)) = print (prefix^"text:"^s^"\n") - | printTplTree prefix (IfNode(s,l)) = (print (prefix^"if:"^s^"\n");List.app (printTplTree (prefix^"\t")) l) - | printTplTree prefix (ElseNode(l)) = (print (prefix^"else:"^"\n"); List.app (printTplTree (prefix^"\t")) l) - | printTplTree prefix (ForEachNode(s,l))=(print (prefix^"foreach:"^s^"\n");List.app (printTplTree (prefix^"\t")) l) - -val printTTree = printTplTree "" - -fun isComment s = (String.isPrefix "//" s) - -(** returns the prefix of l up to the first element where f evaluates to true *) -fun takeUntil f [] = [] - | takeUntil f (h::t) = if f h then [] else h::(takeUntil f t) - - -(** splits line into tokens considering handling escaped @ *) -fun tokenize line = let val l = joinEscapeSplitted "@" (fieldSplit #"@" line) - in - takeUntil isComment l - end - -(** - * extracts the type of line. - * line type must be first token in line! - * if no control tag in line -> "text" returned - *) -fun getType l = let val sl = tokenize l - in - if (length sl = 1) - then "text" (* rather: comment *) - else hd (tokenSplit #" " (String.concat sl)) - end - - -(** - * getContent line - * @return the content of a line - *) -fun getContent l = let val sl = tokenize l - in - if (length sl = 0) then "" - else if (length sl = 1) then hd sl - else String.concat (tl (fieldSplit #" " (String.concat (tl sl)))) - end - -(** 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)) - - -(** - * builds the TemplateTree. - * @return a TemplateTree list - *) -fun buildTree (SOME line) = - let fun getNode ("text", c) = TextLeaf c :: buildTree (readNextLine()) - | getNode ("foreach", c) = ForEachNode (c, buildTree (readNextLine())) - :: buildTree (readNextLine()) - | getNode ("if", c) = IfNode (c, buildTree (readNextLine())) - :: buildTree (readNextLine()) - | getNode ("else", _) = [ ElseNode (buildTree (readNextLine())) ] - | getNode ("elsif", c) = [ ElseNode [ IfNode (c, buildTree (readNextLine())) ]] - | getNode ("openfile", c) = OpenFileLeaf c :: buildTree (readNextLine()) - | getNode ("openfileifnotexists", c) = OpenFileIfNotExistsLeaf c - :: buildTree (readNextLine()) - | getNode ("eval", "") = EvalLeaf (buildTree (readNextLine())) - :: buildTree (readNextLine()) - | getNode ("eval", expr) = EvalLeaf [ TextLeaf expr ]:: buildTree (readNextLine()) - | getNode ("end",_) = [] - | getNode (t,c) = error ("in Tpl_Parser.buildTree: error while parsing \ - \node \""^t^"\" with content \""^c^"\".") - val prLine = preprocess line - in - getNode ((getType prLine),(getContent prLine)) - end - | buildTree NONE = [] - - -fun codegen_home _ = getOpt (OS.Process.getEnv "CODEGEN_HOME", su4sml_home()^"src/codegen") - -(** calls the external cpp ( C PreProcessor). - * writes merged template to a file with extension .tmp instead of .tpl - * and returns this file - *) -fun call_cpp file = - let val targetFile = OS.FileSys.tmpName () - val _ = OS.Process.system ("cpp -P -C "^codegen_home()^"/"^file^" "^targetFile) - in - targetFile - end - - - -(** parse template-file - * @return the parsed template tree - *) -fun parse file = let val _ = info ("parsing template "^file) - val mergedTpl = call_cpp file; - val _ = opentFile mergedTpl; - val pt = RootNode(buildTree (readNextLine())); - val _ = cleanUp mergedTpl; - in - pt - end -end +(***************************************************************************** + * su4sml GCG - Generic Code Generator + * + * tpl_parser.sml - template parser of a su4sml-gcg template + * Copyright (C) 2005 Raphael Eidenbenz + * + * This file is part of su4sml-gcg. + * + * 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. + ******************************************************************************) + +(** A parser for template files. *) +signature TPL_PARSER = +sig + + datatype TemplateTree + = ElseNode of TemplateTree list + | EvalLeaf of TemplateTree list + | ForEachNode of string * TemplateTree list + | IfNode of string * TemplateTree list + | OpenFileLeaf of string + | OpenFileIfNotExistsLeaf of string + | RootNode of TemplateTree list + | TextLeaf of string + + val printTTree : TemplateTree -> unit + val parse : string -> TemplateTree + +end + + +structure Tpl_Parser : TPL_PARSER = +struct +open library +open Gcg_Helper + +val tplStream = ref (TextIO.openString "@// dummy template\n"); + +fun opentFile file = (TextIO.closeIn (!tplStream) ; + tplStream := (TextIO.openIn file)) + handle ex => error ("in Tpl_Parser.opentFile: \ + \couldn't open preprocessed template file: "^ + General.exnMessage ex) + +fun cleanUp tplFile = (TextIO.closeIn (!tplStream); + OS.FileSys.remove tplFile) + +fun readNextLine () = TextIO.inputLine (!tplStream) + + +(* FIXME: this currently uses a simple line-based template-file structure *) +(* (every line corresponds to exactly one node in this tree) *) +(* This should really be relaxed... *) +(* FIXME: add separate VariableLeaf *) +(* FIXME: merge If and Else Nodes *) +datatype TemplateTree = RootNode of TemplateTree list + | OpenFileLeaf of string + | OpenFileIfNotExistsLeaf of string + | EvalLeaf of TemplateTree list + | TextLeaf of string + | IfNode of string * TemplateTree list + (* FIXME: why a seperate ElseNode? should be part of IfNode *) + | ElseNode of TemplateTree list + | ForEachNode of string * TemplateTree list + + + +(** + * replaceSafely (s,v,x) replaces every v that occurs unescaped in s with x. + * if v occurs escaped with "\" in s, then the "\" is removed from s. + * FIXME: move to stringhandling? + *) +fun replaceSafely _ _ "" = "" + | replaceSafely v x s = + let val v_size = size v + val s_size = size s + in + if String.isPrefix (str #"\\"^v) s + then v^replaceSafely v x (String.extract (s, v_size + 1, NONE)) + else if String.isPrefix v s + then x^replaceSafely v x (String.extract (s, v_size, NONE)) + else str (String.sub (s,0))^replaceSafely v x (String.extract (s, 1, NONE)) + end + + +(** removes leading, trainling, and multiple consecutive whitespace chars. *) +(* FIXME: movev to StringHandling? *) +fun cleanLine s = String.concatWith " " (String.tokens Char.isSpace s) + + +(* debugging function + * prints ParseTree to stdOut + *) +fun printTplTree prefix (RootNode(l)) = (print (prefix^"root"^"\n"); List.app (printTplTree (prefix))l) + | printTplTree prefix (OpenFileLeaf(s))= print (prefix^"openfile:"^s^"\n") + | printTplTree prefix (OpenFileIfNotExistsLeaf(s))= print (prefix^"openfileifnotexists:"^s^"\n") + | printTplTree prefix (EvalLeaf(l)) = (print (prefix^"eval:\n"); List.app (printTplTree (prefix^"\t"))l) + | printTplTree prefix (TextLeaf(s)) = print (prefix^"text:"^s^"\n") + | printTplTree prefix (IfNode(s,l)) = (print (prefix^"if:"^s^"\n");List.app (printTplTree (prefix^"\t")) l) + | printTplTree prefix (ElseNode(l)) = (print (prefix^"else:"^"\n"); List.app (printTplTree (prefix^"\t")) l) + | printTplTree prefix (ForEachNode(s,l))=(print (prefix^"foreach:"^s^"\n");List.app (printTplTree (prefix^"\t")) l) + +val printTTree = printTplTree "" + +fun isComment s = (String.isPrefix "//" s) + +(** returns the prefix of l up to the first element where f evaluates to true *) +fun takeUntil f [] = [] + | takeUntil f (h::t) = if f h then [] else h::(takeUntil f t) + + +(** splits line into tokens considering handling escaped @ *) +fun tokenize line = let val l = joinEscapeSplitted "@" (fieldSplit #"@" line) + in + takeUntil isComment l + end + +(** + * extracts the type of line. + * line type must be first token in line! + * if no control tag in line -> "text" returned + *) +fun getType l = let val sl = tokenize l + in + if (length sl = 1) + then "text" (* rather: comment *) + else hd (tokenSplit #" " (String.concat sl)) + end + + +(** + * getContent line + * @return the content of a line + *) +fun getContent l = let val sl = tokenize l + in + if (length sl = 0) then "" + else if (length sl = 1) then hd sl + else String.concat (tl (fieldSplit #" " (String.concat (tl sl)))) + end + +(** 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)) + + +(** + * builds the TemplateTree. + * @return a TemplateTree list + *) +fun buildTree (SOME line) = + let fun getNode ("text", c) = TextLeaf c :: buildTree (readNextLine()) + | getNode ("foreach", c) = ForEachNode (c, buildTree (readNextLine())) + :: buildTree (readNextLine()) + | getNode ("if", c) = IfNode (c, buildTree (readNextLine())) + :: buildTree (readNextLine()) + | getNode ("else", _) = [ ElseNode (buildTree (readNextLine())) ] + | getNode ("elsif", c) = [ ElseNode [ IfNode (c, buildTree (readNextLine())) ]] + | getNode ("openfile", c) = OpenFileLeaf c :: buildTree (readNextLine()) + | getNode ("openfileifnotexists", c) = OpenFileIfNotExistsLeaf c + :: buildTree (readNextLine()) + | getNode ("eval", "") = EvalLeaf (buildTree (readNextLine())) + :: buildTree (readNextLine()) + | getNode ("eval", expr) = EvalLeaf [ TextLeaf expr ]:: buildTree (readNextLine()) + | getNode ("end",_) = [] + | getNode (t,c) = error ("in Tpl_Parser.buildTree: error while parsing \ + \node \""^t^"\" with content \""^c^"\".") + val prLine = preprocess line + in + getNode ((getType prLine),(getContent prLine)) + end + | buildTree NONE = [] + + +fun codegen_home _ = getOpt (OS.Process.getEnv "CODEGEN_HOME", su4sml_home()^"src/codegen") + +(** calls the external cpp ( C PreProcessor). + * writes merged template to a file with extension .tmp instead of .tpl + * and returns this file + *) +fun call_cpp file = + let val targetFile = OS.FileSys.tmpName () + val _ = OS.Process.system ("cpp -P -C "^codegen_home()^"/"^file^" "^targetFile) + in + targetFile + end + + + +(** parse template-file + * @return the parsed template tree + *) +fun parse file = let val _ = info ("parsing template "^file) + val mergedTpl = call_cpp file; + val _ = opentFile mergedTpl; + val pt = RootNode(buildTree (readNextLine())); + val _ = cleanUp mergedTpl; + in + pt + end +end diff --git a/src/library.sml b/src/library.sml index 4d3e231..9e9f9d7 100644 --- a/src/library.sml +++ b/src/library.sml @@ -117,4 +117,8 @@ fun fst (x, y) = x fun snd (x, y) = y +fun join s nil = "" + | join s (h::nil) = h + | join s (h::t) = h^s^(join s t) + end diff --git a/src/ocl2dresdenjava.sml b/src/ocl2dresdenjava.sml new file mode 100644 index 0000000..731ef5a --- /dev/null +++ b/src/ocl2dresdenjava.sml @@ -0,0 +1,238 @@ +(** + * Conversion of OCL expressions to Java code which makes use of the + * Dresden standard ocl library. + *) + +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 = + let + fun count res = Int.toString(snd res) + fun code res = fst res + fun newNode ntype ncode = "final "^ntype^" oclNode"^(varcounter.nextStr())^" = "^ncode^";\n" + fun newFact () = ("final UmlOclFactory oclFact"^(varcounter.nextStr())^" = UmlOclFactory.getInstance();\n", + varcounter.current()) + fun node nid = "oclNode"^(count nid) + fun fact fid = "oclFact"^(count fid) + fun ifStmt cond thenb elseb rest = + let + val condition = ocl2java' cond on + val thenbranch = ocl2java' thenb on + val elsebranch = ocl2java' elseb on + in + ((code condition)^ + (code thenbranch)^ + (code elsebranch)^ + (newNode ("Ocl"^(string_of_OclType rest)) ("Ocl.toOcl"^(string_of_OclType rest)^"("^(node condition)^".ifThenElse("^(node thenbranch)^", "^(node elsebranch)^"))")), + varcounter.current()) + end + 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 + + fun var name t = + let + val factory = newFact () + val vname = if name = "self" then on else name + 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 + end + fun string_of_binop src bop arg rtype = + let + val left = ocl2java' src on + val right = ocl2java' arg on + in + ((code left)^ + (code right)^ + (newNode ("Ocl"^(string_of_OclType rtype)) ((node left)^"."^bop^"("^(node right)^")")), + varcounter.current()) + end + fun string_of_unop src sop rtype = + let + val right = ocl2java' src on + in + ((code right)^ + (newNode ("Ocl"^(string_of_OclType rtype)) ((node right)^"."^sop^"()")), + varcounter.current()) + end + fun emptySet () = (newNode "OclSet" "OclSet.getEmptyOclSet()", + varcounter.current()) + fun oclset src = + let + val src' = ocl2java' src on + val set = emptySet () + in + ((code src')^ + (code set)^ + (node set)^".setToInclude("^(node src')^");\n", + varcounter.current()) + end + fun oclnotempty src = + let + val src' = ocl2java' src on + in + ((code src')^ + (newNode "OclBoolean" ((node src')^".notEmpty()")), + varcounter.current()) + end + fun oclempty src = + let + val src' = ocl2java' src on + in + ((code src')^ + (newNode "OclBoolean" ((node src')^".isEmpty()")), + varcounter.current()) + end + fun oclsize src = + let + val src' = ocl2java' src on + in + ((code src')^ + (newNode "OclInteger" ((node src')^".size()")), + 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) + end + +fun ocl2java oclterm on = fst (ocl2java' oclterm on) + +(* 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 + + +(* Check the result of checking a condition *) +fun checkConditionResult condition name condType 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" + 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))^")") + in + join "\n" (List.map getPrecond (Rep_Core.precondition_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))^")") + 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) + in + join "\n" (List.map getInvariant (Rep_Core.invariant_of curCl)) + end + +end diff --git a/src/rep_core.sml b/src/rep_core.sml index d83cc20..71e9cd6 100644 --- a/src/rep_core.sml +++ b/src/rep_core.sml @@ -111,8 +111,10 @@ val package_of : Classifier -> Rep_OclType.Path val short_name_of : Classifier -> string val parent_name_of : Classifier -> Rep_OclType.Path +val parent_interface_names_of : Classifier -> Rep_OclType.Path list val parent_package_of : Classifier -> Rep_OclType.Path val short_parent_name_of : Classifier -> string +val parent_interfaces_of : Classifier -> Rep_OclType.OclType list val thy_name_of : Classifier -> string val update_thyname : string -> Classifier -> Classifier @@ -494,6 +496,7 @@ fun parent_name_of (C as Class{parent,...}) = | parent_name_of (Template _) = error "in Rep.parent_name_of: \ \unsupported argument type Template" + fun short_parent_name_of C = case (parent_name_of C) of [] => error "in Rep.short_parent_name_of: empty type" | p => (hd o rev) p @@ -528,6 +531,16 @@ fun parent_package_of (Class{parent,...}) = error "in Rep.parent_package_of: unsupported argument type Template" +(* Get parent interfaces of a Classifier. *) +fun parent_interfaces_of (Interface{parents,...}) = parents + | parent_interfaces_of (Class{interfaces,...}) = interfaces + | parent_interfaces_of (Enumeration{interfaces,...}) = interfaces + | parent_interfaces_of (Primitive{interfaces,...}) = interfaces + | parent_interfaces_of (Template{...}) = error "parent_interfaces_of