I definitely think that -1# should be parsed as a single lexeme. Presumably it was easier at the time to do it the way it is, I don't remember exactly.

I'd support a warning for use of prefix negation, or alternatively you could implement the Haskell' proposal to remove prefix negation completely - treat the unary minus as part of a numeric literal in the lexer only. This would have to be optional for now, so that we can continue to support Haskell 98 of course.

Cheers,
        Simon

Isaac Dupree wrote:
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

Now I understand why negative unboxed numeric literals are parsed
weirdly, after poking around a little!
"The parser parses all infix applications as right-associative,
regardless of fixity."
<http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/Renamer>

A negative sign on the left of an expression is parsed as a special
case, binding tighter than all infix ops (until the renamer reassociates
it) (but '-' is not parsed that way when it _follows_ an expression: (
process -1# ) is treated as _infix_ minus, i.e. subtraction, i.e. likely
compile error).

Then, before reassociating based on fixity, negation of an unboxed
number is performed (in order to allow a sort of numeric literals that
are negative and unboxed).  Here is a result of this funny treatment:

\begin{code}
{-# OPTIONS_GHC -fglasgow-exts #-}

import GHC.Base

main = do
  putStrLn $ "boxed:   " ++ show (    ( - 2  ^  6  ) :: Int )
  -- output:  boxed:   -64   --  ===  ( -(2  ^  6 ))

  putStrLn $ "unboxed: " ++ show ( I# ( - 2# ^# 6# ) )
  -- output:  unboxed: 64    --  ===  ((- 2#)^# 6# )


infixr 8  ^#  --just like ^, binds tighter than - (which is infixl 6)
( ^# ) :: Int# -> Int# -> Int#
base ^# 0# = 1#
base ^# exponent = base *# (base ^# ( exponent -# 1# ))
\end{code}

This particular combination of behavior, unfortunately, doesn't seem
useful for implementing sensible numeric literals, IMHO.  My desired
warning scheme would have to wait for the renamer to sort out
fixities... unless I want to warn about (-1==1) which is ((-1)==1), as
well (do I want that warning? how about (1 == -1), or (1 ^^ -1), which
both must parse with negation being tightly binding? I hadn't considered
those very well yet...).


Isaac
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.3 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org

iD8DBQFGGOF8HgcxvIWYTTURAiT5AKC1Zl9JYuSLBPdey/YdmCriY7FaUQCgqzNQ
clHWTS162IZWHhlXKJR8NhQ=
=zqzy
-----END PGP SIGNATURE-----
_______________________________________________
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users


_______________________________________________
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

Reply via email to