Emulating super calls

Learn
#1

I wanted to emulate OOP-style decorators for open recursion and found it surprisingly difficult.

The core idea is this: There is some vtable which contains a bunch of functions, and each function receives this vtable as argument. Decorators are vtable transformers and add or alter some behavior. They can dispatch to their wrapped vtable or the fixpoint vtable, which is written as super and this in most OOP languages.

So far this is very similar to mtl style typeclasses and transformers. Each typeclass is a vtable, each transformer is a decorator, lift calls the parent implementation.
But monad transformers do not have the vtable argument. If we lift through a decorator and the parent class contains a recursive call we do not consider the decorator in nested calls.

One approach I have seen before is to reify the vtable, but this tends to optimize a lot worse and composes badly unless we also use some generic record library.

data ListPrinter a = LP {
   plist :: ListPrinter a -> [a] -> String,
   pelem :: ListPrinter a -> a -> String
}
pDec :: ListPrinter Int -> ListPrinter Int
pDec super = LP {
    plist = \r xs -> plist super r xs,
    pelem = \r d -> if d == 0 then "ZERO" else pelem super r d
}
pList :: (a -> String) -> ListPrinter a
pList f = LP {
   plist = \r xs -> case  xs of
      [] -> "[]"
      (x:xs) -> pelem r r x <> " : " <> plist r r xs,
   pelem = \_ -> f
}

Typeclass decorators essentially would need two super-classes, one for the parent and one for the root/this. But I haven’t found a way to dispatch in a low-weight way, essentially simulating the distinction of super vs this in OOP languages. The approaches I considered are pretty awkward, either boilerplate heavy or using complex type familiies/overlapping instances/implicit params for instance selection.

Is there a known way to do this nicely using type classes rather than structs of functions?

#2

Unless someone else has a better idea I’m gonna use the (admittedly bizarre) implicit params solution. It seems to optimize alright and isn’t too much boilerplate for new instances.

Here is the printer example in this style. The implicit parameters essentially pass the typeclass parameters from typeclass to calls, and the self and super wrappers use them to pick the correct type parameters.

class Printer r t a where
     printImpl :: (?printRoot :: Proxy# r, ?printLocal :: Proxy# t) => a -> String

-- >>> callPrint @(DecZero Base) [0,1,2,3 ::Int]
-- "ZERO : 1 : 2 : 3 : []"

data Base
instance (Printer r r [x], Printer r r x) => Printer r Base [x] where
   printImpl [] = "[]"
   printImpl (x:xs) = self (printR x) <> " : " <> self (printR xs)
instance Printer r Base Int where
   printImpl = show

data DecZero f
instance (Printer r f Int) => Printer r (DecZero f) Int where
   {-# INLINE printImpl #-}
   printImpl 0 = "ZERO"
   printImpl x = super (printR x)
instance {-# OVERLAPS #-} (Printer r f x) => Printer r (DecZero f) x where
   {-# INLINE printImpl #-}
   printImpl x = super (printR x)


newtype Dispatch self root next  a = Dispatch { unDispatch :: a }
self :: Dispatch x root root a -> a
self = unDispatch
super :: Dispatch (f parent) root parent a -> a
super = unDispatch
printR
     :: forall x l a r.  (?printRoot :: Proxy# r, ?printLocal :: Proxy# l, Printer r x a) 
    => a -> Dispatch l r x String
printR x = Dispatch (let ?printLocal = proxy# :: Proxy# x in printImpl x)

callPrint :: forall r a. (Printer r r a) => a -> String
callPrint a =
    let ?printRoot = proxy# :: Proxy# r; ?printLocal = proxy# :: Proxy# r 
    in self (printR a)

data Proxy# a
proxy# :: Proxy# a
proxy# = proxy#


-- Rec {
-- -- RHS size: {terms: 34, types: 30, coercions: 0, joins: 0/0}
-- $w$dPrinter
--   = \ w w1 ->
--       case w1 of {
--         [] -> $fPrinterkTYPErBase[]2;
--         : x xs ->
--           case x of { I# ds ->
--           case ds of ds1 {
--             __DEFAULT ->
--               case $witos ds1 [] of { (# ww1, ww2 #) ->
--               ++_$s++
--                 (unpackAppendCString# $fPrinterkTYPErBase[]1 ($w$dPrinter w xs))
--                 ww1
--                 ww2
--               };
--             0# ->
--               ++
--                 lvl1
--                 (unpackAppendCString# $fPrinterkTYPErBase[]1 ($w$dPrinter w xs))
--           }
--           }
--       }
-- end Rec }
#3

Searching for "open recursion" decorators brought up this:

which has some resemblance to a paper by Oleg Kiselyov:

Subclassing errors, OOP, and practically checkable rules to prevent them.

Both could be worth reading…

1 Like
#4

One approach I have seen before is to reify the vtable, but this tends to optimize a lot worse and composes badly unless we also use some generic record library.

That’s the approach I used in my own experiments. My decorators can be combined through their Monoid instance, but they do require some Generic magic in order to be applied. I didn’t run any in-depth performance benchmarks.

1 Like