daa6403 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

STArray and associated optimization rules

daa6403Phil Freeman13 years ago

examples/passing/STArray.pursnew file+14

compare with golang

unifiedsplit

@@ -0,0 +1,14 @@

1+module Main where

3+import Prelude

4+import Eff

5+import ST

6+import Arrays

8+test = runSTArray (do

9+ a <- newSTArray 2 0

10+ pokeSTArray a 0 1

11+ pokeSTArray a 1 2

12+ return a)

13+

14+main = Trace.print $ runPure test

prelude/prelude.purs+36

@@ -1073,6 +1073,8 @@ module ST where

1073

1074 foreign import data STRef :: * -> * -> *

1075

1076+ foreign import data STArray :: * -> * -> *

1077+

1076 foreign import newSTRef "function newSTRef(val) {\

1078 foreign import newSTRef "function newSTRef(val) {\

1077 \ return function () {\

1079 \ return function () {\

1078 \ return { value: val };\

1080 \ return { value: val };\

@@ -1101,7 +1103,41 @@ module ST where

1101 \ };\

1103 \ };\

1102 \}" :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a

1104 \}" :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a

1103

1105

1106+ foreign import newSTArray "function newSTArray(len) {\

1107+ \ return function(a) {\

1108+ \ return function() {\

1109+ \ var arr = [];\

1110+ \ for (var i = 0; i < len; i++) {\

1111+ \ arr[i] = a;\

1112+ \ };\

1113+ \ return arr;\

1114+ \ };\

1115+ \ };\

1116+ \}" :: forall a h r. Number -> a -> Eff (st :: ST h | r) (STArray h a)

1117+

1118+ foreign import peekSTArray "function peekSTArray(arr) {\

1119+ \ return function(i) {\

1120+ \ return function() {\

1121+ \ return arr[i];\

1122+ \ };\

1123+ \ };\

1124+ \}" :: forall a h r. STArray h a -> Eff (st :: ST h | r) a

1125+

1126+ foreign import pokeSTArray "function pokeSTArray(arr) {\

1127+ \ return function(i) {\

1128+ \ return function(a) {\

1129+ \ return function() {\

1130+ \ return arr[i] = a;\

1131+ \ };\

1132+ \ };\

1133+ \ };\

1134+ \}" :: forall a h r. STArray h a -> Number -> a -> Eff (st :: ST h | r) a

1135+

1104 foreign import runST "function runST(f) {\

1136 foreign import runST "function runST(f) {\

1105 \ return f;\

1137 \ return f;\

1106 \}" :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a

1138 \}" :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a

1107

1139

1140+ foreign import runSTArray "function runSTArray(f) {\

1141+ \ return f;\

1142+ \}" :: forall a r. (forall h. Eff (st :: ST h | r) (STArray h a)) -> Eff r [a]

1143+

src/Language/PureScript/CodeGen/Optimize.hs+18−18

@@ -340,29 +340,29 @@ inlineST = everywhere (mkT convertBlock)

340 -- Look for runST blocks and inline the STRefs there.

341 -- If all STRefs are used in the scope of the same runST, only using { read, write, modify }STRef then

342 -- we can be more aggressive about inlining, and actually turn STRefs into local variables.

343− convertBlock (JSApp f [arg]) | isSTFunc "runST" f =

343+ convertBlock (JSApp f [arg]) | isSTFunc "runST" f || isSTFunc "runSTArray" f =

344 let refs = nub . findSTRefsIn $ arg

345 usages = findAllSTUsagesIn arg

346 allUsagesAreLocalVars = all (\u -> let v = toVar u in isJust v && fromJust v `elem` refs) usages

347 localVarsDoNotEscape = all (\r -> length (r `appearingIn` arg) == length (filter (\u -> let v = toVar u in v == Just r) usages)) refs

348− in everywhere (mkT $ if allUsagesAreLocalVars then convertAggressive else convertSafe) arg

348+ in everywhere (mkT $ convert allUsagesAreLocalVars) arg

349 convertBlock other = other

350− -- Convert a block in a safe way, preserving object wrappers of references

350+ -- Convert a block in a safe way, preserving object wrappers of references,

351− convertSafe (JSApp (JSApp f [arg]) []) | isSTFunc "newSTRef" f =

352− JSObjectLiteral [("value", arg)]

353− convertSafe (JSApp (JSApp f [ref]) []) | isSTFunc "readSTRef" f =

354− JSAccessor "value" ref

355− convertSafe (JSApp (JSApp (JSApp f [ref]) [arg]) []) | isSTFunc "writeSTRef" f =

356− JSAssignment (JSAccessor "value" ref) arg

357− convertSafe (JSApp (JSApp (JSApp f [ref]) [func]) []) | isSTFunc "modifySTRef" f =

358− JSAssignment (JSAccessor "value" ref) (JSApp func [JSAccessor "value" ref])

359− convertSafe other = other

360− -- Convert a block in a more agressive way, unwrapping object wrappers into local variables

351+ -- or in a more aggressive way, turning wrappers into local variables depending on the

352+ -- agg(ressive) parameter.

361− convertAggressive (JSApp (JSApp f [arg]) []) | isSTFunc "newSTRef" f = arg

353+ convert agg (JSApp (JSApp f [arg]) []) | isSTFunc "newSTRef" f =

354+ if agg then arg else JSObjectLiteral [("value", arg)]

362− convertAggressive (JSApp (JSApp f [ref]) []) | isSTFunc "readSTRef" f = ref

355+ convert agg (JSApp (JSApp f [ref]) []) | isSTFunc "readSTRef" f =

356+ if agg then ref else JSAccessor "value" ref

363− convertAggressive (JSApp (JSApp (JSApp f [ref]) [arg]) []) | isSTFunc "writeSTRef" f = JSAssignment ref arg

357+ convert agg (JSApp (JSApp (JSApp f [ref]) [arg]) []) | isSTFunc "writeSTRef" f =

358+ if agg then JSAssignment ref arg else JSAssignment (JSAccessor "value" ref) arg

364− convertAggressive (JSApp (JSApp (JSApp f [ref]) [func]) []) | isSTFunc "modifySTRef" f = JSAssignment ref (JSApp func [ref])

359+ convert agg (JSApp (JSApp (JSApp f [ref]) [func]) []) | isSTFunc "modifySTRef" f =

360+ if agg then JSAssignment ref (JSApp func [ref]) else JSAssignment (JSAccessor "value" ref) (JSApp func [JSAccessor "value" ref])

361+ convert _ (JSApp (JSApp (JSApp f [arr]) [i]) []) | isSTFunc "peekSTArray" f =

362+ (JSIndexer i arr)

363+ convert _ (JSApp (JSApp (JSApp (JSApp f [arr]) [i]) [val]) []) | isSTFunc "pokeSTArray" f =

364+ JSAssignment (JSIndexer i arr) val

365− convertAggressive other = other

365+ convert _ other = other

366 -- Check if an expression represents a function in the ST module

367 isSTFunc name (JSAccessor name' (JSAccessor "ST" (JSVar "_ps"))) | name == name' = True

368 isSTFunc _ _ = False