b87b845 · elk · git.iko.soy

compiler/Type/Constrain/Expression.hs+2−2

compare with master

unifiedsplit

@@ -11,8 +11,8 @@ import SourceSyntax.Location as Loc

11import SourceSyntax.Pattern (Pattern(PVar))

12import SourceSyntax.Expression

13import Type.Type hiding (Descriptor(..))

14−import Type.Constrain.Fragment

14+import Type.Fragment

15−import Type.Constrain.Environment as Env

15+import Type.Environment as Env

16import qualified Type.Constrain.Literal as Literal

17import qualified Type.Constrain.Pattern as Pattern

18

compiler/Type/Constrain/Literal.hs+2−2

@@ -5,8 +5,8 @@ import qualified Data.Map as Map

5

6import SourceSyntax.Literal

7import Type.Type

8−import Type.Constrain.Fragment

8+import Type.Fragment

9−import Type.Constrain.Environment as Env

9+import Type.Environment as Env

10

11constrain :: Environment -> Literal -> Type -> TypeConstraint

12constrain env literal tipe =

compiler/Type/Constrain/Pattern.hs+2−2

@@ -10,8 +10,8 @@ import qualified Data.Map as Map

10

11import SourceSyntax.Pattern

12import Type.Type

13−import Type.Constrain.Fragment

13+import Type.Fragment

14−import Type.Constrain.Environment as Env

14+import Type.Environment as Env

15import qualified Type.Constrain.Literal as Literal

16

17

compiler/Type/Environment.hs+1−1

@@ -1,4 +1,4 @@

1−module Type.Constrain.Environment where

1+module Type.Environment where

2

3import qualified Data.Map as Map

4import Data.Map ((!))

compiler/Type/Fragment.hs+1−1

@@ -1,4 +1,4 @@

1−module Type.Constrain.Fragment where

1+module Type.Fragment where

2

3import qualified Data.List as List

4import qualified Data.Map as Map

compiler/Type/Solve.hs+32−6

@@ -4,11 +4,11 @@ module Type.Solve where

4import Control.Monad

5import qualified Data.UnionFind.IO as UF

6import qualified Data.Array.IO as Array

7−import qualified Data.Map as Map

7+import Data.Map as Map

8import qualified Data.Maybe as Maybe

9import Type.Type

10import Type.Unify

11−import Type.Environment

11+import Type.Environment as Env

12

13-- Pool

14-- Holds a bunch of variables

@@ -88,6 +88,11 @@ traverse young visited k variable =

88

89success = return []

90

91+chop = undefined

92+addTo = undefined

93+newPool = undefined

94+introduce = undefined

95+

91solve env pool constraint =

96solve env pool constraint =

92 case constraint of

97 case constraint of

93 CTrue -> success

98 CTrue -> success

@@ -100,12 +105,33 @@ solve env pool constraint =

100 return (concat results)

105 return (concat results)

101

106

102 CLet schemes constraint' -> do

107 CLet schemes constraint' -> do

103− env' <- foldM (\env' scheme -> (++) env' `liftM` solveScheme env pool scheme) env schemes

108+ env' <- foldM (\env' scheme -> addTo env' `liftM` solveScheme env pool scheme) env schemes

104 solve env' pool constraint'

109 solve env' pool constraint'

105

110

106 CInstance name term -> do

111 CInstance name term -> do

112+ let instance' = undefined

107− let inst = instance' pool (Env.get env value name)

113+ inst = instance' pool (Env.get env value name)

108− t = chop pool term

114+ t <- chop pool term

109 unify pool inst t

115 unify pool inst t

110

116

117+solveScheme env pool scheme =

118+ case scheme of

119+ Scheme [] [] constraint header -> do

120+ solve env pool constraint

121+ mapM (\(n,t) -> (,) n `liftM` chop pool t) (Map.toList header)

122+

123+ Scheme rigidQuantifiers flexibleQuantifiers constraint header -> do

124+ let quantifiers = rigidQuantifiers ++ flexibleQuantifiers

125+ pool' <- newPool pool

126+ mapM (introduce pool') rigidQuantifiers

127+ mapM (introduce pool') flexibleQuantifiers

128+ header' <- mapM (\(n,t) -> (,) n `liftM` chop pool t) (Map.toList header)

129+ solve env pool' constraint

130+ generalize pool pool'

131+ mapM isGeneric rigidQuantifiers

132+ return header'

133+

134+isGeneric var =

135+ do desc <- UF.descriptor var

111−solveScheme = undefined

136+ undefined

137+