{- |
    Module      :  $Header$
    Description :  Importing interface declarations
    Copyright   :  (c) 2000 - 2003 Wolfgang Lux
                       2011        Björn Peemöller
                       2016        Jan Tikovsky
                       2016        Finn Teegen
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    This module provides the function 'importModules' to bring the imported
    entities into the module's scope, and the function 'qualifyEnv' to
    qualify the environment prior to computing the export interface.
-}
module Imports (importInterfaces, importModules, qualifyEnv) where

import           Data.List                  (nubBy, find)
import qualified Data.Map            as Map
import           Data.Maybe                 (catMaybes, fromMaybe, isJust)
import qualified Data.Set            as Set

import Curry.Base.Ident
import Curry.Base.SpanInfo
import Curry.Base.Monad
import Curry.Syntax

import Base.CurryKinds (toKind')
import Base.CurryTypes ( toQualType, toQualTypes, toQualPredType, toConstrType
                       , toMethodType )

import Base.Kinds
import Base.Messages
import Base.TopEnv
import Base.Types
import Base.TypeSubst

import Env.Class
import Env.Instance
import Env.Interface
import Env.ModuleAlias (importAliases, initAliasEnv)
import Env.OpPrec
import Env.TypeConstructor
import Env.Value

import CompilerEnv

importModules :: Monad m => Module a -> InterfaceEnv -> [ImportDecl]
              -> CYT m CompilerEnv
importModules :: Module a -> InterfaceEnv -> [ImportDecl] -> CYT m CompilerEnv
importModules mdl :: Module a
mdl@(Module _ _ _ mid :: ModuleIdent
mid _ _ _) iEnv :: InterfaceEnv
iEnv expImps :: [ImportDecl]
expImps
  = CompilerEnv -> CYT m CompilerEnv
forall (m :: * -> *) a. Monad m => a -> CYT m a
ok (CompilerEnv -> CYT m CompilerEnv)
-> CompilerEnv -> CYT m CompilerEnv
forall a b. (a -> b) -> a -> b
$ (CompilerEnv -> ImportDecl -> CompilerEnv)
-> CompilerEnv -> [ImportDecl] -> CompilerEnv
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl CompilerEnv -> ImportDecl -> CompilerEnv
importModule CompilerEnv
initEnv [ImportDecl]
expImps
  where
    initEnv :: CompilerEnv
initEnv = (ModuleIdent -> CompilerEnv
initCompilerEnv ModuleIdent
mid)
      { aliasEnv :: AliasEnv
aliasEnv     = [ImportDecl] -> AliasEnv
importAliases [ImportDecl]
expImps -- import module aliases
      , interfaceEnv :: InterfaceEnv
interfaceEnv = InterfaceEnv
iEnv                  -- imported interfaces
      , extensions :: [KnownExtension]
extensions   = Module a -> [KnownExtension]
forall a. Module a -> [KnownExtension]
knownExtensions Module a
mdl
      }
    importModule :: CompilerEnv -> ImportDecl -> CompilerEnv
importModule env :: CompilerEnv
env (ImportDecl _ m :: ModuleIdent
m q :: Qualified
q asM :: Maybe ModuleIdent
asM is :: Maybe ImportSpec
is) =
      case ModuleIdent -> InterfaceEnv -> Maybe Interface
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleIdent
m InterfaceEnv
iEnv of
        Just intf :: Interface
intf -> ModuleIdent
-> Qualified
-> Maybe ImportSpec
-> Interface
-> CompilerEnv
-> CompilerEnv
importInterface (ModuleIdent -> Maybe ModuleIdent -> ModuleIdent
forall a. a -> Maybe a -> a
fromMaybe ModuleIdent
m Maybe ModuleIdent
asM) Qualified
q Maybe ImportSpec
is Interface
intf CompilerEnv
env
        Nothing   -> String -> CompilerEnv
forall a. String -> a
internalError (String -> CompilerEnv) -> String -> CompilerEnv
forall a b. (a -> b) -> a -> b
$ "Imports.importModules: no interface for "
                                     String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModuleIdent -> String
forall a. Show a => a -> String
show ModuleIdent
m

-- |The function 'importInterfaces' brings the declarations of all
-- imported interfaces into scope for the current 'Interface'.
importInterfaces :: Interface -> InterfaceEnv -> CompilerEnv
importInterfaces :: Interface -> InterfaceEnv -> CompilerEnv
importInterfaces (Interface m :: ModuleIdent
m is :: [IImportDecl]
is _) iEnv :: InterfaceEnv
iEnv
  = CompilerEnv -> CompilerEnv
importUnifyData (CompilerEnv -> CompilerEnv) -> CompilerEnv -> CompilerEnv
forall a b. (a -> b) -> a -> b
$ (CompilerEnv -> IImportDecl -> CompilerEnv)
-> CompilerEnv -> [IImportDecl] -> CompilerEnv
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl CompilerEnv -> IImportDecl -> CompilerEnv
importModule CompilerEnv
initEnv [IImportDecl]
is
  where
    initEnv :: CompilerEnv
initEnv = (ModuleIdent -> CompilerEnv
initCompilerEnv ModuleIdent
m) { aliasEnv :: AliasEnv
aliasEnv = AliasEnv
initAliasEnv, interfaceEnv :: InterfaceEnv
interfaceEnv = InterfaceEnv
iEnv }
    importModule :: CompilerEnv -> IImportDecl -> CompilerEnv
importModule env :: CompilerEnv
env (IImportDecl _ i :: ModuleIdent
i) = case ModuleIdent -> InterfaceEnv -> Maybe Interface
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleIdent
i InterfaceEnv
iEnv of
      Just intf :: Interface
intf -> Interface -> CompilerEnv -> CompilerEnv
importInterfaceIntf Interface
intf CompilerEnv
env
      Nothing   -> String -> CompilerEnv
forall a. String -> a
internalError (String -> CompilerEnv) -> String -> CompilerEnv
forall a b. (a -> b) -> a -> b
$ "Imports.importInterfaces: no interface for "
                                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModuleIdent -> String
forall a. Show a => a -> String
show ModuleIdent
m

-- ---------------------------------------------------------------------------
-- Importing an interface into the module
-- ---------------------------------------------------------------------------

-- Four kinds of environments are computed from the interface:
--
-- 1. The operator precedences
-- 2. The type constructors
-- 3. The types of the data constructors and functions (values)
-- 4. The instances
--
-- Note that the original names of all entities defined in the imported module
-- are qualified appropriately. The same is true for type expressions.

-- When an interface is imported, the compiler first transforms the
-- interface into these environments. If an import specification is
-- present, the environments are restricted to only those entities which
-- are included in the specification or not hidden by it, respectively.
-- The resulting environments are then imported into the current module
-- using either a qualified import (if the module is imported qualified)
-- or both a qualified and an unqualified import (non-qualified import).
-- Regardless of the type of import, all instance declarations are always
-- imported into the current module.

importInterface :: ModuleIdent -> Bool -> Maybe ImportSpec -> Interface
                -> CompilerEnv -> CompilerEnv
importInterface :: ModuleIdent
-> Qualified
-> Maybe ImportSpec
-> Interface
-> CompilerEnv
-> CompilerEnv
importInterface m :: ModuleIdent
m q :: Qualified
q is :: Maybe ImportSpec
is (Interface mid :: ModuleIdent
mid _ ds :: [IDecl]
ds) env :: CompilerEnv
env = CompilerEnv
env'
  where
  env' :: CompilerEnv
env' = CompilerEnv
env
    { opPrecEnv :: OpPrecEnv
opPrecEnv = (IDecl -> [PrecInfo])
-> ModuleIdent
-> Qualified
-> (Ident -> Qualified)
-> (PrecInfo -> PrecInfo)
-> [IDecl]
-> OpPrecEnv
-> OpPrecEnv
forall a.
Entity a =>
(IDecl -> [a])
-> ModuleIdent
-> Qualified
-> (Ident -> Qualified)
-> (a -> a)
-> [IDecl]
-> TopEnv a
-> TopEnv a
importEntities (ModuleIdent -> IDecl -> [PrecInfo]
precs  ModuleIdent
mid) ModuleIdent
m Qualified
q Ident -> Qualified
vs PrecInfo -> PrecInfo
forall a. a -> a
id              [IDecl]
ds (OpPrecEnv -> OpPrecEnv) -> OpPrecEnv -> OpPrecEnv
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> OpPrecEnv
opPrecEnv CompilerEnv
env
    , tyConsEnv :: TCEnv
tyConsEnv = (IDecl -> [TypeInfo])
-> ModuleIdent
-> Qualified
-> (Ident -> Qualified)
-> (TypeInfo -> TypeInfo)
-> [IDecl]
-> TCEnv
-> TCEnv
forall a.
Entity a =>
(IDecl -> [a])
-> ModuleIdent
-> Qualified
-> (Ident -> Qualified)
-> (a -> a)
-> [IDecl]
-> TopEnv a
-> TopEnv a
importEntities (ModuleIdent -> IDecl -> [TypeInfo]
types  ModuleIdent
mid) ModuleIdent
m Qualified
q Ident -> Qualified
ts ((Ident -> Qualified) -> TypeInfo -> TypeInfo
importData Ident -> Qualified
vs) [IDecl]
ds (TCEnv -> TCEnv) -> TCEnv -> TCEnv
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env
    , valueEnv :: ValueEnv
valueEnv  = (IDecl -> [ValueInfo])
-> ModuleIdent
-> Qualified
-> (Ident -> Qualified)
-> (ValueInfo -> ValueInfo)
-> [IDecl]
-> ValueEnv
-> ValueEnv
forall a.
Entity a =>
(IDecl -> [a])
-> ModuleIdent
-> Qualified
-> (Ident -> Qualified)
-> (a -> a)
-> [IDecl]
-> TopEnv a
-> TopEnv a
importEntities (ModuleIdent -> IDecl -> [ValueInfo]
values ModuleIdent
mid) ModuleIdent
m Qualified
q Ident -> Qualified
vs ValueInfo -> ValueInfo
forall a. a -> a
id              [IDecl]
ds (ValueEnv -> ValueEnv) -> ValueEnv -> ValueEnv
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> ValueEnv
valueEnv  CompilerEnv
env
    , classEnv :: ClassEnv
classEnv  = ModuleIdent -> [IDecl] -> ClassEnv -> ClassEnv
importClasses   ModuleIdent
mid                                [IDecl]
ds (ClassEnv -> ClassEnv) -> ClassEnv -> ClassEnv
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> ClassEnv
classEnv  CompilerEnv
env
    , instEnv :: InstEnv
instEnv   = ModuleIdent -> [IDecl] -> InstEnv -> InstEnv
importInstances ModuleIdent
mid                                [IDecl]
ds (InstEnv -> InstEnv) -> InstEnv -> InstEnv
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> InstEnv
instEnv   CompilerEnv
env
    }
  ts :: Ident -> Qualified
ts = (Import -> [Ident] -> [Ident])
-> Maybe ImportSpec -> Ident -> Qualified
isVisible Import -> [Ident] -> [Ident]
addType  Maybe ImportSpec
is
  vs :: Ident -> Qualified
vs = (Import -> [Ident] -> [Ident])
-> Maybe ImportSpec -> Ident -> Qualified
isVisible Import -> [Ident] -> [Ident]
addValue Maybe ImportSpec
is

addType :: Import -> [Ident] -> [Ident]
addType :: Import -> [Ident] -> [Ident]
addType (Import            _ _) tcs :: [Ident]
tcs = [Ident]
tcs
addType (ImportTypeWith _ tc :: Ident
tc _) tcs :: [Ident]
tcs = Ident
tc Ident -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
: [Ident]
tcs
addType (ImportTypeAll     _ _) _   = String -> [Ident]
forall a. String -> a
internalError "Imports.addType"

addValue :: Import -> [Ident] -> [Ident]
addValue :: Import -> [Ident] -> [Ident]
addValue (Import            _ f :: Ident
f) fs :: [Ident]
fs = Ident
f Ident -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
: [Ident]
fs
addValue (ImportTypeWith _ _ cs :: [Ident]
cs) fs :: [Ident]
fs = [Ident]
cs [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ [Ident]
fs
addValue (ImportTypeAll     _ _) _  = String -> [Ident]
forall a. String -> a
internalError "Imports.addValue"

isVisible :: (Import -> [Ident] -> [Ident]) -> Maybe ImportSpec
          -> Ident -> Bool
isVisible :: (Import -> [Ident] -> [Ident])
-> Maybe ImportSpec -> Ident -> Qualified
isVisible _   Nothing                 = Qualified -> Ident -> Qualified
forall a b. a -> b -> a
const Qualified
True
isVisible add :: Import -> [Ident] -> [Ident]
add (Just (Importing _ xs :: [Import]
xs)) = (Ident -> Set Ident -> Qualified
forall a. Ord a => a -> Set a -> Qualified
`Set.member`    [Ident] -> Set Ident
forall a. Ord a => [a] -> Set a
Set.fromList ((Import -> [Ident] -> [Ident]) -> [Ident] -> [Import] -> [Ident]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Import -> [Ident] -> [Ident]
add [] [Import]
xs))
isVisible add :: Import -> [Ident] -> [Ident]
add (Just (Hiding    _ xs :: [Import]
xs)) = (Ident -> Set Ident -> Qualified
forall a. Ord a => a -> Set a -> Qualified
`Set.notMember` [Ident] -> Set Ident
forall a. Ord a => [a] -> Set a
Set.fromList ((Import -> [Ident] -> [Ident]) -> [Ident] -> [Import] -> [Ident]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Import -> [Ident] -> [Ident]
add [] [Import]
xs))

importEntities :: Entity a => (IDecl -> [a]) -> ModuleIdent -> Bool
               -> (Ident -> Bool) -> (a -> a) -> [IDecl] -> TopEnv a -> TopEnv a
importEntities :: (IDecl -> [a])
-> ModuleIdent
-> Qualified
-> (Ident -> Qualified)
-> (a -> a)
-> [IDecl]
-> TopEnv a
-> TopEnv a
importEntities ents :: IDecl -> [a]
ents m :: ModuleIdent
m q :: Qualified
q isVisible' :: Ident -> Qualified
isVisible' f :: a -> a
f ds :: [IDecl]
ds env :: TopEnv a
env =
  ((Ident, a) -> TopEnv a -> TopEnv a)
-> TopEnv a -> [(Ident, a)] -> TopEnv a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Ident -> a -> TopEnv a -> TopEnv a)
-> (Ident, a) -> TopEnv a -> TopEnv a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (if Qualified
q then ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
forall a.
Entity a =>
ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
qualImportTopEnv ModuleIdent
m else ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
forall a.
Entity a =>
ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
importUnqual ModuleIdent
m)) TopEnv a
env
        [ (Ident
x, a -> a
f a
y) | a
y <- (IDecl -> [a]) -> [IDecl] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IDecl -> [a]
ents [IDecl]
ds
        , let x :: Ident
x = QualIdent -> Ident
unqualify (a -> QualIdent
forall a. Entity a => a -> QualIdent
origName a
y), Ident -> Qualified
isVisible' Ident
x
        ]
  where importUnqual :: ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
