mirror of
https://github.com/google/ghc-source-gen.git
synced 2024-09-11 22:07:09 +03:00
Add kindedVar
and take type parameters as HsTyVarBndr
'. (#61)
Previously functions like `class'` and `data'` took their type variables as `OccNameStr` which let them be passed as overloaded strings; for example, `data' "Maybe" ["a"] ...`. Now, they take them as `HsTyVarBndr'`, the same as `forall'`, and can be constructed with, for example, `data' "Maybe" [bvar "a"] ...`. This approach lets them be constructed with either `bvar` (for regular variables) or `kindedVar` (for kind signatures). Original patch by ersran9@.
This commit is contained in:
parent
76214aa98f
commit
766dbae97c
11
ChangeLog.md
11
ChangeLog.md
@ -1,5 +1,16 @@
|
||||
# Changelog for haskell-syntax
|
||||
|
||||
# 0.4.0.0
|
||||
|
||||
## Breaking Changes
|
||||
- Functions defining types and classes now take their
|
||||
type parameters as `HsTyVarBndr'` rather than `OccNameStr`.
|
||||
To construct a `HsTyVarBndr'`, use either `bvar` or `kindedVar`.
|
||||
Affects: `class'`, `type'`, `newtype'`, and `data'`.
|
||||
|
||||
## Other Changes
|
||||
- Add `kindedVar`.
|
||||
|
||||
## 0.3.0.0
|
||||
- Add `occNameToStr` and `nameToStr` to convert from the GHC types.
|
||||
- Make `listPromotedTy` emit the promoted form `'[..]`,
|
||||
|
@ -5,7 +5,7 @@
|
||||
# https://developers.google.com/open-source/licenses/bsd
|
||||
|
||||
name: ghc-source-gen
|
||||
version: 0.3.0.0
|
||||
version: 0.4.0.0
|
||||
github: "google/ghc-source-gen"
|
||||
license: BSD3
|
||||
author: "Judah Jacobson"
|
||||
|
@ -128,7 +128,7 @@ funDep = ClassFunDep
|
||||
-- > in class'
|
||||
-- > [var "Real" @@ a, var "Enum" @@ a]
|
||||
-- > "Integral"
|
||||
-- > ["a"]
|
||||
-- > [bvar "a"]
|
||||
-- > [ typeSig "divMod" $ a --> a --> tuple [a, a]
|
||||
-- > , typeSig "div" $ a --> a --> a
|
||||
-- > , funBind "div"
|
||||
@ -138,7 +138,7 @@ funDep = ClassFunDep
|
||||
class'
|
||||
:: [HsType'] -- ^ Context
|
||||
-> OccNameStr -- ^ Class name
|
||||
-> [OccNameStr] -- ^ Type parameters
|
||||
-> [HsTyVarBndr'] -- ^ Type parameters
|
||||
-> [ClassDecl] -- ^ Class declarations
|
||||
-> HsDecl'
|
||||
class' context name vars decls
|
||||
@ -246,8 +246,8 @@ tyFamInst name params ty = tyFamInstD
|
||||
--
|
||||
-- > type A a b = B b a
|
||||
-- > =====
|
||||
-- > type' "A" ["a", "b"] $ var "B" @@ var "b" @@ var "a"
|
||||
type' :: OccNameStr -> [OccNameStr] -> HsType' -> HsDecl'
|
||||
-- > type' "A" [bvar "a", bvar "b"] $ var "B" @@ var "b" @@ var "a"
|
||||
type' :: OccNameStr -> [HsTyVarBndr'] -> HsType' -> HsDecl'
|
||||
type' name vars t =
|
||||
noExt TyClD $ withPlaceHolder $ noExt SynDecl (typeRdrName $ unqual name)
|
||||
(mkQTyVars vars)
|
||||
@ -257,7 +257,7 @@ type' name vars t =
|
||||
newOrDataType
|
||||
:: NewOrData
|
||||
-> OccNameStr
|
||||
-> [OccNameStr]
|
||||
-> [HsTyVarBndr']
|
||||
-> [ConDecl']
|
||||
-> [HsDerivingClause']
|
||||
-> HsDecl'
|
||||
@ -276,10 +276,10 @@ newOrDataType newOrData name vars conDecls derivs
|
||||
--
|
||||
-- > newtype Const a b = Const a deriving Eq
|
||||
-- > =====
|
||||
-- > newtype' "Const" ["a", "b"]
|
||||
-- > newtype' "Const" [bvar "a", bvar "b"]
|
||||
-- > (conDecl "Const" [var "a"])
|
||||
-- > [var "Show"]
|
||||
newtype' :: OccNameStr -> [OccNameStr] -> ConDecl' -> [HsDerivingClause'] -> HsDecl'
|
||||
newtype' :: OccNameStr -> [HsTyVarBndr'] -> ConDecl' -> [HsDerivingClause'] -> HsDecl'
|
||||
newtype' name vars conD = newOrDataType NewType name vars [conD]
|
||||
|
||||
-- | A data declaration.
|
||||
@ -287,12 +287,12 @@ newtype' name vars conD = newOrDataType NewType name vars [conD]
|
||||
-- > data Either a b = Left a | Right b
|
||||
-- > deriving Show
|
||||
-- > =====
|
||||
-- > data' "Either" ["a", "b"]
|
||||
-- > data' "Either" [bvar "a", bvar "b"]
|
||||
-- > [ conDecl "Left" [var "a"]
|
||||
-- > , conDecl "Right" [var "b"]
|
||||
-- > ]
|
||||
-- > [var "Show"]
|
||||
data' :: OccNameStr -> [OccNameStr] -> [ConDecl'] -> [HsDerivingClause'] -> HsDecl'
|
||||
data' :: OccNameStr -> [HsTyVarBndr'] -> [ConDecl'] -> [HsDerivingClause'] -> HsDecl'
|
||||
data' = newOrDataType DataType
|
||||
|
||||
-- | Declares a Haskell-98-style prefix constructor for a data or type
|
||||
|
@ -193,6 +193,9 @@ type IE' = IE RdrName
|
||||
|
||||
-- | A type variable binding, as it is represented after the parsing step.
|
||||
--
|
||||
-- Construct with either 'GHC.SourceGen.Overloaded.bVar' (for regular type
|
||||
-- variables) or `GHC.SourceGen.Type.kindedVar` (for kind signatures).
|
||||
--
|
||||
-- Instances:
|
||||
--
|
||||
-- * 'GHC.SourceGen.Overloaded.BVar'
|
||||
|
@ -16,6 +16,7 @@ module GHC.SourceGen.Type
|
||||
, forall'
|
||||
, HsTyVarBndr'
|
||||
, (==>)
|
||||
, kindedVar
|
||||
) where
|
||||
|
||||
import Data.String (fromString)
|
||||
@ -71,3 +72,12 @@ forall' ts = noExt HsForAllTy (map builtLoc ts) . builtLoc
|
||||
(==>) cs = noExt HsQualTy (builtLoc (map builtLoc cs)) . builtLoc
|
||||
|
||||
infixr 0 ==>
|
||||
|
||||
-- | A type variable with a kind signature.
|
||||
--
|
||||
-- > x :: A
|
||||
-- > =====
|
||||
-- > kindedVar "x" (var "A")
|
||||
kindedVar :: OccNameStr -> HsType' -> HsTyVarBndr'
|
||||
kindedVar v t = noExt KindedTyVar (typeRdrName $ UnqualStr v)
|
||||
(builtLoc t)
|
||||
|
@ -11,13 +11,11 @@ import HsTypes
|
||||
import SrcLoc (Located, unLoc)
|
||||
|
||||
import GHC.SourceGen.Syntax.Internal
|
||||
import GHC.SourceGen.Name.Internal
|
||||
|
||||
mkQTyVars :: [OccNameStr] -> LHsQTyVars'
|
||||
mkQTyVars :: [HsTyVarBndr'] -> LHsQTyVars'
|
||||
mkQTyVars vars = withPlaceHolder
|
||||
$ noExt (withPlaceHolder HsQTvs)
|
||||
$ map (builtLoc . noExt UserTyVar . typeRdrName . UnqualStr)
|
||||
vars
|
||||
$ map builtLoc vars
|
||||
|
||||
sigType :: HsType' -> LHsSigType'
|
||||
sigType = implicitBndrs . builtLoc
|
||||
|
@ -116,26 +116,26 @@ test3 = pprint $ module' Nothing Nothing []
|
||||
, typeSig "g" $ op (var "A" @@ var "x") "*"
|
||||
(op (var "B" @@ var "y") "+"
|
||||
(var "C" @@ var "z"))
|
||||
, class' [var "A" @@ var "a"] "B" ["b", "b'"]
|
||||
, class' [var "A" @@ var "a"] "B" [bvar "b", bvar "b'"]
|
||||
[ typeSig "f" $ var "b" --> var "b'"
|
||||
, funBind "f" $ match [] $ var "id"
|
||||
]
|
||||
, class' [] "F" ["a", "b", "c"]
|
||||
, class' [] "F" [bvar "a", bvar "b", bvar "c"]
|
||||
[ funDep ["a", "b"] ["c"]
|
||||
, funDep ["a"] ["b", "c"]
|
||||
]
|
||||
, class' [] "Ident" ["a", "b"]
|
||||
, class' [] "Ident" [bvar "a", bvar "b"]
|
||||
[ funDep ["a"] ["b"]
|
||||
, funDep ["b"] ["a"]
|
||||
, typeSig "ident" $ var "a" --> var "b"
|
||||
]
|
||||
, type' "A" ["b", "c"] $ var "D"
|
||||
, data' "A" ["b", "c"]
|
||||
, type' "A" [bvar "b", bvar "c"] $ var "D"
|
||||
, data' "A" [bvar "b", bvar "c"]
|
||||
[ prefixCon "A" [field (var "b"), field (var "c")]
|
||||
, prefixCon "D" []
|
||||
]
|
||||
[deriving' [var "X", var "Y"]]
|
||||
, newtype' "A" ["b", "c"] (prefixCon "A" [field (var "b")])
|
||||
, newtype' "A" [bvar "b", bvar "c"] (prefixCon "A" [field (var "b")])
|
||||
[deriving' [var "X", var "Y"]]
|
||||
, instance' (var "A" @@ var "b" @@ var "c")
|
||||
[ typeSig "f" $ var "b" --> var "c"
|
||||
@ -145,7 +145,7 @@ test3 = pprint $ module' Nothing Nothing []
|
||||
in class'
|
||||
[var "Real" @@ a, var "Enum" @@ a]
|
||||
"Integral"
|
||||
["a"]
|
||||
[bvar "a"]
|
||||
[ typeSig "divMod" $ a --> a --> tuple [a, a]
|
||||
, typeSig "div" $ a --> a --> a
|
||||
, funBind "div"
|
||||
@ -159,7 +159,7 @@ test3 = pprint $ module' Nothing Nothing []
|
||||
, match [conP "False" []] $ string "False"
|
||||
]
|
||||
]
|
||||
, data' "X" ["b"]
|
||||
, data' "X" [bvar "b"]
|
||||
[ prefixCon "X"
|
||||
[ field $ var "A" @@ var "b"
|
||||
, strict $ field $ var "A" @@ var "b"
|
||||
|
@ -279,6 +279,28 @@ declsTest dflags = testGroup "Decls"
|
||||
[ "pattern F a b = G b a"
|
||||
:~ patSynBind "F" ["a", "b"] $ conP "G" [bvar "b", bvar "a"]
|
||||
]
|
||||
, test "dataDecl"
|
||||
[ "data Either a b\n = Left a | Right b\n deriving Show"
|
||||
:~ data' "Either" [bvar "a", bvar "b"]
|
||||
[ prefixCon "Left" [field $ var "a"]
|
||||
, prefixCon "Right" [field $ var "b"]
|
||||
] $ [deriving' [var "Show"]]
|
||||
, "data Either a (b :: Type)\n = Left a | Right b\n deriving Show"
|
||||
:~ data' "Either" [bvar "a", kindedVar "b" (var "Type")]
|
||||
[ prefixCon "Left" [field $ var "a"]
|
||||
, prefixCon "Right" [field $ var "b"]
|
||||
] $ [deriving' [var "Show"]]
|
||||
]
|
||||
, test "newtypeDecl"
|
||||
[ "newtype Const a b\n = Const a\n deriving Show"
|
||||
:~ newtype' "Const" [bvar "a", bvar "b"]
|
||||
(prefixCon "Const" [field $ var "a"])
|
||||
$ [deriving' [var "Show"]]
|
||||
, "newtype Const a (b :: Type)\n = Const a\n deriving Show"
|
||||
:~ newtype' "Const" [bvar "a", kindedVar "b" (var "Type")]
|
||||
(prefixCon "Const" [field $ var "a"])
|
||||
[deriving' [var "Show"]]
|
||||
]
|
||||
]
|
||||
where
|
||||
test = testDecls dflags
|
||||
|
Loading…
Reference in New Issue
Block a user