Merge pull request purescript#872 from purescript/num

garyb · garyb · commit 8f3e5e42252b · 2015-02-16T00:14:11.000Z
Revise Num class hierarchy
diff --git a/examples/passing/OneConstructor.purs b/examples/passing/OneConstructor.purs
@@ -2,6 +2,6 @@ module Main where
 
 data One a = One a
 
-one (One a) = a
+one' (One a) = a
 
 main = Debug.Trace.trace "Done"
diff --git a/examples/passing/Rank2Data.purs b/examples/passing/Rank2Data.purs
@@ -12,18 +12,18 @@ module Main where
   runNat = \nat -> case nat of
     Nat f -> f 0 (\n -> n + 1)
 
-  zero = Nat (\zero _ -> zero)
+  zero' = Nat (\zero' _ -> zero')
 
   succ = \n -> case n of
-    Nat f -> Nat (\zero succ -> succ (f zero succ))
+    Nat f -> Nat (\zero' succ -> succ (f zero' succ))
 
   add = \n m -> case n of
     Nat f -> case m of
-      Nat g -> Nat (\zero succ -> g (f zero succ) succ)
+      Nat g -> Nat (\zero' succ -> g (f zero' succ) succ)
 
-  one = succ zero
-  two = succ zero
+  one' = succ zero'
+  two = succ zero'
   four = add two two
   fourNumber = runNat four
 
-  main = Debug.Trace.trace "Done"
+  main = Debug.Trace.trace "Done'"
diff --git a/examples/passing/ShadowedTCO.purs b/examples/passing/ShadowedTCO.purs
@@ -2,14 +2,14 @@ module Main where
 
 runNat f = f 0 (\n -> n + 1)
 
-zero z _ = z
+zero' z _ = z
 
-succ f zero succ = succ (f zero succ)
+succ f zero' succ = succ (f zero' succ)
 
-add f g zero succ = g (f zero succ) succ
+add f g zero' succ = g (f zero' succ) succ
 
-one = succ zero
-two = succ one
+one' = succ zero'
+two = succ one'
 four = add two two
 fourNumber = runNat four
 
diff --git a/prelude/README.md b/prelude/README.md
@@ -59,6 +59,13 @@
     class (Semigroupoid a) <= Category a where
       id :: forall t. a t t
 
+#### `DivisionRing`
+
+Ring where every nonzero element has a multiplicative inverse (possibly
+a non-commutative field) so that ```a `mod` b = zero```
+
+    class (ModuloRing a) <= DivisionRing a where
+
 #### `Eq`
 
     class Eq a where
@@ -70,25 +77,37 @@
     class Functor f where
       (<$>) :: forall a b. (a -> b) -> f a -> f b
 
+#### `ModuloRing`
+
+Ring with modulo operation and division where
+```a / b * b + (a `mod` b) = a```
+
+    class (Ring a) <= ModuloRing a where
+      (/) :: a -> a -> a
+      mod :: a -> a -> a
+
 #### `Monad`
 
     class (Applicative m, Bind m) <= Monad m where
 
 #### `Num`
 
-    class Num a where
-      (+) :: a -> a -> a
-      (-) :: a -> a -> a
-      (*) :: a -> a -> a
-      (/) :: a -> a -> a
-      (%) :: a -> a -> a
-      negate :: a -> a
+A commutative field
+
+    class (DivisionRing a) <= Num a where
 
 #### `Ord`
 
     class (Eq a) <= Ord a where
       compare :: a -> a -> Ordering
 
+#### `Ring`
+
+Addition, multiplication, and subtraction
+
+    class (Semiring a) <= Ring a where
+      (-) :: a -> a -> a
+
 #### `Semigroup`
 
     class Semigroup a where
@@ -99,6 +118,16 @@
     class Semigroupoid a where
       (<<<) :: forall b c d. a c d -> a b c -> a b d
 
+#### `Semiring`
+
+Addition and multiplication
+
+    class Semiring a where
+      (+) :: a -> a -> a
+      zero :: a
+      (*) :: a -> a -> a
+      one :: a
+
 #### `Show`
 
     class Show a where
@@ -131,6 +160,10 @@
 
     instance categoryArr :: Category Prim.Function
 
+#### `divisionRingNumber`
+
+    instance divisionRingNumber :: DivisionRing Number
+
 #### `eqArray`
 
     instance eqArray :: (Eq a) => Eq [a]
@@ -159,6 +192,10 @@
 
     instance functorArr :: Functor (Prim.Function r)
 
+#### `moduloRingNumber`
+
+    instance moduloRingNumber :: ModuloRing Number
+
 #### `monadArr`
 
     instance monadArr :: Monad (Prim.Function r)
@@ -187,6 +224,10 @@
 
     instance ordUnit :: Ord Unit
 
+#### `ringNumber`
+
+    instance ringNumber :: Ring Number
+
 #### `semigroupArr`
 
     instance semigroupArr :: (Semigroup s') => Semigroup (s -> s')
@@ -203,6 +244,10 @@
 
     instance semigroupoidArr :: Semigroupoid Prim.Function
 
+#### `semiringNumber`
+
+    instance semiringNumber :: Semiring Number
+
 #### `showArray`
 
     instance showArray :: (Show a) => Show [a]
@@ -277,7 +322,7 @@
 #### `asTypeOf`
 
 This function returns its first argument, and can be used to assert type equalities.
-This can be useful when types are otherwise ambiguous. 
+This can be useful when types are otherwise ambiguous.
 
 E.g.
 
