721ce4f192
Remove uses of uniplate, introduces a regression in testing the ordering of Defs in let-expressions.
32 lines
1.2 KiB
Haskell
32 lines
1.2 KiB
Haskell
module Types.Hints (hints) where
|
|
|
|
import Control.Arrow (first)
|
|
import Control.Monad (liftM)
|
|
import Data.Maybe (catMaybes)
|
|
import qualified Data.Map as Map
|
|
import Unique
|
|
import qualified Metadata.Libraries as Libs
|
|
import Parse.Helpers (iParse)
|
|
import Parse.Type
|
|
import qualified Types.Substitutions as Subs
|
|
import Types.Types
|
|
|
|
hints :: Unique [(String, Scheme)]
|
|
hints = liftM catMaybes (mapM toScheme values)
|
|
where
|
|
values :: [(String, String)]
|
|
values = addPrefixes (Map.toList (Map.map Map.toList Libs.libraries))
|
|
|
|
addPrefixes :: [(String,[(String, String)])] -> [(String, String)]
|
|
addPrefixes = concatMap (\(m,vs) -> map (first (\n -> m ++ "." ++ n)) vs)
|
|
|
|
toScheme :: (String, String) -> Unique (Maybe (String, Scheme))
|
|
toScheme (name, 't':'y':'p':'e':' ':_) = return Nothing
|
|
toScheme (name, 'd':'a':'t':'a':' ':_) = return Nothing
|
|
toScheme (name, tipeString) =
|
|
let err = "compiler error parsing type of " ++ name ++ ":\n" ++ tipeString
|
|
in case iParse (fmap toType typeExpr) err tipeString of
|
|
Left err -> error (show err)
|
|
Right tipe -> do
|
|
scheme <- Subs.generalize [] =<< Subs.superize name tipe
|
|
return (Just (name, scheme))
|