@@ -34,13 +34,14 @@ import Language.PureScript.Declarations
3434import Language.PureScript.Pretty.Common
3535import Language.PureScript.CodeGen.Monad
3636import Language.PureScript.CodeGen.JS.AST as AST
37+import Language.PureScript.TypeChecker.Monad (NameKind(..))
3738
3839declToJs :: Maybe Ident -> ModulePath -> Declaration -> Environment -> Maybe [JS]
39−declToJs mod mp (ValueDeclaration ident (Abs args ret)) _ =
40− Just $ JSFunction (Just ident) args (JSBlock [JSReturn (valueToJs mp ret)]) :
40+declToJs mod mp (ValueDeclaration ident (Abs args ret)) e =
41+ Just $ JSFunction (Just ident) args (JSBlock [JSReturn (valueToJs mp e ret)]) :
4142 maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod
42−declToJs mod mp (ValueDeclaration ident val) _ =
43− Just $ JSVariableIntroduction ident (Just (valueToJs mp val)) :
43+declToJs mod mp (ValueDeclaration ident val) e =
44+ Just $ JSVariableIntroduction ident (Just (valueToJs mp e val)) :
4445 maybe [] (return . setProperty (identToJs ident) (JSVar ident)) mod
4546declToJs mod _ (ExternMemberDeclaration member ident _) _ =
4647 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 =
6364 [JSAssignment (JSAssignVariable (Ident name))
6465 (JSBinary Or (JSVar (Ident name)) (JSObjectLiteral []))]] ++
6566 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)))
7367declToJs _ _ _ _ = Nothing
7468
7569setProperty :: String -> JS -> Ident -> JS
7670setProperty prop val mod = JSAssignment (JSAssignProperty prop (JSAssignVariable mod)) val
7771
78−valueToJs :: ModulePath -> Value -> JS
79−valueToJs _ (NumericLiteral n) = JSNumericLiteral n
80−valueToJs _ (StringLiteral s) = JSStringLiteral s
81−valueToJs _ (BooleanLiteral b) = JSBooleanLiteral b
82−valueToJs m (ArrayLiteral xs) = JSArrayLiteral (map (valueToJs m) xs)
83−valueToJs m (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs m)) ps)
84−valueToJs m (ObjectUpdate o ps) = JSApp (JSAccessor "extend" (JSVar (Ident "Object"))) [ valueToJs m o, JSObjectLiteral (map (second (valueToJs m)) ps)]
85−valueToJs m (Constructor name) = qualifiedToJS runProperName name
86−valueToJs m (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs m) sts))) []
87−valueToJs m (Case value binders) = runGen (bindersToJs m binders (valueToJs m value))
88−valueToJs m (IfThenElse cond th el) = JSConditional (valueToJs m cond) (valueToJs m th) (valueToJs m el)
89−valueToJs m (Accessor prop val) = JSAccessor prop (valueToJs m val)
90−valueToJs m (Indexer index val) = JSIndexer (valueToJs m index) (valueToJs m val)
91−valueToJs m (App val args) = JSApp (valueToJs m val) (map (valueToJs m) args)
92−valueToJs m (Abs args val) = JSFunction Nothing args (JSBlock [JSReturn (valueToJs m val)])
93−valueToJs m (Unary op val) = JSUnary op (valueToJs m val)
94−valueToJs m (Binary op v1 v2) = JSBinary op (valueToJs m v1) (valueToJs m v2)
95−valueToJs m (Var ident) = qualifiedToJS identToJs ident
96−valueToJs m (TypedValue val _) = valueToJs m val
72+valueToJs :: ModulePath -> Environment -> Value -> JS
73+valueToJs _ _ (NumericLiteral n) = JSNumericLiteral n
74+valueToJs _ _ (StringLiteral s) = JSStringLiteral s
75+valueToJs _ _ (BooleanLiteral b) = JSBooleanLiteral b
76+valueToJs m e (ArrayLiteral xs) = JSArrayLiteral (map (valueToJs m e) xs)
77+valueToJs m e (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs m e)) 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)]
79+valueToJs m e (Constructor name) = qualifiedToJS runProperName name
80+valueToJs m e (Block sts) = JSApp (JSFunction Nothing [] (JSBlock (map (statementToJs m e) sts))) []
81+valueToJs m e (Case value binders) = runGen (bindersToJs m e binders (valueToJs m e value))
82+valueToJs m e (IfThenElse cond th el) = JSConditional (valueToJs m e cond) (valueToJs m e th) (valueToJs m e el)
83+valueToJs m e (Accessor prop val) = JSAccessor prop (valueToJs m e val)
84+valueToJs m e (Indexer index val) = JSIndexer (valueToJs m e index) (valueToJs m e val)
85+valueToJs m e (App val args) = JSApp (valueToJs m e val) (map (valueToJs m e) args)
86+valueToJs m e (Abs args val) = JSFunction Nothing args (JSBlock [JSReturn (valueToJs m e val)])
87+valueToJs m e (Unary op val) = JSUnary op (valueToJs m e val)
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)
91+ _ -> qualifiedToJS identToJs ident
92+valueToJs m e (TypedValue val _) = valueToJs m e val
9793
9894qualifiedToJS :: (a -> String) -> Qualified a -> JS
9995qualifiedToJS f (Qualified (ModulePath parts) a) =
@@ -101,41 +97,41 @@ qualifiedToJS f (Qualified (ModulePath parts) a) =
10197 where delimited [part] = JSVar (Ident (part))
10298 delimited (part:parts) = JSAccessor part (delimited parts)
10399
104−bindersToJs :: ModulePath -> [(Binder, Value)] -> JS -> Gen JS
105−bindersToJs m binders val = do
100+bindersToJs :: ModulePath -> Environment -> [(Binder, Value)] -> JS -> Gen JS
101+bindersToJs m e binders val = do
106102 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
108104 return $ JSApp (JSFunction Nothing [Ident valName] (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))
109105 [val]
110106
111−binderToJs :: ModulePath -> String -> [JS] -> Binder -> Gen [JS]
112−binderToJs _ varName done NullBinder = return done
113−binderToJs _ varName done (StringBinder str) =
107+binderToJs :: ModulePath -> Environment -> String -> [JS] -> Binder -> Gen [JS]
108+binderToJs _ _ varName done NullBinder = return done
109+binderToJs _ _ varName done (StringBinder str) =
114110 return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSStringLiteral str)) (JSBlock done) Nothing]
115−binderToJs _ varName done (NumberBinder num) =
111+binderToJs _ _ varName done (NumberBinder num) =
116112 return [JSIfElse (JSBinary EqualTo (JSVar (Ident varName)) (JSNumericLiteral num)) (JSBlock done) Nothing]
117−binderToJs _ varName done (BooleanBinder True) =
113+binderToJs _ _ varName done (BooleanBinder True) =
118114 return [JSIfElse (JSVar (Ident varName)) (JSBlock done) Nothing]
119−binderToJs _ varName done (BooleanBinder False) =
115+binderToJs _ _ varName done (BooleanBinder False) =
120116 return [JSIfElse (JSUnary Not (JSVar (Ident varName))) (JSBlock done) Nothing]
121−binderToJs _ varName done (VarBinder ident) =
117+binderToJs _ e varName done (VarBinder ident) =
122118 return (JSVariableIntroduction ident (Just (JSVar (Ident varName))) : done)
123−binderToJs m varName done (NullaryBinder ctor) =
119+binderToJs m e varName done (NullaryBinder ctor) =
124120 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
126122 value <- fresh
127− js <- binderToJs m value done b
123+ js <- binderToJs m e value done b
128124 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
130126 where
131127 go :: [JS] -> [(String, Binder)] -> Gen [JS]
132128 go done [] = return done
133129 go done ((prop, binder):bs) = do
134130 propVar <- fresh
135131 done' <- go done bs
136− js <- binderToJs m propVar done' binder
132+ js <- binderToJs m e propVar done' binder
137133 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
139135 js <- go done rest 0 bs
140136 return [JSIfElse (JSBinary cmp (JSAccessor "length" (JSVar (Ident varName))) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
141137 where
@@ -145,31 +141,31 @@ binderToJs m varName done (ArrayBinder bs rest) = do
145141 go done Nothing _ [] = return done
146142 go done (Just binder) index [] = do
147143 restVar <- fresh
148− js <- binderToJs m restVar done binder
144+ js <- binderToJs m e restVar done binder
149145 return (JSVariableIntroduction (Ident restVar) (Just (JSApp (JSAccessor "slice" (JSVar (Ident varName))) [JSNumericLiteral (Left index)])) : js)
150146 go done rest index (binder:bs) = do
151147 elVar <- fresh
152148 done' <- go done rest (index + 1) bs
153− js <- binderToJs m elVar done' binder
149+ js <- binderToJs m e elVar done' binder
154150 return (JSVariableIntroduction (Ident elVar) (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar (Ident varName)))) : js)
155−binderToJs m varName done (NamedBinder ident binder) = do
156− js <- binderToJs m varName done binder
151+binderToJs m e varName done (NamedBinder ident binder) = do
152+ js <- binderToJs m e varName done binder
157153 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
159155 where
160− done' = [JSIfElse (valueToJs m cond) (JSBlock done) Nothing]
156+ done' = [JSIfElse (valueToJs m e cond) (JSBlock done) Nothing]
161157
162−statementToJs :: ModulePath -> Statement -> JS
163−statementToJs m (VariableIntroduction ident value) = JSVariableIntroduction ident (Just (valueToJs m value))
164−statementToJs m (Assignment target value) = JSAssignment (JSAssignVariable target) (valueToJs m value)
165−statementToJs m (While cond sts) = JSWhile (valueToJs m cond) (JSBlock (map (statementToJs m) sts))
166−statementToJs m (For ident start end sts) = JSFor ident (valueToJs m start) (valueToJs m end) (JSBlock (map (statementToJs m) sts))
167−statementToJs m (ForEach ident arr sts) = JSApp (JSAccessor "forEach" (valueToJs m arr)) [JSFunction Nothing [ident] (JSBlock (map (statementToJs m) sts))]
168−statementToJs m (If ifst) = ifToJs ifst
158+statementToJs :: ModulePath -> Environment -> Statement -> JS
159+statementToJs m e (VariableIntroduction ident value) = JSVariableIntroduction ident (Just (valueToJs m e value))
160+statementToJs m e (Assignment target value) = JSAssignment (JSAssignVariable target) (valueToJs m e value)
161+statementToJs m e (While cond sts) = JSWhile (valueToJs m e cond) (JSBlock (map (statementToJs m e) 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))
163+statementToJs m e (ForEach ident arr sts) = JSApp (JSAccessor "forEach" (valueToJs m e arr)) [JSFunction Nothing [ident] (JSBlock (map (statementToJs m e) sts))]
164+statementToJs m e (If ifst) = ifToJs ifst
169165 where
170166 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)
172168 elseToJs :: ElseStatement -> JS
173− elseToJs (Else sts) = JSBlock (map (statementToJs m) sts)
169+ elseToJs (Else sts) = JSBlock (map (statementToJs m e) sts)
174170 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)