On Sat, Jan 18, 2014 at 4:25 PM, Carter Schonwald
evan, could you share a minimal example of the code that illustrates your problem? It may be that theres a) an alternative way to write it that that gives the perf characteristics you want b) it could be a good example for future ghc optimization efforts c) other
Sure. As you might guess, there are lots of dependencies, but you don't have to care about them. A Patch has a bunch of fields, but the key part is Score.Attributes, which is a newtype over Set Text. All the attrs_* functions are just the obvious wrappers around set operations. 'strip_attr' tries to remove redundant attributes, but can only do so if that doesn't cause it to collide with an existing attribute set (which means it wasn't redundant after all). You'll notice it's naively implemented, since it does a linear search through all the other attributes. Given 41 instruments, 12 attrs to strip, and a typical instrument having 285 attrs, that winds up being something like 41 * 12 * 285^2, and takes about 0.39 CPU seconds to force with NFData. I appended a less naive version that replaces the linear search with a Set and it's faster (0.19, presumably ^2 becomes (* log 285)), but is uglier. So I did find an alternative way, but it's still fairly expensive, and it would be nice to be able to write the slow but pretty version and pay the cost at compile time. All the attributes data is coming from another module which is basically 1855 lines of CAFs. I could apply the attribute stripping by hand to that, but it would be error-prone and ugly and lots of work... that's the machine's job! patches :: [MidiInst.Patch] patches = [add_code hmap (make_patch inst category) | ((inst, hmap), category) <- instruments] where add_code hmap patch = (patch, code) where code = MidiInst.note_calls (note_calls hmap patch) make_patch :: VslInst.Instrument -> Text -> Instrument.Patch make_patch inst category = instrument_patch category (second strip (make_instrument inst)) where strip = uncurry zip . first strip_attrs . unzip strip_attrs :: [Score.Attributes] -> [Score.Attributes] strip_attrs attrs = foldr strip_attr attrs strip where strip = reverse [ VslInst.sus, VslInst.vib, VslInst.perf, VslInst.fast, VslInst.fa , VslInst.norm, VslInst.na, VslInst.legato, VslInst.v1, VslInst.art , VslInst.med, VslInst.short ] -- | Strip the given attr, but only if it wouldn't cause clashes. strip_attr :: Score.Attributes -> [Score.Attributes] -> [Score.Attributes] strip_attr attr all_attrs = map (strip_redundant attr) all_attrs where strip_redundant attr attrs | stripped `elem` all_attrs = attrs | otherwise = stripped where stripped = Score.attrs_diff attrs attr -- optimized version, applied via mapAccumL to thread the Set through each call: strip_attr :: Score.Attributes -> (Set.Set Score.Attributes, [Score.Attributes]) -> (Set.Set Score.Attributes, [Score.Attributes]) strip_attr attr (all_attrs_set, all_attrs) | any (`Score.attrs_contain` attr) all_attrs = List.mapAccumL strip_redundant all_attrs_set all_attrs | otherwise = (all_attrs_set, all_attrs) where strip_redundant attrs_set attrs | Set.member stripped attrs_set = (attrs_set, attrs) | otherwise = (Set.insert stripped attrs_set, stripped) where stripped = Score.attrs_diff attrs attr