329c739bc05b8ce8d54f81071d0826ff771d1f78Christian MaederDescription : morphism mapping for FPL
329c739bc05b8ce8d54f81071d0826ff771d1f78Christian MaederCopyright : (c) Christian Maeder, DFKI GmbH 2011
329c739bc05b8ce8d54f81071d0826ff771d1f78Christian MaederLicense : GPLv2 or higher, see LICENSE.txt
329c739bc05b8ce8d54f81071d0826ff771d1f78Christian MaederMaintainer : Christian.Maeder@dfki.de
329c739bc05b8ce8d54f81071d0826ff771d1f78Christian MaederStability : provisional
329c739bc05b8ce8d54f81071d0826ff771d1f78Christian MaederPortability : portable
329c739bc05b8ce8d54f81071d0826ff771d1f78Christian Maedermodule Fpl.Morphism (FplMor, mapFplSen) where
329c739bc05b8ce8d54f81071d0826ff771d1f78Christian Maedertype FplMor = Morphism TermExt SignExt (DefMorExt SignExt)
329c739bc05b8ce8d54f81071d0826ff771d1f78Christian MaedermapFplSen :: FplMor -> FplForm -> FplForm
329c739bc05b8ce8d54f81071d0826ff771d1f78Christian MaedermapFplSen = mapSen mapTermExt
329c739bc05b8ce8d54f81071d0826ff771d1f78Christian MaedermapTermExt :: FplMor -> TermExt -> TermExt
329c739bc05b8ce8d54f81071d0826ff771d1f78Christian MaedermapTermExt m te = let rec = mapTerm mapTermExt m in case te of
329c739bc05b8ce8d54f81071d0826ff771d1f78Christian Maeder FixDef fd -> FixDef $ mapFunDef m fd
329c739bc05b8ce8d54f81071d0826ff771d1f78Christian Maeder Case o l r -> Case (rec o) (map (\ (p, t) -> (rec p, rec t)) l) r
329c739bc05b8ce8d54f81071d0826ff771d1f78Christian Maeder Let fd t r -> Let (mapFunDef m fd) (rec t) r
1aa11f4e4b984f2a6d6ce9700cbe82283c8d196aChristian Maeder IfThenElse f t e r -> IfThenElse (rec f) (rec t) (rec e) r
1aa11f4e4b984f2a6d6ce9700cbe82283c8d196aChristian Maeder EqTerm t e r -> EqTerm (rec t) (rec e) r
c8ecc5578d32b222f35b625d4dfe7a3fd8bb4173Christian Maeder BoolTerm t -> BoolTerm (rec t)
329c739bc05b8ce8d54f81071d0826ff771d1f78Christian MaedermapFunDef :: FplMor -> FunDef -> FunDef
51b1633dc0785a542da974fae21fa7d6622c934eChristian MaedermapFunDef m (FunDef i h@(Op_head k vs ms q) at r) =
51b1633dc0785a542da974fae21fa7d6622c934eChristian Maeder let nvs = map (mapVars m) vs
51b1633dc0785a542da974fae21fa7d6622c934eChristian Maeder nt = fmap (mapTerm mapTermExt m) at
51b1633dc0785a542da974fae21fa7d6622c934eChristian Maeder in maybe (FunDef i (Op_head k nvs ms q) nt r)
51b1633dc0785a542da974fae21fa7d6622c934eChristian Maeder (\ hty -> let
51b1633dc0785a542da974fae21fa7d6622c934eChristian Maeder (j, ty) = mapOpSym (sort_map m) (op_map m) (i, toOpType hty)
51b1633dc0785a542da974fae21fa7d6622c934eChristian Maeder in FunDef j (Op_head (opKind ty) nvs (fmap (mapSrt m) ms) q) nt r)
51b1633dc0785a542da974fae21fa7d6622c934eChristian Maeder $ headToType h