importUnqual m' :: ModuleIdent
m' x :: Ident
x y :: a
y = ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
forall a.
Entity a =>
ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
importTopEnv ModuleIdent
m' Ident
x a
y (TopEnv a -> TopEnv a)
-> (TopEnv a -> TopEnv a) -> TopEnv a -> TopEnv a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
forall a.
Entity a =>
ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
qualImportTopEnv ModuleIdent
m' Ident
x a
y

importData :: (Ident -> Bool) -> TypeInfo -> TypeInfo
importData :: (Ident -> Qualified) -> TypeInfo -> TypeInfo
importData isVisible' :: Ident -> Qualified
isVisible' (DataType tc :: QualIdent
tc k :: Kind
k cs :: [DataConstr]
cs) =
  QualIdent -> Kind -> [DataConstr] -> TypeInfo
DataType QualIdent
tc Kind
k ([DataConstr] -> TypeInfo) -> [DataConstr] -> TypeInfo
forall a b. (a -> b) -> a -> b
$ [Maybe DataConstr] -> [DataConstr]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe DataConstr] -> [DataConstr])
-> [Maybe DataConstr] -> [DataConstr]
forall a b. (a -> b) -> a -> b
$ (DataConstr -> Maybe DataConstr)
-> [DataConstr] -> [Maybe DataConstr]
forall a b. (a -> b) -> [a] -> [b]
map ((Ident -> Qualified) -> DataConstr -> Maybe DataConstr
importConstr Ident -> Qualified
isVisible') [DataConstr]
cs
importData isVisible' :: Ident -> Qualified
isVisible' (RenamingType tc :: QualIdent
tc k :: Kind
k nc :: DataConstr
nc) =
  TypeInfo
-> (DataConstr -> TypeInfo) -> Maybe DataConstr -> TypeInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (QualIdent -> Kind -> [DataConstr] -> TypeInfo
DataType QualIdent
tc Kind
k []) (QualIdent -> Kind -> DataConstr -> TypeInfo
RenamingType QualIdent
tc Kind
k) ((Ident -> Qualified) -> DataConstr -> Maybe DataConstr
importConstr Ident -> Qualified
isVisible' DataConstr
nc)
importData _ (AliasType tc :: QualIdent
tc k :: Kind
k n :: Int
n ty :: Type
ty) = QualIdent -> Kind -> Int -> Type -> TypeInfo
AliasType QualIdent
tc Kind
k Int
n Type
ty
importData isVisible' :: Ident -> Qualified
isVisible' (TypeClass qcls :: QualIdent
qcls k :: Kind
k ms :: [ClassMethod]
ms) =
  QualIdent -> Kind -> [ClassMethod] -> TypeInfo
