Uml

Common/Id.hs

@@ -91,7 +91,7 @@ data Token = Token { tokStr :: String
                    } deriving (Eq, Ord, Typeable, Data)
 
 instance Show Token where
-  show = tokStr
+  show x = "(mkSimpleId "++['"'] ++ (tokStr x) ++ ['"'] ++ ")"
 
 instance Read Token where
   readsPrec i = map (\ (a, r) -> (mkSimpleId a, r)) . readsPrec i

CommonLogic/Morphism.hs

@@ -197,3 +197,6 @@ morphismUnion mor1 mor2 =
       { source = unite p1 p2
       , target = unite (target mor1) $ target mor2
       , propMap = pmap } else Result pds Nothing
+
+
+

Comorphisms/LogicGraph.hs

@@ -89,6 +89,7 @@ import Comorphisms.QVTR2CASL
 import Comorphisms.CASL2Hybrid
 import Comorphisms.Hybrid2CASL
 
+import Comorphisms.UML_CD2CL
 
 #ifdef CASLEXTENSIONS
 import Comorphisms.CoCFOL2IsabelleHOL
@@ -244,7 +245,8 @@ comorphismList =
     , Comorphism QBF2Prop
     , Comorphism Prop2QBF
     , Comorphism CSMOF2CASL
-    , Comorphism QVTR2CASL ]
+    , Comorphism QVTR2CASL
+    , Comorphism UML_CD2CL]
 
 inclusionList :: [AnyComorphism]
 inclusionList =

Comorphisms/LogicList.hs

@@ -86,6 +86,7 @@ import OWL2.Logic_OWL2
 import RDF.Logic_RDF
 #endif
 import Comorphisms.DynLogicList
+import UML.Logic_UML
 import NeSyPatterns.Logic_NeSyPatterns
 
 logicList :: [AnyLogic]
@@ -136,6 +137,7 @@ logicList =
 #endif
   , Logic CSMOF
   , Logic QVTR
+  , Logic UML
   , Logic NeSyPatterns
   ] ++ dynLogicList
 

Comorphisms/UML_CD2CL.hs

