diff --git a/rlp.cabal b/rlp.cabal index 9d9120a..ad5cca8 100644 --- a/rlp.cabal +++ b/rlp.cabal @@ -22,6 +22,7 @@ library , TI other-modules: Data.Heap , Control.DFA + , Data.Pretty -- other-extensions: build-depends: base ^>=4.18.0.0 diff --git a/src/Core.hs b/src/Core.hs index 6ab02c7..f821841 100644 --- a/src/Core.hs +++ b/src/Core.hs @@ -2,6 +2,7 @@ module Core where ---------------------------------------------------------------------------------- import Data.Coerce +import Data.Pretty ---------------------------------------------------------------------------------- data Expr = Var Name @@ -39,6 +40,11 @@ newtype Program = Program [ScDef] ---------------------------------------------------------------------------------- +instance Pretty Expr where + prettyPrec _ (Var k) = iStr k + +---------------------------------------------------------------------------------- + instance Semigroup Program where (<>) = coerce $ (++) @ScDef diff --git a/src/Data/Pretty.hs b/src/Data/Pretty.hs new file mode 100644 index 0000000..52c9b2b --- /dev/null +++ b/src/Data/Pretty.hs @@ -0,0 +1,54 @@ +module Data.Pretty + ( Pretty(..) + , ISeq + , iNil + , iStr + , iAppend + ) + where +---------------------------------------------------------------------------------- + +class Pretty a where + pretty :: a -> String + prettyPrec :: Int -> a -> ISeq + + pretty = squash . prettyPrec 0 + prettyPrec _ a = iBracket (iStr $ pretty a) + +data ISeq where + INil :: ISeq + IStr :: String -> ISeq + IAppend :: ISeq -> ISeq -> ISeq + +instance Semigroup ISeq where + (<>) = IAppend + +instance Monoid ISeq where + mempty = INil + +squash :: ISeq -> String +squash = flatten . pure + +flatten :: [ISeq] -> String +flatten (INil : ss) = flatten ss +flatten (IStr s : ss) = s ++ flatten ss +flatten (IAppend r s : ss) = flatten (r : s : ss) + +iNil :: ISeq +iNil = INil + +iStr :: String -> ISeq +iStr = IStr + +iAppend :: ISeq -> ISeq -> ISeq +iAppend = IAppend + +iIndent :: ISeq -> ISeq +iIndent = id + +iBreak :: ISeq +iBreak = iStr "\n" + +iBracket :: ISeq -> ISeq +iBracket s = iStr "(" `iAppend` s `iAppend` iStr ")" +