-- Building interface info from data collected during compilation of a module ---------------------------------
{-
Input to ifaceMod is
      - from Desugar1: exported record types with their selectors and exported type synomyms.
      - from Termred: the entire module in Core form after term reduction
      - from Core2Kindle: declarations in Kindle form.
The function checks that the public part is closed (does not mention private data) and computes
the IFace.
-}
 
ifaceMod                   :: (Map Name [Name], Map Name ([Name], Syntax.Type)) -> Module -> Kindle.Decls -> IFace
ifaceMod (rs,ss) (Module _ ns xs ds ws bss) kds
   | not(null vis2)                  = errorIds "Private types visible in interface" vis2
   | not(null ys)                    = errorTree "Public default declaration mentions private instance" (head ys)
   | otherwise                       = IFace ns xs' rs ss ds1 ws bs' kds
  where Types ke te                  = ds
        Binds r2 ts2 es2             = concatBinds bss
        xs'                          = [d | d@(Default True _ _) <- xs]
        ys                           = [d | d@(Default _ i1 i2) <- xs', isPrivate i1 || isPrivate i2 ]
        ds1                          = Types (filter exported ke ++ map (\n -> (n,Star)) vis1) (filter exported' te)
        bs'                          = Binds r2 (filter exported ts2) (filter (\ eqn -> fin eqn &&  exported eqn) (erase es2))
        (vis1,vis2)                  = partition isStateType (nub (localTypes [] (rng (tsigsOf bs'))))
        
        exported (n,_)               = isQualified n
        exported' p@(n,_)            = isQualified n && (not(isAbstract p)) --Constructors/selectors are exported
        fin (_,e)                    = isFinite e && null(filter isPrivate (constrs e))
ifaceMod                   :: (Map Name [Name], Map Name ([Name], Syntax.Type)) -> Module -> Kindle.Decls -> IFace
ifaceMod (rs,ss) (Module _ ns xs ds ws bss) kds
   | not(null vis2)                  = errorIds "Private types visible in interface" vis2
   | not(null ys)                    = errorTree "Public default declaration mentions private instance" (head ys)
   | otherwise                       = IFace ns xs' rs ss ds1 ws bs' kds
  where Types ke te                  = ds
        Binds r2 ts2 es2             = concatBinds bss
        xs'                          = [d | d@(Default True _ _) <- xs]
        ys                           = [d | d@(Default _ i1 i2) <- xs', isPrivate i1 || isPrivate i2 ]
        ds1                          = Types (filter exported ke ++ map (\n -> (n,Star)) vis1) (filter exported' te)
        bs'                          = Binds r2 (filter exported ts2) (filter (\ eqn -> fin eqn &&  exported eqn) (erase es2))
        (vis1,vis2)                  = partition isStateType (nub (localTypes [] (rng (tsigsOf bs'))))
        
        exported (n,_)               = isQualified n
        exported' p@(n,_)            = isQualified n && (not(isAbstract p)) --Constructors/selectors are exported
        fin (_,e)                    = isFinite e && null(filter isPrivate (constrs e))
ifaceMod (rs,ss) (Module _ ns xs ds ws bss) kds
   | not(null vis2)                  = errorIds "Private types visible in interface" vis2
   | not(null ys)                    = errorTree "Public default declaration mentions private instance" (head ys)
   | otherwise                       = IFace ns xs' rs ss ds1 ws bs' kds
  where Types ke te                  = ds
        Binds r2 ts2 es2             = concatBinds bss
        xs'                          = [d | d@(Default True _ _) <- xs]
        ys                           = [d | d@(Default _ i1 i2) <- xs', isPrivate i1 || isPrivate i2 ]
        ds1                          = Types (filter exported ke ++ map (\n -> (n,Star)) vis1) (filter exported' te)
        bs'                          = Binds r2 (filter exported ts2) (filter (\ eqn -> fin eqn &&  exported eqn) (erase es2))
        (vis1,vis2)                  = partition isStateType (nub (localTypes [] (rng (tsigsOf bs'))))
        
        exported (n,_)               = isQualified n
        exported' p@(n,_)            = isQualified n && (not(isAbstract p)) --Constructors/selectors are exported
        fin (_,e)                    = isFinite e && null(filter isPrivate (constrs e))