on master help sign in
Stop relying on laziness in Type.State.makeCopy
314be83Evan Czaplicki
src/Type/State.hs+28−25
@@ -201,9 +201,9 @@ makeCopy alreadyCopiedMark variable =
201
201
202
202
203makeCopyHelp :: Descriptor -> Int -> Variable -> Solver Variable
203makeCopyHelp :: Descriptor -> Int -> Variable -> Solver Variable
204−makeCopyHelp descriptor alreadyCopiedMark variable =
204+makeCopyHelp (Descriptor content rank mark copy) alreadyCopiedMark variable =
205− if _mark descriptor == alreadyCopiedMark then
205+ if mark == alreadyCopiedMark then
206− case _copy descriptor of
206+ case copy of
207 Just copiedVariable ->
207 Just copiedVariable ->
208 return copiedVariable
208 return copiedVariable
209
209
@@ -214,14 +214,14 @@ makeCopyHelp descriptor alreadyCopiedMark variable =
214 \ with a <http://sscce.org> and information on your OS, how you installed,\
214 \ with a <http://sscce.org> and information on your OS, how you installed,\
215 \ and any other configuration information that might be helpful."
215 \ and any other configuration information that might be helpful."
216
216
217− else if _rank descriptor /= noRank || not (needsCopy (_content descriptor)) then
217+ else if rank /= noRank || not (needsCopy content) then
218 return variable
218 return variable
219
219
220 else
220 else
221 do pool <- getPool
221 do pool <- getPool
222 newVar <-
222 newVar <-
223 State.liftIO $ UF.fresh $ Descriptor
223 State.liftIO $ UF.fresh $ Descriptor
224− { _content = error "will be filled in soon!"
224+ { _content = content -- place holder!
225 , _rank = maxRank pool
225 , _rank = maxRank pool
226 , _mark = noMark
226 , _mark = noMark
227 , _copy = Nothing
227 , _copy = Nothing
@@ -236,34 +236,37 @@ makeCopyHelp descriptor alreadyCopiedMark variable =
236 State.liftIO $ UF.modifyDescriptor variable $ \desc ->
236 State.liftIO $ UF.modifyDescriptor variable $ \desc ->
237 desc { _mark = alreadyCopiedMark, _copy = Just newVar }
237 desc { _mark = alreadyCopiedMark, _copy = Just newVar }
238
238
239+
240+ let setContent newContent =
241+ State.liftIO $ UF.modifyDescriptor newVar $ \desc ->
242+ desc { _content = newContent }
243+
239 -- Now we recursively copy the content of the variable.
244 -- Now we recursively copy the content of the variable.
240 -- We have already marked the variable as copied, so we
245 -- We have already marked the variable as copied, so we
241 -- will not repeat this work or crawl this variable again.
246 -- will not repeat this work or crawl this variable again.
242− let oldContent = _content descriptor
243− newContent <-
244− case oldContent of
247+ case content of
245− Structure term ->
248+ Structure term ->
246− Structure <$> traverseTerm (makeCopy alreadyCopiedMark) term
249+ do newTerm <- traverseTerm (makeCopy alreadyCopiedMark) term
247−
250+ setContent (Structure newTerm)
248− Atom _ ->
249− return oldContent
250
251
251− Var Rigid maybeSuper maybeName ->
252+ Atom _ ->
252− return (Var Flex maybeSuper maybeName)
253+ return ()
253
254
254− Var Flex _ _ ->
255+ Var Rigid maybeSuper maybeName ->
255− return oldContent
256+ setContent (Var Flex maybeSuper maybeName)
256
257
257− Alias name args realType ->
258+ Var Flex _ _ ->
258− Alias name
259+ return ()
259− <$> mapM (traverse (makeCopy alreadyCopiedMark)) args
260− <*> makeCopy alreadyCopiedMark realType
261
260
262− Error ->
261+ Alias name args realType ->
263− return oldContent
262+ setContent =<< (
263+ Alias name
264+ <$> mapM (traverse (makeCopy alreadyCopiedMark)) args
265+ <*> makeCopy alreadyCopiedMark realType
266+ )
264
267
265− State.liftIO $ UF.modifyDescriptor newVar $ \desc ->
268+ Error ->
266− desc { _content = newContent }
269+ return ()
267
270
268 return newVar
271 return newVar
269
272