From 9f411bfd457bf7b154fb9be5d5d8183a8ca9b9e2 Mon Sep 17 00:00:00 2001
From: Neil Brown <neil@twistedsquare.com>
Date: Wed, 21 May 2008 12:46:51 +0000
Subject: [PATCH] Fixed the Rain passes so that the order correctly satisfies
 the pre-requisites

---
 frontends/RainPasses.hs | 19 +++++++++++--------
 pass/Pass.hs            |  4 ++++
 pass/PassList.hs        |  8 +++++---
 3 files changed, 20 insertions(+), 11 deletions(-)

diff --git a/frontends/RainPasses.hs b/frontends/RainPasses.hs
index 787206c..9625ed7 100644
--- a/frontends/RainPasses.hs
+++ b/frontends/RainPasses.hs
@@ -31,6 +31,7 @@ import Errors
 import Pass
 import qualified Properties as Prop
 import RainTypes
+import SimplifyTypes
 import TreeUtils
 import Types
 
@@ -38,22 +39,24 @@ import Types
 
 -- | An ordered list of the Rain-specific passes to be run.
 rainPasses :: [Pass]
-rainPasses = makePassesDep' ((== FrontendRain) . csFrontend)
+rainPasses = let f = makePassesDep' ((== FrontendRain) . csFrontend) in f
      [ ("AST Validity check, Rain #1", excludeNonRainFeatures, [], []) -- TODO work out some dependencies
        ,("Dummy Rain pass", return, [], [Prop.retypesChecked])
        ,("Resolve Int -> Int64", transformInt, [], [Prop.noInt])
        ,("Uniquify variable declarations, record declared types and resolve variable names",
            uniquifyAndResolveVars, [Prop.noInt], Prop.agg_namesDone \\ [Prop.inferredTypesRecorded])
-            
-       ,("Fold all constant expressions", constantFoldPass, [Prop.noInt] ++ Prop.agg_namesDone
-            ++ Prop.agg_typesDone, [Prop.constantsFolded, Prop.constantsChecked])
-       ,("Rain Type Checking", performTypeUnification, [Prop.noInt] ++ Prop.agg_namesDone,
-         Prop.agg_typesDone)
-       
        ,("Record inferred name types in dictionary", recordInfNameTypes,
            Prop.agg_namesDone \\ [Prop.inferredTypesRecorded], [Prop.inferredTypesRecorded])
+            
+       ,("Rain Type Checking", performTypeUnification, [Prop.noInt] ++ Prop.agg_namesDone,
+         [Prop.expressionTypesChecked, Prop.functionTypesChecked, Prop.processTypesChecked,
+          Prop.retypesChecked])
+       ,("Fold all constant expressions", constantFoldPass, [Prop.noInt] ++ Prop.agg_namesDone
+            ++ [Prop.inferredTypesRecorded], [Prop.constantsFolded, Prop.constantsChecked])
+
+     ] ++ enablePassesWhen ((== FrontendRain) . csFrontend) simplifyTypes ++ f [
        
-       ,("Find and tag the main function", findMain, Prop.agg_namesDone, [Prop.mainTagged])
+        ("Find and tag the main function", findMain, Prop.agg_namesDone, [Prop.mainTagged])
        ,("Convert seqeach/pareach loops over ranges into simple replicated SEQ/PAR",
          transformEachRange, Prop.agg_typesDone ++ [Prop.constantsFolded], [Prop.eachRangeTransformed])
        ,("Pull up foreach-expressions", pullUpForEach,
diff --git a/pass/Pass.hs b/pass/Pass.hs
index 87ef971..79f35f3 100644
--- a/pass/Pass.hs
+++ b/pass/Pass.hs
@@ -105,6 +105,10 @@ makePassesDep = map (\(s, p, pre, post) -> Pass p s (Set.fromList pre) (Set.from
 makePassesDep' :: (CompState -> Bool) -> [(String, A.AST -> PassM A.AST, [Property], [Property])] -> [Pass]
 makePassesDep' f = map (\(s, p, pre, post) -> Pass p s (Set.fromList pre) (Set.fromList post) f)
 
+enablePassesWhen :: (CompState -> Bool) -> [Pass] -> [Pass]
+enablePassesWhen f = map (\p -> p
+  {passEnabled = \c -> f c && (passEnabled p c)})
+
 -- | Compose a list of passes into a single pass by running them in the order given.
 runPasses :: [Pass] -> (A.AST -> PassM A.AST)
 runPasses [] ast = return ast
diff --git a/pass/PassList.hs b/pass/PassList.hs
index 6052ac8..5d8d3ec 100644
--- a/pass/PassList.hs
+++ b/pass/PassList.hs
@@ -43,7 +43,8 @@ import Utils
 
 commonPasses :: CompState -> [Pass]
 commonPasses opts = concat $
-  [ simplifyTypes
+  -- Rain does simplifyTypes separately:
+  [ enablePassesWhen ((== FrontendOccam) . csFrontend) simplifyTypes
   , makePassesDep' csUsageChecking [("Usage checking", runPassR usageCheckPass, Prop.agg_namesDone, [Prop.parUsageChecked])]
   -- If usage checking is turned off, the pass list will break unless we insert this dummy item:
   , makePassesDep' (not . csUsageChecking) [("Usage checking turned OFF", return, Prop.agg_namesDone, [Prop.parUsageChecked])]
@@ -86,8 +87,9 @@ checkList passes = case check [] passes of
     check :: [Pass] -> [Pass] -> Either String [Pass]
     check prev [] = Right prev
     check prev (p:ps)
-      = case filter givesPrereq ps of
-          -- Check that our pre-requisites are not supplied by a later pass:
+      = case filter givesPrereq (p:ps) of
+          -- Check that our pre-requisites are not supplied by a later pass
+          -- or supplied by the pass that needs them:
           (x:_) ->
              Left $ "Pass order not correct; one of the pre-requisites"
                ++ " for pass: " ++ (passName p) ++ " is supplied in a later"