Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

initial commit of strictify plugin working with ghc 7.1; we do not ne…

…ed ghc-syb anymore since ghc provides Data/Typeable instances now
  • Loading branch information...
commit 10ae4267e357d2cf701014543fa4bab0ca7cfc0a 0 parents
austin s authored
4 .gitignore
@@ -0,0 +1,4 @@
+_darcs
+*.o
+*.hi
+*~
15 BUILDING
@@ -0,0 +1,15 @@
+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 #-}
3  Setup.hs
@@ -0,0 +1,3 @@
+import Distribution.Simple
+
+main = defaultMain
34 Strict/Pass.lhs
@@ -0,0 +1,34 @@
+\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}
14 Strict/Plugin.hs
@@ -0,0 +1,14 @@
+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
20 strict-plugin.cabal
@@ -0,0 +1,20 @@
+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
32 tests/NonTerminating.hs
@@ -0,0 +1,32 @@
+{-# 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)
+
+
Please sign in to comment.
Something went wrong with that request. Please try again.