Remove erased function arguments

2025-10-23 22:29:04 -07:00
parent e9a02d30a5
commit 11ffd96a91
15 changed files with 791 additions and 760 deletions
--- a/src/Lib/Compile.newt
+++ b/src/Lib/Compile.newt
@@ -11,7 +11,7 @@ import Lib.Prettier
 import Lib.CompileExp
 import Lib.TopContext
 import Lib.LiftWhere
-import Lib.LiftLambda
+-- import Lib.LiftLambda -- NOW needs update for arg erasure
 import Lib.TCO
 import Lib.Ref2
 import Lib.Erasure
@@ -109,14 +109,17 @@ freshName' nm env =
      env' = push env (Var nm')
  in (nm', env')

-freshNames : List String -> JSEnv -> (List String × JSEnv)
+freshNames : List (Quant × String) -> JSEnv -> (List String × JSEnv)
 freshNames nms env = go nms env Lin
  where
-    go : List Name -> JSEnv -> SnocList Name -> (List String × JSEnv)
+    go : List (Quant × String) -> JSEnv -> SnocList Name -> (List String × JSEnv)
    go Nil env acc = (acc <>> Nil, env)
-    go (n :: ns) env acc =
+    go ((Many, n) :: ns) env acc =
      let (n', env') = freshName' n env
      in go ns env' (acc :< n')
+    go ((Zero, n) :: ns) env acc =
+      let env' = push env JUndefined
+      in go ns env' acc

 -- These expressions are added to the environment rather than assigned to a name
 simpleJSExp : JSExp → Bool
@@ -175,23 +178,39 @@ termToJS env (CLetRec 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 (CConstr ix _ args) f = go args 0 (\ args => f $ LitObject (("tag", LitInt (cast ix)) :: args))
+termToJS env (CConstr ix _ args qs) f = go args qs 0 (\ args => f $ LitObject (("tag", LitInt (cast ix)) :: args))
  where
-    go : ∀ e. List CExp -> Int -> (List (String × JSExp) -> JSStmt e) -> JSStmt e
-    go Nil ix k = k Nil
-    go (t :: ts) ix k = termToJS env t $ \ t' => go ts (ix + 1) $ \ args => k $ ("h\{show ix}", t') :: args
-termToJS env (CAppRef nm args etas) f = termToJS env (CRef nm) (\ t' => (argsToJS env t' args Lin f))
+    go : ∀ e. List CExp -> List Quant -> Int -> (List (String × JSExp) -> JSStmt e) -> JSStmt e
+    go (t :: ts) (Many :: qs) ix k = termToJS env t $ \ t' => go ts qs (ix + 1) $ \ args => k $ ("h\{show ix}", t') :: args
+    go (t :: ts) (q :: qs) ix k = go ts qs (ix + 1) $ \ args => k args
+    go _ _ ix k = k Nil
+termToJS env (CAppRef nm args quants) f = termToJS env (CRef nm) (\ t' => (argsToJS env t' args quants Lin f))
  where
-    etaExpand : JSEnv -> Nat -> SnocList JSExp -> JSExp -> JSExp
-    etaExpand env Z args tm = Apply tm (args <>> Nil)
-    etaExpand env (S etas) args tm =
+    etaExpand : JSEnv -> List Quant -> SnocList JSExp -> JSExp -> JSExp
+    etaExpand env Nil args tm = Apply tm (args <>> Nil)
+    etaExpand env (q :: qs) args tm =
      let nm' = freshName "eta" env
          env' = push env (Var nm')
-       in JLam (nm' :: Nil) $ JReturn $ etaExpand (push env (Var nm')) etas (args :< Var nm') tm
+       in case q of
+        Many => JLam (nm' :: Nil) $ JReturn $ etaExpand (push env (Var nm')) qs (args :< Var nm') tm
+        _ => JLam (nm' :: Nil) $ JReturn $ etaExpand (push env (Var nm')) qs args tm

-    argsToJS : ∀ e. JSEnv -> JSExp -> List CExp -> SnocList JSExp -> (JSExp -> JSStmt e) -> JSStmt e
-    argsToJS env tm Nil acc k = k (etaExpand env (cast etas) acc tm)
-    argsToJS env tm (x :: xs) acc k = termToJS env x (\ x' => argsToJS (incr env) tm xs (acc :< x') k)
+    apply : ∀ e. JSEnv → JSExp → (List CExp) → (JSExp → JSStmt e) → JSStmt e
+    apply env tm Nil k = k tm
+    apply env tm (x :: xs) k = termToJS env x $ \ x' => apply env (Apply tm (x' :: Nil)) xs k
+
+    argsToJS : ∀ e. JSEnv -> JSExp -> List CExp -> List Quant -> SnocList JSExp -> (JSExp -> JSStmt e) -> JSStmt e
+    argsToJS env tm Nil qs acc k = k (etaExpand env qs acc tm)
+    argsToJS env tm (x :: xs) (Many :: qs) acc k = termToJS env x (\ x' => argsToJS (incr env) tm xs qs (acc :< x') k)
+    argsToJS env tm (x :: xs) (q :: qs) acc k = argsToJS (incr env) tm xs qs acc k
+    -- REVIEW For now, functions whose arguments are all erased still get (), but no-arg functions don't
+    argsToJS env tm (x :: xs) Nil acc k = case quants of
+      Nil => apply env tm (x :: xs) k
+      _ => apply env (Apply tm (acc <>> Nil)) (x :: xs) k
+    argsToJS env tm (x :: xs) Nil Lin k = apply env tm (x :: xs) k
+    argsToJS env tm (x :: xs) Nil acc k = apply env (Apply tm (acc <>> Nil)) (x :: xs) k
+      -- backwards too...
+        -- termToJS env x $ \ x' => argsToJS env tm xs Nil acc $ \ tm' => k $ Apply tm' (x' :: Nil)

 termToJS env (CApp t arg) f = termToJS env t (\ t' => termToJS env arg (\arg' => f (Apply t' (arg' :: Nil))))

@@ -411,21 +430,22 @@ sortedNames defs qn = map snd $ filter (not ∘ fst) $ go Nil Nil (True, qn)
    getNames deep acc (CLam _ t) = getNames deep acc t
    -- top level 0-ary function, doesn't happen
    getNames deep acc (CFun _ t) = if deep then getNames deep acc t else acc
-    -- 0-ary call is not deep invocation
-    getNames deep acc (CAppRef nm Nil 0) =  (True, nm) :: acc
-    -- full call is deep ref to the head, arguments may be applied by `nm`
-    getNames deep acc (CAppRef nm ts 0) =  foldl (getNames True) ((True, nm) :: acc) ts
-    -- non-zero are closures
-    getNames deep acc (CAppRef nm ts _) =  foldl (getNames deep) ((deep, nm) :: acc) ts
-    -- True is needed for an issue in the parser. symbol -> keyword -> indented
-    -- TODO look at which cases generate CApp
+
+    getNames deep acc (CAppRef nm args qs) =
+      if length' args == length' qs
+        then case args of
+          Nil => (True, nm) :: acc
+          ts => foldl (getNames True) ((True, nm) :: acc) ts
+        else
+          foldl (getNames deep) ((deep, nm) :: acc) args
+   -- TODO look at which cases generate CApp
    getNames deep acc (CApp t u) = getNames True (getNames deep acc u) t
    getNames deep acc (CCase t alts) = foldl (getNames deep) acc $ t :: map getBody alts
    -- we're not calling it
    getNames deep acc (CRef qn) = (deep, qn) :: acc
    getNames deep acc (CLet _ t u) = getNames deep (getNames deep acc t) u
    getNames deep acc (CLetRec _ t u) = getNames deep (getNames deep acc t) u
