[Template-haskell] Representation of unboxed primitives in TH
Ian Lynagh
igloo@earth.li
Tue, 22 Apr 2003 22:16:39 +0100
--FL5UXtIhxfXey3p5
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
On Tue, Apr 22, 2003 at 03:55:44PM +0100, Simon Peyton-Jones wrote:
> I'm not certain that your fix is right, Ian. You are saying that
>
> (I# 30#)
>
> is represented in THSyntax is
>
> (I# 30)
No, this is *in addition* to having a new sort of Lit etc. The problem
seemed to be that dsLit was returning a different sort of value - I
forget the details now - for IntPrims to Int and Integers, so I rewrote
the literal for just that phase. I'm now wondering if it was making it
an Int while I was using it as an Integer.
Which brings me to another question - in the HsLit datatype an Int# is
stored as an Integer - why not an Int?
I've attached the diff which I hope will make it clearer.
(The HEAD seems to be broken again so I can't test this, but I *think*
I've got everything in).
> The question is whether you want to be able to represent unboxed Ints in
> THSyntax, which is meant to be "nice and simple". Perhaps yes, because
> you want to get GHC extensions through it; in that case THSyntax.Lit
> would need an extra constructor. But perhaps no, because it's meant to
> be simple. The more that gets added to THSyntax, the more any program
> analysing THSyntax needs to do.
Well, it's already more than Haskell98, so I didn't think there would be
any problem extending it to cover everything. I guess you could argue
the other things are being developed in the hope they will go into
Haskell 2, though.
Programmers are free to return an error if given a non-H98
datastructure, although it is a pity Haskell has no way to allow you to
define a function on a subset of a datatype so warnings of unhandled
cases would still be useful.
Thanks
Ian
--FL5UXtIhxfXey3p5
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename=diff
Index: ghc/compiler/deSugar/DsMeta.hs
===================================================================
RCS file: /home/cvs/root/fptools/ghc/compiler/deSugar/DsMeta.hs,v
retrieving revision 1.33
diff -u -r1.33 DsMeta.hs
--- ghc/compiler/deSugar/DsMeta.hs 22 Apr 2003 20:39:59 -0000 1.33
+++ ghc/compiler/deSugar/DsMeta.hs 22 Apr 2003 20:59:07 -0000
@@ -1118,11 +1118,15 @@
repLiteral :: HsLit -> DsM (Core M.Lit)
repLiteral lit
- = do { lit_expr <- dsLit lit; rep2 lit_name [lit_expr] }
+ = do { lit_expr <- dsLit lit'; rep2 lit_name [lit_expr] }
where
+ lit' = case lit of
+ HsIntPrim i -> HsInteger i
+ _ -> lit
lit_name = case lit of
HsInteger _ -> integerLName
HsInt _ -> integerLName
+ HsIntPrim _ -> intPrimLName
HsChar _ -> charLName
HsString _ -> stringLName
HsRat _ _ -> rationalLName
@@ -1200,7 +1204,7 @@
-- The names that are implicitly mentioned by ``bracket''
-- Should stay in sync with the import list of DsMeta
templateHaskellNames
- = mkNameSet [ integerLName, charLName, stringLName, rationalLName,
+ = mkNameSet [ intPrimLName, integerLName, charLName, stringLName, rationalLName,
plitName, pvarName, ptupName,
pconName, ptildeName, paspatName, pwildName,
varName, conName, litName, appName, infixEName, lamName,
@@ -1236,6 +1240,7 @@
mk_known_key_name space str uniq
= mkKnownKeyExternalName thModule (mkOccFS space str) uniq
+intPrimLName = varQual FSLIT("intPrimL") intPrimLIdKey
integerLName = varQual FSLIT("integerL") integerLIdKey
charLName = varQual FSLIT("charL") charLIdKey
stringLName = varQual FSLIT("stringL") stringLIdKey
@@ -1459,6 +1464,8 @@
precIdKey = mkPreludeMiscIdUnique 272
fieldKey = mkPreludeMiscIdUnique 273
fieldPKey = mkPreludeMiscIdUnique 274
+
+intPrimLIdKey = mkPreludeMiscIdUnique 275
-- %************************************************************************
-- %* *
Index: ghc/compiler/hsSyn/Convert.lhs
===================================================================
RCS file: /home/cvs/root/fptools/ghc/compiler/hsSyn/Convert.lhs,v
retrieving revision 1.25
diff -u -r1.25 Convert.lhs
--- ghc/compiler/hsSyn/Convert.lhs 22 Apr 2003 20:40:00 -0000 1.25
+++ ghc/compiler/hsSyn/Convert.lhs 22 Apr 2003 20:59:08 -0000
@@ -258,8 +258,9 @@
-- Similarly 3.5 for fractionals
cvtLit :: Lit -> HsLit
-cvtLit (Char c) = HsChar (ord c)
-cvtLit (String s) = HsString (mkFastString s)
+cvtLit (IntPrim i) = HsIntPrim i
+cvtLit (Char c) = HsChar (ord c)
+cvtLit (String s) = HsString (mkFastString s)
cvtp :: Meta.Pat -> Hs.Pat RdrName
cvtp (Plit l)
Index: libraries/haskell-src/Language/Haskell/THSyntax.hs
===================================================================
RCS file: /home/cvs/root/fptools/libraries/haskell-src/Language/Haskell/THSyntax.hs,v
retrieving revision 1.25
diff -u -r1.25 THSyntax.hs
--- libraries/haskell-src/Language/Haskell/THSyntax.hs 22 Apr 2003 20:40:00 -0000 1.25
+++ libraries/haskell-src/Language/Haskell/THSyntax.hs 22 Apr 2003 20:59:15 -0000
@@ -59,6 +59,9 @@
instance Lift Integer where
lift = return . Lit . Integer
+instance Lift Int# where
+ lift = return $ Lit $ IntPrim $ fromIntegral (I# i)
+
instance Lift Int where
lift = return . Lit . Integer . fromIntegral
@@ -81,6 +84,7 @@
| Integer Integer -- Used for overloaded and non-overloaded literals
-- We don't have a good way to represent non-overloaded
-- literals at the moment. Maybe that doesn't matter?
+ | IntPrim Integer
| Rational Rational -- Ditto
deriving( Show )
@@ -231,6 +235,7 @@
-------------------- Lowercase pattern syntax functions ---
+intPrimL = IntPrim
integerL = Integer
charL = Char
stringL = String
@@ -611,6 +616,7 @@
------------------------------
pprLit :: Precedence -> Lit -> Doc
+pprLit i (IntPrim x) = parensIf (i > noPrec && x < 0) (integer x <> char '#')
pprLit i (Integer x) = parensIf (i > noPrec && x < 0) (integer x)
pprLit _ (Char c) = text (show c)
pprLit _ (String s) = text (show s)
--FL5UXtIhxfXey3p5--