@@ -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' <- innerLambdas . optIndexers classes <$> valueToCpp (snd abs')
146+ return $ CppNamespace ""
147+ [ CppFunction
148+ (curriedName name)
149+ [arg']
150+ rty
151+ [Inline]
152+ (returnBlock body')
153+ , CppFunction
154+ name
155+ (arg' : args' ++ args'')
156+ rty
157+ (vqs ++ if isAccessor (snd abs') then [Inline] else [])
158+ (returnBlock $
159+ foldl (\fn a -> CppApp fn [a])
160+ body'
161+ (CppVar . fst <$> (args' ++ args'')))
162+ ]
163+ else do
164+ body' <- innerLambdas . optIndexers 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+ (returnBlock body')
180+ , CppFunction
181+ (curriedName name)
182+ [arg']
183+ rty
184+ (if arity' == 1 then [Inline] else [])
185+ (returnBlock $
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' <- innerLambdas . optIndexers 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+ (returnBlock 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 $
@@ -205,7 +226,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
205226 []
206227 (Just $ Any [])
207228 [Inline]
208− (asReturnBlock $
229+ (returnBlock $
209230 CppDataLiteral [CppAccessor (CppVar $ identToCpp ident) (CppVar "data")])
210231
211232 declToCpp _ (_, ident) (Constructor _ _ (ProperName _) fields) =
@@ -215,7 +236,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
215236 (farg <$> fields')
216237 (Just $ Any [])
217238 [Inline]
218− (asReturnBlock $
239+ (returnBlock $
219240 CppDataLiteral $
220241 CppAccessor (CppVar name) (CppVar "data") : (CppVar <$> fields'))
221242 ] ++
@@ -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))
@@ -260,7 +281,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
260281 [(head argNames, Just $ Any [Const, Ref])]
261282 rty
262283 []
263− (asReturnBlock $
284+ (returnBlock $
264285 curriedLambda
265286 (tail argNames)
266287 (CppApp (CppVar name)
@@ -271,7 +292,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
271292 (zip argNames $ repeat aty)
272293 rty
273294 []
274− (asReturnBlock block)
295+ (returnBlock 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+ innerLambdas :: Cpp -> Cpp
316337 -------------------------------------------------------------------------------------------------
317− convertNestedLambdas = everywhereOnCpp go
338+ innerLambdas = everywhereOnCpp go
318339 where
319340 go :: Cpp -> Cpp
320341 go f@(CppFunction {}) = maybeRemCaps $ fnToLambda f
@@ -399,7 +420,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
399420 [CaptureAll]
400421 [(localdict, Just $ Any [Const, Ref])]
401422 (Just $ Any [])
402− (asReturnBlock cpp')
423+ (returnBlock cpp')
403424 topdict :: String
404425 topdict = "_$dict$_"
405426 localdict :: String
@@ -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' = innerLambdas cpp
470491 return $
471492 CppLambda
472493 []
473494 [(identToCpp arg, Just $ Any [Const, Ref])]
474495 (Just $ Any [])
475− (asReturnBlock $ convertDictIndexers cpp')
496+ (returnBlock $ optIndexers 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 = innerLambdas <$> rs
512532 return $ CppApp
513533 (CppLambda [] [] Nothing (CppBlock (cpps ++ [CppReturn ret])))
514534 []
@@ -589,7 +609,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
589609 guardsToCpp (Left gs) = forM gs $ \(cond, val) -> do
590610 cond' <- valueToCpp cond
591611 done <- valueToCpp val
592− return $ CppIfElse cond' (asReturnBlock done) Nothing
612+ return $ CppIfElse cond' (returnBlock done) Nothing
593613 guardsToCpp (Right v) = return . CppReturn <$> valueToCpp v
594614
595615 -- |
@@ -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 -------------------------------------------------------------------------------------------------
@@ -814,7 +842,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
814842 [(head argNames, Just $ Any [Const, Ref])]
815843 (Just $ Any [])
816844 (if arity' == 1 then [Inline] else [])
817− (asReturnBlock $
845+ (returnBlock $
818846 curriedLambda
819847 (tail argNames)
820848 (CppApp (CppVar name)
@@ -828,9 +856,9 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
828856 M.toList $ E.names env
829857
830858---------------------------------------------------------------------------------------------------
831−asReturnBlock :: Cpp -> Cpp
859+returnBlock :: Cpp -> Cpp
832860---------------------------------------------------------------------------------------------------
833−asReturnBlock cpp = CppBlock [CppReturn cpp]
861+returnBlock cpp = CppBlock [CppReturn cpp]
834862
835863---------------------------------------------------------------------------------------------------
836864curriedLambda :: [String] -> Cpp -> Cpp
@@ -839,7 +867,7 @@ curriedLambda args ret = foldr (\arg ret' -> CppLambda
839867 [CaptureAll]
840868 [(arg, Just $ Any [Const, Ref])]
841869 (Just $ Any [])
842− (asReturnBlock ret')
870+ (returnBlock ret')
843871 ) ret args
844872
845873---------------------------------------------------------------------------------------------------
@@ -872,16 +900,19 @@ extractConstraints = go []
872900 go cs _ = cs
873901
874902---------------------------------------------------------------------------------------------------
875−dictIndexerToEnum :: [(Cpp,Cpp)] -> Cpp -> Cpp
903+optIndexers :: [(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+optIndexers 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
@@ -934,10 +965,10 @@ allSymbols cpps = nub $ concatMap (everythingOnCpp (++) symbols) cpps
934965symbolDefs :: [String] -> Cpp
935966---------------------------------------------------------------------------------------------------
936967symbolDefs [] = CppNoOp
937−symbolDefs syms = CppNamespace "PureScript" [CppNamespace "symbol" (asFunc <$> syms)]
968+symbolDefs syms = CppNamespace "PureScript" [CppNamespace "symbol" (asStruct <$> syms)]
938969 where
939− asFunc :: String -> Cpp
940− asFunc s = CppStruct s []
970+ asStruct :: String -> Cpp
971+ asStruct s = CppStruct s []
941972
942973---------------------------------------------------------------------------------------------------
943974filterInlineFuncs :: Cpp -> Cpp