on master help sign in
Make Type.State.introduce allocate a bit less
696ee0aEvan Czaplicki
src/Type/Solve.hs+2−2
@@ -55,7 +55,7 @@ actuallySolve constraint =
55
55
56 CLet [Scheme [] fqs constraint' _] CTrue ->
56 CLet [Scheme [] fqs constraint' _] CTrue ->
57 do oldEnv <- TS.getEnv
57 do oldEnv <- TS.getEnv
58− mapM_ TS.introduce fqs
58+ TS.introduce fqs
59 actuallySolve constraint'
59 actuallySolve constraint'
60 TS.modifyEnv (\_ -> oldEnv)
60 TS.modifyEnv (\_ -> oldEnv)
61
61
@@ -103,7 +103,7 @@ solveScheme scheme =
103 -- fill in a new pool when working on this scheme's constraints
103 -- fill in a new pool when working on this scheme's constraints
104 freshPool <- TS.nextRankPool
104 freshPool <- TS.nextRankPool
105 TS.switchToPool freshPool
105 TS.switchToPool freshPool
106− mapM_ TS.introduce quantifiers
106+ TS.introduce quantifiers
107 header' <- traverse flatten header
107 header' <- traverse flatten header
108 actuallySolve constraint
108 actuallySolve constraint
109
109
src/Type/State.hs+6−5
@@ -181,13 +181,14 @@ register variable =
181
181
182
182
183{-# INLINE introduce #-}
183{-# INLINE introduce #-}
184−introduce :: Variable -> Solver Variable
184+introduce :: [Variable] -> Solver ()
185−introduce variable =
185+introduce variables =
186 {-# SCC elm_compiler_type_introduce #-}
186 {-# SCC elm_compiler_type_introduce #-}
187 Solver $ \(SS env savedEnv (Pool maxRank inhabitants) mark errors) ->
187 Solver $ \(SS env savedEnv (Pool maxRank inhabitants) mark errors) ->
188− do UF.modifyDescriptor variable $ \(Descriptor c _ m cp) -> Descriptor c maxRank m cp
188+ do let toMaxRank (Descriptor c _ m cp) = Descriptor c maxRank m cp
189+ mapM_ (\var -> UF.modifyDescriptor var toMaxRank) variables
189− let newPool = Pool maxRank (variable : inhabitants)
190+ let newPool = Pool maxRank (variables ++ inhabitants)
190− return ( variable, SS env savedEnv newPool mark errors )
191+ return ( (), SS env savedEnv newPool mark errors )
191
192
192
193
193
194