-    getNames deep acc (CConstr _ _ ts) = foldl (getNames deep) acc ts
+    getNames deep acc (CConstr _ _ ts _) = foldl (getNames deep) acc ts
    -- if the CRaw is called, then the deps are called
    getNames deep acc (CRaw _ deps) = map (_,_ deep) deps ++ acc
    -- wrote these out so I get an error when I add a new constructor
--- a/src/Lib/CompileExp.newt
+++ b/src/Lib/CompileExp.newt
@@ -27,8 +27,8 @@ data CExp : U where
  CBnd : Int -> CExp
  -- How is CLam different from CFun with one arg?
  CLam : Name -> CExp -> CExp
-  CFun : List Name -> CExp -> CExp
-  CAppRef : QName -> List CExp -> Int -> CExp
+  CFun : List (Quant × Name) -> CExp -> CExp
+  CAppRef : QName -> List CExp -> List Quant -> CExp
  CApp : CExp -> CExp -> CExp
  CCase : CExp -> List CAlt -> CExp
  CRef : QName -> CExp
@@ -38,7 +38,7 @@ data CExp : U where
  CLetRec : Name -> CExp -> CExp -> CExp
  CErased : CExp
  -- Data / type constructor
-  CConstr : Nat → Name -> List CExp -> CExp
+  CConstr : Nat → Name → List CExp → List Quant → CExp
  -- Raw javascript for `pfunc`
  CRaw : String -> List QName -> CExp
  -- Need this for magic Nat
@@ -48,9 +48,9 @@ data CExp : U where
 -- I'm counting Lam in the term for arity.  This matches what I need in
 -- code gen.

-lamArity : Tm -> Nat
-lamArity (Lam _ _ _ _ t) = S (lamArity t)
-lamArity _ = Z
+lamArity : Tm -> List Quant
+lamArity (Lam _ _ _ quant t) = quant :: (lamArity t)
+lamArity _ = Nil

 -- It would be nice to be able to declare these
 compilePrimOp : String → List CExp → Maybe CExp
@@ -62,46 +62,45 @@ compilePrimOp "Prelude._&&_" (x :: y :: Nil) = Just (CPrimOp "&&" x y)
 compilePrimOp "Prelude._||_" (x :: y :: Nil) = Just (CPrimOp "||" x y)
 -- Assumes Bool is in the right order!
 compilePrimOp "Prelude.jsEq" (_ :: x :: y :: Nil) = Just (CPrimOp "==" x y)
-compilePrimOp "Prelude.jsLt" (_ :: x :: y :: Nil) = Just (CPrimOp "<" x y)
 compilePrimOp "Prelude.divInt" (x :: y :: Nil) = Just (CPrimOp "|" (CPrimOp "/" x y) (CLit $ LInt 0))
 compilePrimOp _ _ = Nothing

 -- This is how much we want to curry at top level
 -- leading lambda Arity is used for function defs and metas
 -- TODO - figure out how this will work with erasure
-arityForName : {{Ref2 Defs St}} → FC -> QName -> M Nat
+arityForName : {{Ref2 Defs St}} → FC -> QName -> M (List Quant)
 arityForName fc nm = do
  defs <- getRef Defs
  case lookupMap' nm defs of
    Nothing => error fc "Name \{show nm} not in scope"
-    (Just Axiom) => pure Z
-    (Just (TCon arity strs)) => pure $ cast arity
-    (Just (DCon _ _ k str)) => pure $ cast k
+    (Just Axiom) => pure Nil
+    (Just (PrimOp _)) => pure $ Many :: Many :: Nil
+    (Just (TCon arity strs)) => pure $ replicate' (cast arity) Many
+    (Just (DCon _ _ arity str)) => pure arity
    (Just (Fn t)) => pure $ lamArity t
-    (Just (PrimTCon arity)) => pure $ cast arity
-    (Just (PrimFn t arity used)) => pure arity
+    (Just (PrimTCon arity)) => pure $ replicate' (cast arity) Many
+    (Just (PrimFn t arity used)) => pure $ replicate' arity Many
+  where
+

 any : ∀ a. (a → Bool) → List a → Bool
 any f Nil = False
 any f (x :: xs) = if f x then True else any f xs

