diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/FPPrac.hs b/src/FPPrac.hs new file mode 100644 --- /dev/null +++ b/src/FPPrac.hs @@ -0,0 +1,8 @@ +module FPPrac + ( module FPPrac.Prelude + ) +where + +import FPPrac.Prelude + +default (Number) diff --git a/src/FPPrac/Prelude.hs b/src/FPPrac/Prelude.hs new file mode 100644 --- /dev/null +++ b/src/FPPrac/Prelude.hs @@ -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" diff --git a/src/FPPrac/Prelude/Number.hs b/src/FPPrac/Prelude/Number.hs new file mode 100644 --- /dev/null +++ b/src/FPPrac/Prelude/Number.hs @@ -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)] diff --git a/twentefp-number.cabal b/twentefp-number.cabal new file mode 100644 --- /dev/null +++ b/twentefp-number.cabal @@ -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