(***************************************************************************** * su4sml --- an SML repository for managing (Secure)UML/OCL models * http://projects.brucker.ch/su4sml/ * * ocl2string --- "pretty printing" for OCL terms * This file is part of su4sml. * * Copyright (c) 2005-2007 ETH Zurich, Switzerland * 2008 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$ *) (** "pretty printing" for OCL expressions. *) signature OCL2STRING = sig val ocl2string: bool -> Rep_OclTerm.OclTerm -> string end structure Ocl2String:OCL2STRING = struct open Rep_Helper open Rep_OclType open Rep_OclTerm fun ocl2string show_types oclterm = let fun string_of_infix show_types src styp opname arg atyp rtyp = if show_types then "(("^(ocl2string show_types src)^"):"^(string_of_OclType styp) ^" "^opname^" ("^(ocl2string show_types arg)^"):"^(string_of_OclType atyp) ^"):"^(string_of_OclType rtyp) else (ocl2string show_types src) ^" "^opname^" "^(ocl2string show_types arg) fun string_of_prefix1 show_types src styp opname rtyp = if show_types then "(("^opname^" ("^(ocl2string show_types src)^"):"^(string_of_OclType styp) ^"):"^(string_of_OclType rtyp)^")" else "("^opname^" "^(ocl2string show_types src)^")" fun string_of_oo_infix show_types src styp opname arg atyp rtyp = if show_types then "(("^(ocl2string show_types src)^"):"^(string_of_OclType styp) ^"->"^opname^"("^(ocl2string show_types arg)^"):"^(string_of_OclType atyp) ^")):"^(string_of_OclType rtyp) else (ocl2string show_types src) ^"->"^opname^"("^(ocl2string show_types arg)^")" fun string_of_oo_postfix1 show_types src styp opname rtyp = if show_types then "((("^(ocl2string show_types src)^"):"^(string_of_OclType styp) ^")->"^opname^"():"^(string_of_OclType rtyp)^")" else "("^(ocl2string show_types src)^")->"^opname^"()" fun string_of_oo_typeinfix show_types src styp opname arg rtyp = if show_types then "(("^(ocl2string show_types src)^"):"^(string_of_OclType styp) ^"->"^opname^"("^(string_of_OclType arg)^"):OclType" ^")):"^(string_of_OclType rtyp) else (ocl2string show_types src) ^"->"^opname^"("^(string_of_OclType arg)^")" fun cs_list [] = "" | cs_list [a] = a | cs_list l = foldl (fn (x,y) => (y^", "^x)) (hd l) (tl l) fun arglist show_types args = cs_list (map (fn (arg,atyp) => if show_types then "("^(ocl2string show_types arg)^"):"^(string_of_OclType atyp) else (ocl2string show_types arg)) args) fun collection_part_list show_types args = cs_list (map (fn x => case x of CollectionItem (term,typ) => ocl2string show_types term | CollectionRange (t1,t2,typ) => (ocl2string show_types t1)^".."^(ocl2string show_types t2)) args) in case oclterm of (**************************************) (* Literal *) (**************************************) (* OCL Boolean *) Literal (s, String) => if show_types then "("^s^":"^(string_of_OclType String)^")" else ""^s^"" | Literal (lit, typ) => if show_types then "("^lit^":"^(string_of_OclType typ)^")" else lit | CollectionLiteral (parts, typ as Bag x) => "Bag{"^(collection_part_list show_types parts)^"}" | CollectionLiteral (parts, typ as Set x) => "Set{"^(collection_part_list show_types parts)^"}" | CollectionLiteral (parts, typ as OrderedSet x) => "OrderedSet{"^(collection_part_list show_types parts)^"}" | CollectionLiteral (parts, typ as Sequence x) => "Sequence{"^(collection_part_list show_types parts)^"}" | CollectionLiteral (parts, typ as Collection x) => "Collection{"^(collection_part_list show_types parts)^"}" | If (cterm,ctyp, tterm,ttyp,eterm,etyp,iftyp) => if show_types then "(if ("^(ocl2string show_types cterm)^":"^(string_of_OclType ctyp) ^") then ("^(ocl2string show_types tterm)^":"^(string_of_OclType ttyp) ^") else ("^(ocl2string show_types eterm)^":"^(string_of_OclType etyp) ^") endif:"^(string_of_OclType iftyp)^")" else "if "^(ocl2string show_types cterm) ^" then "^(ocl2string show_types tterm) ^" else "^(ocl2string show_types eterm)^" endif" | AssociationEndCall(src,styp,path,ptyp) => if show_types then "(("^(ocl2string show_types src)^":"^(string_of_OclType styp)^")." ^(hd (rev path))^":"^(string_of_OclType ptyp)^")" else (ocl2string show_types src)^"."^(hd (rev path)) | AttributeCall(src,styp,path,ptyp) => if show_types then "(("^(ocl2string show_types src)^":"^(string_of_OclType styp)^")." ^(hd (rev path))^":"^(string_of_OclType ptyp)^")" else (ocl2string show_types src)^"."^(hd (rev path)) (**************************************) (* HOL-HOL Extensions *) (**************************************) | OperationCall (src,styp,["holOclLib","Boolean","implies"],[(arg,atyp)],rtyp) => string_of_infix show_types src styp "-->" arg atyp rtyp | OperationCall (src,styp,["holOclLib","Boolean","and"],[(arg,atyp)],rtyp) => string_of_infix show_types src styp "/\\" arg atyp rtyp | OperationCall (src,styp,["holOclLib","Boolean","or"],[(arg,atyp)],rtyp) => string_of_infix show_types src styp "HOLxor" arg atyp rtyp | OperationCall (src,styp,["holOclLib","Boolean","not"],[],rtyp) => string_of_prefix1 show_types src styp "!" rtyp | OperationCall (src,styp,["holOclLib","Boolean","OclLocalValid"],[(Literal(arg,atyp),_)],rtyp) => string_of_infix show_types (Literal(arg,atyp)) atyp "|=" src styp rtyp | OperationCall (src,styp,["holOclLib","methodology","refinement","OclLocalValidR"], [(Literal(arg,atyp),_)],rtyp) => string_of_infix show_types (Literal(arg,atyp)) atyp "|=_R" src styp rtyp | OperationCall (S,_,["holOclLib","methodology","refinement", "OclForwardRefinement"], [(T,_),(R,_)],Boolean) => "refine " ^(ocl2string show_types S) ^" " ^(ocl2string show_types R) ^" " ^(ocl2string show_types T) | Iterator ("holOclLib.exists",vars,src,styp,c,ctyp,rtyp) => if show_types then "Ex "^(cs_list (map (fn (a,t) => a^":"^(string_of_OclType t)) vars)) ^" . " ^(ocl2string show_types src)^":" ^(string_of_OclType styp) else "Ex "^(cs_list (map (fn (a,t) => a) vars)) ^" . " ^(ocl2string show_types src) | Iterator ("holOclLib.forAll",vars,src,styp,c,ctyp,rtyp) => if show_types then "All "^(cs_list (map (fn (a,t) => a^":"^(string_of_OclType t)) vars)) ^" . " ^(ocl2string show_types src)^":" ^(string_of_OclType styp) else "All "^(cs_list (map (fn (a,t) => a) vars)) ^" . " ^(ocl2string show_types src) (**************************************) (* OperationCall *) (**************************************) (* OCL Boolean *) (* @pre *) | OperationCall (src,styp,["oclLib","OclAny","atPre"],[],rtyp) => if show_types then "((("^(ocl2string show_types src)^"):"^(string_of_OclType styp) ^")@pre:"^(string_of_OclType rtyp)^")" else "("^(ocl2string show_types src)^")@pre" | OperationCall (src,styp,["oclLib","Boolean",opname],[(arg,atyp)],rtyp) => string_of_infix show_types src styp opname arg atyp rtyp | OperationCall (src,styp,["oclLib","Boolean","not"],[],rtyp) => string_of_prefix1 show_types src styp "not" rtyp | OperationCall (src,styp,[opname],[],rtyp) => string_of_oo_postfix1 show_types src styp opname rtyp | OperationCall (src,styp,["oclLib",classifier,"="],[(arg,atyp)],rtyp) => string_of_infix show_types src styp "=" arg atyp rtyp | OperationCall (src,styp,["oclLib",classifier,"<>"],[(arg,atyp)],rtyp) => string_of_infix show_types src styp "<>" arg atyp rtyp | OperationCall (src,styp,["oclLib",classifier,"=="],[(arg,atyp)],rtyp) => string_of_infix show_types src styp "==" arg atyp rtyp | OperationCall (src,styp,["oclLib",classifier,"~="],[(arg,atyp)],rtyp) => string_of_infix show_types src styp "~=" arg atyp rtyp (* OCL Numerals *) | OperationCall (src,styp,["oclLib",classifier,"<"],[(arg,atyp)],rtyp) => string_of_infix show_types src styp "<" arg atyp rtyp | OperationCall (src,styp,["oclLib",classifier,"<="],[(arg,atyp)],rtyp) => string_of_infix show_types src styp "<=" arg atyp rtyp | OperationCall (src,styp,["oclLib",classifier,">"],[(arg,atyp)],rtyp) => string_of_infix show_types src styp ">" arg atyp rtyp | OperationCall (src,styp,["oclLib",classifier,">="],[(arg,atyp)],rtyp) => string_of_infix show_types src styp ">=" arg atyp rtyp (* OCL Real *) | OperationCall (src,styp,["oclLib",classifier,"round"],[],rtyp) => string_of_oo_postfix1 show_types src styp "round" rtyp | OperationCall (src,styp,["oclLib",classifier,"floor"],[],rtyp) => string_of_oo_postfix1 show_types src styp "floor" rtyp | OperationCall (src,styp,["oclLib",classifier,"min"],[(arg,atyp)],rtyp) => string_of_oo_infix show_types src styp "min" arg atyp rtyp | OperationCall (src,styp,["oclLib",classifier,"max"],[(arg,atyp)],rtyp) => string_of_oo_infix show_types src styp "max" arg atyp rtyp | OperationCall (src,styp,["oclLib",classifier,"/"],[(arg,atyp)],rtyp) => string_of_infix show_types src styp "/" arg atyp rtyp | OperationCall (src,styp,["oclLib",classifier,"abs"],[],rtyp) => string_of_oo_postfix1 show_types src styp "abs" rtyp | OperationCall (src,styp,["oclLib",classifier,"-"],[(arg,atyp)],rtyp) => string_of_infix show_types src styp "-" arg atyp rtyp | OperationCall (src,styp,["oclLib",classifier,"+"],[(arg,atyp)],rtyp) => string_of_infix show_types src styp "+" arg atyp rtyp | OperationCall (src,styp,["oclLib",classifier,"*"],[(arg,atyp)],rtyp) => string_of_infix show_types src styp "*" arg atyp rtyp (* OCL Integer *) | OperationCall (src,styp,["oclLib",classifier,"mod"],[(arg,atyp)],rtyp) => string_of_infix show_types src styp "mod" arg atyp rtyp | OperationCall (src,styp,["oclLib",classifier,"div"],[(arg,atyp)],rtyp) => string_of_infix show_types src styp "div" arg atyp rtyp | OperationCall (src,styp,["oclLib",classifier,"-"],[],rtyp) => string_of_prefix1 show_types src styp "-" rtyp (* OCL String *) (* | OperationCall (src,styp,["oclLib",classifier,"subString"],[(b,Integer),(e,Integer)],String) => OclSubString u (ocl2string u src) (ocl2string u b) (ocl2string u e) *) | OperationCall (src,styp,["oclLib",classifier,"allInstances"],[],_) => (string_of_OclType (Rep_OclHelper.type_of src))^"::allInstances()" | OperationCall (src,styp,["oclLib",classifier,opname],[],rtyp) => string_of_oo_postfix1 show_types src styp opname rtyp | OperationCall (src,styp,["oclLib",classifier,opname],[(arg,atyp)],rtyp) => string_of_oo_infix show_types src styp opname arg atyp rtyp (* OperationCalls to modell and Error *) (* TODO *) | OperationCall (src,styp,op_name,args,t) => if show_types then "("^(ocl2string show_types src)^"."^(hd (rev op_name)) ^"("^arglist show_types args^")" ^"):"^(string_of_OclType t) else (ocl2string show_types src)^"."^(hd (rev op_name)) ^"("^arglist show_types args^")" | Predicate (src,styp,op_name,args) => if show_types then (string_of_path op_name) ^"("^arglist show_types ((src,styp)::args)^"):Boolean" else (string_of_path op_name) ^"("^arglist show_types ((src,styp)::args)^")" (**************************************) (* Variable *) (**************************************) | Variable (vname,t) => if show_types then "("^vname^":"^(string_of_OclType t)^")" else vname (**************************************) (* Let *) (**************************************) (* Error *) | Let (var,vart,rhs,rhst,i,it) => "let "^var^":"^(string_of_OclType vart)^ " = "^(ocl2string show_types rhs)^ "in\n"^(ocl2string show_types i) (**************************************) (* OperationWithType *) (**************************************) (* Error *) | OperationWithType (src,styp,opname,oclType,rtyp) => string_of_oo_typeinfix show_types src styp opname oclType rtyp (**************************************) (* Iterate *) (**************************************) (* Error *) | Iterate ([],acc_name,acc_type,acc_term,sterm,stype,bterm,btype,res_type) => (ocl2string false sterm) ^ "->" ^ "iterate(" ^ acc_name ^ ":" ^ (Rep_OclType.string_of_OclType acc_type) ^ (ocl2string false acc_term) ^ (ocl2string false bterm) | Iterate (iter_vars,acc_name,acc_type,acc_term,sterm,stype,bterm,btype,res_type) => let fun string_of_vars [] = "" | string_of_vars ((string,typ)::tail) = (string ^ ":" ^ (Rep_OclType.string_of_OclType typ))^(string_of_vars tail) in (ocl2string false sterm) ^ "->" ^ "iterate(" ^ (string_of_vars iter_vars) ^ acc_name ^ ":" ^ (Rep_OclType.string_of_OclType acc_type) ^ (ocl2string false acc_term) ^ (ocl2string false bterm) end (**************************************) (* Iterator *) (**************************************) (* forAll *) | Iterator (iname,vars,src,styp,c,ctyp,rtyp) => if show_types then "("^(ocl2string show_types src)^":" ^(string_of_OclType styp)^"->"^iname^"(" ^(cs_list (map (fn (a,t) => a^":"^(string_of_OclType t)) vars)) ^"|"^(ocl2string show_types c)^")" else (ocl2string show_types src)^"->"^iname^"(" ^(cs_list (map #1 vars)) ^"|"^(ocl2string show_types c)^")" (* (* OCL Collection *) | Iterate (src,styp,["oclLib",classifier,"iterate"],args,Collection _) => OclIterate u C be e | Iterate (src,styp,["oclLib",classifier,"isUnique"],args,Collection _) => OclIsUnique u C be | Iterate (src,styp,["oclLib",classifier,"one"],args,Collection _) => OclOne u C be | Iterate (src,styp,["oclLib",classifier,"any"],args,Collection _) => OclAny u C be (* OCL OrderedSet *) | Iterate (src,styp,["oclLib",classifier,"count"],[(arg,_)],OrderedSet _) => OclOSetCount u S e *) (* Error *) (* | Iterator (s,_,_,_,_,_,_) => error ("error: unknown Iterator '"^(s)^"' in in ocl2string") *) (**************************************) (* Catch out *) (**************************************) (* Error *) | Tuple(x) => let val x = String.concat (List.map (fn (a,b,c) => a^":"^(string_of_OclType c)^"='"^(ocl2string false b)^"',") x) val size = String.size x in "Tuple{"^(String.substring(x,0,size-1))^"}\n" end | _ => Logger.error "error: unknown OCL-term in in ocl2string" end end (** "pretty printing" of Repository models *) structure Rep2String = struct fun precond2string (SOME n,t) = " pre "^n^":\n "^ (Ocl2String.ocl2string false t)^"\n" | precond2string (NONE,t) = " pre: "^ (Ocl2String.ocl2string false t)^"\n" fun postcond2string (SOME n,t) = " post "^n^":\n "^ (Ocl2String.ocl2string false t)^"\n" | postcond2string (NONE,t) = " post: "^ (Ocl2String.ocl2string false t)^"\n" fun inv2string (SOME n,t) = " inv "^n^":\n "^(Ocl2String.ocl2string false t)^"\n" | inv2string (NONE,t) = " inv: "^(Ocl2String.ocl2string false t)^"\n" fun argument2string (n,t) = n^":"^(Rep_OclType.string_of_OclType t) fun stereotype2string st = "<<"^st^">> " fun operation2string ({name,arguments,result,precondition,postcondition,...}:Rep.operation) = " "^name^ "("^String.concatWith ", " (map argument2string arguments)^ ") : "^Rep_OclType.string_of_OclType result^"\n"^ String.concat (map precond2string precondition)^ String.concat (map postcond2string postcondition) fun attribute2string ({name,attr_type,...}:Rep.attribute) = " "^name^" : "^(Rep_OclType.string_of_OclType attr_type)^"\n" fun parent2string (SOME (p)) = " extends "^Rep_OclType.string_of_OclType p | parent2string _ = "" fun classifier2string (C as Rep.Class x) = String.concat (map stereotype2string (#stereotypes x))^ "class "^Rep.string_of_path (Rep.name_of C)^ parent2string (#parent x)^ " {\n"^ String.concat (map inv2string (#invariant x))^ String.concat (map attribute2string (#attributes x))^ String.concat (map operation2string (#operations x))^ "}\n" | classifier2string (C as Rep.AssociationClass x) = String.concat (map stereotype2string (#stereotypes x))^ "associationclass "^Rep.string_of_path (Rep.name_of C)^ parent2string (#parent x)^ " {\n"^ String.concat (map inv2string (#invariant x))^ String.concat (map attribute2string (#attributes x))^ String.concat (map operation2string (#operations x))^ "}\n" | classifier2string (C as Rep.Interface x) = String.concat (map stereotype2string (#stereotypes x))^ "interface "^Rep.string_of_path (Rep.name_of C)^"{\n"^ String.concat (map operation2string (#operations x))^ "}\n" | classifier2string (C as Rep.Primitive x) = String.concat (map stereotype2string (#stereotypes x))^ "primitive "^Rep.string_of_path (Rep.name_of C)^"{\n"^ String.concat (map operation2string (#operations x))^ "}\n" | classifier2string (C as Rep.Enumeration x) = String.concat (map stereotype2string (#stereotypes x))^ "enum "^Rep.string_of_path (Rep.name_of C)^"{\n"^ String.concat (map operation2string (#operations x))^ "}\n" | classifier2string (C as Rep.Template x) = "template of "^ (classifier2string (#classifier x)) fun printClass (x:Rep.Classifier) = Logger.info (classifier2string x) fun printList (x:Rep.Classifier list) = Logger.info (String.concatWith "\n\n" (map classifier2string x )) end