+-- NOW so we stuff quant and the args in here and sort it out later?
+
 -- apply an expression at an arity to a list of args
 -- CAppRef will specify any missing args, for eta conversion later
 -- and any extra args get individual CApp.
-apply : QName -> List CExp -> SnocList CExp -> Nat -> M CExp
+apply : QName -> List CExp -> List Quant -> M CExp
 -- out of args, make one up (fix that last arg)
-apply t Nil acc (S k) =
-  pure $ CAppRef t (acc <>> Nil) (1 + cast k)
-apply t (x :: xs) acc (S k)  =  apply t xs (acc :< x) k
-- once we hit zero, we fold the rest
-apply t ts acc Z = case acc of
-  -- drop zero arg call
-  Lin => go (CRef t) ts
-  _ => go (CAppRef t (acc <>> Nil) 0) ts
+apply qn args quants = pure $ CAppRef qn args quants
+  -- go (CAppRef qn args quants) args quants
  where
-    go : CExp -> List CExp -> M CExp
-    go t Nil = pure t
-    go t (arg :: args) = go (CApp t arg) args
+    go : CExp -> List CExp -> List Quant → M CExp
+    go t (arg :: args) (q :: qs) = go t args qs
+    go t Nil _ = pure t
+    go t (arg :: args) Nil = go (CApp t arg) args Nil

 lookupDef : {{Ref2 Defs St}} → FC → QName → M Def
 lookupDef fc nm = do
@@ -123,8 +122,7 @@ compileTerm t@(Ref fc nm@(QN _ tag)) = do
  defs <- getRef Defs
  case arity of
    -- we don't need to curry functions that take one argument
-    (S Z) => pure $ CRef nm
-    Z =>
+    Nil =>
      case the (Maybe Def) $ lookupMap' nm defs of
        Just (DCon ix EnumCon _ _) => pure $ CLit $ LInt $ cast ix
        Just (DCon ix FalseCon _ _) => pure $ CLit $ LBool False
@@ -133,7 +131,7 @@ compileTerm t@(Ref fc nm@(QN _ tag)) = do
        Just (DCon _ SuccCon _ _) =>
          pure $ CLam "x" $ CPrimOp "+" (CLit $ LInt 1) (CBnd 0)
        _ => pure $ CRef nm
-    _ => apply nm Nil Lin arity
+    _ => apply nm Nil arity

 compileTerm (Meta fc k) = error fc "Compiling meta \{show k}"
 compileTerm (Lam _ nm _ _ t) = CLam nm <$> compileTerm t
@@ -150,7 +148,7 @@ compileTerm tm@(App _ _ _) = case funArgs tm of
          | Just cexp => pure cexp
        case the (Maybe Def) $ lookupMap' nm defs of
          Just (DCon _ SuccCon _ _) => applySucc args'
-          _ => apply nm args' Lin arity
+          _ => apply nm args' arity
  -- REVIEW maybe we want a different constructor for non-Ref applications?
  (t, args) => do
        debug $ \ _ => "apply other \{render 90 $ pprint Nil t}"
@@ -166,7 +164,7 @@ compileTerm (UU _) = pure $ CRef (QN Nil "U")
 compileTerm (Pi _ nm icit rig t u) = do
  t' <- compileTerm t
  u' <- compileTerm u
-  pure $ CAppRef (QN primNS "PiType") (t' :: CLam nm u' :: Nil) 0
+  pure $ CAppRef (QN primNS "PiType") (t' :: CLam nm u' :: Nil) (Many :: Many :: Nil)
 compileTerm (Case fc t alts) = do
  t' <- compileTerm t
  alts' <- for alts $ \case
@@ -240,27 +238,44 @@ compileTerm (Erased _) = pure CErased
 compileFun : {{Ref2 Defs St}} → Tm -> M CExp
 compileFun tm = go tm Lin
  where
