Commit 58546d4f authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

Consistent handling of primitive identifiers (lists, tuples)

parent e1f58e8e
......@@ -18,7 +18,7 @@ TODO: Use MultiParamTypeClasses ?
> Type (..), isArrowType, arrowArity, arrowArgs, arrowBase, typeVars
> , typeConstrs, typeSkolems, equTypes, qualifyType, unqualifyType
> -- * Representation of Data Constructors
> , DataConstr (..), constrIdent
> , DataConstr (..), constrIdent, tupleData
> -- * Representation of Quantification
> , TypeScheme (..), ExistTypeScheme (..), monoType, polyType
> -- * Predefined types
......@@ -256,40 +256,40 @@ There are a few predefined types:
\begin{verbatim}
> unitType :: Type
> unitType = primType unitId []
> unitType = primType qUnitId []
> boolType :: Type
> boolType = primType boolId []
> boolType = primType qBoolId []
> charType :: Type
> charType = primType charId []
> charType = primType qCharId []
> intType :: Type
> intType = primType intId []
> intType = primType qIntId []
> floatType :: Type
> floatType = primType floatId []
> floatType = primType qFloatId []
> stringType :: Type
> stringType = listType charType
> successType :: Type
> successType = primType successId []
> successType = primType qSuccessId []
> listType :: Type -> Type
> listType ty = primType listId [ty]
> listType ty = primType qListId [ty]
> ioType :: Type -> Type
> ioType ty = primType ioId [ty]
> ioType ty = primType qIOId [ty]
> tupleType :: [Type] -> Type
> tupleType tys = primType (tupleId (length tys)) tys
> tupleType tys = primType (qTupleId (length tys)) tys
> typeVar :: Int -> Type
> typeVar = TypeVariable
> primType :: Ident -> [Type] -> Type
> primType = TypeConstructor . qualifyWith preludeMIdent
> primType :: QualIdent -> [Type] -> Type
> primType = TypeConstructor -- . qualifyWith preludeMIdent
> predefTypes :: [(Type, [DataConstr])]
> predefTypes = let a = typeVar 0 in
......@@ -299,4 +299,8 @@ There are a few predefined types:
> ])
> ]
> tupleData :: [DataConstr]
> tupleData = [DataConstr (tupleId n) n (take n tvs) | n <- [2 ..]]
> where tvs = map typeVar [0 ..]
\end{verbatim}
......@@ -39,7 +39,7 @@
module Env.TypeConstructor
( TCEnv, TypeInfo (..), tcArity, bindTypeInfo, lookupTC, qualLookupTC
, lookupTupleTC, tupleTCs, tupleData, initTCEnv
, initTCEnv
, TypeEnv, TypeKind (..), typeKind
) where
......@@ -101,16 +101,8 @@ lookupTC :: Ident -> TCEnv -> [TypeInfo]
lookupTC tc tcEnv = lookupTopEnv tc tcEnv ++! lookupTupleTC tc
qualLookupTC :: QualIdent -> TCEnv -> [TypeInfo]
qualLookupTC tc tcEnv = qualLookupTopEnv tc tcEnv
++! qualLookupList tc tcEnv
++! lookupTupleTC (unqualify tc)
qualLookupList :: QualIdent -> TCEnv -> [TypeInfo]
qualLookupList tc tcEnv
| mmid == Just preludeMIdent && qid == listId
= qualLookupTopEnv (qualify qid) tcEnv
| otherwise = []
where (mmid, qid) = (qidModule tc, qidIdent tc)
qualLookupTC tc tcEnv = qualLookupTopEnv tc tcEnv
++! lookupTupleTC (unqualify tc)
lookupTupleTC :: Ident -> [TypeInfo]
lookupTupleTC tc | isTupleId tc = [tupleTCs !! (tupleArity tc - 2)]
......@@ -118,19 +110,14 @@ lookupTupleTC tc | isTupleId tc = [tupleTCs !! (tupleArity tc - 2)]
tupleTCs :: [TypeInfo]
tupleTCs = map typeInfo tupleData
where typeInfo (DataConstr c _ tys) =
DataType (qualifyWith preludeMIdent c) (length tys)
[Just (DataConstr c 0 tys)]
tupleData :: [DataConstr]
tupleData = [DataConstr (tupleId n) 0 (take n tvs) | n <- [2 ..]]
where tvs = map typeVar [0 ..]
where typeInfo dc@(DataConstr _ n _) = DataType (qTupleId n) n [Just dc]
initTCEnv :: TCEnv
initTCEnv = foldr (uncurry predefTC) emptyTopEnv predefTypes
where
predefTC (TypeConstructor tc tys) = predefTopEnv (qualify (unqualify tc))
. DataType tc (length tys) . map Just
predefTC (TypeConstructor tc tys) = predefTopEnv tc
. DataType tc (length tys)
. map Just
predefTC _ = internalError "Base.initTCEnv.predefTC: no type constructor"
type TypeEnv = TopEnv TypeKind
......
......@@ -23,7 +23,7 @@
module Env.Value
( ValueEnv, ValueInfo (..)
, bindGlobalInfo, bindFun, qualBindFun, rebindFun, unbindFun, bindLabel
, lookupValue, qualLookupValue, qualLookupCons, lookupTuple, tupleDCs
, lookupValue, qualLookupValue
, initDCEnv, ppTypes
) where
......@@ -38,8 +38,6 @@ import Base.TopEnv
import Base.Types
import Base.Utils ((++!))
import Env.TypeConstructor (TypeInfo (..), tupleTCs)
data ValueInfo
-- |Data constructor with original name, arity and type
= DataConstructor QualIdent Int ExistTypeScheme
......@@ -114,28 +112,16 @@ lookupValue x tyEnv = lookupTopEnv x tyEnv ++! lookupTuple x
qualLookupValue :: QualIdent -> ValueEnv -> [ValueInfo]
qualLookupValue x tyEnv = qualLookupTopEnv x tyEnv
++! qualLookupCons x tyEnv
++! lookupTuple (unqualify x)
qualLookupCons :: QualIdent -> ValueEnv -> [ValueInfo]
qualLookupCons x tyEnv
| mmid == Just preludeMIdent && qid == consId
= qualLookupTopEnv (qualify qid) tyEnv
| otherwise = []
where (mmid, qid) = (qidModule x, qidIdent x)
++! lookupTuple (unqualify x)
lookupTuple :: Ident -> [ValueInfo]
lookupTuple c
| isTupleId c = [tupleDCs !! (tupleArity c - 2)]
| otherwise = []
lookupTuple c | isTupleId c = [tupleDCs !! (tupleArity c - 2)]
| otherwise = []
tupleDCs :: [ValueInfo]
tupleDCs = map dataInfo tupleTCs
where
dataInfo (DataType tc _ [Just (DataConstr _ _ tys)]) =
DataConstructor (qualUnqualify preludeMIdent tc) (length tys)
(ForAllExist (length tys) 0 $ foldr TypeArrow (tupleType tys) tys)
dataInfo _ = internalError "Env.Value.tupleDCs: no data constructor"
tupleDCs = map dataInfo tupleData
where dataInfo (DataConstr _ n tys) = DataConstructor (qTupleId n) n
(ForAllExist n 0 $ foldr TypeArrow (tupleType tys) tys)
initDCEnv :: ValueEnv
initDCEnv = foldr predefDC emptyTopEnv
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment