represent ℕ constants directly

instead of as huge `succ (succ (succ ⋯))` terms

lib/Quox/Untyped/Erase.idr

@@ -189,9 +189,9 @@ eraseTerm ctx ty (DLam body loc) = do
 eraseTerm ctx _ s@(NAT {}) =
   throw $ CompileTimeOnly ctx s
 
--- 0 ⤋ 0 ⇐ ℕ
-eraseTerm _ _ (Zero loc) =
-  pure $ Zero loc
+-- n ⤋ n ⇐ ℕ
+eraseTerm _ _ (Nat n loc) =
+  pure $ Nat n loc
 
 --       s ⤋ s' ⇐ ℕ
 -- -----------------------
@@ -438,7 +438,7 @@ eraseElim ctx (DCloE (Sub term th)) =
 
 export
 uses : Var n -> Term n -> Nat
-uses i (F _ _) = 0
+uses i (F {}) = 0
 uses i (B j _) = if i == j then 1 else 0
 uses i (Lam x body _) = uses (VS i) body
 uses i (App fun arg _) = uses i fun + uses i arg
@@ -448,16 +448,16 @@ uses i (Snd pair _) = uses i pair
 uses i (Tag tag _) = 0
 uses i (CaseEnum tag cases _) =
   uses i tag + foldl max 0 (map (assert_total uses i . snd) cases)
-uses i (Absurd _) = 0
-uses i (Zero _) = 0
+uses i (Absurd {}) = 0
+uses i (Nat {}) = 0
 uses i (Succ nat _) = uses i nat
 uses i (CaseNat nat zer suc _) = uses i nat + max (uses i zer) (uses' suc)
   where uses' : CaseNatSuc n -> Nat
         uses' (NSRec  _ _ s) = uses (VS (VS i)) s
         uses' (NSNonrec _ s) = uses (VS i) s
-uses i (Str _ _) = 0
+uses i (Str {}) = 0
 uses i (Let x rhs body _) = uses i rhs + uses (VS i) body
-uses i (Erased _) = 0
+uses i (Erased {}) = 0
 
 export
 inlineable : U.Term n -> Bool
@@ -482,7 +482,7 @@ trimLets (CaseEnum tag cases loc) =
   CaseEnum (trimLets tag)
            (map (map $ \c => trimLets $ assert_smaller cases c) cases) loc
 trimLets (Absurd loc) = Absurd loc
-trimLets (Zero loc) = Zero loc
+trimLets (Nat n loc) = Nat n loc
 trimLets (Succ nat loc) = Succ (trimLets nat) loc
 trimLets (CaseNat nat zer suc loc) =
   CaseNat (trimLets nat) (trimLets zer) (trimLets' suc) loc

lib/Quox/Untyped/Scheme.idr

@@ -200,13 +200,11 @@ toScheme xs (CaseEnum tag cases _) =
 toScheme xs (Absurd _) =
   pure $ Q "absurd"
 
-toScheme xs (Zero _) =
-  pure $ N 0
+toScheme xs (Nat n _) =
+  pure $ N n
 
 toScheme xs (Succ nat _) =
-  case !(toScheme xs nat) of
-    N n => pure $ N $ S n
-    s   => pure $ L ["+", s, N 1]
+  pure $ L ["+", !(toScheme xs nat), N 1]
 
 toScheme xs (CaseNat nat zer (NSRec p ih suc) _) =
   freshInBC [< p, ih] $ \[< p, ih] =>

lib/Quox/Untyped/Syntax.idr

@@ -39,7 +39,7 @@ data Term where
   ||| empty match
   Absurd : Loc -> Term n
 
-  Zero : Loc -> Term n
+  Nat : (val : Nat) -> Loc -> Term n
   Succ : (nat : Term n) -> Loc -> Term n
   CaseNat : (nat : Term n) ->
             (zer : Term n) ->
@@ -76,7 +76,7 @@ Located (Term n) where
   (Tag _ loc).loc         = loc
   (CaseEnum _ _ loc).loc  = loc
   (Absurd loc).loc        = loc
-  (Zero loc).loc          = loc
+  (Nat _ loc).loc         = loc
   (Succ _ loc).loc        = loc
   (CaseNat _ _ _ loc).loc = loc
   (Str _ loc).loc         = loc
@@ -198,16 +198,6 @@ sucCaseArm (NSRec x ih s) = pure $
 sucCaseArm (NSNonrec x s) = pure $
   MkPrettyCaseArm !(sucPat x) [x] s
 
-private covering
-prettyNat : {opts : LayoutOpts} ->
-            BContext n -> Term n -> Eff Pretty (Either Nat (Doc opts))
-prettyNat xs (Zero _) = pure $ Left 0
-prettyNat xs (Succ n _) =
-  case !(withPrec Arg $ prettyNat xs n) of
-    Left n    => pure $ Left $ S n
-    Right doc => map Right $ parensIfM App $ sep [!succD, doc]
-prettyNat xs s = map Right $ prettyTerm xs s
-
 prettyTerm _  (F x _) = prettyFree x
 prettyTerm xs (B i _) = prettyTBind $ xs !!! i
 prettyTerm xs (Lam x body _) =
@@ -229,11 +219,9 @@ prettyTerm xs (CaseEnum tag cases _) =
   prettyCase xs prettyTag tag $
     map (\(t, rhs) => MkPrettyCaseArm t [] rhs) $ toList cases
 prettyTerm xs (Absurd _) = hl Syntax "absurd"
-prettyTerm xs (Zero _) = hl Tag "0"
+prettyTerm xs (Nat n _) = hl Tag $ pshow n
 prettyTerm xs (Succ nat _) =
-  case !(prettyNat xs nat) of
-    Left  n   => hl Tag $ pshow $ S n
-    Right doc => prettyApp' !succD [< doc]
+  prettyApp' !succD [< !(prettyTerm xs nat)]
 prettyTerm xs (CaseNat nat zer suc _) =
   prettyCase xs pure nat [MkPrettyCaseArm !zeroD [] zer, !(sucCaseArm suc)]
 prettyTerm xs (Str s _) =
@@ -298,8 +286,8 @@ CanSubstSelf Term where
       CaseEnum (tag // th) (map (assert_total mapSnd (// th)) cases) loc
     Absurd loc =>
       Absurd loc
-    Zero loc =>
-      Zero loc
+    Nat n loc =>
+      Nat n loc
     Succ nat loc =>
       Succ (nat // th) loc
     CaseNat nat zer suc loc =>