git.iko.soy/elk
on master help sign in
Stop allocating on Type.Solve.restore
6140a9dEvan Czaplicki
src/Type/Solve.hs+43−22
compare with master
unifiedsplit
@@ -291,7 +291,9 @@ generalize youngMark visitMark youngRank pools =
291 -- get the ranks right for each entry.
291 -- get the ranks right for each entry.
292 -- start at low ranks so that we only have to pass
292 -- start at low ranks so that we only have to pass
293 -- over the information once.
293 -- over the information once.
294+ Vector.imapM_
294− Vector.imapM_ (mapM_ . adjustRank youngMark visitMark) rankTable
295+ (\rank table -> mapM_ (adjustRank youngMark visitMark rank) table)
296+ rankTable
295
297
296 -- For variables that have rank lowerer than youngRank, register them in
298 -- For variables that have rank lowerer than youngRank, register them in
297 -- the appropriate old pool if they are not redundant.
299 -- the appropriate old pool if they are not redundant.
@@ -562,14 +564,13 @@ srcTypeToVar rank pools flexVars srcType =
562makeCopy :: Int -> Pools -> Variable -> IO Variable
564makeCopy :: Int -> Pools -> Variable -> IO Variable
563makeCopy rank pools var =
565makeCopy rank pools var =
564 do copy <- makeCopyHelp rank pools var
566 do copy <- makeCopyHelp rank pools var
565− _ <- restore var
567+ restore var
566 return copy
568 return copy
567
569
568
570
569makeCopyHelp :: Int -> Pools -> Variable -> IO Variable
571makeCopyHelp :: Int -> Pools -> Variable -> IO Variable
570makeCopyHelp maxRank pools variable =
572makeCopyHelp maxRank pools variable =
571− do (Descriptor content rank _ maybeCopy) <-
573+ do (Descriptor content rank _ maybeCopy) <- UF.get variable
572− UF.get variable
573
574
574 case maybeCopy of
575 case maybeCopy of
575 Just copy ->
576 Just copy ->
@@ -628,45 +629,65 @@ makeCopyHelp maxRank pools variable =
628-- RESTORE
629-- RESTORE
629
630
630
631
631−restore :: Variable -> IO Variable
632+restore :: Variable -> IO ()
632restore variable =
633restore variable =
633− do (Descriptor content _rank _mark maybeCopy) <- UF.get variable
634+ do (Descriptor content _ _ maybeCopy) <- UF.get variable
634 case maybeCopy of
635 case maybeCopy of
635 Nothing ->
636 Nothing ->
636− return variable
637+ return ()
637
638
638 Just _ ->
639 Just _ ->
639− do restoredContent <- restoreContent content
640− UF.set variable $
641− Descriptor restoredContent noRank noMark Nothing
640+ do UF.set variable $ Descriptor content noRank noMark Nothing
642− return variable
641+ restoreContent content
643
642
644
643
645−restoreContent :: Content -> IO Content
644+restoreContent :: Content -> IO ()
646restoreContent content =
645restoreContent content =
647 case content of
646 case content of
648 FlexVar _ ->
647 FlexVar _ ->
649− return content
648+ return ()
650
649
651 FlexSuper _ _ ->
650 FlexSuper _ _ ->
652− return content
651+ return ()
653
652
654 RigidVar _ ->
653 RigidVar _ ->
655− return content
654+ return ()
656
655
657 RigidSuper _ _ ->
656 RigidSuper _ _ ->
658− return content
657+ return ()
659
658
660 Structure term ->
659 Structure term ->
661− Structure <$> traverseFlatType restore term
660+ case term of
661+ App1 _ _ args ->
662+ mapM_ restore args
662
663
664+ Fun1 arg result ->
665+ do restore arg
666+ restore result
667+
668+ EmptyRecord1 ->
669+ return ()
670+
671+ Record1 fields ext ->
672+ do mapM_ restore fields
673+ restore ext
674+
675+ Unit1 ->
676+ return ()
677+
678+ Tuple1 a b maybeC ->
679+ do restore a
680+ restore b
681+ case maybeC of
682+ Nothing -> return ()
683+ Just c -> restore c
684+
663− Alias home name args var ->
685+ Alias _ _ args var ->
664− Alias home name
665− <$> mapM (traverse restore) args
686+ do mapM_ (traverse restore) args
666− <*> restore var
687+ restore var
667
688
668 Error _ ->
689 Error _ ->
669− return content
690+ return ()
670
691
671
692
672
693