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
, interfaceEnv :: InterfaceEnv
interfaceEnv = InterfaceEnv
iEnv
, 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
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
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
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
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 _ _ = []
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))
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
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]
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
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
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
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