git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Add `jsUnit` value
53f67beGary Burgess
src/Language/PureScript/CodeGen/JS/AST.hs+6
@@ -242,6 +242,12 @@ data JS
242 --
242 --
243 | JSRaw String deriving (Show, Eq, Data, Typeable)
243 | JSRaw String deriving (Show, Eq, Data, Typeable)
244
244
245+-- |
246+-- Javascript representation of the unit value.
247+--
248+jsUnit :: JS
249+jsUnit = JSObjectLiteral []
250+
245--
251--
246-- Traversals
252-- Traversals
247--
253--
src/Language/PureScript/Optimizer/Inliner.hs+4−4
@@ -49,8 +49,8 @@ etaConvert = everywhereOnJS convert
49 not (any (`isRebound` block) (map JSVar idents)) &&
49 not (any (`isRebound` block) (map JSVar idents)) &&
50 not (any (`isRebound` block) args)
50 not (any (`isRebound` block) args)
51 = JSBlock (map (replaceIdents (zip idents args)) body)
51 = JSBlock (map (replaceIdents (zip idents args)) body)
52− convert (JSFunction Nothing [arg] (JSBlock [JSReturn (JSApp fn@JSVar{} [JSObjectLiteral []])]))
52+ convert (JSFunction Nothing [arg] (JSBlock [JSReturn (JSApp fn@JSVar{} [val])]))
53− | arg == C.__unused = fn
53+ | arg == C.__unused && val == jsUnit = fn
54 convert js = js
54 convert js = js
55
55
56unThunk :: JS -> JS
56unThunk :: JS -> JS
@@ -59,7 +59,7 @@ unThunk = everywhereOnJS convert
59 convert :: JS -> JS
59 convert :: JS -> JS
60 convert (JSBlock []) = JSBlock []
60 convert (JSBlock []) = JSBlock []
61 convert (JSBlock jss) =
61 convert (JSBlock jss) =
62− case (last jss) of
62+ case last jss of
63 JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) []) -> JSBlock $ init jss ++ body
63 JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) []) -> JSBlock $ init jss ++ body
64 _ -> JSBlock jss
64 _ -> JSBlock jss
65 convert js = js
65 convert js = js
@@ -154,7 +154,7 @@ inlineCommonOperators = applyAll $
154 convert other = other
154 convert other = other
155 isOp (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName' == fnName
155 isOp (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName' == fnName
156 isOp _ = False
156 isOp _ = False
157− isOpDict dictName (JSApp (JSAccessor prop (JSVar prelude)) [JSObjectLiteral []]) = prelude == C.prelude && prop == dictName
157+ isOpDict dictName (JSApp (JSAccessor prop (JSVar prelude)) [val]) = prelude == C.prelude && prop == dictName && val == jsUnit
158 isOpDict _ _ = False
158 isOpDict _ _ = False
159 mkFn :: Int -> JS -> JS
159 mkFn :: Int -> JS -> JS
160 mkFn 0 = everywhereOnJS convert
160 mkFn 0 = everywhereOnJS convert
src/Language/PureScript/Optimizer/MagicDo.hs+4−4
@@ -69,10 +69,10 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
69 JSFunction (Just fnName) [] $ JSBlock (JSVariableIntroduction arg (Just (JSApp m [])) : init js ++ [JSReturn (JSApp ret [])] )
69 JSFunction (Just fnName) [] $ JSBlock (JSVariableIntroduction arg (Just (JSApp m [])) : init js ++ [JSReturn (JSApp ret [])] )
70 -- Desugar untilE
70 -- Desugar untilE
71 convert (JSApp (JSApp f [arg]) []) | isEffFunc C.untilE f =
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 jsUnit ])) []
73 -- Desugar whileE
73 -- Desugar whileE
74 convert (JSApp (JSApp (JSApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =
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 jsUnit ])) []
76 convert other = other
76 convert other = other
77 -- Check if an expression represents a monomorphic call to >>= for the Eff monad
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
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'
99 isEffFunc name (JSAccessor name' (JSVar eff)) = eff == C.eff && name == name'
100 isEffFunc _ _ = False
100 isEffFunc _ _ = False
101 -- Check if an expression represents the Monad Eff dictionary
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) [val]) | ident == name && val == jsUnit = True
103− isEffDict name (JSApp (JSAccessor prop (JSVar eff)) [JSObjectLiteral []]) = eff == C.eff && prop == name
103+ isEffDict name (JSApp (JSAccessor prop (JSVar eff)) [val]) = eff == C.eff && prop == name && val == jsUnit
104 isEffDict _ _ = False
104 isEffDict _ _ = False
105 -- Remove __do function applications which remain after desugaring
105 -- Remove __do function applications which remain after desugaring
106 undo :: JS -> JS
106 undo :: JS -> JS