dbe6c75 · elk · git.iko.soy

git.iko.soy/elk

Move constraint primitives into Type.Constraint

commitdbe6c7572273166438b35bb94b7a14989a8e4a15 authorEvan Czaplicki <evancz@users.noreply.github.com> dateSun 16 Jul 2017, 18:43 (9 years ago) parente6b8eb3

9 files changed+121−77

compare with master

unifiedsplit

elm-compiler.cabal+1 src/Type/Constrain/Effects.hs+2−4 src/Type/Constrain/Expression.hs+1 src/Type/Constrain/Literal.hs+2−1 src/Type/Constrain/Pattern.hs+1 src/Type/Constraint.hs+94 src/Type/Inference.hs+1 src/Type/Solve.hs+1 src/Type/Type.hs+18−72

elm-compiler.cabal+1

@@ -133,6 +133,7 @@ Library

133133 Reporting.Report,

134134 Reporting.Result,

135135 Reporting.Warning,

136+ Type.Constraint,

136137 Type.Constrain.Effects,

137138 Type.Constrain.Expression,

138139 Type.Constrain.Literal,

src/Type/Constrain/Effects.hs+2−4

@@ -9,10 +9,8 @@ import qualified AST.Module.Name as ModuleName

99import qualified AST.Variable as Var

1010import qualified Reporting.Annotation as A

1111import qualified Reporting.Error.Type as Error

12−import Type.Type

13− ( Variable, Type(AppN,VarN), Constraint(..)

14− , Scheme(Scheme), (==>), mkVar

15− )

12+import Type.Constraint (Constraint(..), Scheme(Scheme))

13+import Type.Type (Variable, Type(AppN,VarN), (==>), mkVar)

1614

1715

1816

src/Type/Constrain/Expression.hs+1

@@ -16,6 +16,7 @@ import qualified AST.Variable as V

1616import qualified Reporting.Annotation as A

1717import qualified Reporting.Error.Type as Error

1818import qualified Reporting.Region as R

19+import Type.Constraint

1920import qualified Type.Constrain.Effects as Effects

2021import qualified Type.Constrain.Literal as Literal

2122import qualified Type.Constrain.Pattern as Pattern

src/Type/Constrain/Literal.hs+2−1

@@ -1,11 +1,12 @@

11{-# OPTIONS_GHC -Wall #-}

22{-# LANGUAGE OverloadedStrings #-}

3−module Type.Constrain.Literal where

3+module Type.Constrain.Literal (constrain) where

55import qualified AST.Literal as L

66import qualified AST.Variable as Var

77import qualified Reporting.Error.Type as Error

88import qualified Reporting.Region as R

9+import qualified Type.Constraint as T

910import qualified Type.Type as T

1011

1112

src/Type/Constrain/Pattern.hs+1

@@ -11,6 +11,7 @@ import qualified AST.Pattern as P

1111import qualified AST.Variable as Var

1212import qualified Reporting.Annotation as A

1313import qualified Reporting.Error.Type as Error

14+import Type.Constraint

1415import qualified Type.Constrain.Literal as Literal

1516import qualified Type.Environment as Env

1617import Type.Type

src/Type/Constraint.hsnew file+94

@@ -0,0 +1,94 @@

1+{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+module Type.Constraint

4+ ( Constraint(..)

5+ , (/\), ex, forall

6+ , exists, existsNumber

7+ , Scheme(..), SchemeName

8+ , monoscheme

9+ )

10+ where

11+

12+import qualified Data.Map as Map

13+import Data.Text (Text)

14+

15+import qualified Reporting.Annotation as A

16+import qualified Reporting.Error.Type as Error

17+import qualified Reporting.Region as R

18+import Type.Type (Type(VarN), Variable, mkVar, Super(Number))

19+

20+

21+

22+-- CONSTRAINTS

23+

24+

25+data Constraint

26+ = CTrue

27+ | CSaveEnv

28+ | CEqual Error.Hint R.Region Type Type

29+ | CAnd [Constraint]

30+ | CLet [Scheme] Constraint

31+ | CInstance R.Region SchemeName Type

32+

33+

34+

35+-- SCHEMES

36+

37+

38+type SchemeName = Text

39+

40+

41+data Scheme =

42+ Scheme

43+ { _rigidQuantifiers :: [Variable]

44+ , _flexibleQuantifiers :: [Variable]

45+ , _constraint :: Constraint

46+ , _header :: Map.Map Text (A.Located Type)

47+ }

48+

49+

50+

51+-- SCHEME HELPERS

52+

53+

54+monoscheme :: Map.Map Text (A.Located Type) -> Scheme

55+monoscheme headers =

56+ Scheme [] [] CTrue headers

57+

58+

59+

60+-- CONSTRAINT HELPERS

61+

62+

63+infixl 8 /\

64+

65+

66+(/\) :: Constraint -> Constraint -> Constraint

67+(/\) c1 c2 =

68+ case (c1, c2) of

69+ (CTrue, _) -> c2

70+ (_, CTrue) -> c1

71+ _ -> CAnd [c1,c2]

72+

73+

74+-- ex qs constraint == exists qs. constraint

75+ex :: [Variable] -> Constraint -> Constraint

76+ex fqs constraint =

77+ CLet [Scheme [] fqs constraint Map.empty] CTrue

78+

79+

80+forall :: [Variable] -> Constraint -> Constraint

81+forall rqs constraint =

82+ CLet [Scheme rqs [] constraint Map.empty] CTrue

83+

84+

85+exists :: (Type -> IO Constraint) -> IO Constraint

86+exists f =

87+ do v <- mkVar Nothing

88+ ex [v] <$> f (VarN v)

89+

90+

91+existsNumber :: (Type -> IO Constraint) -> IO Constraint

92+existsNumber f =

93+ do v <- mkVar (Just Number)

94+ ex [v] <$> f (VarN v)

src/Type/Inference.hs+1

@@ -13,6 +13,7 @@ import qualified AST.Type as Type

1313import qualified AST.Variable as Var

1414import qualified Reporting.Annotation as A

1515import qualified Reporting.Error.Type as Error

16+import qualified Type.Constraint as T

1617import qualified Type.Constrain.Expression as TcExpr

1718import qualified Type.Environment as Env

1819import qualified Type.Solve as Solve

src/Type/Solve.hs+1

@@ -15,6 +15,7 @@ import qualified Reporting.Annotation as A

1515import qualified Reporting.Error.Type as Error

1616import qualified Type.Occurs as Occurs

1717import qualified Type.State as TS

18+import Type.Constraint (Constraint(..), Scheme(..))

1819import Type.Type as Type

1920import Type.Unify

2021import qualified Type.UnionFind as UF

src/Type/Type.hs+18−72

@@ -1,6 +1,23 @@

11{-# OPTIONS_GHC -Wall #-}

22{-# LANGUAGE OverloadedStrings #-}

3−module Type.Type where

3+module Type.Type

4+ ( Variable

5+ , FlatType(..)

6+ , Type(..)

7+ , Descriptor(..)

8+ , Content(..)

9+ , Flex(..)

10+ , Super(..)

11+ , noRank

12+ , outermostRank

13+ , noMark

14+ , initialMark

15+ , (==>)

16+ , mkVar

17+ , mkNamedVar

18+ , toSrcType

19+ )

20+ where

421

522import Control.Monad (when)

623import Control.Monad.State.Strict (StateT, liftIO)

@@ -13,9 +30,6 @@ import Data.Text (Text)

1330

1431import qualified AST.Type as T

1532import qualified AST.Variable as Var

16−import qualified Reporting.Annotation as A

17−import qualified Reporting.Error.Type as Error

18−import qualified Reporting.Region as R

1933import qualified Type.UnionFind as UF

2034

2135

@@ -104,31 +118,6 @@ getVarNamesMark =

104118

105119

106120

107−-- CONSTRAINTS

108−

109−

110−data Constraint

111− = CTrue

112− | CSaveEnv

113− | CEqual Error.Hint R.Region Type Type

114− | CAnd [Constraint]

115− | CLet [Scheme] Constraint

116− | CInstance R.Region SchemeName Type

117−

118−

119−type SchemeName = Text

120−

121−

122−data Scheme =

123− Scheme

124− { _rigidQuantifiers :: [Variable]

125− , _flexibleQuantifiers :: [Variable]

126− , _constraint :: Constraint

127− , _header :: Map.Map Text (A.Located Type)

128− }

129−

130−

131−

132121-- TYPE HELPERS

133122

134123

@@ -181,49 +170,6 @@ toSuper name =

181170

182171

183172

184−-- CONSTRAINT HELPERS

185−

186−

187−monoscheme :: Map.Map Text (A.Located Type) -> Scheme

188−monoscheme headers =

189− Scheme [] [] CTrue headers

190−

191−

192−infixl 8 /\

193−

194−

195−(/\) :: Constraint -> Constraint -> Constraint

196−(/\) c1 c2 =

197− case (c1, c2) of

198− (CTrue, _) -> c2

199− (_, CTrue) -> c1

200− _ -> CAnd [c1,c2]

201−

202−

203−-- ex qs constraint == exists qs. constraint

204−ex :: [Variable] -> Constraint -> Constraint

205−ex fqs constraint =

206− CLet [Scheme [] fqs constraint Map.empty] CTrue

207−

208−

209−forall :: [Variable] -> Constraint -> Constraint

210−forall rqs constraint =

211− CLet [Scheme rqs [] constraint Map.empty] CTrue

212−

213−

214−exists :: (Type -> IO Constraint) -> IO Constraint

215−exists f =

216− do v <- mkVar Nothing

217− ex [v] <$> f (VarN v)

218−

219−

220−existsNumber :: (Type -> IO Constraint) -> IO Constraint

221−existsNumber f =

222− do v <- mkVar (Just Number)

223− ex [v] <$> f (VarN v)

224−

225−

226−

227173-- CONVERT TO SOURCE TYPES

228174

229175