TypeClass QualIdent
qcls Kind
k ([ClassMethod] -> TypeInfo) -> [ClassMethod] -> TypeInfo
forall a b. (a -> b) -> a -> b
$ [Maybe ClassMethod] -> [ClassMethod]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ClassMethod] -> [ClassMethod])
-> [Maybe ClassMethod] -> [ClassMethod]
forall a b. (a -> b) -> a -> b
$ (ClassMethod -> Maybe ClassMethod)
-> [ClassMethod] -> [Maybe ClassMethod]
forall a b. (a -> b) -> [a] -> [b]
map ((Ident -> Qualified) -> ClassMethod -> Maybe ClassMethod
importMethod Ident -> Qualified
isVisible') [ClassMethod]
ms
importData _ (TypeVar _) = String -> TypeInfo
forall a. String -> a
internalError "Imports.importData: type variable"

importConstr :: (Ident -> Bool) -> DataConstr -> Maybe DataConstr
importConstr :: (Ident -> Qualified) -> DataConstr -> Maybe DataConstr
importConstr isVisible' :: Ident -> Qualified
isVisible' dc :: DataConstr
dc
  | Ident -> Qualified
isVisible' (DataConstr -> Ident
constrIdent DataConstr
dc) = DataConstr -> Maybe DataConstr
forall a. a -> Maybe a
Just DataConstr
dc
  | Qualified
otherwise                   = Maybe DataConstr
forall a. Maybe a
Nothing

importMethod :: (Ident -> Bool) -> ClassMethod -> Maybe ClassMethod
importMethod :: (Ident -> Qualified) -> ClassMethod -> Maybe ClassMethod
importMethod isVisible' :: Ident -> Qualified
isVisible' mthd :: ClassMethod
mthd
  | Ident -> Qualified
isVisible' (ClassMethod -> Ident
methodName ClassMethod
mthd) = ClassMethod -> Maybe ClassMethod
forall a. a -> Maybe a
Just ClassMethod
mthd
  | Qualified
otherwise                    = Maybe ClassMethod
forall a. Maybe a
Nothing

importClasses :: ModuleIdent -> [IDecl] -> ClassEnv -> ClassEnv
importClasses :: ModuleIdent -> [IDecl] -> ClassEnv -> ClassEnv
importClasses m :: ModuleIdent
m = (ClassEnv -> [IDecl] -> ClassEnv)
-> [IDecl] -> ClassEnv -> ClassEnv
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ClassEnv -> [IDecl] -> ClassEnv)
 -> [IDecl] -> ClassEnv -> ClassEnv)
-> (ClassEnv -> [IDecl] -> ClassEnv)
-> [IDecl]
-> ClassEnv
-> ClassEnv
forall a b. (a -> b) -> a -> b
$ (IDecl -> ClassEnv -> ClassEnv) -> ClassEnv -> [IDecl] -> ClassEnv
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ModuleIdent -> IDecl -> ClassEnv -> ClassEnv
bindClass ModuleIdent
m)

bindClass :: ModuleIdent -> IDecl -> ClassEnv -> ClassEnv
bindClass :: ModuleIdent -> IDecl -> ClassEnv -> ClassEnv
bindClass m :: ModuleIdent
m (HidingClassDecl p :: Position
p cx :: Context
cx cls :: QualIdent
cls k :: Maybe KindExpr
k tv :: Ident
tv) =
  ModuleIdent -> IDecl -> ClassEnv -> ClassEnv
bindClass ModuleIdent
m (Position
-> Context
-> QualIdent
-> Maybe KindExpr
-> Ident
-> [IMethodDecl]
-> [Ident]
-> IDecl
IClassDecl Position
p Context
cx QualIdent
cls Maybe KindExpr
k Ident
tv [] [])
bindClass m :: ModuleIdent
m (IClassDecl _ cx :: Context
cx cls :: QualIdent
cls _ _ ds :: [IMethodDecl]
ds ids :: [Ident]
ids) =
  QualIdent -> ClassInfo -> ClassEnv -> ClassEnv
bindClassInfo (ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
cls) ([QualIdent]
sclss, [(Ident, Qualified)]
ms)
  where sclss :: [QualIdent]
sclss = (Constraint -> QualIdent) -> Context -> [QualIdent]
forall a b. (a -> b) -> [a] -> [b]
map (\(Constraint _ scls :: QualIdent
scls _) -> ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
scls) Context
cx
        ms :: [(Ident, Qualified)]
ms = (IMethodDecl -> (Ident, Qualified))
-> [IMethodDecl] -> [(Ident, Qualified)]
forall a b. (a -> b) -> [a] -> [b]
map (\d :: IMethodDecl
d -> (IMethodDecl -> Ident
imethod IMethodDecl
d, Maybe Int -> Qualified
forall a. Maybe a -> Qualified
isJust (Maybe Int -> Qualified) -> Maybe Int -> Qualified
forall a b. (a -> b) -> a -> b
$ IMethodDecl -> Maybe Int
imethodArity IMethodDecl
d)) ([IMethodDecl] -> [(Ident, Qualified)])
-> [IMethodDecl] -> [(Ident, Qualified)]
forall a b. (a -> b) -> a -> b
$ (IMethodDecl -> Qualified) -> [IMethodDecl] -> [IMethodDecl]
forall a. (a -> Qualified) -> [a] -> [a]
filter IMethodDecl -> Qualified
isVis [IMethodDecl]
ds
        isVis :: IMethodDecl -> Qualified
isVis (IMethodDecl _ idt :: Ident
idt _ _ ) = Ident
idt Ident -> [Ident] -> Qualified
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Qualified
`notElem` [Ident]
ids
bindClass _ _ = ClassEnv -> ClassEnv
forall a. a -> a
id

importInstances :: ModuleIdent -> [IDecl] -> InstEnv -> InstEnv
importInstances :: ModuleIdent -> [IDecl] -> InstEnv -> InstEnv
importInstances m :: ModuleIdent
m = (InstEnv -> [IDecl] -> InstEnv) -> [IDecl] -> InstEnv -> InstEnv
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((InstEnv -> [IDecl] -> InstEnv) -> [IDecl] -> InstEnv -> InstEnv)
-> (InstEnv -> [IDecl] -> InstEnv) -> [IDecl] -> InstEnv -> InstEnv
forall a b. (a -> b) -> a -> b
$ (IDecl -> InstEnv -> InstEnv) -> InstEnv -> [IDecl] -> InstEnv
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ModuleIdent -> IDecl -> InstEnv -> InstEnv
bindInstance ModuleIdent
m)

bindInstance :: ModuleIdent -> IDecl -> InstEnv -> InstEnv
bindInstance :: ModuleIdent -> IDecl -> InstEnv -> InstEnv
bindInstance m :: ModuleIdent
m (IInstanceDecl _ cx :: Context
cx qcls :: QualIdent
qcls ty :: InstanceType
ty is :: [IMethodImpl]
is mm :: Maybe ModuleIdent
mm) = InstIdent -> InstInfo -> InstEnv -> InstEnv
bindInstInfo
  (ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
qcls, ModuleIdent -> QualIdent -> QualIdent
qualifyTC ModuleIdent
m (QualIdent -> QualIdent) -> QualIdent -> QualIdent
forall a b. (a -> b) -> a -> b
$ InstanceType -> QualIdent
typeConstr InstanceType
ty) (ModuleIdent -> Maybe ModuleIdent -> ModuleIdent
forall a. a -> Maybe a -> a
fromMaybe ModuleIdent
m Maybe ModuleIdent
mm, PredSet
ps, [IMethodImpl]
is)
  where PredType ps :: PredSet
ps _ = ModuleIdent -> [Ident] -> QualTypeExpr -> PredType
toQualPredType ModuleIdent
m [] (QualTypeExpr -> PredType) -> QualTypeExpr -> PredType
forall a b. (a -> b) -> a -> b
$ SpanInfo -> Context -> InstanceType -> QualTypeExpr
QualTypeExpr SpanInfo
NoSpanInfo Context
cx InstanceType
ty
bindInstance _ _ = InstEnv -> InstEnv
forall a. a -> a
id

-- ---------------------------------------------------------------------------
-- Building the initial environment
-- ---------------------------------------------------------------------------

-- In a first step, the four export environments are initialized from
-- the interface's declarations.

-- operator precedences
precs :: ModuleIdent -> IDecl -> [PrecInfo]
precs :: ModuleIdent -> IDecl -> [PrecInfo]
precs m :: ModuleIdent
m (IInfixDecl _ fix :: Infix
fix prec :: Precedence
prec op :: QualIdent
op) = [QualIdent -> OpPrec -> PrecInfo
PrecInfo (ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
op) (Infix -> Precedence -> OpPrec
OpPrec Infix
fix Precedence
prec)]
precs _ _                          = []

