Re: [Haskell-cafe] WANTED: grey line layout boxes in vim and emacs
something like the attached vim script might work for small sources (ignores all layout rules and keywords, just records increase/decrease of indentation stack; builds up a rather large pattern of positions for highlighting via :match). (don't assume that this is the only, let alone the right way to do this, and please pardon my rusty vimscript;-) bonus tasks are left as exercises for the reader.. Claus ps. a good interface for teaching vim about language syntax and motion would be nice (or at least a dynamically loadable, position-independent GHC API for use with vim's libcall..), but I find that with visual highlighting of lines and blocks, Haskell layout manipulation at least tends to be fairly straightforward (I do not even use highlightling of the cursor column, which gives you a vertical ruler) - Original Message - From: "Donald Bruce Stewart" <[EMAIL PROTECTED]> To: Sent: Thursday, December 07, 2006 12:34 AM Subject: [Haskell-cafe] WANTED: grey line layout boxes in vim and emacs I'd like some more help from the editors in getting 2d layout right without trying. Here's a mockup of vim with vertical grey bars delimiting layout: http://www.cse.unsw.edu.au/~dons/tmp/haskell+boxes.png Does anyone know how to get this effect in vim (or emacs)? Bonus points if the grey bars are draggable, changing the indenting. More bonus points for box-based navigation. -- Don ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe blocks.vim Description: Binary data ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Num is such a fat and greedy class
On Fri, Dec 08, 2006 at 12:06:05PM -0800, Dan Weston wrote: > Would it not make sense to put each of these operators (division too) > into their own individual superclasses that Num inherits? My (obviously > naive) philosophy about type classes is that operations should be > bundled only when they are mutually recursive (i.e. there is more than > one useful minimal definition). If there is just one minimal set of > operations, they can be in their own parent class too. In many ways, this would be nice. But on the other hand, in languages with free overloading of operators, code can get highly obfuscated as a result, since everything overloads +. I actually like how Haskell takes a somewhat more principled approach to the Num class, although it is limiting at times. On the other hand, of John Meacham's class synonyms proposal makes it into Haskell', maybe we'll see some dissolution of Num... -- David Roundy Department of Physics Oregon State University ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
[Haskell-cafe] Num is such a fat and greedy class
The following observations are not new, insightful, or gracious, but I was lusting after the innocent +,-,* operators for my own evil ends and was mildly curious why... Num is such a fat and greedy class. If you want to marry Cinderella, you have to take her ugly stepsisters too. 1) Groups may only want to define addition. Why can't they use + (instead of <+>, >?&**+>, or other such perversion)? 2) Affine spaces have a (-) but no (+). Worse, the signature might be (-) :: Point -> Point -> Vector, which doesn't unify with (a -> a -> a). Wouldn't the following be more useful/general? class Subtraction a b | a -> b where (-) :: a -> a -> b Or would this require needless type annotation for the common subset of (a -> a -> a) instances? 3) Quaternions have no signum, unit quaternions have (*), (/) but no (+) or (-), abs would have a different signatures (Quaternion -> Double) which doesn't unify with (a -> a), and fields cannot be scaled with (*) as in (*) :: (Field f) => Double -> f -> f Would it not make sense to put each of these operators (division too) into their own individual superclasses that Num inherits? My (obviously naive) philosophy about type classes is that operations should be bundled only when they are mutually recursive (i.e. there is more than one useful minimal definition). If there is just one minimal set of operations, they can be in their own parent class too. Then again, I should get over my lust and stick with my own operators <+>, <-->, and <***>. Not too pretty, but they have a wonderful personality all their own! Dan ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: Re: Re: [Haskell-cafe] interval arithmetic for integers?
Fantastic! Just another bit of evidence that Haskell Cafe + one night's sleep can save a great deal of work. :) Thanks for pointing that out, Nick On 12/8/06, Taral <[EMAIL PROTECTED]> wrote: On 12/8/06, Nicolas Frisby <[EMAIL PROTECTED]> wrote: > I did see that one on the wiki; but it doesn't seem to support the > open intervals (i.e. (-inf, 3)) and I'd really like those. Oh, it does. See BoundaryAboveAll and BoundaryBelowAll. -- Taral <[EMAIL PROTECTED]> "You can't prove anything." -- Gödel's Incompetence Theorem ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
[Haskell-cafe] Re: throwTo & block statements considered harmful
Program A and B got word wrapped by mistake...damn it. Program A > loop = block (print "alive") >> loop > > main = do tid <- forkIO loop > threadDelay 1 > killThread tid the above print "alive" forever while killThread stays blocked. Program B > loop = block (print "alive") >> loop >> yield > > main = do tid <- forkIO loop > threadDelay 1 > killThread tid the above prints "alive" about twice before killThread succeeds. ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] modelling problem
On 12/8/06, Kurt Schelfthout <[EMAIL PROTECTED]> wrote: Hi Haskell'ers, class Activity a c where start :: c -> a -> Time --start of the activity (this isn't actually dependent on c, I guess) end :: c -> a -> Time --end of the activity delta :: a -> Time -> c -> c --how the constituent is changed at the given time How can I now represent the state of the simulation (i.e. all activites on all constituents). E.g. a list of activities won't do since the list is heterogeneous (i.e. [Paint Ball White, Move Ball (2,0)]) I know about existentials, but I'm at a loss at how to implement the "wrapper" datatype that is exemplified on http://www.haskell.org/hawiki/ExistentialTypes since my class has two parameters, in fact I'm at a loss at how to use existentials here completely. An existential type will do roughly what you want. I prefer GADT syntax here: data AnyActivity where AnyActivity :: Activity a c => a -> c -> AnyActivity Then, given an activity/constituent pair like, say, Move (2,0) and Ball, you can say: AnyActivity (Move (2,0)) Ball to package the pair. The resulting object has type AnyActivity, and can be stored in a list with other AnyActivities. You can write variations on your class methods that work on the packaged datatype: startAny :: AnyActivity -> Time startAny (AnyActivity a c) = start c a endAny :: AnyActivity -> Time endAny (AnyActivity a c) = end c a deltaAny :: AnyActivity -> Time -> AnyActivity deltaAny (AnyActivity a c) time = AnyActivity a (delta a time c) Then, how could I go back from the "general" lists (or whatever datatype) of [a]'s and [c]'s, to a list of [([a],c)] of all activities a that are applicable to a certain constituent c? I can't seem to be able to use the Typeable class for example, since this can not "cast" to typeclasses, only to concrete types (I think...). I'm not exactly sure what you want here. Since activities of a different type can affect the same constituent, it's not possible to go from a constituent c to a list of activities. You could, for example, find all the AnyActivity wrappers that contain a given constituent, if you added Typeable and Eq constraints: -- I didn't actually test this code data AnyActivity where AnyActivity :: (Activity a c, Typeable c, Eq c) => a -> c -> AnyActivity activitiesAffecting :: (Eq c, Typeable c) => c -> [AnyActivity] -> [AnyActivity] activitiesAffecting c [] = [] activitiesAffecting c (a@(AnyActivity _ c'):as) | c `eq` c' = a : activitiesAffecting c as | otherwise = activitiesAffecting c as where t `eq` t' | Just t'' <- cast t' = t == t'' | otherwise = False Extracting the original a and c used in a wrapper can be done as well, if you also include a Typeable constraint on a. More straightforward ways of modelling this problem (avoiding multiple type class parameters and existentials :) )are also welcome. Without seeing more of your goals, I'm not sure I can suggest anything else. I've found myself writing wrapper code like this before, and it doesn't have to end up completely confused and unusuable. On the other hand, it does feel somewhat inelegant to me - looking at FRP, for instance, might give you some good ideas for other approaches. /g -- It is myself I have never met, whose face is pasted on the underside of my mind. ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
RE: [Haskell-cafe] known, I know: class contexts and mutual recursion
| > Mmm.lhs:15:1: | > Contexts differ in length | > When matching the contexts of the signatures for | > foo :: forall (m :: * -> *). (Monad m) => Thing -> m Int | > goo :: Thing -> (Maybe Int -> Int) -> Int | > The signature contexts in a mutually recursive group should all be | > identical | > | > Poking about on the web, I got the impression that this was a known | > infelicity in ghc 6.4 (which I'm using), due to be ironed out. However, | > an early-adopting colleague with 6.6 alleges that foo-goo is still | > poisonous. | | You can compile it with 6.6 if you use -fglasgow-exts. It's not clear to | me whether this will always work, e.g. if you have higher rank types | floating around, but if it does then we should add a hint to the error; | Simon? Yes, it'll work in 6.6, and it's even documented (at the end of the section on type-system extensions). I'll add a suggestion to the error message to use -fglasgow-exts Simon ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
[Haskell-cafe] Re[4]: [Haskell] ANNOUNCE: Visual Haskell 0.2 final
Hello Krasimir, Friday, December 8, 2006, 4:42:48 PM, you wrote: > You can replace just libHSrts.a in your Visual Haskell directory and > it should work. I will release a new VSHaskell after GHC-6.6.1 > release. If the .hi format is still the same in the last GHC-6.6 > revision then you should safely replace everything. afaik, GHC developers ensure that this format doesn't change during 6.6.* lifetime and about waiting 6.6.1 - some of us more rely on snapshots, it's impossible to wait new ghc release just to have my problems fixed :) so, if it possible to have instructions for using VH with newer 6.6 releases - it will be really great -- Best regards, Bulatmailto:[EMAIL PROTECTED] ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] modelling problem
Hello Kurt, Friday, December 8, 2006, 1:11:35 PM, you wrote: > I'm trying, more as a first excercise in Haskell than anything else, to > class Activity a c where seems like your goes from OOP world? :) type classes are pretty rare birds in Haskell programs. There are other ways to implement such functionality: http://haskell.org/haskellwiki/OOP_vs_type_classes btw, i also suggest looking into sources of Base and MissingH libraries to see examples of good programming style -- Best regards, Bulatmailto:[EMAIL PROTECTED] ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
[Haskell-cafe] Re: Re[2]: [Haskell] ANNOUNCE: Visual Haskell 0.2 final
You can replace just libHSrts.a in your Visual Haskell directory and it should work. I will release a new VSHaskell after GHC-6.6.1 release. If the .hi format is still the same in the last GHC-6.6 revision then you should safely replace everything. Cheers, Krasimir On 12/8/06, Bulat Ziganshin <[EMAIL PROTECTED]> wrote: Hello Krasimir, Friday, December 8, 2006, 4:30:31 PM, you wrote: > It is already bundled with slightly newer version of GHC-6.6. There > was a bug that had to be fixed in order to have working Visual > Haskell. Visual Haskell is dependent of GHC API and you can't simply > use it with different GHC version. i mean newr 6.6.* versions, what fixed also other errors, not only VH-related. if my project needs, for example, GC bugfix, i can't use VH because this error was fixed only a few weeks ago -- Best regards, Bulatmailto:[EMAIL PROTECTED] ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
[Haskell-cafe] Re[2]: [Haskell] ANNOUNCE: Visual Haskell 0.2 final
Hello Krasimir, Friday, December 8, 2006, 4:30:31 PM, you wrote: > It is already bundled with slightly newer version of GHC-6.6. There > was a bug that had to be fixed in order to have working Visual > Haskell. Visual Haskell is dependent of GHC API and you can't simply > use it with different GHC version. i mean newr 6.6.* versions, what fixed also other errors, not only VH-related. if my project needs, for example, GC bugfix, i can't use VH because this error was fixed only a few weeks ago -- Best regards, Bulatmailto:[EMAIL PROTECTED] ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
[Haskell-cafe] Re: [Haskell] ANNOUNCE: Visual Haskell 0.2 final
It is already bundled with slightly newer version of GHC-6.6. There was a bug that had to be fixed in order to have working Visual Haskell. Visual Haskell is dependent of GHC API and you can't simply use it with different GHC version. Cheers, Krasimir On 12/8/06, Bulat Ziganshin <[EMAIL PROTECTED]> wrote: Hello Krasimir, Friday, December 8, 2006, 11:12:26 AM, you wrote: > The final version of Visual Haskell 0.2 is ready: >- distributed with a stable GHC version (6.6) how about bundlng it with up-to-date GHC 6.6 build (which've fixes a lot of problems) or, better, allow to use it with user-installed ghc 6.6.* installation? -- Best regards, Bulatmailto:[EMAIL PROTECTED] ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
[Haskell-cafe] Re: [Haskell] ANNOUNCE: Visual Haskell 0.2 final
Hello Krasimir, Friday, December 8, 2006, 11:12:26 AM, you wrote: > The final version of Visual Haskell 0.2 is ready: >- distributed with a stable GHC version (6.6) how about bundlng it with up-to-date GHC 6.6 build (which've fixes a lot of problems) or, better, allow to use it with user-installed ghc 6.6.* installation? -- Best regards, Bulatmailto:[EMAIL PROTECTED] ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Re: How to combine Error and IO monads?
On 12/7/06, J. Garrett Morris <[EMAIL PROTECTED]> wrote: foo :: ErrorT String IO Int Since ErrorT String IO Int is not the same as IO, you can't use IO operations directly. In this case, you want: < a <- lift getLine You want: < r <- runErrorT foo Wow! I found your help terrific! Thank you! Can I give you some money? ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
[Haskell-cafe] throwTo & block statements considered harmful
Title: "throwTo & block statements considered harmful" This is a short essay to prove that the current GHC concurrency implementation has a critical flaw. And this is on the wiki at: http://haskell.org/haskellwiki/GHC/Concurrency#throwTo_.26_block_statements_considered_harmful The key problem is, at least in the presence of block/unblock, that Exceptions are never reliably delivered. And this is not a theoretical case, but can cause a hang in something as innocuous as "program A" given below. Simon Marlow wrote: >> I think people are misunderstanding the nature of a safepoint. The >> safepoint is a point at which you are prepared to have exceptions >> delivered. This does not mean that they *will* be delivered, just that they >> can. If you need to *wait* for an asynchronous exception, then you >> shouldn't be using them at all. > > Right. If a thread mostly runs inside 'block' with the occasional safe > point, then your exceptions are not really asynchronous, they're synchronous. > > > In this case, I'd say a better solution is to have an explicit event queue, > and instead of the safe point take an event from the queue. The action on > receiving an event can be to raise an exception, if necessary. > > Cheers, Simon The implementation of asynchronous signals, as described by the paper "Asynchronous exceptions in Haskell Simon Marlow, Simon Peyton Jones, Andy Moran and John Reppy, PLDI'01." is fatally inconsistent with the implementation in GHC 6.4 and GHC 6.6 today. The implemented semantics have strictly weaker guarantees and render programs using asynchronous expressions impossible to write correctly. The semantics in the paper were carefully designed to solve the problem laid out in the first sentence of the abstract: "Asynchronous exceptions, such as timeouts, are important for robust, modular programs, but are extremely difficult to program with -- so much so that most programming languages either heavily restrict them or ban them altogether." And I believe the paper succeeded. The paper shows how to replace other languages pervasive and intrusive error catching and handling code with much cleaner, clearer, and often more correct code. The implementation in GHC has changed the behavior of throwTo from asynchronous (not-interruptible) to synchronous (interruptible?) as discussed in section 8 of the paper. This change, in and of itself, is not the fatal problem; as described in the paper a (forkIO (throwTo ...)) recovers the asynchronous behavior. The fatal change between the paper and GHC comes from not following section 7.2 as published. Section "7.2 Implementation of throwTo" has two bullet point, and the second bullet point is (retyped, so typos are my own fault): "As soon as a thread exits the scope of a 'block', and at regular intervals during execution inside 'unblock', it should check its queue of pending exceptions. If the queue is non-empty, the first exception from the queue should be raised." A test of GHC 6.6 shows that this is not the case. Test program A: > loop = block (print "alive") >> loop main = do tid <- forkIO loop threadDelay > 1 killThread tid Program A, compiled with (-threaded) on a single CPU machine never halts. It will print "alive" forever while the the main thread is blocked on "killThread". This is wh As an aside, removing the threadDelay causes killThread to destroy the child before it can enter the block, thus showing the need to add "forkBlockedIO" or "forkInheritIO" to the library. This can be worked around using an MVar. Changing the definition of loop produces Test program B: > loop = block (print "alive") >> yield >> loop main = do tid <- forkIO loop > threadDelay 1 killThread tid This prints "alive" twice before the killThread succeeds. The paper demands that when the loop in Program A exits the scope of "block (print a)" that it check a queue of pending exceptions, see that it is non-empty, and raise the exception thrown by killThread. This can also be seen in "Figure 5. Transition Rules for Asynchronous Exceptions", where killThread should use throwTo to create an in-flight exception and exiting the scope of block in the presence of this in-flight exception should raise the exception. The implementation in GHC sleeps the main thread at the killThread command, and it is awoken when the block is exited and to succeed in delivering the exception it must execute while the child is still in the unblocked state. But the child re-enters a blocked state too quickly in Program A, so killThread never succeeds. The change in Program B has the child "yield" when unblocked and this gives the main thread a change to succeed. This trick using yield to make a safepopint was suggested by Simon Marlow: > The window in 'unblock (return ())' is tiny, I'm not really surprised if > nothing ever gets through it. You might have more luck with 'unblock yield'. It has been said on this mailing list thread that needing "yield" to program concurre
[Haskell-cafe] MissingH status and thanks
Since the MissingH discussion took place on this list, I thought I should update you all on the status. First off, MissingH now has a new Trac-based homepage, complete with wiki, Darcs repository information, source browser, bug tracker, etc. It's at http://software.complete.org/missingh Secondly, the MissingH modules have been renamed as we discussed here. And finally, various pieces of MissingH have been split off already into separate packages. (See the announcements on [EMAIL PROTECTED]) The full list of changes -- planned and executed -- is at http://software.complete.org/missingh/wiki/TransitionPlanning Thanks to all for your valuable feedback. I hope that these changes will make this set of code more useful to everyone. -- John ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
[Haskell-cafe] New Layout Rule
Motivated by some recent discussion, I thought I would explore the possibilty of formalizing the haskell layout rule without the dreaded parse-error clause, as in, one that can be completly handled by the lexer. motivated by that I have written a little program that takes a haskell file with layout on stdin and spits out one without layout on stdout. it can be gotten here: darcs get http://repetae.net/repos/getlaid/ the code is designed to make the layout algorithm completly transparent, so that we might experiment with it. The function layout in 'Layout.hs' is the single and complete layout algorithm and the only thing that need be modified by experimentors. I have come up with a simple improvement to the algorithm given in the paper that seems to catch a very large number of layouts. basically, whenever it comes across something that must come in matched pairs (, ), case of, if then. it pushes a special context onto the stack, when it comes across the closing token, it pops every layout context down to the special context. there is a special case for "in" that causes it to pop only up to the last context created with a "let", but not further. here is the complete algorithm (with my modification, sans the parse-error rule): > data Token = Token String | TokenVLCurly String !Int | TokenNL !Int > deriving(Show) > > data Context = NoLayout | Layout String !Int > > -- the string on 'Layout' and 'TokenVLCurly' is the token that > -- created the layout, always one of "where", "let", "do", or "of" > > layout :: [Token] -> [Context] -> [Token] > layout (TokenNL n:rs) (Layout h n':ls) > | n == n' = semi:layout rs (Layout h n':ls) > | n > n' = layout rs (Layout h n':ls) > | n < n' = rbrace:layout (TokenNL n:rs) ls > layout (TokenNL _:rs) ls = layout rs ls > layout (TokenVLCurly h n:rs) (Layout h' n':ls) > | n >= n' = lbrace:layout rs (Layout h n:Layout h' n':ls) > | otherwise = error "inner layout can't be shorter than outer one" > layout (TokenVLCurly h n:rs) ls = lbrace:layout rs (Layout h n:ls) > layout (t@(Token s):rs) ls | s `elem` fsts layoutBrackets = t:layout rs > (NoLayout:ls) > layout (t@(Token s):rs) ls | s `elem` snds layoutBrackets = case ls of > Layout _ _:ls -> rbrace:layout (t:rs) ls > NoLayout:ls -> t:layout rs ls > [] -> error $ "unexpected " ++ show s > layout (t@(Token "in"):rs) ls = case ls of > Layout "let" n:ls -> rbrace:t:layout rs ls > Layout _ _:ls -> rbrace:layout (t:rs) ls > ls -> t:layout rs ls > layout (t:rs) ls = t:layout rs ls > layout [] (Layout _ n:ls) = rbrace:layout [] ls > layout [] [] = [] > > layoutBrackets = [ ("case","of"), ("if","then"), >("(",")"), ("[","]"), ("{","}") ] now. there are a few cases it doesn't catch. the hanging case at the end of a guard for instance, I believe this can be solved easily by treating '|' and '=' as opening and closing pairs in lets and wheres '|' and '->' as opening and closing pairs in case bodies. it is easy to see which one you are in by looking at the context stack. commas are trickier and are the only other case I think we need to consider. I welcome people to experiment and send patches or brainstorm ideas, I have what I believe is a full solution percolating in my head, but am unhappy with it, I am going to sleep on it and see if it crystalizes by morning. In the meantime, perhaps someone can come up with something more elegant for dealing with the remaining cases. or at least find some real programs that this code breaks down on! (bug fixes for the lexer and everything are very much welcome. it will probably choke on some ghc extensions that would be trivial to add to the alex grammar) John -- John Meacham - ⑆repetae.net⑆john⑈ ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] modelling problem
Dear Kurt, > I'm trying, more as a first excercise in Haskell than anything else, > to code a simulation framework in Haskell. I don't have the time to respond to your mail in detail right now, but you might want to have a look at the work on Fran (functional reactive animation), FRP (Functional Reactive Programming), and Yampa, all very much related to the application area you're interested in. E.g. see http://www.haskell.org/frp/ All the best, /Henrik -- Henrik Nilsson School of Computer Science and Information Technology The University of Nottingham [EMAIL PROTECTED] This message has been checked for viruses but the contents of an attachment may still contain software viruses, which could damage your computer system: you are advised to perform your own checks. Email communications with the University of Nottingham may be monitored as permitted by UK legislation. ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
[Haskell-cafe] modelling problem
Hi Haskell'ers, I'm trying, more as a first excercise in Haskell than anything else, to code a simulation framework in Haskell. A simulation is a bunch of simulation state consisting of constituents (e.g. physical entities like a ball or properties like temperature), on which agents (e.g. simulated humans) in the system can do activities. Activities have a certain duration, and define how the simulation progresses. The simulator framework should just define the basics to maintain a normal representation of time and of cause and effect, i.e. make sure that the state evolves through the application of the activities in the right order. In a later step I will add "laws", which transform activities when they overlap or conflict (e.g. two drive activities leading to collision). I've run into the following problem. I defined a class that allows to define activities on constituents: class Activity a c where start :: c -> a -> Time --start of the activity (this isn't actually dependent on c, I guess) end :: c -> a -> Time --end of the activity delta :: a -> Time -> c -> c --how the constituent is changed at the given time Two parameter type class because some activities are only applicable to certain constituents: instance Activity Paint Ball where instance Activity Move Ball where instance Activity Paint Wall where but you can't move a wall for example, so no instance for Move Wall. My question is: How can I now represent the state of the simulation (i.e. all activites on all constituents). E.g. a list of activities won't do since the list is heterogeneous (i.e. [Paint Ball White, Move Ball (2,0)]) I know about existentials, but I'm at a loss at how to implement the "wrapper" datatype that is exemplified on http://www.haskell.org/hawiki/ExistentialTypes since my class has two parameters, in fact I'm at a loss at how to use existentials here completely. Then, how could I go back from the "general" lists (or whatever datatype) of [a]'s and [c]'s, to a list of [([a],c)] of all activities a that are applicable to a certain constituent c? I can't seem to be able to use the Typeable class for example, since this can not "cast" to typeclasses, only to concrete types (I think...). What I initially liked about this idea is that it can be encoded in the typesystem which activities apply to which consituents, but now it seems like I will have to encode it in the simulation framework more directly (i.e. giving each consituent a String name to encode its "type"). More straightforward ways of modelling this problem (avoiding multiple type class parameters and existentials :) )are also welcome. thanks for any pointers, Kurt ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: Re: [Haskell-cafe] "computational time" always 0.0 in this example...
The "time $ evaluate (sum (doTest wordList2 wordList2))" works fine for me... ...and the ":set +s" is gorgeous as well! Thanks for the help! Lennart Lemmih wrote: On 12/7/06, Lennart <[EMAIL PROTECTED]> wrote: Hi, with the following code, I want to measure the time being needed to execute the algorithm. But the result is always 0.0. import Char (toLower) import Maybe import List ( delete, sort, intersect ) import System.CPUTime import Control.Exception import Debug.Trace fromInt = fromIntegral wordList2 :: [String] wordList2 = ["Sam J Chapman", "Samuel Chapman", "S Chapman", "Samuel John Chapman", "John Smith", "Richard Smith", " mnop ", " mnop ", "aa mnop zz", "a ", "aa", " bcdefgh stuvwx zz", " bcdefgh stuvx yy", "a bcdefgh stuvwx zz", "a a a zz", "a a"] time :: IO t -> IO t time a = do start <- getCPUTime v <- a end <- getCPUTime let diff = (fromIntegral (end - start)) / (10^12) --let diff = (fromIntegral (end - start)) putStrLn "Computation time:" print (diff :: Double) return v main = do putStrLn "Starting..." time $ doTest wordList2 wordList2 `seq` return () putStrLn "Done." test3 = let loop = getCPUTime >>= print >> loop in loop doTest :: [String] -> [String] -> [ Double ] doTest [] _ = [] doTest (x:xs) [] = doTest xs xs doTest (x:xs) (y:ys) = result : (doTest (x:xs) (ys)) where result = qGramMetrics2 x y qGramMetrics2:: String -> String -> Double qGramMetrics2 t1 t2 = let i = intersect (qGramList (map toLower t1) 3) (qGramList (map toLower t2) 3) il = fromInt (length i) ml = fromInt ((max (length t1) (length t2)) - 1 ) in (il / ml ) -- list of chars within list of qgrams qGramList :: String -> Int -> [[Char]] qGramList [] _= [] qGramList (x:[]) _ = [] qGramList (x:xs) i1= (x: take (i1 - 1) xs):(qGramList xs i1) -- list of chars within list of qgrams numberedQgramListWithStart :: String -> Int -> [(Int, [Char])] numberedQgramListWithStart x i1 = let prefix = replicate (i1-1) '#' suffix = replicate (i1-1) '$' in numberedQgramList (prefix++(x++suffix)) i1 0 numberedQgramList :: String -> Int -> Int -> [(Int, [Char])] numberedQgramList [] _ _= [] numberedQgramList (x:xs) i1 i2 -- add the dollar-sign | (length xs) < i1 && x=='$'= [] | otherwise = (i2,(x: take (i1 - 1) xs)):(numberedQgramList xs i1 (i2+1)) Am using ghci 6.6 under a Kubuntu 6.10 Linux. time $ product [1..1000] `seq` return () instead of time $ doTest wordList2 wordList2 `seq` return () works fine. things like time $ print (doTest wordList2 wordList2) `seq` return () or time $ length (doTest wordList2 wordList2) `seq` return () or time $ trace (doTest wordList2 wordList2) `seq` return () didn't work. Am desperated... Try: time $ evaluate (sum (doTest wordList2 wordList2)) ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: Re: [Haskell-cafe] interval arithmetic for integers?
On 12/8/06, Nicolas Frisby <[EMAIL PROTECTED]> wrote: I did see that one on the wiki; but it doesn't seem to support the open intervals (i.e. (-inf, 3)) and I'd really like those. Oh, it does. See BoundaryAboveAll and BoundaryBelowAll. -- Taral <[EMAIL PROTECTED]> "You can't prove anything." -- Gödel's Incompetence Theorem ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: Re: [Haskell-cafe] interval arithmetic for integers?
I did see that one on the wiki; but it doesn't seem to support the open intervals (i.e. (-inf, 3)) and I'd really like those. That is the leading candidate right now though... There was also this one: http://www.dinkla.net/fp/cglib.html It mentions "rangetrees" but I'm not sure if that's the kind I'm thinking of. That package has what seems like scary math. Thanks, Nick On 12/8/06, Taral <[EMAIL PROTECTED]> wrote: Some of that is in the Ranged Sets library: http://ranged-sets.sourceforge.net/Ranged/ but it doesn't support Num. On 12/8/06, Nicolas Frisby <[EMAIL PROTECTED]> wrote: > I'm looking to not reinvent the wheel. > > Is there an existing package that supports interval arithmetic on > integers (or more)? A possible complication is that I'm hoping to > include open intervals such as (GreaterEqThan 3). -- Taral <[EMAIL PROTECTED]> "You can't prove anything." -- Gödel's Incompetence Theorem ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe