fay 0.18.0.5 → 0.18.1

raw patch · 6 files changed

+33/−2 lines, 6 files

Files

• fay.cabal +1/−1
• src/Fay/Compiler/Desugar.hs +20/−1
• src/Fay/Compiler/Exp.hs +1/−0
• src/Fay/Compiler/Misc.hs +1/−0
• tests/tupleSec.hs +7/−0
• tests/tupleSec.res +3/−0

@@ -1,5 +1,5 @@ name:                fay-version:             0.18.0.5+version:             0.18.1 synopsis:            A compiler for Fay, a Haskell subset that compiles to JavaScript. description:         Fay is a proper subset of Haskell which is type-checked                      with GHC, and compiled to JavaScript. It is lazy, pure, has a Fay monad,

@@ -111,7 +111,7 @@   Do _ stmts -> maybe (throwError EmptyDoBlock) return =<< (mmap desugarExp $ foldl desugarStmt' Nothing (reverse stmts))   MDo l ss -> MDo l <$> mapM desugarStmt ss   Tuple l b es -> Tuple l b <$> mapM desugarExp es-  TupleSection l b mes -> TupleSection l b <$> mapM (mmap desugarExp) mes+  TupleSection l _ mes -> desugarTupleSec l =<< (mapM (mmap desugarExp) mes)   List l es -> List l <$> mapM desugarExp es   Paren l e -> Paren l <$> desugarExp e   RecConstr l q f -> RecConstr l (desugarQName q) <$> mapM desugarFieldUpdate f@@ -267,3 +267,22 @@       params = PVar l <$> names       body   = Tuple l b (Var l . UnQual l <$> names)   _ -> Nothing++desugarTupleSec :: l -> [Maybe (Exp l)] -> Desugar (Exp l)+desugarTupleSec l xs = do+    (names, lst) <- genSlotNames l xs (varNames l)+    return $ Lambda l (map (PVar l) names) (Tuple l Unboxed lst)+  where+    varNames :: l -> [Name l]+    varNames l = map (\i -> Ident l ("$gen_" ++ show i)) [0::Int ..]++    genSlotNames :: l -> [Maybe (Exp l)] -> [Name l] -> Desugar ([Name l], [Exp l])+    genSlotNames _ [] _ = return ([], [])+    genSlotNames l (Nothing : rest) ns = do+      -- it's safe to use head/tail here because ns is an infinite list+      (rn, re) <- genSlotNames l rest (tail ns)+      return (head ns : rn, Var l (UnQual l (head ns)) : re)+    genSlotNames l (Just e : rest) ns = do+      (rn, re) <- genSlotNames l rest ns+      e' <- desugarExp e+      return (rn, e' : re)

@@ -60,6 +60,7 @@   Do {}                              -> shouldBeDesugared exp   LeftSection {}                     -> shouldBeDesugared exp   RightSection {}                    -> shouldBeDesugared exp+  TupleSection {}                    -> shouldBeDesugared exp   ExpTypeSig _ exp sig               ->     case ffiExp exp of       Nothing -> compileExp exp

@@ -333,5 +333,6 @@   ,FlexibleContexts   ,FlexibleInstances   ,KindSignatures+  ,TupleSections   ] ++ map DisableExtension   [ImplicitPrelude]

@@ -0,0 +1,7 @@+{-# LANGUAGE TupleSections #-}+import Prelude++main = do+    print $ (,2) 1+    print $ (,2,,4,,6) 1 3 5+    print $ fst (((1,),) 3) 2

@@ -0,0 +1,3 @@+[ 1, 2 ]+[ 1, 2, 3, 4, 5, 6 ]+[ 1, 2 ]