@@ -1,5 +1,5 @@
11{-# OPTIONS_GHC -W #-}
2−module Transform.Canonicalize (module', filterExports) where
2+module Transform.Canonicalize (module') where
33
44import Control.Applicative ((<$>),(<*>))
55import Control.Monad.Error (runErrorT, throwError)
@@ -106,53 +106,6 @@ delist fullList (Var.Listing partial open)
106106
107107 _ -> go list xs partial
108108
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− }
119− where
120− get :: Map.Map String a -> String -> [(String, a)]
121− get dict x =
122− case Map.lookup x dict of
123− Just t -> [(x,t)]
124− Nothing -> []
125−
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−
156109
157110declToValue :: D.ValidDecl -> [Var.Value]
158111declToValue decl =