twentefp-number (empty) → 0.1.0.0

raw patch · 6 files changed

+295/−0 lines, 6 filesdep +basedep +parsecsetup-changed

Dependencies added: base, parsec

Files

LICENSE +30/−0
Setup.hs +2/−0
src/FPPrac.hs +8/−0
src/FPPrac/Prelude.hs +99/−0
src/FPPrac/Prelude/Number.hs +137/−0
twentefp-number.cabal +19/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2014, Christiaan Baaij & Sebastiaan la Fleur
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Christiaan Baaij & Sebastiaan la Fleur nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

+ src/FPPrac.hs view

@@ -0,0 +1,8 @@+module FPPrac +  ( module FPPrac.Prelude+  )+where++import FPPrac.Prelude++default (Number)

+ src/FPPrac/Prelude.hs view

@@ -0,0 +1,99 @@+-- | The 'FPPrac.Prelude' defines the 'Number' type (which is like Amanda's+-- 'num' type), and hides the intricacies of Haskell's Type Classes+-- from new users when dealing with number. Also defines corresponding+-- 'Prelude' functions that use this new 'Number' type.+module FPPrac.Prelude+  ( module Prelude+  , Number+  , ord+  , chr+  , length+  , (!!)+  , replicate+  , take+  , drop+  , splitAt+  )+where++import Prelude hiding (length,(!!),replicate,take,drop,splitAt)+import qualified Prelude as P+import qualified Data.Char (ord,chr)++import FPPrac.Prelude.Number++default (Number)+infixl 9 !!++ord :: Char -> Number+ord = I . toInteger . Data.Char.ord++chr :: Number -> Char+chr (I i) = Data.Char.chr (fromInteger i)+chr n     = error $ "ord undefined for float: " ++ show n++-- | /O(n)/. 'length' returns the length of a finite list as a 'Number'.+length :: [a] -> Number+length = I . toInteger . P.length++-- | List index (subscript) operator, starting from 0.+(!!) :: [a] -> Number -> a+xs !! (I i) = xs P.!! fromInteger i+_  !! _     = error "trying to index (!!) using a floating number"++-- | 'replicate' @n x@ is a list of length @n@ with @x@ the value of+-- every element.+--+-- Fails when @n@ is not an integral number+replicate :: Number -> a -> [a]+replicate (I i) a = P.replicate (fromInteger i) a+replicate _     _ = error "replicate undefined for float"++-- | 'take' @n@, applied to a list @xs@, returns the prefix of @xs@+-- of length @n@, or @xs@ itself if @n > 'length' xs@:+--+-- > take 5 "Hello World!" == "Hello"+-- > take 3 [1,2,3,4,5] == [1,2,3]+-- > take 3 [1,2] == [1,2]+-- > take 3 [] == []+-- > take (-1) [1,2] == []+-- > take 0 [1,2] == []+--+-- Fails when @n@ is not an integral number+take :: Number -> [a] -> [a]+take (I i) xs = P.take (fromInteger i) xs+take _     _  = error "take undefined for float"++-- | 'drop' @n xs@ returns the suffix of @xs@+-- after the first @n@ elements, or @[]@ if @n > 'length' xs@:+--+-- > drop 6 "Hello World!" == "World!"+-- > drop 3 [1,2,3,4,5] == [4,5]+-- > drop 3 [1,2] == []+-- > drop 3 [] == []+-- > drop (-1) [1,2] == [1,2]+-- > drop 0 [1,2] == [1,2]+--+-- Fails when @n@ is not an integral number+drop :: Number -> [a] -> [a]+drop (I i) xs = P.drop (fromInteger i) xs+drop _     _  = error "drop undefined for float"++-- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of+-- length @n@ and second element is the remainder of the list:+--+-- > splitAt 6 "Hello World!" == ("Hello ","World!")+-- > splitAt 3 [1,2,3,4,5] == ([1,2,3],[4,5])+-- > splitAt 1 [1,2,3] == ([1],[2,3])+-- > splitAt 3 [1,2,3] == ([1,2,3],[])+-- > splitAt 4 [1,2,3] == ([1,2,3],[])+-- > splitAt 0 [1,2,3] == ([],[1,2,3])+-- > splitAt (-1) [1,2,3] == ([],[1,2,3])+--+-- It is equivalent to @('take' n xs, 'drop' n xs)@ when @n@ is not @_|_@+-- (@splitAt _|_ xs = _|_@).+--+-- Fails when @n@ is not an integral number+splitAt :: Number -> [a] -> ([a],[a])+splitAt (I i) xs = P.splitAt (fromInteger i) xs+splitAt _     _  = error "splitAt undefined for float"

+ src/FPPrac/Prelude/Number.hs view

@@ -0,0 +1,137 @@+module FPPrac.Prelude.Number+  ( Number(..)+  )+where++import Text.ParserCombinators.Parsec+import qualified Text.ParserCombinators.Parsec.Token as PT+import Text.ParserCombinators.Parsec.Language (emptyDef)++-- | Combined integral and floating number type+data Number+  = I Integer+  | F Double++instance Eq Number where+  (I i1) == (I i2) = i1 == i2+  (F f1) == (F f2) = f1 == f2+  (I i1) == (F f2) = fromIntegral i1 == f2+  (F f1) == (I i2) = f1 == fromIntegral i2++instance Ord Number where+  compare (I i1) (I i2) = compare i1 i2+  compare (F f1) (F f2) = compare f1 f2+  compare (I i1) (F f2) = compare (fromIntegral i1) f2+  compare (F f1) (I i2) = compare f1 (fromIntegral i2)++instance Show Number where+  show (I i) = show i+  show (F f) = show f++instance Num Number where+  (I i1) + (I i2) = I (i1 + i2)+  (F f1) + (F f2) = F (f1 + f2)+  (I i1) + (F f2) = F ((fromInteger i1) + f2)+  (F f1) + (I i2) = F (f1 + (fromInteger i2))+  (I i1) * (I i2) = I (i1 * i2)+  (F f1) * (F f2) = F (f1 * f2)+  (I i1) * (F f2) = F ((fromInteger i1) * f2)+  (F f1) * (I i2) = F (f1 * (fromInteger i2))+  negate (I i)    = I (negate i)+  negate (F f)    = F (negate f)+  abs (I i)       = I (abs i)+  abs (F f)       = F (abs f)+  signum (I i)    = I (signum i)+  signum (F f)    = F (signum f)+  fromInteger     = I++instance Real Number where+  toRational (I i) = toRational i+  toRational (F f) = toRational f++instance Enum Number where+  toEnum         = I . toInteger+  fromEnum (I i) = fromEnum i+  fromEnum (F f) = fromEnum f++instance Integral Number where+  quotRem (I i1) (I i2) = let (i1',i2') = quotRem i1 i2 in (I i1', I i2')+  quotRem (F _)      _  = error "quotRem: first argument is not an integer"+  quotRem _      (F _)  = error "quotRem: second argument is not an integer"+  divMod  (I i1) (I i2) = let (i1',i2') = divMod i1 i2 in (I i1', I i2')+  divMod (F _)      _   = error "divMod: first argument is not an integer"+  divMod _      (F _)   = error "divMod: second argument is not an integer"+  toInteger (I i)       = i+  toInteger (F _)       = error "Can not use 'toInteger' to convert float to integer"++instance Fractional Number where+  (/) (I i1) (I i2) = F $ (fromInteger i1) / (fromInteger i2)+  (/) (F d1) (F d2) = F $ d1 / d2+  (/) (F d1) (I i2) = F $ d1 / (fromInteger i2)+  (/) (I i1) (F d2) = F $ (fromInteger i1) / d2+  fromRational      = F . fromRational++instance RealFrac Number where+  properFraction (F f) = let (b,a) = properFraction f in (b, F a)+  properFraction (I i) = let (b,a) = properFraction (fromIntegral i) in (b, F a)+  truncate (F f)       = truncate f+  truncate (I i)       = truncate ((fromIntegral i) :: Float)+  round (F f)          = round f+  round (I i)          = round ((fromIntegral i) :: Float)+  ceiling (F f)        = ceiling f+  ceiling (I i)        = ceiling ((fromIntegral i) :: Float)+  floor (F f)          = floor f+  floor (I i)          = floor ((fromIntegral i) :: Float)++instance Floating Number where+  pi                    = F pi+  exp (F f)             = F (exp f)+  exp (I i)             = F (exp $ fromIntegral i)+  sqrt (F f)            = F (sqrt f)+  sqrt (I i)            = F (sqrt $ fromIntegral i)+  log (F f)             = F (log f)+  log (I i)             = F (log $ fromIntegral i)+  (F f1) ** (F f2)      = F (f1 ** f2)+  (I i1) ** (I i2)      = F ((fromIntegral i1) ** (fromIntegral i2))+  (F f1) ** (I i2)      = F (f1 ** (fromIntegral i2))+  (I i1) ** (F f2)      = F ((fromIntegral i1) ** f2)+  logBase (F f1) (F f2) = F (logBase f1 f2)+  logBase (I i1) (I i2) = F (logBase (fromIntegral i1) (fromIntegral i2))+  logBase (F f1) (I i2) = F (logBase f1 (fromIntegral i2))+  logBase (I i1) (F f2) = F (logBase (fromIntegral i1) f2)+  sin (F f)             = F (sin f)+  sin (I i)             = F (sin $ fromIntegral i)+  tan (F f)             = F (tan f)+  tan (I i)             = F (tan $ fromIntegral i)+  cos (F f)             = F (cos f)+  cos (I i)             = F (cos $ fromIntegral i)+  asin (F f)            = F (asin f)+  asin (I i)            = F (asin $ fromIntegral i)+  atan (F f)            = F (atan f)+  atan (I i)            = F (atan $ fromIntegral i)+  acos (F f)            = F (acos f)+  acos (I i)            = F (acos $ fromIntegral i)+  sinh (F f)            = F (sinh f)+  sinh (I i)            = F (sinh $ fromIntegral i)+  tanh (F f)            = F (tanh f)+  tanh (I i)            = F (tanh $ fromIntegral i)+  cosh (F f)            = F (cosh f)+  cosh (I i)            = F (cosh $ fromIntegral i)+  asinh (F f)           = F (asinh f)+  asinh (I i)           = F (asinh $ fromIntegral i)+  atanh (F f)           = F (atanh f)+  atanh (I i)           = F (atanh $ fromIntegral i)+  acosh (F f)           = F (acosh f)+  acosh (I i)           = F (acosh $ fromIntegral i)++lexer :: PT.TokenParser st+lexer = PT.makeTokenParser emptyDef++naturalOrFloat :: CharParser st (Either Integer Double)+naturalOrFloat = PT.naturalOrFloat lexer++instance Read Number where+  readsPrec _ = either (const []) id . parse parseRead' "" where+    parseRead' = do a <- naturalOrFloat+                    rest <- getInput+                    return [(either I F a, rest)]

+ twentefp-number.cabal view

@@ -0,0 +1,19 @@+name:                twentefp-number
+version:             0.1.0.0
+synopsis:            Lab Assignments Environment at Univeriteit Twente
+description:         Lab Assignments Environment at Univeriteit Twente
+license:             BSD3
+license-file:        LICENSE
+author:              Christiaan Baaij & Sebastiaan la Fleur
+maintainer:          sebastiaan.la.fleur@gmail.com          
+category:            Education
+build-type:          Simple
+cabal-version:       >=1.8
+
+library
+  exposed-modules:     FPPrac
+  other-modules:       FPPrac.Prelude, 
+                       FPPrac.Prelude.Number
+  build-depends:       base ==4.6.*, 
+                       parsec ==3.1.*
+  hs-source-dirs:      src