From 2d4d1678c38370070fabef8339e10d7a9e684a8b Mon Sep 17 00:00:00 2001 From: timthelion Date: Thu, 7 Nov 2013 12:51:40 +0100 Subject: [PATCH 01/10] Update String.elm You had your types swapped. --- libraries/String.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/String.elm b/libraries/String.elm index 6f58843..00f5778 100644 --- a/libraries/String.elm +++ b/libraries/String.elm @@ -307,5 +307,5 @@ something. fromList ['a','b','c'] == "abc" -} -fromList : String -> [Char] +fromList : [Char] -> String fromList = Native.String.fromList From 87d339b7c9103181a1b14ab46d39171eccd2ebc7 Mon Sep 17 00:00:00 2001 From: Evan Czaplicki Date: Thu, 7 Nov 2013 18:55:45 +0100 Subject: [PATCH 02/10] add note about clang on OS X 10.9 --- README.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/README.md b/README.md index e1b31ae..dd096d5 100644 --- a/README.md +++ b/README.md @@ -3,6 +3,10 @@ Learn about the Elm programming language at [elm-lang.org](http://elm-lang.org/) ## Install +**For people on OS X 10.9 Maverics**, you need to follow +[these directions](http://justtesting.org/post/64947952690/the-glasgow-haskell-compiler-ghc-on-os-x-10-9) +before continuing! + Download the [Haskell Platform 2012.2.0.0 or later](http://hackage.haskell.org/platform/). Once the Haskell Platform is installed: From 3d9f2424650ebc83315f3fad65bd6645bf7f3dc4 Mon Sep 17 00:00:00 2001 From: Evan Czaplicki Date: Thu, 7 Nov 2013 18:56:49 +0100 Subject: [PATCH 03/10] cosmetic change --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index dd096d5..28e2188 100644 --- a/README.md +++ b/README.md @@ -3,7 +3,7 @@ Learn about the Elm programming language at [elm-lang.org](http://elm-lang.org/) ## Install -**For people on OS X 10.9 Maverics**, you need to follow +If you use **OS X 10.9 Maverics**, you must follow [these directions](http://justtesting.org/post/64947952690/the-glasgow-haskell-compiler-ghc-on-os-x-10-9) before continuing! From 13928107ebe7cf1476fb5f01aabf49d9610091b3 Mon Sep 17 00:00:00 2001 From: Evan Czaplicki Date: Thu, 7 Nov 2013 18:57:39 +0100 Subject: [PATCH 04/10] Update README.md --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 28e2188..8fc6358 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ Learn about the Elm programming language at [elm-lang.org](http://elm-lang.org/) If you use **OS X 10.9 Maverics**, you must follow [these directions](http://justtesting.org/post/64947952690/the-glasgow-haskell-compiler-ghc-on-os-x-10-9) -before continuing! +before continuing! Everyone else, can carry on. Download the [Haskell Platform 2012.2.0.0 or later](http://hackage.haskell.org/platform/). Once the Haskell Platform is installed: From 0728d5feb37b860d49b9012de36dbebb00a92d2a Mon Sep 17 00:00:00 2001 From: Evan Czaplicki Date: Thu, 7 Nov 2013 18:59:08 +0100 Subject: [PATCH 05/10] try to make install instructions clearer --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 8fc6358..a1228c9 100644 --- a/README.md +++ b/README.md @@ -3,9 +3,9 @@ Learn about the Elm programming language at [elm-lang.org](http://elm-lang.org/) ## Install -If you use **OS X 10.9 Maverics**, you must follow +On **OS X 10.9 Maverics**, you must follow [these directions](http://justtesting.org/post/64947952690/the-glasgow-haskell-compiler-ghc-on-os-x-10-9) -before continuing! Everyone else, can carry on. +before continuing! Then continue with the normal directions: Download the [Haskell Platform 2012.2.0.0 or later](http://hackage.haskell.org/platform/). Once the Haskell Platform is installed: From 3ce4b090133575c49d20060c98625e804b688b17 Mon Sep 17 00:00:00 2001 From: Evan Czaplicki Date: Thu, 7 Nov 2013 18:59:50 +0100 Subject: [PATCH 06/10] Update README.md --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index a1228c9..ffdb75c 100644 --- a/README.md +++ b/README.md @@ -3,9 +3,9 @@ Learn about the Elm programming language at [elm-lang.org](http://elm-lang.org/) ## Install -On **OS X 10.9 Maverics**, you must follow +**Note for OS X 10.9 Maverics:** you must follow [these directions](http://justtesting.org/post/64947952690/the-glasgow-haskell-compiler-ghc-on-os-x-10-9) -before continuing! Then continue with the normal directions: +before continuing! Download the [Haskell Platform 2012.2.0.0 or later](http://hackage.haskell.org/platform/). Once the Haskell Platform is installed: From 75ad25b7eeb7fa95e6fed24b9350e58d0d85d930 Mon Sep 17 00:00:00 2001 From: i-e-b Date: Fri, 15 Nov 2013 15:58:16 +0000 Subject: [PATCH 07/10] Fix to Json Boolean native constructor --- libraries/Native/Json.js | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libraries/Native/Json.js b/libraries/Native/Json.js index 20dbc30..b6f3e0d 100644 --- a/libraries/Native/Json.js +++ b/libraries/Native/Json.js @@ -41,7 +41,7 @@ Elm.Native.Json.make = function(elm) { switch (typeof v) { case 'string' : return { ctor:"String", _0: JS.toString(v) }; case 'number' : return { ctor:"Number", _0: JS.toFloat(v) }; - case 'boolean': return { ctor:"Bool" , _0: JS.toBool(v) }; + case 'boolean': return { ctor:"Boolean" , _0: JS.toBool(v) }; case 'object' : if (v === null) return { ctor:"Null" }; if (v instanceof Array) { From 704da021b074a3e51bdcd8425870ccc5d7fdedf3 Mon Sep 17 00:00:00 2001 From: Evan Czaplicki Date: Mon, 18 Nov 2013 17:22:36 +0100 Subject: [PATCH 08/10] Fix "dropped" frames for text updates (#224, #339) using @timthelion's insights in #350 * Change the implementation of `notify` so that it does not have a return value any more. * Get rid of the only remaning use of the return value of `notify` in the `every` function. * Have a "lock" on each round to ensure that no library or runtime calls `notify` synchronously, causing an update to happen half way through another update, ultimately leading to a dropped frame. --- libraries/Native/Signal/Time.js | 12 +++++------- libraries/Native/Signal/Window.js | 13 ++++++++++++- runtime/Init.js | 18 ++++++++++++------ 3 files changed, 29 insertions(+), 14 deletions(-) diff --git a/libraries/Native/Signal/Time.js b/libraries/Native/Signal/Time.js index 81ade3e..68d5f63 100644 --- a/libraries/Native/Signal/Time.js +++ b/libraries/Native/Signal/Time.js @@ -34,13 +34,11 @@ Elm.Native.Time.make = function(elm) { return A3( Signal.lift2, F2(f), isOn, ticker ); } - function everyWhen(t, isOn) { + function every(t) { var clock = Signal.constant(Date.now()); - var id = setInterval(function tellTime() { - if (!elm.notify(clock.id, Date.now())) { - clearInterval(id); - } - }, t); + setInterval(function() { + elm.notify(clock.id, Date.now()); + }, t); return clock; } @@ -56,7 +54,7 @@ Elm.Native.Time.make = function(elm) { return elm.Native.Time.values = { fpsWhen : F2(fpsWhen), fps : function(t) { return fpsWhen(t, Signal.constant(true)); }, - every : function(t) { return everyWhen(t, Signal.constant(true)) }, + every : every, delay : NS.delay, timestamp : NS.timestamp, since : F2(since), diff --git a/libraries/Native/Signal/Window.js b/libraries/Native/Signal/Window.js index 0ae17e5..bc9c373 100644 --- a/libraries/Native/Signal/Window.js +++ b/libraries/Native/Signal/Window.js @@ -28,10 +28,21 @@ Elm.Native.Window.make = function(elm) { height.defaultNumberOfKids = 0; function resizeIfNeeded() { + // Do not trigger event if the dimensions have not changed. + // This should be most of the time. var w = getWidth(); var h = getHeight(); if (dimensions.value._0 === w && dimensions.value._1 === h) return; - elm.notify(dimensions.id, Tuple2(w,h)); + + setTimeout(function () { + // Check again to see if the dimensions have changed. + // It is conceivable that the dimensions have changed + // again while some other event was being processed. + var w = getWidth(); + var h = getHeight(); + if (dimensions.value._0 === w && dimensions.value._1 === h) return; + elm.notify(dimensions.id, Tuple2(w,h)); + }, 0); } elm.addListener([dimensions.id], window, 'resize', resizeIfNeeded); diff --git a/runtime/Init.js b/runtime/Init.js index 104d31a..81b5682 100644 --- a/runtime/Init.js +++ b/runtime/Init.js @@ -31,14 +31,20 @@ function init(display, container, module, moduleToReplace) { // defining state needed for an instance of the Elm RTS var inputs = []; + var updateInProgress = false; function notify(id, v) { - var timestep = Date.now(); - var changed = false; - for (var i = inputs.length; i--; ) { - // order is important here to avoid short-circuiting - changed = inputs[i].recv(timestep, id, v) || changed; + if (updateInProgress) { + throw new Error( + 'The notify function has been called synchronously!\n' + + 'This can lead to frames being dropped.\n' + + 'Definitely report this to \n'); } - return changed; + updateInProgress = true; + var timestep = Date.now(); + for (var i = inputs.length; i--; ) { + inputs[i].recv(timestep, id, v); + } + updateInProgress = false; } var listeners = []; From 54a99b730915aab47a818598c0c041927bcc56ba Mon Sep 17 00:00:00 2001 From: Evan Czaplicki Date: Tue, 19 Nov 2013 22:29:25 -0800 Subject: [PATCH 09/10] Add error and explanation for infinite type aliases --- compiler/Transform/Check.hs | 39 +++++++++++++++++++++++++++++++++++-- 1 file changed, 37 insertions(+), 2 deletions(-) diff --git a/compiler/Transform/Check.hs b/compiler/Transform/Check.hs index be3cf2b..4de154d 100644 --- a/compiler/Transform/Check.hs +++ b/compiler/Transform/Check.hs @@ -15,7 +15,9 @@ import Text.PrettyPrint as P mistakes :: (Data t, Data v) => [Declaration t v] -> [Doc] mistakes decls = - illFormedTypes decls ++ map P.text (concatMap findErrors (getLets decls)) + concat [ infiniteTypeAliases decls + , illFormedTypes decls + , map P.text (concatMap findErrors (getLets decls)) ] where findErrors defs = duplicates defs ++ badOrder defs @@ -104,4 +106,37 @@ illFormedTypes decls = map report (Maybe.mapMaybe isIllFormed (aliases ++ adts)) | length xs < 2 = xs | otherwise = zipWith (++) (replicate (length xs - 1) "" ++ ["and "]) xs - quote tvar = "'" ++ tvar ++ "'" \ No newline at end of file + quote tvar = "'" ++ tvar ++ "'" + + +infiniteTypeAliases :: [Declaration t v] -> [Doc] +infiniteTypeAliases decls = + [ report decl | decl@(TypeAlias name _ tipe) <- decls, isInfinite name tipe ] + where + isInfinite name tipe = + let infinite = isInfinite name in + case tipe of + T.Lambda a b -> infinite a || infinite b + T.Var _ -> False + T.Data name' ts -> name == name' || any infinite ts + T.EmptyRecord -> False + T.Record fields ext -> infinite ext || any (infinite . snd) fields + + report decl@(TypeAlias name args tipe) = + P.vcat [ P.text $ eightyCharLines 0 msg1 + , indented decl + , P.text $ eightyCharLines 0 msg2 + , indented (Datatype name args [(name,[tipe])]) + , P.text $ eightyCharLines 0 msg3 ++ "\n" + ] + where + indented decl = P.text "\n " <> pretty decl <> P.text "\n" + + msg1 = "Type alias '" ++ name ++ "' is an infinite type. " ++ + "Notice that it appears in its own definition, so when \ + \you expand it, it just keeps getting bigger:" + msg2 = "Try this instead:" + msg3 = "It looks very similar, but an algebraic data type (ADT) \ + \actually creates a new type. Unlike with a type alias, this \ + \freshly created type is meaningful on its own, so an ADT \ + \does not need to be expanded." From f73a6ff9f92d287d5a9b3754ecd0f52138a6fba5 Mon Sep 17 00:00:00 2001 From: Evan Czaplicki Date: Tue, 19 Nov 2013 22:31:38 -0800 Subject: [PATCH 10/10] Add an occurs check to finally resolve #294 Add it in the more clever location suggested by Pottier and Remy. Also change the style of error messages to get rid of the expected/actual problem for now, and make hints read more smoothly. --- compiler/SourceSyntax/PrettyPrint.hs | 11 ++++ compiler/Type/ExtraChecks.hs | 82 ++++++++++++++-------------- compiler/Type/Solve.hs | 17 ++++-- compiler/Type/State.hs | 28 +++++----- compiler/Type/Unify.hs | 31 ++++++----- 5 files changed, 93 insertions(+), 76 deletions(-) diff --git a/compiler/SourceSyntax/PrettyPrint.hs b/compiler/SourceSyntax/PrettyPrint.hs index 24583fa..fd8f0fb 100644 --- a/compiler/SourceSyntax/PrettyPrint.hs +++ b/compiler/SourceSyntax/PrettyPrint.hs @@ -21,3 +21,14 @@ variable x = reprime :: String -> String reprime = map (\c -> if c == '$' then '\'' else c) + +eightyCharLines :: Int -> String -> String +eightyCharLines indent message = answer + where + (answer,_,_) = foldl step (replicate (indent-1) ' ', indent-1, "") chunks + + chunks = map (\w -> (w, length w)) (words message) + spaces = replicate indent ' ' + step (sentence, slen, space) (word, wlen) + | slen + wlen > 79 = (sentence ++ "\n" ++ spaces ++ word, indent + wlen, " ") + | otherwise = (sentence ++ space ++ word, slen + wlen + length space, " ") diff --git a/compiler/Type/ExtraChecks.hs b/compiler/Type/ExtraChecks.hs index 97be0b2..aec885f 100644 --- a/compiler/Type/ExtraChecks.hs +++ b/compiler/Type/ExtraChecks.hs @@ -1,27 +1,25 @@ -- This module contains checks to be run *after* type inference has -- completed successfully. At that point we still need to do occurs -- checks and ensure that `main` has an acceptable type. -module Type.ExtraChecks (extraChecks) where +module Type.ExtraChecks (extraChecks, occursCheck) where import Control.Applicative ((<$>),(<*>)) +import Control.Monad.State import qualified Data.Map as Map import qualified Data.UnionFind.IO as UF import Type.Type ( Variable, structure, Term1(..), toSrcType ) -import Type.State (Env) +import qualified Type.State as TS import qualified Type.Alias as Alias import Text.PrettyPrint as P import SourceSyntax.PrettyPrint (pretty) import SourceSyntax.Type (Type) +import qualified SourceSyntax.Location as Location +import qualified SourceSyntax.Expression as Expr import qualified Data.Traversable as Traverse -extraChecks :: Alias.Rules -> Env -> IO (Either [P.Doc] (Map.Map String Type)) -extraChecks rules env = do - eitherEnv <- occursCheck env - case eitherEnv of - Left errs -> return $ Left errs - Right env' -> - mainCheck rules <$> Traverse.traverse toSrcType env' - +extraChecks :: Alias.Rules -> TS.Env -> IO (Either [P.Doc] (Map.Map String Type)) +extraChecks rules env = + mainCheck rules <$> Traverse.traverse toSrcType env mainCheck :: Alias.Rules -> (Map.Map String Type) -> Either [P.Doc] (Map.Map String Type) mainCheck rules env = @@ -39,35 +37,37 @@ mainCheck rules env = , P.text " " ] ] -occursCheck :: Env -> IO (Either [P.Doc] Env) -occursCheck env = do - errors <- concat <$> mapM isFinite (Map.toList env) - return $ if null errors then Right env else Left errors - -isFinite :: (String, Variable) -> IO [P.Doc] -isFinite (name, var) = - do varIsFinite <- go [] var - return $ - case varIsFinite of - True -> [] - False -> [ P.vcat [ P.text "Type Error:" - , P.text $ "Cannot construct infinite type for '" ++ name ++ "'\n" - ] - ] +occursCheck :: (String, Variable) -> StateT TS.SolverState IO () +occursCheck (name, variable) = + do vars <- liftIO $ infiniteVars [] variable + case vars of + [] -> return () + var:_ -> do + desc <- liftIO $ UF.descriptor var + case structure desc of + Nothing -> + modify $ \state -> state { TS.sErrors = fallback : TS.sErrors state } + Just struct -> + do liftIO $ UF.setDescriptor var (desc { structure = Nothing }) + var' <- liftIO $ UF.fresh desc + TS.addError (Location.NoSpan name) (Just msg) var var' where - go :: [Variable] -> Variable -> IO Bool - go seen var = - let check = go (var:seen) in - case var `elem` seen of - True -> return False - False -> do - desc <- UF.descriptor var - case structure desc of - Nothing -> return True - Just struct -> - case struct of - App1 a b -> (&&) <$> check a <*> check b - Fun1 a b -> (&&) <$> check a <*> check b - Var1 a -> check a - EmptyRecord1 -> return True - Record1 fields ext -> and <$> mapM check (ext : concat (Map.elems fields)) + msg = "Infinite types are not allowed" + fallback _ = return $ P.text msg + + infiniteVars :: [Variable] -> Variable -> IO [Variable] + infiniteVars seen var = + let go = infiniteVars (var:seen) in + if var `elem` seen + then return [var] + else do + desc <- UF.descriptor var + case structure desc of + Nothing -> return [] + Just struct -> + case struct of + App1 a b -> (++) <$> go a <*> go b + Fun1 a b -> (++) <$> go a <*> go b + Var1 a -> go a + EmptyRecord1 -> return [] + Record1 fields ext -> concat <$> mapM go (ext : concat (Map.elems fields)) diff --git a/compiler/Type/Solve.hs b/compiler/Type/Solve.hs index 1f8655c..4de24d7 100644 --- a/compiler/Type/Solve.hs +++ b/compiler/Type/Solve.hs @@ -9,6 +9,7 @@ import qualified Data.Maybe as Maybe import qualified Data.List as List import Type.Type import Type.Unify +import qualified Type.ExtraChecks as EC import qualified Type.Environment as Env import qualified Type.State as TS import qualified Text.PrettyPrint as P @@ -118,9 +119,10 @@ solve (L span constraint) = CLet schemes constraint' -> do oldEnv <- TS.getEnv - headers <- mapM (solveScheme span) schemes - TS.modifyEnv $ \env -> Map.unions (headers ++ [env]) + headers <- Map.unions `fmap` mapM (solveScheme span) schemes + TS.modifyEnv $ \env -> Map.union headers env solve constraint' + mapM EC.occursCheck $ Map.toList headers TS.modifyEnv (\_ -> oldEnv) CInstance name term -> do @@ -171,11 +173,13 @@ allDistinct span vars = do let check var = do desc <- liftIO $ UF.descriptor var case structure desc of - Just _ -> - TS.addError span "Cannot generalize something that is not a type variable" var var + Just _ -> TS.addError span (Just msg) var var + where msg = "Cannot generalize something that is not a type variable" + Nothing -> do if mark desc == seen - then TS.addError span "Duplicate variable during generalization" var var + then let msg = "Duplicate variable during generalization" + in TS.addError span (Just msg) var var else return () liftIO $ UF.setDescriptor var (desc { mark = seen }) mapM_ check vars @@ -186,4 +190,5 @@ isGeneric span var = do desc <- liftIO $ UF.descriptor var if rank desc == noRank then return () - else TS.addError span "Cannot generalize. Variable must have not have a rank." var var \ No newline at end of file + else let msg = "Unable to generalize a type variable. It is not unranked" + in TS.addError span (Just msg) var var \ No newline at end of file diff --git a/compiler/Type/State.hs b/compiler/Type/State.hs index 756ba48..a8b7d75 100644 --- a/compiler/Type/State.hs +++ b/compiler/Type/State.hs @@ -48,7 +48,7 @@ initialState = SS { modifyEnv f = modify $ \state -> state { sEnv = f (sEnv state) } modifyPool f = modify $ \state -> state { sPool = f (sPool state) } -addError span message t1 t2 = +addError span hint t1 t2 = modify $ \state -> state { sErrors = makeError : sErrors state } where makeError rules = do @@ -56,11 +56,13 @@ addError span message t1 t2 = t1' <- prettiest <$> toSrcType t1 t2' <- prettiest <$> toSrcType t2 return . P.vcat $ - [ P.text $ "Type error" ++ location ++ ":" - , P.vcat . map P.text . lines $ if null message then defaultMessage else message - , P.text src - , P.text " Expected Type:" <+> t1' - , P.text " Actual Type:" <+> t2' <> P.text "\n" + [ display $ case span of { NoSpan msg -> msg ; Span _ _ msg -> msg } + , case hint of + Nothing -> P.text " Could not match the following types:" + Just msg -> P.text $ eightyCharLines 2 $ + msg ++ ", so I could not match the following types:" + , P.text " " <> t1' + , P.text " " <> t2' ] location = case span of @@ -69,14 +71,12 @@ addError span message t1 t2 = if line p1 == line p2 then " on line " ++ show (line p1) else " between lines " ++ show (line p1) ++ " and " ++ show (line p2) - display msg = if null msg then "\n" - else "\n" ++ unlines (map (" "++) $ lines msg) - - src = case span of - NoSpan msg -> display msg - Span _ _ msg -> display msg - - defaultMessage = "Something weird is happening with this value:" + display msg = + case lines msg of + [] -> P.text $ "Type error" ++ location ++ ":" + lines' -> + P.vcat [ P.text $ "Type error" ++ location ++ ", in or near this expression:" + , P.text $ " " ++ List.intercalate "\n " lines' ] switchToPool pool = modifyPool (\_ -> pool) diff --git a/compiler/Type/Unify.hs b/compiler/Type/Unify.hs index 4fb2644..6fadf9d 100644 --- a/compiler/Type/Unify.hs +++ b/compiler/Type/Unify.hs @@ -3,6 +3,7 @@ module Type.Unify (unify) where import Type.Type import qualified Data.UnionFind.IO as UF import qualified Data.Map as Map +import qualified Data.Maybe as Maybe import qualified Type.State as TS import Control.Arrow (first,second) import Control.Monad.State @@ -78,25 +79,26 @@ actuallyUnify span variable1 variable2 = do unifyNumber svar name | name `elem` ["Int","Float","number"] = flexAndUnify svar - | otherwise = TS.addError span "Expecting a number (Int or Float)" variable1 variable2 + | otherwise = TS.addError span (Just hint) variable1 variable2 + where hint = "A number must be an Int or Float" - comparableError str = TS.addError span (str ++ msg) variable1 variable2 - where msg = "Expecting something comparable such as an\n" ++ - "Int, Float, Char, String, or a list or tuple of comparables." + comparableError maybe = + TS.addError span (Just $ Maybe.fromMaybe msg maybe) variable1 variable2 + where msg = "A comparable must be an Int, Float, Char, String, list, or tuple" unifyComparable var name | name `elem` ["Int","Float","Char","String","comparable"] = flexAndUnify var - | otherwise = comparableError "" + | otherwise = comparableError Nothing unifyComparableStructure varSuper varFlex = do struct <- liftIO $ collectApps varFlex case struct of - Other -> comparableError "" + Other -> comparableError Nothing List v -> do flexAndUnify varSuper unify' v =<< liftIO (var $ Is Comparable) Tuple vs | length vs > 6 -> - comparableError "Cannot compare a tuple with more than 6 elements.\n" + comparableError $ Just "Cannot compare a tuple with more than 6 elements" | otherwise -> do flexAndUnify varSuper cmpVars <- liftIO $ forM [1..length vs] $ \_ -> var (Is Comparable) @@ -106,13 +108,12 @@ actuallyUnify span variable1 variable2 = do do struct <- liftIO $ collectApps varFlex case struct of List _ -> flexAndUnify varSuper - _ -> comparableError "" + _ -> comparableError Nothing - rigidError variable = TS.addError span msg variable1 variable2 - where - msg = concat - [ "Cannot unify rigid type variable '", render (pretty Never variable), "'.\n" - , "It is likely that a type annotation is not general enough." ] + rigidError variable = TS.addError span (Just hint) variable1 variable2 + where hint = "There is a problem with the '" ++ + render (pretty Never variable) ++ + "' in the type signature. It currently is not possible to unify type variables that appear in top-level declarations and again in subexpressions" superUnify = case (flex desc1, flex desc2, name desc1, name desc2) of @@ -138,7 +139,7 @@ actuallyUnify span variable1 variable2 = do (Rigid, _, _, _) -> rigidError variable1 (_, Rigid, _, _) -> rigidError variable2 - _ -> TS.addError span "" variable1 variable2 + _ -> TS.addError span Nothing variable1 variable2 case (structure desc1, structure desc2) of (Nothing, Nothing) | flex desc1 == Flexible && flex desc1 == Flexible -> merge @@ -193,5 +194,5 @@ actuallyUnify span variable1 variable2 = do eat (x:xs) (y:ys) = eat xs ys eat xs ys = xs - _ -> TS.addError span "" variable1 variable2 + _ -> TS.addError span Nothing variable1 variable2