make boot fails

2000-05-31 Thread Josef Sveningsson

Hi!

I try to build the hslibs. When I do 'make boot' I get the following:


==fptools== gmake boot --no-print-directory -r;
 in /users/cs/josefs/fpbuild/hslibs/lang

ghc -M -optdep-f -optdep.depend  -optdep-o -optdepo-recomp -cpp
-fglasgow-exts -fvia-C -Rghc-timing -I../../ghc/includesAddr.lhs
Bits.lhs ByteArray.lhs CCall.lhs CString.lhs CTypes.lhs CTypesISO.lhs
Dynamic.lhs Exception.lhs Foreign.lhs ForeignObj.lhs GlaExts.lhs
IOExts.lhs Int.lhs LazyST.lhs MutableArray.lhs NativeInfo.lhs NumExts.lhs
PackedString.lhs ST.lhs ShowFunctions.lhs Stable.lhs StableName.lhs
StablePtr.lhs Storable.lhs TimeExts.lhs Weak.lhs Word.lhs ArrayBase.hs
IArray.hs MArray.hs
:67: #error Alas, no long available...
mkdependHS: Running cpp ( on CTypes.lhs ) failed
gmake[2]: *** [depend] Error 1
gmake[1]: *** [boot] Error 1
gmake: *** [boot] Error 1

Sources were checked out today.

/Josef





Re: Traditional bogus warnings

2000-05-31 Thread Josef Sveningsson

Hi!

The first warning is really easy to get rid of. I'm sending a patch that
does the job (*). The other ones requires some more work.

/Josef

(*) The code compiles but I haven't actually tested it since I'm having
problems compiling the libraries from the current cvs. So, be careful with
the code ;-)

