git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Nicer errors for skolemized types
commitb578d26563d2c321862eb1399fc8dd44d810a3bb authorPhil Freeman <paf31@cantab.net> dateSun 26 Apr 2015, 13:25 (12 years ago) parent9db8c6c
2 files changed+21−15
compare with golang
unifiedsplit
src/Language/PureScript/Errors.hs+20−14 src/Language/PureScript/Pretty/Types.hs+1−1
src/Language/PureScript/Errors.hs+20−14
@@ -19,10 +19,13 @@
1919module Language.PureScript.Errors where
2020
2121import Data.Either (lefts, rights)
22−import Data.List (intercalate, elemIndex)
22+import Data.List (intercalate)
23+import Data.Function (on)
2324import Data.Monoid
2425import Data.Foldable (fold, foldMap)
2526
27+import qualified Data.Map as M
28+
2629import Control.Monad
2730import Control.Monad.Error.Class (MonadError(..))
2831import Control.Monad.Unify
@@ -252,19 +255,22 @@ errorMessage err = MultipleErrors [err]
252255onErrorMessages :: (ErrorMessage -> ErrorMessage) -> MultipleErrors -> MultipleErrors
253256onErrorMessages f = MultipleErrors . map f . runMultipleErrors
254257
255−replaceUnknowns :: Type -> State [Unknown] Type
258+-- | A map from rigid type variable name/unknown variable pairs to new variables.
259+type UnknownMap = M.Map (Maybe String, Unknown) Unknown
260+
261+replaceUnknowns :: Type -> State UnknownMap Type
256262replaceUnknowns = everywhereOnTypesM replaceUnknowns'
257263 where
258− lookupTable :: Unknown -> [Unknown] -> (Unknown, [Unknown])
259− lookupTable x table = case (elemIndex x table) of
260− Nothing -> (length table, table ++ [x])
261− Just i -> (i, table)
262−
263− replaceUnknowns' :: Type -> State [Unknown] Type
264− replaceUnknowns' (TUnknown u) = state $ first TUnknown . lookupTable u
264+ lookupTable :: (Maybe String, Unknown) -> UnknownMap -> (Unknown, UnknownMap)
265+ lookupTable x m = case M.lookup x m of
266+ Nothing -> let i = length (filter (on (==) fst x) (M.keys m)) in (i, M.insert x i m)
267+ Just i -> (i, m)
268+
269+ replaceUnknowns' :: Type -> State UnknownMap Type
270+ replaceUnknowns' (TUnknown u) = state $ first TUnknown . lookupTable (Nothing, u)
271+ replaceUnknowns' (Skolem name s sko) = state $ first (flip (Skolem name) sko) . lookupTable (Just name, s)
265272 replaceUnknowns' other = return other
266273
267−
268274onTypesInErrorMessageM :: (Applicative m) => (Type -> m Type) -> ErrorMessage -> m ErrorMessage
269275onTypesInErrorMessageM f = g
270276 where
@@ -298,7 +304,7 @@ onTypesInErrorMessageM f = g
298304-- |
299305-- Pretty print a single error, simplifying if necessary
300306--
301−prettyPrintSingleError :: Bool -> ErrorMessage -> State [Unknown] Box.Box
307+prettyPrintSingleError :: Bool -> ErrorMessage -> State UnknownMap Box.Box
302308prettyPrintSingleError full e = prettyPrintErrorMessage <$> onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
303309 where
304310 -- |
@@ -569,15 +575,15 @@ prettyPrintSingleError full e = prettyPrintErrorMessage <$> onTypesInErrorMessag
569575-- Pretty print multiple errors
570576--
571577prettyPrintMultipleErrors :: Bool -> MultipleErrors -> String
572−prettyPrintMultipleErrors full = flip evalState [] . prettyPrintMultipleErrorsWith "Error:" "Multiple errors:" full
578+prettyPrintMultipleErrors full = flip evalState M.empty . prettyPrintMultipleErrorsWith "Error:" "Multiple errors:" full
573579
574580-- |
575581-- Pretty print multiple warnings
576582--
577583prettyPrintMultipleWarnings :: Bool -> MultipleErrors -> String
578−prettyPrintMultipleWarnings full = flip evalState [] . prettyPrintMultipleErrorsWith "Warning:" "Multiple warnings:" full
584+prettyPrintMultipleWarnings full = flip evalState M.empty . prettyPrintMultipleErrorsWith "Warning:" "Multiple warnings:" full
579585
580−prettyPrintMultipleErrorsWith :: String -> String -> Bool -> MultipleErrors -> State [Unknown] String
586+prettyPrintMultipleErrorsWith :: String -> String -> Bool -> MultipleErrors -> State UnknownMap String
581587prettyPrintMultipleErrorsWith intro _ full (MultipleErrors [e]) = do
582588 result <- prettyPrintSingleError full e
583589 return $ renderBox $
src/Language/PureScript/Pretty/Types.hs+1−1
@@ -39,7 +39,7 @@ typeLiterals = mkPattern match
3939 match (PrettyPrintObject row) = Just $ "{ " ++ prettyPrintRow row ++ " }"
4040 match (PrettyPrintArray ty) = Just $ "[" ++ prettyPrintType ty ++ "]"
4141 match (TypeConstructor ctor) = Just $ show ctor
42− match (TUnknown u) = Just $ 'u' : show u
42+ match (TUnknown u) = Just $ '_' : show u
4343 match (Skolem name s _) = Just $ name ++ show s
4444 match (ConstrainedType deps ty) = Just $ "(" ++ intercalate ", " (map (\(pn, ty') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom ty')) deps) ++ ") => " ++ prettyPrintType ty
4545 match (SaturatedTypeSynonym name args) = Just $ show name ++ "<" ++ intercalate "," (map prettyPrintTypeAtom args) ++ ">"