7d03f69 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Provide a way to define super-types in type annotations. Should not be used outside of core libraries.

7d03f69evancz14 years ago

compiler/Types/Constrain.hs+3−3

compare with master

unifiedsplit

@@ -14,7 +14,7 @@ import Context

14import Guid

16import Types.Types

17−import Types.Substitutions

17+import qualified Types.Substitutions as Subs

19beta = VarT `liftM` guid

20unionA = Map.unionWith (++)

@@ -283,7 +283,7 @@ defGenHelp name args e = do

283 let as' = Map.findWithDefault [v] arg as

284 return $ map (\y -> ctx arg NoSpan $ VarT x :=: VarT y) as'

285 cs' <- concat `liftM` mapM genCs argDict

286− scheme <- generalize (concat $ Map.elems as') $

286+ scheme <- Subs.generalize (concat $ Map.elems as') $

287 Forall (map snd argDict) (cs' ++ Set.toList cs) tipe

288 return ( as', Set.empty, (name, scheme) )

289

@@ -312,7 +312,7 @@ stmtGen stmt =

312 , Map.singleton elm (Forall [] [] tipe) )

313

314 TypeAnnotation name tipe ->

315− do schm <- generalize [] (Forall [] [] tipe)

315+ do schm <- Subs.generalize [] =<< Subs.superize name tipe

316 return (Map.empty, Set.empty, Map.singleton name schm)

317

318 TypeAlias _ _ _ -> return (Map.empty, Set.empty, Map.empty)

compiler/Types/Hints.hs+8−6

@@ -3,22 +3,24 @@ module Types.Hints (hints) where

3import Control.Arrow (first)

4import qualified Data.Map as Map

5import Guid

6−import Libraries

6+import qualified Libraries as Libs

7import Parse.Library (iParse)

8import Parse.Types

9−import Types.Substitutions

9+import qualified Types.Substitutions as Subs

10import Types.Types

12hints :: GuidCounter [(String, Scheme)]

13hints = mapM toScheme values

14 where

15+ values :: [(String, String)]

16+ values = addPrefixes (Map.toList (Map.map Map.toList Libs.libraries))

16− values = addPrefixes (Map.toList (Map.map Map.toList libraries))

18+ addPrefixes :: [(String,[(String, String)])] -> [(String, String)]

17−

18 addPrefixes = concatMap (\(m,vs) -> map (first (\n -> m ++ "." ++ n)) vs)

19 addPrefixes = concatMap (\(m,vs) -> map (first (\n -> m ++ "." ++ n)) vs)

21+ toScheme :: (String, String) -> GuidCounter (String, Scheme)

20 toScheme (name, tipeString) =

22 toScheme (name, tipeString) =

21 case iParse (fmap toType typeExpr) "parsing types in docs.json" tipeString of

23 case iParse (fmap toType typeExpr) "parsing types in docs.json" tipeString of

22 Left err -> error (show err)

24 Left err -> error (show err)

23− Right tipe -> do scheme <- generalize [] =<< superize name tipe

25+ Right tipe -> do scheme <- Subs.generalize [] =<< Subs.superize name tipe

24− return (name, scheme)

26+ return (name, scheme)

compiler/Types/Solver.hs+3−2

@@ -161,12 +161,13 @@ solver aliases subs (C txt span c : cs) =

161 | any f (Set.toList ts) -> solv cs

162 | otherwise -> subtypeError txt span (ADT "List" [t]) (Super ts)

163 where f (ADT "List" [VarT _]) = True

164− f (ADT "List" [t']) = t == t'

164+ f (ADT "List" [t']) = dealias aliases t == t'

165 f _ = False

166

167 t :<: Super ts

168 | Set.member t ts -> solv cs

169+ | Set.member (dealias aliases t) ts -> solv cs

169− | otherwise -> subtypeError txt span t (Super ts)

170+ | otherwise -> subtypeError txt span t (Super ts)

170

171

171 x :<<: s

172 x :<<: s

172 | any (occurs x) cs ->

173 | any (occurs x) cs ->

compiler/Types/Substitutions.hs+27−28

@@ -11,12 +11,11 @@ import Ast

11import Context

12import Control.Monad (liftM, liftM2)

13import Control.Monad.State (runState, State, get, put)

14−import Data.List (foldl')

14+import Data.List (nub)

15−import Data.Maybe (catMaybes)

16import qualified Data.Set as Set

15import qualified Data.Set as Set

17import qualified Data.Map as Map

16import qualified Data.Map as Map

18import Guid

17import Guid

19−import Types.Types as Types

18+import Types.Types

21class Subst a where

20class Subst a where

22 subst :: [(X,Type)] -> a -> a

21 subst :: [(X,Type)] -> a -> a

@@ -92,21 +91,25 @@ generalize exceptions (Forall xs cs t) = rescheme (Forall (xs ++ frees) cs t)

92 where allFrees = Set.fromList $ freeVars t ++ concatMap freeVars cs

91 where allFrees = Set.fromList $ freeVars t ++ concatMap freeVars cs

93 frees = Set.toList $ Set.difference allFrees (Set.fromList exceptions)

92 frees = Set.toList $ Set.difference allFrees (Set.fromList exceptions)

95−newtype Superize a = S { runSuper :: State (Int, Maybe X, Maybe X) a }

94+newtype Superize a = S { runSuper :: State ([X], [X], [X]) a }

96 deriving (Monad)

95 deriving (Monad)

98superize :: String -> Type -> GuidCounter Scheme

97superize :: String -> Type -> GuidCounter Scheme

99superize name tipe =

98superize name tipe =

100− do x <- guid

99+ do constraints <- liftM concat $

101− let (tipe', (m, number, append)) =

100+ sequence [ mapM (<: nmbr) (nub ns)

102− runState (runSuper (go tipe)) (x+1, Nothing, Nothing)

101+ , mapM (<: apnd) (nub as)

103− mkC super = liftM (\x -> C (Just name) NoSpan (VarT x :<: super))

102+ , mapM (<: comp) (nub cs) ]

104− set m

103+ return (Forall (concat [ns,as,cs]) constraints tipe')

105− return (Forall (catMaybes [number,append])

106− (catMaybes [ mkC Types.number number

107− , mkC (Types.appendable x) append])

108− tipe')

109 where

104 where

105+ (tipe', (ns,as,cs)) = runState (runSuper (go tipe)) ([],[],[])

106+ t <: super = do x <- guid

107+ return $ C (Just name) NoSpan (VarT t :<: super x)

108+

109+ nmbr t = number

110+ apnd t = appendable t

111+ comp t = comparable t

112+

110 go :: Type -> Superize Type

113 go :: Type -> Superize Type

111 go t =

114 go t =

112 case t of

115 case t of

@@ -114,24 +117,20 @@ superize name tipe =

114 Super _ -> return t

117 Super _ -> return t

115 VarT _ -> return t

118 VarT _ -> return t

116 LambdaT t1 t2 -> liftM2 LambdaT (go t1) (go t2)

119 LambdaT t1 t2 -> liftM2 LambdaT (go t1) (go t2)

117− ADT "Number" [] -> liftM VarT number

120+ ADT "Number" [VarT t] -> addNumber t

118− ADT "Appendable" [t] -> liftM VarT append

121+ ADT "Appendable" [VarT t] -> addAppendable t

122+ ADT "Comparable" [VarT t] -> addComparable t

119 ADT name ts -> liftM (ADT name) (mapM go ts)

123 ADT name ts -> liftM (ADT name) (mapM go ts)

120 RecordT fs t -> liftM2 RecordT fs' (go t)

124 RecordT fs t -> liftM2 RecordT fs' (go t)

121 where pairs = Map.toList fs

125 where pairs = Map.toList fs

122 fs' = do ps <- mapM (\(f,t) -> liftM ((,) f) (mapM go t)) pairs

126 fs' = do ps <- mapM (\(f,t) -> liftM ((,) f) (mapM go t)) pairs

123 return (Map.fromList ps)

127 return (Map.fromList ps)

124

128

125− number :: Superize X

129+ add :: (X -> ([X],[X],[X]) -> ([X],[X],[X])) -> X -> Superize Type

126− number = S $ do (n, num, append) <- get

130+ add f v = S $ do (ns, as, cs) <- get

127− case num of

131+ put $ f v (ns, as, cs)

128− Just x -> return x

132+ return (VarT v)

129− Nothing -> do put (n + 1, Just n, append)

133+

130− return n

134+ addNumber = add (\n (ns,as,cs) -> (n:ns,as,cs))

131−

135+ addAppendable = add (\a (ns,as,cs) -> (ns,a:as,cs))

132− append :: Superize X

136+ addComparable = add (\c (ns,as,cs) -> (ns,as,c:cs))

133− append = S $ do (n, number, app) <- get

134− case app of

135− Just x -> return x

136− Nothing -> do put (n + 1, number, Just n)

137− return n

compiler/Types/Types.hs+7−3

@@ -35,13 +35,19 @@ tipe t = ADT t []

36int = tipe "Int"

37float = tipe "Float"

38−number = Super (Set.fromList [ int, float ])

38+time = tipe "Time"

39+date = tipe "Date"

40char = tipe "Char"

41char = tipe "Char"

41bool = tipe "Bool"

42bool = tipe "Bool"

42text = tipe "Text"

43text = tipe "Text"

44+order = tipe "Order"

43string = tipe "String"

45string = tipe "String"

47+number = Super $ Set.fromList [ int, float, time ]

48+appendable t = Super $ Set.fromList [ string, text, listOf (VarT t) ]

49+comparable t = Super $ Set.fromList [ int, float, char, string, time, date ]

50+

45element = tipe "Element"

51element = tipe "Element"

47listOf t = ADT "List" [t]

53listOf t = ADT "List" [t]

@@ -51,8 +57,6 @@ maybeOf t = ADT "Maybe" [t]

51eitherOf a b = ADT "Either" [a,b]

57eitherOf a b = ADT "Either" [a,b]

52pairOf t = tupleOf [t,t]

58pairOf t = tupleOf [t,t]

53point = pairOf int

59point = pairOf int

54−appendable t = Super (Set.fromList [ string, text, listOf (VarT t) ])

55−--comparable = Super (Set.fromList [ int, float, char, string, time, date ])

57infixr ==>

61infixr ==>

58t1 ==> t2 = LambdaT t1 t2

62t1 ==> t2 = LambdaT t1 t2