Thijs Alkemade avatar Thijs Alkemade committed 3ac98eb

INLINE a number of funcitons, and provide rules to rewrite multiple coercions.

MapEq now doesn't take a Bool parameter anymore, as it was unnecessary.

Some refactoring.

Comments (0)

Files changed (4)

 instance (MapNull rest b', IsZero value b, And b b' result) => MapNull ('(unit, value) ': rest) result
 
 -- |'b' is equal to 'True' if and only if 'map1' and 'map2' represent the same dimension.
-class MapEq (map1 :: [(*, Number)]) (map2 :: [(*, Number)]) (b :: Bool) | map1 map2 -> b where
+class MapEq (map1 :: [(*, Number)]) (map2 :: [(*, Number)]) where
 
-instance MapEq a a True
-instance (MapNeg map2 map2', MapMerge map1 map2' sum, MapNull sum b) => MapEq map1 map2 b
+instance MapEq a a
+instance (MapNeg map2 map2', MapMerge map1 map2' sum, MapNull sum True) => MapEq map1 map2
 
 -- |A value tagged with its dimension a and unit b.
 newtype Value (a :: [(*, Number)]) (b :: [(*, Number)]) f = Value f
         {-# INLINE showunit' #-}
         showunit' _ = ""
 
-instance (Convertible a b, MapEq a a' True) => Convertible' a' ('(b, POne) ': '[]) where
+instance (Convertible a b, MapEq a a') => Convertible' a' ('(b, POne) ': '[]) where
         {-# INLINE factor' #-}
         factor' _ = factor (undefined :: ValueProxy a b)
         {-# INLINE showunit' #-}
                   MapTimes value neg_unit_dimension times_neg_unit_dimension, MapMerge times_neg_unit_dimension dimension rec_dimension,
                   Convertible unit_dimension unit) => Convertible' dimension ('(unit, value) ': rest) where
         factor' _ = let
-                                        rec = factor' (undefined :: ValueProxy' rec_dimension rest)
-                                in rec * ((factor (undefined :: ValueProxy unit_dimension unit)) ^^ (fromNumber (undefined :: NumberProxy value)))
+                        rec = factor' (undefined :: ValueProxy' rec_dimension rest)
+                    in rec * ((factor (undefined :: ValueProxy unit_dimension unit)) ^^ (fromNumber (undefined :: NumberProxy value)))
         showunit' _ = let
-                                        rec = showunit' (undefined :: ValueProxy' rec_dimension rest)
-                                        power = fromNumber (undefined :: NumberProxy value)
-                                  in (if null rec then "" else rec) ++ (if (not $ null rec) && (power /= 0) then "⋅" else "") ++ (if power /= 0 then (showunit (undefined :: ValueProxy a'' unit)) ++ if power /= 1 then map toSuperScript $ show power else "" else "")
+                          rec = showunit' (undefined :: ValueProxy' rec_dimension rest)
+                          power = fromNumber (undefined :: NumberProxy value)
+                      in rec
+                          ++ (if (not $ null rec) && (power /= 0) then "⋅" else "")
+                          ++ (if power /= 0
+                              then (showunit (undefined :: ValueProxy a'' unit))
+                                    ++ if power /= 1
+                                       then map toSuperScript $ show power
+                                       else ""
+                              else "")
 
 toSuperScript :: Char -> Char
 toSuperScript '0' = '\8304'
 --
 -- >>> coerce (120 *| meter / second) (kilo meter / hour)
 -- 432.0 km/h