@@ -0,0 +1,114 @@
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses #-}
+module Comorphisms.UML_CD2CL where
+
+import Common.ProofTree
+import Common.Result
+import Common.Id
+import Common.AS_Annotation
+
+import Logic.Logic
+import Logic.Comorphism
+
+import UML.Sign
+import UML.Logic_UML
+import UML.UML hiding (Id)
+import UML.UML2CL
+import UML.UML2CL_preamble
+import UML.Morphism
+
+import CommonLogic.Sign as CL_Sign
+import CommonLogic.Logic_CommonLogic
+import CommonLogic.AS_CommonLogic as As_CL
+import CommonLogic.Symbol as Symbol
+import CommonLogic.ATC_CommonLogic ()
+import CommonLogic.Sublogic
+import CommonLogic.Morphism
+import CommonLogic.Analysis
+
+import qualified Data.Map as Map 
+import qualified Data.Set as Set
+-- | lid of the morphism
+data UML_CD2CL = UML_CD2CL deriving Show
+
+instance Language UML_CD2CL where
+  language_name UML_CD2CL = "UML2CommonLogic" 
+
+instance Comorphism UML_CD2CL 
+    UML.Logic_UML.UML
+    ()                    -- Sublogics
+      UML.UML.CM                 -- basic_spec
+    UML.Sign.Sen             -- sentence
+      ()                    -- symb_items
+      ()                    -- symb_map_items
+      UML.Sign.Sign              -- sign
+      UML.Morphism.Morphism                  -- morphism
+      ()                    -- symbol
+      ()                    -- raw_symbol
+      ()                    -- proof_tree
+    CommonLogic.Logic_CommonLogic.CommonLogic
+    CommonLogicSL     -- Sublogics
+    BASIC_SPEC        -- basic_spec
+    TEXT_META         -- sentence
+    SYMB_ITEMS        -- symb_items
+    SYMB_MAP_ITEMS    -- symb_map_items
+    CL_Sign.Sign              -- sign
+    CommonLogic.Morphism.Morphism          -- morphism
+    Symbol            -- symbol
+    Symbol            -- raw_symbol
+    ProofTree         -- proof_tree
+    where
+        sourceLogic UML_CD2CL = UML.Logic_UML.UML
+        targetLogic UML_CD2CL = CommonLogic.Logic_CommonLogic.CommonLogic
+        map_theory UML_CD2CL = mapTheory
+        map_morphism UML_CD2CL = mapMor 
+
+mapTheory :: (UML.Sign.Sign, [Named Sen]) -> Result (CL_Sign.Sign, [Named TEXT_META])
+mapTheory (sign, sens) = let 
+                            sg = (mapSign sign)
+                            t =  (translateSign2Phrases sign)   
+                            tmSyms = (Set.fromList $ map symName $ foldl (++) [] $ map (symsOfTextMeta.sentence) tms) Set.\\ (allItems sg)
+                            sg2 = CL_Sign.Sign{ discourseNames = Set.union (discourseNames sg) tmSyms,
+                                                CL_Sign.nondiscourseNames = CL_Sign.nondiscourseNames sg,   
+                                                sequenceMarkers = sequenceMarkers sg}
+                            tms = (map (makeNamedSen.emptyAnno) t) ++   (map (mapNamed $ mapSen) sens)                   
+                            in return (sg2 , tms)
+
+
+mapSen ::  UML.Sign.Sen -> TEXT_META
+mapSen mf = Text_meta{ As_CL.getText = Text phrases nullRange
+                          , As_CL.textIri = Nothing
+                          , As_CL.nondiscourseNames = Nothing
+                          , As_CL.prefix_map = [] }
+                    where phrases = (Sentence (translateMult2Sen mf)):[]--(translateSign2Phrases sign) 
+
+
+mapSign :: UML.Sign.Sign -> CL_Sign.Sign 
+mapSign sign = CL_Sign.Sign{
+    CL_Sign.discourseNames =  Set.union (Set.fromList ((map (stringToId.showClassEntityName) $ fst $ signClassHier sign) 
+                    ++ (map (stringToId.literalName) $ foldl (++) [] (map enumLiterals $ filterEnums $ fst $ signClassHier sign))
+                    ++ (map morphTranslateAttr (signAttribute sign))
+                    ++ (foldl (++) [] $ map morphTranslateOper (signOperations sign))
+                    ++ (map morphTranslateComp (signCompositions sign))
+                    ++ (foldl (++) [] $ map morphTranslateAsso (signAssociations sign))))  (foldl (Set.union) Set.empty preambleDiscourseNames),
+    CL_Sign.nondiscourseNames = (foldl (Set.union) Set.empty preambleNonDiscourseNames),
+    CL_Sign.sequenceMarkers = (foldl (Set.union) Set.empty preambleSequenceMarkers)
+}
+
+morphTranslateAttr :: (Class,String,Type) -> Id
+morphTranslateAttr (c,s,_) = (stringToId $ className c ++ "." ++ s)
+
+morphTranslateComp :: ((String,ClassEntity),String,(String,Type)) -> Id
+morphTranslateComp ((_,_),n,(_,_)) = stringToId n
+
+morphTranslateAsso :: (String,[(String,Type)]) -> [Id]
+morphTranslateAsso (n,endL) = (stringToId n):(map (stringToId.fst) endL)
+
+morphTranslateOper :: (Class,String,[(String,Type)],Type) -> [Id]
+morphTranslateOper (c,n,para,_) = (stringToId $ (className c) ++ "." ++ n):(map (stringToId.fst) para)
+
+mapMor :: UML.Morphism.Morphism -> Result CommonLogic.Morphism.Morphism 
+mapMor m = return CommonLogic.Morphism.Morphism
+  { CommonLogic.Morphism.source = mapSign $ UML.Morphism.source m
+  , CommonLogic.Morphism.target = mapSign $ UML.Morphism.target m
+  , CommonLogic.Morphism.propMap = Map.empty
+  }

Driver/Options.hs

@@ -539,6 +539,7 @@ data InType =
   | CommonLogicIn Bool  -- ^ "clf" or "clif" ('True' is long version)
   | DgXml
   | Xmi
+  | UMLCDXmi
   | Qvt
   | TPTPIn
   | HtmlIn -- just to complain
@@ -570,6 +571,7 @@ instance Show InType where
     Xmi -> "xmi"
     Qvt -> "qvt"
     HtmlIn -> "html"
+    UMLCDXmi -> "UMLCD"
 
 -- maybe this optional tree prefix can be omitted
 instance Read InType where

Driver/ReadFn.hs

@@ -57,6 +57,8 @@ import Data.Char (isSpace)
 import Data.List (isPrefixOf)
 import Data.Maybe
 
+import UML.Parser
+
 noPrefix :: QName -> Bool
 noPrefix = isNothing . qPrefix
 
@@ -69,6 +71,9 @@ isPpXml q = qName q == "Lib" && noPrefix q
 isDMU :: QName -> Bool
 isDMU q = qName q == "ClashResult" && noPrefix q
 
+isXMI :: QName -> Bool 
+isXMI q = qName q == "XMI"
+
 isRDF :: QName -> Bool
 isRDF q = qName q == "RDF" && qPrefix q == Just "rdf"
 
@@ -87,9 +92,14 @@ guessXmlContent isXml str = case dropWhile isSpace str of
       | isDMU q -> Left "unexpected DMU xml format"
       | isPpXml q -> Left "unexpected pp.xml format"
       | null (qName q) || not isXml -> Right GuessIn
+      | isUMLCDroot e-> Right UMLCDXmi
       | otherwise -> Left $ "unknown XML format: " ++ tagEnd q ""
  _ -> Right GuessIn  -- assume that it is no xml content
 
