yogsototh/elm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix problem with variable shadowing when instantiating aliased types

Browse source
This commit is contained in:
Evan Czaplicki 2013-08-08 15:45:22 -07:00
parent c70d59fdf9
commit 143547e766
1 changed files with 28 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

56
compiler/Type/Environment.hs
View file

@ -122,40 +122,40 @@ instantiator env sourceType = go sourceType
Src.Var x -> do Src.Var x -> do
(dict, aliases) <- State.get (dict, aliases) <- State.get
case Map.lookup x dict of case (Map.lookup x dict, Map.lookup x aliases) of
Just var -> return (VarN var) (_, Just t) -> return t
Nothing -> (Just v, _) -> return (VarN v)
case Map.lookup x aliases of _ ->
Just t -> return t do var <- State.liftIO $ namedVar flex x
Nothing -> State.put (Map.insert x var dict, aliases)
do var <- State.liftIO $ namedVar flex x return (VarN var)
State.put (Map.insert x var dict, aliases) where
return (VarN var) flex | "number" `isPrefixOf` x = Is Number
where | "comparable" `isPrefixOf` x = Is Comparable
flex | "number" `isPrefixOf` x = Is Number | "appendable" `isPrefixOf` x = Is Appendable
| "comparable" `isPrefixOf` x = Is Comparable | otherwise = Flexible
| "appendable" `isPrefixOf` x = Is Appendable
| otherwise = Flexible
Src.Data "String" [] -> Src.Data "String" [] ->
return (get env types "_List" <| get env types "Char") return (get env types "_List" <| get env types "Char")
Src.Data name ts -> do Src.Data name ts -> do
ts' <- mapM go ts ts' <- mapM go ts
case Map.lookup name (types env) of case (Map.lookup name (types env), Map.lookup name (aliases env)) of
Just t -> return $ foldl (<|) t ts' (Just t, _) -> return $ foldl (<|) t ts'
Nothing -> (_, Just (tvars, t)) ->
case Map.lookup name (aliases env) of let tvarLen = length tvars
Nothing -> error $ "\nCould not find type constructor '" ++ name ++ "' while checking types." msg = "\nType alias '" ++ name ++ "' expects " ++ show tvarLen ++
Just (tvars, t) -> " type argument" ++ (if tvarLen == 1 then "" else "s") ++
let tvarLen = length tvars " but was given " ++ show (length ts')
msg = "\nType alias '" ++ name ++ "' expects " ++ show tvarLen ++ in if length ts' /= length tvars then error msg else
" type argument" ++ (if tvarLen == 1 then "" else "s") ++ do (dict, aliases) <- State.get
" but was given " ++ show (length ts') let aliases' = Map.union (Map.fromList $ zip tvars ts') aliases
in if length ts' /= length tvars then error msg else State.put (dict, aliases')
do (dict, aliases) <- State.get t' <- go t
State.put (dict, Map.union aliases . Map.fromList $ zip tvars ts') State.put (dict, aliases)
go t return t'
_ -> error $ "\nCould not find type constructor '" ++
name ++ "' while checking types."
Src.EmptyRecord -> return (TermN EmptyRecord1) Src.EmptyRecord -> return (TermN EmptyRecord1)