add pretty printer for Nockma

src/Juvix/Compiler/Backend/VampIR/Pretty/Base.hs

@@ -6,7 +6,6 @@ import Juvix.Compiler.Backend.VampIR.Language
 import Juvix.Compiler.Backend.VampIR.Pretty.Keywords
 import Juvix.Compiler.Backend.VampIR.Pretty.Options
 import Juvix.Data.CodeAnn
-import Juvix.Data.NameKind
 
 class PrettyCode c where
   ppCode :: (Member (Reader Options) r) => c -> Sem r (Doc Ann)

src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs

@@ -28,7 +28,6 @@ import Juvix.Compiler.Concrete.Translation.FromSource.Data.Context (ParserResult
 import Juvix.Compiler.Concrete.Translation.FromSource.Data.Context qualified as Parsed
 import Juvix.Compiler.Pipeline.EntryPoint
 import Juvix.Data.FixityInfo qualified as FI
-import Juvix.Data.NameKind
 import Juvix.Prelude hiding (scoped)
 
 iniScoperState :: ScoperState

src/Juvix/Compiler/Internal/Translation/FromConcrete.hs

@@ -31,7 +31,6 @@ import Juvix.Compiler.Internal.Translation.FromConcrete.Data.Context
 import Juvix.Compiler.Internal.Translation.FromConcrete.NamedArguments
 import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination.Checker
 import Juvix.Compiler.Pipeline.EntryPoint
-import Juvix.Data.NameKind
 import Juvix.Prelude
 import Safe (lastMay)
 

src/Juvix/Compiler/Nockma/Pretty.hs

@@ -0,0 +1,26 @@
+module Juvix.Compiler.Nockma.Pretty
+  ( module Juvix.Compiler.Nockma.Pretty,
+    module Juvix.Compiler.Nockma.Pretty.Base,
+    module Juvix.Compiler.Nockma.Pretty.Options,
+    module Juvix.Data.PPOutput,
+  )
+where
+
+import Juvix.Compiler.Nockma.Pretty.Base
+import Juvix.Compiler.Nockma.Pretty.Options
+import Juvix.Data.PPOutput
+import Juvix.Prelude
+import Prettyprinter.Render.Terminal qualified as Ansi
+import Prettyprinter.Render.Text (renderStrict)
+
+ppOutDefault :: (PrettyCode c) => c -> AnsiText
+ppOutDefault = mkAnsiText . PPOutput . doc defaultOptions
+
+ppOut :: (CanonicalProjection a Options, PrettyCode c) => a -> c -> AnsiText
+ppOut o = mkAnsiText . PPOutput . doc (project o)
+
+ppTrace :: (PrettyCode c) => c -> Text
+ppTrace = Ansi.renderStrict . reAnnotateS stylize . layoutPretty defaultLayoutOptions . doc traceOptions
+
+ppPrint :: (PrettyCode c) => c -> Text
+ppPrint = renderStrict . toTextStream . ppOutDefault

src/Juvix/Compiler/Nockma/Pretty/Base.hs

@@ -0,0 +1,54 @@
+module Juvix.Compiler.Nockma.Pretty.Base
+  ( module Juvix.Compiler.Nockma.Pretty.Base,
+    module Juvix.Data.CodeAnn,
+    module Juvix.Compiler.Nockma.Pretty.Options,
+  )
+where
+
+import Juvix.Compiler.Nockma.Language
+import Juvix.Compiler.Nockma.Pretty.Options
+import Juvix.Data.CodeAnn
+import Juvix.Prelude hiding (Atom)
+
+doc :: (PrettyCode c) => Options -> c -> Doc Ann
+doc opts =
+  run
+    . runReader opts
+    . ppCode
+
+class PrettyCode c where
+  ppCode :: (Member (Reader Options) r) => c -> Sem r (Doc Ann)
+
+runPrettyCode :: (PrettyCode c) => Options -> c -> Doc Ann
+runPrettyCode opts = run . runReader opts . ppCode
+
+instance (PrettyCode a) => PrettyCode (Atom a) where
+  ppCode (Atom k) = annotate (AnnKind KNameFunction) <$> ppCode k
+
+instance PrettyCode Natural where
+  ppCode = return . pretty
+
+instance (PrettyCode a) => PrettyCode (Cell a) where
+  ppCode c = do
+    m <- asks (^. optPrettyMode)
+    case m of
+      AllDelimiters -> do
+        l' <- ppCode (c ^. cellLeft)
+        r' <- ppCode (c ^. cellRight)
+        return (brackets (oneLineOrNextNoSpace (l' <+> r')))
+      MinimizeDelimiters -> do
+        l <- mapM ppCode (unfoldCell c)
+        return (brackets (oneLineOrNextNoSpace (sep l)))
+
+unfoldCell :: Cell a -> NonEmpty (Term a)
+unfoldCell c = c ^. cellLeft :| go [] (c ^. cellRight)
+  where
+    go :: [Term a] -> Term a -> [Term a]
+    go acc = \case
+      t@TermAtom {} -> reverse (t : acc)
+      TermCell (Cell l r) -> go (l : acc) r
+
+instance (PrettyCode a) => PrettyCode (Term a) where
+  ppCode = \case
+    TermAtom t -> ppCode t
+    TermCell c -> ppCode c

src/Juvix/Compiler/Nockma/Pretty/Options.hs

@@ -0,0 +1,32 @@
+module Juvix.Compiler.Nockma.Pretty.Options where
+
+import Juvix.Prelude
+
+data PrettyMode
+  = MinimizeDelimiters
+  | AllDelimiters
+  deriving stock (Data)
+
+defaultOptions :: Options
+defaultOptions =
+  Options
+    { _optPrettyMode = MinimizeDelimiters
+    }
+
+newtype Options = Options
+  { _optPrettyMode :: PrettyMode
+  }
+
+traceOptions :: Options
+traceOptions =
+  Options
+    { _optPrettyMode = AllDelimiters
+    }
+
+makeLenses ''Options
+
+fromGenericOptions :: GenericOptions -> Options
+fromGenericOptions GenericOptions {} = defaultOptions
+
+instance CanonicalProjection GenericOptions Options where
+  project = fromGenericOptions

src/Juvix/Data/CodeAnn.hs

@@ -1,5 +1,6 @@
 module Juvix.Data.CodeAnn
   ( module Juvix.Data.CodeAnn,
+    module Juvix.Data.NameKind,
     module Juvix.Prelude.Pretty,
   )
 where
@@ -9,7 +10,7 @@ import Juvix.Data.Keyword
 import Juvix.Data.NameKind
 import Juvix.Extra.Strings qualified as Str
 import Juvix.Prelude
-import Juvix.Prelude.Pretty hiding (braces, group, list, parens)
+import Juvix.Prelude.Pretty hiding (braces, brackets, group, list, parens)
 import Prettyprinter.Render.Terminal (Color (..), bold, colorDull)
 
 type Ann = CodeAnn
@@ -228,6 +229,9 @@ kwAt = delimiter Str.at_
 code :: Doc Ann -> Doc Ann
 code = annotate AnnCode
 
+brackets :: Doc Ann -> Doc Ann
+brackets = enclose kwBracketL kwBracketR
+
 braces :: Doc Ann -> Doc Ann
 braces = enclose kwBraceL kwBraceR
 

src/Juvix/Prelude/Pretty.hs

@@ -183,6 +183,9 @@ spaceOrEmpty = flatAlt (pretty ' ') mempty
 oneLineOrNext :: Doc a -> Doc a
 oneLineOrNext x = PP.group (flatAlt (line <> indent' x) (space <> x))
 
+oneLineOrNextNoSpace :: Doc a -> Doc a
+oneLineOrNextNoSpace x = PP.group (flatAlt (line <> indent' x) x)
+
 oneLineOrNextNoIndent :: Doc a -> Doc a
 oneLineOrNextNoIndent x = PP.group (flatAlt (line <> x) (space <> x))