{- |
    Module      :  $Header$
    Description :  Environment for functions, constructors and labels
    Copyright   :  (c) 2001 - 2004 Wolfgang Lux
                       2011        Björn Peemöller
                       2015        Jan Tikovsky
                       2016        Finn Teegen
    License     :  BSD-3-clause

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

    In order to test the type correctness of a module, the compiler needs
    to determine the type of every data constructor, function and
    variable in the module.
    For the purpose of type checking there is no
    need for distinguishing between variables and functions. For all objects
    their original names and their types are saved. In addition, the compiler
    also saves the (optional) list of field labels for data and newtype
    constructors. Data constructors and functions also contain arity
    information. On import two values are considered equal if their original
    names match.
-}
{-# LANGUAGE CPP #-}
module Env.Value
  ( ValueEnv, ValueInfo (..)
  , bindGlobalInfo, bindFun, qualBindFun, rebindFun, unbindFun
  , lookupValue, qualLookupValue, qualLookupValueUnique
  , initDCEnv
  , ValueType (..), bindLocalVars, bindLocalVar
  ) where

#if __GLASGOW_HASKELL__ >= 804
import Prelude hiding ((<>))
#endif

import Curry.Base.Ident
import Curry.Base.Pretty (Pretty(..))

import Base.Messages (internalError)
import Base.PrettyTypes ()
import Base.TopEnv
import Base.Types
import Base.Utils ((++!))

import Text.PrettyPrint

data ValueInfo
  -- |Data constructor with original name, arity, list of record labels and type
  = DataConstructor    QualIdent                   Int [Ident] TypeScheme
  -- |Newtype constructor with original name, record label and type
  -- (arity is always 1)
  | NewtypeConstructor QualIdent                       Ident   TypeScheme
  -- |Value with original name, class method name, arity and type
  | Value              QualIdent (Maybe QualIdent) Int         TypeScheme
  -- |Record label with original name, list of constructors for which label
  -- is a valid field and type (arity is always 1)
  | Label              QualIdent [QualIdent]                   TypeScheme
    deriving Int -> ValueInfo -> ShowS
[ValueInfo] -> ShowS
ValueInfo -> String
(Int -> ValueInfo -> ShowS)
-> (ValueInfo -> String)
-> ([ValueInfo] -> ShowS)
-> Show ValueInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueInfo] -> ShowS
$cshowList :: [ValueInfo] -> ShowS
show :: ValueInfo -> String
$cshow :: ValueInfo -> String
showsPrec :: Int -> ValueInfo -> ShowS
$cshowsPrec :: Int -> ValueInfo -> ShowS
Show

instance Entity ValueInfo where
  origName :: ValueInfo -> QualIdent
origName (DataConstructor    orgName :: QualIdent
orgName _ _ _) = QualIdent
orgName
  origName (NewtypeConstructor orgName :: QualIdent
orgName   _ _) = QualIdent
orgName
  origName (Value              orgName :: QualIdent
orgName _ _ _) = QualIdent
orgName
  origName (Label              orgName :: QualIdent
orgName   _ _) = QualIdent
orgName

  merge :: ValueInfo -> ValueInfo -> Maybe ValueInfo
merge (DataConstructor c1 :: QualIdent
c1 ar1 :: Int
ar1 ls1 :: [Ident]
ls1 ty1 :: TypeScheme
ty1) (DataConstructor c2 :: QualIdent
c2 ar2 :: Int
ar2 ls2 :: [Ident]
ls2 ty2 :: TypeScheme
ty2)
    | QualIdent
c1 QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
c2 Bool -> Bool -> Bool
&& Int
ar1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ar2 Bool -> Bool -> Bool
&& TypeScheme
ty1 TypeScheme -> TypeScheme -> Bool
forall a. Eq a => a -> a -> Bool
== TypeScheme
ty2 = do
      [Ident]
ls' <- [Maybe Ident] -> Maybe [Ident]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((Ident -> Ident -> Maybe Ident)
-> [Ident] -> [Ident] -> [Maybe Ident]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Ident -> Ident -> Maybe Ident
mergeLabel [Ident]
ls1 [Ident]
ls2)
      ValueInfo -> Maybe ValueInfo
