From ac808e641e285df89b8f1bcda95b6e859bb4e4ab Mon Sep 17 00:00:00 2001 From: Roman Leshchinskiy Date: Fri, 12 Sep 2008 01:56:09 +0000 Subject: [PATCH] Change desugaring of PArr literals --- compiler/deSugar/DsExpr.lhs | 24 ++++++++++++------------ compiler/prelude/PrelNames.lhs | 19 ++++++++----------- 2 files changed, 20 insertions(+), 23 deletions(-) diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs index f152ff5..6cbd538 100644 --- 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 --- 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, -- 1.7.10.4