f20f277 · rowtype-yoga/purescript-native

examples/passing/Eff.purs+7−7

compare with golang

unifiedsplit

@@ -6,14 +6,14 @@ import ST

6import Errors

7import Trace

8

9−test1 = catchError (\s -> ret 0)

9+test1 = catchError (\s -> ret 0) $ do

10− (do trace "Testing"

10+ trace "Testing"

11− throwError "Error!")

11+ throwError "Error!"

12

13−test2 = runPure (runST (do

13+test2 = runPure $ runST $ do

14− ref <- newSTRef 0

14+ ref <- newSTRef 0

15− modifySTRef (\n -> n + 1) ref

15+ modifySTRef ref $ \n -> n + 1

16− readSTRef ref))

16+ readSTRef ref

17

18module Main where

19

libraries/prelude/prelude.purs+20−3

@@ -495,6 +495,15 @@ module IORef where

495 \ };\

496 \}" :: forall s r. IORef s -> Eff (ref :: Ref | r) s

497

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+

498 foreign import writeIORef "function writeIORef(ref) {\

507 foreign import writeIORef "function writeIORef(ref) {\

499 \ return function(val) {\

508 \ return function(val) {\

500 \ return function() {\

509 \ return function() {\

@@ -540,14 +549,22 @@ module ST where

540 \ };\

549 \ };\

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

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

542

551

543− foreign import modifySTRef "function modifySTRef(f) {\

552+ foreign import modifySTRef "function modifySTRef(ref) {\

544− \ return function(ref) {\

553+ \ return function(f) {\

545 \ return function() {\

554 \ return function() {\

546 \ ref.value = f(ref.value);\

555 \ ref.value = f(ref.value);\

547 \ };\

556 \ };\

548 \ };\

557 \ };\

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) {}

550

559

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+

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

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

552 \ return f;\

569 \ return f;\

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

570 \}" :: 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

4import Eff

5import Errors

6import Trace

7+import Global

7

8

8test1 n = runPure $ catchError (\s -> ret 0) $ do

9test1 n = runPure $ catchError (\s -> ret 0) $ do

9 case {} of

10 case {} of

@@ -34,8 +35,17 @@ test6 s = do

34 trace s

35 trace s

35 test6 (s ++ " test")

36 test6 (s ++ " test")

36

37

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+

37module Main where

47module Main where

38

48

39import Tests

49import Tests

40

50

41−main = test6 ""

51+main = test7 ()

src/Language/PureScript/CodeGen/JS/AST.hs+2−2

@@ -129,7 +129,7 @@ data JS

129 -- |

130 -- Raw Javascript (generated when parsing fails for an inline foreign import declaration)

131 --

132− | JSRaw String deriving (Show, Data, Typeable)

132+ | JSRaw String deriving (Show, Eq, Data, Typeable)

133

134-- |

135-- Data type for expressions which can appear on the left hand side of an assignment

@@ -142,4 +142,4 @@ data JSAssignment

142 -- |

143 -- Assign an object property

144 --

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 @@

27--

28-- * Inlining variables

29--

30+-- * Inline Prelude.($)

31+--

30-----------------------------------------------------------------------------

32-----------------------------------------------------------------------------

31

33

32module Language.PureScript.CodeGen.Optimize (

34module Language.PureScript.CodeGen.Optimize (

@@ -49,14 +51,24 @@ import Language.PureScript.Types (Type(..))

49-- Apply a series of optimizer passes to simplified Javascript code

51-- Apply a series of optimizer passes to simplified Javascript code

50--

52--

51optimize :: Options -> JS -> JS

53optimize :: Options -> JS -> JS

52−optimize opts =

54+optimize opts = untilFixedPoint $ applyAll

53− collapseNestedBlocks

55+ [ collapseNestedBlocks

54− . tco opts

56+ , tco opts

55− . magicDo opts

57+ , magicDo opts

56− . removeUnusedVariables

58+ , removeUnusedVariables

57− . unThunk

59+ , unThunk

58− . etaConvert

60+ , etaConvert

59− . inlineVariables

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''

60

72

61replaceIdent :: (Data d) => Ident -> JS -> d -> d

73replaceIdent :: (Data d) => Ident -> JS -> d -> d

62replaceIdent var1 js = everywhere (mkT replace)

74replaceIdent var1 js = everywhere (mkT replace)

@@ -279,3 +291,12 @@ collapseNestedBlocks = everywhere (mkT collapse)

279 go :: JS -> [JS]

291 go :: JS -> [JS]

280 go (JSBlock sts) = sts

292 go (JSBlock sts) = sts

281 go s = [s]

293 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