@@ -140,46 +140,68 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
140140 then do
141141 argNames <- replicateM (arity' - length args' - 1) freshName
142142 let args'' = zip argNames (repeat aty)
143− block <- asReturnBlock <$> valueToCpp
144− (if null argNames
145− then snd abs'
146− else curriedApp
147− (tail argNames)
148− (App
149− nullAnn
150− (snd abs')
151− (Var nullAnn . Qualified Nothing . Ident $ head argNames)))
152− return $ CppNamespace ""
153− [ CppFunction
154− name
155− (arg' : args' ++ args'')
156− rty
157− (vqs ++ if isAccessor (snd abs') then [Inline] else [])
158− (convertNestedLambdas $ convertDictIndexers block)
159− , CppFunction
160− (curriedName name)
161− [arg']
162− rty
163− (if arity' == 1 then [Inline] else [])
164− (asReturnBlock $
165− curriedLambda
166− (fst <$> args' ++ args'')
167− (CppApp (CppVar name)
168− (CppVar . fst <$> (arg' : args' ++ args''))))
169− ]
143+ if isTypeClassMember
144+ then do -- typeclass member functions are stored curried
145+ body' <- nestedLambdas . optimizeIndexers classes <$> valueToCpp (snd abs')
146+ return $ CppNamespace ""
147+ [ CppFunction
148+ (curriedName name)
149+ [arg']
150+ rty
151+ [Inline]
152+ (asReturnBlock body')
153+ , CppFunction
154+ name
155+ (arg' : args' ++ args'')
156+ rty
157+ (vqs ++ if isAccessor (snd abs') then [Inline] else [])
158+ (asReturnBlock $
159+ foldl (\fn a -> CppApp fn [a])
160+ body'
161+ (CppVar . fst <$> (args' ++ args'')))
162+ ]
163+ else do
164+ body' <- nestedLambdas . optimizeIndexers classes <$> valueToCpp
165+ (if null argNames
166+ then snd abs'
167+ else curriedApp
168+ (tail argNames)
169+ (App
170+ nullAnn
171+ (snd abs')
172+ (Var nullAnn . Qualified Nothing . Ident $ head argNames)))
173+ return $ CppNamespace ""
174+ [ CppFunction
175+ name
176+ (arg' : args' ++ args'')
177+ rty
178+ (vqs ++ if isAccessor (snd abs') then [Inline] else [])
179+ (asReturnBlock body')
180+ , CppFunction
181+ (curriedName name)
182+ [arg']
183+ rty
184+ (if arity' == 1 then [Inline] else [])
185+ (asReturnBlock $
186+ curriedLambda
187+ (fst <$> args' ++ args'')
188+ (CppApp (CppVar name)
189+ (CppVar . fst <$> (arg' : args' ++ args''))))
190+ ]
170191 else do
171− block <- valueToCpp body
192+ body' <- nestedLambdas . optimizeIndexers classes <$> valueToCpp body
172193 return $ CppFunction
173194 name
174195 [arg']
175196 rty
176− (vqs ++ if isIndexer block then [Inline] else [])
177− (convertNestedLambdas . asReturnBlock $ convertDictIndexers block)
197+ (vqs ++ if isIndexer body' then [Inline] else [])
198+ (asReturnBlock body')
178199 return (CppComment com $ convertIfPrimFn ty' fn)
179200 where
180201 ty' | Just t <- ty = Just t
181202 | Just (t, _, _) <- M.lookup (Qualified (Just mn) ident) (E.names env) = Just t
182203 | otherwise = Nothing
204+ isTypeClassMember = ident `elem` typeClassMembers
183205 arity' = maybe 0 arity ty'
184206 name = identToCpp ident
185207 aty = Just $ Any [Const, Ref]
@@ -193,10 +215,9 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
193215 isIndexer :: Cpp -> Bool
194216 isIndexer (CppIndexer (CppSymbol _) (CppVar _)) = True
195217 isIndexer _ = False
196− classes = qualifiedToCpp (Ident . runProperName) . T.constraintClass <$>
197− maybe [] extractConstraints ty'
198− dictClasses = zip (CppVar . fst <$> arg' : args') classes
199− convertDictIndexers = everywhereOnCpp (dictIndexerToEnum dictClasses)
218+ classes = zip (CppVar . fst <$> arg' : args')
219+ (qualifiedToCpp (Ident . runProperName) . T.constraintClass <$> maybe [] extractConstraints ty')
220+
200221
201222 declToCpp _ (_, ident) (Constructor _ _ (ProperName _) []) =
202223 return $
@@ -251,7 +272,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
251272 arity' <- arity ty,
252273 arity' > 0 = do
253274 argNames <- replicateM arity' freshName
254− block <- valueToCpp $
275+ body' <- valueToCpp $
255276 curriedApp
256277 (tail argNames)
257278 (App nullAnn e (Var nullAnn . Qualified Nothing . Ident $ head argNames))
@@ -271,7 +292,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
271292 (zip argNames $ repeat aty)
272293 rty
273294 []
274− (asReturnBlock block)
295+ (asReturnBlock body')
275296 ] ++ if arity' > 0
276297 then [fn']
277298 else []
@@ -312,9 +333,9 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
312333 fnToLambda _ = error "Not a function!"
313334
314335 -------------------------------------------------------------------------------------------------
315− convertNestedLambdas :: Cpp -> Cpp
336+ nestedLambdas :: Cpp -> Cpp
316337 -------------------------------------------------------------------------------------------------
317− convertNestedLambdas = everywhereOnCpp go
338+ nestedLambdas = everywhereOnCpp go
318339 where
319340 go :: Cpp -> Cpp
320341 go f@(CppFunction {}) = maybeRemCaps $ fnToLambda f
@@ -466,20 +487,19 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
466487
467488 valueToCpp (Abs (_, _, ty, _) arg body) = do
468489 cpp <- valueToCpp body
469− let cpp' = convertNestedLambdas cpp
490+ let cpp' = nestedLambdas cpp
470491 return $
471492 CppLambda
472493 []
473494 [(identToCpp arg, Just $ Any [Const, Ref])]
474495 (Just $ Any [])
475− (asReturnBlock $ convertDictIndexers cpp')
496+ (asReturnBlock $ optimizeIndexers classes cpp')
476497 where
477498 arg' = identToCpp arg
478499 args' = identToCpp <$> (fst $ unAbs body [])
479− classes = qualifiedToCpp (Ident . runProperName) . T.constraintClass <$>
480− maybe [] extractConstraints ty
481− dictClasses = zip (CppVar <$> arg' : args') classes
482− convertDictIndexers = everywhereOnCpp (dictIndexerToEnum dictClasses)
500+ classes = zip (CppVar <$> arg' : args')
501+ (qualifiedToCpp (Ident . runProperName) . T.constraintClass <$> maybe [] extractConstraints ty)
502+
483503 valueToCpp e@App{} = do
484504 let (f, args) = unApp e []
485505 args' <- mapM valueToCpp args
@@ -508,7 +528,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
508528 let rs = if hasRecursion ds''
509529 then convertRecursiveFns ds'' ret
510530 else ds''
511− let cpps = convertNestedLambdas <$> rs
531+ let cpps = nestedLambdas <$> rs
512532 return $ CppApp
513533 (CppLambda [] [] Nothing (CppBlock (cpps ++ [CppReturn ret])))
514534 []
@@ -787,6 +807,14 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
787807 (sortBy (compare `on` normalizedName . fst) fns'))
788808 findClass _ = Nothing
789809
810+ -------------------------------------------------------------------------------------------------
811+ typeClassMembers :: [Ident]
812+ -------------------------------------------------------------------------------------------------
813+ typeClassMembers = fst <$> (concat . M.elems $ M.map E.typeClassMembers (M.filterWithKey thisModule (E.typeClasses env)))
814+ where
815+ thisModule (Qualified (Just mn') _) _ = mn' == mn
816+ thisModule _ _ = False
817+
790818 -------------------------------------------------------------------------------------------------
791819 dataCtors :: [Cpp]
792820 -------------------------------------------------------------------------------------------------
@@ -872,16 +900,19 @@ extractConstraints = go []
872900 go cs _ = cs
873901
874902---------------------------------------------------------------------------------------------------
875−dictIndexerToEnum :: [(Cpp,Cpp)] -> Cpp -> Cpp
903+optimizeIndexers :: [(Cpp,Cpp)] -> Cpp -> Cpp
876904---------------------------------------------------------------------------------------------------
877−dictIndexerToEnum repls (CppIndexer (CppSymbol prop) dict)
878− | Just cls <- lookup dict repls =
879− CppBinary Dot
880− (CppIndexer
881− (CppAccessor (CppVar . identToCpp $ Ident prop) cls)
882− (CppCast (mapType 0) dict))
883− (CppVar "second")
884−dictIndexerToEnum _ cpp = cpp
905+optimizeIndexers classes = everywhereOnCpp dictIndexerToEnum
906+ where
907+ dictIndexerToEnum :: Cpp -> Cpp
908+ dictIndexerToEnum (CppIndexer (CppSymbol prop) dict)
909+ | Just cls <- lookup dict classes =
910+ CppBinary Dot
911+ (CppIndexer
912+ (CppAccessor (CppVar . identToCpp $ Ident prop) cls)
913+ (CppCast (mapType 0) dict))
914+ (CppVar "second")
915+ dictIndexerToEnum cpp = cpp
885916
886917---------------------------------------------------------------------------------------------------
887918curriedName :: String -> String