Permalink
Browse files

Simple implementation of export lists.

  • Loading branch information...
marcotmarcot committed Oct 9, 2012
1 parent e635fca commit 3bb0a0dd1e87315b2a5eac4e4f4be3e74714dc63
Showing with 49 additions and 8 deletions.
  1. +19 −1 src/Main.hs
  2. +4 −1 src/Tc/Assumption.hs
  3. +3 −0 src/Tc/Class.hs
  4. +2 −6 src/Tc/TySyn.hs
  5. +21 −0 src/Utils/Id.hs
View
@@ -22,6 +22,7 @@ import Utils.Env
import Utils.ExpandTySyn
import Utils.RecompilationChecker
import Utils.FileNameUtils
+import Utils.Id
main :: IO()
main = do
@@ -79,14 +80,31 @@ continueCompilation dir' m args ifaces
opts = filter (flip notElem [Make, Help]) args
miface <- tcDriver syns' lbls kenv cls ins assums m'
-- writing module interface and printing final inference results
- writeIface dir' m' ifaces miface
+ writeIface dir' m' ifaces $ filterEl m miface
let result = foldr f miface ([KindInfo .. AssumpInfo] \\ opts)
f KindInfo ac = ac{kinds = K.emptyEnv}
f ClassInfo ac = ac{classes = []}
f InstInfo ac = ac{instances = []}
f AssumpInfo ac = ac{assumps = []}
print result
+filterEl :: Module -> Iface -> Iface
+filterEl (Module _ _ _ _ Nothing _ _) i = i
+filterEl
+ (Module _ _ _ _ (Just exps) _ _)
+ i@(Iface {synonyms = s, classes = c, assumps = a})
+ = i
+ {synonyms = doFilterEl exps s,
+ classes = doFilterEl exps c,
+ assumps = doFilterEl exps a}
+
+doFilterEl :: ToId a => [ExportSpec] -> [a] -> [a]
+doFilterEl exps = filter ((`elem` map esToName exps) . idToName . toId)
+
+esToName :: ExportSpec -> Name
+esToName (EVar q) = qNameToName q
+esToName (EAbs q) = qNameToName q
+
-- Loading interfaces using import declarations.
-- if multi-module compilation is turned on,
-- this function does the job.
View
@@ -14,4 +14,7 @@ data Assumption = Id :>: Type
instance Show Assumption where
show (i :>: ty) = show i ++ " :: " ++ prettyPrint ty
-toScheme n ctx t = toId n :>: (TyForall Nothing ctx t)
+toScheme n ctx t = toId n :>: (TyForall Nothing ctx t)
+
+instance ToId Assumption where
+ toId (i :>: _) = i
View
@@ -17,6 +17,9 @@ data Class = Class {
members :: [Assumption],
instances :: [Inst]
} deriving (Eq, Ord)
+
+instance ToId Class where
+ toId = name
data Inst = Inst {
instname :: Id,
View
@@ -9,14 +9,10 @@ module Tc.TySyn where
-- and to write / read interface files
import Language.Haskell.Exts
-
+import Utils.Id
type TySyn = (Type, Type) -- first component: left hand side of type synonym
-- second component: right hand side.
tySynName :: TySyn -> QName
-tySynName (t,_)
- = goLeft t
- where
- goLeft (TyApp l _) = goLeft l
- goLeft (TyCon qn) = qn
+tySynName (t,_) = goLeft t
View
@@ -1,10 +1,13 @@
{-#LANGUAGE DeriveDataTypeable#-}
module Utils.Id ( Id,
+ qNameToName,
+ idToName,
ToId(..),
Unqualify(..),
isqual,
isunqual,
+ goLeft,
unid
) where
@@ -23,6 +26,14 @@ data Id = IdName Name
| IdSpecial SpecialCon
deriving (Data, Typeable)
+qNameToName :: QName -> Name
+qNameToName (Qual _ n) = n
+qNameToName (UnQual n) = n
+
+idToName :: Id -> Name
+idToName (IdName n) = n
+idToName (IdQName q) = qNameToName q
+
-- a type class to convert such thing to Id's
class ToId n where
@@ -53,6 +64,16 @@ instance ToId TyVarBind where
toId (UnkindedVar n) = toId n
toId x = unsupportedDeclMsg x
+goLeft :: Type -> QName
+goLeft (TyApp l _) = goLeft l
+goLeft (TyCon qn) = qn
+
+instance ToId Type where
+ toId = toId . goLeft
+
+instance ToId a => ToId (a, b) where
+ toId = toId . fst
+
unid (IdName n) = UnQual n
unid (IdQName n) = n
unid (IdSpecial n) = Special n

0 comments on commit 3bb0a0d

Please sign in to comment.