85a3aa6 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

More performance tweaks

commit85a3aa6a7ed601901e331ef7a9546a0d13b238c7 authorRyan Trinkle <ryan.trinkle@gmail.com> dateTue 5 Sep 2017, 14:19 (9 years ago) parent1630226

8 files changed+32−27

compare with develop

unifiedsplit

reflex-dom-core/reflex-dom-core.cabal+1−1 reflex-dom-core/src/Foreign/JavaScript/TH.hs+4 reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+1−1 reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+18−22 reflex-dom-core/src/Reflex/Dom/Builder/Static.hs+4 reflex-dom-core/src/Reflex/Dom/Main.hs+1 reflex-dom/benchmarks/krausest.hs+1−1 reflex-dom/reflex-dom.cabal+2−2

reflex-dom-core/reflex-dom-core.cabal+1−1

@@ -119,7 +119,7 @@ library

119119 Reflex.Dom.Xhr.ResponseType

120120 Reflex.Dom.Xhr.Exception

121121

122− ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans

122+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans -fspecialise-aggressively -ddump-simpl -ddump-to-file -dsuppress-coercions -dsuppress-idinfo

123123 ghc-prof-options: -fprof-auto

124124

125125 if flag(expose-all-unfoldings)

reflex-dom-core/src/Foreign/JavaScript/TH.hs+4

@@ -170,6 +170,10 @@ instance MonadHold t m => MonadHold t (WithJSContextSingleton x m) where

170170 holdDyn v0 = lift . holdDyn v0