-    go : Tm -> SnocList String -> M CExp
-    go (Lam _ nm _ _ t) acc = go t (acc :< nm)
+    go : Tm -> SnocList (Quant × String) -> M CExp
+    go (Lam _ nm _ quant t) acc = go t (acc :< (quant, nm))
    go tm Lin = compileTerm tm
    go tm args = CFun (args <>> Nil) <$> compileTerm tm

+compilePop : QName → M CExp
+compilePop qn = do
+  top <- getTop
+  let (Just def) = lookup qn top | _ => error emptyFC "\{show qn} not found"
+  pure $ CErased -- FIXME - not implemented
+
 -- What are the Defs used for above? (Arity for name)
-compileDCon : Nat → QName → ConInfo → Int → CExp
-compileDCon ix (QN _ nm) EnumCon 0 = CLit $ LInt $ cast ix
-compileDCon ix (QN _ nm) TrueCon 0 = CLit $ LBool True
-compileDCon ix (QN _ nm) FalseCon 0 = CLit $ LBool False
-compileDCon ix (QN _ nm) info 0 = CConstr ix nm Nil
+compileDCon : Nat → QName → ConInfo → List Quant → CExp
+compileDCon ix (QN _ nm) EnumCon Nil = CLit $ LInt $ cast ix
+compileDCon ix (QN _ nm) TrueCon Nil = CLit $ LBool True
+compileDCon ix (QN _ nm) FalseCon Nil = CLit $ LBool False
+compileDCon ix (QN _ nm) info Nil = CConstr ix nm Nil Nil
 compileDCon ix (QN _ nm) info arity =
-  let args = map (\k => "h\{show k}") (range 0 arity) in
-  CFun args $ CConstr ix nm $ map (\k => CBnd $ arity - k - 1) (range 0 arity)
+  -- so we're fully applying this here, but dropping the args later?
+  -- The weird thing is that lambdas need the
+  let args = mkArgs Z arity
+      alen = length' arity
+  in CFun args $ CConstr ix nm (map (\k => CBnd $ alen - k - 1) (range 0 alen)) arity
+  where
+    mkArgs : Nat → List Quant → List (Quant × String)
+    mkArgs k (quant :: args) = (quant, "h\{show k}") :: mkArgs (S k) args
+    mkArgs k Nil = Nil
+
+

 -- 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, Axiom)      = pure $ (qn, CErased)
+defToCExp (qn, (PrimOp _)) = (_,_ qn) <$> compilePop qn
 defToCExp (qn, DCon ix info arity _)   = pure $ (qn, compileDCon ix qn info arity)
