git.iko.soy/elk
on master help sign in
Fix #766, properly trim explicit exports of ADTs and type aliases

It looks like it may be possible to simplify Var.Value so that it just has values and types. I’m not sure though.

commit8a045c7a3ef6a828ca2e1c126a609332fea2a7e7 authorEvan Czaplicki <info@elm-lang.org> dateSun 24 Aug 2014, 00:54 (12 years ago) parentce614bb
4 files changed+98−55
compare with master
unifiedsplit
compiler/Build/Source.hs+7−7 compiler/Transform/Canonicalize.hs+49−15 libraries/Dict.elm+33−26 libraries/Set.elm+9−7
compiler/Build/Source.hs+7−7
@@ -4,22 +4,22 @@ module Build.Source (build) where
44import qualified Data.Map as Map
55import Text.PrettyPrint (Doc)
66
7−import AST.Module as Module
7+import qualified AST.Module as Module
88import qualified Parse.Parse as Parse
99import qualified Metadata.Prelude as Prelude
1010import qualified Transform.Check as Check
1111import qualified Type.Inference as TI
1212import qualified Transform.Canonicalize as Canonical
1313
14−build :: Bool -> Interfaces -> String -> Either [Doc] CanonicalModule
14+build :: Bool -> Module.Interfaces -> String -> Either [Doc] Module.CanonicalModule
1515build noPrelude interfaces source =
1616 do let infixes = Map.fromList . map (\(assoc,lvl,op) -> (op,(lvl,assoc)))
17− . concatMap iFixities $ Map.elems interfaces
17+ . concatMap Module.iFixities $ Map.elems interfaces
1818
1919 -- Parse the source code and validate that it is well formed.
2020 validModule <- do
2121 modul <- Prelude.add noPrelude `fmap` Parse.program infixes source
22− case Check.mistakes (body modul) of
22+ case Check.mistakes (Module.body modul) of
2323 [] -> return modul
2424 ms -> Left ms
2525
@@ -30,7 +30,7 @@ build noPrelude interfaces source =
3030 types <- TI.infer interfaces canonicalModule
3131
3232 -- Trim down the set of exported values to the stuff that is actually exported.
33− let types' = Canonical.filterExports types (Module.exports canonicalModule)
34− body' = (body canonicalModule) { types = types' }
33+ let bodyWithTypes = (Module.body canonicalModule) { Module.types = types }
34+ body = Canonical.filterExports bodyWithTypes (Module.exports canonicalModule)
3535
36− return $ canonicalModule { body = body' }
36+ return $ canonicalModule { Module.body = body }
compiler/Transform/Canonicalize.hs+49−15
@@ -106,23 +106,54 @@ delist fullList (Var.Listing partial open)
106106
107107 _ -> go list xs partial
108108
109−filterExports :: Module.Types -> [Var.Value] -> Module.Types
110−filterExports types values =
111− Map.fromList (concatMap getValue values)
109+filterExports :: Module.CanonicalBody -> [Var.Value] -> Module.CanonicalBody
110+filterExports body exportedValues =
111+ body
112+ { Module.types =
113+ Map.fromList (concatMap getTypes exportedValues)
114+ , Module.aliases =
115+ Map.fromList (concatMap getAliases exportedValues)
116+ , Module.datatypes =
117+ Map.fromList (concatMap getAdts exportedValues)
118+ }
112119 where
113− getValue :: Var.Value -> [(String, Type.CanonicalType)]
114− getValue value =
115− case value of
116− Var.Value x -> get x
117− Var.Alias x -> get x
118− Var.ADT _ (Var.Listing ctors _) -> concatMap get ctors
119−
120− get :: String -> [(String, Type.CanonicalType)]
121− get x =
122− case Map.lookup x types of
120+ get :: Map.Map String a -> String -> [(String, a)]
121+ get dict x =
122+ case Map.lookup x dict of
123123 Just t -> [(x,t)]
124124 Nothing -> []
125125
126+ getTypes :: Var.Value -> [(String, Type.CanonicalType)]
127+ getTypes value =
128+ case value of
129+ Var.Value x -> getType x
130+ Var.Alias _ -> []
131+ Var.ADT _ (Var.Listing ctors _) -> concatMap getType ctors
132+
133+ getType :: String -> [(String, Type.CanonicalType)]
134+ getType = get (Module.types body)
135+
136+ getAliases :: Var.Value -> [(String, ([String], Type.CanonicalType))]
137+ getAliases value =
138+ case value of
139+ Var.Value _ -> []
140+ Var.Alias name -> get (Module.aliases body) name
141+ Var.ADT _ _ -> []
142+
143+ getAdts :: Var.Value -> [(String, Module.AdtInfo String)]
144+ getAdts value =
145+ case value of
146+ Var.Value _ -> []
147+ Var.Alias _ -> []
148+ Var.ADT name (Var.Listing exportedCtors _) ->
149+ case Map.lookup name (Module.datatypes body) of
150+ Nothing -> []
151+ Just (tvars, ctors) ->
152+ [(name, (tvars, filter isExported ctors))]
153+ where
154+ isExported (ctor, _) = ctor `elem` exportedCtors
155+
156+
126157declToValue :: D.ValidDecl -> [Var.Value]
127158declToValue decl =
128159 case decl of
@@ -132,8 +163,11 @@ declToValue decl =
132163 D.Datatype name _tvs ctors ->
133164 [ Var.ADT name (Var.Listing (map fst ctors) False) ]
134165
135− D.TypeAlias name _ (Type.Record _ _) ->
136− [ Var.Alias name ]
166+ D.TypeAlias name _ tipe ->
167+ case tipe of
168+ Type.Record _ _ ->
169+ [ Var.Alias name, Var.Value name ]
170+ _ -> [ Var.Alias name ]
137171
138172 _ -> []
139173
libraries/Dict.elm+33−26
@@ -1,13 +1,15 @@
1−module Dict (empty,singleton,insert,update
2− ,get,getOrElse,getOrFail
3− ,remove,member
4− ,filter
5− ,partition
6− ,foldl,foldr,map
7− ,union,intersect,diff
8− ,keys,values
9− ,toList,fromList
10− ) where
1+module Dict
2+ ( Dict
3+ , empty, singleton, insert, update
4+ , get, getOrElse, getOrFail
5+ , remove, member
6+ , filter
7+ , partition
8+ , foldl, foldr, map
9+ , union, intersect, diff
10+ , keys, values
11+ , toList, fromList
12+ ) where
1113
1214{-| A dictionary mapping unique keys to values. The keys can be any comparable
1315type. This includes `Int`, `Float`, `Time`, `Char`, `String`, and tuples or
@@ -40,34 +42,39 @@ import List
4042import List ((::))
4143import Native.Utils
4244
45+type Fakeout = (Int, Int)
46+
47+type Another = (Int, Int)
48+
4349-- BBlack and NBlack should only be used during the deletion
4450-- algorithm. Any other occurrence is a bug and should fail an assert.
45−data NColor = Red
46− | Black
47− -- ^ Double Black, counts as 2 blacks for the invariant
48− | BBlack
49− -- ^ Negative Black, counts as -1 blacks for the invariant
50− | NBlack
51+data NColor
52+ = Red
53+ | Black
54+ | BBlack -- Double Black, counts as 2 blacks for the invariant
55+ | NBlack -- Negative Black, counts as -1 blacks for the invariant
5156
5257
5358showNColor : NColor -> String
54−showNColor c = case c of
55− Red -> "Red"
56− Black -> "Black"
57− BBlack -> "BBlack"
58− NBlack -> "NBlack"
59+showNColor c =
60+ case c of
61+ Red -> "Red"
62+ Black -> "Black"
63+ BBlack -> "BBlack"
64+ NBlack -> "NBlack"
5965
60−data LeafColor = LBlack
61− -- ^ Double Black, counts as 2
62− | LBBlack
66+data LeafColor
67+ = LBlack
68+ | LBBlack -- Double Black, counts as 2
6369
6470showLColor : LeafColor -> String
6571showLColor c = case c of
6672 LBlack -> "LBlack"
6773 LBBlack -> "LBBlack"
6874
69−data Dict k v = RBNode NColor k v (Dict k v) (Dict k v)
70− | RBEmpty LeafColor
75+data Dict k v
76+ = RBNode NColor k v (Dict k v) (Dict k v)
77+ | RBEmpty LeafColor
7178
7279{-| Create an empty dictionary. -}
7380empty : Dict comparable v
libraries/Set.elm+9−7
@@ -1,11 +1,13 @@
11
2−module Set (empty,singleton,insert,remove
3− ,member
4− ,foldl,foldr,map
5− ,filter,partition
6− ,union,intersect,diff
7− ,toList,fromList
8− ) where
2+module Set
3+ ( Set
4+ , empty, singleton, insert, remove
5+ , member
6+ , foldl, foldr, map
7+ , filter, partition
8+ , union, intersect, diff
9+ , toList, fromList
10+ ) where
911
1012{-| A set of unique values. The values can be any comparable type. This
1113includes `Int`, `Float`, `Time`, `Char`, `String`, and tuples or lists