-- * Essentially, Haskell98
{-# LANGUAGE NoMonomorphismRestriction #-}
-- * Serialization and de-serialization in the tagless-final style
-- * for the extended data type
-- The deserialization problem is posed in
-- \url{http://userpages.uni-koblenz.de/~laemmel/TheEagle/}
-- * Solving the expression problem
-- What is the expression problem (see the slides)
-- We can:
-- add new operations on the data type: we have just added
-- a serializer
-- Add a new expression form (multiplication)
-- We now see how we can extend the serializer and de-serializer.
module SerializeExt where
-- We really are re-using the existing code (which may already be compiled):
import Intro2 hiding (main)
import ExtF hiding (main) -- import the extended `variant': Mul
import Serialize (Tree(..)) -- import the wire format
-- import the original serializer
import qualified Serialize as S hiding (main)
import Control.Monad
-- * //
-- First we extend the serializer
instance MulSYM Tree where
mul e1 e2 = Node "Mul" [e1,e2]
-- And the puzzling duplicator
instance (MulSYM repr, MulSYM repr') => MulSYM (repr,repr') where
mul (e11,e12) (e21, e22) = (mul e11 e21, mul e12 e22)
-- And we serialize the extended terms
tfm1_tree = S.toTree tfm1
-- Node "Add" [Node "Lit" [Leaf "7"],
-- Node "Neg" [Node "Mul" [Node "Lit" [Leaf "1"],Node "Lit" [Leaf "2"]]]]
tfm2_tree = S.toTree tfm2
-- Node "Mul" [Node "Lit" [Leaf "7"],
-- Node "Add" [Node "Lit" [Leaf "8"],
-- Node "Neg" [Node "Add" [Node "Lit" [Leaf "1"],Node "Lit" [Leaf "2"]]]]]
-- * //
-- Let us now extend the de-serializer
-- We merely `add' one clause to the de-serializer of unextended terms.
-- We have not touched the code of the old de-serializer. The file
-- Serialize.hs could have been given to us in the compiled form.
-- We don't need the source code for it since we don't modify it and
-- don't recompile it.
-- The inferred signature is exactly as we wish:
-- fromTreeExt
-- :: (MulSYM repr, ExpSYM repr) =>
-- (Tree -> Either S.ErrMsg repr) -> Tree -> Either S.ErrMsg repr
-- This is a different function, from S.fromTreeExt
-- It relays to the latter for all other nodes
fromTreeExt self (Node "Mul" [e1,e2]) = liftM2 mul (self e1) (self e2)
fromTreeExt self e = S.fromTreeExt self e -- use the old one for the rest
-- * Tie up the knot
fromTree = S.fix fromTreeExt -- One does use fix in real programs
-- Now we can see the real benefit of using fix in real programs.
-- The fixpoint combinator is NOT a mere curiosity
-- We can de-serialize the unextended terms using the extended
-- de-serializer
tf1'_int3 = S.check_consume S.thrice . fromTree $ S.tf1_tree
{-
5
"(8 + (-(1 + 2)))"
Node "Add" ...
-}
-- We can now de-serialize the extended terms
-- And evaluate them in different interpreters
tfm1'_int3 = S.check_consume S.thrice . fromTree $ tfm1_tree
{-
5
"(7 + (-(1 * 2)))"
Node "Add" [Node "Lit" [Leaf "7"] ...
-}
tfm2'_int3 = S.check_consume S.thrice . fromTree $ tfm2_tree
{-
35
"(7 * (8 + (-(1 + 2))))"
Node "Mul" ...
-}
-- * Extending the deserializer has been an open problem!
-- Of course we had to write the deserializer in the open-recursion form.
-- We had to anticipate the extension.
-- But we had to extend the wire format, which is the
-- input of the deserializer (rather than the expression, which
-- is the output of the deserializer).
-- Whether we use the final tagless approach or not,
-- if we want deserializer to be extensible with respect to its
-- input (the wire format), we have to explicitly make it so.
main = do
print tfm1_tree
print tfm2_tree
tf1'_int3
tfm1'_int3
tfm2'_int3
-- LocalWords: serializer deserializer