diff --git a/Main.hs b/Main.hs index 56a814d..bb151c1 100644 --- a/Main.hs +++ b/Main.hs @@ -61,6 +61,7 @@ options = , Option ['v'] ["verbose"] (NoArg $ optVerbose) "be more verbose (use multiple times for more detail)" , Option ['o'] ["output"] (ReqArg optOutput "FILE") "output file (default \"-\")" , Option [] ["usage-checking"] (ReqArg optUsageChecking "SETTING") "usage checking (EXPERIMENTAL) (options: on, off)" + , Option [] ["sanity-check"] (ReqArg optSanityCheck "SETTING") "internal sanity check (options: on, off)" ] optMode :: String -> OptFunc @@ -105,6 +106,14 @@ optUsageChecking s ps _ -> dieIO (Nothing, "Unknown usage checking mode: " ++ s) return $ ps { csUsageChecking = usageCheck } +optSanityCheck :: String -> OptFunc +optSanityCheck s ps + = do sanityCheck <- case s of + "on" -> return True + "off" -> return False + _ -> dieIO (Nothing, "Unknown sanity checking mode: " ++ s) + return $ ps { csSanityCheck = sanityCheck } + getOpts :: [String] -> IO ([OptFunc], [String]) getOpts argv = case getOpt RequireOrder options argv of diff --git a/common/CompState.hs b/common/CompState.hs index c5506ce..1d9a1f9 100644 --- a/common/CompState.hs +++ b/common/CompState.hs @@ -57,6 +57,7 @@ data CompState = CompState { csMode :: CompMode, csBackend :: CompBackend, csFrontend :: CompFrontend, + csSanityCheck :: Bool, csUsageChecking :: Bool, csVerboseLevel :: Int, csOutputFile :: String, @@ -89,6 +90,7 @@ emptyState = CompState { csMode = ModeFull, csBackend = BackendC, csFrontend = FrontendOccam, + csSanityCheck = False, csUsageChecking = False, -- For now! TODO turn this on by default csVerboseLevel = 0, csOutputFile = "-", diff --git a/common/PassList.hs b/common/PassList.hs index b2a2bda..6e33cf1 100644 --- a/common/PassList.hs +++ b/common/PassList.hs @@ -69,8 +69,9 @@ getPassList optsPS = filterPasses optsPS $ concat calculatePassList :: (Die m, CSMR m) => m [Pass] calculatePassList - = do rawList <- getCompState >>* getPassList - case buildGraph rawList of + = do st <- getCompState + let rawList = getPassList st + case buildGraph (csSanityCheck st) rawList of Left err -> dieReport (Nothing, "Error working out pass list: " ++ err) Right g -> return $ graphToList (g :: Gr Pass ()) @@ -82,8 +83,9 @@ calculatePassList graphToList :: Graph gr => gr Pass () -> [Pass] graphToList = topsort' -buildGraph :: forall gr. Graph gr => [Pass] -> Either String (gr Pass ()) -buildGraph passes = do checked <- checkedRelations +buildGraph :: forall gr. Graph gr => Bool -> [Pass] -> Either String (gr Pass ()) +buildGraph runProps passes + = do checked <- checkedRelations checkPassUnique checkGraph nodes <- labelledNodes @@ -98,7 +100,7 @@ buildGraph passes = do checked <- checkedRelations propToPass :: Property -> Pass propToPass prop = Pass { - passCode = runPassR (\t -> propCheck prop t >> return t) + passCode = if runProps then runPassR (\t -> propCheck prop t >> return t) else return ,passName = prefixPropName (propName prop) ,passPre = Set.empty ,passPost = Set.empty