hets/CSL/Fold.hs

{- |
Module      :  ./CSL/Fold.hs
Description :  folding functions for CSL terms and commands
Copyright   :  (c) Ewaryst.Schulz, DFKI 2010
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Ewaryst.Schulz@dfki.de
Stability   :  provisional
Portability :  portable

folding functions for CSL terms and commands

-}

module CSL.Fold where

import Common.Id
import CSL.AS_BASIC_CSL (EXPRESSION (..), CMD (..), OpDecl, EXTPARAM , APInt, APFloat, OPID)

data Record a b = Record
    { foldAss :: CMD -> OpDecl -> b -> a
    , foldCmd :: CMD -> String -> [b] -> a
    , foldSequence :: CMD -> [a] -> a
    , foldCond :: CMD -> [(b, [a])] -> a
    , foldRepeat :: CMD -> b -> [a] -> a

    , foldVar :: EXPRESSION -> Token -> b
    , foldOp :: EXPRESSION -> OPID -> [EXTPARAM] -> [b] -> Range -> b
    , foldList :: EXPRESSION -> [b] -> Range -> b
    , foldInterval :: EXPRESSION -> Double -> Double -> Range -> b
    , foldInt :: EXPRESSION -> APInt -> Range -> b
    , foldRat :: EXPRESSION -> APFloat -> Range -> b
    }

{- | Produces an error with given message on all entries. Use this if you
overwrite only the EXPRESSION part and you do not use the CMD part anyway
, e.g., if you use the record in foldTerm -}
emptyRecord :: String -> Record a b
emptyRecord s =
    Record { foldAss = error s
           , foldCmd = error s
           , foldSequence = error s
           , foldCond = error s
           , foldRepeat = error s

           , foldVar = error s
           , foldOp = error s
           , foldList = error s
           , foldInterval = error s
           , foldInt = error s
           , foldRat = error s
           }

-- | The identity transformation
idRecord :: Record CMD EXPRESSION
idRecord =
    Record { foldAss = \ v _ _ -> v
           , foldCmd = \ v _ _ -> v
           , foldSequence = const
           , foldCond = const
           , foldRepeat = \ v _ _ -> v

           , foldVar = const
           , foldOp = \ v _ _ _ _ -> v
           , foldList = \ v _ _ -> v
           , foldInterval = \ v _ _ _ -> v
           , foldInt = \ v _ _ -> v
           , foldRat = \ v _ _ -> v
           }

{- | Passes the transformation through the CMD part and is the identity
on the EXPRESSION part -}
passRecord :: Record CMD EXPRESSION
passRecord =
    idRecord { foldAss = const Ass
             , foldCmd = const Cmd
             , foldSequence = const Sequence
             , foldCond = const Cond
             , foldRepeat = const Repeat
             }

-- | Passes the transformation through both, the CMD and the EXPRESSION part
passAllRecord :: Record CMD EXPRESSION
passAllRecord =
    passRecord { foldVar = const Var
               , foldOp = const Op
               , foldList = const List
               , foldInterval = const Interval
               , foldInt = const Int
               , foldRat = const Rat
               }

{- | Passes the transformation through the 'CMD' part by concatenating the
processed list from left to right and identity on expression part -}
listCMDRecord :: Record [a] EXPRESSION
listCMDRecord =
    idRecord { foldAss = \ _ _ _ -> []
             , foldCmd = \ _ _ _ -> []
             , foldSequence = const concat
             , foldCond = \ _ -> concat . concatMap snd
             , foldRepeat = \ _ _ -> concat
             }

{- | Returns the first constant on the CMD part and the second
on the EXPRESSION part -}
constRecord :: a -> b -> Record a b
constRecord a b =
    Record { foldAss = \ _ _ _ -> a
           , foldCmd = \ _ _ _ -> a
           , foldSequence = \ _ _ -> a
           , foldCond = \ _ _ -> a
           , foldRepeat = \ _ _ _ -> a

           , foldVar = \ _ _ -> b
           , foldOp = \ _ _ _ _ _ -> b
           , foldList = \ _ _ _ -> b
           , foldInterval = \ _ _ _ _ -> b
           , foldInt = \ _ _ _ -> b
           , foldRat = \ _ _ _ -> b
           }

foldCMD :: Record a b -> CMD -> a
foldCMD r f = case f of
   Ass c def -> foldAss r f c $ foldTerm r def
   Cmd s l -> foldCmd r f s $ map (foldTerm r) l
   Sequence l -> foldSequence r f $ map (foldCMD r) l
   Cond l -> foldCond r f $ map cf l where
                     cf (x, y) = (foldTerm r x, map (foldCMD r) y)
   Repeat c l -> foldRepeat r f (foldTerm r c) $ map (foldCMD r) l

foldTerm :: Record a b -> EXPRESSION -> b
foldTerm r t = case t of
    Var tok -> foldVar r t tok
    Op s epl al rg -> foldOp r t s epl (map (foldTerm r) al) rg
    List l rg -> foldList r t (map (foldTerm r) l) rg
    Interval from to rg -> foldInterval r t from to rg
    Int i rg -> foldInt r t i rg
    Rat f rg -> foldRat r t f rg