From 944854b1c476399978f3ab08b68eb27c6bc02acb Mon Sep 17 00:00:00 2001
From: Steve Dunham <dunhamsteve@gmail.com>
Date: Sat, 15 Mar 2025 17:09:00 -0700
Subject: [PATCH] Cleanup in Compile.newt, don't emit vestigial letrec

---
 src/Lib/Compile.newt    | 33 ++++++++++++++-------------------
 src/Lib/CompileExp.newt |  9 +++++++++
 2 files changed, 23 insertions(+), 19 deletions(-)

diff --git a/src/Lib/Compile.newt b/src/Lib/Compile.newt
index 1e17ba8..d3423b6 100644
--- a/src/Lib/Compile.newt
+++ b/src/Lib/Compile.newt
@@ -145,7 +145,9 @@ termToJS env (CLet nm t u) f =
   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 (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
@@ -286,24 +288,11 @@ maybeWrap : JSStmt Return -> JSExp
 maybeWrap (JReturn exp) = exp
 maybeWrap stmt = Apply (JLam Nil stmt) Nil
 
-dcon : QName -> Int -> Doc
-dcon qn arity =
-  let ct = compileDCon qn arity
-      exp = maybeWrap $ termToJS emptyJSEnv ct JReturn
-  in stmtToDoc $ JConst (show qn) exp
-
--- convert a Def to a Doc (compile to javascript)
-defToDoc : {{Ref2 Defs St}} → QName → Def → M Doc
-defToDoc name (Fn tm) = do
-  debug $ \ _ => "compileFun \{render 90 $ pprint Nil tm}"
-  ct <- compileFun tm
+cexpToDoc : (QName × CExp) -> Doc
+cexpToDoc (qn, ct) =
+  -- If we leak extra statements/assignments, we need an IIFE
   let exp = maybeWrap $ termToJS emptyJSEnv ct JReturn
-  pure $ text "const" <+> jsIdent (show name) <+> text "=" <+/> expToDoc exp ++ text ";"
-defToDoc name Axiom = pure $ text ""
-defToDoc name (DCon arity _) = pure $ dcon name arity
-defToDoc name (TCon arity strs) = pure $ dcon name arity
-defToDoc name (PrimTCon arity) = pure $ dcon name arity
-defToDoc name (PrimFn src _ _) = pure $ stmtToDoc $ JConst (show name) $ Raw src
+  in stmtToDoc $ JConst (show qn) exp
 
 -- Collect the QNames used in a term
 getNames : Tm -> List QName -> List QName
@@ -376,15 +365,21 @@ process name = do
   -- Maybe move this dance into liftWhere
   ref <- newIORef entries
   let foo = MkRef ref -- for the autos below
+  -- TODO, erasure needs to happen on Tm, but can be part of Tm -> CExp
+  -- if we move the liftWhere down.
   eraseEntries
   liftWhere
-  tailCallOpt
   entries <- readIORef ref
   let names = sortedNames entries name
+  -- I think this was just debugging
   for names $ \ nm => case lookupMap nm entries of
       Nothing => error emptyFC "MISS \{show nm}"
       Just _ => pure MkUnit
-  mapM (uncurry defToDoc) $ mapMaybe (\x => lookupMap x entries) names
+
+  exprs <- mapM defToCExp $ toList entries
+  let cexpMap = foldMap const EmptyMap exprs
+  -- TCO here on cexpMap
+  pure $ map cexpToDoc $ mapMaybe (\x => lookupMap x cexpMap) names
 
 compile : M (List Doc)
 compile = do
diff --git a/src/Lib/CompileExp.newt b/src/Lib/CompileExp.newt
index 3b8d73b..e90ed76 100644
--- a/src/Lib/CompileExp.newt
+++ b/src/Lib/CompileExp.newt
@@ -153,3 +153,12 @@ compileDCon (QN _ nm) 0 = CConstr nm Nil
 compileDCon (QN _ nm) arity =
   let args = map (\k => "h\{show k}") (range 0 arity) in
   CFun args $ CConstr nm $ map (\k => CBnd $ arity - k - 1) (range 0 arity)
+
+-- probably want to drop the Ref2 when we can
+defToCExp : {{Ref2 Defs St}} → (QName × Def) -> M (QName × CExp)
+defToCExp (qn, Axiom)          = pure $ (qn, CErased)
+defToCExp (qn, DCon arity _)   = pure $ (qn, compileDCon qn arity)
+defToCExp (qn, TCon arity _)   = pure $ (qn, compileDCon qn arity)
+defToCExp (qn, PrimTCon arity) = pure $ (qn, compileDCon qn arity)
+defToCExp (qn, PrimFn src _ _) = pure $ (qn, CRaw src)
+defToCExp (qn, Fn tm)          = (_,_ qn) <$> compileFun tm