Something went wrong. Try again.
Newt - a dependent typed programming language
This is a mirror of the main github repository. newt.cloakedarrow.com
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524module Lib.Compile.JSimport Preludeimport Lib.Commonimport Lib.Typesimport Lib.Evalimport Lib.Prettierimport Lib.Compile.CExpimport Lib.Compile.Commonimport Lib.TopContextimport Lib.Compile.LiftWhere-- import Lib.Compile.LiftLambdaimport Lib.Compile.TCOimport Lib.Ref2import Data.Stringimport Data.SnocListimport Data.Intimport Data.SortedMapimport Data.IORefdata StKind = Plain | Return | Assign Stringdata JSStmt : StKind -> Udata JSExp : Udata CaseType = CaseInd | CaseBool | CaseChar | CaseInt | CaseStrderive Show CaseTypedata JAlt : U where JConAlt : ∀ e. Nat -> JSStmt e -> JAlt JDefAlt : ∀ e. JSStmt e -> JAlt JLitAlt : ∀ e. JSExp -> JSStmt e -> JAltdata 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 -> JSExpdata 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 aalias Cont e = JSExp -> JSStmt emkAppRef : String → JSExp → JSExp → JSExpmkAppRef nm x y = ApplyRef nm (S (S Z)) [x,y]-- JSEnv contains `Var` for binders or `Dot` for destructured data. It-- used to translate bindersrecord 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 -> JSEnvpush (MkEnv env depth noprim) exp = MkEnv (exp :: env) (depth + 1) noprimincr : JSEnv → JSEnvincr env = MkEnv env.jsenv (1 + env.depth) env.noprimemptyJSEnv : JSEnvemptyJSEnv = MkEnv Nil 0 FalsealtType : CAlt → CaseTypealtType (CLitAlt (LString _) _) = CaseStraltType (CLitAlt (LInt _) _) = CaseIntaltType (CLitAlt (LChar _) _) = CaseCharaltType (CLitAlt (LBool _) _) = CaseBoolaltType _ = CaseIndlitToJS : Literal -> JSExplitToJS (LString str) = LitString strlitToJS (LBool b) = LitBool blitToJS (LChar c) = LitChar clitToJS (LInt i) = LitInt i-- Stuff nm.h1, nm.h2, ... into environment for constructor matchconAltEnv : JSExp -> Int -> JSEnv -> List String -> JSEnvconAltEnv sc k env Nil = envconAltEnv 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 EnvfreshName : String -> JSEnv -> StringfreshName 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 quantityfreshNames : 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 namesimpleJSExp : JSExp → BoolsimpleJSExp (Var _) = TruesimpleJSExp (Dot a _) = simpleJSExp asimpleJSExp (JUndefined) = TruesimpleJSExp (Index a b) = if simpleJSExp a then simpleJSExp b else FalsesimpleJSExp (LitInt _) = TruesimpleJSExp (LitString _) = TruesimpleJSExp (LitBool _) = TruesimpleJSExp _ = FalsegetEnv : Int → List JSExp → JSExpgetEnv 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 eargsToJS : ∀ e. JSEnv → List CExp → (List JSExp → JSStmt e) → JSStmt eargsToJS {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) xstermToJS 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 argstermToJS env (CThunk t) f = f $ JLam (freshName "_" env) $ termToJS env t JReturntermToJS env CErased f = f JUndefinedtermToJS 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-aritytermToJS 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 utermToJS 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 originaltermToJS 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 ftermToJS 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 NiltermToJS {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 _ _ = JContinuetermToJS env (CAppRef nm args quants) f = argsToJS env args $ \ args => f $ ApplyRef (show nm) quants argstermToJS 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 StringjsKeywords = ( "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 jsjsIdent : String -> DocjsIdent 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 xsstmtToDoc : ∀ e. JSStmt e -> DocexpToDoc : JSExp -> DocexpToDoc (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 expexpToDoc (LitString str) = text $ quoteString strexpToDoc (LitInt i) = text $ show iexpToDoc (Raw str) = text str-- TODO add precedenceexpToDoc (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 qsexpToDoc (Var nm) = jsIdent nmexpToDoc (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 → DocstmtWithBreak (JSnoc x y) = stmtToDoc x </> stmtWithBreak ystmtWithBreak st@(JReturn _) = stmtToDoc ststmtWithBreak st@(JContinue) = stmtToDoc ststmtWithBreak st = stmtToDoc st </> text "break;"caseBody : ∀ e. JSStmt e -> DoccaseBody 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 -> DocaltToDoc (JConAlt nm stmt) = text "case" <+> text (show nm) ++ text ":" ++ caseBody stmtaltToDoc (JDefAlt stmt) = text "default" ++ text ":" ++ caseBody stmtaltToDoc (JLitAlt a stmt) = text "case" <+> expToDoc a ++ text ":" ++ caseBody stmtstmtToDoc (JSnoc x y) = stmtToDoc x </> stmtToDoc ystmtToDoc (JPlain x) = expToDoc x ++ text ";"-- I might not need these split yet.stmtToDoc (JLet nm body) = text "let" <+> jsIdent nm ++ text ";" </> stmtToDoc bodystmtToDoc (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 reassignedstmtToDoc (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) -> DoccexpToDoc 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 passesgetEntries : 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 sourceprocess : 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 cexpcompileJavascript : 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