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

codegen-sourcen von Raphael 

git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@4212 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Jürgen Doser 2006-03-21 13:14:15 +00:00
parent 69b426c531
commit 4ba2516d92
29 changed files with 2513 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
src/codegen/LIB.ML Normal file
View File

@ -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";

61
src/codegen/ROOT.ML Normal file
View File

@ -0,0 +1,61 @@
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* ROOT.ML - main "ROOT.ML" file for su4sml-GCG
* Copyright (C) 2005 Raphael Eidenbenz <eraphael@student.ethz.ch>
*
* 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";

37
src/codegen/base_cartridge.sig Normal file
View File

@ -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 <eraphael@student.ethz.ch>
*
* 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

195
src/codegen/base_cartridge.sml Normal file
View File

@ -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 <eraphael@student.ethz.ch>
*
* 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) (<SuperCartridge>.foreach name (unpack env))
*)
| foreach s _ = gcg_error ("Couldn't write foreach "^s^" ." ^
"\""^s^"\" not defined in base_cartridge.foreach ")
end

103
src/codegen/c#_cartridge.sml Normal file
View File

@ -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 <eraphael@student.ethz.ch>
*
* 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

102
src/codegen/c#_net1_cartridge.sml Normal file
View File

@ -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 <eraphael@student.ethz.ch>
*
* 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

33
src/codegen/cartridge.sig Normal file
View File

@ -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 <eraphael@student.ethz.ch>
*
* 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

24
src/codegen/codegen.cm Normal file
View File

@ -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

28
src/codegen/codegen.mlb Normal file
View File

@ -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

65
src/codegen/codegen.sml Normal file
View File

@ -0,0 +1,65 @@
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* codegen.sml - control file for su4sml-GCG
* Copyright (C) 2005 Raphael Eidenbenz <eraphael@student.ethz.ch>
*
* 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 <xmi_file> \"base\" | \"c#\" | \"c#_secure\" | \"c#_net1\" | \"c#_secure_net1\"\n")
fun main (_,[xmi_file,lang]) = generate xmi_file lang
| main _ = print ("usage: codegen <xmi_file> <language>\n"^
"\tlanguage = \"base\" | \"c#\" | \"c#_secure\" | \"c#_net1\" | \"c#_secure_net1\"\n")
end
val _ = Codegen.main(CommandLine.name(),CommandLine.arguments())

28
src/codegen/compiler/compiler_ext.sig Normal file
View File

@ -0,0 +1,28 @@
(*****************************************************************************
* su4sml - a SecureUML repository for SML
*
* compiler_ext.sig - interactive eval stub
* Copyright (C) 2005 Achim D. Brucker <brucker@inf.ethz.ch>
*
* 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

28
src/codegen/compiler/mlton.sml Normal file
View File

@ -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 <brucker@inf.ethz.ch>
*
* 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

57
src/codegen/compiler/polyml.sml Normal file
View File

@ -0,0 +1,57 @@
(*****************************************************************************
* su4sml - a SecureUML repository for SML
*
* polyml.sml - interactive eval
* Copyright (C) 2005 Achim D. Brucker <brucker@inf.ethz.ch>
*
* 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

51
src/codegen/compiler/smlnj.sml Normal file
View File

@ -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 <brucker@inf.ethz.ch>
*
* 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

131
src/codegen/examples/ebank.sml Normal file
View File

@ -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 <brucker@inf.ethz.ch>
*
* 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

196
src/codegen/examples/simple.sml Normal file
View File

@ -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 <brucker@inf.ethz.ch>
*
* 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

37
src/codegen/gcg_core.sig Normal file
View File

@ -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 <eraphael@student.ethz.ch>
*
* 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

142
src/codegen/gcg_core.sml Normal file
View File

@ -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 <eraphael@student.ethz.ch>
*
* 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 ("<eval>\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

171
src/codegen/gcg_helper.sml Normal file
View File

@ -0,0 +1,171 @@
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* gcg_helper.sml - helper library for su4sml-gcg
* Copyright (C) 2005 Raphael Eidenbenz <eraphael@student.ethz.ch>
*
* 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

45
src/codegen/gcg_library.sml Normal file
View File

@ -0,0 +1,45 @@
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* gcg_library.sml - provides simple library needed by su4sml-gcg
* Copyright (C) 2005 Raphael Eidenbenz <eraphael@student.ethz.ch>
*
* 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

54
src/codegen/java_cartridge.sml Normal file
View File

@ -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 <eraphael@student.ethz.ch>
*
* 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

42
src/codegen/secureuml_cartridge.sig Normal file
View File

@ -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 <eraphael@student.ethz.ch>
*
* 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

250
src/codegen/secureuml_cartridge.sml Normal file
View File

@ -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 <eraphael@student.ethz.ch>
*
* 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_<new_list_type>: 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

68
src/codegen/templates/C#.tpl Normal file
View File

@ -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

166
src/codegen/templates/C#_SecureUML.tpl Normal file
View File

@ -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
<?xml version="1.0" encoding="utf-8" ?>
@nl<!-- XML-permissions file for MdsEngine. Generated by su4sml-gcg. -->
@nl<!-- source: C#_SecureUML.tpl -->
@nl@nl<mds>
@foreach permission_list
@nl @tab <permission name="$permission_name$">
@foreach role_list
@nl @tab@tab <role name="$role_name$" />
@end
@foreach constraint_list
@nl @tab@tab <condition lang="OCL">$constraint$</condition>
@end
@nl @tab@tab <obligation></obligation>
@nl @tab </permission>
@end
@nl </mds>
@// 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

28
src/codegen/templates/base.tpl Normal file
View File

@ -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

25
src/codegen/templates/java.tpl Normal file
View File

@ -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

39
src/codegen/tpl_parser.sig Normal file
View File

@ -0,0 +1,39 @@
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* tpl_parser.sig - template parser of a su4sml-gcg template
* Copyright (C) 2005 Raphael Eidenbenz <eraphael@student.ethz.ch>
*
* 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

204
src/codegen/tpl_parser.sml Normal file
View File

@ -0,0 +1,204 @@
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* tpl_parser.sml - template parser of a su4sml-gcg template
* Copyright (C) 2005 Raphael Eidenbenz <eraphael@student.ethz.ch>
*
* 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