Commit 18f66e93 authored by Jan Rasmus Tikovsky 's avatar Jan Rasmus Tikovsky
Browse files

Fixed bug regarding export of record labels

parent ce2237ac
...@@ -30,7 +30,7 @@ import Curry.Syntax ...@@ -30,7 +30,7 @@ import Curry.Syntax
import Base.Messages (Message, internalError, posMessage) import Base.Messages (Message, internalError, posMessage)
import Base.TopEnv (allEntities, origName, localBindings, moduleImports) import Base.TopEnv (allEntities, origName, localBindings, moduleImports)
import Base.Types (DataConstr (..)) import Base.Types (DataConstr (..), constrIdent, recLabels)
import Base.Utils (findMultiples) import Base.Utils (findMultiples)
import Env.ModuleAlias (AliasEnv) import Env.ModuleAlias (AliasEnv)
...@@ -151,10 +151,10 @@ expandTypeWith tc xs = do ...@@ -151,10 +151,10 @@ expandTypeWith tc xs = do
case qualLookupTC tc tcEnv of case qualLookupTC tc tcEnv of
[] -> report (errUndefinedType tc) >> return [] [] -> report (errUndefinedType tc) >> return []
[t@(DataType _ _ cs)] -> do [t@(DataType _ _ cs)] -> do
mapM_ (checkElement (concatMap visibleElems cs)) xs' mapM_ (checkElement (visibleElems cs)) xs'
return [ExportTypeWith (origName t) xs'] return [ExportTypeWith (origName t) xs']
[t@(RenamingType _ _ c)] -> do [t@(RenamingType _ _ c)] -> do
mapM_ (checkElement (visibleElems c)) xs' mapM_ (checkElement (visibleElems [c])) xs'
return [ExportTypeWith (origName t) xs'] return [ExportTypeWith (origName t) xs']
[_] -> report (errNonDataType tc) >> return [] [_] -> report (errNonDataType tc) >> return []
ts -> report (errAmbiguousType tc ts) >> return [] ts -> report (errAmbiguousType tc ts) >> return []
...@@ -269,14 +269,13 @@ joinFun export _ = internalError $ ...@@ -269,14 +269,13 @@ joinFun export _ = internalError $
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
elements :: TypeInfo -> [Ident] elements :: TypeInfo -> [Ident]
elements (DataType _ _ cs) = concatMap visibleElems cs elements (DataType _ _ cs) = visibleElems cs
elements (RenamingType _ _ c) = visibleElems c elements (RenamingType _ _ c) = visibleElems [c]
elements (AliasType _ _ _) = [] elements (AliasType _ _ _) = []
-- get visible constructor and label identifiers for given constructor -- get visible constructor and label identifiers for given constructor
visibleElems :: DataConstr -> [Ident] visibleElems :: [DataConstr] -> [Ident]
visibleElems (DataConstr c _ _) = [c] visibleElems cs = map constrIdent cs ++ (nub (concatMap recLabels cs))
visibleElems (RecordConstr c _ ls _) = c : ls
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Error messages -- Error messages
......
module HaskellRecords (R (C), getL) where module HaskellRecords where
data R a = C { l :: Int, x :: a } data R a = C { l :: Int, x :: a }
| D { l :: Int }
-- construction -- construction
r1 :: R Bool r1 :: R Bool
......
Supports Markdown
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