Documenting record pattern synonyms
Matthew Pickering
matthewtpickering at gmail.com
Thu Oct 29 18:56:54 UTC 2015
The documentation is in D1325 - https://phabricator.haskell.org/D1325
I added a specification to the wiki page -
https://ghc.haskell.org/trac/ghc/wiki/PatternSynonyms/RecordPatternSynonyms
On Thu, Oct 29, 2015 at 12:03 PM, Simon Peyton Jones
<simonpj at microsoft.com> wrote:
> Matthew:
>
> Could you please write the user-manual sections that you have promised? That is, the *specification* this feature.
>
> Currently, so far as I can see, there is literally NO user manual documentation. No changes to docs/users_guide whatsoever.
>
> We have discussed this on several occasions, and you agreed to do it. I sat with you in person and showed you what I have in mind. There is a sketch on the wiki page.
>
> I did not intend this patch to land until the user documentation was done. Now I feel as if I've lost my leverage :-). But it really really really really needs doing.
>
> Please. I'm begging you. Compared to what you have already done, it's easy.
>
> Simon
>
> | -----Original Message-----
> | From: ghc-commits [mailto:ghc-commits-bounces at haskell.org] On Behalf Of
> | git at git.haskell.org
> | Sent: 29 October 2015 11:25
> | To: ghc-commits at haskell.org
> | Subject: [commit: ghc] master: Record pattern synonyms (2a74a64)
> |
> | Repository : ssh://git@git.haskell.org/ghc
> |
> | On branch : master
> | Link :
> | https://na01.safelinks.protection.outlook.com/?url=http%3a%2f%2fghc.haskell.
> | org%2ftrac%2fghc%2fchangeset%2f2a74a64e8329ab9e0c74bec47198cb492d25affb%2fgh
> | c&data=01%7c01%7csimonpj%40064d.mgd.microsoft.com%7c0deecf24e85641ff3abb08d2
> | e05387f2%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdata=nEAgwVmvFQNgN%2bANGD4H
> | z1flN%2fucKSRFoZMdhRqQKSM%3d
> |
> | >---------------------------------------------------------------
> |
> | commit 2a74a64e8329ab9e0c74bec47198cb492d25affb
> | Author: Matthew Pickering <matthewtpickering at gmail.com>
> | Date: Mon Oct 19 21:17:29 2015 +0100
> |
> | Record pattern synonyms
> |
> | This patch implements an extension to pattern synonyms which allows user
> | to specify pattern synonyms using record syntax. Doing so generates
> | appropriate selectors and update functions.
> |
> | === Interaction with Duplicate Record Fields ===
> |
> | The implementation given here isn't quite as general as it could be with
> | respect to the recently-introduced `DuplicateRecordFields` extension.
> |
> | Consider the following module:
> |
> | {-# LANGUAGE DuplicateRecordFields #-}
> | {-# LANGUAGE PatternSynonyms #-}
> |
> | module Main where
> |
> | pattern S{a, b} = (a, b)
> | pattern T{a} = Just a
> |
> | main = do
> | print S{ a = "fst", b = "snd" }
> | print T{ a = "a" }
> |
> | In principle, this ought to work, because there is no ambiguity. But at
> | the moment it leads to a "multiple declarations of a" error. The problem
> | is that pattern synonym record selectors don't do the same name mangling
> | as normal datatypes when DuplicateRecordFields is enabled. They could,
> | but this would require some work to track the field label and selector
> | name separately.
> |
> | In particular, we currently represent datatype selectors in the third
> | component of AvailTC, but pattern synonym selectors are just represented
> | as Avails (because they don't have a corresponding type constructor).
> | Moreover, the GlobalRdrElt for a selector currently requires it to have
> | a parent tycon.
> |
> | (example due to Adam Gundry)
> |
> | === Updating Explicitly Bidirectional Pattern Synonyms ===
> |
> | Consider the following
> |
> | ```
> | pattern Silly{a} <- [a] where
> | Silly a = [a, a]
> |
> | f1 = a [5] -- 5
> |
> | f2 = [5] {a = 6} -- currently [6,6]
> | ```
> |
> | === Fixing Polymorphic Updates ===
> |
> | They were fixed by adding these two lines in `dsExpr`. This might break
> | record updates but will be easy to fix.
> |
> | ```
> | + ; let req_wrap = mkWpTyApps (mkTyVarTys univ_tvs)
> |
> | - , pat_wrap = idHsWrapper }
> | +, pat_wrap = req_wrap }
> | ```
> |
> | === Mixed selectors error ===
> |
> | Note [Mixed Record Field Updates]
> | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> |
> | Consider the following pattern synonym.
> |
> | data MyRec = MyRec { foo :: Int, qux :: String }
> |
> | pattern HisRec{f1, f2} = MyRec{foo = f1, qux=f2}
> |
> | This allows updates such as the following
> |
> | updater :: MyRec -> MyRec
> | updater a = a {f1 = 1 }
> |
> | It would also make sense to allow the following update (which we
> | reject).
> |
> | updater a = a {f1 = 1, qux = "two" } ==? MyRec 1 "two"
> |
> | This leads to confusing behaviour when the selectors in fact refer the
> | same field.
> |
> | updater a = a {f1 = 1, foo = 2} ==? ???
> |
> | For this reason, we reject a mixture of pattern synonym and normal
> | record selectors in the same update block. Although of course we still
> | allow the following.
> |
> | updater a = (a {f1 = 1}) {foo = 2}
> |
> | > updater (MyRec 0 "str")
> | MyRec 2 "str"
> |
> |
> | >---------------------------------------------------------------
> |
> | 2a74a64e8329ab9e0c74bec47198cb492d25affb
> | compiler/basicTypes/ConLike.hs | 86 +++++++-
> | compiler/basicTypes/ConLike.hs-boot | 18 ++
> | compiler/basicTypes/Id.hs | 31 ++-
> | compiler/basicTypes/IdInfo.hs | 21 +-
> | compiler/basicTypes/PatSyn.hs | 51 +++--
> | compiler/deSugar/Coverage.hs | 11 +-
> | compiler/deSugar/DsExpr.hs | 79 ++++---
> | compiler/deSugar/DsMeta.hs | 2 +-
> | compiler/hsSyn/Convert.hs | 10 +-
> | compiler/hsSyn/HsBinds.hs | 67 +++++-
> | compiler/hsSyn/HsExpr.hs | 35 +++-
> | compiler/hsSyn/HsUtils.hs | 21 +-
> | compiler/hsSyn/PlaceHolder.hs | 6 +-
> | compiler/iface/BuildTyCl.hs | 7 +-
> | compiler/iface/IfaceSyn.hs | 17 +-
> | compiler/iface/MkIface.hs | 11 +-
> | compiler/iface/TcIface.hs | 12 +-
> | compiler/main/HscTypes.hs | 15 +-
> | compiler/parser/Parser.y | 28 ++-
> | compiler/parser/RdrHsSyn.hs | 2 +-
> | compiler/prelude/TysWiredIn.hs | 2 +-
> | compiler/rename/RnBinds.hs | 18 +-
> | compiler/rename/RnExpr.hs | 8 +-
> | compiler/rename/RnNames.hs | 30 +--
> | compiler/rename/RnSource.hs | 52 ++++-
> | compiler/typecheck/TcBinds.hs | 6 +-
> | compiler/typecheck/TcExpr.hs | 231 +++++++++++++++---
> | ---
> | compiler/typecheck/TcHsSyn.hs | 10 +-
> | compiler/typecheck/TcPat.hs | 6 +-
> | compiler/typecheck/TcPatSyn.hs | 124 ++++++++---
> | compiler/typecheck/TcPatSyn.hs-boot | 8 +-
> | compiler/typecheck/TcRnDriver.hs | 3 +-
> | compiler/typecheck/TcTyClsDecls.hs | 39 ++--
> | compiler/types/TyCon.hs | 7 +-
> | compiler/types/TypeRep.hs | 2 +-
> | compiler/types/TypeRep.hs-boot | 1 +
> | testsuite/tests/patsyn/should_compile/all.T | 7 +-
> | .../tests/patsyn/should_compile/records-compile.hs | 11 +
> | .../tests/patsyn/should_compile/records-poly.hs | 16 ++
> | .../patsyn/should_compile/records-prov-req.hs | 26 +++
> | .../patsyn/should_compile/records-req-only.hs | 16 ++
> | .../tests/patsyn/should_compile/records-req.hs | 14 ++
> | testsuite/tests/patsyn/should_fail/all.T | 7 +
> | .../should_fail/mixed-pat-syn-record-sels.hs | 9 +
> | .../should_fail/mixed-pat-syn-record-sels.stderr | 5 +
> | .../tests/patsyn/should_fail/records-check-sels.hs | 10 +
> | .../patsyn/should_fail/records-check-sels.stderr | 3 +
> | .../tests/patsyn/should_fail/records-exquant.hs | 10 +
> | .../patsyn/should_fail/records-exquant.stderr | 11 +
> | .../patsyn/should_fail/records-mixing-fields.hs | 12 ++
> | .../should_fail/records-mixing-fields.stderr | 17 ++
> | .../patsyn/should_fail/records-no-uni-update.hs | 7 +
> | .../should_fail/records-no-uni-update.stderr | 5 +
> | .../patsyn/should_fail/records-no-uni-update2.hs | 11 +
> | .../should_fail/records-no-uni-update2.stderr | 5 +
> | .../patsyn/should_fail/records-poly-update.hs | 13 ++
> | .../patsyn/should_fail/records-poly-update.stderr | 5 +
> | testsuite/tests/patsyn/should_run/all.T | 1 +
> | testsuite/tests/patsyn/should_run/records-run.hs | 14 ++
> | .../tests/patsyn/should_run/records-run.stdout | 5 +
> | 60 files changed, 1055 insertions(+), 262 deletions(-)
> |
> | Diff suppressed because of size. To see it, use:
> |
> | git diff-tree --root --patch-with-stat --no-color --find-copies-harder -
> | -ignore-space-at-eol --cc 2a74a64e8329ab9e0c74bec47198cb492d25affb
> | _______________________________________________
> | ghc-commits mailing list
> | ghc-commits at haskell.org
> | https://na01.safelinks.protection.outlook.com/?url=http%3a%2f%2fmail.haskell
> | .org%2fcgi-bin%2fmailman%2flistinfo%2fghc-
> | commits&data=01%7c01%7csimonpj%40064d.mgd.microsoft.com%7c0deecf24e85641ff3a
> | bb08d2e05387f2%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdata=ymzeKEsSAnOhr4QL
> | ngFKt0e8B84voue20%2bCyMPwWf%2fQ%3d
More information about the ghc-devs
mailing list