Commits

Anonymous committed 10ae426

initial commit of strictify plugin working with ghc 7.1; we do not need ghc-syb anymore since ghc provides Data/Typeable instances now

  • Participants

Comments (0)

Files changed (7)

+_darcs
+*.o
+*.hi
+*~
+To build and install the actual plugin:
+
+runhaskell Setup.hs configure
+runhaskell Setup.hs build
+sudo runhaskell Setup.hs install
+
+Once you've done that, you can if you wish run the tests:
+
+cd tests
+ghc --make -plg Strict.Plugin NonTerminating.hs
+./NonTerminating
+
+To use the plugin on any module you compile with GHC, use the -plgStrict.Plugin option, or include it in an OPTIONS_GHC pragma, like so:
+
+{-# OPTIONS_GHC -plgStrict.Plugin #-}
+import Distribution.Simple
+
+main = defaultMain

File Strict/Pass.lhs

+\begin{code}
+{-# LANGUAGE PatternGuards #-}
+
+module Strict.Pass (strictifyProgram) where
+
+import GHCPlugins
+
+import Data.Generics
+import Data.Maybe
+
+\end{code}
+\begin{code}
+
+strictifyProgram :: [CoreBind] -> CoreM [CoreBind]
+strictifyProgram binds = everywhereM (mkM strictifyExpr) binds
+
+strictifyExpr :: CoreExpr -> CoreM CoreExpr
+strictifyExpr e@(Let (NonRec b e1) e2) 
+  | Type _ <- e1 = return e -- Yes, this can occur!
+  | otherwise    = return $ Case e1 b (exprType e2) [(DEFAULT, [], e2)]
+strictifyExpr e@(App e1 e2)
+  = case e2 of
+          App _ _ -> translate
+          Case _ _ _ _ -> translate
+          Cast _ _ -> translate -- May as well, these two don't
+          Note _ _ -> translate -- appear on types anyway
+          _ -> return e -- N.b. don't need to consider lets since they will have been eliminated already
+  where
+    translate = do
+            b <- mkSysLocalM (fsLit "strict") (exprType e2)
+            return $ Case e2 b (exprType e) [(DEFAULT, [], App e1 (Var b))]
+strictifyExpr e = return e
+
+\end{code}

File Strict/Plugin.hs

+module Strict.Plugin where
+
+import Strict.Pass
+
+import GHCPlugins
+
+plugin :: Plugin
+plugin = defaultPlugin {
+    installCoreToDos = install
+  }
+
+install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
+install _option todos = do
+    return $ CoreDoPluginPass "Strictify" (BindsToBindsPluginPass strictifyProgram) : todos

File strict-plugin.cabal

+Name:           strict-plugin
+Version:        1.0
+License:        BSD3
+Synopsis:       A plugin for GHC that lets you change Haskell into a strict language!
+Cabal-Version:  >= 1.2
+Build-Type:	Simple
+Author:         Max Bolingbroke
+Homepage:       http://www.omega-prime.co.uk
+
+Library
+    Exposed-Modules:
+        Strict.Plugin
+    Other-Modules:
+        Strict.Pass
+    Build-Depends:
+        base,
+        syb,
+        template-haskell,
+        ghc-prim,
+        ghc >= 6.11

File tests/NonTerminating.hs

+{-# LANGUAGE CPP #-}
+module Main ( main ) where
+
+#ifdef USE_CHASING_BOTTOMS
+
+import Test.ChasingBottoms
+
+evaluate_and_possibly_timeout what = do
+    result <- timeOut'
+    case result of
+            NonTermination -> putStrLn "Test successful"
+            Value val -> putStrLn $ "Test failed due to the thing compiled terminating with value: " ++ show val
+
+#else
+
+import Control.Exception ( evaluate )
+
+evaluate_and_possibly_timeout what = do
+    val <- evaluate what
+    putStrLn $ "Test failed due to the thing compiled terminating with value: " ++ show val
+
+#endif
+
+foreverFrom :: Int -> [Int]
+foreverFrom n = n : foreverFrom (n + 1)
+
+main :: IO ()
+main = do
+    let xs = foreverFrom 0
+    evaluate_and_possibly_timeout (take 10 xs)
+
+