Opened 8 years ago
Closed 8 years ago
#5290 closed feature request (fixed)
Add UNPACK support to Template Haskell
Reported by: | mikhail.vorozhtsov | Owned by: | |
---|---|---|---|
Priority: | high | Milestone: | 7.4.1 |
Component: | Template Haskell | Version: | 7.1 |
Keywords: | Cc: | ||
Operating System: | Unknown/Multiple | Architecture: | Unknown/Multiple |
Type of failure: | None/Unknown | Test Case: | th/T5290 |
Blocked By: | Blocking: | ||
Related Tickets: | Differential Rev(s): | ||
Wiki Page: |
Description
I've just hacked it in:
$ ghci -XTemplateHaskell GHCi, version 7.1.20110630: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. Loading package ffi-1.0 ... linking ... done. λ> import Language.Haskell.TH λ> runQ [d| data T = T {-# UNPACK #-} !Int |] Loading package array-0.3.0.2 ... linking ... done. Loading package containers-0.4.0.0 ... linking ... done. Loading package pretty-1.0.2.0 ... linking ... done. Loading package template-haskell ... linking ... done. [DataD [] T [] [NormalC T [(Unpacked,ConT GHC.Types.Int)]] []] λ>
TH.hs:
{-# LANGUAGE TemplateHaskell #-} module TH where import Language.Haskell.TH d :: Q [Dec] d = return [DataD [] n [] [NormalC n [(Unpacked,ConT ''Int)]] []] where n = mkName "T"
Main.hs:
{-# LANGUAGE TemplateHaskell #-} import TH $(d) instance Show T where show (T i) = show i main = putStrLn $ show (T 10)
Compiling and running:
$ ghc -ddump-splices -fforce-recomp Main.hs [1 of 2] Compiling TH ( TH.hs, TH.o ) [2 of 2] Compiling Main ( Main.hs, Main.o ) Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. Loading package ffi-1.0 ... linking ... done. Loading package pretty-1.0.2.0 ... linking ... done. Loading package array-0.3.0.2 ... linking ... done. Loading package containers-0.4.0.0 ... linking ... done. Loading package template-haskell ... linking ... done. Main.hs:1:1: Splicing declarations d ======> Main.hs:5:3 data T = T {-# UNPACK #-} !Int Linking Main ... $ ./Main 10
Please consider merging.
Attachments (2)
Change History (6)
Changed 8 years ago by
Attachment: | th-unpacked.patch added |
---|
comment:1 Changed 8 years ago by
Status: | new → patch |
---|
comment:2 Changed 8 years ago by
Milestone: | → 7.4.1 |
---|---|
Priority: | normal → high |
comment:3 Changed 8 years ago by
Status: | patch → merge |
---|---|
Test Case: | → th/T5290 |
Thanks. Seemed to fit into the existing data types quite nicely. I applied yoru patches. (Something went wrong with using your patches verbatim, so you are only credited as author in the commit message.)
commit 65c019407134fcb0c6b7c9d2038ba07c52e2a6c2 Author: Simon Peyton Jones <simonpj@microsoft.com> Date: Fri Jul 15 21:15:43 2011 +0100 Extend Template Haskell to support the UNPACk pragma on data constructors (Work done by mikhail.vorozhtsov.) compiler/hsSyn/Convert.lhs | 1 + 1 files changed, 1 insertions(+), 0 deletions(-)
and in the TH lib
commit 15f68f57ca685933d18d88655e91ea692ccd198f Author: Simon Peyton Jones <simonpj@microsoft.com> Date: Mon Jul 18 23:25:51 2011 +0100 Add TH support for UNPACK pragmas (Trac #5290) The extension is nice, because it just adds an extra constructor to the existing data type 'Strict'. Thanks to Mikhail Vorozhtsov. Language/Haskell/TH/Lib.hs | 3 ++- Language/Haskell/TH/Ppr.hs | 1 + Language/Haskell/TH/Syntax.hs | 2 +- 3 files changed, 4 insertions(+), 2 deletions(-)
Could merge to 7.2
Simon
comment:4 Changed 8 years ago by
Resolution: | → fixed |
---|---|
Status: | merge → closed |
I think it's too late for new features in the 7.2 branch, sorry.
Note: See
TracTickets for help on using
tickets.
Patch for the template-haskell library