bug in Random.lhs

1999-03-06 Thread Martin Stein

Hi,

there's a little bug in randomIvalInteger of Random.lhs (ghc-4.02):

 | otherwise = case (f n 1 rng) of (v, rng') - (fromInteger (v `mod` (k+1)),
rng')
 where
   k = h - l + 1

should be something like

 | otherwise = case (f n 1 rng) of (v, rng') - (fromInteger (v `mod` (k+1)+l),
rng')
 where
   k = h - l + 1

Martin Stein



error while parsing a context, a bug?

1998-07-01 Thread Martin Stein

Suppose I want to write a function like this one:

 -- the foldl' from the Prelude.hs
 foldl' :: Eval a = (a - b - a) - a - [b] - a
 foldl' f a [] = a
 foldl' f a (x:xs) = strict (foldl' f) (f a x) xs

 f :: (Eval (a b)) = (a b - c - a b) - a b - [c] - a b
 f h s xs = foldl' h s xs

ghc compiles without any error messages.

If I write instead

 class (Eval (a b)) = AClass a b where
 f :: (a b - c - a b) - a b - [c] - a b
 f h s xs = foldl' h s xs

then I got the error: `TypeTest.hs:9:13: parse error on input: "("'
(line 9 of TypeTest.hs is the line with the `class' keyword)

Using 'Eval a b' instead of 'Eval (a b) is wrong, of course.
Giving the context in the type signatur of f is wrong, too.
Omitting the context will produce the error message `Could not deduce `Eval (a
b)' ...'

The 2 examples are inconsistent, so it seems to me that this is a bug!

Martin Stein



Re: type errors

1998-06-30 Thread Martin Stein

  Ambiguous type variable(s)
  `key', `dict'
  in the constraint `Dictionary dict key a10v'
  arising from use of `searchList' at Dtest2.hs:11
  In an equation for function `searchList':
  searchList (x : xs) d
 = let
 (sresults, d') = searchList xs d
 (x', sresult, d'') = search x d'
 new_sres = (x', (sresult)) : sresults
   in (new_sres, (d''))
  In the definition for method `searchList'
 
 You don't say which version of the compiler you are using,
 but I think this a palpable bug in 3.01 that is fixed in 3.02.

Sorry, but I'm using 3.02 of the binary distribution

Martin Stein



panic, compiler bug

1998-06-30 Thread Martin Stein

During developing a module, I tried to compile the incomplete module
SplayTree.hs to check something and got a panic!

After changing the incorrect first line of SplayTree.hs from

 module Dictionary where
to
 module SplayTree where

I got the right error messages I "wanted".
The 3 concerned modules are attached

Martin Stein

PS: I'm using 3.02 from binary distribution and Linux

the compiler messages (Dictionary.o and BinarySearchTree.o existed):
 ghc -c -fglasgow-exts SplayTree.hs

importDecl wierdness: Dictionary.delete{-r7k-}

importDecl wierdness: Dictionary.insert{-r7l-}

importDecl wierdness: Dictionary.Dictionary{-r7a-}

panic! (the `impossible' happened):
tcLookupClass Dictionary.Dictionary{-r7a-}

Please report it as a compiler bug to [EMAIL PROTECTED]

module Dictionary where

data SearchResult a = Found a | Fail

class (Eq key,Ord key) = Dictionary dict key dat where
insert :: (key,dat) - dict key dat - dict key dat
delete :: key - dict key dat - dict key dat
search :: key - dict key dat - (key,SearchResult dat,dict key dat)
update :: (key,dat) - dict key dat - dict key dat

fromList :: [(key,dat)] - dict key dat
toList :: dict key dat - [(key,dat)]

insertList :: [(key,dat)] - dict key dat - dict key dat
deleteList :: [key] - dict key dat - dict key dat
searchList :: [key] - dict key dat - ([(key,SearchResult dat)],dict key dat)
updateList :: [(key,dat)] - dict key dat - dict key dat

insertList xs d = foldr insert d xs
deleteList xs d = foldr delete d xs
updateList xs d = foldr update d xs

searchList xs d = foldr search' ([],d) xs
where  search' x (l,d) = ((x,sr):l,d') where (x,sr,d') = search x d


module BinarySearchTree where

import Dictionary

class (Eq key,Ord key) = BinarySearchTree tree key dat where
getKey :: tree key dat - key
getDat :: tree key dat - dat
getLeft :: tree key dat - tree key dat
getRight :: tree key dat - tree key dat
height :: tree key dat - Int
numberOfNodes :: tree key dat - Int
rotateRight :: tree key dat - tree key dat
rotateLeft :: tree key dat - tree key dat


data (Eq key, Ord key) = BSTree key dat = Node (BSTree key dat) (BSTree key dat) 
(key,dat) |
   Nil deriving (Eq, Ord)

instance (Eq key,Ord key) = BinarySearchTree BSTree key dat where
getKey Nil = error "getKey: empty BSTree\n"
getKey (Node _ _ (k,d)) = k

getDat Nil = error "getDat: empty BSTree\n"
getDat (Node _ _ (k,d)) = d

getLeft Nil = error "getLeft: empty BSTree\n"
getLeft (Node tl _ _) = tl

getRight Nil = error "getRight: empty BSTree\n"
getRight (Node _ tr _) = tr

height Nil = 0
height (Node tl tr _) = 1 + max (height tl) (height tr)

numberOfNodes Nil = 0
numberOfNodes (Node tl tr _) = 1 + (numberOfNodes tl) + (numberOfNodes tr)

rotateRight (Node (Node tll tlr xl) tr x) = Node tll (Node tlr tr x) xl
rotateRight Nil = error "rotateRight: empty BSTree\n"
rotateRight (Node Nil tl x) = error "rotateRight: empty left BSTree\n"

rotateLeft (Node tl (Node trl trr xr) x) = Node (Node tl trl x) trr xr
rotateLeft Nil = error "rotateLeft: empty BSTree\n"
rotateLeft (Node tl Nil x) = error "rotateLeft: empty right BSTree\n"


module Dictionary where

import BinarySearchTree
import Dictionary

type SplayTree key dat = BSTree key dat

instance (Eq key,Ord key) = Dictionary SplayTree key dat where
insert p@(x,_) t = case splay x t of
Nil - Node Nil Nil x
Node tl tr q@(y,_) - case compare x y of
  EQ - Node tl tr p
  GT - Node (Node tl Nil q) tr p
  LT - Node tl (Node Nil tr q) p

delete x t = case splay x t of
 Nil  - Nil
 t'@(Node Nil tr q@(y,_)) - if x/=y then t' else tr
 t'@(Node tl Nil q@(y,_)) - if x/=y then t' else tl
 t'@(Node tl tr q@(y,_))  - if x/=y then t' else putToRight 
(splay x tl) tr
 where t'' = putToRight (splay x tl) tr
  -- 'splay x tl' dadurch wird der groeszte 
Knoten im
  -- linken Teilbaum nach oben rotiert - 
rechts ist Nil
-- putToRight :: (Eq key, Ord key) = SplayTree key dat - SplayTree key 
dat - STree a
   putToRight (Node tl Nil p) ttr = Node tl ttr p












---
-- splay: the most important function, all dictionary functions are based on it
---

type SI key dat = (SplayTree key dat,Int)

splay ::