Re: [Haskell-cafe] Re: [Haskell] Simple IO Regions

2006-01-19 Thread Keean Schupke
Andrew Pimlott wrote: liftR :: (InRegion mark marks) = (h - m a) - Private mark h - Region marks m a liftR f (Private h) = Region $ f h This is not as safe. Try modifying your test2. Okay, I missed this... Have renamed the function unsafeLiftR... As you say still useful for

Re: [Haskell-cafe] Re: [Haskell] Simple IO Regions

2006-01-18 Thread Keean Schupke
Taral wrote: On 1/17/06, Keean Schupke [EMAIL PROTECTED] wrote: Just made a few modifications and thought it might be useful to people. I have rewritten the functions as liftR and bracketR over a MonadIO monad interface (allowing monad-transformers to be used). I'm sorry, but what

Re: [Haskell-cafe] Re: [Haskell] Simple IO Regions

2006-01-18 Thread Keean Schupke
up3 is quite easy to define, but it is specific to the monad-transformer you are lifting through... see attached for definition for the state-monad-transformer. Keean. Taral wrote: On 1/18/06, Keean Schupke [EMAIL PROTECTED] wrote: It didnt when I wrote the MonadIO stuff that I use

[Haskell-cafe] Re: [Haskell] Simple IO Regions

