95026fc · rowtype-yoga/purescript-native

libraries/prelude/tests/Eff.purs+12−2

compare with golang

unifiedsplit

@@ -5,9 +5,19 @@ import Eff

5import Errors

6import Trace

7

8−test n = runPure $ catchError (\s -> eff do return 0) $ eff do

8+test1 n = runPure $ catchError (\s -> eff do return 0) $ eff do

9 case {} of

10 _ | n > 10 -> eff do

11+ throwError "Error!"

12+ _ -> eff do return n

13+

14+test2 = eff do

15+ trace "Hello World"

16+ throwError "Error!"

17+

18+test3 n = catchError (\s -> eff do return 0) $ eff do

19+ case {} of

20+ _ | n > 10 -> eff do

11− --trace "n > 10"

21+ trace "n > 10"

12 throwError "Error!"

22 throwError "Error!"

13 _ -> eff do return n

23 _ -> eff do return n

purescript.cabal+1−1

@@ -1,5 +1,5 @@

1name: purescript

2−version: 0.2.11

2+version: 0.2.12

3cabal-version: >=1.8

4build-type: Simple

5license: MIT

src/Language/PureScript/CodeGen/Optimize.hs+21

@@ -27,6 +27,7 @@ import Language.PureScript.Options

27optimize :: Options -> JS -> JS

28optimize opts =

29 collapseNestedBlocks

30+ . magicDo opts

30 . tco opts

31 . tco opts

31 . removeUnusedVariables

32 . removeUnusedVariables

32 . unThunk

33 . unThunk

@@ -195,6 +196,26 @@ tco' = everywhere (mkT convert)

195 isSelfCall ident (JSApp fn _) = isSelfCall ident fn

196 isSelfCall ident (JSApp fn _) = isSelfCall ident fn

196 isSelfCall _ _ = False

197 isSelfCall _ _ = False

197

198

199+magicDo :: Options -> JS -> JS

200+magicDo opts | optionsMagicDo opts = magicDo'

201+ | otherwise = id

202+

203+magicDo' :: JS -> JS

204+magicDo' = everywhere (mkT undo) . everywhere (mkT convert)

205+ where

206+ fnName = Ident "__do"

207+ convert :: JS -> JS

208+ convert (JSApp (JSApp (bind) [m]) [JSFunction Nothing [Ident "_"] (JSBlock [JSReturn ret])]) | isBind bind =

209+ JSFunction (Just fnName) [] $ JSBlock [ JSApp m [], JSApp ret [] ]

210+ convert (JSApp (JSApp (bind) [m]) [JSFunction Nothing [arg] (JSBlock [JSReturn ret])]) | isBind bind =

211+ JSFunction (Just fnName) [] $ JSBlock [ JSVariableIntroduction arg (Just (JSApp m [])), JSApp ret [] ]

212+ convert other = other

213+ isBind (JSAccessor "bind" (JSAccessor "eff" (JSVar (Ident "Eff")))) = True

214+ isBind _ = False

215+ undo :: JS -> JS

216+ undo (JSApp (JSFunction (Just ident) [] body) []) | ident == fnName = body

217+ undo other = other

218+

198collapseNestedBlocks :: JS -> JS

219collapseNestedBlocks :: JS -> JS

199collapseNestedBlocks = everywhere (mkT collapse)

220collapseNestedBlocks = everywhere (mkT collapse)

200 where

221 where

src/Language/PureScript/Options.hs+2−1

@@ -17,7 +17,8 @@ module Language.PureScript.Options where

17data Options = Options

18 { optionsTco :: Bool

19 , optionsPerformRuntimeTypeChecks :: Bool

20+ , optionsMagicDo :: Bool

20 } deriving Show

21 } deriving Show

21

22

22defaultOptions :: Options

23defaultOptions :: Options

23−defaultOptions = Options False False

24+defaultOptions = Options False False False

src/Main.hs+5−1

@@ -82,8 +82,12 @@ noPrelude :: Term Bool

82noPrelude = value $ flag $ (optInfo [ "no-prelude" ])

83 { optDoc = "Omit the Prelude" }

84

85+magicDo :: Term Bool

86+magicDo = value $ flag $ (optInfo [ "magic-do" ])

87+ { optDoc = "Overload the do keyword to generate efficient code specifically for the Eff monad." }

88+

85options :: Term P.Options

89options :: Term P.Options

86−options = P.Options <$> tco <*> performRuntimeTypeChecks

90+options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo

87

91

88stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])

92stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])

89stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles

93stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles