Re: [Haskell-cafe] The values of infinite lists

2006-05-10 Thread Bjorn Lisper
Deokhwan Kim:
>Bjorn Lisper wrote:
>
>> precisely the same as _|_. Only certain kinds of nontermination can be
>> modeled by _|_ in a non-strict language.
>
>What kinds of nontermination are modeled by _|_ in Haskell?

Nonterminating computations that never return anything. For instance,

inf = inf

Björn Lisper
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Porting GHC to OSX86?

2006-05-10 Thread Scott Weeks
Thanks for your response, I'll follow your saga and hopefully learn a  
bit more about GHC's guts in the process.



On 07/05/2006, at 4:05 AM, Reilly Hayes wrote:



You'll get a better response to this on the glasgow-haskell-users  
list.  I'm cross-posting my reply.


I'm brand new to hacking on GHC, but I've been working on this in  
my pitifully meagre spare time.  The actual expert is Wolfgang  
Thaller, but he doesn't seem to be around the lists lately.  I was  
able to generate hc files on a 386 linux box (actually on a  
Parallels virtual machine on my mac, as my linux boxen all run 64  
bit linuces).I'll share my findings so far:



1) STABLE does not have the appropriate code in the Mangler to deal  
with Darwin/86.  I've been playing with various versions of HEAD.


2) HEAD has gone through a major revision to the directory  
structure.  The documentation and some of the build processes have  
not caught up.  Simon Marlow sent a helpful e-mail to the ghc users  
list a few days ago that you should look at.


3) Building the .hc files mostly requires the appropriate settings  
in mk/build.mk on the Host (linux) machine.  I'll include my  
build.mk below.  There is a target in the top level makefile called  
hc-file-bundle (which needs to be invoked with the parameter  
ProjectNameShort=ghc in HEAD and Project=ghc in STABLE).  This  
target packages up the .hc files, but does not build them.  Some of  
the .hc files in utils (genapply, genprimopcode, & ghc-pkg) don't  
get built.  I just cd to the directories and make them by hand (be  
sure to use the in-place compiler).  A GhcUtilsHcOpts variable in  
the make structure would be nice (in order to pass -keep-hc-files  
to ghc when building these on the host).


4) I have been working with Registerised hc files.  This may have  
been a mistake, as registerised code seems to present some unique  
challenges on Darwin/86.  See the items below for a discussion.


5) If I understand correctly (somebody with better knowledge please  
correct me), there is a register allocation conflict between ghc  
and relocatable code generated by gcc on the 386 (gcc flag -fPIC).   
This limits ghc to producing static binaries.  The gcc in Xcode  
builds relocatable code by default and requires -static to build  
static binaries.


I think this conflict is limited to code that goes through the  
Mangler (registerized code).


6) If I understand correctly, there is code in the RTS that cannot  
be built using the native code generator.  Which suggests that  
we're stuck with static binaries.  There is a ticket to fix this in  
HEAD.


7) Mac OS X really doesn't like static binaries.  In fact, in order  
to link a static binary, you have to go to opendarwin and download  
the Csu package to build crt0.o.  It's not included in any of the  
development tools.  Apple warns that static binaries are likely to  
fail to operate in O/S version changes.


Curently I'm fighting with the Makefiles to figure out how to get  
the -static flag stuffed into all of the invocations of gcc.  Some  
of the invocations in rts components don't seem to obey the normal  
variables used in the makefile structure.  I haven't had time to  
puzzle this out and won't for a few days.



mk/build.mk used to generate hc files:


GhcLibHcOpts = -O -fasm -keep-hc-files
GhcRtsHcOpts = -fasm -keep-hc-files
GhcWithInterpreter = NO
GhcStage1HcOpts = -O
GhcStage2HcOpts = -O -fasm -keep-hc-files
SRC_HC_OPTS += -H32m



-reilly hayes

On May 5, 2006, at 7:34 PM, Scott Weeks wrote:


Hi All,

Does anyone know if there's been any headway on this? If there's not
a port available, where do I go about finding the hc files? Could I
compile on a windows or linux x86 box and use the generated hc files
to bootstrap?

Cheers,
Scott

On 22/03/2006, at 7:09 AM, Deling Ren wrote:


Hi there,

