diff --git a/Makefile b/Makefile new file mode 100644 --- /dev/null +++ b/Makefile @@ -0,0 +1,1 @@ +include ../cho-home-cabal-make.inc diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,8 @@ +See http://haskell.org/haskellwiki/lub for a description of the lub package. + +You can configure, build, and install all in the usual way with Cabal +commands. + + runhaskell Setup.lhs configure + runhaskell Setup.lhs build + runhaskell Setup.lhs install diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/lub.cabal b/lub.cabal new file mode 100644 --- /dev/null +++ b/lub.cabal @@ -0,0 +1,36 @@ +Name: lub +Version: 0.0.0 +Cabal-Version: >= 1.2 +Synopsis: least upper bounds -- information merging +Category: Concurrency, Data, Other +Description: + Lub is an experiment in computing least upper information bounds on + (partially defined) functional values. It provides a 'lub' function + that is consistent with the 'unamb' operator but has a more liberal + precondition. Where 'unamb' requires its arguments to equal when + neither is bottom, 'lub' is able to synthesize a value from the + partial information contained in both of its arguments. + . + Project wiki page: + . + © 2008 by Conal Elliott; BSD3 license. +Author: Conal Elliott +Maintainer: conal@conal.net +Homepage: http://haskell.org/haskellwiki/lub +Package-Url: http://code.haskell.org/lub +Copyright: (c) 2008 by Conal Elliott +License: BSD3 +Stability: experimental +build-type: Simple + +Library + hs-Source-Dirs: src + Extensions: + Build-Depends: base, unamb >= 0.1.0 + Exposed-Modules: + Data.Repr + Data.Lub + + ghc-options: -Wall + +-- ghc-prof-options: -prof -auto-all diff --git a/src/Data/AssocRepr.hs b/src/Data/AssocRepr.hs new file mode 100644 --- /dev/null +++ b/src/Data/AssocRepr.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE TypeFamilies, FlexibleContexts #-} +{-# OPTIONS_GHC -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Data.AssocRepr +-- Copyright : (c) Conal Elliott 2008 +-- License : BSD3 +-- +-- Maintainer : conal@conal.net +-- Stability : experimental +-- +-- Compute least upper bounds (lub / join) of two values +-- +-- This version uses associated types for HasRepr +---------------------------------------------------------------------- + +module Data.AssocRepr (HasRepr(..), onRepr, onRepr2) where + +-- Reprs. TODO: find & use a simple, standard generic programming framework. + +class HasRepr t where + type Repr t + repr :: t -> Repr t + unrepr :: Repr t -> t + +-- | Apply a binary function on a repr +onRepr :: (HasRepr a, HasRepr b) => + (Repr a -> Repr b) + -> (a -> b) +onRepr h = unrepr . h . repr + +-- | Apply a binary function on a repr +onRepr2 :: (HasRepr a, HasRepr b, HasRepr c) => + (Repr a -> Repr b -> Repr c) + -> (a -> b -> c) +onRepr2 op a b = unrepr (repr a `op` repr b) + + +-- Repr instances + +instance HasRepr (Maybe a) where + type Repr (Maybe a) = Either () a + + repr Nothing = (Left ()) + repr (Just a) = (Right a) + + unrepr (Left ()) = Nothing + unrepr (Right a) = (Just a) + + +instance HasRepr [a] where + type Repr [a] = Either () (a,[a]) + + repr [] = (Left ()) + repr (a:as) = (Right (a,as)) + + unrepr (Left ()) = [] + unrepr (Right (a,as)) = (a:as) + +-- ... diff --git a/src/Data/Lub.hs b/src/Data/Lub.hs new file mode 100644 --- /dev/null +++ b/src/Data/Lub.hs @@ -0,0 +1,180 @@ +{-# LANGUAGE TypeFamilies, FlexibleContexts #-} +{-# OPTIONS_GHC -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Data.Lub +-- Copyright : (c) Conal Elliott 2008 +-- License : BSD3 +-- +-- Maintainer : conal@conal.net +-- Stability : experimental +-- +-- Compute least upper bound ('lub') of two values, with respect to +-- information content. I.e., merge the information available in each. +---------------------------------------------------------------------- + +module Data.Lub + ( + -- * Least upper bounds + HasLub(..), bottom, flatLub + -- * Some useful special applications of 'lub' + , parCommute, por, pand, ptimes + ) where + +import Data.Unamb + +import Data.Repr + +-- | Types that support information merging ('lub') +class HasLub a where + -- | Least upper information bound. Combines information available from + -- each argument. The arguments must be consistent, i.e., must have a + -- common upper bound. + lub :: a -> a -> a + +instance HasLub () where _ `lub` _ = () + +-- | A 'lub' for flat domains. Equivalent to 'unamb'. Handy for defining +-- 'HasLub' instances, e.g., +-- +-- @ +-- instance HasLub Integer where lub = flatLub +-- @ + +flatLub :: a -> a -> a +flatLub = unamb + +-- Flat types: +instance HasLub Bool where lub = flatLub +instance HasLub Char where lub = flatLub +instance HasLub Int where lub = flatLub +instance HasLub Integer where lub = flatLub +instance HasLub Float where lub = flatLub +instance HasLub Double where lub = flatLub +-- ... + + +-- Lub on pairs +-- pairLub :: (HasLub a, HasLub b) => +-- (a,b) -> (a,b) -> (a,b) + +-- Too strict. Bottom if one pair is bottom +-- +-- (a,b) `pairLub` (a',b') = (a `lub` a', b `lub` b') + +-- Too lazy. Non-bottom even if both pairs are bottom +-- +-- ~(a,b) `pairLub` ~(a',b') = (a `lub` a', b `lub` b') + +-- Probably correct, but more clever than necessary, and less efficient. +-- +-- p `pairLub` p' = assuming (isP p `por` isP p') +-- (a `lub` a', b `lub` b') +-- where +-- ~(a ,b ) = p +-- ~(a',b') = p' +-- +-- isP :: (a,b) -> Bool +-- isP (_,_) = True + + +instance (HasLub a, HasLub b) => HasLub (a,b) where + p `lub` p' = (p `unamb` p') `seq` + (a `lub` a', b `lub` b') + where + ~(a ,b ) = p + ~(a',b') = p' + +instance (HasLub a, HasLub b) => HasLub (Either a b) where + u `lub` v = if isL u `unamb` isL v then + Left (outL u `lub` outL v) + else + Right (outR u `lub` outR v) + +isL :: Either a b -> Bool +isL = either (const True) (const False) + +outL :: Either a b -> a +outL = either id (error "outL on Right") + +outR :: Either a b -> b +outR = either (error "outR on Left") id + +-- Generic case +-- instance (HasRepr t v, HasLub v) => HasLub t where lub = repLub + +-- For instance, +instance HasLub a => HasLub (Maybe a) where lub = repLub +instance HasLub a => HasLub [a] where lub = repLub + + +-- 'lub' on representations +repLub :: (HasRepr a v, HasLub v) => a -> a -> a +repLub = onRepr2 lub + + +{- + +-- Examples: + +(bottom,False) `lub` (True,bottom) + +(bottom,(bottom,False)) `lub` ((),(bottom,bottom)) `lub` (bottom,(True,bottom)) + +Left () `lub` bottom :: Either () Bool + +[1,bottom,2] `lub` [bottom,3,2] + +-} + + +{-------------------------------------------------------------------- + Some useful special applications of 'unamb' +--------------------------------------------------------------------} + +-- | Turn a binary commutative operation into that tries both orders in +-- parallel, 'lub'-merging the results. Useful when there are special +-- cases that don't require evaluating both arguments. +parCommute :: HasLub a => (a -> a -> a) -> (a -> a -> a) +parCommute op a b = (a `op` b) `lub` (b `op` a) + +-- | Parallel or +por :: Bool -> Bool -> Bool +por = parCommute (||) + +-- | Parallel and +pand :: Bool -> Bool -> Bool +pand = parCommute (&&) + +-- | Multiplication optimized for either argument being zero or one, where +-- the other might be expensive/delayed. +ptimes :: (HasLub a, Num a) => a -> a -> a +ptimes = parCommute times + where + 0 `times` _ = 0 + 1 `times` b = b + a `times` b = a*b + +-- I don't think this pplus is useful, since both arguments have to get +-- evaluated anyway. +-- +-- -- | Addition optimized for either argument being zero, where the other +-- -- might be expensive/delayed. +-- pplus :: (HasLub a, Num a) => a -> a -> a +-- pplus = parCommute plus +-- where +-- 0 `plus` b = b +-- a `plus` b = a+b + + +{- + +-- Examples: + +0 * bottom :: Integer +0 `ptimes` bottom :: Integer + +bottom `ptimes` 0 :: Integer + +-} + diff --git a/src/Data/Repr.hs b/src/Data/Repr.hs new file mode 100644 --- /dev/null +++ b/src/Data/Repr.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances + , FunctionalDependencies + #-} +{-# OPTIONS_GHC -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Data.Repr +-- Copyright : (c) Conal Elliott 2008 +-- License : BSD3 +-- +-- Maintainer : conal@conal.net +-- Stability : experimental +-- +-- Compute least upper bounds (lub / join) of two values +-- +-- This version uses associated types for HasRepr +---------------------------------------------------------------------- + +module Data.Repr (HasRepr(..), onRepr, onRepr2) where + +-- Reprs. TODO: find & use a simple, standard generic programming framework. + +-- | A data type representation, in terms of standard data types. +-- Requires that @'unrepr' . 'repr' == 'id'@. +class HasRepr t r | t -> r where + repr :: t -> r -- ^ to representation + unrepr :: r -> t -- ^ from representation + +-- | Apply a binary function on a repr +onRepr :: (HasRepr a ra, HasRepr b rb) => + (ra -> rb) -> (a -> b) +onRepr h = unrepr . h . repr + +-- | Apply a binary function on a repr +onRepr2 :: (HasRepr a ra, HasRepr b rb, HasRepr c rc) => + (ra -> rb -> rc) -> (a -> b -> c) +onRepr2 h a b = unrepr (h (repr a) (repr b)) + +-- Equivalently: +-- +-- onRepr2 h a = unrepr . h (repr a) . repr +-- +-- onRepr2 h a = onRepr (h (repr a)) +-- +-- onRepr2 h = onRepr . h . repr + + + +-- Some HasRepr instances + +instance HasRepr (Maybe a) (Either () a) where + repr Nothing = (Left ()) + repr (Just a) = (Right a) + + unrepr (Left ()) = Nothing + unrepr (Right a) = (Just a) + + +instance HasRepr [a] (Either () (a,[a])) where + repr [] = (Left ()) + repr (a:as) = (Right (a,as)) + + unrepr (Left ()) = [] + unrepr (Right (a,as)) = (a:as) + +-- ... diff --git a/wikipage.tw b/wikipage.tw new file mode 100644 --- /dev/null +++ b/wikipage.tw @@ -0,0 +1,15 @@ +[[Category:Packages]] + +== Abstract == + +Lub is an experiment in computing least upper information bounds on (partially defined) functional values. +It provides a lub function that is consistent with the unamb operator but has a more liberal precondition. +Where unamb requires its arguments to equal when neither is bottom, lub is able to synthesize a value from the partial information contained in both of its arguments. + +Besides this wiki page, here are more ways to find out about lub: +* Visit the [http://hackage.haskell.org/cgi-bin/hackage-scripts/package/lub Hackage page] for library documentation and to download & install. +* Or install with cabal install lub. +* Get the code repository: darcs get http://code.haskell.org/lub. + + +Please leave comments at the [[Talk:lub|Talk page]].