Sunday, July 10, 2011

GHC ImplicitParams are nice, but they're not really Haskellesque

With appropriate options, GHC let's you do something like:

-- imp-params.hs --

1 {-# LANGUAGE ImplicitParams #-} 2 3 main = do 4 let exp = ?x + ?y 5 print exp where 6 ?x = 3 7 ?y = 7

10

If you look at the type of ?x + ?y you can see that the unbound variables are reflected in the type.

-- imp-params.hs --

1 {-# LANGUAGE ImplicitParams #-} 2 {-# LANGUAGE NoMonomorphismRestriction #-} 3 4 dexp = ?x + ?y

ghci> :t dexp
dexp :: (?x::a, ?y::a, Num a) => a

(Sorry about lifting the monomorphism restriction -- I didn't want to add a type signature because that would defeat the whole point of inspecting the type with ghci).

I like this feature, but it's not really in the spirit of Haskell. Though they did do a good job of covering up the problems; if you look at that type signature you'll see that, even though dexp takes parameters, it does not have a function type: it has the type of its result. This is important because

ghci> :t (+)
(+) :: (Num a) => a -> a -> a

In particular, if ?x were a function type (like the name "implicit parameters" suggests), you would not be allowed to use + on it. But you can see that this is deceptive...

-- deceptive.hs --

1 {-# LANGUAGE ImplicitParams #-} 2 3 dexp :: (?x::Int) => Int 4 dexp = ?x

ghci> :t dexp
dexp :: (?x::Int) => Int
ghci> print dexp
<interactive>:1:6: Unbound implicit parameter (?x::Int) arising from a use of `dexp' at <interactive>:1:6-9 In the first argument of `print', namely `dexp' In the expression: print dexp In the definition of `it': it = print dexp

If it were really just an Int as its type claims, you should be allowed to print it. But if it's not really just an Int you should not be allowed to use + on it.

(Actually technically you are allowed to print it, which is why I had to use ghci to get that error:

-- deceptive.hs (cont) --

1 {-# LANGUAGE ImplicitParams #-} 2 3 dexp :: (?x::Int) => Int 4 dexp = ?x 5 6 main = do 7 print dexp

deceptive.hs:6:0: Implicit parameters escape from the monomorphic top-level binding of `main': ?x::Int arising from a use of `dexp' at deceptive.hs:7:10-13 Probable fix: give these definition(s) an explicit type signature or use -XNoMonomorphismRestriction When generalising the type(s) for `main'

You see the unbound variables leaked all the way out in to main, changed its type, and hit the monorphism restriction. Sneaky.)

Haskell has of course encountered this dilemma before, which is where functors come from. And in functors the magic is always made explicit:

-- params-with-functors.hs --

1 dexp :: Int -> Int 2 dexp = id 3 4 instance Functor ((->) a) where 5 fmap f p = f . p

ghci> :t fmap (5-) dexp
fmap (5-) dexp :: Int -> Int
ghci> fmap (5-) dexp 3
2

It's just like an implicit (unnamed) parameter, except it doesn't leak up the call stack by itself -- you have to do so explicitly with fmap.

But whether or not we're ok with this breach of Haskellinity is really beside the point: you can't do that much with implicit parameters anyway. As I pointed out last time you have no runtime access to implicit parameters, so you can't do anything like R's with(), which would really be the biggest use for dynamic binding.

But this is Haskell, surely we can implement dynamic binding!

Since an "unbound expression" is basically a map from a named set of parameters to its resulting value, we could represent it as a map taking an HList Record.

-- dyn-bind.hs --

1 {-# LANGUAGE EmptyDataDecls #-} 2 {-# LANGUAGE TemplateHaskell #-} 3 {-# LANGUAGE DeriveDataTypeable #-} 4 5 import Data.HList 6 import Data.HList.Label4 7 import Data.HList.TypeEqGeneric1 8 import Data.HList.TypeCastGeneric1 9 import Data.HList.MakeLabels 10 11 $(makeLabels ["labX", "labY"]) 12 13 x rec = rec # labX 14 y rec = rec # labY 15 16 z rec = (x rec) + (y rec)

Here x represents ?x, ie it takes the supplied variables and just grabs the one called x. Likewise for y. Then z represents ?x + ?y. These have types:

ghci> :t x
x :: (HasField (Proxy LabX) r v) => r -> v
ghci> :t y
y :: (HasField (Proxy LabY) r v) => r -> v
ghci> :t z
z :: (HasField (Proxy LabX) r v, HasField (Proxy LabY) r v, Num v) => r -> v

And we can bind them:

-- dyn-bind.hs (cont) --

18 bindings = 19 labX .=. 5 .*. 20 labY .=. 7 .*. 21 emptyRecord 22 23 main = do 24 print $ x bindings 25 print $ y bindings 26 print $ z bindings

5 7 12

And rebind them:

-- dyn-bind.hs (cont) --

18 b1 = 19 labX .=. 5 .*. 20 labY .=. 7 .*. 21 emptyRecord 22 23 b2 = 24 labX .=. 9 .*. 25 labY .=. 12 .*. 26 emptyRecord 27 28 main = do 29 print $ z b1 30 print $ z b2

12 21

So that's all the structure we need; now we just need ways to combine them. Here you can see we are going to run into problems, because if we start with say +, which is (Num a) => a -> a -> a, and bind it to its first dynamic argument, we will get a dynamic function. Meaning the seconding binding has a different type signature. Or, as an example,

-- dyn-bind.hs (cont) --

18 call1 f dexp rec = f (dexp rec)

ghci> :t (+)
(+) :: (Num a) => a -> a -> a
ghci> :t call1 (+) x
call1 (+) x :: (Num t1, HasField (Proxy LabX) t t1) => t -> t1 -> t1
ghci> :t call1 (call1 (+) x) y
call1 (call1 (+) x) y :: (Num t1, HasField (Proxy LabX) t11 t1, HasField (Proxy LabY) t t11) => t -> t1 -> t1

That does not look at all like the right type. And of course binding it fails:

ghci> (call1 (call1 (+) x) y) b1
<interactive>:1:18: No instance for (HasField (Proxy LabX) Integer t1) arising from a use of `x' at <interactive>:1:18 Possible fix: add an instance declaration for (HasField (Proxy LabX) Integer t1) In the second argument of `call1', namely `x' In the first argument of `call1', namely `(call1 (+) x)' In the expression: (call1 (call1 (+) x) y) b1

So the second binding is a different type...

-- dyn-bind.hs (cont) --

18 call1 f dexp rec = f (dexp rec) 19 call2 f dexp rec = (f rec) (dexp rec)

ghci> (call2 (call1 (+) x) y) b1
12

It is of course totally contrary to the spirit of dynamic binding to require the programmer to pay such close attention to whether this is the first or second or any dynamic combination. And this is where things start to fall apart...

The natural way to make the call operation generalize the signatures of call1 and call2 would be to use a typeclass:

-- dyn-bind2.hs --

1 {-# LANGUAGE EmptyDataDecls #-} 2 {-# LANGUAGE TemplateHaskell #-} 3 {-# LANGUAGE DeriveDataTypeable #-} 4 {-# LANGUAGE MultiParamTypeClasses #-} 5 {-# LANGUAGE FunctionalDependencies #-} 6 {-# LANGUAGE FlexibleInstances #-} 7 8 import Data.HList 9 import Data.HList.Label4 10 import Data.HList.TypeEqGeneric1 11 import Data.HList.TypeCastGeneric1 12 import Data.HList.MakeLabels 13 14 $(makeLabels ["labX", "labY"])

16 class Call a b c | a b -> c where 17 call :: a -> b -> c

19 infixl <*> 20 f <*> x = call f x 21 22 instance Call (a -> b) a b where 23 call f x = f x

Which gets us regular function application, sort of:

ghci> ((+) :: Int -> Int -> Int) <*> (2::Int) <*> (3::Int)
5
ghci> (+) <*> 2 <*> 3
<interactive>:1:0: No instance for (Call (a -> a -> a) t c) arising from a use of `<*>' at <interactive>:1:0-8 Possible fix: add an instance declaration for (Call (a -> a -> a) t c) In the first argument of `(<*>)', namely `(+) <*> 2' In the expression: (+) <*> 2 <*> 3 In the definition of `it': it = (+) <*> 2 <*> 3

It performs correctly but we utterly and completely lose type inference, because the typeclass needs things very specific before it is willing to do anything.

Note that if we were looking for just regular no dynamic binding Haskell we could have written the functional dependency

-- dyn-bind2.hs (cont) --

16 class Call a b c | a -> b c where 17 call :: a -> b -> c

And now we have type inference again,

ghci> (+) <*> 2 <*> 3
5

But that won't work if (+) shoul be able to be applied both to dynamic and to not-dynamic expressions.

I wrestled with a few other variations on this path -- I don't think it's the right way to go. As with most things in Haskell the most reliable way to deal with ambiguity is to make things more explicit. And here that means that every little node in the formuala tree should be decorated to show what its dynamic variables are.

-- dyn-bind3.hs --

1 {-# LANGUAGE EmptyDataDecls #-} 2 {-# LANGUAGE TemplateHaskell #-} 3 {-# LANGUAGE DeriveDataTypeable #-} 4 5 module DynBind where 6 7 import Data.HList hiding (apply,Apply) 8 import Data.HList.Label4 9 import Data.HList.TypeEqGeneric1 10 import Data.HList.TypeCastGeneric1 11 import Data.HList.MakeLabels 12 13 $(makeLabels ["labX", "labY"])

So we make it explicit that this is a dynamically bindable expression:

-- dyn-bind3.hs (cont) --

15 data DynExp a b = DynExp (a -> b)

A leaf is an expression with no dynamic variables:

-- dyn-bind3.hs (cont) --

17 leaf x = DynExp (\t -> x)

And then dynVar introduces one variable:

-- dyn-bind3.hs (cont) --

19 dynVar label = DynExp grab where 20 grab rec = rec # label

When we combine expressions by applying, we may as well just pass the whole record on to both branches: they'll just ignore the fields they don't need (exercise: why is this a bad idea?):

-- dyn-bind3.hs (cont) --

22 apply (DynExp f) (DynExp x) = DynExp g where 23 g rec = (f rec) (x rec) 24 25 infixl <*> 26 a <*> b = apply a b 27 28 with hl (DynExp f) = f hl

So let's test that...

-- dyn-bind3.hs (cont) --

30 expr = (leaf (+)) <*> (dynVar labX) <*> (dynVar labY) 31 bindings = 32 labX .=. 5 .*. 33 labY .=. 3 .*. 34 emptyRecord 35 36 main = do 37 print $ with bindings expr

8

So far it seems to work. But then problems develop...

-- dyn-bind3.hs (cont) --

30 expr = (leaf (+)) <*> (dynVar labX) <*> (dynVar labY) 31 b1 = 32 labX .=. 5 .*. 33 labY .=. 3 .*. 34 emptyRecord 35 b2 = 36 labY .=. 3 .*. 37 labX .=. 5 .*. 38 emptyRecord 39 40 main = do 41 print $ with b1 expr 42 print $ with b2 expr

dyn-bind3.hs:42:20: Couldn't match expected type `LabY' against inferred type `LabX' Expected type: DynExp (Record (HCons (LVPair (Proxy LabY) t) (HCons (LVPair (Proxy LabX) t1) HNil))) t2 Inferred type: DynExp (Record (HCons (LVPair (Proxy LabX) t3) (HCons (LVPair (Proxy LabY) t4) HNil))) a In the second argument of `with', namely `expr' In the second argument of `($)', namely `with b2 expr'

That's a tricky one. So does it matter what order you specify the labels in?

-- dyn-bind3.hs (cont) --

30 expr = (leaf (+)) <*> (dynVar labX) <*> (dynVar labY) 31 b1 = 32 labX .=. 5 .*. 33 labY .=. 3 .*. 34 emptyRecord 35 b2 = 36 labY .=. 3 .*. 37 labX .=. 5 .*. 38 emptyRecord 39 40 main = do 41 print $ with b2 expr

8

No... it just won't work if you do it 2 different ways. What is going on here? What if you don't specify them any ways?

-- dyn-bind3.hs (cont) --

30 expr = (leaf (+)) <*> (dynVar labX) <*> (dynVar labY) 31 32 main = do 33 print "hi"

dyn-bind3.hs:30:23: No instance for (HasField (Proxy LabX) t1 t) arising from a use of `dynVar' at dyn-bind3.hs:30:23-33 Possible fix: add an instance declaration for (HasField (Proxy LabX) t1 t) In the second argument of `(<*>)', namely `(dynVar labX)' In the first argument of `(<*>)', namely `(leaf (+)) <*> (dynVar labX)' In the expression: (leaf (+)) <*> (dynVar labX) <*> (dynVar labY) dyn-bind3.hs:30:41: No instance for (HasField (Proxy LabY) t1 t) arising from a use of `dynVar' at dyn-bind3.hs:30:41-51 Possible fix: add an instance declaration for (HasField (Proxy LabY) t1 t) In the second argument of `(<*>)', namely `(dynVar labY)' In the expression: (leaf (+)) <*> (dynVar labX) <*> (dynVar labY) In the definition of `expr': expr = (leaf (+)) <*> (dynVar labX) <*> (dynVar labY)

And now it becomes apparent... notice that this works:

-- dyn-bind3.hs (cont) --

30 expr rec = with rec $ (leaf (+)) <*> (dynVar labX) <*> (dynVar labY) 31 32 main = do 33 print "hi"

"hi"

In other words it would appear that we have hit the monomorphism restriction ;)

We could just lift the restriction, but I prefer another approach that makes types more explicit all around:

-- dyn-bind4.hs --

1 {-# LANGUAGE FlexibleContexts #-} 2 {-# LANGUAGE EmptyDataDecls #-} 3 {-# LANGUAGE TemplateHaskell #-} 4 {-# LANGUAGE DeriveDataTypeable #-} 5 6 import Data.HList hiding (apply,Apply) 7 import Data.HList.Label4 8 import Data.HList.TypeEqGeneric1 9 import Data.HList.TypeCastGeneric1 10 import Data.HList.MakeLabels 11 12 $(makeLabels ["labX", "labY"]) 13 14 data DynExp a b = DynExp (a -> b)

Leaves explicitly take no parameters:

-- dyn-bind4.hs (cont) --

16 leaf :: v -> DynExp (Record HNil) v 17 leaf x = DynExp (\t -> x)

dynVars explicitly take just one:

-- dyn-bind4.hs (cont) --

19 dynVar :: label -> DynExp (Record (HCons (LVPair label v) HNil)) v 20 dynVar label = DynExp grab where 21 grab (Record (HCons (LVPair v) HNil)) = v

And apply uses the functional dependency in HLeftUnion to give its result an explicit type as well (which is why we have to give an explicit type signature, which is why we have to specify all that other stuff):

-- dyn-bind4.hs (cont) --

23 apply (DynExp f) (DynExp x) = DynExp (splitApply f x) 24 25 splitApply :: ( 26 HLeftUnion (Record hl1) (Record hl2) (Record hlU), 27 H2ProjectByLabels ls1 hlU hl1' uu1, 28 H2ProjectByLabels ls2 hlU hl2' uu2, 29 HRearrange ls1 hl1' hl1, 30 HRearrange ls2 hl2' hl2, 31 HLabelSet ls1, 32 HLabelSet ls2, 33 HRLabelSet hl1', 34 HRLabelSet hl2', 35 RecordLabels hl1 ls1, 36 RecordLabels hl2 ls2 37 ) => 38 (Record hl1 -> a -> b) -> 39 (Record hl2 -> a) -> 40 Record hlU -> 41 b 42 splitApply f x hl = f (hMoldByType hl) (x (hMoldByType hl))

And my favorite are these infinitily recursive adaptor functions:

-- dyn-bind4.hs (cont) --

44 hProjectByType r1 = r2 where 45 r2 = hProjectByLabels r2Labels r1 46 r2Labels = recordLabels r2 47 48 hMoldByType r1 = r2 where 49 r2 = hRearrange r2Labels $ hProjectByLabels r2Labels r1 50 r2Labels = recordLabels r2 51 52 infixl <*> 53 a <*> b = apply a b 54 55 with hl (DynExp f) = f $ hMoldByType hl

And now everything works:

-- dyn-bind4.hs (cont) --

57 expr = (leaf (+)) <*> (dynVar labX) <*> (dynVar labY) 58 b1 = 59 labX .=. 5 .*. 60 labY .=. 3 .*. 61 emptyRecord 62 b2 = 63 labY .=. 3 .*. 64 labX .=. 5 .*. 65 emptyRecord 66 67 main = do 68 print $ with b1 expr 69 print $ with b2 expr

8 8

This is of course an extremely ugly way to write expressions, but since we're already using Template Haskell we may as well use Template Haskell.

-- Leafify.hs --

1 {-# LANGUAGE EmptyDataDecls #-} 2 {-# LANGUAGE TemplateHaskell #-} 3 {-# LANGUAGE DeriveDataTypeable #-} 4 5 module Leafify where 6 7 import DynBind 8 9 import Language.Haskell.TH 10 import Language.Haskell.TH.Quote 11 import Language.Haskell.Meta.Parse 12 import Data.List.Utils 13 14 var str = VarE (mkName str) 15 vLeaf = var "leaf" 16 vDynVar = var "dynVar" 17 vApply = var "apply" 18 vFlip = var "flip" 19 20 fromRight (Right x) = x 21 22 lf = QuasiQuoter { 23 quoteExp = doLf, 24 quotePat = doLfPat 25 } 26 27 -- Not used, but will warn if we don't provide it. 28 doLf :: String -> Q Exp 29 doLf str = do 30 return $ leafify' $ fromRight $ parseExp str 31 32 doLfPat :: String -> Q Pat 33 doLfPat str = do 34 return $ WildP 35 36 infixl <**> 37 a <**> b = AppE a b 38 39 -- This isn't really the best way to do things; we should really 40 -- do all of this in the Q monad. But this is flatter ;) 41 leafify' :: Exp -> Exp 42 leafify' (VarE v) = 43 let name = nameBase v in 44 if startswith "lab" name 45 then vDynVar <**> (VarE v) 46 else vLeaf <**> (VarE v) 47 leafify' (ConE x) = vLeaf <**> (ConE x) 48 leafify' (LitE x) = vLeaf <**> (LitE x) 49 leafify' (AppE f x) = vApply <**> (leafify' f) <**> (leafify' x) 50 leafify' (InfixE Nothing op Nothing) = 51 vLeaf <**> (InfixE Nothing op Nothing) 52 leafify' (InfixE (Just a) op Nothing) = expr where 53 expr = vApply <**> (vLeaf <**> f) <**> (leafify' a) 54 f = InfixE Nothing op Nothing 55 leafify' (InfixE Nothing op (Just b)) = expr where 56 expr = vApply <**> (vLeaf <**> f) <**> (leafify' b) 57 f = vFlip <**> (InfixE Nothing op Nothing) 58 leafify' (InfixE (Just a) op (Just b)) = expr where 59 expr = vApply <**> expr1 <**> (leafify' b) 60 expr1 = vApply <**> (vLeaf <**> f) <**> (leafify' a) 61 f = InfixE Nothing op Nothing 62 leafify' (LamE ps x) = LamE ps (leafify' x) 63 leafify' (TupE xs) = TupE (fmap leafify' xs) 64 leafify' (CondE x y z) = 65 CondE (leafify' x) (leafify' y) (leafify' z) 66 leafify' (ListE xs) = ListE (fmap leafify' xs) 67 68 -- Not Implemented 69 --leafify' (LetE d x) 70 --leafify' (CaseE x m) 71 --leafify' (DoE sts) 72 --leafify' (CompE sts) 73 --leafify' (ArithSeqE r) 74 --leafify' (SigE x t) 75 --leafify' (RecConE n fes) 76 --leafify' (RecUpdE x fes)

So that we can write

-- dyn-bind5.hs --

1 {-# LANGUAGE TemplateHaskell #-} 2 {-# LANGUAGE QuasiQuotes #-} 3 {-# LANGUAGE EmptyDataDecls #-} 4 {-# LANGUAGE DeriveDataTypeable #-} 5 6 import Leafify 7 import DynBind 8 9 import Data.HList hiding (apply,Apply) 10 import Data.HList.Label4 11 import Data.HList.TypeEqGeneric1 12 import Data.HList.TypeCastGeneric1 13 import Data.HList.MakeLabels 14 15 $(makeLabels ["labX", "labY", "labZ"]) 16 17 expr = [$lf| 18 (labX + labY) * labX - labZ/2 19 |] 20 21 bindings = 22 labX .=. 5 .*. 23 labY .=. 7 .*. 24 labZ .=. 10 .*. 25 emptyRecord 26 27 main = do 28 print $ with bindings expr

55.0

Man that is hacky... but it works.

No comments:

Post a Comment