haste-compiler 0.2.5 → 0.2.6

raw patch · 3 files changed

+25/−8 lines, 3 files

Files

• haste-compiler.cabal +1/−1
• src/Data/JSTarget/Optimize.hs +23/−6
• src/Haste/Version.hs +1/−1

@@ -1,5 +1,5 @@ Name:           haste-compiler-Version:        0.2.5+Version:        0.2.6 License:        BSD3 License-File:   LICENSE Synopsis:       Haskell To ECMAScript compiler

@@ -18,12 +18,19 @@   flip runTravM js $ do     shrinkCase ast     >>= inlineAssigns True+    >>= optimizeArrays     >>= inlineReturns     >>= optimizeThunks+    >>= optimizeArrays     >>= tailLoopify f  topLevelInline :: AST Stm -> AST Stm-topLevelInline (AST ast js) = runTravM (inlineAssigns False ast) js+topLevelInline (AST ast js) =+  flip runTravM js $ do+    inlineAssigns False ast+    >>= optimizeArrays+    >>= optimizeThunks+    >>= optimizeArrays  -- | Attempt to turn two case branches into a ternary operator expression. tryTernary :: Var@@ -91,7 +98,7 @@ inlineAssigns :: JSTrav ast => Bool -> ast -> TravM ast inlineAssigns blackholeOK ast = do     inlinable <- gatherInlinable ast-    mapJS (const True) inlEx (inl inlinable) ast+    mapJS (const True) return (inl inlinable) ast   where     varOccurs lhs (Exp (Var lhs')) = lhs == lhs'     varOccurs _ _                  = False@@ -110,8 +117,8 @@                 Once | mayReorder -> do                   replaceEx (not <$> isShared) (Var lhs) ex next                 -- Don't inline lambdas, but use less verbose syntax.-                _     | Fun Nothing vs body <- ex,-                        Internal lhsname _ <- lhs -> do+                _    | Fun Nothing vs body <- ex,+                       Internal lhsname _ <- lhs -> do                   return $ Assign blackHole (Fun (Just lhsname) vs body) next                 _ -> do                   return keep@@ -121,6 +128,12 @@           return keep     inl _ stm = return stm ++-- | Turn occurrences of [a,b][1] into b.+optimizeArrays :: JSTrav ast => ast -> TravM ast+optimizeArrays ast =+    mapJS (const True) inlEx return ast+  where     inlEx (Index (Arr xs) (Lit (LNum n))) =       return $ xs !! truncate n     inlEx x =@@ -130,12 +143,16 @@ -- | Optimize thunks in the following ways: --   A(thunk(return f), xs) --     => A(f, xs)+--   E(thunk(return x))+--     => x optimizeThunks :: JSTrav ast => ast -> TravM ast optimizeThunks ast =     mapJS (const True) optEx return ast   where-    optEx (Call arity Normal f args) | Just f' <- fromThunkEx f =-      return $ Call arity Normal f' args+    optEx (Call _ _ (Var (Foreign "E")) [x]) | Just x' <- fromThunkEx x =+      return x'+    optEx (Call arity calltype f args) | Just f' <- fromThunkEx f =+      return $ Call arity calltype f' args     optEx ex =       return ex 

@@ -10,7 +10,7 @@ import Haste.Environment (hasteDir)  hasteVersion :: Version-hasteVersion = Version [0, 2, 5] []+hasteVersion = Version [0, 2, 6] []  ghcVersion :: String ghcVersion = cProjectVersion