@@ -27,12 +27,12 @@ import Control.Monad.Trans (MonadIO, liftIO)
2727import qualified Data.Map as Map
2828import Data.Map ((!))
2929import Data.Text (Text)
30−import qualified Data.UnionFind.IO as UF
3130
3231import qualified Reporting.Annotation as A
3332import qualified Reporting.Error.Type as Error
3433import qualified Reporting.Region as R
3534import Type.Type
35+import qualified Type.UnionFind as UF
3636
3737
3838
@@ -214,30 +214,41 @@ flattenHelp aliasDict termN =
214214 AliasN name args realType ->
215215 do flatArgs <- mapM (traverse (flattenHelp aliasDict)) args
216216 flatVar <- flattenHelp (Map.fromList flatArgs) realType
217− pool <- getPool
218− variable <-
219− liftIO $ UF.fresh $ Descriptor
220− { _content = Alias name flatArgs flatVar
221− , _rank = _maxRank pool
222− , _mark = noMark
223− , _copy = Nothing
224− }
225− register variable
217+ makeFlatType (Alias name flatArgs flatVar)
226218
227219 VarN v ->
228220 return v
229221
230− TermN term1 ->
231− do variableTerm <- traverseTerm (flattenHelp aliasDict) term1
232− pool <- getPool
233− variable <-
234− liftIO $ UF.fresh $ Descriptor
235− { _content = Structure variableTerm
236− , _rank = _maxRank pool
237− , _mark = noMark
238− , _copy = Nothing
239− }
240− register variable
222+ AppN a b ->
223+ do flatA <- flattenHelp aliasDict a
224+ flatB <- flattenHelp aliasDict b
225+ makeFlatType (Structure (App1 flatA flatB))
226+
227+ FunN a b ->
228+ do flatA <- flattenHelp aliasDict a
229+ flatB <- flattenHelp aliasDict b
230+ makeFlatType (Structure (Fun1 flatA flatB))
231+
232+ EmptyRecordN ->
233+ makeFlatType (Structure EmptyRecord1)
234+
235+ RecordN fields ext ->
236+ do flatFields <- traverse (flattenHelp aliasDict) fields
237+ flatExt <- flattenHelp aliasDict ext
238+ makeFlatType (Structure (Record1 flatFields flatExt))
239+
240+
241+makeFlatType :: Content -> Solver Variable
242+makeFlatType content =
243+ do pool <- getPool
244+ variable <- liftIO $ UF.fresh $
245+ Descriptor
246+ { _content = content
247+ , _rank = _maxRank pool
248+ , _mark = noMark
249+ , _copy = Nothing
250+ }
251+ register variable
241252
242253
243254
@@ -309,7 +320,7 @@ makeCopyHelp (Descriptor content rank mark copy) alreadyCopiedMark variable =
309320 -- will not repeat this work or crawl this variable again.
310321 case content of
311322 Structure term ->
312− do newTerm <- traverseTerm (makeCopy alreadyCopiedMark) term
323+ do newTerm <- traverseFlatType (makeCopy alreadyCopiedMark) term
313324 setContent (Structure newTerm)
314325
315326 Atom _ ->
@@ -384,7 +395,7 @@ restoreContent alreadyCopiedMark content =
384395 in
385396 case content of
386397 Structure term ->
387− Structure <$> traverseTerm go term
398+ Structure <$> traverseFlatType go term
388399
389400 Atom _ ->
390401 return content
@@ -402,12 +413,12 @@ restoreContent alreadyCopiedMark content =
402413
403414
404415
405−-- TERM TRAVERSAL
416+-- TRAVERSE FLAT TYPE
406417
407418
408−traverseTerm :: (a -> Solver b) -> Term1 a -> Solver (Term1 b)
409−traverseTerm f term =
410− case term of
419+traverseFlatType :: (Variable -> Solver Variable) -> FlatType -> Solver FlatType
420+traverseFlatType f flatType =
421+ case flatType of
411422 App1 a b ->
412423 liftM2 App1 (f a) (f b)
413424