Commit ac808e64 authored by rl@cse.unsw.edu.au's avatar rl@cse.unsw.edu.au
Browse files

Change desugaring of PArr literals

parent 1b41ef08
......@@ -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
......
......@@ -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,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment