@@ -40,7 +40,6 @@ import System.Directory (doesFileExist)
4040import System.Environment
4141import System.FilePath
4242
43−
4443-- | Code generation stats hold information about the generated user
4544-- code. Based on that information we add additional code to make
4645-- things work.
@@ -99,14 +98,31 @@ isYes (Just "Y") = True
9998isYes (Just "y") = True
10099isYes _ = False
101100
102−makeExportDecls :: ExportIFace -> [Text]
103−makeExportDecls (Export _ _ e) =
101+makeExportDecls :: Map Name LDecl -> ExportIFace -> [Text]
102+makeExportDecls defs (Export _ _ e) =
104103 concatMap makeExport e
105104 where
105+ uncurryF name argTy (Just args) =
106+ if length argTy == length args then name
107+ else T.concat [ "function(){ return "
108+ , name
109+ , ".apply(this, Array.prototype.slice.call(arguments, 0,", T.pack $ show $ length args,"))"
110+ , T.concat $ map (\x -> T.concat ["(arguments[", T.pack $ show x , "])"]) [length args .. (length argTy - 1)]
111+ , "}"
112+ ]
113+ uncurryF name argTy Nothing = name
114+
115+ addApplyForIO (FIO _) f = T.concat ["function(){ return (",f, ").apply(this,arguments)()}"]
116+ addApplyForIO _ f = f
117+
106118 makeExport (ExportData _) =
107119 []
108− makeExport (ExportFun name (FStr exportname) _ _) =
109− [T.concat [T.pack $ exportname, ": ", jsName name]]
120+ makeExport (ExportFun name (FStr exportname) retTy argTy) =
121+ [T.concat [ T.pack $ exportname
122+ , ": "
123+ , addApplyForIO retTy $ uncurryF (jsName name) argTy (getArgList' name defs)
124+ ]
125+ ]
110126
111127codegenJs :: CGConf -> CodeGenerator
112128codegenJs conf ci =
@@ -148,7 +164,7 @@ codegenJs conf ci =
148164 , doPartials (partialApplications stats), "\n"
149165 , doHiddenClasses (hiddenClasses stats), "\n"
150166 , out, "\n"
151− , if iface then T.concat ["module.exports = {\n", T.intercalate ";\n" $ concatMap makeExportDecls (exportDecls ci), "\n};\n"]
167+ , if iface then T.concat ["module.exports = {\n", T.intercalate ",\n" $ concatMap (makeExportDecls defs) (exportDecls ci), "\n};\n"]
152168 else jsName (sMN 0 "runMain") `T.append` "();\n"
153169 , "}.call(this))"
154170 , footer conf
@@ -236,13 +252,17 @@ getConsId n =
236252 Just (LConstructor _ conId arity) -> pure (conId, arity)
237253 _ -> error $ "Internal JS Backend error " ++ showCG n ++ " is not a constructor."
238254
255+getArgList' :: Name -> Map Name LDecl -> Maybe [Name]
256+getArgList' n defs =
257+ case Map.lookup n defs of
258+ Just (LFun _ _ a _) -> Just a
259+ _ -> Nothing
260+
239261getArgList :: Name -> State CGBodyState (Maybe [Name])
240262getArgList n =
241263 do
242264 st <- get
243− case Map.lookup n (defs st) of
244− Just (LFun _ _ a _) -> pure $ Just a
245− _ -> pure Nothing
265+ pure $ getArgList' n (defs st)
246266
247267data BodyResTarget = ReturnBT
248268 | DecBT Text