module Lib.Compile.JS

import Prelude
import Lib.Common
import Lib.Types
import Lib.Eval
import Lib.Prettier
import Lib.Compile.CExp
import Lib.Compile.Common
import Lib.TopContext
import Lib.Compile.LiftWhere
-- import Lib.Compile.LiftLambda
import Lib.Compile.TCO
import Lib.Ref2
import Data.String
import Data.SnocList
import Data.Int
import Data.SortedMap
import Data.IORef

data StKind = Plain | Return | Assign String

data JSStmt : StKind -> U
data JSExp : U

data CaseType = CaseInd | CaseBool | CaseChar | CaseInt | CaseStr

derive Show CaseType

data JAlt : U where
  JConAlt : ∀ e. Nat -> JSStmt e -> JAlt
  JDefAlt : ∀ e. JSStmt e -> JAlt
  JLitAlt : ∀ e. JSExp -> JSStmt e -> JAlt

data JSExp : U where
  DataCon : Int -> List JSExp -> JSExp
  LitString : String -> JSExp
  LitChar : Char -> JSExp
  LitBool : Bool -> JSExp
  LitInt : Int -> JSExp
  -- Application of a closure
  ApplyCL : JSExp → JSExp → JSExp
  -- Application of a Ref, may create a closure
  ApplyRef : String → Nat → List JSExp → JSExp
  Var : String -> JSExp
  JFun : List String -> JSStmt Return -> JSExp
  JLam : String -> JSStmt Return -> JSExp
  JUndefined : JSExp
  JTernary : JSExp → JSExp → JSExp → JSExp
  Index : JSExp -> JSExp -> JSExp
  Dot : JSExp -> Int -> JSExp
  Raw : String -> JSExp

data JSStmt : StKind -> U where
  -- Maybe make this a snoc...
  JSnoc : ∀ a. JSStmt Plain -> JSStmt a -> JSStmt a
  JPlain : JSExp -> JSStmt Plain
  JConst : (nm : String) -> JSExp -> JSStmt Plain
  JReturn : JSExp -> JSStmt Return
  JLet : (nm : String) -> JSStmt (Assign nm) -> JSStmt Plain  -- need somebody to assign
  JAssign : (nm : String) -> JSExp -> JSStmt (Assign nm)
  JCase : ∀ a. CaseType -> JSExp -> List JAlt -> JSStmt a
  JIfThen : ∀ a. JSExp -> JSStmt a -> JSStmt a -> JSStmt a
  -- throw can't be used
  JError : ∀ a. String -> JSStmt a
  -- FIXME We're routing around the index here
  -- Might be able to keep the index if
  -- we add `Loop : List String -> StKind`
  -- JLoopAssign peels one off
  -- JContinue is a Loop Nil
  -- And LoopReturn
  JWhile : ∀ a. JSStmt a → JSStmt a
  JLoopAssign : (nm : String) → JSExp → JSStmt Plain
  JContinue : ∀ a. JSStmt a

alias Cont e = JSExp -> JSStmt e

mkAppRef : String → JSExp → JSExp → JSExp
mkAppRef nm x y = ApplyRef nm (S (S Z)) [x,y]

-- JSEnv contains `Var` for binders or `Dot` for destructured data. It
-- used to translate binders
record JSEnv where
  constructor MkEnv
  jsenv : List JSExp
  -- This is not depth, it is incremented as we go down the tree to get fresh names
  depth : Int
  noprim : Bool

-- this was like this, are we not using depth?
push : JSEnv -> JSExp -> JSEnv
push (MkEnv env depth noprim) exp = MkEnv (exp :: env) (depth + 1) noprim

incr : JSEnv → JSEnv
incr env = MkEnv env.jsenv (1 + env.depth) env.noprim

emptyJSEnv : JSEnv
emptyJSEnv = MkEnv Nil 0 False

altType : CAlt → CaseType
altType (CLitAlt (LString _) _) = CaseStr
altType (CLitAlt (LInt _) _) = CaseInt
altType (CLitAlt (LChar _) _) = CaseChar
altType (CLitAlt (LBool _) _) = CaseBool
altType _ = CaseInd

litToJS : Literal -> JSExp
litToJS (LString str) = LitString str
litToJS (LBool b) = LitBool b
litToJS (LChar c) = LitChar c
litToJS (LInt i) = LitInt i

-- Stuff nm.h1, nm.h2, ... into environment for constructor match
conAltEnv : JSExp -> Int -> JSEnv -> List String -> JSEnv
conAltEnv sc k env Nil = env
conAltEnv sc k env (_ :: xs) = conAltEnv sc (1 + k) (push env (Dot sc k)) xs

-- given a name, find a similar one that doesn't shadow in Env
freshName : String -> JSEnv -> String
freshName nm env = if free env.jsenv nm then nm else go nm 1
  where
    free : List JSExp -> String -> Bool
    free Nil nm = True
    free (Var n :: xs) nm = if n == nm then False else free xs nm
    free (_ :: xs) nm = free xs nm

    go : String -> Int -> String
    go nm k = let nm' = "\{nm}\{show k}" in if free env.jsenv nm' then nm' else go nm (1 + k)

freshName' : String -> JSEnv -> (String × JSEnv)
freshName' nm env =
  let nm' = freshName nm env -- "\{nm}$\{show $ length env}"
      env' = push env (Var nm')
  in (nm', env')

-- get list of arg names and an environment with either references or undefined
-- depending on quantity
freshNames : List String -> JSEnv -> (List String × JSEnv)
freshNames nms env = go nms env Lin
  where
    go : List String -> JSEnv -> SnocList Name -> (List String × JSEnv)
    go Nil env acc = (acc <>> Nil, env)
    go (n :: ns) env acc =
      let (n', env') = freshName' n env
      in go ns env' (acc :< n')

-- These expressions are added to the environment rather than assigned to a name
simpleJSExp : JSExp → Bool
simpleJSExp (Var _) = True
simpleJSExp (Dot a _) = simpleJSExp a
simpleJSExp (JUndefined) = True
simpleJSExp (Index a b) = if simpleJSExp a then simpleJSExp b else False
simpleJSExp (LitInt _) = True
simpleJSExp (LitString _) = True
simpleJSExp (LitBool _) = True
simpleJSExp _ = False

getEnv : Int → List JSExp → JSExp
getEnv ix env = case getAt' ix env of
  Just e => e
  Nothing => fatalError "Bad bounds \{show ix}"

-- This is inspired by A-normalization, look into the continuation monad
-- There is an index on JSStmt, adopted from Stefan Hoeck's code.
--
-- Here we turn a Term into a statement (which may be a sequence of statements), there
-- is a continuation, which turns the final JSExpr into a JSStmt, and the function returns
-- a JSStmt, wrapping recursive calls in JSnoc if necessary.
termToJS : ∀ e. JSEnv -> CExp -> Cont e -> JSStmt e

argsToJS : ∀ e. JSEnv → List CExp → (List JSExp → JSStmt e) → JSStmt e
argsToJS {e} env args f = go Lin args
  where
    go : SnocList JSExp → List CExp → JSStmt e
    go acc Nil = f (acc <>> Nil)
    go acc (x :: xs) = termToJS env x $ \ x => go (acc :< x) xs

termToJS env (CBnd k) f = f $ getEnv k env.jsenv
-- REVIEW - might need to handle these in lifting..
termToJS env (CForce t) f = termToJS env t $ \ t' => f $ ApplyCL t' JUndefined
-- REVIEW was Nil for args
termToJS env (CThunk t) f = f $ JLam (freshName "_" env) $ termToJS env t JReturn
termToJS env CErased f = f JUndefined
termToJS env (CRaw str _) f = f (Raw str)
termToJS env (CLam nm t) f =
  let (nm',env') = freshName' nm env -- "\{nm}$\{show $ length env}"
  in f $ JLam nm' (termToJS env' t JReturn)
termToJS env (CFun nms t) f =
  let (nms', env') = freshNames nms env
  in f $ JFun nms' (termToJS env' t JReturn)
-- 0-arity
termToJS env (CRef nm) f = f $ Var (show nm)
-- termToJS env (CPrimOp op t u) f = termToJS env t $ \ t => termToJS env u $ \ u => f $ JPrimOp op t u
termToJS env (CMeta k) f = f $ LitString "META \{show k}"
termToJS env (CLit lit) f = f (litToJS lit)
-- if it's a var, just use the original
termToJS env (CLet nm (CBnd k) u) f = termToJS (push env $ getEnv k env.jsenv) u f
-- For a let, we run with a continuation to JAssign to a pre-declared variable
-- if JAssign comes back out, we either push the JSExpr into the environment or JConst it,
-- depending on complexity. Otherwise, stick the declaration in front.
termToJS env (CLet nm t u) f =
  let nm' = freshName nm env
      env' = push env (Var nm')
  in case termToJS env t (JAssign nm') of
    (JAssign _ exp) => if simpleJSExp exp
      then termToJS (push env exp) u f
      else JSnoc (JConst nm' exp) (termToJS env' u f)
    t' => JSnoc (JLet nm' t') (termToJS env' u f)
termToJS env (CLetLoop args body) f =
  let off = length' args in
  -- Add lets for the args, we put this in a while and
  -- mutate the args, then continue for the self-call
  let (lets, env') = go (length' args - 1) args env Lin in
  JWhile $ foldr (\a b => JSnoc a b) (termToJS env' body f) lets
  where
    go : Int → List String -> JSEnv -> SnocList (JSStmt Plain) -> (List (JSStmt Plain) × JSEnv)
    go off Nil env acc = (acc <>> Nil, env)
    go off (n :: ns) env acc =
      let (n', env') = freshName' n env
      in go off ns env' (acc :< JConst n' (getEnv off env.jsenv))

termToJS env (CLetRec nm CErased u) f = termToJS (push env JUndefined) u f
termToJS env (CLetRec nm t u) f =
  -- this shouldn't happen if where is lifted
  let nm' = freshName nm env
      env' = push env (Var nm')
  -- If it's a simple term, use const
  in case termToJS env' t (JAssign nm') of
    (JAssign _ exp) => JSnoc (JConst nm' exp) (termToJS env' u f)
    t' => JSnoc (JLet nm' t') (termToJS env' u f)
termToJS env (CConstr ix _ args info) f = go args 1 (\ args => f $ DataCon (cast ix) args)
  where
    go : ∀ e. List CExp -> Int -> (List JSExp -> JSStmt e) -> JSStmt e
    go (t :: ts)  ix k = termToJS env t $ \ t' => go ts (ix + 1) $ \ args => k $ t' :: args
    go _ ix k = k Nil
termToJS {e} env (CLoop args quants) f = runArgs (reverse env.jsenv) args
  where
    runArgs : List JSExp → List CExp → JSStmt e
    runArgs (Var x :: rest) (arg :: args) =
      termToJS env arg $ \ arg' => JSnoc (JLoopAssign x arg') $ runArgs rest args
    runArgs _ _ = JContinue
termToJS env (CAppRef nm args quants) f = argsToJS env args $ \ args => f $ ApplyRef (show nm) quants args
termToJS env (CApp t arg) f = termToJS env t (\ t' => termToJS env arg (\arg' => f (ApplyCL t' arg')))
termToJS {e} env (CCase t alts) f =
  termToJS env t $ \case
    (Var nm) => maybeCaseStmt env (Var nm) alts
    t' =>
      -- TODO with inlining, we hit cases where the let gets pulled forward more than once
      -- two cases as separate args, so we need actual unique names. For now, we're calling
      -- incr when processing App, as a stopgap, we probably need a fresh names state monad
      -- also TODO find out when the case builder pulls out sc$ for us and when we do
      -- _sc here.  It seems like nm doesn't get used in the CDefAlt case.
      -- possibly from inlining?
      -- Lib.Parser.pratt has two (hence the incr)
      -- and record updates hit _sc$
      let nm = "_sc$\{show env.depth}"
          -- increment the bit that goes into the name
          env' = incr env
      in if simpleJSExp t'
        then (maybeCaseStmt env t' alts)
        else JSnoc (JConst nm t') (maybeCaseStmt env' (Var nm) alts)
  where
    tertiary : JSExp → JSStmt e → JSStmt e → Cont e → JSStmt e
    tertiary sc (JReturn t) (JReturn f) k = JReturn $ JTernary sc t f
    tertiary sc (JAssign nm t) (JAssign _ f) k = JAssign nm $ JTernary sc t f
    tertiary sc t f k = JIfThen sc t f

    termToJSAlt : JSEnv -> JSExp -> CAlt -> JAlt
    termToJSAlt env nm (CConAlt ix name info args u) = JConAlt ix (termToJS (conAltEnv nm 1 env args) u f)
    -- intentionally reusing scrutinee name here
    termToJSAlt env nm (CDefAlt u) = JDefAlt (termToJS (env) u f)
    termToJSAlt env nm (CLitAlt lit u) = JLitAlt (litToJS lit) (termToJS env u f)

    maybeCaseStmt : JSEnv -> JSExp -> List CAlt -> JSStmt e
    -- deleteT23 does this...
    maybeCaseStmt env sc (CDefAlt u :: Nil) = (termToJS env u f)
    -- If there is a single alt, assume it matched
    maybeCaseStmt env sc ((CConAlt _ _ info args u) :: Nil) = (termToJS (conAltEnv sc 1 env args) u f)
    maybeCaseStmt env sc alts@(CLitAlt _ u :: Nil) = termToJS env u f
    maybeCaseStmt env sc alts@(CDefAlt u :: Nil) = termToJS env u f
    maybeCaseStmt env sc alts = case alts of
        -- Bool alt becomes tertiary operator
        CLitAlt (LBool b) rhs :: alt :: Nil =>
          let t' = termToJS env rhs f
              e' = termToJS env (getBody alt) f
          in if b then tertiary sc t' e' f else tertiary sc e' t' f
        -- two branch alt becomes tertiary operator
        CConAlt ix name info args t :: CConAlt _ _ _ args' u :: Nil =>
          let cond = (mkAppRef "Prelude.eqInt" (Dot sc 0) (LitInt $ cast ix))
              t' = termToJS (conAltEnv sc 1 env args) t f
              u' = termToJS (conAltEnv sc 1 env args') u f
          in tertiary cond t' u' f
        alts@(alt@(CLitAlt _ _)  :: _) =>
          (JCase (altType alt) sc (map (termToJSAlt env sc) alts))
        -- fall back to switch statement
        alts => JCase CaseInd (Dot sc 0) (map (termToJSAlt env sc) alts)

jsKeywords : List String
jsKeywords = (
  "break" :: "case" :: "catch" :: "continue" :: "debugger" :: "default" :: "delete" :: "do" :: "else" ::
  "finally" :: "for" :: "function" :: "if" :: "in" :: "instanceof" :: "new" :: "return" :: "switch" ::
  "this" :: "throw" :: "try" :: "typeof" :: "var" :: "void" :: "while" :: "with" ::
  "class" :: "const" :: "enum" :: "export" :: "extends" :: "import" :: "super" ::
  "implements" :: "class" :: "let" :: "package" :: "private" :: "protected" :: "public" ::
  "static" :: "yield" ::
  "null" :: "true" :: "false" ::
  -- might not occur now that we have namespaces on the names
  "String" :: "Number" :: "Array" :: "BigInt" :: Nil)


-- escape identifiers for js
jsIdent : String -> Doc
jsIdent id = if elem id jsKeywords then text ("$" ++ id) else text $ pack $ fix (unpack id)
  where
    fix : List Char -> List Char
    fix Nil = Nil
    fix (x :: xs) =
      if isAlphaNum x || x == '_' then
        x :: fix xs
      -- make qualified names more readable
      else if x == '.' then '_' :: fix xs
      else if x == '$' then
        '$' :: '$' :: fix xs
      else
        '$' :: (toHex (cast x)) ++ fix xs


stmtToDoc : ∀ e. JSStmt e -> Doc

expToDoc : JSExp -> Doc
expToDoc (LitBool b) = if b then text "true" else text "false"
expToDoc (LitChar c) = text $ quoteString $ pack [c]
expToDoc (JTernary sc t f) = bracket "(" (expToDoc sc <+> text "?" <+> expToDoc t <+> text ":" <+> expToDoc f )")"
expToDoc (DataCon tag vals) = text "{" <+> text "tag:" <+> text (show tag) ++ text "," <+> folddoc (\ a e => a ++ text ", " <+/> e) (map entry $ enumerate vals) <+> text "}"
  where
    entry : (Nat × JSExp) -> Doc
    entry (nm, exp) = text "h\{show $ 1 + cast nm}" ++ text ":" <+> expToDoc exp
    entry (nm, exp) = jsIdent nm ++ text ":" <+> expToDoc exp
expToDoc (LitString str) = text $ quoteString str
expToDoc (LitInt i) = text $ show i
expToDoc (Raw str) = text str
-- TODO add precedence
expToDoc (ApplyCL x@(JLam _ _) xs) = text "(" ++ expToDoc x ++ text ")" ++ text "(" ++ nest 2 (expToDoc xs) ++ text ")"
expToDoc (ApplyCL x xs) = expToDoc x ++ text "(" ++ nest 2 (expToDoc xs) ++ text ")"
expToDoc (ApplyRef nm qs xs) =
  case xs of
    [x,y] => if cast qs == 2
      then case nm of
        "Prelude.addString"  => opdoc "+" x y
        "Prelude.addInt"  => opdoc "+" x y
        "Prelude.mulInt"  => opdoc "*" x y
        "Prelude.subInt"  => opdoc "-" x y
        "Prelude._&&_"  => opdoc "&&" x y
        "Prelude._||_"  => opdoc "||" x y
        -- Assumes Bool is in the right order!
        "Prelude.jsEq"  => opdoc "==" x y
        "Prelude.eqChar"  => opdoc "==" x y
        "Prelude.ltChar"  => opdoc "<" x y
        "Prelude.eqInt"  => opdoc "==" x y
        "Prelude.ltInt"  => opdoc "<" x y
        "Prelude.eqString"  => opdoc "==" x y
        "Prelude.ltString"  => opdoc "<" x y
        "Prelude.divInt"  => text "(" ++ (opdoc "/" x y) ++ text "|0)"
        _ => go xs qs
      else go xs qs
    [x] => if cast qs == 1 then
      case nm of
        "Prelude.incrInt" => opdoc "+" (LitInt 1) x
        -- "Prelude.intToNat" => expToDoc x
        "Prelude.natToInt" => expToDoc x
        _ => go xs qs
      else go xs qs
    _ => go xs qs
  where
    opdoc : String → JSExp → JSExp → Doc
    opdoc op x y = text "(" ++ expToDoc x <+> text op <+> expToDoc y ++ text ")"

    appRest : List JSExp → Doc → Doc
    appRest Nil doc = doc
    appRest (arg :: args) doc = appRest args $ doc ++ text "(" ++ expToDoc arg ++ text ")"

    appArgs : SnocList Doc → List JSExp → Nat → Doc
    appArgs acc Nil (S qs) =
      let n = snoclen' acc
          nm = "eta\{show n}"
       in text "(\{nm}) =>" <+> appArgs (acc :< text nm) Nil qs
    appArgs acc xs Z = appRest xs $ jsIdent nm ++ text "(" ++ commaSep (acc <>> []) ++ text ")"
    appArgs acc (x :: xs) (S qs) = appArgs (acc :< expToDoc x) xs qs

    go : List JSExp → Nat → Doc
    go args Z = appRest xs $ jsIdent nm
    go args qs = appArgs Lin args qs