hiddenTypes :: ModuleIdent -> IDecl -> [TypeInfo]
hiddenTypes :: ModuleIdent -> IDecl -> [TypeInfo]
hiddenTypes m :: ModuleIdent
m (HidingDataDecl     _ tc :: QualIdent
tc k :: Maybe KindExpr
k tvs :: [Ident]
tvs) = [(QualIdent -> Kind -> [DataConstr] -> TypeInfo)
-> ModuleIdent
-> QualIdent
-> Maybe KindExpr
-> [Ident]
-> [DataConstr]
-> TypeInfo
forall a.
(QualIdent -> Kind -> a)
-> ModuleIdent -> QualIdent -> Maybe KindExpr -> [Ident] -> a
typeCon QualIdent -> Kind -> [DataConstr] -> TypeInfo
DataType ModuleIdent
m QualIdent
tc Maybe KindExpr
k [Ident]
tvs []]
hiddenTypes m :: ModuleIdent
m (HidingClassDecl  _ _ qcls :: QualIdent
qcls k :: Maybe KindExpr
k _) = [ModuleIdent
-> QualIdent -> Maybe KindExpr -> [ClassMethod] -> TypeInfo
typeCls ModuleIdent
m QualIdent
qcls Maybe KindExpr
k []]
hiddenTypes m :: ModuleIdent
m d :: IDecl
d                               = ModuleIdent -> IDecl -> [TypeInfo]
types ModuleIdent
m IDecl
d

-- type constructors and type classes
types :: ModuleIdent -> IDecl -> [TypeInfo]
types :: ModuleIdent -> IDecl -> [TypeInfo]
types m :: ModuleIdent
m (IDataDecl _ tc :: QualIdent
tc k :: Maybe KindExpr
k tvs :: [Ident]
tvs cs :: [ConstrDecl]
cs _) =
  [(QualIdent -> Kind -> [DataConstr] -> TypeInfo)
-> ModuleIdent
-> QualIdent
-> Maybe KindExpr
-> [Ident]
-> [DataConstr]
-> TypeInfo
forall a.
(QualIdent -> Kind -> a)
-> ModuleIdent -> QualIdent -> Maybe KindExpr -> [Ident] -> a
typeCon QualIdent -> Kind -> [DataConstr] -> TypeInfo
DataType ModuleIdent
m QualIdent
tc Maybe KindExpr
k [Ident]
tvs ((ConstrDecl -> DataConstr) -> [ConstrDecl] -> [DataConstr]
forall a b. (a -> b) -> [a] -> [b]
map ConstrDecl -> DataConstr
mkData [ConstrDecl]
cs)]
  where
    mkData :: ConstrDecl -> DataConstr
mkData (ConstrDecl _ c :: Ident
c tys :: [InstanceType]
tys) =
      Ident -> [Type] -> DataConstr
DataConstr Ident
c (ModuleIdent -> [Ident] -> [InstanceType] -> [Type]
toQualTypes ModuleIdent
m [Ident]
tvs [InstanceType]
tys)
    mkData (ConOpDecl _  ty1 :: InstanceType
ty1 c :: Ident
c ty2 :: InstanceType
ty2) =
      Ident -> [Type] -> DataConstr
DataConstr Ident
c (ModuleIdent -> [Ident] -> [InstanceType] -> [Type]
toQualTypes ModuleIdent
m [Ident]
tvs [InstanceType
ty1, InstanceType
ty2])
    mkData (RecordDecl _ c :: Ident
c fs :: [FieldDecl]
fs) =
      Ident -> [Ident] -> [Type] -> DataConstr
RecordConstr Ident
c [Ident]
labels (ModuleIdent -> [Ident] -> [InstanceType] -> [Type]
toQualTypes ModuleIdent
m [Ident]
tvs [InstanceType]
tys)
      where (labels :: [Ident]
labels, tys :: [InstanceType]
tys) = [(Ident, InstanceType)] -> ([Ident], [InstanceType])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Ident
l, InstanceType
ty) | FieldDecl _ ls :: [Ident]
ls ty :: InstanceType
ty <- [FieldDecl]
fs, Ident
l <- [Ident]
ls]
types m :: ModuleIdent
m (INewtypeDecl _ tc :: QualIdent
tc k :: Maybe KindExpr
k tvs :: [Ident]
tvs nc :: NewConstrDecl
nc _) =
  [(QualIdent -> Kind -> DataConstr -> TypeInfo)
-> ModuleIdent
-> QualIdent
-> Maybe KindExpr
-> [Ident]
-> DataConstr
-> TypeInfo
forall a.
(QualIdent -> Kind -> a)
-> ModuleIdent -> QualIdent -> Maybe KindExpr -> [Ident] -> a
typeCon QualIdent -> Kind -> DataConstr -> TypeInfo
RenamingType ModuleIdent
m QualIdent
tc Maybe KindExpr
k [Ident]
tvs (NewConstrDecl -> DataConstr
mkData NewConstrDecl
nc)]
  where
    mkData :: NewConstrDecl -> DataConstr
mkData (NewConstrDecl _ c :: Ident
c ty :: InstanceType
ty) =
      Ident -> [Type] -> DataConstr
DataConstr Ident
c [ModuleIdent -> [Ident] -> InstanceType -> Type
toQualType ModuleIdent
m [Ident]
tvs InstanceType
ty]
    mkData (NewRecordDecl _ c :: Ident
c (l :: Ident
l, ty :: InstanceType
ty)) =
      Ident -> [Ident] -> [Type] -> DataConstr
RecordConstr Ident
c [Ident
l] [ModuleIdent -> [Ident] -> InstanceType -> Type
toQualType ModuleIdent
m [Ident]
tvs InstanceType
ty]
types m :: ModuleIdent
m (ITypeDecl _ tc :: QualIdent
tc k :: Maybe KindExpr
k tvs :: [Ident]
tvs ty :: InstanceType
ty) =
  [(QualIdent -> Kind -> Type -> TypeInfo)
-> ModuleIdent
-> QualIdent
-> Maybe KindExpr
-> [Ident]
-> Type
-> TypeInfo
forall a.
(QualIdent -> Kind -> a)
-> ModuleIdent -> QualIdent -> Maybe KindExpr -> [Ident] -> a
typeCon QualIdent -> Kind -> Type -> TypeInfo
aliasType ModuleIdent
m QualIdent
tc Maybe KindExpr
k [Ident]
tvs (ModuleIdent -> [Ident] -> InstanceType -> Type
toQualType ModuleIdent
m [Ident]
tvs InstanceType
ty)]
  where
    aliasType :: QualIdent -> Kind -> Type -> TypeInfo
aliasType tc' :: QualIdent
tc' k' :: Kind
k' = QualIdent -> Kind -> Int -> Type -> TypeInfo
AliasType QualIdent
tc' Kind
k' ([Ident] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ident]
tvs)
types m :: ModuleIdent
m (IClassDecl _ _ qcls :: QualIdent
qcls k :: Maybe KindExpr
k tv :: Ident
tv ds :: [IMethodDecl]
ds ids :: [Ident]
ids) =
  [ModuleIdent
-> QualIdent -> Maybe KindExpr -> [ClassMethod] -> TypeInfo
typeCls ModuleIdent
m QualIdent
qcls Maybe KindExpr
k ((IMethodDecl -> ClassMethod) -> [IMethodDecl] -> [ClassMethod]
forall a b. (a -> b) -> [a] -> [b]
map IMethodDecl -> ClassMethod
mkMethod ([IMethodDecl] -> [ClassMethod]) -> [IMethodDecl] -> [ClassMethod]
forall a b. (a -> b) -> a -> b
$ (IMethodDecl -> Qualified) -> [IMethodDecl] -> [IMethodDecl]
forall a. (a -> Qualified) -> [a] -> [a]
filter IMethodDecl -> Qualified
isVis [IMethodDecl]
ds)]
  where
    isVis :: IMethodDecl -> Qualified
isVis (IMethodDecl _ f :: Ident
f _ _ ) = Ident
f Ident -> [Ident] -> Qualified
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Qualified
`notElem` [Ident]
ids
    mkMethod :: IMethodDecl -> ClassMethod
mkMethod (IMethodDecl _ f :: Ident
f a :: Maybe Int
a qty :: QualTypeExpr
qty) = Ident -> Maybe Int -> PredType -> ClassMethod
ClassMethod Ident
f Maybe Int
a (PredType -> ClassMethod) -> PredType -> ClassMethod
forall a b. (a -> b) -> a -> b
$
      ModuleIdent -> PredType -> PredType
qualifyPredType ModuleIdent
m (PredType -> PredType) -> PredType -> PredType
forall a b. (a -> b) -> a -> b
$ Int -> PredType -> PredType
normalize 1 (PredType -> PredType) -> PredType -> PredType
forall a b. (a -> b) -> a -> b
$ QualIdent -> Ident -> QualTypeExpr -> PredType
toMethodType QualIdent
qcls Ident
tv QualTypeExpr
qty
types _ _ = []