+isUMLCDroot :: Element -> Bool 
+isUMLCDroot el0 = not $ isNothing $ findModelElement el0 
+
+
 isDgXmlFile :: HetcatsOpts -> FilePath -> String -> Bool
 isDgXmlFile opts file content = guess file (intype opts) == DgXml
         && guessXmlContent True content == Right DgXml

Driver/ReadLibDefn.hs

@@ -34,6 +34,7 @@ import QVTR.ParseQvtAsLibDefn
 import TPTP.ParseAsLibDefn
 import FreeCAD.Logic_FreeCAD
 
+import Data.Maybe 
 import Driver.Options
 import Driver.ReadFn
 
@@ -42,11 +43,15 @@ import Common.Result
 import Common.ResultT
 
 import Text.ParserCombinators.Parsec
+import Text.XML.Light
 
 import Control.Monad.Trans (MonadIO (..))
 import qualified Control.Monad.Fail as Fail
 import Data.List
 
+import UML.ParseUMLAsLibDefn
+import UML.Parser
+
 mimeTypeMap :: [(String, InType)]
 mimeTypeMap =
   [ ("xml", DgXml)
@@ -96,8 +101,12 @@ guessInput opts mr file input =
       _ -> return $ joinFileTypes fty ty
   else return fty
 
+isUMLCDroot :: Element -> Bool 
+isUMLCDroot el0 = not $ isNothing $ findModelElement el0 
+
 readLibDefn :: LogicGraph -> HetcatsOpts -> Maybe String
   -> FilePath -> FilePath -> String -> ResultT IO [LIB_DEFN]
+
 readLibDefn lgraph opts mr file fileForPos input =
     if null input then Fail.fail ("empty input file: " ++ file) else
     case intype opts of
@@ -112,7 +121,12 @@ readLibDefn lgraph opts mr file fileForPos input =
 #ifdef RDFLOGIC
      -- RDFIn -> liftIO $ parseRDF file
 #endif
-      Xmi -> return [parseXmi file input]
+      UMLCDXmi -> liftIO $ fmap (: []) $  parseUMLCDasLibDefn file
+      Xmi -> liftIO $ fmap (: []) $ case parseXMLDoc input of 
+                                        Nothing -> error "empty XMI" 
+                                        Just e -> case isUMLCDroot e of 
+                                            True -> parseUMLCDasLibDefn file
+                                            False ->  parseXmi file input
       Qvt -> liftIO $ fmap (: []) $ parseQvt file input
       TPTPIn -> parseTPTP opts file input
 #ifndef NOOWLLOGIC

Makefile

@@ -120,7 +120,7 @@ logics = CASL HasCASL Isabelle Modal Hybrid TopHybrid Temporal \
     CoCASL COL CspCASL CASL_DL \
     SoftFOL ConstraintCASL Propositional RelationalScheme VSE OMDoc DFOL \
     LF Framework Maude ExtModal CommonLogic CSL QBF Adl HolLight Fpl THF \
-    FreeCAD OWL2 RDF CSMOF QVTR TPTP NeSyPatterns
+    FreeCAD OWL2 RDF CSMOF QVTR TPTP UML NeSyPatterns
 
 TESTTARGETFILES += Scratch.hs CASL/fromKif.hs CASL/capa.hs HasCASL/hacapa.hs \
     Haskell/wrap.hs Isabelle/isa.hs Syntax/hetpa.hs \
@@ -362,6 +362,8 @@ RDF_files = RDF/AS.hs RDF/Symbols.hs RDF/Sign.hs RDF/Morphism.hs \
 
 CSMOF_files = CSMOF/As.hs CSMOF/Sign.hs
 
+UML_files = UML/UML.hs UML/Sign.hs UML/Morphism.hs UML/StateMachine.hs
+
 QVTR_files = QVTR/As.hs QVTR/Sign.hs
 
 TPTP_files = TPTP/AS.hs TPTP/Sign.hs TPTP/Sublogic.hs
@@ -471,6 +473,9 @@ RDF/ATC_RDF.der.hs: $(RDF_files) $(GENRULES)
 CSMOF/ATC_CSMOF.der.hs: $(CSMOF_files) $(GENRULES)
 	$(GENRULECALL) -i Common.ATerm.ConvInstances -i Common.Json.ConvInstances -o $@ $(CSMOF_files)
 
+UML/ATC_UML.der.hs: $(UML_files) $(GENRULES)
+	$(GENRULECALL) -i Common.ATerm.ConvInstances -o $@ $(UML_files)
+
 QVTR/ATC_QVTR.der.hs: $(QVTR_files) CSMOF/ATC_CSMOF.hs $(GENRULES)
 	$(GENRULECALL) -i CSMOF.ATC_CSMOF -i Common.ATerm.ConvInstances -i Common.Json.ConvInstances \
  -o $@ $(QVTR_files)