diff --git a/ghc/lib/std/PrelIOBase.lhs b/ghc/lib/std/PrelIOBase.lhs
index a50cc293516ba3e53da0d8a1675f029182785286..6b48b1f9106eca3ebb2e2db96d9bc7f1f367e013 100644
--- a/ghc/lib/std/PrelIOBase.lhs
+++ b/ghc/lib/std/PrelIOBase.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: PrelIOBase.lhs,v 1.27 2000/07/08 18:17:40 panne Exp $
+% $Id: PrelIOBase.lhs,v 1.28 2000/09/25 12:58:39 simonpj Exp $
 % 
 % (c) The University of Glasgow, 1994-2000
 %
@@ -21,6 +21,7 @@ import {-# SOURCE #-} PrelErr ( error )
 
 import PrelST
 import PrelBase
+import PrelNum	  ( fromInteger )	-- Integer literals
 import PrelMaybe  ( Maybe(..) )
 import PrelAddr	  ( Addr(..) )
 import PrelShow
diff --git a/ghc/lib/std/PrelNum.lhs b/ghc/lib/std/PrelNum.lhs
index ebf31c1ab04496c98326bf76905b93d928015dd0..293935821bd079365f7dcfa01f2b715beabd3ab5 100644
--- a/ghc/lib/std/PrelNum.lhs
+++ b/ghc/lib/std/PrelNum.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: PrelNum.lhs,v 1.32 2000/06/30 13:39:36 simonmar Exp $
+% $Id: PrelNum.lhs,v 1.33 2000/09/25 12:58:39 simonpj Exp $
 %
 % (c) The University of Glasgow, 1994-2000
 %
@@ -319,39 +319,14 @@ instance  Ord Integer  where
 
 \begin{code}
 instance  Num Integer  where
-    (+) i1@(S# i) i2@(S# j)
-	= case addIntC# i j of { (# r, c #) ->
-	  if c ==# 0# then S# r
-	  else toBig i1 + toBig i2 }
-    (+) i1@(J# _ _) i2@(S# _)	= i1 + toBig i2
-    (+) i1@(S# _) i2@(J# _ _)	= toBig i1 + i2
-    (+) (J# s1 d1) (J# s2 d2)
-      = case plusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
-
-    (-) i1@(S# i) i2@(S# j)
-	= case subIntC# i j of { (# r, c #) ->
-	  if c ==# 0# then S# r
-	  else toBig i1 - toBig i2 }
-    (-) i1@(J# _ _) i2@(S# _)	= i1 - toBig i2
-    (-) i1@(S# _) i2@(J# _ _)	= toBig i1 - i2
-    (-) (J# s1 d1) (J# s2 d2)
-      = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
-
-    (*) i1@(S# i) i2@(S# j)
-	= case mulIntC# i j of { (# r, c #) ->
-	  if c ==# 0# then S# r
-	  else toBig i1 * toBig i2 }
-    (*) i1@(J# _ _) i2@(S# _)	= i1 * toBig i2
-    (*) i1@(S# _) i2@(J# _ _)	= toBig i1 * i2
-    (*) (J# s1 d1) (J# s2 d2)
-      = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
-
-    negate (S# (-2147483648#)) = 2147483648
-    negate (S# i) = S# (negateInt# i)
-    negate (J# s d) = J# (negateInt# s) d
+    (+) = plusInteger
+    (-) = minusInteger
+    (*) = timesInteger
+    negate	   = negateInteger
+    fromInteger	x  =  x
+    fromInt (I# i) =  S# i
 
     -- ORIG: abs n = if n >= 0 then n else -n
-
     abs (S# (-2147483648#)) = 2147483648
     abs (S# i) = case abs (I# i) of I# j -> S# j
     abs n@(J# s d) = if (s >=# 0#) then n else J# (negateInt# s) d
@@ -365,9 +340,30 @@ instance  Num Integer  where
 	else if cmp ==# 0# then S# 0#
 	else			S# (negateInt# 1#)
 
-    fromInteger	x	=  x
-
-    fromInt (I# i)	=  S# i
+plusInteger i1@(S# i) i2@(S# j)  = case addIntC# i j of { (# r, c #) ->
+				   if c ==# 0# then S# r
+				   else toBig i1 + toBig i2 }
+plusInteger i1@(J# _ _) i2@(S# _) = i1 + toBig i2
+plusInteger i1@(S# _) i2@(J# _ _) = toBig i1 + i2
+plusInteger (J# s1 d1) (J# s2 d2) = case plusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
+
+minusInteger i1@(S# i) i2@(S# j)   = case subIntC# i j of { (# r, c #) ->
+				     if c ==# 0# then S# r
+				     else toBig i1 - toBig i2 }
+minusInteger i1@(J# _ _) i2@(S# _) = i1 - toBig i2
+minusInteger i1@(S# _) i2@(J# _ _) = toBig i1 - i2
+minusInteger (J# s1 d1) (J# s2 d2) = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
+
+timesInteger i1@(S# i) i2@(S# j)   = case mulIntC# i j of { (# r, c #) ->
+				     if c ==# 0# then S# r
+				     else toBig i1 * toBig i2 }
+timesInteger i1@(J# _ _) i2@(S# _) = i1 * toBig i2
+timesInteger i1@(S# _) i2@(J# _ _) = toBig i1 * i2
+timesInteger (J# s1 d1) (J# s2 d2) = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
+
+negateInteger (S# (-2147483648#)) = 2147483648
+negateInteger (S# i)		  = S# (negateInt# i)
+negateInteger (J# s d)		  = J# (negateInt# s) d
 \end{code}
 
 
diff --git a/ghc/lib/std/PrelST.lhs b/ghc/lib/std/PrelST.lhs
index a5a04118321e926ae02902458c97fab86763879b..735426d1a816423fd7c01053c677859616c353bc 100644
--- a/ghc/lib/std/PrelST.lhs
+++ b/ghc/lib/std/PrelST.lhs
@@ -1,5 +1,5 @@
 % ------------------------------------------------------------------------------
-% $Id: PrelST.lhs,v 1.16 2000/07/07 11:03:58 simonmar Exp $
+% $Id: PrelST.lhs,v 1.17 2000/09/25 12:58:39 simonpj Exp $
 %
 % (c) The University of Glasgow, 1992-2000
 %
@@ -11,6 +11,7 @@
 
 module PrelST where
 
+import PrelNum	( fromInteger )		-- For integer literals
 import PrelShow
 import PrelBase
 import PrelNum ()	-- So that we get the .hi file for system imports