forall a. a -> Maybe a
Just (QualIdent -> Int -> [Ident] -> TypeScheme -> ValueInfo
DataConstructor QualIdent
c1 Int
ar1 [Ident]
ls' TypeScheme
ty1)
  merge (NewtypeConstructor c1 :: QualIdent
c1 l1 :: Ident
l1 ty1 :: TypeScheme
ty1) (NewtypeConstructor c2 :: QualIdent
c2 l2 :: Ident
l2 ty2 :: TypeScheme
ty2)
    | QualIdent
c1 QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
c2 Bool -> Bool -> Bool
&& TypeScheme
ty1 TypeScheme -> TypeScheme -> Bool
forall a. Eq a => a -> a -> Bool
== TypeScheme
ty2 = do
      Ident
l' <- Ident -> Ident -> Maybe Ident
mergeLabel Ident
l1 Ident
l2
      ValueInfo -> Maybe ValueInfo
forall a. a -> Maybe a
Just (QualIdent -> Ident -> TypeScheme -> ValueInfo
NewtypeConstructor QualIdent
c1 Ident
l' TypeScheme
ty1)
  merge (Value x1 :: QualIdent
x1 ar1 :: Maybe QualIdent
ar1 cm1 :: Int
cm1 ty1 :: TypeScheme
ty1) (Value x2 :: QualIdent
x2 ar2 :: Maybe QualIdent
ar2 cm2 :: Int
cm2 ty2 :: TypeScheme
ty2)
    | QualIdent
x1 QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
x2 Bool -> Bool -> Bool
&& Maybe QualIdent
ar1 Maybe QualIdent -> Maybe QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe QualIdent
ar2 Bool -> Bool -> Bool
&& Int
cm1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cm2 Bool -> Bool -> Bool
&& TypeScheme
ty1 TypeScheme -> TypeScheme -> Bool
forall a. Eq a => a -> a -> Bool
== TypeScheme
ty2 =
      ValueInfo -> Maybe ValueInfo
forall a. a -> Maybe a
Just (QualIdent -> Maybe QualIdent -> Int -> TypeScheme -> ValueInfo
Value QualIdent
x1 Maybe QualIdent
ar1 Int
cm1 TypeScheme
ty1)
  merge (Label l1 :: QualIdent
l1 cs1 :: [QualIdent]
cs1 ty1 :: TypeScheme
ty1) (Label l2 :: QualIdent
l2 cs2 :: [QualIdent]
cs2 ty2 :: TypeScheme
ty2)
    | QualIdent
l1 QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
l2 Bool -> Bool -> Bool
&& [QualIdent]
cs1 [QualIdent] -> [QualIdent] -> Bool
forall a. Eq a => a -> a -> Bool
== [QualIdent]
cs2 Bool -> Bool -> Bool
&& TypeScheme
ty1 TypeScheme -> TypeScheme -> Bool
forall a. Eq a => a -> a -> Bool
== TypeScheme
ty2 = ValueInfo -> Maybe ValueInfo
forall a. a -> Maybe a
Just (QualIdent -> [QualIdent] -> TypeScheme -> ValueInfo
Label QualIdent
l1 [QualIdent]
cs1 TypeScheme
ty1)
  merge _ _ = Maybe ValueInfo
forall a. Maybe a
Nothing

instance Pretty ValueInfo where
  pPrint :: ValueInfo -> Doc
pPrint (DataConstructor qid :: QualIdent
qid ar :: Int
ar _ tySc :: TypeScheme
tySc) =     String -> Doc
text "data" Doc -> Doc -> Doc
<+> QualIdent -> Doc
forall a. Pretty a => a -> Doc
pPrint QualIdent
qid
                                           Doc -> Doc -> Doc
<>  String -> Doc
text "/" Doc -> Doc -> Doc
<> Int -> Doc
int Int
ar
                                           Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> TypeScheme -> Doc
forall a. Pretty a => a -> Doc
pPrint TypeScheme
tySc
  pPrint (NewtypeConstructor qid :: QualIdent
qid _ tySc :: TypeScheme
tySc) =     String -> Doc
text "newtype" Doc -> Doc -> Doc
<+> QualIdent -> Doc
forall a. Pretty a => a -> Doc
pPrint QualIdent
qid
                                           Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> TypeScheme -> Doc
