@@ -24,6 +24,7 @@ module Language.PureScript.Sugar.BindingGroups (
24import Data.Graph
24import Data.Graph
25import Data.List (nub, intersect)
25import Data.List (nub, intersect)
26import Data.Maybe (isJust, mapMaybe)
26import Data.Maybe (isJust, mapMaybe)
27+import Data.Monoid ((<>))
27import Control.Applicative ((<$>), (<*>), pure)
28import Control.Applicative ((<$>), (<*>), pure)
29import qualified Data.Set as S
30import qualified Data.Set as S
@@ -171,7 +172,15 @@ toBindingGroup moduleName (CyclicSCC ds') =
172 toBinding :: SCC Declaration -> Either ErrorStack (Ident, NameKind, Expr)
173 toBinding :: SCC Declaration -> Either ErrorStack (Ident, NameKind, Expr)
173 toBinding (AcyclicSCC d) = return $ fromValueDecl d
174 toBinding (AcyclicSCC d) = return $ fromValueDecl d
174− toBinding (CyclicSCC ds) = Left $ mkErrorStack ("Cycle in value declarations " ++ unwords (map (show . getIdent) ds)) Nothing
175+ toBinding (CyclicSCC ~(d:ds)) = cycleError d ds
177+ cycleError :: Declaration -> [Declaration] -> Either ErrorStack a
178+ cycleError (PositionedDeclaration p d) ds = rethrowWithPosition p $ cycleError d ds
179+ cycleError (ValueDeclaration n _ _ _ e) [] = Left $
180+ mkErrorStack ("Cycle in definition of " ++ show n) (Just (ExprError e))
181+ cycleError d ds@(_:_) = rethrow (<> mkErrorStack ("The following are not yet defined here: " ++ unwords (map (show . getIdent) ds)) Nothing) $ cycleError d []
182+ cycleError _ _ = error "Expected ValueDeclaration"
176toDataBindingGroup :: SCC Declaration -> Either ErrorStack Declaration
185toDataBindingGroup :: SCC Declaration -> Either ErrorStack Declaration
177toDataBindingGroup (AcyclicSCC d) = return d
186toDataBindingGroup (AcyclicSCC d) = return d