@@ -80,12 +80,7 @@ isYes _ = False
8080codegenJs :: CGConf -> CodeGenerator
8181codegenJs conf ci =
8282 do
83− optim <- isYes <$> lookupEnv "IDRISJS_OPTIM"
8483 debug <- isYes <$> lookupEnv "IDRISJS_DEBUG"
85− if debug then
86− if optim then putStrLn "compiling width idris-js optimizations"
87− else putStrLn "compiling widthout idris-js optimizations"
88− else pure ()
8984 let defs = Map.fromList $ liftDecls ci
9085 let used = Map.elems $ removeDeadCode defs [sMN 0 "runMain"]
9186 if debug then
@@ -108,12 +103,15 @@ codegenJs conf ci =
108103 TIO.writeFile (outputFile ci) $ T.concat [ header conf
109104 , "\"use strict\";\n\n"
110105 , "(function(){\n\n"
106+ -- rts
111107 , runtimeCommon, "\n"
112108 , extraRT, "\n"
113109 , jsbn, "\n"
110+ -- external libraries
111+ , includes, "\n"
112+ -- user code
114113 , doPartials (partialApplications stats), "\n"
115114 , doHiddenClasses (hiddenClasses stats), "\n"
116− , includes, "\n"
117115 , out, "\n"
118116 , jsName (sMN 0 "runMain"), "();\n"
119117 , "}.call(this))"
@@ -135,6 +133,7 @@ doHiddenClasses :: Set HiddenClass -> Text
135133doHiddenClasses x =
136134 T.intercalate "\n" (map f $ Set.toList x)
137135 where
136+ f p@(HiddenClass n id 0) = jsStmt2Text $ JsDecConst (jsNameHiddenClass p) $ JsObj [("type", JsInt id)]
138137 f p@(HiddenClass n id arity) =
139138 let vars = map dataPartName $ take arity [1..]
140139 in jsStmt2Text $
@@ -349,27 +348,9 @@ cgBody' rt (LApp tailcall (LV (Glob fn)) args) =
349348 let ((y1,y2), y3) = tailCallOptimRefreshArgs (zip argN argVals) Set.empty
350349 addUsedArgsTailCallOptim y3
351350 pure (preDecs, y1 `JsSeq` y2)
352− _ ->
353− do
354− argsFn <- getArgList fn
355− case argsFn of
356− Nothing -> do
357− fn' <- cgName fn
358− pure (preDecs, addRT rt $ jsCurryApp fn' argVals )
359− Just agFn ->
360− do
361− let lenAgFn = length agFn
362− let lenArgs = length args
363− case compare lenAgFn lenArgs of
364− EQ ->
365− pure (preDecs, addRT rt $ jsAppN fname argVals)
366− LT ->
367− pure (preDecs, addRT rt $ jsCurryApp (jsAppN fname (take lenAgFn argVals)) (drop lenAgFn argVals) )
368− GT ->
369− do
370− let part = Partial fn lenArgs lenAgFn
371− addPartial part
372− pure (preDecs, addRT rt $ jsAppN (jsNamePartial part) argVals )
351+ _ -> do
352+ app <- formApp fn argVals
353+ pure (preDecs, addRT rt app)
373354
374355cgBody' rt (LForce (LLazyApp n args)) = cgBody rt (LApp False (LV (Glob n)) args)
375356cgBody' rt (LLazyApp n args) =
@@ -447,18 +428,36 @@ altHasNoProj :: LAlt -> Bool
447428altHasNoProj (LConCase _ _ args _) = args == []
448429altHasNoProj _ = True
449430
431+formApp :: Name -> [JsExpr] -> State CGBodyState JsExpr
432+formApp fn argVals = case specialCall fn of
433+ Just (arity, g) | arity == length argVals -> pure $ g argVals
434+ _ -> do
435+ argsFn <- getArgList fn
436+ fname <- cgName fn
437+ case argsFn of
438+ Nothing -> pure $ jsCurryApp fname argVals
439+ Just agFn -> do
440+ let lenAgFn = length agFn
441+ let lenArgs = length argVals
442+ case compare lenAgFn lenArgs of
443+ EQ -> pure $ JsApp fname argVals
444+ LT -> pure $ jsCurryApp (JsApp fname (take lenAgFn argVals)) (drop lenAgFn argVals)
445+ GT -> do
446+ let part = Partial fn lenArgs lenAgFn
447+ addPartial part
448+ pure $ jsAppN (jsNamePartial part) argVals
449+
450450formCon :: Name -> [JsExpr] -> State CGBodyState JsExpr
451451formCon n args = do
452452 case specialCased n of
453453 Just (ctor, test, match) -> pure $ ctor args
454454 Nothing -> do
455455 (conId, arity) <- getConsId n
456− if (arity > 0)
457− then do
458− let hc = HiddenClass n conId arity
459− addHiddenClass hc
460− pure $ JsNew (JsVar $ jsNameHiddenClass hc) args
461− else pure $ JsInt conId
456+ let hc = HiddenClass n conId arity
457+ addHiddenClass hc
458+ pure $ if (arity > 0)
459+ then JsNew (JsVar $ jsNameHiddenClass hc) args
460+ else JsVar $ jsNameHiddenClass hc
462461
463462formConTest :: Name -> JsExpr -> State CGBodyState JsExpr
464463formConTest n x = do
@@ -466,9 +465,10 @@ formConTest n x = do
466465 Just (ctor, test, match) -> pure $ test x
467466 Nothing -> do
468467 (conId, arity) <- getConsId n
469− if (arity > 0)
470− then pure $ JsBinOp "===" (JsProp x (T.pack "type")) (JsInt conId)
471− else pure $ JsBinOp "===" x (JsInt conId)
468+ pure $ JsBinOp "===" (JsProp x (T.pack "type")) (JsInt conId)
469+ -- if (arity > 0)
470+ -- then pure $ JsBinOp "===" (JsProp x (T.pack "type")) (JsInt conId)
471+ -- else pure $ JsBinOp "===" x (JsInt conId)
472472
473473formProj :: Name -> JsExpr -> Int -> JsExpr
474474formProj n v i =