Has anyone made any attempt to port GHC to Mac OS X on x86?
Wolfgang Thaller’s binary package runs over Rosetta but slow (not
surprising). It can not be used to compile a native version either
(I got some errors related to machine registers).

I tried to do a bootstrap but can't find the ".HC" files mentioned
in the manual. They don't seem to be on the download page of GHC.
Any ideas?

Thanks.

Deling___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe



___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Reilly Hayes
[EMAIL PROTECTED]







___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] The values of infinite lists

2006-05-10 Thread Robert Dockins
On Wednesday 10 May 2006 02:49 pm, you wrote:
> Robert Dockins wrote:
> > On Wednesday 10 May 2006 12:30 pm, Brian Hulley wrote:
> >> Bjorn Lisper wrote:
> >>> Nontermination is not
> >>> the precisely the same as _|_. Only certain kinds of nontermination
> >>> can be modeled by _|_ in a non-strict language.
> >>
> >> What kinds of non-termination are *not* modelled by _|_ in Haskell?
> >
> > Non-termination that is "doing something".
> >
> > For example consider:
> >
> > ] ones = 1 : ones
> >
> > If I try to take its length, I get _|_.  So:
> >
> > ] main = print (length ones)
> >
> > Will churn my CPU forever without producing any output.
> >
> > However, if I print each item sequentially:
> >
> > ] main = mapM print ones
> >
> > I'll get a never-ending stream of '1' on my console.  This is not the
> > same as bottom because it's "doing something".
>
> I can see what you're getting at, but I don't know if I agree with the idea
> that "doing" should affect whether or not one sees the result of the above
> computation as bottom or not. With a hypothetical implementation of
>
>   runIO :: IO a -> RealWorld -> (RealWorld, a)
>
> I could write:
>
> ] (r',_) = runIO (mapM print ones) realWorld
>
> and this computation, even though some printing would be observable, still
> evaluates to bottom, because r' will never be bound.

Humm... how do you define observable? If r' is never bound, how can I observe 
any intermediate printing?

More generally, if you want the possibility of implementing 'runIO' as a pure 
function (the world-state-transformer view of Haskell IO), you are forced to 
make a closed-world assumption.

I don't believe that concurrency can be given a nice story in this view;you 
pretty much have to do something ugly like calculate the result of all 
possible interleavings (yuck!).  And your world is still closed.

The world-state-transformer idea is nice as a didactic tool, but I don't think 
its the right world-view for serious thinking about Haskell's semantics.

> > Now, obviously this definition is pretty imprecise, but maybe it
> > helps you get the idea.  Now for the corner cases.  What about:
> >
> > ] main = sequence_ repeat (return ())
> >
> > ?  I'd personally say it is _not_ bottom.  Even though "return ()" is
> > a completely useless action, I'm inclined to say its "doing
> > something" in some theoretical sense (mostly because I think of _|_
> > as being a property of the functional part of Haskell).
>
> I thought everything in Haskell is purely functional - surely that is the
> whole point of using monads? :-)

Sure.  But in that world-view then you don't think of the IO actions as 
"running" at all, so you can't discuss their termination properties.  This is 
more or less what all accounts (at least the ones I've seen) of Haskell's 
semantics do -- they provide a denotational semantics for the lambda terms 
basicaly ignore the meaning of IO actions.

> I'd have thought that "doing" is simply a  projection of the purely
> functional "being" into the stream of time and therefore cannot be part of
> the discourse regarding the nature of bottom...

My favorite view of Haskell semantics is of a coroutining abstract machine 
which alternates between evaluating lambda terms to obtain the terms of a 
process calculus, and then reducing those process calculus terms; some 
process calculus reduction rules call into the lambda reduction engine to 
grow more (process calculus) terms to reduce.  The observable behavior of the 
program is defined in terms of the sequence of reductions undertaken by the 
process calculus engine.

In this view "bottom" is the denotion of all (lambda) terms which make the 
lambda portion of the machine fail to terminate, and never return control to 
the process calculus part -- thus no further observations will be generated 
by the program.

> Regards, Brian.



Rob Dockins
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] The values of infinite lists

2006-05-10 Thread Brian Hulley

Robert Dockins wrote:

On Wednesday 10 May 2006 12:30 pm, Brian Hulley wrote:

Bjorn Lisper wrote:

Nontermination is not
the precisely the same as _|_. Only certain kinds of nontermination
can be modeled by _|_ in a non-strict language.


What kinds of non-termination are *not* modelled by _|_ in Haskell?


Non-termination that is "doing something".

For example consider:

] ones = 1 : ones

If I try to take its length, I get _|_.  So:

] main = print (length ones)

Will churn my CPU forever without producing any output.

However, if I print each item sequentially:

] main = mapM print ones

I'll get a never-ending stream of '1' on my console.  This is not the
same as bottom because it's "doing something".


I can see what you're getting at, but I don't know if I agree with the idea 
that "doing" should affect whether or not one sees the result of the above 
computation as bottom or not. With a hypothetical implementation of


 runIO :: IO a -> RealWorld -> (RealWorld, a)

I could write:

] (r',_) = runIO (mapM print ones) realWorld

and this computation, even though some printing would be observable, still 
evaluates to bottom, because r' will never be bound.




Now, obviously this definition is pretty imprecise, but maybe it
helps you get the idea.  Now for the corner cases.  What about:

] main = sequence_ repeat (return ())

?  I'd personally say it is _not_ bottom.  Even though "return ()" is
a completely useless action, I'm inclined to say its "doing
something" in some theoretical sense (mostly because I think of _|_
as being a property of the functional part of Haskell).


I thought everything in Haskell is purely functional - surely that is the 
whole point of using monads? :-)
I'd have thought that "doing" is simply a  projection of the purely 
functional "being" into the stream of time and therefore cannot be part of 
the discourse regarding the nature of bottom...


Regards, Brian. 


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] The values of infinite lists

2006-05-10 Thread Robert Dockins
On Wednesday 10 May 2006 12:30 pm, Brian Hulley wrote:
> Bjorn Lisper wrote:
> > Nontermination is not
> > the precisely the same as _|_. Only certain kinds of nontermination
> > can be modeled by _|_ in a non-strict language.
>
> What kinds of non-termination are *not* modelled by _|_ in Haskell?

Non-termination that is "doing something".

For example consider:

] ones = 1 : ones

If I try to take its length, I get _|_.  So:

] main = print (length ones)

Will churn my CPU forever without producing any output.

However, if I print each item sequentially:

] main = mapM print ones

I'll get a never-ending stream of '1' on my console.  This is not the same as 
bottom because it's "doing something".

Now, obviously this definition is pretty imprecise, but maybe it helps you get 
the idea.  Now for the corner cases.  What about:

] main = sequence_ repeat (return ())

?  I'd personally say it is _not_ bottom.  Even though "return ()" is a 
completely useless action, I'm inclined to say its "doing something" in some 
theoretical sense (mostly because I think of _|_ as being a property of the 
functional part of Haskell).
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] The values of infinite lists

2006-05-10 Thread Brian Hulley

Bjorn Lisper wrote:

Nontermination is not
the precisely the same as _|_. Only certain kinds of nontermination
can be modeled by _|_ in a non-strict language.


What kinds of non-termination are *not* modelled by _|_ in Haskell?

Thanks, Brian.
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Re: [Haskell] FP-style vs. OO-style AST structure

2006-05-10 Thread Robert Dockins
[moved to haskell-cafe]

On Wednesday 10 May 2006 11:09 am, Doug Kirk wrote:
> Hi,
>
> I'm a Haskell newbie, but not new to programming, and I have a
> question regarding style (I think).
>
> I'm writing a parser for OMG's OCL, and have two ways of defining the
> AST model of a constraint. Each constraint in OCL has the following 4
> characteristics:
>
> 1. name :: Maybe String
> 2. context :: UmlElement
> 3. expr :: OclExpression
> 4. type :: OclConstraintType
>
> Now, having come from an O-O background, this looks right; however, in
> an FPL, it may not be. OclConstraintType is essentially an enumeration
> of the values:
>
>  Invariant
>
>| Precondition
>| Postcondition
>| InitialValue
>| Derivation
>| Body
>
> The question is this: is it better to create a single type as above
> with a 'type' attribute, or would it be better to use the types as
> separate constructors of a Constraint, each constructor taking the
> same attributes?