-- type constructors
typeCon :: (QualIdent -> Kind -> a) -> ModuleIdent -> QualIdent
        -> Maybe KindExpr -> [Ident] -> a
typeCon :: (QualIdent -> Kind -> a)
-> ModuleIdent -> QualIdent -> Maybe KindExpr -> [Ident] -> a
typeCon f :: QualIdent -> Kind -> a
f m :: ModuleIdent
m tc :: QualIdent
tc k :: Maybe KindExpr
k tvs :: [Ident]
tvs = QualIdent -> Kind -> a
f (ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
tc) (Maybe KindExpr -> Int -> Kind
toKind' Maybe KindExpr
k ([Ident] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ident]
tvs))

-- type classes
typeCls :: ModuleIdent -> QualIdent -> Maybe KindExpr -> [ClassMethod]
        -> TypeInfo
typeCls :: ModuleIdent
-> QualIdent -> Maybe KindExpr -> [ClassMethod] -> TypeInfo
typeCls m :: ModuleIdent
m qcls :: QualIdent
qcls k :: Maybe KindExpr
k ms :: [ClassMethod]
ms = QualIdent -> Kind -> [ClassMethod] -> TypeInfo
TypeClass (ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
qcls) (Maybe KindExpr -> Int -> Kind
toKind' Maybe KindExpr
k 0) [ClassMethod]
ms

-- data constructors, record labels, functions and class methods
values :: ModuleIdent -> IDecl -> [ValueInfo]
values :: ModuleIdent -> IDecl -> [ValueInfo]
values m :: ModuleIdent
m (IDataDecl _ tc :: QualIdent
tc _ tvs :: [Ident]
tvs cs :: [ConstrDecl]
cs hs :: [Ident]
hs) =
  (ConstrDecl -> ValueInfo) -> [ConstrDecl] -> [ValueInfo]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleIdent -> QualIdent -> [Ident] -> ConstrDecl -> ValueInfo
dataConstr ModuleIdent
m QualIdent
tc' [Ident]
tvs)
      ((ConstrDecl -> Qualified) -> [ConstrDecl] -> [ConstrDecl]
forall a. (a -> Qualified) -> [a] -> [a]
filter ((\con :: Ident
con -> Ident
con Ident -> [Ident] -> Qualified
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Qualified
`notElem` [Ident]
hs Qualified -> Qualified -> Qualified
|| Ident -> Qualified
isHiddenButNeeded Ident
con)
              (Ident -> Qualified)
-> (ConstrDecl -> Ident) -> ConstrDecl -> Qualified
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstrDecl -> Ident
constrId) [ConstrDecl]
cs) [ValueInfo] -> [ValueInfo] -> [ValueInfo]
forall a. [a] -> [a] -> [a]
++
  ((Ident, [Ident], InstanceType) -> ValueInfo)
-> [(Ident, [Ident], InstanceType)] -> [ValueInfo]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleIdent
-> QualIdent
-> [Ident]
-> InstanceType
-> (Ident, [Ident], InstanceType)
-> ValueInfo
recLabel ModuleIdent
m QualIdent
tc' [Ident]
tvs InstanceType
ty') (((Ident, [Ident], InstanceType)
 -> (Ident, [Ident], InstanceType) -> Qualified)
-> [(Ident, [Ident], InstanceType)]
-> [(Ident, [Ident], InstanceType)]
forall a. (a -> a -> Qualified) -> [a] -> [a]
nubBy (Ident, [Ident], InstanceType)
-> (Ident, [Ident], InstanceType) -> Qualified
forall a b c b c. Eq a => (a, b, c) -> (a, b, c) -> Qualified
sameLabel [(Ident, [Ident], InstanceType)]
clabels)
  where tc' :: QualIdent
tc' = ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
tc
        ty' :: InstanceType
ty' = QualIdent -> [Ident] -> InstanceType
constrType QualIdent
tc' [Ident]
tvs
        labels :: [(Ident, InstanceType)]
labels   = [ (Ident
l, InstanceType
lty) | RecordDecl _ _ fs :: [FieldDecl]
fs <- [ConstrDecl]
cs
                   , FieldDecl _ ls :: [Ident]
ls lty :: InstanceType
lty <- [FieldDecl]
fs, Ident
l <- [Ident]
ls, Ident
l Ident -> [Ident] -> Qualified
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Qualified
`notElem` [Ident]
hs
                   ]
        clabels :: [(Ident, [Ident], InstanceType)]
clabels  = [(Ident
l, Ident -> [Ident]
constr Ident
l, InstanceType
ty) | (l :: Ident
l, ty :: InstanceType
ty) <- [(Ident, InstanceType)]
labels]
        constr :: Ident -> [Ident]
constr l :: Ident
l = [ConstrDecl -> Ident
constrId ConstrDecl
c | ConstrDecl
c <- [ConstrDecl]
cs, Ident
l Ident -> [Ident] -> Qualified
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Qualified
`elem` ConstrDecl -> [Ident]
recordLabels ConstrDecl
c]
        -- hidden constructors needed for record updates with visible labels
        hiddenCs :: [Ident]
hiddenCs = [Ident
c | (l :: Ident
l, _) <- [(Ident, InstanceType)]
labels, Ident
c <- Ident -> [Ident]
constr Ident
l, Ident
c Ident -> [Ident] -> Qualified
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Qualified
`elem` [Ident]
hs]
        isHiddenButNeeded :: Ident -> Qualified
isHiddenButNeeded = (Ident -> [Ident] -> Qualified) -> [Ident] -> Ident -> Qualified
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ident -> [Ident] -> Qualified
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Qualified
elem [Ident]
hiddenCs
        sameLabel :: (a, b, c) -> (a, b, c) -> Qualified
sameLabel (l1 :: a
l1,_,_) (l2 :: a
l2,_,_) = a
l1 a -> a -> Qualified
forall a. Eq a => a -> a -> Qualified
== a
l2
values m :: ModuleIdent
m (INewtypeDecl _ tc :: QualIdent
tc _ tvs :: [Ident]
tvs nc :: NewConstrDecl
nc hs :: [Ident]
hs) =
  (NewConstrDecl -> ValueInfo) -> [NewConstrDecl] -> [ValueInfo]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleIdent -> QualIdent -> [Ident] -> NewConstrDecl -> ValueInfo
newConstr ModuleIdent
m QualIdent
tc' [Ident]
tvs) [NewConstrDecl
nc | NewConstrDecl -> Ident
nconstrId NewConstrDecl
nc Ident -> [Ident] -> Qualified
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Qualified
`notElem` [Ident]
hs] [ValueInfo] -> [ValueInfo] -> [ValueInfo]
forall a. [a] -> [a] -> [a]
++
  case NewConstrDecl
nc of
    NewConstrDecl _ _ _        -> []
    NewRecordDecl _ c :: Ident
c (l :: Ident
l, lty :: InstanceType
lty) ->
      [ModuleIdent
-> QualIdent
-> [Ident]
-> InstanceType
-> (Ident, [Ident], InstanceType)
-> ValueInfo
recLabel ModuleIdent
m QualIdent
tc' [Ident]
tvs InstanceType
ty' (Ident
l, [Ident
c], InstanceType
lty) | Ident
l Ident -> [Ident] -> Qualified
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Qualified
`notElem` [Ident]
hs]
  where tc' :: QualIdent
tc' = ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
tc
        ty' :: InstanceType
ty' = QualIdent -> [Ident] -> InstanceType
constrType QualIdent
tc' [Ident]
tvs
values m :: ModuleIdent
m (IFunctionDecl _ f :: QualIdent
f Nothing a :: Int
a qty :: QualTypeExpr
qty) =
  [QualIdent -> Maybe QualIdent -> Int -> TypeScheme -> ValueInfo
Value (ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
f) Maybe QualIdent
forall a. Maybe a
Nothing Int
a (PredType -> TypeScheme
typeScheme (ModuleIdent -> [Ident] -> QualTypeExpr -> PredType
toQualPredType ModuleIdent
m [] QualTypeExpr
qty))]
values m :: ModuleIdent
m (IFunctionDecl _ f :: QualIdent
f (Just tv :: Ident
tv) _ qty :: QualTypeExpr
qty) =
  let mcls :: Maybe QualIdent
mcls = case QualTypeExpr
qty of
        QualTypeExpr _ ctx :: Context
ctx _ -> (Constraint -> QualIdent) -> Maybe Constraint -> Maybe QualIdent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Constraint _ qcls :: QualIdent
qcls _) -> QualIdent
qcls) (Maybe Constraint -> Maybe QualIdent)
-> Maybe Constraint -> Maybe QualIdent
forall a b. (a -> b) -> a -> b
$
                                (Constraint -> Qualified) -> Context -> Maybe Constraint
