From 4ba2516d92b873be02e6f425fc15fc5c1f915162 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=BCrgen=20Doser?= Date: Tue, 21 Mar 2006 13:14:15 +0000 Subject: [PATCH] codegen-sourcen von Raphael git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@4212 3260e6d1-4efc-4170-b0a7-36055960796d --- src/codegen/LIB.ML | 103 ++++++++++ src/codegen/ROOT.ML | 61 ++++++ src/codegen/base_cartridge.sig | 37 ++++ src/codegen/base_cartridge.sml | 195 +++++++++++++++++++ src/codegen/c#_cartridge.sml | 103 ++++++++++ src/codegen/c#_net1_cartridge.sml | 102 ++++++++++ src/codegen/cartridge.sig | 33 ++++ src/codegen/codegen.cm | 24 +++ src/codegen/codegen.mlb | 28 +++ src/codegen/codegen.sml | 65 +++++++ src/codegen/compiler/compiler_ext.sig | 28 +++ src/codegen/compiler/mlton.sml | 28 +++ src/codegen/compiler/polyml.sml | 57 ++++++ src/codegen/compiler/smlnj.sml | 51 +++++ src/codegen/examples/ebank.sml | 131 +++++++++++++ src/codegen/examples/simple.sml | 196 +++++++++++++++++++ src/codegen/gcg_core.sig | 37 ++++ src/codegen/gcg_core.sml | 142 ++++++++++++++ src/codegen/gcg_helper.sml | 171 +++++++++++++++++ src/codegen/gcg_library.sml | 45 +++++ src/codegen/java_cartridge.sml | 54 ++++++ src/codegen/secureuml_cartridge.sig | 42 +++++ src/codegen/secureuml_cartridge.sml | 250 +++++++++++++++++++++++++ src/codegen/templates/C#.tpl | 68 +++++++ src/codegen/templates/C#_SecureUML.tpl | 166 ++++++++++++++++ src/codegen/templates/base.tpl | 28 +++ src/codegen/templates/java.tpl | 25 +++ src/codegen/tpl_parser.sig | 39 ++++ src/codegen/tpl_parser.sml | 204 ++++++++++++++++++++ 29 files changed, 2513 insertions(+) create mode 100644 src/codegen/LIB.ML create mode 100644 src/codegen/ROOT.ML create mode 100644 src/codegen/base_cartridge.sig create mode 100644 src/codegen/base_cartridge.sml create mode 100644 src/codegen/c#_cartridge.sml create mode 100644 src/codegen/c#_net1_cartridge.sml create mode 100644 src/codegen/cartridge.sig create mode 100644 src/codegen/codegen.cm create mode 100644 src/codegen/codegen.mlb create mode 100644 src/codegen/codegen.sml create mode 100644 src/codegen/compiler/compiler_ext.sig create mode 100644 src/codegen/compiler/mlton.sml create mode 100644 src/codegen/compiler/polyml.sml create mode 100644 src/codegen/compiler/smlnj.sml create mode 100644 src/codegen/examples/ebank.sml create mode 100644 src/codegen/examples/simple.sml create mode 100644 src/codegen/gcg_core.sig create mode 100644 src/codegen/gcg_core.sml create mode 100644 src/codegen/gcg_helper.sml create mode 100644 src/codegen/gcg_library.sml create mode 100644 src/codegen/java_cartridge.sml create mode 100644 src/codegen/secureuml_cartridge.sig create mode 100644 src/codegen/secureuml_cartridge.sml create mode 100644 src/codegen/templates/C#.tpl create mode 100644 src/codegen/templates/C#_SecureUML.tpl create mode 100644 src/codegen/templates/base.tpl create mode 100644 src/codegen/templates/java.tpl create mode 100644 src/codegen/tpl_parser.sig create mode 100644 src/codegen/tpl_parser.sml diff --git a/src/codegen/LIB.ML b/src/codegen/LIB.ML new file mode 100644 index 0000000..1a64151 --- /dev/null +++ b/src/codegen/LIB.ML @@ -0,0 +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"; diff --git a/src/codegen/ROOT.ML b/src/codegen/ROOT.ML new file mode 100644 index 0000000..70a9d61 --- /dev/null +++ b/src/codegen/ROOT.ML @@ -0,0 +1,61 @@ +(***************************************************************************** + * 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. + ******************************************************************************) + +(* +OS.FileSys.chDir "../../../src"; +*) + +OS.FileSys.chDir "../lib/su4sml/src"; +use "ROOT.ML"; +OS.FileSys.chDir "../../../src"; + +OS.FileSys.chDir "compiler"; + +use "compiler_ext.sig"; +use "smlnj.sml"; (* or "polyml.sml" or "mlton.sml" *) + +OS.FileSys.chDir ".."; + +use "gcg_library.sml"; +use "gcg_helper.sml"; +(*use "examples/simple.sml"; *) +(*use "examples/ebank.sml";*) + +use "tpl_parser.sig"; +use "tpl_parser.sml"; + +use "cartridge.sig"; +use "base_cartridge.sig"; +use "base_cartridge.sml"; +use "c#_cartridge.sml"; +use "c#_net1_cartridge.sml"; +use "secureuml_cartridge.sig"; +use "secureuml_cartridge.sml"; +(* +use "java_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 new file mode 100644 index 0000000..016a98c --- /dev/null +++ b/src/codegen/base_cartridge.sig @@ -0,0 +1,37 @@ +(***************************************************************************** + * 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. + ******************************************************************************) + +signature BASE_CARTRIDGE = +sig + + include CARTRIDGE + +(* specific for BASE_CARTRIDGE *) + val model : environment -> Rep_SecureUML_ComponentUML.Model + val curClassifier: environment -> Rep.Classifier + val curAttribute: environment -> Rep.attribute + val curOperation: environment -> Rep.operation + val curArgument : environment -> string * Rep_OclType.OclType + +end diff --git a/src/codegen/base_cartridge.sml b/src/codegen/base_cartridge.sml new file mode 100644 index 0000000..774c42e --- /dev/null +++ b/src/codegen/base_cartridge.sml @@ -0,0 +1,195 @@ +(***************************************************************************** + * 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. + ******************************************************************************) + +structure Base_Cartridge : BASE_CARTRIDGE = +struct + (* translation functions *) + open Rep_OclType + open Rep + open Tpl_Parser + open Rep_SecureUML_ComponentUML.Security + open ComponentUML + open Gcg_Helper + (* type translation table *) + + fun oclType2Native t = Rep_OclType.string_of_OclType t + + fun visibility2Native public = "public" + | visibility2Native private = "private" + | visibility2Native protected = "protected" + | visibility2Native package = "package" + + fun scope2Native ClassifierScope = "ClassifierScope" + | scope2Native InstanceScope = "InstanceScope" + + + type environment = {model : Rep_SecureUML_ComponentUML.Model, + curClassifier: Classifier, + curOperation : operation, + curAttribute : attribute, + curArgument : string * OclType + } + +(* service functions for other cartridges to have access to the current + * list items + *) +fun model (env : environment) = #model env +fun curClassifier (env : environment) = #curClassifier env +fun curAttribute (env : environment) = #curAttribute env +fun curOperation (env : environment) = #curOperation env +fun curArgument (env : environment) = #curArgument env + + +fun initEnv model = { model = model, + curClassifier = emptyClassifier, + curOperation = emptyOperation, + curAttribute = emptyAttribute, + curArgument = emptyArgument + } : environment + + + +fun lookup (env : environment) "classifier_name" = short_name_of (#curClassifier env) + | lookup (env : environment) "classifier_package" = if ((#curClassifier env) = emptyClassifier) then (* not in foreach-loop yet *) + Rep_OclType.string_of_path (package_of (hd (#1 (#model env)))) + else + Rep_OclType.string_of_path (package_of (#curClassifier env)) + + | lookup (env : environment) "classifier_parent" = short_parent_name_of (#curClassifier env) + | lookup (env : environment) "attribute_name" = #name (#curAttribute env) + | lookup (env : environment) "attribute_type" = oclType2Native (#attr_type (#curAttribute env)) + | lookup (env : environment) "attribute_visibility"= visibility2Native(#visibility (#curAttribute env)) + | lookup (env : environment) "attribute_scope" = scope2Native (#scope (#curAttribute env)) + | lookup (env : environment) "operation_name" = name_of_op (#curOperation env) + | lookup (env : environment) "operation_result_type"= oclType2Native (result_of_op (#curOperation env)) + | lookup (env : environment) "operation_visibility"= visibility2Native (#visibility (#curOperation env)) + | lookup (env : environment) "operation_scope" = scope2Native (#scope (#curOperation env)) + | lookup (env : environment) "argument_name" = #1 (#curArgument env) + | lookup (env : environment) "argument_type" = oclType2Native (#2 (#curArgument env)) + | lookup _ s = (gcg_warning ("Couldn't lookup \""^s^"\" in base_cartridge.lookup !"); s) + + + +fun evalCondition (env : environment) "isClass" + = (case (#curClassifier env) of (Class{...}) => true + | _ => false) + | evalCondition (env : environment) "isInterface" + = (case (#curClassifier env) of (Interface{...}) => true + | _ => false) + | evalCondition (env : environment) "isEnumeration" + = (case (#curClassifier env) of (Enumeration{...}) => true + | _ => false) + | evalCondition (env : environment) "isPrimitive" + = (case (#curClassifier env) of (Primitive{...}) => true + | _ => false) + | evalCondition (env : environment) "hasParent" + = let val parentName = + Rep_OclType.string_of_path (parent_name_of (#curClassifier env)) + in + (parentName <> "OclAny") + end + | evalCondition (env : environment) "first_classifier" = (#curClassifier env = hd (#1 (#model env))) + | evalCondition (env : environment) "first_attribute" = (#curAttribute env = hd (attributes_of (#curClassifier env))) + | evalCondition (env : environment) "first_operation" = (#curOperation env = hd (operations_of (#curClassifier env))) + | evalCondition (env : environment) "first_argument" = (#curArgument env = hd (arguments_of_op (#curOperation env))) + | evalCondition (env : environment) "last_classifier" = (#curClassifier env = List.last (#1 (#model env))) + | evalCondition (env : environment) "last_attribute" = (#curAttribute env = List.last (attributes_of (#curClassifier env))) + | evalCondition (env : environment) "last_operation" = (#curOperation env = List.last (operations_of (#curClassifier env))) + | evalCondition (env : environment) "last_argument" = (#curArgument env = List.last (arguments_of_op (#curOperation env))) + | evalCondition (env : environment) "attribute_isPublic" = ((#visibility (#curAttribute env)) = public) + | evalCondition (env : environment) "attribute_isPrivate" = ((#visibility (#curAttribute env)) = private) + | evalCondition (env : environment) "attribute_isProtected"=((#visibility (#curAttribute env)) = protected) + | evalCondition (env : environment) "attribute_isPackage" = ((#visibility (#curAttribute env)) = package) + | evalCondition (env : environment) "attribute_isStatic" = ((#scope (#curAttribute env)) = ClassifierScope) + | evalCondition (env : environment) "operation_isPublic" = ((#visibility (#curOperation env)) = public) + | evalCondition (env : environment) "operation_isPrivate" = ((#visibility (#curOperation env)) = private) + | evalCondition (env : environment) "operation_isProtected"=((#visibility (#curOperation env)) = protected) + | evalCondition (env : environment) "operation_isPackage" = ((#visibility (#curOperation env)) = package) + | evalCondition (env : environment) "operation_isStatic" = ((#scope (#curOperation env)) = ClassifierScope) + | evalCondition (env : environment) s + = gcg_error ("Couldn't evaluate if-condition: "^s^" in base_cartridge.evalCondition") + + +(* fun foreach_classifier: environment -> environment list *) +fun foreach_classifier (env : environment) + = let val cl = #1 (#model env); + fun env_from_classifier c = + { model = (#model env), + curClassifier = c, + curOperation = emptyOperation, + curAttribute = emptyAttribute, + curArgument = emptyArgument + } + in + List.map env_from_classifier cl + end + +fun foreach_attribute (env : environment) + = let val attrs = attributes_of (#curClassifier env); + fun env_from_attr a = + { model = #model env, + curClassifier = (#curClassifier env), + curOperation = emptyOperation, + curAttribute = a, + curArgument = emptyArgument + } + in + List.map env_from_attr attrs + end + +fun foreach_operation (env : environment) + = let val ops = operations_of (#curClassifier env); + fun env_from_op operation = + { model = #model env, + curClassifier = (#curClassifier env), + curOperation = operation, + curAttribute = emptyAttribute, + curArgument = emptyArgument + } + in + List.map env_from_op ops + end +fun foreach_argument (env : environment) + = let val args = arguments_of_op (#curOperation env); + fun env_from_argument arg = + { model = #model env, + curClassifier = (#curClassifier env), + curOperation = (#curOperation env), + curAttribute = emptyAttribute, + curArgument = arg + } + in + List.map env_from_argument args + end + +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 + (* hier muss man das Environment noch etwas umpacken + | foreach listType env = map (pack env) (.foreach name (unpack env)) + *) + | foreach s _ = gcg_error ("Couldn't write foreach "^s^" ." ^ + "\""^s^"\" not defined in base_cartridge.foreach ") + +end diff --git a/src/codegen/c#_cartridge.sml b/src/codegen/c#_cartridge.sml new file mode 100644 index 0000000..9783b36 --- /dev/null +++ b/src/codegen/c#_cartridge.sml @@ -0,0 +1,103 @@ +(***************************************************************************** + * 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 : CARTRIDGE) : CARTRIDGE = + struct + open Rep_OclType + + +type environment = { extension : SuperCart.environment } + + + +fun initEnv model = { extension = SuperCart.initEnv model } : environment + +fun unpack (env : environment) = #extension env + +fun pack superEnv = {extension = superEnv} : environment + + + (* 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 + +fun startWithSmallLetter s = let val sl = explode s + in + implode ((Char.toLower (hd sl))::(tl sl)) + end + +fun startWithCapital s = let val sl = explode s + in + 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 evalCondition (env : environment) s = SuperCart.evalCondition (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 \ No newline at end of file diff --git a/src/codegen/c#_net1_cartridge.sml b/src/codegen/c#_net1_cartridge.sml new file mode 100644 index 0000000..af8e533 --- /dev/null +++ b/src/codegen/c#_net1_cartridge.sml @@ -0,0 +1,102 @@ +(***************************************************************************** + * 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 } + + + +fun initEnv model = { extension = SuperCart.initEnv model } : environment + +fun unpack (env : environment) = #extension env + +fun pack superEnv = {extension = superEnv} : environment + + + (* 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 = explode s + in + implode ((Char.toLower (hd sl))::(tl sl)) + end + +fun startWithCapital s = let val sl = explode s + in + 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 evalCondition (env : environment) s = SuperCart.evalCondition (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 \ No newline at end of file diff --git a/src/codegen/cartridge.sig b/src/codegen/cartridge.sig new file mode 100644 index 0000000..72cf248 --- /dev/null +++ b/src/codegen/cartridge.sig @@ -0,0 +1,33 @@ +(***************************************************************************** + * 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. + ******************************************************************************) + +signature CARTRIDGE = +sig + (* translation functions *) + type environment + val initEnv : Rep_SecureUML_ComponentUML.Model -> environment + + val lookup : environment -> string -> string + val evalCondition : environment -> string -> bool + val foreach : string -> environment -> environment list +end \ No newline at end of file diff --git a/src/codegen/codegen.cm b/src/codegen/codegen.cm new file mode 100644 index 0000000..67bde10 --- /dev/null +++ b/src/codegen/codegen.cm @@ -0,0 +1,24 @@ +Group is +#if(defined(SMLNJ_VERSION)) + $/basis.cm + $smlnj/compiler/compiler.cm + $/smlnj-lib.cm +#else +#endif + ../lib/su4sml/src/su4sml.cm + compiler/compiler_ext.sig + compiler/mlton.sml + gcg_library.sml + gcg_helper.sml + tpl_parser.sig + tpl_parser.sml + cartridge.sig + base_cartridge.sig + base_cartridge.sml + c#_cartridge.sml + c#_net1_cartridge.sml + secureuml_cartridge.sig + secureuml_cartridge.sml + gcg_core.sig + gcg_core.sml + codegen.sml diff --git a/src/codegen/codegen.mlb b/src/codegen/codegen.mlb new file mode 100644 index 0000000..8003db2 --- /dev/null +++ b/src/codegen/codegen.mlb @@ -0,0 +1,28 @@ +ann + "warnMatch false" + "allowFFI true" + "sequenceUnit false" + "allowExport true" +in + local + $(MLTON_ROOT)/basis/basis.mlb + ../lib/su4sml/src/su4sml-cygwin.mlb + in + compiler/compiler_ext.sig + compiler/mlton.sml + gcg_library.sml + gcg_helper.sml + tpl_parser.sig + tpl_parser.sml + cartridge.sig + base_cartridge.sig + base_cartridge.sml + "c#_cartridge.sml" + "c#_net1_cartridge.sml" + secureuml_cartridge.sig + secureuml_cartridge.sml + gcg_core.sig + gcg_core.sml + codegen.sml + end +end diff --git a/src/codegen/codegen.sml b/src/codegen/codegen.sml new file mode 100644 index 0000000..2ac18fd --- /dev/null +++ b/src/codegen/codegen.sml @@ -0,0 +1,65 @@ +(***************************************************************************** + * 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(SecureUML_Cartridge(Base_Cartridge))); +structure CSharp_NET1_Gcg = GCG_Core (CSharp_NET1_Cartridge(Base_Cartridge)); +structure CSharpSecure_NET1_Gcg = GCG_Core (CSharp_NET1_Cartridge(SecureUML_Cartridge(Base_Cartridge))); +(* +structure Java_Gcg = GCG_Core (Java_Cartridge(Base_Cartridge)); +structure JavaSecure_Gcg = GCG_Core (Java_Cartridge(SecureUML_Cartridge(Base_Cartridge))); +*) + +fun generate xmi_file "base" = + Base_Gcg.generate ( Rep_SecureUML_ComponentUML.readXMI xmi_file) "templates/base.tpl" + | generate xmi_file "c#" = + CSharp_Gcg.generate ( Rep_SecureUML_ComponentUML.readXMI xmi_file) "templates/C#.tpl" + | generate xmi_file "c#_secure" = + CSharpSecure_Gcg.generate ( Rep_SecureUML_ComponentUML.readXMI xmi_file) "templates/C#_SecureUML.tpl" + | generate xmi_file "c#_net1" = + CSharp_NET1_Gcg.generate ( Rep_SecureUML_ComponentUML.readXMI xmi_file) "templates/C#.tpl" + | generate xmi_file "c#_secure_net1" = + CSharpSecure_NET1_Gcg.generate ( Rep_SecureUML_ComponentUML.readXMI xmi_file) "templates/C#_SecureUML.tpl" + (* + | generate "java" = Java_Gcg.generate model "templates/java.tpl" + | generate "java_secure" = JavaSecure_Gcg.generate model "templates/java_SecureUML.tpl" + *) + | generate _ s = print ("target language unknown : "^s^"\n"^ + "usage: generate \"base\" | \"c#\" | \"c#_secure\" | \"c#_net1\" | \"c#_secure_net1\"\n") + + +fun main (_,[xmi_file,lang]) = generate xmi_file lang + | main _ = print ("usage: codegen \n"^ + "\tlanguage = \"base\" | \"c#\" | \"c#_secure\" | \"c#_net1\" | \"c#_secure_net1\"\n") + +end + + +val _ = Codegen.main(CommandLine.name(),CommandLine.arguments()) diff --git a/src/codegen/compiler/compiler_ext.sig b/src/codegen/compiler/compiler_ext.sig new file mode 100644 index 0000000..4c1a349 --- /dev/null +++ b/src/codegen/compiler/compiler_ext.sig @@ -0,0 +1,28 @@ +(***************************************************************************** + * su4sml - a SecureUML repository for SML + * + * compiler_ext.sig - interactive eval stub + * Copyright (C) 2005 Achim D. Brucker + * + * 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 COMPILER_EXT = +sig + exception EvalNotSupported + val eval : bool -> string -> unit +end diff --git a/src/codegen/compiler/mlton.sml b/src/codegen/compiler/mlton.sml new file mode 100644 index 0000000..b012f0f --- /dev/null +++ b/src/codegen/compiler/mlton.sml @@ -0,0 +1,28 @@ +(***************************************************************************** + * su4sml - a SecureUML repository for SML + * + * mlton.sml - interactive eval stub (not supported by MLton) + * Copyright (C) 2005 Achim D. Brucker + * + * 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. + ******************************************************************************) + +structure CompilerExt : COMPILER_EXT = +struct +exception EvalNotSupported +fun eval verbose txt = raise EvalNotSupported +end diff --git a/src/codegen/compiler/polyml.sml b/src/codegen/compiler/polyml.sml new file mode 100644 index 0000000..4e21806 --- /dev/null +++ b/src/codegen/compiler/polyml.sml @@ -0,0 +1,57 @@ +(***************************************************************************** + * su4sml - a SecureUML repository for SML + * + * polyml.sml - interactive eval + * Copyright (C) 2005 Achim D. Brucker + * + * 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. + ******************************************************************************) + +structure CompilerExt : COMPILER_EXT = +struct + +exception EvalNotSupported +fun drop_last [] = [] + | drop_last [x] = [] + | drop_last (x :: xs) = x :: drop_last xs; + +fun eval verbose txt = + let + fun eval_fh (print, err) verbose txt = + let + val in_buffer = ref (SML90.explode txt); + val out_buffer = ref ([]: string list); + fun output () = SML90.implode (drop_last (rev (! out_buffer))); + + fun get () = + (case ! in_buffer of + [] => "" + | c :: cs => (in_buffer := cs; c)); + fun put s = out_buffer := s :: ! out_buffer; + + fun exec () = + (case ! in_buffer of + [] => () + | _ => (PolyML.compiler (get, put) (); exec ())); + in + exec () handle exn => (err (output ()); raise exn); + if verbose then print (output ()) else () + end + in + eval_fh (fn s => print (s^"\n"), fn s => library.error (s^"\n")) verbose txt + end +end diff --git a/src/codegen/compiler/smlnj.sml b/src/codegen/compiler/smlnj.sml new file mode 100644 index 0000000..58b63d9 --- /dev/null +++ b/src/codegen/compiler/smlnj.sml @@ -0,0 +1,51 @@ +(***************************************************************************** + * su4sml - a SecureUML repository for SML + * + * smlnj.sml - interactive eval stub (not supported by MLton) + * Copyright (C) 2005 Achim D. Brucker + * + * 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. + ******************************************************************************) + +structure CompilerExt : COMPILER_EXT = +struct +exception EvalNotSupported + +fun eval verbose txt = + let + fun eval_fh (print, err) verbose txt = + let + val ref out_orig = Control.Print.out; + + val out_buffer = ref ([]: string list); + val out = {say = (fn s => out_buffer := s :: ! out_buffer), + flush = (fn () => ())}; + fun output () = + let val str = SML90.implode (rev (! out_buffer)) + in String.substring (str, 0, Int.max (0, size str - 1)) end; + in + Control.Print.out := out; + Backend.Interact.useStream (TextIO.openString txt) + handle exn => + (Control.Print.out := out_orig; err (output ()); raise exn); + Control.Print.out := out_orig; + if verbose then print (output ()) else () + end + in + eval_fh (fn s => print (s^"\n"), fn s => library.error (s^"\n")) verbose txt + end +end diff --git a/src/codegen/examples/ebank.sml b/src/codegen/examples/ebank.sml new file mode 100644 index 0000000..89e50bb --- /dev/null +++ b/src/codegen/examples/ebank.sml @@ -0,0 +1,131 @@ +(***************************************************************************** + * su4sml - a SecureUML repository for SML + * + * ebank.sml - a simple test file for the core repository + * Copyright (C) 2003-2005 Achim D. Brucker + * + * 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. + ******************************************************************************) + +open Rep_Core; +open Rep_OclTerm; + + val ebank = [Class + {activity_graphs=[],associationends=[], + attributes=[("source",Set (Classifier ["eBank","Account"])), + ("destination",Set (Classifier ["eBank","Account"])), + ("amount",Integer),("date",Classifier ["eBank","Date"])], + interfaces=[], + invariant=[], + name=["eBank","Transaction"], + operations=[{arguments=[],isQuery=false,name="makeTransfer", + postcondition=[],precondition=[],result=Boolean}], + parent=NONE,stereotypes=[],thyname=NONE}, + Class + {activity_graphs=[],associationends=[], + attributes=[("t1",Set (Classifier ["eBank","Transaction"])), + ("t2",Set (Classifier ["eBank","Transaction"])), + ("owner",Set (Classifier ["eBank","Customer"]))], + interfaces=[], + invariant=[], + name=["eBank","Account"], + operations=[{arguments=[("amount",Integer)],isQuery=false, + name="makeDeposit",postcondition=[],precondition=[], + result=Boolean}, + {arguments=[("amount",Integer)],isQuery=false, + name="makeWithdrawal",postcondition=[],precondition=[], + result=Boolean}, + {arguments=[],isQuery=false,name="getBalance", + postcondition=[],precondition=[],result=Integer}, + {arguments=[],isQuery=false,name="getCurrency", + postcondition=[],precondition=[],result=String}], + parent=NONE,stereotypes=[],thyname=NONE}, + Class + {activity_graphs=[],associationends=[], + attributes=[("accounts",Set (Classifier ["eBank","Account"])), + ("name",String),("address",String),("gender",Boolean), + ("title",String)],interfaces=[], + invariant=[],name=["eBank","Customer"],operations=[], + parent=NONE,stereotypes=[],thyname=NONE}, + Class + {activity_graphs=[],associationends=[], + attributes=[("checks",Set (Classifier ["eBank","Check"])), + ("checkAccount",Set (Classifier ["eBank","CreditAccount"]))], + interfaces=[], + invariant=[],name=["eBank","Checkbook"],operations=[], + parent=NONE,stereotypes=[],thyname=NONE}, + Class + {activity_graphs=[],associationends=[], + attributes=[("checkbook",Set (Classifier ["eBank","Checkbook"]))], + interfaces=[], + invariant=[], + name=["eBank","Check"], + operations=[{arguments=[],isQuery=false,name="newOperation", + postcondition=[],precondition=[], + result=Classifier ["eBank","void"]}],parent=NONE, + stereotypes=[],thyname=NONE}, + Class + {activity_graphs=[],associationends=[], + attributes=[("accountNumber",String),("currency",String), + ("balance",Integer)],interfaces=[],invariant=[], + name=["eBank","BankAccount"], + operations=[{arguments=[],isQuery=false,name="getBalance", + postcondition=[],precondition=[],result=Integer}, + {arguments=[("amount",Integer)],isQuery=false, + name="makeDeposit",postcondition=[],precondition=[], + result=Boolean}, + {arguments=[("amount",Integer)],isQuery=false, + name="makeWithdrawal",postcondition=[],precondition=[], + result=Boolean}],parent=SOME ["eBank","Account"], + stereotypes=[],thyname=NONE}, + Class + {activity_graphs=[],associationends=[], + attributes=[("tradingCurrency",String),("price",Integer)],interfaces=[], + invariant=[],name=["eBank","CurrencyTradingAccount"], + operations=[{arguments=[("amount",Integer)],isQuery=false,name="buy", + postcondition=[],precondition=[],result=Boolean}, + {arguments=[("amount",Integer)],isQuery=false,name="sell", + postcondition=[],precondition=[],result=Boolean}, + {arguments=[],isQuery=false,name="getBalance", + postcondition=[],precondition=[],result=Integer}, + {arguments=[],isQuery=false,name="getNormBalance", + postcondition=[],precondition=[],result=Boolean}], + parent=SOME ["eBank","BankAccount"],stereotypes=[],thyname=NONE}, + Class + {activity_graphs=[],associationends=[],attributes=[],interfaces=[], + invariant=[],name=["eBank","Date"],operations=[],parent=NONE, + stereotypes=[],thyname=NONE}, + Class + {activity_graphs=[],associationends=[], + attributes=[("book",Set (Classifier ["eBank","Checkbook"])), + ("creditLimit",Integer),("maxAmount",Integer)], + interfaces=[], + invariant=[],name=["eBank","CreditAccount"], + operations=[{arguments=[("amount",Integer)],isQuery=false, + name="makeDeposit",postcondition=[],precondition=[], + result=Boolean}, + {arguments=[("amount",Integer)],isQuery=false, + name="makeWithdrawal",postcondition=[],precondition=[], + result=Boolean}],parent=SOME ["eBank","BankAccount"], + stereotypes=[],thyname=NONE}, + Primitive + {associationends=[],interfaces=[],invariant=[],name=["eBank","void"], + operations=[],parent=NONE,stereotypes=[],thyname=NONE}] + + + +val cl = ebank diff --git a/src/codegen/examples/simple.sml b/src/codegen/examples/simple.sml new file mode 100644 index 0000000..5f795b5 --- /dev/null +++ b/src/codegen/examples/simple.sml @@ -0,0 +1,196 @@ +(***************************************************************************** + * su4sml - a SecureUML repository for SML + * + * simple.sml - a simple test file for the core repository + * Copyright (C) 2003-2005 Achim D. Brucker + * + * 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. + ******************************************************************************) + + +open Rep; +open Rep_OclType; +open XMI_DataTypes; +open Rep_SecureUML_ComponentUML.Security; +open ComponentUML; + +val A = Class({name=["simple","A"], + parent=NONE, + stereotypes=[], + attributes=[({ name="i", + attr_type=Integer, + visibility=private, + scope=InstanceScope, + init=NONE + } : attribute), + ({name="r", + attr_type=Real, + visibility=public, + scope=InstanceScope, + init=NONE + } : attribute), + ({name="attribB", + attr_type=Classifier(["simple","B"]), + visibility=public, + scope=InstanceScope, + init=NONE + } : attribute) + ] , + associationends=[({name="B", + aend_type=Classifier(["simple","B"]), + multiplicity=[(1,5)], + ordered=false, + visibility=public, + init=NONE + } : associationend)], + operations=[({name="main", + precondition=[], + postcondition=[], + arguments=[("p",Integer)], + result=OclVoid, + isQuery=true, + visibility=public, + scope=ClassifierScope + }: operation)], + interfaces=[], + invariant=[], + activity_graphs=[], + thyname=NONE + }) + +val B = Class({name=["simple","B"], + parent=NONE, + stereotypes=[], + attributes=[({ name="j", + attr_type=Integer, + visibility=private, + scope=InstanceScope, + init=NONE + } : attribute), + ({name="attribA", + attr_type=Classifier(["simple","A"]), + visibility=public, + scope=InstanceScope, + init=NONE + } : attribute) + ] , + associationends=[({name="B", + aend_type=Classifier(["simple","B"]), + multiplicity=[(~1,~1)], + ordered=false, + visibility=public, + init=NONE + }:associationend)], + operations=[], + interfaces=[], + invariant=[], + activity_graphs=[], + thyname=NONE + }) + +val C = Class({name=["simple","C"], + parent=SOME(["simple","A"]), + stereotypes=[], + attributes=[({ name="sl", + attr_type=Sequence(String), + visibility=public, + scope=InstanceScope, + init=NONE + } : attribute), + ({ name="slset", + attr_type=Set(String), + visibility=public, + scope=InstanceScope, + init=NONE + } : attribute) + ], + associationends=[], + operations=[], + interfaces=[], + invariant=[], + activity_graphs=[], + thyname=NONE + }) + +val D = Class({name=["simple","D"], + parent=SOME(["simple","A"]), + stereotypes=[], + attributes=[({ name="r", + attr_type=Real, + visibility=private, + scope=InstanceScope, + init=NONE + } : attribute)], + associationends=[], + operations=[], + interfaces=[], + invariant=[], + activity_graphs=[], + thyname=NONE + }) + +val E = Class({name=["simple","E"], + parent=SOME(["simple","B"]), + stereotypes=[], + attributes=[({ name="r", + attr_type=Real, + visibility=package, + scope=InstanceScope, + init=NONE + } : attribute)], + associationends=[], + operations=[], + interfaces=[], + invariant=[], + activity_graphs=[], + thyname=NONE + }) + +val cl = [A,B,C,D,E] + +val perms =[{name="FullAccessClassABC", + roles=["Supervisor","Admin"], + constraints=[]: Rep_OclTerm.OclTerm list, + actions= [ (CompositeAction ("full_access",("Entity",["simple","A"]))), + (CompositeAction ("full_access",("Entity",["simple","B"]))), + (CompositeAction ("full_access",("Entity",["simple","C"])))]: Design.Action list + }, + {name="ReadRealProperties", + roles=["Supervisor","Admin","Raphi"], + constraints=[]: Rep_OclTerm.OclTerm list, + actions= [ (SimpleAction ("read",("EntityAttribute",["simple","A","r"]))), + (SimpleAction ("read",("EntityAttribute",["simple","D","r"]))), + (SimpleAction ("read",("EntityAttribute",["simple","E","r"])))]: Design.Action list + }, + {name="CreateDeleteClassABC", + roles=["Supervisor","Admin"], + constraints=[]: Rep_OclTerm.OclTerm list, + actions= [ (SimpleAction ("create",("Entity",["simple","A"]))), + (SimpleAction ("create",("Entity",["simple","B"]))), + (SimpleAction ("create",("Entity",["simple","C"]))), + (SimpleAction ("delete",("Entity",["simple","A"]))), + (SimpleAction ("delete",("Entity",["simple","B"]))), + (SimpleAction ("delete",("Entity",["simple","C"])))]: Design.Action list + } + ] + +val model = (cl, {config_type = "SecureUML", + permissions = perms, + subjects = nil, + roles = nil, + sa = nil}):Rep_SecureUML_ComponentUML.Model + diff --git a/src/codegen/gcg_core.sig b/src/codegen/gcg_core.sig new file mode 100644 index 0000000..24dce61 --- /dev/null +++ b/src/codegen/gcg_core.sig @@ -0,0 +1,37 @@ +(***************************************************************************** + * 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. + ******************************************************************************) + +signature GCG = +sig + +(*structure C : CARTRIDGE*) + +val writeLine : string -> unit + +val generate : Rep_SecureUML_ComponentUML.Model -> string -> unit +(* +val generate : C.environment -> unit +*) +end \ No newline at end of file diff --git a/src/codegen/gcg_core.sml b/src/codegen/gcg_core.sml new file mode 100644 index 0000000..f531950 --- /dev/null +++ b/src/codegen/gcg_core.sml @@ -0,0 +1,142 @@ +(***************************************************************************** + * 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. + ******************************************************************************) + +functor GCG_Core (C: CARTRIDGE): GCG = +struct + +open Rep +open Rep_OclType +open Tpl_Parser +open Rep_SecureUML_ComponentUML.Security +open ComponentUML +open Gcg_Helper +open Ocl2String +open TextIO + + +val curFile = ref ""; + + +val out = ref TextIO.stdOut; + +fun closeFile ()= if (!curFile = "") + then () + else (closeOut (!out); + print ((!curFile)^" ... done\n"); + curFile := "") + + +fun openFile file = (closeFile (); + print ("opening "^file^"...\n"); + assureDir file; + out := (TextIO.openOut file); + curFile := file + ) + + + + +fun initOut () = (out := TextIO.stdOut; + curFile := "") + + + +fun writeLine s = TextIO.output (!out,s) + + + + + +fun eval s = (print ("\n"); + CompilerExt.eval true s; + print "<>\n") + + + + +(* map2EveryOther f l 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 = (joinEscapeSplitted "$") (fieldSplit s #"$") + in + String.concat (map2EveryOther (C.lookup e) tkl) + end + + +(* + * write is the main function of gcg_core. + * it traverses a templateParseTree and executes the given instructions + *) +(* write : C.environment -> TemplateTree -> () *) +fun write env (RootNode(l)) = List.app (write env) l + | write env (OpenFileLeaf(file)) = openFile (substituteVars env file) + | write env (EvalLeaf(l)) = let fun collectEval [] = "" + | collectEval ((TextLeaf(expr))::t) = expr^"\n"^(collectEval t) + | collectEval _ = + gcg_error "eval failed: TextLeaf expected in gcg_core.write." + in + eval (substituteVars env (collectEval l)) + end + | write env (TextLeaf(s)) = writeLine (substituteVars env s) + | write env (IfNode(cond,l)) + = let (*val list_of_environments = C.foreach listType env + fun write_children e = List.app (fn tree => write e tree) children + *) + fun writeThen _ [] = () + | writeThen _ [ElseNode(_)]= () + | writeThen e (h::t) = (write e h ;writeThen e t) + in + if (C.evalCondition env cond) + then writeThen env l + else (case (List.last l) of nd as (ElseNode(_)) => write env nd + | _ => () ) + end + | write env (ElseNode(l)) = List.app (write env) l + | write env (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 + end + + + +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 GCG_Error => (closeFile(); raise GCG_Error) + end + + +end \ No newline at end of file diff --git a/src/codegen/gcg_helper.sml b/src/codegen/gcg_helper.sml new file mode 100644 index 0000000..0e22a8e --- /dev/null +++ b/src/codegen/gcg_helper.sml @@ -0,0 +1,171 @@ +(***************************************************************************** + * 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 (* : + sig + val emptyAction : ComponentUML.Action + val emptyArgument : string * OclType + val emptyAttribute : attribute + val emptyClassifier : Classifier + val emptyConstraint : Rep_OclTerm.OclTerm + val emptyOperation : operation + val emptyPermission : Permission + val emptyResource : Resource + val emptyRole : string + val emptyModel : Rep_SecureUML_ComponentUML.Model + val action_to_string : ComponentUML.Action -> string + val isInPermission : ComponentUML.Action -> Permission -> bool + end*) = + struct + open Rep + open Rep_OclType + open Rep_OclTerm + open Rep_SecureUML_ComponentUML.Security + open ComponentUML + open XMI_DataTypes + +exception GCG_Error + +fun gcg_error s = (print ("Error:"^s^"\n"); raise GCG_Error); + +fun gcg_warning s = (print ("Warning: "^s^"\n")); + +fun fieldSplit s d = String.fields (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 + +val curry = fn f => fn x => fn y => f (x, y) +val uncurry = fn f => fn (x, y) => f x y + + + +val emptyClassifier = (Primitive({ name=["",""], + parent=NONE, + operations=[], + associationends=[], + invariant=[], + stereotypes=[], + interfaces=[], + thyname=NONE + })); + +val emptyOperation = ({name="", + precondition=[], + postcondition=[], + arguments=[], + result=DummyT, + isQuery=false, + visibility=private, + scope=ClassifierScope + }: operation); + +val emptyAttribute = ({name="", + attr_type=DummyT, + visibility=private, + scope=ClassifierScope, + init=NONE + } : attribute); + +val emptyArgument = ("",DummyT) + +val emptyPermission = ({actions = [], + constraints = [], + name="", + roles= [] + } : Permission) +val emptyRole = "" +val emptyConstraint = (Literal("",DummyT)) +val emptyResource = (("",[]) : Resource) +val emptyAction = SimpleAction("", emptyResource) + +val emptyModel = (nil, {config_type = "", + permissions = nil, + subjects = nil, + roles = nil, + sa = nil}):Rep_SecureUML_ComponentUML.Model + + +fun isSuffix [] _ = true + | isSuffix _ [] = false + | isSuffix (h1::t1) (h2::t2) = (h1=h2) andalso (isSuffix t1 t2) + +fun resPath_of a = #2 (resource_of a) + +fun actionType_of (SimpleAction (t,_)) = t + | actionType_of (CompositeAction (t,_)) = t + +fun actionTypes_compatible _ "full_access" = true + | actionTypes_compatible "read" "read" = true + | actionTypes_compatible "update" "update" = true + | actionTypes_compatible _ _ = false + +(* checks if a1 is part of a2 *) +fun is_contained_in a1 (a2 as (SimpleAction _)) = (a1 = a2) + | is_contained_in a1 a2 = let + val p1 = resPath_of a1 + val p2 = resPath_of a2 + val at1 = actionType_of a1 + val at2 = actionType_of a2 + in + (isSuffix p2 p1) andalso (actionTypes_compatible at1 at2) + end + +(* fun is_contained_in a1 a2 = (a1 = a2) orelse List.exists (fn x=> x=true)) (List.map (is_contained_in a1) (subordinated_actions a2))) *) + +fun isInPermission a (p:Permission) = List.exists (is_contained_in a) (#actions p) + +fun resource_to_string (s,p) = "("^s^", "^(string_of_path p)^")" +fun action_to_string (SimpleAction (s,r)) = "SimpleAction("^s^", "^(resource_to_string r)^"))" + | action_to_string (CompositeAction (s,r)) = "CompositeAction("^s^", "^(resource_to_string r)^"))" + + + +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/gcg_library.sml b/src/codegen/gcg_library.sml new file mode 100644 index 0000000..eaddc45 --- /dev/null +++ b/src/codegen/gcg_library.sml @@ -0,0 +1,45 @@ +(***************************************************************************** + * su4sml GCG - Generic Code Generator + * + * gcg_library.sml - provides simple library needed by 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. + ******************************************************************************) + +exception GCG_Error + +fun gcg_error s = (print ("Error:"^s^"\n"); raise GCG_Error); + +fun gcg_warning s = (print ("Warning: "^s^"\n")); + +fun fieldSplit s d = String.fields (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 + +val curry = fn f => fn x => fn y => f (x, y) +val uncurry = fn f => fn (x, y) => f x y + \ No newline at end of file diff --git a/src/codegen/java_cartridge.sml b/src/codegen/java_cartridge.sml new file mode 100644 index 0000000..608b02c --- /dev/null +++ b/src/codegen/java_cartridge.sml @@ -0,0 +1,54 @@ +(***************************************************************************** + * 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. + ******************************************************************************) + + structure Java_Cartridge : CARTRIDGE = + struct + open Rep_OclType + (* type translation table *) + fun oclType2Native Integer = "int" + | oclType2Native Real = "float" + | oclType2Native String = "string" + | oclType2Native Boolean = "bool" + | oclType2Native OclVoid = "void" + | oclType2Native (Set(t)) = "java.util.TreeSet" + | oclType2Native (Sequence(t)) = "java.util.TreeSet" + | oclType2Native t = Rep_OclType.string_of_OclType t +(* + | OclAny + | Set of OclType | Sequence of OclType + | OrderedSet of OclType | Bag of OclType + | Collection of OclType + | Classifier of Path | OclVoid | DummyT +*) + +fun visibility2Native public = "public" + | visibility2Native private = "private" + | visibility2Native protected = "protected" + | visibility2Native package = "public" + +fun scope2Native ClassifierScope = "static" + | scope2Native InstanceScope = "" + +val template = "templates/java.tpl"; + +end \ No newline at end of file diff --git a/src/codegen/secureuml_cartridge.sig b/src/codegen/secureuml_cartridge.sig new file mode 100644 index 0000000..a251f81 --- /dev/null +++ b/src/codegen/secureuml_cartridge.sig @@ -0,0 +1,42 @@ +(***************************************************************************** + * 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 + +(* from CARTRIDGE *) + type environment + val initEnv : Rep_SecureUML_ComponentUML.Model -> environment + + val lookup : environment -> string -> string + val evalCondition : environment -> string -> bool + val foreach : string -> environment -> environment list + +(* specific for SECUREUML_CARTRIDGE *) + val curPermissionSet: environment -> Rep_SecureUML_ComponentUML.Security.Permission list + val curPermission : environment -> Rep_SecureUML_ComponentUML.Security.Permission + val curRole : environment -> string + val curConstraint : environment -> Rep_OclTerm.OclTerm + +end diff --git a/src/codegen/secureuml_cartridge.sml b/src/codegen/secureuml_cartridge.sml new file mode 100644 index 0000000..0c00f87 --- /dev/null +++ b/src/codegen/secureuml_cartridge.sml @@ -0,0 +1,250 @@ +(***************************************************************************** + * su4sml GCG - Generic Code Generator + * + * secureuml_cartridge.sml - A cartridge for Access Control features of SecureUML + * 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. + ******************************************************************************) + + +functor SecureUML_Cartridge(SuperCart : BASE_CARTRIDGE) : SECUREUML_CARTRIDGE = + struct + open Rep_SecureUML_ComponentUML.Security + open ComponentUML + open Gcg_Helper + open Ocl2String + + + type environment = { curPermissionSet: Permission list, + curPermission : Permission, + curRole : string, + curConstraint : Rep_OclTerm.OclTerm, + extension : SuperCart.environment } + + + (* service functions for other cartridges to have access to the current + * list items + *) + fun curPermissionSet (env : environment) = #curPermissionSet env + fun curPermission (env : environment) = #curPermission env + fun curRole (env : environment) = #curRole env + fun curConstraint (env : environment) = #curConstraint env + + + fun initEnv model = { curPermissionSet = [], + curPermission = emptyPermission, + curRole = emptyRole, + curConstraint = emptyConstraint, + 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) + = { curPermissionSet = #curPermissionSet env, + curPermission = #curPermission env, + curRole = #curRole env, + curConstraint = #curConstraint env, + extension=new_env} + + +(* Helper functions that get the SuperCartridge's needed environment values *) +fun getModel (env : environment) = SuperCart.model (unpack env) +fun getCurClassifier (env : environment) = SuperCart.curClassifier (unpack env) +fun getCurAttribute (env : environment) = SuperCart.curAttribute (unpack env) +fun getCurOperation (env : environment) = SuperCart.curOperation (unpack env) + +type permissionContext = {permissions : Permission list, + setter_permissions : Permission list, + getter_permissions : Permission list, + constructor_permissions : Permission list, + destructor_permissions : Permission list} + +fun permissionsForAction (e : environment) a + = List.filter (isInPermission a) (#permissions (#2 (getModel e))) + +(* computePermissionContext: environment -> permissionContext + * compute Permissions according to actual environment + *) +fun computePermissionContext (env : environment)= + let + fun path_of_attr () = (Rep_Core.name_of (getCurClassifier env))@[#name (getCurAttribute env)] + fun path_of_op () = (Rep_Core.name_of (getCurClassifier env))@[(name_of_op (getCurOperation env))] + fun getAction "set" = SimpleAction ("update", ("EntityAttribute",(path_of_attr ()))) + | getAction "get" = SimpleAction ("read", ("EntityAttribute",(path_of_attr ()))) + | getAction "execute" = SimpleAction ("execute", ("EntityMethod",(path_of_op ()))) + | getAction "create" = SimpleAction ("create", ("Entity",(Rep_Core.name_of (getCurClassifier env)))) + | getAction "delete" = SimpleAction ("delete", ("Entity",(Rep_Core.name_of (getCurClassifier env)))) + | getAction s = gcg_error ("invalid action_type \""^s^"\" in secureUML_cartridge.computePermissionContext:getAction.") + in + if not((getCurAttribute env) = emptyAttribute) then + {permissions = [], + setter_permissions = (permissionsForAction env (getAction "set")), + getter_permissions = (permissionsForAction env (getAction "get")), + constructor_permissions = [], + destructor_permissions = [] + } + else if not((getCurOperation env) = emptyOperation) then + {permissions = permissionsForAction env (getAction "execute"), + setter_permissions = [], + getter_permissions = [], + constructor_permissions = [], + destructor_permissions = [] + } + else if not((getCurClassifier env) = emptyClassifier) then + {permissions = [], + setter_permissions = [], + getter_permissions = [], + constructor_permissions = permissionsForAction env (getAction "create"), + destructor_permissions = permissionsForAction env (getAction "delete") + } + else + {permissions = #permissions (#2 (getModel env)), + setter_permissions = [], + getter_permissions = [], + constructor_permissions = [], + destructor_permissions = [] + } + end + +fun name_of_role r = r + +(********** ADDING/MODIFYING VARIABLE SUBSTITUTIONS *****************************************) +(* lookup environment -> string -> string + * might override some lookup entries of the base cartridge + *) +fun lookup (env : environment) "permission_name" = #name (#curPermission env) + | lookup (env : environment) "role_name" = name_of_role (#curRole env) + | lookup (env : environment) "constraint" = ocl2string false (#curConstraint env) + (* pass the unknown variables to the Superior Cartridge *) + | lookup (env : environment) s = SuperCart.lookup (unpack env) s + +(********** ADDING IF-CONDITION TYPE *****************************************) +fun evalCondition (env : environment) "first_permission" = (#curPermission env = hd (#curPermissionSet env)) + | evalCondition (env : environment) "first_role" = (#curRole env = hd (#roles (#curPermission env))) + | evalCondition (env : environment) "first_constraint" = (#curConstraint env = hd (#constraints (#curPermission env))) + | evalCondition (env : environment) "last_permission" = (#curPermission env = List.last (#curPermissionSet env)) + | evalCondition (env : environment) "last_role" = (#curRole env = List.last (#roles (#curPermission env))) + | evalCondition (env : environment) "last_constraint" = (#curConstraint env = List.last (#constraints (#curPermission env))) + (* pass unknown condition types to Superior Cartridge *) + | evalCondition (env : environment) s = SuperCart.evalCondition (unpack env) s + + +(********** ADDING FOREACH TYPE **********************************************) + +(* fun foreach_: environment -> environment list *) +fun foreach_permission (env : environment) + = let val plist = #permissions (computePermissionContext env); + fun env_from_list_item c ={curPermissionSet = plist, + curPermission = c, + curRole = emptyRole , + curConstraint = emptyConstraint, + extension = #extension env + } : environment + in + List.map env_from_list_item plist + end + +fun foreach_readPermission (env : environment) + = let val plist = #getter_permissions (computePermissionContext env); + fun env_from_list_item c ={curPermissionSet = plist, + curPermission = c, + curRole = emptyRole , + curConstraint = emptyConstraint, + extension = #extension env + } : environment + in + List.map env_from_list_item plist + end + +fun foreach_updatePermission (env : environment) + = let val plist = #setter_permissions (computePermissionContext env); + fun env_from_list_item c ={curPermissionSet = plist, + curPermission = c, + curRole = emptyRole , + curConstraint = emptyConstraint, + extension = #extension env + } : environment + in + List.map env_from_list_item plist + end +fun foreach_createPermission (env : environment) + = let val plist = #constructor_permissions (computePermissionContext env); + fun env_from_list_item c ={curPermissionSet = plist, + curPermission = c, + curRole = emptyRole , + curConstraint = emptyConstraint, + extension = #extension env + } : environment + in + List.map env_from_list_item plist + end + +fun foreach_deletePermission (env : environment) + = let val plist = #destructor_permissions (computePermissionContext env); + fun env_from_list_item c ={curPermissionSet = plist, + curPermission = c, + curRole = emptyRole , + curConstraint = emptyConstraint, + extension = #extension env + } : environment + in + List.map env_from_list_item plist + end + +fun foreach_role (env : environment) + = let val roles = #roles (#curPermission env); + fun env_from_list_item r ={curPermissionSet = #curPermissionSet env, + curPermission = #curPermission env, + curRole = r , + curConstraint = emptyConstraint, + extension = #extension env + } : environment + in + List.map env_from_list_item roles + end + +fun foreach_constraint (env : environment) + = let val cons = #constraints (#curPermission env); + fun env_from_list_item c ={curPermissionSet = #curPermissionSet env, + curPermission = #curPermission env, + curRole = emptyRole , + curConstraint = c, + extension = #extension env + } : environment + in + List.map env_from_list_item cons + end + + +fun foreach "permission_list" env = foreach_permission env + | foreach "readPermission_list" env = foreach_readPermission env + | foreach "updatePermission_list" env = foreach_updatePermission env + | foreach "createPermission_list" env = foreach_createPermission env + | foreach "deletePermission_list" env = foreach_deletePermission env + | foreach "role_list" env = foreach_role env + | foreach "constraint_list" env = foreach_constraint env + (* pass unknown list types to superior cartridge by unpacking environments, + * having SuperCart compute environment list, pack into native environment again*) + | foreach listType env = map (pack env) (SuperCart.foreach listType (unpack env)) + + +end \ No newline at end of file diff --git a/src/codegen/templates/C#.tpl b/src/codegen/templates/C#.tpl new file mode 100644 index 0000000..610e6ff --- /dev/null +++ b/src/codegen/templates/C#.tpl @@ -0,0 +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 +@nl} // End \ No newline at end of file diff --git a/src/codegen/templates/C#_SecureUML.tpl b/src/codegen/templates/C#_SecureUML.tpl new file mode 100644 index 0000000..7503e79 --- /dev/null +++ b/src/codegen/templates/C#_SecureUML.tpl @@ -0,0 +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 permission_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 \ No newline at end of file diff --git a/src/codegen/templates/base.tpl b/src/codegen/templates/base.tpl new file mode 100644 index 0000000..8f2ca1f --- /dev/null +++ b/src/codegen/templates/base.tpl @@ -0,0 +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 } +@end \ No newline at end of file diff --git a/src/codegen/templates/java.tpl b/src/codegen/templates/java.tpl new file mode 100644 index 0000000..ed66ddc --- /dev/null +++ b/src/codegen/templates/java.tpl @@ -0,0 +1,25 @@ +@// 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 \ No newline at end of file diff --git a/src/codegen/tpl_parser.sig b/src/codegen/tpl_parser.sig new file mode 100644 index 0000000..403b2e7 --- /dev/null +++ b/src/codegen/tpl_parser.sig @@ -0,0 +1,39 @@ +(***************************************************************************** + * 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 + | RootNode of TemplateTree list + | TextLeaf of string + +val printTTree : TemplateTree -> unit +val parse : string -> TemplateTree + +end \ No newline at end of file diff --git a/src/codegen/tpl_parser.sml b/src/codegen/tpl_parser.sml new file mode 100644 index 0000000..4dc6588 --- /dev/null +++ b/src/codegen/tpl_parser.sml @@ -0,0 +1,204 @@ +(***************************************************************************** + * 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. + ******************************************************************************) + +structure Tpl_Parser : TPL_PARSER = +struct +open Gcg_Helper + +val tplStream = ref (TextIO.openString "@// dummy template\n"); +fun opentFile file = (TextIO.closeIn (!tplStream) ; + print ("opening "^file^"...\n"); + tplStream := (TextIO.openIn file)) + +fun cleanUp tplFile = (TextIO.closeIn (!tplStream); + OS.FileSys.remove tplFile) + +fun readNextLine () = TextIO.inputLine (!tplStream) + +datatype TemplateTree = RootNode of TemplateTree list + | OpenFileLeaf of string + | EvalLeaf of TemplateTree list + | TextLeaf of string + | IfNode of string * TemplateTree list + | ElseNode of TemplateTree list + | ForEachNode of string * TemplateTree list + + + + +(* replaceSafely (s,v,x) + * replaces every v in s with x or if v is escaped removes "\" + *) +fun replaceSafely ("",_,_) = "" + | replaceSafely (s,v,x) = let val v_size = size v and + s_size = size s + in + if String.isPrefix ((str #"\\")^v) s + then (v^(replaceSafely(String.extract(s,v_size +1,NONE),v,x))) + else if String.isPrefix v s + then x^(replaceSafely(String.extract(s,v_size,NONE),v,x)) + else str(String.sub(s,0))^(replaceSafely(String.extract(s,1,NONE),v,x)) + end + + +(* + * cleanLine [string] + * splits string into tokens and + * removes space- and tab-characters + *) +fun cleanLine s = let fun removeWspace s = + implode (List.filter (fn c => not (Char.isSpace c)) (explode s)) + fun concatWith [] d = "" + | concatWith [s] d = s^" " + | concatWith (h::t) d = h^d^(concatWith t d) + val myToken = (String.tokens (fn c => c = #" ")) + in + concatWith ( List.filter (fn s => s <>"")(((List.map removeWspace) o myToken) s )) " " + end + +(* 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 (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 left part of l up to the element where f evaluates to true + *) +fun itemsUntil f [] = [] + | itemsUntil f (h::t) = if (f h) then [] + else h::(itemsUntil f t) + + +(* splits line into tokens considering handling escaped @ *) +fun tokenize line = let val l = joinEscapeSplitted "@" (fieldSplit line #"@"); + in + (hd l)::(itemsUntil isComment (tl l)) + end + +(* + * getType line + * 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" + else hd(fieldSplit (String.concat(tl(sl))) #" ") + end + + +(* + * getContent line + * returns the content of a line + *) +fun getContent l = let val sl = tokenize l + in + if (length sl = 1) + then hd(sl) + else String.concat(tl(fieldSplit (String.concat(tl(sl))) #" ")) + end + +(* + * preprocess [line] + * cleans line, replaces nl and tabs + * so that no space char is left out + *) + +fun preprocess s = let val rl = replaceSafely(replaceSafely(cleanLine s,"@nl ","\n"),"@tab ","\t") + in + replaceSafely(replaceSafely(rl,"@nl","\n"),"@tab","\t") + end + + +(* buildTree + * builds the TemplateTree + * returns 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 ("eval","") = + (EvalLeaf(buildTree(readNextLine())))::(buildTree (readNextLine())) + | getNode ("eval",expr) = (EvalLeaf([TextLeaf(expr)]))::(buildTree (readNextLine())) + | getNode ("end",_) = [] + | getNode (t,c) = gcg_error ("Couldn't parse the node \""^t^"\" with content\""^c^"\" in tpl_parser.buildTree.") + val prLine = preprocess line + in + getNode ((getType prLine),(getContent prLine)) + end + | buildTree NONE = [] + + +fun codegen_env _ = getOpt(OS.Process.getEnv "CODEGEN_HOME",".") + +(* 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 = String.substring (file,0,size file -4) ^".tmp";*) + val targetFile = OS.FileSys.tmpName () + in + (* (OS.Process.system ("cd $CODEGEN; cpp "^file^" "^targetFile^" -P -C"); *) + (OS.Process.system ("cpp "^codegen_env()^"/"^file^" "^targetFile^" -P -C"); + targetFile) + end + + + +(* parse [template-file] + * returns the parsed template tree + *) +fun parse file = let val mergedTpl = call_cpp file; + val u = opentFile mergedTpl; + val pt = RootNode(buildTree (readNextLine())); + val u2 = cleanUp mergedTpl; + in + (print "...template parsed.\n"; pt) + end + +(* +val testline = "@foreach \\@public @// commkejbk"; +val textline1 = "\t\tpublic $class_name$ "; +val textline2 = ""; +val endline = "\t@end"; +*) +(* +val ParseTree = parse "examples/C#.tpl"; + +printTplTree ParseTree; +*) +end