{- |
We add implicit imports are for public nested modules.  This allows
using definitions from nested modules without having to explicitly import
them, for example:

module A where

  submodule B where
    x = 0x20

  y = x     // This works because of the implicit import of `B`

Restriction:
============

We only add impicit imports of modules that are syntactically visiable
in the source code.  Consider the following example:

module A where
  submodule M = F {X}   -- F,X are external modules (e.g., top-level)

We will add an implicit import for `M`, but *NO* implicit imports for
any modules imported vial `M` as those are not sytnactically visible
in the source (i.e., we have to know what `F` refers to).

This restriction allows us to add implicit imports before doing the
`Imports` pass.
-}

module Cryptol.ModuleSystem.Renamer.ImplicitImports
  ( addImplicitNestedImports
  ) where

import Data.List(partition)

import Cryptol.Utils.Ident(identIsNormal, packModName)
import Cryptol.Utils.Panic(panic)
import Cryptol.Parser.Position(Range)
import Cryptol.Parser.AST

{- | Add additional imports for modules nested withing this one -}
addImplicitNestedImports :: [TopDecl PName] -> [TopDecl PName]
addImplicitNestedImports :: [TopDecl PName] -> [TopDecl PName]
addImplicitNestedImports = ([[Ident]], [TopDecl PName]) -> [TopDecl PName]
forall a b. (a, b) -> b
snd (([[Ident]], [TopDecl PName]) -> [TopDecl PName])
-> ([TopDecl PName] -> ([[Ident]], [TopDecl PName]))
-> [TopDecl PName]
-> [TopDecl PName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TopDecl PName] -> ([[Ident]], [TopDecl PName])
addImplicitNestedImports'

{- | Returns:

  * declarations with additional imports and
  * the public module names of this module and its children.
-}
addImplicitNestedImports' ::
  [TopDecl PName] -> ([[Ident]], [TopDecl PName])
addImplicitNestedImports' :: [TopDecl PName] -> ([[Ident]], [TopDecl PName])
addImplicitNestedImports' [TopDecl PName]
decls =
  ([[[Ident]]] -> [[Ident]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Ident]]]
exportedMods, [[TopDecl PName]] -> [TopDecl PName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[TopDecl PName]]
newDecls [TopDecl PName] -> [TopDecl PName] -> [TopDecl PName]
forall a. [a] -> [a] -> [a]
++ [TopDecl PName]
other)
  where
  ([TopDecl PName]
mods,[TopDecl PName]
other)            = (TopDecl PName -> Bool)
-> [TopDecl PName] -> ([TopDecl PName], [TopDecl PName])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition TopDecl PName -> Bool
forall name. TopDecl name -> Bool
isNestedMod [TopDecl PName]
decls
  ([[TopDecl PName]]
newDecls,[[[Ident]]]
exportedMods) = [([TopDecl PName], [[Ident]])] -> ([[TopDecl PName]], [[[Ident]]])
forall a b. [(a, b)] -> ([a], [b])
unzip ((TopDecl PName -> ([TopDecl PName], [[Ident]]))
-> [TopDecl PName] -> [([TopDecl PName], [[Ident]])]
forall a b. (a -> b) -> [a] -> [b]
map TopDecl PName -> ([TopDecl PName], [[Ident]])
processModule [TopDecl PName]
mods)


processModule :: TopDecl PName -> ([TopDecl PName], [[Ident]])
processModule :: TopDecl PName -> ([TopDecl PName], [[Ident]])
processModule TopDecl PName
dcl =
  case TopDecl PName
dcl of
    DModule TopLevel (NestedModule PName)
m ->
      let NestedModule ModuleG PName PName
m1 = TopLevel (NestedModule PName) -> NestedModule PName
forall a. TopLevel a -> a
tlValue TopLevel (NestedModule PName)
m
          mname :: Ident
mname           = PName -> Ident
getIdent (Located PName -> PName
forall a. Located a -> a
thing (ModuleG PName PName -> Located PName
forall mname name. ModuleG mname name -> Located mname
mName ModuleG PName PName
m1))
          loc :: Range
loc             = Located PName -> Range
forall a. Located a -> Range
srcRange (ModuleG PName PName -> Located PName
forall mname name. ModuleG mname name -> Located mname
mName ModuleG PName PName
m1)
      in
      case ModuleG PName PName -> ModuleDefinition PName
forall mname name. ModuleG mname name -> ModuleDefinition name
mDef ModuleG PName PName
m1 of
        ModuleDefinition PName
_ | Bool -> Bool
not (Ident -> Bool
identIsNormal Ident
mname) -> ([TopDecl PName
dcl],[])
        NormalModule [TopDecl PName]
ds ->
          let ([[Ident]]
childExs, [TopDecl PName]
ds1) = [TopDecl PName] -> ([[Ident]], [TopDecl PName])
addImplicitNestedImports' [TopDecl PName]
ds
              imps :: [[Ident]]
imps            = ([Ident] -> [Ident]) -> [[Ident]] -> [[Ident]]
forall a b. (a -> b) -> [a] -> [b]
map (Ident
mname Ident -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
:) ([] [Ident] -> [[Ident]] -> [[Ident]]
forall a. a -> [a] -> [a]
: [[Ident]]
childExs) -- this & nested
          in ( TopLevel (NestedModule PName) -> TopDecl PName
forall name. TopLevel (NestedModule name) -> TopDecl name
DModule TopLevel (NestedModule PName)
m { tlValue = NestedModule m1 { mDef = NormalModule ds1 } }
             TopDecl PName -> [TopDecl PName] -> [TopDecl PName]
forall a. a -> [a] -> [a]
: ([Ident] -> TopDecl PName) -> [[Ident]] -> [TopDecl PName]
forall a b. (a -> b) -> [a] -> [b]
map (Range -> [Ident] -> TopDecl PName
mkImp Range
loc) [[Ident]]
imps
             , case TopLevel (NestedModule PName) -> ExportType
forall a. TopLevel a -> ExportType
tlExport TopLevel (NestedModule PName)
m of
                 ExportType
Public  -> [[Ident]]
imps
                 ExportType
Private -> []
             )

        FunctorInstance {} ->
          let imps :: [[Ident]]
imps = [[Ident
mname]]
          in ( TopDecl PName
dcl TopDecl PName -> [TopDecl PName] -> [TopDecl PName]
forall a. a -> [a] -> [a]
: ([Ident] -> TopDecl PName) -> [[Ident]] -> [TopDecl PName]
forall a b. (a -> b) -> [a] -> [b]
map (Range -> [Ident] -> TopDecl PName
mkImp Range
loc) [[Ident]]
imps
             , case TopLevel (NestedModule PName) -> ExportType
forall a. TopLevel a -> ExportType
tlExport TopLevel (NestedModule PName)
m of
                 ExportType
Public  -> [[Ident]]
imps
                 ExportType
Private -> []
             )
        InterfaceModule {} -> ([TopDecl PName
dcl], [])
    TopDecl PName
_ -> String -> [String] -> ([TopDecl PName], [[Ident]])
forall a. HasCallStack => String -> [String] -> a
panic String
"processModule" [String
"Not a module"]



isNestedMod :: TopDecl name -> Bool
isNestedMod :: forall name. TopDecl name -> Bool
isNestedMod TopDecl name
d =
  case TopDecl name
d of
    DModule TopLevel (NestedModule name)
tl -> case TopLevel (NestedModule name) -> NestedModule name
forall a. TopLevel a -> a
tlValue TopLevel (NestedModule name)
tl of
                    NestedModule ModuleG name name
m -> Bool -> Bool
not (ModuleG name name -> Bool
forall mname nmae. ModuleG mname nmae -> Bool
mIsFunctor ModuleG name name
m)
    TopDecl name
_          -> Bool
False

-- | Make a name qualifier out of a list of identifiers.
isToQual :: [Ident] -> ModName
isToQual :: [Ident] -> ModName
isToQual [Ident]
is = [Text] -> ModName
packModName ((Ident -> Text) -> [Ident] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Text
identText [Ident]
is)

-- | Make a module name out of a list of identifier.
-- This is the name of the module we are implicitly importing.
isToName :: [Ident] -> PName
isToName :: [Ident] -> PName
isToName [Ident]
is = case [Ident]
is of
                [Ident
i] -> Ident -> PName
mkUnqual Ident
i
                [Ident]
_   -> ModName -> Ident -> PName
mkQual ([Ident] -> ModName
isToQual ([Ident] -> [Ident]
forall a. HasCallStack => [a] -> [a]
init [Ident]
is)) ([Ident] -> Ident
forall a. HasCallStack => [a] -> a
last [Ident]
is)

-- | Make an implicit import declaration.
mkImp :: Range -> [Ident] -> TopDecl PName
mkImp :: Range -> [Ident] -> TopDecl PName
mkImp Range
loc [Ident]
xs =
  Located (ImportG (ImpName PName)) -> TopDecl PName
forall name. Located (ImportG (ImpName name)) -> TopDecl name
DImport
    Located
      { srcRange :: Range
srcRange = Range
loc
      , thing :: ImportG (ImpName PName)
thing    = Import
                     { iModule :: ImpName PName
iModule = PName -> ImpName PName
forall name. name -> ImpName name
ImpNested ([Ident] -> PName
isToName [Ident]
xs)
                     , iAs :: Maybe ModName
iAs     = ModName -> Maybe ModName
forall a. a -> Maybe a
Just ([Ident] -> ModName
isToQual [Ident]
xs)
                     , iSpec :: Maybe ImportSpec
iSpec   = Maybe ImportSpec
forall a. Maybe a
Nothing
                     , iInst :: Maybe (ModuleInstanceArgs PName)
iInst   = Maybe (ModuleInstanceArgs PName)
forall a. Maybe a
Nothing
                     , iDoc :: Maybe (Located Text)
iDoc    = Maybe (Located Text)
forall a. Maybe a
Nothing
                     }
      }