daacf6b · rowtype-yoga/purescript-native

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

on golang help sign in

Fix == on lists, use >>> and <<< for category composition

daacf6bPhil Freeman13 years ago

examples/passing/Category.pursdeleted−15

compare with golang

unifiedsplit

@@ -1,15 +0,0 @@

1−module Category where

2−

3−class Category c where

4− id :: forall x. c x x

5− (<|) :: forall x y z. c y z -> c x y -> c x z

6−

7−instance Category (->) where

8− id = Prelude.id

9− (<|) = Prelude.(<|)

10−

11−module Main where

12−

13−import Category

14−

15−main = Trace.trace (id "Done")

libraries/prelude/prelude.purs+33−28

@@ -6,29 +6,33 @@ module Prelude where

6 foreign import data Array :: * -> *

7 foreign import data Function :: * -> * -> *

9− id :: forall a. a -> a

10− id = \x -> x

11−

12 flip :: forall a b c. (a -> b -> c) -> b -> a -> c

9 flip :: forall a b c. (a -> b -> c) -> b -> a -> c

13− flip = \f -> \b -> \a -> f a b

10+ flip f b a = f a b

15 konst :: forall a b. a -> b -> a

12 konst :: forall a b. a -> b -> a

16− konst = \a -> \b -> a

13+ konst a _ = a

18− (|>) :: forall a b c. (a -> b) -> (b -> c) -> a -> c

15+ infixr 5 >>>

19− (|>) = \f -> \g -> \a -> g (f a)

16+ infixr 5 <<<

21− infixr 5 |>

18+ class Category a where

19+ id :: forall t. a t t

20+ (<<<) :: forall b c d. a c d -> a b c -> a b d

21+ (>>>) :: forall b c d. a b c -> a c d -> a b d

23− (<|) :: forall a b c. (b -> c) -> (a -> b) -> a -> c

23+ instance Category (->) where

24− (<|) = flip (|>)

24+ id x = x

25+ (<<<) f g x = f (g x)

26+ (>>>) f g x = g (f x)

26− infixr 5 <|

28+ infixr 1000 $

29+ infixl 1000 #

28 ($) :: forall a b. (a -> b) -> a -> b

31 ($) :: forall a b. (a -> b) -> a -> b

29 ($) f x = f x

32 ($) f x = f x

31− infixr 1000 $

34+ (#) :: forall a b. a -> (a -> b) -> b

35+ (#) x f = f x

33 class Show a where

37 class Show a where

34 show :: a -> String

38 show :: a -> String

@@ -169,8 +173,10 @@ module Prelude where

169 (/=) = unsafeRefIneq

173 (/=) = unsafeRefIneq

170

174

171 instance (Eq a) => Eq [a] where

175 instance (Eq a) => Eq [a] where

172− (==) = unsafeRefEq

176+ (==) [] [] = true

173− (/=) = unsafeRefIneq

177+ (==) (x:xs) (y:ys) = x == y && xs == ys

178+ (==) _ _ = false

179+ (/=) xs ys = not (xs == ys)

174

180

175 infixl 3 <

181 infixl 3 <

176 infixl 3 >

182 infixl 3 >

@@ -213,21 +219,17 @@ module Prelude where

213 (<=) = numLessEq

219 (<=) = numLessEq

214 (>=) = numGreaterEq

220 (>=) = numGreaterEq

215

221

216− infixl 8 <<

217− infixl 8 >>

218− infixl 8 >>>

219−

220 infixl 10 &

222 infixl 10 &

221 infixl 10 |

223 infixl 10 |

222− infixl 10 ^

224+ infixl 10 ^

223

225

224 class Bits b where

226 class Bits b where

225− (<<) :: b -> Number -> b

226− (>>) :: b -> Number -> b

227− (>>>) :: b -> Number -> b

228 (&) :: b -> b -> b

227 (&) :: b -> b -> b

229 (|) :: b -> b -> b

228 (|) :: b -> b -> b

230 (^) :: b -> b -> b

229 (^) :: b -> b -> b

230+ shl :: b -> Number -> b

231+ shr :: b -> Number -> b

232+ zshr :: b -> Number -> b

231 complement :: b -> b

233 complement :: b -> b

232

234

233 foreign import numShl "function numShl(n1) {\

235 foreign import numShl "function numShl(n1) {\

@@ -242,7 +244,7 @@ module Prelude where

242 \ };\

244 \ };\

243 \}" :: Number -> Number -> Number

245 \}" :: Number -> Number -> Number

244

246

245− foreign import numZfShr "function numZfShr(n1) {\

247+ foreign import numZshr "function numZshr(n1) {\

246 \ return function(n2) {\

248 \ return function(n2) {\

247 \ return n1 >>> n2;\

249 \ return n1 >>> n2;\

248 \ };\

250 \ };\

@@ -271,12 +273,12 @@ module Prelude where

271 \}" :: Number -> Number

273 \}" :: Number -> Number

272

274

273 instance Bits Number where

275 instance Bits Number where

274− (<<) = numShl

275− (>>) = numShr

276− (>>>) = numZfShr

277 (&) = numAnd

276 (&) = numAnd

278 (|) = numOr

277 (|) = numOr

279 (^) = numXor

278 (^) = numXor

279+ shl = numShl

280+ shr = numShr

281+ zshr = numZshr

280 complement = numComplement

282 complement = numComplement

281

283

282 infixl 4 !!

