ToItem.hs revision c169af7c97f636424adc459c9c7f145383186046
b6ff72be73dad3d1394cf2c71e29e67624ff030bChristian Maeder{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederModule : $Header$
e6d40133bc9f858308654afb1262b8b483ec5922Till MossakowskiDescription : extracted annotated items as strings from BASIC_SPEC
2725abe920f91de62ae5c0b7230c1627cccf5fabChristian MaederCopyright : (c) Christian Maeder and Ewaryst Schulz and DFKI GmbH 2009
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederMaintainer : Ewaryst.Schulz@dfki.de
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederStability : experimental
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederPortability : non-portable
f3a94a197960e548ecd6520bb768cb0d547457bbChristian Maederget item representation of 'BASIC_SPEC'
b53688bfed888214b485cf76439d57262d80e0a7Christian Maedermodule CASL.ToItem (bsToItem) where
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder--------------------- utils
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaedertoString :: Pretty a => a -> String
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaedertoString = show . pretty
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder--------------------- TS = TransState
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maederdata TS b s f = TS { fB :: (b -> Doc)
c770b05f3d85f8eeb25ba15f7192044f9dd534ddSoeren D. Schulze , fS :: (s -> Doc)
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder , fF :: (f -> Doc) }
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder-- LITC = LocalITContext
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder-- This datastructure is used to pass an additional ItemType argument to
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder-- the toitem method when one needs an instance for which this method
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder-- should behave differently in different contexts depending on this argument.
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder-- Typically the ItemType is used as ItemType of the Item to be created.
bbba6dd86153aacb0f662b182b128df0eb09fd54Christian Maederdata LITC a = LITC ItemType a
a461314c811f4187dff85c8be079a41b2f13f176Christian Maeder--------------------- lifting to Local Contexts
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaederwithLIT :: ItemTypeable a => a -> b -> LITC b
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederwithLIT it = LITC $ toIT it
be43c3fa0292555bd126784ae27ff5c1d23438cbChristian MaederlistWithLIT :: ItemTypeable a => a -> [b] -> [LITC b]
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederlistWithLIT it = map (withLIT it)
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian Maeder-- analogous for annotated objects, don't needed yet
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder--annWithLIT :: ItemTypeable a => a -> Annoted b -> Annoted (LITC b)
7f7460e7095628f3437b116ee78d3043d11f8febChristian Maeder--annWithLIT it = fmap (withLIT it)
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maeder--annlistWithLIT :: ItemTypeable a => a -> [Annoted b] -> [Annoted (LITC b)]
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder--annlistWithLIT it = map (annWithLIT it)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder-- this function is only to unify the types of the state and the basic spec
502483734c83d0bf1eadcc94113d0362f8713784Christian Maeder-- in the call of toitem and runState in bsToItem
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergetTransState :: (Pretty b, Pretty s, Pretty f) => BASIC_SPEC b s f ->
7f7460e7095628f3437b116ee78d3043d11f8febChristian MaedergetTransState _ = TS pretty pretty pretty
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder--------------------- The Main function of this module
96ae1a1d2197d0e0d5b80da2474b64c456feb1b0Christian MaederbsToItem :: (Pretty b, Pretty s, Pretty f) => (BASIC_SPEC b s f) -> Item
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederbsToItem bs = runReader (toitem bs) $ getTransState bs
2353f65833a3da763392f771223250cd50b8d873Christian Maederinstance ItemConvertible (BASIC_SPEC b s f) (Reader (TS b s f)) where
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder toitem (Basic_spec l) =
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder do{ l' <- listFromAL l
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maeder ; return rootItem{ items = l' } }
96ae1a1d2197d0e0d5b80da2474b64c456feb1b0Christian Maederinstance ItemConvertible (BASIC_ITEMS b s f) (Reader (TS b s f)) where
d81905a5b924415c524d702df26204683c82c12eChristian Maeder Sig_items s -> toitem s
96ae1a1d2197d0e0d5b80da2474b64c456feb1b0Christian Maeder Var_items l (Range qs) -> mkItemM "Var_items"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder (Range . joinRanges $ qs : map varDeclRange l) $ listFromL l
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Axiom_items al (Range qs) -> mkItemM "Axiom_items"
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder (Range . joinRanges $ qs : map (annoRange formulaRange) al)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder $ listFromAL al
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maeder Local_var_axioms vl fl (Range qs) ->
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder mkItemMM "Local_var_axioms"
cb2044812811d66efe038d914966e04290be93faChristian Maeder (Range . joinRanges $ qs : map varDeclRange vl ++
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder map (annoRange formulaRange) fl)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder [fromL "VAR_DECLS" vl, fromAL "FORMULAS" fl]
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maeder Sort_gen asis rg -> mkItemM "Sort_gen" rg $ listFromAL asis
0ae7a79e865d4a6022d705d160530682b3c1f825Christian Maeder Free_datatype sk adtds rg ->
083bc1972a66d73749760eab3a90bf4eb9ca7951Christian Maeder mkItemM ("Free_datatype", "SortsKind", show sk) rg
6352f3c31da3043783a13be6594aacb2147378baRazvan Pascanu $ listFromAL adtds
fefee7e1dee1ee5f0768a03a4abae88d1ca2c3fdRazvan Pascanu Ext_BASIC_ITEMS b ->
b324cda6178c49ddeead3ce62b832ccf644cbcabRazvan Pascanu do{ st <- ask
fefee7e1dee1ee5f0768a03a4abae88d1ca2c3fdRazvan Pascanu ; fromPrinter (show . (fB st)) "Ext_BASIC_ITEMS" b }
966519955f5f7111abac20118563132b9dd41165Christian Maederinstance ItemConvertible (SIG_ITEMS s f) (Reader (TS b s f)) where
33fcc19ef2b59493b4e91eebf701df95fd230765Christian Maeder Sort_items sk sis rg ->
33fcc19ef2b59493b4e91eebf701df95fd230765Christian Maeder mkItemM ("Sort_items", "SortsKind", show sk) rg
33fcc19ef2b59493b4e91eebf701df95fd230765Christian Maeder $ listFromAL sis
d4ebd9e5adc974cfa2bdf4bdd155e07be0e26f75Christian Maeder Op_items aois rg -> mkItemM "Op_items" rg $ listFromAL aois
d4ebd9e5adc974cfa2bdf4bdd155e07be0e26f75Christian Maeder Pred_items apis rg -> mkItemM "Pred_items" rg $ listFromAL apis
d4ebd9e5adc974cfa2bdf4bdd155e07be0e26f75Christian Maeder Datatype_items sk adds rg ->
8865728716566f42fa73e7e0bc080ba3225df764Christian Maeder mkItemM ("Datatype_items", "SortsKind", show sk) rg
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder $ listFromAL adds
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Ext_SIG_ITEMS s ->
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder do{ st <- ask
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder ; fromPrinter (show . (fS st)) "Ext_SIG_ITEMS" s }
b53688bfed888214b485cf76439d57262d80e0a7Christian Maederinstance ItemConvertible (SORT_ITEM f) (Reader (TS b s f)) where
fdac680252d7347858bd67b4c2a2aaa52e623815Christian Maeder Sort_decl l rg -> mkItemM "Sort_decl" rg $ listFromL
fdac680252d7347858bd67b4c2a2aaa52e623815Christian Maeder $ listWithLIT "SORT" l
a9e804dbec424ec36e34bab955cbe90edac5baa6Christian Maeder Subsort_decl sl s rg -> mkItemMM "Subsort_decl" rg
f8cc2399c16fcda7e3bf9d901a0de0cc8a455f86Ewaryst Schulz [ fromL "SORTS" $ listWithLIT "SORT" sl
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder , fromC $ withLIT "SORT" s]
b76d27eba526ecac2a20400fa505ec5c642ae7d2Dominik Luecke Subsort_defn s v s' f rg ->
b76d27eba526ecac2a20400fa505ec5c642ae7d2Dominik Luecke mkItemMM "Subsort_defn" rg
8a5c05062ef501bf725a86a370a5145a198e81fdKlaus Luettich [ fromC $ withLIT "SORT" s, fromC $ withLIT "VAR" v
8a5c05062ef501bf725a86a370a5145a198e81fdKlaus Luettich , fromC $ withLIT "SORT" s', fromAC f]
8a5c05062ef501bf725a86a370a5145a198e81fdKlaus Luettich Iso_decl l rg -> mkItemM "Iso_decl" rg $ listFromL
2353f65833a3da763392f771223250cd50b8d873Christian Maeder $ listWithLIT "SORT" l
2353f65833a3da763392f771223250cd50b8d873Christian Maederinstance ItemConvertible (OP_ITEM f) (Reader (TS b s f)) where
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder Op_decl onl ot oal rg ->
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder mkItemMM "Op_decl" rg
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder [ fromL "OP_NAMES" $ listWithLIT "OP_NAME" onl, fromC ot
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder , fromL "OP_ATTRIBS" oal]
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder Op_defn on oh at rg ->
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder mkItemMM "Op_defn" rg [ fromC $ withLIT "OP_NAME" on, fromC oh
00df6fd583c19393fa141d5a0e21ac74c7bf5b19Christian Maederinstance ItemConvertible (PRED_ITEM f) (Reader (TS b s f)) where
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder Pred_decl pnl pt rg ->
96ae1a1d2197d0e0d5b80da2474b64c456feb1b0Christian Maeder mkItemMM "Pred_decl" rg
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder [fromL "PRED_NAMES" $ listWithLIT "PRED_NAME" pnl, fromC pt]
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder Pred_defn pn ph af rg ->
8d780c893d6df5dab3dcc7d8444b7517f6547f11Christian Maeder mkItemMM "Pred_defn" rg [ fromC $ withLIT "PRED_NAME" pn, fromC ph
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maeder-------------------- not further expanded --------------------
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaederfromPrinterWithRg :: (Monad m, GetRange a) =>
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder (a -> String) -> String -> a -> m Item
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaederfromPrinterWithRg = fromPrinterWithRange getRange
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian MaederfromPrinterWithRange
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder :: Monad m => (a -> Range) -> (a -> String) -> String -> a -> m Item
bc263f610d20a9cd3014ddfca903026127fa0d48Christian MaederfromPrinterWithRange r p n o = mkItemMM (n, p o) (r o) []
bbba6dd86153aacb0f662b182b128df0eb09fd54Christian MaederfromPrinter :: Monad m => (a -> String) -> String -> a -> m Item
16b71dad8d398af412d66a4f4763f1ada5b03d23Christian MaederfromPrinter p n o = mkItemMM (n, p o) nullRange []
d96bfd1d7a4595bfff87771b91797330fa939455Christian MaederlitFromPrinterWithRg :: (Monad m, GetRange a) =>
8c8545dd3bf34fbcbc16904b65d249658f8f9efcChristian Maeder (a -> String) -> LITC a -> m Item
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian MaederlitFromPrinterWithRg p (LITC (IT l) o) =
34d14197eb3dd643a8e6ef3ed8cba5629528e97fAivaras Jakubauskas mkItemMM (IT $ l ++ [p o]) (getRange o) []
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maederinstance ItemConvertible OP_TYPE (Reader (TS b s f)) where
b6ff72be73dad3d1394cf2c71e29e67624ff030bChristian Maeder toitem = fromPrinterWithRg toString "OP_TYPE"
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maederinstance ItemConvertible OP_HEAD (Reader (TS b s f)) where
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder toitem = fromPrinterWithRg toString "OP_HEAD"
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maederinstance ItemConvertible (OP_ATTR f) (Reader (TS b s f)) where
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder do{ st <- ask
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder ; fromPrinter (show . printAttr (fF st)) "OP_ATTR" a }
2360728d4185c0c04279c999941c64d36626af79Christian Maederinstance ItemConvertible PRED_TYPE (Reader (TS b s f)) where
2360728d4185c0c04279c999941c64d36626af79Christian Maeder toitem = fromPrinterWithRg toString "PRED_TYPE"
96ae1a1d2197d0e0d5b80da2474b64c456feb1b0Christian Maederinstance ItemConvertible PRED_HEAD (Reader (TS b s f)) where
2360728d4185c0c04279c999941c64d36626af79Christian Maeder toitem = fromPrinterWithRg (show . printPredHead) "PRED_HEAD"
8d780c893d6df5dab3dcc7d8444b7517f6547f11Christian Maederinstance ItemConvertible DATATYPE_DECL (Reader (TS b s f)) where
2360728d4185c0c04279c999941c64d36626af79Christian Maeder toitem = fromPrinterWithRg toString "DATATYPE_DECL"
dff1de7ad15d1582e25d636c3724dd202874897fChristian Maederinstance ItemConvertible VAR_DECL (Reader (TS b s f)) where
2360728d4185c0c04279c999941c64d36626af79Christian Maeder toitem = fromPrinterWithRg toString "VAR_DECL"
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maederinstance ItemConvertible (FORMULA f) (Reader (TS b s f)) where
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder toitem f = do
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder fromPrinterWithRange (Range . formulaRange)
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder (show . printFormula (fF st)) "FORMULA" f
bc263f610d20a9cd3014ddfca903026127fa0d48Christian Maederinstance ItemConvertible (TERM f) (Reader (TS b s f)) where
966519955f5f7111abac20118563132b9dd41165Christian Maeder toitem f = do
5a448e9be8c4482a978b174b744237757335140fChristian Maeder fromPrinterWithRange (Range . termRange)
d96bfd1d7a4595bfff87771b91797330fa939455Christian Maeder (show . printTerm (fF st)) "TERM" f
d27b1887e61f1dc53d77c37f59dbf5019242a686Christian Maederinstance ItemConvertible (LITC Id) (Reader (TS b s f)) where
34d14197eb3dd643a8e6ef3ed8cba5629528e97fAivaras Jakubauskas toitem = litFromPrinterWithRg toString
d4ebd9e5adc974cfa2bdf4bdd155e07be0e26f75Christian Maederinstance ItemConvertible (LITC Token) (Reader (TS b s f)) where
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder toitem = litFromPrinterWithRg toString