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

merge with work of Manfred (based on rev. 35191) 

git-svn-id: https://projects.brucker.ch/su4sml/svn/infsec-import/trunk/src/su4sml@6108 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
Achim D. Brucker 2007-02-09 11:14:53 +00:00
parent 54b804076a
commit 47e8852dcb
34 changed files with 2730 additions and 2254 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/ROOT.ML
View File

@ -88,6 +88,7 @@ use "rep.sml";
(* support functions *)
use "ocl2string.sml";
use "ocl2dresdenjava.sml";
(* ****************************************************** *)
(* Main Conversion Processes *)

206
src/codegen/LIB.ML
View File

@ -1,103 +1,103 @@
(*****************************************************************************
* su4sml - a SecureUML repository for SML
*
* ROOT.ML - main "ROOT.ML" file for ...
* Copyright (C) 2005 Raphael
*
* This file is part of su4sml.
*
* su4sml is free software; you can redistribute it and/or modify it under
* the terms of the GNU General Public License as published by the Free
* Software Foundation; either version 2 of the License, or (at your option)
* any later version.
*
* su4sml is distributed in the hope that it will be useful, but WITHOUT ANY
* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
* FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
* details.
*
* You should have received a copy of the GNU General Public License along
* with this program; if not, write to the Free Software Foundation, Inc.,
* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
******************************************************************************)
OS.FileSys.chDir "../lib/su4sml/src";
use "library.sml";
(* library should be opend locally for MLton compatibility... *)
(* open library; *)
(* ****************************************************** *)
(* Load the (foreign) fxp-module providing
an elemantary library in processing xml documents. *)
OS.FileSys.chDir "../lib/fxp/src";
use "ROOT.ML";
OS.FileSys.chDir "../../../src";
(* ****************************************************** *)
(* Abstract Representation of an XMI File of a UML Model.
- References kept
- only "interesting" parts were represented
- structural simplifications whereever needed for
our applications.
- Layout Information skippedi
- the structure is oriented towards UML 1.5
(although the supported Poseidon is apparantly based
on Version 1.4 or something ...). *)
use "xmi_ocl.sml";
use "xmi_datatypes.sml";
use "xmi_extension_mechanisms.sml";
use "xmi_state_machines.sml";
use "xmi_activity_graphs.sml";
use "xmi_core.sml";
use "xmi.sml";
(* ****************************************************** *)
(* Abstract Representation ("The Repository") of a UML model.
- References resolved
- only supported parts were represented
- structural simplifications whereever needed for
our applications. *)
use "rep_ocl.sig";
use "rep_ocl.sml";
use "rep_state_machines.sig";
use "rep_state_machines.sml";
use "rep_activity_graphs.sig";
use "rep_activity_graphs.sml";
use "rep_core.sig";
use "rep_core.sml";
(* use "rep_secureuml.sig"; *)
(* use "rep_secureuml.sml"; *)
use "rep.sig";
use "rep.sml";
(* support functions *)
use "ocl2string.sml";
(* ****************************************************** *)
(* Main Conversion Processes *)
use "xmltree_parser.sml"; (* provides explicit xml-tree data structure,
abstracts away fxp package. *)
use "xml2xmi.sml"; (* conversion XML to XMI *);
use "xmi_idtable.sml"; (* auxiliary table to store and dereference xmi.id's *)
use "xmi2rep.sml"; (* conversion XMI to Rep *)
use "mds.sig";
use "component_uml.sml";
use "secure_uml.sml";
use "rep_secure.sig";
use "rep_secure.sml";
OS.FileSys.chDir "../../../src";
(*****************************************************************************
* su4sml - a SecureUML repository for SML
*
* ROOT.ML - main "ROOT.ML" file for ...
* Copyright (C) 2005 Raphael
*
* This file is part of su4sml.
*
* su4sml is free software; you can redistribute it and/or modify it under
* the terms of the GNU General Public License as published by the Free
* Software Foundation; either version 2 of the License, or (at your option)
* any later version.
*
* su4sml is distributed in the hope that it will be useful, but WITHOUT ANY
* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
* FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
* details.
*
* You should have received a copy of the GNU General Public License along
* with this program; if not, write to the Free Software Foundation, Inc.,
* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
******************************************************************************)
OS.FileSys.chDir "../lib/su4sml/src";
use "library.sml";
(* library should be opend locally for MLton compatibility... *)
(* open library; *)
(* ****************************************************** *)
(* Load the (foreign) fxp-module providing
an elemantary library in processing xml documents. *)
OS.FileSys.chDir "../lib/fxp/src";
use "ROOT.ML";
OS.FileSys.chDir "../../../src";
(* ****************************************************** *)
(* Abstract Representation of an XMI File of a UML Model.
- References kept
- only "interesting" parts were represented
- structural simplifications whereever needed for
our applications.
- Layout Information skippedi
- the structure is oriented towards UML 1.5
(although the supported Poseidon is apparantly based
on Version 1.4 or something ...). *)
use "xmi_ocl.sml";
use "xmi_datatypes.sml";
use "xmi_extension_mechanisms.sml";
use "xmi_state_machines.sml";
use "xmi_activity_graphs.sml";
use "xmi_core.sml";
use "xmi.sml";
(* ****************************************************** *)
(* Abstract Representation ("The Repository") of a UML model.
- References resolved
- only supported parts were represented
- structural simplifications whereever needed for
our applications. *)
use "rep_ocl.sig";
use "rep_ocl.sml";
use "rep_state_machines.sig";
use "rep_state_machines.sml";
use "rep_activity_graphs.sig";
use "rep_activity_graphs.sml";
use "rep_core.sig";
use "rep_core.sml";
(* use "rep_secureuml.sig"; *)
(* use "rep_secureuml.sml"; *)
use "rep.sig";
use "rep.sml";
(* support functions *)
use "ocl2string.sml";
(* ****************************************************** *)
(* Main Conversion Processes *)
use "xmltree_parser.sml"; (* provides explicit xml-tree data structure,
abstracts away fxp package. *)
use "xml2xmi.sml"; (* conversion XML to XMI *);
use "xmi_idtable.sml"; (* auxiliary table to store and dereference xmi.id's *)
use "xmi2rep.sml"; (* conversion XMI to Rep *)
use "mds.sig";
use "component_uml.sml";
use "secure_uml.sml";
use "rep_secure.sig";
use "rep_secure.sml";
OS.FileSys.chDir "../../../src";

126
src/codegen/ROOT.ML
View File

@ -1,61 +1,65 @@
(*****************************************************************************
* 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.
******************************************************************************)
use "gcg_helper.sml";
use "stringHandling.sml";
(*use "examples/simple.sml"; *)
(*use "examples/ebank.sml";*)
use "tpl_parser.sml";
(* Base *)
use "cartridge.sig";
use "base_cartridge.sml";
(* C# *)
use "c#_cartridge.sml";
use "c#_net1_cartridge.sml";
(* SecureUML *)
use "design_cartridge.sig";
use "secureuml_cartridge.sml";
use "componentuml_cartridge.sml";
use "java_cartridge.sml";
use "junit_cartridge.sml";
(* Statemachines *)
use "SM_helper.sml";
use "stateMachineTypes.sml";
use "stateMachine.sml";
use "c#sm_cartridge.sig";
use "c#sm_cartridge.sml";
use "gcg_core.sig";
use "gcg_core.sml";
use "codegen.sml";
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* ROOT.ML - main "ROOT.ML" file for su4sml-GCG
* Copyright (C) 2005 Raphael Eidenbenz <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.
******************************************************************************)
use "gcg_helper.sml";
use "stringHandling.sml";
(*use "examples/simple.sml"; *)
(*use "examples/ebank.sml";*)
use "tpl_parser.sml";
(* Base *)
use "cartridge.sig";
use "base_cartridge.sml";
(* C# *)
use "c#_cartridge.sml";
use "c#_net1_cartridge.sml";
(* SecureUML *)
use "design_cartridge.sig";
use "secureuml_cartridge.sml";
use "componentuml_cartridge.sml";
use "java_cartridge.sml";
use "junit_cartridge.sml";
(* Statemachines *)
use "SM_helper.sml";
use "stateMachineTypes.sml";
use "stateMachine.sml";
use "c#sm_cartridge.sig";
use "c#sm_cartridge.sml";
use "gcg_core.sig";
use "gcg_core.sml";
use "codegen.sml";

92
src/codegen/base_cartridge.sig
View File

@ -1,46 +1,46 @@
(*****************************************************************************
* su4sml - a SecureUML repository for SML
*
* base_cartridge.sig - an extended signature of CARTRIDGE specific
* for the base cartridge
* Copyright (C) 2005 Raphael Eidenbenz <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.
******************************************************************************)
(**
* This cartridge knows about the basic elements of UML class diagrams.
* The elements are classifiers, attributes, and operations with their
* parameters in terms of the Rep interface
*)
signature BASE_CARTRIDGE =
sig
include CARTRIDGE
(** returns the current classifier. *)
val curClassifier: environment -> Rep.Classifier option
(** returns the current attribute *)
val curAttribute: environment -> Rep.attribute option
(** returns the current operation *)
val curOperation: environment -> Rep.operation option
(** returns the current operation parameter *)
val curArgument : environment -> (string * Rep_OclType.OclType) option
end
(*****************************************************************************
* su4sml - a SecureUML repository for SML
*
* base_cartridge.sig - an extended signature of CARTRIDGE specific
* for the base cartridge
* Copyright (C) 2005 Raphael Eidenbenz <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.
******************************************************************************)
(**
* This cartridge knows about the basic elements of UML class diagrams.
* The elements are classifiers, attributes, and operations with their
* parameters in terms of the Rep interface
*)
signature BASE_CARTRIDGE =
sig
include CARTRIDGE
(** returns the current classifier. *)
val curClassifier: environment -> Rep.Classifier option
(** returns the current attribute *)
val curAttribute: environment -> Rep.attribute option
(** returns the current operation *)
val curOperation: environment -> Rep.operation option
(** returns the current operation parameter *)
val curArgument : environment -> (string * Rep_OclType.OclType) option
end

612
src/codegen/base_cartridge.sml
View File

@ -1,296 +1,316 @@
(*****************************************************************************
* su4sml - a SecureUML repository for SML
*
* simple.sml - a simple test file for the core repository
* Copyright (C) 2005 Raphael Eidenbenz <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.
******************************************************************************)
(**
* This cartridge knows about the basic elements of UML class diagrams.
* The elements are classifiers, attributes, and operations with their
* parameters in terms of the Rep interface
*)
signature BASE_CARTRIDGE =
sig
include CARTRIDGE
(** returns the current classifier. *)
val curClassifier: environment -> Rep.Classifier option
(** returns the current attribute *)
val curAttribute: environment -> Rep.attribute option
(** returns the current association end *)
val curAssociationEnd : environment -> Rep.associationend option
(** returns the current operation *)
val curOperation: environment -> Rep.operation option
(** returns the current operation parameter *)
val curArgument : environment -> (string * Rep_OclType.OclType) option
end
structure Base_Cartridge : BASE_CARTRIDGE =
struct
open library
(* translation functions *)
(* type translation table *)
fun oclType2Native t = Rep_OclType.string_of_OclType t
fun visibility2Native XMI.public = "public"
| visibility2Native XMI.private = "private"
| visibility2Native XMI.protected = "protected"
| visibility2Native XMI.package = "package"
fun scope2Native XMI.ClassifierScope = "ClassifierScope"
| scope2Native XMI.InstanceScope = "InstanceScope"
type Model = Rep.Classifier list
type environment = { model : Model,
counter : int ref,
curClassifier: Rep_Core.Classifier option,
curAssocEnd : Rep_Core.associationend option,
curOperation : Rep_Core.operation option,
curAttribute : Rep_Core.attribute option ,
curArgument : (string * Rep_OclType.OclType) option
}
(* service functions for other cartridges to have access to the current
* list items
*)
fun getModel (env : environment) = #model env
fun curClassifier (env : environment) = (#curClassifier env)
fun curAttribute (env : environment) = (#curAttribute env)
fun curAssociationEnd (env : environment) = (#curAssocEnd env)
fun curOperation (env : environment) = (#curOperation env)
fun curArgument (env : environment) = (#curArgument env)
fun curClassifier' (env : environment) = Option.valOf((#curClassifier env))
fun curAttribute' (env : environment) = Option.valOf((#curAttribute env))
fun curAssociationEnd' (env : environment) = Option.valOf((#curAssocEnd env))
fun curOperation' (env : environment) = Option.valOf((#curOperation env))
fun curArgument' (env : environment) = Option.valOf((#curArgument env))
fun initEnv model = { model = model,
counter = ref 0,
curClassifier = NONE,
curAssocEnd = NONE,
curOperation = NONE,
curAttribute = NONE,
curArgument = NONE } : environment
fun curClassifierPackageToString env p2sfun = (case (#curClassifier env) of
NONE => p2sfun
(Rep.package_of
(hd (#model env)))
| SOME c => p2sfun
(Rep.package_of
(curClassifier' env)))
(* FIX: check for NONEs in arguments environment *)
(**
* lookup base cartridge specific string-valued variables
* The base cartridge knows the following variables:
* classifier_name, classifier_package, classifier_parent,
* attribute_name, attribute_type, attribute_visibility,
* attribute_scope, operation_name, operation_result_type,
* operation_visibility, operation_scope, argument_name, argument_type
*)
fun lookup env "classifier_name" = Rep_Core.short_name_of (curClassifier' env)
| lookup env "classifier_package" = curClassifierPackageToString env Rep_OclType.string_of_path
| lookup env "classifier_package_path" = curClassifierPackageToString env Rep_OclType.pathstring_of_path
| lookup env "classifier_parent" = Rep_Core.short_parent_name_of (curClassifier' env)
| lookup env "attribute_name" = #name (curAttribute' env)
| lookup env "attribute_type" = oclType2Native (#attr_type
(curAttribute' env))
| lookup env "attribute_visibility" = visibility2Native(#visibility
(curAttribute' env))
| lookup env "attribute_scope" = scope2Native (#scope (curAttribute' env))
| lookup env "assocend_name" = (#name o valOf o #curAssocEnd) env
| lookup env "assocend_type" = (oclType2Native o #aend_type o valOf o #curAssocEnd) env
| lookup env "operation_name" = Rep.name_of_op (curOperation' env)
| lookup env "operation_result_type" = oclType2Native (Rep.result_of_op
(curOperation' env))
| lookup env "operation_visibility" = visibility2Native (#visibility
(curOperation' env))
| lookup env "operation_scope" = scope2Native (#scope (curOperation' env))
| lookup env "argument_name" = #1 (curArgument' env)
| lookup env "argument_type" = oclType2Native (#2 (curArgument' env))
| lookup env "counter" = Int.toString (!(#counter env))
| lookup env "counter_next" = ((#counter env) := !(#counter env)+1;
Int.toString (!(#counter env)))
| lookup _ s = (warn ("in Base_Cartridge.lookup: unknown variable \""^s^"\"."); "$"^s^"$")
(**
* evaluate base cartridge specific predicates.
* The base cartridge supports the following predicates:
* isClass, isInterface, isEnumeration, isPrimitive, hasParent,
* first_classifier, first_attribute, first_operation, first_argument,
* last_classifier, last_attribute, last_operation, last_argument,
* attribute_isPublic, attribute_isProtected, attribute_isPrivate,
* attribute_isPackage, attribute_isStatic, operation_isPublic,
* operation_isPrivate, operation_isProtected, operation_isPackage,
* operation_isStatic,
*)
fun test env "isClass" = (case (#curClassifier env) of
SOME (Rep.Class{...}) => true
| _ => false)
| test env "isInterface" = (case (#curClassifier env) of
SOME (Rep.Interface{...}) => true
| _ => false)
| test env "isEnumeration" = (case (#curClassifier env) of
SOME (Rep.Enumeration{...}) => true
| _ => false)
| test env "isPrimitive" = (case (#curClassifier env) of
SOME (Rep.Primitive{...}) => true
| _ => false)
| test env "hasParent" = let val parentName =
Rep_OclType.string_of_path
(Rep.parent_name_of (curClassifier' env))
in
(parentName <> "oclLib.OclAny")
end
| test env "hasOperations" = (length (Rep_Core.operations_of (curClassifier' env))) > 0
| test env "first_classifier" = (curClassifier' env = hd (#model env))
| test env "first_attribute" = (curAttribute' env
= hd (Rep_Core.attributes_of (curClassifier' env)))
| test env "first_operation" = (curOperation' env
= hd (Rep_Core.operations_of (curClassifier' env)))
| test env "first_argument" = (curArgument' env
= hd (Rep_Core.arguments_of_op (curOperation' env)))
| test env "last_classifier" = (curClassifier' env = List.last (#model env))
| test env "last_attribute" = (curAttribute' env =
List.last (Rep_Core.attributes_of
(curClassifier' env)))
| test env "last_operation" = (curOperation' env =
List.last (Rep_Core.operations_of
(curClassifier' env)))
| test env "last_argument" = (curArgument' env
= List.last (Rep_Core.arguments_of_op
(curOperation' env)))
| test env "attribute_isPublic" = ((#visibility (curAttribute' env)) = XMI.public)
| test env "attribute_isPrivate" = ((#visibility (curAttribute' env)) = XMI.private)
| test env "attribute_isProtected" = ((#visibility (curAttribute' env)) = XMI.protected)
| test env "attribute_isPackage" = ((#visibility (curAttribute' env)) = XMI.package)
| test env "attribute_isStatic" = ((#scope (curAttribute' env)) = XMI.ClassifierScope)
| test env "operation_isPublic" = ((#visibility (curOperation' env)) = XMI.public)
| test env "operation_isPrivate" = ((#visibility (curOperation' env)) = XMI.private)
| test env "operation_isProtected" = ((#visibility (curOperation' env)) = XMI.protected)
| test env "operation_isPackage" = ((#visibility (curOperation' env)) = XMI.package)
| test env "operation_isStatic" = ((#scope (curOperation' env)) = XMI.ClassifierScope)
| test env "operation_isQuery" = #isQuery (curOperation' env)
| test env s = error ("in Base_Cartridge.test: undefined predicate: \""^s^"\".")
(* fun foreach_classifier: environment -> environment list *)
fun foreach_classifier (env : environment)
= let val cl = (#model env)
fun env_from_classifier c = { model = #model env,
counter = #counter env,
curClassifier= SOME c,
curAssocEnd = NONE,
curOperation = NONE,
curAttribute = NONE,
curArgument = NONE }
in
List.map env_from_classifier cl
end
fun foreach_attribute (env : environment)
= let val attrs = Rep_Core.attributes_of (curClassifier' env)
fun env_from_attr a = { model = #model env,
counter = #counter env,
curClassifier = SOME (curClassifier' env),
curAssocEnd = NONE,
curOperation = NONE,
curAttribute = SOME a,
curArgument = NONE }
in
List.map env_from_attr attrs
end
fun foreach_operation (env : environment)
= let val ops = Rep_Core.operations_of (curClassifier' env)
fun env_from_op operation = { model = #model env,
counter = #counter env,
curClassifier = SOME (curClassifier' env),
curOperation = SOME operation,
curAssocEnd = NONE,
curAttribute = NONE,
curArgument = NONE }
in
List.map env_from_op ops
end
fun foreach_argument (env : environment)
= let val args = Rep_Core.arguments_of_op (curOperation' env)
fun env_from_argument arg = { model = #model env,
counter = #counter env,
curClassifier = SOME (curClassifier' env),
curOperation = SOME (curOperation' env),
curAssocEnd = NONE,
curAttribute = NONE,
curArgument = SOME arg }
in
List.map env_from_argument args
end
fun foreach_assocend (env : environment)
= let val aends = Rep_Core.associationends_of (curClassifier' env)
fun env_from_argument arg = { model = #model env,
counter = #counter env,
curClassifier = SOME (curClassifier' env),
curAssocEnd = SOME arg,
curOperation = NONE,
curAttribute = NONE,
curArgument = NONE }
in
List.map env_from_argument aends
end
(**
* compute the base cartridge specific lists.
* The base cartridge supports the following lists:
* classifier_list iterates over all classifiers of the model,
* attribute_list iterates over all attributes of the current
* classifier, operation_list iterates over all operations of the
* current classifier, argument_list iterates over all arguments of
* the current operation
*)
fun foreach "classifier_list" env = foreach_classifier env
| foreach "attribute_list" env = foreach_attribute env
| foreach "operation_list" env = foreach_operation env
| foreach "argument_list" env = foreach_argument env
| foreach "assocend_list" env = foreach_assocend env
(* hier muss man das Environment noch etwas umpacken
| foreach listType env = map (pack env)
(<SuperCartridge>.foreach name (unpack env))
*)
| foreach s _ = (error_msg ("in Base_Cartridge.foreach: unknown list \""^s^"\".");
[])
end
(*****************************************************************************
* su4sml - a SecureUML repository for SML
*
* simple.sml - a simple test file for the core repository
* Copyright (C) 2005 Raphael Eidenbenz <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.
******************************************************************************)
(**
* This cartridge knows about the basic elements of UML class diagrams.
* The elements are classifiers, attributes, and operations with their
* parameters in terms of the Rep interface
*)
signature BASE_CARTRIDGE =
sig
include CARTRIDGE
(** returns the current classifier. *)
val curClassifier: environment -> Rep.Classifier option
(** returns the current attribute *)
val curAttribute: environment -> Rep.attribute option
(** returns the current association end *)
val curAssociationEnd : environment -> Rep.associationend option
(** returns the current operation *)
val curOperation: environment -> Rep.operation option
(** returns the current operation parameter *)
val curArgument : environment -> (string * Rep_OclType.OclType) option
end
structure Base_Cartridge : BASE_CARTRIDGE =
struct
open library
(* translation functions *)
(* type translation table *)
fun oclType2Native t = Rep_OclType.string_of_OclType t
fun visibility2Native XMI.public = "public"
| visibility2Native XMI.private = "private"
| visibility2Native XMI.protected = "protected"
| visibility2Native XMI.package = "package"
fun scope2Native XMI.ClassifierScope = "ClassifierScope"
| scope2Native XMI.InstanceScope = "InstanceScope"
type Model = Rep.Classifier list
type environment = { model : Model,
counter : int ref,
curClassifier: Rep_Core.Classifier option,
curAssocEnd : Rep_Core.associationend option,
curOperation : Rep_Core.operation option,
curAttribute : Rep_Core.attribute option ,
curArgument : (string * Rep_OclType.OclType) option
}
(* service functions for other cartridges to have access to the current
* list items
*)
fun getModel (env : environment) = #model env
fun curClassifier (env : environment) = (#curClassifier env)
fun curAttribute (env : environment) = (#curAttribute env)
fun curAssociationEnd (env : environment) = (#curAssocEnd env)
fun curOperation (env : environment) = (#curOperation env)
fun curArgument (env : environment) = (#curArgument env)
fun curClassifier' (env : environment) = Option.valOf((#curClassifier env))
fun curAttribute' (env : environment) = Option.valOf((#curAttribute env))
fun curAssociationEnd' (env : environment) = Option.valOf((#curAssocEnd env))
fun curOperation' (env : environment) = Option.valOf((#curOperation env))
fun curArgument' (env : environment) = Option.valOf((#curArgument env))
fun initEnv model = { model = model,
counter = ref 0,
curClassifier = NONE,
curAssocEnd = NONE,
curOperation = NONE,
curAttribute = NONE,
curArgument = NONE } : environment
fun curClassifierPackageToString env p2sfun = (case (#curClassifier env) of
NONE => p2sfun
(Rep.package_of
(hd (#model env)))
| SOME c => p2sfun
(Rep.package_of
(curClassifier' env)))
(* FIX: check for NONEs in arguments environment *)
(**
* lookup base cartridge specific string-valued variables
* The base cartridge knows the following variables:
* classifier_name, classifier_package, classifier_parent,
* attribute_name, attribute_type, attribute_visibility,
* attribute_scope, operation_name, operation_result_type,
* operation_visibility, operation_scope, argument_name, argument_type
*)
fun lookup env "classifier_name" = Rep_Core.short_name_of (curClassifier' env)
| lookup env "classifier_package" = curClassifierPackageToString env Rep_OclType.string_of_path
| lookup env "classifier_package_path" = curClassifierPackageToString env Rep_OclType.pathstring_of_path
| lookup env "classifier_parent" = Rep_Core.short_parent_name_of (curClassifier' env)
| lookup env "attribute_name" = #name (curAttribute' env)
| lookup env "attribute_type" = oclType2Native (#attr_type
(curAttribute' env))
| lookup env "attribute_visibility" = visibility2Native(#visibility
(curAttribute' env))
| lookup env "attribute_scope" = scope2Native (#scope (curAttribute' env))
| lookup env "assocend_name" = (#name o valOf o #curAssocEnd) env
| lookup env "assocend_type" = (oclType2Native o #aend_type o valOf o #curAssocEnd) env
| lookup env "operation_name" = Rep.name_of_op (curOperation' env)
| lookup env "operation_result_type" = oclType2Native (Rep.result_of_op
(curOperation' env))
| lookup env "operation_visibility" = visibility2Native (#visibility
(curOperation' env))
| lookup env "operation_scope" = scope2Native (#scope (curOperation' env))
| lookup env "argument_name" = #1 (curArgument' env)
| lookup env "argument_type" = oclType2Native (#2 (curArgument' env))
| lookup env "counter" = Int.toString (!(#counter env))
| lookup env "counter_next" = ((#counter env) := !(#counter env)+1;
Int.toString (!(#counter env)))
| lookup _ s = (warn ("in Base_Cartridge.lookup: unknown variable \""^s^"\"."); "$"^s^"$")
(**
* evaluate base cartridge specific predicates.
* The base cartridge supports the following predicates:
* isClass, isInterface, isEnumeration, isPrimitive, hasParent,
* first_classifier, first_attribute, first_operation, first_argument,
* last_classifier, last_attribute, last_operation, last_argument,
* attribute_isPublic, attribute_isProtected, attribute_isPrivate,
* attribute_isPackage, attribute_isStatic, operation_isPublic,
* operation_isPrivate, operation_isProtected, operation_isPackage,
* operation_isStatic,
*)
fun test env "isClass" = (case (#curClassifier env) of
SOME (Rep.Class{...}) => true
| _ => false)
| test env "notClass" = not (test env "isClass")
| test env "isInterface" = (case (#curClassifier env) of
SOME (Rep.Interface{...}) => true
| _ => false)
| test env "notInterface" = not (test env "isInterface")
| test env "isEnumeration" = (case (#curClassifier env) of
SOME (Rep.Enumeration{...}) => true
| _ => false)
| test env "isPrimitive" = (case (#curClassifier env) of
SOME (Rep.Primitive{...}) => true
| _ => false)
| test env "hasParent" = let val parentName =
Rep_OclType.string_of_path
(Rep.parent_name_of (curClassifier' env))
in
(parentName <> "oclLib.OclAny")
end
| test env "hasOperations" = (length (Rep_Core.operations_of (curClassifier' env))) > 0
| test env "first_classifier" = (curClassifier' env = hd (#model env))
| test env "first_attribute" = (curAttribute' env
= hd (Rep_Core.attributes_of (curClassifier' env)))
| test env "first_operation" = (curOperation' env
= hd (Rep_Core.operations_of (curClassifier' env)))
| test env "first_argument" = (curArgument' env
= hd (Rep_Core.arguments_of_op (curOperation' env)))
| test env "last_classifier" = (curClassifier' env = List.last (#model env))
| test env "last_attribute" = (curAttribute' env =
List.last (Rep_Core.attributes_of
(curClassifier' env)))
| test env "last_operation" = (curOperation' env =
List.last (Rep_Core.operations_of
(curClassifier' env)))
| test env "last_argument" = (curArgument' env
= List.last (Rep_Core.arguments_of_op
(curOperation' env)))
| test env "attribute_isPublic" = ((#visibility (curAttribute' env)) = XMI.public)
| test env "attribute_isPrivate" = ((#visibility (curAttribute' env)) = XMI.private)
| test env "attribute_isProtected" = ((#visibility (curAttribute' env)) = XMI.protected)
| test env "attribute_isPackage" = ((#visibility (curAttribute' env)) = XMI.package)
| test env "attribute_isStatic" = ((#scope (curAttribute' env)) = XMI.ClassifierScope)
| test env "operation_isPublic" = ((#visibility (curOperation' env)) = XMI.public)
| test env "operation_isPrivate" = ((#visibility (curOperation' env)) = XMI.private)
| test env "operation_isProtected" = ((#visibility (curOperation' env)) = XMI.protected)
| test env "operation_isPackage" = ((#visibility (curOperation' env)) = XMI.package)
| test env "operation_isStatic" = ((#scope (curOperation' env)) = XMI.ClassifierScope)
| test env "operation_isQuery" = #isQuery (curOperation' env)
| test env s = error ("in Base_Cartridge.test: undefined predicate: \""^s^"\".")
(* fun foreach_classifier: environment -> environment list *)
fun foreach_classifier (env : environment)
= let val cl = (#model env)
fun env_from_classifier c = { model = #model env,
counter = #counter env,
curClassifier= SOME c,
curAssocEnd = NONE,
curOperation = NONE,
curAttribute = NONE,
curArgument = NONE }
in
List.map env_from_classifier cl
end
(* Only iterate over non-primitive classifiers such as Class, Interface, Enum *)
fun foreach_nonprimitive_classifier (env : environment)
= let val cl = List.filter (fn cenv => (case cenv of
Rep.Primitive{...} => false
| _ => true)) (#model env)
fun env_from_classifier c = { model = (#model env),
counter = #counter env,
curClassifier = SOME c,
curAssocEnd = NONE,
curOperation = NONE,
curAttribute = NONE,
curArgument = NONE }
in
List.map env_from_classifier cl
end
fun foreach_attribute (env : environment)
= let val attrs = Rep_Core.attributes_of (curClassifier' env)
fun env_from_attr a = { model = #model env,
counter = #counter env,
curClassifier = SOME (curClassifier' env),
curAssocEnd = NONE,
curOperation = NONE,
curAttribute = SOME a,
curArgument = NONE }
in
List.map env_from_attr attrs
end
fun foreach_operation (env : environment)
= let val ops = Rep_Core.operations_of (curClassifier' env)
fun env_from_op operation = { model = #model env,
counter = #counter env,
curClassifier = SOME (curClassifier' env),
curOperation = SOME operation,
curAssocEnd = NONE,
curAttribute = NONE,
curArgument = NONE }
in
List.map env_from_op ops
end
fun foreach_argument (env : environment)
= let val args = Rep_Core.arguments_of_op (curOperation' env)
fun env_from_argument arg = { model = #model env,
counter = #counter env,
curClassifier = SOME (curClassifier' env),
curOperation = SOME (curOperation' env),
curAssocEnd = NONE,
curAttribute = NONE,
curArgument = SOME arg }
in
List.map env_from_argument args
end
fun foreach_assocend (env : environment)
= let val aends = Rep_Core.associationends_of (curClassifier' env)
fun env_from_argument arg = { model = #model env,
counter = #counter env,
curClassifier = SOME (curClassifier' env),
curAssocEnd = SOME arg,
curOperation = NONE,
curAttribute = NONE,
curArgument = NONE }
in
List.map env_from_argument aends
end
(**
* compute the base cartridge specific lists.
* The base cartridge supports the following lists:
* classifier_list iterates over all classifiers of the model,
* attribute_list iterates over all attributes of the current
* classifier, operation_list iterates over all operations of the
* current classifier, argument_list iterates over all arguments of
* the current operation
*)
fun foreach "classifier_list" env = foreach_classifier env
| foreach "attribute_list" env = foreach_attribute env
| foreach "operation_list" env = foreach_operation env
| foreach "argument_list" env = foreach_argument env
| foreach "nonprimitive_classifier_list" env = foreach_nonprimitive_classifier env
| foreach "assocend_list" env = foreach_assocend env
(* hier muss man das Environment noch etwas umpacken
| foreach listType env = map (pack env)
(<SuperCartridge>.foreach name (unpack env))
*)
| foreach s _ = (error_msg ("in Base_Cartridge.foreach: unknown list \""^s^"\".");
[])
end

204
src/codegen/c#_cartridge.sml
View File

@ -1,102 +1,102 @@
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* c#_catridge.sml - a cartridge to gcg_core for C# .NET 2.0
* Copyright (C) 2005 Raphael Eidenbenz <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 : BASE_CARTRIDGE) : BASE_CARTRIDGE =
struct
open Rep_OclType
type Model = SuperCart.Model
type environment = { extension : SuperCart.environment }
(* fun getModel (env:environment) = SuperCart.getModel (#extension env)*)
fun initEnv model = { extension = SuperCart.initEnv model } : environment
fun unpack (env : environment) = #extension env
fun pack superEnv = {extension = superEnv} : environment
fun curClassifier env = SuperCart.curClassifier (unpack env)
fun curArgument env = SuperCart.curArgument (unpack env)
fun curOperation env = SuperCart.curOperation (unpack env)
fun curAttribute env = SuperCart.curAttribute (unpack env)
fun curAssociationEnd env = SuperCart.curAssociationEnd (unpack env)
(* internal translation table *)
fun super2Native "ClassifierScope" = "static"
| super2Native "InstanceScope" = ""
| super2Native "package" = "public"
| super2Native "Integer" = "int"
| super2Native "Real" = "double"
| super2Native "String" = "string"
| super2Native "Boolean" = "bool"
| super2Native "OclVoid" = "void"
| super2Native s = ( if ((String.extract (s,0,SOME 8)) = "Sequence")
then (super2Native (String.substring(s,9,size s -10)))^"[]"
else if ((String.extract (s,0,SOME 3)) = "Set")
then "System.Collections.Generic.List<"
^(super2Native (String.substring(s,4,size s - 5)))^">"
(*else (gcg_warning ("Couldn't lookup \""^s^
"\" in c#_cartridge.super2Native !"); s)
*)
else s
)
handle Subscript =>
(*(gcg_warning ("Couldn't lookup \""^s^"\" in c#_cartridge.super2Native !");s)*)
s
(* lookup environment -> string -> string
* overrides some lookup entries of the base cartridge
*)
fun lookup (env : environment) "attribute_name_small_letter"
= StringHandling.uncapitalize (SuperCart.lookup (unpack env) "attribute_name")
| lookup (env : environment) "attribute_name_capital"
= StringHandling.capitalize (SuperCart.lookup (unpack env) "attribute_name")
| lookup (env : environment) (s as "attribute_type") = super2Native (SuperCart.lookup (unpack env) s )
| lookup (env : environment) (s as "attribute_visibility")= super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "attribute_scope") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_result_type")=super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_visibility")= super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_scope") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "argument_type") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) s = SuperCart.lookup (unpack env) s
fun test (env : environment) s = SuperCart.test (unpack env) s
(* no further functionality to add
* just unpack the Supercartridge's environment,
* pass it to SuperCart.foreach, get back a SuperCart.environment list
* pack every item into a native environment
*)
fun foreach listType (env : environment)
= map pack (SuperCart.foreach listType (unpack env))
end
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* c#_catridge.sml - a cartridge to gcg_core for C# .NET 2.0
* Copyright (C) 2005 Raphael Eidenbenz <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 : BASE_CARTRIDGE) : BASE_CARTRIDGE =
struct
open Rep_OclType
type Model = SuperCart.Model
type environment = { extension : SuperCart.environment }
(* fun getModel (env:environment) = SuperCart.getModel (#extension env)*)
fun initEnv model = { extension = SuperCart.initEnv model } : environment
fun unpack (env : environment) = #extension env
fun pack superEnv = {extension = superEnv} : environment
fun curClassifier env = SuperCart.curClassifier (unpack env)
fun curArgument env = SuperCart.curArgument (unpack env)
fun curOperation env = SuperCart.curOperation (unpack env)
fun curAttribute env = SuperCart.curAttribute (unpack env)
fun curAssociationEnd env = SuperCart.curAssociationEnd (unpack env)
(* internal translation table *)
fun super2Native "ClassifierScope" = "static"
| super2Native "InstanceScope" = ""
| super2Native "package" = "public"
| super2Native "Integer" = "int"
| super2Native "Real" = "double"
| super2Native "String" = "string"
| super2Native "Boolean" = "bool"
| super2Native "OclVoid" = "void"
| super2Native s = ( if ((String.extract (s,0,SOME 8)) = "Sequence")
then (super2Native (String.substring(s,9,size s -10)))^"[]"
else if ((String.extract (s,0,SOME 3)) = "Set")
then "System.Collections.Generic.List<"
^(super2Native (String.substring(s,4,size s - 5)))^">"
(*else (gcg_warning ("Couldn't lookup \""^s^
"\" in c#_cartridge.super2Native !"); s)
*)
else s
)
handle Subscript =>
(*(gcg_warning ("Couldn't lookup \""^s^"\" in c#_cartridge.super2Native !");s)*)
s
(* lookup environment -> string -> string
* overrides some lookup entries of the base cartridge
*)
fun lookup (env : environment) "attribute_name_small_letter"
= StringHandling.uncapitalize (SuperCart.lookup (unpack env) "attribute_name")
| lookup (env : environment) "attribute_name_capital"
= StringHandling.capitalize (SuperCart.lookup (unpack env) "attribute_name")
| lookup (env : environment) (s as "attribute_type") = super2Native (SuperCart.lookup (unpack env) s )
| lookup (env : environment) (s as "attribute_visibility")= super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "attribute_scope") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_result_type")=super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_visibility")= super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_scope") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "argument_type") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) s = SuperCart.lookup (unpack env) s
fun test (env : environment) s = SuperCart.test (unpack env) s
(* no further functionality to add
* just unpack the Supercartridge's environment,
* pass it to SuperCart.foreach, get back a SuperCart.environment list
* pack every item into a native environment
*)
fun foreach listType (env : environment)
= map pack (SuperCart.foreach listType (unpack env))
end

206
src/codegen/c#_net1_cartridge.sml
View File

@ -1,103 +1,103 @@
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* c#_catridge.sml - a cartridge to gcg_core for C# .NET 1.x
* Copyright (C) 2005 Raphael Eidenbenz <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 }
type Model = SuperCart.Model
fun initEnv model = { extension = SuperCart.initEnv model } : environment
fun unpack (env : environment) = #extension env
fun pack superEnv = {extension = superEnv} : environment
(* fun getModel (env:environment) = SuperCart.getModel (unpack env)*)
(* internal translation table *)
fun super2Native "ClassifierScope" = "static"
| super2Native "InstanceScope" = ""
| super2Native "package" = "public"
| super2Native "Integer" = "int"
| super2Native "Real" = "double"
| super2Native "String" = "string"
| super2Native "Boolean" = "bool"
| super2Native "OclVoid" = "void"
| super2Native s = ( if ((String.extract (s,0,SOME 8)) = "Sequence")
then (super2Native (String.substring(s,9,size s -10)))^"[]"
else if ((String.extract (s,0,SOME 3)) = "Set")
then "System.Collections.ArrayList"
(*else (gcg_warning ("Couldn't lookup \""^s^
"\" in c#_cartridge.super2Native !"); s)
*)
else s
)
handle Subscript =>
(*(gcg_warning ("Couldn't lookup \""^s^"\" in c#_cartridge.super2Native !");s)*)
s
fun startWithSmallLetter s = let val sl = String.explode s
in
String.implode ((Char.toLower (hd sl))::(tl sl))
end
fun startWithCapital s = let val sl = String.explode s
in
String.implode ((Char.toUpper (hd sl))::(tl sl))
end
(* lookup environment -> string -> string
* overrides some lookup entries of the base cartridge
*)
fun lookup (env : environment) "attribute_name_small_letter"
= startWithSmallLetter (SuperCart.lookup (unpack env) "attribute_name")
| lookup (env : environment) "attribute_name_capital"
= startWithCapital (SuperCart.lookup (unpack env) "attribute_name")
| lookup (env : environment) (s as "attribute_type") = super2Native (SuperCart.lookup (unpack env) s )
| lookup (env : environment) (s as "attribute_visibility")= super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "attribute_scope") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_result_type")=super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_visibility")= super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_scope") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "argument_type") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) s = SuperCart.lookup (unpack env) s
fun test env s = SuperCart.test (unpack env) s
(* no further functionality to add
* just unpack the Supercartridge's environment,
* pass it to SuperCart.foreach, get back a SuperCart.environment list
* pack every item into a native environment
*)
fun foreach listType (env : environment)
= map pack (SuperCart.foreach listType (unpack env))
end
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* c#_catridge.sml - a cartridge to gcg_core for C# .NET 1.x
* Copyright (C) 2005 Raphael Eidenbenz <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 }
type Model = SuperCart.Model
fun initEnv model = { extension = SuperCart.initEnv model } : environment
fun unpack (env : environment) = #extension env
fun pack superEnv = {extension = superEnv} : environment
(* fun getModel (env:environment) = SuperCart.getModel (unpack env)*)
(* internal translation table *)
fun super2Native "ClassifierScope" = "static"
| super2Native "InstanceScope" = ""
| super2Native "package" = "public"
| super2Native "Integer" = "int"
| super2Native "Real" = "double"
| super2Native "String" = "string"
| super2Native "Boolean" = "bool"
| super2Native "OclVoid" = "void"
| super2Native s = ( if ((String.extract (s,0,SOME 8)) = "Sequence")
then (super2Native (String.substring(s,9,size s -10)))^"[]"
else if ((String.extract (s,0,SOME 3)) = "Set")
then "System.Collections.ArrayList"
(*else (gcg_warning ("Couldn't lookup \""^s^
"\" in c#_cartridge.super2Native !"); s)
*)
else s
)
handle Subscript =>
(*(gcg_warning ("Couldn't lookup \""^s^"\" in c#_cartridge.super2Native !");s)*)
s
fun startWithSmallLetter s = let val sl = String.explode s
in
String.implode ((Char.toLower (hd sl))::(tl sl))
end
fun startWithCapital s = let val sl = String.explode s
in
String.implode ((Char.toUpper (hd sl))::(tl sl))
end
(* lookup environment -> string -> string
* overrides some lookup entries of the base cartridge
*)
fun lookup (env : environment) "attribute_name_small_letter"
= startWithSmallLetter (SuperCart.lookup (unpack env) "attribute_name")
| lookup (env : environment) "attribute_name_capital"
= startWithCapital (SuperCart.lookup (unpack env) "attribute_name")
| lookup (env : environment) (s as "attribute_type") = super2Native (SuperCart.lookup (unpack env) s )
| lookup (env : environment) (s as "attribute_visibility")= super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "attribute_scope") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_result_type")=super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_visibility")= super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_scope") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "argument_type") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) s = SuperCart.lookup (unpack env) s
fun test env s = SuperCart.test (unpack env) s
(* no further functionality to add
* just unpack the Supercartridge's environment,
* pass it to SuperCart.foreach, get back a SuperCart.environment list
* pack every item into a native environment
*)
fun foreach listType (env : environment)
= map pack (SuperCart.foreach listType (unpack env))
end

522
src/codegen/c#sm_cartridge.sml
View File

@ -1,261 +1,261 @@
(*****************************************************************************************)
(* su4sml - State Machine generator (SMG) *)
(* based upon GCG *)
(* *)
(* c#sm_cartridge.sml - implementation of the Statechart->StateMachine cartridge. *)
(* *)
(* Copyright (C) 2005 by Rolf Simon Adelsberger (RSA) *)
(* <rsa@student.ethz.ch> *)
(* *)
(* This file is part of the StateMachine cartridge for su4sml *)
(* *)
(* su4sml is free software; you can redistribute it and/or modify it under *)
(* the terms of the GNU General Public License as published by the Free *)
(* Software Foundation; either version 2 of the License, or (at your option) *)
(* any later version. *)
(* *)
(* su4sml is distributed in the hope that it will be useful, but WITHOUT ANY *)
(* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *)
(* FOR A PARTICULAR PURPOSE. See the GNU General Public License for more *)
(* details. *)
(* *)
(* You should have received a copy of the GNU General Public License along *)
(* with this program; if not, write to the Free Software Foundation, Inc., *)
(* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
(*****************************************************************************************)
(* use "stateMachine.sml"; *)
functor CSSM_Cartridge(SuperCart : BASE_CARTRIDGE) : CARTRIDGE =
struct
open Rep_OclType
open Rep_StateMachine
open Gcg_Helper
(* open Rep_SecureUML_ComponentUML.Security*)
open ComponentUML
open SM_Helper
open StateMachineTypes
open StringHandling
open StateMachine
val emptySM_Trans = { trans_id="",
source = "",
target = "",
guards = [],
triggers = [],
effects = []
}:SM_Trans
type environment = {
curState : StateVertex,
allTransitions: SM_Trans list,
curTransition : (SM_Trans*int),
curEvent: Event,
curGuard: (Guard*int),
curEffect: Procedure,
extension : SuperCart.environment
}
fun initEnv model = {
curState = emptyState,
allTransitions = [],
curTransition = (emptySM_Trans,0),
curEvent = emptyEvent,
curGuard = (emptyGuard,0),
curEffect = emptyEffect,
extension = SuperCart.initEnv model
} : environment
(* unpack : environment -> SuperCart.environment *)
fun unpack (env:environment) = #extension env
(* pack : environment -> SuperCart.environment -> environment *)
fun pack (env: environment) (new_env : SuperCart.environment) = {
curState = #curState env,
allTransitions = #allTransitions env,
curTransition = #curTransition env,
curEvent = #curEvent env,
curGuard = #curGuard env,
curEffect = #curEffect env,
extension=new_env
}
(* fun getModel env = SuperCart.getModel (unpack env) *)
(*
* lookup environment -> string -> string
* might override some lookup entries of the base cartridge
*)
fun lookup (env : environment) "state_name" = toUpper(name_of_state(#curState env))
| lookup (env : environment) "state_ident" = id_of_state(#curState env)
| lookup (env : environment) "final_state_name" = toUpper(id_of_state(FinalState(states_of_classif(Option.valOf(SuperCart.curClassifier (unpack env))))))
| lookup (env : environment) "transition_target" = target_of_SM_Trans(#1(#curTransition env))
| lookup (env : environment) "guard_ident" = ident_of_guard(#1(#curGuard env))
| lookup (env : environment) "event_name" = toUpper(name_of_event(#curEvent env))
| lookup (env : environment) "cur_event_id" = toUpper(name_of_event(#curEvent env))
| lookup (env : environment) "effect_ident" = #proc_id (#curEffect env)
| lookup (env : environment) "trigger_name" = name_of_event(#curEvent env)
| lookup (env : environment) "real_init" = id_of_state(realInit(Option.valOf(SuperCart.curClassifier (unpack env))))
| lookup (env : environment) s = SuperCart.lookup (unpack env) s
fun evalCondition (env : environment) "hasAG" = hasAG(Option.valOf(SuperCart.curClassifier (unpack env)))
| evalCondition (env : environment) "isTrigger" = let val Transitions = transitions_of_classif(Option.valOf(SuperCart.curClassifier (unpack env)))
val oper = Option.valOf(SuperCart.curOperation (unpack env))
in
acts_as_trigger oper Transitions
end
| evalCondition (env : environment) "isLastGuard" = (#2(#curGuard env)) = 0
| evalCondition (env : environment) "isLastTrans" = (#2(#curTransition env)) = 0
(* | evalCondition (env : environment) "isStart" = is_StartState(#curState env)*)
(* pass unknown condition types to Superior Cartridge *)
| evalCondition (env : environment) s = SuperCart.test (unpack env) s
val test = evalCondition
fun foreach_event(env: environment) = let val eventList = events_of_classif(Option.valOf(SuperCart.curClassifier (unpack env)))
fun env_from_ev X = {
curState = #curState env,
allTransitions = #allTransitions env,
curTransition = (emptySM_Trans,0),
curEvent = X,
curGuard = (emptyGuard,0),
curEffect = emptyEffect,
extension = #extension env
}
in
List.map env_from_ev eventList
end
fun foreach_events_of_state(env: environment) = let val TL = (#allTransitions env)
val SL = states_of_classif(Option.valOf(SuperCart.curClassifier (unpack env)))
val EVTList = events_of_state((#curState env), ref TL, ref SL)
fun env_from_EoS evt =
{
curEvent = evt,
curGuard = (emptyGuard,0),
curState = #curState env,
allTransitions = #allTransitions env,
curTransition = #curTransition env,
curEffect = emptyEffect,
extension = #extension env
}
in
List.map env_from_EoS EVTList
end
fun foreach_state(env: environment) = let val stateList = states_of_classif(Option.valOf(SuperCart.curClassifier (unpack env)))
val realStates = List.filter (fn X => not(isPseudo(X))) stateList
fun env_from_state X = {
curState = X,
allTransitions = #allTransitions env,
curTransition = (emptySM_Trans,0),
curEvent = #curEvent env,
curGuard = (emptyGuard,0),
curEffect = emptyEffect,
extension = #extension env
}
in
List.map env_from_state realStates
end
fun foreach_classifier (env : environment)
= let val envL = SuperCart.foreach "classifier_list" (unpack env)
fun env_from_classifier e =
{
curState = emptyState,
allTransitions = SM_Trans_of_classif(Option.valOf(SuperCart.curClassifier(e))),(* NOTE: here the SM_Trans are calculated *)
curTransition = (emptySM_Trans,0),
curEvent = (#curEvent env),
curGuard = (emptyGuard,0),
curEffect = emptyEffect,
extension = e
}
in
List.map env_from_classifier envL
end
fun foreach_transition(env: environment) = let val TransL = next_SM_Trans_4EV((#curState env),ref (#allTransitions env), (#curEvent env))
val LEN = List.length(TransL)
fun env_from_TL T = {
curState = #curState env,
allTransitions = #allTransitions env,
curTransition = T,
curEvent = #curEvent env,
curGuard = (emptyGuard,0),
curEffect = emptyEffect,
extension = #extension env
}
fun transform([],_) = []
| transform(h::t,n) = (h,n)::transform(t,(n-1))
in
List.map env_from_TL (transform((sort_SM_TransL_withGAtEnd(TransL,lastGuard)),(LEN-1)))
end
fun foreach_guard(env: environment) = let val GL = guards_of_SM_Trans(#1(#curTransition env))
fun env_from_GL G = {
curState = #curState env,
allTransitions = #allTransitions env,
curTransition = #curTransition env,
curEvent = #curEvent env,
curGuard = G,
curEffect = emptyEffect,
extension = #extension env
}
val LEN = List.length(GL)
fun transform([],_) = []
| transform(h::t,n) = (h,n)::transform(t,(n-1))
in
List.map env_from_GL (transform(GL,(LEN-1)))
end
fun all_guards(env: environment) = let val AGL = makeDistinct(List.concat (List.map guards_of_SM_Trans (#allTransitions env)))
fun env_from_GL G = {
curState = #curState env,
allTransitions = #allTransitions env,
curTransition = #curTransition env,
curEvent = #curEvent env,
curGuard = G,
curEffect = emptyEffect,
extension = #extension env
}
val LEN = List.length(AGL)
fun transform([],_) = []
| transform(h::t,n) = (h,n)::transform(t,(n-1))
in
List.map env_from_GL (transform(AGL,(LEN-1)))
end
fun foreach_effect(env: environment) = let val EffL = effects_of_SM_Trans(#1(#curTransition env))
fun env_from_EffL E = {
curState = #curState env,
allTransitions = #allTransitions env,
curTransition = #curTransition env,
curEvent = #curEvent env,
curEffect = E,
curGuard = #curGuard env,
extension = #extension env
}
in
List.map env_from_EffL EffL
end
fun foreach "event_list" env = foreach_event env
| foreach "state_list" env = foreach_state env
| foreach "transition_list" env = foreach_transition env
| foreach "guard_of_trans_list" env = foreach_guard env
| foreach "guard_list" env = all_guards env
| foreach "effect_list" env = foreach_effect env
| foreach "events_of_state" env = foreach_events_of_state env
| foreach (LT as "classifier_list") env = ListPair.map (uncurry pack) ((foreach_classifier env), (SuperCart.foreach LT (unpack env)))
| foreach L (env:environment) = map (pack env) (SuperCart.foreach L (unpack env))
end
(*****************************************************************************************)
(* su4sml - State Machine generator (SMG) *)
(* based upon GCG *)
(* *)
(* c#sm_cartridge.sml - implementation of the Statechart->StateMachine cartridge. *)
(* *)
(* Copyright (C) 2005 by Rolf Simon Adelsberger (RSA) *)
(* <rsa@student.ethz.ch> *)
(* *)
(* This file is part of the StateMachine cartridge for su4sml *)
(* *)
(* su4sml is free software; you can redistribute it and/or modify it under *)
(* the terms of the GNU General Public License as published by the Free *)
(* Software Foundation; either version 2 of the License, or (at your option) *)
(* any later version. *)
(* *)
(* su4sml is distributed in the hope that it will be useful, but WITHOUT ANY *)
(* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *)
(* FOR A PARTICULAR PURPOSE. See the GNU General Public License for more *)
(* details. *)
(* *)
(* You should have received a copy of the GNU General Public License along *)
(* with this program; if not, write to the Free Software Foundation, Inc., *)
(* 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
(*****************************************************************************************)
(* use "stateMachine.sml"; *)
functor CSSM_Cartridge(SuperCart : BASE_CARTRIDGE) : CARTRIDGE =
struct
open Rep_OclType
open Rep_StateMachine
open Gcg_Helper
(* open Rep_SecureUML_ComponentUML.Security*)
open ComponentUML
open SM_Helper
open StateMachineTypes
open StringHandling
open StateMachine
val emptySM_Trans = { trans_id="",
source = "",
target = "",
guards = [],
triggers = [],
effects = []
}:SM_Trans
type environment = {
curState : StateVertex,
allTransitions: SM_Trans list,
curTransition : (SM_Trans*int),
curEvent: Event,
curGuard: (Guard*int),
curEffect: Procedure,
extension : SuperCart.environment
}
fun initEnv model = {
curState = emptyState,
allTransitions = [],
curTransition = (emptySM_Trans,0),
curEvent = emptyEvent,
curGuard = (emptyGuard,0),
curEffect = emptyEffect,
extension = SuperCart.initEnv model
} : environment
(* unpack : environment -> SuperCart.environment *)
fun unpack (env:environment) = #extension env
(* pack : environment -> SuperCart.environment -> environment *)
fun pack (env: environment) (new_env : SuperCart.environment) = {
curState = #curState env,
allTransitions = #allTransitions env,
curTransition = #curTransition env,
curEvent = #curEvent env,
curGuard = #curGuard env,
curEffect = #curEffect env,
extension=new_env
}
(* fun getModel env = SuperCart.getModel (unpack env) *)
(*
* lookup environment -> string -> string
* might override some lookup entries of the base cartridge
*)
fun lookup (env : environment) "state_name" = toUpper(name_of_state(#curState env))
| lookup (env : environment) "state_ident" = id_of_state(#curState env)
| lookup (env : environment) "final_state_name" = toUpper(id_of_state(FinalState(states_of_classif(Option.valOf(SuperCart.curClassifier (unpack env))))))
| lookup (env : environment) "transition_target" = target_of_SM_Trans(#1(#curTransition env))
| lookup (env : environment) "guard_ident" = ident_of_guard(#1(#curGuard env))
| lookup (env : environment) "event_name" = toUpper(name_of_event(#curEvent env))
| lookup (env : environment) "cur_event_id" = toUpper(name_of_event(#curEvent env))
| lookup (env : environment) "effect_ident" = #proc_id (#curEffect env)
| lookup (env : environment) "trigger_name" = name_of_event(#curEvent env)
| lookup (env : environment) "real_init" = id_of_state(realInit(Option.valOf(SuperCart.curClassifier (unpack env))))
| lookup (env : environment) s = SuperCart.lookup (unpack env) s
fun evalCondition (env : environment) "hasAG" = hasAG(Option.valOf(SuperCart.curClassifier (unpack env)))
| evalCondition (env : environment) "isTrigger" = let val Transitions = transitions_of_classif(Option.valOf(SuperCart.curClassifier (unpack env)))
val oper = Option.valOf(SuperCart.curOperation (unpack env))
in
acts_as_trigger oper Transitions
end
| evalCondition (env : environment) "isLastGuard" = (#2(#curGuard env)) = 0
| evalCondition (env : environment) "isLastTrans" = (#2(#curTransition env)) = 0
(* | evalCondition (env : environment) "isStart" = is_StartState(#curState env)*)
(* pass unknown condition types to Superior Cartridge *)
| evalCondition (env : environment) s = SuperCart.test (unpack env) s
val test = evalCondition
fun foreach_event(env: environment) = let val eventList = events_of_classif(Option.valOf(SuperCart.curClassifier (unpack env)))
fun env_from_ev X = {
curState = #curState env,
allTransitions = #allTransitions env,
curTransition = (emptySM_Trans,0),
curEvent = X,
curGuard = (emptyGuard,0),
curEffect = emptyEffect,
extension = #extension env
}
in
List.map env_from_ev eventList
end
fun foreach_events_of_state(env: environment) = let val TL = (#allTransitions env)
val SL = states_of_classif(Option.valOf(SuperCart.curClassifier (unpack env)))
val EVTList = events_of_state((#curState env), ref TL, ref SL)
fun env_from_EoS evt =
{
curEvent = evt,
curGuard = (emptyGuard,0),
curState = #curState env,
allTransitions = #allTransitions env,
curTransition = #curTransition env,
curEffect = emptyEffect,
extension = #extension env
}
in
List.map env_from_EoS EVTList
end
fun foreach_state(env: environment) = let val stateList = states_of_classif(Option.valOf(SuperCart.curClassifier (unpack env)))
val realStates = List.filter (fn X => not(isPseudo(X))) stateList
fun env_from_state X = {
curState = X,
allTransitions = #allTransitions env,
curTransition = (emptySM_Trans,0),
curEvent = #curEvent env,
curGuard = (emptyGuard,0),
curEffect = emptyEffect,
extension = #extension env
}
in
List.map env_from_state realStates
end
fun foreach_classifier (env : environment)
= let val envL = SuperCart.foreach "classifier_list" (unpack env)
fun env_from_classifier e =
{
curState = emptyState,
allTransitions = SM_Trans_of_classif(Option.valOf(SuperCart.curClassifier(e))),(* NOTE: here the SM_Trans are calculated *)
curTransition = (emptySM_Trans,0),
curEvent = (#curEvent env),
curGuard = (emptyGuard,0),
curEffect = emptyEffect,
extension = e
}
in
List.map env_from_classifier envL
end
fun foreach_transition(env: environment) = let val TransL = next_SM_Trans_4EV((#curState env),ref (#allTransitions env), (#curEvent env))
val LEN = List.length(TransL)
fun env_from_TL T = {
curState = #curState env,
allTransitions = #allTransitions env,
curTransition = T,
curEvent = #curEvent env,
curGuard = (emptyGuard,0),
curEffect = emptyEffect,
extension = #extension env
}
fun transform([],_) = []
| transform(h::t,n) = (h,n)::transform(t,(n-1))
in
List.map env_from_TL (transform((sort_SM_TransL_withGAtEnd(TransL,lastGuard)),(LEN-1)))
end
fun foreach_guard(env: environment) = let val GL = guards_of_SM_Trans(#1(#curTransition env))
fun env_from_GL G = {
curState = #curState env,
allTransitions = #allTransitions env,
curTransition = #curTransition env,
curEvent = #curEvent env,
curGuard = G,
curEffect = emptyEffect,
extension = #extension env
}
val LEN = List.length(GL)
fun transform([],_) = []
| transform(h::t,n) = (h,n)::transform(t,(n-1))
in
List.map env_from_GL (transform(GL,(LEN-1)))
end
fun all_guards(env: environment) = let val AGL = makeDistinct(List.concat (List.map guards_of_SM_Trans (#allTransitions env)))
fun env_from_GL G = {
curState = #curState env,
allTransitions = #allTransitions env,
curTransition = #curTransition env,
curEvent = #curEvent env,
curGuard = G,
curEffect = emptyEffect,
extension = #extension env
}
val LEN = List.length(AGL)
fun transform([],_) = []
| transform(h::t,n) = (h,n)::transform(t,(n-1))
in
List.map env_from_GL (transform(AGL,(LEN-1)))
end
fun foreach_effect(env: environment) = let val EffL = effects_of_SM_Trans(#1(#curTransition env))
fun env_from_EffL E = {
curState = #curState env,
allTransitions = #allTransitions env,
curTransition = #curTransition env,
curEvent = #curEvent env,
curEffect = E,
curGuard = #curGuard env,
extension = #extension env
}
in
List.map env_from_EffL EffL
end
fun foreach "event_list" env = foreach_event env
| foreach "state_list" env = foreach_state env
| foreach "transition_list" env = foreach_transition env
| foreach "guard_of_trans_list" env = foreach_guard env
| foreach "guard_list" env = all_guards env
| foreach "effect_list" env = foreach_effect env
| foreach "events_of_state" env = foreach_events_of_state env
| foreach (LT as "classifier_list") env = ListPair.map (uncurry pack) ((foreach_classifier env), (SuperCart.foreach LT (unpack env)))
| foreach L (env:environment) = map (pack env) (SuperCart.foreach L (unpack env))
end

124
src/codegen/cartridge.sig
View File

@ -1,62 +1,62 @@
(*****************************************************************************
* su4sml - a SecureUML repository for SML
*
* cartridge.sig - the minimal signature every cartridge has to implement
* Copyright (C) 2005 Raphael Eidenbenz <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.
******************************************************************************)
(** the minimal signature every code-generator cartridge has to implement. *)
signature CARTRIDGE =
sig
(**
* the environment in which template-file statements are to be evaluated.
* Ususally this will contain lists of model elements and
* "pointers" to the "current" elements
*)
type environment
(**
* The particular model from which model element information is
* taken.
* This can be cartridge specific.
*)
type Model
(**
* returns the model information as it is part of the current
* environment.
*)
(* val getModel : environment -> Model *)
(** initialze the environment by parsing the given classifier list *)
val initEnv : Rep.Model -> environment
(** look up string-valued variables in the environment by name. *)
val lookup : environment -> string -> string
(** evaluate boolean-valued predicates in the environment by name. *)
val test : environment -> string -> bool
(**
* return a list of environment, where the "current" element
* iterates over a given list.
*)
val foreach : string -> environment -> environment list
end
(*****************************************************************************
* su4sml - a SecureUML repository for SML
*
* cartridge.sig - the minimal signature every cartridge has to implement
* Copyright (C) 2005 Raphael Eidenbenz <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.
******************************************************************************)
(** the minimal signature every code-generator cartridge has to implement. *)
signature CARTRIDGE =
sig
(**
* the environment in which template-file statements are to be evaluated.
* Ususally this will contain lists of model elements and
* "pointers" to the "current" elements
*)
type environment
(**
* The particular model from which model element information is
* taken.
* This can be cartridge specific.
*)
type Model
(**
* returns the model information as it is part of the current
* environment.
*)
(* val getModel : environment -> Model *)
(** initialze the environment by parsing the given classifier list *)
val initEnv : Rep.Model -> environment
(** look up string-valued variables in the environment by name. *)
val lookup : environment -> string -> string
(** evaluate boolean-valued predicates in the environment by name. *)
val test : environment -> string -> bool
(**
* return a list of environment, where the "current" element
* iterates over a given list.
*)
val foreach : string -> environment -> environment list
end

2
src/codegen/codegen.mlb
View File

@ -8,8 +8,6 @@ in
$(MLTON_ROOT)/basis/basis.mlb
../su4sml.mlb
in
compiler/compiler_ext.sig
compiler/mlton.sml
stringHandling.sml
gcg_helper.sml
tpl_parser.sig

194
src/codegen/codegen.sml
View File

@ -1,96 +1,98 @@
(*****************************************************************************
* 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( ComponentUML_Cartridge(Base_Cartridge)))
structure CSharp_NET1_Gcg
= GCG_Core (CSharp_NET1_Cartridge(Base_Cartridge))
structure CSharpSecure_NET1_Gcg
= GCG_Core (CSharp_NET1_Cartridge(ComponentUML_Cartridge(Base_Cartridge)))
structure SecureUML_Base_Gcg
= GCG_Core (ComponentUML_Cartridge(Base_Cartridge))
structure CSharpSM_Gcg = GCG_Core (CSSM_Cartridge(CSharp_Cartridge(Base_Cartridge)))
structure Java_Gcg = GCG_Core (Java_Cartridge(Base_Cartridge))
structure Junit_Gcg = GCG_Core (Junit_Cartridge(Java_Cartridge(Base_Cartridge)))
structure SecureMova_Gcg = GCG_Core (ComponentUML_Cartridge(Base_Cartridge))
(*
structure JavaSecure_Gcg = GCG_Core (Java_Cartridge(SecureUML_Cartridge(Base_Cartridge)));
*)
fun generate xmi_file "base" =
Base_Gcg.generate ( RepParser.readFile xmi_file) "templates/base.tpl"
| generate xmi_file "c#" =
CSharp_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#.tpl"
| generate xmi_file "c#_secure" =
CSharpSecure_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#_SecureUML.tpl"
| generate xmi_file "c#_net1" =
CSharp_NET1_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#.tpl"
| generate xmi_file "c#_secure_net1" =
CSharpSecure_NET1_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#_SecureUML.tpl"
| generate xmi_file "c#sm" =
CSharpSM_Gcg.generate (RepParser.readFile xmi_file) "templates/C#_SM.tpl"
| generate xmi_file "java" =
Java_Gcg.generate (RepParser.readFile xmi_file) "templates/java.tpl"
| generate xmi_file "junit" =
Junit_Gcg.generate (RepParser.readFile xmi_file) "templates/junit.tpl"
(*
| generate "java_secure" = JavaSecure_Gcg.generate model "templates/java_SecureUML.tpl"
*)
(* | generate xmi_file "maude" =
Base_Gcg.generate ( RepParser.readFile xmi_file) "templates/maude.tpl"
| generate xmi_file "maude_secure" =
SecureUML_Base_Gcg.generate ( Rep_SecureUML_ComponentUML.readXMI xmi_file) "templates/maude.tpl" *)
| generate xmi_file "securemova" =
SecureMova_Gcg.generate (RepParser.transformXMI (XmiParser.readFile xmi_file))
"templates/securemova.tpl"
| generate _ s = print ("target language unknown : "^s^"\n"^
"usage: generate <xmi_file> \"base\" | \"c#\" | \"c#_secure\" | \"c#_net1\" | \"c#_secure_net1\" | \"java\" | \"junit\"\n")
fun main (_,[xmi_file,lang]) = (generate xmi_file lang ; OS.Process.success)
| main _ = (print ("usage: codegen <xmi_file> <language>\n"^
"\tlanguage = \"base\" | \"c#\" | \"c#sm\" | \"c#_secure\" | \"c#_net1\" | \"c#_secure_net1\" | \"java\" | \"junit\" | \"maude\" | \"maude_secure\" \n"); OS.Process.success)
end
val _ = Codegen.main(CommandLine.name(),CommandLine.arguments())
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* codegen.sml - control file for su4sml-GCG
* Copyright (C) 2005 Raphael Eidenbenz <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( ComponentUML_Cartridge(Base_Cartridge)))
structure CSharp_NET1_Gcg
= GCG_Core (CSharp_NET1_Cartridge(Base_Cartridge))
structure CSharpSecure_NET1_Gcg
= GCG_Core (CSharp_NET1_Cartridge(ComponentUML_Cartridge(Base_Cartridge)))
structure SecureUML_Base_Gcg
= GCG_Core (ComponentUML_Cartridge(Base_Cartridge))
structure CSharpSM_Gcg = GCG_Core (CSSM_Cartridge(CSharp_Cartridge(Base_Cartridge)))
structure Java_Gcg = GCG_Core (Java_Cartridge(Base_Cartridge))
structure Junit_Gcg = GCG_Core (Junit_Cartridge(Java_Cartridge(Base_Cartridge)))
structure Java_Ocl_Gcg = GCG_Core (Java_Cartridge(Base_Cartridge))
structure SecureMova_Gcg = GCG_Core (ComponentUML_Cartridge(Base_Cartridge))
(*
structure JavaSecure_Gcg = GCG_Core (Java_Cartridge(SecureUML_Cartridge(Base_Cartridge)));
*)
fun generate xmi_file "base" =
Base_Gcg.generate ( RepParser.readFile xmi_file) "templates/base.tpl"
| generate xmi_file "c#" =
CSharp_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#.tpl"
| generate xmi_file "c#_secure" =
CSharpSecure_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#_SecureUML.tpl"
| generate xmi_file "c#_net1" =
CSharp_NET1_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#.tpl"
| generate xmi_file "c#_secure_net1" =
CSharpSecure_NET1_Gcg.generate ( RepParser.readFile xmi_file) "templates/C#_SecureUML.tpl"
| generate xmi_file "c#sm" =
CSharpSM_Gcg.generate (RepParser.readFile xmi_file) "templates/C#_SM.tpl"
| generate xmi_file "java" =
Java_Gcg.generate (RepParser.readFile xmi_file) "templates/java.tpl"
| generate xmi_file "junit" =
Junit_Gcg.generate (RepParser.readFile xmi_file) "templates/junit.tpl"
| generate xmi_file "javaocl" =
Java_Ocl_Gcg.generate (RepParser.readFile xmi_file) "templates/java_ocl.tpl"
(*
| generate "java_secure" = JavaSecure_Gcg.generate model "templates/java_SecureUML.tpl"
*)
(* | generate xmi_file "maude" =
Base_Gcg.generate ( RepParser.readFile xmi_file) "templates/maude.tpl"
| generate xmi_file "maude_secure" =
SecureUML_Base_Gcg.generate ( Rep_SecureUML_ComponentUML.readXMI xmi_file) "templates/maude.tpl" *)
| generate xmi_file "securemova" =
SecureMova_Gcg.generate (RepParser.transformXMI (XmiParser.readFile xmi_file))
"templates/securemova.tpl"
| generate _ s = print ("target language unknown : "^s^"\n"^
"usage: generate <xmi_file> \"base\" | \"c#\" | \"c#_secure\" | \"c#_net1\" | \"c#_secure_net1\" | \"java\" | \"junit\"\n")
fun main (_,[xmi_file,lang]) = (generate xmi_file lang ; OS.Process.success)
| main _ = (print ("usage: codegen <xmi_file> <language>\n"^
"\tlanguage = \"base\" | \"c#\" | \"c#sm\" | \"c#_secure\" | \"c#_net1\" | \"c#_secure_net1\" | \"java\" | \"junit\" | \"maude\" | \"maude_secure\" | \"javaocl\"\n"); OS.Process.success)
end
val _ = Codegen.main(CommandLine.name(),CommandLine.arguments())

50
src/codegen/gcg_core.sig
View File

@ -1,25 +1,25 @@
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* gcg_core.sig - signature of functor GCG_Core
* transcribes a su4sml model according to a template tree
* into code specific to a target language cartridge C
* Copyright (C) 2005 Raphael Eidenbenz <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.
******************************************************************************)
(*****************************************************************************
* 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.
******************************************************************************)

270
src/codegen/gcg_core.sml
View File

@ -1,135 +1,135 @@
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* gcg_core.sml - implements functor GCG_Core
* transcribes a su4sml model according to a template tree
* into code specific to a target language cartridge C
* Copyright (C) 2005 Raphael Eidenbenz <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.
******************************************************************************)
(** A Code generator *)
signature GCG =
sig
val writeLine : string -> unit
val generate : Rep.Model -> string -> unit
end
(** builds a code generator from a cartridge chain. *)
functor GCG_Core (C: CARTRIDGE): GCG =
struct
open library
val curFile = ref ""
val out = ref TextIO.stdOut
fun closeFile () = if (!curFile = "")
then ()
else (TextIO.closeOut (!out);
info ("closing "^(!curFile));
curFile := "")
fun openFile file = (closeFile ();
info ("opening "^file^"...");
Gcg_Helper.assureDir file;
out := (TextIO.openOut file);
curFile := file
)
fun openFileIfNotExists file = (closeFile ();
(if ((OS.FileSys.fileSize file) > 0)
then openFile "/dev/null"
else openFile file
) handle SysErr => ( openFile file ))
fun initOut () = (out := TextIO.stdOut;
curFile := "")
fun writeLine s = TextIO.output (!out,s)
fun eval s = (info "<eval>"; CompilerExt.eval true s)
(** applies f to every other element in l starting with the second
*)
fun map2EveryOther f [] = []
| map2EveryOther f [a] = [a]
| map2EveryOther f (a::b::z) = a::(f b)::(map2EveryOther f z)
fun substituteVars e s =
let val tkl = Gcg_Helper.joinEscapeSplitted "$" (Gcg_Helper.fieldSplit #"$" s)
in
String.concat (map2EveryOther (C.lookup e) tkl)
handle ex => (error_msg ("in GCG_Core.substituteVars: \
\variable lookup failure in string \""^s^"\".");
s)
end
(** traverses a templateParseTree and executes the given instructions *)
fun write env (Tpl_Parser.RootNode(l)) = List.app (write env) l
| write env (Tpl_Parser.OpenFileLeaf(file)) = openFile (substituteVars env file)
| write env (Tpl_Parser.OpenFileIfNotExistsLeaf(file)) =
openFileIfNotExists (substituteVars env file)
| write env (Tpl_Parser.EvalLeaf(l)) =
let fun collectEval [] = ""
| collectEval ((Tpl_Parser.TextLeaf(expr))::t) = expr^"\n"^(collectEval t)
| collectEval _ =
error "in GCG_Core.write: No TextLeaf in EvalLeaf"
in
eval (substituteVars env (collectEval l))
end
| write env (Tpl_Parser.TextLeaf(s)) = writeLine (substituteVars env s)
| write env (Tpl_Parser.IfNode(cond,l)) =
let fun writeThen _ [] = ()
| writeThen _ [Tpl_Parser.ElseNode(_)] = ()
| writeThen e (h::t) = (write e h ;writeThen e t)
in
(if (C.test env cond)
then writeThen env l
else case (List.last l) of nd as (Tpl_Parser.ElseNode(_)) => write env nd
| _ => ())
handle ex => () (* ignore failed/unknown predicates *)
end
| write env (Tpl_Parser.ElseNode(l)) = List.app (write env) l
| write env (Tpl_Parser.ForEachNode(listType,children))=
let val list_of_environments = C.foreach listType env
fun write_children e = List.app (fn tree => write e tree) children
in
List.app (fn e => write_children e) list_of_environments
handle ex => (error_msg ("in GCG_Core.write: error in foreach node "^listType^
": "^General.exnMessage ex);
())
end
(** generate code according to the given template file for the given model *)
fun generate model template
= let val env = C.initEnv model
val tree = Tpl_Parser.parse template
in
(initOut();
(*printTTree tree;*)
write env tree;
closeFile () )
handle ex => (closeFile(); raise ex)
end
end
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* gcg_core.sml - implements functor GCG_Core
* transcribes a su4sml model according to a template tree
* into code specific to a target language cartridge C
* Copyright (C) 2005 Raphael Eidenbenz <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.
******************************************************************************)
(** A Code generator *)
signature GCG =
sig
val writeLine : string -> unit
val generate : Rep.Model -> string -> unit
end
(** builds a code generator from a cartridge chain. *)
functor GCG_Core (C: CARTRIDGE): GCG =
struct
open library
val curFile = ref ""
val out = ref TextIO.stdOut
fun closeFile () = if (!curFile = "")
then ()
else (TextIO.closeOut (!out);
info ("closing "^(!curFile));
curFile := "")
fun openFile file = (closeFile ();
info ("opening "^file^"...");
Gcg_Helper.assureDir file;
out := (TextIO.openOut file);
curFile := file
)
fun openFileIfNotExists file = (closeFile ();
(if ((OS.FileSys.fileSize file) > 0)
then openFile "/dev/null"
else openFile file
) handle SysErr => ( openFile file ))
fun initOut () = (out := TextIO.stdOut;
curFile := "")
fun writeLine s = TextIO.output (!out,s)
fun eval s = (info "<eval>"; CompilerExt.eval true s)
(** applies f to every other element in l starting with the second
*)
fun map2EveryOther f [] = []
| map2EveryOther f [a] = [a]
| map2EveryOther f (a::b::z) = a::(f b)::(map2EveryOther f z)
fun substituteVars e s =
let val tkl = Gcg_Helper.joinEscapeSplitted "$" (Gcg_Helper.fieldSplit #"$" s)
in
String.concat (map2EveryOther (C.lookup e) tkl)
handle ex => (error_msg ("in GCG_Core.substituteVars: \
\variable lookup failure in string \""^s^"\".");
s)
end
(** traverses a templateParseTree and executes the given instructions *)
fun write env (Tpl_Parser.RootNode(l)) = List.app (write env) l
| write env (Tpl_Parser.OpenFileLeaf(file)) = openFile (substituteVars env file)
| write env (Tpl_Parser.OpenFileIfNotExistsLeaf(file)) =
openFileIfNotExists (substituteVars env file)
| write env (Tpl_Parser.EvalLeaf(l)) =
let fun collectEval [] = ""
| collectEval ((Tpl_Parser.TextLeaf(expr))::t) = expr^"\n"^(collectEval t)
| collectEval _ =
error "in GCG_Core.write: No TextLeaf in EvalLeaf"
in
eval (substituteVars env (collectEval l))
end
| write env (Tpl_Parser.TextLeaf(s)) = writeLine (substituteVars env s)
| write env (Tpl_Parser.IfNode(cond,l)) =
let fun writeThen _ [] = ()
| writeThen _ [Tpl_Parser.ElseNode(_)] = ()
| writeThen e (h::t) = (write e h ;writeThen e t)
in
(if (C.test env cond)
then writeThen env l
else case (List.last l) of nd as (Tpl_Parser.ElseNode(_)) => write env nd
| _ => ())
handle ex => () (* ignore failed/unknown predicates *)
end
| write env (Tpl_Parser.ElseNode(l)) = List.app (write env) l
| write env (Tpl_Parser.ForEachNode(listType,children))=
let val list_of_environments = C.foreach listType env
fun write_children e = List.app (fn tree => write e tree) children
in
List.app (fn e => write_children e) list_of_environments
handle ex => (error_msg ("in GCG_Core.write: error in foreach node "^listType^
": "^General.exnMessage ex);
())
end
(** generate code according to the given template file for the given model *)
fun generate model template
= let val env = C.initEnv model
val tree = Tpl_Parser.parse template
in
(initOut();
(*printTTree tree;*)
write env tree;
closeFile () )
handle ex => (closeFile(); raise ex)
end
end

142
src/codegen/gcg_helper.sml
View File

@ -1,71 +1,71 @@
(*****************************************************************************
* 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 =
struct
fun fieldSplit d s = String.fields (fn c => (c = d)) s
fun tokenSplit d s = String.tokens (fn c => (c = d)) s
local
fun endsWithEscape "" = false
| endsWithEscape s = (substring(s,size(s)-1,1) = "\\")
in
fun joinEscapeSplitted d [] = []
| joinEscapeSplitted d [l] = [l]
| joinEscapeSplitted d (h::s::t) = if endsWithEscape(h)
then (substring(h,0,size(h)-1)^d^s)::t
else h::(joinEscapeSplitted d (s::t))
end
(* FIXME: move to library.sml? *)
val curry = fn f => fn x => fn y => f (x, y)
val uncurry = fn f => fn (x, y) => f x y
(* FIXME: move to ListEq (and rename to isPrefix...) (is this even used somewhere?) *)
fun isSuffix [] _ = true
| isSuffix _ [] = false
| isSuffix (h1::t1) (h2::t2) = (h1=h2) andalso (isSuffix t1 t2)
(* FIXME: cleanup *)
fun assureDir file =
let val dirList = rev (tl (rev (String.tokens (fn c => c = #"/") file)))
fun assert1 "" d = ((if (OS.FileSys.isDir d) then () else ())
handle SysErr => (OS.FileSys.mkDir d) )
| assert1 prefix d = (if (OS.FileSys.isDir (prefix^"/"^d)) then () else ())
handle SysErr => (OS.FileSys.mkDir (prefix^"/"^d))
fun assertDList _ [] = ()
| assertDList prefix [d] = assert1 prefix d
| assertDList "" (h::t) = (assert1 "" h ; assertDList h t)
| assertDList prefix (h::t) = (assert1 prefix h;
assertDList (prefix^"/"^h) t )
in
assertDList "" dirList
end
end
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* gcg_helper.sml - helper library for su4sml-gcg
* Copyright (C) 2005 Raphael Eidenbenz <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 =
struct
fun fieldSplit d s = String.fields (fn c => (c = d)) s
fun tokenSplit d s = String.tokens (fn c => (c = d)) s
local
fun endsWithEscape "" = false
| endsWithEscape s = (substring(s,size(s)-1,1) = "\\")
in
fun joinEscapeSplitted d [] = []
| joinEscapeSplitted d [l] = [l]
| joinEscapeSplitted d (h::s::t) = if endsWithEscape(h)
then (substring(h,0,size(h)-1)^d^s)::t
else h::(joinEscapeSplitted d (s::t))
end
(* FIXME: move to library.sml? *)
val curry = fn f => fn x => fn y => f (x, y)
val uncurry = fn f => fn (x, y) => f x y
(* FIXME: move to ListEq (and rename to isPrefix...) (is this even used somewhere?) *)
fun isSuffix [] _ = true
| isSuffix _ [] = false
| isSuffix (h1::t1) (h2::t2) = (h1=h2) andalso (isSuffix t1 t2)
(* FIXME: cleanup *)
fun assureDir file =
let val dirList = rev (tl (rev (String.tokens (fn c => c = #"/") file)))
fun assert1 "" d = ((if (OS.FileSys.isDir d) then () else ())
handle SysErr => (OS.FileSys.mkDir d) )
| assert1 prefix d = (if (OS.FileSys.isDir (prefix^"/"^d)) then () else ())
handle SysErr => (OS.FileSys.mkDir (prefix^"/"^d))
fun assertDList _ [] = ()
| assertDList prefix [d] = assert1 prefix d
| assertDList "" (h::t) = (assert1 "" h ; assertDList h t)
| assertDList prefix (h::t) = (assert1 prefix h;
assertDList (prefix^"/"^h) t )
in
assertDList "" dirList
end
end

224
src/codegen/java_cartridge.sml
View File

@ -1,100 +1,124 @@
(*****************************************************************************
* su4sml - a SecureUML repository for SML
*
* java_cartridge.sml - a java cartridge for gcg
* 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.
******************************************************************************)
(* FIXME: This is blindly copied from the C#_Cartridge. *)
(* Probably, some things have to be adjusted to Java syntax *)
functor Java_Cartridge(SuperCart : BASE_CARTRIDGE) : BASE_CARTRIDGE =
struct
open Rep_OclType
type Model = SuperCart.Model
type environment = { extension : SuperCart.environment }
(* fun getModel (env:environment) = SuperCart.getModel (#extension env)*)
fun initEnv model = { extension = SuperCart.initEnv model } : environment
fun unpack (env : environment) = #extension env
fun pack superEnv = {extension = superEnv} : environment
fun curClassifier env = SuperCart.curClassifier (unpack env)
fun curArgument env = SuperCart.curArgument (unpack env)
fun curOperation env = SuperCart.curOperation (unpack env)
fun curAttribute env = SuperCart.curAttribute (unpack env)
fun curAssociationEnd env = SuperCart.curAssociationEnd (unpack env)
(* internal translation table, blindly copied from C# *)
fun super2Native "ClassifierScope" = "static"
| super2Native "InstanceScope" = ""
| super2Native "package" = "public"
| super2Native "Integer" = "int"
| super2Native "Real" = "double"
| super2Native "String" = "string"
| super2Native "Boolean" = "bool"
| super2Native "OclVoid" = "void"
| super2Native s = ( if ((String.extract (s,0,SOME 8)) = "Sequence")
then (super2Native (String.substring(s,9,size s -10)))^"[]"
else if ((String.extract (s,0,SOME 3)) = "Set")
then "System.Collections.Generic.List<"
^(super2Native (String.substring(s,4,size s - 5)))^">"
else s )
handle Subscript => s
(* lookup environment -> string -> string
* overrides some lookup entries of the base cartridge
*)
fun lookup (env : environment) "attribute_name_small_letter"
= StringHandling.uncapitalize (SuperCart.lookup (unpack env) "attribute_name")
| lookup (env : environment) "attribute_name_capital"
= StringHandling.capitalize (SuperCart.lookup (unpack env) "attribute_name")
| lookup (env : environment) (s as "attribute_type") = super2Native (SuperCart.lookup (unpack env) s )
| lookup (env : environment) (s as "attribute_visibility")= super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "attribute_scope") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_result_type")=super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_visibility")= super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_scope") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "argument_type") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) s = SuperCart.lookup (unpack env) s
fun test (env : environment) s = SuperCart.test (unpack env) s
(* no further functionality to add
* just unpack the Supercartridge's environment,
* pass it to SuperCart.foreach, get back a SuperCart.environment list
* pack every item into a native environment
*)
fun foreach listType (env : environment)
= map pack (SuperCart.foreach listType (unpack env))
end
(*****************************************************************************
* su4sml - a SecureUML repository for SML
*
* java_cartridge.sml - a java cartridge for gcg
* Copyright (C) 2005 Raphael Eidenbenz <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.
******************************************************************************)
(* FIXME: This is blindly copied from the C#_Cartridge. *)
(* Probably, some things have to be adjusted to Java syntax *)
functor Java_Cartridge(SuperCart : BASE_CARTRIDGE) : BASE_CARTRIDGE =
struct
open Rep_OclType
open library
type Model = SuperCart.Model
type environment = { curParent : Rep_OclType.Path option,
extension : SuperCart.environment }
(* fun getModel (env:environment) = SuperCart.getModel (#extension env)*)
fun initEnv model = { curParent = NONE,
extension = SuperCart.initEnv model } : environment
fun unpack (env : environment) = #extension env
fun pack (Env : environment) (superEnv : SuperCart.environment) = {curParent = #curParent Env,
extension = superEnv} : environment
fun curClassifier env = SuperCart.curClassifier (unpack env)
fun curArgument env = SuperCart.curArgument (unpack env)
fun curAssociationEnd env = SuperCart.curAssociationEnd (unpack env)
fun curOperation env = SuperCart.curOperation (unpack env)
fun curAttribute env = SuperCart.curAttribute (unpack env)
fun curParent (env : environment) = #curParent env
fun curClassifier' env = Option.valOf(curClassifier env)
fun curOperation' env = Option.valOf(curOperation env)
fun curParent' (env : environment) = Option.valOf(curParent env)
(* internal translation table, blindly copied from C# *)
fun super2Native "ClassifierScope" = "static"
| super2Native "InstanceScope" = ""
| super2Native "package" = ""
| super2Native "Integer" = "int"
| super2Native "Real" = "double"
| super2Native "Boolean" = "Boolean"
| super2Native "OclVoid" = "void"
| super2Native s = ( if ((String.extract (s,0,SOME 8)) = "Sequence")
then (super2Native (String.substring(s,9,size s -10)))^"[]"
else if ((String.extract (s,0,SOME 3)) = "Set")
then "System.Collections.Generic.List<"
^(super2Native (String.substring(s,4,size s - 5)))^">"
else s )
handle Subscript => s
(* lookup environment -> string -> string
* overrides some lookup entries of the base cartridge
*)
fun lookup (env : environment) "attribute_name_small_letter"
= StringHandling.uncapitalize (SuperCart.lookup (unpack env) "attribute_name")
| lookup (env : environment) "attribute_name_capital"
= StringHandling.capitalize (SuperCart.lookup (unpack env) "attribute_name")
| lookup (env : environment) (s as "attribute_type") = super2Native (SuperCart.lookup (unpack env) s )
| lookup (env : environment) (s as "attribute_visibility")= super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "attribute_scope") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_result_type")=super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_visibility")= super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "operation_scope") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "argument_type") = super2Native (SuperCart.lookup (unpack env) s)
| lookup (env : environment) (s as "parent_interface") = List.last (Option.valOf (#curParent env))
| lookup (env : environment) (s as "preconditions") = Ocl2DresdenJava.precondString env "this" (curOperation' env)
| lookup (env : environment) (s as "postconditions") = Ocl2DresdenJava.postcondString env "this" (curOperation' env)
| lookup (env : environment) (s as "invariants") = Ocl2DresdenJava.invString env "this" (curClassifier' env)
| lookup (env : environment) s = SuperCart.lookup (unpack env) s
fun test (env : environment) "hasParentInterfaces" = (length (Rep_Core.parent_interface_names_of (curClassifier' env))) <> 0
| test env "last_interface" = (List.last (Rep_Core.parent_interface_names_of (curClassifier' env))) =
curParent' env
| test env "operation_has_arguments" = (length (Rep_Core.arguments_of_op (curOperation' env))) > 0
| test env "operation_is_void" = (lookup env "operation_result_type") = "void"
| test env "operation_non_void" = (lookup env "operation_result_type") <> "void"
| test (env : environment) s = SuperCart.test (unpack env) s
fun foreach_parent_interface (env : environment)
= let val parents = Rep_Core.parent_interface_names_of (curClassifier' env)
fun env_from_parent p = { curParent = SOME p,
extension = #extension env }
in
List.map env_from_parent parents
end
fun foreach "parent_interface_list" env = foreach_parent_interface env
(* no further functionality to add
* just unpack the Supercartridge's environment,
* pass it to SuperCart.foreach, get back a SuperCart.environment list
* pack every item into a native environment
*)
| foreach listType (env : environment) = map (pack env) (SuperCart.foreach listType (unpack env))
end

19
src/codegen/junit_cartridge.sml
View File

@ -47,18 +47,31 @@ fun curOperation env = SuperCart.curOperation (unpack env)
fun curAttribute env = SuperCart.curAttribute (unpack env)
fun curAssociationEnd env = SuperCart.curAssociationEnd (unpack env)
fun curClassifier' env = Option.valOf(curClassifier env)
fun curOperation' env = Option.valOf(curOperation env)
(* any special variables? *)
fun lookup (env : environment) s = SuperCart.lookup (unpack env) s
fun lookup (env : environment) (s as "preconditions") = Ocl2DresdenJava.precondString env "testObject" (curOperation' env)
| lookup (env : environment) (s as "postconditions") = Ocl2DresdenJava.postcondString env "testObject" (curOperation' env)
| lookup (env : environment) (s as "invariants") = Ocl2DresdenJava.invString env "testObject" (curClassifier' env)
| lookup (env : environment) s = SuperCart.lookup (unpack env) s
(* any special predicates?*)
fun test (env : environment ) "operation_isNotPrivate" = not (test env "operation_isPrivate")
| test (env : environment ) "not_last_argument" = not (test env "last_argument")
| test (env : environment) "isTestable" = (test env "hasOperations") andalso (not (test env "isInterface"))
| test (env : environment) "isTestable" = (not (test env "isInterface")) (* andalso (not (test env "isAbstract")) *) andalso (test env "hasOperations")
| test (env : environment) s = SuperCart.test (unpack env) s
(* Check if operation is already in given list *)
fun opInList (operation : environment) oplist = foldr (fn (a,b) => if (lookup operation "operation_name") = (lookup a "operation_name") then (false andalso b) else (true andalso b)) true oplist
(* Remove duplicate methods by comparing their names *)
fun unique_op oplist = foldl (fn (el,l) => if (opInList el l) then l @ [el] else l) [] oplist
(* any special lists? *)
fun foreach listType (env : environment)
fun foreach "unique_operation_list" (env : environment) = unique_op (foreach "operation_list" env)
| foreach listType (env : environment)
= map pack (SuperCart.foreach listType (unpack env))
end

80
src/codegen/secureuml_cartridge.sig
View File

@ -1,40 +1,40 @@
(*****************************************************************************
* su4sml - a SecureUML repository for SML
*
* secureuml_cartridge.sig - an extended signature of CARTRIDGE specific
* for the SecureUML cartridge
* Copyright (C) 2005 Raphael Eidenbenz <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
include BASE_CARTRIDGE
(** the particular secureuml dialect used *)
structure Security:SECURITY_LANGUAGE
val curPermissionSet: environment -> Security.Permission list option
val curPermission : environment -> Security.Permission option
val curRole : environment -> string option
val curConstraint : environment -> Rep_OclTerm.OclTerm option
val isInPermission : Security.Design.Action -> Security.Permission -> bool
end
(*****************************************************************************
* su4sml - a SecureUML repository for SML
*
* secureuml_cartridge.sig - an extended signature of CARTRIDGE specific
* for the SecureUML cartridge
* Copyright (C) 2005 Raphael Eidenbenz <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
include BASE_CARTRIDGE
(** the particular secureuml dialect used *)
structure Security:SECURITY_LANGUAGE
val curPermissionSet: environment -> Security.Permission list option
val curPermission : environment -> Security.Permission option
val curRole : environment -> string option
val curConstraint : environment -> Rep_OclTerm.OclTerm option
val isInPermission : Security.Design.Action -> Security.Permission -> bool
end

134
src/codegen/templates/C#.tpl
View File

@ -1,68 +1,68 @@
@// Template for C#
@// (c) Copyright 2005 Raphael Eidenbenz eraphael-at-student.ethz.ch
@openfile generated/csharp/$classifier_package$.cs
// generated by su4sml GCG - Generic Code Generator
@nl
@nl using System;
@nl
@nl namespace $classifier_package$
@nl {
@foreach classifier_list
@nl@nl@nl
@if isPrimitive
@nl @tab // no support for primitive $classifier_name$ !!
@nl
@else
@if isClass
@nl @tab class $classifier_name$
@elsif isInterface
@nl @tab interface $classifier_name$
@end
@if hasParent
: $classifier_parent$
@end
@nl @tab {
@foreach attribute_list
@nl@nl
@if attribute_isPublic @// PROPERTY!
@nl @tab@tab private $attribute_scope$ $attribute_type$ $attribute_name_small_letter$ ;
@nl @tab@tab public $attribute_scope$ $attribute_type$ $attribute_name_capital$
@nl @tab@tab {
@nl @tab@tab@tab get { return $attribute_name_small_letter$; }
@nl @tab@tab@tab set { $attribute_name_small_letter$ = value ; }
@nl @tab@tab }
@else
@nl @tab@tab $attribute_visibility$ $attribute_scope$ $attribute_type$ $attribute_name$ ;
@end
@end
@nl
@foreach operation_list
@nl @tab@tab public $operation_scope$ $operation_result_type$ $operation_name$(
@foreach argument_list
@if last_argument
$argument_type$ $argument_name$
@else
$argument_type$ $argument_name$ ,
@end
@end
)
@nl @tab@tab {
@nl @tab@tab@tab // ...toDo...
@nl @tab@tab }
@end
@// Konstruktor:
@// @nl @tab@tab $classifier_name$()
@// @nl @tab@tab {}
@nl @tab}
@end
@end
@// Template for C#
@// (c) Copyright 2005 Raphael Eidenbenz eraphael-at-student.ethz.ch
@openfile generated/csharp/$classifier_package$.cs
// generated by su4sml GCG - Generic Code Generator
@nl
@nl using System;
@nl
@nl namespace $classifier_package$
@nl {
@foreach classifier_list
@nl@nl@nl
@if isPrimitive
@nl @tab // no support for primitive $classifier_name$ !!
@nl
@else
@if isClass
@nl @tab class $classifier_name$
@elsif isInterface
@nl @tab interface $classifier_name$
@end
@if hasParent
: $classifier_parent$
@end
@nl @tab {
@foreach attribute_list
@nl@nl
@if attribute_isPublic @// PROPERTY!
@nl @tab@tab private $attribute_scope$ $attribute_type$ $attribute_name_small_letter$ ;
@nl @tab@tab public $attribute_scope$ $attribute_type$ $attribute_name_capital$
@nl @tab@tab {
@nl @tab@tab@tab get { return $attribute_name_small_letter$; }
@nl @tab@tab@tab set { $attribute_name_small_letter$ = value ; }
@nl @tab@tab }
@else
@nl @tab@tab $attribute_visibility$ $attribute_scope$ $attribute_type$ $attribute_name$ ;
@end
@end
@nl
@foreach operation_list
@nl @tab@tab public $operation_scope$ $operation_result_type$ $operation_name$(
@foreach argument_list
@if last_argument
$argument_type$ $argument_name$
@else
$argument_type$ $argument_name$ ,
@end
@end
)
@nl @tab@tab {
@nl @tab@tab@tab // ...toDo...
@nl @tab@tab }
@end
@// Konstruktor:
@// @nl @tab@tab $classifier_name$()
@// @nl @tab@tab {}
@nl @tab}
@end
@end
@nl} // End

364
src/codegen/templates/C#_SM.tpl
View File

@ -1,182 +1,182 @@
@// Template for C#
@// (c) Rolf Adelsberger (rsa@student.ethz.ch)
@openfile generated/csharp/StateMachine_$classifier_package$.cs
// generated by su4sml GCG - Generic Code Generator
@foreach classifier_list
@if hasAG
@nl
@nl using System;
@nl using System.Collections;
@nl
@nl namespace $classifier_package$
@nl {
//State Class
@nl @tab public class State
@nl @tab {
@nl @tab@tab public string name;
@nl @tab@tab public Hashtable transitions; //this is indexed by the event IDs.
@nl
@nl @tab@tab public State(string n)
@nl @tab@tab {
@nl @tab@tab@tab transitions = new Hashtable();
@nl @tab@tab@tab name = n;
@nl @tab@tab }
@nl @tab }
@nl
@nl
@nl @tab public delegate bool EventF();
@nl @tab public delegate bool Guard();
@nl @tab public delegate bool Effect();
// Transition Class
@nl @tab public class Transition
@nl @tab {
@nl @tab@tab public State target;
@nl @tab@tab public Guard[] guards;
@nl @tab@tab public Effect[] effects;
@nl
@nl @tab@tab public Transition(State t, Guard[] ga, Effect[] e)
@nl @tab@tab {
@nl @tab@tab@tab target = t;
@nl @tab@tab@tab guards = ga;
@nl @tab@tab@tab effects = e;
@nl @tab@tab }
@nl @tab }
@nl
// State machine class
@nl @tab public class StateMachine
@nl @tab {
@nl @tab@tab public enum EVENTS
@nl @tab@tab {
@nl @tab@tab@tab ALWAYS = -1,
@foreach event_list
@nl @tab@tab@tab $event_name$,
@end
@nl @tab@tab@tab NUM_EV
@nl @tab@tab };
@nl @tab@tab public State CUR_STATE;
@nl
@nl @tab@tab State START;
@foreach state_list
@nl @tab@tab State $state_ident$;
@end
@nl @tab@tab State END;
@nl
@nl
@nl @tab@tab private void init_states()
@nl @tab@tab {
@nl @tab@tab@tab START = new State("Initial");
@foreach state_list
@nl @tab@tab@tab $state_ident$ = new State("$state_ident$");
@end
@nl @tab@tab@tab END = new State("Final");
@nl @tab@tab }
@nl
@nl @tab@tab public StateMachine()
@nl @tab@tab {
@nl @tab@tab init_states();
@foreach state_list
@foreach events_of_state
@nl
@nl @tab@tab $state_ident$.transitions.Add(EVENTS.$cur_event_id$,new Transition[]{
@foreach transition_list
@nl @tab@tab@tab@tab
new Transition($transition_target$,
@nl @tab@tab@tab@tab@tab new Guard[]{
@foreach guard_of_trans_list
new Guard($guard_ident$)
@if isLastGuard
} @//closing guard array
@else
, @//between guards
@end
@end
, @//comma between guards and Effects
@nl @tab@tab@tab@tab@tab new Effect[] {
@foreach effect_list
new Effect($effect_ident$),
@end
})
@if isLastTrans
}); @//endof transition array
@else
, @//separate transitions
@end
@end
@end @//endof events_of_state
@nl
@nl
@end @//endof state_list
@nl @tab@tab CUR_STATE = START = $real_init$;
@nl @tab@tab END = $final_state_name$;
@nl @tab@tab }
@nl
@nl @tab@tab //these three guards always exist
@nl @tab@tab public bool alwaysG(){return true;}
@nl @tab@tab public bool elseG(){return true;}
@nl @tab@tab public bool noneR(){return true;}
@nl
@nl
@nl @tab@tab private bool checkState(EVENTS E_ID)
@nl @tab@tab {
@nl @tab@tab@tab return (CUR_STATE.transitions.ContainsKey(E_ID));
@nl @tab@tab }
@nl
@nl
@foreach event_list
@nl @tab@tab public void $trigger_name$()
@nl @tab@tab {
@nl @tab@tab@tab EVENTS E_ID = EVENTS.$event_name$;
@nl @tab@tab@tab if(checkState(E_ID)) {
@nl @tab@tab@tab@tab Console.WriteLine("Checkstate ok...\n");
@nl @tab@tab@tab@tab Transition[] trans = (Transition[]) CUR_STATE.transitions[E_ID];
@nl @tab@tab@tab@tab foreach(Transition t in trans){
@nl @tab@tab@tab@tab@tab foreach(Guard g in t.guards){
@nl @tab@tab@tab@tab@tab@tab if(g()){
@nl @tab@tab@tab@tab@tab@tab@tab Console.WriteLine("Guard \"{0}\" in $event_name$ succeeded...\n",g.Method.ToString());
@//@nl @tab@tab@tab@tab@tab@tab@tab CUR_STATE = t.target;
@//@nl @tab@tab@tab@tab@tab@tab@tab return;
@nl @tab@tab@tab@tab@tab@tab } else {
@nl @tab@tab@tab@tab@tab@tab@tab Console.WriteLine("Guard \"{0}\" in $event_name$ didn't hold...\n",g.Method.ToString());
@nl @tab@tab@tab@tab@tab@tab@tab break;
@nl @tab@tab@tab@tab@tab@tab }
@nl @tab@tab@tab@tab@tab@tab //if we arrived here, all guards did hold -->
@nl @tab@tab@tab@tab@tab@tab CUR_STATE = t.target;
@nl @tab@tab@tab@tab@tab@tab //fire all effects
@nl @tab@tab@tab@tab@tab foreach(Effect e in t.effects) {
@nl @tab@tab@tab@tab@tab@tab e.eval();
@nl @tab@tab@tab@tab@tab }
@nl @tab@tab@tab@tab@tab@tab //go back
@nl @tab@tab@tab@tab@tab@tab return;
@nl @tab@tab@tab@tab@tab }
@nl @tab@tab@tab@tab }
@nl @tab@tab@tab } else {
Console.WriteLine("Current state \"{0}\" does not accept Event \"{1}\"", CUR_STATE.name,E_ID.ToString());
}
@nl @tab@tab }
@nl
@end
@nl @tab@tab private void auto() {
@nl @tab@tab@tab if(checkState(EVENTS.AUTO)){
@nl @tab@tab@tab@tab Transitions[] trans = (Transition[]) CUR_STATE.transitions[EVENTS.AUTO];
@nl @tab@tab@tab@tab foreach(Transition t in trans) {
@nl @tab@tab@tab@tab@tab foreach(Guard g in t.guards) {
@nl @tab@tab@tab@tab@tab if(!g()) {
@nl @tab@tab@tab@tab@tab@tab break; // break out of the iteration over the guards
@nl @tab@tab@tab@tab@tab }
@nl @tab@tab@tab@tab@tab CUR_STATE = t.target;
@nl @tab@tab@tab@tab@tab }
@nl @tab@tab@tab@tab foreach(Effect e in t.effects) {
@nl @tab@tab@tab@tab@tab e.eval();
@nl @tab@tab@tab@tab }
@nl @tab@tab@tab@tab return;
@nl @tab@tab@tab }
@nl @tab@tab }
@nl @tab@tab else {
@nl @tab@tab@tab return;
@nl @tab@tab }
@nl @tab }
@nl @tab@tab } @//endof state machine
@nl} // End
@end
@end
@// Template for C#
@// (c) Rolf Adelsberger (rsa@student.ethz.ch)
@openfile generated/csharp/StateMachine_$classifier_package$.cs
// generated by su4sml GCG - Generic Code Generator
@foreach classifier_list
@if hasAG
@nl
@nl using System;
@nl using System.Collections;
@nl
@nl namespace $classifier_package$
@nl {
//State Class
@nl @tab public class State
@nl @tab {
@nl @tab@tab public string name;
@nl @tab@tab public Hashtable transitions; //this is indexed by the event IDs.
@nl
@nl @tab@tab public State(string n)
@nl @tab@tab {
@nl @tab@tab@tab transitions = new Hashtable();
@nl @tab@tab@tab name = n;
@nl @tab@tab }
@nl @tab }
@nl
@nl
@nl @tab public delegate bool EventF();
@nl @tab public delegate bool Guard();
@nl @tab public delegate bool Effect();
// Transition Class
@nl @tab public class Transition
@nl @tab {
@nl @tab@tab public State target;
@nl @tab@tab public Guard[] guards;
@nl @tab@tab public Effect[] effects;
@nl
@nl @tab@tab public Transition(State t, Guard[] ga, Effect[] e)
@nl @tab@tab {
@nl @tab@tab@tab target = t;
@nl @tab@tab@tab guards = ga;
@nl @tab@tab@tab effects = e;
@nl @tab@tab }
@nl @tab }
@nl
// State machine class
@nl @tab public class StateMachine
@nl @tab {
@nl @tab@tab public enum EVENTS
@nl @tab@tab {
@nl @tab@tab@tab ALWAYS = -1,
@foreach event_list
@nl @tab@tab@tab $event_name$,
@end
@nl @tab@tab@tab NUM_EV
@nl @tab@tab };
@nl @tab@tab public State CUR_STATE;
@nl
@nl @tab@tab State START;
@foreach state_list
@nl @tab@tab State $state_ident$;
@end
@nl @tab@tab State END;
@nl
@nl
@nl @tab@tab private void init_states()
@nl @tab@tab {
@nl @tab@tab@tab START = new State("Initial");
@foreach state_list
@nl @tab@tab@tab $state_ident$ = new State("$state_ident$");
@end
@nl @tab@tab@tab END = new State("Final");
@nl @tab@tab }
@nl
@nl @tab@tab public StateMachine()
@nl @tab@tab {
@nl @tab@tab init_states();
@foreach state_list
@foreach events_of_state
@nl
@nl @tab@tab $state_ident$.transitions.Add(EVENTS.$cur_event_id$,new Transition[]{
@foreach transition_list
@nl @tab@tab@tab@tab
new Transition($transition_target$,
@nl @tab@tab@tab@tab@tab new Guard[]{
@foreach guard_of_trans_list
new Guard($guard_ident$)
@if isLastGuard
} @//closing guard array
@else
, @//between guards
@end
@end
, @//comma between guards and Effects
@nl @tab@tab@tab@tab@tab new Effect[] {
@foreach effect_list
new Effect($effect_ident$),
@end
})
@if isLastTrans
}); @//endof transition array
@else
, @//separate transitions
@end
@end
@end @//endof events_of_state
@nl
@nl
@end @//endof state_list
@nl @tab@tab CUR_STATE = START = $real_init$;
@nl @tab@tab END = $final_state_name$;
@nl @tab@tab }
@nl
@nl @tab@tab //these three guards always exist
@nl @tab@tab public bool alwaysG(){return true;}
@nl @tab@tab public bool elseG(){return true;}
@nl @tab@tab public bool noneR(){return true;}
@nl
@nl
@nl @tab@tab private bool checkState(EVENTS E_ID)
@nl @tab@tab {
@nl @tab@tab@tab return (CUR_STATE.transitions.ContainsKey(E_ID));
@nl @tab@tab }
@nl
@nl
@foreach event_list
@nl @tab@tab public void $trigger_name$()
@nl @tab@tab {
@nl @tab@tab@tab EVENTS E_ID = EVENTS.$event_name$;
@nl @tab@tab@tab if(checkState(E_ID)) {
@nl @tab@tab@tab@tab Console.WriteLine("Checkstate ok...\n");
@nl @tab@tab@tab@tab Transition[] trans = (Transition[]) CUR_STATE.transitions[E_ID];
@nl @tab@tab@tab@tab foreach(Transition t in trans){
@nl @tab@tab@tab@tab@tab foreach(Guard g in t.guards){
@nl @tab@tab@tab@tab@tab@tab if(g()){
@nl @tab@tab@tab@tab@tab@tab@tab Console.WriteLine("Guard \"{0}\" in $event_name$ succeeded...\n",g.Method.ToString());
@//@nl @tab@tab@tab@tab@tab@tab@tab CUR_STATE = t.target;
@//@nl @tab@tab@tab@tab@tab@tab@tab return;
@nl @tab@tab@tab@tab@tab@tab } else {
@nl @tab@tab@tab@tab@tab@tab@tab Console.WriteLine("Guard \"{0}\" in $event_name$ didn't hold...\n",g.Method.ToString());
@nl @tab@tab@tab@tab@tab@tab@tab break;
@nl @tab@tab@tab@tab@tab@tab }
@nl @tab@tab@tab@tab@tab@tab //if we arrived here, all guards did hold -->
@nl @tab@tab@tab@tab@tab@tab CUR_STATE = t.target;
@nl @tab@tab@tab@tab@tab@tab //fire all effects
@nl @tab@tab@tab@tab@tab foreach(Effect e in t.effects) {
@nl @tab@tab@tab@tab@tab@tab e.eval();
@nl @tab@tab@tab@tab@tab }
@nl @tab@tab@tab@tab@tab@tab //go back
@nl @tab@tab@tab@tab@tab@tab return;
@nl @tab@tab@tab@tab@tab }
@nl @tab@tab@tab@tab }
@nl @tab@tab@tab } else {
Console.WriteLine("Current state \"{0}\" does not accept Event \"{1}\"", CUR_STATE.name,E_ID.ToString());
}
@nl @tab@tab }
@nl
@end
@nl @tab@tab private void auto() {
@nl @tab@tab@tab if(checkState(EVENTS.AUTO)){
@nl @tab@tab@tab@tab Transitions[] trans = (Transition[]) CUR_STATE.transitions[EVENTS.AUTO];
@nl @tab@tab@tab@tab foreach(Transition t in trans) {
@nl @tab@tab@tab@tab@tab foreach(Guard g in t.guards) {
@nl @tab@tab@tab@tab@tab if(!g()) {
@nl @tab@tab@tab@tab@tab@tab break; // break out of the iteration over the guards
@nl @tab@tab@tab@tab@tab }
@nl @tab@tab@tab@tab@tab CUR_STATE = t.target;
@nl @tab@tab@tab@tab@tab }
@nl @tab@tab@tab@tab foreach(Effect e in t.effects) {
@nl @tab@tab@tab@tab@tab e.eval();
@nl @tab@tab@tab@tab }
@nl @tab@tab@tab@tab return;
@nl @tab@tab@tab }
@nl @tab@tab }
@nl @tab@tab else {
@nl @tab@tab@tab return;
@nl @tab@tab }
@nl @tab }
@nl @tab@tab } @//endof state machine
@nl} // End
@end
@end

332
src/codegen/templates/C#_SecureUML.tpl
View File

@ -1,166 +1,166 @@
@// Template for C#
@// (c) Copyright 2005 Raphael Eidenbenz eraphael-at-student.ethz.ch
@// write permissions into XML-file
@openfile generated/csharp_secure/$classifier_package$.xml
<?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 executePermission_list
@if first_permission
@nl@tab@tab@tab
MdsEngine.Assert(this, new string[] {
@end
@if last_permission
"$permission_name$" });
@else
"$permission_name$",
@end
@end
@nl @tab@tab@tab // ...toDo...
@nl @tab@tab }
@end
@nl
@// Constructor:
@nl @tab@tab // Constructor
@nl @tab@tab $classifier_name$()
@nl @tab@tab {
@foreach createPermission_list
@if first_permission
@nl @tab @tab @tab
MdsEngine.Assert(this, new string[] {
@end
@if last_permission
"$permission_name$" });
@else
"$permission_name$",
@end
@end
@nl @tab@tab }
@nl
@// Destructor:
@nl @tab@tab // Destructor
@nl @tab@tab ~$classifier_name$()
@nl @tab@tab {
@foreach deletePermission_list
@if first_permission
@nl @tab @tab @tab
MdsEngine.Assert(this, new string[] {
@end
@if last_permission
"$permission_name$" });
@else
"$permission_name$",
@end
@end
@nl @tab@tab }
@nl @tab }
@end
@end
@nl} @// End
@// Template for C#
@// (c) Copyright 2005 Raphael Eidenbenz eraphael-at-student.ethz.ch
@// write permissions into XML-file
@openfile generated/csharp_secure/$classifier_package$.xml
<?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 executePermission_list
@if first_permission
@nl@tab@tab@tab
MdsEngine.Assert(this, new string[] {
@end
@if last_permission
"$permission_name$" });
@else
"$permission_name$",
@end
@end
@nl @tab@tab@tab // ...toDo...
@nl @tab@tab }
@end
@nl
@// Constructor:
@nl @tab@tab // Constructor
@nl @tab@tab $classifier_name$()
@nl @tab@tab {
@foreach createPermission_list
@if first_permission
@nl @tab @tab @tab
MdsEngine.Assert(this, new string[] {
@end
@if last_permission
"$permission_name$" });
@else
"$permission_name$",
@end
@end
@nl @tab@tab }
@nl
@// Destructor:
@nl @tab@tab // Destructor
@nl @tab@tab ~$classifier_name$()
@nl @tab@tab {
@foreach deletePermission_list
@if first_permission
@nl @tab @tab @tab
MdsEngine.Assert(this, new string[] {
@end
@if last_permission
"$permission_name$" });
@else
"$permission_name$",
@end
@end
@nl @tab@tab }
@nl @tab }
@end
@end
@nl} @// End

54
src/codegen/templates/base.tpl
View File

@ -1,28 +1,28 @@
@// base template
@// assumption: all classifiers are classes
@openfile generated/base/$classifier_package$.base
// generated by su4sml GCG - Generic Code Generator
@nl@nl package $classifier_package$ ;
@foreach classifier_list
@nl@nl
class $classifier_name$
@if hasParent
extends $classifier_parent$
@end
@nl {
@foreach attribute_list
@nl @tab public $attribute_type$ $attribute_name$ ;
@end
@foreach operation_list
@nl @tab $operation_result_type$ $operation_name$(
@foreach argument_list
$argument_type$ $argument_name$
@end
)
@nl @tab {}
@end
@nl }
@// base template
@// assumption: all classifiers are classes
@openfile generated/base/$classifier_package$.base
// generated by su4sml GCG - Generic Code Generator
@nl@nl package $classifier_package$ ;
@foreach classifier_list
@nl@nl
class $classifier_name$
@if hasParent
extends $classifier_parent$
@end
@nl {
@foreach attribute_list
@nl @tab public $attribute_type$ $attribute_name$ ;
@end
@foreach operation_list
@nl @tab $operation_result_type$ $operation_name$(
@foreach argument_list
$argument_type$ $argument_name$
@end
)
@nl @tab {}
@end
@nl }
@end

84
src/codegen/templates/java.tpl
View File

@ -1,25 +1,59 @@
@// Example template for Java
@// assumption: all classifiers are classes
@foreach classifier_list
@openfile generated/$classifier_name$.java
package $classifier_package$ ;
@nl@nl
public class $classifier_name$
@if hasParent
extends $classifier_parent$
@end
@nl {
@foreach attribute_list
@nl @tab public $attribute_type$ $attribute_name$ ;
@end
@foreach operation_list
@nl @tab public $operation_result_type$ $operation_name$(
@foreach argument_list
$argument_type$ $argument_name$
@end
)
@nl @tab {}
@end
@nl }
@end
@// Example template for Java
@// assumption: all classifiers are classes
@foreach nonprimitive_classifier_list
@openfileifnotexists generated/src/main/java/$classifier_package_path$/$classifier_name$.java
package $classifier_package$;
@nl@nl
@if isClass
public class $classifier_name$
@end
@if isInterface
public interface $classifier_name$
@end
@if isEnumeration
public enum $classifier_name$
@end
@if notInterface
@if hasParent
extends $classifier_parent$
@end
@end
@if hasParentInterfaces
@if isInterface
extends
@else
implements
@end
@foreach parent_interface_list
@if last_interface
$parent_interface$
@else
$parent_interface$,
@end
@end
@end
{
@if notInterface
@foreach attribute_list
@nl @tab $attribute_visibility$ $attribute_type$ $attribute_name$ ;
@end
@end
@foreach operation_list
@nl @tab $operation_visibility$ $operation_result_type$ $operation_name$(
@foreach argument_list
@if last_argument
$argument_type$ $argument_name$
@else
$argument_type$ $argument_name$,
@end
@end
)
@if notInterface
{@nl@nl@tab}
@else
;
@end
@end
@nl }
@end

61
src/codegen/templates/java_ocl.tpl Normal file
View File

@ -0,0 +1,61 @@
@// Example template for Java
@// assumption: all classifiers are classes
@foreach classifier_list
@openfile generated/$classifier_package_path$/$classifier_name$.java
package $classifier_package$ ;
@nl@nl
@if isClass
public class $classifier_name$
@end
@if isInterface
public interface $classifier_name$
@end
@if notInterface
@if hasParent
extends $classifier_parent$
@end
@end
@if hasParentInterfaces
@if isInterface
extends
@else
implements
@end
@foreach parent_interface_list
@if last_interface
$parent_interface$
@else
$parent_interface$,
@end
@end
@end
@nl {
@if notInterface
@foreach attribute_list
@nl @tab public $attribute_type$ $attribute_name$ ;
@end
@end
@foreach operation_list
@nl @tab public $operation_result_type$ $operation_name$(
@foreach argument_list
$argument_type$ $argument_name$
@end
)
@if notInterface
{
@nl @tab @tab // Preconditions
@nl $preconditions$
@nl @tab @tab // Your Code
@nl @tab @tab // Postconditions
@nl $postconditions$
@nl@tab }
@else
;
@end
@end
@nl // Invariant
@nl $invariants$
@nl
@nl }
@end

76
src/codegen/templates/junit.tpl
View File

@ -17,6 +17,8 @@
@nl import ch.ethz.infsec.jtestdataaccessor.TestHelper;
@nl import antlr.RecognitionException;
@nl import antlr.TokenStreamException;
@nl import tudresden.ocl20.core.lib.*;
@nl import ch.ethz.infsec.jtestdataaccessor.oclexceptions.*;
@nl
@nl public class $classifier_name$Test extends Abstract$classifier_name$Test implements TestDataUser {
@ -40,7 +42,7 @@
@nl@tab@tab th = new TestHelper(classUnderTest,tda);
@nl@tab }
@foreach operation_list
@foreach unique_operation_list
@if operation_isNotPrivate
@nl@nl@tab\@Test
@nl@tab public void $operation_name$Test() throws Throwable {
@ -49,8 +51,60 @@
@nl@tab }
@end
@end
@nl}
@nl@nl
@foreach operation_list
@nl@nl@tab
/**@nl@tab
* Wrapper to call $operation_name$ and check pre-/postconditions and invariants. @nl@tab
*/
@nl@tab public $operation_result_type$ wrapped_$operation_name$(
@foreach argument_list
@if last_argument
$argument_type$ $argument_name$
@else
$argument_type$ $argument_name$,
@end
@end
) throws Throwable {@nl
@if operation_non_void
@tab@tab$operation_result_type$ result;@nl
@end
@tab@tab// Check preconditions @nl
$preconditions$@nl@tab@tab
// Execute method @nl@tab@tab
@if operation_non_void
result =
@end
testObject.$operation_name$(
@foreach argument_list
@if last_argument
$argument_name$
@else
$argument_name$,
@end
@end
);@nl
@tab@tab// Check postconditions @nl
$postconditions$@nl
@tab@tab// Check invariants @nl
@tab@tab checkInvariant();
@nl@tab@tab
@if operation_non_void
return result;
@end
@nl@tab
}@nl
@end
@nl@nl@tab
/**@nl@tab
* Check invariants of the class @nl@tab
*/@nl@tab
public void checkInvariant() throws InvariantFailedException {@nl
$invariants$
@nl@tab}
@nl}
@//--------------------------
@// Generate stub for abstract class
@ -60,7 +114,7 @@
@nl import $classifier_package$.$classifier_name$;
@nl@nl public abstract class Abstract$classifier_name$Test {
@nl@nl@tab static Value testObject;
@nl@nl@tab static $classifier_name$ testObject;
@nl@nl }
@ -74,14 +128,16 @@
@if operation_isNotPrivate
[$operation_name$]
@nl resulttype = $operation_result_type$;
@nl inputtypes =
@foreach argument_list
$argument_type$
@if not_last_argument
,
@end
@if operation_has_arguments
@nl inputtypes =
@foreach argument_list
$argument_type$
@if not_last_argument
,
@end
@end
;
@end
;
@nl #setup = ;
@nl #teardown = ;
@nl #{

2
src/codegen/templates/tpl.el
View File

@ -14,7 +14,7 @@
(list "\\W\\(@foreach\\)[ \t]*\\([a-zA-Z_-]*\\)\\W"
'(1 font-lock-keyword-face)
'(2 font-lock-variable-name-face))
(list "\\W\\(@openfile\\|@else\\|@end\\)\\W"
(list "\\W\\(@openfile\\|@openfileifnotexists\\|@else\\|@end\\)\\W"
'(0 font-lock-keyword-face))
;; variables
(list "\\$[a-zA-Z_-]*\\$"

80
src/codegen/tpl_parser.sig
View File

@ -1,40 +1,40 @@
(*****************************************************************************
* 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
| OpenFileIfNotExistsLeaf of string
| RootNode of TemplateTree list
| TextLeaf of string
val printTTree : TemplateTree -> unit
val parse : string -> TemplateTree
end
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* tpl_parser.sig - template parser of a su4sml-gcg template
* Copyright (C) 2005 Raphael Eidenbenz <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
| OpenFileIfNotExistsLeaf of string
| RootNode of TemplateTree list
| TextLeaf of string
val printTTree : TemplateTree -> unit
val parse : string -> TemplateTree
end

424
src/codegen/tpl_parser.sml
View File

@ -1,212 +1,212 @@
(*****************************************************************************
* 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.
******************************************************************************)
(** A parser for template files. *)
signature TPL_PARSER =
sig
datatype TemplateTree
= ElseNode of TemplateTree list
| EvalLeaf of TemplateTree list
| ForEachNode of string * TemplateTree list
| IfNode of string * TemplateTree list
| OpenFileLeaf of string
| OpenFileIfNotExistsLeaf of string
| RootNode of TemplateTree list
| TextLeaf of string
val printTTree : TemplateTree -> unit
val parse : string -> TemplateTree
end
structure Tpl_Parser : TPL_PARSER =
struct
open library
open Gcg_Helper
val tplStream = ref (TextIO.openString "@// dummy template\n");
fun opentFile file = (TextIO.closeIn (!tplStream) ;
tplStream := (TextIO.openIn file))
handle ex => error ("in Tpl_Parser.opentFile: \
\couldn't open preprocessed template file: "^
General.exnMessage ex)
fun cleanUp tplFile = (TextIO.closeIn (!tplStream);
OS.FileSys.remove tplFile)
fun readNextLine () = TextIO.inputLine (!tplStream)
(* FIXME: this currently uses a simple line-based template-file structure *)
(* (every line corresponds to exactly one node in this tree) *)
(* This should really be relaxed... *)
(* FIXME: add separate VariableLeaf *)
(* FIXME: merge If and Else Nodes *)
datatype TemplateTree = RootNode of TemplateTree list
| OpenFileLeaf of string
| OpenFileIfNotExistsLeaf of string
| EvalLeaf of TemplateTree list
| TextLeaf of string
| IfNode of string * TemplateTree list
(* FIXME: why a seperate ElseNode? should be part of IfNode *)
| ElseNode of TemplateTree list
| ForEachNode of string * TemplateTree list
(**
* replaceSafely (s,v,x) replaces every v that occurs unescaped in s with x.
* if v occurs escaped with "\" in s, then the "\" is removed from s.
* FIXME: move to stringhandling?
*)
fun replaceSafely _ _ "" = ""
| replaceSafely v x s =
let val v_size = size v
val s_size = size s
in
if String.isPrefix (str #"\\"^v) s
then v^replaceSafely v x (String.extract (s, v_size + 1, NONE))
else if String.isPrefix v s
then x^replaceSafely v x (String.extract (s, v_size, NONE))
else str (String.sub (s,0))^replaceSafely v x (String.extract (s, 1, NONE))
end
(** removes leading, trainling, and multiple consecutive whitespace chars. *)
(* FIXME: movev to StringHandling? *)
fun cleanLine s = String.concatWith " " (String.tokens Char.isSpace s)
(* debugging function
* prints ParseTree to stdOut
*)
fun printTplTree prefix (RootNode(l)) = (print (prefix^"root"^"\n"); List.app (printTplTree (prefix))l)
| printTplTree prefix (OpenFileLeaf(s))= print (prefix^"openfile:"^s^"\n")
| printTplTree prefix (OpenFileIfNotExistsLeaf(s))= print (prefix^"openfileifnotexists:"^s^"\n")
| printTplTree prefix (EvalLeaf(l)) = (print (prefix^"eval:\n"); List.app (printTplTree (prefix^"\t"))l)
| printTplTree prefix (TextLeaf(s)) = print (prefix^"text:"^s^"\n")
| printTplTree prefix (IfNode(s,l)) = (print (prefix^"if:"^s^"\n");List.app (printTplTree (prefix^"\t")) l)
| printTplTree prefix (ElseNode(l)) = (print (prefix^"else:"^"\n"); List.app (printTplTree (prefix^"\t")) l)
| printTplTree prefix (ForEachNode(s,l))=(print (prefix^"foreach:"^s^"\n");List.app (printTplTree (prefix^"\t")) l)
val printTTree = printTplTree ""
fun isComment s = (String.isPrefix "//" s)
(** returns the prefix of l up to the first element where f evaluates to true *)
fun takeUntil f [] = []
| takeUntil f (h::t) = if f h then [] else h::(takeUntil f t)
(** splits line into tokens considering handling escaped @ *)
fun tokenize line = let val l = joinEscapeSplitted "@" (fieldSplit #"@" line)
in
takeUntil isComment l
end
(**
* extracts the type of line.
* line type must be first token in line!
* if no control tag in line -> "text" returned
*)
fun getType l = let val sl = tokenize l
in
if (length sl = 1)
then "text" (* rather: comment *)
else hd (tokenSplit #" " (String.concat sl))
end
(**
* getContent line
* @return the content of a line
*)
fun getContent l = let val sl = tokenize l
in
if (length sl = 0) then ""
else if (length sl = 1) then hd sl
else String.concat (tl (fieldSplit #" " (String.concat (tl sl))))
end
(** cleans line, replaces nl and tabs so that no space char is left out. *)
fun preprocess s = replaceSafely "@tab" "\t" (replaceSafely "@nl" "\n" (cleanLine s))
(**
* builds the TemplateTree.
* @return a TemplateTree list
*)
fun buildTree (SOME line) =
let fun getNode ("text", c) = TextLeaf c :: buildTree (readNextLine())
| getNode ("foreach", c) = ForEachNode (c, buildTree (readNextLine()))
:: buildTree (readNextLine())
| getNode ("if", c) = IfNode (c, buildTree (readNextLine()))
:: buildTree (readNextLine())
| getNode ("else", _) = [ ElseNode (buildTree (readNextLine())) ]
| getNode ("elsif", c) = [ ElseNode [ IfNode (c, buildTree (readNextLine())) ]]
| getNode ("openfile", c) = OpenFileLeaf c :: buildTree (readNextLine())
| getNode ("openfileifnotexists", c) = OpenFileIfNotExistsLeaf c
:: buildTree (readNextLine())
| getNode ("eval", "") = EvalLeaf (buildTree (readNextLine()))
:: buildTree (readNextLine())
| getNode ("eval", expr) = EvalLeaf [ TextLeaf expr ]:: buildTree (readNextLine())
| getNode ("end",_) = []
| getNode (t,c) = error ("in Tpl_Parser.buildTree: error while parsing \
\node \""^t^"\" with content \""^c^"\".")
val prLine = preprocess line
in
getNode ((getType prLine),(getContent prLine))
end
| buildTree NONE = []
fun codegen_home _ = getOpt (OS.Process.getEnv "CODEGEN_HOME", su4sml_home()^"src/codegen")
(** calls the external cpp ( C PreProcessor).
* writes merged template to a file with extension .tmp instead of .tpl
* and returns this file
*)
fun call_cpp file =
let val targetFile = OS.FileSys.tmpName ()
val _ = OS.Process.system ("cpp -P -C "^codegen_home()^"/"^file^" "^targetFile)
in
targetFile
end
(** parse template-file
* @return the parsed template tree
*)
fun parse file = let val _ = info ("parsing template "^file)
val mergedTpl = call_cpp file;
val _ = opentFile mergedTpl;
val pt = RootNode(buildTree (readNextLine()));
val _ = cleanUp mergedTpl;
in
pt
end
end
(*****************************************************************************
* su4sml GCG - Generic Code Generator
*
* tpl_parser.sml - template parser of a su4sml-gcg template
* Copyright (C) 2005 Raphael Eidenbenz <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.
******************************************************************************)
(** A parser for template files. *)
signature TPL_PARSER =
sig
datatype TemplateTree
= ElseNode of TemplateTree list
| EvalLeaf of TemplateTree list
| ForEachNode of string * TemplateTree list
| IfNode of string * TemplateTree list
| OpenFileLeaf of string
| OpenFileIfNotExistsLeaf of string
| RootNode of TemplateTree list
| TextLeaf of string
val printTTree : TemplateTree -> unit
val parse : string -> TemplateTree
end
structure Tpl_Parser : TPL_PARSER =
struct
open library
open Gcg_Helper
val tplStream = ref (TextIO.openString "@// dummy template\n");
fun opentFile file = (TextIO.closeIn (!tplStream) ;
tplStream := (TextIO.openIn file))
handle ex => error ("in Tpl_Parser.opentFile: \
\couldn't open preprocessed template file: "^
General.exnMessage ex)
fun cleanUp tplFile = (TextIO.closeIn (!tplStream);
OS.FileSys.remove tplFile)
fun readNextLine () = TextIO.inputLine (!tplStream)
(* FIXME: this currently uses a simple line-based template-file structure *)
(* (every line corresponds to exactly one node in this tree) *)
(* This should really be relaxed... *)
(* FIXME: add separate VariableLeaf *)
(* FIXME: merge If and Else Nodes *)
datatype TemplateTree = RootNode of TemplateTree list
| OpenFileLeaf of string
| OpenFileIfNotExistsLeaf of string
| EvalLeaf of TemplateTree list
| TextLeaf of string
| IfNode of string * TemplateTree list
(* FIXME: why a seperate ElseNode? should be part of IfNode *)
| ElseNode of TemplateTree list
| ForEachNode of string * TemplateTree list
(**
* replaceSafely (s,v,x) replaces every v that occurs unescaped in s with x.
* if v occurs escaped with "\" in s, then the "\" is removed from s.
* FIXME: move to stringhandling?
*)
fun replaceSafely _ _ "" = ""
| replaceSafely v x s =
let val v_size = size v
val s_size = size s
in
if String.isPrefix (str #"\\"^v) s
then v^replaceSafely v x (String.extract (s, v_size + 1, NONE))
else if String.isPrefix v s
then x^replaceSafely v x (String.extract (s, v_size, NONE))
else str (String.sub (s,0))^replaceSafely v x (String.extract (s, 1, NONE))
end
(** removes leading, trainling, and multiple consecutive whitespace chars. *)
(* FIXME: movev to StringHandling? *)
fun cleanLine s = String.concatWith " " (String.tokens Char.isSpace s)
(* debugging function
* prints ParseTree to stdOut
*)
fun printTplTree prefix (RootNode(l)) = (print (prefix^"root"^"\n"); List.app (printTplTree (prefix))l)
| printTplTree prefix (OpenFileLeaf(s))= print (prefix^"openfile:"^s^"\n")
| printTplTree prefix (OpenFileIfNotExistsLeaf(s))= print (prefix^"openfileifnotexists:"^s^"\n")
| printTplTree prefix (EvalLeaf(l)) = (print (prefix^"eval:\n"); List.app (printTplTree (prefix^"\t"))l)
| printTplTree prefix (TextLeaf(s)) = print (prefix^"text:"^s^"\n")
| printTplTree prefix (IfNode(s,l)) = (print (prefix^"if:"^s^"\n");List.app (printTplTree (prefix^"\t")) l)
| printTplTree prefix (ElseNode(l)) = (print (prefix^"else:"^"\n"); List.app (printTplTree (prefix^"\t")) l)
| printTplTree prefix (ForEachNode(s,l))=(print (prefix^"foreach:"^s^"\n");List.app (printTplTree (prefix^"\t")) l)
val printTTree = printTplTree ""
fun isComment s = (String.isPrefix "//" s)
(** returns the prefix of l up to the first element where f evaluates to true *)
fun takeUntil f [] = []
| takeUntil f (h::t) = if f h then [] else h::(takeUntil f t)
(** splits line into tokens considering handling escaped @ *)
fun tokenize line = let val l = joinEscapeSplitted "@" (fieldSplit #"@" line)
in
takeUntil isComment l
end
(**
* extracts the type of line.
* line type must be first token in line!
* if no control tag in line -> "text" returned
*)
fun getType l = let val sl = tokenize l
in
if (length sl = 1)
then "text" (* rather: comment *)
else hd (tokenSplit #" " (String.concat sl))
end
(**
* getContent line
* @return the content of a line
*)
fun getContent l = let val sl = tokenize l
in
if (length sl = 0) then ""
else if (length sl = 1) then hd sl
else String.concat (tl (fieldSplit #" " (String.concat (tl sl))))
end
(** cleans line, replaces nl and tabs so that no space char is left out. *)
fun preprocess s = replaceSafely "@tab" "\t" (replaceSafely "@nl" "\n" (cleanLine s))
(**
* builds the TemplateTree.
* @return a TemplateTree list
*)
fun buildTree (SOME line) =
let fun getNode ("text", c) = TextLeaf c :: buildTree (readNextLine())
| getNode ("foreach", c) = ForEachNode (c, buildTree (readNextLine()))
:: buildTree (readNextLine())
| getNode ("if", c) = IfNode (c, buildTree (readNextLine()))
:: buildTree (readNextLine())
| getNode ("else", _) = [ ElseNode (buildTree (readNextLine())) ]
| getNode ("elsif", c) = [ ElseNode [ IfNode (c, buildTree (readNextLine())) ]]
| getNode ("openfile", c) = OpenFileLeaf c :: buildTree (readNextLine())
| getNode ("openfileifnotexists", c) = OpenFileIfNotExistsLeaf c
:: buildTree (readNextLine())
| getNode ("eval", "") = EvalLeaf (buildTree (readNextLine()))
:: buildTree (readNextLine())
| getNode ("eval", expr) = EvalLeaf [ TextLeaf expr ]:: buildTree (readNextLine())
| getNode ("end",_) = []
| getNode (t,c) = error ("in Tpl_Parser.buildTree: error while parsing \
\node \""^t^"\" with content \""^c^"\".")
val prLine = preprocess line
in
getNode ((getType prLine),(getContent prLine))
end
| buildTree NONE = []
fun codegen_home _ = getOpt (OS.Process.getEnv "CODEGEN_HOME", su4sml_home()^"src/codegen")
(** calls the external cpp ( C PreProcessor).
* writes merged template to a file with extension .tmp instead of .tpl
* and returns this file
*)
fun call_cpp file =
let val targetFile = OS.FileSys.tmpName ()
val _ = OS.Process.system ("cpp -P -C "^codegen_home()^"/"^file^" "^targetFile)
in
targetFile
end
(** parse template-file
* @return the parsed template tree
*)
fun parse file = let val _ = info ("parsing template "^file)
val mergedTpl = call_cpp file;
val _ = opentFile mergedTpl;
val pt = RootNode(buildTree (readNextLine()));
val _ = cleanUp mergedTpl;
in
pt
end
end

4
src/library.sml
View File

@ -117,4 +117,8 @@ fun fst (x, y) = x
fun snd (x, y) = y
fun join s nil = ""
| join s (h::nil) = h
| join s (h::t) = h^s^(join s t)
end

238
src/ocl2dresdenjava.sml Normal file
View File

@ -0,0 +1,238 @@
(**
* Conversion of OCL expressions to Java code which makes use of the
* Dresden standard ocl library.
*)
structure varcounter = struct
val count = ref ~1
fun next() = (count := !count + 1; !count)
fun nextStr() = Int.toString (next())
fun reset() = (count := ~1)
fun current() = !count
fun currentStr() = Int.toString(current())
end
structure Ocl2DresdenJava = struct open library open Rep_OclType open Rep_OclTerm open Rep_Core
fun ocl2java' oclterm on =
let
fun count res = Int.toString(snd res)
fun code res = fst res
fun newNode ntype ncode = "final "^ntype^" oclNode"^(varcounter.nextStr())^" = "^ncode^";\n"
fun newFact () = ("final UmlOclFactory oclFact"^(varcounter.nextStr())^" = UmlOclFactory.getInstance();\n",
varcounter.current())
fun node nid = "oclNode"^(count nid)
fun fact fid = "oclFact"^(count fid)
fun ifStmt cond thenb elseb rest =
let
val condition = ocl2java' cond on
val thenbranch = ocl2java' thenb on
val elsebranch = ocl2java' elseb on
in
((code condition)^
(code thenbranch)^
(code elsebranch)^
(newNode ("Ocl"^(string_of_OclType rest)) ("Ocl.toOcl"^(string_of_OclType rest)^"("^(node condition)^".ifThenElse("^(node thenbranch)^", "^(node elsebranch)^"))")),
varcounter.current())
end
fun attrCall src path ptype =
let
val target = ocl2java' src on
fun node' typ typobj = (newNode ("Ocl"^typ) ("Ocl.toOcl"^typ^"("^(node target)^".getFeature("^(node typobj)^", \""^(hd (rev path))^"\"))"))
in
case ptype of (Classifier p) =>
let
val factory = newFact ()
val oclmodeltype = (newNode "OclModelType" ((fact factory)^".getOclModelTypeFor(\""^(string_of_OclType_colon ptype)^"\")"),varcounter.current())
in
((code factory)^
(code target)^
(code oclmodeltype)^
(node' "ModelObject" oclmodeltype),
varcounter.current())
end
| _ =>
let
val oclprimtype = (newNode "OclPrimitiveType" ("OclPrimitiveType.getOcl"^(string_of_OclType ptype)^"()"),varcounter.current())
in
((code target)^
(code oclprimtype)^
(node' (string_of_OclType ptype) oclprimtype),
varcounter.current())
end
end
fun var name t =
let
val factory = newFact ()
val vname = if name = "self" then on else name
in
case t of Integer =>
let
val integertype = (newNode "OclPrimitiveType" "OclPrimitiveType.getOclInteger()",varcounter.current())
in
((code factory)^
(code integertype)^
(newNode "OclInteger" ("(OclInteger)"^(fact factory)^".getOclRepresentationFor("^(node integertype)^", "^vname^")")),
varcounter.current())
end
| _ =>
let
val modeltype = (newNode "OclModelType" ((fact factory)^".getOclModelTypeFor(\""^(string_of_OclType_colon t)^"\")"),
varcounter.current())
in
((code factory)^
(code modeltype)^
(newNode "OclModelObject" ("(OclModelObject)"^(fact factory)^".getOclRepresentationFor("^(node modeltype)^", "^vname^")")),
varcounter.current())
end
end
fun string_of_binop src bop arg rtype =
let
val left = ocl2java' src on
val right = ocl2java' arg on
in
((code left)^
(code right)^
(newNode ("Ocl"^(string_of_OclType rtype)) ((node left)^"."^bop^"("^(node right)^")")),
varcounter.current())
end
fun string_of_unop src sop rtype =
let
val right = ocl2java' src on
in
((code right)^
(newNode ("Ocl"^(string_of_OclType rtype)) ((node right)^"."^sop^"()")),
varcounter.current())
end
fun emptySet () = (newNode "OclSet" "OclSet.getEmptyOclSet()",
varcounter.current())
fun oclset src =
let
val src' = ocl2java' src on
val set = emptySet ()
in
((code src')^
(code set)^
(node set)^".setToInclude("^(node src')^");\n",
varcounter.current())
end
fun oclnotempty src =
let
val src' = ocl2java' src on
in
((code src')^
(newNode "OclBoolean" ((node src')^".notEmpty()")),
varcounter.current())
end
fun oclempty src =
let
val src' = ocl2java' src on
in
((code src')^
(newNode "OclBoolean" ((node src')^".isEmpty()")),
varcounter.current())
end
fun oclsize src =
let
val src' = ocl2java' src on
in
((code src')^
(newNode "OclInteger" ((node src')^".size()")),
varcounter.current())
end
in
case oclterm of
Literal ("true",Boolean) => (newNode "OclBoolean" "OclBoolean.TRUE",varcounter.current())
| Literal ("false",Boolean) => (newNode "OclBoolean" "OclBoolean.FALSE",varcounter.current())
| Literal (l,Integer) => (newNode "OclInteger" ("new OclInteger("^l^")"),varcounter.current())
(* Logical operators *)
| OperationCall (src,Boolean,["oclLib","Boolean","and"],[(arg,Boolean)],rtype) => string_of_binop src "and" arg rtype
| OperationCall (src,Boolean,["oclLib","Boolean","or"],[(arg,Boolean)],rtype) => string_of_binop src "or" arg rtype
| OperationCall (src,Boolean,["oclLib","Boolean","xor"],[(arg,Boolean)],rtype) => string_of_binop src "xor" arg rtype
| OperationCall (src,Boolean,["oclLib","Boolean","not"],[],rtype) => string_of_unop src "not" rtype
| OperationCall (src,Boolean,["oclLib","Boolean","implies"],[(arg,Boolean)],rtype) => string_of_binop src "implies" arg rtype
(* Comparison operators *)
| OperationCall (src,styp,["oclLib",classifier,"="],[(arg,atyp)],rtype) => string_of_binop src "isEqualTo" arg rtype
| OperationCall (src,styp,["oclLib",classifier,"<>"],[(arg,atyp)],rtype) => string_of_binop src "isNotEqualTo" arg rtype
| OperationCall (src,styp,["oclLib",classifier,"=="],[(arg,atyp)],rtype) => string_of_binop src "isEqualTo" arg rtype
| OperationCall (src,styp,["oclLib",classifier,"~="],[(arg,atyp)],rtype) => string_of_binop src "isNotEqualTo" arg rtype
(* OCL Real *)
| OperationCall (src,styp,["oclLib",classifier,"round"],[],rtype) => string_of_unop src "round" rtype
| OperationCall (src,styp,["oclLib",classifier,"floor"],[],rtype) => string_of_unop src "floor" rtype
| OperationCall (src,styp,["oclLib",classifier,"min"],[(arg,atyp)],rtype) => string_of_binop src "min" arg rtype
| OperationCall (src,styp,["oclLib",classifier,"max"],[(arg,atyp)],rtype) => string_of_binop src "max" arg rtype
| OperationCall (src,styp,["oclLib",classifier,"/"],[(arg,atyp)],rtype) => string_of_binop src "divide" arg rtype
| OperationCall (src,styp,["oclLib",classifier,"abs"],[],rtype) => string_of_unop src "abs" rtype
| OperationCall (src,styp,["oclLib",classifier,"-"],[(arg,atyp)],rtype) => string_of_binop src "subtract" arg rtype
| OperationCall (src,styp,["oclLib",classifier,"+"],[(arg,atyp)],rtype) => string_of_binop src "add" arg rtype
| OperationCall (src,styp,["oclLib",classifier,"*"],[(arg,atyp)],rtype) => string_of_binop src "multiply" arg rtype
(* OCL Integer *)
| OperationCall (src,styp,["oclLib",classifier,"mod"],[(arg,atyp)],rtyp) => string_of_binop src "mod" arg rtyp
| OperationCall (src,styp,["oclLib",classifier,"div"],[(arg,atyp)],rtyp) => string_of_binop src "div" arg rtyp
| OperationCall (src,styp,["oclLib",classifier,"-"],[],rtyp) => string_of_unop src "negative" rtyp
(* OCL Numerals *)
| OperationCall (src,styp,["oclLib",classifier,"<"],[(arg,atyp)],rtyp) => string_of_binop src "isLessThan" arg rtyp
| OperationCall (src,styp,["oclLib",classifier,"<="],[(arg,atyp)],rtyp) => string_of_binop src "isLessEqual" arg rtyp
| OperationCall (src,styp,["oclLib",classifier,">"],[(arg,atyp)],rtyp) => string_of_binop src "isGreaterThan" arg rtyp
| OperationCall (src,styp,["oclLib",classifier,">="],[(arg,atyp)],rtyp) => string_of_binop src "isGreaterEqual" arg rtyp
(* Some collection operations *)
| OperationCall (src,styp,["oclLib",_,"asSet"],[],rtyp) => oclset src
| OperationCall (src,styp,["oclLib",_,"notEmpty"],[],rtyp) => oclnotempty src
| OperationCall (src,styp,["oclLib",_,"isEmpty"],[],rtyp) => oclempty src
| OperationCall (src,styp,["oclLib",_,"size"],[],rtyp) => oclsize src
(* If *)
| If (cond,condt,thenb,thent,elseb,elset,rest) => ifStmt cond thenb elseb rest
(* Access to attributes *)
| AttributeCall (src,styp,path,ptype) => attrCall src path ptype
(* Access to variables *)
| Variable (name, t) => var name t
| _ => (Ocl2String.ocl2string true oclterm, 0)
end
fun ocl2java oclterm on = fst (ocl2java' oclterm on)
(* Convert list of arguments ((string * Rep_OclType.OclType) list) to a comma separated string *)
fun opargs2string args =
let
fun arg2string (name,typ) = (Rep_OclType.string_of_OclType typ)^" "^name
in
join ", " (List.map arg2string args )
end
(* Check the result of checking a condition *)
fun checkConditionResult condition name condType uut =
let
val name' = case name of SOME t => " "^t
| NONE => ""
in
(fst condition)^
"if(!oclNode"^(Int.toString(snd condition))^".isTrue()){"^
"\n\tthrow new "^condType^"FailedException(\""^condType^name'^" of "^uut^" failed!\");\n"^
"}\n"
end
(* Create the string which checks preconditions *)
fun precondString env on curOp =
let fun getPrecond precond = checkConditionResult (ocl2java' (snd precond) on) (fst precond) "Precondition" ((Rep_Core.name_of_op curOp)^"("^(opargs2string (Rep_Core.arguments_of_op curOp))^")")
in
join "\n" (List.map getPrecond (Rep_Core.precondition_of_op curOp))
end
(* Create the string which checks postconditions *)
fun postcondString env on curOp =
let fun getPostcond postcond = checkConditionResult (ocl2java' (snd postcond) on) (fst postcond) "Postcondition" ((Rep_Core.name_of_op curOp)^"("^(opargs2string (Rep_Core.arguments_of_op curOp))^")")
in
join "\n" (List.map getPostcond (Rep_Core.postcondition_of_op curOp))
end
(* Create the string which checks invariants *)
fun invString env on curCl =
let fun getInvariant invariant = checkConditionResult (ocl2java' (snd invariant) on) (fst invariant) "Invariant" (Rep_Core.short_name_of curCl)
in
join "\n" (List.map getInvariant (Rep_Core.invariant_of curCl))
end
end

13
src/rep_core.sml
View File

@ -111,8 +111,10 @@ val package_of : Classifier -> Rep_OclType.Path
val short_name_of : Classifier -> string
val parent_name_of : Classifier -> Rep_OclType.Path
val parent_interface_names_of : Classifier -> Rep_OclType.Path list
val parent_package_of : Classifier -> Rep_OclType.Path
val short_parent_name_of : Classifier -> string
val parent_interfaces_of : Classifier -> Rep_OclType.OclType list
val thy_name_of : Classifier -> string
val update_thyname : string -> Classifier -> Classifier
@ -494,6 +496,7 @@ fun parent_name_of (C as Class{parent,...}) =
| parent_name_of (Template _) = error "in Rep.parent_name_of: \
\unsupported argument type Template"
fun short_parent_name_of C = case (parent_name_of C) of
[] => error "in Rep.short_parent_name_of: empty type"
| p => (hd o rev) p
@ -528,6 +531,16 @@ fun parent_package_of (Class{parent,...}) =
error "in Rep.parent_package_of: unsupported argument type Template"
(* Get parent interfaces of a Classifier. *)
fun parent_interfaces_of (Interface{parents,...}) = parents
| parent_interfaces_of (Class{interfaces,...}) = interfaces
| parent_interfaces_of (Enumeration{interfaces,...}) = interfaces
| parent_interfaces_of (Primitive{interfaces,...}) = interfaces
| parent_interfaces_of (Template{...}) = error "parent_interfaces_of <Template> not supported"
(* Get the names of parent interfaces of a Classifier *)
fun parent_interface_names_of c = map path_of_OclType (parent_interfaces_of c)
fun attributes_of (Class{attributes,...}) = attributes
| attributes_of (Interface{...}) =
error "in Rep.attributes_of: argument is Interface"

34
src/rep_ocl.sml
View File

@ -37,6 +37,7 @@ sig
val path_of_OclType : OclType -> Path
val string_of_OclType : OclType -> string
val string_of_path : Path -> string
val string_of_OclType_colon : OclType -> string
val pathstring_of_path: Path -> string
val is_Classifier : OclType -> bool
val is_Collection : OclType -> bool
@ -114,24 +115,31 @@ fun string_of_path (path:Path) = path_to_string path "."
(** Convert Path to a string using /, creating a Unix directory like string *)
fun pathstring_of_path (path:Path) = path_to_string path "/"
fun string_of_OclType Integer = "Integer"
| string_of_OclType Real = "Real"
| string_of_OclType String = "String"
| string_of_OclType Boolean = "Boolean"
| string_of_OclType OclAny = "OclAny"
| string_of_OclType (Set t) = ("Set("^(string_of_OclType t)^")")
| string_of_OclType (Sequence t) = ("Sequence("^(string_of_OclType t)^")")
| string_of_OclType (OrderedSet t) = ("OrderedSet("^(string_of_OclType t)^")")
| string_of_OclType (Bag t) = ("Bag("^(string_of_OclType t)^")")
| string_of_OclType (Collection t) = ("Collection("^(string_of_OclType t)^")")
| string_of_OclType OclVoid = "OclVoid"
| string_of_OclType (Classifier p) = (string_of_path p)
| string_of_OclType DummyT = "DummyT"
fun string_of_OclType' f Integer = "Integer"
| string_of_OclType' f Real = "Real"
| string_of_OclType' f String = "String"
| string_of_OclType' f Boolean = "Boolean"
| string_of_OclType' f OclAny = "OclAny"
| string_of_OclType' f (Set t) = ("Set("^(string_of_OclType' f t)^")")
| string_of_OclType' f (Sequence t) = ("Sequence("^(string_of_OclType' f t)^")")
| string_of_OclType' f (OrderedSet t) = ("OrderedSet("^(string_of_OclType' f t)^")")
| string_of_OclType' f (Bag t) = ("Bag("^(string_of_OclType' f t)^")")
| string_of_OclType' f (Collection t) = ("Collection("^(string_of_OclType' f t)^")")
| string_of_OclType' f OclVoid = "OclVoid"
| string_of_OclType' f (Classifier p) = (path_to_string p f)
| string_of_OclType' f DummyT = "DummyT"
fun string_of_OclType t = string_of_OclType' "." t
fun path_of_OclType (Classifier p) = p
| path_of_OclType (TemplateParameter p) = [] (* FIXME *)
| path_of_OclType x = ["oclLib",string_of_OclType x]
(** Convert OclType to a string with :: in between *)
fun string_of_OclType_colon t = string_of_OclType' "::" t
fun is_Classifier (Classifier p) = true
| is_Classifier _ = false

4
src/rep_state_machines.sml
View File

@ -45,7 +45,7 @@ type Transition
type PseudoStateVars = XMI_StateMachines.PseudoStateVars
type StateMachine
datatype StateVertex =
State_CompositeState
of {name : string,
@ -91,8 +91,6 @@ datatype StateVertex =
outgoing : Transition_Id list,
incoming : Transition_Id list}
(* | StubState *)
withtype StateMachine = {top : StateVertex,
transition : Transition list}
val isInit : StateVertex -> bool

1
src/su4sml.cm
View File

@ -37,3 +37,4 @@ Group is
xmltree_writer.sml
xmi_idtable.sml
ocl2string.sml
ocl2dresdenjava.sml

5
src/su4sml.mlb
View File

@ -8,8 +8,8 @@ in
$(MLTON_ROOT)/smlnj-lib/Util/smlnj-lib.mlb
../lib/fxp/src/fxlib.mlb
in
codegen/compiler/compiler_ext.sig
codegen/compiler/mlton.sml
compiler/compiler_ext.sig
compiler/mlton.sml
library.sml
xmi_ocl.sml
xmltree.sml
@ -39,5 +39,6 @@ in
rep_parser.sml
rep_secure.sml
rep_su2holocl.sml
ocl2dresdenjava.sml
end
end