diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright (c) 2009 Bas van Dijk + +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. + + * The name of Bas van Dijk and the names of contributors may NOT + 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/Repr.hs b/Repr.hs new file mode 100644 --- /dev/null +++ b/Repr.hs @@ -0,0 +1,307 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Repr + ( Repr + , value + , renderer + , Renderer + , Precedence + , Fixity(..) + , render + , () + ) where + + +-------------------------------------------------------------------------------- +-- Imports +-------------------------------------------------------------------------------- + +import Data.String ( IsString, fromString ) +import Data.String.ToString ( ToString, toString ) +import Data.String.Combinators ( (<>) + , (<+>) + , between + , paren + , thenParen + , fromShow + , integer + , int + , hsep + ) +import Data.DString ( DString, fromShowS ) +import Control.Applicative ( liftA2 ) + + +-------------------------------------------------------------------------------- +-- Repr +-------------------------------------------------------------------------------- + +-- | @Repr a@ is a value of type @a@ paired with a way to render that value to a +-- string which will contain a representation of the value. +-- +-- Note that @Repr a@ is overloaded for all the numeric classes provided that +-- @a@ has instances for the respected classes. This allows you to write a +-- numeric expression of type @Repr a@. For example: +-- +-- @ +-- *Repr> let rd = 1.5 + 2 + (3 + (-4) * (5 - pi / sqrt 6)) :: Repr Double +-- @ +-- +-- You can extract the value of @rd@: +-- +-- @ +-- *Repr> value rd +-- 17.281195923884734 +-- @ +-- +-- And you can than render @rd@ to its textual representation: +-- +-- @ +-- *Repr> render rd +-- \"fromRational (3 % 2) + fromInteger 2 + (fromInteger 3 + negate (fromInteger 4) * (fromInteger 5 - pi / sqrt (fromInteger 6)))\" +-- @ +data Repr a = S { value :: a -- ^ Extract the value of the @Repr@. + , renderer :: Renderer -- ^ Extrac the renderer of the @Repr@. + } + +-- | To render you need to supply the precedence and fixity of the enclosing +-- context. +-- +-- For more documentation about precedence and fixity see: +-- +-- +-- +-- The reason the renderer returns a 'DString' instead of for example a 'String' +-- is that the rendering of numeric expression involves lots of left-factored +-- appends i.e.: @((a ++ b) ++ c) ++ d@. A 'DString' has a O(1) append operation +-- while a 'String' just has a O(n) append. So choosing a 'DString' is more +-- efficient. +type Renderer = Precedence -> Fixity -> DString + +-- | The precedence of operators and function application. +-- +-- * Operators usually have a precedence in the range of 0 to 9. +-- +-- * Function application always has precedence 10. +type Precedence = Int + +-- | Fixity of operators. +data Fixity = Non -- ^ No fixity information. + | L -- ^ Left associative operator. + | R -- ^ Right associative operator. + deriving Eq + +-- | Render a /top-level/ value to a 'String'. +-- +-- Note that: @render r = 'toString' $ 'renderer' r 0 'Non'@ +render :: Repr a -> String +render r = toString $ renderer r 0 Non + +-- | @x \ s@ annotates the rendering with the given string. +-- +-- The output wil look like: @\"({- s -} ...)\"@ where @...@ is the rendering of +-- @x@. +-- +-- This combinator is handy when you want to render the ouput of a function and +-- you want to see how the parameters of the function contribute to the +-- result. For example, suppose you defined the following function @f@: +-- +-- @ +-- f p0 p1 p2 = p0 ^ 2 + sqrt p1 * ([p2..] !! 10) +-- @ +-- +-- You can then apply @f@ to some parameters annotated with some descriptive +-- strings (the name of the parameter is usally a good idea): +-- +-- @ +-- f (1 \ \"p0\") (2 \ \"p1\") (3 \ \"p2\") +-- @ +-- +-- The rendering will then look like: +-- +-- @ +-- \"({- p0 -} fromInteger 1) * ({- p0 -} fromInteger 1) + sqrt ({- p1 -} (fromInteger 2)) * enumFrom ({- p2 -} (fromInteger 3)) !! 10\" +-- @ +() :: Repr a -> DString -> Repr a +(S x rx) s = S x $ \prec fixity -> paren (between "{- " " -}" s <+> rx prec fixity) + + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +instance Show (Repr a) where + show = render + +instance Num a => Num (Repr a) where + fromInteger = from fromInteger "fromInteger" + (+) = infx L 6 (+) "+" + (-) = infx L 6 (-) "-" + (*) = infx L 7 (*) "*" + negate = app negate "negate" + abs = app abs "abs" + signum = app signum "signum" + +instance Real a => Real (Repr a) where + toRational = to toRational + +instance Integral a => Integral (Repr a) where + quot = app2 quot "quot" + rem = app2 rem "rem" + div = app2 div "div" + mod = app2 mod "mod" + quotRem = tup quotRem "quotRem" + divMod = tup divMod "divMod" + toInteger = to toInteger + +instance Fractional a => Fractional (Repr a) where + (/) = infx L 7 (*) "/" + recip = app recip "recip" + fromRational = from fromRational "fromRational" + +instance Floating a => Floating (Repr a) where + pi = constant pi "pi" + (**) = infx R 8 (**) "**" + logBase = app2 logBase "logBase" + exp = app exp "exp" + sqrt = app sqrt "sqrt" + log = app log "log" + sin = app sin "sin" + tan = app tan "tan" + cos = app cos "cos" + asin = app asin "asin" + atan = app atan "atan" + acos = app acos "acos" + sinh = app sinh "sinh" + tanh = app tanh "tanh" + cosh = app cosh "cosh" + asinh = app asinh "asinh" + atanh = app atanh "atanh" + acosh = app acosh "acosh" + +instance RealFrac a => RealFrac (Repr a) where + properFraction (S x rx) = + let (n, f) = properFraction x + in (n, S f $ "snd" `apply` paren ("properFraction" <+> args [rx])) + +instance RealFloat a => RealFloat (Repr a) where + floatRadix = to floatRadix + floatDigits = to floatDigits + floatRange = to floatRange + decodeFloat = to decodeFloat + encodeFloat = from2 encodeFloat "encodeFloat" + exponent = to exponent + significand = app significand "significand" + scaleFloat i = app (scaleFloat i) ("scaleFloat" <+> int i) + isNaN = to isNaN + isInfinite = to isInfinite + isDenormalized = to isDenormalized + isNegativeZero = to isNegativeZero + isIEEE = to isIEEE + atan2 = app2 atan2 "atan2" + +instance Enum a => Enum (Repr a) where + succ = app succ "succ" + pred = app pred "pred" + toEnum = from toEnum "toEnum" + fromEnum = to fromEnum + enumFrom (S x rx) = enum "From" (enumFrom x) [rx] + enumFromThen (S x rx) (S y ry) = enum "FromThen" (enumFromThen x y) [rx, ry] + enumFromTo (S x rx) (S y ry) = enum "FromTo" (enumFromTo x y) [rx, ry] + enumFromThenTo (S x rx) (S y ry) (S z rz) = enum "FromThenTo" (enumFromThenTo x y z) [rx, ry, rz] + +enum :: DString -> [a] -> [Renderer] -> [Repr a] +enum enumStr xs rxs = zipWith combine [0..] xs + where + combine i y = S y $ \prec fixity -> (prec > 9 || (prec == 9 && fixity /= Non && fixity /= L)) + `thenParen` + ("enum" <> enumStr <+> args rxs <+> "!!" <+> integer i) + +instance Ord a => Ord (Repr a) where + compare = to2 compare + (<) = to2 (<) + (>=) = to2 (>=) + (>) = to2 (>) + (<=) = to2 (<=) + max = app2 max "max" + min = app2 min "min" + +instance Eq a => Eq (Repr a) where + (==) = to2 (==) + (/=) = to2 (/=) + +instance IsString a => IsString (Repr a) where + fromString = liftA2 constant fromString fromShow + + +-------------------------------------------------------------------------------- +-- Utility functions +-------------------------------------------------------------------------------- + +-- | Construct 'Repr' from a given value and string. +constant :: a -> DString -> Repr a +constant x xStr = S x $ \_ _ -> xStr + +-- | Precedence of function application. +funAppPrec :: Precedence +funAppPrec = 10 + +from :: Show a => (a -> b) -> DString -> (a -> Repr b) +from f fStr = \x -> S (f x) $ + \prec _ -> (prec >= funAppPrec) + `thenParen` + (fStr <+> fromShowS (showsPrec funAppPrec x)) + +from2 :: (Show a, Show b) => (a -> b -> c) -> DString -> (a -> b -> Repr c) +from2 f fStr = \x y -> S (f x y) $ + \prec _ -> (prec >= funAppPrec) + `thenParen` + (fStr <+> fromShowS (showsPrec funAppPrec x) + <+> fromShowS (showsPrec funAppPrec y)) + +to :: (a -> b) -> Repr a -> b +to f = f . value + +to2 :: (a -> b -> c) -> Repr a -> Repr b -> c +to2 f x y = f (value x) (value y) + +app :: (a -> b) -> DString -> (Repr a -> Repr b) +app fun funStr = + \(S x rx) -> S (fun x) $ funStr `apply` args [rx] + +app2 :: (a -> b -> c) -> DString -> (Repr a -> Repr b -> Repr c) +app2 fun funStr = + \(S x rx) (S y ry) -> S (fun x y) $ funStr `apply` args [rx, ry] + +infx :: Fixity -> Precedence -> (a -> b -> c) -> DString + -> (Repr a -> Repr b -> Repr c) +infx opFix opPrec op opStr = + \(S x rx) (S y ry) -> + S (x `op` y) $ + \prec fixity -> (prec > opPrec || + (prec == opPrec && + fixity /= Non && + fixity /= opFix)) + `thenParen` + (rx opPrec L <+> opStr <+> ry opPrec R) + +tup :: (a -> b -> (c, d)) -> DString + -> (Repr a -> Repr b -> (Repr c, Repr d)) +tup f fStr = + \(S x rx) (S y ry) -> + let (q, r) = f x y + s = paren (fStr <+> args [rx, ry]) + in ( S q $ "fst" `apply` s + , S r $ "snd" `apply` s + ) + +args :: [Renderer] -> DString +args = hsep . map (\rx -> rx funAppPrec Non) + +apply :: DString -> DString -> Renderer +funStr `apply` argsStr = \prec _ -> (prec >= funAppPrec) + `thenParen` + (funStr <+> argsStr) + + +-- The End --------------------------------------------------------------------- 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/repr.cabal b/repr.cabal new file mode 100644 --- /dev/null +++ b/repr.cabal @@ -0,0 +1,33 @@ +name: repr +version: 0.1 +cabal-version: >= 1.6 +build-type: Simple +stability: experimental +tested-with: GHC ==6.10.4 +author: Bas van Dijk +maintainer: v.dijk.bas@gmail.com +copyright: (c) 2009 Bas van Dijk +license: BSD3 +license-file: LICENSE +category: Numeric, Text +synopsis: Render numeric expressions to their textual representation. +description: This library allows you to render a numeric expression to its + textual representation. For example: + . + @ + *Repr> let rd = 1.5 + 2 + (3 + (-4) * (5 - pi / sqrt 6)) :: Repr Double + *Repr> render rd + \"fromRational (3 % 2) + fromInteger 2 + (fromInteger 3 + negate (fromInteger 4) * (fromInteger 5 - pi / sqrt (fromInteger 6)))\" + @ + +source-repository head + Type: darcs + Location: http://code.haskell.org/~basvandijk/code/repr + +library + build-depends: base >= 3 && < 4.2 + , string-combinators >= 0.4 && < 0.5 + , to-string-class >= 0.1 && < 0.2 + , dstring >= 0.3 && < 0.4 + exposed-modules: Repr + ghc-options: -Wall -O2