3108d93 · rowtype-yoga/purescript-native

src/Language/PureScript/CodeGen/JS.hs+1

compare with golang

unifiedsplit

@@ -307,6 +307,7 @@ varToJs m qual = qualifiedToJS m id qual

307-- variable that may have a qualified name.

308--

309qualifiedToJS :: ModuleName -> (a -> Ident) -> Qualified a -> JS

310+qualifiedToJS _ f (Qualified (Just (ModuleName [ProperName mn])) a) | mn == C.prim = JSVar . runIdent $ f a

310qualifiedToJS m f (Qualified (Just m') a) | m /= m' = accessor (f a) (JSVar (moduleNameToJs m'))

311qualifiedToJS m f (Qualified (Just m') a) | m /= m' = accessor (f a) (JSVar (moduleNameToJs m'))

311qualifiedToJS _ f (Qualified _ a) = JSVar $ identToJs (f a)

312qualifiedToJS _ f (Qualified _ a) = JSVar $ identToJs (f a)

312

313

src/Language/PureScript/Constants.hs+5

@@ -153,6 +153,11 @@ mkFn = "mkFn"

153runFn :: String

154runFn = "runFn"

155

156+-- Prim values

157+

158+undefined :: String

159+undefined = "undefined"

160+

156-- Type Class Dictionary Names

161-- Type Class Dictionary Names

157

162

158monadEffDictionary :: String

163monadEffDictionary :: String

src/Language/PureScript/Optimizer.hs+2

@@ -57,6 +57,8 @@ optimize opts | optionsNoOptimizations opts = id

57 , tco opts

58 , magicDo opts

59 , removeCodeAfterReturnStatements

60+ , removeUnusedArg

61+ , removeUndefinedApp

60 , unThunk

62 , unThunk

61 , etaConvert

63 , etaConvert

62 , evaluateIifes

64 , evaluateIifes

src/Language/PureScript/Optimizer/Inliner.hs+3−4

@@ -49,8 +49,7 @@ etaConvert = everywhereOnJS convert

49 not (any (`isRebound` block) (map JSVar idents)) &&

50 not (any (`isRebound` block) args)

51 = JSBlock (map (replaceIdents (zip idents args)) body)

52− convert (JSFunction Nothing [arg] (JSBlock [JSReturn (JSApp fn@JSVar{} [JSObjectLiteral []])]))

52+ convert (JSFunction Nothing [] (JSBlock [JSReturn (JSApp fn [])])) = fn

53− | arg == C.__unused = fn

54 convert js = js

53 convert js = js

55

54

56unThunk :: JS -> JS

55unThunk :: JS -> JS

@@ -59,7 +58,7 @@ unThunk = everywhereOnJS convert

59 convert :: JS -> JS

58 convert :: JS -> JS

60 convert (JSBlock []) = JSBlock []

59 convert (JSBlock []) = JSBlock []

61 convert (JSBlock jss) =

60 convert (JSBlock jss) =

62− case (last jss) of

61+ case last jss of

63 JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) []) -> JSBlock $ init jss ++ body

62 JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) []) -> JSBlock $ init jss ++ body

64 _ -> JSBlock jss

63 _ -> JSBlock jss

65 convert js = js

64 convert js = js

@@ -154,7 +153,7 @@ inlineCommonOperators = applyAll $

154 convert other = other

153 convert other = other

155 isOp (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName' == fnName

154 isOp (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName' == fnName

156 isOp _ = False

155 isOp _ = False

157− isOpDict dictName (JSApp (JSAccessor prop (JSVar prelude)) [JSObjectLiteral []]) = prelude == C.prelude && prop == dictName

156+ isOpDict dictName (JSApp (JSAccessor prop (JSVar prelude)) []) = prelude == C.prelude && prop == dictName

158 isOpDict _ _ = False

157 isOpDict _ _ = False

159 mkFn :: Int -> JS -> JS

158 mkFn :: Int -> JS -> JS

160 mkFn 0 = everywhereOnJS convert

159 mkFn 0 = everywhereOnJS convert

src/Language/PureScript/Optimizer/MagicDo.hs+5−5

@@ -60,7 +60,7 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert

60 -- Desugar pure

61 convert (JSApp (JSApp pure' [val]) []) | isPure pure' = val

62 -- Desugar >>

63− convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock js)]) | isBind bind && isJSReturn (last js) && arg == C.__unused =

63+ convert (JSApp (JSApp bind [m]) [JSFunction Nothing [] (JSBlock js)]) | isBind bind && isJSReturn (last js) =

64 let JSReturn ret = last js in

65 JSFunction (Just fnName) [] $ JSBlock (JSApp m [] : init js ++ [JSReturn (JSApp ret [])] )

66 -- Desugar >>=

@@ -69,10 +69,10 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert

69 JSFunction (Just fnName) [] $ JSBlock (JSVariableIntroduction arg (Just (JSApp m [])) : init js ++ [JSReturn (JSApp ret [])] )

70 -- Desugar untilE

71 convert (JSApp (JSApp f [arg]) []) | isEffFunc C.untilE f =

72− JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSUnary Not (JSApp arg [])) (JSBlock []), JSReturn (JSObjectLiteral []) ])) []

72+ JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSUnary Not (JSApp arg [])) (JSBlock []), JSReturn $ JSObjectLiteral []])) []

73 -- Desugar whileE

74 convert (JSApp (JSApp (JSApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =

75− JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSApp arg1 []) (JSBlock [ JSApp arg2 [] ]), JSReturn (JSObjectLiteral []) ])) []

75+ JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSApp arg1 []) (JSBlock [ JSApp arg2 [] ]), JSReturn $ JSObjectLiteral []])) []

76 convert other = other

77 -- Check if an expression represents a monomorphic call to >>= for the Eff monad

78 isBind (JSApp bindPoly [effDict]) | isBindPoly bindPoly && isEffDict C.bindEffDictionary effDict = True

@@ -99,8 +99,8 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert

99 isEffFunc name (JSAccessor name' (JSVar eff)) = eff == C.eff && name == name'

100 isEffFunc _ _ = False

101 -- Check if an expression represents the Monad Eff dictionary

102− isEffDict name (JSApp (JSVar ident) [JSObjectLiteral []]) | ident == name = True

102+ isEffDict name (JSApp (JSVar ident) []) | ident == name = True

103− isEffDict name (JSApp (JSAccessor prop (JSVar eff)) [JSObjectLiteral []]) = eff == C.eff && prop == name

103+ isEffDict name (JSApp (JSAccessor prop (JSVar eff)) []) = eff == C.eff && prop == name

104 isEffDict _ _ = False

105 -- Remove __do function applications which remain after desugaring

106 undo :: JS -> JS

src/Language/PureScript/Optimizer/Unused.hs+19−3

@@ -13,13 +13,17 @@

13--

14-----------------------------------------------------------------------------

15

16−module Language.PureScript.Optimizer.Unused (

16+module Language.PureScript.Optimizer.Unused

17− removeCodeAfterReturnStatements

17+ ( removeCodeAfterReturnStatements

18+ , removeUnusedArg

19+ , removeUndefinedApp

18−) where

20+ ) where

19

21

20import Language.PureScript.CodeGen.JS.AST

22import Language.PureScript.CodeGen.JS.AST

21import Language.PureScript.Optimizer.Common

23import Language.PureScript.Optimizer.Common

22

24

25+import qualified Language.PureScript.Constants as C

26+

23removeCodeAfterReturnStatements :: JS -> JS

27removeCodeAfterReturnStatements :: JS -> JS

24removeCodeAfterReturnStatements = everywhereOnJS (removeFromBlock go)

28removeCodeAfterReturnStatements = everywhereOnJS (removeFromBlock go)

25 where

29 where

@@ -28,3 +32,15 @@ removeCodeAfterReturnStatements = everywhereOnJS (removeFromBlock go)

28 | otherwise = let (body, ret : _) = span (not . isJSReturn) jss in body ++ [ret]

32 | otherwise = let (body, ret : _) = span (not . isJSReturn) jss in body ++ [ret]

29 isJSReturn (JSReturn _) = True

33 isJSReturn (JSReturn _) = True

30 isJSReturn _ = False

34 isJSReturn _ = False

35+

36+removeUnusedArg :: JS -> JS

37+removeUnusedArg = everywhereOnJS convert

38+ where

39+ convert (JSFunction name [arg] body) | arg == C.__unused = JSFunction name [] body

40+ convert js = js

41+

42+removeUndefinedApp :: JS -> JS

43+removeUndefinedApp = everywhereOnJS convert

44+ where

45+ convert (JSApp fn [JSVar arg]) | arg == C.undefined = JSApp fn []

46+ convert js = js

src/Language/PureScript/TypeChecker/Types.hs+5−2

@@ -357,12 +357,12 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt

357 -- Turn a DictionaryValue into a Expr

358 dictionaryValueToValue :: DictionaryValue -> Expr

359 dictionaryValueToValue (LocalDictionaryValue fnName) = Var fnName

360− dictionaryValueToValue (GlobalDictionaryValue fnName) = App (Var fnName) (ObjectLiteral [])

360+ dictionaryValueToValue (GlobalDictionaryValue fnName) = App (Var fnName) valUndefined

361 dictionaryValueToValue (DependentDictionaryValue fnName dicts) = foldl App (Var fnName) (map dictionaryValueToValue dicts)

362 dictionaryValueToValue (SubclassDictionaryValue dict superclassName index) =

363 App (Accessor (C.__superclass_ ++ show superclassName ++ "_" ++ show index)

364 (dictionaryValueToValue dict))

365− (ObjectLiteral [])

365+ valUndefined

366 -- Ensure that a substitution is valid

367 verifySubstitution :: [(String, Type)] -> Maybe [(String, Type)]

368 verifySubstitution subst = do

@@ -393,6 +393,9 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt

393 dictTrace (SubclassDictionaryValue dict _ _) = dictTrace dict

394 dictTrace other = other

395

396+ valUndefined :: Expr

397+ valUndefined = Var (Qualified (Just (ModuleName [ProperName C.prim])) (Ident C.undefined))

398+

396-- |

399-- |

397-- Check all values in a list pairwise match a predicate

400-- Check all values in a list pairwise match a predicate

398--

401--