-coerce :: (Convertible' a b, Convertible' c d, Fractional f, MapEq a c True) => Value a b f -> Value c d f -> Value c d f
-{-# INLINE coerce #-}
-coerce u _ = let result = mkVal (factor' (proxy' u) * val u / factor' (proxy' result)) in result
+coerce :: (Convertible' a b, Convertible' c d, Fractional f, MapEq a c) => Value a b f -> Value c d f -> Value c d f
+{-# INLINE[1] coerce #-}
+coerce u into = mkVal (factor' (proxy' u) * val u / factor' (proxy' into))
+
+{-# RULES
+"coerce/id" [10] forall (x :: Value a b f) (u :: Value a b f) . coerce u x = u
+"coerce/twice" [10] forall (x :: Value a b f) (y :: Value a d f) (u :: Value a i f) . coerce (coerce u y) x = coerce u x
+"coerce/twice2" [10] forall (x :: Value a b f) (y :: Value a d f) (u :: Value a i f) . coerce u (coerce y x) = coerce u x
+  #-}
 
 infixl 5 `as`
 
 -- |Shorthand for 'coerce'.
-as :: (Convertible' a b, Convertible' c d, Fractional f, MapEq a c True) => Value a b f -> Value c d f -> Value c d f
-{-# INLINE as #-}
+as :: (Convertible' a b, Convertible' c d, Fractional f, MapEq a c) => Value a b f -> Value c d f -> Value c d f
+{-# INLINE[20] as #-}
 as = coerce
 
 -- |Shorthand for 'flip' 'coerce'
-to :: (Convertible' a b, Convertible' c d, Fractional f, MapEq a c True) => Value c d f -> Value a b f -> Value c d f
-{-# INLINE to #-}
+to :: (Convertible' a b, Convertible' c d, Fractional f, MapEq a c) => Value c d f -> Value a b f -> Value c d f
+{-# INLINE[20] to #-}
 to = flip coerce
 
 infixl 7 |*|, |/|
 -- |Multiply two values, constructing a value with as dimension the product of the dimensions,
 -- and as unit the multplication of the units.
 (|*|) :: (Fractional f, Convertible' a b, Convertible' c d, MapMerge a c u, MapMerge b d s) => Value a b f -> Value c d f -> Value u s f
+{-# INLINE (|*|) #-}
 a |*| b = mkVal (val a * val b)
 
 -- |Divide two values, constructing a value with as dimension the division of the dimension of the lhs by the dimension of the rhs,
 -- and the same for the units.
 (|/|), per :: (Fractional f, Convertible' a b, Convertible' c d, MapMerge a c' u, MapNeg c c', MapNeg d d', MapMerge b d' s) => Value a b f -> Value c d f -> Value u s f
+{-# INLINE (|/|) #-}
 a |/| b = mkVal (val a / val b)
+{-# INLINE per #-}
 per = (|/|)
 
 -- |Add two values with matching dimensions. Units are automatically resolved. The result will have the same unit as the lhs.
-(|+|) :: (Fractional f, Convertible' a b, Convertible' c d, MapEq c a True) => Value a b f -> Value c d f -> Value a b f
-a |+| b = mkVal (val a + val (coerce b a))
+(|+|) :: (Fractional f, Convertible' a b, Convertible' c d, MapEq c a) => Value a b f -> Value c d f -> Value a b f
+{-# INLINE (|+|) #-}
+a |+| b = fmap (+ val (coerce b a)) a
 
 -- |Subtract two values with matching dimensions. Units are automatically resolved. The result will have the same unit as the lhs.
-(|-|) :: (Fractional f, Convertible' a b, Convertible' c d, MapEq c a True) => Value a b f -> Value c d f -> Value a b f
-a |-| b = mkVal (val a - val (coerce b a))
+(|-|) :: (Fractional f, Convertible' a b, Convertible' c d, MapEq c a) => Value a b f -> Value c d f -> Value a b f
+{-# INLINE (|-|) #-}
+a |-| b = fmap (\x -> x - val (coerce b a)) a
 
 infixl 9 *|, |*, |/, /|
 infixl 8 +|, |+, -|, |-
 
 -- |Multiply a scalar by a unit.
 (*|) :: (Convertible' a b, Fractional f) => f -> Value a b f -> Value a b f
-d *| u = mkVal (d * val u)
+{-# INLINE (*|) #-}
+d *| u = fmap (d*) u
 
 -- |Multiply a unit by a scalar.
 (|*) :: (Convertible' a b, Fractional f) => Value a b f -> f -> Value a b f
-u |* d = mkVal (val u * d)
+{-# INLINE (|*) #-}
+u |* d = fmap (*d) u
 
 -- |Divide a scalar by a unit.
 (/|) :: (Convertible' a b, Fractional f, MapNeg a a', MapNeg b b') => f -> Value a b f -> Value a' b' f
+{-# INLINE (/|) #-}
 d /| u = mkVal (d / val u)
 
 -- |Divide a unit by a scalar.
 (|/) :: (Convertible' a b, Fractional f) => Value a b f -> f -> Value a b f
-u |/ d = mkVal (val u / d)
+{-# INLINE (|/) #-}
+u |/ d = fmap (/d) u
 
 -- |Add a unit to a scalar.
 (+|) :: (Convertible' a b, Fractional f) => f -> Value a b f -> Value a b f
-d +| u = mkVal (d + val u)
+{-# INLINE (+|) #-}
+d +| u = fmap (d+) u
 
 -- |Add a scalar to a unit.
 (|+) :: (Convertible' a b, Fractional f) => Value a b f -> f -> Value a b f
-u |+ d = mkVal (val u + d)
+{-# INLINE (|+) #-}
+u |+ d = fmap (+d) u
 
 -- |Subtract a unit from a scalar.
 (-|) :: (Convertible' a b, Fractional f) => f -> Value a b f -> Value a b f
-d -| u = mkVal (d - val u)
+{-# INLINE (-|) #-}
+d -| u = fmap (d-) u
 
 -- |Subtract a scalar from a unit.
 (|-) :: (Convertible' a b, Fractional f) => Value a b f -> f -> Value a b f
-u |- d = mkVal (val u - d)
+{-# INLINE (|-) #-}
+u |- d = fmap (\x -> x - d) u
 
 -- |Create a new value with given scalar as value.
 mkVal :: f -> Value a b f
 {-# INLINE val #-}
 val (Value f) = f
 
-instance (Enum f) => Enum (Value a b f) where
-    succ = mkVal . succ . val
-    pred = mkVal . pred . val
-    toEnum = mkVal . toEnum
-    fromEnum = fromEnum . val
+deriving instance (Enum f) => Enum (Value a b f)
 
 deriving instance (Eq f) => Eq (Value a b f)
 
 instance Functor (Value a b) where
+    {-# INLINE fmap #-}
     fmap f = mkVal . f . val
 
 instance Monad (Value a b) where
 {-# INLINE cubic #-}
 cubic x = x |*| x |*| x
 
-wrapB :: (Convertible' a b, Convertible' c d, MapEq c a True) => (Rational -> Rational -> Bool) -> Value a b Rational -> Value c d Rational -> Bool
+wrapB :: (Convertible' a b, Convertible' c d, MapEq c a) => (Rational -> Rational -> Bool) -> Value a b Rational -> Value c d Rational -> Bool
+{-# INLINE wrapB #-}
 wrapB op a b = op (val a) (val $ coerce b a)
 
 infixl 4 |==|, |<|, |>|, |<=|, |>=|
 
-(|==|), (|<|), (|>|), (|<=|), (|>=|) :: (Convertible' a b, Convertible' c d, MapEq c a True) => Value a b Rational -> Value c d Rational -> Bool
+(|==|), (|<|), (|>|), (|<=|), (|>=|) :: (Convertible' a b, Convertible' c d, MapEq c a) => Value a b Rational -> Value c d Rational -> Bool
 -- |'==' for values. Only defined for values with rational contents. Can be used on any two values with the same dimension.
+{-# INLINE (|==|) #-}
 (|==|) = wrapB (==)
 -- |'<' on values. Only defined for values with rational contents. Can be used on any two values with the same dimension.
+{-# INLINE (|<|) #-}
 (|<|) = wrapB (<)
 -- |'<=' on values. Only defined for values with rational contents. Can be used on any two values with the same dimension.
+{-# INLINE (|<=|) #-}
 (|<=|) = wrapB (<=)
 -- |'>' on values. Only defined for values with rational contents. Can be used on any two values with the same dimension.
+{-# INLINE (|>|) #-}
 (|>|) = wrapB (>)
 -- |'>=' on values. Only defined for values with rational contents. Can be used on any two values with the same dimension.
+{-# INLINE (|>=|) #-}
 (|>=|) = wrapB (>=)
 
 ----

src/UnitTyped/NoPrelude.hs

 (/) = (|/|)
 
 -- |See '|+|'
-(+) :: (Fractional f, Convertible' a b, Convertible' c d, MapEq c a True) => Value a b f -> Value c d f -> Value a b f
+(+) :: (Fractional f, Convertible' a b, Convertible' c d, MapEq c a) => Value a b f -> Value c d f -> Value a b f
 (+) = (|+|)
 
 -- |See '|-|'
-(-) :: (Fractional f, Convertible' a b, Convertible' c d, MapEq c a True) => Value a b f -> Value c d f -> Value a b f
+(-) :: (Fractional f, Convertible' a b, Convertible' c d, MapEq c a) => Value a b f -> Value c d f -> Value a b f
 (-) = (|-|)
 
 wrap1 :: (Floating f, Convertible' '[] b) => (f -> f) -> Value '[] b f -> Value '[] '[] f
 
 infixl 5 ==, <, <=, >, >=
 
-(==), (<), (<=), (>), (>=) :: (Convertible' a b, Convertible' c d, MapEq c a 'True) => Value a b Prelude.Rational -> Value c d Prelude.Rational -> Bool
+(==), (<), (<=), (>), (>=) :: (Convertible' a b, Convertible' c d, MapEq c a) => Value a b Prelude.Rational -> Value c d Prelude.Rational -> Bool
 -- |See '|==|'
 (==) = (|==|)
 -- |See '|<|'

src/UnitTyped/SI/Meta.hs

 
 -- |Take a unit and return one deca(unit).
 deca :: (Convertible a b, Fractional f) => Value a (U b) f -> Value a (U (Deca b)) f
+{-# INLINE deca #-}
 deca (Value x) = (Value x)
 
 -- |Take a unit and return one hecto(unit).
 hecto :: (Convertible a b, Fractional f) => Value a (U b) f -> Value a (U (Hecto b)) f
+{-# INLINE hecto #-}
 hecto (Value x) = (Value x)
 
 -- |Take a unit and return one kilo(unit).
 kilo :: (Convertible a b, Fractional f) => Value a (U b) f -> Value a (U (Kilo b)) f
+{-# INLINE kilo #-}
 kilo (Value x) = (Value x)
 
 -- |Take a unit and return one mega(unit).

src/UnitTyped/SI/Show.hs

 -- |Start a chain of units. For example:
 --
 -- > format_end second $ format minute $ format_start hour x
-format_start :: (Convertible' a b, Convertible' c d, MapEq a c 'True) => Value c d Rational -> Value a b Rational -> (String, Value c d Rational)
+format_start :: (Convertible' a b, Convertible' c d, MapEq a c) => Value c d Rational -> Value a b Rational -> (String, Value c d Rational)
 format_start u v = format u ("", (NP.abs v) `as` u)
 
 -- |Add a unit in between 'format_start' and 'format_end'.
 format_end u (s, v) = (s ++ (if val v == 0 then "" else ((if not $ null s then ", " else "") ++ (show $ fromRational $ val (coerce v u)) ++ " " ++ (showunit' $ proxy' u))))
 
 -- |Show a time range as years, days, hours, minutes, seconds and miliseconds.
-time_str :: (Convertible' a b, MapEq a TimeDimension 'True) => Value a b Rational -> String
+time_str :: (Convertible' a b, MapEq a TimeDimension) => Value a b Rational -> String
 time_str = format_end (mili second) . format second . format minute . format hour . format day . format_start year
 
 -- |Show a unit with all possible SI-prefixes.
 --
 -- >>> meta_str meter (c |*| 1 *| year)
 -- "9 Pm, 460 Tm, 536 Gm, 207 Mm, 68 km, 16 m"
-meta_str :: (Convertible' a b, Convertible c d, MapEq a c 'True) => Value c (U d) Rational -> Value a b Rational -> String
+meta_str :: (Convertible' a b, Convertible c d, MapEq a c) => Value c (U d) Rational -> Value a b Rational -> String
 meta_str unit v = format_end (yocto unit) $ format (zepto unit) $ format (atto unit) $ format (femto unit)
 					$ format (pico unit) $ format (nano unit) $ format (micro unit) $ format (mili unit)
 					$ format unit $ format (kilo unit) $ format (mega unit) $ format (giga unit)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.