Typed Expression Analyzer

Question

I am trying to create a typed expression parser in Haskell that works fine so far, but I'm currently trying to implement higher order functions. I swallowed the problem into a simple example:

{-# LANGUAGE TypeFamilies,GADTs,FlexibleContexts,RankNTypes #-} -- A function has an argument type and a result type class Fun f where type FunArg f type FunRes f -- Expressions are either constants of function applications data Expr a where Const :: a -> Expr a App :: Fun f => f -> FunArg f -> Expr (FunRes f) -- A very simple function data Plus = Plus -- Which takes two integer expressions and returns an integer expression instance Fun Plus where type FunArg Plus = (Expr Int,Expr Int) type FunRes Plus = Int -- A more complicated function which lifts a function to lists (like in haskell) data Map fr = Map f -- For this we need the concept of lifting function arguments: class Liftable a where type LiftRes a -- A singleton argument is lifted by changing the expression type from a to [a] instance Liftable (Expr a) where type LiftRes (Expr a) = Expr [a] -- Two function arguments are lifted by lifting each argument instance (Liftable a,Liftable b) => Liftable (a,b) where type LiftRes (a,b) = (LiftRes a,LiftRes b) -- Now we can declare a function instance for Map instance (Fun f,Liftable (FunArg f),r ~ LiftRes (FunArg f)) => Fun (Map fr) where type FunArg (Map fr) = r type FunRes (Map fr) = [FunRes f] -- Now a parser for functions: parseFun :: [String] -> (forall f. Fun f => f -> a) -> a -- The parser for the plus function is easy: parseFun ["plus"] f = f Plus -- But the parser for map is not possible: parseFun ("map":sym) f = parseFun sym (\fun -> f (Map fun)) 

It seems that the problem is that there is no way to convince the type controller that each LiftRes is itself Liftable, because declarations of recursive classes are forbidden.

My question is: how do I do this job? Are there other examples of typed expression parsers from which I could use hints?

EDIT: This discussion about family type restrictions seems very related. However, I cannot make my decision in my case, maybe someone can handle it?

Answer 1

The easiest way to get your example to work is to remove the Liftable (FunArg f) constraint Liftable (FunArg f) from the instance declaration. But I think your example is so concise that it does not show why you really need it.

So, it's best to add a Liftable (FunArg f) superclass constraint to the Fun class:

 class Liftable (FunArg f) => Fun f where ... 

If this is not possible (i.e. if not all of your functions have valid argument types), then you cannot expect to write parseFun this type.

A more general note: I think what you are trying to do here is very strange and maybe too much at once. Analysis from unstructured rows to a context-free data type is already quite complicated. Why not do it first and write a separate function that converts the “untyped” but structured representation of your language into a typed one.

EDIT (as a reaction to comments revised): As indicated in the discussion of type family constraints that you also linked in your question, you can get around the superclass loop constraint using ConstraintKinds . Here is a way to make your given example work. Perhaps this will scale to a complete solution?

 {-# LANGUAGE RankNTypes, ScopedTypeVariables, TypeFamilies, FlexibleContexts, GADTs #-} import Data.Constraint -- from the constraints package import Data.Proxy -- from the tagged package -- A function has an argument type and a result type class Liftable (FunArg f) => Fun f where type FunArg f type FunRes f -- Expr, Plus, and instance Fun Plus as before class Liftable a where type LiftRes a get :: pa -> Dict (Liftable (LiftRes a)) -- acquire "superclass" dictionary by calling this method and -- then pattern matching on the result instance Liftable (Expr a) where type LiftRes (Expr a) = Expr [a] get _ = Dict instance (Liftable a, Liftable b) => Liftable (a, b) where type LiftRes (a, b) = (LiftRes a, LiftRes b) get (_ :: p (a, b)) = case get (Proxy :: Proxy a) of -- extra code required Dict -> case get (Proxy :: Proxy b) of -- extra code required Dict -> Dict data Map fr = Map f instance (Fun f, Liftable r, r ~ LiftRes (FunArg f)) => Fun (Map fr) where type FunArg (Map fr) = r type FunRes (Map fr) = [FunRes f] parseFun :: forall a. [String] -> (forall f. Fun f => f -> a) -> a parseFun ["plus"] f = f Plus parseFun ("map" : sym) f = parseFun sym (\ (fun :: g) -> case get (Proxy :: Proxy (FunArg g)) of -- extra code required Dict -> f (Map fun))