- Haskell-Cafe - Haskell.org

Darcs Patch Theory and GADTs at London Haskell User Group tonight
by Neil Bartlett 23 Jan '08

23 Jan '08

Hi all, Just a reminder about tonight's London Haskell User Group meeting, at City University from 6:30PM. Ganesh Sittampalam will be giving a talk entitled "Darcs Patch Theory and GADTs". For full details see the website: http://www.londonhug.net/2008/01/07/darcs-patch-theory-and-gadts-with-ganes… For those outside the London area or unable to come, there will be a video posted to the website later, so subscribe to it in your RSS reader now! Regards, Neil

1 0

haskeem -- (almost) scheme in haskell
by Uwe Hollerbach 23 Jan '08

23 Jan '08

Hello, haskellers, I am a total newbie in haskell, but I've been making some mud pies that are coming out kinda pleasingly to my admittedly biased eye. I found Jonathan Tang's excellent tutorial "Write yourself a scheme in 48 hours" a few weeks ago, went through and beyond that, and now have something that's starting to look moderately like a real scheme interpreter. I've got much, though not all, of the scheme number tower implemented, I have most of the core syntactic forms (and, apply, begin, case cond, define, if, lambda, let, let*, letrec, letrec*, or, quote, set!) and am working on a few more (delay and force are well along, guard is also in progress but less so), and I have implemented a small trace facility. It's still a toy, but it's starting to be a toy with some nice dance moves. I think it could do the majority of the code in SICP by now. If you'd like to have a look, please surf over to http://www.korgwal.com/software/haskeem/index.html. Feedback welcome! best regards, Uwe Hollerbach

1 0

Irrefutable pattern love and new regex engine.
by Michael Speer 22 Jan '08

22 Jan '08

I've been using the creation of a regular expression engine as an ongoing project to learn Haskell. Last night I created the newest iteration. My love for the irrefutable pattern can be found in the definition of the rexn ( apply repetition to extracted nodes ) function below. /snip rexn ns pps = let ( ~( xs , rps ) , ~( ~( nxs ) , ~( rxs , rrps ) ) ) = ( exn nxs pps , case rps of ('?':'?':rr) -> ( ( ns ) , ( ns ++ xs , rr ) ) ('?':rr) -> ( ( ns ) , ( xs ++ ns , rr ) ) /snip Beautiful, beautiful lazy execution and irrefutable pattern matching. The data flow is able to easily twist in and out of functions, even as an argument to the function call that creates it. Is this kind of usage normal? Any and all comments, suggestions, refutations, and criticisms are welcome. -- regular expression engine -- (c) 2008 michael speer import Char ( isSpace ) -- import Debug.Trace ( trace ) xor :: Bool -> Bool -> Bool xor True a = not a xor False a = a data RxToken = RxStart -- matchable start of target string | RxChar Char -- a literal character to match | RxBound -- inserted wherever alphanums touch whitespace | RxEnd -- matchable end of target string | RxEOF -- an additional token to push through to catch anything trying for RxEnd -- RxEOF is never matched. deriving ( Show ) rxTokenize tts = RxStart : case tts of [] -> RxEnd : RxEOF : [] tts@(t:_) -> case not $ isSpace t of True -> RxBound : rxt tts False -> rxt tts where rxt (t:[]) | not $ isSpace t = RxChar t : RxBound : RxEnd : RxEOF : [] | otherwise = RxChar t : RxEnd : RxEOF : [] rxt (t:ts@(t':_)) | isSpace t `xor` isSpace t' = RxChar t : RxBound : rxt ts | otherwise = RxChar t : rxt ts data RxTransform = RxTransform ( RxNode -> RxToken -> [ RxNode ] ) | RxNullTransform data RxNode = RxActive { rxTransforms :: [RxTransform] , rxMatched :: String , rxNumSubs :: Integer , rxSubExprs :: [ String ] } | RxComplete { rxMatched :: String , rxNumSubs :: Integer , rxSubExprs :: [ String ] } instance Show RxNode where show (RxComplete matched _ _) = "<rx|matched:[" ++ matched ++ "]>" data RxDepth = RxTop | RxSub deriving ( Show ) rxCompile pps = let ( xs , rps ) = oexn [success] RxTop pps in case length rps of 0 -> RxActive { rxTransforms = xs , rxMatched = [] , rxNumSubs = 0 , rxSubExprs = [] } _ -> error $ "Not all of pattern consumed : remains : " ++ rps where -- or together different expression sections -- (a|b|c) oexn ns RxTop [] = ( ns , [] ) oexn _ RxSub [] = error "Pattern ended while still in sub expression" oexn ns d pps = let ( ~( xs , rps ) , ~( nxs , nrps ) ) = ( aexn ns pps , case rps of ('|':rr) -> let ( inxs , irps ) = oexn ns d rr in ( xs ++ inxs , irps ) (')':rr) -> case d of RxTop -> error "Erroneous close parenthesis in pattern " RxSub -> ( xs , rr ) [] -> case d of RxTop -> ( xs , [] ) RxSub -> error "End of pattern while still in sub expression" ) in ( nxs , nrps ) -- and together extracted nodes in a given expression segment -- abd?dfs aexn ns pps = let ( ~( xs , rps ) , ~( nxs , nrps ) ) = ( rexn nxs pps , case rps of ('|':_) -> ( ns , rps ) (')':_) -> ( ns , rps ) [] -> ( ns , rps ) _ -> aexn ns rps ) in ( xs , nrps ) -- replication application - weee! rexn ns pps = let ( ~( xs , rps ) , ~( ~( nxs ) , ~( rxs , rrps ) ) ) = ( exn nxs pps , case rps of ('?':'?':rr) -> ( ( ns ) , ( ns ++ xs , rr ) ) ('?':rr) -> ( ( ns ) , ( xs ++ ns , rr ) ) ('*':'?':rr) -> ( ( ns ++ xs ) , ( ns ++ xs , rr ) ) ('*':rr) -> ( ( xs ++ ns ) , ( xs ++ ns , rr ) ) ('+':'?':rr) -> ( ( ns ++ xs ) , ( xs , rr ) ) ('+':rr) -> ( ( xs ++ ns ) , ( xs , rr ) ) _ -> ( ( ns ) , ( xs , rps ) ) ) in ( rxs , rrps ) -- extract node ( including an entire subexpression as a single node ) exn _ ('?':_) = error "Bad question mark operator" exn _ ('*':_) = error "Bad splat operator" exn _ ('+':_) = error "Bad plus sign operator" exn ns ('(':ps) = oexn ns RxSub ps exn ns (p:ps) = ( [ RxTransform ( \rxn k -> case k of (RxChar c) -> if c == p then [ RxActive { rxTransforms = ns , rxMatched = c : rxMatched rxn , rxNumSubs = rxNumSubs rxn , rxSubExprs = rxSubExprs rxn } ] else [] (RxStart) -> [rxn] (RxBound) -> [rxn] _ -> [] ) ] , ps ) exn ns [] = error "can this be reached?" success = RxTransform ( \ rxn k -> [ RxComplete { rxMatched = reverse $ rxMatched rxn , rxNumSubs = rxNumSubs rxn , rxSubExprs = map reverse $ rxSubExprs rxn } ] ) rxExec n tts = iexec [n] (rxTokenize tts) where iexec (win@(RxComplete _ _ _ ):_) _ = Just win iexec [] _ = Nothing iexec nns (k:ks) = iexec ( concatMap ( \n -> case n of (RxComplete _ _ _) -> [n] a@(RxActive _ _ _ _) -> concatMap (\xf -> case xf of (RxTransform f) -> f a k (RxNullTransform) -> [] ) (rxTransforms a) ) nns ) ks main = do print $ rxTokenize "this is a test" print $ rxExec (rxCompile "hello|world") "hello" print $ rxExec (rxCompile "hello|world") "world" print $ rxExec (rxCompile "abcde|ab") "abcd" print $ rxExec (rxCompile "ab?c") "ac" print $ rxExec (rxCompile "ab?c") "abc" print $ rxExec (rxCompile "ab*c") "ac" print $ rxExec (rxCompile "ab*c") "abc" print $ rxExec (rxCompile "ab*c") "abbbc" print $ rxExec (rxCompile "ab+c") "ac" print $ rxExec (rxCompile "ab+c") "abc" print $ rxExec (rxCompile "ab+c") "abbbbbc" print $ rxExec (rxCompile "(a|b)+") "aaabbbabaaababaaabbbabbaba" print $ rxExec (rxCompile "abc|") "zyx"

4 4

ghc6.8: hiding uninstalled package?
by Magnus Therning 22 Jan '08

22 Jan '08

This might seem like a silly question, but what's the reasoning behind the following behaviour? % ghc-pkg list dataenc /usr/lib/ghc-6.8.2/package.conf: % ghc --make -hide-package dataenc -isrc UT.hs ghc-6.8.2: unknown package: dataenc Hiding an uninstalled package doesn't seem to warrant failing compilation! /M

4 4

Announce: mersenne-random 0.1, very fast pseudo-random number generation for Haskell
by Don Stewart 22 Jan '08

22 Jan '08

Hey all, I'm pleased to announce the creation of the mersenne-random package, The Mersenne twister is a pseudorandom number generator developed by Makoto Matsumoto and Takuji Nishimura, that provides for fast generation of very high quality pseudorandom numbers, suitable for simulators and monte carlo modelling. This library binds to 'SFMT', the SIMD-oriented Fast Mersenne Twister. SFMT is a variant of Mersenne Twister that is much faster than the original. It is designed to be fast when it runs on 128-bit SIMD. To compile in the vector instructions use Cabal, and pass '-f use_sse2' or '-f use_altivec' to configure, depend on which set your cpu supports (or none if it doesn't). The use of sse2 instructions will typically halve the generation time. The library is very fast (generation of Ints and Doubles will be some 50x faster than System.Random), but the implementation we bind to is heavily impure, so only a single generator is possible per-process (splitting generators is also not supported). Some light abstractions are implemented over the raw C interface, including a type class for SFMT-generated Haskell values, and lists of those values. Full 64 bit Ints and Doubles, and 53-bit precision Doubles, are supported on 64 bit machines. As usual, the stable branch is on hackage, so you can install it with cabal: $ cabal install mersenne-random Note that the cpu isn't detected automatically, so to turn on SIMD flags for your cpu, you'll need to build it by hand from: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/mersenne-random And the darcs repo is at code.haskell.org, darcs get http://code.haskell.org/~dons/code/mersenne-random A test suite and example programs are provided. Enjoy, Don