On Sun, 28 May 2000, Sven Panne wrote:

 I know that those warnings below are longstanding buglets, but would
 it be possible to remove them before the release of 4.07? I had a
 medium-quick look at the desugarer/type checker, but with no real
 success.
 
 -
 module Foo where
 import Complex
 
 bar :: String - Int
 bar "ab" = 1
 bar "c"  = 2
 bar _= 3
 
 baz :: Complex Float - Int
 baz 0= 11
 baz (_ :+ _) = 22
 -
 panne@jeanluc:~  ghc -Wall -c Foo.hs
 
 Foo.hs:5: Pattern match(es) are overlapped in the definition of function
 `bar':
   bar "c" = ...
 
 Foo.hs:10: Pattern match(es) are overlapped in the definition of
 function `baz':
   baz (_ (:+) _) = ...
 
 Foo.hs:10: Pattern match(es) are non-exhaustive in the definition of
 function `baz':
   Patterns not matched: (#x) with (#x) `notElem` [0]
 -
 
 Cheers,
Sven
 -- 
 Sven PanneTel.: +49/89/2178-2235
 LMU, Institut fuer Informatik FAX : +49/89/2178-2211
 LFE Programmier- und Modellierungssprachen  Oettingenstr. 67
 mailto:[EMAIL PROTECTED]D-80538 Muenchen
 http://www.informatik.uni-muenchen.de/~Sven.Panne
 
 


Index: DsUtils.lhs
===
RCS file: /cvs/fptools/ghc/compiler/deSugar/DsUtils.lhs,v
retrieving revision 1.44
diff -c -r1.44 DsUtils.lhs
*** DsUtils.lhs 2000/05/25 12:41:16 1.44
--- DsUtils.lhs 2000/05/31 15:12:01
***
*** 91,101 
| lit_ty == floatTy   = ConPat floatDataCon  lit_ty [] [] [LitPat 
(mk_float lit)  floatPrimTy]
| lit_ty == doubleTy  = ConPat doubleDataCon lit_ty [] [] [LitPat 
(mk_double lit) doublePrimTy]
  
!   -- Convert the literal pattern "" to the constructor pattern [].
!   | null_str_lit lit   = ConPat nilDataCon lit_ty [] [] [] 
!   -- Similar special case for "x"
!   | one_str_lit   lit= ConPat consDataCon lit_ty [] [] 
!   [mk_first_char_lit lit, ConPat nilDataCon lit_ty [] [] 
[]]
  
| otherwise = default_pat
  
--- 91,98 
| lit_ty == floatTy   = ConPat floatDataCon  lit_ty [] [] [LitPat 
(mk_float lit)  floatPrimTy]
| lit_ty == doubleTy  = ConPat doubleDataCon lit_ty [] [] [LitPat 
(mk_double lit) doublePrimTy]
  
!   -- Convert literal patterns like "foo" to 'f':'o':'o':[]
!   | str_lit lit   = mk_list lit
  
| otherwise = default_pat
  
***
*** 121,129 
  null_str_lit (HsString s) = _NULL_ s
  null_str_lit other_lit= False
  
! one_str_lit (HsString s) = _LENGTH_ s == (1::Int)
! one_str_lit other_lit= False
! mk_first_char_lit (HsString s) = ConPat charDataCon charTy [] [] [LitPat 
(HsCharPrim (_HEAD_ s)) charPrimTy]
  \end{code}
  
  
--- 118,131 
  null_str_lit (HsString s) = _NULL_ s
  null_str_lit other_lit= False
  
! str_lit (HsString s) = True
! str_lit _= False
! 
! mk_list (HsString s) = foldr
!   (\c pat - ConPat consDataCon lit_ty [] [] [mk_char_lit c,pat])
!   (ConPat nilDataCon lit_ty [] [] []) (_UNPK_ s)
! 
! mk_char_lit c= ConPat charDataCon charTy [] [] [LitPat (HsCharPrim 
c) charPrimTy]
  \end{code}
  
  



Re: Inlining errors...

2000-04-27 Thread Josef Sveningsson

On Wed, 19 Apr 2000, Jan-Willem Maessen wrote:

 I agree so wholeheartedly that I just write a (very!) short paper on
 the subject for ICFP (having discovered to my surprise that no such
 write-up existed).  It describes how to identify such expressions and
 hoist them out so they don't end up getting inlined.  It's still being
 refereed is thus likely to be revised, but if you're interested in a
 pre-print take a look (there are no pointers to it from elsewhere at
 the moment):
 
It's interesting reading. However, it seems to me that it would interact
badly with minimal typing derivations (mtd). Mtd is an algorithm for type
checking which computes the least general type instead of the most
general. This is used by some compilers to guide other optimisations. Some
optimisations, like certain representation analysises, do a better job on
less polymorphic code and therefore it is desirable to have less general
types.

Does ghc use mtd or some other heuristics to remove redundant
polymorphism?

/Josef

PS. Sorry for not having any pointers to mtd.





Re: strange selectee 11

2000-02-14 Thread Josef Sveningsson

Hi guys!

On Mon, 14 Feb 2000, Alastair Reid wrote:

 
  Thinking about this more, the error msg has a familiar sound
  to it.  Did you use 4.04 patchlevel 0 or 1 ? pl 0 has some
  rts-ish probs which were fixed in pl1 (and of course in 4.06).
 
 The Glorious Glasgow Haskell Compilation System, version 4.04, patchlevel 1
 
 My program is just a plain old compiler.  No concurrency, all I/O is
 through readFile and writeFile.  There is a little GreenCard stuff
 (the DFS library is just too slow when run under Hugs) - but it just
 marshalls Ints and the like (ie no foreigns or stables).
 
 It could take a few days to get 4.06 installed - I'll submit a request
 and get back to you.
 
I also managed to get the 'strange selectee' error but with number 27
instead while compiling.
The thing is that I'm running ghc 4.06 . The file I compiled was a Lex
generated file.

/Josef




Re: strange selectee 11

2000-02-14 Thread Josef Sveningsson

Sorry for replying on my own posting but...

On Mon, 14 Feb 2000, Josef Sveningsson wrote:

 I also managed to get the 'strange selectee' error but with number 27
 instead while compiling.
 The thing is that I'm running ghc 4.06 . The file I compiled was a Lex
 generated file.
 
OK, now you all say "No wonder he gets an error message when he compiles
files generated from Lex!". That should ofcourse be Alex.

/Josef




build error

2000-01-03 Thread Josef Sveningsson

Hi!

I'm trying to build ghc using the latest cvs sources. When I do
'gmake all' I get:

 from ../includes/Rts.h:16,
 from Itimer.c:25,
../includes/PrimOps.h:806: parse error before `sigset_t'
../includes/PrimOps.h:806: warning: function declaration isn't a prototype
Itimer.c:185: storage size of `action' isn't known
Itimer.c:189: warning: implicit declaration of function `sigemptyset'
Itimer.c:192: warning: implicit declaration of function `sigaction'
Itimer.c:185: warning: unused variable `action'
Itimer.c:198: `sigset_t' undeclared (first use this function)
Itimer.c:198: (Each undeclared identifier is reported only once
Itimer.c:198: for each function it appears in.)
Itimer.c:198: parse error before `signals'
Itimer.c:200: `signals' undeclared (first use this function)
Itimer.c:201: warning: implicit declaration of function `sigaddset'
Itimer.c:203: warning: implicit declaration of function `sigprocmask'
Itimer.c:209: `sigset_t' undeclared (first use this function)
Itimer.c:209: parse error before `signals'
Itimer.c:211: `signals' undeclared (first use this function)
gmake[2]: *** [Itimer.o] Error 1
gmake[1]: *** [all] Error 1
gmake: *** [all] Error 1

I'm using an UltraSparc running SunOS 5.6

/Josef

--
|Josef Svenningsson|http://www.dtek.chalmers.se/~d95josef|
|Rubingatan 39 |  email: [EMAIL PROTECTED]   |
|421 62 Göteborg   |  tel: 031-7090774   |
--
What is a magician but a practising theorist?
-- Obi-Wan Kenobi




Re: advice wanted on GUI design patterns

1999-09-28 Thread Josef Sveningsson

On Mon, 27 Sep 1999, Havoc Pennington wrote:

 The question is: how do you structure a GUI program?

There is one paper I can recommend that tries to answer this question;
"Structuring Graphical Paradigms in TkGofer". It can be found here:

http://www.cs.chalmers.se/~koen/Papers/tkgofer.ps

The paper show how it's possible to structure programs using the MVC
paradigm. The paper uses TkGofer, but I think it's possible to use the
ideas in TclHaskell also (but I don't know since I haven't tested it).

/Josef

--
|Josef Svenningsson|http://www.dtek.chalmers.se/~d95josef|
|Rubingatan 39 |  email: [EMAIL PROTECTED]   |
|421 62 Göteborg   |  tel: 031-7090774   |
--
What is a magician but a practising theorist?
-- Obi-Wan Kenobi








Re: Dear Santa (Error Messages)

1999-09-15 Thread Josef Sveningsson

On Wed, 15 Sep 1999, George Russell wrote:

 Re parser combinators.  I think I was obviously too rude about
 these, because of my previous bad experience.  Naively it seems
 to me that there is a trade-off.  I am not prepared to settle
 for anything less than having my grammar statically checked
 for potential conflicts.  This obviously rules out rules 
 generated with complete generality at run time, and so rules
 out some kinds of parser combinators.  I can conceive that you
 can restrict the use of parser combinators in such a way that
 a preprocessor can verify the grammar statically, and 
 (by computing follow sets and so on) do as good a job as Yacc,
 while still allowing you the advantages of abstracting
 sequences.  Fine.
 
I also like it when my code can be automatically check, in particular
parser grammars. So about 1 1/2 year ago I extended the parsing
combinators of Doaitse Swierstra so that it was possible to actually test
if the grammar was correct (i.e. LL(1)). The checking was done at runtime
but the way I used the checker was that I compiled the grammar and the
grammar checking code separately and ran the tester once. Then I could
(without any modification to the grammar) use it where it was ment to be
used. This way I could get both the freedom of parsing combinators and the
security a grammar analysing tool. It has prooved to be very useful.

/Josef

--
|Josef Svenningsson|http://www.dtek.chalmers.se/~d95josef|
|Rubingatan 39 |  email: [EMAIL PROTECTED]   |
|421 62 Göteborg   |  tel: 031-7090774   |
--
What is a magician but a practising theorist?
-- Obi-Wan Kenobi



Re: Haskell Wish list: library documentation

1999-09-09 Thread Josef Sveningsson

On Wed, 8 Sep 1999, Andy Gill wrote:

 
  At 05:54 PM 9/8/99 , Andy Gill wrote:
  I've been playing will possible formats of such documentation.
  Have a look at http://www.cse.ogi.edu/~andy/gooddoc.htm
  for what I'm currently thinking of.
  
This looks real nice. As someone else on the list pointed out it would be
nice to have this kind of documentation on the module level also. My
experience from Java tells me that this could be extremely useful. Also,
documentations for types and classes is also a must IMO.

Maybe the definition of a function should be left out from the
documentation, at least by default. Javadoc has a number of options so 
that one can choose how much information the documentation should contain.
If we have a good specification and a set of axioms and rules, that's all
we need. Taking javadoc as an example again, imagine how it would look if
it included the definition of every function (yes, I know it's not really
comparable :-).

  What sort of fields would be useful in a Haskeldoc program?
  
The documentation of a type should contain class-instances.
The fixity of a function, if it's declared, should be documented.

 The sort of fields I'm thinking of are:
 
 Specification:
 
   Sometimes the implementation rewrites some functions
   to make them faster, but the original def. is clearer,
   so might remain as part documentation.
 
 Reductions:
   
   An example worked through, line by line,
   so that the operational semantics of the function become clear.
 
   unzip [(1,2),(3,4),(5,6)]
 { by syntactical sugar }
   unzip ((1,2):(3,4):(5,6):[])
 { by def. of unzip }
   foldr (\(a,b) ~(as,bs) - (a:as, b:bs)) ([], [])
  ((1,2):(3,4):(5,6):[])
 { by rule 1 of foldr }
   (\(a,b) ~(as,bs) - (a:as, b:bs))
   (1,2)
   (foldr (\(a,b) ~(as,bs) - (a:as, b:bs)) ([], [])
   ((3,4):(5,6):[]))
  { by beta-reduction }
   let
  (as,bs) = foldr (\(a,b) ~(as,bs) - (a:as, b:bs)) ([], [])
  ((3,4):(5,6):[])
   in 
  (1:as,2:bs)
   
This strikes me as odd. How can you define the operational semantics of a
function when Haskell does not have an operational semantics?

 Axioms and Rules:
   
   Algebraic properties of the definition.
 

/Josef

--
|Josef Svenningsson|http://www.dtek.chalmers.se/~d95josef|
|Rubingatan 39 |  email: [EMAIL PROTECTED]   |
|421 62 Göteborg   |  tel: 031-7090774   |
--
What is a magician but a practising theorist?
-- Obi-Wan Kenobi






Re: Towards a more OO Haskell

1999-08-28 Thread Josef Sveningsson

