Skip to content

Instantly share code, notes, and snippets.

@eagletmt
Created May 9, 2010 01:34
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save eagletmt/394878 to your computer and use it in GitHub Desktop.
Save eagletmt/394878 to your computer and use it in GitHub Desktop.
# require ghc-paths <http://hackage.haskell.org/package/ghc-paths>
% echo 'length x' | ./hint
[a]
% echo 'x + 1' | ./hint
(GHC.Num.Num a) => a
% echo 'foldl x 0 [2,3]' | ./hint
(GHC.Num.Num a, GHC.Num.Num b) => a -> b -> a
% echo 'nub x' | ./hint Data.List
(GHC.Classes.Eq a) => [a]
import Control.Applicative ((<$>))
import Control.Monad (forM_, forM)
import Data.List (intercalate)
import System.Environment (getArgs)
import GHC
import GHC.Paths (libdir)
import Type (dropForAlls, splitFunTy, tyVarsOfType, tyVarsOfPred)
import TypeRep (Type (..))
import VarSet (intersectsVarSet)
import Outputable (showSDoc, ppr)
import DynFlags (defaultDynFlags)
main = do
modules <- ("Prelude" :) <$> getArgs
ls <- lines <$> getContents
res <- predTypesAndTypeOfFirstArgs modules $ map ("\\x -> " ++) ls
forM_ res $ \(ps,a) ->
let ss = if null ps
then ""
else "(" ++ intercalate ", " (map (showSDoc . ppr) ps) ++ ") => "
in putStrLn $ ss ++ showSDoc (ppr a)
predTypesAndTypeOfFirstArgs :: [String] -> [String] -> IO [([PredType],Type)]
predTypesAndTypeOfFirstArgs modules exprs =
defaultErrorHandler defaultDynFlags $ do
runGhc (Just libdir) $ do
dflags <- getSessionDynFlags
setSessionDynFlags dflags
mods <- mapM (\m -> findModule (mkModuleName m) Nothing) modules
setContext [] mods
forM exprs $ \expr -> do
t <- dropForAlls <$> exprType expr
let (ps,f) = splitPredTys t
(a,_) = splitFunTy f
return $ (filter (partOfPred a) ps, a)
splitPredTys :: Type -> ([PredType], Type)
splitPredTys = go []
where
go ps t =
case x of
PredTy p -> go (p:ps) y
_ -> (reverse ps, t)
where
(x,y) = splitFunTy t
partOfPred :: Type -> PredType -> Bool
partOfPred t p = intersectsVarSet (tyVarsOfType t) (tyVarsOfPred p)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment