@@ -138,8 +138,8 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
138138 -- Generate code in the simplified Javascript intermediate representation for a declaration
139139 --
140140 bindToJs :: Bind Ann -> m [JS]
141− bindToJs (NonRec ann ident val) = nonRecToJS ann ident val
142− bindToJs (Rec vals) = concat <$> forM vals (uncurry . uncurry $ nonRecToJS)
141+ bindToJs (NonRec ann ident val) = return <$> nonRecToJS ann ident val
142+ bindToJs (Rec vals) = forM vals (uncurry . uncurry $ nonRecToJS)
143143
144144 -- |
145145 -- Generate code in the simplified Javascript intermediate representation for a single non-recursive
@@ -147,22 +147,15 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
147147 --
148148 -- The main purpose of this function is to handle code generation for comments.
149149 --
150− nonRecToJS :: Ann -> Ident -> Expr Ann -> m [JS]
150+ nonRecToJS :: Ann -> Ident -> Expr Ann -> m JS
151151 nonRecToJS a i e@(extractAnn -> (_, com, _, _)) | not (null com) = do
152152 withoutComment <- asks optionsNoComments
153153 if withoutComment
154154 then nonRecToJS a i (modifyAnn removeComments e)
155− else withHead (JSComment Nothing com) <$> nonRecToJS a i (modifyAnn removeComments e)
156− where
157− withHead _ [] = []
158− withHead f (x:xs) = f x : xs
155+ else JSComment Nothing com <$> nonRecToJS a i (modifyAnn removeComments e)
159156 nonRecToJS (ss, _, _, _) ident val = do
160− case constructorToJs ident val of
161− Just jss ->
162− traverse (withPos ss) jss
163− Nothing -> do
164− js <- valueToJs val
165− return <$> (withPos ss $ JSVariableIntroduction Nothing (identToJs ident) (Just js))
157+ js <- valueToJs val
158+ withPos ss $ JSVariableIntroduction Nothing (identToJs ident) (Just js)
166159
167160 withPos :: Maybe SourceSpan -> JS -> m JS
168161 withPos (Just ss) js = do
@@ -258,37 +251,23 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
258251 JSObjectLiteral Nothing [("create",
259252 JSFunction Nothing Nothing ["value"]
260253 (JSBlock Nothing [JSReturn Nothing $ JSVar Nothing "value"]))])
261− valueToJs' (Constructor _ _ (ProperName ctor) _) =
262− internalError $ "Unexpected constructor definition: " ++ T.unpack ctor
263−
264− -- |
265− -- Attempt to generate code in the simplified JS intermediate representation for a constructor definition.
266− -- If the argument is not a constructor, this returns Nothing.
267− --
268− constructorToJs :: Ident -> Expr Ann -> Maybe [JS]
269− constructorToJs ident (Constructor _ _ (ProperName ctor) fs) =
270− Just jss
271− where
272− mkAccessor name = JSAssignment Nothing (accessorString name (JSVar Nothing (identToJs ident)))
273− jss = case fs of
274− [] ->
275− [ JSVariableIntroduction Nothing (identToJs ident) (Just $
276− JSFunction Nothing (Just (properToJs ctor)) [] (JSBlock Nothing []))
277− , mkAccessor "value" $
278− JSUnary Nothing JSNew $ JSApp Nothing (JSVar Nothing (identToJs ident)) []
279− ]
280− fields ->
281− let constructor =
282− let body = [ JSAssignment Nothing ((accessorString $ mkString $ identToJs f) (JSVar Nothing "this")) (var f) | f <- fields ]
283− in JSFunction Nothing (Just (properToJs ctor)) (identToJs `map` fields) (JSBlock Nothing body)
284− createFn =
285− let body = JSUnary Nothing JSNew $ JSApp Nothing (JSVar Nothing (properToJs ctor)) (var `map` fields)
286− in foldr (\f inner -> JSFunction Nothing Nothing [identToJs f] (JSBlock Nothing [JSReturn Nothing inner])) body fields
287− in [ constructor
288− , mkAccessor "create" createFn
289− ]
290− constructorToJs _ _ =
291− Nothing
254+ valueToJs' (Constructor _ _ (ProperName ctor) []) =
255+ return $ iife (properToJs ctor) [ JSFunction Nothing (Just (properToJs ctor)) [] (JSBlock Nothing [])
256+ , JSAssignment Nothing (accessorString "value" (JSVar Nothing (properToJs ctor)))
257+ (JSUnary Nothing JSNew $ JSApp Nothing (JSVar Nothing (properToJs ctor)) []) ]
258+ valueToJs' (Constructor _ _ (ProperName ctor) fields) =
259+ let constructor =
260+ let body = [ JSAssignment Nothing ((accessorString $ mkString $ identToJs f) (JSVar Nothing "this")) (var f) | f <- fields ]
261+ in JSFunction Nothing (Just (properToJs ctor)) (identToJs `map` fields) (JSBlock Nothing body)
262+ createFn =
263+ let body = JSUnary Nothing JSNew $ JSApp Nothing (JSVar Nothing (properToJs ctor)) (var `map` fields)
264+ in foldr (\f inner -> JSFunction Nothing Nothing [identToJs f] (JSBlock Nothing [JSReturn Nothing inner])) body fields
265+ in return $ iife (properToJs ctor) [ constructor
266+ , JSAssignment Nothing (accessorString "create" (JSVar Nothing (properToJs ctor))) createFn
267+ ]
268+
269+ iife :: Text -> [JS] -> JS
270+ iife v exprs = JSApp Nothing (JSFunction Nothing Nothing [] (JSBlock Nothing $ exprs ++ [JSReturn Nothing $ JSVar Nothing v])) []
292271
293272 literalToValueJS :: Literal (Expr Ann) -> m JS
294273 literalToValueJS (NumericLiteral (Left i)) = return $ JSNumericLiteral Nothing (Left i)