On Fri, 27 Aug 1999, Martin Norb{ck wrote:

 Fri Aug 27 1999, Michael Hobbs -
  But to reiterate the point of this message, would anybody be interested
  in a preprocessor that reads in some sort of class/interface definition
  and spits out standard Haskell code, which uses the conventions I
  alluded to above? My current project probably isn't large enough to
  warrant the effort, but if someone else could use it I might be willing
  to go the extra mile.
 
 Have you looked at Haskell++?
 http://www.cs.chalmers.se/~rjmh/Software/h++.html
 
Another interesting oo-extension to Haskell is O'Haskell:

http://www.cs.chalmers.se/~nordland/ohaskell.html

/Josef

--
|Josef Svenningsson|http://www.dtek.chalmers.se/~d95josef|
|Rubingatan 39 |  email: [EMAIL PROTECTED]   |
|421 62 Göteborg   |  tel: 031-7090774   |
--
What is a magician but a practising theorist?
-- Obi-Wan Kenobi






Re: ANNOUNCEMENT: The Glasgow Haskell Compiler, version 4.04

1999-07-30 Thread Josef Sveningsson

On Thu, 29 Jul 1999, Simon Marlow wrote:

The Glasgow Haskell Compiler -- version 4.04
   ==
 
[Snip]
- Rewrite rules can be specified in the source using the RULES
  pragma.  This is used for automatic fusion of common list
  functions.
 
Some time ago I requested some sort of explanation on which functions one
should use to achive fusion. Now that GHC really fuses functions (which it
didn't when I made my last request) I think it would be nice if you
updated the user's guide with a list of functions that can be fused and
how to use them.

Keep up the good work.

/Josef

--
|Josef Svenningsson|http://www.dtek.chalmers.se/~d95josef|
|Rubingatan 39 |  email: [EMAIL PROTECTED]   |
|421 62 Göteborg   |  tel: 031-7090774   |
--
What is a magician but a practising theorist?
-- Obi-Wan Kenobi



Re: Haskell 2 -- Dependent types?

1999-02-18 Thread Josef Sveningsson

On Wed, 17 Feb 1999, George Beshers wrote:

 1.  If the tool can resolve the types (and I would expect this
 to be true most of the time) it can display the types and (if
 the user or style guide dictates) add the types to the source.
 
 2.  If the tool can not resolve the type of a particular
 construct then the programmer can add the information and
 the tool can verify that the supplied type is correct.
 
 3.  As D. Tweed's short STL example points out, C++ can be all
 but unreadable without the support of static analysis tools 
 today (ooh... there was an implicit constructor call there!!!).
 I would argue that working with large software systems in any
 language requires support from software tools. So why not
 design Haskell-2 with tools in mind?
 
For anyone who would like to see what a tool like this *might* look like I
think you should look at Alfa. This tool is really a proof editor but
could as well be used as a programming tool for the functional language
cayenne since the proofs are formulated in cayenne and proof checking is
done by typechecking the program/proof. This can be be done because
cayenne is a language with dependent types which are powerful enough to
express just about anything about the program. The typechecking is done
incrementally which is really neat and prevents you from constructing
erronious proofs/programs. Alfa has a GUI which is really nice and allows
you to just use the mouse for programming/proof construction.

Alfa can be found on:
http://www.cs.chalmers.se/~hallgren/Alfa/

/Josef

--
|Josef Svenningsson|http://www.dtek.chalmers.se/~d95josef|
|Rubingatan 39 |  email: [EMAIL PROTECTED]   |
|421 62 Göteborg   |  tel: 031-7090774   |
--
What is a magician but a practising theorist?
-- Obi-Wan Kenobi






Re: data or class inheritance

1998-06-06 Thread Josef Sveningsson

On Sat, 6 Jun 1998, Fergus Henderson wrote:

[...]
 But I think it would be nice to have better language support.
 
[...]
 
 I think you can go even ahead and declare OrganizationThing to be
 a member of class Organization:
 
   instance Organization OrganizationThing where
   name (MkOrg o) = name o
   foo (MkOrg o) = foo o
   bar (MkOrg o) = bar o
   -- similarly for all methods of class Organization
   
 Then you don't need to use that annoying MkOrg constructor so often --
 in fact, you only need it when constructing values, I don't think
 you ever need it for deconstruction.
 
 However, adding these instance declarations is a bit tedious.
 Wouldn't it be handy if the compiler could do that automatically?
 
 So, why not also extend the language so that it if `Foo' is a type class,
 then `any Foo' is a type and `new Foo' is a constructor
 for that type, and the type `any Foo' is automatically made an
 instance of the class `Foo'?
 This would make object-oriented programming a lot more convenient.
 
[...]

Yes, it would be rather convenient but the problem is that it will be
rather ad-hoc. I don't see how it fits with the constructor-classes. And
future versions of Haskell will probably have multi-parameter type-classes
and this will also cause problems for this mechanism (what type would 
'any Foo' refer to).

My opinion is that Haskell should be kept clean and orthogonal as I think
it is right now (with a few embarrasing exceptions like the default
mechanism for example) and this sort of thing will ruin that.

The argument that the above declaration is tedios is, I think, irrelevant.
First of all; ofcourse it would be nice if the compiler could generate
everything that is possible derive but that is not always a help. Consider
c++ were type-conversions can happen almost by magic and in situations
where one wanted the compiler to report an error (it has happend to me a
couple of times and is rather annoying). Secondly, talking about
functional programming as tedious is being very lazy. Compared to
objectoriented languages the definition above is not a big block of code.

To sum up; all typed languages have the problem that some thing cannot be
expressed easily because it is not typesafe. I think Haskell has very good
expressive power in this sense, due to its anvanced typesystem, and I
think that existential types are great as they are in hbc. Ofcourse one
could always ask more but it will always be a trade of, the typesystem is
already so complicated in Haskell most mortals don't understand it :-).

/Josef

--
|Josef Svenningsson|http://www.dtek.chalmers.se/~d95josef|
|Rubingatan 39 |  email: [EMAIL PROTECTED]   |
|421 62 Göteborg   |  tel: 031-7090774   |
--
What is a magician but a practising theorist?
-- Obi-Wan Kenobi