@@ -71,7 +71,14 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
7171 (snd <$> imps)
7272 let cppImports' = "PureScript" : cppImports
7373 cppDecls <- concat <$> mapM (bindToCpp [CppTopLevel]) decls
74− cppDecls' <- traverse optimize cppDecls
74+ let namesmap = M.toList .
75+ M.mapKeysMonotonic (qualifiedToCpp id) . M.map (\(t, _, _) -> arity t) $
76+ E.names env
77+ datamap = M.toList .
78+ M.mapKeysMonotonic (qualifiedToCpp (Ident . runProperName)) .
79+ M.map (\(_, _, _, fields) -> length fields) $
80+ E.dataConstructors env
81+ cppDecls' <- traverse (optimize $ namesmap ++ datamap) cppDecls
7582 foreignWrappers <- curriedForeigns
7683 let optimized = cppDecls' ++ foreignWrappers
7784 let moduleHeader =
@@ -127,7 +134,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
127134 in return $ CppStruct className [CppEnum Nothing Nothing (sort supers ++ members)]
128135
129136 declToCpp vqs (_, ident) (Abs (_, com, ty, _) arg body) = do
130− fn <- if arity' > 1 && CppTopLevel `elem` vqs
137+ fn <- if CppTopLevel `elem` vqs
131138 then do
132139 argNames <- replicateM (arity' - length args' - 1) freshName
133140 let args'' = zip argNames (repeat aty)
@@ -151,7 +158,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
151158 (curriedName name)
152159 [arg']
153160 rty
154− []
161+ (if arity' == 1 then [CppInline] else [])
155162 (asReturnBlock $
156163 curriedLambda
157164 (fst <$> args' ++ args'')
@@ -210,7 +217,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
210217 CppDataLiteral $
211218 CppAccessor (CppVar name) (CppVar "data") : (CppVar <$> fields'))
212219 ] ++
213− if length fields > 1
220+ if length fields > 0
214221 then
215222 [ CppFunction
216223 (curriedName name)
@@ -263,7 +270,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
263270 rty
264271 []
265272 (asReturnBlock block)
266− ] ++ if arity' > 1
273+ ] ++ if arity' > 0
267274 then [fn']
268275 else []
269276 where
@@ -387,17 +394,14 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
387394 -------------------------------------------------------------------------------------------------
388395 valueToCpp :: Expr Ann -> m Cpp
389396 -------------------------------------------------------------------------------------------------
390− valueToCpp (Var (_, _, _, Just (IsConstructor _ [])) ident) =
391− return $ CppApp (varToCpp ident) []
392−
393− valueToCpp (Var (_, _, _, Just (IsConstructor _ [_])) ident) =
397+ valueToCpp (Var (_, _, _, Just IsNewtype) ident) =
394398 return $ varToCpp ident
395399
396− valueToCpp (Var (_, _, _, Just (IsConstructor _ _)) ident) =
397− return . curriedName' $ varToCpp ident
400+ valueToCpp (Var (_, _, _, Just (IsConstructor _ [])) ident) =
401+ return $ CppApp (varToCpp ident) []
398402
399403 valueToCpp (Var (_, _, Just ty, _) ident@(Qualified (Just _) _))
400− | arity ty > 1 =
404+ | arity ty > 0 =
401405 return . curriedName' $ varToCpp ident
402406
403407 valueToCpp (Var _ ident) =
@@ -460,34 +464,16 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
460464 args' <- mapM valueToCpp args
461465 case f of
462466 Var (_, _, _, Just IsNewtype) _ -> return (head args')
463− Var (_, _, _, Just (IsConstructor _ fields)) ident
464− | length args == length fields ->
465− return $ CppApp (uncurried' $ qualifiedToCpp id ident) args'
466467 Var (_, _, _, Just IsTypeClassConstructor) (Qualified mn' (Ident classname)) ->
467468 let Just (_, constraints, fns) = findClass (Qualified mn' (ProperName classname)) in
468469 return . CppObjectLiteral CppInstance $
469470 zip
470471 ((sort $ superClassDictionaryNames constraints) ++ (fst <$> fns))
471472 args'
472− Var ann (Qualified (Just mn') ident)
473− | arity' <- maybe 0 arity ty,
474− arity' > 1 -> do
475− f' <- valueToCpp f
476− let (uncurriedArgs, curriedArgs) =
477− if length args' >= arity'
478− then splitAt arity' args'
479− else ([], args')
480− fn' =
481− if null uncurriedArgs
482− then curriedName' f'
483− else CppApp (uncurried' f') uncurriedArgs
484− return $ foldl (\fn a -> CppApp fn [a]) fn' curriedArgs
485− where
486− ty | (_, _, Just t, _) <- ann = Just t
487− | Just (t, _, _) <- M.lookup (Qualified (Just mn') ident) (E.names env) = Just t
488− | otherwise = Nothing
489− _ ->
490− flip (foldl (\fn a -> CppApp fn [a])) args' <$> valueToCpp f
473+ Var _ (Qualified (Just _) _) -> applied f args' curriedName'
474+ _ -> applied f args' id
475+ where
476+ applied f args g = flip (foldl (\fn a -> CppApp (g fn) [a])) args <$> valueToCpp f
491477
492478 valueToCpp (Case (maybeSpan, _, ty, _) values binders) = do
493479 vals <- mapM valueToCpp values
@@ -792,7 +778,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
792778 where
793779 go (ident, ty)
794780 | arity' <- arity ty,
795− arity' > 1 = do
781+ arity' > 0 = do
796782 let name = identToCpp ident
797783 argNames <- replicateM arity' freshName
798784 return $
@@ -800,7 +786,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do
800786 (curriedName name)
801787 [(head argNames, Just $ CppAny [CppConst, CppRef])]
802788 (Just $ CppAny [])
803− []
789+ (if arity' == 1 then [CppInline] else [])
804790 (asReturnBlock $
805791 curriedLambda
806792 (tail argNames)
@@ -876,13 +862,6 @@ curriedName :: String -> String
876862curriedName name@('$' : _) = name
877863curriedName name = '$' : name
878864
879−---------------------------------------------------------------------------------------------------
880−uncurried' :: Cpp -> Cpp
881−---------------------------------------------------------------------------------------------------
882−uncurried' (CppVar ('$':name)) = CppVar name
883−uncurried' (CppAccessor a b) = CppAccessor (uncurried' a) b
884−uncurried' cpp = cpp
885−
886865---------------------------------------------------------------------------------------------------
887866curriedName' :: Cpp -> Cpp
888867---------------------------------------------------------------------------------------------------