Opinions may differ on this, bit I'm going to go out on a limb and say that 
using separate constructors with the same field names is the more idiomatic 
approach in Haskell.

Having a product type or a big record with an enumerated tag field is usually 
just a way to simulate sum types.  Why do that if the language supports them 
directly?

> I'm looking to avoid any pitfalls that could occur with either
> decision, and at this point I don't know the benefits of doing it one
> way vs. the other.

So long as every constraint has exactly the same fields, there isn't much 
practical difference.  If later you discover that different kinds of 
constraints need different fields, you'll be better off with the separate 
constructors.

> BTW, I am using UUST Parser Combinator AG for the parser definition,
> in case that makes a difference.
>
> Thanks!
> --doug
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] The values of infinite lists

2006-05-10 Thread Duncan Coutts
On Wed, 2006-05-10 at 23:29 +0900, Deokhwan Kim wrote:
> Bjorn Lisper wrote:
> 
> > precisely the same as _|_. Only certain kinds of nontermination can be
> > modeled by _|_ in a non-strict language.
> 
> What kinds of nontermination are modeled by _|_ in Haskell?

let f = f in f 3

length [0..]


Duncan

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] The values of infinite lists

2006-05-10 Thread Deokhwan Kim
Bjorn Lisper wrote:

> precisely the same as _|_. Only certain kinds of nontermination can be
> modeled by _|_ in a non-strict language.

What kinds of nontermination are modeled by _|_ in Haskell?
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] develop new Haskell shell?

2006-05-10 Thread Brian Hulley

Donald Bruce Stewart wrote:


Funny this should come up. We've just had several submissions to work
on a functional shell for the google summer of code.

Here's a bit of a summary of what's been done in Haskell I prepared a
while back.

http://www.cse.unsw.edu.au/~pls/thesis-topics/functionalshell.html


Looking at the brief description of the Esther shell, I was struck by the 
question - why not just use Haskell directly ie by extending something like 
GHCi to allow interactive definition of functions/values and an operator to 
map filenames to functions.


I was reminded of 
http://users.ipa.net/~dwighth/smalltalk/byte_aug81/design_principles_behind_smalltalk.html 
and in particular the following principle:


Operating System:
   An operating system is a collection of things
 that don't fit into a language.
   There shouldn't be one.

Regards, Brian. 


___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Existentially-quantified constructors: Hugs is fine, GHC is not?

2006-05-10 Thread Einar Karttunen
On 10.05 13:27, Otakar Smrz wrote:
>data ... = ... | forall b . FMap (b -> a) (Mapper s b)
> 
>... where FMap qf qc = stripFMap f q
> 
> the GHC compiler as well as GHCi (6.4.2 and earlier) issue an error
> 
> My brain just exploded.
> I can't handle pattern bindings for existentially-quantified
> constructors.

You can rewrite the code in a way that GHC accepts it. Just
avoid pattern binding your variables. I had the same problem
in HAppS code and needed to lift some code to the top
level to solve it.

- Einar Karttunen
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


[Haskell-cafe] Existentially-quantified constructors: Hugs is fine, GHC is not?

2006-05-10 Thread Otakar Smrz

Dear all,

while WinHugs (20051031) lets me match against an existentially 
quantified constructor


   data ... = ... | forall b . FMap (b -> a) (Mapper s b)

   ... where FMap qf qc = stripFMap f q

the GHC compiler as well as GHCi (6.4.2 and earlier) issue an error

My brain just exploded.
I can't handle pattern bindings for existentially-quantified
constructors.


Let me give the whole (non-practical) code, which is well typed and 
compiles in Hugs, and then show the change I had to do to make it work 
in GHC, too.


The question is why there is a difference. Am I misusing something?

The point of the complexFun below is to explore the Mapper data 
structure, taking care of the :&: constructor and quickly 
(transitively) skipping the FMap constructors, only accumulating and 
composing the tranformation functions that these provide.


---

module Problem where

import Data.Map as Map hiding (map)

type Labels a = [a]

data Mapper s a = Labels a :&: Map.Map s (Mapper s a)
| forall b . FMap (b -> a) (Mapper s b)


stripFMap :: Ord s => (a -> c) -> Mapper s a -> Mapper s c

stripFMap k (FMap f p)  = stripFMap (k . f) p
stripFMap k x   = FMap k x


