add fst and snd

lib/Quox/Syntax/Term/Base.idr

@@ -155,6 +155,12 @@ mutual
                (loc : Loc) ->
                Elim d n
 
+    ||| first element of a pair. only works in non-linear contexts.
+    Fst : (pair : Elim d n) -> (loc : Loc) -> Elim d n
+
+    ||| second element of a pair. only works in non-linear contexts.
+    Snd : (pair : Elim d n) -> (loc : Loc) -> Elim d n
+
     ||| enum matching
     CaseEnum : (qty : Qty) -> (tag : Elim d n) ->
                (ret : ScopeTerm d n) ->
@@ -369,6 +375,8 @@ Located (Elim d n) where
   (B _ loc).loc                 = loc
   (App _ _ loc).loc             = loc
   (CasePair _ _ _ _ loc).loc    = loc
+  (Fst _ loc).loc               = loc
+  (Snd _ loc).loc               = loc
   (CaseEnum _ _ _ _ loc).loc    = loc
   (CaseNat _ _ _ _ _ _ loc).loc = loc
   (CaseBox _ _ _ _ loc).loc     = loc
@@ -417,6 +425,8 @@ Relocatable (Elim d n) where
   setLoc loc (App fun arg _) = App fun arg loc
   setLoc loc (CasePair qty pair ret body _) =
     CasePair qty pair ret body loc
+  setLoc loc (Fst pair _) = Fst pair loc
+  setLoc loc (Snd pair _) = Fst pair loc
   setLoc loc (CaseEnum qty tag ret arms _) =
     CaseEnum qty tag ret arms loc
   setLoc loc (CaseNat qty qtyIH nat ret zero succ _) =

lib/Quox/Syntax/Term/Pretty.idr

@@ -493,6 +493,16 @@ prettyElim dnames tnames (CasePair qty pair ret body _) = do
   prettyCase dnames tnames qty pair ret
     [MkCaseArm pat [<] [< x, y] body.term]
 
+prettyElim dnames tnames (Fst pair _) =
+  parensIfM App =<< do
+    pair <- prettyTArg dnames tnames (E pair)
+    prettyAppD !fstD [pair]
+
+prettyElim dnames tnames (Snd pair _) =
+  parensIfM App =<< do
+    pair <- prettyTArg dnames tnames (E pair)
+    prettyAppD !sndD [pair]
+
 prettyElim dnames tnames (CaseEnum qty tag ret arms _) = do
   arms <- for (SortedMap.toList arms) $ \(tag, body) =>
     pure $ MkCaseArm !(prettyTag tag) [<] [<] body

lib/Quox/Syntax/Term/Subst.idr

@@ -299,6 +299,10 @@ mutual
       nclo $ App (f // th // ph) (s // th // ph) loc
     pushSubstsWith th ph (CasePair pi p r b loc) =
       nclo $ CasePair pi (p // th // ph) (r // th // ph) (b // th // ph) loc
+    pushSubstsWith th ph (Fst pair loc) =
+      nclo $ Fst (pair // th // ph) loc
+    pushSubstsWith th ph (Snd pair loc) =
+      nclo $ Snd (pair // th // ph) loc
     pushSubstsWith th ph (CaseEnum pi t r arms loc) =
       nclo $ CaseEnum pi (t // th // ph) (r // th // ph)
                (map (\b => b // th // ph) arms) loc

lib/Quox/Syntax/Term/Tighten.idr

@@ -87,6 +87,10 @@ mutual
                  <*> tightenS p ret
                  <*> tightenS p body
                  <*> pure loc
+  tightenE' p (Fst pair loc) =
+    Fst <$> tightenE p pair <*> pure loc
+  tightenE' p (Snd pair loc) =
+    Snd <$> tightenE p pair <*> pure loc
   tightenE' p (CaseEnum qty tag ret arms loc) =
     CaseEnum qty <$> tightenE p tag
                  <*> tightenS p ret
@@ -202,6 +206,10 @@ mutual
                  <*> dtightenS p ret
                  <*> dtightenS p body
                  <*> pure loc
+  dtightenE' p (Fst pair loc) =
+    Fst <$> dtightenE p pair <*> pure loc
+  dtightenE' p (Snd pair loc) =
+    Snd <$> dtightenE p pair <*> pure loc
   dtightenE' p (CaseEnum qty tag ret arms loc) =
     CaseEnum qty <$> dtightenE p tag
                  <*> dtightenS p ret