diff --git a/lhc.cabal b/lhc.cabal
--- a/lhc.cabal
+++ b/lhc.cabal
@@ -1,6 +1,6 @@
 cabal-version:       >= 1.2
 name:                lhc
-version:             0.6.20081210
+version:             0.6.20081210.1
 synopsis:            LHC Haskell Compiler
 description:
   lhc is a haskell compiler which aims to produce the most efficient programs possible via whole
@@ -14,10 +14,101 @@
 homepage:            http://lhc.seize.it/
 build-type:          Custom
 Extra-Source-Files:  src/arch/generic.arch, src/arch/i686.arch, src/arch/x86_64.arch
+extra-source-files:  lib/base/base.cabal,
+                     lib/base/Setup.hs,
+                     lib/base/src/Control/Exception.hs,
+                     lib/base/src/Control/Monad.hs,
+                     lib/base/src/Data/Array/IO.hs,
+                     lib/base/src/Data/Array/Unboxed.hs,
+                     lib/base/src/Data/Array.hs,
+                     lib/base/src/Data/Bits.hs,
+                     lib/base/src/Data/Char.hs,
+                     lib/base/src/Data/Complex.hs,
+                     lib/base/src/Data/Dynamic.hs,
+                     lib/base/src/Data/Int.hs,
+                     lib/base/src/Data/IORef.hs,
+                     lib/base/src/Data/Ix.hs,
+                     lib/base/src/Data/List.hs,
+                     lib/base/src/Data/Maybe.hs,
+                     lib/base/src/Data/Monoid.hs,
+                     lib/base/src/Data/Ratio.hs,
+                     lib/base/src/Data/Typeable.hs,
+                     lib/base/src/Data/Unicode.hs,
+                     lib/base/src/Data/Word.hs,
+                     lib/base/src/Foreign/C/Error.hs,
+                     lib/base/src/Foreign/C/OldString.hs,
+                     lib/base/src/Foreign/C/String.hs,
+                     lib/base/src/Foreign/C/Types.hs,
+                     lib/base/src/Foreign/C.hs,
+                     lib/base/src/Foreign/ForeignPtr.hs,
+                     lib/base/src/Foreign/Marshal/Alloc.hs,
+                     lib/base/src/Foreign/Marshal/Array.hs,
+                     lib/base/src/Foreign/Marshal/Error.hs,
+                     lib/base/src/Foreign/Marshal/Pool.hs,
+                     lib/base/src/Foreign/Marshal/Utils.hs,
+                     lib/base/src/Foreign/Marshal.hs,
+                     lib/base/src/Foreign/Ptr.hs,
+                     lib/base/src/Foreign/StablePtr.hs,
+                     lib/base/src/Foreign/Storable.hs,
+                     lib/base/src/Foreign/Storable.m4,
+                     lib/base/src/Foreign.hs,
+                     lib/base/src/Lhc/ACIO.hs,
+                     lib/base/src/Lhc/Addr.hs,
+                     lib/base/src/Lhc/Array.hs,
+                     lib/base/src/Lhc/Basics.hs,
+                     lib/base/src/Lhc/Enum.hs,
+                     lib/base/src/Lhc/Float.hs,
+                     lib/base/src/Lhc/Handle.hs,
+                     lib/base/src/Lhc/Hole.hs,
+                     lib/base/src/Lhc/Inst/Enum.hs,
+                     lib/base/src/Lhc/Inst/PrimEnum.hs,
+                     lib/base/src/Lhc/Inst/Read.hs,
+                     lib/base/src/Lhc/Inst/Show.hs,
+                     lib/base/src/Lhc/Inst/Storable.hs,
+                     lib/base/src/Lhc/Int.hs,
+                     lib/base/src/Lhc/IO.hs,
+                     lib/base/src/Lhc/JumpPoint.hs,
+                     lib/base/src/Lhc/List.hs,
+                     lib/base/src/Lhc/Maybe.hs,
+                     lib/base/src/Lhc/Monad.hs,
+                     lib/base/src/Lhc/Num.hs,
+                     lib/base/src/Lhc/Options.hs,
+                     lib/base/src/Lhc/Order.hs,
+                     lib/base/src/Lhc/Order.m4,
+                     lib/base/src/Lhc/Prim.hs,
+                     lib/base/src/Lhc/Show.hs,
+                     lib/base/src/Lhc/String.hs,
+                     lib/base/src/Lhc/Text/Read.hs,
+                     lib/base/src/Lhc/Tuples.hs,
+                     lib/base/src/Lhc/Types.hs,
+                     lib/base/src/Numeric.hs,
+                     lib/base/src/Prelude/CType.hs,
+                     lib/base/src/Prelude/Float.hs,
+                     lib/base/src/Prelude/IO.hs,
+                     lib/base/src/Prelude/IOError.hs,
+                     lib/base/src/Prelude/Text.hs,
+                     lib/base/src/Prelude.hs,
+                     lib/base/src/System/Console/GetOpt.hs,
+                     lib/base/src/System/CPUTime.hs,
+                     lib/base/src/System/Directory.hs,
+                     lib/base/src/System/Info.hs,
+                     lib/base/src/System/IO/Binary.hs,
+                     lib/base/src/System/IO/Continuation.hs,
+                     lib/base/src/System/IO/Error.hs,
+                     lib/base/src/System/IO/Unsafe.hs,
+                     lib/base/src/System/IO.hs,
+                     lib/base/src/System/Locale.hs,
+                     lib/base/src/System/Random.hs,
+                     lib/base/src/System/Time.hs,
+                     lib/base/src/System.hs,
+                     lib/base/src/Text/Printf.hs,
+                     lib/base/src/Text/Show/Functions.hs,
+                     lib/base/src/Typeable.hs,
+                     lib/base/src/Unsafe/Coerce.hs
 data-dir:            data
 data-files:          HsFFI.h names.txt operators.txt prelude.m4 primitives.txt props.txt wsize.h ViaGhc.hs
                      rts/lhc_rts.c rts/lhc_rts2.c rts/lhc_rts_alloc.c rts/lhc_rts_header.h 
-
+                     
 flag base4
 flag hpc
   default:            False
@@ -50,7 +141,6 @@
  else
   build-depends:      base >= 3 && < 4
   Extensions:         PatternSignatures
-
  if flag(threaded)
   ghc-options:        -threaded
  if flag(with-base)
diff --git a/lib/base/Setup.hs b/lib/base/Setup.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/lib/base/base.cabal b/lib/base/base.cabal
new file mode 100644
--- /dev/null
+++ b/lib/base/base.cabal
@@ -0,0 +1,70 @@
+Cabal-version:   >= 1.2
+Name: base
+Version: 1.0
+Build-Type: Simple
+
+Library
+  Extensions:      ForeignFunctionInterface
+  hs-source-dirs:  src
+  Exposed-Modules: Control.Exception,
+                 Control.Monad,
+                 Data.Array,
+                 Data.Char,
+                 Data.Complex,
+                 Data.List,
+                 Data.Word,
+                 Data.Monoid,
+                 Data.Bits,
+                 Data.Int,
+                 Data.IORef,
+                 Data.Ix,
+                 Data.Maybe,
+                 Data.Ratio,
+                 Data.Unicode,
+                 Foreign,
+                 Foreign.C,
+                 Foreign.C.Types,
+                 Foreign.C.String,
+                 Foreign.C.Error,
+                 Foreign.ForeignPtr,
+                 Foreign.Marshal
+                 Foreign.Marshal.Alloc,
+                 Foreign.Marshal.Array,
+                 Foreign.Marshal.Error,
+                 Foreign.Marshal.Pool,
+                 Foreign.Marshal.Utils,
+                 Foreign.Ptr,
+                 Foreign.StablePtr,
+                 Foreign.Storable,
+                 Lhc.Addr,
+                 Lhc.Basics,
+                 Lhc.Float
+                 Lhc.Array,
+                 Data.Array.IO,
+                 Data.Array.Unboxed,
+                 Lhc.Handle,
+                 Lhc.IO,
+                 Lhc.Tuples,
+                 Numeric,
+                 Prelude.Float,
+                 Prelude.IO,
+                 Prelude.IOError,
+                 Prelude.Text,
+                 Prelude,
+                 System.Console.GetOpt,
+                 System.CPUTime,
+                 System.Directory,
+                 System.Info,
+                 System.IO,
+                 System.IO.Error,
+                 System.IO.Unsafe,
+                 System.IO.Binary,
+                 System.Locale,
+                 System.Random,
+                 System.Time,
+                 System
+                 Text.Show.Functions
+                 Text.Printf
+
+  if !impl(lhc)
+    buildable:     False
diff --git a/lib/base/src/Control/Exception.hs b/lib/base/src/Control/Exception.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Control/Exception.hs
@@ -0,0 +1,60 @@
+-- | This is mostly dummy, LHC does not support inexact exceptions.
+
+module Control.Exception where
+
+import Prelude hiding(catch)
+import qualified Prelude as P
+
+type IOException = IOError
+
+data Exception = IOException IOException
+
+-- throw :: Exception -> a
+
+throwIO :: Exception -> IO a
+throwIO (IOException ioe) = ioError ioe
+
+catch :: IO a -> (Exception -> IO a) -> IO a
+catch c h = P.catch c (h . IOException)
+
+catchJust :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a
+catchJust et c h = catch c $ \e -> maybe (throwIO e) h (et e)
+
+handle :: (Exception -> IO a) -> IO a -> IO a
+handle = flip catch
+
+handleJust :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a
+handleJust et h c = catchJust et c h
+
+try :: IO a -> IO (Either Exception a)
+try c = catch (fmap Right c) (return . Left)
+
+tryJust :: (Exception -> Maybe b) -> IO a -> IO (Either b a)
+tryJust et c = catchJust et (fmap Right c) (return . Left)
+
+-- FIXME this is wrong!
+evaluate :: a -> IO a
+evaluate = return
+
+-- mapException
+
+ioErrors (IOException _) = True
+
+block, unblock :: IO a -> IO a
+block   = id
+unblock = id
+
+bracket        :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
+bracket before after m = do
+        x  <- before
+        rs <- try (m x)
+        after x
+        case rs of
+           Right r -> return r
+           Left  e -> throwIO e
+
+bracket_        :: IO a -> (a -> IO b) -> IO c -> IO c
+bracket_ before after m = bracket before after (const m)
+
+finally :: IO a -> IO b -> IO a
+finally cmd end = bracket_ (return ()) (const end) cmd
diff --git a/lib/base/src/Control/Monad.hs b/lib/base/src/Control/Monad.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Control/Monad.hs
@@ -0,0 +1,136 @@
+module Control.Monad(
+    MonadPlus(mzero, mplus),
+    join, guard, when, unless, ap, msum,
+    filterM, mapAndUnzipM, zipWithM, zipWithM_, foldM,
+    liftM, liftM2, liftM3, liftM4, liftM5,
+
+    foldM_,replicateM,replicateM_,(>=>),(<=<),forever,
+
+    -- ...and what the Prelude exports
+    Monad((>>=), (>>), return, fail),
+    Functor(fmap),
+    mapM, mapM_, sequence, sequence_, (=<<)
+)where
+
+import Lhc.Basics
+
+class Monad m => MonadPlus m where
+    mzero :: m a
+    mplus :: m a -> m a -> m a
+    mzero = fail "mzero"
+
+
+instance MonadPlus Maybe where
+    mzero = Nothing
+    Nothing `mplus` y = y
+    x `mplus` _ = x
+
+instance MonadPlus [] where
+    mzero = []
+    mplus = (++)
+
+
+-- Functions
+
+
+msum  :: MonadPlus m => [m a] -> m a
+msum xs  =  foldr mplus mzero xs
+
+join             :: (Monad m) => m (m a) -> m a
+join x           =  x >>= id
+
+when             :: (Monad m) => Bool -> m () -> m ()
+when p s         =  if p then s else return ()
+
+unless           :: (Monad m) => Bool -> m () -> m ()
+unless p s       =  when (not p) s
+
+ap               :: (Monad m) => m (a -> b) -> m a -> m b
+ap               =  liftM2 ($)
+
+guard            :: MonadPlus m => Bool -> m ()
+guard p          =  if p then return () else mzero
+
+mapAndUnzipM     :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
+mapAndUnzipM f xs = sequence (map f xs) >>= return . unzip
+
+zipWithM         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
+zipWithM f xs ys =  sequence (zipWith f xs ys)
+
+zipWithM_         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
+zipWithM_ f xs ys =  sequence_ (zipWith f xs ys)
+
+foldM            :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
+foldM f a []     =  return a
+foldM f a (x:xs) =  f a x >>= \ y -> foldM f y xs
+
+filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]
+filterM p []     = return []
+filterM p (x:xs) = do { b  <- p x;
+ys <- filterM p xs;
+return (if b then (x:ys) else ys)
+   }
+
+liftM            :: (Monad m) => (a -> b) -> (m a -> m b)
+liftM f          =  \a -> do { a' <- a; return (f a') }
+
+liftM2           :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c)
+liftM2 f         =  \a b -> do { a' <- a; b' <- b; return (f a' b') }
+
+liftM3           :: (Monad m) => (a -> b -> c -> d) ->
+                                 (m a -> m b -> m c -> m d)
+liftM3 f         =  \a b c -> do { a' <- a; b' <- b; c' <- c;
+   return (f a' b' c') }
+
+liftM4           :: (Monad m) => (a -> b -> c -> d -> e) ->
+                                 (m a -> m b -> m c -> m d -> m e)
+liftM4 f         =  \a b c d -> do { a' <- a; b' <- b; c' <- c; d' <- d;
+     return (f a' b' c' d') }
+
+liftM5           :: (Monad m) => (a -> b -> c -> d -> e -> f) ->
+                                 (m a -> m b -> m c -> m d -> m e -> m f)
+liftM5 f         =  \a b c d e -> do { a' <- a; b' <- b; c' <- c; d' <- d;
+       e' <- e; return (f a' b' c' d' e') }
+
+
+-- extensions
+
+-- | Like 'foldM', but discards the result.
+foldM_            :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()
+foldM_ f a xs     = foldM f a xs >> return ()
+
+-- | @'replicateM' n act@ performs the action @n@ times,
+-- gathering the results.
+replicateM        :: (Monad m) => Int -> m a -> m [a]
+replicateM n x    = sequence (replicate n x)
+
+-- | Like 'replicateM', but discards the result.
+replicateM_       :: (Monad m) => Int -> m a -> m ()
+replicateM_ n x   = sequence_ (replicate n x)
+
+
+-- | 'forM' is 'mapM' with its arguments flipped
+forM            :: Monad m => [a] -> (a -> m b) -> m [b]
+{-# INLINE forM #-}
+forM            = flip mapM
+
+-- | 'forM_' is 'mapM_' with its arguments flipped
+forM_           :: Monad m => [a] -> (a -> m b) -> m ()
+{-# INLINE forM_ #-}
+forM_           = flip mapM_
+
+infixr 1 <=<, >=>
+
+-- | Left-to-right Kleisli composition of monads.
+(>=>)       :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
+f >=> g     = \x -> f x >>= g
+
+-- | Right-to-left Kleisli composition of monads. '(>=>)', with the
+-- arguments flipped
+(<=<)       :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)
+(<=<)       = flip (>=>)
+
+-- | @'forever' act@ repeats the action infinitely.
+forever     :: (Monad m) => m a -> m ()
+forever a   = a >> forever a
+
diff --git a/lib/base/src/Data/Array.hs b/lib/base/src/Data/Array.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/Array.hs
@@ -0,0 +1,90 @@
+{-# OPTIONS_LHC -funboxed-tuples #-}
+module  Data.Array (
+    module Ix,  -- export all of Ix
+    Array(),
+    array,
+    listArray,
+    (!),
+    bounds,
+    indices,
+    elems,
+    assocs,
+    accumArray,
+    (//),
+    accum,
+    ixmap
+    ) where
+
+import Data.Ix
+import Lhc.Array
+import Lhc.Int
+
+infixl 9  !, //
+
+
+data Array a b = MkArray !a !a (Array__ b)
+
+array       :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
+array b@(s,e) ivs = case newArray (error "array: missing element") (rangeSize b) [(index b x,y) | (x,y) <- ivs] of
+        arr -> MkArray s e arr
+
+listArray             :: (Ix a) => (a,a) -> [b] -> Array a b
+listArray b vs        =  array b (zipWith (\ a b -> (a,b)) (range b) vs)
+
+(!)                   :: (Ix a) => Array a b -> a -> b
+(!) (MkArray s e arr) i =  case unboxInt (index (s,e) i) of i' -> case indexArray__ arr i' of (# r #) -> r
+
+bounds                :: (Ix a) => Array a b -> (a,a)
+bounds (MkArray s e _)  =  (s,e)
+
+indices               :: (Ix a) => Array a b -> [a]
+indices               =  range . bounds
+
+elems                 :: (Ix a) => Array a b -> [b]
+elems a               =  [a!i | i <- indices a]
+
+assocs                :: (Ix a) => Array a b -> [(a,b)]
+assocs a              =  [(i, a!i) | i <- indices a]
+
+(//)                  :: (Ix a) => Array a b -> [(a,b)] -> Array a b
+a // []               = a
+a // new_ivs          = array (bounds a) (old_ivs ++ new_ivs)
+                      where
+                  	old_ivs = [(i,a!i) | i <- indices a,
+                                             i `notElem` new_is]
+                  	new_is  = [i | (i,_) <- new_ivs]
+
+accum                 :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)] -> Array a b
+accum f               =  foldl (\a (i,v) -> a // [(i,f (a!i) v)])
+
+accumArray            :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> Array a b
+accumArray f z b      =  accum f (array b [(i,z) | i <- range b])
+
+ixmap                 :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c -> Array a c
+ixmap b f a           = array b [(i, a ! f i) | i <- range b]
+
+instance  (Ix a)          => Functor (Array a) where
+    fmap fn a = array (bounds a) [ (a,fn b) | (a,b) <- assocs a ]
+
+instance  (Ix a, Eq b)  => Eq (Array a b)  where
+    a == a' =  assocs a == assocs a'
+
+instance  (Ix a, Ord b) => Ord (Array a b)  where
+    a <= a' =  assocs a <= assocs a'
+
+instance  (Ix a, Show a, Show b) => Show (Array a b)  where
+    showsPrec p a = showParen (p > arrPrec) (
+                    showString "array " .
+                    showsPrec (arrPrec+1) (bounds a) . showChar ' ' .
+                    showsPrec (arrPrec+1) (assocs a)                  )
+instance  (Ix a, Read a, Read b) => Read (Array a b)  where
+    readsPrec p = readParen (p > arrPrec)
+           (\r -> [ (array b as, u)
+                  | ("array",s) <- lex r,
+                    (b,t)       <- readsPrec (arrPrec+1) s,
+                    (as,u)      <- readsPrec (arrPrec+1) t ])
+
+-- Precedence of the 'array' function is that of application itself
+arrPrec :: Int
+arrPrec = 10
+
diff --git a/lib/base/src/Data/Array/IO.hs b/lib/base/src/Data/Array/IO.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/Array/IO.hs
@@ -0,0 +1,51 @@
+{-# OPTIONS_LHC -N -funboxed-tuples -fffi #-}
+module Data.Array.IO where
+
+import Lhc.Basics
+import Data.Ix
+import Lhc.Array
+import Lhc.IO
+import Lhc.Int
+import Data.Array
+
+data IOArray a b = IOA !a !a (MutArray__ b)
+
+newIOArray :: Ix a => (a,a) -> b -> IO (IOArray a b)
+newIOArray rng fill = IO (newIOArray_ rng fill)
+
+newIOArray_ :: Ix a => (a,a) -> b -> World__ -> (# World__, IOArray a b #)
+newIOArray_ rng@(l,h) fill w1 =
+    case unboxInt (rangeSize rng) of
+      size__ -> case newMutArray__ size__ fill w1 of
+                  (# w2, arr #) -> (# w2, IOA l h arr #)
+                                     
+boundsIOArray :: Ix a => IOArray a b -> IO (a,a)
+boundsIOArray (IOA l h _) = returnIO (l,h)
+
+readIOArray :: Ix a => IOArray a b -> a -> IO b
+readIOArray (IOA l h arr) i =
+    case unboxInt (index (l,h) i) of
+      i' -> IO (readArray__ arr i')
+    
+writeIOArray :: Ix a => IOArray a b -> a -> b -> IO ()
+writeIOArray (IOA l h arr) i x =
+    case unboxInt (index (l,h) i) of
+      i' -> IO (\w1 -> case writeArray__ arr i' x w1 of
+                         w2 -> (# w2, () #))
+
+unsafeReadIOArray :: Ix a => IOArray a b -> Int -> IO b
+unsafeReadIOArray (IOA l h arr) i = case unboxInt i of i' -> IO (readArray__ arr i')
+
+unsafeWriteIOArray :: Ix a => IOArray a b -> Int -> b -> IO ()
+unsafeWriteIOArray (IOA l h arr) i x =
+    case unboxInt i of i' -> IO (\w1 -> case writeArray__ arr i' x w1 of
+                                          w2 -> (# w2, () #))
+
+{-
+freezeIOArray :: Ix a => IOArray a b -> IO (Array a b)
+thawIOArray :: Ix a => Array a b -> IO (IOArray a b)
+
+unsafeFreezeIOArray :: Ix a => IOArray a b -> IO (Array a b)
+unsafeFreezeIOArray (IOA l h arr) = 
+    IO (\w1 -> unsafeFreezeArray__ )
+-}
diff --git a/lib/base/src/Data/Array/Unboxed.hs b/lib/base/src/Data/Array/Unboxed.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/Array/Unboxed.hs
@@ -0,0 +1,82 @@
+module Data.Array.Unboxed where
+
+import Data.Ix
+import System.IO.Unsafe
+import Foreign.Storable
+import Foreign.Marshal.Alloc
+import Foreign.ForeignPtr
+
+infixl 9  !, //
+
+data UArray i e = MkArray !i !i (ForeignPtr e)
+
+array       :: (Ix a,Storable b) => (a,a) -> [(a,b)] -> UArray a b
+array b@(s,e) ivs = MkArray s e (unsafePerformIO arr) where
+    arr = do
+        let f :: [(a,b)] -> b; f _ = undefined
+        fp <- mallocForeignPtrBytes (sizeOf (f ivs) *  rangeSize b)
+        withForeignPtr fp $ \ptr ->
+            mapM_ (\ (i,v) -> pokeElemOff ptr (index b i) v) ivs
+        return fp
+
+
+listArray             :: (Ix a,Storable b) => (a,a) -> [b] -> UArray a b
+listArray b vs        =  array b (zipWith (\ a b -> (a,b)) (range b) vs)
+
+(!)                   :: (Ix a,Storable b) => UArray a b -> a -> b
+(!) (MkArray s e arr) i = case (index (s,e) i) of i' -> unsafePerformIO (withForeignPtr arr (\ptr -> peekElemOff ptr i'))
+
+bounds                :: (Ix a) => UArray a b -> (a,a)
+bounds (MkArray s e _)  =  (s,e)
+
+indices               :: (Ix a) => UArray a b -> [a]
+indices               =  range . bounds
+
+elems                 :: (Ix a,Storable b) => UArray a b -> [b]
+elems a               =  [a!i | i <- indices a]
+
+assocs                :: (Ix a,Storable b) => UArray a b -> [(a,b)]
+assocs a              =  [(i, a!i) | i <- indices a]
+
+(//)                  :: (Ix a,Storable b) => UArray a b -> [(a,b)] -> UArray a b
+a // []               = a
+a // new_ivs          = array (bounds a) (old_ivs ++ new_ivs)
+                      where
+                  	old_ivs = [(i,a!i) | i <- indices a,
+                                             i `notElem` new_is]
+                  	new_is  = [i | (i,_) <- new_ivs]
+
+accum                 :: (Ix a,Storable b ) => (b -> c -> b) -> UArray a b -> [(a,c)] -> UArray a b
+accum f               =  foldl (\a (i,v) -> a // [(i,f (a!i) v)])
+
+accumArray            :: (Ix a,Storable b ) => (b -> c -> b) -> b -> (a,a) -> [(a,c)] -> UArray a b
+accumArray f z b      =  accum f (array b [(i,z) | i <- range b])
+
+ixmap                 :: (Ix a, Ix b,Storable c) => (a,a) -> (a -> b) -> UArray b c -> UArray a c
+ixmap b f a           = array b [(i, a ! f i) | i <- range b]
+
+--instance  (Ix a)          => Functor (UArray a) where
+--    fmap fn a = array (bounds a) [ (a,fn b) | (a,b) <- assocs a ]
+
+instance  (Ix a, Eq b, Storable b)  => Eq (UArray a b)  where
+    a == a' =  assocs a == assocs a'
+
+instance  (Ix a, Ord b, Storable b) => Ord (UArray a b)  where
+    a <= a' =  assocs a <= assocs a'
+
+instance  (Ix a, Show a, Show b, Storable b) => Show (UArray a b)  where
+    showsPrec p a = showParen (p > arrPrec) (
+                    showString "array " .
+                    showsPrec (arrPrec+1) (bounds a) . showChar ' ' .
+                    showsPrec (arrPrec+1) (assocs a)                  )
+instance  (Ix a, Read a, Read b, Storable b) => Read (UArray a b)  where
+    readsPrec p = readParen (p > arrPrec)
+           (\r -> [ (array b as, u)
+                  | ("array",s) <- lex r,
+                    (b,t)       <- readsPrec (arrPrec+1) s,
+                    (as,u)      <- readsPrec (arrPrec+1) t ])
+
+-- Precedence of the 'array' function is that of application itself
+arrPrec :: Int
+arrPrec = 10
+
diff --git a/lib/base/src/Data/Bits.hs b/lib/base/src/Data/Bits.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/Bits.hs
@@ -0,0 +1,142 @@
+{-# OPTIONS_LHC -N #-}
+module Data.Bits where
+
+
+import Lhc.Num
+import Lhc.Order
+import Lhc.Int
+
+
+infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
+infixl 7 .&.
+infixl 6 `xor`
+infixl 5 .|.
+
+
+{-|
+The 'Bits' class defines bitwise operations over integral types.
+
+* Bits are numbered from 0 with bit 0 being the least
+  significant bit.
+-}
+class Num a => Bits a where
+    -- | Bitwise \"and\"
+    (.&.) :: a -> a -> a
+
+    -- | Bitwise \"or\"
+    (.|.) :: a -> a -> a
+
+    -- | Bitwise \"xor\"
+    xor :: a -> a -> a
+
+    {-| Reverse all the bits in the argument -}
+    complement        :: a -> a
+
+    {-| Shift the argument left by the specified number of bits.
+	Right shifts (signed) are specified by giving a negative value.
+
+	An instance can define either this unified 'shift' or 'shiftL' and
+	'shiftR', depending on which is more convenient for the type in
+	question. -}
+    shift             :: a -> Int -> a
+
+    x `shift`   i | i<0  = x `shiftR` (-i)
+                  | i==0 = x
+                  | i>0  = x `shiftL` i
+
+    {-| Rotate the argument left by the specified number of bits.
+	Right rotates are specified by giving a negative value.
+
+        For unbounded types like 'Integer', 'rotate' is equivalent to 'shift'.
+
+	An instance can define either this unified 'rotate' or 'rotateL' and
+	'rotateR', depending on which is more convenient for the type in
+	question. -}
+    rotate            :: a -> Int -> a
+
+    x `rotate`  i | i<0  = x `rotateR` (-i)
+                  | i==0 = x
+                  | i>0  = x `rotateL` i
+
+    {-
+    -- Rotation can be implemented in terms of two shifts, but care is
+    -- needed for negative values.  This suggested implementation assumes
+    -- 2's-complement arithmetic.  It is commented out because it would
+    -- require an extra context (Ord a) on the signature of 'rotate'.
+    x `rotate`  i | i<0 && isSigned x && x<0
+                         = let left = i+bitSize x in
+                           ((x `shift` i) .&. complement ((-1) `shift` left))
+                           .|. (x `shift` left)
+                  | i<0  = (x `shift` i) .|. (x `shift` (i+bitSize x))
+                  | i==0 = x
+                  | i>0  = (x `shift` i) .|. (x `shift` (i-bitSize x))
+    -}
+
+    -- | @bit i@ is a value with the @i@th bit set
+    bit               :: Int -> a
+
+    -- | @x \`setBit\` i@ is the same as @x .|. bit i@
+    setBit            :: a -> Int -> a
+
+    -- | @x \`clearBit\` i@ is the same as @x .&. complement (bit i)@
+    clearBit          :: a -> Int -> a
+
+    -- | @x \`complementBit\` i@ is the same as @x \`xor\` bit i@
+    complementBit     :: a -> Int -> a
+
+    -- | Return 'True' if the @n@th bit of the argument is 1
+    testBit           :: a -> Int -> Bool
+
+    {-| Return the number of bits in the type of the argument.  The actual
+	value of the argument is ignored.  The function 'bitSize' is
+	undefined for types that do not have a fixed bitsize, like 'Integer'.
+	-}
+    bitSize           :: a -> Int
+
+    {-| Return 'True' if the argument is a signed type.  The actual
+        value of the argument is ignored -}
+    isSigned          :: a -> Bool
+
+    bit i               = 1 `shiftL` i
+    x `setBit` i        = x .|. bit i
+    x `clearBit` i      = x .&. complement (bit i)
+    x `complementBit` i = x `xor` bit i
+    x `testBit` i       = (x .&. bit i) /= 0
+
+    {-| Shift the argument left by the specified number of bits
+	(which must be non-negative).
+
+	An instance can define either this and 'shiftR' or the unified
+	'shift', depending on which is more convenient for the type in
+	question. -}
+    shiftL            :: a -> Int -> a
+    x `shiftL`  i = x `shift`  i
+
+    {-| Shift the argument right (signed) by the specified number of bits
+	(which must be non-negative).
+
+	An instance can define either this and 'shiftL' or the unified
+	'shift', depending on which is more convenient for the type in
+	question. -}
+    shiftR            :: a -> Int -> a
+    x `shiftR`  i = x `shift`  (-i)
+
+    {-| Rotate the argument left by the specified number of bits
+	(which must be non-negative).
+
+	An instance can define either this and 'rotateR' or the unified
+	'rotate', depending on which is more convenient for the type in
+	question. -}
+    rotateL           :: a -> Int -> a
+    x `rotateL` i = x `rotate` i
+
+    {-| Rotate the argument right by the specified number of bits
+	(which must be non-negative).
+
+	An instance can define either this and 'rotateL' or the unified
+	'rotate', depending on which is more convenient for the type in
+	question. -}
+    rotateR           :: a -> Int -> a
+    x `rotateR` i = x `rotate` (-i)
+
+
diff --git a/lib/base/src/Data/Char.hs b/lib/base/src/Data/Char.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/Char.hs
@@ -0,0 +1,85 @@
+module Data.Char (
+    isAscii, isLatin1, isControl, isPrint, isSpace, isUpper, isLower,
+    isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
+    digitToInt, intToDigit,
+    toUpper, toLower,
+    ord, chr,
+    readLitChar, showLitChar, lexLitChar,
+    module Prelude.CType,
+
+        -- ...and what the Prelude exports
+    Char, String
+    ) where
+
+--import Array         -- Used for character name table.
+import Numeric (readDec, readOct, lexDigits, readHex)
+import Prelude.Text
+import Lhc.Basics
+import Data.Word(Word())
+import Prelude.CType
+
+
+
+
+
+-- Text functions
+readLitChar          :: ReadS Char
+readLitChar ('\\':s) =  readEsc s
+readLitChar (c:s)    =  [(c,s)]
+
+readEsc          :: ReadS Char
+readEsc ('a':s)  = [('\a',s)]
+readEsc ('b':s)  = [('\b',s)]
+readEsc ('f':s)  = [('\f',s)]
+readEsc ('n':s)  = [('\n',s)]
+readEsc ('r':s)  = [('\r',s)]
+readEsc ('t':s)  = [('\t',s)]
+readEsc ('v':s)  = [('\v',s)]
+readEsc ('\\':s) = [('\\',s)]
+readEsc ('"':s)  = [('"',s)]
+readEsc ('\'':s) = [('\'',s)]
+readEsc ('^':(c:s)) | c >= '@' && c <= '_'
+                 = [(chr (ord c - ord '@'), s)]
+readEsc s@(d:_) | isDigit d
+                 = [(chr n, t) | (n,t) <- readDec s]
+readEsc ('o':s)  = [(chr n, t) | (n,t) <- readOct s]
+readEsc ('x':s)  = [(chr n, t) | (n,t) <- readHex s]
+readEsc s@(c:_) | isUpper c
+                 = let table = ('\DEL', "DEL") : zip ['\NUL' .. ] asciiTab
+                   in case [(c,s') | (c, mne) <- table,
+                                     ([],s') <- [match mne s]]
+                      of (pr:_) -> [pr]
+                         []     -> []
+readEsc _        = []
+
+match                         :: (Eq a) => [a] -> [a] -> ([a],[a])
+match (x:xs) (y:ys) | x == y  =  match xs ys
+match xs     ys               =  (xs,ys)
+
+showLitChar               :: Char -> ShowS
+showLitChar c | c > '\DEL' =  showChar '\\' .
+                              protectEsc isDigit (shows (ord c))
+showLitChar '\DEL'         =  showString "\\DEL"
+showLitChar '\\'           =  showString "\\\\"
+showLitChar c | c >= ' '   =  showChar c
+showLitChar '\a'           =  showString "\\a"
+showLitChar '\b'           =  showString "\\b"
+showLitChar '\f'           =  showString "\\f"
+showLitChar '\n'           =  showString "\\n"
+showLitChar '\r'           =  showString "\\r"
+showLitChar '\t'           =  showString "\\t"
+showLitChar '\v'           =  showString "\\v"
+showLitChar '\SO'          =  protectEsc (== 'H') (showString "\\SO")
+showLitChar c              =  showString ('\\' : (asciiTab!!ord c))
+
+protectEsc p f             = f . cont
+                             where cont s@(c:_) | p c = "\\&" ++ s
+                                   cont s             = s
+
+asciiTab :: [String]
+asciiTab = --listArray ('\NUL', ' ')
+           ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
+            "BS",  "HT",  "LF",  "VT",  "FF",  "CR",  "SO",  "SI",
+            "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
+            "CAN", "EM",  "SUB", "ESC", "FS",  "GS",  "RS",  "US",
+            "SP"]
diff --git a/lib/base/src/Data/Complex.hs b/lib/base/src/Data/Complex.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/Complex.hs
@@ -0,0 +1,104 @@
+module Data.Complex(
+    Complex((:+)),
+    realPart,
+    imagPart,
+    conjugate,
+    mkPolar,
+    cis,
+    polar,
+    magnitude,
+    phase
+    )  where
+
+infix  6  :+
+
+-- the standard says this should have a RealFloat constraint, but that is silly.
+data  Complex a = !a :+ !a  deriving (Eq,Read,Show)
+
+
+realPart, imagPart :: (RealFloat a) => Complex a -> a
+realPart (x:+y)  =  x
+imagPart (x:+y)  =  y
+
+conjugate  :: (RealFloat a) => Complex a -> Complex a
+conjugate (x:+y) =  x :+ (-y)
+
+mkPolar  :: (RealFloat a) => a -> a -> Complex a
+mkPolar r theta  =  r * cos theta :+ r * sin theta
+
+cis  :: (RealFloat a) => a -> Complex a
+cis theta  =  cos theta :+ sin theta
+
+polar  :: (RealFloat a) => Complex a -> (a,a)
+polar z  =  (magnitude z, phase z)
+
+magnitude :: (RealFloat a) => Complex a -> a
+magnitude (x:+y) =  scaleFloat k
+     (sqrt ((scaleFloat mk x)^(2::Int) + (scaleFloat mk y)^(2::Int)))
+    where k  = max (exponent x) (exponent y)
+          mk = - k
+
+phase :: (RealFloat a) => Complex a -> a
+phase (0 :+ 0) = 0
+phase (x :+ y) = atan2 y x
+
+
+instance  (RealFloat a) => Num (Complex a)  where
+    (x:+y) + (x':+y') =  (x+x') :+ (y+y')
+    (x:+y) - (x':+y') =  (x-x') :+ (y-y')
+    (x:+y) * (x':+y') =  (x*x'-y*y') :+ (x*y'+y*x')
+    negate (x:+y) =  negate x :+ negate y
+    abs z =  magnitude z :+ 0
+    signum (0 :+ 0) =  0
+    signum z@(x:+y) =  x/r :+ y/r  where r = magnitude z
+    fromInteger n =  fromInteger n :+ 0
+    fromInt n =  fromInt n :+ 0
+
+instance  (RealFloat a) => Fractional (Complex a)  where
+    (x:+y) / (x':+y') =  (x*x''+y*y'') / d :+ (y*x''-x*y'') / d
+       where x'' = scaleFloat k x'
+             y'' = scaleFloat k y'
+             k   = - max (exponent x') (exponent y')
+             d   = x'*x'' + y'*y''
+    fromRational a =  fromRational a :+ 0
+    fromDouble a = fromDouble a :+ 0
+
+instance  (RealFloat a) => Floating (Complex a) where
+    pi             =  pi :+ 0
+    exp (x:+y)     =  expx * cos y :+ expx * sin y
+                      where expx = exp x
+    log z          =  log (magnitude z) :+ phase z
+
+    sqrt (0 :+ 0)  =  0
+    sqrt z@(x:+y)  =  u :+ (if y < 0 then -v else v)
+                      where (u,v) = if x < 0 then (v',u') else (u',v')
+                            v'    = abs y / (u'*2)
+                            u'    = sqrt ((magnitude z + abs x) / 2)
+
+    sin (x:+y)     =  sin x * cosh y :+ cos x * sinh y
+    cos (x:+y)     =  cos x * cosh y :+ (- sin x * sinh y)
+    tan (x:+y)     =  (sinx*coshy:+cosx*sinhy)/(cosx*coshy:+(-sinx*sinhy))
+                      where sinx  = sin x
+                            cosx  = cos x
+                            sinhy = sinh y
+                            coshy = cosh y
+
+    sinh (x:+y)    =  cos y * sinh x :+ sin  y * cosh x
+    cosh (x:+y)    =  cos y * cosh x :+ sin y * sinh x
+    tanh (x:+y)    =  (cosy*sinhx:+siny*coshx)/(cosy*coshx:+siny*sinhx)
+                      where siny  = sin y
+                            cosy  = cos y
+                            sinhx = sinh x
+                            coshx = cosh x
+
+    asin z@(x:+y)  =  y':+(-x')
+                      where  (x':+y') = log (((-y):+x) + sqrt (1 - z*z))
+    acos z@(x:+y)  =  y'':+(-x'')
+                      where (x'':+y'') = log (z + ((-y'):+x'))
+                            (x':+y')   = sqrt (1 - z*z)
+    atan z@(x:+y)  =  y':+(-x')
+                      where (x':+y') = log (((1-y):+x) / sqrt (1+z*z))
+
+    asinh z        =  log (z + sqrt (1+z*z))
+    acosh z        =  log (z + (z+1) * sqrt ((z-1)/(z+1)))
+    atanh z        =  log ((1+z) / sqrt (1-z*z))
diff --git a/lib/base/src/Data/Dynamic.hs b/lib/base/src/Data/Dynamic.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/Dynamic.hs
@@ -0,0 +1,66 @@
+{-# OPTIONS_LHC -fffi #-}
+module Data.Dynamic(Dynamic,toDyn,fromDyn,fromDynamic,dynApply,dynApp) where
+
+
+import Data.Typeable
+
+data Obj
+
+data Dynamic = Dynamic TypeRep Obj
+
+instance Show Dynamic where
+    showsPrec _ x s = "<Dynamic>" ++ s
+
+-- | Converts an arbitrary value into an object of type 'Dynamic'.
+--
+-- The type of the object must be an instance of 'Typeable', which
+-- ensures that only monomorphically-typed objects may be converted to
+-- 'Dynamic'.  To convert a polymorphic object into 'Dynamic', give it
+-- a monomorphic type signature.  For example:
+--
+-- >    toDyn (id :: Int -> Int)
+--
+toDyn :: Typeable a => a -> Dynamic
+toDyn v = Dynamic (typeOf v) (unsafeCoerce v)
+
+-- | Converts a 'Dynamic' object back into an ordinary Haskell value of
+-- the correct type.  See also 'fromDynamic'.
+fromDyn :: Typeable a
+ 	=> Dynamic 	-- ^ the dynamically-typed object
+	-> a		-- ^ a default value
+	-> a		-- ^ returns: the value of the first argument, if
+			-- it has the correct type, otherwise the value of
+			-- the second argument.
+fromDyn (Dynamic t v) def
+  | typeOf def == t = unsafeCoerce v
+  | otherwise       = def
+
+-- | Converts a 'Dynamic' object back into an ordinary Haskell value of
+-- the correct type.  See also 'fromDyn'.
+fromDynamic
+	:: Typeable a
+	=> Dynamic	-- ^ the dynamically-typed object
+	-> Maybe a	-- ^ returns: @'Just' a@, if the dynamically-typed
+			-- object has the correct type (and @a@ is its value),
+			-- or 'Nothing' otherwise.
+fromDynamic (Dynamic t v) =
+  case unsafeCoerce v of
+    r | t == typeOf r -> Just r
+      | otherwise     -> Nothing
+
+-- (f::(a->b)) `dynApply` (x::a) = (f a)::b
+dynApply :: Dynamic -> Dynamic -> Maybe Dynamic
+dynApply (Dynamic t1 f) (Dynamic t2 x) =
+  case funResultTy t1 t2 of
+    Just t3 -> Just (Dynamic t3 ((unsafeCoerce f) x))
+    Nothing -> Nothing
+
+dynApp :: Dynamic -> Dynamic -> Dynamic
+dynApp f x = case dynApply f x of
+             Just r -> r
+             Nothing -> error ("Type error in dynamic application.\n" ++
+                               "Can't apply function " ++ show f ++
+                               " to argument " ++ show x)
+
+
+foreign import primitive "unsafeCoerce" unsafeCoerce :: a -> b
diff --git a/lib/base/src/Data/IORef.hs b/lib/base/src/Data/IORef.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/IORef.hs
@@ -0,0 +1,77 @@
+{-# OPTIONS_LHC -N -funboxed-tuples -fffi #-}
+module Data.IORef(
+    IORef(),	      -- abstract, instance of: Eq
+    newIORef,	      -- :: a -> IO (IORef a)
+    readIORef,	      -- :: IORef a -> IO a
+    writeIORef,	      -- :: IORef a -> a -> IO ()
+    modifyIORef,      -- :: IORef a -> (a -> a) -> IO ()
+    atomicModifyIORef,-- :: IORef a -> (a -> (a,b)) -> IO b
+    ) where
+
+import Lhc.Basics
+import Lhc.Order
+import Lhc.IO
+import Lhc.Int
+
+data IORef a = IORef (Ref__ a)
+data Ref__ a :: #
+
+
+foreign import primitive newRef__   :: a -> UIO (Ref__ a)
+foreign import primitive readRef__  :: Ref__ a -> UIO a
+foreign import primitive writeRef__ :: Ref__ a -> a -> UIO_
+
+-- {-# NOINLINE newIORef #-}
+newIORef :: a -> IO (IORef a)
+newIORef v = IO $ \w -> case newRef__ v w of (# w', r #) -> (# w', IORef r #)
+
+
+-- {-# NOINLINE readIORef #-}
+readIORef :: IORef a -> IO a
+readIORef (IORef r) = IO $ \w -> readRef__ r w
+
+-- {-# NOINLINE writeIORef #-}
+writeIORef :: IORef a -> a -> IO ()
+writeIORef (IORef r) v = IO $ \w -> case writeRef__ r v w of w' -> (# w', () #)
+
+--foreign import primitive eqRef__ :: Ref__ a -> Ref__ a -> Bool
+
+--instance Eq (IORef a) where
+--    (IORef x) == (IORef y) = eqRef__ x y
+
+
+--{-# NOINLINE modifyIORef #-}
+modifyIORef :: IORef a -> (a -> a) -> IO ()
+modifyIORef (IORef ref) f = IO $ \w -> case readRef__ ref w of
+    (# w', a #) -> case writeRef__ ref (f a) w' of
+        w'' -> (# w'', () #)
+
+--{-# NOINLINE atomicModifyIORef #-}
+atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b
+atomicModifyIORef (IORef r) f = IO $ \w -> case readRef__ r w of
+    (# w', a #) -> case f a of
+        (a',b) -> case writeRef__ r a' w' of
+            w'' -> (# w'', b #)
+{-
+--newIORef v = IO $ \_ world -> case newRef__ v world of
+--    (world',r) -> JustIO world' r
+--readIORef r = IO $ \_ world -> case readRef__ r world of
+--    (world',v) -> JustIO world' v
+--writeIORef r v = IO $ \_ world -> case writeRef__ r v world of
+--    world' -> JustIO world' ()
+{-# NOINLINE newIORef #-}
+newIORef :: a -> IO (IORef a)
+newIORef v = do
+    v' <- strictReturn v
+    return (IORef v')
+
+{-# NOINLINE readIORef #-}
+readIORef :: IORef a -> IO a
+readIORef r = do
+    --v <- strictReturn r
+    case r of
+        IORef r -> strictReturn r
+-}
+
+--foreign import primitive newRef__ :: forall s . a -> s -> (s,Ref s a)
+--foreign import primitive readRef__ :: forall s . Ref s a -> s -> (s,a)
diff --git a/lib/base/src/Data/Int.hs b/lib/base/src/Data/Int.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/Int.hs
@@ -0,0 +1,11 @@
+{-# OPTIONS_LHC -N #-}
+module Data.Int(Int,Int8,Int16,Int32,Int64,IntMax,IntPtr) where
+
+import Lhc.Prim(Int())
+
+data Int8
+data Int16
+data Int32
+data Int64
+data IntMax
+data IntPtr
diff --git a/lib/base/src/Data/Ix.hs b/lib/base/src/Data/Ix.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/Ix.hs
@@ -0,0 +1,69 @@
+{-# OPTIONS_LHC -N #-}
+module Data.Ix ( Ix(range, index, inRange, rangeSize) ) where
+
+import Lhc.Int
+import Lhc.Enum
+import Lhc.Order
+import Lhc.Basics
+import Lhc.Num
+import Lhc.IO
+
+class  Ord a => Ix a  where
+    range     :: (a,a) -> [a]
+    index     :: (a,a) -> a -> Int
+    inRange   :: (a,a) -> a -> Bool
+    rangeSize :: (a,a) -> Int
+
+    rangeSize b@(l,h) = case range b of
+        [] -> zero
+        _  -> index b h `plus` one
+	-- NB: replacing "null (range b)" by  "not (l <= h)"
+	-- fails if the bounds are tuples.  For example,
+	-- 	(1,2) <= (2,1)
+	-- but the range is nevertheless empty
+	--	range ((1,2),(2,1)) = []
+
+instance  Ix Char  where
+    range (m,n)		= [m..n]
+    index b@(c,c') ci
+        | inRange b ci  =  fromEnum ci `minus` fromEnum c
+        | otherwise     =  error "Ix.index: Index out of range."
+    inRange (c,c') i    =  c <= i && i <= c'
+
+instance  Ix Int  where
+    range (m,n)		= [m..n]
+    index b@(m,n) i
+        | inRange b i   =  i `minus` m
+        | otherwise     =  error "Ix.index: Index out of range."
+    inRange (m,n) i     =  m <= i && i <= n
+
+instance  (Ix a, Ix b)  => Ix (a,b) where
+        range   ((l,l'),(u,u')) = [(i,i') | i <- range (l,u), i' <- range (l',u')]
+        index   ((l,l'),(u,u')) (i,i') =  index (l,u) i * rangeSize (l',u') + index (l',u') i'
+        inRange ((l,l'),(u,u')) (i,i') = inRange (l,u) i && inRange (l',u') i'
+
+--instance  Ix Integer  where
+--    range (m,n)		= [m..n]
+--    index b@(m,n) i
+--        | inRange b i   =  fromInteger (i - m)
+--        | otherwise     =  error "Ix.index: Index out of range."
+--    inRange (m,n) i     =  m <= i && i <= n
+
+instance  Ix Bool  where
+    range (m,n)		= [m..n]
+    index b@(c,c') ci
+        | inRange b ci  =  fromEnum ci `minus` fromEnum c
+        | otherwise     =  error "Ix.index: 'Bool' Index out of range."
+    inRange (c,c') i    =  c <= i && i <= c'
+
+instance  Ix Ordering  where
+    range (m,n)		= [m..n]
+    index b@(c,c') ci
+        | inRange b ci  =  fromEnum ci `minus` fromEnum c
+        | otherwise     =  error "Ix.index: 'Ordering' Index out of range."
+    inRange (c,c') i    =  c <= i && i <= c'
+
+-- instance (Ix a,Ix b) => Ix (a, b) -- as derived, for all tuples
+-- instance Ix Bool                  -- as derived
+-- instance Ix Ordering              -- as derived
+-- instance Ix ()                    -- as derived
diff --git a/lib/base/src/Data/List.hs b/lib/base/src/Data/List.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/List.hs
@@ -0,0 +1,336 @@
+
+module Data.List (
+    elemIndex, elemIndices,
+    find, findIndex, findIndices,
+    nub, nubBy, delete, deleteBy, (\\), deleteFirstsBy,
+    union, unionBy, intersect, intersectBy,
+    intersperse, transpose, partition, group, groupBy,
+    inits, tails, isPrefixOf, isSuffixOf,
+    mapAccumL, mapAccumR,
+    sort, sortBy, insert, insertBy, maximumBy, minimumBy,
+    genericLength, genericTake, genericDrop,
+    genericSplitAt, genericIndex, genericReplicate,
+    zip4, zip5, zip6, zip7,
+    zipWith4, zipWith5, zipWith6, zipWith7,
+    unzip4, unzip5, unzip6, unzip7, unfoldr,
+
+    foldl', foldl1',
+
+    -- ...and what the Prelude exports
+    -- []((:), []), -- This is built-in syntax
+    map, (++), concat, filter,
+    head, last, tail, init, null, length, (!!),
+    foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,
+    iterate, repeat, replicate, cycle,
+    take, drop, splitAt, takeWhile, dropWhile, span, break,
+    lines, words, unlines, unwords, reverse, and, or,
+    any, all, elem, notElem, lookup,
+    sum, product, maximum, minimum, concatMap,
+    zip, zip3, zipWith, zipWith3, unzip, unzip3
+    ) where
+
+
+infix 5 \\
+
+elemIndex               :: Eq a => a -> [a] -> Maybe Int
+elemIndex x             =  findIndex (x ==)
+
+elemIndices             :: Eq a => a -> [a] -> [Int]
+elemIndices x           =  findIndices (x ==)
+
+find    :: (a -> Bool) -> [a] -> Maybe a
+find p xs =  case  filter p xs of
+    (x:_) -> Just x
+    [] -> Nothing
+
+findIndex               :: (a -> Bool) -> [a] -> Maybe Int
+findIndex p  xs           = case findIndices p xs of
+    (x:_) -> Just x
+    [] -> Nothing
+
+findIndices             :: (a -> Bool) -> [a] -> [Int]
+findIndices p xs        =  [ i | (x,i) <- zip xs [0..], p x ]
+
+nub                     :: Eq a => [a] -> [a]
+nub l                   = nub' l [] where
+    nub' [] _           = []
+    nub' (x:xs) ls
+        | x `elem` ls   = nub' xs ls
+        | otherwise     = x : nub' xs (x:ls)
+
+--nub                     =  nubBy (==)
+
+nubBy                   :: (a -> a -> Bool) -> [a] -> [a]
+nubBy eq l              = nubBy' l []
+  where
+    nubBy' [] _         = []
+    nubBy' (y:ys) xs
+       | elem_by eq y xs = nubBy' ys xs
+       | otherwise       = y : nubBy' ys (y:xs)
+    elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool
+    elem_by _  _ []             =  False
+    elem_by eq y (x:xs) =  x `eq` y || elem_by eq y xs
+
+--nubBy eq []             =  []
+--nubBy eq (x:xs)         =  x : nubBy eq (filter (\y -> not (eq x y)) xs)
+
+delete                  :: Eq a => a -> [a] -> [a]
+delete                  =  deleteBy (==)
+
+deleteBy                :: (a -> a -> Bool) -> a -> [a] -> [a]
+deleteBy eq x []        = []
+deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys
+
+(\\)                    :: Eq a => [a] -> [a] -> [a]
+(\\)                    =  foldl (flip delete)
+
+deleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+deleteFirstsBy eq       =  foldl (flip (deleteBy eq))
+
+union                   :: Eq a => [a] -> [a] -> [a]
+union                   =  unionBy (==)
+
+unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+unionBy eq xs ys        =  xs ++ deleteFirstsBy eq (nubBy eq ys) xs
+
+intersect               :: Eq a => [a] -> [a] -> [a]
+intersect               =  intersectBy (==)
+
+intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]
+
+intersperse             :: a -> [a] -> [a]
+intersperse sep []      =  []
+intersperse sep [x]     =  [x]
+intersperse sep (x:xs)  =  x : sep : intersperse sep xs
+
+-- transpose is lazy in both rows and columns,
+--       and works for non-rectangular 'matrices'
+-- For example, transpose [[1,2],[3,4,5],[]]  =  [[1,3],[2,4],[5]]
+-- Note that [h | (h:t) <- xss] is not the same as (map head xss)
+--      because the former discards empty sublists inside xss
+transpose                :: [[a]] -> [[a]]
+transpose []             = []
+transpose ([]     : xss) = transpose xss
+transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) :
+                           transpose (xs : [t | (h:t) <- xss])
+
+partition               :: (a -> Bool) -> [a] -> ([a],[a])
+partition p xs          =  (filter p xs, filter (not . p) xs)
+
+-- group splits its list argument into a list of lists of equal, adjacent
+-- elements.  e.g.,
+-- group "Mississippi" == ["M","i","ss","i","ss","i","pp","i"]
+group                   :: Eq a => [a] -> [[a]]
+group                   =  groupBy (==)
+
+groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]
+groupBy eq []           =  []
+groupBy eq (x:xs)       =  (x:ys) : groupBy eq zs
+                           where (ys,zs) = span (eq x) xs
+
+-- inits xs returns the list of initial segments of xs, shortest first.
+-- e.g., inits "abc" == ["","a","ab","abc"]
+inits                   :: [a] -> [[a]]
+inits []                =  [[]]
+inits (x:xs)            =  [[]] ++ map (x:) (inits xs)
+
+-- tails xs returns the list of all final segments of xs, longest first.
+-- e.g., tails "abc" == ["abc", "bc", "c",""]
+tails                   :: [a] -> [[a]]
+tails []                =  [[]]
+tails xxs@(_:xs)        =  xxs : tails xs
+
+isPrefixOf               :: Eq a => [a] -> [a] -> Bool
+isPrefixOf []     _      =  True
+isPrefixOf _      []     =  False
+isPrefixOf (x:xs) (y:ys) =  x == y && isPrefixOf xs ys
+
+isSuffixOf              :: Eq a => [a] -> [a] -> Bool
+isSuffixOf x y          =  reverse x `isPrefixOf` reverse y
+
+mapAccumL               :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c])
+mapAccumL f s []        =  (s, [])
+mapAccumL f s (x:xs)    =  (s'',y:ys)
+                           where (s', y ) = f s x
+                                 (s'',ys) = mapAccumL f s' xs
+
+mapAccumR               :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c])
+mapAccumR f s []        =  (s, [])
+mapAccumR f s (x:xs)    =  (s'', y:ys)
+                           where (s'',y ) = f s' x
+                                 (s', ys) = mapAccumR f s xs
+
+unfoldr                 :: (b -> Maybe (a,b)) -> b -> [a]
+unfoldr f b             = case f b of
+                                Nothing    -> []
+                                Just (a,b) -> a : unfoldr f b
+
+sort                    :: (Ord a) => [a] -> [a]
+sort                    =  sortBy compare
+
+sortBy                  :: (a -> a -> Ordering) -> [a] -> [a]
+sortBy cmp l = mergesort cmp l where
+    mergesort :: (a -> a -> Ordering) -> [a] -> [a]
+    mergesort cmp = mergesort' cmp . map wrap
+
+    mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]
+    mergesort' cmp [] = []
+    mergesort' cmp [xs] = xs
+    mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)
+
+    merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]
+    merge_pairs cmp [] = []
+    merge_pairs cmp [xs] = [xs]
+    merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss
+
+    merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
+    merge cmp xs [] = xs
+    merge cmp [] ys = ys
+    merge cmp (x:xs) (y:ys)
+     = case x `cmp` y of
+            GT -> y : merge cmp (x:xs)   ys
+            _  -> x : merge cmp    xs (y:ys)
+
+    wrap :: a -> [a]
+    wrap x = [x]
+
+-- sortBy cmp              =  foldr (insertBy cmp) []
+
+insert                  :: (Ord a) => a -> [a] -> [a]
+insert                  = insertBy compare
+
+insertBy                :: (a -> a -> Ordering) -> a -> [a] -> [a]
+insertBy cmp x []       =  [x]
+insertBy cmp x ys@(y:ys')
+                        =  case cmp x y of
+                                GT -> y : insertBy cmp x ys'
+                                _  -> x : ys
+
+maximumBy               :: (a -> a -> Ordering) -> [a] -> a
+maximumBy cmp []        =  error "List.maximumBy: empty list"
+maximumBy cmp xs        =  foldl1 max xs
+                        where
+                           max x y = case cmp x y of
+                                        GT -> x
+                                        _  -> y
+
+minimumBy               :: (a -> a -> Ordering) -> [a] -> a
+minimumBy cmp []        =  error "List.minimumBy: empty list"
+minimumBy cmp xs        =  foldl1 min xs
+                        where
+                           min x y = case cmp x y of
+                                        GT -> y
+                                        _  -> x
+
+genericLength           :: (Integral a) => [b] -> a
+genericLength []        =  0
+genericLength (x:xs)    =  1 + genericLength xs
+
+genericTake             :: (Integral a) => a -> [b] -> [b]
+genericTake _ []        =  []
+genericTake 0 _         =  []
+genericTake n (x:xs)
+   | n > 0              =  x : genericTake (n-1) xs
+   | otherwise          =  error "List.genericTake: negative argument"
+
+genericDrop             :: (Integral a) => a -> [b] -> [b]
+genericDrop 0 xs        =  xs
+genericDrop _ []        =  []
+genericDrop n (_:xs)
+   | n > 0              =  genericDrop (n-1) xs
+   | otherwise          =  error "List.genericDrop: negative argument"
+
+genericSplitAt          :: (Integral a) => a -> [b] -> ([b],[b])
+genericSplitAt 0 xs     =  ([],xs)
+genericSplitAt _ []     =  ([],[])
+genericSplitAt n (x:xs)
+   | n > 0              =  (x:xs',xs'')
+   | otherwise          =  error "List.genericSplitAt: negative argument"
+       where (xs',xs'') =  genericSplitAt (n-1) xs
+
+genericIndex            :: (Integral a) => [b] -> a -> b
+genericIndex (x:_)  0   =  x
+genericIndex (_:xs) n
+        | n > 0         =  genericIndex xs (n-1)
+        | otherwise     =  error "List.genericIndex: negative argument"
+genericIndex _ _        =  error "List.genericIndex: index too large"
+
+genericReplicate        :: (Integral a) => a -> b -> [b]
+genericReplicate n x    =  genericTake n (repeat x)
+
+zip4                    :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
+zip4                    =  zipWith4 (,,,)
+
+zip5                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
+zip5                    =  zipWith5 (,,,,)
+
+zip6                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
+                              [(a,b,c,d,e,f)]
+zip6                    =  zipWith6 (,,,,,)
+
+zip7                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->
+                              [g] -> [(a,b,c,d,e,f,g)]
+zip7                    =  zipWith7 (,,,,,,)
+
+zipWith4                :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
+zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
+                        =  z a b c d : zipWith4 z as bs cs ds
+zipWith4 _ _ _ _ _      =  []
+
+zipWith5                :: (a->b->c->d->e->f) ->
+                           [a]->[b]->[c]->[d]->[e]->[f]
+zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
+                        =  z a b c d e : zipWith5 z as bs cs ds es
+zipWith5 _ _ _ _ _ _    =  []
+
+zipWith6                :: (a->b->c->d->e->f->g) ->
+                           [a]->[b]->[c]->[d]->[e]->[f]->[g]
+zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
+                        =  z a b c d e f : zipWith6 z as bs cs ds es fs
+zipWith6 _ _ _ _ _ _ _  =  []
+
+zipWith7                :: (a->b->c->d->e->f->g->h) ->
+                           [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
+zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
+                   =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs
+zipWith7 _ _ _ _ _ _ _ _ = []
+
+unzip4                  :: [(a,b,c,d)] -> ([a],[b],[c],[d])
+unzip4                  =  foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
+                                        (a:as,b:bs,c:cs,d:ds))
+                                 ([],[],[],[])
+
+unzip5                  :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
+unzip5                  =  foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
+                                        (a:as,b:bs,c:cs,d:ds,e:es))
+                                 ([],[],[],[],[])
+
+unzip6                  :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
+unzip6                  =  foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
+                                        (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
+                                 ([],[],[],[],[],[])
+
+unzip7          :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
+unzip7          =  foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
+                                (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
+                         ([],[],[],[],[],[],[])
+
+{-# RULES "sort/sort"  forall  xs . sort (sort xs) = sort xs #-}
+{-# RULES "nub/nub"  forall  xs . nub (nub xs) = nub xs #-}
+
+
+-- | A strict version of 'foldl'.
+foldl'           :: (a -> b -> a) -> a -> [b] -> a
+foldl' f z xs = lgo z xs where
+    lgo z []     = z
+    lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs
+
+
+-- | A strict version of 'foldl1'
+foldl1'                  :: (a -> a -> a) -> [a] -> a
+foldl1' f (x:xs)         =  foldl' f x xs
+foldl1' _ []             =  error "foldl1': empty list"
+
+
+
diff --git a/lib/base/src/Data/Maybe.hs b/lib/base/src/Data/Maybe.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/Maybe.hs
@@ -0,0 +1,44 @@
+{-# OPTIONS_LHC -N #-}
+module Data.Maybe(
+    isJust, isNothing,
+    fromJust, fromMaybe, listToMaybe, maybeToList,
+    catMaybes, mapMaybe,
+
+    -- ...and what the Prelude exports
+    Maybe(Nothing, Just),
+    maybe
+  ) where
+
+import Lhc.Maybe
+import Lhc.Order
+import Lhc.Basics
+import Lhc.IO
+
+isJust                 :: Maybe a -> Bool
+isJust (Just a)        =  True
+isJust Nothing         =  False
+
+isNothing        :: Maybe a -> Bool
+isNothing        =  not . isJust
+
+fromJust               :: Maybe a -> a
+fromJust (Just a)      =  a
+fromJust Nothing       =  error "Maybe.fromJust: Nothing"
+
+fromMaybe              :: a -> Maybe a -> a
+fromMaybe d Nothing    =  d
+fromMaybe d (Just a)   =  a
+
+maybeToList            :: Maybe a -> [a]
+maybeToList Nothing    =  []
+maybeToList (Just a)   =  [a]
+
+listToMaybe            :: [a] -> Maybe a
+listToMaybe []         =  Nothing
+listToMaybe (a:_)      =  Just a
+
+catMaybes              :: [Maybe a] -> [a]
+catMaybes ms           =  [ m | Just m <- ms ]
+
+mapMaybe               :: (a -> Maybe b) -> [a] -> [b]
+mapMaybe f             =  catMaybes . map f
diff --git a/lib/base/src/Data/Monoid.hs b/lib/base/src/Data/Monoid.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/Monoid.hs
@@ -0,0 +1,90 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Monoid
+-- Copyright   :  (c) Andy Gill 2001,
+-- 		  (c) Oregon Graduate Institute of Science and Technology, 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (requires extended type classes)
+--
+-- Declaration of the Monoid class, and instances for list and functions.
+--
+--	  Inspired by the paper
+--	  /Functional Programming with Overloading and
+--	      Higher-Order Polymorphism/,
+--	    Mark P Jones (<http://www.cse.ogi.edu/~mpj/>)
+--		  Advanced School of Functional Programming, 1995.
+-----------------------------------------------------------------------------
+
+module Data.Monoid (
+ 	Monoid(..)
+  ) where
+
+import Prelude
+
+-- ---------------------------------------------------------------------------
+-- | The monoid class.
+-- A minimal complete definition must supply 'mempty' and 'mappend',
+-- and these should satisfy the monoid laws.
+
+class Monoid a where
+	mempty  :: a
+	-- ^ Identity of 'mappend'
+	mappend :: a -> a -> a
+	-- ^ An associative operation
+	mconcat :: [a] -> a
+
+	-- ^ Fold a list using the monoid.
+	-- For most types, the default definition for 'mconcat' will be
+	-- used, but the function is included in the class definition so
+	-- that an optimized version can be provided for specific types.
+
+	mconcat = foldr mappend mempty
+
+-- Monoid instances.
+
+instance Monoid [a] where
+	mempty  = []
+	mappend = (++)
+
+instance Monoid (a -> a) where
+	mempty  = id
+	mappend = (.)
+
+instance Monoid () where
+	-- Should it be strict?
+	mempty        = ()
+	_ `mappend` _ = ()
+	mconcat _     = ()
+
+instance (Monoid a, Monoid b) => Monoid (a,b) where
+	mempty = (mempty, mempty)
+	(a1,b1) `mappend` (a2,b2) =
+		(a1 `mappend` a2, b1 `mappend` b2)
+
+instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where
+	mempty = (mempty, mempty, mempty)
+	(a1,b1,c1) `mappend` (a2,b2,c2) =
+		(a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2)
+
+instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where
+	mempty = (mempty, mempty, mempty, mempty)
+	(a1,b1,c1,d1) `mappend` (a2,b2,c2,d2) =
+		(a1 `mappend` a2, b1 `mappend` b2,
+		 c1 `mappend` c2, d1 `mappend` d2)
+
+instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) =>
+		Monoid (a,b,c,d,e) where
+	mempty = (mempty, mempty, mempty, mempty, mempty)
+	(a1,b1,c1,d1,e1) `mappend` (a2,b2,c2,d2,e2) =
+		(a1 `mappend` a2, b1 `mappend` b2, c1 `mappend` c2,
+		 d1 `mappend` d2, e1 `mappend` e2)
+
+-- lexicographical ordering
+instance Monoid Ordering where
+	mempty         = EQ
+	LT `mappend` _ = LT
+	EQ `mappend` y = y
+	GT `mappend` _ = GT
diff --git a/lib/base/src/Data/Ratio.hs b/lib/base/src/Data/Ratio.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/Ratio.hs
@@ -0,0 +1,115 @@
+-- Standard functions on rational numbers
+
+module  Data.Ratio (
+    Ratio, Rational, (%), numerator, denominator, approxRational ) where
+
+import Prelude.Text
+import Prelude.Float(doubleToRational)
+import Lhc.Num
+import Lhc.Float
+
+infixl 7  %
+
+ratPrec = 7 :: Int
+
+
+
+(%)                     :: (Integral a) => a -> a -> Ratio a
+approxRational          :: (RealFrac a) => a -> a -> Rational
+
+
+
+x % y                   =  reduce (x * signum y) (abs y)
+
+
+
+
+-- "reduce" is a subsidiary function used only in this module.
+-- It normalises a ratio by dividing both numerator
+-- and denominator by their greatest common divisor.
+--
+-- E.g., 12 `reduce` 8    ==  3 :%   2
+--       12 `reduce` (-8) ==  3 :% (-2)
+
+reduce _ 0              =  error "Ratio.% : zero denominator"
+reduce x y              =  (x `quot` d) :% (y `quot` d)
+                           where d = gcd x y
+
+instance  (Integral a)  => Eq (Ratio a)  where
+    (x:%y) == (x':%y')  =  x == x' && y == y'
+
+instance  (Integral a)  => Ord (Ratio a)  where
+    (x:%y) <= (x':%y')  =  x * y' <= x' * y
+    (x:%y) <  (x':%y')  =  x * y' <  x' * y
+
+--negateRatio (x:%y)       =  (-x) :% y
+--(x:%y) `plusRatio` (x':%y')   =  reduce ((x*y') + (x'*y)) (y*y')
+--absRatio (x:%y)          =  abs x :% y
+
+instance  (Integral a)  => Num (Ratio a)  where
+    --(+) = plusRatio
+    (x:%y) + (x':%y')   =  reduce (x*y' + x'*y) (y*y')
+    (x:%y) * (x':%y')   =  reduce (x * x') (y * y')
+    --negate x {-(x:%y)-}   =  negateRatio x -- (-x) :% y
+    negate (x:%y)       =  (-x) :% y
+    --abs (x:%y)        =  abs x :% y
+    abs (x:%y)          =  abs x :% y
+    signum (x:%y)       =  signum x :% 1
+    fromInteger x       =  fromInteger x :% 1
+    fromInt     x       =  fromInt x :% 1
+
+instance  (Integral a)  => Real (Ratio a)  where
+    toRational (x:%y)   =  toInteger x :% toInteger y
+
+    toDouble  x         = rationalToDouble (toRational x)
+
+instance  (Integral a)  => Fractional (Ratio a)  where
+    (x:%y) / (x':%y')   =  (x*y') % (y*x')
+    recip (x:%y)        =  y % x
+    fromRational (x:%y) =  fromInteger x :% fromInteger y
+    fromDouble   x      = fromRational (doubleToRational x)
+
+instance  (Integral a)  => RealFrac (Ratio a)  where
+    properFraction (x:%y) = (fromIntegral q, r:%y)
+                            where (q,r) = quotRem x y
+
+{-
+instance  (Integral a)  => Enum (Ratio a)  where
+    succ x           =  x+1
+    pred x           =  x-1
+    toEnum           =  fromIntegral
+    fromEnum         =  fromInteger . truncate	-- May overflow
+--    enumFrom         =  numericEnumFrom		-- These numericEnumXXX functions
+--    enumFromThen     =  numericEnumFromThen	-- are as defined in Prelude.hs
+--    enumFromTo       =  numericEnumFromTo	-- but not exported from it!
+--    enumFromThenTo   =  numericEnumFromThenTo
+-}
+
+instance  (Read a, Integral a)  => Read (Ratio a)  where
+    readsPrec p  =  readParen (p > ratPrec)
+                              (\r -> [(reduce (x * signum y) (abs y),u) | (x,s)   <- readsPrec (ratPrec+1) r,
+                                                ("%",t) <- lex s,
+                                                (y,u)   <- readsPrec (ratPrec+1) t ])
+
+instance  (Integral a)  => Show (Ratio a)  where
+    showsPrec p (x:%y)  =  showParen (p > ratPrec)
+                               (showsPrec (ratPrec+1) x .
+			        showString " % " .
+				showsPrec (ratPrec+1) y)
+
+approxRational x eps    =  simplest (x-eps) (x+eps)
+        where simplest x y | y < x      =  simplest y x
+                           | x == y     =  xr
+                           | x > 0      =  simplest' n d n' d'
+                           | y < 0      =  - simplest' (-n') d' (-n) d
+                           | otherwise  =  0 :% 1
+                                        where xr@(n:%d) = toRational x
+                                              (n':%d')  = toRational y
+
+              simplest' n d n' d'       -- assumes 0 < n%d < n'%d'
+                        | r == 0     =  q :% 1
+                        | q /= q'    =  (q+1) :% 1
+                        | otherwise  =  (q*n''+d'') :% n''
+                                     where (q,r)      =  quotRem n d
+                                           (q',r')    =  quotRem n' d'
+                                           (n'':%d'') =  simplest' d' r' d r
diff --git a/lib/base/src/Data/Typeable.hs b/lib/base/src/Data/Typeable.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/Typeable.hs
@@ -0,0 +1,63 @@
+{-# OPTIONS_LHC -fffi #-}
+module Data.Typeable(TypeRep,typeOf) where
+
+
+data TypeRep
+
+instance Eq TypeRep where
+    (==) = primTypeRepEq
+
+foreign import primitive typeOf :: a -> TypeRep
+foreign import primitive typeOf1 :: t a -> TypeRep
+foreign import primitive typeOf2 :: t a b -> TypeRep
+foreign import primitive typeOf3 :: t a b c -> TypeRep
+foreign import primitive typeOf4 :: t a b c d -> TypeRep
+foreign import primitive typeOf5 :: t a b c d e -> TypeRep
+foreign import primitive typeOf6 :: t a b c d e f -> TypeRep
+foreign import primitive typeOf7 :: t a b c d e f g -> TypeRep
+foreign import primitive typeRepEq :: TypeRep -> TypeRep -> Bool
+
+
+-------------------------------------------------------------
+--
+--		Type-safe cast
+--
+-------------------------------------------------------------
+
+-- | The type-safe cast operation
+cast ::  a -> Maybe b
+cast x = r
+       where
+	 r = if typeOf x == typeOf (fromJust r)
+               then Just $ unsafeCoerce x
+	       else Nothing
+
+-- | A flexible variation parameterised in a type constructor
+gcast :: c a -> Maybe (c b)
+gcast x = r
+ where
+  r = if typeOf (getArg x) == typeOf (getArg (fromJust r))
+        then Just $ unsafeCoerce x
+        else Nothing
+  getArg :: c x -> x
+  getArg = undefined
+
+-- | Cast for * -> *
+gcast1 ::  c (t a) -> Maybe (c (t' a))
+gcast1 x = r
+ where
+  r = if typeOf1 (getArg x) == typeOf1 (getArg (fromJust r))
+       then Just $ unsafeCoerce x
+       else Nothing
+  getArg :: c x -> x
+  getArg = undefined
+
+-- | Cast for * -> * -> *
+gcast2 ::  c (t a b) -> Maybe (c (t' a b))
+gcast2 x = r
+ where
+  r = if typeOf2 (getArg x) == typeOf2 (getArg (fromJust r))
+       then Just $ unsafeCoerce x
+       else Nothing
+  getArg :: c x -> x
+  getArg = undefined
diff --git a/lib/base/src/Data/Unicode.hs b/lib/base/src/Data/Unicode.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/Unicode.hs
@@ -0,0 +1,63 @@
+{-# OPTIONS_LHC -fffi #-}
+module Data.Unicode(
+    CType(),
+    ctype,
+    isCType,
+    t_alnum,
+    t_alpha,
+    t_blank,
+    t_cntrl,
+    t_digit,
+    t_graph,
+    t_lower,
+    t_print,
+    t_punct,
+    t_space,
+    t_upper,
+    t_xdigit,
+    t_none
+    )where
+
+import Foreign.C.String
+import Foreign.C.Types
+import System.IO.Unsafe
+
+newtype CType = CType CInt
+
+-- | Get a ctype other than one of the defaults.
+
+ctype :: String -> IO CType
+ctype s = withCString s c_wctype
+
+isCType :: Char -> CType -> Bool
+isCType ch ct = unsafePerformIO (c_iswctype ch ct) /= 0
+
+
+t_alnum, t_alpha, t_blank, t_cntrl,
+ t_digit, t_graph, t_lower, t_print,
+ t_punct, t_space, t_upper, t_xdigit, t_none :: CType
+
+t_alnum = unsafePerformIO (ctype "alnum")
+t_alpha = unsafePerformIO (ctype "alpha")
+t_blank = unsafePerformIO (ctype "blank")
+t_cntrl = unsafePerformIO (ctype "cntrl")
+t_digit = unsafePerformIO (ctype "digit")
+t_graph = unsafePerformIO (ctype "graph")
+t_lower = unsafePerformIO (ctype "lower")
+t_print = unsafePerformIO (ctype "print")
+t_punct = unsafePerformIO (ctype "punct")
+t_space = unsafePerformIO (ctype "space")
+t_upper = unsafePerformIO (ctype "upper")
+t_xdigit = unsafePerformIO (ctype "xdigit")
+t_none = CType 0
+
+{-# NOINLINE
+ t_alnum, t_alpha, t_blank, t_cntrl,
+ t_digit, t_graph, t_lower, t_print,
+ t_punct, t_space, t_upper, t_xdigit
+ #-}
+
+
+foreign import ccall "wctype.h iswctype" c_iswctype :: Char -> CType -> IO Int
+foreign import ccall "wctype.h wctype" c_wctype :: CString -> IO CType
+
diff --git a/lib/base/src/Data/Word.hs b/lib/base/src/Data/Word.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Data/Word.hs
@@ -0,0 +1,12 @@
+{-# OPTIONS -N #-}
+module Data.Word(Word,Word8,Word16,Word32,Word64,WordMax,WordPtr) where
+
+
+
+data Word
+data Word8
+data Word16
+data Word32
+data Word64
+data WordMax
+data WordPtr
diff --git a/lib/base/src/Foreign.hs b/lib/base/src/Foreign.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign.hs
@@ -0,0 +1,41 @@
+{-# OPTIONS_LHC -N #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A collection of data types, classes, and functions for interfacing
+-- with another programming language.
+--
+-----------------------------------------------------------------------------
+
+module Foreign
+        ( module Data.Bits
+        , module Data.Int
+        , module Data.Word
+	, module Foreign.Ptr
+        , module Foreign.ForeignPtr
+        , module Foreign.StablePtr
+        , module Foreign.Storable
+        , module Foreign.Marshal
+
+        -- | For compatibility with the FFI addendum only.  The recommended
+        -- place to get this from is "System.IO.Unsafe".
+        , unsafePerformIO
+        ) where
+
+import Data.Bits
+import Data.Int
+import Data.Word
+import Foreign.Ptr
+import Foreign.ForeignPtr
+import Foreign.StablePtr
+import Foreign.Storable
+import Foreign.Marshal
+
+import System.IO.Unsafe (unsafePerformIO)
diff --git a/lib/base/src/Foreign/C.hs b/lib/base/src/Foreign/C.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/C.hs
@@ -0,0 +1,23 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.C
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Bundles the C specific FFI library functionality
+--
+-----------------------------------------------------------------------------
+
+module Foreign.C
+        ( module Foreign.C.Types
+        , module Foreign.C.String
+        , module Foreign.C.Error
+        ) where
+
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.C.Error
diff --git a/lib/base/src/Foreign/C/Error.hs b/lib/base/src/Foreign/C/Error.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/C/Error.hs
@@ -0,0 +1,539 @@
+{-# OPTIONS_LHC -fffi #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.C.Error
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- C-specific Marshalling support: Handling of C \"errno\" error codes.
+--
+-----------------------------------------------------------------------------
+
+
+
+module Foreign.C.Error (
+
+  -- * Haskell representations of @errno@ values
+
+  Errno(..),		-- instance: Eq
+
+  -- ** Common @errno@ symbols
+  -- | Different operating systems and\/or C libraries often support
+  -- different values of @errno@.  This module defines the common values,
+  -- but due to the open definition of 'Errno' users may add definitions
+  -- which are not predefined.
+  eOK,{- e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN,
+  eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED,
+  eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT,
+  eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ,
+  eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK,
+  eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH,
+  eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK,
+  eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS,
+  eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTTY, eNXIO,
+  eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL,
+  ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE,
+  eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN,
+  eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT,
+  eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV, -}
+
+  -- ** 'Errno' functions
+                        -- :: Errno
+  isValidErrno,		-- :: Errno -> Bool
+
+  -- access to the current thread's "errno" value
+  --
+  getErrno,             -- :: IO Errno
+  resetErrno,           -- :: IO ()
+
+  -- conversion of an "errno" value into IO error
+  --
+  errnoToIOError,       -- :: String       -- location
+                        -- -> Errno        -- errno
+                        -- -> Maybe Handle -- handle
+                        -- -> Maybe String -- filename
+                        -- -> IOError
+
+  -- throw current "errno" value
+  --
+  throwErrno,           -- ::                String               -> IO a
+
+  -- ** Guards for IO operations that may fail
+
+  throwErrnoIf,         -- :: (a -> Bool) -> String -> IO a       -> IO a
+  throwErrnoIf_,        -- :: (a -> Bool) -> String -> IO a       -> IO ()
+  throwErrnoIfRetry,    -- :: (a -> Bool) -> String -> IO a       -> IO a
+  throwErrnoIfRetry_,   -- :: (a -> Bool) -> String -> IO a       -> IO ()
+  throwErrnoIfMinus1,   -- :: Num a
+			-- =>                String -> IO a       -> IO a
+  throwErrnoIfMinus1_,  -- :: Num a
+			-- =>                String -> IO a       -> IO ()
+  throwErrnoIfMinus1Retry,
+			-- :: Num a
+			-- =>                String -> IO a       -> IO a
+  throwErrnoIfMinus1Retry_,
+			-- :: Num a
+			-- =>                String -> IO a       -> IO ()
+  throwErrnoIfNull,	-- ::                String -> IO (Ptr a) -> IO (Ptr a)
+  throwErrnoIfNullRetry,-- ::                String -> IO (Ptr a) -> IO (Ptr a)
+
+  throwErrnoIfRetryMayBlock,
+  throwErrnoIfRetryMayBlock_,
+  throwErrnoIfMinus1RetryMayBlock,
+  throwErrnoIfMinus1RetryMayBlock_,
+  throwErrnoIfNullRetryMayBlock
+) where
+
+
+import Foreign.Storable
+import Foreign.Ptr
+import Foreign.C.Types
+import Foreign.C.String
+
+import System.IO.Unsafe		( unsafePerformIO )
+
+
+
+-- "errno" type
+-- ------------
+
+-- | Haskell representation for @errno@ values.
+-- The implementation is deliberately exposed, to allow users to add
+-- their own definitions of 'Errno' values.
+
+newtype Errno = Errno CInt
+
+instance Eq Errno where
+  errno1@(Errno no1) == errno2@(Errno no2)
+    | isValidErrno errno1 && isValidErrno errno2 = no1 == no2
+    | otherwise					 = False
+
+-- common "errno" symbols
+--
+{-
+eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN,
+  eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED,
+  eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT,
+  eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ,
+  eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK,
+  eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH,
+  eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK,
+  eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS,
+  eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTTY, eNXIO,
+  eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL,
+  ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE,
+  eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN,
+  eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT,
+  eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV		       :: Errno
+-- -}
+-- the cCONST_XXX identifiers are cpp symbols whose value is computed by
+-- configure
+--
+eOK             = Errno 0
+{-
+#ifdef __NHC__
+#include "Errno.hs"
+#else
+e2BIG           = Errno (CONST_E2BIG)
+eACCES		= Errno (CONST_EACCES)
+eADDRINUSE	= Errno (CONST_EADDRINUSE)
+eADDRNOTAVAIL	= Errno (CONST_EADDRNOTAVAIL)
+eADV		= Errno (CONST_EADV)
+eAFNOSUPPORT	= Errno (CONST_EAFNOSUPPORT)
+eAGAIN		= Errno (CONST_EAGAIN)
+eALREADY	= Errno (CONST_EALREADY)
+eBADF		= Errno (CONST_EBADF)
+eBADMSG		= Errno (CONST_EBADMSG)
+eBADRPC		= Errno (CONST_EBADRPC)
+eBUSY		= Errno (CONST_EBUSY)
+eCHILD		= Errno (CONST_ECHILD)
+eCOMM		= Errno (CONST_ECOMM)
+eCONNABORTED	= Errno (CONST_ECONNABORTED)
+eCONNREFUSED	= Errno (CONST_ECONNREFUSED)
+eCONNRESET	= Errno (CONST_ECONNRESET)
+eDEADLK		= Errno (CONST_EDEADLK)
+eDESTADDRREQ	= Errno (CONST_EDESTADDRREQ)
+eDIRTY		= Errno (CONST_EDIRTY)
+eDOM		= Errno (CONST_EDOM)
+eDQUOT		= Errno (CONST_EDQUOT)
+eEXIST		= Errno (CONST_EEXIST)
+eFAULT		= Errno (CONST_EFAULT)
+eFBIG		= Errno (CONST_EFBIG)
+eFTYPE		= Errno (CONST_EFTYPE)
+eHOSTDOWN	= Errno (CONST_EHOSTDOWN)
+eHOSTUNREACH	= Errno (CONST_EHOSTUNREACH)
+eIDRM		= Errno (CONST_EIDRM)
+eILSEQ		= Errno (CONST_EILSEQ)
+eINPROGRESS	= Errno (CONST_EINPROGRESS)
+eINTR		= Errno (CONST_EINTR)
+eINVAL		= Errno (CONST_EINVAL)
+eIO		= Errno (CONST_EIO)
+eISCONN		= Errno (CONST_EISCONN)
+eISDIR		= Errno (CONST_EISDIR)
+eLOOP		= Errno (CONST_ELOOP)
+eMFILE		= Errno (CONST_EMFILE)
+eMLINK		= Errno (CONST_EMLINK)
+eMSGSIZE	= Errno (CONST_EMSGSIZE)
+eMULTIHOP	= Errno (CONST_EMULTIHOP)
+eNAMETOOLONG	= Errno (CONST_ENAMETOOLONG)
+eNETDOWN	= Errno (CONST_ENETDOWN)
+eNETRESET	= Errno (CONST_ENETRESET)
+eNETUNREACH	= Errno (CONST_ENETUNREACH)
+eNFILE		= Errno (CONST_ENFILE)
+eNOBUFS		= Errno (CONST_ENOBUFS)
+eNODATA		= Errno (CONST_ENODATA)
+eNODEV		= Errno (CONST_ENODEV)
+eNOENT		= Errno (CONST_ENOENT)
+eNOEXEC		= Errno (CONST_ENOEXEC)
+eNOLCK		= Errno (CONST_ENOLCK)
+eNOLINK		= Errno (CONST_ENOLINK)
+eNOMEM		= Errno (CONST_ENOMEM)
+eNOMSG		= Errno (CONST_ENOMSG)
+eNONET		= Errno (CONST_ENONET)
+eNOPROTOOPT	= Errno (CONST_ENOPROTOOPT)
+eNOSPC		= Errno (CONST_ENOSPC)
+eNOSR		= Errno (CONST_ENOSR)
+eNOSTR		= Errno (CONST_ENOSTR)
+eNOSYS		= Errno (CONST_ENOSYS)
+eNOTBLK		= Errno (CONST_ENOTBLK)
+eNOTCONN	= Errno (CONST_ENOTCONN)
+eNOTDIR		= Errno (CONST_ENOTDIR)
+eNOTEMPTY	= Errno (CONST_ENOTEMPTY)
+eNOTSOCK	= Errno (CONST_ENOTSOCK)
+eNOTTY		= Errno (CONST_ENOTTY)
+eNXIO		= Errno (CONST_ENXIO)
+eOPNOTSUPP	= Errno (CONST_EOPNOTSUPP)
+ePERM		= Errno (CONST_EPERM)
+ePFNOSUPPORT	= Errno (CONST_EPFNOSUPPORT)
+ePIPE		= Errno (CONST_EPIPE)
+ePROCLIM	= Errno (CONST_EPROCLIM)
+ePROCUNAVAIL	= Errno (CONST_EPROCUNAVAIL)
+ePROGMISMATCH	= Errno (CONST_EPROGMISMATCH)
+ePROGUNAVAIL	= Errno (CONST_EPROGUNAVAIL)
+ePROTO		= Errno (CONST_EPROTO)
+ePROTONOSUPPORT = Errno (CONST_EPROTONOSUPPORT)
+ePROTOTYPE	= Errno (CONST_EPROTOTYPE)
+eRANGE		= Errno (CONST_ERANGE)
+eREMCHG		= Errno (CONST_EREMCHG)
+eREMOTE		= Errno (CONST_EREMOTE)
+eROFS		= Errno (CONST_EROFS)
+eRPCMISMATCH	= Errno (CONST_ERPCMISMATCH)
+eRREMOTE	= Errno (CONST_ERREMOTE)
+eSHUTDOWN	= Errno (CONST_ESHUTDOWN)
+eSOCKTNOSUPPORT = Errno (CONST_ESOCKTNOSUPPORT)
+eSPIPE		= Errno (CONST_ESPIPE)
+eSRCH		= Errno (CONST_ESRCH)
+eSRMNT		= Errno (CONST_ESRMNT)
+eSTALE		= Errno (CONST_ESTALE)
+eTIME		= Errno (CONST_ETIME)
+eTIMEDOUT	= Errno (CONST_ETIMEDOUT)
+eTOOMANYREFS	= Errno (CONST_ETOOMANYREFS)
+eTXTBSY		= Errno (CONST_ETXTBSY)
+eUSERS		= Errno (CONST_EUSERS)
+eWOULDBLOCK	= Errno (CONST_EWOULDBLOCK)
+eXDEV		= Errno (CONST_EXDEV)
+#endif
+-}
+-- | Yield 'True' if the given 'Errno' value is valid on the system.
+-- This implies that the 'Eq' instance of 'Errno' is also system dependent
+-- as it is only defined for valid values of 'Errno'.
+--
+isValidErrno               :: Errno -> Bool
+--
+-- the configure script sets all invalid "errno"s to -1
+--
+isValidErrno (Errno errno)  = errno /= -1
+
+
+-- access to the current thread's "errno" value
+-- --------------------------------------------
+
+-- | Get the current value of @errno@ in the current thread.
+--
+getErrno :: IO Errno
+
+-- We must call a C function to get the value of errno in general.  On
+-- threaded systems, errno is hidden behind a C macro so that each OS
+-- thread gets its own copy.
+getErrno = do e <- peek _errno; return (Errno e)
+foreign import ccall "errno.h &errno" _errno :: Ptr CInt
+
+-- | Reset the current thread\'s @errno@ value to 'eOK'.
+--
+resetErrno :: IO ()
+
+-- Again, setting errno has to be done via a C function.
+resetErrno = poke _errno 0
+
+-- throw current "errno" value
+-- ---------------------------
+
+-- | Throw an 'IOError' corresponding to the current value of 'getErrno'.
+--
+throwErrno     :: String	-- ^ textual description of the error location
+	       -> IO a
+throwErrno loc  =
+  do
+    errno <- getErrno
+    ioError (errnoToIOError loc errno Nothing Nothing)
+
+
+-- guards for IO operations that may fail
+-- --------------------------------------
+
+-- | Throw an 'IOError' corresponding to the current value of 'getErrno'
+-- if the result value of the 'IO' action meets the given predicate.
+--
+throwErrnoIf    :: (a -> Bool)	-- ^ predicate to apply to the result value
+				-- of the 'IO' operation
+		-> String	-- ^ textual description of the location
+		-> IO a		-- ^ the 'IO' operation to be executed
+		-> IO a
+throwErrnoIf pred loc f  =
+  do
+    res <- f
+    if pred res then throwErrno loc else return res
+
+-- | as 'throwErrnoIf', but discards the result of the 'IO' action after
+-- error handling.
+--
+throwErrnoIf_   :: (a -> Bool) -> String -> IO a -> IO ()
+throwErrnoIf_ pred loc f  = throwErrnoIf pred loc f >> return ()
+
+-- | as 'throwErrnoIf', but retry the 'IO' action when it yields the
+-- error code 'eINTR' - this amounts to the standard retry loop for
+-- interrupted POSIX system calls.
+--
+throwErrnoIfRetry            :: (a -> Bool) -> String -> IO a -> IO a
+throwErrnoIfRetry pred loc f  =
+  do
+    res <- f
+    if pred res
+      then do
+	err <- getErrno
+	if err == eINTR
+	  then throwErrnoIfRetry pred loc f
+	  else throwErrno loc
+      else return res
+
+-- | as 'throwErrnoIfRetry', but checks for operations that would block and
+-- executes an alternative action before retrying in that case.
+--
+throwErrnoIfRetryMayBlock
+		:: (a -> Bool)	-- ^ predicate to apply to the result value
+				-- of the 'IO' operation
+		-> String	-- ^ textual description of the location
+		-> IO a		-- ^ the 'IO' operation to be executed
+		-> IO b		-- ^ action to execute before retrying if
+				-- an immediate retry would block
+		-> IO a
+throwErrnoIfRetryMayBlock pred loc f on_block  =
+  do
+    res <- f
+    if pred res
+      then do
+	err <- getErrno
+	if err == eINTR
+	  then throwErrnoIfRetryMayBlock pred loc f on_block
+          else if err == eWOULDBLOCK || err == eAGAIN
+	         then do on_block; throwErrnoIfRetryMayBlock pred loc f on_block
+                 else throwErrno loc
+      else return res
+
+-- | as 'throwErrnoIfRetry', but discards the result.
+--
+throwErrnoIfRetry_            :: (a -> Bool) -> String -> IO a -> IO ()
+throwErrnoIfRetry_ pred loc f  = throwErrnoIfRetry pred loc f >> return ()
+
+-- | as 'throwErrnoIfRetryMayBlock', but discards the result.
+--
+throwErrnoIfRetryMayBlock_ :: (a -> Bool) -> String -> IO a -> IO b -> IO ()
+throwErrnoIfRetryMayBlock_ pred loc f on_block
+  = throwErrnoIfRetryMayBlock pred loc f on_block >> return ()
+
+-- | Throw an 'IOError' corresponding to the current value of 'getErrno'
+-- if the 'IO' action returns a result of @-1@.
+--
+throwErrnoIfMinus1 :: Num a => String -> IO a -> IO a
+throwErrnoIfMinus1  = throwErrnoIf (== -1)
+
+-- | as 'throwErrnoIfMinus1', but discards the result.
+--
+throwErrnoIfMinus1_ :: Num a => String -> IO a -> IO ()
+throwErrnoIfMinus1_  = throwErrnoIf_ (== -1)
+
+-- | Throw an 'IOError' corresponding to the current value of 'getErrno'
+-- if the 'IO' action returns a result of @-1@, but retries in case of
+-- an interrupted operation.
+--
+throwErrnoIfMinus1Retry :: Num a => String -> IO a -> IO a
+throwErrnoIfMinus1Retry  = throwErrnoIfRetry (== -1)
+
+-- | as 'throwErrnoIfMinus1', but discards the result.
+--
+throwErrnoIfMinus1Retry_ :: Num a => String -> IO a -> IO ()
+throwErrnoIfMinus1Retry_  = throwErrnoIfRetry_ (== -1)
+
+-- | as 'throwErrnoIfMinus1Retry', but checks for operations that would block.
+--
+throwErrnoIfMinus1RetryMayBlock :: Num a => String -> IO a -> IO b -> IO a
+throwErrnoIfMinus1RetryMayBlock  = throwErrnoIfRetryMayBlock (== -1)
+
+-- | as 'throwErrnoIfMinus1RetryMayBlock', but discards the result.
+--
+throwErrnoIfMinus1RetryMayBlock_ :: Num a => String -> IO a -> IO b -> IO ()
+throwErrnoIfMinus1RetryMayBlock_  = throwErrnoIfRetryMayBlock_ (== -1)
+
+-- | Throw an 'IOError' corresponding to the current value of 'getErrno'
+-- if the 'IO' action returns 'nullPtr'.
+--
+throwErrnoIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
+throwErrnoIfNull  = throwErrnoIf (== nullPtr)
+
+-- | Throw an 'IOError' corresponding to the current value of 'getErrno'
+-- if the 'IO' action returns 'nullPtr',
+-- but retry in case of an interrupted operation.
+--
+throwErrnoIfNullRetry :: String -> IO (Ptr a) -> IO (Ptr a)
+throwErrnoIfNullRetry  = throwErrnoIfRetry (== nullPtr)
+
+-- | as 'throwErrnoIfNullRetry', but checks for operations that would block.
+--
+throwErrnoIfNullRetryMayBlock :: String -> IO (Ptr a) -> IO b -> IO (Ptr a)
+throwErrnoIfNullRetryMayBlock  = throwErrnoIfRetryMayBlock (== nullPtr)
+
+-- conversion of an "errno" value into IO error
+-- --------------------------------------------
+
+-- | Construct a Haskell 98 I\/O error based on the given 'Errno' value.
+-- The optional information can be used to improve the accuracy of
+-- error messages.
+--
+errnoToIOError	:: String	-- ^ the location where the error occurred
+		-> Errno	-- ^ the error number
+		-> Maybe a	-- ^ optional handle associated with the error
+		-> Maybe String	-- ^ optional filename associated with the error
+		-> IOError
+errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
+    str <- strerror errno >>= peekCString
+
+{-
+#if __GLASGOW_HASKELL__
+    return (IOError maybeHdl errType loc str maybeName)
+    where
+    errType
+        | errno == eOK             = OtherError
+        | errno == e2BIG           = ResourceExhausted
+        | errno == eACCES          = PermissionDenied
+        | errno == eADDRINUSE      = ResourceBusy
+        | errno == eADDRNOTAVAIL   = UnsupportedOperation
+        | errno == eADV            = OtherError
+        | errno == eAFNOSUPPORT    = UnsupportedOperation
+        | errno == eAGAIN          = ResourceExhausted
+        | errno == eALREADY        = AlreadyExists
+        | errno == eBADF           = OtherError
+        | errno == eBADMSG         = InappropriateType
+        | errno == eBADRPC         = OtherError
+        | errno == eBUSY           = ResourceBusy
+        | errno == eCHILD          = NoSuchThing
+        | errno == eCOMM           = ResourceVanished
+        | errno == eCONNABORTED    = OtherError
+        | errno == eCONNREFUSED    = NoSuchThing
+        | errno == eCONNRESET      = ResourceVanished
+        | errno == eDEADLK         = ResourceBusy
+        | errno == eDESTADDRREQ    = InvalidArgument
+        | errno == eDIRTY          = UnsatisfiedConstraints
+        | errno == eDOM            = InvalidArgument
+        | errno == eDQUOT          = PermissionDenied
+        | errno == eEXIST          = AlreadyExists
+        | errno == eFAULT          = OtherError
+        | errno == eFBIG           = PermissionDenied
+        | errno == eFTYPE          = InappropriateType
+        | errno == eHOSTDOWN       = NoSuchThing
+        | errno == eHOSTUNREACH    = NoSuchThing
+        | errno == eIDRM           = ResourceVanished
+        | errno == eILSEQ          = InvalidArgument
+        | errno == eINPROGRESS     = AlreadyExists
+        | errno == eINTR           = Interrupted
+        | errno == eINVAL          = InvalidArgument
+        | errno == eIO             = HardwareFault
+        | errno == eISCONN         = AlreadyExists
+        | errno == eISDIR          = InappropriateType
+        | errno == eLOOP           = InvalidArgument
+        | errno == eMFILE          = ResourceExhausted
+        | errno == eMLINK          = ResourceExhausted
+        | errno == eMSGSIZE        = ResourceExhausted
+        | errno == eMULTIHOP       = UnsupportedOperation
+        | errno == eNAMETOOLONG    = InvalidArgument
+        | errno == eNETDOWN        = ResourceVanished
+        | errno == eNETRESET       = ResourceVanished
+        | errno == eNETUNREACH     = NoSuchThing
+        | errno == eNFILE          = ResourceExhausted
+        | errno == eNOBUFS         = ResourceExhausted
+        | errno == eNODATA         = NoSuchThing
+        | errno == eNODEV          = UnsupportedOperation
+        | errno == eNOENT          = NoSuchThing
+        | errno == eNOEXEC         = InvalidArgument
+        | errno == eNOLCK          = ResourceExhausted
+        | errno == eNOLINK         = ResourceVanished
+        | errno == eNOMEM          = ResourceExhausted
+        | errno == eNOMSG          = NoSuchThing
+        | errno == eNONET          = NoSuchThing
+        | errno == eNOPROTOOPT     = UnsupportedOperation
+        | errno == eNOSPC          = ResourceExhausted
+        | errno == eNOSR           = ResourceExhausted
+        | errno == eNOSTR          = InvalidArgument
+        | errno == eNOSYS          = UnsupportedOperation
+        | errno == eNOTBLK         = InvalidArgument
+        | errno == eNOTCONN        = InvalidArgument
+        | errno == eNOTDIR         = InappropriateType
+        | errno == eNOTEMPTY       = UnsatisfiedConstraints
+        | errno == eNOTSOCK        = InvalidArgument
+        | errno == eNOTTY          = IllegalOperation
+        | errno == eNXIO           = NoSuchThing
+        | errno == eOPNOTSUPP      = UnsupportedOperation
+        | errno == ePERM           = PermissionDenied
+        | errno == ePFNOSUPPORT    = UnsupportedOperation
+        | errno == ePIPE           = ResourceVanished
+        | errno == ePROCLIM        = PermissionDenied
+        | errno == ePROCUNAVAIL    = UnsupportedOperation
+        | errno == ePROGMISMATCH   = ProtocolError
+        | errno == ePROGUNAVAIL    = UnsupportedOperation
+        | errno == ePROTO          = ProtocolError
+        | errno == ePROTONOSUPPORT = ProtocolError
+        | errno == ePROTOTYPE      = ProtocolError
+        | errno == eRANGE          = UnsupportedOperation
+        | errno == eREMCHG         = ResourceVanished
+        | errno == eREMOTE         = IllegalOperation
+        | errno == eROFS           = PermissionDenied
+        | errno == eRPCMISMATCH    = ProtocolError
+        | errno == eRREMOTE        = IllegalOperation
+        | errno == eSHUTDOWN       = IllegalOperation
+        | errno == eSOCKTNOSUPPORT = UnsupportedOperation
+        | errno == eSPIPE          = UnsupportedOperation
+        | errno == eSRCH           = NoSuchThing
+        | errno == eSRMNT          = UnsatisfiedConstraints
+        | errno == eSTALE          = ResourceVanished
+        | errno == eTIME           = TimeExpired
+        | errno == eTIMEDOUT       = TimeExpired
+        | errno == eTOOMANYREFS    = ResourceExhausted
+        | errno == eTXTBSY         = ResourceBusy
+        | errno == eUSERS          = ResourceExhausted
+        | errno == eWOULDBLOCK     = OtherError
+        | errno == eXDEV           = UnsupportedOperation
+        | otherwise                = OtherError
+#else
+#endif
+-}
+    return (userError (loc ++ ": " ++ str ++ maybe "" (": "++) maybeName))
+-- #endif
+
+foreign import ccall  "string.h strerror" strerror :: Errno -> IO (Ptr CChar)
+foreign import primitive "const.EINTR" eINTR :: Errno
+foreign import primitive "const.EWOULDBLOCK" eWOULDBLOCK :: Errno
+foreign import primitive "const.EAGAIN" eAGAIN :: Errno
+
diff --git a/lib/base/src/Foreign/C/OldString.hs b/lib/base/src/Foreign/C/OldString.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/C/OldString.hs
@@ -0,0 +1,36 @@
+module Foreign.C.String where
+
+import Char
+import Foreign.C.Types
+import Foreign.Marshal.Array
+import Foreign.Ptr
+import Data.Word
+
+type CString = Ptr CChar
+type CStringLen = (Ptr CChar, Int)
+
+nUL :: CChar
+nUL = 0
+
+peekCString :: CString -> IO String
+peekCString cp = do
+    cs <- peekArray0 nUL cp
+    return (cCharsToChars cs)
+
+-- TODO UTF8
+-- cast [CChar] to [Char]
+--
+cCharsToChars :: [CChar] -> [Char]
+cCharsToChars xs  = map castCCharToChar xs
+
+-- cast [Char] to [CChar]
+--
+charsToCChars :: [Char] -> [CChar]
+charsToCChars xs  = map castCharToCChar xs
+
+castCCharToChar :: CChar -> Char
+castCCharToChar ch = chr (fromIntegral (fromIntegral ch :: Word8))
+
+castCharToCChar :: Char -> CChar
+castCharToCChar ch = fromIntegral (ord ch)
+
diff --git a/lib/base/src/Foreign/C/String.hs b/lib/base/src/Foreign/C/String.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/C/String.hs
@@ -0,0 +1,460 @@
+{-# OPTIONS_LHC -N -fffi #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.C.String
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Utilities for primitive marshalling of C strings.
+--
+-- The marshalling converts each Haskell character, representing a Unicode
+-- code point, to one or more bytes in a manner that, by default, is
+-- determined by the current locale.  As a consequence, no guarantees
+-- can be made about the relative length of a Haskell string and its
+-- corresponding C string, and therefore all the marshalling routines
+-- include memory allocation.  The translation between Unicode and the
+-- encoding of the current locale may be lossy.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.C.String (   -- representation of strings in C
+
+  -- * C strings
+
+  CString,           -- = Ptr CChar
+  CStringLen,        -- = (Ptr CChar, Int)
+
+  -- ** Using a locale-dependent encoding
+
+  -- | Currently these functions are identical to their @CAString@ counterparts;
+  -- eventually they will use an encoding determined by the current locale.
+
+  -- conversion of C strings into Haskell strings
+  --
+  peekCString,       -- :: CString    -> IO String
+  peekCStringLen,    -- :: CStringLen -> IO String
+
+  -- conversion of Haskell strings into C strings
+  --
+  newCString,        -- :: String -> IO CString
+  newCStringLen,     -- :: String -> IO CStringLen
+
+  -- conversion of Haskell strings into C strings using temporary storage
+  --
+  withCString,       -- :: String -> (CString    -> IO a) -> IO a
+  withCStringLen,    -- :: String -> (CStringLen -> IO a) -> IO a
+
+  charIsRepresentable, -- :: Char -> IO Bool
+
+  -- ** Using 8-bit characters
+
+  -- | These variants of the above functions are for use with C libraries
+  -- that are ignorant of Unicode.  These functions should be used with
+  -- care, as a loss of information can occur.
+
+  castCharToCChar,   -- :: Char -> CChar
+  castCCharToChar,   -- :: CChar -> Char
+
+  peekCAString,      -- :: CString    -> IO String
+  peekCAStringLen,   -- :: CStringLen -> IO String
+  newCAString,       -- :: String -> IO CString
+  newCAStringLen,    -- :: String -> IO CStringLen
+  withCAString,      -- :: String -> (CString    -> IO a) -> IO a
+  withCAStringLen,   -- :: String -> (CStringLen -> IO a) -> IO a
+
+  -- * C wide strings
+
+  -- | These variants of the above functions are for use with C libraries
+  -- that encode Unicode using the C @wchar_t@ type in a system-dependent
+  -- way.  The only encodings supported are
+  --
+  -- * UTF-32 (the C compiler defines @__STDC_ISO_10646__@), or
+  --
+  -- * UTF-16 (as used on Windows systems).
+
+  CWString,          -- = Ptr CWchar
+  CWStringLen,       -- = (Ptr CWchar, Int)
+
+  peekCWString,      -- :: CWString    -> IO String
+  peekCWStringLen,   -- :: CWStringLen -> IO String
+  newCWString,       -- :: String -> IO CWString
+  newCWStringLen,    -- :: String -> IO CWStringLen
+  withCWString,      -- :: String -> (CWString    -> IO a) -> IO a
+  withCWStringLen,   -- :: String -> (CWStringLen -> IO a) -> IO a
+
+  ) where
+
+import Lhc.Basics
+import Lhc.Monad
+import Lhc.Order
+import Lhc.List
+import Lhc.Num
+import Foreign.Marshal.Array
+import Foreign.C.Types
+import Foreign.Ptr
+import Foreign.Storable
+
+import Data.Word
+
+
+-----------------------------------------------------------------------------
+-- Strings
+
+-- representation of strings in C
+-- ------------------------------
+
+-- | A C string is a reference to an array of C characters terminated by NUL.
+type CString    = Ptr CChar
+
+-- | A string with explicit length information in bytes instead of a
+-- terminating NUL (allowing NUL characters in the middle of the string).
+type CStringLen = (Ptr CChar, Int)
+
+-- exported functions
+-- ------------------
+--
+-- * the following routines apply the default conversion when converting the
+--   C-land character encoding into the Haskell-land character encoding
+
+-- | Marshal a NUL terminated C string into a Haskell string.
+--
+peekCString    :: CString -> IO String
+peekCString = peekCAString
+
+-- | Marshal a C string with explicit length into a Haskell string.
+--
+peekCStringLen           :: CStringLen -> IO String
+peekCStringLen = peekCAStringLen
+
+-- | Marshal a Haskell string into a NUL terminated C string.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * new storage is allocated for the C string and must be
+--   explicitly freed using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCString :: String -> IO CString
+newCString = newCAString
+
+-- | Marshal a Haskell string into a C string (ie, character array) with
+-- explicit length information.
+--
+-- * new storage is allocated for the C string and must be
+--   explicitly freed using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCStringLen     :: String -> IO CStringLen
+newCStringLen = newCAStringLen
+
+-- | Marshal a Haskell string into a NUL terminated C string using temporary
+-- storage.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+withCString :: String -> (CString -> IO a) -> IO a
+withCString = withCAString
+
+-- | Marshal a Haskell string into a NUL terminated C string using temporary
+-- storage.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+withCStringLen         :: String -> (CStringLen -> IO a) -> IO a
+withCStringLen = withCAStringLen
+
+-- | Determines whether a character can be accurately encoded in a 'CString'.
+-- Unrepresentable characters are converted to @\'?\'@.
+--
+-- Currently only Latin-1 characters are representable.
+charIsRepresentable :: Char -> IO Bool
+charIsRepresentable c = return (ord c < 256)
+
+-- single byte characters
+-- ----------------------
+--
+--   ** NOTE: These routines don't handle conversions! **
+
+-- | Convert a C byte, representing a Latin-1 character, to the corresponding
+-- Haskell character.
+--castCCharToChar :: CChar -> Char
+--castCCharToChar ch = chr (fromIntegral (fromIntegral ch :: Word8))
+
+-- | Convert a Haskell character to a C character.
+-- This function is only safe on the first 256 characters.
+--castCharToCChar :: Char -> CChar
+--castCharToCChar ch = fromIntegral (ord ch)
+
+foreign import primitive "U2U" castCCharToChar :: CChar -> Char
+foreign import primitive "U2U" castCharToCChar :: Char -> CChar
+
+-- | Marshal a NUL terminated C string into a Haskell string.
+--
+peekCAString    :: CString -> IO String
+--  #ifndef __GLASGOW_HASKELL__
+--peekCAString cp  = do
+--  cs <- peekArray0 nUL cp
+--  return (cCharsToChars cs)
+--  #else
+peekCAString cp = do
+  l <- lengthArray0 nUL cp
+  if l <= 0 then return "" else loop "" (l-1) where
+    loop s i = do
+        xval <- peekElemOff cp i
+	let val = castCCharToChar xval
+	val `seq` if i <= 0 then return (val:s) else loop (val:s) (i-1)
+--  #endif
+
+-- | Marshal a C string with explicit length into a Haskell string.
+--
+peekCAStringLen           :: CStringLen -> IO String
+--  #ifndef __GLASGOW_HASKELL__
+-- peekCAStringLen (cp, len)  = do
+--   cs <- peekArray len cp
+--  return (cCharsToChars cs)
+--  #else
+peekCAStringLen (cp, len)
+  | len <= 0  = return "" -- being (too?) nice.
+  | otherwise = loop [] (len-1)
+  where
+    loop acc i = do
+         xval <- peekElemOff cp i
+	 let val = castCCharToChar xval
+	   -- blow away the coercion ASAP.
+	 if (val `seq` (i == 0))
+	  then return (val:acc)
+	  else loop (val:acc) (i-1)
+--  #endif
+
+-- | Marshal a Haskell string into a NUL terminated C string.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * new storage is allocated for the C string and must be
+--   explicitly freed using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCAString :: String -> IO CString
+--  #ifndef __GLASGOW_HASKELL__
+-- newCAString  = newArray0 nUL . charsToCChars
+--  #else
+newCAString str = do
+  ptr <- mallocArray0 (length str)
+  let
+	go [] n     = pokeElemOff ptr n nUL
+    	go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
+  go str 0
+  return ptr
+--  #endif
+
+-- | Marshal a Haskell string into a C string (ie, character array) with
+-- explicit length information.
+--
+-- * new storage is allocated for the C string and must be
+--   explicitly freed using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCAStringLen     :: String -> IO CStringLen
+--  #ifndef __GLASGOW_HASKELL__
+-- newCAStringLen str  = do
+--   a <- newArray (charsToCChars str)
+--  return (pairLength str a)
+--  #else
+newCAStringLen str = do
+  ptr <- mallocArray0 len
+  let
+	go [] n     = n `seq` return ()	-- make it strict in n
+    	go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
+  go str 0
+  return (ptr, len) where
+    len = length str
+--  #endif
+
+-- | Marshal a Haskell string into a NUL terminated C string using temporary
+-- storage.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+withCAString :: String -> (CString -> IO a) -> IO a
+--  #ifndef __GLASGOW_HASKELL__
+-- withCAString  = withArray0 nUL . charsToCChars
+--  #else
+withCAString str f =
+  allocaArray0 (length str) $ \ptr ->
+      let
+	go [] n     = pokeElemOff ptr n nUL
+    	go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
+      in do
+      go str 0
+      f ptr
+-- #endif
+
+-- | Marshal a Haskell string into a NUL terminated C string using temporary
+-- storage.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+-- withCAStringLen         :: String -> (CStringLen -> IO a) -> IO a
+--  #ifndef __GLASGOW_HASKELL__
+-- withCAStringLen str act  = withArray (charsToCChars str) $ act . pairLength str
+--  #else
+withCAStringLen str f =
+  allocaArray len $ \ptr ->
+      let
+	go [] n     = n `seq` return ()	-- make it strict in n
+    	go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
+      in do
+      go str 0
+      f (ptr,len)
+  where
+    len = length str
+--  #endif
+
+-- auxiliary definitions
+-- ----------------------
+
+-- C's end of string character
+--
+nUL :: CChar
+nUL  = 0
+
+-- pair a C string with the length of the given Haskell string
+--
+pairLength :: String -> a -> (a, Int)
+pairLength  = flip (,) . length
+
+--  #ifndef __GLASGOW_HASKELL__
+-- cast [CChar] to [Char]
+--
+cCharsToChars :: [CChar] -> [Char]
+cCharsToChars xs  = map castCCharToChar xs
+
+-- cast [Char] to [CChar]
+--
+charsToCChars :: [Char] -> [CChar]
+charsToCChars xs  = map castCharToCChar xs
+--   #endif
+
+-----------------------------------------------------------------------------
+-- Wide strings
+
+-- representation of wide strings in C
+-- -----------------------------------
+
+-- | A C wide string is a reference to an array of C wide characters
+-- terminated by NUL.
+type CWString    = Ptr CWchar
+
+-- | A wide character string with explicit length information in bytes
+-- instead of a terminating NUL (allowing NUL characters in the middle
+-- of the string).
+type CWStringLen = (Ptr CWchar, Int)
+
+-- | Marshal a NUL terminated C wide string into a Haskell string.
+--
+peekCWString    :: CWString -> IO String
+peekCWString cp  = do
+  cs <- peekArray0 wNUL cp
+  return (cWcharsToChars cs)
+
+-- | Marshal a C wide string with explicit length into a Haskell string.
+--
+peekCWStringLen           :: CWStringLen -> IO String
+peekCWStringLen (cp, len)  = do
+  cs <- peekArray len cp
+  return (cWcharsToChars cs)
+
+-- | Marshal a Haskell string into a NUL terminated C wide string.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * new storage is allocated for the C wide string and must
+--   be explicitly freed using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCWString :: String -> IO CWString
+newCWString  = newArray0 wNUL . charsToCWchars
+
+-- | Marshal a Haskell string into a C wide string (ie, wide character array)
+-- with explicit length information.
+--
+-- * new storage is allocated for the C wide string and must
+--   be explicitly freed using 'Foreign.Marshal.Alloc.free' or
+--   'Foreign.Marshal.Alloc.finalizerFree'.
+--
+newCWStringLen     :: String -> IO CWStringLen
+newCWStringLen str  = do
+  a <- newArray (charsToCWchars str)
+  return (pairLength str a)
+
+-- | Marshal a Haskell string into a NUL terminated C wide string using
+-- temporary storage.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+withCWString :: String -> (CWString -> IO a) -> IO a
+withCWString  = withArray0 wNUL . charsToCWchars
+
+-- | Marshal a Haskell string into a NUL terminated C wide string using
+-- temporary storage.
+--
+-- * the Haskell string may /not/ contain any NUL characters
+--
+-- * the memory is freed when the subcomputation terminates (either
+--   normally or via an exception), so the pointer to the temporary
+--   storage must /not/ be used after this.
+--
+withCWStringLen         :: String -> (CWStringLen -> IO a) -> IO a
+withCWStringLen str act  = withArray (charsToCWchars str) $ act . pairLength str
+
+-- auxiliary definitions
+-- ----------------------
+
+wNUL :: CWchar
+wNUL = 0
+
+cWcharsToChars :: [CWchar] -> [Char]
+charsToCWchars :: [Char] -> [CWchar]
+
+
+cWcharsToChars xs  = map castCWcharToChar xs
+charsToCWchars xs  = map castCharToCWchar xs
+
+-- These conversions only make sense if __STDC_ISO_10646__ is defined
+-- (meaning that wchar_t is ISO 10646, aka Unicode)
+
+--castCWcharToChar :: CWchar -> Char
+--castCWcharToChar ch = chr (fromIntegral ch )
+
+--castCharToCWchar :: Char -> CWchar
+--castCharToCWchar ch = fromIntegral (ord ch)
+
+foreign import primitive "U2U" castCWcharToChar :: CWchar -> Char
+foreign import primitive "U2U" castCharToCWchar :: Char -> CWchar
+
+
+
diff --git a/lib/base/src/Foreign/C/Types.hs b/lib/base/src/Foreign/C/Types.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/C/Types.hs
@@ -0,0 +1,27 @@
+{-# OPTIONS --noprelude #-}
+module Foreign.C.Types where
+
+data CChar
+data CSChar
+data CUChar
+data CShort
+data CUShort
+data CInt
+data CUInt
+data CLong
+data CULong
+data CPtrdiff
+data CSize
+data CWchar
+data CSigAtomic
+data CLLong
+data CULLong
+data CClock
+data CTime
+data CFloat
+data CDouble
+data CLDouble
+data CFile
+data CJmpBuf
+data CFpos
+data CWint
diff --git a/lib/base/src/Foreign/ForeignPtr.hs b/lib/base/src/Foreign/ForeignPtr.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/ForeignPtr.hs
@@ -0,0 +1,55 @@
+-- | Just a dummy skeleton, fixme.
+module Foreign.ForeignPtr
+    (ForeignPtr, newForeignPtr_, newForeignPtr,
+     addForeignPtrFinalizer, mallocForeignPtr, mallocForeignPtrBytes,
+     withForeignPtr, unsafeForeignPtrToPtr, touchForeignPtr, castForeignPtr
+    ) where
+
+import Control.Monad
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Array
+import Foreign.Ptr
+import Foreign.Storable
+
+newtype ForeignPtr a = FP (Ptr a)
+type FinalizerPtr  a = Ptr a
+
+newForeignPtr_ :: Ptr a -> IO (ForeignPtr a)
+newForeignPtr_ = return . FP
+
+newForeignPtr :: FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
+newForeignPtr finalizer ptr = do
+    fp <- newForeignPtr_ ptr
+    addForeignPtrFinalizer finalizer fp
+    return fp
+
+
+-- newForeignPtrEnv :: FinalizerEnvPtr env a -> Ptr env -> Ptr a -> IO (ForeignPtr a)
+addForeignPtrFinalizer :: FinalizerPtr a -> ForeignPtr a -> IO ()
+addForeignPtrFinalizer _ _ = return ()
+
+-- addForeignPtrFinalizerEnv :: FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO ()
+
+mallocForeignPtr :: Storable a => IO (ForeignPtr a)
+mallocForeignPtr = liftM FP malloc
+
+mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
+mallocForeignPtrBytes = liftM FP . mallocBytes
+
+mallocForeignPtrArray  :: Storable a => Int -> IO (ForeignPtr a)
+mallocForeignPtrArray = liftM FP . mallocArray
+
+-- mallocForeignPtrArray0 :: Storable a => Int -> IO (ForeignPtr a)
+-- mallocForeignPtrArray0 = liftM FP . mallocArray0
+
+withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
+withForeignPtr (FP p) act = act p
+
+unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a
+unsafeForeignPtrToPtr (FP x) = x
+
+touchForeignPtr :: ForeignPtr a -> IO ()
+touchForeignPtr _ = return ()
+
+castForeignPtr :: ForeignPtr a -> ForeignPtr b
+castForeignPtr (FP x) = FP $ castPtr x
diff --git a/lib/base/src/Foreign/Marshal.hs b/lib/base/src/Foreign/Marshal.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/Marshal.hs
@@ -0,0 +1,28 @@
+{-# OPTIONS_GHC -fno-implicit-prelude #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Marshal
+-- Copyright   :  (c) The FFI task force 2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Marshalling support
+--
+-----------------------------------------------------------------------------
+
+module Foreign.Marshal
+        ( module Foreign.Marshal.Alloc
+        , module Foreign.Marshal.Array
+        , module Foreign.Marshal.Error
+        , module Foreign.Marshal.Pool
+        , module Foreign.Marshal.Utils
+        ) where
+
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Array
+import Foreign.Marshal.Error
+import Foreign.Marshal.Pool
+import Foreign.Marshal.Utils
diff --git a/lib/base/src/Foreign/Marshal/Alloc.hs b/lib/base/src/Foreign/Marshal/Alloc.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/Marshal/Alloc.hs
@@ -0,0 +1,137 @@
+{-# OPTIONS_LHC -N -fffi #-}
+module Foreign.Marshal.Alloc (
+  -- * Memory allocation
+  -- ** Local allocation
+  alloca,       -- :: Storable a =>        (Ptr a -> IO b) -> IO b
+  allocaBytes,  -- ::               Int -> (Ptr a -> IO b) -> IO b
+
+  -- ** Dynamic allocation
+  malloc,       -- :: Storable a =>        IO (Ptr a)
+  mallocBytes,  -- ::               Int -> IO (Ptr a)
+
+  realloc,      -- :: Storable b => Ptr a        -> IO (Ptr b)
+  reallocBytes, -- ::		    Ptr a -> Int -> IO (Ptr a)
+
+  free,         -- :: Ptr a -> IO ()
+  finalizerFree -- :: FinalizerPtr a
+) where
+
+import Foreign.Ptr
+import Foreign.Storable
+import Prelude.IO
+import Foreign.C.Types
+import Foreign.Marshal.Utils
+import Prelude.IOError
+import Lhc.Prim
+import Lhc.Basics
+import Lhc.Monad
+import Lhc.Order
+import Lhc.IO
+import Lhc.Int(unboxInt)
+import Lhc.Addr
+import Lhc.Num
+import qualified Lhc.Options as JO
+
+
+
+-- TODO handle exceptions
+allocaBytes' :: Int -> (Ptr a -> IO b) -> IO b
+allocaBytes' b f = do
+    p <- mallocBytes b
+    r <- f p
+    free p
+    return r
+
+allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
+allocaBytes num fn = etaIO $ case JO.target of
+    JO.GhcHs -> case unboxInt num of n -> alloca__ n (\addr -> fn (boxAddr addr))
+    _ -> allocaBytes' num fn
+
+foreign import primitive alloca__ :: Int__ -> (Addr__ -> IO b) -> IO b
+foreign import primitive "box" boxAddr :: Addr__ -> Ptr a
+
+-- exported functions
+-- ------------------
+
+-- |Allocate a block of memory that is sufficient to hold values of type
+-- @a@.  The size of the area allocated is determined by the 'sizeOf'
+-- method from the instance of 'Storable' for the appropriate type.
+--
+-- The memory may be deallocated using 'free' or 'finalizerFree' when
+-- no longer required.
+--
+malloc :: Storable a => IO (Ptr a)
+malloc  = doMalloc undefined
+doMalloc       :: Storable b => b -> IO (Ptr b)
+doMalloc dummy  = mallocBytes (sizeOf dummy)
+
+
+-- |@'alloca' f@ executes the computation @f@, passing as argument
+-- a pointer to a temporarily allocated block of memory sufficient to
+-- hold values of type @a@.
+--
+-- The memory is freed when @f@ terminates (either normally or via an
+-- exception), so the pointer passed to @f@ must /not/ be used after this.
+--
+alloca :: Storable a => (Ptr a -> IO b) -> IO b
+alloca fn  = etaIO $ doAlloca undefined fn where
+    doAlloca       :: Storable a' => a' -> (Ptr a' -> IO b') -> IO b'
+    doAlloca dummy fn = allocaBytes (sizeOf dummy) fn
+
+failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)
+failWhenNULL name f = do
+   addr <- f
+   if addr == nullPtr
+      then ioError (userError (name++": out of memory"))
+      else return addr
+
+-- |Allocate a block of memory of the given number of bytes.
+-- The block of memory is sufficiently aligned for any of the basic
+-- foreign types that fits into a memory block of the allocated size.
+--
+-- The memory may be deallocated using 'free' or 'finalizerFree' when
+-- no longer required.
+--
+mallocBytes      :: Int -> IO (Ptr a)
+mallocBytes size  = failWhenNULL "malloc" (_malloc (fromIntegral size))
+
+
+-- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
+-- to the size needed to store values of type @b@.  The returned pointer
+-- may refer to an entirely different memory area, but will be suitably
+-- aligned to hold values of type @b@.  The contents of the referenced
+-- memory area will be the same as of the original pointer up to the
+-- minimum of the original size and the size of values of type @b@.
+--
+-- If the argument to 'realloc' is 'nullPtr', 'realloc' behaves like
+-- 'malloc'.
+--
+realloc :: Storable b => Ptr a -> IO (Ptr b)
+realloc  = doRealloc undefined
+doRealloc           :: Storable b' => b' -> Ptr a' -> IO (Ptr b')
+doRealloc dummy ptr  = let
+                         size = fromIntegral (sizeOf dummy)
+                       in
+                       failWhenNULL "realloc" (_realloc ptr size)
+
+-- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
+-- to the given size.  The returned pointer may refer to an entirely
+-- different memory area, but will be sufficiently aligned for any of the
+-- basic foreign types that fits into a memory block of the given size.
+-- The contents of the referenced memory area will be the same as of
+-- the original pointer up to the minimum of the original size and the
+-- given size.
+--
+-- If the pointer argument to 'reallocBytes' is 'nullPtr', 'reallocBytes'
+-- behaves like 'malloc'.  If the requested size is 0, 'reallocBytes'
+-- behaves like 'free'.
+--
+reallocBytes          :: Ptr a -> Int -> IO (Ptr a)
+reallocBytes ptr i | ptr `seq` i `seq` False = undefined
+reallocBytes ptr 0     = do free ptr; return nullPtr
+reallocBytes ptr size  =
+  failWhenNULL "realloc" (_realloc ptr (fromIntegral size))
+
+foreign import ccall "stdlib.h malloc" _malloc :: CSize -> IO (Ptr a)
+foreign import ccall "stdlib.h free" free :: Ptr a -> IO ()
+foreign import ccall "stdlib.h realloc" _realloc :: Ptr a -> CSize -> IO (Ptr b)
diff --git a/lib/base/src/Foreign/Marshal/Array.hs b/lib/base/src/Foreign/Marshal/Array.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/Marshal/Array.hs
@@ -0,0 +1,256 @@
+{-# OPTIONS_LHC -N  #-}
+module Foreign.Marshal.Array (
+  -- * Marshalling arrays
+
+  -- ** Allocation
+  --
+  mallocArray,    -- :: Storable a => Int -> IO (Ptr a)
+  mallocArray0,   -- :: Storable a => Int -> IO (Ptr a)
+
+  allocaArray,    -- :: Storable a => Int -> (Ptr a -> IO b) -> IO b
+  allocaArray0,   -- :: Storable a => Int -> (Ptr a -> IO b) -> IO b
+
+  reallocArray,   -- :: Storable a => Ptr a -> Int -> IO (Ptr a)
+  reallocArray0,  -- :: Storable a => Ptr a -> Int -> IO (Ptr a)
+
+  -- ** Marshalling
+  --
+  peekArray,      -- :: Storable a =>         Int -> Ptr a -> IO [a]
+  peekArray0,     -- :: (Storable a, Eq a) => a   -> Ptr a -> IO [a]
+
+  pokeArray,      -- :: Storable a =>      Ptr a -> [a] -> IO ()
+  pokeArray0,     -- :: Storable a => a -> Ptr a -> [a] -> IO ()
+
+  -- ** Combined allocation and marshalling
+  --
+  newArray,       -- :: Storable a =>      [a] -> IO (Ptr a)
+  newArray0,      -- :: Storable a => a -> [a] -> IO (Ptr a)
+
+  withArray,      -- :: Storable a =>      [a] -> (Ptr a -> IO b) -> IO b
+  withArray0,     -- :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
+
+  withArrayLen,   -- :: Storable a =>      [a] -> (Int -> Ptr a -> IO b) -> IO b
+  withArrayLen0,  -- :: Storable a => a -> [a] -> (Int -> Ptr a -> IO b) -> IO b
+
+  -- ** Copying
+
+  -- | (argument order: destination, source)
+  copyArray,      -- :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
+  moveArray,      -- :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
+
+  -- ** Finding the length
+  --
+  lengthArray0,   -- :: (Storable a, Eq a) => a -> Ptr a -> IO Int
+
+  -- ** Indexing
+  --
+  advancePtr,     -- :: Storable a => Ptr a -> Int -> Ptr a
+) where
+
+
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils
+import Foreign.Ptr
+import Foreign.Storable
+import Lhc.Basics
+import Lhc.IO
+import Lhc.List
+import Lhc.Monad
+import Lhc.Num
+import Lhc.Order
+import Prelude.IOError
+
+-- allocation
+-- ----------
+
+-- |Allocate storage for the given number of elements of a storable type
+-- (like 'Foreign.Marshal.Alloc.malloc', but for multiple elements).
+--
+mallocArray :: Storable a => Int -> IO (Ptr a)
+mallocArray  = doMalloc undefined
+doMalloc            :: Storable a' => a' -> Int -> IO (Ptr a')
+doMalloc dummy size  = mallocBytes (size * sizeOf dummy)
+
+-- |Like 'mallocArray', but add an extra position to hold a special
+-- termination element.
+--
+mallocArray0      :: Storable a => Int -> IO (Ptr a)
+mallocArray0 size  = mallocArray (size + 1)
+
+-- |Temporarily allocate space for the given number of elements
+-- (like 'Foreign.Marshal.Alloc.alloca', but for multiple elements).
+--
+allocaArray :: Storable a => Int -> (Ptr a -> IO b) -> IO b
+allocaArray  size fn = etaIO $ doAlloca undefined fn where
+    doAlloca            :: Storable a' => a' ->  (Ptr a' -> IO b') -> IO b'
+    doAlloca dummy fn = allocaBytes (size * sizeOf dummy) fn
+
+-- |Like 'allocaArray', but add an extra position to hold a special
+-- termination element.
+--
+allocaArray0      :: Storable a => Int -> (Ptr a -> IO b) -> IO b
+allocaArray0 size  = allocaArray (size + 1)
+
+-- |Adjust the size of an array
+--
+reallocArray :: Storable a => Ptr a -> Int -> IO (Ptr a)
+reallocArray  = doRealloc undefined
+  where
+    doRealloc                :: Storable a' => a' -> Ptr a' -> Int -> IO (Ptr a')
+    doRealloc dummy ptr size  = reallocBytes ptr (size * sizeOf dummy)
+
+-- |Adjust the size of an array including an extra position for the end marker.
+--
+reallocArray0          :: Storable a => Ptr a -> Int -> IO (Ptr a)
+reallocArray0 ptr size  = reallocArray ptr (size + 1)
+
+
+-- |Convert an array of given length into a Haskell list.  This version
+-- traverses the array backwards using an accumulating parameter,
+-- which uses constant stack space.  The previous version using mapM
+-- needed linear stack space.
+--
+peekArray          :: Storable a => Int -> Ptr a -> IO [a]
+peekArray size ptr | ptr `seq` (size <= 0) = return []
+                   | otherwise = f (size-1) []
+  where
+    f 0 acc = do e <- peekElemOff ptr 0; return (e:acc)
+    f n acc = do e <- peekElemOff ptr n; f (n-1) (e:acc)
+
+-- |Convert an array terminated by the given end marker into a Haskell list
+--
+peekArray0            :: (Storable a, Eq a) => a -> Ptr a -> IO [a]
+peekArray0 marker ptr  = do
+  size <- lengthArray0 marker ptr
+  peekArray size ptr
+
+-- finding the length
+-- ------------------
+
+
+-- |Write the list elements consecutive into memory
+--
+--pokeArray :: Storable a => Ptr a -> [a] -> IO ()
+--pokeArray ptr vals =  zipWithM_ (pokeElemOff ptr) [0..] vals where
+--    zipWithM_         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
+--    zipWithM_ f xs ys =  sequence_ (zipWith f xs ys)
+
+pokeArray :: Storable a => Ptr a -> [a] -> IO ()
+pokeArray ptr vals = pokeArray' ptr vals >> return ()
+
+pokeArray' :: Storable a => Ptr a -> [a] -> IO Int
+pokeArray' ptr vals =  etaIO $ f 0 vals where
+    f n [] | n `seq` True = return n
+    f n (x:xs) = pokeElemOff ptr n x >> f (n + 1) xs
+
+
+-- |Write the list elements consecutive into memory and terminate them with the
+-- given marker element
+--
+pokeArray0 :: Storable a => a -> Ptr a -> [a] -> IO ()
+pokeArray0 marker ptr vals  = do
+  lv <- pokeArray' ptr vals
+  pokeElemOff ptr lv marker
+
+-- combined allocation and marshalling
+-- -----------------------------------
+
+-- |Write a list of storable elements into a newly allocated, consecutive
+-- sequence of storable values
+-- (like 'Foreign.Marshal.Utils.new', but for multiple elements).
+--
+newArray      :: Storable a => [a] -> IO (Ptr a)
+newArray vals  = do
+  ptr <- mallocArray (length vals)
+  pokeArray ptr vals
+  return ptr
+
+-- |Write a list of storable elements into a newly allocated, consecutive
+-- sequence of storable values, where the end is fixed by the given end marker
+--
+newArray0             :: Storable a => a -> [a] -> IO (Ptr a)
+newArray0 marker vals  = do
+  ptr <- mallocArray0 (length vals)
+  pokeArray0 marker ptr vals
+  return ptr
+
+-- |Temporarily store a list of storable values in memory
+-- (like 'Foreign.Marshal.Utils.with', but for multiple elements).
+--
+withArray :: Storable a => [a] -> (Ptr a -> IO b) -> IO b
+withArray vals = withArrayLen vals . const
+
+-- |Like 'withArray', but the action gets the number of values
+-- as an additional parameter
+--
+withArrayLen :: Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
+withArrayLen vals f  = etaIO $
+  len `seq` allocaArray len $ \ptr -> do
+      pokeArray ptr vals
+      res <- f len ptr
+      return res
+  where
+    len = length vals
+
+-- |Like 'withArray', but a terminator indicates where the array ends
+--
+withArray0 :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
+withArray0 marker vals = withArrayLen0 marker vals . const
+
+-- |Like 'withArrayLen', but a terminator indicates where the array ends
+--
+withArrayLen0 :: Storable a => a -> [a] -> (Int -> Ptr a -> IO b) -> IO b
+withArrayLen0 marker vals f  = etaIO $
+  len `seq` allocaArray0 len $ \ptr -> do
+      pokeArray0 marker ptr vals
+      res <- f len ptr
+      return res
+  where
+    len = length vals
+
+
+-- copying (argument order: destination, source)
+-- -------
+
+-- |Copy the given number of elements from the second array (source) into the
+-- first array (destination); the copied areas may /not/ overlap
+--
+copyArray :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
+copyArray  = doCopy undefined
+  where
+    doCopy                     :: Storable a' => a' -> Ptr a' -> Ptr a' -> Int -> IO ()
+    doCopy dummy dest src size  = copyBytes dest src (size * sizeOf dummy)
+
+-- |Copy the given number of elements from the second array (source) into the
+-- first array (destination); the copied areas /may/ overlap
+--
+moveArray :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
+moveArray  = doMove undefined
+  where
+    doMove                     :: Storable a' => a' -> Ptr a' -> Ptr a' -> Int -> IO ()
+    doMove dummy dest src size  = moveBytes dest src (size * sizeOf dummy)
+
+
+-- finding the length
+-- ------------------
+
+-- |Return the number of elements in an array, excluding the terminator
+--
+lengthArray0            :: (Storable a, Eq a) => a -> Ptr a -> IO Int
+lengthArray0 marker ptr | ptr `seq` True  = etaIO $ loop 0
+  where
+    loop i | i `seq` True = do
+        val <- peekElemOff ptr i
+        if val == marker then return i else loop (i+1)
+
+
+-- indexing
+-- --------
+
+-- |Advance a pointer into an array by the given number of elements
+--
+advancePtr :: Storable a => Ptr a -> Int -> Ptr a
+advancePtr  = doAdvance undefined
+  where
+    doAdvance             :: Storable a' => a' -> Ptr a' -> Int -> Ptr a'
+    doAdvance dummy ptr i  = ptr `plusPtr` (i * sizeOf dummy)
diff --git a/lib/base/src/Foreign/Marshal/Error.hs b/lib/base/src/Foreign/Marshal/Error.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/Marshal/Error.hs
@@ -0,0 +1,74 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Marshal.Error
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Routines for testing return values and raising a 'userError' exception
+-- in case of values indicating an error state.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.Marshal.Error (
+  throwIf,       -- :: (a -> Bool) -> (a -> String) -> IO a       -> IO a
+  throwIf_,      -- :: (a -> Bool) -> (a -> String) -> IO a       -> IO ()
+  throwIfNeg,    -- :: (Ord a, Num a)
+	         -- =>                (a -> String) -> IO a       -> IO a
+  throwIfNeg_,   -- :: (Ord a, Num a)
+	         -- =>                (a -> String) -> IO a       -> IO ()
+  throwIfNull,   -- ::                String        -> IO (Ptr a) -> IO (Ptr a)
+
+  -- Discard return value
+  --
+  void           -- IO a -> IO ()
+) where
+
+import Foreign.Ptr
+import Prelude.IO
+import Prelude.IOError
+
+
+-- exported functions
+-- ------------------
+
+-- |Execute an 'IO' action, throwing a 'userError' if the predicate yields
+-- 'True' when applied to the result returned by the 'IO' action.
+-- If no exception is raised, return the result of the computation.
+--
+throwIf :: (a -> Bool)	-- ^ error condition on the result of the 'IO' action
+	-> (a -> String) -- ^ computes an error message from erroneous results
+			-- of the 'IO' action
+	-> IO a		-- ^ the 'IO' action to be executed
+	-> IO a
+throwIf pred msgfct act  = do
+    res <- act
+    (if pred res then ioError . userError . msgfct else return) res
+
+-- |Like 'throwIf', but discarding the result
+--
+throwIf_                 :: (a -> Bool) -> (a -> String) -> IO a -> IO ()
+throwIf_ pred msgfct act  = void $ throwIf pred msgfct act
+
+-- |Guards against negative result values
+--
+throwIfNeg :: (Ord a, Num a) => (a -> String) -> IO a -> IO a
+throwIfNeg  = throwIf (< 0)
+
+-- |Like 'throwIfNeg', but discarding the result
+--
+throwIfNeg_ :: (Ord a, Num a) => (a -> String) -> IO a -> IO ()
+throwIfNeg_  = throwIf_ (< 0)
+
+-- |Guards against null pointers
+--
+throwIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
+throwIfNull  = throwIf (== nullPtr) . const
+
+-- |Discard the return value of an 'IO' action
+--
+void     :: IO a -> IO ()
+void act  = act >> return ()
diff --git a/lib/base/src/Foreign/Marshal/Pool.hs b/lib/base/src/Foreign/Marshal/Pool.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/Marshal/Pool.hs
@@ -0,0 +1,190 @@
+{-# OPTIONS_GHC -fno-implicit-prelude #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Marshal.Pool
+-- Copyright   :  (c) Sven Panne 2002-2004
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  sven.panne@aedion.de
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- This module contains support for pooled memory management. Under this scheme,
+-- (re-)allocations belong to a given pool, and everything in a pool is
+-- deallocated when the pool itself is deallocated. This is useful when
+-- 'Foreign.Marshal.Alloc.alloca' with its implicit allocation and deallocation
+-- is not flexible enough, but explicit uses of 'Foreign.Marshal.Alloc.malloc'
+-- and 'free' are too awkward.
+--
+-- modified by John Meacham to use unboxed linked lists directly
+--
+--------------------------------------------------------------------------------
+
+module Foreign.Marshal.Pool(
+   -- * Pool management
+   Pool(),
+   newPool,             -- :: IO Pool
+   freePool,            -- :: Pool -> IO ()
+   withPool,            -- :: (Pool -> IO b) -> IO b
+
+   -- * (Re-)Allocation within a pool
+   pooledMalloc,        -- :: Storable a => Pool                 -> IO (Ptr a)
+   pooledMallocBytes,   -- ::               Pool          -> Int -> IO (Ptr a)
+
+   pooledRealloc,       -- :: Storable a => Pool -> Ptr a        -> IO (Ptr a)
+   pooledReallocBytes,  -- ::               Pool -> Ptr a -> Int -> IO (Ptr a)
+
+   pooledMallocArray,   -- :: Storable a => Pool ->          Int -> IO (Ptr a)
+   pooledMallocArray0,  -- :: Storable a => Pool ->          Int -> IO (Ptr a)
+
+   pooledReallocArray,  -- :: Storable a => Pool -> Ptr a -> Int -> IO (Ptr a)
+   pooledReallocArray0, -- :: Storable a => Pool -> Ptr a -> Int -> IO (Ptr a)
+
+   -- * Combined allocation and marshalling
+   pooledNew,           -- :: Storable a => Pool -> a            -> IO (Ptr a)
+   pooledNewArray,      -- :: Storable a => Pool ->      [a]     -> IO (Ptr a)
+   pooledNewArray0      -- :: Storable a => Pool -> a -> [a]     -> IO (Ptr a)
+) where
+
+import Control.Exception     ( bracket )
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Array ( pokeArray, pokeArray0 )
+import Foreign.Ptr
+import Foreign.Storable
+
+--------------------------------------------------------------------------------
+
+-- To avoid non-H98 stuff like existentially quantified data constructors, we
+-- simply use pointers to () below. Not very nice, but...
+
+-- | A memory pool.
+
+
+
+newtype Pool = Pool (Ptr (Ptr ())) -- (IORef [Ptr ()])
+
+-- | Allocate a fresh memory pool.
+
+newPool :: IO Pool
+newPool = do
+    pool <- malloc
+    poke pool nullPtr
+    return $ Pool pool
+
+-- | Deallocate a memory pool and everything which has been allocated in the
+-- pool itself.
+
+freePool :: Pool -> IO ()
+freePool (Pool pool) = f pool where
+    f p = do
+        v <- peek p
+        free p
+        if v == nullPtr then return () else f (castPtr v :: Ptr (Ptr ()))
+
+-- | Execute an action with a fresh memory pool, which gets automatically
+-- deallocated (including its contents) after the action has finished.
+
+withPool :: (Pool -> IO b) -> IO b
+withPool = bracket newPool freePool
+
+--------------------------------------------------------------------------------
+
+-- | Allocate space for storable type in the given pool. The size of the area
+-- allocated is determined by the 'sizeOf' method from the instance of
+-- 'Storable' for the appropriate type.
+
+pooledMalloc :: Storable a => Pool -> IO (Ptr a)
+pooledMalloc = pm undefined
+  where
+    pm           :: Storable a' => a' -> Pool -> IO (Ptr a')
+    pm dummy pool = pooledMallocBytes pool (sizeOf dummy)
+
+-- | Allocate the given number of bytes of storage in the pool.
+
+pooledMallocBytes :: Pool -> Int -> IO (Ptr a)
+pooledMallocBytes (Pool pool) size = do
+    ptr <- mallocBytes (size + sizeOf pool)
+    v <- peek pool
+    poke ptr (v :: Ptr ())
+    return ((ptr :: Ptr (Ptr ())) `plusPtr` sizeOf pool)
+
+-- | Adjust the storage area for an element in the pool to the given size of
+-- the required type.
+
+pooledRealloc :: Storable a => Pool -> Ptr a -> IO (Ptr a)
+pooledRealloc = pr undefined
+  where
+    pr               :: Storable a' => a' -> Pool -> Ptr a' -> IO (Ptr a')
+    pr dummy pool ptr = pooledReallocBytes pool ptr (sizeOf dummy)
+
+-- | Adjust the storage area for an element in the pool to the given size.
+
+pooledReallocBytes :: Pool -> Ptr a -> Int -> IO (Ptr a)
+pooledReallocBytes = error "pools don't support reallocing the size" --(Pool pool) ptr size = do
+--   let cPtr = castPtr ptr
+--   throwIf (not . (cPtr `elem`)) (\_ -> "pointer not in pool") (readIORef pool)
+--   newPtr <- reallocBytes cPtr size
+--   ptrs <- readIORef pool
+--   writeIORef pool (newPtr : delete cPtr ptrs)
+--   return (castPtr newPtr)
+
+-- | Allocate storage for the given number of elements of a storable type in the
+-- pool.
+
+pooledMallocArray :: Storable a => Pool -> Int -> IO (Ptr a)
+pooledMallocArray = pma undefined
+  where
+    pma                :: Storable a' => a' -> Pool -> Int -> IO (Ptr a')
+    pma dummy pool size = pooledMallocBytes pool (size * sizeOf dummy)
+
+-- | Allocate storage for the given number of elements of a storable type in the
+-- pool, but leave room for an extra element to signal the end of the array.
+
+pooledMallocArray0 :: Storable a => Pool -> Int -> IO (Ptr a)
+pooledMallocArray0 pool size =
+   pooledMallocArray pool (size + 1)
+
+-- | Adjust the size of an array in the given pool.
+
+pooledReallocArray :: Storable a => Pool -> Ptr a -> Int -> IO (Ptr a)
+pooledReallocArray = pra undefined
+  where
+    pra                ::  Storable a' => a' -> Pool -> Ptr a' -> Int -> IO (Ptr a')
+    pra dummy pool ptr size  = pooledReallocBytes pool ptr (size * sizeOf dummy)
+
+-- | Adjust the size of an array with an end marker in the given pool.
+
+pooledReallocArray0 :: Storable a => Pool -> Ptr a -> Int -> IO (Ptr a)
+pooledReallocArray0 pool ptr size =
+   pooledReallocArray pool ptr (size + 1)
+
+--------------------------------------------------------------------------------
+
+-- | Allocate storage for a value in the given pool and marshal the value into
+-- this storage.
+
+pooledNew :: Storable a => Pool -> a -> IO (Ptr a)
+pooledNew pool val = do
+   ptr <- pooledMalloc pool
+   poke ptr val
+   return ptr
+
+-- | Allocate consecutive storage for a list of values in the given pool and
+-- marshal these values into it.
+
+pooledNewArray :: Storable a => Pool -> [a] -> IO (Ptr a)
+pooledNewArray pool vals = do
+   ptr <- pooledMallocArray pool (length vals)
+   pokeArray ptr vals
+   return ptr
+
+-- | Allocate consecutive storage for a list of values in the given pool and
+-- marshal these values into it, terminating the end with the given marker.
+
+pooledNewArray0 :: Storable a => Pool -> a -> [a] -> IO (Ptr a)
+pooledNewArray0 pool marker vals = do
+   ptr <- pooledMallocArray0 pool (length vals)
+   pokeArray0 marker ptr vals
+   return ptr
+
+
diff --git a/lib/base/src/Foreign/Marshal/Utils.hs b/lib/base/src/Foreign/Marshal/Utils.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/Marshal/Utils.hs
@@ -0,0 +1,175 @@
+{-# OPTIONS_LHC -N -fffi #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Marshal.Utils
+-- Copyright   :  (c) The FFI task force 2001
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Utilities for primitive marshaling
+--
+-----------------------------------------------------------------------------
+
+module Foreign.Marshal.Utils (
+  -- * General marshalling utilities
+
+  -- ** Combined allocation and marshalling
+  --
+  with,          -- :: Storable a => a -> (Ptr a -> IO b) -> IO b
+  new,           -- :: Storable a => a -> IO (Ptr a)
+
+  -- ** Marshalling of Boolean values (non-zero corresponds to 'True')
+  --
+  fromBool,      -- :: Num a => Bool -> a
+  toBool,	 -- :: Num a => a -> Bool
+
+  -- ** Marshalling of Maybe values
+  --
+  maybeNew,      -- :: (      a -> IO (Ptr a))
+		 -- -> (Maybe a -> IO (Ptr a))
+  maybeWith,     -- :: (      a -> (Ptr b -> IO c) -> IO c)
+		 -- -> (Maybe a -> (Ptr b -> IO c) -> IO c)
+  maybePeek,     -- :: (Ptr a -> IO        b )
+		 -- -> (Ptr a -> IO (Maybe b))
+
+  -- ** Marshalling lists of storable objects
+  --
+  withMany,      -- :: (a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
+
+  -- ** Haskellish interface to memcpy and memmove
+  -- | (argument order: destination, source)
+  --
+  copyBytes,     -- :: Ptr a -> Ptr a -> Int -> IO ()
+  moveBytes     -- :: Ptr a -> Ptr a -> Int -> IO ()
+
+) where
+
+import Foreign.Ptr	        ( Ptr, nullPtr )
+import Foreign.Storable		( Storable(poke) )
+import Foreign.C.Types    	( CSize )
+import Foreign.Marshal.Alloc 	( malloc, alloca )
+import Lhc.Basics
+import Lhc.IO
+import Lhc.List
+import Lhc.Monad
+import Lhc.Num
+import Lhc.Order
+import Lhc.Maybe
+
+
+-- combined allocation and marshalling
+-- -----------------------------------
+
+-- |Allocate a block of memory and marshal a value into it
+-- (the combination of 'malloc' and 'poke').
+-- The size of the area allocated is determined by the 'Foreign.Storable.sizeOf'
+-- method from the instance of 'Storable' for the appropriate type.
+--
+-- The memory may be deallocated using 'Foreign.Marshal.Alloc.free' or
+-- 'Foreign.Marshal.Alloc.finalizerFree' when no longer required.
+--
+new     :: Storable a => a -> IO (Ptr a)
+new val  =
+  do
+    ptr <- malloc
+    poke ptr val
+    return ptr
+
+-- |@'with' val f@ executes the computation @f@, passing as argument
+-- a pointer to a temporarily allocated block of memory into which
+-- 'val' has been marshalled (the combination of 'alloca' and 'poke').
+--
+-- The memory is freed when @f@ terminates (either normally or via an
+-- exception), so the pointer passed to @f@ must /not/ be used after this.
+--
+with       :: Storable a => a -> (Ptr a -> IO b) -> IO b
+with val f  =
+  alloca $ \ptr -> do
+    poke ptr val
+    res <- f ptr
+    return res
+
+
+
+-- marshalling of Boolean values (non-zero corresponds to 'True')
+-- -----------------------------
+
+-- |Convert a Haskell 'Bool' to its numeric representation
+--
+fromBool       :: Num a => Bool -> a
+fromBool False  = 0
+fromBool True   = 1
+
+-- |Convert a Boolean in numeric representation to a Haskell value
+--
+toBool :: Num a => a -> Bool
+toBool  = (/= 0)
+
+
+-- marshalling of Maybe values
+-- ---------------------------
+
+-- |Allocate storage and marshall a storable value wrapped into a 'Maybe'
+--
+-- * the 'nullPtr' is used to represent 'Nothing'
+--
+maybeNew :: (      a -> IO (Ptr a))
+	 -> (Maybe a -> IO (Ptr a))
+maybeNew  = maybe (return nullPtr)
+
+-- |Converts a @withXXX@ combinator into one marshalling a value wrapped
+-- into a 'Maybe', using 'nullPtr' to represent 'Nothing'.
+--
+maybeWith :: (      a -> (Ptr b -> IO c) -> IO c)
+	  -> (Maybe a -> (Ptr b -> IO c) -> IO c)
+maybeWith  = maybe ($ nullPtr)
+
+-- |Convert a peek combinator into a one returning 'Nothing' if applied to a
+-- 'nullPtr'
+--
+maybePeek                           :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
+maybePeek peek ptr | ptr == nullPtr  = return Nothing
+		   | otherwise       = do a <- peek ptr; return (Just a)
+
+
+-- marshalling lists of storable objects
+-- -------------------------------------
+
+-- |Replicates a @withXXX@ combinator over a list of objects, yielding a list of
+-- marshalled objects
+--
+withMany :: (a -> (b -> res) -> res)  -- withXXX combinator for one object
+	 -> [a]			      -- storable objects
+	 -> ([b] -> res)	      -- action on list of marshalled obj.s
+	 -> res
+withMany _       []     f = f []
+withMany withFoo (x:xs) f = withFoo x $ \x' ->
+			      withMany withFoo xs (\xs' -> f (x':xs'))
+
+
+-- Haskellish interface to memcpy and memmove
+-- ------------------------------------------
+
+-- |Copies the given number of bytes from the second area (source) into the
+-- first (destination); the copied areas may /not/ overlap
+--
+copyBytes               :: Ptr a -> Ptr a -> Int -> IO ()
+copyBytes dest src size  = memcpy dest src (fromIntegral size)
+
+-- |Copies the given number of elements from the second area (source) into the
+-- first (destination); the copied areas /may/ overlap
+--
+moveBytes               :: Ptr a -> Ptr a -> Int -> IO ()
+moveBytes dest src size  = memmove dest src (fromIntegral size)
+
+
+-- auxilliary routines
+-- -------------------
+
+-- |Basic C routines needed for memory copying
+--
+foreign import ccall  "string.h memcpy" memcpy  :: Ptr a -> Ptr a -> CSize -> IO ()
+foreign import ccall  "string.h memmove" memmove :: Ptr a -> Ptr a -> CSize -> IO ()
diff --git a/lib/base/src/Foreign/Ptr.hs b/lib/base/src/Foreign/Ptr.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/Ptr.hs
@@ -0,0 +1,65 @@
+{-# OPTIONS_LHC -N -fffi -funboxed-tuples #-}
+
+module Foreign.Ptr(
+    Ptr(),
+    nullPtr,
+    castPtr,
+    plusPtr,
+    alignPtr,
+    minusPtr,
+    FunPtr(),
+    nullFunPtr,
+    castFunPtr,
+    castFunPtrToPtr,
+    castPtrToFunPtr,
+    freeHaskellFunPtr
+    ) where
+
+
+import Lhc.Show
+import Lhc.Inst.Show
+import Lhc.Monad
+import Lhc.Order
+import Lhc.IO
+import Lhc.Basics
+import Lhc.Num
+import Lhc.Addr
+import Foreign.Storable
+
+
+instance Show (Ptr a) where
+    showsPrec n (Ptr x) = showsPrec n (toInteger (addrToWordPtr  x))
+
+nullPtr :: Ptr a
+nullPtr = Ptr nullAddr
+
+plusPtr :: Ptr a -> Int -> Ptr b
+plusPtr (Ptr addr) off = Ptr (plusAddr addr off)
+
+minusPtr :: Ptr a -> Int -> Ptr b
+minusPtr (Ptr addr) off = Ptr (plusAddr addr (negate off))
+
+
+alignPtr :: Ptr a -> Int -> Ptr a
+alignPtr = error "alignPtr"
+--alignPtr addr@(Ptr a) (I# i)
+--  = case remAddr# a i of {
+--      0# -> addr;
+--      n -> Ptr (plusAddr# a (i -# n)) }
+
+
+
+nullFunPtr = FunPtr nullFunAddr
+castFunPtr (FunPtr addr) = FunPtr addr
+
+--castFunPtrToPtr :: FunPtr a -> Ptr b
+--castFunPtrToPtr = unsafeCoerce
+
+--castPtrToFunPtr :: Ptr a -> FunPtr b
+--castPtrToFunPtr = unsafeCoerce
+
+
+foreign import primitive "U2U" castFunPtrToPtr :: FunPtr a -> Ptr b
+foreign import primitive "U2U" castPtrToFunPtr :: Ptr a -> FunPtr b
+
+
diff --git a/lib/base/src/Foreign/StablePtr.hs b/lib/base/src/Foreign/StablePtr.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/StablePtr.hs
@@ -0,0 +1,49 @@
+{-# OPTIONS_LHC -N -fffi #-}
+module Foreign.StablePtr(
+    StablePtr(),
+    castStablePtrToPtr,
+    castPtrToStablePtr,
+    newStablePtr,
+    deRefStablePtr,
+    freeStablePtr
+    ) where
+
+import Lhc.Addr
+import Lhc.Basics
+import Lhc.IO
+import Lhc.Monad
+
+newtype StablePtr a = StablePtr (Ptr ())
+data PlaceHolder
+
+castPtrToStablePtr :: Ptr () -> StablePtr a
+castPtrToStablePtr p = StablePtr p
+
+castStablePtrToPtr :: StablePtr a -> Ptr ()
+castStablePtrToPtr (StablePtr p) = p
+
+
+freeStablePtr :: StablePtr a -> IO ()
+freeStablePtr _ = return ()
+
+newStablePtr :: a -> IO (StablePtr a)
+newStablePtr x = do
+    ptr <- ref_ptr (unsafeCoerce x)
+    return (StablePtr ptr)
+
+deRefStablePtr :: StablePtr a -> IO a
+deRefStablePtr (StablePtr x) = do
+    v <- deref_ptr x
+    return (unsafeCoerce v)
+
+deref_ptr = undefined
+ref_ptr = undefined
+unsafeCoerce = undefined
+
+{-
+
+foreign import primitive deref_ptr :: Ptr () -> IO PlaceHolder
+foreign import primitive ref_ptr   :: PlaceHolder -> IO (Ptr ())
+
+foreign import primitive unsafeCoerce :: a -> b
+-}
diff --git a/lib/base/src/Foreign/Storable.hs b/lib/base/src/Foreign/Storable.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/Storable.hs
@@ -0,0 +1,31 @@
+{-# OPTIONS_LHC -N #-}
+module Foreign.Storable(Storable(..)) where
+
+import Lhc.Basics
+import Lhc.Addr
+import Lhc.Int
+import Lhc.IO
+
+plusPtr :: Ptr a -> Int -> Ptr b
+plusPtr (Ptr addr) off = Ptr (plusAddr addr off)
+
+class Storable a where
+    sizeOf :: a -> Int
+    alignment :: a -> Int
+    peekElemOff :: Ptr a -> Int -> IO a
+    pokeElemOff :: Ptr a -> Int -> a -> IO ()
+    peekByteOff :: Ptr b -> Int -> IO a
+    pokeByteOff :: Ptr b -> Int -> a -> IO ()
+    peek :: Ptr a -> IO a
+    poke :: Ptr a -> a -> IO ()
+
+    alignment x = sizeOf x
+    peekElemOff addr idx = IO $ \w -> unIO (peek $! (addr `plusPtr` (idx `times` sizeOf (_f addr)))) w
+    pokeElemOff addr idx x = IO $ \w -> unIO (let adr = (addr `plusPtr` (idx `times` sizeOf x)) in adr `seq` poke adr x) w
+    peekByteOff addr off = IO $ \w -> unIO (peek $! (addr `plusPtr` off)) w
+    pokeByteOff addr off x = IO $ \w -> unIO (let adr = (addr `plusPtr` off) in adr `seq` poke adr x) w
+
+_f :: Ptr a -> a
+_f _ = undefined
+
+
diff --git a/lib/base/src/Foreign/Storable.m4 b/lib/base/src/Foreign/Storable.m4
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Foreign/Storable.m4
@@ -0,0 +1,21 @@
+
+
+m4_define(INST_STORABLE,{{
+
+instance Storable $1 where
+    peek (Ptr (Addr addr)) = IO $ \w -> case peek$2 addr w of
+        (# w', r #) -> (# w', $1 r #)
+    poke (Ptr (Addr addr)) ($1 v) = IO $ \w -> case poke$2 addr v w of
+        w' -> (# w', () #)
+    sizeOf _ = boxInt (sizeOf$2 0#)
+    alignment _ = boxInt (alignmentOf$2 0#)
+
+ONCE({{
+foreign import primitive "peek.$3" peek$2 :: Addr__ -> UIO $2
+foreign import primitive "poke.$3" poke$2 :: Addr__ -> $2 -> UIO_
+foreign import primitive "sizeOf.$3" sizeOf$2 :: $2 -> Int__
+foreign import primitive "alignmentOf.$3" alignmentOf$2 :: $2 -> Int__
+}})
+
+}})
+
diff --git a/lib/base/src/Lhc/ACIO.hs b/lib/base/src/Lhc/ACIO.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/ACIO.hs
@@ -0,0 +1,86 @@
+{-# OPTIONS_LHC -N  #-}
+module Lhc.ACIO where
+
+import Lhc.IORef
+import Lhc.IO
+import Lhc.Monad
+
+
+newtype ACIO a = ACIO (IO a)
+    deriving(Monad,Functor)
+
+unsafeIOToACIO :: IO a -> ACIO a
+unsafeIOToACIO x = ACIO x
+
+acioToIO :: ACIO a -> IO a
+acioToIO (ACIO x) = x
+
+newIORefAC :: a -> ACIO (IORef a)
+newIORefAC a = unsafeIOToACIO (newIORef a)
+
+
+runOnce :: IO a -> ACIO (IO a)
+runOnce action = do
+    ref <- newIORefAC Nothing
+    return $ do
+        v <- readIORef ref
+        case v of
+            Just v -> return v
+            Nothing -> do
+                v <- action
+                writeIORef ref v
+                return v
+
+{-@Extensions
+
+# Top Level Actions
+
+Lhc supports monadic actions declared at the top level of your module. These
+can be used to do things such as initialize IORefs or allocate static data. An example
+of a top level action is the following.
+
+    import Lhc.ACIO
+    import Data.IORef
+
+    ref <- newIORefAC 0
+
+    count = do
+        modifyIORef ref (1 +)
+        readIORef ref >>= print
+
+    main = do
+        count
+        count
+        count
+
+Which will print 1, 2, and 3. A special monad ACIO (which stands for Affine
+Central IO) is provided to restrict what may take place in top level actions.
+Basically, top level actions can only consist of IO that can be omitted or
+reordered without changing the meaning of a program. In practice, this means
+that it does not matter whether such actions are all performed at the beginning
+or are only computed once on demand.
+
+If you need to use arbitrary IO, a utility function 'runOnce' is provided.
+using it you can ensure arbitrary IO actions are run only once and the return
+values shared, however you must access the value inside the IO monad, thus
+ensuring program integrity. An example using a hypothetical GUI library is below.
+
+
+    import Lhc.ACIO
+
+    getWindow <- runOnce $ do
+        connection <- newGUIConnection
+        window <- createWindow (640,480)
+        setTitle window "My Global Window"
+        return window
+
+    main = do
+        w <- getWindow
+        draw w "Hello!"
+
+Note, top level global variables can be indicative of design issues. In
+general, they should only be used when necessary to interface with an external
+library, opaque uses inside a library where the shared state can not be
+externally observed, or inside your Main program as design dictates.
+
+-}
diff --git a/lib/base/src/Lhc/Addr.hs b/lib/base/src/Lhc/Addr.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Addr.hs
@@ -0,0 +1,83 @@
+{-# OPTIONS_LHC -N -fffi -funboxed-values -fm4 #-}
+
+m4_include(Lhc/Order.m4)
+m4_include(Foreign/Storable.m4)
+
+module Lhc.Addr(
+    Addr(..),
+    FunAddr(..),
+    Ptr(..),
+    FunPtr(..),
+    ptrFromAddr__,
+    nullAddr,
+    castPtr,
+    nullFunAddr,
+    plusAddr,
+    addrToWordPtr,
+    wordPtrToAddr,
+    wordPtrToFunAddr,
+    funAddrToWordPtr
+    ) where
+
+import Lhc.Int
+import Data.Word
+import Lhc.Prim
+import Lhc.Types
+import Lhc.Order
+import Lhc.Basics
+import Lhc.IO
+import Foreign.Storable
+
+data Addr = Addr BitsPtr_
+data FunAddr = FunAddr BitsPtr_
+
+newtype Ptr a = Ptr Addr
+newtype FunPtr a = FunPtr FunAddr
+
+nullAddr = Addr 0#
+nullFunAddr = FunAddr 0#
+
+INST_EQORDER(Addr,BitsPtr_)
+INST_EQORDER(FunAddr,BitsPtr_)
+
+INST_STORABLE(Addr,BitsPtr_,bits<ptr>)
+INST_STORABLE(FunAddr,BitsPtr_,bits<ptr>)
+
+{-# INLINE plusAddr #-}
+plusAddr :: Addr -> Int -> Addr
+plusAddr (Addr addr) off = case unboxInt off of
+    off_ -> Addr (addr `plusWordPtr` intToPtr__ off_)
+
+foreign import primitive "U2U" addrToWordPtr :: Addr -> WordPtr
+foreign import primitive "U2U" wordPtrToAddr :: WordPtr -> Addr
+foreign import primitive "U2U" wordPtrToFunAddr :: WordPtr -> FunAddr
+foreign import primitive "U2U" funAddrToWordPtr :: FunAddr -> WordPtr
+
+foreign import primitive "Sx" intToPtr__ :: Int__ -> BitsPtr_
+
+foreign import primitive "Add" plusWordPtr :: BitsPtr_ -> BitsPtr_ -> BitsPtr_
+
+ptrFromAddr__ :: Addr__ -> Ptr a
+ptrFromAddr__ addr = Ptr (Addr addr)
+
+instance Storable (Ptr a) where
+    sizeOf (Ptr a) = sizeOf a
+    alignment (Ptr a) = alignment a
+    peek p = peek (castPtr p) `thenIO` (returnIO . Ptr)
+    poke p (Ptr x) = poke (castPtr p) x
+
+instance Eq (Ptr a) where
+    Ptr a == Ptr b = a == b
+    Ptr a /= Ptr b = a /= b
+
+instance Ord (Ptr a) where
+    compare (Ptr a) (Ptr b) = compare a b
+    Ptr a <= Ptr b = a <= b
+    Ptr a < Ptr b = a < b
+    Ptr a > Ptr b = a > b
+    Ptr a >= Ptr b = a >= b
+
+castPtr :: Ptr a -> Ptr b
+castPtr (Ptr addr) = Ptr addr
+
+
diff --git a/lib/base/src/Lhc/Array.hs b/lib/base/src/Lhc/Array.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Array.hs
@@ -0,0 +1,36 @@
+{-# OPTIONS_LHC -N -funboxed-tuples -fffi #-}
+module Lhc.Array where
+
+import Lhc.Basics
+import Lhc.IO
+import Lhc.Int
+
+
+
+data MutArray__ :: * -> #
+data Array__ :: * -> #
+
+foreign import primitive newMutArray__      :: Int__ -> a -> UIO (MutArray__ a)
+foreign import primitive newBlankMutArray__ :: Int__ -> UIO (MutArray__ a)
+foreign import primitive copyArray__        :: Int__ -> Int__ -> Int__ -> Array__ a -> MutArray__ a -> UIO_
+foreign import primitive copyMutArray__     :: Int__ -> Int__ -> Int__ -> MutArray__ a -> MutArray__ a -> UIO_
+foreign import primitive readArray__        :: MutArray__ a -> Int__ -> UIO a
+foreign import primitive writeArray__       :: MutArray__ a -> Int__ -> a -> UIO_
+foreign import primitive indexArray__       :: Array__ a -> Int__ -> (# a #)
+
+-- these basically cast from a mutable to an immutable array and back again
+foreign import primitive unsafeFreezeArray__ :: MutArray__ a -> UIO (Array__ a)
+foreign import primitive unsafeThawArray__ :: Array__ a -> UIO (MutArray__ a)
+
+foreign import primitive newWorld__ :: a -> World__
+
+newArray :: a -> Int -> [(Int,a)] -> Array__ a
+newArray init n xs = case unboxInt n of
+    n' -> case newWorld__ (init,n,xs) of
+     w -> case newMutArray__ n' init w of
+      (# w, arr #) -> let
+        f :: MutArray__ a -> World__ -> [(Int,a)] -> World__
+        f arr w [] = w
+        f arr w ((i,v):xs) = case unboxInt i of i' -> case writeArray__ arr i' v w of w -> f arr w xs
+            in case f arr w xs of w -> case unsafeFreezeArray__ arr w  of (# _, r #) -> r
+
diff --git a/lib/base/src/Lhc/Basics.hs b/lib/base/src/Lhc/Basics.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Basics.hs
@@ -0,0 +1,180 @@
+{-# OPTIONS_LHC -N -fffi #-}
+module Lhc.Basics(module Lhc.Basics, module Lhc.Prim) where
+
+import Lhc.Prim
+import Lhc.Int
+
+data (->) :: ?? -> ? -> *
+data Integer
+
+type String = [Char]
+
+data () = ()
+data (,) a b = (,) a b
+data (,,) a b c = (,,) a b c
+data (,,,) a b c d = (,,,) a b c d
+data (,,,,) a b c d e = (,,,,) a b c d e
+data (,,,,,) a b c d e f = (,,,,,) a b c d e f
+data (,,,,,,) a b c d e f g = (,,,,,,) a b c d e f g
+data (,,,,,,,) a b c d e f g h = (,,,,,,,) a b c d e f g h
+data (,,,,,,,,) a b c d e f g h i = (,,,,,,,,) a b c d e f g h i
+
+
+
+------------------------
+-- the basic combinators
+------------------------
+
+{-# SUPERINLINE id, const, (.), ($), ($!), flip #-}
+
+infixr 9  .
+infixr 0  $, $!, `seq`
+
+id x = x
+const x _ = x
+f . g = \x -> f (g x)
+f $ x = f x
+f $! x = x `seq` f x
+flip f x y = f y x
+
+-- asTypeOf is a type-restricted version of const.  It is usually used
+-- as an infix operator, and its typing forces its first argument
+-- (which is usually overloaded) to have the same type as the second.
+
+{-# SUPERINLINE asTypeOf #-}
+asTypeOf         :: a -> a -> a
+asTypeOf         =  const
+
+
+{-# INLINE seq #-}
+foreign import primitive seq :: a -> b -> b
+
+
+--------------------
+-- some tuple things
+--------------------
+
+{-# INLINE fst, snd #-}
+fst (a,b) = a
+snd (a,b) = b
+
+uncurry f (x,y) = f x y
+curry f x y = f (x,y)
+
+
+
+----------------------
+-- Basic list routines
+----------------------
+
+
+-- iterate f x returns an infinite list of repeated applications of f to x:
+-- iterate f x == [x, f x, f (f x), ...]
+
+iterate          :: (a -> a) -> a -> [a]
+iterate f x      =  x : iterate f (f x)
+
+-- repeat x is an infinite list, with x the value of every element.
+
+repeat           :: a -> [a]
+repeat x         =  xs where xs = x:xs
+
+
+
+-- Map and append
+
+map :: (a -> b) -> [a] -> [b]
+map f xs = go xs where
+    go [] = []
+    go (x:xs) = f x : go xs
+
+
+
+infixr 5  ++
+
+(++) :: [a] -> [a] -> [a]
+[]     ++ ys = ys
+(x:xs) ++ ys = x : (xs ++ ys)
+
+
+foldl            :: (a -> b -> a) -> a -> [b] -> a
+foldl f z []     =  z
+foldl f z (x:xs) =  foldl f (f z x) xs
+
+
+scanl            :: (a -> b -> a) -> a -> [b] -> [a]
+scanl f q xs     =  q : (case xs of
+                            []   -> []
+                            x:xs -> scanl f (f q x) xs)
+
+
+
+reverse          :: [a] -> [a]
+--reverse          =  foldl (flip (:)) []
+reverse l =  rev l [] where
+    rev []     a = a
+    rev (x:xs) a = rev xs (x:a)
+
+
+-- zip takes two lists and returns a list of corresponding pairs.  If one
+-- input list is short, excess elements of the longer list are discarded.
+-- zip3 takes three lists and returns a list of triples.  Zips for larger
+-- tuples are in the List library
+
+
+zip :: [a] -> [b] -> [(a,b)]
+zip (a:as) (b:bs) = (a,b) : zip as bs
+zip _      _      = []
+
+-- The zipWith family generalises the zip family by zipping with the
+-- function given as the first argument, instead of a tupling function.
+-- For example, zipWith (+) is applied to two lists to produce the list
+-- of corresponding sums.
+
+zipWith          :: (a->b->c) -> [a]->[b]->[c]
+zipWith z (a:as) (b:bs) =  z a b : zipWith z as bs
+zipWith _ _ _    =  []
+
+
+concat :: [[a]] -> [a]
+concat [] = []
+concat (x:xs) = case x of
+    [] -> concat xs
+    (y:ys) -> y:concat (ys:xs)
+
+
+concatMap :: (a -> [b]) -> [a] -> [b]
+concatMap f xs = g xs where
+    g [] = []
+    g (x:xs) = f x ++ g xs
+
+
+foldr :: (a -> b -> b) -> b -> [a] -> b
+foldr k z [] = z
+foldr k z (x:xs) = k x (foldr k z xs)
+
+foreign import primitive "error.Prelude.undefined" undefined :: a
+
+ord :: Char -> Int
+ord (Char c) = boxInt c
+
+chr :: Int -> Char
+chr i = Char (unboxInt i)
+
+unsafeChr :: Int -> Char
+unsafeChr = chr
+
+{-
+foreign import primitive "ULte" bits32ULte  :: Bits32_ -> Bits32_ -> Bool__
+foreign import primitive "error.Prelude.chr: value out of range" chr_error :: a
+
+chr :: Int -> Char
+chr i = case unboxInt i of
+    i' -> case i' `bits32ULTE` 0x10FFFF# of
+        1# -> Char i'
+        0# -> chr_error
+
+unsafeChr :: Int -> Char
+unsafeChr i = Char (unboxInt i)
+-}
+
diff --git a/lib/base/src/Lhc/Enum.hs b/lib/base/src/Lhc/Enum.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Enum.hs
@@ -0,0 +1,95 @@
+{-# OPTIONS_LHC -N -fffi -funboxed-values #-}
+module Lhc.Enum(Enum(..),Bounded(..)) where
+-- Enumeration and Bounded classes
+
+import Lhc.Inst.PrimEnum()
+import Data.Int
+import Lhc.Types
+import Lhc.Basics
+import Lhc.Order
+import Lhc.Int
+
+class  Enum a  where
+    succ, pred       :: a -> a
+    toEnum           :: Int -> a
+    fromEnum         :: a -> Int
+    enumFrom         :: a -> [a]             -- [n..]
+    enumFromThen     :: a -> a -> [a]        -- [n,n'..]
+    enumFromTo       :: a -> a -> [a]        -- [n..m]
+    enumFromThenTo   :: a -> a -> a -> [a]   -- [n,n'..m]
+
+        -- Minimal complete definition:
+        --      toEnum, fromEnum
+--
+-- NOTE: these default methods only make sense for types
+--   that map injectively into Int using fromEnum
+--  and toEnum.
+    succ             =  toEnum . increment . fromEnum
+    pred             =  toEnum . decrement . fromEnum
+    enumFrom x       =  map toEnum [fromEnum x ..]
+    enumFromTo x y   =  map toEnum [fromEnum x .. fromEnum y]
+    enumFromThen x y =  map toEnum [fromEnum x, fromEnum y ..]
+    enumFromThenTo x y z =
+                        map toEnum [fromEnum x, fromEnum y .. fromEnum z]
+
+
+class Bounded a  where
+    minBound         :: a
+    maxBound         :: a
+
+instance Enum Int where
+    succ = increment
+    pred = decrement
+    toEnum x = x
+    fromEnum x = x
+
+    enumFrom x  | x `seq` True  =  enumFromTo x maxBound
+    enumFromThen c c' = [c, c' .. lastInt]
+                      where lastInt | c' < c    = minBound
+                                    | otherwise = maxBound
+    enumFromTo x y = f x where
+        f x | x > y = []
+            | otherwise = x:f (increment x)
+    enumFromThenTo x y z | y >= x = f x where
+        inc = y `minus` x
+        f x | x <= z = x:f (x `plus` inc)
+            | otherwise = []
+    enumFromThenTo x y z  = f x where
+        inc = y `minus` x
+        f x | x >= z = x:f (x `plus` inc)
+            | otherwise = []
+
+
+instance Enum Char where
+    toEnum = chr
+    fromEnum = ord
+    enumFrom c        = [c .. maxBound::Char]
+    enumFromThen c c' = [c, c' .. lastChar]
+                      where lastChar :: Char
+                            lastChar | c' < c    = minBound
+                                     | otherwise = maxBound
+--    enumFromTo (Char x) (Char y) = f x where
+--        f x = case x `bits32UGt` y of
+--            0# -> []
+--            1# -> Char x:f (bits32Increment x)
+--    enumFromThenTo (Char x) (Char y) (Char z) =
+--        case y `bits32Sub` x of
+--            inc -> let f x = case x `bits32UGte` z of
+--                            1# -> Char x:f (x `bits32Add` inc)
+--                            0# -> []
+--             in f x
+
+
+instance Bounded Char where
+    minBound = Char 0#
+    maxBound = Char 0x10ffff#
+
+foreign import primitive "UGt"       bits32UGt       :: Bits32_ -> Bits32_ -> Bool__
+foreign import primitive "UGte"      bits32UGte      :: Bits32_ -> Bits32_ -> Bool__
+foreign import primitive "increment" bits32Increment :: Bits32_ -> Bits32_
+
+foreign import primitive "Add"       bits32Add       :: Bits32_ -> Bits32_ -> Bits32_
+foreign import primitive "Sub"       bits32Sub       :: Bits32_ -> Bits32_ -> Bits32_
+
+
+
diff --git a/lib/base/src/Lhc/Float.hs b/lib/base/src/Lhc/Float.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Float.hs
@@ -0,0 +1,228 @@
+{-# OPTIONS_LHC -N -fffi -fm4 #-}
+
+module Lhc.Float(
+    Float(..),
+    Double(..),
+    floatToDouble,
+    doubleToFloat,
+    Floating(..),
+    RealFrac(..),
+    RealFloat(..),
+    rationalToDouble
+    )
+    where
+
+import Lhc.Basics
+import Lhc.Int
+import Lhc.IO(error)
+import Lhc.Num
+import Lhc.Order
+import Lhc.Types
+import Lhc.Enum
+
+infixr 8  **
+
+data Float = Float Float32_
+data Double = Double Float64_
+
+
+foreign import primitive "F2F" floatToDouble :: Float -> Double
+foreign import primitive "F2F" doubleToFloat :: Double -> Float
+
+ -- floating point stuff
+
+class  (Fractional a) => Floating a  where
+    pi                  :: a
+    exp, log, sqrt      :: a -> a
+    (**), logBase       :: a -> a -> a
+    sin, cos, tan       :: a -> a
+    asin, acos, atan    :: a -> a
+    sinh, cosh, tanh    :: a -> a
+    asinh, acosh, atanh :: a -> a
+
+        -- Minimal complete definition:
+        --      pi, exp, log, sin, cos, sinh, cosh
+        --      asin, acos, atan
+        --      asinh, acosh, atanh
+    x ** y           =  exp (log x * y)
+    logBase x y      =  log y / log x
+    sqrt x           =  x ** (1 / 2) -- 0.5        -- TODO Doubles
+    tan  x           =  sin  x / cos  x
+    tanh x           =  sinh x / cosh x
+
+
+
+-- TODO Doubles
+class  (Real a, Fractional a) => RealFrac a  where
+    properFraction   :: (Integral b) => a -> (b,a)
+    truncate, round  :: (Integral b) => a -> b
+    ceiling, floor   :: (Integral b) => a -> b
+
+
+
+        -- Minimal complete definition:
+        --      properFraction
+    truncate x       =  m  where (m,_) = properFraction x
+
+    round x          =  let (n,r) = properFraction x
+                            m     = if r < 0 then n - 1 else n + 1
+                          in case signum (abs r - (1 / 2)) of
+                                -1 -> n
+                                0  -> if n `rem` 2 == 0 then n else m
+                                1  -> m
+
+    ceiling x        =  if r > 0 then n + 1 else n
+                        where (n,r) = properFraction x
+
+    floor x          =  if r < 0 then n - 1 else n
+                        where (n,r) = properFraction x
+
+        -- Minimal complete definition:
+        --      properFraction
+
+    properFractionf   :: a -> (a,a)
+    truncatef, roundf :: a -> a
+    ceilingf, floorf  :: a -> a
+
+    truncatef x       =  m  where (m,_) = properFractionf x
+    roundf x          =  fromInteger (round x)
+    ceilingf x        =  if r > 0 then n + 1 else n
+                        where (n,r) = properFractionf x
+    floorf x          =  if r < 0 then n - 1 else n
+                        where (n,r) = properFractionf x
+
+
+-- TODO Doubles
+class  (RealFrac a, Floating a) => RealFloat a  where
+    floatRadix       :: a -> Integer
+    floatDigits      :: a -> Int
+    floatRange       :: a -> (Int,Int)
+    decodeFloat      :: a -> (Integer,Int)
+    encodeFloat      :: Integer -> Int -> a
+    exponent         :: a -> Int
+    significand      :: a -> a
+    scaleFloat       :: Int -> a -> a
+    isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE
+                     :: a -> Bool
+    atan2            :: a -> a -> a
+
+        -- Minimal complete definition:
+        --      All except exponent, significand,
+        --                 scaleFloat, atan2
+    exponent x       =  if m == 0 then 0 else n + floatDigits x
+                        where (m,n) = decodeFloat x
+
+    significand x    =  encodeFloat m (- floatDigits x)
+                        where (m,_) = decodeFloat x
+
+    scaleFloat k x   =  encodeFloat m (n+k)
+                        where (m,n) = decodeFloat x
+
+    atan2 y x
+      | x>0           =  atan (y/x)
+      | x==0 && y>0   =  pi/2
+      | x<0  && y>0   =  pi + atan (y/x)
+      |(x<=0 && y<0)  ||
+       (x<0 && isNegativeZero y) ||
+       (isNegativeZero x && isNegativeZero y)
+                      = -atan2 (-y) x
+      | y==0 && (x<0 || isNegativeZero x)
+                      =  pi    -- must be after the previous test on zero y
+      | x==0 && y==0  =  y     -- must be after the other double zero tests
+      | otherwise     =  x + y -- x or y is a NaN, return a NaN (via +)
+
+    decodeFloatf     :: a -> (a,Int)
+    decodeFloatf x    = case decodeFloat x of
+        (v,exp) -> (fromInteger v,exp)
+
+    encodeFloatf     :: a -> Int -> a
+    encodeFloatf a i = scaleFloat i a
+
+
+
+rationalToDouble :: Rational -> Double
+rationalToDouble (x:%y) = fromInteger x `divideDouble` fromInteger y
+
+foreign import primitive "FDiv" divideDouble ::  Double -> Double -> Double
+foreign import primitive "box" boxBool :: Bool__ -> Bool
+
+
+m4_define(NUMINSTANCE,
+instance Num $1 where
+    $1 x * $1 y = $1 (times$1 x y)
+    $1 x + $1 y = $1 (plus$1 x y)
+    $1 x - $1 y = $1 (minus$1 x y)
+    abs ($1 x) = $1 (abs$1 x)
+    negate ($1 x) = $1 (neg$1 x)
+    fromInt x = fromInt$1 x
+    fromInteger x = fromInteger$1 x
+    signum x = case compare x 0 of
+        EQ -> 0
+        GT -> 1
+        LT -> -1
+
+foreign import primitive "FMul" times$1 :: $2 -> $2 -> $2
+foreign import primitive "FAdd" plus$1  :: $2 -> $2 -> $2
+foreign import primitive "FSub" minus$1 :: $2 -> $2 -> $2
+
+foreign import primitive "FAbs" abs$1 :: $2 -> $2
+foreign import primitive "FNeg" neg$1 :: $2 -> $2
+
+foreign import primitive "I2F"  fromInt$1 :: Int -> $1
+foreign import primitive "I2F"  fromInteger$1 :: Integer -> $1
+
+foreign import primitive "F2I"  toInt$1 :: $1 -> Int
+
+instance Enum $1 where
+    succ = increment$1
+    pred = decrement$1
+    toEnum x = fromInt$1 x
+    fromEnum x = toInt$1 x
+
+    enumFrom x  | x `seq` True     =  x:enumFrom (increment$1 x)
+    enumFromTo x y = f x where
+        f x | x > y = []
+            | otherwise = x:f (increment$1 x)
+    enumFromThen x y | x `seq` y `seq` True = f x where
+        z = y `fminus$1` x
+        f x = x:f (x `fplus$1` z)
+    enumFromThenTo x y z | y >= x = f x where
+        inc = y `fminus$1` x
+        f x | x <= z = x:f (x `fplus$1` inc)
+            | otherwise = []
+    enumFromThenTo x y z  = f x where
+        inc = y `fminus$1` x
+        f x | x >= z = x:f (x `fplus$1` inc)
+            | otherwise = []
+
+foreign import primitive "fincrement" increment$1 :: $1 -> $1
+foreign import primitive "fdecrement" decrement$1 :: $1 -> $1
+foreign import primitive "FAdd" fplus$1  :: $1 -> $1 -> $1
+foreign import primitive "FSub" fminus$1 :: $1 -> $1 -> $1
+
+instance Eq $1 where
+    $1 x == $1 y = boxBool (x `eq$2` y)
+    $1 x /= $1 y = boxBool (x `neq$2` y)
+
+instance Ord $1 where
+    $1 x < $1 y = boxBool (flt$2 x y)
+    $1 x > $1 y = boxBool (fgt$2 x y)
+    $1 x <= $1 y = boxBool (flte$2 x y)
+    $1 x >= $1 y = boxBool (fgte$2 x y)
+
+
+
+foreign import primitive "FEq" eq$2   :: $2 -> $2 -> Bool__
+foreign import primitive "FNEq" neq$2 :: $2 -> $2 -> Bool__
+foreign import primitive "FLt" flt$2  :: $2 -> $2 -> Bool__
+foreign import primitive "FLte" flte$2 :: $2 -> $2 -> Bool__
+foreign import primitive "FGt" fgt$2 :: $2 -> $2 -> Bool__
+foreign import primitive "FGte" fgte$2 :: $2 -> $2 -> Bool__
+
+)
+
+
+
+NUMINSTANCE(Float,Float32_)
+NUMINSTANCE(Double,Float64_)
+
diff --git a/lib/base/src/Lhc/Handle.hs b/lib/base/src/Lhc/Handle.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Handle.hs
@@ -0,0 +1,91 @@
+{-# OPTIONS_LHC -fffi -funboxed-values #-}
+module Lhc.Handle(
+    Handle(..),
+    IOMode(..),
+    stdin,
+    stdout,
+    stderr,
+    withHandle,
+    hClose,
+    hIsOpen,
+    openFile
+    ) where
+
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.Types
+import Lhc.IO
+import Lhc.Addr
+import Foreign.C.String
+import Foreign.Marshal.Utils
+import Foreign.C.Error
+
+data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
+    deriving(Eq, Ord, Bounded, Enum, Read, Show)
+
+data Handle = Handle {
+    handleName :: String,
+    handleFile :: Ptr (Ptr Handle),
+    handleIOMode :: IOMode
+    }
+
+instance Show Handle where
+    showsPrec _ h s = handleName h ++ s
+
+stdin, stdout, stderr :: Handle
+
+make_builtin mode name std = Handle { handleName = "(" ++ name ++ ")", handleFile = std, handleIOMode = mode }
+
+stdin = make_builtin ReadMode "stdin" c_stdin
+stdout = make_builtin WriteMode "stdout" c_stdout
+stderr = make_builtin WriteMode "stderr" c_stderr
+
+{-
+stdin  = Handle (unsafePerformIO (peek c_stdin))
+stdout = Handle (unsafePerformIO (peek c_stdout))
+stderr = Handle (unsafePerformIO (peek c_stderr))
+-}
+
+foreign import ccall "stdio.h &stdin" c_stdin :: Ptr (Ptr Handle)
+foreign import ccall "stdio.h &stdout" c_stdout :: Ptr (Ptr Handle)
+foreign import ccall "stdio.h &stderr" c_stderr :: Ptr (Ptr Handle)
+
+withHandle h action = do
+    ptr <- peek (handleFile h)
+    case ptr == nullPtr of
+        True -> fail $ handleName h ++ ": handle  is closed"
+        False -> action ptr
+
+hClose h = do
+    ptr <- peek (handleFile h)
+    case ptr == nullPtr of
+        True -> return ()
+        False -> c_fclose ptr >> poke (handleFile h) nullPtr
+
+hIsOpen h = do
+    ptr <- peek (handleFile h)
+    return (ptr /= nullPtr)
+
+throwErrnoFN     :: String	-- ^ textual description of the error location
+               -> String
+	       -> IO a
+throwErrnoFN loc fn  = do
+    errno <- getErrno
+    ioError (errnoToIOError loc errno Nothing (Just fn))
+
+openFile :: FilePath -> IOMode -> IO Handle
+openFile fp m = do
+    ptr <- withCString fp $ \cfp -> c_fopen cfp (toStr m)
+    if ptr == nullPtr then throwErrnoFN "openFile" fp  else do
+        pptr <- new ptr
+        return Handle { handleName = fp, handleIOMode = m, handleFile = pptr }
+
+toStr ReadMode = ptrFromAddr__ "r"#
+toStr WriteMode = ptrFromAddr__ "w"#
+toStr AppendMode = ptrFromAddr__ "a"#
+toStr ReadWriteMode = ptrFromAddr__ "r+"#
+
+foreign import ccall "stdio.h fclose" c_fclose :: Ptr Handle -> IO CInt
+foreign import ccall "stdio.h fopen" c_fopen :: Ptr CChar -> Ptr CChar ->  IO (Ptr Handle)
+
+
diff --git a/lib/base/src/Lhc/Hole.hs b/lib/base/src/Lhc/Hole.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Hole.hs
@@ -0,0 +1,36 @@
+{-# OPTIONS_LHC -fffi #-}
+-- | this module provides a once-updatable value that may be used in pure code.
+-- it is an _unchecked_ error to read a hole before it has been filled in.
+-- filling in a hole has the effect of 'seq'ing its value immediatly so lift it in
+-- a datatype if this is an issue.
+--
+-- this module should not be used unless you really know what you are doing.
+-- incorrect usage may result in memory corruption.
+
+module Lhc.Hole(Hole(),newHole,fillHole,readHole,errorHole) where
+
+import Lhc.IO
+
+newtype Hole a = Hole a
+
+-- | unchecked error if readHole is evaled before fillHole has filled it in.
+readHole :: Hole a -> IO a
+readHole (Hole x) = strictReturn x
+
+-- | create a new hole containing a garbage value. must not be read until it has been filled.
+newHole :: IO (Hole a)
+newHole = IO $ \world -> newHole__ world
+
+-- | hole that can be written to and results discarded. never read this.
+errorHole :: Hole a
+errorHole = Hole undefined
+
+
+-- | it is an unchecked error to fill in the same hole more than once.
+fillHole :: Hole a -> a -> IO ()
+fillHole r v = IO $ \world -> case fillHole__ r v world of
+    world' -> (# world', () #)
+
+foreign import primitive newHole__  :: World__ -> (# World__, Hole a #)
+foreign import primitive fillHole__ :: Hole a -> a -> World__ -> World__
+
diff --git a/lib/base/src/Lhc/IO.hs b/lib/base/src/Lhc/IO.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/IO.hs
@@ -0,0 +1,178 @@
+{-# OPTIONS_LHC -N -funboxed-tuples -fffi #-}
+
+module Lhc.IO(
+    IO(..),
+    thenIO,
+    thenIO_,
+    returnIO,
+
+    UIO(),
+    UIO_(),
+
+    World__(),
+    catch,
+    unIO,
+    etaIO,
+    dependingOn,
+    fixIO,
+    ioError,
+    runExpr,
+    runMain,
+    runNoWrapper,
+    exitFailure,
+    strictReturn,
+    unsafeInterleaveIO,
+    error,
+    IOError(),
+    showIOError,
+    userError,
+    unsafePerformIO,
+    unsafePerformIO'
+    ) where
+
+import Lhc.Prim
+import Lhc.Basics
+import Lhc.Order
+import Foreign.C.Types
+import qualified Lhc.Options
+
+
+-- basic types
+
+
+unIO :: IO a -> World__ -> (# World__, a #)
+unIO (IO x) = x
+
+type UIO a = World__ -> (# World__, a #)
+type UIO_ = World__ -> World__
+
+-- | this ensures the world parameter is eta expanded out
+{-# INLINE etaIO #-}
+etaIO :: IO a -> IO a
+etaIO x = IO $ \w -> unIO x w
+
+-- unsafe operations
+
+unsafePerformIO :: IO a -> a
+unsafePerformIO x = case newWorld__ x of
+    world -> case errorContinuation x of
+        IO y -> case y world of
+            (# _, a #) -> a
+
+-- | same as unsafePerformIO, but doesn't set up error handler
+unsafePerformIO' :: IO a -> a
+unsafePerformIO' x = case newWorld__ x of
+    world -> case (unIO x) world of
+            (# _, a #) -> a
+
+-- we have to replace the error handler because the context might have quit by the time the value is evaluated.
+unsafeInterleaveIO :: IO a -> IO a
+unsafeInterleaveIO action = IO $ \w -> (# w , case action' w of (# _,  a #) -> a #)
+    where IO action' = errorContinuation action
+
+
+-- IO Exception handling
+
+newtype IOError = IOError String
+    deriving(Eq)
+
+showIOError :: IOError -> String
+showIOError (IOError x) = x
+
+userError       :: String  -> IOError
+userError str	=  IOError  str
+
+showError :: IOError -> IO b
+showError (IOError z) = putErrLn z `thenIO_` exitFailure
+
+errorContinuation :: IO a -> IO a
+errorContinuation x = catch x showError
+
+ioError    ::  IOError -> IO a
+ioError e  = case Lhc.Options.target of
+    Lhc.Options.GhcHs -> IO $ \w -> raiseIO__ e w
+    _ -> showError e
+
+
+catch :: IO a -> (IOError -> IO a) -> IO a
+catch (IO m) k =  case Lhc.Options.target of
+    Lhc.Options.GhcHs -> IO $ \s -> catch__ m (\ex -> unIO (k ex)) s
+    _ -> IO m  -- no catching on other targets just yet
+
+
+-- IO fixpoint operation
+
+data FixIO a = FixIO World__ a
+
+fixIO :: (a -> IO a) -> IO a
+fixIO k = IO $ \w -> let
+            r = case k ans of
+                    IO z -> case z w of
+                        (# w, r #) -> FixIO w r
+            ans = case r of
+                FixIO _ z -> z
+               in case r of
+                FixIO w z -> (# w, z #)
+
+
+-- some primitives
+
+
+-- | this creates a new world object that artificially depends on its argument to avoid CSE.
+foreign import primitive newWorld__ :: a -> World__
+foreign import primitive "dependingOn" worldDep__ :: forall b. b -> World__ -> b
+
+-- | this will return a value making it artificially depend on the state of the world. any uses of this value are guarenteed not to float before this point in the IO monad.
+strictReturn :: a -> IO a
+strictReturn a = IO $ \w -> (# w, worldDep__ a w #)
+
+{-# INLINE runMain #-}
+-- | this is wrapped around 'main' when compiling programs. it catches any exceptions and prints them to the screen and dies appropriatly.
+runMain :: IO a -> World__ -> World__
+runMain main w = case run w of
+        (# w,  _ #) -> w
+    where
+    IO run = catch main $ \e ->
+            putErrLn "\nUncaught Exception:" `thenIO_`
+            putErrLn (showIOError e)         `thenIO_`
+            exitFailure
+
+
+
+
+exitFailure :: IO a
+exitFailure = IO $ \w -> exitFailure__ w
+
+foreign import primitive exitFailure__ :: World__ -> (# World__, a #)
+
+
+thenIO_ :: IO a -> IO b -> IO b
+IO a `thenIO_` IO b = IO $ \w -> case a w of
+    (# w', _ #) -> b w'
+
+IO a `thenIO` b = IO $ \w -> case a w of
+    (# w', v #) -> unIO (b v) w'
+
+returnIO :: a -> IO a
+returnIO x = IO $ \w -> (# w, x #)
+
+{-# NOINLINE error #-}
+error s = unsafePerformIO' $
+    putErrLn "error:"  `thenIO_`
+    putErrLn s         `thenIO_`
+    exitFailure
+
+-- | no the implicit unsafeCoerce__ here!
+foreign import primitive catch__ :: (World__ -> (# World__,a #)) -> (b -> World__ -> (# World__,a #)) -> World__ -> (# World__,a #)
+foreign import primitive raiseIO__ :: a -> World__ -> (# World__,b #)
+
+
+putErrLn :: [Char] -> IO ()
+putErrLn [] = putChar '\n'
+putErrLn (c:cs) = putChar c `thenIO_` putErrLn cs
+putChar :: Char -> IO ()
+putChar c = c_putwchar (charToInt c)
+
+foreign import primitive "U2U" charToInt :: Char -> Int
+foreign import ccall "stdio.h lhc_utf8_putchar" c_putwchar :: Int -> IO ()
+
diff --git a/lib/base/src/Lhc/Inst/Enum.hs b/lib/base/src/Lhc/Inst/Enum.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Inst/Enum.hs
@@ -0,0 +1,70 @@
+{-# OPTIONS_LHC -N -fffi -funboxed-values -fm4 #-}
+
+module Lhc.Inst.Enum() where
+
+import Data.Word
+import Data.Int
+import Lhc.Enum
+import Lhc.Num
+import Lhc.Order
+import Lhc.IO(error)
+import Lhc.Basics
+
+m4_define(ENUMINST,{{
+instance Enum $1 where
+    toEnum = fromInt
+    fromEnum = toInt
+    succ = increment$1
+    pred = decrement$1
+    enumFrom c        = [c .. maxBound]
+    enumFromThen c c' = last `seq` [c, c' .. last]
+                      where last | c' < c    = minBound
+                                 | otherwise = maxBound
+    enumFromTo x y = f x where
+        f x | x > y = []
+            | otherwise = x:f (x + 1)
+    enumFromThenTo x y z | y >= x = inc `seq` z `seq` f x where
+        inc = y - x
+        f x | x <= z = x:f (x + inc)
+            | otherwise = []
+    enumFromThenTo x y z  = dec `seq` z `seq` f x where
+        dec = x - y
+        f x | x >= z = x:f (x - dec)
+            | otherwise = []
+
+foreign import primitive "increment" increment$1 :: $1 -> $1
+foreign import primitive "decrement" decrement$1 :: $1 -> $1
+
+}})
+
+ENUMINST(Word)
+ENUMINST(Word8)
+ENUMINST(Word16)
+ENUMINST(Word32)
+ENUMINST(Word64)
+ENUMINST(WordPtr)
+ENUMINST(WordMax)
+
+ENUMINST(Int8)
+ENUMINST(Int16)
+ENUMINST(Int32)
+ENUMINST(Int64)
+ENUMINST(IntPtr)
+ENUMINST(IntMax)
+ENUMINST(Integer)
+
+
+instance Enum () where
+    succ _      = error "Prelude.Enum.().succ: bad argument"
+    pred _      = error "Prelude.Enum.().pred: bad argument"
+
+    toEnum x | x == 0 = ()
+             | otherwise    = error "Prelude.Enum.().toEnum: bad argument"
+
+    fromEnum () = 0
+    enumFrom () 	= [()]
+    enumFromThen () () 	= let many = ():many in many
+    enumFromTo () () 	= [()]
+    enumFromThenTo () () () = let many = ():many in many
+
+
diff --git a/lib/base/src/Lhc/Inst/PrimEnum.hs b/lib/base/src/Lhc/Inst/PrimEnum.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Inst/PrimEnum.hs
@@ -0,0 +1,88 @@
+{-# OPTIONS_LHC -N -fffi -funboxed-values #-}
+
+-- | helper routines for deriving(Enum) instances
+-- these routines help out the compiler when
+-- deriving enums.
+
+module Lhc.Inst.PrimEnum(enum_succ,enum_pred,enum_fromTo,enum_fromThen,enum_fromThenTo,enum_toEnum,enum_from) where
+
+
+import Lhc.Prim
+import Lhc.Int
+import Lhc.Types
+
+
+{-# INLINE enum_toEnum, enum_succ, enum_pred, enum_fromTo, enum_fromThen, enum_fromThenTo, enum_from #-}
+
+enum_toEnum :: (Enum__ -> a) -> Int__ -> Int -> a
+enum_toEnum box max int = case unboxInt int of
+    int_ -> case int_ `bits32UGt` max of
+        1# -> toEnumError
+        0# -> box (intToEnum int_)
+
+foreign import primitive "error.toEnum: out of range" toEnumError :: a
+foreign import primitive "error.succ: out of range" succError :: a
+foreign import primitive "error.pred: out of range" predError :: a
+foreign import primitive "UGt"       bits32UGt       :: Bits32_ -> Bits32_ -> Bool__
+
+enum_succ :: (Enum__ -> a) -> (a -> Enum__) -> Enum__ -> a -> a
+enum_succ box debox max e = case debox e of
+    e_ -> case e_ `enumEq` max of
+        0# -> box (enumInc e_)
+        1# -> succError
+
+enum_pred :: (Enum__ -> a) -> (a -> Enum__) -> a -> a
+enum_pred box debox e = case debox e of
+    e_ -> case e_ `enumEq` 0# of
+        0# -> box (enumDec e_)
+        1# -> predError
+
+enum_from :: (Enum__ -> a) -> (a -> Enum__) -> Enum__ -> a -> [a]
+enum_from box debox max x = case debox x of
+    x_ -> f x_ where
+        f x = case x `enumGt` max of
+            0# -> box x:f (enumInc x)
+            1# -> []
+
+enum_fromTo :: (Enum__ -> a) -> (a -> Enum__) -> a -> a -> [a]
+enum_fromTo box debox x y = case debox y of
+    y_ -> enum_from box debox y_ x
+
+enum_fromThen :: (Enum__ -> a) -> (a -> Enum__) -> Enum__ -> a -> a -> [a]
+enum_fromThen box debox max x y = case debox x of
+    x_ -> case debox y of
+        y_ -> case x_ `enumGt` y_ of
+            0# -> enum_fromThenToUp' box x_ y_ max
+            1# -> enum_fromThenToDown' box x_ y_ 0#
+
+enum_fromThenTo :: (Enum__ -> a) -> (a -> Enum__) -> a -> a -> a -> [a]
+enum_fromThenTo box debox x y z = case debox x of
+    x_ -> case debox y of
+        y_ -> case debox z of
+            z_ -> case x_ `enumGt` y_ of
+                0# -> enum_fromThenToUp' box x_ y_ z_
+                1# -> enum_fromThenToDown' box x_ y_ z_
+
+enum_fromThenToUp' :: (Enum__ -> a) -> Enum__ -> Enum__ -> Enum__ -> [a]
+enum_fromThenToUp' box x y z = case y `enumSub` x of
+            inc -> let f x = case x `enumGt` z of
+                            0# -> box x:f (x `enumAdd` inc)
+                            1# -> []
+             in f x
+
+enum_fromThenToDown' :: (Enum__ -> a) -> Enum__ -> Enum__ -> Enum__ -> [a]
+enum_fromThenToDown' box x y z = case y `enumSub` x of
+            inc -> let f x = case x `enumLt` z of
+                            0# -> box x:f (x `enumAdd` inc)
+                            1# -> []
+             in f x
+
+foreign import primitive "Eq"         enumEq  :: Enum__ -> Enum__ -> Bool__
+foreign import primitive "Gt"         enumGt  :: Enum__ -> Enum__ -> Bool__
+foreign import primitive "Lt"         enumLt  :: Enum__ -> Enum__ -> Bool__
+foreign import primitive "Gte"        enumGte :: Enum__ -> Enum__ -> Bool__
+foreign import primitive "Add"        enumAdd :: Enum__ -> Enum__ -> Enum__
+foreign import primitive "Sub"        enumSub :: Enum__ -> Enum__ -> Enum__
+foreign import primitive "increment"  enumInc :: Enum__ -> Enum__
+foreign import primitive "decrement"  enumDec :: Enum__ -> Enum__
+foreign import primitive "U2U"        intToEnum :: Int__ -> Enum__
diff --git a/lib/base/src/Lhc/Inst/Read.hs b/lib/base/src/Lhc/Inst/Read.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Inst/Read.hs
@@ -0,0 +1,55 @@
+{-# OPTIONS_LHC -N -fm4 #-}
+
+module Lhc.Inst.Read() where
+
+import Prelude.Text
+import Data.Int
+import Lhc.Basics
+import Data.Word
+import Lhc.Order
+import Lhc.Float
+import Prelude.Float
+import Lhc.Num
+import Numeric(showSigned, showInt, readSigned, readDec, showFloat,
+               readFloat, lexDigits)
+
+-- Reading at the Integer type avoids
+-- possible difficulty with minInt
+
+m4_define(READINST,{{
+instance  Read $1  where
+  readsPrec p r = [(fromInteger i, t) | (i,t) <- readsPrec p r]
+}})
+
+
+READINST(Int8)
+READINST(Int16)
+READINST(Int32)
+READINST(Int64)
+READINST(IntMax)
+READINST(IntPtr)
+
+m4_define(READWORD,{{
+instance  Read $1  where
+  readsPrec _ r = readDec r
+}})
+
+READWORD(Word)
+READWORD(Word8)
+READWORD(Word16)
+READWORD(Word32)
+READWORD(Word64)
+READWORD(WordMax)
+READWORD(WordPtr)
+
+
+instance Read () where
+    readsPrec p    = readParen False
+                            (\r -> [((),t) | ("(",s) <- lex r,
+                                             (")",t) <- lex s ] )
+
+instance  Read Double  where
+    readsPrec p         = readSigned readDouble
+
+instance  Read Float  where
+    readsPrec p s        = [ (doubleToFloat x,y) | (x,y) <- readSigned readDouble s]
diff --git a/lib/base/src/Lhc/Inst/Show.hs b/lib/base/src/Lhc/Inst/Show.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Inst/Show.hs
@@ -0,0 +1,67 @@
+{-# OPTIONS_LHC -N #-}
+
+module Lhc.Inst.Show() where
+
+import Data.Int
+import Data.Word
+import Lhc.Basics
+import Lhc.Num
+import Lhc.Order
+import Lhc.Show
+
+-- we convert them to Word or WordMax so the showIntAtBase specialization can occur.
+
+instance Show Word where
+    showsPrec _ x = showWord x
+
+instance Show Word8 where
+    showsPrec _ x = showWord (fromIntegral x :: Word)
+
+instance Show Word16 where
+    showsPrec _ x = showWord (fromIntegral x :: Word)
+
+instance Show Word32 where
+    showsPrec _ x = showWord (fromIntegral x :: Word)
+
+instance Show Word64 where
+    showsPrec _ x = showWordMax (fromIntegral x :: WordMax)
+
+instance Show WordPtr where
+    showsPrec _ x = showWordMax (fromIntegral x :: WordMax)
+
+instance Show WordMax where
+    showsPrec _ x = showWordMax x
+
+instance Show Int where
+    showsPrec p x
+        | x < 0 = showParen (p > 6) (showChar '-' . showWord (fromIntegral $ negate x :: Word))
+        | otherwise = showWord (fromIntegral x :: Word)
+
+instance Show Integer where
+    showsPrec p x
+        | x < 0 = showParen (p > 6) (showChar '-' . showWordMax (fromIntegral $ negate x :: WordMax))
+        | otherwise = showWordMax (fromIntegral x :: WordMax)
+
+instance Show Int8 where
+    showsPrec p x = showsPrec p (fromIntegral x :: Int)
+instance Show Int16 where
+    showsPrec p x = showsPrec p (fromIntegral x :: Int)
+instance Show Int32 where
+    showsPrec p x = showsPrec p (fromIntegral x :: Int)
+instance Show Int64 where
+    showsPrec p x = showsPrec p (fromIntegral x :: Integer)
+instance Show IntPtr where
+    showsPrec p x = showsPrec p (fromIntegral x :: Integer)
+
+
+-- specialized base 10 only versions of show
+showWord :: Word -> String -> String
+showWord w rest = w `seq` case quotRem w 10 of
+    (n',d) -> n' `seq` d `seq` rest' `seq` if n' == 0 then rest' else showWord n' rest'
+        where rest' = chr (fromIntegral d + ord '0') : rest
+
+showWordMax :: WordMax -> String -> String
+showWordMax w rest = w `seq` case quotRem w 10 of
+    (n',d) -> n' `seq` d `seq` rest' `seq` if n' == 0 then rest' else showWordMax n' rest'
+        where rest' = chr (fromIntegral d + ord '0') : rest
+
diff --git a/lib/base/src/Lhc/Inst/Storable.hs b/lib/base/src/Lhc/Inst/Storable.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Inst/Storable.hs
@@ -0,0 +1,19 @@
+{-# OPTIONS_LHC -fm4 -N -fffi -funboxed-tuples -funboxed-values #-}
+module Lhc.Inst.Storable where
+
+m4_include(Foreign/Storable.m4)
+
+import Lhc.Types
+import Lhc.Float
+import Foreign.Storable
+import Lhc.Prim
+import Lhc.Basics
+import Lhc.Addr
+import Lhc.Int
+import Lhc.IO
+
+
+INST_STORABLE(Float,Float32_,fbits32)
+INST_STORABLE(Double,Float64_,fbits64)
+
+
diff --git a/lib/base/src/Lhc/Int.hs b/lib/base/src/Lhc/Int.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Int.hs
@@ -0,0 +1,19 @@
+{-# OPTIONS_LHC -N -fffi #-}
+
+-- just a few basic operations on integers to jumpstart things
+module Lhc.Int(Int(),Int__(),increment,decrement,plus,minus,times,divide,modulus,zero,one,boxInt,unboxInt) where
+
+import Lhc.Prim(Int(),Int__())
+
+foreign import primitive increment :: Int -> Int
+foreign import primitive decrement :: Int -> Int
+foreign import primitive "Add" plus      :: Int -> Int -> Int
+foreign import primitive "Sub" minus     :: Int -> Int -> Int
+foreign import primitive "Mul" times     :: Int -> Int -> Int
+foreign import primitive "Div" divide    :: Int -> Int -> Int
+foreign import primitive "Mod" modulus   :: Int -> Int -> Int
+foreign import primitive zero      :: Int
+foreign import primitive one       :: Int
+
+foreign import primitive "box" boxInt :: Int__ -> Int
+foreign import primitive "unbox" unboxInt :: Int -> Int__
diff --git a/lib/base/src/Lhc/JumpPoint.hs b/lib/base/src/Lhc/JumpPoint.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/JumpPoint.hs
@@ -0,0 +1,33 @@
+{-# OPTIONS_LHC -fffi #-}
+module Lhc.JumpPoint(JumpPoint(), withJumpPoint__, jumpJumpPoint__, errorJumpPoint) where
+
+import Lhc.IO
+import Lhc.Addr
+
+newtype JumpPoint = JumpPoint Addr
+
+
+-- | in order to be safe, the JumpPoint must not escape the handling function
+withJumpPoint__ :: (JumpPoint -> Bool -> IO a) -> IO a
+withJumpPoint__ action = do
+    p <- _malloc jmp_buf_size
+    let jp = (JumpPoint p)
+    r <- lhc_setjmp jp
+    r <- action jp (r /= 0)
+    _free p
+    return r
+
+jumpJumpPoint__ :: JumpPoint -> IO a
+jumpJumpPoint__ jp = lhc_longjmp  jp >> return (error "jumpJumpPoint__")
+
+-- | jumping to this jumppoint will always abort the program.
+foreign import ccall "&lhc_uncaught" errorJumpPoint :: JumpPoint
+
+foreign import ccall lhc_setjmp :: JumpPoint -> IO Int
+foreign import ccall lhc_longjmp :: JumpPoint -> IO ()
+foreign import primitive "const.sizeof(jmp_buf)" jmp_buf_size  :: Int
+foreign import ccall "malloc.h malloc" _malloc :: Int -> IO Addr
+foreign import ccall "malloc.h free" _free :: Addr -> IO ()
+
+
+
diff --git a/lib/base/src/Lhc/List.hs b/lib/base/src/Lhc/List.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/List.hs
@@ -0,0 +1,319 @@
+{-# OPTIONS_LHC -N #-}
+module Lhc.List where
+
+import Lhc.Basics
+import Lhc.IO(error)
+import Lhc.Int
+import Lhc.Order
+
+import Lhc.String
+
+
+-- | our fusion routines
+
+build :: (forall b . (a -> b -> b) -> b -> b) -> [a]
+build g = g (:) []
+
+
+augment :: forall a. (forall b. (a->b->b) -> b -> b) -> [a] -> [a]
+augment g xs = g (:) xs
+
+{-# RULES "foldr/nil" forall k z.   foldr k z []  = z  #-}
+{-# RULES "foldr/single"  forall k z x . foldr k z [x] = k x z #-}
+{-# RULES "foldr/double"  forall k z x y . foldr k z [x,y] = k x (k y z) #-}
+{-# RULES "foldr/triple"  forall k z a b c . foldr k z [a,b,c] = k a (k b (k c z)) #-}
+{-# RULES "foldr/id"      foldr (:) [] = \x -> x  #-}
+{- "foldr/app"    	[1] forall ys. foldr (:) ys = \xs -> xs ++ ys -}
+
+{-# RULES "foldr/build" forall k z (g :: forall b . (a -> b -> b) -> b -> b) . foldr k z (build g) = g k z #-}
+{-# RULES "foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) .  foldr k z (augment g xs) = g k (foldr k z xs) #-}
+{-# RULES "foldr/single" forall k z x. foldr k z [x] = k x z #-}
+{-# RULES "augment/build" forall (g::forall b. (a->b->b) -> b -> b)
+		       (h::forall b. (a->b->b) -> b -> b) .
+		       augment g (build h) = build (\c n -> g c (h c n)) #-}
+{-# RULES "augment/nil"   forall (g::forall b. (a->b->b) -> b -> b) .  augment g [] = build g #-}
+
+{-# RULES "foldr/unpackString"  forall k z (addr::Addr__) . foldr k z (unpackString addr) = unpackStringFoldr addr k z  #-}
+
+-- a few pre-fusioned routines
+
+filterIterate :: (a -> Bool) -> (a -> a) -> a -> [a]
+filterIterate p f x = fi x where
+    fi x | p x = x : fi (f x)
+    fi x = fi (f x)
+
+mapIterate :: (a -> b) -> (a -> a) -> a -> [b]
+mapIterate f g x = fi x where
+    fi x = f x : fi (g x)
+
+filterMap :: (b -> Bool) -> (a -> b) -> [a] -> [b]
+filterMap p f xs = fm xs where
+    fm (x:xs) = let nx = f x in if p nx then nx:fm xs else fm xs
+    fm [] = []
+
+mapFilter :: (a -> b) -> (a -> Bool) -> [a] -> [b]
+mapFilter f p xs = fm xs where
+    fm (x:xs) = if p x then f x:fm xs else fm xs
+    fm [] = []
+
+{-# RULES "tail/map"      forall f xs . tail (map f xs) = map f (tail xs) #-}
+{-# RULES "head/map"      forall f xs . head (map f xs) = f (head xs) #-}
+{-# RULES "head/:"        forall x xs . head (x:xs) = x #-}
+{-# RULES "tail/:"        forall x xs . tail (x:xs) = xs #-}
+
+{-# RULES "filter/iterate" forall p f x . filter p (iterate f x) = filterIterate p f x  #-}
+{-# RULES "map/iterate" forall f g x . map f (iterate g x) = mapIterate f g x  #-}
+{-# RULES "map/filter" forall f p xs . map f (filter p xs) = mapFilter f p xs  #-}
+{-# RULES "filter/map" forall f p xs . filter p (map f xs) = filterMap p f xs  #-}
+
+-- efficient implementations of prelude routines
+
+{-# CATALYST "and/foldr" forall . and = foldr (&&) True #-}
+{-# CATALYST "or/foldr"  forall . or = foldr (||) False #-}
+
+and, or          :: [Bool] -> Bool
+and [] = True
+and (False:_) = False
+and (True:xs) = and xs
+
+or [] = False
+or (True:_) = True
+or (False:xs) = or xs
+
+{-# RULES "any/build"     forall p (g::forall b.(a->b->b)->b->b) .  any p (build g) = g ((||) . p) False #-}
+
+
+{-# RULES "all/build"     forall p (g::forall b.(a->b->b)->b->b) .  all p (build g) = g ((&&) . p) True #-}
+
+
+any, all         :: (a -> Bool) -> [a] -> Bool
+any p xs = f xs where
+    f [] = False
+    f (x:xs) | p x = True
+             | otherwise = f xs
+
+all p xs = f xs where
+    f [] = True
+    f (x:xs) | not (p x) = False
+             | otherwise = f xs
+
+filter :: (a -> Bool) -> [a] -> [a]
+filter p []                 = []
+filter p (x:xs) | p x       = x : filter p xs
+                | otherwise = filter p xs
+
+-- elem is the list membership predicate, usually written in infix form,
+-- e.g., x `elem` xs.  notElem is the negation.
+
+infix  4  `elem`, `notElem`
+
+
+-- the implementation looks a little funny, but the reason for the
+-- inner loop is so that both the == function and the unboxing of the
+-- argument may occur right away outside the inner loop when the list isn't
+-- empty.
+
+
+elem, notElem    :: (Eq a) => a -> [a] -> Bool
+elem _ []	= False
+elem x (y:ys)
+    | x == y = True
+    | otherwise = f y ys where
+        f y _ | x == y = True
+        f _ (y:ys) = f y ys
+        f _ [] = False
+
+{-# SPECIALIZE elem :: Char -> String -> Bool #-}
+{-# SPECIALIZE elem :: Int -> [Int] -> Bool #-}
+{-# RULES "elem/[]" forall c . elem c [] = False #-}
+{-# RULES "elem/[_]" forall c v . elem c [v] = c == v #-}
+
+notElem	_ []	=  True
+notElem x (y:ys)
+    | x == y = False
+    | otherwise = f y ys where
+        f y ys | x == y = False
+        f _ (y:ys) = f y ys
+        f _ [] = True
+
+{-# SPECIALIZE notElem :: Char -> String -> Bool #-}
+{-# SPECIALIZE notElem :: Int -> [Int] -> Bool #-}
+{-# RULES "notElem/[]" forall c . notElem c [] = True #-}
+{-# RULES "notElem/[_]" forall c v . notElem c [v] = c /= v #-}
+
+infixl 9  !!
+
+(!!)                :: [a] -> Int -> a
+xs !! n | n < zero  =  error "Prelude.(!!): negative index"
+	| otherwise =  sub xs n where
+                sub :: [a] -> Int -> a
+                sub _ n | n `seq` False = undefined
+                sub []     _ = error "Prelude.(!!): index too large"
+                sub (y:ys) n = if n == zero
+                               then y
+                               else sub ys $! (n `minus` one)
+
+null             :: [a] -> Bool
+null []          =  True
+null (_:_)       =  False
+
+-- length returns the length of a finite list as an Int.
+
+length           :: [a] -> Int
+length xs = f xs zero where
+    f [] n = n
+    f (_:xs) n = f xs $! n `plus` one
+
+head             :: [a] -> a
+head (x:_)       =  x
+head []          =  error "Prelude.head: empty list"
+
+
+tail             :: [a] -> [a]
+tail (_:xs)      =  xs
+tail []          =  error "Prelude.tail: empty list"
+
+
+last             :: [a] -> a
+last []          =  error "Prelude.last: empty list"
+last (x:xs)      = last' x xs where
+    last' x []     = x
+    last' _ (y:ys) = last' y xs
+
+
+init             :: [a] -> [a]
+init []          =  error "Prelude.init: empty list"
+init (x:xs)      =  init' x xs where
+    init' _ [] = []
+    init' y (z:zs) = y:init' z zs
+
+
+{-# RULES "head/iterate"  forall f x . head (iterate f x) = x #-}
+{-# RULES "head/repeat"   forall x . head (repeat x) = x #-}
+{-# RULES "tail/repeat"   forall x . tail (repeat x) = repeat x #-}
+{-# RULES "tail/iterate"  forall f x . tail (iterate f x) = iterate f (f x) #-}
+{-# RULES "iterate/id" forall . iterate id = repeat #-}
+
+{-
+concatMap f = foldr ((++) . f) []
+--concat xss = foldr (++) [] xss
+concat xss = foldr (++) [] xss
+concatMap f = foldr ((++) . f) []
+
+and xs  = foldr (&&) True xs
+sum xs = foldr (+) (0::Int) xs
+(++) xs ys = augment (\c n -> foldr c n xs) ys
+concat xs = foldr (++) [] xs
+foldl f z xs = foldr (\b g a -> g (f a b)) id xs z
+
+filter p xs = build (\c n -> foldr (filterFB c p) n xs)
+{- RULES "filterFB" forall c p q. filterFB (filterFB c p) q = filterFB c (\x -> q x && p x) #-}
+
+{- NOINLINE filterFB #-}
+filterFB c p x r | p x       = x `c` r
+		 | otherwise = r
+
+
+{- NOINLINE iterateFB #-}
+iterate f x = build (\c _n -> iterateFB c f x)
+iterateFB c f x = x `c` iterateFB c f (f x)
+
+head (x:xs) = x
+head [] = badHead
+
+
+map f xs =  build (\c n -> foldr (mapFB c f) n xs)
+{- NOINLINE mapFB #-}
+mapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
+mapFB c f x ys = c (f x) ys
+
+
+badHead = error "Prelude.head: empty list"
+
+{-# RULES "head/build"   forall (g::forall b.(a->b->b)->b->b) . head (build g) = g (\x _ -> x) badHead #-}
+
+{-# RULES "head/augment"   forall xs (g::forall b. (a->b->b) -> b -> b) .  head (augment g xs) = g (\x _ -> x) (head xs) #-}
+
+--repeat x = build (\c _n -> repeatFB c x)
+--repeatFB c x = xs where xs = x `c` xs
+
+
+{-
+
+
+
+{-# RULES forall xs n (g :: forall b . (a -> b -> b) -> b -> b) . build g !! n  = bangBang g n  #-}
+
+bangBang :: (forall b . (a -> b -> b) -> b -> b) -> Int -> a
+g `bangBang` n
+    | n < 0 = error "Prelude.(!!): negative index\n"
+    | otherwise = g c k  where
+            sub _ n | n `seq` False = undefined
+            sub []     _ = error "Prelude.(!!): index too large\n"
+            sub (y:ys) n = if n == 0
+                           then y
+                           else sub ys $! (n - 1)
+
+-}
+
+(!!) :: [a] -> Int -> a
+xs !! n = foldr bangFB bangCon xs n
+
+bangCon _ = error "!! out of range"
+
+bangFB :: a -> (Int -> a) -> Int -> a
+bangFB x _xs m | m == 0 = x
+bangFB _x xs m = xs $! (m - 1)
+
+{-# INLINE bangFB #-}
+{-# INLINE iterateFB #-}
+{-# INLINE (!!) #-}
+
+
+
+{-# RULES
+"take"	   [~1] forall n xs . take n xs = case n of I# n# -> build (\c nil -> foldr (takeFB c nil) (takeConst nil) xs n#)
+"takeList"  [1] forall n xs . foldr (takeFB (:) []) (takeConst []) xs n = takeUInt n xs
+ #-}
+
+{-# NOINLINE [0] takeConst #-}
+-- just a version of const that doesn't get inlined too early, so we
+-- can spot it in rules.  Also we need a type sig due to the unboxed Int#.
+takeConst :: a -> Int# -> a
+takeConst x _ = x
+
+{-# NOINLINE [0] takeFB #-}
+takeFB :: (a -> b -> c) -> c -> a -> (Int# -> b) -> Int# -> c
+takeFB c n x xs m | m <=# 0#  = n
+		  | otherwise = x `c` xs (m -# 1#)
+  -}
+
+-- takeWhile, applied to a predicate p and a list xs, returns the longest
+-- prefix (possibly empty) of xs of elements that satisfy p.  dropWhile p xs
+-- returns the remaining suffix.  span p xs is equivalent to
+-- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p.
+
+
+takeWhile               :: (a -> Bool) -> [a] -> [a]
+takeWhile p []          =  []
+takeWhile p (x:xs)
+            | p x       =  x : takeWhile p xs
+            | otherwise =  []
+
+
+dropWhile               :: (a -> Bool) -> [a] -> [a]
+dropWhile p []          =  []
+dropWhile p xs@(x:xs')
+            | p x       =  dropWhile p xs'
+            | otherwise =  xs
+
+span, break             :: (a -> Bool) -> [a] -> ([a],[a])
+span p []            = ([],[])
+span p xs@(x:xs')
+            | p x       =  (x:ys,zs)
+            | otherwise =  ([],xs)
+                           where (ys,zs) = span p xs'
+
+{-# INLINE break #-}
+break p                 =  span (not . p)
+
diff --git a/lib/base/src/Lhc/Maybe.hs b/lib/base/src/Lhc/Maybe.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Maybe.hs
@@ -0,0 +1,36 @@
+{-# OPTIONS_LHC -N -fffi #-}
+module Lhc.Maybe where
+
+import Lhc.Monad
+import Lhc.Order
+import Lhc.Show
+import Lhc.List
+import Lhc.Basics
+import Lhc.Num
+
+instance Monad Maybe where
+    return x = Just x
+    Nothing >>= _ = Nothing
+    Just x >>= y = y x
+    fail _ = Nothing
+
+
+
+instance Functor Maybe where
+    fmap _ Nothing = Nothing
+    fmap f (Just x) = Just (f x)
+
+
+
+-- Maybe
+-- need to add Read instance
+
+data Maybe a  =  Nothing | Just a
+    deriving (Eq, Ord, Show)
+
+maybe :: b -> (a -> b) -> Maybe a -> b
+maybe n f m = case m of
+    Just x -> f x
+    Nothing -> n
+
+
diff --git a/lib/base/src/Lhc/Monad.hs b/lib/base/src/Lhc/Monad.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Monad.hs
@@ -0,0 +1,89 @@
+{-# OPTIONS_LHC -N -funboxed-tuples #-}
+
+module Lhc.Monad where
+
+import Lhc.Basics
+import Lhc.IO
+
+-- Monadic classes
+
+infixl 1  >>, >>=
+infixr 1  =<<
+
+class Functor f  where
+    fmap              :: (a -> b) -> f a -> f b
+
+{- INLINE return, fail, (>>=), (>>) -}
+class Monad m  where
+    (>>=)  :: m a -> (a -> m b) -> m b
+    (>>)   :: m a -> m b -> m b
+    return :: a -> m a
+    fail   :: String -> m a
+
+        -- Minimal complete definition:
+        --      (>>=), return
+    m >> k  =  m >>= \_ -> k
+    fail s  = error s
+
+{- SPECIALIZE sequence :: forall a . [IO a] -> IO [a] #-}
+{- SPECIALIZE sequence_ :: forall a . [IO a] -> IO () #-}
+{- SPECIALIZE mapM :: forall a b . (a -> IO b) -> [a]-> IO [b] #-}
+{- SPECIALIZE mapM_ :: forall a b . (a -> IO b) -> [a]-> IO () #-}
+
+{-# RULES "sequence/[]"   sequence [] = return [] #-}
+{-# RULES "sequence_/[]"  sequence_ [] = return () #-}
+{-# RULES "mapM/[]"       forall f . mapM f [] = return [] #-}
+{-# RULES "mapM_/[]"      forall f . mapM_ f [] = return () #-}
+{-# RULES "sequence_/++"  forall xs ys . sequence_ (xs ++ ys) = sequence_ xs >> sequence_ ys #-}
+{-# RULES "mapM_/++"      forall xs ys f . mapM_ f (xs ++ ys) = mapM_ f xs >> mapM_ f ys #-}
+
+mapM             :: Monad m => (a -> m b) -> [a] -> m [b]
+mapM f as = go as where
+    go [] = return []
+    go (a:as) = do
+        a' <- f a
+        as' <- go as
+        return (a':as')
+
+mapM_            :: Monad m => (a -> m b) -> [a] -> m ()
+mapM_ f as = go as where
+    go [] = return ()
+    go (a:as) = f a >> go as
+
+sequence       :: Monad m => [m a] -> m [a]
+sequence xs = f xs where
+    f [] = return []
+    f (x:xs) = x >>= \r -> f xs >>= \rs -> return (r:rs)
+
+sequence_      :: Monad m => [m a] -> m ()
+sequence_ xs  =  f xs where
+    f [] = return ()
+    f (x:xs) = x >> f xs
+
+(=<<)            :: Monad m => (a -> m b) -> m a -> m b
+f =<< x          =  x >>= f
+
+
+
+instance Monad [] where
+    return x = [x]
+    xs >>= f = concatMap f xs
+    fail _ = []
+
+instance Functor [] where
+    fmap f (x:xs) = f x : fmap f xs
+    fmap f [] = []
+
+instance Monad IO where
+    return x = IO $ \w -> (# w, x #)
+    IO x >>= f = IO $ \w -> case x w of
+        (# w, v #) -> case f v of
+            IO g -> g w
+    IO x >> IO y = IO $ \w -> case x w of
+        (# w,  _ #) -> y w
+    fail s = ioError $ userError s
+
+instance Functor IO where
+    fmap f a = a >>= \x -> return (f x)
+
+
diff --git a/lib/base/src/Lhc/Num.hs b/lib/base/src/Lhc/Num.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Num.hs
@@ -0,0 +1,108 @@
+{-# OPTIONS_LHC -N #-}
+module Lhc.Num where
+
+import Lhc.Basics
+import Lhc.Order
+import Lhc.Show
+import Lhc.IO(error)
+import Lhc.Enum
+import Lhc.Float
+
+infixl 7 :%
+infixl 7  *  , /, `quot`, `rem`, `div`, `mod`
+infixl 6  +, -
+
+data  Ratio a  = !a :% !a
+type  Rational = Ratio Integer
+
+numerator, denominator  :: Ratio a -> a
+numerator (x :% _)      =  x
+denominator (_ :% y)    =  y
+
+
+class  (Eq a, Show a) => Num a  where
+    (+), (-), (*)    :: a -> a -> a
+    negate           :: a -> a
+    abs, signum      :: a -> a
+    fromInteger      :: Integer -> a
+    fromInt          :: Int -> a
+
+        -- Minimal complete definition:
+        --      All, except negate or (-)
+    x - y            =  x + negate y
+    negate x         =  0 - x
+    fromInt i = fromInteger (toInteger i)
+    fromInteger x = fromInt (toInt x)
+
+class  (Num a, Ord a) => Real a  where
+    toRational       ::  a -> Rational
+    toDouble         ::  a -> Double
+    toDouble x = rationalToDouble (toRational x)
+
+class  (Real a, Enum a) => Integral a  where
+    quot, rem        :: a -> a -> a
+    div, mod         :: a -> a -> a
+    quotRem, divMod  :: a -> a -> (a,a)
+    toInteger        :: a -> Integer
+    toInt            :: a -> Int
+
+        -- Minimal complete definition:
+        --      quotRem, toInteger
+    n `quot` d       =  q  where (q,r) = quotRem n d
+    n `rem` d        =  r  where (q,r) = quotRem n d
+    n `div` d        =  q  where (q,r) = divMod n d
+    n `mod` d        =  r  where (q,r) = divMod n d
+    divMod n d       =  if signum r == - signum d then (q-1, r+d) else qr
+                        where qr@(q,r) = quotRem n d
+    quotRem n d       =  (n `quot` d, n `rem` d)
+    toInteger x = toInteger (toInt x)
+    toInt x = toInt (toInteger x)
+
+class  (Num a) => Fractional a  where
+    (/)              :: a -> a -> a
+    recip            :: a -> a
+    fromRational     :: Rational -> a
+    fromDouble       :: Double   -> a
+
+        -- Minimal complete definition:
+        --      fromRational and (recip or (/))
+    recip x          =  1 / x
+    x / y            =  x * recip y
+
+    --fromDouble x = fromRational (doubleToRational x)
+
+
+fromIntegral   :: (Integral a, Num b) => a -> b
+fromIntegral x =  fromInteger (toInteger x)
+
+realToFrac     :: (Real a, Fractional b) => a -> b
+realToFrac x   =  fromRational (toRational x)
+
+{-# RULES
+  "realToFrac/toRational"     realToFrac = toRational
+  "realToFrac/fromRational"   realToFrac = fromRational
+  "realToFrac/toDouble"       realToFrac = toDouble
+  "realToFrac/fromDouble"     realToFrac = fromDouble
+ #-}
+
+{-# RULES
+  "fromIntegral/Int"          fromIntegral = (id :: Int -> Int)
+  "fromIntegral/Integer"      fromIntegral = (id :: Integer -> Integer)
+  "fromIntegral/toInt"        fromIntegral = toInt
+  "fromIntegral/fromInt"      fromIntegral = fromInt
+  "fromIntegral/toInteger"    fromIntegral = toInteger
+  "fromIntegral/fromInteger"  fromIntegral = fromInteger
+ #-}
+
+
+{-# INLINE subtract #-}
+subtract         :: (Num a) => a -> a -> a
+subtract         =  flip (-)
+
+{-# INLINE even #-}
+{-# INLINE odd #-}
+
+even, odd        :: (Integral a) => a -> Bool
+even n           =  n `rem` 2 == 0
+odd              =  not . even
+
diff --git a/lib/base/src/Lhc/Options.hs b/lib/base/src/Lhc/Options.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Options.hs
@@ -0,0 +1,13 @@
+{-# OPTIONS_LHC -N -fffi #-}
+
+module Lhc.Options(target,Target(..)) where
+
+data Target = Grin | GhcHs | DotNet | Java
+
+
+{-# NOINLINE target #-}
+target :: Target
+target = unknown_target
+
+foreign import primitive unknown_target :: Target
+
diff --git a/lib/base/src/Lhc/Order.hs b/lib/base/src/Lhc/Order.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Order.hs
@@ -0,0 +1,131 @@
+{-# OPTIONS_LHC -N -fffi #-}
+
+module Lhc.Order(
+    Bool(..),
+    Ordering(..),
+    Eq(..),
+    Ord(..),
+    (&&),
+    (||),
+    not,
+    otherwise
+    ) where
+
+import Lhc.Enum
+import Lhc.Basics
+
+data Bool = False | True
+    deriving (Eq, Ord, Bounded, Enum)
+
+data  Ordering    =  LT | EQ | GT
+    deriving (Eq, Ord, Bounded, Enum)
+
+infix  4  ==, /=, <, <=, >=, >
+
+class Eq a where
+    (==) :: a -> a -> Bool
+    (/=) :: a -> a -> Bool
+    x == y = case x /= y of
+        True -> False
+        False -> True
+    x /= y = case x == y of
+        True -> False
+        False -> True
+
+class  (Eq a) => Ord a  where
+    compare              :: a -> a -> Ordering
+    (<), (<=), (>=), (>) :: a -> a -> Bool
+    max, min             :: a -> a -> a
+
+    compare x y | x == y    = EQ
+                | x <= y    = LT
+                | otherwise = GT
+
+    x <= y  = compare x y /= GT
+    x <  y  = compare x y == LT
+    x >= y  = compare x y /= LT
+    x >  y  = compare x y == GT
+
+    -- Note that (min x y, max x y) = (x,y) or (y,x)
+    max x y | x <= y    =  y
+            | otherwise =  x
+    min x y | x <= y    =  x
+            | otherwise =  y
+
+
+instance Eq () where
+    () == () = True
+    () /= () = False
+
+instance Ord () where
+    () <= () = True
+    () <  () = False
+    () >= () = True
+    () >  () = False
+    max () () = ()
+    min () () = ()
+    compare () () = EQ
+
+instance Bounded () where
+    minBound = ()
+    maxBound = ()
+
+instance Eq a => Eq [a] where
+    [] == [] = True
+    (x:xs) == (y:ys) | x == y = xs == ys
+    _ == _ = False
+
+instance Ord a => Ord [a] where
+    compare (x:xs) (y:ys) = case compare x y of
+        EQ -> compare xs ys
+        z -> z
+    compare [] [] = EQ
+    compare [] _ = LT
+    compare _ [] = GT
+
+    [] < [] = False
+    [] < _ = True
+    (x:xs) < (y:ys) = if x == y then xs < ys else x < y
+
+    x > y = y < x
+
+    x >= y = not (x < y)
+    x <= y = not (y < x)
+
+
+instance Eq Char where
+    Char x == Char y = boxBool (equalsChar x y)
+    Char x /= Char y = boxBool (nequalsChar x y)
+
+instance Ord Char where
+    Char x < Char y = boxBool (bits32ULt x y)
+    Char x > Char y = boxBool (bits32UGt x y)
+    Char x <= Char y = boxBool (bits32ULte x y)
+    Char x >= Char y = boxBool (bits32UGte x y)
+
+infixr 3  &&
+infixr 2  ||
+
+{-# INLINE (&&), (||), not, otherwise #-}
+(&&), (||)       :: Bool -> Bool -> Bool
+True  && x       =  x
+False && _       =  False
+True  || _       =  True
+False || x       =  x
+
+
+not              :: Bool -> Bool
+not x = if x then False else True
+
+
+otherwise        :: Bool
+otherwise        =  True
+
+foreign import primitive "Eq" equalsChar :: Char__ -> Char__ -> Bool__
+foreign import primitive "NEq" nequalsChar :: Char__ -> Char__ -> Bool__
+foreign import primitive "ULt" bits32ULt :: Char__ -> Char__ -> Bool__
+foreign import primitive "ULte" bits32ULte :: Char__ -> Char__ -> Bool__
+foreign import primitive "UGt" bits32UGt :: Char__ -> Char__ -> Bool__
+foreign import primitive "UGte" bits32UGte :: Char__ -> Char__ -> Bool__
+foreign import primitive "box" boxBool :: Bool__ -> Bool
+
diff --git a/lib/base/src/Lhc/Order.m4 b/lib/base/src/Lhc/Order.m4
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Order.m4
@@ -0,0 +1,39 @@
+m4_divert(-1)
+m4_dnl simple macros for defining instances for classes in Lhc.Order
+
+m4_define(BOXBOOL,{{ONCE({{
+foreign import primitive "box" boxBool :: Bool__ -> Bool
+}})}})
+
+m4_define(INST_EQ,{{
+instance Eq $1 where
+    $1 x == $1 y = boxBool (equals$2 x y)
+    $1 x /= $1 y = boxBool (nequals$2 x y)
+ONCE({{
+foreign import primitive "Eq" equals$2 :: $2 -> $2 -> Bool__
+foreign import primitive "NEq" nequals$2 :: $2 -> $2 -> Bool__
+}})
+BOXBOOL()
+}})
+
+
+m4_define(INST_ORDER,{{
+instance Ord $1 where
+    $1 x < $1 y = boxBool (lt$2 x y)
+    $1 x > $1 y = boxBool (gt$2 x y)
+    $1 x <= $1 y = boxBool (lte$2 x y)
+    $1 x >= $1 y = boxBool (gte$2 x y)
+ONCE({{
+foreign import primitive "$3Lt" lt$3$2   :: $2 -> $2 -> Bool__
+foreign import primitive "$3Lte" lte$3$2 :: $2 -> $2 -> Bool__
+foreign import primitive "$3Gt" gt$3$2   :: $2 -> $2 -> Bool__
+foreign import primitive "$3Gte" gte$3$2 :: $2 -> $2 -> Bool__
+}})
+BOXBOOL()
+}})
+
+m4_define(INST_EQORDER,{{INST_EQ($1,$2)INST_ORDER($1,$2,$3)}})
+
+m4_divert
+
+
diff --git a/lib/base/src/Lhc/Prim.hs b/lib/base/src/Lhc/Prim.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Prim.hs
@@ -0,0 +1,37 @@
+{-# OPTIONS_LHC -N -fffi -funboxed-tuples #-}
+module Lhc.Prim where
+
+-- this module is always included in all programs compiled by lhc. it defines some things that are needed to make lhc work at all.
+
+import Lhc.String
+import Lhc.Types
+
+infixr 5  :
+data [] a =  a : ([] a) | []
+
+newtype IO a = IO (World__ -> (# World__, a #))
+
+data World__ :: #
+
+data Int
+data Char = Char Char__
+
+type Bool__ = Bits16_ -- Change to Bits1_ when the time comes
+type Addr__ = BitsPtr_
+type Int__  = Bits32_
+type Char__ = Bits32_
+type Enum__ = Bits16_
+
+
+-- | this is wrapped around arbitrary expressions and just evaluates them to whnf
+foreign import primitive "seq" runRaw :: a -> World__ -> World__
+
+-- | when no exception wrapper is wanted
+runNoWrapper :: IO a -> World__ -> World__
+runNoWrapper (IO run) w = case run w of (# w, _ #) -> w
+
+
+foreign import primitive "unsafeCoerce" unsafeCoerce__ :: a -> b
+
+-- like 'const' but creates an artificial dependency on its second argument to guide optimization.
+foreign import primitive dependingOn :: forall a b. a -> b -> a
diff --git a/lib/base/src/Lhc/Show.hs b/lib/base/src/Lhc/Show.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Show.hs
@@ -0,0 +1,67 @@
+{-# OPTIONS_LHC -N #-}
+module Lhc.Show where
+
+import Lhc.Int
+import Lhc.Order
+import Lhc.Basics
+
+type  ShowS    = String -> String
+
+class  Show a  where
+    showsPrec        :: Int -> a -> ShowS
+    show             :: a -> String
+    showList         :: [a] -> ShowS
+
+        -- Mimimal complete definition:
+        --      show or showsPrec
+    showsPrec _ x s   = show x ++ s
+
+    show x            = showsPrec zero x ""
+
+    showList []       = showString "[]"
+    showList (x:xs)   = showChar '[' . shows x . showl xs
+                        where showl []     = showChar ']'
+                              showl (x:xs) = showChar ',' . shows x .
+                                             showl xs
+
+shows            :: (Show a) => a -> ShowS
+shows            =  showsPrec zero
+
+{-# INLINE showChar, showString #-}
+showChar         :: Char -> ShowS
+showChar         =  (:)
+
+showString       :: String -> ShowS
+showString       =  (++)
+
+showParen        :: Bool -> ShowS -> ShowS
+showParen b p    =  if b then showChar '(' . p . showChar ')' else p
+
+
+instance Show () where
+    showsPrec _ () = showString "()"
+
+instance (Show a, Show b) => Show (a,b)  where
+    showsPrec _ (x,y) = showChar '(' . shows x . showChar ',' .
+                                          shows y . showChar ')'
+
+instance (Show a, Show b, Show c) => Show (a, b, c) where
+    showsPrec _ (x,y,z) = showChar '(' . shows x . showChar ',' .
+					    shows y . showChar ',' .
+					    shows z . showChar ')'
+
+instance Show a => Show [a]  where
+    showsPrec p      = showList
+
+
+instance Show Bool where
+    showsPrec d (False) = showString "False"
+    showsPrec d (True) = showString "True"
+
+
+instance Show Ordering where
+    showsPrec d (LT) = showString "LT"
+    showsPrec d (EQ) = showString "EQ"
+    showsPrec d (GT) = showString "GT"
+
+
diff --git a/lib/base/src/Lhc/String.hs b/lib/base/src/Lhc/String.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/String.hs
@@ -0,0 +1,103 @@
+-- module for things dealing with string constants needed by the compiler internally
+{-# OPTIONS_LHC -N -fffi -funboxed-values #-}
+module Lhc.String(
+    eqString,
+    eqUnpackedString,
+    unpackStringFoldr,
+    eqSingleChar,
+    unpackString
+    )where
+
+
+import Lhc.Prim
+
+-- TODO make it handle full UTF8
+
+{-# VCONSTRUCTOR unpackString #-}
+{-# NOINLINE unpackString #-}
+unpackString :: Addr__ -> [Char]
+unpackString addr = f addr where
+    f addr = case constPeekByte addr of
+        0# -> []
+        c -> (Char c:f (increment addr))
+
+{-
+unpackFoldrString :: Addr__ -> (Char__ -> b -> b) -> b -> b
+unpackFoldrString addr f e = unpack addr where
+    unpack addr = case constPeekByte addr of
+      '\NUL'# -> e
+      ch  | ch `leChar__` '\x7F'# = ch `f` unpack (increment addr)
+          | ch `leChar__` '\xDF'# = (((ch .&. '\x1f') `shiftL` 6#) .|. (constPeekByte (increment addr) .&. '\x3f')) `f` unpack (increment (increment addr))
+           (chr# (((ord# ch                                  -# 0xC0#) `uncheckedIShiftL#`  6#) +#
+                     (ord# (indexCharArray# addr (nh +# 1#)) -# 0x80#))) `f`
+          unpack (nh +# 2#)
+      | ch `leChar#` '\xEF'# =
+           (chr# (((ord# ch                                  -# 0xE0#) `uncheckedIShiftL#` 12#) +#
+                    ((ord# (indexCharArray# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#
+                     (ord# (indexCharArray# addr (nh +# 2#)) -# 0x80#))) `f`
+          unpack (nh +# 3#)
+      | otherwise            =
+           (chr# (((ord# ch                                  -# 0xF0#) `uncheckedIShiftL#` 18#) +#
+                    ((ord# (indexCharArray# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12#) +#
+                    ((ord# (indexCharArray# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#`  6#) +#
+                     (ord# (indexCharArray# addr (nh +# 3#)) -# 0x80#))) `f`
+          unpack (nh +# 4#)
+      where
+	ch = indexCharArray# addr nh
+
+-}
+
+unpackStringFoldr :: Addr__ -> (Char -> b -> b) -> b -> b
+unpackStringFoldr addr cons nil = f addr where
+    f addr = case constPeekByte addr of
+        0# -> nil
+        c -> (Char c `cons` f (increment addr))
+
+{-# NOINLINE eqUnpackedString #-}
+eqUnpackedString :: Addr__ -> [Char] -> Bool__
+eqUnpackedString addr cs = f addr cs where
+    f :: Addr__ -> [Char] -> Bool__
+    f offset [] = case constPeekByte offset of 0# -> 1#; _ -> 0#
+    f offset (Char c:cs) = case constPeekByte offset of
+        0# -> 0#
+        uc -> case equalsChar uc c of
+            0# -> 0#
+            1# -> f (increment offset) cs
+
+eqSingleChar :: Char__ -> [Char] -> Bool__
+eqSingleChar ch (Char c:cs) = case equalsChar ch c of
+    0# -> 0#
+    1# -> case cs of
+        [] -> 1#
+        _ -> 0#
+
+
+{-# NOINLINE eqUnpacked #-}
+eqUnpacked :: Addr__ -> [Char] -> Bool__
+eqUnpacked addr cs = f addr cs where
+    f :: Addr__ -> [Char] -> Bool__
+    f offset [] = case constPeekByte offset of 0# -> 1#; _ -> 0#
+    f offset (Char c:cs) = case constPeekByte offset of
+        0# -> 0#
+        uc -> case equalsChar uc c of
+            0# -> 0#
+            1# -> f (increment offset) cs
+
+-- returns it in an Char__ even though it is just a byte
+foreign import primitive constPeekByte :: Addr__ -> Char__
+
+
+eqString :: [Char] -> [Char] -> Bool__
+eqString [] [] = 1#
+eqString (Char x:xs) (Char y:ys) = case equalsChar x y of
+    0# -> 0#
+    1# -> eqString xs ys
+eqString _ _ = 0#
+
+foreign import primitive increment :: Addr__ -> Addr__
+foreign import primitive "Eq" equalsChar :: Char__ -> Char__ -> Bool__
+
+
+
+
+
diff --git a/lib/base/src/Lhc/Text/Read.hs b/lib/base/src/Lhc/Text/Read.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Text/Read.hs
@@ -0,0 +1,122 @@
+{-# OPTIONS_LHC -N #-}
+module Lhc.Text.Read where
+
+import Lhc.Basics
+import Lhc.Order
+import Lhc.Int
+import Lhc.List
+import Prelude.CType
+
+type  ReadS a  = String -> [(a,String)]
+
+class  Read a  where
+    readsPrec        :: Int -> ReadS a
+    readList         :: ReadS [a]
+
+        -- Minimal complete definition:
+        --      readsPrec
+    readList         = readParen False (\r -> [pr | ("[",s)  <- lex r,
+                                                    pr       <- readl s])
+                       where readl  s = [([],t)   | ("]",t)  <- lex s] ++
+                                        [(x:xs,u) | (x,t)    <- reads s,
+                                                    (xs,u)   <- readl' t]
+                             readl' s = [([],t)   | ("]",t)  <- lex s] ++
+                                        [(x:xs,v) | (",",t)  <- lex s,
+                                                    (x,u)    <- reads t,
+                                                    (xs,v)   <- readl' u]
+
+reads            :: (Read a) => ReadS a
+reads            =  readsPrec zero
+
+readParen        :: Bool -> ReadS a -> ReadS a
+readParen b g    =  if b then mandatory else optional
+                    where optional r  = g r ++ mandatory r
+                          mandatory r = [(x,u) | ("(",s) <- lex r,
+                                                 (x,t)   <- optional s,
+                                                 (")",u) <- lex t    ]
+
+
+-- This lexer is not completely faithful to the Haskell lexical syntax.
+-- Current limitations:
+--    Qualified names are not handled properly
+--    Octal and hexidecimal numerics are not recognized as a single token
+--    Comments are not treated properly
+
+lex              :: ReadS String
+lex ""           =  [("","")]
+lex (c:s)
+   | isSpace c   =  lex (dropWhile isSpace s)
+lex ('\'':s)     =  [('\'':ch++"'", t) | (ch,'\'':t)  <- lexLitChar s,
+                                         ch /= "'" ]
+lex ('"':s)      =  [('"':str, t)      | (str,t) <- lexString s]
+                    where
+                    lexString ('"':s) = [("\"",s)]
+                    lexString s = [(ch++str, u)
+                                         | (ch,t)  <- lexStrItem s,
+                                           (str,u) <- lexString t  ]
+
+                    lexStrItem ('\\':('&':s)) =  [("\\&",s)]
+                    lexStrItem ('\\':(c:s)) | isSpace c
+                                           =  [("\\&",t) |
+                                               '\\':t <-
+                                                   [dropWhile isSpace s]]
+                    lexStrItem s           =  lexLitChar s
+
+lex (c:s) | isSingle c = [([c],s)]
+          | isSym c    = [(c:sym,t)       | (sym,t) <- [span isSym s]]
+          | isAlpha c  = [(c:nam,t)       | (nam,t) <- [span isIdChar s]]
+          | isDigit c  = [(c:(ds++fe),t)  | (ds,s')  <- [span isDigit s],
+                                            (fe,t)  <- lexFracExp s'     ]
+          | otherwise  = []    -- bad character
+             where
+              isSingle c =  c `elem` ",;()[]{}_`"
+              isSym c    =  c `elem` "!@#$%&*+./<=>?\\^|:-~"
+              isIdChar c =  isAlphaNum c || c `elem` "_'"
+
+              lexFracExp ('.':(c:cs)) | isDigit c
+                            = [('.':ds++e,u) | (ds,t) <- lexDigits (c:cs),
+                                               (e,u)  <- lexExp t]
+              lexFracExp s  = lexExp s
+
+              lexExp (e:s) | e `elem` "eE"
+                       = [(e:c:ds,u) | (c:t)  <- [s], c `elem` "+-",
+                                                 (ds,u) <- lexDigits t] ++
+                         [(e:ds,t)   | (ds,t) <- lexDigits s]
+              lexExp s = [("",s)]
+
+asciiTab :: [String]
+asciiTab = --listArray ('\NUL', ' ')
+           ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
+            "BS",  "HT",  "LF",  "VT",  "FF",  "CR",  "SO",  "SI",
+            "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
+            "CAN", "EM",  "SUB", "ESC", "FS",  "GS",  "RS",  "US",
+            "SP"]
+
+lexLitChar          :: ReadS String
+lexLitChar ('\\':s) =  map (prefix '\\') (lexEsc s)
+        where
+          lexEsc :: String -> [(String,String)]
+          lexEsc (c:s)     | c `elem` "abfnrtv\\\"'"  = [([c],s)]
+          lexEsc ('^':(c:s)) | (c >= '@') && (c <= '_') = [(['^',c],s)]
+
+          -- Numeric escapes
+          lexEsc ('o':s)               = [prefix 'o' (span isOctDigit s)]
+          lexEsc ('x':s)               = [prefix 'x' (span isHexDigit s)]
+          lexEsc s@(d:_)   | isDigit d = [span isDigit s]
+
+          -- Very crude approximation to \XYZ.
+          lexEsc s@(c:_)   | isUpper c = [span isCharName s]
+          lexEsc _                     = []
+
+          isCharName c   = isUpper c || isDigit c
+          prefix c (t,s) = (c:t, s)
+
+lexLitChar (c:s)    =  [([c],s)]
+lexLitChar ""       =  []
+
+lexDigits        :: ReadS String
+lexDigits        =  nonnull isDigit
+
+nonnull          :: (Char -> Bool) -> ReadS String
+nonnull p s      =  [(cs,t) | (cs@(_:_),t) <- [span p s]]
+
diff --git a/lib/base/src/Lhc/Tuples.hs b/lib/base/src/Lhc/Tuples.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Tuples.hs
@@ -0,0 +1,115 @@
+{-# OPTIONS_LHC -N #-}
+
+-- | A place to collect the tuple instances.
+
+module Lhc.Tuples where
+
+import Lhc.Basics
+import Lhc.Show
+import Lhc.Order
+import Lhc.List
+import Lhc.Text.Read
+
+
+{- TUPGEN!
+
+instance (#Tup Eq #t) => Eq (#Tup #t) where
+    (#Tup #x) == (#Tup #y) = and [#List #x == #y]
+    (#Tup #x) /= (#Tup #y) = or [#List #x /= #y]
+
+-}
+
+
+
+instance (Ord a, Ord b) => Ord (a,b) where
+    compare (x,y) (a,b) = case compare x a of
+        EQ -> compare y b
+        z -> z
+
+--instance (Eq a, Eq b) => Eq (a,b) where
+--    (x,y) == (a,b) = x == a && y == b
+
+
+
+
+instance  (Read a, Read b) => Read (a,b)  where
+    readsPrec p       = readParen False
+                            (\r -> [((x,y), w) | ("(",s) <- lex r,
+                                                 (x,t)   <- reads s,
+                                                 (",",u) <- lex t,
+                                                 (y,v)   <- reads u,
+                                                 (")",w) <- lex v ] )
+
+instance  (Read a, Read b, Read c) => Read (a,b,c)  where
+    readsPrec p       = readParen False
+                            (\r -> [((x,y,z), w) | ("(",s) <- lex r,
+                                                 (x,t)   <- reads s,
+                                                 (",",u) <- lex t,
+                                                 (y,v)   <- reads u,
+                                                 (",",w) <- lex v,
+                                                 (z,p)   <- reads w,
+                                                 (")",w) <- lex p ] )
+
+
+
+instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
+    showsPrec _ (w,x,y,z) s = (showChar '(' . shows w . showChar ',' .
+                                              shows x . showChar ',' .
+                                              shows y . showChar ',' .
+                                              shows z . showChar ')')
+                              s
+
+instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
+    showsPrec _ (v,w,x,y,z) s = (showChar '(' . shows v . showChar ',' .
+                                                shows w . showChar ',' .
+                                                shows x . showChar ',' .
+                                                shows y . showChar ',' .
+                                                shows z . showChar ')')
+                                    s
+
+instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a, b, c, d, e, f) where
+    showsPrec _ (v,w,x,y,z,a) s = (showChar '(' . shows v . showChar ',' .
+                                                  shows w . showChar ',' .
+                                                  shows x . showChar ',' .
+                                                  shows y . showChar ',' .
+                                                  shows z . showChar ',' .
+                                                  shows a . showChar ')')
+                                    s
+
+
+-- tupgen 2
+
+instance (Eq t1,Eq t2) => Eq (t1,t2) where
+    (x1,x2) == (y1,y2) = and [x1 == y1,x2 == y2]
+    (x1,x2) /= (y1,y2) = or [x1 /= y1,x2 /= y2]
+
+-- tupgen 3
+
+instance (Eq t1,Eq t2,Eq t3) => Eq (t1,t2,t3) where
+    (x1,x2,x3) == (y1,y2,y3) = and [x1 == y1,x2 == y2,x3 == y3]
+    (x1,x2,x3) /= (y1,y2,y3) = or [x1 /= y1,x2 /= y2,x3 /= y3]
+
+-- tupgen 4
+
+instance (Eq t1,Eq t2,Eq t3,Eq t4) => Eq (t1,t2,t3,t4) where
+    (x1,x2,x3,x4) == (y1,y2,y3,y4) = and [x1 == y1,x2 == y2,x3 == y3,x4 == y4]
+    (x1,x2,x3,x4) /= (y1,y2,y3,y4) = or [x1 /= y1,x2 /= y2,x3 /= y3,x4 /= y4]
+
+-- tupgen 5
+
+instance (Eq t1,Eq t2,Eq t3,Eq t4,Eq t5) => Eq (t1,t2,t3,t4,t5) where
+    (x1,x2,x3,x4,x5) == (y1,y2,y3,y4,y5) = and [x1 == y1,x2 == y2,x3 == y3,x4 == y4,x5 == y5]
+    (x1,x2,x3,x4,x5) /= (y1,y2,y3,y4,y5) = or [x1 /= y1,x2 /= y2,x3 /= y3,x4 /= y4,x5 /= y5]
+
+-- tupgen 6
+
+instance (Eq t1,Eq t2,Eq t3,Eq t4,Eq t5,Eq t6) => Eq (t1,t2,t3,t4,t5,t6) where
+    (x1,x2,x3,x4,x5,x6) == (y1,y2,y3,y4,y5,y6) = and [x1 == y1,x2 == y2,x3 == y3,x4 == y4,x5 == y5,x6 == y6]
+    (x1,x2,x3,x4,x5,x6) /= (y1,y2,y3,y4,y5,y6) = or [x1 /= y1,x2 /= y2,x3 /= y3,x4 /= y4,x5 /= y5,x6 /= y6]
+
+-- tupgen 7
+
+instance (Eq t1,Eq t2,Eq t3,Eq t4,Eq t5,Eq t6,Eq t7) => Eq (t1,t2,t3,t4,t5,t6,t7) where
+    (x1,x2,x3,x4,x5,x6,x7) == (y1,y2,y3,y4,y5,y6,y7) = and [x1 == y1,x2 == y2,x3 == y3,x4 == y4,x5 == y5,x6 == y6,x7 == y7]
+    (x1,x2,x3,x4,x5,x6,x7) /= (y1,y2,y3,y4,y5,y6,y7) = or [x1 /= y1,x2 /= y2,x3 /= y3,x4 /= y4,x5 /= y5,x6 /= y6,x7 /= y7]
+
diff --git a/lib/base/src/Lhc/Types.hs b/lib/base/src/Lhc/Types.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Lhc/Types.hs
@@ -0,0 +1,17 @@
+{-# OPTIONS_LHC -N  #-}
+module Lhc.Types where
+
+data Bits1_ :: #
+
+data Bits8_   :: #
+data Bits16_  :: #
+data Bits32_  :: #
+data Bits64_  :: #
+data Bits128_ :: #
+data BitsPtr_ :: #
+data BitsMax_ :: #
+
+data Float32_ :: #
+data Float64_ :: #
+data Float80_ :: #
+data Float128_ :: #
diff --git a/lib/base/src/Numeric.hs b/lib/base/src/Numeric.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Numeric.hs
@@ -0,0 +1,360 @@
+module Numeric(fromRat,
+               showSigned, showIntAtBase,
+               showInt, showOct, showHex,
+               readSigned, readInt,
+               readDec, readOct, readHex,
+               floatToDigits,
+               showEFloat, showFFloat, showGFloat, showFloat,
+               readFloat, lexDigits) where
+
+import Data.Word
+import Prelude.CType   ( isDigit, isOctDigit, isHexDigit
+                   , digitToInt, intToDigit )
+import Data.Ratio  ( (%), numerator, denominator )
+--import Array  ( (!), Array, array )
+import Prelude.Text
+import Lhc.Text.Read
+
+-- This converts a rational to a floating.  This should be used in the
+-- Fractional instances of Float and Double.
+
+fromRat :: (RealFloat a) => Rational -> a
+fromRat = error "fromRat not implemented yet"
+
+{-
+fromRat :: (RealFloat a) => Rational -> a
+fromRat x =
+    if x == 0 then encodeFloat 0 0              -- Handle exceptional cases
+    else if x < 0 then - fromRat' (-x)          -- first.
+    else fromRat' x
+
+-- Conversion process:
+-- Scale the rational number by the RealFloat base until
+-- it lies in the range of the mantissa (as used by decodeFloat/encodeFloat).
+-- Then round the rational to an Integer and encode it with the exponent
+-- that we got from the scaling.
+-- To speed up the scaling process we compute the log2 of the number to get
+-- a first guess of the exponent.
+fromRat' :: (RealFloat a) => Rational ->  a
+fromRat' x = fromRat'' x undefined
+
+fromRat'' :: (RealFloat a) => Rational -> a -> a
+fromRat'' x _x = r
+  where b = floatRadix r
+        p = floatDigits r
+        (minExp0, _) = floatRange r
+        minExp = minExp0 - p            -- the real minimum exponent
+        xMin = toRational (expt b (p-1))
+        xMax = toRational (expt b p)
+        p0 = (integerLogBase b (numerator x) -
+              integerLogBase b (denominator x) - p) `max` minExp
+        f = if p0 < 0 then 1 % expt b (-p0) else expt b p0 % 1
+        (x', p') = scaleRat (toRational b) minExp xMin xMax p0 (x / f)
+        r = encodeFloat (round x') p' `asTypeOf` _x
+
+-- Scale x until xMin <= x < xMax, or p (the exponent) <= minExp.
+scaleRat :: Rational -> Int -> Rational -> Rational ->
+             Int -> Rational -> (Rational, Int)
+scaleRat b minExp xMin xMax p x =
+    if p <= minExp then
+        (x, p)
+    else if x >= xMax then
+        scaleRat b minExp xMin xMax (p+1) (x/b)
+    else if x < xMin  then
+        scaleRat b minExp xMin xMax (p-1) (x*b)
+    else
+        (x, p)
+        -}
+-- Exponentiation with a cache for the most common numbers.
+minExpt = 0::Int
+maxExpt = 1100::Int
+expt :: Integer -> Int -> Integer
+expt base n = base^n
+{-
+expt base n =
+    if base == 2 && n >= minExpt && n <= maxExpt then
+        expts!n
+    else
+        base^n
+
+expts :: Array Int Integer
+expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]
+-}
+
+-- Compute the (floor of the) log of i in base b.
+-- Simplest way would be just divide i by b until it's smaller then b,
+-- but that would be very slow!  We are just slightly more clever.
+integerLogBase :: Integer -> Integer -> Int
+integerLogBase b i =
+     if i < b then
+        0
+     else
+        -- Try squaring the base first to cut down the number of divisions.
+        let l = 2 * integerLogBase (b*b) i
+            doDiv :: Integer -> Int -> Int
+            doDiv i l = if i < b then l else doDiv (i `div` b) (l+1)
+        in  doDiv (i `div` (b^l)) l
+
+
+-- Misc utilities to show integers and floats
+{-# SPECIALIZE showSigned :: (Int -> ShowS) -> Int -> Int -> ShowS #-}
+{-# SPECIALIZE showSigned :: (Integer -> ShowS) -> Int -> Integer -> ShowS #-}
+
+showSigned :: Real a => (a -> ShowS) -> Int -> a -> ShowS
+showSigned showPos p x
+  | x < 0     = showParen (p > 6) (showChar '-' . showPos (negate x))
+  | otherwise = showPos x
+
+{-# INLINE showInt #-}
+
+-- showInt, showOct, showHex are used for positive numbers only
+showInt, showOct, showHex :: Integral a => a -> ShowS
+showOct = showIntAtBase  8 intToDigit
+showInt = showIntAtBase 10 intToDigit
+showHex = showIntAtBase 16 intToDigit
+
+{-# SPECIALIZE showIntAtBase :: Word -> (Int -> Char) -> Word -> ShowS #-}
+{-# SPECIALIZE showIntAtBase :: WordMax -> (Int -> Char) -> WordMax -> ShowS #-}
+
+
+showIntAtBase :: Integral a
+	      => a              -- base
+	      -> (Int -> Char)  -- digit to char
+	      -> a              -- number to show
+	      -> ShowS
+showIntAtBase base intToDig n rest
+  | n < 0     = error $ "Numeric.showIntAtBase: can't show negative numbers " ++ show n
+  | n' == 0   = rest'
+  | otherwise = showIntAtBase base intToDig n' rest'
+  where
+    (n',d) = quotRem n base
+    rest'  = intToDig (fromIntegral d) : rest
+
+
+readSigned :: (Real a) => ReadS a -> ReadS a
+readSigned readPos = readParen False read'
+                     where read' r  = read'' r ++
+                                      [(-x,t) | ("-",s) <- lex r,
+                                                (x,t)   <- read'' s]
+                           read'' r = [(n,s)  | (str,s) <- lex r,
+                                                (n,"")  <- readPos str]
+
+
+-- readInt reads a string of digits using an arbitrary base.
+-- Leading minus signs must be handled elsewhere.
+
+{-# SPECIALIZE readInt :: Int -> (Char -> Bool) -> (Char -> Int) -> ReadS Int #-}
+{-# SPECIALIZE readInt :: Integer -> (Char -> Bool) -> (Char -> Int) -> ReadS Integer #-}
+
+readInt :: (Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
+readInt radix isDig digToInt s =
+   [(foldl1 (\n d -> n * radix + d) (map (fromIntegral . digToInt) ds), r)
+          | (ds,r) <- nonnull isDig s ]
+
+-- Unsigned readers for various bases
+readDec, readOct, readHex :: (Integral a) => ReadS a
+readDec = readInt 10 isDigit    digitToInt
+readOct = readInt  8 isOctDigit digitToInt
+readHex = readInt 16 isHexDigit digitToInt
+
+
+showEFloat     :: (RealFloat a) => Maybe Int -> a -> ShowS
+showFFloat     :: (RealFloat a) => Maybe Int -> a -> ShowS
+showGFloat     :: (RealFloat a) => Maybe Int -> a -> ShowS
+showFloat      :: (RealFloat a) => a -> ShowS
+
+showEFloat d x =  showString (formatRealFloat FFExponent d x)
+showFFloat d x =  showString (formatRealFloat FFFixed d x)
+showGFloat d x =  showString (formatRealFloat FFGeneric d x)
+showFloat      =  showGFloat Nothing
+
+-- These are the format types.  This type is not exported.
+
+data FFFormat = FFExponent | FFFixed | FFGeneric
+
+formatRealFloat :: (RealFloat a) => FFFormat -> Maybe Int -> a -> String
+formatRealFloat fmt decs x
+  = s
+  where
+    base = 10
+    s = if isNaN x then
+            "NaN"
+        else if isInfinite x then
+            if x < 0 then "-Infinity" else "Infinity"
+        else if x < 0 || isNegativeZero x then
+            '-' : doFmt fmt (floatToDigits (toInteger base) (-x))
+        else
+            doFmt fmt (floatToDigits (toInteger base) x)
+
+    doFmt fmt (is, e)
+      = let
+           ds = map intToDigit is
+        in
+        case fmt of
+          FFGeneric ->
+              doFmt (if e < 0 || e > 7 then FFExponent else FFFixed)
+                    (is, e)
+          FFExponent ->
+            case decs of
+              Nothing ->
+                case ds of
+                   []    -> "0.0e0"
+                   [d]   -> d : ".0e" ++ show (e-1)
+                   d:ds  -> d : '.' : ds ++ 'e':show (e-1)
+
+              Just dec ->
+                let dec' = max dec 1 in
+                case is of
+                  [] -> '0':'.':take dec' (repeat '0') ++ "e0"
+                  _ ->
+                    let (ei, is') = roundTo base (dec'+1) is
+                        d:ds = map intToDigit
+                                   (if ei > 0 then init is' else is')
+                    in d:'.':ds  ++ "e" ++ show (e-1+ei)
+
+          FFFixed ->
+            case decs of
+               Nothing 	-- Always prints a decimal point
+                 | e > 0     -> take e (ds ++ repeat '0')
+                                ++ '.' : mk0 (drop e ds)
+                 | otherwise -> "0." ++ mk0 (replicate (-e) '0' ++ ds)
+
+               Just dec ->  -- Print decimal point iff dec > 0
+                 let dec' = max dec 0 in
+                 if e >= 0 then
+                   let (ei, is') = roundTo base (dec' + e) is
+                       (ls, rs)  = splitAt (e+ei)
+                                              (map intToDigit is')
+                   in  mk0 ls ++ mkdot0 rs
+                 else
+                   let (ei, is') = roundTo base dec'
+                                           (replicate (-e) 0 ++ is)
+                       d : ds = map intToDigit
+                                    (if ei > 0 then is' else 0:is')
+                   in  d : mkdot0 ds
+            where
+              mk0 "" = "0"        -- Print 0.34, not .34
+              mk0 s  = s
+
+              mkdot0 "" = ""       -- Print 34, not 34.
+              mkdot0 s  = '.' : s  -- when the format specifies no
+			           -- digits after the decimal point
+
+
+roundTo :: Int -> Int -> [Int] -> (Int, [Int])
+roundTo base d is | base `seq` d `seq` True = case f d is of
+                (0, is) -> (0, is)
+                (1, is) -> (1, 1 : is)
+  where b2 = base `div` 2
+        f n [] = (0, replicate n 0)
+        f 0 (i:_) = (if i >= b2 then 1 else 0, [])
+        f d (i:is) =
+            let (c, ds) = f (d-1) is
+                i' = c + i
+            in  if i' == base then (1, 0:ds) else (0, i':ds)
+
+--
+-- Based on "Printing Floating-Point Numbers Quickly and Accurately"
+-- by R.G. Burger and R. K. Dybvig, in PLDI 96.
+-- The version here uses a much slower logarithm estimator.
+-- It should be improved.
+
+-- This function returns a non-empty list of digits (Ints in [0..base-1])
+-- and an exponent.  In general, if
+--      floatToDigits r = ([a, b, ... z], e)
+-- then
+--      r = 0.ab..z * base^e
+--
+
+floatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int)
+
+floatToDigits _ 0 = ([], 0)
+floatToDigits base x =
+    let (f0, e0) = decodeFloat x
+        (minExp0, _) = floatRange x
+        p = floatDigits x
+        b = floatRadix x
+        minExp = minExp0 - p            -- the real minimum exponent
+
+        -- Haskell requires that f be adjusted so denormalized numbers
+        -- will have an impossibly low exponent.  Adjust for this.
+        f :: Integer
+        e :: Int
+        (f, e) = let n = minExp - e0
+                 in  if n > 0 then (f0 `div` (b^n), e0+n) else (f0, e0)
+
+        (r, s, mUp, mDn) =
+           if e >= 0 then
+               let be = b^e in
+               if f == b^(p-1) then
+                   (f*be*b*2, 2*b, be*b, b)
+               else
+                   (f*be*2, 2, be, be)
+           else
+               if e > minExp && f == b^(p-1) then
+                   (f*b*2, b^(-e+1)*2, b, 1)
+               else
+                   (f*2, b^(-e)*2, 1, 1)
+        k =
+            let k0 =
+                    if b==2 && base==10 then
+                        -- logBase 10 2 is slightly bigger than 3/10 so
+                        -- the following will err on the low side.  Ignoring
+                        -- the fraction will make it err even more.
+                        -- Haskell promises that p-1 <= logBase b f < p.
+                        (p - 1 + e0) * 3 `div` 10
+                    else
+                        ceiling ((log ((fromInteger (f+1))::Double) +
+                                 fromIntegral e * log (fromInteger b)) /
+                                  log (fromInteger base))
+                fixup n =
+                    if n >= 0 then
+                        if r + mUp <= expt base n * s then n else fixup (n+1)
+                    else
+                        if expt base (-n) * (r + mUp) <= s then n
+                                                           else fixup (n+1)
+            in  fixup (k0::Int)
+
+        gen ds rn sN mUpN mDnN =
+            let (dn, rn') = (rn * base) `divMod` sN
+                mUpN' = mUpN * base
+                mDnN' = mDnN * base
+            in  case (rn' < mDnN', rn' + mUpN' > sN) of
+                (True,  False) -> dn : ds
+                (False, True)  -> dn+1 : ds
+                (True,  True)  -> if rn' * 2 < sN then dn : ds else dn+1 : ds
+                (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'
+        rds =
+            if k >= 0 then
+                gen [] r (s * expt base k) mUp mDn
+            else
+                let bk = expt base (-k)
+                in  gen [] (r * bk) s (mUp * bk) (mDn * bk)
+    in  (map fromIntegral (reverse rds), k)
+
+
+
+-- This floating point reader uses a less restrictive syntax for floating
+-- point than the Haskell lexer.  The `.' is optional.
+
+readFloat     :: (RealFrac a) => ReadS a
+readFloat r    = [(fromRational ((n%1)*10^^(k-d)),t) | (n,d,s) <- readFix r,
+                                                       (k,t)   <- readExp s] ++
+                 [ (0/0, t) | ("NaN",t)      <- lex r] ++
+                 [ (1/0, t) | ("Infinity",t) <- lex r]
+               where
+                 readFix r = [(read (ds++ds'), length ds', t)
+                             | (ds,d) <- lexDigits r,
+                               (ds',t) <- lexFrac d ]
+
+                 lexFrac ('.':ds) = lexDigits ds
+                 lexFrac s        = [("",s)]
+
+                 readExp (e:s) | e `elem` "eE" = readExp' s
+                 readExp s                     = [(0,s)]
+
+                 readExp' ('-':s) = [(-k,t) | (k,t) <- readDec s]
+                 readExp' ('+':s) = readDec s
+                 readExp' s       = readDec s
+
+
diff --git a/lib/base/src/Prelude.hs b/lib/base/src/Prelude.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Prelude.hs
@@ -0,0 +1,416 @@
+{-# OPTIONS_LHC -funboxed-tuples #-}
+module Prelude(
+    -- export everything here
+    module Prelude,
+    -- export types from elsewhere
+    IO(),
+    IOError(),
+    Rational(),
+    -- functions from elsewhere
+    putStr,
+    putStrLn,
+    error,
+    concatMap,
+    concat,
+    any,
+    all,
+    subtract,
+    even,
+    odd,
+    foldr,
+    and,
+    filter,
+    or,
+    length,
+    null,
+    head,
+    tail,
+    last,
+    init,
+    takeWhile,
+    dropWhile,
+    span,
+    break,
+    (!!),
+    Maybe(Just,Nothing),
+    maybe,
+    sequence,
+    sequence_,
+    -- submodules
+    module Lhc.Basics,
+    module Lhc.Float,
+    module Lhc.Enum,
+    module Lhc.Order,
+    module Lhc.Show,
+    Num(..),
+    fromIntegral,
+    elem,notElem,
+    realToFrac,
+    Real(..),
+    Integral(..),
+    Fractional(..),
+    Floating(..),
+    RealFrac(properFraction,truncate,round,ceiling,floor),
+    RealFloat(..),
+    module Lhc.Monad,
+    Int(),
+
+    module Prelude.IO,
+    module Prelude.Text
+    ) where
+
+
+import Lhc.Basics
+import Lhc.Float
+import Data.Int(Int())
+
+import Lhc.Inst.Enum
+import Lhc.Inst.Read
+import Lhc.Inst.Show
+import Lhc.Inst.Storable
+
+import Data.Ratio
+import Lhc.Enum
+import Lhc.IO
+import Lhc.List
+import Lhc.Monad
+import Lhc.Num
+import Lhc.Order
+import Lhc.Show
+import Lhc.Maybe
+import Lhc.Tuples
+import Prelude.Float
+import Prelude.IO
+import Prelude.IOError
+import Prelude.Text
+import qualified Data.Char as Char(isSpace,ord,chr)
+
+
+
+-- infixr 9  .
+--infixr 8  ^, ^^, **
+infixr 8  ^, ^^
+--infixl 7  *  , /, `quot`, `rem`, `div`, `mod`
+--infixl 6  +, -
+--infixr 5  :
+--infix  4  ==, /=, <, <=, >=, >
+--infixr 3  &&
+--infixr 2  ||
+--infixl 1  >>, >>=
+--infixr 1  =<<
+-- infixr 0  $, $!, `seq`
+
+
+
+-- Numeric functions
+
+
+
+
+{-# SPECIALIZE gcd :: Int -> Int -> Int #-}
+{-# SPECIALIZE gcd :: Integer -> Integer -> Integer #-}
+gcd              :: (Integral a) => a -> a -> a
+gcd 0 0          =  error "Prelude.gcd: gcd 0 0 is undefined"
+gcd x y          =  gcd' (abs x) (abs y)
+                    where gcd' x 0  =  x
+                          gcd' x y  =  gcd' y (x `rem` y)
+
+
+{-# SPECIALIZE lcm :: Int -> Int -> Int #-}
+{-# SPECIALIZE lcm :: Integer -> Integer -> Integer #-}
+lcm              :: (Integral a) => a -> a -> a
+lcm _ 0          =  0
+lcm 0 _          =  0
+lcm x y          =  abs ((x `quot` (gcd x y)) * y)
+
+
+{-# SPECIALIZE (^) :: Int -> Int -> Int #-}
+{-# SPECIALIZE (^) :: Integer -> Int -> Integer #-}
+{-# SPECIALIZE (^) :: Double -> Int -> Double #-}
+
+(^)              :: (Num a, Integral b) => a -> b -> a
+x ^ 0            =  1
+x ^ n | n > 0    =  f x (n-1) x
+                    where f _ 0 y = y
+                          f x n y = g x n  where
+                                    g x n | even n  = g (x*x) (n `quot` 2)
+                                          | otherwise = f x (n-1) (x*y)
+_ ^ _            = error "Prelude.^: negative exponent"
+
+
+(^^)             :: (Fractional a, Integral b) => a -> b -> a
+x ^^ n           =  if n >= 0 then x^n else recip (x^(-n))
+
+
+
+
+
+
+
+
+
+data Either a b = Left a | Right b
+    deriving (Eq, Ord, Read, Show)
+
+either :: (a -> c) -> (b -> c) -> Either a b -> c
+either f g (Left x)  =  f x
+either f g (Right y) =  g y
+
+
+
+until            :: (a -> Bool) -> (a -> a) -> a -> a
+until p f x
+     | p x       =  x
+     | otherwise =  until p f (f x)
+
+
+
+
+
+
+
+-- foldl, applied to a binary operator, a starting value (typically the
+-- left-identity of the operator), and a list, reduces the list using
+-- the binary operator, from left to right:
+--  foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn
+-- foldl1 is a variant that has no starting value argument, and  thus must
+-- be applied to non-empty lists.  scanl is similar to foldl, but returns
+-- a list of successive reduced values from the left:
+--      scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
+-- Note that  last (scanl f z xs) == foldl f z xs.
+-- scanl1 is similar, again without the starting element:
+--      scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
+
+
+
+
+foldl1           :: (a -> a -> a) -> [a] -> a
+foldl1 f (x:xs)  =  foldl f x xs
+foldl1 _ []      =  error "Prelude.foldl1: empty list"
+
+
+
+scanl1           :: (a -> a -> a) -> [a] -> [a]
+scanl1 f (x:xs)  =  scanl f x xs
+scanl1 _ []      =  []
+
+-- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the
+-- above functions.
+
+
+--foldr :: (a -> b -> b) -> b -> [a] -> b
+--foldr k z [] = z
+--foldr k z (x:xs) = k x (foldr k z xs)
+
+
+foldr1           :: (a -> a -> a) -> [a] -> a
+foldr1 f [x]     =  x
+foldr1 f (x:xs)  =  f x (foldr1 f xs)
+foldr1 _ []      =  error "Prelude.foldr1: empty list"
+
+
+scanr             :: (a -> b -> b) -> b -> [a] -> [b]
+scanr f q0 []     =  [q0]
+scanr f q0 (x:xs) =  f x q : qs where qs@(q:_) = scanr f q0 xs
+
+
+scanr1          :: (a -> a -> a) -> [a] -> [a]
+scanr1 f []     =  []
+scanr1 f [x]    =  [x]
+scanr1 f (x:xs) =  f x q : qs where qs@(q:_) = scanr1 f xs
+
+
+-- replicate n x is a list of length n with x the value of every element
+
+replicate        :: Int -> a -> [a]
+replicate n x    = f n where
+    f n | n <= 0 = []
+    f n = let n' = n - 1 in n' `seq` (x:f n')
+
+-- cycle ties a finite list into a circular one, or equivalently,
+-- the infinite repetition of the original list.  It is the identity
+-- on infinite lists.
+
+
+cycle            :: [a] -> [a]
+cycle []         =  error "Prelude.cycle: empty list"
+cycle xs         =  xs' where xs' = xs ++ xs'
+
+-- take n, applied to a list xs, returns the prefix of xs of length n,
+-- or xs itself if n > length xs.  drop n xs returns the suffix of xs
+-- after the first n elements, or [] if n > length xs.  splitAt n xs
+-- is equivalent to (take n xs, drop n xs).
+
+
+take :: Int -> [a] -> [a]
+take n xs = f n xs where
+    f n _      | n <= 0 =  []
+    f _ []              =  []
+    f n (x:xs)          =  x : f (n-1) xs
+
+
+drop :: Int -> [a] -> [a]
+drop n xs = f n xs where
+    f n xs | n <= 0 =  xs
+    f _ [] = []
+    f n (_:xs) = f (n-1) xs
+
+
+
+splitAt                  :: Int -> [a] -> ([a],[a])
+--splitAt n xs             =  (take n xs, drop n xs)
+splitAt n ls | n < 0	= ([], ls)
+splitAt n ls = splitAt' n ls where
+    splitAt' :: Int -> [a] -> ([a], [a])
+    splitAt' 0  xs  = ([], xs)
+    splitAt' _  []  = ([], [])
+    splitAt' m (x:xs) = case splitAt' (m - 1) xs of
+        (xs', xs'') -> (x:xs', xs'')
+
+-- lines breaks a string up into a list of strings at newline characters.
+-- The resulting strings do not contain newlines.  Similary, words
+-- breaks a string up into a list of words, which were delimited by
+-- white space.  unlines and unwords are the inverse operations.
+-- unlines joins lines with terminating newlines, and unwords joins
+-- words with separating spaces.
+
+
+lines            :: String -> [String]
+lines ""         =  []
+lines s          =  let (l, s') = break (== '\n') s
+                      in  l : case s' of
+                                []      -> []
+                                (_:s'') -> lines s''
+
+
+words            :: String -> [String]
+words s          =  case dropWhile Char.isSpace s of
+                      "" -> []
+                      s' -> w : words s''
+                            where (w, s'') = break Char.isSpace s'
+
+
+unlines          :: [String] -> String
+unlines [] = []
+unlines (l:ls) = l ++ '\n' : unlines ls
+--unlines          =  concatMap (++ "\n")
+
+
+unwords          :: [String] -> String
+unwords []		=  ""
+unwords [w]		= w
+unwords (w:ws)		= w ++ ' ' : unwords ws
+
+
+-- lookup key assocs looks up a key in an association list.
+
+{- SPECIALIZE lookup :: forall b . Char -> (Char,b) -> Maybe b #-}
+{- SPECIALIZE lookup :: forall b . Int -> (Int,b) -> Maybe b #-}
+
+lookup           :: (Eq a) => a -> [(a,b)] -> Maybe b
+lookup key []    =  Nothing
+lookup key ((x,y):xys)
+    | key == x   =  Just y
+    | otherwise  =  f x y xys where
+        f x y _ | key == x = Just y
+        f _ _ ((x,y):xys)  = f x y xys
+        f _ _ []           = Nothing
+
+-- sum and product compute the sum or product of a finite list of numbers.
+
+sum, product     :: (Num a) => [a] -> a
+--sum              =  foldl (+) 0
+--product          =  foldl (*) 1
+sum l	= sum' l 0 where
+    sum' []     a = a
+    sum' (x:xs) a = sum' xs (a+x)
+product	l = prod l 1 where
+    prod []     a = a
+    prod (x:xs) a = prod xs (a*x)
+
+-- maximum and minimum return the maximum or minimum value from a list,
+-- which must be non-empty, finite, and of an ordered type.
+
+maximum, minimum :: (Ord a) => [a] -> a
+maximum []       =  error "Prelude.maximum: empty list"
+maximum xs       =  foldl1 max xs
+
+minimum []       =  error "Prelude.minimum: empty list"
+minimum xs       =  foldl1 min xs
+
+
+zip3             :: [a] -> [b] -> [c] -> [(a,b,c)]
+zip3             =  zipWith3 (\a b c -> (a,b,c))
+
+
+
+zipWith3         :: (a->b->c->d) -> [a]->[b]->[c]->[d]
+zipWith3 z (a:as) (b:bs) (c:cs)
+                 =  z a b c : zipWith3 z as bs cs
+zipWith3 _ _ _ _ =  []
+
+
+-- unzip transforms a list of pairs into a pair of lists.
+
+
+unzip            :: [(a,b)] -> ([a],[b])
+unzip            =  foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])
+
+
+unzip3           :: [(a,b,c)] -> ([a],[b],[c])
+unzip3           =  foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
+                          ([],[],[])
+
+
+instance Real Integer where
+    toRational = fromInteger
+instance Real Int where
+    toRational = fromInt
+
+
+
+{-# RULES "drop/0"        forall . drop 0 = \xs -> xs #-}
+{-# RULES "drop/1"        forall x xs . drop 1 (x:xs) = xs #-}
+{-# RULES "drop/2"        forall x y xs . drop 2 (x:y:xs) = xs #-}
+{-# RULES "drop/3"        forall x y z xs . drop 3 (x:y:z:xs) = xs #-}
+{-# RULES "take/0"        forall xs . take 0 xs = [] #-}
+{-# RULES "take/1"        forall x xs . take 1 (x:xs) = [x] #-}
+{-# RULES "take/2"        forall x y xs . take 2 (x:y:xs) = [x,y] #-}
+{-# RULES "take/3"        forall x y z xs . take 3 (x:y:z:xs) = [x,y,z] #-}
+{-# RULES "!!/0"          forall x xs . (x:xs) !! 0 = x #-}
+{-# RULES "!!/1"          forall x y xs . (x:y:xs) !! 1 = y #-}
+{-# RULES "!!/2"          forall x y z xs . (x:y:z:xs) !! 2 = z #-}
+{-# RULES "concat/Map"    forall f xs . concat (map f xs) = concatMap f xs #-}
+{-# RULES "sequence/map"  forall f xs . sequence (map f xs) = mapM f xs #-}
+{-# RULES "sequence_/map" forall f xs . sequence_ (map f xs) = mapM_ f xs #-}
+{-# RULES "++/emptyr"     forall xs . xs ++ [] = xs #-}
+{-# RULES "++/refix"      forall xs ys zs . (xs ++ ys) ++ zs = xs ++ (ys ++ zs) #-}
+--{-# RULES "++/tick4"      forall x y z x' xs ys . (x:y:z:x':xs) ++ ys = x:y:z:x':(xs ++ ys) #-}
+--{-# RULES "++/tick2"      forall x y xs ys . (x:y:xs) ++ ys = x:y:(xs ++ ys) #-}
+--{-# RULES "++/tick1"      forall x xs ys . (x:xs) ++ ys = x:(xs ++ ys) #-}
+{-# RULES "++/tick0"      forall xs . [] ++ xs = xs #-}
+{-# RULES "++/tick1"      forall x xs . [x] ++ xs = x:xs #-}
+{-# RULES "++/tick2"      forall x y xs . [x,y] ++ xs = x:y:xs #-}
+{-# RULES "++/tick3"      forall x y z xs . [x,y,z] ++ xs = x:y:z:xs #-}
+{-# RULES "map/map"       forall f g xs . map f (map g xs) = map (\x -> f (g x)) xs #-}
+{-# RULES "concatMap/map" forall f g xs . concatMap f (map g xs) = concatMap (\x -> f (g x)) xs #-}
+{---# RULES "concat/tick"   forall x xs . concat (x:xs) = x ++ concat xs #-}
+{-# RULES "concat/[]"     concat [] = [] #-}
+{-# RULES "map/[]"        forall f . map f [] = [] #-}
+{-# RULES "concatMap/[]"  forall f . concatMap f [] = [] #-}
+{-# RULES "concatMap/++"  forall xs ys f . concatMap f (xs ++ ys) = concatMap f xs ++ concatMap f ys #-}
+{-# RULES "map/++"        forall xs ys f . map f (xs ++ ys) = map f xs ++ map f ys #-}
+
+{-# RULES "foldr/map" forall k z f xs . foldr k z (map f xs) = foldr (\x y -> k (f x) y) z xs #-}
+{-# RULES "foldr/concatMap" forall k z f xs . foldr k z (concatMap f xs) = foldr (\x y -> foldr k (f x) y) z xs #-}
+{-# RULES "foldr/filter" forall k z f xs . foldr k z (filter f xs) = foldr (\x y -> if f x then k x y else y) z xs #-}
+{-# RULES "foldr/++" forall k z xs ys . foldr k z (xs ++ ys) = foldr k (foldr k z ys) xs #-}
+{-# RULES "foldr/concat" forall k z xs . foldr k z (concat xs) = foldr (\x y -> foldr k y x) z xs #-}
+{-# RULES "foldr/repeat" forall k _z x . foldr k _z (repeat x) = let r = k x r in r #-}
+-- causes horrible code bloat
+-- {-# RULES "foldr/x:xs" forall k z x xs . foldr k z (x:xs) = k x (foldr k z xs) #-}
+{-# RULES "foldr/zip" forall k z xs ys . foldr k z (zip xs ys) = let zip' (a:as) (b:bs) = k (a,b) (zip' as bs); zip' _ _ = z in zip' xs ys #-}
+-- {-# RULES "foldr/sequence" forall k z xs . foldr k z (sequence xs) = foldr (\x y -> do rx <- x; ry <- y; return (k rx ry)) (return z) xs #-}
+-- {-# RULES "foldr/mapM" forall k z f xs . foldr k z (mapM f xs) = foldr (\x y -> do rx <- f x; ry <- y; return (k rx ry)) (return z) xs   #-}
+
+default(Int,Double)
diff --git a/lib/base/src/Prelude/CType.hs b/lib/base/src/Prelude/CType.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Prelude/CType.hs
@@ -0,0 +1,75 @@
+{-# OPTIONS_LHC -N #-}
+module Prelude.CType (
+    isAscii, isLatin1, isControl, isPrint, isSpace, isUpper, isLower,
+    isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
+    digitToInt, intToDigit,
+    toUpper, toLower
+    ) where
+
+import Lhc.Basics
+import Lhc.Order
+import Lhc.Num
+import Data.Word
+import Lhc.IO
+import Lhc.List
+
+-- Character-testing operations
+isAscii, isLatin1, isControl, isPrint, isSpace, isUpper, isLower,
+ isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum :: Char -> Bool
+
+isAscii c                =  c < '\x80'
+
+isLatin1 c               =  c <= '\xff'
+
+isControl c              =  c < ' ' || c >= '\DEL' && c <= '\x9f'
+
+isPrint c               =  isLatin1 c && not (isControl c)
+
+isSpace c                =  c `elem` " \t\n\r\f\v\xA0"
+
+isUpper c                =  c >= 'A' && c <= 'Z'
+
+isLower c                =  c >= 'a' && c <= 'z'
+
+isAlpha c                =  isUpper c || isLower c
+
+isDigit c                =  c >= '0' && c <= '9'
+
+isOctDigit c             =  c >= '0' && c <= '7'
+
+isHexDigit c             =  isDigit c || c >= 'A' && c <= 'F' ||
+                                         c >= 'a' && c <= 'f'
+
+isAlphaNum c             =  isAlpha c || isDigit c
+
+-- Digit conversion operations
+digitToInt :: Char -> Int
+digitToInt c
+  | isDigit c            =  ord c - ord '0'
+  | c >= 'a' && c <= 'f' =  ord c - (ord 'a' + 10)
+  | c >= 'A' && c <= 'F' =  ord c - (ord 'A' + 10)
+  | otherwise            =  error "Char.digitToInt: not a digit"
+
+intToDigit :: Int -> Char
+intToDigit i = f (fromIntegral i :: Word) where
+    f w | w < 10 = chr (ord '0' + i)
+        | w < 16 = chr ((ord 'a' - 10) + i)
+        | otherwise = error "Char.intToDigit: not a digit"
+
+-- Case-changing operations
+toUpper :: Char -> Char
+toUpper c | isLower c = chr $ ord c - 32
+          | otherwise = c
+
+toLower :: Char -> Char
+toLower c | isUpper c = chr $ ord c + 32
+          | otherwise = c
+
+elem    :: Char -> [Char] -> Bool
+elem _ []	= False
+elem x (y:ys)
+    | x == y = True
+    | otherwise = f y ys where
+        f y _ | x == y = True
+        f _ (y:ys) = f y ys
+        f _ [] = False
diff --git a/lib/base/src/Prelude/Float.hs b/lib/base/src/Prelude/Float.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Prelude/Float.hs
@@ -0,0 +1,303 @@
+{-# OPTIONS_LHC -N -fffi -fm4  #-}
+
+module Prelude.Float(readDouble,doubleToDigits,doubleToRational) where
+
+import Lhc.Order
+import Lhc.Basics
+import Lhc.Monad
+import Lhc.IO
+import Lhc.Float
+import Lhc.Num
+import Lhc.Types
+import Data.Word
+import Foreign.Storable
+import Foreign.C.Types
+import Foreign.Ptr
+import Foreign.Marshal.Alloc
+import Numeric
+import Prelude.Text
+import Lhc.List
+import Prelude((^),(^^),elem,take)
+
+
+
+
+m4_define(INST,{{
+
+
+foreign import primitive "FDiv" divide$2 ::  $2 -> $2 -> $2
+foreign import primitive "FPwr" exponent$2 ::  $2 -> $2 -> $2
+foreign import primitive "FAtan2" atan2$1 ::  $1 -> $1 -> $1
+foreign import primitive "F2I"  toInteger$1 :: $1 -> Integer
+foreign import primitive "const.M_PI" c_pi$1 :: $1
+
+instance Fractional $1 where
+    $1 x / $1 y = $1 (divide$2 x y)
+    fromRational x = fromInteger (numerator x) / fromInteger (denominator x)
+
+m4_define(FI,foreign import primitive "{{$}}1"  {{$}}2$2 :: $2 -> $2)
+
+FI(Sqrt,sqrt)
+FI(Exp,exp)
+FI(Log,log)
+FI(Sin,sin)
+FI(Cos,cos)
+FI(Tan,tan)
+FI(Sinh,sinh)
+FI(Cosh,cosh)
+FI(Tanh,tanh)
+FI(Asin,asin)
+FI(Acos,acos)
+FI(Atan,atan)
+
+m4_undefine({{FI}})
+
+instance Floating $1 where
+    pi = c_pi$1
+    sqrt ($1 x) = $1 (sqrt$2 x)
+    exp ($1 x) = $1 (exp$2 x)
+    log ($1 x) = $1 (log$2 x)
+    sin ($1 x) = $1 (sin$2 x)
+    cos ($1 x) = $1 (cos$2 x)
+    tan ($1 x) = $1 (tan$2 x)
+    asin ($1 x) = $1 (asin$2 x)
+    acos ($1 x) = $1 (acos$2 x)
+    atan ($1 x) = $1 (atan$2 x)
+    sinh ($1 x) = $1 (sinh$2 x)
+    cosh ($1 x) = $1 (cosh$2 x)
+    tanh ($1 x) = $1 (tanh$2 x)
+    $1 x ** $1 y = $1 (exponent$2 x y)
+
+    asinh = c_asinh$1
+    acosh = c_acosh$1
+    atanh = c_atanh$1
+
+
+instance RealFrac $1 where
+    properFraction x
+      = case (decodeFloat x)      of { (m,n) ->
+    	let  b = floatRadix x     in
+    	if n >= 0 then
+	    (fromInteger m * fromInteger b ^ n, 0.0)
+    	else
+	    case (quotRem m (b^(negate n))) of { (w,r) ->
+	    (fromInteger w, encodeFloat r n)
+	    }
+        }
+
+    truncate x = fromInteger (toInteger$1 x)
+    round x = fromInteger (toInteger$1 (roundf x))
+    ceiling x = fromInteger (toInteger$1 (ceilingf x))
+    floor x = fromInteger (toInteger$1 (floorf x))
+
+
+    properFractionf x = (c_trunc$1 x,x - c_trunc$1 x)
+    truncatef x = c_trunc$1 x
+    roundf x = c_nearbyint$1 x
+    ceilingf x = c_ceil$1 x
+    floorf x = c_floor$1 x
+
+
+foreign import ccall "-lm math.h asinh$3" c_asinh$1 :: $1 -> $1
+foreign import ccall "-lm math.h acosh$3" c_acosh$1 :: $1 -> $1
+foreign import ccall "-lm math.h atanh$3" c_atanh$1 :: $1 -> $1
+foreign import ccall "-lm math.h trunc$3" c_trunc$1 :: $1 -> $1
+foreign import ccall "-lm math.h ceil$3" c_ceil$1 :: $1 -> $1
+foreign import ccall "-lm math.h floor$3" c_floor$1 :: $1 -> $1
+foreign import ccall "-lm math.h nearbyint$3" c_nearbyint$1 :: $1 -> $1
+
+foreign import ccall "math.h isnan" c_isnan$3 :: $1 -> CInt
+foreign import ccall "math.h isinf" c_isinfinite$3 :: $1 -> CInt
+foreign import ccall "math.h signbit" c_signbit$3 :: $1 -> CInt
+
+foreign import ccall "math.h ldexp$3"  c_ldexp$3 :: $1 -> CInt -> $1
+foreign import ccall "math.h frexp$3"  c_frexp$3 :: $1 -> Ptr CInt -> IO $1
+
+}})
+
+INST(Float,Float32_,f)
+INST(Double,Float64_)
+
+
+instance Real Float where
+    toRational x	=  (m:%1)*(b:%1)^^n
+			   where (m,n) = decodeFloat x
+				 b     = floatRadix  x
+    toDouble x = floatToDouble x
+
+instance Real Double where
+    toRational x = doubleToRational x
+    toDouble x = x
+
+
+
+
+instance RealFloat Float where
+    floatRadix _ = 2
+    floatDigits _ = 24
+    floatRange _ = (-125,128)
+
+    exponent x		= case decodeFloatf x of (_,n) -> n
+    significand x	= case decodeFloatf x of (m,_) -> m
+
+    isNaN x = c_isnanf x /= 0
+    isInfinite x = c_isinfinitef x /= 0
+    isDenormalized _ = False
+    isNegativeZero x = x == 0 && c_signbitf x /= 0
+    isIEEE _ = True
+
+    scaleFloat k x = c_ldexpf x (fromInt k)
+    decodeFloatf x = unsafePerformIO $ alloca $ \ptr -> do
+        x' <- c_frexpf x ptr
+        exp <- peek ptr
+        return (x', fromIntegral exp)
+
+    encodeFloat i e = c_ldexpf (fromInteger i) (fromInt e)
+    decodeFloat x = unsafePerformIO $ alloca $ \ptr -> do
+        x' <- c_frexp (floatToDouble x) ptr
+        exp <- peek ptr
+        let x'' =  c_ldexp x' (fromInt $ floatDigits x)
+        return (double2integer x'', fromIntegral exp  - floatDigits x)
+
+    atan2 = atan2Float
+
+
+
+
+instance RealFloat Double where
+    floatRadix _ = 2
+    floatDigits _ = 53
+    floatRange _ = (-1021,1024)
+
+    exponent x		= case decodeFloatf x of (_,n) -> n
+    significand x	= case decodeFloatf x of (m,_) -> m
+
+    isNaN x = c_isnan x /= 0
+    isInfinite x = c_isinfinite x /= 0
+    isDenormalized _ = False
+    isNegativeZero x = x == 0 && c_signbit x /= 0
+    isIEEE _ = True
+    scaleFloat k x = c_ldexp x (fromInt k)
+    decodeFloatf x = unsafePerformIO $ alloca $ \ptr -> do
+        x' <- c_frexp x ptr
+        exp <- peek ptr
+        return (x', fromIntegral exp)
+
+    encodeFloat i e =  c_ldexp (integer2double i) (fromInt e)
+    decodeFloat x = unsafePerformIO $ alloca $ \ptr -> do
+        x' <- c_frexp x ptr
+        exp <- peek ptr
+        let x'' = c_ldexp x' (fromInt $ floatDigits x)
+        return (double2integer x'', fromIntegral exp  - floatDigits x)
+
+
+    atan2 = atan2Double
+
+
+
+foreign import primitive "I2F" integer2float :: Integer -> Float
+foreign import primitive "I2F" integer2double :: Integer -> Double
+foreign import primitive "F2I" double2integer :: Double -> Integer
+
+
+
+readDouble :: ReadS Double
+readDouble r    = [((fromInteger n * (10^^(k-d))),t) | (n,d,s) <- readFix r,(k,t)   <- readExp s] ++
+                 [ (0/0, t) | ("NaN",t)      <- lex r] ++
+                 [ (1/0, t) | ("Infinity",t) <- lex r]
+               where
+                 readFix r = [(read (take 15 $ ds++ds'), length ds', t)
+                             | (ds,d) <- lexDigits r,
+                               (ds',t) <- lexFrac d ]
+
+                 lexFrac ('.':ds) = lexDigits ds
+                 lexFrac s        = [("",s)]
+
+                 readExp (e:s) | e `elem` "eE" = readExp' s
+                 readExp s                     = [(0,s)]
+
+                 readExp' ('-':s) = [(-k,t) | (k,t) <- readDec s]
+                 readExp' ('+':s) = readDec s
+                 readExp' s       = readDec s
+
+
+doubleToDigits :: Integer -> Double -> ([Int], Int)
+doubleToDigits n d | n `seq` d `seq` d == 0 = ([], 0)
+doubleToDigits base' x =
+    let (f0', e0) = decodeFloat x
+        base, f0 :: WordMax
+        base = fromInteger base'
+        f0 = fromIntegral f0'
+        (minExp0, _) = floatRange x
+        p = floatDigits x
+        b :: WordMax
+        b = fromInteger $ floatRadix x
+        minExp = minExp0 - p            -- the real minimum exponent
+
+        -- Haskell requires that f be adjusted so denormalized numbers
+        -- will have an impossibly low exponent.  Adjust for this.
+        f :: WordMax
+        e :: Int
+        (f, e) = let n = minExp - e0
+                 in  if n > 0 then (f0 `div` (b^n), e0+n) else (f0, e0)
+
+        (r, s, mUp, mDn) =
+           if e >= 0 then
+               let be = b^e in
+               if f == b^(p-1) then
+                   (f*be*b*2, 2*b, be*b, b)
+               else
+                   (f*be*2, 2, be, be)
+           else
+               if e > minExp && f == b^(p-1) then
+                   (f*b*2, b^(-e+1)*2, b, 1)
+               else
+                   (f*2, b^(-e)*2, 1, 1)
+        k =
+            let k0 =
+                    if b==2 && base==10 then
+                        -- logBase 10 2 is slightly bigger than 3/10 so
+                        -- the following will err on the low side.  Ignoring
+                        -- the fraction will make it err even more.
+                        -- Haskell promises that p-1 <= logBase b f < p.
+                        (p - 1 + e0) * 3 `div` 10
+                    else
+                        ceiling ((log ((fromIntegral (f+1))::Double) +
+                                 fromIntegral e * log (fromIntegral b)) /
+                                  log (fromIntegral base))
+                fixup n =
+                    if n >= 0 then
+                        if r + mUp <= expt base n * s then n else fixup (n+1)
+                    else
+                        if expt base (-n) * (r + mUp) <= s then n
+                                                           else fixup (n+1)
+            in  fixup (k0::Int)
+
+        gen ds rn sN mUpN mDnN | rn `seq` sN `seq` mUpN `seq` mDnN `seq` True =
+            let (dn, rn') = (rn * base) `divMod` sN
+                mUpN' = mUpN * base
+                mDnN' = mDnN * base
+            in  case (rn' < mDnN', rn' + mUpN' > sN) of
+                (True,  False) -> toInt dn : ds
+                (False, True)  -> toInt (dn+1) : ds
+                (True,  True)  -> if rn' * 2 < sN then toInt dn : ds else toInt (dn+1) : ds
+                (False, False) -> gen (toInt dn:ds) rn' sN mUpN' mDnN'
+        rds,rrds :: [Int]
+        rrds = reverse rds
+        rds =
+            if k >= 0 then
+                gen [] r (s * expt base k) mUp mDn
+            else
+                let bk = expt base (-k)
+                in  gen [] (r * bk) s (mUp * bk) (mDn * bk)
+        expt :: WordMax -> Int -> WordMax
+        expt base n = base^n
+    in  k `seq` f `seq` e `seq` b `seq` rrds `seq` (rrds, k)
+
+
+doubleToRational :: Double -> Rational
+doubleToRational x  =  (m:%1)*(b:%1)^^n where
+    (m,n) = decodeFloat x
+    b     = floatRadix  x
+
+
diff --git a/lib/base/src/Prelude/IO.hs b/lib/base/src/Prelude/IO.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Prelude/IO.hs
@@ -0,0 +1,131 @@
+{-# OPTIONS_LHC -N -fffi -funboxed-values #-}
+module Prelude.IO(
+    IO(),
+    ioError,
+    catch,
+    runExpr,
+    FilePath(),
+    putStr,
+    putStrLn,
+    print,
+    getLine,
+    getContents,
+    readFile,
+    interact,
+    writeFile,
+    appendFile,
+    putChar,
+    runExpr,
+    getChar,
+    userError
+    ) where
+
+import Foreign.C.String
+import Foreign.C.Types
+import Foreign.Ptr
+import Lhc.Addr
+import Lhc.Basics
+import Lhc.IO
+import Lhc.Monad
+import Lhc.Order
+import Lhc.Show
+import Prelude.IOError
+
+
+-- IO operations exported by the prelude
+
+type  FilePath = String
+
+
+
+{-# RULES "putStr/++"      forall xs ys . putStr (xs ++ ys) = putStr xs >> putStr ys #-}
+
+putStr     :: String -> IO ()
+putStr s   =  mapM_ putChar s
+
+putStrLn   :: String -> IO ()
+putStrLn s =  do putStr s
+                 putChar '\n'
+
+print      :: Show a => a -> IO ()
+print x    =  putStrLn (show x)
+
+
+getLine    :: IO String
+getLine    =  do c <- getChar
+                 if c == '\n' then return "" else
+                    do s <- getLine
+                       return (c:s)
+
+getContents :: IO String
+getContents = unsafeInterleaveIO getContents' where
+    getContents' = do
+        ch <- c_getwchar
+        if ch == -1 then return [] else  do
+            xs <- unsafeInterleaveIO getContents'
+            return (unsafeChr ch:xs)
+
+
+readFile :: FilePath -> IO String
+readFile fn = do
+    file <- withCString fn $ \fnc -> c_fopen fnc (ptrFromAddr__ "r"#)
+    if  (file == nullPtr) then (fail "Could not open file.") else do
+        let gc = do
+                ch <- c_fgetwc file
+                if ch == -1 then c_fclose file >> return [] else do
+                        xs <- unsafeInterleaveIO gc
+                        return (unsafeChr ch:xs)
+        unsafeInterleaveIO gc
+
+
+foreign import ccall "stdio.h fopen" c_fopen :: CString -> CString -> IO (Ptr ())
+foreign import ccall "stdio.h fclose" c_fclose :: Ptr () -> IO CInt
+foreign import ccall "wchar.h lhc_utf8_getc" c_fgetwc :: Ptr () -> IO Int
+
+-- | The 'interact' function takes a function of type @String->String@
+-- as its argument.  The entire input from the standard input device is
+-- passed to this function as its argument, and the resulting string is
+-- output on the standard output device.
+
+interact        ::  (String -> String) -> IO ()
+interact f      =   do s <- getContents
+                       putStr (f s)
+{-
+interact    ::  (String -> String) -> IO ()
+-- The hSetBuffering ensures the expected interactive behaviour
+interact f  =  do hSetBuffering stdin  NoBuffering
+                  hSetBuffering stdout NoBuffering
+                  s <- getContents
+                  putStr (f s)
+
+-}
+
+
+writeFile  :: FilePath -> String -> IO ()
+writeFile  =  error "writeFile"
+
+appendFile :: FilePath -> String -> IO ()
+appendFile =  error "appendFile"
+
+
+
+putChar :: Char -> IO ()
+putChar c = c_putwchar (ord c)
+
+-- | this is wrapped around arbitrary showable expressions when used as the main entry point
+runExpr :: Show a => a -> World__ -> World__
+runExpr x w = runNoWrapper (print x) w
+
+--TODO EOF == -1
+getChar :: IO Char
+getChar = do
+    ch <- c_getwchar
+    if ch == -1 then fail "End of file." else return (unsafeChr ch)
+
+foreign import primitive "I2I" cwintToChar :: CWint -> Char
+foreign import primitive "U2U" charToCWchar :: Char -> CWchar
+
+foreign import ccall "stdio.h lhc_utf8_putchar" c_putwchar :: Int -> IO ()
+foreign import ccall "wchar.h lhc_utf8_getchar" c_getwchar :: IO Int
+
+
diff --git a/lib/base/src/Prelude/IOError.hs b/lib/base/src/Prelude/IOError.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Prelude/IOError.hs
@@ -0,0 +1,62 @@
+{-# OPTIONS_LHC -N #-}
+module Prelude.IOError(IOError(),showIOError,userError) where
+
+import Lhc.IO
+import Lhc.Show
+
+instance Show IOError where
+    showsPrec _ s = showString (showIOError s)
+
+{-
+
+data IOError = IOError {
+     ioe_handle   :: Maybe Handle,   -- the handle used by the action flagging
+				     -- the error.
+     ioe_type     :: IOErrorType,    -- what it was.
+     ioe_location :: String,	     -- location.
+     ioe_description :: String,      -- error type specific information.
+     ioe_filename :: Maybe FilePath  -- filename the error is related to.
+   } deriving(Eq)
+
+
+-- | An abstract type that contains a value for each variant of 'IOError'.
+data IOErrorType
+  = AlreadyExists
+  | NoSuchThing
+  | ResourceBusy
+  | ResourceExhausted
+  | EOF
+  | IllegalOperation
+  | PermissionDenied
+  | UserError
+
+instance Show IOErrorType where
+  showsPrec _ e =
+    showString $
+    case e of
+      AlreadyExists	-> "already exists"
+      NoSuchThing       -> "does not exist"
+      ResourceBusy      -> "resource busy"
+      ResourceExhausted -> "resource exhausted"
+      EOF		-> "end of file"
+      IllegalOperation	-> "illegal operation"
+      PermissionDenied  -> "permission denied"
+      UserError		-> "user error"
+
+instance Show IOException where
+    showsPrec p (IOError hdl iot loc s fn) =
+      (case fn of
+	 Nothing -> case hdl of
+		        Nothing -> id
+			Just h  -> showsPrec p h . showString ": "
+	 Just name -> showString name . showString ": ") .
+      (case loc of
+         "" -> id
+	 _  -> showString loc . showString ": ") .
+      showsPrec p iot .
+      (case s of
+	 "" -> id
+	 _  -> showString " (" . showString s . showString ")")
+
+-}
+
diff --git a/lib/base/src/Prelude/Text.hs b/lib/base/src/Prelude/Text.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Prelude/Text.hs
@@ -0,0 +1,123 @@
+module Prelude.Text (
+    ReadS, ShowS,
+    Read(readsPrec, readList),
+    Show(showsPrec, show, showList),
+    reads, shows, read, lex,
+    showChar, showString, readParen, showParen,readIO,readLn ) where
+
+-- The instances of Read and Show for
+--      Bool, Maybe, Either, Ordering
+-- are done via "deriving" clauses in Prelude.hs
+import Lhc.Show
+import Lhc.Inst.Show()
+import Prelude.Float
+import Lhc.Basics
+import Lhc.Monad
+import Lhc.IO
+import Prelude.IO
+import Lhc.Order
+import Lhc.Maybe
+import Lhc.Text.Read
+
+
+import Data.Char(isSpace, isAlpha, isDigit, isAlphaNum,
+                 showLitChar, readLitChar, lexLitChar)
+
+import Numeric(showSigned, showInt, readSigned, readDec, showFloat,
+               readFloat, lexDigits)
+
+readLn :: Read a => IO a
+readLn =  do l <- getLine
+             r <- readIO l
+             return r
+
+  -- raises an exception instead of an error
+readIO   :: Read a => String -> IO a
+readIO s =  case [x | (x,t) <- reads s, ("","") <- lex t] of
+              [x] -> return x
+              []  -> ioError (userError "Prelude.readIO: no parse")
+              _   -> ioError (userError "Prelude.readIO: ambiguous parse")
+
+
+
+read             :: (Read a) => String -> a
+read s           =  case [x | (x,t) <- reads s, ("","") <- lex t] of
+                         [x] -> x
+                         []  -> error "Prelude.read: no parse"
+                         _   -> error "Prelude.read: ambiguous parse"
+
+
+
+instance  Read Int  where
+  readsPrec p r = [(fromInteger i, t) | (i,t) <- readsPrec p r]
+        -- Reading at the Integer type avoids
+        -- possible difficulty with minInt
+
+
+instance  Read Integer  where
+    readsPrec p         = readSigned readDec
+
+instance  Show Float  where
+    showsPrec p         = showFloat
+
+
+instance  Show Double  where
+    showsPrec p         = showFloat
+
+
+instance  Show Char  where
+    showsPrec p '\'' = showString "'\\''"
+    showsPrec p c    = showChar '\'' . showLitChar c . showChar '\''
+
+    showList cs = showChar '"' . showl cs
+                 where showl ""       = showChar '"'
+                       showl ('"':cs) = showString "\\\"" . showl cs
+                       showl (c:cs)   = showLitChar c . showl cs
+
+instance  Read Char  where
+    readsPrec p      = readParen False
+                            (\r -> [(c,t) | ('\'':s,t)<- lex r,
+                                            (c,"\'")  <- readLitChar s])
+
+    readList = readParen False (\r -> [(l,t) | ('"':s, t) <- lex r,
+                                               (l,_)      <- readl s ])
+        where readl ('"':s)      = [("",s)]
+              readl ('\\':('&':s)) = readl s
+              readl s            = [(c:cs,u) | (c ,t) <- readLitChar s,
+                                               (cs,u) <- readl t       ]
+
+
+instance  (Read a) => Read [a]  where
+    readsPrec p      = readList
+
+
+
+instance Read Bool where
+    readsPrec d input =
+              (\ inp -> [((False) , rest) | ("False" , rest) <- lex inp]) input
+              ++
+              (\ inp -> [((True) , rest) | ("True" , rest) <- lex inp]) input
+
+
+instance Read Ordering where
+    readsPrec d input =
+              (\ inp -> [((LT) , rest) | ("LT" , rest) <- lex inp]) input
+              ++
+              (\ inp -> [((EQ) , rest) | ("EQ" , rest) <- lex inp]) input
+              ++
+              (\ inp -> [((GT) , rest) | ("GT" , rest) <- lex inp]) input
+
+
+
+
+instance (Read a) => Read (Maybe a) where
+    readsPrec d input =
+	      (\ inp -> [((Nothing) , rest) | ("Nothing" , rest) <- lex inp])
+	      input
+	      ++
+	      readParen (d > 9)
+	      (\ inp ->
+	       [((Just aa) , rest) | ("Just" , inp) <- lex inp ,
+		(aa , rest) <- readsPrec 10 inp])
+	      input
+
diff --git a/lib/base/src/System.hs b/lib/base/src/System.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/System.hs
@@ -0,0 +1,84 @@
+{-# OPTIONS_LHC -fffi #-}
+module System (
+    ExitCode(ExitSuccess,ExitFailure),
+    getArgs, getProgName, getEnv, system, exitWith, exitFailure
+  ) where
+
+import Foreign.C.String
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.Marshal.Alloc
+import Foreign.C.Types
+import Lhc.IO(exitFailure)
+import qualified Lhc.Options
+
+data ExitCode = ExitSuccess | ExitFailure !Int
+            deriving (Eq, Ord, Read, Show)
+
+getArgs     :: IO [String]
+getProgName :: IO String
+getEnv      :: String -> IO String
+system      :: String -> IO ExitCode
+exitWith    :: ExitCode -> IO a
+exitFailure :: IO a
+
+
+exitWith ExitSuccess = do
+    c_exit 0
+    return undefined
+exitWith (ExitFailure n) = do
+    c_exit n
+    return undefined
+
+
+getProgName = case Lhc.Options.target of
+    Lhc.Options.GhcHs -> ghc_getProgName
+    _ -> peek lhc_progname >>= peekCString
+
+getArgs = case Lhc.Options.target of
+    Lhc.Options.GhcHs -> ghc_getArgs
+    _ -> do
+        argc <- peek lhc_argc
+        argv <- peek lhc_argv
+        let f n = peekElemOff argv n >>= peekCString
+        mapM f [0 .. fromIntegral argc - 1]
+
+
+getEnv s = withCString s c_getenv >>= \p ->
+    if p == nullPtr then fail ("getEnv: " ++ show s)  else peekCString p
+
+
+system s = withCString s c_system >>= \r -> case r of
+    0 -> return ExitSuccess
+    _ -> return $ ExitFailure (fromIntegral r)
+
+foreign import unsafe ccall "exit" c_exit :: Int -> IO ()
+foreign import unsafe ccall "system" c_system :: CString -> IO CInt
+foreign import unsafe ccall "stdlib.h getenv" c_getenv :: Ptr CChar -> IO (Ptr CChar)
+
+foreign import ccall "&lhc_progname" lhc_progname :: Ptr CString
+foreign import ccall "&lhc_argc" lhc_argc :: Ptr CInt
+foreign import ccall "&lhc_argv" lhc_argv :: Ptr (Ptr CString)
+
+ghc_getArgs :: IO [String]
+ghc_getArgs =
+    alloca $ \ p_argc ->
+    alloca $ \ p_argv -> do
+        getProgArgv p_argc p_argv
+        p    <- peek p_argc
+        argv <- peek p_argv
+        let f n = peekElemOff argv n >>= peekCString
+        mapM f [1 .. fromIntegral p - 1]
+
+
+foreign import unsafe ccall "getProgArgv"
+  getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
+
+ghc_getProgName :: IO String
+ghc_getProgName =
+  alloca $ \ p_argc ->
+  alloca $ \ p_argv -> do
+     getProgArgv p_argc p_argv
+     argv <- peek p_argv
+     peekElemOff argv 0 >>= peekCString
+
diff --git a/lib/base/src/System/CPUTime.hs b/lib/base/src/System/CPUTime.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/System/CPUTime.hs
@@ -0,0 +1,3 @@
+-- | Skeleton only, fixme.
+module System.CPUTime where
+
diff --git a/lib/base/src/System/Console/GetOpt.hs b/lib/base/src/System/Console/GetOpt.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/System/Console/GetOpt.hs
@@ -0,0 +1,303 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Console.GetOpt
+-- Copyright   :  (c) Sven Panne 2002-2004
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- This library provides facilities for parsing the command-line options
+-- in a standalone program.  It is essentially a Haskell port of the GNU
+-- @getopt@ library.
+--
+-----------------------------------------------------------------------------
+
+{-
+Sven Panne <Sven.Panne@informatik.uni-muenchen.de> Oct. 1996 (small
+changes Dec. 1997)
+
+Two rather obscure features are missing: The Bash 2.0 non-option hack
+(if you don't already know it, you probably don't want to hear about
+it...) and the recognition of long options with a single dash
+(e.g. '-help' is recognised as '--help', as long as there is no short
+option 'h').
+
+Other differences between GNU's getopt and this implementation:
+
+* To enforce a coherent description of options and arguments, there
+  are explanation fields in the option/argument descriptor.
+
+* Error messages are now more informative, but no longer POSIX
+  compliant... :-(
+
+And a final Haskell advertisement: The GNU C implementation uses well
+over 1100 lines, we need only 195 here, including a 46 line example!
+:-)
+-}
+
+module System.Console.GetOpt (
+   -- * GetOpt
+   getOpt,
+   usageInfo,
+   ArgOrder(..),
+   OptDescr(..),
+   ArgDescr(..),
+
+   -- * Example
+
+   -- $example
+) where
+
+import Prelude -- necessary to get dependencies right
+
+import Data.List ( isPrefixOf )
+
+-- |What to do with options following non-options
+data ArgOrder a
+  = RequireOrder                -- ^ no option processing after first non-option
+  | Permute                     -- ^ freely intersperse options and non-options
+  | ReturnInOrder (String -> a) -- ^ wrap non-options into options
+
+{-|
+Each 'OptDescr' describes a single option.
+
+The arguments to 'Option' are:
+
+* list of short option characters
+
+* list of long option strings (without \"--\")
+
+* argument descriptor
+
+* explanation of option for user
+-}
+data OptDescr a =              -- description of a single options:
+   Option [Char]                --    list of short option characters
+          [String]              --    list of long option strings (without "--")
+          (ArgDescr a)          --    argument descriptor
+          String                --    explanation of option for user
+
+-- |Describes whether an option takes an argument or not, and if so
+-- how the argument is injected into a value of type @a@.
+data ArgDescr a
+   = NoArg                   a         -- ^   no argument expected
+   | ReqArg (String       -> a) String -- ^   option requires argument
+   | OptArg (Maybe String -> a) String -- ^   optional argument
+
+data OptKind a                -- kind of cmd line arg (internal use only):
+   = Opt       a                --    an option
+   | NonOpt    String           --    a non-option
+   | EndOfOpts                  --    end-of-options marker (i.e. "--")
+   | OptErr    String           --    something went wrong...
+
+-- | Return a string describing the usage of a command, derived from
+-- the header (first argument) and the options described by the
+-- second argument.
+usageInfo :: String                    -- header
+          -> [OptDescr a]              -- option descriptors
+          -> String                    -- nicely formatted decription of options
+usageInfo header optDescr = unlines (header:table)
+   where (ss,ls,ds)     = (unzip3 . concatMap fmtOpt) optDescr
+         table          = zipWith3 paste (sameLen ss) (sameLen ls) ds
+         paste x y z    = "  " ++ x ++ "  " ++ y ++ "  " ++ z
+         sameLen xs     = flushLeft ((maximum . map length) xs) xs
+         flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ]
+
+fmtOpt :: OptDescr a -> [(String,String,String)]
+fmtOpt (Option sos los ad descr) =
+   case lines descr of
+     []     -> [(sosFmt,losFmt,"")]
+     (d:ds) ->  (sosFmt,losFmt,d) : [ ("","",d') | d' <- ds ]
+   where sepBy _  []     = ""
+         sepBy _  [x]    = x
+         sepBy ch (x:xs) = x ++ ch:' ':sepBy ch xs
+         sosFmt = sepBy ',' (map (fmtShort ad) sos)
+         losFmt = sepBy ',' (map (fmtLong  ad) los)
+
+fmtShort :: ArgDescr a -> Char -> String
+fmtShort (NoArg  _   ) so = "-" ++ [so]
+fmtShort (ReqArg _ ad) so = "-" ++ [so] ++ " " ++ ad
+fmtShort (OptArg _ ad) so = "-" ++ [so] ++ "[" ++ ad ++ "]"
+
+fmtLong :: ArgDescr a -> String -> String
+fmtLong (NoArg  _   ) lo = "--" ++ lo
+fmtLong (ReqArg _ ad) lo = "--" ++ lo ++ "=" ++ ad
+fmtLong (OptArg _ ad) lo = "--" ++ lo ++ "[=" ++ ad ++ "]"
+
+{-|
+Process the command-line, and return the list of values that matched
+(and those that didn\'t). The arguments are:
+
+* The order requirements (see 'ArgOrder')
+
+* The option descriptions (see 'OptDescr')
+
+* The actual command line arguments (presumably got from
+  'System.Environment.getArgs').
+
+'getOpt' returns a triple, consisting of the argument values, a list
+of options that didn\'t match, and a list of error messages.
+-}
+getOpt :: ArgOrder a                   -- non-option handling
+       -> [OptDescr a]                 -- option descriptors
+       -> [String]                     -- the commandline arguments
+       -> ([a],[String],[String])      -- (options,non-options,error messages)
+getOpt _        _        []         =  ([],[],[])
+getOpt ordering optDescr (arg:args) = procNextOpt opt ordering
+   where procNextOpt (Opt o)    _                 = (o:os,xs,es)
+         procNextOpt (NonOpt x) RequireOrder      = ([],x:rest,[])
+         procNextOpt (NonOpt x) Permute           = (os,x:xs,es)
+         procNextOpt (NonOpt x) (ReturnInOrder f) = (f x :os, xs,es)
+         procNextOpt EndOfOpts  RequireOrder      = ([],rest,[])
+         procNextOpt EndOfOpts  Permute           = ([],rest,[])
+         procNextOpt EndOfOpts  (ReturnInOrder f) = (map f rest,[],[])
+         procNextOpt (OptErr e) _                 = (os,xs,e:es)
+
+         (opt,rest) = getNext arg args optDescr
+         (os,xs,es) = getOpt ordering optDescr rest
+
+-- take a look at the next cmd line arg and decide what to do with it
+getNext :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])
+getNext ('-':'-':[]) rest _        = (EndOfOpts,rest)
+getNext ('-':'-':xs) rest optDescr = longOpt xs rest optDescr
+getNext ('-': x :xs) rest optDescr = shortOpt x xs rest optDescr
+getNext a            rest _        = (NonOpt a,rest)
+
+-- handle long option
+longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])
+longOpt ls rs optDescr = long ads arg rs
+   where (opt,arg) = break (=='=') ls
+         getWith p = [ o  | o@(Option _ ls _ _) <- optDescr, l <- ls, opt `p` l ]
+         exact     = getWith (==)
+         options   = if null exact then getWith isPrefixOf else exact
+         ads       = [ ad | Option _ _ ad _ <- options ]
+         optStr    = ("--"++opt)
+
+         long (_:_:_)      _        rest     = (errAmbig options optStr,rest)
+         long [NoArg  a  ] []       rest     = (Opt a,rest)
+         long [NoArg  _  ] ('=':_)  rest     = (errNoArg optStr,rest)
+         long [ReqArg _ d] []       []       = (errReq d optStr,[])
+         long [ReqArg f _] []       (r:rest) = (Opt (f r),rest)
+         long [ReqArg f _] ('=':xs) rest     = (Opt (f xs),rest)
+         long [OptArg f _] []       rest     = (Opt (f Nothing),rest)
+         long [OptArg f _] ('=':xs) rest     = (Opt (f (Just xs)),rest)
+         long _            _        rest     = (errUnrec optStr,rest)
+
+-- handle short option
+shortOpt :: Char -> String -> [String] -> [OptDescr a] -> (OptKind a,[String])
+shortOpt x xs rest optDescr = short ads xs rest
+  where options = [ o  | o@(Option ss _ _ _) <- optDescr, s <- ss, x == s ]
+        ads     = [ ad | Option _ _ ad _ <- options ]
+        optStr  = '-':[x]
+
+        short (_:_:_)        _  rest     = (errAmbig options optStr,rest)
+        short (NoArg  a  :_) [] rest     = (Opt a,rest)
+        short (NoArg  a  :_) xs rest     = (Opt a,('-':xs):rest)
+        short (ReqArg _ d:_) [] []       = (errReq d optStr,[])
+        short (ReqArg f _:_) [] (r:rest) = (Opt (f r),rest)
+        short (ReqArg f _:_) xs rest     = (Opt (f xs),rest)
+        short (OptArg f _:_) [] rest     = (Opt (f Nothing),rest)
+        short (OptArg f _:_) xs rest     = (Opt (f (Just xs)),rest)
+        short []             [] rest     = (errUnrec optStr,rest)
+        short []             xs rest     = (errUnrec optStr,('-':xs):rest)
+
+-- miscellaneous error formatting
+
+errAmbig :: [OptDescr a] -> String -> OptKind a
+errAmbig ods optStr = OptErr (usageInfo header ods)
+   where header = "option `" ++ optStr ++ "' is ambiguous; could be one of:"
+
+errReq :: String -> String -> OptKind a
+errReq d optStr = OptErr ("option `" ++ optStr ++ "' requires an argument " ++ d ++ "\n")
+
+errUnrec :: String -> OptKind a
+errUnrec optStr = OptErr ("unrecognized option `" ++ optStr ++ "'\n")
+
+errNoArg :: String -> OptKind a
+errNoArg optStr = OptErr ("option `" ++ optStr ++ "' doesn't allow an argument\n")
+
+{-
+-----------------------------------------------------------------------------------------
+-- and here a small and hopefully enlightening example:
+
+data Flag = Verbose | Version | Name String | Output String | Arg String   deriving Show
+
+options :: [OptDescr Flag]
+options =
+   [Option ['v']     ["verbose"]           (NoArg Verbose)      "verbosely list files",
+    Option ['V','?'] ["version","release"] (NoArg Version)      "show version info",
+    Option ['o']     ["output"]            (OptArg out "FILE")  "use FILE for dump",
+    Option ['n']     ["name"]              (ReqArg Name "USER") "only dump USER's files"]
+
+out :: Maybe String -> Flag
+out Nothing  = Output "stdout"
+out (Just o) = Output o
+
+test :: ArgOrder Flag -> [String] -> String
+test order cmdline = case getOpt order options cmdline of
+                        (o,n,[]  ) -> "options=" ++ show o ++ "  args=" ++ show n ++ "\n"
+                        (_,_,errs) -> concat errs ++ usageInfo header options
+   where header = "Usage: foobar [OPTION...] files..."
+
+-- example runs:
+-- putStr (test RequireOrder ["foo","-v"])
+--    ==> options=[]  args=["foo", "-v"]
+-- putStr (test Permute ["foo","-v"])
+--    ==> options=[Verbose]  args=["foo"]
+-- putStr (test (ReturnInOrder Arg) ["foo","-v"])
+--    ==> options=[Arg "foo", Verbose]  args=[]
+-- putStr (test Permute ["foo","--","-v"])
+--    ==> options=[]  args=["foo", "-v"]
+-- putStr (test Permute ["-?o","--name","bar","--na=baz"])
+--    ==> options=[Version, Output "stdout", Name "bar", Name "baz"]  args=[]
+-- putStr (test Permute ["--ver","foo"])
+--    ==> option `--ver' is ambiguous; could be one of:
+--          -v      --verbose             verbosely list files
+--          -V, -?  --version, --release  show version info
+--        Usage: foobar [OPTION...] files...
+--          -v        --verbose             verbosely list files
+--          -V, -?    --version, --release  show version info
+--          -o[FILE]  --output[=FILE]       use FILE for dump
+--          -n USER   --name=USER           only dump USER's files
+-----------------------------------------------------------------------------------------
+-}
+
+{- $example
+
+To hopefully illuminate the role of the different data
+structures, here\'s the command-line options for a (very simple)
+compiler:
+
+>    module Opts where
+>
+>    import System.Console.GetOpt
+>    import Data.Maybe ( fromMaybe )
+>
+>    data Flag
+>     = Verbose  | Version
+>     | Input String | Output String | LibDir String
+>       deriving Show
+>
+>    options :: [OptDescr Flag]
+>    options =
+>     [ Option ['v']     ["verbose"] (NoArg Verbose)       "chatty output on stderr"
+>     , Option ['V','?'] ["version"] (NoArg Version)       "show version number"
+>     , Option ['o']     ["output"]  (OptArg outp "FILE")  "output FILE"
+>     , Option ['c']     []          (OptArg inp  "FILE")  "input FILE"
+>     , Option ['L']     ["libdir"]  (ReqArg LibDir "DIR") "library directory"
+>     ]
+>
+>    inp,outp :: Maybe String -> Flag
+>    outp = Output . fromMaybe "stdout"
+>    inp  = Input  . fromMaybe "stdout"
+>
+>    compilerOpts :: [String] -> IO ([Flag], [String])
+>    compilerOpts argv =
+>       case (getOpt Permute options argv) of
+>          (o,n,[]  ) -> return (o,n)
+>          (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
+>      where header = "Usage: ic [OPTION...] files..."
+
+-}
diff --git a/lib/base/src/System/Directory.hs b/lib/base/src/System/Directory.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/System/Directory.hs
@@ -0,0 +1,40 @@
+module System.Directory where
+{-
+ (
+    Permissions( Permissions, readable, writable, executable, searchable ),
+    createDirectory, removeDirectory, removeFile,
+    renameDirectory, renameFile, getDirectoryContents,
+    getCurrentDirectory, setCurrentDirectory,
+    doesFileExist, doesDirectoryExist,
+    getPermissions, setPermissions,
+    getModificationTime ) where
+
+import Time ( ClockTime )
+
+data Permissions = Permissions {
+    readable,   writable,
+    executable, searchable :: Bool
+   } deriving (Eq,Ord,Read,Show)
+
+
+
+
+createDirectory  :: FilePath -> IO ()
+removeDirectory  :: FilePath -> IO ()
+removeFile  :: FilePath -> IO ()
+renameDirectory  :: FilePath -> FilePath -> IO ()
+renameFile  :: FilePath -> FilePath -> IO ()
+
+getDirectoryContents  :: FilePath -> IO [FilePath]
+getCurrentDirectory  :: IO FilePath
+setCurrentDirectory  :: FilePath -> IO ()
+
+doesFileExist :: FilePath -> IO Bool
+doesDirectoryExist :: FilePath -> IO Bool
+
+getPermissions :: FilePath -> IO Permissions
+setPermissions :: FilePath -> Permissions -> IO ()
+
+getModificationTime :: FilePath -> IO ClockTime
+
+-}
diff --git a/lib/base/src/System/IO.hs b/lib/base/src/System/IO.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/System/IO.hs
@@ -0,0 +1,158 @@
+{-# OPTIONS_LHC -fffi #-}
+module System.IO(
+    BufferMode(..),
+    Handle,
+    IOMode(..),
+    SeekMode(..),
+    hClose,
+    hFileSize,
+    hSeek,
+    hTell,
+    hFlush,
+    hGetBuf,
+    hGetPosn,
+    hSetPosn,
+    hGetContents,
+    hIsOpen,
+    hPrint,
+    hPutBuf,
+    hPutChar,
+    hPutStr,
+    hPutStrLn,
+    openFile,
+    withFile,
+    fixIO,
+    stdin,stdout,stderr,
+    try
+
+    ) where
+
+import Lhc.IO
+import Lhc.Handle
+import Prelude.IOError
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.Types
+import Data.Char(ord)
+import Data.Int
+
+
+data BufferMode = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
+    deriving(Eq, Ord, Read, Show)
+data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
+    deriving(Eq,Ord,Bounded,Enum,Read,Show)
+
+type HandlePosn = Integer
+
+
+
+try            :: IO a -> IO (Either IOError a)
+try f          =  catch (do r <- f
+                            return (Right r))
+                        (return . Left)
+
+
+withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
+withFile fp iom action = do
+    h <- openFile fp iom
+    r <- action h
+    hClose h
+    return r
+
+
+
+hFlush :: Handle -> IO ()
+hFlush h = withHandle h c_fflush
+
+isEOF :: IO Bool
+isEOF = hIsEOF stdin
+
+hIsEOF :: Handle -> IO Bool
+hIsEOF h = withHandle h $ \ptr -> do
+    r <- c_feof ptr
+    return (r /= 0)
+
+hPutChar h ch = withHandle h $ \ptr -> do
+    c_fputwc (fromInt (ord ch)) ptr
+    return ()
+
+hPutStr     :: Handle -> String -> IO ()
+hPutStr h s   = withHandle h $ \ptr -> do
+    sequence_ [ c_fputwc (fromInt (ord ch)) ptr | ch <- s ]
+
+hPutStrLn   :: Handle -> String -> IO ()
+hPutStrLn h s = do
+    hPutStr h s
+    hPutChar h '\n'
+
+hPrint      :: Show a => Handle -> a -> IO ()
+hPrint h x    =  hPutStrLn h (show x)
+
+
+hGetContents :: Handle -> IO String
+hGetContents h = withHandle h $ \ptr -> do
+    let getContents' = do
+            ch <- c_fgetwc ptr
+            case ch of
+                -1 -> return []
+                _ -> do
+                    xs <- unsafeInterleaveIO getContents'
+                    return (unsafeChr ch:xs)
+    unsafeInterleaveIO getContents'
+
+hTell :: Handle -> IO Integer
+hTell h = withHandle h $ \ptr -> fmap fromIntegral (c_ftell ptr)
+
+hSeek :: Handle -> SeekMode -> Integer -> IO ()
+hSeek h v w = withHandle h $ \ptr -> do
+    let sm x = case x of
+            AbsoluteSeek -> c_SEEK_SET
+            RelativeSeek -> c_SEEK_CUR
+            SeekFromEnd  -> c_SEEK_END
+    c_fseek ptr (fromIntegral w) (sm v)
+    return ()
+
+hGetPosn :: Handle -> IO HandlePosn
+hGetPosn h = hTell h
+
+hSetPosn :: Handle -> HandlePosn -> IO ()
+hSetPosn h hp = hSeek h AbsoluteSeek hp
+
+hPutBuf :: Handle -> Ptr a -> Int -> IO ()
+hPutBuf h p c = do
+    let count = fromIntegral c
+    rc <- withHandle h $ fwrite p 1 count
+    if rc /= count then fail "hPutBuf: short write" else return ()
+
+hGetBuf :: Handle -> Ptr a -> Int -> IO Int
+hGetBuf h p c = do
+    let count = fromIntegral c
+    rc <- withHandle h $ fread p 1 count
+    return $ fromIntegral rc
+
+hFileSize :: Handle -> IO Integer
+hFileSize h = do
+    cp <- hTell h
+    hSeek h SeekFromEnd 0
+    fl <- hTell h
+    hSeek h AbsoluteSeek cp
+    return fl
+
+foreign import ccall "stdio.h fwrite_unlocked" fwrite  :: Ptr a -> CSize -> CSize -> Ptr Handle -> IO CSize
+foreign import ccall "stdio.h fread_unlocked" fread :: Ptr a -> CSize -> CSize -> Ptr Handle -> IO CSize
+
+foreign import primitive "I2I" cwintToChar :: CWint -> Char
+
+foreign import ccall "stdio.h fflush" c_fflush :: Ptr Handle -> IO ()
+
+foreign import ccall "wchar.h lhc_utf8_getc" c_fgetwc :: Ptr Handle -> IO Int
+foreign import ccall "wchar.h lhc_utf8_putc" c_fputwc :: Int -> Ptr Handle -> IO Int
+
+foreign import ccall "stdio.h feof" c_feof :: Ptr Handle -> IO CInt
+foreign import ccall "stdio.h ftell" c_ftell :: Ptr Handle -> IO IntMax                  -- XXX
+foreign import ccall "stdio.h fseek" c_fseek :: Ptr Handle -> IntMax -> CInt -> IO CInt  -- XXX
+
+foreign import primitive "const.SEEK_SET" c_SEEK_SET :: CInt
+foreign import primitive "const.SEEK_CUR" c_SEEK_CUR :: CInt
+foreign import primitive "const.SEEK_END" c_SEEK_END :: CInt
+
diff --git a/lib/base/src/System/IO/Binary.hs b/lib/base/src/System/IO/Binary.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/System/IO/Binary.hs
@@ -0,0 +1,47 @@
+{-# OPTIONS_LHC -fffi #-}
+module System.IO.Binary(readBinaryFile,putWord8,getWord8) where
+
+import Data.Word
+import Lhc.IO
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.Ptr
+import Foreign.C.Error
+
+-- | Lazily read a file as a sequence of bytes.
+
+readBinaryFile :: FilePath -> IO [Word8]
+readBinaryFile fn = do
+    file <- withCString fn $ \fnc -> c_fopen fnc read_str
+    if  (file == nullPtr) then getErrno >>= \errno -> (ioError $ errnoToIOError "readBinaryFile" errno Nothing (Just fn)) else do
+        let gc = do
+                ch <- c_getc file
+                case ch of
+                    -1 -> c_fclose file >> return []
+                    _ -> do
+                        xs <- unsafeInterleaveIO gc
+                        return (cintToWord8 ch:xs)
+        unsafeInterleaveIO gc
+
+foreign import primitive "Lobits" cintToWord8 :: CInt -> Word8
+foreign import primitive "const.\"rb\"" read_str :: Ptr CChar
+
+foreign import ccall "stdio.h getc_unlocked" c_getc :: Ptr () -> IO CInt
+foreign import ccall "stdio.h fopen" c_fopen :: CString -> CString -> IO (Ptr ())
+foreign import ccall "stdio.h fclose" c_fclose :: Ptr () -> IO CInt
+
+-- Int translates to CInt in the calling conventions so this is safe.
+foreign import ccall "stdio.h putchar_unlocked" c_putchar :: Int -> IO Int
+foreign import ccall "stdio.h getchar_unlocked" c_getchar :: IO Int
+
+
+putWord8 :: Word8 -> IO ()
+putWord8 w = c_putchar (fromIntegral w) >> return ()
+
+getWord8 :: IO Word8
+getWord8 = do
+    c <- c_getchar
+    case c of
+        -1 -> fail "EOF"
+        _ -> return $ fromIntegral c
+
diff --git a/lib/base/src/System/IO/Continuation.hs b/lib/base/src/System/IO/Continuation.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/System/IO/Continuation.hs
@@ -0,0 +1,19 @@
+module System.IO.Continuation(IOCont(),newContinuation,callContinuation) where
+
+import Lhc.JumpPoint
+import Lhc.Hole
+
+data IOCont s a = IOCont (Hole a) JumpPoint
+
+newContinuation :: (forall s . IOCont s a -> IO b) -> (a -> IO b) -> IO b
+newContinuation act cc = do
+    ref <- newHole
+    withJumpPoint__ $ \jp r -> case r of
+        False -> do act (IOCont ref jp)
+        True  -> do readHole ref >>= cc
+
+callContinuation :: IOCont s a -> a -> IO b
+callContinuation (IOCont ref jp) x = do
+    fillHole ref x
+    jumpJumpPoint__ jp
+
diff --git a/lib/base/src/System/IO/Error.hs b/lib/base/src/System/IO/Error.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/System/IO/Error.hs
@@ -0,0 +1,1 @@
+module System.IO.Error where
diff --git a/lib/base/src/System/IO/Unsafe.hs b/lib/base/src/System/IO/Unsafe.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/System/IO/Unsafe.hs
@@ -0,0 +1,6 @@
+{-# OPTIONS -N #-}
+module System.IO.Unsafe(unsafePerformIO, unsafeInterleaveIO) where
+
+import Lhc.IO
+
+
diff --git a/lib/base/src/System/Info.hs b/lib/base/src/System/Info.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/System/Info.hs
@@ -0,0 +1,6 @@
+{-# OPTIONS_LHC -N #-}
+module System.Info where
+
+
+compilerName = "lhc"
+compilerVersion = "0"
diff --git a/lib/base/src/System/Locale.hs b/lib/base/src/System/Locale.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/System/Locale.hs
@@ -0,0 +1,30 @@
+module System.Locale where
+
+data TimeLocale = TimeLocale {
+        wDays  :: [(String, String)],   -- full and abbreviated week days
+        months :: [(String, String)],   -- full and abbreviated months
+        amPm   :: (String, String),     -- AM/PM symbols
+        dateTimeFmt, dateFmt,           -- formatting strings
+          timeFmt, time12Fmt :: String
+        } deriving (Eq, Ord,Show)
+
+defaultTimeLocale :: TimeLocale
+defaultTimeLocale =  TimeLocale {
+        wDays  = [("Sunday",   "Sun"),  ("Monday",    "Mon"),
+                  ("Tuesday",  "Tue"),  ("Wednesday", "Wed"),
+                  ("Thursday", "Thu"),  ("Friday",    "Fri"),
+                  ("Saturday", "Sat")],
+
+        months = [("January",   "Jan"), ("February",  "Feb"),
+                  ("March",     "Mar"), ("April",     "Apr"),
+                  ("May",       "May"), ("June",      "Jun"),
+                  ("July",      "Jul"), ("August",    "Aug"),
+                  ("September", "Sep"), ("October",   "Oct"),
+                  ("November",  "Nov"), ("December",  "Dec")],
+
+        amPm = ("AM", "PM"),
+        dateTimeFmt = "%a %b %e %H:%M:%S %Z %Y",
+        dateFmt = "%m/%d/%y",
+        timeFmt = "%H:%M:%S",
+        time12Fmt = "%I:%M:%S %p"
+        }
diff --git a/lib/base/src/System/Random.hs b/lib/base/src/System/Random.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/System/Random.hs
@@ -0,0 +1,268 @@
+{-# OPTIONS_LHC -fffi #-}
+{-
+The June 1988 (v31 #6) issue of the Communications of the ACM has an
+article by Pierre L'Ecuyer called, "Efficient and Portable Combined
+Random Number Generators".  Here is the Portable Combined Generator of
+L'Ecuyer for 32-bit computers.  It has a period of roughly 2.30584e18.
+
+Transliterator: Lennart Augustsson
+
+sof 1/99 - code brought (kicking and screaming) into the new Random
+world..
+
+malcolm 2/00 - patched for nhc98
+-}
+
+module System.Random
+	(
+	  RandomGen(next, split, genRange)
+	, StdGen
+	, mkStdGen
+	, Random ( random,   randomR,
+		   randoms,  randomRs,
+		   randomIO, randomRIO )
+	, getStdRandom
+	, getStdGen
+	, setStdGen
+	, newStdGen
+	) where
+
+import Data.Char ( isSpace, chr, ord )
+import Numeric
+import Foreign.Storable
+import Foreign.Ptr
+
+
+
+class RandomGen g where
+    next  :: g -> (Int, g)
+    split :: g -> (g, g)
+    genRange :: g -> (Int,Int)
+    genRange g = (minBound,maxBound)
+
+data StdGen = StdGen !Int !Int
+
+instance RandomGen StdGen where
+  next  = stdNext
+  split = stdSplit
+  genRange g = (minBound,maxBound)
+  -- without this Hat+nhc98 do not work
+
+instance Show StdGen where
+  showsPrec p (StdGen s1 s2) =
+     showsPrec p s1 .
+     showChar ' ' .
+     showsPrec p s2
+
+instance Read StdGen where
+  readsPrec _p = \ r ->
+     case try_read r of
+       r@[_] -> r
+       _   -> [stdFromString r] -- because it shouldn't ever fail.
+    where
+      try_read r = do
+         (s1, r1) <- readDec (dropWhile isSpace r)
+	 (s2, r2) <- readDec (dropWhile isSpace r1)
+	 return (StdGen s1 s2, r2)
+
+{-
+ If we cannot unravel the StdGen from a string, create
+ one based on the string given.
+-}
+stdFromString         :: String -> (StdGen, String)
+stdFromString s        = (mkStdGen num, rest)
+	where (cs, rest) = splitAt 6 s
+              num        = foldl (\a x -> x + 3 * a) 1 (map ord cs)
+
+
+mkStdGen :: Int -> StdGen -- why not Integer ?
+mkStdGen s
+ | s < 0     = mkStdGen (-s)
+ | otherwise = StdGen (s1+1) (s2+1)
+      where
+	(q, s1) = s `divMod` 2147483562
+	s2      = q `mod` 2147483398
+
+createStdGen :: Integer -> StdGen
+createStdGen s
+ | s < 0     = createStdGen (-s)
+ | otherwise = StdGen (toInt (s1+1)) (toInt (s2+1))
+      where
+	(q, s1) = s `divMod` 2147483562
+	s2      = q `mod` 2147483398
+
+
+
+class Random a where
+  -- Minimal complete definition: random and randomR
+  random  :: RandomGen g => g -> (a, g)
+  randomR :: RandomGen g => (a,a) -> g -> (a,g)
+  randoms  :: RandomGen g => g -> [a]
+  randomRs :: RandomGen g => (a,a) -> g -> [a]
+  randomIO  :: IO a
+  randomRIO :: (a,a) -> IO a
+
+  randomRs ival g = x : randomRs ival g' where
+    (x,g') = randomR ival g
+  randomIO	   = getStdRandom random
+  randoms  g      = (\(x,g') -> x : randoms g') (random g)
+  randomRIO range  = getStdRandom (randomR range)
+
+instance Random Int where
+  randomR (a,b) g = randomIvalInteger (toInteger a, toInteger b) g
+  random g        = randomR (minBound,maxBound) g
+
+instance Random Char where
+  randomR (a,b) g =
+      case (randomIvalInteger (toInteger (ord a), toInteger (ord b)) g) of
+        (x,g) -> (chr x, g)
+  random g	  = randomR (minBound,maxBound) g
+
+instance Random Bool where
+  randomR (a,b) g =
+      case (randomIvalInteger (toInteger (bool2Int a), toInteger (bool2Int b)) g) of
+        (x, g) -> (int2Bool (x::Int), g)
+       where
+         bool2Int False = (0::Int)
+         bool2Int True  = 1
+
+	 int2Bool 0	= False
+	 int2Bool _	= True
+
+  random g	  = randomR (minBound,maxBound) g
+
+instance Random Integer where
+  randomR ival g = randomIvalInteger ival g
+  random g	 = randomR (toInteger (minBound::Int), toInteger (maxBound::Int)) g
+
+instance Random Double where
+  randomR ival g = randomIvalDouble ival id g
+  random g       = randomR (0::Double,1) g
+
+-- hah, so you thought you were saving cycles by using Float?
+
+instance Random Float where
+  random g        = randomIvalDouble (0::Double,1) realToFrac g
+  randomR (a,b) g = randomIvalDouble (realToFrac a, realToFrac b) realToFrac g
+
+
+
+mkStdRNG :: Integer -> IO StdGen
+mkStdRNG o = return (createStdGen o)
+--mkStdRNG :: Integer -> IO StdGen
+--mkStdRNG o = do
+--    ct          <- getCPUTime
+--    (TOD sec _) <- getClockTime
+--    return (createStdGen (sec * 12345 + ct + o))
+
+randomIvalInteger :: (RandomGen g, Num a) => (Integer, Integer) -> g -> (a, g)
+randomIvalInteger (l,h) rng
+ | l > h     = randomIvalInteger (h,l) rng
+ | otherwise = case (f n 1 rng) of (v, rng') -> (fromInteger (l + v `mod` k), rng')
+     where
+       k = h - l + 1
+       b = 2147483561
+       --b = 2147  -- TODO Bad!
+       n = iLogBase b k
+
+       f 0 acc g = (acc, g)
+       f n acc g =
+          let
+	   (x,g')   = next g
+	  in
+	  f (n-1) (fromInt x + acc * b) g'
+
+randomIvalDouble :: (RandomGen g, Fractional a) => (Double, Double) -> (Double -> a) -> g -> (a, g)
+randomIvalDouble (l,h) fromDouble rng
+  | l > h     = randomIvalDouble (h,l) fromDouble rng
+  | otherwise =
+       case (randomIvalInteger (toInteger (minBound::Int), toInteger (maxBound::Int)) rng) of
+         (x, rng') ->
+	    let
+	     scaled_x =
+		fromDouble ((l+h)/2) +
+                fromDouble ((h-l) / realToFrac intRange) *
+		fromIntegral (x::Int)
+	    in
+	    (scaled_x, rng')
+
+intRange :: Integer
+intRange  = toInteger (maxBound::Int) - toInteger (minBound::Int)
+
+iLogBase :: Integer -> Integer -> Integer
+iLogBase b i = if i < b then 1 else 1 + iLogBase b (i `div` b)
+
+stdNext :: StdGen -> (Int, StdGen)
+stdNext (StdGen s1 s2) = (z', StdGen s1'' s2'')
+	where	z'   = if z < 1 then z + 2147483562 else z
+		z    = s1'' - s2''
+
+		k    = s1 `quot` 53668
+		s1'  = 40014 * (s1 - k * 53668) - k * 12211
+		s1'' = if s1' < 0 then s1' + 2147483563 else s1'
+
+		k'   = s2 `quot` 52774
+		s2'  = 40692 * (s2 - k' * 52774) - k' * 3791
+		s2'' = if s2' < 0 then s2' + 2147483399 else s2'
+
+stdSplit            :: StdGen -> (StdGen, StdGen)
+stdSplit std@(StdGen s1 s2)
+                     = (left, right)
+                       where
+                        -- no statistical foundation for this!
+                        left    = StdGen new_s1 t2
+                        right   = StdGen t1 new_s2
+
+                        new_s1 | s1 == 2147483562 = 1
+                               | otherwise        = s1 + 1
+
+                        new_s2 | s2 == 1          = 2147483398
+                               | otherwise        = s2 - 1
+
+                        StdGen t1 t2 = snd (next std)
+--  #else
+-- stdSplit :: StdGen -> (StdGen, StdGen)
+-- stdSplit std@(StdGen s1 _) = (std, unsafePerformIO (mkStdRNG (fromInt s1)))
+--  #endif	
+
+
+--ptr_a = unsafePerformIO $ malloc
+--ptr_b = unsadePerformIO $ malloc
+
+--setStdGen :: StdGen -> IO ()
+--setStdGen sgen = writeIORef theStdGen sgen
+
+--getStdGen :: IO StdGen
+--getStdGen  = readIORef theStdGen
+
+--theStdGen :: IORef StdGen
+--theStdGen  = unsafePerformIO (newIORef (createStdGen 0))
+
+setStdGen :: StdGen -> IO ()
+getStdGen :: IO StdGen
+setStdGen (StdGen a b) = do
+    pokeElemOff c_stdrnd 0 a
+    pokeElemOff c_stdrnd 1 b
+getStdGen = do
+    a <- peekElemOff c_stdrnd 0
+    b <- peekElemOff c_stdrnd 1
+    return $ StdGen a b
+
+
+foreign import ccall "&lhc_stdrnd" c_stdrnd :: Ptr Int
+
+
+newStdGen :: IO StdGen
+newStdGen = do
+  rng <- getStdGen
+  let (a,b) = split rng
+  setStdGen a
+  return b
+
+getStdRandom :: (StdGen -> (a,StdGen)) -> IO a
+getStdRandom f = do
+   rng		<- getStdGen
+   let (v, new_rng) = f rng
+   setStdGen new_rng
+   return v
+
diff --git a/lib/base/src/System/Time.hs b/lib/base/src/System/Time.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/System/Time.hs
@@ -0,0 +1,232 @@
+{-# OPTIONS_LHC -fffi #-}
+module System.Time (
+    ClockTime,
+    Month(..),
+    Day(..),
+    CalendarTime(..),
+    TimeDiff(..),
+    getClockTime,
+    addToClockTime,
+    diffClockTimes,
+    toCalendarTime,
+    toUTCTime,
+    toClockTime,
+    calendarTimeToString,
+    formatCalendarTime
+    ) where
+
+import Data.Char
+import Data.Ix
+import Foreign.C.Types
+import Foreign.Ptr
+import System.Locale
+import System.IO.Unsafe
+
+data ClockTime = TOD !Integer !Integer -- Implementation-dependent
+    deriving(Eq,Ord)
+
+-- When a ClockTime is shown, it is converted to a CalendarTime in the current
+-- timezone and then printed.  FIXME: This is arguably wrong, since we can't
+-- get the current timezone without being in the IO monad.
+
+instance Show ClockTime where
+    showsPrec _ t = showString (calendarTimeToString
+	  			 (unsafePerformIO (toCalendarTime t)))
+
+data Month =  January   | February | March    | April
+           |  May       | June     | July     | August
+           |  September | October  | November | December
+           deriving (Eq, Ord, Enum, Bounded, Read, Show)
+
+instance Ix Month where
+    range (x,y) = enumFromTo x y
+    index (x,y) i
+        | y < x || i < x || i > y = error "Time.Month.Ix: index out of range"
+        | otherwise = fromEnum i - fromEnum x
+    inRange (x,y) i = y >= x && (not $ i < x || i > y)
+    rangeSize (x,y)
+        | y < x = 0
+        | otherwise = fromEnum y - fromEnum x
+
+
+
+data Day   =  Sunday | Monday  | Tuesday  | Wednesday | Thursday
+           |  Friday | Saturday
+           deriving (Eq, Ord, Enum, Bounded, Read, Show)
+
+instance Ix Day where
+    range (x,y) = enumFromTo x y
+    index (x,y) i
+        | y < x || i < x || i > y = error "Time.Day.Ix: index out of range"
+        | otherwise = fromEnum i - fromEnum x
+    inRange (x,y) i = y >= x && (not $ i < x || i > y)
+    rangeSize (x,y)
+        | y < x = 0
+        | otherwise = fromEnum y - fromEnum x
+
+data CalendarTime = CalendarTime {
+    ctYear       :: !Int,
+    ctMonth      :: !Month,
+    ctDay, ctHour, ctMin, ctSec  :: !Int,
+    ctPicosec    :: !Integer,
+    ctWDay       :: !Day,
+    ctYDay       :: !Int,
+    ctTZName     :: String,
+    ctTZ         :: !Int,
+    ctIsDST      :: !Bool
+    } deriving (Eq, Ord)
+
+data TimeDiff = TimeDiff {
+    tdYear, tdMonth, tdDay, tdHour, tdMin, tdSec :: !Int,
+    tdPicosec      :: !Integer
+    } deriving (Eq, Ord)
+
+
+-- Functions on times
+getClockTime         :: IO ClockTime
+getClockTime = do
+    secs <- c_time nullPtr -- can't fail, according to POSIX
+    return (TOD (ctimeToInteger secs) 0)
+
+foreign import primitive "U2U" ctimeToInteger :: CTime -> Integer
+   -- -----------------------------------------------------------------------------
+-- | converts an internal clock time to a local time, modified by the
+-- timezone and daylight savings time settings in force at the time
+-- of conversion.  Because of this dependence on the local environment,
+-- 'toCalendarTime' is in the 'IO' monad.
+
+toCalendarTime :: ClockTime -> IO CalendarTime
+toCalendarTime =  toCalTime False
+
+-- | converts an internal clock time into a 'CalendarTime' in standard
+-- UTC format.
+
+toUTCTime :: ClockTime -> CalendarTime
+toUTCTime      =  unsafePerformIO . toCalTime True
+
+toCalTime :: Bool -> ClockTime -> IO CalendarTime
+toCalTime = error "toCalTime"
+
+toClockTime          :: CalendarTime -> ClockTime
+toClockTime = error "toClockTime"
+
+calendarTimeToString    :: CalendarTime -> String
+calendarTimeToString    =  formatCalendarTime defaultTimeLocale "%c"
+
+-- -----------------------------------------------------------------------------
+-- | @'addToClockTime' d t@ adds a time difference @d@ and a
+-- clock time @t@ to yield a new clock time.  The difference @d@
+-- may be either positive or negative.
+
+addToClockTime  :: TimeDiff  -> ClockTime -> ClockTime
+addToClockTime (TimeDiff year mon day hour min sec psec)
+	       (TOD c_sec c_psec) =
+	let
+	  sec_diff = toInteger sec +
+                     60 * toInteger min +
+                     3600 * toInteger hour +
+                     24 * 3600 * toInteger day
+	  cal      = toUTCTime (TOD (c_sec + sec_diff) (c_psec + psec))
+                                                       -- FIXME! ^^^^
+          new_mon  = fromEnum (ctMonth cal) + r_mon
+	  month' = fst tmp
+	  yr_diff = snd tmp
+          tmp
+	    | new_mon < 0  = (toEnum (12 + new_mon), (-1))
+	    | new_mon > 11 = (toEnum (new_mon `mod` 12), 1)
+	    | otherwise    = (toEnum new_mon, 0)
+
+	  (r_yr, r_mon) = mon `quotRem` 12
+
+          year' = ctYear cal + year + r_yr + yr_diff
+	in
+	toClockTime cal{ctMonth=month', ctYear=year'}
+
+-- | @'diffClockTimes' t1 t2@ returns the difference between two clock
+-- times @t1@ and @t2@ as a 'TimeDiff'.
+
+diffClockTimes  :: ClockTime -> ClockTime -> TimeDiff
+-- diffClockTimes is meant to be the dual to `addToClockTime'.
+-- If you want to have the TimeDiff properly splitted, use
+-- `normalizeTimeDiff' on this function's result
+--
+-- CAVEAT: see comment of normalizeTimeDiff
+diffClockTimes (TOD sa pa) (TOD sb pb) =
+    noTimeDiff{ tdSec     = fromIntegral (sa - sb)
+                -- FIXME: can handle just 68 years...
+              , tdPicosec = pa - pb
+              }
+
+noTimeDiff :: TimeDiff
+noTimeDiff = TimeDiff 0 0 0 0 0 0 0
+
+
+formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String
+formatCalendarTime l fmt ct@(CalendarTime year mon day hour min sec sdec
+                                           wday yday tzname _ _) =
+        doFmt fmt
+  where doFmt ('%':c:cs) = decode c ++ doFmt cs
+        doFmt (c:cs) = c : doFmt cs
+        doFmt "" = ""
+
+        to12 :: Int -> Int
+        to12 h = let h' = h `mod` 12 in if h' == 0 then 12 else h'
+
+        decode 'A' = fst (wDays l  !! fromEnum wday)
+        decode 'a' = snd (wDays l  !! fromEnum wday)
+        decode 'B' = fst (months l !! fromEnum mon)
+        decode 'b' = snd (months l !! fromEnum mon)
+        decode 'h' = snd (months l !! fromEnum mon)
+        decode 'C' = show2 (year `quot` 100)
+        decode 'c' = doFmt (dateTimeFmt l)
+        decode 'D' = doFmt "%m/%d/%y"
+        decode 'd' = show2 day
+        decode 'e' = show2' day
+        decode 'H' = show2 hour
+        decode 'I' = show2 (to12 hour)
+        decode 'j' = show3 yday
+        decode 'k' = show2' hour
+        decode 'l' = show2' (to12 hour)
+        decode 'M' = show2 min
+        decode 'm' = show2 (fromEnum mon+1)
+        decode 'n' = "\n"
+        decode 'p' = (if hour < 12 then fst else snd) (amPm l)
+        decode 'R' = doFmt "%H:%M"
+        decode 'r' = doFmt (time12Fmt l)
+        decode 'T' = doFmt "%H:%M:%S"
+        decode 't' = "\t"
+        decode 'S' = show2 sec
+--        decode 's' = ...                -- Implementation-dependent
+        decode 'U' = show2 ((yday + 7 - fromEnum wday) `div` 7)
+        decode 'u' = show (let n = fromEnum wday in
+                           if n == 0 then 7 else n)
+        decode 'V' =
+            let (week, days) =
+                   (yday + 7 - if fromEnum wday > 0 then
+                               fromEnum wday - 1 else 6) `divMod` 7
+            in  show2 (if days >= 4 then
+                          week+1
+                       else if week == 0 then 53 else week)
+
+        decode 'W' =
+            show2 ((yday + 7 - if fromEnum wday > 0 then
+                               fromEnum wday - 1 else 6) `div` 7)
+        decode 'w' = show (fromEnum wday)
+        decode 'X' = doFmt (timeFmt l)
+        decode 'x' = doFmt (dateFmt l)
+        decode 'Y' = show year
+        decode 'y' = show2 (year `rem` 100)
+        decode 'Z' = tzname
+        decode '%' = "%"
+        decode c   = [c]
+
+show2, show2', show3 :: Int -> String
+show2 x = [intToDigit (x `quot` 10), intToDigit (x `rem` 10)]
+
+show2' x = if x < 10 then [ ' ', intToDigit x] else show2 x
+
+show3 x = intToDigit (x `quot` 100) : show2 (x `rem` 100)
+
+
+foreign import unsafe ccall "time.h time" c_time :: Ptr CTime -> IO CTime
+
diff --git a/lib/base/src/Text/Printf.hs b/lib/base/src/Text/Printf.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Text/Printf.hs
@@ -0,0 +1,276 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Text.Printf
+-- Copyright   :  (c) Lennart Augustsson, 2004
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  lennart@augustsson.net
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A C printf like formatter.
+--
+-----------------------------------------------------------------------------
+
+module Text.Printf(
+   printf, hPrintf,
+   PrintfType, HPrintfType, PrintfArg, IsChar
+) where
+
+import Prelude
+import Data.Char
+import Numeric(showEFloat, showFFloat, showGFloat)
+import System.IO
+
+-------------------
+
+-- | Format a variable number of arguments with the C-style formatting string.
+-- The return value is either 'String' or @('IO' a)@.
+--
+-- The format string consists of ordinary characters and /conversion
+-- specifications/, which specify how to format one of the arguments
+-- to printf in the output string.  A conversion specification begins with the
+-- character @%@, followed by one or more of the following flags:
+--
+-- >    -      left adjust (default is right adjust)
+-- >    0      pad with zeroes rather than spaces
+--
+-- followed optionally by a field width:
+--
+-- >    num    field width
+-- >    *      as num, but taken from argument list
+--
+-- followed optionally by a precision:
+--
+-- >    .num   precision (number of decimal places)
+--
+-- and finally, a format character:
+--
+-- >    c      character               Char, Int, Integer
+-- >    d      decimal                 Char, Int, Integer
+-- >    o      octal                   Char, Int, Integer
+-- >    x      hexadecimal             Char, Int, Integer
+-- >    u      unsigned decimal        Char, Int, Integer
+-- >    f      floating point          Float, Double
+-- >    g      general format float    Float, Double
+-- >    e      exponent format float   Float, Double
+-- >    s      string                  String
+--
+-- Mismatch between the argument types and the format string will cause
+-- an exception to be thrown at runtime.
+--
+-- Examples:
+--
+-- >   > printf "%d\n" (23::Int)
+-- >   23
+-- >   > printf "%s %s\n" "Hello" "World"
+-- >   Hello World
+-- >   > printf "%.2f\n" pi
+-- >   3.14
+--
+printf :: (PrintfType r) => String -> r
+printf fmt = spr fmt []
+
+-- | Similar to 'printf', except that output is via the specified
+-- 'Handle'.  The return type is restricted to @('IO' a)@.
+hPrintf :: (HPrintfType r) => Handle -> String -> r
+hPrintf hdl fmt = hspr hdl fmt []
+
+-- |The 'PrintfType' class provides the variable argument magic for
+-- 'printf'.  Its implementation is intentionally not visible from
+-- this module. If you attempt to pass an argument of a type which
+-- is not an instance of this class to 'printf' or 'hPrintf', then
+-- the compiler will report it as a missing instance of 'PrintfArg'.
+class PrintfType t where
+    spr :: String -> [UPrintf] -> t
+
+-- | The 'HPrintfType' class provides the variable argument magic for
+-- 'hPrintf'.  Its implementation is intentionally not visible from
+-- this module.
+class HPrintfType t where
+    hspr :: Handle -> String -> [UPrintf] -> t
+
+{- not allowed in Haskell 98
+instance PrintfType String where
+    spr fmt args = uprintf fmt (reverse args)
+-}
+instance (IsChar c) => PrintfType [c] where
+    spr fmt args = map fromChar (uprintf fmt (reverse args))
+
+instance PrintfType (IO a) where
+    spr fmt args = do
+	putStr (uprintf fmt (reverse args))
+	return undefined
+
+instance HPrintfType (IO a) where
+    hspr hdl fmt args = do
+	hPutStr hdl (uprintf fmt (reverse args))
+	return undefined
+
+instance (PrintfArg a, PrintfType r) => PrintfType (a -> r) where
+    spr fmt args = \ a -> spr fmt (toUPrintf a : args)
+
+instance (PrintfArg a, HPrintfType r) => HPrintfType (a -> r) where
+    hspr hdl fmt args = \ a -> hspr hdl fmt (toUPrintf a : args)
+
+class PrintfArg a where
+    toUPrintf :: a -> UPrintf
+
+instance PrintfArg Char where
+    toUPrintf c = UChar c
+
+{- not allowed in Haskell 98
+instance PrintfArg String where
+    toUPrintf s = UString s
+-}
+instance (IsChar c) => PrintfArg [c] where
+    toUPrintf s = UString (map toChar s)
+
+instance PrintfArg Int where
+    toUPrintf i = UInt i
+
+instance PrintfArg Integer where
+    toUPrintf i = UInteger i
+
+instance PrintfArg Float where
+    toUPrintf f = UFloat f
+
+instance PrintfArg Double where
+    toUPrintf d = UDouble d
+
+class IsChar c where
+    toChar :: c -> Char
+    fromChar :: Char -> c
+
+instance IsChar Char where
+    toChar c = c
+    fromChar c = c
+
+-------------------
+
+data UPrintf = UChar Char | UString String | UInt Int | UInteger Integer | UFloat Float | UDouble Double
+
+uprintf :: String -> [UPrintf] -> String
+uprintf ""       []       = ""
+uprintf ""       (_:_)    = fmterr
+uprintf ('%':'%':cs) us   = '%':uprintf cs us
+uprintf ('%':_)  []       = argerr
+uprintf ('%':cs) us@(_:_) = fmt cs us
+uprintf (c:cs)   us       = c:uprintf cs us
+
+fmt :: String -> [UPrintf] -> String
+fmt cs us =
+	let (width, prec, ladj, zero, cs', us') = getSpecs False False cs us
+	    adjust (pre, str) =
+		let lstr = length str
+		    lpre = length pre
+		    fill = if lstr+lpre < width then take (width-(lstr+lpre)) (repeat (if zero then '0' else ' ')) else ""
+		in  if ladj then pre ++ str ++ fill else if zero then pre ++ fill ++ str else fill ++ pre ++ str
+        in
+	case cs' of
+	[]     -> fmterr
+	c:cs'' ->
+	    case us' of
+	    []     -> argerr
+	    u:us'' ->
+		(case c of
+		'c' -> adjust ("", [toEnum (toint u)])
+		'd' -> adjust (fmti u)
+		'x' -> adjust ("", fmtu 16 u)
+		'o' -> adjust ("", fmtu 8  u)
+		'u' -> adjust ("", fmtu 10 u)
+		'e' -> adjust (dfmt' c prec u)
+		'f' -> adjust (dfmt' c prec u)
+		'g' -> adjust (dfmt' c prec u)
+		's' -> adjust ("", tostr u)
+		c   -> perror ("bad formatting char " ++ [c])
+		 ) ++ uprintf cs'' us''
+
+fmti (UInt i)     = if i < 0 then
+			if i == -i then fmti (UInteger (toInteger i)) else ("-", itos (-i))
+		    else
+			("", itos i)
+fmti (UInteger i) = if i < 0 then ("-", itos (-i)) else ("", itos i)
+fmti (UChar c)    = fmti (UInt (fromEnum c))
+fmti u		  = baderr
+
+fmtu b (UInt i)     = if i < 0 then
+			  if i == -i then itosb b (maxi - toInteger (i+1) - 1) else itosb b (maxi - toInteger (-i))
+		      else
+			  itosb b (toInteger i)
+fmtu b (UInteger i) = itosb b i
+fmtu b (UChar c)    = itosb b (toInteger (fromEnum c))
+fmtu b u            = baderr
+
+maxi :: Integer
+maxi = (toInteger (maxBound::Int) + 1) * 2
+
+toint (UInt i)     = i
+toint (UInteger i) = toInt i
+toint (UChar c)    = fromEnum c
+toint u		   = baderr
+
+tostr (UString s) = s
+tostr u		  = baderr
+
+itos n =
+	if n < 10 then
+	    [toEnum (fromEnum '0' + toInt n)]
+	else
+	    let (q, r) = quotRem n 10 in
+	    itos q ++ [toEnum (fromEnum '0' + toInt r)]
+
+itosb :: Integer -> Integer -> String
+itosb b n =
+	if n < b then
+	    [intToDigit $ fromInteger n]
+	else
+	    let (q, r) = quotRem n b in
+	    itosb b q ++ [intToDigit $ fromInteger r]
+
+stoi :: Int -> String -> (Int, String)
+stoi a (c:cs) | isDigit c = stoi (a*10 + fromEnum c - fromEnum '0') cs
+stoi a cs                 = (a, cs)
+
+getSpecs :: Bool -> Bool -> String -> [UPrintf] -> (Int, Int, Bool, Bool, String, [UPrintf])
+getSpecs l z ('-':cs) us = getSpecs True z cs us
+getSpecs l z ('0':cs) us = getSpecs l True cs us
+getSpecs l z ('*':cs) us =
+        case us of
+        [] -> argerr
+        nu : us' ->
+	    let n = toint nu
+		(p, cs'', us'') =
+		    case cs of
+                    '.':'*':r -> case us' of { [] -> argerr; pu:us'' -> (toint pu, r, us'') }
+		    '.':r     -> let (n, cs') = stoi 0 r in (n, cs', us')
+		    _         -> (-1, cs, us')
+	    in  (n, p, l, z, cs'', us'')
+getSpecs l z ('.':cs) us =
+	let (p, cs') = stoi 0 cs
+	in  (0, p, l, z, cs', us)
+getSpecs l z cs@(c:_) us | isDigit c =
+	let (n, cs') = stoi 0 cs
+	    (p, cs'') = case cs' of
+			'.':r -> stoi 0 r
+			_     -> (-1, cs')
+	in  (n, p, l, z, cs'', us)
+getSpecs l z cs       us = (0, -1, l, z, cs, us)
+
+dfmt' c p (UDouble d) = dfmt c p d
+dfmt' c p (UFloat f)  = dfmt c p f
+dfmt' c p u           = baderr
+
+dfmt c p d =
+	case (case c of 'e' -> showEFloat; 'f' -> showFFloat; 'g' -> showGFloat)
+               (if p < 0 then Nothing else Just p) d "" of
+	'-':cs -> ("-", cs)
+	cs     -> ("" , cs)
+
+perror s = error ("Printf.printf: "++s)
+fmterr = perror "formatting string ended prematurely"
+argerr = perror "argument list ended prematurely"
+baderr = perror "bad argument"
+
+toInt :: (Integral a) => a -> Int
+toInt x = fromInteger (toInteger x)
diff --git a/lib/base/src/Text/Show/Functions.hs b/lib/base/src/Text/Show/Functions.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Text/Show/Functions.hs
@@ -0,0 +1,5 @@
+module Text.Show.Functions where
+
+
+instance Show (a -> b) where
+    showsPrec _ _ = showString "<function>"
diff --git a/lib/base/src/Typeable.hs b/lib/base/src/Typeable.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Typeable.hs
@@ -0,0 +1,15 @@
+module Typeable where
+
+class Typeable a where
+    typeOf :: a -> String
+    typeOf _ = "Unknown"
+
+instance Typeable Char where
+    typeOf _ = "Char"
+
+instance Typeable Bool where
+    typeOf _ = "Bool"
+
+instance Typeable a => Typeable [a] where
+    typeOf x = "[" ++ typeOf (head x) ++ "]"
+
diff --git a/lib/base/src/Unsafe/Coerce.hs b/lib/base/src/Unsafe/Coerce.hs
new file mode 100644
--- /dev/null
+++ b/lib/base/src/Unsafe/Coerce.hs
@@ -0,0 +1,5 @@
+{-# OPTIONS_LHC -N -fffi #-}
+module Unsafe.Coerce(unsafeCoerce) where
+
+
+foreign import primitive unsafeCoerce :: a -> b