tarjan is running on CExp now

src/Lib/Compile.newt

@@ -1,4 +1,6 @@
--- TODO Audit how much "outside" stuff could pile up in the continuation.
+-- TODO Audit how much "outside" stuff could pile up in the continuation. (How much might be repeated in case branches.)
+-- TODO consider inlining constructors here (a future inline process might do this anyway).
+-- TODO consider not emitting null in `LitObject` (after inlining constructors)
 module Lib.Compile
 
 import Prelude
@@ -131,7 +133,7 @@ termToJS env (CLam nm t) f =
 termToJS env (CFun nms t) f =
   let (nms', env') = freshNames nms env
   in f $ JLam nms' (termToJS env' t JReturn)
-termToJS env (CRef nm) f = f $ Var nm
+termToJS env (CRef nm) f = f $ Var (show nm)
 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
@@ -371,14 +373,10 @@ process name = do
   liftWhere
   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
-
   exprs <- mapM defToCExp $ toList entries
   let cexpMap = foldMap const EmptyMap exprs
   -- TCO here on cexpMap
+  tailCallOpt cexpMap
   pure $ map cexpToDoc $ mapMaybe (\x => lookupMap x cexpMap) names
 
 compile : M (List Doc)

src/Lib/CompileExp.newt

@@ -32,7 +32,7 @@ data CExp : U where
   CFun : List Name -> CExp -> CExp
   CApp : CExp -> List CExp -> Int -> CExp
   CCase : CExp -> List CAlt -> CExp
-  CRef : Name -> CExp
+  CRef : QName -> CExp
   CMeta : Int -> CExp
   CLit : Literal -> CExp
   CLet : Name -> CExp -> CExp -> CExp
@@ -95,10 +95,10 @@ compileTerm t@(Ref fc nm) = do
   arity <- arityForName fc nm
   case arity of
     -- we don't need to curry functions that take one argument
-    (S Z) => pure $ CRef (show nm)
-    _ => apply (CRef (show nm)) Nil Lin arity
+    (S Z) => pure $ CRef nm
+    _ => apply (CRef nm) Nil Lin arity
 
-compileTerm (Meta _ k) = pure $ CRef "meta$\{show k}" -- FIXME
+compileTerm (Meta _ k) = pure $ CRef (QN Nil "meta$\{show k}") -- FIXME should be exception
 compileTerm (Lam _ nm _ _ t) = CLam nm <$> compileTerm t
 compileTerm tm@(App _ _ _) = case funArgs tm of
   (Meta _ k, args) => do
@@ -108,18 +108,18 @@ compileTerm tm@(App _ _ _) = case funArgs tm of
   (t@(Ref fc nm), args) => do
         args' <- traverse compileTerm args
         arity <- arityForName fc nm
-        apply (CRef (show nm)) args' Lin arity
+        apply (CRef nm) args' Lin arity
   (t, args) => do
         debug $ \ _ => "apply other \{render 90 $ pprint Nil t}"
         t' <- compileTerm t
         args' <- traverse compileTerm args
         apply t' args' Lin Z
         -- error (getFC t) "Don't know how to apply \{showTm t}"
-compileTerm (UU _) = pure $ CRef "U"
+compileTerm (UU _) = pure $ CRef (QN Nil "U")
 compileTerm (Pi _ nm icit rig t u) = do
   t' <- compileTerm t
   u' <- compileTerm u
-  pure $ CApp (CRef "PiType") (t' :: CLam nm u' :: Nil) 0
+  pure $ CApp (CRef (QN Nil "PiType")) (t' :: CLam nm u' :: Nil) 0
 compileTerm (Case _ t alts) = do
   t' <- compileTerm t
   alts' <- for alts $ \case

src/Lib/TCO.newt

@@ -6,6 +6,7 @@ import Lib.Ref2
 import Lib.Common
 import Lib.Types
 import Lib.CompileExp
+import Data.SortedMap
 
 -- We need CompileExp here, so we know if it's
 -- fully applied, needs eta, etc.
@@ -15,22 +16,23 @@ import Lib.CompileExp
 -- at the next stage, we'd need to fake up constructor
 -- records
 
-tailNames : CExp → List Name
+tailNames : CExp → List QName
 -- This is tricky, we need to skip the first CLam, but
 -- a deeper one is a return value
 tailNames (CApp (CRef name) args 0) = name :: Nil
 tailNames (CCase _ alts) = join $ map altTailNames alts
   where
-    altTailNames : CAlt → List Name
+    altTailNames : CAlt → List QName
     altTailNames (CConAlt _ _ exp) = tailNames exp
     altTailNames (CDefAlt exp) = tailNames exp
     altTailNames (CLitAlt _ exp) = tailNames exp
 tailNames (CLet _ _ t) = tailNames t
 tailNames (CLetRec _ _ t) = tailNames t
-tailNames (CConstr _ args) = join $ map tailNames args
+tailNames (CConstr _ args) = Nil -- join $ map tailNames args
 tailNames (CBnd _) = Nil
-tailNames (CFun _ _) = Nil
+tailNames (CFun _ tm) = tailNames tm
 tailNames (CLam _ _) = Nil
+tailNames (CApp (CRef nm) args n) = nm :: Nil
 tailNames (CApp t args n) = Nil
 tailNames (CRef _) = Nil
 tailNames CErased = Nil
@@ -38,7 +40,33 @@ tailNames (CLit _) = Nil
 tailNames (CMeta _) = Nil
 tailNames (CRaw _) = Nil
 
-tailCallOpt : {{Ref2 Defs St}} → M Unit
-tailCallOpt = do
-  defs <- getRef Defs
+/-
+(CFun ["_", "_", "_$2", "_$3"]
+  (CCase (CBnd 0) [
+     (CConAlt "_::_" ["a$4", "_$5", "_$6"]
+       (CApp (CRef "Prelude.reverse.go")
+          [(CBnd 6), (CBnd 5), (CApp (CRef "Prelude._::_") [(CErased), (CBnd 1), (CBnd 4)] 0), (CBnd 0)] 0)), (CConAlt "Nil" ["a$4"] (CBnd 2))]))
+
+-/
+
+
+ExpMap : U
+ExpMap = SortedMap QName CExp
+
+-- Need to switch everything to QName
+tailCallOpt : ExpMap → M ExpMap
+tailCallOpt expMap = do
   putStrLn "TODO TCO"
+  let blah = map (bimap id tailNames) (toList expMap)
+  let out = tarjan blah
+  for (toList expMap) $ \ foo => case foo of
+    (qn, cexp) => do
+      liftIO $ putStrLn "--- \{show qn}"
+      liftIO $ debugLog cexp
+      liftIO $ debugLog $ tailNames cexp
+  -- everything is pointing to itself, I don't want that unless it actually does..
+  for out $ \ names => liftIO $ debugLog names
+
+  -- liftIO $ debugLog out
+  pure expMap
+