7d9110a9b0
This is solely because GHC 6.6 doesn't like them (it complains about the type variable already being in scope -- which it is, but there's nothing I can do about that!). This doesn't lose any safety; if you try to write a transformation for something that's not Data you'll find out when you try to pass it to one of the application functions.
95 lines
3.5 KiB
Haskell
95 lines
3.5 KiB
Haskell
{-
|
|
Tock: a compiler for parallel languages
|
|
Copyright (C) 2008 University of Kent
|
|
|
|
This program is free software; you can redistribute it and/or modify it
|
|
under the terms of the GNU General Public License as published by the
|
|
Free Software Foundation, either version 2 of the License, or (at your
|
|
option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful, but
|
|
WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License along
|
|
with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
-}
|
|
|
|
-- | Traversal strategies over the AST and other data types.
|
|
module Traversal (
|
|
ExplicitTrans, Transform, Check
|
|
, transformToExplicitDepth, checkToTransform
|
|
, applyExplicitM, applyExplicitM2
|
|
, applyDepthM, applyDepthM2
|
|
, checkDepthM
|
|
) where
|
|
|
|
import Data.Generics
|
|
|
|
import GenericUtils
|
|
import Pass
|
|
|
|
-- | A transformation for a single 'Data' type with explicit descent.
|
|
-- The first argument passed is a function that can be called to explicitly
|
|
-- descend into a generic value.
|
|
type ExplicitTrans t = (forall s. Data s => s -> PassM s) -> t -> PassM t
|
|
|
|
-- | A transformation for a single 'Data' type with implicit descent.
|
|
-- This can be applied recursively throughout a data structure.
|
|
type Transform t = t -> PassM t
|
|
|
|
-- | A check for a single 'Data' type with implicit descent.
|
|
-- This is like 'Transform', but it doesn't change the value; it may fail or
|
|
-- modify the state, though.
|
|
type Check t = t -> PassM ()
|
|
|
|
-- | Make an 'ExplicitTrans' that applies a 'Transform', recursing depth-first.
|
|
transformToExplicitDepth :: Data t => Transform t -> ExplicitTrans t
|
|
transformToExplicitDepth f descend x = descend x >>= f
|
|
|
|
-- | Make a 'Transform' that applies a 'Check'.
|
|
checkToTransform :: Data t => Check t -> Transform t
|
|
checkToTransform f x = f x >> return x
|
|
|
|
-- | Apply an explicit transformation.
|
|
applyExplicitM :: forall t1 s. (Data t1, Data s) =>
|
|
ExplicitTrans t1 -> s -> PassM s
|
|
applyExplicitM f1 = doGeneric `extM` (doSpecific f1)
|
|
where
|
|
doGeneric :: Data t => t -> PassM t
|
|
doGeneric = gmapMFor (undefined :: t1) (applyExplicitM f1)
|
|
|
|
doSpecific :: Data t => ExplicitTrans t -> t -> PassM t
|
|
doSpecific f x = f doGeneric x
|
|
|
|
-- | Apply two explicit transformations.
|
|
applyExplicitM2 :: forall t1 t2 s. (Data t1, Data t2, Data s) =>
|
|
ExplicitTrans t1 -> ExplicitTrans t2 -> s -> PassM s
|
|
applyExplicitM2 f1 f2 = doGeneric `extM` (doSpecific f1)
|
|
`extM` (doSpecific f2)
|
|
where
|
|
doGeneric :: Data t => t -> PassM t
|
|
doGeneric = gmapMFor2 (undefined :: t1) (undefined :: t2)
|
|
(applyExplicitM2 f1 f2)
|
|
|
|
doSpecific :: Data t => ExplicitTrans t -> t -> PassM t
|
|
doSpecific f x = f doGeneric x
|
|
|
|
-- | Apply a transformation, recursing depth-first.
|
|
applyDepthM :: forall t1 s. (Data t1, Data s) =>
|
|
Transform t1 -> s -> PassM s
|
|
applyDepthM f = applyExplicitM (transformToExplicitDepth f)
|
|
|
|
-- | Apply two transformations, recursing depth-first.
|
|
applyDepthM2 :: forall t1 t2 s. (Data t1, Data t2, Data s) =>
|
|
Transform t1 -> Transform t2 -> s -> PassM s
|
|
applyDepthM2 f1 f2 = applyExplicitM2 (transformToExplicitDepth f1)
|
|
(transformToExplicitDepth f2)
|
|
|
|
-- | Apply a check, recursing depth-first.
|
|
checkDepthM :: forall t1 s. (Data t1, Data s) =>
|
|
Check t1 -> s -> PassM s
|
|
checkDepthM f = applyDepthM (checkToTransform f)
|
|
|