171171 {-# INLINABLE holdIncremental #-}

172172 holdIncremental v0 = lift . holdIncremental v0

173+ {-# INLINABLE buildDynamic #-}

174+ buildDynamic a0 = lift . buildDynamic a0

175+ {-# INLINABLE headE #-}

176+ headE = lift . headE

173177

174178instance MonadTransControl (WithJSContextSingleton x) where

175179 type StT (WithJSContextSingleton x) a = StT (ReaderT (JSContextSingleton x)) a

reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+1−1

@@ -610,7 +610,7 @@ class HasDomEvent t target eventName where

610610instance Reflex t => HasDomEvent t (Element EventResult d t) en where

611611 type DomEventType (Element EventResult d t) en = EventResultType en

612612 {-# INLINABLE domEvent #-}

613− domEvent en e = unEventResult <$> Reflex.select (_element_events e) (WrapArg en)

613+ domEvent en e = coerceEvent $ Reflex.select (_element_events e) (WrapArg en)

614614

615615instance Reflex t => HasDomEvent t (InputElement EventResult d t) en where

616616 type DomEventType (InputElement EventResult d t) en = EventResultType en

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+18−22

@@ -22,6 +22,10 @@

2222{-# LANGUAGE TypeFamilies #-}

2323{-# LANGUAGE TypeOperators #-}

2424{-# LANGUAGE UndecidableInstances #-}

25+#ifdef ghcjs_HOST_OS

26+{-# LANGUAGE ForeignFunctionInterface #-}

27+{-# LANGUAGE JavaScriptFFI #-}

28+#endif

2529module Reflex.Dom.Builder.Immediate

2630 ( EventTriggerRef (..)

2731 , ImmediateDomBuilderEnv (..)

@@ -297,16 +301,7 @@ deleteBetweenExclusive s e = liftJSM $ do

297301-- and e will not be moved

298302extractBetweenExclusive :: (MonadJSM m, IsNode start, IsNode end) => DOM.DocumentFragment -> start -> end -> m ()

299303extractBetweenExclusive df s e = liftJSM $ do

300− f <- eval $ T.unlines

301− [ "(function(df,s,e){"

302− , " var x;"

303− , " for(;;){"

304− , " x = s.nextSibling;"

305− , " if(e===x) break;"

306− , " df.appendChild(x);"

307− , " }"

308− , "})"

309− ]

304+ f <- eval ("(function(df,s,e) { var x; for(;;) { x = s['nextSibling']; if(e===x) { break; }; df['appendChild'](x); } })" :: Text)

310305 void $ call f f (df, s, e)

311306

312307-- | s and e must both be children of the same node and s must precede e;

@@ -318,20 +313,17 @@ deleteUpTo s e = do

318313 extractUpTo df s e -- In many places in ImmediateDomBuilderT, we assume that things always have a parent; by adding them to this DocumentFragment, we maintain that invariant

319314

320315extractUpTo :: (MonadJSM m, IsNode start, IsNode end) => DOM.DocumentFragment -> start -> end -> m ()

316+#ifdef ghcjs_HOST_OS

317+--NOTE: Although wrapping this javascript in a function seems unnecessary, GHCJS's optimizer will break it if it is entered without that wrapping (as of 2017-09-04)

318+foreign import javascript unsafe

319+ "(function() { var x = $2; while(x !== $3) { var y = x['nextSibling']; $1['appendChild'](x); x = y; } })()"

320+ extractUpTo_ :: DOM.DocumentFragment -> DOM.Node -> DOM.Node -> IO ()

321+extractUpTo df s e = liftJSM $ extractUpTo_ df (toNode s) (toNode e)

322+#else

321323extractUpTo df s e = liftJSM $ do

322− f <- eval $ T.unlines

323− [ "(function(df,s,e){"

324− , " var x = s;"

325− , " var y;"

326− , " for(;;) {"

327− , " y = x.nextSibling;"

328− , " df.appendChild(x);"

329− , " if(e===y) break;"

330− , " x = y;"

331− , " }"

332− , "})"

333− ]

324+ f <- eval ("(function(df,s,e){ var x = s; var y; for(;;) { y = x['nextSibling']; df['appendChild'](x); if(e===y) { break; } x = y; } })" :: Text)

334325 void $ call f f (df, s, e)

326+#endif

335327

336328type SupportsImmediateDomBuilder t m = (Reflex t, MonadJSM m, MonadHold t m, MonadFix m, MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref JSM, MonadAdjust t m, PrimMonad m)

337329

@@ -1567,6 +1559,10 @@ instance MonadHold t m => MonadHold t (ImmediateDomBuilderT t m) where

15671559 holdDyn v0 v' = lift $ holdDyn v0 v'

15681560 {-# INLINABLE holdIncremental #-}

15691561 holdIncremental v0 v' = lift $ holdIncremental v0 v'

1562+ {-# INLINABLE buildDynamic #-}

1563+ buildDynamic a0 = lift . buildDynamic a0

1564+ {-# INLINABLE headE #-}

1565+ headE = lift . headE

15701566

15711567data WindowConfig t = WindowConfig -- No config options yet

15721568

reflex-dom-core/src/Reflex/Dom/Builder/Static.hs+4

@@ -100,6 +100,10 @@ instance MonadHold t m => MonadHold t (StaticDomBuilderT t m) where

100100 holdDyn v0 v' = lift $ holdDyn v0 v'

101101 {-# INLINABLE holdIncremental #-}

102102 holdIncremental v0 v' = lift $ holdIncremental v0 v'

103+ {-# INLINABLE buildDynamic #-}

104+ buildDynamic a0 = lift . buildDynamic a0

105+ {-# INLINABLE headE #-}

106+ headE = lift . headE

103107

104108instance (Monad m, Ref m ~ Ref IO, Reflex t) => TriggerEvent t (StaticDomBuilderT t m) where

105109 {-# INLINABLE newTriggerEvent #-}

reflex-dom-core/src/Reflex/Dom/Main.hs+1

@@ -12,6 +12,7 @@

1212{-# LANGUAGE TypeFamilies #-}

1313{-# LANGUAGE TypeOperators #-}

1414{-# LANGUAGE UndecidableInstances #-}

15+{-# OPTIONS_GHC -fspecialise-aggressively #-}

1516module Reflex.Dom.Main where

1617

1718import Prelude hiding (concat, mapM, mapM_, sequence, sequence_)

reflex-dom/benchmarks/krausest.hs+1−1

@@ -2,7 +2,7 @@

22{-# LANGUAGE OverloadedStrings #-}

33{-# LANGUAGE ScopedTypeVariables #-}

44{-# LANGUAGE FlexibleContexts #-}

5−{-# OPTIONS_GHC -ddump-simpl -ddump-rules -ddump-spec -ddump-to-file -dsuppress-coercions -dsuppress-idinfo #-}

5+{-# OPTIONS_GHC -fmax-simplifier-iterations=5 -ddump-simpl -ddump-to-file -dsuppress-coercions -dsuppress-idinfo #-}

66import Control.Monad.State

77import Data.Monoid

88import Data.IntMap (IntMap, assocs, elems, empty, fromList, size, singleton)

reflex-dom/reflex-dom.cabal+2−2

@@ -100,7 +100,7 @@ executable sortableList

100100 , transformers

101101 hs-source-dirs: examples

102102 main-is: sortableList.hs

103− ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans

103+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans -fspecialise-aggressively

104104 ghc-prof-options: -fprof-auto

105105 if !flag(build-examples)

106106 buildable: False

@@ -121,7 +121,7 @@ benchmark krausest

121121 build-depends: base, reflex, reflex-dom, text, prim-uniq, dependent-map, containers, transformers, mtl, ghcjs-dom, ghc-prim, random, dependent-sum, vector

122122 hs-source-dirs: benchmarks

123123 main-is: krausest.hs

124− ghc-options: -O2 -fspecialise-aggressively

124+ ghc-options: -O2 -fspecialise-aggressively -DGHCJS_GC_INTERVAL=60000

125125 type: exitcode-stdio-1.0

126126

127127source-repository head