Printing.hs revision 521e1648b2c66064c41e9ac47bcd510356ed2355
967e5f3c25249c779575864692935627004d3f9eChristian MaederModule : $Header$
81d182b21020b815887e9057959228546cf61b6bChristian MaederDescription : Dealing with transformation from/to Haskell and Maude
f11f713bebd8e1e623a0a4361065df256033de47Christian MaederCopyright : (c) Adrian Riesco, Facultad de Informatica UCM 2009
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederMaintainer : ariesco@fdi.ucm.es
967e5f3c25249c779575864692935627004d3f9eChristian MaederStability : experimental
89054b2b95a3f92e78324dc852f3d34704e2ca49Christian MaederPortability : portable
717686b54b9650402e2ebfbaadf433eab8ba5171Christian MaederTranslations between Maude and Haskell
8b9fda012e5ee53b7b2320c0638896a0ff6e99f3Christian Maederimport qualified Data.Set as Set
ee93fb771fcf3000d73c8e2f2000adb4b9a5158cChristian Maederimport qualified Data.Map as Map
ee93fb771fcf3000d73c8e2f2000adb4b9a5158cChristian Maederimport qualified Common.Lib.Rel as Rel
fd896e2068ad7e50aed66ac18c3720ea7ff2619fChristian MaedergetSpec :: String -> String
967e5f3c25249c779575864692935627004d3f9eChristian MaedergetSpec = quitNil . quitEnd . quitBegin
78eeae099616e255ccf2e5f9122387bb10c68338Christian MaederquitBegin :: String -> String
ad187062b0009820118c1b773a232e29b879a2faChristian MaederquitBegin ('S' : ('p' : l)) = 'S' : ('p' : l)
ad270004874ce1d0697fb30d7309f180553bb315Christian MaederquitBegin (_ : l) = quitBegin l
fd896e2068ad7e50aed66ac18c3720ea7ff2619fChristian MaederquitBegin [] = []
551af0e4ba6d96bb24f3555f3b30ed648e22e34aChristian MaederquitEnd :: String -> String
551af0e4ba6d96bb24f3555f3b30ed648e22e34aChristian MaederquitEnd ('@' : ('#' : ('$' : ('e' : ('n' : _))))) = []
551af0e4ba6d96bb24f3555f3b30ed648e22e34aChristian MaederquitEnd (h : l) = h : (quitEnd l)
551af0e4ba6d96bb24f3555f3b30ed648e22e34aChristian MaederquitEnd [] = []
551af0e4ba6d96bb24f3555f3b30ed648e22e34aChristian MaederquitNil :: String -> String
551af0e4ba6d96bb24f3555f3b30ed648e22e34aChristian MaederquitNil = Prelude.filter (/= '\NUL')
51fb5d7edd9369c367dda2f8b15ddd6f8a146606Christian Maeder -> Map.Map Qid (Set.Set ([Qid], Qid, [Attr])) -> String
1a75698c909ad515d59c76e65bd783f015c21c4dChristian MaederprintSign sts sbsts ops = ss ++ sbs ++ opd
1a75698c909ad515d59c76e65bd783f015c21c4dChristian Maeder where ss = sorts2maude sts
1a75698c909ad515d59c76e65bd783f015c21c4dChristian Maeder sbs = subsorts2maude sbsts
51fb5d7edd9369c367dda2f8b15ddd6f8a146606Christian Maeder opd = ops2maude ops
67d92da5e9610aabad39055a16031154b4dc3748Christian Maedersorts2maude :: Set.Set Qid -> String
67d92da5e9610aabad39055a16031154b4dc3748Christian Maedersorts2maude ss = if Set.null ss
67d92da5e9610aabad39055a16031154b4dc3748Christian Maeder else "sorts " ++ Set.fold (++) "" (Set.map ((++ " ") . show) ss) ++ ".\n"
67d92da5e9610aabad39055a16031154b4dc3748Christian Maedersubsorts2maude :: Rel.Rel Qid -> String
67d92da5e9610aabad39055a16031154b4dc3748Christian Maedersubsorts2maude ssbs = if Rel.null ssbs
67d92da5e9610aabad39055a16031154b4dc3748Christian Maeder else foldr (++) "" (map printPair $ Rel.toList ssbs)
67d92da5e9610aabad39055a16031154b4dc3748Christian MaederprintPair :: (Token,Token) -> String
7a879b08ae0ca30006f9be887a73212b07f10204Christian MaederprintPair (a,b) = "subsort " ++ show a ++ " < " ++ show b ++ " .\n"
1a75698c909ad515d59c76e65bd783f015c21c4dChristian Maederops2maude :: Map.Map Qid (Set.Set ([Qid], Qid, [Attr])) -> String
1a75698c909ad515d59c76e65bd783f015c21c4dChristian Maederops2maude om = flatten (flatten (map printOp (Map.toList om)))
67d92da5e9610aabad39055a16031154b4dc3748Christian Maederflatten :: [[a]] -> [a]
1a75698c909ad515d59c76e65bd783f015c21c4dChristian Maederflatten [] = []
1a75698c909ad515d59c76e65bd783f015c21c4dChristian Maederflatten (a : l) = a ++ (flatten l)
1a75698c909ad515d59c76e65bd783f015c21c4dChristian MaederprintOp :: (Qid, Set.Set ([Qid], Qid, [Attr])) -> [String]
1a75698c909ad515d59c76e65bd783f015c21c4dChristian MaederprintOp (opid, s) = map (printOpAux opid) (Set.toList s)
1a75698c909ad515d59c76e65bd783f015c21c4dChristian MaederprintOpAux :: Qid -> ([Qid], Qid, [Attr]) -> String
1a75698c909ad515d59c76e65bd783f015c21c4dChristian MaederprintOpAux opid (ar, co, ats) = "op " ++ show opid ++ " : " ++ printArity ar ++
67d92da5e9610aabad39055a16031154b4dc3748Christian Maeder " -> " ++ show co ++ printAttrSet ats ++ " .\n"
1a75698c909ad515d59c76e65bd783f015c21c4dChristian MaederprintArity :: [Qid] -> String
67d92da5e9610aabad39055a16031154b4dc3748Christian MaederprintArity a = foldr (++) "" (map showSpace a)
a89389521ddf76109168a0b339031575aafbd512Christian MaedershowSpace ::Show t => t -> String
a89389521ddf76109168a0b339031575aafbd512Christian MaedershowSpace s = show s ++ " "
a89389521ddf76109168a0b339031575aafbd512Christian MaederprintAttrSet :: [Attr] -> String
a89389521ddf76109168a0b339031575aafbd512Christian MaederprintAttrSet [] = []
a89389521ddf76109168a0b339031575aafbd512Christian MaederprintAttrSet ats = " [" ++ printAttrSetAux ats ++ "] "
a89389521ddf76109168a0b339031575aafbd512Christian MaederprintAttrSetAux :: [Attr] -> String
a89389521ddf76109168a0b339031575aafbd512Christian MaederprintAttrSetAux [] = []
3c8d067accf18572352351ec42ff905c7297a8a5Christian MaederprintAttrSetAux [a] = printAttr a
3c8d067accf18572352351ec42ff905c7297a8a5Christian MaederprintAttrSetAux (a : ats) = printAttr a ++ " " ++ printAttrSetAux ats
9b30898b139ee02f97ac933b6d935ef0a4206921Christian MaederprintAttr :: Attr -> String
1a75698c909ad515d59c76e65bd783f015c21c4dChristian MaederprintAttr Comm = "comm"
1a75698c909ad515d59c76e65bd783f015c21c4dChristian MaederprintAttr Assoc = "assoc"
67d92da5e9610aabad39055a16031154b4dc3748Christian MaederprintAttr Idem = "idem"
51fb5d7edd9369c367dda2f8b15ddd6f8a146606Christian MaederprintAttr Iter = "iter"
e1839fb37a3a2ccd457464cb0dcc5efd466dbe22Christian MaederprintAttr Memo = "memo"
67d92da5e9610aabad39055a16031154b4dc3748Christian MaederprintAttr Ctor = "ctor"
b66eb6038bfbcd2fe520d87c151bb4f1f510e985Christian MaederprintAttr Msg = "msg"
51fb5d7edd9369c367dda2f8b15ddd6f8a146606Christian MaederprintAttr Object = "object"
ee93fb771fcf3000d73c8e2f2000adb4b9a5158cChristian MaederprintAttr (Id t) = "id: " ++ printTerm t
ee93fb771fcf3000d73c8e2f2000adb4b9a5158cChristian MaederprintAttr (LeftId t) = "id-left: " ++ printTerm t
ee93fb771fcf3000d73c8e2f2000adb4b9a5158cChristian MaederprintAttr (RightId t) = "id-right: " ++ printTerm t
ee93fb771fcf3000d73c8e2f2000adb4b9a5158cChristian MaederprintAttr (Prec p) = "prec " ++ show p
ee93fb771fcf3000d73c8e2f2000adb4b9a5158cChristian MaederprintAttr (Strat ls) = "strat (" ++ printListSpaces ls ++ ")"
ee93fb771fcf3000d73c8e2f2000adb4b9a5158cChristian MaederprintAttr (Poly ls) = "poly (" ++ printListSpaces ls ++ ")"
51fb5d7edd9369c367dda2f8b15ddd6f8a146606Christian MaederprintAttr (Frozen ls) = if null ls
e7ce154edb906685b3fa7f6c0a764e18a4658068Christian Maeder then "frozen"
67d92da5e9610aabad39055a16031154b4dc3748Christian Maeder else "frozen (" ++ printListSpaces ls ++ ")"
67086e0fe40a985c5e8a3cf50e611f43234580c2Christian MaederprintAttr (Gather ls) = "gather (" ++ printListSpaces ls ++ ")"
ee93fb771fcf3000d73c8e2f2000adb4b9a5158cChristian MaederprintAttr (Format ls) = "format (" ++ printListSpaces ls ++ ")"
ee93fb771fcf3000d73c8e2f2000adb4b9a5158cChristian MaederprintAttr _ = ""
67086e0fe40a985c5e8a3cf50e611f43234580c2Christian MaederprintStmntAttrSet :: [StmntAttr] -> String
ee93fb771fcf3000d73c8e2f2000adb4b9a5158cChristian MaederprintStmntAttrSet [] = []
67d92da5e9610aabad39055a16031154b4dc3748Christian MaederprintStmntAttrSet ats = " [ " ++ printStmntAttrSetAux ats ++ " ] "
67086e0fe40a985c5e8a3cf50e611f43234580c2Christian MaederprintStmntAttrSetAux :: [StmntAttr] -> String
588c0c022a0f4e129a89c3bc569daf6a835e182dChristian MaederprintStmntAttrSetAux [] = []
717686b54b9650402e2ebfbaadf433eab8ba5171Christian MaederprintStmntAttrSetAux [a] = printAttrStmnt a
717686b54b9650402e2ebfbaadf433eab8ba5171Christian MaederprintStmntAttrSetAux (a : ats) = printAttrStmnt a ++ " " ++ printStmntAttrSetAux ats
d48085f765fca838c1d972d2123601997174583dChristian MaederprintAttrStmnt :: StmntAttr -> String
717686b54b9650402e2ebfbaadf433eab8ba5171Christian MaederprintAttrStmnt Owise = "owise"
d48085f765fca838c1d972d2123601997174583dChristian MaederprintAttrStmnt Nonexec = "nonexec"
d48085f765fca838c1d972d2123601997174583dChristian MaederprintAttrStmnt (Metadata s) = "metadata \"" ++ s ++ "\""
588c0c022a0f4e129a89c3bc569daf6a835e182dChristian MaederprintAttrStmnt (Label q) = "label \"" ++ show q ++ "\""
d48085f765fca838c1d972d2123601997174583dChristian MaederprintAttrStmnt (Print _) = ""
717686b54b9650402e2ebfbaadf433eab8ba5171Christian MaederprintTerm :: Term -> String
e7ce154edb906685b3fa7f6c0a764e18a4658068Christian MaederprintTerm (Const q _) = show q
b66eb6038bfbcd2fe520d87c151bb4f1f510e985Christian MaederprintTerm (Var q _) = show q
9b30898b139ee02f97ac933b6d935ef0a4206921Christian MaederprintTerm (Apply q tl) = show q ++ "(" ++ printTermList tl ++ ")"
1a75698c909ad515d59c76e65bd783f015c21c4dChristian MaederprintTermList :: [Term] -> String
b66eb6038bfbcd2fe520d87c151bb4f1f510e985Christian MaederprintTermList [] = []
1a75698c909ad515d59c76e65bd783f015c21c4dChristian MaederprintTermList [t] = printTerm t
b66eb6038bfbcd2fe520d87c151bb4f1f510e985Christian MaederprintTermList (t : tl) = printTerm t ++ ", " ++ printTermList tl
1a75698c909ad515d59c76e65bd783f015c21c4dChristian MaederprintListSpaces :: Show t => [t] -> String
b66eb6038bfbcd2fe520d87c151bb4f1f510e985Christian MaederprintListSpaces = foldr ((++) . showSpace) ""
67d92da5e9610aabad39055a16031154b4dc3748Christian MaederprintMb :: Membership -> String
b66eb6038bfbcd2fe520d87c151bb4f1f510e985Christian MaederprintMb (Mb t s conds ats) = "mb " ++ printTerm t ++ " : " ++ printSort s ++
1a75698c909ad515d59c76e65bd783f015c21c4dChristian Maeder printConds conds ++ printStmntAttrSet ats ++ " .\n"
1a75698c909ad515d59c76e65bd783f015c21c4dChristian MaederprintEq :: Equation -> String
1a75698c909ad515d59c76e65bd783f015c21c4dChristian MaederprintEq (Eq t1 t2 conds ats) = "eq " ++ printTerm t1 ++ " = " ++ printTerm t2 ++
f11f713bebd8e1e623a0a4361065df256033de47Christian Maeder printConds conds ++ printStmntAttrSet ats ++ " .\n"
967e5f3c25249c779575864692935627004d3f9eChristian MaederprintRl :: Rule -> String
18b513ff41708f24e1a7407f36b719add813ffeaChristian MaederprintRl (Rl t1 t2 conds ats) = "rl " ++ printTerm t1 ++ " => " ++ printTerm t2 ++
dedabc954aa15f6ad0764472a9434dc6dafe3db2Christian Maeder printConds conds ++ printStmntAttrSet ats ++ " .\n"
a23e572c8f957cc051a1b0831abd6fe9380d45c7Christian MaederprintSort :: Sort -> String
58b5ac21d1c88344246aaedab0c0bdc7b759d7c6Christian MaederprintSort (SortId q) = show q
3c8d067accf18572352351ec42ff905c7297a8a5Christian MaederprintConds :: [Condition] -> String
58b5ac21d1c88344246aaedab0c0bdc7b759d7c6Christian MaederprintConds [] = ""
f2ee9fc53048ea92bad79e3f5d292d83efd7f8beMihai CodescuprintConds cs = "if " ++ printCondsAux cs
81d182b21020b815887e9057959228546cf61b6bChristian MaederprintCondsAux :: [Condition] -> String
58b5ac21d1c88344246aaedab0c0bdc7b759d7c6Christian MaederprintCondsAux [] = ""
242397ba0f1cc490e892130bf0df239deeecf5daChristian MaederprintCondsAux [c] = printCond c
2e9985cd67e4f2414becb670ef33b8f16513e41dChristian MaederprintCondsAux (c : cs) = printCond c ++ " /\\ " ++ printCondsAux cs
d769b9ca726a9b50d661847c0e58c41d6ef334b4Christian MaederprintCond :: Condition -> String
551af0e4ba6d96bb24f3555f3b30ed648e22e34aChristian MaederprintCond (EqCond t1 t2) = printTerm t1 ++ " = " ++ printTerm t2
58b5ac21d1c88344246aaedab0c0bdc7b759d7c6Christian MaederprintCond (MatchCond t1 t2) = printTerm t1 ++ " := " ++ printTerm t2
551af0e4ba6d96bb24f3555f3b30ed648e22e34aChristian MaederprintCond (MbCond t s) = printTerm t ++ " : " ++ printSort s
551af0e4ba6d96bb24f3555f3b30ed648e22e34aChristian MaederprintCond (RwCond t1 t2) = printTerm t1 ++ " => " ++ printTerm t2
d769b9ca726a9b50d661847c0e58c41d6ef334b4Christian MaederprintMorphism :: Map.Map Qid Qid -> Map.Map Qid (Map.Map ([Qid], Qid) (Qid, ([Qid], Qid))) -> Map.Map Qid Qid -> String
3c8d067accf18572352351ec42ff905c7297a8a5Christian MaederprintMorphism sorts ops labels = if str == ""
58b5ac21d1c88344246aaedab0c0bdc7b759d7c6Christian Maeder else "\n\nMorphism:\n\n" ++ str
ad187062b0009820118c1b773a232e29b879a2faChristian Maeder where str = (printQidMap "sort" sorts) ++ (printOpRenaming ops)
3c8d067accf18572352351ec42ff905c7297a8a5Christian Maeder ++ (printQidMap "label" labels)
551af0e4ba6d96bb24f3555f3b30ed648e22e34aChristian MaederprintQidMap :: String -> Map.Map Qid Qid -> String
dedabc954aa15f6ad0764472a9434dc6dafe3db2Christian MaederprintQidMap str = Map.foldWithKey f ""
842eedc62639561781b6c33533d1949693ef6cc5Christian Maeder where f = \ x y z -> str ++ " " ++ show x ++ " to " ++ show y ++ "\n" ++ z
588c0c022a0f4e129a89c3bc569daf6a835e182dChristian MaederprintOpRenaming :: Map.Map Qid (Map.Map ([Qid], Qid) (Qid, ([Qid], Qid))) -> String
588c0c022a0f4e129a89c3bc569daf6a835e182dChristian MaederprintOpRenaming = Map.foldWithKey f ""
842eedc62639561781b6c33533d1949693ef6cc5Christian Maeder where f = \ x y z -> (Map.foldWithKey (g x) "" y) ++ z
bfa9e03532243ceb487f0384d0f6a447f1ce7670Till Mossakowski where g = \ from (ar, co) (to, _) z' ->
967e5f3c25249c779575864692935627004d3f9eChristian Maeder "op " ++ show from ++ " : " ++ printArity ar ++ " -> "
967e5f3c25249c779575864692935627004d3f9eChristian Maeder ++ show co ++ " to " ++ show to ++ z'