Change desugaring of PArr literals

diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs
index f152ff5..6cbd538 100644 (file)
--- a/compiler/deSugar/DsExpr.lhs
+++ b/compiler/deSugar/DsExpr.lhs
@@ -315,20 +315,20 @@ dsExpr (HsIf guard_expr then_expr else_expr)
 dsExpr (ExplicitList elt_ty xs) 
   = dsExplicitList elt_ty xs
 
--- we create a list from the array elements and convert them into a list using
--- `PrelPArr.toP'
---
---  * the main disadvantage to this scheme is that `toP' traverses the list
---   twice: once to determine the length and a second time to put to elements
---   into the array; this inefficiency could be avoided by exposing some of
---   the innards of `PrelPArr' to the compiler (ie, have a `PrelPArrBase') so
---   that we can exploit the fact that we already know the length of the array
---   here at compile time
+-- We desugar [:x1, ..., xn:] as
+--   singletonP x1 +:+ ... +:+ singletonP xn
 --
+dsExpr (ExplicitPArr ty []) = do
+    emptyP <- dsLookupGlobalId emptyPName
+    return (Var emptyP `App` Type ty)
 dsExpr (ExplicitPArr ty xs) = do
-    toP <- dsLookupGlobalId toPName
-    coreList <- dsExpr (ExplicitList ty xs)
-    return (mkApps (Var toP) [Type ty, coreList])
+    singletonP <- dsLookupGlobalId singletonPName
+    appP       <- dsLookupGlobalId appPName
+    xs'        <- mapM dsLExpr xs
+    return . foldr1 (binary appP) $ map (unary singletonP) xs'
+  where
+    unary  fn x   = mkApps (Var fn) [Type ty, x]
+    binary fn x y = mkApps (Var fn) [Type ty, x, y]
 
 dsExpr (ExplicitTuple expr_list boxity) = do
     core_exprs <- mapM dsLExpr expr_list

diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index efba489..1879261 100644 (file)
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -182,7 +182,7 @@ basicKnownKeyNames
         -- Parallel array operations
        nullPName, lengthPName, replicatePName, singletonPName, mapPName,
        filterPName, zipPName, crossMapPName, indexPName,
-       toPName, bpermutePName, bpermuteDftPName, indexOfPName,
+       toPName, emptyPName, appPName,
 
        -- FFI primitive types that are not wired-in.
        stablePtrTyConName, ptrTyConName, funPtrTyConName,
@@ -705,8 +705,8 @@ readClassName          = clsQual gHC_READ (fsLit "Read") readClassKey
 -- parallel array types and functions
 enumFromToPName, enumFromThenToPName, nullPName, lengthPName,
     singletonPName, replicatePName, mapPName, filterPName,
-    zipPName, crossMapPName, indexPName, toPName, bpermutePName,
-    bpermuteDftPName, indexOfPName :: Name
+    zipPName, crossMapPName, indexPName, toPName,
+    emptyPName, appPName :: Name
 enumFromToPName           = varQual gHC_PARR (fsLit "enumFromToP") enumFromToPIdKey
 enumFromThenToPName= varQual gHC_PARR (fsLit "enumFromThenToP") enumFromThenToPIdKey
 nullPName        = varQual gHC_PARR (fsLit "nullP")             nullPIdKey
@@ -719,9 +719,8 @@ zipPName      = varQual gHC_PARR (fsLit "zipP")              zipPIdKey
 crossMapPName    = varQual gHC_PARR (fsLit "crossMapP")         crossMapPIdKey
 indexPName       = varQual gHC_PARR (fsLit "!:")                indexPIdKey
 toPName                  = varQual gHC_PARR (fsLit "toP")               toPIdKey
-bpermutePName     = varQual gHC_PARR (fsLit "bpermuteP")    bpermutePIdKey
-bpermuteDftPName  = varQual gHC_PARR (fsLit "bpermuteDftP") bpermuteDftPIdKey
-indexOfPName      = varQual gHC_PARR (fsLit "indexOfP")     indexOfPIdKey
+emptyPName        = varQual gHC_PARR (fsLit "emptyP")            emptyPIdKey
+appPName          = varQual gHC_PARR (fsLit "+:+")               appPIdKey
 
 -- IOBase things
 ioTyConName, ioDataConName, thenIOName, bindIOName, returnIOName,
@@ -1177,8 +1176,7 @@ groupWithIdKey        = mkPreludeMiscIdUnique 70
 -- Parallel array functions
 singletonPIdKey, nullPIdKey, lengthPIdKey, replicatePIdKey, mapPIdKey,
     filterPIdKey, zipPIdKey, crossMapPIdKey, indexPIdKey, toPIdKey,
-    enumFromToPIdKey, enumFromThenToPIdKey,
-    bpermutePIdKey, bpermuteDftPIdKey, indexOfPIdKey :: Unique
+    enumFromToPIdKey, enumFromThenToPIdKey, emptyPIdKey, appPIdKey :: Unique
 singletonPIdKey               = mkPreludeMiscIdUnique 79
 nullPIdKey                   = mkPreludeMiscIdUnique 80
 lengthPIdKey                 = mkPreludeMiscIdUnique 81
@@ -1191,9 +1189,8 @@ indexPIdKey                     = mkPreludeMiscIdUnique 87
 toPIdKey                     = mkPreludeMiscIdUnique 88
 enumFromToPIdKey              = mkPreludeMiscIdUnique 89
 enumFromThenToPIdKey          = mkPreludeMiscIdUnique 90
-bpermutePIdKey               = mkPreludeMiscIdUnique 91
-bpermuteDftPIdKey            = mkPreludeMiscIdUnique 92
-indexOfPIdKey                = mkPreludeMiscIdUnique 93
+emptyPIdKey                   = mkPreludeMiscIdUnique 91
+appPIdKey                     = mkPreludeMiscIdUnique 92
 
 -- dotnet interop
 unmarshalObjectIdKey, marshalObjectIdKey, marshalStringIdKey,