git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
--magic-do flag
commit95026fc5da520716194bb3f514a319e923030787 authorPhil Freeman <paf31@cantab.net> dateSat 11 Jan 2014, 11:51 (13 years ago) parent439ce1a
5 files changed+41−5
compare with golang
unifiedsplit
libraries/prelude/tests/Eff.purs+12−2 purescript.cabal+1−1 src/Language/PureScript/CodeGen/Optimize.hs+21 src/Language/PureScript/Options.hs+2−1 src/Main.hs+5−1
libraries/prelude/tests/Eff.purs+12−2
@@ -5,9 +5,19 @@ import Eff
55import Errors
66import Trace
77
8−test n = runPure $ catchError (\s -> eff do return 0) $ eff do
8+test1 n = runPure $ catchError (\s -> eff do return 0) $ eff do
99 case {} of
1010 _ | n > 10 -> eff do
11− --trace "n > 10"
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
21+ trace "n > 10"
1222 throwError "Error!"
1323 _ -> eff do return n
purescript.cabal+1−1
@@ -1,5 +1,5 @@
11name: purescript
2−version: 0.2.11
2+version: 0.2.12
33cabal-version: >=1.8
44build-type: Simple
55license: MIT
src/Language/PureScript/CodeGen/Optimize.hs+21
@@ -27,6 +27,7 @@ import Language.PureScript.Options
2727optimize :: Options -> JS -> JS
2828optimize opts =
2929 collapseNestedBlocks
30+ . magicDo opts
3031 . tco opts
3132 . removeUnusedVariables
3233 . unThunk
@@ -195,6 +196,26 @@ tco' = everywhere (mkT convert)
195196 isSelfCall ident (JSApp fn _) = isSelfCall ident fn
196197 isSelfCall _ _ = False
197198
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+
198219collapseNestedBlocks :: JS -> JS
199220collapseNestedBlocks = everywhere (mkT collapse)
200221 where
src/Language/PureScript/Options.hs+2−1
@@ -17,7 +17,8 @@ module Language.PureScript.Options where
1717data Options = Options
1818 { optionsTco :: Bool
1919 , optionsPerformRuntimeTypeChecks :: Bool
20+ , optionsMagicDo :: Bool
2021 } deriving Show
2122
2223defaultOptions :: Options
23−defaultOptions = Options False False
24+defaultOptions = Options False False False
src/Main.hs+5−1
@@ -82,8 +82,12 @@ noPrelude :: Term Bool
8282noPrelude = value $ flag $ (optInfo [ "no-prelude" ])
8383 { optDoc = "Omit the Prelude" }
8484
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+
8589options :: Term P.Options
86−options = P.Options <$> tco <*> performRuntimeTypeChecks
90+options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo
8791
8892stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])
8993stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles