@@ -22,17 +22,27 @@ beta = VarT `liftM` guid
22unionA = Map.unionWith (++)
22unionA = Map.unionWith (++)
23unionsA = Map.unionsWith (++)
23unionsA = Map.unionsWith (++)
25+getAliases :: [(String,ImportMethod)] -> [(String,Scheme)] -> [(String,Scheme)]
25getAliases imports hints = concatMap aliasesFrom imports
26getAliases imports hints = concatMap aliasesFrom imports
28+ -- Get the names of values that are now in scope after a particular
30+ aliasesFrom :: (String,ImportMethod) -> [(String,Scheme)]
26− where aliasesFrom (name,method) =
31+ aliasesFrom (name,method) =
27− let values = concatMap (getValue name) hints
32+ let values = concatMap (getValue name) hints
33+ prefixed name = map (\(n,t) -> (name ++ "." ++ n, t)) values
28− in case method of
34+ in case method of
29− As alias -> map (\(n,t) -> (alias ++ "." ++ n, t)) values
35+ As alias -> prefixed alias
30− Hiding vs -> filter (\(n,t) -> n `notElem` vs) values
36+ Hiding vs -> prefixed name ++ filter (\(n,t) -> n `notElem` vs) values
31− Importing vs -> filter (\(n,t) -> n `elem` vs) values
37+ Importing vs -> prefixed name ++ filter (\(n,t) -> n `elem` vs) values
39+ -- Take a module name and a type annotation. Return the unprefxed
40+ -- type annotation: getValue "List" ("List.map",t) == [("map",t)]
41+ getValue :: String -> (String,Scheme) -> [(String,Scheme)]
32− getValue inModule (name,tipe) =
42+ getValue inModule (name,tipe) =
33− case inModule `isPrefixOf` name of
43+ case inModule `isPrefixOf` name of
34− True -> [ (drop (length inModule + 1) name, tipe) ]
44+ True -> [ (drop (length inModule + 1) name, tipe) ]
35− False -> []
45+ False -> []
37findAmbiguous hints assumptions continue =
47findAmbiguous hints assumptions continue =
38 let potentialDups = map head . filter (\g -> length g > 1) . group . sort $
48 let potentialDups = map head . filter (\g -> length g > 1) . group . sort $
@@ -74,10 +84,11 @@ constrain typeHints (Module _ _ imports stmts) = do
74 let f k s vs = map (\v -> C (Just k) NoSpan $ v :<<: s) vs
84 let f k s vs = map (\v -> C (Just k) NoSpan $ v :<<: s) vs
75 cs = concat . Map.elems $ Map.intersectionWithKey f allHints assumptions
85 cs = concat . Map.elems $ Map.intersectionWithKey f allHints assumptions
76 escapees = Map.keys $ Map.difference assumptions allHints
86 escapees = Map.keys $ Map.difference assumptions allHints
87+ msg = "Warning! Type-checker could not find variables:\n" ++ intercalate ", " escapees
77 return $ case escapees of
88 return $ case escapees of
78 [] -> Right (Set.toList constraints ++ cs)
89 [] -> Right (Set.toList constraints ++ cs)
79− _ -> unsafePerformIO (print escapees) `seq` Right (Set.toList constraints ++ cs)
90+ _ -> unsafePerformIO (putStrLn msg) `seq` Right (Set.toList constraints ++ cs)
80− _ -> Left ("Undefined variable(s): " ++ intercalate ", " escapees)
91+ --_ -> Left ("Undefined variable(s): " ++ intercalate ", " escapees)
82type TVarMap = Map.Map String [X]
93type TVarMap = Map.Map String [X]
83type ConstraintSet = Set.Set (Context Constraint)
94type ConstraintSet = Set.Set (Context Constraint)