From dc77f1919b6d85c2b411e810951d310d3b8db08c Mon Sep 17 00:00:00 2001
From: igloo <unknown>
Date: Sun, 4 May 2003 13:21:49 +0000
Subject: [PATCH] [project @ 2003-05-04 13:21:48 by igloo] Add support for
 unboxed Ints, Floats and Doubles to Template Haskell.

---
 ghc/compiler/deSugar/DsMeta.hs |   36 ++++++++++++++++++++++++++++--------
 ghc/compiler/hsSyn/Convert.lhs |    7 +++++--
 2 files changed, 33 insertions(+), 10 deletions(-)

diff --git a/ghc/compiler/deSugar/DsMeta.hs b/ghc/compiler/deSugar/DsMeta.hs
index 794ec3d..048660f 100644
--- a/ghc/compiler/deSugar/DsMeta.hs
+++ b/ghc/compiler/deSugar/DsMeta.hs
@@ -1118,15 +1118,27 @@ repListTyCon = rep2 listTyConName []
 
 repLiteral :: HsLit -> DsM (Core M.Lit)
 repLiteral lit 
-  = do { lit_expr <- dsLit lit; rep2 lit_name [lit_expr] }
+  = do lit' <- case lit of
+                   HsIntPrim i -> return $ HsInteger i
+                   HsInt i -> return $ HsInteger i
+                   HsFloatPrim r -> do rat_ty <- lookupType rationalTyConName
+                                       return $ HsRat r rat_ty
+                   HsDoublePrim r -> do rat_ty <- lookupType rationalTyConName
+                                        return $ HsRat r rat_ty
+                   _ -> return lit
+       lit_expr <- dsLit lit'
+       rep2 lit_name [lit_expr]
   where
     lit_name = case lit of
-		 HsInteger _ -> integerLName
-		 HsInt     _ -> integerLName
-		 HsChar _    -> charLName
-		 HsString _  -> stringLName
-		 HsRat _ _   -> rationalLName
-		 other 	     -> uh_oh
+		 HsInteger _    -> integerLName
+		 HsInt     _    -> integerLName
+		 HsIntPrim _    -> intPrimLName
+		 HsFloatPrim _  -> floatPrimLName
+		 HsDoublePrim _ -> doublePrimLName
+		 HsChar _       -> charLName
+		 HsString _     -> stringLName
+		 HsRat _ _      -> rationalLName
+		 other 	        -> uh_oh
     uh_oh = pprPanic "DsMeta.repLiteral: trying to represent exotic literal"
 		    (ppr lit)
 
@@ -1200,7 +1212,8 @@ templateHaskellNames :: NameSet
 -- 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, floatPrimLName, doublePrimLName,
+        integerLName, charLName, stringLName, rationalLName,
 		plitName, pvarName, ptupName, 
 		pconName, ptildeName, paspatName, pwildName, 
                 varName, conName, litName, appName, infixEName, lamName,
@@ -1236,6 +1249,9 @@ thModule = mkThPkgModule mETA_META_Name
 mk_known_key_name space str uniq 
   = mkKnownKeyExternalName thModule (mkOccFS space str) uniq 
 
+intPrimLName   = varQual FSLIT("intPrimL")      intPrimLIdKey
+floatPrimLName  = varQual FSLIT("floatPrimL")   floatPrimLIdKey
+doublePrimLName = varQual FSLIT("doublePrimL")  doublePrimLIdKey
 integerLName   = varQual FSLIT("integerL")      integerLIdKey
 charLName      = varQual FSLIT("charL")         charLIdKey
 stringLName    = varQual FSLIT("stringL")       stringLIdKey
@@ -1460,6 +1476,10 @@ precIdKey       = mkPreludeMiscIdUnique 272
 fieldKey        = mkPreludeMiscIdUnique 273
 fieldPKey       = mkPreludeMiscIdUnique 274
 
+intPrimLIdKey    = mkPreludeMiscIdUnique 275
+floatPrimLIdKey  = mkPreludeMiscIdUnique 276
+doublePrimLIdKey = mkPreludeMiscIdUnique 277
+
 -- %************************************************************************
 -- %*									*
 --		Other utilities
diff --git a/ghc/compiler/hsSyn/Convert.lhs b/ghc/compiler/hsSyn/Convert.lhs
index 4e610cb..e286b43 100644
--- a/ghc/compiler/hsSyn/Convert.lhs
+++ b/ghc/compiler/hsSyn/Convert.lhs
@@ -258,8 +258,11 @@ cvtOverLit (Rational r) = mkHsFractional r
 -- 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 (FloatPrim f)  = HsFloatPrim f
+cvtLit (DoublePrim f) = HsDoublePrim f
+cvtLit (Char c)       = HsChar (ord c)
+cvtLit (String s)     = HsString (mkFastString s)
 
 cvtp :: Meta.Pat -> Hs.Pat RdrName
 cvtp (Plit l)
-- 
1.7.10.4