OMDocExport.hs revision d2d5606ab65ddf48599bd044416de07a205095f2
57221209d11b05aa0373cc3892d5df89ba96ebf9Christian Maeder{- |
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyModule : $Header$
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyDescription : CommonLogic-to-OMDoc conversion
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyCopyright : (c) Iulia Ignatov, DFKI Bremen 2009, Eugen Kuksa, Uni Bremen 2011
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyLicense : GPLv2 or higher, see LICENSE.txt
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu Prodescu
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyMaintainer : eugenk@informatik.uni-bremen.de
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyStability : experimental
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyPortability : portable
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'Reilly
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyCommon Logic implementation of the interface functions
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reillyexport_senToOmdoc and export_symToOmdoc from class Logic.
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyThe actual instantiation can be found in module "CommonLogic.Logic_CommonLogic".
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'Reilly-}
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reillymodule CommonLogic.OMDocExport
57221209d11b05aa0373cc3892d5df89ba96ebf9Christian Maeder ( exportSymToOmdoc
66bc8d6e69cde43f1ccbeb76104cf7b8038acd6cChristian Maeder , exportSenToOmdoc
66bc8d6e69cde43f1ccbeb76104cf7b8038acd6cChristian Maeder ) where
e90dc723887d541f809007ae81c9bb73ced9592eChristian Maeder
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian Maederimport CommonLogic.AS_CommonLogic as AS
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reillyimport CommonLogic.Symbol
56899f6457976a2ee20f6a23f088cb5655b15715Liam O'Reillyimport CommonLogic.OMDoc
66bc8d6e69cde43f1ccbeb76104cf7b8038acd6cChristian Maeder
a00461fcf7432205a79a0f12dbe6c1ebc58bc000Christian Maederimport OMDoc.DataTypes
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reillyimport Common.Id
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'Reillyimport Common.Result
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder
648fe1220044aac847acbdfbc4155af5556063ebChristian Maederimport qualified Data.Map as Map
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian Maedertype Env = NameMap Symbol
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly
c0833539c8cf577dd3f2497792fbdd818442744cChristian Maeder-- | Exports the symbol @n@ to OMDoc
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillyexportSymToOmdoc :: Env -> Symbol -> String -> Result TCElement
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillyexportSymToOmdoc _ _ n = return $ TCSymbol n const_symbol Obj Nothing
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly
fa373bc327620e08861294716b4454be8d25669fChristian Maeder-- | Exports the text @tm@ to OMDoc
036ecbd8f721096321f47cf6a354a9d1bf3d032fChristian MaederexportSenToOmdoc :: Env -> TEXT_META
fa373bc327620e08861294716b4454be8d25669fChristian Maeder -> Result TCorOMElement
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederexportSenToOmdoc en tm = return $ Right $ exportText en [] $ AS.getText tm
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'Reilly
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyexportText :: Env -> [NAME_OR_SEQMARK] -> TEXT -> OMElement
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'ReillyexportText en vars txt = case txt of
53bd0c89aa4743dc41a6394db5a90717c1ca4517Liam O'Reilly Text phrs _ ->
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly OMA $ const_and : map (exportPhr en vars) (filter nonImportation phrs)
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly Named_text n t _ ->
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder OMA [const_textName, OMV $ mkSimpleName $ tokStr n, exportText en vars t]
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder where nonImportation p = case p of
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Importation _ -> False
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder _ -> True
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederexportPhr :: Env -> [NAME_OR_SEQMARK] -> PHRASE -> OMElement
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederexportPhr en vars phr = case phr of
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Importation _ -> undefined -- does not occur
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Module m -> OMBIND const_module [modName m] $ exportModule en vars m
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Sentence s -> exportSen en vars s
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Comment_text c t _ ->
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder OMA [const_comment, varFromComment c, exportText en vars t]
4314e26a12954cb1c9be4dea10aa8103edac5bbbChristian Maeder where modName m = case m of
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian Maeder Mod n _ _ -> exportVar $ AS.Name n
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian Maeder Mod_ex n _ _ _ -> exportVar $ AS.Name n
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'ReillyexportModule :: Env -> [NAME_OR_SEQMARK] -> MODULE -> OMElement
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillyexportModule en vars m = case m of
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Mod _ t _ -> exportText en vars t
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Mod_ex _ exs t _ -> OMA $ const_moduleExcludes : exportText en vars t
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder : map (exportVar . AS.Name) exs
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian MaederexportSen :: Env -> [NAME_OR_SEQMARK] -> SENTENCE
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder -> OMElement
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillyexportSen en vars s = case s of
33bdce26495121cdbce30331ef90a1969126a840Liam O'Reilly Quant_sent qs _ -> case qs of
fa373bc327620e08861294716b4454be8d25669fChristian Maeder QUANT_SENT q vars2 s2 -> OMBIND (case q of
fa373bc327620e08861294716b4454be8d25669fChristian Maeder Universal -> const_forall
fa373bc327620e08861294716b4454be8d25669fChristian Maeder Existential -> const_exists)
fa373bc327620e08861294716b4454be8d25669fChristian Maeder (map exportVar vars2)
fa373bc327620e08861294716b4454be8d25669fChristian Maeder (exportSen en (vars ++ vars2) s2)
fa373bc327620e08861294716b4454be8d25669fChristian Maeder Bool_sent bs _ -> case bs of
fa373bc327620e08861294716b4454be8d25669fChristian Maeder Junction j ss ->
fa373bc327620e08861294716b4454be8d25669fChristian Maeder OMA $ (case j of Conjunction -> const_and
fa373bc327620e08861294716b4454be8d25669fChristian Maeder Disjunction -> const_or)
fa373bc327620e08861294716b4454be8d25669fChristian Maeder : map (exportSen en vars) ss
fa373bc327620e08861294716b4454be8d25669fChristian Maeder Negation s1 -> OMA [ const_not, exportSen en vars s1]
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder BinOp op s1 s2 -> OMA
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder [ case op of Implication -> const_implies
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian Maeder Biconditional -> const_equivalent
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder , exportSen en vars s1
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder , exportSen en vars s2]
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder Atom_sent at _ -> case at of
9aeda2b3ae8ce0b018955521e4ca835a8ba8a27bLiam O'Reilly Equation t1 t2 -> OMA
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder [ const_eq
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder , exportTerm en vars t1
7857a35e3af533dfbd0f0e18638ebd211e6358a0Christian Maeder , exportTerm en vars t2 ]
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Atom pt tts ->
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder OMA $ exportTerm en vars pt : map (exportTermSeq en vars) tts
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Comment_sent _com s1 _ ->
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder OMA [const_comment, varFromComment _com, exportSen en vars s1]
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Irregular_sent s1 _ ->
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder OMA [const_irregular, exportSen en vars s1]
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederexportTerm :: Env -> [NAME_OR_SEQMARK] -> TERM -> OMElement
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederexportTerm e vars t = case t of
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder Name_term n -> if AS.Name n `elem` vars
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder then exportVar (AS.Name n)
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder else oms e n
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian Maeder Funct_term ft tss _ ->
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian Maeder OMA $ exportTerm e vars ft : map (exportTermSeq e vars) tss
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian Maeder Comment_term t1 _com _ ->
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian Maeder OMA [ const_comment_term, varFromComment _com, exportTerm e vars t1 ]
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian Maeder
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian MaederexportTermSeq :: Env -> [NAME_OR_SEQMARK] -> TERM_SEQ -> OMElement
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian MaederexportTermSeq e vars ts = case ts of
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian Maeder Term_seq t -> exportTerm e vars t
eb48217dfa67ddb87b8fbd846de293d0636bd578Christian Maeder Seq_marks s -> if SeqMark s `elem` vars
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian Maeder then exportVar (SeqMark s)
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder else oms e s
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder
7830e8fa7442fb7452af7ecdba102bc297ae367eChristian MaederexportVar :: NAME_OR_SEQMARK -> OMElement
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederexportVar (AS.Name n) = OMV $ mkSimpleName $ tokStr n
648fe1220044aac847acbdfbc4155af5556063ebChristian MaederexportVar (SeqMark s) = OMV $ mkSimpleName $ tokStr s
4314e26a12954cb1c9be4dea10aa8103edac5bbbChristian Maeder
648fe1220044aac847acbdfbc4155af5556063ebChristian MaedervarFromComment :: COMMENT -> OMElement
648fe1220044aac847acbdfbc4155af5556063ebChristian MaedervarFromComment (Comment x _) = OMV $ mkSimpleName x
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder
648fe1220044aac847acbdfbc4155af5556063ebChristian Maederoms :: Env -> Token -> OMElement
648fe1220044aac847acbdfbc4155af5556063ebChristian Maederoms e x =
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder let s = toSymbol x
4314e26a12954cb1c9be4dea10aa8103edac5bbbChristian Maeder err = error $ "oms: no mapping for the symbol " ++ show s
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder -- printId1 (symName s) ++ "\n" ++ show e ++ "\n\n\n" ++ ""
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder in simpleOMS $ findInEnv err e s
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder
33bdce26495121cdbce30331ef90a1969126a840Liam O'ReillyfindInEnv :: (Ord k) => a -> Map.Map k a -> k -> a
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian MaederfindInEnv err m x = Map.findWithDefault err x m
d5833d2ee7bafcbf2fdd2bdfd9a728c769b100c7Christian Maeder
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder-- transform a NAME_OR_SEQMARK into a symbol.
648fe1220044aac847acbdfbc4155af5556063ebChristian MaedertoSymbol :: Token -> Symbol
648fe1220044aac847acbdfbc4155af5556063ebChristian MaedertoSymbol = Symbol . simpleIdToId
648fe1220044aac847acbdfbc4155af5556063ebChristian Maeder