haste-compiler 0.2.8 → 0.2.9

raw patch · 5 files changed

+50/−11 lines, 5 files

Files

• LICENSE +1/−1
• haste-compiler.cabal +1/−1
• src/Data/JSTarget/Optimize.hs +43/−8
• src/Data/JSTarget/Traversal.hs +4/−0
• src/Haste/Version.hs +1/−1

@@ -13,7 +13,7 @@       disclaimer in the documentation and/or other materials provided       with the distribution. -    * Neither the name of Milan Straka nor the names of other+    * Neither the name of Anton Ekblad nor the names of other       contributors may be used to endorse or promote products derived       from this software without specific prior written permission. 

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

@@ -20,9 +20,11 @@     >>= inlineAssigns True     >>= optimizeArrays     >>= inlineReturns+    >>= zapJSStringConversions     >>= optimizeThunks     >>= optimizeArrays     >>= tailLoopify f+    >>= ifReturnToTernary  topLevelInline :: AST Stm -> AST Stm topLevelInline (AST ast js) =@@ -129,6 +131,16 @@     inl _ stm = return stm  +-- | Turn if(foo) {return bar;} else {return baz;} into return foo ? bar : baz.+ifReturnToTernary :: JSTrav ast => ast -> TravM ast+ifReturnToTernary ast = do+    mapJS (const True) return opt ast+  where+    opt (Case cond (Return el) [(ex, Return th)] _) =+      pure $ Return $ IfEx (BinOp Eq cond ex) th el+    opt stm =+      pure stm+ -- | Turn occurrences of [a,b][1] into b. optimizeArrays :: JSTrav ast => ast -> TravM ast optimizeArrays ast =@@ -140,17 +152,38 @@       return x  +-- | Turn toJSStr(unCStr(x)) into x, since rewrite rules absolutely refuse+--   to work with unpackCString#.+--   Also turn T(unCStr(x)) into unCStr(x) whenever x is a literal, since+--   unCStr is evaluated lazily anyway.+zapJSStringConversions :: JSTrav ast => ast -> TravM ast+zapJSStringConversions ast =+    mapJS (const True) opt return ast+  where+    opt (Call _ _ (Var (Foreign "toJSStr"))+       [Call _ _ (Var (Foreign "unCStr")) [x]]) =+      return x+    opt (Call _ _ (Var (Foreign "new T"))+         [Fun _ [] (Return x@(Call _ _ (Var (Foreign "unCStr")) [Lit _]))]) =+      return x+    opt x =+      return x++ -- | Optimize thunks in the following ways: --   A(thunk(return f), xs) --     => A(f, xs) --   E(thunk(return x)) --     => x+--   E(\x ... -> ...)+--     => \x ... -> ... optimizeThunks :: JSTrav ast => ast -> TravM ast optimizeThunks ast =     mapJS (const True) optEx return ast   where-    optEx (Call _ _ (Var (Foreign "E")) [x]) | Just x' <- fromThunkEx x =-      return x'+    optEx (Call _ _ (Var (Foreign "E")) [x])+      | Just x' <- fromThunkEx x = return x'+      | Fun _ _ _ <- x           = return x     optEx (Call arity calltype f args) | Just f' <- fromThunkEx f =       return $ Call arity calltype f' args     optEx ex =@@ -176,18 +209,20 @@  -- | Gather a map of all inlinable symbols; that is, the once that are used --   exactly once.+--   TODO: always inline assigns that are just aliases! gatherInlinable :: JSTrav ast => ast -> TravM (M.Map Var Occs)-gatherInlinable =-    fmap (M.filter (< Lots)) . foldJS (\_ _ -> True) countOccs M.empty+gatherInlinable ast = do+    m <- foldJS (\_ _->True) countOccs (M.empty) ast+    return (M.filter (< Lots) m)   where     updVar (Just occs) = Just (occs+Once)     updVar _           = Just Once     updVarAss (Just o) = Just o     updVarAss _        = Just Never     countOccs m (Exp (Var v@(Internal _ _))) =-      pure $ M.alter updVar v m+      pure (M.alter updVar v m)     countOccs m (Stm (Assign (NewVar _ v) _ _)) =-      pure $ M.alter updVarAss v m+      pure (M.alter updVarAss v m)     countOccs m _ =       pure m @@ -298,7 +333,7 @@       else do         return fun   where-    isTailRec (Stm (Return (Call 0 _ (Var f') _))) = f == f'+    isTailRec (Stm (Return (Call _ _ (Var f') _))) = f == f'     isTailRec _                                    = False          -- Only traverse until we find a closure@@ -307,7 +342,7 @@     isClosure acc _               = pure acc      -- Assign any changed vars, then loop.-    replaceByAssign end as (Return (Call 0 _ (Var f') as')) | f == f' = do+    replaceByAssign end as (Return (Call _ _ (Var f') as')) | f == f' = do       let (first, second) = foldr assignUnlessEqual (id, end) (zip as as')       return $ first second     replaceByAssign _ _ stm =

@@ -277,6 +277,10 @@ isLambda (Exp (Fun _ _ _)) = True isLambda _                 = False +isJump :: ASTNode -> Bool+isJump (Stm (Jump _)) = True+isJump _              = False+ -- | Counts occurrences. Use ints or something for a more exact count. data Occs = Never | Once | Lots deriving (Eq, Show) 

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