git.iko.soy/elk
on master help sign in
Make Transform.Interface a bit easier to read
a1aa92aEvan Czaplicki
src/AST/Variable.hs+42
compare with master
unifiedsplit
@@ -3,6 +3,7 @@ module AST.Variable where
3import Control.Applicative ((<$>), (<*>))
3import Control.Applicative ((<$>), (<*>))
4import Data.Binary
4import Data.Binary
5import qualified Data.List as List
5import qualified Data.List as List
6+import qualified Data.Maybe as Maybe
6import Text.PrettyPrint as P
7import Text.PrettyPrint as P
7import qualified AST.Helpers as Help
8import qualified AST.Helpers as Help
8import AST.PrettyPrint
9import AST.PrettyPrint
@@ -133,6 +134,47 @@ data Value
133 deriving (Eq,Ord,Show)
134 deriving (Eq,Ord,Show)
134
135
135
136
137+-- CATEGORIZING VALUES
138+
139+getValues :: [Value] -> [String]
140+getValues values =
141+ Maybe.mapMaybe getValue values
142+
143+
144+getValue :: Value -> Maybe String
145+getValue value =
146+ case value of
147+ Value name -> Just name
148+ Alias _ -> Nothing
149+ Union _ _ -> Nothing
150+
151+
152+getAliases :: [Value] -> [String]
153+getAliases values =
154+ Maybe.mapMaybe getAlias values
155+
156+
157+getAlias :: Value -> Maybe String
158+getAlias value =
159+ case value of
160+ Value _-> Nothing
161+ Alias name -> Just name
162+ Union _ _ -> Nothing
163+
164+
165+getUnions :: [Value] -> [(String, Listing String)]
166+getUnions values =
167+ Maybe.mapMaybe getUnion values
168+
169+
170+getUnion :: Value -> Maybe (String, Listing String)
171+getUnion value =
172+ case value of
173+ Value _ -> Nothing
174+ Alias _ -> Nothing
175+ Union name ctors -> Just (name, ctors)
176+
177+
136-- PRETTY VARIABLES
178-- PRETTY VARIABLES
137
179
138instance Pretty Raw where
180instance Pretty Raw where
src/Transform/Interface.hs+46−43
@@ -1,57 +1,60 @@
1module Transform.Interface (filterExports) where
1module Transform.Interface (filterExports) where
2
2
3import qualified Data.Map as Map
3import qualified Data.Map as Map
4+import qualified Data.Maybe as Maybe
4import qualified AST.Module as Module
5import qualified AST.Module as Module
5−import qualified AST.Type as Type
6import qualified AST.Variable as Var
6import qualified AST.Variable as Var
7
7
8+
8filterExports :: Module.Interface -> Module.Interface
9filterExports :: Module.Interface -> Module.Interface
9filterExports interface =
10filterExports interface =
10 interface
11 interface
11 { Module.iTypes =
12 { Module.iTypes =
12− Map.fromList (concatMap getTypes exportedValues)
13+ Map.fromList $
14+ Maybe.mapMaybe
15+ (get (Module.iTypes interface))
16+ (Var.getValues exports ++ ctors)
17+
13 , Module.iAliases =
18 , Module.iAliases =
14− Map.fromList (concatMap getAliases exportedValues)
19+ Map.fromList $
20+ Maybe.mapMaybe
21+ (get (Module.iAliases interface))
22+ (Var.getAliases exports)
23+
15 , Module.iAdts =
24 , Module.iAdts =
16− Map.fromList (concatMap getAdts exportedValues)
25+ Map.fromList
26+ (Maybe.mapMaybe (trimUnions interface) unions)
17 }
27 }
18 where
28 where
19− exportedValues :: [Var.Value]
29+ exports :: [Var.Value]
30+ exports =
20− exportedValues = Module.iExports interface
31+ Module.iExports interface
21−
32+
22− get :: Map.Map String a -> String -> [(String, a)]
33+ unions :: [(String, Var.Listing String)]
23− get dict x =
34+ unions =
24− case Map.lookup x dict of
35+ Var.getUnions exports
25− Just t -> [(x,t)]
36+
26− Nothing -> []
37+ ctors :: [String]
27−
38+ ctors =
28− getTypes :: Var.Value -> [(String, Type.CanonicalType)]
39+ concatMap (\(_, Var.Listing ctorList _) -> ctorList) unions
29− getTypes value =
40+
30− case value of
41+
31− Var.Value x -> getType x
42+get :: Map.Map String a -> String -> Maybe (String, a)
32− Var.Alias _ -> []
43+get dict key =
33− Var.Union _ (Var.Listing ctors _) -> concatMap getType ctors
44+ case Map.lookup key dict of
34−
45+ Nothing -> Nothing
35− getType :: String -> [(String, Type.CanonicalType)]
46+ Just value -> Just (key, value)
36− getType name =
47+
37− get (Module.iTypes interface) name
48+
38−
49+trimUnions
39− getAliases :: Var.Value -> [(String, ([String], Type.CanonicalType))]
50+ :: Module.Interface
40− getAliases value =
51+ -> (String, Var.Listing String)
41− case value of
42− Var.Value _ -> []
43− Var.Alias name -> get (Module.iAliases interface) name
44− Var.Union _ _ -> []
45−
46− getAdts :: Var.Value -> [(String, Module.AdtInfo String)]
52+ -> Maybe (String, Module.AdtInfo String)
47− getAdts value =
48− case value of
49− Var.Value _ -> []
50− Var.Alias _ -> []
51− Var.Union name (Var.Listing exportedCtors _) ->
53+trimUnions interface (name, Var.Listing exportedCtors _) =
52− case Map.lookup name (Module.iAdts interface) of
54+ case Map.lookup name (Module.iAdts interface) of
53− Nothing -> []
55+ Nothing -> Nothing
54− Just (tvars, ctors) ->
56+ Just (tvars, ctors) ->
57+ let isExported (ctor, _) =
58+ ctor `elem` exportedCtors
59+ in
55− [(name, (tvars, filter isExported ctors))]
60+ Just (name, (tvars, filter isExported ctors))
56− where
57− isExported (ctor, _) = ctor `elem` exportedCtors