suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Changed rntState so that it "nulls" the bodies of procs and functions first

Browse Source
This commit is contained in:
Neil Brown 2008-02-24 15:54:18 +00:00
parent caff04c548
commit 5d9e2d8e33
1 changed files with 11 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
transformations/SimplifyTypes.hs
View File

@ -21,8 +21,10 @@ module SimplifyTypes (simplifyTypes) where
import Control.Monad.State import Control.Monad.State
import Data.Generics import Data.Generics
import qualified Data.Map as Map
import qualified AST as A import qualified AST as A
import CompState
import Metadata import Metadata
import Pass import Pass
import qualified Properties as Prop import qualified Properties as Prop
@ -47,5 +49,13 @@ resolveNamedTypes = doGeneric `extM` doType
-- | Resolve named types in CompState. -- | Resolve named types in CompState.
rntState :: Data t => t -> PassM t rntState :: Data t => t -> PassM t
rntState p = (get >>= resolveNamedTypes >>= put) >> return p rntState p = (get >>= nullBodies >>= resolveNamedTypes >>= put) >> return p
where
nullBodies :: CompState -> PassM CompState
nullBodies st = return $ st {csNames = Map.map nullProcFuncDefs (csNames st)}
nullProcFuncDefs :: A.NameDef -> A.NameDef
nullProcFuncDefs (A.NameDef m n on nt (A.Proc m' sm fs _) am pl) = (A.NameDef m n on nt (A.Proc m' sm fs (A.Skip m')) am pl)
nullProcFuncDefs (A.NameDef m n on nt (A.Function m' sm ts fs _) am pl) = (A.NameDef m n on nt (A.Function m' sm ts fs (A.Several m' [])) am pl)
nullProcFuncDefs x = x