git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Inline fully applied calls to $
commitf20f277ce1ce7020eb52ceeaa473f4e4f9d7cd5b authorPhil Freeman <paf31@cantab.net> dateTue 28 Jan 2014, 22:28 (13 years ago) parenta3e07b6
5 files changed+69−21
compare with golang
unifiedsplit
examples/passing/Eff.purs+7−7 libraries/prelude/prelude.purs+20−3 libraries/prelude/tests/Eff.purs+11−1 src/Language/PureScript/CodeGen/JS/AST.hs+2−2 src/Language/PureScript/CodeGen/Optimize.hs+29−8
examples/passing/Eff.purs+7−7
@@ -6,14 +6,14 @@ import ST
66import Errors
77import Trace
88
9−test1 = catchError (\s -> ret 0)
10− (do trace "Testing"
11− throwError "Error!")
9+test1 = catchError (\s -> ret 0) $ do
10+ trace "Testing"
11+ throwError "Error!"
1212
13−test2 = runPure (runST (do
14− ref <- newSTRef 0
15− modifySTRef (\n -> n + 1) ref
16− readSTRef ref))
13+test2 = runPure $ runST $ do
14+ ref <- newSTRef 0
15+ modifySTRef ref $ \n -> n + 1
16+ readSTRef ref
1717
1818module Main where
1919
libraries/prelude/prelude.purs+20−3
@@ -495,6 +495,15 @@ module IORef where
495495 \ };\
496496 \}" :: forall s r. IORef s -> Eff (ref :: Ref | r) s
497497
498+
499+ foreign import modifyIORef "function modifyIORef(ref) {\
500+ \ return function(f) {\
501+ \ return function() {\
502+ \ ref.value = f(ref.value);\
503+ \ };\
504+ \ };\
505+ \}" :: forall s r. IORef s -> (s -> s) -> Eff (ref :: Ref | r) {}
506+
498507 foreign import writeIORef "function writeIORef(ref) {\
499508 \ return function(val) {\
500509 \ return function() {\
@@ -540,14 +549,22 @@ module ST where
540549 \ };\
541550 \}" :: forall a h r. STRef h a -> Eff (st :: ST h | r) a
542551
543− foreign import modifySTRef "function modifySTRef(f) {\
544− \ return function(ref) {\
552+ foreign import modifySTRef "function modifySTRef(ref) {\
553+ \ return function(f) {\
545554 \ return function() {\
546555 \ ref.value = f(ref.value);\
547556 \ };\
548557 \ };\
549− \}" :: forall a h r. (a -> a) -> STRef h a -> Eff (st :: ST h | r) {}
558+ \}" :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) {}
550559
560+ foreign import writeSTRef "function writeSTRef(ref) {\
561+ \ return function(a) {\
562+ \ return function() {\
563+ \ ref.value = a;\
564+ \ };\
565+ \ };\
566+ \}" :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) {}
567+
551568 foreign import runST "function runST(f) {\
552569 \ return f;\
553570 \}" :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a
libraries/prelude/tests/Eff.purs+11−1
@@ -4,6 +4,7 @@ import Prelude
44import Eff
55import Errors
66import Trace
7+import Global
78
89test1 n = runPure $ catchError (\s -> ret 0) $ do
910 case {} of
@@ -34,8 +35,17 @@ test6 s = do
3435 trace s
3536 test6 (s ++ " test")
3637
38+import ST
39+
40+test7 = \ -> do
41+ n <- runST $ do
42+ r <- newSTRef 0
43+ modifySTRef r $ \n -> n + 1
44+ readSTRef r
45+ print n
46+
3747module Main where
3848
3949import Tests
4050
41−main = test6 ""
51+main = test7 ()
src/Language/PureScript/CodeGen/JS/AST.hs+2−2
@@ -129,7 +129,7 @@ data JS
129129 -- |
130130 -- Raw Javascript (generated when parsing fails for an inline foreign import declaration)
131131 --
132− | JSRaw String deriving (Show, Data, Typeable)
132+ | JSRaw String deriving (Show, Eq, Data, Typeable)
133133
134134-- |
135135-- Data type for expressions which can appear on the left hand side of an assignment
@@ -142,4 +142,4 @@ data JSAssignment
142142 -- |
143143 -- Assign an object property
144144 --
145− | JSAssignProperty String JSAssignment deriving (Show, Data, Typeable)
145+ | JSAssignProperty String JSAssignment deriving (Show, Eq, Data, Typeable)
src/Language/PureScript/CodeGen/Optimize.hs+29−8
@@ -27,6 +27,8 @@
2727--
2828-- * Inlining variables
2929--
30+-- * Inline Prelude.($)
31+--
3032-----------------------------------------------------------------------------
3133
3234module Language.PureScript.CodeGen.Optimize (
@@ -49,14 +51,24 @@ import Language.PureScript.Types (Type(..))
4951-- Apply a series of optimizer passes to simplified Javascript code
5052--
5153optimize :: Options -> JS -> JS
52−optimize opts =
53− collapseNestedBlocks
54− . tco opts
55− . magicDo opts
56− . removeUnusedVariables
57− . unThunk
58− . etaConvert
59− . inlineVariables
54+optimize opts = untilFixedPoint $ applyAll
55+ [ collapseNestedBlocks
56+ , tco opts
57+ , magicDo opts
58+ , removeUnusedVariables
59+ , unThunk
60+ , etaConvert
61+ , inlineVariables
62+ , inlineDollar ]
63+
64+applyAll :: [a -> a] -> a -> a
65+applyAll = foldl1 (.)
66+
67+untilFixedPoint :: (Eq a) => (a -> a) -> a -> a
68+untilFixedPoint f a = go a
69+ where
70+ go a' = let a'' = f a' in
71+ if a'' == a' then a'' else go a''
6072
6173replaceIdent :: (Data d) => Ident -> JS -> d -> d
6274replaceIdent var1 js = everywhere (mkT replace)
@@ -279,3 +291,12 @@ collapseNestedBlocks = everywhere (mkT collapse)
279291 go :: JS -> [JS]
280292 go (JSBlock sts) = sts
281293 go s = [s]
294+
295+inlineDollar :: JS -> JS
296+inlineDollar = everywhere (mkT convert)
297+ where
298+ convert :: JS -> JS
299+ convert (JSApp (JSApp dollar [f]) [x]) | isDollar dollar = JSApp f [x]
300+ convert other = other
301+ isDollar (JSAccessor name (JSVar (Ident "Prelude"))) | name == identToJs (Op "$") = True
302+ isDollar _ = False