add fst and snd

lib/Quox/Parser/FromParser.idr

@@ -141,6 +141,12 @@ mutual
         <*> fromPTermTScope ds ns [< x, y] body
         <*> pure loc
 
+    Fst pair loc =>
+      map E $ Fst <$> fromPTermElim ds ns pair <*> pure loc
+
+    Snd pair loc =>
+      map E $ Snd <$> fromPTermElim ds ns pair <*> pure loc
+
     Case pi tag (r, ret) (CaseEnum arms _) loc =>
       map E $ CaseEnum (fromPQty pi)
         <$> fromPTermElim ds ns tag

lib/Quox/Parser/Lexer.idr

@@ -203,6 +203,7 @@ reserved =
    Word "caseω" `Or` Word "case#",
    Word1 "return",
    Word1 "of",
+   Word1 "fst", Word1 "snd",
    Word1 "_",
    Word1 "Eq",
    Word "λ" `Or` Word "fun",

lib/Quox/Parser/Parser.idr

@@ -372,10 +372,23 @@ eqTerm : FileName -> Grammar True PTerm
 eqTerm fname = withLoc fname $
   resC "Eq" *> mustWork [|Eq (typeLine fname) (termArg fname) (termArg fname)|]
 
+export
+resAppTerm : FileName -> (word : String) -> (0 _ : IsReserved word) =>
+             (PTerm -> Loc -> PTerm) -> Grammar True PTerm
+resAppTerm fname word f = withLoc fname $
+  resC word *> mustWork [|f (termArg fname)|]
+
 export
 succTerm : FileName -> Grammar True PTerm
-succTerm fname = withLoc fname $
-  resC "succ" *> mustWork [|Succ (termArg fname)|]
+succTerm fname = resAppTerm fname "succ" Succ
+
+export
+fstTerm : FileName -> Grammar True PTerm
+fstTerm fname = resAppTerm fname "fst" Fst
+
+export
+sndTerm : FileName -> Grammar True PTerm
+sndTerm fname = resAppTerm fname "snd" Snd
 
 ||| a dimension argument with an `@` prefix, or
 ||| a term argument with no prefix
@@ -403,6 +416,8 @@ appTerm fname =
   <|> splitUniverseTerm fname
   <|> eqTerm fname
   <|> succTerm fname
+  <|> fstTerm fname
+  <|> sndTerm fname
   <|> normalAppTerm fname
 
 export

lib/Quox/Parser/Syntax.idr

@@ -73,6 +73,7 @@ namespace PTerm
       | Sig PatVar PTerm PTerm Loc
       | Pair PTerm PTerm Loc
       | Case PQty PTerm (PatVar, PTerm) PCaseBody Loc
+      | Fst PTerm Loc | Snd PTerm Loc
 
       | Enum (List TagVal) Loc
       | Tag TagVal Loc
@@ -113,6 +114,8 @@ Located PTerm where
   (App  _ _           loc).loc = loc
   (Sig  _ _ _         loc).loc = loc
   (Pair _ _           loc).loc = loc
+  (Fst  _             loc).loc = loc
+  (Snd  _             loc).loc = loc
   (Case _ _ _ _       loc).loc = loc
   (Enum _             loc).loc = loc
   (Tag  _             loc).loc = loc