Fold.hs revision c3ebe5e0a6545997d56e4156de02d00518c71c0c
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederModule : $Header$
09249711700a6acbc40a2e337688b434d7aafa28Christian MaederDescription : folding functions for VSE progams
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederCopyright : (c) Christian Maeder, DFKI Bremen 2008
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederMaintainer : Christian.Maeder@dfki.de
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian MaederStability : provisional
413db961f13e112716509b6d61d7a7bbf50c98b2Christian MaederPortability : portable
f3a94a197960e548ecd6520bb768cb0d547457bbChristian Maederfolding functions for VSE progams
e8ffec0fa3d3061061bdc16e44247b9cf96b050fChristian Maederimport qualified Data.Set as Set
72b9099aeec0762bae4546db3bc4b48721027bf4Christian Maeder-- | fold record
0df692ce8b9293499b2e1768458613a63e7b5cd0Christian Maederdata FoldRec a = FoldRec
d48085f765fca838c1d972d2123601997174583dChristian Maeder { foldAbort :: Program -> a
47d6bc7bc9a708427f96be8d805f712697ad3d9eChristian Maeder , foldSkip :: Program -> a
23a00c966f2aa8da525d7a7c51933c99964426c0Christian Maeder , foldAssign :: Program -> VAR -> TERM () -> a
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , foldCall :: Program -> FORMULA () -> a
72b9099aeec0762bae4546db3bc4b48721027bf4Christian Maeder , foldReturn :: Program -> (TERM ()) -> a
72909c6c1cfe9702f5910d0a135c8b55729c7917Christian Maeder , foldBlock :: Program -> [VAR_DECL] -> a -> a
72b9099aeec0762bae4546db3bc4b48721027bf4Christian Maeder , foldSeq :: Program -> a -> a -> a
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder , foldIf :: Program -> FORMULA () -> a -> a -> a
3c5cc698b0c061209ff83eb8de027daef5ae922aChristian Maeder , foldWhile :: Program -> FORMULA () -> a -> a }
3c5cc698b0c061209ff83eb8de027daef5ae922aChristian Maeder-- | fold function
3c5cc698b0c061209ff83eb8de027daef5ae922aChristian MaederfoldProg :: FoldRec a -> Program -> a
413db961f13e112716509b6d61d7a7bbf50c98b2Christian MaederfoldProg r p = case unRanged p of
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder Abort -> foldAbort r p
413db961f13e112716509b6d61d7a7bbf50c98b2Christian Maeder Skip -> foldSkip r p
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Assign v t-> foldAssign r p v t
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Call f -> foldCall r p f
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Return t -> foldReturn r p t
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder Block vs q -> foldBlock r p vs $ foldProg r q
8452387b4c54b8dd36c012b216e0b0c5004ca6f1Christian Maeder Seq p1 p2 -> foldSeq r p (foldProg r p1) $ foldProg r p2
c18e9c3c6d5039618f1f2c05526ece84c7794ea3Christian Maeder If f p1 p2 -> foldIf r p f (foldProg r p1) $ foldProg r p2
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder While f q -> foldWhile r p f $ foldProg r q
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaedermapRec :: FoldRec Program
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaedermapRec = FoldRec
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder { foldAbort = id
8f88a86e9656713ea4608541b8b47bb47a755bffChristian Maeder , foldSkip = id
2f6227e9ec96ca827cc40078916f18d54a075136Christian Maeder , foldAssign = \ (Ranged _ r) v t -> Ranged (Assign v t) r
2f6227e9ec96ca827cc40078916f18d54a075136Christian Maeder , foldCall = \ (Ranged _ r) f -> Ranged (Call f) r
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder , foldReturn = \ (Ranged _ r) t -> Ranged (Return t) r
2f6227e9ec96ca827cc40078916f18d54a075136Christian Maeder , foldBlock = \ (Ranged _ r) vs p -> Ranged (Block vs p) r
2f6227e9ec96ca827cc40078916f18d54a075136Christian Maeder , foldSeq = \ (Ranged _ r) p1 p2 -> Ranged (Seq p1 p2) r
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , foldIf = \ (Ranged _ r) c p1 p2 -> Ranged (If c p1 p2) r
120efeede54a5f7650cda8e91363bd6832eac9a9Christian Maeder , foldWhile = \ (Ranged _ r) c p -> Ranged (While c p) r }
120efeede54a5f7650cda8e91363bd6832eac9a9Christian MaedermapProg :: (TERM () -> TERM ()) -> (FORMULA () -> FORMULA ())
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder -> FoldRec Program
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaedermapProg mt mf = mapRec
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder { foldAssign = \ (Ranged _ r) v t -> Ranged (Assign v $ mt t) r
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder , foldCall = \ (Ranged _ r) f -> Ranged (Call $ mf f) r
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder , foldReturn = \ (Ranged _ r) t -> Ranged (Return $ mt t) r
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder , foldIf = \ (Ranged _ r) c p1 p2 -> Ranged (If (mf c) p1 p2) r
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder , foldWhile = \ (Ranged _ r) c p -> Ranged (While (mf c) p) r }
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder-- | collect i.e. variables to be universally bound on the top level
df33a9af92444f63ad545da6bb326aac9284318eChristian MaederconstProg :: (TERM () -> a) -> (FORMULA () -> a) -> ([a] -> a) -> a -> FoldRec a
df33a9af92444f63ad545da6bb326aac9284318eChristian MaederconstProg ft ff join c = FoldRec
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder { foldAbort = const c
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder , foldSkip = const c
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder , foldAssign = \ _ _ t -> ft t
df33a9af92444f63ad545da6bb326aac9284318eChristian Maeder , foldCall = \ _ f -> ff f
120efeede54a5f7650cda8e91363bd6832eac9a9Christian Maeder , foldReturn = \ _ t -> ft t
ce3928e71520030ad0275b72050a8f4377f9313cChristian Maeder , foldBlock = \ _ _ p -> p
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian Maeder , foldSeq = \ _ p1 p2 -> join [p1, p2]
d703a61b7fa9f85d92ac8f768d7c290b7c0a41c5Christian Maeder , foldIf = \ _ f p1 p2 -> join [ff f, p1, p2]
abd8dd44106c507dd2cb64359b63d7d56fa0a9c8Christian Maeder , foldWhile = \ _ f p -> join [ff f, p] }
5a13581acc5a76d392c1dec01657bb3efd4dcf2dChristian MaederprogToSetRec :: Ord a => (TERM () -> Set.Set a) -> (FORMULA () -> Set.Set a)
2f6227e9ec96ca827cc40078916f18d54a075136Christian Maeder -> FoldRec (Set.Set a)
2f6227e9ec96ca827cc40078916f18d54a075136Christian MaederprogToSetRec ft ff = constProg ft ff Set.unions Set.empty