expToDoc (Var nm) = jsIdent nm
expToDoc (JFun nms (JReturn exp)) = text "(" <+> commaSep (map jsIdent nms) <+> text ") =>" <+> text "(" ++ expToDoc exp ++ text ")"
expToDoc (JFun nms body) = text "(" <+> commaSep (map jsIdent nms) <+> text ") =>" <+> bracket "{" (stmtToDoc body) "}"
expToDoc (JLam nm (JReturn exp)) = text "(" <+> jsIdent nm <+> text ") =>" <+> text "(" ++ expToDoc exp ++ text ")"
expToDoc (JLam nm body) = text "(" <+> jsIdent nm <+> text ") =>" <+> bracket "{" (stmtToDoc body) "}"
expToDoc JUndefined = text "null"
expToDoc (Index obj ix) = expToDoc obj ++ text "[" ++ expToDoc ix ++ text "]"
expToDoc (Dot obj 0) = expToDoc obj ++ text ".tag"
expToDoc (Dot obj k) = expToDoc obj ++ text ".h\{show k}"

stmtWithBreak : ∀ e. JSStmt e → Doc
stmtWithBreak (JSnoc x y) = stmtToDoc x </> stmtWithBreak y
stmtWithBreak st@(JReturn _) = stmtToDoc st
stmtWithBreak st@(JContinue) = stmtToDoc st
stmtWithBreak st = stmtToDoc st </> text "break;"

caseBody : ∀ e. JSStmt e -> Doc
caseBody stmt@(JReturn x) = nest 2 (line ++ stmtToDoc stmt)
caseBody stmt@(JCase _ _ _) = nest 2 (line ++ stmtToDoc stmt </> text "break;")
caseBody stmt = line ++ text "{" ++ nest 2 (line ++ stmtWithBreak stmt) </> text "}"

altToDoc : JAlt -> Doc
altToDoc (JConAlt nm stmt) = text "case" <+> text (show nm) ++ text ":" ++ caseBody stmt
altToDoc (JDefAlt stmt) = text "default" ++ text ":" ++ caseBody stmt
altToDoc (JLitAlt a stmt) = text "case" <+> expToDoc a ++ text ":" ++ caseBody stmt

stmtToDoc (JSnoc x y) = stmtToDoc x </> stmtToDoc y
stmtToDoc (JPlain x) = expToDoc x ++ text ";"
-- I might not need these split yet.
stmtToDoc (JLet nm body) = text "let" <+> jsIdent nm ++ text ";" </> stmtToDoc body
stmtToDoc (JAssign nm expr) = jsIdent nm <+> text "=" <+> expToDoc expr ++ text ";"
stmtToDoc (JLoopAssign nm expr) = jsIdent nm <+> text "=" <+> expToDoc expr ++ text ";"
stmtToDoc (JContinue) = text "continue" ++ text ";"
stmtToDoc (JWhile stmt) = text "while (1)" <+> bracket "{" (stmtToDoc stmt) "}"
-- In the loop case, this may be reassigned
stmtToDoc (JConst nm x) = text "let" <+> jsIdent nm <+> nest 2 (text "=" <+/> expToDoc x ++ text ";")
stmtToDoc (JReturn x) = text "return" <+> expToDoc x ++ text ";"
stmtToDoc (JError str) = text "throw new Error(" ++ text (quoteString str) ++ text ");"
stmtToDoc (JIfThen sc t e) =
  text "if (" ++ expToDoc sc ++ text ")"
    <+> bracket "{" (stmtToDoc t) "}"
    <+> text "else" <+> bracket "{" (stmtToDoc e) "}"