forall (t :: * -> *) a.
Foldable t =>
(a -> Qualified) -> t a -> Maybe a
find (\(Constraint _ _ ty :: InstanceType
ty) -> InstanceType -> Qualified
isVar InstanceType
ty) Context
ctx
  in [QualIdent -> Maybe QualIdent -> Int -> TypeScheme -> ValueInfo
Value (ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
f) Maybe QualIdent
mcls 0 (PredType -> TypeScheme
typeScheme (ModuleIdent -> [Ident] -> QualTypeExpr -> PredType
toQualPredType ModuleIdent
m [Ident
tv] QualTypeExpr
qty))]
  where
    isVar :: InstanceType -> Qualified
isVar (VariableType _ i :: Ident
i) = Ident
i Ident -> Ident -> Qualified
forall a. Eq a => a -> a -> Qualified
== Ident
tv
    isVar _                  = Qualified
False
values m :: ModuleIdent
m (IClassDecl _ _ qcls :: QualIdent
qcls _ tv :: Ident
tv ds :: [IMethodDecl]
ds hs :: [Ident]
hs) =
  (IMethodDecl -> ValueInfo) -> [IMethodDecl] -> [ValueInfo]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleIdent
-> QualIdent -> Ident -> [Ident] -> IMethodDecl -> ValueInfo
classMethod ModuleIdent
m QualIdent
qcls' Ident
tv [Ident]
hs) [IMethodDecl]
ds
  where qcls' :: QualIdent
qcls' = ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
qcls
values _ _                        = []

dataConstr :: ModuleIdent -> QualIdent -> [Ident] -> ConstrDecl -> ValueInfo
dataConstr :: ModuleIdent -> QualIdent -> [Ident] -> ConstrDecl -> ValueInfo
dataConstr m :: ModuleIdent
m tc :: QualIdent
tc tvs :: [Ident]
tvs (ConstrDecl _ c :: Ident
c tys :: [InstanceType]
tys) =
  QualIdent -> Int -> [Ident] -> TypeScheme -> ValueInfo
DataConstructor (QualIdent -> Ident -> QualIdent
qualifyLike QualIdent
tc Ident
c) Int
a [Ident]
labels (TypeScheme -> ValueInfo) -> TypeScheme -> ValueInfo
forall a b. (a -> b) -> a -> b
$
    ModuleIdent -> QualIdent -> [Ident] -> [InstanceType] -> TypeScheme
constrType' ModuleIdent
m QualIdent
tc [Ident]
tvs [InstanceType]
tys
  where a :: Int
a      = [InstanceType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [InstanceType]
tys
        labels :: [Ident]
labels = Int -> Ident -> [Ident]
forall a. Int -> a -> [a]
replicate Int
a Ident
anonId
dataConstr m :: ModuleIdent
m tc :: QualIdent
tc tvs :: [Ident]
tvs (ConOpDecl _ ty1 :: InstanceType
ty1 op :: Ident
op ty2 :: InstanceType
ty2) =
  QualIdent -> Int -> [Ident] -> TypeScheme -> ValueInfo
DataConstructor (QualIdent -> Ident -> QualIdent
qualifyLike QualIdent
tc Ident
op) 2 [Ident
anonId, Ident
anonId] (TypeScheme -> ValueInfo) -> TypeScheme -> ValueInfo
forall a b. (a -> b) -> a -> b
$
    ModuleIdent -> QualIdent -> [Ident] -> [InstanceType] -> TypeScheme
constrType' ModuleIdent
m QualIdent
tc [Ident]
tvs [InstanceType
ty1, InstanceType
ty2]
dataConstr m :: ModuleIdent
m tc :: QualIdent
tc tvs :: [Ident]
tvs (RecordDecl _ c :: Ident
c fs :: [FieldDecl]
fs) =
  QualIdent -> Int -> [Ident] -> TypeScheme -> ValueInfo
DataConstructor (QualIdent -> Ident -> QualIdent
qualifyLike QualIdent
tc Ident
c) Int
a [Ident]
labels (TypeScheme -> ValueInfo) -> TypeScheme -> ValueInfo
forall a b. (a -> b) -> a -> b
$
    ModuleIdent -> QualIdent -> [Ident] -> [InstanceType] -> TypeScheme
constrType' ModuleIdent
m QualIdent
tc [Ident]
tvs [InstanceType]
tys
  where fields :: [(Ident, InstanceType)]
fields        = [(Ident
l, InstanceType
ty) | FieldDecl _ ls :: [Ident]
ls ty :: InstanceType
ty <- [FieldDecl]
fs, Ident
l <- [Ident]
ls]
        (labels :: [Ident]
labels, tys :: [InstanceType]
tys) = [(Ident, InstanceType)] -> ([Ident], [InstanceType])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Ident, InstanceType)]
fields
        a :: Int
a             = [Ident] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ident]
labels

newConstr :: ModuleIdent -> QualIdent -> [Ident] -> NewConstrDecl -> ValueInfo
newConstr :: ModuleIdent -> QualIdent -> [Ident] -> NewConstrDecl -> ValueInfo
newConstr m :: ModuleIdent
m tc :: QualIdent
tc tvs :: [Ident]
tvs (NewConstrDecl _ c :: Ident
c ty1 :: InstanceType
ty1) =
  QualIdent -> Ident -> TypeScheme -> ValueInfo
NewtypeConstructor (QualIdent -> Ident -> QualIdent
qualifyLike QualIdent
tc Ident
c) Ident
anonId (TypeScheme -> ValueInfo) -> TypeScheme -> ValueInfo
forall a b. (a -> b) -> a -> b
$
  ModuleIdent -> QualIdent -> [Ident] -> [InstanceType] -> TypeScheme
constrType' ModuleIdent
m QualIdent
tc [Ident]
tvs [InstanceType
ty1]
newConstr m :: ModuleIdent
m tc :: QualIdent
tc tvs :: [Ident]
tvs (NewRecordDecl _ c :: Ident
c (l :: Ident
l, ty1 :: InstanceType
ty1)) =
  QualIdent -> Ident -> TypeScheme -> ValueInfo
NewtypeConstructor (QualIdent -> Ident -> QualIdent
qualifyLike QualIdent
tc Ident
c) Ident
l (TypeScheme -> ValueInfo) -> TypeScheme -> ValueInfo
forall a b. (a -> b) -> a -> b
$
  ModuleIdent -> QualIdent -> [Ident] -> [InstanceType] -> TypeScheme
constrType' ModuleIdent
m QualIdent
tc [Ident]
tvs [InstanceType
ty1]

recLabel :: ModuleIdent -> QualIdent -> [Ident] -> TypeExpr
           -> (Ident, [Ident], TypeExpr) -> ValueInfo
recLabel :: ModuleIdent
-> QualIdent
-> [Ident]
-> InstanceType
-> (Ident, [Ident], InstanceType)
-> ValueInfo
recLabel m :: ModuleIdent
m tc :: QualIdent
tc tvs :: [Ident]
tvs ty0 :: InstanceType
ty0 (l :: Ident
l, cs :: [Ident]
cs, lty :: InstanceType
lty) = QualIdent -> [QualIdent] -> TypeScheme -> ValueInfo
Label QualIdent
ql [QualIdent]
qcs TypeScheme
tySc
  where ql :: QualIdent
ql   = QualIdent -> Ident -> QualIdent
qualifyLike QualIdent
tc Ident
l
        qcs :: [QualIdent]
qcs  = (Ident -> QualIdent) -> [Ident] -> [QualIdent]
forall a b. (a -> b) -> [a] -> [b]
map (QualIdent -> Ident -> QualIdent
qualifyLike QualIdent
tc) [Ident]
cs
        tySc :: TypeScheme
tySc = Type -> TypeScheme
polyType (ModuleIdent -> [Ident] -> InstanceType -> Type
toQualType ModuleIdent
m [Ident]
tvs (SpanInfo -> InstanceType -> InstanceType -> InstanceType
ArrowType SpanInfo
NoSpanInfo InstanceType
ty0 InstanceType
lty))

constrType' :: ModuleIdent -> QualIdent -> [Ident] -> [TypeExpr] -> TypeScheme
constrType' :: ModuleIdent -> QualIdent -> [Ident] -> [InstanceType] -> TypeScheme
constrType' m :: ModuleIdent
m tc :: QualIdent
tc tvs :: [Ident]
tvs tys :: [InstanceType]
tys = Int -> PredType -> TypeScheme
ForAll ([Ident] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ident]
tvs) PredType
pty
  where pty :: PredType
pty  = ModuleIdent -> PredType -> PredType
qualifyPredType ModuleIdent
m (PredType -> PredType) -> PredType -> PredType
forall a b. (a -> b) -> a -> b
$ QualIdent -> [Ident] -> [InstanceType] -> PredType
toConstrType QualIdent
tc [Ident]
tvs [InstanceType]
tys

