hets/CSL/Fold.hs

	Fold.hs revision e9458b1a7a19a63aa4c179f9ab20f4d50681c168
446N/A{- |
4744N/AModule      :  ./CSL/Fold.hs
446N/ADescription :  folding functions for CSL terms and commands
446N/ACopyright   :  (c) Ewaryst.Schulz, DFKI 2010
446N/ALicense     :  GPLv2 or higher, see LICENSE.txt
446N/A
446N/AMaintainer  :  Ewaryst.Schulz@dfki.de
446N/AStability   :  provisional
446N/APortability :  portable
446N/A
6982N/Afolding functions for CSL terms and commands
6982N/A
446N/A-}
446N/A
446N/Amodule CSL.Fold where
446N/A
6982N/Aimport Common.Id
6982N/Aimport CSL.AS_BASIC_CSL (EXPRESSION (..), CMD (..), OpDecl, EXTPARAM , APInt, APFloat, OPID)
6982N/A
6982N/Adata Record a b = Record
446N/A    { foldAss :: CMD -> OpDecl -> b -> a
446N/A    , foldCmd :: CMD -> String -> [b] -> a
446N/A    , foldSequence :: CMD -> [a] -> a
446N/A    , foldCond :: CMD -> [(b, [a])] -> a
5073N/A    , foldRepeat :: CMD -> b -> [a] -> a
5508N/A
446N/A    , foldVar :: EXPRESSION -> Token -> b
446N/A    , foldOp :: EXPRESSION -> OPID -> [EXTPARAM] -> [b] -> Range -> b
446N/A    , foldList :: EXPRESSION -> [b] -> Range -> b
4744N/A    , foldInterval :: EXPRESSION -> Double -> Double -> Range -> b
4744N/A    , foldInt :: EXPRESSION -> APInt -> Range -> b
4744N/A    , foldRat :: EXPRESSION -> APFloat -> Range -> b
4744N/A    }
4744N/A
4744N/A{- | Produces an error with given message on all entries. Use this if you
4744N/Aoverwrite only the EXPRESSION part and you do not use the CMD part anyway
4744N/A, e.g., if you use the record in foldTerm -}
4744N/AemptyRecord :: String -> Record a b
4744N/AemptyRecord s =
4744N/A    Record { foldAss = error s
4744N/A           , foldCmd = error s
4744N/A           , foldSequence = error s
4744N/A           , foldCond = error s
4744N/A           , foldRepeat = error s
4744N/A
4744N/A           , foldVar = error s
4744N/A           , foldOp = error s
4744N/A           , foldList = error s
4744N/A           , foldInterval = error s
4744N/A           , foldInt = error s
4744N/A           , foldRat = error s
5073N/A           }
4744N/A
5073N/A-- | The identity transformation
4744N/AidRecord :: Record CMD EXPRESSION
4744N/AidRecord =
4744N/A    Record { foldAss = \ v _ _ -> v
4744N/A           , foldCmd = \ v _ _ -> v
4744N/A           , foldSequence = const
957N/A           , foldCond = const
4744N/A           , foldRepeat = \ v _ _ -> v
4744N/A
4744N/A           , foldVar = const
4744N/A           , foldOp = \ v _ _ _ _ -> v
4744N/A           , foldList = \ v _ _ -> v
4744N/A           , foldInterval = \ v _ _ _ -> v
4744N/A           , foldInt = \ v _ _ -> v
4744N/A           , foldRat = \ v _ _ -> v
4744N/A           }
4744N/A
4744N/A{- | Passes the transformation through the CMD part and is the identity
4744N/Aon the EXPRESSION part -}
4744N/ApassRecord :: Record CMD EXPRESSION
4744N/ApassRecord =
4744N/A    idRecord { foldAss = const Ass
4744N/A             , foldCmd = const Cmd
4744N/A             , foldSequence = const Sequence
4744N/A             , foldCond = const Cond
4744N/A             , foldRepeat = const Repeat
4744N/A             }
4744N/A
4744N/A-- | Passes the transformation through both, the CMD and the EXPRESSION part
4744N/ApassAllRecord :: Record CMD EXPRESSION
4744N/ApassAllRecord =
4744N/A    passRecord { foldVar = const Var
4744N/A               , foldOp = const Op
4744N/A               , foldList = const List
4744N/A               , foldInterval = const Interval
4744N/A               , foldInt = const Int
4744N/A               , foldRat = const Rat
4744N/A               }
4744N/A
4744N/A{- | Passes the transformation through the 'CMD' part by concatenating the
4744N/Aprocessed list from left to right and identity on expression part -}
4744N/AlistCMDRecord :: Record [a] EXPRESSION
4744N/AlistCMDRecord =
4744N/A    idRecord { foldAss = \ _ _ _ -> []
4744N/A             , foldCmd = \ _ _ _ -> []
4744N/A             , foldSequence = const concat
4744N/A             , foldCond = \ _ -> concat . concatMap snd
4744N/A             , foldRepeat = \ _ _ -> concat
4744N/A             }
4618N/A
4744N/A{- | Returns the first constant on the CMD part and the second
4744N/Aon the EXPRESSION part -}
4744N/AconstRecord :: a -> b -> Record a b
4744N/AconstRecord a b =
4744N/A    Record { foldAss = \ _ _ _ -> a
4744N/A           , foldCmd = \ _ _ _ -> a
4744N/A           , foldSequence = \ _ _ -> a
4744N/A           , foldCond = \ _ _ -> a
4744N/A           , foldRepeat = \ _ _ _ -> a
4744N/A
4744N/A           , foldVar = \ _ _ -> b
4744N/A           , foldOp = \ _ _ _ _ _ -> b
4744N/A           , foldList = \ _ _ _ -> b
4744N/A           , foldInterval = \ _ _ _ _ -> b
4744N/A           , foldInt = \ _ _ _ -> b
4744N/A           , foldRat = \ _ _ _ -> b
4744N/A           }
4744N/A
4744N/AfoldCMD :: Record a b -> CMD -> a
4744N/AfoldCMD r f = case f of
5073N/A   Ass c def -> foldAss r f c $ foldTerm r def
4744N/A   Cmd s l -> foldCmd r f s $ map (foldTerm r) l
5073N/A   Sequence l -> foldSequence r f $ map (foldCMD r) l
4744N/A   Cond l -> foldCond r f $ map cf l where
4744N/A                     cf (x, y) = (foldTerm r x, map (foldCMD r) y)
4744N/A   Repeat c l -> foldRepeat r f (foldTerm r c) $ map (foldCMD r) l
4744N/A
4744N/AfoldTerm :: Record a b -> EXPRESSION -> b
4744N/AfoldTerm r t = case t of
4744N/A    Var tok -> foldVar r t tok
4744N/A    Op s epl al rg -> foldOp r t s epl (map (foldTerm r) al) rg
4744N/A    List l rg -> foldList r t (map (foldTerm r) l) rg
4744N/A    Interval from to rg -> foldInterval r t from to rg
4744N/A    Int i rg -> foldInt r t i rg
4744N/A    Rat f rg -> foldRat r t f rg
4744N/A