complexFun :: Ord s => (b -> a) -> Mapper s b -> s -> [a]

complexFun f c y = case c of

FMap t q -> complexFun qf qc y

where FMap qf qc = stripFMap (f . t) q   -- !!!

r :&: k  -> case Map.lookup y k of

Just q  ->  let FMap qf qc = stripFMap f q-- !!!
in case qc of

([] :&: _) -> complexFun qf qc y
(xs :&: _) -> map qf xs
_  -> error "Never matching"

Nothing -> error "Irrelevant"

---

Even though GHC does not let me pattern-match on FMap, I can use a 
case expression in complexFun instead -- then it compiles alright:


--

complexFun f c y = case c of

FMap t q -> case stripFMap (f . t) q of  -- !!!

FMap qf qc -> complexFun qf qc y -- !!!
_  -> error "No option"-- !!!

r :&: k  -> case Map.lookup y k of

Just q  ->  case stripFMap f q of-- !!!

  FMap qf qc -> case qc of   -- !!!

([] :&: _) -> complexFun qf qc y
(xs :&: _) -> map qf xs
_  -> error "Never matching"

  _  -> error "No option"  -- !!!

Nothing -> error "Irrelevant"

--

If I wanted to make this auxiliary case on stripFMap local, there 
would be a problem for both Hugs and GHC:


 Hugs: Existentially quantified variable in inferred type!
   *** Variable : _48
   *** From pattern : FMap xf xc
   *** Result type  : (_48 -> _32,Mapper _30 _48)

 GHC: Inferred type is less polymorphic than expected
