re-worked logger
git-svn-id: https://projects.brucker.ch/su4sml/svn/su4sml/trunk@8370 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
parent
ef3d967d8a
commit
f4f523bb50
|
@ -39,6 +39,7 @@
|
|||
******************************************************************************)
|
||||
(* $Id$ *)
|
||||
|
||||
use "config.sml";
|
||||
use "rep_helper.sml";
|
||||
use "rep_logger.sml";
|
||||
use "stringHandling.sml";
|
||||
|
|
|
@ -70,7 +70,6 @@ end
|
|||
structure Base_Cartridge : BASE_CARTRIDGE =
|
||||
struct
|
||||
|
||||
open Rep_Logger
|
||||
(* translation functions *)
|
||||
(* type translation table *)
|
||||
|
||||
|
@ -187,7 +186,7 @@ fun lookup env "classifier_name" = Rep_Core.short_name_of (curClassifier' 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^"$")
|
||||
| lookup _ s = (Logger.warn ("in Base_Cartridge.lookup: unknown variable \""^s^"\"."); "$"^s^"$")
|
||||
|
||||
|
||||
(**
|
||||
|
@ -254,7 +253,7 @@ fun test env "isClass" = (case (#curClassifier env) of
|
|||
| 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^"\".")
|
||||
| test env s = Logger.error ("in Base_Cartridge.test: undefined predicate: \""^s^"\".")
|
||||
|
||||
|
||||
(* fun foreach_classifier: environment -> environment list *)
|
||||
|
@ -434,7 +433,7 @@ fun foreach "classifier_list" env = foreach_classifier env
|
|||
| foreach listType env = map (pack env)
|
||||
(<SuperCartridge>.foreach name (unpack env))
|
||||
*)
|
||||
| foreach s _ = (error_msg ("in Base_Cartridge.foreach: unknown list \""^s^"\".");
|
||||
| foreach s _ = (Logger.error ("in Base_Cartridge.foreach: unknown list \""^s^"\".");
|
||||
[])
|
||||
|
||||
end
|
||||
|
|
|
@ -45,7 +45,6 @@ struct
|
|||
structure SuperCart = SecureUML_Cartridge(structure SuperCart=S; structure D=ComponentUML)
|
||||
|
||||
structure Design = SuperCart.Security.Design
|
||||
open Rep_Logger
|
||||
|
||||
(* TODO: fill out *)
|
||||
type environment = { curPermissionList : SuperCart.Security.Permission list option,
|
||||
|
@ -141,7 +140,7 @@ fun test env "first_permission" =
|
|||
fun foreach_permission env name =
|
||||
let val action = Option.valOf (List.find (fn x => ComponentUML.action_type_of x = name)
|
||||
(atomic_actions_from_context env))
|
||||
handle Option => error ("error in finding action "^name)
|
||||
handle Option => Logger.error ("error in finding action "^name)
|
||||
val permissions = permissions_for_action env action
|
||||
fun env_from_list_item c = { curPermissionList = SOME permissions,
|
||||
curPermission = SOME c,
|
||||
|
|
|
@ -54,7 +54,6 @@ end
|
|||
functor GCG_Core (C: CARTRIDGE): GCG =
|
||||
struct
|
||||
|
||||
open Rep_Logger
|
||||
|
||||
val curFile = ref ""
|
||||
val out = ref TextIO.stdOut
|
||||
|
@ -67,14 +66,14 @@ fun closeFile () = if (!curFile = "")
|
|||
|
||||
(* FIXME: set out to a real NullStream *)
|
||||
fun openNull file = (closeFile ();
|
||||
info ("skipping "^file);
|
||||
Logger.info ("skipping "^file);
|
||||
out := (TextIO.openOut "/dev/null");
|
||||
curFile := "/dev/null"
|
||||
)
|
||||
|
||||
|
||||
fun openFile file = (closeFile ();
|
||||
info ("opening "^file);
|
||||
Logger.info ("opening "^file);
|
||||
Gcg_Helper.assureDir file;
|
||||
out := (TextIO.openOut file);
|
||||
curFile := file
|
||||
|
@ -91,7 +90,7 @@ fun initOut () = (out := TextIO.stdOut;
|
|||
|
||||
fun writeLine s = TextIO.output (!out,s)
|
||||
|
||||
fun eval s = (info "<eval>"; CompilerExt.eval true s)
|
||||
fun eval s = (Logger.info "<eval>"; CompilerExt.eval true s)
|
||||
|
||||
(** applies f to every other element in l starting with the second
|
||||
*)
|
||||
|
@ -103,7 +102,7 @@ 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: \
|
||||
handle ex => (Logger.error ("in GCG_Core.substituteVars: \
|
||||
\variable lookup failure in string \""^s^"\".");
|
||||
s)
|
||||
end
|
||||
|
@ -117,7 +116,7 @@ fun write env (Tpl_Parser.RootNode(l)) = List.app (write env)
|
|||
let fun collectEval [] = ""
|
||||
| collectEval ((Tpl_Parser.TextLeaf(expr))::t) = expr^"\n"^(collectEval t)
|
||||
| collectEval _ =
|
||||
error "in GCG_Core.write: No TextLeaf in EvalLeaf"
|
||||
Logger.error "in GCG_Core.write: No TextLeaf in EvalLeaf"
|
||||
in
|
||||
eval (substituteVars env (collectEval l))
|
||||
end
|
||||
|
@ -131,7 +130,7 @@ fun write env (Tpl_Parser.RootNode(l)) = List.app (write env)
|
|||
then writeThen env l
|
||||
else case (List.last l) of nd as (Tpl_Parser.ElseNode(_)) => write env nd
|
||||
| _ => ())
|
||||
handle ex => error ("in GCG_Core.write: problem in IfNode "^cond)
|
||||
handle ex => Logger.error ("in GCG_Core.write: problem in IfNode "^cond)
|
||||
end
|
||||
| write env (Tpl_Parser.ElseNode(l)) = List.app (write env) l
|
||||
| write env (Tpl_Parser.ForEachNode(listType,children))=
|
||||
|
@ -139,7 +138,7 @@ fun write env (Tpl_Parser.RootNode(l)) = List.app (write 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^
|
||||
handle ex => (Logger.error ("in GCG_Core.write: error in foreach node "^listType^
|
||||
": "^General.exnMessage ex);
|
||||
())
|
||||
end
|
||||
|
@ -154,7 +153,7 @@ fun generate model template
|
|||
(*printTTree tree;*)
|
||||
write env tree;
|
||||
closeFile ();
|
||||
info "codegen finished successfully"
|
||||
Logger.info "codegen finished successfully"
|
||||
)
|
||||
handle ex => (closeFile(); raise ex)
|
||||
end
|
||||
|
|
|
@ -43,7 +43,6 @@
|
|||
(* Probably, some things have to be adjusted to Java syntax *)
|
||||
functor Java_Cartridge(SuperCart : BASE_CARTRIDGE) : BASE_CARTRIDGE =
|
||||
struct
|
||||
open Rep_Logger
|
||||
open Rep_OclType
|
||||
|
||||
|
||||
|
|
|
@ -75,7 +75,6 @@ functor SecureUML_Cartridge(structure SuperCart : BASE_CARTRIDGE;
|
|||
structure D: DESIGN_LANGUAGE) : SECUREUML_CARTRIDGE =
|
||||
struct
|
||||
|
||||
open Rep_Logger
|
||||
structure Security = SecureUML(structure Design = D)
|
||||
|
||||
(*type Model = Rep.Classifier list * Security.Configuration*)
|
||||
|
@ -154,7 +153,7 @@ fun lookup env "permission_name" = #name (curPermission' env)
|
|||
| lookup env "subject_name" = (Security.subject_name_of o valOf o curSubject) env
|
||||
| lookup env "superrole_name" = (name_of_role o valOf o curSuperrole) env
|
||||
| lookup env s = SuperCart.lookup (unpack env) s
|
||||
handle Option => error "variable outside of context"
|
||||
handle Option => Logger.error "variable outside of context"
|
||||
(********** ADDING IF-CONDITION TYPE *****************************************)
|
||||
fun test env "first_permission" = (curPermission' env = hd (PermissionSet env))
|
||||
| test env "first_role" = (curRole' env = hd (#roles (curPermission' env)))
|
||||
|
@ -193,7 +192,7 @@ fun foreach_role (env:environment)
|
|||
(** iterate over all superroles in the context of a role *)
|
||||
fun foreach_superrole (env:environment) =
|
||||
let val cur = valOf (curRole env )
|
||||
handle Option => error ("no current role")
|
||||
handle Option => Logger.error ("no current role")
|
||||
val superroles = List.mapPartial (fn (r,s) => if r=cur then SOME s
|
||||
else NONE)
|
||||
(#rh (security_conf env))
|
||||
|
|
|
@ -61,14 +61,13 @@ end
|
|||
|
||||
structure Tpl_Parser : TPL_PARSER =
|
||||
struct
|
||||
open Rep_Logger
|
||||
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: \
|
||||
handle ex => Logger.error ("in Tpl_Parser.opentFile: \
|
||||
\couldn't open preprocessed template file: "^
|
||||
General.exnMessage ex)
|
||||
|
||||
|
@ -157,7 +156,7 @@ fun getType l = let val sl = tokenize l
|
|||
then "text" (* rather: comment? *)
|
||||
else hd (tokenSplit #" " (String.concat sl))
|
||||
end
|
||||
handle ex => error ("in Tpl_Parser.getType: "^General.exnMessage ex)
|
||||
handle ex => Logger.error ("in Tpl_Parser.getType: "^General.exnMessage ex)
|
||||
|
||||
(**
|
||||
* getContent line
|
||||
|
@ -169,7 +168,7 @@ fun getContent l = let val sl = tokenize l
|
|||
else if (length sl = 1) then hd sl
|
||||
else String.concat (tl (fieldSplit #" " (String.concat (tl sl))))
|
||||
end
|
||||
handle ex => error ("in Tpl_Parser.getContent: "^General.exnMessage ex)
|
||||
handle ex => Logger.error ("in Tpl_Parser.getContent: "^General.exnMessage ex)
|
||||
|
||||
(** cleans line, replaces nl and tabs so that no space char is left out. *)
|
||||
fun preprocess s = replaceSafely "@spc" " " (replaceSafely "@tab" "\t" (replaceSafely "@nl" "\n" (cleanLine s)))
|
||||
|
@ -194,18 +193,18 @@ fun buildTree (SOME line) =
|
|||
:: buildTree (readNextLine())
|
||||
| getNode ("eval", expr) = EvalLeaf [ TextLeaf expr ]:: buildTree (readNextLine())
|
||||
| getNode ("end",_) = []
|
||||
| getNode (t,c) = error ("in Tpl_Parser.buildTree: error while parsing \
|
||||
| getNode (t,c) = Logger.error ("in Tpl_Parser.buildTree: error while parsing \
|
||||
\node \""^t^"\" with content \""^c^"\".")
|
||||
val prLine = preprocess line
|
||||
in
|
||||
getNode ((getType prLine),(getContent prLine))
|
||||
end
|
||||
handle ex => error ("in Tpl_Parser.buildTree: error "^General.exnMessage ex))
|
||||
handle ex => Logger.error ("in Tpl_Parser.buildTree: error "^General.exnMessage ex))
|
||||
| buildTree NONE = []
|
||||
|
||||
|
||||
|
||||
fun codegen_home _ = getOpt (OS.Process.getEnv "CODEGEN_HOME", su4sml_home()^"/codegen")
|
||||
fun codegen_home _ = getOpt (OS.Process.getEnv "CODEGEN_HOME", Config.su4sml_home()^"/codegen")
|
||||
|
||||
(** calls the external cpp ( C PreProcessor).
|
||||
* writes merged template to a file with extension .tmp instead of .tpl
|
||||
|
@ -223,7 +222,7 @@ fun call_cpp file =
|
|||
(** parse template-file
|
||||
* @return the parsed template tree
|
||||
*)
|
||||
fun parse file = let val _ = info ("parsing template "^file)
|
||||
fun parse file = let val _ = Logger.info ("parsing template "^file)
|
||||
val mergedTpl = call_cpp file;
|
||||
val _ = opentFile mergedTpl;
|
||||
val pt = RootNode(buildTree (readNextLine()));
|
||||
|
|
|
@ -75,7 +75,7 @@ fun eval verbose txt =
|
|||
if verbose then print (output ()) else ()
|
||||
end
|
||||
in
|
||||
eval_fh (fn s => print (s^"\n"), fn s => Rep_Logger.error (s^"\n")) verbose txt
|
||||
eval_fh (fn s => print (s^"\n"), fn s => Logger.error (s^"\n")) verbose txt
|
||||
end
|
||||
|
||||
fun exnHistory _ = []
|
||||
|
|
|
@ -70,7 +70,7 @@ fun eval verbose txt =
|
|||
if verbose then print (output ()) else ()
|
||||
end
|
||||
in
|
||||
eval_fh (fn s => print (s^"\n"), fn s => Rep_Logger.error (s^"\n")) verbose txt
|
||||
eval_fh (fn s => print (s^"\n"), fn s => Logger.error (s^"\n")) verbose txt
|
||||
end
|
||||
|
||||
fun exnHistory _ = []
|
||||
|
|
|
@ -64,7 +64,7 @@ fun eval verbose txt =
|
|||
if verbose then print (output ()) else ()
|
||||
end
|
||||
in
|
||||
eval_fh (fn s => print (s^"\n"), fn s => Rep_Logger.error s) verbose txt
|
||||
eval_fh (fn s => print (s^"\n"), fn s => Logger.error s) verbose txt
|
||||
end
|
||||
|
||||
fun exnHistory e = SMLofNJ.exnHistory e
|
||||
|
|
|
@ -43,7 +43,6 @@
|
|||
(** Auxiliary structure to specialize the resource type for ComponentUML. *)
|
||||
structure ComponentUMLResource =
|
||||
struct
|
||||
open Rep_Logger
|
||||
(** The type of resource, plus a path name specifiying the resource.
|
||||
* Resource types can be entities, methods, and attributes.
|
||||
* FIX: using Path for methods is unsafe, there can be severable
|
||||
|
@ -72,24 +71,24 @@ val root_stereotypes = ["compuml.entity"]
|
|||
|
||||
(** The list of all attributes of an entity. *)
|
||||
fun entity_contained_attributes (Entity c) = map EntityAttribute (Rep.attributes_of c)
|
||||
| entity_contained_attributes _ = error "in entity_contained_attributes: \
|
||||
| entity_contained_attributes _ = Logger.error "in entity_contained_attributes: \
|
||||
\argument is not an entity"
|
||||
|
||||
(** the list of all methods of an entity *)
|
||||
fun entity_contained_methods (Entity c) = map EntityMethod (Rep.operations_of c)
|
||||
| entity_contained_methods _ = error "in entity_contained_methods: \
|
||||
| entity_contained_methods _ = Logger.error "in entity_contained_methods: \
|
||||
\argument is not an entity"
|
||||
|
||||
(** The list of all side-effect free methods of an entity. *)
|
||||
fun entity_contained_read_methods (Entity c) =
|
||||
map EntityMethod (List.filter #isQuery (Rep.operations_of c))
|
||||
| entity_contained_read_methods _ = error "in entity_contained_read_methods: \
|
||||
| entity_contained_read_methods _ = Logger.error "in entity_contained_read_methods: \
|
||||
\argument is not an entity"
|
||||
|
||||
(** The list of all methods with side-effects of an entity *)
|
||||
fun entity_contained_update_methods (Entity c) =
|
||||
map EntityMethod (List.filter (not o #isQuery) (Rep.operations_of c))
|
||||
| entity_contained_update_methods _ = error
|
||||
| entity_contained_update_methods _ = Logger.error
|
||||
"in entity_contained_update_methods: \
|
||||
\argument is not an entity"
|
||||
|
||||
|
@ -113,7 +112,7 @@ fun parse_entity_action root att_name "create" =
|
|||
SimpleAction ("delete", (Entity root))
|
||||
| parse_entity_action root att_name "fullaccess" =
|
||||
CompositeAction ("fullaccess", (Entity root))
|
||||
| parse_entity_action root att_name s = error ("in parse_entity_action: \
|
||||
| parse_entity_action root att_name s = Logger.error ("in parse_entity_action: \
|
||||
\unknown action type "^s)
|
||||
|
||||
(** parses an entity attribute action permission attribute. *)
|
||||
|
@ -121,21 +120,21 @@ fun parse_attribute_action root name "read" =
|
|||
(SimpleAction ("read",
|
||||
(EntityAttribute ((hd o List.filter (fn x => #name x = name))
|
||||
(Rep.attributes_of root))))
|
||||
handle Empty => error ("in parse_attribute_action: \
|
||||
handle Empty => Logger.error ("in parse_attribute_action: \
|
||||
\did not find attribute "^name))
|
||||
| parse_attribute_action root name "update" =
|
||||
( SimpleAction ("update",
|
||||
(EntityAttribute ((hd o List.filter (fn x => #name x = name))
|
||||
(Rep.attributes_of root))))
|
||||
handle Empty => error ("in parse_attribute_action: \
|
||||
handle Empty => Logger.error ("in parse_attribute_action: \
|
||||
\did not find attribute "^name))
|
||||
| parse_attribute_action root name "fullaccess" =
|
||||
( CompositeAction ("fullaccess",
|
||||
(EntityAttribute ((hd o List.filter (fn x => #name x = name))
|
||||
(Rep.attributes_of root))))
|
||||
handle Empty => error ("in parse_attribute_action: \
|
||||
handle Empty => Logger.error ("in parse_attribute_action: \
|
||||
\did not find attribute "^name))
|
||||
| parse_attribute_action root name s = error ("in parse_attribute_action: \
|
||||
| parse_attribute_action root name s = Logger.error ("in parse_attribute_action: \
|
||||
\unknown action type "^s^
|
||||
"for attribute action "^name)
|
||||
|
||||
|
@ -144,8 +143,8 @@ fun parse_method_action root name "execute"
|
|||
= (SimpleAction ("execute",
|
||||
(EntityMethod ((hd o List.filter (fn x => #name x = name))
|
||||
(Rep.operations_of root))))
|
||||
handle Empty => error ("in parse_method_action: did not find method "^name))
|
||||
| parse_method_action roor name s = error ("unknown action type "^s^
|
||||
handle Empty => Logger.error ("in parse_method_action: did not find method "^name))
|
||||
| parse_method_action roor name s = Logger.error ("unknown action type "^s^
|
||||
"for method action "^name)
|
||||
|
||||
(**
|
||||
|
@ -156,7 +155,7 @@ fun parse_action root (att:Rep.attribute) =
|
|||
let val att_name = #name att
|
||||
val att_type = #attr_type att
|
||||
val cls_path = case att_type of Rep_OclType.Classifier x => x
|
||||
| _ => error "type of permission attribute \
|
||||
| _ => Logger.error "type of permission attribute \
|
||||
\is not a classifier"
|
||||
val action_name = hd (rev cls_path)
|
||||
fun resource_path name = (hd o List.tl) (String.tokens (fn x => x= #".") name)
|
||||
|
@ -167,10 +166,10 @@ fun parse_action root (att:Rep.attribute) =
|
|||
parse_method_action root (resource_path att_name) action_name
|
||||
| "dialect.entityattributeaction" =>
|
||||
parse_attribute_action root (resource_path att_name) action_name
|
||||
| s => error ("in ComponentUML.parse_action: "^
|
||||
| s => Logger.error ("in ComponentUML.parse_action: "^
|
||||
"permission attribute "^att_name^"has unexpected stereotype "^s)
|
||||
end
|
||||
handle ex => (error_msg "in ComponentUML.parse_action: \
|
||||
handle ex => (Logger.warn "in ComponentUML.parse_action: \
|
||||
\could not parse permission attribute"; raise ex)
|
||||
|
||||
fun action_type_of (SimpleAction (t,_)) = t
|
||||
|
@ -219,7 +218,7 @@ fun subordinated_actions (SimpleAction _) = nil
|
|||
| subordinated_actions (CompositeAction ("full_access", a as (EntityAttribute ae)))
|
||||
= [SimpleAction ("read", a),
|
||||
SimpleAction ("update", a)]
|
||||
| subordinated_actions (CompositeAction (s,_)) = error ("in subordinated_actions: \
|
||||
| subordinated_actions (CompositeAction (s,_)) = Logger.error ("in subordinated_actions: \
|
||||
\unsupported composite action \
|
||||
\type "^s)
|
||||
end
|
||||
|
|
|
@ -0,0 +1,62 @@
|
|||
(*****************************************************************************
|
||||
* su4sml --- a SML repository for managing (Secure)UML/OCL models
|
||||
* http://projects.brucker.ch/su4sml/
|
||||
*
|
||||
* config.sml ---
|
||||
* This file is part of su4sml.
|
||||
*
|
||||
* Copyright (c) 2009 Achim D. Brucker, Germany
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are
|
||||
* met:
|
||||
*
|
||||
* * Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
*
|
||||
* * Redistributions in binary form must reproduce the above
|
||||
* copyright notice, this list of conditions and the following
|
||||
* disclaimer in the documentation and/or other materials provided
|
||||
* with the distribution.
|
||||
*
|
||||
* * Neither the name of the copyright holders nor the names of its
|
||||
* contributors may be used to endorse or promote products derived
|
||||
* from this software without specific prior written permission.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
******************************************************************************)
|
||||
(* $Id$ *)
|
||||
|
||||
signature CONFIG =
|
||||
sig
|
||||
val su4sml_home : unit -> string
|
||||
end
|
||||
|
||||
structure Config:>CONFIG =
|
||||
struct
|
||||
|
||||
(* HOLOCL_HOME resp. SU4SML_HOME should point to the top-level directory *)
|
||||
(* of the corresponding library. The semantics of UML2CDL_HOME should *)
|
||||
(* probably be fixed *)
|
||||
fun su4sml_home () = case OS.Process.getEnv "HOLOCL_HOME" of
|
||||
SOME p => p^"/lib/su4sml/src"
|
||||
| NONE => (case OS.Process.getEnv "SU4SML_HOME" of
|
||||
SOME p => p^"/src"
|
||||
| NONE => (case OS.Process.getEnv "UML2CDL_HOME" of
|
||||
SOME p => p^"../../../src"
|
||||
| NONE => ".")
|
||||
)
|
||||
|
||||
end
|
|
@ -70,7 +70,6 @@ end
|
|||
structure preMap =
|
||||
struct
|
||||
open Rep_Helper
|
||||
open Rep_Logger
|
||||
|
||||
val entries : (string * int) list ref = ref nil
|
||||
|
||||
|
@ -100,7 +99,6 @@ end
|
|||
structure Ocl2DresdenJava =
|
||||
struct
|
||||
open Rep_Helper
|
||||
open Rep_Logger
|
||||
open Rep_OclType
|
||||
open Rep_OclTerm
|
||||
open Rep_Core
|
||||
|
@ -497,7 +495,7 @@ fun preExtract env on curOp =
|
|||
| _ => (getPres src)^(join "\n" (map (getPres o fst) args))
|
||||
in
|
||||
case precond of
|
||||
OperationCall (src,styp,["oclLib","OclAny","atPre"],[],_) => error "atPre()-operation should not be reached."
|
||||
OperationCall (src,styp,["oclLib","OclAny","atPre"],[],_) => Logger.error "atPre()-operation should not be reached."
|
||||
| OperationCall (src,styp,op_name,args,rtype) => resSave src styp op_name args rtype
|
||||
| Literal (_,_) => ""
|
||||
| If (cond,_,thenb,_,elseb,_,_) => (getPres cond)^(getPres thenb)^(getPres elseb)
|
||||
|
|
|
@ -52,7 +52,6 @@ end
|
|||
structure Ocl2String:OCL2STRING =
|
||||
struct
|
||||
open Rep_Helper
|
||||
open Rep_Logger
|
||||
open Rep_OclType
|
||||
open Rep_OclTerm
|
||||
|
||||
|
@ -321,14 +320,13 @@ fun ocl2string show_types oclterm =
|
|||
"Tuple{"^(String.substring(x,0,size-1))^"}\n"
|
||||
end
|
||||
|
||||
| _ => error "error: unknown OCL-term in in ocl2string"
|
||||
| _ => Logger.error "error: unknown OCL-term in in ocl2string"
|
||||
end
|
||||
end
|
||||
|
||||
(** "pretty printing" of Repository models *)
|
||||
structure Rep2String =
|
||||
struct
|
||||
open Rep_Logger
|
||||
|
||||
fun precond2string (SOME n,t) = " pre "^n^":\n "^
|
||||
(Ocl2String.ocl2string false t)^"\n"
|
||||
|
@ -394,8 +392,8 @@ fun classifier2string (C as Rep.Class x) =
|
|||
| classifier2string (C as Rep.Template x) =
|
||||
"template of "^ (classifier2string (#classifier x))
|
||||
|
||||
fun printClass (x:Rep.Classifier) = trace medium (classifier2string x)
|
||||
fun printClass (x:Rep.Classifier) = Logger.info (classifier2string x)
|
||||
|
||||
fun printList (x:Rep.Classifier list) =
|
||||
trace medium (String.concatWith "\n\n" (map classifier2string x ))
|
||||
Logger.info (String.concatWith "\n\n" (map classifier2string x ))
|
||||
end
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
* This file is part of su4sml.
|
||||
*
|
||||
* Copyright (c) 2005-2007 ETH Zurich, Switzerland
|
||||
* (c) 2008 Achim D. Brucker, Germany
|
||||
* (c) 2008-2009 Achim D. Brucker, Germany
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
|
@ -107,7 +107,6 @@ structure Context:CONTEXT =
|
|||
struct
|
||||
|
||||
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
open Rep_OclType
|
||||
open Rep_OclTerm
|
||||
|
@ -219,26 +218,26 @@ fun real_signature ([]) = []
|
|||
fun add_source (source,(AttributeCall (_, _, path, res_typ ))) =
|
||||
let
|
||||
val test = (AttributeCall (source,DummyT,path,res_typ))
|
||||
val _ = trace low ("source added for AttributeCall..." ^ Ocl2String.ocl2string true test ^ "\n");
|
||||
val _ = Logger.debug4 ("source added for AttributeCall..." ^ Ocl2String.ocl2string true test ^ "\n");
|
||||
in
|
||||
(AttributeCall (source, DummyT, path, res_typ))
|
||||
end
|
||||
| add_source (source,(OperationCall (_,_,path,paras,res_typ))) =
|
||||
let
|
||||
val _ = trace low ("source added for OperationCall..." ^ "\n");
|
||||
val _ = Logger.debug1 ("source added for OperationCall..." ^ "\n");
|
||||
in
|
||||
(OperationCall (source,DummyT,path,paras,res_typ))
|
||||
end
|
||||
| add_source (source, Literal(s,t)) = Literal (s,t)
|
||||
| add_source (source, CollectionLiteral (part_list,typ)) =
|
||||
let
|
||||
val _ = trace low ("source added for AttributeCall..." ^ "\n");
|
||||
val _ = Logger.debug1 ("source added for AttributeCall..." ^ "\n");
|
||||
in
|
||||
(CollectionLiteral (part_list,typ))
|
||||
end
|
||||
| add_source (source, Iterator(name,iter_vars_list,_,_,body_term,body_typ,res_typ)) =
|
||||
let
|
||||
val _ = trace low ("source added for Iterator..." ^ "\n");
|
||||
val _ = Logger.debug1 ("source added for Iterator..." ^ "\n");
|
||||
in
|
||||
(Iterator (name,iter_vars_list,source,DummyT,body_term,body_typ,res_typ))
|
||||
end
|
||||
|
@ -250,13 +249,13 @@ fun add_source (source,(AttributeCall (_, _, path, res_typ ))) =
|
|||
If (paras)
|
||||
| add_source (source, Iterate([],acc_var_name,acc_var_type,acc_var_term,sterm,stype,bterm,btype,res_type)) =
|
||||
let
|
||||
val _ = trace low ("source added for Iterate ..." ^ "\n");
|
||||
val _ = Logger.debug1 ("source added for Iterate ..." ^ "\n");
|
||||
in
|
||||
(Iterate ([],acc_var_name,acc_var_type,acc_var_term,source,DummyT,bterm,btype,res_type))
|
||||
end
|
||||
| add_source (source, Iterate(iter_vars,acc_var_name,acc_var_type,acc_var_term,sterm,stype,bterm,btype,res_type)) =
|
||||
let
|
||||
val _ = trace high ("source added for Iterate ..." ^ "\n");
|
||||
val _ = Logger.debug1 ("source added for Iterate ..." ^ "\n");
|
||||
in
|
||||
(Iterate (iter_vars,acc_var_name,acc_var_type,acc_var_term,source,DummyT,bterm,btype,res_type))
|
||||
end
|
||||
|
@ -275,20 +274,20 @@ fun add_source_to_list source (h::tail) = (add_source (source,h))::tail
|
|||
(* RETURN: OclTerm *)
|
||||
fun nest_source (OperationCall (sterm,styp,[OclLibPackage,rtyp,"-"],[],res_typ)::tail) =
|
||||
let
|
||||
val _ = trace low ("unary_exp_cs Call: '-' ... \n")
|
||||
val _ = Logger.debug1 ("unary_exp_cs Call: '-' ... \n")
|
||||
in
|
||||
foldl (switch add_source) (OperationCall (sterm,styp,[OclLibPackage,rtyp,"-"],[],res_typ)) tail
|
||||
end
|
||||
| nest_source (OperationCall (sterm,styp,[OclLibPackage,rtyp,"not"],[],res_typ)::tail) =
|
||||
let
|
||||
val _ = trace low ("unary_exp_cs Call: 'not' ... \n")
|
||||
val _ = Logger.debug1 ("unary_exp_cs Call: 'not' ... \n")
|
||||
in
|
||||
foldl (switch add_source) (OperationCall (sterm,styp,[OclLibPackage,rtyp,"not"],[],res_typ)) tail
|
||||
end
|
||||
| nest_source term_list =
|
||||
let
|
||||
val _ = trace low ("source nested for AttributeCall..." ^ "\n");
|
||||
val _ = trace low ((Ocl2String.ocl2string true (List.last term_list)) ^ "bla\n");
|
||||
val _ = Logger.debug1 ("source nested for AttributeCall..." ^ "\n");
|
||||
val _ = Logger.debug1 ((Ocl2String.ocl2string true (List.last term_list)) ^ "bla\n");
|
||||
in
|
||||
foldl (switch add_source) (Variable ("dummy_source",DummyT)) term_list
|
||||
end
|
||||
|
@ -296,13 +295,13 @@ fun nest_source (OperationCall (sterm,styp,[OclLibPackage,rtyp,"-"],[],res_typ):
|
|||
(* RETURN: context list *)
|
||||
fun attr_list (context,Typ,[]) =
|
||||
let
|
||||
val _ = trace low ("Contextes created form list of Attributes ..." ^ "\n")
|
||||
val _ = Logger.debug1 ("Contextes created form list of Attributes ..." ^ "\n")
|
||||
in
|
||||
[]
|
||||
end
|
||||
| attr_list (context,Typ,((asser,expr)::tail)) =
|
||||
let
|
||||
val _ = trace low ("Contextes created form list of Attributes ..." ^ "\n")
|
||||
val _ = Logger.debug1 ("Contextes created form list of Attributes ..." ^ "\n")
|
||||
in
|
||||
(Attr (context,Typ,asser,expr))::(attr_list (context,Typ,tail))
|
||||
end
|
||||
|
@ -310,13 +309,13 @@ fun attr_list (context,Typ,[]) =
|
|||
(* RETURN: context list *)
|
||||
fun inv_list (context,[]) =
|
||||
let
|
||||
val _ = trace low ("Contextes created form list of invs ..." ^ "\n")
|
||||
val _ = Logger.debug4 ("Contextes created form list of invs ..." ^ "\n")
|
||||
in
|
||||
[]
|
||||
end
|
||||
| inv_list (context,((name,expr)::tail)) =
|
||||
let
|
||||
val _ = trace low ("Contextes created form list of invs ..." ^ "\n")
|
||||
val _ = Logger.debug4 ("Contextes created form list of invs ..." ^ "\n")
|
||||
in
|
||||
(Inv(context,name,expr))::(inv_list (context,tail))
|
||||
end
|
||||
|
@ -324,13 +323,13 @@ fun inv_list (context,[]) =
|
|||
(* RETURN: context list *)
|
||||
fun cond_list (path,sign,[]) =
|
||||
let
|
||||
val _ = trace low ("Contextes created form list of conds ..." ^ "\n")
|
||||
val _ = Logger.debug4 ("Contextes created form list of conds ..." ^ "\n")
|
||||
in
|
||||
[]
|
||||
end
|
||||
| cond_list (path,sign,((asser,name_cond,expr)::tail)) =
|
||||
let
|
||||
val _ = trace low ("Contextes created form list of conds ..." ^ "\n")
|
||||
val _ = Logger.debug4 ("Contextes created form list of conds ..." ^ "\n")
|
||||
in
|
||||
Cond(real_path path,List.last path,real_signature sign, #2(List.last sign),asser,name_cond,expr)::cond_list (path,sign,tail)
|
||||
end
|
||||
|
@ -354,7 +353,7 @@ fun cxt_list2string ([]) = ""
|
|||
|
||||
fun rename_classifier path (Class{name=name,parent=parent,attributes=attributes,operations=operations,associations=associations,invariant=invariant,stereotypes=stereotypes,interfaces=interfaces,thyname=thyname,visibility=visibility,activity_graphs=activity_graphs}) =
|
||||
let
|
||||
val _ = trace function_calls ("Context.rename_classifier\n")
|
||||
val _ = Logger.debug2 ("Context.rename_classifier\n")
|
||||
val res = Class {
|
||||
name = Classifier (path),
|
||||
parent=parent,
|
||||
|
@ -368,14 +367,14 @@ fun rename_classifier path (Class{name=name,parent=parent,attributes=attributes,
|
|||
visibility=visibility,
|
||||
activity_graphs=activity_graphs
|
||||
}
|
||||
val _ = trace function_ends ("Context.rename_classifier\n")
|
||||
val _ = Logger.debug2 ("Context.rename_classifier\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
||||
fun merge_classifier ((a as Class{attributes=a_atts,operations=a_ops,invariant=a_invs,associations=a_assocs,...}),(b as Class{attributes=b_atts,operations=b_ops,invariant=b_invs,associations=b_assocs,...})) =
|
||||
let
|
||||
val _ = trace function_calls ("Context.merge_classifier\n")
|
||||
val _ = Logger.debug2 ("Context.merge_classifier\n")
|
||||
val res = Class {
|
||||
name = OclVoid,
|
||||
parent=NONE,
|
||||
|
@ -389,14 +388,14 @@ fun merge_classifier ((a as Class{attributes=a_atts,operations=a_ops,invariant=a
|
|||
visibility=public:Rep_Core.Visibility,
|
||||
activity_graphs=[]
|
||||
}
|
||||
val _ = trace function_ends ("Context.merge_classifier\n")
|
||||
val _ = Logger.debug2 ("Context.merge_classifier\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
||||
fun merge_classifiers list =
|
||||
let
|
||||
val _ = trace function_calls ("Context.merge_classifiers\n")
|
||||
val _ = Logger.debug2 ("Context.merge_classifiers\n")
|
||||
val Empty_Class = Class{
|
||||
name = OclVoid,
|
||||
parent=NONE,
|
||||
|
@ -411,7 +410,7 @@ fun merge_classifiers list =
|
|||
activity_graphs=[]
|
||||
}
|
||||
val res = List.foldr (merge_classifier) Empty_Class list
|
||||
val _ = trace function_ends ("Context.merge_classifier\n")
|
||||
val _ = Logger.debug2 ("Context.merge_classifier\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -419,7 +418,7 @@ fun merge_classifiers list =
|
|||
|
||||
fun operations_to_classifier ops =
|
||||
let
|
||||
val _ = trace function_calls ("Context.operation_to_classifier\n")
|
||||
val _ = Logger.debug2 ("Context.operation_to_classifier\n")
|
||||
val res = Class{
|
||||
name = OclVoid,
|
||||
parent=NONE,
|
||||
|
@ -433,14 +432,14 @@ fun operations_to_classifier ops =
|
|||
visibility=public:Rep_Core.Visibility,
|
||||
activity_graphs=[]
|
||||
}
|
||||
val _ = trace function_ends ("Context.operation_to_classifier\n")
|
||||
val _ = Logger.debug2 ("Context.operation_to_classifier\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
||||
fun attributes_to_classifier atts =
|
||||
let
|
||||
val _ = trace function_calls ("Context.attributes_to_classifier\n")
|
||||
val _ = Logger.debug2 ("Context.attributes_to_classifier\n")
|
||||
val res = Class{
|
||||
name = OclVoid,
|
||||
parent=NONE,
|
||||
|
@ -454,14 +453,14 @@ fun attributes_to_classifier atts =
|
|||
visibility=public:Rep_Core.Visibility,
|
||||
activity_graphs=[]
|
||||
}
|
||||
val _ = trace function_ends ("Context.attributes_to_classifier\n")
|
||||
val _ = Logger.debug2 ("Context.attributes_to_classifier\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
||||
fun constraints_to_classifier invs =
|
||||
let
|
||||
val _ = trace function_calls ("Context.constraints_to_classifier\n")
|
||||
val _ = Logger.debug2 ("Context.constraints_to_classifier\n")
|
||||
val res = Class{
|
||||
name = OclVoid,
|
||||
parent=NONE,
|
||||
|
@ -475,19 +474,19 @@ fun constraints_to_classifier invs =
|
|||
visibility=public:Rep_Core.Visibility,
|
||||
activity_graphs=[]
|
||||
}
|
||||
val _ = trace function_ends ("Context.constraints_to_classifier\n")
|
||||
val _ = Logger.debug2 ("Context.constraints_to_classifier\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
||||
fun dispatch_pre_or_post (cond_type:ConditionType) (list:(ConditionType * string option * OclTerm) list) =
|
||||
let
|
||||
val _ = trace function_calls ("Context.dispatch_pre_or_post")
|
||||
val _ = Logger.debug2 ("Context.dispatch_pre_or_post")
|
||||
val filter = List.filter (fn (a,b,c) => if cond_type = a
|
||||
then true
|
||||
else false) list
|
||||
val res = List.map (fn (a,b,c) => (b,c)) filter
|
||||
val _ = trace function_ends ("Context.dispatch_pre_or_post")
|
||||
val _ = Logger.debug2 ("Context.dispatch_pre_or_post")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
|
|
@ -60,7 +60,6 @@ end
|
|||
structure Update_Model:UPDATE_MODEL =
|
||||
struct
|
||||
|
||||
open Rep_Logger
|
||||
open Rep_Core;
|
||||
open Context;
|
||||
|
||||
|
@ -133,19 +132,19 @@ fun add_operations cond_type (op_name,cond_name,term) [] = raise OperationUpdate
|
|||
case cond_type of
|
||||
pre =>
|
||||
let
|
||||
val _ = trace low ("pre\n")
|
||||
val _ = Logger.debug3 ("pre\n")
|
||||
in
|
||||
add_precondition (op_name,cond_name,term) op_list
|
||||
end
|
||||
| post =>
|
||||
let
|
||||
val _ = trace low ("post\n")
|
||||
val _ = Logger.debug3 ("post\n")
|
||||
in
|
||||
add_postcondition (op_name,cond_name,term) op_list
|
||||
end
|
||||
| body =>
|
||||
let
|
||||
val _ = trace low ("body\n")
|
||||
val _ = Logger.debug3 ("body\n")
|
||||
in
|
||||
add_body (op_name,cond_name,term) op_list
|
||||
end
|
||||
|
@ -170,7 +169,7 @@ fun add_attribute (attr_name,term) ((attr: attribute)::attribute_tail) =
|
|||
(* INVARIANTS *)
|
||||
fun context_to_classifier (Inv (path,string_opt,term)) model =
|
||||
let
|
||||
val _ = trace low ("Invariant to Classifier ... " ^ "\n")
|
||||
val _ = Logger.debug3 ("Invariant to Classifier ... " ^ "\n")
|
||||
val c = class_of_type (Rep_OclType.Classifier (path)) model
|
||||
in
|
||||
(
|
||||
|
@ -223,7 +222,7 @@ fun context_to_classifier (Inv (path,string_opt,term)) model =
|
|||
(* Attribute constraints *)
|
||||
| context_to_classifier (Attr (path,typ,attrorassoc,term)) model =
|
||||
let
|
||||
val _ = trace low ("Attribute to Classifier ... " ^ "\n")
|
||||
val _ = Logger.debug3 ("Attribute to Classifier ... " ^ "\n")
|
||||
val c = class_of_type (Rep_OclType.Classifier (real_path path)) model
|
||||
in
|
||||
(
|
||||
|
@ -278,7 +277,7 @@ fun context_to_classifier (Inv (path,string_opt,term)) model =
|
|||
(* Operation constraints *)
|
||||
| context_to_classifier (Cond (path,op_name,args,ret_typ,cond_type,cond_name,term)) model=
|
||||
let
|
||||
val _ = trace low ("Cond to Classifier ... " ^ "\n")
|
||||
val _ = Logger.debug3 ("Cond to Classifier ... " ^ "\n")
|
||||
val c = class_of_type (Rep_OclType.Classifier (path)) model
|
||||
in
|
||||
(
|
||||
|
@ -347,41 +346,37 @@ fun gen_updated_classifier_list [] model = model
|
|||
gen_updated_classifier_list context_list_tail (merge_classifier updated_classifier model)
|
||||
handle AlreadyInitValueError (attr_path,term,mes) =>
|
||||
let
|
||||
val _ = trace zero ("\n\n#################################################\n")
|
||||
val _ = trace zero ("AlreadyInitValueError:\n")
|
||||
val _ = trace zero ("Error Message: " ^ mes ^ "\n")
|
||||
val _ = trace zero ("In attribute or association: " ^ (attr_path) ^ "\n")
|
||||
val _ = trace zero ("In Term: " ^ Ocl2String.ocl2string false term ^ "\n")
|
||||
val _ = Logger.error("AlreadyInitValueError:\n"
|
||||
^"Error Message: " ^ mes ^ "\n"
|
||||
^"In attribute or association: " ^ (attr_path) ^ "\n"
|
||||
^"In Term: " ^ Ocl2String.ocl2string false term ^ "\n")
|
||||
in
|
||||
[]
|
||||
[]
|
||||
end
|
||||
| NotYetSupportedError mes =>
|
||||
let
|
||||
val _ = trace zero ("\n\n#################################################\n")
|
||||
val _ = trace zero ("NotYetSupportedError:\n")
|
||||
val _ = trace zero ("Error Message: " ^ mes ^ "\n")
|
||||
val _ = Logger.error ("NotYetSupportedError:\n"
|
||||
^"Error Message: " ^ mes ^ "\n")
|
||||
in
|
||||
[]
|
||||
[]
|
||||
end
|
||||
| ContextToClassifierError (term,mes) =>
|
||||
let
|
||||
val _ = trace zero ("\n\n#################################################\n")
|
||||
val _ = trace zero ("ContextToClassifierError:\n")
|
||||
val _ = trace zero ("Error Message: " ^ mes ^ "\n")
|
||||
val _ = trace zero ("In Term: " ^ Ocl2String.ocl2string false term ^ "\n")
|
||||
val _ = Logger.error ("ContextToClassifierError:\n"
|
||||
^"Error Message: " ^ mes ^ "\n"
|
||||
^"In Term: " ^ Ocl2String.ocl2string false term ^ "\n")
|
||||
in
|
||||
[]
|
||||
[]
|
||||
end
|
||||
| OperationUpdateError (meth_path,cond_type,term,mes) =>
|
||||
let
|
||||
val _ = trace zero ("\n\n#################################################\n")
|
||||
val _ = trace zero ("AlreadyInitValueError:\n")
|
||||
val _ = trace zero ("Error Message: " ^ mes ^ "\n")
|
||||
val _ = trace zero ("In condition: " ^ (cond_type_to_string cond_type) ^ "\n")
|
||||
val _ = trace zero ("In operation: " ^ (meth_path) ^ "\n")
|
||||
val _ = trace zero ("In Term: " ^ Ocl2String.ocl2string false term ^ "\n")
|
||||
val _ = Logger.error ("AlreadyInitValueError:\n"
|
||||
^"Error Message: " ^ mes ^ "\n"
|
||||
^"In condition: " ^ (cond_type_to_string cond_type) ^ "\n"
|
||||
^"In operation: " ^ (meth_path) ^ "\n"
|
||||
^"In Term: " ^ Ocl2String.ocl2string false term ^ "\n")
|
||||
in
|
||||
[]
|
||||
[]
|
||||
end
|
||||
end
|
||||
| gen_updated_classifier_list (NONE::context_list_tail) model = gen_updated_classifier_list context_list_tail model
|
||||
|
|
|
@ -58,7 +58,6 @@ open List
|
|||
open Posix.Error
|
||||
|
||||
(* su4sml *)
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
|
||||
(* OclParser *)
|
||||
|
@ -87,7 +86,7 @@ fun importArgoUMLUnNormalized file =
|
|||
val base = if String.isSuffix ".zargo" file
|
||||
then String.substring(file,0, (String.size file) -6)
|
||||
else file
|
||||
val _ = print ("*** Syscall: unzip -p -ca "^base^".zargo "^(basename base)^".xmi > "^tmpFile^"\n")
|
||||
val _ = Logger.info ("*** Syscall: unzip -p -ca "^base^".zargo "^(basename base)^".xmi > "^tmpFile)
|
||||
val _ = OS.Process.system ("unzip -p -ca "^base^".zargo "^(basename base)^".xmi > "^tmpFile)
|
||||
val model = readFileUnNormalized tmpFile
|
||||
val _ = OS.FileSys.remove tmpFile
|
||||
|
@ -103,11 +102,11 @@ fun importArgoUMLUnNormalized file =
|
|||
|
||||
fun parseUML umlFile =
|
||||
let
|
||||
val _ = trace high "### Parsing UML Model ###\n"
|
||||
val _ = Logger.info "### Parsing UML Model ###\n"
|
||||
val umlModel = if String.isSuffix ".zargo" umlFile
|
||||
then importArgoUMLUnNormalized umlFile
|
||||
else readFileUnNormalized umlFile
|
||||
val _ = trace high ("### Finished Parsing UML Model ("
|
||||
val _ = Logger.info ("### Finished Parsing UML Model ("
|
||||
^(Int.toString(length (#1 umlModel)))
|
||||
^" Classifiers found)###\n\n")
|
||||
in
|
||||
|
@ -116,11 +115,11 @@ fun parseUML umlFile =
|
|||
|
||||
fun parseOCL oclFile =
|
||||
let
|
||||
val _ = trace high "### Parsing OCL File ###\n"
|
||||
val _ = Logger.info "### Parsing OCL File ###\n"
|
||||
val context_classes = case oclFile of
|
||||
"" => ([],[])
|
||||
| filename => OclParser.parse_contextlist oclFile;
|
||||
val _ = trace high ("### Finished Parsing OCL File ("
|
||||
val _ = Logger.info ("### Finished Parsing OCL File ("
|
||||
^(Int.toString(length (#1 context_classes)))
|
||||
^" Constraints Found) ###\n\n")
|
||||
in
|
||||
|
@ -129,11 +128,11 @@ fun parseOCL oclFile =
|
|||
|
||||
fun parseModel oclFile =
|
||||
let
|
||||
val _ = trace high "### Parsing OCL File ###\n"
|
||||
val _ = Logger.info "### Parsing OCL File ###\n"
|
||||
val context_classes = case oclFile of
|
||||
"" => ([],[])
|
||||
| filename => OclParser.parse_contextlist oclFile;
|
||||
val _ = trace high ("### Finished Parsing OCL File ("
|
||||
val _ = Logger.info ("### Finished Parsing OCL File ("
|
||||
^(Int.toString(length (#2 context_classes)))
|
||||
^" Constraints Found) ###\n\n")
|
||||
in
|
||||
|
@ -145,11 +144,11 @@ fun removePackages packageList (cl,al) =
|
|||
fun filter_package_assoc model p = filter
|
||||
(fn a => not ((rev o tl o rev) (Rep_Core.name_of_association a) = p)) model
|
||||
fun filter_package model p = filter (fn cl => not (Rep_Core.package_of cl = p)) model
|
||||
val _ = trace high "### Excluding Packages ###\n"
|
||||
val _ = Logger.info "### Excluding Packages ###\n"
|
||||
fun stringToPath s = (String.tokens (fn s => (s = (#":"))) s)
|
||||
val cl =foldr (fn (p,m) => filter_package m (stringToPath p)) cl packageList
|
||||
val al =foldr (fn (p,m) => filter_package_assoc m (stringToPath p)) al packageList
|
||||
val _ = trace high ("### Finished excluding Packages ("
|
||||
val _ = Logger.info ("### Finished excluding Packages ("
|
||||
^(Int.toString(length cl))
|
||||
^ " Classifiers found ###\n\n")
|
||||
(* TODO: Implement check for dangeling references/Types and Ocl Expressions *)
|
||||
|
@ -175,41 +174,41 @@ fun removeOclLibrary (model) =
|
|||
fun import xmifile oclfile excludePackages =
|
||||
let
|
||||
val xmi = parseUML xmifile
|
||||
val _ = init_offset()
|
||||
(* val _ = init_offset() *)
|
||||
val ocl = parseOCL oclfile
|
||||
val (xmi_cls, xmi_assocs) = xmi
|
||||
val _ = init_offset()
|
||||
(* val _ = init_offset() *)
|
||||
|
||||
|
||||
val model = case ocl of
|
||||
[] => (xmi_cls,xmi_assocs)
|
||||
| ocl => let
|
||||
val _ = init_offset()
|
||||
(* val _ = init_offset() *)
|
||||
|
||||
val _ = trace high "### Preprocess Context List ###\n"
|
||||
val _ = Logger.info "### Preprocess Context List ###\n"
|
||||
val fixed_ocl = Preprocessor.preprocess_context_list ocl ((OclLibrary.oclLib)@xmi_cls)
|
||||
val _ = trace high "### Finished Preprocess Context List ###\n\n"
|
||||
val _ = init_offset()
|
||||
val _ = Logger.info "### Finished Preprocess Context List ###\n\n"
|
||||
(* val _ = init_offset() *)
|
||||
|
||||
val _ = trace high "### Type Checking ###\n"
|
||||
val _ = Logger.info "### Type Checking ###\n"
|
||||
val typed_cl = TypeChecker.check_context_list fixed_ocl (((OclLibrary.oclLib)@xmi_cls),xmi_assocs);
|
||||
val _ = trace high "### Finished Type Checking ###\n\n"
|
||||
val _ = init_offset()
|
||||
val _ = Logger.info "### Finished Type Checking ###\n\n"
|
||||
(* val _ = init_offset() *)
|
||||
|
||||
val _ = print"### Updating Classifier List ###\n"
|
||||
val _ = Logger.info "### Updating Classifier List ###\n"
|
||||
val model = Update_Model.gen_updated_classifier_list typed_cl ((OclLibrary.oclLib)@xmi_cls);
|
||||
val _ = trace high ("### Finished Updating Classifier List "
|
||||
val _ = Logger.info ("### Finished Updating Classifier List "
|
||||
^(Int.toString(length model))
|
||||
^ " Classifiers found (11 from 'oclLib') ###\n")
|
||||
val _ = init_offset()
|
||||
(* val _ = init_offset() *)
|
||||
|
||||
val _ = trace high "### Fixing Types ###\n"
|
||||
val _ = Logger.info "### Fixing Types ###\n"
|
||||
val model = removeOclLibrary model
|
||||
val model = removePackages excludePackages (model,xmi_assocs)
|
||||
(*
|
||||
val model = FixTyping.transform_ocl_spec FixTyping.transformForHolOcl model
|
||||
*)
|
||||
val _ = trace high "### Finished Fixing Types ###\n\n"
|
||||
val _ = Logger.info "### Finished Fixing Types ###\n\n"
|
||||
in
|
||||
model
|
||||
end
|
||||
|
|
|
@ -60,7 +60,6 @@ THIS POINTS HAVE TO BE NOTICED TO UNDERSTAND THE SEMANTICS OF:
|
|||
*)
|
||||
|
||||
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
|
@ -326,8 +325,8 @@ package_constraint_list_cs_p : package_constraint_list_cs (package_const
|
|||
| package_constraint_list_cs package_constraint_list_cs_p (package_constraint_list_cs@package_constraint_list_cs_p)
|
||||
|
||||
(* RETURN: context list *)
|
||||
package_constraint_list_cs : PACKAGE path_name_cs ENDPACKAGE (trace low ("Starts creatind empty package ... " ^ "\n"); ([Empty_context ("this is an empty context", Literal ("empty",OclVoid))]))
|
||||
| PACKAGE path_name_cs context_declaration_list_cs ENDPACKAGE (trace low ("Starts creating contextes ..." ^ "\n"); (list_extend_path path_name_cs context_declaration_list_cs))
|
||||
package_constraint_list_cs : PACKAGE path_name_cs ENDPACKAGE (Logger.debug3 ("Starts creatind empty package ... " ^ "\n"); ([Empty_context ("this is an empty context", Literal ("empty",OclVoid))]))
|
||||
| PACKAGE path_name_cs context_declaration_list_cs ENDPACKAGE (Logger.debug3 ("Starts creating contextes ..." ^ "\n"); (list_extend_path path_name_cs context_declaration_list_cs))
|
||||
|
||||
(* RETURN: context list *)
|
||||
context_declaration_list_cs : context_declaration_cs (context_declaration_cs)
|
||||
|
@ -344,7 +343,7 @@ attr_or_assoc_cs : CONTEXT path_name_cs COLON type_specifier init_
|
|||
|
||||
|
||||
(* RETURN: string *)
|
||||
simple_name : SIMPLE_NAME (trace low ("simple_name..." ^ "\n");SIMPLE_NAME)
|
||||
simple_name : SIMPLE_NAME (Logger.debug3 ("simple_name..." ^ "\n");SIMPLE_NAME)
|
||||
|
||||
(* RETURN: context list *)
|
||||
classifier_context_declaration_cs : CONTEXT path_name_cs classifier_constraint_cs_p (inv_list (path_name_cs, classifier_constraint_cs_p))
|
||||
|
@ -376,15 +375,15 @@ init_or_der_value_cs : INIT COLON ocl_expression_cs (INI
|
|||
| DERIVE COLON ocl_expression_cs (DERIVE, ocl_expression_cs)
|
||||
|
||||
(* RETURN: (string option, OclTerm) 1.name 2.expression *)
|
||||
classifier_constraint_cs : INV COLON ocl_expression_cs (trace low ("INV COLON ocl_expression_cs ..." ^ "\n"); (NONE,ocl_expression_cs))
|
||||
| INV simple_name COLON ocl_expression_cs (trace low ("INV simple_name COLON ocl_expression_cs ..." ^ "\n");(SOME(simple_name),ocl_expression_cs))
|
||||
classifier_constraint_cs : INV COLON ocl_expression_cs (Logger.debug3 ("INV COLON ocl_expression_cs ..." ^ "\n"); (NONE,ocl_expression_cs))
|
||||
| INV simple_name COLON ocl_expression_cs (Logger.debug3 ("INV simple_name COLON ocl_expression_cs ..." ^ "\n");(SOME(simple_name),ocl_expression_cs))
|
||||
| DEF COLON definition_constraint_cs (NONE,definition_constraint_cs)
|
||||
| DEF simple_name COLON definition_constraint_cs (SOME(simple_name),definition_constraint_cs)
|
||||
|
||||
|
||||
(* RETURN: (ConditionType, string option, OclTerm) 1.{Pre|Post|Body} 2. name 3.expression*)
|
||||
operation_constraint_cs : op_constraint_stereotype_cs COLON ocl_expression_cs (trace low ("operation_constraint_cs 1..." ^ "\n"); (op_constraint_stereotype_cs,NONE,ocl_expression_cs))
|
||||
| op_constraint_stereotype_cs simple_name COLON ocl_expression_cs (trace low ("operation_constraint_cs 23454..." ^ "\n"); (op_constraint_stereotype_cs,SOME(simple_name),ocl_expression_cs))
|
||||
operation_constraint_cs : op_constraint_stereotype_cs COLON ocl_expression_cs (Logger.debug3 ("operation_constraint_cs 1..." ^ "\n"); (op_constraint_stereotype_cs,NONE,ocl_expression_cs))
|
||||
| op_constraint_stereotype_cs simple_name COLON ocl_expression_cs (Logger.debug3 ("operation_constraint_cs 23454..." ^ "\n"); (op_constraint_stereotype_cs,SOME(simple_name),ocl_expression_cs))
|
||||
|
||||
(* RETURN: (string option, OclTerm) 1.name 2.expression *)
|
||||
guard_constraint_cs : GUARD COLON ocl_expression_cs (NONE,ocl_expression_cs)
|
||||
|
@ -395,7 +394,7 @@ guard_constraint_cs : GUARD COLON ocl_expression_cs (NO
|
|||
definition_constraint_cs : defined_entity_decl_cs EQUALS ocl_expression_cs (OperationCall (defined_entity_decl_cs,DummyT,[OclLibPackage,"DummyT",EQUALS],[(ocl_expression_cs,DummyT)],DummyT))
|
||||
|
||||
(* RETURN: OclTerm *)
|
||||
defined_entity_decl_cs : ocl_attribute_defined_entity_decl_cs (trace low ("AttributeCall 1 ..." ^ "\n");AttributeCall (Literal ("self2",DummyT),DummyT,[#1(ocl_attribute_defined_entity_decl_cs)],#2(ocl_attribute_defined_entity_decl_cs)))
|
||||
defined_entity_decl_cs : ocl_attribute_defined_entity_decl_cs (Logger.debug3 ("AttributeCall 1 ..." ^ "\n");AttributeCall (Literal ("self2",DummyT),DummyT,[#1(ocl_attribute_defined_entity_decl_cs)],#2(ocl_attribute_defined_entity_decl_cs)))
|
||||
| ocl_operation_defined_entity_decl_cs (OperationCall (Literal ("self2",DummyT),DummyT,[#1(ocl_operation_defined_entity_decl_cs)],List.map gen_literal_term (real_signature (#2(ocl_operation_defined_entity_decl_cs))),#2(List.last (#2(ocl_operation_defined_entity_decl_cs)))))
|
||||
|
||||
(* RETURN: (string * OclType) *)
|
||||
|
@ -408,12 +407,12 @@ ocl_operation_defined_entity_decl_cs : simple_name operation_signature_cs (s
|
|||
|
||||
(* RETURN: (string * OclType) list *)
|
||||
(* last element of list is the return type. Only second part of tuple then used *)
|
||||
operation_signature_cs : PAREN_OPEN PAREN_CLOSE (trace low ("operation_signature_cs ..." ^ "\n");[("",OclVoid)])
|
||||
| PAREN_OPEN PAREN_CLOSE operation_return_type_specifier_cs (trace low ("operation_signature_cs ..." ^ "\n");[("",operation_return_type_specifier_cs)])
|
||||
| PAREN_OPEN formal_parameter_list_cs PAREN_CLOSE (trace low ("operation_signature_cs ..." ^ "\n");formal_parameter_list_cs@[("",OclVoid)])
|
||||
| PAREN_OPEN formal_parameter_list_cs PAREN_CLOSE operation_return_type_specifier_cs (trace low ("operation_signature_cs ..." ^ "\n");formal_parameter_list_cs@[("",operation_return_type_specifier_cs)])
|
||||
operation_signature_cs : PAREN_OPEN PAREN_CLOSE (Logger.debug3 ("operation_signature_cs ..." ^ "\n");[("",OclVoid)])
|
||||
| PAREN_OPEN PAREN_CLOSE operation_return_type_specifier_cs (Logger.debug3 ("operation_signature_cs ..." ^ "\n");[("",operation_return_type_specifier_cs)])
|
||||
| PAREN_OPEN formal_parameter_list_cs PAREN_CLOSE (Logger.debug3 ("operation_signature_cs ..." ^ "\n");formal_parameter_list_cs@[("",OclVoid)])
|
||||
| PAREN_OPEN formal_parameter_list_cs PAREN_CLOSE operation_return_type_specifier_cs (Logger.debug3 ("operation_signature_cs ..." ^ "\n");formal_parameter_list_cs@[("",operation_return_type_specifier_cs)])
|
||||
(* RETURN: OclType *)
|
||||
operation_return_type_specifier_cs : COLON type_specifier (trace low ("Contextes created form list of Attributes ..." ^ "\n");type_specifier)
|
||||
operation_return_type_specifier_cs : COLON type_specifier (Logger.debug3 ("Contextes created form list of Attributes ..." ^ "\n");type_specifier)
|
||||
(* RETURN: (ConditionType) *)
|
||||
op_constraint_stereotype_cs : PRE (PRE)
|
||||
| POST (POST)
|
||||
|
@ -472,9 +471,9 @@ tuple_type_specifier_cs : TUPLE_TYPE PAREN_OPEN PAREN_CLOSE
|
|||
*)
|
||||
|
||||
(* RETURN: OclTerm *)
|
||||
ocl_expression_cs : logical_exp_cs (trace low ("ocl_expression_cs..." ^ "\n");logical_exp_cs)
|
||||
ocl_expression_cs : logical_exp_cs (Logger.debug3 ("ocl_expression_cs..." ^ "\n");logical_exp_cs)
|
||||
|
||||
| let_exp_cs (trace low ("ocl_expression_cs..." ^ "\n");let_exp_cs)
|
||||
| let_exp_cs (Logger.debug3 ("ocl_expression_cs..." ^ "\n");let_exp_cs)
|
||||
|
||||
(* RETURN: OclTerm *)
|
||||
let_exp_cs : LET initialized_variable_list_cs IN expression (gen_let_term initialized_variable_list_cs expression)
|
||||
|
@ -508,30 +507,30 @@ ocl_op_name : OCLISKINDOF (OCLISKINDOF)
|
|||
| OCLISTYPEOF (OCLISTYPEOF)
|
||||
| OCLASTYPE (OCLASTYPE)
|
||||
(* RETURN: Path *)
|
||||
path_name_cs : identifier_cs (trace low ("path_name finished..." ^ "\n");[identifier_cs])
|
||||
| path_name_head_cs identifier_cs (trace low ("path_name generation ..." ^ "\n");path_name_head_cs@[identifier_cs])
|
||||
path_name_cs : identifier_cs (Logger.debug3 ("path_name finished..." ^ "\n");[identifier_cs])
|
||||
| path_name_head_cs identifier_cs (Logger.debug3 ("path_name generation ..." ^ "\n");path_name_head_cs@[identifier_cs])
|
||||
|
||||
(* RETURN : string *)
|
||||
identifier_cs : simple_name (trace low ("path_name generation..." ^ "\n");simple_name)
|
||||
identifier_cs : simple_name (Logger.debug3 ("path_name generation..." ^ "\n");simple_name)
|
||||
| ITERATE (ITERATE)
|
||||
| iterator_name_cs (iterator_name_cs)
|
||||
| ocl_op_name (ocl_op_name)
|
||||
|
||||
(* RETURN: Path *)
|
||||
path_name_head_cs : identifier_cs DBL_COLON (trace low ("path_name generation..." ^ "\n");[identifier_cs])
|
||||
| path_name_head_cs identifier_cs DBL_COLON (trace low ("path_name generation..." ^ "\n");path_name_head_cs@[identifier_cs])
|
||||
path_name_head_cs : identifier_cs DBL_COLON (Logger.debug3 ("path_name generation..." ^ "\n");[identifier_cs])
|
||||
| path_name_head_cs identifier_cs DBL_COLON (Logger.debug3 ("path_name generation..." ^ "\n");path_name_head_cs@[identifier_cs])
|
||||
|
||||
(* RETURN: OclTerm *)
|
||||
literal_exp_cs : primitive_literal_exp_cs (trace low ("primitive_literal_exp_cs..." ^ "\n");primitive_literal_exp_cs)
|
||||
literal_exp_cs : primitive_literal_exp_cs (Logger.debug3 ("primitive_literal_exp_cs..." ^ "\n");primitive_literal_exp_cs)
|
||||
| collection_literal_exp_cs (collection_literal_exp_cs)
|
||||
(* NOT YET SUPPORTED ...
|
||||
| tuple_literal_exp_cs (tuple_literal_exp_cs)
|
||||
*)
|
||||
|
||||
primitive_literal_exp_cs : numeric_literal_exp_cs (trace low ("numeric_literal_exp_cs..." ^ "\n");numeric_literal_exp_cs)
|
||||
| string_literal_exp_cs (trace low ("string_literal_exp_cs..." ^ "\n");string_literal_exp_cs)
|
||||
primitive_literal_exp_cs : numeric_literal_exp_cs (Logger.debug3 ("numeric_literal_exp_cs..." ^ "\n");numeric_literal_exp_cs)
|
||||
| string_literal_exp_cs (Logger.debug3 ("string_literal_exp_cs..." ^ "\n");string_literal_exp_cs)
|
||||
| boolean_literal_exp_cs (boolean_literal_exp_cs)
|
||||
numeric_literal_exp_cs : INTEGER_LITERAL (trace low ("INTEGER_LITERAL..." ^ "\n");Literal (INTEGER_LITERAL,Integer))
|
||||
numeric_literal_exp_cs : INTEGER_LITERAL (Logger.debug3 ("INTEGER_LITERAL..." ^ "\n");Literal (INTEGER_LITERAL,Integer))
|
||||
| REAL_LITERAL (Literal (REAL_LITERAL,Real))
|
||||
string_literal_exp_cs : STRING_LITERAL (Literal (STRING_LITERAL,String))
|
||||
boolean_literal_exp_cs : TRUE (Literal ("true",Boolean))
|
||||
|
@ -541,8 +540,8 @@ tuple_literal_exp_cs : TUPLE BRACE_OPEN initialized_variable_
|
|||
*)
|
||||
|
||||
(* RETURN: OclTerm *)
|
||||
logical_exp_cs : relational_exp_cs (trace low ("logical_exp_cs..." ^ "\n");relational_exp_cs)
|
||||
| relational_exp_cs logical_exp_tail_cs_p (trace low ("logical_exp_cs..." ^ "\n");OperationCall(relational_exp_cs,Boolean,[OclLibPackage,"Boolean",#1(logical_exp_tail_cs_p)],[(#2(logical_exp_tail_cs_p),Boolean)],Boolean))
|
||||
logical_exp_cs : relational_exp_cs (Logger.debug3 ("logical_exp_cs..." ^ "\n");relational_exp_cs)
|
||||
| relational_exp_cs logical_exp_tail_cs_p (Logger.debug3 ("logical_exp_cs..." ^ "\n");OperationCall(relational_exp_cs,Boolean,[OclLibPackage,"Boolean",#1(logical_exp_tail_cs_p)],[(#2(logical_exp_tail_cs_p),Boolean)],Boolean))
|
||||
|
||||
(* RETURN: (logic_op, OclTerm) *)
|
||||
logical_exp_tail_cs_p : logical_exp_tail_cs (logical_exp_tail_cs)
|
||||
|
@ -557,23 +556,23 @@ logic_op : LOG_AND
|
|||
| LOG_IMPL (LOG_IMPL)
|
||||
|
||||
(* RETURN: OclTerm *)
|
||||
relational_exp_cs : additive_exp_cs (trace low ("additive_exp_cs..." ^ "\n");additive_exp_cs)
|
||||
| additive_exp_cs relational_exp_tail_cs (trace low ("additive_exp_cs relational_exp_tail_cs ..." ^ "\n");OperationCall(additive_exp_cs,DummyT,[OclLibPackage,"DummyT",#1(relational_exp_tail_cs)],[(#2(relational_exp_tail_cs),DummyT)],Boolean))
|
||||
relational_exp_cs : additive_exp_cs (Logger.debug3 ("additive_exp_cs..." ^ "\n");additive_exp_cs)
|
||||
| additive_exp_cs relational_exp_tail_cs (Logger.debug3 ("additive_exp_cs relational_exp_tail_cs ..." ^ "\n");OperationCall(additive_exp_cs,DummyT,[OclLibPackage,"DummyT",#1(relational_exp_tail_cs)],[(#2(relational_exp_tail_cs),DummyT)],Boolean))
|
||||
|
||||
(* RETURN: (rel_op, Ocl_Term) *)
|
||||
relational_exp_tail_cs : rel_op additive_exp_cs (trace low ("relational_exp_tail_cs..." ^ "\n");(rel_op, additive_exp_cs))
|
||||
relational_exp_tail_cs : rel_op additive_exp_cs (Logger.debug3 ("relational_exp_tail_cs..." ^ "\n");(rel_op, additive_exp_cs))
|
||||
|
||||
(* RETURN: string *)
|
||||
rel_op : EQUALS (EQUALS)
|
||||
| REL_GT (trace low (">..." ^ "\n");REL_GT)
|
||||
| REL_LT (trace low ("<..." ^ "\n");REL_LT)
|
||||
| REL_GT (Logger.debug3 (">..." ^ "\n");REL_GT)
|
||||
| REL_LT (Logger.debug3 ("<..." ^ "\n");REL_LT)
|
||||
| REL_GTE (REL_GTE)
|
||||
| REL_LTE (REL_LTE)
|
||||
| REL_NOTEQUAL (REL_NOTEQUAL)
|
||||
|
||||
(* RETURN: OclTerm *)
|
||||
additive_exp_cs : multiplicative_exp_cs (trace low ("multiplicative_exp_cs..." ^ "\n");multiplicative_exp_cs)
|
||||
| multiplicative_exp_cs additive_exp_tail_cs_p (trace low ("multiplicative_exp_cs additive_exp_tail_cs_p..." ^ "\n");OperationCall (multiplicative_exp_cs,DummyT,[OclLibPackage,"DummyT",#1(additive_exp_tail_cs_p)],[(#2(additive_exp_tail_cs_p),DummyT)],DummyT))
|
||||
additive_exp_cs : multiplicative_exp_cs (Logger.debug3 ("multiplicative_exp_cs..." ^ "\n");multiplicative_exp_cs)
|
||||
| multiplicative_exp_cs additive_exp_tail_cs_p (Logger.debug3 ("multiplicative_exp_cs additive_exp_tail_cs_p..." ^ "\n");OperationCall (multiplicative_exp_cs,DummyT,[OclLibPackage,"DummyT",#1(additive_exp_tail_cs_p)],[(#2(additive_exp_tail_cs_p),DummyT)],DummyT))
|
||||
|
||||
(* RETURN: (add_op, Ocl_Term) *)
|
||||
additive_exp_tail_cs_p : additive_exp_tail_cs (additive_exp_tail_cs)
|
||||
|
@ -585,7 +584,7 @@ additive_exp_tail_cs : add_op multiplicative_exp_cs
|
|||
add_op: PLUS (PLUS)
|
||||
| MINUS (MINUS)
|
||||
(* RETURN: OclTerm *)
|
||||
multiplicative_exp_cs: unary_exp_cs (trace low ("unary_exp_cs ..." ^ "\n");unary_exp_cs)
|
||||
multiplicative_exp_cs: unary_exp_cs (Logger.debug3 ("unary_exp_cs ..." ^ "\n");unary_exp_cs)
|
||||
| unary_exp_cs multiplicative_exp_tail_cs_p (OperationCall (unary_exp_cs,DummyT,[OclLibPackage,"DummyT",#1(multiplicative_exp_tail_cs_p)],[(#2(multiplicative_exp_tail_cs_p),DummyT)],DummyT))
|
||||
|
||||
(* RETURN: (mult_op, Ocl_Term ) *)
|
||||
|
@ -607,22 +606,22 @@ unary_op : MINUS
|
|||
|
||||
(* RETURN: OclTerm *)
|
||||
postfix_exp_cs : primary_exp_cs (primary_exp_cs)
|
||||
| primary_exp_cs postfix_exp_tail_cs_p (trace low ("literal_call_exp_cs..." ^ "\n");nest_source ([primary_exp_cs]@postfix_exp_tail_cs_p))
|
||||
| primary_exp_cs postfix_exp_tail_cs_p (Logger.debug3 ("literal_call_exp_cs..." ^ "\n");nest_source ([primary_exp_cs]@postfix_exp_tail_cs_p))
|
||||
(* NOT YET IMPLEMENTED
|
||||
| msg_operator_cs signal_spec_exp_cs
|
||||
*)
|
||||
(* RETURN: OclTerm *)
|
||||
primary_exp_cs : literal_exp_cs (trace low ("literal_call_exp_cs..." ^ "\n");literal_exp_cs)
|
||||
primary_exp_cs : literal_exp_cs (Logger.debug3 ("literal_call_exp_cs..." ^ "\n");literal_exp_cs)
|
||||
| PAREN_OPEN expression PAREN_CLOSE (expression)
|
||||
| property_call_exp_cs (trace low ("property_call_exp_cs..." ^ "\n");property_call_exp_cs)
|
||||
| property_call_exp_cs (Logger.debug3 ("property_call_exp_cs..." ^ "\n");property_call_exp_cs)
|
||||
| if_exp_cs (if_exp_cs)
|
||||
|
||||
(* RETURN: OclTerm *)
|
||||
if_exp_cs: IF logical_exp_cs THEN ocl_expression_cs ELSE ocl_expression_cs ENDIF (If (logical_exp_cs,DummyT,ocl_expression_cs1,DummyT,ocl_expression_cs2,DummyT,DummyT))
|
||||
|
||||
(* RETURN: OclTerm list *)
|
||||
postfix_exp_tail_cs_p : postfix_exp_tail_cs (trace low ("end of recursion..." ^ Ocl2String.ocl2string false postfix_exp_tail_cs ^ "\n");[postfix_exp_tail_cs])
|
||||
| postfix_exp_tail_cs postfix_exp_tail_cs_p (trace low ("add_source ..." ^ "\n" ^ "done");([postfix_exp_tail_cs]@postfix_exp_tail_cs_p))
|
||||
postfix_exp_tail_cs_p : postfix_exp_tail_cs (Logger.debug3 ("end of recursion..." ^ Ocl2String.ocl2string false postfix_exp_tail_cs ^ "\n");[postfix_exp_tail_cs])
|
||||
| postfix_exp_tail_cs postfix_exp_tail_cs_p (Logger.debug3 ("add_source ..." ^ "\n" ^ "done");([postfix_exp_tail_cs]@postfix_exp_tail_cs_p))
|
||||
|
||||
(* RETURN: OclTerm *)
|
||||
postfix_exp_tail_cs : DOT property_call_exp_cs (property_call_exp_cs)
|
||||
|
@ -646,8 +645,8 @@ property_call_exp_cs : path_name_cs (AttributeCall (Va
|
|||
|
||||
(* RETURN: OclTerm *)
|
||||
arrow_property_call_exp_cs: iterator_name_cs PAREN_OPEN expression PAREN_CLOSE (Iterator (iterator_name_cs,[],Variable("dummy_source",DummyT),DummyT,expression,DummyT,DummyT))
|
||||
| iterator_name_cs PAREN_OPEN iterator_vars_cs expression PAREN_CLOSE (trace low ("arrow_property_call_cs: iterator with vars..." ^ "\n");Iterator (iterator_name_cs,iterator_vars_cs,Variable("dummy_source",DummyT),DummyT,expression,DummyT,DummyT))
|
||||
| simple_name PAREN_OPEN PAREN_CLOSE (trace low ("arrow_property_call_exp_cs..." ^ "\n");OperationCall (Variable ("dummy_source",DummyT),DummyT,(["arrow"]@[simple_name]),[],DummyT))
|
||||
| iterator_name_cs PAREN_OPEN iterator_vars_cs expression PAREN_CLOSE (Logger.debug3 ("arrow_property_call_cs: iterator with vars..." ^ "\n");Iterator (iterator_name_cs,iterator_vars_cs,Variable("dummy_source",DummyT),DummyT,expression,DummyT,DummyT))
|
||||
| simple_name PAREN_OPEN PAREN_CLOSE (Logger.debug3 ("arrow_property_call_exp_cs..." ^ "\n");OperationCall (Variable ("dummy_source",DummyT),DummyT,(["arrow"]@[simple_name]),[],DummyT))
|
||||
| simple_name PAREN_OPEN actual_parameter_list_cs PAREN_CLOSE (OperationCall (Variable ("dummy_source",DummyT),DummyT,(["arrow"]@[simple_name]),actual_parameter_list_cs,DummyT))
|
||||
(*
|
||||
| ITERATE PAREN_OPEN initialized_variable_cs VERTICAL_BAR expression PAREN_CLOSE (Iterate ([],(#1 initialized_variable_cs),(#2 initialized_variable_cs),(#3 initialized_variable_cs),Variable ("dummy_source",DummyT),DummyT,expression,DummyT,DummyT))
|
||||
|
@ -711,7 +710,7 @@ formal_parameter_cs : simple_name formal_parameter_type_specifier (simple
|
|||
formal_parameter_type_specifier : COLON type_specifier (type_specifier)
|
||||
|
||||
(* RETURN: OclType *)
|
||||
type_specifier: simple_type_specifier_cs (trace low ("type_specifier ..." ^ "\n");simple_type_specifier_cs)
|
||||
type_specifier: simple_type_specifier_cs (Logger.debug3 ("type_specifier ..." ^ "\n");simple_type_specifier_cs)
|
||||
| collection_type_specifier_cs (collection_type_specifier_cs)
|
||||
(*
|
||||
| typle_type_specifier_cs
|
||||
|
@ -719,7 +718,7 @@ type_specifier: simple_type_specifier_cs
|
|||
*)
|
||||
|
||||
(* RETURN: OclType *)
|
||||
simple_type_specifier_cs : simple_name (trace wgen ("simple_type_name_specifier_cs : " ^ simple_name ^ "\n");string_to_type simple_name)
|
||||
simple_type_specifier_cs : simple_name (Logger.debug3 ("simple_type_name_specifier_cs : " ^ simple_name ^ "\n");string_to_type simple_name)
|
||||
|
||||
|
||||
(* RETURN: (string * OclType * OclTerm) list *)
|
||||
|
|
|
@ -70,7 +70,6 @@ THIS POINTS HAVE TO BE NOTICED TO UNDERSTAND THE SEMANTICS OF:
|
|||
*)
|
||||
|
||||
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
|
@ -1412,7 +1411,7 @@ PACKAGE1 = PACKAGE1 ()
|
|||
val path_name_cs1 = path_name_cs1 ()
|
||||
val ENDPACKAGE1 = ENDPACKAGE1 ()
|
||||
in (
|
||||
trace low ("Starts creatind empty package ... " ^ "\n"); ([Empty_context ("this is an empty context", Literal ("empty",OclVoid))])
|
||||
Logger.debug3 ("Starts creatind empty package ... " ^ "\n"); ([Empty_context ("this is an empty context", Literal ("empty",OclVoid))])
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 10, ( result, PACKAGE1left, ENDPACKAGE1right),
|
||||
|
@ -1430,7 +1429,7 @@ PACKAGE1 ()
|
|||
context_declaration_list_cs1 ()
|
||||
val ENDPACKAGE1 = ENDPACKAGE1 ()
|
||||
in (
|
||||
trace low ("Starts creating contextes ..." ^ "\n"); (list_extend_path path_name_cs context_declaration_list_cs)
|
||||
Logger.debug3 ("Starts creating contextes ..." ^ "\n"); (list_extend_path path_name_cs context_declaration_list_cs)
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 10, ( result, PACKAGE1left, ENDPACKAGE1right),
|
||||
|
@ -1528,7 +1527,7 @@ end
|
|||
SIMPLE_NAME1right)) :: rest671)) => let val result =
|
||||
MlyValue.simple_name (fn _ => let val (SIMPLE_NAME as SIMPLE_NAME1) =
|
||||
SIMPLE_NAME1 ()
|
||||
in (trace low ("simple_name..." ^ "\n");SIMPLE_NAME)
|
||||
in (Logger.debug3 ("simple_name..." ^ "\n");SIMPLE_NAME)
|
||||
end)
|
||||
in ( LrTable.NT 32, ( result, SIMPLE_NAME1left, SIMPLE_NAME1right),
|
||||
rest671)
|
||||
|
@ -1712,7 +1711,7 @@ ocl_expression_cs1right)) :: ( _, ( MlyValue.COLON COLON1, _, _)) :: (
|
|||
val (ocl_expression_cs as ocl_expression_cs1) = ocl_expression_cs1
|
||||
()
|
||||
in (
|
||||
trace low ("INV COLON ocl_expression_cs ..." ^ "\n"); (NONE,ocl_expression_cs)
|
||||
Logger.debug3 ("INV COLON ocl_expression_cs ..." ^ "\n"); (NONE,ocl_expression_cs)
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 23, ( result, INV1left, ocl_expression_cs1right),
|
||||
|
@ -1729,7 +1728,7 @@ INV1 ()
|
|||
val (ocl_expression_cs as ocl_expression_cs1) = ocl_expression_cs1
|
||||
()
|
||||
in (
|
||||
trace low ("INV simple_name COLON ocl_expression_cs ..." ^ "\n");(SOME(simple_name),ocl_expression_cs)
|
||||
Logger.debug3 ("INV simple_name COLON ocl_expression_cs ..." ^ "\n");(SOME(simple_name),ocl_expression_cs)
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 23, ( result, INV1left, ocl_expression_cs1right),
|
||||
|
@ -1774,7 +1773,7 @@ op_constraint_stereotype_cs1) = op_constraint_stereotype_cs1 ()
|
|||
val (ocl_expression_cs as ocl_expression_cs1) = ocl_expression_cs1
|
||||
()
|
||||
in (
|
||||
trace low ("operation_constraint_cs 1..." ^ "\n"); (op_constraint_stereotype_cs,NONE,ocl_expression_cs)
|
||||
Logger.debug3 ("operation_constraint_cs 1..." ^ "\n"); (op_constraint_stereotype_cs,NONE,ocl_expression_cs)
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 26, ( result, op_constraint_stereotype_cs1left,
|
||||
|
@ -1793,7 +1792,7 @@ op_constraint_stereotype_cs1 ()
|
|||
val (ocl_expression_cs as ocl_expression_cs1) = ocl_expression_cs1
|
||||
()
|
||||
in (
|
||||
trace low ("operation_constraint_cs 23454..." ^ "\n"); (op_constraint_stereotype_cs,SOME(simple_name),ocl_expression_cs)
|
||||
Logger.debug3 ("operation_constraint_cs 23454..." ^ "\n"); (op_constraint_stereotype_cs,SOME(simple_name),ocl_expression_cs)
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 26, ( result, op_constraint_stereotype_cs1left,
|
||||
|
@ -1852,7 +1851,7 @@ ocl_attribute_defined_entity_decl_cs as
|
|||
ocl_attribute_defined_entity_decl_cs1) =
|
||||
ocl_attribute_defined_entity_decl_cs1 ()
|
||||
in (
|
||||
trace low ("AttributeCall 1 ..." ^ "\n");AttributeCall (Literal ("self2",DummyT),DummyT,[#1(ocl_attribute_defined_entity_decl_cs)],#2(ocl_attribute_defined_entity_decl_cs))
|
||||
Logger.debug3 ("AttributeCall 1 ..." ^ "\n");AttributeCall (Literal ("self2",DummyT),DummyT,[#1(ocl_attribute_defined_entity_decl_cs)],#2(ocl_attribute_defined_entity_decl_cs))
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 34, ( result,
|
||||
|
@ -1903,7 +1902,8 @@ PAREN_OPEN1left, _)) :: rest671)) => let val result =
|
|||
MlyValue.operation_signature_cs (fn _ => let val PAREN_OPEN1 =
|
||||
PAREN_OPEN1 ()
|
||||
val PAREN_CLOSE1 = PAREN_CLOSE1 ()
|
||||
in (trace low ("operation_signature_cs ..." ^ "\n");[("",OclVoid)])
|
||||
in (
|
||||
Logger.debug3 ("operation_signature_cs ..." ^ "\n");[("",OclVoid)])
|
||||
|
||||
end)
|
||||
in ( LrTable.NT 24, ( result, PAREN_OPEN1left, PAREN_CLOSE1right),
|
||||
|
@ -1921,7 +1921,7 @@ PAREN_OPEN1 = PAREN_OPEN1 ()
|
|||
operation_return_type_specifier_cs1) =
|
||||
operation_return_type_specifier_cs1 ()
|
||||
in (
|
||||
trace low ("operation_signature_cs ..." ^ "\n");[("",operation_return_type_specifier_cs)]
|
||||
Logger.debug3 ("operation_signature_cs ..." ^ "\n");[("",operation_return_type_specifier_cs)]
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 24, ( result, PAREN_OPEN1left,
|
||||
|
@ -1937,7 +1937,7 @@ PAREN_OPEN1 ()
|
|||
formal_parameter_list_cs1 ()
|
||||
val PAREN_CLOSE1 = PAREN_CLOSE1 ()
|
||||
in (
|
||||
trace low ("operation_signature_cs ..." ^ "\n");formal_parameter_list_cs@[("",OclVoid)]
|
||||
Logger.debug3 ("operation_signature_cs ..." ^ "\n");formal_parameter_list_cs@[("",OclVoid)]
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 24, ( result, PAREN_OPEN1left, PAREN_CLOSE1right),
|
||||
|
@ -1958,7 +1958,7 @@ formal_parameter_list_cs1 ()
|
|||
operation_return_type_specifier_cs1) =
|
||||
operation_return_type_specifier_cs1 ()
|
||||
in (
|
||||
trace low ("operation_signature_cs ..." ^ "\n");formal_parameter_list_cs@[("",operation_return_type_specifier_cs)]
|
||||
Logger.debug3 ("operation_signature_cs ..." ^ "\n");formal_parameter_list_cs@[("",operation_return_type_specifier_cs)]
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 24, ( result, PAREN_OPEN1left,
|
||||
|
@ -1971,7 +1971,7 @@ MlyValue.operation_return_type_specifier_cs (fn _ => let val COLON1 =
|
|||
COLON1 ()
|
||||
val (type_specifier as type_specifier1) = type_specifier1 ()
|
||||
in (
|
||||
trace low ("Contextes created form list of Attributes ..." ^ "\n");type_specifier
|
||||
Logger.debug3 ("Contextes created form list of Attributes ..." ^ "\n");type_specifier
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 40, ( result, COLON1left, type_specifier1right),
|
||||
|
@ -2182,8 +2182,9 @@ end
|
|||
logical_exp_cs1left, logical_exp_cs1right)) :: rest671)) => let val
|
||||
result = MlyValue.ocl_expression_cs (fn _ => let val (logical_exp_cs
|
||||
as logical_exp_cs1) = logical_exp_cs1 ()
|
||||
in (trace low ("ocl_expression_cs..." ^ "\n");logical_exp_cs)
|
||||
end)
|
||||
in (Logger.debug3 ("ocl_expression_cs..." ^ "\n");logical_exp_cs)
|
||||
end
|
||||
)
|
||||
in ( LrTable.NT 54, ( result, logical_exp_cs1left,
|
||||
logical_exp_cs1right), rest671)
|
||||
end
|
||||
|
@ -2191,7 +2192,7 @@ end
|
|||
let_exp_cs1right)) :: rest671)) => let val result =
|
||||
MlyValue.ocl_expression_cs (fn _ => let val (let_exp_cs as
|
||||
let_exp_cs1) = let_exp_cs1 ()
|
||||
in (trace low ("ocl_expression_cs..." ^ "\n");let_exp_cs)
|
||||
in (Logger.debug3 ("ocl_expression_cs..." ^ "\n");let_exp_cs)
|
||||
end)
|
||||
in ( LrTable.NT 54, ( result, let_exp_cs1left, let_exp_cs1right),
|
||||
rest671)
|
||||
|
@ -2314,7 +2315,8 @@ end
|
|||
identifier_cs1left, identifier_cs1right)) :: rest671)) => let val
|
||||
result = MlyValue.path_name_cs (fn _ => let val (identifier_cs as
|
||||
identifier_cs1) = identifier_cs1 ()
|
||||
in (trace low ("path_name finished..." ^ "\n");[identifier_cs])
|
||||
in (Logger.debug3 ("path_name finished..." ^ "\n");[identifier_cs])
|
||||
|
||||
end)
|
||||
in ( LrTable.NT 11, ( result, identifier_cs1left, identifier_cs1right
|
||||
), rest671)
|
||||
|
@ -2326,7 +2328,7 @@ path_name_head_cs1, path_name_head_cs1left, _)) :: rest671)) => let
|
|||
path_name_head_cs as path_name_head_cs1) = path_name_head_cs1 ()
|
||||
val (identifier_cs as identifier_cs1) = identifier_cs1 ()
|
||||
in (
|
||||
trace low ("path_name generation ..." ^ "\n");path_name_head_cs@[identifier_cs]
|
||||
Logger.debug3 ("path_name generation ..." ^ "\n");path_name_head_cs@[identifier_cs]
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 11, ( result, path_name_head_cs1left,
|
||||
|
@ -2336,8 +2338,9 @@ end
|
|||
simple_name1right)) :: rest671)) => let val result =
|
||||
MlyValue.identifier_cs (fn _ => let val (simple_name as simple_name1)
|
||||
= simple_name1 ()
|
||||
in (trace low ("path_name generation..." ^ "\n");simple_name)
|
||||
end)
|
||||
in (Logger.debug3 ("path_name generation..." ^ "\n");simple_name)
|
||||
end
|
||||
)
|
||||
in ( LrTable.NT 59, ( result, simple_name1left, simple_name1right),
|
||||
rest671)
|
||||
end
|
||||
|
@ -2373,9 +2376,9 @@ end
|
|||
_)) :: rest671)) => let val result = MlyValue.path_name_head_cs (fn
|
||||
_ => let val (identifier_cs as identifier_cs1) = identifier_cs1 ()
|
||||
val DBL_COLON1 = DBL_COLON1 ()
|
||||
in (trace low ("path_name generation..." ^ "\n");[identifier_cs])
|
||||
end
|
||||
)
|
||||
in (Logger.debug3 ("path_name generation..." ^ "\n");[identifier_cs])
|
||||
|
||||
end)
|
||||
in ( LrTable.NT 12, ( result, identifier_cs1left, DBL_COLON1right),
|
||||
rest671)
|
||||
end
|
||||
|
@ -2388,7 +2391,7 @@ path_name_head_cs1 ()
|
|||
val (identifier_cs as identifier_cs1) = identifier_cs1 ()
|
||||
val DBL_COLON1 = DBL_COLON1 ()
|
||||
in (
|
||||
trace low ("path_name generation..." ^ "\n");path_name_head_cs@[identifier_cs]
|
||||
Logger.debug3 ("path_name generation..." ^ "\n");path_name_head_cs@[identifier_cs]
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 12, ( result, path_name_head_cs1left, DBL_COLON1right
|
||||
|
@ -2400,7 +2403,7 @@ primitive_literal_exp_cs1right)) :: rest671)) => let val result =
|
|||
MlyValue.literal_exp_cs (fn _ => let val (primitive_literal_exp_cs
|
||||
as primitive_literal_exp_cs1) = primitive_literal_exp_cs1 ()
|
||||
in (
|
||||
trace low ("primitive_literal_exp_cs..." ^ "\n");primitive_literal_exp_cs
|
||||
Logger.debug3 ("primitive_literal_exp_cs..." ^ "\n");primitive_literal_exp_cs
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 62, ( result, primitive_literal_exp_cs1left,
|
||||
|
@ -2423,8 +2426,8 @@ MlyValue.primitive_literal_exp_cs (fn _ => let val (
|
|||
numeric_literal_exp_cs as numeric_literal_exp_cs1) =
|
||||
numeric_literal_exp_cs1 ()
|
||||
in (
|
||||
trace low ("numeric_literal_exp_cs..." ^ "\n");numeric_literal_exp_cs)
|
||||
|
||||
Logger.debug3 ("numeric_literal_exp_cs..." ^ "\n");numeric_literal_exp_cs
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 65, ( result, numeric_literal_exp_cs1left,
|
||||
numeric_literal_exp_cs1right), rest671)
|
||||
|
@ -2436,8 +2439,8 @@ MlyValue.primitive_literal_exp_cs (fn _ => let val (
|
|||
string_literal_exp_cs as string_literal_exp_cs1) =
|
||||
string_literal_exp_cs1 ()
|
||||
in (
|
||||
trace low ("string_literal_exp_cs..." ^ "\n");string_literal_exp_cs)
|
||||
|
||||
Logger.debug3 ("string_literal_exp_cs..." ^ "\n");string_literal_exp_cs
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 65, ( result, string_literal_exp_cs1left,
|
||||
string_literal_exp_cs1right), rest671)
|
||||
|
@ -2458,7 +2461,7 @@ INTEGER_LITERAL1left, INTEGER_LITERAL1right)) :: rest671)) => let val
|
|||
result = MlyValue.numeric_literal_exp_cs (fn _ => let val (
|
||||
INTEGER_LITERAL as INTEGER_LITERAL1) = INTEGER_LITERAL1 ()
|
||||
in (
|
||||
trace low ("INTEGER_LITERAL..." ^ "\n");Literal (INTEGER_LITERAL,Integer)
|
||||
Logger.debug3 ("INTEGER_LITERAL..." ^ "\n");Literal (INTEGER_LITERAL,Integer)
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 66, ( result, INTEGER_LITERAL1left,
|
||||
|
@ -2500,8 +2503,9 @@ end
|
|||
relational_exp_cs1left, relational_exp_cs1right)) :: rest671)) => let
|
||||
val result = MlyValue.logical_exp_cs (fn _ => let val (
|
||||
relational_exp_cs as relational_exp_cs1) = relational_exp_cs1 ()
|
||||
in (trace low ("logical_exp_cs..." ^ "\n");relational_exp_cs)
|
||||
end)
|
||||
in (Logger.debug3 ("logical_exp_cs..." ^ "\n");relational_exp_cs)
|
||||
end
|
||||
)
|
||||
in ( LrTable.NT 73, ( result, relational_exp_cs1left,
|
||||
relational_exp_cs1right), rest671)
|
||||
end
|
||||
|
@ -2514,7 +2518,7 @@ relational_exp_cs1 ()
|
|||
val (logical_exp_tail_cs_p as logical_exp_tail_cs_p1) =
|
||||
logical_exp_tail_cs_p1 ()
|
||||
in (
|
||||
trace low ("logical_exp_cs..." ^ "\n");OperationCall(relational_exp_cs,Boolean,[OclLibPackage,"Boolean",#1(logical_exp_tail_cs_p)],[(#2(logical_exp_tail_cs_p),Boolean)],Boolean)
|
||||
Logger.debug3 ("logical_exp_cs..." ^ "\n");OperationCall(relational_exp_cs,Boolean,[OclLibPackage,"Boolean",#1(logical_exp_tail_cs_p)],[(#2(logical_exp_tail_cs_p),Boolean)],Boolean)
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 73, ( result, relational_exp_cs1left,
|
||||
|
@ -2592,7 +2596,7 @@ end
|
|||
additive_exp_cs1left, additive_exp_cs1right)) :: rest671)) => let val
|
||||
result = MlyValue.relational_exp_cs (fn _ => let val (
|
||||
additive_exp_cs as additive_exp_cs1) = additive_exp_cs1 ()
|
||||
in (trace low ("additive_exp_cs..." ^ "\n");additive_exp_cs)
|
||||
in (Logger.debug3 ("additive_exp_cs..." ^ "\n");additive_exp_cs)
|
||||
end)
|
||||
in ( LrTable.NT 75, ( result, additive_exp_cs1left,
|
||||
additive_exp_cs1right), rest671)
|
||||
|
@ -2605,7 +2609,7 @@ MlyValue.additive_exp_cs additive_exp_cs1, additive_exp_cs1left, _))
|
|||
val (relational_exp_tail_cs as relational_exp_tail_cs1) =
|
||||
relational_exp_tail_cs1 ()
|
||||
in (
|
||||
trace low ("additive_exp_cs relational_exp_tail_cs ..." ^ "\n");OperationCall(additive_exp_cs,DummyT,[OclLibPackage,"DummyT",#1(relational_exp_tail_cs)],[(#2(relational_exp_tail_cs),DummyT)],Boolean)
|
||||
Logger.debug3 ("additive_exp_cs relational_exp_tail_cs ..." ^ "\n");OperationCall(additive_exp_cs,DummyT,[OclLibPackage,"DummyT",#1(relational_exp_tail_cs)],[(#2(relational_exp_tail_cs),DummyT)],Boolean)
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 75, ( result, additive_exp_cs1left,
|
||||
|
@ -2618,7 +2622,7 @@ MlyValue.relational_exp_tail_cs (fn _ => let val (rel_op as rel_op1)
|
|||
= rel_op1 ()
|
||||
val (additive_exp_cs as additive_exp_cs1) = additive_exp_cs1 ()
|
||||
in (
|
||||
trace low ("relational_exp_tail_cs..." ^ "\n");(rel_op, additive_exp_cs)
|
||||
Logger.debug3 ("relational_exp_tail_cs..." ^ "\n");(rel_op, additive_exp_cs)
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 77, ( result, rel_op1left, additive_exp_cs1right),
|
||||
|
@ -2635,7 +2639,7 @@ end
|
|||
| ( 113, ( ( _, ( MlyValue.REL_GT REL_GT1, REL_GT1left, REL_GT1right)
|
||||
) :: rest671)) => let val result = MlyValue.rel_op (fn _ => let val
|
||||
(REL_GT as REL_GT1) = REL_GT1 ()
|
||||
in (trace low (">..." ^ "\n");REL_GT)
|
||||
in (Logger.debug3 (">..." ^ "\n");REL_GT)
|
||||
end)
|
||||
in ( LrTable.NT 82, ( result, REL_GT1left, REL_GT1right), rest671)
|
||||
|
||||
|
@ -2643,7 +2647,7 @@ end
|
|||
| ( 114, ( ( _, ( MlyValue.REL_LT REL_LT1, REL_LT1left, REL_LT1right)
|
||||
) :: rest671)) => let val result = MlyValue.rel_op (fn _ => let val
|
||||
(REL_LT as REL_LT1) = REL_LT1 ()
|
||||
in (trace low ("<..." ^ "\n");REL_LT)
|
||||
in (Logger.debug3 ("<..." ^ "\n");REL_LT)
|
||||
end)
|
||||
in ( LrTable.NT 82, ( result, REL_LT1left, REL_LT1right), rest671)
|
||||
|
||||
|
@ -2679,8 +2683,8 @@ multiplicative_exp_cs1right)) :: rest671)) => let val result =
|
|||
MlyValue.additive_exp_cs (fn _ => let val (multiplicative_exp_cs as
|
||||
multiplicative_exp_cs1) = multiplicative_exp_cs1 ()
|
||||
in (
|
||||
trace low ("multiplicative_exp_cs..." ^ "\n");multiplicative_exp_cs)
|
||||
|
||||
Logger.debug3 ("multiplicative_exp_cs..." ^ "\n");multiplicative_exp_cs
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 79, ( result, multiplicative_exp_cs1left,
|
||||
multiplicative_exp_cs1right), rest671)
|
||||
|
@ -2694,7 +2698,7 @@ multiplicative_exp_cs1) = multiplicative_exp_cs1 ()
|
|||
val (additive_exp_tail_cs_p as additive_exp_tail_cs_p1) =
|
||||
additive_exp_tail_cs_p1 ()
|
||||
in (
|
||||
trace low ("multiplicative_exp_cs additive_exp_tail_cs_p..." ^ "\n");OperationCall (multiplicative_exp_cs,DummyT,[OclLibPackage,"DummyT",#1(additive_exp_tail_cs_p)],[(#2(additive_exp_tail_cs_p),DummyT)],DummyT)
|
||||
Logger.debug3 ("multiplicative_exp_cs additive_exp_tail_cs_p..." ^ "\n");OperationCall (multiplicative_exp_cs,DummyT,[OclLibPackage,"DummyT",#1(additive_exp_tail_cs_p)],[(#2(additive_exp_tail_cs_p),DummyT)],DummyT)
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 79, ( result, multiplicative_exp_cs1left,
|
||||
|
@ -2756,7 +2760,7 @@ end
|
|||
unary_exp_cs1left, unary_exp_cs1right)) :: rest671)) => let val
|
||||
result = MlyValue.multiplicative_exp_cs (fn _ => let val (
|
||||
unary_exp_cs as unary_exp_cs1) = unary_exp_cs1 ()
|
||||
in (trace low ("unary_exp_cs ..." ^ "\n");unary_exp_cs)
|
||||
in (Logger.debug3 ("unary_exp_cs ..." ^ "\n");unary_exp_cs)
|
||||
end)
|
||||
in ( LrTable.NT 83, ( result, unary_exp_cs1left, unary_exp_cs1right),
|
||||
rest671)
|
||||
|
@ -2880,7 +2884,7 @@ rest671)) => let val result = MlyValue.postfix_exp_cs (fn _ => let
|
|||
val (postfix_exp_tail_cs_p as postfix_exp_tail_cs_p1) =
|
||||
postfix_exp_tail_cs_p1 ()
|
||||
in (
|
||||
trace low ("literal_call_exp_cs..." ^ "\n");nest_source ([primary_exp_cs]@postfix_exp_tail_cs_p)
|
||||
Logger.debug3 ("literal_call_exp_cs..." ^ "\n");nest_source ([primary_exp_cs]@postfix_exp_tail_cs_p)
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 90, ( result, primary_exp_cs1left,
|
||||
|
@ -2890,7 +2894,8 @@ end
|
|||
literal_exp_cs1left, literal_exp_cs1right)) :: rest671)) => let val
|
||||
result = MlyValue.primary_exp_cs (fn _ => let val (literal_exp_cs as
|
||||
literal_exp_cs1) = literal_exp_cs1 ()
|
||||
in (trace low ("literal_call_exp_cs..." ^ "\n");literal_exp_cs)
|
||||
in (Logger.debug3 ("literal_call_exp_cs..." ^ "\n");literal_exp_cs)
|
||||
|
||||
end)
|
||||
in ( LrTable.NT 93, ( result, literal_exp_cs1left,
|
||||
literal_exp_cs1right), rest671)
|
||||
|
@ -2912,8 +2917,9 @@ end
|
|||
=> let val result = MlyValue.primary_exp_cs (fn _ => let val (
|
||||
property_call_exp_cs as property_call_exp_cs1) = property_call_exp_cs1
|
||||
()
|
||||
in (trace low ("property_call_exp_cs..." ^ "\n");property_call_exp_cs
|
||||
)
|
||||
in (
|
||||
Logger.debug3 ("property_call_exp_cs..." ^ "\n");property_call_exp_cs)
|
||||
|
||||
end)
|
||||
in ( LrTable.NT 93, ( result, property_call_exp_cs1left,
|
||||
property_call_exp_cs1right), rest671)
|
||||
|
@ -2951,7 +2957,7 @@ postfix_exp_tail_cs1left, postfix_exp_tail_cs1right)) :: rest671)) =>
|
|||
let val result = MlyValue.postfix_exp_tail_cs_p (fn _ => let val (
|
||||
postfix_exp_tail_cs as postfix_exp_tail_cs1) = postfix_exp_tail_cs1 ()
|
||||
in (
|
||||
trace low ("end of recursion..." ^ Ocl2String.ocl2string false postfix_exp_tail_cs ^ "\n");[postfix_exp_tail_cs]
|
||||
Logger.debug3 ("end of recursion..." ^ Ocl2String.ocl2string false postfix_exp_tail_cs ^ "\n");[postfix_exp_tail_cs]
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 91, ( result, postfix_exp_tail_cs1left,
|
||||
|
@ -2966,7 +2972,7 @@ MlyValue.postfix_exp_tail_cs_p (fn _ => let val (postfix_exp_tail_cs
|
|||
val (postfix_exp_tail_cs_p as postfix_exp_tail_cs_p1) =
|
||||
postfix_exp_tail_cs_p1 ()
|
||||
in (
|
||||
trace low ("add_source ..." ^ "\n" ^ "done");([postfix_exp_tail_cs]@postfix_exp_tail_cs_p)
|
||||
Logger.debug3 ("add_source ..." ^ "\n" ^ "done");([postfix_exp_tail_cs]@postfix_exp_tail_cs_p)
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 91, ( result, postfix_exp_tail_cs1left,
|
||||
|
@ -3079,7 +3085,7 @@ iterator_name_cs as iterator_name_cs1) = iterator_name_cs1 ()
|
|||
val (expression as expression1) = expression1 ()
|
||||
val PAREN_CLOSE1 = PAREN_CLOSE1 ()
|
||||
in (
|
||||
trace low ("arrow_property_call_cs: iterator with vars..." ^ "\n");Iterator (iterator_name_cs,iterator_vars_cs,Variable("dummy_source",DummyT),DummyT,expression,DummyT,DummyT)
|
||||
Logger.debug3 ("arrow_property_call_cs: iterator with vars..." ^ "\n");Iterator (iterator_name_cs,iterator_vars_cs,Variable("dummy_source",DummyT),DummyT,expression,DummyT,DummyT)
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 95, ( result, iterator_name_cs1left,
|
||||
|
@ -3093,7 +3099,7 @@ PAREN_CLOSE1right)) :: ( _, ( MlyValue.PAREN_OPEN PAREN_OPEN1, _, _))
|
|||
val PAREN_OPEN1 = PAREN_OPEN1 ()
|
||||
val PAREN_CLOSE1 = PAREN_CLOSE1 ()
|
||||
in (
|
||||
trace low ("arrow_property_call_exp_cs..." ^ "\n");OperationCall (Variable ("dummy_source",DummyT),DummyT,(["arrow"]@[simple_name]),[],DummyT)
|
||||
Logger.debug3 ("arrow_property_call_exp_cs..." ^ "\n");OperationCall (Variable ("dummy_source",DummyT),DummyT,(["arrow"]@[simple_name]),[],DummyT)
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 95, ( result, simple_name1left, PAREN_CLOSE1right),
|
||||
|
@ -3358,7 +3364,8 @@ simple_type_specifier_cs1, simple_type_specifier_cs1left,
|
|||
simple_type_specifier_cs1right)) :: rest671)) => let val result =
|
||||
MlyValue.type_specifier (fn _ => let val (simple_type_specifier_cs
|
||||
as simple_type_specifier_cs1) = simple_type_specifier_cs1 ()
|
||||
in (trace low ("type_specifier ..." ^ "\n");simple_type_specifier_cs)
|
||||
in (
|
||||
Logger.debug3 ("type_specifier ..." ^ "\n");simple_type_specifier_cs)
|
||||
|
||||
end)
|
||||
in ( LrTable.NT 19, ( result, simple_type_specifier_cs1left,
|
||||
|
@ -3380,7 +3387,7 @@ end
|
|||
MlyValue.simple_type_specifier_cs (fn _ => let val (simple_name as
|
||||
simple_name1) = simple_name1 ()
|
||||
in (
|
||||
trace wgen ("simple_type_name_specifier_cs : " ^ simple_name ^ "\n");string_to_type simple_name
|
||||
Logger.debug3 ("simple_type_name_specifier_cs : " ^ simple_name ^ "\n");string_to_type simple_name
|
||||
)
|
||||
end)
|
||||
in ( LrTable.NT 52, ( result, simple_name1left, simple_name1right),
|
||||
|
|
|
@ -49,7 +49,6 @@ structure OclParser : sig
|
|||
val parse_contextlist: string -> (Context.context list * Rep_Core.Classifier list)
|
||||
end =
|
||||
struct
|
||||
open Rep_Logger
|
||||
open Context
|
||||
|
||||
structure OclParserLrVals =
|
||||
|
|
|
@ -5,8 +5,8 @@
|
|||
* preprocessor.sml ---
|
||||
* This file is part of su4sml.
|
||||
*
|
||||
* Copyright (c) 2005-2007, ETH Zurich, Switzerland
|
||||
* 2008 Achim D. Brucker, Germany
|
||||
* Copyright (c) 2005-2007 ETH Zurich, Switzerland
|
||||
* 2008-2009 Achim D. Brucker, Germany
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
|
@ -51,7 +51,6 @@ end
|
|||
structure Preprocessor:PREPROCESSOR =
|
||||
struct
|
||||
open Rep_Helper
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
|
@ -153,56 +152,56 @@ fun fun_name (Varible (str,type)) =
|
|||
(* RETURN: OclTerm *)
|
||||
fun embed_atPre_expressions_collpart (CollectionItem (term,typ)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_atPre_expression_collpart CollectionItem(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expression_collpart CollectionItem(...)\n")
|
||||
val res = (CollectionItem (embed_atPre_expressions term,typ))
|
||||
val _ = trace function_ends ("Preprocessor.embed_atPre_expression_collpart\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expression_collpart\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_atPre_expressions_collpart (CollectionRange (term1,term2,typ)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_atPre_expression_collpart CollectionRange(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expression_collpart CollectionRange(...)\n")
|
||||
val res = (CollectionRange (embed_atPre_expressions term1, embed_atPre_expressions term2, typ))
|
||||
val _ = trace function_ends ("Preprocessor.embed_atPre_expression_collpart\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expression_collpart\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
||||
and embed_atPre_expressions (Variable (str,typ)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_atPre_expressions Variable(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions Variable(...)\n")
|
||||
val res = (Variable (str,typ))
|
||||
val _ = trace function_ends ("Preprocessor.embed_atPre_expressions\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_atPre_expressions (Literal (str,typ)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_atPre_expressions Literal(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions Literal(...)\n")
|
||||
val res = (Literal (str,typ))
|
||||
val _ = trace function_ends ("Preprocessor.embed_atPre_expressions\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_atPre_expressions (CollectionLiteral (collpart,typ)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_atPre_expressions CollectionLiteral(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions CollectionLiteral(...)\n")
|
||||
val res = (CollectionLiteral (List.map (embed_atPre_expressions_collpart) collpart,typ))
|
||||
val _ = trace function_ends ("Preprocessor.embed_atPre_expressions\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_atPre_expressions (If (cond,cond_type,then_e,then_type,else_e,else_type,res_type)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_atPre_expressions Variable(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions Variable(...)\n")
|
||||
val res = (If (embed_atPre_expressions cond,cond_type,embed_atPre_expressions then_e,then_type,embed_atPre_expressions else_e,else_type,res_type))
|
||||
val _ = trace function_ends ("Preprocessor.embed_atPre_expressions\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_atPre_expressions (AttributeCall (sterm,styp,p,res_typ)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_atPre_expressions AttributeCall(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions AttributeCall(...)\n")
|
||||
val res =
|
||||
if (List.last (p) = "atPre")
|
||||
then (* atPre Call *)
|
||||
|
@ -215,125 +214,125 @@ and embed_atPre_expressions (Variable (str,typ)) =
|
|||
)
|
||||
else (* normal Call *)
|
||||
(AttributeCall (embed_atPre_expressions sterm,styp,p,res_typ))
|
||||
val _ = trace function_ends ("Preprocessor.embed_atPre_expressions\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_atPre_expressions (OperationCall (sterm,styp,pa,para,res_typ)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_atPre_expressions OperationCall(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions OperationCall(...)\n")
|
||||
val atpre_para = List.map (fn (a,b) => (embed_atPre_expressions a,b)) para
|
||||
val res =
|
||||
if (List.last (pa) = "atPre")
|
||||
then (OperationCall (OperationCall (embed_atPre_expressions sterm,styp,real_path pa,atpre_para,res_typ),DummyT,[OclLibPackage,"OclAny","atPre"],[],DummyT))
|
||||
else (OperationCall (embed_atPre_expressions sterm,styp,pa,atpre_para,res_typ))
|
||||
val _ = trace function_ends ("Preprocessor.embed_atPre_expressions\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_atPre_expressions (OperationWithType (sterm,stype,para_name,para_type,res_type)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_atPre_expressions OperationWithType(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions OperationWithType(...)\n")
|
||||
val res = (OperationWithType (embed_atPre_expressions sterm,stype,para_name,para_type,res_type))
|
||||
val _ = trace function_ends ("Preprocessor.embed_atPre_expressions\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_atPre_expressions (Let (var_name,var_type,rhs,rhs_type,in_e,in_type)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_atPre_expressions Let(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions Let(...)\n")
|
||||
val res = (Let (var_name,var_type,embed_atPre_expressions rhs,rhs_type,embed_atPre_expressions in_e,in_type))
|
||||
val _ = trace function_ends ("Preprocessor.embed_atPre_expressions\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_atPre_expressions (Iterator (name,iter_vars,sterm,stype,body_e,body_type,res_type)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_atPre_expressions Iterator(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions Iterator(...)\n")
|
||||
val res = (Iterator (name,iter_vars,embed_atPre_expressions sterm,stype,embed_atPre_expressions body_e,body_type,res_type))
|
||||
val _ = trace function_ends ("Preprocessor.embed_atPre_expressions\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_atPre_expressions (Iterate (iter_vars,acc_var_name,acc_var_type,acc_var_term,sterm,stype,bterm,btype,res_type)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_atPre_expressions Iterate(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expressions Iterate(...)\n")
|
||||
val res = (Iterate (iter_vars,acc_var_name,acc_var_type,acc_var_term,embed_atPre_expressions sterm,stype,embed_atPre_expressions bterm,btype,res_type))
|
||||
val _ = trace function_ends ("Preprocessor.embed_atPre_expression\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_atPre_expression\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
(* RETURN: OclTerm *)
|
||||
fun embed_bound_variable (str,typ) (Variable(s,t)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_bound_variable Variable(...)\n")
|
||||
val _ = trace preprocessor ("1 Bound variable '" ^ s ^ "' in 'AttributeCall': " ^ Ocl2String.ocl2string false (Variable(s,t)) ^ "\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable Variable(...)\n")
|
||||
val _ = Logger.debug3 ("1 Bound variable '" ^ s ^ "' in 'AttributeCall': " ^ Ocl2String.ocl2string false (Variable(s,t)) ^ "\n")
|
||||
val res =
|
||||
if (str = s ) then
|
||||
Variable(s,typ)
|
||||
else
|
||||
Variable(s,t)
|
||||
val _ = trace function_ends ("Preprocessor.embed_bound_variable\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_bound_variable (s,typ) (AttributeCall (sterm,styp,path,rtyp)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
|
||||
val _ = trace preprocessor ("2 Bound variable '" ^ s ^ "' in 'AttributeCall': " ^ Ocl2String.ocl2string false (AttributeCall (sterm,styp,path,rtyp)) ^ "\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
|
||||
val _ = Logger.debug3 ("2 Bound variable '" ^ s ^ "' in 'AttributeCall': " ^ Ocl2String.ocl2string false (AttributeCall (sterm,styp,path,rtyp)) ^ "\n")
|
||||
val res =
|
||||
if (List.last path = s) then
|
||||
(* embed variable *)
|
||||
(Variable (s,typ))
|
||||
else
|
||||
(AttributeCall (embed_bound_variable (s,typ) sterm,styp,path,rtyp))
|
||||
val _ = trace function_ends ("Preprocessor.embed_bound_variable\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_bound_variable (s,typ) (OperationCall (sterm,styp,path,args,rtyp)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
|
||||
val _ = trace preprocessor ("Bound variable '" ^ s ^ "' in 'OperationCall': " ^ Ocl2String.ocl2string false (OperationCall (sterm,styp,path,args,rtyp)) ^ "\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
|
||||
val _ = Logger.debug3 ("Bound variable '" ^ s ^ "' in 'OperationCall': " ^ Ocl2String.ocl2string false (OperationCall (sterm,styp,path,args,rtyp)) ^ "\n")
|
||||
val res = (OperationCall (embed_bound_variable (s,typ) sterm,styp,path,embed_bound_args (s,typ) args ,rtyp))
|
||||
val _ = trace function_ends ("Preprocessor.embed_bound_variable\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_bound_variable (s,typ) (Iterator (name,iter_list,sterm,styp,expr,expr_typ,rtyp)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
|
||||
val _ = trace preprocessor ("Bound variable '" ^ s ^ "' in 'Iterator': " ^ Ocl2String.ocl2string false (Iterator (name,iter_list,sterm,styp,expr,expr_typ,rtyp)) ^ "\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
|
||||
val _ = Logger.debug3 ("Bound variable '" ^ s ^ "' in 'Iterator': " ^ Ocl2String.ocl2string false (Iterator (name,iter_list,sterm,styp,expr,expr_typ,rtyp)) ^ "\n")
|
||||
val res = (Iterator (name,iter_list,embed_bound_variable (s,typ) sterm,styp,embed_bound_variables iter_list (embed_bound_variable (s,typ) expr),expr_typ,rtyp))
|
||||
val _ = trace function_ends ("Preprocessor.embed_bound_variable\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_bound_variable (s,typ) (Iterate (iter_vars,acc_name,acc_type,acc_term,sterm,stype,bterm,btype,res_type)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
|
||||
val _ = trace medium ("Bound variable '" ^ s ^ "' in 'Iterate': " ^ Ocl2String.ocl2string false (Iterate (iter_vars,acc_name,acc_type,acc_term,sterm,stype,bterm,btype,res_type)) ^ "\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
|
||||
val _ = Logger.debug1 ("Bound variable '" ^ s ^ "' in 'Iterate': " ^ Ocl2String.ocl2string false (Iterate (iter_vars,acc_name,acc_type,acc_term,sterm,stype,bterm,btype,res_type)) ^ "\n")
|
||||
val res = (Iterate (iter_vars,acc_name,acc_type,acc_term,embed_bound_variable (s,typ) sterm,stype,embed_bound_variable (s,typ) bterm,btype,res_type))
|
||||
val _ = trace function_ends ("Preprocessor.embed_bound_variable\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_bound_variable (s,typ) (Let (var_name,var_type,rhs,rhs_type,in_e,in_type)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
|
||||
val _ = trace preprocessor ("Bound variable '" ^ s ^ "' in 'Let': " ^ Ocl2String.ocl2string false (Let (var_name,var_type,rhs,rhs_type,in_e,in_type)) ^ "\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
|
||||
val _ = Logger.debug3 ("Bound variable '" ^ s ^ "' in 'Let': " ^ Ocl2String.ocl2string false (Let (var_name,var_type,rhs,rhs_type,in_e,in_type)) ^ "\n")
|
||||
val embed_in_e = embed_bound_variable (var_name,var_type) in_e
|
||||
val res = (Let (var_name,var_type,embed_bound_variable (s,typ) rhs,rhs_type,embed_bound_variable (s,typ) embed_in_e,in_type))
|
||||
val _ = trace function_ends ("Preprocessor.embed_bound_variable\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| embed_bound_variable (s,typ) (If (cond,cond_type,then_e,then_type,else_e,else_type,res_type)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
|
||||
val _ = trace preprocessor ("Bound variable '" ^ s ^ "' in 'If' ..." ^ "\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable AttributeCall(...)\n")
|
||||
val _ = Logger.debug3 ("Bound variable '" ^ s ^ "' in 'If' ..." ^ "\n")
|
||||
val res = (If (embed_bound_variable (s,typ) cond,cond_type,embed_bound_variable (s,typ) then_e,then_type,embed_bound_variable (s,typ) else_e,else_type,res_type))
|
||||
val _ = trace function_ends ("Preprocessor.embed_bound_variable\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.embed_bound_variable\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -392,14 +391,14 @@ and generate_variables (Literal (paras)) path meth_name model = Literal (paras)
|
|||
(If (generate_variables cond path meth_name model,cond_type,generate_variables then_e path meth_name model,then_type,generate_variables else_e path meth_name model,else_type,res_type))
|
||||
| generate_variables (AttributeCall (src,src_type,["result"],_)) path meth_name model =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.generate_variables: AttributeCall\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.generate_variables: AttributeCall\n")
|
||||
val new_src = generate_variables src path meth_name model
|
||||
val _ = List.app (print o (fn x => x^"\n") o string_of_path o name_of ) model
|
||||
val classifier = class_of path (model,[])
|
||||
val _ = trace low "classifier found\n"
|
||||
val _ = Logger.debug4 "classifier found\n"
|
||||
val meth = get_operation meth_name classifier (model,[])
|
||||
val res = (Variable ("result",(#result (meth))))
|
||||
val _ = trace function_ends ("Preprocessor.generate_variables\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.generate_variables\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -407,21 +406,21 @@ and generate_variables (Literal (paras)) path meth_name model = Literal (paras)
|
|||
(AttributeCall (generate_variables sterm path meth_name model,styp,p,res_typ))
|
||||
| generate_variables (OperationCall (sterm,styp,pa,paras,res_typ)) path meth_name model =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.generate_variables \n")
|
||||
val _ = Logger.debug2 ("Preprocessor.generate_variables \n")
|
||||
val new_para_terms = List.map (fn (a,b) => generate_variables (a) path meth_name model) paras
|
||||
val new_paras = List.map (fn a => (a, type_of_term a)) new_para_terms
|
||||
val res =
|
||||
(OperationCall (generate_variables sterm path meth_name model,styp,pa,new_paras,res_typ))
|
||||
val _ = trace function_ends ("Preprocessor.generate_variables\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.generate_variables\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| generate_variables (OperationWithType (sterm,stype,para_name,para_type,res_typ)) path meth_name model =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.generate_variables \n")
|
||||
val _ = Logger.debug2 ("Preprocessor.generate_variables \n")
|
||||
val res =
|
||||
(OperationWithType (generate_variables sterm path meth_name model,stype,para_name,para_type,res_typ))
|
||||
val _ = trace function_ends ("Preprocessor.generate_variables\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.generate_variables\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -441,27 +440,27 @@ fun fetch (x,((y1,y2)::tail)) =
|
|||
fun check_for_self_paras arg_list typ [] model = []
|
||||
| check_for_self_paras arg_list typ ((term,t)::tail) model =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.check_for_self_paras\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self_paras\n")
|
||||
val res = ((check_for_self arg_list typ term model),t)::(check_for_self_paras arg_list typ tail model)
|
||||
val _ = trace function_ends ("Preprocessor.check_for_self_paras\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self_paras\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
||||
and check_for_self_collpart arg_list typ model (CollectionItem (term,ctyp)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.check_for_self_collpart CollectionItem(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self_collpart CollectionItem(...)\n")
|
||||
val res = (CollectionItem (check_for_self arg_list typ term model,ctyp))
|
||||
val _ = trace function_ends ("Preprocessor.check_for_self_collpart\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self_collpart\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| check_for_self_collpart arg_list typ model (CollectionRange (term1,term2,ctyp)) =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.check_for_self_collpart CollectionRange(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self_collpart CollectionRange(...)\n")
|
||||
val res = (CollectionRange (check_for_self arg_list typ term1 model,
|
||||
check_for_self arg_list typ term2 model, ctyp))
|
||||
val _ = trace function_ends ("Preprocessor.check_for_self_collpart\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self_collpart\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -469,35 +468,35 @@ and check_for_self_collpart arg_list typ model (CollectionItem (term,ctyp)) =
|
|||
(* RETURN: OclTerm *)
|
||||
and check_for_self arg_list typ (AttributeCall (Variable("dummy_source",_),_,path,_)) model=
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.check_for_self: dummy_source AttributeCall\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self: dummy_source AttributeCall\n")
|
||||
val test = (member (List.last path) (List.map (#1) arg_list))
|
||||
val _ = trace preprocessor ("member? "^ Bool.toString (test) ^ "\n")
|
||||
val _ = Logger.debug3 ("member? "^ Bool.toString (test) ^ "\n")
|
||||
val res =
|
||||
if (List.last path = "self") then
|
||||
(* 'self' is writen in the ocl file *)
|
||||
(Variable ("self",typ))
|
||||
else
|
||||
(AttributeCall (Variable ("self",typ),DummyT,path,DummyT))
|
||||
val _ = trace function_ends ("Preprocessor.check_for_self\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
||||
| check_for_self arg_list typ (CollectionLiteral (collpart,ctyp)) model =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.check_for_self: dummy_source CollectionLiteral\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self: dummy_source CollectionLiteral\n")
|
||||
|
||||
val res = (CollectionLiteral (List.map (check_for_self_collpart arg_list typ model) collpart,ctyp))
|
||||
val _ = trace function_ends ("Preprocessor.check_for_self\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
||||
| check_for_self arg_list typ (AttributeCall (source_term,source_typ,path,ret_typ)) model =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.check_for_self: complex AttributeCall\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self: complex AttributeCall\n")
|
||||
val res = (AttributeCall (check_for_self arg_list typ source_term model,source_typ,path,ret_typ))
|
||||
val _ = trace function_ends ("Preprocessor.check_for_self\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -505,7 +504,7 @@ and check_for_self arg_list typ (AttributeCall (Variable("dummy_source",_),_,pat
|
|||
| check_for_self arg_list typ (OperationCall (Variable ("dummy_source",_),source_type,path,paras,ret_typ)) model =
|
||||
let
|
||||
val test = (member (List.last path) (List.map (#1) arg_list))
|
||||
val _ = trace preprocessor ("member2? "^ Bool.toString (test) ^ "\n")
|
||||
val _ = Logger.debug3 ("member2? "^ Bool.toString (test) ^ "\n")
|
||||
in
|
||||
if (member (List.last path) (List.map (#1) arg_list))
|
||||
then
|
||||
|
@ -517,46 +516,46 @@ and check_for_self arg_list typ (AttributeCall (Variable("dummy_source",_),_,pat
|
|||
end
|
||||
| check_for_self arg_list typ (OperationCall (source_term,source_typ,path,paras,ret_typ)) model =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.check_for_self complex OperationCall\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self complex OperationCall\n")
|
||||
val res = (OperationCall (check_for_self arg_list typ source_term model ,source_typ,path,check_for_self_paras arg_list typ paras model,ret_typ))
|
||||
val _ = trace function_ends ("Preprocessor.check_for_self\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| check_for_self arg_list typ (Iterator (name,iter_var,sterm,styp,expr,expr_typ,res_typ)) model =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.check_for_self: Iterator(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self: Iterator(...)\n")
|
||||
val res = (Iterator (name,iter_var,(check_for_self arg_list typ sterm model),styp,(check_for_self arg_list typ expr model),expr_typ,res_typ))
|
||||
val _ = trace function_ends ("Preprocessor.check_for_self\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| check_for_self arg_list typ (Iterate (iter_vars,acc_name,acc_type,acc_term,sterm,stype,bterm,btype,res_type)) model =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.check_for_self Iterate \n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self Iterate \n")
|
||||
val res = (Iterate (iter_vars,acc_name,acc_type,acc_term,(check_for_self arg_list typ sterm model),stype,(check_for_self arg_list typ bterm model),btype,res_type))
|
||||
val _ = trace function_ends("Preprocessor.check_for_self\n")
|
||||
val _ = Logger.debug2("Preprocessor.check_for_self\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| check_for_self arg_list typ (Let (str,ttyp,rhs_term,rhs_typ,in_term,in_typ)) model =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.check_for_self Let (...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self Let (...)\n")
|
||||
val self_rhs_term = check_for_self arg_list typ rhs_term model
|
||||
val self_in_term = check_for_self arg_list typ in_term model
|
||||
val res = (Let (str,ttyp,self_rhs_term,rhs_typ,self_in_term,in_typ))
|
||||
val _ = trace function_ends ("Preprocessor.check_for_self\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| check_for_self arg_list typ (If (cond,cond_typ,expr1,typ1,expr2,typ2,res_typ)) model =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.check_for_self If (...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self If (...)\n")
|
||||
val self_cond = check_for_self arg_list typ cond model
|
||||
val self_expr1 = check_for_self arg_list typ expr1 model
|
||||
val self_expr2 = check_for_self arg_list typ expr2 model
|
||||
val res = (If (self_cond,cond_typ,self_expr1,typ1,self_expr2,typ2,res_typ))
|
||||
val _ = trace function_ends ("Preprocessor.check_for_self\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.check_for_self\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -720,10 +719,10 @@ and prefix_OperationWithType prefix (Variable (str,typ)) = (Variable (str,typ))
|
|||
fun preprocess_context (Cond (path,op_name,op_sign,result_type,cond,pre_name,expr)) model =
|
||||
let
|
||||
(* embed 'result' variable *)
|
||||
val _ = trace function_calls ("Preprocessor.preprocess_context Cond(...)\n")
|
||||
val _ = trace preprocessor ("Embed result variable \n")
|
||||
val _ = Logger.debug2 ("Preprocessor.preprocess_context Cond(...)\n")
|
||||
val _ = Logger.debug3 ("Embed result variable \n")
|
||||
val vexpr = generate_variables expr path op_name model
|
||||
val _ = trace preprocessor ("Variable 'result' embeded ... \n")
|
||||
val _ = Logger.debug3 ("Variable 'result' embeded ... \n")
|
||||
(* embed method arguments *)
|
||||
val class = class_of_type (Classifier (path)) (model,[])
|
||||
val prfx = package_of class
|
||||
|
@ -734,35 +733,35 @@ fun preprocess_context (Cond (path,op_name,op_sign,result_type,cond,pre_name,exp
|
|||
val pexpr = embed_atPre_expressions eexpr
|
||||
val res =
|
||||
(Cond (path,op_name,prefixed_op_sign,prefixed_result_type,cond,pre_name,(check_for_self prefixed_op_sign (Classifier (path)) pexpr model)))
|
||||
val _ = trace function_ends ("Preprocessor.preprocess_context\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.preprocess_context\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| preprocess_context (Inv (path,string,term)) model =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.preprocess_context Inv (...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.preprocess_context Inv (...)\n")
|
||||
(* embed '@pre'-expressions *)
|
||||
val pexpr = embed_atPre_expressions term
|
||||
val res = (Inv (path,string,(check_for_self [] (Classifier (path)) pexpr model)))
|
||||
val _ = trace function_ends ("Preprocessor.preprocess_context\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.preprocess_context\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| preprocess_context (Attr (path,typ,aoa,expr)) model =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.preprocess_context Attr(...)\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.preprocess_context Attr(...)\n")
|
||||
(* embed '@pre'-expressions *)
|
||||
val pexpr = embed_atPre_expressions expr
|
||||
val res = (Attr (path,typ,aoa,check_for_self [] (Classifier (path)) pexpr model))
|
||||
val _ = trace function_ends ("Preprocessor.preprocess_context\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.preprocess_context\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| preprocess_context c model =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.preprocess_context: others" ^ "\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.preprocess_context: others" ^ "\n")
|
||||
val res = c
|
||||
val _ = trace function_ends ("Preprocessor.preprocess_context\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.preprocess_context\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -771,9 +770,9 @@ fun preprocess_context (Cond (path,op_name,op_sign,result_type,cond,pre_name,exp
|
|||
fun preprocess_context_list [] model = []
|
||||
| preprocess_context_list (h::context_list_tail) model =
|
||||
let
|
||||
val _ = trace function_calls ("Preprocessor.preprocess_context_list\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.preprocess_context_list\n")
|
||||
val res = (preprocess_context h model)::(preprocess_context_list context_list_tail model)
|
||||
val _ = trace function_ends ("Preprocessor.preprocess_context_list\n")
|
||||
val _ = Logger.debug2 ("Preprocessor.preprocess_context_list\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
* This file is part of su4sml.
|
||||
*
|
||||
* Copyright (c) 2005-2007 ETH Zurich, Switzerland
|
||||
* 2008 Achim D. Brucker, Germany
|
||||
* 2008-2009 Achim D. Brucker, Germany
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
|
@ -73,7 +73,6 @@ end
|
|||
structure TypeChecker:TYPECHECKER =
|
||||
struct
|
||||
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
|
@ -127,7 +126,7 @@ fun FromSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs):Rep
|
|||
then (* OperationCall *)
|
||||
let
|
||||
(* check 'fromSet' *)
|
||||
val _ = trace type_checker ("==> FromSet-desugarator: operation ... \n")
|
||||
val _ = Logger.debug3 ("==> FromSet-desugarator: operation ... \n")
|
||||
val new_type = type_of_template_parameter (type_of_term rterm)
|
||||
val iterVar = (("anonIterVar_" ^ (varcounter.nextStr())),new_type)
|
||||
val class = class_of_term (Variable (iterVar)) model
|
||||
|
@ -146,7 +145,7 @@ fun FromSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs):Rep
|
|||
else (* AttributeCall *)
|
||||
let
|
||||
(* check 'fromSet' *)
|
||||
val _ = trace type_checker ("==> FromSet-desugarator: attribute/assocend ... \n")
|
||||
val _ = Logger.debug3 ("==> FromSet-desugarator: attribute/assocend ... \n")
|
||||
val new_type = type_of_template_parameter (type_of_term rterm)
|
||||
val iterVar = (("anonIterVar_" ^ (varcounter.nextStr())),new_type)
|
||||
val class = class_of_term (Variable (iterVar)) model
|
||||
|
@ -158,7 +157,7 @@ fun FromSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs):Rep
|
|||
let
|
||||
val insert_term = upcast_att_aend attrs_or_assocs (Variable iterVar) model
|
||||
val it_type = type_of_term insert_term
|
||||
val _ = trace development ("association type " ^ string_of_OclType it_type ^ "\n")
|
||||
val _ = Logger.debug4 ("association type " ^ string_of_OclType it_type ^ "\n")
|
||||
(* special case *)
|
||||
(* if it is an attribute, there needs to be added a collection type constructor *)
|
||||
|
||||
|
@ -193,13 +192,13 @@ fun FromSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs):Rep
|
|||
fun AsSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs)) =
|
||||
let
|
||||
val _ = if isColl_Type (type_of_term rterm) then print "\n error in AsSet_Desugarotr\n" else ()
|
||||
val _ = (trace function_calls ("TypeChecker.AsSet_desugarator class= " ^ (string_of_OclType (type_of_term rterm)) ^ " , attr\n"))
|
||||
val _ = (Logger.debug2 ("TypeChecker.AsSet_desugarator class= " ^ (string_of_OclType (type_of_term rterm)) ^ " , attr\n"))
|
||||
val res = if (attr_or_meth = 0)
|
||||
then (* OperationCall *)
|
||||
let
|
||||
val _ = trace type_checker ("==> AsSet-desugarator: operation ... \n")
|
||||
val _ = Logger.debug3 ("==> AsSet-desugarator: operation ... \n")
|
||||
val rtyp = Set(type_of_term rterm)
|
||||
val _ = trace type_checker ("Type of source term " ^ string_of_OclType rtyp ^ " ---> try Set(" ^ string_of_OclType rtyp ^ ")\n")
|
||||
val _ = Logger.debug3 ("Type of source term " ^ string_of_OclType rtyp ^ " ---> try Set(" ^ string_of_OclType rtyp ^ ")\n")
|
||||
val class = class_of_term (Variable ("anonIterVar_" ^ (varcounter.nextStr()),rtyp)) model
|
||||
val ops = get_overloaded_methods class (List.last path) model
|
||||
val new_rterm = CollectionLiteral([CollectionItem(rterm,type_of_term rterm)],rtyp)
|
||||
|
@ -215,14 +214,14 @@ in
|
|||
end
|
||||
else (* AttributeCall *)
|
||||
let
|
||||
val _ = trace type_checker ("==> AsSet-desugarator: attribute/assocend\n")
|
||||
val _ = Logger.debug3 ("==> AsSet-desugarator: attribute/assocend\n")
|
||||
val rtyp = Set(type_of_term rterm)
|
||||
val _ = trace type_checker (string_of_OclType rtyp ^ "\n")
|
||||
val _ = Logger.debug3 (string_of_OclType rtyp ^ "\n")
|
||||
val class = class_of_term (Variable ("anonIterVar_" ^ (varcounter.nextStr()),Set(rtyp))) model
|
||||
val attrs = get_overloaded_attrs_or_assocends class (List.last path) model
|
||||
(* source term is a dummy-Term *)
|
||||
val new_rterm = CollectionLiteral([CollectionItem(rterm,type_of_term rterm)],rtyp)
|
||||
val _ = trace type_checker ("'AsSetError' ... \n")
|
||||
val _ = Logger.debug3 ("'AsSetError' ... \n")
|
||||
in
|
||||
if (List.length attrs = 0)
|
||||
then
|
||||
|
@ -230,7 +229,7 @@ in
|
|||
else
|
||||
upcast_att_aend attrs new_rterm model
|
||||
end
|
||||
val _ = trace function_ends ("TypeChecker.AsSet_desugarator class= " ^ (string_of_OclType (type_of_term rterm)) ^ " , attr\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.AsSet_desugarator class= " ^ (string_of_OclType (type_of_term rterm)) ^ " , attr\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -243,17 +242,17 @@ in
|
|||
(* RETURN: CollectionPart *)
|
||||
fun resolve_CollectionPart model (CollectionItem (term,typ)) =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.resolve_CollectionPart " ^ (ocl2string false term) ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_CollectionPart " ^ (ocl2string false term) ^ "\n")
|
||||
val rterm = resolve_OclTerm term model
|
||||
val rtyp = type_of_term rterm
|
||||
val res = (CollectionItem (rterm,rtyp))
|
||||
val _ = trace function_ends ("TypeChecker.resolve_CollectionPart " ^ (ocl2string false term) ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_CollectionPart " ^ (ocl2string false term) ^ "\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| resolve_CollectionPart model (CollectionRange (term1,term2,typ)) =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.resolve_CollectionPart " ^ (ocl2string false term1) ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_CollectionPart " ^ (ocl2string false term1) ^ "\n")
|
||||
val rterm1 = resolve_OclTerm term1 model
|
||||
val rtyp1 = type_of_term rterm1
|
||||
val rterm2 = resolve_OclTerm term2 model
|
||||
|
@ -263,14 +262,14 @@ fun resolve_CollectionPart model (CollectionItem (term,typ)) =
|
|||
(CollectionRange (rterm1,rterm2,rtyp1))
|
||||
else
|
||||
raise (TC_CollectionRangeError ((CollectionRange (term1,term2,typ)),("Begin and end of Range not of same type.\n")))
|
||||
val _ = trace function_ends ("TypeChecker.resolve_CollectionPart " ^ (ocl2string false term1) ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_CollectionPart " ^ (ocl2string false term1) ^ "\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
||||
and resolve_CollectionLiteral (CollectionLiteral (part_list,typ)) model =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.resolve_CollectionLiteral\n ")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_CollectionLiteral\n ")
|
||||
val rpart_list = List.map (resolve_CollectionPart model) part_list
|
||||
val tlist = List.map (type_of_CollPart) rpart_list
|
||||
val res =
|
||||
|
@ -279,7 +278,7 @@ and resolve_CollectionLiteral (CollectionLiteral (part_list,typ)) model =
|
|||
rpart_list
|
||||
else
|
||||
raise TC_wrongCollectionLiteral ((CollectionLiteral (part_list,typ)),"Not all Literals have the same type.\n")
|
||||
val _ = trace function_ends ("TypeChecker.resolve_CollectionLiteral\n ")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_CollectionLiteral\n ")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -297,17 +296,17 @@ and resolve_arguments [] model = []
|
|||
(* RETURN: OclTerm *)
|
||||
and resolve_OclTerm (Literal (s,typ)) model =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm Literal " ^ ocl2string false (Literal(s,typ)) ^ "\n")
|
||||
val _ = trace medium ("RESOLVE Literal: " ^ s ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm Literal " ^ ocl2string false (Literal(s,typ)) ^ "\n")
|
||||
val _ = Logger.debug2 ("RESOLVE Literal: " ^ s ^ "\n")
|
||||
val res = (Literal (s,typ))
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm Literal " ^ ocl2string false (Literal(s,typ)) ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm Literal " ^ ocl2string false (Literal(s,typ)) ^ "\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
(* TupleLiteral *)
|
||||
| resolve_OclTerm (Tuple(x)) model =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm TupleLiteral " ^ ocl2string false (Tuple(x)) ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm TupleLiteral " ^ ocl2string false (Tuple(x)) ^ "\n")
|
||||
val res = Tuple (List.map (fn (a,b,c) =>
|
||||
let
|
||||
val rterm = resolve_OclTerm b model
|
||||
|
@ -315,24 +314,24 @@ and resolve_OclTerm (Literal (s,typ)) model =
|
|||
in
|
||||
(a,rterm,rtype)
|
||||
end) x)
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
(* Variable *)
|
||||
| resolve_OclTerm (Variable ("self",typ)) model =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm Variable " ^ ocl2string false (Variable("self",typ)) ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm Variable " ^ ocl2string false (Variable("self",typ)) ^ "\n")
|
||||
val res = (Variable ("self",typ))
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm Variable " ^ ocl2string false (Variable("self",typ)) ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm Variable " ^ ocl2string false (Variable("self",typ)) ^ "\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| resolve_OclTerm (Variable (name,typ)) model =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm Variable " ^ ocl2string false (Variable(name,typ)) ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm Variable " ^ ocl2string false (Variable(name,typ)) ^ "\n")
|
||||
val res = Variable (name,typ)
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm Variable " ^ ocl2string false (Variable(name,typ)) ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm Variable " ^ ocl2string false (Variable(name,typ)) ^ "\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -343,20 +342,20 @@ and resolve_OclTerm (Literal (s,typ)) model =
|
|||
(* self.self -> self *)
|
||||
| resolve_OclTerm (AttributeCall (term,_,["self"],_)) model =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm, AttributeCall, self, " ^ ocl2string false term ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, AttributeCall, self, " ^ ocl2string false term ^ "\n")
|
||||
val res = (resolve_OclTerm term model)
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm, AttributeCall, self " ^ ocl2string false term ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, AttributeCall, self " ^ ocl2string false term ^ "\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| resolve_OclTerm (AttributeCall (term,_,attr_path,_)) (model as (cls,assocs)) =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm, AttributeCall, attribute name = " ^ (List.last attr_path) ^ ", " ^ ocl2string true term ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, AttributeCall, attribute name = " ^ (List.last attr_path) ^ ", " ^ ocl2string true term ^ "\n")
|
||||
(* resolve source term *)
|
||||
val rterm = resolve_OclTerm term model
|
||||
val _ = trace wgen ("res AttCall : arrow or not " ^ List.hd (attr_path) ^ "\n")
|
||||
val _ = trace wgen ("res AttCall (" ^ (List.last attr_path) ^ ") : rterm = " ^ Ocl2String.ocl2string false rterm ^ "\n")
|
||||
val _ = trace wgen ("res AttCall (" ^ (List.last attr_path) ^ ") : rtype = " ^ string_of_OclType (type_of_term rterm) ^ "\n")
|
||||
val _ = Logger.debug3 ("res AttCall : arrow or not " ^ List.hd (attr_path) ^ "\n")
|
||||
val _ = Logger.debug3 ("res AttCall (" ^ (List.last attr_path) ^ ") : rterm = " ^ Ocl2String.ocl2string false rterm ^ "\n")
|
||||
val _ = Logger.debug3 ("res AttCall (" ^ (List.last attr_path) ^ ") : rtype = " ^ string_of_OclType (type_of_term rterm) ^ "\n")
|
||||
val res =
|
||||
let
|
||||
in
|
||||
|
@ -371,16 +370,16 @@ and resolve_OclTerm (Literal (s,typ)) model =
|
|||
(
|
||||
(
|
||||
let
|
||||
val _ = trace type_checker ("==> 2-dim Inheritance check: attribute/assocend\n")
|
||||
val _ = Logger.debug3 ("==> 2-dim Inheritance check: attribute/assocend\n")
|
||||
val rtyp = type_of_term rterm
|
||||
val _ = trace type_checker (string_of_OclType rtyp ^"\n")
|
||||
val _ = Logger.debug3 (string_of_OclType rtyp ^"\n")
|
||||
val templ_type = type_of_template_parameter rtyp
|
||||
val pclass = class_of_term (Variable ("x",templ_type)) model
|
||||
val ntempl_type = type_of_parent pclass
|
||||
val new_type = substitute_templ_para rtyp ntempl_type
|
||||
val new_class = class_of_term (Variable ("x",new_type)) model
|
||||
val attrs = get_overloaded_attrs_or_assocends new_class (List.last attr_path) model
|
||||
val _ = trace type_checker ("parent type of term:" ^ string_of_OclType new_type ^ "\n")
|
||||
val _ = Logger.debug3 ("parent type of term:" ^ string_of_OclType new_type ^ "\n")
|
||||
in
|
||||
if (List.length attrs = 0)
|
||||
then raise TC_DesugaratorCall (rterm,attr_path,1,[],model)
|
||||
|
@ -392,7 +391,7 @@ and resolve_OclTerm (Literal (s,typ)) model =
|
|||
| Empty => AsSet_desugarator rterm attr_path 1 [] model
|
||||
)
|
||||
end
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm \n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm \n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -406,18 +405,18 @@ and resolve_OclTerm (Literal (s,typ)) model =
|
|||
| attributes_to_path (AttributeCall(term,_,[correct_package_part],res_typ)) =
|
||||
(correct_package_part)::(attributes_to_path term)
|
||||
(* prefix type of iterator variable *)
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm, OperationCallWithType = oclIsTypeOf, " ^ ocl2string true term ^"\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, OperationCallWithType = oclIsTypeOf, " ^ ocl2string true term ^"\n")
|
||||
val rterm = resolve_OclTerm term model
|
||||
val _ = trace type_checker ("res OpCall: oclIsTypeOf 2: " ^ "\n")
|
||||
val _ = Logger.debug3 ("res OpCall: oclIsTypeOf 2: " ^ "\n")
|
||||
val rtyp = type_of_term rterm
|
||||
val _ = trace type_checker ("res OpCall: oclIsTypeOf 3: " ^ "\n")
|
||||
val _ = Logger.debug3 ("res OpCall: oclIsTypeOf 3: " ^ "\n")
|
||||
val path = (attributes_to_path source)@[string_path]
|
||||
val _ = trace type_checker ("Path of the given type: " ^ string_of_path (path) ^ "\n")
|
||||
val _ = Logger.debug3 ("Path of the given type: " ^ string_of_path (path) ^ "\n")
|
||||
val typ = type_of_path path model
|
||||
handle GetClassifierError s => raise TC_OperationWithTypeError ("Wrong or ommited package in a OperationWithType call. Please ajust the the package of the type.\n" ^ "OclTerm is: " ^ ocl2string true opcall ^ "\n")
|
||||
val _ = trace type_checker ("res OpCall: oclTypeOf 4:" ^ "... " ^ "\n")
|
||||
val _ = Logger.debug3 ("res OpCall: oclTypeOf 4:" ^ "... " ^ "\n")
|
||||
val res = OperationWithType (rterm,rtyp,"oclIsTypeOf",typ,Boolean)
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -429,18 +428,18 @@ let
|
|||
| attributes_to_path (AttributeCall(term,_,[correct_package_part],res_typ)) =
|
||||
(correct_package_part)::(attributes_to_path term)
|
||||
(* prefix type of iterator variable *)
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm, OperationCallWithType = oclIsTypeOf, " ^ ocl2string true term ^"\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, OperationCallWithType = oclIsTypeOf, " ^ ocl2string true term ^"\n")
|
||||
val rterm = resolve_OclTerm term model
|
||||
val _ = trace type_checker ("res OpCall: oclIsTypeOf 2: " ^ "\n")
|
||||
val _ = Logger.debug3 ("res OpCall: oclIsTypeOf 2: " ^ "\n")
|
||||
val rtyp = type_of_term rterm
|
||||
val _ = trace type_checker ("res OpCall: oclIsTypeOf 3: " ^ "\n")
|
||||
val _ = Logger.debug3 ("res OpCall: oclIsTypeOf 3: " ^ "\n")
|
||||
val path = (attributes_to_path source)@[string_path]
|
||||
val _ = trace type_checker ("Path of the given type: " ^ string_of_path (path) ^ "\n")
|
||||
val _ = Logger.debug3 ("Path of the given type: " ^ string_of_path (path) ^ "\n")
|
||||
val typ = type_of_path path model
|
||||
handle GetClassifierError s => raise TC_OperationWithTypeError ("Wrong or ommited package in a OperationWithType call. Please ajust the the package of the type.\n" ^ "OclTerm is: " ^ ocl2string true opcall ^ "\n")
|
||||
val _ = trace type_checker ("res OpCall: oclTypeOf 4:" ^ "... " ^ "\n")
|
||||
val _ = Logger.debug3 ("res OpCall: oclTypeOf 4:" ^ "... " ^ "\n")
|
||||
val res = OperationWithType (rterm,rtyp,"oclIsKindOf",typ,Boolean)
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -452,43 +451,43 @@ let
|
|||
| attributes_to_path (AttributeCall(term,_,[correct_package_part],res_typ)) =
|
||||
(correct_package_part)::(attributes_to_path term)
|
||||
(* prefix type of iterator variable *)
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm, OperationCallWithType = oclIsTypeOf, " ^ ocl2string true term ^"\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, OperationCallWithType = oclIsTypeOf, " ^ ocl2string true term ^"\n")
|
||||
val rterm = resolve_OclTerm term model
|
||||
val _ = trace type_checker ("res OpCall: oclIsTypeOf 2: " ^ "\n")
|
||||
val _ = Logger.debug3 ("res OpCall: oclIsTypeOf 2: " ^ "\n")
|
||||
val rtyp = type_of_term rterm
|
||||
val _ = trace type_checker ("res OpCall: oclIsTypeOf 3: " ^ "\n")
|
||||
val _ = Logger.debug3 ("res OpCall: oclIsTypeOf 3: " ^ "\n")
|
||||
val path = (attributes_to_path source)@[string_path]
|
||||
val _ = trace type_checker ("Path of the given type: " ^ string_of_path (path) ^ "\n")
|
||||
val _ = Logger.debug3 ("Path of the given type: " ^ string_of_path (path) ^ "\n")
|
||||
val typ = type_of_path path model
|
||||
handle GetClassifierError s => raise TC_OperationWithTypeError ("Wrong or ommited package in a OperationWithType call. Please ajust the the package of the type.\n" ^ "OclTerm is: " ^ ocl2string true opcall ^ "\n")
|
||||
val _ = trace type_checker ("res OpCall: oclTypeOf 4:" ^ "... " ^ "\n")
|
||||
val _ = Logger.debug3 ("res OpCall: oclTypeOf 4:" ^ "... " ^ "\n")
|
||||
val res = OperationWithType (rterm,rtyp,"oclAsType",typ,typ)
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
(* HARD CODED STUFF *)
|
||||
| resolve_OclTerm (OperationCall (term,typ,[OclLibPackage,"OclAny","atPre"],[],_)) model =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm, OperationCall atPre, " ^ ocl2string true term ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, OperationCall atPre, " ^ ocl2string true term ^ "\n")
|
||||
(* resolve source term *)
|
||||
val rterm = resolve_OclTerm term model
|
||||
val rtyp = type_of_term rterm
|
||||
val _ = trace type_checker ("res OpCall: Type of source : " ^ string_of_OclType rtyp ^ "\n")
|
||||
val _ = Logger.debug3 ("res OpCall: Type of source : " ^ string_of_OclType rtyp ^ "\n")
|
||||
val res = OperationCall (rterm,rtyp,[OclLibPackage,"OclAny","atPre"],[],rtyp)
|
||||
val _ = trace function_ends ("TypeChecker.resovle_OclTerm\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resovle_OclTerm\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| resolve_OclTerm (OperationCall (term,typ,meth_path,args,res_typ)) (model as (cls,assocs)) =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm, OperatioCall: name = " ^ (List.last (meth_path)) ^ ", " ^ ocl2string true term ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, OperatioCall: name = " ^ (List.last (meth_path)) ^ ", " ^ ocl2string true term ^ "\n")
|
||||
(* resolve source term *)
|
||||
val rterm = resolve_OclTerm term model
|
||||
val _ = trace type_checker ("res OpCall: Type of source : " ^ string_of_OclType (type_of_term rterm) ^ "\n")
|
||||
val _ = Logger.debug3 ("res OpCall: Type of source : " ^ string_of_OclType (type_of_term rterm) ^ "\n")
|
||||
(* resolve arguments *)
|
||||
val rargs = resolve_arguments args model
|
||||
val _ = trace type_checker ("res OpCall: args resolved ...\n")
|
||||
val _ = Logger.debug3 ("res OpCall: args resolved ...\n")
|
||||
val res =
|
||||
let
|
||||
in
|
||||
|
@ -502,17 +501,17 @@ let
|
|||
(
|
||||
(
|
||||
let
|
||||
val _ = trace type_checker ("==> no 2-dim Inheritance check: attribute/assocend\n")
|
||||
val _ = Logger.debug3 ("==> no 2-dim Inheritance check: attribute/assocend\n")
|
||||
val rtyp = type_of_term rterm
|
||||
val _ = trace type_checker (string_of_OclType rtyp ^ "\n")
|
||||
val _ = Logger.debug3 (string_of_OclType rtyp ^ "\n")
|
||||
val templ_type = type_of_template_parameter rtyp
|
||||
val pclass = class_of_term (Variable ("x",templ_type)) model
|
||||
val ntempl_type = type_of_parent pclass
|
||||
val _ = trace type_checker (string_of_OclType ntempl_type ^ "\n")
|
||||
val _ = Logger.debug3 (string_of_OclType ntempl_type ^ "\n")
|
||||
val new_type = substitute_templ_para rtyp ntempl_type
|
||||
val new_class = class_of_term (Variable ("x",new_type)) model
|
||||
val ops = get_overloaded_methods new_class (List.last meth_path) model
|
||||
val _ = trace type_checker ("parent type of term: " ^ string_of_OclType new_type ^ "\n")
|
||||
val _ = Logger.debug3 ("parent type of term: " ^ string_of_OclType new_type ^ "\n")
|
||||
in
|
||||
if (List.length ops = 0)
|
||||
then raise TC_DesugaratorCall (rterm, meth_path, 0, rargs, model)
|
||||
|
@ -524,7 +523,7 @@ let
|
|||
| Empty => AsSet_desugarator rterm meth_path 0 rargs model
|
||||
)
|
||||
end
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -532,37 +531,37 @@ let
|
|||
| resolve_OclTerm (Iterator (name,iter_vars,source_term,_,expr,expr_typ,res_typ)) (model as (cls,assocs)) =
|
||||
let
|
||||
(* resolve source term, type *)
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm, Itertor: name = " ^ name ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, Itertor: name = " ^ name ^ "\n")
|
||||
val rterm = resolve_OclTerm source_term model
|
||||
val rtyp = type_of_term rterm
|
||||
val _ = trace type_checker ("res Iter (" ^ name ^ "): source type " ^ string_of_OclType (type_of_term rterm) ^ "\n\n")
|
||||
val _ = Logger.debug3 ("res Iter (" ^ name ^ "): source type " ^ string_of_OclType (type_of_term rterm) ^ "\n\n")
|
||||
(* get source classifier *)
|
||||
val source_class = class_of_term rterm model
|
||||
val _ = trace type_checker ("res Iter (" ^ name ^ "): type of classifier: " ^ string_of_OclType (type_of source_class) ^ "\n")
|
||||
val _ = Logger.debug3 ("res Iter (" ^ name ^ "): type of classifier: " ^ string_of_OclType (type_of source_class) ^ "\n")
|
||||
(* prefix types *)
|
||||
val prfx = (package_of_template_parameter (type_of source_class))
|
||||
val _ = trace type_checker ("res Iter (" ^ name ^ "): Type prefixed ... \n")
|
||||
val _ = Logger.debug3 ("res Iter (" ^ name ^ "): Type prefixed ... \n")
|
||||
val piter_vars = List.map (fn (a,b) => (a,prefix_type prfx b)) iter_vars
|
||||
val piter_types = List.map (fn (a,b) => b) piter_vars
|
||||
val _ = trace type_checker ("res Iter (" ^ name ^ "): first iter types: " ^ string_of_OclType (List.hd piter_types) ^ "\n")
|
||||
val _ = Logger.debug3 ("res Iter (" ^ name ^ "): first iter types: " ^ string_of_OclType (List.hd piter_types) ^ "\n")
|
||||
(* check if iterator types correspond to source type *)
|
||||
val static_iter_type = type_of_template_parameter (type_of (source_class))
|
||||
val _ = trace type_checker ("Length of iter_types: " ^ Int.toString (List.length piter_types) ^ "\n")
|
||||
val _ = trace type_checker ("parent of classifier: " ^ string_of_OclType (type_of_parent source_class) ^ "\n")
|
||||
val _ = trace type_checker ("static iter type : " ^ string_of_OclType static_iter_type ^ " \n")
|
||||
val _ = trace type_checker ("iter types: " ^ string_of_OclType (List.hd piter_types) ^ "\n")
|
||||
val _ = Logger.debug3 ("Length of iter_types: " ^ Int.toString (List.length piter_types) ^ "\n")
|
||||
val _ = Logger.debug3 ("parent of classifier: " ^ string_of_OclType (type_of_parent source_class) ^ "\n")
|
||||
val _ = Logger.debug3 ("static iter type : " ^ string_of_OclType static_iter_type ^ " \n")
|
||||
val _ = Logger.debug3 ("iter types: " ^ string_of_OclType (List.hd piter_types) ^ "\n")
|
||||
val h2 = List.map (fn a => conforms_to a static_iter_type model) (piter_types)
|
||||
val check = List.all (fn a => a=true) h2
|
||||
val res =
|
||||
if (check) then
|
||||
let
|
||||
val _ = trace type_checker ("res Iter: types conforms \n")
|
||||
val _ = Logger.debug3 ("res Iter: types conforms \n")
|
||||
val bound_expr = embed_bound_variables piter_vars expr
|
||||
val _ = trace type_checker ("res Iter: term : " ^ Ocl2String.ocl2string false bound_expr ^ "\n")
|
||||
val _ = Logger.debug3 ("res Iter: term : " ^ Ocl2String.ocl2string false bound_expr ^ "\n")
|
||||
val rexpr = resolve_OclTerm bound_expr model
|
||||
val _ = trace type_checker (" manuel " ^ string_of_OclType (type_of_term rexpr) ^ "\n")
|
||||
val _ = trace type_checker (" ma " ^ string_of_OclType (Set(static_iter_type)) ^ "\n")
|
||||
val _ = trace type_checker ("res Iter: Iterator name = " ^ name ^ " \n\n\n")
|
||||
val _ = Logger.debug3 (" manuel " ^ string_of_OclType (type_of_term rexpr) ^ "\n")
|
||||
val _ = Logger.debug3 (" ma " ^ string_of_OclType (Set(static_iter_type)) ^ "\n")
|
||||
val _ = Logger.debug3 ("res Iter: Iterator name = " ^ name ^ " \n\n\n")
|
||||
in
|
||||
(
|
||||
case name of
|
||||
|
@ -585,7 +584,7 @@ let
|
|||
end
|
||||
else
|
||||
raise TC_IteratorTypeMissMatch (Iterator (name,iter_vars,source_term,DummyT,expr,expr_typ,res_typ),("Iterator variable doesn't conform to choosen set \n"))
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -593,25 +592,25 @@ let
|
|||
| resolve_OclTerm (Iterate (iter_vars,acc_var_name,acc_var_type,acc_var_term,sterm,stype,bterm,btype,res_type)) (model as (cls,assocs)) =
|
||||
let
|
||||
(* resolve source term, type *)
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm, Iterate: accumulator " ^ acc_var_name ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, Iterate: accumulator " ^ acc_var_name ^ "\n")
|
||||
val rterm = resolve_OclTerm sterm model
|
||||
val rtyp = type_of_term rterm
|
||||
val _ = trace medium ("res Iterate: source type " ^ string_of_OclType (type_of_term rterm) ^ "\n\n")
|
||||
val _ = Logger.debug2 ("res Iterate: source type " ^ string_of_OclType (type_of_term rterm) ^ "\n\n")
|
||||
(* get source classifier *)
|
||||
val source_class = class_of_term rterm model
|
||||
val _ = trace medium ("res Iterate: type of classifier: " ^ string_of_OclType (type_of source_class) ^ "\n")
|
||||
val _ = Logger.debug2 ("res Iterate: type of classifier: " ^ string_of_OclType (type_of source_class) ^ "\n")
|
||||
(* prefix types *)
|
||||
val prfx = (package_of_template_parameter (type_of source_class))
|
||||
val _ = trace medium ("res Iterate: Type prefixed ... \n")
|
||||
val _ = Logger.debug2 ("res Iterate: Type prefixed ... \n")
|
||||
val piter_vars = List.map (fn (a,b) => (a,prefix_type prfx b)) iter_vars
|
||||
val piter_types = List.map (fn (a,b) => b) piter_vars
|
||||
val _ = trace medium ("res Iterate: first iter types: " ^ string_of_OclType (List.hd piter_types) ^ "\n")
|
||||
val _ = Logger.debug2 ("res Iterate: first iter types: " ^ string_of_OclType (List.hd piter_types) ^ "\n")
|
||||
(* check if iterator types correspond to source type *)
|
||||
val static_iter_type = type_of_template_parameter (type_of (source_class))
|
||||
val _ = trace medium ("Length of iter_types: " ^ Int.toString (List.length piter_types) ^ "\n")
|
||||
val _ = trace medium ("parent of classifier: " ^ string_of_OclType (type_of_parent source_class) ^ "\n")
|
||||
val _ = trace medium ("\nstatic iter type : " ^ string_of_OclType static_iter_type ^ " \n")
|
||||
val _ = trace medium ("iter types: " ^ string_of_OclType (List.hd piter_types) ^ "\n")
|
||||
val _ = Logger.debug2 ("Length of iter_types: " ^ Int.toString (List.length piter_types) ^ "\n")
|
||||
val _ = Logger.debug2 ("parent of classifier: " ^ string_of_OclType (type_of_parent source_class) ^ "\n")
|
||||
val _ = Logger.debug2 ("\nstatic iter type : " ^ string_of_OclType static_iter_type ^ " \n")
|
||||
val _ = Logger.debug2 ("iter types: " ^ string_of_OclType (List.hd piter_types) ^ "\n")
|
||||
val h2 = List.map (fn a => conforms_to a static_iter_type model) (piter_types)
|
||||
val check = List.all (fn a => a=true) h2
|
||||
(* check if initial value of accumulator has correct type *)
|
||||
|
@ -621,14 +620,14 @@ let
|
|||
if (check) then
|
||||
if (racc_var_type = acc_var_type) then
|
||||
let
|
||||
val _ = trace medium ("res Iterate: types conforms \n")
|
||||
val _ = Logger.debug2 ("res Iterate: types conforms \n")
|
||||
val bound_expr = embed_bound_variables piter_vars bterm
|
||||
val bound_expr2 = embed_bound_variables [(acc_var_name,acc_var_type)] bound_expr
|
||||
val _ = trace medium ("myres Iterate: term : " ^ Ocl2String.ocl2string false bound_expr2 ^ "\n")
|
||||
val _ = Logger.debug2 ("myres Iterate: term : " ^ Ocl2String.ocl2string false bound_expr2 ^ "\n")
|
||||
val rexpr = resolve_OclTerm bound_expr2 model
|
||||
val _ = trace medium (" manuel " ^ string_of_OclType (type_of_term rexpr) ^ "\n")
|
||||
val _ = trace medium (" ma " ^ string_of_OclType (Set(static_iter_type)) ^ "\n")
|
||||
val _ = trace medium ("res Iterate: \n\n\n")
|
||||
val _ = Logger.debug2 (" manuel " ^ string_of_OclType (type_of_term rexpr) ^ "\n")
|
||||
val _ = Logger.debug2 (" ma " ^ string_of_OclType (Set(static_iter_type)) ^ "\n")
|
||||
val _ = Logger.debug2 ("res Iterate: \n\n\n")
|
||||
in
|
||||
Iterate(piter_vars,acc_var_name,racc_var_type,racc_var_term,rterm,rtyp,rexpr,type_of_term rexpr,racc_var_type)
|
||||
end
|
||||
|
@ -636,21 +635,21 @@ let
|
|||
raise TC_IterateAccumulatorTypeError ("Type of accumulator does not conform to type of expression of accumulator")
|
||||
else
|
||||
raise TC_IterateTypeMissMatch ("Iterate variables doesn't conform to choosen set \n")
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| resolve_OclTerm (CollectionLiteral ([],typ)) model =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm CollectionLiteral\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm CollectionLiteral\n")
|
||||
val res = CollectionLiteral ([],typ)
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| resolve_OclTerm (CollectionLiteral (coll_parts,temp_typ)) model =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm CollectionLiteral\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm CollectionLiteral\n")
|
||||
val r_coll_parts = List.map (resolve_CollectionPart model) coll_parts
|
||||
val typ = type_of_CollPart (List.hd r_coll_parts)
|
||||
val res =
|
||||
|
@ -658,25 +657,25 @@ let
|
|||
(CollectionLiteral (r_coll_parts,substitute_templ_para temp_typ typ))
|
||||
else
|
||||
raise (TC_wrongCollectionLiteral ((CollectionLiteral (coll_parts,temp_typ)), ("not all Literals have type of Collection")))
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| resolve_OclTerm (Let (str,typ,rhs_term,_,in_term,_)) model =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm a Let-Expression \n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm a Let-Expression \n")
|
||||
val rrhs_term = resolve_OclTerm rhs_term model
|
||||
val rrhs_typ = type_of_term rrhs_term
|
||||
val rin_term = resolve_OclTerm in_term model
|
||||
val rin_typ = type_of_term rin_term
|
||||
val res = (Let (str,typ,rrhs_term,rrhs_typ,rin_term,rin_typ))
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm")
|
||||
in
|
||||
res
|
||||
end
|
||||
| resolve_OclTerm (If (cond_term,cond_typ,if_expr,if_typ,else_expr,else_typ,ret_typ)) model =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.resolve_OclTerm a If-Expression \n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm a If-Expression \n")
|
||||
val rterm = resolve_OclTerm cond_term model
|
||||
val rtyp = type_of_term rterm
|
||||
|
||||
|
@ -695,7 +694,7 @@ let
|
|||
raise TC_TypeCheckerResolveIfError (If (cond_term,cond_typ,if_expr,if_typ,else_expr,else_typ,ret_typ),("Types of if-expression and else-expression don't conform each other \n"))
|
||||
else
|
||||
raise TC_TypeCheckerResolveIfError (If (cond_term,cond_typ,if_expr,if_typ,else_expr,else_typ,ret_typ),("Type of condition is not Boolean. \n"))
|
||||
val _ = trace function_ends ("TypeChecker.resolve_OclTerm\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -704,14 +703,14 @@ let
|
|||
(* RETURN: context option *)
|
||||
fun check_context (Cond (path,op_name,op_sign,result_type,cond,pre_name,expr)) (model as (cls,assocs)) =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.check_context Cond(...)\n")
|
||||
val _ = trace type_checker ("pre/post/body : " ^ Ocl2String.ocl2string false expr ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.check_context Cond(...)\n")
|
||||
val _ = Logger.debug3 ("pre/post/body : " ^ Ocl2String.ocl2string false expr ^ "\n")
|
||||
val classifier = class_of_type (Classifier (path)) model
|
||||
val oper = get_operation op_name classifier model
|
||||
val check1 = (op_sign = (#arguments oper))
|
||||
val check2 = (result_type = (#result oper))
|
||||
val _ = trace type_checker ("check1 = " ^ Bool.toString check1 ^ ", check2 = " ^ Bool.toString check2 ^ "\n")
|
||||
val _ = List.map (fn (a,b) => (trace type_checker (a ^ ":" ^ (string_of_OclType b) ^ " "))) op_sign
|
||||
val _ = Logger.debug3 ("check1 = " ^ Bool.toString check1 ^ ", check2 = " ^ Bool.toString check2 ^ "\n")
|
||||
val _ = List.map (fn (a,b) => (Logger.debug3 (a ^ ":" ^ (string_of_OclType b) ^ " "))) op_sign
|
||||
val res =
|
||||
if check1 andalso check2
|
||||
then
|
||||
|
@ -720,25 +719,25 @@ fun check_context (Cond (path,op_name,op_sign,result_type,cond,pre_name,expr)) (
|
|||
(* NONE *)
|
||||
raise TC_WrongContextChecked (Cond (path,op_name,op_sign,result_type,cond,pre_name,expr))
|
||||
|
||||
val _ = trace function_ends ("TypeChecker.check_context Cond(...)\n\n\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.check_context Cond(...)\n\n\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| check_context (Attr (path,typ,attrorassoc,expr)) (model as (cls,assocs)) =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.check_context Attr(..._)\n")
|
||||
val _ = trace type_checker ("init/derive : " ^ Ocl2String.ocl2string false expr ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.check_context Attr(..._)\n")
|
||||
val _ = Logger.debug3 ("init/derive : " ^ Ocl2String.ocl2string false expr ^ "\n")
|
||||
val classifier = class_of_type (Classifier (real_path path)) model
|
||||
val _ = trace type_checker ( "classifier found ... " ^ "\n")
|
||||
val _ = Logger.debug3 ( "classifier found ... " ^ "\n")
|
||||
val attr_list = attributes_of classifier
|
||||
val _ = trace type_checker ( "attr_list found ... " ^ "\n")
|
||||
val _ = Logger.debug3 ( "attr_list found ... " ^ "\n")
|
||||
val attr = valOf (get_attribute (List.last path) attr_list)
|
||||
val _ = trace type_checker ( "attribute found ... " ^ "\n")
|
||||
val _ = Logger.debug3 ( "attribute found ... " ^ "\n")
|
||||
val res =
|
||||
if (typ = #attr_type attr)
|
||||
then
|
||||
let
|
||||
val _ = trace type_checker (" ... " ^ "\n")
|
||||
val _ = Logger.debug3 (" ... " ^ "\n")
|
||||
in
|
||||
(SOME ((Attr (path,(#attr_type attr),attrorassoc,resolve_OclTerm expr model))))
|
||||
end
|
||||
|
@ -746,16 +745,16 @@ fun check_context (Cond (path,op_name,op_sign,result_type,cond,pre_name,expr)) (
|
|||
(* NONE *)
|
||||
raise TC_WrongContextChecked (Attr (path,typ,attrorassoc,expr))
|
||||
|
||||
val _ = trace function_ends ("TypeChecker.check_context\n\n\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.check_context\n\n\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| check_context (Inv (path,name,expr)) model =
|
||||
let
|
||||
val _ = trace function_calls ("TypeChecker.check_context Inv(...)\n")
|
||||
val _ = trace type_checker ("inv : " ^ Ocl2String.ocl2string false expr ^ "\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.check_context Inv(...)\n")
|
||||
val _ = Logger.debug3 ("inv : " ^ Ocl2String.ocl2string false expr ^ "\n")
|
||||
val res = (SOME (Inv (path,name, resolve_OclTerm expr model)))
|
||||
val _ = trace function_ends ("TypeChecker.check_context\n\n\n")
|
||||
val _ = Logger.debug2 ("TypeChecker.check_context\n\n\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -769,88 +768,78 @@ fun check_context_list [] model = []
|
|||
| check_context_list (h::context_list_tail) model =
|
||||
((check_context h model
|
||||
handle TC_wrongCollectionLiteral (term,mes) =>
|
||||
let
|
||||
let
|
||||
val s1 = ("wrongCollectionLiteral:\n")
|
||||
val s2 = ("Error Message: " ^ mes ^ "\n")
|
||||
val s3 = ("In Term: " ^ Ocl2String.ocl2string false term ^ "\n")
|
||||
val _ = trace exce (s1^s2^s3)
|
||||
in
|
||||
raise TC_WrongContextChecked h
|
||||
end
|
||||
| TC_CollectionRangeError (part,mes) =>
|
||||
let
|
||||
in
|
||||
Logger.errorExn (TC_WrongContextChecked h) (s1^s2^s3)
|
||||
end
|
||||
| TC_CollectionRangeError (part,mes) =>
|
||||
let
|
||||
val s1 = ("CollectionRangeError:\n")
|
||||
val s2 = ("Error Message: " ^ mes ^ "\n")
|
||||
val _ = trace exce (s1^s2)
|
||||
in
|
||||
raise TC_WrongContextChecked h
|
||||
end
|
||||
| TC_IteratorTypeMissMatch (term,mes) =>
|
||||
let
|
||||
in
|
||||
Logger.errorExn (TC_WrongContextChecked h) (s1^s2)
|
||||
end
|
||||
| TC_IteratorTypeMissMatch (term,mes) =>
|
||||
let
|
||||
val s1 = ("IteratorTypeMissMatch:\n")
|
||||
val s2 = ("Error Message: " ^ mes ^ "\n")
|
||||
val s3 = ("In Term: " ^ Ocl2String.ocl2string false term ^ "\n")
|
||||
val _ = trace exce (s1^s2^s3)
|
||||
in
|
||||
raise TC_WrongContextChecked h
|
||||
Logger.errorExn (TC_WrongContextChecked h) (s1^s2^s3)
|
||||
end
|
||||
| TC_NoSuchIteratorNameError (term,mes) =>
|
||||
let
|
||||
val s1 = ("NoSuchIteratorNameError:\n")
|
||||
val s2 = ("Error Message: " ^ mes ^ "\n")
|
||||
val s3 = ("In Term: " ^ Ocl2String.ocl2string false term ^ "\n")
|
||||
val _ = trace exce (s1^s2^s3)
|
||||
in
|
||||
raise TC_WrongContextChecked h
|
||||
Logger.errorExn (TC_WrongContextChecked h) (s1^s2^s3)
|
||||
end
|
||||
| TC_TypeCheckerResolveIfError (term,mes) =>
|
||||
let
|
||||
val s1 = ("TypeCheckerResolveIfError:\n")
|
||||
val s2 = ("Error Message: " ^ mes ^ "\n")
|
||||
val s3 = ("In Term: " ^ Ocl2String.ocl2string false term ^ "\n")
|
||||
val _ = trace exce (s1^s2^s3)
|
||||
in
|
||||
raise TC_WrongContextChecked h
|
||||
Logger.errorExn (TC_WrongContextChecked h) (s1^s2^s3)
|
||||
end
|
||||
| TC_NotYetSupportedError mes =>
|
||||
let
|
||||
val s1 = ("TC_NotYetSupportedError:\n")
|
||||
val s2 = ("Error Message: " ^ mes ^ "\n")
|
||||
val _ = trace exce (s1^s2)
|
||||
in
|
||||
raise TC_WrongContextChecked h
|
||||
Logger.errorExn (TC_WrongContextChecked h) (s1^s2)
|
||||
end
|
||||
| TC_OperationWithTypeError mes =>
|
||||
let
|
||||
val s1 = ("TC_OperationWithType:\n")
|
||||
val s2 = ("Error Message: " ^ mes ^ "\n")
|
||||
val _ = trace exce (s1^s2)
|
||||
in
|
||||
raise TC_WrongContextChecked h
|
||||
Logger.errorExn (TC_WrongContextChecked h) (s1^s2)
|
||||
end
|
||||
| TC_NoSuchAttributeError mes =>
|
||||
let
|
||||
val s1 = ("TC_NoSuchAttributeError:\n")
|
||||
val s2 = ("Error Message: " ^ mes ^ "\n")
|
||||
val _ = trace exce (s1^s2)
|
||||
in
|
||||
raise TC_WrongContextChecked h
|
||||
Logger.errorExn (TC_WrongContextChecked h) (s1^s2)
|
||||
end
|
||||
| GetClassifierError mes =>
|
||||
let
|
||||
val s1 = ("GetClassifierError:\n")
|
||||
val s2 = ("Error Message: " ^ mes ^ "\n")
|
||||
val _ = trace exce (s1^s2)
|
||||
in
|
||||
raise TC_WrongContextChecked h
|
||||
Logger.errorExn (TC_WrongContextChecked h) (s1^s2)
|
||||
end
|
||||
| TC_NoSuchOperationError mes =>
|
||||
let
|
||||
val s1 = ("TC_NoSuchOperationError:\n")
|
||||
val s2 = ("Error Message: " ^ mes ^ "\n")
|
||||
val _ = trace exce (s1^s2)
|
||||
in
|
||||
raise TC_WrongContextChecked h
|
||||
Logger.errorExn (TC_WrongContextChecked h) (s1^s2)
|
||||
end
|
||||
)::(check_context_list context_list_tail model))
|
||||
handle TC_WrongContextChecked h =>
|
||||
|
@ -858,9 +847,8 @@ fun check_context_list [] model = []
|
|||
val s1 = ("\n\n#################################################\n")
|
||||
val s2 = ("WrongContextChecked:\n")
|
||||
val s3 = ("In Context: " ^ (cxt_list2string [h]) ^ "\n")
|
||||
val _ = trace exce (s1^s2^s3)
|
||||
in
|
||||
raise TC_RootError ("Something went wrong!\n")
|
||||
Logger.errorExn (TC_RootError "Something went wrong!\n") (s1^s2^s3)
|
||||
end
|
||||
end
|
||||
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
* This file is part of su4sml.
|
||||
*
|
||||
* Copyright (c) 2005-2007 ETH Zurich, Switzerland
|
||||
* 2008 Achim D. Brucker, Germany
|
||||
* 2008-2009 Achim D. Brucker, Germany
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
|
@ -865,7 +865,6 @@ end
|
|||
structure Rep_Core : REP_CORE =
|
||||
struct
|
||||
open Rep_Helper
|
||||
open Rep_Logger
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
open XMI_DataTypes
|
||||
|
@ -1075,9 +1074,9 @@ fun local_operations_of (Class{operations,...}) = operations
|
|||
fun local_attributes_of (Class{attributes,...}) = attributes
|
||||
| local_attributes_of (AssociationClass{attributes,...}) = attributes
|
||||
| local_attributes_of (Interface{...}) =
|
||||
error "in Rep.local_attributes_of: argument is Interface"
|
||||
Logger.error "in Rep.local_attributes_of: argument is Interface"
|
||||
| local_attributes_of (Enumeration{...}) =
|
||||
error "in Rep.local_attributes_of: argument is Enumeration"
|
||||
Logger.error "in Rep.local_attributes_of: argument is Enumeration"
|
||||
| local_attributes_of (Primitive{...}) = []
|
||||
| local_attributes_of (Template{parameter,classifier}) = raise AttributeNotFoundError ("..._attributes_of a template not possible.\n")
|
||||
|
||||
|
@ -1087,7 +1086,7 @@ fun attributes_of class = local_attributes_of class
|
|||
|
||||
fun class_of_design_model path (model as (clist,alist)) =
|
||||
let
|
||||
val _ = trace rep_core ("path of class = " ^ (String.concat (path)) ^ "\n")
|
||||
val _ = Logger.debug3 ("path of class = " ^ (String.concat (path)) ^ "\n")
|
||||
in
|
||||
if (List.hd (path) = "holOclLib")
|
||||
then raise HOLOCL_ClassifierError ("You try to access an HOLOCL Classifier "^(string_of_path path) ^" which is not part of the model.\n")
|
||||
|
@ -1099,14 +1098,14 @@ fun class_of_design_model path (model as (clist,alist)) =
|
|||
|
||||
fun type_of_parent (Class {parent,...}) =
|
||||
let
|
||||
val _ = trace development ("type_of_parent : Class{parent,...} \n")
|
||||
val _ = Logger.debug4 ("type_of_parent : Class{parent,...} \n")
|
||||
in
|
||||
Option.valOf(parent)
|
||||
handle Option.Option => OclAny
|
||||
end
|
||||
| type_of_parent (AssociationClass {parent,...}) =
|
||||
let
|
||||
val _ = trace development ("type_of_parent : AssociationClass{parent,...} \n")
|
||||
val _ = Logger.debug4 ("type_of_parent : AssociationClass{parent,...} \n")
|
||||
in
|
||||
Option.valOf(parent)
|
||||
handle Option.Option => OclAny
|
||||
|
@ -1200,7 +1199,7 @@ fun type_of_path ["Integer"] (model:transform_model) = Integer
|
|||
fun class_of_term source (c:Classifier list, a:association list) =
|
||||
let
|
||||
val typ = type_of_term (source)
|
||||
val _ = trace rep_core ("type_of_term term = " ^ (string_of_OclType typ) ^ "\n")
|
||||
val _ = Logger.debug3 ("type_of_term term = " ^ (string_of_OclType typ) ^ "\n")
|
||||
fun class_of_t typ m =
|
||||
hd (List.filter (fn a => if ((type_of a) = typ) then true else false) m)
|
||||
fun substitute_classifier typ classifier =
|
||||
|
@ -1208,7 +1207,7 @@ fun class_of_term source (c:Classifier list, a:association list) =
|
|||
fun substitute_args typ [] = []
|
||||
| substitute_args typ ((s,t)::tail) =
|
||||
let
|
||||
val _ = trace low ("substitute argument : " ^ (string_of_OclType typ)
|
||||
val _ = Logger.debug4 ("substitute argument : " ^ (string_of_OclType typ)
|
||||
^" template parameter of " ^ (string_of_OclType t) ^ " \n")
|
||||
in
|
||||
(s,substitute_typ typ t)::(substitute_args typ tail)
|
||||
|
@ -1224,10 +1223,9 @@ fun class_of_term source (c:Classifier list, a:association list) =
|
|||
and substitute_operations typ [] = []
|
||||
| substitute_operations typ ((oper:operation)::tail) =
|
||||
let
|
||||
val _ = trace low ("substitute operation : " ^ (#name oper) ^ " ... \n")
|
||||
val _ = Logger.debug4 ("substitute operation : " ^ (#name oper) ^ " ... \n")
|
||||
val args = substitute_args typ (#arguments oper)
|
||||
val res = substitute_typ typ (#result oper)
|
||||
val _ = trace 100 ("check\n")
|
||||
in
|
||||
({
|
||||
name = #name oper,
|
||||
|
@ -1244,7 +1242,7 @@ fun class_of_term source (c:Classifier list, a:association list) =
|
|||
end
|
||||
and substitute_typ typ templ_type =
|
||||
let
|
||||
val _ = trace low ("substitute type : " ^ (string_of_OclType typ) ^ " instead of " ^ (string_of_OclType templ_type) ^ " \n")
|
||||
val _ = Logger.debug4 ("substitute type : " ^ (string_of_OclType typ) ^ " instead of " ^ (string_of_OclType templ_type) ^ " \n")
|
||||
in
|
||||
case templ_type of
|
||||
(* innerst type *)
|
||||
|
@ -1273,15 +1271,15 @@ fun class_of_term source (c:Classifier list, a:association list) =
|
|||
(* else error *)
|
||||
| _ => raise TemplateInstantiationError ("Template type not of type: Sequence, Set, OrderedSet, Collection or Bag")
|
||||
end
|
||||
val _ = trace rep_core ("substitute classifier: parameter type: " ^ string_of_OclType typ ^ " template type: " ^ string_of_OclType (type_of classifier) ^ "\n")
|
||||
val _ = Logger.debug3 ("substitute classifier: parameter type: " ^ string_of_OclType typ ^ " template type: " ^ string_of_OclType (type_of classifier) ^ "\n")
|
||||
(* val typ = parameter type *)
|
||||
val styp = substitute_typ typ (type_of classifier)
|
||||
val _ = trace rep_core ("substitute_classifier: end substitute_type \n")
|
||||
val _ = Logger.debug3 ("substitute_classifier: end substitute_type \n")
|
||||
val ops = substitute_operations typ (local_operations_of classifier)
|
||||
val _ = trace 100 ("substitute parent.\n")
|
||||
val _ = Logger.debug4 ("substitute parent.\n")
|
||||
|
||||
val sparent = substitute_parent (type_of classifier) typ
|
||||
val _ = trace 100 ("end substitute parent.\n")
|
||||
val _ = Logger.debug4 ("end substitute parent.\n")
|
||||
in
|
||||
(Class
|
||||
{
|
||||
|
@ -1310,7 +1308,7 @@ fun class_of_term source (c:Classifier list, a:association list) =
|
|||
fun templ_of temp_typ para_typ [] = raise TemplateInstantiationError ("Error during instantiating a template" ^ "\n")
|
||||
| templ_of temp_typ para_typ (Template{parameter,classifier}::tail) =
|
||||
let
|
||||
val _ = trace low ("Instantiate Template for classifier: " ^ (string_of_OclType (type_of classifier)) ^ "\n")
|
||||
val _ = Logger.debug4 ("Instantiate Template for classifier: " ^ (string_of_OclType (type_of classifier)) ^ "\n")
|
||||
in
|
||||
if ((type_of classifier) = temp_typ) then
|
||||
substitute_classifier para_typ classifier
|
||||
|
@ -1319,11 +1317,11 @@ fun class_of_term source (c:Classifier list, a:association list) =
|
|||
end
|
||||
| templ_of temp_typ para_typ (h::tail) =
|
||||
let
|
||||
val _ = trace development ("shit")
|
||||
val _ = Logger.debug4 ("shit")
|
||||
in
|
||||
templ_of temp_typ para_typ tail
|
||||
end
|
||||
val _ = trace rep_core ("Now dispatch type ...\n")
|
||||
val _ = Logger.debug3 ("Now dispatch type ...\n")
|
||||
in
|
||||
case typ of
|
||||
(* Primitive types of lib *)
|
||||
|
@ -1341,29 +1339,29 @@ fun class_of_term source (c:Classifier list, a:association list) =
|
|||
| OclVoid => class_of_t OclVoid c
|
||||
| OclAny =>
|
||||
let
|
||||
val _ = trace rep_core ("type is OclAny")
|
||||
val _ = Logger.debug3 ("type is OclAny")
|
||||
in
|
||||
class_of_t OclAny c
|
||||
end
|
||||
(* Model types *)
|
||||
| Classifier (path) =>
|
||||
let
|
||||
val _ = trace development ("class_of_term: Classifier ("^(string_of_path path)^")\n")
|
||||
val _ = Logger.debug4 ("class_of_term: Classifier ("^(string_of_path path)^")\n")
|
||||
val res = class_of_t (Classifier (path)) c
|
||||
val _ = trace development ("found: "^(string_of_path (name_of res)) ^"\n")
|
||||
val _ = Logger.debug4 ("found: "^(string_of_path (name_of res)) ^"\n")
|
||||
in
|
||||
(*class_of_t (Classifier (path)) model*)
|
||||
res
|
||||
end
|
||||
| DummyT =>
|
||||
let
|
||||
val _ = trace development ("GetClassifierError: DummyT \n")
|
||||
val _ = Logger.debug4 ("GetClassifierError: DummyT \n")
|
||||
in
|
||||
raise GetClassifierError ("No classifier of type: 'DummyT' \n")
|
||||
end
|
||||
| TemplateParameter (string) =>
|
||||
let
|
||||
val _ = trace development ("GetClassifierError: TemplateParameter ("^ string ^") \n")
|
||||
val _ = Logger.debug4 ("GetClassifierError: TemplateParameter ("^ string ^") \n")
|
||||
in
|
||||
raise GetClassifierError ("No classifier of type: 'TemplateParameter (string)' \n")
|
||||
end
|
||||
|
@ -1371,14 +1369,14 @@ fun class_of_term source (c:Classifier list, a:association list) =
|
|||
|
||||
fun class_of (name:Path) (model as (clist,alist)) =
|
||||
let
|
||||
val _ = trace rep_core ("top level package: " ^ (List.hd (name)) ^ "\n")
|
||||
val _ = trace rep_core ("remaining package: " ^ (String.concat (List.tl name)) ^ "\n")
|
||||
val _ = Logger.debug3 ("top level package: " ^ (List.hd (name)) ^ "\n")
|
||||
val _ = Logger.debug3 ("remaining package: " ^ (String.concat (List.tl name)) ^ "\n")
|
||||
in
|
||||
class_of_term (Variable("x",type_of_path name model)) model
|
||||
handle TemplateInstantiationError s =>
|
||||
let
|
||||
val _ = trace rep_core ("The path of the template parameter is not in the desing model.\n")
|
||||
val _ = trace rep_core ("Path = " ^ s ^ "\n")
|
||||
val _ = Logger.debug3 ("The path of the template parameter is not in the desing model.\n")
|
||||
val _ = Logger.debug3 ("Path = " ^ s ^ "\n")
|
||||
in
|
||||
raise TemplateError ("shit\n")
|
||||
end
|
||||
|
@ -1386,9 +1384,9 @@ fun class_of (name:Path) (model as (clist,alist)) =
|
|||
|
||||
fun class_of_type (typ:OclType) (model:transform_model) =
|
||||
let
|
||||
val _ = trace rep_core ("Rep_Core.class_of_type\n")
|
||||
val _ = Logger.debug3 ("Rep_Core.class_of_type\n")
|
||||
val res = class_of_term (Variable ("x",typ)) model
|
||||
val _ = trace rep_core ("Rep_Core.class_of_type\n")
|
||||
val _ = Logger.debug3 ("Rep_Core.class_of_type\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -1432,7 +1430,7 @@ fun type_equals Integer (Classifier ([OclLibPackage,"Real"])) = true
|
|||
fun conforms_to_up _ OclAny (_:transform_model) = true
|
||||
| conforms_to_up (Set(T1)) (Collection(T2)) model =
|
||||
let
|
||||
val _ = trace low ("conforms_to_up: set -> collection \n")
|
||||
val _ = Logger.debug4 ("conforms_to_up: set -> collection \n")
|
||||
in
|
||||
if (conforms_to T1 T2 model) then
|
||||
true
|
||||
|
@ -1441,7 +1439,7 @@ fun conforms_to_up _ OclAny (_:transform_model) = true
|
|||
end
|
||||
| conforms_to_up (Bag(T1)) (Collection(T2)) model =
|
||||
let
|
||||
val _ = trace low ("conforms_to_up: bag -> collection \n")
|
||||
val _ = Logger.debug4 ("conforms_to_up: bag -> collection \n")
|
||||
in
|
||||
if (conforms_to T1 T2 model) then
|
||||
true
|
||||
|
@ -1450,7 +1448,7 @@ fun conforms_to_up _ OclAny (_:transform_model) = true
|
|||
end
|
||||
| conforms_to_up (Sequence(T1)) (Collection(T2)) model =
|
||||
let
|
||||
val _ = trace low ("conforms_to_up: sequence -> collection \n")
|
||||
val _ = Logger.debug4 ("conforms_to_up: sequence -> collection \n")
|
||||
in
|
||||
if (conforms_to T1 T2 model) then
|
||||
true
|
||||
|
@ -1459,7 +1457,7 @@ fun conforms_to_up _ OclAny (_:transform_model) = true
|
|||
end
|
||||
| conforms_to_up (OrderedSet(T1)) (Collection(T2)) model =
|
||||
let
|
||||
val _ = trace low ("conforms_to_up: orderedset -> collection \n")
|
||||
val _ = Logger.debug4 ("conforms_to_up: orderedset -> collection \n")
|
||||
in
|
||||
if (conforms_to T1 T2 model) then
|
||||
true
|
||||
|
@ -1470,7 +1468,7 @@ fun conforms_to_up _ OclAny (_:transform_model) = true
|
|||
let
|
||||
val class = class_of_type typ1 model
|
||||
val parents_types = type_of_parents (class) model
|
||||
val _ = trace low ("conforms_to_up: ... \n")
|
||||
val _ = Logger.debug4 ("conforms_to_up: ... \n")
|
||||
in
|
||||
member (typ2) (parents_types)
|
||||
end
|
||||
|
@ -1479,7 +1477,7 @@ and
|
|||
(* RETRUN: Boolean *)
|
||||
conforms_to x y (model:transform_model) =
|
||||
let
|
||||
val _ = trace low ("conforms_to: " ^ string_of_OclType x ^ " -> " ^ string_of_OclType y ^ " ? \n")
|
||||
val _ = Logger.debug4 ("conforms_to: " ^ string_of_OclType x ^ " -> " ^ string_of_OclType y ^ " ? \n")
|
||||
in
|
||||
if (x = y) then
|
||||
true
|
||||
|
@ -1505,9 +1503,9 @@ fun parent_name_of (C as Class{parent,...}) =
|
|||
(case parent of NONE => name_of OclAnyAC
|
||||
| SOME p => path_of_OclType p )
|
||||
| parent_name_of (Interface{...}) =
|
||||
error "in Rep.parent_name_of: unsupported argument type Interface"
|
||||
Logger.error "in Rep.parent_name_of: unsupported argument type Interface"
|
||||
| parent_name_of (E as Enumeration{parent,...}) =
|
||||
(case parent of NONE => error ("in Rep.parent_name_of: Enumeration "^
|
||||
(case parent of NONE => Logger.error ("in Rep.parent_name_of: Enumeration "^
|
||||
((string_of_path o name_of) E)
|
||||
^" has no parent")
|
||||
| SOME p => path_of_OclType p )
|
||||
|
@ -1516,7 +1514,7 @@ fun parent_name_of (C as Class{parent,...}) =
|
|||
(* error ("Primitive "^((string_of_path o name_of) D)^" has no parent") *)
|
||||
| SOME p => path_of_OclType p )
|
||||
| parent_name_of (Template _) =
|
||||
error "in Rep.parent_name_of: unsupported argument type Template"
|
||||
Logger.error "in Rep.parent_name_of: unsupported argument type Template"
|
||||
|
||||
fun sig_conforms_to [] [] model = true
|
||||
| sig_conforms_to [] list model =
|
||||
|
@ -1645,7 +1643,7 @@ fun isValueType Integer = true
|
|||
| isValueType (Classifier s) = false
|
||||
| isValueType DummyT = false
|
||||
| isValueType OclVoid = false
|
||||
| isValueType t = error ("Error in isValueType(_,"^(string_of_OclType t)^")")
|
||||
| isValueType t = Logger.error ("Error in isValueType(_,"^(string_of_OclType t)^")")
|
||||
|
||||
|
||||
|
||||
|
@ -1695,7 +1693,7 @@ fun parent_of_template (cl as Class{parent,...}:Classifier) (model:transform_mod
|
|||
fun parents_of_help (C:Classifier) (model:transform_model) =
|
||||
let
|
||||
val this_type = type_of C
|
||||
val _ = trace rep_core ("type of C = " ^ (string_of_OclType this_type) ^ "\n")
|
||||
val _ = Logger.debug3 ("type of C = " ^ (string_of_OclType this_type) ^ "\n")
|
||||
in
|
||||
case this_type of
|
||||
OclAny => []
|
||||
|
@ -1765,9 +1763,9 @@ fun parents_of_help (C:Classifier) (model:transform_model) =
|
|||
end
|
||||
| some_type =>
|
||||
let
|
||||
val _ = trace rep_core ("parent_of_template \n")
|
||||
val _ = Logger.debug3 ("parent_of_template \n")
|
||||
val parent = parent_of_template C model
|
||||
val _ = trace rep_core ("parent_of_template end, classifier = "
|
||||
val _ = Logger.debug3 ("parent_of_template end, classifier = "
|
||||
^ (String.concat (name_of parent)) ^ "\n")
|
||||
in
|
||||
[parent]@(parents_of_help parent model)
|
||||
|
@ -1780,7 +1778,7 @@ fun parent_of (C:Classifier) model = parent_of_template C model
|
|||
|
||||
fun parents_of (C:Classifier) model =
|
||||
let
|
||||
val _ = trace rep_core ("parents_of ... \n")
|
||||
val _ = Logger.debug3 ("parents_of ... \n")
|
||||
val helper = (parents_of_help C model)
|
||||
in
|
||||
(if (helper = [])
|
||||
|
@ -1832,50 +1830,50 @@ fun incomingAendsOfAssociation name allAssociations associationPath =
|
|||
|
||||
fun local_associationends_of (all_associations:association list) (Class{name,associations,...}):associationend list =
|
||||
let
|
||||
val _ = trace rep_core ("local_associationends_of 1 ... \n")
|
||||
val _ = trace rep_core ("classifier = " ^ (string_of_OclType name) ^ "\n")
|
||||
val _ = Logger.debug3 ("local_associationends_of 1 ... \n")
|
||||
val _ = Logger.debug3 ("classifier = " ^ (string_of_OclType name) ^ "\n")
|
||||
val oppAends = List.concat (List.map (fn a =>
|
||||
let
|
||||
val _ = trace rep_core ("Association path = ")
|
||||
val _ = trace rep_core (string_of_path a ^ "\n")
|
||||
val _ = Logger.debug3 ("Association path = ")
|
||||
val _ = Logger.debug3 (string_of_path a ^ "\n")
|
||||
in
|
||||
(oppositeAendsOfAssociation name all_associations a)
|
||||
end
|
||||
) associations)
|
||||
val _ = trace rep_core ("local_associationends_of 2 ... \n")
|
||||
val _ = Logger.debug3 ("local_associationends_of 2 ... \n")
|
||||
val selfAends = map (incomingAendsOfAssociation name all_associations) associations
|
||||
val _ = trace rep_core ("local_associationends_of 3 ... \n")
|
||||
val _ = Logger.debug3 ("local_associationends_of 3 ... \n")
|
||||
val filteredSelfAends = List.concat (List.filter (fn x => length x >= 2) selfAends)
|
||||
val _ = trace rep_core ("local_associationends_of 4 ... \n")
|
||||
val _ = Logger.debug3 ("local_associationends_of 4 ... \n")
|
||||
in
|
||||
oppAends@filteredSelfAends
|
||||
end
|
||||
| local_associationends_of all_associations (AssociationClass{name,associations,association,...}) =
|
||||
(* association only contains endpoints to the other, pure classes *)
|
||||
let
|
||||
val _ = trace rep_core ("local_associationends_of 1 AssoCl ... \n")
|
||||
val _ = Logger.debug3 ("local_associationends_of 1 AssoCl ... \n")
|
||||
val assocs = if List.exists (fn x => x = association ) associations
|
||||
then associations
|
||||
else association::associations
|
||||
val _ = trace rep_core ("local_associationends_of 2 AssoCl ... \n")
|
||||
val _ = Logger.debug3 ("local_associationends_of 2 AssoCl ... \n")
|
||||
val oppAends = List.concat (map (oppositeAendsOfAssociation name all_associations) assocs)
|
||||
val _ = trace rep_core ("local_associationends_of 3 AssoCl ... \n")
|
||||
val _ = Logger.debug3 ("local_associationends_of 3 AssoCl ... \n")
|
||||
val selfAends = map (incomingAendsOfAssociation name all_associations) associations
|
||||
val _ = trace rep_core ("local_associationends_of 4 AssoCl ... \n")
|
||||
val _ = Logger.debug3 ("local_associationends_of 4 AssoCl ... \n")
|
||||
val filteredSelfAends = List.concat (List.filter (fn x => length x >= 2) selfAends)
|
||||
val _ = trace rep_core ("local_associationends_of 5 AssoCl ... \n")
|
||||
val _ = Logger.debug3 ("local_associationends_of 5 AssoCl ... \n")
|
||||
in
|
||||
oppAends@filteredSelfAends
|
||||
end
|
||||
| local_associationends_of all_associations (Primitive{name,associations,...}) = []
|
||||
(* let
|
||||
val _ = trace rep_core ("local_associationends_of 1 Primi... \n")
|
||||
val _ = Logger.debug3 ("local_associationends_of 1 Primi... \n")
|
||||
val oppAends = List.concat (map (oppositeAendsOfAssociation name all_associations) associations)
|
||||
val _ = trace rep_core ("local_associationends_of 2 primi ... \n")
|
||||
val _ = Logger.debug3 ("local_associationends_of 2 primi ... \n")
|
||||
val selfAends = map (incomingAendsOfAssociation name all_associations) associations
|
||||
val _ = trace rep_core ("local_associationends_of 3 primi ... \n")
|
||||
val _ = Logger.debug3 ("local_associationends_of 3 primi ... \n")
|
||||
val filteredSelfAends = List.concat (List.filter (fn x => length x >= 2) selfAends)
|
||||
val _ = trace rep_core ("local_associationends_of 4 primi ... \n")
|
||||
val _ = Logger.debug3 ("local_associationends_of 4 primi ... \n")
|
||||
in
|
||||
oppAends@filteredSelfAends
|
||||
end *)
|
||||
|
@ -1886,22 +1884,22 @@ fun associationends_of assocs classes = local_associationends_of assocs classes
|
|||
(* get all inherited operations of a classifier, without the local operations *)
|
||||
fun inherited_operations_of class (model as (clist,alist)) =
|
||||
let
|
||||
val _ = trace rep_core ("inh ops 0\n")
|
||||
val _ = Logger.debug3 ("inh ops 0\n")
|
||||
val c_parents = parents_of class model
|
||||
val _ = trace rep_core ("inh ops: parents = " ^ (String.concat (List.map (fn a => (string_of_path (name_of a))) c_parents)) ^ " \n")
|
||||
val _ = Logger.debug3 ("inh ops: parents = " ^ (String.concat (List.map (fn a => (string_of_path (name_of a))) c_parents)) ^ " \n")
|
||||
val ops_of_par = (List.map (operations_of) c_parents)
|
||||
val _ = trace rep_core ("inh ops 2\n")
|
||||
val _ = Logger.debug3 ("inh ops 2\n")
|
||||
in
|
||||
List.foldr (fn (a,b) => embed_local_operations a b model) (List.last (ops_of_par)) ops_of_par
|
||||
end
|
||||
|
||||
fun inherited_attributes_of class (model as (clist,alist)) =
|
||||
let
|
||||
val _ = trace rep_core ("inh att 0\n")
|
||||
val _ = Logger.debug3 ("inh att 0\n")
|
||||
val c_parents = parents_of class model
|
||||
val _ = trace rep_core ("inh att 0\n")
|
||||
val _ = Logger.debug3 ("inh att 0\n")
|
||||
val atts_of_par = (List.map (attributes_of) c_parents)
|
||||
val _ = trace rep_core ("inh att 0\n")
|
||||
val _ = Logger.debug3 ("inh att 0\n")
|
||||
in
|
||||
if (List.length(atts_of_par) = 0)
|
||||
then []
|
||||
|
@ -1910,12 +1908,12 @@ fun inherited_attributes_of class (model as (clist,alist)) =
|
|||
|
||||
fun inherited_associationends_of class (model as (clist,alist)) =
|
||||
let
|
||||
val _ = trace rep_core ("inh assoEnd 0\n")
|
||||
val _ = Logger.debug3 ("inh assoEnd 0\n")
|
||||
val c_parents = parents_of class model
|
||||
val _ = trace rep_core ("inh assoEnd 1: parents = " ^ (String.concat (List.map (fn a => string_of_path (name_of a)) (c_parents))) ^ "\n")
|
||||
val _ = Logger.debug3 ("inh assoEnd 1: parents = " ^ (String.concat (List.map (fn a => string_of_path (name_of a)) (c_parents))) ^ "\n")
|
||||
val assE_of_par = (List.map (associationends_of alist) c_parents)
|
||||
val _ = trace rep_core ("inh assoEnd 2\n")
|
||||
val _ = trace rep_core ("inh assoEnd 3: assocEnds of parents: " ^ (String.concat (List.map (fn a => (name_of_aend a)) (List.concat assE_of_par))) ^ "\n")
|
||||
val _ = Logger.debug3 ("inh assoEnd 2\n")
|
||||
val _ = Logger.debug3 ("inh assoEnd 3: assocEnds of parents: " ^ (String.concat (List.map (fn a => (name_of_aend a)) (List.concat assE_of_par))) ^ "\n")
|
||||
in
|
||||
if (List.length(assE_of_par) = 0)
|
||||
then []
|
||||
|
@ -1926,9 +1924,9 @@ fun inherited_associationends_of class (model as (clist,alist)) =
|
|||
fun all_operations_of class model =
|
||||
let
|
||||
val lo = local_operations_of class
|
||||
val _ = trace rep_core ("all ops of classifier : "^ (string_of_path (name_of class)) ^ "\n")
|
||||
val _ = Logger.debug3 ("all ops of classifier : "^ (string_of_path (name_of class)) ^ "\n")
|
||||
val io = inherited_operations_of class model
|
||||
val _ = trace rep_core ("all ops 2\n")
|
||||
val _ = Logger.debug3 ("all ops 2\n")
|
||||
in
|
||||
embed_local_operations lo io model
|
||||
end
|
||||
|
@ -1936,9 +1934,9 @@ fun all_operations_of class model =
|
|||
fun all_attributes_of class model =
|
||||
let
|
||||
val la = local_attributes_of class
|
||||
val _ = trace rep_core ("all atts of classifier : "^ (string_of_path (name_of class)) ^ "\n")
|
||||
val _ = Logger.debug3 ("all atts of classifier : "^ (string_of_path (name_of class)) ^ "\n")
|
||||
val ia = inherited_attributes_of class model
|
||||
val _ = trace rep_core ("all atts 2\n")
|
||||
val _ = Logger.debug3 ("all atts 2\n")
|
||||
in
|
||||
embed_local_attributes la ia model
|
||||
end
|
||||
|
@ -1946,11 +1944,11 @@ fun all_attributes_of class model =
|
|||
fun all_associationends_of class (model as (clist,alist)) =
|
||||
let
|
||||
val la = local_associationends_of alist class
|
||||
val _ = trace rep_core ("all assocEnds of classifier : " ^ (String.concat (name_of class)) ^ "\n")
|
||||
val _ = trace rep_core ("name of loacal assends: " ^ (String.concat (List.map (fn a => (name_of_aend a)) la)) ^ "\n")
|
||||
val _ = Logger.debug3 ("all assocEnds of classifier : " ^ (String.concat (name_of class)) ^ "\n")
|
||||
val _ = Logger.debug3 ("name of loacal assends: " ^ (String.concat (List.map (fn a => (name_of_aend a)) la)) ^ "\n")
|
||||
val ia = inherited_associationends_of class model
|
||||
val _ = trace rep_core ("name of inherited assends: " ^ (String.concat (List.map (fn a => (name_of_aend a)) ia)) ^ "\n")
|
||||
val _ = trace rep_core ("all assocEnds \n")
|
||||
val _ = Logger.debug3 ("name of inherited assends: " ^ (String.concat (List.map (fn a => (name_of_aend a)) ia)) ^ "\n")
|
||||
val _ = Logger.debug3 ("all assocEnds \n")
|
||||
in
|
||||
embed_local_assocEnds la ia model
|
||||
end
|
||||
|
@ -2258,12 +2256,12 @@ fun normalize (all_associations:association list)
|
|||
invariant,stereotypes,interfaces,thyname,
|
||||
visibility,activity_graphs})):Classifier =
|
||||
let
|
||||
val _ = trace function_calls ("Rep_Core:normalize: class\n")
|
||||
val _ = trace function_arguments
|
||||
val _ = Logger.debug2 ("Rep_Core:normalize: class\n")
|
||||
val _ = Logger.debug2
|
||||
("number of associations: "^(Int.toString(List.length
|
||||
associations)
|
||||
)^"\n")
|
||||
val _ = map (trace function_arguments o (fn x =>
|
||||
val _ = map (Logger.debug2 o (fn x =>
|
||||
"association path: "^x^"\n")
|
||||
o string_of_path) associations
|
||||
fun mapPath (aend1,aend2) = (aend1,path_of_aend aend2)
|
||||
|
@ -2271,7 +2269,7 @@ fun normalize (all_associations:association list)
|
|||
(* val aendPathPairs = map mapPath (bidirectionalPairs name all_associations
|
||||
associations)*)
|
||||
val aendPathPairs = bidirectionalPairs name all_associations associations
|
||||
val _ = trace function_ends ("Rep_Core: end normalize \n")
|
||||
val _ = Logger.debug2 ("Rep_Core: end normalize \n")
|
||||
in
|
||||
Class {name = name,
|
||||
parent = parent,
|
||||
|
@ -2298,8 +2296,8 @@ fun normalize (all_associations:association list)
|
|||
thyname,visibility, activity_graphs})) =
|
||||
(* FIXME: how to handle AssociationClass.association? *)
|
||||
let
|
||||
val _ = trace function_calls ("Rep_Core.normalize AssociationClass\n")
|
||||
val _ = trace function_arguments
|
||||
val _ = Logger.debug2 ("Rep_Core.normalize AssociationClass\n")
|
||||
val _ = Logger.debug2
|
||||
("number of associations: "^
|
||||
(Int.toString (List.length associations ))^"\n")
|
||||
fun mapPath (aend1,aend2) = (aend1,path_of_aend aend2)
|
||||
|
@ -2326,7 +2324,7 @@ fun normalize (all_associations:association list)
|
|||
associations = [],
|
||||
visibility=visibility,
|
||||
association = [] (* FIXME? *)}
|
||||
val _ = trace function_ends ("Rep_Core.normalize")
|
||||
val _ = Logger.debug2 ("Rep_Core.normalize")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -2532,7 +2530,7 @@ fun update_thyname tname (Class{name,parent,attributes,operations,invariant,
|
|||
interfaces=interfaces,
|
||||
thyname=(SOME tname)}
|
||||
| update_thyname _ (Template T) =
|
||||
error ("in update_thyname: Template does not have a theory")
|
||||
Logger.error ("in update_thyname: Template does not have a theory")
|
||||
|
||||
fun update_invariant invariant' (Class{name,parent,attributes,operations,
|
||||
invariant,stereotypes,interfaces,
|
||||
|
@ -2596,7 +2594,7 @@ fun update_invariant invariant' (Class{name,parent,attributes,operations,
|
|||
interfaces=interfaces,
|
||||
thyname=thyname}
|
||||
| update_invariant _ (Template T) =
|
||||
error ("in update_invariant: Template does not have an invariant")
|
||||
Logger.error ("in update_invariant: Template does not have an invariant")
|
||||
|
||||
|
||||
fun update_operations operations' (Class{name,parent,attributes,invariant,
|
||||
|
@ -2663,7 +2661,7 @@ fun update_operations operations' (Class{name,parent,attributes,invariant,
|
|||
interfaces=interfaces,
|
||||
thyname=thyname}
|
||||
| update_operations _ (Template T) =
|
||||
error ("in update_operations: Template does not have operations")
|
||||
Logger.error ("in update_operations: Template does not have operations")
|
||||
|
||||
|
||||
fun update_precondition pre' ({name,precondition,postcondition,body,arguments,
|
||||
|
@ -2703,7 +2701,7 @@ fun visibility_of (Class{visibility,...}) = visibility
|
|||
|
||||
|
||||
fun short_name_of C = case (name_of C) of
|
||||
[] => error "in Rep.short_name_of: empty type"
|
||||
[] => Logger.error "in Rep.short_name_of: empty type"
|
||||
| p => (hd o rev) p
|
||||
|
||||
fun stereotypes_of (Class{stereotypes,...}) = stereotypes
|
||||
|
@ -2711,7 +2709,7 @@ fun stereotypes_of (Class{stereotypes,...}) = stereotypes
|
|||
| stereotypes_of (Interface{stereotypes,...}) = stereotypes
|
||||
| stereotypes_of (Enumeration{stereotypes,...}) = stereotypes
|
||||
| stereotypes_of (Primitive{stereotypes,...}) = stereotypes
|
||||
| stereotypes_of (Template _) = error "in Rep.stereotypes_of: \
|
||||
| stereotypes_of (Template _) = Logger.error "in Rep.stereotypes_of: \
|
||||
\unsupported argument type Template"
|
||||
|
||||
|
||||
|
@ -2758,7 +2756,7 @@ fun substitute_package [] tpackage [] = raise Rep_CoreError ("Not possible to su
|
|||
|
||||
fun parent_short_name_of C =
|
||||
(case (parent_name_of C) of
|
||||
[] => error "in Rep.parent_short_name_of: empty type"
|
||||
[] => Logger.error "in Rep.parent_short_name_of: empty type"
|
||||
| p => (hd o rev) p)
|
||||
|
||||
fun parent_package_of (Class{parent,...}) =
|
||||
|
@ -2776,9 +2774,9 @@ fun parent_package_of (Class{parent,...}) =
|
|||
else []
|
||||
end)
|
||||
| parent_package_of (Interface{...}) =
|
||||
error "in Rep.parent_package_of: unsupported argument type Interface"
|
||||
Logger.error "in Rep.parent_package_of: unsupported argument type Interface"
|
||||
| parent_package_of (E as Enumeration{parent,...}) =
|
||||
(case parent of NONE => error ("in Rep.parent_package_of: Enumeration "^
|
||||
(case parent of NONE => Logger.error ("in Rep.parent_package_of: Enumeration "^
|
||||
(string_of_path o name_of) E^
|
||||
" has no parent")
|
||||
| SOME q => let val p = path_of_OclType q in
|
||||
|
@ -2788,14 +2786,14 @@ fun parent_package_of (Class{parent,...}) =
|
|||
end )
|
||||
| parent_package_of (Primitive{parent,...}) =
|
||||
(case parent of NONE => package_of OclAnyC
|
||||
(* NONE => error "Primitive has no parent" *)
|
||||
(* NONE => Logger.error "Primitive has no parent" *)
|
||||
| SOME q => let val p = path_of_OclType q in
|
||||
if (length p) > 1
|
||||
then (take (((length p) -1),p))
|
||||
else []
|
||||
end)
|
||||
| parent_package_of (Template{...}) =
|
||||
error "in Rep.parent_package_of: unsupported argument type Template"
|
||||
Logger.error "in Rep.parent_package_of: unsupported argument type Template"
|
||||
|
||||
|
||||
(* Get parent interfaces of a Classifier. *)
|
||||
|
@ -2804,7 +2802,7 @@ fun parent_interfaces_of (Interface{parents,...}) = parents
|
|||
| parent_interfaces_of (AssociationClass{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"
|
||||
| parent_interfaces_of (Template{...}) = Logger.error "parent_interfaces_of <Template> not supported"
|
||||
|
||||
|
||||
|
||||
|
@ -2818,7 +2816,7 @@ fun p_invariant_of (Class{invariant,...}) = invariant
|
|||
| p_invariant_of (Interface{invariant,...}) = invariant
|
||||
| p_invariant_of (Enumeration{invariant,...}) = invariant
|
||||
| p_invariant_of (Primitive{invariant,...}) = invariant
|
||||
| p_invariant_of (Template _) = error "in Rep.p_invariant_of: \
|
||||
| p_invariant_of (Template _) = Logger.error "in Rep.p_invariant_of: \
|
||||
\unsupported argument type Template"
|
||||
|
||||
fun invariant_of C =
|
||||
|
@ -2847,29 +2845,29 @@ fun name_of_ae ({name,...}:associationend) = name
|
|||
|
||||
fun thy_name_of (C as Class{thyname,...}) =
|
||||
(case thyname of SOME tname => tname
|
||||
| NONE => error ("Class "^((string_of_path o name_of) C)^
|
||||
| NONE => Logger.error ("Class "^((string_of_path o name_of) C)^
|
||||
" has no thyname"))
|
||||
| thy_name_of (AC as AssociationClass{thyname,...}) =
|
||||
(case thyname of SOME tname => tname
|
||||
| NONE => error ("AssociationClass "^((string_of_path o
|
||||
| NONE => Logger.error ("AssociationClass "^((string_of_path o
|
||||
name_of) AC)^
|
||||
" has no thyname"))
|
||||
| thy_name_of (I as Interface{thyname,...}) =
|
||||
(case thyname of SOME tname => tname
|
||||
| NONE => error ("Interface "^((string_of_path o
|
||||
| NONE => Logger.error ("Interface "^((string_of_path o
|
||||
name_of) I)
|
||||
^" has no thyname"))
|
||||
| thy_name_of (E as Enumeration{thyname,...}) =
|
||||
(case thyname of SOME tname => tname
|
||||
| NONE => error ("Enumeration "^((string_of_path o
|
||||
| NONE => Logger.error ("Enumeration "^((string_of_path o
|
||||
name_of) E)
|
||||
^" has no thyname"))
|
||||
| thy_name_of (P as Primitive{thyname,...}) =
|
||||
(case thyname of SOME tname => tname
|
||||
| NONE => error ("Primitive "^((string_of_path o
|
||||
| NONE => Logger.error ("Primitive "^((string_of_path o
|
||||
name_of) P)^
|
||||
" has no thyname"))
|
||||
| thy_name_of (Template _) = error "in Rep.thy_name_of: \
|
||||
| thy_name_of (Template _) = Logger.error "in Rep.thy_name_of: \
|
||||
\unsupported argument type Template"
|
||||
|
||||
|
||||
|
@ -3326,7 +3324,7 @@ fun connected_classifiers_of (all_associations:association list)
|
|||
fun upcastable_args [] [] model = true
|
||||
| upcastable_args ((str,typ)::tail) ((term,ttyp)::args) model =
|
||||
let
|
||||
val _ = trace low ("must conform to: " ^ (string_of_OclType typ) ^ "\n")
|
||||
val _ = Logger.debug4 ("must conform to: " ^ (string_of_OclType typ) ^ "\n")
|
||||
in
|
||||
if (conforms_to (type_of_term term) typ model) then
|
||||
true
|
||||
|
@ -3341,7 +3339,7 @@ fun upcastable_args [] [] model = true
|
|||
fun upcast_args [] [] model = []
|
||||
| upcast_args ((str,typ)::tail) ((term,_)::args) model =
|
||||
let
|
||||
val _ = trace low ("interfere args" ^ "\n")
|
||||
val _ = Logger.debug4 ("interfere args" ^ "\n")
|
||||
in
|
||||
if (type_equals typ (type_of_term term)) then
|
||||
(term,type_of_term term)::(upcast_args tail args model)
|
||||
|
@ -3362,17 +3360,17 @@ fun upcast_type t1 t2 model =
|
|||
(* RETURN: OclTerm *)
|
||||
fun upcast_op [] source args model =
|
||||
let
|
||||
val _ = trace development ("UpcastingError ... \n")
|
||||
val _ = Logger.debug4 ("UpcastingError ... \n")
|
||||
in
|
||||
raise UpcastingError ("interefere_methods: No operation signature matches given types.")
|
||||
end
|
||||
| upcast_op ((class,meth)::class_meth_list) source args model =
|
||||
let
|
||||
val _ = trace low ("Interfere method : name : '" ^ name_of_op meth ^ "'\n")
|
||||
val _ = Logger.debug4 ("Interfere method : name : '" ^ name_of_op meth ^ "'\n")
|
||||
val check_source = conforms_to (type_of_term source) (type_of class) model
|
||||
val check_args = upcastable_args (#arguments meth) args model
|
||||
val _ = trace low ("Upcastable ? : Source conforms : " ^ Bool.toString check_source ^ " Args conforms : " ^ Bool.toString check_args ^ "\n")
|
||||
val _ = trace low ("Return type of method : " ^ string_of_OclType (result_of_op meth) ^ "\n\n")
|
||||
val _ = Logger.debug4 ("Upcastable ? : Source conforms : " ^ Bool.toString check_source ^ " Args conforms : " ^ Bool.toString check_args ^ "\n")
|
||||
val _ = Logger.debug4 ("Return type of method : " ^ string_of_OclType (result_of_op meth) ^ "\n\n")
|
||||
in
|
||||
if (check_source andalso check_args) then
|
||||
(* signature matches given types *)
|
||||
|
@ -3385,7 +3383,7 @@ fun upcast_op [] source args model =
|
|||
fun upcast_att (class,attr:attribute) source (model:transform_model) =
|
||||
let
|
||||
val check_source = conforms_to (type_of_term source) (type_of class) model
|
||||
val _ = trace low ("interfere attribute: check_source "^ Bool.toString check_source ^ "\n\n")
|
||||
val _ = Logger.debug4 ("interfere attribute: check_source "^ Bool.toString check_source ^ "\n\n")
|
||||
in
|
||||
if check_source then
|
||||
(* signature matches given types *)
|
||||
|
@ -3398,8 +3396,8 @@ fun upcast_att (class,attr:attribute) source (model:transform_model) =
|
|||
fun upcast_aend (class,assocend:associationend) source (model:transform_model) =
|
||||
let
|
||||
val check_source = conforms_to (type_of_term source) (type_of class) model
|
||||
val _ = trace low ("Interfere assocend: check_source " ^ Bool.toString check_source ^ "\n")
|
||||
val _ = trace low ("type of assoc " ^ string_of_OclType (convert_aend_type assocend) ^ "\n")
|
||||
val _ = Logger.debug4 ("Interfere assocend: check_source " ^ Bool.toString check_source ^ "\n")
|
||||
val _ = Logger.debug4 ("type of assoc " ^ string_of_OclType (convert_aend_type assocend) ^ "\n")
|
||||
in
|
||||
if check_source then
|
||||
(* billk_tag *)
|
||||
|
@ -3464,12 +3462,12 @@ fun end_of_recursion classifier =
|
|||
|
||||
fun get_overloaded_methods class op_name model =
|
||||
let
|
||||
val _ = trace rep_core ("get_overloaded_methods, look for operation = " ^ op_name ^ "\n")
|
||||
val _ = Logger.debug3 ("get_overloaded_methods, look for operation = " ^ op_name ^ "\n")
|
||||
val parents = parents_of class model
|
||||
val loc_ops = List.map (fn a => (class,a)) (local_operations_of class)
|
||||
val cl_op_list = (loc_ops)@(List.concat (List.map (fn a => (List.map (fn b => (a,b)) (all_operations_of a model))) parents))
|
||||
val cls_ops = List.filter (fn (a,b) => if (name_of_op b = op_name) then true else false) cl_op_list
|
||||
val _ = trace rep_core ("number of overloaded operations found = " ^ Int.toString(List.length(cls_ops)) ^ "\n")
|
||||
val _ = Logger.debug3 ("number of overloaded operations found = " ^ Int.toString(List.length(cls_ops)) ^ "\n")
|
||||
in
|
||||
cls_ops
|
||||
end
|
||||
|
@ -3480,14 +3478,14 @@ fun last_implementation_of_op class op_name model =
|
|||
fun get_overloaded_methods class op_name ([],_) = raise NoModelReferenced ("in 'get_overloaded_methods' ...\n")
|
||||
| get_overloaded_methods class op_name (model as (classifiers,associations)) =
|
||||
let
|
||||
val _ = trace function_calls "get_overloaded_methods\n"
|
||||
val _ = trace low("\n")
|
||||
val _ = Logger.debug2 "get_overloaded_methods\n"
|
||||
val _ = Logger.debug4("\n")
|
||||
val ops = local_operations_of class
|
||||
val _ = trace low("Look for methods for classifier: " ^ string_of_OclType (type_of class) ^ "\n")
|
||||
val _ = Logger.debug4("Look for methods for classifier: " ^ string_of_OclType (type_of class) ^ "\n")
|
||||
val ops2 = List.filter (fn a => (if ((#name a) = op_name) then true else false)) ops
|
||||
val _ = trace low("operation name : " ^ op_name ^ " Found " ^ Int.toString (List.length ops2) ^ " method(s) \n")
|
||||
val _ = Logger.debug4("operation name : " ^ op_name ^ " Found " ^ Int.toString (List.length ops2) ^ " method(s) \n")
|
||||
val parent = parent_of class model
|
||||
val _ = trace low("Parent class : " ^ string_of_OclType (type_of parent) ^ "\n\n")
|
||||
val _ = Logger.debug4("Parent class : " ^ string_of_OclType (type_of parent) ^ "\n\n")
|
||||
val cl_op = List.map (fn a => (class,a)) ops2
|
||||
in
|
||||
if (class = class_of_type OclAny model)
|
||||
|
@ -3514,7 +3512,7 @@ fun get_overloaded_methods class op_name ([],_) = raise NoModelReferenced ("in '
|
|||
|
||||
fun get_overloaded_attrs_or_assocends class attr_name (model as (clist,alist)) =
|
||||
let
|
||||
val _ = trace function_calls
|
||||
val _ = Logger.debug2
|
||||
("Rep_Core.get_overloaded_attrs_or_assocends, look for attr_or_assoc = "
|
||||
^ attr_name
|
||||
^ "\n")
|
||||
|
@ -3524,7 +3522,7 @@ fun get_overloaded_attrs_or_assocends class attr_name (model as (clist,alist)) =
|
|||
val cl_att_list = (loc_atts)@(List.concat (List.map (fn a => (List.map (fn b => (a,b)) (all_attributes_of a model))) parents))
|
||||
val cls_atts = List.filter (fn (a,b) => if (name_of_att b = attr_name) then true else false) cl_att_list
|
||||
(* Associations *)
|
||||
val _ = trace rep_core ("middle get_overloaded_attrs_or_assocends \n")
|
||||
val _ = Logger.debug3 ("middle get_overloaded_attrs_or_assocends \n")
|
||||
val loc_assE = List.map (fn a => (class,a)) (local_associationends_of alist class)
|
||||
val cl_assE_list = (loc_assE)@(List.concat (List.map (fn a => (List.map (fn b => (a,b)) (all_associationends_of a model))) parents))
|
||||
val cls_assEs = List.filter (fn (a,b) => if (name_of_aend b = attr_name) then true else false) cl_assE_list
|
||||
|
@ -3551,7 +3549,7 @@ fun get_overloaded_attrs_or_assocends class attr_name (model as (clist,alist)) =
|
|||
else
|
||||
raise AttributeAssocEndNameClash ("Attributes and AssocEnd in same inheritance tree are named equal.\n")
|
||||
)
|
||||
val _ = trace function_ends ("Rep_Core.get_overloaded_attrs_or_assocends\n")
|
||||
val _ = Logger.debug2 ("Rep_Core.get_overloaded_attrs_or_assocends\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -3559,29 +3557,29 @@ fun get_overloaded_attrs_or_assocends class attr_name (model as (clist,alist)) =
|
|||
fun get_meth source op_name args (model as (classifiers,associations))=
|
||||
(* object type *)
|
||||
let
|
||||
val _ = trace function_calls ("Rep_Core: get_meth: Type of Classifier : " ^ string_of_OclType (type_of_term source ) ^ "\n")
|
||||
val _ = Logger.debug2 ("Rep_Core: get_meth: Type of Classifier : " ^ string_of_OclType (type_of_term source ) ^ "\n")
|
||||
val class = class_of_term source model
|
||||
val meth_list = get_overloaded_methods class op_name model
|
||||
val res = upcast_op meth_list source args model
|
||||
val _ = trace function_ends ("Rep_Core: overloaded methods found: " ^ Int.toString (List.length meth_list) ^ "\n")
|
||||
val _ = Logger.debug2 ("Rep_Core: overloaded methods found: " ^ Int.toString (List.length meth_list) ^ "\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
||||
fun get_attr_or_assoc source attr_name (model as (classifiers,associations)) =
|
||||
let
|
||||
val _ = trace function_calls ("Rep_Core.get_attr_or_assoc\n")
|
||||
val _ = trace rep_core ("GET ATTRIBUTES OR ASSOCENDS: source term.\n")
|
||||
val _ = Logger.debug2 ("Rep_Core.get_attr_or_assoc\n")
|
||||
val _ = Logger.debug3 ("GET ATTRIBUTES OR ASSOCENDS: source term.\n")
|
||||
val class = class_of_term source model
|
||||
val attr_or_assocend_list = get_overloaded_attrs_or_assocends class attr_name model
|
||||
val res =
|
||||
let
|
||||
val x = upcast_att_aend attr_or_assocend_list source model
|
||||
val _ = trace rep_core ("Return type of attribute: " ^ string_of_OclType (type_of_term x) ^ "\n\n")
|
||||
val _ = Logger.debug3 ("Return type of attribute: " ^ string_of_OclType (type_of_term x) ^ "\n\n")
|
||||
in
|
||||
x
|
||||
end
|
||||
val _ = trace function_ends ("Rep_Core.end get_attr_or_assoc\n")
|
||||
val _ = Logger.debug2 ("Rep_Core.end get_attr_or_assoc\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -3693,7 +3691,6 @@ fun string_to_type "Integer" = Integer
|
|||
val cons = (#1 tokens)
|
||||
(* delete first "(" and last ")" element *)
|
||||
val tail = List.tl (real_path (#2 tokens))
|
||||
val _ = trace important ("tail "^ (String.implode tail) ^ "\n")
|
||||
in
|
||||
string_to_cons (String.implode cons) (string_to_type (String.implode tail))
|
||||
end
|
||||
|
|
|
@ -2,10 +2,11 @@
|
|||
* su4sml --- a SML repository for managing (Secure)UML/OCL models
|
||||
* http://projects.brucker.ch/su4sml/
|
||||
*
|
||||
* library.sml ---
|
||||
* logger.sml ---
|
||||
* This file is part of su4sml.
|
||||
*
|
||||
* Copyright (c) 2005-2007, ETH Zurich, Switzerland
|
||||
* Copyright (c) 2005-2007 ETH Zurich, Switzerland
|
||||
* 2008-2009 Achim D. Brucker, Germany
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
|
@ -38,46 +39,130 @@
|
|||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
******************************************************************************)
|
||||
(* $Id$ *)
|
||||
|
||||
signature LOGGER =
|
||||
sig
|
||||
type log_level
|
||||
val set_log_level : log_level -> unit
|
||||
val get_log_level : unit -> log_level
|
||||
|
||||
val set_strict_logging : bool -> unit
|
||||
val get_strict_logging : unit -> bool
|
||||
|
||||
|
||||
val ERROR : log_level
|
||||
val WARN : log_level
|
||||
val INFO : log_level
|
||||
|
||||
val DEBUG_1 : log_level
|
||||
val DEBUG_2 : log_level
|
||||
val DEBUG_3 : log_level
|
||||
val DEBUG_4 : log_level
|
||||
val DEBUG_5 : log_level
|
||||
|
||||
val get_log_level_str : unit -> string
|
||||
|
||||
val error: string -> 'a
|
||||
val errorExn: exn -> string -> 'a
|
||||
val warn: string -> unit
|
||||
val info: string -> unit
|
||||
val debug1: string -> unit
|
||||
val debug2: string -> unit
|
||||
val debug3: string -> unit
|
||||
val debug4: string -> unit
|
||||
val debug5: string -> unit
|
||||
end
|
||||
|
||||
structure Logger:>LOGGER =
|
||||
struct
|
||||
type log_level = int
|
||||
|
||||
fun std_output s = print s
|
||||
fun std_error s = (TextIO.output (TextIO.stdErr, s); TextIO.flushOut TextIO.stdErr )
|
||||
|
||||
infix 1 |>
|
||||
fun x |> f = f x
|
||||
|
||||
val ERROR = 0
|
||||
val WARN = 10
|
||||
val INFO = 20
|
||||
val DEBUG_1 = 30
|
||||
val DEBUG_2 = 40
|
||||
val DEBUG_3 = 50
|
||||
val DEBUG_4 = 60
|
||||
val DEBUG_5 = 70
|
||||
|
||||
val logLevel = ref WARN
|
||||
fun set_log_level l = (logLevel := l;())
|
||||
fun get_log_level () = !logLevel
|
||||
|
||||
val strictLogging = ref false
|
||||
fun set_strict_logging l = (strictLogging := l;())
|
||||
fun get_strict_logging () = !strictLogging
|
||||
|
||||
|
||||
fun get_log_level_str () = case !logLevel of
|
||||
0 => "error"
|
||||
| 10 => "warn"
|
||||
| 20 => "info"
|
||||
| 30 => "debug 1"
|
||||
| 40 => "debug 2"
|
||||
| 50 => "debug 3"
|
||||
| 60 => "debug 4"
|
||||
| _ => "debug 5"
|
||||
|
||||
fun separate s (x :: (xs as _ :: _)) = x :: s :: separate s xs
|
||||
| separate _ xs = xs;
|
||||
|
||||
fun space_implode a bs = String.concat (separate a bs)
|
||||
fun space_explode _ "" = []
|
||||
| space_explode sep s = String.fields (fn c => str c = sep) s
|
||||
val split_lines = space_explode "\n"
|
||||
val cat_lines = space_implode "\n"
|
||||
|
||||
fun prefix_lines "" txt = txt
|
||||
| prefix_lines prfx txt = txt |> split_lines |> map (fn s => prfx ^ s) |> cat_lines;
|
||||
fun prefix prfx s = prfx ^ s
|
||||
fun suffix sffx s = s ^ sffx
|
||||
|
||||
|
||||
fun mk_error_string s = s |> prefix_lines "*** " |> suffix "\n"
|
||||
fun mk_warn_string s = s |> prefix_lines "### " |> suffix "\n"
|
||||
fun mk_info_string s = s |> prefix_lines "+++ " |> suffix "\n"
|
||||
fun mk_debug_string s = s |> prefix_lines "::: " |> suffix "\n"
|
||||
|
||||
fun trace log msg = if (!strictLogging andalso log = !logLevel) orelse (not (!strictLogging) andalso log <= !logLevel)
|
||||
then print msg
|
||||
else ()
|
||||
|
||||
|
||||
fun error s = ((print o mk_error_string) s; raise Fail s)
|
||||
fun errorExn ex s = ((print o mk_error_string) s; raise ex)
|
||||
fun warn msg = msg |> mk_warn_string |> trace WARN
|
||||
fun info msg = msg |> mk_info_string |> trace INFO
|
||||
fun debug1 msg = msg |> mk_debug_string |> trace DEBUG_1
|
||||
fun debug2 msg = msg |> mk_debug_string |> trace DEBUG_2
|
||||
fun debug3 msg = msg |> mk_debug_string |> trace DEBUG_3
|
||||
fun debug4 msg = msg |> mk_debug_string |> trace DEBUG_4
|
||||
fun debug5 msg = msg |> mk_debug_string |> trace DEBUG_5
|
||||
|
||||
|
||||
(*
|
||||
fun printStackTrace e =
|
||||
let val ss = CompilerExt.exnHistory e
|
||||
in
|
||||
print_stderr ("uncaught exception " ^ (General.exnMessage e) ^ " at:\n");
|
||||
app (fn s => print_stderr ("\t" ^ s ^ "\n")) ss
|
||||
end
|
||||
*)
|
||||
end
|
||||
(*
|
||||
signature REP_LOGGER =
|
||||
sig
|
||||
val trace : int -> string -> unit
|
||||
val init_offset : unit -> unit
|
||||
|
||||
val error : string -> 'a
|
||||
val error_msg : string -> unit
|
||||
val print_stderr : TextIO.vector -> unit
|
||||
val warn : string -> unit
|
||||
val info : string -> unit
|
||||
val log_level : int ref
|
||||
|
||||
val line_offset : int ref
|
||||
(**
|
||||
* log_levels
|
||||
*)
|
||||
val zero : int
|
||||
val exce : int
|
||||
val high : int
|
||||
val medium : int
|
||||
val function_calls : int
|
||||
val function_ends : int
|
||||
val function_arguments : int
|
||||
val important : int
|
||||
val wgen : int
|
||||
val type_checker : int
|
||||
val preprocessor : int
|
||||
val rep_core : int
|
||||
val low : int
|
||||
val development : int
|
||||
val isa_metho : int
|
||||
val su4sml_home : unit -> string
|
||||
|
||||
end
|
||||
structure Rep_Logger:REP_LOGGER =
|
||||
end
|
||||
structure Rep_Logger:>REP_LOGGER =
|
||||
struct
|
||||
|
||||
open Rep_Helper
|
||||
|
||||
|
||||
(* minimal tracing support (modifed version of ocl_parser tracing *)
|
||||
val log_level = ref 6
|
||||
|
||||
|
@ -134,15 +219,9 @@ fun embed_newline s =
|
|||
fun trace lev s =
|
||||
case lev of
|
||||
6 =>
|
||||
let
|
||||
val s1 = ("\n\n\n##################################################\n")
|
||||
val s2 = ("############## EXCEPTION MESSAGE ################\n")
|
||||
val s3 = ("##################################################\n\n")
|
||||
in
|
||||
if (lev <= !log_level )
|
||||
then print(s1^s2^s3^(embed_newline s))
|
||||
then print(embed_newline s)
|
||||
else ()
|
||||
end
|
||||
| 25 =>
|
||||
let
|
||||
val _ = if (lev <= !log_level )
|
||||
|
@ -175,89 +254,6 @@ fun trace lev s =
|
|||
else ()
|
||||
)
|
||||
|
||||
|
||||
(* HOLOCL_HOME resp. SU4SML_HOME should point to the top-level directory *)
|
||||
(* of the corresponding library. The semantics of UML2CDL_HOME should *)
|
||||
(* probably be fixed *)
|
||||
fun su4sml_home () = case OS.Process.getEnv "HOLOCL_HOME" of
|
||||
SOME p => p^"/lib/su4sml/src"
|
||||
| NONE => (case OS.Process.getEnv "SU4SML_HOME" of
|
||||
SOME p => p^"/src"
|
||||
| NONE => (case OS.Process.getEnv "UML2CDL_HOME" of
|
||||
SOME p => p^"../../../src"
|
||||
| NONE => ".")
|
||||
)
|
||||
|
||||
|
||||
fun filter (pred: 'a->bool) : 'a list -> 'a list =
|
||||
let fun filt [] = []
|
||||
| filt (x :: xs) = if pred x then x :: filt xs else filt xs
|
||||
in filt end;
|
||||
|
||||
fun real_path x = List.rev (List.tl (List.rev x))
|
||||
|
||||
|
||||
fun optlist2list [] = []
|
||||
| optlist2list (h::tail) =
|
||||
(
|
||||
case h of
|
||||
NONE => optlist2list (tail)
|
||||
| SOME (e) => (e::(optlist2list tail))
|
||||
)
|
||||
|
||||
fun exists (pred: 'a -> bool) : 'a list -> bool =
|
||||
let fun boolf [] = false
|
||||
| boolf (x :: xs) = pred x orelse boolf xs
|
||||
in boolf end;
|
||||
|
||||
|
||||
fun append xs ys = xs @ ys;
|
||||
|
||||
fun find _ [] = Option.NONE
|
||||
| find p (x :: xs) = if p x then Option.SOME x else find p xs;
|
||||
|
||||
fun swap1 f a b c = f c b a
|
||||
|
||||
(* fun getenv var =
|
||||
(case OS.Process.getEnv var of
|
||||
NONE => ""
|
||||
| SOME txt => txt);
|
||||
*)
|
||||
(*
|
||||
fun print_depth n =
|
||||
(Control.Print.printDepth := n div 2;
|
||||
Control.Print.printLength := n);
|
||||
*)
|
||||
|
||||
val cd = OS.FileSys.chDir
|
||||
val pwd = OS.FileSys.getDir
|
||||
|
||||
(* use Option.map instead
|
||||
fun ap_some f (SOME x) = SOME(f x)
|
||||
|ap_some f NONE = NONE
|
||||
*)
|
||||
|
||||
fun separate s (x :: (xs as _ :: _)) = x :: s :: separate s xs
|
||||
| separate _ xs = xs;
|
||||
(* fun suffix sfx s = s ^ sfx;*)
|
||||
|
||||
fun space_implode a bs = implode (separate a bs);
|
||||
|
||||
fun print_stderr s = (TextIO.output (TextIO.stdErr, s); TextIO.flushOut TextIO.stdErr);
|
||||
|
||||
exception ERROR;
|
||||
|
||||
(** output an informational message about what is going on. *)
|
||||
fun info s = print (s^"\n")
|
||||
|
||||
(** output a warning that something is wrong,
|
||||
* but it is dealt with somehow. *)
|
||||
fun warn s = print ("Warning: "^s^"\n")
|
||||
|
||||
(** output an error message *)
|
||||
fun error_msg s = print (s^"\n")
|
||||
|
||||
(** output an error message and Fail *)
|
||||
fun error s = (print (s^"\n"); raise Fail s)
|
||||
|
||||
end
|
||||
|
||||
*)
|
||||
|
|
|
@ -5,7 +5,8 @@
|
|||
* rep_ocl.sml ---
|
||||
* This file is part of su4sml.
|
||||
*
|
||||
* Copyright (c) 2005-2007, ETH Zurich, Switzerland
|
||||
* Copyright (c) 2005-2007 ETH Zurich, Switzerland
|
||||
* 2008-2009 Achim D. Brucker, Germany
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
|
@ -136,7 +137,6 @@ end
|
|||
structure Rep_OclType : REP_OCL_TYPE =
|
||||
struct
|
||||
open Rep_Helper
|
||||
open Rep_Logger
|
||||
|
||||
type Path = string list
|
||||
|
||||
|
|
|
@ -5,7 +5,8 @@
|
|||
* rep_parser.sml --- an xmi-parser for the import interface for su4sml
|
||||
* This file is part of su4sml.
|
||||
*
|
||||
* Copyright (c) 2005-2007, ETH Zurich, Switzerland
|
||||
* Copyright (c) 2005-2007 ETH Zurich, Switzerland
|
||||
* 2008-2009 Achim D. Brucker, Germany
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
|
@ -45,11 +46,10 @@ structure RepParser :
|
|||
val transformXMI_ext : XMI.XmiContent -> Rep.transform_model
|
||||
val readFile : string -> Rep.Model
|
||||
val importArgoUML : string -> Rep.Model
|
||||
val test: (string * string list) -> OS.Process.status
|
||||
(* val test: (string * string list) -> OS.Process.status *)
|
||||
(* generic exception if something is wrong *)
|
||||
end =
|
||||
struct
|
||||
open Rep_Logger
|
||||
|
||||
open Xmi_IDTable
|
||||
|
||||
|
@ -179,7 +179,7 @@ fun transform_expression t (XMI.LiteralExp {symbol,expression_type}) =
|
|||
find_classifier_type t expression_type
|
||||
)
|
||||
end
|
||||
| transform_expression t _ = error "unsupported OCL expression type"
|
||||
| transform_expression t _ = Logger.error "unsupported OCL expression type"
|
||||
and transform_collection_part t (XMI.CollectionItem {item,expression_type}) =
|
||||
Rep_OclTerm.CollectionItem (transform_expression t item,
|
||||
find_classifier_type t expression_type)
|
||||
|
@ -195,7 +195,7 @@ fun transform_constraint t ({xmiid,name,body,...}:XMI.Constraint) =
|
|||
| NONE => NONE
|
||||
in
|
||||
(n_name,transform_expression t body)
|
||||
handle ex => (print ("Warning: in RepParser.transform_constraint: \
|
||||
handle ex => (Logger.warn ("Warning: in RepParser.transform_constraint: \
|
||||
\Could not parse Constraint: "^General.exnMessage ex^"\n"^
|
||||
"using the trivial constraint 'true' instead");
|
||||
(NONE, triv_expr))
|
||||
|
@ -211,7 +211,7 @@ fun transform_bodyconstraint result_type t ({xmiid,name,body,...}:XMI.Constraint
|
|||
equal,[(body,body_type)],
|
||||
Rep_OclType.Boolean))
|
||||
end
|
||||
handle ex => (print ("Warning: in RepParser.transform_bodyconstraint: \
|
||||
handle ex => (Logger.warn ("Warning: in RepParser.transform_bodyconstraint: \
|
||||
\Could not parse Constraint: "^
|
||||
General.exnMessage ex^"\n"^
|
||||
"using the trivial constraint 'true' instead");
|
||||
|
@ -219,7 +219,7 @@ fun transform_bodyconstraint result_type t ({xmiid,name,body,...}:XMI.Constraint
|
|||
|
||||
fun transform_parameter t {xmiid,name,kind,type_id} =
|
||||
(name, find_classifier_type t type_id
|
||||
handle _ => (warn ("no type found for parameter '"^name^
|
||||
handle _ => (Logger.warn ("no type found for parameter '"^name^
|
||||
"', defaulting to OclVoid");
|
||||
Rep_OclType.OclVoid)
|
||||
)
|
||||
|
@ -228,11 +228,11 @@ fun transform_operation t {xmiid,name,isQuery,parameter,visibility,
|
|||
constraints,ownerScope} =
|
||||
let val result_type = (
|
||||
case filter (fn x => #kind x = XMI.Return) parameter
|
||||
of [] => (warn ("no return type found for operation '"^name^
|
||||
of [] => (Logger.warn ("no return type found for operation '"^name^
|
||||
"', defaulting to OclVoid");
|
||||
Rep_OclType.OclVoid)
|
||||
| [x] => (find_classifier_type t (#type_id x)
|
||||
handle _ => (warn ("return parameter for \
|
||||
handle _ => (Logger.warn ("return parameter for \
|
||||
\operation '"^name^
|
||||
"' has no declared type, \
|
||||
\defaulting to OclVoid");
|
||||
|
@ -240,12 +240,12 @@ fun transform_operation t {xmiid,name,isQuery,parameter,visibility,
|
|||
| x::y::_ =>
|
||||
let
|
||||
val ret_type = find_classifier_type t (#type_id x)
|
||||
handle _ => (warn ("return parameter for operation '"
|
||||
handle _ => (Logger.warn ("return parameter for operation '"
|
||||
^name^"' has no declared type, \
|
||||
\defaulting to OclVoid");
|
||||
Rep_OclType.OclVoid)
|
||||
in
|
||||
(warn ("operation '"^name^
|
||||
(Logger.warn ("operation '"^name^
|
||||
"' has multiple return parameters. Using only '"^
|
||||
(Rep_OclType.string_of_OclType ret_type)^"'.");
|
||||
ret_type)
|
||||
|
@ -277,7 +277,7 @@ fun transform_operation t {xmiid,name,isQuery,parameter,visibility,
|
|||
fun transform_attribute t ({xmiid,name,type_id,changeability,visibility,ordering,
|
||||
multiplicity,taggedValue,ownerScope,targetScope,stereotype,initialValue}) =
|
||||
let val cls_type = find_classifier_type t type_id
|
||||
handle _ => (warn ("no type found for attribute '"^name^
|
||||
handle _ => (Logger.warn ("no type found for attribute '"^name^
|
||||
"', defaulting to OclVoid");
|
||||
Rep_OclType.OclVoid)
|
||||
in
|
||||
|
@ -354,7 +354,7 @@ fun transform_state t (XMI.CompositeState {xmiid,outgoing,incoming,subvertex,
|
|||
outgoing = outgoing,
|
||||
incoming = incoming,
|
||||
kind = kind }
|
||||
| transform_state t _ = error ("in transform_state: unsupported StateVertex type \
|
||||
| transform_state t _ = Logger.error ("in transform_state: unsupported StateVertex type \
|
||||
\(Subactivity states, object flow states and \
|
||||
\sync states are not supported).")
|
||||
(* a primitive hack: we take the body of the guard g as the name of an *)
|
||||
|
@ -408,24 +408,24 @@ fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf,
|
|||
classifierInState,activity_graphs,
|
||||
state_machines}) =
|
||||
let
|
||||
val _ = trace function_calls ("RepParser.transform_classifier: Class\n")
|
||||
val _ = trace function_arguments ("class name: "^ name ^"\n")
|
||||
val _ = Logger.debug2 ("RepParser.transform_classifier: Class\n")
|
||||
val _ = Logger.debug2 ("class name: "^ name ^"\n")
|
||||
val assocs = find_classifier_associations t xmiid
|
||||
val _ = trace high ("number of associations added: "^(Int.toString (List.length assocs))^"\n")
|
||||
val _ = Logger.debug1 ("number of associations added: "^(Int.toString (List.length assocs))^"\n")
|
||||
val parents = map ((find_classifier_type t) o (find_parent t))
|
||||
generalizations
|
||||
val filtered_parents = filter (fn x => x <> Rep_OclType.OclAny) parents
|
||||
val filtered_parent = case filtered_parents
|
||||
of [] => NONE
|
||||
| [x] => SOME x
|
||||
| x::y::_ => (warn ("Class '"^name^"' has multiple parents."^
|
||||
| x::y::_ => (Logger.warn ("Class '"^name^"' has multiple parents."^
|
||||
" Using only '"^
|
||||
(Rep_OclType.string_of_OclType x)^"'.");
|
||||
SOME x)
|
||||
val checked_invariants = filter_exists t invariant
|
||||
(* val navigable_aends = filter #isNavigable (find_aends t xmiid)*)
|
||||
val class_type = find_classifier_type t xmiid
|
||||
val _ = print ("transform_classifier: adding "^name^"\n")
|
||||
val _ = Logger.info ("transform_classifier: adding "^name^"\n")
|
||||
val res =
|
||||
Rep.Class {name = (* type_of_classifier *) class_type,
|
||||
parent = case filtered_parents
|
||||
|
@ -443,7 +443,7 @@ fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf,
|
|||
activity_graphs = List.concat [map (transform_activitygraph t) activity_graphs,
|
||||
map (transform_statemachine t) state_machines],
|
||||
thyname = NONE}
|
||||
val _ = trace function_ends ("RepParser.transform_classifier\n")
|
||||
val _ = Logger.debug2 ("RepParser.transform_classifier\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -453,21 +453,21 @@ fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf,
|
|||
clientDependency,connection,
|
||||
supplierDependency,taggedValue}) =
|
||||
let
|
||||
val _ = trace function_calls ("RepParser.transform_classifier: AssociationClass\n")
|
||||
val _ = trace function_arguments ("associationclass name: "^ name ^"\n")
|
||||
val _ = Logger.debug2 ("RepParser.transform_classifier: AssociationClass\n")
|
||||
val _ = Logger.debug2 ("associationclass name: "^ name ^"\n")
|
||||
val (_,assocs,assoc,_,_) = find_classifier_entries t xmiid
|
||||
val _ = trace high ("number of associations added: "^(Int.toString (List.length assocs))^"\n")
|
||||
val _ = trace high ("ac association found: "^(Bool.toString (assoc <> []))^"\n")
|
||||
val _ = print "associations retrieved\n"
|
||||
val _ = Logger.debug1 ("number of associations added: "^(Int.toString (List.length assocs))^"\n")
|
||||
val _ = Logger.debug1 ("ac association found: "^(Bool.toString (assoc <> []))^"\n")
|
||||
val _ = Logger.info "associations retrieved\n"
|
||||
val parents = map ((find_classifier_type t) o (find_parent t))
|
||||
generalizations
|
||||
val _ = trace high "parents retrieved\n"
|
||||
val _ = Logger.debug1 "parents retrieved\n"
|
||||
(* FIXME: filter for classes vs. interfaces *)
|
||||
val filtered_parents = filter (fn x => x <> Rep_OclType.OclAny) parents
|
||||
val checked_invariants = filter_exists t invariant
|
||||
(*val navigable_aends = filter #isNavigable connection *)
|
||||
val class_type = find_classifier_type t xmiid
|
||||
val _ = print ("transform_classifier: adding "^name^"\n")
|
||||
val _ = Logger.debug1 ("transform_classifier: adding "^name^"\n")
|
||||
val res =
|
||||
Rep.AssociationClass {name = (* type_of_classifier *)class_type,
|
||||
parent = case filtered_parents
|
||||
|
@ -484,16 +484,16 @@ fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf,
|
|||
associations = assocs,
|
||||
visibility = visibility,
|
||||
association = assoc}
|
||||
val _ = trace function_ends ("RepParser.transform_classifier\n")
|
||||
val _ = Logger.debug2 ("RepParser.transform_classifier\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| transform_classifier t (XMI.Primitive {xmiid,name,generalizations,operations,invariant,taggedValue}) =
|
||||
let
|
||||
val _ = trace function_calls ("RepParser.transform_classifier: Primitive\n")
|
||||
val _ = trace function_arguments ("primitive name: "^ name ^"\n")
|
||||
val _ = Logger.debug2 ("RepParser.transform_classifier: Primitive\n")
|
||||
val _ = Logger.debug2 ("primitive name: "^ name ^"\n")
|
||||
val (_,assocs,_,_,_) = find_classifier_entries t xmiid
|
||||
val _ = trace high ("number of associations added: "^(Int.toString (List.length assocs))^"\n")
|
||||
val _ = Logger.debug1 ("number of associations added: "^(Int.toString (List.length assocs))^"\n")
|
||||
val checked_invariants = filter_exists t invariant
|
||||
val res =
|
||||
Rep.Primitive {name = (* case *) find_classifier_type t xmiid (*of Rep_OclType.Classifier x => x
|
||||
|
@ -508,14 +508,14 @@ fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf,
|
|||
stereotypes = nil (*FIX *),
|
||||
interfaces = nil (* FIX *),
|
||||
thyname = NONE}
|
||||
val _ = trace function_ends ("RepParser.transform_classifier\n")
|
||||
val _ = Logger.debug2 ("RepParser.transform_classifier\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| transform_classifier t (XMI.Enumeration {xmiid,name,generalizations,
|
||||
operations,literals,invariant}) =
|
||||
let
|
||||
val _ = trace function_calls ("RepParser.transform_classifier: Enumeration\n")
|
||||
val _ = Logger.debug2 ("RepParser.transform_classifier: Enumeration\n")
|
||||
val checked_invariants = filter_exists t invariant
|
||||
val res =
|
||||
Rep.Enumeration {name = (* case *) find_classifier_type t xmiid (* of Rep_OclType.Classifier x => x
|
||||
|
@ -528,14 +528,14 @@ fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf,
|
|||
stereotypes = nil, (* FIX *)
|
||||
interfaces = nil, (* FIX *)
|
||||
thyname = NONE}
|
||||
val _ = trace function_ends ("RepParser.transform_classifier\n")
|
||||
val _ = Logger.debug2 ("RepParser.transform_classifier\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| transform_classifier t (XMI.Interface { xmiid, name, generalizations, operations, invariant,
|
||||
...}) =
|
||||
let
|
||||
val _ = trace function_calls ("RepParser.transform_classifier: Interface\n")
|
||||
val _ = Logger.debug2 ("RepParser.transform_classifier: Interface\n")
|
||||
val checked_invariants = filter_exists t invariant
|
||||
val res =
|
||||
Rep.Interface { name = find_classifier_type t xmiid,
|
||||
|
@ -547,25 +547,25 @@ fun transform_classifier t (XMI.Class {xmiid,name,isActive,visibility,isLeaf,
|
|||
(find_constraint t)) checked_invariants,
|
||||
thyname = NONE
|
||||
}
|
||||
val _ = trace function_ends ("RepParser.transform_classifier\n")
|
||||
val _ = Logger.debug2 ("RepParser.transform_classifier\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
| transform_classifier t (_) = error "Not supported Classifier type found."
|
||||
| transform_classifier t (_) = Logger.error "Not supported Classifier type found."
|
||||
|
||||
|
||||
(** transform an XMI.Association into a Rep.association *)
|
||||
fun transform_association t ({xmiid,name,connection}:XMI.Association):
|
||||
Rep.association =
|
||||
let
|
||||
val _ = trace function_calls ("RepParser.transform_association\n")
|
||||
val _ = trace function_arguments ("transform_association xmiid: "
|
||||
val _ = Logger.debug2 ("RepParser.transform_association\n")
|
||||
val _ = Logger.debug2 ("transform_association xmiid: "
|
||||
^xmiid^"\n")
|
||||
val associationPath = find_association_path t xmiid
|
||||
val _ = print ("transform_association path: "^(string_of_path
|
||||
val _ = Logger.info ("transform_association path: "^(string_of_path
|
||||
associationPath)^
|
||||
"\n")
|
||||
val _ = print ("transform_association path length: "^
|
||||
val _ = Logger.info ("transform_association path length: "^
|
||||
(Int.toString (List.length associationPath)) ^"\n")
|
||||
val (associationEnds,qualifierPairs) =
|
||||
ListPair.unzip (map (transform_aend t associationPath) connection)
|
||||
|
@ -574,7 +574,7 @@ fun transform_association t ({xmiid,name,connection}:XMI.Association):
|
|||
aends = associationEnds,
|
||||
qualifiers = qualifierPairs,
|
||||
aclass = NONE (* regular association *)}
|
||||
val _ = trace function_ends ("RepParser.transform_association\n")
|
||||
val _ = Logger.debug2 ("RepParser.transform_association\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -583,17 +583,17 @@ fun transformAssociationFromAssociationClass t (XMI.AssociationClass
|
|||
{xmiid,connection,...}):
|
||||
Rep.association =
|
||||
let
|
||||
val _ = trace function_calls ("RepParser.transformAssociationFromAassociation Class\n")
|
||||
val _ = Logger.debug2 ("RepParser.transformAssociationFromAassociation Class\n")
|
||||
val id = xmiid^"_association"
|
||||
val associationPath = find_association_path t id
|
||||
val _ = trace low ("transform_association path: "^
|
||||
val _ = Logger.debug4 ("transform_association path: "^
|
||||
(string_of_path associationPath)^"\n")
|
||||
val _ = trace low ("transform_association path length: "^
|
||||
val _ = Logger.debug4 ("transform_association path length: "^
|
||||
(Int.toString (List.length associationPath)) ^"\n")
|
||||
val (associationEnds,qualifierPairs) =
|
||||
ListPair.unzip (map (transform_aend t associationPath) connection)
|
||||
val aClass = SOME (path_of_OclType (find_classifier_type t xmiid))
|
||||
val _ = trace function_ends ("RepParser.transformAssociationFromAssociationClass\n")
|
||||
val _ = Logger.debug2 ("RepParser.transformAssociationFromAssociationClass\n")
|
||||
in
|
||||
{name = associationPath (* path_of_association *),
|
||||
aends = associationEnds,
|
||||
|
@ -605,7 +605,7 @@ fun transformAssociationFromAssociationClass t (XMI.AssociationClass
|
|||
fun transform_package t (XMI.Package p) :transform_model =
|
||||
let
|
||||
(* we do not transform the ocl library *)
|
||||
val _ = trace function_calls ("RepParser.transform_package\n")
|
||||
val _ = Logger.debug2 ("RepParser.transform_package\n")
|
||||
val filteredPackages =
|
||||
filter (fn (XMI.Package x) =>
|
||||
((#name x <> "oclLib") andalso (#name x <> "UML_OCL")))
|
||||
|
@ -621,7 +621,7 @@ fun transform_package t (XMI.Package p) :transform_model =
|
|||
val associations = local_associations @ (List.concat res_associations)
|
||||
val classifiers =local_classifiers @ (List.concat res_classifiers)
|
||||
val res = (classifiers, associations )
|
||||
val _ = trace function_ends ("RepParser.transform_package\n")
|
||||
val _ = Logger.debug2 ("RepParser.transform_package\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -670,40 +670,37 @@ fun transformXMI_ext ({classifiers,constraints,packages,stereotypes,
|
|||
|
||||
fun test2 (classifiers,associations) =
|
||||
let
|
||||
val _ = print "test2\n"
|
||||
val _ = print "classifiers\n"
|
||||
val _ = map (print o (fn x => x^"\n") o string_of_path o name_of)
|
||||
val _ = Logger.info "test2\n"
|
||||
val _ = Logger.info "classifiers\n"
|
||||
val _ = map (Logger.info o (fn x => x^"\n") o string_of_path o name_of)
|
||||
classifiers
|
||||
val _ = print "associations\n"
|
||||
val _ = map (print o (fn x => x^"\n") o string_of_path o
|
||||
val _ = Logger.info "associations\n"
|
||||
val _ = map (Logger.info o (fn x => x^"\n") o string_of_path o
|
||||
(fn {name,aends,qualifiers,aclass} => name))
|
||||
associations
|
||||
val _ = print "operations\n"
|
||||
val _ = Logger.info "operations\n"
|
||||
fun printClassifier cls =
|
||||
let
|
||||
val _ = print ("output of transformXMI_ext:\n")
|
||||
val _ = print ("classifier: "^ (string_of_path (name_of cls))
|
||||
val _ = Logger.info ("output of transformXMI_ext:\n")
|
||||
val _ = Logger.info ("classifier: "^ (string_of_path (name_of cls))
|
||||
^"\n")
|
||||
val _ = print ("associations: \n")
|
||||
val _ = map (print o(fn x => x ^ "\n") o string_of_path )
|
||||
val _ = Logger.info ("associations: \n")
|
||||
val _ = map (Logger.info o(fn x => x ^ "\n") o string_of_path )
|
||||
(associations_of cls)
|
||||
val _ = print ("operations: \n")
|
||||
val _ = map (print o (fn {name,...} => name))
|
||||
val _ = Logger.info ("operations: \n")
|
||||
val _ = map (Logger.info o (fn {name,...} => name))
|
||||
(operations_of cls)
|
||||
in
|
||||
print "\n"
|
||||
end
|
||||
val _ = map printClassifier classifiers
|
||||
in
|
||||
trace 27 "\n### transformXMI_ext done\n\n";
|
||||
Logger.debug2 "\n### transformXMI_ext done\n\n";
|
||||
(classifiers,associations)
|
||||
end
|
||||
in
|
||||
trace 27 "### transformXMI: populate hash table\n";
|
||||
insert_model xmiid_table model (* fill xmi.id table *);
|
||||
trace 27 "### transformXMI: fix associations\n";
|
||||
fix_associations xmiid_table model (* handle associations *);
|
||||
trace 27 "### transformXMI: transform XMI into Rep\n";
|
||||
test2 (transform_package xmiid_table model) (* transform classifiers *)
|
||||
end
|
||||
|
||||
|
@ -718,7 +715,7 @@ fun transformXMI x:Classifier list = fst (transformXMI_ext x)
|
|||
fun normalize_ext ((clsses,accs):transform_model):Rep.Model =
|
||||
(map (Rep.normalize accs) clsses,accs)
|
||||
|
||||
fun readFile f = (info ("opening "^f);
|
||||
fun readFile f = (Logger.info ("opening "^f);
|
||||
(normalize_ext o transformXMI_ext o XmiParser.readFile) f)
|
||||
(* handle ex as (IllFormed msg) => raise ex *)
|
||||
|
||||
|
@ -744,16 +741,6 @@ fun importArgoUML file =
|
|||
|
||||
|
||||
|
||||
fun printStackTrace e =
|
||||
let val ss = CompilerExt.exnHistory e
|
||||
in
|
||||
print_stderr ("uncaught exception " ^ (General.exnMessage e) ^ " at:\n");
|
||||
app (fn s => print_stderr ("\t" ^ s ^ "\n")) ss
|
||||
end
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
@ -761,8 +748,8 @@ fun printStackTrace e =
|
|||
*****************************************************
|
||||
* Test function.
|
||||
*)
|
||||
fun test (_,filename::_) = (Rep2String.printList (fst (readFile filename)); OS.Process.success)
|
||||
handle ex => (printStackTrace ex; OS.Process.failure)
|
||||
(* fun test (_,filename::_) = (Rep2String.printList (fst (readFile filename)); OS.Process.success) *)
|
||||
(* handle ex => (printStackTrace ex; OS.Process.failure) *)
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -44,7 +44,6 @@ structure SecureUML2HolOcl:sig
|
|||
end = struct
|
||||
|
||||
open Rep_Helper
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
open XMI_DataTypes
|
||||
open Rep_OclTerm
|
||||
|
|
|
@ -110,7 +110,6 @@ datatype transformFlag = BinaryAssociationsOnly
|
|||
type modelTransformation = Rep_Core.transform_model * transformFlag list
|
||||
-> Rep_Core.transform_model * transformFlag list
|
||||
open Rep_Helper
|
||||
open Rep_Logger
|
||||
open Transform_Library
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
|
@ -137,8 +136,8 @@ fun get_association (all_assocs: Rep_Core.association list) (assoc_path:Path):
|
|||
in
|
||||
(case assoc of
|
||||
[x] => x
|
||||
| [] => error ("in get_association: no match found ("^(string_of_path (assoc_path))^")")
|
||||
| _ => error "in get_association: more than 1 match found")
|
||||
| [] => Logger.error ("in get_association: no match found ("^(string_of_path (assoc_path))^")")
|
||||
| _ => Logger.error "in get_association: more than 1 match found")
|
||||
end
|
||||
|
||||
fun get_other_associationends (all_assocs:association list) (assoc_path:Path)
|
||||
|
@ -194,7 +193,7 @@ fun transformAggregation (allClassifiers,allAssociations) =
|
|||
fun transformQualifiers ((allClassifiers,allAssociations):transform_model):
|
||||
transform_model =
|
||||
let
|
||||
val _ = trace function_calls "transformQualifiers\n"
|
||||
val _ = Logger.debug2 "transformQualifiers\n"
|
||||
(* connects the dummy class to the new qualifier classes *)
|
||||
fun handleQualifier assocPath (role,attributes) =
|
||||
let
|
||||
|
@ -478,7 +477,7 @@ fun transformQualifiers ((allClassifiers,allAssociations):transform_model):
|
|||
fun transformNAryAssociationsToAssociationClasses (allClassifiers,
|
||||
allAssociations) =
|
||||
let
|
||||
val _ = trace function_calls "transformNAryAssociationsTo\
|
||||
val _ = Logger.debug2 "transformNAryAssociationsTo\
|
||||
\AssociationClasses\n"
|
||||
fun toAssocClass (assoc as {name,aends,qualifiers,aclass=NONE}) =
|
||||
let
|
||||
|
@ -528,7 +527,7 @@ fun transformAssociationClassIntoClass (AssociationClass
|
|||
fun transformAssociationClassesToNAryAssociations (allClassifiers,
|
||||
allAssociations) =
|
||||
let
|
||||
val _ = trace function_calls "transformAssociationClassesTo\
|
||||
val _ = Logger.debug2 "transformAssociationClassesTo\
|
||||
\NAryAssociations\n"
|
||||
fun morph {name,aends,qualifiers,aclass} class =
|
||||
let
|
||||
|
@ -583,7 +582,7 @@ fun generalTransfromNAryAssociation dummy (association as {name,aends,
|
|||
aclass=NONE},
|
||||
(classifiers,processedAssocs)) =
|
||||
let
|
||||
val _ = trace function_calls "generalTransformNAryAssociation\n"
|
||||
val _ = Logger.debug2 "generalTransformNAryAssociation\n"
|
||||
fun modifyClassifier ((assocs,classifier),classifiers) =
|
||||
let
|
||||
val ([cls],rem) = List.partition (fn x => name_of x =
|
||||
|
@ -655,7 +654,7 @@ fun generalTransfromNAryAssociation dummy (association as {name,aends,
|
|||
*)
|
||||
fun transformAssociationClasses (allClassifiers,allAssociations) =
|
||||
let
|
||||
val _ = trace function_calls "transformAssociationClasses\n"
|
||||
val _ = Logger.debug2 "transformAssociationClasses\n"
|
||||
fun transformAssociationClass ({name,aends,qualifiers=[],
|
||||
aclass=SOME aClass},
|
||||
(classifiers,procAssocs)) =
|
||||
|
@ -699,7 +698,7 @@ fun transformAssociationClasses (allClassifiers,allAssociations) =
|
|||
*)
|
||||
fun transformNAryAssociations (allClassifiers,allAssociations) =
|
||||
let
|
||||
val _ = trace function_calls "transformNAryAssociations\n"
|
||||
val _ = Logger.debug2 "transformNAryAssociations\n"
|
||||
fun transformNAryAssociation (association,(classifiers,procAssocs)) =
|
||||
generalTransfromNAryAssociation
|
||||
(newDummyClass (package_of_association association))
|
||||
|
@ -723,7 +722,7 @@ fun transformNAryAssociations (allClassifiers,allAssociations) =
|
|||
|
||||
fun transformMultiplicities (allClassifiers,allAssociations) =
|
||||
let
|
||||
val _ = trace function_calls "transformMultiplicities\n"
|
||||
val _ = Logger.debug2 "transformMultiplicities\n"
|
||||
fun withinBound selfVar targetType role (low,high)=
|
||||
let
|
||||
val returnType = Set targetType
|
||||
|
@ -749,7 +748,7 @@ fun transformMultiplicities (allClassifiers,allAssociations) =
|
|||
aclass=NONE},
|
||||
localClassifiers) =
|
||||
let
|
||||
val _ = trace function_calls "addMultiplicityConstraints\n"
|
||||
val _ = Logger.debug2 "addMultiplicityConstraints\n"
|
||||
val aType = type_of_aend a
|
||||
val bType = type_of_aend b
|
||||
val aPath = path_of_aend a
|
||||
|
@ -826,20 +825,11 @@ fun transformClassifiers (model:transform_model):Rep.Classifier list =
|
|||
* read and transform an .xmi file.
|
||||
* @return a list of rep classifiers, or nil in case of problems
|
||||
*)
|
||||
fun transformFile f:transform_model = (info ("opening "^f);
|
||||
fun transformFile f:transform_model = (Logger.info ("opening "^f);
|
||||
(normalize_ext o transformClassifiersExt o
|
||||
RepParser.transformXMI_ext o XmiParser.readFile) f)
|
||||
(* handle ex as (IllFormed msg) => raise ex *)
|
||||
|
||||
exception FileNotFound of string
|
||||
|
||||
fun printStackTrace e =
|
||||
let val ss = CompilerExt.exnHistory e
|
||||
in
|
||||
print_stderr ("uncaught exception " ^ (General.exnMessage e) ^ " at:\n");
|
||||
app (fn s => print_stderr ("\t" ^ s ^ "\n")) ss
|
||||
end
|
||||
|
||||
|
||||
|
||||
end
|
||||
|
|
|
@ -68,7 +68,6 @@ end
|
|||
functor SecureUML(structure Design: DESIGN_LANGUAGE):SECUREUML =
|
||||
struct
|
||||
open Rep_Helper
|
||||
open Rep_Logger
|
||||
|
||||
|
||||
structure Design : DESIGN_LANGUAGE = Design
|
||||
|
@ -170,11 +169,11 @@ fun filter_role cs = List.filter (classifier_has_stereotype "secuml.role") cs
|
|||
|
||||
|
||||
fun mkRole (C as Rep.Class c) = Rep.string_of_path (Rep.name_of C)
|
||||
| mkRole _ = error ("in mkRole: argument is not a class")
|
||||
| mkRole _ = Logger.error ("in mkRole: argument is not a class")
|
||||
|
||||
(* FIXME: handle groups also *)
|
||||
fun mkSubject (C as Rep.Class c) = User (Rep.string_of_path (Rep.name_of C))
|
||||
| mkSubject _ = error ("in mkSubject: argument is not a class")
|
||||
| mkSubject _ = Logger.error ("in mkSubject: argument is not a class")
|
||||
fun mkPermission (cs,ascs) (c as Rep.Class _) =
|
||||
let val classifiers = (Rep.connected_classifiers_of ascs c cs)
|
||||
val role_classes = List.filter (classifier_has_stereotype "secuml.role")
|
||||
|
@ -184,24 +183,24 @@ fun mkPermission (cs,ascs) (c as Rep.Class _) =
|
|||
Design.root_stereotypes)
|
||||
classifiers
|
||||
val root_resource = hd root_classes
|
||||
handle Empty => error ("in mkPermission: no root resource found "^
|
||||
handle Empty => Logger.error ("in mkPermission: no root resource found "^
|
||||
"for permission "^Rep.string_of_path (Rep.name_of c))
|
||||
val action_attributes =
|
||||
List.filter (fn x => ListEq.overlaps (#stereotypes x) (Design.action_stereotypes))
|
||||
(Rep.attributes_of c)
|
||||
handle ex => (error_msg "could not parse permission attributes"; raise ex)
|
||||
handle ex => (Logger.error "could not parse permission attributes"; raise ex)
|
||||
in
|
||||
{ name = (Rep.string_of_path (Rep.name_of c)),
|
||||
roles = (map (Rep.string_of_path o Rep.name_of) role_classes),
|
||||
(* FIXME: find attached constraints *)
|
||||
constraints = nil,
|
||||
actions = if action_attributes = []
|
||||
then error ("in mkPermission: Permission "^
|
||||
then Logger.error ("in mkPermission: Permission "^
|
||||
(Rep.string_of_path (Rep.name_of c))^
|
||||
"has no action attributes")
|
||||
else map (Design.parse_action root_resource) action_attributes }
|
||||
end
|
||||
| mkPermission _ _ = error "in mkPermission: argument is not a class"
|
||||
| mkPermission _ _ = Logger.error "in mkPermission: argument is not a class"
|
||||
|
||||
|
||||
fun mkSubjectAssignment (cs,ascs) (c as (Rep.Class _)) =
|
||||
|
@ -314,7 +313,7 @@ fun removeSecureUmlAends (Rep.Class {name=class_name,...},(assocs,removed_assocs
|
|||
* removes the classes with SecureUML stereotypes.
|
||||
*)
|
||||
fun parse (model as (cs,assocs):Rep.Model) =
|
||||
let val _ = info "parsing security configuration"
|
||||
let val _ = Logger.info "parsing security configuration"
|
||||
val non_secureumlstereotypes = List.filter (classifier_has_no_stereotype ["secuml.permission",
|
||||
"secuml.role",
|
||||
"secuml.subject",
|
||||
|
@ -400,7 +399,7 @@ fun parse (model as (cs,assocs):Rep.Model) =
|
|||
(List.filter classifier_has_parent (filter_role cs)),
|
||||
sa = map (mkSubjectAssignment model) (filter_subject cs)})
|
||||
end
|
||||
handle ex => (error_msg "in SecureUML.parse: security configuration \
|
||||
handle ex => (Logger.warn "in SecureUML.parse: security configuration \
|
||||
\could not be parsed";
|
||||
raise ex)
|
||||
|
||||
|
|
|
@ -93,29 +93,29 @@ fun check uml ocl = let
|
|||
val ocl = ModelImport.parseOCL ocl
|
||||
handle _ => []
|
||||
val OclParse = if ocl = [] then false else true
|
||||
val _ = print "### Preprocess Context List ###\n"
|
||||
val _ = Logger.info "### Preprocess Context List ###\n"
|
||||
val fixed_ocl = Preprocessor.preprocess_context_list
|
||||
ocl ((OclLibrary.oclLib)@(#1 xmi))
|
||||
handle _ => []
|
||||
val OclPreprocess = if fixed_ocl = [] then false else true
|
||||
val OclPreprocess = OclPreprocess andalso OclParse
|
||||
val _ = print "### Finished Preprocess Context List ###\n\n"
|
||||
val _ = Logger.info "### Finished Preprocess Context List ###\n\n"
|
||||
|
||||
val _ = print "### Type Checking ###\n"
|
||||
val _ = Logger.info "### Type Checking ###\n"
|
||||
val typed_cl = TypeChecker.check_context_list
|
||||
fixed_ocl (((OclLibrary.oclLib)@(#1 xmi)),#2 xmi)
|
||||
handle _ => []
|
||||
val OclTC = if typed_cl = [] then false else true
|
||||
val OclTC = OclTC andalso OclPreprocess
|
||||
val _ = print "### Finished Type Checking ###\n\n"
|
||||
val _ = Logger.info "### Finished Type Checking ###\n\n"
|
||||
|
||||
val _ = print"### Updating Classifier List ###\n"
|
||||
val _ = Logger.info "### Updating Classifier List ###\n"
|
||||
val model = Update_Model.gen_updated_classifier_list
|
||||
typed_cl ((OclLibrary.oclLib)@(#1 xmi))
|
||||
handle _ => []
|
||||
val modelUpdate = if model = [] then false else true
|
||||
val modelUpdate = modelUpdate andalso OclTC
|
||||
val _ = print "### Finished Updating Classifier List ###\n"
|
||||
val _ = Logger.info "### Finished Updating Classifier List ###\n"
|
||||
|
||||
|
||||
fun printBool b = if b then "passed" else "FAILED"
|
||||
|
@ -136,8 +136,7 @@ end
|
|||
fun main (name:string,args:(string list)) =
|
||||
let
|
||||
val prgName = (hd o rev) (String.fields (fn s => s = #"/" orelse s = #"\\") name);
|
||||
val _ = print ("Name: "^prgName^"\n");
|
||||
val _ = (Rep_Logger.log_level := 2)
|
||||
val _ = Logger.set_log_level Logger.WARN
|
||||
in
|
||||
case (prgName,args) of
|
||||
(n, []) => print_usage n
|
||||
|
|
|
@ -59,6 +59,7 @@ Group is
|
|||
contrib/HashTable.sml
|
||||
#endif
|
||||
../lib/fxp/src/fxlib.cm
|
||||
config.sml
|
||||
rep_helper.sml
|
||||
rep_logger.sml
|
||||
listeq.sml
|
||||
|
|
|
@ -241,7 +241,6 @@ structure Transform_Library:TRANSFORM_LIBRARY =
|
|||
struct
|
||||
|
||||
open Rep_Helper
|
||||
open Rep_Logger
|
||||
open StringHandling
|
||||
open Rep_OclTerm
|
||||
open Rep_OclHelper
|
||||
|
@ -522,7 +521,7 @@ fun mapCalls f [] = []
|
|||
fun updateAssociationReferences classifiers [] = classifiers
|
||||
| updateAssociationReferences classifiers updates =
|
||||
let
|
||||
val _ = trace function_calls "updateAssociationReferences\n"
|
||||
val _ = Logger.debug2 "updateAssociationReferences\n"
|
||||
|
||||
fun findNewPath oldAssoc newAssocs source path =
|
||||
let
|
||||
|
@ -613,7 +612,7 @@ fun updateAssociationReferences classifiers [] = classifiers
|
|||
|
||||
fun handleConstraint oldAssoc newAssocs (name,term) =
|
||||
let
|
||||
val _ = trace function_calls "handleConstraint\n"
|
||||
val _ = Logger.debug2 "handleConstraint\n"
|
||||
in
|
||||
(name,traverseOcl oldAssoc newAssocs term)
|
||||
end
|
||||
|
@ -661,7 +660,7 @@ fun updateAssociationReferences classifiers [] = classifiers
|
|||
|
||||
fun updateReferences ((oldAssoc,newAssocs),tmpClassifiers) =
|
||||
let
|
||||
val _ = trace function_calls "updateReferences\n"
|
||||
val _ = Logger.debug2 "updateReferences\n"
|
||||
in
|
||||
map (modifyClassifier oldAssoc newAssocs) tmpClassifiers
|
||||
end
|
||||
|
@ -742,7 +741,7 @@ fun modifyAssociationsOfClassifier (newAssociations:association list)
|
|||
fun uniquenessOclConstraint (source:Classifier)
|
||||
(associations:association list) =
|
||||
let
|
||||
val _ = trace function_calls "uniquenessOclConstraint\n"
|
||||
val _ = Logger.debug2 "uniquenessOclConstraint\n"
|
||||
fun assocAendCalls (self:OclTerm) (iter:OclTerm) {name,aends=[a,b],
|
||||
qualifiers,
|
||||
aclass} =
|
||||
|
@ -801,7 +800,7 @@ fun binaryAssociations (source:Classifier) (sourceRole:string option)
|
|||
(targetRolePairs:(Classifier*string option) list):
|
||||
(association list * associationend list)=
|
||||
let
|
||||
val _ = trace function_calls "binaryAssociations\n"
|
||||
val _ = Logger.debug2 "binaryAssociations\n"
|
||||
fun generateAssociation srcRole (target,roleOpt):
|
||||
(association * associationend)=
|
||||
let
|
||||
|
@ -839,7 +838,7 @@ fun binaryAssociations (source:Classifier) (sourceRole:string option)
|
|||
fun orderedBinaryAssociations (source:Classifier) (targets:Classifier list)
|
||||
aends: (association list * associationend list)=
|
||||
let
|
||||
val _ = trace function_calls "orderedBinaryAssociations\n"
|
||||
val _ = Logger.debug2 "orderedBinaryAssociations\n"
|
||||
|
||||
fun order [] [] = []
|
||||
| order [] (x::xs) =
|
||||
|
@ -898,7 +897,7 @@ fun fixAends source (aends:associationend list) =
|
|||
|
||||
fun multiplicityOclConstraints source multis oppAends =
|
||||
let
|
||||
val _ = trace function_calls "multiplicityOclConstraint\n"
|
||||
val _ = Logger.debug2 "multiplicityOclConstraint\n"
|
||||
fun bound set (low,high) =
|
||||
if low = high then
|
||||
ocl_eq (ocl_size set) (Literal(Int.toString high,Integer))
|
||||
|
@ -932,7 +931,7 @@ fun multiplicityOclConstraints source multis oppAends =
|
|||
*)
|
||||
fun consistencyOclConstraint source reference selfAend roles refRoles =
|
||||
let
|
||||
val _ = trace function_calls "consistencyOclConstraint\n"
|
||||
val _ = Logger.debug2 "consistencyOclConstraint\n"
|
||||
fun implies selfVar refVar {name=selfPath,aend_type=selfType,
|
||||
multiplicity,init,visibility,ordered}
|
||||
((role as {name=newPath,aend_type=newType,ordered=ord2,
|
||||
|
@ -986,7 +985,7 @@ fun splitNAryAssociation (association as {name,qualifiers,aends=[a,b],
|
|||
| splitNAryAssociation (association as {name,qualifiers,
|
||||
aends,aclass}) classifiers =
|
||||
let
|
||||
val _ = trace function_calls "splitNAryAssociation\n"
|
||||
val _ = Logger.debug2 "splitNAryAssociation\n"
|
||||
fun updateClassifier ((clsType,newAssocs),classifiers) =
|
||||
let
|
||||
val ([cls],rem) = List.partition (fn x => type_of x = clsType )
|
||||
|
|
|
@ -70,7 +70,6 @@ struct
|
|||
|
||||
(* su4sml *)
|
||||
open Rep_Core
|
||||
open Rep_Logger
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
open Rep2String
|
||||
|
|
|
@ -60,7 +60,6 @@ structure WFCPOG_Command_Query_Constraint:WFCPOG_COMMAND_QUERY_CONSTRAINT =
|
|||
struct
|
||||
|
||||
(* su4sml *)
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
|
|
|
@ -55,7 +55,6 @@ structure WFCPOG_Constructor_Constraint : WFCPOG_CONSTRUCTOR_CONSTRAINT =
|
|||
struct
|
||||
|
||||
(* SU4SML *)
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
open Rep
|
||||
open Rep_OclTerm
|
||||
|
|
|
@ -51,7 +51,6 @@ structure WFCPOG_Data_Model_Consistency_Constraint : WFCPOG_DATA_MODEL_CONSISTEN
|
|||
struct
|
||||
|
||||
(* su4sml *)
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
|
|
|
@ -57,7 +57,6 @@ structure WFCPOG_Interface_Constraint:WFCPOG_INTERFACE_CONSTRAINT =
|
|||
struct
|
||||
|
||||
(* su4sml *)
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
|
|
|
@ -99,7 +99,6 @@ struct
|
|||
|
||||
(* SU4SML *)
|
||||
open Rep_Helper
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
open Rep
|
||||
open Rep_OclType
|
||||
|
|
|
@ -69,7 +69,6 @@ struct
|
|||
|
||||
exception WFCPOG_LiskovError of string
|
||||
(* su4sml *)
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
(* open structures *)
|
||||
|
||||
(* SU4SML *)
|
||||
open Rep_Logger
|
||||
open OclLibrary
|
||||
open ModelImport
|
||||
open Rep_Core
|
||||
|
|
|
@ -49,7 +49,6 @@ struct
|
|||
|
||||
|
||||
(* SU4SML *)
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
open Rep
|
||||
open Rep_OclTerm
|
||||
|
|
|
@ -61,7 +61,6 @@ struct
|
|||
|
||||
(* su4sml *)
|
||||
open Rep_Helper
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
|
|
|
@ -249,7 +249,6 @@ end
|
|||
structure Rep_HolOcl_Helper:REP_HOLOCL_HELPER =
|
||||
struct
|
||||
open Rep_Core
|
||||
open Rep_Logger
|
||||
open Rep_OclType
|
||||
open Rep_OclTerm
|
||||
open WFCPOG_Library
|
||||
|
|
|
@ -63,7 +63,6 @@ structure WFCPOG_Taxonomy_Constraint:WFCPOG_TAXONOMY_CONSTRAINT =
|
|||
struct
|
||||
|
||||
(* su4sml *)
|
||||
open Rep_Logger
|
||||
open Rep_Core
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
|
||||
|
||||
open OclLibrary
|
||||
open Rep_Logger
|
||||
open WFCPOG
|
||||
open WFCPOG_Registry
|
||||
open WFCPOG_TestSuite
|
||||
|
|
|
@ -17,7 +17,6 @@ end
|
|||
|
||||
structure WFCPOG_TestSuite : WFCPOG_TESTSUITE =
|
||||
struct
|
||||
open Rep_Logger
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
open WFCPOG
|
||||
|
|
|
@ -73,7 +73,6 @@ struct
|
|||
|
||||
(* su4sml *)
|
||||
open Rep_Core
|
||||
open Rep_Logger
|
||||
open Rep_OclTerm
|
||||
open Rep_OclType
|
||||
open Rep2String
|
||||
|
|
|
@ -112,7 +112,6 @@ struct
|
|||
exception WFCPOG_RegistryError of string
|
||||
exception WFCPOG_MethodologyError of string
|
||||
|
||||
open Rep_Logger
|
||||
open WFCPOG
|
||||
open Datatab
|
||||
|
||||
|
|
|
@ -400,7 +400,7 @@ fun classifier_elementtype_of (Collection{elementtype,...}) = elementtype
|
|||
| classifier_elementtype_of (Set{elementtype,...}) = elementtype
|
||||
| classifier_elementtype_of (Bag{elementtype,...}) = elementtype
|
||||
| classifier_elementtype_of (OrderedSet{elementtype,...}) = elementtype
|
||||
| classifier_elementtype_of _ = Rep_Logger.error "in classifier_elementtype_of: \
|
||||
| classifier_elementtype_of _ = Logger.error "in classifier_elementtype_of: \
|
||||
\argument is not a collection value"
|
||||
|
||||
end
|
||||
|
|
|
@ -5,7 +5,8 @@
|
|||
* xmi_idtable.sml ---
|
||||
* This file is part of su4sml.
|
||||
*
|
||||
* Copyright (c) 2005-2007, ETH Zurich, Switzerland
|
||||
* Copyright (c) 2005-2007 ETH Zurich, Switzerland
|
||||
* 2008-2009 Achim D. Brucker, Germany
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
|
@ -42,7 +43,6 @@
|
|||
structure Xmi_IDTable =
|
||||
struct
|
||||
open Rep_Helper
|
||||
open Rep_Logger
|
||||
|
||||
(**
|
||||
* special keys:
|
||||
|
@ -91,85 +91,85 @@ fun next_unique_name t:string=
|
|||
Int.toString number
|
||||
)
|
||||
end
|
||||
handle Option => error ("expected UniqueName to be defined in table")
|
||||
handle Option => Logger.error ("expected UniqueName to be defined in table")
|
||||
|
||||
fun find_tagdefinition t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of TagDefinition x => x
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected TagDefinition "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected TagDefinition "^xmiid^" in table")
|
||||
|
||||
fun find_state t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of State x => x
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected State "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected State "^xmiid^" in table")
|
||||
|
||||
fun find_event t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Event x => x
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Event "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected Event "^xmiid^" in table")
|
||||
|
||||
fun find_transition t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Transition x => x
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Transition "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected Transition "^xmiid^" in table")
|
||||
|
||||
fun find_dependency t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Dependency x => x
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Dependency "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected Dependency "^xmiid^" in table")
|
||||
|
||||
fun find_generalization t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Generalization x => x
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Generalization "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected Generalization "^xmiid^" in table")
|
||||
|
||||
fun find_stereotype t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Stereotype x => x
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Stereotype "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected Stereotype "^xmiid^" in table")
|
||||
|
||||
fun find_attribute t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Attribute x => x
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Attribute "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected Attribute "^xmiid^" in table")
|
||||
|
||||
fun find_operation t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Operation x => x
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Operation "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected Operation "^xmiid^" in table")
|
||||
|
||||
fun find_type t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Type x => x
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Type "^xmiid^" in table (find_type)")
|
||||
handle Option => Logger.error ("expected Type "^xmiid^" in table (find_type)")
|
||||
|
||||
fun find_assoc t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of (Association(path,assoc)) => assoc
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Type "^xmiid^" in table (find_assocs)")
|
||||
handle Option => Logger.error ("expected Type "^xmiid^" in table (find_assocs)")
|
||||
|
||||
fun find_aend t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of (AssociationEnd(path,aend)) => aend
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected AssociationEnd "^xmiid^" in table (find_aend)")
|
||||
handle Option => Logger.error ("expected AssociationEnd "^xmiid^" in table (find_aend)")
|
||||
|
||||
fun find_variable_dec t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Variable x => x
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected VariableDeclaration "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected VariableDeclaration "^xmiid^" in table")
|
||||
|
||||
fun find_parent t xmiid = #2 (find_generalization t xmiid)
|
||||
|
||||
|
@ -177,42 +177,42 @@ fun find_package t xmiid =
|
|||
(case valOf (HashTable.find t xmiid)
|
||||
of Package path => path
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Path "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected Path "^xmiid^" in table")
|
||||
|
||||
fun path_of_classifier (Rep_OclType.Classifier x) = x
|
||||
| path_of_classifier _ = error ("path_of_classifier called on non-Classifier argument")
|
||||
| path_of_classifier _ = Logger.error ("path_of_classifier called on non-Classifier argument")
|
||||
|
||||
fun find_constraint t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Constraint c => c
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Constraint "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected Constraint "^xmiid^" in table")
|
||||
|
||||
fun find_associationend t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of AssociationEnd (path,ae) => ae
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected AssociationEnd "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected AssociationEnd "^xmiid^" in table")
|
||||
|
||||
|
||||
fun path_of_association t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Association (path,ae) => path
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Association "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected Association "^xmiid^" in table")
|
||||
|
||||
fun path_of_associationend t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of AssociationEnd (path,ae) => path
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected AssociationEnd "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected AssociationEnd "^xmiid^" in table")
|
||||
|
||||
|
||||
fun find_association t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Association (p,a) => a
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Association "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected Association "^xmiid^" in table")
|
||||
|
||||
|
||||
fun find_association_of_associationend t xmiid =
|
||||
|
@ -227,7 +227,7 @@ fun find_classifier_associations t xmiid =
|
|||
(case valOf (HashTable.find t xmiid)
|
||||
of Type(_,assocs,_,_,_) => assocs
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Association "^xmiid^" in table")
|
||||
handle Option => Logger.error ("expected Association "^xmiid^" in table")
|
||||
|
||||
fun filter_exists t cs =
|
||||
filter (fn x => Option.isSome (HashTable.find t x)) cs
|
||||
|
@ -261,12 +261,12 @@ fun filter_bodyconstraint t cs
|
|||
|
||||
fun find_classifier_entries t xmiid =
|
||||
let
|
||||
val _ = trace function_calls "Xmi_IDTable.find_classifier_entries \n"
|
||||
val _ = Logger.debug2 "Xmi_IDTable.find_classifier_entries \n"
|
||||
val res = (case valOf (HashTable.find t xmiid) of
|
||||
Type c => c
|
||||
| _ => raise Option
|
||||
) handle Option => error ("expected Classifier "^xmiid^" in table (in find_classifer_entries)")
|
||||
val _ = trace function_ends "end Xmi_IDTable.find_classifiers_entries \n"
|
||||
) handle Option => Logger.error ("expected Classifier "^xmiid^" in table (in find_classifer_entries)")
|
||||
val _ = Logger.debug2 "end Xmi_IDTable.find_classifiers_entries \n"
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -275,7 +275,7 @@ fun find_classifier_entries t xmiid =
|
|||
(case valOf (HashTable.find t xmiid)
|
||||
of Type (_,_,_,c,_) => c
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Classifier "^xmiid^" in table (in find_classifer)")
|
||||
handle Option => Logger.error ("expected Classifier "^xmiid^" in table (in find_classifer)")
|
||||
|
||||
fun exists_classifier t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
|
@ -287,19 +287,19 @@ fun find_classifierInState_classifier t cis_id =
|
|||
of ClassifierInState c => find_classifier t c
|
||||
| Type (_,_,_,c,_) => c
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected ClassifierInState "
|
||||
handle Option => Logger.error ("expected ClassifierInState "
|
||||
^cis_id^" in table")
|
||||
fun find_association_of_associationclass t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Type (_,_,ac,_,_) => ac
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected associationclass "^xmiid^" in table (in find_association_of_associationclass)")
|
||||
handle Option => Logger.error ("expected associationclass "^xmiid^" in table (in find_association_of_associationclass)")
|
||||
|
||||
fun find_activity_graph_of t xmiid =
|
||||
(case valOf (HashTable.find t xmiid)
|
||||
of Type (_,_,_,_,ag) => ag
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Classifier "^xmiid^" in table (in find_activity_graph_of)")
|
||||
handle Option => Logger.error ("expected Classifier "^xmiid^" in table (in find_activity_graph_of)")
|
||||
|
||||
|
||||
fun find_classifier_type t xmiid
|
||||
|
@ -319,20 +319,20 @@ fun find_classifier_type t xmiid
|
|||
| Rep_OclType.Set (Rep_OclType.Classifier [x]) => Rep_OclType.Set (find_classifier_type t x)
|
||||
| Rep_OclType.Bag (Rep_OclType.Classifier [x]) => Rep_OclType.Bag (find_classifier_type t x)
|
||||
| Rep_OclType.OrderedSet (Rep_OclType.Classifier [x]) => Rep_OclType.OrderedSet (find_classifier_type t x)
|
||||
| _ => error ("unexpected Classifier-Type "^xmiid^" in table")
|
||||
| _ => Logger.error ("unexpected Classifier-Type "^xmiid^" in table")
|
||||
end
|
||||
handle Option => error ("expected Classifier "^xmiid^" in table (in find_classifier_type)")
|
||||
handle Option => Logger.error ("expected Classifier "^xmiid^" in table (in find_classifier_type)")
|
||||
|
||||
|
||||
fun find_association_path t xmiid =
|
||||
case valOf (HashTable.find t xmiid) of (Association (x,xs)) => x
|
||||
| _ => raise Option
|
||||
handle Option => error ("expected Association "^xmiid^" in table (in find_association_path)")
|
||||
handle Option => Logger.error ("expected Association "^xmiid^" in table (in find_association_path)")
|
||||
|
||||
fun find_association_name t xmiid =
|
||||
case valOf (HashTable.find t xmiid) of (Association (_,{xmiid,name,connection})) => name
|
||||
| _ => raise Option
|
||||
handle Option => error ("expected Association "^xmiid^" in table (in find_association_name)")
|
||||
handle Option => Logger.error ("expected Association "^xmiid^" in table (in find_association_name)")
|
||||
|
||||
fun insert_constraint table (c:XMI.Constraint) =
|
||||
HashTable.insert table (#xmiid c, Constraint c)
|
||||
|
@ -379,7 +379,7 @@ fun insert_activity_graph table (XMI.mk_ActivityGraph ag) =
|
|||
table (context, Type (c,xs,assocs,ac,
|
||||
XMI.mk_ActivityGraph ag::ags))
|
||||
| _ => raise Option)
|
||||
handle Option => error ("expected Type "^context^" in table (insert_activity_graph)");
|
||||
handle Option => Logger.error ("expected Type "^context^" in table (insert_activity_graph)");
|
||||
List.app (insert_transition table) (#transitions ag);
|
||||
insert_state table (#top ag)
|
||||
end
|
||||
|
@ -396,13 +396,13 @@ fun insert_classifierInState table cls_id cis_id =
|
|||
(** insert an association into the hashtable *)
|
||||
fun insert_association table package_prefix (association:XMI.Association) =
|
||||
let
|
||||
val _ = trace function_calls ("Xmi_IDTable.insert_association\n")
|
||||
val _ = Logger.debug2 ("Xmi_IDTable.insert_association\n")
|
||||
val id = #xmiid association
|
||||
val name = #name association
|
||||
val path = if (isSome name) then package_prefix@[valOf name]
|
||||
else package_prefix@["association_"^(next_unique_name table)]
|
||||
val res = HashTable.insert table (id,Association(path,association))
|
||||
val _ = trace function_ends ("Xmi_IDTable.insert_association\n")
|
||||
val _ = Logger.debug2 ("Xmi_IDTable.insert_association\n")
|
||||
in
|
||||
res
|
||||
|
||||
|
@ -410,7 +410,7 @@ fun insert_association table package_prefix (association:XMI.Association) =
|
|||
|
||||
|
||||
fun insert_classifier table package_prefix class =
|
||||
let val _ = trace function_calls ("Xmi_IDTable.insert_classifier\n")
|
||||
let val _ = Logger.debug2 ("Xmi_IDTable.insert_classifier\n")
|
||||
val id = XMI.classifier_xmiid_of class
|
||||
val name = XMI.classifier_name_of class
|
||||
val path = package_prefix @ [name]
|
||||
|
@ -440,7 +440,7 @@ fun insert_classifier table package_prefix class =
|
|||
else if String.isPrefix "OrderedSet(" name
|
||||
then Rep_OclType.OrderedSet (Rep_OclType.Classifier [
|
||||
XMI.classifier_elementtype_of class])
|
||||
else error ("didn't recognize ocltype "^name)
|
||||
else Logger.error ("didn't recognize ocltype "^name)
|
||||
else Rep_OclType.Classifier path
|
||||
(* This function is called before the associations are handled, *)
|
||||
(* so we do not have to take care of them now... *)
|
||||
|
@ -464,7 +464,7 @@ fun insert_classifier table package_prefix class =
|
|||
val _ = HashTable.insert table (id,Type (ocltype,assocs,acPath,class,ag))
|
||||
in
|
||||
(case class
|
||||
of XMI.Class c => (trace function_calls "insert_classifier: Class\n";
|
||||
of XMI.Class c => (Logger.debug2 "insert_classifier: Class\n";
|
||||
List.app (insert_attribute table path) (#attributes c);
|
||||
List.app (insert_operation table path) (#operations c);
|
||||
List.app (insert_classifierInState table id) (#classifierInState c);
|
||||
|
@ -477,7 +477,7 @@ fun insert_classifier table package_prefix class =
|
|||
| XMI.Set c => (List.app (insert_operation table path) (#operations c); ())
|
||||
| XMI.Bag c => (List.app (insert_operation table path) (#operations c); ())
|
||||
| XMI.OrderedSet c => (List.app (insert_operation table path) (#operations c); ())
|
||||
| XMI.AssociationClass c => (trace function_calls "insert_classifier: AssociationClass\n";
|
||||
| XMI.AssociationClass c => (Logger.debug2 "insert_classifier: AssociationClass\n";
|
||||
List.app (insert_attribute table path) (#attributes c);
|
||||
List.app (insert_operation table path) (#operations c);
|
||||
List.app (insert_classifierInState table id) [];
|
||||
|
@ -487,7 +487,7 @@ fun insert_classifier table package_prefix class =
|
|||
| _ => ()
|
||||
)
|
||||
end
|
||||
val _ = trace function_ends ("end Xmi_IDTable.insert_classifier \n")
|
||||
val _ = Logger.debug2 ("end Xmi_IDTable.insert_classifier \n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -496,34 +496,34 @@ fun insert_classifier table package_prefix class =
|
|||
(* recursively insert mapping of xmi.id's to model elements into Hashtable *)
|
||||
fun insert_package table package_prefix (XMI.Package p) =
|
||||
let
|
||||
val _ = trace function_calls ("Xmi_IDTable.insert_package\n")
|
||||
val _ = Logger.debug2 ("Xmi_IDTable.insert_package\n")
|
||||
val full_name = package_prefix @ [#name p]
|
||||
val res =
|
||||
let
|
||||
val _ = List.app (insert_generalization table) (#generalizations p)
|
||||
val _ = trace 24 "insert_package: constraints\n"
|
||||
val _ = Logger.debug3 "insert_package: constraints\n"
|
||||
val _ = List.app (insert_constraint table) (#constraints p)
|
||||
val _ = trace 24 "insert_package: stereotypes\n"
|
||||
val _ = Logger.debug3 "insert_package: stereotypes\n"
|
||||
val _ = List.app (insert_stereotype table) (#stereotypes p)
|
||||
val _ = trace 24 "insert_package: classifiers\n"
|
||||
val _ = Logger.debug3 "insert_package: classifiers\n"
|
||||
val _ = List.app (insert_classifier table full_name) (#classifiers p)
|
||||
val _ = trace 24 "insert_package: associations\n"
|
||||
val _ = Logger.debug3 "insert_package: associations\n"
|
||||
val _ = List.app (insert_association table full_name) (#associations p)
|
||||
val _ = trace 24 "insert_package: packages\n"
|
||||
val _ = Logger.debug3 "insert_package: packages\n"
|
||||
val _ = List.app (insert_package table full_name) (#packages p)
|
||||
val _ = trace 24 "insert_package: activity_graphs\n"
|
||||
val _ = Logger.debug3 "insert_package: activity_graphs\n"
|
||||
val _ = List.app (insert_activity_graph table) (#activity_graphs p)
|
||||
val _ = trace 24 "insert_package: dependencies\n"
|
||||
val _ = Logger.debug3 "insert_package: dependencies\n"
|
||||
val _ = List.app (insert_dependency table) (#dependencies p)
|
||||
val _ = trace 24 "insert_package: tag defenitions\n"
|
||||
val _ = Logger.debug3 "insert_package: tag defenitions\n"
|
||||
val _ = List.app (insert_tagdefinition table) (#tag_definitions p)
|
||||
val _ = trace 24 "insert_package: events\n"
|
||||
val _ = Logger.debug3 "insert_package: events\n"
|
||||
val _ = List.app (insert_event table) (#events p)
|
||||
val _ = trace 24 "insert_package: insert package\n"
|
||||
val _ = Logger.debug3 "insert_package: insert package\n"
|
||||
in
|
||||
HashTable.insert table (#xmiid p,Package full_name)
|
||||
end
|
||||
val _ = trace function_ends ("Xmi_IDTable.insert_package \n")
|
||||
val _ = Logger.debug2 ("Xmi_IDTable.insert_package \n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -532,7 +532,7 @@ fun insert_package table package_prefix (XMI.Package p) =
|
|||
(* therefore we handle the top-level model seperately *)
|
||||
fun insert_model table (XMI.Package p) =
|
||||
let
|
||||
val _ = trace function_calls ("insert_model\n")
|
||||
val _ = Logger.debug2 ("insert_model\n")
|
||||
val full_name = nil
|
||||
val res =
|
||||
let
|
||||
|
@ -549,7 +549,7 @@ fun insert_model table (XMI.Package p) =
|
|||
in
|
||||
HashTable.insert table (#xmiid p,Package full_name)
|
||||
end
|
||||
val _ = trace function_ends ("Xmi_IDTable.insert_model\n")
|
||||
val _ = Logger.debug2 ("Xmi_IDTable.insert_model\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
@ -576,7 +576,7 @@ fun class_taggedvalues_of table (XMI.Class c) =
|
|||
| class_taggedvalues_of table (XMI.Primitive c) =
|
||||
map (fn x => (find_tagdefinition table (#tag_type x),#dataValue x))
|
||||
(#taggedValue c)
|
||||
| class_taggedvalues_of table _ = error "in class_taggedvalues_of: \
|
||||
| class_taggedvalues_of table _ = Logger.error "in class_taggedvalues_of: \
|
||||
\argument doesn't support tagged values"
|
||||
|
||||
|
||||
|
@ -590,7 +590,7 @@ fun class_taggedvalue_of table tag (XMI.Class c) =
|
|||
| class_taggedvalue_of table tag (XMI.Primitive c) =
|
||||
Option.map #2 ((List.find (fn (x,y) => x=tag))
|
||||
(class_taggedvalues_of table (XMI.Primitive c)))
|
||||
| class_taggedvalue_of table tag _ = error "in class_taggedvalues_of: \
|
||||
| class_taggedvalue_of table tag _ = Logger.error "in class_taggedvalues_of: \
|
||||
\argument doesn't support tagged values"
|
||||
|
||||
|
||||
|
|
|
@ -130,7 +130,7 @@ fun expression_source_of (AssociationEndCallExp{source,...}) = source
|
|||
| expression_source_of (OperationWithTypeArgExp{source,...}) = source
|
||||
| expression_source_of (IterateExp{source,...}) = source
|
||||
| expression_source_of (IteratorExp{source,...}) = source
|
||||
| expression_source_of _ = Rep_Logger.error ("expression has no source")
|
||||
| expression_source_of _ = Logger.error ("expression has no source")
|
||||
|
||||
(* from UML 1.5 Core: --------------------------------------------------------
|
||||
* A constraint is a semantic condition or restriction expressed in text.
|
||||
|
|
|
@ -5,7 +5,8 @@
|
|||
* xmi_parser.sml --- an xmi-parser for the import interface for su4sml
|
||||
* This file is part of su4sml.
|
||||
*
|
||||
* Copyright (c) 2005-2007, ETH Zurich, Switzerland
|
||||
* Copyright (c) 2005-2007 ETH Zurich, Switzerland
|
||||
* 2008-2009 Achim D. Brucker, Germany
|
||||
*
|
||||
* All rights reserved.
|
||||
*
|
||||
|
@ -44,7 +45,6 @@ structure XmiParser : sig
|
|||
end =
|
||||
struct
|
||||
open Rep_Helper
|
||||
open Rep_Logger
|
||||
open XmlTree
|
||||
open XmlTreeHelper
|
||||
|
||||
|
@ -58,7 +58,7 @@ fun bool_value_of string atts =
|
|||
let val att = value_of string atts
|
||||
in
|
||||
(valOf o Bool.fromString) att
|
||||
handle Option => error ("boolean attribute \""^string^
|
||||
handle Option => Logger.error ("boolean attribute \""^string^
|
||||
"\" has non-boolean value \""^att^
|
||||
"\" (xmi.id = "^(value_of "xmi.id" atts)^")")
|
||||
end
|
||||
|
@ -68,7 +68,7 @@ fun int_value_of string atts =
|
|||
let val att = value_of string atts
|
||||
in
|
||||
(valOf o Int.fromString) att
|
||||
handle Option => error ("integer attribute \""^string^
|
||||
handle Option => Logger.error ("integer attribute \""^string^
|
||||
"\" has non-integer value \""^att^
|
||||
"\" (xmi.id = "^(value_of "xmi.id" atts)^")")
|
||||
end
|
||||
|
@ -82,7 +82,7 @@ fun xmiidref t = t |> attributes |> value_of "xmi.idref"
|
|||
fun optional_name_or_empty atts = atts |> optional_value_of "name"
|
||||
|> get_optional_or_default ""
|
||||
|
||||
fun unknown_attribute_value atts att s = error ("attribute \""^att^
|
||||
fun unknown_attribute_value atts att s = Logger.error ("attribute \""^att^
|
||||
"\" has unknown value \""^s^
|
||||
"\" (xmi.id = "^(atts |> xmiid)^")")
|
||||
|
||||
|
@ -281,7 +281,7 @@ fun mkOCLExpression (tree as Node(("UML15OCL.Expressions.BooleanLiteralExp",
|
|||
}
|
||||
| mkOCLExpression (tree as Node(("UML15OCL.Expressions.AssociationClassCall\
|
||||
\Exp",atts),_))
|
||||
= error ("AssociationClassCallExp is not yet implemented"^some_id tree)
|
||||
= Logger.error ("AssociationClassCallExp is not yet implemented"^some_id tree)
|
||||
| mkOCLExpression (tree as Node(("UML15OCL.Expressions.VariableExp",atts),_))
|
||||
= XMI.VariableExp
|
||||
{ referredVariable = tree |> xmiidref_to
|
||||
|
@ -347,7 +347,7 @@ fun mkOCLExpression (tree as Node(("UML15OCL.Expressions.BooleanLiteralExp",
|
|||
expression_type = tree |> expression_type
|
||||
}
|
||||
| mkOCLExpression tree =
|
||||
error ("unknown OCLExpression type \""^(tagname tree)^"\""^some_id tree^
|
||||
Logger.error ("unknown OCLExpression type \""^(tagname tree)^"\""^some_id tree^
|
||||
".")
|
||||
and mkVariableDec vtree =
|
||||
let val atts = vtree |> assert "UML15OCL.Expressions.VariableDeclaration"
|
||||
|
@ -363,7 +363,7 @@ and mkVariableDec vtree =
|
|||
|> xmiidref
|
||||
}
|
||||
end
|
||||
(* handle IllFormed msg => error ("in mkVariableDec: "^msg)*)
|
||||
(* handle IllFormed msg => Logger.error ("in mkVariableDec: "^msg)*)
|
||||
|
||||
fun mkTaggedValue tree =
|
||||
let val atts = tree |> assert "UML:TaggedValue" |> attributes
|
||||
|
@ -378,7 +378,7 @@ fun mkTaggedValue tree =
|
|||
|> xmiidref
|
||||
}
|
||||
end
|
||||
(*handle IllFormed msg => error ("in mkTaggedValue: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkTaggedValue: "^msg)*)
|
||||
|
||||
fun mkAttribute tree =
|
||||
let val atts = tree |> assert "UML:Attribute" |> attributes
|
||||
|
@ -408,7 +408,7 @@ fun mkAttribute tree =
|
|||
|> map mkTaggedValue
|
||||
}
|
||||
end
|
||||
(*handle IllFormed msg => error ("in mkAttribute: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkAttribute: "^msg)*)
|
||||
|
||||
fun mkQualifier tree =
|
||||
get_maybe "UML:Attribute" tree
|
||||
|
@ -437,7 +437,7 @@ fun mkAssociationEnd association tree:XMI_Core.AssociationEnd =
|
|||
|> xmiidref
|
||||
}
|
||||
end
|
||||
(*handle IllFormed msg => error ("in mkAssociationEnd: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkAssociationEnd: "^msg)*)
|
||||
|
||||
(* This is a hack to handle the implicit association end to *)
|
||||
(* the AssociationClass itself. *)
|
||||
|
@ -478,12 +478,12 @@ fun mkAssociationFromAssociationClass tree =
|
|||
|> map (mkAssociationEnd id)
|
||||
}
|
||||
end
|
||||
(*handle IllFormed msg => error ("in mkAssociation: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkAssociation: "^msg)*)
|
||||
|
||||
|
||||
fun mkAssociation tree =
|
||||
let
|
||||
val _ = trace function_calls ("XmiParser.mkAssociation\n")
|
||||
val _ = Logger.debug2 ("XmiParser.mkAssociation\n")
|
||||
val atts = tree |> assert "UML:Association" |> attributes
|
||||
val id = atts |> xmiid
|
||||
(* FIXME: empty string is returned as (SOME "") instead of NONE *)
|
||||
|
@ -496,11 +496,11 @@ fun mkAssociation tree =
|
|||
connection = tree |> get_many "UML:Association.connection"
|
||||
|> map (mkAssociationEnd id)
|
||||
}
|
||||
val _ = trace function_ends ("end XmiParser.mkAssociation")
|
||||
val _ = Logger.debug2 ("end XmiParser.mkAssociation")
|
||||
in
|
||||
res
|
||||
end
|
||||
(* handle IllFormed msg => error ("in mkAssociation: "^msg)*)
|
||||
(* handle IllFormed msg => Logger.error ("in mkAssociation: "^msg)*)
|
||||
|
||||
val filterAssociations = filter "UML:Association"
|
||||
val filterAssociationClasses = filter "UML:AssociationClass"
|
||||
|
@ -551,7 +551,7 @@ fun mkDependency tree =
|
|||
|> xmiidref
|
||||
}
|
||||
end
|
||||
(*handle IllFormed msg => error ("in mkDependency: "^msg) *)
|
||||
(*handle IllFormed msg => Logger.error ("in mkDependency: "^msg) *)
|
||||
|
||||
fun mkConstraint tree =
|
||||
let val atts = tree |> assert "UML:Constraint" |> attributes
|
||||
|
@ -566,7 +566,7 @@ fun mkConstraint tree =
|
|||
|> mkOCLExpression
|
||||
}
|
||||
end
|
||||
(*handle IllFormed msg => error ("in mkConstraint: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkConstraint: "^msg)*)
|
||||
|
||||
|
||||
fun mkParameter tree =
|
||||
|
@ -580,7 +580,7 @@ fun mkParameter tree =
|
|||
|> get_optional_or_default ""
|
||||
}
|
||||
end
|
||||
(*handle IllFormed msg => error ("in mkParameter: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkParameter: "^msg)*)
|
||||
|
||||
fun mkOperation tree =
|
||||
let val atts = tree |> assert "UML:Operation" |> attributes
|
||||
|
@ -596,7 +596,7 @@ fun mkOperation tree =
|
|||
|> map xmiidref
|
||||
}
|
||||
end
|
||||
(*handle IllFormed msg => error ("in mkOperation: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkOperation: "^msg)*)
|
||||
|
||||
fun mkTagDefinition tree =
|
||||
let val atts = tree |> assert "UML:TagDefinition" |> attributes
|
||||
|
@ -607,14 +607,14 @@ fun mkTagDefinition tree =
|
|||
|> mkMultiplicity
|
||||
}
|
||||
end
|
||||
(*handle IllFormed msg => error ("in mkTagDefinition: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkTagDefinition: "^msg)*)
|
||||
|
||||
fun mkStereotypeR tree =
|
||||
let val atts = tree |> assert "UML:Stereotype" |> attributes
|
||||
in
|
||||
tree |> xmiidref
|
||||
end
|
||||
(*handle IllFormed msg => error ("in mkStereotype: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkStereotype: "^msg)*)
|
||||
|
||||
fun mkAction tree =
|
||||
let val atts = tree |> attributes
|
||||
|
@ -630,7 +630,7 @@ fun mkAction tree =
|
|||
body = expr_atts |> body ,
|
||||
expression = "" (* FIXME: is this even useful? *)}
|
||||
end
|
||||
(*handle IllFormed msg => error ("in mkAction: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkAction: "^msg)*)
|
||||
|
||||
(* This works for ArgoUML, i.e. 1.4 metamodels... *)
|
||||
fun mkProcedure tree =
|
||||
|
@ -644,7 +644,7 @@ fun mkProcedure tree =
|
|||
elem = "UML:TerminateAction" orelse
|
||||
elem = "UML:UninterpretedAction"
|
||||
then mkAction tree
|
||||
else error ("unknown Action type \""^elem^"\""^(some_id tree)^".")
|
||||
else Logger.error ("unknown Action type \""^elem^"\""^(some_id tree)^".")
|
||||
end
|
||||
|
||||
fun mkGuard tree =
|
||||
|
@ -662,7 +662,7 @@ fun mkGuard tree =
|
|||
expr is "UML:BooleanExpression"
|
||||
then expr_atts |> language
|
||||
else
|
||||
error ("unknown expression type \""^(tagname expr)^
|
||||
Logger.error ("unknown expression type \""^(tagname expr)^
|
||||
"\""^some_id expr^"."),
|
||||
body = if expr is "UML:BooleanExpression" then
|
||||
SOME (expr_atts |> body)
|
||||
|
@ -671,7 +671,7 @@ fun mkGuard tree =
|
|||
then SOME (mkOCLExpression expr)
|
||||
else NONE}
|
||||
end
|
||||
(*handle IllFormed msg => error ("in mkGuard: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkGuard: "^msg)*)
|
||||
|
||||
|
||||
fun mkTransition tree =
|
||||
|
@ -694,7 +694,7 @@ fun mkTransition tree =
|
|||
|> map mkTaggedValue
|
||||
}
|
||||
end
|
||||
(*handle IllFormed msg => error ("in mkTransition: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkTransition: "^msg)*)
|
||||
|
||||
|
||||
|
||||
|
@ -804,7 +804,7 @@ fun mkState tree =
|
|||
outgoing = outgoing,incoming = incoming,
|
||||
taggedValue = tagval}
|
||||
|
||||
| s => error ("unknown StateVertex type \""^s^"\""^some_id tree^".")
|
||||
| s => Logger.error ("unknown StateVertex type \""^s^"\""^some_id tree^".")
|
||||
end
|
||||
and mkStateMachine tree =
|
||||
let val atts = tree |> assert "UML:StateMachine" |> attributes
|
||||
|
@ -820,7 +820,7 @@ and mkStateMachine tree =
|
|||
|> map mkTransition
|
||||
}
|
||||
end
|
||||
(*handle IllFormed msg => error ("in mkStateMachine: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkStateMachine: "^msg)*)
|
||||
|
||||
|
||||
fun mkActivityGraph tree =
|
||||
|
@ -837,11 +837,11 @@ fun mkActivityGraph tree =
|
|||
|> map mkTransition,
|
||||
partition = nil}
|
||||
end
|
||||
(*handle IllFormed msg => error ("in mkActivityGraph: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkActivityGraph: "^msg)*)
|
||||
|
||||
fun mkClass atts tree =
|
||||
let
|
||||
val _ = trace function_calls ("XmiParser.mkClass \n")
|
||||
val _ = Logger.debug2 ("XmiParser.mkClass \n")
|
||||
val res = XMI.Class
|
||||
{ xmiid = atts |> xmiid,
|
||||
name = atts |> name,
|
||||
|
@ -876,17 +876,17 @@ fun mkClass atts tree =
|
|||
|> filter "UML:ActivityGraph"
|
||||
|> map mkActivityGraph
|
||||
}
|
||||
val _ = trace function_ends ("end XmiParser.mkClass \n")
|
||||
val _ = Logger.debug2 ("end XmiParser.mkClass \n")
|
||||
in
|
||||
res
|
||||
end
|
||||
(*handle IllFormed msg => error ("Error in mkClass "^(name atts)^
|
||||
(*handle IllFormed msg => Logger.error ("Error in mkClass "^(name atts)^
|
||||
": "^msg)*)
|
||||
|
||||
(* extended to match Rep.AssociationClass *)
|
||||
fun mkAssociationClass atts tree =
|
||||
let
|
||||
val _ = trace function_calls ("XmiParser.mkAssociationClass\n")
|
||||
val _ = Logger.debug2 ("XmiParser.mkAssociationClass\n")
|
||||
val id = atts |> xmiid
|
||||
val res = XMI.AssociationClass
|
||||
{ xmiid = id,
|
||||
|
@ -926,12 +926,12 @@ fun mkAssociationClass atts tree =
|
|||
*)connection = tree |> get_many "UML:Association.connection"
|
||||
|> map (mkAssociationEnd id)
|
||||
}
|
||||
val _ = trace function_ends ("end XmiParser.mkAssociation Class\n")
|
||||
val _ = Logger.debug2 ("end XmiParser.mkAssociation Class\n")
|
||||
in
|
||||
res
|
||||
end
|
||||
|
||||
(*handle IllFormed msg => error ("in mkAssociationClass: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkAssociationClass: "^msg)*)
|
||||
|
||||
|
||||
fun mkPrimitive atts tree
|
||||
|
@ -948,7 +948,7 @@ fun mkPrimitive atts tree
|
|||
taggedValue = tree |> get "UML:ModelElement.taggedValue"
|
||||
|> map mkTaggedValue
|
||||
}
|
||||
(* handle IllFormed msg => error ("in mkPrimitive: "^msg)*)
|
||||
(* handle IllFormed msg => Logger.error ("in mkPrimitive: "^msg)*)
|
||||
|
||||
fun mkInterface atts tree
|
||||
= XMI.Interface
|
||||
|
@ -966,12 +966,12 @@ fun mkInterface atts tree
|
|||
supplierDependency = tree |> get "UML:ModelElement.supplierDependency"
|
||||
|> map xmiidref
|
||||
}
|
||||
(*handle IllFormed msg => error ("in mkInterface: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkInterface: "^msg)*)
|
||||
|
||||
fun mkEnumerationLiteral tree =
|
||||
tree |> assert "UML:EnumerationLiteral"
|
||||
|> attributes |> name
|
||||
(*handle IllFormed msg => error ("in mkOperation: "^msg)*)
|
||||
(*handle IllFormed msg => Logger.error ("in mkOperation: "^msg)*)
|
||||
|
||||
|
||||
fun mkEnumeration atts tree
|
||||
|
@ -988,12 +988,12 @@ fun mkEnumeration atts tree
|
|||
literals = tree |> get "UML:Enumeration.literal"
|
||||
|> map mkEnumerationLiteral
|
||||
}
|
||||
(* handle IllFormed msg => error ("in mkEnumeration: "^msg)*)
|
||||
(* handle IllFormed msg => Logger.error ("in mkEnumeration: "^msg)*)
|
||||
|
||||
fun mkVoid atts tree = XMI.Void { xmiid = atts |> xmiid,
|
||||
name = atts |> name
|
||||
}
|
||||
(* handle IllFormed msg => error ("in mkVoid: "^msg)*)
|
||||
(* handle IllFormed msg => Logger.error ("in mkVoid: "^msg)*)
|
||||
|
||||
|
||||
fun mkGenericCollection atts tree =
|
||||
|
@ -1007,7 +1007,7 @@ fun mkGenericCollection atts tree =
|
|||
elementtype = tree |> get_one "OCL.Types.CollectionType.elementType"
|
||||
|> xmiidref
|
||||
}
|
||||
(* handle IllFormed msg => error ("in mkGenericCollection: "^msg) *)
|
||||
(* handle IllFormed msg => Logger.error ("in mkGenericCollection: "^msg) *)
|
||||
|
||||
|
||||
fun mkCollection atts tree = XMI.Collection (mkGenericCollection atts tree)
|
||||
|
@ -1027,7 +1027,7 @@ fun mkStereotype tree =
|
|||
stereotypeConstraint = NONE (* FIXME, not supported by ArgoUML 0.22 *)
|
||||
}
|
||||
end
|
||||
(* handle IllFormed msg => error ("in mkStereotype: "^msg)*)
|
||||
(* handle IllFormed msg => Logger.error ("in mkStereotype: "^msg)*)
|
||||
|
||||
|
||||
fun mkClassifier tree =
|
||||
|
@ -1047,7 +1047,7 @@ fun mkClassifier tree =
|
|||
| "UML15OCL.Types.SetType" => mkSet atts tree
|
||||
| "UML15OCL.Types.BagType" => mkBag atts tree
|
||||
| "UML15OCL.Types.OrderedSetType" => mkOrderedSet atts tree
|
||||
| _ => error ("unknown Classifier type \""^elem^
|
||||
| _ => Logger.error ("unknown Classifier type \""^elem^
|
||||
"\""^some_id tree^".")
|
||||
end
|
||||
|
||||
|
@ -1088,7 +1088,7 @@ fun mkEvent tree =
|
|||
in
|
||||
case elem of "UML:CallEvent" => mkCallEvent atts tree
|
||||
| "UML:SignalEvent" => mkSignalEvent atts tree
|
||||
| _ => error ("unknown Event type \""^elem^"\""^some_id tree^".")
|
||||
| _ => Logger.error ("unknown Event type \""^elem^"\""^some_id tree^".")
|
||||
end
|
||||
|
||||
|
||||
|
@ -1099,8 +1099,8 @@ fun mkPackage tree =
|
|||
then let val trees = tree |> get "UML:Namespace.ownedElement"
|
||||
val atts = attributes tree
|
||||
val package_name = atts |> name
|
||||
val _ = if tree is "UML:Model" then info ("parsing model "^package_name)
|
||||
else info ("parsing package "^package_name)
|
||||
val _ = if tree is "UML:Model" then Logger.info ("parsing model "^package_name)
|
||||
else Logger.info ("parsing package "^package_name)
|
||||
in
|
||||
XMI.Package
|
||||
{ xmiid = atts |> xmiid,
|
||||
|
@ -1128,7 +1128,7 @@ fun mkPackage tree =
|
|||
events = trees |> filterEvents |> map mkEvent
|
||||
}
|
||||
end
|
||||
else error "no UML:Model or UML:Package found"
|
||||
else Logger.error "no UML:Model or UML:Package found"
|
||||
|
||||
|
||||
fun mkXmiContent tree =
|
||||
|
@ -1154,10 +1154,10 @@ val emptyXmiContent = { packages = nil,
|
|||
state_machines = nil}
|
||||
|
||||
fun findXmiContent tree = valOf (dfs "XMI.content" tree)
|
||||
handle Option => error "no XMI.content found"
|
||||
handle Option => Logger.error "no XMI.content found"
|
||||
|
||||
fun readFile f = (mkXmiContent o findXmiContent o XmlTreeParser.readFile) f
|
||||
handle ex => (error_msg ("Error during parsing of "^f^": \n\t"^General.exnMessage ex);
|
||||
handle ex => (Logger.warn ("Error during parsing of "^f^": \n\t"^General.exnMessage ex);
|
||||
raise ex)
|
||||
end
|
||||
|
||||
|
|
|
@ -201,7 +201,7 @@ and StateMachine = mk_StateMachine of
|
|||
transitions : Transition list}
|
||||
|
||||
fun state_type_of (ObjectFlowState{type_,...}) = type_
|
||||
| state_type_of _ = Rep_Logger.error "in state_type_of: argument is not an ObjectFlow state"
|
||||
| state_type_of _ = Logger.error "in state_type_of: argument is not an ObjectFlow state"
|
||||
|
||||
fun state_entry_of (CompositeState{entry,...}) = entry
|
||||
| state_entry_of (SubactivityState{entry,...}) = entry
|
||||
|
@ -209,7 +209,7 @@ fun state_entry_of (CompositeState{entry,...}) = entry
|
|||
| state_entry_of (ActionState{entry,...}) = entry
|
||||
| state_entry_of (ObjectFlowState{entry,...}) = entry
|
||||
| state_entry_of (FinalState{entry,...}) = entry
|
||||
| state_entry_of _ = Rep_Logger.error "in state_entry_of: argument does not have entry actions"
|
||||
| state_entry_of _ = Logger.error "in state_entry_of: argument does not have entry actions"
|
||||
|
||||
fun state_xmiid_of (CompositeState{xmiid,...}) = xmiid
|
||||
| state_xmiid_of (SubactivityState{xmiid,...}) = xmiid
|
||||
|
@ -231,7 +231,7 @@ fun state_name_of (CompositeState{name,...}) = name
|
|||
|
||||
fun state_subvertices_of (CompositeState{subvertex,...}) = subvertex
|
||||
| state_subvertices_of (SubactivityState{subvertex,...}) = subvertex
|
||||
| state_subvertices_of _ = Rep_Logger.error "in state_subvertices_of: argument is \
|
||||
| state_subvertices_of _ = Logger.error "in state_subvertices_of: argument is \
|
||||
\not a composite state"
|
||||
|
||||
fun state_outgoing_trans_of (CompositeState{outgoing,...}) = outgoing
|
||||
|
@ -241,7 +241,7 @@ fun state_outgoing_trans_of (CompositeState{outgoing,...}) = outgoing
|
|||
| state_outgoing_trans_of (ObjectFlowState{outgoing,...}) = outgoing
|
||||
| state_outgoing_trans_of (PseudoState{outgoing,...}) = outgoing
|
||||
| state_outgoing_trans_of (SyncState{outgoing,...}) = outgoing
|
||||
| state_outgoing_trans_of (FinalState _) = Rep_Logger.error "in state_outgoing_trans_of: \
|
||||
| state_outgoing_trans_of (FinalState _) = Logger.error "in state_outgoing_trans_of: \
|
||||
\argument is a final state"
|
||||
|
||||
fun state_incoming_trans_of (CompositeState{incoming,...}) = incoming
|
||||
|
|
|
@ -57,7 +57,6 @@ structure XmlTree : sig
|
|||
val value_of : string -> Attribute list -> string
|
||||
val has_attribute : string -> Tree -> bool
|
||||
end = struct
|
||||
open Rep_Logger
|
||||
infix 1 |>
|
||||
|
||||
(** A name-value pair. *)
|
||||
|
@ -80,19 +79,19 @@ fun tagname (Node ((elem,atts),trees)) = elem
|
|||
| tagname (Text _) = ""
|
||||
|
||||
fun text (Text s) = s
|
||||
| text x = error ("in XmlTree.text: argument is a Node element (<"^tagname x^">).")
|
||||
| text x = Logger.error ("in XmlTree.text: argument is a Node element (<"^tagname x^">).")
|
||||
|
||||
fun attributes (Node ((elem,atts),trees)) = atts
|
||||
| attributes _ = error "in attributes_of: argument is a Text-Node"
|
||||
| attributes _ = Logger.error "in attributes_of: argument is a Text-Node"
|
||||
|
||||
fun children (Node ((elem,atts),trees)) = trees
|
||||
| children _ = error "in XmlTree.children: argument is a Text-Node"
|
||||
| children _ = Logger.error "in XmlTree.children: argument is a Text-Node"
|
||||
|
||||
fun node_children (Node ((elem,atts),trees)) = filter_nodes trees
|
||||
| node_children _ = error "in XmlTree.node_children: argument is a Text-Node"
|
||||
| node_children _ = Logger.error "in XmlTree.node_children: argument is a Text-Node"
|
||||
|
||||
fun text_children (Node ((elem,atts),trees)) = filter_text trees
|
||||
| text_children _ = error "in XmlTree.text_children: argument is a Text-Node"
|
||||
| text_children _ = Logger.error "in XmlTree.text_children: argument is a Text-Node"
|
||||
|
||||
|
||||
fun optional_value_of string atts = Option.map #2 (List.find (fn (x,_) => x = string) atts)
|
||||
|
@ -102,6 +101,6 @@ fun has_attribute string tree = Option.isSome (optional_value_of string (attribu
|
|||
|
||||
|
||||
fun value_of string atts = valOf (optional_value_of string atts)
|
||||
handle Option => error ("in XmlTree.value_of: argument has no attribute "^string)
|
||||
handle Option => Logger.error ("in XmlTree.value_of: argument has no attribute "^string)
|
||||
|
||||
end
|
||||
|
|
|
@ -68,7 +68,6 @@ structure XmlTreeHelper : sig
|
|||
end =
|
||||
struct
|
||||
open Rep_Helper
|
||||
open Rep_Logger
|
||||
open XmlTree
|
||||
|
||||
infix 1 |>
|
||||
|
@ -80,7 +79,7 @@ fun filter_children string tree = filter string (node_children tree)
|
|||
fun find_some string trees = (List.find (fn x => string = tagname x) trees)
|
||||
|
||||
fun find string trees = valOf (List.find (fn x => string = tagname x) trees)
|
||||
handle Option => error ("in XmlTree.find: no element "^string)
|
||||
handle Option => Logger.error ("in XmlTree.find: no element "^string)
|
||||
|
||||
|
||||
fun some_id' atts = let val xmiid = atts |> optional_value_of "xmi.id"
|
||||
|
@ -100,10 +99,10 @@ fun some_id' atts = let val xmiid = atts |> optional_value_of "xmi.id"
|
|||
fun some_id tree = some_id' (attributes tree)
|
||||
|
||||
fun value_of string atts = XmlTree.value_of string atts
|
||||
handle ex => error ((General.exnMessage ex)^(some_id' atts))
|
||||
handle ex => Logger.error ((General.exnMessage ex)^(some_id' atts))
|
||||
|
||||
fun find_child string tree = find string (node_children tree)
|
||||
handle ex => error ((General.exnMessage ex)^" inside node "^(tagname tree)^(some_id tree)^"\n")
|
||||
handle ex => Logger.error ((General.exnMessage ex)^" inside node "^(tagname tree)^(some_id tree)^"\n")
|
||||
|
||||
fun dfs string tree = if tagname tree = string
|
||||
then SOME tree
|
||||
|
@ -126,7 +125,7 @@ fun skipM string tree = if has_child string tree
|
|||
fun is (tree,string) = string = tagname tree
|
||||
infix 2 is
|
||||
fun assert string tree = if tree is string then tree
|
||||
else error ("expected "^string^" but found "^
|
||||
else Logger.error ("expected "^string^" but found "^
|
||||
(tagname tree)^(some_id tree)^"\n")
|
||||
|
||||
(* navigate to association ends with multiplicity 1..* *)
|
||||
|
|
|
@ -41,7 +41,7 @@
|
|||
|
||||
structure XmlTreeHooks : Hooks =
|
||||
struct
|
||||
open IgnoreHooks XmlTree UniChar HookData Rep_Logger
|
||||
open IgnoreHooks XmlTree UniChar HookData
|
||||
|
||||
type AppData = Dtd.Dtd * Tree list * (Tag * Tree list) list
|
||||
type AppFinal = Tree
|
||||
|
@ -71,7 +71,7 @@ fun hookStartTag ((dtd,content, stack), (_,elem,atts,_,empty)) =
|
|||
else (dtd,nil,((elemName,attNames),content)::stack)
|
||||
end
|
||||
|
||||
fun hookEndTag ((dtd,_,nil),_) = error "in hookEndTag: illformed XML"
|
||||
fun hookEndTag ((dtd,_,nil),_) = Logger.error "in hookEndTag: illformed XML"
|
||||
| hookEndTag ((dtd,content,(tag,content')::stack),_) =
|
||||
(dtd,Node (tag,rev content)::content',stack)
|
||||
|
||||
|
@ -85,7 +85,7 @@ fun hookCharRef ((dtd,content,stack),(_,c,_)) = (* FIX *)
|
|||
(dtd,content,stack)
|
||||
|
||||
fun hookFinish (dtd,[elem],nil) = elem
|
||||
| hookFinish _ = error "in hookFinish: illformed XML"
|
||||
| hookFinish _ = Logger.error "in hookFinish: illformed XML"
|
||||
|
||||
|
||||
fun print_message (pos,msg) =
|
||||
|
|
|
@ -43,7 +43,6 @@ structure XmlTreeParser : sig
|
|||
val readFile : string -> XmlTree.Tree
|
||||
end =
|
||||
struct
|
||||
open Rep_Logger
|
||||
open XmlTree
|
||||
exception FileNotFound of string
|
||||
|
||||
|
@ -57,13 +56,13 @@ fun readFile filename =
|
|||
|
||||
(* how to do the following in a clean/portable way? *)
|
||||
fun read_dtd dtd =
|
||||
(OS.FileSys.chDir (su4sml_home());
|
||||
(OS.FileSys.chDir (Config.su4sml_home());
|
||||
(* check to see if the DTD file exists. *)
|
||||
if OS.FileSys.access ("UML15OCL.xmi",[]) then
|
||||
(Parser.parseDocument
|
||||
(SOME (Uri.String2Uri ("file:UML15OCL.xmi")))
|
||||
(SOME dtd) (dtd,nil,nil))
|
||||
else error ("Error while reading file UML15OCL.xmi: "^
|
||||
else Logger.error ("Error while reading file UML15OCL.xmi: "^
|
||||
"no such file or directory");
|
||||
OS.FileSys.chDir currentDir)
|
||||
|
||||
|
@ -79,7 +78,7 @@ fun readFile filename =
|
|||
(SOME (Uri.String2Uri filename))
|
||||
(SOME dtd) (dtd,nil,nil)
|
||||
end
|
||||
handle ex => (error_msg ("Error while reading file " ^filename^": "^
|
||||
handle ex => (Logger.warn ("Error while reading file " ^filename^": "^
|
||||
General.exnMessage ex);
|
||||
raise ex)
|
||||
|
||||
|
|
Loading…
Reference in New Issue