DrIFT-2.2.3/ 0000777 0000764 0000764 00000000000 10753607202 007445 5 0000000 0000000 DrIFT-2.2.3/code/ 0000777 0000764 0000764 00000000000 10753606147 010366 5 0000000 0000000 DrIFT-2.2.3/code/FunctorM.hs 0000644 0000764 0000764 00000000700 10753606147 012370 0000000 0000000 module FunctorM where import Array class FunctorM f where fmapM :: Monad m => (a -> m b) -> f a -> m (f b) instance FunctorM [] where fmapM f xs = mapM f xs instance FunctorM Maybe where fmapM _ Nothing = return Nothing fmapM f (Just x) = f x >>= return . Just instance Ix i => FunctorM (Array i) where fmapM f a = sequence [ f e >>= return . (,) i | (i,e) <- assocs a] >>= return . array b where b = bounds a DrIFT-2.2.3/code/README.txt 0000644 0000764 0000764 00000000323 10753606147 011776 0000000 0000000 This directory contains various modules which are assosiated with deriving rules. They may either be used as-is or some may require modification or have a suitable replacement in the standard libraries already. DrIFT-2.2.3/code/GhcBinary.hs 0000644 0000764 0000764 00000050632 10753606147 012512 0000000 0000000 {-# OPTIONS -fallow-overlapping-instances #-} -- -- (c) The University of Glasgow 2002 -- -- Binary I/O library, with special tweaks for GHC -- -- Based on the nhc98 Binary library, which is copyright -- (c) Malcolm Wallace and Colin Runciman, University of York, 1998. -- Under the terms of the license for that software, we must tell you -- where you can obtain the original version of the Binary library, namely -- http://www.cs.york.ac.uk/fp/nhc98/ -- arch-tag: 1418e09a-9a18-4dca-a0fc-9262c9d97beb module Binary ( {-type-} Bin, {-class-} Binary(..), {-type-} BinHandle, openBinIO, openBinIO_, openBinMem, -- closeBin, seekBin, tellBin, castBin, writeBinMem, readBinMem, isEOFBin, -- for writing instances: putByte, getByte, -- lazy Bin I/O lazyGet, lazyPut, -- GHC only: ByteArray(..), getByteArray, putByteArray --getBinFileWithDict, -- :: Binary a => FilePath -> IO a --putBinFileWithDict, -- :: Binary a => FilePath -> ModuleName -> a -> IO () ) where --import FastString import FastMutInt import Data.Array.IO import Data.Array import Data.Bits import Data.Int import Data.Word import Data.IORef import Data.Char ( ord, chr ) import Data.Array.Base ( unsafeRead, unsafeWrite ) import Control.Monad ( when ) import Control.Exception ( throwDyn ) import System.IO as IO import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO.Error ( mkIOError, eofErrorType ) import GHC.Real ( Ratio(..) ) import GHC.Exts import GHC.IOBase ( IO(..) ) import GHC.Word ( Word8(..) ) import System.IO ( openBinaryFile ) import PackedString --import Atom import Time import Monad import Data.Array.IArray import Data.Array.Base {- #if __GLASGOW_HASKELL__ < 503 type BinArray = MutableByteArray RealWorld Int newArray_ bounds = stToIO (newCharArray bounds) unsafeWrite arr ix e = stToIO (writeWord8Array arr ix e) unsafeRead arr ix = stToIO (readWord8Array arr ix) #if __GLASGOW_HASKELL__ < 411 newByteArray# = newCharArray# #endif hPutArray h arr sz = hPutBufBAFull h arr sz hGetArray h sz = hGetBufBAFull h sz mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> Exception mkIOError t location maybe_hdl maybe_filename = IOException (IOError maybe_hdl t location "" #if __GLASGOW_HASKELL__ > 411 maybe_filename #endif ) eofErrorType = EOF #ifndef SIZEOF_HSWORD #define SIZEOF_HSWORD WORD_SIZE_IN_BYTES #endif #else type BinArray = IOUArray Int Word8 #endif -} -- #define SIZEOF_HSINT 4 type BinArray = IOUArray Int Word8 --------------------------------------------------------------- -- BinHandle --------------------------------------------------------------- data BinHandle = BinMem { -- binary data stored in an unboxed array off_r :: !FastMutInt, -- the current offset sz_r :: !FastMutInt, -- size of the array (cached) arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) } -- XXX: should really store a "high water mark" for dumping out -- the binary data to a file. | BinIO { -- binary data stored in a file off_r :: !FastMutInt, -- the current offset (cached) hdl :: !IO.Handle -- the file handle (must be seekable) } -- cache the file ptr in BinIO; using hTell is too expensive -- to call repeatedly. If anyone else is modifying this Handle -- at the same time, we'll be screwed. --getUserData :: BinHandle -> UserData --getUserData bh = bh_usr bh --setUserData :: BinHandle -> UserData -> BinHandle --setUserData bh us = bh { bh_usr = us } --------------------------------------------------------------- -- Bin --------------------------------------------------------------- newtype Bin a = BinPtr Int deriving (Eq, Ord, Show, Bounded) castBin :: Bin a -> Bin b castBin (BinPtr i) = BinPtr i --------------------------------------------------------------- -- class Binary --------------------------------------------------------------- class Binary a where put_ :: BinHandle -> a -> IO () put :: BinHandle -> a -> IO (Bin a) get :: BinHandle -> IO a -- define one of put_, put. Use of put_ is recommended because it -- is more likely that tail-calls can kick in, and we rarely need the -- position return value. put_ bh a = do put bh a; return () put bh a = do p <- tellBin bh; put_ bh a; return p putAt :: Binary a => BinHandle -> Bin a -> a -> IO () putAt bh p x = do seekBin bh p; put bh x; return () getAt :: Binary a => BinHandle -> Bin a -> IO a getAt bh p = do seekBin bh p; get bh openBinIO_ :: IO.Handle -> IO BinHandle openBinIO_ h = openBinIO h openBinIO :: IO.Handle -> IO BinHandle openBinIO h = do r <- newFastMutInt writeFastMutInt r 0 return (BinIO r h) openBinMem :: Int -> IO BinHandle openBinMem size | size <= 0 = error "Data.Binary.openBinMem: size must be >= 0" | otherwise = do arr <- newArray_ (0,size-1) arr_r <- newIORef arr ix_r <- newFastMutInt writeFastMutInt ix_r 0 sz_r <- newFastMutInt writeFastMutInt sz_r size return (BinMem ix_r sz_r arr_r) tellBin :: BinHandle -> IO (Bin a) tellBin (BinIO r _) = do ix <- readFastMutInt r; return (BinPtr ix) tellBin (BinMem r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) seekBin :: BinHandle -> Bin a -> IO () seekBin (BinIO ix_r h) (BinPtr p) = do writeFastMutInt ix_r p hSeek h AbsoluteSeek (fromIntegral p) seekBin h@(BinMem ix_r sz_r a) (BinPtr p) = do sz <- readFastMutInt sz_r if (p >= sz) then do expandBin h p; writeFastMutInt ix_r p else writeFastMutInt ix_r p isEOFBin :: BinHandle -> IO Bool isEOFBin (BinMem ix_r sz_r a) = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r return (ix >= sz) isEOFBin (BinIO ix_r h) = hIsEOF h writeBinMem :: BinHandle -> FilePath -> IO () writeBinMem (BinIO _ _) _ = error "Data.Binary.writeBinMem: not a memory handle" writeBinMem (BinMem ix_r sz_r arr_r) fn = do h <- openBinaryFile fn WriteMode arr <- readIORef arr_r ix <- readFastMutInt ix_r hPutArray h arr ix hClose h readBinMem :: FilePath -> IO BinHandle -- Return a BinHandle with a totally undefined State readBinMem filename = do h <- openBinaryFile filename ReadMode filesize' <- hFileSize h let filesize = fromIntegral filesize' arr <- newArray_ (0,filesize-1) count <- hGetArray h arr filesize when (count /= filesize) (error ("Binary.readBinMem: only read " ++ show count ++ " bytes")) hClose h arr_r <- newIORef arr ix_r <- newFastMutInt writeFastMutInt ix_r 0 sz_r <- newFastMutInt writeFastMutInt sz_r filesize return (BinMem ix_r sz_r arr_r) -- expand the size of the array to include a specified offset expandBin :: BinHandle -> Int -> IO () expandBin (BinMem ix_r sz_r arr_r) off = do sz <- readFastMutInt sz_r let sz' = head (dropWhile (<= off) (iterate (* 2) sz)) arr <- readIORef arr_r arr' <- newArray_ (0,sz'-1) sequence_ [ unsafeRead arr i >>= unsafeWrite arr' i | i <- [ 0 .. sz-1 ] ] writeFastMutInt sz_r sz' writeIORef arr_r arr' return () expandBin (BinIO _ _) _ = return () -- no need to expand a file, we'll assume they expand by themselves. -- ----------------------------------------------------------------------------- -- Low-level reading/writing of bytes putWord8 :: BinHandle -> Word8 -> IO () putWord8 h@(BinMem ix_r sz_r arr_r) w = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r -- double the size of the array if it overflows if (ix >= sz) then do expandBin h ix putWord8 h w else do arr <- readIORef arr_r unsafeWrite arr ix w writeFastMutInt ix_r (ix+1) return () putWord8 (BinIO ix_r h) w = do ix <- readFastMutInt ix_r hPutChar h (chr (fromIntegral w)) -- XXX not really correct writeFastMutInt ix_r (ix+1) return () getWord8 :: BinHandle -> IO Word8 getWord8 (BinMem ix_r sz_r arr_r) = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix >= sz) $ ioError (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing) arr <- readIORef arr_r w <- unsafeRead arr ix writeFastMutInt ix_r (ix+1) return w getWord8 (BinIO ix_r h) = do ix <- readFastMutInt ix_r c <- hGetChar h writeFastMutInt ix_r (ix+1) return $! (fromIntegral (ord c)) -- XXX not really correct {-# INLINE putByte #-} putByte :: BinHandle -> Word8 -> IO () putByte bh w = putWord8 bh w {-# INLINE getByte #-} getByte :: BinHandle -> IO Word8 getByte = getWord8 -- ----------------------------------------------------------------------------- -- Primitve Word writes instance Binary Word8 where put_ = putWord8 get = getWord8 instance Binary Word16 where put_ h w = do -- XXX too slow.. inline putWord8? putByte h (fromIntegral (w `shiftR` 8)) putByte h (fromIntegral (w .&. 0xff)) get h = do w1 <- getWord8 h w2 <- getWord8 h return $! ((fromIntegral w1 `shiftL` 8) .|. fromIntegral w2) instance Binary Word32 where put_ h w = do putByte h (fromIntegral (w `shiftR` 24)) putByte h (fromIntegral ((w `shiftR` 16) .&. 0xff)) putByte h (fromIntegral ((w `shiftR` 8) .&. 0xff)) putByte h (fromIntegral (w .&. 0xff)) get h = do w1 <- getWord8 h w2 <- getWord8 h w3 <- getWord8 h w4 <- getWord8 h return $! ((fromIntegral w1 `shiftL` 24) .|. (fromIntegral w2 `shiftL` 16) .|. (fromIntegral w3 `shiftL` 8) .|. (fromIntegral w4)) instance Binary Word64 where put_ h w = do putByte h (fromIntegral (w `shiftR` 56)) putByte h (fromIntegral ((w `shiftR` 48) .&. 0xff)) putByte h (fromIntegral ((w `shiftR` 40) .&. 0xff)) putByte h (fromIntegral ((w `shiftR` 32) .&. 0xff)) putByte h (fromIntegral ((w `shiftR` 24) .&. 0xff)) putByte h (fromIntegral ((w `shiftR` 16) .&. 0xff)) putByte h (fromIntegral ((w `shiftR` 8) .&. 0xff)) putByte h (fromIntegral (w .&. 0xff)) get h = do w1 <- getWord8 h w2 <- getWord8 h w3 <- getWord8 h w4 <- getWord8 h w5 <- getWord8 h w6 <- getWord8 h w7 <- getWord8 h w8 <- getWord8 h return $! ((fromIntegral w1 `shiftL` 56) .|. (fromIntegral w2 `shiftL` 48) .|. (fromIntegral w3 `shiftL` 40) .|. (fromIntegral w4 `shiftL` 32) .|. (fromIntegral w5 `shiftL` 24) .|. (fromIntegral w6 `shiftL` 16) .|. (fromIntegral w7 `shiftL` 8) .|. (fromIntegral w8)) -- ----------------------------------------------------------------------------- -- Primitve Int writes instance Binary Int8 where put_ h w = put_ h (fromIntegral w :: Word8) get h = do w <- get h; return $! (fromIntegral (w::Word8)) instance Binary Int16 where put_ h w = put_ h (fromIntegral w :: Word16) get h = do w <- get h; return $! (fromIntegral (w::Word16)) instance Binary Int32 where put_ h w = put_ h (fromIntegral w :: Word32) get h = do w <- get h; return $! (fromIntegral (w::Word32)) instance Binary Int64 where put_ h w = put_ h (fromIntegral w :: Word64) get h = do w <- get h; return $! (fromIntegral (w::Word64)) -- ----------------------------------------------------------------------------- -- Instances for standard types instance Binary () where put_ bh () = return () get _ = return () -- getF bh p = case getBitsF bh 0 p of (_,b) -> ((),b) instance Binary Bool where put_ bh b = putByte bh (fromIntegral (fromEnum b)) get bh = do x <- getWord8 bh; return $! (toEnum (fromIntegral x)) -- getF bh p = case getBitsF bh 1 p of (x,b) -> (toEnum x,b) instance Binary Char where put_ bh c = put_ bh (fromIntegral (ord c) :: Word32) get bh = do x <- get bh; return $! (chr (fromIntegral (x :: Word32))) -- getF bh p = case getBitsF bh 8 p of (x,b) -> (toEnum x,b) instance Binary Int where -- #if SIZEOF_HSINT == 4 put_ bh i = put_ bh (fromIntegral i :: Int32) get bh = do x <- get bh return $! (fromIntegral (x :: Int32)) -- #elif SIZEOF_HSINT == 8 -- put_ bh i = put_ bh (fromIntegral i :: Int64) -- get bh = do -- x <- get bh -- return $! (fromIntegral (x :: Int64)) -- #else -- #error "unsupported sizeof(HsInt)" -- #endif instance Binary ClockTime where put_ bh ct = do let t = toUTCTime ct put_ bh (ctYear t) put_ bh (fromEnum $ ctMonth t) put_ bh (ctDay t) put_ bh (ctHour t) put_ bh (ctMin t) put_ bh (ctSec t) get bh = do year <- get bh month <- fmap toEnum $ get bh day <- get bh hour <- get bh min <- get bh sec <- get bh return $ toClockTime $ (toUTCTime epoch) {ctYear = year, ctDay = day, ctMonth = month, ctHour = hour, ctMin = min, ctSec = sec} epoch = toClockTime $ CalendarTime { ctYear = 1970, ctMonth = January, ctDay = 0, ctHour = 0, ctMin = 0, ctSec = 0, ctTZ = 0, ctPicosec = 0, ctWDay = undefined, ctYDay = undefined, ctTZName = undefined, ctIsDST = undefined} instance Binary PackedString where put_ bh (PS a) = put_ bh a get bh = fmap PS $ get bh --put_ bh $ (snd $ Data.Array.IArray.bounds a) + 1 --mapM_ (put_ bh) (Data.Array.IArray.elems a) --sz <- get bh --x <- sequence $ replicate sz (get bh) --return $ PS (Data.Array.IArray.listArray (0,sz - 1) x) --put_ bh ps = put_ bh (unpackPS ps) --get bh = liftM packString $ get bh --put_ bh ps = putNList_ bh (unpackPS ps) --get bh = liftM packString $ getNList bh -- putNList_ bh xs = do -- put_ bh (length xs) -- mapM_ (put_ bh) xs -- -- getNList bh = do -- l <- get bh -- sequence $ replicate l (get bh) {- instance Binary [Char] where put_ bh cs = put_ bh (packString cs) get bh = do ps <- get bh return $ unpackPS ps -} instance Binary a => Binary [a] where put_ bh [] = putByte bh 0 put_ bh (x:xs) = do putByte bh 1; put_ bh x; put_ bh xs get bh = do h <- getWord8 bh case h of 0 -> return [] _ -> do x <- get bh xs <- get bh return (x:xs) instance (Binary a, Binary b) => Binary (a,b) where put_ bh (a,b) = do put_ bh a; put_ bh b get bh = do a <- get bh b <- get bh return (a,b) instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where put_ bh (a,b,c) = do put_ bh a; put_ bh b; put_ bh c get bh = do a <- get bh b <- get bh c <- get bh return (a,b,c) instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where put_ bh (a,b,c,d) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d get bh = do a <- get bh b <- get bh c <- get bh d <- get bh return (a,b,c,d) instance Binary a => Binary (Maybe a) where put_ bh Nothing = putByte bh 0 put_ bh (Just a) = do putByte bh 1; put_ bh a get bh = do h <- getWord8 bh case h of 0 -> return Nothing _ -> do x <- get bh return (Just x) instance (Binary a, Binary b) => Binary (Either a b) where put_ bh (Left a) = do putByte bh 0; put_ bh a put_ bh (Right b) = do putByte bh 1; put_ bh b get bh = do h <- getWord8 bh case h of 0 -> do a <- get bh ; return (Left a) _ -> do b <- get bh ; return (Right b) -- these flatten the start element. hope that's okay! instance Binary (UArray Int Word8) where put_ bh@(BinIO ix_r h) ua = do let sz = rangeSize (Data.Array.IO.bounds ua) ix <- readFastMutInt ix_r put_ bh sz ua <- unsafeThaw ua hPutArray h ua sz writeFastMutInt ix_r (ix + sz + 4) put_ bh (UArray s e ba) = do let sz = (rangeSize (s,e)) put_ bh sz case sz of I# i -> putByteArray bh ba i get bh@(BinIO ix_r h) = do ix <- readFastMutInt ix_r sz <- get bh ba <- newArray_ (0, sz - 1) hGetArray h ba sz writeFastMutInt ix_r (ix + sz + 4) ba <- unsafeFreeze ba return ba get bh = do sz <- get bh BA ba <- getByteArray bh sz return $ UArray 0 (sz - 1) ba {- instance (Ix a, Binary a) => Binary (UArray a Word8) where put_ bh (UArray s e ba) = do put_ bh s put_ bh e case (rangeSize (s,e)) of I# i -> putByteArray bh ba i get bh = do s <- get bh e <- get bh BA ba <- getByteArray bh (rangeSize (s,e)) return $ UArray s e ba -} -- #ifdef __GLASGOW_HASKELL__ instance Binary Integer where put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#) put_ bh (J# s# a#) = do p <- putByte bh 1; put_ bh (I# s#) let sz# = sizeofByteArray# a# -- in *bytes* put_ bh (I# sz#) -- in *bytes* putByteArray bh a# sz# get bh = do b <- getByte bh case b of 0 -> do (I# i#) <- get bh return (S# i#) _ -> do (I# s#) <- get bh sz <- get bh (BA a#) <- getByteArray bh sz return (J# s# a#) putByteArray :: BinHandle -> ByteArray# -> Int# -> IO () putByteArray bh a s# = loop 0# where loop n# | n# ==# s# = return () | otherwise = do putByte bh (indexByteArray a n#) loop (n# +# 1#) getByteArray :: BinHandle -> Int -> IO ByteArray getByteArray bh (I# sz) = do (MBA arr) <- newByteArray sz let loop n | n ==# sz = return () | otherwise = do w <- getByte bh writeByteArray arr n w loop (n +# 1#) loop 0# freezeByteArray arr data ByteArray = BA ByteArray# data MBA = MBA (MutableByteArray# RealWorld) newByteArray :: Int# -> IO MBA newByteArray sz = IO $ \s -> case newByteArray# sz s of { (# s, arr #) -> (# s, MBA arr #) } freezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray freezeByteArray arr = IO $ \s -> case unsafeFreezeByteArray# arr s of { (# s, arr #) -> (# s, BA arr #) } writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO () writeByteArray arr i (W8# w) = IO $ \s -> case writeWord8Array# arr i w s of { s -> (# s, () #) } indexByteArray a# n# = W8# (indexWord8Array# a# n#) instance (Integral a, Binary a) => Binary (Ratio a) where put_ bh (a :% b) = do put_ bh a; put_ bh b get bh = do a <- get bh; b <- get bh; return (a :% b) -- #endif instance Binary (Bin a) where put_ bh (BinPtr i) = put_ bh i get bh = do i <- get bh; return (BinPtr i) -- ----------------------------------------------------------------------------- -- Lazy reading/writing lazyPut :: Binary a => BinHandle -> a -> IO () lazyPut bh a = do -- output the obj with a ptr to skip over it: pre_a <- tellBin bh put_ bh pre_a -- save a slot for the ptr put_ bh a -- dump the object q <- tellBin bh -- q = ptr to after object putAt bh pre_a q -- fill in slot before a with ptr to q seekBin bh q -- finally carry on writing at q lazyGet :: Binary a => BinHandle -> IO a lazyGet bh = do p <- get bh -- a BinPtr p_a <- tellBin bh a <- unsafeInterleaveIO (getAt bh p_a) seekBin bh p -- skip over the object for now return a {- --------------------------------------------------------- -- Reading and writing FastStrings --------------------------------------------------------- putFS bh (FastString id l ba) = do put_ bh (I# l) putByteArray bh ba l putFS bh s = error ("Binary.put_(FastString): " ++ unpackFS s) -- Note: the length of the FastString is *not* the same as -- the size of the ByteArray: the latter is rounded up to a -- multiple of the word size. {- -- possible faster version, not quite there yet: getFS bh@BinMem{} = do (I# l) <- get bh arr <- readIORef (arr_r bh) off <- readFastMutInt (off_r bh) return $! (mkFastSubStringBA# arr off l) -} getFS bh = do (I# l) <- get bh (BA ba) <- getByteArray bh (I# l) return $! (mkFastSubStringBA# ba 0# l) {- instance Binary FastString where put_ bh f@(FastString id l ba) = case getUserData bh of { UserData { ud_next = j_r, ud_map = out_r, ud_dict = dict} -> do out <- readIORef out_r let uniq = getUnique f case lookupUFM out uniq of Just (j,f) -> put_ bh j Nothing -> do j <- readIORef j_r put_ bh j writeIORef j_r (j+1) writeIORef out_r (addToUFM out uniq (j,f)) } put_ bh s = error ("Binary.put_(FastString): " ++ show (unpackFS s)) get bh = do j <- get bh return $! (ud_dict (getUserData bh) ! j) -} -} {- instance Binary Atom where get bh = do ps <- get bh a <- fromPackedStringIO ps return a put_ bh a = put_ bh (toPackedString a) -} DrIFT-2.2.3/README 0000644 0000764 0000764 00000003074 10753606147 010254 0000000 0000000 ------------------------------------------------------------------------------ DrIFT This package contains a source distribution of DrIFT, a tool for automatic derivation of Haskell class instances. DrIFT was formerly known as Derive. the current homepage is at http://repetae.net/john/computer/haskell/DrIFT/ ------------------------------------------------------------------------------ Contents of this package: - src Directory with the source files of the DrIFT tool - example Directory with examples of using the DrIFT tool - docs Documentation ------------------------------------------------------------------------------ To configure and install DrIFT from the source tarball ./configure --prefix=
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
1. Introduction | ||
2. User Guide | ||
3. Standard Rules | ||
4. Rolling Your Own | ||
5. Installation | ||
6. Bugs and Shortcomings |
This is a guide to using DrIFT, a type sensitive preprocessor for Haskell 98.
DrIFT is a tool which parses a Haskell module for structures (data & newtype declarations) and commands. These commands cause rules to be fired on the parsed data, generating new code which is then appended to the bottom of the input file, or redirected to another. These rules are expressed as Haskell code, and it is intended that the user can add new rules as required.
DrIFT is written in pure Haskell 98, however code it generates is free to make use of extensions when appropriate. DrIFT is currently tested against hugs and ghc.
1.1 So, What Does DrIFT do? | ||
1.2 Features | ||
1.3 Why Do We Need DrIFT? | ||
1.4 An Example |
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
DrIFT allows derivation of instances for classes that aren't supported by the standard compilers. In addition, instances can be produced in separate modules to that containing the type declaration. This allows instances to be derived for a type after the original module has been compiled. As a bonus, simple utility functions can also be produced for types.
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
Currently supported derivations are the following. This list is obtainable by
running DrIFT -l
.
Binary: Binary efficient binary encoding of terms GhcBinary byte sized binary encoding of terms Debugging: Observable HOOD observable General: NFData provides 'rnf' to reduce to normal form (deepSeq) Typeable derive Typeable for Dynamic Generics: FunctorM derive reasonable fmapM implementation HFoldable Strafunski hfoldr Monoid derive reasonable Data.Monoid implementation RMapM derive reasonable rmapM implementation Term Strafunski representation via Dynamic Prelude: Bounded Enum Eq Ord Read Show Representation: ATermConvertible encode terms in the ATerm format Haskell2Xml encode terms as XML (HaXml<=1.13) XmlContent encode terms as XML (HaXml>=1.14) Utility: Parse parse values back from standard 'Show' Query provide a QueryFoo class with 'is', 'has', 'from', and 'get' routines from provides fromFoo for each constructor get for label 'foo' provide foo_g to get it has hasfoo for record types is provides isFoo for each constructor test output raw data for testing un provides unFoo for unary constructors update for label 'foo' provides 'foo_u' to update it and foo_s to set it
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
The original motivation for DrIFT came from reading one of the Glasgow Parallel Haskell papers on Strategies. Strategies require producing instances of a class which reduces to normal form (called NFData). It was commented that it was a shame that instances of NFData couldn't be automatically derived; the rules to generate the instances are simple, and adding instances by hand is tiresome. Many classes' instances follow simple patterns. This is what makes coding up instances so tedious: there's no thought involved!
The idea to extend DrIFT to work on imported types came from a discussion of the Haskell mailing list, arising from a point made by Olaf Chitil :
Why is the automatic derivation of instances for some standard classes linked to data and newtype declarations? It happened already several times to me that I needed a standard instance of a data type that I imported from a module that did not provide that instance and which I did not want to change (a library; GHC, which I mainly want to extend by further modules, not spread changes over 250 modules). When declaring a new data type one normally avoids deriving (currently) unneeded instances, because it costs program code (and maybe one even wants to enable the user of the module to define his own instances).
The third feature of DrIFT, providing utility functions to manipulate new types, especially records was caused by finding oneself writing the same sort of code over and over again. These functions couldn't be captured in a class, but have a similar form for each type they are defined on. A thread on the Haskell mailing list made a related point: untagging and manipulating newtypes was more cumbersome than it should be.
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
Here's an example of what how DrIFT is used. This Haskell module
contains commands to the DrIFT preprocessor. These are annotated with
{-! ... !-}
. After processing with DrIFT the generated code
is glued on the bottom of the file, beneath a marker indicating where
the new code starts. The machine generated code is quite long, and
would really have been a drudge to type in by hand.
1.4.1 Source Code | ||
1.4.2 After processing with DrIFT |
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
-- example script for DrIFT module Example where import Foo {-!for Foo derive : Read,NFData !-} -- apply rules to imported type {-! global : is !-} -- global to this module {-!for Data derive : update,Show,Read!-} -- stand alone comand syntax {-!for Maybe derive : NFData !-} -- apply rules to prelude type data Data = D {name :: Name, constraints :: [(Class,Var)], vars :: [Var], body :: [(Constructor,[(Name,Type)])], derive :: [Class], statement :: Statement} data Statement = DataStmt | NewTypeStmt deriving Eq {-!derive : Ord,Show,Read !-} -- abbreviated syntax |
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
module Example where import Foo {-!for Foo derive : Read,NFData !-} -- apply rules to imported type {-! global : is !-} -- global to this module {-!for Data derive : update,Show,Read!-} -- stand alone comand syntax {-!for Maybe derive : NFData !-} -- apply rules to prelude type data Data = D {name :: Name, constraints :: [(Class,Var)], vars :: [Var], body :: [(Constructor,[(Name,Type)])], derive :: [Class], statement :: Statement} data Statement = DataStmt | NewTypeStmt deriving Eq {-!derive : Ord,Show,Read !-} {-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-} isD (D aa ab ac ad ae af) = True isD _ = False instance Ord Statement where compare DataStmt (DataStmt) = EQ compare DataStmt (NewTypeStmt) = LT compare NewTypeStmt (DataStmt) = GT compare NewTypeStmt (NewTypeStmt) = EQ instance Show Statement where showsPrec d (DataStmt) = showString "DataStmt" showsPrec d (NewTypeStmt) = showString "NewTypeStmt" instance Read Statement where readsPrec d input = (\ inp -> [((DataStmt) , rest) | ("DataStmt" , rest) <- lex inp]) input ++ (\ inp -> [((NewTypeStmt) , rest) | ("NewTypeStmt" , rest) <- lex inp]) input isDataStmt (DataStmt) = True isDataStmt _ = False isNewTypeStmt (NewTypeStmt) = True isNewTypeStmt _ = False instance (NFData a) => NFData (Maybe a) where rnf (Just aa) = rnf aa rnf (Nothing) = () body_u f r@D{body} = r{body = f body} constraints_u f r@D{constraints} = r{constraints = f constraints} derive_u f r@D{derive} = r{derive = f derive} name_u f r@D{name} = r{name = f name} statement_u f r@D{statement} = r{statement = f statement} vars_u f r@D{vars} = r{vars = f vars} body_s v = body_u (const v) constraints_s v = constraints_u (const v) derive_s v = derive_u (const v) name_s v = name_u (const v) statement_s v = statement_u (const v) vars_s v = vars_u (const v) instance Show Data where showsPrec d (D aa ab ac ad ae af) = showParen (d >= 10) (showString "D" . showChar '{' . showString "name" . showChar '=' . showsPrec 10 aa . showChar ',' . showString "constraints" . showChar '=' . showsPrec 10 ab . showChar ',' . showString "vars" . showChar '=' . showsPrec 10 ac . showChar ',' . showString "body" . showChar '=' . showsPrec 10 ad . showChar ',' . showString "derive" . showChar '=' . showsPrec 10 ae . showChar ',' . showString "statement" . showChar '=' . showsPrec 10 af . showChar '}') instance Read Data where readsPrec d input = readParen (d > 9) (\ inp -> [((D aa ab ac ad ae af) , rest) | ("D" , inp) <- lex inp , ("{" , inp) <- lex inp , ("name" , inp) <- lex inp , ("=" , inp) <- lex inp , (aa , inp) <- readsPrec 10 inp , ("," , inp) <- lex inp , ("constraints" , inp) <- lex inp , ("=" , inp) <- lex inp , (ab , inp) <- readsPrec 10 inp , ("," , inp) <- lex inp , ("vars" , inp) <- lex inp , ("=" , inp) <- lex inp , (ac , inp) <- readsPrec 10 inp , ("," , inp) <- lex inp , ("body" , inp) <- lex inp , ("=" , inp) <- lex inp , (ad , inp) <- readsPrec 10 inp , ("," , inp) <- lex inp , ("derive" , inp) <- lex inp , ("=" , inp) <- lex inp , (ae , inp) <- readsPrec 10 inp , ("," , inp) <- lex inp , ("statement" , inp) <- lex inp , ("=" , inp) <- lex inp , (af , inp) <- readsPrec 10 inp , ("}" , rest) <- lex inp]) input -- Imported from other files :- instance Read Foo where readsPrec d input = (\ inp -> [((Foo) , rest) | ("Foo" , rest) <- lex inp]) input ++ (\ inp -> [((Bar) , rest) | ("Bar" , rest) <- lex inp]) input ++ (\ inp -> [((Bub) , rest) | ("Bub" , rest) <- lex inp]) input instance NFData Foo where rnf (Foo) = () rnf (Bar) = () rnf (Bub) = () |
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
This chapter assumes that DrIFT has already been installed and the environment variables set up. The installation is handled in Installation.
Briefly, the way DrIFT works is
Rules can be applied to any types defined using a data
or
newtype
statement. Rules can't be applied to types defined using
type
, as this only produces a synonym for a type. Don't
try to use rules on type synonyms.
2.1 The Command Line | ||
2.2 Command Syntax | ||
2.3 Emacs DrIFT mode |
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
DrIFT processes standard Haskell scripts (suffix ‘.hs’) and
literate scripts (suffix ‘.lhs’). Currently, only literate code
using >
is accepted: DrIFT doesn't understand the TeX style
of literate programming using \begin{code}
.
If you've compiled up an executable from the source code (or are using Runhugs) to run DrIFT over a file type :-
DrIFT filename
Alternatively, for Hugs, use :-
runhugs DrIFT filename
(run DrIFT over filename)
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
Commands to DrIFT are entered into Haskell code in the form of
annotations. DrIFT's annotations start with {-!
and finish
with !-}
. (This is so they don't clash with the compiler annotations
given to GHC or HBC). There are three forms of command.
{-! for type derive :
rule1,rule2,… !-}
)
This is the basic form of DrIFT command. It asks DrIFT to apply the
listed rules to the specified type. If the type is parameterised,
e.g. Maybe a
, just enter the type name into the command, omitting
any type variables. DrIFT assumes that types given are currently in
scope, and will first search the current module. If it fails to find a
matching type definition, the prelude and any imported modules are also
searched. This is the only command which allows code to be generated
for a type defined in another module.
{-! derive :rule1,rule2,… !-}
)
This command is appended to the end of a data
or newtype
definition, after the deriving clause, if present. It applies the listed
rules to the type it is attached to.
{-! global :rule1,rule2,… !-}
This command applies the listed rules
to all types defined within the module. Note that this command doesn't
cause code to be generated for types imported from other modules.
For an example of these commands in use, See section An Example.
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
infix
, import
,newtype
). It
doesn't matter what position they occur within the module.
>
).
--
and {- .. -}
in the usual way.
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
For Emacs fans, Hans W Loidl hwloidl@dcs.gla.ac.uk has written a script which allows DrIFT to be run within a buffer.
The commands available are
M-x hwl-derive
, C-c d d
runs DrIFT over the current
buffer, and then updates the buffer.
M-x hwl-derive-insert-standalone
, C-c d s
inserts a
template for a standalone command into the current buffer at the
cursor position.
M-x hwl-derive-insert-local
, C-c d l
inserts a template
for an abbreviated command.
M-x hwl-derive-insert-global
, C-c d g
inserts a template
for a global command
In `hugs-mode' these functions are also available vie a menu item in the hugs menu.
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
Heres a listing of the rules that come pre-defined with DrIFT. If you want a more detailed idea of how they work, their definitions are in the file ‘StandardRules.hs’, and are (fairly) well documented. In the following list the highlighted text is the name of the rule, as used in commands. The naming convention for rules is names starting with a capital generate an instance for the class of the same name. Sets of functions are generated by a name beginning with a lower case letter.
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
The classes Eq, Ord, Enum, Show, Read & Bounded are described in the Haskell report as being derivable; DrIFT provides rules for all these.
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
Originally, NFData (for Normal Form evaluation strategies)
was the only other class to have a rule. But now, there are rules for
many more classes from 3rd-party libraries, e.g. XmlContent
from HaXml, Binary from nhc98, Term from Strafunski,
FunctorM for Generics, Observable for HOOD debugging,
Typeable for dynamics, and so on. For a full list, use the
--list
command-line option.
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
newtype
.
For a type
newtype Foo a = F a
,un produces the function
unFoo :: Foo a -> a
.
For a type
data Foo = Bar | Bub
, is generates
isBar :: Foo -> Bool
andisBub :: Foo -> Bool
.
For a type
data Foo a = F{bar :: a,bub :: Int}
has generates
hasbar :: Foo a-> Bool
andhasbub :: Foo a -> Bool
.
For a type
data Foo a = F{bar :: a, bub ::Int}
update generates
bar_u :: (a -> a) -> Foo a -> Foo a
and
bub_u :: (Int -> Int) -> Foo a -> Foo a
which apply a function to a field of a record, and then return the updated record. If the value does not have the given field then the value is returned unchanged.
bar_s :: a -> Foo a -> Foo a
andbub_s ::Int -> Foo a -> Foo a
are also generated, and are used to set the value of a field in a record.
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
Programmers who only wish to use the pre-defined rules in DrIFT don't need to read or understand the following section. However, as well as using the supplied rules, users are encouraged to add their own. There is a stub module ‘UserRules.hs’ in the source, to which rules can be added.
If a compiled version of DrIFT is being used, the program will then
have to be recompiled before the new rules can be used. However, if the
Runhugs standalone interpreter is used, this is not necessary. Due to
the way Runhugs searches for modules to load, a user may have many
copies of the UserRules module. The UserRules module in the current
directory will be loaded first. If that is not present, then the
HUGSPATH
environment variable is searched for the module. So it is
possible to have a default UserRules module, and specialised ones for
particular projects.
4.1 The Basic Idea | ||
4.2 How is a Type Represented? | ||
4.3 Pretty Printing | ||
4.4 Utilities | ||
4.5 Adding a new rule |
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
A rule is a tuple containing a string and a function. The string is the name of the rule, and is used in commands in an input file. The function maps between the abstract representation of a datatype and text to be output (A sort of un-parser, if you like). The best way to understand this is to have a look at the existing rules in ‘StandardRules.hs’. This module is quite well documented.
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
A type is represented within DrIFT using the following data definition.
>data Statement = DataStmt | NewTypeStmt deriving (Eq,Show) >data Data = D { name :: Name, -- type name > constraints :: [(Class,Var)], > vars :: [Var], -- Parameters > body :: [Body], > derives :: [Class], -- derived classes > statement :: Statement} > | Directive > | TypeName Name deriving (Eq,Show) >type Name = String >type Var = String >type Class = String |
A Data
type represents one parsed data
or newtype
statement. These are held in a D
constructor record (the
Directive
and TypeName
constructors are just used internally by
DrIFT). We'll now examine each of the fields in turn.
name
holds the name of the new datatype as a string.
constraints
list the type constraints for the type variables of
the new type. e.g. for data (Eq a) => Foo a = F a
, the value of
constraints
would be [("Eq","a")]
.
vars
contains a list of the type variables in the type. For the
previous example, this would simply be ["a"]
.
body
is a list of the constructors of the type, and the
information associated with them. We'll come back to this in a moment.
derives
lists the classes that the type an instance of though
using the deriving
clause.
statement
indicates whether the type was declared using a
newtype
or data
statement
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
>data Body = Body { constructor :: Constructor, > labels :: [Name], > types :: [Type]} deriving (Eq,Show) >type Constructor = String |
The body type holds information about one of the constructors of a type.
constructor
is self-explanatory. labels
holds the names
of labels of a record. This will be blank if the constructor isn't a
record. types
contains a representation of the type of each
value within the constructor. The definition of Type
is as
follows.
>data Type = Arrow Type Type -- fn > | Apply Type Type -- application > | Var String -- variable > | Con String -- constructor > | Tuple [Type] -- tuple > | List Type -- list > deriving (Eq,Show) |
Few of the deriving rules supplied have actually needed to use this type information, which I found quite surprising. If you do find you need to use it, one example is the Haskell2Xml rule.
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
Instead of producing a string as output, rules produce a value of type
Doc
. This type is defined in the Pretty Printing Library implemented
by Simon Peyton-Jones. The pretty printer ensures that the code is
formatted for readability, and also handles problems such as
indentation. Constructing output using pretty printing combinators is
easier and more structured than manipulating strings too. For those
unfamiliar with these combinators, have a look at the module
‘Pretty.lhs’ and the web page http://www.cse.ogi.edu/~simonpj/
or for more detail the paper The Design of a Pretty Printing
Library, J. Hughes
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
Upon the pretty printing library, DrIFT defines some more formatting functions which make regularly occurring structures of code easier to write. These structures include simple instances, blocks of code, lists, etc. The utilities are in the module ‘RuleUtils.hs’ and should be self explanatory.
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
A rule has type type Rule = (String,Data -> Doc)
. Once you have
written your mapping function and chosen an appropriate name for the
rule, add this tuple to the list userRules :: [Rule]
in module ‘UserRules.hs’. Recompile if necessary. DrIFT will then call this rule when
its name occurs in a command in an input file.
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
DrIFT isn't a large or complicated application, so it shouldn't be too hard for anyone to get it up and running. For the platform you want to install for, read the corresponding section below, then see Environment Variables
5.1 GHC | ||
5.2 Hugs | ||
5.3 Runhugs | ||
5.4 Environment Variables | ||
5.5 Installing the Emacs DrIFT Mode |
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
the automake script should automatically detect any ghc or nhc installation and
use that to build and install DrIFT. First run ./configure
. To
compile, type make all
. The executable produced ‘DrIFT’ can then
be installed with make install
.
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
The DrIFT code comes as a set of Haskell modules. You want to copy all
these to somewhere in your HUGSPATH
, then you can load and run
DrIFT in any directory.
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
Edit the first line of the the file ‘DrIFT’ to point to your copy
of runhugs
. Copy ‘DrIFT’ to somewhere on your PATH
, and
the remainder of the source (‘*.hs’,‘*.lhs’) to a directory in your HUGSPATH
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
In you environment set DERIVEPATH
to the list of directories you
wish derive to search for modules / interfaces.
DERIVEPATH
is quite fussy about the format the list should take :-
For instance
good - /users/nww/share/hugs/lib:/users/nww/share/hugs/lib/hugs
bad - /users/nww/share/hugs/lib/: /users/nww/share/hugs/lib/hugs/
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
Edit ‘derive.el’ so that the variable hwl-derive-cmd
contains your
copy of the DrIFT executable.
Place ‘derive.el’ into a directory on your load-path
, byte-compile it and put the following command into your ‘.emacs’ file:
(load "derive")
[ < ] | [ > ] | [ << ] | [ Up ] | [ >> ] | [Top] | [Contents] | [Index] | [ ? ] |
[Top] | [Contents] | [Index] | [ ? ] |
[Top] | [Contents] | [Index] | [ ? ] |
This document was generated on February, 10 2008 using texi2html 1.78.
The buttons in the navigation panels have the following meaning:
Button | Name | Go to | From 1.2.3 go to |
---|---|---|---|
[ < ] | Back | Previous section in reading order | 1.2.2 |
[ > ] | Forward | Next section in reading order | 1.2.4 |
[ << ] | FastBack | Beginning of this chapter or previous chapter | 1 |
[ Up ] | Up | Up section | 1.2 |
[ >> ] | FastForward | Next chapter | 2 |
[Top] | Top | Cover (top) of document | |
[Contents] | Contents | Table of contents | |
[Index] | Index | Index | |
[ ? ] | About | About (help) |
where the Example assumes that the current position is at Subsubsection One-Two-Three of a document of the following structure:
This document was generated on February, 10 2008 using texi2html 1.78.