constrType :: QualIdent -> [Ident] -> TypeExpr
constrType :: QualIdent -> [Ident] -> InstanceType
constrType tc :: QualIdent
tc tvs :: [Ident]
tvs = (InstanceType -> InstanceType -> InstanceType)
-> InstanceType -> [InstanceType] -> InstanceType
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (SpanInfo -> InstanceType -> InstanceType -> InstanceType
ApplyType SpanInfo
NoSpanInfo) (SpanInfo -> QualIdent -> InstanceType
ConstructorType SpanInfo
NoSpanInfo QualIdent
tc)
                      ([InstanceType] -> InstanceType) -> [InstanceType] -> InstanceType
forall a b. (a -> b) -> a -> b
$ (Ident -> InstanceType) -> [Ident] -> [InstanceType]
forall a b. (a -> b) -> [a] -> [b]
map (SpanInfo -> Ident -> InstanceType
VariableType SpanInfo
NoSpanInfo) [Ident]
tvs

-- We always enter class methods with an arity of 0 into the value environment
-- because there may be different implementations with different arities.

classMethod :: ModuleIdent -> QualIdent -> Ident -> [Ident] -> IMethodDecl
            -> ValueInfo
classMethod :: ModuleIdent
-> QualIdent -> Ident -> [Ident] -> IMethodDecl -> ValueInfo
classMethod m :: ModuleIdent
m qcls :: QualIdent
qcls tv :: Ident
tv hs :: [Ident]
hs (IMethodDecl _ f :: Ident
f _ qty :: QualTypeExpr
qty) =
  QualIdent -> Maybe QualIdent -> Int -> TypeScheme -> ValueInfo
Value (QualIdent -> Ident -> QualIdent
qualifyLike QualIdent
qcls Ident
f) Maybe QualIdent
mcls 0 (TypeScheme -> ValueInfo) -> TypeScheme -> ValueInfo
forall a b. (a -> b) -> a -> b
$
    PredType -> TypeScheme
typeScheme (PredType -> TypeScheme) -> PredType -> TypeScheme
forall a b. (a -> b) -> a -> b
$ ModuleIdent -> PredType -> PredType
qualifyPredType ModuleIdent
m (PredType -> PredType) -> PredType -> PredType
forall a b. (a -> b) -> a -> b
$ QualIdent -> Ident -> QualTypeExpr -> PredType
toMethodType QualIdent
qcls Ident
tv QualTypeExpr
qty
  where
    mcls :: Maybe QualIdent
mcls = if Ident
f Ident -> [Ident] -> Qualified
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Qualified
`elem` [Ident]
hs then Maybe QualIdent
forall a. Maybe a
Nothing else QualIdent -> Maybe QualIdent
forall a. a -> Maybe a
Just QualIdent
qcls

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

-- After all modules have been imported, the compiler has to ensure that
-- all references to a data type use the same list of constructors.

importUnifyData :: CompilerEnv -> CompilerEnv
importUnifyData :: CompilerEnv -> CompilerEnv
importUnifyData cEnv :: CompilerEnv
cEnv = CompilerEnv
cEnv { tyConsEnv :: TCEnv
tyConsEnv = TCEnv -> TCEnv
importUnifyData' (TCEnv -> TCEnv) -> TCEnv -> TCEnv
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
cEnv }

importUnifyData' :: TCEnv -> TCEnv
importUnifyData' :: TCEnv -> TCEnv
importUnifyData' tcEnv :: TCEnv
tcEnv = (TypeInfo -> TypeInfo) -> TCEnv -> TCEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map QualIdent TypeInfo -> TypeInfo -> TypeInfo
forall a p. Entity a => Map QualIdent p -> a -> p
setInfo Map QualIdent TypeInfo
allTyCons) TCEnv
tcEnv
  where
  setInfo :: Map QualIdent p -> a -> p
setInfo tcs :: Map QualIdent p
tcs t :: a
t   = case QualIdent -> Map QualIdent p -> Maybe p
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (a -> QualIdent
forall a. Entity a => a -> QualIdent
origName a
t) Map QualIdent p
tcs of
                         Nothing -> String -> p
forall a. HasCallStack => String -> a
error "Imports.importUnifyData'"
                         Just ty :: p
ty -> p
ty
  allTyCons :: Map QualIdent TypeInfo
allTyCons       = ((QualIdent, TypeInfo)
 -> Map QualIdent TypeInfo -> Map QualIdent TypeInfo)
-> Map QualIdent TypeInfo
-> [(QualIdent, TypeInfo)]
-> Map QualIdent TypeInfo
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (TypeInfo -> Map QualIdent TypeInfo -> Map QualIdent TypeInfo
forall a. Entity a => a -> Map QualIdent a -> Map QualIdent a
mergeData (TypeInfo -> Map QualIdent TypeInfo -> Map QualIdent TypeInfo)
-> ((QualIdent, TypeInfo) -> TypeInfo)
-> (QualIdent, TypeInfo)
-> Map QualIdent TypeInfo
-> Map QualIdent TypeInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualIdent, TypeInfo) -> TypeInfo
forall a b. (a, b) -> b
snd) Map QualIdent TypeInfo
forall k a. Map k a
Map.empty ([(QualIdent, TypeInfo)] -> Map QualIdent TypeInfo)
-> [(QualIdent, TypeInfo)] -> Map QualIdent TypeInfo
forall a b. (a -> b) -> a -> b
$ TCEnv -> [(QualIdent, TypeInfo)]
forall a. TopEnv a -> [(QualIdent, a)]
allImports TCEnv
tcEnv
  mergeData :: a -> Map QualIdent a -> Map QualIdent a
mergeData t :: a
t tcs :: Map QualIdent a
tcs =
    QualIdent -> a -> Map QualIdent a -> Map QualIdent a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert QualIdent
tc (a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
t (a -> a -> a
forall p. Entity p => p -> p -> p
sureMerge a
t) (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ QualIdent -> Map QualIdent a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent
tc Map QualIdent a
tcs) Map QualIdent a
tcs
    where tc :: QualIdent
tc = a -> QualIdent
forall a. Entity a => a -> QualIdent
origName a
t
  sureMerge :: p -> p -> p
sureMerge x :: p
x y :: p
y = case p -> p -> Maybe p
forall a. Entity a => a -> a -> Maybe a
merge p
x p
y of
                       Nothing -> String -> p
forall a. HasCallStack => String -> a
error "Imports.importUnifyData'.sureMerge"
                       Just z :: p
z  -> p
z

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

-- |
qualifyEnv :: CompilerEnv -> CompilerEnv
qualifyEnv :: CompilerEnv -> CompilerEnv
qualifyEnv env :: CompilerEnv
env = CompilerEnv -> CompilerEnv -> CompilerEnv
qualifyLocal CompilerEnv
env
               (CompilerEnv -> CompilerEnv) -> CompilerEnv -> CompilerEnv
forall a b. (a -> b) -> a -> b
$ (CompilerEnv -> Interface -> CompilerEnv)
-> CompilerEnv -> [Interface] -> CompilerEnv
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Interface -> CompilerEnv -> CompilerEnv)
-> CompilerEnv -> Interface -> CompilerEnv
forall a b c. (a -> b -> c) -> b -> a -> c
flip Interface -> CompilerEnv -> CompilerEnv
importInterfaceIntf) CompilerEnv
initEnv
               ([Interface] -> CompilerEnv) -> [Interface] -> CompilerEnv
forall a b. (a -> b) -> a -> b
$ InterfaceEnv -> [Interface]
forall k a. Map k a -> [a]
Map.elems
               (InterfaceEnv -> [Interface]) -> InterfaceEnv -> [Interface]
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> InterfaceEnv
interfaceEnv CompilerEnv
env
  where initEnv :: CompilerEnv
initEnv = ModuleIdent -> CompilerEnv
initCompilerEnv (ModuleIdent -> CompilerEnv) -> ModuleIdent -> CompilerEnv
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> ModuleIdent
moduleIdent CompilerEnv
env

qualifyLocal :: CompilerEnv -> CompilerEnv -> CompilerEnv
qualifyLocal :: CompilerEnv -> CompilerEnv -> CompilerEnv
qualifyLocal currentEnv :: CompilerEnv
currentEnv initEnv :: CompilerEnv
initEnv = CompilerEnv
currentEnv
  { opPrecEnv :: OpPrecEnv
opPrecEnv = ((Ident, PrecInfo) -> OpPrecEnv -> OpPrecEnv)
-> OpPrecEnv -> [(Ident, PrecInfo)] -> OpPrecEnv
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Ident, PrecInfo) -> OpPrecEnv -> OpPrecEnv
forall a a. Entity a => (a, a) -> TopEnv a -> TopEnv a
bindQual   OpPrecEnv
pEnv  ([(Ident, PrecInfo)] -> OpPrecEnv)
-> [(Ident, PrecInfo)] -> OpPrecEnv
forall a b. (a -> b) -> a -> b
$ OpPrecEnv -> [(Ident, PrecInfo)]
forall a. TopEnv a -> [(Ident, a)]
localBindings (OpPrecEnv -> [(Ident, PrecInfo)])
-> OpPrecEnv -> [(Ident, PrecInfo)]
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> OpPrecEnv
opPrecEnv CompilerEnv
currentEnv
  , tyConsEnv :: TCEnv