stmtToDoc (JCase _ sc alts) =
  text "switch (" ++ expToDoc sc ++ text ")" <+> bracket "{" (stack $ map altToDoc alts) "}"

cexpToDoc : Bool → (QName × CExp) -> Doc
cexpToDoc exp (qn, ct) =
  case termToJS emptyJSEnv ct JReturn of
    JReturn t => doExport exp $ stmtToDoc $ JConst (show qn) t
    stmt =>
      -- use iife to turn stmts into expr
      let nm' = show qn ++ "_iife"
          doc1 = stmtToDoc $ JConst nm' $ JFun ["_"] stmt
          doc2 = stmtToDoc $ JConst (show qn) (ApplyRef nm' (S Z) [JUndefined])
       in doc1 </> doExport exp doc2
  where
    doExport : Bool → Doc → Doc
    doExport True doc = text "export" <+> doc
    doExport False doc = doc

-- returns a QName -> Def of in-use entries
-- This will be what we work on for optimization passes
getEntries : SortedMap QName Def → QName → M (SortedMap QName Def)
getEntries acc name = do
  top <- getTop
  case lookup name top of
    Nothing => do
      putStrLn "bad name \{show name}"
      pure acc
    Just (MkEntry _ _ name type def@(Fn exp) _) => case lookupMap' name acc of
      Just _ => pure acc
      Nothing => do
        top <- getTop
        exp <- zonk top 0 Nil exp
        let acc = updateMap name (Fn exp) acc
        foldlM getEntries acc $ getNames exp Nil
    Just (MkEntry _ _ name type def@(PrimFn _ _ used) _) =>
      let acc = updateMap name def acc in
      foldlM getEntries acc used
    Just entry => pure $ updateMap name entry.def acc

-- given a initial function, return a dependency-ordered list of javascript source
process : List QName → M (List Doc)
process names = do
  top <- getTop
  entries <- foldlM getEntries emptyMap names

  -- Maybe move this dance into liftWhere
  ref <- newIORef entries
  let foo = MkRef ref -- for the autos below
  liftWhere
  entries <- readIORef ref
  -- Now working with defs
  exprs <- mapM defToCExp $ toList entries
  let cexpMap = foldMap const emptyMap exprs
  cexpMap <- tailCallOpt cexpMap
  -- Not needed for JS, uncomment to test
  -- cexpMap <- liftLambda cexpMap
  let names = sortedNames cexpMap names
  pure $ mapMaybe (go cexpMap) names
  where
    go : ExpMap → QName → Maybe Doc
    go cexpMap name = do
      cexp <- lookupMap name cexpMap
      if elem name names
        then Just $ cexpToDoc True cexp
        else Just $ cexpToDoc False cexp

compileJavascript : M (List Doc)
compileJavascript = do
  top <- getTop
  let exports = getExports Nil $ listValues top.currentMod.modDefs
  let mainName = (QN top.currentMod.modName "main")
  let main = lookup mainName top
  let todo = case main of
        Nothing => exports
        Just _ => mainName :: exports
  defs <- process todo
  case lookup mainName top of
    Just _ => -- tack on call to main function
      let exec = stmtToDoc $ JPlain $ ApplyRef (show mainName) (S Z) [JUndefined]
      in pure $ reverse (exec :: defs)
    Nothing => pure $ reverse defs
  where
    getExports : List QName → List TopEntry → List QName
    getExports acc Nil = acc
    getExports acc ((MkEntry fc _ name@(QN ns nm) type def eflags) :: rest) =
      let acc = if elem Export eflags then name :: acc else acc
      in getExports acc rest