[Haskell-cafe] Return of the revenge of the revisit of the extensible records, reiterated

adam vogt vogt.adam at gmail.com
Wed Nov 27 18:37:11 UTC 2013


On Wed, Nov 27, 2013 at 3:08 AM, Atze van der Ploeg <atzeus at gmail.com> wrote:
> Yes, that is currently the most painful bit of the syntax. It should be
> possible to adopt HList labelable. I would like a small syntactic extension
> that allows 'x for (Label :: Label "x") indeed. I'll probably hack this up
> later.

Did you mean to type 'x as opposed to `x? Using the former is
going to make -XLabelQuotes (or whatever you like to call it)
conflict with -XTemplateHaskell. I suppose you could make a class
to disambiguate:

class LeadingPrime s a where
   fromLeadingPrime :: Either String Language.Haskell.TH.Name
                    -> Label s
                    -> a

-- standard 'name
instance (name ~ Name) => LeadingPrime s name where
   fromLeadingPrime x _ = either error id x

instance (s ~ s', label ~ Label) =>
    LeadingPrime s (label s') where
   fromLeadingPrime _ x = x

-- | this instance might go in HList... still
-- you could get problems if another library,
-- say Vinyl, also wants to do the same thing
-- that doesn't fit in with the current Labelable
instance (Labelable l p f s t a b,
          x ~ (a -> f b),
          y ~ (Record s -> f (Record t))) =>
    LeadingPrime l (p x y) where
   fromLeadingPrime _ x = hLens' x

The compiler would then replace 'x with
fromLeadingPrime (Left "x not in scope") (Label :: Label "x"),
or the Right contains the usual Name.

This might have gone overboard with extensions.  But I'm not sure
you would be able to mix the following:

    $(varE 'x) -- normal template haskell

    \ record -> record ! 'x ! 'y -- 2nd instance

    \ record -> record^.'x.'y    -- Labelable

Another option would be to steal the leading backquote `
for Label only, which adds quite a bit of noise when
you can't accept just a Label:

    \ record -> record^.hLens `x.hLens `y


>> On a somewhat related note, would your strategy of
>> having sorted labels give better compile times for
>> for code which uses records that are a bit larger
>> than a toy example:
>> <http://code.haskell.org/~aavogt/xmonad-hlist/>
>
> Depends, as far as I understand HList record sometimes require searching for
> a permutation of l such that l~l' which seems expensive to me. This is not
> necessary if we keep the row sorted. For projections and decompositions the
> performance is (theoretically) the same: linear searching in a list (sorted
> or unsorted list)  is O(n).

I see. I did a bit of a benchmark on compiling a module that just creates one
record of size N, <http://i.imgur.com/iiZwUgX.png>. It's not exactly O(n^2) as
residuals <http://i.imgur.com/TGeq9Qx.png> show. My guess is the
check for duplicate labels is to blame for this bad performance. A record
of size 100 might be absurd and probably most people have better CPUs
than the Core(TM)2 Duo CPU     T7100  @ 1.80GHz I used, but it's still
an issue. I imagine your ordered labels will fix this slow compile issue,
but I guess somebody actually has to try it out to see.

The full code is something like
<http://code.haskell.org/~aavogt/HList-benchmark/>


Regards,
Adam


More information about the Haskell-Cafe mailing list