[Haskell-cafe] Re: Problems interpreting

Neil Mitchell ndmitchell at gmail.com
Mon Sep 18 12:16:19 EDT 2006


Hi,

Out of curiosity, I've been developing a tool called Dr Haskell, for a
sample run:

--------------------------------
module Test where

substitute1 :: Eq a => a -> [a] -> [a] -> [a]
substitute1 e l1 l2= [c | c <- check_elem l1]
   where check_elem [] = l1
         check_elem (x:xs) = if x == e then (l2 ++ xs) else [x] ++ check_elem xs


substitute2 e l l'
  = concat (map subst_elem l)
    where subst_elem x
              | x == e = l'
              | otherwise = [x]

subst3 e l [] = []
subst3 e l (x:xs) = if x == e then l ++ xs else x : subst3 e l xs


subst4 e l' = concat.map (\x->if x==e then l' else [x])
----------------------------

> drhaskell Test.hs

I can apply Hints.concat_map in Test.subst4
I can apply Hints.concat_map in Test.substitute2
I can apply Hints.box_append in Test.Test.Prelude.200.check_elem

For the curious, see the darcs repo:

http://www.cs.york.ac.uk/fp/darcs/drhaskell/

(Requires Yhc)

Thanks

Neil

PS. dons also contributed some of the earlier discussion to this tool,
so deserves some credit.


On 9/18/06, wld <volodimir.rudenko at gmail.com> wrote:
> Hi,
> On 9/18/06, Joachim Breitner <mail at joachim-breitner.de> wrote:
> > Hi,
> >
> > Am Montag, den 18.09.2006, 16:00 +0100 schrieb Neil Mitchell:
> > > > subst e l' = concat.map (\x->if x==e then l' else [x])
> > > subst e l' = concatMap (\x->if x==e then l' else [x])
> > > Let's save an extra character :)
> > We are talking keystrokes here, so count the shift key!
> >
> > Greetings,
> > Joachim
>
> Sorry, couldn't resist... If we *really* talking keystrokes, it much
> depends on auto-completion features of your editor! :)
>
> V.Rudenko
> --
> λ is the ultimate
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>
>


More information about the Haskell-Cafe mailing list