add let to the core

lib/Quox/Syntax/Term/Pretty.idr

@@ -317,6 +317,44 @@ prettyCase dnames tnames qty head ret body =
   prettyCase_ dnames tnames ![|caseD <+> prettyQty qty|] head ret body
 
 
+private
+LetBinder : Nat -> Nat -> Type
+LetBinder d n = (Qty, BindName, Elim d n)
+
+private
+LetExpr : Nat -> Nat -> Nat -> Type
+LetExpr d n n' = (Telescope (LetBinder d) n n', Term d n')
+
+private
+PrettyLetResult : LayoutOpts -> Nat -> Type
+PrettyLetResult opts d =
+  Exists $ \n => (BContext n, Term d n, SnocList (Doc opts))
+
+-- [todo] factor out this and the untyped version somehow
+export
+splitLet : Telescope (LetBinder d) n n' -> Term d n' -> Exists (LetExpr d n)
+splitLet ys t@(Let qty rhs body _) =
+  splitLet (ys :< (qty, body.name, rhs)) (assert_smaller t body.term)
+splitLet ys t =
+  Evidence _ (ys, t)
+
+private covering
+prettyLets : {opts : LayoutOpts} ->
+             BContext d -> BContext a -> Telescope (LetBinder d) a b ->
+             Eff Pretty (SnocList (Doc opts))
+prettyLets dnames xs lets = sequence $ snd $ go lets where
+  go : forall b. Telescope (LetBinder d) a b ->
+       (BContext b, SnocList (Eff Pretty (Doc opts)))
+  go [<] = (xs, [<])
+  go (lets :< (qty, x, rhs)) =
+    let (ys, docs) = go lets
+        doc = do
+          x   <- prettyTBind x
+          rhs <- withPrec Outer $ assert_total prettyElim dnames ys rhs
+          hangDSingle (hsep [!letD, x, !cstD]) (hsep [rhs, !inD]) in
+    (ys :< x, docs :< doc)
+
+
 private
 isDefaultDir : Dim d -> Dim d -> Bool
 isDefaultDir (K Zero _) (K One _) = True
@@ -457,6 +495,14 @@ prettyTerm dnames tnames (BOX qty ty _) =
 prettyTerm dnames tnames (Box val _) =
   bracks =<< withPrec Outer (prettyTerm dnames tnames val)
 
+prettyTerm dnames tnames (Let qty rhs body _) = do
+  let Evidence _ (lets, body) = splitLet [< (qty, body.name, rhs)] body.term
+  heads <- prettyLets dnames tnames lets
+  let tnames = tnames . map (\(_, x, _) => x) lets
+  body <- withPrec Outer $ assert_total prettyTerm dnames tnames body
+  let lines = toList $ heads :< body
+  pure $ ifMultiline (hsep lines) (vsep lines)
+
 prettyTerm dnames tnames (E e) = prettyElim dnames tnames e
 
 prettyTerm dnames tnames t0@(CloT (Sub t ph)) =