-- FIXME need a number if we ever add typecase.
-defToCExp (qn, TCon arity _)   = pure $ (qn, compileDCon Z qn NormalCon arity)
-defToCExp (qn, PrimTCon arity) = pure $ (qn, compileDCon Z qn NormalCon arity)
+-- We're not using these are runtime at the moment, no typecase
+-- we need to sort out tag number if we do that
+defToCExp (qn, TCon arity conNames) = pure $ (qn, compileDCon Z qn NormalCon (replicate' (cast arity) Many))
+defToCExp (qn, PrimTCon arity) = pure $ (qn, compileDCon Z qn NormalCon (replicate' (cast arity) Many))
 defToCExp (qn, PrimFn src _ deps) = pure $ (qn, CRaw src deps)
 defToCExp (qn, Fn tm)          = (_,_ qn) <$> compileFun tm
--- a/src/Lib/Elab.newt
+++ b/src/Lib/Elab.newt
@@ -165,10 +165,10 @@ contextMatches ctx ty = go (zip ctx.env ctx.types)
          modifyTop [ metaCtx := mc]
          go xs)

-getArity : Tm -> Int
-getArity (Pi x str icit rig t u) = 1 + getArity u
+getArity : Tm -> List Quant
+getArity (Pi x str icit rig t u) = rig :: getArity u
 -- Ref or App (of type constructor) are valid
-getArity _ = 0
+getArity _ = Nil

 -- Makes the arg for `solve` when we solve an auto
 makeSpine : Int -> List BD -> SnocList Val
@@ -727,7 +727,7 @@ getConstructors ctx scfc (VRef fc nm _) = do
    lookupDCon nm = do
      top <- getTop
      case lookup nm top of
-        (Just (MkEntry _ name type (DCon _ _ k str) _)) => pure (name, k, type)
+        (Just (MkEntry _ name type (DCon _ _ k str) _)) => pure (name, length' k, type)
        Just _ => error fc "Internal Error: \{show nm} is not a DCon"
        Nothing => error fc "Internal Error: DCon \{show nm} not found"
 getConstructors ctx scfc tm = do
--- a/src/Lib/ProcessDecl.newt
+++ b/src/Lib/ProcessDecl.newt
@@ -418,16 +418,16 @@ populateConInfo entries =
    setInfo x _ = x

    checkEnum : TopEntry → Maybe TopEntry
-    checkEnum (MkEntry fc nm dty (DCon ix _ 0 hn) flags) = Just $ MkEntry fc nm dty (DCon ix EnumCon 0 hn) flags
+    checkEnum (MkEntry fc nm dty (DCon ix _ Nil hn) flags) = Just $ MkEntry fc nm dty (DCon ix EnumCon Nil hn) flags
    checkEnum _ = Nothing

    isZero : TopEntry → Bool
-    isZero (MkEntry fc nm dty (DCon _ _ 0 hn) flags) = True
+    isZero (MkEntry fc nm dty (DCon _ _ Nil hn) flags) = True
    isZero _ = False

    -- TODO - handle indexes, etc
    isSucc : TopEntry → Bool
-    isSucc (MkEntry fc nm dty@(Pi _ _ _ _ (Ref _ a) (Ref _ b)) (DCon _ _ 1 hn) _) = a == b
+    isSucc (MkEntry fc nm dty@(Pi _ _ _ _ (Ref _ a) (Ref _ b)) (DCon _ _ (Many :: Nil) hn) _) = a == b
    isSucc _ = False

 processData : List String → FC → String → Raw → List Decl → M Unit
--- a/src/Lib/TCO.newt
+++ b/src/Lib/TCO.newt
@@ -28,7 +28,7 @@ tailNames (CCase _ alts) = join $ map altTailNames alts
    altTailNames (CLitAlt _ exp) = tailNames exp
 tailNames (CLet _ _ t) = tailNames t
 tailNames (CLetRec _ _ t) = tailNames t
-tailNames (CConstr _ _ args) = Nil
+tailNames (CConstr _ _ args _) = Nil
 tailNames (CBnd _) = Nil
 tailNames (CFun _ tm) = tailNames tm
 tailNames (CLam _ _) = Nil
@@ -43,14 +43,16 @@ tailNames (CPrimOp _ _ _) = Nil
 -- rewrite tail calls to return an object
 rewriteTailCalls : List QName → CExp → CExp
 rewriteTailCalls nms tm = case tm of
-  CAppRef nm args 0 =>
-      case getTag (S Z) nm nms of
-        Just ix => CConstr ix (show nm) args
-        Nothing => CConstr Z "return" (tm :: Nil)
+  CAppRef nm args qs =>
+      if length' args == length' qs
+      then case getTag (S Z) nm nms of
+        Just ix => CConstr ix (show nm) args $ map (const Many) args
+        Nothing => CConstr Z "return" (tm :: Nil) (Many :: Nil)
+      else CConstr Z "return" (tm :: Nil) (Many :: Nil)
  CLetRec nm t u => CLetRec nm t $ rewriteTailCalls nms u
  CLet nm t u => CLet nm t $ rewriteTailCalls nms u
  CCase sc alts => CCase sc $ map rewriteAlt alts
-  tm => CConstr Z "return" (tm :: Nil)
+  tm => CConstr Z "return" (tm :: Nil) (Many :: Nil)
  where
      getTag : Nat → QName → List QName → Maybe Nat
      getTag t nm Nil = Nothing
@@ -71,15 +73,17 @@ doOptimize fns = do
  let nms = map fst fns
  let alts = map (mkAlt nms) $ enumerate splitFuns
  recName <- mkRecName nms
-  let recfun = CFun ("arg" :: Nil) $ CCase (CBnd 0) alts
+  let recfun = CFun ((Many, "arg") :: Nil) $ CCase (CBnd 0) alts
  wrapped <- traverse (mkWrap recName) (enumerate fns)
  pure $ (recName, recfun) :: wrapped
  where
    mkWrap : QName → Nat × QName × CExp → M (QName × CExp)
    mkWrap recName (ix, qn, CFun args _) = do
      let arglen = length' args
-      let arg = CConstr (S ix) (show qn) $ map (\k => CBnd (arglen - k - 1)) (range 0 arglen)
-      let body = CAppRef bouncer (CRef recName :: arg :: Nil) 0
+      let conargs = map (\k => CBnd (arglen - k - 1)) (range 0 arglen)
+      let conquant = map (const Many) conargs
+      let arg = CConstr (S ix) (show qn) conargs conquant
+      let body = CAppRef bouncer (CRef recName :: arg :: Nil) (Many :: Many :: Nil)
      pure $ (qn, CFun args body)
    mkWrap _ (qn, _) = error emptyFC "error in mkWrap: \{show qn} not a CFun"

@@ -87,10 +91,10 @@ doOptimize fns = do
    mkRecName Nil = error emptyFC "INTERNAL ERROR: Empty List in doOptimize"
    mkRecName (QN ns nm :: _) = pure $ QN ns "REC_\{nm}"

-    mkAlt : List QName → (Nat × QName × List Name × CExp) -> CAlt
-    mkAlt nms (ix, qn, args, tm) = CConAlt (S ix) (show qn) NormalCon args (rewriteTailCalls nms tm)
+    mkAlt : List QName → (Nat × QName × List (Quant × Name) × CExp) -> CAlt
+    mkAlt nms (ix, qn, args, tm) = CConAlt (S ix) (show qn) NormalCon (map snd args) (rewriteTailCalls nms tm)

-    splitFun : (QName × CExp) → M (QName × List Name × CExp)
+    splitFun : (QName × CExp) → M (QName × List (Quant × Name) × CExp)
    splitFun (qn, CFun args body) = pure (qn, args, body)
    splitFun (qn, _) = error emptyFC "TCO error: \{show qn} not a function"

--- a/src/Lib/Types.newt
+++ b/src/Lib/Types.newt
@@ -357,11 +357,13 @@ instance Show ConInfo where
  show ZeroCon = "[Z]"
  show EnumCon = "[E]"

-data Def = Axiom | TCon Int (List QName) | DCon Nat ConInfo Int QName | Fn Tm | PrimTCon Int
+data Def = Axiom | TCon Int (List QName) | DCon Nat ConInfo (List Quant) QName | Fn Tm | PrimTCon Int
         | PrimFn String Nat (List QName)
+         | PrimOp String

 instance Show Def where
  show Axiom = "axiom"
+  show (PrimOp op) = "PrimOp \{show op}"
  show (TCon _ strs) = "TCon \{show strs}"
  show (DCon ix ci k tyname) = "DCon \{show ix} \{show k} \{show tyname} \{show ci}"
  show (Fn t) = "Fn \{show t}"
@@ -439,13 +441,15 @@ record TopContext where
 record Context where
  constructor MkCtx
  lvl : Int
-  -- shall we use lvl as an index?
+  -- Kovacs splits this into multiple fields
+  -- I was going to recombine them, but realized I'd have to regenerate env for eval
  env : Env                  -- Values in scope
+  -- TODO add fc, maybe add BD and make this a proper type
  types : List (String × Val) -- types and names in scope
  -- so we'll try "bds" determines length of local context
  bds : List BD          -- bound or defined

-  -- FC to use if we don't have a better option
+  -- FC to use for errors if we don't have a better option
  ctxFC : FC

 -- add a binding to environment