5b4cf0d · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

C++: updates for 0.9 (get Inliner, etc. building)

5b4cf0dAndy Arvanitis10 years ago

src/Language/PureScript/CodeGen/Cpp.hs+6−6

compare with golang

unifiedsplit

@@ -620,7 +620,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

620 SumType ->

621 [ CppIfElse

622 (CppBinary

623− Equal

623+ EqualTo

624 (CppIndexer

625 (CppVar ctorKey)

626 (CppCast dataType $ CppVar varName))

@@ -667,19 +667,19 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

667 -------------------------------------------------------------------------------------------------

668 literalToBinderCpp varName done (NumericLiteral num) =

669 return [ CppIfElse

670− (CppBinary Equal (CppVar varName) (CppNumericLiteral num))

670+ (CppBinary EqualTo (CppVar varName) (CppNumericLiteral num))

671 (CppBlock done)

672 Nothing ]

673

674 literalToBinderCpp varName done (CharLiteral c) =

675 return [ CppIfElse

676− (CppBinary Equal (CppVar varName) (CppCharLiteral c))

676+ (CppBinary EqualTo (CppVar varName) (CppCharLiteral c))

677 (CppBlock done)

678 Nothing ]

679

680 literalToBinderCpp varName done (StringLiteral str) =

681 return [ CppIfElse

682− (CppBinary Equal (CppVar varName) (CppStringLiteral str))

682+ (CppBinary EqualTo (CppVar varName) (CppStringLiteral str))

683 (CppBlock done)

684 Nothing ]

685

@@ -692,7 +692,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

692 literalToBinderCpp varName done (BooleanLiteral False) =

693 return [ CppIfElse

694 (CppUnary

695− CppNot

695+ Not

696 (CppVar varName))

697 (CppBlock done)

698 Nothing ]

@@ -724,7 +724,7 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

724 (CppApp (CppVar "empty") [])

725 n -> let var = CppCast arrayType $ CppVar varName

726 in CppBinary

727− Equal

727+ EqualTo

728 (CppBinary Dot var (CppApp (CppVar "size") []))

729 (CppNumericLiteral (Left (fromIntegral n)))

730 return [ CppIfElse cond (CppBlock cpp) Nothing ]

src/Language/PureScript/CodeGen/Cpp/AST.hs+13−13

@@ -32,33 +32,33 @@ import Language.PureScript.Traversals

32-- |

33-- Built-in unary operators

34--

35−data CppUnaryOp

35+data UnaryOperator

36 -- |

37 -- Numeric negation

38 --

39− = CppNegate

39+ = Negate

40 -- |

41 -- Boolean negation

42 --

43− | CppNot

43+ | Not

44 -- |

45 -- Bitwise negation

46 --

47− | CppBitwiseNot

47+ | BitwiseNot

48 -- |

49 -- Numeric unary \'plus\'

50 --

51− | CppPositive

51+ | Positive

52 -- |

53 -- Constructor

54 --

55− | CppNew

55+ | New

56 deriving (Show, Read, Eq)

58-- |

59-- Built-in binary operators

60--

61−data BinaryOp

61+data BinaryOperator

62 -- |

63 -- Numeric addition

64 --

@@ -86,11 +86,11 @@ data BinaryOp

86 -- |

87 -- Generic equality test

88 --

89− | Equal

89+ | EqualTo

90 -- |

91 -- Generic inequality test

92 --

93− | NotEqual

93+ | NotEqualTo

94 -- |

95 -- Numeric less-than

96 --

@@ -98,7 +98,7 @@ data BinaryOp

98 -- |

99 -- Numeric less-than-or-equal

100 --

101− | LessThanOrEqual

101+ | LessThanOrEqualTo

102 -- |

103 -- Numeric greater-than

104 --

@@ -106,7 +106,7 @@ data BinaryOp

106 -- |

107 -- Numeric greater-than-or-equal

108 --

109− | GreaterThanOrEqual

109+ | GreaterThanOrEqualTo

110 -- |

111 -- Boolean and

112 --

@@ -161,11 +161,11 @@ data Cpp

161 -- |

162 -- A unary operator application

163 --

164− | CppUnary CppUnaryOp Cpp

164+ | CppUnary UnaryOperator Cpp

165 -- |

166 -- A binary operator application

167 --

168− | CppBinary BinaryOp Cpp Cpp

168+ | CppBinary BinaryOperator Cpp Cpp

169 -- |

170 -- An array literal

171 --

src/Language/PureScript/CodeGen/Cpp/Optimizer.hs+1−1

@@ -81,7 +81,7 @@ optimize' cpp = do

81 , etaConvert

82 , evaluateIifes

83 , inlineVariables

84− , inlineValues

84+ , inlineCommonValues

85 , inlineOperator (C.prelude, (C.$)) $ \f x -> CppApp f [x]

86 , inlineOperator (C.prelude, (C.#)) $ \x f -> CppApp f [x]

87 , inlineOperator (C.dataArrayUnsafe, C.unsafeIndex) $ flip CppIndexer

src/Language/PureScript/CodeGen/Cpp/Optimizer/Blocks.hs+8−8

@@ -51,29 +51,29 @@ collapseIfElses = everywhereOnCpp collapse

51 collapse :: Cpp -> Cpp

52 collapse (CppBlock cpps) = CppBlock (go cpps)

53 where

54− go (st'@(CppIfElse (CppBinary Equal lhs _) _ Nothing) : sts') =

54+ go (st'@(CppIfElse (CppBinary EqualTo lhs _) _ Nothing) : sts') =

55 if length (fst cpps') > 1

56 then CppSwitch lhs (mkCases <$> fst cpps') : snd cpps'

57 else st' : sts'

58 where

59 cpps' = span (isIntEq lhs) (st' : sts')

60 isIntEq :: Cpp -> Cpp -> Bool

61− isIntEq a (CppIfElse (CppBinary Equal a' (CppNumericLiteral (Left _))) (CppBlock [CppReturn _]) Nothing)

61+ isIntEq a (CppIfElse (CppBinary EqualTo a' (CppNumericLiteral (Left _))) (CppBlock [CppReturn _]) Nothing)

62 | a == a' = True

63− isIntEq a (CppIfElse (CppBinary Equal a' (CppCharLiteral _)) (CppBlock [CppReturn _]) Nothing)

63+ isIntEq a (CppIfElse (CppBinary EqualTo a' (CppCharLiteral _)) (CppBlock [CppReturn _]) Nothing)

64 | a == a' = True

65− isIntEq a (CppIfElse (CppBinary Equal a' (CppBooleanLiteral _)) (CppBlock [CppReturn _]) Nothing)

65+ isIntEq a (CppIfElse (CppBinary EqualTo a' (CppBooleanLiteral _)) (CppBlock [CppReturn _]) Nothing)

66 | a == a' = True

67 isIntEq _ _ = False

68 mkCases :: Cpp -> (Cpp, Cpp)

69− mkCases (CppIfElse (CppBinary Equal _ b') (CppBlock [body]) Nothing) = (b', body)

69+ mkCases (CppIfElse (CppBinary EqualTo _ b') (CppBlock [body]) Nothing) = (b', body)

70− mkCases (CppIfElse (CppUnary CppNot _) (CppBlock [body]) Nothing) = (CppBooleanLiteral False, body)

70+ mkCases (CppIfElse (CppUnary Not _) (CppBlock [body]) Nothing) = (CppBooleanLiteral False, body)

71 mkCases (CppIfElse _ (CppBlock [body]) Nothing) = (CppBooleanLiteral True, body)

72 mkCases _ = error ""

73 go ((CppIfElse cond1 body1 Nothing) : (CppIfElse cond2 body2 Nothing) : _)

74 | returns body1 && returns body2 &&

75− (CppUnary CppNot cond1 == cond2 ||

75+ (CppUnary Not cond1 == cond2 ||

76− CppUnary CppNot cond2 == cond1) = [CppIfElse cond1 body1 (Just body2)]

76+ CppUnary Not cond2 == cond1) = [CppIfElse cond1 body1 (Just body2)]

77 where

78 returns :: Cpp -> Bool

79 returns (CppBlock rets@(_:_)) | CppReturn{} <- last rets = True

src/Language/PureScript/CodeGen/Cpp/Optimizer/Inliner.hs+193−150

@@ -12,30 +12,25 @@

12-- This module provides basic inlining capabilities

13--

14-----------------------------------------------------------------------------

15−

16−{-# LANGUAGE CPP #-}

17−

18−module Language.PureScript.CodeGen.Cpp.Optimizer.Inliner (

15+module Language.PureScript.CodeGen.Cpp.Optimizer.Inliner

19− inlineVariables,

16+ ( inlineVariables

20− inlineValues,

17+ , inlineCommonValues

21− inlineOperator,

18+ , inlineOperator

22− inlineCommonOperators,

19+ , inlineCommonOperators

23− inlineFnComposition,

20+ , inlineFnComposition

24− etaConvert,

21+ , etaConvert

25− unThunk,

22+ , unThunk

26− evaluateIifes

23+ , evaluateIifes

27−) where

24+ ) where

29import Prelude.Compat

26import Prelude.Compat

31−#if __GLASGOW_HASKELL__ < 710

32−import Control.Applicative (Applicative)

33−#endif

34import Control.Monad.Supply.Class (MonadSupply, freshName)

28import Control.Monad.Supply.Class (MonadSupply, freshName)

35−import Language.PureScript.CodeGen.Cpp.Types

29+

36import Language.PureScript.CodeGen.Cpp.AST

30import Language.PureScript.CodeGen.Cpp.AST

37import Language.PureScript.CodeGen.Cpp.Common

31import Language.PureScript.CodeGen.Cpp.Common

38import Language.PureScript.CodeGen.Cpp.Optimizer.Common

32import Language.PureScript.CodeGen.Cpp.Optimizer.Common

33+import Language.PureScript.CodeGen.Cpp.Types

39import Language.PureScript.Names

34import Language.PureScript.Names

40import qualified Language.PureScript.Constants as C

35import qualified Language.PureScript.Constants as C

@@ -101,36 +96,30 @@ inlineVariables = everywhereOnCpp $ removeFromBlock go

101 go (map (replaceIdent var cpp) sts)

96 go (map (replaceIdent var cpp) sts)

102 go (s:sts) = s : go sts

97 go (s:sts) = s : go sts

103

104−inlineValues :: Cpp -> Cpp

99+inlineCommonValues :: Cpp -> Cpp

105−inlineValues = everywhereOnCpp convert

100+inlineCommonValues = everywhereOnCpp convert

106 where

101 where

107 convert :: Cpp -> Cpp

102 convert :: Cpp -> Cpp

108− convert (CppApp fn [dict]) | isDict semiringNumber dict && isFn fnZero fn = CppNumericLiteral (Left 0)

103+ convert (CppApp fn [dict])

109− | isDict semiringNumber dict && isFn fnOne fn = CppNumericLiteral (Left 1)

110− | isDict semiringInt dict && isFn fnZero fn = CppNumericLiteral (Left 0)

104+ | isDict' [semiringNumber, semiringInt] dict && isFn fnZero fn = CppNumericLiteral (Left 0)

111− | isDict semiringInt dict && isFn fnOne fn = CppNumericLiteral (Left 1)

105+ | isDict' [semiringNumber, semiringInt] dict && isFn fnOne fn = CppNumericLiteral (Left 1)

112− | isDict boundedBoolean dict && isFn fnBottom fn = CppBooleanLiteral False

106+ | isDict boundedBoolean dict && isFn fnBottom fn = CppBooleanLiteral False

113− | isDict boundedBoolean dict && isFn fnTop fn = CppBooleanLiteral True

107+ | isDict boundedBoolean dict && isFn fnTop fn = CppBooleanLiteral True

114− convert (CppApp fn [dict, x, y])

115− | isDict semiringInt dict && isFn fnAdd fn = CppBinary Add x y

116− | isDict semiringInt dict && isFn fnMultiply fn = CppBinary Multiply x y

117− | isDict moduloSemiringInt dict && isFn fnDivide fn = CppBinary Divide x y

118− | isDict ringInt dict && isFn fnSubtract fn = CppBinary Subtract x y

119 convert (CppApp (CppApp (CppApp fn [dict]) [x]) [y])

108 convert (CppApp (CppApp (CppApp fn [dict]) [x]) [y])

120− | isDict semiringInt dict && isFn fnAdd fn = CppBinary Add x y

109+ | isDict semiringInt dict && isFn fnAdd fn = intOp Add x y

121− | isDict semiringInt dict && isFn fnMultiply fn = CppBinary Multiply x y

110+ | isDict semiringInt dict && isFn fnMultiply fn = intOp Multiply x y

122− | isDict moduloSemiringInt dict && isFn fnDivide fn = CppBinary Divide x y

111+ | isDict euclideanRingInt dict && isFn fnDivide fn = intOp Divide x y

123− | isDict ringInt dict && isFn fnSubtract fn = CppBinary Subtract x y

112+ | isDict ringInt dict && isFn fnSubtract fn = intOp Subtract x y

124−

125 convert other = other

113 convert other = other

126− fnZero = (C.prelude, C.zero)

114+ fnZero = (C.dataSemiring, C.zero)

127− fnOne = (C.prelude, C.one)

115+ fnOne = (C.dataSemiring, C.one)

128− fnBottom = (C.prelude, C.bottom)

116+ fnBottom = (C.dataBounded, C.bottom)

129− fnTop = (C.prelude, C.top)

117+ fnTop = (C.dataBounded, C.top)

130− fnAdd = (C.prelude, (C.+))

118+ fnAdd = (C.dataSemiring, C.add)

131− fnDivide = (C.prelude, (C./))

119+ fnDivide = (C.dataEuclideanRing, C.div)

132− fnMultiply = (C.prelude, (C.*))

120+ fnMultiply = (C.dataSemiring, C.mul)

133− fnSubtract = (C.prelude, (C.-))

121+ fnSubtract = (C.dataRing, C.sub)

122+ intOp op x y = CppBinary BitwiseOr (CppBinary op x y) (CppNumericLiteral (Left 0))

134

123

135inlineOperator :: (String, String) -> (Cpp -> Cpp -> Cpp) -> Cpp -> Cpp

124inlineOperator :: (String, String) -> (Cpp -> Cpp -> Cpp) -> Cpp -> Cpp

136inlineOperator (m, op) f = everywhereOnCpp convert

125inlineOperator (m, op) f = everywhereOnCpp convert

@@ -139,49 +128,60 @@ inlineOperator (m, op) f = everywhereOnCpp convert

139 convert (CppApp op' [x, y]) | isOp op' = f x y

128 convert (CppApp op' [x, y]) | isOp op' = f x y

140 convert (CppApp (CppApp op' [x]) [y]) | isOp op' = f x y

129 convert (CppApp (CppApp op' [x]) [y]) | isOp op' = f x y

141 convert other = other

130 convert other = other

142− isOp (CppAccessor (CppVar longForm) (CppVar m')) = m == m' && longForm == identToCpp (Op op)

131+ isOp (CppAccessor (CppVar longForm) (CppVar m')) = m == m' && longForm == identToCpp (Ident op)

143 isOp (CppIndexer (CppStringLiteral op') (CppVar m')) = m == m' && op == op'

132 isOp (CppIndexer (CppStringLiteral op') (CppVar m')) = m == m' && op == op'

144 isOp _ = False

133 isOp _ = False

145

134

146inlineCommonOperators :: Cpp -> Cpp

135inlineCommonOperators :: Cpp -> Cpp

147inlineCommonOperators = applyAll $

136inlineCommonOperators = applyAll $

148− [ binary semiringNumber (C.+) Add

137+ [ binary semiringNumber opAdd Add

149− , binary semiringNumber (C.*) Multiply

138+ , binary semiringNumber opMul Multiply

150−

139+

151− , binary ringNumber (C.-) Subtract

140+ , binary ringNumber opSub Subtract

152− , unary ringNumber C.negate CppNegate

141+ , unary ringNumber opNegate Negate

153− , binary ringInt (C.-) Subtract

142+ , binary ringInt opSub Subtract

154− , unary ringInt C.negate CppNegate

143+ , unary ringInt opNegate Negate

155−

144+

156− , binary moduloSemiringNumber (C./) Divide

145+ , binary euclideanRingNumber opDiv Divide

157− , binary moduloSemiringInt C.mod Modulus

146+ , binary euclideanRingInt opMod Modulus

158−

147+

159− , binary eqNumber (C.==) Equal

148+ , binary eqNumber opEq EqualTo

160− , binary eqNumber (C./=) NotEqual

149+ , binary eqNumber opNotEq NotEqualTo

161− , binary eqInt (C.==) Equal

150+ , binary eqInt opEq EqualTo

162− , binary eqInt (C./=) NotEqual

151+ , binary eqInt opNotEq NotEqualTo

163− , binary eqString (C.==) Equal

152+ , binary eqString opEq EqualTo

164− , binary eqString (C./=) NotEqual

153+ , binary eqString opNotEq NotEqualTo

154+ , binary eqChar opEq EqualTo

155+ , binary eqChar opNotEq NotEqualTo

165− , binary eqBoolean (C.==) Equal

156+ , binary eqBoolean opEq EqualTo

166− , binary eqBoolean (C./=) NotEqual

157+ , binary eqBoolean opNotEq NotEqualTo

167−

158+

168− , binary ordNumber (C.<) LessThan

159+ , binary ordBoolean opLessThan LessThan

169− , binary ordNumber (C.>) GreaterThan

160+ , binary ordBoolean opLessThanOrEq LessThanOrEqualTo

170− , binary ordNumber (C.<=) LessThanOrEqual

161+ , binary ordBoolean opGreaterThan GreaterThan

171− , binary ordNumber (C.>=) GreaterThanOrEqual

162+ , binary ordBoolean opGreaterThanOrEq GreaterThanOrEqualTo

163+ , binary ordChar opLessThan LessThan

164+ , binary ordChar opLessThanOrEq LessThanOrEqualTo

165+ , binary ordChar opGreaterThan GreaterThan

166+ , binary ordChar opGreaterThanOrEq GreaterThanOrEqualTo

172− , binary ordInt (C.<) LessThan

167+ , binary ordInt opLessThan LessThan

173− , binary ordInt (C.>) GreaterThan

168+ , binary ordInt opLessThanOrEq LessThanOrEqualTo

174− , binary ordInt (C.<=) LessThanOrEqual

169+ , binary ordInt opGreaterThan GreaterThan

175− , binary ordInt (C.>=) GreaterThanOrEqual

170+ , binary ordInt opGreaterThanOrEq GreaterThanOrEqualTo

176−

171+ , binary ordNumber opLessThan LessThan

177− , binary semigroupString (C.<>) Add

172+ , binary ordNumber opLessThanOrEq LessThanOrEqualTo

178− , binary semigroupString (C.++) Add

173+ , binary ordNumber opGreaterThan GreaterThan

179−

174+ , binary ordNumber opGreaterThanOrEq GreaterThanOrEqualTo

180− , binary booleanAlgebraBoolean (C.&&) And

175+ , binary ordString opLessThan LessThan

181− , binary booleanAlgebraBoolean (C.||) Or

176+ , binary ordString opLessThanOrEq LessThanOrEqualTo

182− , binaryFunction booleanAlgebraBoolean C.conj And

177+ , binary ordString opGreaterThan GreaterThan

183− , binaryFunction booleanAlgebraBoolean C.disj Or

178+ , binary ordString opGreaterThanOrEq GreaterThanOrEqualTo

184− , unary booleanAlgebraBoolean C.not CppNot

179+

180+ , binary semigroupString opAppend Add

181+

182+ , binary heytingAlgebraBoolean opConj And

183+ , binary heytingAlgebraBoolean opDisj Or

184+ , unary heytingAlgebraBoolean opNot Not

185

186 , binary' C.dataIntBits (C..|.) BitwiseOr

187 , binary' C.dataIntBits (C..&.) BitwiseAnd

@@ -189,43 +189,30 @@ inlineCommonOperators = applyAll $

189 , binary' C.dataIntBits C.shl ShiftLeft

190 , binary' C.dataIntBits C.shr ShiftRight

191 -- , binary' C.dataIntBits C.zshr ZeroFillShiftRight

192− , unary' C.dataIntBits C.complement CppBitwiseNot

192+ , unary' C.dataIntBits C.complement BitwiseNot

193− ] -- ++ -- DISABLE mkFn/runFn inlining

193+ ] ++

194+ []

194 -- [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]

195 -- [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]

195 where

196 where

196− binary :: (String, String) -> String -> BinaryOp -> Cpp -> Cpp

197+ binary :: (String, String) -> (String, String) -> BinaryOperator -> Cpp -> Cpp

197− binary dict opString op = everywhereOnCpp convert

198+ binary dict fns op = everywhereOnCpp convert

198 where

199 where

199 convert :: Cpp -> Cpp

200 convert :: Cpp -> Cpp

200− convert (CppApp fn [dict', CppStringLiteral x, CppStringLiteral y])

201− | isDict dict dict' && isPreludeFn opString fn = CppStringLiteral (x ++ y)

202− convert (CppApp fn [dict', x, y]) | isDict dict dict' && isPreludeFn opString fn = CppBinary op x y

203− convert (CppApp (CppApp (CppApp fn [dict']) [CppStringLiteral x]) [CppStringLiteral y])

204− | isDict dict dict' && isPreludeFn opString fn = CppStringLiteral (x ++ y)

205− convert (CppApp (CppApp (CppApp fn [dict']) [x]) [y]) | isDict dict dict' && isPreludeFn opString fn = CppBinary op x y

201+ convert (CppApp (CppApp (CppApp fn [dict']) [x]) [y]) | isDict dict dict' && isFn fns fn = CppBinary op x y

206 convert other = other

202 convert other = other

207− binary' :: String -> String -> BinaryOp -> Cpp -> Cpp

203+ binary' :: String -> String -> BinaryOperator -> Cpp -> Cpp

208 binary' moduleName opString op = everywhereOnCpp convert

204 binary' moduleName opString op = everywhereOnCpp convert

209 where

205 where

210 convert :: Cpp -> Cpp

206 convert :: Cpp -> Cpp

211− convert (CppApp fn [x, y]) | isFn (moduleName, opString) fn = CppBinary op x y

212 convert (CppApp (CppApp fn [x]) [y]) | isFn (moduleName, opString) fn = CppBinary op x y

207 convert (CppApp (CppApp fn [x]) [y]) | isFn (moduleName, opString) fn = CppBinary op x y

213 convert other = other

208 convert other = other

214− binaryFunction :: (String, String) -> String -> BinaryOp -> Cpp -> Cpp

215− binaryFunction dict fnName op = everywhereOnCpp convert

216− where

217− convert :: Cpp -> Cpp

218− convert (CppApp fn [dict', x, y]) | isPreludeFn fnName fn && isDict dict dict' = CppBinary op x y

219− convert (CppApp (CppApp (CppApp fn [dict']) [x]) [y]) | isPreludeFn fnName fn && isDict dict dict' = CppBinary op x y

220− convert other = other

221− unary :: (String, String) -> String -> CppUnaryOp -> Cpp -> Cpp

209+ unary :: (String, String) -> (String, String) -> UnaryOperator -> Cpp -> Cpp

222− unary dict fnName op = everywhereOnCpp convert

210+ unary dicts fns op = everywhereOnCpp convert

223 where

211 where

224 convert :: Cpp -> Cpp

212 convert :: Cpp -> Cpp

225− convert (CppApp fn [dict', x]) | isPreludeFn fnName fn && isDict dict dict' = CppUnary op x

213+ convert (CppApp (CppApp fn [dict']) [x]) | isDict dicts dict' && isFn fns fn = CppUnary op x

226− convert (CppApp (CppApp fn [dict']) [x]) | isPreludeFn fnName fn && isDict dict dict' = CppUnary op x

227 convert other = other

214 convert other = other

228− unary' :: String -> String -> CppUnaryOp -> Cpp -> Cpp

215+ unary' :: String -> String -> UnaryOperator -> Cpp -> Cpp

229 unary' moduleName fnName op = everywhereOnCpp convert

216 unary' moduleName fnName op = everywhereOnCpp convert

230 where

217 where

231 convert :: Cpp -> Cpp

218 convert :: Cpp -> Cpp

@@ -235,8 +222,8 @@ inlineCommonOperators = applyAll $

235 -- mkFn 0 = everywhereOnCpp convert

222 -- mkFn 0 = everywhereOnCpp convert

236 -- where

223 -- where

237 -- convert :: Cpp -> Cpp

224 -- convert :: Cpp -> Cpp

238− -- convert (CppApp mkFnN [CppLambda caps [_] _ (CppBlock cpp)]) | isNFn C.mkFn 0 mkFnN =

225+ -- convert (CppApp mkFnN [CppLambda _ [_] _ (CppBlock cpp)]) | isNFn C.mkFn 0 mkFnN =

239− -- CppLambda caps [] Nothing (CppBlock cpp)

226+ -- CppLambda [CppCaptureAll] [] Nothing (CppBlock cpp)

240 -- convert other = other

227 -- convert other = other

241 -- mkFn n = everywhereOnCpp convert

228 -- mkFn n = everywhereOnCpp convert

242 -- where

229 -- where

@@ -246,14 +233,14 @@ inlineCommonOperators = applyAll $

246 -- Just (args, cpp) -> CppLambda [CppCaptureAll] args Nothing (CppBlock cpp)

233 -- Just (args, cpp) -> CppLambda [CppCaptureAll] args Nothing (CppBlock cpp)

247 -- Nothing -> orig

234 -- Nothing -> orig

248 -- convert other = other

235 -- convert other = other

249− -- collectArgs :: Int -> [(String, Maybe CppType)] -> Cpp -> Maybe ([(String, Maybe CppType)], [Cpp])

236+ -- collectArgs :: Int -> [String] -> Cpp -> Maybe ([String], [Cpp])

250 -- collectArgs 1 acc (CppLambda _ [oneArg] _ (CppBlock cpp)) | length acc == n - 1 = Just (reverse (oneArg : acc), cpp)

237 -- collectArgs 1 acc (CppLambda _ [oneArg] _ (CppBlock cpp)) | length acc == n - 1 = Just (reverse (oneArg : acc), cpp)

251 -- collectArgs m acc (CppLambda _ [oneArg] _ (CppBlock [CppReturn ret])) = collectArgs (m - 1) (oneArg : acc) ret

238 -- collectArgs m acc (CppLambda _ [oneArg] _ (CppBlock [CppReturn ret])) = collectArgs (m - 1) (oneArg : acc) ret

252 -- collectArgs _ _ _ = Nothing

239 -- collectArgs _ _ _ = Nothing

253 --

240 --

254 -- isNFn :: String -> Int -> Cpp -> Bool

241 -- isNFn :: String -> Int -> Cpp -> Bool

255 -- isNFn prefix n (CppVar name) = name == (prefix ++ show n)

242 -- isNFn prefix n (CppVar name) = name == (prefix ++ show n)

256− -- isNFn prefix n (CppAccessor (CppVar name) (CppVar dataFunction)) | dataFunction == C.dataFunction = name == (prefix ++ show n)

243+ -- isNFn prefix n (CppAccessor _ name (CppVar dataFunction)) | dataFunction == C.dataFunction = name == (prefix ++ show n)

257 -- isNFn _ _ _ = False

244 -- isNFn _ _ _ = False

258 --

245 --

259 -- runFn :: Int -> Cpp -> Cpp

246 -- runFn :: Int -> Cpp -> Cpp

@@ -269,78 +256,134 @@ inlineCommonOperators = applyAll $

269

256

270-- (f <<< g $ x) = f (g x)

257-- (f <<< g $ x) = f (g x)

271-- (f <<< g) = \x -> f (g x)

258-- (f <<< g) = \x -> f (g x)

272−inlineFnComposition :: (Applicative m, MonadSupply m) => Cpp -> m Cpp

259+inlineFnComposition :: (MonadSupply m) => Cpp -> m Cpp

273inlineFnComposition = everywhereOnCppTopDownM convert

260inlineFnComposition = everywhereOnCppTopDownM convert

274 where

261 where

275 convert :: (MonadSupply m) => Cpp -> m Cpp

262 convert :: (MonadSupply m) => Cpp -> m Cpp

276− convert (CppApp fn [dict', x, y]) | isFnCompose dict' fn = do

263+ convert (CppApp (CppApp (CppApp (CppApp fn [dict']) [x]) [y]) [z])

277− arg <- freshName

264+ | isFnCompose dict' fn = return $ CppApp x [CppApp y [z]]

278− return $ CppLambda [CppCaptureAll] [(arg, Just (CppAny [CppConst, CppRef]))] (Just $ CppAny []) (CppBlock [CppReturn $ CppApp x [CppApp y [CppVar arg]]])

265+ | isFnComposeFlipped dict' fn = return $ CppApp y [CppApp x [z]]

279− convert (CppApp (CppApp (CppApp (CppApp fn [dict']) [x]) [y]) [z]) | isFnCompose dict' fn =

266+ convert (CppApp (CppApp (CppApp fn [dict']) [x]) [y])

280− return $ CppApp x [CppApp y [z]]

267+ | isFnCompose dict' fn = do

281− convert (CppApp (CppApp (CppApp fn [dict']) [x]) [y]) | isFnCompose dict' fn = do

268+ arg <- freshName

269+ return $ CppLambda [CppCaptureAll] [(arg, constAnyRef)] Nothing (CppBlock [CppReturn $ CppApp x [CppApp y [CppVar arg]]])

270+ | isFnComposeFlipped dict' fn = do

282− arg <- freshName

271+ arg <- freshName

283− return $ CppLambda [CppCaptureAll] [(arg, Just (CppAny [CppConst, CppRef]))] (Just $ CppAny []) (CppBlock [CppReturn $ CppApp x [CppApp y [CppVar arg]]])

272+ return $ CppLambda [CppCaptureAll] [(arg, constAnyRef)] Nothing (CppBlock [CppReturn $ CppApp y [CppApp x [CppVar arg]]])

284 convert other = return other

273 convert other = return other

285 isFnCompose :: Cpp -> Cpp -> Bool

274 isFnCompose :: Cpp -> Cpp -> Bool

286− isFnCompose dict' fn = isDict semigroupoidFn dict' && (isPreludeFn (C.<<<) fn || isPreludeFn (C.compose) fn)

275+ isFnCompose dict' fn = isDict semigroupoidFn dict' && isFn fnCompose fn

287−

276+ isFnComposeFlipped :: Cpp -> Cpp -> Bool

277+ isFnComposeFlipped dict' fn = isDict semigroupoidFn dict' && isFn fnComposeFlipped fn

278+ fnCompose :: (String, String)

279+ fnCompose = (C.controlSemigroupoid, C.compose)

288−isDict :: (String, String) -> Cpp -> Bool

280+ fnComposeFlipped :: (String, String)

289−isDict (moduleName, dictName) (CppAccessor (CppVar x) (CppVar y)) = x == dictName && y == moduleName

281+ fnComposeFlipped = (C.controlSemigroupoid, C.composeFlipped)

290−isDict _ _ = False

291−

292−isFn :: (String, String) -> Cpp -> Bool

293−isFn (moduleName, fnName) (CppAccessor (CppVar x) (CppVar y)) = x == (identToCpp (Ident fnName)) && y == moduleName

294−isFn (moduleName, fnName) (CppIndexer (CppStringLiteral x) (CppVar y)) = x == fnName && y == moduleName

295−isFn _ _ = False

296−

297−isPreludeFn :: String -> Cpp -> Bool

298−isPreludeFn fnName = isFn (C.prelude, fnName)

299

282

300semiringNumber :: (String, String)

283semiringNumber :: (String, String)

301−semiringNumber = (C.prelude, C.semiringNumber)

284+semiringNumber = (C.dataSemiring, C.semiringNumber)

302

285

303semiringInt :: (String, String)

286semiringInt :: (String, String)

304−semiringInt = (C.prelude, C.semiringInt)

287+semiringInt = (C.dataSemiring, C.semiringInt)

305

288

306ringNumber :: (String, String)

289ringNumber :: (String, String)

307−ringNumber = (C.prelude, C.ringNumber)

290+ringNumber = (C.dataRing, C.ringNumber)

308

291

309ringInt :: (String, String)

292ringInt :: (String, String)

310−ringInt = (C.prelude, C.ringInt)

293+ringInt = (C.dataRing, C.ringInt)

311

294

312−moduloSemiringNumber :: (String, String)

295+euclideanRingNumber :: (String, String)

313−moduloSemiringNumber = (C.prelude, C.moduloSemiringNumber)

296+euclideanRingNumber = (C.dataEuclideanRing, C.euclideanRingNumber)

314

297

315−moduloSemiringInt :: (String, String)

298+euclideanRingInt :: (String, String)

316−moduloSemiringInt = (C.prelude, C.moduloSemiringInt)

299+euclideanRingInt = (C.dataEuclideanRing, C.euclideanRingInt)

317

300

318eqNumber :: (String, String)

301eqNumber :: (String, String)

319−eqNumber = (C.prelude, C.eqNumber)

302+eqNumber = (C.dataEq, C.eqNumber)

320

303

321eqInt :: (String, String)

304eqInt :: (String, String)

322−eqInt = (C.prelude, C.eqInt)

305+eqInt = (C.dataEq, C.eqInt)

323

306

324eqString :: (String, String)

307eqString :: (String, String)

325−eqString = (C.prelude, C.eqNumber)

308+eqString = (C.dataEq, C.eqString)

309+

310+eqChar :: (String, String)

311+eqChar = (C.dataEq, C.eqChar)

326

312

327eqBoolean :: (String, String)

313eqBoolean :: (String, String)

328−eqBoolean = (C.prelude, C.eqNumber)

314+eqBoolean = (C.dataEq, C.eqBoolean)

315+

316+ordBoolean :: (String, String)

317+ordBoolean = (C.dataOrd, C.ordBoolean)

329

318

330ordNumber :: (String, String)

319ordNumber :: (String, String)

331−ordNumber = (C.prelude, C.ordNumber)

320+ordNumber = (C.dataOrd, C.ordNumber)

332

321

333ordInt :: (String, String)

322ordInt :: (String, String)

334−ordInt = (C.prelude, C.ordInt)

323+ordInt = (C.dataOrd, C.ordInt)

324+

325+ordString :: (String, String)

326+ordString = (C.dataOrd, C.ordString)

327+

328+ordChar :: (String, String)

329+ordChar = (C.dataOrd, C.ordChar)

335

330

336semigroupString :: (String, String)

331semigroupString :: (String, String)

337−semigroupString = (C.prelude, C.semigroupString)

332+semigroupString = (C.dataSemigroup, C.semigroupString)

338

333

339boundedBoolean :: (String, String)

334boundedBoolean :: (String, String)

340−boundedBoolean = (C.prelude, C.boundedBoolean)

335+boundedBoolean = (C.dataBounded, C.boundedBoolean)

341

336

342−booleanAlgebraBoolean :: (String, String)

337+heytingAlgebraBoolean :: (String, String)

343−booleanAlgebraBoolean = (C.prelude, C.booleanAlgebraBoolean)

338+heytingAlgebraBoolean = (C.dataHeytingAlgebra, C.heytingAlgebraBoolean)

344

339

345semigroupoidFn :: (String, String)

340semigroupoidFn :: (String, String)

346−semigroupoidFn = (C.prelude, C.semigroupoidFn)

341+semigroupoidFn = (C.controlSemigroupoid, C.semigroupoidFn)

342+

343+opAdd :: (String, String)

344+opAdd = (C.dataSemiring, C.add)

345+

346+opMul :: (String, String)

347+opMul = (C.dataSemiring, C.mul)

348+

349+opEq :: (String, String)

350+opEq = (C.dataEq, C.eq)

351+

352+opNotEq :: (String, String)

353+opNotEq = (C.dataEq, C.notEq)

354+

355+opLessThan :: (String, String)

356+opLessThan = (C.dataOrd, C.lessThan)

357+

358+opLessThanOrEq :: (String, String)

359+opLessThanOrEq = (C.dataOrd, C.lessThanOrEq)

360+

361+opGreaterThan :: (String, String)

362+opGreaterThan = (C.dataOrd, C.greaterThan)

363+

364+opGreaterThanOrEq :: (String, String)

365+opGreaterThanOrEq = (C.dataOrd, C.greaterThanOrEq)

366+

367+opAppend :: (String, String)

368+opAppend = (C.dataSemigroup, C.append)

369+

370+opSub :: (String, String)

371+opSub = (C.dataRing, C.sub)

372+

373+opNegate :: (String, String)

374+opNegate = (C.dataRing, C.negate)

375+

376+opDiv :: (String, String)

377+opDiv = (C.dataEuclideanRing, C.div)

378+

379+opMod :: (String, String)

380+opMod = (C.dataEuclideanRing, C.mod)

381+

382+opConj :: (String, String)

383+opConj = (C.dataHeytingAlgebra, C.conj)

384+

385+opDisj :: (String, String)

386+opDisj = (C.dataHeytingAlgebra, C.disj)

387+

388+opNot :: (String, String)

389+opNot = (C.dataHeytingAlgebra, C.not)

src/Language/PureScript/CodeGen/Cpp/Optimizer/MagicDo.hs+1−1

@@ -63,7 +63,7 @@ magicDo' = everywhereOnCpp undo . everywhereOnCppTopDown convert

63 CppFunction fnName [] rty [] $ CppBlock (CppVariableIntroduction arg [] (Just (CppApp m [])) : map applyReturns cpp)

64 -- Desugar untilE

65 convert (CppApp (CppApp f [arg]) []) | isEffFunc C.untilE f =

66− CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppUnary CppNot (CppApp arg [])) (CppBlock []), CppReturn $ CppObjectLiteral []])) []

66+ CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppUnary Not (CppApp arg [])) (CppBlock []), CppReturn $ CppObjectLiteral []])) []

67 -- Desugar whileE

68 convert (CppApp (CppApp (CppApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =

69 CppApp (CppLambda [CppCaptureAll] [] Nothing (CppBlock [ CppWhile (CppApp arg1 []) (CppBlock [ CppApp arg2 [] ]), CppReturn $ CppObjectLiteral []])) []

src/Language/PureScript/CodeGen/Cpp/Types.hs+3

@@ -125,3 +125,6 @@ thunkMarkerType = CppPrimitive "any::as_thunk"

125

126ctorKey :: String

127ctorKey = "constructor"

128+

129+constAnyRef :: Maybe CppType

130+constAnyRef = Just $ CppAny [CppConst, CppRef]

src/Language/PureScript/Pretty/Cpp.hs+13−13

@@ -411,7 +411,7 @@ app = mkPattern' match

411 return (intercalate ", " cpps, val)

412 match _ = mzero

413

414−unary' :: CppUnaryOp -> (Cpp -> String) -> Operator PrinterState Cpp String

414+unary' :: UnaryOperator -> (Cpp -> String) -> Operator PrinterState Cpp String

415unary' op mkStr = Wrap match (++)

416 where

417 match :: Pattern PrinterState Cpp (String, Cpp)

@@ -420,16 +420,16 @@ unary' op mkStr = Wrap match (++)

420 match' (CppUnary op' val) | op' == op = Just (mkStr val, val)

421 match' _ = Nothing

422

423−unary :: CppUnaryOp -> String -> Operator PrinterState Cpp String

423+unary :: UnaryOperator -> String -> Operator PrinterState Cpp String

424unary op str = unary' op (const str)

425

426negateOperator :: Operator PrinterState Cpp String

427−negateOperator = unary' CppNegate (\v -> if isNegate v then "- " else "-")

427+negateOperator = unary' Negate (\v -> if isNegate v then "- " else "-")

428 where

429− isNegate (CppUnary CppNegate _) = True

429+ isNegate (CppUnary Negate _) = True

430 isNegate _ = False

431

432−binary :: BinaryOp -> String -> Operator PrinterState Cpp String

432+binary :: BinaryOperator -> String -> Operator PrinterState Cpp String

433binary op str = AssocL match (\v1 v2 -> v1 ++ str ++ v2)

434 where

435 match :: Pattern PrinterState Cpp (Cpp, Cpp)

@@ -476,16 +476,16 @@ prettyPrintCpp' = A.runKleisli $ runPattern matchValue

476 OperatorTable [ [ Wrap accessor $ \prop val -> val ++ "::" ++ prop ]

477 , [ Wrap indexer $ \index val -> val ++ "[" ++ index ++ "]" ]

478 , [ Wrap app $ \args val -> val ++ parens args ]

479− , [ unary CppNew "new " ]

479+ , [ unary New "new " ]

480 , [ Wrap lam $ \(caps, args, rty) ret -> '[' : caps ++ "]"

481 ++ let args' = argstr <$> args in

482 parens (intercalate ", " args')

483 ++ maybe "" ((" -> " ++) . runType) rty

484 ++ " "

485 ++ ret ]

486− , [ unary CppNot "!"

486+ , [ unary Not "!"

487− , unary CppBitwiseNot "~"

487+ , unary BitwiseNot "~"

488− , unary CppPositive "+"

488+ , unary Positive "+"

489 , negateOperator ]

490 , [ binary Multiply " * "

491 , binary Divide " / "

@@ -496,11 +496,11 @@ prettyPrintCpp' = A.runKleisli $ runPattern matchValue

496 , [ binary ShiftLeft " << "

497 , binary ShiftRight " >> " ]

498 , [ binary LessThan " < "

499− , binary LessThanOrEqual " <= "

499+ , binary LessThanOrEqualTo " <= "

500 , binary GreaterThan " > "

501− , binary GreaterThanOrEqual " >= "

501+ , binary GreaterThanOrEqualTo " >= "

502− , binary Equal " == "

502+ , binary EqualTo " == "

503− , binary NotEqual " != " ]

503+ , binary NotEqualTo " != " ]

504 , [ binary BitwiseAnd " & " ]

505 , [ binary BitwiseXor " ^ " ]

506 , [ binary BitwiseOr " | " ]