I want to implement a generic recursion operator for (at first simple) ADTs.
(Simple means that only with constructors whose argument types are the defined one.) The general idea is to be able to use something as simple as $(recop ''Alg)
.
It is easy to write down the recursion operator manually for a given type.
data D = E | C D D
recD :: t -> ((D, t) -> (D, t) -> t) -> D -> t
recD rE rC = let r = recD rE rC in \case
E -> rE
C pC0 pC1 -> rC (pC0, r pC0) (pC1, r pC1)
I wanted to use templates for that. My problem is the recursive call e.g. r pC0
. I got it working without the recursive call.
newNames :: String -> Int -> Q [Name]
newNames stem n = sequence [ newName (stem ++ show i) | i <- [1::Int .. n] ]
match' :: PatQ -> ExpQ -> MatchQ
match' pat exp = match pat (normalB exp) []
recop :: Name -> ExpQ
recop name = do
TyConI (DataD _ algName [] {-_-} ctors _) <- reify name
let ctorNames = [ ctorName | NormalC ctorName _ <- ctors ] :: [Name]
let ctorTypes = [ [ typ | (_, typ) <- bts ] | NormalC _ bts <- ctors ]
rs <- newNames ("r" ++ nameBase algName) (length ctorNames)
pss <- sequence [ newNames ("p" ++ nameBase algName ++ nameBase ctorName) (length ctorTypes) | (ctorName, ctorTypes) <- zip ctorNames ctorTypes ]
let pats = zipWith conP ctorNames (map varP <$> pss) :: [PatQ]
let prs = zipWith (\p r -> tupE [varE p, r]) ps "recursive calls"
lamE (varP <$> rs) $ lamCaseE [ match' pat $ foldl appE (varE r) prs | (r, pat, ps) <- zip3 rs pats pss ]
I don't know how to get the hole of "recursive calls"
filled. I have no idea and suspect that it's not easily doable.
You do it exactly the same way you've done it in your concrete code; you generate
let r = .. in ..
and refer to thatr
to construct the recursive calls. Right now, you are just constructing the\case { .. }
portion. Keep in mind you can rewriterecD
asCredit goes to user2407038 who answered the question in a comment.
The general pattern is to use an additional
let
construct:so you can refer to
recursive_
inexpression
.