forall a. Pretty a => a -> Doc
pPrint TypeScheme
tySc
  pPrint (Value qid :: QualIdent
qid _ ar :: Int
ar tySc :: TypeScheme
tySc)           =     QualIdent -> Doc
forall a. Pretty a => a -> Doc
pPrint QualIdent
qid
                                           Doc -> Doc -> Doc
<>  String -> Doc
text "/" Doc -> Doc -> Doc
<> Int -> Doc
int Int
ar
                                           Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> TypeScheme -> Doc
forall a. Pretty a => a -> Doc
pPrint TypeScheme
tySc
  pPrint (Label qid :: QualIdent
qid _ tySc :: TypeScheme
tySc)              =     String -> Doc
text "label" Doc -> Doc -> Doc
<+> QualIdent -> Doc
forall a. Pretty a => a -> Doc
pPrint QualIdent
qid
                                           Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> TypeScheme -> Doc
forall a. Pretty a => a -> Doc
pPrint TypeScheme
tySc

mergeLabel :: Ident -> Ident -> Maybe Ident
mergeLabel :: Ident -> Ident -> Maybe Ident
mergeLabel l1 :: Ident
l1 l2 :: Ident
l2
  | Ident
l1 Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
anonId = Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
l2
  | Ident
l2 Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
anonId = Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
l1
  | Ident
l1 Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
l2     = Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
l1
  | Bool
otherwise    = Maybe Ident
forall a. Maybe a
Nothing

-- Even though value declarations may be nested, the compiler uses only
-- flat environments for saving type information. This is possible
-- because all identifiers are renamed by the compiler. Here we need
-- special cases for handling tuple constructors.
--
-- Note: the function 'qualLookupValue' has been extended to
-- allow the usage of the qualified list constructor (Prelude.:).

type ValueEnv = TopEnv ValueInfo

bindGlobalInfo :: (QualIdent -> a -> ValueInfo) -> ModuleIdent -> Ident -> a
               -> ValueEnv -> ValueEnv
bindGlobalInfo :: (QualIdent -> a -> ValueInfo)
-> ModuleIdent -> Ident -> a -> ValueEnv -> ValueEnv
bindGlobalInfo f :: QualIdent -> a -> ValueInfo
f m :: ModuleIdent
m c :: Ident
c ty :: a
ty = Ident -> ValueInfo -> ValueEnv -> ValueEnv
forall a. Ident -> a -> TopEnv a -> TopEnv a
bindTopEnv Ident
c ValueInfo
v (ValueEnv -> ValueEnv)
-> (ValueEnv -> ValueEnv) -> ValueEnv -> ValueEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualIdent -> ValueInfo -> ValueEnv -> ValueEnv
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
qualBindTopEnv QualIdent
qc ValueInfo
v
  where qc :: QualIdent
qc = ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
m Ident
c
        v :: ValueInfo
v  = QualIdent -> a -> ValueInfo
f QualIdent
qc a
ty

bindFun :: ModuleIdent -> Ident -> Maybe QualIdent -> Int -> TypeScheme
        -> ValueEnv -> ValueEnv
bindFun :: ModuleIdent
-> Ident
-> Maybe QualIdent
-> Int
-> TypeScheme
-> ValueEnv
-> ValueEnv
bindFun m :: ModuleIdent
m f :: Ident
f cm :: Maybe QualIdent
cm a :: Int
a ty :: TypeScheme
ty
  | Ident -> Bool
hasGlobalScope Ident
f = Ident -> ValueInfo -> ValueEnv -> ValueEnv
forall a. Ident -> a -> TopEnv a -> TopEnv a
bindTopEnv Ident
f ValueInfo
v (ValueEnv -> ValueEnv)
-> (ValueEnv -> ValueEnv) -> ValueEnv -> ValueEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualIdent -> ValueInfo -> ValueEnv -> ValueEnv
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
qualBindTopEnv QualIdent
qf ValueInfo
v
  | Bool
otherwise        = Ident -> ValueInfo -> ValueEnv -> ValueEnv
forall a. Ident -> a -> TopEnv a -> TopEnv a
bindTopEnv Ident
f ValueInfo
v
  where qf :: QualIdent
qf = ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
m Ident
f
        v :: ValueInfo
v  = QualIdent -> Maybe QualIdent -> Int -> TypeScheme -> ValueInfo
Value QualIdent
qf Maybe QualIdent
cm Int
a TypeScheme
ty

qualBindFun :: ModuleIdent -> Ident -> Maybe QualIdent -> Int -> TypeScheme
            -> ValueEnv -> ValueEnv
qualBindFun :: ModuleIdent
-> Ident
-> Maybe QualIdent
-> Int
-> TypeScheme
-> ValueEnv
-> ValueEnv
qualBindFun m :: ModuleIdent
m f :: Ident
f cm :: Maybe QualIdent
cm a :: Int
a ty :: TypeScheme
ty = QualIdent -> ValueInfo -> ValueEnv -> ValueEnv
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
qualBindTopEnv QualIdent
qf (ValueInfo -> ValueEnv -> ValueEnv)
-> ValueInfo -> ValueEnv -> ValueEnv
forall a b. (a -> b) -> a -> b
$ QualIdent -> Maybe QualIdent -> Int -> TypeScheme -> ValueInfo
Value QualIdent
qf Maybe QualIdent
cm Int
a TypeScheme
ty
  where qf :: QualIdent
qf = ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
m Ident
f

rebindFun :: ModuleIdent -> Ident -> Maybe QualIdent -> Int -> TypeScheme
          -> ValueEnv -> ValueEnv
rebindFun :: ModuleIdent
-> Ident
-> Maybe QualIdent
-> Int
-> TypeScheme
-> ValueEnv
-> ValueEnv
rebindFun m :: ModuleIdent
m f :: Ident
f cm :: Maybe QualIdent
cm a :: Int
a ty :: TypeScheme
ty
  | Ident -> Bool
hasGlobalScope Ident
f = Ident -> ValueInfo -> ValueEnv -> ValueEnv
forall a. Ident -> a -> TopEnv a -> TopEnv a
rebindTopEnv Ident
f ValueInfo
v (ValueEnv -> ValueEnv)
-> (ValueEnv -> ValueEnv) -> ValueEnv -> ValueEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualIdent -> ValueInfo -> ValueEnv -> ValueEnv
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
qualRebindTopEnv QualIdent
qf ValueInfo
v
  | Bool
otherwise        = Ident -> ValueInfo -> ValueEnv -> ValueEnv
forall a. Ident -> a -> TopEnv a -> TopEnv a
rebindTopEnv Ident
f ValueInfo
v
  where qf :: QualIdent
qf = ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
m Ident
f
        v :: ValueInfo
v  = QualIdent -> Maybe QualIdent -> Int -> TypeScheme -> ValueInfo
Value QualIdent
qf Maybe QualIdent
cm Int
a TypeScheme
ty

unbindFun :: Ident -> ValueEnv -> ValueEnv
unbindFun :: Ident -> ValueEnv -> ValueEnv
unbindFun = Ident -> ValueEnv -> ValueEnv
forall a. Ident -> TopEnv a -> TopEnv a
unbindTopEnv

lookupValue :: Ident -> ValueEnv -> [ValueInfo]
lookupValue :: Ident -> ValueEnv -> [ValueInfo]
lookupValue x :: Ident
x tyEnv :: ValueEnv
tyEnv = Ident -> ValueEnv -> [ValueInfo]
forall a. Ident -> TopEnv a -> [a]
lookupTopEnv Ident
x ValueEnv
tyEnv [ValueInfo] -> [ValueInfo] -> [ValueInfo]
forall a. [a] -> [a] -> [a]
++! Ident -> [ValueInfo]
lookupTuple Ident
x

qualLookupValue :: QualIdent -> ValueEnv -> [ValueInfo]
qualLookupValue :: QualIdent -> ValueEnv -> [ValueInfo]
qualLookupValue x :: QualIdent
x tyEnv :: ValueEnv
tyEnv = QualIdent -> ValueEnv -> [ValueInfo]
forall a. QualIdent -> TopEnv a -> [a]
qualLookupTopEnv QualIdent
x ValueEnv
tyEnv
                      [ValueInfo] -> [ValueInfo] -> [ValueInfo]
forall a. [a] -> [a] -> [a]
++! Ident -> [ValueInfo]
lookupTuple (QualIdent -> Ident
unqualify QualIdent
x)

qualLookupValueUnique :: ModuleIdent -> QualIdent -> ValueEnv -> [ValueInfo]
qualLookupValueUnique :: ModuleIdent -> QualIdent -> ValueEnv -> [ValueInfo]
qualLookupValueUnique m :: ModuleIdent
m x :: QualIdent
x tyEnv :: ValueEnv
tyEnv = case QualIdent -> ValueEnv -> [ValueInfo]
qualLookupValue QualIdent
x ValueEnv
tyEnv of
  []  -> []
  [v :: ValueInfo
v] -> [ValueInfo
v]
  vs :: [ValueInfo]
vs  -> case QualIdent -> ValueEnv -> [ValueInfo]
qualLookupValue (ModuleIdent -> QualIdent -> QualIdent
qualQualify ModuleIdent
m QualIdent
x) ValueEnv
tyEnv of
    []  -> [ValueInfo]
vs
    [v :: ValueInfo
v] -> [ValueInfo
v]
    qvs :: [ValueInfo]
qvs -> [ValueInfo]
qvs

lookupTuple :: Ident -> [ValueInfo]
lookupTuple :: Ident -> [ValueInfo]
lookupTuple c :: Ident
c | Ident -> Bool
isTupleId Ident
c = [[ValueInfo]
tupleDCs [ValueInfo] -> Int -> ValueInfo
forall a. [a] -> Int -> a
!! (Ident -> Int
tupleArity Ident
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)]
              | Bool
otherwise   = []

tupleDCs :: [ValueInfo]
tupleDCs :: [ValueInfo]
tupleDCs = (DataConstr -> ValueInfo) -> [DataConstr] -> [ValueInfo]
forall a b. (a -> b) -> [a] -> [b]
map DataConstr -> ValueInfo
dataInfo [DataConstr]
tupleData
  where dataInfo :: DataConstr -> ValueInfo
dataInfo (DataConstr _ tys :: [Type]
tys) =
          let n :: Int
n = [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tys
          in  QualIdent -> Int -> [Ident] -> TypeScheme -> ValueInfo
DataConstructor (Int -> QualIdent
qTupleId Int
n) Int
n (Int -> Ident -> [Ident]
forall a. Int -> a -> [a]
replicate Int
n Ident
anonId) (TypeScheme -> ValueInfo) -> TypeScheme -> ValueInfo
forall a b. (a -> b) -> a -> b
$
                Int -> PredType -> TypeScheme
ForAll Int
n (PredType -> TypeScheme) -> PredType -> TypeScheme
forall a b. (a -> b) -> a -> b
$ Type -> PredType
predType (Type -> PredType) -> Type -> PredType
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> Type -> [Type] -> Type
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Type -> Type -> Type
TypeArrow ([Type] -> Type
tupleType [Type]
tys) [Type]
tys
        dataInfo (RecordConstr _ _ _) =
          String -> ValueInfo
forall a. String -> a
internalError (String -> ValueInfo) -> String -> ValueInfo
forall a b. (a -> b) -> a -> b
$ "Env.Value.tupleDCs: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ValueInfo] -> String
forall a. Show a => a -> String
show [ValueInfo]
tupleDCs

-- Since all predefined types are free of existentially quantified type
-- variables and have an empty predicate set, we can ignore both of them
-- when entering the types into the value environment.

initDCEnv :: ValueEnv
initDCEnv :: ValueEnv
initDCEnv = ((Ident, Int, TypeScheme) -> ValueEnv -> ValueEnv)
-> ValueEnv -> [(Ident, Int, TypeScheme)] -> ValueEnv
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Ident, Int, TypeScheme) -> ValueEnv -> ValueEnv
predefDC ValueEnv
forall a. TopEnv a
emptyTopEnv
  [ (Ident
c, [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tys, TypeScheme -> [Type] -> TypeScheme
forall (t :: * -> *).
Foldable t =>
TypeScheme -> t Type -> TypeScheme
constrType (Type -> TypeScheme
polyType Type
ty) [Type]
tys)
  | (ty :: Type
ty, cs :: [DataConstr]
cs) <- [(Type, [DataConstr])]
predefTypes, DataConstr c :: Ident
c tys :: [Type]
tys <- [DataConstr]
cs ]
  where predefDC :: (Ident, Int, TypeScheme) -> ValueEnv -> ValueEnv
predefDC (c :: Ident
c, a :: Int
a, ty :: TypeScheme
ty) = QualIdent -> ValueInfo -> ValueEnv -> ValueEnv
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
predefTopEnv QualIdent
c' (QualIdent -> Int -> [Ident] -> TypeScheme -> ValueInfo
DataConstructor QualIdent
c' Int
a [Ident]
ls TypeScheme
ty)
          where ls :: [Ident]
ls = Int -> Ident -> [Ident]
forall a. Int -> a -> [a]
replicate Int
a Ident
anonId
                c' :: QualIdent
c' = Ident -> QualIdent
qualify Ident
c
        constrType :: TypeScheme -> t Type -> TypeScheme
constrType (ForAll n :: Int
n (PredType ps :: PredSet
ps ty :: Type
ty)) =
          Int -> PredType -> TypeScheme
ForAll Int
n (PredType -> TypeScheme)
-> (t Type -> PredType) -> t Type -> TypeScheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredSet -> Type -> PredType
PredType PredSet
ps (Type -> PredType) -> (t Type -> Type) -> t Type -> PredType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> Type -> Type) -> Type -> t Type -> Type
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Type -> Type -> Type
TypeArrow Type
ty

-- The functions 'bindLocalVar' and 'bindLocalVars' add the type of one or
-- many local variables or functions to the value environment. In contrast
-- to global functions, we do not care about the name of the module containing
-- the variable or function's definition.

class ValueType t where
  toValueType :: Type -> t
  fromValueType :: t -> PredType

instance ValueType Type where
  toValueType :: Type -> Type
toValueType = Type -> Type
forall a. a -> a
id
  fromValueType :: Type -> PredType
fromValueType = Type -> PredType
predType

instance ValueType PredType where
  toValueType :: Type -> PredType
toValueType = Type -> PredType
predType
  fromValueType :: PredType -> PredType
fromValueType = PredType -> PredType
forall a. a -> a
id

bindLocalVars :: ValueType t => [(Ident, Int, t)] -> ValueEnv -> ValueEnv
bindLocalVars :: [(Ident, Int, t)] -> ValueEnv -> ValueEnv
bindLocalVars = (ValueEnv -> [(Ident, Int, t)] -> ValueEnv)
-> [(Ident, Int, t)] -> ValueEnv -> ValueEnv
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ValueEnv -> [(Ident, Int, t)] -> ValueEnv)
 -> [(Ident, Int, t)] -> ValueEnv -> ValueEnv)
-> (ValueEnv -> [(Ident, Int, t)] -> ValueEnv)
-> [(Ident, Int, t)]
-> ValueEnv
-> ValueEnv
forall a b. (a -> b) -> a -> b
$ ((Ident, Int, t) -> ValueEnv -> ValueEnv)
-> ValueEnv -> [(Ident, Int, t)] -> ValueEnv
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Ident, Int, t) -> ValueEnv -> ValueEnv
forall t. ValueType t => (Ident, Int, t) -> ValueEnv -> ValueEnv
bindLocalVar

bindLocalVar :: ValueType t => (Ident, Int, t) -> ValueEnv -> ValueEnv
bindLocalVar :: (Ident, Int, t) -> ValueEnv -> ValueEnv
bindLocalVar (v :: Ident
v, a :: Int
a, ty :: t
ty) =
  Ident -> ValueInfo -> ValueEnv -> ValueEnv
forall a. Ident -> a -> TopEnv a -> TopEnv a
bindTopEnv Ident
v (ValueInfo -> ValueEnv -> ValueEnv)
-> ValueInfo -> ValueEnv -> ValueEnv
forall a b. (a -> b) -> a -> b
$ QualIdent -> Maybe QualIdent -> Int -> TypeScheme -> ValueInfo
Value (Ident -> QualIdent
qualify Ident
v) Maybe QualIdent
forall a. Maybe a
Nothing Int
a (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
$ t -> PredType
forall t. ValueType t => t -> PredType
fromValueType t
ty