Repository : ssh://darcs.haskell.org//srv/darcs/packages/integer-gmp On branch : master
http://hackage.haskell.org/trac/ghc/changeset/ff3bf2210a04c46779f1bc15e45763b71040e638 >--------------------------------------------------------------- commit ff3bf2210a04c46779f1bc15e45763b71040e638 Author: Ian Lynagh <[email protected]> Date: Fri Jul 22 19:18:39 2011 +0100 Fix build following modules moving around >--------------------------------------------------------------- GHC/Integer.lhs | 12 ++---------- 1 files changed, 2 insertions(+), 10 deletions(-) diff --git a/GHC/Integer.lhs b/GHC/Integer.lhs index fd911e0..19b4a4d 100644 --- a/GHC/Integer.lhs +++ b/GHC/Integer.lhs @@ -1,6 +1,8 @@ \begin{code} {-# LANGUAGE BangPatterns, CPP, MagicHash #-} {-# OPTIONS_GHC -XNoImplicitPrelude #-} +-- TODO: Get rid of orphan instances +{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | @@ -137,9 +139,6 @@ int64ToInteger i = if ((i `leInt64#` intToInt64# 0x7FFFFFFF#) && then smallInteger (int64ToInt# i) else case int64ToInteger# i of (# s, d #) -> J# s d - where -- XXX Move the (&&) definition below us? - True && x = x - False && _ = False #endif toInt# :: Integer -> Int# @@ -212,13 +211,6 @@ divModInteger (S# i) (S# j) = (# S# d, S# m #) else r# where !r# = x# `remInt#` y# - (&&) :: Bool -> Bool -> Bool - True && x = x - False && _ = False - - (||) :: Bool -> Bool -> Bool - True || _ = True - False || x = x divModInteger i1@(J# _ _) i2@(S# _) = divModInteger i1 (toBig i2) divModInteger i1@(S# _) i2@(J# _ _) = divModInteger (toBig i1) i2 divModInteger (J# s1 d1) (J# s2 d2) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
