@@ -81,7 +81,7 @@ bindToJs mp (NonRec ident val) = return <$> nonRecToJS mp ident val
8181bindToJs mp (Rec vals) = forM vals (uncurry (nonRecToJS mp))
8282
8383-- |
84−-- Generate code in the simplified Javascript intermediate representation for a single non-recursive
84+-- Generate code in the simplified Javascript intermediate representation for a single non-recursive
8585-- declaration.
8686--
8787-- The main purpose of this function is to handle code generation for comments.
@@ -92,7 +92,7 @@ nonRecToJS m i e@(extractAnn -> (_, com, _, _)) | not (null com) =
9292nonRecToJS mp ident val = do
9393 js <- valueToJs mp val
9494 return $ JSVariableIntroduction (identToJs ident) (Just js)
95−
95+
9696
9797-- |
9898-- Generate code in the simplified Javascript intermediate representation for a variable based on a
@@ -171,26 +171,23 @@ valueToJs _ (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) =
171171 JSObjectLiteral [("create",
172172 JSFunction Nothing ["value"]
173173 (JSBlock [JSReturn $ JSVar "value"]))])
174−valueToJs _ (Constructor _ _ (ProperName ctor) 0) =
174+valueToJs _ (Constructor _ _ (ProperName ctor) []) =
175175 return $ iife ctor [ JSFunction (Just ctor) [] (JSBlock [])
176176 , JSAssignment (JSAccessor "value" (JSVar ctor))
177177 (JSUnary JSNew $ JSApp (JSVar ctor) []) ]
178−valueToJs _ (Constructor _ _ (ProperName ctor) arity) =
179− return $ iife ctor [ makeConstructor ctor arity
180− , JSAssignment (JSAccessor "create" (JSVar ctor)) (go ctor 0 arity [])
178+valueToJs _ (Constructor _ _ (ProperName ctor) fields) =
179+ return $ iife ctor [ makeConstructor ctor fields
180+ , JSAssignment (JSAccessor "create" (JSVar ctor)) (makeCreateFn ctor fields)
181181 ]
182182 where
183− makeConstructor :: String -> Int -> JS
184− makeConstructor ctorName n =
185− let args = [ "value" ++ show index | index <- [0..n-1] ]
186− body = [ JSAssignment (JSAccessor arg (JSVar "this")) (JSVar arg) | arg <- args ]
187− in JSFunction (Just ctorName) args (JSBlock body)
188− go :: String -> Int -> Int -> [JS] -> JS
189− go pn _ 0 values = JSUnary JSNew $ JSApp (JSVar pn) (reverse values)
190− go pn index n values =
191− JSFunction Nothing ["value" ++ show index]
192− (JSBlock [JSReturn (go pn (index + 1) (n - 1) (JSVar ("value" ++ show index) : values))])
193−
183+ makeConstructor :: String -> [Ident] -> JS
184+ makeConstructor ctorName fs =
185+ let body = [ JSAssignment (JSAccessor (identToJs f) (JSVar "this")) (var f) | f <- fs ]
186+ in JSFunction (Just ctorName) (identToJs `map` fs) (JSBlock body)
187+ makeCreateFn :: String -> [Ident] -> JS
188+ makeCreateFn ctorName fs =
189+ let body = JSUnary JSNew $ JSApp (JSVar ctorName) (var `map` fs)
190+ in foldr (\f inner -> JSFunction Nothing [identToJs f] (JSBlock [JSReturn inner])) body fields
194191iife :: String -> [JS] -> JS
195192iife v exprs = JSApp (JSFunction Nothing [] (JSBlock $ exprs ++ [JSReturn $ JSVar v])) []
196193