git.iko.soy/elk
on master help sign in
Properly export and import record constructors
30a2689Evan Czaplicki
compiler/Transform/Canonicalize.hs+61−30
compare with master
unifiedsplit
@@ -43,10 +43,10 @@ module' interfaces modul =
43
43
44moduleHelp :: Module.Interfaces -> Module.ValidModule
44moduleHelp :: Module.Interfaces -> Module.ValidModule
45 -> Canonicalizer [Doc] Module.CanonicalModule
45 -> Canonicalizer [Doc] Module.CanonicalModule
46−moduleHelp interfaces modul@(Module.Module _ _ exs _ decls) =
46+moduleHelp interfaces modul@(Module.Module _ _ exports _ decls) =
47 do env <- Setup.environment interfaces modul
47 do env <- Setup.environment interfaces modul
48 canonicalDecls <- mapM (declaration env) decls
48 canonicalDecls <- mapM (declaration env) decls
49− exports' <- delist locals exs
49+ exports' <- resolveExports locals exports
50 return $ modul { Module.exports = exports'
50 return $ modul { Module.exports = exports'
51 , Module.body = body canonicalDecls
51 , Module.body = body canonicalDecls
52 }
52 }
@@ -71,40 +71,71 @@ moduleHelp interfaces modul@(Module.Module _ _ exs _ decls) =
71 [ D.portName port | D.Port port <- decls ]
71 [ D.portName port | D.Port port <- decls ]
72 }
72 }
73
73
74−delist :: [Var.Value] -> Var.Listing Var.Value -> Canonicalizer [Doc] [Var.Value]
74+resolveExports :: [Var.Value] -> Var.Listing Var.Value -> Canonicalizer [Doc] [Var.Value]
75−delist fullList (Var.Listing partial open)
75+resolveExports fullList (Var.Listing partialList open) =
76+ if open
76− | open = return fullList
77+ then return fullList
77− | otherwise = go [] (List.sort fullList) (List.sort partial)
78+ else do
79+ valueExports <- getValueExports
80+ aliasExports <- concat `fmap` mapM getAliasExport aliases
81+ adtExports <- mapM getAdtExport adts
82+ return $ valueExports ++ aliasExports ++ adtExports
78 where
83 where
84+ (allValues, allAliases, allAdts) = splitValues fullList
85+
86+ (values, aliases, adts) = splitValues partialList
87+
88+ getValueExports =
89+ case Set.toList (Set.difference values' allValues') of
90+ [] -> return (map Var.Value values)
91+ xs -> notFound xs
92+ where
93+ allValues' = Set.fromList allValues
94+ values' = Set.fromList values
95+
96+ getAliasExport alias
97+ | alias `elem` allAliases =
98+ let recordConstructor =
99+ if alias `elem` allValues then [Var.Value alias] else []
100+ in
101+ return $ Var.Alias alias : recordConstructor
102+
103+ | otherwise =
104+ case List.find (\(name, _ctors) -> name == alias) allAdts of
105+ Nothing -> notFound [alias]
106+ Just (name, _ctor) ->
107+ return [Var.ADT name (Var.Listing [] False)]
108+
109+ getAdtExport (name, Var.Listing ctors open) =
110+ case lookup name allAdts of
111+ Nothing -> notFound [name]
112+ Just (Var.Listing allCtors _)
113+ | open -> return $ Var.ADT name (Var.Listing allCtors False)
114+ | otherwise ->
115+ case filter (`notElem` allCtors) ctors of
116+ [] -> return $ Var.ADT name (Var.Listing ctors False)
117+ unfoundCtors -> notFound unfoundCtors
118+
79 notFound xs =
119 notFound xs =
80 throwError [ P.text "Export Error: trying to export non-existent values:" <+>
120 throwError [ P.text "Export Error: trying to export non-existent values:" <+>
81 commaSep (map pretty xs)
121 commaSep (map pretty xs)
82 ]
122 ]
83
123
84− go list full partial =
124+{-| Split a list of values into categories so we can work with them
85− case (full, partial) of
125+independently.
86− (_, []) -> return list
126+-}
87− ([], _) -> notFound partial
127+splitValues :: [Var.Value] -> ([String], [String], [(String, Var.Listing String)])
88− (x:xs, y:ys) ->
128+splitValues mixedValues =
89− case (x,y) of
129+ case mixedValues of
90− (Var.Value x', Var.Value y') | x' == y' ->
130+ [] -> ([], [], [])
91− go (x : list) xs ys
131+ x:xs ->
92−
132+ let (values, aliases, adts) = splitValues xs in
93− (Var.Alias x', Var.Alias y') | x' == y' ->
133+ case x of
94− go (x : list) xs ys
134+ Var.Value name -> (name : values, aliases, adts)
95−
135+ Var.Alias name -> (values, name : aliases, adts)
96− (Var.ADT x' _, Var.Alias y') | x' == y' ->
136+ Var.ADT name listing ->
97− go (Var.ADT x' (Var.Listing [] False) : list) xs ys
137+ (values, aliases, (name, listing) : adts)
98−
138+
99− (Var.ADT x' (Var.Listing xctors _ ),
100− Var.ADT y' (Var.Listing yctors open)) | x' == y' ->
101− if open
102− then go (x : list) xs ys
103− else case filter (`notElem` xctors) yctors of
104− [] -> go (y : list) xs ys
105− bads -> notFound bads
106−
107− _ -> go list xs partial
108
139
109
140
110declToValue :: D.ValidDecl -> [Var.Value]
141declToValue :: D.ValidDecl -> [Var.Value]
compiler/Transform/Canonicalize/Setup.hs+11−2
@@ -99,8 +99,17 @@ addValue name interface env value =
99 Var.Alias x ->
99 Var.Alias x ->
100 case Map.lookup x (iAliases interface) of
100 case Map.lookup x (iAliases interface) of
101 Just (tvars, t) ->
101 Just (tvars, t) ->
102+ return $ env
103+ { _aliases = insert x v (_aliases env)
104+ , _values = updatedValues
105+ }
106+ where
102− let v = (Var.Canonical (Var.Module name) x, tvars, t) in
107+ v = (Var.Canonical (Var.Module name) x, tvars, t)
103− return $ env { _aliases = insert x v (_aliases env) }
108+ updatedValues =
109+ if Map.member x (iTypes interface)
110+ then insert' x (_values env)
111+ else _values env
112+
104 Nothing ->
113 Nothing ->
105 case Map.lookup x (iAdts interface) of
114 case Map.lookup x (iAdts interface) of
106 Nothing -> notFound x
115 Nothing -> notFound x
tests/compiler/test-files/good/Imports/UseRecordConstructor.elmnew file+4
@@ -0,0 +1,4 @@
1+
2+import Imports (Point)
3+
4+point = Point 3 4