git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #872 from purescript/num
8f3e5e4Gary Burgess
examples/passing/OneConstructor.purs+1−1
compare with golang
unifiedsplit
@@ -2,6 +2,6 @@ module Main where
2
2
3data One a = One a
3data One a = One a
4
4
5−one (One a) = a
5+one' (One a) = a
6
6
7main = Debug.Trace.trace "Done"
7main = Debug.Trace.trace "Done"
examples/passing/Rank2Data.purs+6−6
@@ -12,18 +12,18 @@ module Main where
12 runNat = \nat -> case nat of
12 runNat = \nat -> case nat of
13 Nat f -> f 0 (\n -> n + 1)
13 Nat f -> f 0 (\n -> n + 1)
14
14
15− zero = Nat (\zero _ -> zero)
15+ zero' = Nat (\zero' _ -> zero')
16
16
17 succ = \n -> case n of
17 succ = \n -> case n of
18− Nat f -> Nat (\zero succ -> succ (f zero succ))
18+ Nat f -> Nat (\zero' succ -> succ (f zero' succ))
19
19
20 add = \n m -> case n of
20 add = \n m -> case n of
21 Nat f -> case m of
21 Nat f -> case m of
22− Nat g -> Nat (\zero succ -> g (f zero succ) succ)
22+ Nat g -> Nat (\zero' succ -> g (f zero' succ) succ)
23
23
24− one = succ zero
24+ one' = succ zero'
25− two = succ zero
25+ two = succ zero'
26 four = add two two
26 four = add two two
27 fourNumber = runNat four
27 fourNumber = runNat four
28
28
29− main = Debug.Trace.trace "Done"
29+ main = Debug.Trace.trace "Done'"
examples/passing/ShadowedTCO.purs+5−5
@@ -2,14 +2,14 @@ module Main where
2
2
3runNat f = f 0 (\n -> n + 1)
3runNat f = f 0 (\n -> n + 1)
4
4
5−zero z _ = z
5+zero' z _ = z
6
6
7−succ f zero succ = succ (f zero succ)
7+succ f zero' succ = succ (f zero' succ)
8
8
9−add f g zero succ = g (f zero succ) succ
9+add f g zero' succ = g (f zero' succ) succ
10
10
11−one = succ zero
11+one' = succ zero'
12−two = succ one
12+two = succ one'
13four = add two two
13four = add two two
14fourNumber = runNat four
14fourNumber = runNat four
15
15
prelude/README.md+61−12
@@ -59,6 +59,13 @@
59 class (Semigroupoid a) <= Category a where
59 class (Semigroupoid a) <= Category a where
60 id :: forall t. a t t
60 id :: forall t. a t t
61
61
62+#### `DivisionRing`
63+
64+Ring where every nonzero element has a multiplicative inverse (possibly
65+a non-commutative field) so that ```a `mod` b = zero```
66+
67+ class (ModuloRing a) <= DivisionRing a where
68+
62#### `Eq`
69#### `Eq`
63
70
64 class Eq a where
71 class Eq a where
@@ -70,25 +77,37 @@
70 class Functor f where
77 class Functor f where
71 (<$>) :: forall a b. (a -> b) -> f a -> f b
78 (<$>) :: forall a b. (a -> b) -> f a -> f b
72
79
80+#### `ModuloRing`
81+
82+Ring with modulo operation and division where
83+```a / b * b + (a `mod` b) = a```
84+
85+ class (Ring a) <= ModuloRing a where
86+ (/) :: a -> a -> a
87+ mod :: a -> a -> a
88+
73#### `Monad`
89#### `Monad`
74
90
75 class (Applicative m, Bind m) <= Monad m where
91 class (Applicative m, Bind m) <= Monad m where
76
92
77#### `Num`
93#### `Num`
78
94
95+A commutative field
96+
79− class Num a where
97+ class (DivisionRing a) <= Num a where
80− (+) :: a -> a -> a
81− (-) :: a -> a -> a
82− (*) :: a -> a -> a
83− (/) :: a -> a -> a
84− (%) :: a -> a -> a
85− negate :: a -> a
86
98
87#### `Ord`
99#### `Ord`
88
100
89 class (Eq a) <= Ord a where
101 class (Eq a) <= Ord a where
90 compare :: a -> a -> Ordering
102 compare :: a -> a -> Ordering
91
103
104+#### `Ring`
105+
106+Addition, multiplication, and subtraction
107+
108+ class (Semiring a) <= Ring a where
109+ (-) :: a -> a -> a
110+
92#### `Semigroup`
111#### `Semigroup`
93
112
94 class Semigroup a where
113 class Semigroup a where
@@ -99,6 +118,16 @@
99 class Semigroupoid a where
118 class Semigroupoid a where
100 (<<<) :: forall b c d. a c d -> a b c -> a b d
119 (<<<) :: forall b c d. a c d -> a b c -> a b d
101
120
121+#### `Semiring`
122+
123+Addition and multiplication
124+
125+ class Semiring a where
126+ (+) :: a -> a -> a
127+ zero :: a
128+ (*) :: a -> a -> a
129+ one :: a
130+
102#### `Show`
131#### `Show`
103
132
104 class Show a where
133 class Show a where
@@ -131,6 +160,10 @@
131
160
132 instance categoryArr :: Category Prim.Function
161 instance categoryArr :: Category Prim.Function
133
162
163+#### `divisionRingNumber`
164+
165+ instance divisionRingNumber :: DivisionRing Number
166+
134#### `eqArray`
167#### `eqArray`
135
168
136 instance eqArray :: (Eq a) => Eq [a]
169 instance eqArray :: (Eq a) => Eq [a]
@@ -159,6 +192,10 @@
159
192
160 instance functorArr :: Functor (Prim.Function r)
193 instance functorArr :: Functor (Prim.Function r)
161
194
195+#### `moduloRingNumber`
196+
197+ instance moduloRingNumber :: ModuloRing Number
198+
162#### `monadArr`
199#### `monadArr`
163
200
164 instance monadArr :: Monad (Prim.Function r)
201 instance monadArr :: Monad (Prim.Function r)
@@ -187,6 +224,10 @@
187
224
188 instance ordUnit :: Ord Unit
225 instance ordUnit :: Ord Unit
189
226
227+#### `ringNumber`
228+
229+ instance ringNumber :: Ring Number
230+
190#### `semigroupArr`
231#### `semigroupArr`
191
232
192 instance semigroupArr :: (Semigroup s') => Semigroup (s -> s')
233 instance semigroupArr :: (Semigroup s') => Semigroup (s -> s')
@@ -203,6 +244,10 @@
203
244
204 instance semigroupoidArr :: Semigroupoid Prim.Function
245 instance semigroupoidArr :: Semigroupoid Prim.Function
205
246
247+#### `semiringNumber`
248+
249+ instance semiringNumber :: Semiring Number
250+
206#### `showArray`
251#### `showArray`
207
252
208 instance showArray :: (Show a) => Show [a]
253 instance showArray :: (Show a) => Show [a]
@@ -277,7 +322,7 @@
277#### `asTypeOf`
322#### `asTypeOf`
278
323
279This function returns its first argument, and can be used to assert type equalities.
324This function returns its first argument, and can be used to assert type equalities.
280−This can be useful when types are otherwise ambiguous.
325+This can be useful when types are otherwise ambiguous.
281
326
282E.g.
327E.g.
283
328
@@ -294,13 +339,13 @@ been ambiguous, resulting in a compile-time error.
294
339
295#### `const`
340#### `const`
296
341
297−Returns its first argument and ignores its second.
342+Returns its first argument and ignores its second.
298
343
299 const :: forall a b. a -> b -> a
344 const :: forall a b. a -> b -> a
300
345
301#### `flip`
346#### `flip`
302
347
303−Flips the order of the arguments to a function of two arguments.
348+Flips the order of the arguments to a function of two arguments.
304
349
305 flip :: forall a b c. (a -> b -> c) -> b -> a -> c
350 flip :: forall a b c. (a -> b -> c) -> b -> a -> c
306
351
@@ -312,13 +357,17 @@ Flips the order of the arguments to a function of two arguments.
312
357
313 liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b
358 liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b
314
359
360+#### `negate`
361+
362+ negate :: forall a. (Ring a) => a -> a
363+
315#### `otherwise`
364#### `otherwise`
316
365
317−An alias for `true`, which can be useful in guard clauses:
366+An alias for `true`, which can be useful in guard clauses:
318
367
319E.g.
368E.g.
320
369
321− max x y | x >= y = x
370+ max x y | x >= y = x
322 | otherwise = y
371 | otherwise = y
323
372
324 otherwise :: Boolean
373 otherwise :: Boolean
prelude/prelude.purs+53−25
@@ -13,8 +13,13 @@ module Prelude
13 , Applicative, pure, liftA1
13 , Applicative, pure, liftA1
14 , Bind, (>>=)
14 , Bind, (>>=)
15 , Monad, return, liftM1, ap
15 , Monad, return, liftM1, ap
16− , Num, (+), (-), (*), (/), (%)
16+ , Semiring, (+), zero, (*), one
17+ , Ring, (-)
18+ , (%)
17 , negate
19 , negate
20+ , ModuloRing, (/), mod
21+ , DivisionRing
22+ , Num
18 , Eq, (==), (/=), refEq, refIneq
23 , Eq, (==), (/=), refEq, refIneq
19 , Ord, Ordering(..), compare, (<), (>), (<=), (>=)
24 , Ord, Ordering(..), compare, (<), (>), (<=), (>=)
20 , Bits, (.&.), (.|.), (.^.), shl, shr, zshr, complement
25 , Bits, (.&.), (.|.), (.^.), shl, shr, zshr, complement
@@ -24,28 +29,28 @@ module Prelude
24 , Unit(..), unit
29 , Unit(..), unit
25 ) where
30 ) where
26
31
27− -- | An alias for `true`, which can be useful in guard clauses:
32+ -- | An alias for `true`, which can be useful in guard clauses:
28− -- |
33+ -- |
29 -- | E.g.
34 -- | E.g.
30− -- |
35+ -- |
31− -- | max x y | x >= y = x
36+ -- | max x y | x >= y = x
32 -- | | otherwise = y
37 -- | | otherwise = y
33 otherwise :: Boolean
38 otherwise :: Boolean
34 otherwise = true
39 otherwise = true
35
40
36− -- | Flips the order of the arguments to a function of two arguments.
41+ -- | Flips the order of the arguments to a function of two arguments.
37 flip :: forall a b c. (a -> b -> c) -> b -> a -> c
42 flip :: forall a b c. (a -> b -> c) -> b -> a -> c
38 flip f b a = f a b
43 flip f b a = f a b
39
44
40− -- | Returns its first argument and ignores its second.
45+ -- | Returns its first argument and ignores its second.
41 const :: forall a b. a -> b -> a
46 const :: forall a b. a -> b -> a
42 const a _ = a
47 const a _ = a
43
48
44 -- | This function returns its first argument, and can be used to assert type equalities.
49 -- | This function returns its first argument, and can be used to assert type equalities.
45− -- | This can be useful when types are otherwise ambiguous.
50+ -- | This can be useful when types are otherwise ambiguous.
46− -- |
51+ -- |
47 -- | E.g.
52 -- | E.g.
48− -- |
53+ -- |
49 -- | main = print $ [] `asTypeOf` [0]
54 -- | main = print $ [] `asTypeOf` [0]
50 -- |
55 -- |
51 -- | If instead, we had written `main = print []`, the type of the argument `[]` would have
56 -- | If instead, we had written `main = print []`, the type of the argument `[]` would have
@@ -205,13 +210,32 @@ module Prelude
205 infixl 6 -
210 infixl 6 -
206 infixl 6 +
211 infixl 6 +
207
212
213+ -- | Addition and multiplication
208− class Num a where
214+ class Semiring a where
215+ (+) :: a -> a -> a
216+ zero :: a
209− (+) :: a -> a -> a
217+ (*) :: a -> a -> a
218+ one :: a
219+
220+ -- | Addition, multiplication, and subtraction
221+ class (Semiring a) <= Ring a where
210 (-) :: a -> a -> a
222 (-) :: a -> a -> a
211− (*) :: a -> a -> a
223+
224+ negate :: forall a. (Ring a) => a -> a
225+ negate a = zero - a
226+
227+ -- | Ring with modulo operation and division where
228+ -- | ```a / b * b + (a `mod` b) = a```
229+ class (Ring a) <= ModuloRing a where
212 (/) :: a -> a -> a
230 (/) :: a -> a -> a
213− (%) :: a -> a -> a
231+ mod :: a -> a -> a
214− negate :: a -> a
232+
233+ -- | Ring where every nonzero element has a multiplicative inverse (possibly
234+ -- | a non-commutative field) so that ```a `mod` b = zero```
235+ class (ModuloRing a) <= DivisionRing a
236+
237+ -- | A commutative field
238+ class (DivisionRing a) <= Num a
215
239
216 foreign import numAdd
240 foreign import numAdd
217 """
241 """
@@ -258,20 +282,24 @@ module Prelude
258 }
282 }
259 """ :: Number -> Number -> Number
283 """ :: Number -> Number -> Number
260
284
261− foreign import numNegate
285+ (%) = numMod
262− """
263− function numNegate(n) {
264− return -n;
265− }
266− """ :: Number -> Number
267
286
268− instance numNumber :: Num Number where
287+ instance semiringNumber :: Semiring Number where
269 (+) = numAdd
288 (+) = numAdd
270− (-) = numSub
289+ zero = 0
271 (*) = numMul
290 (*) = numMul
291+ one = 1
292+
293+ instance ringNumber :: Ring Number where
294+ (-) = numSub
295+
296+ instance moduloRingNumber :: ModuloRing Number where
272 (/) = numDiv
297 (/) = numDiv
273− (%) = numMod
298+ mod _ _ = 0
274− negate = numNegate
299+
300+ instance divisionRingNumber :: DivisionRing Number
301+
302+ instance numNumber :: Num Number
275
303
276 newtype Unit = Unit {}
304 newtype Unit = Unit {}
277
305
src/Language/PureScript/CodeGen/JS/Optimizer.hs+1
@@ -63,6 +63,7 @@ optimize opts | optionsNoOptimizations opts = id
63 , etaConvert
63 , etaConvert
64 , evaluateIifes
64 , evaluateIifes
65 , inlineVariables
65 , inlineVariables
66+ , inlineValues
66 , inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp f [x]
67 , inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp f [x]
67 , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]
68 , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]
68 , inlineOperator (C.preludeUnsafe, C.unsafeIndex) $ flip JSIndexer
69 , inlineOperator (C.preludeUnsafe, C.unsafeIndex) $ flip JSIndexer
src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs+28−18
@@ -15,6 +15,7 @@
15
15
16module Language.PureScript.CodeGen.JS.Optimizer.Inliner (
16module Language.PureScript.CodeGen.JS.Optimizer.Inliner (
17 inlineVariables,
17 inlineVariables,
18+ inlineValues,
18 inlineOperator,
19 inlineOperator,
19 inlineCommonOperators,
20 inlineCommonOperators,
20 etaConvert,
21 etaConvert,
@@ -79,6 +80,15 @@ inlineVariables = everywhereOnJS $ removeFromBlock go
79 go (map (replaceIdent var js) sts)
80 go (map (replaceIdent var js) sts)
80 go (s:sts) = s : go sts
81 go (s:sts) = s : go sts
81
82
83+inlineValues :: JS -> JS
84+inlineValues = everywhereOnJS convert
85+ where
86+ convert :: JS -> JS
87+ convert (JSApp fn [dict]) | isPreludeDict C.semiringNumber dict && isPreludeFn C.zero fn = JSNumericLiteral (Left 0)
88+ convert (JSApp fn [dict]) | isPreludeDict C.semiringNumber dict && isPreludeFn C.one fn = JSNumericLiteral (Left 1)
89+ convert (JSApp (JSApp fn [x]) [y]) | isPreludeFn (C.%) fn = JSBinary Modulus x y
90+ convert other = other
91+
82inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
92inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
83inlineOperator (m, op) f = everywhereOnJS convert
93inlineOperator (m, op) f = everywhereOnJS convert
84 where
94 where
@@ -91,12 +101,11 @@ inlineOperator (m, op) f = everywhereOnJS convert
91
101
92inlineCommonOperators :: JS -> JS
102inlineCommonOperators :: JS -> JS
93inlineCommonOperators = applyAll $
103inlineCommonOperators = applyAll $
94− [ binary C.numNumber (C.+) Add
104+ [ binary C.semiringNumber (C.+) Add
95− , binary C.numNumber (C.-) Subtract
105+ , binary C.semiringNumber (C.*) Multiply
96− , binary C.numNumber (C.*) Multiply
106+ , binary C.ringNumber (C.-) Subtract
97− , binary C.numNumber (C./) Divide
98− , binary C.numNumber (C.%) Modulus
99− , unary C.numNumber C.negate Negate
107+ , unary C.ringNumber C.negate Negate
108+ , binary C.moduloRingNumber (C./) Divide
100
109
101 , binary C.ordNumber (C.<) LessThan
110 , binary C.ordNumber (C.<) LessThan
102 , binary C.ordNumber (C.>) GreaterThan
111 , binary C.ordNumber (C.>) GreaterThan
@@ -131,29 +140,20 @@ inlineCommonOperators = applyAll $
131 binary dictName opString op = everywhereOnJS convert
140 binary dictName opString op = everywhereOnJS convert
132 where
141 where
133 convert :: JS -> JS
142 convert :: JS -> JS
134− convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y
143+ convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isPreludeDict dictName dict && isPreludeFn opString fn = JSBinary op x y
135 convert other = other
144 convert other = other
136− isOp (JSAccessor longForm (JSAccessor prelude (JSVar _))) = prelude == C.prelude && longForm == identToJs (Op opString)
137− isOp (JSIndexer (JSStringLiteral op') (JSVar prelude)) = prelude == C.prelude && opString == op'
138− isOp _ = False
139 binaryFunction :: String -> String -> BinaryOperator -> JS -> JS
145 binaryFunction :: String -> String -> BinaryOperator -> JS -> JS
140 binaryFunction dictName fnName op = everywhereOnJS convert
146 binaryFunction dictName fnName op = everywhereOnJS convert
141 where
147 where
142 convert :: JS -> JS
148 convert :: JS -> JS
143− convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y
149+ convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isPreludeFn fnName fn && isPreludeDict dictName dict = JSBinary op x y
144 convert other = other
150 convert other = other
145− isOp (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName == fnName'
146− isOp _ = False
147 unary :: String -> String -> UnaryOperator -> JS -> JS
151 unary :: String -> String -> UnaryOperator -> JS -> JS
148 unary dictName fnName op = everywhereOnJS convert
152 unary dictName fnName op = everywhereOnJS convert
149 where
153 where
150 convert :: JS -> JS
154 convert :: JS -> JS
151− convert (JSApp (JSApp fn [dict]) [x]) | isOp fn && isOpDict dictName dict = JSUnary op x
155+ convert (JSApp (JSApp fn [dict]) [x]) | isPreludeFn fnName fn && isPreludeDict dictName dict = JSUnary op x
152 convert other = other
156 convert other = other
153− isOp (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName' == fnName
154− isOp _ = False
155− isOpDict dictName (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == dictName
156− isOpDict _ _ = False
157 mkFn :: Int -> JS -> JS
157 mkFn :: Int -> JS -> JS
158 mkFn 0 = everywhereOnJS convert
158 mkFn 0 = everywhereOnJS convert
159 where
159 where
@@ -189,3 +189,13 @@ inlineCommonOperators = applyAll $
189 go 0 acc (JSApp runFnN [fn]) | isNFn C.runFn n runFnN && length acc == n = Just (JSApp fn acc)
189 go 0 acc (JSApp runFnN [fn]) | isNFn C.runFn n runFnN && length acc == n = Just (JSApp fn acc)
190 go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
190 go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
191 go _ _ _ = Nothing
191 go _ _ _ = Nothing
192+
193+isPreludeDict :: String -> JS -> Bool
194+isPreludeDict dictName (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == dictName
195+isPreludeDict _ _ = False
196+
197+isPreludeFn :: String -> JS -> Bool
198+isPreludeFn fnName (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName' == fnName
199+isPreludeFn fnName (JSIndexer (JSStringLiteral fnName') (JSVar prelude)) = prelude == C.prelude && fnName' == fnName
200+isPreludeFn fnName (JSAccessor longForm (JSAccessor prelude (JSVar _))) = prelude == C.prelude && longForm == identToJs (Op fnName)
201+isPreludeFn _ _ = False
src/Language/PureScript/Constants.hs+15
@@ -105,6 +105,12 @@ not = "not"
105
105
106-- Prelude Values
106-- Prelude Values
107
107
108+zero :: String
109+zero = "zero"
110+
111+one :: String
112+one = "one"
113+
108return :: String
114return :: String
109return = "return"
115return = "return"
110
116
@@ -163,6 +169,15 @@ applicativeEffDictionary = "applicativeEff"
163bindEffDictionary :: String
169bindEffDictionary :: String
164bindEffDictionary = "bindEff"
170bindEffDictionary = "bindEff"
165
171
172+semiringNumber :: String
173+semiringNumber = "semiringNumber"
174+
175+ringNumber :: String
176+ringNumber = "ringNumber"
177+
178+moduloRingNumber :: String
179+moduloRingNumber = "moduloRingNumber"
180+
166numNumber :: String
181numNumber :: String
167numNumber = "numNumber"
182numNumber = "numNumber"
168
183