@@ -185,13 +185,19 @@ renameInModule :: ImportEnvironment -> ExportEnvironment -> Module -> Either Str
185renameInModule imports exports (Module mn decls exps) =
185renameInModule imports exports (Module mn decls exps) =
186 Module mn <$> mapM go decls <*> pure exps
186 Module mn <$> mapM go decls <*> pure exps
188+ go (DataDeclaration name args dctors) =
189+ rethrowFor "data declaration" name $ DataDeclaration <$> pure name <*> pure args <*> updateAll dctors
190+ go (DataBindingGroupDeclaration decls') =
191+ DataBindingGroupDeclaration <$> mapM go decls'
192+ go (TypeSynonymDeclaration name ps ty) =
193+ rethrowFor "type synonym" name $ TypeSynonymDeclaration <$> pure name <*> pure ps <*> updateType' ty
188 go (TypeInstanceDeclaration name cs cn ts ds) =
194 go (TypeInstanceDeclaration name cs cn ts ds) =
189− TypeInstanceDeclaration name <$> updateConstraints cs <*> updateClassName cn <*> everywhereM (mkM updateType) ts <*> mapM go ds
195+ TypeInstanceDeclaration name <$> updateConstraints cs <*> updateClassName cn <*> updateType' ts <*> mapM go ds
190 go (ExternInstanceDeclaration name cs cn ts) =
196 go (ExternInstanceDeclaration name cs cn ts) =
191− ExternInstanceDeclaration name <$> updateConstraints cs <*> updateClassName cn <*> everywhereM (mkM updateType) ts
197+ ExternInstanceDeclaration name <$> updateConstraints cs <*> updateClassName cn <*> updateType' ts
192 go (ValueDeclaration name nameKind [] Nothing val) = do
198 go (ValueDeclaration name nameKind [] Nothing val) = do
193 val' <- everywhereWithContextM' [] (mkS bindFunctionArgs `extS` bindBinders) val
199 val' <- everywhereWithContextM' [] (mkS bindFunctionArgs `extS` bindBinders) val
194− rethrowForDecl name $ ValueDeclaration name nameKind [] Nothing <$> updateAll val'
200+ rethrowFor "declaration" name $ ValueDeclaration name nameKind [] Nothing <$> updateAll val'
196 bindFunctionArgs bound (Abs (Left arg) val') = return (arg : bound, Abs (Left arg) val')
202 bindFunctionArgs bound (Abs (Left arg) val') = return (arg : bound, Abs (Left arg) val')
197 bindFunctionArgs bound (Let ds val') = let args = map letBoundVariable ds in
203 bindFunctionArgs bound (Let ds val') = let args = map letBoundVariable ds in
@@ -212,10 +218,15 @@ renameInModule imports exports (Module mn decls exps) =
212 letBoundVariable (ValueDeclaration ident _ _ _ _) = ident
218 letBoundVariable (ValueDeclaration ident _ _ _ _) = ident
213 letBoundVariable _ = error "Invalid argument to letBoundVariable"
219 letBoundVariable _ = error "Invalid argument to letBoundVariable"
214 go (ValueDeclaration name _ _ _ _) = error $ "Binders should have been desugared in " ++ show name
220 go (ValueDeclaration name _ _ _ _) = error $ "Binders should have been desugared in " ++ show name
221+ go (ExternDeclaration fit name js ty) =
222+ rethrowFor "declaration" name $ ExternDeclaration <$> pure fit <*> pure name <*> pure js <*> updateType' ty
223+ go (BindingGroupDeclaration decls') = do
224+ BindingGroupDeclaration <$> mapM go' decls'
225+ where go' = \(name, nk, value) -> rethrowFor "declaration" name $ (,,) <$> pure name <*> pure nk <*> updateAll value
215 go d = updateAll d
226 go d = updateAll d
217− rethrowForDecl :: Ident -> Either String a -> Either String a
228+ rethrowFor :: (Show a) => String -> a -> Either String b -> Either String b
218− rethrowForDecl name = rethrow $ "Error in declaration '" ++ show name ++ "'"
229+ rethrowFor what name = rethrow $ "Error in " ++ what ++ " '" ++ show name ++ "'"
220 updateAll :: Data d => d -> Either String d
231 updateAll :: Data d => d -> Either String d
221 updateAll = everywhereM (mkM updateType `extM` updateValue `extM` updateBinder)
232 updateAll = everywhereM (mkM updateType `extM` updateValue `extM` updateBinder)
@@ -230,6 +241,8 @@ renameInModule imports exports (Module mn decls exps) =
230 updateType (SaturatedTypeSynonym name tys) = SaturatedTypeSynonym <$> updateTypeName name <*> mapM updateType tys
241 updateType (SaturatedTypeSynonym name tys) = SaturatedTypeSynonym <$> updateTypeName name <*> mapM updateType tys
231 updateType (ConstrainedType cs t) = ConstrainedType <$> updateConstraints cs <*> pure t
242 updateType (ConstrainedType cs t) = ConstrainedType <$> updateConstraints cs <*> pure t
232 updateType t = return t
243 updateType t = return t
244+ updateType' :: Data d => d -> Either String d
245+ updateType' = everywhereM (mkM updateType)
234 updateConstraints = mapM (\(name, ts) -> (,) <$> updateClassName name <*> pure ts)
247 updateConstraints = mapM (\(name, ts) -> (,) <$> updateClassName name <*> pure ts)