{-# LANGUAGE MonomorphismRestriction #-}
module Main where
import Data.List
import Text.PrettyPrint
— our ‘initial’ encoding of a language consisting of integers, addition, subtraction, and negation
data Expr =
Int_ Int
| Add_ [Expr]
| Sub_ [Expr]
| Neg_ Expr
— Let’s build a quick basic printer!
toStr :: Expr -> String
toStr v = undefined
{- Let’s build a tree-like generating pretty printer! 🙂
Int_ 1 would be represented as:
1
Neg_ 1 would be represented as:
– 1
Add_ [Int_ 6, Int_ 7] would be represented as:
+
6
7
Add_ [Add_ [Int_ 1, Int_ 2], Int_ 3] would be represented as:
+
+
1
2
3
Some notable functions we might be interested in:
* text :: String -> Doc — convert a String into a Doc
* empty :: Doc — empty Doc
* nest :: Int -> Doc -> Doc — nest (or indent) a document by a given number of positions
* $$ —
* $+$ —
* <> —
-}
renderI :: Expr -> Doc
renderI v = undefined
— our ‘final’ encoding of the same language (lowercase letters to differentiate)
class Sym rep where
int_ :: Int -> rep Int
neg_ :: rep Int -> rep Int
add_ :: [rep Int] -> rep Int
sub_ :: [rep Int] -> rep Int
— create a ‘pretty printing’ type
newtype Pr a = Pr { unPr :: Doc }
— define an instance for Sym Pr
instance Sym Pr where
— TODO
— create an extra printer (for the sake of naming it `renderF` like the `renderI` above, however, if we had parameters in unPr, we might’ve set defaults)
renderF :: Pr a -> Doc
renderF = unPr
main :: IO ()
main = do
putStrLn “Hi”
putStrLn $ toStr $ Add_ [Int_ 1]
putStrLn $ toStr $ Add_ [Int_ 1, Int_ 2]
putStrLn $ toStr $ Sub_ [Add_ [Int_ 1, Int_ 2], Int_ 10]
putStrLn “Initial encoding style”
putStrLn $ render $ renderI $ Int_ 1
putStrLn $ render $ renderI $ Neg_ $ Int_ 1
putStrLn $ render $ renderI $ Add_ [Int_ 1, Int_ 2, Int_ 3]
putStrLn $ render $ renderI $ Add_ [Int_ 1, Int_ 2, Add_ [Int_ 3, Int_ 4, Neg_ $ Int_ 5]]
putStrLn $ render $ renderI $ Sub_ [Int_ 1, Int_ 2, Int_ 3]
putStrLn $ render $ renderI $ Add_ [Add_ [Add_ [Add_ [Int_ 1]]]]
putStrLn “Typed tagless final encoding style”
putStrLn $ render $ renderF $ int_ 1
putStrLn $ render $ renderF $ neg_ $ int_ 1
putStrLn $ render $ renderF $ add_ [int_ 1, int_ 2, int_ 3]
putStrLn $ render $ renderF $ add_ [int_ 1, int_ 2, add_ [int_ 3, int_ 4, neg_ $ int_ 5]]
putStrLn $ render $ renderF $ sub_ [int_ 1, int_ 2, int_ 3]
putStrLn $ render $ renderF $ add_ [add_ [add_ [add_ [int_ 1]]]]