LGTM, this looks like a very nice optimization (even though static binary size isn't the bottleneck)
On Thursday, May 12, 2016 at 10:21:16 AM UTC+1, Brian Foley wrote: > > Instead of generating splices that look like > > ... > mkUsedKeys > (Set.unions > [Set.fromList (map Text.pack ["uuid"]), > Set.fromList (map Text.pack ["ip"]), > Set.fromList (map Text.pack ["netmask"]), > Set.fromList (map Text.pack ["netdev"]), > Set.fromList (map Text.pack ["ip_family"])]) > > Generate > > ... > mkUsedKeys > (Set.fromList > (map Text.pack ["ip", "ip_family", "netdev", "netmask", "uuid"])) > > This occurs once for every object created with $(buildObject ...). > > For a test application that just parses ConfigData, this trims about > 1.5MB off the stripped -O2 optimised binary size (from 37.3MiB to > 35.8MiB). It also shaves a total of ~5MB of temporarily allocated heap > objects for the first parse of these objects. > > More importantly it makes the splices a little more comprehensible. > > Signed-off-by: Brian Foley <[email protected]> > --- > src/Ganeti/THH.hs | 20 ++++++++++---------- > 1 file changed, 10 insertions(+), 10 deletions(-) > > diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs > index 6a3cb8f..4457868 100644 > --- a/src/Ganeti/THH.hs > +++ b/src/Ganeti/THH.hs > @@ -1185,7 +1185,7 @@ defaultFromJSArray keys xs = do > -- See 'defaultToJSArray' and 'defaultFromJSArray'. > genArrayObjectInstance :: Name -> [Field] -> Q Dec > genArrayObjectInstance name fields = do > - let fnames = map T.unpack $ concatMap (liftA2 (:) fieldName > fieldExtraKeys) fields > + let fnames = fieldsKeys fields > instanceD (return []) (appT (conT ''ArrayObject) (conT name)) > [ valD (varP 'toJSArray) (normalB [| defaultToJSArray $(lift fnames) > |]) [] > , valD (varP 'fromJSArray) (normalB [| defaultFromJSArray fnames |]) > [] > @@ -1293,18 +1293,18 @@ loadObjectField allFields field = do > $ $objvar |] > _ -> loadFnOpt field [| maybeFromObj $objvar $objfield |] objvar > > --- | Generates the set of all used JSON dictionary keys for a field > --- This is the equivalent of [| S.fromList (map T.pack 'fnames) |] > -fieldDictKeys :: Field -> Exp > -fieldDictKeys field = AppE (VarE 'S.fromList) > - . AppE (AppE (VarE 'map) (VarE 'T.pack)) > - . ListE . map (LitE . StringL) > - $ map T.unpack $ liftA2 (:) fieldName fieldExtraKeys field > +fieldsKeys :: [Field] -> [String] > +fieldsKeys fields = > + map T.unpack $ concatMap (liftA2 (:) fieldName fieldExtraKeys) fields > > --- | Generates the list of all used JSON dictionary keys for a list of > fields > +-- | Generates the set of all used JSON dictionary keys for a list of > fields > +-- The equivalent of S.fromList (map T.pack ["f1", "f2", "f3"] ) > fieldsDictKeys :: [Field] -> Exp > fieldsDictKeys fields = > - AppE (VarE 'S.unions) . ListE . map fieldDictKeys $ fields > + AppE (VarE 'S.fromList) > + . AppE (AppE (VarE 'map) (VarE 'T.pack)) > + . ListE . map (LitE . StringL) > + $ fieldsKeys fields > > -- | Generates the list of all used JSON dictionary keys for a list of > fields > fieldsDictKeysQ :: [Field] -> Q Exp > -- > 2.8.0.rc3.226.g39d4020 > >