@@ -294,13 +339,13 @@ been ambiguous, resulting in a compile-time error.
 
 #### `const`
 
-Returns its first argument and ignores its second. 
+Returns its first argument and ignores its second.
 
     const :: forall a b. a -> b -> a
 
 #### `flip`
 
-Flips the order of the arguments to a function of two arguments. 
+Flips the order of the arguments to a function of two arguments.
 
     flip :: forall a b c. (a -> b -> c) -> b -> a -> c
 
@@ -312,13 +357,17 @@ Flips the order of the arguments to a function of two arguments.
 
     liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b
 
+#### `negate`
+
+    negate :: forall a. (Ring a) => a -> a
+
 #### `otherwise`
 
-An alias for `true`, which can be useful in guard clauses: 
+An alias for `true`, which can be useful in guard clauses:
 
 E.g.
 
-    max x y | x >= y = x 
+    max x y | x >= y = x
             | otherwise = y
 
     otherwise :: Boolean
diff --git a/prelude/prelude.purs b/prelude/prelude.purs
@@ -13,8 +13,13 @@ module Prelude
   , Applicative, pure, liftA1
   , Bind, (>>=)
   , Monad, return, liftM1, ap
-  , Num, (+), (-), (*), (/), (%)
+  , Semiring, (+), zero, (*), one
+  , Ring, (-)
+  , (%)
   , negate
+  , ModuloRing, (/), mod
+  , DivisionRing
+  , Num
   , Eq, (==), (/=), refEq, refIneq
   , Ord, Ordering(..), compare, (<), (>), (<=), (>=)
   , Bits, (.&.), (.|.), (.^.), shl, shr, zshr, complement
@@ -24,28 +29,28 @@ module Prelude
   , Unit(..), unit
   ) where
 
-  -- | An alias for `true`, which can be useful in guard clauses: 
-  -- | 
+  -- | An alias for `true`, which can be useful in guard clauses:
+  -- |
   -- | E.g.
-  -- | 
-  -- |     max x y | x >= y = x 
+  -- |
+  -- |     max x y | x >= y = x
   -- |             | otherwise = y
   otherwise :: Boolean
   otherwise = true
 
-  -- | Flips the order of the arguments to a function of two arguments. 
+  -- | Flips the order of the arguments to a function of two arguments.
   flip :: forall a b c. (a -> b -> c) -> b -> a -> c
   flip f b a = f a b
 
-  -- | Returns its first argument and ignores its second. 
+  -- | Returns its first argument and ignores its second.
   const :: forall a b. a -> b -> a
   const a _ = a
 
   -- | This function returns its first argument, and can be used to assert type equalities.
-  -- | This can be useful when types are otherwise ambiguous. 
-  -- | 
+  -- | This can be useful when types are otherwise ambiguous.
+  -- |
   -- | E.g.
-  -- | 
+  -- |
   -- |     main = print $ [] `asTypeOf` [0]
   -- |
   -- | If instead, we had written `main = print []`, the type of the argument `[]` would have
@@ -205,13 +210,32 @@ module Prelude
   infixl 6 -
   infixl 6 +
 
-  class Num a where
-    (+) :: a -> a -> a
+  -- | Addition and multiplication
+  class Semiring a where
+    (+)  :: a -> a -> a
+    zero :: a
+    (*)  :: a -> a -> a
+    one  :: a
+
+  -- | Addition, multiplication, and subtraction
+  class (Semiring a) <= Ring a where
     (-) :: a -> a -> a
-    (*) :: a -> a -> a
+
+  negate :: forall a. (Ring a) => a -> a
+  negate a = zero - a
+
+  -- | Ring with modulo operation and division where
+  -- | ```a / b * b + (a `mod` b) = a```
+  class (Ring a) <= ModuloRing a where
     (/) :: a -> a -> a
-    (%) :: a -> a -> a
-    negate :: a -> a
+    mod :: a -> a -> a
+
+  -- | Ring where every nonzero element has a multiplicative inverse (possibly
+  -- | a non-commutative field) so that ```a `mod` b = zero```
+  class (ModuloRing a) <= DivisionRing a
+
+  -- | A commutative field
+  class (DivisionRing a) <= Num a
 
   foreign import numAdd
     """
@@ -258,20 +282,24 @@ module Prelude
     }
     """ :: Number -> Number -> Number
 
-  foreign import numNegate
-    """
-    function numNegate(n) {
-      return -n;
-    }
-    """ :: Number -> Number
+  (%) = numMod
 
-  instance numNumber :: Num Number where
+  instance semiringNumber :: Semiring Number where
     (+) = numAdd
-    (-) = numSub
+    zero = 0
     (*) = numMul
+    one = 1
+
+  instance ringNumber :: Ring Number where
+    (-) = numSub
+
+  instance moduloRingNumber :: ModuloRing Number where
     (/) = numDiv
-    (%) = numMod
-    negate = numNegate
+    mod _ _ = 0
+
+  instance divisionRingNumber :: DivisionRing Number
+
+  instance numNumber :: Num Number
 
   newtype Unit = Unit {}
 
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer.hs b/src/Language/PureScript/CodeGen/JS/Optimizer.hs
@@ -63,6 +63,7 @@ optimize opts | optionsNoOptimizations opts = id
   , etaConvert
   , evaluateIifes
   , inlineVariables
+  , inlineValues
   , inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp f [x]
   , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]
   , inlineOperator (C.preludeUnsafe, C.unsafeIndex) $ flip JSIndexer
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs
diff --git a/src/Language/PureScript/Constants.hs b/src/Language/PureScript/Constants.hs