284 infixl 4 !!

@@ -326,6 +328,8 @@ module Prelude where

326

328

327module Maybe where

329module Maybe where

328

330

331+ import Prelude

332+

329 data Maybe a = Nothing | Just a

333 data Maybe a = Nothing | Just a

330

334

331 maybe :: forall a b. b -> (a -> b) -> Maybe a -> b

335 maybe :: forall a b. b -> (a -> b) -> Maybe a -> b

@@ -333,7 +337,7 @@ module Maybe where

333 maybe _ f (Just a) = f a

337 maybe _ f (Just a) = f a

334

338

335 fromMaybe :: forall a. a -> Maybe a -> a

339 fromMaybe :: forall a. a -> Maybe a -> a

336− fromMaybe a = maybe a Prelude.id

340+ fromMaybe a = maybe a (Prelude.id :: forall a. a -> a)

337

341

338 instance Prelude.Monad Maybe where

342 instance Prelude.Monad Maybe where

339 ret = Just

343 ret = Just

@@ -503,6 +507,7 @@ module Arrays where

503

507

504module Tuple where

508module Tuple where

505

509

510+ import Prelude

506 import Arrays

511 import Arrays

507

512

508 type Tuple a b = { fst :: a, snd :: b }

513 type Tuple a b = { fst :: a, snd :: b }

@@ -514,7 +519,7 @@ module Tuple where

514 uncurry f t = f t.fst t.snd

519 uncurry f t = f t.fst t.snd

515

520

516 tuple :: forall a b. a -> b -> Tuple a b

521 tuple :: forall a b. a -> b -> Tuple a b

517− tuple = curry Prelude.id

522+ tuple = curry (\t -> t)

518

523

519 zip :: forall a b. [a] -> [b] -> [Tuple a b]

524 zip :: forall a b. [a] -> [b] -> [Tuple a b]

520 zip = zipWith tuple

525 zip = zipWith tuple

src/Language/PureScript/CodeGen/Optimize.hs+13−4

@@ -27,7 +27,7 @@

27--

28-- * Inlining variables

29--

30−-- * Inline Prelude.($), Prelude.(++), Prelude.(!!)

30+-- * Inline Prelude.($), Prelude.(#), Prelude.(++), Prelude.(!!)

31--

32-- * Inlining primitive Javascript operators

33--

@@ -63,6 +63,7 @@ optimize opts | optionsNoOptimizations opts = id

63 , etaConvert

64 , inlineVariables

65 , inlineOperator "$" $ \f x -> JSApp f [x]

66+ , inlineOperator "#" $ \x f -> JSApp f [x]

66 , inlineOperator "!!" $ flip JSIndexer

67 , inlineOperator "!!" $ flip JSIndexer

67 , inlineOperator "++" $ JSBinary Add

68 , inlineOperator "++" $ JSBinary Add

68 , inlineCommonOperators ]

69 , inlineCommonOperators ]

@@ -330,9 +331,9 @@ inlineCommonOperators = applyAll

330 , binary "==" "Eq" tyBoolean EqualTo

331 , binary "==" "Eq" tyBoolean EqualTo

331 , binary "/=" "Eq" tyBoolean NotEqualTo

332 , binary "/=" "Eq" tyBoolean NotEqualTo

332

333

333− , binary "<<" "Bits" tyNumber ShiftLeft

334+ , binaryFunction "shl" "Bits" tyNumber ShiftLeft

334− , binary ">>" "Bits" tyNumber ShiftRight

335+ , binaryFunction "shr" "Bits" tyNumber ShiftRight

335− , binary ">>>" "Bits" tyNumber ZeroFillShiftRight

336+ , binaryFunction "zshr" "Bits" tyNumber ZeroFillShiftRight

336 , binary "&" "Bits" tyNumber BitwiseAnd

337 , binary "&" "Bits" tyNumber BitwiseAnd

337 , binary "|" "Bits" tyNumber BitwiseOr

338 , binary "|" "Bits" tyNumber BitwiseOr

338 , binary "^" "Bits" tyNumber BitwiseXor

339 , binary "^" "Bits" tyNumber BitwiseXor

@@ -352,6 +353,14 @@ inlineCommonOperators = applyAll

352 isOp (JSAccessor longForm (JSVar "Prelude")) | longForm == identToJs (Op opString) = True

353 isOp (JSAccessor longForm (JSVar "Prelude")) | longForm == identToJs (Op opString) = True

353 isOp (JSIndexer (JSStringLiteral op') (JSVar "Prelude")) | opString == op' = True

354 isOp (JSIndexer (JSStringLiteral op') (JSVar "Prelude")) | opString == op' = True

354 isOp _ = False

355 isOp _ = False

356+ binaryFunction :: String -> String -> Type -> BinaryOperator -> JS -> JS

357+ binaryFunction fnName className classTy op = everywhere (mkT convert)

358+ where

359+ convert :: JS -> JS

360+ convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict className classTy dict = JSBinary op x y

361+ convert other = other

362+ isOp (JSAccessor fnName' (JSVar "Prelude")) | fnName == fnName' = True

363+ isOp _ = False

355 unary :: String -> String -> Type -> UnaryOperator -> JS -> JS

364 unary :: String -> String -> Type -> UnaryOperator -> JS -> JS

356 unary fnName className classTy op = everywhere (mkT convert)

365 unary fnName className classTy op = everywhere (mkT convert)

357 where

366 where