diff options
| author | simonpj@microsoft.com <unknown> | 2009-07-23 06:38:59 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2009-07-23 06:38:59 +0000 |
| commit | 58521c72cec262496dabf5fffb057d25ab17a0f7 (patch) | |
| tree | f751884ebd8c6934713a2d93e986e2a40e6d3294 /compiler/deSugar/DsArrows.lhs | |
| parent | 4b8dfb01980b44bc3284c87aadeada130f94f85f (diff) | |
| download | haskell-58521c72cec262496dabf5fffb057d25ab17a0f7.tar.gz | |
Add tuple sections as a new feature
This patch adds tuple sections, so that
(x,,z) means \y -> (x,y,z)
Thanks for Max Bolinbroke for doing the hard work.
In the end, instead of using two constructors in HsSyn, I used
just one (still called ExplicitTuple) whose arguments can be
Present (LHsExpr id)
or Missing PostTcType
While I was at it, I did a bit of refactoring too.
Diffstat (limited to 'compiler/deSugar/DsArrows.lhs')
| -rw-r--r-- | compiler/deSugar/DsArrows.lhs | 15 |
1 files changed, 5 insertions, 10 deletions
diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs index 76117b3474..cead3dd541 100644 --- a/compiler/deSugar/DsArrows.lhs +++ b/compiler/deSugar/DsArrows.lhs @@ -217,16 +217,11 @@ matchVarStack env_id (stack_id:stack_ids) body = do \end{code} \begin{code} -mkHsTupleExpr :: [HsExpr Id] -> HsExpr Id -mkHsTupleExpr [e] = e -mkHsTupleExpr es = ExplicitTuple (map noLoc es) Boxed - -mkHsPairExpr :: HsExpr Id -> HsExpr Id -> HsExpr Id -mkHsPairExpr e1 e2 = mkHsTupleExpr [e1, e2] - -mkHsEnvStackExpr :: [Id] -> [Id] -> HsExpr Id +mkHsEnvStackExpr :: [Id] -> [Id] -> LHsExpr Id mkHsEnvStackExpr env_ids stack_ids - = foldl mkHsPairExpr (mkHsTupleExpr (map HsVar env_ids)) (map HsVar stack_ids) + = foldl (\a b -> mkLHsTupleExpr [a,b]) + (mkLHsVarTuple env_ids) + (map nlHsVar stack_ids) \end{code} Translation of arrow abstraction @@ -479,7 +474,7 @@ dsCmd ids local_vars env_ids stack res_ty (HsCase exp (MatchGroup matches match_ (core_leaf, fvs, leaf_ids) <- dsfixCmd ids (local_vars `unionVarSet` bound_vars) stack res_ty leaf return (fvs `minusVarSet` bound_vars, - [noLoc $ mkHsEnvStackExpr leaf_ids stack_ids], + [mkHsEnvStackExpr leaf_ids stack_ids], envStackType leaf_ids stack, core_leaf) |