tyConsEnv = ((Ident, TypeInfo) -> TCEnv -> TCEnv)
-> TCEnv -> [(Ident, TypeInfo)] -> TCEnv
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Ident, TypeInfo) -> TCEnv -> TCEnv
forall a a. Entity a => (a, a) -> TopEnv a -> TopEnv a
bindQual   TCEnv
tcEnv ([(Ident, TypeInfo)] -> TCEnv) -> [(Ident, TypeInfo)] -> TCEnv
forall a b. (a -> b) -> a -> b
$ TCEnv -> [(Ident, TypeInfo)]
forall a. TopEnv a -> [(Ident, a)]
localBindings (TCEnv -> [(Ident, TypeInfo)]) -> TCEnv -> [(Ident, TypeInfo)]
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
currentEnv
  , valueEnv :: ValueEnv
valueEnv  = ((Ident, ValueInfo) -> ValueEnv -> ValueEnv)
-> ValueEnv -> [(Ident, ValueInfo)] -> ValueEnv
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Ident, ValueInfo) -> ValueEnv -> ValueEnv
forall a. Entity a => (Ident, a) -> TopEnv a -> TopEnv a
bindGlobal ValueEnv
tyEnv ([(Ident, ValueInfo)] -> ValueEnv)
-> [(Ident, ValueInfo)] -> ValueEnv
forall a b. (a -> b) -> a -> b
$ ValueEnv -> [(Ident, ValueInfo)]
forall a. TopEnv a -> [(Ident, a)]
localBindings (ValueEnv -> [(Ident, ValueInfo)])
-> ValueEnv -> [(Ident, ValueInfo)]
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> ValueEnv
valueEnv  CompilerEnv
currentEnv
  , classEnv :: ClassEnv
classEnv  = (ClassInfo -> ClassInfo -> ClassInfo)
-> ClassEnv -> ClassEnv -> ClassEnv
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith ClassInfo -> ClassInfo -> ClassInfo
mergeClassInfo ClassEnv
clsEnv (ClassEnv -> ClassEnv) -> ClassEnv -> ClassEnv
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> ClassEnv
classEnv CompilerEnv
currentEnv
  , instEnv :: InstEnv
instEnv   = InstEnv -> InstEnv -> InstEnv
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union                    InstEnv
iEnv   (InstEnv -> InstEnv) -> InstEnv -> InstEnv
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> InstEnv
instEnv  CompilerEnv
currentEnv
  }
  where
    pEnv :: OpPrecEnv
pEnv   = CompilerEnv -> OpPrecEnv
opPrecEnv CompilerEnv
initEnv
    tcEnv :: TCEnv
tcEnv  = CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
initEnv
    tyEnv :: ValueEnv
tyEnv  = CompilerEnv -> ValueEnv
valueEnv  CompilerEnv
initEnv
    clsEnv :: ClassEnv
clsEnv = CompilerEnv -> ClassEnv
classEnv  CompilerEnv
initEnv
    iEnv :: InstEnv
iEnv   = CompilerEnv -> InstEnv
instEnv   CompilerEnv
initEnv
    bindQual :: (a, a) -> TopEnv a -> TopEnv a
bindQual   (_, y :: a
y) = QualIdent -> a -> TopEnv a -> TopEnv a
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
qualBindTopEnv (a -> QualIdent
forall a. Entity a => a -> QualIdent
origName a
y) a
y
    bindGlobal :: (Ident, a) -> TopEnv a -> TopEnv a
bindGlobal (x :: Ident
x, y :: a
y)
      | Ident -> Qualified
hasGlobalScope Ident
x = (Ident, a) -> TopEnv a -> TopEnv a
forall a a. Entity a => (a, a) -> TopEnv a -> TopEnv a
bindQual (Ident
x, a
y)
      | Qualified
otherwise        = Ident -> a -> TopEnv a -> TopEnv a
forall a. Ident -> a -> TopEnv a -> TopEnv a
bindTopEnv Ident
x a
y

-- Importing an interface into another interface is somewhat simpler
-- because all entities are imported into the environment. In addition,
-- only a qualified import is necessary. Note that the hidden data types
-- are imported as well because they may be used in type expressions in
-- an interface.

importInterfaceIntf :: Interface -> CompilerEnv -> CompilerEnv
importInterfaceIntf :: Interface -> CompilerEnv -> CompilerEnv
importInterfaceIntf (Interface m :: ModuleIdent
m _ ds :: [IDecl]
ds) env :: CompilerEnv
env = CompilerEnv
env
  { opPrecEnv :: OpPrecEnv
opPrecEnv = ModuleIdent
-> (IDecl -> [PrecInfo]) -> [IDecl] -> OpPrecEnv -> OpPrecEnv
forall a.
Entity a =>
ModuleIdent -> (IDecl -> [a]) -> [IDecl] -> TopEnv a -> TopEnv a
importEntitiesIntf ModuleIdent
m (ModuleIdent -> IDecl -> [PrecInfo]
precs  ModuleIdent
m)       [IDecl]
ds (OpPrecEnv -> OpPrecEnv) -> OpPrecEnv -> OpPrecEnv
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> OpPrecEnv
opPrecEnv CompilerEnv
env
  , tyConsEnv :: TCEnv
tyConsEnv = ModuleIdent -> (IDecl -> [TypeInfo]) -> [IDecl] -> TCEnv -> TCEnv
forall a.
Entity a =>
ModuleIdent -> (IDecl -> [a]) -> [IDecl] -> TopEnv a -> TopEnv a
importEntitiesIntf ModuleIdent
m (ModuleIdent -> IDecl -> [TypeInfo]
hiddenTypes  ModuleIdent
m) [IDecl]
ds (TCEnv -> TCEnv) -> TCEnv -> TCEnv
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env
  , valueEnv :: ValueEnv
valueEnv  = ModuleIdent
-> (IDecl -> [ValueInfo]) -> [IDecl] -> ValueEnv -> ValueEnv
forall a.
Entity a =>
ModuleIdent -> (IDecl -> [a]) -> [IDecl] -> TopEnv a -> TopEnv a
importEntitiesIntf ModuleIdent
m (ModuleIdent -> IDecl -> [ValueInfo]
values ModuleIdent
m)       [IDecl]
ds (ValueEnv -> ValueEnv) -> ValueEnv -> ValueEnv
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> ValueEnv
valueEnv  CompilerEnv
env
  , classEnv :: ClassEnv
classEnv  = ModuleIdent -> [IDecl] -> ClassEnv -> ClassEnv
importClasses      ModuleIdent
m                  [IDecl]
ds (ClassEnv -> ClassEnv) -> ClassEnv -> ClassEnv
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> ClassEnv
classEnv  CompilerEnv
env
  , instEnv :: InstEnv
instEnv   = ModuleIdent -> [IDecl] -> InstEnv -> InstEnv
importInstances    ModuleIdent
m                  [IDecl]
ds (InstEnv -> InstEnv) -> InstEnv -> InstEnv
forall a b. (a -> b) -> a -> b
$ CompilerEnv -> InstEnv
instEnv   CompilerEnv
env
  }

importEntitiesIntf :: Entity a => ModuleIdent -> (IDecl -> [a]) -> [IDecl]
                    -> TopEnv a -> TopEnv a
importEntitiesIntf :: ModuleIdent -> (IDecl -> [a]) -> [IDecl] -> TopEnv a -> TopEnv a
importEntitiesIntf m :: ModuleIdent
m ents :: IDecl -> [a]
ents ds :: [IDecl]
ds env :: TopEnv a
env = (a -> TopEnv a -> TopEnv a) -> TopEnv a -> [a] -> TopEnv a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> TopEnv a -> TopEnv a
forall a. Entity a => a -> TopEnv a -> TopEnv a
importEntity TopEnv a
env ((IDecl -> [a]) -> [IDecl] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IDecl -> [a]
ents [IDecl]
ds)
  where importEntity :: a -> TopEnv a -> TopEnv a
importEntity x :: a
x = ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
forall a.
Entity a =>
ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
qualImportTopEnv (ModuleIdent -> Maybe ModuleIdent -> ModuleIdent
forall a. a -> Maybe a -> a
fromMaybe ModuleIdent
m (QualIdent -> Maybe ModuleIdent
qidModule (a -> QualIdent
forall a. Entity a => a -> QualIdent
origName a
x)))
                                          (QualIdent -> Ident
unqualify (a -> QualIdent
forall a. Entity a => a -> QualIdent
origName a
x)) a
x