2006-01-17 Thread Keean Schupke
typeclass and one trivial instance. {-# OPTIONS -fglasgow-exts #-} -- parser.hs: Copyright (C)2001,2002 Keean Schupke. -- -- Polymorphic monadic consumer based parser. module Main where import Control.Monad hiding (guard) import Control.Concurrent import Control.Exception as Exception import

[Haskell-cafe] Re: Records vs HList

2005-11-24 Thread Keean Schupke
David Menendez wrote: Keean Schupke writes: HList can do O(log n) by the way, if the labels have order, you can implement a binary search tree of labels (Of course all the accessor functions would need to be rewritten). The idea of writing a type-level balanced binary search tree

[Haskell-cafe] Re: Records vs HList

2005-11-23 Thread Keean Schupke
David Menendez wrote: Keean Schupke writes: David Menendez wrote: Chris Kuklewicz writes: Would the record system describe at http://lambda-the-ultimate.org/node/view/1119 also be convertable into System Fw, GHC's existing, strongly-typeed intermediate language

[Haskell-cafe] Existential quantification of environments.

2005-11-22 Thread Keean Schupke
If I have a function: f x y = add x y and I want to type the function in isolation, then the type of 'add' is essentially carried in the environment... Lets say I want to make this type explicit in the type signature (where f is valid for any a where there is an add function on a -

Re: [Haskell-cafe] records proposals list

2005-11-22 Thread Keean Schupke
in the compiler rather than some problem with the HList code. Keean. Wolfgang Jeltsch wrote: Am Dienstag, 22. November 2005 07:33 schrieb David Menendez: Keean Schupke writes: Haskell already has static records (in H98) Dynamic records are addressed by the HList library, which

Re: [Haskell-cafe] records proposals list

2005-11-22 Thread Keean Schupke
My mistake, what you want is: ( mything .=. something .*. value .=. (27::Int) .*. logic .=. True .*. HNil ) Admittedly the label creation would benefit from some syntactic sugar to reduce typing... Keean. Bulat Ziganshin wrote: Hello Keean, Monday, November 21, 2005, 6:56:06

Re: [Haskell-cafe] records proposals list

2005-11-22 Thread Keean Schupke
, you just define instances of TTypeable for all your datatypes. There is a template-haskell library that can automatically derive TTypeable for any datatype as well. Keean. David Menendez wrote: Keean Schupke writes: Haskell already has static records (in H98) Dynamic records

Re: [Haskell-cafe] Records

2005-11-22 Thread Keean Schupke
Just my 2p worth... If I were designing a language I would not have used the '.' like Haskell does. One problem is that ascii does not support enough symbols (Hmm, PL1 here we come). I guess my vote would go to keeping the '.' as is to not break existing programs, and using a different symbol

Re: [Haskell-cafe] Existential quantification of environments.

2005-11-22 Thread Keean Schupke
Excellent link thanks! Not quite what I was thinking of - but definitely related. I'll give it a read and see if they want to existentially quantify environments... Keean. Adrian Hey wrote: On Tuesday 22 Nov 2005 10:39 am, Keean Schupke wrote: If I have a function: f x y = add x y

Re: [Haskell-cafe] Re: Pickling HList

2005-11-22 Thread Keean Schupke
This function is already in the HList library (well early versions anyway)... I dont think this is in the current distribution. Its a generic constructor wrapper. For example: hMarkAll Just hlist class HList l = HMarkAll c l m | c l - m where hMarkAll :: (forall a . a - c a) -

Re: [Haskell-cafe] Existential quantification of environments.

2005-11-22 Thread Keean Schupke
Wolfgang Jeltsch wrote: This seems to suggest: Add a == exists (add :: a - a - a) Doesn't exists normally quantify over types and not over values? It is quantifying over types, it is saying there exists a type a - a - a that has at least one value we will call add... I think

Re: [Haskell-cafe] Re: Pickling HList

2005-11-22 Thread Keean Schupke
performance of such code? Thanks, Joel On Nov 22, 2005, at 4:07 PM, Keean Schupke wrote: hMarkAll Just hlist class HList l = HMarkAll c l m | c l - m where hMarkAll :: (forall a . a - c a) - l - m instance HMarkAll c HNil HNil where hMarkAll _ _ = HNil instance HMarkAll

Re: [Haskell-cafe] records proposals list

2005-11-21 Thread Keean Schupke
Hi, Haskell already has static records (in H98) Dynamic records are addressed by the HList library, which uses extensions already present in GHC and Hugs (namely Multi-parameter type-classes and function-dependancies). So you can do this now... with reasonable syntax, for example

Re: [Haskell-cafe] Spurious program crashes

2005-11-21 Thread Keean Schupke
One thing, which I am sure you must have got right, but which burned me, is that you must explicitly free enitities created by FFI calls. For example network sockets exist outside of the haskell runtime, and are not free'd automatically when a haskell thread is killed, you need an explicit

Re: [Haskell-cafe] Records (was Re: [Haskell] Improvements to GHC)

2005-11-21 Thread Keean Schupke
You can change the project and update operators in the HList library to behave in exactly this way. At the moment they are constrained to not allow multiple identical labels in records. If this kind of access is considered useful, I can add it to the HList distribution. Keean. David

Re: [Haskell-cafe] Records (was Re: [Haskell] Improvements to GHC)

2005-11-21 Thread Keean Schupke
Can this not be done with the HList code? I am pretty sure you should be able to map projections over HLists of HLists... (although the HList generic map is a bit ugly, requiring instances of the Apply class). Actually you should look in the OOHaskell paper (if you haven't already) where it

Re: [Haskell-cafe] Interactive Haskell and hs-plugins

2005-11-01 Thread Keean Schupke
The symbols must be exported from the main program... I think you can pass the linker an option to force it to export symbols. Keean. Fraser Wilson wrote: Hi there, I would like to use evaluate arbitrary expressions in the context of a mixed-language (Ada, Haskell and about twelve lines

Re: [Haskell-cafe] Re: Network parsing and parsec

2005-09-23 Thread Keean Schupke
Andrew Pimlott wrote: On Tue, Sep 20, 2005 at 03:01:32PM +0100, Keean Schupke wrote: (see attachment for files) You didn't include all the used libraries (MonadControl, MonadState). Andrew Oops, here they are (it was extracted from a larger project), sorry about that... (Have

Re: [Haskell-cafe] Re: Network parsing and parsec

2005-09-20 Thread Keean Schupke
John Goerzen wrote: On 2005-09-15, Adam Turoff [EMAIL PROTECTED] wrote: On 9/15/05, John Goerzen [EMAIL PROTECTED] wrote: So, to make that approach work, I would really need to do a lot of work outside of Parsec -- the stuff that I really want to use Parsec for, I think. Well,

Re: [Haskell-cafe] Re: Network parsing and parsec

2005-09-20 Thread Keean Schupke
). -- parser.hs: Copyright (C)2001,2002 Keean Schupke. -- -- Polymorphic monadic consumer based parser. module Lib.Monad.ParserT(ParserT(..)) where import Control.Monad hiding (guard) import Control.Monad.Error import Lib.Monad.MonadT import Lib.Monad.MonadState import Lib.Monad.MonadParser import

Re: [Haskell-cafe] Re: Network parsing and parsec

2005-09-20 Thread Keean Schupke
Here's some useful definitions to go with that... module Lib.Parser.Parser(Parser,when,unless,guard,(|),opt,many,many1,sepBy, parse,alpha,digit,lower,upper,other,lexical,satisfy,optional,literal,untilP,untilParser,matchP) where ... (see attachment for files) Regards, Keean.

Re: [Haskell-cafe] Re: Network parsing and parsec

2005-09-20 Thread Keean Schupke
John Goerzen wrote: On Tue, Sep 20, 2005 at 02:29:12PM +0100, Keean Schupke wrote: It's unclear to me exactly how to mix the IO monad with Parsec. It doesn't really seem to be doable. Not to mention that if hGetContents is used, the Handle has to be put into non-buffering mode, which

Re: [Haskell-cafe] Re: Network parsing and parsec

2005-09-20 Thread Keean Schupke
be expected... Regards, Keean. Keean Schupke wrote: John Goerzen wrote: On Tue, Sep 20, 2005 at 02:29:12PM +0100, Keean Schupke wrote: It's unclear to me exactly how to mix the IO monad with Parsec. It doesn't really seem to be doable. Not to mention that if hGetContents

Re: [Haskell-cafe] Re: Network parsing and parsec

2005-09-20 Thread Keean Schupke
John Goerzen wrote: On Tue, Sep 20, 2005 at 03:05:25PM +0100, Keean Schupke wrote: strace seems to say yes. Thats odd, the source code seems to suggest that when you read past the end of the buffer it reads the next entire buffer (it has cases for each possible buffer

Re: [Haskell-cafe] embedding prolog in haskell.

2005-09-01 Thread Keean Schupke
Thanks for that, altough I have completely rewritten it! Here's the new implementation: unify :: Subst - (Term,Term) - [Subst] unify sigma (s,t) = let s' = if isVar s then subst s sigma else s t' = if isVar t then subst t sigma else t in if isVar s'

Re: [Haskell-cafe] pros and cons of static typing and side effects ?

2005-09-01 Thread Keean Schupke
Martin Vlk wrote: On pondělí 29 srpna 2005 8:57, Ketil Malde wrote: It contains descriptions of lots of real-world problems and how They are only implementing TRUTH and CWB, no? Yes, and lots of real-world situations that they faced during the development. That's what I

Re: [Haskell-cafe] Re: Oracle + Haskell advice?

2005-08-19 Thread Keean Schupke
Well, I'll put my hand up, I use Haskell with databases and web stuff... Unfortunately when I started the common tools were not available. I have a home-grown Haskell-Servlet server, with monadic continuation based HTML composition and a HaskellDB like database layer. It all works very well,

Re: [Haskell-cafe] embedding prolog in haskell.

2005-08-18 Thread Keean Schupke
= [] unify' :: Subst - [Term] - [Term] - [Subst] unify' s [] [] = [s] unify' s (t0:ts) (u0:us) = case unify s (t0,u0) of s@(_:_) - unify' (concat s) ts us _ - [] Keean. Keean Schupke wrote: Does anyone know if the source code for the embedded prolog (by Silvija

Re: [Haskell-cafe] embedding prolog in haskell.

2005-08-18 Thread Keean Schupke
Christian Maeder wrote: Keean Schupke wrote: implementation of unify? For example can the algorithm be simplified from my nieve attempt? Most importantly is it correct? It will not be correct without occurs check. You may also get different terms for the same variable in your

Re: [Haskell-cafe] static typing and interactivity

2005-08-18 Thread Keean Schupke
I look at the source code and think about it... Generally I code in vi, then run ghci, or compile and run. I find from experience the type errors are normally easy to fix, you just look at the error, and study the structure of the function. If I still have problems I edit the code to return or

[Haskell-cafe] embedding prolog in haskell.

2005-08-17 Thread Keean Schupke
Does anyone know if the source code for the embedded prolog (by Silvija Seres Michael Spivey) is available for download from anywhere? I have read the paper and found some of the types are wrong, some critical definitions are missing, and the definition of unify is missing. Regards,

Re: [Haskell-cafe] Re: [Haskell] pros and cons of static typing and side effects ?

2005-08-16 Thread Keean Schupke
My 2-pence worth on static typing. Static typing to me seems to be a simplified form of design by contract. There are some things about a program that can be proved true for all time. Types are an example of such a thing. We can use type systems to make assertions about properties that must

Re: [Haskell-cafe] Re: [Haskell] pros and cons of static typing and side effects ?

2005-08-16 Thread Keean Schupke
Benjamin Franksen wrote: On Tuesday 16 August 2005 21:56, Keean Schupke wrote: You can even use existential types to create lists of things with a common interface, where you do not know in advance what types you may need: data XWrap = XWrap (forall a . Show a = a) type ListXWrap

Re: [Haskell-cafe] Re: [Haskell] pros and cons of static typing and side effects ?

2005-08-16 Thread Keean Schupke
Lennart Augustsson wrote: Keean Schupke wrote: quicksort :: IntList - OrderedIntList By this we are asking the compiler to prove (by induction) that the function provided can only result in correctly ordered lists - irrespective of what arguments it is given (ie proved true for any

Re: [Haskell-cafe] Re: [Haskell] pros and cons of static typing and side effects ?

2005-08-16 Thread Keean Schupke
Benjamin Franksen wrote: as in data XWrap = Show a = XWrap a I always thought this was a pretty nice idea. Wow, I hadn't thought of that... of course you still need to explicitly give the universal quantification if you need it. I guess the best option is to make it optional, as I

Re: [Haskell-cafe] matrix computations based on the GSL

2005-07-08 Thread Keean Schupke
Henning Thielemann wrote: My objections to making everything a matrix were the objections I sketched for MatLab. The example, again: If you write some common expression like transpose x * a * x Which just goes to show why haskell limits the '*' operator to multiplying the same types. Keep

Re: [Haskell-cafe] matrix computations based on the GSL

2005-07-08 Thread Keean Schupke
Henning Thielemann wrote: Let me elaborate on that: In some cases putting vectors as columns into a matrix then applying a matrix operation on this matrix leads to the same like to 'map' a matrix-vector operation to a list of vectors. But in other cases (as the one above) this is not what you

Re: [Haskell-cafe] matrix computations based on the GSL

2005-07-08 Thread Keean Schupke
Henning Thielemann wrote: I'm excited if your code gets swamped by conversions between Double and Matrix then. I really plead for representing everything with strings, this is the most simple and most flexible solution! :-] Surely its a case of balancing the advantage of type safety against

Re: [Haskell-cafe] matrix computations based on the GSL

2005-07-08 Thread Keean Schupke
Henning Thielemann wrote: Do you mean [x,y,z,1] * [[1,0,0,0],[0,1,0,0],[0,0,1,0],[dx,dy,dz,dw+1]] ? Erm, yes thats what I meant ... but you obviously got the point. but how is this different from adding vectors? If we allow vector addition then we no longer have the nice separation

[Haskell-cafe] Re: matrix computations based on the GSL

2005-07-08 Thread Keean Schupke
Is a matrix is a linear operation on a vector, does it not make sense to define matrix applicaion: mapply :: Matrix - Vector - Vector Then you can define say: rotate90 = mapply rotationMatrix90 v' = rotate90 v Keean. ___ Haskell-Cafe

Re: [Haskell-cafe] matrix computations based on the GSL

2005-07-08 Thread Keean Schupke
Henning Thielemann wrote: In general a vector need not to be a linear operator. You talked about vector translation, translation is not a linear operator. You gave some process to map the problem to somewhere, where it becomes a linear operator. Other people said that the scalar product with a

Re: [Haskell-cafe] matrix computations based on the GSL

2005-07-08 Thread Keean Schupke
Henning Thielemann wrote: On Fri, 8 Jul 2005, Keean Schupke wrote: So the linear operator is translation (ie: + v)... effectively 'plus' could be viewed as a function which takes a vector and returns a matrix (operator) (+) :: Vector - Matrix Since a matrix _is_ not a linear map

[Haskell-cafe] Re: matrix computations based on the GSL

2005-07-08 Thread Keean Schupke
Henning Thielemann wrote: does it not make sense to define matrix applicaion: mapply :: Matrix - Vector - Vector Then you can define say: rotate90 = mapply rotationMatrix90 v' = rotate90 v ... that's what I said about mulVec. I guess that means we agree... Keean.

Re: [Haskell-cafe] matrix computations based on the GSL

2005-07-05 Thread Keean Schupke
Henning Thielemann wrote: I'm uncertain about how who want to put the different kinds of multiplication into one method, even with multi-parameter type classes. You need instances (*) :: Matrix - Matrix - Matrix (*) :: RowVector - Matrix - RowVector (*) :: Matrix - ColumnVector - ColumnVector

Re: [Haskell-cafe] matrix computations based on the GSL

2005-07-05 Thread Keean Schupke
David Roundy wrote: In short, especially since the folks doing the work (not me) seem to want plain old octave-style matrix operations, it makes sense to actually do that. *Then* someone can implement an ultra-uber-tensor library on top of that, if they like. And I would be interested in a nice

Re: [Haskell-cafe] Re[4]: [Haskell] Dynamic binding

2005-06-23 Thread Keean Schupke
Interestingly this is exactly the approach taken in the OOHaskell paper! The difference is we used extensible records with subtyping (from the HList paper) to implement inheritance and overloading, which you cannot do with ordinary Haskell records. So you statment that it is better to do it in

Re: [Haskell-cafe] Open mutable records

2005-05-23 Thread Keean Schupke
Have you seen the OOHaskell paper (the follow up to the HList paper)... It looks like you do much the same thing - with some differences... Would be interesting to get your comments on the paper: http://homepages.cwi.nl/~ralf/OOHaskell/ Keean. Einar Karttunen wrote: Hello I recently

Re: [Haskell-cafe] RFE: Extensible algebraic user-defined data types?

2005-04-29 Thread Keean Schupke
David Menendez wrote: The downside is that a function that might normally be typed Either A B - C now will have the type: (HTypeIndexed l, HTypeProxied l, HOccurs (Proxy (Left A)) l, HOccurs (Proxy (Right B)) l) = TIC l - C But it will accept a TIC (HEither A B) and a TIC

Re: [Haskell-cafe] Instances of constrained datatypes

2005-04-08 Thread Keean Schupke
Can you not define functor like Hughes defines a restricted monad (section 3 in the paper)... Keean Arjun Guha wrote: One way to do roughly what you want is to pass the dictionary yourself: data EqDict a = EqDict { leq :: a - a - Bool } data EqList a = EqList (EqDict a) [a]

Re: [Haskell-cafe] List containing different types but all implementing the same class

2005-04-08 Thread Keean Schupke
You can do this like: data TTrue = TTrue data TFalse = TFalse data Nil = Nil data Cons a l = Cons a l class Constrain c a b | c a - b where constrain :: c - a - b data ZConstraint = ZConstraint instance Z a b = Constrain ZConstraint a b class List c l instance List c Nil instance

Re: [Haskell-cafe] Instances of constrained datatypes

2005-04-07 Thread Keean Schupke
I think it is more a problem of imlpementation than one of what is desirable. A Constrained data type: data (Eq v) = EqList v = EqList [v] The problem is how to get the dictionary for the class Eq to the application site: f :: EqList v - EqList v f (EqList (u0:us)) (EqList (v0:vs)) | v0 == u0

Re: [Haskell-cafe] Instances of constrained datatypes

2005-04-07 Thread Keean Schupke
of equality on elements of type 'a' is passed with the list type, so it can be used wherever the list type is used, without requiring extra constraints. Keean. Keean Schupke wrote: I think it is more a problem of imlpementation than one of what is desirable. A Constrained data type: data (Eq v

Re: [Haskell-cafe] Instances of constrained datatypes

2005-04-07 Thread Keean Schupke
of equality on elements of type 'a' is passed with the list type, so it can be used wherever the list type is used, without requiring extra constraints. Keean. Keean Schupke wrote: I think it is more a problem of imlpementation than one of what is desirable. A Constrained data type: data (Eq v

Re: [Haskell-cafe] Linux device drivers

2005-03-22 Thread Keean Schupke
Actually with PCI chipsets, implementing a generic BusMaster DMA driver is not too hard, assuming you already have interrupts handled (and you don't want 64bit DMA support)... You just load the parameters for the disk read into the PCI registers, and wait for the completed interrupt. I wrote a

Re: [Haskell-cafe] Linux device drivers

2005-03-22 Thread Keean Schupke
I thought the BusMaster interface was pretty uniform, unlike the earlier DMA interfaces which varied from chipset to chipset. Keean. Lennart Augustsson wrote: But there are plenty of minor variations on how to program and initiate DMA for different devices. -- Lennart Keean Schupke wrote

Re: [Haskell-cafe] tuple and HList

2005-03-22 Thread Keean Schupke
requirements, the compiler can safely infer all required constraints from the code (IE just don't give signatures for the functions). Keean. Keean Schupke wrote: You can avoid the need to declare a new class for each constrained list by using the following: class Constraint c a data SHOW instance

Re: [Haskell-cafe] Linux device drivers

2005-03-22 Thread Keean Schupke
. -- Lennart Keean Schupke wrote: I thought the BusMaster interface was pretty uniform, unlike the earlier DMA interfaces which varied from chipset to chipset. Keean. Lennart Augustsson wrote: But there are plenty of minor variations on how to program and initiate DMA for different devices

Re: [Haskell-cafe] Linux device drivers

2005-03-22 Thread Keean Schupke
The generic busmaster diver should go all the way to UDMA mode 4 (133Mb) Keean. Lennart Augustsson wrote: Keean Schupke wrote: Have a look at the linux kernel IDE drivers, look for Generic IDE Chipset support That's the part I missed, you were talking about IDE chips. Yes, they have many

Re: [Haskell-cafe] Linux device drivers

2005-03-22 Thread Keean Schupke
I don't think I said anything controversial. I guess I was just over-simplifying things by only considering PC IDE hardware - but then again that must get you running on 90% of the systems people are likely to have lying around to play with a developmental OS on. On the other hand the average

Re: [Haskell-cafe] tuple and HList

2005-03-21 Thread Keean Schupke
David Menendez wrote: instance Functor ((,) a) where fmap f (x,y) = (x, f y) If we get rid of '(,)' and redefine '(a,b)' as sugar for 'TCons a (TCons b HNil)' (or whatever), then there is no way to declare the above instance. I don't think that's a

Re: [Haskell-cafe] invalid character encoding

2005-03-20 Thread Keean Schupke
One thing I don't like about this automatic conversion is that it is hidden magic - and could catch people out. Let's say I don't want to use it... How can I do the following (ie what are the new API calls): Open a file with a name that is invalid in the current locale (say a zip disc from

Re: [Haskell-cafe] tuple and HList

2005-03-20 Thread Keean Schupke
Frederik Eaton wrote: Another thing which I don't think is mentioned in the paper, which is convenient, is that you can define HLists all of whose elements are members of a given class: class HListShow l instance HListShow HNil instance (Show a, HListShow l) = HListShow (a :* l) You can avoid

Re: [Haskell-cafe] tuple and HList

2005-03-20 Thread Keean Schupke
Frederik Eaton wrote: That's a neat technique. Since it's so general it would be nice if there were a way to make it more automatic, could one use template haskell? It seems one should be able to write HListConstraint $(mkConstraint Show) l to generate the declarations automatically. Frederik

Re: [Haskell-cafe] invalid character encoding

2005-03-19 Thread Keean Schupke
David Roundy wrote: That's not true, there could be many filesystems, each of which uses a different encoding for the filenames. In the case of removable media, this scenario isn't even unlikely. I agree - I can quite easily see the situation occuring where a student (say from japan) brings

Re: [Haskell-cafe] invalid character encoding

2005-03-17 Thread Keean Schupke
I cannot help feeling that all this multi-language support is a mess. All strings should be coded in a universal encoding (like UTF8) so that the code for a character is the same independant of locale. It seems stupid that the locale affects the character encodings... the code for an 'a' should

Re: [Haskell-cafe] Re: Best practices for modular programming in Haskell

2005-03-17 Thread Keean Schupke
Yes. Its actually very easy once you get how instance resolution occurs and how constraints work. I have used this style to code a database interface, and am using the OOHaskell style (which is related to this kind of stuff) for an application server (was a SOAP server, but might migrate to the

Re: [Haskell-cafe] Joy Combinators (Occurs check: infinite type)

2005-03-11 Thread Keean Schupke
Greg Buchholz wrote: Wow. Color me impressed. A little under a week ago, I stumbled onto Joy, and thought to myself that it could be translated almost directly into Haskell (which would imply it was possible to statically type). Well, it wasn't quite as direct as I had initially thought, but

Re: [Haskell-cafe] Joy Combinators (Occurs check: infinite type)

2005-03-09 Thread Keean Schupke
Greg Buchholz wrote: Keean Schupke wrote: I dont see why this is illegal... what do we want? take the top two items from the stack? With the code below (direct translation from tuples to HLists) I still get an occurs check error when trying to define fact5... Okay the reason

Re: [Haskell-cafe] Joy Combinators (Occurs check: infinite type)

2005-03-09 Thread Keean Schupke
Greg Buchholz wrote: Keean Schupke wrote: Haskell is not dependantly typed, so cannot deal with types that depend on values. Can anyone recommend a nice dependently typed language to play with? Cayenne, Epigram, other? I have refactored your code into a type level Haskell program

Re: [Haskell-cafe] tuples and Show in GHC

2005-03-07 Thread Keean Schupke
Remi Turk wrote: On Mon, Mar 07, 2005 at 12:05:41AM +, Keean Schupke wrote: Daniel Fischer wrote: The Show instances for tuples aren't automatically derived, they are defined in GHC.Show. So somewhere there must be an end, probably the author(s) thought that larger tuples than

Re: [Haskell-cafe] Joy Combinators (Occurs check: infinite type)

2005-03-07 Thread Keean Schupke
Daniel Fischer wrote: And, BTW, that's why Keean et al's HList library doesn't help here either, the type of an HList determines the number of elements and the type of each, so there we face the same problems as with nested tuples. What we need is type Stack = [ArbitraryType] (from the HList

Re: [Haskell-cafe] Joy Combinators (Occurs check: infinite type)

2005-03-06 Thread Keean Schupke
Daniel Fischer wrote: I don't know Joy, but probably there the stack is (roughly) a heterogenous list, which is hard to model in Haskell, think of data Element = Bool Bool | Char Char | Int Int . . . | IntToBool

Re: [Haskell-cafe] tuples and Show in GHC

2005-03-06 Thread Keean Schupke
Daniel Fischer wrote: The Show instances for tuples aren't automatically derived, they are defined in GHC.Show. So somewhere there must be an end, probably the author(s) thought that larger tuples than quintuples aren't used often enough to bother. That's not a principled reason but a practical

Re: [Haskell-cafe] how do I avoid excessive constructor application?

2005-03-02 Thread Keean Schupke
Something like: class Coerce a b where coerce :: a - b The class must be in a separate file from the instance so that the compiler does not determine that a == b for all instances. instance Coerce a a where coerce = id If it turns out the left and right types do not match, you get a no

Re: [Haskell-cafe] Re: New to haskell: unresolved overloading question

2005-02-21 Thread Keean Schupke
There are problems with this approach... Instance heads are only chosen by the pattern not the constraints, so: instance (Ord a, Num a) = ApproxEq a where x ~= y = (abs (x-y) 1) Will match any type at all (whether a member of Ord or Num or not) and then will fail if the particular type is not

Re: [Haskell-cafe] What is MonadPlus good for?

2005-02-14 Thread Keean Schupke
Technically this is a use of MonadError, not MonadPlus (see earlier discussion about how IO is _not_ an instance of MonadPlus). Keean. David Roundy wrote: On Sat, Feb 12, 2005 at 01:08:59PM -0500, Benjamin Pierce wrote: I have seen lots of examples that show how it's useful to make some

Re: [Haskell-cafe] What is MonadPlus good for?

2005-02-14 Thread Keean Schupke
[EMAIL PROTECTED] wrote: G'day all. Quoting David Roundy [EMAIL PROTECTED]: It might be interesting to write a backtracking IO-like monad which obeyed m mzero === mzero. I imagine you could do it for something like an ACID database, if you define === as meaning has the same final result on

Re: [Haskell-cafe] File path programme

2005-01-27 Thread Keean Schupke
Ben Rudiak-Gould wrote: I'm tentatively opposed to (B), since I think that the only interesting difference between Win32 and Posix paths is in the set of starting points you can name. (The path separator isn't very interesting.) But maybe it does make sense to have separate starting-point ADTs

Re: [Haskell-cafe] File path programme

2005-01-27 Thread Keean Schupke
I guess it's just that I'm more concerned with making possible what is currently impossible (according to the library standards)--that is, using FFI and IO on the same file--rather than just adding utility features that application developers could have written themselves. I suppose we don't

Re: [Haskell-cafe] File path programme

2005-01-27 Thread Keean Schupke
Jules Bean wrote: only it isn't. That's a property of a shell, the underlying OS allows spaces in file names with no need for an escaping mechanism. Okay, that was a mistake... but it does not change the point, that pathToString needs to work out what platform it is on, and doing it without

Re: [Haskell-cafe] Re: Visual Programming Languages

2005-01-26 Thread Keean Schupke
Hmm, can't resist commenting on this one! Bayley, Alistair wrote: This was odd... Some cherry-picked quotes from the manifesto: http://alarmingdevelopment.org/index.php?p=5 - Visual languages are not the solution: ... common idea is to replace AST structures with some form of graphical diagram.

Re: [Haskell-cafe] Re: what is inverse of mzero and return?

2005-01-25 Thread Keean Schupke
Daniel Fischer wrote: I think, 1. should be acceptable to everybody, and 2. as a principle too, only the question of which effects are relevant needs to be answered. It's plain that not all measurable effects are relevant. My inclination to ignore the side-effects stemmed from the (irrational)

Re: [Haskell-cafe] Re: what is inverse of mzero and return?

2005-01-25 Thread Keean Schupke
I think I see, but if the objects are types, arn't the morphisms functions on types not values? Keean. Ashley Yakeley wrote: In article [EMAIL PROTECTED], Keean Schupke [EMAIL PROTECTED] wrote: I am sure monads in Haskell (and other functional languages like ML) are defined on types

Re: [Haskell-cafe] Re: what is inverse of mzero and return?

2005-01-25 Thread Keean Schupke
Jules Bean wrote: No. Well: they are functions 'on' types, but functions 'on' types map values to values. Analogy: In the category of sets and functions, the objects are sets and the morphisms are functions. The functions --- from sets to sets --- take objects in one set to objects in another

Re: [Haskell-cafe] Re: what is inverse of mzero and return?

2005-01-25 Thread Keean Schupke
Jules Bean wrote: Well, mzero isn't a return value in the IO monad, it's an exception. But yes, I agree with you that the (plausible) laws I have seen for MonadPlus seem to say that mzero should ignore the actions. But this in practice is not how IO behaves. Jules I can see three possible

Re: [Haskell-cafe] Re: what is inverse of mzero and return?

2005-01-25 Thread Keean Schupke
Jules Bean wrote: It's in Control.Monad.Error. Not documented though. Jules Ahh, so it is: instance MonadPlus IO where mzero = ioError (userError mzero) m `mplus` n = m `catch` \_ - n So, the author of this obviously subscribed to the view that side-effects are not counted

Re: [Haskell-cafe] Re: what is inverse of mzero and return?

2005-01-24 Thread Keean Schupke
Ashley Yakeley wrote: If you remember your category theory, you'll recall that two morphisms are not necessarily the same just because they're between the same two objects. For instance, the objects may be sets, and the morphisms may be functions between sets: morphisms from A to B are the

Re: [Haskell-cafe] Re: what is inverse of mzero and return?

2005-01-24 Thread Keean Schupke
Jules Bean wrote: I've lost track of what you mean by 'this case' and indeed of what you mean by 'join' (did you mean mplus? the word join is normally used for the operation of type m (m a) - m a, which is not often used directly in haskell) However, even addressing your point about

Re: [Haskell-cafe] Re: File path programme

2005-01-24 Thread Keean Schupke
Marcin 'Qrczak' Kowalczyk wrote: These rules agree on foo, foo. and foo.tar.gz, yet disagree on foo.bar.; I don't know which is more natural. Filename extensions come from DOS 8.3 format. In these kind of names only one '.' is allowed. Unix does not have filename extensions, as '.' is just a

Re: [Haskell-cafe] Re: what is inverse of mzero and return?

2005-01-24 Thread Keean Schupke
Ashley Yakeley wrote: I disagree. Clearly (putStrLn Hello mzero) is not the same as mzero. Yes it is, side effects are quite clearly not counted. The value of (putStrLn Hello mzero) is mzero. In reference to the idea of splitting MonadPlus, what category would you be operating in, if you have

Re: [Haskell-cafe] Re: what is inverse of mzero and return?

2005-01-24 Thread Keean Schupke
Just thinking about this, a monad is a Functor plus two natural-tranformations, Unit and Join. Is there an equivalent definition for MonadPlus... I am not sure I understand where MonadPlus comes from? Is it just a Functor and two different definitions of Unit and Join (from those chosen to be

Re: [Haskell-cafe] Re: what is inverse of mzero and return?

2005-01-24 Thread Keean Schupke
Ashley Yakeley wrote: I don't believe this represents a good understanding of IO actions as Haskell values. For instance, 'return ()' and 'putStrLn Hello' are the same type, but are clearly different actions and so are usually considered to be different values. That the latter prints out text

Re: [Haskell-cafe] Re: what is inverse of mzero and return?

2005-01-23 Thread Keean Schupke
Jorge Adriano Aires wrote: On the list monad, I think of the mplus operation as the union two non-deterministic states. Mzero is the state that works as the identity (which is when you have no possible state at all). Okay... thats a definition of a monoid. What would happen if this was the

Re: [Haskell-cafe] Re: what is inverse of mzero and return?

2005-01-23 Thread Keean Schupke
Aaron Denney wrote: You can, but the other one turns it into a copy of the Maybe Monad, so the current one is more useful. So what does this mean in terms of Ashley's question: But only some instances (such as []) satisfy this: (mplus a b) = c = mplus (a = c) (b = c)

Re: [Haskell-cafe] Re: what is inverse of mzero and return?

2005-01-23 Thread Keean Schupke
Ashley Yakeley wrote: I think it would be helpful if all these classes came with their laws prominently attached in their Haddock documentation or wherever. The trouble with MonadPlus is that the precise set of associated laws is either unspecified or not the most useful (I assume there's a

Re: [Haskell-cafe] Re: what is inverse of mzero and return?

2005-01-22 Thread Keean Schupke
Ashley Yakeley wrote: In article [EMAIL PROTECTED], S. Alexander Jacobson [EMAIL PROTECTED] wrote: I assume there is a standard name for this class/function: instance Foo [] where foo [] = mzero foo (x:_) = return x instance Foo (Maybe x) where foo Nothing = mzero foo Just

Re: [Haskell-cafe] Re: what is inverse of mzero and return?

2005-01-22 Thread Keean Schupke
Ashley Yakeley wrote: In article [EMAIL PROTECTED], Keean Schupke [EMAIL PROTECTED] wrote: This fits the above description, but I don't see how the following can be true: (mplus a b) = c = mplus (a = c) (b = c) Try it (and my test code) with [], which is an instance of MonadPlus

  1   2   3   >