Quantified type variable `b' is mentioned in the environment:
  qc :: Mapper s1 b (bound at Problem.hs:65:27)
  qf :: b -> a1 (bound at Problem.hs:65:23)
  When checking an existential match that binds
  xf :: b -> a
  xc :: Mapper s b
  The pattern(s) have type(s): Mapper s1 a1
  The body has type: (b -> a1, Mapper s1 b)
  In a case alternative: FMap xf xc -> (xf, xc)

--

complexFun f c y = case c of

FMap t q -> complexFun qf qc y

where (qf, qc) = case stripFMap (f . t) q of  -- !!!

FMap xf xc -> (xf, xc)
_  -> error "No option"

r :&: k  -> case Map.lookup y k of

Just q -> let (qf, qc) = case stripFMap f q of-- !!!

FMap xf xc -> (xf, xc)
_  -> error "No option"

in case qc of

([] :&: _) -> complexFun qf qc y
(xs :&: _) -> map qf xs
_  -> error "Never matching"

Nothing -> error "Irrelevant"

--


Many thanks for your comments or advice!

Best,

Otakar Smrz
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] develop new Haskell shell?

2006-05-10 Thread Donald Bruce Stewart
johanj:
> >>>Who wants to try devloping a new shell with me?
> >
> >
> >Also:
> >http://www.cse.unsw.edu.au/~dons/h4sh.html
> 
> And (in Clean):
> 
> Rinus Plasmeijer and Arjen van Weelden. A functional shell that  
> operates on typed and compiled applications. In Varmo Vene and Tarmo  
> Uustalu, editors, Advanced Functional Programming, 5th International  
> Summer School, AFP 2004, University of Tartu, Revised Lectures,  
> volume 3622 of Lecture Notes in Computer Science, pages 245-272,  
> Tartu, Estonia, August 2004. Springer
> 
> http://www.cs.ru.nl/A.vanWeelden/index.php?p=publications

Funny this should come up. We've just had several submissions to work on
a functional shell for the google summer of code.

Here's a bit of a summary of what's been done in Haskell I prepared a
while back.

http://www.cse.unsw.edu.au/~pls/thesis-topics/functionalshell.html

-- Don
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] develop new Haskell shell?

2006-05-10 Thread Johan Jeuring

Who wants to try devloping a new shell with me?



Also:
http://www.cse.unsw.edu.au/~dons/h4sh.html


And (in Clean):

Rinus Plasmeijer and Arjen van Weelden. A functional shell that  
operates on typed and compiled applications. In Varmo Vene and Tarmo  
Uustalu, editors, Advanced Functional Programming, 5th International  
Summer School, AFP 2004, University of Tartu, Revised Lectures,  
volume 3622 of Lecture Notes in Computer Science, pages 245-272,  
Tartu, Estonia, August 2004. Springer


http://www.cs.ru.nl/A.vanWeelden/index.php?p=publications

-- Johan
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


RE: [Haskell-cafe] develop new Haskell shell?

2006-05-10 Thread Bayley, Alistair
> From: [EMAIL PROTECTED] 
> [mailto:[EMAIL PROTECTED] On Behalf Of Graham Klyne
> 
> Did you see [http://nellardo.com/lang/haskell/hash/] ?
> 
> Google also finds some links to code.
> 
> #g
> --
> 
> Marc Weber wrote:
> > Hi.
> > 
> > Who wants to try devloping a new shell with me?


Also:
http://www.cse.unsw.edu.au/~dons/h4sh.html
*
Confidentiality Note: The information contained in this message,
and any attachments, may contain confidential and/or privileged
material. It is intended solely for the person(s) or entity to
which it is addressed. Any review, retransmission, dissemination,
or taking of any action in reliance upon this information by
persons or entities other than the intended recipient(s) is
prohibited. If you received this in error, please contact the
sender and delete the material from any computer.
*
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] The values of infinite lists

2006-05-10 Thread Bjorn Lisper
>Are the values of infinite lists _|_ (bottom)?

No. _|_ represents total lack of information about the result, whereas in a
lazy language like Haskell an infinite list contains a lot of information:
you can observe arbitrary parts of such a list, access them, and compute
with them.

>In section 1.3, the Haskell 98 report said as follows:
>
>   Errors in Haskell are semantically equivalent to _|_. Technically,
>   they are not distinguishable from nontermination, so the language
>   includes no mechanism for detecting or acting upon errors.

The formulation in the Haskell report is sloppy to say the least, and
clearly misleading as witnessed by your mail. Nontermination is not the
precisely the same as _|_. Only certain kinds of nontermination can be
modeled by _|_ in a non-strict language.

I think one should consider reformulating the paragraph above in future
versions of the Haskell report.

>Therefore, the value of the following infinity is _|_. Right?
>
>   data Nat = Zero | Succ Nat
>
>   infinity = Succ infinity

No. Consider the following function:

f Zero = 0
f (Succ _) = 17

We then have f infinity = f (Succ infinity) = 17, whereas f _|_ = _|_.
Thus, f distinguishes infinity and _|_, so they can not be the same.

>What about infinite lists? For example, is the value of [1 ..] also _|_?

No, see above.

Björn Lisper
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] The values of infinite lists

2006-05-10 Thread Matthias Fischmann

On Wed, May 10, 2006 at 02:00:20PM +0900, Deokhwan Kim wrote:
> To: haskell-cafe@haskell.org
> From: Deokhwan Kim <[EMAIL PROTECTED]>
> Date: Wed, 10 May 2006 14:00:20 +0900
> Subject: [Haskell-cafe] The values of infinite lists
> 
> Are the values of infinite lists _|_ (bottom)?
> 
> In section 1.3, the Haskell 98 report said as follows:
> 
>   Errors in Haskell are semantically equivalent to _|_. Technically,
>   they are not distinguishable from nontermination, so the language
>   includes no mechanism for detecting or acting upon errors.

type theoreticians talk like that ;-).

this paragraph is more about the "error" function than about infinite
data structures.  it means that whenever you trigger an "error ..."
line, you make the program non-terminating, just like if you try to
access the last element of an infinite list.  the program still *ends*
with an error message (notifying you that it won't *terminate*)
because it is nice and it knows you don't like to wait forever.  (-:

> Therefore, the value of the following infinity is _|_. Right?
> 
>   data Nat = Zero | Succ Nat
> 
>   infinity = Succ infinity

same as with lists: as long as you don't get lost in an infinitely
distant point in the data structure, you are fine: you can do this

ghci> case infinity of Succ _ -> "not there yet."; Zero -> "the end."
ghci> take 1000 [1..]

actually one of the things that i still find most amazing about
haskell is that i can express so many algorithms by starting from the
declaration of an infinite data structure and then traversing a finite
part of it.  the king paper on graph algorithms in haskell has some
nice examples on this, too.

cheers,
matthias


signature.asc
Description: Digital signature
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe