diff --git a/fco2/Pass.hs b/fco2/Pass.hs index 7412e47..9ba20cf 100644 --- a/fco2/Pass.hs +++ b/fco2/Pass.hs @@ -3,11 +3,13 @@ module Pass where import Control.Monad.Error import Control.Monad.State +import Data.Generics import Data.List import System.IO import qualified AST as A import Errors +import Metadata import ParseState import PrettyShow @@ -78,3 +80,10 @@ numberLines s = concat $ intersperse "\n" $ [show n ++ ": " ++ s | (n, s) <- zip [1..] (lines s)] +-- | Make a generic rule for a pass. +makeGeneric :: (Data t) => (forall s. Data s => s -> PassM s) -> t -> PassM t +makeGeneric top + = (gmapM top) + `extM` (return :: String -> PassM String) + `extM` (return :: Meta -> PassM Meta) + diff --git a/fco2/SimplifyExprs.hs b/fco2/SimplifyExprs.hs index 6f79ba8..7bf0757 100644 --- a/fco2/SimplifyExprs.hs +++ b/fco2/SimplifyExprs.hs @@ -28,7 +28,7 @@ functionsToProcs :: Data t => t -> PassM t functionsToProcs = doGeneric `extM` doSpecification where doGeneric :: Data t => t -> PassM t - doGeneric = gmapM functionsToProcs + doGeneric = makeGeneric functionsToProcs doSpecification :: A.Specification -> PassM A.Specification doSpecification (A.Specification m n (A.Function mf sm rts fs vp)) @@ -66,7 +66,7 @@ removeAfter :: Data t => t -> PassM t removeAfter = doGeneric `extM` doExpression where doGeneric :: Data t => t -> PassM t - doGeneric = gmapM removeAfter + doGeneric = makeGeneric removeAfter doExpression :: A.Expression -> PassM A.Expression doExpression (A.Dyadic m A.After a b) @@ -82,7 +82,7 @@ expandArrayLiterals :: Data t => t -> PassM t expandArrayLiterals = doGeneric `extM` doArrayElem where doGeneric :: Data t => t -> PassM t - doGeneric = gmapM expandArrayLiterals + doGeneric = makeGeneric expandArrayLiterals doArrayElem :: A.ArrayElem -> PassM A.ArrayElem doArrayElem ae@(A.ArrayElemExpr e) @@ -107,7 +107,7 @@ pullUp :: Data t => t -> PassM t pullUp = doGeneric `extM` doStructured `extM` doProcess `extM` doSpecification `extM` doExpression `extM` doVariable `extM` doExpressionList where doGeneric :: Data t => t -> PassM t - doGeneric = gmapM pullUp + doGeneric = makeGeneric pullUp -- | When we encounter a Structured, create a new pulled items state, -- recurse over it, then apply whatever pulled items we found to it. diff --git a/fco2/SimplifyProcs.hs b/fco2/SimplifyProcs.hs index e9b5b12..fa09c7d 100644 --- a/fco2/SimplifyProcs.hs +++ b/fco2/SimplifyProcs.hs @@ -25,7 +25,7 @@ parsToProcs :: Data t => t -> PassM t parsToProcs = doGeneric `extM` doProcess where doGeneric :: Data t => t -> PassM t - doGeneric = gmapM parsToProcs + doGeneric = makeGeneric parsToProcs doProcess :: A.Process -> PassM A.Process doProcess (A.Par m pm s) @@ -59,7 +59,7 @@ removeParAssign :: Data t => t -> PassM t removeParAssign = doGeneric `extM` doProcess where doGeneric :: Data t => t -> PassM t - doGeneric = gmapM removeParAssign + doGeneric = makeGeneric removeParAssign doProcess :: A.Process -> PassM A.Process doProcess (A.Assign m vs@(_:_:_) (A.ExpressionList _ es)) diff --git a/fco2/Unnest.hs b/fco2/Unnest.hs index 51d13b1..5c7e2b2 100644 --- a/fco2/Unnest.hs +++ b/fco2/Unnest.hs @@ -25,11 +25,17 @@ type NameMap = Map.Map String A.Name -- | Get the set of free names within a block of code. freeNamesIn :: Data t => t -> NameMap -freeNamesIn = doGeneric `extQ` doName `extQ` doStructured `extQ` doSpecType +freeNamesIn = doGeneric + `extQ` (ignore :: String -> NameMap) + `extQ` (ignore :: Meta -> NameMap) + `extQ` doName `extQ` doStructured `extQ` doSpecType where doGeneric :: Data t => t -> NameMap doGeneric n = Map.unions $ gmapQ freeNamesIn n + ignore :: t -> NameMap + ignore s = Map.empty + doName :: A.Name -> NameMap doName n = Map.singleton (A.nameName n) n @@ -58,7 +64,10 @@ freeNamesIn = doGeneric `extQ` doName `extQ` doStructured `extQ` doSpecType -- | Replace names. replaceNames :: Data t => [(A.Name, A.Name)] -> t -> t -replaceNames map p = everywhere (mkT $ doName) p +replaceNames map p = everywhere (mkT doName + `extT` (id :: String -> String) + `extT` (id :: Meta -> Meta) + ) p where smap = [(A.nameName f, t) | (f, t) <- map] @@ -73,7 +82,7 @@ removeFreeNames :: Data t => t -> PassM t removeFreeNames = doGeneric `extM` doSpecification `extM` doProcess where doGeneric :: Data t => t -> PassM t - doGeneric = gmapM removeFreeNames + doGeneric = makeGeneric removeFreeNames doSpecification :: A.Specification -> PassM A.Specification doSpecification spec = case spec of @@ -154,7 +163,7 @@ removeNesting p pullSpecs = doGeneric `extM` doStructured doGeneric :: Data t => t -> PassM t - doGeneric = gmapM pullSpecs + doGeneric = makeGeneric pullSpecs doStructured :: A.Structured -> PassM A.Structured doStructured s@(A.Spec m spec@(A.Specification _ n st) subS)