natural numbers

lib/Quox/Parser/Parser.idr

@@ -116,6 +116,10 @@ qty = terminal "expecting quantity" $
   \case Nat 0 => Just Zero; Nat 1 => Just One; Reserved "ω" => Just Any
         _ => Nothing
 
+export
+zero : Grammar True ()
+zero = terminal "expecting 0" $ guard . (== Nat 0)
+
 
 public export
 AllReserved : List (a, String) -> Type
@@ -125,6 +129,7 @@ export
 symbols : (lst : List (a, String)) -> (0 _ : AllReserved lst) =>
           Grammar True a
 symbols []                 = fail "no symbols found"
+symbols [(x, str)]         = x <$ res str
 symbols ((x, str) :: rest) = x <$ res str <|> symbols rest
 
 export
@@ -185,11 +190,24 @@ mutual
   caseBody : Grammar True PCaseBody
   caseBody = braces $
         [|CasePair (pairPat <* darr) (term <* optSemi)|]
+    <|> CaseNat <$> zeroCase <* resC ";" <*> succCase <* optSemi
+    <|> flip CaseNat <$> succCase <* resC ";" <*> zeroCase <* optSemi
     <|> [|CaseEnum $ semiSep [|MkPair tag (darr *> term)|]|]
   where
     optSemi = optional $ res ";"
     pairPat = parens [|MkPair bname (resC "," *> bname)|]
 
+    zeroCase : Grammar True PTerm
+    zeroCase = (resC "zero" <|> zero) *> darr *> term
+
+    succCase : Grammar True (BName, PQty, BName, PTerm)
+    succCase = do
+      resC "succ"
+      n   <- bname
+      ih  <- option (Zero, Nothing) $ bracks [|MkPair qty (resC "." *> bname)|]
+      rhs <- darr *> term
+      pure $ (n, fst ih, snd ih, rhs)
+
   private covering
   bindTerm : Grammar True PTerm
   bindTerm = pi <|> sigma
@@ -199,7 +217,7 @@ mutual
     pi, sigma : Grammar True PTerm
     pi = [|makePi (qty <* res ".") domain (resC "→" *> term)|]
     where
-      makePi : Three -> (BName, PTerm) -> PTerm -> PTerm
+      makePi : PQty -> (BName, PTerm) -> PTerm -> PTerm
       makePi q (x, s) t = Pi q x s t
       domain = binderHead <|> [|(Nothing,) aTerm|]
 
@@ -226,8 +244,9 @@ mutual
 
   private covering
   appTerm : Grammar True PTerm
-  appTerm = resC "★"  *> [|TYPE nat|]
-        <|> resC "Eq" *> [|Eq (bracks optBinderTerm) aTerm aTerm|]
+  appTerm = resC "★"    *> [|TYPE nat|]
+        <|> resC "Eq"   *> [|Eq (bracks optBinderTerm) aTerm aTerm|]
+        <|> resC "succ" *> [|Succ aTerm|]
         <|> [|apply aTerm (many appArg)|]
   where
     data PArg = TermArg PTerm | DimArg PDim
@@ -245,9 +264,16 @@ mutual
   aTerm : Grammar True PTerm
   aTerm = [|Enum $ braces $ commaSep bareTag|]
       <|> [|TYPE universe|]
+      <|> Nat  <$ resC "ℕ"
+      <|> Zero <$ resC "zero"
+      <|> (nat <&> \n => fromNat n :# Nat)
       <|> [|V name|]
       <|> [|Tag tag|]
       <|> foldr1 Pair <$> parens (commaSep1 term)
+  where
+    fromNat : Nat -> PTerm
+    fromNat 0     = Zero
+    fromNat (S k) = Succ $ fromNat k
 
   private covering
   optBinderTerm : Grammar True (BName, PTerm)