Or-Patterns as Expressions

or-patterns_as_expressions.markdown

This plays with an interesting idea from Pattern synonyms, arbitrary patterns as expressions, brought up in the ghc-proposal for or-patterns.

data Exp
  = Val Int 
  | Add Exp Exp
  | Mul Exp Exp
  | Div Exp Exp

incr :: Exp -> Exp
incr = \case
  Val i   -> Val (1 + i)
  Add a b -> Add (incr a) (incr b)
  Mul a b -> Mul (incr a) (incr b)
  Div a b -> Div (incr a) (incr b)

There is repition there, the left-hand-side could be implemented as an or-pattern but with no way to (re-)construct it

pattern :: Exp -> Exp -> Exp
pattern MkOp a b <- (Add a b | Mul a b | Div a b)
  where MkOp a b = ???

One option is to abstract these operations into their own data type

data Exp
  = Val Int
  | Op Op Exp Exp
  
data Op = Add | Mul | Div

but that is too simple/obvious/boring for our purposes. We will use PatternSynonyms and iffy-ImplicitParams to implement a pattern that constructs the same pattern it matched on:

type Op = Exp -> Exp -> Exp  

data Protect where
  Protect :: (?op :: Op) => Protect
  
protectOp :: Exp -> Maybe (Protect, Exp, Exp)
protectOp = \case
  Add a b -> Just (Protect, a, b) where ?op = Add
  Mul a b -> Just (Protect, a, b) where ?op = Mul
  Div a b -> Just (Protect, a, b) where ?op = Div
  _       -> Nothing
  
pattern MkOp :: () => (?op::Op) => Exp -> Exp -> Exp
pattern MkOp a b <- Op (protectOp -> Protect) a b
  where MkOp a b  = Op ?op                    a b

Now we avoid repeated pattern matches (solved by regular or-patterns: (Add a b | Mul a b | Div a b )) and an untouched variable name in the case of parameterising Op by an operator (incr (Op op a b) = Op op (incr a) (incr b)).

incr :: Exp -> Exp
incr = \case
  Val i    -> Val (1 + i)
  MkOp a b -> MkOp (incr a) (incr b)

Of course this is a hack since the moment we use MkOp twice in the same scope we are in trouble.

Record Pattern Synonyms

More info on record pattern synonyms, a new feature in GHC 8.0.

Allows us to write

splitOp :: Exp -> Maybe (Op, Exp, Exp)
splitOp (Add a b) = Just (Add, a, b)
splitOp (Mul a b) = Just (Mul, a, b)
splitOp _         = Nothing

pattern MkOp :: Op -> Exp -> Exp -> Exp
pattern MkOp {operator, a, b} <- (splitOp -> Just (operator, a, b))
  where MkOp operator a b      = operator a b

incr :: Exp -> Exp
incr = \case
  Val i        -> Val (1 + i)
  MkOp{a,b,..} -> MkOp{a=incr a, b=incr b,..}

This method actually gives us an error when multiple operators are in scope, probably what we want anyway!

-- tTDv.hs:21:10-44: error: …
--     • Conflicting definitions for ‘operator’
--       Bound at: /tmp/tTDv.hs:21:10-25
--                 /tmp/tTDv.hs:21:29-44
--     • In an equation for ‘combine’

combine :: Exp -> Exp -> Exp
combine (MkOp{a=u,b=v,..}) (MkOp{a=x,b=y,..}) = undefined 

Other Stuff

A less silly application: the paper [http://www.cse.chalmers.se/~josefs/publications/deepshallow.pdf](Combining Deep and Shallow Embedding of Domain-Specic Languages) defines an “embedded” version of Maybe where we do not know whether Option a represents a None or a Just _ at Haskell evaluation-time:

data Option a = Option { isSome :: FunC Bool, fromSome :: a }

data FunC a where
  Fls   :: FunC Bool
  Tru   :: FunC Bool
  Pair  :: FunC a -> FunC b -> FunC (a, b)
  Undef :: FunC a
  ...

where we can encode how to embed our Option a into FunC _:

class Syntactic a where
  type Internal a
  toFunC   :: a -> FunC (Internal a)
  fromFunC :: FunC (Internal a) -> a
  
instance Syntactic a => Syntactic (Option a) where
  type Internal a = (Bool, Internal a)
  toFunC :: Option a -> FunC (Bool, Internal a)
  toFunC (O b a) = Pair b (toFunC a)
  
  fromFunC :: FunC (Bool, Internal a) -> Option a
  fromFunC (Pair b 

where `

This suggests that ‘deep’ and ‘shallow’ do not form a dichotomy, but rather are two extreme points on a scale of embedding depth. Augustsson discusses representations of intermediate depth, in which some constructs have deep embeddings and some shallow. In particular, for a language with a ‘semantics’ in the form of generated assembly code, the deeply embedded constructs will persist as generated code, whereas those with shallow embeddings will get translated away at ‘compile time’. Augustsson calls these neritic embeddings, after the region of the sea between the shore and the edge of the continental shelf.

— Folding Domain-Specific Languages: Deep and Shallow Embeddings (Functional Pearl)