git.iko.soy/rowtype-yoga/purescript-native
on a1ef2ea help sign in
rowtype-yoga/purescript-native/src/PureScript/TypeChecker/Synonyms.hs
56 lines 1.7 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : PureScript.TypeChecker.Synonyms
4-- Copyright : (c) Phil Freeman 2013
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12--
13-----------------------------------------------------------------------------
15{-# LANGUAGE Rank2Types #-}
17module PureScript.TypeChecker.Synonyms (
18 saturateTypeSynonym,
19 saturateAllTypeSynonyms
20) where
22import PureScript.Types
23import PureScript.Declarations
25import Data.Maybe (fromMaybe)
26import Data.Data
27import Data.Generics
28import Control.Arrow
29import Control.Monad.Writer
30import Control.Monad.Error
31import qualified Data.Map as M
33buildTypeSubstitution :: String -> Int -> Type -> Either String (Maybe Type)
34buildTypeSubstitution name n = go n []
35 where
36 go :: Int -> [Type] -> Type -> Either String (Maybe Type)
37 go 0 args (TypeConstructor ctor) | name == ctor = return (Just $ SaturatedTypeSynonym ctor args)
38 go n _ (TypeConstructor ctor) | n > 0 && name == ctor = throwError $ "Partially applied type synonym " ++ name
39 go n args (TypeApp f arg) = go (n - 1) (arg:args) f
40 go _ _ _ = return Nothing
42everywhereM' :: (Monad m, Data d) => (forall d. (Data d) => d -> m d) -> d -> m d
43everywhereM' f x = do
44 y <- f x
45 gmapM (everywhereM' f) y
47saturateTypeSynonym :: (Data d) => String -> Int -> d -> Either String d
48saturateTypeSynonym name n = everywhereM' (mkM replace)
49 where
50 replace t = fmap (fromMaybe t) $ buildTypeSubstitution name n t
52saturateAllTypeSynonyms :: (Data d) => [(String, Int)] -> d -> Either String d
53saturateAllTypeSynonyms syns d = foldM (\d (name, n) -> saturateTypeSynonym name n d) d syns