819 lines
39 KiB
Standard ML
819 lines
39 KiB
Standard ML
(*****************************************************************************
|
|
* su4sml --- an SML repository for managing (Secure)UML/OCL models
|
|
* http://projects.brucker.ch/su4sml/
|
|
*
|
|
* type_checker.sml ---
|
|
* This file is part of su4sml.
|
|
*
|
|
* Copyright (c) 2005-2007 ETH Zurich, Switzerland
|
|
* 2008-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 TYPECHECKER =
|
|
sig
|
|
exception TC_wrongCollectionLiteral of Rep_OclTerm.OclTerm * string
|
|
exception TC_CollectionRangeError of Rep_OclTerm.CollectionPart * string
|
|
exception TC_IteratorTypeMismatch of Rep_OclTerm.OclTerm * string
|
|
exception TC_NoSuchIteratorNameError of Rep_OclTerm.OclTerm * string
|
|
exception TC_TypeCheckerResolveIfError of Rep_OclTerm.OclTerm * string
|
|
exception TC_NotYetSupportedError of string
|
|
exception TC_WrongContextChecked of Context.context
|
|
exception TC_ContextNotDefined of Context.context
|
|
exception TC_RootError of string
|
|
(* exception TC_AsSetError of (Rep_OclTerm.OclTerm * string list * int *
|
|
* (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list * Rep_Core.transform_model)
|
|
* exception TC_DesugaratorCall of (Rep_OclTerm.OclTerm * string list * int *
|
|
* (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list * Rep_Core.transform_model) *)
|
|
exception TC_IterateError of string
|
|
exception TC_IterateAccumulatorTypeError of string
|
|
exception TC_IterateTypeMismatch of string
|
|
exception TC_NoSuchAttributeError of string
|
|
exception TC_NoSuchOperationError of string
|
|
exception TC_OperationWithTypeError of string
|
|
|
|
val check_context_list : Context.context list -> Rep_Core.transform_model -> Context.context option list
|
|
val check_context : Context.context -> Rep_Core.transform_model -> Context.context option
|
|
val resolve_OclTerm : Rep_OclTerm.OclTerm -> Rep_Core.transform_model -> Rep_OclTerm.OclTerm
|
|
val resolve_CollectionPart : Rep_Core.transform_model -> Rep_OclTerm.CollectionPart -> Rep_OclTerm.CollectionPart
|
|
val resolve_arguments : (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list
|
|
-> Rep_Core.transform_model -> (Rep_OclTerm.OclTerm * Rep_OclType.OclType) list
|
|
end
|
|
|
|
structure TypeChecker:TYPECHECKER =
|
|
struct
|
|
|
|
open Rep_Core
|
|
open Rep_OclTerm
|
|
open Rep_OclType
|
|
open Context
|
|
open RepParser
|
|
open XMI_DataTypes
|
|
open Preprocessor
|
|
open OclLibrary
|
|
open Ocl2String
|
|
|
|
type operation = Rep_Core.operation
|
|
type attribute = Rep_Core.attribute
|
|
|
|
exception TC_ContextNotDefined of Context.context
|
|
exception TC_RootError of string
|
|
exception TC_wrongCollectionLiteral of Rep_OclTerm.OclTerm * string
|
|
exception TC_CollectionRangeError of Rep_OclTerm.CollectionPart * string
|
|
exception TC_IteratorTypeMismatch of Rep_OclTerm.OclTerm * string
|
|
exception TC_NoSuchIteratorNameError of Rep_OclTerm.OclTerm * string
|
|
exception TC_TypeCheckerResolveIfError of Rep_OclTerm.OclTerm * string
|
|
exception TC_NotYetSupportedError of string
|
|
exception TC_WrongContextChecked of context
|
|
exception TC_AsSetError of (OclTerm * string list * int * (OclTerm * OclType) list * Rep_Core.transform_model)
|
|
exception TC_DesugaratorCall of (OclTerm * string list * int * (OclTerm * OclType) list * Rep_Core.transform_model)
|
|
exception TC_IterateError of string
|
|
exception TC_IterateAccumulatorTypeError of string
|
|
exception TC_IterateTypeMismatch of string
|
|
exception TC_NoSuchAttributeError of string
|
|
exception TC_NoSuchOperationError of string
|
|
exception TC_OperationWithTypeError of string
|
|
(* RETURN: bool *)
|
|
fun check_argument_type [] [] = true
|
|
| check_argument_type [x] [] = false
|
|
| check_argument_type [] [x] = false
|
|
| check_argument_type list [] = false
|
|
| check_argument_type [] list = false
|
|
| check_argument_type [(term,typ1:OclType)] [(string,typ2:OclType)] =
|
|
if (typ1 = typ2) then
|
|
true
|
|
else
|
|
false
|
|
| check_argument_type ((term,typ1)::sig_tail1) ((string,typ2)::sig_tail2) =
|
|
if (typ1 = typ2) then
|
|
(check_argument_type sig_tail1 sig_tail2)
|
|
else false
|
|
|
|
|
|
|
|
(* RETURN: OclTerm (OperationCall/AttributeCall) *)
|
|
fun FromSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs):Rep_Core.transform_model) =
|
|
if (attr_or_meth = 0)
|
|
then (* OperationCall *)
|
|
let
|
|
(* check 'fromSet' *)
|
|
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
|
|
val ops = get_overloaded_methods class (List.last path) model
|
|
in
|
|
if (List.length ops = 0)
|
|
then raise UpcastingError ("FromSet no operation/attribute found.")
|
|
else
|
|
let
|
|
val insert_term = upcast_op ops (Variable iterVar) rargs model
|
|
val it_type = type_of_term insert_term
|
|
in
|
|
Iterator ("collect",[iterVar],rterm,type_of_term rterm,insert_term,it_type,it_type)
|
|
end
|
|
end
|
|
else (* AttributeCall *)
|
|
let
|
|
(* check 'fromSet' *)
|
|
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
|
|
val attrs_or_assocs = get_overloaded_attrs_or_assocends class (List.last path) model
|
|
in
|
|
if (List.length attrs_or_assocs = 0)
|
|
then raise UpcastingError ("Attribute '" ^ (List.last path) ^ "' does not exist ...")
|
|
else
|
|
let
|
|
val insert_term = upcast_att_aend attrs_or_assocs (Variable iterVar) model
|
|
val it_type = type_of_term insert_term
|
|
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 *)
|
|
|
|
in
|
|
case (List.hd attrs_or_assocs) of
|
|
(* AttributeCall *)
|
|
(x,SOME(shit),NONE) =>
|
|
let
|
|
val ret_type = substitute_templ_para (type_of_term rterm) it_type
|
|
in
|
|
Iterator ("collect",[iterVar],rterm,type_of_term rterm,insert_term,it_type,ret_type)
|
|
end
|
|
(* AssociatonCall *)
|
|
| (x,NONE,SOME(shit)) =>
|
|
if (isColl_Type it_type)
|
|
then
|
|
let
|
|
val ret_type = substitute_templ_para (type_of_term rterm) (type_of_template_parameter it_type)
|
|
in
|
|
Iterator("collect",[iterVar],rterm,type_of_term rterm,insert_term,it_type,ret_type)
|
|
end
|
|
else
|
|
let
|
|
val ret_type = substitute_templ_para (type_of_term rterm) it_type
|
|
in
|
|
Iterator("collect",[iterVar],rterm,type_of_term rterm,insert_term,it_type,ret_type)
|
|
end
|
|
end
|
|
end
|
|
exception unkown
|
|
(* RETURN: OclTerm (OperationCall/AttributeCall) *)
|
|
fun AsSet_desugarator rterm path attr_or_meth rargs (model as (cls,assocs)) =
|
|
let
|
|
val _ = if isColl_Type (type_of_term rterm) then Logger.error "\n error in AsSet_Desugarotr\n" else ()
|
|
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 _ = Logger.debug3 ("==> AsSet-desugarator: operation ... \n")
|
|
val rtyp = Set(type_of_term rterm)
|
|
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)
|
|
in
|
|
if (List.length ops = 0)
|
|
then
|
|
raise TC_NoSuchOperationError ("interefere_methods: No operation signature "
|
|
^"for `"^(Rep_Core.string_of_path path)^"'"
|
|
^" matches given types (source: "
|
|
^(Ocl2String.ocl2string false rterm)^").")
|
|
else
|
|
upcast_op ops new_rterm rargs model
|
|
end
|
|
else (* AttributeCall *)
|
|
let
|
|
val _ = Logger.debug3 ("==> AsSet-desugarator: attribute/assocend\n")
|
|
val rtyp = Set(type_of_term rterm)
|
|
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 _ = Logger.debug3 ("'AsSetError' ... \n")
|
|
in
|
|
if (List.length attrs = 0)
|
|
then
|
|
raise TC_NoSuchAttributeError ("Attribute '" ^ (List.last path) ^ "' does not exist ...")
|
|
else
|
|
upcast_att_aend attrs new_rterm model
|
|
end
|
|
val _ = Logger.debug2 ("TypeChecker.AsSet_desugarator class= " ^ (string_of_OclType (type_of_term rterm)) ^ " , attr\n")
|
|
in
|
|
res
|
|
end
|
|
|
|
(* RETURN: OclTerm (OperationCall/AttributeCall) *)
|
|
fun desugarator rterm path attr_or_meth rargs model =
|
|
FromSet_desugarator rterm path attr_or_meth rargs model
|
|
handle UpcastingError s => AsSet_desugarator rterm path attr_or_meth rargs model
|
|
|
|
(* RETURN: CollectionPart *)
|
|
fun resolve_CollectionPart model (CollectionItem (term,typ)) =
|
|
let
|
|
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 _ = Logger.debug2 ("TypeChecker.resolve_CollectionPart " ^ (ocl2string false term) ^ "\n")
|
|
in
|
|
res
|
|
end
|
|
| resolve_CollectionPart model (CollectionRange (term1,term2,typ)) =
|
|
let
|
|
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
|
|
val rtyp2 = type_of_term rterm2
|
|
val res =
|
|
if (rtyp2 = rtyp1) then
|
|
(CollectionRange (rterm1,rterm2,rtyp1))
|
|
else
|
|
raise (TC_CollectionRangeError ((CollectionRange (term1,term2,typ)),("Begin and end of Range not of same type.")))
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_CollectionPart " ^ (ocl2string false term1) ^ "\n")
|
|
in
|
|
res
|
|
end
|
|
|
|
and resolve_CollectionLiteral (CollectionLiteral (part_list,typ)) model =
|
|
let
|
|
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 =
|
|
if (List.all (type_equals (List.hd (tlist))) tlist)
|
|
then
|
|
rpart_list
|
|
else
|
|
raise TC_wrongCollectionLiteral ((CollectionLiteral (part_list,typ)),"Not all Literals have the same type.")
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_CollectionLiteral\n ")
|
|
in
|
|
res
|
|
end
|
|
|
|
(* RETURN: OclTerm * OclType *)
|
|
and resolve_arguments [] model = []
|
|
| resolve_arguments ((term,typ)::list_tail) model =
|
|
let
|
|
val rterm = resolve_OclTerm term model
|
|
val rtyp = type_of_term rterm
|
|
in
|
|
(rterm,rtyp)::(resolve_arguments list_tail model)
|
|
end
|
|
|
|
(* RETURN: OclTerm *)
|
|
and resolve_OclTerm (Literal (s,typ)) model =
|
|
let
|
|
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 _ = Logger.debug2 ("TypeChecker.resolve_OclTerm Literal " ^ ocl2string false (Literal(s,typ)) ^ "\n")
|
|
in
|
|
res
|
|
end
|
|
(* TupleLiteral *)
|
|
| resolve_OclTerm (Tuple(x)) model =
|
|
let
|
|
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
|
|
val rtype = type_of_term rterm
|
|
in
|
|
(a,rterm,rtype)
|
|
end) x)
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
|
in
|
|
res
|
|
end
|
|
(* Variable *)
|
|
| resolve_OclTerm (Variable ("self",typ)) model =
|
|
let
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm Variable " ^ ocl2string false (Variable("self",typ)) ^ "\n")
|
|
val res = (Variable ("self",typ))
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm Variable " ^ ocl2string false (Variable("self",typ)) ^ "\n")
|
|
in
|
|
res
|
|
end
|
|
| resolve_OclTerm (Variable (name,typ)) model =
|
|
let
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm Variable " ^ ocl2string false (Variable(name,typ)) ^ "\n")
|
|
val res = Variable (name,typ)
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm Variable " ^ ocl2string false (Variable(name,typ)) ^ "\n")
|
|
in
|
|
res
|
|
end
|
|
(* AssociationEndCall *)
|
|
| resolve_OclTerm (AssociationEndCall (term,_,["self"],_)) model = (resolve_OclTerm (AttributeCall (term,OclAny,["self"],OclAny)) model)
|
|
| resolve_OclTerm (AssociationEndCall (term,_,attr_path,_)) model = (resolve_OclTerm (AttributeCall (term,OclAny,attr_path,OclAny)) model)
|
|
(* AttributeCall *)
|
|
(* self.self -> self *)
|
|
| resolve_OclTerm (AttributeCall (term,_,["self"],_)) model =
|
|
let
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, AttributeCall, self, " ^ ocl2string false term ^ "\n")
|
|
val res = (resolve_OclTerm term model)
|
|
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 _ = 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 _ = 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
|
|
if (List.hd attr_path = "arrow")
|
|
then get_attr_or_assoc rterm (List.last attr_path) model
|
|
handle UpcastingError s => AsSet_desugarator rterm (List.tl attr_path) 1 [] model
|
|
else
|
|
get_attr_or_assoc rterm (List.last attr_path) model
|
|
|
|
(* 2-dimensional inheritance of Collection types *)
|
|
handle UpcastingError s =>
|
|
(
|
|
(
|
|
let
|
|
val _ = Logger.debug3 ("==> 2-dim Inheritance check: attribute/assocend\n")
|
|
val rtyp = type_of_term rterm
|
|
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 _ = 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)
|
|
else upcast_att_aend attrs rterm model
|
|
end
|
|
)
|
|
handle TC_DesugaratorCall arg => desugarator (#1 arg) (#2 arg) (#3 arg) (#4 arg) (#5 arg)
|
|
| NoCollectionTypeError t => AsSet_desugarator rterm attr_path 1 [] model
|
|
| Empty => AsSet_desugarator rterm attr_path 1 [] model
|
|
)
|
|
end
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm \n")
|
|
in
|
|
res
|
|
end
|
|
(* built in Operations not include in Library: oclIsKindOf, oclIsTypOf, oclAsType *)
|
|
(* OperationWithType Calls *)
|
|
(* OCLISTYPEOF *)
|
|
| resolve_OclTerm (opcall as OperationCall (term,_,["oclIsTypeOf"],[(AttributeCall (source,_,[string_path], _),arg_type)],_)) (model as (cls,assocs)) =
|
|
let
|
|
fun attributes_to_path (Variable (x,y)) = []
|
|
| attributes_to_path (AttributeCall(Variable(x,y),_,[correct_package_part],res_typ)) = [correct_package_part]
|
|
| attributes_to_path (AttributeCall(term,_,[correct_package_part],res_typ)) =
|
|
(correct_package_part)::(attributes_to_path term)
|
|
(* prefix type of iterator variable *)
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, OperationCallWithType = oclIsTypeOf, " ^ ocl2string true term ^"\n")
|
|
val rterm = resolve_OclTerm term model
|
|
val _ = Logger.debug3 ("res OpCall: oclIsTypeOf 2: " ^ "\n")
|
|
val rtyp = type_of_term rterm
|
|
val _ = Logger.debug3 ("res OpCall: oclIsTypeOf 3: " ^ "\n")
|
|
val path = (attributes_to_path source)@[string_path]
|
|
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)
|
|
val _ = Logger.debug3 ("res OpCall: oclTypeOf 4:" ^ "... " ^ "\n")
|
|
val res = OperationWithType (rterm,rtyp,"oclIsTypeOf",typ,Boolean)
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
|
in
|
|
res
|
|
end
|
|
(* OCLISKINDOF *)
|
|
| resolve_OclTerm (opcall as OperationCall (term,_,["oclIsKindOf"],[(AttributeCall (source,_,[string_path], _),arg_type)],_)) (model as (cls,assocs)) =
|
|
let
|
|
fun attributes_to_path (Variable (x,y)) = []
|
|
| attributes_to_path (AttributeCall(Variable(x,y),_,[correct_package_part],res_typ)) = [correct_package_part]
|
|
| attributes_to_path (AttributeCall(term,_,[correct_package_part],res_typ)) =
|
|
(correct_package_part)::(attributes_to_path term)
|
|
(* prefix type of iterator variable *)
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, OperationCallWithType = oclIsTypeOf, " ^ ocl2string true term ^"\n")
|
|
val rterm = resolve_OclTerm term model
|
|
val _ = Logger.debug3 ("res OpCall: oclIsTypeOf 2: " ^ "\n")
|
|
val rtyp = type_of_term rterm
|
|
val _ = Logger.debug3 ("res OpCall: oclIsTypeOf 3: " ^ "\n")
|
|
val path = (attributes_to_path source)@[string_path]
|
|
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)
|
|
val _ = Logger.debug3 ("res OpCall: oclTypeOf 4:" ^ "... " ^ "\n")
|
|
val res = OperationWithType (rterm,rtyp,"oclIsKindOf",typ,Boolean)
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
|
in
|
|
res
|
|
end
|
|
(* OCLASTYPE *)
|
|
| resolve_OclTerm (opcall as OperationCall (term,_,["oclAsType"],[(AttributeCall (source,_,[string_path], _),arg_type)],_)) (model as (cls,assocs)) =
|
|
let
|
|
fun attributes_to_path (Variable (x,y)) = []
|
|
| attributes_to_path (AttributeCall(Variable(x,y),_,[correct_package_part],res_typ)) = [correct_package_part]
|
|
| attributes_to_path (AttributeCall(term,_,[correct_package_part],res_typ)) =
|
|
(correct_package_part)::(attributes_to_path term)
|
|
(* prefix type of iterator variable *)
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, OperationCallWithType = oclIsTypeOf, " ^ ocl2string true term ^"\n")
|
|
val rterm = resolve_OclTerm term model
|
|
val _ = Logger.debug3 ("res OpCall: oclIsTypeOf 2: " ^ "\n")
|
|
val rtyp = type_of_term rterm
|
|
val _ = Logger.debug3 ("res OpCall: oclIsTypeOf 3: " ^ "\n")
|
|
val path = (attributes_to_path source)@[string_path]
|
|
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)
|
|
val _ = Logger.debug3 ("res OpCall: oclTypeOf 4:" ^ "... " ^ "\n")
|
|
val res = OperationWithType (rterm,rtyp,"oclAsType",typ,typ)
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
|
in
|
|
res
|
|
end
|
|
(* HARD CODED STUFF *)
|
|
| resolve_OclTerm (OperationCall (term,typ,[OclLibPackage,"OclAny","atPre"],[],_)) model =
|
|
let
|
|
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 _ = Logger.debug3 ("res OpCall: Type of source : " ^ string_of_OclType rtyp ^ "\n")
|
|
val res = OperationCall (rterm,rtyp,[OclLibPackage,"OclAny","atPre"],[],rtyp)
|
|
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 _ = 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 _ = Logger.debug3 ("res OpCall: Type of source : " ^ string_of_OclType (type_of_term rterm) ^ "\n")
|
|
(* resolve arguments *)
|
|
val rargs = resolve_arguments args model
|
|
val _ = Logger.debug3 ("res OpCall: args resolved ...\n")
|
|
val res =
|
|
let
|
|
in
|
|
if (List.hd meth_path = "arrow")
|
|
then get_meth rterm (List.last meth_path) rargs model
|
|
handle UpcastingError s => AsSet_desugarator rterm (List.tl meth_path) 0 rargs model
|
|
else
|
|
get_meth rterm (List.last meth_path) rargs model
|
|
(* 2-dimensional inheritance of Collection types *)
|
|
handle UpcastingError s =>
|
|
(
|
|
(
|
|
let
|
|
val _ = Logger.debug3 ("==> no 2-dim Inheritance check: attribute/assocend\n")
|
|
val rtyp = type_of_term rterm
|
|
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 _ = 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 _ = 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)
|
|
else upcast_op ops rterm rargs model
|
|
end
|
|
)
|
|
handle TC_DesugaratorCall arg => desugarator (#1 arg) (#2 arg) (#3 arg) (#4 arg) (#5 arg)
|
|
| NoCollectionTypeError typ => AsSet_desugarator rterm meth_path 0 rargs model
|
|
| Empty => AsSet_desugarator rterm meth_path 0 rargs model
|
|
)
|
|
end
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
|
in
|
|
res
|
|
end
|
|
(* Iterator *)
|
|
| resolve_OclTerm (Iterator (name,iter_vars,source_term,_,expr,expr_typ,res_typ)) (model as (cls,assocs)) =
|
|
let
|
|
(* resolve source term, type *)
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, Itertor: name = " ^ name ^ "\n")
|
|
val rterm = resolve_OclTerm source_term model
|
|
val rtyp = type_of_term rterm
|
|
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 _ = 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 _ = 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 _ = 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 _ = 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 _ = Logger.debug3 ("res Iter: types conforms \n")
|
|
val bound_expr = embed_bound_variables piter_vars expr
|
|
val _ = Logger.debug3 ("res Iter: term : " ^ Ocl2String.ocl2string false bound_expr ^ "\n")
|
|
val rexpr = resolve_OclTerm bound_expr model
|
|
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
|
|
"select" =>
|
|
Iterator (name,piter_vars,rterm,rtyp,rexpr,type_of_term rexpr,rtyp)
|
|
| "reject" =>
|
|
Iterator (name,piter_vars,rterm,rtyp,rexpr,type_of_term rexpr,rtyp)
|
|
| "forAll" =>
|
|
Iterator (name,piter_vars,rterm,rtyp,rexpr,type_of_term rexpr,Boolean)
|
|
| "one" =>
|
|
Iterator (name,piter_vars,rterm,rtyp,rexpr,type_of_term rexpr,Boolean)
|
|
| "any" =>
|
|
Iterator (name,piter_vars,rterm,rtyp,rexpr,type_of_term rexpr,Boolean)
|
|
| "exists" =>
|
|
Iterator (name,piter_vars,rterm,rtyp,rexpr,type_of_term rexpr,Boolean)
|
|
| "collect" =>
|
|
Iterator (name,piter_vars,rterm,rtyp,rexpr,type_of_term rexpr,flatten_type (substitute_templ_para (rtyp) (type_of_term rexpr)))
|
|
| _ => raise TC_NoSuchIteratorNameError (Iterator (name,iter_vars,source_term,DummyT,expr,expr_typ,res_typ),("No such Iterator ..."))
|
|
)
|
|
end
|
|
else
|
|
raise TC_IteratorTypeMismatch (Iterator (name,iter_vars,source_term,DummyT,expr,expr_typ,res_typ),("Iterator variable doesn't conform to choosen set"))
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
|
in
|
|
res
|
|
end
|
|
|
|
| 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 _ = Logger.debug2 ("TypeChecker.resolve_OclTerm, Iterate: accumulator " ^ acc_var_name ^ "\n")
|
|
val rterm = resolve_OclTerm sterm model
|
|
val rtyp = type_of_term rterm
|
|
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 _ = 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 _ = 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 _ = 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 _ = 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 *)
|
|
val racc_var_term = resolve_OclTerm acc_var_term model
|
|
val racc_var_type = type_of_term racc_var_term
|
|
val res =
|
|
if (check) then
|
|
if (racc_var_type = acc_var_type) then
|
|
let
|
|
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 _ = Logger.debug2 ("myres Iterate: term : " ^ Ocl2String.ocl2string false bound_expr2 ^ "\n")
|
|
val rexpr = resolve_OclTerm bound_expr2 model
|
|
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
|
|
else
|
|
raise TC_IterateAccumulatorTypeError ("Type of accumulator does not conform to type of expression of accumulator")
|
|
else
|
|
raise TC_IterateTypeMismatch ("Iterate variables doesn't conform to choosen set")
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
|
in
|
|
res
|
|
end
|
|
| resolve_OclTerm (CollectionLiteral ([],typ)) model =
|
|
let
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm CollectionLiteral\n")
|
|
val res = CollectionLiteral ([],typ)
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
|
in
|
|
res
|
|
end
|
|
| resolve_OclTerm (CollectionLiteral (coll_parts,temp_typ)) model =
|
|
let
|
|
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 =
|
|
if (List.all (correct_type_for_CollLiteral typ) r_coll_parts) then
|
|
(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 _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
|
in
|
|
res
|
|
end
|
|
| resolve_OclTerm (Let (str,typ,rhs_term,_,in_term,_)) model =
|
|
let
|
|
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 (* TODO *) *)
|
|
|
|
val _ = Logger.debug3 ("res Iter: types conforms \n")
|
|
val bound_expr = embed_bound_variables [(str,typ)] in_term
|
|
val _ = Logger.debug3 ("res Iter: term : " ^ Ocl2String.ocl2string false bound_expr ^ "\n")
|
|
val rin_term = resolve_OclTerm bound_expr model
|
|
|
|
|
|
|
|
val rin_typ = type_of_term rin_term
|
|
val res = (Let (str,typ,rrhs_term,rrhs_typ,rin_term,rin_typ))
|
|
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 _ = Logger.debug2 ("TypeChecker.resolve_OclTerm a If-Expression \n")
|
|
val rterm = resolve_OclTerm cond_term model
|
|
val rtyp = type_of_term rterm
|
|
|
|
val rif_expr = resolve_OclTerm if_expr model
|
|
val rif_typ = type_of_term rif_expr
|
|
|
|
val relse_expr = resolve_OclTerm else_expr model
|
|
val relse_typ = type_of_term relse_expr
|
|
val res =
|
|
if (rtyp = Boolean) then
|
|
if (conforms_to rif_typ relse_typ model) then
|
|
If(rterm,rtyp,rif_expr,rif_typ,relse_expr,relse_typ,relse_typ)
|
|
else if (conforms_to relse_typ rif_typ model) then
|
|
If(rterm,rtyp,rif_expr,rif_typ,relse_expr,relse_typ,rif_typ)
|
|
else
|
|
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"))
|
|
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."))
|
|
val _ = Logger.debug2 ("TypeChecker.resolve_OclTerm\n")
|
|
in
|
|
res
|
|
end
|
|
|
|
|
|
(* RETURN: context option *)
|
|
fun check_context (Cond (path,op_name,op_sign,result_type,cond,pre_name,expr)) (model as (cls,assocs)) =
|
|
let
|
|
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
|
|
handle Option => raise TC_ContextNotDefined (Cond (path,op_name,op_sign,result_type,cond,pre_name,expr))
|
|
val check1 = (op_sign = (#arguments oper))
|
|
val check2 = (result_type = (#result oper))
|
|
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
|
|
(SOME((Cond (path,op_name,op_sign,(#result oper),cond,pre_name,resolve_OclTerm expr model))))
|
|
else
|
|
(* NONE *)
|
|
raise TC_WrongContextChecked (Cond (path,op_name,op_sign,result_type,cond,pre_name,expr))
|
|
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 _ = 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 _ = Logger.debug3 ( "classifier found ... " ^ "\n")
|
|
val attr_list = attributes_of classifier
|
|
val _ = Logger.debug3 ( "attr_list found ... " ^ "\n")
|
|
val attr = valOf (get_attribute (List.last path) attr_list)
|
|
val _ = Logger.debug3 ( "attribute found ... " ^ "\n")
|
|
val res =
|
|
if (typ = #attr_type attr)
|
|
then
|
|
let
|
|
val _ = Logger.debug3 (" ... " ^ "\n")
|
|
in
|
|
(SOME ((Attr (path,(#attr_type attr),attrorassoc,resolve_OclTerm expr model))))
|
|
end
|
|
else
|
|
(* NONE *)
|
|
raise TC_WrongContextChecked (Attr (path,typ,attrorassoc,expr))
|
|
|
|
val _ = Logger.debug2 ("TypeChecker.check_context\n\n\n")
|
|
in
|
|
res
|
|
end
|
|
| check_context (Inv (path,name,expr)) model =
|
|
let
|
|
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 _ = Logger.debug2 ("TypeChecker.check_context\n\n\n")
|
|
in
|
|
res
|
|
end
|
|
| check_context (Empty_context (s,t)) _ = raise TC_NotYetSupportedError ("Empty_context not supported.")
|
|
(* SOME (Empty_context (s,t)) *)
|
|
| check_context (Guard (path,name,expr)) _ = raise TC_NotYetSupportedError ("Guard not supported.")
|
|
(* SOME (Guard (path,name,expr)) *)
|
|
|
|
(* RETURN: (context option) list *)
|
|
fun check_context_list [] model = []
|
|
| check_context_list (h::context_list_tail) model =
|
|
((check_context h model
|
|
handle TC_wrongCollectionLiteral (term,mes) => Logger.error ("WrongCollectionLiteral: "^mes^"\n"
|
|
^" in term: "^(Ocl2String.ocl2string false term)
|
|
^" in context: "^(cxt_list2string [h]))
|
|
| TC_CollectionRangeError (part,mes) => Logger.error ("CollectionRangeError: "^mes^"\n"
|
|
^" in context: "^(cxt_list2string [h]))
|
|
| TC_IteratorTypeMismatch (term,mes) => Logger.error ("IteratorTypeMismatch: "^mes^"\n"
|
|
^" in term: "^(Ocl2String.ocl2string false term)
|
|
^" in context: "^(cxt_list2string [h]))
|
|
| TC_NoSuchIteratorNameError (term,mes) => Logger.error ("NoSuchIteratorNameError: "^mes^"\n"
|
|
^" in term: "^(Ocl2String.ocl2string false term)
|
|
^" in context: "^(cxt_list2string [h]))
|
|
| TC_TypeCheckerResolveIfError (term,mes) => Logger.error ("TypeCheckResolveIfError: "^mes^"\n"
|
|
^" in term: "^(Ocl2String.ocl2string false term)
|
|
^" in context: "^(cxt_list2string [h]))
|
|
| TC_NotYetSupportedError mes => Logger.error ("NotYetSupportedError: "^mes^"\n"
|
|
^" in context: "^(cxt_list2string [h]))
|
|
| TC_OperationWithTypeError mes => Logger.error ("OperationWithTypeError: "^mes^"\n"
|
|
^" in context: "^(cxt_list2string [h]))
|
|
| TC_NoSuchAttributeError mes => Logger.error ("NoSuchAttributeError: "^mes^"\n"
|
|
^" in context: "^(cxt_list2string [h]))
|
|
| GetClassifierError mes => Logger.error ("GetClassifierError: "^mes^"\n"
|
|
^" in context: "^(cxt_list2string [h]))
|
|
| TC_NoSuchOperationError mes => Logger.error ("NoSuchOperationError: "^mes^"\n"
|
|
^" in context: "^(cxt_list2string [h]))
|
|
| TC_ContextNotDefined h => Logger.error ("Context not defined in UML model:\n"
|
|
^(cxt_list2string [h]))
|
|
| Option => Logger.error ("hadling otpin")
|
|
)::(check_context_list context_list_tail model))
|
|
|
|
handle TC_WrongContextChecked h => Logger.error ("Unkown Error in context: "
|
|
^(cxt_list2string [h]))
|
|
| Option => Logger.error ("hadling option outer")
|
|
end
|
|
|