(*****************************************************************************
 * 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
 
