{- |

This module deals with imports of nested modules (@import submodule@).
This is more complex than it might seem at first because to resolve a
declaration like @import submodule X@ we need to resolve what @X@
referes to before we know what it will import.

Even triciker is the case for functor instantiations:

  module M = F { X }
  import M

In this case, even if we know what `M` referes to, we first need to
resolve `F`, so that we can generate the instantiation and generate
fresh names for names defined by `M`.

If we want to support applicative semantics, then before instantiation
`M` we also need to resolve `X` so that we know if this instantiation has
already been generated.

An overall guiding principle of the design is that we assume that declarations
can be ordered in dependency order, and submodules can be processed one
at a time. In particular, this does not allow recursion across modules,
or functor instantiations depending on their arguments.

Thus, the following is OK:

module A where
  x = 0x2

  submodule B where
    y = x

  z = B::y


However, this is not OK:

  submodule A = F X
  submodule F where
    import A
-}

{-# Language BlockArguments #-}
{-# Language TypeSynonymInstances, FlexibleInstances #-}
module Cryptol.ModuleSystem.Renamer.Imports
  ( resolveImports
  , ResolvedModule(..)
  , ModKind(..)
  , ResolvedLocal
  , ResolvedExt
  )
  where

import Data.Maybe(fromMaybe)
import Data.Set(Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.List(foldl')
import Control.Monad(when)
import qualified MonadLib as M

import Cryptol.Utils.PP(pp)
import Cryptol.Utils.Panic(panic)
import Cryptol.Utils.Ident(ModName,ModPath(..),Namespace(..),OrigName(..))

import Cryptol.Parser.AST
  ( ImportG(..),PName, ModuleInstanceArgs(..), ImpName(..) )
import Cryptol.ModuleSystem.Binds (Mod(..), TopDef(..), modNested, ModKind(..))
import Cryptol.ModuleSystem.Name
          ( Name, Supply, SupplyT, runSupplyT, liftSupply, freshNameFor
          , asOrigName, nameIdent, nameTopModule )
import Cryptol.ModuleSystem.Names(Names(..))
import Cryptol.ModuleSystem.NamingEnv
          ( NamingEnv(..), lookupNS, shadowing, travNamingEnv
          , interpImportEnv, zipByTextName, filterUNames )


{- | This represents a resolved module or signaure.
The type parameter helps us distinguish between two types of resolved modules:

  1. Resolved modules that are *inputs* to the algorithm (i.e., they are
     defined outside the current module).  For such modules the type
     parameter is @imps@ is ()

  2. Resolved modules that are *outputs* of the algorithm (i.e., they
     are defined within the current module).  For such modules the type
     parameter @imps@ contains the naming environment for things
     that came in through the import.

Note that signaures are never "imported", however we do need to keep them
here so that signatures in a functor are properly instantiated when
the functor is instantiated.
-}
data ResolvedModule imps = ResolvedModule
  { forall imps. ResolvedModule imps -> NamingEnv
rmodDefines   :: NamingEnv    -- ^ Things defined by the module/signature.
  , forall imps. ResolvedModule imps -> Set Name
rmodPublic    :: !(Set Name)  -- ^ Exported names
  , forall imps. ResolvedModule imps -> ModKind
rmodKind      :: ModKind      -- ^ What sort of thing are we
  , forall imps. ResolvedModule imps -> Set Name
rmodNested    :: Set Name     -- ^ Modules and signatures nested in this one
  , forall imps. ResolvedModule imps -> imps
rmodImports   :: imps
    {- ^ Resolved imports. External modules need not specify this field,
    it is just part of the thing we compute for local modules. -}
  }


-- | A resolved module that's defined in (or is) the current top-level module
type ResolvedLocal = ResolvedModule NamingEnv

-- | A resolved module that's not defined in the current top-level module
type ResolvedExt   = ResolvedModule ()


resolveImports ::
  (ImpName Name -> Mod ()) ->
  TopDef ->
  Supply ->
  (Map (ImpName Name) ResolvedLocal, Supply)
resolveImports :: (ImpName Name -> Mod ())
-> TopDef -> Supply -> (Map (ImpName Name) ResolvedLocal, Supply)
resolveImports ImpName Name -> Mod ()
ext TopDef
def Supply
su =
  case TopDef
def of

    TopMod ModName
m Mod ()
mo ->
      do let cur :: Todo
cur  = Mod () -> Todo
todoModule Mod ()
mo
             newS :: CurState
newS = CurState -> CurState
doModuleStep CurState
                                   { curMod :: Todo
curMod = Todo
cur
                                   , curTop :: ModName
curTop = ModName
m
                                   , externalModules :: ImpName Name -> Mod ()
externalModules = ImpName Name -> Mod ()
ext
                                   , doneModules :: Map Name ResolvedLocal
doneModules = forall a. Monoid a => a
mempty
                                   , nameSupply :: Supply
nameSupply = Supply
su
                                   , changes :: Bool
changes = Bool
False
                                   }


         case Todo -> CurState -> Maybe ResolvedLocal
tryFinishCurMod Todo
cur CurState
newS of
           Just ResolvedLocal
r  -> forall {a}.
ModName
-> ResolvedLocal
-> CurState' a
-> (Map (ImpName Name) ResolvedLocal, Supply)
add ModName
m ResolvedLocal
r CurState
newS
           Maybe ResolvedLocal
Nothing -> forall {a}.
ModName
-> ResolvedLocal
-> CurState' a
-> (Map (ImpName Name) ResolvedLocal, Supply)
add ModName
m ResolvedLocal
r CurState
s1
              where (ResolvedLocal
r,CurState
s1) = CurState -> (ResolvedLocal, CurState)
forceFinish CurState
newS

    TopInst ModName
m ImpName PName
f ModuleInstanceArgs PName
as ->
      do let s :: CurState' ()
s = CurState
                   { curMod :: ()
curMod = ()
                   , curTop :: ModName
curTop = ModName
m
                   , externalModules :: ImpName Name -> Mod ()
externalModules = ImpName Name -> Mod ()
ext
                   , doneModules :: Map Name ResolvedLocal
doneModules = forall a. Monoid a => a
mempty
                   , nameSupply :: Supply
nameSupply = Supply
su
                   , changes :: Bool
changes = Bool
False
                   }

         case forall a.
HasCurScope a =>
CurState' a
-> ImpName Name
-> (ImpName PName, ModuleInstanceArgs PName)
-> Maybe (ResolvedLocal, CurState' a)
tryInstanceMaybe CurState' ()
s (forall name. ModName -> ImpName name
ImpTop ModName
m) (ImpName PName
f,ModuleInstanceArgs PName
as) of
           Just (ResolvedLocal
r,CurState' ()
newS) -> forall {a}.
ModName
-> ResolvedLocal
-> CurState' a
-> (Map (ImpName Name) ResolvedLocal, Supply)
add ModName
m ResolvedLocal
r CurState' ()
newS
           Maybe (ResolvedLocal, CurState' ())
Nothing -> (forall k a. k -> a -> Map k a
Map.singleton (forall name. ModName -> ImpName name
ImpTop ModName
m) ResolvedLocal
forceResolveInst, Supply
su)

  where
  toNest :: Map name a -> Map (ImpName name) a
toNest Map name a
m = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (forall name. name -> ImpName name
ImpNested name
k, a
v) | (name
k,a
v) <- forall k a. Map k a -> [(k, a)]
Map.toList Map name a
m ]
  add :: ModName
-> ResolvedLocal
-> CurState' a
-> (Map (ImpName Name) ResolvedLocal, Supply)
add ModName
m ResolvedLocal
r CurState' a
s  = ( forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall name. ModName -> ImpName name
ImpTop ModName
m) ResolvedLocal
r (forall {name} {a}. Ord name => Map name a -> Map (ImpName name) a
toNest (forall a. CurState' a -> Map Name ResolvedLocal
doneModules CurState' a
s))
               , forall a. CurState' a -> Supply
nameSupply CurState' a
s
               )




--------------------------------------------------------------------------------


-- | This keeps track of the current state of resolution of a module.
type Todo = Mod ModState

data ModState = ModState
  { ModState -> NamingEnv
modOuter        :: NamingEnv
    -- ^ Things which come in scope from outer modules

  , ModState -> NamingEnv
modImported     :: NamingEnv
    -- ^ Things which come in scope via imports.  These shadow outer names.
  }


-- | Initial state of a module that needs processing.
todoModule :: Mod () -> Todo
todoModule :: Mod () -> Todo
todoModule = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ModState
emptyModState)
  where
  emptyModState :: ModState
emptyModState =
    ModState
      { modOuter :: NamingEnv
modOuter    = forall a. Monoid a => a
mempty
      , modImported :: NamingEnv
modImported = forall a. Monoid a => a
mempty
      }

{- | A module is fully processed when we are done with all its:

  * submodule imports
  * instantiations
  * nested things (signatures and modules)
-}
isDone :: Todo -> Bool
isDone :: Todo -> Bool
isDone Todo
m = forall (t :: * -> *) a. Foldable t => t a -> Bool
null     (forall a. Mod a -> [ImportG (ImpName PName)]
modImports Todo
m)   Bool -> Bool -> Bool
&&
           forall k a. Map k a -> Bool
Map.null (forall a.
Mod a -> Map Name (ImpName PName, ModuleInstanceArgs PName)
modInstances Todo
m) Bool -> Bool -> Bool
&&
           forall k a. Map k a -> Bool
Map.null (forall a. Mod a -> Map Name (Mod a)
modMods Todo
m)


-- | Finish up all unfinished modules as best as we can
forceFinish :: CurState -> (ResolvedLocal,CurState)
forceFinish :: CurState -> (ResolvedLocal, CurState)
forceFinish CurState
s0 =
  let this :: Todo
this  = forall a. CurState' a -> a
curMod CurState
s0
      add :: Name -> ResolvedLocal -> CurState' a -> CurState' a
add Name
k ResolvedLocal
v CurState' a
s = CurState' a
s { doneModules :: Map Name ResolvedLocal
doneModules = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
k ResolvedLocal
v (forall a. CurState' a -> Map Name ResolvedLocal
doneModules CurState' a
s) }
      s1 :: CurState
s1        = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\CurState
s Name
k -> forall {a}. Name -> ResolvedLocal -> CurState' a -> CurState' a
add Name
k ResolvedLocal
forceResolveInst CurState
s) CurState
s0
                         (forall k a. Map k a -> [k]
Map.keys (forall a.
Mod a -> Map Name (ImpName PName, ModuleInstanceArgs PName)
modInstances Todo
this))

      doNestMod :: CurState' a -> (Name, Todo) -> CurState
doNestMod CurState' a
s (Name
k,Todo
m) =
        let (ResolvedLocal
r,CurState
s') = CurState -> (ResolvedLocal, CurState)
forceFinish CurState' a
s { curMod :: Todo
curMod = Todo
m }
        in forall {a}. Name -> ResolvedLocal -> CurState' a -> CurState' a
add Name
k ResolvedLocal
r CurState
s'

  in ( Todo -> ResolvedLocal
forceResolveMod Todo
this
     , forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}. CurState' a -> (Name, Todo) -> CurState
doNestMod CurState
s1 (forall k a. Map k a -> [(k, a)]
Map.toList (forall a. Mod a -> Map Name (Mod a)
modMods Todo
this))
     )


-- | A place-holder entry for instnatitations we couldn't resolve.
forceResolveInst :: ResolvedLocal
forceResolveInst :: ResolvedLocal
forceResolveInst =
  ResolvedModule
    { rmodDefines :: NamingEnv
rmodDefines = forall a. Monoid a => a
mempty
    , rmodPublic :: Set Name
rmodPublic  = forall a. Monoid a => a
mempty
    , rmodKind :: ModKind
rmodKind    = ModKind
AModule
    , rmodNested :: Set Name
rmodNested  = forall a. Set a
Set.empty
    , rmodImports :: NamingEnv
rmodImports = forall a. Monoid a => a
mempty
    }

-- | Finish up unresolved modules as well as we can, in situations where
-- the program contains an error.
forceResolveMod :: Todo -> ResolvedLocal
forceResolveMod :: Todo -> ResolvedLocal
forceResolveMod Todo
todo =
  ResolvedModule
    { rmodDefines :: NamingEnv
rmodDefines   = forall a. Mod a -> NamingEnv
modDefines Todo
todo
    , rmodPublic :: Set Name
rmodPublic    = forall a. Mod a -> Set Name
modPublic Todo
todo
    , rmodKind :: ModKind
rmodKind      = forall a. Mod a -> ModKind
modKind Todo
todo
    , rmodNested :: Set Name
rmodNested    = forall k a. Map k a -> Set k
Map.keysSet (forall a. Mod a -> Map Name (Mod a)
modMods Todo
todo)
    , rmodImports :: NamingEnv
rmodImports   = ModState -> NamingEnv
modImported (forall a. Mod a -> a
modState Todo
todo)
    }





pushImport :: ImportG (ImpName PName) -> Todo -> Todo
pushImport :: ImportG (ImpName PName) -> Todo -> Todo
pushImport ImportG (ImpName PName)
i Todo
m = Todo
m { modImports :: [ImportG (ImpName PName)]
modImports = ImportG (ImpName PName)
i forall a. a -> [a] -> [a]
: forall a. Mod a -> [ImportG (ImpName PName)]
modImports Todo
m }

pushInst :: Name -> (ImpName PName, ModuleInstanceArgs PName) -> Todo -> Todo
pushInst :: Name -> (ImpName PName, ModuleInstanceArgs PName) -> Todo -> Todo
pushInst Name
k (ImpName PName, ModuleInstanceArgs PName)
v Todo
m = Todo
m { modInstances :: Map Name (ImpName PName, ModuleInstanceArgs PName)
modInstances = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
k (ImpName PName, ModuleInstanceArgs PName)
v (forall a.
Mod a -> Map Name (ImpName PName, ModuleInstanceArgs PName)
modInstances Todo
m) }

pushMod :: Name -> Todo -> Todo -> Todo
pushMod :: Name -> Todo -> Todo -> Todo
pushMod Name
k Todo
v Todo
m = Todo
m { modMods :: Map Name Todo
modMods = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
k Todo
v (forall a. Mod a -> Map Name (Mod a)
modMods Todo
m) }

updMS :: (ModState -> ModState) -> Todo -> Todo
updMS :: (ModState -> ModState) -> Todo -> Todo
updMS ModState -> ModState
f Todo
m = Todo
m { modState :: ModState
modState = ModState -> ModState
f (forall a. Mod a -> a
modState Todo
m) }
--------------------------------------------------------------------------------



externalMod :: Mod () -> ResolvedExt
externalMod :: Mod () -> ResolvedExt
externalMod Mod ()
m = ResolvedModule
  { rmodDefines :: NamingEnv
rmodDefines  = forall a. Mod a -> NamingEnv
modDefines Mod ()
m
  , rmodPublic :: Set Name
rmodPublic   = forall a. Mod a -> Set Name
modPublic Mod ()
m
  , rmodKind :: ModKind
rmodKind     = forall a. Mod a -> ModKind
modKind Mod ()
m
  , rmodNested :: Set Name
rmodNested   = forall a. Mod a -> Set Name
modNested Mod ()
m
  , rmodImports :: ()
rmodImports  = ()
  }

{- | This is used when we need to use a local resolved module as an input
     to another module. -}
forget :: ResolvedLocal -> ResolvedExt
forget :: ResolvedLocal -> ResolvedExt
forget ResolvedLocal
r = ResolvedLocal
r { rmodImports :: ()
rmodImports = () }

type CurState = CurState' Todo

data CurState' a = CurState
  { forall a. CurState' a -> a
curMod      :: a
    -- ^ This is what needs to be done

  , forall a. CurState' a -> ModName
curTop      :: !ModName
    {- ^ The top-level module we are working on.  This does not change
       throught the algorithm, it is just convenient to pass it here with 
       all the other stuff. -}

  , forall a. CurState' a -> ImpName Name -> Mod ()
externalModules :: ImpName Name -> Mod ()
    -- ^ Modules defined outside the current top-level modules

  , forall a. CurState' a -> Map Name ResolvedLocal
doneModules :: Map Name ResolvedLocal
    {- ^ Nested modules/signatures in the current top-level modules.
         These may be either defined locally, or be the result of
         instantiating a functor.  Note that the functor itself may be
         either local or external.
    -}

  , forall a. CurState' a -> Supply
nameSupply :: Supply
    -- ^ Use this to instantiate functors

  , forall a. CurState' a -> Bool
changes :: Bool
    -- ^ True if something changed on the last iteration
  }

updCur :: CurState -> (Todo -> Todo) -> CurState
updCur :: CurState -> (Todo -> Todo) -> CurState
updCur CurState
m Todo -> Todo
f = CurState
m { curMod :: Todo
curMod = Todo -> Todo
f (forall a. CurState' a -> a
curMod CurState
m) }

updCurMS :: CurState -> (ModState -> ModState) -> CurState
updCurMS :: CurState -> (ModState -> ModState) -> CurState
updCurMS CurState
s ModState -> ModState
f = CurState -> (Todo -> Todo) -> CurState
updCur CurState
s ((ModState -> ModState) -> Todo -> Todo
updMS ModState -> ModState
f)

class HasCurScope a where
  curScope :: CurState' a -> NamingEnv

instance HasCurScope () where
  curScope :: CurState' () -> NamingEnv
curScope CurState' ()
_ = forall a. Monoid a => a
mempty

instance HasCurScope Todo where
  curScope :: CurState -> NamingEnv
curScope CurState
s = forall a. Mod a -> NamingEnv
modDefines Todo
m NamingEnv -> NamingEnv -> NamingEnv
`shadowing` ModState -> NamingEnv
modImported ModState
ms NamingEnv -> NamingEnv -> NamingEnv
`shadowing` ModState -> NamingEnv
modOuter ModState
ms
    where
    m :: Todo
m   = forall a. CurState' a -> a
curMod CurState
s
    ms :: ModState
ms  = forall a. Mod a -> a
modState Todo
m


-- | Keep applying a transformation while things are changing
doStep :: (CurState -> CurState) -> (CurState -> CurState)
doStep :: (CurState -> CurState) -> CurState -> CurState
doStep CurState -> CurState
f CurState
s0 = Bool -> CurState -> CurState
go (forall a. CurState' a -> Bool
changes CurState
s0) CurState
s0
  where
  go :: Bool -> CurState -> CurState
go Bool
ch CurState
s = let s1 :: CurState
s1 = CurState -> CurState
f CurState
s { changes :: Bool
changes = Bool
False }
            in if forall a. CurState' a -> Bool
changes CurState
s1
                then Bool -> CurState -> CurState
go Bool
True CurState
s1
                else CurState
s { changes :: Bool
changes = Bool
ch }

-- | Is this a known name for a module in the current scope?
knownPName :: HasCurScope a => CurState' a -> PName -> Maybe Name
knownPName :: forall a. HasCurScope a => CurState' a -> PName -> Maybe Name
knownPName CurState' a
s PName
x =
  do Names
ns <- Namespace -> PName -> NamingEnv -> Maybe Names
lookupNS Namespace
NSModule PName
x (forall a. HasCurScope a => CurState' a -> NamingEnv
curScope CurState' a
s)
     case Names
ns of
       One Name
n    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
n
       {- NOTE: since we build up what's in scope incrementally,
          it is possible that this would eventually be ambiguous,
          which we'll detect during actual renaming. -}

       Ambig {} -> forall a. Maybe a
Nothing
       {- We treat ambiguous imports as undefined, which may lead to
          spurious "undefined X" errors.  To avoid this we should prioritize
          reporting "ambiguous X" errors. -}

-- | Is the module mentioned in this import known in the current scope?
knownImpName ::
  HasCurScope a => CurState' a -> ImpName PName -> Maybe (ImpName Name)
knownImpName :: forall a.
HasCurScope a =>
CurState' a -> ImpName PName -> Maybe (ImpName Name)
knownImpName CurState' a
s ImpName PName
i =
  case ImpName PName
i of
    ImpTop ModName
m    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall name. ModName -> ImpName name
ImpTop ModName
m)
    ImpNested PName
m -> forall name. name -> ImpName name
ImpNested forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCurScope a => CurState' a -> PName -> Maybe Name
knownPName CurState' a
s PName
m

-- | Is the module mentioned in the import already resolved?
knownModule ::
  HasCurScope a => CurState' a -> ImpName Name -> Maybe ResolvedExt
knownModule :: forall a.
HasCurScope a =>
CurState' a -> ImpName Name -> Maybe ResolvedExt
knownModule CurState' a
s ImpName Name
x
  | ModName
root forall a. Eq a => a -> a -> Bool
== forall a. CurState' a -> ModName
curTop CurState' a
s =
    case ImpName Name
x of
      ImpNested Name
y -> ResolvedLocal -> ResolvedExt
forget forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
y (forall a. CurState' a -> Map Name ResolvedLocal
doneModules CurState' a
s)
      ImpTop {}   -> forall a. Maybe a
Nothing   -- or panic? recursive import

  | Bool
otherwise = forall a. a -> Maybe a
Just (Mod () -> ResolvedExt
externalMod (forall a. CurState' a -> ImpName Name -> Mod ()
externalModules CurState' a
s ImpName Name
x))

  where
  root :: ModName
root = case ImpName Name
x of
           ImpTop ModName
r    -> ModName
r
           ImpNested Name
n -> Name -> ModName
nameTopModule Name
n

--------------------------------------------------------------------------------


{- | Try to resolve an import. If the imported module can be resolved,
and it refers to a module that's already been resolved, then we do the
import and extend the current scoping environment.  Otherwise, we just
queue the import back on the @modImports@ of the current module to be tried
again later.-}
tryImport :: CurState -> ImportG (ImpName PName) -> CurState
tryImport :: CurState -> ImportG (ImpName PName) -> CurState
tryImport CurState
s ImportG (ImpName PName)
imp =
  forall a. a -> Maybe a -> a
fromMaybe (CurState -> (Todo -> Todo) -> CurState
updCur CurState
s (ImportG (ImpName PName) -> Todo -> Todo
pushImport ImportG (ImpName PName)
imp))   -- not ready, put it back on the q
  do let srcName :: ImpName PName
srcName = forall mname. ImportG mname -> mname
iModule ImportG (ImpName PName)
imp
     ImpName Name
mname <- forall a.
HasCurScope a =>
CurState' a -> ImpName PName -> Maybe (ImpName Name)
knownImpName CurState
s ImpName PName
srcName
     ResolvedExt
ext   <- forall a.
HasCurScope a =>
CurState' a -> ImpName Name -> Maybe ResolvedExt
knownModule CurState
s ImpName Name
mname

     let isPub :: Name -> Bool
isPub Name
x = Name
x forall a. Ord a => a -> Set a -> Bool
`Set.member` forall imps. ResolvedModule imps -> Set Name
rmodPublic ResolvedExt
ext
         new :: NamingEnv
new = case forall imps. ResolvedModule imps -> ModKind
rmodKind ResolvedExt
ext of
                 ModKind
AModule    -> forall name. ImportG name -> NamingEnv -> NamingEnv
interpImportEnv ImportG (ImpName PName)
imp
                                 ((Name -> Bool) -> NamingEnv -> NamingEnv
filterUNames Name -> Bool
isPub (forall imps. ResolvedModule imps -> NamingEnv
rmodDefines ResolvedExt
ext))
                 ModKind
AFunctor   -> forall a. Monoid a => a
mempty
                 ModKind
ASignature -> forall a. Monoid a => a
mempty

     forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ CurState -> (ModState -> ModState) -> CurState
updCurMS CurState
s { changes :: Bool
changes = Bool
True }
            \ModState
ms -> ModState
ms { modImported :: NamingEnv
modImported = NamingEnv
new forall a. Semigroup a => a -> a -> a
<> ModState -> NamingEnv
modImported ModState
ms }

-- | Resolve all imports in the current modules
doImportStep :: CurState -> CurState
doImportStep :: CurState -> CurState
doImportStep CurState
s = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CurState -> ImportG (ImpName PName) -> CurState
tryImport CurState
s1 (forall a. Mod a -> [ImportG (ImpName PName)]
modImports (forall a. CurState' a -> a
curMod CurState
s))
  where
  s1 :: CurState
s1 = CurState -> (Todo -> Todo) -> CurState
updCur CurState
s \Todo
m -> Todo
m { modImports :: [ImportG (ImpName PName)]
modImports = [] }


{- | Try to instantiate a functor.  This succeeds if we can resolve the functor
and the arguments and the both refer to already resolved names.
Note: at the moment we ignore the arguments, but we'd have to do that in
order to implment applicative behavior with caching. -}
tryInstanceMaybe ::
  HasCurScope a =>
  CurState' a ->
  ImpName Name ->
  (ImpName PName, ModuleInstanceArgs PName)
  {- ^ Functor and arguments -}  ->
  Maybe (ResolvedLocal,CurState' a)
tryInstanceMaybe :: forall a.
HasCurScope a =>
CurState' a
-> ImpName Name
-> (ImpName PName, ModuleInstanceArgs PName)
-> Maybe (ResolvedLocal, CurState' a)
tryInstanceMaybe CurState' a
s ImpName Name
mn (ImpName PName
f,ModuleInstanceArgs PName
_xs) =
  do ImpName Name
fn <- forall a.
HasCurScope a =>
CurState' a -> ImpName PName -> Maybe (ImpName Name)
knownImpName CurState' a
s ImpName PName
f
     let path :: ModPath
path = case ImpName Name
mn of
                  ImpTop ModName
m    -> ModName -> ModPath
TopModule ModName
m
                  ImpNested Name
m ->
                    case Name -> Maybe OrigName
asOrigName Name
m of
                      Just OrigName
og -> ModPath -> Ident -> ModPath
Nested (OrigName -> ModPath
ogModule OrigName
og) (OrigName -> Ident
ogName OrigName
og)
                      Maybe OrigName
Nothing ->
                        forall a. HasCallStack => String -> [String] -> a
panic String
"tryInstanceMaybe" [ String
"Not a top-level name" ]
     forall a.
HasCurScope a =>
Bool
-> ModPath
-> ImpName Name
-> CurState' a
-> Maybe (ResolvedLocal, CurState' a)
doInstantiateByName Bool
False ModPath
path ImpName Name
fn CurState' a
s

{- | Try to instantiate a functor.  If successful, then the newly instantiated
module (and all things nested in it) are going to be added to the
@doneModules@ field.  Otherwise, we queue up the instantiatation in
@curMod@ for later processing -}
tryInstance ::
  CurState ->
  Name ->
  (ImpName PName, ModuleInstanceArgs PName) ->
  CurState
tryInstance :: CurState
-> Name -> (ImpName PName, ModuleInstanceArgs PName) -> CurState
tryInstance CurState
s Name
mn (ImpName PName
f,ModuleInstanceArgs PName
xs) =
  case forall a.
HasCurScope a =>
CurState' a
-> ImpName Name
-> (ImpName PName, ModuleInstanceArgs PName)
-> Maybe (ResolvedLocal, CurState' a)
tryInstanceMaybe CurState
s (forall name. name -> ImpName name
ImpNested Name
mn) (ImpName PName
f,ModuleInstanceArgs PName
xs) of
    Maybe (ResolvedLocal, CurState)
Nothing       -> CurState -> (Todo -> Todo) -> CurState
updCur CurState
s (Name -> (ImpName PName, ModuleInstanceArgs PName) -> Todo -> Todo
pushInst Name
mn (ImpName PName
f,ModuleInstanceArgs PName
xs))
    Just (ResolvedLocal
def,CurState
s1) -> CurState
s1 { changes :: Bool
changes = Bool
True
                        , doneModules :: Map Name ResolvedLocal
doneModules = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
mn ResolvedLocal
def (forall a. CurState' a -> Map Name ResolvedLocal
doneModules CurState
s1)
                        }

{- | Generate a fresh instance for the functor with the given name. -}
doInstantiateByName ::
  HasCurScope a =>
  Bool
  {- ^ This indicates if the result is a functor or not.  When instantiating
    a functor applied to some arguments the result is not a functor.  However,
    if we are instantiating a functor nested within some functor that's being
    instantiated, then the result is still a functor. -} ->
  ModPath {- ^ Path for instantiated names -} ->
  ImpName Name {- ^ Name of the functor/module being instantiated -} ->
  CurState' a -> Maybe (ResolvedLocal,CurState' a)

doInstantiateByName :: forall a.
HasCurScope a =>
Bool
-> ModPath
-> ImpName Name
-> CurState' a
-> Maybe (ResolvedLocal, CurState' a)
doInstantiateByName Bool
keepArgs ModPath
mpath ImpName Name
fname CurState' a
s =
  do ResolvedExt
def <- forall a.
HasCurScope a =>
CurState' a -> ImpName Name -> Maybe ResolvedExt
knownModule CurState' a
s ImpName Name
fname
     forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
HasCurScope a =>
Bool
-> ModPath
-> ResolvedExt
-> CurState' a
-> (ResolvedLocal, CurState' a)
doInstantiate Bool
keepArgs ModPath
mpath ResolvedExt
def CurState' a
s)



{- | Generate a new instantiation of the given module/signature.
Note that the module might not be a functor itself (e.g., if we are
instantiating something nested in a functor -}
doInstantiate ::
  HasCurScope a =>
  Bool               {- ^ See `doInstantiateByName` -} ->
  ModPath            {- ^ Path for instantiated names -} ->
  ResolvedExt        {- ^ The thing being instantiated -} ->
  CurState' a -> (ResolvedLocal,CurState' a)
doInstantiate :: forall a.
HasCurScope a =>
Bool
-> ModPath
-> ResolvedExt
-> CurState' a
-> (ResolvedLocal, CurState' a)
doInstantiate Bool
keepArgs ModPath
mpath ResolvedExt
def CurState' a
s = (ResolvedLocal
newDef, forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' forall {a}.
HasCurScope a =>
CurState' a -> (Name, Name) -> CurState' a
doSub CurState' a
newS Set (Name, Name)
nestedToDo)
  where
  ((NamingEnv
newEnv,Supply
newNameSupply),Set (Name, Name)
nestedToDo) =
      forall a. Id a -> a
M.runId
    forall a b. (a -> b) -> a -> b
$ forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
M.runStateT forall a. Set a
Set.empty
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
Supply -> SupplyT m a -> m (a, Supply)
runSupplyT (forall a. CurState' a -> Supply
nameSupply CurState' a
s)
    forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Applicative f =>
(Name -> f Name) -> NamingEnv -> f NamingEnv
travNamingEnv Name -> SupplyT (StateT (Set (Name, Name)) Id) Name
instName
    forall a b. (a -> b) -> a -> b
$ forall imps. ResolvedModule imps -> NamingEnv
rmodDefines ResolvedExt
def

  newS :: CurState' a
newS = CurState' a
s { nameSupply :: Supply
nameSupply = Supply
newNameSupply }

  pub :: Set Name
pub = let inst :: Map Name Name
inst = NamingEnv -> NamingEnv -> Map Name Name
zipByTextName (forall imps. ResolvedModule imps -> NamingEnv
rmodDefines ResolvedExt
def) NamingEnv
newEnv
        in forall a. Ord a => [a] -> Set a
Set.fromList [ case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
og Map Name Name
inst of
                            Just Name
newN -> Name
newN
                            Maybe Name
Nothing -> forall a. HasCallStack => String -> [String] -> a
panic String
"doInstantiate.pub"
                                           [ String
"Lost a name", forall a. Show a => a -> String
show Name
og ]
                        | Name
og <- forall a. Set a -> [a]
Set.toList (forall imps. ResolvedModule imps -> Set Name
rmodPublic ResolvedExt
def)
                        ]


  newDef :: ResolvedLocal
newDef = ResolvedModule { rmodDefines :: NamingEnv
rmodDefines   = NamingEnv
newEnv
                          , rmodPublic :: Set Name
rmodPublic    = Set Name
pub
                          , rmodKind :: ModKind
rmodKind      = case forall imps. ResolvedModule imps -> ModKind
rmodKind ResolvedExt
def of
                                              ModKind
AFunctor ->
                                                 if Bool
keepArgs then ModKind
AFunctor
                                                             else ModKind
AModule
                                              ModKind
ASignature -> ModKind
ASignature
                                              ModKind
AModule -> ModKind
AModule

                          , rmodNested :: Set Name
rmodNested    = forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall a b. (a, b) -> b
snd Set (Name, Name)
nestedToDo
                          , rmodImports :: NamingEnv
rmodImports   = forall a. Monoid a => a
mempty
                            {- we don't do name resolution on the instantiation
                               the usual way: instead the functor and the
                               arguments are renamed separately, then we
                               we do a pass where we replace:
                                  defined names of functor by instantiations
                                  parameter by actual names in arguments.
                            -}
                          }

  doSub :: CurState' a -> (Name, Name) -> CurState' a
doSub CurState' a
st (Name
oldSubName,Name
newSubName) =
    case forall a.
HasCurScope a =>
Bool
-> ModPath
-> ImpName Name
-> CurState' a
-> Maybe (ResolvedLocal, CurState' a)
doInstantiateByName Bool
True (ModPath -> Ident -> ModPath
Nested ModPath
mpath (Name -> Ident
nameIdent Name
newSubName))
                                  (forall name. name -> ImpName name
ImpNested Name
oldSubName) CurState' a
st of
      Just (ResolvedLocal
idef,CurState' a
st1) -> CurState' a
st1 { doneModules :: Map Name ResolvedLocal
doneModules = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
newSubName ResolvedLocal
idef
                                                        (forall a. CurState' a -> Map Name ResolvedLocal
doneModules CurState' a
st1) }
      Maybe (ResolvedLocal, CurState' a)
Nothing  -> forall a. HasCallStack => String -> [String] -> a
panic String
"doInstantiate.doSub"
                    [ String
"Missing nested module:", forall a. Show a => a -> String
show (forall a. PP a => a -> Doc
pp Name
oldSubName) ]

  instName :: Name -> SupplyT (M.StateT (Set (Name,Name)) M.Id) Name
  instName :: Name -> SupplyT (StateT (Set (Name, Name)) Id) Name
instName Name
x =
    do Name
y <- forall (m :: * -> *) a. FreshM m => (Supply -> (a, Supply)) -> m a
liftSupply (ModPath -> Name -> Supply -> (Name, Supply)
freshNameFor ModPath
mpath Name
x)
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name
x forall a. Ord a => a -> Set a -> Bool
`Set.member` forall imps. ResolvedModule imps -> Set Name
rmodNested ResolvedExt
def)
            (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
M.lift (forall (m :: * -> *) s. StateM m s => (s -> s) -> m ()
M.sets_ (forall a. Ord a => a -> Set a -> Set a
Set.insert (Name
x,Name
y))))
       forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
y


-- | Try to make progress on all instantiations.
doInstancesStep :: CurState -> CurState
doInstancesStep :: CurState -> CurState
doInstancesStep CurState
s = forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' CurState
-> Name -> (ImpName PName, ModuleInstanceArgs PName) -> CurState
tryInstance CurState
s0 (forall a.
Mod a -> Map Name (ImpName PName, ModuleInstanceArgs PName)
modInstances (forall a. CurState' a -> a
curMod CurState
s))
  where
  s0 :: CurState
s0 = CurState -> (Todo -> Todo) -> CurState
updCur CurState
s \Todo
m' -> Todo
m' { modInstances :: Map Name (ImpName PName, ModuleInstanceArgs PName)
modInstances = forall k a. Map k a
Map.empty }

tryFinishCurMod :: Todo -> CurState -> Maybe ResolvedLocal
tryFinishCurMod :: Todo -> CurState -> Maybe ResolvedLocal
tryFinishCurMod Todo
m CurState
newS
  | Todo -> Bool
isDone Todo
newM =
    forall a. a -> Maybe a
Just ResolvedModule
           { rmodDefines :: NamingEnv
rmodDefines = forall a. Mod a -> NamingEnv
modDefines Todo
m
           , rmodPublic :: Set Name
rmodPublic  = forall a. Mod a -> Set Name
modPublic Todo
m
           , rmodKind :: ModKind
rmodKind    = forall a. Mod a -> ModKind
modKind Todo
m
           , rmodNested :: Set Name
rmodNested  = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
                             [ forall k a. Map k a -> Set k
Map.keysSet (forall a.
Mod a -> Map Name (ImpName PName, ModuleInstanceArgs PName)
modInstances Todo
m)
                             , forall k a. Map k a -> Set k
Map.keysSet (forall a. Mod a -> Map Name (Mod a)
modMods Todo
m)
                             ]
           , rmodImports :: NamingEnv
rmodImports  = ModState -> NamingEnv
modImported (forall a. Mod a -> a
modState Todo
newM)
           }

  | Bool
otherwise = forall a. Maybe a
Nothing
  where newM :: Todo
newM = forall a. CurState' a -> a
curMod CurState
newS


-- | Try to resolve the "normal" module with the given name.
tryModule :: CurState -> Name -> Todo -> CurState
tryModule :: CurState -> Name -> Todo -> CurState
tryModule CurState
s Name
nm Todo
m =
  case Todo -> CurState -> Maybe ResolvedLocal
tryFinishCurMod Todo
m CurState
newS of
    Just ResolvedLocal
rMod ->
      CurState
newS { curMod :: Todo
curMod      = forall a. CurState' a -> a
curMod CurState
s
           , doneModules :: Map Name ResolvedLocal
doneModules = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
nm ResolvedLocal
rMod (forall a. CurState' a -> Map Name ResolvedLocal
doneModules CurState
newS)
           , changes :: Bool
changes     = Bool
True
           }
    Maybe ResolvedLocal
Nothing -> CurState
newS { curMod :: Todo
curMod = Name -> Todo -> Todo -> Todo
pushMod Name
nm Todo
newM (forall a. CurState' a -> a
curMod CurState
s) }
  where
  s1 :: CurState
s1     = CurState -> (Todo -> Todo) -> CurState
updCur CurState
s \Todo
_ -> (ModState -> ModState) -> Todo -> Todo
updMS (\ModState
ms -> ModState
ms { modOuter :: NamingEnv
modOuter = forall a. HasCurScope a => CurState' a -> NamingEnv
curScope CurState
s }) Todo
m
  newS :: CurState
newS   = CurState -> CurState
doModuleStep CurState
s1
  newM :: Todo
newM   = forall a. CurState' a -> a
curMod CurState
newS

-- | Process all submodules of a module.
doModulesStep :: CurState -> CurState
doModulesStep :: CurState -> CurState
doModulesStep CurState
s = forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' CurState -> Name -> Todo -> CurState
tryModule CurState
s0 (forall a. Mod a -> Map Name (Mod a)
modMods Todo
m)
  where
  m :: Todo
m  = forall a. CurState' a -> a
curMod CurState
s
  s0 :: CurState
s0 = CurState
s { curMod :: Todo
curMod = Todo
m { modMods :: Map Name Todo
modMods = forall a. Monoid a => a
mempty } }



-- | All steps involved in processing a module.
doModuleStep :: CurState -> CurState
doModuleStep :: CurState -> CurState
doModuleStep = (CurState -> CurState) -> CurState -> CurState
doStep CurState -> CurState
step
  where
  step :: CurState -> CurState
step = (CurState -> CurState) -> CurState -> CurState
doStep CurState -> CurState
doModulesStep
       forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CurState -> CurState) -> CurState -> CurState
doStep CurState -> CurState
doInstancesStep
       forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CurState -> CurState) -> CurState -> CurState
doStep CurState -> CurState
doImportStep