Commit de455b88 authored by Jan Rasmus Tikovsky 's avatar Jan Rasmus Tikovsky
Browse files

Implicit import of hidden data constructors for imported record labels

parent 830a23c2
......@@ -162,6 +162,6 @@ ppTypes mid valueEnv = ppTypes' mid $ localBindings valueEnv
conType :: QualIdent -> ValueEnv -> ([Ident], ExistTypeScheme)
conType c tyEnv = case qualLookupTopEnv c tyEnv of
[DataConstructor _ _ ls ty] -> (ls, ty)
[DataConstructor _ _ ls ty] -> (ls , ty)
[NewtypeConstructor _ l ty] -> ([l], ty)
_ -> internalError $ "Env.Value.conType: " ++ show c
......@@ -211,7 +211,8 @@ bindType f m tc tvs = Map.insert (unqualify tc)
bindTy :: ModuleIdent -> IDecl -> ExpValueEnv -> ExpValueEnv
bindTy m (IDataDecl _ tc tvs cs hs) env =
let env' = foldr (bindConstr m tc' tvs ty') env $
filter ((`notElem` hs) . constrId) cs
filter ((\con -> con `notElem` hs || isHiddenButNeeded con)
. constrId) cs
in foldr (bindLabel m tc' tvs ty') env' $ nubBy sameLabel clabels
where tc' = qualQualify m tc
ty' = constrType tc' tvs
......@@ -220,6 +221,9 @@ bindTy m (IDataDecl _ tc tvs cs hs) env =
]
clabels = [(l, constr l, ty) | (l, ty) <- labels]
constr l = [constrId c | c <- cs, l `elem` recordLabels c]
-- hidden constructors needed for record updates with visible labels
hiddenCs = [c | (l, _) <- labels, c <- constr l, c `elem` hs]
isHiddenButNeeded = flip elem hiddenCs
sameLabel (l1,_,_) (l2,_,_) = l1 == l2
bindTy m (INewtypeDecl _ tc tvs nc hs) env
| (nconstrId nc) `notElem` hs = mBindLabel nc $
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment