on master help sign in
Generated type variables are all recorded in Can.FreeVars

If you had a module with unannotated declarations like this: id v = v Then it would be exported with an incorrect Can.Annotation because the generated type variable names (in this case [“a”]) were not recorded properly. These changes ensure that the taken names are updated as more names are generated.

commita84f4bd8351babfbd09d34e797f0df813dd91518 authorEvan Czaplicki <evancz@users.noreply.github.com> dateMon 2 Apr 2018, 15:03 (9 years ago) parent074467f
1 file changed+44−45
compiler/src/Type/Type.hs+44−45
compiler/src/Type/Type.hs+44−45
@@ -344,9 +344,9 @@ toSuper name =
344344toAnnotation :: Variable -> IO Can.Annotation
345345toAnnotation variable =
346346 do userNames <- getVarNames variable Map.empty
347− (tipe, NameState allNames _ _ _ _ _) <-
347+ (tipe, NameState freeVars _ _ _ _ _) <-
348348 State.runStateT (variableToCanType variable) (makeNameState userNames)
349− return $ Can.Forall (Map.map (const ()) allNames) tipe
349+ return $ Can.Forall freeVars tipe
350350
351351
352352variableToCanType :: Variable -> StateT NameState IO Can.Type
@@ -557,7 +557,7 @@ termToErrorType term =
557557
558558data NameState =
559559 NameState
560− { _taken :: TakenNames
560+ { _taken :: Map.Map N.Name ()
561561 , _normals :: Int
562562 , _numbers :: Int
563563 , _comparables :: Int
@@ -566,21 +566,41 @@ data NameState =
566566 }
567567
568568
569−type TakenNames = Map.Map N.Name Variable
569+makeNameState :: Map.Map N.Name Variable -> NameState
570+makeNameState taken =
571+ NameState (Map.map (const ()) taken) 0 0 0 0 0
570572
571573
572−makeNameState :: TakenNames -> NameState
573−makeNameState taken =
574− NameState taken 0 0 0 0 0
574+
575+-- FRESH VAR NAMES
575576
576577
577578getFreshVarName :: (Monad m) => StateT NameState m N.Name
578579getFreshVarName =
579580 do index <- State.gets _normals
580581 taken <- State.gets _taken
581− let (uniqueName, newIndex) = getFreshNormal index taken
582− State.modify (\state -> state { _normals = newIndex })
583− return uniqueName
582+ let (name, newIndex, newTaken) = getFreshVarNameHelp index taken
583+ State.modify $ \state -> state { _taken = newTaken, _normals = newIndex }
584+ return name
585+
586+
587+getFreshVarNameHelp :: Int -> Map.Map N.Name () -> (N.Name, Int, Map.Map N.Name ())
588+getFreshVarNameHelp index taken =
589+ let
590+ (postfix, letter) =
591+ quotRem index 26
592+
593+ chr = N.fromLetter letter
594+ name = if postfix <= 0 then chr else N.addIndex chr postfix
595+ in
596+ if Map.member name taken then
597+ getFreshVarNameHelp (index + 1) taken
598+ else
599+ ( name, index + 1, Map.insert name () taken )
600+
601+
602+
603+-- FRESH SUPER NAMES
584604
585605
586606getFreshSuperName :: (Monad m) => SuperType -> StateT NameState m N.Name
@@ -599,54 +619,33 @@ getFreshSuperName super =
599619 getFreshSuper "compappend" _compAppends (\index state -> state { _compAppends = index })
600620
601621
602−getFreshNormal :: Int -> TakenNames -> (N.Name, Int)
603−getFreshNormal index taken =
604− let
605− (postfix, letter) =
606− quotRem index 26
607−
608− chr = N.fromLetter letter
609− name = if postfix <= 0 then chr else N.addIndex chr postfix
610− in
611− if Map.member name taken then
612− getFreshNormal (index + 1) taken
613−
614− else
615− (name, index + 1)
616−
617−
618−getFreshSuper
619− :: (Monad m)
620− => N.Name
621− -> (NameState -> Int)
622− -> (Int -> NameState -> NameState)
623− -> StateT NameState m N.Name
624−getFreshSuper name getter setter =
622+getFreshSuper :: (Monad m) => N.Name -> (NameState -> Int) -> (Int -> NameState -> NameState) -> StateT NameState m N.Name
623+getFreshSuper prefix getter setter =
625624 do index <- State.gets getter
626625 taken <- State.gets _taken
627− let (uniqueName, newIndex) = getFreshSuperHelp name index taken
628− State.modify (setter newIndex)
629− return uniqueName
626+ let (name, newIndex, newTaken) = getFreshSuperHelp prefix index taken
627+ State.modify (\state -> setter newIndex state { _taken = newTaken })
628+ return name
630629
631630
632−getFreshSuperHelp :: N.Name -> Int -> TakenNames -> (N.Name, Int)
633−getFreshSuperHelp name index taken =
631+getFreshSuperHelp :: N.Name -> Int -> Map.Map N.Name () -> (N.Name, Int, Map.Map N.Name ())
632+getFreshSuperHelp prefix index taken =
634633 let
635− newName =
636− if index <= 0 then name else N.addIndex name index
634+ name =
635+ if index <= 0 then prefix else N.addIndex prefix index
637636 in
638− if Map.member newName taken then
639− getFreshSuperHelp name (index + 1) taken
637+ if Map.member name taken then
638+ getFreshSuperHelp prefix (index + 1) taken
640639
641640 else
642− (newName, index + 1)
641+ ( name, index + 1, Map.insert name () taken )
643642
644643
645644
646645-- GET ALL VARIABLE NAMES
647646
648647
649−getVarNames :: Variable -> TakenNames -> IO TakenNames
648+getVarNames :: Variable -> Map.Map N.Name Variable -> IO (Map.Map N.Name Variable)
650649getVarNames var takenNames =
651650 do (Descriptor content rank mark copy) <- UF.get var
652651 if mark == getVarNamesMark
@@ -711,7 +710,7 @@ getVarNames var takenNames =
711710-- REGISTER NAME / RENAME DUPLICATES
712711
713712
714−addName :: Int -> N.Name -> Variable -> (N.Name -> Content) -> TakenNames -> IO TakenNames
713+addName :: Int -> N.Name -> Variable -> (N.Name -> Content) -> Map.Map N.Name Variable -> IO (Map.Map N.Name Variable)
715714addName index givenName var makeContent takenNames =
716715 let
717716 indexedName =