suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Provided slightly better error messages from the type unification module

Browse Source
This commit is contained in:
Neil Brown 2008-05-14 12:18:58 +00:00
parent e843ce5022
commit 875cf4b40a
1 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
frontends/TypeUnification.hs
View File

@ -62,23 +62,23 @@ unifyRainTypes m prs
mapToST = mapMapM typeToTypeExp mapToST = mapMapM typeToTypeExp
stToMap :: Map.Map k (TypeExp s A.Type) -> ST s (Either String (Map.Map k A.Type)) stToMap :: Map.Map k (TypeExp s A.Type) -> ST s (Either String (Map.Map k A.Type))
stToMap m = do m' <- mapMapM (read <.< prune) m stToMap m = do m' <- mapMapWithKeyM (\k v -> prune v >>= read k) m
let (mapOfErrs, mapOfRes) = Map.mapEitherWithKey (const id) m' let (mapOfErrs, mapOfRes) = Map.mapEitherWithKey (const id) m'
case Map.elems mapOfErrs of case Map.elems mapOfErrs of
(e:_) -> return $ Left e (e:_) -> return $ Left e
[] -> return $ Right mapOfRes [] -> return $ Right mapOfRes
where where
read :: TypeExp s A.Type -> ST s (Either String A.Type) read :: k -> TypeExp s A.Type -> ST s (Either String A.Type)
read (OperType con vals) = do vals' <- mapM read vals read k (OperType con vals) = do vals' <- mapM (read k) vals
return $ foldCon con vals' return $ foldCon con vals'
read (MutVar v) = readSTRef v >>= \t -> case t of read k (MutVar v) = readSTRef v >>= \t -> case t of
Nothing -> return $ Left $ "Type error in unification, found non-unified type" Nothing -> return $ Left $ "Type error in unification, "
Just t' -> read t' ++ "ambigious type remains for: " ++ show k
read (NumLit v) = readSTRef v >>= \x -> case x of Just t' -> read k t'
Left _ -> return $ Left $ "Numeric type without concrete type" read k (NumLit v) = readSTRef v >>= \x -> case x of
Left _ -> return $ Left $ "Type error in unification, "
++ "ambigious type remains for numeric literal: " ++ show k
Right t -> return $ Right t Right t -> return $ Right t
read x = return $ Left $ "Type error in unification, found: " ++ show x
++ " in: " ++ show m
ttte :: Data b => b -> A.Type -> ST s (TypeExp s A.Type) ttte :: Data b => b -> A.Type -> ST s (TypeExp s A.Type)
ttte c t = typeToTypeExp t >>= \t' -> return $ OperType (toConstr c) [t'] ttte c t = typeToTypeExp t >>= \t' -> return $ OperType (toConstr c) [t']