2 2

[Fwd: Invitation for MathematiKa '08 : projectEuler format]
by anshuman＠students.iiit.ac.in 22 Jan '08

22 Jan '08

---------------------------- Original Message ---------------------------- Subject: Invitation for MathematiKa '08 : projectEuler format From: anshuman(a)students.iiit.ac.in Date: Mon, January 21, 2008 11:30 am To: haskell-cafe(a)haskell.org -------------------------------------------------------------------------- Hello Math Enthusiast, IIIT-Hyderabad, India cordially invites you to be a part of Mathematika '08, an online competition that emphasizes on fusion of mathematics and computing. Where: http://felicity.iiit.ac.in/~math When: 4th February, 2008 This Online Math Contest will consist of 10-12 problems made randomly from different domains of existing Math. All problem statements will be visible to the contestant from the start of contest spanning over a 10 hour period. The solution to each problem would be an integer or a floating point number which is to be submitted in real-time. One Minute Rule: The problems are designed in a way that support 1 minute rule which means that an efficient implementation will allow a solution to be obtained on a modestly powered computer in less than one minute. Also, make sure to bring your appetite for math, programming and fun. There will be plenty of all three to go around. Regards Mathematika Team http://felicity.iiit.ac.in/~math

1 0

Hangman game
by Ronald Guida 22 Jan '08

22 Jan '08

Hi, I'm interested in learning how to program games. Since I have to start somewhere, I decided to write a simple Hangman game. I'm wondering if anyone can look at my code and give me some feedback. Thank you. -- Hangman game module Main where import Data.Char import Data.List import System.IO import System.Random import Control.Monad.State data GameState = GameState { gsAnswer :: String, -- the answer gsKnown :: [Maybe Char], -- partial answer known to the user gsGuesses :: [Char], -- incorrect letters guessed so far gsWrong :: Int, -- number of incorrect guesses gsWonLost :: Maybe Bool -- Just true = won, Just false = lost } deriving (Show) newGameState :: String -> GameState newGameState answer = GameState{ gsAnswer = map toUpper answer, gsKnown = (map (filt $ not . isAlpha) answer), gsGuesses = [], gsWrong = 0, gsWonLost = Nothing} data UserInput = UIGuess Char | UIQuit | UINewGame | UIRefresh deriving (Show) main :: IO () main = do hSetBuffering stdout NoBuffering putStr "Welcome to Hangman!\n\n" putStr instructions runStateT startNewGame undefined return () startNewGame :: StateT GameState IO () startNewGame = do nWord <- liftIO $ getStdRandom (randomR (0,length wordList - 1)) let word = wordList !! nWord let gs = newGameState word put gs liftIO $ putStrLn $ renderGameState gs gameLoop gameLoop :: StateT GameState IO () gameLoop = do ui <- liftIO getUserInput case ui of UIGuess c -> do modify $ handleGuess c gs <- get liftIO $ putStrLn $ renderGameState gs case (gsWonLost gs) of Nothing -> gameLoop Just True -> do liftIO $ putStrLn "Congratulations, you won!" startNewGame Just False -> do liftIO $ putStrLn "You've been hanged!" liftIO $ putStrLn $ "The word was \'" ++ (gsAnswer gs) ++ "\'." startNewGame UIQuit -> do gs <- get liftIO $ putStrLn $ "The word was \'" ++ (gsAnswer gs) ++ "\'." liftIO $ putStrLn "Thank you for playing!" UINewGame -> do gs <- get liftIO $ putStrLn $ "The word was \'" ++ (gsAnswer gs) ++ "\'." startNewGame UIRefresh -> do gs <- get liftIO $ putStrLn $ renderGameState gs gameLoop getUserInput :: IO UserInput getUserInput = do putStr "Hangman> " response <- getLine if null response then getUserInput else do let c:cs = response if isAlpha c then return $ UIGuess $ toUpper c else if c == ':' && not (null cs) then case toLower (head cs) of 'q' -> return UIQuit 'n' -> return UINewGame 'r' -> return UIRefresh '?' -> do putStr instructions getUserInput otherwise -> do putStrLn $ "Unknown command \'" ++ cs ++ "\'" putStrLn $ "Use \':?\' for help." getUserInput else do putStrLn $ "Invalid input \'" ++ response ++ "\'" putStrLn $ "Use \':?\' for help." getUserInput instructions :: String instructions = "Instructions:\n" ++ "To guess a letter, type the letter and press enter.\n" ++ "To quit or restart the game, use the following commands:\n" ++ " :q = quit\n" ++ " :n = new game\n" ++ " :r = re-display the game state\n" ++ " :? = show instructions\n" ++ "\n" filt :: (a -> Bool) -> a -> Maybe a filt pred x = if pred x then Just x else Nothing handleGuess :: Char -> GameState -> GameState handleGuess ch state = if (elem ch $ gsGuesses state) then state else if (elem ch $ gsAnswer state) then let revealed = map (filt (== ch)) (gsAnswer state) known = zipWith mplus (gsKnown state) revealed won = all (maybe False (const True)) known in state{gsKnown = known, gsWonLost = filt id won} else let wrong = 1 + (gsWrong state) in state{gsGuesses = ch:(gsGuesses state), gsWrong = wrong, gsWonLost = filt not (wrong < 7)} wordList :: [String] wordList = ["alligator", "angelfish", "ant", "bear", "buffalo", "butterfly", "canary", "chameleon", "crab", "dinosaur", "dog", "dolphin", "eel", "elephant", "flamingo", "frog", "giraffe", "goldfish", "grasshopper", "hedgehog", "hippopotamus", "horse", "iguana", "jaguar", "jellyfish", "kangaroo", "kinkajou", "lemur", "lizard", "llama", "meerkat", "moose", "mouse", "narwhal", "nautilus", "nuthatch", "ostrich", "owl", "panda", "pelican", "quail", "quokka", "raccoon", "rhinoceros", "salamander", "sea horse", "sea urchin", "snail", "tiger", "toucan", "uakari", "unicorn", "vampire bat", "vulture", "walrus", "wildebeest", "worm", "xenops", "yak", "yellow jacket", "zebra"] renderGameState :: GameState -> String renderGameState gs = let noose = renderNoose $ gsWrong gs report = ["","The Word:","",word,"","Your Guesses:","",guessed] word = intersperse ' ' $ map (maybe '_' id) (gsKnown gs) guessed = gsGuesses gs in (concat $ zipWith (++) noose $ map (++ "\n") report) renderNoose :: Int -> [String] renderNoose n | n <= 0 = [ " ___ ", " / | ", " | ", " | ", " | ", " | ", " | ", " -+- "] renderNoose 1 = [ " ___ ", " / | ", " | O ", " | ", " | ", " | ", " | ", " -+- "] renderNoose 2 = [ " ___ ", " / | ", " | O ", " | | ", " | ", " | ", " | ", " -+- "] renderNoose 3 = [ " ___ ", " / | ", " | O ", " | --| ", " | ", " | ", " | ", " -+- "] renderNoose 4 = [ " ___ ", " / | ", " | O ", " | --|-- ", " | ", " | ", " | ", " -+- "] renderNoose 5 = [ " ___ ", " / | ", " | O ", " | --|-- ", " | | ", " | ", " | ", " -+- "] renderNoose 6 = [ " ___ ", " / | ", " | O ", " | --|-- ", " | | ", " | / ", " | ", " -+- "] renderNoose n | n >= 7 = [ " ___ ", " / | ", " | O ", " | --|-- ", " | | ", " | / \\ ", " | ", " -+- "]

6 13

Newbie question
by Alexander Seliverstov 22 Jan '08

22 Jan '08

Hi, I try to undestand why this code dosen't work f :: (Num a)=>Integer->a f i = i Integer is an instance of Num, so why does this code produce error: "Couldn't match expected type 'a' againsta inferred type 'Integer' ..."

8 18

Re: [Haskell-cafe] Has character changed in GHC 6.8?
by Miguel Mitrofanov 22 Jan '08

22 Jan '08

> > chr . ord $ 'å' > '\229' > What would I have to do to get an 'å' from '229'? It seems you already have it; 'å' is the same as '\229'. But IO output is still 8-bit, so when you ask ghci to print 'å', you get '\229'. You can use utf-string library (from hackage).

2 1

non-alphabetical mathematical symbols as non-infix function names
by Cetin Sert 22 Jan '08

22 Jan '08

(¬) :: Bool → Bool (¬) q = not q q = True ¬ q : parser error on input q ¬ : parser error (possibly incorrect indentation) (¬ q) : Couldn't match expected type `Bool -> t' against inferred type `Bool' In the expression: (� True) In the definition of `it': it = (� True) * (q ¬) : False (Why) is it not possible to define a (non-infix) function whose name consists of a single non-alphabetical mathematical symbol? ¬ :: Bool → Bool -- parser error on input ** ¬ q = not q -- parser error on input ** Cetin Sert

3 2