git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Avoid reassigning vars when importing a module
3eec9f0Phil Freeman
src/Language/PureScript/CodeGen/JS.hs+58−62
compare with golang
unifiedsplit
@@ -34,13 +34,14 @@ import Language.PureScript.Declarations
34import Language.PureScript.Pretty.Common
34import Language.PureScript.Pretty.Common
35import Language.PureScript.CodeGen.Monad
35import Language.PureScript.CodeGen.Monad
36import Language.PureScript.CodeGen.JS.AST as AST
36import Language.PureScript.CodeGen.JS.AST as AST
37+import Language.PureScript.TypeChecker.Monad (NameKind(..))
37
38
38declToJs :: Maybe Ident -> ModulePath -> Declaration -> Environment -> Maybe [JS]
39declToJs :: Maybe Ident -> ModulePath -> Declaration -> Environment -> Maybe [JS]
39−declToJs mod mp (ValueDeclaration ident (Abs args ret)) _ =
40+declToJs mod mp (ValueDeclaration ident (Abs args ret)) e =
40− Just $ JSFunction (Just ident) args (JSBlock [JSReturn (valueToJs mp ret)]) :
41+ Just $ JSFunction (Just ident) args (JSBlock [JSReturn (valueToJs mp e ret)]) :
41 maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod
42 maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod
42−declToJs mod mp (ValueDeclaration ident val) _ =
43+declToJs mod mp (ValueDeclaration ident val) e =
43− Just $ JSVariableIntroduction ident (Just (valueToJs mp val)) :
44+ Just $ JSVariableIntroduction ident (Just (valueToJs mp e val)) :
44 maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod
45 maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod
45declToJs mod _ (ExternMemberDeclaration member ident _) _ =
46declToJs mod _ (ExternMemberDeclaration member ident _) _ =
46 Just $ JSFunction (Just ident) [Ident "value"] (JSBlock [JSReturn (JSAccessor member (JSVar (Ident "value")))]) :
47 Just $ JSFunction (Just ident) [Ident "value"] (JSBlock [JSReturn (JSAccessor member (JSVar (Ident "value")))]) :
@@ -63,37 +64,32 @@ declToJs mod mp (ModuleDeclaration pn@(ProperName name) decls) env =
63 [JSAssignment (JSAssignVariable (Ident name))
64 [JSAssignment (JSAssignVariable (Ident name))
64 (JSBinary Or (JSVar (Ident name)) (JSObjectLiteral []))]] ++
65 (JSBinary Or (JSVar (Ident name)) (JSObjectLiteral []))]] ++
65 maybe [] (return . setProperty name (JSVar (Ident name))) mod
66 maybe [] (return . setProperty name (JSVar (Ident name))) mod
66−declToJs mod omp (ImportDeclaration mp idents) env =
67− Just $ case idents of
68− Nothing ->
69− let idents = map snd . filter ((== mp) . fst) . M.keys $ names env
70− in map mkLocal idents
71− Just idents -> map mkLocal idents
72− where mkLocal ident = JSVariableIntroduction ident (Just (qualifiedToJS identToJs (Qualified mp ident)))
73declToJs _ _ _ _ = Nothing
67declToJs _ _ _ _ = Nothing
74
68
75setProperty :: String -> JS -> Ident -> JS
69setProperty :: String -> JS -> Ident -> JS
76setProperty prop val mod = JSAssignment (JSAssignProperty prop (JSAssignVariable mod)) val
70setProperty prop val mod = JSAssignment (JSAssignProperty prop (JSAssignVariable mod)) val
77
71
78−valueToJs :: ModulePath -> Value -> JS
72+valueToJs :: ModulePath -> Environment -> Value -> JS
79−valueToJs _ (NumericLiteral n) = JSNumericLiteral n
73+valueToJs _ _ (NumericLiteral n) = JSNumericLiteral n
80−valueToJs _ (StringLiteral s) = JSStringLiteral s
74+valueToJs _ _ (StringLiteral s) = JSStringLiteral s
81−valueToJs _ (BooleanLiteral b) = JSBooleanLiteral b
75+valueToJs _ _ (BooleanLiteral b) = JSBooleanLiteral b
82−valueToJs m (ArrayLiteral xs) = JSArrayLiteral (map (valueToJs m) xs)
76+valueToJs m e (ArrayLiteral xs) = JSArrayLiteral (map (valueToJs m e) xs)
83−valueToJs m (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs m)) ps)
77+valueToJs m e (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs m e)) ps)
84−valueToJs m (ObjectUpdate o ps) = JSApp (JSAccessor "extend" (JSVar (Ident "Object"))) [ valueToJs m o, JSObjectLiteral (map (second (valueToJs m)) ps)]
78+valueToJs m e (ObjectUpdate o ps) = JSApp (JSAccessor "extend" (JSVar (Ident "Object"))) [ valueToJs m e o, JSObjectLiteral (map (second (valueToJs m e)) ps)]
85−valueToJs m (Constructor name) = qualifiedToJS runProperName name
79+valueToJs m e (Constructor name) = qualifiedToJS runProperName name
86−valueToJs m (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs m) sts))) []
80+valueToJs m e (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs m e) sts))) []
87−valueToJs m (Case value binders) = runGen (bindersToJs m binders (valueToJs m value))
81+valueToJs m e (Case value binders) = runGen (bindersToJs m e binders (valueToJs m e value))
88−valueToJs m (IfThenElse cond th el) = JSConditional (valueToJs m cond) (valueToJs m th) (valueToJs m el)
82+valueToJs m e (IfThenElse cond th el) = JSConditional (valueToJs m e cond) (valueToJs m e th) (valueToJs m e el)
89−valueToJs m (Accessor prop val) = JSAccessor prop (valueToJs m val)
83+valueToJs m e (Accessor prop val) = JSAccessor prop (valueToJs m e val)
90−valueToJs m (Indexer index val) = JSIndexer (valueToJs m index) (valueToJs m val)
84+valueToJs m e (Indexer index val) = JSIndexer (valueToJs m e index) (valueToJs m e val)
91−valueToJs m (App val args) = JSApp (valueToJs m val) (map (valueToJs m) args)
85+valueToJs m e (App val args) = JSApp (valueToJs m e val) (map (valueToJs m e) args)
92−valueToJs m (Abs args val) = JSFunction Nothing args (JSBlock [JSReturn (valueToJs m val)])
86+valueToJs m e (Abs args val) = JSFunction Nothing args (JSBlock [JSReturn (valueToJs m e val)])
93−valueToJs m (Unary op val) = JSUnary op (valueToJs m val)
87+valueToJs m e (Unary op val) = JSUnary op (valueToJs m e val)
94−valueToJs m (Binary op v1 v2) = JSBinary op (valueToJs m v1) (valueToJs m v2)
88+valueToJs m e (Binary op v1 v2) = JSBinary op (valueToJs m e v1) (valueToJs m e v2)
89+valueToJs m e (Var ident) = case M.lookup (qualify m ident) (names e) of
90+ Just (_, Alias aliasModule aliasIdent) -> qualifiedToJS identToJs (Qualified aliasModule aliasIdent)
95−valueToJs m (Var ident) = qualifiedToJS identToJs ident
91+ _ -> qualifiedToJS identToJs ident
96−valueToJs m (TypedValue val _) = valueToJs m val
92+valueToJs m e (TypedValue val _) = valueToJs m e val
97
93
98qualifiedToJS :: (a -> String) -> Qualified a -> JS
94qualifiedToJS :: (a -> String) -> Qualified a -> JS
99qualifiedToJS f (Qualified (ModulePath parts) a) =
95qualifiedToJS f (Qualified (ModulePath parts) a) =
@@ -101,41 +97,41 @@ qualifiedToJS f (Qualified (ModulePath parts) a) =
101 where delimited [part] = JSVar (Ident (part))
97 where delimited [part] = JSVar (Ident (part))
102 delimited (part:parts) = JSAccessor part (delimited parts)
98 delimited (part:parts) = JSAccessor part (delimited parts)
103
99
104−bindersToJs :: ModulePath -> [(Binder, Value)] -> JS -> Gen JS
100+bindersToJs :: ModulePath -> Environment -> [(Binder, Value)] -> JS -> Gen JS
105−bindersToJs m binders val = do
101+bindersToJs m e binders val = do
106 valName <- fresh
102 valName <- fresh
107− jss <- forM binders $ \(binder, result) -> binderToJs m valName [JSReturn (valueToJs m result)] binder
103+ jss <- forM binders $ \(binder, result) -> binderToJs m e valName [JSReturn (valueToJs m e result)] binder
108 return $ JSApp (JSFunction Nothing [Ident valName] (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))
104 return $ JSApp (JSFunction Nothing [Ident valName] (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))
109 [val]
105 [val]
110
106
111−binderToJs :: ModulePath -> String -> [JS] -> Binder -> Gen [JS]
107+binderToJs :: ModulePath -> Environment -> String -> [JS] -> Binder -> Gen [JS]
112−binderToJs _ varName done NullBinder = return done
108+binderToJs _ _ varName done NullBinder = return done
113−binderToJs _ varName done (StringBinder str) =
109+binderToJs _ _ varName done (StringBinder str) =
114 return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSStringLiteral str)) (JSBlock done) Nothing]
110 return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSStringLiteral str)) (JSBlock done) Nothing]
115−binderToJs _ varName done (NumberBinder num) =
111+binderToJs _ _ varName done (NumberBinder num) =
116 return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSNumericLiteral num)) (JSBlock done) Nothing]
112 return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSNumericLiteral num)) (JSBlock done) Nothing]
117−binderToJs _ varName done (BooleanBinder True) =
113+binderToJs _ _ varName done (BooleanBinder True) =
118 return [JSIfElse (JSVar (Ident varName)) (JSBlock done) Nothing]
114 return [JSIfElse (JSVar (Ident varName)) (JSBlock done) Nothing]
119−binderToJs _ varName done (BooleanBinder False) =
115+binderToJs _ _ varName done (BooleanBinder False) =
120 return [JSIfElse (JSUnary Not (JSVar (Ident varName))) (JSBlock done) Nothing]
116 return [JSIfElse (JSUnary Not (JSVar (Ident varName))) (JSBlock done) Nothing]
121−binderToJs _ varName done (VarBinder ident) =
117+binderToJs _ e varName done (VarBinder ident) =
122 return (JSVariableIntroduction ident (Just (JSVar (Ident varName))) : done)
118 return (JSVariableIntroduction ident (Just (JSVar (Ident varName))) : done)
123−binderToJs m varName done (NullaryBinder ctor) =
119+binderToJs m e varName done (NullaryBinder ctor) =
124 return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar (Ident varName))) (JSStringLiteral (show (uncurry Qualified $ qualify m ctor)))) (JSBlock done) Nothing]
120 return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar (Ident varName))) (JSStringLiteral (show (uncurry Qualified $ qualify m ctor)))) (JSBlock done) Nothing]
125−binderToJs m varName done (UnaryBinder ctor b) = do
121+binderToJs m e varName done (UnaryBinder ctor b) = do
126 value <- fresh
122 value <- fresh
127− js <- binderToJs m value done b
123+ js <- binderToJs m e value done b
128 return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar (Ident varName))) (JSStringLiteral (show (uncurry Qualified $ qualify m ctor)))) (JSBlock (JSVariableIntroduction (Ident value) (Just (JSAccessor "value" (JSVar (Ident varName)))) : js)) Nothing]
124 return [JSIfElse (JSBinary EqualTo (JSAccessor "ctor" (JSVar (Ident varName))) (JSStringLiteral (show (uncurry Qualified $ qualify m ctor)))) (JSBlock (JSVariableIntroduction (Ident value) (Just (JSAccessor "value" (JSVar (Ident varName)))) : js)) Nothing]
129−binderToJs m varName done (ObjectBinder bs) = go done bs
125+binderToJs m e varName done (ObjectBinder bs) = go done bs
130 where
126 where
131 go :: [JS] -> [(String, Binder)] -> Gen [JS]
127 go :: [JS] -> [(String, Binder)] -> Gen [JS]
132 go done [] = return done
128 go done [] = return done
133 go done ((prop, binder):bs) = do
129 go done ((prop, binder):bs) = do
134 propVar <- fresh
130 propVar <- fresh
135 done' <- go done bs
131 done' <- go done bs
136− js <- binderToJs m propVar done' binder
132+ js <- binderToJs m e propVar done' binder
137 return (JSVariableIntroduction (Ident propVar) (Just (JSAccessor prop (JSVar (Ident varName)))) : js)
133 return (JSVariableIntroduction (Ident propVar) (Just (JSAccessor prop (JSVar (Ident varName)))) : js)
138−binderToJs m varName done (ArrayBinder bs rest) = do
134+binderToJs m e varName done (ArrayBinder bs rest) = do
139 js <- go done rest 0 bs
135 js <- go done rest 0 bs
140 return [JSIfElse (JSBinary cmp (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
136 return [JSIfElse (JSBinary cmp (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
141 where
137 where
@@ -145,31 +141,31 @@ binderToJs m varName done (ArrayBinder bs rest) = do
145 go done Nothing _ [] = return done
141 go done Nothing _ [] = return done
146 go done (Just binder) index [] = do
142 go done (Just binder) index [] = do
147 restVar <- fresh
143 restVar <- fresh
148− js <- binderToJs m restVar done binder
144+ js <- binderToJs m e restVar done binder
149 return (JSVariableIntroduction (Ident restVar) (Just (JSApp (JSAccessor "slice" (JSVar (Ident varName))) [JSNumericLiteral (Left index)])) : js)
145 return (JSVariableIntroduction (Ident restVar) (Just (JSApp (JSAccessor "slice" (JSVar (Ident varName))) [JSNumericLiteral (Left index)])) : js)
150 go done rest index (binder:bs) = do
146 go done rest index (binder:bs) = do
151 elVar <- fresh
147 elVar <- fresh
152 done' <- go done rest (index + 1) bs
148 done' <- go done rest (index + 1) bs
153− js <- binderToJs m elVar done' binder
149+ js <- binderToJs m e elVar done' binder
154 return (JSVariableIntroduction (Ident elVar) (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar (Ident varName)))) : js)
150 return (JSVariableIntroduction (Ident elVar) (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar (Ident varName)))) : js)
155−binderToJs m varName done (NamedBinder ident binder) = do
151+binderToJs m e varName done (NamedBinder ident binder) = do
156− js <- binderToJs m varName done binder
152+ js <- binderToJs m e varName done binder
157 return (JSVariableIntroduction ident (Just (JSVar (Ident varName))) : js)
153 return (JSVariableIntroduction ident (Just (JSVar (Ident varName))) : js)
158−binderToJs m varName done (GuardedBinder cond binder) = binderToJs m varName done' binder
154+binderToJs m e varName done (GuardedBinder cond binder) = binderToJs m e varName done' binder
159 where
155 where
160− done' = [JSIfElse (valueToJs m cond) (JSBlock done) Nothing]
156+ done' = [JSIfElse (valueToJs m e cond) (JSBlock done) Nothing]
161
157
162−statementToJs :: ModulePath -> Statement -> JS
158+statementToJs :: ModulePath -> Environment -> Statement -> JS
163−statementToJs m (VariableIntroduction ident value) = JSVariableIntroduction ident (Just (valueToJs m value))
159+statementToJs m e (VariableIntroduction ident value) = JSVariableIntroduction ident (Just (valueToJs m e value))
164−statementToJs m (Assignment target value) = JSAssignment (JSAssignVariable target) (valueToJs m value)
160+statementToJs m e (Assignment target value) = JSAssignment (JSAssignVariable target) (valueToJs m e value)
165−statementToJs m (While cond sts) = JSWhile (valueToJs m cond) (JSBlock (map (statementToJs m) sts))
161+statementToJs m e (While cond sts) = JSWhile (valueToJs m e cond) (JSBlock (map (statementToJs m e) sts))
166−statementToJs m (For ident start end sts) = JSFor ident (valueToJs m start) (valueToJs m end) (JSBlock (map (statementToJs m) sts))
162+statementToJs m e (For ident start end sts) = JSFor ident (valueToJs m e start) (valueToJs m e end) (JSBlock (map (statementToJs m e) sts))
167−statementToJs m (ForEach ident arr sts) = JSApp (JSAccessor "forEach" (valueToJs m arr)) [JSFunction Nothing [ident] (JSBlock (map (statementToJs m) sts))]
163+statementToJs m e (ForEach ident arr sts) = JSApp (JSAccessor "forEach" (valueToJs m e arr)) [JSFunction Nothing [ident] (JSBlock (map (statementToJs m e) sts))]
168−statementToJs m (If ifst) = ifToJs ifst
164+statementToJs m e (If ifst) = ifToJs ifst
169 where
165 where
170 ifToJs :: IfStatement -> JS
166 ifToJs :: IfStatement -> JS
171− ifToJs (IfStatement cond thens elses) = JSIfElse (valueToJs m cond) (JSBlock (map (statementToJs m) thens)) (fmap elseToJs elses)
167+ ifToJs (IfStatement cond thens elses) = JSIfElse (valueToJs m e cond) (JSBlock (map (statementToJs m e) thens)) (fmap elseToJs elses)
172 elseToJs :: ElseStatement -> JS
168 elseToJs :: ElseStatement -> JS
173− elseToJs (Else sts) = JSBlock (map (statementToJs m) sts)
169+ elseToJs (Else sts) = JSBlock (map (statementToJs m e) sts)
174 elseToJs (ElseIf ifst) = ifToJs ifst
170 elseToJs (ElseIf ifst) = ifToJs ifst
175−statementToJs m (Return value) = JSReturn (valueToJs m value)
171+statementToJs m e (Return value) = JSReturn (valueToJs m e value)