Commit 56d70705 authored by Finn Teegen's avatar Finn Teegen

Merge branch 'typevars-with-kinds' into 'master'

Add Kind information to explicitly bound type variables in FlatCurry

See merge request !15
parents 9df5bcd6 45f5cf33
......@@ -22,7 +22,7 @@ import Control.Monad
import Curry.FlatCurry.Typeable
import Curry.FlatCurry.Type ( QName, VarIndex, Visibility (..), TVarIndex
, TypeDecl (..), OpDecl (..), Fixity (..)
, TypeDecl (..), Kind (..), OpDecl (..), Fixity (..)
, TypeExpr (..), ConsDecl (..), NewConsDecl (..)
, Literal (..), CombType (..), CaseType (..)
)
......
......@@ -370,7 +370,7 @@ tConsArgs _ = error $ "Curry.FlatCurry.Goodies.tConsArgs: " ++
trTypeExpr :: (TVarIndex -> a) ->
(QName -> [a] -> a) ->
(a -> a -> a) ->
([TVarIndex] -> a -> a) -> TypeExpr -> a
([(TVarIndex, Kind)] -> a -> a) -> TypeExpr -> a
trTypeExpr tvar _ _ _ (TVar n) = tvar n
trTypeExpr tvar tcons functype foralltype (TCons name args)
= tcons name (map (trTypeExpr tvar tcons functype foralltype) args)
......@@ -417,7 +417,7 @@ updFuncTypes :: (TypeExpr -> TypeExpr -> TypeExpr) -> TypeExpr -> TypeExpr
updFuncTypes functype = trTypeExpr TVar TCons functype ForallType
-- |update all forall types
updForallTypes :: ([TVarIndex] -> TypeExpr -> TypeExpr) -> TypeExpr -> TypeExpr
updForallTypes :: ([(TVarIndex, Kind)] -> TypeExpr -> TypeExpr) -> TypeExpr -> TypeExpr
updForallTypes = trTypeExpr TVar TCons FuncType
-- Auxiliary Functions
......@@ -442,7 +442,7 @@ resultType (ForallType ns t) = ForallType ns t
-- |get indexes of all type variables
allVarsInTypeExpr :: TypeExpr -> [TVarIndex]
allVarsInTypeExpr = trTypeExpr (:[]) (const concat) (++) (++)
allVarsInTypeExpr = trTypeExpr (:[]) (const concat) (++) ((++) . map fst)
-- |yield the list of all contained type constructors
allTypeCons :: TypeExpr -> [QName]
......
......@@ -100,11 +100,14 @@ instance Pretty TypeExpr where
| null vs = pPrintPrec p ty
| otherwise = parenIf (p > 0) $ ppQuantifiedVars vs <+> pPrintPrec 0 ty
-- |pretty-print explicitly quantified type variables
ppQuantifiedVars :: [TVarIndex] -> Doc
-- |pretty-print explicitly quantified type variables (without kinds)
ppQuantifiedVars :: [(TVarIndex, Kind)] -> Doc
ppQuantifiedVars vs
| null vs = empty
| otherwise = text "forall" <+> hsep (map ppTVarIndex vs) <> char '.'
| otherwise = text "forall" <+> hsep (map ppTVar vs) <> char '.'
ppTVar :: (TVarIndex, Kind) -> Doc
ppTVar (i, _) = ppTVarIndex i
-- |pretty-print a type variable
ppTVarIndex :: TVarIndex -> Doc
......
......@@ -18,7 +18,7 @@ module Curry.FlatCurry.Type
( -- * Representation of qualified names and (type) variables
QName, VarIndex, TVarIndex
-- * Data types for FlatCurry
, Visibility (..), Prog (..), TypeDecl (..), TypeExpr (..)
, Visibility (..), Prog (..), TypeDecl (..), TypeExpr (..), Kind (..)
, ConsDecl (..), NewConsDecl(..), OpDecl (..), Fixity (..)
, FuncDecl (..), Rule (..), Expr (..), Literal (..)
, CombType (..), CaseType (..), BranchExpr (..), Pattern (..)
......@@ -118,12 +118,20 @@ data NewConsDecl = NewCons QName Visibility TypeExpr
-- @Int@, @Float@, @Bool@, @Char@, @IO@, @Success@,
-- @()@ (unit type), @(,...,)@ (tuple types), @[]@ (list type)
data TypeExpr
= TVar TVarIndex -- ^ type variable
| FuncType TypeExpr TypeExpr -- ^ function type @t1 -> t2@
| TCons QName [TypeExpr] -- ^ type constructor application
| ForallType [TVarIndex] TypeExpr -- ^ forall type
= TVar TVarIndex -- ^ type variable
| FuncType TypeExpr TypeExpr -- ^ function type @t1 -> t2@
| TCons QName [TypeExpr] -- ^ type constructor application
| ForallType [(TVarIndex, Kind)] TypeExpr -- ^ forall type
deriving (Eq, Read, Show)
-- |Kinds.
--
-- A kind is either * or k_1 -> k_2 where k_1 and k_2 are kinds.
data Kind
= KStar -- ^ star kind
| KArrow Kind Kind -- ^ arrow kind
deriving (Eq, Ord, Read, Show)
-- |Operator declarations.
--
-- An operator declaration @fix p n@ in Curry corresponds to the
......@@ -387,6 +395,16 @@ instance Binary TypeExpr where
3 -> liftM2 ForallType get get
_ -> fail "Invalid encoding for TypeExpr"
instance Binary Kind where
put KStar = putWord8 0
put (KArrow k1 k2) = putWord8 1 >> put k1 >> put k2
get = do
x <- getWord8
case x of
0 -> return KStar
1 -> liftM2 KArrow get get
_ -> fail "Invalid encoding for Kind"
instance Binary OpDecl where
put (Op qid fix pr) = put qid >> put fix >> put pr
get = liftM3 Op get get get
......
......@@ -27,7 +27,7 @@ import Control.Monad
import Curry.FlatCurry.Typeable
import Curry.FlatCurry.Type ( QName, VarIndex, Visibility (..), TVarIndex
, TypeDecl (..), OpDecl (..), Fixity (..)
, TypeDecl (..), Kind (..), OpDecl (..), Fixity (..)
, TypeExpr (..), ConsDecl (..), NewConsDecl (..)
, Literal (..), CombType (..), CaseType (..)
)
......
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