"1.(x: A) → B" instead of "(1.x: A) → B"

also "1.A → B"

lib/Quox/Syntax/Term/Pretty.idr

@@ -24,13 +24,14 @@ dlamD   = hlF Syntax $ ifUnicode "δ" "dfun"
 annD    = hlF Syntax $ ifUnicode "∷" "::"
 
 private %inline
-eqD, colonD, commaD, caseD, returnD, ofD : Doc HL
+eqD, colonD, commaD, caseD, returnD, ofD, dotD : Doc HL
 eqD     = hl Syntax "Eq"
 colonD  = hl Syntax ":"
 commaD  = hl Syntax ","
 caseD   = hl Syntax "case"
 ofD     = hl Syntax "of"
 returnD = hl Syntax "return"
+dotD    = hl Delim "."
 
 
 export
@@ -47,22 +48,39 @@ export
 prettyUniverse : Universe -> Doc HL
 prettyUniverse = hl Syntax . pretty
 
+
+public export
+data WithQty q a = MkWithQty q a
+
 export
-prettyBind : PrettyHL a => PrettyHL q => Pretty.HasEnv m =>
-             List q -> BaseName -> a -> m (Doc HL)
-prettyBind qtys x s = do
-  var <- prettyQtyBinds qtys $ TV x
-  s   <- withPrec Outer $ prettyM s
-  pure $ var <++> colonD <%%> hang 2 s
+PrettyHL q => PrettyHL a => PrettyHL (WithQty q a) where
+  prettyM (MkWithQty q x) = do
+    q <- pretty0M q
+    x <- withPrec Arg $ prettyM x
+    pure $ hcat [q, dotD, x]
+
+
+public export
+data Binder a = MkBinder BaseName a
+
+export
+PrettyHL a => PrettyHL (Binder a) where
+  prettyM (MkBinder x ty) = do
+    x  <- pretty0M $ TV x
+    ty <- align <$> pretty0M ty
+    pure $ parens $ sep [hsep [x, colonD], ty]
+
 
 export
 prettyBindType : PrettyHL a => PrettyHL b => PrettyHL q =>
                  Pretty.HasEnv m =>
-                 List q -> BaseName -> a -> Doc HL -> b -> m (Doc HL)
-prettyBindType qtys x s arr t = do
-  bind <- prettyBind qtys x s
-  t    <- withPrec AnnR $ under T x $ prettyM t
-  parensIfM AnnR $ hang 2 $ parens bind <++> arr <%%> t
+                 Maybe q -> BaseName -> a -> Doc HL -> b -> m (Doc HL)
+prettyBindType q x s arr t = do
+  bind <- case q of
+    Nothing => pretty0M $ MkBinder x s
+    Just q  => pretty0M $ MkWithQty q $ MkBinder x s
+  t <- withPrec AnnR $ under T x $ prettyM t
+  parensIfM AnnR $ hang 2 $ bind <++> arr <%%> t
 
 export
 prettyArm : PrettyHL a => Pretty.HasEnv m =>
@@ -105,15 +123,16 @@ prettyArms =
   map (braces . asep) . traverse (\(xs, l, r) => prettyArm T xs l r)
 
 export
-prettyCase : PrettyHL a => PrettyHL b => PrettyHL c => PrettyHL q =>
+prettyCase : PrettyHL a => PrettyHL b => PrettyHL c => IsQty q =>
              Pretty.HasEnv m =>
              q -> a -> BaseName -> b -> List (SnocList BaseName, Doc HL, c) ->
              m (Doc HL)
 prettyCase pi elim r ret arms = do
-  elim <- prettyQtyBinds [pi] elim
-  ret  <- prettyLams Nothing T [< r] ret
-  arms <- prettyArms arms
-  pure $ asep [caseD <++> elim, returnD <++> ret, ofD <++> arms]
+  caseq <- (caseD <+>) <$> prettySuffix pi
+  elim  <- pretty0M elim
+  ret   <- prettyLams Nothing T [< r] ret
+  arms  <- prettyArms arms
+  pure $ asep [caseq <++> elim, returnD <++> ret, ofD <++> arms]
 
 export
 escapeString : String -> String
@@ -142,12 +161,12 @@ prettyTagBare t = hl Tag $ quoteTag t
 parameters (showSubsts : Bool)
  mutual
   export covering
-  [TermSubst] PrettyHL q => PrettyHL (Term q d n) using TermSubst ElimSubst
+  [TermSubst] IsQty q => PrettyHL q => PrettyHL (Term q d n) using ElimSubst
   where
     prettyM (TYPE l) =
       parensIfM App $ !typeD <+> hl Syntax !(prettyUnivSuffix l)
     prettyM (Pi qty s (S [< x] t)) =
-      prettyBindType [qty] x s !arrowD t.term
+      prettyBindType (Just qty) x s !arrowD t.term
     prettyM (Lam (S x t)) =
       let GotLams {names, body, _} = getLams' x t.term Refl in
       prettyLams (Just !lamD) T (toSnocList' names) body
@@ -156,7 +175,7 @@ parameters (showSubsts : Bool)
       t <- withPrec Times   $ prettyM t
       parensIfM Times $ asep [s <++> !timesD, t]
     prettyM (Sig s (S [< x] (Y t))) =
-      prettyBindType {q} [] x s !timesD t
+      prettyBindType {q} Nothing x s !timesD t
     prettyM (Pair s t) =
       let GotPairs {init, last, _} = getPairs' [< s] t in
       prettyTuple $ toList $ init :< last
@@ -193,7 +212,7 @@ parameters (showSubsts : Bool)
         prettyM $ pushSubstsWith' th id s
 
   export covering
-  [ElimSubst] PrettyHL q => PrettyHL (Elim q d n) using TermSubst ElimSubst
+  [ElimSubst] IsQty q => PrettyHL q => PrettyHL (Elim q d n) using TermSubst
   where
     prettyM (F x) =
       hl' Free <$> prettyM x
@@ -229,22 +248,22 @@ parameters (showSubsts : Bool)
         prettyM $ pushSubstsWith' th id e
 
   export covering
-  prettyTSubst : Pretty.HasEnv m => PrettyHL q =>
+  prettyTSubst : Pretty.HasEnv m => IsQty q => PrettyHL q =>
                  TSubst q d from to -> m (Doc HL)
   prettyTSubst s =
     prettySubstM (prettyM @{ElimSubst}) (!ask).tnames TVar "[" "]" s
 
 export covering %inline
-PrettyHL q => PrettyHL (Term q d n) where
+IsQty q => PrettyHL q => PrettyHL (Term q d n) where
   prettyM = prettyM @{TermSubst False}
 
 export covering %inline
-PrettyHL q => PrettyHL (Elim q d n) where
+IsQty q => PrettyHL q => PrettyHL (Elim q d n) where
   prettyM = prettyM @{ElimSubst False}
 
 
 export covering
-prettyTerm : PrettyHL q => (unicode : Bool) ->
+prettyTerm : IsQty q => PrettyHL q => (unicode : Bool) ->
              (dnames : NContext d) -> (tnames : NContext n) ->
              Term q d n -> Doc HL
 prettyTerm unicode dnames tnames term =