diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,32 @@
+The Timber compiler <timber-lang.org>
+
+Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+
+3. Neither the names of the copyright holder and any identified
+   contributors, nor the names of their affiliations, may be used to 
+   endorse or promote products derived from this software without 
+   specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,33 @@
+#! /usr/bin/env runhaskell
+
+ 
+> import System.Cmd
+> import System.Directory
+> import System.FilePath
+
+> import Distribution.Simple.UserHooks
+> import Distribution.Simple.Setup
+> import Distribution.Simple.Command
+> import Distribution.Simple.Utils ( rawSystemExit )
+> import Distribution.Simple -- (defaultMainWithHooks, autoconfUserHooks)
+> import Distribution.Simple.InstallDirs  (CopyDest(..))
+> import Distribution.Simple.LocalBuildInfo (absoluteInstallDirs, InstallDirs(..) )
+> main = defaultMainWithHooks simpleUserHooks { postInst = myPostInst }
+
+> buildRTS timberc dataDir
+>  = do 
+>       system("cd rtsPOSIX && chmod +x configure")
+>       system("cd rtsPOSIX && ./configure --prefix=" ++ dataDir ++ " --with-timberc=" ++ timberc)
+>       system("cd rtsPOSIX && make install")
+>       return ()
+
+> myPostInst args iflags pkg_descr lbi = do
+>    let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest 
+>        dataDir = datadir dirs
+>        timberc = bindir dirs </> "timberc"
+>        script = "#!/bin/sh\n\nexec " ++ dataDir ++ "/timberc ${1+\"$@\"} --datadir " ++ dataDir ++ "\n"
+>    copyFile timberc (dataDir </> "timberc")
+>    writeFile timberc script
+>    buildRTS timberc dataDir
+>    return ()
+
diff --git a/dist/build/timberc/timberc-tmp/Parser.hs b/dist/build/timberc/timberc-tmp/Parser.hs
new file mode 100644
--- /dev/null
+++ b/dist/build/timberc/timberc-tmp/Parser.hs
@@ -0,0 +1,3712 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+module Parser (parser) where
+
+import Common
+import Token
+import Lexer
+import ParseMonad
+import Syntax
+import Fixity
+#if __GLASGOW_HASKELL__ >= 503
+import Data.Array
+#else
+import Array
+#endif
+#if __GLASGOW_HASKELL__ >= 503
+import GHC.Exts
+#else
+import GlaExts
+#endif
+
+-- parser produced by Happy Version 1.18.2
+
+newtype HappyAbsSyn  = HappyAbsSyn HappyAny
+#if __GLASGOW_HASKELL__ >= 607
+type HappyAny = GHC.Exts.Any
+#else
+type HappyAny = forall a . a
+#endif
+happyIn4 :: (Module) -> (HappyAbsSyn )
+happyIn4 x = unsafeCoerce# x
+{-# INLINE happyIn4 #-}
+happyOut4 :: (HappyAbsSyn ) -> (Module)
+happyOut4 x = unsafeCoerce# x
+{-# INLINE happyOut4 #-}
+happyIn5 :: (([Import],[Decl],[Decl])) -> (HappyAbsSyn )
+happyIn5 x = unsafeCoerce# x
+{-# INLINE happyIn5 #-}
+happyOut5 :: (HappyAbsSyn ) -> (([Import],[Decl],[Decl]))
+happyOut5 x = unsafeCoerce# x
+{-# INLINE happyOut5 #-}
+happyIn6 :: ([Decl]) -> (HappyAbsSyn )
+happyIn6 x = unsafeCoerce# x
+{-# INLINE happyIn6 #-}
+happyOut6 :: (HappyAbsSyn ) -> ([Decl])
+happyOut6 x = unsafeCoerce# x
+{-# INLINE happyOut6 #-}
+happyIn7 :: ([Decl]) -> (HappyAbsSyn )
+happyIn7 x = unsafeCoerce# x
+{-# INLINE happyIn7 #-}
+happyOut7 :: (HappyAbsSyn ) -> ([Decl])
+happyOut7 x = unsafeCoerce# x
+{-# INLINE happyOut7 #-}
+happyIn8 :: ([Import]) -> (HappyAbsSyn )
+happyIn8 x = unsafeCoerce# x
+{-# INLINE happyIn8 #-}
+happyOut8 :: (HappyAbsSyn ) -> ([Import])
+happyOut8 x = unsafeCoerce# x
+{-# INLINE happyOut8 #-}
+happyIn9 :: (Import) -> (HappyAbsSyn )
+happyIn9 x = unsafeCoerce# x
+{-# INLINE happyIn9 #-}
+happyOut9 :: (HappyAbsSyn ) -> (Import)
+happyOut9 x = unsafeCoerce# x
+{-# INLINE happyOut9 #-}
+happyIn10 :: ([Decl]) -> (HappyAbsSyn )
+happyIn10 x = unsafeCoerce# x
+{-# INLINE happyIn10 #-}
+happyOut10 :: (HappyAbsSyn ) -> ([Decl])
+happyOut10 x = unsafeCoerce# x
+{-# INLINE happyOut10 #-}
+happyIn11 :: ([Decl]) -> (HappyAbsSyn )
+happyIn11 x = unsafeCoerce# x
+{-# INLINE happyIn11 #-}
+happyOut11 :: (HappyAbsSyn ) -> ([Decl])
+happyOut11 x = unsafeCoerce# x
+{-# INLINE happyOut11 #-}
+happyIn12 :: ([Type]) -> (HappyAbsSyn )
+happyIn12 x = unsafeCoerce# x
+{-# INLINE happyIn12 #-}
+happyOut12 :: (HappyAbsSyn ) -> ([Type])
+happyOut12 x = unsafeCoerce# x
+{-# INLINE happyOut12 #-}
+happyIn13 :: ([Type]) -> (HappyAbsSyn )
+happyIn13 x = unsafeCoerce# x
+{-# INLINE happyIn13 #-}
+happyOut13 :: (HappyAbsSyn ) -> ([Type])
+happyOut13 x = unsafeCoerce# x
+{-# INLINE happyOut13 #-}
+happyIn14 :: ([Type]) -> (HappyAbsSyn )
+happyIn14 x = unsafeCoerce# x
+{-# INLINE happyIn14 #-}
+happyOut14 :: (HappyAbsSyn ) -> ([Type])
+happyOut14 x = unsafeCoerce# x
+{-# INLINE happyOut14 #-}
+happyIn15 :: ([Name]) -> (HappyAbsSyn )
+happyIn15 x = unsafeCoerce# x
+{-# INLINE happyIn15 #-}
+happyOut15 :: (HappyAbsSyn ) -> ([Name])
+happyOut15 x = unsafeCoerce# x
+{-# INLINE happyOut15 #-}
+happyIn16 :: ([Name]) -> (HappyAbsSyn )
+happyIn16 x = unsafeCoerce# x
+{-# INLINE happyIn16 #-}
+happyOut16 :: (HappyAbsSyn ) -> ([Name])
+happyOut16 x = unsafeCoerce# x
+{-# INLINE happyOut16 #-}
+happyIn17 :: ([Default Type]) -> (HappyAbsSyn )
+happyIn17 x = unsafeCoerce# x
+{-# INLINE happyIn17 #-}
+happyOut17 :: (HappyAbsSyn ) -> ([Default Type])
+happyOut17 x = unsafeCoerce# x
+{-# INLINE happyOut17 #-}
+happyIn18 :: ([Default Type]) -> (HappyAbsSyn )
+happyIn18 x = unsafeCoerce# x
+{-# INLINE happyIn18 #-}
+happyOut18 :: (HappyAbsSyn ) -> ([Default Type])
+happyOut18 x = unsafeCoerce# x
+{-# INLINE happyOut18 #-}
+happyIn19 :: (Default Type) -> (HappyAbsSyn )
+happyIn19 x = unsafeCoerce# x
+{-# INLINE happyIn19 #-}
+happyOut19 :: (HappyAbsSyn ) -> (Default Type)
+happyOut19 x = unsafeCoerce# x
+{-# INLINE happyOut19 #-}
+happyIn20 :: ([Constr]) -> (HappyAbsSyn )
+happyIn20 x = unsafeCoerce# x
+{-# INLINE happyIn20 #-}
+happyOut20 :: (HappyAbsSyn ) -> ([Constr])
+happyOut20 x = unsafeCoerce# x
+{-# INLINE happyOut20 #-}
+happyIn21 :: ([Constr]) -> (HappyAbsSyn )
+happyIn21 x = unsafeCoerce# x
+{-# INLINE happyIn21 #-}
+happyOut21 :: (HappyAbsSyn ) -> ([Constr])
+happyOut21 x = unsafeCoerce# x
+{-# INLINE happyOut21 #-}
+happyIn22 :: ([Sig]) -> (HappyAbsSyn )
+happyIn22 x = unsafeCoerce# x
+{-# INLINE happyIn22 #-}
+happyOut22 :: (HappyAbsSyn ) -> ([Sig])
+happyOut22 x = unsafeCoerce# x
+{-# INLINE happyOut22 #-}
+happyIn23 :: ([Sig]) -> (HappyAbsSyn )
+happyIn23 x = unsafeCoerce# x
+{-# INLINE happyIn23 #-}
+happyOut23 :: (HappyAbsSyn ) -> ([Sig])
+happyOut23 x = unsafeCoerce# x
+{-# INLINE happyOut23 #-}
+happyIn24 :: ([Sig]) -> (HappyAbsSyn )
+happyIn24 x = unsafeCoerce# x
+{-# INLINE happyIn24 #-}
+happyOut24 :: (HappyAbsSyn ) -> ([Sig])
+happyOut24 x = unsafeCoerce# x
+{-# INLINE happyOut24 #-}
+happyIn25 :: ([Sig]) -> (HappyAbsSyn )
+happyIn25 x = unsafeCoerce# x
+{-# INLINE happyIn25 #-}
+happyOut25 :: (HappyAbsSyn ) -> ([Sig])
+happyOut25 x = unsafeCoerce# x
+{-# INLINE happyOut25 #-}
+happyIn26 :: (Sig) -> (HappyAbsSyn )
+happyIn26 x = unsafeCoerce# x
+{-# INLINE happyIn26 #-}
+happyOut26 :: (HappyAbsSyn ) -> (Sig)
+happyOut26 x = unsafeCoerce# x
+{-# INLINE happyOut26 #-}
+happyIn27 :: ([Bind]) -> (HappyAbsSyn )
+happyIn27 x = unsafeCoerce# x
+{-# INLINE happyIn27 #-}
+happyOut27 :: (HappyAbsSyn ) -> ([Bind])
+happyOut27 x = unsafeCoerce# x
+{-# INLINE happyOut27 #-}
+happyIn28 :: ([Bind]) -> (HappyAbsSyn )
+happyIn28 x = unsafeCoerce# x
+{-# INLINE happyIn28 #-}
+happyOut28 :: (HappyAbsSyn ) -> ([Bind])
+happyOut28 x = unsafeCoerce# x
+{-# INLINE happyOut28 #-}
+happyIn29 :: (Bind) -> (HappyAbsSyn )
+happyIn29 x = unsafeCoerce# x
+{-# INLINE happyIn29 #-}
+happyOut29 :: (HappyAbsSyn ) -> (Bind)
+happyOut29 x = unsafeCoerce# x
+{-# INLINE happyOut29 #-}
+happyIn30 :: ([Field]) -> (HappyAbsSyn )
+happyIn30 x = unsafeCoerce# x
+{-# INLINE happyIn30 #-}
+happyOut30 :: (HappyAbsSyn ) -> ([Field])
+happyOut30 x = unsafeCoerce# x
+{-# INLINE happyOut30 #-}
+happyIn31 :: (Field) -> (HappyAbsSyn )
+happyIn31 x = unsafeCoerce# x
+{-# INLINE happyIn31 #-}
+happyOut31 :: (HappyAbsSyn ) -> (Field)
+happyOut31 x = unsafeCoerce# x
+{-# INLINE happyOut31 #-}
+happyIn32 :: ([Name]) -> (HappyAbsSyn )
+happyIn32 x = unsafeCoerce# x
+{-# INLINE happyIn32 #-}
+happyOut32 :: (HappyAbsSyn ) -> ([Name])
+happyOut32 x = unsafeCoerce# x
+{-# INLINE happyOut32 #-}
+happyIn33 :: (Lhs) -> (HappyAbsSyn )
+happyIn33 x = unsafeCoerce# x
+{-# INLINE happyIn33 #-}
+happyOut33 :: (HappyAbsSyn ) -> (Lhs)
+happyOut33 x = unsafeCoerce# x
+{-# INLINE happyOut33 #-}
+happyIn34 :: (Rhs Exp) -> (HappyAbsSyn )
+happyIn34 x = unsafeCoerce# x
+{-# INLINE happyIn34 #-}
+happyOut34 :: (HappyAbsSyn ) -> (Rhs Exp)
+happyOut34 x = unsafeCoerce# x
+{-# INLINE happyOut34 #-}
+happyIn35 :: ([GExp Exp]) -> (HappyAbsSyn )
+happyIn35 x = unsafeCoerce# x
+{-# INLINE happyIn35 #-}
+happyOut35 :: (HappyAbsSyn ) -> ([GExp Exp])
+happyOut35 x = unsafeCoerce# x
+{-# INLINE happyOut35 #-}
+happyIn36 :: (GExp Exp) -> (HappyAbsSyn )
+happyIn36 x = unsafeCoerce# x
+{-# INLINE happyIn36 #-}
+happyOut36 :: (HappyAbsSyn ) -> (GExp Exp)
+happyOut36 x = unsafeCoerce# x
+{-# INLINE happyOut36 #-}
+happyIn37 :: (Type) -> (HappyAbsSyn )
+happyIn37 x = unsafeCoerce# x
+{-# INLINE happyIn37 #-}
+happyOut37 :: (HappyAbsSyn ) -> (Type)
+happyOut37 x = unsafeCoerce# x
+{-# INLINE happyOut37 #-}
+happyIn38 :: (Type) -> (HappyAbsSyn )
+happyIn38 x = unsafeCoerce# x
+{-# INLINE happyIn38 #-}
+happyOut38 :: (HappyAbsSyn ) -> (Type)
+happyOut38 x = unsafeCoerce# x
+{-# INLINE happyOut38 #-}
+happyIn39 :: ([Type]) -> (HappyAbsSyn )
+happyIn39 x = unsafeCoerce# x
+{-# INLINE happyIn39 #-}
+happyOut39 :: (HappyAbsSyn ) -> ([Type])
+happyOut39 x = unsafeCoerce# x
+{-# INLINE happyOut39 #-}
+happyIn40 :: (Type) -> (HappyAbsSyn )
+happyIn40 x = unsafeCoerce# x
+{-# INLINE happyIn40 #-}
+happyOut40 :: (HappyAbsSyn ) -> (Type)
+happyOut40 x = unsafeCoerce# x
+{-# INLINE happyOut40 #-}
+happyIn41 :: (Type) -> (HappyAbsSyn )
+happyIn41 x = unsafeCoerce# x
+{-# INLINE happyIn41 #-}
+happyOut41 :: (HappyAbsSyn ) -> (Type)
+happyOut41 x = unsafeCoerce# x
+{-# INLINE happyOut41 #-}
+happyIn42 :: ([Type]) -> (HappyAbsSyn )
+happyIn42 x = unsafeCoerce# x
+{-# INLINE happyIn42 #-}
+happyOut42 :: (HappyAbsSyn ) -> ([Type])
+happyOut42 x = unsafeCoerce# x
+{-# INLINE happyOut42 #-}
+happyIn43 :: (Int) -> (HappyAbsSyn )
+happyIn43 x = unsafeCoerce# x
+{-# INLINE happyIn43 #-}
+happyOut43 :: (HappyAbsSyn ) -> (Int)
+happyOut43 x = unsafeCoerce# x
+{-# INLINE happyOut43 #-}
+happyIn44 :: ([Pred]) -> (HappyAbsSyn )
+happyIn44 x = unsafeCoerce# x
+{-# INLINE happyIn44 #-}
+happyOut44 :: (HappyAbsSyn ) -> ([Pred])
+happyOut44 x = unsafeCoerce# x
+{-# INLINE happyOut44 #-}
+happyIn45 :: (Pred) -> (HappyAbsSyn )
+happyIn45 x = unsafeCoerce# x
+{-# INLINE happyIn45 #-}
+happyOut45 :: (HappyAbsSyn ) -> (Pred)
+happyOut45 x = unsafeCoerce# x
+{-# INLINE happyOut45 #-}
+happyIn46 :: (Kind) -> (HappyAbsSyn )
+happyIn46 x = unsafeCoerce# x
+{-# INLINE happyIn46 #-}
+happyOut46 :: (HappyAbsSyn ) -> (Kind)
+happyOut46 x = unsafeCoerce# x
+{-# INLINE happyOut46 #-}
+happyIn47 :: (Kind) -> (HappyAbsSyn )
+happyIn47 x = unsafeCoerce# x
+{-# INLINE happyIn47 #-}
+happyOut47 :: (HappyAbsSyn ) -> (Kind)
+happyOut47 x = unsafeCoerce# x
+{-# INLINE happyOut47 #-}
+happyIn48 :: (Exp) -> (HappyAbsSyn )
+happyIn48 x = unsafeCoerce# x
+{-# INLINE happyIn48 #-}
+happyOut48 :: (HappyAbsSyn ) -> (Exp)
+happyOut48 x = unsafeCoerce# x
+{-# INLINE happyOut48 #-}
+happyIn49 :: (Exp) -> (HappyAbsSyn )
+happyIn49 x = unsafeCoerce# x
+{-# INLINE happyIn49 #-}
+happyOut49 :: (HappyAbsSyn ) -> (Exp)
+happyOut49 x = unsafeCoerce# x
+{-# INLINE happyOut49 #-}
+happyIn50 :: (Exp) -> (HappyAbsSyn )
+happyIn50 x = unsafeCoerce# x
+{-# INLINE happyIn50 #-}
+happyOut50 :: (HappyAbsSyn ) -> (Exp)
+happyOut50 x = unsafeCoerce# x
+{-# INLINE happyOut50 #-}
+happyIn51 :: (Exp) -> (HappyAbsSyn )
+happyIn51 x = unsafeCoerce# x
+{-# INLINE happyIn51 #-}
+happyOut51 :: (HappyAbsSyn ) -> (Exp)
+happyOut51 x = unsafeCoerce# x
+{-# INLINE happyOut51 #-}
+happyIn52 :: (OpExp) -> (HappyAbsSyn )
+happyIn52 x = unsafeCoerce# x
+{-# INLINE happyIn52 #-}
+happyOut52 :: (HappyAbsSyn ) -> (OpExp)
+happyOut52 x = unsafeCoerce# x
+{-# INLINE happyOut52 #-}
+happyIn53 :: (OpExp) -> (HappyAbsSyn )
+happyIn53 x = unsafeCoerce# x
+{-# INLINE happyIn53 #-}
+happyOut53 :: (HappyAbsSyn ) -> (OpExp)
+happyOut53 x = unsafeCoerce# x
+{-# INLINE happyOut53 #-}
+happyIn54 :: (Exp) -> (HappyAbsSyn )
+happyIn54 x = unsafeCoerce# x
+{-# INLINE happyIn54 #-}
+happyOut54 :: (HappyAbsSyn ) -> (Exp)
+happyOut54 x = unsafeCoerce# x
+{-# INLINE happyOut54 #-}
+happyIn55 :: (Exp) -> (HappyAbsSyn )
+happyIn55 x = unsafeCoerce# x
+{-# INLINE happyIn55 #-}
+happyOut55 :: (HappyAbsSyn ) -> (Exp)
+happyOut55 x = unsafeCoerce# x
+{-# INLINE happyOut55 #-}
+happyIn56 :: (Exp) -> (HappyAbsSyn )
+happyIn56 x = unsafeCoerce# x
+{-# INLINE happyIn56 #-}
+happyOut56 :: (HappyAbsSyn ) -> (Exp)
+happyOut56 x = unsafeCoerce# x
+{-# INLINE happyOut56 #-}
+happyIn57 :: (Exp) -> (HappyAbsSyn )
+happyIn57 x = unsafeCoerce# x
+{-# INLINE happyIn57 #-}
+happyOut57 :: (HappyAbsSyn ) -> (Exp)
+happyOut57 x = unsafeCoerce# x
+{-# INLINE happyOut57 #-}
+happyIn58 :: (Exp) -> (HappyAbsSyn )
+happyIn58 x = unsafeCoerce# x
+{-# INLINE happyIn58 #-}
+happyOut58 :: (HappyAbsSyn ) -> (Exp)
+happyOut58 x = unsafeCoerce# x
+{-# INLINE happyOut58 #-}
+happyIn59 :: (Exp) -> (HappyAbsSyn )
+happyIn59 x = unsafeCoerce# x
+{-# INLINE happyIn59 #-}
+happyOut59 :: (HappyAbsSyn ) -> (Exp)
+happyOut59 x = unsafeCoerce# x
+{-# INLINE happyOut59 #-}
+happyIn60 :: (Exp) -> (HappyAbsSyn )
+happyIn60 x = unsafeCoerce# x
+{-# INLINE happyIn60 #-}
+happyOut60 :: (HappyAbsSyn ) -> (Exp)
+happyOut60 x = unsafeCoerce# x
+{-# INLINE happyOut60 #-}
+happyIn61 :: (Lit) -> (HappyAbsSyn )
+happyIn61 x = unsafeCoerce# x
+{-# INLINE happyIn61 #-}
+happyOut61 :: (HappyAbsSyn ) -> (Lit)
+happyOut61 x = unsafeCoerce# x
+{-# INLINE happyOut61 #-}
+happyIn62 :: (Exp) -> (HappyAbsSyn )
+happyIn62 x = unsafeCoerce# x
+{-# INLINE happyIn62 #-}
+happyOut62 :: (HappyAbsSyn ) -> (Exp)
+happyOut62 x = unsafeCoerce# x
+{-# INLINE happyOut62 #-}
+happyIn63 :: ([Exp]) -> (HappyAbsSyn )
+happyIn63 x = unsafeCoerce# x
+{-# INLINE happyIn63 #-}
+happyOut63 :: (HappyAbsSyn ) -> ([Exp])
+happyOut63 x = unsafeCoerce# x
+{-# INLINE happyOut63 #-}
+happyIn64 :: ([Qual]) -> (HappyAbsSyn )
+happyIn64 x = unsafeCoerce# x
+{-# INLINE happyIn64 #-}
+happyOut64 :: (HappyAbsSyn ) -> ([Qual])
+happyOut64 x = unsafeCoerce# x
+{-# INLINE happyOut64 #-}
+happyIn65 :: (Qual) -> (HappyAbsSyn )
+happyIn65 x = unsafeCoerce# x
+{-# INLINE happyIn65 #-}
+happyOut65 :: (HappyAbsSyn ) -> (Qual)
+happyOut65 x = unsafeCoerce# x
+{-# INLINE happyOut65 #-}
+happyIn66 :: ([Alt Exp]) -> (HappyAbsSyn )
+happyIn66 x = unsafeCoerce# x
+{-# INLINE happyIn66 #-}
+happyOut66 :: (HappyAbsSyn ) -> ([Alt Exp])
+happyOut66 x = unsafeCoerce# x
+{-# INLINE happyOut66 #-}
+happyIn67 :: ([Alt Exp]) -> (HappyAbsSyn )
+happyIn67 x = unsafeCoerce# x
+{-# INLINE happyIn67 #-}
+happyOut67 :: (HappyAbsSyn ) -> ([Alt Exp])
+happyOut67 x = unsafeCoerce# x
+{-# INLINE happyOut67 #-}
+happyIn68 :: (Alt Exp) -> (HappyAbsSyn )
+happyIn68 x = unsafeCoerce# x
+{-# INLINE happyIn68 #-}
+happyOut68 :: (HappyAbsSyn ) -> (Alt Exp)
+happyOut68 x = unsafeCoerce# x
+{-# INLINE happyOut68 #-}
+happyIn69 :: (Rhs Exp) -> (HappyAbsSyn )
+happyIn69 x = unsafeCoerce# x
+{-# INLINE happyIn69 #-}
+happyOut69 :: (HappyAbsSyn ) -> (Rhs Exp)
+happyOut69 x = unsafeCoerce# x
+{-# INLINE happyOut69 #-}
+happyIn70 :: ([GExp Exp]) -> (HappyAbsSyn )
+happyIn70 x = unsafeCoerce# x
+{-# INLINE happyIn70 #-}
+happyOut70 :: (HappyAbsSyn ) -> ([GExp Exp])
+happyOut70 x = unsafeCoerce# x
+{-# INLINE happyOut70 #-}
+happyIn71 :: (GExp Exp) -> (HappyAbsSyn )
+happyIn71 x = unsafeCoerce# x
+{-# INLINE happyIn71 #-}
+happyOut71 :: (HappyAbsSyn ) -> (GExp Exp)
+happyOut71 x = unsafeCoerce# x
+{-# INLINE happyOut71 #-}
+happyIn72 :: ([Alt [Stmt]]) -> (HappyAbsSyn )
+happyIn72 x = unsafeCoerce# x
+{-# INLINE happyIn72 #-}
+happyOut72 :: (HappyAbsSyn ) -> ([Alt [Stmt]])
+happyOut72 x = unsafeCoerce# x
+{-# INLINE happyOut72 #-}
+happyIn73 :: ([Alt [Stmt]]) -> (HappyAbsSyn )
+happyIn73 x = unsafeCoerce# x
+{-# INLINE happyIn73 #-}
+happyOut73 :: (HappyAbsSyn ) -> ([Alt [Stmt]])
+happyOut73 x = unsafeCoerce# x
+{-# INLINE happyOut73 #-}
+happyIn74 :: (Alt [Stmt]) -> (HappyAbsSyn )
+happyIn74 x = unsafeCoerce# x
+{-# INLINE happyIn74 #-}
+happyOut74 :: (HappyAbsSyn ) -> (Alt [Stmt])
+happyOut74 x = unsafeCoerce# x
+{-# INLINE happyOut74 #-}
+happyIn75 :: (Rhs [Stmt]) -> (HappyAbsSyn )
+happyIn75 x = unsafeCoerce# x
+{-# INLINE happyIn75 #-}
+happyOut75 :: (HappyAbsSyn ) -> (Rhs [Stmt])
+happyOut75 x = unsafeCoerce# x
+{-# INLINE happyOut75 #-}
+happyIn76 :: ([GExp [Stmt]]) -> (HappyAbsSyn )
+happyIn76 x = unsafeCoerce# x
+{-# INLINE happyIn76 #-}
+happyOut76 :: (HappyAbsSyn ) -> ([GExp [Stmt]])
+happyOut76 x = unsafeCoerce# x
+{-# INLINE happyOut76 #-}
+happyIn77 :: (GExp [Stmt]) -> (HappyAbsSyn )
+happyIn77 x = unsafeCoerce# x
+{-# INLINE happyIn77 #-}
+happyOut77 :: (HappyAbsSyn ) -> (GExp [Stmt])
+happyOut77 x = unsafeCoerce# x
+{-# INLINE happyOut77 #-}
+happyIn78 :: ([Stmt]) -> (HappyAbsSyn )
+happyIn78 x = unsafeCoerce# x
+{-# INLINE happyIn78 #-}
+happyOut78 :: (HappyAbsSyn ) -> ([Stmt])
+happyOut78 x = unsafeCoerce# x
+{-# INLINE happyOut78 #-}
+happyIn79 :: ([Stmt]) -> (HappyAbsSyn )
+happyIn79 x = unsafeCoerce# x
+{-# INLINE happyIn79 #-}
+happyOut79 :: (HappyAbsSyn ) -> ([Stmt])
+happyOut79 x = unsafeCoerce# x
+{-# INLINE happyOut79 #-}
+happyIn80 :: ([Stmt]) -> (HappyAbsSyn )
+happyIn80 x = unsafeCoerce# x
+{-# INLINE happyIn80 #-}
+happyOut80 :: (HappyAbsSyn ) -> ([Stmt])
+happyOut80 x = unsafeCoerce# x
+{-# INLINE happyOut80 #-}
+happyIn81 :: (Stmt) -> (HappyAbsSyn )
+happyIn81 x = unsafeCoerce# x
+{-# INLINE happyIn81 #-}
+happyOut81 :: (HappyAbsSyn ) -> (Stmt)
+happyOut81 x = unsafeCoerce# x
+{-# INLINE happyOut81 #-}
+happyIn82 :: (Exp) -> (HappyAbsSyn )
+happyIn82 x = unsafeCoerce# x
+{-# INLINE happyIn82 #-}
+happyOut82 :: (HappyAbsSyn ) -> (Exp)
+happyOut82 x = unsafeCoerce# x
+{-# INLINE happyOut82 #-}
+happyIn83 :: (Exp) -> (HappyAbsSyn )
+happyIn83 x = unsafeCoerce# x
+{-# INLINE happyIn83 #-}
+happyOut83 :: (HappyAbsSyn ) -> (Exp)
+happyOut83 x = unsafeCoerce# x
+{-# INLINE happyOut83 #-}
+happyIn84 :: (Exp) -> (HappyAbsSyn )
+happyIn84 x = unsafeCoerce# x
+{-# INLINE happyIn84 #-}
+happyOut84 :: (HappyAbsSyn ) -> (Exp)
+happyOut84 x = unsafeCoerce# x
+{-# INLINE happyOut84 #-}
+happyIn85 :: (Exp) -> (HappyAbsSyn )
+happyIn85 x = unsafeCoerce# x
+{-# INLINE happyIn85 #-}
+happyOut85 :: (HappyAbsSyn ) -> (Exp)
+happyOut85 x = unsafeCoerce# x
+{-# INLINE happyOut85 #-}
+happyIn86 :: (OpExp) -> (HappyAbsSyn )
+happyIn86 x = unsafeCoerce# x
+{-# INLINE happyIn86 #-}
+happyOut86 :: (HappyAbsSyn ) -> (OpExp)
+happyOut86 x = unsafeCoerce# x
+{-# INLINE happyOut86 #-}
+happyIn87 :: (OpExp) -> (HappyAbsSyn )
+happyIn87 x = unsafeCoerce# x
+{-# INLINE happyIn87 #-}
+happyOut87 :: (HappyAbsSyn ) -> (OpExp)
+happyOut87 x = unsafeCoerce# x
+{-# INLINE happyOut87 #-}
+happyIn88 :: (Pat) -> (HappyAbsSyn )
+happyIn88 x = unsafeCoerce# x
+{-# INLINE happyIn88 #-}
+happyOut88 :: (HappyAbsSyn ) -> (Pat)
+happyOut88 x = unsafeCoerce# x
+{-# INLINE happyOut88 #-}
+happyIn89 :: ([Pat]) -> (HappyAbsSyn )
+happyIn89 x = unsafeCoerce# x
+{-# INLINE happyIn89 #-}
+happyOut89 :: (HappyAbsSyn ) -> ([Pat])
+happyOut89 x = unsafeCoerce# x
+{-# INLINE happyOut89 #-}
+happyIn90 :: (Pat) -> (HappyAbsSyn )
+happyIn90 x = unsafeCoerce# x
+{-# INLINE happyIn90 #-}
+happyOut90 :: (HappyAbsSyn ) -> (Pat)
+happyOut90 x = unsafeCoerce# x
+{-# INLINE happyOut90 #-}
+happyIn91 :: (Name) -> (HappyAbsSyn )
+happyIn91 x = unsafeCoerce# x
+{-# INLINE happyIn91 #-}
+happyOut91 :: (HappyAbsSyn ) -> (Name)
+happyOut91 x = unsafeCoerce# x
+{-# INLINE happyOut91 #-}
+happyIn92 :: (Name) -> (HappyAbsSyn )
+happyIn92 x = unsafeCoerce# x
+{-# INLINE happyIn92 #-}
+happyOut92 :: (HappyAbsSyn ) -> (Name)
+happyOut92 x = unsafeCoerce# x
+{-# INLINE happyOut92 #-}
+happyIn93 :: (Name) -> (HappyAbsSyn )
+happyIn93 x = unsafeCoerce# x
+{-# INLINE happyIn93 #-}
+happyOut93 :: (HappyAbsSyn ) -> (Name)
+happyOut93 x = unsafeCoerce# x
+{-# INLINE happyOut93 #-}
+happyIn94 :: (Name) -> (HappyAbsSyn )
+happyIn94 x = unsafeCoerce# x
+{-# INLINE happyIn94 #-}
+happyOut94 :: (HappyAbsSyn ) -> (Name)
+happyOut94 x = unsafeCoerce# x
+{-# INLINE happyOut94 #-}
+happyIn95 :: (Name) -> (HappyAbsSyn )
+happyIn95 x = unsafeCoerce# x
+{-# INLINE happyIn95 #-}
+happyOut95 :: (HappyAbsSyn ) -> (Name)
+happyOut95 x = unsafeCoerce# x
+{-# INLINE happyOut95 #-}
+happyIn96 :: (Name) -> (HappyAbsSyn )
+happyIn96 x = unsafeCoerce# x
+{-# INLINE happyIn96 #-}
+happyOut96 :: (HappyAbsSyn ) -> (Name)
+happyOut96 x = unsafeCoerce# x
+{-# INLINE happyOut96 #-}
+happyIn97 :: (Name) -> (HappyAbsSyn )
+happyIn97 x = unsafeCoerce# x
+{-# INLINE happyIn97 #-}
+happyOut97 :: (HappyAbsSyn ) -> (Name)
+happyOut97 x = unsafeCoerce# x
+{-# INLINE happyOut97 #-}
+happyIn98 :: (Name) -> (HappyAbsSyn )
+happyIn98 x = unsafeCoerce# x
+{-# INLINE happyIn98 #-}
+happyOut98 :: (HappyAbsSyn ) -> (Name)
+happyOut98 x = unsafeCoerce# x
+{-# INLINE happyOut98 #-}
+happyIn99 :: (Name) -> (HappyAbsSyn )
+happyIn99 x = unsafeCoerce# x
+{-# INLINE happyIn99 #-}
+happyOut99 :: (HappyAbsSyn ) -> (Name)
+happyOut99 x = unsafeCoerce# x
+{-# INLINE happyOut99 #-}
+happyIn100 :: (Name) -> (HappyAbsSyn )
+happyIn100 x = unsafeCoerce# x
+{-# INLINE happyIn100 #-}
+happyOut100 :: (HappyAbsSyn ) -> (Name)
+happyOut100 x = unsafeCoerce# x
+{-# INLINE happyOut100 #-}
+happyIn101 :: (Name) -> (HappyAbsSyn )
+happyIn101 x = unsafeCoerce# x
+{-# INLINE happyIn101 #-}
+happyOut101 :: (HappyAbsSyn ) -> (Name)
+happyOut101 x = unsafeCoerce# x
+{-# INLINE happyOut101 #-}
+happyIn102 :: ((String,String)) -> (HappyAbsSyn )
+happyIn102 x = unsafeCoerce# x
+{-# INLINE happyIn102 #-}
+happyOut102 :: (HappyAbsSyn ) -> ((String,String))
+happyOut102 x = unsafeCoerce# x
+{-# INLINE happyOut102 #-}
+happyIn103 :: ((String,String)) -> (HappyAbsSyn )
+happyIn103 x = unsafeCoerce# x
+{-# INLINE happyIn103 #-}
+happyOut103 :: (HappyAbsSyn ) -> ((String,String))
+happyOut103 x = unsafeCoerce# x
+{-# INLINE happyOut103 #-}
+happyIn104 :: (()) -> (HappyAbsSyn )
+happyIn104 x = unsafeCoerce# x
+{-# INLINE happyIn104 #-}
+happyOut104 :: (HappyAbsSyn ) -> (())
+happyOut104 x = unsafeCoerce# x
+{-# INLINE happyOut104 #-}
+happyIn105 :: (()) -> (HappyAbsSyn )
+happyIn105 x = unsafeCoerce# x
+{-# INLINE happyIn105 #-}
+happyOut105 :: (HappyAbsSyn ) -> (())
+happyOut105 x = unsafeCoerce# x
+{-# INLINE happyOut105 #-}
+happyIn106 :: (()) -> (HappyAbsSyn )
+happyIn106 x = unsafeCoerce# x
+{-# INLINE happyIn106 #-}
+happyOut106 :: (HappyAbsSyn ) -> (())
+happyOut106 x = unsafeCoerce# x
+{-# INLINE happyOut106 #-}
+happyIn107 :: ((Int,Int)) -> (HappyAbsSyn )
+happyIn107 x = unsafeCoerce# x
+{-# INLINE happyIn107 #-}
+happyOut107 :: (HappyAbsSyn ) -> ((Int,Int))
+happyOut107 x = unsafeCoerce# x
+{-# INLINE happyOut107 #-}
+happyInTok :: (Token) -> (HappyAbsSyn )
+happyInTok x = unsafeCoerce# x
+{-# INLINE happyInTok #-}
+happyOutTok :: (HappyAbsSyn ) -> (Token)
+happyOutTok x = unsafeCoerce# x
+{-# INLINE happyOutTok #-}
+
+
+happyActOffsets :: HappyAddr
+happyActOffsets = HappyA# "\xbe\x04\xbe\x04\x00\x00\xaf\x04\xae\x04\xe7\x04\x00\x00\xda\x04\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x06\xd9\x04\xbc\x01\x00\x00\x4f\x02\x31\x03\xd0\x01\x00\x00\x39\x07\xcb\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd0\x01\x00\x00\x35\x02\xd4\x04\x00\x00\xc8\x04\x88\x01\xb7\x03\x1c\x07\xf1\x07\x00\x00\x06\x03\x06\x03\x06\x03\x00\x00\xd1\x04\x00\x00\xd3\x04\xcd\x04\x00\x00\x00\x00\x00\x00\x00\x00\xc7\x06\xb6\x02\x00\x00\xc7\x04\x00\x00\x00\x00\x0f\x00\x2d\x01\x00\x00\x00\x00\xab\x04\x12\x0b\x00\x00\xbd\x04\xb5\x04\xb1\x04\x00\x00\x9e\x01\x00\x00\x00\x00\xbb\x04\x00\x00\x00\x00\xd5\x07\x00\x00\x00\x00\x00\x00\x66\x03\xd5\x07\x84\x04\x08\x01\x00\x00\x6d\x01\x00\x00\x81\x04\x00\x00\xd0\x01\x00\x00\xd0\x01\x00\x00\x00\x00\x00\x00\x86\x04\x83\x04\x2f\x0b\x00\x00\x0d\x08\x0d\x08\x89\x04\x0a\x03\xa2\x02\x53\x0b\xa1\x02\x00\x00\x06\x03\x88\x04\x7e\x04\x00\x00\x7a\x04\x91\x07\x24\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x78\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x04\x74\x04\x74\x04\x74\x04\xa2\x01\x00\x00\x00\x00\x00\x00\xff\x0a\x00\x00\x00\x00\x00\x00\x7b\x04\x00\x00\x00\x00\x6d\x04\x5b\x04\xf7\x0a\x3a\x04\x52\x04\x00\x00\x0d\x08\xec\x0a\x37\x04\xbd\x02\x0e\x04\x00\x00\xed\x06\x00\x00\x00\x00\x00\x00\x00\x00\x32\x04\x00\x00\x20\x04\x14\x04\xe9\x02\x00\x00\x00\x00\x00\x00\x7c\x03\xf6\x02\x00\x00\x00\x00\x2f\x04\x36\x02\x00\x00\x21\x04\x1f\x04\x1d\x04\x00\x00\x00\x00\x1d\x04\x00\x00\x00\x00\xb7\x03\x00\x00\x16\x04\x15\x04\x00\x00\x00\x00\x00\x00\xb7\x03\x10\x01\x00\x00\x02\x04\x00\x00\xa2\x01\x00\x00\x00\x00\x57\x03\x00\x00\x00\x00\x00\x00\x00\x00\x11\x04\x05\x04\x00\x00\x00\x00\x00\x00\x00\x00\xe4\x02\x00\x00\x0d\x08\x47\x0a\x00\x00\x0d\x08\x00\x00\x00\x00\x00\x00\xb3\x03\xe4\x03\x76\x02\x00\x00\x6f\x0a\x4c\x0a\xbd\x02\x0d\x08\x0d\x08\xec\x0a\x00\x00\x0d\x08\x00\x00\x00\x00\x81\x02\xd6\x03\x58\x01\x00\x00\x0b\x00\xbd\x02\x00\x00\xda\x0a\x48\x01\x00\x00\xfe\x01\x95\x02\x0d\x08\x1c\x00\xcf\x03\x09\x00\xb5\x03\x00\x00\xac\x03\x00\x00\xbd\x02\xd7\x03\xbd\x02\x00\x00\xa9\x03\x00\x00\xa4\x03\xbd\x02\x00\x00\xda\x0a\x93\x02\x00\x00\x7d\x00\xd3\x03\xbd\x02\x00\x00\xd3\x03\x59\x02\xc6\x03\xbd\x02\x00\x00\xc7\x03\x00\x00\xc0\x03\xeb\x01\x00\x00\x00\x00\x2f\x0b\x00\x00\x00\x00\x2f\x0b\x3b\x02\x00\x00\xb6\x03\x00\x00\xc8\x03\x0d\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\x06\xb8\x01\x49\x02\x81\x00\xc4\x03\x00\x00\x00\x00\x58\x02\xe4\x01\x0d\x08\xc5\x03\x0d\x08\xcf\x0a\x0d\x08\x0d\x08\x0d\x08\xbf\x03\xa2\x01\x32\x00\x00\x00\xbb\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9b\x03\xc7\x0a\xb4\x0a\x0d\x08\xb1\x03\x00\x00\xb9\x03\xcd\x00\xec\x01\xa6\x00\xb8\x03\x8d\x01\x00\x00\x00\x00\xbd\x02\xbd\x02\xbd\x02\x00\x00\xed\x06\x00\x00\xed\x06\x37\x01\x00\x00\xae\x03\x00\x00\xa6\x03\xeb\x01\xeb\x01\x00\x00\x00\x00\xbd\x02\xbd\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9e\x00\x7f\x03\x00\x00\x00\x00\x6b\x03\x00\x00\x59\x03\x38\x00\x52\x03\x00\x00\x58\x03\x0d\x08\x0d\x08\xab\x06\x00\x00\x4a\x03\xb6\x07\xbd\x02\x75\x03\x5b\x03\x00\x00\xb2\x0a\x00\x00\x0d\x08\x00\x00\x72\x03\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x08\x00\x00\x61\x03\x00\x00\xbd\x02\x00\x00\x00\x00\x00\x00\x00\x00\x41\x03\x68\x03\x00\x00\x00\x00\x00\x00\x00\x00\x67\x03\x00\x00\x00\x00\x14\x00\x00\x00\x00\x00\x5e\x03\x00\x00\xd8\x01\x81\x00\x5c\x03\x00\x00\xa3\x01\x00\x00\x00\x00\x00\x00\x4b\x03\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x0a\x1e\x01\x00\x00\x00\x00\xf9\x01\x0d\x08\x00\x00\x00\x00\x0d\x08\x00\x00\x00\x00\x00\x00\x4f\x03\x40\x03\x40\x03\x40\x03\x40\x03\x00\x00\x39\x03\x00\x00\x00\x00\xa2\x01\xbd\x02\x00\x00\x9a\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x0a\x00\x00\x00\x00\x00\x00\xfc\x02\xf9\x02\x00\x00\x9f\x0a\x0d\x08\x00\x00\x97\x0a\x61\x01\xbd\x02\xbd\x02\x21\x03\x00\x00\x0b\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb5\x00\x00\x00\x04\x03\x97\x0a\x04\x01\x00\x00\xfc\x00\xc7\x02\xee\x02\x00\x00\x8c\x0a\xe8\x02\x00\x00\x74\x0a\x74\x00\x00\x00\x0d\x08\x00\x00\x00\x00\x00\x00\x00\x00\x95\x00\x00\x00\xdf\x02\x00\x00\xd9\x02\x00\x00\x00\x00"#
+
+happyGotoOffsets :: HappyAddr
+happyGotoOffsets = HappyA# "\xe6\x02\x00\x00\xb7\x01\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\xcb\x02\x80\x02\xc2\x02\x37\x00\x00\x00\x3d\x02\x00\x00\x00\x00\x3e\x03\x73\x04\x00\x00\xf4\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x30\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdc\x09\xf4\x02\x0e\x03\x00\x00\x43\x09\x6e\x09\x98\x08\xb3\x01\x05\x00\x65\x01\x1b\x00\x1a\x00\x40\x01\xbb\xff\xfc\xff\xb7\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x02\x00\x00\xaa\x02\x8d\x02\x00\x00\x26\x01\x2e\x02\x00\x00\x00\x00\x00\x00\x00\x00\xf8\x01\x00\x00\x00\x00\x36\x00\x2d\x02\x7d\x02\x46\x06\x00\x00\x00\x00\x00\x00\x00\x00\x38\x06\x00\x00\xea\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1b\x04\x00\x00\xd8\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x07\x20\x02\x2a\x06\xee\x05\x19\x00\x00\x00\x00\x00\xc3\x03\x00\x00\x00\x00\xaf\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x77\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xce\x01\x59\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x00\x7b\x00\x73\x00\x72\x00\x23\x02\x13\x02\x00\x00\x00\x00\xd2\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x01\xe9\x00\x00\x00\xc5\x08\x00\x00\x64\x02\x00\x00\xe0\x05\x30\x09\x8c\x00\x85\x02\x77\x02\x00\x00\xd4\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfe\xff\x00\x00\x00\x00\x00\x00\xe2\xff\x00\x00\x00\x00\x00\x00\x3f\x01\x7b\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x18\x00\x00\x00\x00\x00\x17\x00\x00\x00\x00\x00\x6b\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x11\x08\xb9\x00\x00\x00\x00\x00\x00\x00\x15\x02\x00\x00\x00\x00\xbd\x01\xf4\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x02\x00\x00\xd2\x05\x6d\x07\x00\x00\x96\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb1\x00\x00\x00\x6d\x07\x37\x07\xb7\x02\x88\x05\x7a\x05\x1f\x09\x00\x00\x3e\x05\x00\x00\x00\x00\x0a\x00\x1d\x00\xd2\x01\x00\x00\x00\x00\x6a\x02\x9d\x01\x1c\x01\xca\x01\x00\x00\x00\x00\x18\x03\x30\x05\x02\x00\x94\x00\xfb\xff\x29\x02\x00\x00\xf3\x01\x00\x00\x0e\x02\xf9\xff\x5a\x02\x00\x00\xee\x01\x00\x00\x00\x00\x4d\x02\x00\x00\x63\x01\x00\x00\x00\x00\x15\x03\xc1\xff\x3c\x02\x00\x00\x39\x00\x00\x00\xed\x01\x04\x02\x00\x00\x00\x00\x00\x00\x00\x00\xe2\xff\x00\x00\x00\x00\x2d\x07\x00\x00\x00\x00\x23\x07\x00\x00\x00\x00\x00\x00\x00\x00\xd3\xff\x22\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x90\x01\x00\x00\x12\x03\x28\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe6\x04\x62\x00\xd8\x04\xf2\x08\xca\x04\x8e\x04\x80\x04\x00\x00\xc0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc8\x09\x9b\x09\x72\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x96\x02\x89\x02\x9b\x02\x00\x00\xa7\x00\xf1\x00\x6f\x00\xe0\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe2\xff\xe2\xff\x00\x00\x00\x00\xb3\x02\xde\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x36\x04\x28\x04\xea\x01\x00\x00\x00\x00\x1a\x04\x32\x02\x00\x00\x00\x00\x00\x00\xe1\x08\xdc\x00\xde\x03\x00\x00\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd0\x03\x00\x00\x00\x00\x00\x00\x8e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf6\xff\x00\x00\x00\x00\xd3\x00\xaf\x00\x00\x00\x00\x00\x00\x00\xbb\x00\xad\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x08\x6e\x00\x00\x00\x00\x00\x8e\x01\xc2\x03\x00\x00\x00\x00\x86\x03\x00\x00\x00\x00\x00\x00\xd5\xff\x52\x00\x50\x00\xdc\xff\xd9\xff\x00\x00\x00\x00\x00\x00\x00\x00\xd2\x00\xa9\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x08\x54\x00\x00\x00\x00\x00\x00\x00\x22\x00\x00\x00\x5a\x08\x78\x03\x00\x00\x8a\x09\x00\x00\x22\x02\x29\x01\x8d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x2d\x08\xe6\xff\x00\x00\x4e\x02\x00\x00\x49\x00\x00\x00\x00\x08\xcd\xff\x00\x00\x5d\x09\x00\x00\x00\x00\x6a\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\xc4\xff\x00\x00\x00\x00"#
+
+happyDefActions :: HappyAddr
+happyDefActions = HappyA# "\x00\x00\x00\x00\xf1\xfe\x00\x00\x00\x00\x00\x00\xff\xfe\xf2\xfe\xfe\xff\xf6\xff\xf3\xfe\xf6\xff\xf1\xfe\x00\x00\x00\x00\xf2\xff\x00\x00\x00\x00\x20\xff\x1e\xff\x75\xff\x6d\xff\x6b\xff\x67\xff\xba\xff\x23\xff\x22\xff\x21\xff\x1f\xff\x6a\xff\x68\xff\x0f\xff\x0d\xff\x00\x00\xf1\xfe\xf1\xfe\xf1\xfe\x69\xff\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xf2\xfe\xf1\xfe\xf1\xfe\xf2\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\x00\x00\xf4\xff\xeb\xff\xd9\xff\x05\xff\x04\xff\x00\x00\xdb\xff\xdb\xff\x00\x00\xf1\xfe\xf3\xfe\xe7\xff\x00\x00\x05\xff\x04\xff\x00\x00\xf5\xff\xe6\xff\xf1\xfe\xf3\xfe\xdb\xff\xf1\xfe\x6a\xff\x68\xff\x0d\xff\x00\x00\xf1\xfe\x10\xff\xf1\xfe\x11\xff\x59\xff\x94\xff\x92\xff\x91\xff\x90\xff\x8e\xff\x8f\xff\x7f\xff\x8d\xff\x73\xff\x00\x00\x58\xff\xf1\xfe\xf3\xfe\xf1\xfe\xf1\xfe\xf2\xfe\x00\x00\x00\x00\xf1\xfe\x00\x00\x01\xff\xf1\xfe\x00\x00\x09\xff\xfe\xfe\x03\xff\x00\x00\xf1\xfe\xf9\xfe\xf8\xfe\xf7\xfe\xfa\xfe\x66\xff\x9f\xff\xf1\xfe\xf1\xfe\xf6\xfe\x1b\xff\x16\xff\x00\xff\x5e\xff\x5d\xff\x5c\xff\x5b\xff\xf2\xfe\xf2\xfe\xf2\xfe\xf2\xfe\x00\x00\xf3\xfe\x07\xff\x06\xff\xf1\xfe\x0b\xff\x09\xff\xfc\xfe\x00\x00\xfb\xfe\xf1\xfe\xf1\xfe\x6e\xff\xf1\xfe\xe4\xff\xb8\xff\xb5\xff\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xfa\xff\xf4\xfe\xf1\xfe\xf5\xfe\xf7\xff\xf3\xff\xfc\xff\xf2\xfe\xe5\xff\xb2\xff\xb1\xff\xae\xff\xac\xff\xab\xff\xaa\xff\xf1\xfe\xf1\xfe\xa9\xff\xbc\xff\x00\x00\x00\x00\x51\xff\x4f\xff\x00\x00\xf2\xfe\xb9\xff\xb6\xff\xf2\xfe\x19\xff\x14\xff\xf1\xfe\x6c\xff\x00\x00\x00\x00\xfd\xfe\x1c\xff\x17\xff\xf1\xfe\xf1\xfe\xf1\xff\x99\xff\x98\xff\x00\x00\x97\xff\x7b\xff\x34\xff\xf3\xfe\x7e\xff\x7d\xff\x7c\xff\x00\x00\x00\x00\x8a\xff\x85\xff\x0c\xff\x0e\xff\xf1\xfe\x63\xff\xf1\xfe\xf1\xfe\x64\xff\xf1\xfe\x5f\xff\xa0\xff\x93\xff\x00\x00\x00\x00\xf1\xfe\x62\xff\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\x12\xff\xf1\xfe\x70\xff\x6f\xff\xdd\xff\xf1\xfe\x00\x00\xd5\xff\x00\x00\xf1\xfe\xf1\xfe\xf1\xfe\x00\x00\xc2\xff\x00\x00\x00\x00\xf1\xfe\xe0\xff\xf1\xfe\xf1\xfe\xfa\xff\xfd\xff\xcd\xff\xdc\xff\xf1\xfe\xf2\xfe\xf1\xfe\xe1\xff\xcd\xff\x71\xff\xc0\xff\xf1\xfe\xc4\xff\xf1\xfe\x00\x00\xda\xff\xea\xff\xf1\xfe\xf1\xfe\xd7\xff\xf1\xfe\x00\x00\xd1\xff\xf1\xfe\x72\xff\x55\xff\x57\xff\x53\xff\x95\xff\x8b\xff\x86\xff\xf1\xfe\x88\xff\x83\xff\xf1\xfe\x00\x00\xbe\xff\x00\x00\x80\xff\xf2\xfe\xf1\xfe\x53\xff\x61\xff\x54\xff\x60\xff\x02\xff\x65\xff\xf1\xfe\x00\x00\x00\x00\x00\x00\x35\xff\x32\xff\x30\xff\x24\xff\x00\x00\xf1\xfe\xf2\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\x00\x00\x00\x00\x00\x00\x76\xff\x00\x00\x1d\xff\x18\xff\x08\xff\x0a\xff\x1a\xff\x15\xff\xb7\xff\x4e\xff\xf1\xfe\xf1\xfe\xf1\xfe\x00\x00\xa8\xff\x00\x00\xb2\xff\x00\x00\x00\x00\x00\x00\x00\x00\xa6\xff\xad\xff\xf1\xfe\xf1\xfe\xf1\xfe\xfb\xff\xf1\xfe\xf3\xfe\xf1\xfe\x00\x00\x9c\xff\xb3\xff\x9d\xff\xaa\xff\xaf\xff\xb0\xff\xa7\xff\xa4\xff\xf1\xfe\xf1\xfe\xa5\xff\xa3\xff\xb4\xff\x52\xff\x50\xff\x77\xff\x7a\xff\xf1\xfe\x00\x00\x9a\xff\x96\xff\x00\x00\x2b\xff\x00\x00\x00\x00\x00\x00\x27\xff\x00\x00\xf1\xfe\xf1\xfe\xf1\xfe\x36\xff\x2e\xff\xf1\xfe\xf1\xfe\x00\x00\x00\x00\x82\xff\xf1\xfe\xf3\xfe\xf1\xfe\x81\xff\xf1\xfe\x89\xff\x84\xff\x8c\xff\x87\xff\xf1\xfe\xde\xff\xdf\xff\xef\xff\xf1\xfe\xd8\xff\xd6\xff\xd3\xff\xd4\xff\xe8\xff\xf2\xfe\xc5\xff\xc3\xff\xc1\xff\xee\xff\xf2\xfe\xf0\xff\xec\xff\xc9\xff\xf3\xfe\xe2\xff\xe3\xff\xed\xff\xf1\xfe\x00\x00\xca\xff\xc7\xff\x00\x00\xbb\xff\xce\xff\xe9\xff\xd2\xff\xcf\xff\x56\xff\xbf\xff\xbd\xff\xf1\xfe\x00\x00\x4a\xff\x13\xff\x00\x00\xf1\xfe\x37\xff\x2f\xff\xf1\xfe\x33\xff\x31\xff\x2c\xff\xf2\xfe\xf2\xfe\xf2\xfe\xf2\xfe\xf2\xfe\x79\xff\x00\x00\xa1\xff\xa2\xff\x00\x00\xf1\xfe\xf8\xff\x00\x00\xf9\xff\x9e\xff\x9b\xff\x78\xff\x26\xff\x29\xff\x2a\xff\x28\xff\x25\xff\xf1\xfe\xf3\xfe\x2d\xff\x74\xff\x49\xff\x47\xff\x44\xff\xf1\xfe\xf1\xfe\x4c\xff\xf1\xfe\x00\x00\xf1\xfe\xf1\xfe\xf1\xfe\xcb\xff\x00\x00\xcc\xff\xc8\xff\xc6\xff\xd0\xff\x4d\xff\x4b\xff\x48\xff\x00\x00\x45\xff\xf2\xfe\xf1\xfe\x00\x00\x3f\xff\x00\x00\x3e\xff\x3c\xff\x39\xff\xf1\xfe\xf2\xfe\x41\xff\xf1\xfe\x00\x00\x46\xff\xf1\xfe\x43\xff\x42\xff\x40\xff\x3d\xff\x00\x00\x3a\xff\xf2\xfe\x3b\xff\xf2\xfe\x38\xff"#
+
+happyCheck :: HappyAddr
+happyCheck = HappyA# "\xff\xff\x03\x00\x01\x00\x08\x00\x05\x00\x06\x00\x07\x00\x25\x00\x0c\x00\x13\x00\x08\x00\x09\x00\x13\x00\x04\x00\x4a\x00\x04\x00\x01\x00\x3e\x00\x0d\x00\x04\x00\x0a\x00\x01\x00\x5f\x00\x4a\x00\x57\x00\x44\x00\x5f\x00\x1c\x00\x1d\x00\x01\x00\x67\x00\x5e\x00\x04\x00\x0d\x00\x67\x00\x4a\x00\x17\x00\x1a\x00\x4a\x00\x0c\x00\x67\x00\x17\x00\x66\x00\x0e\x00\x0f\x00\x17\x00\x17\x00\x17\x00\x17\x00\x17\x00\x33\x00\x66\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x66\x00\x58\x00\x66\x00\x05\x00\x06\x00\x07\x00\x66\x00\x5e\x00\x5f\x00\x66\x00\x11\x00\x0e\x00\x0f\x00\x3d\x00\x15\x00\x0f\x00\x67\x00\x64\x00\x19\x00\x3d\x00\x15\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x1c\x00\x1d\x00\x1b\x00\x57\x00\x58\x00\x5c\x00\x5e\x00\x5e\x00\x5f\x00\x66\x00\x5e\x00\x5f\x00\x66\x00\x5e\x00\x29\x00\x67\x00\x67\x00\x66\x00\x43\x00\x67\x00\x66\x00\x5e\x00\x67\x00\x33\x00\x66\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\x57\x00\x66\x00\x57\x00\x06\x00\x07\x00\x5c\x00\x66\x00\x5e\x00\x5f\x00\x5e\x00\x66\x00\x66\x00\x66\x00\x66\x00\x66\x00\x00\x00\x67\x00\x0f\x00\x67\x00\x11\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x1c\x00\x1d\x00\x57\x00\x57\x00\x58\x00\x57\x00\x57\x00\x49\x00\x12\x00\x5e\x00\x5e\x00\x5f\x00\x5e\x00\x5e\x00\x1c\x00\x4a\x00\x1e\x00\x4a\x00\x67\x00\x67\x00\x11\x00\x67\x00\x67\x00\x33\x00\x16\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x1c\x00\x15\x00\x0d\x00\x4a\x00\x06\x00\x07\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x0e\x00\x20\x00\x66\x00\x19\x00\x66\x00\x65\x00\x3d\x00\x15\x00\x4a\x00\x4a\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x1c\x00\x1d\x00\x4a\x00\x57\x00\x58\x00\x66\x00\x4a\x00\x15\x00\x1a\x00\x1b\x00\x5e\x00\x5f\x00\x14\x00\x15\x00\x16\x00\x64\x00\x1a\x00\x1b\x00\x20\x00\x67\x00\x1c\x00\x66\x00\x66\x00\x33\x00\x07\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x66\x00\x15\x00\x57\x00\x57\x00\x66\x00\x58\x00\x14\x00\x15\x00\x16\x00\x5e\x00\x5e\x00\x5e\x00\x5f\x00\x21\x00\x1c\x00\x1c\x00\x1d\x00\x5e\x00\x67\x00\x67\x00\x67\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x67\x00\x2a\x00\x2b\x00\x57\x00\x58\x00\x22\x00\x23\x00\x24\x00\x25\x00\x00\x00\x5e\x00\x5f\x00\x33\x00\x57\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\x5e\x00\x57\x00\x64\x00\x57\x00\x0f\x00\x65\x00\x0d\x00\x12\x00\x5e\x00\x67\x00\x5e\x00\x1e\x00\x13\x00\x20\x00\x0d\x00\x00\x00\x17\x00\x67\x00\x11\x00\x67\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x20\x00\x19\x00\x57\x00\x57\x00\x58\x00\x0f\x00\x01\x00\x02\x00\x12\x00\x5e\x00\x5e\x00\x5f\x00\x18\x00\x19\x00\x58\x00\x00\x00\x1c\x00\x1d\x00\x67\x00\x67\x00\x5e\x00\x5f\x00\x18\x00\x19\x00\x57\x00\x65\x00\x1c\x00\x1d\x00\x64\x00\x67\x00\x0f\x00\x5e\x00\x00\x00\x12\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x33\x00\x67\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x65\x00\x0f\x00\x00\x00\x33\x00\x12\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x0f\x00\x5e\x00\x5f\x00\x12\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x0f\x00\x67\x00\x11\x00\x57\x00\x58\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x5e\x00\x5f\x00\x19\x00\x57\x00\x58\x00\x1c\x00\x1d\x00\x58\x00\x15\x00\x67\x00\x5e\x00\x5f\x00\x19\x00\x5e\x00\x5f\x00\x01\x00\x02\x00\x1e\x00\x64\x00\x67\x00\x01\x00\x02\x00\x67\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x08\x00\x33\x00\x58\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x5e\x00\x5f\x00\x5f\x00\x61\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x67\x00\x67\x00\x06\x00\x0f\x00\x22\x00\x11\x00\x1c\x00\x1d\x00\x26\x00\x0d\x00\x57\x00\x29\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x5e\x00\x15\x00\x17\x00\x57\x00\x58\x00\x00\x00\x1a\x00\x36\x00\x21\x00\x67\x00\x5e\x00\x5f\x00\x33\x00\x5f\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\x0f\x00\x67\x00\x15\x00\x12\x00\x41\x00\x42\x00\x43\x00\x1a\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x1c\x00\x1d\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x0d\x00\x16\x00\x57\x00\x58\x00\x11\x00\x2a\x00\x2b\x00\x01\x00\x02\x00\x5e\x00\x5f\x00\x33\x00\x21\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\x0d\x00\x5c\x00\x0e\x00\x5e\x00\x5f\x00\x10\x00\x13\x00\x1b\x00\x12\x00\x15\x00\x17\x00\x1f\x00\x67\x00\x12\x00\x1c\x00\x1d\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x5f\x00\x15\x00\x57\x00\x58\x00\x5f\x00\x1e\x00\x1a\x00\x20\x00\x67\x00\x5e\x00\x5f\x00\x33\x00\x67\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x02\x00\x5e\x00\x5f\x00\x64\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x67\x00\x64\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x2a\x00\x2b\x00\x57\x00\x58\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x5e\x00\x5f\x00\x15\x00\x15\x00\x11\x00\x2a\x00\x2b\x00\x1a\x00\x15\x00\x67\x00\x1c\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x60\x00\x65\x00\x62\x00\x63\x00\x58\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x5e\x00\x5f\x00\x15\x00\x1c\x00\x58\x00\x1e\x00\x0f\x00\x1a\x00\x11\x00\x67\x00\x5e\x00\x5f\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x1b\x00\x1c\x00\x67\x00\x1e\x00\x1f\x00\x65\x00\x02\x00\x58\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x5e\x00\x5f\x00\x01\x00\x0d\x00\x20\x00\x65\x00\x05\x00\x11\x00\x0b\x00\x67\x00\x58\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x5e\x00\x5f\x00\x65\x00\x65\x00\x58\x00\x47\x00\x48\x00\x49\x00\x0b\x00\x67\x00\x5e\x00\x5f\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x64\x00\x0f\x00\x67\x00\x11\x00\x58\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x5e\x00\x5f\x00\x24\x00\x25\x00\x0e\x00\x0e\x00\x1c\x00\x58\x00\x1e\x00\x67\x00\x0b\x00\x15\x00\x15\x00\x5e\x00\x5f\x00\x24\x00\x25\x00\x0b\x00\x22\x00\x23\x00\x24\x00\x25\x00\x67\x00\x58\x00\x28\x00\x29\x00\x0f\x00\x04\x00\x11\x00\x5e\x00\x5f\x00\x0d\x00\x22\x00\x23\x00\x24\x00\x25\x00\x04\x00\x13\x00\x67\x00\x29\x00\x58\x00\x17\x00\x22\x00\x23\x00\x24\x00\x25\x00\x5e\x00\x5f\x00\x24\x00\x25\x00\x58\x00\x37\x00\x38\x00\x39\x00\x58\x00\x67\x00\x5e\x00\x5f\x00\x65\x00\x00\x00\x5e\x00\x5f\x00\x10\x00\x01\x00\x02\x00\x67\x00\x04\x00\x58\x00\x10\x00\x67\x00\x0d\x00\x0e\x00\x58\x00\x5e\x00\x5f\x00\x0d\x00\x13\x00\x10\x00\x5e\x00\x5f\x00\x17\x00\x13\x00\x67\x00\x57\x00\x58\x00\x17\x00\x58\x00\x67\x00\x0d\x00\x3d\x00\x5e\x00\x5f\x00\x5e\x00\x5f\x00\x13\x00\x14\x00\x58\x00\x1e\x00\x17\x00\x67\x00\x58\x00\x67\x00\x5e\x00\x5f\x00\x0d\x00\x10\x00\x5e\x00\x5f\x00\x1e\x00\x0e\x00\x13\x00\x67\x00\x27\x00\x11\x00\x17\x00\x67\x00\x15\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x0d\x00\x3b\x00\x1e\x00\x1f\x00\x20\x00\x1e\x00\x1f\x00\x20\x00\x1e\x00\x1f\x00\x20\x00\x3d\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x11\x00\x57\x00\x58\x00\x1c\x00\x5a\x00\x1e\x00\x10\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x01\x00\x02\x00\x03\x00\x67\x00\x1e\x00\x1f\x00\x20\x00\x10\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x57\x00\x58\x00\x01\x00\x02\x00\x1e\x00\x13\x00\x0f\x00\x5e\x00\x5f\x00\x17\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x15\x00\x1d\x00\x67\x00\x15\x00\x10\x00\x10\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x3d\x00\x0d\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2a\x00\x11\x00\x3d\x00\x31\x00\x0d\x00\x0e\x00\x39\x00\x34\x00\x36\x00\x37\x00\x13\x00\x11\x00\x15\x00\x39\x00\x17\x00\x29\x00\x3e\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x1a\x00\x57\x00\x58\x00\x15\x00\x0d\x00\x14\x00\x0e\x00\x0e\x00\x5e\x00\x5f\x00\x13\x00\x30\x00\x11\x00\x0e\x00\x17\x00\x57\x00\x58\x00\x67\x00\x1c\x00\x0f\x00\x1d\x00\x10\x00\x5e\x00\x5f\x00\x10\x00\x19\x00\x23\x00\x24\x00\x15\x00\x57\x00\x58\x00\x67\x00\x0d\x00\x3d\x00\x1c\x00\x0d\x00\x5e\x00\x5f\x00\x3d\x00\x10\x00\x31\x00\x3d\x00\x35\x00\x1c\x00\x39\x00\x67\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x34\x00\x57\x00\x58\x00\x16\x00\x59\x00\x5a\x00\x5b\x00\x0e\x00\x5e\x00\x5f\x00\x20\x00\x60\x00\x61\x00\x62\x00\x63\x00\x57\x00\x58\x00\x67\x00\x67\x00\x16\x00\x16\x00\x10\x00\x5e\x00\x5f\x00\x01\x00\x59\x00\x5a\x00\x5b\x00\x20\x00\x57\x00\x58\x00\x67\x00\x60\x00\x61\x00\x62\x00\x63\x00\x5e\x00\x5f\x00\x1f\x00\x67\x00\x1f\x00\x21\x00\x10\x00\x35\x00\x0d\x00\x67\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x1e\x00\x57\x00\x58\x00\x18\x00\x59\x00\x5a\x00\x5b\x00\x3d\x00\x5e\x00\x5f\x00\x0d\x00\x60\x00\x61\x00\x62\x00\x63\x00\x57\x00\x58\x00\x67\x00\x67\x00\x08\x00\x10\x00\x0d\x00\x5e\x00\x5f\x00\x0e\x00\x59\x00\x5a\x00\x5b\x00\x0e\x00\x57\x00\x58\x00\x67\x00\x60\x00\x61\x00\x62\x00\x63\x00\x5e\x00\x5f\x00\x0e\x00\x67\x00\x15\x00\x10\x00\x14\x00\x1a\x00\x18\x00\x67\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x0d\x00\x57\x00\x58\x00\x1a\x00\x59\x00\x5a\x00\x5b\x00\x1a\x00\x5e\x00\x5f\x00\x15\x00\x60\x00\x61\x00\x62\x00\x63\x00\x57\x00\x58\x00\x67\x00\x67\x00\x30\x00\x15\x00\x10\x00\x5e\x00\x5f\x00\x0d\x00\x10\x00\x1a\x00\x18\x00\x10\x00\x57\x00\x58\x00\x67\x00\x0f\x00\x02\x00\x10\x00\x3d\x00\x5e\x00\x5f\x00\x3f\x00\xff\xff\x32\x00\xff\xff\xff\xff\xff\xff\xff\xff\x67\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x67\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x67\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x67\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x67\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x67\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x67\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x67\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x67\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x67\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x67\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x67\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x67\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x67\x00\x03\x00\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x57\x00\x58\x00\x67\x00\x11\x00\xff\xff\x13\x00\xff\xff\x5e\x00\x5f\x00\x17\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x00\x67\x00\x03\x00\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\xff\xff\xff\xff\xff\xff\x0d\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x13\x00\xff\xff\x31\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x37\x00\xff\xff\x1d\x00\xff\xff\x03\x00\xff\xff\xff\xff\x3e\x00\x23\x00\x24\x00\x25\x00\xff\xff\xff\xff\xff\xff\x0d\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\xff\xff\x13\x00\xff\xff\x31\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x37\x00\xff\xff\x1d\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3e\x00\x23\x00\x24\x00\xff\xff\xff\xff\x27\x00\x28\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\x2f\x00\xff\xff\x31\x00\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\x13\x00\x3a\x00\x3b\x00\x3c\x00\x17\x00\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\x1d\x00\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\x23\x00\x24\x00\xff\xff\xff\xff\x27\x00\x28\x00\x67\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\x38\x00\xff\xff\x3a\x00\x3b\x00\x0d\x00\x0e\x00\xff\xff\x10\x00\xff\xff\xff\xff\x13\x00\xff\xff\x15\x00\x16\x00\x17\x00\x18\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x00\x01\x00\x02\x00\xff\xff\x21\x00\xff\xff\x23\x00\x24\x00\x25\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x2d\x00\xff\xff\xff\xff\x13\x00\x31\x00\xff\xff\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\x38\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\x67\x00\x5e\x00\x5f\x00\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\x01\x00\x02\x00\x67\x00\x5e\x00\x5f\x00\xff\xff\xff\xff\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x67\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x22\x00\xff\xff\xff\xff\xff\xff\x26\x00\xff\xff\x03\x00\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x57\x00\x58\x00\x10\x00\x36\x00\xff\xff\x13\x00\xff\xff\x5e\x00\x5f\x00\x17\x00\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\x1d\x00\x67\x00\x5e\x00\x5f\x00\xff\xff\x03\x00\x23\x00\x24\x00\x25\x00\xff\xff\xff\xff\x67\x00\xff\xff\xff\xff\xff\xff\x0d\x00\x2d\x00\xff\xff\x10\x00\xff\xff\x31\x00\x13\x00\x33\x00\xff\xff\xff\xff\x17\x00\x18\x00\x38\x00\xff\xff\xff\xff\xff\xff\x1d\x00\xff\xff\x03\x00\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\xff\xff\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\x10\x00\x2d\x00\xff\xff\x13\x00\x14\x00\x31\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\x1d\x00\xff\xff\x03\x00\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\xff\xff\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\x10\x00\x2d\x00\xff\xff\x13\x00\xff\xff\x31\x00\xff\xff\x17\x00\xff\xff\xff\xff\xff\xff\xff\xff\x38\x00\x1d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x2d\x00\xff\xff\x3c\x00\x3d\x00\x31\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\x38\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\xff\xff\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\x67\x00\xff\xff\xff\xff\xff\xff\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\xff\xff\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\xff\xff\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\x45\x00\x46\x00\xff\xff\x37\x00\x38\x00\x39\x00\x67\x00\xff\xff\xff\xff\xff\xff\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\xff\xff\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\x57\x00\x58\x00\xff\xff\xff\xff\x3f\x00\x40\x00\xff\xff\x5e\x00\x5f\x00\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\xff\xff\xff\xff\xff\xff\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\xff\xff\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\x57\x00\x58\x00\xff\xff\xff\xff\x3f\x00\x40\x00\xff\xff\x5e\x00\x5f\x00\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\xff\xff\x3c\x00\x3d\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\xff\xff\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\xff\xff\x67\x00\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x3c\x00\x3d\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\xff\xff\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\x37\x00\x38\x00\x39\x00\x5e\x00\x5f\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\xff\xff\x67\x00\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\x55\x00\x56\x00\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\x46\x00\xff\xff\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x67\x00\xff\xff\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\xff\xff\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\x40\x00\xff\xff\x5e\x00\x5f\x00\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\xff\xff\xff\xff\x3d\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\xff\xff\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\xff\xff\x67\x00\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x67\x00\xff\xff\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\xff\xff\x33\x00\xff\xff\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\xff\xff\xff\xff\xff\xff\x57\x00\x58\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x5e\x00\x5f\x00\xff\xff\x57\x00\x58\x00\x37\x00\x38\x00\x39\x00\xff\xff\x67\x00\x5e\x00\x5f\x00\xff\xff\x57\x00\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\x67\x00\x5e\x00\x5f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x56\x00\x57\x00\x58\x00\x67\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5e\x00\x5f\x00\x03\x00\x57\x00\x58\x00\xff\xff\xff\xff\x03\x00\xff\xff\x67\x00\x5e\x00\x5f\x00\x0d\x00\x0e\x00\xff\xff\x10\x00\xff\xff\x0d\x00\x13\x00\x67\x00\x10\x00\xff\xff\x17\x00\x13\x00\xff\xff\xff\xff\xff\xff\x17\x00\x1d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x00\x23\x00\x24\x00\x25\x00\xff\xff\xff\xff\x23\x00\x24\x00\x25\x00\x03\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x03\x00\x31\x00\x2d\x00\xff\xff\xff\xff\x0d\x00\x31\x00\xff\xff\x10\x00\xff\xff\x0d\x00\x13\x00\xff\xff\xff\xff\xff\xff\x17\x00\x13\x00\xff\xff\xff\xff\xff\xff\x17\x00\x1d\x00\xff\xff\xff\xff\x03\x00\xff\xff\x1d\x00\x23\x00\x24\x00\x25\x00\xff\xff\xff\xff\x23\x00\x24\x00\x0d\x00\x03\x00\xff\xff\x2d\x00\xff\xff\xff\xff\x13\x00\x31\x00\xff\xff\x03\x00\x17\x00\x0d\x00\x31\x00\xff\xff\xff\xff\xff\xff\x1d\x00\x13\x00\xff\xff\x0d\x00\xff\xff\x17\x00\x23\x00\x24\x00\xff\xff\x13\x00\xff\xff\x1d\x00\x03\x00\x17\x00\x03\x00\xff\xff\xff\xff\x23\x00\x24\x00\x1d\x00\x31\x00\xff\xff\x0d\x00\xff\xff\x0d\x00\x23\x00\x24\x00\xff\xff\x13\x00\xff\xff\x13\x00\x31\x00\x17\x00\x03\x00\x17\x00\xff\xff\xff\xff\xff\xff\x1d\x00\x31\x00\x1d\x00\x03\x00\xff\xff\x0d\x00\x23\x00\x24\x00\x23\x00\x24\x00\xff\xff\x13\x00\xff\xff\x0d\x00\x03\x00\x17\x00\xff\xff\xff\xff\xff\xff\x13\x00\x31\x00\x1d\x00\x31\x00\x17\x00\x0d\x00\xff\xff\xff\xff\x23\x00\x24\x00\x1d\x00\x13\x00\xff\xff\x03\x00\xff\xff\x17\x00\x23\x00\x24\x00\xff\xff\xff\xff\xff\xff\x1d\x00\x31\x00\x0d\x00\x03\x00\xff\xff\xff\xff\x23\x00\x24\x00\x13\x00\x31\x00\xff\xff\x03\x00\x17\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x00\x13\x00\x31\x00\x0d\x00\xff\xff\x17\x00\x23\x00\x24\x00\xff\xff\x13\x00\xff\xff\x1d\x00\x03\x00\x17\x00\xff\xff\xff\xff\xff\xff\x23\x00\x24\x00\x1d\x00\x31\x00\xff\xff\x0d\x00\xff\xff\xff\xff\x23\x00\x24\x00\xff\xff\x13\x00\xff\xff\xff\xff\x31\x00\x17\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x1d\x00\x31\x00\x0d\x00\x0e\x00\xff\xff\x10\x00\x23\x00\x24\x00\x13\x00\xff\xff\xff\xff\xff\xff\x17\x00\x0d\x00\xff\xff\xff\xff\x10\x00\xff\xff\x1d\x00\x13\x00\x31\x00\xff\xff\xff\xff\x17\x00\x23\x00\x24\x00\x25\x00\xff\xff\xff\xff\x1d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2d\x00\x23\x00\x24\x00\x25\x00\x31\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\xff\xff\x2d\x00\xff\xff\xff\xff\xff\xff\x31\x00\x0e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x16\x00\xff\xff\xff\xff\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x21\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+
+happyTable :: HappyAddr
+happyTable = HappyA# "\x00\x00\x53\x01\x08\x00\xf9\x00\x0d\x00\x33\x00\x0f\x00\x4f\x01\x35\x00\xa4\x01\xfe\x00\xff\x00\x98\x01\xfc\x00\xff\x01\x09\x01\xdb\xff\x7d\x01\x45\x00\xdb\xff\x0d\x01\xf1\xfe\x34\x00\xf9\x01\x8f\x01\xcc\x01\x3a\x00\x10\x00\x11\x00\xf1\xfe\x05\x00\x1f\x00\xfc\x00\x44\x00\x05\x00\xc8\x01\xfd\x01\x0a\x01\xc9\x01\x3f\x00\xab\x00\xf4\x01\xc5\x00\x0c\x01\xea\x00\xa5\x01\x41\x01\x42\x01\xd8\x00\x3c\x00\x12\x00\xc5\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x7e\x01\xa5\x00\xcd\x01\x0d\x00\x0e\x00\x0f\x00\xc5\x00\xa6\x00\x4c\x00\xc5\x00\x69\x01\xe9\x00\xea\x00\xfd\x00\x6a\x01\x8d\x01\x39\x00\xf1\x01\x6b\x01\xdb\xff\x45\x01\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x10\x00\x11\x00\xa9\x01\x1d\x00\x1e\x00\x36\x00\xfa\x00\x37\x00\x38\x00\x99\x01\x1f\x00\x20\x00\x99\x01\xfa\x00\xba\x01\xab\x00\x39\x00\x54\x01\xe6\x01\x21\x00\x09\x00\xfa\x00\xab\x00\x12\x00\x46\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\xab\x00\x40\x00\x3d\x00\xeb\x00\xc3\x01\x0f\x00\x36\x00\x3d\x00\x41\x00\x42\x00\x1f\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x3d\x00\x9a\x00\x39\x00\xf3\x01\xab\x00\xf8\x01\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x10\x00\x11\x00\xeb\x00\x1d\x00\x1e\x00\xeb\x00\x1c\x01\xfb\x01\x9c\x00\x1f\x00\x1f\x00\x20\x00\x1f\x00\x1f\x00\x95\x00\xca\x01\x96\x00\xcb\x01\xab\x00\x21\x00\xa6\x01\xab\x00\xab\x00\x12\x00\xdf\x01\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\xa2\x01\x45\x01\x44\x00\x72\x01\x57\x01\x0f\x00\xa7\x01\xa1\x00\xa2\x00\xa3\x00\xa4\x00\x5f\x01\xff\x01\xc5\x00\xbe\x01\xc5\x00\xe8\x01\x92\x01\xd8\x00\xc4\x00\xc7\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x10\x00\x11\x00\xc8\x00\x1d\x00\x1e\x00\xc5\x00\xc9\x00\x45\x01\x1a\x01\x1b\x01\x1f\x00\x20\x00\xdd\x01\xa0\x01\xa1\x01\xd6\x01\x38\x01\x1b\x01\xf6\x01\x21\x00\xa2\x01\xc5\x00\xc5\x00\x12\x00\x9d\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\xc5\x00\x62\x01\xaa\x00\xa3\x01\xc5\x00\xa5\x00\x9f\x01\xa0\x01\xa1\x01\x1f\x00\x1f\x00\xa6\x00\x4c\x00\x53\x01\xa2\x01\x10\x00\x11\x00\xfa\x00\xab\x00\xab\x00\x39\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xab\x00\xc6\x01\xc0\x00\x1d\x00\x1e\x00\xbe\x01\xa2\x00\xa3\x00\xa4\x00\x9a\x00\x1f\x00\x20\x00\x12\x00\x1c\x01\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x21\x00\x1f\x00\x1c\x01\xdc\x01\xa3\x01\xf3\x01\x9e\x01\x24\x00\x9c\x00\x1f\x00\xab\x00\x1f\x00\xf0\x01\x25\x00\xf1\x01\x44\x00\x9a\x00\x26\x00\xab\x00\x3a\x01\xab\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xe5\x00\x3b\x01\xa3\x01\x1d\x00\x1e\x00\xd8\x01\x7b\x00\x07\x00\x9c\x00\x1f\x00\x1f\x00\x20\x00\x05\x01\xf0\x00\xa5\x00\x9a\x00\xf1\x00\xf2\x00\xab\x00\x21\x00\xa6\x00\x4c\x00\xef\x00\xf0\x00\xb7\x00\xab\x01\xf1\x00\xf2\x00\xc2\x01\x39\x00\x9b\x00\x1f\x00\x9a\x00\x9c\x00\xe0\x01\xa1\x00\xa2\x00\xa3\x00\xa4\x00\x12\x00\xab\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x56\x01\x05\x01\x9a\x00\x12\x00\x9c\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x48\x01\x49\x01\xa2\x00\xa3\x00\xa4\x00\x4a\x01\x4b\x01\x0c\x01\xb8\x00\xb9\x00\x9c\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xd8\x01\x39\x00\xe3\x01\x1d\x00\x1e\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1f\x00\x4c\x00\x93\x01\x1d\x00\x1e\x00\xf1\x00\xf2\x00\xa5\x00\xe1\x00\x21\x00\x1f\x00\x4c\x00\xe2\x00\xa6\x00\x4c\x00\x7b\x00\x07\x00\xe3\x00\x77\x01\x21\x00\x7b\x00\x07\x00\x39\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\xbb\x00\x12\x00\xa5\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\xa6\x00\x4c\x00\x3b\x00\x4c\x01\x8d\x00\x70\x00\x71\x00\x72\x00\x73\x00\x4d\x01\x05\x00\xc2\x00\x9b\x00\x80\x00\xc5\x01\x27\x01\x28\x01\x81\x00\xc3\x00\xca\x00\x82\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1f\x00\x97\x00\xc4\x00\x1d\x00\x1e\x00\x9a\x00\xdb\x01\x83\x00\x78\x00\xab\x00\x1f\x00\x4c\x00\x12\x00\x44\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x21\x00\x9b\x00\x05\x00\x97\x00\x9c\x00\xd1\x01\xd2\x01\xd3\x01\x7b\x01\x8d\x00\x70\x00\x71\x00\x72\x00\x73\x00\xf1\xfe\x27\x01\x28\x01\x7b\x01\x2a\x01\x2b\x01\x2c\x01\x2d\x01\x19\x00\x1a\x00\x1b\x00\x1c\x00\x2e\x01\x44\x00\x8e\x00\x1d\x00\x1e\x00\xc9\xff\x6b\x01\xc0\x00\xf1\xfe\xf1\xfe\x1f\x00\x4c\x00\x12\x00\x78\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x21\x00\xa8\x00\x06\x01\x60\x01\x37\x00\x42\x00\x8a\x01\xa9\x00\x75\x01\x95\x01\x61\x01\xaa\x00\x76\x01\x39\x00\x9d\x01\x27\x01\x28\x01\x29\x01\x2a\x01\x2b\x01\x2c\x01\x2d\x01\x19\x00\x1a\x00\x1b\x00\x1c\x00\x2e\x01\x48\x00\x97\x00\x1d\x00\x1e\x00\x04\x00\xd5\x01\x03\x01\xd6\x01\x05\x00\x1f\x00\x4c\x00\x12\x00\x05\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x21\x00\x88\x01\x49\x01\xa2\x00\xa3\x00\xa4\x00\x89\x01\xf8\x00\xcb\x00\xb9\x00\x03\x01\x9b\x01\x49\x01\xa2\x00\xa3\x00\xa4\x00\x9c\x01\x39\x00\x0a\x01\xb4\x01\x2c\x01\x2d\x01\x19\x00\x1a\x00\x1b\x00\x1c\x00\x2e\x01\x36\x01\xc0\x00\x1d\x00\x1e\x00\xe1\x01\xa1\x00\xa2\x00\xa3\x00\xa4\x00\x1f\x00\x4c\x00\xbb\xff\x45\x01\x82\x01\xbf\x00\xc0\x00\xbb\xff\x83\x01\x21\x00\x46\x01\xb2\x01\xa1\x00\xa2\x00\xa3\x00\xa4\x00\x69\x00\x26\x01\x6b\x00\x8a\x00\xa5\x00\x8e\x01\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa6\x00\x4c\x00\x97\x00\x7a\x01\xa5\x00\x96\x00\x0c\x01\x98\x00\x8d\x01\x39\x00\xa6\x00\x4c\x00\x94\x01\xa1\x00\xa2\x00\xa3\x00\xa4\x00\x13\xff\xba\xff\x39\x00\xba\xff\x13\xff\xbe\x00\x9e\x00\xa5\x00\x97\x01\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa6\x00\x4c\x00\xf1\xfe\x44\x00\xb2\x00\xdb\x00\x0f\x01\x1e\x01\xe7\x00\x39\x00\xa5\x00\x07\x01\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa6\x00\x4c\x00\xe8\x00\xee\x00\xa5\x00\xec\x01\xed\x01\xee\x01\xf4\x00\x39\x00\xa6\x00\x4c\x00\x46\x01\xa1\x00\xa2\x00\xa3\x00\xa4\x00\x98\x00\x05\x01\x39\x00\x93\x01\xa5\x00\xa0\x00\xa1\x00\xa2\x00\xa3\x00\xa4\x00\xa6\x00\x4c\x00\x5c\x01\xa4\x00\xd2\x00\xd5\x00\x95\x00\xa5\x00\x96\x00\x39\x00\xf5\x00\xd3\x00\xd6\x00\xa6\x00\x4c\x00\x5d\x01\xa4\x00\xf6\x00\x58\x01\xa2\x00\xa3\x00\xa4\x00\x39\x00\xa5\x00\x59\x01\x5a\x01\x9b\x00\x32\x00\xf8\x00\xa6\x00\x4c\x00\xa8\x00\x58\x01\xa2\x00\xa3\x00\xa4\x00\x0c\x00\xa9\x00\x39\x00\xc5\x01\xa5\x00\xaa\x00\xbf\x01\xa2\x00\xa3\x00\xa4\x00\xa6\x00\x4c\x00\x13\x01\xa4\x00\xa5\x00\x8f\x00\x16\x00\x17\x00\xa5\x00\x39\x00\xa6\x00\x4c\x00\x0b\x00\x03\x00\xa6\x00\x4c\x00\xc7\x00\xf1\xfe\xf1\xfe\x39\x00\x51\x01\xa5\x00\x3f\x00\x39\x00\x24\x00\x24\x01\xa5\x00\xa6\x00\x4c\x00\xa8\x00\x25\x00\xc7\x00\x5b\x01\x4c\x00\x26\x00\xa9\x00\x39\x00\x4a\x00\x4b\x00\xaa\x00\xa5\x00\x39\x00\xa8\x00\xfd\x01\x1f\x00\x4c\x00\x5b\x01\x4c\x00\xa9\x00\x48\x01\xa5\x00\xf0\x01\xaa\x00\x4d\x00\xa5\x00\x39\x00\xa6\x00\x4c\x00\x24\x00\x3f\x00\xa6\x00\x4c\x00\xd5\x01\xd7\x00\x25\x00\x39\x00\x63\x00\xdf\x01\x26\x00\x39\x00\xd8\x00\x64\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x65\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x44\x00\x66\x00\x78\x01\x92\x00\x93\x00\x90\x01\x92\x00\x93\x00\x01\x01\x92\x00\x93\x00\xe8\x01\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x5c\x00\x5d\x00\xc8\x01\x4a\x00\x1e\x00\x95\x00\x67\x00\x96\x00\xc7\x00\x68\x00\x1f\x00\x4c\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\xf1\xfe\xf1\xfe\x23\x00\x6d\x00\x91\x00\x92\x00\x93\x00\xcf\x01\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\x24\x00\x4a\x00\x1e\x00\x7b\x00\x07\x00\xda\x01\x25\x00\xdc\x01\x1f\x00\x4c\x00\x26\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x61\x01\x27\x00\x21\x00\x61\x01\x9b\x01\x3f\x00\xf1\xfe\x28\x00\x29\x00\x30\x01\xf1\xfe\xb4\x00\x44\x00\xf1\xfe\x31\x01\x32\x01\x33\x01\x34\x01\xb1\x01\xb2\x01\xb4\x00\x2e\x00\xa8\x00\x4f\x01\xb9\x01\xb8\x01\xf1\xfe\x35\x01\xa9\x00\xbd\x01\x75\x00\xbb\x01\xaa\x00\xbc\x01\x36\x01\xf6\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\xe4\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\xcf\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\xc1\x01\x4a\x00\x1e\x00\xc2\x01\x24\x00\x64\x01\xcf\x00\x63\x01\x1f\x00\x4c\x00\x25\x00\xf4\x00\x68\x01\x6d\x01\x26\x00\x4a\x00\x1e\x00\x21\x00\x81\x01\x77\x01\x27\x00\xc7\x00\x1f\x00\x4c\x00\x80\x01\x88\x01\x28\x00\x29\x00\x45\x01\x4a\x00\x1e\x00\x21\x00\x44\x00\xb4\x00\x8c\x01\x44\x00\x1f\x00\x4c\x00\x97\x01\x9b\x01\x2e\x00\x97\x01\xa0\x00\xfe\x00\x20\x01\x21\x00\xd0\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\xa8\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\xaa\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x1f\x01\x4a\x00\x1e\x00\x25\x01\x85\x00\x86\x00\xd3\x00\x26\x01\x1f\x00\x4c\x00\x38\x01\x88\x00\x89\x00\x6b\x00\x8a\x00\x4a\x00\x1e\x00\x21\x00\x8b\x00\x3e\x01\x3f\x01\x3f\x00\x1f\x00\x4c\x00\x7b\x00\x85\x00\x86\x00\xdd\x00\x52\x01\x4a\x00\x1e\x00\x21\x00\x88\x00\x89\x00\x6b\x00\x8a\x00\x1f\x00\x4c\x00\x44\x01\x8b\x00\x13\xff\x53\x01\x56\x01\xa0\x00\x44\x00\x21\x00\xb1\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\xb5\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\xb6\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x96\x00\x4a\x00\x1e\x00\x8f\x00\x85\x00\x86\x00\xde\x00\xb4\x00\x1f\x00\x4c\x00\x44\x00\x88\x00\x89\x00\x6b\x00\x8a\x00\x4a\x00\x1e\x00\x21\x00\x8b\x00\xbb\x00\xc7\x00\x44\x00\x1f\x00\x4c\x00\xfc\xfe\x85\x00\x86\x00\x87\x00\xcf\x00\x4a\x00\x1e\x00\x21\x00\x88\x00\x89\x00\x6b\x00\x8a\x00\x1f\x00\x4c\x00\xd0\x00\x8b\x00\xd3\x00\x3f\x00\xdd\x00\xe0\x00\x8f\x00\x21\x00\x64\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x6d\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x6e\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x44\x00\x4a\x00\x1e\x00\x0f\xff\x85\x00\x86\x00\x90\x00\xed\x00\x1f\x00\x4c\x00\xee\x00\x88\x00\x89\x00\x6b\x00\x8a\x00\x4a\x00\x1e\x00\x21\x00\x8b\x00\xf4\x00\xee\x00\x3f\x00\x1f\x00\x4c\x00\x44\x00\x48\x00\x84\x00\x8f\x00\x85\x00\x4a\x00\x1e\x00\x21\x00\x9d\x00\x07\x00\x0b\x00\x08\x00\x1f\x00\x4c\x00\xff\xff\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x00\x6f\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x71\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x73\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x1e\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x1e\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x00\x7c\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x00\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x0f\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x1e\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x1e\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x00\x11\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x12\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x20\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x1e\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x1e\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x00\x22\x01\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\xb1\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\xd9\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x1e\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x1e\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x00\xda\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\xe5\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\xe6\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x1e\x00\x21\x00\x23\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x4a\x00\x1e\x00\x21\x00\x34\xff\x00\x00\x25\x00\x00\x00\x1f\x00\x4c\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\x21\x00\x23\x00\x00\x00\x00\x00\x00\x00\x28\x00\x29\x00\x30\x01\x00\x00\x00\x00\x00\x00\x24\x00\x31\x01\x32\x01\x33\x01\x34\x01\x00\x00\x25\x00\x00\x00\x2e\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x35\x01\x00\x00\x27\x00\x00\x00\x23\x00\x00\x00\x00\x00\x36\x01\x28\x00\x29\x00\x30\x01\x00\x00\x00\x00\x00\x00\x24\x00\x31\x01\x32\x01\x33\x01\x34\x01\x00\x00\x25\x00\x00\x00\x2e\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x35\x01\x00\x00\x27\x00\xd0\x00\x15\x00\x16\x00\x17\x00\x36\x01\x28\x00\x29\x00\x00\x00\x00\x00\x2a\x00\x2b\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2c\x00\x2d\x00\x00\x00\x2e\x00\x00\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2f\x00\x25\x00\x30\x00\x31\x00\x32\x00\x26\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x27\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x28\x00\x29\x00\x00\x00\x00\x00\x2a\x00\x2b\x00\x4d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2d\x00\x00\x00\x2e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x00\x00\x2f\x00\x00\x00\x30\x00\x31\x00\x24\x00\x74\x00\x00\x00\x60\x00\x00\x00\x00\x00\x25\x00\x00\x00\x75\x00\x76\x00\x26\x00\x77\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\xf1\xfe\xf1\xfe\x00\x00\x78\x00\x00\x00\x28\x00\x29\x00\x61\x00\xf1\xfe\xf1\xfe\xf1\xfe\xf1\xfe\x24\x00\x00\x00\x00\x00\x62\x00\x00\x00\x00\x00\x25\x00\x2e\x00\x00\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x63\x00\x83\x01\x59\x00\x84\x01\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x00\x00\x00\x00\x85\x01\x59\x00\x86\x01\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x00\x00\x00\x00\x14\x01\x59\x00\x15\x01\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x00\x1f\x00\x4c\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x7b\x00\x07\x00\x21\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\xbb\x00\x7c\x00\x7d\x00\x7e\x00\x7f\x00\x21\x00\x17\x01\x59\x00\x18\x01\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x00\x00\x00\x00\xcc\x00\x59\x00\xcd\x00\x5b\x00\x14\x00\x15\x00\x16\x00\x17\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x81\x00\x00\x00\x5f\x00\x82\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x24\x00\x4a\x00\x1e\x00\x60\x00\x83\x00\x00\x00\x25\x00\x00\x00\x1f\x00\x4c\x00\x26\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x27\x00\x21\x00\x1f\x00\x4c\x00\x00\x00\x5f\x00\x28\x00\x29\x00\x61\x00\x00\x00\x00\x00\x21\x00\x00\x00\x00\x00\x00\x00\x24\x00\x62\x00\x00\x00\x60\x00\x00\x00\x2e\x00\x25\x00\xb4\x01\x00\x00\x00\x00\x26\x00\x8f\x00\x63\x00\x00\x00\x00\x00\x00\x00\x27\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x28\x00\x29\x00\x61\x00\x00\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x60\x00\x62\x00\x00\x00\x25\x00\x5a\xff\x2e\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x27\x00\x00\x00\x5f\x00\x00\x00\x00\x00\x00\x00\x28\x00\x29\x00\x61\x00\x00\x00\x00\x00\x00\x00\x24\x00\x00\x00\x00\x00\x60\x00\x62\x00\x00\x00\x25\x00\x00\x00\x2e\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x29\x00\x61\x00\x12\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x62\x00\x00\x00\xfa\x01\xad\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x01\x63\x00\x3c\x01\x14\x00\x15\x00\x16\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\xae\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xaf\x00\x00\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x12\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x21\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\xf3\x01\xea\x01\x00\x00\x00\x00\x00\x00\x00\x00\x21\x00\x00\x00\x00\x00\x00\x00\xae\x01\x19\x00\x1a\x00\x1b\x00\x1c\x00\xeb\x01\x00\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x12\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x21\x00\x00\x00\xe5\x01\xad\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x01\x00\x00\x40\x01\x14\x00\x15\x00\x16\x00\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\xae\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xaf\x00\x00\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x12\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x21\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\xe9\x01\xea\x01\x00\x00\x49\x00\x16\x00\x17\x00\x21\x00\x00\x00\x00\x00\x00\x00\xae\x01\x19\x00\x1a\x00\x1b\x00\x1c\x00\xeb\x01\x00\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x12\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x21\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\xd8\x01\xad\x01\x00\x00\x1f\x00\x4c\x00\xb4\x00\x00\x00\xb5\x00\x14\x00\x15\x00\x16\x00\x17\x00\x4d\x00\x00\x00\x00\x00\x00\x00\xae\x01\x19\x00\x1a\x00\x1b\x00\x1c\x00\xaf\x01\x00\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x12\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x21\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\xac\x01\xad\x01\x00\x00\x1f\x00\x4c\x00\x12\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x21\x00\x00\x00\x70\x01\xad\x00\xae\x01\x19\x00\x1a\x00\x1b\x00\x1c\x00\xaf\x01\x00\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\xae\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xaf\x00\x00\x00\x21\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x12\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x21\x00\x00\x00\x10\x01\xad\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x00\x00\x00\x00\xac\x00\xad\x00\xae\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xaf\x00\x00\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x4f\x00\x16\x00\x17\x00\x1f\x00\x4c\x00\xae\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xaf\x00\x00\x00\x21\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x12\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x21\x00\x50\x00\x51\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\xf8\x01\x00\x00\x4e\x00\x16\x00\x17\x00\x00\x00\x00\x00\x4d\x00\x00\x00\xae\x01\x19\x00\x1a\x00\x1b\x00\x1c\x00\xeb\x01\x00\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x12\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x21\x00\x4a\x00\x4b\x00\x00\x00\x00\x00\x00\x00\xe3\x01\x00\x00\x1f\x00\x4c\x00\x12\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x4d\x00\x00\x00\x00\x00\x65\x01\xae\x01\x19\x00\x1a\x00\x1b\x00\x1c\x00\xaf\x01\x00\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\xae\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\xaf\x00\x00\x00\x21\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x12\x00\x00\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x21\x00\x00\x00\x00\x00\xbb\x00\x00\x00\xbc\x00\x14\x00\x15\x00\x16\x00\x17\x00\x00\x00\x00\x00\x00\x00\x78\x00\x00\x00\x79\x00\x14\x00\x15\x00\x16\x00\x17\x00\x00\x00\x66\x01\x19\x00\x1a\x00\x1b\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x1e\x00\x4f\x00\x16\x00\x17\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x00\x00\x4a\x00\x1e\x00\x8f\x00\x16\x00\x17\x00\x00\x00\x21\x00\x1f\x00\x4c\x00\x00\x00\x4a\x00\x1e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x21\x00\x1f\x00\x4c\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe3\x00\x4a\x00\x4b\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x4c\x00\x1a\x01\x4a\x00\x4b\x00\x00\x00\x00\x00\x17\x01\x00\x00\x4d\x00\x1f\x00\x4c\x00\x24\x00\x22\x01\x00\x00\x60\x00\x00\x00\x24\x00\x25\x00\x4d\x00\x60\x00\x00\x00\x26\x00\x25\x00\x00\x00\x00\x00\x00\x00\x26\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\x28\x00\x29\x00\x61\x00\x00\x00\x00\x00\x28\x00\x29\x00\x61\x00\x1a\x01\x00\x00\x62\x00\x00\x00\x00\x00\x23\x00\x2e\x00\x62\x00\x00\x00\x00\x00\x24\x00\x2e\x00\x00\x00\x60\x00\x00\x00\x24\x00\x25\x00\x00\x00\x00\x00\x00\x00\x26\x00\x25\x00\x00\x00\x00\x00\x00\x00\x26\x00\x27\x00\x00\x00\x00\x00\x23\x00\x00\x00\x27\x00\x28\x00\x29\x00\x61\x00\x00\x00\x00\x00\x28\x00\x29\x00\x24\x00\x23\x00\x00\x00\x62\x00\x00\x00\x00\x00\x25\x00\x2e\x00\x00\x00\x23\x00\x26\x00\x24\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x27\x00\x25\x00\x00\x00\x24\x00\x00\x00\x26\x00\x28\x00\x29\x00\x00\x00\x25\x00\x00\x00\x27\x00\x23\x00\x26\x00\x23\x00\x00\x00\x00\x00\x28\x00\x29\x00\x27\x00\xb1\x00\x00\x00\x24\x00\x00\x00\x24\x00\x28\x00\x29\x00\x00\x00\x25\x00\x00\x00\x25\x00\x2e\x00\x26\x00\x23\x00\x26\x00\x00\x00\x00\x00\x00\x00\x27\x00\xb1\x00\x27\x00\x23\x00\x00\x00\x24\x00\x28\x00\x29\x00\x28\x00\x29\x00\x00\x00\x25\x00\x00\x00\x24\x00\x23\x00\x26\x00\x00\x00\x00\x00\x00\x00\x25\x00\x2e\x00\x27\x00\xb1\x00\x26\x00\x24\x00\x00\x00\x00\x00\x28\x00\x29\x00\x27\x00\x25\x00\x00\x00\x23\x00\x00\x00\x26\x00\x28\x00\x29\x00\x00\x00\x00\x00\x00\x00\x27\x00\x2e\x00\x24\x00\xb7\x00\x00\x00\x00\x00\x28\x00\x29\x00\x25\x00\xb1\x00\x00\x00\xbe\x00\x26\x00\x24\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\x25\x00\x2e\x00\x24\x00\x00\x00\x26\x00\x28\x00\x29\x00\x00\x00\x25\x00\x00\x00\x27\x00\x23\x00\x26\x00\x00\x00\x00\x00\x00\x00\x28\x00\x29\x00\x27\x00\xb1\x00\x00\x00\x24\x00\x00\x00\x00\x00\x28\x00\x29\x00\x00\x00\x25\x00\x00\x00\x00\x00\x2e\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\x2e\x00\x24\x00\xfb\xfe\x00\x00\x60\x00\x28\x00\x29\x00\x25\x00\x00\x00\x00\x00\x00\x00\x26\x00\x24\x00\x00\x00\x00\x00\x60\x00\x00\x00\x27\x00\x25\x00\x2e\x00\x00\x00\x00\x00\x26\x00\x28\x00\x29\x00\x61\x00\x00\x00\x00\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x28\x00\x29\x00\x61\x00\x2e\x00\x8d\x00\x70\x00\x71\x00\x72\x00\x73\x00\x00\x00\x62\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x8f\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8f\xff\x8e\x00\x00\x00\x00\x00\x00\x00\x8f\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+
+happyReduceArr = array (1, 270) [
+	(1 , happyReduce_1),
+	(2 , happyReduce_2),
+	(3 , happyReduce_3),
+	(4 , happyReduce_4),
+	(5 , happyReduce_5),
+	(6 , happyReduce_6),
+	(7 , happyReduce_7),
+	(8 , happyReduce_8),
+	(9 , happyReduce_9),
+	(10 , happyReduce_10),
+	(11 , happyReduce_11),
+	(12 , happyReduce_12),
+	(13 , happyReduce_13),
+	(14 , happyReduce_14),
+	(15 , happyReduce_15),
+	(16 , happyReduce_16),
+	(17 , happyReduce_17),
+	(18 , happyReduce_18),
+	(19 , happyReduce_19),
+	(20 , happyReduce_20),
+	(21 , happyReduce_21),
+	(22 , happyReduce_22),
+	(23 , happyReduce_23),
+	(24 , happyReduce_24),
+	(25 , happyReduce_25),
+	(26 , happyReduce_26),
+	(27 , happyReduce_27),
+	(28 , happyReduce_28),
+	(29 , happyReduce_29),
+	(30 , happyReduce_30),
+	(31 , happyReduce_31),
+	(32 , happyReduce_32),
+	(33 , happyReduce_33),
+	(34 , happyReduce_34),
+	(35 , happyReduce_35),
+	(36 , happyReduce_36),
+	(37 , happyReduce_37),
+	(38 , happyReduce_38),
+	(39 , happyReduce_39),
+	(40 , happyReduce_40),
+	(41 , happyReduce_41),
+	(42 , happyReduce_42),
+	(43 , happyReduce_43),
+	(44 , happyReduce_44),
+	(45 , happyReduce_45),
+	(46 , happyReduce_46),
+	(47 , happyReduce_47),
+	(48 , happyReduce_48),
+	(49 , happyReduce_49),
+	(50 , happyReduce_50),
+	(51 , happyReduce_51),
+	(52 , happyReduce_52),
+	(53 , happyReduce_53),
+	(54 , happyReduce_54),
+	(55 , happyReduce_55),
+	(56 , happyReduce_56),
+	(57 , happyReduce_57),
+	(58 , happyReduce_58),
+	(59 , happyReduce_59),
+	(60 , happyReduce_60),
+	(61 , happyReduce_61),
+	(62 , happyReduce_62),
+	(63 , happyReduce_63),
+	(64 , happyReduce_64),
+	(65 , happyReduce_65),
+	(66 , happyReduce_66),
+	(67 , happyReduce_67),
+	(68 , happyReduce_68),
+	(69 , happyReduce_69),
+	(70 , happyReduce_70),
+	(71 , happyReduce_71),
+	(72 , happyReduce_72),
+	(73 , happyReduce_73),
+	(74 , happyReduce_74),
+	(75 , happyReduce_75),
+	(76 , happyReduce_76),
+	(77 , happyReduce_77),
+	(78 , happyReduce_78),
+	(79 , happyReduce_79),
+	(80 , happyReduce_80),
+	(81 , happyReduce_81),
+	(82 , happyReduce_82),
+	(83 , happyReduce_83),
+	(84 , happyReduce_84),
+	(85 , happyReduce_85),
+	(86 , happyReduce_86),
+	(87 , happyReduce_87),
+	(88 , happyReduce_88),
+	(89 , happyReduce_89),
+	(90 , happyReduce_90),
+	(91 , happyReduce_91),
+	(92 , happyReduce_92),
+	(93 , happyReduce_93),
+	(94 , happyReduce_94),
+	(95 , happyReduce_95),
+	(96 , happyReduce_96),
+	(97 , happyReduce_97),
+	(98 , happyReduce_98),
+	(99 , happyReduce_99),
+	(100 , happyReduce_100),
+	(101 , happyReduce_101),
+	(102 , happyReduce_102),
+	(103 , happyReduce_103),
+	(104 , happyReduce_104),
+	(105 , happyReduce_105),
+	(106 , happyReduce_106),
+	(107 , happyReduce_107),
+	(108 , happyReduce_108),
+	(109 , happyReduce_109),
+	(110 , happyReduce_110),
+	(111 , happyReduce_111),
+	(112 , happyReduce_112),
+	(113 , happyReduce_113),
+	(114 , happyReduce_114),
+	(115 , happyReduce_115),
+	(116 , happyReduce_116),
+	(117 , happyReduce_117),
+	(118 , happyReduce_118),
+	(119 , happyReduce_119),
+	(120 , happyReduce_120),
+	(121 , happyReduce_121),
+	(122 , happyReduce_122),
+	(123 , happyReduce_123),
+	(124 , happyReduce_124),
+	(125 , happyReduce_125),
+	(126 , happyReduce_126),
+	(127 , happyReduce_127),
+	(128 , happyReduce_128),
+	(129 , happyReduce_129),
+	(130 , happyReduce_130),
+	(131 , happyReduce_131),
+	(132 , happyReduce_132),
+	(133 , happyReduce_133),
+	(134 , happyReduce_134),
+	(135 , happyReduce_135),
+	(136 , happyReduce_136),
+	(137 , happyReduce_137),
+	(138 , happyReduce_138),
+	(139 , happyReduce_139),
+	(140 , happyReduce_140),
+	(141 , happyReduce_141),
+	(142 , happyReduce_142),
+	(143 , happyReduce_143),
+	(144 , happyReduce_144),
+	(145 , happyReduce_145),
+	(146 , happyReduce_146),
+	(147 , happyReduce_147),
+	(148 , happyReduce_148),
+	(149 , happyReduce_149),
+	(150 , happyReduce_150),
+	(151 , happyReduce_151),
+	(152 , happyReduce_152),
+	(153 , happyReduce_153),
+	(154 , happyReduce_154),
+	(155 , happyReduce_155),
+	(156 , happyReduce_156),
+	(157 , happyReduce_157),
+	(158 , happyReduce_158),
+	(159 , happyReduce_159),
+	(160 , happyReduce_160),
+	(161 , happyReduce_161),
+	(162 , happyReduce_162),
+	(163 , happyReduce_163),
+	(164 , happyReduce_164),
+	(165 , happyReduce_165),
+	(166 , happyReduce_166),
+	(167 , happyReduce_167),
+	(168 , happyReduce_168),
+	(169 , happyReduce_169),
+	(170 , happyReduce_170),
+	(171 , happyReduce_171),
+	(172 , happyReduce_172),
+	(173 , happyReduce_173),
+	(174 , happyReduce_174),
+	(175 , happyReduce_175),
+	(176 , happyReduce_176),
+	(177 , happyReduce_177),
+	(178 , happyReduce_178),
+	(179 , happyReduce_179),
+	(180 , happyReduce_180),
+	(181 , happyReduce_181),
+	(182 , happyReduce_182),
+	(183 , happyReduce_183),
+	(184 , happyReduce_184),
+	(185 , happyReduce_185),
+	(186 , happyReduce_186),
+	(187 , happyReduce_187),
+	(188 , happyReduce_188),
+	(189 , happyReduce_189),
+	(190 , happyReduce_190),
+	(191 , happyReduce_191),
+	(192 , happyReduce_192),
+	(193 , happyReduce_193),
+	(194 , happyReduce_194),
+	(195 , happyReduce_195),
+	(196 , happyReduce_196),
+	(197 , happyReduce_197),
+	(198 , happyReduce_198),
+	(199 , happyReduce_199),
+	(200 , happyReduce_200),
+	(201 , happyReduce_201),
+	(202 , happyReduce_202),
+	(203 , happyReduce_203),
+	(204 , happyReduce_204),
+	(205 , happyReduce_205),
+	(206 , happyReduce_206),
+	(207 , happyReduce_207),
+	(208 , happyReduce_208),
+	(209 , happyReduce_209),
+	(210 , happyReduce_210),
+	(211 , happyReduce_211),
+	(212 , happyReduce_212),
+	(213 , happyReduce_213),
+	(214 , happyReduce_214),
+	(215 , happyReduce_215),
+	(216 , happyReduce_216),
+	(217 , happyReduce_217),
+	(218 , happyReduce_218),
+	(219 , happyReduce_219),
+	(220 , happyReduce_220),
+	(221 , happyReduce_221),
+	(222 , happyReduce_222),
+	(223 , happyReduce_223),
+	(224 , happyReduce_224),
+	(225 , happyReduce_225),
+	(226 , happyReduce_226),
+	(227 , happyReduce_227),
+	(228 , happyReduce_228),
+	(229 , happyReduce_229),
+	(230 , happyReduce_230),
+	(231 , happyReduce_231),
+	(232 , happyReduce_232),
+	(233 , happyReduce_233),
+	(234 , happyReduce_234),
+	(235 , happyReduce_235),
+	(236 , happyReduce_236),
+	(237 , happyReduce_237),
+	(238 , happyReduce_238),
+	(239 , happyReduce_239),
+	(240 , happyReduce_240),
+	(241 , happyReduce_241),
+	(242 , happyReduce_242),
+	(243 , happyReduce_243),
+	(244 , happyReduce_244),
+	(245 , happyReduce_245),
+	(246 , happyReduce_246),
+	(247 , happyReduce_247),
+	(248 , happyReduce_248),
+	(249 , happyReduce_249),
+	(250 , happyReduce_250),
+	(251 , happyReduce_251),
+	(252 , happyReduce_252),
+	(253 , happyReduce_253),
+	(254 , happyReduce_254),
+	(255 , happyReduce_255),
+	(256 , happyReduce_256),
+	(257 , happyReduce_257),
+	(258 , happyReduce_258),
+	(259 , happyReduce_259),
+	(260 , happyReduce_260),
+	(261 , happyReduce_261),
+	(262 , happyReduce_262),
+	(263 , happyReduce_263),
+	(264 , happyReduce_264),
+	(265 , happyReduce_265),
+	(266 , happyReduce_266),
+	(267 , happyReduce_267),
+	(268 , happyReduce_268),
+	(269 , happyReduce_269),
+	(270 , happyReduce_270)
+	]
+
+happy_n_terms = 64 :: Int
+happy_n_nonterms = 104 :: Int
+
+happyReduce_1 = happyReduce 4# 0# happyReduction_1
+happyReduction_1 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut99 happy_x_2 of { happy_var_2 -> 
+	case happyOut5 happy_x_4 of { happy_var_4 -> 
+	happyIn4
+		 (mkModule happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_2 = happyReduce 6# 1# happyReduction_2
+happyReduction_2 (happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut8 happy_x_3 of { happy_var_3 -> 
+	case happyOut10 happy_x_4 of { happy_var_4 -> 
+	case happyOut6 happy_x_6 of { happy_var_6 -> 
+	happyIn5
+		 ((reverse happy_var_3,reverse happy_var_4, happy_var_6)
+	) `HappyStk` happyRest}}}
+
+happyReduce_3 = happyReduce 5# 1# happyReduction_3
+happyReduction_3 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut8 happy_x_2 of { happy_var_2 -> 
+	case happyOut10 happy_x_3 of { happy_var_3 -> 
+	case happyOut6 happy_x_5 of { happy_var_5 -> 
+	happyIn5
+		 ((reverse happy_var_2, reverse happy_var_3, happy_var_5)
+	) `HappyStk` happyRest}}}
+
+happyReduce_4 = happySpecReduce_2  2# happyReduction_4
+happyReduction_4 happy_x_2
+	happy_x_1
+	 =  case happyOut7 happy_x_2 of { happy_var_2 -> 
+	happyIn6
+		 (happy_var_2
+	)}
+
+happyReduce_5 = happySpecReduce_0  2# happyReduction_5
+happyReduction_5  =  happyIn6
+		 ([]
+	)
+
+happyReduce_6 = happyReduce 4# 3# happyReduction_6
+happyReduction_6 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut10 happy_x_3 of { happy_var_3 -> 
+	happyIn7
+		 (reverse happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_7 = happySpecReduce_3  3# happyReduction_7
+happyReduction_7 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_2 of { happy_var_2 -> 
+	happyIn7
+		 (reverse happy_var_2
+	)}
+
+happyReduce_8 = happySpecReduce_3  4# happyReduction_8
+happyReduction_8 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> 
+	case happyOut9 happy_x_2 of { happy_var_2 -> 
+	happyIn8
+		 (happy_var_2 : happy_var_1
+	)}}
+
+happyReduce_9 = happySpecReduce_0  4# happyReduction_9
+happyReduction_9  =  happyIn8
+		 ([]
+	)
+
+happyReduce_10 = happySpecReduce_2  5# happyReduction_10
+happyReduction_10 happy_x_2
+	happy_x_1
+	 =  case happyOut99 happy_x_2 of { happy_var_2 -> 
+	happyIn9
+		 (Import True (modId happy_var_2)
+	)}
+
+happyReduce_11 = happySpecReduce_2  5# happyReduction_11
+happyReduction_11 happy_x_2
+	happy_x_1
+	 =  case happyOut99 happy_x_2 of { happy_var_2 -> 
+	happyIn9
+		 (Import False (modId happy_var_2)
+	)}
+
+happyReduce_12 = happySpecReduce_3  6# happyReduction_12
+happyReduction_12 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> 
+	case happyOut11 happy_x_3 of { happy_var_3 -> 
+	happyIn10
+		 (happy_var_3 ++ happy_var_1
+	)}}
+
+happyReduce_13 = happySpecReduce_1  6# happyReduction_13
+happyReduction_13 happy_x_1
+	 =  case happyOut11 happy_x_1 of { happy_var_1 -> 
+	happyIn10
+		 (happy_var_1
+	)}
+
+happyReduce_14 = happySpecReduce_3  7# happyReduction_14
+happyReduction_14 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut99 happy_x_1 of { happy_var_1 -> 
+	case happyOut46 happy_x_3 of { happy_var_3 -> 
+	happyIn11
+		 ([DKSig happy_var_1 happy_var_3]
+	)}}
+
+happyReduce_15 = happyReduce 5# 7# happyReduction_15
+happyReduction_15 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut99 happy_x_2 of { happy_var_2 -> 
+	case happyOut15 happy_x_3 of { happy_var_3 -> 
+	case happyOut37 happy_x_5 of { happy_var_5 -> 
+	happyIn11
+		 ([DType happy_var_2 (reverse happy_var_3) happy_var_5]
+	) `HappyStk` happyRest}}}
+
+happyReduce_16 = happyReduce 5# 7# happyReduction_16
+happyReduction_16 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut99 happy_x_2 of { happy_var_2 -> 
+	case happyOut15 happy_x_3 of { happy_var_3 -> 
+	case happyOut14 happy_x_4 of { happy_var_4 -> 
+	case happyOut20 happy_x_5 of { happy_var_5 -> 
+	happyIn11
+		 ([DData happy_var_2 (reverse happy_var_3) happy_var_4 happy_var_5]
+	) `HappyStk` happyRest}}}}
+
+happyReduce_17 = happyReduce 5# 7# happyReduction_17
+happyReduction_17 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut99 happy_x_2 of { happy_var_2 -> 
+	case happyOut15 happy_x_3 of { happy_var_3 -> 
+	case happyOut13 happy_x_4 of { happy_var_4 -> 
+	case happyOut22 happy_x_5 of { happy_var_5 -> 
+	happyIn11
+		 ([DRec False happy_var_2 (reverse happy_var_3) happy_var_4 happy_var_5]
+	) `HappyStk` happyRest}}}}
+
+happyReduce_18 = happyReduce 5# 7# happyReduction_18
+happyReduction_18 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut99 happy_x_2 of { happy_var_2 -> 
+	case happyOut15 happy_x_3 of { happy_var_3 -> 
+	case happyOut12 happy_x_4 of { happy_var_4 -> 
+	case happyOut22 happy_x_5 of { happy_var_5 -> 
+	happyIn11
+		 ([DRec True happy_var_2 (reverse happy_var_3) happy_var_4 happy_var_5]
+	) `HappyStk` happyRest}}}}
+
+happyReduce_19 = happyReduce 5# 7# happyReduction_19
+happyReduction_19 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut99 happy_x_2 of { happy_var_2 -> 
+	case happyOut15 happy_x_3 of { happy_var_3 -> 
+	case happyOut23 happy_x_5 of { happy_var_5 -> 
+	happyIn11
+		 ([DRec True happy_var_2 (reverse happy_var_3) [] happy_var_5]
+	) `HappyStk` happyRest}}}
+
+happyReduce_20 = happySpecReduce_2  7# happyReduction_20
+happyReduction_20 happy_x_2
+	happy_x_1
+	 =  case happyOut16 happy_x_2 of { happy_var_2 -> 
+	happyIn11
+		 ([DTClass happy_var_2]
+	)}
+
+happyReduce_21 = happyReduce 4# 7# happyReduction_21
+happyReduction_21 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut91 happy_x_2 of { happy_var_2 -> 
+	case happyOut37 happy_x_4 of { happy_var_4 -> 
+	happyIn11
+		 ([DPSig happy_var_2 happy_var_4]
+	) `HappyStk` happyRest}}
+
+happyReduce_22 = happyReduce 6# 7# happyReduction_22
+happyReduction_22 (happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut91 happy_x_2 of { happy_var_2 -> 
+	case happyOut37 happy_x_4 of { happy_var_4 -> 
+	case happyOut27 happy_x_6 of { happy_var_6 -> 
+	happyIn11
+		 ([DBind [BEqn (exp2lhs (EVar happy_var_2)) (RExp (EBStruct Nothing [] happy_var_6))], DPSig happy_var_2 happy_var_4]
+	) `HappyStk` happyRest}}}
+
+happyReduce_23 = happyReduce 5# 7# happyReduction_23
+happyReduction_23 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut91 happy_x_2 of { happy_var_2 -> 
+	case happyOut37 happy_x_4 of { happy_var_4 -> 
+	case happyOut34 happy_x_5 of { happy_var_5 -> 
+	happyIn11
+		 ([DBind [BEqn (exp2lhs (EVar happy_var_2)) happy_var_5], DPSig happy_var_2 happy_var_4]
+	) `HappyStk` happyRest}}}
+
+happyReduce_24 = happySpecReduce_2  7# happyReduction_24
+happyReduction_24 happy_x_2
+	happy_x_1
+	 =  case happyOut16 happy_x_2 of { happy_var_2 -> 
+	happyIn11
+		 ([DInstance happy_var_2]
+	)}
+
+happyReduce_25 = happySpecReduce_2  7# happyReduction_25
+happyReduction_25 happy_x_2
+	happy_x_1
+	 =  case happyOut17 happy_x_2 of { happy_var_2 -> 
+	happyIn11
+		 ([DDefault (reverse happy_var_2)]
+	)}
+
+happyReduce_26 = happySpecReduce_3  7# happyReduction_26
+happyReduction_26 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
+	case happyOut37 happy_x_3 of { happy_var_3 -> 
+	happyIn11
+		 ([DBind [BSig (reverse happy_var_1) happy_var_3]]
+	)}}
+
+happyReduce_27 = happySpecReduce_2  7# happyReduction_27
+happyReduction_27 happy_x_2
+	happy_x_1
+	 =  case happyOut33 happy_x_1 of { happy_var_1 -> 
+	case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn11
+		 ([DBind [BEqn happy_var_1 happy_var_2]]
+	)}}
+
+happyReduce_28 = happySpecReduce_2  8# happyReduction_28
+happyReduction_28 happy_x_2
+	happy_x_1
+	 =  case happyOut42 happy_x_2 of { happy_var_2 -> 
+	happyIn12
+		 (reverse happy_var_2
+	)}
+
+happyReduce_29 = happySpecReduce_2  8# happyReduction_29
+happyReduction_29 happy_x_2
+	happy_x_1
+	 =  case happyOut37 happy_x_2 of { happy_var_2 -> 
+	happyIn12
+		 ([happy_var_2]
+	)}
+
+happyReduce_30 = happySpecReduce_1  9# happyReduction_30
+happyReduction_30 happy_x_1
+	 =  case happyOut12 happy_x_1 of { happy_var_1 -> 
+	happyIn13
+		 (happy_var_1
+	)}
+
+happyReduce_31 = happySpecReduce_0  9# happyReduction_31
+happyReduction_31  =  happyIn13
+		 ([]
+	)
+
+happyReduce_32 = happySpecReduce_2  10# happyReduction_32
+happyReduction_32 happy_x_2
+	happy_x_1
+	 =  case happyOut42 happy_x_2 of { happy_var_2 -> 
+	happyIn14
+		 (reverse happy_var_2
+	)}
+
+happyReduce_33 = happySpecReduce_2  10# happyReduction_33
+happyReduction_33 happy_x_2
+	happy_x_1
+	 =  case happyOut37 happy_x_2 of { happy_var_2 -> 
+	happyIn14
+		 ([happy_var_2]
+	)}
+
+happyReduce_34 = happySpecReduce_0  10# happyReduction_34
+happyReduction_34  =  happyIn14
+		 ([]
+	)
+
+happyReduce_35 = happySpecReduce_2  11# happyReduction_35
+happyReduction_35 happy_x_2
+	happy_x_1
+	 =  case happyOut15 happy_x_1 of { happy_var_1 -> 
+	case happyOut98 happy_x_2 of { happy_var_2 -> 
+	happyIn15
+		 (happy_var_2 : happy_var_1
+	)}}
+
+happyReduce_36 = happySpecReduce_0  11# happyReduction_36
+happyReduction_36  =  happyIn15
+		 ([]
+	)
+
+happyReduce_37 = happySpecReduce_3  12# happyReduction_37
+happyReduction_37 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut16 happy_x_1 of { happy_var_1 -> 
+	case happyOut96 happy_x_3 of { happy_var_3 -> 
+	happyIn16
+		 (happy_var_3 : happy_var_1
+	)}}
+
+happyReduce_38 = happySpecReduce_1  12# happyReduction_38
+happyReduction_38 happy_x_1
+	 =  case happyOut96 happy_x_1 of { happy_var_1 -> 
+	happyIn16
+		 ([happy_var_1]
+	)}
+
+happyReduce_39 = happyReduce 4# 13# happyReduction_39
+happyReduction_39 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut18 happy_x_3 of { happy_var_3 -> 
+	happyIn17
+		 (happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_40 = happySpecReduce_3  13# happyReduction_40
+happyReduction_40 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut18 happy_x_2 of { happy_var_2 -> 
+	happyIn17
+		 (happy_var_2
+	)}
+
+happyReduce_41 = happySpecReduce_3  14# happyReduction_41
+happyReduction_41 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut18 happy_x_1 of { happy_var_1 -> 
+	case happyOut19 happy_x_3 of { happy_var_3 -> 
+	happyIn18
+		 (happy_var_3 : happy_var_1
+	)}}
+
+happyReduce_42 = happySpecReduce_1  14# happyReduction_42
+happyReduction_42 happy_x_1
+	 =  case happyOut19 happy_x_1 of { happy_var_1 -> 
+	happyIn18
+		 ([happy_var_1]
+	)}
+
+happyReduce_43 = happySpecReduce_3  15# happyReduction_43
+happyReduction_43 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut91 happy_x_1 of { happy_var_1 -> 
+	case happyOut91 happy_x_3 of { happy_var_3 -> 
+	happyIn19
+		 (Default True happy_var_1 happy_var_3
+	)}}
+
+happyReduce_44 = happySpecReduce_3  15# happyReduction_44
+happyReduction_44 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut91 happy_x_1 of { happy_var_1 -> 
+	case happyOut37 happy_x_3 of { happy_var_3 -> 
+	happyIn19
+		 (Derive happy_var_1 happy_var_3
+	)}}
+
+happyReduce_45 = happySpecReduce_2  16# happyReduction_45
+happyReduction_45 happy_x_2
+	happy_x_1
+	 =  case happyOut21 happy_x_2 of { happy_var_2 -> 
+	happyIn20
+		 (reverse happy_var_2
+	)}
+
+happyReduce_46 = happySpecReduce_0  16# happyReduction_46
+happyReduction_46  =  happyIn20
+		 ([]
+	)
+
+happyReduce_47 = happySpecReduce_3  17# happyReduction_47
+happyReduction_47 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut21 happy_x_1 of { happy_var_1 -> 
+	case happyOut37 happy_x_3 of { happy_var_3 -> 
+	happyIn21
+		 (type2cons happy_var_3 : happy_var_1
+	)}}
+
+happyReduce_48 = happySpecReduce_1  17# happyReduction_48
+happyReduction_48 happy_x_1
+	 =  case happyOut37 happy_x_1 of { happy_var_1 -> 
+	happyIn21
+		 ([type2cons happy_var_1]
+	)}
+
+happyReduce_49 = happySpecReduce_2  18# happyReduction_49
+happyReduction_49 happy_x_2
+	happy_x_1
+	 =  case happyOut23 happy_x_2 of { happy_var_2 -> 
+	happyIn22
+		 (happy_var_2
+	)}
+
+happyReduce_50 = happySpecReduce_0  18# happyReduction_50
+happyReduction_50  =  happyIn22
+		 ([]
+	)
+
+happyReduce_51 = happyReduce 4# 19# happyReduction_51
+happyReduction_51 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut24 happy_x_3 of { happy_var_3 -> 
+	happyIn23
+		 (reverse happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_52 = happySpecReduce_3  19# happyReduction_52
+happyReduction_52 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut24 happy_x_2 of { happy_var_2 -> 
+	happyIn23
+		 (reverse happy_var_2
+	)}
+
+happyReduce_53 = happySpecReduce_1  20# happyReduction_53
+happyReduction_53 happy_x_1
+	 =  case happyOut25 happy_x_1 of { happy_var_1 -> 
+	happyIn24
+		 (happy_var_1
+	)}
+
+happyReduce_54 = happySpecReduce_0  20# happyReduction_54
+happyReduction_54  =  happyIn24
+		 ([]
+	)
+
+happyReduce_55 = happySpecReduce_3  21# happyReduction_55
+happyReduction_55 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut25 happy_x_1 of { happy_var_1 -> 
+	case happyOut26 happy_x_3 of { happy_var_3 -> 
+	happyIn25
+		 (happy_var_3 : happy_var_1
+	)}}
+
+happyReduce_56 = happySpecReduce_1  21# happyReduction_56
+happyReduction_56 happy_x_1
+	 =  case happyOut26 happy_x_1 of { happy_var_1 -> 
+	happyIn25
+		 ([happy_var_1]
+	)}
+
+happyReduce_57 = happySpecReduce_3  22# happyReduction_57
+happyReduction_57 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
+	case happyOut37 happy_x_3 of { happy_var_3 -> 
+	happyIn26
+		 (Sig (reverse happy_var_1) happy_var_3
+	)}}
+
+happyReduce_58 = happyReduce 4# 23# happyReduction_58
+happyReduction_58 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut28 happy_x_3 of { happy_var_3 -> 
+	happyIn27
+		 (reverse happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_59 = happySpecReduce_3  23# happyReduction_59
+happyReduction_59 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut28 happy_x_2 of { happy_var_2 -> 
+	happyIn27
+		 (reverse happy_var_2
+	)}
+
+happyReduce_60 = happySpecReduce_3  24# happyReduction_60
+happyReduction_60 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut28 happy_x_1 of { happy_var_1 -> 
+	case happyOut29 happy_x_3 of { happy_var_3 -> 
+	happyIn28
+		 (happy_var_3 : happy_var_1
+	)}}
+
+happyReduce_61 = happySpecReduce_1  24# happyReduction_61
+happyReduction_61 happy_x_1
+	 =  case happyOut29 happy_x_1 of { happy_var_1 -> 
+	happyIn28
+		 ([happy_var_1]
+	)}
+
+happyReduce_62 = happySpecReduce_3  25# happyReduction_62
+happyReduction_62 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
+	case happyOut37 happy_x_3 of { happy_var_3 -> 
+	happyIn29
+		 (BSig (reverse happy_var_1) happy_var_3
+	)}}
+
+happyReduce_63 = happySpecReduce_2  25# happyReduction_63
+happyReduction_63 happy_x_2
+	happy_x_1
+	 =  case happyOut33 happy_x_1 of { happy_var_1 -> 
+	case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn29
+		 (BEqn happy_var_1 happy_var_2
+	)}}
+
+happyReduce_64 = happySpecReduce_3  26# happyReduction_64
+happyReduction_64 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut30 happy_x_1 of { happy_var_1 -> 
+	case happyOut31 happy_x_3 of { happy_var_3 -> 
+	happyIn30
+		 (happy_var_3 : happy_var_1
+	)}}
+
+happyReduce_65 = happySpecReduce_1  26# happyReduction_65
+happyReduction_65 happy_x_1
+	 =  case happyOut31 happy_x_1 of { happy_var_1 -> 
+	happyIn30
+		 ([happy_var_1]
+	)}
+
+happyReduce_66 = happySpecReduce_3  27# happyReduction_66
+happyReduction_66 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut91 happy_x_1 of { happy_var_1 -> 
+	case happyOut48 happy_x_3 of { happy_var_3 -> 
+	happyIn31
+		 (Field happy_var_1  happy_var_3
+	)}}
+
+happyReduce_67 = happySpecReduce_3  28# happyReduction_67
+happyReduction_67 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
+	case happyOut91 happy_x_3 of { happy_var_3 -> 
+	happyIn32
+		 (happy_var_3 : happy_var_1
+	)}}
+
+happyReduce_68 = happySpecReduce_1  28# happyReduction_68
+happyReduction_68 happy_x_1
+	 =  case happyOut91 happy_x_1 of { happy_var_1 -> 
+	happyIn32
+		 ([happy_var_1]
+	)}
+
+happyReduce_69 = happySpecReduce_1  29# happyReduction_69
+happyReduction_69 happy_x_1
+	 =  case happyOut83 happy_x_1 of { happy_var_1 -> 
+	happyIn33
+		 (exp2lhs happy_var_1
+	)}
+
+happyReduce_70 = happySpecReduce_2  30# happyReduction_70
+happyReduction_70 happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_2 of { happy_var_2 -> 
+	happyIn34
+		 (RExp happy_var_2
+	)}
+
+happyReduce_71 = happySpecReduce_1  30# happyReduction_71
+happyReduction_71 happy_x_1
+	 =  case happyOut35 happy_x_1 of { happy_var_1 -> 
+	happyIn34
+		 (RGrd (reverse happy_var_1)
+	)}
+
+happyReduce_72 = happySpecReduce_3  30# happyReduction_72
+happyReduction_72 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut34 happy_x_1 of { happy_var_1 -> 
+	case happyOut27 happy_x_3 of { happy_var_3 -> 
+	happyIn34
+		 (RWhere happy_var_1 happy_var_3
+	)}}
+
+happyReduce_73 = happySpecReduce_2  31# happyReduction_73
+happyReduction_73 happy_x_2
+	happy_x_1
+	 =  case happyOut35 happy_x_1 of { happy_var_1 -> 
+	case happyOut36 happy_x_2 of { happy_var_2 -> 
+	happyIn35
+		 (happy_var_2 : happy_var_1
+	)}}
+
+happyReduce_74 = happySpecReduce_1  31# happyReduction_74
+happyReduction_74 happy_x_1
+	 =  case happyOut36 happy_x_1 of { happy_var_1 -> 
+	happyIn35
+		 ([happy_var_1]
+	)}
+
+happyReduce_75 = happyReduce 4# 32# happyReduction_75
+happyReduction_75 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut64 happy_x_2 of { happy_var_2 -> 
+	case happyOut48 happy_x_4 of { happy_var_4 -> 
+	happyIn36
+		 (GExp (reverse happy_var_2) happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_76 = happySpecReduce_3  33# happyReduction_76
+happyReduction_76 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut38 happy_x_1 of { happy_var_1 -> 
+	case happyOut44 happy_x_3 of { happy_var_3 -> 
+	happyIn37
+		 (TQual happy_var_1 happy_var_3
+	)}}
+
+happyReduce_77 = happySpecReduce_1  33# happyReduction_77
+happyReduction_77 happy_x_1
+	 =  case happyOut38 happy_x_1 of { happy_var_1 -> 
+	happyIn37
+		 (happy_var_1
+	)}
+
+happyReduce_78 = happySpecReduce_1  34# happyReduction_78
+happyReduction_78 happy_x_1
+	 =  case happyOut39 happy_x_1 of { happy_var_1 -> 
+	happyIn38
+		 (tFun (reverse (tail happy_var_1)) (head happy_var_1)
+	)}
+
+happyReduce_79 = happySpecReduce_3  34# happyReduction_79
+happyReduction_79 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
+	case happyOut40 happy_x_3 of { happy_var_3 -> 
+	happyIn38
+		 (TSub happy_var_1 happy_var_3
+	)}}
+
+happyReduce_80 = happySpecReduce_3  35# happyReduction_80
+happyReduction_80 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut39 happy_x_1 of { happy_var_1 -> 
+	case happyOut40 happy_x_3 of { happy_var_3 -> 
+	happyIn39
+		 (happy_var_3 : happy_var_1
+	)}}
+
+happyReduce_81 = happySpecReduce_1  35# happyReduction_81
+happyReduction_81 happy_x_1
+	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
+	happyIn39
+		 ([happy_var_1]
+	)}
+
+happyReduce_82 = happySpecReduce_2  36# happyReduction_82
+happyReduction_82 happy_x_2
+	happy_x_1
+	 =  case happyOut40 happy_x_1 of { happy_var_1 -> 
+	case happyOut41 happy_x_2 of { happy_var_2 -> 
+	happyIn40
+		 (TAp happy_var_1 happy_var_2
+	)}}
+
+happyReduce_83 = happySpecReduce_1  36# happyReduction_83
+happyReduction_83 happy_x_1
+	 =  case happyOut41 happy_x_1 of { happy_var_1 -> 
+	happyIn40
+		 (happy_var_1
+	)}
+
+happyReduce_84 = happySpecReduce_1  37# happyReduction_84
+happyReduction_84 happy_x_1
+	 =  case happyOut92 happy_x_1 of { happy_var_1 -> 
+	happyIn41
+		 (TCon happy_var_1
+	)}
+
+happyReduce_85 = happySpecReduce_1  37# happyReduction_85
+happyReduction_85 happy_x_1
+	 =  case happyOut98 happy_x_1 of { happy_var_1 -> 
+	happyIn41
+		 (TVar happy_var_1
+	)}
+
+happyReduce_86 = happySpecReduce_1  37# happyReduction_86
+happyReduction_86 happy_x_1
+	 =  happyIn41
+		 (TWild
+	)
+
+happyReduce_87 = happySpecReduce_2  37# happyReduction_87
+happyReduction_87 happy_x_2
+	happy_x_1
+	 =  happyIn41
+		 (TCon (prim LIST)
+	)
+
+happyReduce_88 = happySpecReduce_3  37# happyReduction_88
+happyReduction_88 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut43 happy_x_2 of { happy_var_2 -> 
+	happyIn41
+		 (TCon (tuple (happy_var_2+1))
+	)}
+
+happyReduce_89 = happySpecReduce_2  37# happyReduction_89
+happyReduction_89 happy_x_2
+	happy_x_1
+	 =  happyIn41
+		 (TCon (prim UNITTYPE)
+	)
+
+happyReduce_90 = happySpecReduce_3  37# happyReduction_90
+happyReduction_90 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut37 happy_x_2 of { happy_var_2 -> 
+	happyIn41
+		 (happy_var_2
+	)}
+
+happyReduce_91 = happySpecReduce_3  37# happyReduction_91
+happyReduction_91 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut42 happy_x_2 of { happy_var_2 -> 
+	happyIn41
+		 (TTup (reverse happy_var_2)
+	)}
+
+happyReduce_92 = happySpecReduce_3  37# happyReduction_92
+happyReduction_92 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut37 happy_x_2 of { happy_var_2 -> 
+	happyIn41
+		 (TList happy_var_2
+	)}
+
+happyReduce_93 = happySpecReduce_3  38# happyReduction_93
+happyReduction_93 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut42 happy_x_1 of { happy_var_1 -> 
+	case happyOut38 happy_x_3 of { happy_var_3 -> 
+	happyIn42
+		 (happy_var_3 : happy_var_1
+	)}}
+
+happyReduce_94 = happySpecReduce_3  38# happyReduction_94
+happyReduction_94 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut38 happy_x_1 of { happy_var_1 -> 
+	case happyOut38 happy_x_3 of { happy_var_3 -> 
+	happyIn42
+		 ([happy_var_3, happy_var_1]
+	)}}
+
+happyReduce_95 = happySpecReduce_2  39# happyReduction_95
+happyReduction_95 happy_x_2
+	happy_x_1
+	 =  case happyOut43 happy_x_1 of { happy_var_1 -> 
+	happyIn43
+		 (happy_var_1 + 1
+	)}
+
+happyReduce_96 = happySpecReduce_1  39# happyReduction_96
+happyReduction_96 happy_x_1
+	 =  happyIn43
+		 (1
+	)
+
+happyReduce_97 = happySpecReduce_3  40# happyReduction_97
+happyReduction_97 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut44 happy_x_1 of { happy_var_1 -> 
+	case happyOut45 happy_x_3 of { happy_var_3 -> 
+	happyIn44
+		 (happy_var_3 : happy_var_1
+	)}}
+
+happyReduce_98 = happySpecReduce_1  40# happyReduction_98
+happyReduction_98 happy_x_1
+	 =  case happyOut45 happy_x_1 of { happy_var_1 -> 
+	happyIn44
+		 ([happy_var_1]
+	)}
+
+happyReduce_99 = happySpecReduce_1  41# happyReduction_99
+happyReduction_99 happy_x_1
+	 =  case happyOut38 happy_x_1 of { happy_var_1 -> 
+	happyIn45
+		 (PType happy_var_1
+	)}
+
+happyReduce_100 = happySpecReduce_3  41# happyReduction_100
+happyReduction_100 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut98 happy_x_1 of { happy_var_1 -> 
+	case happyOut46 happy_x_3 of { happy_var_3 -> 
+	happyIn45
+		 (PKind happy_var_1 happy_var_3
+	)}}
+
+happyReduce_101 = happySpecReduce_3  42# happyReduction_101
+happyReduction_101 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
+	case happyOut46 happy_x_3 of { happy_var_3 -> 
+	happyIn46
+		 (KFun happy_var_1 happy_var_3
+	)}}
+
+happyReduce_102 = happySpecReduce_1  42# happyReduction_102
+happyReduction_102 happy_x_1
+	 =  case happyOut47 happy_x_1 of { happy_var_1 -> 
+	happyIn46
+		 (happy_var_1
+	)}
+
+happyReduce_103 = happySpecReduce_1  43# happyReduction_103
+happyReduction_103 happy_x_1
+	 =  happyIn47
+		 (Star
+	)
+
+happyReduce_104 = happySpecReduce_1  43# happyReduction_104
+happyReduction_104 happy_x_1
+	 =  happyIn47
+		 (KWild
+	)
+
+happyReduce_105 = happySpecReduce_3  43# happyReduction_105
+happyReduction_105 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut46 happy_x_2 of { happy_var_2 -> 
+	happyIn47
+		 (happy_var_2
+	)}
+
+happyReduce_106 = happySpecReduce_3  44# happyReduction_106
+happyReduction_106 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> 
+	case happyOut40 happy_x_3 of { happy_var_3 -> 
+	happyIn48
+		 (ESig happy_var_1 happy_var_3
+	)}}
+
+happyReduce_107 = happySpecReduce_1  44# happyReduction_107
+happyReduction_107 happy_x_1
+	 =  case happyOut49 happy_x_1 of { happy_var_1 -> 
+	happyIn48
+		 (happy_var_1
+	)}
+
+happyReduce_108 = happySpecReduce_2  44# happyReduction_108
+happyReduction_108 happy_x_2
+	happy_x_1
+	 =  case happyOut27 happy_x_2 of { happy_var_2 -> 
+	happyIn48
+		 (EBStruct Nothing [] happy_var_2
+	)}
+
+happyReduce_109 = happySpecReduce_1  45# happyReduction_109
+happyReduction_109 happy_x_1
+	 =  case happyOut50 happy_x_1 of { happy_var_1 -> 
+	happyIn49
+		 (happy_var_1
+	)}
+
+happyReduce_110 = happySpecReduce_1  45# happyReduction_110
+happyReduction_110 happy_x_1
+	 =  case happyOut51 happy_x_1 of { happy_var_1 -> 
+	happyIn49
+		 (happy_var_1
+	)}
+
+happyReduce_111 = happySpecReduce_1  46# happyReduction_111
+happyReduction_111 happy_x_1
+	 =  case happyOut52 happy_x_1 of { happy_var_1 -> 
+	happyIn50
+		 (transFix happy_var_1
+	)}
+
+happyReduce_112 = happySpecReduce_1  46# happyReduction_112
+happyReduction_112 happy_x_1
+	 =  case happyOut54 happy_x_1 of { happy_var_1 -> 
+	happyIn50
+		 (happy_var_1
+	)}
+
+happyReduce_113 = happySpecReduce_1  47# happyReduction_113
+happyReduction_113 happy_x_1
+	 =  case happyOut53 happy_x_1 of { happy_var_1 -> 
+	happyIn51
+		 (transFix happy_var_1
+	)}
+
+happyReduce_114 = happySpecReduce_1  47# happyReduction_114
+happyReduction_114 happy_x_1
+	 =  case happyOut56 happy_x_1 of { happy_var_1 -> 
+	happyIn51
+		 (happy_var_1
+	)}
+
+happyReduce_115 = happyReduce 4# 48# happyReduction_115
+happyReduction_115 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut52 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut54 happy_x_4 of { happy_var_4 -> 
+	happyIn52
+		 (Cons happy_var_1 happy_var_2 (ENeg happy_var_4)
+	) `HappyStk` happyRest}}}
+
+happyReduce_116 = happySpecReduce_3  48# happyReduction_116
+happyReduction_116 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut52 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut54 happy_x_3 of { happy_var_3 -> 
+	happyIn52
+		 (Cons happy_var_1 happy_var_2 happy_var_3
+	)}}}
+
+happyReduce_117 = happySpecReduce_2  48# happyReduction_117
+happyReduction_117 happy_x_2
+	happy_x_1
+	 =  case happyOut54 happy_x_2 of { happy_var_2 -> 
+	happyIn52
+		 (Nil (ENeg happy_var_2)
+	)}
+
+happyReduce_118 = happyReduce 4# 48# happyReduction_118
+happyReduction_118 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut54 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut54 happy_x_4 of { happy_var_4 -> 
+	happyIn52
+		 (Cons (Nil happy_var_1) happy_var_2 (ENeg happy_var_4)
+	) `HappyStk` happyRest}}}
+
+happyReduce_119 = happySpecReduce_3  48# happyReduction_119
+happyReduction_119 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut54 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut54 happy_x_3 of { happy_var_3 -> 
+	happyIn52
+		 (Cons (Nil happy_var_1) happy_var_2 happy_var_3
+	)}}}
+
+happyReduce_120 = happyReduce 4# 49# happyReduction_120
+happyReduction_120 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut52 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut56 happy_x_4 of { happy_var_4 -> 
+	happyIn53
+		 (Cons happy_var_1 happy_var_2 (ENeg happy_var_4)
+	) `HappyStk` happyRest}}}
+
+happyReduce_121 = happySpecReduce_3  49# happyReduction_121
+happyReduction_121 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut52 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut56 happy_x_3 of { happy_var_3 -> 
+	happyIn53
+		 (Cons happy_var_1 happy_var_2 happy_var_3
+	)}}}
+
+happyReduce_122 = happySpecReduce_2  49# happyReduction_122
+happyReduction_122 happy_x_2
+	happy_x_1
+	 =  case happyOut56 happy_x_2 of { happy_var_2 -> 
+	happyIn53
+		 (Nil (ENeg happy_var_2)
+	)}
+
+happyReduce_123 = happyReduce 4# 49# happyReduction_123
+happyReduction_123 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut54 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut56 happy_x_4 of { happy_var_4 -> 
+	happyIn53
+		 (Cons (Nil happy_var_1) happy_var_2 (ENeg happy_var_4)
+	) `HappyStk` happyRest}}}
+
+happyReduce_124 = happySpecReduce_3  49# happyReduction_124
+happyReduction_124 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut54 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut56 happy_x_3 of { happy_var_3 -> 
+	happyIn53
+		 (Cons (Nil happy_var_1) happy_var_2 happy_var_3
+	)}}}
+
+happyReduce_125 = happyReduce 4# 50# happyReduction_125
+happyReduction_125 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut48 happy_x_2 of { happy_var_2 -> 
+	case happyOut66 happy_x_4 of { happy_var_4 -> 
+	happyIn54
+		 (ECase happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_126 = happyReduce 4# 50# happyReduction_126
+happyReduction_126 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut30 happy_x_3 of { happy_var_3 -> 
+	happyIn54
+		 (ERec Nothing (reverse happy_var_3)
+	) `HappyStk` happyRest}
+
+happyReduce_127 = happySpecReduce_3  50# happyReduction_127
+happyReduction_127 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  happyIn54
+		 (ERec Nothing []
+	)
+
+happyReduce_128 = happySpecReduce_1  50# happyReduction_128
+happyReduction_128 happy_x_1
+	 =  case happyOut55 happy_x_1 of { happy_var_1 -> 
+	happyIn54
+		 (happy_var_1
+	)}
+
+happyReduce_129 = happySpecReduce_3  51# happyReduction_129
+happyReduction_129 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut78 happy_x_3 of { happy_var_3 -> 
+	happyIn55
+		 (EDo Nothing Nothing happy_var_3
+	)}
+
+happyReduce_130 = happySpecReduce_3  51# happyReduction_130
+happyReduction_130 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut78 happy_x_3 of { happy_var_3 -> 
+	happyIn55
+		 (ETempl Nothing Nothing happy_var_3
+	)}
+
+happyReduce_131 = happySpecReduce_3  51# happyReduction_131
+happyReduction_131 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut78 happy_x_3 of { happy_var_3 -> 
+	happyIn55
+		 (EAct Nothing happy_var_3
+	)}
+
+happyReduce_132 = happySpecReduce_3  51# happyReduction_132
+happyReduction_132 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut78 happy_x_3 of { happy_var_3 -> 
+	happyIn55
+		 (EReq Nothing happy_var_3
+	)}
+
+happyReduce_133 = happyReduce 5# 51# happyReduction_133
+happyReduction_133 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut92 happy_x_1 of { happy_var_1 -> 
+	case happyOut30 happy_x_4 of { happy_var_4 -> 
+	happyIn55
+		 (ERec (Just (happy_var_1,True)) (reverse happy_var_4)
+	) `HappyStk` happyRest}}
+
+happyReduce_134 = happyReduce 6# 51# happyReduction_134
+happyReduction_134 (happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut92 happy_x_1 of { happy_var_1 -> 
+	case happyOut30 happy_x_4 of { happy_var_4 -> 
+	happyIn55
+		 (ERec (Just (happy_var_1,False)) (reverse happy_var_4)
+	) `HappyStk` happyRest}}
+
+happyReduce_135 = happyReduce 7# 51# happyReduction_135
+happyReduction_135 (happy_x_7 `HappyStk`
+	happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut92 happy_x_1 of { happy_var_1 -> 
+	case happyOut30 happy_x_4 of { happy_var_4 -> 
+	happyIn55
+		 (ERec (Just (happy_var_1,False)) (reverse happy_var_4)
+	) `HappyStk` happyRest}}
+
+happyReduce_136 = happyReduce 5# 51# happyReduction_136
+happyReduction_136 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut92 happy_x_1 of { happy_var_1 -> 
+	happyIn55
+		 (ERec (Just (happy_var_1,False)) []
+	) `HappyStk` happyRest}
+
+happyReduce_137 = happyReduce 4# 51# happyReduction_137
+happyReduction_137 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut92 happy_x_1 of { happy_var_1 -> 
+	happyIn55
+		 (ERec (Just (happy_var_1,True)) []
+	) `HappyStk` happyRest}
+
+happyReduce_138 = happySpecReduce_1  51# happyReduction_138
+happyReduction_138 happy_x_1
+	 =  case happyOut58 happy_x_1 of { happy_var_1 -> 
+	happyIn55
+		 (happy_var_1
+	)}
+
+happyReduce_139 = happyReduce 6# 52# happyReduction_139
+happyReduction_139 (happy_x_6 `HappyStk`
+	happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut48 happy_x_2 of { happy_var_2 -> 
+	case happyOut48 happy_x_4 of { happy_var_4 -> 
+	case happyOut48 happy_x_6 of { happy_var_6 -> 
+	happyIn56
+		 (EIf happy_var_2 happy_var_4 happy_var_6
+	) `HappyStk` happyRest}}}
+
+happyReduce_140 = happySpecReduce_1  52# happyReduction_140
+happyReduction_140 happy_x_1
+	 =  case happyOut57 happy_x_1 of { happy_var_1 -> 
+	happyIn56
+		 (happy_var_1
+	)}
+
+happyReduce_141 = happyReduce 4# 53# happyReduction_141
+happyReduction_141 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut89 happy_x_2 of { happy_var_2 -> 
+	case happyOut48 happy_x_4 of { happy_var_4 -> 
+	happyIn57
+		 (ELam (reverse happy_var_2) happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_142 = happyReduce 4# 53# happyReduction_142
+happyReduction_142 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut27 happy_x_2 of { happy_var_2 -> 
+	case happyOut48 happy_x_4 of { happy_var_4 -> 
+	happyIn57
+		 (ELet happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_143 = happySpecReduce_3  53# happyReduction_143
+happyReduction_143 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut59 happy_x_2 of { happy_var_2 -> 
+	case happyOut48 happy_x_3 of { happy_var_3 -> 
+	happyIn57
+		 (EAfter happy_var_2 happy_var_3
+	)}}
+
+happyReduce_144 = happySpecReduce_3  53# happyReduction_144
+happyReduction_144 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut59 happy_x_2 of { happy_var_2 -> 
+	case happyOut48 happy_x_3 of { happy_var_3 -> 
+	happyIn57
+		 (EBefore happy_var_2 happy_var_3
+	)}}
+
+happyReduce_145 = happySpecReduce_2  54# happyReduction_145
+happyReduction_145 happy_x_2
+	happy_x_1
+	 =  case happyOut58 happy_x_1 of { happy_var_1 -> 
+	case happyOut59 happy_x_2 of { happy_var_2 -> 
+	happyIn58
+		 (EAp happy_var_1 happy_var_2
+	)}}
+
+happyReduce_146 = happySpecReduce_1  54# happyReduction_146
+happyReduction_146 happy_x_1
+	 =  case happyOut59 happy_x_1 of { happy_var_1 -> 
+	happyIn58
+		 (happy_var_1
+	)}
+
+happyReduce_147 = happySpecReduce_3  55# happyReduction_147
+happyReduction_147 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut59 happy_x_1 of { happy_var_1 -> 
+	case happyOut91 happy_x_3 of { happy_var_3 -> 
+	happyIn59
+		 (ESelect happy_var_1 happy_var_3
+	)}}
+
+happyReduce_148 = happySpecReduce_1  55# happyReduction_148
+happyReduction_148 happy_x_1
+	 =  case happyOut60 happy_x_1 of { happy_var_1 -> 
+	happyIn59
+		 (happy_var_1
+	)}
+
+happyReduce_149 = happySpecReduce_1  56# happyReduction_149
+happyReduction_149 happy_x_1
+	 =  case happyOut91 happy_x_1 of { happy_var_1 -> 
+	happyIn60
+		 (EVar happy_var_1
+	)}
+
+happyReduce_150 = happySpecReduce_1  56# happyReduction_150
+happyReduction_150 happy_x_1
+	 =  happyIn60
+		 (EWild
+	)
+
+happyReduce_151 = happySpecReduce_1  56# happyReduction_151
+happyReduction_151 happy_x_1
+	 =  case happyOut92 happy_x_1 of { happy_var_1 -> 
+	happyIn60
+		 (ECon happy_var_1
+	)}
+
+happyReduce_152 = happySpecReduce_1  56# happyReduction_152
+happyReduction_152 happy_x_1
+	 =  case happyOut61 happy_x_1 of { happy_var_1 -> 
+	happyIn60
+		 (ELit happy_var_1
+	)}
+
+happyReduce_153 = happySpecReduce_2  56# happyReduction_153
+happyReduction_153 happy_x_2
+	happy_x_1
+	 =  happyIn60
+		 (ECon (prim UNITTERM)
+	)
+
+happyReduce_154 = happyReduce 4# 56# happyReduction_154
+happyReduction_154 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut91 happy_x_3 of { happy_var_3 -> 
+	happyIn60
+		 (ESel happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_155 = happySpecReduce_3  56# happyReduction_155
+happyReduction_155 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_2 of { happy_var_2 -> 
+	happyIn60
+		 (happy_var_2
+	)}
+
+happyReduce_156 = happySpecReduce_3  56# happyReduction_156
+happyReduction_156 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut63 happy_x_2 of { happy_var_2 -> 
+	happyIn60
+		 (ETup (reverse happy_var_2)
+	)}
+
+happyReduce_157 = happySpecReduce_3  56# happyReduction_157
+happyReduction_157 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut62 happy_x_2 of { happy_var_2 -> 
+	happyIn60
+		 (happy_var_2
+	)}
+
+happyReduce_158 = happyReduce 4# 56# happyReduction_158
+happyReduction_158 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut54 happy_x_2 of { happy_var_2 -> 
+	case happyOut95 happy_x_3 of { happy_var_3 -> 
+	happyIn60
+		 (ESectR happy_var_2 happy_var_3
+	) `HappyStk` happyRest}}
+
+happyReduce_159 = happyReduce 4# 56# happyReduction_159
+happyReduction_159 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut97 happy_x_2 of { happy_var_2 -> 
+	case happyOut58 happy_x_3 of { happy_var_3 -> 
+	happyIn60
+		 (ESectL happy_var_2 happy_var_3
+	) `HappyStk` happyRest}}
+
+happyReduce_160 = happySpecReduce_3  56# happyReduction_160
+happyReduction_160 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut43 happy_x_2 of { happy_var_2 -> 
+	happyIn60
+		 (ECon (tuple (happy_var_2+1))
+	)}
+
+happyReduce_161 = happySpecReduce_2  57# happyReduction_161
+happyReduction_161 happy_x_2
+	happy_x_1
+	 =  case happyOut107 happy_x_1 of { happy_var_1 -> 
+	case happyOutTok happy_x_2 of { (IntTok happy_var_2) -> 
+	happyIn61
+		 (LInt (Just happy_var_1) (readInteger happy_var_2)
+	)}}
+
+happyReduce_162 = happySpecReduce_2  57# happyReduction_162
+happyReduction_162 happy_x_2
+	happy_x_1
+	 =  case happyOut107 happy_x_1 of { happy_var_1 -> 
+	case happyOutTok happy_x_2 of { (FloatTok happy_var_2) -> 
+	happyIn61
+		 (LRat (Just happy_var_1) (readRational happy_var_2)
+	)}}
+
+happyReduce_163 = happySpecReduce_2  57# happyReduction_163
+happyReduction_163 happy_x_2
+	happy_x_1
+	 =  case happyOut107 happy_x_1 of { happy_var_1 -> 
+	case happyOutTok happy_x_2 of { (Character happy_var_2) -> 
+	happyIn61
+		 (LChr (Just happy_var_1) happy_var_2
+	)}}
+
+happyReduce_164 = happySpecReduce_2  57# happyReduction_164
+happyReduction_164 happy_x_2
+	happy_x_1
+	 =  case happyOut107 happy_x_1 of { happy_var_1 -> 
+	case happyOutTok happy_x_2 of { (StringTok happy_var_2) -> 
+	happyIn61
+		 (LStr (Just happy_var_1) happy_var_2
+	)}}
+
+happyReduce_165 = happySpecReduce_0  58# happyReduction_165
+happyReduction_165  =  happyIn62
+		 (EList []
+	)
+
+happyReduce_166 = happySpecReduce_1  58# happyReduction_166
+happyReduction_166 happy_x_1
+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> 
+	happyIn62
+		 (EList [happy_var_1]
+	)}
+
+happyReduce_167 = happySpecReduce_1  58# happyReduction_167
+happyReduction_167 happy_x_1
+	 =  case happyOut63 happy_x_1 of { happy_var_1 -> 
+	happyIn62
+		 (EList (reverse happy_var_1)
+	)}
+
+happyReduce_168 = happySpecReduce_3  58# happyReduction_168
+happyReduction_168 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> 
+	case happyOut48 happy_x_3 of { happy_var_3 -> 
+	happyIn62
+		 (ESeq happy_var_1 Nothing happy_var_3
+	)}}
+
+happyReduce_169 = happyReduce 5# 58# happyReduction_169
+happyReduction_169 (happy_x_5 `HappyStk`
+	happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut48 happy_x_1 of { happy_var_1 -> 
+	case happyOut48 happy_x_3 of { happy_var_3 -> 
+	case happyOut48 happy_x_5 of { happy_var_5 -> 
+	happyIn62
+		 (ESeq happy_var_1 (Just happy_var_3) happy_var_5
+	) `HappyStk` happyRest}}}
+
+happyReduce_170 = happySpecReduce_3  58# happyReduction_170
+happyReduction_170 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> 
+	case happyOut64 happy_x_3 of { happy_var_3 -> 
+	happyIn62
+		 (EComp happy_var_1 (reverse happy_var_3)
+	)}}
+
+happyReduce_171 = happySpecReduce_3  59# happyReduction_171
+happyReduction_171 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut63 happy_x_1 of { happy_var_1 -> 
+	case happyOut48 happy_x_3 of { happy_var_3 -> 
+	happyIn63
+		 (happy_var_3 : happy_var_1
+	)}}
+
+happyReduce_172 = happySpecReduce_3  59# happyReduction_172
+happyReduction_172 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_1 of { happy_var_1 -> 
+	case happyOut48 happy_x_3 of { happy_var_3 -> 
+	happyIn63
+		 ([happy_var_3,happy_var_1]
+	)}}
+
+happyReduce_173 = happySpecReduce_3  60# happyReduction_173
+happyReduction_173 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut64 happy_x_1 of { happy_var_1 -> 
+	case happyOut65 happy_x_3 of { happy_var_3 -> 
+	happyIn64
+		 (happy_var_3 : happy_var_1
+	)}}
+
+happyReduce_174 = happySpecReduce_1  60# happyReduction_174
+happyReduction_174 happy_x_1
+	 =  case happyOut65 happy_x_1 of { happy_var_1 -> 
+	happyIn64
+		 ([happy_var_1]
+	)}
+
+happyReduce_175 = happySpecReduce_3  61# happyReduction_175
+happyReduction_175 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut88 happy_x_1 of { happy_var_1 -> 
+	case happyOut83 happy_x_3 of { happy_var_3 -> 
+	happyIn65
+		 (QGen happy_var_1 happy_var_3
+	)}}
+
+happyReduce_176 = happySpecReduce_1  61# happyReduction_176
+happyReduction_176 happy_x_1
+	 =  case happyOut83 happy_x_1 of { happy_var_1 -> 
+	happyIn65
+		 (QExp happy_var_1
+	)}
+
+happyReduce_177 = happySpecReduce_2  61# happyReduction_177
+happyReduction_177 happy_x_2
+	happy_x_1
+	 =  case happyOut27 happy_x_2 of { happy_var_2 -> 
+	happyIn65
+		 (QLet happy_var_2
+	)}
+
+happyReduce_178 = happyReduce 4# 62# happyReduction_178
+happyReduction_178 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut67 happy_x_3 of { happy_var_3 -> 
+	happyIn66
+		 (reverse happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_179 = happySpecReduce_3  62# happyReduction_179
+happyReduction_179 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut67 happy_x_2 of { happy_var_2 -> 
+	happyIn66
+		 (reverse happy_var_2
+	)}
+
+happyReduce_180 = happySpecReduce_3  63# happyReduction_180
+happyReduction_180 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut67 happy_x_1 of { happy_var_1 -> 
+	case happyOut68 happy_x_3 of { happy_var_3 -> 
+	happyIn67
+		 (happy_var_3 : happy_var_1
+	)}}
+
+happyReduce_181 = happySpecReduce_1  63# happyReduction_181
+happyReduction_181 happy_x_1
+	 =  case happyOut68 happy_x_1 of { happy_var_1 -> 
+	happyIn67
+		 ([happy_var_1]
+	)}
+
+happyReduce_182 = happySpecReduce_2  64# happyReduction_182
+happyReduction_182 happy_x_2
+	happy_x_1
+	 =  case happyOut88 happy_x_1 of { happy_var_1 -> 
+	case happyOut69 happy_x_2 of { happy_var_2 -> 
+	happyIn68
+		 (Alt happy_var_1 happy_var_2
+	)}}
+
+happyReduce_183 = happySpecReduce_2  65# happyReduction_183
+happyReduction_183 happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_2 of { happy_var_2 -> 
+	happyIn69
+		 (RExp happy_var_2
+	)}
+
+happyReduce_184 = happySpecReduce_1  65# happyReduction_184
+happyReduction_184 happy_x_1
+	 =  case happyOut70 happy_x_1 of { happy_var_1 -> 
+	happyIn69
+		 (RGrd (reverse happy_var_1)
+	)}
+
+happyReduce_185 = happySpecReduce_3  65# happyReduction_185
+happyReduction_185 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut69 happy_x_1 of { happy_var_1 -> 
+	case happyOut27 happy_x_3 of { happy_var_3 -> 
+	happyIn69
+		 (RWhere happy_var_1 happy_var_3
+	)}}
+
+happyReduce_186 = happySpecReduce_2  66# happyReduction_186
+happyReduction_186 happy_x_2
+	happy_x_1
+	 =  case happyOut70 happy_x_1 of { happy_var_1 -> 
+	case happyOut71 happy_x_2 of { happy_var_2 -> 
+	happyIn70
+		 (happy_var_2 : happy_var_1
+	)}}
+
+happyReduce_187 = happySpecReduce_1  66# happyReduction_187
+happyReduction_187 happy_x_1
+	 =  case happyOut71 happy_x_1 of { happy_var_1 -> 
+	happyIn70
+		 ([happy_var_1]
+	)}
+
+happyReduce_188 = happyReduce 4# 67# happyReduction_188
+happyReduction_188 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut64 happy_x_2 of { happy_var_2 -> 
+	case happyOut48 happy_x_4 of { happy_var_4 -> 
+	happyIn71
+		 (GExp (reverse happy_var_2) happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_189 = happyReduce 4# 68# happyReduction_189
+happyReduction_189 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut73 happy_x_3 of { happy_var_3 -> 
+	happyIn72
+		 (reverse happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_190 = happySpecReduce_3  68# happyReduction_190
+happyReduction_190 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut73 happy_x_2 of { happy_var_2 -> 
+	happyIn72
+		 (reverse happy_var_2
+	)}
+
+happyReduce_191 = happySpecReduce_3  69# happyReduction_191
+happyReduction_191 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut73 happy_x_1 of { happy_var_1 -> 
+	case happyOut74 happy_x_3 of { happy_var_3 -> 
+	happyIn73
+		 (happy_var_3 : happy_var_1
+	)}}
+
+happyReduce_192 = happySpecReduce_1  69# happyReduction_192
+happyReduction_192 happy_x_1
+	 =  case happyOut74 happy_x_1 of { happy_var_1 -> 
+	happyIn73
+		 ([happy_var_1]
+	)}
+
+happyReduce_193 = happySpecReduce_2  70# happyReduction_193
+happyReduction_193 happy_x_2
+	happy_x_1
+	 =  case happyOut88 happy_x_1 of { happy_var_1 -> 
+	case happyOut75 happy_x_2 of { happy_var_2 -> 
+	happyIn74
+		 (Alt happy_var_1 happy_var_2
+	)}}
+
+happyReduce_194 = happySpecReduce_2  71# happyReduction_194
+happyReduction_194 happy_x_2
+	happy_x_1
+	 =  case happyOut78 happy_x_2 of { happy_var_2 -> 
+	happyIn75
+		 (RExp happy_var_2
+	)}
+
+happyReduce_195 = happySpecReduce_1  71# happyReduction_195
+happyReduction_195 happy_x_1
+	 =  case happyOut76 happy_x_1 of { happy_var_1 -> 
+	happyIn75
+		 (RGrd (reverse happy_var_1)
+	)}
+
+happyReduce_196 = happySpecReduce_3  71# happyReduction_196
+happyReduction_196 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut75 happy_x_1 of { happy_var_1 -> 
+	case happyOut27 happy_x_3 of { happy_var_3 -> 
+	happyIn75
+		 (RWhere happy_var_1 happy_var_3
+	)}}
+
+happyReduce_197 = happySpecReduce_2  72# happyReduction_197
+happyReduction_197 happy_x_2
+	happy_x_1
+	 =  case happyOut76 happy_x_1 of { happy_var_1 -> 
+	case happyOut77 happy_x_2 of { happy_var_2 -> 
+	happyIn76
+		 (happy_var_2 : happy_var_1
+	)}}
+
+happyReduce_198 = happySpecReduce_1  72# happyReduction_198
+happyReduction_198 happy_x_1
+	 =  case happyOut77 happy_x_1 of { happy_var_1 -> 
+	happyIn76
+		 ([happy_var_1]
+	)}
+
+happyReduce_199 = happyReduce 4# 73# happyReduction_199
+happyReduction_199 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut64 happy_x_2 of { happy_var_2 -> 
+	case happyOut78 happy_x_4 of { happy_var_4 -> 
+	happyIn77
+		 (GExp (reverse happy_var_2) happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_200 = happyReduce 4# 74# happyReduction_200
+happyReduction_200 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut79 happy_x_3 of { happy_var_3 -> 
+	happyIn78
+		 (reverse happy_var_3
+	) `HappyStk` happyRest}
+
+happyReduce_201 = happySpecReduce_3  74# happyReduction_201
+happyReduction_201 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut79 happy_x_2 of { happy_var_2 -> 
+	happyIn78
+		 (reverse happy_var_2
+	)}
+
+happyReduce_202 = happySpecReduce_1  75# happyReduction_202
+happyReduction_202 happy_x_1
+	 =  case happyOut80 happy_x_1 of { happy_var_1 -> 
+	happyIn79
+		 (happy_var_1
+	)}
+
+happyReduce_203 = happySpecReduce_0  75# happyReduction_203
+happyReduction_203  =  happyIn79
+		 ([]
+	)
+
+happyReduce_204 = happySpecReduce_3  76# happyReduction_204
+happyReduction_204 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut80 happy_x_1 of { happy_var_1 -> 
+	case happyOut81 happy_x_3 of { happy_var_3 -> 
+	happyIn80
+		 (happy_var_3 : happy_var_1
+	)}}
+
+happyReduce_205 = happySpecReduce_1  76# happyReduction_205
+happyReduction_205 happy_x_1
+	 =  case happyOut81 happy_x_1 of { happy_var_1 -> 
+	happyIn80
+		 ([happy_var_1]
+	)}
+
+happyReduce_206 = happySpecReduce_3  77# happyReduction_206
+happyReduction_206 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut88 happy_x_1 of { happy_var_1 -> 
+	case happyOut48 happy_x_3 of { happy_var_3 -> 
+	happyIn81
+		 (SGen happy_var_1 happy_var_3
+	)}}
+
+happyReduce_207 = happySpecReduce_1  77# happyReduction_207
+happyReduction_207 happy_x_1
+	 =  case happyOut82 happy_x_1 of { happy_var_1 -> 
+	happyIn81
+		 (SExp happy_var_1
+	)}
+
+happyReduce_208 = happySpecReduce_3  77# happyReduction_208
+happyReduction_208 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut32 happy_x_1 of { happy_var_1 -> 
+	case happyOut37 happy_x_3 of { happy_var_3 -> 
+	happyIn81
+		 (SBind [BSig happy_var_1 happy_var_3]
+	)}}
+
+happyReduce_209 = happySpecReduce_2  77# happyReduction_209
+happyReduction_209 happy_x_2
+	happy_x_1
+	 =  case happyOut33 happy_x_1 of { happy_var_1 -> 
+	case happyOut34 happy_x_2 of { happy_var_2 -> 
+	happyIn81
+		 (SBind [BEqn happy_var_1 happy_var_2]
+	)}}
+
+happyReduce_210 = happyReduce 4# 77# happyReduction_210
+happyReduction_210 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut33 happy_x_1 of { happy_var_1 -> 
+	case happyOut48 happy_x_4 of { happy_var_4 -> 
+	happyIn81
+		 (SBind [BEqn happy_var_1 (RExp (EAp (EVar (prim New)) happy_var_4))]
+	) `HappyStk` happyRest}}
+
+happyReduce_211 = happySpecReduce_3  77# happyReduction_211
+happyReduction_211 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut88 happy_x_1 of { happy_var_1 -> 
+	case happyOut48 happy_x_3 of { happy_var_3 -> 
+	happyIn81
+		 (SAss happy_var_1 happy_var_3
+	)}}
+
+happyReduce_212 = happySpecReduce_2  77# happyReduction_212
+happyReduction_212 happy_x_2
+	happy_x_1
+	 =  case happyOut48 happy_x_2 of { happy_var_2 -> 
+	happyIn81
+		 (SRet happy_var_2
+	)}
+
+happyReduce_213 = happyReduce 4# 77# happyReduction_213
+happyReduction_213 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut64 happy_x_2 of { happy_var_2 -> 
+	case happyOut78 happy_x_4 of { happy_var_4 -> 
+	happyIn81
+		 (SForall (reverse happy_var_2) happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_214 = happyReduce 4# 77# happyReduction_214
+happyReduction_214 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut48 happy_x_2 of { happy_var_2 -> 
+	case happyOut78 happy_x_4 of { happy_var_4 -> 
+	happyIn81
+		 (SIf happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_215 = happyReduce 4# 77# happyReduction_215
+happyReduction_215 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut48 happy_x_2 of { happy_var_2 -> 
+	case happyOut78 happy_x_4 of { happy_var_4 -> 
+	happyIn81
+		 (SElsif happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_216 = happySpecReduce_2  77# happyReduction_216
+happyReduction_216 happy_x_2
+	happy_x_1
+	 =  case happyOut78 happy_x_2 of { happy_var_2 -> 
+	happyIn81
+		 (SElse happy_var_2
+	)}
+
+happyReduce_217 = happyReduce 4# 77# happyReduction_217
+happyReduction_217 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut48 happy_x_2 of { happy_var_2 -> 
+	case happyOut78 happy_x_4 of { happy_var_4 -> 
+	happyIn81
+		 (SWhile happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_218 = happyReduce 4# 77# happyReduction_218
+happyReduction_218 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut48 happy_x_2 of { happy_var_2 -> 
+	case happyOut72 happy_x_4 of { happy_var_4 -> 
+	happyIn81
+		 (SCase happy_var_2 happy_var_4
+	) `HappyStk` happyRest}}
+
+happyReduce_219 = happySpecReduce_1  78# happyReduction_219
+happyReduction_219 happy_x_1
+	 =  case happyOut83 happy_x_1 of { happy_var_1 -> 
+	happyIn82
+		 (happy_var_1
+	)}
+
+happyReduce_220 = happySpecReduce_1  79# happyReduction_220
+happyReduction_220 happy_x_1
+	 =  case happyOut84 happy_x_1 of { happy_var_1 -> 
+	happyIn83
+		 (happy_var_1
+	)}
+
+happyReduce_221 = happySpecReduce_1  79# happyReduction_221
+happyReduction_221 happy_x_1
+	 =  case happyOut85 happy_x_1 of { happy_var_1 -> 
+	happyIn83
+		 (happy_var_1
+	)}
+
+happyReduce_222 = happySpecReduce_1  80# happyReduction_222
+happyReduction_222 happy_x_1
+	 =  case happyOut86 happy_x_1 of { happy_var_1 -> 
+	happyIn84
+		 (transFix happy_var_1
+	)}
+
+happyReduce_223 = happySpecReduce_1  80# happyReduction_223
+happyReduction_223 happy_x_1
+	 =  case happyOut55 happy_x_1 of { happy_var_1 -> 
+	happyIn84
+		 (happy_var_1
+	)}
+
+happyReduce_224 = happySpecReduce_1  81# happyReduction_224
+happyReduction_224 happy_x_1
+	 =  case happyOut87 happy_x_1 of { happy_var_1 -> 
+	happyIn85
+		 (transFix happy_var_1
+	)}
+
+happyReduce_225 = happySpecReduce_1  81# happyReduction_225
+happyReduction_225 happy_x_1
+	 =  case happyOut57 happy_x_1 of { happy_var_1 -> 
+	happyIn85
+		 (happy_var_1
+	)}
+
+happyReduce_226 = happyReduce 4# 82# happyReduction_226
+happyReduction_226 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut86 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut55 happy_x_4 of { happy_var_4 -> 
+	happyIn86
+		 (Cons happy_var_1 happy_var_2 (ENeg happy_var_4)
+	) `HappyStk` happyRest}}}
+
+happyReduce_227 = happySpecReduce_3  82# happyReduction_227
+happyReduction_227 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut86 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut55 happy_x_3 of { happy_var_3 -> 
+	happyIn86
+		 (Cons happy_var_1 happy_var_2 happy_var_3
+	)}}}
+
+happyReduce_228 = happySpecReduce_2  82# happyReduction_228
+happyReduction_228 happy_x_2
+	happy_x_1
+	 =  case happyOut55 happy_x_2 of { happy_var_2 -> 
+	happyIn86
+		 (Nil (ENeg happy_var_2)
+	)}
+
+happyReduce_229 = happyReduce 4# 82# happyReduction_229
+happyReduction_229 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut55 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut55 happy_x_4 of { happy_var_4 -> 
+	happyIn86
+		 (Cons (Nil happy_var_1) happy_var_2 (ENeg happy_var_4)
+	) `HappyStk` happyRest}}}
+
+happyReduce_230 = happySpecReduce_3  82# happyReduction_230
+happyReduction_230 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut55 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut55 happy_x_3 of { happy_var_3 -> 
+	happyIn86
+		 (Cons (Nil happy_var_1) happy_var_2 happy_var_3
+	)}}}
+
+happyReduce_231 = happyReduce 4# 83# happyReduction_231
+happyReduction_231 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut86 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut57 happy_x_4 of { happy_var_4 -> 
+	happyIn87
+		 (Cons happy_var_1 happy_var_2 (ENeg happy_var_4)
+	) `HappyStk` happyRest}}}
+
+happyReduce_232 = happySpecReduce_3  83# happyReduction_232
+happyReduction_232 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut86 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut57 happy_x_3 of { happy_var_3 -> 
+	happyIn87
+		 (Cons happy_var_1 happy_var_2 happy_var_3
+	)}}}
+
+happyReduce_233 = happySpecReduce_2  83# happyReduction_233
+happyReduction_233 happy_x_2
+	happy_x_1
+	 =  case happyOut57 happy_x_2 of { happy_var_2 -> 
+	happyIn87
+		 (Nil (ENeg happy_var_2)
+	)}
+
+happyReduce_234 = happyReduce 4# 83# happyReduction_234
+happyReduction_234 (happy_x_4 `HappyStk`
+	happy_x_3 `HappyStk`
+	happy_x_2 `HappyStk`
+	happy_x_1 `HappyStk`
+	happyRest)
+	 = case happyOut55 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut57 happy_x_4 of { happy_var_4 -> 
+	happyIn87
+		 (Cons (Nil happy_var_1) happy_var_2 (ENeg happy_var_4)
+	) `HappyStk` happyRest}}}
+
+happyReduce_235 = happySpecReduce_3  83# happyReduction_235
+happyReduction_235 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut55 happy_x_1 of { happy_var_1 -> 
+	case happyOut95 happy_x_2 of { happy_var_2 -> 
+	case happyOut57 happy_x_3 of { happy_var_3 -> 
+	happyIn87
+		 (Cons (Nil happy_var_1) happy_var_2 happy_var_3
+	)}}}
+
+happyReduce_236 = happySpecReduce_1  84# happyReduction_236
+happyReduction_236 happy_x_1
+	 =  case happyOut83 happy_x_1 of { happy_var_1 -> 
+	happyIn88
+		 (happy_var_1
+	)}
+
+happyReduce_237 = happySpecReduce_2  85# happyReduction_237
+happyReduction_237 happy_x_2
+	happy_x_1
+	 =  case happyOut89 happy_x_1 of { happy_var_1 -> 
+	case happyOut90 happy_x_2 of { happy_var_2 -> 
+	happyIn89
+		 (happy_var_2 : happy_var_1
+	)}}
+
+happyReduce_238 = happySpecReduce_1  85# happyReduction_238
+happyReduction_238 happy_x_1
+	 =  case happyOut90 happy_x_1 of { happy_var_1 -> 
+	happyIn89
+		 ([happy_var_1]
+	)}
+
+happyReduce_239 = happySpecReduce_1  86# happyReduction_239
+happyReduction_239 happy_x_1
+	 =  case happyOut59 happy_x_1 of { happy_var_1 -> 
+	happyIn90
+		 (happy_var_1
+	)}
+
+happyReduce_240 = happySpecReduce_1  87# happyReduction_240
+happyReduction_240 happy_x_1
+	 =  case happyOut98 happy_x_1 of { happy_var_1 -> 
+	happyIn91
+		 (happy_var_1
+	)}
+
+happyReduce_241 = happySpecReduce_3  87# happyReduction_241
+happyReduction_241 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut100 happy_x_2 of { happy_var_2 -> 
+	happyIn91
+		 (happy_var_2
+	)}
+
+happyReduce_242 = happySpecReduce_1  88# happyReduction_242
+happyReduction_242 happy_x_1
+	 =  case happyOut99 happy_x_1 of { happy_var_1 -> 
+	happyIn92
+		 (happy_var_1
+	)}
+
+happyReduce_243 = happySpecReduce_3  88# happyReduction_243
+happyReduction_243 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut101 happy_x_2 of { happy_var_2 -> 
+	happyIn92
+		 (happy_var_2
+	)}
+
+happyReduce_244 = happySpecReduce_1  89# happyReduction_244
+happyReduction_244 happy_x_1
+	 =  case happyOut100 happy_x_1 of { happy_var_1 -> 
+	happyIn93
+		 (happy_var_1
+	)}
+
+happyReduce_245 = happySpecReduce_3  89# happyReduction_245
+happyReduction_245 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut98 happy_x_2 of { happy_var_2 -> 
+	happyIn93
+		 (happy_var_2
+	)}
+
+happyReduce_246 = happySpecReduce_1  90# happyReduction_246
+happyReduction_246 happy_x_1
+	 =  case happyOut101 happy_x_1 of { happy_var_1 -> 
+	happyIn94
+		 (happy_var_1
+	)}
+
+happyReduce_247 = happySpecReduce_3  90# happyReduction_247
+happyReduction_247 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut99 happy_x_2 of { happy_var_2 -> 
+	happyIn94
+		 (happy_var_2
+	)}
+
+happyReduce_248 = happySpecReduce_1  91# happyReduction_248
+happyReduction_248 happy_x_1
+	 =  case happyOut93 happy_x_1 of { happy_var_1 -> 
+	happyIn95
+		 (happy_var_1
+	)}
+
+happyReduce_249 = happySpecReduce_1  91# happyReduction_249
+happyReduction_249 happy_x_1
+	 =  case happyOut94 happy_x_1 of { happy_var_1 -> 
+	happyIn95
+		 (happy_var_1
+	)}
+
+happyReduce_250 = happySpecReduce_1  92# happyReduction_250
+happyReduction_250 happy_x_1
+	 =  case happyOut98 happy_x_1 of { happy_var_1 -> 
+	happyIn96
+		 (happy_var_1
+	)}
+
+happyReduce_251 = happySpecReduce_1  92# happyReduction_251
+happyReduction_251 happy_x_1
+	 =  case happyOut99 happy_x_1 of { happy_var_1 -> 
+	happyIn96
+		 (happy_var_1
+	)}
+
+happyReduce_252 = happyMonadReduce 1# 93# happyReduction_252
+happyReduction_252 (happy_x_1 `HappyStk`
+	happyRest) tk
+	 = happyThen (case happyOut103 happy_x_1 of { happy_var_1 -> 
+	( do l <- getSrcLoc; return (name l happy_var_1))}
+	) (\r -> happyReturn (happyIn97 r))
+
+happyReduce_253 = happySpecReduce_3  93# happyReduction_253
+happyReduction_253 happy_x_3
+	happy_x_2
+	happy_x_1
+	 =  case happyOut98 happy_x_2 of { happy_var_2 -> 
+	happyIn97
+		 (happy_var_2
+	)}
+
+happyReduce_254 = happySpecReduce_1  93# happyReduction_254
+happyReduction_254 happy_x_1
+	 =  case happyOut94 happy_x_1 of { happy_var_1 -> 
+	happyIn97
+		 (happy_var_1
+	)}
+
+happyReduce_255 = happySpecReduce_2  94# happyReduction_255
+happyReduction_255 happy_x_2
+	happy_x_1
+	 =  case happyOut107 happy_x_1 of { happy_var_1 -> 
+	case happyOutTok happy_x_2 of { (VarId happy_var_2) -> 
+	happyIn98
+		 (name happy_var_1 happy_var_2
+	)}}
+
+happyReduce_256 = happySpecReduce_2  95# happyReduction_256
+happyReduction_256 happy_x_2
+	happy_x_1
+	 =  case happyOut107 happy_x_1 of { happy_var_1 -> 
+	case happyOutTok happy_x_2 of { (ConId happy_var_2) -> 
+	happyIn99
+		 (name happy_var_1 happy_var_2
+	)}}
+
+happyReduce_257 = happyMonadReduce 1# 96# happyReduction_257
+happyReduction_257 (happy_x_1 `HappyStk`
+	happyRest) tk
+	 = happyThen (case happyOut102 happy_x_1 of { happy_var_1 -> 
+	( do l <- getSrcLoc; return (name l happy_var_1))}
+	) (\r -> happyReturn (happyIn100 r))
+
+happyReduce_258 = happySpecReduce_2  97# happyReduction_258
+happyReduction_258 happy_x_2
+	happy_x_1
+	 =  case happyOut107 happy_x_1 of { happy_var_1 -> 
+	case happyOutTok happy_x_2 of { (ConSym happy_var_2) -> 
+	happyIn101
+		 (name happy_var_1 happy_var_2
+	)}}
+
+happyReduce_259 = happySpecReduce_1  98# happyReduction_259
+happyReduction_259 happy_x_1
+	 =  case happyOut103 happy_x_1 of { happy_var_1 -> 
+	happyIn102
+		 (happy_var_1
+	)}
+
+happyReduce_260 = happySpecReduce_1  98# happyReduction_260
+happyReduction_260 happy_x_1
+	 =  happyIn102
+		 (("","-")
+	)
+
+happyReduce_261 = happySpecReduce_1  99# happyReduction_261
+happyReduction_261 happy_x_1
+	 =  case happyOutTok happy_x_1 of { (VarSym happy_var_1) -> 
+	happyIn103
+		 (happy_var_1
+	)}
+
+happyReduce_262 = happySpecReduce_1  99# happyReduction_262
+happyReduction_262 happy_x_1
+	 =  happyIn103
+		 (("","<")
+	)
+
+happyReduce_263 = happySpecReduce_1  99# happyReduction_263
+happyReduction_263 happy_x_1
+	 =  happyIn103
+		 (("",">")
+	)
+
+happyReduce_264 = happySpecReduce_1  99# happyReduction_264
+happyReduction_264 happy_x_1
+	 =  happyIn103
+		 (("","*")
+	)
+
+happyReduce_265 = happySpecReduce_1  99# happyReduction_265
+happyReduction_265 happy_x_1
+	 =  happyIn103
+		 (("","\\\\")
+	)
+
+happyReduce_266 = happySpecReduce_1  100# happyReduction_266
+happyReduction_266 happy_x_1
+	 =  happyIn104
+		 (()
+	)
+
+happyReduce_267 = happyMonadReduce 1# 100# happyReduction_267
+happyReduction_267 (happy_x_1 `HappyStk`
+	happyRest) tk
+	 = happyThen (( popContext)
+	) (\r -> happyReturn (happyIn104 r))
+
+happyReduce_268 = happyMonadReduce 0# 101# happyReduction_268
+happyReduction_268 (happyRest) tk
+	 = happyThen (( pushContext NoLayout)
+	) (\r -> happyReturn (happyIn105 r))
+
+happyReduce_269 = happyMonadReduce 0# 102# happyReduction_269
+happyReduction_269 (happyRest) tk
+	 = happyThen (( do { (r,c) <- getSrcLoc ;
+                                                        pushContext (Layout c)
+                                                      })
+	) (\r -> happyReturn (happyIn106 r))
+
+happyReduce_270 = happyMonadReduce 0# 103# happyReduction_270
+happyReduction_270 (happyRest) tk
+	 = happyThen (( getSrcLoc)
+	) (\r -> happyReturn (happyIn107 r))
+
+happyNewToken action sts stk
+	= lexer(\tk -> 
+	let cont i = happyDoAction i tk action sts stk in
+	case tk of {
+	EOF -> happyDoAction 63# tk action sts stk;
+	VarId happy_dollar_dollar -> cont 1#;
+	ConId happy_dollar_dollar -> cont 2#;
+	VarSym ("","-") -> cont 3#;
+	VarSym ("","<") -> cont 4#;
+	VarSym ("",">") -> cont 5#;
+	VarSym ("","*") -> cont 6#;
+	VarSym happy_dollar_dollar -> cont 7#;
+	ConSym happy_dollar_dollar -> cont 8#;
+	IntTok happy_dollar_dollar -> cont 9#;
+	FloatTok happy_dollar_dollar -> cont 10#;
+	Character happy_dollar_dollar -> cont 11#;
+	StringTok happy_dollar_dollar -> cont 12#;
+	LeftParen -> cont 13#;
+	RightParen -> cont 14#;
+	SemiColon -> cont 15#;
+	LeftCurly -> cont 16#;
+	RightCurly -> cont 17#;
+	VRightCurly -> cont 18#;
+	LeftSquare -> cont 19#;
+	RightSquare -> cont 20#;
+	Comma -> cont 21#;
+	BackQuote -> cont 22#;
+	Wildcard -> cont 23#;
+	Dot -> cont 24#;
+	DotDot -> cont 25#;
+	DoubleColon -> cont 26#;
+	Assign -> cont 27#;
+	Equals -> cont 28#;
+	Backslash -> cont 29#;
+	Bar -> cont 30#;
+	LeftArrow -> cont 31#;
+	RightArrow -> cont 32#;
+	Backslash2 -> cont 33#;
+	KW_Action -> cont 34#;
+	KW_After -> cont 35#;
+	KW_Before -> cont 36#;
+	KW_Case -> cont 37#;
+	KW_Class -> cont 38#;
+	KW_Data -> cont 39#;
+	KW_Default -> cont 40#;
+	KW_Do -> cont 41#;
+	KW_Else -> cont 42#;
+	KW_Elsif -> cont 43#;
+	KW_Forall -> cont 44#;
+	KW_If -> cont 45#;
+	KW_Import -> cont 46#;
+	KW_Instance -> cont 47#;
+	KW_In -> cont 48#;
+	KW_Let -> cont 49#;
+	KW_Module -> cont 50#;
+	KW_New -> cont 51#;
+	KW_Of -> cont 52#;
+	KW_Private -> cont 53#;
+	KW_Request -> cont 54#;
+	KW_Result -> cont 55#;
+	KW_Struct -> cont 56#;
+	KW_Then -> cont 57#;
+	KW_Type -> cont 58#;
+	KW_Typeclass -> cont 59#;
+	KW_Use -> cont 60#;
+	KW_Where -> cont 61#;
+	KW_While -> cont 62#;
+	_ -> happyError' tk
+	})
+
+happyError_ tk = happyError' tk
+
+happyThen :: () => PM a -> (a -> PM b) -> PM b
+happyThen = (thenPM)
+happyReturn :: () => a -> PM a
+happyReturn = (returnPM)
+happyThen1 = happyThen
+happyReturn1 :: () => a -> PM a
+happyReturn1 = happyReturn
+happyError' :: () => (Token) -> PM a
+happyError' tk = (\token -> happyError) tk
+
+parse = happySomeParser where
+  happySomeParser = happyThen (happyParse 0#) (\x -> happyReturn (happyOut4 x))
+
+happySeq = happyDontSeq
+
+
+parser     :: String -> M s Module
+parser str = runPM2 parse str
+
+happyError = parseError "parse error"
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+{-# LINE 1 "<built-in>" #-}
+{-# LINE 1 "<command-line>" #-}
+{-# LINE 1 "templates/GenericTemplate.hs" #-}
+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp 
+
+{-# LINE 28 "templates/GenericTemplate.hs" #-}
+
+
+data Happy_IntList = HappyCons Int# Happy_IntList
+
+
+
+
+
+{-# LINE 49 "templates/GenericTemplate.hs" #-}
+
+{-# LINE 59 "templates/GenericTemplate.hs" #-}
+
+{-# LINE 68 "templates/GenericTemplate.hs" #-}
+
+infixr 9 `HappyStk`
+data HappyStk a = HappyStk a (HappyStk a)
+
+-----------------------------------------------------------------------------
+-- starting the parse
+
+happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll
+
+-----------------------------------------------------------------------------
+-- Accepting the parse
+
+-- If the current token is 0#, it means we've just accepted a partial
+-- parse (a %partial parser).  We must ignore the saved token on the top of
+-- the stack in this case.
+happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =
+	happyReturn1 ans
+happyAccept j tk st sts (HappyStk ans _) = 
+	(happyTcHack j (happyTcHack st)) (happyReturn1 ans)
+
+-----------------------------------------------------------------------------
+-- Arrays only: do the next action
+
+
+
+happyDoAction i tk st
+	= {- nothing -}
+
+
+	  case action of
+		0#		  -> {- nothing -}
+				     happyFail i tk st
+		-1# 	  -> {- nothing -}
+				     happyAccept i tk st
+		n | (n <# (0# :: Int#)) -> {- nothing -}
+
+				     (happyReduceArr ! rule) i tk st
+				     where rule = (I# ((negateInt# ((n +# (1# :: Int#))))))
+		n		  -> {- nothing -}
+
+
+				     happyShift new_state i tk st
+				     where new_state = (n -# (1# :: Int#))
+   where off    = indexShortOffAddr happyActOffsets st
+	 off_i  = (off +# i)
+	 check  = if (off_i >=# (0# :: Int#))
+			then (indexShortOffAddr happyCheck off_i ==#  i)
+			else False
+ 	 action | check     = indexShortOffAddr happyTable off_i
+		| otherwise = indexShortOffAddr happyDefActions st
+
+{-# LINE 127 "templates/GenericTemplate.hs" #-}
+
+
+indexShortOffAddr (HappyA# arr) off =
+#if __GLASGOW_HASKELL__ > 500
+	narrow16Int# i
+#elif __GLASGOW_HASKELL__ == 500
+	intToInt16# i
+#else
+	(i `iShiftL#` 16#) `iShiftRA#` 16#
+#endif
+  where
+#if __GLASGOW_HASKELL__ >= 503
+	i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)
+#else
+	i = word2Int# ((high `shiftL#` 8#) `or#` low)
+#endif
+	high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
+	low  = int2Word# (ord# (indexCharOffAddr# arr off'))
+	off' = off *# 2#
+
+
+
+
+
+data HappyAddr = HappyA# Addr#
+
+
+
+
+-----------------------------------------------------------------------------
+-- HappyState data type (not arrays)
+
+{-# LINE 170 "templates/GenericTemplate.hs" #-}
+
+-----------------------------------------------------------------------------
+-- Shifting a token
+
+happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =
+     let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in
+--     trace "shifting the error token" $
+     happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)
+
+happyShift new_state i tk st sts stk =
+     happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk)
+
+-- happyReduce is specialised for the common cases.
+
+happySpecReduce_0 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_0 nt fn j tk st@((action)) sts stk
+     = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)
+
+happySpecReduce_1 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')
+     = let r = fn v1 in
+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))
+
+happySpecReduce_2 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')
+     = let r = fn v1 v2 in
+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))
+
+happySpecReduce_3 i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')
+     = let r = fn v1 v2 v3 in
+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))
+
+happyReduce k i fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happyReduce k nt fn j tk st sts stk
+     = case happyDrop (k -# (1# :: Int#)) sts of
+	 sts1@((HappyCons (st1@(action)) (_))) ->
+        	let r = fn stk in  -- it doesn't hurt to always seq here...
+       		happyDoSeq r (happyGoto nt j tk st1 sts1 r)
+
+happyMonadReduce k nt fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happyMonadReduce k nt fn j tk st sts stk =
+        happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))
+       where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))
+             drop_stk = happyDropStk k stk
+
+happyMonad2Reduce k nt fn 0# tk st sts stk
+     = happyFail 0# tk st sts stk
+happyMonad2Reduce k nt fn j tk st sts stk =
+       happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))
+       where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))
+             drop_stk = happyDropStk k stk
+
+             off    = indexShortOffAddr happyGotoOffsets st1
+             off_i  = (off +# nt)
+             new_state = indexShortOffAddr happyTable off_i
+
+
+
+
+happyDrop 0# l = l
+happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t
+
+happyDropStk 0# l = l
+happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs
+
+-----------------------------------------------------------------------------
+-- Moving to a new state after a reduction
+
+
+happyGoto nt j tk st = 
+   {- nothing -}
+   happyDoAction j tk new_state
+   where off    = indexShortOffAddr happyGotoOffsets st
+	 off_i  = (off +# nt)
+ 	 new_state = indexShortOffAddr happyTable off_i
+
+
+
+
+-----------------------------------------------------------------------------
+-- Error recovery (0# is the error token)
+
+-- parse error if we are in recovery and we fail again
+happyFail  0# tk old_st _ stk =
+--	trace "failing" $ 
+    	happyError_ tk
+
+{-  We don't need state discarding for our restricted implementation of
+    "error".  In fact, it can cause some bogus parses, so I've disabled it
+    for now --SDM
+
+-- discard a state
+happyFail  0# tk old_st (HappyCons ((action)) (sts)) 
+						(saved_tok `HappyStk` _ `HappyStk` stk) =
+--	trace ("discarding state, depth " ++ show (length stk))  $
+	happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))
+-}
+
+-- Enter error recovery: generate an error token,
+--                       save the old token and carry on.
+happyFail  i tk (action) sts stk =
+--      trace "entering error recovery" $
+	happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk)
+
+-- Internal happy errors:
+
+notHappyAtAll = error "Internal Happy error\n"
+
+-----------------------------------------------------------------------------
+-- Hack to get the typechecker to accept our action functions
+
+
+happyTcHack :: Int# -> a -> a
+happyTcHack x y = y
+{-# INLINE happyTcHack #-}
+
+
+-----------------------------------------------------------------------------
+-- Seq-ing.  If the --strict flag is given, then Happy emits 
+--	happySeq = happyDoSeq
+-- otherwise it emits
+-- 	happySeq = happyDontSeq
+
+happyDoSeq, happyDontSeq :: a -> b -> b
+happyDoSeq   a b = a `seq` b
+happyDontSeq a b = b
+
+-----------------------------------------------------------------------------
+-- Don't inline any functions from the template.  GHC has a nasty habit
+-- of deciding to inline happyGoto everywhere, which increases the size of
+-- the generated parser quite a bit.
+
+
+{-# NOINLINE happyDoAction #-}
+{-# NOINLINE happyTable #-}
+{-# NOINLINE happyCheck #-}
+{-# NOINLINE happyActOffsets #-}
+{-# NOINLINE happyGotoOffsets #-}
+{-# NOINLINE happyDefActions #-}
+
+{-# NOINLINE happyShift #-}
+{-# NOINLINE happySpecReduce_0 #-}
+{-# NOINLINE happySpecReduce_1 #-}
+{-# NOINLINE happySpecReduce_2 #-}
+{-# NOINLINE happySpecReduce_3 #-}
+{-# NOINLINE happyReduce #-}
+{-# NOINLINE happyMonadReduce #-}
+{-# NOINLINE happyGoto #-}
+{-# NOINLINE happyFail #-}
+
+-- end of Happy Template.
diff --git a/examples/Counter.t b/examples/Counter.t
new file mode 100644
--- /dev/null
+++ b/examples/Counter.t
@@ -0,0 +1,18 @@
+module Counter where
+
+struct Counter where
+  incr  :: Action
+  decr  :: Action
+  value :: Request Int
+
+counter = class
+
+   n := 0
+
+   incr  = action n := n+1
+
+   decr  = action n := n-1
+   
+   value = request result n
+
+   result Counter{..}
diff --git a/examples/Echo.t b/examples/Echo.t
new file mode 100644
--- /dev/null
+++ b/examples/Echo.t
@@ -0,0 +1,13 @@
+module Echo where
+
+import POSIX
+
+root env = class
+
+   echo str = action
+      env.stdout.write str
+
+   result 
+      action 
+         env.stdin.installR echo
+
diff --git a/examples/Echo2.t b/examples/Echo2.t
new file mode 100644
--- /dev/null
+++ b/examples/Echo2.t
@@ -0,0 +1,22 @@
+module Echo2 where
+
+import POSIX
+
+root env = class
+
+   count := 1
+
+   prompt = do
+      env.stdout.write (show count++"> ")
+      count := count+1
+
+   echo str = action
+      env.stdout.write str
+      prompt
+
+   result 
+      action 
+         env.stdin.installR echo
+         env.stdout.write "Welcome to Echo2!\n"
+         prompt
+
diff --git a/examples/Echo3.t b/examples/Echo3.t
new file mode 100644
--- /dev/null
+++ b/examples/Echo3.t
@@ -0,0 +1,19 @@
+module Echo3 where
+
+import POSIX
+
+root env = class
+
+   current := "Hello!\n"
+
+   save str = action
+      current := str
+
+   tick = action
+      env.stdout.write current
+      after (sec 1) tick
+
+   result 
+      action 
+         env.stdin.installR save
+         tick
diff --git a/examples/EchoServer.t b/examples/EchoServer.t
new file mode 100644
--- /dev/null
+++ b/examples/EchoServer.t
@@ -0,0 +1,35 @@
+module EchoServer where
+
+import POSIX
+
+port = Port 12345
+
+root env = class
+
+    log str = action
+       env.stdout.write ('[':str ++ "]\n")
+
+    result action
+       env.inet.tcp.listen port (server log)
+
+server log sock = class
+
+   n := 1
+
+   p = show sock.remoteHost
+
+   echo str = action
+      sock.outFile.write (show n ++"> "++str)
+      n := n+1
+
+   close = request
+      log (p ++ " closing")
+      result ()
+
+   neterror str = log ("Neterror: "++str)
+
+   established = action
+      log ("Connected from " ++ p)
+      sock.inFile.installR echo
+
+   result Connection{..}
diff --git a/examples/EchoServer2.t b/examples/EchoServer2.t
new file mode 100644
--- /dev/null
+++ b/examples/EchoServer2.t
@@ -0,0 +1,49 @@
+module EchoServer2 where
+
+import POSIX
+import Counter
+
+port = Port 12345
+
+root env = class
+ 
+    clients = new counter
+
+    log str = action
+       env.stdout.write ('[':str ++ "]\n")
+
+    result action
+       case parse (env.argv!1) of
+         Right n -> env.inet.tcp.listen port (server n clients log)
+         _ -> env.stdout.write "usage: EchoServer n, where n is number of concurrent clients\n"
+              env.exit 1
+server :: Int -> Counter -> (String -> Action) -> Socket -> Class Connection
+server maxClients clients log sock = class
+
+   n := 1
+
+   p = show sock.remoteHost
+
+   echo str = action
+      sock.outFile.write (show n ++"> "++str)
+      n := n+1
+
+   close = request
+      clients.decr
+      log (p ++ " closing")
+      result ()
+
+   neterror str = log ("Neterror: "++str)
+
+   established = action
+      cl <- clients.value
+      if cl < maxClients then
+         clients.incr
+         log ("Connected from " ++ p)
+         sock.inFile.installR echo
+      else
+         sock.outFile.write "Server busy"
+         log ("Refused " ++ p)
+         sock.close
+
+   result Connection{..}
diff --git a/examples/Makefile b/examples/Makefile
new file mode 100644
--- /dev/null
+++ b/examples/Makefile
@@ -0,0 +1,14 @@
+LOCALCOMP = ../dist/build/timberc/timberc --datadir ..
+TIMBERC=timberc
+
+EXAMPLES = Echo Echo2 Echo3 EchoServer EchoServer2 MasterMind Primes Reflex TCPClient PingTimeServers
+
+examples: 
+	@for ex in $(EXAMPLES); do \
+		$(TIMBERC) --make  $$ex; \
+	done
+
+local:
+	@for ex in $(EXAMPLES); do \
+		$(LOCALCOMP) --make  $$ex; \
+	done
diff --git a/examples/MasterMind.t b/examples/MasterMind.t
new file mode 100644
--- /dev/null
+++ b/examples/MasterMind.t
@@ -0,0 +1,131 @@
+module MasterMind where
+
+import Data.Functional.List
+import RandomGenerator
+import POSIX
+
+{-
+Standard Mastermind, where the program does the guessing. Answers are given as two integers (separated by space(s)) on 
+one row, indicating number of bulls and cows. Command line argument acts as seed for random number generation.
+-}
+
+data Colour = Red | Blue | Green | Yellow | Black | White
+
+default eqColour :: Eq Colour
+        showColour :: Show Colour 
+        parseColour :: Parse Colour
+        eqAnswer :: Eq Answer
+
+type Guess = [Colour]
+
+data Answer = Answer Int Int
+
+instance showAnswer :: Show Answer where
+   show (Answer e n) = show e ++ " " ++ show n
+
+instance showGuess :: Show Guess where
+  show ss = unwords (map show ss)
+
+type Board = [(Guess,Answer)]
+
+allColours = [Red, Blue, Green, Yellow, Black, White]
+
+allCodes :: Int -> [Guess]
+allCodes 0 = [[]]
+allCodes n = concat [[c:cs | c <- allColours] | cs <- allCodes (n-1)]
+
+answer :: Guess -> Guess -> Answer
+answer guess code = Answer e n
+   where e = equals guess code
+
+         n  = sum [min (count c guess) (count c code) | c <- allColours] - e
+
+         count c xs = length [x | x <- xs, x==c]
+
+         equals [] [] = 0
+         equals (x:xs) (y:ys)
+           |x==y      = 1 + equals xs ys
+           |otherwise = equals xs ys
+
+
+contradictions :: Board -> Guess -> Board
+contradictions board c = [(g,r) | (g,r) <- board, answer g c /= r]
+
+consistent :: Board -> [Guess] -> [Guess]
+consistent board cs = [ c | c <- cs, null (contradictions board c)]
+
+data State = Idle | JustGuessed | GameOver | GetSecret
+           
+root env = class
+  
+  gen = new baseGen(microsecOf env.startTime)
+
+  board := []
+  cs := [] 
+  state := Idle
+
+  shift = do
+     r <- gen.next
+     n = r `mod` (length cs)
+     ys = take n cs
+     zs = drop n cs
+     cs := zs ++ ys
+  
+  startGame = do
+    board := []
+    cs := []
+    env.stdout.write "Choose your secret. Press return when ready.\n"
+    state := Idle
+
+  mkGuess = do
+     if null cs then
+        env.stdout.write "Contradictory answers!\n"
+        env.stdout.write "Tell me your secret: "
+        state := GetSecret
+     else
+        shift
+        env.stdout.write ("My guess: "++ show (head cs) ++"\n")
+        env.stdout.write "Answer (two integers): "
+        state := JustGuessed
+
+  checkQuit = do
+     env.stdout.write "Do you want to play again? (y/n) "
+     state := GameOver
+
+  inpHandler inp = action
+    case state of
+      Idle ->           cs := allCodes 4
+                        mkGuess
+
+      JustGuessed ->    case map parse (words inp)  of
+                          [Right e, Right n] ->
+                             if e == 4 then
+                                env.stdout.write "Yippee!\n"
+                                checkQuit 
+                             else
+                                c:cs' = cs
+                                board := (c,Answer e n) : board
+                                cs := consistent board cs'
+                                mkGuess
+                          _ -> env.stdout.write "Answer must be two integers separated by spaces; try again\n"
+      
+      GameOver ->       if head inp == 'y' then
+                           startGame
+                        else
+                           env.exit 0
+
+      GetSecret ->     case map parse (words inp) of
+                         es | length es==4 && all isRight es ->
+                           ss = map fromRight es
+                           (g',r'):_ = contradictions board ss
+                           env.stdout.write ("When I guessed "++show g'++ ", you answered " ++ show r'++".\n")
+                           env.stdout.write ("Correct answer should have been "++show (answer g' ss)++".\n")
+                           checkQuit
+                         _ -> env.stdout.write "Secret must be four colours separated by spaces; try again\n"
+
+  result 
+     action
+         env.stdin.installR inpHandler
+         env.stdout.write "Welcome to Mastermind!\n"
+         startGame
+
diff --git a/examples/PingTimeServers.t b/examples/PingTimeServers.t
new file mode 100644
--- /dev/null
+++ b/examples/PingTimeServers.t
@@ -0,0 +1,42 @@
+-- Possible call
+-- ./PingTimeServers time.nist.gov time-a.nist.gov time.ien.it
+-- NB: It is explicitly disallowed to ask a NIST time server for time 
+-- more frequently than once every 4 seconds.
+
+
+module PingTimeServers where
+
+import POSIX
+import Data.Functional.List
+
+port = Port 13  -- standard port for time servers
+
+client neterror report sock = class
+
+    established = action
+       sock.inFile.installR report
+
+    close = request result ()
+
+    result Connection {..}
+ 
+
+root env = class
+
+    args = [1..size env.argv-1] 
+    print i mess = env.stdout.write (env.argv!i ++ ": "++ mess ++ "\n")
+
+    outstanding := args
+
+    report i mess = action
+       outstanding := delete i outstanding
+       print i mess
+       if (null outstanding) then env.exit 0
+    
+    result action
+       forall i <- args do
+          env.inet.tcp.connect (Host (env.argv!i)) port (client (report i) (report i))
+       after (sec 2) action
+          forall i <- outstanding do 
+             print i "no response"
+          env.exit 0
diff --git a/examples/Primes.t b/examples/Primes.t
new file mode 100644
--- /dev/null
+++ b/examples/Primes.t
@@ -0,0 +1,40 @@
+module Primes where
+
+import POSIX 
+
+root env = class
+   limit :: Int
+   limit = fromRight (parse (env.argv!1))
+   primesBound = limit `div` log3 limit
+
+   primes := uniarray primesBound 0
+   count  := 0
+
+   isPrime k = loop 0
+      where loop n = do 
+              p = primes!n
+              if p*p > k then
+                 result True
+              elsif k `mod` p  == 0 then
+                 result False
+              else loop (n+1)
+
+   checkFrom k = do
+     p <- isPrime k
+     if p then 
+        primes!count := k
+        count := count + 1
+     if k < limit then checkFrom (k+1)
+
+   result action
+     primes!0 := 2
+     count := 1
+     checkFrom 3
+     env.stdout.write (show count++"\n")
+     env.exit 0
+
+
+log3 :: Int -> Int
+log3 n  
+  | n < 3       = 0
+  | otherwise   = 1 + log3 (n `div` 3)
diff --git a/examples/Reflex.t b/examples/Reflex.t
new file mode 100644
--- /dev/null
+++ b/examples/Reflex.t
@@ -0,0 +1,43 @@
+module Reflex where
+
+import POSIX
+import RandomGenerator
+
+data State = Idle | Waiting Msg | Counting
+
+root env = class
+  
+   print str = env.stdout.write (str ++ "\n")
+
+   tmr = new timer
+   gen = new baseGen (microsecOf env.startTime)
+
+   state := Idle
+  
+   enter _ = action
+      case state of
+        Idle ->         r <- gen.next
+                        waitingTime = sec 2 + millisec (r `mod` 2000)
+                        msg <- after waitingTime action
+                           tmr.reset
+                           print "Go!"
+                           state := Counting 
+                        print "Wait..."
+                        state := Waiting msg
+                 
+        Waiting msg ->  abort msg
+                        print "Cheat!!!"
+                        state := Idle
+
+        Counting ->     t <- tmr.sample
+                        print (format t)
+                        state := Idle
+
+   result 
+     action
+       env.stdin.installR enter
+       print "Press return to start"
+
+format t = show (secOf t) ++ '.' : fracs ++ " secs"
+  where t100  = microsecOf t `div` 10000
+        fracs = if t100<10 then '0':show t100 else show t100 
diff --git a/examples/TCPClient.t b/examples/TCPClient.t
new file mode 100644
--- /dev/null
+++ b/examples/TCPClient.t
@@ -0,0 +1,42 @@
+module TCPClient where
+
+  import POSIX
+
+  root env = class
+
+     result action
+        if size env.argv /= 3 then
+           env.stdout.write "Usage: TCPClient host port\n"
+           env.exit 0
+        host = Host (env.argv!1)
+        port = Port (fromRight (parse (env.argv!2)))
+        env.stdout.write "Connecting... "
+        env.inet.tcp.connect host port (handler env)
+
+private
+
+  handler env sock = class
+
+      rounds := 0 
+
+      neterror err = action 
+         env.stdout.write (err ++ "\n")
+         env.exit 0
+
+      close       = request 
+         env.stdout.write ("Server closing after "++show rounds++" rounds\n")
+         env.exit 0
+
+      receive str = action
+         env.stdout.write (str ++ "\n")
+         rounds := rounds + 1
+
+      echo str = action
+         sock.outFile.write (init str)
+       
+      established = action
+          env.stdout.write "Hello!\n"
+          env.stdin.installR echo
+          sock.inFile.installR receive
+
+      result Connection{..}
diff --git a/examples/UnionFind.t b/examples/UnionFind.t
new file mode 100644
--- /dev/null
+++ b/examples/UnionFind.t
@@ -0,0 +1,37 @@
+module UnionFind where
+
+struct EqRel where
+  equal   :: Int -> Int -> Request Bool
+  mkEqual :: Int -> Int -> Action
+
+unionFind :: Int -> Class EqRel
+unionFind n = class
+   a := uniarray n (-1)
+
+   find k = do 
+     if a!k < 0 then
+        result k
+     else
+        s <- find(a!k)
+        a!k := s
+        result s
+
+   equal i j = request
+     si <- find i
+     sj <- find j
+     result (si==sj)
+
+   mkEqual i j = action
+     si <- find i 
+     sj <- find j
+     if si/=sj then
+        asi = a!si
+        asj = a!sj
+        if asj < asi then
+           a!si := sj
+        else 
+           a!sj := si
+           if asi==asj then
+              a!si := asi-1
+
+   result EqRel{..}
diff --git a/include/arrays.c b/include/arrays.c
new file mode 100644
--- /dev/null
+++ b/include/arrays.c
@@ -0,0 +1,90 @@
+// The Timber compiler <timber-lang.org>
+// 
+// Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+// All rights reserved.
+// 
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions
+// are met:
+// 
+// 1. Redistributions of source code must retain the above copyright
+//    notice, this list of conditions and the following disclaimer.
+// 
+// 2. Redistributions in binary form must reproduce the above copyright
+//    notice, this list of conditions and the following disclaimer in the
+//    documentation and/or other materials provided with the distribution.
+// 
+// 3. Neither the names of the copyright holder and any identified
+//    contributors, nor the names of their affiliations, may be used to 
+//    endorse or promote products derived from this software without 
+//    specific prior written permission.
+// 
+// THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+// OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+// DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+// ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+// OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+// HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+// STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+// ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+// POSSIBILITY OF SUCH DAMAGE.
+
+// Array primitives
+
+#include "timber.h"
+
+Array primListArray(BITS32 polytag, LIST xs) {
+        Int len = 0;
+        Int i = 0;
+        LIST ys = xs;
+        while ((Int)ys) {len++; ys = ((CONS)ys)->b;}; // not nice to compute the length here ...
+        Array res; NEW(Array,res,WORDS(sizeof(struct Array))+len);
+        res->GCINFO = (polytag ? __GC__Array1 : __GC__Array0);
+        res->size = len;
+        ys = xs;
+        while((Int)ys) {res->elems[i] = ((CONS)ys)->a; ys = ((CONS)ys)->b; i++;}
+        return res;
+}
+
+Array primUniArray(BITS32 polytag, Int len, POLY a) {
+        Int i;
+        Array res; NEW(Array,res,WORDS(sizeof(struct Array))+len);
+        res->GCINFO = (polytag ? __GC__Array1 : __GC__Array0);
+        res->size = len;
+        for(i=0; i<len; i++) res->elems[i] = a;
+        return res;
+}
+
+Array EmptyArray(BITS32 polytag, Int len) {
+        Array res; NEW(Array,res,WORDS(sizeof(struct Array))+len);
+        res->GCINFO = (polytag ? __GC__Array1 : __GC__Array0);
+        res->size = len;
+        return res;
+}
+
+Array CloneArray(BITS32 polytag, Array a, Int lev) {
+        if (!lev)
+                return a;
+        Int i; 
+        Array res; NEW(Array,res,WORDS(sizeof(struct Array))+a->size);
+        res->size = a->size;
+        lev--;
+        if (lev) {
+                res->GCINFO = __GC__Array0;
+                for (i=0; i < a->size; i++) 
+                        res->elems[i] = (ADDR)CloneArray(polytag, (Array)a->elems[i], lev);
+        } else {
+                res->GCINFO = (polytag ? __GC__Array1 : __GC__Array0);
+                for (i=0; i < a->size; i++) 
+                        res->elems[i] = a->elems[i];    
+        }
+        return res;
+}
+
+Array primUpdateArray(BITS32 polytag, Array a, Int i, POLY v) {
+        a = CloneArray(polytag, a, 1);
+        a->elems[i] = v;
+        return a;
+}
diff --git a/include/float.c b/include/float.c
new file mode 100644
--- /dev/null
+++ b/include/float.c
@@ -0,0 +1,53 @@
+// The Timber compiler <timber-lang.org>
+// 
+// Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+// All rights reserved.
+// 
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions
+// are met:
+// 
+// 1. Redistributions of source code must retain the above copyright
+//    notice, this list of conditions and the following disclaimer.
+// 
+// 2. Redistributions in binary form must reproduce the above copyright
+//    notice, this list of conditions and the following disclaimer in the
+//    documentation and/or other materials provided with the distribution.
+// 
+// 3. Neither the names of the copyright holder and any identified
+//    contributors, nor the names of their affiliations, may be used to 
+//    endorse or promote products derived from this software without 
+//    specific prior written permission.
+// 
+// THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+// OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+// DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+// ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+// OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+// HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+// STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+// ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+// POSSIBILITY OF SUCH DAMAGE.
+
+#include "timber.h"
+
+struct DummyStruct {
+  WORD *GCINFO;
+  Int n;
+};
+
+typedef struct DummyStruct *DummyStruct;
+
+static WORD __GC__DummyStruct[] = {WORDS(sizeof(struct DummyStruct)+20), GC_STD, 0};
+
+LIST primShowFloat(Float x) {
+  DummyStruct p;
+  NEW(DummyStruct,p,sizeof(struct DummyStruct)+20);
+  p->GCINFO = __GC__DummyStruct;
+  snprintf((char*)&p->n,20,"%e",x);
+  LIST res = getStr((char*)&p->n);
+  return res;
+}
+ 
diff --git a/include/timber.c b/include/timber.c
new file mode 100644
--- /dev/null
+++ b/include/timber.c
@@ -0,0 +1,162 @@
+// The Timber compiler <timber-lang.org>
+// 
+// Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+// All rights reserved.
+// 
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions
+// are met:
+// 
+// 1. Redistributions of source code must retain the above copyright
+//    notice, this list of conditions and the following disclaimer.
+// 
+// 2. Redistributions in binary form must reproduce the above copyright
+//    notice, this list of conditions and the following disclaimer in the
+//    documentation and/or other materials provided with the distribution.
+// 
+// 3. Neither the names of the copyright holder and any identified
+//    contributors, nor the names of their affiliations, may be used to 
+//    endorse or promote products derived from this software without 
+//    specific prior written permission.
+// 
+// THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+// OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+// DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+// ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+// OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+// HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+// STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+// ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+// POSSIBILITY OF SUCH DAMAGE.
+
+#define HEAD(X)         WORDS(sizeof(struct X)), GC_STD
+#define OFF(X,Y)        WORDS(offsetof(struct X, Y))
+
+WORD __GC__TUP2[]       = 
+        {
+        HEAD(TUP2),      OFF(TUP2, a),  OFF(TUP2, b),   0,
+        HEAD(TUP2),                     OFF(TUP2, b),   0,0,
+        HEAD(TUP2),      OFF(TUP2, a),                  0,0,
+        HEAD(TUP2),                                     0,0,0
+        };
+                                                 
+WORD __GC__TUP3[]       = 
+        {
+        HEAD(TUP3),      OFF(TUP3, a),  OFF(TUP3, b),   OFF(TUP3, c),   0,
+        HEAD(TUP3),                     OFF(TUP3, b),   OFF(TUP3, c),   0,0,
+        HEAD(TUP3),      OFF(TUP3, a),                  OFF(TUP3, c),   0,0,
+        HEAD(TUP3),                                     OFF(TUP3, c),   0,0,0,
+        HEAD(TUP3),      OFF(TUP3, a),  OFF(TUP3, b),                   0,0,
+        HEAD(TUP3),                     OFF(TUP3, b),                   0,0,0,
+        HEAD(TUP3),      OFF(TUP3, a),                                  0,0,0,
+        HEAD(TUP3),                                                     0,0,0,0
+        };
+                                                 
+WORD __GC__TUP4[]       = 
+        {                        
+        HEAD(TUP4),      OFF(TUP4, a),  OFF(TUP4, b),   OFF(TUP4, c),   OFF(TUP4, d),   0,
+        HEAD(TUP4),                     OFF(TUP4, b),   OFF(TUP4, c),   OFF(TUP4, d),   0,0,
+        HEAD(TUP4),      OFF(TUP4, a),                  OFF(TUP4, c),   OFF(TUP4, d),   0,0,
+        HEAD(TUP4),                                     OFF(TUP4, c),   OFF(TUP4, d),   0,0,0,
+        HEAD(TUP4),      OFF(TUP4, a),  OFF(TUP4, b),                   OFF(TUP4, d),   0,0,
+        HEAD(TUP4),                     OFF(TUP4, b),                   OFF(TUP4, d),   0,0,0,
+        HEAD(TUP4),      OFF(TUP4, a),                                  OFF(TUP4, d),   0,0,0,
+        HEAD(TUP4),                                                     OFF(TUP4, d),   0,0,0,0,
+        HEAD(TUP4),      OFF(TUP4, a),  OFF(TUP4, b),   OFF(TUP4, c),                   0,0,
+        HEAD(TUP4),                     OFF(TUP4, b),   OFF(TUP4, c),                   0,0,0,
+        HEAD(TUP4),      OFF(TUP4, a),                  OFF(TUP4, c),                   0,0,0,
+        HEAD(TUP4),                                     OFF(TUP4, c),                   0,0,0,0,
+        HEAD(TUP4),      OFF(TUP4, a),  OFF(TUP4, b),                                   0,0,0,
+        HEAD(TUP4),                     OFF(TUP4, b),                                   0,0,0,0,
+        HEAD(TUP4),      OFF(TUP4, a),                                                  0,0,0,0,
+        HEAD(TUP4),                                                                     0,0,0,0,0
+        };
+
+WORD __GC__CONS[]       = {
+        HEAD(CONS),     OFF(CONS, a),   OFF(CONS, b),   0,
+        HEAD(CONS),                     OFF(CONS, b),   0,0
+        };
+
+WORD __GC__LEFT[]       = {
+        HEAD(LEFT),     OFF(LEFT, a),   0,
+        HEAD(LEFT),                     0,0
+        };
+
+WORD __GC__RIGHT[]      = {
+        HEAD(RIGHT),    OFF(RIGHT, a),  0,
+        HEAD(RIGHT),                    0,0
+        };
+
+WORD __GC__Timer[]      = {
+        HEAD(Timer),    0
+        };
+
+/*
+struct Msg {
+  Int (*Code)(Msg);
+  AbsTime baseline;
+  AbsTime deadline;
+  Msg next;
+};
+*/
+WORD __GC__Msg[]        = {WORDS(sizeof(struct Msg)), GC_STD, 0};       // sole pointer field "next" is custom handled by the gc
+
+WORD __GC__Ref[]        = {WORDS(sizeof(struct Ref)), GC_MUT, OFF(Ref,STATE), 0,
+                           WORDS(sizeof(struct Ref)), GC_MUT, 0,              0 };
+
+/*
+struct Array {
+  Int size;
+  POLY elems[];
+};
+*/
+WORD __GC__Array0[]     = {WORDS(sizeof(struct Array)), GC_ARRAY, 0};       // flag 0 => node contains all pointers
+
+WORD __GC__Array1[]     = {WORDS(sizeof(struct Array)), GC_ARRAY, 1};     // flag 1 => node contains all scalars
+
+
+POLY primRefl(BITS32 polytag, POLY in) {
+        return in;
+}
+
+// String marshalling ----------------------------------------------------------------------------------
+
+LIST getStr(char *p) {
+        if (!*p)
+                return (LIST)0;
+        CONS n0; NEW(CONS, n0, WORDS(sizeof(struct CONS)));
+        n0->GCINFO = __GC__CONS;
+        CONS n = n0;
+        n->a = (POLY)(Int)*p++;
+        while (*p) {
+	        NEW(LIST, n->b, WORDS(sizeof(struct CONS)));
+                n = (CONS)n->b;
+                n->GCINFO = __GC__CONS;
+                n->a = (POLY)(Int)*p++;
+        }
+        n->b = (LIST)0;
+        return (LIST)n0;
+}
+
+Int strEq (LIST s1, LIST s2) {
+  Char c1, c2;
+  while(1) {
+    switch ((Int)s1) {
+    case 0: 
+      return ((Int)s2==0);
+    default: 
+      switch ((Int)s2) {
+      case 0:
+	return 0;
+      default:
+	c1 = (Int)((CONS)s1)->a;
+	c2 = (Int)((CONS)s2)->a;
+        if (c1!=c2) return 0;
+	s1 = ((CONS)s1)->b;
+	s2 = ((CONS)s2)->b;
+      }
+    }
+  }
+}
diff --git a/include/timber.h b/include/timber.h
new file mode 100644
--- /dev/null
+++ b/include/timber.h
@@ -0,0 +1,173 @@
+// The Timber compiler <timber-lang.org>
+// 
+// Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+// All rights reserved.
+// 
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions
+// are met:
+// 
+// 1. Redistributions of source code must retain the above copyright
+//    notice, this list of conditions and the following disclaimer.
+// 
+// 2. Redistributions in binary form must reproduce the above copyright
+//    notice, this list of conditions and the following disclaimer in the
+//    documentation and/or other materials provided with the distribution.
+// 
+// 3. Neither the names of the copyright holder and any identified
+//    contributors, nor the names of their affiliations, may be used to 
+//    endorse or promote products derived from this software without 
+//    specific prior written permission.
+// 
+// THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+// OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+// DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+// ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+// OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+// HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+// STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+// ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+// POSSIBILITY OF SUCH DAMAGE.
+
+#ifndef TIMBER_H_
+#define TIMBER_H_
+#include <math.h>
+
+struct TUP2;
+typedef struct TUP2 *TUP2;
+struct TUP3;
+typedef struct TUP3 *TUP3;
+struct TUP4;
+typedef struct TUP4 *TUP4;
+struct LIST;
+typedef struct LIST *LIST;
+struct NIL;
+typedef struct NIL *NIL;
+struct CONS;
+typedef struct CONS *CONS;
+struct EITHER;
+typedef struct EITHER *EITHER;
+struct LEFT;
+typedef struct LEFT *LEFT;
+struct RIGHT;
+typedef struct RIGHT *RIGHT;
+
+struct Msg;
+typedef struct Msg *Msg;
+
+struct TUP2 {
+  WORD *GCINFO;
+  POLY a;
+  POLY b;
+};
+extern WORD __GC__TUP2[];
+
+struct TUP3 {
+  WORD *GCINFO;
+  POLY a;
+  POLY b;
+  POLY c;
+};
+extern WORD __GC__TUP3[];
+
+struct TUP4 {
+  WORD *GCINFO;
+  POLY a;
+  POLY b;
+  POLY c;
+  POLY d;
+};
+extern WORD __GC__TUP4[];
+
+struct LIST {
+    WORD *GCINFO;
+};
+
+struct CONS {
+  WORD *GCINFO;
+  POLY a;
+  LIST b;
+};
+extern WORD __GC__CONS[];
+
+struct EITHER {
+  WORD *GCINFO;
+  Int Tag;
+};
+
+extern WORD __GC__EITHER[];
+struct LEFT {
+  WORD *GCINFO;
+  Int Tag;
+  POLY a;
+};
+extern WORD __GC__LEFT[];
+
+struct RIGHT {
+  WORD *GCINFO;
+  Int Tag;
+  POLY a;
+};
+extern WORD __GC__RIGHT[];
+
+struct Msg {
+  WORD *GCINFO;
+  Int (*Code)(Msg);
+  AbsTime baseline;
+  AbsTime deadline;
+  Msg next;
+};
+extern WORD __GC__Msg[];
+
+struct Array {
+  WORD *GCINFO;
+  Int size;
+  POLY elems[];
+};
+extern WORD __GC__Array0[];
+extern WORD __GC__Array1[];
+
+
+typedef struct Array *Array;
+
+struct Timer;
+typedef struct Timer *TIMERTYPE;
+
+
+struct Timer {
+  WORD *GCINFO;
+  UNITTYPE (*reset) (TIMERTYPE, Int);
+  Time (*sample) (TIMERTYPE, Int);
+};
+
+extern WORD __GC__Timer[];
+
+
+UNITTYPE ASYNC(Msg, Time, Time);
+PID      LOCK(PID);
+UNITTYPE UNLOCK(PID);
+void     RAISE(Int);
+
+POLY     Raise(BITS32, Int);
+
+Array primListArray(BITS32,LIST);
+Array primUniArray(BITS32,Int,POLY);
+Array EmptyArray(BITS32,Int);
+Array CloneArray(BITS32,Array,Int);
+Array primUpdateArray(BITS32,Array,Int,POLY);
+
+Array CYCLIC_BEGIN(Int, Int);
+void  CYCLIC_UPDATE(Array, Int, ADDR stop);
+void  CYCLIC_END(Array, ADDR stop);
+
+POLY primRefl(BITS32,POLY);
+
+TIMERTYPE primTIMERTERM(Int x);
+UNITTYPE ABORT(BITS32,Msg msg,Ref x);
+
+LIST primShowFloat(Float x);
+LIST getStr(char *p) ;
+Int strEq (LIST s1, LIST s2) ;
+#endif
diff --git a/lib/BitOps.t b/lib/BitOps.t
new file mode 100644
--- /dev/null
+++ b/lib/BitOps.t
@@ -0,0 +1,174 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module BitOps where
+
+
+instance intBITS32 :: IntLiteral BITS32 where
+    fromInt = primIntToBITS32
+
+instance intBITS16 :: IntLiteral BITS16 where
+    fromInt = primIntToBITS16
+
+instance intBITS8 :: IntLiteral BITS8 where
+    fromInt = primIntToBITS8
+
+    
+default intInt < intBITS8
+default intInt < intBITS16
+default intInt < intBITS32
+
+typeclass ToInt a where
+    toInt :: a -> Int
+
+instance fromBITS32 :: ToInt BITS32 where
+    toInt = primBITS32ToInt
+
+instance fromBITS16 :: ToInt BITS16 where
+    toInt = primBITS16ToInt
+
+instance fromBITS8 :: ToInt BITS8 where
+    toInt = primBITS8ToInt
+    
+
+typeclass BitsOp a where
+    band :: a -> a -> a        
+    bor  :: a -> a -> a        
+    bxor :: a -> a -> a        
+    binv :: a -> a             
+    bsll :: a -> Int -> a      
+    bsrl :: a -> Int -> a      
+    bsra :: a -> Int -> a      
+    bset :: a -> Int -> a      
+    bclr :: a -> Int -> a      
+    btst :: a -> Int -> Bool   
+
+a .&. b  = band a b
+a .|. b  = bor  a b
+a .^. b  = bxor a b  
+a .<<. b = bsll a b   
+a .>>. b = bsrl a b 
+a .|=. b = bset a b   
+a .!=. b = bclr a b  
+a .?. b  = btst a b         
+
+instance bitsOpBits32 :: BitsOp BITS32 where
+    band   a b = primAND32 a b
+    bor    a b = primOR32  a b
+    bxor   a b = primEXOR32 a b
+    binv   a   = primNOT32 a
+    bsll   a i = primSHIFTL32 a i
+    bsrl   a i = primSHIFTR32 a i
+    bsra   a i = primSHIFTRA32 a i
+    bset   a i = primSET32 a i  
+    bclr   a i = primCLR32 a i
+    btst   a i = primTST32 a i
+
+instance bitsOpBits16 :: BitsOp BITS16 where
+    band   a b = primAND16 a b
+    bor    a b = primOR16  a b
+    bxor   a b = primEXOR16 a b
+    binv   a   = primNOT16 a
+    bsll   a i = primSHIFTL16 a i
+    bsrl   a i = primSHIFTR16 a i
+    bsra   a i = primSHIFTRA16 a i
+    bset   a i = primSET16 a i  
+    bclr   a i = primCLR16 a i
+    btst   a i = primTST16 a i
+
+instance bitsOpBits8 :: BitsOp BITS8 where
+    band   a b = primAND8 a b
+    bor    a b = primOR8  a b
+    bxor   a b = primEXOR8 a b
+    binv   a   = primNOT8 a
+    bsll   a i = primSHIFTL8 a i
+    bsrl   a i = primSHIFTR8 a i
+    bsra   a i = primSHIFTRA8 a i
+    bset   a i = primSET8 a i  
+    bclr   a i = primCLR8 a i
+    btst   a i = primTST8 a i
+
+                
+instance eqBits32 :: Eq BITS32 where
+    a == b = primBITS32ToInt a == primBITS32ToInt b
+    a /= b = primBITS32ToInt a /= primBITS32ToInt b
+
+instance eqBits16 :: Eq BITS16 where
+    a == b = primBITS16ToInt a == primBITS16ToInt b
+    a /= b = primBITS16ToInt a /= primBITS16ToInt b
+
+instance eqBits8 :: Eq BITS8 where
+    a == b = primBITS8ToInt a == primBITS8ToInt b
+    a /= b = primBITS8ToInt a /= primBITS8ToInt b
+
+
+showbits :: a -> Int -> String \\ BitsOp a
+
+showbits a 0 = ""
+showbits a n = if btst a n1 then '1' : str else '0' : str
+  where n1  = n-1
+        str = showbits a n1
+                    
+instance showBits32 :: Show BITS32 where 
+    show a = "0b" ++ showbits a 32
+
+instance showBits16 :: Show BITS16 where 
+    show a = "0b" ++ showbits a 16
+
+instance showBits8 :: Show BITS8 where 
+    show a = "0b" ++ showbits a 8
+
+
+hex a = if (a <= 9) then 
+            (chr (a + (ord '0'))) 
+        else
+            (chr ((a -10) + (ord 'A'))) 
+
+    
+showh :: BITS32 -> Int -> String    
+showh a 0 = ""
+showh a n = ( hex (toInt((a `bsrl` (4 * n1)) `band` 0xF)) ) : str 
+    where n1 = n - 1
+          str = showh a n1
+
+typeclass ShowHex a where
+    showhex :: a -> String
+
+instance showHBits32 :: ShowHex BITS32 where 
+    showhex a = "0x" ++ showh a 8
+
+instance showHBits16 :: ShowHex BITS16 where 
+    showhex a = "0x" ++ showh (fromInt(toInt a)) 4
+
+instance showHBits8 :: ShowHex BITS8 where 
+    showhex a = "0x" ++ showh (fromInt(toInt a)) 2
diff --git a/lib/Data.Functional.List.t b/lib/Data.Functional.List.t
new file mode 100644
--- /dev/null
+++ b/lib/Data.Functional.List.t
@@ -0,0 +1,117 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module List where
+
+delete             :: a -> [a] -> [a] \\ Eq 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
+
+
+(\\)               :: [a] -> [a] -> [a] \\ Eq a
+(\\)                = foldl (flip delete)
+
+elemBy, notElemBy  :: (a -> a -> Bool) -> a -> [a] -> Bool
+elemBy eq _ []      = False
+elemBy eq x (y:ys)  = x `eq` y || elemBy eq x ys
+
+notElemBy eq x xs   = not (elemBy eq x xs)
+
+lookupBy           :: (a -> a -> Bool) -> a -> [(a, b)] -> Maybe b
+lookupBy eq key []  = Nothing
+lookupBy eq key ((x,y):xys)
+    | key `eq` x    = Just y
+    | otherwise     = lookupBy eq key xys
+
+partition          :: (a -> Bool) -> [a] -> ([a],[a])
+partition p         = foldr select ([],[])
+		      where select x (ts,fs) | p x       = (x:ts,fs)
+		  			     | otherwise = (ts,x:fs)
+
+nub                :: [a] -> [a] \\ Eq a
+nub                 = nubBy (==)
+
+nubBy              :: (a -> a -> Bool) -> [a] -> [a]
+nubBy eq []         = []
+nubBy eq (x:xs)     = x : nubBy eq (filter (\y -> not (eq x y)) xs)
+
+sort               :: [a] -> [a] \\ Ord a
+sort []             = []
+sort (x : xs)       = sort small ++ x : sort big
+  where (small,big) = partition (\y -> y <= x) xs
+
+span, break         :: (a -> Bool) -> [a] -> ([a],[a])
+span p []            = ([],[])
+span p (x:xs)
+         | p x       = let (ys,zs) = span p xs in (x:ys,zs)
+         | otherwise = ([],x:xs)
+
+break p              = span (\x -> not (p x))
+
+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 isSpace s of
+                        [] -> []
+                        s' -> w : words s''
+                           where (w,s'') = acc s' []
+                                 acc [] w = (reverse w,[])
+                                 acc (c:cs) w
+                                  |isSpace c = (reverse w,cs)
+                                  |otherwise = acc cs (c:w) 
+                         
+isSpace c           = elem c " \t\n"
+
+unlines             :: [String] -> String
+unlines ls          = concat (map (\l -> l ++ "\n") ls)
+
+unwords             :: [String] -> String
+unwords []          = []
+unwords ws          = foldr1 (\w s -> w ++ ' ':s) ws
+
+foldr1 f [x]        = x
+foldr1 f (x:xs)     = f x (foldr1 f xs)
+
+sum                 :: [a] -> a \\ IntLiteral a, Num a
+sum                 = foldl (+) 0
+
+null []             = True
+null _              = False
diff --git a/lib/Data.Objects.Dictionary.t b/lib/Data.Objects.Dictionary.t
new file mode 100644
--- /dev/null
+++ b/lib/Data.Objects.Dictionary.t
@@ -0,0 +1,104 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Dictionary where
+
+  struct Dictionary a b where
+    insert :: a -> b -> Request ()
+    lookup :: a -> Request (Maybe b)
+
+  listDict :: Class (Dictionary a b) \\ Eq a
+  listDict = class
+    dict := []
+  
+    insert a b = request
+      dict := insL a b dict
+
+    lookup a = request
+      result Prelude.lookup a dict
+
+    result Dictionary {..}
+
+
+  treeDict :: Class (Dictionary a b) \\ Ord a
+  treeDict = class
+    dict := Nil
+    
+    insert a b = request
+      dict := insT a b dict
+
+    lookup a = request
+      result look a dict
+
+    result Dictionary {..}
+
+
+  hashDict :: (a -> Int -> Int) -> Class (Dictionary a b) ->
+              Int -> Class (Dictionary a b)
+  hashDict hash dictC n = class
+
+     ds = new seqC dictC n
+     dict = array ds
+  
+     insert a b = (dict!(hash a n)).insert a b
+
+     lookup a = (dict!(hash a n)).lookup a
+   
+     result Dictionary {..}
+
+private
+  
+  insL a b []            = [(a,b)]
+  insL a b ((x,y) : xs) 
+           | a == x      = (a,b) : xs
+           | otherwise   = (x,y) : insL a b xs
+
+  data Tree a = Nil | Node (Tree a) a (Tree a)
+
+  insT a b Nil                 = Node Nil (a,b) Nil
+  insT a b (Node l (x,y) r)  
+         | a == x              = Node l (a,b) r
+         | a < x               = Node (insT a b l) (x,y) r
+         | a > x               = Node l (x,y) (insT a b r)
+
+  look a Nil                   = Nothing
+  look a (Node l (x,y) r)     
+          | a == x             = Just y
+          | a < x              = look a l
+          | a > x              = look a r
+
+  seqC c 0       = class result []
+  seqC c n       = class
+                     x  = new c
+                     xs = new seqC c (n-1)
+                     result (x:xs)
diff --git a/lib/Data.Objects.Stack.t b/lib/Data.Objects.Stack.t
new file mode 100644
--- /dev/null
+++ b/lib/Data.Objects.Stack.t
@@ -0,0 +1,58 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Stack where
+
+struct Stack a where 
+  push :: a -> Action
+  pop  :: Action
+  top  :: Request a
+  size :: Request Int
+
+stk = class
+   xs := []
+   
+   push x = action
+     xs := x : xs
+
+   pop = action
+     xs := tail xs
+ 
+   top = request
+     result (head xs)
+
+   size = request
+     result (length xs)
+
+   result Stack{..}
+
diff --git a/lib/POSIX.t b/lib/POSIX.t
new file mode 100644
--- /dev/null
+++ b/lib/POSIX.t
@@ -0,0 +1,86 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module POSIX where
+    
+type RootType = Env -> Class Prog
+
+type Prog = Action
+
+struct Env where
+    exit      :: Int -> Request ()
+    argv      :: Array String
+    stdin     :: RFile
+    stdout    :: WFile
+    openR     :: String -> Request (Maybe RFile)
+    openW     :: String -> Request (Maybe WFile)
+    startTime :: Time
+    inet      :: Internet
+
+struct Closable where
+    close :: Request ()
+
+struct File < Closable where
+    seek  :: Int -> Request Int
+    
+struct RFile < File where
+    read     :: Request String
+    installR :: (String -> Action) -> Request ()
+    
+struct WFile < File where
+    write    :: String -> Request Int
+    installW :: Action -> Request ()
+
+data Host = Host String
+data Port = Port Int
+
+struct Internet where
+    tcp :: Sockets
+
+struct Socket < Closable where
+    remoteHost :: Host
+    remotePort :: Port
+    inFile     :: RFile
+    outFile    :: WFile
+
+struct Connection < Closable where 
+    established :: Action
+    neterror    :: String -> Action
+
+struct Sockets where
+    connect :: Host -> Port -> (Socket -> Class Connection) -> Request ()
+    listen  :: Port -> (Socket -> Class Connection) -> Request Closable
+
+instance showHost :: Show Host
+showHost = struct
+    show (Host nm) = nm
diff --git a/lib/Prelude.t b/lib/Prelude.t
new file mode 100644
--- /dev/null
+++ b/lib/Prelude.t
@@ -0,0 +1,553 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Prelude where
+
+-- IntLiteral ----------------------------------------------
+
+typeclass IntLiteral a where
+ fromInt :: Int -> a
+
+instance intInt :: IntLiteral Int where
+  fromInt n = n
+  
+instance intFloat ::IntLiteral Float where
+  fromInt = primIntToFloat
+
+default intInt < intFloat
+
+-- Num ----------------------------------------------------- 
+
+typeclass Num a where
+ (+),(-),(*) :: a -> a -> a
+ negate :: a -> a
+
+instance numInt :: Num Int where
+  (+) = primIntPlus
+  (-) = primIntMinus
+  (*) = primIntTimes
+  negate = primIntNeg
+
+instance numFloat :: Num Float where
+  (+) = primFloatPlus
+  (-) = primFloatMinus
+  (*) = primFloatTimes
+  negate = primFloatNeg
+
+instance numTime :: Num Time where
+  (+) = primTimePlus
+  (-) = primTimeMinus
+  _ * _ = raise 1
+  negate _ = sec 0
+
+-- Eq ------------------------------------------------------
+
+typeclass Eq a where
+  (==),(/=) :: a -> a -> Bool
+
+instance eqInt :: Eq Int where
+  (==) = primIntEQ
+  (/=) = primIntNE
+
+instance eqFloat :: Eq Float where
+  (==) = primFloatEQ
+  (/=) = primFloatNE
+
+instance eqTime :: Eq Time where
+  (==) = primTimeEQ
+  (/=) = primTimeNE
+
+instance eqPID :: Eq PID where
+  (==) = primPidEQ
+  (/=) = primPidNE
+
+instance eqChar :: Eq Char where
+  a == b = ord a == ord b
+  a /= b = ord a /= ord b
+
+instance eqUnit :: Eq () where
+  _ == _ = True
+  _ /= _ = False
+
+instance eqList :: Eq [a] \\ Eq a where
+    [] == []              = True
+    a : as == b : bs  = a == b && as == bs
+    _ == _               = False
+    xs /= ys             = not ( xs == ys)
+
+instance eqEither :: Eq (Either a b) \\ Eq a, Eq b where
+  Left x  == Left y  = x == y
+  Right x == Right y = x == y
+  _       == _       = False
+  x       /= y       = not (x == y)
+
+instance eqPair :: Eq (a,b) \\ Eq a, Eq b where
+  (a,b) == (c,d) = a==c && b==d
+  x /= y = not (x==y)
+
+-- Ord -----------------------------------------------------
+
+typeclass Ord a < Eq a where
+  (<),(<=),(>),(>=) :: a -> a -> Bool
+
+instance ordInt :: Ord Int = Ord {..}
+  where Eq {..} = eqInt
+        (<)  = primIntLT
+        (<=) = primIntLE
+        (>)  = primIntGT
+        (>=) = primIntGE
+
+instance ordFloat :: Ord Float = Ord {..}
+  where Eq {..} = eqFloat
+        (<)  = primFloatLT
+        (<=) = primFloatLE
+        (>)  = primFloatGT
+        (>=) = primFloatGE
+
+instance ordChar :: Ord Char = struct
+        a <  b = ord a <  ord b
+        a <= b = ord a <= ord b
+        a >  b = ord a >  ord b
+        a >= b = ord a >= ord b
+        (==) = eqChar.(==)
+        (/=) = eqChar.(/=)
+
+instance ordTime :: Ord Time = Ord {..}
+  where Eq {..} = eqTime
+        (<)  = primTimeLT
+        (<=) = primTimeLE
+        (>)  = primTimeGT
+        (>=) = primTimeGE
+
+instance ordUnit :: Ord () = Ord{..}
+  where Eq{..} = eqUnit
+        _ < _  = False
+        _ <= _ = True
+        _ > _  = False
+        _ >= _ = True
+    
+-- Show ----------------------------------------------------
+     
+typeclass Show a where
+  show :: a -> String
+
+instance showInt :: Show Int where
+  show 0            = "0"
+  show n
+    |n < 0          = '-' : show (negate n)
+    | otherwise     = reverse (digs n)
+    where dig n     = chr (n + ord '0')
+          digs n
+           | n < 10    = [dig n]
+           | otherwise = dig (n `mod` 10) : digs (n `div` 10)
+ 
+instance showFloat :: Show Float where
+   show = primShowFloat
+
+instance showBool :: Show Bool where
+  show False = "False"
+  show True  = "True"
+
+instance showChar :: Show Char where
+  show c = [c]
+
+instance showMaybe :: Show (Maybe a) \\ Show a where
+  show Nothing      = "Nothing"
+  show (Just x)     = "Just (" ++ show x ++ ")"
+
+instance showString :: Show String where
+  show s = '"' : s ++ "\""
+
+instance showList :: Show [a] \\ Show a where
+  show [] = "[]"
+  show (x : xs) = '[' : show x ++ concat (map (\x -> ',' : show x) xs) ++ "]"
+
+instance showTuple :: Show (a,b) \\ Show a, Show b where
+  show (a,b) = "("++show a++","++show b++")"
+
+instance showUnit :: Show () where
+  show () = "()"
+
+-- Parse ---------------------------------------------------
+
+typeclass Parse a where
+  parse :: String -> Either String a
+
+instance parseInt :: Parse Int where
+  parse str = p (strip str)
+    where p('-':cs) = case q (strip (reverse cs)) of
+                        Left err -> Left err
+                        Right n -> Right (-n)
+          p cs = q (strip (reverse cs))
+          q cs
+            | all isDigit cs = Right (r cs)
+            | otherwise = Left "parseInt: no Parse"
+          r (c:cs) = ord c - ord '0' + 10*r cs
+          r [] = 0
+          strip cs = dropWhile (== ' ') cs
+          isDigit c = c >= '0' && c <= '9'
+
+-- Enum ----------------------------------------------------
+
+typeclass Enum a where
+  fromEnum :: a -> Int
+  toEnum :: Int -> a
+
+instance enumInt :: Enum Int where
+  fromEnum n = n
+  toEnum n = n
+
+instance enumChar :: Enum Char where
+   fromEnum = primCharToInt
+   toEnum = primIntToChar
+
+instance enumUnit :: Enum () where
+  fromEnum () = 0
+  toEnum 0 = ()
+
+instance enumEither :: Enum (Either () a) \\ Enum a where
+  fromEnum (Left ()) = 0
+  fromEnum (Right a) = 1 + fromEnum a
+  toEnum 0 = Left ()
+  toEnum n = Right (toEnum (n-1))
+
+-- Functor, Monad and friends ------------------------------
+
+typeclass Functor m where
+  ($^)   :: (a -> b) -> m a -> m b
+
+typeclass Applicative m < Functor m where
+  ($*)   :: m (a -> b) -> m a -> m b
+  return :: a -> m a
+
+typeclass Monad m < Applicative m where
+  (>>=)  :: m a -> (a -> m b) -> m b
+
+typeclass MPlus m where
+  mempty :: m a
+  mappend :: m a -> m a -> m a
+
+instance functorMaybe :: Functor Maybe where
+  f $^ Nothing = Nothing
+  f $^ Just a  = Just (f a)
+
+instance applicativeMaybe :: Applicative Maybe = Applicative {..}
+  where Functor {..} = functorMaybe
+        Just f $* Just a = Just (f a)
+        _      $* _      = Nothing
+
+instance monadMaybe :: Monad Maybe = Monad {..}
+  where Applicative {..} = applicativeMaybe
+        Just a  >>= f = f a
+        Nothing >>= _ = Nothing
+
+instance mPlusMaybe :: MPlus Maybe where
+  mempty = Nothing
+  Just a  `mappend` _ = Just a
+  Nothing `mappend` a = a
+
+instance functorArray :: Functor Array where
+  f $^ a = array [f (a!i) | i <- [0..size a-1]]
+
+
+(>>) :: m a -> m b -> m b \\ Monad m
+ma >> mb = ma >>= \_ -> mb
+
+join :: m (m a) -> m a \\ Monad m
+join m = m >>= id
+
+-- Prelude support for forall statement --------------------
+
+forallList f []       = do result ()
+forallList f (x : xs) = do f x
+                           forallList f xs
+
+forallSeq :: (a -> Cmd b c) -> a -> a -> Cmd b () \\ Enum a
+forallSeq f a b = fS (fromEnum a) (fromEnum b)
+  where fS ai bi
+         | ai>bi = do result ()
+         | otherwise = do f (toEnum ai)
+                          fS (ai+1) bi
+
+forallSeq1 :: (a -> Cmd b c) -> a -> a -> a -> Cmd b () \\ Enum a
+forallSeq1 f a b c = fE ai (bi-ai) ci
+  where ai = fromEnum a
+        bi = fromEnum b
+        ci = fromEnum c
+        fE ai bi ci 
+          | (if bi > 0 then ai > ci else ai < ci) = do result ()
+          | otherwise = do f (toEnum ai)
+                           fE (ai+bi) bi ci
+
+-- Prelude support for arithmetic sequences ----------------
+
+enumFromTo          :: a -> a -> [a] \\ Enum a
+enumFromTo a b      = map toEnum (fromToInt (fromEnum a) 1 (fromEnum b))
+
+enumFromThenTo a b c = map toEnum (fromToInt ai (bi-ai) ci)
+  where  ai = fromEnum a
+         bi = fromEnum b
+         ci = fromEnum c
+
+fromToInt :: Int -> Int -> Int -> [Int]
+fromToInt m s n
+       | s > 0     = up m n
+       | otherwise = down m n
+  where up m n
+         | m > n      = []
+         | otherwise  = m : up (m+s) n
+        down m n
+         | m < n      = []
+         | otherwise  = m : down (m+s) n
+
+-- Maybe ---------------------------------------------------
+
+data Maybe a = Just a | Nothing
+
+isNothing          :: Maybe a -> Bool
+isNothing Nothing   = True
+isNothing (Just _)  = False
+
+isJust              :: Maybe a -> Bool
+isJust Nothing      = False
+isJust (Just _)     = True
+
+-- Either --------------------------------------------------
+
+isLeft (Left _)     = True
+isLeft _            = False
+
+isRight (Right _)   = True
+isRight _           = False
+
+fromRight (Right x) = x
+
+fromLeft (Left x)   = x
+
+-- String --------------------------------------------------
+
+type String         = [Char]
+
+-- Tuples --------------------------------------------------
+
+fst                :: (a,b) -> a
+fst (x,_)           = x
+
+snd                :: (a,b) -> b
+snd (_,x)           = x
+
+-- List functions ------------------------------------------
+
+head               :: [a] -> a
+head (x : _)        = x
+
+tail               :: [a] -> [a]
+tail (_ : xs)       = xs
+
+init               :: [a] -> [a]
+init [x]           = []
+init (x : xs)      = x : init xs
+
+last               :: [a] -> a
+last [x]           = x
+last (x : xs)      = last xs
+
+(++)               :: [a] -> [a] -> [a]
+[] ++ ys            = ys
+(x:xs) ++ ys        = x : xs ++ ys
+
+length             :: [a] -> Int
+length []           = 0
+length (_ : xs)     = 1 + length xs
+
+reverse            :: [a] -> [a]
+reverse xs          = rev xs []
+  where rev [] ys   = ys
+        rev (x : xs) ys
+                    = rev xs (x : ys)
+
+map                :: (a -> b) -> [a] -> [b]
+map f []            = []
+map f (x : xs)      = f x : map f xs
+
+filter             :: (a -> Bool) -> [a] -> [a]
+filter p []         = []
+filter p (x : xs) 
+    | p x           = x : filter p xs
+    | otherwise     = filter p xs
+
+
+foldr              :: ( a -> b -> b) -> b -> [a] -> b
+foldr f u []        = u
+foldr f u (x : xs)  = f x (foldr f u xs)
+
+foldl              :: (a -> b -> a) -> a -> [b] -> a
+foldl f u []        = u 
+foldl f u (x : xs)  = foldl f (f u x) xs
+
+concat              = foldr (++) []
+
+zip (x:xs) (y:ys)   = (x,y) : zip xs ys
+zip _ _             = []
+
+elem               :: a -> [a] -> Bool \\ Eq a
+elem x []           = False
+elem x (y : ys)     = x == y || elem x ys
+
+lookup              :: a -> [(a,b)] -> Maybe b \\ Eq a
+lookup x []          = Nothing
+lookup x ((a,b) : xs) 
+     | x == a        = Just b
+     | otherwise     = lookup x xs
+
+replicate :: Int -> a -> [a]
+replicate n x
+  | n < 0          = []
+  | otherwise       = x : replicate (n-1) x
+
+take, drop          :: Int -> [a] -> [a]
+take 0 xs           = []
+take n []           = []
+take n (x : xs) 
+        | n > 0     = x : take (n-1) xs
+
+drop 0 xs           = xs
+drop n []           = []
+drop n (x : xs)
+       | n > 0      = drop (n-1) xs
+         
+takeWhile p []      = []
+takeWhile p (x:xs)
+  | p x             = x : takeWhile p xs
+  | otherwise       = []
+
+dropWhile p []      = []
+dropWhile p (x:xs)
+  | p x             = dropWhile p xs
+  | otherwise       = x:xs
+
+all p []            = True
+all p (x : xs)      = p x && all p xs
+
+any p []            = False
+any p (x : xs)      = p x || any p xs
+
+-- Combinators ---------------------------------------------
+
+($) :: (a -> b) -> a -> b
+f $ a = f a
+
+const :: a -> b -> a
+const a _ = a
+
+id :: a -> a
+id a = a
+
+flip               :: (a -> b -> c) -> b -> a -> c
+flip f x y          = f y x
+
+curry              :: ((a,b) -> c) -> a -> b -> c 
+curry f x y         = f (x,y)
+
+uncurry            :: (a -> b -> c) -> (a,b) -> c
+uncurry f (x,y)     = f x y
+
+f @ g               = \x -> f (g x)
+
+-- Boolean and numeric functions ---------------------------
+
+not                :: Bool -> Bool
+not True            = False
+not False           = True
+
+otherwise          :: Bool
+otherwise           = True
+
+ord                :: Char -> Int
+ord                 = primCharToInt
+
+chr                :: Int -> Char
+chr                 = primIntToChar
+
+a ^ 0               = 1
+a ^ n 
+  | even n          = (a * a) ^ (n `div` 2)
+  | otherwise       = a * (a * a) ^ (n `div` 2)
+
+div, mod           :: Int -> Int -> Int
+div                 = primIntDiv
+mod                 = primIntMod
+
+(/)                :: Float -> Float -> Float
+(/)                 = primFloatDiv
+
+even, odd          :: Int -> Bool
+even x              = x `mod` 2 == 0
+odd x               = x `mod` 2 == 1
+
+gcd                :: Int -> Int -> Int
+gcd x y             = gcd' (abs x) (abs y)
+  where gcd' a 0
+         | a > 0    = a
+        gcd' a b    = gcd' b (a `mod` b)
+
+abs x  = case x < 0 of
+             True  -> -x
+             False -> x
+
+
+max, min           :: a -> a -> a \\ Ord a
+max x y
+  | x >= y          = x
+  | otherwise       = y
+
+min x y
+  | x <= y          = x
+  | otherwise       = y
+
+floor               = primFloatToInt
+
+round x             = floor (x + 0.5)
+
+-- Command sequencing --------------------------------------
+
+sequence []         = do result []
+sequence (x : xs)   = do a  <- x
+                         as <- sequence xs
+                         result a : as
+
+mapM f []           = do result []
+mapM f (x : xs)     = do a <- f x
+                         as <- mapM f xs
+                         result a : as
+
diff --git a/lib/RandomGenerator.t b/lib/RandomGenerator.t
new file mode 100644
--- /dev/null
+++ b/lib/RandomGenerator.t
@@ -0,0 +1,60 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module RandomGenerator where
+
+struct Generator a where
+  next :: Request a
+  
+-- Lehmer/Schrage random number generator. Simple and not too bad.
+-- baseGen generates integers in the range [1..m-1] on 32 bit machines.
+-- The n-th number produced is (seed * a^n) mod m but with calculations organised to avoid overflow.
+-- 7^5 is a primitive root of the prime m, so this generator has period m - 1.
+
+baseGen :: Int -> Class (Generator Int)
+baseGen 0 = raise 1
+baseGen seed = class
+  a = 16807        -- = 7^5
+  m = 2147483647   -- = 2^31 - 1
+  q = 127773       -- = m `div` a
+  r = 2836         -- = m `mod` a
+
+  state := seed
+  
+  next = request
+    tmp = a * (state `mod` q) - r * (state `div` q)
+    state := if tmp > 0 then tmp else tmp + m
+    result state
+
+  result Generator{..}
+
diff --git a/rtsPOSIX/Makefile.in b/rtsPOSIX/Makefile.in
new file mode 100644
--- /dev/null
+++ b/rtsPOSIX/Makefile.in
@@ -0,0 +1,42 @@
+prefix       = @prefix@
+CC           = @CC@
+CFLAGS       = @CFLAGS@
+INSTALL	     = @INSTALL@
+
+TIMBERC      = @TIMBERC@
+TIMBERLIBS   = Prelude.t $(filter-out Prelude.t,$(notdir $(wildcard ../lib/*.t)))
+OBJS         = $(TIMBERLIBS:.t=.o)
+
+DEST         = libTimber.a
+
+all: 
+	@printf "Run make install to install and build this RTS.\n\n"
+	@printf "Run make $(DEST) to build this RTS in-place.\n"
+	@printf "Notice that building in-place requires the RTS to reside in\n"
+	@printf "an installed timberc tree.\n\n"
+
+
+$(DEST): $(OBJS) rts.o
+	ar rc $(DEST) $(OBJS) rts.o
+
+$(OBJS): %.o: ../lib/%.t ../include/timber.h
+	$(TIMBERC) --target POSIX --api -c $<
+
+rts.o: rts.c cyclic.c gc.c env.c env.h timer.c rts.h ../include/timber.h ../include/timber.c ../include/float.c
+	$(CC) $(CFLAGS) -Wall -O2 -fno-strict-aliasing -g -I../include -I../lib -I. -c rts.c
+
+install: 
+	$(INSTALL) -d $(DESTDIR)$(prefix)/rtsPOSIX
+	$(INSTALL) timberc.cfg $(DESTDIR)$(prefix)/rtsPOSIX
+	$(INSTALL) rts.h $(DESTDIR)$(prefix)/rtsPOSIX
+	$(INSTALL) rts.c $(DESTDIR)$(prefix)/rtsPOSIX
+	$(INSTALL) cyclic.c $(DESTDIR)$(prefix)/rtsPOSIX
+	$(INSTALL) config.h $(DESTDIR)$(prefix)/rtsPOSIX
+	$(INSTALL) gc.c $(DESTDIR)$(prefix)/rtsPOSIX
+	$(INSTALL) env.c $(DESTDIR)$(prefix)/rtsPOSIX
+	$(INSTALL) env.h $(DESTDIR)$(prefix)/rtsPOSIX
+	$(INSTALL) timer.c $(DESTDIR)$(prefix)/rtsPOSIX
+	$(INSTALL) main.c $(DESTDIR)$(prefix)/rtsPOSIX
+	$(INSTALL) Makefile $(DESTDIR)$(prefix)/rtsPOSIX
+	cd $(DESTDIR)$(prefix)/rtsPOSIX && make $(DEST) 
+
diff --git a/rtsPOSIX/config.guess b/rtsPOSIX/config.guess
new file mode 100644
--- /dev/null
+++ b/rtsPOSIX/config.guess
@@ -0,0 +1,1526 @@
+#! /bin/sh
+# Attempt to guess a canonical system name.
+#   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+#   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+#   Free Software Foundation, Inc.
+
+timestamp='2008-01-23'
+
+# This file is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
+# 02110-1301, USA.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+
+# Originally written by Per Bothner <per@bothner.com>.
+# Please send patches to <config-patches@gnu.org>.  Submit a context
+# diff and a properly formatted ChangeLog entry.
+#
+# This script attempts to guess a canonical system name similar to
+# config.sub.  If it succeeds, it prints the system name on stdout, and
+# exits with 0.  Otherwise, it exits with 1.
+#
+# The plan is that this can be called by configure scripts if you
+# don't specify an explicit build system type.
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION]
+
+Output the configuration name of the system \`$me' is run on.
+
+Operation modes:
+  -h, --help         print this help, then exit
+  -t, --time-stamp   print date of last modification, then exit
+  -v, --version      print version number, then exit
+
+Report bugs and patches to <config-patches@gnu.org>."
+
+version="\
+GNU config.guess ($timestamp)
+
+Originally written by Per Bothner.
+Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
+2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+
+This is free software; see the source for copying conditions.  There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+
+help="
+Try \`$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+  case $1 in
+    --time-stamp | --time* | -t )
+       echo "$timestamp" ; exit ;;
+    --version | -v )
+       echo "$version" ; exit ;;
+    --help | --h* | -h )
+       echo "$usage"; exit ;;
+    -- )     # Stop option processing
+       shift; break ;;
+    - )	# Use stdin as input.
+       break ;;
+    -* )
+       echo "$me: invalid option $1$help" >&2
+       exit 1 ;;
+    * )
+       break ;;
+  esac
+done
+
+if test $# != 0; then
+  echo "$me: too many arguments$help" >&2
+  exit 1
+fi
+
+trap 'exit 1' 1 2 15
+
+# CC_FOR_BUILD -- compiler used by this script. Note that the use of a
+# compiler to aid in system detection is discouraged as it requires
+# temporary files to be created and, as you can see below, it is a
+# headache to deal with in a portable fashion.
+
+# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still
+# use `HOST_CC' if defined, but it is deprecated.
+
+# Portable tmp directory creation inspired by the Autoconf team.
+
+set_cc_for_build='
+trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;
+trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;
+: ${TMPDIR=/tmp} ;
+ { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
+ { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } ||
+ { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } ||
+ { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ;
+dummy=$tmp/dummy ;
+tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ;
+case $CC_FOR_BUILD,$HOST_CC,$CC in
+ ,,)    echo "int x;" > $dummy.c ;
+	for c in cc gcc c89 c99 ; do
+	  if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then
+	     CC_FOR_BUILD="$c"; break ;
+	  fi ;
+	done ;
+	if test x"$CC_FOR_BUILD" = x ; then
+	  CC_FOR_BUILD=no_compiler_found ;
+	fi
+	;;
+ ,,*)   CC_FOR_BUILD=$CC ;;
+ ,*,*)  CC_FOR_BUILD=$HOST_CC ;;
+esac ; set_cc_for_build= ;'
+
+# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
+# (ghazi@noc.rutgers.edu 1994-08-24)
+if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
+	PATH=$PATH:/.attbin ; export PATH
+fi
+
+UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
+UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
+UNAME_SYSTEM=`(uname -s) 2>/dev/null`  || UNAME_SYSTEM=unknown
+UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
+
+# Note: order is significant - the case branches are not exclusive.
+
+case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+    *:NetBSD:*:*)
+	# NetBSD (nbsd) targets should (where applicable) match one or
+	# more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*,
+	# *-*-netbsdecoff* and *-*-netbsd*.  For targets that recently
+	# switched to ELF, *-*-netbsd* would select the old
+	# object file format.  This provides both forward
+	# compatibility and a consistent mechanism for selecting the
+	# object file format.
+	#
+	# Note: NetBSD doesn't particularly care about the vendor
+	# portion of the name.  We always set it to "unknown".
+	sysctl="sysctl -n hw.machine_arch"
+	UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \
+	    /usr/sbin/$sysctl 2>/dev/null || echo unknown)`
+	case "${UNAME_MACHINE_ARCH}" in
+	    armeb) machine=armeb-unknown ;;
+	    arm*) machine=arm-unknown ;;
+	    sh3el) machine=shl-unknown ;;
+	    sh3eb) machine=sh-unknown ;;
+	    sh5el) machine=sh5le-unknown ;;
+	    *) machine=${UNAME_MACHINE_ARCH}-unknown ;;
+	esac
+	# The Operating System including object format, if it has switched
+	# to ELF recently, or will in the future.
+	case "${UNAME_MACHINE_ARCH}" in
+	    arm*|i386|m68k|ns32k|sh3*|sparc|vax)
+		eval $set_cc_for_build
+		if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \
+			| grep __ELF__ >/dev/null
+		then
+		    # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout).
+		    # Return netbsd for either.  FIX?
+		    os=netbsd
+		else
+		    os=netbsdelf
+		fi
+		;;
+	    *)
+	        os=netbsd
+		;;
+	esac
+	# The OS release
+	# Debian GNU/NetBSD machines have a different userland, and
+	# thus, need a distinct triplet. However, they do not need
+	# kernel version information, so it can be replaced with a
+	# suitable tag, in the style of linux-gnu.
+	case "${UNAME_VERSION}" in
+	    Debian*)
+		release='-gnu'
+		;;
+	    *)
+		release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+		;;
+	esac
+	# Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:
+	# contains redundant information, the shorter form:
+	# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
+	echo "${machine}-${os}${release}"
+	exit ;;
+    *:OpenBSD:*:*)
+	UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`
+	echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE}
+	exit ;;
+    *:ekkoBSD:*:*)
+	echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE}
+	exit ;;
+    *:SolidBSD:*:*)
+	echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE}
+	exit ;;
+    macppc:MirBSD:*:*)
+	echo powerpc-unknown-mirbsd${UNAME_RELEASE}
+	exit ;;
+    *:MirBSD:*:*)
+	echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE}
+	exit ;;
+    alpha:OSF1:*:*)
+	case $UNAME_RELEASE in
+	*4.0)
+		UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
+		;;
+	*5.*)
+	        UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`
+		;;
+	esac
+	# According to Compaq, /usr/sbin/psrinfo has been available on
+	# OSF/1 and Tru64 systems produced since 1995.  I hope that
+	# covers most systems running today.  This code pipes the CPU
+	# types through head -n 1, so we only detect the type of CPU 0.
+	ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^  The alpha \(.*\) processor.*$/\1/p' | head -n 1`
+	case "$ALPHA_CPU_TYPE" in
+	    "EV4 (21064)")
+		UNAME_MACHINE="alpha" ;;
+	    "EV4.5 (21064)")
+		UNAME_MACHINE="alpha" ;;
+	    "LCA4 (21066/21068)")
+		UNAME_MACHINE="alpha" ;;
+	    "EV5 (21164)")
+		UNAME_MACHINE="alphaev5" ;;
+	    "EV5.6 (21164A)")
+		UNAME_MACHINE="alphaev56" ;;
+	    "EV5.6 (21164PC)")
+		UNAME_MACHINE="alphapca56" ;;
+	    "EV5.7 (21164PC)")
+		UNAME_MACHINE="alphapca57" ;;
+	    "EV6 (21264)")
+		UNAME_MACHINE="alphaev6" ;;
+	    "EV6.7 (21264A)")
+		UNAME_MACHINE="alphaev67" ;;
+	    "EV6.8CB (21264C)")
+		UNAME_MACHINE="alphaev68" ;;
+	    "EV6.8AL (21264B)")
+		UNAME_MACHINE="alphaev68" ;;
+	    "EV6.8CX (21264D)")
+		UNAME_MACHINE="alphaev68" ;;
+	    "EV6.9A (21264/EV69A)")
+		UNAME_MACHINE="alphaev69" ;;
+	    "EV7 (21364)")
+		UNAME_MACHINE="alphaev7" ;;
+	    "EV7.9 (21364A)")
+		UNAME_MACHINE="alphaev79" ;;
+	esac
+	# A Pn.n version is a patched version.
+	# A Vn.n version is a released version.
+	# A Tn.n version is a released field test version.
+	# A Xn.n version is an unreleased experimental baselevel.
+	# 1.2 uses "1.2" for uname -r.
+	echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
+	exit ;;
+    Alpha\ *:Windows_NT*:*)
+	# How do we know it's Interix rather than the generic POSIX subsystem?
+	# Should we change UNAME_MACHINE based on the output of uname instead
+	# of the specific Alpha model?
+	echo alpha-pc-interix
+	exit ;;
+    21064:Windows_NT:50:3)
+	echo alpha-dec-winnt3.5
+	exit ;;
+    Amiga*:UNIX_System_V:4.0:*)
+	echo m68k-unknown-sysv4
+	exit ;;
+    *:[Aa]miga[Oo][Ss]:*:*)
+	echo ${UNAME_MACHINE}-unknown-amigaos
+	exit ;;
+    *:[Mm]orph[Oo][Ss]:*:*)
+	echo ${UNAME_MACHINE}-unknown-morphos
+	exit ;;
+    *:OS/390:*:*)
+	echo i370-ibm-openedition
+	exit ;;
+    *:z/VM:*:*)
+	echo s390-ibm-zvmoe
+	exit ;;
+    *:OS400:*:*)
+        echo powerpc-ibm-os400
+	exit ;;
+    arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
+	echo arm-acorn-riscix${UNAME_RELEASE}
+	exit ;;
+    arm:riscos:*:*|arm:RISCOS:*:*)
+	echo arm-unknown-riscos
+	exit ;;
+    SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)
+	echo hppa1.1-hitachi-hiuxmpp
+	exit ;;
+    Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
+	# akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
+	if test "`(/bin/universe) 2>/dev/null`" = att ; then
+		echo pyramid-pyramid-sysv3
+	else
+		echo pyramid-pyramid-bsd
+	fi
+	exit ;;
+    NILE*:*:*:dcosx)
+	echo pyramid-pyramid-svr4
+	exit ;;
+    DRS?6000:unix:4.0:6*)
+	echo sparc-icl-nx6
+	exit ;;
+    DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*)
+	case `/usr/bin/uname -p` in
+	    sparc) echo sparc-icl-nx7; exit ;;
+	esac ;;
+    sun4H:SunOS:5.*:*)
+	echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
+	echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*)
+	echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    sun4*:SunOS:6*:*)
+	# According to config.sub, this is the proper way to canonicalize
+	# SunOS6.  Hard to guess exactly what SunOS6 will be like, but
+	# it's likely to be more like Solaris than SunOS4.
+	echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    sun4*:SunOS:*:*)
+	case "`/usr/bin/arch -k`" in
+	    Series*|S4*)
+		UNAME_RELEASE=`uname -v`
+		;;
+	esac
+	# Japanese Language versions have a version number like `4.1.3-JL'.
+	echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`
+	exit ;;
+    sun3*:SunOS:*:*)
+	echo m68k-sun-sunos${UNAME_RELEASE}
+	exit ;;
+    sun*:*:4.2BSD:*)
+	UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`
+	test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3
+	case "`/bin/arch`" in
+	    sun3)
+		echo m68k-sun-sunos${UNAME_RELEASE}
+		;;
+	    sun4)
+		echo sparc-sun-sunos${UNAME_RELEASE}
+		;;
+	esac
+	exit ;;
+    aushp:SunOS:*:*)
+	echo sparc-auspex-sunos${UNAME_RELEASE}
+	exit ;;
+    # The situation for MiNT is a little confusing.  The machine name
+    # can be virtually everything (everything which is not
+    # "atarist" or "atariste" at least should have a processor
+    # > m68000).  The system name ranges from "MiNT" over "FreeMiNT"
+    # to the lowercase version "mint" (or "freemint").  Finally
+    # the system name "TOS" denotes a system which is actually not
+    # MiNT.  But MiNT is downward compatible to TOS, so this should
+    # be no problem.
+    atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
+        echo m68k-atari-mint${UNAME_RELEASE}
+	exit ;;
+    atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
+	echo m68k-atari-mint${UNAME_RELEASE}
+        exit ;;
+    *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
+        echo m68k-atari-mint${UNAME_RELEASE}
+	exit ;;
+    milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
+        echo m68k-milan-mint${UNAME_RELEASE}
+        exit ;;
+    hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
+        echo m68k-hades-mint${UNAME_RELEASE}
+        exit ;;
+    *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
+        echo m68k-unknown-mint${UNAME_RELEASE}
+        exit ;;
+    m68k:machten:*:*)
+	echo m68k-apple-machten${UNAME_RELEASE}
+	exit ;;
+    powerpc:machten:*:*)
+	echo powerpc-apple-machten${UNAME_RELEASE}
+	exit ;;
+    RISC*:Mach:*:*)
+	echo mips-dec-mach_bsd4.3
+	exit ;;
+    RISC*:ULTRIX:*:*)
+	echo mips-dec-ultrix${UNAME_RELEASE}
+	exit ;;
+    VAX*:ULTRIX*:*:*)
+	echo vax-dec-ultrix${UNAME_RELEASE}
+	exit ;;
+    2020:CLIX:*:* | 2430:CLIX:*:*)
+	echo clipper-intergraph-clix${UNAME_RELEASE}
+	exit ;;
+    mips:*:*:UMIPS | mips:*:*:RISCos)
+	eval $set_cc_for_build
+	sed 's/^	//' << EOF >$dummy.c
+#ifdef __cplusplus
+#include <stdio.h>  /* for printf() prototype */
+	int main (int argc, char *argv[]) {
+#else
+	int main (argc, argv) int argc; char *argv[]; {
+#endif
+	#if defined (host_mips) && defined (MIPSEB)
+	#if defined (SYSTYPE_SYSV)
+	  printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);
+	#endif
+	#if defined (SYSTYPE_SVR4)
+	  printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);
+	#endif
+	#if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
+	  printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);
+	#endif
+	#endif
+	  exit (-1);
+	}
+EOF
+	$CC_FOR_BUILD -o $dummy $dummy.c &&
+	  dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` &&
+	  SYSTEM_NAME=`$dummy $dummyarg` &&
+	    { echo "$SYSTEM_NAME"; exit; }
+	echo mips-mips-riscos${UNAME_RELEASE}
+	exit ;;
+    Motorola:PowerMAX_OS:*:*)
+	echo powerpc-motorola-powermax
+	exit ;;
+    Motorola:*:4.3:PL8-*)
+	echo powerpc-harris-powermax
+	exit ;;
+    Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*)
+	echo powerpc-harris-powermax
+	exit ;;
+    Night_Hawk:Power_UNIX:*:*)
+	echo powerpc-harris-powerunix
+	exit ;;
+    m88k:CX/UX:7*:*)
+	echo m88k-harris-cxux7
+	exit ;;
+    m88k:*:4*:R4*)
+	echo m88k-motorola-sysv4
+	exit ;;
+    m88k:*:3*:R3*)
+	echo m88k-motorola-sysv3
+	exit ;;
+    AViiON:dgux:*:*)
+        # DG/UX returns AViiON for all architectures
+        UNAME_PROCESSOR=`/usr/bin/uname -p`
+	if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ]
+	then
+	    if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \
+	       [ ${TARGET_BINARY_INTERFACE}x = x ]
+	    then
+		echo m88k-dg-dgux${UNAME_RELEASE}
+	    else
+		echo m88k-dg-dguxbcs${UNAME_RELEASE}
+	    fi
+	else
+	    echo i586-dg-dgux${UNAME_RELEASE}
+	fi
+ 	exit ;;
+    M88*:DolphinOS:*:*)	# DolphinOS (SVR3)
+	echo m88k-dolphin-sysv3
+	exit ;;
+    M88*:*:R3*:*)
+	# Delta 88k system running SVR3
+	echo m88k-motorola-sysv3
+	exit ;;
+    XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
+	echo m88k-tektronix-sysv3
+	exit ;;
+    Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
+	echo m68k-tektronix-bsd
+	exit ;;
+    *:IRIX*:*:*)
+	echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
+	exit ;;
+    ????????:AIX?:[12].1:2)   # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
+	echo romp-ibm-aix     # uname -m gives an 8 hex-code CPU id
+	exit ;;               # Note that: echo "'`uname -s`'" gives 'AIX '
+    i*86:AIX:*:*)
+	echo i386-ibm-aix
+	exit ;;
+    ia64:AIX:*:*)
+	if [ -x /usr/bin/oslevel ] ; then
+		IBM_REV=`/usr/bin/oslevel`
+	else
+		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
+	fi
+	echo ${UNAME_MACHINE}-ibm-aix${IBM_REV}
+	exit ;;
+    *:AIX:2:3)
+	if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
+		eval $set_cc_for_build
+		sed 's/^		//' << EOF >$dummy.c
+		#include <sys/systemcfg.h>
+
+		main()
+			{
+			if (!__power_pc())
+				exit(1);
+			puts("powerpc-ibm-aix3.2.5");
+			exit(0);
+			}
+EOF
+		if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy`
+		then
+			echo "$SYSTEM_NAME"
+		else
+			echo rs6000-ibm-aix3.2.5
+		fi
+	elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
+		echo rs6000-ibm-aix3.2.4
+	else
+		echo rs6000-ibm-aix3.2
+	fi
+	exit ;;
+    *:AIX:*:[456])
+	IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`
+	if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then
+		IBM_ARCH=rs6000
+	else
+		IBM_ARCH=powerpc
+	fi
+	if [ -x /usr/bin/oslevel ] ; then
+		IBM_REV=`/usr/bin/oslevel`
+	else
+		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
+	fi
+	echo ${IBM_ARCH}-ibm-aix${IBM_REV}
+	exit ;;
+    *:AIX:*:*)
+	echo rs6000-ibm-aix
+	exit ;;
+    ibmrt:4.4BSD:*|romp-ibm:BSD:*)
+	echo romp-ibm-bsd4.4
+	exit ;;
+    ibmrt:*BSD:*|romp-ibm:BSD:*)            # covers RT/PC BSD and
+	echo romp-ibm-bsd${UNAME_RELEASE}   # 4.3 with uname added to
+	exit ;;                             # report: romp-ibm BSD 4.3
+    *:BOSX:*:*)
+	echo rs6000-bull-bosx
+	exit ;;
+    DPX/2?00:B.O.S.:*:*)
+	echo m68k-bull-sysv3
+	exit ;;
+    9000/[34]??:4.3bsd:1.*:*)
+	echo m68k-hp-bsd
+	exit ;;
+    hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
+	echo m68k-hp-bsd4.4
+	exit ;;
+    9000/[34678]??:HP-UX:*:*)
+	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
+	case "${UNAME_MACHINE}" in
+	    9000/31? )            HP_ARCH=m68000 ;;
+	    9000/[34]?? )         HP_ARCH=m68k ;;
+	    9000/[678][0-9][0-9])
+		if [ -x /usr/bin/getconf ]; then
+		    sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
+                    sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
+                    case "${sc_cpu_version}" in
+                      523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0
+                      528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1
+                      532)                      # CPU_PA_RISC2_0
+                        case "${sc_kernel_bits}" in
+                          32) HP_ARCH="hppa2.0n" ;;
+                          64) HP_ARCH="hppa2.0w" ;;
+			  '') HP_ARCH="hppa2.0" ;;   # HP-UX 10.20
+                        esac ;;
+                    esac
+		fi
+		if [ "${HP_ARCH}" = "" ]; then
+		    eval $set_cc_for_build
+		    sed 's/^              //' << EOF >$dummy.c
+
+              #define _HPUX_SOURCE
+              #include <stdlib.h>
+              #include <unistd.h>
+
+              int main ()
+              {
+              #if defined(_SC_KERNEL_BITS)
+                  long bits = sysconf(_SC_KERNEL_BITS);
+              #endif
+                  long cpu  = sysconf (_SC_CPU_VERSION);
+
+                  switch (cpu)
+              	{
+              	case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
+              	case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
+              	case CPU_PA_RISC2_0:
+              #if defined(_SC_KERNEL_BITS)
+              	    switch (bits)
+              		{
+              		case 64: puts ("hppa2.0w"); break;
+              		case 32: puts ("hppa2.0n"); break;
+              		default: puts ("hppa2.0"); break;
+              		} break;
+              #else  /* !defined(_SC_KERNEL_BITS) */
+              	    puts ("hppa2.0"); break;
+              #endif
+              	default: puts ("hppa1.0"); break;
+              	}
+                  exit (0);
+              }
+EOF
+		    (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy`
+		    test -z "$HP_ARCH" && HP_ARCH=hppa
+		fi ;;
+	esac
+	if [ ${HP_ARCH} = "hppa2.0w" ]
+	then
+	    eval $set_cc_for_build
+
+	    # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating
+	    # 32-bit code.  hppa64-hp-hpux* has the same kernel and a compiler
+	    # generating 64-bit code.  GNU and HP use different nomenclature:
+	    #
+	    # $ CC_FOR_BUILD=cc ./config.guess
+	    # => hppa2.0w-hp-hpux11.23
+	    # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess
+	    # => hppa64-hp-hpux11.23
+
+	    if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) |
+		grep __LP64__ >/dev/null
+	    then
+		HP_ARCH="hppa2.0w"
+	    else
+		HP_ARCH="hppa64"
+	    fi
+	fi
+	echo ${HP_ARCH}-hp-hpux${HPUX_REV}
+	exit ;;
+    ia64:HP-UX:*:*)
+	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
+	echo ia64-hp-hpux${HPUX_REV}
+	exit ;;
+    3050*:HI-UX:*:*)
+	eval $set_cc_for_build
+	sed 's/^	//' << EOF >$dummy.c
+	#include <unistd.h>
+	int
+	main ()
+	{
+	  long cpu = sysconf (_SC_CPU_VERSION);
+	  /* The order matters, because CPU_IS_HP_MC68K erroneously returns
+	     true for CPU_PA_RISC1_0.  CPU_IS_PA_RISC returns correct
+	     results, however.  */
+	  if (CPU_IS_PA_RISC (cpu))
+	    {
+	      switch (cpu)
+		{
+		  case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
+		  case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
+		  case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
+		  default: puts ("hppa-hitachi-hiuxwe2"); break;
+		}
+	    }
+	  else if (CPU_IS_HP_MC68K (cpu))
+	    puts ("m68k-hitachi-hiuxwe2");
+	  else puts ("unknown-hitachi-hiuxwe2");
+	  exit (0);
+	}
+EOF
+	$CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` &&
+		{ echo "$SYSTEM_NAME"; exit; }
+	echo unknown-hitachi-hiuxwe2
+	exit ;;
+    9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )
+	echo hppa1.1-hp-bsd
+	exit ;;
+    9000/8??:4.3bsd:*:*)
+	echo hppa1.0-hp-bsd
+	exit ;;
+    *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)
+	echo hppa1.0-hp-mpeix
+	exit ;;
+    hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )
+	echo hppa1.1-hp-osf
+	exit ;;
+    hp8??:OSF1:*:*)
+	echo hppa1.0-hp-osf
+	exit ;;
+    i*86:OSF1:*:*)
+	if [ -x /usr/sbin/sysversion ] ; then
+	    echo ${UNAME_MACHINE}-unknown-osf1mk
+	else
+	    echo ${UNAME_MACHINE}-unknown-osf1
+	fi
+	exit ;;
+    parisc*:Lites*:*:*)
+	echo hppa1.1-hp-lites
+	exit ;;
+    C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
+	echo c1-convex-bsd
+        exit ;;
+    C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
+	if getsysinfo -f scalar_acc
+	then echo c32-convex-bsd
+	else echo c2-convex-bsd
+	fi
+        exit ;;
+    C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
+	echo c34-convex-bsd
+        exit ;;
+    C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
+	echo c38-convex-bsd
+        exit ;;
+    C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
+	echo c4-convex-bsd
+        exit ;;
+    CRAY*Y-MP:*:*:*)
+	echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*[A-Z]90:*:*:*)
+	echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \
+	| sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
+	      -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \
+	      -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*TS:*:*:*)
+	echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*T3E:*:*:*)
+	echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    CRAY*SV1:*:*:*)
+	echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    *:UNICOS/mp:*:*)
+	echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+	exit ;;
+    F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)
+	FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
+        FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
+        FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`
+        echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
+        exit ;;
+    5000:UNIX_System_V:4.*:*)
+        FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
+        FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'`
+        echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
+	exit ;;
+    i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
+	echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}
+	exit ;;
+    sparc*:BSD/OS:*:*)
+	echo sparc-unknown-bsdi${UNAME_RELEASE}
+	exit ;;
+    *:BSD/OS:*:*)
+	echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
+	exit ;;
+    *:FreeBSD:*:*)
+	case ${UNAME_MACHINE} in
+	    pc98)
+		echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
+	    amd64)
+		echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
+	    *)
+		echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
+	esac
+	exit ;;
+    i*:CYGWIN*:*)
+	echo ${UNAME_MACHINE}-pc-cygwin
+	exit ;;
+    *:MINGW*:*)
+	echo ${UNAME_MACHINE}-pc-mingw32
+	exit ;;
+    i*:windows32*:*)
+    	# uname -m includes "-pc" on this system.
+    	echo ${UNAME_MACHINE}-mingw32
+	exit ;;
+    i*:PW*:*)
+	echo ${UNAME_MACHINE}-pc-pw32
+	exit ;;
+    *:Interix*:[3456]*)
+    	case ${UNAME_MACHINE} in
+	    x86)
+		echo i586-pc-interix${UNAME_RELEASE}
+		exit ;;
+	    EM64T | authenticamd)
+		echo x86_64-unknown-interix${UNAME_RELEASE}
+		exit ;;
+	    IA64)
+		echo ia64-unknown-interix${UNAME_RELEASE}
+		exit ;;
+	esac ;;
+    [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*)
+	echo i${UNAME_MACHINE}-pc-mks
+	exit ;;
+    i*:Windows_NT*:* | Pentium*:Windows_NT*:*)
+	# How do we know it's Interix rather than the generic POSIX subsystem?
+	# It also conflicts with pre-2.0 versions of AT&T UWIN. Should we
+	# UNAME_MACHINE based on the output of uname instead of i386?
+	echo i586-pc-interix
+	exit ;;
+    i*:UWIN*:*)
+	echo ${UNAME_MACHINE}-pc-uwin
+	exit ;;
+    amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)
+	echo x86_64-unknown-cygwin
+	exit ;;
+    p*:CYGWIN*:*)
+	echo powerpcle-unknown-cygwin
+	exit ;;
+    prep*:SunOS:5.*:*)
+	echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+	exit ;;
+    *:GNU:*:*)
+	# the GNU system
+	echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
+	exit ;;
+    *:GNU/*:*:*)
+	# other systems with GNU libc and userland
+	echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu
+	exit ;;
+    i*86:Minix:*:*)
+	echo ${UNAME_MACHINE}-pc-minix
+	exit ;;
+    arm*:Linux:*:*)
+	eval $set_cc_for_build
+	if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \
+	    | grep -q __ARM_EABI__
+	then
+	    echo ${UNAME_MACHINE}-unknown-linux-gnu
+	else
+	    echo ${UNAME_MACHINE}-unknown-linux-gnueabi
+	fi
+	exit ;;
+    avr32*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-gnu
+	exit ;;
+    cris:Linux:*:*)
+	echo cris-axis-linux-gnu
+	exit ;;
+    crisv32:Linux:*:*)
+	echo crisv32-axis-linux-gnu
+	exit ;;
+    frv:Linux:*:*)
+    	echo frv-unknown-linux-gnu
+	exit ;;
+    ia64:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-gnu
+	exit ;;
+    m32r*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-gnu
+	exit ;;
+    m68*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-gnu
+	exit ;;
+    mips:Linux:*:*)
+	eval $set_cc_for_build
+	sed 's/^	//' << EOF >$dummy.c
+	#undef CPU
+	#undef mips
+	#undef mipsel
+	#if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
+	CPU=mipsel
+	#else
+	#if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
+	CPU=mips
+	#else
+	CPU=
+	#endif
+	#endif
+EOF
+	eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
+	    /^CPU/{
+		s: ::g
+		p
+	    }'`"
+	test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }
+	;;
+    mips64:Linux:*:*)
+	eval $set_cc_for_build
+	sed 's/^	//' << EOF >$dummy.c
+	#undef CPU
+	#undef mips64
+	#undef mips64el
+	#if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
+	CPU=mips64el
+	#else
+	#if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
+	CPU=mips64
+	#else
+	CPU=
+	#endif
+	#endif
+EOF
+	eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
+	    /^CPU/{
+		s: ::g
+		p
+	    }'`"
+	test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }
+	;;
+    or32:Linux:*:*)
+	echo or32-unknown-linux-gnu
+	exit ;;
+    ppc:Linux:*:*)
+	echo powerpc-unknown-linux-gnu
+	exit ;;
+    ppc64:Linux:*:*)
+	echo powerpc64-unknown-linux-gnu
+	exit ;;
+    alpha:Linux:*:*)
+	case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
+	  EV5)   UNAME_MACHINE=alphaev5 ;;
+	  EV56)  UNAME_MACHINE=alphaev56 ;;
+	  PCA56) UNAME_MACHINE=alphapca56 ;;
+	  PCA57) UNAME_MACHINE=alphapca56 ;;
+	  EV6)   UNAME_MACHINE=alphaev6 ;;
+	  EV67)  UNAME_MACHINE=alphaev67 ;;
+	  EV68*) UNAME_MACHINE=alphaev68 ;;
+        esac
+	objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null
+	if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi
+	echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC}
+	exit ;;
+    parisc:Linux:*:* | hppa:Linux:*:*)
+	# Look for CPU level
+	case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in
+	  PA7*) echo hppa1.1-unknown-linux-gnu ;;
+	  PA8*) echo hppa2.0-unknown-linux-gnu ;;
+	  *)    echo hppa-unknown-linux-gnu ;;
+	esac
+	exit ;;
+    parisc64:Linux:*:* | hppa64:Linux:*:*)
+	echo hppa64-unknown-linux-gnu
+	exit ;;
+    s390:Linux:*:* | s390x:Linux:*:*)
+	echo ${UNAME_MACHINE}-ibm-linux
+	exit ;;
+    sh64*:Linux:*:*)
+    	echo ${UNAME_MACHINE}-unknown-linux-gnu
+	exit ;;
+    sh*:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-gnu
+	exit ;;
+    sparc:Linux:*:* | sparc64:Linux:*:*)
+	echo ${UNAME_MACHINE}-unknown-linux-gnu
+	exit ;;
+    vax:Linux:*:*)
+	echo ${UNAME_MACHINE}-dec-linux-gnu
+	exit ;;
+    x86_64:Linux:*:*)
+	echo x86_64-unknown-linux-gnu
+	exit ;;
+    xtensa*:Linux:*:*)
+    	echo ${UNAME_MACHINE}-unknown-linux-gnu
+	exit ;;
+    i*86:Linux:*:*)
+	# The BFD linker knows what the default object file format is, so
+	# first see if it will tell us. cd to the root directory to prevent
+	# problems with other programs or directories called `ld' in the path.
+	# Set LC_ALL=C to ensure ld outputs messages in English.
+	ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \
+			 | sed -ne '/supported targets:/!d
+				    s/[ 	][ 	]*/ /g
+				    s/.*supported targets: *//
+				    s/ .*//
+				    p'`
+        case "$ld_supported_targets" in
+	  elf32-i386)
+		TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu"
+		;;
+	  a.out-i386-linux)
+		echo "${UNAME_MACHINE}-pc-linux-gnuaout"
+		exit ;;
+	  coff-i386)
+		echo "${UNAME_MACHINE}-pc-linux-gnucoff"
+		exit ;;
+	  "")
+		# Either a pre-BFD a.out linker (linux-gnuoldld) or
+		# one that does not give us useful --help.
+		echo "${UNAME_MACHINE}-pc-linux-gnuoldld"
+		exit ;;
+	esac
+	# Determine whether the default compiler is a.out or elf
+	eval $set_cc_for_build
+	sed 's/^	//' << EOF >$dummy.c
+	#include <features.h>
+	#ifdef __ELF__
+	# ifdef __GLIBC__
+	#  if __GLIBC__ >= 2
+	LIBC=gnu
+	#  else
+	LIBC=gnulibc1
+	#  endif
+	# else
+	LIBC=gnulibc1
+	# endif
+	#else
+	#if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC)
+	LIBC=gnu
+	#else
+	LIBC=gnuaout
+	#endif
+	#endif
+	#ifdef __dietlibc__
+	LIBC=dietlibc
+	#endif
+EOF
+	eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
+	    /^LIBC/{
+		s: ::g
+		p
+	    }'`"
+	test x"${LIBC}" != x && {
+		echo "${UNAME_MACHINE}-pc-linux-${LIBC}"
+		exit
+	}
+	test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; }
+	;;
+    i*86:DYNIX/ptx:4*:*)
+	# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
+	# earlier versions are messed up and put the nodename in both
+	# sysname and nodename.
+	echo i386-sequent-sysv4
+	exit ;;
+    i*86:UNIX_SV:4.2MP:2.*)
+        # Unixware is an offshoot of SVR4, but it has its own version
+        # number series starting with 2...
+        # I am not positive that other SVR4 systems won't match this,
+	# I just have to hope.  -- rms.
+        # Use sysv4.2uw... so that sysv4* matches it.
+	echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION}
+	exit ;;
+    i*86:OS/2:*:*)
+	# If we were able to find `uname', then EMX Unix compatibility
+	# is probably installed.
+	echo ${UNAME_MACHINE}-pc-os2-emx
+	exit ;;
+    i*86:XTS-300:*:STOP)
+	echo ${UNAME_MACHINE}-unknown-stop
+	exit ;;
+    i*86:atheos:*:*)
+	echo ${UNAME_MACHINE}-unknown-atheos
+	exit ;;
+    i*86:syllable:*:*)
+	echo ${UNAME_MACHINE}-pc-syllable
+	exit ;;
+    i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*)
+	echo i386-unknown-lynxos${UNAME_RELEASE}
+	exit ;;
+    i*86:*DOS:*:*)
+	echo ${UNAME_MACHINE}-pc-msdosdjgpp
+	exit ;;
+    i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*)
+	UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'`
+	if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+		echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL}
+	else
+		echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL}
+	fi
+	exit ;;
+    i*86:*:5:[678]*)
+    	# UnixWare 7.x, OpenUNIX and OpenServer 6.
+	case `/bin/uname -X | grep "^Machine"` in
+	    *486*)	     UNAME_MACHINE=i486 ;;
+	    *Pentium)	     UNAME_MACHINE=i586 ;;
+	    *Pent*|*Celeron) UNAME_MACHINE=i686 ;;
+	esac
+	echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}
+	exit ;;
+    i*86:*:3.2:*)
+	if test -f /usr/options/cb.name; then
+		UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
+		echo ${UNAME_MACHINE}-pc-isc$UNAME_REL
+	elif /bin/uname -X 2>/dev/null >/dev/null ; then
+		UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')`
+		(/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486
+		(/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \
+			&& UNAME_MACHINE=i586
+		(/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \
+			&& UNAME_MACHINE=i686
+		(/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \
+			&& UNAME_MACHINE=i686
+		echo ${UNAME_MACHINE}-pc-sco$UNAME_REL
+	else
+		echo ${UNAME_MACHINE}-pc-sysv32
+	fi
+	exit ;;
+    pc:*:*:*)
+	# Left here for compatibility:
+        # uname -m prints for DJGPP always 'pc', but it prints nothing about
+        # the processor, so we play safe by assuming i386.
+	echo i386-pc-msdosdjgpp
+        exit ;;
+    Intel:Mach:3*:*)
+	echo i386-pc-mach3
+	exit ;;
+    paragon:*:*:*)
+	echo i860-intel-osf1
+	exit ;;
+    i860:*:4.*:*) # i860-SVR4
+	if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
+	  echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4
+	else # Add other i860-SVR4 vendors below as they are discovered.
+	  echo i860-unknown-sysv${UNAME_RELEASE}  # Unknown i860-SVR4
+	fi
+	exit ;;
+    mini*:CTIX:SYS*5:*)
+	# "miniframe"
+	echo m68010-convergent-sysv
+	exit ;;
+    mc68k:UNIX:SYSTEM5:3.51m)
+	echo m68k-convergent-sysv
+	exit ;;
+    M680?0:D-NIX:5.3:*)
+	echo m68k-diab-dnix
+	exit ;;
+    M68*:*:R3V[5678]*:*)
+	test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;;
+    3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0)
+	OS_REL=''
+	test -r /etc/.relid \
+	&& OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+	  && { echo i486-ncr-sysv4.3${OS_REL}; exit; }
+	/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
+	  && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;
+    3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
+        /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+          && { echo i486-ncr-sysv4; exit; } ;;
+    m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)
+	echo m68k-unknown-lynxos${UNAME_RELEASE}
+	exit ;;
+    mc68030:UNIX_System_V:4.*:*)
+	echo m68k-atari-sysv4
+	exit ;;
+    TSUNAMI:LynxOS:2.*:*)
+	echo sparc-unknown-lynxos${UNAME_RELEASE}
+	exit ;;
+    rs6000:LynxOS:2.*:*)
+	echo rs6000-unknown-lynxos${UNAME_RELEASE}
+	exit ;;
+    PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*)
+	echo powerpc-unknown-lynxos${UNAME_RELEASE}
+	exit ;;
+    SM[BE]S:UNIX_SV:*:*)
+	echo mips-dde-sysv${UNAME_RELEASE}
+	exit ;;
+    RM*:ReliantUNIX-*:*:*)
+	echo mips-sni-sysv4
+	exit ;;
+    RM*:SINIX-*:*:*)
+	echo mips-sni-sysv4
+	exit ;;
+    *:SINIX-*:*:*)
+	if uname -p 2>/dev/null >/dev/null ; then
+		UNAME_MACHINE=`(uname -p) 2>/dev/null`
+		echo ${UNAME_MACHINE}-sni-sysv4
+	else
+		echo ns32k-sni-sysv
+	fi
+	exit ;;
+    PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort
+                      # says <Richard.M.Bartel@ccMail.Census.GOV>
+        echo i586-unisys-sysv4
+        exit ;;
+    *:UNIX_System_V:4*:FTX*)
+	# From Gerald Hewes <hewes@openmarket.com>.
+	# How about differentiating between stratus architectures? -djm
+	echo hppa1.1-stratus-sysv4
+	exit ;;
+    *:*:*:FTX*)
+	# From seanf@swdc.stratus.com.
+	echo i860-stratus-sysv4
+	exit ;;
+    i*86:VOS:*:*)
+	# From Paul.Green@stratus.com.
+	echo ${UNAME_MACHINE}-stratus-vos
+	exit ;;
+    *:VOS:*:*)
+	# From Paul.Green@stratus.com.
+	echo hppa1.1-stratus-vos
+	exit ;;
+    mc68*:A/UX:*:*)
+	echo m68k-apple-aux${UNAME_RELEASE}
+	exit ;;
+    news*:NEWS-OS:6*:*)
+	echo mips-sony-newsos6
+	exit ;;
+    R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
+	if [ -d /usr/nec ]; then
+	        echo mips-nec-sysv${UNAME_RELEASE}
+	else
+	        echo mips-unknown-sysv${UNAME_RELEASE}
+	fi
+        exit ;;
+    BeBox:BeOS:*:*)	# BeOS running on hardware made by Be, PPC only.
+	echo powerpc-be-beos
+	exit ;;
+    BeMac:BeOS:*:*)	# BeOS running on Mac or Mac clone, PPC only.
+	echo powerpc-apple-beos
+	exit ;;
+    BePC:BeOS:*:*)	# BeOS running on Intel PC compatible.
+	echo i586-pc-beos
+	exit ;;
+    SX-4:SUPER-UX:*:*)
+	echo sx4-nec-superux${UNAME_RELEASE}
+	exit ;;
+    SX-5:SUPER-UX:*:*)
+	echo sx5-nec-superux${UNAME_RELEASE}
+	exit ;;
+    SX-6:SUPER-UX:*:*)
+	echo sx6-nec-superux${UNAME_RELEASE}
+	exit ;;
+    SX-7:SUPER-UX:*:*)
+	echo sx7-nec-superux${UNAME_RELEASE}
+	exit ;;
+    SX-8:SUPER-UX:*:*)
+	echo sx8-nec-superux${UNAME_RELEASE}
+	exit ;;
+    SX-8R:SUPER-UX:*:*)
+	echo sx8r-nec-superux${UNAME_RELEASE}
+	exit ;;
+    Power*:Rhapsody:*:*)
+	echo powerpc-apple-rhapsody${UNAME_RELEASE}
+	exit ;;
+    *:Rhapsody:*:*)
+	echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}
+	exit ;;
+    *:Darwin:*:*)
+	UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown
+	case $UNAME_PROCESSOR in
+	    unknown) UNAME_PROCESSOR=powerpc ;;
+	esac
+	echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE}
+	exit ;;
+    *:procnto*:*:* | *:QNX:[0123456789]*:*)
+	UNAME_PROCESSOR=`uname -p`
+	if test "$UNAME_PROCESSOR" = "x86"; then
+		UNAME_PROCESSOR=i386
+		UNAME_MACHINE=pc
+	fi
+	echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE}
+	exit ;;
+    *:QNX:*:4*)
+	echo i386-pc-qnx
+	exit ;;
+    NSE-?:NONSTOP_KERNEL:*:*)
+	echo nse-tandem-nsk${UNAME_RELEASE}
+	exit ;;
+    NSR-?:NONSTOP_KERNEL:*:*)
+	echo nsr-tandem-nsk${UNAME_RELEASE}
+	exit ;;
+    *:NonStop-UX:*:*)
+	echo mips-compaq-nonstopux
+	exit ;;
+    BS2000:POSIX*:*:*)
+	echo bs2000-siemens-sysv
+	exit ;;
+    DS/*:UNIX_System_V:*:*)
+	echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE}
+	exit ;;
+    *:Plan9:*:*)
+	# "uname -m" is not consistent, so use $cputype instead. 386
+	# is converted to i386 for consistency with other x86
+	# operating systems.
+	if test "$cputype" = "386"; then
+	    UNAME_MACHINE=i386
+	else
+	    UNAME_MACHINE="$cputype"
+	fi
+	echo ${UNAME_MACHINE}-unknown-plan9
+	exit ;;
+    *:TOPS-10:*:*)
+	echo pdp10-unknown-tops10
+	exit ;;
+    *:TENEX:*:*)
+	echo pdp10-unknown-tenex
+	exit ;;
+    KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)
+	echo pdp10-dec-tops20
+	exit ;;
+    XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)
+	echo pdp10-xkl-tops20
+	exit ;;
+    *:TOPS-20:*:*)
+	echo pdp10-unknown-tops20
+	exit ;;
+    *:ITS:*:*)
+	echo pdp10-unknown-its
+	exit ;;
+    SEI:*:*:SEIUX)
+        echo mips-sei-seiux${UNAME_RELEASE}
+	exit ;;
+    *:DragonFly:*:*)
+	echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
+	exit ;;
+    *:*VMS:*:*)
+    	UNAME_MACHINE=`(uname -p) 2>/dev/null`
+	case "${UNAME_MACHINE}" in
+	    A*) echo alpha-dec-vms ; exit ;;
+	    I*) echo ia64-dec-vms ; exit ;;
+	    V*) echo vax-dec-vms ; exit ;;
+	esac ;;
+    *:XENIX:*:SysV)
+	echo i386-pc-xenix
+	exit ;;
+    i*86:skyos:*:*)
+	echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//'
+	exit ;;
+    i*86:rdos:*:*)
+	echo ${UNAME_MACHINE}-pc-rdos
+	exit ;;
+esac
+
+#echo '(No uname command or uname output not recognized.)' 1>&2
+#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2
+
+eval $set_cc_for_build
+cat >$dummy.c <<EOF
+#ifdef _SEQUENT_
+# include <sys/types.h>
+# include <sys/utsname.h>
+#endif
+main ()
+{
+#if defined (sony)
+#if defined (MIPSEB)
+  /* BFD wants "bsd" instead of "newsos".  Perhaps BFD should be changed,
+     I don't know....  */
+  printf ("mips-sony-bsd\n"); exit (0);
+#else
+#include <sys/param.h>
+  printf ("m68k-sony-newsos%s\n",
+#ifdef NEWSOS4
+          "4"
+#else
+	  ""
+#endif
+         ); exit (0);
+#endif
+#endif
+
+#if defined (__arm) && defined (__acorn) && defined (__unix)
+  printf ("arm-acorn-riscix\n"); exit (0);
+#endif
+
+#if defined (hp300) && !defined (hpux)
+  printf ("m68k-hp-bsd\n"); exit (0);
+#endif
+
+#if defined (NeXT)
+#if !defined (__ARCHITECTURE__)
+#define __ARCHITECTURE__ "m68k"
+#endif
+  int version;
+  version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+  if (version < 4)
+    printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
+  else
+    printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
+  exit (0);
+#endif
+
+#if defined (MULTIMAX) || defined (n16)
+#if defined (UMAXV)
+  printf ("ns32k-encore-sysv\n"); exit (0);
+#else
+#if defined (CMU)
+  printf ("ns32k-encore-mach\n"); exit (0);
+#else
+  printf ("ns32k-encore-bsd\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (__386BSD__)
+  printf ("i386-pc-bsd\n"); exit (0);
+#endif
+
+#if defined (sequent)
+#if defined (i386)
+  printf ("i386-sequent-dynix\n"); exit (0);
+#endif
+#if defined (ns32000)
+  printf ("ns32k-sequent-dynix\n"); exit (0);
+#endif
+#endif
+
+#if defined (_SEQUENT_)
+    struct utsname un;
+
+    uname(&un);
+
+    if (strncmp(un.version, "V2", 2) == 0) {
+	printf ("i386-sequent-ptx2\n"); exit (0);
+    }
+    if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
+	printf ("i386-sequent-ptx1\n"); exit (0);
+    }
+    printf ("i386-sequent-ptx\n"); exit (0);
+
+#endif
+
+#if defined (vax)
+# if !defined (ultrix)
+#  include <sys/param.h>
+#  if defined (BSD)
+#   if BSD == 43
+      printf ("vax-dec-bsd4.3\n"); exit (0);
+#   else
+#    if BSD == 199006
+      printf ("vax-dec-bsd4.3reno\n"); exit (0);
+#    else
+      printf ("vax-dec-bsd\n"); exit (0);
+#    endif
+#   endif
+#  else
+    printf ("vax-dec-bsd\n"); exit (0);
+#  endif
+# else
+    printf ("vax-dec-ultrix\n"); exit (0);
+# endif
+#endif
+
+#if defined (alliant) && defined (i860)
+  printf ("i860-alliant-bsd\n"); exit (0);
+#endif
+
+  exit (1);
+}
+EOF
+
+$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` &&
+	{ echo "$SYSTEM_NAME"; exit; }
+
+# Apollos put the system type in the environment.
+
+test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; }
+
+# Convex versions that predate uname can use getsysinfo(1)
+
+if [ -x /usr/convex/getsysinfo ]
+then
+    case `getsysinfo -f cpu_type` in
+    c1*)
+	echo c1-convex-bsd
+	exit ;;
+    c2*)
+	if getsysinfo -f scalar_acc
+	then echo c32-convex-bsd
+	else echo c2-convex-bsd
+	fi
+	exit ;;
+    c34*)
+	echo c34-convex-bsd
+	exit ;;
+    c38*)
+	echo c38-convex-bsd
+	exit ;;
+    c4*)
+	echo c4-convex-bsd
+	exit ;;
+    esac
+fi
+
+cat >&2 <<EOF
+$0: unable to guess system type
+
+This script, last modified $timestamp, has failed to recognize
+the operating system you are using. It is advised that you
+download the most up to date version of the config scripts from
+
+  http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD
+and
+  http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD
+
+If the version you run ($0) is already up to date, please
+send the following data and any information you think might be
+pertinent to <config-patches@gnu.org> in order to provide the needed
+information to handle your system.
+
+config.guess timestamp = $timestamp
+
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null`
+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null`
+
+hostinfo               = `(hostinfo) 2>/dev/null`
+/bin/universe          = `(/bin/universe) 2>/dev/null`
+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null`
+/bin/arch              = `(/bin/arch) 2>/dev/null`
+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null`
+
+UNAME_MACHINE = ${UNAME_MACHINE}
+UNAME_RELEASE = ${UNAME_RELEASE}
+UNAME_SYSTEM  = ${UNAME_SYSTEM}
+UNAME_VERSION = ${UNAME_VERSION}
+EOF
+
+exit 1
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%:y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
diff --git a/rtsPOSIX/config.h.in b/rtsPOSIX/config.h.in
new file mode 100644
--- /dev/null
+++ b/rtsPOSIX/config.h.in
@@ -0,0 +1,69 @@
+/* Define to 1 if you have the `gettimeofday' function. */
+#undef HAVE_GETTIMEOFDAY
+
+/* Define to 1 if you have the <inttypes.h> header file. */
+#undef HAVE_INTTYPES_H
+
+/* Define to 1 if your system has a GNU libc compatible `malloc' function, and
+   to 0 otherwise. */
+#undef HAVE_MALLOC
+
+/* Define to 1 if you have the <memory.h> header file. */
+#undef HAVE_MEMORY_H
+
+/* Define to 1 if you have the <stdint.h> header file. */
+#undef HAVE_STDINT_H
+
+/* Define to 1 if you have the <stdlib.h> header file. */
+#undef HAVE_STDLIB_H
+
+/* Define to 1 if you have the <strings.h> header file. */
+#undef HAVE_STRINGS_H
+
+/* Define to 1 if you have the <string.h> header file. */
+#undef HAVE_STRING_H
+
+/* Define to 1 if you have the <sys/stat.h> header file. */
+#undef HAVE_SYS_STAT_H
+
+/* Define to 1 if you have the <sys/time.h> header file. */
+#undef HAVE_SYS_TIME_H
+
+/* Define to 1 if you have the <sys/types.h> header file. */
+#undef HAVE_SYS_TYPES_H
+
+/* Define to 1 if you have the <termios.h> header file. */
+#undef HAVE_TERMIOS_H
+
+/* Define to 1 if you have the <unistd.h> header file. */
+#undef HAVE_UNISTD_H
+
+/* Define to the address where bug reports for this package should be sent. */
+#undef PACKAGE_BUGREPORT
+
+/* Define to the full name of this package. */
+#undef PACKAGE_NAME
+
+/* Define to the full name and version of this package. */
+#undef PACKAGE_STRING
+
+/* Define to the one symbol short name of this package. */
+#undef PACKAGE_TARNAME
+
+/* Define to the version of this package. */
+#undef PACKAGE_VERSION
+
+/* Define to 1 if you have the ANSI C header files. */
+#undef STDC_HEADERS
+
+/* Define to 1 if you can safely include both <sys/time.h> and <time.h>. */
+#undef TIME_WITH_SYS_TIME
+
+/* Define to rpl_malloc if the replacement function should be used. */
+#undef malloc
+
+/* Define if we have atomic ops */
+#undef HAVE_BUILTIN_ATOMIC
+
+/* Define if we have atomic ops on OSX */
+#undef HAVE_OSX_ATOMICS
diff --git a/rtsPOSIX/config.sub b/rtsPOSIX/config.sub
new file mode 100644
--- /dev/null
+++ b/rtsPOSIX/config.sub
@@ -0,0 +1,1658 @@
+#! /bin/sh
+# Configuration validation subroutine script.
+#   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+#   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+#   Free Software Foundation, Inc.
+
+timestamp='2008-01-16'
+
+# This file is (in principle) common to ALL GNU software.
+# The presence of a machine in this file suggests that SOME GNU software
+# can handle that machine.  It does not imply ALL GNU software can.
+#
+# This file is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
+# 02110-1301, USA.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+
+# Please send patches to <config-patches@gnu.org>.  Submit a context
+# diff and a properly formatted ChangeLog entry.
+#
+# Configuration subroutine to validate and canonicalize a configuration type.
+# Supply the specified configuration type as an argument.
+# If it is invalid, we print an error message on stderr and exit with code 1.
+# Otherwise, we print the canonical config type on stdout and succeed.
+
+# This file is supposed to be the same for all GNU packages
+# and recognize all the CPU types, system types and aliases
+# that are meaningful with *any* GNU software.
+# Each package is responsible for reporting which valid configurations
+# it does not support.  The user should be able to distinguish
+# a failure to support a valid configuration from a meaningless
+# configuration.
+
+# The goal of this file is to map all the various variations of a given
+# machine specification into a single specification in the form:
+#	CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
+# or in some cases, the newer four-part form:
+#	CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
+# It is wrong to echo any other type of specification.
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION] CPU-MFR-OPSYS
+       $0 [OPTION] ALIAS
+
+Canonicalize a configuration name.
+
+Operation modes:
+  -h, --help         print this help, then exit
+  -t, --time-stamp   print date of last modification, then exit
+  -v, --version      print version number, then exit
+
+Report bugs and patches to <config-patches@gnu.org>."
+
+version="\
+GNU config.sub ($timestamp)
+
+Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
+2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+
+This is free software; see the source for copying conditions.  There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+
+help="
+Try \`$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+  case $1 in
+    --time-stamp | --time* | -t )
+       echo "$timestamp" ; exit ;;
+    --version | -v )
+       echo "$version" ; exit ;;
+    --help | --h* | -h )
+       echo "$usage"; exit ;;
+    -- )     # Stop option processing
+       shift; break ;;
+    - )	# Use stdin as input.
+       break ;;
+    -* )
+       echo "$me: invalid option $1$help"
+       exit 1 ;;
+
+    *local*)
+       # First pass through any local machine types.
+       echo $1
+       exit ;;
+
+    * )
+       break ;;
+  esac
+done
+
+case $# in
+ 0) echo "$me: missing argument$help" >&2
+    exit 1;;
+ 1) ;;
+ *) echo "$me: too many arguments$help" >&2
+    exit 1;;
+esac
+
+# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).
+# Here we must recognize all the valid KERNEL-OS combinations.
+maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
+case $maybe_os in
+  nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \
+  uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \
+  storm-chaos* | os2-emx* | rtmk-nova*)
+    os=-$maybe_os
+    basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
+    ;;
+  *)
+    basic_machine=`echo $1 | sed 's/-[^-]*$//'`
+    if [ $basic_machine != $1 ]
+    then os=`echo $1 | sed 's/.*-/-/'`
+    else os=; fi
+    ;;
+esac
+
+### Let's recognize common machines as not being operating systems so
+### that things like config.sub decstation-3100 work.  We also
+### recognize some manufacturers as not being operating systems, so we
+### can provide default operating systems below.
+case $os in
+	-sun*os*)
+		# Prevent following clause from handling this invalid input.
+		;;
+	-dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \
+	-att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \
+	-unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \
+	-convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
+	-c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
+	-harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
+	-apple | -axis | -knuth | -cray)
+		os=
+		basic_machine=$1
+		;;
+	-sim | -cisco | -oki | -wec | -winbond)
+		os=
+		basic_machine=$1
+		;;
+	-scout)
+		;;
+	-wrs)
+		os=-vxworks
+		basic_machine=$1
+		;;
+	-chorusos*)
+		os=-chorusos
+		basic_machine=$1
+		;;
+ 	-chorusrdb)
+ 		os=-chorusrdb
+		basic_machine=$1
+ 		;;
+	-hiux*)
+		os=-hiuxwe2
+		;;
+	-sco6)
+		os=-sco5v6
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco5)
+		os=-sco3.2v5
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco4)
+		os=-sco3.2v4
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco3.2.[4-9]*)
+		os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco3.2v[4-9]*)
+		# Don't forget version if it is 3.2v4 or newer.
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco5v6*)
+		# Don't forget version if it is 3.2v4 or newer.
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-sco*)
+		os=-sco3.2v2
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-udk*)
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-isc)
+		os=-isc2.2
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-clix*)
+		basic_machine=clipper-intergraph
+		;;
+	-isc*)
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+		;;
+	-lynx*)
+		os=-lynxos
+		;;
+	-ptx*)
+		basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
+		;;
+	-windowsnt*)
+		os=`echo $os | sed -e 's/windowsnt/winnt/'`
+		;;
+	-psos*)
+		os=-psos
+		;;
+	-mint | -mint[0-9]*)
+		basic_machine=m68k-atari
+		os=-mint
+		;;
+esac
+
+# Decode aliases for certain CPU-COMPANY combinations.
+case $basic_machine in
+	# Recognize the basic CPU types without company name.
+	# Some are omitted here because they have special meanings below.
+	1750a | 580 \
+	| a29k \
+	| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
+	| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \
+	| am33_2.0 \
+	| arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \
+	| bfin \
+	| c4x | clipper \
+	| d10v | d30v | dlx | dsp16xx \
+	| fido | fr30 | frv \
+	| h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
+	| i370 | i860 | i960 | ia64 \
+	| ip2k | iq2000 \
+	| m32c | m32r | m32rle | m68000 | m68k | m88k \
+	| maxq | mb | microblaze | mcore | mep \
+	| mips | mipsbe | mipseb | mipsel | mipsle \
+	| mips16 \
+	| mips64 | mips64el \
+	| mips64vr | mips64vrel \
+	| mips64orion | mips64orionel \
+	| mips64vr4100 | mips64vr4100el \
+	| mips64vr4300 | mips64vr4300el \
+	| mips64vr5000 | mips64vr5000el \
+	| mips64vr5900 | mips64vr5900el \
+	| mipsisa32 | mipsisa32el \
+	| mipsisa32r2 | mipsisa32r2el \
+	| mipsisa64 | mipsisa64el \
+	| mipsisa64r2 | mipsisa64r2el \
+	| mipsisa64sb1 | mipsisa64sb1el \
+	| mipsisa64sr71k | mipsisa64sr71kel \
+	| mipstx39 | mipstx39el \
+	| mn10200 | mn10300 \
+	| mt \
+	| msp430 \
+	| nios | nios2 \
+	| ns16k | ns32k \
+	| or32 \
+	| pdp10 | pdp11 | pj | pjl \
+	| powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \
+	| pyramid \
+	| score \
+	| sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \
+	| sh64 | sh64le \
+	| sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \
+	| sparcv8 | sparcv9 | sparcv9b | sparcv9v \
+	| spu | strongarm \
+	| tahoe | thumb | tic4x | tic80 | tron \
+	| v850 | v850e \
+	| we32k \
+	| x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \
+	| z8k)
+		basic_machine=$basic_machine-unknown
+		;;
+	m6811 | m68hc11 | m6812 | m68hc12)
+		# Motorola 68HC11/12.
+		basic_machine=$basic_machine-unknown
+		os=-none
+		;;
+	m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k)
+		;;
+	ms1)
+		basic_machine=mt-unknown
+		;;
+
+	# We use `pc' rather than `unknown'
+	# because (1) that's what they normally are, and
+	# (2) the word "unknown" tends to confuse beginning users.
+	i*86 | x86_64)
+	  basic_machine=$basic_machine-pc
+	  ;;
+	# Object if more than one company name word.
+	*-*-*)
+		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+		exit 1
+		;;
+	# Recognize the basic CPU types with company name.
+	580-* \
+	| a29k-* \
+	| alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
+	| alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
+	| alphapca5[67]-* | alpha64pca5[67]-* | arc-* \
+	| arm-*  | armbe-* | armle-* | armeb-* | armv*-* \
+	| avr-* | avr32-* \
+	| bfin-* | bs2000-* \
+	| c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \
+	| clipper-* | craynv-* | cydra-* \
+	| d10v-* | d30v-* | dlx-* \
+	| elxsi-* \
+	| f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \
+	| h8300-* | h8500-* \
+	| hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
+	| i*86-* | i860-* | i960-* | ia64-* \
+	| ip2k-* | iq2000-* \
+	| m32c-* | m32r-* | m32rle-* \
+	| m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
+	| m88110-* | m88k-* | maxq-* | mcore-* \
+	| mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
+	| mips16-* \
+	| mips64-* | mips64el-* \
+	| mips64vr-* | mips64vrel-* \
+	| mips64orion-* | mips64orionel-* \
+	| mips64vr4100-* | mips64vr4100el-* \
+	| mips64vr4300-* | mips64vr4300el-* \
+	| mips64vr5000-* | mips64vr5000el-* \
+	| mips64vr5900-* | mips64vr5900el-* \
+	| mipsisa32-* | mipsisa32el-* \
+	| mipsisa32r2-* | mipsisa32r2el-* \
+	| mipsisa64-* | mipsisa64el-* \
+	| mipsisa64r2-* | mipsisa64r2el-* \
+	| mipsisa64sb1-* | mipsisa64sb1el-* \
+	| mipsisa64sr71k-* | mipsisa64sr71kel-* \
+	| mipstx39-* | mipstx39el-* \
+	| mmix-* \
+	| mt-* \
+	| msp430-* \
+	| nios-* | nios2-* \
+	| none-* | np1-* | ns16k-* | ns32k-* \
+	| orion-* \
+	| pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
+	| powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \
+	| pyramid-* \
+	| romp-* | rs6000-* \
+	| sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \
+	| shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \
+	| sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \
+	| sparclite-* \
+	| sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \
+	| tahoe-* | thumb-* \
+	| tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \
+	| tron-* \
+	| v850-* | v850e-* | vax-* \
+	| we32k-* \
+	| x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \
+	| xstormy16-* | xtensa*-* \
+	| ymp-* \
+	| z8k-*)
+		;;
+	# Recognize the basic CPU types without company name, with glob match.
+	xtensa*)
+		basic_machine=$basic_machine-unknown
+		;;
+	# Recognize the various machine names and aliases which stand
+	# for a CPU type and a company and sometimes even an OS.
+	386bsd)
+		basic_machine=i386-unknown
+		os=-bsd
+		;;
+	3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
+		basic_machine=m68000-att
+		;;
+	3b*)
+		basic_machine=we32k-att
+		;;
+	a29khif)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+    	abacus)
+		basic_machine=abacus-unknown
+		;;
+	adobe68k)
+		basic_machine=m68010-adobe
+		os=-scout
+		;;
+	alliant | fx80)
+		basic_machine=fx80-alliant
+		;;
+	altos | altos3068)
+		basic_machine=m68k-altos
+		;;
+	am29k)
+		basic_machine=a29k-none
+		os=-bsd
+		;;
+	amd64)
+		basic_machine=x86_64-pc
+		;;
+	amd64-*)
+		basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	amdahl)
+		basic_machine=580-amdahl
+		os=-sysv
+		;;
+	amiga | amiga-*)
+		basic_machine=m68k-unknown
+		;;
+	amigaos | amigados)
+		basic_machine=m68k-unknown
+		os=-amigaos
+		;;
+	amigaunix | amix)
+		basic_machine=m68k-unknown
+		os=-sysv4
+		;;
+	apollo68)
+		basic_machine=m68k-apollo
+		os=-sysv
+		;;
+	apollo68bsd)
+		basic_machine=m68k-apollo
+		os=-bsd
+		;;
+	aux)
+		basic_machine=m68k-apple
+		os=-aux
+		;;
+	balance)
+		basic_machine=ns32k-sequent
+		os=-dynix
+		;;
+	blackfin)
+		basic_machine=bfin-unknown
+		os=-linux
+		;;
+	blackfin-*)
+		basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'`
+		os=-linux
+		;;
+	c90)
+		basic_machine=c90-cray
+		os=-unicos
+		;;
+	convex-c1)
+		basic_machine=c1-convex
+		os=-bsd
+		;;
+	convex-c2)
+		basic_machine=c2-convex
+		os=-bsd
+		;;
+	convex-c32)
+		basic_machine=c32-convex
+		os=-bsd
+		;;
+	convex-c34)
+		basic_machine=c34-convex
+		os=-bsd
+		;;
+	convex-c38)
+		basic_machine=c38-convex
+		os=-bsd
+		;;
+	cray | j90)
+		basic_machine=j90-cray
+		os=-unicos
+		;;
+	craynv)
+		basic_machine=craynv-cray
+		os=-unicosmp
+		;;
+	cr16)
+		basic_machine=cr16-unknown
+		os=-elf
+		;;
+	crds | unos)
+		basic_machine=m68k-crds
+		;;
+	crisv32 | crisv32-* | etraxfs*)
+		basic_machine=crisv32-axis
+		;;
+	cris | cris-* | etrax*)
+		basic_machine=cris-axis
+		;;
+	crx)
+		basic_machine=crx-unknown
+		os=-elf
+		;;
+	da30 | da30-*)
+		basic_machine=m68k-da30
+		;;
+	decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
+		basic_machine=mips-dec
+		;;
+	decsystem10* | dec10*)
+		basic_machine=pdp10-dec
+		os=-tops10
+		;;
+	decsystem20* | dec20*)
+		basic_machine=pdp10-dec
+		os=-tops20
+		;;
+	delta | 3300 | motorola-3300 | motorola-delta \
+	      | 3300-motorola | delta-motorola)
+		basic_machine=m68k-motorola
+		;;
+	delta88)
+		basic_machine=m88k-motorola
+		os=-sysv3
+		;;
+	djgpp)
+		basic_machine=i586-pc
+		os=-msdosdjgpp
+		;;
+	dpx20 | dpx20-*)
+		basic_machine=rs6000-bull
+		os=-bosx
+		;;
+	dpx2* | dpx2*-bull)
+		basic_machine=m68k-bull
+		os=-sysv3
+		;;
+	ebmon29k)
+		basic_machine=a29k-amd
+		os=-ebmon
+		;;
+	elxsi)
+		basic_machine=elxsi-elxsi
+		os=-bsd
+		;;
+	encore | umax | mmax)
+		basic_machine=ns32k-encore
+		;;
+	es1800 | OSE68k | ose68k | ose | OSE)
+		basic_machine=m68k-ericsson
+		os=-ose
+		;;
+	fx2800)
+		basic_machine=i860-alliant
+		;;
+	genix)
+		basic_machine=ns32k-ns
+		;;
+	gmicro)
+		basic_machine=tron-gmicro
+		os=-sysv
+		;;
+	go32)
+		basic_machine=i386-pc
+		os=-go32
+		;;
+	h3050r* | hiux*)
+		basic_machine=hppa1.1-hitachi
+		os=-hiuxwe2
+		;;
+	h8300hms)
+		basic_machine=h8300-hitachi
+		os=-hms
+		;;
+	h8300xray)
+		basic_machine=h8300-hitachi
+		os=-xray
+		;;
+	h8500hms)
+		basic_machine=h8500-hitachi
+		os=-hms
+		;;
+	harris)
+		basic_machine=m88k-harris
+		os=-sysv3
+		;;
+	hp300-*)
+		basic_machine=m68k-hp
+		;;
+	hp300bsd)
+		basic_machine=m68k-hp
+		os=-bsd
+		;;
+	hp300hpux)
+		basic_machine=m68k-hp
+		os=-hpux
+		;;
+	hp3k9[0-9][0-9] | hp9[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hp9k2[0-9][0-9] | hp9k31[0-9])
+		basic_machine=m68000-hp
+		;;
+	hp9k3[2-9][0-9])
+		basic_machine=m68k-hp
+		;;
+	hp9k6[0-9][0-9] | hp6[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hp9k7[0-79][0-9] | hp7[0-79][0-9])
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k78[0-9] | hp78[0-9])
+		# FIXME: really hppa2.0-hp
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
+		# FIXME: really hppa2.0-hp
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k8[0-9][13679] | hp8[0-9][13679])
+		basic_machine=hppa1.1-hp
+		;;
+	hp9k8[0-9][0-9] | hp8[0-9][0-9])
+		basic_machine=hppa1.0-hp
+		;;
+	hppa-next)
+		os=-nextstep3
+		;;
+	hppaosf)
+		basic_machine=hppa1.1-hp
+		os=-osf
+		;;
+	hppro)
+		basic_machine=hppa1.1-hp
+		os=-proelf
+		;;
+	i370-ibm* | ibm*)
+		basic_machine=i370-ibm
+		;;
+# I'm not sure what "Sysv32" means.  Should this be sysv3.2?
+	i*86v32)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-sysv32
+		;;
+	i*86v4*)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-sysv4
+		;;
+	i*86v)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-sysv
+		;;
+	i*86sol2)
+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+		os=-solaris2
+		;;
+	i386mach)
+		basic_machine=i386-mach
+		os=-mach
+		;;
+	i386-vsta | vsta)
+		basic_machine=i386-unknown
+		os=-vsta
+		;;
+	iris | iris4d)
+		basic_machine=mips-sgi
+		case $os in
+		    -irix*)
+			;;
+		    *)
+			os=-irix4
+			;;
+		esac
+		;;
+	isi68 | isi)
+		basic_machine=m68k-isi
+		os=-sysv
+		;;
+	m68knommu)
+		basic_machine=m68k-unknown
+		os=-linux
+		;;
+	m68knommu-*)
+		basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'`
+		os=-linux
+		;;
+	m88k-omron*)
+		basic_machine=m88k-omron
+		;;
+	magnum | m3230)
+		basic_machine=mips-mips
+		os=-sysv
+		;;
+	merlin)
+		basic_machine=ns32k-utek
+		os=-sysv
+		;;
+	mingw32)
+		basic_machine=i386-pc
+		os=-mingw32
+		;;
+	mingw32ce)
+		basic_machine=arm-unknown
+		os=-mingw32ce
+		;;
+	miniframe)
+		basic_machine=m68000-convergent
+		;;
+	*mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)
+		basic_machine=m68k-atari
+		os=-mint
+		;;
+	mips3*-*)
+		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`
+		;;
+	mips3*)
+		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown
+		;;
+	monitor)
+		basic_machine=m68k-rom68k
+		os=-coff
+		;;
+	morphos)
+		basic_machine=powerpc-unknown
+		os=-morphos
+		;;
+	msdos)
+		basic_machine=i386-pc
+		os=-msdos
+		;;
+	ms1-*)
+		basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'`
+		;;
+	mvs)
+		basic_machine=i370-ibm
+		os=-mvs
+		;;
+	ncr3000)
+		basic_machine=i486-ncr
+		os=-sysv4
+		;;
+	netbsd386)
+		basic_machine=i386-unknown
+		os=-netbsd
+		;;
+	netwinder)
+		basic_machine=armv4l-rebel
+		os=-linux
+		;;
+	news | news700 | news800 | news900)
+		basic_machine=m68k-sony
+		os=-newsos
+		;;
+	news1000)
+		basic_machine=m68030-sony
+		os=-newsos
+		;;
+	news-3600 | risc-news)
+		basic_machine=mips-sony
+		os=-newsos
+		;;
+	necv70)
+		basic_machine=v70-nec
+		os=-sysv
+		;;
+	next | m*-next )
+		basic_machine=m68k-next
+		case $os in
+		    -nextstep* )
+			;;
+		    -ns2*)
+		      os=-nextstep2
+			;;
+		    *)
+		      os=-nextstep3
+			;;
+		esac
+		;;
+	nh3000)
+		basic_machine=m68k-harris
+		os=-cxux
+		;;
+	nh[45]000)
+		basic_machine=m88k-harris
+		os=-cxux
+		;;
+	nindy960)
+		basic_machine=i960-intel
+		os=-nindy
+		;;
+	mon960)
+		basic_machine=i960-intel
+		os=-mon960
+		;;
+	nonstopux)
+		basic_machine=mips-compaq
+		os=-nonstopux
+		;;
+	np1)
+		basic_machine=np1-gould
+		;;
+	nsr-tandem)
+		basic_machine=nsr-tandem
+		;;
+	op50n-* | op60c-*)
+		basic_machine=hppa1.1-oki
+		os=-proelf
+		;;
+	openrisc | openrisc-*)
+		basic_machine=or32-unknown
+		;;
+	os400)
+		basic_machine=powerpc-ibm
+		os=-os400
+		;;
+	OSE68000 | ose68000)
+		basic_machine=m68000-ericsson
+		os=-ose
+		;;
+	os68k)
+		basic_machine=m68k-none
+		os=-os68k
+		;;
+	pa-hitachi)
+		basic_machine=hppa1.1-hitachi
+		os=-hiuxwe2
+		;;
+	paragon)
+		basic_machine=i860-intel
+		os=-osf
+		;;
+	parisc)
+		basic_machine=hppa-unknown
+		os=-linux
+		;;
+	parisc-*)
+		basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'`
+		os=-linux
+		;;
+	pbd)
+		basic_machine=sparc-tti
+		;;
+	pbb)
+		basic_machine=m68k-tti
+		;;
+	pc532 | pc532-*)
+		basic_machine=ns32k-pc532
+		;;
+	pc98)
+		basic_machine=i386-pc
+		;;
+	pc98-*)
+		basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentium | p5 | k5 | k6 | nexgen | viac3)
+		basic_machine=i586-pc
+		;;
+	pentiumpro | p6 | 6x86 | athlon | athlon_*)
+		basic_machine=i686-pc
+		;;
+	pentiumii | pentium2 | pentiumiii | pentium3)
+		basic_machine=i686-pc
+		;;
+	pentium4)
+		basic_machine=i786-pc
+		;;
+	pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
+		basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentiumpro-* | p6-* | 6x86-* | athlon-*)
+		basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)
+		basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pentium4-*)
+		basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	pn)
+		basic_machine=pn-gould
+		;;
+	power)	basic_machine=power-ibm
+		;;
+	ppc)	basic_machine=powerpc-unknown
+		;;
+	ppc-*)	basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	ppcle | powerpclittle | ppc-le | powerpc-little)
+		basic_machine=powerpcle-unknown
+		;;
+	ppcle-* | powerpclittle-*)
+		basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	ppc64)	basic_machine=powerpc64-unknown
+		;;
+	ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	ppc64le | powerpc64little | ppc64-le | powerpc64-little)
+		basic_machine=powerpc64le-unknown
+		;;
+	ppc64le-* | powerpc64little-*)
+		basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'`
+		;;
+	ps2)
+		basic_machine=i386-ibm
+		;;
+	pw32)
+		basic_machine=i586-unknown
+		os=-pw32
+		;;
+	rdos)
+		basic_machine=i386-pc
+		os=-rdos
+		;;
+	rom68k)
+		basic_machine=m68k-rom68k
+		os=-coff
+		;;
+	rm[46]00)
+		basic_machine=mips-siemens
+		;;
+	rtpc | rtpc-*)
+		basic_machine=romp-ibm
+		;;
+	s390 | s390-*)
+		basic_machine=s390-ibm
+		;;
+	s390x | s390x-*)
+		basic_machine=s390x-ibm
+		;;
+	sa29200)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+	sb1)
+		basic_machine=mipsisa64sb1-unknown
+		;;
+	sb1el)
+		basic_machine=mipsisa64sb1el-unknown
+		;;
+	sde)
+		basic_machine=mipsisa32-sde
+		os=-elf
+		;;
+	sei)
+		basic_machine=mips-sei
+		os=-seiux
+		;;
+	sequent)
+		basic_machine=i386-sequent
+		;;
+	sh)
+		basic_machine=sh-hitachi
+		os=-hms
+		;;
+	sh5el)
+		basic_machine=sh5le-unknown
+		;;
+	sh64)
+		basic_machine=sh64-unknown
+		;;
+	sparclite-wrs | simso-wrs)
+		basic_machine=sparclite-wrs
+		os=-vxworks
+		;;
+	sps7)
+		basic_machine=m68k-bull
+		os=-sysv2
+		;;
+	spur)
+		basic_machine=spur-unknown
+		;;
+	st2000)
+		basic_machine=m68k-tandem
+		;;
+	stratus)
+		basic_machine=i860-stratus
+		os=-sysv4
+		;;
+	sun2)
+		basic_machine=m68000-sun
+		;;
+	sun2os3)
+		basic_machine=m68000-sun
+		os=-sunos3
+		;;
+	sun2os4)
+		basic_machine=m68000-sun
+		os=-sunos4
+		;;
+	sun3os3)
+		basic_machine=m68k-sun
+		os=-sunos3
+		;;
+	sun3os4)
+		basic_machine=m68k-sun
+		os=-sunos4
+		;;
+	sun4os3)
+		basic_machine=sparc-sun
+		os=-sunos3
+		;;
+	sun4os4)
+		basic_machine=sparc-sun
+		os=-sunos4
+		;;
+	sun4sol2)
+		basic_machine=sparc-sun
+		os=-solaris2
+		;;
+	sun3 | sun3-*)
+		basic_machine=m68k-sun
+		;;
+	sun4)
+		basic_machine=sparc-sun
+		;;
+	sun386 | sun386i | roadrunner)
+		basic_machine=i386-sun
+		;;
+	sv1)
+		basic_machine=sv1-cray
+		os=-unicos
+		;;
+	symmetry)
+		basic_machine=i386-sequent
+		os=-dynix
+		;;
+	t3e)
+		basic_machine=alphaev5-cray
+		os=-unicos
+		;;
+	t90)
+		basic_machine=t90-cray
+		os=-unicos
+		;;
+	tic54x | c54x*)
+		basic_machine=tic54x-unknown
+		os=-coff
+		;;
+	tic55x | c55x*)
+		basic_machine=tic55x-unknown
+		os=-coff
+		;;
+	tic6x | c6x*)
+		basic_machine=tic6x-unknown
+		os=-coff
+		;;
+	tile*)
+		basic_machine=tile-unknown
+		os=-linux-gnu
+		;;
+	tx39)
+		basic_machine=mipstx39-unknown
+		;;
+	tx39el)
+		basic_machine=mipstx39el-unknown
+		;;
+	toad1)
+		basic_machine=pdp10-xkl
+		os=-tops20
+		;;
+	tower | tower-32)
+		basic_machine=m68k-ncr
+		;;
+	tpf)
+		basic_machine=s390x-ibm
+		os=-tpf
+		;;
+	udi29k)
+		basic_machine=a29k-amd
+		os=-udi
+		;;
+	ultra3)
+		basic_machine=a29k-nyu
+		os=-sym1
+		;;
+	v810 | necv810)
+		basic_machine=v810-nec
+		os=-none
+		;;
+	vaxv)
+		basic_machine=vax-dec
+		os=-sysv
+		;;
+	vms)
+		basic_machine=vax-dec
+		os=-vms
+		;;
+	vpp*|vx|vx-*)
+		basic_machine=f301-fujitsu
+		;;
+	vxworks960)
+		basic_machine=i960-wrs
+		os=-vxworks
+		;;
+	vxworks68)
+		basic_machine=m68k-wrs
+		os=-vxworks
+		;;
+	vxworks29k)
+		basic_machine=a29k-wrs
+		os=-vxworks
+		;;
+	w65*)
+		basic_machine=w65-wdc
+		os=-none
+		;;
+	w89k-*)
+		basic_machine=hppa1.1-winbond
+		os=-proelf
+		;;
+	xbox)
+		basic_machine=i686-pc
+		os=-mingw32
+		;;
+	xps | xps100)
+		basic_machine=xps100-honeywell
+		;;
+	ymp)
+		basic_machine=ymp-cray
+		os=-unicos
+		;;
+	z8k-*-coff)
+		basic_machine=z8k-unknown
+		os=-sim
+		;;
+	none)
+		basic_machine=none-none
+		os=-none
+		;;
+
+# Here we handle the default manufacturer of certain CPU types.  It is in
+# some cases the only manufacturer, in others, it is the most popular.
+	w89k)
+		basic_machine=hppa1.1-winbond
+		;;
+	op50n)
+		basic_machine=hppa1.1-oki
+		;;
+	op60c)
+		basic_machine=hppa1.1-oki
+		;;
+	romp)
+		basic_machine=romp-ibm
+		;;
+	mmix)
+		basic_machine=mmix-knuth
+		;;
+	rs6000)
+		basic_machine=rs6000-ibm
+		;;
+	vax)
+		basic_machine=vax-dec
+		;;
+	pdp10)
+		# there are many clones, so DEC is not a safe bet
+		basic_machine=pdp10-unknown
+		;;
+	pdp11)
+		basic_machine=pdp11-dec
+		;;
+	we32k)
+		basic_machine=we32k-att
+		;;
+	sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele)
+		basic_machine=sh-unknown
+		;;
+	sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v)
+		basic_machine=sparc-sun
+		;;
+	cydra)
+		basic_machine=cydra-cydrome
+		;;
+	orion)
+		basic_machine=orion-highlevel
+		;;
+	orion105)
+		basic_machine=clipper-highlevel
+		;;
+	mac | mpw | mac-mpw)
+		basic_machine=m68k-apple
+		;;
+	pmac | pmac-mpw)
+		basic_machine=powerpc-apple
+		;;
+	*-unknown)
+		# Make sure to match an already-canonicalized machine name.
+		;;
+	*)
+		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+		exit 1
+		;;
+esac
+
+# Here we canonicalize certain aliases for manufacturers.
+case $basic_machine in
+	*-digital*)
+		basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`
+		;;
+	*-commodore*)
+		basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`
+		;;
+	*)
+		;;
+esac
+
+# Decode manufacturer-specific aliases for certain operating systems.
+
+if [ x"$os" != x"" ]
+then
+case $os in
+        # First match some system type aliases
+        # that might get confused with valid system types.
+	# -solaris* is a basic system type, with this one exception.
+	-solaris1 | -solaris1.*)
+		os=`echo $os | sed -e 's|solaris1|sunos4|'`
+		;;
+	-solaris)
+		os=-solaris2
+		;;
+	-svr4*)
+		os=-sysv4
+		;;
+	-unixware*)
+		os=-sysv4.2uw
+		;;
+	-gnu/linux*)
+		os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`
+		;;
+	# First accept the basic system types.
+	# The portable systems comes first.
+	# Each alternative MUST END IN A *, to match a version number.
+	# -sysv* is not here because it comes later, after sysvr4.
+	-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
+	      | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\
+	      | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \
+	      | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
+	      | -aos* \
+	      | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
+	      | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
+	      | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \
+	      | -openbsd* | -solidbsd* \
+	      | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \
+	      | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
+	      | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
+	      | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
+	      | -chorusos* | -chorusrdb* \
+	      | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
+	      | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \
+	      | -uxpv* | -beos* | -mpeix* | -udk* \
+	      | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \
+	      | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \
+	      | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \
+	      | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \
+	      | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \
+	      | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \
+	      | -skyos* | -haiku* | -rdos* | -toppers* | -drops*)
+	# Remember, each alternative MUST END IN *, to match a version number.
+		;;
+	-qnx*)
+		case $basic_machine in
+		    x86-* | i*86-*)
+			;;
+		    *)
+			os=-nto$os
+			;;
+		esac
+		;;
+	-nto-qnx*)
+		;;
+	-nto*)
+		os=`echo $os | sed -e 's|nto|nto-qnx|'`
+		;;
+	-sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
+	      | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \
+	      | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)
+		;;
+	-mac*)
+		os=`echo $os | sed -e 's|mac|macos|'`
+		;;
+	-linux-dietlibc)
+		os=-linux-dietlibc
+		;;
+	-linux*)
+		os=`echo $os | sed -e 's|linux|linux-gnu|'`
+		;;
+	-sunos5*)
+		os=`echo $os | sed -e 's|sunos5|solaris2|'`
+		;;
+	-sunos6*)
+		os=`echo $os | sed -e 's|sunos6|solaris3|'`
+		;;
+	-opened*)
+		os=-openedition
+		;;
+        -os400*)
+		os=-os400
+		;;
+	-wince*)
+		os=-wince
+		;;
+	-osfrose*)
+		os=-osfrose
+		;;
+	-osf*)
+		os=-osf
+		;;
+	-utek*)
+		os=-bsd
+		;;
+	-dynix*)
+		os=-bsd
+		;;
+	-acis*)
+		os=-aos
+		;;
+	-atheos*)
+		os=-atheos
+		;;
+	-syllable*)
+		os=-syllable
+		;;
+	-386bsd)
+		os=-bsd
+		;;
+	-ctix* | -uts*)
+		os=-sysv
+		;;
+	-nova*)
+		os=-rtmk-nova
+		;;
+	-ns2 )
+		os=-nextstep2
+		;;
+	-nsk*)
+		os=-nsk
+		;;
+	# Preserve the version number of sinix5.
+	-sinix5.*)
+		os=`echo $os | sed -e 's|sinix|sysv|'`
+		;;
+	-sinix*)
+		os=-sysv4
+		;;
+        -tpf*)
+		os=-tpf
+		;;
+	-triton*)
+		os=-sysv3
+		;;
+	-oss*)
+		os=-sysv3
+		;;
+	-svr4)
+		os=-sysv4
+		;;
+	-svr3)
+		os=-sysv3
+		;;
+	-sysvr4)
+		os=-sysv4
+		;;
+	# This must come after -sysvr4.
+	-sysv*)
+		;;
+	-ose*)
+		os=-ose
+		;;
+	-es1800*)
+		os=-ose
+		;;
+	-xenix)
+		os=-xenix
+		;;
+	-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
+		os=-mint
+		;;
+	-aros*)
+		os=-aros
+		;;
+	-kaos*)
+		os=-kaos
+		;;
+	-zvmoe)
+		os=-zvmoe
+		;;
+	-none)
+		;;
+	*)
+		# Get rid of the `-' at the beginning of $os.
+		os=`echo $os | sed 's/[^-]*-//'`
+		echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2
+		exit 1
+		;;
+esac
+else
+
+# Here we handle the default operating systems that come with various machines.
+# The value should be what the vendor currently ships out the door with their
+# machine or put another way, the most popular os provided with the machine.
+
+# Note that if you're going to try to match "-MANUFACTURER" here (say,
+# "-sun"), then you have to tell the case statement up towards the top
+# that MANUFACTURER isn't an operating system.  Otherwise, code above
+# will signal an error saying that MANUFACTURER isn't an operating
+# system, and we'll never get to this point.
+
+case $basic_machine in
+        score-*)
+		os=-elf
+		;;
+        spu-*)
+		os=-elf
+		;;
+	*-acorn)
+		os=-riscix1.2
+		;;
+	arm*-rebel)
+		os=-linux
+		;;
+	arm*-semi)
+		os=-aout
+		;;
+        c4x-* | tic4x-*)
+        	os=-coff
+		;;
+	# This must come before the *-dec entry.
+	pdp10-*)
+		os=-tops20
+		;;
+	pdp11-*)
+		os=-none
+		;;
+	*-dec | vax-*)
+		os=-ultrix4.2
+		;;
+	m68*-apollo)
+		os=-domain
+		;;
+	i386-sun)
+		os=-sunos4.0.2
+		;;
+	m68000-sun)
+		os=-sunos3
+		# This also exists in the configure program, but was not the
+		# default.
+		# os=-sunos4
+		;;
+	m68*-cisco)
+		os=-aout
+		;;
+        mep-*)
+		os=-elf
+		;;
+	mips*-cisco)
+		os=-elf
+		;;
+	mips*-*)
+		os=-elf
+		;;
+	or32-*)
+		os=-coff
+		;;
+	*-tti)	# must be before sparc entry or we get the wrong os.
+		os=-sysv3
+		;;
+	sparc-* | *-sun)
+		os=-sunos4.1.1
+		;;
+	*-be)
+		os=-beos
+		;;
+	*-haiku)
+		os=-haiku
+		;;
+	*-ibm)
+		os=-aix
+		;;
+    	*-knuth)
+		os=-mmixware
+		;;
+	*-wec)
+		os=-proelf
+		;;
+	*-winbond)
+		os=-proelf
+		;;
+	*-oki)
+		os=-proelf
+		;;
+	*-hp)
+		os=-hpux
+		;;
+	*-hitachi)
+		os=-hiux
+		;;
+	i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
+		os=-sysv
+		;;
+	*-cbm)
+		os=-amigaos
+		;;
+	*-dg)
+		os=-dgux
+		;;
+	*-dolphin)
+		os=-sysv3
+		;;
+	m68k-ccur)
+		os=-rtu
+		;;
+	m88k-omron*)
+		os=-luna
+		;;
+	*-next )
+		os=-nextstep
+		;;
+	*-sequent)
+		os=-ptx
+		;;
+	*-crds)
+		os=-unos
+		;;
+	*-ns)
+		os=-genix
+		;;
+	i370-*)
+		os=-mvs
+		;;
+	*-next)
+		os=-nextstep3
+		;;
+	*-gould)
+		os=-sysv
+		;;
+	*-highlevel)
+		os=-bsd
+		;;
+	*-encore)
+		os=-bsd
+		;;
+	*-sgi)
+		os=-irix
+		;;
+	*-siemens)
+		os=-sysv4
+		;;
+	*-masscomp)
+		os=-rtu
+		;;
+	f30[01]-fujitsu | f700-fujitsu)
+		os=-uxpv
+		;;
+	*-rom68k)
+		os=-coff
+		;;
+	*-*bug)
+		os=-coff
+		;;
+	*-apple)
+		os=-macos
+		;;
+	*-atari*)
+		os=-mint
+		;;
+	*)
+		os=-none
+		;;
+esac
+fi
+
+# Here we handle the case where we know the os, and the CPU type, but not the
+# manufacturer.  We pick the logical manufacturer.
+vendor=unknown
+case $basic_machine in
+	*-unknown)
+		case $os in
+			-riscix*)
+				vendor=acorn
+				;;
+			-sunos*)
+				vendor=sun
+				;;
+			-aix*)
+				vendor=ibm
+				;;
+			-beos*)
+				vendor=be
+				;;
+			-hpux*)
+				vendor=hp
+				;;
+			-mpeix*)
+				vendor=hp
+				;;
+			-hiux*)
+				vendor=hitachi
+				;;
+			-unos*)
+				vendor=crds
+				;;
+			-dgux*)
+				vendor=dg
+				;;
+			-luna*)
+				vendor=omron
+				;;
+			-genix*)
+				vendor=ns
+				;;
+			-mvs* | -opened*)
+				vendor=ibm
+				;;
+			-os400*)
+				vendor=ibm
+				;;
+			-ptx*)
+				vendor=sequent
+				;;
+			-tpf*)
+				vendor=ibm
+				;;
+			-vxsim* | -vxworks* | -windiss*)
+				vendor=wrs
+				;;
+			-aux*)
+				vendor=apple
+				;;
+			-hms*)
+				vendor=hitachi
+				;;
+			-mpw* | -macos*)
+				vendor=apple
+				;;
+			-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
+				vendor=atari
+				;;
+			-vos*)
+				vendor=stratus
+				;;
+		esac
+		basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
+		;;
+esac
+
+echo $basic_machine$os
+exit
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%:y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
diff --git a/rtsPOSIX/configure b/rtsPOSIX/configure
new file mode 100644
--- /dev/null
+++ b/rtsPOSIX/configure
@@ -0,0 +1,6122 @@
+#! /bin/sh
+# Guess values for system-dependent variables and create Makefiles.
+# Generated by GNU Autoconf 2.61 for rtsPOSIX 0.9.9.
+#
+# Report bugs to <nordland@csee.ltu.se>.
+#
+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
+# 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+## --------------------- ##
+## M4sh Initialization.  ##
+## --------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+  emulate sh
+  NULLCMD=:
+  # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in
+  *posix*) set -o posix ;;
+esac
+
+fi
+
+
+
+
+# PATH needs CR
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+  echo "#! /bin/sh" >conf$$.sh
+  echo  "exit 0"   >>conf$$.sh
+  chmod +x conf$$.sh
+  if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+    PATH_SEPARATOR=';'
+  else
+    PATH_SEPARATOR=:
+  fi
+  rm -f conf$$.sh
+fi
+
+# Support unset when possible.
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+  as_unset=unset
+else
+  as_unset=false
+fi
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.  Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+as_nl='
+'
+IFS=" ""	$as_nl"
+
+# Find who we are.  Look in the path if we contain no directory separator.
+case $0 in
+  *[\\/]* ) as_myself=$0 ;;
+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+IFS=$as_save_IFS
+
+     ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+  as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+  echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+  { (exit 1); exit 1; }
+fi
+
+# Work around bugs in pre-3.0 UWIN ksh.
+for as_var in ENV MAIL MAILPATH
+do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var
+done
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+for as_var in \
+  LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+  LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+  LC_TELEPHONE LC_TIME
+do
+  if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
+    eval $as_var=C; export $as_var
+  else
+    ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var
+  fi
+done
+
+# Required to use basename.
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+   test "X`expr 00001 : '.*\(...\)'`" = X001; then
+  as_expr=expr
+else
+  as_expr=false
+fi
+
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
+  as_basename=basename
+else
+  as_basename=false
+fi
+
+
+# Name of the executable.
+as_me=`$as_basename -- "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+	 X"$0" : 'X\(//\)$' \| \
+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+echo X/"$0" |
+    sed '/^.*\/\([^/][^/]*\)\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+
+# CDPATH.
+$as_unset CDPATH
+
+
+if test "x$CONFIG_SHELL" = x; then
+  if (eval ":") 2>/dev/null; then
+  as_have_required=yes
+else
+  as_have_required=no
+fi
+
+  if test $as_have_required = yes && 	 (eval ":
+(as_func_return () {
+  (exit \$1)
+}
+as_func_success () {
+  as_func_return 0
+}
+as_func_failure () {
+  as_func_return 1
+}
+as_func_ret_success () {
+  return 0
+}
+as_func_ret_failure () {
+  return 1
+}
+
+exitcode=0
+if as_func_success; then
+  :
+else
+  exitcode=1
+  echo as_func_success failed.
+fi
+
+if as_func_failure; then
+  exitcode=1
+  echo as_func_failure succeeded.
+fi
+
+if as_func_ret_success; then
+  :
+else
+  exitcode=1
+  echo as_func_ret_success failed.
+fi
+
+if as_func_ret_failure; then
+  exitcode=1
+  echo as_func_ret_failure succeeded.
+fi
+
+if ( set x; as_func_ret_success y && test x = \"\$1\" ); then
+  :
+else
+  exitcode=1
+  echo positional parameters were not saved.
+fi
+
+test \$exitcode = 0) || { (exit 1); exit 1; }
+
+(
+  as_lineno_1=\$LINENO
+  as_lineno_2=\$LINENO
+  test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" &&
+  test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; }
+") 2> /dev/null; then
+  :
+else
+  as_candidate_shells=
+    as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  case $as_dir in
+	 /*)
+	   for as_base in sh bash ksh sh5; do
+	     as_candidate_shells="$as_candidate_shells $as_dir/$as_base"
+	   done;;
+       esac
+done
+IFS=$as_save_IFS
+
+
+      for as_shell in $as_candidate_shells $SHELL; do
+	 # Try only shells that exist, to save several forks.
+	 if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
+		{ ("$as_shell") 2> /dev/null <<\_ASEOF
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+  emulate sh
+  NULLCMD=:
+  # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in
+  *posix*) set -o posix ;;
+esac
+
+fi
+
+
+:
+_ASEOF
+}; then
+  CONFIG_SHELL=$as_shell
+	       as_have_required=yes
+	       if { "$as_shell" 2> /dev/null <<\_ASEOF
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+  emulate sh
+  NULLCMD=:
+  # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in
+  *posix*) set -o posix ;;
+esac
+
+fi
+
+
+:
+(as_func_return () {
+  (exit $1)
+}
+as_func_success () {
+  as_func_return 0
+}
+as_func_failure () {
+  as_func_return 1
+}
+as_func_ret_success () {
+  return 0
+}
+as_func_ret_failure () {
+  return 1
+}
+
+exitcode=0
+if as_func_success; then
+  :
+else
+  exitcode=1
+  echo as_func_success failed.
+fi
+
+if as_func_failure; then
+  exitcode=1
+  echo as_func_failure succeeded.
+fi
+
+if as_func_ret_success; then
+  :
+else
+  exitcode=1
+  echo as_func_ret_success failed.
+fi
+
+if as_func_ret_failure; then
+  exitcode=1
+  echo as_func_ret_failure succeeded.
+fi
+
+if ( set x; as_func_ret_success y && test x = "$1" ); then
+  :
+else
+  exitcode=1
+  echo positional parameters were not saved.
+fi
+
+test $exitcode = 0) || { (exit 1); exit 1; }
+
+(
+  as_lineno_1=$LINENO
+  as_lineno_2=$LINENO
+  test "x$as_lineno_1" != "x$as_lineno_2" &&
+  test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; }
+
+_ASEOF
+}; then
+  break
+fi
+
+fi
+
+      done
+
+      if test "x$CONFIG_SHELL" != x; then
+  for as_var in BASH_ENV ENV
+        do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var
+        done
+        export CONFIG_SHELL
+        exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"}
+fi
+
+
+    if test $as_have_required = no; then
+  echo This script requires a shell more modern than all the
+      echo shells that I found on your system.  Please install a
+      echo modern shell, or manually run the script under such a
+      echo shell if you do have one.
+      { (exit 1); exit 1; }
+fi
+
+
+fi
+
+fi
+
+
+
+(eval "as_func_return () {
+  (exit \$1)
+}
+as_func_success () {
+  as_func_return 0
+}
+as_func_failure () {
+  as_func_return 1
+}
+as_func_ret_success () {
+  return 0
+}
+as_func_ret_failure () {
+  return 1
+}
+
+exitcode=0
+if as_func_success; then
+  :
+else
+  exitcode=1
+  echo as_func_success failed.
+fi
+
+if as_func_failure; then
+  exitcode=1
+  echo as_func_failure succeeded.
+fi
+
+if as_func_ret_success; then
+  :
+else
+  exitcode=1
+  echo as_func_ret_success failed.
+fi
+
+if as_func_ret_failure; then
+  exitcode=1
+  echo as_func_ret_failure succeeded.
+fi
+
+if ( set x; as_func_ret_success y && test x = \"\$1\" ); then
+  :
+else
+  exitcode=1
+  echo positional parameters were not saved.
+fi
+
+test \$exitcode = 0") || {
+  echo No shell found that supports shell functions.
+  echo Please tell autoconf@gnu.org about your system,
+  echo including any error possibly output before this
+  echo message
+}
+
+
+
+  as_lineno_1=$LINENO
+  as_lineno_2=$LINENO
+  test "x$as_lineno_1" != "x$as_lineno_2" &&
+  test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || {
+
+  # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+  # uniformly replaced by the line number.  The first 'sed' inserts a
+  # line-number line after each line using $LINENO; the second 'sed'
+  # does the real work.  The second script uses 'N' to pair each
+  # line-number line with the line containing $LINENO, and appends
+  # trailing '-' during substitution so that $LINENO is not a special
+  # case at line end.
+  # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+  # scripts with optimization help from Paolo Bonzini.  Blame Lee
+  # E. McMahon (1931-1989) for sed's syntax.  :-)
+  sed -n '
+    p
+    /[$]LINENO/=
+  ' <$as_myself |
+    sed '
+      s/[$]LINENO.*/&-/
+      t lineno
+      b
+      :lineno
+      N
+      :loop
+      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
+      t loop
+      s/-\n.*//
+    ' >$as_me.lineno &&
+  chmod +x "$as_me.lineno" ||
+    { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
+   { (exit 1); exit 1; }; }
+
+  # Don't try to exec as it changes $[0], causing all sort of problems
+  # (the dirname of $[0] is not the place where we might find the
+  # original and so on.  Autoconf is especially sensitive to this).
+  . "./$as_me.lineno"
+  # Exit status is that of the last command.
+  exit
+}
+
+
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+  as_dirname=dirname
+else
+  as_dirname=false
+fi
+
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in
+-n*)
+  case `echo 'x\c'` in
+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
+  *)   ECHO_C='\c';;
+  esac;;
+*)
+  ECHO_N='-n';;
+esac
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+   test "X`expr 00001 : '.*\(...\)'`" = X001; then
+  as_expr=expr
+else
+  as_expr=false
+fi
+
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+  rm -f conf$$.dir/conf$$.file
+else
+  rm -f conf$$.dir
+  mkdir conf$$.dir
+fi
+echo >conf$$.file
+if ln -s conf$$.file conf$$ 2>/dev/null; then
+  as_ln_s='ln -s'
+  # ... but there are two gotchas:
+  # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+  # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+  # In both cases, we have to default to `cp -p'.
+  ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+    as_ln_s='cp -p'
+elif ln conf$$.file conf$$ 2>/dev/null; then
+  as_ln_s=ln
+else
+  as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
+
+if mkdir -p . 2>/dev/null; then
+  as_mkdir_p=:
+else
+  test -d ./-p && rmdir ./-p
+  as_mkdir_p=false
+fi
+
+if test -x / >/dev/null 2>&1; then
+  as_test_x='test -x'
+else
+  if ls -dL / >/dev/null 2>&1; then
+    as_ls_L_option=L
+  else
+    as_ls_L_option=
+  fi
+  as_test_x='
+    eval sh -c '\''
+      if test -d "$1"; then
+        test -d "$1/.";
+      else
+	case $1 in
+        -*)set "./$1";;
+	esac;
+	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in
+	???[sx]*):;;*)false;;esac;fi
+    '\'' sh
+  '
+fi
+as_executable_p=$as_test_x
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+
+exec 7<&0 </dev/null 6>&1
+
+# Name of the host.
+# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
+# so uname gets run too.
+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
+
+#
+# Initializations.
+#
+ac_default_prefix=/usr/local
+ac_clean_files=
+ac_config_libobj_dir=.
+LIBOBJS=
+cross_compiling=no
+subdirs=
+MFLAGS=
+MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+
+# Identity of this package.
+PACKAGE_NAME='rtsPOSIX'
+PACKAGE_TARNAME='rtsposix'
+PACKAGE_VERSION='0.9.9'
+PACKAGE_STRING='rtsPOSIX 0.9.9'
+PACKAGE_BUGREPORT='nordland@csee.ltu.se'
+
+ac_unique_file="main.c"
+# Factoring default headers for most tests.
+ac_includes_default="\
+#include <stdio.h>
+#ifdef HAVE_SYS_TYPES_H
+# include <sys/types.h>
+#endif
+#ifdef HAVE_SYS_STAT_H
+# include <sys/stat.h>
+#endif
+#ifdef STDC_HEADERS
+# include <stdlib.h>
+# include <stddef.h>
+#else
+# ifdef HAVE_STDLIB_H
+#  include <stdlib.h>
+# endif
+#endif
+#ifdef HAVE_STRING_H
+# if !defined STDC_HEADERS && defined HAVE_MEMORY_H
+#  include <memory.h>
+# endif
+# include <string.h>
+#endif
+#ifdef HAVE_STRINGS_H
+# include <strings.h>
+#endif
+#ifdef HAVE_INTTYPES_H
+# include <inttypes.h>
+#endif
+#ifdef HAVE_STDINT_H
+# include <stdint.h>
+#endif
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#endif"
+
+ac_subst_vars='SHELL
+PATH_SEPARATOR
+PACKAGE_NAME
+PACKAGE_TARNAME
+PACKAGE_VERSION
+PACKAGE_STRING
+PACKAGE_BUGREPORT
+exec_prefix
+prefix
+program_transform_name
+bindir
+sbindir
+libexecdir
+datarootdir
+datadir
+sysconfdir
+sharedstatedir
+localstatedir
+includedir
+oldincludedir
+docdir
+infodir
+htmldir
+dvidir
+pdfdir
+psdir
+libdir
+localedir
+mandir
+DEFS
+ECHO_C
+ECHO_N
+ECHO_T
+LIBS
+build_alias
+host_alias
+target_alias
+CC
+CFLAGS
+LDFLAGS
+CPPFLAGS
+ac_ct_CC
+EXEEXT
+OBJEXT
+INSTALL_PROGRAM
+INSTALL_SCRIPT
+INSTALL_DATA
+build
+build_cpu
+build_vendor
+build_os
+host
+host_cpu
+host_vendor
+host_os
+acx_pthread_config
+PTHREAD_CC
+PTHREAD_LIBS
+PTHREAD_CFLAGS
+TIMBERC
+CPP
+GREP
+EGREP
+LIBOBJS
+SRC
+DEST
+LTLIBOBJS'
+ac_subst_files=''
+      ac_precious_vars='build_alias
+host_alias
+target_alias
+CC
+CFLAGS
+LDFLAGS
+LIBS
+CPPFLAGS
+CPP'
+
+
+# Initialize some variables set by options.
+ac_init_help=
+ac_init_version=false
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+cache_file=/dev/null
+exec_prefix=NONE
+no_create=
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+verbose=
+x_includes=NONE
+x_libraries=NONE
+
+# Installation directory options.
+# These are left unexpanded so users can "make install exec_prefix=/foo"
+# and all the variables that are supposed to be based on exec_prefix
+# by default will actually change.
+# Use braces instead of parens because sh, perl, etc. also accept them.
+# (The list follows the same order as the GNU Coding Standards.)
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datarootdir='${prefix}/share'
+datadir='${datarootdir}'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
+infodir='${datarootdir}/info'
+htmldir='${docdir}'
+dvidir='${docdir}'
+pdfdir='${docdir}'
+psdir='${docdir}'
+libdir='${exec_prefix}/lib'
+localedir='${datarootdir}/locale'
+mandir='${datarootdir}/man'
+
+ac_prev=
+ac_dashdash=
+for ac_option
+do
+  # If the previous option needs an argument, assign it.
+  if test -n "$ac_prev"; then
+    eval $ac_prev=\$ac_option
+    ac_prev=
+    continue
+  fi
+
+  case $ac_option in
+  *=*)	ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
+  *)	ac_optarg=yes ;;
+  esac
+
+  # Accept the important Cygnus configure options, so we can diagnose typos.
+
+  case $ac_dashdash$ac_option in
+  --)
+    ac_dashdash=yes ;;
+
+  -bindir | --bindir | --bindi | --bind | --bin | --bi)
+    ac_prev=bindir ;;
+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+    bindir=$ac_optarg ;;
+
+  -build | --build | --buil | --bui | --bu)
+    ac_prev=build_alias ;;
+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+    build_alias=$ac_optarg ;;
+
+  -cache-file | --cache-file | --cache-fil | --cache-fi \
+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+    ac_prev=cache_file ;;
+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+    cache_file=$ac_optarg ;;
+
+  --config-cache | -C)
+    cache_file=config.cache ;;
+
+  -datadir | --datadir | --datadi | --datad)
+    ac_prev=datadir ;;
+  -datadir=* | --datadir=* | --datadi=* | --datad=*)
+    datadir=$ac_optarg ;;
+
+  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
+  | --dataroo | --dataro | --datar)
+    ac_prev=datarootdir ;;
+  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
+  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
+    datarootdir=$ac_optarg ;;
+
+  -disable-* | --disable-*)
+    ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_feature" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+      { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+   { (exit 1); exit 1; }; }
+    ac_feature=`echo $ac_feature | sed 's/[-.]/_/g'`
+    eval enable_$ac_feature=no ;;
+
+  -docdir | --docdir | --docdi | --doc | --do)
+    ac_prev=docdir ;;
+  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
+    docdir=$ac_optarg ;;
+
+  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
+    ac_prev=dvidir ;;
+  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
+    dvidir=$ac_optarg ;;
+
+  -enable-* | --enable-*)
+    ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_feature" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+      { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+   { (exit 1); exit 1; }; }
+    ac_feature=`echo $ac_feature | sed 's/[-.]/_/g'`
+    eval enable_$ac_feature=\$ac_optarg ;;
+
+  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+  | --exec | --exe | --ex)
+    ac_prev=exec_prefix ;;
+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+  | --exec=* | --exe=* | --ex=*)
+    exec_prefix=$ac_optarg ;;
+
+  -gas | --gas | --ga | --g)
+    # Obsolete; use --with-gas.
+    with_gas=yes ;;
+
+  -help | --help | --hel | --he | -h)
+    ac_init_help=long ;;
+  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
+    ac_init_help=recursive ;;
+  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
+    ac_init_help=short ;;
+
+  -host | --host | --hos | --ho)
+    ac_prev=host_alias ;;
+  -host=* | --host=* | --hos=* | --ho=*)
+    host_alias=$ac_optarg ;;
+
+  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
+    ac_prev=htmldir ;;
+  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
+  | --ht=*)
+    htmldir=$ac_optarg ;;
+
+  -includedir | --includedir | --includedi | --included | --include \
+  | --includ | --inclu | --incl | --inc)
+    ac_prev=includedir ;;
+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+  | --includ=* | --inclu=* | --incl=* | --inc=*)
+    includedir=$ac_optarg ;;
+
+  -infodir | --infodir | --infodi | --infod | --info | --inf)
+    ac_prev=infodir ;;
+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+    infodir=$ac_optarg ;;
+
+  -libdir | --libdir | --libdi | --libd)
+    ac_prev=libdir ;;
+  -libdir=* | --libdir=* | --libdi=* | --libd=*)
+    libdir=$ac_optarg ;;
+
+  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+  | --libexe | --libex | --libe)
+    ac_prev=libexecdir ;;
+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+  | --libexe=* | --libex=* | --libe=*)
+    libexecdir=$ac_optarg ;;
+
+  -localedir | --localedir | --localedi | --localed | --locale)
+    ac_prev=localedir ;;
+  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
+    localedir=$ac_optarg ;;
+
+  -localstatedir | --localstatedir | --localstatedi | --localstated \
+  | --localstate | --localstat | --localsta | --localst | --locals)
+    ac_prev=localstatedir ;;
+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
+    localstatedir=$ac_optarg ;;
+
+  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+    ac_prev=mandir ;;
+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+    mandir=$ac_optarg ;;
+
+  -nfp | --nfp | --nf)
+    # Obsolete; use --without-fp.
+    with_fp=no ;;
+
+  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+  | --no-cr | --no-c | -n)
+    no_create=yes ;;
+
+  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+    no_recursion=yes ;;
+
+  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+  | --oldin | --oldi | --old | --ol | --o)
+    ac_prev=oldincludedir ;;
+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+    oldincludedir=$ac_optarg ;;
+
+  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+    ac_prev=prefix ;;
+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+    prefix=$ac_optarg ;;
+
+  -program-prefix | --program-prefix | --program-prefi | --program-pref \
+  | --program-pre | --program-pr | --program-p)
+    ac_prev=program_prefix ;;
+  -program-prefix=* | --program-prefix=* | --program-prefi=* \
+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+    program_prefix=$ac_optarg ;;
+
+  -program-suffix | --program-suffix | --program-suffi | --program-suff \
+  | --program-suf | --program-su | --program-s)
+    ac_prev=program_suffix ;;
+  -program-suffix=* | --program-suffix=* | --program-suffi=* \
+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+    program_suffix=$ac_optarg ;;
+
+  -program-transform-name | --program-transform-name \
+  | --program-transform-nam | --program-transform-na \
+  | --program-transform-n | --program-transform- \
+  | --program-transform | --program-transfor \
+  | --program-transfo | --program-transf \
+  | --program-trans | --program-tran \
+  | --progr-tra | --program-tr | --program-t)
+    ac_prev=program_transform_name ;;
+  -program-transform-name=* | --program-transform-name=* \
+  | --program-transform-nam=* | --program-transform-na=* \
+  | --program-transform-n=* | --program-transform-=* \
+  | --program-transform=* | --program-transfor=* \
+  | --program-transfo=* | --program-transf=* \
+  | --program-trans=* | --program-tran=* \
+  | --progr-tra=* | --program-tr=* | --program-t=*)
+    program_transform_name=$ac_optarg ;;
+
+  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
+    ac_prev=pdfdir ;;
+  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
+    pdfdir=$ac_optarg ;;
+
+  -psdir | --psdir | --psdi | --psd | --ps)
+    ac_prev=psdir ;;
+  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
+    psdir=$ac_optarg ;;
+
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil)
+    silent=yes ;;
+
+  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+    ac_prev=sbindir ;;
+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+  | --sbi=* | --sb=*)
+    sbindir=$ac_optarg ;;
+
+  -sharedstatedir | --sharedstatedir | --sharedstatedi \
+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+  | --sharedst | --shareds | --shared | --share | --shar \
+  | --sha | --sh)
+    ac_prev=sharedstatedir ;;
+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+  | --sha=* | --sh=*)
+    sharedstatedir=$ac_optarg ;;
+
+  -site | --site | --sit)
+    ac_prev=site ;;
+  -site=* | --site=* | --sit=*)
+    site=$ac_optarg ;;
+
+  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+    ac_prev=srcdir ;;
+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+    srcdir=$ac_optarg ;;
+
+  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+  | --syscon | --sysco | --sysc | --sys | --sy)
+    ac_prev=sysconfdir ;;
+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+    sysconfdir=$ac_optarg ;;
+
+  -target | --target | --targe | --targ | --tar | --ta | --t)
+    ac_prev=target_alias ;;
+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+    target_alias=$ac_optarg ;;
+
+  -v | -verbose | --verbose | --verbos | --verbo | --verb)
+    verbose=yes ;;
+
+  -version | --version | --versio | --versi | --vers | -V)
+    ac_init_version=: ;;
+
+  -with-* | --with-*)
+    ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_package" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+      { echo "$as_me: error: invalid package name: $ac_package" >&2
+   { (exit 1); exit 1; }; }
+    ac_package=`echo $ac_package | sed 's/[-.]/_/g'`
+    eval with_$ac_package=\$ac_optarg ;;
+
+  -without-* | --without-*)
+    ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_package" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+      { echo "$as_me: error: invalid package name: $ac_package" >&2
+   { (exit 1); exit 1; }; }
+    ac_package=`echo $ac_package | sed 's/[-.]/_/g'`
+    eval with_$ac_package=no ;;
+
+  --x)
+    # Obsolete; use --with-x.
+    with_x=yes ;;
+
+  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+  | --x-incl | --x-inc | --x-in | --x-i)
+    ac_prev=x_includes ;;
+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+    x_includes=$ac_optarg ;;
+
+  -x-libraries | --x-libraries | --x-librarie | --x-librari \
+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+    ac_prev=x_libraries ;;
+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+    x_libraries=$ac_optarg ;;
+
+  -*) { echo "$as_me: error: unrecognized option: $ac_option
+Try \`$0 --help' for more information." >&2
+   { (exit 1); exit 1; }; }
+    ;;
+
+  *=*)
+    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
+    # Reject names that are not valid shell variable names.
+    expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
+      { echo "$as_me: error: invalid variable name: $ac_envvar" >&2
+   { (exit 1); exit 1; }; }
+    eval $ac_envvar=\$ac_optarg
+    export $ac_envvar ;;
+
+  *)
+    # FIXME: should be removed in autoconf 3.0.
+    echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+      echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+    : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
+    ;;
+
+  esac
+done
+
+if test -n "$ac_prev"; then
+  ac_option=--`echo $ac_prev | sed 's/_/-/g'`
+  { echo "$as_me: error: missing argument to $ac_option" >&2
+   { (exit 1); exit 1; }; }
+fi
+
+# Be sure to have absolute directory names.
+for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \
+		datadir sysconfdir sharedstatedir localstatedir includedir \
+		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
+		libdir localedir mandir
+do
+  eval ac_val=\$$ac_var
+  case $ac_val in
+    [\\/$]* | ?:[\\/]* )  continue;;
+    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
+  esac
+  { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+   { (exit 1); exit 1; }; }
+done
+
+# There might be people who depend on the old broken behavior: `$host'
+# used to hold the argument of --host etc.
+# FIXME: To remove some day.
+build=$build_alias
+host=$host_alias
+target=$target_alias
+
+# FIXME: To remove some day.
+if test "x$host_alias" != x; then
+  if test "x$build_alias" = x; then
+    cross_compiling=maybe
+    echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
+    If a cross compiler is detected then cross compile mode will be used." >&2
+  elif test "x$build_alias" != "x$host_alias"; then
+    cross_compiling=yes
+  fi
+fi
+
+ac_tool_prefix=
+test -n "$host_alias" && ac_tool_prefix=$host_alias-
+
+test "$silent" = yes && exec 6>/dev/null
+
+
+ac_pwd=`pwd` && test -n "$ac_pwd" &&
+ac_ls_di=`ls -di .` &&
+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
+  { echo "$as_me: error: Working directory cannot be determined" >&2
+   { (exit 1); exit 1; }; }
+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
+  { echo "$as_me: error: pwd does not report name of working directory" >&2
+   { (exit 1); exit 1; }; }
+
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+  ac_srcdir_defaulted=yes
+  # Try the directory containing this script, then the parent directory.
+  ac_confdir=`$as_dirname -- "$0" ||
+$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$0" : 'X\(//\)[^/]' \| \
+	 X"$0" : 'X\(//\)$' \| \
+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+echo X"$0" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+  srcdir=$ac_confdir
+  if test ! -r "$srcdir/$ac_unique_file"; then
+    srcdir=..
+  fi
+else
+  ac_srcdir_defaulted=no
+fi
+if test ! -r "$srcdir/$ac_unique_file"; then
+  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
+  { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
+   { (exit 1); exit 1; }; }
+fi
+ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
+ac_abs_confdir=`(
+	cd "$srcdir" && test -r "./$ac_unique_file" || { echo "$as_me: error: $ac_msg" >&2
+   { (exit 1); exit 1; }; }
+	pwd)`
+# When building in place, set srcdir=.
+if test "$ac_abs_confdir" = "$ac_pwd"; then
+  srcdir=.
+fi
+# Remove unnecessary trailing slashes from srcdir.
+# Double slashes in file names in object file debugging info
+# mess up M-x gdb in Emacs.
+case $srcdir in
+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
+esac
+for ac_var in $ac_precious_vars; do
+  eval ac_env_${ac_var}_set=\${${ac_var}+set}
+  eval ac_env_${ac_var}_value=\$${ac_var}
+  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
+  eval ac_cv_env_${ac_var}_value=\$${ac_var}
+done
+
+#
+# Report the --help message.
+#
+if test "$ac_init_help" = "long"; then
+  # Omit some internal or obsolete options to make the list less imposing.
+  # This message is too long to be a string in the A/UX 3.1 sh.
+  cat <<_ACEOF
+\`configure' configures rtsPOSIX 0.9.9 to adapt to many kinds of systems.
+
+Usage: $0 [OPTION]... [VAR=VALUE]...
+
+To assign environment variables (e.g., CC, CFLAGS...), specify them as
+VAR=VALUE.  See below for descriptions of some of the useful variables.
+
+Defaults for the options are specified in brackets.
+
+Configuration:
+  -h, --help              display this help and exit
+      --help=short        display options specific to this package
+      --help=recursive    display the short help of all the included packages
+  -V, --version           display version information and exit
+  -q, --quiet, --silent   do not print \`checking...' messages
+      --cache-file=FILE   cache test results in FILE [disabled]
+  -C, --config-cache      alias for \`--cache-file=config.cache'
+  -n, --no-create         do not create output files
+      --srcdir=DIR        find the sources in DIR [configure dir or \`..']
+
+Installation directories:
+  --prefix=PREFIX         install architecture-independent files in PREFIX
+			  [$ac_default_prefix]
+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
+			  [PREFIX]
+
+By default, \`make install' will install all the files in
+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify
+an installation prefix other than \`$ac_default_prefix' using \`--prefix',
+for instance \`--prefix=\$HOME'.
+
+For better control, use the options below.
+
+Fine tuning of the installation directories:
+  --bindir=DIR           user executables [EPREFIX/bin]
+  --sbindir=DIR          system admin executables [EPREFIX/sbin]
+  --libexecdir=DIR       program executables [EPREFIX/libexec]
+  --sysconfdir=DIR       read-only single-machine data [PREFIX/etc]
+  --sharedstatedir=DIR   modifiable architecture-independent data [PREFIX/com]
+  --localstatedir=DIR    modifiable single-machine data [PREFIX/var]
+  --libdir=DIR           object code libraries [EPREFIX/lib]
+  --includedir=DIR       C header files [PREFIX/include]
+  --oldincludedir=DIR    C header files for non-gcc [/usr/include]
+  --datarootdir=DIR      read-only arch.-independent data root [PREFIX/share]
+  --datadir=DIR          read-only architecture-independent data [DATAROOTDIR]
+  --infodir=DIR          info documentation [DATAROOTDIR/info]
+  --localedir=DIR        locale-dependent data [DATAROOTDIR/locale]
+  --mandir=DIR           man documentation [DATAROOTDIR/man]
+  --docdir=DIR           documentation root [DATAROOTDIR/doc/rtsposix]
+  --htmldir=DIR          html documentation [DOCDIR]
+  --dvidir=DIR           dvi documentation [DOCDIR]
+  --pdfdir=DIR           pdf documentation [DOCDIR]
+  --psdir=DIR            ps documentation [DOCDIR]
+_ACEOF
+
+  cat <<\_ACEOF
+
+System types:
+  --build=BUILD     configure for building on BUILD [guessed]
+  --host=HOST       cross-compile to build programs to run on HOST [BUILD]
+_ACEOF
+fi
+
+if test -n "$ac_init_help"; then
+  case $ac_init_help in
+     short | recursive ) echo "Configuration of rtsPOSIX 0.9.9:";;
+   esac
+  cat <<\_ACEOF
+
+Optional Packages:
+  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
+  --with-timberc=DIR      Path to timberc
+
+Some influential environment variables:
+  CC          C compiler command
+  CFLAGS      C compiler flags
+  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+              nonstandard directory <lib dir>
+  LIBS        libraries to pass to the linker, e.g. -l<library>
+  CPPFLAGS    C/C++/Objective C preprocessor flags, e.g. -I<include dir> if
+              you have headers in a nonstandard directory <include dir>
+  CPP         C preprocessor
+
+Use these variables to override the choices made by `configure' or to help
+it to find libraries and programs with nonstandard names/locations.
+
+Report bugs to <nordland@csee.ltu.se>.
+_ACEOF
+ac_status=$?
+fi
+
+if test "$ac_init_help" = "recursive"; then
+  # If there are subdirs, report their specific --help.
+  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
+    test -d "$ac_dir" || continue
+    ac_builddir=.
+
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+  ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+  # A ".." for each directory in $ac_dir_suffix.
+  ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'`
+  case $ac_top_builddir_sub in
+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+  esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
+
+case $srcdir in
+  .)  # We are building in place.
+    ac_srcdir=.
+    ac_top_srcdir=$ac_top_builddir_sub
+    ac_abs_top_srcdir=$ac_pwd ;;
+  [\\/]* | ?:[\\/]* )  # Absolute name.
+    ac_srcdir=$srcdir$ac_dir_suffix;
+    ac_top_srcdir=$srcdir
+    ac_abs_top_srcdir=$srcdir ;;
+  *) # Relative name.
+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+    ac_top_srcdir=$ac_top_build_prefix$srcdir
+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
+esac
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+    cd "$ac_dir" || { ac_status=$?; continue; }
+    # Check for guested configure.
+    if test -f "$ac_srcdir/configure.gnu"; then
+      echo &&
+      $SHELL "$ac_srcdir/configure.gnu" --help=recursive
+    elif test -f "$ac_srcdir/configure"; then
+      echo &&
+      $SHELL "$ac_srcdir/configure" --help=recursive
+    else
+      echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+    fi || ac_status=$?
+    cd "$ac_pwd" || { ac_status=$?; break; }
+  done
+fi
+
+test -n "$ac_init_help" && exit $ac_status
+if $ac_init_version; then
+  cat <<\_ACEOF
+rtsPOSIX configure 0.9.9
+generated by GNU Autoconf 2.61
+
+Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
+2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+This configure script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it.
+_ACEOF
+  exit
+fi
+cat >config.log <<_ACEOF
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+
+It was created by rtsPOSIX $as_me 0.9.9, which was
+generated by GNU Autoconf 2.61.  Invocation command line was
+
+  $ $0 $@
+
+_ACEOF
+exec 5>>config.log
+{
+cat <<_ASUNAME
+## --------- ##
+## Platform. ##
+## --------- ##
+
+hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`
+
+/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`
+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
+/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`
+/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`
+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`
+/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`
+
+_ASUNAME
+
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  echo "PATH: $as_dir"
+done
+IFS=$as_save_IFS
+
+} >&5
+
+cat >&5 <<_ACEOF
+
+
+## ----------- ##
+## Core tests. ##
+## ----------- ##
+
+_ACEOF
+
+
+# Keep a trace of the command line.
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Strip out --silent because we don't want to record it for future runs.
+# Also quote any args containing shell meta-characters.
+# Make two passes to allow for proper duplicate-argument suppression.
+ac_configure_args=
+ac_configure_args0=
+ac_configure_args1=
+ac_must_keep_next=false
+for ac_pass in 1 2
+do
+  for ac_arg
+  do
+    case $ac_arg in
+    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
+    -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+    | -silent | --silent | --silen | --sile | --sil)
+      continue ;;
+    *\'*)
+      ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+    esac
+    case $ac_pass in
+    1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;
+    2)
+      ac_configure_args1="$ac_configure_args1 '$ac_arg'"
+      if test $ac_must_keep_next = true; then
+	ac_must_keep_next=false # Got value, back to normal.
+      else
+	case $ac_arg in
+	  *=* | --config-cache | -C | -disable-* | --disable-* \
+	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
+	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
+	  | -with-* | --with-* | -without-* | --without-* | --x)
+	    case "$ac_configure_args0 " in
+	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
+	    esac
+	    ;;
+	  -* ) ac_must_keep_next=true ;;
+	esac
+      fi
+      ac_configure_args="$ac_configure_args '$ac_arg'"
+      ;;
+    esac
+  done
+done
+$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }
+$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }
+
+# When interrupted or exit'd, cleanup temporary files, and complete
+# config.log.  We remove comments because anyway the quotes in there
+# would cause problems or look ugly.
+# WARNING: Use '\'' to represent an apostrophe within the trap.
+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
+trap 'exit_status=$?
+  # Save into config.log some information that might help in debugging.
+  {
+    echo
+
+    cat <<\_ASBOX
+## ---------------- ##
+## Cache variables. ##
+## ---------------- ##
+_ASBOX
+    echo
+    # The following way of writing the cache mishandles newlines in values,
+(
+  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do
+    eval ac_val=\$$ac_var
+    case $ac_val in #(
+    *${as_nl}*)
+      case $ac_var in #(
+      *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5
+echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;;
+      esac
+      case $ac_var in #(
+      _ | IFS | as_nl) ;; #(
+      *) $as_unset $ac_var ;;
+      esac ;;
+    esac
+  done
+  (set) 2>&1 |
+    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
+    *${as_nl}ac_space=\ *)
+      sed -n \
+	"s/'\''/'\''\\\\'\'''\''/g;
+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
+      ;; #(
+    *)
+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
+      ;;
+    esac |
+    sort
+)
+    echo
+
+    cat <<\_ASBOX
+## ----------------- ##
+## Output variables. ##
+## ----------------- ##
+_ASBOX
+    echo
+    for ac_var in $ac_subst_vars
+    do
+      eval ac_val=\$$ac_var
+      case $ac_val in
+      *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+      esac
+      echo "$ac_var='\''$ac_val'\''"
+    done | sort
+    echo
+
+    if test -n "$ac_subst_files"; then
+      cat <<\_ASBOX
+## ------------------- ##
+## File substitutions. ##
+## ------------------- ##
+_ASBOX
+      echo
+      for ac_var in $ac_subst_files
+      do
+	eval ac_val=\$$ac_var
+	case $ac_val in
+	*\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+	esac
+	echo "$ac_var='\''$ac_val'\''"
+      done | sort
+      echo
+    fi
+
+    if test -s confdefs.h; then
+      cat <<\_ASBOX
+## ----------- ##
+## confdefs.h. ##
+## ----------- ##
+_ASBOX
+      echo
+      cat confdefs.h
+      echo
+    fi
+    test "$ac_signal" != 0 &&
+      echo "$as_me: caught signal $ac_signal"
+    echo "$as_me: exit $exit_status"
+  } >&5
+  rm -f core *.core core.conftest.* &&
+    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
+    exit $exit_status
+' 0
+for ac_signal in 1 2 13 15; do
+  trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
+done
+ac_signal=0
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -f -r conftest* confdefs.h
+
+# Predefined preprocessor variables.
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_NAME "$PACKAGE_NAME"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_VERSION "$PACKAGE_VERSION"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_STRING "$PACKAGE_STRING"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
+_ACEOF
+
+
+# Let the site file select an alternate cache file if it wants to.
+# Prefer explicitly selected file to automatically selected ones.
+if test -n "$CONFIG_SITE"; then
+  set x "$CONFIG_SITE"
+elif test "x$prefix" != xNONE; then
+  set x "$prefix/share/config.site" "$prefix/etc/config.site"
+else
+  set x "$ac_default_prefix/share/config.site" \
+	"$ac_default_prefix/etc/config.site"
+fi
+shift
+for ac_site_file
+do
+  if test -r "$ac_site_file"; then
+    { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5
+echo "$as_me: loading site script $ac_site_file" >&6;}
+    sed 's/^/| /' "$ac_site_file" >&5
+    . "$ac_site_file"
+  fi
+done
+
+if test -r "$cache_file"; then
+  # Some versions of bash will fail to source /dev/null (special
+  # files actually), so we avoid doing that.
+  if test -f "$cache_file"; then
+    { echo "$as_me:$LINENO: loading cache $cache_file" >&5
+echo "$as_me: loading cache $cache_file" >&6;}
+    case $cache_file in
+      [\\/]* | ?:[\\/]* ) . "$cache_file";;
+      *)                      . "./$cache_file";;
+    esac
+  fi
+else
+  { echo "$as_me:$LINENO: creating cache $cache_file" >&5
+echo "$as_me: creating cache $cache_file" >&6;}
+  >$cache_file
+fi
+
+# Check that the precious variables saved in the cache have kept the same
+# value.
+ac_cache_corrupted=false
+for ac_var in $ac_precious_vars; do
+  eval ac_old_set=\$ac_cv_env_${ac_var}_set
+  eval ac_new_set=\$ac_env_${ac_var}_set
+  eval ac_old_val=\$ac_cv_env_${ac_var}_value
+  eval ac_new_val=\$ac_env_${ac_var}_value
+  case $ac_old_set,$ac_new_set in
+    set,)
+      { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+      ac_cache_corrupted=: ;;
+    ,set)
+      { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
+echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+      ac_cache_corrupted=: ;;
+    ,);;
+    *)
+      if test "x$ac_old_val" != "x$ac_new_val"; then
+	{ echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
+echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+	{ echo "$as_me:$LINENO:   former value:  $ac_old_val" >&5
+echo "$as_me:   former value:  $ac_old_val" >&2;}
+	{ echo "$as_me:$LINENO:   current value: $ac_new_val" >&5
+echo "$as_me:   current value: $ac_new_val" >&2;}
+	ac_cache_corrupted=:
+      fi;;
+  esac
+  # Pass precious variables to config.status.
+  if test "$ac_new_set" = set; then
+    case $ac_new_val in
+    *\'*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+    *) ac_arg=$ac_var=$ac_new_val ;;
+    esac
+    case " $ac_configure_args " in
+      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.
+      *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+    esac
+  fi
+done
+if $ac_cache_corrupted; then
+  { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
+echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+  { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
+echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
+   { (exit 1); exit 1; }; }
+fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+ac_config_headers="$ac_config_headers config.h"
+
+
+# Checks for programs.
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}gcc; ac_word=$2
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_CC="${ac_tool_prefix}gcc"
+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6; }
+else
+  { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+  ac_ct_CC=$CC
+  # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  if test -n "$ac_ct_CC"; then
+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_ac_ct_CC="gcc"
+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+  { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6; }
+else
+  { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
+fi
+
+  if test "x$ac_ct_CC" = x; then
+    CC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools
+whose name does not start with the host triplet.  If you think this
+configuration is useful to you, please write to autoconf@gnu.org." >&5
+echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools
+whose name does not start with the host triplet.  If you think this
+configuration is useful to you, please write to autoconf@gnu.org." >&2;}
+ac_tool_warned=yes ;;
+esac
+    CC=$ac_ct_CC
+  fi
+else
+  CC="$ac_cv_prog_CC"
+fi
+
+if test -z "$CC"; then
+          if test -n "$ac_tool_prefix"; then
+    # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}cc; ac_word=$2
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_CC="${ac_tool_prefix}cc"
+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6; }
+else
+  { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
+fi
+
+
+  fi
+fi
+if test -z "$CC"; then
+  # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+  ac_prog_rejected=no
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
+       ac_prog_rejected=yes
+       continue
+     fi
+    ac_cv_prog_CC="cc"
+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+done
+IFS=$as_save_IFS
+
+if test $ac_prog_rejected = yes; then
+  # We found a bogon in the path, so make sure we never use it.
+  set dummy $ac_cv_prog_CC
+  shift
+  if test $# != 0; then
+    # We chose a different compiler from the bogus one.
+    # However, it has the same basename, so the bogon will be chosen
+    # first if we set CC to just the basename; use the full file name.
+    shift
+    ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
+  fi
+fi
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6; }
+else
+  { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
+fi
+
+
+fi
+if test -z "$CC"; then
+  if test -n "$ac_tool_prefix"; then
+  for ac_prog in cl.exe
+  do
+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
+if test "${ac_cv_prog_CC+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  if test -n "$CC"; then
+  ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+done
+IFS=$as_save_IFS
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+  { echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6; }
+else
+  { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
+fi
+
+
+    test -n "$CC" && break
+  done
+fi
+if test -z "$CC"; then
+  ac_ct_CC=$CC
+  for ac_prog in cl.exe
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  if test -n "$ac_ct_CC"; then
+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_ac_ct_CC="$ac_prog"
+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+done
+IFS=$as_save_IFS
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+  { echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6; }
+else
+  { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
+fi
+
+
+  test -n "$ac_ct_CC" && break
+done
+
+  if test "x$ac_ct_CC" = x; then
+    CC=""
+  else
+    case $cross_compiling:$ac_tool_warned in
+yes:)
+{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools
+whose name does not start with the host triplet.  If you think this
+configuration is useful to you, please write to autoconf@gnu.org." >&5
+echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools
+whose name does not start with the host triplet.  If you think this
+configuration is useful to you, please write to autoconf@gnu.org." >&2;}
+ac_tool_warned=yes ;;
+esac
+    CC=$ac_ct_CC
+  fi
+fi
+
+fi
+
+
+test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH
+See \`config.log' for more details." >&5
+echo "$as_me: error: no acceptable C compiler found in \$PATH
+See \`config.log' for more details." >&2;}
+   { (exit 1); exit 1; }; }
+
+# Provide some information about the compiler.
+echo "$as_me:$LINENO: checking for C compiler version" >&5
+ac_compiler=`set X $ac_compile; echo $2`
+{ (ac_try="$ac_compiler --version >&5"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compiler --version >&5") 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }
+{ (ac_try="$ac_compiler -v >&5"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compiler -v >&5") 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }
+{ (ac_try="$ac_compiler -V >&5"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compiler -V >&5") 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }
+
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files a.out a.exe b.out"
+# Try to create an executable without -o first, disregard a.out.
+# It will help us diagnose broken compilers, and finding out an intuition
+# of exeext.
+{ echo "$as_me:$LINENO: checking for C compiler default output file name" >&5
+echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6; }
+ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+#
+# List of possible output files, starting from the most likely.
+# The algorithm is not robust to junk in `.', hence go to wildcards (a.*)
+# only as a last resort.  b.out is created by i960 compilers.
+ac_files='a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out'
+#
+# The IRIX 6 linker writes into existing files which may not be
+# executable, retaining their permissions.  Remove them first so a
+# subsequent execution test works.
+ac_rmfiles=
+for ac_file in $ac_files
+do
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;;
+    * ) ac_rmfiles="$ac_rmfiles $ac_file";;
+  esac
+done
+rm -f $ac_rmfiles
+
+if { (ac_try="$ac_link_default"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_link_default") 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; then
+  # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.
+# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'
+# in a Makefile.  We should not override ac_cv_exeext if it was cached,
+# so that the user can short-circuit this test for compilers unknown to
+# Autoconf.
+for ac_file in $ac_files ''
+do
+  test -f "$ac_file" || continue
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj )
+	;;
+    [ab].out )
+	# We found the default executable, but exeext='' is most
+	# certainly right.
+	break;;
+    *.* )
+        if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;
+	then :; else
+	   ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+	fi
+	# We set ac_cv_exeext here because the later test for it is not
+	# safe: cross compilers may not add the suffix if given an `-o'
+	# argument, so we may need to know it at that point already.
+	# Even if this section looks crufty: it has the advantage of
+	# actually working.
+	break;;
+    * )
+	break;;
+  esac
+done
+test "$ac_cv_exeext" = no && ac_cv_exeext=
+
+else
+  ac_file=''
+fi
+
+{ echo "$as_me:$LINENO: result: $ac_file" >&5
+echo "${ECHO_T}$ac_file" >&6; }
+if test -z "$ac_file"; then
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: C compiler cannot create executables
+See \`config.log' for more details." >&5
+echo "$as_me: error: C compiler cannot create executables
+See \`config.log' for more details." >&2;}
+   { (exit 77); exit 77; }; }
+fi
+
+ac_exeext=$ac_cv_exeext
+
+# Check that the compiler produces executables we can run.  If not, either
+# the compiler is broken, or we cross compile.
+{ echo "$as_me:$LINENO: checking whether the C compiler works" >&5
+echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6; }
+# FIXME: These cross compiler hacks should be removed for Autoconf 3.0
+# If not cross compiling, check that we can run a simple program.
+if test "$cross_compiling" != yes; then
+  if { ac_try='./$ac_file'
+  { (case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_try") 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+    cross_compiling=no
+  else
+    if test "$cross_compiling" = maybe; then
+	cross_compiling=yes
+    else
+	{ { echo "$as_me:$LINENO: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&2;}
+   { (exit 1); exit 1; }; }
+    fi
+  fi
+fi
+{ echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6; }
+
+rm -f a.out a.exe conftest$ac_cv_exeext b.out
+ac_clean_files=$ac_clean_files_save
+# Check that the compiler produces executables we can run.  If not, either
+# the compiler is broken, or we cross compile.
+{ echo "$as_me:$LINENO: checking whether we are cross compiling" >&5
+echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6; }
+{ echo "$as_me:$LINENO: result: $cross_compiling" >&5
+echo "${ECHO_T}$cross_compiling" >&6; }
+
+{ echo "$as_me:$LINENO: checking for suffix of executables" >&5
+echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6; }
+if { (ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; then
+  # If both `conftest.exe' and `conftest' are `present' (well, observable)
+# catch `conftest.exe'.  For instance with Cygwin, `ls conftest' will
+# work properly (i.e., refer to `conftest.exe'), while it won't with
+# `rm'.
+for ac_file in conftest.exe conftest conftest.*; do
+  test -f "$ac_file" || continue
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;;
+    *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+	  break;;
+    * ) break;;
+  esac
+done
+else
+  { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&2;}
+   { (exit 1); exit 1; }; }
+fi
+
+rm -f conftest$ac_cv_exeext
+{ echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
+echo "${ECHO_T}$ac_cv_exeext" >&6; }
+
+rm -f conftest.$ac_ext
+EXEEXT=$ac_cv_exeext
+ac_exeext=$EXEEXT
+{ echo "$as_me:$LINENO: checking for suffix of object files" >&5
+echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6; }
+if test "${ac_cv_objext+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.o conftest.obj
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; then
+  for ac_file in conftest.o conftest.obj conftest.*; do
+  test -f "$ac_file" || continue;
+  case $ac_file in
+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf ) ;;
+    *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
+       break;;
+  esac
+done
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&2;}
+   { (exit 1); exit 1; }; }
+fi
+
+rm -f conftest.$ac_cv_objext conftest.$ac_ext
+fi
+{ echo "$as_me:$LINENO: result: $ac_cv_objext" >&5
+echo "${ECHO_T}$ac_cv_objext" >&6; }
+OBJEXT=$ac_cv_objext
+ac_objext=$OBJEXT
+{ echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
+echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6; }
+if test "${ac_cv_c_compiler_gnu+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+int
+main ()
+{
+#ifndef __GNUC__
+       choke me
+#endif
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then
+  ac_compiler_gnu=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_compiler_gnu=no
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_c_compiler_gnu=$ac_compiler_gnu
+
+fi
+{ echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
+echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6; }
+GCC=`test $ac_compiler_gnu = yes && echo yes`
+ac_test_CFLAGS=${CFLAGS+set}
+ac_save_CFLAGS=$CFLAGS
+{ echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
+echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6; }
+if test "${ac_cv_prog_cc_g+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  ac_save_c_werror_flag=$ac_c_werror_flag
+   ac_c_werror_flag=yes
+   ac_cv_prog_cc_g=no
+   CFLAGS="-g"
+   cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then
+  ac_cv_prog_cc_g=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	CFLAGS=""
+      cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then
+  :
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_c_werror_flag=$ac_save_c_werror_flag
+	 CFLAGS="-g"
+	 cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then
+  ac_cv_prog_cc_g=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+   ac_c_werror_flag=$ac_save_c_werror_flag
+fi
+{ echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_g" >&6; }
+if test "$ac_test_CFLAGS" = set; then
+  CFLAGS=$ac_save_CFLAGS
+elif test $ac_cv_prog_cc_g = yes; then
+  if test "$GCC" = yes; then
+    CFLAGS="-g -O2"
+  else
+    CFLAGS="-g"
+  fi
+else
+  if test "$GCC" = yes; then
+    CFLAGS="-O2"
+  else
+    CFLAGS=
+  fi
+fi
+{ echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5
+echo $ECHO_N "checking for $CC option to accept ISO C89... $ECHO_C" >&6; }
+if test "${ac_cv_prog_cc_c89+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  ac_cv_prog_cc_c89=no
+ac_save_CC=$CC
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <stdarg.h>
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+     char **p;
+     int i;
+{
+  return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+  char *s;
+  va_list v;
+  va_start (v,p);
+  s = g (p, va_arg (v,int));
+  va_end (v);
+  return s;
+}
+
+/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has
+   function prototypes and stuff, but not '\xHH' hex character constants.
+   These don't provoke an error unfortunately, instead are silently treated
+   as 'x'.  The following induces an error, until -std is added to get
+   proper ANSI mode.  Curiously '\x00'!='x' always comes out true, for an
+   array size at least.  It's necessary to write '\x00'==0 to get something
+   that's true only with -std.  */
+int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+
+/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters
+   inside strings and character constants.  */
+#define FOO(x) 'x'
+int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];
+
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+int
+main ()
+{
+return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];
+  ;
+  return 0;
+}
+_ACEOF
+for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \
+	-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+  CC="$ac_save_CC $ac_arg"
+  rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then
+  ac_cv_prog_cc_c89=$ac_arg
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+
+fi
+
+rm -f core conftest.err conftest.$ac_objext
+  test "x$ac_cv_prog_cc_c89" != "xno" && break
+done
+rm -f conftest.$ac_ext
+CC=$ac_save_CC
+
+fi
+# AC_CACHE_VAL
+case "x$ac_cv_prog_cc_c89" in
+  x)
+    { echo "$as_me:$LINENO: result: none needed" >&5
+echo "${ECHO_T}none needed" >&6; } ;;
+  xno)
+    { echo "$as_me:$LINENO: result: unsupported" >&5
+echo "${ECHO_T}unsupported" >&6; } ;;
+  *)
+    CC="$CC $ac_cv_prog_cc_c89"
+    { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_c89" >&6; } ;;
+esac
+
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+ac_aux_dir=
+for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do
+  if test -f "$ac_dir/install-sh"; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install-sh -c"
+    break
+  elif test -f "$ac_dir/install.sh"; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/install.sh -c"
+    break
+  elif test -f "$ac_dir/shtool"; then
+    ac_aux_dir=$ac_dir
+    ac_install_sh="$ac_aux_dir/shtool install -c"
+    break
+  fi
+done
+if test -z "$ac_aux_dir"; then
+  { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" >&5
+echo "$as_me: error: cannot find install-sh or install.sh in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" >&2;}
+   { (exit 1); exit 1; }; }
+fi
+
+# These three variables are undocumented and unsupported,
+# and are intended to be withdrawn in a future Autoconf release.
+# They can cause serious problems if a builder's source tree is in a directory
+# whose full name contains unusual characters.
+ac_config_guess="$SHELL $ac_aux_dir/config.guess"  # Please don't use this var.
+ac_config_sub="$SHELL $ac_aux_dir/config.sub"  # Please don't use this var.
+ac_configure="$SHELL $ac_aux_dir/configure"  # Please don't use this var.
+
+
+# Find a good install program.  We prefer a C program (faster),
+# so one script is as good as another.  But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AmigaOS /C/install, which installs bootblocks on floppy discs
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# OS/2's system install, which has a completely different semantic
+# ./install, which can be erroneously created by make from ./install.sh.
+{ echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5
+echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6; }
+if test -z "$INSTALL"; then
+if test "${ac_cv_path_install+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  # Account for people who put trailing slashes in PATH elements.
+case $as_dir/ in
+  ./ | .// | /cC/* | \
+  /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \
+  ?:\\/os2\\/install\\/* | ?:\\/OS2\\/INSTALL\\/* | \
+  /usr/ucb/* ) ;;
+  *)
+    # OSF1 and SCO ODT 3.0 have their own names for install.
+    # Don't use installbsd from OSF since it installs stuff as root
+    # by default.
+    for ac_prog in ginstall scoinst install; do
+      for ac_exec_ext in '' $ac_executable_extensions; do
+	if { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$as_dir/$ac_prog$ac_exec_ext"; }; then
+	  if test $ac_prog = install &&
+	    grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+	    # AIX install.  It has an incompatible calling convention.
+	    :
+	  elif test $ac_prog = install &&
+	    grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+	    # program-specific install script used by HP pwplus--don't use.
+	    :
+	  else
+	    ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"
+	    break 3
+	  fi
+	fi
+      done
+    done
+    ;;
+esac
+done
+IFS=$as_save_IFS
+
+
+fi
+  if test "${ac_cv_path_install+set}" = set; then
+    INSTALL=$ac_cv_path_install
+  else
+    # As a last resort, use the slow shell script.  Don't cache a
+    # value for INSTALL within a source directory, because that will
+    # break other packages using the cache if that directory is
+    # removed, or if the value is a relative name.
+    INSTALL=$ac_install_sh
+  fi
+fi
+{ echo "$as_me:$LINENO: result: $INSTALL" >&5
+echo "${ECHO_T}$INSTALL" >&6; }
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+
+# Force building 32-bit applications since we're not 64-bit clean.
+#
+# GCC accepts -m32 on most architectures that might have a corresponding
+# 64-bit architecture, for example sparc and MIPS.
+
+old_CFLAGS="$CFLAGS"
+CFLAGS="$CFLAGS -m32"
+
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+int
+main ()
+{
+return 1;
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then
+  :
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	CFLAGS="$old_CFLAGS"
+
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+# Checks for libraries.
+
+# Look for pthreads.
+# Make sure we can run config.sub.
+$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 ||
+  { { echo "$as_me:$LINENO: error: cannot run $SHELL $ac_aux_dir/config.sub" >&5
+echo "$as_me: error: cannot run $SHELL $ac_aux_dir/config.sub" >&2;}
+   { (exit 1); exit 1; }; }
+
+{ echo "$as_me:$LINENO: checking build system type" >&5
+echo $ECHO_N "checking build system type... $ECHO_C" >&6; }
+if test "${ac_cv_build+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  ac_build_alias=$build_alias
+test "x$ac_build_alias" = x &&
+  ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"`
+test "x$ac_build_alias" = x &&
+  { { echo "$as_me:$LINENO: error: cannot guess build type; you must specify one" >&5
+echo "$as_me: error: cannot guess build type; you must specify one" >&2;}
+   { (exit 1); exit 1; }; }
+ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` ||
+  { { echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $ac_build_alias failed" >&5
+echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $ac_build_alias failed" >&2;}
+   { (exit 1); exit 1; }; }
+
+fi
+{ echo "$as_me:$LINENO: result: $ac_cv_build" >&5
+echo "${ECHO_T}$ac_cv_build" >&6; }
+case $ac_cv_build in
+*-*-*) ;;
+*) { { echo "$as_me:$LINENO: error: invalid value of canonical build" >&5
+echo "$as_me: error: invalid value of canonical build" >&2;}
+   { (exit 1); exit 1; }; };;
+esac
+build=$ac_cv_build
+ac_save_IFS=$IFS; IFS='-'
+set x $ac_cv_build
+shift
+build_cpu=$1
+build_vendor=$2
+shift; shift
+# Remember, the first character of IFS is used to create $*,
+# except with old shells:
+build_os=$*
+IFS=$ac_save_IFS
+case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac
+
+
+{ echo "$as_me:$LINENO: checking host system type" >&5
+echo $ECHO_N "checking host system type... $ECHO_C" >&6; }
+if test "${ac_cv_host+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  if test "x$host_alias" = x; then
+  ac_cv_host=$ac_cv_build
+else
+  ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` ||
+    { { echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&5
+echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&2;}
+   { (exit 1); exit 1; }; }
+fi
+
+fi
+{ echo "$as_me:$LINENO: result: $ac_cv_host" >&5
+echo "${ECHO_T}$ac_cv_host" >&6; }
+case $ac_cv_host in
+*-*-*) ;;
+*) { { echo "$as_me:$LINENO: error: invalid value of canonical host" >&5
+echo "$as_me: error: invalid value of canonical host" >&2;}
+   { (exit 1); exit 1; }; };;
+esac
+host=$ac_cv_host
+ac_save_IFS=$IFS; IFS='-'
+set x $ac_cv_host
+shift
+host_cpu=$1
+host_vendor=$2
+shift; shift
+# Remember, the first character of IFS is used to create $*,
+# except with old shells:
+host_os=$*
+IFS=$ac_save_IFS
+case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac
+
+
+
+
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+acx_pthread_ok=no
+
+# We used to check for pthread.h first, but this fails if pthread.h
+# requires special compiler flags (e.g. on True64 or Sequent).
+# It gets checked for in the link test anyway.
+
+# First of all, check if the user has set any of the PTHREAD_LIBS,
+# etcetera environment variables, and if threads linking works using
+# them:
+if test x"$PTHREAD_LIBS$PTHREAD_CFLAGS" != x; then
+        save_CFLAGS="$CFLAGS"
+        CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+        save_LIBS="$LIBS"
+        LIBS="$PTHREAD_LIBS $LIBS"
+        { echo "$as_me:$LINENO: checking for pthread_join in LIBS=$PTHREAD_LIBS with CFLAGS=$PTHREAD_CFLAGS" >&5
+echo $ECHO_N "checking for pthread_join in LIBS=$PTHREAD_LIBS with CFLAGS=$PTHREAD_CFLAGS... $ECHO_C" >&6; }
+        cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char pthread_join ();
+int
+main ()
+{
+return pthread_join ();
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_link") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest$ac_exeext &&
+       $as_test_x conftest$ac_exeext; then
+  acx_pthread_ok=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
+      conftest$ac_exeext conftest.$ac_ext
+        { echo "$as_me:$LINENO: result: $acx_pthread_ok" >&5
+echo "${ECHO_T}$acx_pthread_ok" >&6; }
+        if test x"$acx_pthread_ok" = xno; then
+                PTHREAD_LIBS=""
+                PTHREAD_CFLAGS=""
+        fi
+        LIBS="$save_LIBS"
+        CFLAGS="$save_CFLAGS"
+fi
+
+# We must check for the threads library under a number of different
+# names; the ordering is very important because some systems
+# (e.g. DEC) have both -lpthread and -lpthreads, where one of the
+# libraries is broken (non-POSIX).
+
+# Create a list of thread flags to try.  Items starting with a "-" are
+# C compiler flags, and other items are library names, except for "none"
+# which indicates that we try without any flags at all, and "pthread-config"
+# which is a program returning the flags for the Pth emulation library.
+
+acx_pthread_flags="pthreads none -Kthread -kthread lthread -pthread -pthreads -mthreads pthread --thread-safe -mt pthread-config"
+
+# The ordering *is* (sometimes) important.  Some notes on the
+# individual items follow:
+
+# pthreads: AIX (must check this before -lpthread)
+# none: in case threads are in libc; should be tried before -Kthread and
+#       other compiler flags to prevent continual compiler warnings
+# -Kthread: Sequent (threads in libc, but -Kthread needed for pthread.h)
+# -kthread: FreeBSD kernel threads (preferred to -pthread since SMP-able)
+# lthread: LinuxThreads port on FreeBSD (also preferred to -pthread)
+# -pthread: Linux/gcc (kernel threads), BSD/gcc (userland threads)
+# -pthreads: Solaris/gcc
+# -mthreads: Mingw32/gcc, Lynx/gcc
+# -mt: Sun Workshop C (may only link SunOS threads [-lthread], but it
+#      doesn't hurt to check since this sometimes defines pthreads too;
+#      also defines -D_REENTRANT)
+#      ... -mt is also the pthreads flag for HP/aCC
+# pthread: Linux, etcetera
+# --thread-safe: KAI C++
+# pthread-config: use pthread-config program (for GNU Pth library)
+
+case "${host_cpu}-${host_os}" in
+        *solaris*)
+
+        # On Solaris (at least, for some versions), libc contains stubbed
+        # (non-functional) versions of the pthreads routines, so link-based
+        # tests will erroneously succeed.  (We need to link with -pthreads/-mt/
+        # -lpthread.)  (The stubs are missing pthread_cleanup_push, or rather
+        # a function called by this macro, so we could check for that, but
+        # who knows whether they'll stub that too in a future libc.)  So,
+        # we'll just look for -pthreads and -lpthread first:
+
+        acx_pthread_flags="-pthreads pthread -mt -pthread $acx_pthread_flags"
+        ;;
+esac
+
+if test x"$acx_pthread_ok" = xno; then
+for flag in $acx_pthread_flags; do
+
+        case $flag in
+                none)
+                { echo "$as_me:$LINENO: checking whether pthreads work without any flags" >&5
+echo $ECHO_N "checking whether pthreads work without any flags... $ECHO_C" >&6; }
+                ;;
+
+                -*)
+                { echo "$as_me:$LINENO: checking whether pthreads work with $flag" >&5
+echo $ECHO_N "checking whether pthreads work with $flag... $ECHO_C" >&6; }
+                PTHREAD_CFLAGS="$flag"
+                ;;
+
+		pthread-config)
+		# Extract the first word of "pthread-config", so it can be a program name with args.
+set dummy pthread-config; ac_word=$2
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
+if test "${ac_cv_prog_acx_pthread_config+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  if test -n "$acx_pthread_config"; then
+  ac_cv_prog_acx_pthread_config="$acx_pthread_config" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_acx_pthread_config="yes"
+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+done
+IFS=$as_save_IFS
+
+  test -z "$ac_cv_prog_acx_pthread_config" && ac_cv_prog_acx_pthread_config="no"
+fi
+fi
+acx_pthread_config=$ac_cv_prog_acx_pthread_config
+if test -n "$acx_pthread_config"; then
+  { echo "$as_me:$LINENO: result: $acx_pthread_config" >&5
+echo "${ECHO_T}$acx_pthread_config" >&6; }
+else
+  { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
+fi
+
+
+		if test x"$acx_pthread_config" = xno; then continue; fi
+		PTHREAD_CFLAGS="`pthread-config --cflags`"
+		PTHREAD_LIBS="`pthread-config --ldflags` `pthread-config --libs`"
+		;;
+
+                *)
+                { echo "$as_me:$LINENO: checking for the pthreads library -l$flag" >&5
+echo $ECHO_N "checking for the pthreads library -l$flag... $ECHO_C" >&6; }
+                PTHREAD_LIBS="-l$flag"
+                ;;
+        esac
+
+        save_LIBS="$LIBS"
+        save_CFLAGS="$CFLAGS"
+        LIBS="$PTHREAD_LIBS $LIBS"
+        CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+
+        # Check for various functions.  We must include pthread.h,
+        # since some functions may be macros.  (On the Sequent, we
+        # need a special flag -Kthread to make this header compile.)
+        # We check for pthread_join because it is in -lpthread on IRIX
+        # while pthread_create is in libc.  We check for pthread_attr_init
+        # due to DEC craziness with -lpthreads.  We check for
+        # pthread_cleanup_push because it is one of the few pthread
+        # functions on Solaris that doesn't have a non-functional libc stub.
+        # We try pthread_create on general principles.
+        cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <pthread.h>
+int
+main ()
+{
+pthread_t th; pthread_join(th, 0);
+                     pthread_attr_init(0); pthread_cleanup_push(0, 0);
+                     pthread_create(0,0,0,0); pthread_cleanup_pop(0);
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_link") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest$ac_exeext &&
+       $as_test_x conftest$ac_exeext; then
+  acx_pthread_ok=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
+      conftest$ac_exeext conftest.$ac_ext
+
+        LIBS="$save_LIBS"
+        CFLAGS="$save_CFLAGS"
+
+        { echo "$as_me:$LINENO: result: $acx_pthread_ok" >&5
+echo "${ECHO_T}$acx_pthread_ok" >&6; }
+        if test "x$acx_pthread_ok" = xyes; then
+                break;
+        fi
+
+        PTHREAD_LIBS=""
+        PTHREAD_CFLAGS=""
+done
+fi
+
+# Various other checks:
+if test "x$acx_pthread_ok" = xyes; then
+        save_LIBS="$LIBS"
+        LIBS="$PTHREAD_LIBS $LIBS"
+        save_CFLAGS="$CFLAGS"
+        CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+
+        # Detect AIX lossage: JOINABLE attribute is called UNDETACHED.
+	{ echo "$as_me:$LINENO: checking for joinable pthread attribute" >&5
+echo $ECHO_N "checking for joinable pthread attribute... $ECHO_C" >&6; }
+	attr_name=unknown
+	for attr in PTHREAD_CREATE_JOINABLE PTHREAD_CREATE_UNDETACHED; do
+	    cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <pthread.h>
+int
+main ()
+{
+int attr=$attr; return attr;
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_link") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest$ac_exeext &&
+       $as_test_x conftest$ac_exeext; then
+  attr_name=$attr; break
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
+      conftest$ac_exeext conftest.$ac_ext
+	done
+        { echo "$as_me:$LINENO: result: $attr_name" >&5
+echo "${ECHO_T}$attr_name" >&6; }
+        if test "$attr_name" != PTHREAD_CREATE_JOINABLE; then
+
+cat >>confdefs.h <<_ACEOF
+#define PTHREAD_CREATE_JOINABLE $attr_name
+_ACEOF
+
+        fi
+
+        { echo "$as_me:$LINENO: checking if more special flags are required for pthreads" >&5
+echo $ECHO_N "checking if more special flags are required for pthreads... $ECHO_C" >&6; }
+        flag=no
+        case "${host_cpu}-${host_os}" in
+            *-aix* | *-freebsd* | *-darwin*) flag="-D_THREAD_SAFE";;
+            *solaris* | *-osf* | *-hpux*) flag="-D_REENTRANT";;
+        esac
+        { echo "$as_me:$LINENO: result: ${flag}" >&5
+echo "${ECHO_T}${flag}" >&6; }
+        if test "x$flag" != xno; then
+            PTHREAD_CFLAGS="$flag $PTHREAD_CFLAGS"
+        fi
+
+        LIBS="$save_LIBS"
+        CFLAGS="$save_CFLAGS"
+
+        # More AIX lossage: must compile with xlc_r or cc_r
+	if test x"$GCC" != xyes; then
+          for ac_prog in xlc_r cc_r
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
+if test "${ac_cv_prog_PTHREAD_CC+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  if test -n "$PTHREAD_CC"; then
+  ac_cv_prog_PTHREAD_CC="$PTHREAD_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_PTHREAD_CC="$ac_prog"
+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+done
+IFS=$as_save_IFS
+
+fi
+fi
+PTHREAD_CC=$ac_cv_prog_PTHREAD_CC
+if test -n "$PTHREAD_CC"; then
+  { echo "$as_me:$LINENO: result: $PTHREAD_CC" >&5
+echo "${ECHO_T}$PTHREAD_CC" >&6; }
+else
+  { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
+fi
+
+
+  test -n "$PTHREAD_CC" && break
+done
+test -n "$PTHREAD_CC" || PTHREAD_CC="${CC}"
+
+        else
+          PTHREAD_CC=$CC
+	fi
+else
+        PTHREAD_CC="$CC"
+fi
+
+
+
+
+
+# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
+if test x"$acx_pthread_ok" = xyes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_PTHREAD 1
+_ACEOF
+
+        :
+else
+        acx_pthread_ok=no
+
+fi
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+if test "$THREAD_SUPPORT" = "no"; then
+	{ { echo "$as_me:$LINENO: error: Cannot enable threads on this platform." >&5
+echo "$as_me: error: Cannot enable threads on this platform." >&2;}
+   { (exit 1); exit 1; }; }
+fi
+
+CC="$PTHREAD_CC"
+CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+LIBS="$PTHREAD_LIBS $LIBS"
+
+# Make sure that pthread realtime-threads extension is available. This is
+# not the default behaviour on most GNU/Linux dists. If it turns out that
+# the realtime-threads extension is not available we add -D_GNU_SOURCE=1
+# as this should enable all extensions on most GNU/Linux dists. For more
+# information please see <features.h>.
+{ echo "$as_me:$LINENO: checking pthread realtime-threads extension" >&5
+echo $ECHO_N "checking pthread realtime-threads extension... $ECHO_C" >&6; }
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <pthread.h>
+int
+main ()
+{
+pthread_mutexattr_setprotocol(NULL, PTHREAD_PRIO_INHERIT);
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then
+  need_gnu_source=no
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	need_gnu_source=yes
+
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+if test "x$need_gnu_source" = "xyes"; then
+	CFLAGS="$CFLAGS -D_GNU_SOURCE=1"
+fi
+
+# Finalize the checking for pthread realtime-threads extension. This may
+# still fail if -D_GNU_SOURCE=1 does not enable the realtime-threads
+# extension. I this is the case then we are either running this on a
+# system without the realtime-threads extension or we need to perform some
+# other kind of black magic to enable it. If you know of any such platform
+# then please feel free to send a patch.
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <pthread.h>
+int
+main ()
+{
+pthread_mutexattr_setprotocol(NULL, PTHREAD_PRIO_INHERIT);
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then
+  { echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6; }
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	{ { echo "$as_me:$LINENO: error: no
+See \`config.log' for more details." >&5
+echo "$as_me: error: no
+See \`config.log' for more details." >&2;}
+   { (exit 1); exit 1; }; }
+
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+
+# Check whether --with-timberc was given.
+if test "${with_timberc+set}" = set; then
+  withval=$with_timberc; with_timberc=$withval
+
+fi
+
+
+if test "x$with_timberc" = "x"; then
+	for ac_prog in timberc
+do
+  # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+{ echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6; }
+if test "${ac_cv_prog_TIMBERC+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  if test -n "$TIMBERC"; then
+  ac_cv_prog_TIMBERC="$TIMBERC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_prog_TIMBERC="$ac_prog"
+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+done
+IFS=$as_save_IFS
+
+fi
+fi
+TIMBERC=$ac_cv_prog_TIMBERC
+if test -n "$TIMBERC"; then
+  { echo "$as_me:$LINENO: result: $TIMBERC" >&5
+echo "${ECHO_T}$TIMBERC" >&6; }
+else
+  { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
+fi
+
+
+  test -n "$TIMBERC" && break
+done
+
+else
+	TIMBERC="$with_timberc"
+fi
+
+if test "x$TIMBERC" = "x"; then
+	{ { echo "$as_me:$LINENO: error: Timberc not found." >&5
+echo "$as_me: error: Timberc not found." >&2;}
+   { (exit 1); exit 1; }; }
+fi
+
+# Checks for header files.
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+{ echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5
+echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6; }
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+  CPP=
+fi
+if test -z "$CPP"; then
+  if test "${ac_cv_prog_CPP+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+      # Double quotes because CPP needs to be expanded
+    for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
+    do
+      ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+  # Use a header file that comes with gcc, so configuring glibc
+  # with a fresh cross-compiler works.
+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+  # <limits.h> exists even on freestanding compilers.
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp. "Syntax error" is here to catch this case.
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+		     Syntax error
+_ACEOF
+if { (ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } >/dev/null && {
+	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       }; then
+  :
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+  # Broken: fails on valid input.
+continue
+fi
+
+rm -f conftest.err conftest.$ac_ext
+
+  # OK, works on sane cases.  Now check whether nonexistent headers
+  # can be detected and how.
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <ac_nonexistent.h>
+_ACEOF
+if { (ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } >/dev/null && {
+	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       }; then
+  # Broken: success on invalid input.
+continue
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+  # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then
+  break
+fi
+
+    done
+    ac_cv_prog_CPP=$CPP
+
+fi
+  CPP=$ac_cv_prog_CPP
+else
+  ac_cv_prog_CPP=$CPP
+fi
+{ echo "$as_me:$LINENO: result: $CPP" >&5
+echo "${ECHO_T}$CPP" >&6; }
+ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+  # Use a header file that comes with gcc, so configuring glibc
+  # with a fresh cross-compiler works.
+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+  # <limits.h> exists even on freestanding compilers.
+  # On the NeXT, cc -E runs the code through the compiler's parser,
+  # not just through cpp. "Syntax error" is here to catch this case.
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+		     Syntax error
+_ACEOF
+if { (ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } >/dev/null && {
+	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       }; then
+  :
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+  # Broken: fails on valid input.
+continue
+fi
+
+rm -f conftest.err conftest.$ac_ext
+
+  # OK, works on sane cases.  Now check whether nonexistent headers
+  # can be detected and how.
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <ac_nonexistent.h>
+_ACEOF
+if { (ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } >/dev/null && {
+	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       }; then
+  # Broken: success on invalid input.
+continue
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+  # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then
+  :
+else
+  { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details." >&5
+echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details." >&2;}
+   { (exit 1); exit 1; }; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+{ echo "$as_me:$LINENO: checking for grep that handles long lines and -e" >&5
+echo $ECHO_N "checking for grep that handles long lines and -e... $ECHO_C" >&6; }
+if test "${ac_cv_path_GREP+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  # Extract the first word of "grep ggrep" to use in msg output
+if test -z "$GREP"; then
+set dummy grep ggrep; ac_prog_name=$2
+if test "${ac_cv_path_GREP+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  ac_path_GREP_found=false
+# Loop through the user's path and test for each of PROGNAME-LIST
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  for ac_prog in grep ggrep; do
+  for ac_exec_ext in '' $ac_executable_extensions; do
+    ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
+    { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue
+    # Check for GNU ac_path_GREP and select it if it is found.
+  # Check for GNU $ac_path_GREP
+case `"$ac_path_GREP" --version 2>&1` in
+*GNU*)
+  ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;
+*)
+  ac_count=0
+  echo $ECHO_N "0123456789$ECHO_C" >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    echo 'GREP' >> "conftest.nl"
+    "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    ac_count=`expr $ac_count + 1`
+    if test $ac_count -gt ${ac_path_GREP_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_GREP="$ac_path_GREP"
+      ac_path_GREP_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+
+    $ac_path_GREP_found && break 3
+  done
+done
+
+done
+IFS=$as_save_IFS
+
+
+fi
+
+GREP="$ac_cv_path_GREP"
+if test -z "$GREP"; then
+  { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5
+echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;}
+   { (exit 1); exit 1; }; }
+fi
+
+else
+  ac_cv_path_GREP=$GREP
+fi
+
+
+fi
+{ echo "$as_me:$LINENO: result: $ac_cv_path_GREP" >&5
+echo "${ECHO_T}$ac_cv_path_GREP" >&6; }
+ GREP="$ac_cv_path_GREP"
+
+
+{ echo "$as_me:$LINENO: checking for egrep" >&5
+echo $ECHO_N "checking for egrep... $ECHO_C" >&6; }
+if test "${ac_cv_path_EGREP+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  if echo a | $GREP -E '(a|b)' >/dev/null 2>&1
+   then ac_cv_path_EGREP="$GREP -E"
+   else
+     # Extract the first word of "egrep" to use in msg output
+if test -z "$EGREP"; then
+set dummy egrep; ac_prog_name=$2
+if test "${ac_cv_path_EGREP+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  ac_path_EGREP_found=false
+# Loop through the user's path and test for each of PROGNAME-LIST
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  for ac_prog in egrep; do
+  for ac_exec_ext in '' $ac_executable_extensions; do
+    ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
+    { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue
+    # Check for GNU ac_path_EGREP and select it if it is found.
+  # Check for GNU $ac_path_EGREP
+case `"$ac_path_EGREP" --version 2>&1` in
+*GNU*)
+  ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;
+*)
+  ac_count=0
+  echo $ECHO_N "0123456789$ECHO_C" >"conftest.in"
+  while :
+  do
+    cat "conftest.in" "conftest.in" >"conftest.tmp"
+    mv "conftest.tmp" "conftest.in"
+    cp "conftest.in" "conftest.nl"
+    echo 'EGREP' >> "conftest.nl"
+    "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+    ac_count=`expr $ac_count + 1`
+    if test $ac_count -gt ${ac_path_EGREP_max-0}; then
+      # Best one so far, save it but keep looking for a better one
+      ac_cv_path_EGREP="$ac_path_EGREP"
+      ac_path_EGREP_max=$ac_count
+    fi
+    # 10*(2^10) chars as input seems more than enough
+    test $ac_count -gt 10 && break
+  done
+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+
+    $ac_path_EGREP_found && break 3
+  done
+done
+
+done
+IFS=$as_save_IFS
+
+
+fi
+
+EGREP="$ac_cv_path_EGREP"
+if test -z "$EGREP"; then
+  { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5
+echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;}
+   { (exit 1); exit 1; }; }
+fi
+
+else
+  ac_cv_path_EGREP=$EGREP
+fi
+
+
+   fi
+fi
+{ echo "$as_me:$LINENO: result: $ac_cv_path_EGREP" >&5
+echo "${ECHO_T}$ac_cv_path_EGREP" >&6; }
+ EGREP="$ac_cv_path_EGREP"
+
+
+{ echo "$as_me:$LINENO: checking for ANSI C header files" >&5
+echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6; }
+if test "${ac_cv_header_stdc+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+
+int
+main ()
+{
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then
+  ac_cv_header_stdc=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_cv_header_stdc=no
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+if test $ac_cv_header_stdc = yes; then
+  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <string.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "memchr" >/dev/null 2>&1; then
+  :
+else
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <stdlib.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+  $EGREP "free" >/dev/null 2>&1; then
+  :
+else
+  ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+  if test "$cross_compiling" = yes; then
+  :
+else
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <ctype.h>
+#include <stdlib.h>
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) \
+		   (('a' <= (c) && (c) <= 'i') \
+		     || ('j' <= (c) && (c) <= 'r') \
+		     || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
+#endif
+
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int
+main ()
+{
+  int i;
+  for (i = 0; i < 256; i++)
+    if (XOR (islower (i), ISLOWER (i))
+	|| toupper (i) != TOUPPER (i))
+      return 2;
+  return 0;
+}
+_ACEOF
+rm -f conftest$ac_exeext
+if { (ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
+  { (case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_try") 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  :
+else
+  echo "$as_me: program exited with status $ac_status" >&5
+echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+( exit $ac_status )
+ac_cv_header_stdc=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+fi
+
+
+fi
+fi
+{ echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5
+echo "${ECHO_T}$ac_cv_header_stdc" >&6; }
+if test $ac_cv_header_stdc = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define STDC_HEADERS 1
+_ACEOF
+
+fi
+
+# On IRIX 5.3, sys/types and inttypes.h are conflicting.
+
+
+
+
+
+
+
+
+
+for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
+		  inttypes.h stdint.h unistd.h
+do
+as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
+{ echo "$as_me:$LINENO: checking for $ac_header" >&5
+echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; }
+if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+$ac_includes_default
+
+#include <$ac_header>
+_ACEOF
+rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then
+  eval "$as_ac_Header=yes"
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	eval "$as_ac_Header=no"
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+ac_res=`eval echo '${'$as_ac_Header'}'`
+	       { echo "$as_me:$LINENO: result: $ac_res" >&5
+echo "${ECHO_T}$ac_res" >&6; }
+if test `eval echo '${'$as_ac_Header'}'` = yes; then
+  cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
+
+
+
+for ac_header in stdlib.h sys/time.h termios.h
+do
+as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
+if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
+  { echo "$as_me:$LINENO: checking for $ac_header" >&5
+echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; }
+if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+fi
+ac_res=`eval echo '${'$as_ac_Header'}'`
+	       { echo "$as_me:$LINENO: result: $ac_res" >&5
+echo "${ECHO_T}$ac_res" >&6; }
+else
+  # Is the header compilable?
+{ echo "$as_me:$LINENO: checking $ac_header usability" >&5
+echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; }
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+$ac_includes_default
+#include <$ac_header>
+_ACEOF
+rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then
+  ac_header_compiler=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_header_compiler=no
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
+echo "${ECHO_T}$ac_header_compiler" >&6; }
+
+# Is the header present?
+{ echo "$as_me:$LINENO: checking $ac_header presence" >&5
+echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; }
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <$ac_header>
+_ACEOF
+if { (ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } >/dev/null && {
+	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       }; then
+  ac_header_preproc=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+  ac_header_preproc=no
+fi
+
+rm -f conftest.err conftest.$ac_ext
+{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
+echo "${ECHO_T}$ac_header_preproc" >&6; }
+
+# So?  What about this header?
+case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
+  yes:no: )
+    { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
+echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
+    { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5
+echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}
+    ac_header_preproc=yes
+    ;;
+  no:yes:* )
+    { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
+echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
+    { echo "$as_me:$LINENO: WARNING: $ac_header:     check for missing prerequisite headers?" >&5
+echo "$as_me: WARNING: $ac_header:     check for missing prerequisite headers?" >&2;}
+    { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5
+echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}
+    { echo "$as_me:$LINENO: WARNING: $ac_header:     section \"Present But Cannot Be Compiled\"" >&5
+echo "$as_me: WARNING: $ac_header:     section \"Present But Cannot Be Compiled\"" >&2;}
+    { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
+echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}
+    { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5
+echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}
+    ( cat <<\_ASBOX
+## ----------------------------------- ##
+## Report this to nordland@csee.ltu.se ##
+## ----------------------------------- ##
+_ASBOX
+     ) | sed "s/^/$as_me: WARNING:     /" >&2
+    ;;
+esac
+{ echo "$as_me:$LINENO: checking for $ac_header" >&5
+echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; }
+if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  eval "$as_ac_Header=\$ac_header_preproc"
+fi
+ac_res=`eval echo '${'$as_ac_Header'}'`
+	       { echo "$as_me:$LINENO: result: $ac_res" >&5
+echo "${ECHO_T}$ac_res" >&6; }
+
+fi
+if test `eval echo '${'$as_ac_Header'}'` = yes; then
+  cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
+if test "${ac_cv_header_libkern_OSAtomic_h+set}" = set; then
+  { echo "$as_me:$LINENO: checking for libkern/OSAtomic.h" >&5
+echo $ECHO_N "checking for libkern/OSAtomic.h... $ECHO_C" >&6; }
+if test "${ac_cv_header_libkern_OSAtomic_h+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+fi
+{ echo "$as_me:$LINENO: result: $ac_cv_header_libkern_OSAtomic_h" >&5
+echo "${ECHO_T}$ac_cv_header_libkern_OSAtomic_h" >&6; }
+else
+  # Is the header compilable?
+{ echo "$as_me:$LINENO: checking libkern/OSAtomic.h usability" >&5
+echo $ECHO_N "checking libkern/OSAtomic.h usability... $ECHO_C" >&6; }
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+$ac_includes_default
+#include <libkern/OSAtomic.h>
+_ACEOF
+rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then
+  ac_header_compiler=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_header_compiler=no
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
+echo "${ECHO_T}$ac_header_compiler" >&6; }
+
+# Is the header present?
+{ echo "$as_me:$LINENO: checking libkern/OSAtomic.h presence" >&5
+echo $ECHO_N "checking libkern/OSAtomic.h presence... $ECHO_C" >&6; }
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <libkern/OSAtomic.h>
+_ACEOF
+if { (ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } >/dev/null && {
+	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       }; then
+  ac_header_preproc=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+  ac_header_preproc=no
+fi
+
+rm -f conftest.err conftest.$ac_ext
+{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
+echo "${ECHO_T}$ac_header_preproc" >&6; }
+
+# So?  What about this header?
+case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
+  yes:no: )
+    { echo "$as_me:$LINENO: WARNING: libkern/OSAtomic.h: accepted by the compiler, rejected by the preprocessor!" >&5
+echo "$as_me: WARNING: libkern/OSAtomic.h: accepted by the compiler, rejected by the preprocessor!" >&2;}
+    { echo "$as_me:$LINENO: WARNING: libkern/OSAtomic.h: proceeding with the compiler's result" >&5
+echo "$as_me: WARNING: libkern/OSAtomic.h: proceeding with the compiler's result" >&2;}
+    ac_header_preproc=yes
+    ;;
+  no:yes:* )
+    { echo "$as_me:$LINENO: WARNING: libkern/OSAtomic.h: present but cannot be compiled" >&5
+echo "$as_me: WARNING: libkern/OSAtomic.h: present but cannot be compiled" >&2;}
+    { echo "$as_me:$LINENO: WARNING: libkern/OSAtomic.h:     check for missing prerequisite headers?" >&5
+echo "$as_me: WARNING: libkern/OSAtomic.h:     check for missing prerequisite headers?" >&2;}
+    { echo "$as_me:$LINENO: WARNING: libkern/OSAtomic.h: see the Autoconf documentation" >&5
+echo "$as_me: WARNING: libkern/OSAtomic.h: see the Autoconf documentation" >&2;}
+    { echo "$as_me:$LINENO: WARNING: libkern/OSAtomic.h:     section \"Present But Cannot Be Compiled\"" >&5
+echo "$as_me: WARNING: libkern/OSAtomic.h:     section \"Present But Cannot Be Compiled\"" >&2;}
+    { echo "$as_me:$LINENO: WARNING: libkern/OSAtomic.h: proceeding with the preprocessor's result" >&5
+echo "$as_me: WARNING: libkern/OSAtomic.h: proceeding with the preprocessor's result" >&2;}
+    { echo "$as_me:$LINENO: WARNING: libkern/OSAtomic.h: in the future, the compiler will take precedence" >&5
+echo "$as_me: WARNING: libkern/OSAtomic.h: in the future, the compiler will take precedence" >&2;}
+    ( cat <<\_ASBOX
+## ----------------------------------- ##
+## Report this to nordland@csee.ltu.se ##
+## ----------------------------------- ##
+_ASBOX
+     ) | sed "s/^/$as_me: WARNING:     /" >&2
+    ;;
+esac
+{ echo "$as_me:$LINENO: checking for libkern/OSAtomic.h" >&5
+echo $ECHO_N "checking for libkern/OSAtomic.h... $ECHO_C" >&6; }
+if test "${ac_cv_header_libkern_OSAtomic_h+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  ac_cv_header_libkern_OSAtomic_h=$ac_header_preproc
+fi
+{ echo "$as_me:$LINENO: result: $ac_cv_header_libkern_OSAtomic_h" >&5
+echo "${ECHO_T}$ac_cv_header_libkern_OSAtomic_h" >&6; }
+
+fi
+if test $ac_cv_header_libkern_OSAtomic_h = yes; then
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_OSX_ATOMICS 1
+_ACEOF
+
+fi
+
+
+
+# Check the <sys/stat.h> header for XSI extensions. This should already be
+# enable by -D_GNU_SOURCE=1, if it's supported.
+# NOTE:
+#   While it might be possible for the compiler to optimize away the int xsi
+#   statement I'm not up for the challenge of writing something that is
+#   _impossible_ for the compiler to optimize away.
+{ echo "$as_me:$LINENO: checking sys/stat.h header for XSI extensions" >&5
+echo $ECHO_N "checking sys/stat.h header for XSI extensions... $ECHO_C" >&6; }
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <sys/stat.h>
+int
+main ()
+{
+mode_t mode_xsi = S_IWUSR|S_IRUSR|S_IRGRP|S_IROTH;
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then
+  { echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6; }
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	{ { echo "$as_me:$LINENO: error: no
+See \`config.log' for more details." >&5
+echo "$as_me: error: no
+See \`config.log' for more details." >&2;}
+   { (exit 1); exit 1; }; }
+
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+# Does this compiler have built-in functions for atomic memory access?
+{ echo "$as_me:$LINENO: checking if gcc supports __sync_bool_compare_and_swap" >&5
+echo $ECHO_N "checking if gcc supports __sync_bool_compare_and_swap... $ECHO_C" >&6; }
+
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+  int variable = 1;
+  return (__sync_bool_compare_and_swap(&variable, 1, 2)
+         && __sync_add_and_fetch(&variable, 1)) ? 1 : 0;
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_link") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest$ac_exeext &&
+       $as_test_x conftest$ac_exeext; then
+
+  { echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6; }
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_BUILTIN_ATOMIC 1
+_ACEOF
+
+
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+
+  # Retry with -march set for x86.
+  old_CFLAGS="$CFLAGS"
+  CFLAGS="$CFLAGS -march=i686"
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+int
+main ()
+{
+
+    int variable = 1;
+    return (__sync_bool_compare_and_swap(&variable, 1, 2)
+           && __sync_add_and_fetch(&variable, 1)) ? 1 : 0;
+
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_link") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest$ac_exeext &&
+       $as_test_x conftest$ac_exeext; then
+
+    { echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6; }
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_BUILTIN_ATOMIC 1
+_ACEOF
+
+
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+
+    { echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6; }
+    CFLAGS="$old_CFLAGS"
+
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
+      conftest$ac_exeext conftest.$ac_ext
+
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
+      conftest$ac_exeext conftest.$ac_ext
+
+# Checks for typedefs, structures, and compiler characteristics.
+{ echo "$as_me:$LINENO: checking whether time.h and sys/time.h may both be included" >&5
+echo $ECHO_N "checking whether time.h and sys/time.h may both be included... $ECHO_C" >&6; }
+if test "${ac_cv_header_time+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <sys/types.h>
+#include <sys/time.h>
+#include <time.h>
+
+int
+main ()
+{
+if ((struct tm *) 0)
+return 0;
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then
+  ac_cv_header_time=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_cv_header_time=no
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+{ echo "$as_me:$LINENO: result: $ac_cv_header_time" >&5
+echo "${ECHO_T}$ac_cv_header_time" >&6; }
+if test $ac_cv_header_time = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define TIME_WITH_SYS_TIME 1
+_ACEOF
+
+fi
+
+
+# Look for the timber compiler
+
+# Checks for library functions.
+
+for ac_header in stdlib.h
+do
+as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
+if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
+  { echo "$as_me:$LINENO: checking for $ac_header" >&5
+echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; }
+if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+fi
+ac_res=`eval echo '${'$as_ac_Header'}'`
+	       { echo "$as_me:$LINENO: result: $ac_res" >&5
+echo "${ECHO_T}$ac_res" >&6; }
+else
+  # Is the header compilable?
+{ echo "$as_me:$LINENO: checking $ac_header usability" >&5
+echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6; }
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+$ac_includes_default
+#include <$ac_header>
+_ACEOF
+rm -f conftest.$ac_objext
+if { (ac_try="$ac_compile"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_compile") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest.$ac_objext; then
+  ac_header_compiler=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	ac_header_compiler=no
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+{ echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
+echo "${ECHO_T}$ac_header_compiler" >&6; }
+
+# Is the header present?
+{ echo "$as_me:$LINENO: checking $ac_header presence" >&5
+echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6; }
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#include <$ac_header>
+_ACEOF
+if { (ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } >/dev/null && {
+	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       }; then
+  ac_header_preproc=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+  ac_header_preproc=no
+fi
+
+rm -f conftest.err conftest.$ac_ext
+{ echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
+echo "${ECHO_T}$ac_header_preproc" >&6; }
+
+# So?  What about this header?
+case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
+  yes:no: )
+    { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
+echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
+    { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5
+echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}
+    ac_header_preproc=yes
+    ;;
+  no:yes:* )
+    { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
+echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
+    { echo "$as_me:$LINENO: WARNING: $ac_header:     check for missing prerequisite headers?" >&5
+echo "$as_me: WARNING: $ac_header:     check for missing prerequisite headers?" >&2;}
+    { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5
+echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}
+    { echo "$as_me:$LINENO: WARNING: $ac_header:     section \"Present But Cannot Be Compiled\"" >&5
+echo "$as_me: WARNING: $ac_header:     section \"Present But Cannot Be Compiled\"" >&2;}
+    { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
+echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}
+    { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5
+echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}
+    ( cat <<\_ASBOX
+## ----------------------------------- ##
+## Report this to nordland@csee.ltu.se ##
+## ----------------------------------- ##
+_ASBOX
+     ) | sed "s/^/$as_me: WARNING:     /" >&2
+    ;;
+esac
+{ echo "$as_me:$LINENO: checking for $ac_header" >&5
+echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; }
+if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  eval "$as_ac_Header=\$ac_header_preproc"
+fi
+ac_res=`eval echo '${'$as_ac_Header'}'`
+	       { echo "$as_me:$LINENO: result: $ac_res" >&5
+echo "${ECHO_T}$ac_res" >&6; }
+
+fi
+if test `eval echo '${'$as_ac_Header'}'` = yes; then
+  cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+{ echo "$as_me:$LINENO: checking for GNU libc compatible malloc" >&5
+echo $ECHO_N "checking for GNU libc compatible malloc... $ECHO_C" >&6; }
+if test "${ac_cv_func_malloc_0_nonnull+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  if test "$cross_compiling" = yes; then
+  ac_cv_func_malloc_0_nonnull=no
+else
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+#if defined STDC_HEADERS || defined HAVE_STDLIB_H
+# include <stdlib.h>
+#else
+char *malloc ();
+#endif
+
+int
+main ()
+{
+return ! malloc (0);
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest$ac_exeext
+if { (ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_link") 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
+  { (case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_try") 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  ac_cv_func_malloc_0_nonnull=yes
+else
+  echo "$as_me: program exited with status $ac_status" >&5
+echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+( exit $ac_status )
+ac_cv_func_malloc_0_nonnull=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+fi
+
+
+fi
+{ echo "$as_me:$LINENO: result: $ac_cv_func_malloc_0_nonnull" >&5
+echo "${ECHO_T}$ac_cv_func_malloc_0_nonnull" >&6; }
+if test $ac_cv_func_malloc_0_nonnull = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_MALLOC 1
+_ACEOF
+
+else
+  cat >>confdefs.h <<\_ACEOF
+#define HAVE_MALLOC 0
+_ACEOF
+
+   case " $LIBOBJS " in
+  *" malloc.$ac_objext "* ) ;;
+  *) LIBOBJS="$LIBOBJS malloc.$ac_objext"
+ ;;
+esac
+
+
+cat >>confdefs.h <<\_ACEOF
+#define malloc rpl_malloc
+_ACEOF
+
+fi
+
+
+
+
+for ac_func in gettimeofday
+do
+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
+{ echo "$as_me:$LINENO: checking for $ac_func" >&5
+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; }
+if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
+   For example, HP-UX 11i <limits.h> declares gettimeofday.  */
+#define $ac_func innocuous_$ac_func
+
+/* System header to define __stub macros and hopefully few prototypes,
+    which can conflict with char $ac_func (); below.
+    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+    <limits.h> exists even on freestanding compilers.  */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef $ac_func
+
+/* Override any GCC internal prototype to avoid an error.
+   Use char because int might match the return type of a GCC
+   builtin and then its argument prototype would still apply.  */
+#ifdef __cplusplus
+extern "C"
+#endif
+char $ac_func ();
+/* The GNU C library defines this for functions which it implements
+    to always fail with ENOSYS.  Some functions are actually named
+    something starting with __ and the normal name is an alias.  */
+#if defined __stub_$ac_func || defined __stub___$ac_func
+choke me
+#endif
+
+int
+main ()
+{
+return $ac_func ();
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (ac_try="$ac_link"
+case "(($ac_try" in
+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+  *) ac_try_echo=$ac_try;;
+esac
+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
+  (eval "$ac_link") 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } && {
+	 test -z "$ac_c_werror_flag" ||
+	 test ! -s conftest.err
+       } && test -s conftest$ac_exeext &&
+       $as_test_x conftest$ac_exeext; then
+  eval "$as_ac_var=yes"
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+	eval "$as_ac_var=no"
+fi
+
+rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
+      conftest$ac_exeext conftest.$ac_ext
+fi
+ac_res=`eval echo '${'$as_ac_var'}'`
+	       { echo "$as_me:$LINENO: result: $ac_res" >&5
+echo "${ECHO_T}$ac_res" >&6; }
+if test `eval echo '${'$as_ac_var'}'` = yes; then
+  cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+
+
+
+
+
+
+
+
+
+ac_config_files="$ac_config_files Makefile timberc.cfg"
+
+cat >confcache <<\_ACEOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs, see configure's option --config-cache.
+# It is not useful on other systems.  If it contains results you don't
+# want to keep, you may remove or edit it.
+#
+# config.status only pays attention to the cache file if you give it
+# the --recheck option to rerun configure.
+#
+# `ac_cv_env_foo' variables (set or unset) will be overridden when
+# loading this file, other *unset* `ac_cv_foo' will be assigned the
+# following values.
+
+_ACEOF
+
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, we kill variables containing newlines.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(
+  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
+    eval ac_val=\$$ac_var
+    case $ac_val in #(
+    *${as_nl}*)
+      case $ac_var in #(
+      *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5
+echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;;
+      esac
+      case $ac_var in #(
+      _ | IFS | as_nl) ;; #(
+      *) $as_unset $ac_var ;;
+      esac ;;
+    esac
+  done
+
+  (set) 2>&1 |
+    case $as_nl`(ac_space=' '; set) 2>&1` in #(
+    *${as_nl}ac_space=\ *)
+      # `set' does not quote correctly, so add quotes (double-quote
+      # substitution turns \\\\ into \\, and sed turns \\ into \).
+      sed -n \
+	"s/'/'\\\\''/g;
+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
+      ;; #(
+    *)
+      # `set' quotes correctly as required by POSIX, so do not add quotes.
+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
+      ;;
+    esac |
+    sort
+) |
+  sed '
+     /^ac_cv_env_/b end
+     t clear
+     :clear
+     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
+     t end
+     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+     :end' >>confcache
+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
+  if test -w "$cache_file"; then
+    test "x$cache_file" != "x/dev/null" &&
+      { echo "$as_me:$LINENO: updating cache $cache_file" >&5
+echo "$as_me: updating cache $cache_file" >&6;}
+    cat confcache >$cache_file
+  else
+    { echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5
+echo "$as_me: not updating unwritable cache $cache_file" >&6;}
+  fi
+fi
+rm -f confcache
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+DEFS=-DHAVE_CONFIG_H
+
+ac_libobjs=
+ac_ltlibobjs=
+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
+  # 1. Remove the extension, and $U if already installed.
+  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
+  ac_i=`echo "$ac_i" | sed "$ac_script"`
+  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR
+  #    will be set to the directory where LIBOBJS objects are built.
+  ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext"
+  ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo'
+done
+LIBOBJS=$ac_libobjs
+
+LTLIBOBJS=$ac_ltlibobjs
+
+
+
+: ${CONFIG_STATUS=./config.status}
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files $CONFIG_STATUS"
+{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
+echo "$as_me: creating $CONFIG_STATUS" >&6;}
+cat >$CONFIG_STATUS <<_ACEOF
+#! $SHELL
+# Generated by $as_me.
+# Run this file to recreate the current configuration.
+# Compiler output produced by configure, useful for debugging
+# configure, is in config.log if it exists.
+
+debug=false
+ac_cs_recheck=false
+ac_cs_silent=false
+SHELL=\${CONFIG_SHELL-$SHELL}
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+## --------------------- ##
+## M4sh Initialization.  ##
+## --------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+  emulate sh
+  NULLCMD=:
+  # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+  # is contrary to our usage.  Disable this feature.
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in
+  *posix*) set -o posix ;;
+esac
+
+fi
+
+
+
+
+# PATH needs CR
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+  echo "#! /bin/sh" >conf$$.sh
+  echo  "exit 0"   >>conf$$.sh
+  chmod +x conf$$.sh
+  if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+    PATH_SEPARATOR=';'
+  else
+    PATH_SEPARATOR=:
+  fi
+  rm -f conf$$.sh
+fi
+
+# Support unset when possible.
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+  as_unset=unset
+else
+  as_unset=false
+fi
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.  Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+as_nl='
+'
+IFS=" ""	$as_nl"
+
+# Find who we are.  Look in the path if we contain no directory separator.
+case $0 in
+  *[\\/]* ) as_myself=$0 ;;
+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+IFS=$as_save_IFS
+
+     ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+  as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+  echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+  { (exit 1); exit 1; }
+fi
+
+# Work around bugs in pre-3.0 UWIN ksh.
+for as_var in ENV MAIL MAILPATH
+do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var
+done
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+for as_var in \
+  LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+  LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+  LC_TELEPHONE LC_TIME
+do
+  if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
+    eval $as_var=C; export $as_var
+  else
+    ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var
+  fi
+done
+
+# Required to use basename.
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+   test "X`expr 00001 : '.*\(...\)'`" = X001; then
+  as_expr=expr
+else
+  as_expr=false
+fi
+
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
+  as_basename=basename
+else
+  as_basename=false
+fi
+
+
+# Name of the executable.
+as_me=`$as_basename -- "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+	 X"$0" : 'X\(//\)$' \| \
+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+echo X/"$0" |
+    sed '/^.*\/\([^/][^/]*\)\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\/\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+
+# CDPATH.
+$as_unset CDPATH
+
+
+
+  as_lineno_1=$LINENO
+  as_lineno_2=$LINENO
+  test "x$as_lineno_1" != "x$as_lineno_2" &&
+  test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || {
+
+  # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+  # uniformly replaced by the line number.  The first 'sed' inserts a
+  # line-number line after each line using $LINENO; the second 'sed'
+  # does the real work.  The second script uses 'N' to pair each
+  # line-number line with the line containing $LINENO, and appends
+  # trailing '-' during substitution so that $LINENO is not a special
+  # case at line end.
+  # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+  # scripts with optimization help from Paolo Bonzini.  Blame Lee
+  # E. McMahon (1931-1989) for sed's syntax.  :-)
+  sed -n '
+    p
+    /[$]LINENO/=
+  ' <$as_myself |
+    sed '
+      s/[$]LINENO.*/&-/
+      t lineno
+      b
+      :lineno
+      N
+      :loop
+      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
+      t loop
+      s/-\n.*//
+    ' >$as_me.lineno &&
+  chmod +x "$as_me.lineno" ||
+    { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
+   { (exit 1); exit 1; }; }
+
+  # Don't try to exec as it changes $[0], causing all sort of problems
+  # (the dirname of $[0] is not the place where we might find the
+  # original and so on.  Autoconf is especially sensitive to this).
+  . "./$as_me.lineno"
+  # Exit status is that of the last command.
+  exit
+}
+
+
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+  as_dirname=dirname
+else
+  as_dirname=false
+fi
+
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in
+-n*)
+  case `echo 'x\c'` in
+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
+  *)   ECHO_C='\c';;
+  esac;;
+*)
+  ECHO_N='-n';;
+esac
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+   test "X`expr 00001 : '.*\(...\)'`" = X001; then
+  as_expr=expr
+else
+  as_expr=false
+fi
+
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+  rm -f conf$$.dir/conf$$.file
+else
+  rm -f conf$$.dir
+  mkdir conf$$.dir
+fi
+echo >conf$$.file
+if ln -s conf$$.file conf$$ 2>/dev/null; then
+  as_ln_s='ln -s'
+  # ... but there are two gotchas:
+  # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+  # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+  # In both cases, we have to default to `cp -p'.
+  ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+    as_ln_s='cp -p'
+elif ln conf$$.file conf$$ 2>/dev/null; then
+  as_ln_s=ln
+else
+  as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
+
+if mkdir -p . 2>/dev/null; then
+  as_mkdir_p=:
+else
+  test -d ./-p && rmdir ./-p
+  as_mkdir_p=false
+fi
+
+if test -x / >/dev/null 2>&1; then
+  as_test_x='test -x'
+else
+  if ls -dL / >/dev/null 2>&1; then
+    as_ls_L_option=L
+  else
+    as_ls_L_option=
+  fi
+  as_test_x='
+    eval sh -c '\''
+      if test -d "$1"; then
+        test -d "$1/.";
+      else
+	case $1 in
+        -*)set "./$1";;
+	esac;
+	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in
+	???[sx]*):;;*)false;;esac;fi
+    '\'' sh
+  '
+fi
+as_executable_p=$as_test_x
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+exec 6>&1
+
+# Save the log message, to keep $[0] and so on meaningful, and to
+# report actual input values of CONFIG_FILES etc. instead of their
+# values after options handling.
+ac_log="
+This file was extended by rtsPOSIX $as_me 0.9.9, which was
+generated by GNU Autoconf 2.61.  Invocation command line was
+
+  CONFIG_FILES    = $CONFIG_FILES
+  CONFIG_HEADERS  = $CONFIG_HEADERS
+  CONFIG_LINKS    = $CONFIG_LINKS
+  CONFIG_COMMANDS = $CONFIG_COMMANDS
+  $ $0 $@
+
+on `(hostname || uname -n) 2>/dev/null | sed 1q`
+"
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<_ACEOF
+# Files that config.status was made for.
+config_files="$ac_config_files"
+config_headers="$ac_config_headers"
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+ac_cs_usage="\
+\`$as_me' instantiates files from templates according to the
+current configuration.
+
+Usage: $0 [OPTIONS] [FILE]...
+
+  -h, --help       print this help, then exit
+  -V, --version    print version number and configuration settings, then exit
+  -q, --quiet      do not print progress messages
+  -d, --debug      don't remove temporary files
+      --recheck    update $as_me by reconfiguring in the same conditions
+  --file=FILE[:TEMPLATE]
+		   instantiate the configuration file FILE
+  --header=FILE[:TEMPLATE]
+		   instantiate the configuration header FILE
+
+Configuration files:
+$config_files
+
+Configuration headers:
+$config_headers
+
+Report bugs to <bug-autoconf@gnu.org>."
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
+ac_cs_version="\\
+rtsPOSIX config.status 0.9.9
+configured by $0, generated by GNU Autoconf 2.61,
+  with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"
+
+Copyright (C) 2006 Free Software Foundation, Inc.
+This config.status script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it."
+
+ac_pwd='$ac_pwd'
+srcdir='$srcdir'
+INSTALL='$INSTALL'
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+# If no file are specified by the user, then we need to provide default
+# value.  By we need to know if files were specified by the user.
+ac_need_defaults=:
+while test $# != 0
+do
+  case $1 in
+  --*=*)
+    ac_option=`expr "X$1" : 'X\([^=]*\)='`
+    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
+    ac_shift=:
+    ;;
+  *)
+    ac_option=$1
+    ac_optarg=$2
+    ac_shift=shift
+    ;;
+  esac
+
+  case $ac_option in
+  # Handling of the options.
+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+    ac_cs_recheck=: ;;
+  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
+    echo "$ac_cs_version"; exit ;;
+  --debug | --debu | --deb | --de | --d | -d )
+    debug=: ;;
+  --file | --fil | --fi | --f )
+    $ac_shift
+    CONFIG_FILES="$CONFIG_FILES $ac_optarg"
+    ac_need_defaults=false;;
+  --header | --heade | --head | --hea )
+    $ac_shift
+    CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
+    ac_need_defaults=false;;
+  --he | --h)
+    # Conflict between --help and --header
+    { echo "$as_me: error: ambiguous option: $1
+Try \`$0 --help' for more information." >&2
+   { (exit 1); exit 1; }; };;
+  --help | --hel | -h )
+    echo "$ac_cs_usage"; exit ;;
+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+  | -silent | --silent | --silen | --sile | --sil | --si | --s)
+    ac_cs_silent=: ;;
+
+  # This is an error.
+  -*) { echo "$as_me: error: unrecognized option: $1
+Try \`$0 --help' for more information." >&2
+   { (exit 1); exit 1; }; } ;;
+
+  *) ac_config_targets="$ac_config_targets $1"
+     ac_need_defaults=false ;;
+
+  esac
+  shift
+done
+
+ac_configure_extra_args=
+
+if $ac_cs_silent; then
+  exec 6>/dev/null
+  ac_configure_extra_args="$ac_configure_extra_args --silent"
+fi
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
+if \$ac_cs_recheck; then
+  echo "running CONFIG_SHELL=$SHELL $SHELL $0 "$ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
+  CONFIG_SHELL=$SHELL
+  export CONFIG_SHELL
+  exec $SHELL "$0"$ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+fi
+
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+exec 5>>config.log
+{
+  echo
+  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+  echo "$ac_log"
+} >&5
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+# Handling of arguments.
+for ac_config_target in $ac_config_targets
+do
+  case $ac_config_target in
+    "config.h") CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;;
+    "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;;
+    "timberc.cfg") CONFIG_FILES="$CONFIG_FILES timberc.cfg" ;;
+
+  *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
+echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
+   { (exit 1); exit 1; }; };;
+  esac
+done
+
+
+# If the user did not use the arguments to specify the items to instantiate,
+# then the envvar interface is used.  Set only those that are not.
+# We use the long form for the default assignment because of an extremely
+# bizarre bug on SunOS 4.1.3.
+if $ac_need_defaults; then
+  test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
+  test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers
+fi
+
+# Have a temporary directory for convenience.  Make it in the build tree
+# simply because there is no reason against having it here, and in addition,
+# creating and moving files from /tmp can sometimes cause problems.
+# Hook for its removal unless debugging.
+# Note that there is a small window in which the directory will not be cleaned:
+# after its creation but before its name has been assigned to `$tmp'.
+$debug ||
+{
+  tmp=
+  trap 'exit_status=$?
+  { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status
+' 0
+  trap '{ (exit 1); exit 1; }' 1 2 13 15
+}
+# Create a (secure) tmp directory for tmp files.
+
+{
+  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
+  test -n "$tmp" && test -d "$tmp"
+}  ||
+{
+  tmp=./conf$$-$RANDOM
+  (umask 077 && mkdir "$tmp")
+} ||
+{
+   echo "$me: cannot create a temporary directory in ." >&2
+   { (exit 1); exit 1; }
+}
+
+#
+# Set up the sed scripts for CONFIG_FILES section.
+#
+
+# No need to generate the scripts if there are no CONFIG_FILES.
+# This happens for instance when ./config.status config.h
+if test -n "$CONFIG_FILES"; then
+
+_ACEOF
+
+
+
+ac_delim='%!_!# '
+for ac_last_try in false false false false false :; do
+  cat >conf$$subs.sed <<_ACEOF
+SHELL!$SHELL$ac_delim
+PATH_SEPARATOR!$PATH_SEPARATOR$ac_delim
+PACKAGE_NAME!$PACKAGE_NAME$ac_delim
+PACKAGE_TARNAME!$PACKAGE_TARNAME$ac_delim
+PACKAGE_VERSION!$PACKAGE_VERSION$ac_delim
+PACKAGE_STRING!$PACKAGE_STRING$ac_delim
+PACKAGE_BUGREPORT!$PACKAGE_BUGREPORT$ac_delim
+exec_prefix!$exec_prefix$ac_delim
+prefix!$prefix$ac_delim
+program_transform_name!$program_transform_name$ac_delim
+bindir!$bindir$ac_delim
+sbindir!$sbindir$ac_delim
+libexecdir!$libexecdir$ac_delim
+datarootdir!$datarootdir$ac_delim
+datadir!$datadir$ac_delim
+sysconfdir!$sysconfdir$ac_delim
+sharedstatedir!$sharedstatedir$ac_delim
+localstatedir!$localstatedir$ac_delim
+includedir!$includedir$ac_delim
+oldincludedir!$oldincludedir$ac_delim
+docdir!$docdir$ac_delim
+infodir!$infodir$ac_delim
+htmldir!$htmldir$ac_delim
+dvidir!$dvidir$ac_delim
+pdfdir!$pdfdir$ac_delim
+psdir!$psdir$ac_delim
+libdir!$libdir$ac_delim
+localedir!$localedir$ac_delim
+mandir!$mandir$ac_delim
+DEFS!$DEFS$ac_delim
+ECHO_C!$ECHO_C$ac_delim
+ECHO_N!$ECHO_N$ac_delim
+ECHO_T!$ECHO_T$ac_delim
+LIBS!$LIBS$ac_delim
+build_alias!$build_alias$ac_delim
+host_alias!$host_alias$ac_delim
+target_alias!$target_alias$ac_delim
+CC!$CC$ac_delim
+CFLAGS!$CFLAGS$ac_delim
+LDFLAGS!$LDFLAGS$ac_delim
+CPPFLAGS!$CPPFLAGS$ac_delim
+ac_ct_CC!$ac_ct_CC$ac_delim
+EXEEXT!$EXEEXT$ac_delim
+OBJEXT!$OBJEXT$ac_delim
+INSTALL_PROGRAM!$INSTALL_PROGRAM$ac_delim
+INSTALL_SCRIPT!$INSTALL_SCRIPT$ac_delim
+INSTALL_DATA!$INSTALL_DATA$ac_delim
+build!$build$ac_delim
+build_cpu!$build_cpu$ac_delim
+build_vendor!$build_vendor$ac_delim
+build_os!$build_os$ac_delim
+host!$host$ac_delim
+host_cpu!$host_cpu$ac_delim
+host_vendor!$host_vendor$ac_delim
+host_os!$host_os$ac_delim
+acx_pthread_config!$acx_pthread_config$ac_delim
+PTHREAD_CC!$PTHREAD_CC$ac_delim
+PTHREAD_LIBS!$PTHREAD_LIBS$ac_delim
+PTHREAD_CFLAGS!$PTHREAD_CFLAGS$ac_delim
+TIMBERC!$TIMBERC$ac_delim
+CPP!$CPP$ac_delim
+GREP!$GREP$ac_delim
+EGREP!$EGREP$ac_delim
+LIBOBJS!$LIBOBJS$ac_delim
+SRC!$SRC$ac_delim
+DEST!$DEST$ac_delim
+LTLIBOBJS!$LTLIBOBJS$ac_delim
+_ACEOF
+
+  if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 67; then
+    break
+  elif $ac_last_try; then
+    { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5
+echo "$as_me: error: could not make $CONFIG_STATUS" >&2;}
+   { (exit 1); exit 1; }; }
+  else
+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
+  fi
+done
+
+ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed`
+if test -n "$ac_eof"; then
+  ac_eof=`echo "$ac_eof" | sort -nru | sed 1q`
+  ac_eof=`expr $ac_eof + 1`
+fi
+
+cat >>$CONFIG_STATUS <<_ACEOF
+cat >"\$tmp/subs-1.sed" <<\CEOF$ac_eof
+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b end
+_ACEOF
+sed '
+s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g
+s/^/s,@/; s/!/@,|#_!!_#|/
+:n
+t n
+s/'"$ac_delim"'$/,g/; t
+s/$/\\/; p
+N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n
+' >>$CONFIG_STATUS <conf$$subs.sed
+rm -f conf$$subs.sed
+cat >>$CONFIG_STATUS <<_ACEOF
+:end
+s/|#_!!_#|//g
+CEOF$ac_eof
+_ACEOF
+
+
+# VPATH may cause trouble with some makes, so we remove $(srcdir),
+# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
+# trailing colons and then remove the whole line if VPATH becomes empty
+# (actually we leave an empty line to preserve line numbers).
+if test "x$srcdir" = x.; then
+  ac_vpsub='/^[	 ]*VPATH[	 ]*=/{
+s/:*\$(srcdir):*/:/
+s/:*\${srcdir}:*/:/
+s/:*@srcdir@:*/:/
+s/^\([^=]*=[	 ]*\):*/\1/
+s/:*$//
+s/^[^=]*=[	 ]*$//
+}'
+fi
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+fi # test -n "$CONFIG_FILES"
+
+
+for ac_tag in  :F $CONFIG_FILES  :H $CONFIG_HEADERS
+do
+  case $ac_tag in
+  :[FHLC]) ac_mode=$ac_tag; continue;;
+  esac
+  case $ac_mode$ac_tag in
+  :[FHL]*:*);;
+  :L* | :C*:*) { { echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5
+echo "$as_me: error: Invalid tag $ac_tag." >&2;}
+   { (exit 1); exit 1; }; };;
+  :[FH]-) ac_tag=-:-;;
+  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
+  esac
+  ac_save_IFS=$IFS
+  IFS=:
+  set x $ac_tag
+  IFS=$ac_save_IFS
+  shift
+  ac_file=$1
+  shift
+
+  case $ac_mode in
+  :L) ac_source=$1;;
+  :[FH])
+    ac_file_inputs=
+    for ac_f
+    do
+      case $ac_f in
+      -) ac_f="$tmp/stdin";;
+      *) # Look for the file first in the build tree, then in the source tree
+	 # (if the path is not absolute).  The absolute path cannot be DOS-style,
+	 # because $ac_f cannot contain `:'.
+	 test -f "$ac_f" ||
+	   case $ac_f in
+	   [\\/$]*) false;;
+	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
+	   esac ||
+	   { { echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5
+echo "$as_me: error: cannot find input file: $ac_f" >&2;}
+   { (exit 1); exit 1; }; };;
+      esac
+      ac_file_inputs="$ac_file_inputs $ac_f"
+    done
+
+    # Let's still pretend it is `configure' which instantiates (i.e., don't
+    # use $as_me), people would be surprised to read:
+    #    /* config.h.  Generated by config.status.  */
+    configure_input="Generated from "`IFS=:
+	  echo $* | sed 's|^[^:]*/||;s|:[^:]*/|, |g'`" by configure."
+    if test x"$ac_file" != x-; then
+      configure_input="$ac_file.  $configure_input"
+      { echo "$as_me:$LINENO: creating $ac_file" >&5
+echo "$as_me: creating $ac_file" >&6;}
+    fi
+
+    case $ac_tag in
+    *:-:* | *:-) cat >"$tmp/stdin";;
+    esac
+    ;;
+  esac
+
+  ac_dir=`$as_dirname -- "$ac_file" ||
+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$ac_file" : 'X\(//\)[^/]' \| \
+	 X"$ac_file" : 'X\(//\)$' \| \
+	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
+echo X"$ac_file" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+  { as_dir="$ac_dir"
+  case $as_dir in #(
+  -*) as_dir=./$as_dir;;
+  esac
+  test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || {
+    as_dirs=
+    while :; do
+      case $as_dir in #(
+      *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #(
+      *) as_qdir=$as_dir;;
+      esac
+      as_dirs="'$as_qdir' $as_dirs"
+      as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+	 X"$as_dir" : 'X\(//\)[^/]' \| \
+	 X"$as_dir" : 'X\(//\)$' \| \
+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+echo X"$as_dir" |
+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)[^/].*/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\/\)$/{
+	    s//\1/
+	    q
+	  }
+	  /^X\(\/\).*/{
+	    s//\1/
+	    q
+	  }
+	  s/.*/./; q'`
+      test -d "$as_dir" && break
+    done
+    test -z "$as_dirs" || eval "mkdir $as_dirs"
+  } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5
+echo "$as_me: error: cannot create directory $as_dir" >&2;}
+   { (exit 1); exit 1; }; }; }
+  ac_builddir=.
+
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+  ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+  # A ".." for each directory in $ac_dir_suffix.
+  ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'`
+  case $ac_top_builddir_sub in
+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+  esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
+
+case $srcdir in
+  .)  # We are building in place.
+    ac_srcdir=.
+    ac_top_srcdir=$ac_top_builddir_sub
+    ac_abs_top_srcdir=$ac_pwd ;;
+  [\\/]* | ?:[\\/]* )  # Absolute name.
+    ac_srcdir=$srcdir$ac_dir_suffix;
+    ac_top_srcdir=$srcdir
+    ac_abs_top_srcdir=$srcdir ;;
+  *) # Relative name.
+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+    ac_top_srcdir=$ac_top_build_prefix$srcdir
+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
+esac
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+
+  case $ac_mode in
+  :F)
+  #
+  # CONFIG_FILE
+  #
+
+  case $INSTALL in
+  [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;;
+  *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;;
+  esac
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+# If the template does not know about datarootdir, expand it.
+# FIXME: This hack should be removed a few years after 2.60.
+ac_datarootdir_hack=; ac_datarootdir_seen=
+
+case `sed -n '/datarootdir/ {
+  p
+  q
+}
+/@datadir@/p
+/@docdir@/p
+/@infodir@/p
+/@localedir@/p
+/@mandir@/p
+' $ac_file_inputs` in
+*datarootdir*) ac_datarootdir_seen=yes;;
+*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
+  { echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
+echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
+  ac_datarootdir_hack='
+  s&@datadir@&$datadir&g
+  s&@docdir@&$docdir&g
+  s&@infodir@&$infodir&g
+  s&@localedir@&$localedir&g
+  s&@mandir@&$mandir&g
+    s&\\\${datarootdir}&$datarootdir&g' ;;
+esac
+_ACEOF
+
+# Neutralize VPATH when `$srcdir' = `.'.
+# Shell code in configure.ac might set extrasub.
+# FIXME: do we really want to maintain this feature?
+cat >>$CONFIG_STATUS <<_ACEOF
+  sed "$ac_vpsub
+$extrasub
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+:t
+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
+s&@configure_input@&$configure_input&;t t
+s&@top_builddir@&$ac_top_builddir_sub&;t t
+s&@srcdir@&$ac_srcdir&;t t
+s&@abs_srcdir@&$ac_abs_srcdir&;t t
+s&@top_srcdir@&$ac_top_srcdir&;t t
+s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t
+s&@builddir@&$ac_builddir&;t t
+s&@abs_builddir@&$ac_abs_builddir&;t t
+s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
+s&@INSTALL@&$ac_INSTALL&;t t
+$ac_datarootdir_hack
+" $ac_file_inputs | sed -f "$tmp/subs-1.sed" >$tmp/out
+
+test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
+  { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } &&
+  { ac_out=`sed -n '/^[	 ]*datarootdir[	 ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } &&
+  { echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined.  Please make sure it is defined." >&5
+echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined.  Please make sure it is defined." >&2;}
+
+  rm -f "$tmp/stdin"
+  case $ac_file in
+  -) cat "$tmp/out"; rm -f "$tmp/out";;
+  *) rm -f "$ac_file"; mv "$tmp/out" $ac_file;;
+  esac
+ ;;
+  :H)
+  #
+  # CONFIG_HEADER
+  #
+_ACEOF
+
+# Transform confdefs.h into a sed script `conftest.defines', that
+# substitutes the proper values into config.h.in to produce config.h.
+rm -f conftest.defines conftest.tail
+# First, append a space to every undef/define line, to ease matching.
+echo 's/$/ /' >conftest.defines
+# Then, protect against being on the right side of a sed subst, or in
+# an unquoted here document, in config.status.  If some macros were
+# called several times there might be several #defines for the same
+# symbol, which is useless.  But do not sort them, since the last
+# AC_DEFINE must be honored.
+ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]*
+# These sed commands are passed to sed as "A NAME B PARAMS C VALUE D", where
+# NAME is the cpp macro being defined, VALUE is the value it is being given.
+# PARAMS is the parameter list in the macro definition--in most cases, it's
+# just an empty string.
+ac_dA='s,^\\([	 #]*\\)[^	 ]*\\([	 ]*'
+ac_dB='\\)[	 (].*,\\1define\\2'
+ac_dC=' '
+ac_dD=' ,'
+
+uniq confdefs.h |
+  sed -n '
+	t rset
+	:rset
+	s/^[	 ]*#[	 ]*define[	 ][	 ]*//
+	t ok
+	d
+	:ok
+	s/[\\&,]/\\&/g
+	s/^\('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/ '"$ac_dA"'\1'"$ac_dB"'\2'"${ac_dC}"'\3'"$ac_dD"'/p
+	s/^\('"$ac_word_re"'\)[	 ]*\(.*\)/'"$ac_dA"'\1'"$ac_dB$ac_dC"'\2'"$ac_dD"'/p
+  ' >>conftest.defines
+
+# Remove the space that was appended to ease matching.
+# Then replace #undef with comments.  This is necessary, for
+# example, in the case of _POSIX_SOURCE, which is predefined and required
+# on some systems where configure will not decide to define it.
+# (The regexp can be short, since the line contains either #define or #undef.)
+echo 's/ $//
+s,^[	 #]*u.*,/* & */,' >>conftest.defines
+
+# Break up conftest.defines:
+ac_max_sed_lines=50
+
+# First sed command is:	 sed -f defines.sed $ac_file_inputs >"$tmp/out1"
+# Second one is:	 sed -f defines.sed "$tmp/out1" >"$tmp/out2"
+# Third one will be:	 sed -f defines.sed "$tmp/out2" >"$tmp/out1"
+# et cetera.
+ac_in='$ac_file_inputs'
+ac_out='"$tmp/out1"'
+ac_nxt='"$tmp/out2"'
+
+while :
+do
+  # Write a here document:
+    cat >>$CONFIG_STATUS <<_ACEOF
+    # First, check the format of the line:
+    cat >"\$tmp/defines.sed" <<\\CEOF
+/^[	 ]*#[	 ]*undef[	 ][	 ]*$ac_word_re[	 ]*\$/b def
+/^[	 ]*#[	 ]*define[	 ][	 ]*$ac_word_re[(	 ]/b def
+b
+:def
+_ACEOF
+  sed ${ac_max_sed_lines}q conftest.defines >>$CONFIG_STATUS
+  echo 'CEOF
+    sed -f "$tmp/defines.sed"' "$ac_in >$ac_out" >>$CONFIG_STATUS
+  ac_in=$ac_out; ac_out=$ac_nxt; ac_nxt=$ac_in
+  sed 1,${ac_max_sed_lines}d conftest.defines >conftest.tail
+  grep . conftest.tail >/dev/null || break
+  rm -f conftest.defines
+  mv conftest.tail conftest.defines
+done
+rm -f conftest.defines conftest.tail
+
+echo "ac_result=$ac_in" >>$CONFIG_STATUS
+cat >>$CONFIG_STATUS <<\_ACEOF
+  if test x"$ac_file" != x-; then
+    echo "/* $configure_input  */" >"$tmp/config.h"
+    cat "$ac_result" >>"$tmp/config.h"
+    if diff $ac_file "$tmp/config.h" >/dev/null 2>&1; then
+      { echo "$as_me:$LINENO: $ac_file is unchanged" >&5
+echo "$as_me: $ac_file is unchanged" >&6;}
+    else
+      rm -f $ac_file
+      mv "$tmp/config.h" $ac_file
+    fi
+  else
+    echo "/* $configure_input  */"
+    cat "$ac_result"
+  fi
+  rm -f "$tmp/out12"
+ ;;
+
+
+  esac
+
+done # for ac_tag
+
+
+{ (exit 0); exit 0; }
+_ACEOF
+chmod +x $CONFIG_STATUS
+ac_clean_files=$ac_clean_files_save
+
+
+# configure is writing to config.log, and then calls config.status.
+# config.status does its own redirection, appending to config.log.
+# Unfortunately, on DOS this fails, as config.log is still kept open
+# by configure, so config.status won't be able to write to it; its
+# output is simply discarded.  So we exec the FD to /dev/null,
+# effectively closing config.log, so it can be properly (re)opened and
+# appended to by config.status.  When coming back to configure, we
+# need to make the FD available again.
+if test "$no_create" != yes; then
+  ac_cs_success=:
+  ac_config_status_args=
+  test "$silent" = yes &&
+    ac_config_status_args="$ac_config_status_args --quiet"
+  exec 5>/dev/null
+  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
+  exec 5>>config.log
+  # Use ||, not &&, to avoid exiting from the if with $? = 1, which
+  # would make configure fail if this is the last instruction.
+  $ac_cs_success || { (exit 1); exit 1; }
+fi
+
diff --git a/rtsPOSIX/cyclic.c b/rtsPOSIX/cyclic.c
new file mode 100644
--- /dev/null
+++ b/rtsPOSIX/cyclic.c
@@ -0,0 +1,144 @@
+// The Timber compiler <timber-lang.org>
+// 
+// Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+// All rights reserved.
+// 
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions
+// are met:
+// 
+// 1. Redistributions of source code must retain the above copyright
+//    notice, this list of conditions and the following disclaimer.
+// 
+// 2. Redistributions in binary form must reproduce the above copyright
+//    notice, this list of conditions and the following disclaimer in the
+//    documentation and/or other materials provided with the distribution.
+// 
+// 3. Neither the names of the copyright holder and any identified
+//    contributors, nor the names of their affiliations, may be used to 
+//    endorse or promote products derived from this software without 
+//    specific prior written permission.
+// 
+// THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+// OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+// DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+// ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+// OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+// HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+// STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+// ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+// POSSIBILITY OF SUCH DAMAGE.
+
+
+#define BIT0(val)               (((WORD)(val)) & 0x01)
+#define CLR0(val)               ((WORD)(val) & (~0x01))
+#define TOGGLE0(val)            ((WORD)(val) ^ 0x01)
+
+#define ISPLACEHOLDER(obj)      (BIT0(obj) && ((int)(obj) < 0))
+#define INDEXOF(obj)            (((-(int)(obj)) >> 1) - current->placeholders)
+#define PLACEHOLDER(index)      (-((((index) + current->placeholders) << 1) | 0x01))
+
+#define CURRENT_CYCLE(obj,roots)    !INSIDE(heapchain,obj,(ADDR)roots)
+
+#define SUBST(obj,off,roots,lim)      { ADDR obj1 = (ADDR)obj[off]; \
+                                        if (ISPLACEHOLDER(obj1)) { \
+                                                int index = INDEXOF(obj1); \
+                                                if (index >= 0 && index < (lim)) \
+                                                        obj[off] = (WORD)roots->elems[index]; \
+                                        } \
+                                      }
+
+ADDR substObj(ADDR obj, Array roots, int limit, Thread current) {
+        ADDR info = IND0(obj);
+        if (!info)                                      // if gcinfo is null we have reached the end of a heap segment
+                return (ADDR)obj[1];                    // pointer to first object of next segment is found in subsequent slot
+        switch (GC_TYPE(info)) {
+                case GC_STD: {
+                        WORD size = STATIC_SIZE(info), i = 2, offset = info[i];
+                        while (offset) {
+                                SUBST(obj,offset,roots,limit);
+                                offset = info[++i];
+                        }
+                        return obj + size;
+                }
+                case GC_ARRAY: {
+                        WORD size = STATIC_SIZE(info) + obj[1], offset = 2;     // find size of dynamic part in second slot of obj, add static size
+                        if (info[2])
+                                return obj + size;                              // return immediately if array contains only scalars
+                        while (offset<size) {
+                                SUBST(obj,offset,roots,limit);
+                                offset++;
+                        }
+                        return obj + size;
+                }
+                case GC_TUPLE: {
+                        WORD width = obj[1], offset = 1 + POLYTAGS(width), i = 1, j, tags;
+                        while (width > 32) {
+                                for (j = 0, tags = obj[i++]; j < 32; j++, offset++, tags = tags >> 1)
+                                        if (!(tags & 1))
+                                                SUBST(obj,offset,roots,limit);
+                                width -= 32;
+                        }
+                        for (tags = obj[i]; width > 0; width--, offset++, tags = tags >> 1) 
+                                if (!(tags & 1))
+                                        SUBST(obj,offset,roots,limit);
+                        return obj + STATIC_SIZE(info) + width + POLYTAGS(width);
+                }
+                case GC_BIG: {
+                        WORD size = STATIC_SIZE(info), i = 2, offset = info[i];
+                        while (offset) {                                        // subst all statically known pointer fields
+                                SUBST(obj,offset,roots,limit);
+                                offset = info[++i];
+                        }
+                        offset = info[++i];
+                        while (offset) {                                        // subst dynamically identified pointers
+                                WORD tagword = info[++i];
+                                WORD bitno = info[++i];
+                                if ((tagword & (1 << bitno)) == 0)
+                                        SUBST(obj,offset,roots,limit);
+                                offset = info[++i];
+                        }
+                        return obj + size;
+                }
+                case GC_MUT: {
+                        return substObj(obj + STATIC_SIZE(info), roots, limit, current);
+                }
+        }
+        return (ADDR)0;                 // Not reached
+}
+
+void subst(Array roots, int limit, ADDR stop, Thread current) {
+        ADDR p = (ADDR)roots + STATIC_SIZE(roots->GCINFO) + roots->size;
+        int i;
+        for (i = 0; i < limit; i++)
+                if (ISPLACEHOLDER(roots->elems[i])) 
+                        RAISE(2);
+        while (p != stop)
+                p = substObj(p, roots, limit, current);
+}
+
+Array CYCLIC_BEGIN(Int n, Int updates) {
+        Thread current = CURRENT();
+        Array roots = EmptyArray(0,n);
+        int i;
+        for (i = 0; i < n; i++)
+                roots->elems[i] = (POLY)PLACEHOLDER(i);
+        current->placeholders += n;
+        return roots;
+}
+
+void CYCLIC_UPDATE(Array roots, Int limit, ADDR stop) {
+        Thread current = CURRENT();
+        current->placeholders -= roots->size;
+        subst(roots, limit, stop, current);
+        current->placeholders += roots->size;
+}
+
+void CYCLIC_END(Array roots, ADDR stop) {
+        Thread current = CURRENT();
+        current->placeholders -= roots->size;
+        subst(roots, roots->size, stop, current);
+}
+
diff --git a/rtsPOSIX/env.c b/rtsPOSIX/env.c
new file mode 100644
--- /dev/null
+++ b/rtsPOSIX/env.c
@@ -0,0 +1,618 @@
+// The Timber compiler <timber-lang.org>
+// 
+// Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+// All rights reserved.
+// 
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions
+// are met:
+// 
+// 1. Redistributions of source code must retain the above copyright
+//    notice, this list of conditions and the following disclaimer.
+// 
+// 2. Redistributions in binary form must reproduce the above copyright
+//    notice, this list of conditions and the following disclaimer in the
+//    documentation and/or other materials provided with the distribution.
+// 
+// 3. Neither the names of the copyright holder and any identified
+//    contributors, nor the names of their affiliations, may be used to 
+//    endorse or promote products derived from this software without 
+//    specific prior written permission.
+// 
+// THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+// OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+// DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+// ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+// OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+// HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+// STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+// ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+// POSSIBILITY OF SUCH DAMAGE.
+
+#include <fcntl.h>
+#include <pthread.h>
+#include <unistd.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <netdb.h>
+#include <arpa/inet.h>
+#include <errno.h>
+#include "POSIX.h"
+#include "env.h"
+
+#define SIGSELECT SIGUSR1
+
+#define ADD_RDTABLE(desc,act) {rdTable[desc] = act; FD_SET(desc,&readUsed); }
+#define ADD_WRTABLE(desc,act) {wrTable[desc] = act; FD_SET(desc,&writeUsed); }
+
+#define CLR_RDTABLE(desc) {rdTable[desc] = NULL; FD_CLR(desc, &readUsed);}
+#define CLR_WRTABLE(desc) {wrTable[desc] = NULL; FD_CLR(desc, &writeUsed);}
+
+// --------- Socket data stored in global array sockTable, indexed by descriptor -------------------------------------------------
+
+struct SockData {
+  WORD *GCINFO;
+  struct sockaddr_in addr;              // address of remote peer
+  SOCKHANDLER handler;      
+};
+
+WORD __GC__SockData[] = { WORDS(sizeof(struct SockData)), GC_STD, WORDS(offsetof(struct SockData,handler)), 0 };
+
+typedef struct SockData *SockData;
+
+
+// -------- Global variables ---------------------------------------------------
+
+/*
+
+  Bit n in readUsed is set iff
+  - we have used installR to install a callback for the RFile with descriptor n; the callback is rdTable[n] OR
+  - n is a (server) socket, we have called listen and are waiting for clients to connect; handler is sockTable[i] OR
+  - n is a socket with an established connection; deliver method of the Destination is rdTable[i] and sockTable[i] contains
+    SockData (needed for future closing message).
+
+  Bit n in writeUsed is set iff
+  - we have used installW to install a callback for the WFile with descriptor n; the callback is wrTable[i] OR
+  - n is a (client) socket, we have called connect and are waiting for connection with server to be established; sockTable[i]
+    contains SockData from which we can construct the handler when connection is set up.
+
+  In all other cases, bits are cleared and array entries are NULL.
+
+  eventLoop runs the indefinite loop that repetitively blocks on select; each change to the above data strucures is 
+  reported to the calling thread through a SIGSELECT signal, so that select parameters can be adapted accordingly.
+
+  maxDesc is an upper bound on the highest descriptor in use; updated when opening, but currently not decreased on closing.
+
+*/
+
+
+fd_set readUsed, writeUsed;
+
+HANDLER rdTable[FD_SETSIZE] ;
+ACTION  wrTable[FD_SETSIZE] ;
+SockData sockTable[FD_SETSIZE];
+
+int envRootsDirty;
+
+struct Msg msg0 = { NULL, 0, { 0, 0 }, { INF, 0 }, NULL };
+
+struct Thread thread0 = { NULL, &msg0, 0,  };
+
+pthread_mutex_t envmut;
+
+int maxDesc = 2;
+
+ACTION prog                     = NULL;                         // Must be set by main()
+
+
+//---------- Utilities ---------------------------------------------------------
+
+Host_POSIX mkHost(struct sockaddr_in addr) {
+  _Host_POSIX host; NEW(_Host_POSIX, host, WORDS(sizeof(struct _Host_POSIX)));
+  host->GCINFO = __GC___Host_POSIX;
+  host->a = getStr(inet_ntoa(addr.sin_addr));
+  return (Host_POSIX)host;
+}
+
+Port_POSIX mkPort (struct sockaddr_in addr) {
+  _Port_POSIX port; NEW(_Port_POSIX, port, WORDS(sizeof(struct _Port_POSIX)));
+  port->GCINFO = __GC___Port_POSIX;
+  port->a = ntohs(addr.sin_port); 
+  return (Port_POSIX)port;
+}
+
+void netError(Int sock,char *message);
+
+// -------- Closable -----------------------------------------------------------
+
+struct DescClosable {
+  WORD *GCINFO;
+  UNITTYPE (*close_POSIX) (Closable_POSIX, Int);
+//  Msg (*close_POSIX) (Closable_POSIX, Time, Time);
+  int descriptor;
+//  DescState self;
+};
+ 
+WORD __GC__DescClosable[] = { WORDS(sizeof(struct DescClosable)), GC_STD, 0 };
+
+typedef struct DescClosable *DescClosable;
+
+struct CloseMsg;
+typedef struct CloseMsg *CloseMsg;
+
+struct CloseMsg {
+  WORD *GCINFO;
+  UNITTYPE (*Code)(CloseMsg);
+  AbsTime baseline;
+  AbsTime deadline;
+  Msg next;
+  int descriptor;
+//  DescState self;
+};
+
+WORD __GC__CloseMsg[] = { WORDS(sizeof(struct CloseMsg)), GC_STD, 0 };   // Field "next" is custom handled by the GC
+
+
+UNITTYPE close_fun (Closable_POSIX this, Int dummy) {
+  DISABLE(envmut);
+  int desc = ((DescClosable)this)->descriptor;
+  close(desc);
+  CLR_RDTABLE(desc);
+  CLR_WRTABLE(desc);
+  sockTable[desc] = NULL;
+  pthread_kill(thread0.id, SIGSELECT);
+  ENABLE(envmut);
+  return (UNITTYPE)0;
+}
+
+Closable_POSIX new_Closable (int desc) {
+  DescClosable res;
+  NEW(DescClosable, res, WORDS(sizeof(struct DescClosable)));
+  res->GCINFO = __GC__DescClosable;
+  res->close_POSIX = close_fun;
+  res->descriptor = desc;
+  return (Closable_POSIX)res;
+}
+
+// -------- File ---------------------------------------------------------------
+
+Int seek_fun (File_POSIX this, Int off, Int dummy) {
+  DISABLE(envmut);
+  Int res, mode;
+  if (off >= 0) 
+    mode = SEEK_SET;
+  else {
+    mode = SEEK_END;
+    off++;
+  }
+  res = lseek(((DescClosable)this->FILE2CLOSABLE)->descriptor,off,mode);
+  ENABLE(envmut);
+  return res;
+}
+
+File_POSIX new_File (int desc) {
+  File_POSIX res; NEW(File_POSIX, res, WORDS(sizeof(struct File_POSIX)));
+  res->GCINFO = __GC__File_POSIX;
+  res->FILE2CLOSABLE = new_Closable(desc);
+  res->seek_POSIX = seek_fun;
+  return res;
+}
+
+// --------- RFile -------------------------------------------------------------
+
+LIST read_descr (int descr) {
+  char buf[1024];
+  LIST xs = (LIST)0;
+  LIST xslast = (LIST)0;
+  LIST res = (LIST)0;
+  LIST reslast = (LIST)0;
+  int r;
+  while (1) {
+    xs = (LIST)0;
+    xslast = (LIST)0;
+    r = read(descr, buf, 1023);
+    if (r <= 0) {
+      if (reslast != (LIST)0) ((CONS)reslast)->b = (LIST)0;
+      return res;
+    }
+    while (r) {
+      CONS n; NEW(CONS, n, WORDS(sizeof(struct CONS)));
+      if (xslast==(LIST)0) xslast = (LIST)n;
+      n->GCINFO = __GC__CONS+5;                         // POLY instance is a scalar
+      n->a = (POLY)(Int)buf[--r];
+      n->b = xs;
+      xs = (LIST)n;
+    }
+    if (res==(LIST)0) 
+      res = xs; 
+    else 
+      ((CONS)reslast)->b = xs;
+    reslast = xslast;
+  }
+}
+
+
+LIST read_fun (RFile_POSIX this, Int dummy) {
+  return read_descr(((DescClosable)this->RFILE2FILE->FILE2CLOSABLE)->descriptor);
+}
+
+UNITTYPE installR_fun (RFile_POSIX this, HANDLER hand, Int dummy) {
+  DISABLE(envmut);
+  Int desc = ((DescClosable)this->RFILE2FILE->FILE2CLOSABLE)->descriptor;
+  ADD_RDTABLE(desc,hand);
+  maxDesc = desc > maxDesc ? desc : maxDesc;  
+  pthread_kill(thread0.id, SIGSELECT);
+  ENABLE(envmut);
+  return (UNITTYPE)0;
+}
+
+RFile_POSIX new_RFile(int desc) {
+    RFile_POSIX rf; NEW(RFile_POSIX, rf, sizeof(struct RFile_POSIX));
+    rf->GCINFO = __GC__RFile_POSIX;
+    rf->RFILE2FILE = new_File(desc);
+    rf->read_POSIX = read_fun;
+    rf->installR_POSIX = installR_fun;
+    return rf;
+}
+
+// ----------- WFile -----------------------------------------------------------
+
+int write_fun (WFile_POSIX this, LIST xs, Int dummy) {
+  char buf[1024];
+  int res = 0;
+  while (xs) {
+    int len = 0;
+    while (xs && len < 1024) {
+      buf[len++] = (Char)(Int)((CONS)xs)->a;
+      xs = ((CONS)xs)->b;
+    }
+    if (len<1024) buf[len] = 0;
+    int r = write(((DescClosable)this->WFILE2FILE->FILE2CLOSABLE)->descriptor, buf, len);
+    if (r < 0) return res;
+    res += r;
+  }
+  return res;
+}
+
+UNITTYPE installW_fun (WFile_POSIX this, ACTION act, Int dummy) {
+  DISABLE(envmut);
+  Int desc = ((DescClosable)this->WFILE2FILE->FILE2CLOSABLE)->descriptor;
+  ADD_WRTABLE(desc,act);
+  envRootsDirty = 1;
+  maxDesc = desc > maxDesc ? desc : maxDesc;  
+  pthread_kill(thread0.id, SIGSELECT);
+  ENABLE(envmut);
+  return (UNITTYPE)0;
+}
+
+WFile_POSIX new_WFile(int desc) {
+    WFile_POSIX wf; NEW(WFile_POSIX, wf, sizeof(struct WFile_POSIX));
+    wf->GCINFO = __GC__WFile_POSIX;
+    wf->WFILE2FILE = new_File(desc);
+    wf->write_POSIX = write_fun;
+    wf->installW_POSIX = installW_fun;
+    return wf;
+}
+
+// ------------ Env ------------------------------------------------------------
+
+UNITTYPE exit_fun (Env_POSIX this, Int n, Int dummy) {
+  DISABLE(envmut);
+  DISABLE(rts);
+  exit(n);
+}
+
+Maybe_Prelude open_fun (LIST path, int oflag) {
+  char buf[1024];
+  int len = 0;
+  while (path && len < 1024) {
+    buf[len++] = (Char)(Int)((CONS)path)->a;
+    path = ((CONS)path)->b;
+  }
+  buf[len] = 0;
+  int descr = open(buf,oflag,S_IWUSR|S_IRUSR|S_IRGRP|S_IROTH);
+  if (descr < 0) return (Maybe_Prelude)0;
+  _Just_Prelude res; NEW(_Just_Prelude, res, WORDS(sizeof(struct _Just_Prelude)));
+  res->GCINFO = __GC___Just_Prelude+0;           // POLY instance is a pointer
+  res->a = (POLY)new_File(descr);
+  return (Maybe_Prelude)res;
+}
+
+
+Maybe_Prelude openR_fun (Env_POSIX this, LIST path, Int dummy) {
+  DISABLE(envmut);
+  Maybe_Prelude f = open_fun(path,O_RDONLY);
+  if (f) {
+    RFile_POSIX rf; NEW(RFile_POSIX, rf, WORDS(sizeof(struct RFile_POSIX)));
+    rf->GCINFO = __GC__RFile_POSIX;
+    rf->RFILE2FILE = (File_POSIX)((_Just_Prelude)f)->a;
+    rf->read_POSIX = read_fun;
+    rf->installR_POSIX = installR_fun;
+    ((_Just_Prelude)f)->a = (POLY)rf;
+  }
+  ENABLE(envmut);
+  return f;
+}
+
+Maybe_Prelude openW_fun (Env_POSIX this, LIST path, Int dummy) {
+  DISABLE(envmut);
+  Maybe_Prelude f =  open_fun(path,O_WRONLY | O_CREAT | O_TRUNC);
+  if (f) {
+    WFile_POSIX wf; NEW(WFile_POSIX, wf, WORDS(sizeof(struct WFile_POSIX)));
+    wf->GCINFO = __GC__WFile_POSIX;
+    wf->WFILE2FILE = (File_POSIX)((_Just_Prelude)f)->a;
+    wf->write_POSIX = write_fun;
+    wf->installW_POSIX = installW_fun;
+    ((_Just_Prelude)f)->a = (POLY)wf;
+  }
+  ENABLE(envmut);
+  return f;
+} 
+
+// ---------- Sockets ----------------------------------------------------------
+
+Socket_POSIX new_Socket (Int sock) {
+  Socket_POSIX res;
+  NEW (Socket_POSIX, res, WORDS(sizeof(struct Socket_POSIX)));
+  res->GCINFO = __GC__Socket_POSIX;
+  res->SOCK2CLOSABLE = new_Closable(sock);
+  res->inFile_POSIX = new_RFile(sock);
+  res->outFile_POSIX = new_WFile(sock);  
+  struct sockaddr_in addr = sockTable[sock]->addr;
+  res->remoteHost_POSIX = mkHost(addr);
+  res->remotePort_POSIX = mkPort(addr);
+  return res;
+}
+
+
+Int new_socket (SOCKHANDLER handler) {
+  SockData d; 
+  int sock = socket(PF_INET,SOCK_STREAM,0);
+  fcntl(sock,F_SETFL,O_NONBLOCK);
+  maxDesc = sock > maxDesc ? sock : maxDesc;  
+  NEW(SockData,d,WORDS(sizeof(struct SockData)));
+  d->GCINFO =__GC__SockData;
+  d->handler = handler;
+  sockTable[sock] = d;
+  envRootsDirty = 1;
+  return sock;
+}  
+
+void netError (Int sock, char *message) {
+  SOCKHANDLER handler = sockTable[sock]->handler;
+  Connection_POSIX conn = (Connection_POSIX)handler->Code(handler,(POLY)new_Socket(sock),(POLY)0);
+  //ADD_RDTABLE(sock,mkHandler(conn));
+  envRootsDirty = 1;
+  conn->neterror_POSIX(conn,getStr(message),Inherit,Inherit);
+}
+
+void setupConnection (Int sock) {
+  SOCKHANDLER handler = sockTable[sock]->handler;
+  Connection_POSIX conn = (Connection_POSIX)handler->Code(handler,(POLY)new_Socket(sock),(POLY)0);
+  //ADD_RDTABLE(sock,mkHandler(conn));
+  envRootsDirty = 1;
+  conn->established_POSIX(conn,Inherit,Inherit);
+}
+
+int mkAddr (Int sock, Host_POSIX host, struct in_addr *addr) {
+  LIST h = ((_Host_POSIX)host)->a;
+  char buf[1024];
+  int len = 0;
+  Int hostid;
+  struct hostent *ent;
+  while (h && len < 1024) {
+    buf[len++] = (Char)(Int)((CONS)h)->a;
+    h = ((CONS)h)->b;
+  }
+  buf[len] = 0;
+  // We assume gethostbyname will not block...
+  ent = gethostbyname(buf);
+  if(ent==NULL) {
+    netError(sock,"Name lookup error");
+    return -1;
+  }
+  else {
+    memcpy(&hostid, ent->h_addr_list[0], sizeof hostid);
+    addr->s_addr = hostid;
+    return 0;
+  }
+}
+
+UNITTYPE connect_fun (Sockets_POSIX this, Host_POSIX host, Port_POSIX port, SOCKHANDLER handler, Int dummy) {
+  DISABLE(envmut);
+  struct sockaddr_in addr;
+  struct in_addr iaddr;
+  int sock = new_socket(handler);
+  if (mkAddr(sock, host, &iaddr) == 0) {
+    addr.sin_addr = iaddr;
+    addr.sin_port = htons(((_Port_POSIX)port)->a);
+    addr.sin_family = AF_INET;
+    sockTable[sock]->addr = addr;
+    if (connect(sock,(struct sockaddr *)&addr,sizeof(struct sockaddr)) < 0) {// couldn't connect immediately, 
+      if (errno==EINPROGRESS)                                                // so check if attempt continues asynchronously.
+	FD_SET(sock,&writeUsed);
+      else
+	netError(sock,"Connect failed");
+    }
+    else {
+      setupConnection(sock);
+    }
+    pthread_kill(thread0.id, SIGSELECT);
+  }
+  ENABLE(envmut);
+  return (UNITTYPE)0;
+}
+
+
+Closable_POSIX listen_fun (Sockets_POSIX this, Port_POSIX port, SOCKHANDLER handler, Int dummy) {
+  DISABLE(envmut);
+  struct sockaddr_in addr;
+  int sock = new_socket(handler);
+  addr.sin_addr.s_addr = INADDR_ANY;
+  addr.sin_port = htons(((_Port_POSIX)port)->a);
+  addr.sin_family = AF_INET;
+  if (bind(sock,(struct sockaddr *)&addr,sizeof(struct sockaddr)) < 0)
+    perror("bind failed");
+  listen(sock,5);
+  FD_SET(sock,&readUsed);
+  pthread_kill(thread0.id, SIGSELECT);
+  ENABLE(envmut);
+  return new_Closable(sock);
+}
+
+// ---------- Global env object ------------------------------------------------
+
+// Note: all the following structs lie outside the garbage collected heap, and are therefore marked with a gcinfo = 0.
+
+struct DescClosable stdin_cl    = { 0, close_fun, 0 };
+struct DescClosable stdout_cl   = { 0, close_fun, 1 };
+
+struct File_POSIX stdin_file    = { 0, (Closable_POSIX)&stdin_cl, seek_fun };
+struct File_POSIX stdout_file   = { 0, (Closable_POSIX)&stdout_cl, seek_fun };
+
+struct RFile_POSIX stdin_rfile  = { 0, &stdin_file, read_fun, installR_fun };
+struct WFile_POSIX stdout_wfile = { 0, &stdout_file, write_fun, installW_fun };
+
+struct Sockets_POSIX tcp        = { 0, connect_fun, listen_fun };
+
+struct Internet_POSIX inet      = { 0, &tcp };
+
+struct Time startTime;
+
+struct Env_POSIX env_struct     = { 0, exit_fun,  NULL, &stdin_rfile, &stdout_wfile,
+                                    openR_fun, openW_fun, &startTime, &inet };
+
+Env_POSIX env                   = &env_struct;
+
+
+// ------- Copying for gc -----------------------------------------------
+
+void scanEnvRoots (void) {
+        envRootsDirty = 0;
+        int i;
+        prog = (ACTION)copy((ADDR)prog);
+        i = 0;
+        DISABLE(envmut);
+        while (i<maxDesc+1) {
+                if (rdTable[i]) rdTable[i] = (HANDLER)copy((ADDR)rdTable[i]);
+                if (wrTable[i]) wrTable[i] = (ACTION)copy((ADDR)wrTable[i]);
+                if (sockTable[i]) sockTable[i] = (SockData)copy((ADDR)sockTable[i]);
+                i++;
+                ENABLE(envmut);
+                DISABLE(envmut);
+        }
+        ENABLE(envmut);
+}
+
+// --------- Event loop ----------------------------------------------
+
+void kill_handler () {
+    return;
+}
+
+void eventLoop (void) {
+    sigset_t one_sig;
+    sigemptyset(&one_sig);
+    sigaddset(&one_sig, SIGSELECT);
+    pthread_sigmask(SIG_UNBLOCK, &one_sig, NULL);
+
+    DISABLE(envmut);
+    fd_set readFds, writeFds;
+    int i;
+    while(1) {
+        readFds = readUsed;
+        writeFds = writeUsed;
+        ENABLE(envmut);
+        int r = select(maxDesc+1, &readFds, &writeFds, NULL, NULL);
+        DISABLE(envmut);
+        if (r >= 0) {
+            TIMERGET(msg0.baseline);
+            for(i=0; i<maxDesc+1; i++) {
+	            if (FD_ISSET(i, &readFds)) {
+	                if (rdTable[i]) {
+	                    LIST inp = read_descr(i);
+	                    if (inp) {
+	                        rdTable[i]->Code(rdTable[i],(POLY)inp,(POLY)Inherit,(POLY)Inherit);
+	                    }
+	                    else if (sockTable[i]) { //we got a close message from peer on connected socket
+	                        SOCKHANDLER handler = sockTable[i]->handler;
+	                        Connection_POSIX conn = (Connection_POSIX)handler->Code(handler,(POLY)new_Socket(i),(POLY)0);
+                            Closable_POSIX cl = conn->CONN2CLOSABLE;
+	                        cl->close_POSIX(cl,0);
+	                        close(i);
+	                        CLR_RDTABLE(i);
+	                        sockTable[i] = NULL;
+	                    }
+	                } else if (sockTable[i]) { //listening socket received a connect request; we will accept
+	                    socklen_t len = sizeof(struct sockaddr);
+	                    struct sockaddr_in addr;
+	                    Int sock = accept(i,(struct sockaddr *)&addr,&len);
+	                    fcntl(sock,F_SETFL,O_NONBLOCK);
+	                    NEW(SockData,sockTable[sock],WORDS(sizeof(struct SockData)));
+	                    sockTable[sock]->handler = sockTable[i]->handler;
+	                    sockTable[sock]->addr = addr;
+	                    maxDesc = sock > maxDesc ? sock : maxDesc;
+	                    setupConnection(sock);
+	                }
+	            }
+	            if (FD_ISSET(i, &writeFds)) {
+	                if (wrTable[i]) {
+	                    wrTable[i]->Code(wrTable[i],(POLY)Inherit,(POLY)Inherit);
+	                } else if (sockTable[i]) { //delayed connection has been accepted or has failed
+	                    int opt;
+	                    socklen_t len = sizeof(int);
+	                    FD_CLR(i,&writeUsed);
+	                    if (getsockopt(i,SOL_SOCKET,SO_ERROR, (void *)&opt, &len) < 0)
+	                        perror("getsockopt failed");
+	                    if (opt) {
+	                        netError(i,"Connection failed");
+	                    } else {
+	                        setupConnection(i);
+	                    }
+	                }
+	            }
+            }
+        }
+    }
+}
+
+// --------- Initialization ----------------------------------------------------
+
+void envInit (int argc, char **argv) {
+    Int i;
+  
+    pthread_setspecific(current_key, &thread0);
+    pthread_mutex_init(&envmut, &glob_mutexattr);
+  
+    FD_ZERO(&readUsed);
+    FD_ZERO(&writeUsed);
+  
+    struct sigaction act;
+    act.sa_flags = 0;
+    sigemptyset( &act.sa_mask );
+    act.sa_handler = kill_handler;
+    sigaction( SIGSELECT, &act, NULL );
+  
+    Array arr; NEW(Array,arr,WORDS(sizeof(struct Array))+argc);
+    arr->GCINFO = __GC__Array0;
+    arr->size = argc;
+    for (i=0; i<argc; i++)
+        arr->elems[i] = (POLY)getStr(argv[i]);
+    env->argv_POSIX = arr;
+  
+    struct timeval now;
+    if (gettimeofday(&now,NULL) < 0)
+      perror("gettimeofday failed");
+    startTime.sec = now.tv_sec;
+    startTime.usec = now.tv_usec;
+
+    fcntl(0, F_SETFL, O_NONBLOCK);
+    fcntl(1, F_SETFL, O_NONBLOCK);
+
+    TIMERGET(msg0.baseline);
+
+    thread0.msg = &msg0;
+    thread0.id = pthread_self();
+  }
diff --git a/rtsPOSIX/env.h b/rtsPOSIX/env.h
new file mode 100644
--- /dev/null
+++ b/rtsPOSIX/env.h
@@ -0,0 +1,46 @@
+// The Timber compiler <timber-lang.org>
+// 
+// Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+// All rights reserved.
+// 
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions
+// are met:
+// 
+// 1. Redistributions of source code must retain the above copyright
+//    notice, this list of conditions and the following disclaimer.
+// 
+// 2. Redistributions in binary form must reproduce the above copyright
+//    notice, this list of conditions and the following disclaimer in the
+//    documentation and/or other materials provided with the distribution.
+// 
+// 3. Neither the names of the copyright holder and any identified
+//    contributors, nor the names of their affiliations, may be used to 
+//    endorse or promote products derived from this software without 
+//    specific prior written permission.
+// 
+// THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+// OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+// DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+// ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+// OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+// HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+// STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+// ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+// POSSIBILITY OF SUCH DAMAGE.
+
+#ifndef ENV_H_
+#define ENV_H_
+
+#define SOCKHANDLER   CLOS2_Prelude   // CLOS_Peer_POSIX_Int_Connection_POSIX__POSIX
+#define HANDLER       CLOS3_POSIX     // CLOS_LIST_Time_Time_Msg__POSIX
+#define ACTION        CLOS2_Prelude   // CLOS_Time_Time_Msg__POSIX
+#define FILE2CLOSABLE l_File_POSIX_Closable_POSIX_POSIX
+#define RFILE2FILE    l_RFile_POSIX_File_POSIX_POSIX
+#define WFILE2FILE    l_WFile_POSIX_File_POSIX_POSIX
+#define CONN2CLOSABLE l_Connection_POSIX_Closable_POSIX_POSIX
+#define SOCK2CLOSABLE l_Socket_POSIX_Closable_POSIX_POSIX
+#define __GC__HANDLER __GC__CLOS3_POSIX    // __GC__CLOS_LIST_Time_Time_Msg__POSIX
+#endif
diff --git a/rtsPOSIX/gc.c b/rtsPOSIX/gc.c
new file mode 100644
--- /dev/null
+++ b/rtsPOSIX/gc.c
@@ -0,0 +1,373 @@
+// The Timber compiler <timber-lang.org>
+// 
+// Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+// All rights reserved.
+// 
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions
+// are met:
+// 
+// 1. Redistributions of source code must retain the above copyright
+//    notice, this list of conditions and the following disclaimer.
+// 
+// 2. Redistributions in binary form must reproduce the above copyright
+//    notice, this list of conditions and the following disclaimer in the
+//    documentation and/or other materials provided with the distribution.
+// 
+// 3. Neither the names of the copyright holder and any identified
+//    contributors, nor the names of their affiliations, may be used to 
+//    endorse or promote products derived from this software without 
+//    specific prior written permission.
+// 
+// THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+// OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+// DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+// ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+// OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+// HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+// STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+// ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+// POSSIBILITY OF SUCH DAMAGE.
+
+#include <stdlib.h>
+#if defined(__APPLE__)
+#include <mach-o/getsect.h>
+#endif
+
+#define NEW2(addr,words,info)   { ADDR top,stop; \
+                                  do { addr = hp2; stop = lim2; top = ODD((addr)+(words)); \
+                                  } while (ISODD(addr) || !CAS(addr,top,&hp2)); \
+                                  if (top>=stop) addr = force2(words,addr,info); else { addr[0] = (WORD)(info); hp2 = EVEN(top); } }
+
+#define ODD(addr)               (ADDR)((WORD)(addr) | 1)
+#define EVEN(addr)              (ADDR)((WORD)(addr) & ~1)
+#define ISODD(addr)             ((WORD)(addr) & 1)
+
+#define IND0(obj)               (ADDR)((ADDR)obj)[0]
+#define GC_PROLOGUE(obj)        { if (ISFORWARD(IND0(obj))) obj = (PID)IND0(obj); }             // read barrier
+#define GC_EPILOGUE(obj)        { if (ISBLACK((ADDR)obj)) { ADDR a; NEW2(a,1,(ADDR)obj); } }    // write barrier
+
+#define GC_STD                  0
+#define GC_ARRAY                1
+#define GC_TUPLE                2
+#define GC_BIG                  3
+#define GC_MUT                  4
+
+#define POLYTAGS(width)         (((width)+31) % 32)
+
+#define GC_TYPE(info)           (info[1])
+#define STATIC_SIZE(info)       (info[0])
+
+#define allocwords(size)        (ADDR)malloc(BYTES(size))
+#define HEAPSIZE                0x100000  //  0x100000 words = 0x400000 bytes = 4194304 bytes = 4 Mb = 1024 pages = 0x400 pages
+#define STARTGC()               (WORD)hp >= 7 * (((WORD)lim)/8)
+
+#define ISWHITE(a)              INSIDE(heapchain,a,hp)
+#define ISBLACK(a)              hp2 && INSIDE(heapchain2,a,scanp)
+#define ISFORWARD(a)            ((ADDR)(a) > edata)
+
+#define INSIDE(base,a,lim)      (base[0] ? inside(base,a,lim) : (base <= (a) && (a) < lim))
+
+int inside(ADDR base, ADDR a, ADDR lim) {
+    if (base <= a && a < base+HEAPSIZE)
+        return 1;
+    base = (ADDR)base[0];
+    return INSIDE(base,a,lim);
+}
+
+WORD pagesize;                          // obtained from OS, measured in words
+ADDR base, lim, hp;                     // start, end, and current pos of latest "fromspace" (normal space)
+ADDR base2, lim2, hp2;                  // start, end and current pos of latest "tospace" (only used during gc)
+ADDR scanbase, scanp;                   // start and current pos of currently scanned segment (only used during gc)
+ADDR heapchain, heapchain2;             // anchor for the chain of all fromspaces, ditto for the tospaces
+ADDR edata;                             // end of static data
+ADDR staticHeap;                        // heap (chain) containing only statically allocated nodes (no copy)
+
+char emergency = 0;                     // flag signalling heap overflow during gc
+
+void scanEnvRoots(void);
+void scanTimerQ(void);
+extern int envRootsDirty;
+extern int timerQdirty;
+
+
+void initheap() {
+        base = allocwords(HEAPSIZE);
+        if (!base)
+                panic("Cannot allocate initial heap");
+        base[0] = 0;                                    // first word in a heap is the "next" link
+        hp = base + 1;
+        lim = base + HEAPSIZE - 1;                      // leave room for a one word node at the end
+        heapchain = base;
+        // printf("# Fresh heap: base=%x lim=%x (hp=%x)\n", (int)base, (int)lim, (int)hp);
+}
+
+void pruneStaticHeap() {
+        ADDR lim0 = hp;
+        ADDR base0 = realloc(base, BYTES(hp - base));   // Let current heap shrink to its current size
+        if (base0 != base)
+                panic("Cannot shrink static heap to current size");
+        staticHeap = heapchain;                         // Remember the static chain (for debugging only)
+
+        base0 = staticHeap;                             // Scan through all nodes allocated so far
+        ADDR obj = base0 + 1;
+        while (obj != lim0) {
+                ADDR info = IND0(obj);
+                if (info) {
+                        obj[0] = 0;                     // Mark as static
+                        WORD size = STATIC_SIZE(info);
+                        switch (GC_TYPE(info)) {
+                                case GC_ARRAY:  size += obj[1]; break;
+                                case GC_TUPLE:  size += obj[1] + POLYTAGS(obj[1]);
+                        }
+                        obj = obj + size;
+                } else {
+                        base0 = (ADDR)base0[0];         // End of one static segment reached, move to next
+                        obj = base0 + 1;
+                }
+        }
+
+        initheap();                                     // Create fresh heap for dynamic data
+}
+
+ADDR force(WORD size, ADDR last) {                      // Overflow in fromspace
+        ADDR a;
+        if (size > HEAPSIZE-3) panic("Excessive heap block requested");
+
+        DISABLE(rts);
+        // printf("# force: base=%x lim=%x (hp=%x)\n", (int)base, (int)lim, (int)hp);
+        if (base <= last && last < lim) {               // only extend if we were first to reach critical section
+                a = allocwords(HEAPSIZE);
+                if (!a) panic("Cannot allocate more memory");
+
+                base[0] = (WORD)a;                      // add link to new heap in first word of previous heap
+                a[0] = 0;                               // null terminate chain of heaps
+                base = a;
+                lim = a + HEAPSIZE - 1;                 // leave room for two words at the end
+                hp = a + 1;
+
+                last[0] = 0;                            // mark the end of a heap segment (nulled gcinfo)
+                last[1] = (WORD)hp;
+                // printf("# new:   base=%x lim=%x (hp=%x)\n", (int)base, (int)lim, (int)hp);
+        }
+        ENABLE(rts);
+
+        NEW(ADDR,a,size);
+        return a;
+}
+
+ADDR force2(WORD size, ADDR last, ADDR info) {          // Overflow in tospace
+        ADDR a;
+        if (size > HEAPSIZE-3) panic("Excessive heap block requested");
+        
+        DISABLE(rts);
+        if (base2 <= last && last < lim2) {             // only extend if we were first to reach critical section
+                a = allocwords(HEAPSIZE);
+                if (!a) panic("Cannot allocate more memory");
+
+                base2[0] = (WORD)a;                     // add link to new heap in first word of previous heap
+                a[0] = 0;                               // null terminate chain of heaps
+                base2 = a;
+                lim2 = a + HEAPSIZE - 2;                // leave room for two words at the end
+                hp2 = a + 1;
+
+                last[0] = 0;                            // mark the end of a heap segment (nulled gcinfo)
+                last[1] = (WORD)hp2;
+        }
+        ENABLE(rts);
+
+        NEW2(a,size,info);
+        return a;
+}
+
+ADDR copystateful(ADDR obj, ADDR info) {
+        WORD i = STATIC_SIZE(info);
+        ADDR dest, datainfo = IND0(obj+i);              // actual mutable struct follows right after the Ref struct
+        WORD size = i + STATIC_SIZE(datainfo);          // dataobj must be a GC_STD or a GC_BIG
+        NEW2(dest,size,info);
+        DISABLE(((Ref)obj)->mut);
+        for ( ; i < size; i++)
+                dest[i] = obj[i];
+        INITREF((Ref)dest);
+        obj[0] = (WORD)dest;
+        if (info[2]) {
+                // object has mutable arrays...  !!!!!!!!
+        }
+        ENABLE(((Ref)obj)->mut);
+        return dest;
+}
+
+ADDR copy(ADDR obj) {
+        if (!ISWHITE(obj))                              // don't copy if obj is a tospace address or a low range constant
+                return obj;
+        ADDR dest, info = IND0(obj);
+        if (!info)                                      // don't copy if obj is in static heap
+                return obj;
+        if (ISFORWARD(info))                            // gcinfo should point to static data;
+                return info;                            // if not, we have a forward ptr
+        WORD i, size = STATIC_SIZE(info);
+        switch (GC_TYPE(info)) {                              
+                case GC_ARRAY:  size += obj[1]; break;
+                case GC_TUPLE:  size += obj[1] + POLYTAGS(obj[1]); break;
+                case GC_MUT:    return copystateful(obj,info);
+                default:        break;
+        }
+        NEW2(dest,size,info);                           // allocate in tospace and initialize with gcinfo
+        for (i=0; i<size; i++)
+                dest[i] = obj[i];
+        obj[0] = (WORD)dest;                            // mark fromspace object as forwarded
+        return dest;
+}
+
+
+ADDR scan(ADDR obj) {
+        ADDR info = IND0(obj);
+        if (!info)                                      // if gcinfo is null we have reached the end of a tospace segment
+                return (ADDR)0;                         
+        if (ISFORWARD(info)) {                          // gcinfo should point to static data;
+                scan(info);                             // if not, we have a write barrier (rescan request)
+                return obj + 1;
+        }
+        switch (GC_TYPE(info)) {
+                case GC_STD: {
+                        WORD size = STATIC_SIZE(info), i = 2, offset = info[i];
+                        while (offset) {
+                                obj[offset] = (WORD)copy((ADDR)obj[offset]);
+                                offset = info[++i];
+                        }
+                        return obj + size;
+                }
+                case GC_ARRAY: {
+                        WORD size = STATIC_SIZE(info) + obj[1], offset = 2;     // find size of dynamic part in second slot of obj, add static size
+                        if (info[2])
+                                return obj + size;                              // return immediately if array contains only scalars
+                        while (offset<size) {
+                                obj[offset] = (WORD)copy((ADDR)obj[offset]);
+                                offset++;
+                        }
+                        return obj + size;
+                }
+                case GC_TUPLE: {
+                        WORD width = obj[1], offset = 1 + POLYTAGS(width), i = 1, j, tags;
+                        while (width > 32) {
+                                for (j = 0, tags = obj[i++]; j < 32; j++, offset++, tags = tags >> 1)
+                                        if (!(tags & 1))
+                                                obj[offset] = (WORD)copy((ADDR)obj[offset]);
+                                width -= 32;
+                        }
+                        for (tags = obj[i]; width > 0; width--, offset++, tags = tags >> 1) 
+                                if (!(tags & 1))
+                                        obj[offset] = (WORD)copy((ADDR)obj[offset]);
+                        return obj + STATIC_SIZE(info) + width + POLYTAGS(width);
+                }
+                case GC_BIG: {
+                        WORD size = STATIC_SIZE(info), i = 2, offset = info[i];
+                        while (offset) {                                        // scan all statically known pointer fields
+                                obj[offset] = (WORD)copy((ADDR)obj[offset]);
+                                offset = info[++i];
+                        }
+                        offset = info[++i];
+                        while (offset) {                                        // scan dynamically identified pointers
+                                WORD tagword = info[++i];
+                                WORD bitno = info[++i];
+                                if ((tagword & (1 << bitno)) == 0)
+                                        obj[offset] = (WORD)copy((ADDR)obj[offset]);
+                                offset = info[++i];
+                        }
+                        return obj + size;
+                }
+                case GC_MUT: {
+                        return scan(obj + STATIC_SIZE(info));
+                }
+        }
+        return (ADDR)0;                 // Not reached
+}
+
+void gc() {
+        heapchain2 = (ADDR)allocwords(HEAPSIZE);       // allocate tospace (initial segment)
+        base2 = heapchain2;
+        base2[0] = 0;
+        lim2 = base2 + HEAPSIZE - 1;                   // leave room for a one wor node at the end
+        hp2 = base2 + 1;
+        scanp = hp2;
+        scanbase = base2;
+        ENABLE(rts);
+        
+        envRootsDirty = 1;
+        timerQdirty = 1;
+
+        while (1) {
+                if (envRootsDirty)
+                        scanEnvRoots();
+                if (timerQdirty)
+                        scanTimerQ();
+
+                while (1) {
+                        while (ISODD(hp2));             // spin while a mutator is allocating a write barrier
+                        if (scanp == hp2)
+                                break;                  // break loop when we seem to be done
+                        scanp = scan(scanp);
+                        if (!scanp) {                   // nulled scanp: end of currently scanned segment
+                                scanbase = (ADDR)scanbase[0];
+                                scanp = scanbase + 1;
+                        }
+                }
+
+                DISABLE(rts);
+                if ((scanp == hp2) && (envRootsDirty+timerQdirty+nactive == 0)) // still done and everybody else is asleep?
+                        break;                                                  // Continue with exclusive rts access
+                ENABLE(rts);
+        }
+        
+        do {    base = heapchain;
+                heapchain = (ADDR)base[0];
+                free(base);
+        } while (heapchain);
+
+        heapchain = heapchain2;
+        base = base2;
+        lim = lim2;
+        hp = hp2;
+        // printf("!!!Heap switched:  base=%x lim=%x (hp=%x)\n", (int)base, (int)lim, (int)hp);
+
+        base2 = lim2 = hp2 = (ADDR)0;
+        scanbase = scanp = (ADDR)0;
+        heapchain2 = (ADDR)0;
+}
+
+void *garbageCollector(void *arg) {
+    Thread current = (Thread)arg;
+    pthread_setspecific(current_key, current);
+    struct sched_param param;
+    param.sched_priority = current->prio;
+    pthread_setschedparam(current->id, SCHED_RR, &param);
+    DISABLE(rts);
+    while (1) {
+        pthread_cond_wait(&current->trigger, &rts);
+        // printf("# Starting GC\n");
+        gc();
+    }
+}
+
+Thread gcThread;
+
+void gcStart(void) {
+    pthread_cond_signal(&gcThread->trigger);
+}
+
+void gcInit() {
+#if defined(__APPLE__)
+    edata = (ADDR)get_edata();
+#endif
+#if defined(__linux__)
+    extern int _end[];
+    edata = (ADDR)_end;
+#endif
+    pagesize = sysconf(_SC_PAGESIZE) / sizeof(WORD);
+    base2 = lim2 = hp2 = (ADDR)0;                   // no active tospace
+    initheap();                                     // Allocate base (= heapchain)
+    gcThread = newThread(NULL, prio_min, garbageCollector, pagesize);
+}
+
diff --git a/rtsPOSIX/install-sh b/rtsPOSIX/install-sh
new file mode 100644
--- /dev/null
+++ b/rtsPOSIX/install-sh
@@ -0,0 +1,294 @@
+#!/bin/sh
+#
+# install - install a program, script, or datafile
+#
+# This originates from X11R5 (mit/util/scripts/install.sh), which was
+# later released in X11R6 (xc/config/util/install.sh) with the
+# following copyright and license.
+#
+# Copyright (C) 1994 X Consortium
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
+# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
+# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC-
+# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+#
+# Except as contained in this notice, the name of the X Consortium shall not
+# be used in advertising or otherwise to promote the sale, use or other deal-
+# ings in this Software without prior written authorization from the X Consor-
+# tium.
+#
+#
+# FSF changes to this file are in the public domain.
+#
+# Calling this script install-sh is preferred over install.sh, to prevent
+# `make' implicit rules from creating a file called install from it
+# when there is no Makefile.
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch.  It can only install one file at a time, a restriction
+# shared with many OS's install programs.
+
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit="${DOITPROG-}"
+
+
+# put in absolute paths if you don't have them in your path; or use env. vars.
+
+mvprog="${MVPROG-mv}"
+cpprog="${CPPROG-cp}"
+chmodprog="${CHMODPROG-chmod}"
+chownprog="${CHOWNPROG-chown}"
+chgrpprog="${CHGRPPROG-chgrp}"
+stripprog="${STRIPPROG-strip}"
+rmprog="${RMPROG-rm}"
+mkdirprog="${MKDIRPROG-mkdir}"
+
+transformbasename=""
+transform_arg=""
+instcmd="$mvprog"
+chmodcmd="$chmodprog 0755"
+chowncmd=""
+chgrpcmd=""
+stripcmd=""
+rmcmd="$rmprog -f"
+mvcmd="$mvprog"
+src=""
+dst=""
+dir_arg=""
+
+while [ x"$1" != x ]; do
+    case $1 in
+	-c) instcmd=$cpprog
+	    shift
+	    continue;;
+
+	-d) dir_arg=true
+	    shift
+	    continue;;
+
+	-m) chmodcmd="$chmodprog $2"
+	    shift
+	    shift
+	    continue;;
+
+	-o) chowncmd="$chownprog $2"
+	    shift
+	    shift
+	    continue;;
+
+	-g) chgrpcmd="$chgrpprog $2"
+	    shift
+	    shift
+	    continue;;
+
+	-s) stripcmd=$stripprog
+	    shift
+	    continue;;
+
+	-t=*) transformarg=`echo $1 | sed 's/-t=//'`
+	    shift
+	    continue;;
+
+	-b=*) transformbasename=`echo $1 | sed 's/-b=//'`
+	    shift
+	    continue;;
+
+	*)  if [ x"$src" = x ]
+	    then
+		src=$1
+	    else
+		# this colon is to work around a 386BSD /bin/sh bug
+		:
+		dst=$1
+	    fi
+	    shift
+	    continue;;
+    esac
+done
+
+if [ x"$src" = x ]
+then
+	echo "$0: no input file specified" >&2
+	exit 1
+else
+	:
+fi
+
+if [ x"$dir_arg" != x ]; then
+	dst=$src
+	src=""
+
+	if [ -d "$dst" ]; then
+		instcmd=:
+		chmodcmd=""
+	else
+		instcmd=$mkdirprog
+	fi
+else
+
+# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
+# might cause directories to be created, which would be especially bad
+# if $src (and thus $dsttmp) contains '*'.
+
+	if [ -f "$src" ] || [ -d "$src" ]
+	then
+		:
+	else
+		echo "$0: $src does not exist" >&2
+		exit 1
+	fi
+
+	if [ x"$dst" = x ]
+	then
+		echo "$0: no destination specified" >&2
+		exit 1
+	else
+		:
+	fi
+
+# If destination is a directory, append the input filename; if your system
+# does not like double slashes in filenames, you may need to add some logic
+
+	if [ -d "$dst" ]
+	then
+		dst=$dst/`basename "$src"`
+	else
+		:
+	fi
+fi
+
+## this sed command emulates the dirname command
+dstdir=`echo "$dst" | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
+
+# Make sure that the destination directory exists.
+#  this part is taken from Noah Friedman's mkinstalldirs script
+
+# Skip lots of stat calls in the usual case.
+if [ ! -d "$dstdir" ]; then
+defaultIFS='
+	'
+IFS="${IFS-$defaultIFS}"
+
+oIFS=$IFS
+# Some sh's can't handle IFS=/ for some reason.
+IFS='%'
+set - `echo "$dstdir" | sed -e 's@/@%@g' -e 's@^%@/@'`
+IFS=$oIFS
+
+pathcomp=''
+
+while [ $# -ne 0 ] ; do
+	pathcomp=$pathcomp$1
+	shift
+
+	if [ ! -d "$pathcomp" ] ;
+        then
+		$mkdirprog "$pathcomp"
+	else
+		:
+	fi
+
+	pathcomp=$pathcomp/
+done
+fi
+
+if [ x"$dir_arg" != x ]
+then
+	$doit $instcmd "$dst" &&
+
+	if [ x"$chowncmd" != x ]; then $doit $chowncmd "$dst"; else : ; fi &&
+	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd "$dst"; else : ; fi &&
+	if [ x"$stripcmd" != x ]; then $doit $stripcmd "$dst"; else : ; fi &&
+	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd "$dst"; else : ; fi
+else
+
+# If we're going to rename the final executable, determine the name now.
+
+	if [ x"$transformarg" = x ]
+	then
+		dstfile=`basename "$dst"`
+	else
+		dstfile=`basename "$dst" $transformbasename |
+			sed $transformarg`$transformbasename
+	fi
+
+# don't allow the sed command to completely eliminate the filename
+
+	if [ x"$dstfile" = x ]
+	then
+		dstfile=`basename "$dst"`
+	else
+		:
+	fi
+
+# Make a couple of temp file names in the proper directory.
+
+	dsttmp=$dstdir/#inst.$$#
+	rmtmp=$dstdir/#rm.$$#
+
+# Trap to clean up temp files at exit.
+
+	trap 'status=$?; rm -f "$dsttmp" "$rmtmp" && exit $status' 0
+	trap '(exit $?); exit' 1 2 13 15
+
+# Move or copy the file name to the temp name
+
+	$doit $instcmd "$src" "$dsttmp" &&
+
+# and set any options; do chmod last to preserve setuid bits
+
+# If any of these fail, we abort the whole thing.  If we want to
+# ignore errors from any of these, just make sure not to ignore
+# errors from the above "$doit $instcmd $src $dsttmp" command.
+
+	if [ x"$chowncmd" != x ]; then $doit $chowncmd "$dsttmp"; else :;fi &&
+	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd "$dsttmp"; else :;fi &&
+	if [ x"$stripcmd" != x ]; then $doit $stripcmd "$dsttmp"; else :;fi &&
+	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd "$dsttmp"; else :;fi &&
+
+# Now remove or move aside any old file at destination location.  We try this
+# two ways since rm can't unlink itself on some systems and the destination
+# file might be busy for other reasons.  In this case, the final cleanup
+# might fail but the new file should still install successfully.
+
+{
+	if [ -f "$dstdir/$dstfile" ]
+	then
+		$doit $rmcmd -f "$dstdir/$dstfile" 2>/dev/null ||
+		$doit $mvcmd -f "$dstdir/$dstfile" "$rmtmp" 2>/dev/null ||
+		{
+		  echo "$0: cannot unlink or rename $dstdir/$dstfile" >&2
+		  (exit 1); exit
+		}
+	else
+		:
+	fi
+} &&
+
+# Now rename the file to the real destination.
+
+	$doit $mvcmd "$dsttmp" "$dstdir/$dstfile"
+
+fi &&
+
+# The final little trick to "correctly" pass the exit status to the exit trap.
+
+{
+	(exit 0); exit
+}
diff --git a/rtsPOSIX/main.c b/rtsPOSIX/main.c
new file mode 100644
--- /dev/null
+++ b/rtsPOSIX/main.c
@@ -0,0 +1,52 @@
+// The Timber compiler <timber-lang.org>
+// 
+// Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+// All rights reserved.
+// 
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions
+// are met:
+// 
+// 1. Redistributions of source code must retain the above copyright
+//    notice, this list of conditions and the following disclaimer.
+// 
+// 2. Redistributions in binary form must reproduce the above copyright
+//    notice, this list of conditions and the following disclaimer in the
+//    documentation and/or other materials provided with the distribution.
+// 
+// 3. Neither the names of the copyright holder and any identified
+//    contributors, nor the names of their affiliations, may be used to 
+//    endorse or promote products derived from this software without 
+//    specific prior written permission.
+// 
+// THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+// OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+// DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+// ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+// OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+// HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+// STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+// ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+// POSSIBILITY OF SUCH DAMAGE.
+
+#include "rts.h"
+#include "timber.h"
+#include "POSIX.h"
+#include "env.h"
+
+void ROOTINIT(void);
+ACTION ROOT(Env_POSIX, POLY);
+
+extern ACTION prog;
+extern Env_POSIX env;
+
+int main(int argc, char **argv) {
+    init_rts(argc, argv);
+    ROOTINIT();
+    pruneStaticHeap();
+    prog = ROOT(env, (POLY)0);
+    prog->Code(prog,(POLY)Inherit,(POLY)Inherit);
+    eventLoop();
+}
diff --git a/rtsPOSIX/rts.c b/rtsPOSIX/rts.c
new file mode 100644
--- /dev/null
+++ b/rtsPOSIX/rts.c
@@ -0,0 +1,500 @@
+// The Timber compiler <timber-lang.org>
+// 
+// Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+// All rights reserved.
+// 
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions
+// are met:
+// 
+// 1. Redistributions of source code must retain the above copyright
+//    notice, this list of conditions and the following disclaimer.
+// 
+// 2. Redistributions in binary form must reproduce the above copyright
+//    notice, this list of conditions and the following disclaimer in the
+//    documentation and/or other materials provided with the distribution.
+// 
+// 3. Neither the names of the copyright holder and any identified
+//    contributors, nor the names of their affiliations, may be used to 
+//    endorse or promote products derived from this software without 
+//    specific prior written permission.
+// 
+// THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+// OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+// DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+// ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+// OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+// HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+// STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+// ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+// POSSIBILITY OF SUCH DAMAGE.
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <unistd.h>
+#include <sys/types.h>
+#include <sys/mman.h>
+#include <signal.h>
+#include <sys/time.h>
+#include <string.h>
+#include "rts.h"
+#include "timber.h"
+
+
+#define MAXTHREADS      8
+
+#define SLEEP()         sigsuspend(&enabled_mask)
+#define DISABLE(mutex)  pthread_mutex_lock(&mutex)
+#define ENABLE(mutex)   pthread_mutex_unlock(&mutex)
+
+
+#define TDELTA          1
+#define TIMERGET(x)     gettimeofday(&x, NULL)
+#define TIMERSET(x,now) { struct itimerval t; \
+                          t.it_value = (x); \
+                          SUB(t.it_value, now); \
+                          t.it_interval.tv_sec = 0; \
+                          t.it_interval.tv_usec = 0; \
+                          setitimer( ITIMER_REAL, &t, NULL); \
+                        }
+
+#define LESS(a,b)       ( ((a).tv_sec < (b).tv_sec) || (((a).tv_sec == (b).tv_sec) && ((a).tv_usec <  (b).tv_usec)) )
+#define LESSEQ(a,b)     ( ((a).tv_sec < (b).tv_sec) || (((a).tv_sec == (b).tv_sec) && ((a).tv_usec <= (b).tv_usec)) )
+#define ADD(a,t)        { (a).tv_usec += (t->usec); \
+                          if ((a).tv_usec >= 1000000) { \
+                                  (a).tv_usec -= 1000000; \
+                                  (a).tv_sec += 1; \
+                          } \
+                          (a).tv_sec += (t->sec); \
+                        }
+#define SUB(a,b)        { (a).tv_usec -= (b).tv_usec; \
+                          if ((a).tv_usec < 0) { \
+                                  (a).tv_usec += 1000000; \
+                                  (a).tv_sec -= 1; \
+                          } \
+                          (a).tv_sec -= (b).tv_sec; \
+                        }
+
+#define INF             0x7fffffff
+
+
+// Thread management --------------------------------------------------------------------------------
+
+struct Thread;
+typedef struct Thread *Thread;
+
+struct Thread {
+        Thread next;            // for use in linked lists
+        Msg msg;                // message under execution
+        int prio;
+        pthread_t id;
+        int index;
+        pthread_cond_t trigger;
+        int placeholders;       // for use during cyclic data construction
+};
+
+Msg msgQ                = NULL;
+Msg timerQ              = NULL;
+
+Thread runQ             = NULL;
+Thread sleepQ           = NULL;
+
+int nactive             = 0;
+int nthreads            = 0;
+
+struct Thread threads[MAXTHREADS];
+
+pthread_mutex_t rts;
+
+pthread_mutexattr_t glob_mutexattr;
+pthread_mutexattr_t obj_mutexattr;
+
+sigset_t all_sigs;
+
+pthread_key_t current_key;
+
+int prio_min, prio_max;
+
+#define NCORES          2
+#define PRIO(t)         (t ? t->prio : )
+
+
+Thread newThread(Msg m, int prio, void *(*fun)(void *), int stacksize) {
+    Thread t = NULL;
+    if (nthreads < MAXTHREADS) {
+        t = &threads[nthreads++];
+        t->msg = m;
+        t->prio = prio;
+        t->placeholders = 0;
+        t->index = nthreads;
+        pthread_attr_t attr;
+        pthread_attr_init(&attr);
+        pthread_attr_setinheritsched(&attr, PTHREAD_EXPLICIT_SCHED);
+        if (stacksize > 0)
+                pthread_attr_setstacksize(&attr, BYTES(stacksize));
+        pthread_cond_init(&t->trigger, NULL);
+        pthread_create(&t->id, &attr, fun, t);
+    }
+    return t;
+}
+
+
+
+// Last resort -----------------------------------------------------------------------------------
+
+void panic(char *str) {
+    DISABLE(rts);
+    fprintf(stderr, "Timber RTS panic: %s. Quitting...\n", str);
+    exit(1);
+}
+
+
+// Memory management --------------------------------------------------------------------------------
+
+#include "gc.c"
+
+
+// Cyclic data handling -----------------------------------------------------------------------------
+
+#include "cyclic.c"
+
+
+// GCINFO definitions for the built-in types -----------------------------------------------------
+
+#include "timber.c"
+
+
+// Queue management ------------------------------------------------------------------------------
+
+void enqueueByDeadline(Msg p, Msg *queue) {
+        Msg prev = NULL, q = *queue;
+        while (q && LESS(q->deadline, p->deadline)) {
+                prev = q;
+                q = q->next;
+        }
+        p->next = q;
+        if (prev == NULL)
+                *queue = p;
+        else
+                prev->next = p;
+}
+
+void enqueueByBaseline(Msg p, Msg *queue) {
+        Msg prev = NULL, q = *queue;
+        while (q && LESS(q->baseline, p->baseline)) {
+                prev = q;
+                q = q->next;
+        }
+        p->next = q;
+        if (prev == NULL)
+                *queue = p;
+        else
+                prev->next = p;
+}
+
+Msg dequeue(Msg *queue) {
+        Msg m = *queue;
+        if (m)
+                *queue = m->next;
+        else
+                panic("Empty queue");
+        return m;
+}
+
+UNITTYPE ABORT(BITS32 polytag, Msg m, Ref dummy){
+    m->Code = NULL;
+    ADDR info;
+    do {
+        info = IND0((ADDR)m);
+        if (ISFORWARD(info))
+            ((Msg)info)->Code = NULL;
+    } while (info != IND0((ADDR)m));
+    return (UNITTYPE)0;
+}
+
+
+
+// Thread management ------------------------------------------------------------------------
+
+int midPrio(Thread prev, Thread next) {
+    int left  = (prev ? prev->prio : prio_max-1);
+    int right = (next ? next->prio : prio_min+1);
+    return right + ((left - right) / 2);
+}
+
+
+void *run(void*);
+
+Thread getThread(Msg m, int prio) {
+    Thread t = sleepQ;
+    if (t) {
+        struct sched_param param;
+        param.sched_priority = prio;
+        sleepQ = t->next;
+        t->msg = m;
+        pthread_setschedparam(t->id, SCHED_RR, &param);
+        pthread_cond_signal(&t->trigger);
+    } else
+        t = newThread(m, prio, run, 0);
+    return t;
+}
+
+int activate(Msg m) {
+    int count = 0;
+    Thread prev = NULL, t = runQ;
+    AbsTime dl = m->deadline;
+    while (count < NCORES && t && LESS(t->msg->deadline, dl)) {
+        count++;
+        prev = t;
+        t = t->next;
+    }
+    if (count >= NCORES)
+        return 0;
+    Thread new = getThread(m, midPrio(prev,t));
+    if (new == NULL)
+        return 0;
+    new->next = t;
+    if (prev == NULL)
+        runQ = new;
+    else
+        prev->next = new;
+    nactive++;
+    // fprintf(stderr, "Worker thread %d activated (%d)\n", (int)new, nactive);
+    return 1;
+}
+
+void deactivate(Thread t) {
+    if (t == runQ)
+        runQ = runQ->next;
+    else {
+        Thread prev = runQ, q = runQ->next;
+        while (q != t) {
+            prev = q;
+            q = q->next;
+        }
+        prev->next = q->next;
+    }
+    t->next = sleepQ;
+    sleepQ = t;
+    nactive--;
+    // fprintf(stderr, "Worker thread %d deactivated (%d)\n", (int)t, nactive);
+}
+
+void *run(void *arg) {
+    Thread current = (Thread)arg;
+    pthread_setspecific(current_key, current);
+    struct sched_param param;
+    param.sched_priority = current->prio;
+    pthread_setschedparam(current->id, SCHED_RR, &param);
+    // fprintf(stderr, "Worker thread %d started\n", (int)current);
+    DISABLE(rts);
+    while (1) {
+        Msg this = current->msg;
+
+        ENABLE(rts);
+        Int (*code)(Msg) = this->Code;
+        if (code)
+            code(this);
+        DISABLE(rts);
+
+        deactivate(current);
+        while (msgQ && !(msgQ->Code))
+            msgQ = msgQ->next;
+        if (msgQ) {
+            activate(msgQ);
+            msgQ = msgQ->next;
+        } else {
+            pthread_cond_wait(&current->trigger, &rts);
+        }
+        if (STARTGC())
+                gcStart();
+    }
+}
+
+
+// Major primitives ---------------------------------------------------------------------
+
+UNITTYPE ASYNC( Msg m, Time bl, Time dl ) {
+    DISABLE(rts);
+
+    AbsTime now;
+    TIMERGET(now);
+    Thread current = CURRENT();
+    // fprintf(stderr, "Working thread %d in ASYNC\n", (int)current);
+    m->baseline = current->msg->baseline;
+    switch ((Int)bl) {
+	    case INHERIT: break;
+        case TIME_INFINITY:
+	        m->baseline.tv_sec = INF;
+	        m->baseline.tv_usec = 0;
+	        break;
+        default:
+            ADD(m->baseline, bl);
+            if (LESS(m->baseline, now))
+                m->baseline = now;
+    }
+    switch((Int)dl) {
+	    case INHERIT: 
+	        m->deadline = current->msg->deadline;
+            break;
+	    case TIME_INFINITY:
+	        m->deadline.tv_sec = INF;
+	        m->deadline.tv_usec = 0;
+	        break;
+	    default:
+	        m->deadline = m->baseline;
+            ADD(m->deadline, dl);
+	}
+        
+    if (LESS(now, m->baseline)) {           //  TIMERQ_PROLOGUE();
+        enqueueByBaseline(m, &timerQ);
+        timerQdirty = 1;
+        if (timerQ == m)
+            TIMERSET(m->baseline, now);     //  TIMERQ_EPILOGUE();
+    } else if (!activate(m))
+        enqueueByDeadline(m, &msgQ);
+
+    ENABLE(rts);
+    return (UNITTYPE)0;
+}
+
+
+void INITREF( Ref obj ) {
+        obj->GCINFO = __GC__Ref;
+        pthread_mutex_init(&obj->mut, &obj_mutexattr);
+        obj->STATE = (ADDR)STATEOF(obj);                              // actually unused, but keep it clean
+}
+
+PID LOCK( PID to ) {
+    Ref r = (Ref)to;
+    pthread_mutex_lock(&(r->mut));
+    GC_PROLOGUE(to);
+    if (to != (PID)r) {
+        pthread_mutex_lock(&(((Ref)to)->mut));
+        pthread_mutex_unlock(&(r->mut));
+    }
+    return to;
+}
+
+UNITTYPE UNLOCK( PID to ) {
+    GC_EPILOGUE(to);
+    pthread_mutex_unlock(&(((Ref)to)->mut));
+    return (UNITTYPE)0;
+}
+
+
+
+// Exception handling ----------------------------------------------------------------------------------
+
+void RAISE(Int err) {
+        char buf[100];
+        sprintf(buf, "Unhandled exception (%d)", err);
+        panic(buf);
+}
+
+POLY Raise(BITS32 polyTag, Int err) {
+        RAISE(err);
+        return NULL;
+}
+
+
+// Arrays ---------------------------------------------------------------------------------------------
+
+#include "arrays.c"
+
+// Primitive timer class ------------------------------------------------------------------------------
+
+#include "timer.c"
+
+// Environment object ---------------------------------------------------------------------------------
+
+#include "env.c"
+
+// Show Float -----------------------------------------------------------------------------------------
+
+#include "float.c"
+
+// timerQ handling ------------------------------------------------------------------------------------
+
+int timerQdirty;
+
+void *timerHandler(void *arg) {
+    Thread current = (Thread)arg;
+    struct sched_param param;
+    param.sched_priority = current->prio;
+    pthread_setschedparam(current->id, SCHED_RR, &param);
+
+//    pthread_sigmask(SIG_BLOCK, &all_sigs, NULL);
+    sigset_t accept;
+    sigemptyset(&accept);
+    sigaddset(&accept, SIGALRM);
+    while (1) {
+        int received;
+        sigwait(&accept, &received);
+        DISABLE(rts);
+        AbsTime now;
+        TIMERGET(now);
+        while (timerQ && LESSEQ(timerQ->baseline, now)) {
+            Msg m = dequeue(&timerQ);
+            if (m->Code) {
+                if (!activate(m))
+                    enqueueByDeadline(m, &msgQ);
+            }
+        }
+        if (timerQ)
+            TIMERSET(timerQ->baseline, now);
+        ENABLE(rts);
+    }
+}
+
+void scanTimerQ() {
+        timerQdirty = 0;
+        DISABLE(rts);
+        if (timerQ) {
+                timerQ = (Msg)copy((ADDR)timerQ);
+                ENABLE(rts);
+                DISABLE(rts);
+                Msg m = timerQ, next = m->next;
+                while (next) {
+                        m->next = (Msg)copy((ADDR)next);
+                        ENABLE(rts);
+                        DISABLE(rts);
+                        m = m->next;
+                        next = m->next;
+                }
+        }
+        ENABLE(rts);
+}
+
+
+// Initialization -------------------------------------------------------------------------------------
+
+void init_rts(int argc, char **argv) {
+    pthread_mutexattr_init(&glob_mutexattr);
+    pthread_mutexattr_settype(&glob_mutexattr, PTHREAD_MUTEX_NORMAL);
+    pthread_mutexattr_setprotocol(&glob_mutexattr, PTHREAD_PRIO_INHERIT);
+    pthread_mutex_init(&rts, &glob_mutexattr);
+    
+    pthread_mutexattr_init(&obj_mutexattr);
+    pthread_mutexattr_settype(&obj_mutexattr, PTHREAD_MUTEX_NORMAL);
+    pthread_mutexattr_setprotocol(&obj_mutexattr, PTHREAD_PRIO_INHERIT);
+    
+    prio_min = sched_get_priority_min(SCHED_RR);
+    prio_max = sched_get_priority_max(SCHED_RR);
+    pthread_key_create(&current_key, NULL);
+    sigemptyset(&all_sigs);
+    sigaddset(&all_sigs, SIGALRM);
+    sigaddset(&all_sigs, SIGSELECT);
+    pthread_sigmask(SIG_BLOCK, &all_sigs, NULL);
+    
+    DISABLE(rts);
+    
+    gcInit();
+    envInit(argc, argv);
+    newThread(NULL, prio_max, timerHandler, pagesize);
+    
+    ENABLE(rts);
+}
+
diff --git a/rtsPOSIX/rts.h b/rtsPOSIX/rts.h
new file mode 100644
--- /dev/null
+++ b/rtsPOSIX/rts.h
@@ -0,0 +1,185 @@
+// The Timber compiler <timber-lang.org>
+// 
+// Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+// All rights reserved.
+// 
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions
+// are met:
+// 
+// 1. Redistributions of source code must retain the above copyright
+//    notice, this list of conditions and the following disclaimer.
+// 
+// 2. Redistributions in binary form must reproduce the above copyright
+//    notice, this list of conditions and the following disclaimer in the
+//    documentation and/or other materials provided with the distribution.
+// 
+// 3. Neither the names of the copyright holder and any identified
+//    contributors, nor the names of their affiliations, may be used to 
+//    endorse or promote products derived from this software without 
+//    specific prior written permission.
+// 
+// THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+// OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+// DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+// ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+// OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+// HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+// STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+// ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+// POSSIBILITY OF SUCH DAMAGE.
+
+#ifndef RTS_H_
+#define RTS_H_
+
+#include <stddef.h>
+#include <sys/time.h>
+//#include <setjmp.h>
+#include <pthread.h>
+
+#include "config.h"
+
+typedef int WORD;
+typedef WORD *ADDR;
+
+#define Int int
+#define Float float
+#define Char char
+#define Bool char
+#define FALSE char          // alias for singleton type
+#define TRUE char           // alias for singleton type
+#define UNITTYPE char
+#define UNITTERM char       // alias for singleton type
+#define POLY ADDR
+#define PID ADDR
+#define BITS8 unsigned char
+#define BITS16 unsigned short
+#define BITS32 unsigned int
+
+
+#define primSHIFTRA8(a,b)  ((signed char)(a) >> (b))
+#define primSET8(a,b)      ((a) | (1 << (b)))
+#define primCLR8(a,b)      ((a) & ~(1 << (b)))
+#define primTST8(a,b)      (((a) & (1 << (b))) != 0)
+
+#define primSHIFTRA16(a,b) ((signed short)(a) >> (b))
+#define primSET16(a,b)     ((a) | (1 << (b)))
+#define primCLR16(a,b)     ((a) & ~(1 << (b)))
+#define primTST16(a,b)     (((a) & (1 << (b))) != 0)
+
+#define primSHIFTRA32(a,b) ((signed int)(a) >> (b))
+#define primSET32(a,b)     ((a) | (1 << (b)))
+#define primCLR32(a,b)     ((a) & ~(1 << (b)))
+#define primTST32(a,b)     (((a) & (1 << (b))) != 0)
+
+
+union FloatCast {
+    float f;
+    POLY p;
+};
+
+#define POLY2Float(x)   ((union FloatCast )(x)).f
+#define Float2POLY(x)   ((union FloatCast )((float)x)).p
+
+#define ZEROBITS        0
+#define ORBITS(a,b)     (a) | (b)
+#define SETBIT(n)       (1 << n)
+#define COPYBIT(x,m,n)  (((x >> m) & 1) << n)
+
+/*
+#define SEC(x)          ((x)*1000000)
+#define MILLISEC(x)     ((x)*1000)
+#define MICROSEC(x)     (x)
+*/
+
+struct Msg;
+
+typedef struct Ref *Ref;
+struct Ref {
+    WORD *GCINFO;
+    pthread_mutex_t mut;
+    POLY STATE;
+};
+
+#define STATEOF(ref)    (((ADDR)(ref))+WORDS(sizeof(struct Ref)))
+
+void INITREF(Ref);
+
+extern WORD __GC__Ref[];
+
+typedef struct timeval AbsTime;
+
+struct Time {
+  WORD *GCINFO;
+  Int sec;
+  Int usec;
+};
+
+typedef struct Time *Time;
+
+extern WORD __GG__Time[] ;
+
+
+#define WORDS(bytes)            (((bytes)+sizeof(WORD)-1)/sizeof(WORD))
+#define BYTES(words)            ((words)*sizeof(WORD))
+
+
+#if defined(HAVE_OSX_ATOMICS)
+#include <libkern/OSAtomic.h>
+#define CAS(old,new,mem)        OSAtomicCompareAndSwap32((WORD)(old),(WORD)(new),(ADDR)(mem))
+#else
+#if defined(HAVE_BUILTIN_ATOMIC) 
+#define CAS(old,new,mem)        __sync_bool_compare_and_swap((mem),(WORD)(old),(WORD)(new))
+#else
+#error "Can not define CAS on your architecture."
+#endif
+#endif
+
+#define NEW(t,addr,words)       { ADDR top,stop; \
+                                  do { addr = (t)hp; stop = lim; top = ((ADDR)addr)+(words); } \
+                                  while (!CAS(addr,top,&hp)); \
+                                  if (top>=stop) addr = (t)force((words),(ADDR)addr); }
+
+#define CURRENT()               ((Thread)pthread_getspecific(current_key))
+
+/*
+#define TMIN(a,b)               ((a) < (b) ? (a) : (b) )
+#define TPLUS(a,b)              ((a) + (b))
+#define TMINUS(a,b)             ( (a) > (b) ? (a) - (b) : 0 )
+*/
+
+
+extern ADDR hp, lim;
+extern pthread_key_t current_key;
+
+ADDR force(WORD, ADDR);
+void pruneStaticHeap();
+
+void init_rts(int, char**);
+
+Time sec(Int c);
+Time millisec(Int x);
+Time microsec(Int x);
+Int secOf(Time t);
+Int microsecOf (Time t);
+
+#define Inherit ((Time)0)
+#define Infinity ((Time)1)
+
+#define INHERIT 0
+#define TIME_INFINITY 1
+
+Time primTimeMin(Time t1, Time t2);
+Time primTimePlus(Time t1, Time t2);
+Time primTimeMinus(Time t1, Time t2);
+
+Bool primTimeEQ(Time t1, Time t2);
+Bool primTimeNE(Time t1, Time t2);
+Bool primTimeLT(Time t1, Time t2);
+Bool primTimeLE(Time t1, Time t2);
+Bool primTimeGT(Time t1, Time t2);
+Bool primTimeGE(Time t1, Time t2);
+
+#endif
diff --git a/rtsPOSIX/timberc.cfg.in b/rtsPOSIX/timberc.cfg.in
new file mode 100644
--- /dev/null
+++ b/rtsPOSIX/timberc.cfg.in
@@ -0,0 +1,5 @@
+CfgOpts
+      { cCompiler = "@CC@ -DPOSIX"
+      , compileFlags = " @CFLAGS@ "
+      , linkFlags = " @LDFLAGS@ "
+      }
diff --git a/rtsPOSIX/timer.c b/rtsPOSIX/timer.c
new file mode 100644
--- /dev/null
+++ b/rtsPOSIX/timer.c
@@ -0,0 +1,305 @@
+// The Timber compiler <timber-lang.org>
+// 
+// Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+// All rights reserved.
+// 
+// Redistribution and use in source and binary forms, with or without
+// modification, are permitted provided that the following conditions
+// are met:
+// 
+// 1. Redistributions of source code must retain the above copyright
+//    notice, this list of conditions and the following disclaimer.
+// 
+// 2. Redistributions in binary form must reproduce the above copyright
+//    notice, this list of conditions and the following disclaimer in the
+//    documentation and/or other materials provided with the distribution.
+// 
+// 3. Neither the names of the copyright holder and any identified
+//    contributors, nor the names of their affiliations, may be used to 
+//    endorse or promote products derived from this software without 
+//    specific prior written permission.
+// 
+// THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+// OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+// DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+// ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+// DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+// OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+// HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+// STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+// ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+// POSSIBILITY OF SUCH DAMAGE.
+
+
+#include "timber.h"
+
+struct S_Timer {
+    WORD *GCINFO;
+    AbsTime start;
+};
+
+typedef struct S_Timer *S_Timer;
+
+struct T_Timer;
+typedef struct T_Timer *T_Timer;
+
+struct T_Timer {
+  WORD *GCINFO;
+  UNITTYPE (*reset) (T_Timer, Int);
+  Time (*sample) (T_Timer, Int);
+  Ref self;
+};
+
+
+static WORD __GC__T_Timer[] = {WORDS(sizeof(struct T_Timer)), GC_STD, WORDS(offsetof(struct T_Timer,self)), 0};
+   
+static WORD __GC__S_Timer[] = {WORDS(sizeof(struct S_Timer)), GC_STD, 0};
+
+static WORD __GC__Time[]    = {WORDS(sizeof(struct Time)), GC_STD, 0};
+
+
+Time sec(Int c) {
+  Time res;
+  NEW(Time,res,WORDS(sizeof(struct Time)));
+  res->GCINFO = __GC__Time;
+  res->sec = c;
+  res->usec = 0;
+  return res;
+}
+
+Time millisec(Int c) {
+  Time res;
+  NEW(Time,res,WORDS(sizeof(struct Time)));
+  res->GCINFO = __GC__Time;
+  res->sec = c / 1000;
+  res->usec = 1000 * (c % 1000);
+  return res;
+}
+
+Time microsec(Int c) {
+  Time res;
+  NEW(Time,res,WORDS(sizeof(struct Time)));
+  res->GCINFO = __GC__Time;
+  res->sec = c / 1000000;
+  res->usec = c % 1000000;
+  return res;
+}
+
+Int secOf(Time t) {
+  switch ((Int)t) {
+  case INHERIT: panic("secOf Inherit");
+  case TIME_INFINITY: panic("secOf infinity");
+  default: return t->sec;
+  }
+}
+
+Int microsecOf(Time t) {
+  switch ((Int)t) {
+  case INHERIT: panic("microsecOf Inherit");
+  case TIME_INFINITY: panic("microsecOf infinity");
+  default: return t->usec;
+  }
+}
+
+
+
+Time primTimePlus(Time t1, Time t2) {
+  Time res;
+  switch ((Int)t1) {
+  case INHERIT: return t2;
+  case TIME_INFINITY: return Infinity;
+  default: 
+    switch ((Int)t2) {
+    case INHERIT: return t1;
+    case TIME_INFINITY: return Infinity;
+    default:
+      NEW(Time,res,WORDS(sizeof(struct Time)));
+      res->GCINFO = __GC__Time;
+      res->usec = t1->usec + t2->usec;
+      res->sec = t1->sec + t2->sec;
+      if (res->usec >= 1000000) {
+	res->usec -= 1000000;
+	res->sec += 1;
+      }
+      return res;
+    }
+  }
+}
+
+Time primTimeMin(Time t1, Time t2) {
+  switch ((Int)t1) {
+  case INHERIT: 
+  case TIME_INFINITY:return t2;
+  default:
+    switch ((Int)t2) {
+    case INHERIT: 
+    case TIME_INFINITY: return t1;
+    default: 
+      if (t1->sec < t2->sec || (t1->sec == t2->sec && t1->usec < t2->usec))
+	return t1;
+      else
+	return t2;
+    }
+  }
+}
+
+
+Time primTimeMinus(Time t1, Time t2) {
+  Time res;
+  switch ((Int)t1) {
+  case INHERIT: panic("primTimeMinus Inherit");
+  case TIME_INFINITY: 
+    switch((Int) t2) {
+    case INHERIT: panic("primTimeMinus Inherit");
+    case TIME_INFINITY: panic("infinity - infinity");
+    default: return Infinity;
+    }      
+  default:
+    switch ((Int)t2) {
+    case INHERIT: panic("primTimeMinus Inherit");
+    case TIME_INFINITY:
+      NEW(Time,res,WORDS(sizeof(struct Time)));
+      res->GCINFO = __GC__Time;
+      res->sec = 0;
+      res->usec = 0;
+      return res;
+    default:
+      NEW(Time,res,WORDS(sizeof(struct Time)));
+      res->GCINFO = __GC__Time;
+      res->usec = t1->usec - t2->usec;
+      if (res->usec < 0) {
+	res->usec += 1000000;
+	t1->sec -= 1;
+      }
+      res->sec = t1->sec - t2->sec;
+      if (res->sec < 0) res->sec = 0;
+      return res;
+    }
+  }
+}
+
+Bool primTimeEQ(Time t1, Time t2) {
+  switch ((Int)t1) {
+  case INHERIT: panic("primTimeEQ Inherit");
+  case TIME_INFINITY: switch((Int)t2) {
+    case INHERIT: panic("primTimeEQ Inherit");
+    case TIME_INFINITY: return 1;
+    default:
+      return 0;
+    }
+  default:
+    switch ((Int)t2) {
+    case INHERIT: panic("primTimeEQ Inherit");
+    case TIME_INFINITY: return 0;
+    default:
+      return (t1->sec == t2->sec && t1->usec == t2->usec);
+    }
+  }
+}
+
+Bool primTimeNE(Time t1, Time t2) {
+  switch ((Int)t1) {
+  case INHERIT: panic("primTimeNE Inherit");
+  case TIME_INFINITY: switch((Int)t2) {
+    case INHERIT: panic("primTimeNE Inherit");
+    case TIME_INFINITY: return 0;
+    default:
+      return 1;
+    }
+  default:
+    switch ((Int)t2) {
+    case INHERIT: panic("primTimeNE Inherit");
+    case TIME_INFINITY: return 1;
+    default:
+      return (t1->sec != t2->sec || t1->usec != t2->usec);
+    }
+  }
+}
+
+Bool primTimeLT(Time t1, Time t2) {
+  switch ((Int)t1) {
+  case INHERIT: panic("primTimeLT Inherit");
+  case TIME_INFINITY: switch((Int)t2) {
+    case INHERIT: panic("primTimeLT Inherit");
+    default:
+      return 0;
+    }
+  default:
+    switch ((Int)t2) {
+    case INHERIT: panic("primTimeLT Inherit");
+    case TIME_INFINITY: return 1;
+    default:
+      return (t1->sec < t2->sec || (t1->sec==t2->sec && t1->usec<t2->usec));
+    }
+  }
+}
+Bool primTimeLE(Time t1, Time t2) {
+  switch ((Int)t1) {
+  case INHERIT: panic("primTime InheritLE");
+  case TIME_INFINITY: switch((Int)t2) {
+    case INHERIT: panic("primTime InheritLE");
+    default:
+      return 0;
+    }
+  default:
+    switch ((Int)t2) {
+    case INHERIT: panic("primTime InheritLE");
+    case TIME_INFINITY: return 1;
+    default:
+      return (t1->sec < t2->sec || (t1->sec==t2->sec && t1->usec<=t2->usec));
+    }
+  }
+}
+
+Bool primTimeGT(Time t1, Time t2) {
+  return primTimeLT(t2,t1);
+}
+
+Bool primTimeGE(Time t1, Time t2) {
+  return primTimeLE(t2,t1);
+}
+
+static UNITTYPE reset_fun(Ref self, Int x) {
+  self = (Ref)LOCK((PID)self);
+  ((S_Timer)STATEOF(self))->start = CURRENT()->msg->baseline;
+  UNLOCK((PID)self);
+  return (UNITTYPE)0;
+}
+
+static Time sample_fun(Ref self, Int x) {
+  self = (Ref)LOCK((PID)self);
+  AbsTime now;
+  now = CURRENT()->msg->baseline;
+  SUB(now,((S_Timer)STATEOF(self))->start);
+  UNLOCK((PID)self);
+  Time res;
+  NEW(Time,res,WORDS(sizeof(struct Time)));
+  res->GCINFO = __GC__Time;
+  res->sec = now.tv_sec;
+  res->usec = now.tv_usec;
+  return res;
+}
+
+static UNITTYPE reset_sel(T_Timer this,Int x) {
+  return reset_fun(this->self,x);
+}
+
+static Time sample_sel(T_Timer this, Int x) {
+  return sample_fun(this->self,x);
+}
+
+TIMERTYPE primTIMERTERM(Int x) {
+  Ref self;
+  NEW(Ref,self,WORDS(sizeof(struct Ref))+WORDS(sizeof(struct S_Timer)));
+  INITREF(self);
+  ((S_Timer)STATEOF(self))->GCINFO = __GC__S_Timer;
+  ((S_Timer)STATEOF(self))->start = CURRENT()->msg->baseline;
+  T_Timer res;
+  NEW(T_Timer,res,WORDS(sizeof(struct T_Timer)));
+  res->GCINFO = __GC__T_Timer;
+  res->reset = reset_sel;
+  res->sample = sample_sel;
+  res->self = self;
+  return (TIMERTYPE)res;
+}
diff --git a/src/Common.hs b/src/Common.hs
new file mode 100644
--- /dev/null
+++ b/src/Common.hs
@@ -0,0 +1,657 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Common (module Common, module Name, isDigit) where
+
+import PP
+import qualified List
+import qualified Maybe
+import Char
+import Name
+import Data.Binary
+import Debug.Trace
+
+
+
+fromJust                        = Maybe.fromJust
+listToMaybe                     = Maybe.listToMaybe
+
+fst3 (a,b,c)                    = a
+snd3 (a,b,c)                    = b
+thd3 (a,b,c)                    = c
+
+dom                             = map fst
+
+rng                             = map snd
+
+partition p xs                  = List.partition p xs
+
+nub xs                          = List.nub xs
+
+xs \\ ys                        = filter (`notElem` ys) xs
+
+xs `intersect` ys               = xs `List.intersect` ys
+
+xs `union` ys                   = xs `List.union` ys
+
+disjoint xs ys                  = xs `intersect` ys == []
+
+overlaps xs ys                  = not (disjoint xs ys)
+
+intersperse x xs                = List.intersperse x xs
+
+duplicates xs                   = filter (`elem` dups) xs1
+  where xs1                     = nub xs
+        dups                    = foldl (flip List.delete) xs xs1
+
+rotate n xs                     = let (xs1,xs2) = splitAt n xs in xs2++xs1
+
+separate []                     = ([],[])
+separate (Left x : xs)          = let (ls,rs) = separate xs in (x:ls,rs)
+separate (Right x : xs)         = let (ls,rs) = separate xs in (ls,x:rs)
+
+showids vs                      = concat (intersperse ", " (map show vs))
+
+fmapM f g xs                    = do ys <- mapM g xs
+                                     return (f ys)
+
+mapFst f xs                     = [ (f a, b) | (a,b) <- xs ]
+
+mapSnd f xs                     = [ (a, f b) | (a,b) <- xs ]
+
+zipFilter (f:fs) (x:xs)
+  | f                           = x : zipFilter fs xs
+  | otherwise                   = zipFilter fs xs
+zipFilter _ _                   = []
+                                    
+noDups mess vs
+  | not (null dups)             = errorIds mess dups
+  | otherwise                   = vs
+  where dups                    = duplicates vs
+
+uncurry3 f (x,y,z)              = f x y z
+
+
+-- String manipulation -----------------------------------------------------
+
+rmSuffix                        :: String -> String -> String
+rmSuffix suf                    = reverse . rmPrefix (reverse suf) . reverse
+
+rmPrefix                        :: String -> String -> String
+rmPrefix pre str 
+  | pre `List.isPrefixOf` str   = drop (length pre) str
+  | otherwise                   = error $ "rmPrefix: " ++ str ++ " is not a prefix of " ++ show pre
+
+rmDirs                          :: String -> String
+rmDirs                          = reverse . fst . span (/='/') . reverse 
+
+dropPrefix [] s                 = (True, s)
+dropPrefix (x:xs) (y:ys)
+  | x == y                      = dropPrefix xs ys
+dropPrefix xs ys                = (False, ys)
+
+
+dropDigits xs                   = drop 0 xs
+  where drop n (x:xs)
+          | isDigit x           = drop (10*n + ord x - ord '0') xs
+        drop n xs               = (n, xs)
+
+
+
+-- Error reporting ---------------------------------------------------------
+
+errorIds mess ns                = error (unlines ((mess++":") : map pos ns))
+  where pos n                   = case loc n of
+                                    Just (r,c) -> rJust 15 (show n) ++ "  at line " ++ show r ++ ", column " ++ show c
+                                    Nothing ->    rJust 15 (show n) ++ modInfo n
+        loc n                   = location (annot n)
+        rJust w str             = replicate (w-length str) ' ' ++ str
+        modInfo (Name _ _ (Just m) a) = " defined in " ++ m
+        modInfo _               = " (unknown position)"
+errorTree mess t                = error (mess ++ pos ++ (if length (lines str) > 1 then "\n"++str++"\n" else str) )
+  where str                     = render (pr t)
+        pos                     = " ("++ show (posInfo t) ++"): "
+ 
+internalError mess t            = errorTree ("**** Internal compiler error ****\n" ++ mess) t
+
+internalError0 mess             = error ("**** Internal compiler error ****\n" ++ mess)
+
+
+-- PosInfo ---------------------------------------------------------
+   
+
+data PosInfo                    = Between {start :: (Int,Int), end :: (Int,Int)}
+                                | Unknown
+
+instance Show PosInfo where
+   show (Between (l1,c1) (l2,c2)) 
+                                = case l1==l2 of
+                                    True ->  case c1 == c2 of
+                                              True -> "close to line "++show l1++", column "++show c1
+                                              False -> "close to line "++show l1++", columns "++show c1++" -- "++show c2
+                                    False -> "close to lines "++show l1++" -- "++show l2
+   show Unknown                 = "at unknown position"
+
+
+
+between (Between s1 e1) (Between s2 e2) 
+                                = Between (min s1 s2) (max e1 e2)
+between b@(Between _ _) Unknown = b
+between Unknown b@(Between _ _) = b
+between Unknown Unknown         = Unknown 
+
+startPos (Between s _)          = Just s
+startPos Unknown                = Nothing
+
+class HasPos a where
+  posInfo :: a -> PosInfo
+
+instance HasPos a => HasPos [a] where
+  posInfo xs = foldr between Unknown (map posInfo xs)
+
+instance (HasPos a, HasPos b) => HasPos (a,b) where
+  posInfo (a,b) = between (posInfo a) (posInfo b)
+
+instance HasPos a => HasPos (Maybe a) where
+  posInfo Nothing  = Unknown
+  posInfo (Just a) = posInfo a
+
+instance HasPos Bool where
+  posInfo _ = Unknown
+
+instance HasPos Name where
+   posInfo n = case location (annot n) of
+                 Just (l,c)
+                    |l==0 && c==0 -> Unknown  -- artificially introduced name
+                    |otherwise ->    Between (l,c) (l,c+len n-1)
+                 Nothing    -> Unknown
+               where len(Name s _ _ _) = length s
+                     len(Prim p _)     = length (strRep p)
+                     len(Tuple n _)    = n+2
+
+-- Literals ----------------------------------------------------------------
+
+data Lit                        = LInt  (Maybe (Int,Int)) Integer
+                                | LRat  (Maybe (Int,Int)) Rational
+                                | LChr  (Maybe (Int,Int)) Char
+                                | LStr  (Maybe (Int,Int)) String
+--                                deriving  (Eq)
+
+instance Eq Lit where
+  LInt _ m == LInt _ n = m == n
+  LRat _ m == LRat _ n = m == n
+  LChr _ m == LChr _ n = m == n
+  LStr _ m == LStr _ n = m == n
+  _ == _ = False
+
+instance Show Lit where
+    show (LInt _ i)             = "LInt " ++ show i
+    show (LRat _ r)             = "LRat " ++ show r
+    show (LChr _ c)             = "LChr " ++ show c
+    show (LStr _ s)             = "LStr " ++ show s
+    
+instance Pr Lit where
+    pr (LInt p i)                 = integer i
+    pr (LRat _ r)                 = rational r
+    pr (LChr _ c)                 = litChar c
+    pr (LStr _ s)                 = litString s
+
+
+instance HasPos Lit where
+    posInfo (LInt (Just (l,c)) i) = Between (l,c) (l,c+length(show i)-1) 
+    posInfo (LRat (Just (l,c)) r) = Between (l,c) (l,c) -- check length of rationals) 
+    posInfo (LChr (Just (l,c)) _) = Between (l,c) (l,c) 
+    posInfo (LStr (Just (l,c)) cs) = Between (l,c) (l,c+length cs+1)
+    posInfo _                     = Unknown
+
+lInt n                            = LInt Nothing (toInteger n)
+lRat r                            = LRat Nothing r
+lChr c                            = LChr Nothing c
+lStr s                            = LStr Nothing s
+
+-- Underlying monad ----------------------------------------------------------------------
+
+newtype M s a                   = M ((Int,[s]) -> Either String ((Int,[s]), a))
+
+
+instance Functor (M s) where
+    fmap f x                    = x >>= (return . f)
+
+instance Monad (M s) where
+    M m >>= f                   = M $ \k -> 
+                                    case m k of 
+                                        Right (k',a) -> m' k' where M m' = f a
+                                        Left s -> Left s
+    return a                    = M $ \k -> Right (k,a)
+    fail s                      = M $ \k -> Left s
+
+handle (M m) f                  = M $ \k ->
+                                    case m k of
+                                        Right r -> Right r
+                                        Left s  -> m' k where M m' = f s
+
+expose (M m)                    = M $ \k ->
+                                    case m k of
+                                        Right (k',a) -> Right (k',Right a)
+                                        Left s       -> Right (k, Left s)
+
+unexpose (Right a)              = return a
+unexpose (Left b)               = fail b
+
+runM (M m)                      = case m (1,[]) of 
+                                    Right (_,x) -> x
+                                    Left s      -> error s
+
+newNum                          = M $ \(n,s) -> Right ((n+1,s), n)
+
+currentNum                      = M $ \(n,s) -> Right ((n,s), n)
+
+addToStore x                    = M $ \(n,s) -> Right ((n,x:s), ())
+
+currentStore                    = M $ \(n,s) -> Right ((n,s), s)
+
+localStore (M m)                = M $ \(n0,s0) ->
+                                    case m (n0,[]) of
+                                      Right ((n,s), x) -> Right ((n,s0), x)
+                                      Left s           -> Left s
+
+newNameMod m s                  = do n <- newNum
+                                     return (Name s n m ann)
+  where ann                     = if s `elem` explicitSyms then suppAnnot { explicit = True } else suppAnnot
+        suppAnnot               = genAnnot { suppressMod = True }
+
+newName s                       = newNameMod Nothing s
+
+newNames s n                    = mapM (const (newName s)) [1..n]
+
+newNamesPos s ps                = mapM (newNamePos s) ps
+
+newNamePos s p                  = do n <- newName s
+                                     return (n {annot = genAnnot {location = startPos(posInfo p)}})
+
+renaming vs                     = mapM f vs
+  where f v | tag v == 0        = do n <- newNum
+                                     return (v, v { tag = n })
+            | otherwise         = return (v, v)
+
+
+-- Merging renamings ------------------------------------------------------
+
+-- Here we cannot use equality of names (Eq instance), since two unqualified
+-- imported names with the same string will have non-zero tags and hence not be compared
+-- for str equality.
+
+-- remove pairs from rn2 that are shadowed by rn1; return also shadowed names
+deleteRenamings [] rn2           = (rn2,[])
+deleteRenamings ((n,_):rn1) rn2
+  | not(isQualified n)          = (rn',if b then n:ns else ns)
+  | otherwise                   = (rn,ns)
+  where (rn,ns)                 = deleteRenamings rn1 rn2
+        (b,rn')                 = deleteName n rn
+        
+deleteName _ []                 = (False,[])
+deleteName n ((Name s t Nothing a,_):rn) 
+  | str n == s                  = (True,rn)
+deleteName n (p:rn)             = let (b,rn') = deleteName n rn
+                                  in  (b,p:rn')
+
+-- for merging renaming for locally bound names with ditto for imported names;
+-- removes unqualified form of imported name
+mergeRenamings1 rn1 rn2         = rn1 ++ rn2' 
+  where (rn2',_)                = deleteRenamings rn1 rn2
+
+-- for merging renamings from two imported modules;
+-- removes both occurrences when two unqualified names clash
+mergeRenamings2 rn1 rn2         = case ns' of
+                                     [] -> rn1' ++ rn2'
+                                     _  -> tr' ("Warning: clash of imported name(s): "++showids ns' ++ "(hence not in scope)\n") (rn1' ++ rn2')
+  where (rn2',ns)               = deleteRenamings rn1 rn2
+        rn1'                    = deleteNames ns rn1
+        ns'                     = filter (not . isGenerated) ns
+        deleteNames [] rn       = rn
+        deleteNames (n:ns) rn   = deleteNames ns (snd (deleteName n rn))
+
+-- Assertions -----------------------------------------------------------------------
+
+assert e msg ns
+  | e                           = return ()
+  | otherwise                   = errorIds msg ns
+
+assert1 e msg ts
+  | e                           = return ()
+  | otherwise                   = errorTree msg ts
+
+
+-- Poor man's exception datatype ------------------------------------------------------
+
+encodeError msg ids             = msg ++ ": " ++ concat (intersperse " " (map packName ids))
+
+decodeError str
+  | msg `elem` encodedMsgs      = Just (msg, map unpackName (words rest))
+  | otherwise                   = Nothing
+  where (msg,_:rest)            = span (/=':') str
+
+encodedMsgs                     = [circularSubMsg, ambigInstMsg, ambigSubMsg]
+
+circularSubMsg                  = "Circular subtyping"
+ambigInstMsg                    = "Ambiguous instances"
+ambigSubMsg                     = "Ambiguous subtyping"
+
+assert0 e msg
+  | e                           = return ()
+  | otherwise                   = fail msg
+
+
+-- Tracing -----------------------------------------------------------------------------
+
+tr m                            = trace (m++"\n") (return ())
+
+tr' m e                         = trace ("\n"++m++"\n") e
+
+trNum str                       = do n <- currentNum
+                                     tr ("At "++show n++": "++str)
+
+-- Free variables -----------------------------------------------------------------------
+
+class Ids a where
+    idents :: a -> [Name]
+
+instance Ids a => Ids [a] where
+    idents xs                   = concatMap idents xs
+
+instance Ids a => Ids (Name,a) where
+    idents (v,a)                = idents a
+
+tycons x                        = filter isCon (idents x)
+
+tyvars x                        = filter isVar (idents x)
+
+evars x                         = filter isVar (idents x)
+
+svars x                         = filter isState (idents x)
+
+
+vclose vss vs
+  | null vss2                   = nub vs
+  | otherwise                   = vclose vss1 (concat vss2 ++ vs)
+  where (vss1,vss2)             = partition (null . intersect vs) vss
+
+
+
+-- Bound variables -----------------------------------------------------------------------
+
+class BVars a where
+    bvars  :: a -> [Name]
+    
+    bvars _                     = []
+
+
+-- Mappings -----------------------------------------------------------------------------
+
+infixr 4 @@
+
+type Map a b = [(a,b)]
+
+lookup' assoc x                 = case lookup x assoc of
+                                    Just e -> e
+                                    Nothing -> internalError "lookup': did not find" x
+
+lookup'' s assoc x              = case lookup x assoc of
+                                    Just e -> e
+                                    Nothing -> internalError ("lookup' (" ++ s ++ "): did not find") x
+
+inv assoc                       = map (\(a,b) -> (b,a)) assoc
+
+delete k []                     = []
+delete k (x:xs)
+  | fst x == k                  = xs
+  | otherwise                   = x : delete k xs
+
+
+delete' ks xs                   = foldr delete xs ks
+
+
+insert k x []                   = [(k,x)]
+insert k x ((k',x'):assoc)
+  | k == k'                     = (k,x) : assoc
+  | otherwise                   = (k',x') : insert k x assoc
+
+
+update k f []                   = error "Internal: Common.update"
+update k f ((k',x):assoc)
+  | k == k'                     = (k, f x) : assoc
+  | otherwise                   = (k',x) : update k f assoc
+
+
+search p []                     = Nothing
+search p (a:assoc)
+  | p a                         = Just a
+  | otherwise                   = search p assoc
+
+
+insertBefore kx ks []           = [kx]
+insertBefore kx ks ((k,x'):assoc)
+  | k `elem` ks                 = kx:(k,x'):assoc
+  | otherwise                   = (k,x') : insertBefore kx ks assoc
+
+
+
+
+(@@)                            :: Subst b a b => Map a b -> Map a b -> Map a b
+s1 @@ s2                        = [(u,subst s1 t) | (u,t) <- s2] ++ s1
+
+
+merge                           :: (Eq a, Eq b) => Map a b -> Map a b -> Maybe (Map a b)
+merge [] s'                     = Just s'
+merge ((v,t):s) s'              = case lookup v s' of
+                                    Nothing         -> merge s ((v,t):s')
+                                    Just t' | t==t' -> merge s s'
+                                    _               -> Nothing
+
+nullSubst                       = []
+
+a  +-> b                        = [(a,b)]
+
+restrict s vs                   = filter ((`elem` vs) . fst) s
+
+prune s vs                      = filter ((`notElem` vs) . fst) s
+
+class Subst a i e where
+    subst :: Map i e -> a -> a
+
+
+substVars s xs                  = map (substVar s) xs
+
+substVar s x                    = case lookup x s of
+                                    Just x' -> x'
+                                    Nothing -> x
+
+
+instance Subst a i e => Subst [a] i e where
+    subst [] xs                 = xs
+    subst s xs                  = map (subst s) xs
+
+instance Subst a i e => Subst (Name,a) i e where
+    subst s (v,a)               = (v, subst s a)
+
+instance Subst a i e => Subst (Maybe a) i e where
+    subst s Nothing             = Nothing
+    subst s (Just a)            = Just (subst s a)
+
+
+newEnv x ts                     = do vs <- mapM (const (newName x)) ts
+                                     return (vs `zip` ts)
+
+newEnvPos x ts e                = do vs <- mapM (const (newNamePos x e)) ts
+                                     return (vs `zip` ts)
+
+
+
+-- Kinds ---------------------------------------------------------------------------------
+
+data Kind                       = Star
+                                | KFun    Kind Kind
+                                | KWild
+                                | KVar    Int
+                                deriving (Eq,Show)
+
+instance HasPos Kind where
+  posInfo _                     = Unknown
+
+newtype TVar                    = TV (Int,Kind)
+
+type KEnv                       = Map Name Kind
+
+instance Eq TVar where
+    TV (n,k) == TV (n',k')      = n == n'
+
+instance Show TVar where
+    show (TV (n,k))             = show n
+
+instance Pr TVar where
+    pr (TV (n,k))               = pr n
+
+
+newTV k                         = do n <- newNum
+                                     return (TV (n,k))
+
+newKVar                         = do n <- newNum
+                                     return (KVar n)
+
+tvKind (TV (n,k))               = k
+
+kvars Star                      = []
+kvars (KVar n)                  = [n]
+kvars (KFun k1 k2)              = kvars k1 ++ kvars k2
+
+kArgs (KFun k k')               = k : kArgs k'
+kArgs k                         = []
+
+kFlat k                         = (kArgs k, kRes k)
+
+kRes (KFun k k')                = kRes k'
+kRes k                          = k
+
+
+instance Subst Kind Int Kind where
+    subst s Star                = Star
+    subst s k@(KVar n)          = case lookup n s of
+                                    Just k' -> k'
+                                    Nothing -> k
+    subst s (KFun k1 k2)        = KFun (subst s k1) (subst s k2)
+
+instance Subst (Kind,Kind) Int Kind where
+    subst s (a,b)               = (subst s a, subst s b)
+
+instance Pr (Name,Kind) where
+    pr (n,k)                    = prId n <+> text "::" <+> pr k
+
+instance Pr Kind where
+    prn 0 (KFun k1 k2)          = prn 1 k1 <+> text "->" <+> prn 0 k2
+    prn 0 k                     = prn 1 k
+    prn 1 Star                  = text "*"
+    prn 1 (KVar n)              = text ('_':show n)
+    prn 1 KWild                 = text "_"
+    prn 1 k                     = parens (prn 0 k)
+
+
+class TVars a where
+    tvars                       :: a -> [TVar]
+
+instance TVars a => TVars [a] where
+    tvars xs                    = concatMap tvars xs
+
+instance TVars a => TVars (Name,a) where
+    tvars (v,a)                 = tvars a
+
+
+-- Defaults ------------------------------------------
+
+data Default a = Default Bool Name Name  -- First arg is True if declaration is in public part
+               | Derive Name a
+             deriving (Eq, Show)
+
+instance Pr a => Pr(Default a) where
+  pr (Default _ a b)            = pr a <+> text "<" <+> pr b
+  pr (Derive v t)               = pr v <+> text "::" <+> pr t
+
+instance HasPos a => HasPos (Default a) where
+  posInfo (Default _ a b)       = between (posInfo a) (posInfo b)
+  posInfo (Derive v t)          = between (posInfo v) (posInfo t)
+
+
+-- Binary --------------------------------------------
+
+instance Binary Lit where
+  put (LInt _ a) = putWord8 0 >> put a
+  put (LRat _ a) = putWord8 1 >> put a
+  put (LChr _ a) = putWord8 2 >> put a
+  put (LStr _ a) = putWord8 3 >> put a
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> return (lInt (a::Integer))
+      1 -> get >>= \a -> return (lRat a)
+      2 -> get >>= \a -> return (lChr a)
+      3 -> get >>= \a -> return (lStr a)
+      _ -> fail "no parse"
+
+instance Binary Kind where
+  put Star       = putWord8 0
+  put (KFun a b) = putWord8 1 >> put a >> put b
+  put KWild      = putWord8 2
+  put (KVar a)   = putWord8 3 >> put a
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> return Star
+      1 -> get >>= \a -> get >>= \b -> return (KFun a b)
+      2 -> return KWild
+      3 -> get >>= \a -> return (KVar a)
+      _ -> fail "no parse"
+
+instance Binary TVar where
+  put (TV a) = put a
+  get = get >>= \a -> return (TV a)
+
+instance Binary a => Binary (Default a) where
+  put (Default a b c) = putWord8 0 >> put a >> put b >> put c
+  put (Derive a b) = putWord8 1 >> put a >> put b
+ 
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+       0 -> get >>= \a -> get >>= \b -> get >>= \c -> return (Default a b c)
+       1 -> get >>= \a ->  get >>= \b -> return (Derive a b)
diff --git a/src/Config.hs b/src/Config.hs
new file mode 100644
--- /dev/null
+++ b/src/Config.hs
@@ -0,0 +1,326 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+--------------------------------------------------------------------------
+--
+-- Compiler configuration
+--
+-- This module contains both what GHC calls "dynamic flags", flags that
+-- can change between each compilation, and static flags. Initial idea
+-- from GHC, slightly modified to fit our needs.
+--
+---------------------------------------------------------------------------
+
+module Config (
+               -- Our Data from files/flags.
+               CfgOpts(..),
+               CmdLineOpts(..),
+               
+               -- Read out configuration from file.
+               readCfg,
+
+               -- Query about our options from flags.
+               cmdLineOpts,
+                          
+               -- Configurable paths
+               libDir,
+               includeDir,
+               rtsDir,
+               rtsCfg,
+               rtsMain,
+               
+               -- Print usage info and exit.
+               helpMsg,
+                      
+               -- Pass data. XXX Does not belong here?
+               Pass(..),
+               allPasses,
+                        
+               -- Dynamic Exceptions
+               TimbercException(..),
+               ) where
+
+
+import Char
+import System.Console.GetOpt
+import System                 ( getArgs, getEnv, getProgName )
+import qualified Control.Exception as Exception ( throwIO, Exception )
+import Data.Dynamic
+
+
+versionString = "The Timber compiler, version 1.0.1"
+
+-- | Contains the configuration for the compiler with the current
+-- command line switches.
+data CfgOpts         = CfgOpts { cCompiler       :: FilePath,
+                                 compileFlags    :: String,
+                                 linkFlags       :: String
+                               } deriving (Show, Eq, Read)
+
+-- | Command line options.
+data CmdLineOpts     = CmdLineOpts { isVerbose :: Bool,
+                                     datadir   :: FilePath,
+                                     target    :: String,
+                                     outfile   :: FilePath,
+                                     root      :: String,
+                                     make      :: String,
+                                     api       :: Bool,
+                                     pager     :: FilePath,
+                                     shortcut  :: Bool,
+                                     stopAtC   :: Bool,
+                                     stopAtO   :: Bool,
+                                     dumpAfter :: Pass -> Bool,
+                                     stopAfter :: Pass -> Bool
+                                   }
+
+
+options              :: [OptDescr Flag]
+options              = [ Option []
+                                ["help"]
+                                (NoArg Help)
+                                "Show this message",
+                         Option [] 
+                                ["version"] 
+                                (NoArg Version)
+                                "Print version information",
+                         Option [] 
+                                ["print-datadir"] 
+                                (NoArg PrintDatadir)
+                                "Print effective datadir path",
+                         Option ['v'] 
+                                ["verbose"] 
+                                (NoArg Verbose)
+                                "Be verbose",
+                         Option []
+                                ["datadir"]
+                                (ReqArg Datadir "DIRECTORY")
+                                "Path to installed libraries and run-time systems",
+                         Option []
+                                ["target"]
+                                (ReqArg Target "TARGET")
+                                "Target platform",
+                         Option ['o'] 
+                                ["output"]  
+                                (ReqArg Outfile "FILE")     
+                                "Name of executable output",
+                         Option []
+                                ["root"]
+                                (ReqArg Root "[MODULE.]NAME")
+                                "Define root of executable program",
+                         Option []
+                                ["make"]
+                                (ReqArg Make "[MODULE.]NAME")
+                                "Make program with given root module",
+                         Option []
+                                ["api"]
+                                (NoArg Api)
+                                "Produce html file with API",
+                         Option [] 
+                                ["pager"] 
+                                (ReqArg Pager "PATH")
+                                "Use command PATH to display .html files",
+                         Option ['s']
+                                ["shortcut"]
+                                (NoArg ShortCut)
+                                "Try to reuse existing .c, .h and .ti files",
+                         Option ['C'] 
+                                ["stop-at-c"]
+                                (NoArg StopAtC)
+                                "Stop compiler after .c file generation",
+                         Option ['c'] 
+                                ["stop-at-o"] 
+                                (NoArg StopAtO)
+                                "Stop compiler after .o file generation"
+                       ]
+                       ++ 
+                       [ Option []
+                                ["dump-" ++ map Char.toLower (show pass)]
+                                (NoArg $ DumpAfter pass)
+                                ("Dump " ++ show pass ++ " output to stdout")
+                       | pass <- allPasses 
+                       ] 
+                       ++ 
+                       [ Option []
+                                ["stop-after-" ++ map Char.toLower (show pass)]
+                                (NoArg $ StopAfter pass)
+                                ("Stop compiler after pass " ++ show pass)
+                       | pass <- allPasses 
+                       ]
+                       
+
+
+data Flag            = Help
+                     | Verbose
+                     | Version
+                     | PrintDatadir
+                     | Datadir String
+                     | Target String
+                     | Outfile String
+                     | Root String
+                     | Make String
+                     | Api
+                     | Pager String
+                     | ShortCut
+                     | StopAtC
+                     | StopAtO
+                     | DumpAfter Pass
+                     | StopAfter Pass
+                     deriving (Show,Eq)
+
+data TimbercException
+  = CmdLineError String  -- User did something wrong with command line options.
+  | Panic String         -- Unexpected faults in timberc, panic.
+  deriving (Eq)
+
+instance Typeable TimbercException where
+  typeOf _ = mkTyConApp (mkTyCon "TimbercException") []
+
+-- | Let us show our exceptions as expected.
+instance Show TimbercException where
+  showsPrec _ (CmdLineError s) = showString s
+  showsPrec _ (Panic s)        = showString $
+                                 "Panic! Please file a bug report!\n\n" ++ s
+
+instance Exception.Exception TimbercException
+
+cmdLineOpts          :: [String] -> IO (CmdLineOpts,[String])
+cmdLineOpts args     = do pager <- System.getEnv "PAGER" `catch` (\_ -> return "")
+                          let pagerOpt = if null pager then [] else ["--pager", pager]
+                          home <- System.getEnv "HOME" `catch` (\_ -> return "")
+                          cfgFile <- System.getEnv "TIMBERC_CFG" `catch` (\_ -> return (home ++ "/.timberc"))
+                          cfgOpts <- readFile cfgFile `catch` (\_ -> return "")
+                          case getOpt Permute options (args ++ words cfgOpts ++ pagerOpt) of
+                            (flags,n,[]) 
+                              | Help `elem` flags -> do 
+                                  msg <- helpMsg
+                                  Exception.throwIO (CmdLineError msg)
+                              | Version `elem` flags ->
+                                  Exception.throwIO (CmdLineError versionString)
+                              | PrintDatadir `elem` flags ->
+                                  Exception.throwIO (CmdLineError (datadir (mkCmdLineOpts flags)))
+                              | otherwise -> 
+                                  return (mkCmdLineOpts flags, n)
+                            (_,_,errs) -> do 
+                                  msg <- helpMsg
+                                  Exception.throwIO (CmdLineError (concat errs ++ msg))
+
+
+helpMsg              = do pgm <- getProgName
+                          return (usageInfo (header pgm) options)
+  where header pgm   = "Usage: " ++ pgm ++ " [OPTION...] files..."
+                         
+
+
+-- CmdLineOpts is a set of functions that can be queried
+-- about the command line options.
+
+mkCmdLineOpts        :: [Flag] -> CmdLineOpts
+mkCmdLineOpts flags  =  CmdLineOpts { isVerbose = find Verbose,
+                                      datadir   = first ""
+                                                  [ dir | (Datadir dir) <- flags ],
+                                      target    = first "POSIX"
+                                                  [ target | (Target target) <- flags ],
+                                      outfile   = first "a.out"
+                                                  [ file | (Outfile file) <- flags ],
+                                      root      = first "root"
+                                                  [ root | (Root root) <- flags ],
+                                      make      = first ""
+                                                  [ root | Make root <- flags ],
+                                      api       = find Api,
+                                      pager     = first "less"
+                                                  [ p | (Pager p) <- flags ],
+                                      shortcut  = find ShortCut,
+                                      stopAtC   = find StopAtC,
+                                      stopAtO   = find StopAtO,
+                                      dumpAfter = find . DumpAfter,
+                                      stopAfter = find . StopAfter
+                                    }
+  where 
+    first def []     = def
+    first def (opt:_)= opt
+    find opt         = first False [ True | flag <- flags, flag == opt ]
+
+
+
+
+
+-- | Reads a configuration file in the format of CfgOpts.
+readCfg clo = parseCfg (rtsCfg clo)
+
+
+-- | Internal help routine for readCfg.
+parseCfg file
+    = do
+      txt <- catch (readFile file)
+             (\e -> Exception.throwIO $ emsg file)
+      config <- safeRead file txt
+      return config
+    where        
+        safeRead :: FilePath -> String -> IO CfgOpts
+        safeRead file text =
+            let val = case [x | (x,t) <- reads text, ("","") <- lex t] of
+                      [x] -> x
+                      [] -> error ("Parse error in " ++ file ++ "\n")
+                      _ -> error ("File not found: " ++ file ++ "\n")
+                in (return $! val)
+        emsg f = (CmdLineError $ "Could not open " ++ file)
+
+
+-- | The different compiler passes.
+-- XXX Should not be in this file.
+data Pass            = Parser
+                     | Desugar1
+                     | Rename
+                     | Desugar2
+                     | S2C
+                     | KCheck
+                     | TCheck
+                     | Termred
+                     | Type2
+                     | C2K
+                     | Kindlered
+                     | LLift
+                     | Prepare4C
+                     | K2C
+                     | Main                  -- top level 'pass'
+                     deriving (Show,Eq,Ord,Enum)
+                        
+allPasses            :: [Pass]
+allPasses            = [Parser .. K2C]
+
+
+rtsDir clo           = datadir clo ++ "/rts" ++ target clo
+rtsCfg clo           = rtsDir clo ++ "/timberc.cfg"
+rtsMain clo          = rtsDir clo ++ "/main.c"
+libDir clo           = datadir clo ++ "/lib"
+includeDir clo       = datadir clo ++ "/include"
diff --git a/src/Core.hs b/src/Core.hs
new file mode 100644
--- /dev/null
+++ b/src/Core.hs
@@ -0,0 +1,1151 @@
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
+
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Core where
+
+import Common
+import PP
+import Data.Binary
+import Monad
+
+
+data Module     = Module Name [(Bool,Name)] [Default Scheme] Types [Name] [Binds]
+                deriving  (Eq,Show)
+
+data Types      = Types   KEnv Decls
+                deriving  (Eq,Show)
+
+data Binds      = Binds   Bool TEnv Eqns
+                deriving  (Eq,Show)
+
+--type Default    = (Bool,Name,Name)
+
+type PEnv       = TEnv
+
+type TEnv       = Map Name Scheme
+
+type CEnv       = Map Name Constr
+
+type Decls      = Map Name Decl
+
+type Eqns       = Map Name Exp
+
+data Decl       = DData     [Name] [Scheme] CEnv
+                | DRec Bool [Name] [Scheme] TEnv
+                | DType     [Name] Type
+                deriving  (Eq,Show)
+
+type PScheme    = Scheme
+
+type Pred       = Type
+
+data Scheme     = Scheme  Rho [PScheme] KEnv
+                deriving  (Eq,Show)
+
+data Constr     = Constr  [Scheme] [PScheme] KEnv
+                deriving (Eq,Show)
+
+data Rho        = R       Type
+                | F       [Scheme] Rho
+                deriving (Eq,Show)
+
+data Type       = TId     Name
+                | TVar    TVar
+                | TFun    [Type] Type
+                | TAp     Type Type
+                deriving  (Eq,Show)
+
+type Alt        = (Pat, Exp)
+
+data Pat        = PCon    Name
+                | PLit    Lit
+                | PWild
+                deriving (Eq,Show)
+
+data Exp        = ECon    Name
+                | ESel    Exp Name
+                | EVar    Name
+                | ELam    TEnv Exp
+                | EAp     Exp [Exp]
+                | ELet    Binds Exp
+                | ECase   Exp [Alt]
+                | ERec    Name Eqns
+                | ELit    Lit
+
+                | EAct    Exp Exp
+                | EReq    Exp Exp
+                | ETempl  Name Type TEnv Cmd
+                | EDo     Name Type Cmd
+                deriving (Eq,Show)
+
+data Cmd        = CGen    Name Type Exp Cmd
+                | CAss    Name Exp Cmd
+                | CLet    Binds Cmd
+                | CRet    Exp
+                | CExp    Exp
+                deriving (Eq,Show)
+
+
+litType (LInt _ i)              = TId (prim Int)
+litType (LRat _ r)              = TId (prim Float)
+litType (LChr _ c)              = TId (prim Char)
+litType (LStr _ s)              = TAp (TId (prim LIST)) (TId (prim Char)) --internalError0 "Core.litType LStr"
+
+
+isNewAp (EVar (Prim New _))     = True
+isNewAp (EAp e _)               = isNewAp e
+isNewAp (ELet bs e)
+  | isEncoding bs               = isNewAp e
+isNewAp _                       = False
+
+
+tupleKind n                     = foldr KFun Star (replicate n Star)
+
+
+tupleType n                     = Scheme (tFun' (map scheme ts) t) [] (vs `zip` repeat Star)
+  where vs                      = take n abcSupply
+        ts                      = map TId vs
+        t                       = tAp (TId (tuple n)) ts
+
+
+newTVar k                       = fmap TVar (newTV k)
+
+
+nullCon                         = Constr [] [] []
+
+
+isLitPat (PLit _)               = True
+isLitPat _                      = False
+
+isConPat (PCon _)               = True
+isConPat _                      = False
+
+isLambda (ELam _ _)             = True
+isLambda _                      = False
+
+
+arity (ELam te e)               = length te
+arity e                         = 0
+
+eLet [] [] e                    = e
+eLet te eq e                    = ELet (Binds False te eq) e
+
+eLet' [] e                      = e
+eLet' (bs:bss) e                = ELet bs (eLet' bss e)
+
+cLet' [] c                      = c
+cLet' (bs:bss) c                = CLet bs (cLet' bss c)
+
+eLam [] e                       = e
+eLam te e                       = ELam te e
+
+eAbs (ELam te e)                = (te,e)
+eAbs e                          = ([],e)
+
+eAp e []                        = e
+eAp e es                        = EAp e es
+
+eAp1 e1 e2                      = EAp e1 [e2]
+
+eAp2 (EAp e es) es'             = eAp2 e (es++es')
+eAp2 e es                       = EAp e es
+
+eFlat (EAp e es)                = (e, es)
+eFlat e                         = (e,[])
+
+eHead (EAp e e')                = eHead e
+eHead e                         = e
+
+nAp n f es                      = f es1 : es2
+  where (es1,es2)               = splitAt n es
+
+tAp t ts                        = foldl TAp t ts
+
+tAp' i vs                       = tAp (TId i) (map TId vs)
+
+tFun [] rh                      = rh
+tFun scs rh                     = F scs rh
+
+tFun' scs t                     = tFun scs (R t)
+
+tFlat t                         = flat t []
+  where flat (TAp t t') ts      = flat t (t':ts)
+        flat t ts               = (t,ts)
+
+
+tHead (TAp t t')                = tHead t
+tHead t                         = t
+
+tId (TId i)                     = i
+
+isTVar (TVar _)                 = True
+isTVar _                        = False
+
+
+a `sub` b                       = TFun [a] b
+
+
+isSub' p                        = isSub (body p)
+
+
+isSub (TFun [l] u)              = True
+isSub _                         = False
+
+isClass' p                      = isClass (body p)
+
+isClass c                       = not (isSub c)
+
+
+subs (TFun [l] u)               = (l,u)
+subs t                          = internalError "subs of" t
+
+subsyms p                       = (tId (tHead t), tId (tHead t'))
+  where (t,t')                  = subs (body p)
+
+lowersym p                      = fst (subsyms p)
+uppersym p                      = snd (subsyms p)
+
+headsym                         = tId . tHead . body
+
+funArgs (F ts rh)               = ts
+funArgs rh                      = []
+
+
+body (Scheme rh _ _)            = body' rh
+  where body' (R c)             = c
+        body' (F _ rh)          = body' rh
+
+ctxt (Scheme _ ps _)            = ps
+
+quant (Scheme _ _ ke)           = ke
+
+scheme t                        = Scheme (R t) [] []
+scheme' t                       = Scheme t [] []
+pscheme p                       = Scheme (R p) [] []
+pscheme' p ps ke                = Scheme (R p) ps ke
+
+
+splitInsts (Binds r pe eq)      = (Binds False pe1 eq1, Binds r pe2 eq2)
+  where (pe1,pe2)               = partition (isSub' . snd) pe
+        (eq1,eq2)               = partition ((`elem` dom pe1) . fst) eq
+
+
+ksigsOf (Types ke ds)           = ke
+
+tdefsOf (Types ke ds)           = ds
+
+tsigsOf (Binds _ te es)         = te
+
+tsigsOf'                        = foldr (\bs -> ((tsigsOf bs) ++)) []
+
+eqnsOf (Binds _ te es)          = es
+
+isRec (Binds r _ _)             = r
+
+catDecls ds1 ds2                = Types (ksigsOf ds1 ++ ksigsOf ds2) (tdefsOf ds1 ++ tdefsOf ds2)
+
+catBinds bs1 bs2                = Binds (isRec bs1 || isRec bs2) (tsigsOf bs1 ++ tsigsOf bs2) (eqnsOf bs1 ++ eqnsOf bs2)
+
+concatBinds                     = foldr catBinds nullBinds
+
+nullDecls                       = Types [] []
+
+nullBinds                       = Binds True [] []
+
+clash (Binds r te es)           = not r && dom es `overlaps` evars es
+
+
+altPats                         = map fst
+altRhss                         = map snd
+
+oplus eqs eqs'                  = filter ((`notElem` vs) . fst) eqs ++ eqs'
+  where vs                      = dom eqs'
+
+
+-- One-way matching -----------------------------------------------------
+-- Only apply when types are known to match!! ---------------------------
+
+
+matchTs []                              = nullSubst
+matchTs ((t,TVar n):eqs)                = matchTs (subst s eqs) @@ s
+  where s                               = n +-> t
+matchTs ((TAp t u,TAp t' u'):eqs)       = matchTs ((t,t'):(u,u'):eqs)
+matchTs ((TId c,TId c'):eqs)            = matchTs eqs
+matchTs ((TFun ts t,TFun ts' t'):eqs)   = matchTs ((t,t') : ts `zip` ts' ++ eqs)
+matchTs _                               = internalError0 "Core.match"
+
+
+-- Equality up to renaming ----------------------------------------------
+
+equalTs []                              = True
+equalTs ((TVar n, t@(TVar n')):eqs)
+  | n == n'                             = equalTs eqs
+  | otherwise                           = equalTs (subst (n +-> t) eqs)
+equalTs ((TAp t u, TAp t' u'):eqs)      = equalTs ((t,t'):(u,u'):eqs)
+equalTs ((TId c,TId c'):eqs)
+  | c == c'                             = equalTs eqs
+equalTs ((TFun ts t,TFun ts' t'):eqs)
+  | length ts == length ts'             = equalTs ((t,t') : ts `zip` ts' ++ eqs)
+equalTs eqs                             = False
+
+
+-- Simple equality check (modulo function type representation) ----------------
+
+sameType sc t0                          = case schemeToType sc of
+                                            Just t  -> t == t0
+                                            Nothing -> False
+
+schemeToType (Scheme rh [] [])          = rhoToType rh
+schemeToType _                          = Nothing
+
+rhoToType (R t)                         = return t
+rhoToType (F scs rh)                    = do ts <- mapM schemeToType scs
+                                             t <- rhoToType rh
+                                             return (TFun ts t)
+
+
+-- Free variables (Exp) -------------------------------------------------------------
+
+instance Ids Binds where
+    idents (Binds rec te eqns)
+      | rec                     = idents eqns \\ dom eqns
+      | otherwise               = idents eqns
+
+instance Ids Exp where
+    idents (EVar v)             = [v]
+    idents (ESel e l)           = idents e
+    idents (ELam te e)          = idents e \\ dom te
+    idents (EAp e es)           = idents e ++ idents es
+    idents (ELet bs e)          = idents bs ++ (idents e \\ bvars bs)
+    idents (ECase e alts)       = idents e ++ idents alts
+    idents (ERec c eqs)         = idents eqs
+    idents (EAct e e')          = idents e ++ idents e'
+    idents (EReq e e')          = idents e ++ idents e'
+    idents (ETempl x t te c)    = idents c \\ (x : dom te)
+    idents (EDo x t c)          = filter (not . isState) (idents c \\ [x])
+    idents _                    = []
+
+instance Ids Alt where
+    idents (p,e)                = idents e
+
+
+instance Ids Cmd where
+    idents (CLet bs c)          = idents bs ++ (idents c \\ bvars bs)
+    idents (CGen x t e c)       = idents e ++ (idents c \\ [x])
+    idents (CAss x e c)         = idents e ++ idents c
+    idents (CRet e)             = idents e
+    idents (CExp e)             = idents e
+
+
+-- Substitutions (Exp) --------------------------------------------------------------
+
+-- Note! This substitution algorithm does not alpha convert!
+-- Only use when variables are known not to clash
+
+instance Subst Binds Name Exp where
+    subst s (Binds r te eqns)   = Binds r te (subst s eqns)
+    
+instance Subst Exp Name Exp where
+    subst [] e                  = e
+    subst s (EVar v)            = case lookup v s of
+                                      Just e  -> e
+                                      Nothing -> EVar v
+    subst s (ESel e l)          = ESel (subst s e) l
+    subst s (ELam te e)         = ELam te (subst s e)
+    subst s (EAp e es)          = EAp (subst s e) (subst s es)
+    subst s (ELet bs e)         = ELet (subst s bs) (subst s e)
+    subst s (ECase e alts)      = ECase (subst s e) (subst s alts)
+    subst s (ERec c eqs)        = ERec c (subst s eqs)
+    subst s (EAct e e')         = EAct (subst s e) (subst s e')
+    subst s (EReq e e')         = EReq (subst s e) (subst s e')
+    subst s (ETempl x t te c)   = ETempl x t te (subst s c)
+    subst s (EDo x t c)         = EDo x t (subst s c)
+    subst s e                   = e
+
+instance Subst Cmd Name Exp where
+    subst s (CLet bs c)         = CLet (subst s bs) (subst s c)
+    subst s (CAss x e c)        = CAss x (subst s e) (subst s c)
+    subst s (CGen x t e c)      = CGen x t (subst s e) (subst s c)
+    subst s (CRet e)            = CRet (subst s e)
+    subst s (CExp e)            = CExp (subst s e)
+
+instance Subst Exp a b => Subst Alt a b where
+    subst s (p,rh)              = (p, subst s rh)
+
+instance Subst (Exp, Exp) Name Exp where
+    subst s (e,e')              = (subst s e, subst s e')
+
+
+instance Subst Binds TVar Type where
+    subst s (Binds r te eqns)   = Binds r (subst s te) (subst s eqns)
+
+instance Subst Exp TVar Type where
+    subst [] e                  = e
+    subst s (ESel e l)          = ESel (subst s e) l
+    subst s (ELam te e)         = ELam (subst s te) (subst s e)
+    subst s (EAp e es)          = EAp (subst s e) (subst s es)
+    subst s (ELet bs e)         = ELet (subst s bs) (subst s e)
+    subst s (ECase e alts)      = ECase (subst s e) (subst s alts)
+    subst s (ERec c eqs)        = ERec c (subst s eqs)
+    subst s (EAct e e')         = EAct (subst s e) (subst s e')
+    subst s (EReq e e')         = EReq (subst s e) (subst s e')
+    subst s (ETempl x t te c)   = ETempl x (subst s t) (subst s te) (subst s c)
+    subst s (EDo x t c)         = EDo x (subst s t) (subst s c)
+    subst s e                   = e
+
+instance Subst Cmd TVar Type where
+    subst s (CLet bs c)         = CLet (subst s bs) (subst s c)
+    subst s (CAss x e c)        = CAss x (subst s e) (subst s c)
+    subst s (CGen x t e c)      = CGen x (subst s t) (subst s e) (subst s c)
+    subst s (CRet e)            = CRet (subst s e)
+    subst s (CExp e)            = CExp (subst s e)
+
+
+
+instance Subst Binds Name Type where
+    subst s (Binds r te eqns)   = Binds r (subst s te) (subst s eqns)
+
+instance Subst Exp Name Type where
+    subst [] e                  = e
+    subst s (ESel e l)          = ESel (subst s e) l
+    subst  s (ELam te e)         = ELam (subst s te) (subst s e)
+    subst s (EAp e es)          = EAp (subst s e) (subst s es)
+    subst s (ELet bs e)         = ELet (subst s bs) (subst s e)
+    subst s (ECase e alts)      = ECase (subst s e) (subst s alts)
+    subst s (ERec c eqs)        = ERec c (subst s eqs)
+    subst s (EAct e e')         = EAct (subst s e) (subst s e')
+    subst s (EReq e e')         = EReq (subst s e) (subst s e')
+    subst s (ETempl x t te c)   = ETempl x (subst s t) (subst s te) (subst s c)
+    subst s (EDo x t c)         = EDo x (subst s t) (subst s c)
+    subst s e                   = e
+
+instance Subst Cmd Name Type where
+    subst s (CLet bs c)         = CLet (subst s bs) (subst s c)
+    subst s (CAss x e c)        = CAss x (subst s e) (subst s c)
+    subst s (CGen x t e c)      = CGen x (subst s t) (subst s e) (subst s c)
+    subst s (CRet e)            = CRet (subst s e)
+    subst s (CExp e)            = CExp (subst s e)
+
+instance Subst Scheme Name Name where
+    subst s (Scheme rh ps ke)   = Scheme (subst s rh) (subst s ps) (map (subKE s) ke)
+      where subKE s (n,k)       = case lookup n s of
+                                    Just n' -> (n',k)
+                                    Nothing -> (n,k)
+
+instance Subst Rho Name Name where
+    subst s (R t)               = R (subst s t)
+    subst s (F scs rh)          = F (subst s scs) (subst s rh)
+
+instance Subst Type Name Name  where
+    subst s (TId c)             = case lookup c s of
+                                    Just c' -> TId c'
+                                    Nothing -> TId c
+    subst s (TAp t t')          = TAp (subst s t) (subst s t')
+    subst s (TFun ts t)         = TFun (subst s ts) (subst s t)
+    subst s (TVar n)            = TVar n
+    
+
+-- Type identifiers ---------------------------------------------------------
+
+instance Ids Decl where
+    idents (DData _ bs cs)      = idents bs ++ idents cs
+    idents (DRec _ _ bs ss)     = idents bs ++ idents ss
+    idents (DType _ t)          = idents t
+
+instance Ids Constr where
+    idents (Constr ts ps ke)    = idents ts ++ idents ps
+
+instance Ids Type where
+    idents (TId c)              = [c]
+    idents (TVar _)             = []
+    idents (TAp t t')           = idents t ++ idents t'
+    idents (TFun ts t)          = idents ts ++ idents t
+
+instance Ids Scheme where
+    idents (Scheme rh ps ke)    = (idents rh ++ idents ps) \\ dom ke
+    
+instance Ids Rho where
+    idents (R t)                = idents t
+    idents (F scs rh)           = idents scs ++ idents rh
+
+instance Subst Type Name Type where
+    subst s (TId c)             = case lookup c s of
+                                    Just t -> t
+                                    Nothing -> TId c
+    subst s (TVar n)            = TVar n
+    subst s (TAp t t')          = TAp (subst s t) (subst s t')
+    subst s (TFun ts t)         = TFun (subst s ts) (subst s t)
+
+instance Subst Scheme Name Type where
+    subst s (Scheme rh ps ke)   = Scheme (subst s rh) (subst s ps) ke
+
+instance Subst Rho Name Type where
+    subst s (R t)               = R (subst s t)
+    subst s (F scs rh)          = F (subst s scs) (subst s rh)
+
+instance Subst (Type,Type) Name Type where
+    subst s (t1,t2)             = (subst s t1, subst s t2)
+    
+instance Subst (Scheme,Scheme) Name Type where
+    subst s (s1,s2)             = (subst s s1, subst s s2)
+                
+
+-- Type variables --------------------------------------------------------------
+
+instance TVars Type where
+    tvars (TId c)               = []
+    tvars (TVar n)              = [n]
+    tvars (TAp t t')            = tvars t ++ tvars t'
+    tvars (TFun ts t)           = tvars ts ++ tvars t
+
+instance TVars Scheme where
+    tvars (Scheme t ps ke)      = tvars t ++ tvars ps
+
+instance TVars Rho where
+    tvars (R t)                 = tvars t
+    tvars (F scs rh)            = tvars scs ++ tvars rh
+
+instance Subst Type TVar Type where
+    subst [] t                  = t
+    subst s (TId c)             = TId c
+    subst s (TVar n)            = case lookup n s of
+                                    Just t -> t
+                                    Nothing -> TVar n
+    subst s (TAp t t')          = TAp (subst s t) (subst s t')
+    subst s (TFun ts t)         = TFun (subst s ts) (subst s t)
+
+instance Subst Scheme TVar Type where
+    subst [] sc                 = sc
+    subst s sc@(Scheme t ps ke) = Scheme (subst s t) (subst s ps) ke
+  
+
+instance Subst Rho TVar Type where
+    subst s (R t)               = R (subst s t)
+    subst s (F scs rh)          = F (subst s scs) (subst s rh)
+
+instance Subst (Type,Type) TVar Type where
+    subst s (t,t')              = (subst s t, subst s t')
+
+
+instance Subst (Scheme,Scheme) TVar Type where
+    subst s (sc,sc')            = (subst s sc, subst s sc')
+    
+    
+-- Kind variables ----------------------------------------------------------------
+
+instance Subst Decl Int Kind where
+    subst s (DData vs bs cs)    = DData vs (subst s bs) (subst s cs)
+    subst s (DRec i vs bs ss)   = DRec i vs (subst s bs) (subst s ss)
+    subst s (DType vs t)        = DType vs (subst s t)
+
+instance Subst Constr Int Kind where
+    subst s (Constr ts ps ke)   = Constr (subst s ts) (subst s ps) (subst s ke)
+  
+instance Subst Scheme Int Kind where
+    subst s (Scheme rh ps ke)  = Scheme (subst s rh) (subst s ps) (subst s ke)
+
+instance Subst Rho Int Kind where
+    subst s (R t)               = R (subst s t)
+    subst s (F scs rh)          = F (subst s scs) (subst s rh)
+
+instance Subst Type Int Kind where
+    subst s (TAp t t')          = TAp (subst s t) (subst s t')
+    subst s (TFun ts t)         = TFun (subst s ts) (subst s t)
+    subst s (TId c)             = TId c
+    subst s (TVar (TV (n,k)))   = TVar (TV (n, subst s k))
+    
+
+-- Alpha conversion -------------------------------------------------------------
+
+class AlphaConv a where
+    ac                          :: Map Name Name -> a -> M x a
+
+
+alphaConvert e | mustAc e       = ac nullSubst e
+               | otherwise      = return e
+
+mustAc (ELam te e)              = True
+mustAc (ELet bs e)              = True
+mustAc (EDo x tx c)             = True
+mustAc (ETempl x tx te c)       = True
+mustAc (EAp e es)               = any mustAc (e:es)
+mustAc (ESel e l)               = mustAc e
+mustAc (ERec c eqs)             = any mustAc (rng eqs)
+mustAc (EReq e1 e2)             = any mustAc [e1,e2]
+mustAc (EAct e1 e2)             = any mustAc [e1,e2]
+mustAc (ECase e alts)           = any mustAc (e:rng alts)
+mustAc e                        = False
+
+
+instance AlphaConv a => AlphaConv [a] where
+    ac s xs                     = mapM (ac s) xs
+
+instance (AlphaConv a, AlphaConv b) => AlphaConv (a,b) where
+    ac s (p,e)                  = liftM2 (,) (ac s p) (ac s e)
+
+instance AlphaConv Name where
+    ac s x                      = case lookup x s of
+                                    Just x' -> return x'
+                                    _       -> return x
+
+instance AlphaConv Binds where
+    ac s (Binds r te eqs)       = liftM2 (Binds r) (ac s te) (ac s eqs)
+    
+instance AlphaConv Exp where
+    ac s (ELit l)               = return (ELit l)
+    ac s (EVar x)               = liftM EVar (ac s x)
+    ac s (ECon k)               = return (ECon k)
+    ac s (ESel e l)             = liftM (`ESel` l) (ac s e)
+    ac s (ELam te e)            = do s' <- extSubst s (dom te)
+                                     liftM2 ELam (ac s' te) (ac s' e)
+    ac s (EAp e es)             = liftM2 EAp (ac s e) (mapM (ac s) es)
+    ac s (ELet bs e)            = do s' <- extSubst s (bvars bs)
+                                     liftM2 ELet (ac s' bs) (ac s' e)
+    ac s (ERec c eqs)           = liftM (ERec c) (ac s eqs)
+    ac s (ECase e alts)         = liftM2 ECase (ac s e) (ac s alts)
+    ac s (EReq e1 e2)           = liftM2 EReq (ac s e1) (ac s e2)
+    ac s (EAct e1 e2)           = liftM2 EAct (ac s e1) (ac s e2)
+    ac s (EDo x tx c)           = do s' <- extSubst s [x]
+                                     liftM3 EDo (ac s' x) (ac s' tx) (ac s' c)
+    ac s (ETempl x tx te c)     = do s' <- extSubst s (x : dom te)
+                                     liftM4 ETempl (ac s' x) (ac s' tx) (ac s' te) (ac s' c)
+        
+instance AlphaConv Pat where
+    ac s p                      = return p
+
+instance AlphaConv Cmd where
+    ac s (CRet e)               = liftM CRet (ac s e)
+    ac s (CExp e)               = liftM CExp (ac s e)
+    ac s (CGen x tx e c)        = do s' <- extSubst s [x]
+                                     liftM4 CGen (ac s' x) (ac s' tx) (ac s' e) (ac s' c)
+    ac s (CAss x e c)           = liftM3 CAss (ac s x) (ac s e) (ac s c)
+    ac s (CLet bs c)            = do s' <- extSubst s (bvars bs)
+                                     liftM2 CLet (ac s' bs) (ac s' c)
+
+instance AlphaConv Type where
+    ac s (TId n)                = case lookup n s of
+                                    Just n'       -> return (TId n')
+                                    _ | isVar n   -> newTVar Star   -- not quite correct, really need an env to find kind of n
+                                                                    -- But we're past kind errors anyway when we alphaconvert...
+                                      | otherwise -> return (TId n)
+    ac s (TFun t ts)            = liftM2 TFun (ac s t) (ac s ts)
+    ac s (TAp t u)              = liftM2 TAp (ac s t) (ac s u)
+    ac s t                      = return t
+
+instance AlphaConv Rho where
+    ac s (R t)                  = liftM R (ac s t)
+    ac s (F ts t)               = liftM2 F (ac s ts) (ac s t)
+
+instance AlphaConv Scheme where
+    ac s (Scheme t ps ke)       = do s' <- extSubst s (dom ke)
+                                     liftM3 Scheme (ac s' t) (ac s' ps) (ac s' ke)
+    
+instance AlphaConv Kind where
+    ac s k                      = return k
+    
+
+extSubst s xs                   = do s' <- mapM ext xs
+                                     return (s'++s)
+  where ext x                   = do n <- newNum
+                                     return (x, {-annotGenerated-} x { tag = n })
+                                     
+
+-- Bound variables --------------------------------------------------------------
+
+instance BVars Binds where
+    bvars (Binds r te eqns)     = dom eqns
+
+                 
+
+-- System F encodings ============================================================
+
+-- Encode a System F type application term
+encodeTApp env [] e             = return e
+encodeTApp env ts e             = do xs <- newNames tappSym (length ts)
+                                     let te = xs `zip` map scheme ts
+                                         eq = xs `zip` map EVar xs
+                                     return (ELet (Binds True te eq) e)
+
+isTAppEncoding (Binds r te _)   = r && isTApp (head (dom te))
+
+tAppTypes (Binds _ te _)        = map body (rng te)
+
+
+-- Encode a System F type abstraction term
+encodeTAbs env [] e             = return e
+encodeTAbs env ke e             = do x <- newName tabsSym
+                                     let te = [(x,Scheme (R (TId (prim UNITTYPE))) [] ke)]
+                                     return (ELet (Binds True te [(x,EVar x)]) e)
+
+isTAbsEncoding (Binds r te _)   = r && isTAbs (head (dom te))
+
+tAbsVars (Binds _ te _)         = dom (quant (head (rng te)))
+
+
+isEncoding bs                   = isTAppEncoding bs || isTAbsEncoding bs
+
+
+class Erase a where
+    erase               ::  a -> a
+
+instance Erase a => Erase [a] where
+    erase xs                    = map erase xs
+
+instance Erase a => Erase (Name,a) where
+    erase (x,e)                 = (x, erase e)
+
+instance Erase Exp where
+    erase (ESel e l)            = ESel (erase e) l
+    erase (ELam te e)           = ELam (erase te) (erase e)
+    erase (EAp e es)            = EAp (erase e) (erase es)
+    erase (ELet bs e)
+      | isEncoding bs           = erase e
+      | otherwise               = ELet (erase bs) (erase e)
+    erase (ECase e alts)        = ECase (erase e) (erase alts)
+    erase (ERec c eqs)          = ERec c (erase eqs)
+    erase (EAct e e')           = EAct (erase e) (erase e')
+    erase (EReq e e')           = EReq (erase e) (erase e')
+    erase (ETempl x t te c)     = ETempl x (erase t) (erase te) (erase c)
+    erase (EDo x t c)           = EDo x (erase t) (erase c)
+    erase e                     = e
+
+instance Erase Alt where
+    erase (p,e)                 = (p, erase e)
+
+instance Erase Binds where
+    erase (Binds r te es)       = Binds r (erase te) (erase es)
+    
+instance Erase Cmd where
+    erase (CLet bs c)           = CLet (erase bs) (erase c)
+    erase (CAss x e c)          = CAss x (erase e) (erase c)
+    erase (CGen x t e c)        = CGen x (erase t) (erase e) (erase c)
+    erase (CRet e)              = CRet (erase e)
+    erase (CExp e)              = CExp (erase e)
+    
+instance Erase Type where
+    erase (TAp t t')            = TAp (erase t) (erase t')
+    erase (TFun ts t)           = TFun (erase ts) (erase t)
+    erase (TId n)               = TId n
+    erase (TVar _)              = TId (prim Int)
+
+instance Erase Rho where
+    erase (F ts t)              = F (erase ts) (erase t)
+    erase (R t)                 = R (erase t)
+
+instance Erase Scheme where
+    erase (Scheme rh ps ke)     = Scheme (erase rh) (erase ps) ke
+
+
+-- Printing ==================================================================
+
+-- Modules -------------------------------------------------------------------
+
+instance Pr Module where
+    pr (Module i ns xs ds is bss) = text "module" <+> prId i <+> text "where"
+                                    $$ prImports ns $$ prDefaults xs $$ pr ds $$ prInstance is $$ vpr bss
+
+prImports []                      = empty
+prImports (i : is)                = prI i $$ prImports is
+  where prI(True,n)               = text "import" <+> pr n
+        prI(False,n)              = text "use" <+> pr n
+
+prDefaults []                     = empty
+prDefaults ns                     = text "default" <+> hpr ',' ns
+
+prInstance []                     = empty
+prInstance ns                     = text "instance" <+> hpr ',' ns
+
+instance Pr (Module,a) where
+  pr (m,_)                       = pr m
+
+-- Type declarations ---------------------------------------------------------
+
+instance Pr Types where
+    pr (Types ke ds)            = vpr ke $$ vpr ds
+
+instance Pr (Name, Decl) where
+    pr (i, DType vs t)          = text "type" <+> prId i <+> hsep (map prId vs) 
+                                  <+> text "=" <+> pr t
+    pr (i, DData vs ts cs)      = text "data" <+> prId i <+> hsep (map prId vs) 
+                                  <+> prSubs ts <+> prConstrs cs
+    pr (i, DRec isC vs ts ss)   = text kwd <+> prId i <+> hsep (map prId vs) 
+                                  <+> prSups ts <+> prEq ss $$ nest 4 (vpr ss)
+      where kwd                 = if isC then "typeclass " else "struct"
+
+prEq []                         = empty
+prEq _                          = text "where"
+
+
+-- Instances ---------------------------------------------------------------
+
+prInsts (Binds r te eqs)        = vcat (map prInst te) $$ vpr eqs
+
+prInst (i, p)                   = text "instance" <+> prId i <+> text "::" <+> prPScheme 0 p
+
+
+-- Bindings -----------------------------------------------------------------
+
+instance Pr Binds where
+--    pr (Binds True te eqns)     = text "rec" $$ vpr te $$ vpr eqns
+    pr (Binds _ te eqns)        = vpr te $$ vpr eqns
+    
+instance Pr (Name, Scheme) where
+    pr (v, sc)                  = prId v <+> text "::" <+> pr sc'
+      where sc'                 = subst s sc
+            s                   = map f (tyvars sc)
+            f v@(Name s n m a)  = (v, Name ('_':s) n m a)
+            f v                 = (v,v)
+                                  
+instance Pr (Name, Exp) where
+    pr (v, e)                   = prId v <+> text "=" <+> pr e
+
+instance Pr [(Name, Scheme)] where
+    pr ss                       = vpr ss
+        
+
+prTop te                        = vcat (map pr' te)
+  where pr' (v,sc)              = prId v <+> text "::" <+> pr sc
+
+
+-- Sub/supertypes -----------------------------------------------------------
+
+prSups []                       = empty
+prSups ts                       = char '<' <+> hpr ',' ts
+
+prSubs []                       = empty
+prSubs ts                       = char '>' <+> hpr ',' ts
+
+    
+-- Constructors ------------------------------------------------------------
+
+prConstrs []                    = empty
+prConstrs (c:cs)                = vcat (char '=' <+> pr c : map ((char '|' <+>) . pr) cs)
+
+instance Pr (Name,Constr) where
+    pr (i, Constr ts ps ke)     = prId i <+> hsep (map (prn 1) ts) <+> prContext ps ke
+
+
+-- Predicates --------------------------------------------------------------
+
+prContext [] []                 = empty
+prContext ps ke                 = text "\\\\" <+> preds
+  where preds                   = hsep (punctuate comma (map (prPScheme 1) ps ++ map prKind ke))
+
+prKind (n,Star)                 = prId n
+prKind (n,k)                    = prId n <+> text "::" <+> pr k
+
+prPScheme 0 (Scheme p ps ke)    = prRPred p <+> prContext ps ke
+prPScheme 1 (Scheme p [] [])    = prRPred p
+prPScheme 1 sc                  = parens (prPScheme 0 sc)
+
+prRPred (F [t1] t2)             = prn 1 t1 <+> text "<" <+> prn 1 t2
+prRPred (R t)                   = prPred t
+
+prPred (TFun [t1] t2)           = prn 1 t1 <+> text "<" <+> prn 1 t2
+prPred t                        = pr t
+
+
+-- Types -----------------------------------------------------------------
+
+instance Pr Scheme where
+    prn 0 (Scheme rh ps ke)     = prn 0 rh <+> prContext ps ke
+    prn 1 (Scheme rh [] [])     = prn 1 rh
+    prn n sc                    = parens (prn 0 sc)
+
+instance Pr Rho where
+    prn 0 (F scs rh)            = hsep (punctuate (text " ->") (map (prn 1) scs ++ [prn 1 rh]))
+    prn 0 rh                    = prn 1 rh
+    prn 1 (R t)                 = prn 1 t
+    prn 1 rh                    = parens (prn 0 rh)
+    
+instance Pr Type where
+    prn 0 (TFun ts t)           = hsep (punctuate (text " ->") (map (prn 1) (ts++[t])))
+    prn 0 t                     = prn 1 t
+    
+    prn 1 (TAp (TId (Prim LIST _)) t) = text "[" <> prn 0 t <> text "]"
+    prn 1 t@(TAp _ _)           = prTAp (tFlat t)
+      where prTAp (TId (Tuple n _),ts) = text "(" <> hpr ',' ts <> text ")"
+--            prTAp (t,ts)        = hang (prn 1 t) 2 (sep (map (prn 2) ts))
+            prTAp (t,ts)        = prn 1 t <+> sep (map (prn 2) ts)
+    prn 1 t                     = prn 2 t
+
+    prn 2 (TId c)               = prId c
+--    prn 2 (TVar _)              = text "_"
+    prn 2 (TVar n)              = text "_" <> pr n
+
+    prn 2 t                     = parens (prn 0 t)
+
+
+prMaybeScheme Nothing           = empty
+prMaybeScheme (Just t)          = prn 1 t
+
+
+-- Patterns ----------------------------------------------------------------
+
+instance Pr Pat where
+    pr (PCon k)                 = prId k
+    pr (PLit l)                 = pr l
+    pr (PWild)                  = text "_"
+    
+
+-- Expressions -------------------------------------------------------------
+
+prParam (x,Scheme (R (TVar _)) [] [])
+                                = prId x
+prParam (x,sc)                  = parens (pr (x,sc))
+
+instance Pr Exp where
+    prn 0 (ELam te e)           = hang (char '\\' <> sep (map prParam te) <+> text "->") 4 (pr e)
+    prn 0 (ELet bs e)
+      | isTAppEncoding bs       = pr e <+> braces (commasep pr (tAppTypes bs))
+      | isTAbsEncoding bs       = hang (text "/\\" <> sep (map prId (tAbsVars bs)) <+> text "->") 4 (pr e)
+--      | isTAppEncoding bs       = pr e
+--      | isTAbsEncoding bs       = pr e
+      | otherwise               = text "let" $$ nest 4 (pr bs) $$ text "in" <+> pr e
+    prn 0 (ECase e alts)        = text "case" <+> pr e <+> text "of" $$ 
+                                       nest 2 (vpr alts)
+    prn 0 (EAct e e')           = text "action@" <> prn 2 e $$
+                                       nest 4 (pr e')
+    prn 0 (EReq e e')           = text "request@" <> prn 2 e $$
+                                       nest 4 (pr e')
+    prn 0 (ETempl x t te c)     = text "class@" <> prId x $$
+                                       nest 4 (vpr te) $$
+                                       nest 4 (pr c)
+    prn 0 (EDo x t c)           = text "do@" <> prId x <> text "::" <> pr t $$
+                                       nest 4 (pr c)
+    prn 0 e                     = prn 1 e
+
+    prn 1 (EAp e@(ELet bs _) es)
+      | isEncoding bs           = prn 0 e <+> sep (map (prn 2) es)
+    prn 1 (EAp e es)            = prn 1 e <+> sep (map (prn 2) es)
+
+    prn 1 e                     = prn 2 e
+        
+    prn 2 (ECon c)              = prId c
+    prn 2 (ESel e s)            = prn 2 e <> text "." <> prId s
+    prn 2 (EVar v)              = prId v
+    prn 2 (ELit l)              = pr l
+    prn 2 (ERec c eqs)          = prId c <+> text "{" <+> hpr ',' eqs <+> text "}"
+    prn 2 e                     = parens (prn 0 e)
+
+instance Pr Alt where
+    pr (p, e)                   = pr p <+> text "->" $$ nest 4 (pr e)
+
+instance Pr Cmd where
+    pr (CLet bs c)              = pr bs $$
+                                  pr c
+    pr (CAss x e c)             = prId x <+> text ":=" <+> pr e $$
+                                  pr c
+    pr (CGen x t e c)           = prId x <+> {- text "::" <+> pr t <+> -} text "<-" <+> pr e $$
+                                  pr c
+    pr (CRet e)                 = text "result" <+> pr e
+    pr (CExp e)                 = pr e
+
+
+
+-- HasPos --------------------------------------------------
+
+instance HasPos Types where
+  posInfo (Types ke ds)         = between (posInfo ke) (posInfo ds)
+
+instance HasPos Binds where
+  posInfo (Binds _ te es)       = posInfo es
+
+instance HasPos Decl where
+  posInfo (DData ns ts ce)      = foldr1 between [posInfo ns, posInfo ts, posInfo ce]
+  posInfo (DRec _ ns ts te)     = foldr1 between [posInfo ns, posInfo ts, posInfo te]
+  posInfo (DType ns t)          = between (posInfo ns) (posInfo t)
+
+instance HasPos Scheme where
+  posInfo (Scheme r ps ke)      = foldr1 between [posInfo r, posInfo ps, posInfo ke]
+
+instance HasPos Constr where
+  posInfo (Constr ts ps ke)     = foldr1 between [posInfo ts, posInfo ps, posInfo ke]
+
+instance HasPos Rho where
+  posInfo (R t)                 = posInfo t
+  posInfo (F ts r)              = between (posInfo ts) (posInfo r)
+
+instance HasPos Type where
+  posInfo (TId n)               = posInfo n
+  posInfo (TVar _)              = Unknown
+  posInfo (TFun ts t)           = posInfo (t : ts)
+  posInfo (TAp t t')            = between (posInfo t) (posInfo t')
+
+instance HasPos Pat where
+  posInfo (PCon n)              = posInfo n
+  posInfo (PLit l)              = posInfo l
+  posInfo (PWild)               = Unknown
+
+instance HasPos Exp where
+  posInfo (ECon n)              = posInfo n
+  posInfo (ESel e l)            = between (posInfo e) (posInfo l)
+  posInfo (EVar n)              = posInfo n
+  posInfo (ELam te e)           = between (posInfo (dom te)) (posInfo e)
+  posInfo (EAp e es)            = foldr1 between (map posInfo (e : es))
+  posInfo (ELet bs e)           = between (posInfo bs) (posInfo e)
+  posInfo (ECase e as)          = foldr1 between [posInfo e, posInfo as]
+  posInfo (ERec n es)           = between (posInfo n) (posInfo es)
+  posInfo (ELit l)              = posInfo l
+  posInfo (EAct e e')           = between (posInfo e) (posInfo e')
+  posInfo (EReq e e')           = between (posInfo e) (posInfo e')
+  posInfo (ETempl n t te c)     = foldr1 between [posInfo n, posInfo te, posInfo c]
+  posInfo (EDo n t c)           = foldr1 between [posInfo n, posInfo c]
+
+instance HasPos Cmd where
+  posInfo (CGen n t e c)        = foldr1 between [posInfo n, posInfo e, posInfo c]
+  posInfo (CAss n e c)          = foldr1 between [posInfo n, posInfo e, posInfo c]
+  posInfo (CLet bs c)           = between (posInfo bs) (posInfo c)
+  posInfo (CRet e)              = posInfo e
+  posInfo (CExp e)              = posInfo e
+
+  
+-- Binary --------------------------------------------------
+
+instance Binary Module where
+  put (Module a b c d e f) = put a >> put b >> put c >> put d >> put e >> put f
+  get = get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> get >>= \e -> get>>= \f -> return (Module a b c d e f)
+
+instance Binary Types where
+  put (Types a b) = put a >> put b
+  get = get >>= \a -> get >>= \b -> return (Types a b)
+
+instance Binary Binds where
+  put (Binds a b c) = put a >> put b >> put c
+  get = get >>= \a -> get >>= \b -> get >>= \c -> return (Binds a b c)
+
+instance Binary Decl where
+  put (DData a b c) = putWord8 0 >> put a >> put b >> put c
+  put (DRec a b c d) = putWord8 1 >> put a >> put b >> put c >> put d
+  put (DType a b) = putWord8 2 >> put a >> put b
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> get >>= \b -> get >>= \c -> return (DData a b c)
+      1 -> get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> return (DRec a b c d)
+      2 -> get >>= \a -> get >>= \b -> return (DType a b)
+      _ -> fail "no parse"
+
+instance Binary Scheme where
+  put (Scheme a b c) = put a >> put b >> put c
+  get = get >>= \a -> get >>= \b -> get >>= \c -> return (Scheme a b c)
+
+instance Binary Constr where
+  put (Constr a b c) = put a >> put b >> put c
+  get = get >>= \a -> get >>= \b -> get >>= \c -> return (Constr a b c)
+
+instance Binary Rho where
+  put (R a) = putWord8 0 >> put a
+  put (F a b) = putWord8 1 >> put a >> put b
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> return (R a)
+      1 -> get >>= \a -> get >>= \b -> return (F a b)
+      _ -> fail "no parse"
+
+instance Binary Type where
+  put (TId a) = putWord8 0 >> put a
+  put (TVar a) = putWord8 1 >> put a
+  put (TFun a b) = putWord8 2 >> put a >> put b
+  put (TAp a b) = putWord8 3 >> put a >> put b
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> return (TId a)
+      1 -> get >>= \a -> return (TVar a)
+      2 -> get >>= \a -> get >>= \b -> return (TFun a b)
+      3 -> get >>= \a -> get >>= \b -> return (TAp a b)
+      _ -> fail "no parse"
+
+instance Binary Pat where
+  put (PCon a) = putWord8 0 >> put a
+  put (PLit a) = putWord8 1 >> put a
+  put (PWild)  = putWord8 2
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> return (PCon a)
+      1 -> get >>= \a -> return (PLit a)
+      2 -> return PWild
+      _ -> fail "no parse"
+
+instance Binary Exp where
+  put (ECon a) = putWord8 0 >> put a
+  put (ESel a b) = putWord8 1 >> put a >> put b
+  put (EVar a) = putWord8 2 >> put a
+  put (ELam a b) = putWord8 3 >> put a >> put b
+  put (EAp a b) = putWord8 4 >> put a >> put b
+  put (ELet a b) = putWord8 5 >> put a >> put b
+  put (ECase a b) = putWord8 6 >> put a >> put b
+  put (ERec a b) = putWord8 7 >> put a >> put b
+  put (ELit a) = putWord8 8 >> put a
+  put (EAct a b) = putWord8 9 >> put a >> put b
+  put (EReq a b) = putWord8 10 >> put a >> put b
+  put (ETempl a b c d) = putWord8 11 >> put a >> put b >> put c >> put d
+  put (EDo a b c) = putWord8 12 >> put a >> put b >> put c
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> return (ECon a)
+      1 -> get >>= \a -> get >>= \b -> return (ESel a b)
+      2 -> get >>= \a -> return (EVar a)
+      3 -> get >>= \a -> get >>= \b -> return (ELam a b)
+      4 -> get >>= \a -> get >>= \b -> return (EAp a b)
+      5 -> get >>= \a -> get >>= \b -> return (ELet a b)
+      6 -> get >>= \a -> get >>= \b -> return (ECase a b)
+      7 -> get >>= \a -> get >>= \b -> return (ERec a b)
+      8 -> get >>= \a -> return (ELit a)
+      9 -> get >>= \a -> get >>= \b -> return (EAct a b)
+      10 -> get >>= \a -> get >>= \b -> return (EReq a b)
+      11 -> get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> return (ETempl a b c d)
+      12 -> get >>= \a -> get >>= \b -> get >>= \c -> return (EDo a b c)
+      _ -> fail "no parse"
+
+instance Binary Cmd where
+  put (CGen a b c d) = putWord8 0 >> put a >> put b >> put c >> put d
+  put (CAss a b c) = putWord8 1 >> put a >> put b >> put c
+  put (CLet a b) = putWord8 2 >> put a >> put b
+  put (CRet a) = putWord8 3 >> put a
+  put (CExp a) = putWord8 4 >> put a
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> return (CGen a b c d)
+      1 -> get >>= \a -> get >>= \b -> get >>= \c -> return (CAss a b c)
+      2 -> get >>= \a -> get >>= \b -> return (CLet a b)
+      3 -> get >>= \a -> return (CRet a)
+      4 -> get >>= \a -> return (CExp a)
+      _ -> fail "no parse"
diff --git a/src/Core2Kindle.hs b/src/Core2Kindle.hs
new file mode 100644
--- /dev/null
+++ b/src/Core2Kindle.hs
@@ -0,0 +1,887 @@
+{-# LANGUAGE FlexibleInstances, PatternGuards #-}
+
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Core2Kindle(core2kindle, c2kTEnv) where
+{- -}
+import Monad
+import Common
+import Core
+import Name
+import PP
+import qualified Decls
+import qualified Env
+import qualified Kindle
+
+
+-- =========================================================================================
+-- Translation of Core modules into back-end Kindle format
+-- =========================================================================================
+
+core2kindle e2 e3 m                 = localStore (cModule e2 e3 m)
+
+
+-- =========================================================================================
+-- The FType format
+-- =========================================================================================
+    
+-- This datatype is used to distinguish the types of known functions that can be called directly,
+-- from those that are anonymous and thus must be translated as closures.  Furthermore, the type
+-- arguments of FType constructors are supposed to be on a semi-Kindle form, where several primitive
+-- type constructors have been replaced by their corresponding Kindle implementations.  These types
+-- are still expressed using Core.Type syntax during the translation process, though, to facilitate
+-- tracking of instantiation of type variables by means of unification.
+
+data Result a                       = ValR a
+                                    | FunR ([Kindle.Exp] -> a) [Kindle.AType]
+
+instance Show a => Show (Result a) where
+    show (ValR a)                   = "ValR (" ++ show a ++ ")"
+    show (FunR f ts)                = "FunR _ " ++ show ts
+
+rcomp f (ValR c)                    = ValR (f c)
+rcomp f (FunR g ts)                 = FunR (f . g) ts
+
+
+-- =========================================================================================
+-- Translation environment
+-- =========================================================================================
+
+data Env                            = Env { mname   :: Maybe String,
+                                            decls   :: Kindle.Decls,
+                                            tenv    :: Kindle.TEnv,
+                                            selfN   :: Maybe Name,
+                                            tArgs   :: [Kindle.AType] }
+
+
+env0                                = Env { mname   = Nothing,
+                                            decls   = [],
+                                            tenv    = [],
+                                            selfN   = Nothing,
+                                            tArgs   = [] }
+
+setMName m env                      = env { mname = Just (str m) }
+
+addDecls ds env                     = env { decls = ds ++ decls env }
+
+addTEnv te env                      = env { tenv = te ++ tenv env }
+
+addATEnv te env                     = env { tenv = mapSnd Kindle.ValT te ++ tenv env }
+
+pushSelf x env                      = env { selfN = Just x }
+
+self env                            = fromJust (selfN env)
+
+setTArgs env ts                     = env { tArgs = ts }
+
+findDecl env k
+  | isTuple k                       = Kindle.tupleDecl k
+  | otherwise                       = lookup' (decls env) k
+  
+
+-- Look up a closure type (a Kindle.Struct) in the current store, extending the store if necessary
+findClosureType env [] ts t         = do ds <- currentStore
+                                         -- tr ("Looking for (1) " ++ render (pr (name0 "closure", Kindle.FunT [] ts t)))
+                                         case Kindle.findStruct s0 ds of
+                                            Just n  -> return (Kindle.TCon n (t:ts))
+                                            Nothing -> do
+                                               n <- newNameMod (mname env) (closureSym ++ show a)
+                                               addToStore (n, s0)
+                                               return (Kindle.TCon n (t:ts))
+  where s0                          = Kindle.Struct vs0 [(prim Code, Kindle.FunT [] (tail ts0) (head ts0))] Kindle.Top
+        vs0                         = take (a + 1) abcSupply
+        ts0                         = map Kindle.tVar vs0
+        a                           = length ts
+findClosureType env vs ts t         = do ds <- currentStore
+                                         -- tr ("Looking for (2) " ++ render (pr (name0 "closure", Kindle.FunT vs ts t)))
+                                         case Kindle.findStruct s0 ds of
+                                            Just n  -> return (Kindle.TCon n ts0)
+                                            Nothing -> do
+                                               n <- newNameMod (mname env) closureSym
+                                               addToStore (n, s0)
+                                               return (Kindle.TCon n ts0)
+  where s0                          = Kindle.Struct vs0 [(prim Code, Kindle.FunT vs ts t)] Kindle.Top
+        vs0                         = nub (Kindle.typevars (t:ts) \\ vs)
+        ts0                         = map Kindle.tVar vs0
+
+
+openClosureType (Kindle.TCon n ts)
+  | isClosure n                     = do ds <- currentStore
+                                         let Kindle.Struct vs te _ = lookup' ds n
+                                             Kindle.FunT [] ts' t' = lookup' te (prim Code)
+                                             s = vs `zip` ts
+                                         return (subst s ts', subst s t')
+openClosureType t                   = internalError "Core2Kindle.openClosureType" t
+
+
+splitClosureType env 0 t0           = return ([], t0)
+splitClosureType env n t0           = do (ts,t) <- openClosureType t0
+                                         let n' = n - length ts
+                                         if n' >= 0 then do
+                                             (tss,t1) <- splitClosureType env n' t
+                                             return (ts:tss, t1)
+                                          else 
+                                             return ([], t0)
+                                             
+                                         
+-- =========================================================================================
+-- Translation entry point
+-- =========================================================================================
+
+-- Translate a Core.Module into a Kindle.Module
+cModule e2 e3 (Module m ns xs ds ws bss)
+                                    = do mapM_ addToStore (filter (isClosure . fst) e3)
+                                         te0 <- tenvImp env e2
+                                         ds1  <- cDecls env ds
+                                         bs  <- cBindsList (addTEnv te0 (addDecls ds1 env)) bss
+                                         ds2 <- currentStore
+                                         let (dsQ,dsNQ) = partition (isQualified . fst) (reverse ds2)
+                                             dsThis = ds1 ++ filter (isQual m . fst) dsQ
+                                             ds3 = dsThis ++ dsNQ
+                                         --let fromCurrent n = not (isQualified n)|| isQual m n
+                                         --    ds3 = ds1++reverse (filter (fromCurrent . fst) ds2)
+                                         return (Kindle.Module m (map snd ns) ds3 bs,dsThis)
+  where env                         = addDecls e3 (setMName m (addTEnv Kindle.primTEnv (addDecls Kindle.primDecls env0)))
+
+-- Compute the imported type environment
+tenvImp env (_,ds,ws,bs)            = cTEnv env (tsigsOf bs)
+
+
+-- =========================================================================================
+-- Translating Core type declarations into Kindle.Decls
+-- =========================================================================================
+
+cDecls env (Types ke ds)            = do dss <- mapM cDecl ds
+                                         return (concat dss)
+  where cDecl (n,DRec _ vs [] ss)   = do te <- cTEnv env ss
+                                         return [(n, Kindle.Struct vs te Kindle.Top)]
+        cDecl (n,DType vs t)        = return []
+        cDecl (n,DData vs [] cs)    = do ds <- mapM (cCon n vs) cs
+                                         return ((n, Kindle.Struct vs [] Kindle.Union) : ds)
+
+        cCon n vs (c,Constr ts ps ke) 
+                                    = do te' <- cValTEnv env te
+                                         return (injectCon c, Kindle.Struct (vs++dom ke) te' (Kindle.Extends n))
+          where te                  = abcSupply `zip` (ps++ts)
+
+
+injectCon (Name s t m a)            = Name ('_':s) t m a
+injectCon n                         = n
+
+
+-- =========================================================================================
+-- Translating schemes and types into Kindle form
+-- =========================================================================================
+
+-- Translate a Core.Scheme into an Kindle.Type on basis of arity and polymorphism
+cScheme env (Scheme rh ps ke)           = do ts0 <- mapM (cAScheme env) ps
+                                             (ts,t) <- cRho env rh
+                                             case (dom ke, ts0++ts) of          -- concatenate witness params with ts
+                                               ([],[]) -> return (Kindle.ValT t)
+                                               (vs,ts) -> return (Kindle.FunT vs ts t)
+        
+
+-- Translate a Core.Rho type
+cRho env (F scs rh)                     = do ts <- mapM (cAScheme env) scs
+                                             (ts',t) <- cRho' env rh
+                                             return (ts++ts', t)                -- concatenate ts with monadic params
+cRho env (R t)                          = cType env t
+
+
+-- Translate a Core.Rho type but treat function types as closures
+cRho' env (R t)                         = cType' env (tFlat t)
+cRho' env rh                            = do t <- cAScheme env (Scheme rh [] [])
+                                             return ([],t)
+
+
+-- Translate a Core.Type
+cType env (TFun ts t)                   = do ts <- mapM (cAType env) ts
+                                             (ts',t) <- cType' env (tFlat t)
+                                             return (ts++ts', t)                -- concatenate ts with monadic params
+cType env t                             = cType' env (tFlat t)
+
+
+-- Translate a Core.Type but treat function types as closures
+cType' env (TId (Prim Action _), [])    = return ([t,t], Kindle.tId Msg)
+  where t                               = Kindle.tId Time
+cType' env (TId (Prim Request _), [t])  = do t <- cAType env t
+                                             return ([Kindle.tInt], t)
+cType' env (TId (Prim Class _), [t])    = do t <- cAType env t
+                                             return ([Kindle.tInt], t)
+cType' env (TId (Prim Cmd _), [s,t])    = do s <- cAType env s
+                                             t <- cAType env t
+                                             return ([Kindle.tRef s], t)
+cType' env (TId (Prim PMC _), [t])      = do t <- cAType env t
+                                             return ([], t)
+cType' env (TId n, ts)                  = do ts <- mapM (cAType env) ts
+                                             if isVar n then
+                                                 return ([], Kindle.TVar n ts)
+                                              else
+                                                 return ([], Kindle.TCon n ts)
+cType' env (TVar _, [])                 = return ([], Kindle.tInt)
+cType' env (TVar _, ts)                 = do ts <- mapM (cAType env) ts
+                                             return ([], Kindle.TCon (tuple (length ts)) ts)
+cType' env (t, _)                       = do t <- cAType env t
+                                             return ([], t)
+
+
+-- Translate a Core.Type unconditionally into a Kindle.AType
+cAType env t                            = do (ts, t) <- cType env t
+                                             case ts of
+                                                [] -> return t
+                                                _  -> findClosureType env [] ts t
+
+
+-- Translate a Core.Scheme unconditionally into a Kindle.AType
+cAScheme env sc                         = do t0 <- cScheme env sc
+                                             case t0 of
+                                               Kindle.ValT t -> return t
+                                               Kindle.FunT vs ts t -> findClosureType env vs ts t
+
+
+-- Translate a Core.Scheme unconditionally into a ValT variant of a Kindle.Type
+cValScheme env sc                       = do t <- cAScheme env sc
+                                             return (Kindle.ValT t)
+
+
+-- Translate a Core.TEnv into an Kindle.TEnv
+cTEnv env te                            = do ts <- mapM (cScheme env) scs
+                                             return (xs `zip` ts)
+  where (xs,scs)                        = unzip te
+       
+
+-- Translate a Core.TEnv into an Kindle.ATEnv
+cATEnv env te                           = do ts <- mapM (cAScheme env) scs
+                                             return (xs `zip` ts)
+  where (xs,scs)                        = unzip te
+  
+    
+-- Translate a Core.TEnv into an Kindle.TEnv with only ValT types
+cValTEnv env te                         = do ts <- mapM (cValScheme env) scs
+                                             return (xs `zip` ts)
+  where (xs,scs)                        = unzip te
+
+
+-- =========================================================================================
+-- Translating bindings
+-- =========================================================================================
+
+-- Translate a list of strongly connected Core binding groups into a list of Kindle bindings
+cBindsList env []                       = return []
+cBindsList env (bs:bss)                 = do (te,bf) <- cBinds env bs
+                                             bs <- cBindsList (addTEnv te env) bss
+                                             return (flatBinds bf ++ bs)
+
+
+flatBinds bf                            = flat (bf Kindle.CBreak)
+  where flat (Kindle.CBind r bs c)      = bs ++ flat c
+        flat _                          = []
+
+
+-- Translate a list of (mutually recursive) Core bindings into a Kindle.CBind on basis of declared type
+cBinds env (Binds rec te eqs)           = do te1 <- cValTEnv env te1
+                                             te2 <- cTEnv env te2
+                                             let te' = te1 ++ te2
+                                             assert (not rec || all Kindle.okRec (rng te')) "Illegal value recursion" (dom te')
+                                             (bf,bs) <- cEqs (addTEnv te' env) te' eqs
+                                             return (te', comb rec bf bs)
+  where comb False bf bs                = bf . Kindle.CBind False bs
+        comb True bf bs                 = Kindle.CBind True (flatBinds bf ++ bs)
+        insts                           = dom (filter (isNewAp . snd) eqs)
+        (te1,te2)                       = partition ((`elem` insts) . fst) te
+
+
+-- Translate a list of Core equations into a list of Kindle bindings on basis of declared type
+cEqs env te eqs                         = do (bfs,bs) <- fmap unzip (mapM (cEq env te) eqs)
+                                             return (foldr (.) id bfs, bs)
+
+cEq env te (x,e)                        = case lookup' te x of
+                                            Kindle.ValT t0 -> do
+                                                (bf,e) <- cValExpT env t0 e
+                                                return (bf, (x, Kindle.Val t0 e))
+                                            Kindle.FunT _ ts0 t0 -> do
+                                                (vs,te,t,c) <- cFunN env (length ts0) e
+                                                return (id, (x, Kindle.Fun vs t te c))
+
+
+-- Translate a Core.Exp with a known type into a Kindle.Exp
+cValExpT env t e                        = do (bf,t',e') <- cValExp env e
+                                             e'' <- adaptClos env [] t [] t' e'
+                                             return (bf, e'')
+                                                 
+
+adaptClos env [] t0 [] t1 e
+  | t0 == t1                            = return e                                                                  -- A
+adaptClos env xs t0 [] t1 e             = do (ts,t1) <- openClosureType t1
+                                             adaptClos env xs t0 ts t1 e                                            -- B
+adaptClos env xs t0 ts t1 e
+  | length xs >= length ts              = adaptClos env xs2 t0 [] t1 (Kindle.enter e [] (map Kindle.EVar xs1))      -- C
+  | otherwise                           = do (ts',t') <- openClosureType t0
+                                             te <- newEnv paramSym ts'
+                                             e' <- adaptClos env (xs ++ dom te) t' ts t1 e
+                                             return (Kindle.closure t0 t' te (Kindle.CRet e'))                      -- D
+  where (xs1,xs2)                       = splitAt (length ts) xs
+        (ts1,ts2)                       = splitAt (length xs) ts
+
+
+-- []         (s1 s2 s3 -> s4 -> s5 -> s0)   []         (t1 t2 -> t3 t4 t5 -> t0)      e                             =                          B
+-- []         (s1 s2 s3 -> s4 -> s5 -> s0)   t1 t2      (t3 t4 t5 -> t0)               e                             C (s1 x1, s2 x2, s3 x3) =  D
+-- x1 x2 x3   (s4 -> s5 -> s0)               t1 t2      (t3 t4 t5 -> t0)               e                             =                          C
+-- x3         (s4 -> s5 -> s0)               []         (t3 t4 t5 -> t0)               e->C(x1,x2)                   =                          B
+-- x3         (s4 -> s5 -> s0)               t3 t4 t5   t0                             e->C(x1,x2)                   C (s4 x4) =                D
+-- x3 x4      (s5 -> s0)                     t3 t4 t5   t0                             e->C(x1,x2)                   C (s5 x5) =                D
+-- x3 x4 x5   s0                             t3 t4 t5   t0                             e->C(x1,x2)->C(x3,x4,x5)      =                          C
+-- []         s0                             []         t0                             e->C(x1,x2)->C(x3,x4,x5)      =                          A
+
+-- new Code (s1 x1, s2 x2, s3 x3) { ret new Code (s4 x4) { ret new Code (s5 x5) { ret e->Code(x1,x2)->Code(x3,x4,x5) }}}
+
+
+-- []         (s1 s2 -> s3 s4 s5 -> s0)      []         (t1 t2 t3 -> t4 -> t5 -> t0)   e                             =                          B
+-- []         (s1 s2 -> s3 s4 s5 -> s0)      t1 t2 t3   (t4 -> t5 -> t0)               e                             C (s1 x1, s2 x2) =         D
+-- x1 x2      (s3 s4 s5 -> s0)               t1 t2 t3   (t4 -> t5 -> t0)               e                             C (s3 x3, s4 x4, s5 x5) =  D
+-- x1 .. x5   s0                             t1 t2 t3   (t4 -> t5 -> t0)               e                             =                          C
+-- x4 x5      s0                             []         (t4 -> t5 -> t0)               e->C(x1,x2,x3)                =                          B
+-- x4 x5      s0                             t4         (t5 -> t0)                     e->C(x1,x2,x3)                =                          C
+-- x5         s0                             []         (t5 -> t0)                     e->C(x1,x2,x3)->C(x4)         =                          B
+-- x5         s0                             t5         t0                             e->C(x1,x2,x3)->C(x4)         =                          C
+-- []         s0                             []         t0                             e->C(x1,x2,x3)->C(x4)->C(x5)  =                          A
+
+-- s1 s2 -> s3 s4 s5 -> s0   || t1 t2 t3 -> t4 -> t5 -> t0
+-- new Code (s1 x1, s2 x2) { ret new Code (s3 x3, s4 x4 s5 x5) { ret e->Code(x1, x2, x3)->Code(x4)->Code(x5) }}
+
+
+
+                                             
+cValExpTs env [] []                     = return (id, [])
+cValExpTs env (t:ts) (e:es)             = do (bf,e) <- cValExpT env t e
+                                             (bf',es) <- cValExpTs env ts es
+                                             return (bf . bf', e:es)
+
+
+-- Translate a Core.Exp into a Kindle command, a return type, a type abstraction, and an argument list of given length
+cFunN env n e                           = do (vs,te,t,c) <- cFun0 env e
+                                             (te,t,c) <- adapt te t c
+                                             return (vs, te, t, c)
+  where adapt te t c
+          | n == l_te                   = return (te, t, c)
+          | n >  l_te                   = do (tss,t') <- splitClosureType env (n - l_te) t
+                                             te' <- newEnv paramSym (concat tss)
+                                             return (te++te', t', Kindle.cmap (Kindle.multiEnter tss (map Kindle.EVar (dom te'))) c)
+          | n <  l_te                   = do t1 <- findClosureType env [] (rng te2) t
+                                             return (te1, t1, Kindle.CRet (Kindle.closure t1 t te2 c))
+          where l_te                    = length te
+                (te1,te2)               = splitAt n te
+
+
+-- =========================================================================================
+-- Translating abstractions
+-- =========================================================================================
+
+-- Convert a Core.Exp into a type abstraction, a parameter list and a Kindle.Cmd
+cFun0 env (ELet bs e)
+  | isTAbsEncoding bs                   = do (te,t,c) <- cFun env e
+                                             return (tAbsVars bs, te, t, c)
+cFun0 env e                             = do (te,t,c) <- cFun env e
+                                             return ([], te, t, c)
+                                             
+
+-- Convert a Core.Exp into a parameter list and a Kindle.Cmd
+cFun env (ELam te e)                    = do te <- cATEnv env te
+                                             (te',t,c) <- cFun (addATEnv te env) e
+                                             return (te ++ te', t, c)
+cFun env (EReq e (EDo x tx c))          = do tx <- fmap Kindle.tRef (cAType env tx)
+                                             (bf,e) <- cValExpT env tx e
+                                             (t,c) <- cCmd (pushSelf x (addATEnv [(x,tx)] env)) c
+                                             let bf' = Kindle.cBind [(x,Kindle.Val tx (Kindle.lock tx e))]
+                                             y <- newName dummySym
+                                             return ([(y,Kindle.tInt)], t, bf (bf' (Kindle.unlock x c)))
+cFun env (EReq e e')                    = do (bf,tx,e) <- cValExp env e
+                                             x <- newName selfSym
+                                             (t,c) <- cCmdExp (pushSelf x (addATEnv [(x,tx)] env)) e'
+                                             y <- newName dummySym
+                                             let bf' = Kindle.cBind [(x,Kindle.Val tx (Kindle.lock tx e))]
+                                             return  ([(y,Kindle.tInt)], t, bf (bf' (Kindle.unlock x c)))
+cFun env e@(EAct _ _)                   = cAct env id id e
+cFun env e@(EAp e0 _) 
+  | isPrim After e0 || isPrim Before e0 = cAct env id id e
+cFun env (ETempl x tx te c)             = do tx@(Kindle.TCon n []) <- cAType env tx  -- Type-checker guarantees tx is a struct type name
+                                             te <- cValTEnv env te
+                                             (t,c) <- cCmd (pushSelf x (addATEnv [(x,Kindle.tRef tx)] (addTEnv te env))) c
+                                             addToStore (n, Kindle.Struct vs te Kindle.Top)
+                                             y <- newName dummySym
+                                             let e = Kindle.ENew (prim Ref) [tx] [(prim STATE, Kindle.Val tx (Kindle.ENew n ts []))]
+                                             return ([(y,Kindle.tInt)], t, Kindle.cBind [(x,Kindle.Val (Kindle.tRef tx) e)] c)
+  where vs                              = nub (tyvars te)
+        ts                              = map Kindle.tVar vs
+cFun env (EDo x tx c)                   = do tx <- fmap Kindle.tRef (cAType env tx)
+                                             (t,c) <- cCmd (pushSelf x (addATEnv [(x,tx)] env)) c
+                                             return ([(x,tx)], t, c)
+cFun env e                              = do (t,r) <- cBody env e
+                                             case r of
+                                               FunR f ts -> do xs <- newNames paramSym (length ts)
+                                                               return (xs `zip` ts, t, f (map Kindle.EVar xs))
+                                               ValR c    -> return ([], t, c)
+
+
+-- Translate an action expression into a Core.Cmd
+cAct env fa fb (EAp e0 [e,e'])
+  | isPrim After e0                     = do (bf,e1) <- cValExpT env Kindle.tTime e
+                                             (te,t,c) <- cAct env (sum e1 . fa) fb e'
+                                             return (te, t, bf c)
+  | isPrim Before e0                    = do (bf,e1) <- cValExpT env Kindle.tTime e
+                                             (te,t,c) <- cAct env fa (min e1 . fb) e'
+                                             return (te, t, bf c)
+  where sum (Kindle.EVar (Prim Inherit _)) a = a
+        sum e1 a                             = Kindle.ECall (prim TimePlus) [] [e1,a]
+        min (Kindle.EVar (Prim Inherit _)) a = a
+        min e1 b                             = Kindle.ECall (prim TimeMin) [] [e1,b]
+cAct env fa fb (EAct e e')              = do (_,_,c) <- cFun env (EReq e e')
+                                             -- Ignore returned te (must be unused) and result type (will be replaced below)
+                                             a  <- newName paramSym
+                                             b  <- newName paramSym
+                                             m  <- newName tempSym
+                                             let c1  = Kindle.cBind bs (Kindle.CRun e1 (Kindle.CRet (Kindle.EVar m)))
+                                                 c2  = Kindle.cmap (\_ -> Kindle.unit) c
+                                                 bs  = [(m, Kindle.Val Kindle.tMsg (Kindle.ENew (prim Msg) [] bs'))]
+                                                 bs' = [(prim Code, Kindle.Fun [] Kindle.tUNIT [] c2)]
+                                                 es  = [Kindle.EVar m, fa (Kindle.EVar a), fb (Kindle.EVar b)]
+                                                 e1  = Kindle.ECall (prim ASYNC) [] es
+                                             return ([(a,Kindle.tTime),(b,Kindle.tTime)], Kindle.tMsg, c1)
+cAct env fa fb e                        = do (bf,t0,f,[ta,tb]) <- cFunExp env e
+                                             a  <- newName paramSym
+                                             b  <- newName paramSym
+                                             let c = bf (Kindle.CRet (f [fa (Kindle.EVar a), fb (Kindle.EVar b)]))
+                                             return ([(a,Kindle.tTime), (b,Kindle.tTime)], Kindle.tMsg, c)
+
+
+-- =========================================================================================
+-- Translating let- and case expressions
+-- =========================================================================================
+
+-- Translate a Core (Pat,Exp) pair into a Kindle.Alt result
+cAlt cBdy env (PLit l, e)               = do (t1,r) <- cBdy env e
+                                             return (t1, rcomp (Kindle.ALit l) r)
+cAlt cBdy env (PWild, e)                = do (t1,r) <- cBdy env e
+                                             return (t1, rcomp Kindle.AWild r)
+cAlt cBdy env (PCon k, e)               = do (vs,te,t,r) <- cRhs0 cBdy env (length te0) e
+                                             return (t, rcomp (Kindle.ACon (injectCon k) vs te) r)
+  where Kindle.Struct vs0 te0 _         = findDecl env k
+
+
+-- Translate a Core right-hand-side into a Kindle.Cmd result, a binding, and a type abstraction
+cRhs0 cBdy env n (ELet bs e)
+  | isTAbsEncoding bs                   = do (te,t,r) <- cRhs cBdy env n [] e
+                                             return (tAbsVars bs, te, t, r)
+cRhs0 cBdy env n e                      = do (te,t,r) <- cRhs cBdy env n [] e
+                                             return ([], te, t, r)
+                                             
+
+-- Translate a Core right-hand-side into a Kindle.Cmd result and a binding
+cRhs cBdy env n te (ELam te' e)         = do te' <- cATEnv env te'
+                                             cRhs cBdy (addATEnv te' env) n (te++te') e
+cRhs cBdy env n te e
+  | n == l_te                           = do (t,r) <- cBdy env e
+                                             return (te, t, r)
+  | n < l_te                            = do (t,r) <- cBdy env e
+                                             t' <- findClosureType env [] (rng te2) t
+                                             return (te1, t', rcomp (Kindle.CRet . Kindle.closure t' t te2) r)
+  | n > l_te                            = do (t,r) <- cBdy env e
+                                             (tss,t') <- splitClosureType env (n - l_te) t
+                                             te' <- newEnv paramSym (concat tss)
+                                             let f = Kindle.multiEnter tss (map Kindle.EVar (dom te'))
+                                             return (te++te', t', rcomp (Kindle.cmap f) r)
+  where l_te                            = length te
+        (te1,te2)                       = splitAt n te
+
+
+-- Translate a Core.Exp into a Kindle.Cmd result
+cBody env (ELet bs e)
+  | not (isEncoding bs)                 = do (te,bf) <- cBinds env bs
+                                             (t,r) <- cBody (addTEnv te env) e
+                                             return (t, rcomp bf r)
+cBody env (ECase e alts)                = cCase cBody env e alts
+cBody env (EAp e0 [e]) 
+  | isPrim Match e0                     = do (t,r) <- cPMC cBody env e
+                                             return (t, rcomp (\c -> Kindle.CSeq c (Kindle.CRaise (Kindle.ELit (lInt 1)))) r)
+cBody env e                             = do (bf,t,h) <- cExp env e
+                                             case h of
+                                               ValR e    -> return (t, ValR (bf (Kindle.CRet e)))
+                                               FunR f ts -> return (t, FunR (bf . Kindle.CRet . f) ts)
+
+
+-- Note: we don't really handle PMC terms as first class citizens, rather like constructors in a small grammar
+-- of pattern-matching expressions:
+-- e  ::=  ...  |  Match pm
+-- pm ::=  Commit e  |  Fail  |  Fatbar pm pm  |  case e of {p -> pm} pm  |  let bs in pm
+-- This syntax is followed when PMC terms are introduced in module Match, and is also respected by Termred.
+--
+-- However, should we for some reason want to allow abstraction over PMC terms, as in (\e -> Commit e),
+-- the translation below will need to be complemented with a concrete implementation of the PMC type constructor
+-- (using Maybe, for example), and corresponding general implementations of Match, Commit, Fail & Fatbar.
+
+
+-- Translate a Core.Exp corresponding to a PMC term into a Kindle.Cmd result
+cPMC cE env (ELet bs e)
+  | not (isEncoding bs)                 = do (te,bf) <- cBinds env bs
+                                             (t,r) <- cPMC cE (addTEnv te env) e
+                                             return (t, rcomp bf r)
+cPMC cE env (ECase e alts)              = cCase (cPMC cE) env e alts
+cPMC cE env (EAp e0 [e1,e2])
+  | isPrim Fatbar e0                    = do r1 <- cPMC cE env e1
+                                             r2 <- cPMC cE env e2
+                                             let n = maximum [rArity r1, rArity r2]
+                                             r1 <- adaptR env n r1
+                                             r2 <- adaptR env n r2
+                                             return (mkSeq r1 r2)
+cPMC cE env (EAp e0 [e])
+  | isPrim Commit e0                    = cE env e
+cPMC cE env e0
+  | isPrim Fail e0                      = do [t] <- cTArgs env e0
+                                             return (t, ValR Kindle.CBreak)
+cPMC cE env e                           = internalError "PMC syntax violated in Core2Kindle" e
+
+
+-- Translate the parts of a case expression into a Kindle.Cmd result
+cCase cE env e ((PCon k,e'):_)
+  | isTuple k                           = do (bf,_,e) <- cValExp env e
+                                             (te,t1,r) <- cRhs cE env (width k) [] e'
+                                             let (xs,ts) = unzip te
+                                                 bs = mkBinds xs ts (map (Kindle.ESel e) (take (width k) abcSupply))
+                                             return (t1, rcomp (bf . Kindle.cBind bs) r)
+cCase cE env e alts                     = do (bf,t0,e0) <- cValExp env e
+                                             rs <- mapM (cAlt cE env) alts
+                                             let n = maximum (map rArity rs)
+                                             rs <- mapM (adaptR env n) rs
+                                             return (mkSwitch bf rs e0)
+
+
+adaptR env 0 (t0, ValR c)               = return (t0, ValR c)
+adaptR env n (t0, FunR f ts)
+  | n == l_ts                           = return (t0, FunR f ts)
+  | n > l_ts                            = do (tss,t) <- splitClosureType env (n - l_ts) t0
+                                             return (t, FunR (g tss) (ts ++ concat tss))
+  where l_ts                            = length ts
+        g tss es                        = let (es1,es2) = splitAt l_ts es
+                                          in Kindle.cmap (Kindle.multiEnter tss es2) (f es1)
+adaptR env n (t0, ValR c)               = do (tss,t) <- splitClosureType env n t0
+                                             return (t, FunR (g tss) (concat tss))
+  where g tss es                        = Kindle.cmap (Kindle.multiEnter tss es) c
+
+
+rArity (t, ValR _)                      = 0
+rArity (t, FunR f ts)                   = length ts
+
+mkSwitch bf ((t,ValR c):rs) e0          = (t, ValR (bf (Kindle.CSwitch e0 alts)))
+  where alts                            = c : [ alt | (_,ValR alt) <- rs ]     
+mkSwitch bf ((t,FunR g ts):rs) e0       = (t, FunR (\es -> bf (Kindle.CSwitch e0 (map ($es) (g:gs)))) ts)
+  where gs                              = [ g | (_,FunR g _) <- rs ]
+
+mkSeq (t1,ValR c1) (t2,ValR c2)         = (t1, ValR (Kindle.CSeq c1 c2))
+mkSeq (t1,FunR g1 ts1) (t2,FunR g2 ts2) = (t1, FunR (\es -> Kindle.CSeq (g1 es) (g2 es)) ts1)
+
+
+-- =========================================================================================
+-- Translating commands
+-- =========================================================================================
+
+-- Translate a Core.Cmd into a Kindle.Cmd
+cCmd env (CRet e)                       = do (bf,te,e) <- freezeState env e
+                                             (bf',t,e) <- cValExp (addTEnv te env) e
+                                             if Kindle.simpleExp e then         -- No state references or non-termination in e
+                                                 return (t, bf (bf' (Kindle.CRet e)))   -- Can be ignored (see CGen alternative)
+                                              else do
+                                                 x <- newName tempSym
+                                                 let bf'' = Kindle.cBind [(x, Kindle.Val t e)]
+                                                 return (t, bf (bf' (bf'' (Kindle.CRet (Kindle.EVar x)))))
+cCmd env (CAss x e c)                   = do (bf,te,e) <- freezeState env e
+                                             (bf',e) <- cValExpT (addTEnv te env) tx e
+                                             (t,c) <- cCmd env c
+                                             return (t, bf (bf' (Kindle.CUpdS (stateRef env) x e c)))
+  where Kindle.ValT tx                  = lookup' (tenv env) x
+cCmd env (CLet bs c)                    = do (bf,te,bs) <- freezeState env bs
+                                             (te',bf') <- cBinds (addTEnv te env) bs
+                                             (t,c) <- cCmd (addTEnv te' env) c
+                                             return (t, bf (bf' c))
+cCmd env (CGen x tx (ECase e alts) c)
+  | isDummy x && null alts'             = cCmd env c
+  | isDummy x                           = do (_,ValR c1) <- cCase cValCmdExp env e alts'
+                                             (t,c2) <- cCmd env c
+                                             return (t, Kindle.CSeq (Kindle.cMap (\_ -> Kindle.CBreak) c1) c2)
+  where alts'                           = filter useful alts
+        useful (_,EDo _ _ (CRet (ECon (Prim UNITTERM _))))  = False
+        useful _                                            = True
+cCmd env (CGen x tx e c)                = do (bf,te,e) <- freezeState env e
+                                             tx <- cAType env tx
+                                             (bf',e) <- cValExpT (addTEnv te env) tx (EAp e [EVar (self env)])
+                                             (t,c) <- cCmd (addATEnv [(x,tx)] env) c
+                                             return (t, bf (bf' (Kindle.cBind [(x,Kindle.Val tx e)] c)))
+cCmd env (CExp e)                       = cCmdExp env e
+
+
+-- Translate a Core.Exp in the monadic execution path into a Kindle.Cmd
+cCmdExp env (ELet bs e)
+  | not (isEncoding bs)                 = do (bf,te,bs) <- freezeState env bs
+                                             (te',bf') <- cBinds (addTEnv te env) bs
+                                             (t,c) <- cCmdExp (addTEnv te' env) e
+                                             return (t, bf (bf' c))
+cCmdExp env (EAp e0 [e])  
+--  | isPrim ReqToCmd e0                  = ...
+  | isPrim Raise e0                     = do (bf,te,e) <- freezeState env e
+                                             (bf',t,e') <- cValExp (addTEnv te env) e
+                                             return (t, bf (bf' (Kindle.CRaise e')))
+  | isPrim Match e0                     = do (bf,te,e) <- freezeState env e
+                                             (t,ValR c) <- cPMC cValCmdExp (addTEnv te env) e
+                                             return (t, bf (Kindle.CSeq c (Kindle.CRaise (Kindle.ELit (lInt 1)))))
+cCmdExp env (EDo x tx c)                = do tx <- cAType env tx
+                                             (t,c) <- cCmd (pushSelf x (addATEnv [(x,Kindle.tRef tx)] env)) c
+                                             return (t, Kindle.cBind [(x,Kindle.Val (Kindle.tRef tx) (Kindle.EVar (self env)))] c)
+cCmdExp env (ECase e alts)              = do (bf,te,e) <- freezeState env e
+                                             (t,ValR c) <- cCase cValCmdExp (addTEnv te env) e alts
+                                             return (t, bf c)
+cCmdExp env e                           = do (bf,te,e) <- freezeState env e
+                                             (bf',t,e) <- cValExp (addTEnv te env) (EAp e [EVar (self env)])
+                                             x <- newName tempSym
+                                             let bf'' = Kindle.cBind [(x, Kindle.Val t e)]
+                                             return (t, bf (bf' (bf'' (Kindle.CRet (Kindle.EVar x)))))
+
+
+cValCmdExp env e                        = do (t,c) <- cCmdExp env e
+                                             return (t, ValR c)
+                                             
+
+-- State variables are normally translated into field selections from the current "self".  For example,
+--     x := 7; result (x + 1)
+-- gets translated into
+--     self->x := 7; result (self->x + 1)
+-- However, closure values, which may be invoked long after they are defined, must not be sensitive to state
+-- mutations.  This means that "self" dereferencing operations for any contained state variables must be done 
+-- when the closure is defined, not when it is invoked.  Here's a challenging example:
+--     x := 7; f = \y->x+y; x := 2; result (f 1);
+-- If we naively translate the x reference in f to self->x, we end up with the wrong behavior:
+--     self->x := 7; int f(int y) { return self->x + y }; self->x := 2; return f(1);    -- gives 3, not 8
+--
+-- A correct translation can instead be obtained if we make sure that no state variables are ever referenced 
+-- from within a lambda abstraction, as in the equivalent example
+--     x := 7; x' = x; f = \y->x'+y; x := 2; return (f 1);                      (for some fresh variable x')
+-- Achieving this is the job of function freezeState below.  It takes an expression e and returns a renaming 
+-- of e with the "fragile" free variables (i.e., state vars inside lambdas) replaced by fresh variables, 
+-- together with a type environment and Kindle bindings for the new variables.  For the example above, 
+-- input (\y->x+y) results in output (\y->x'+y) together with the Kindle binding (int x' = self->x).  When
+-- composed with the rest of the translation process, the full output becomes
+--     self->x := 7; int x' = self->x; int f(int y) { return x'+y }; self->x := 2; return f(1);
+-- This form is perfectly valid as input to the subsequent lambda-lifting pass, whose result will be
+--     int f(int x'', int y) { return x'' + y }
+--     self->x := 7; int x' = self->x; self->x := 2; return f(x',1);
+
+
+class Fragile a where
+    fragile :: a -> [Name]
+    
+instance Fragile Exp where
+    fragile (ELam _ e)                  = filter isState (idents e)
+    fragile (EAp e es)                  = concatMap fragile (e:es)
+    fragile (ESel e l)                  = fragile e
+    fragile (ERec c eqs)                = concatMap fragile (rng eqs)
+    fragile (ELet bs e)                 = fragile bs ++ fragile e
+    fragile (ECase e alts)              = fragile e ++ concatMap fragile alts
+    fragile _                           = []
+
+instance Fragile (Pat,Exp) where
+    fragile (_,ELam te e)               = fragile e
+    fragile (_,e)                       = fragile e
+    
+instance Fragile Binds where
+    fragile bs                          = concatMap fragile (rng (eqnsOf bs))
+
+
+freezeState env xx
+  | null vs                             = return (id, [], xx)
+  | otherwise                           = do vs' <- newNames paramSym (length vs)
+                                             return (Kindle.cBind (zipWith3 f vs' ts vs), vs' `zip` ts, subst (vs `zip` map EVar vs') xx)
+  where vs                              = nub (fragile xx)
+        ts                              = map (lookup' (tenv env)) vs
+        f v' (Kindle.ValT t) v          = (v', Kindle.Val t (Kindle.ESel (stateRef env) v))
+
+
+-- Return a Kindle expression identifying the current state struct
+stateRef env                            = Kindle.ESel (Kindle.EVar (self env)) (prim STATE)
+
+
+-- =========================================================================================
+-- Translating expressions
+-- =========================================================================================
+
+-- Translate a Core.Exp into an expression result that is either a value or a function,
+-- overflowing into a list of Kindle.Binds if necessary
+cExp env (ELet bs e)
+  | isTAppEncoding bs                   = do ts <- mapM (cAType env) (tAppTypes bs)
+                                             cExp (setTArgs env ts) e
+  | not (isTAbsEncoding bs)             = do (te,bf) <- cBinds env bs
+                                             (bf',t,h) <- cExp (addTEnv te env) e
+                                             return (bf . bf', t, h)
+cExp env (ELit l)                       = return (id, Kindle.litType l, ValR (Kindle.ELit l))
+cExp env (ERec c eqs)                   = do (bf,bs) <- cEqs (setTArgs env []) te' eqs
+                                             return (bf, Kindle.TCon c ts, ValR (Kindle.ENew c ts bs))
+  where ts                              = tArgs env
+        Kindle.Struct vs te _           = findDecl env c
+        te'                             = subst (vs `zip` ts) te
+cExp env (EAp e0 [e])
+  | isPrim ActToCmd e0                  = do (bf,t,e) <- cValExp env (EAp e [EVar (prim Inherit), EVar (prim Inherit)])
+                                             [t1] <- cTArgs env e0
+                                             return (bf, t, FunR (\_ -> e) [Kindle.tRef t1])
+  | isPrim ReqToCmd e0                  = do (bf,t,e) <- cValExp env (EAp e [ELit (lInt 0)])
+                                             [t1,t2] <- cTArgs env e0
+                                             return (bf, t, FunR (\_ -> e) [Kindle.tRef t2])
+  | Just t <- isCastPrim e0             = do (bf,_,e') <- cExp env e
+                                             return (bf, t, rcomp (Kindle.ECast t) e')
+  | isPrim RefToPID e0                  = do (bf,t,e) <- cExp env e
+                                             return (bf, Kindle.tPID, rcomp (Kindle.ECast Kindle.tPID) e)
+  | isPrim New e0                       = cExp env (EAp e [ELit (lInt 0)])       -- Can't occur but in CBind rhs, syntactic restriction
+cExp env (EAp e0 [e,e'])
+  | isPrim After e0                     = do (bf,e1) <- cValExpT env Kindle.tTime e
+                                             (bf',t,f,ts) <- cFunExp env e'
+                                             return (bf . bf', t, FunR (\[a,b] -> f [sum a e1, b]) ts)
+  | isPrim Before e0                    = do (bf,e1) <- cValExpT env Kindle.tTime e
+                                             (bf',t,f,ts) <- cFunExp env e'
+                                             return (bf . bf', t, FunR (\[a,b] -> f [a, min b e1]) ts)
+  where sum a e1                        = Kindle.ECall (prim TimePlus) [] [a,e1]
+        min b e1                        = Kindle.ECall (prim TimeMin) [] [b,e1]
+cExp env (EAp e es) 
+  | not (isPrim Match e)                = do (bf,t,f,ts) <- cFunExp env e
+                                             appFun env bf t f ts es
+  where appFun env bf t f ts es
+          | l_ts <  l_es                = do (bf',es1) <- cValExpTs env ts es1
+                                             (ts',t') <- openClosureType t 
+                                             appFun env (bf . bf') t' (Kindle.enter (f es1) []) ts' es2
+          | l_ts == l_es                = do (bf',es) <- cValExpTs env ts es
+                                             return (bf . bf', t, ValR (f es))
+          | l_ts >  l_es                = do (bf',es) <- cValExpTs env ts1 es
+                                             return (bf . bf', t, FunR (f . (es++)) ts2)
+          where l_ts                    = length ts
+                l_es                    = length es
+                (ts1,ts2)               = splitAt l_es ts
+                (es1,es2)               = splitAt l_ts es
+cExp env (EVar x)                       = case lookup' (tenv env) x of
+                                             Kindle.ValT t        -> return (id, t, ValR e)
+                                             Kindle.FunT vs ts' t 
+                                               | null ts'         -> return (id, subst s t, ValR (Kindle.ECall x ts []))
+                                               | otherwise        -> return (id, subst s t, FunR (Kindle.ECall x ts) (subst s ts'))
+                                               where s             = vs `zip` ts
+  where e                               = if stateVar (annot x) then Kindle.ESel (stateRef env) x else Kindle.EVar x
+        ts                              = tArgs env
+cExp env (ESel e l)                     = do (bf,e) <- cValExpT (setTArgs env []) (Kindle.TCon k ts0) e
+                                             case subst (vs0 `zip` ts0) rhstype of
+                                               Kindle.ValT t       -> return (bf, t, ValR (Kindle.ESel e l))
+                                               Kindle.FunT vs ts t -> return (bf, subst s t, FunR (Kindle.EEnter e l ts1) (subst s ts))
+                                                 where s            = vs `zip` ts1
+  where (k,vs0,rhstype)                 = Kindle.typeOfSel (decls env) l
+        (ts0,ts1)                       = splitAt (length vs0) (tArgs env)  -- tArgs lists *full* instantiation, not just local quantification
+cExp env (ECon k)                       = case te of
+                                             [] -> return (id, t0, ValR (newK []))
+                                             _  -> return (id, t0, FunR (newK . mkBinds abcSupply ts') ts')
+  where ts                              = tArgs env
+        Kindle.Struct vs te _           = findDecl env k
+        ts'                             = subst (vs `zip` ts) (map (Kindle.rngType . snd) te)
+        (k0,n)                          = Kindle.typeOfCon (decls env) k
+        t0                              = Kindle.TCon k0 (take n ts)
+        newK | isTuple k                = Kindle.ENew k ts
+             | otherwise                = Kindle.ECast t0 . Kindle.ENew (injectCon k) ts
+cExp env e                              = do (vs,te,t,c) <- cFun0 env e
+                                             case (vs,te) of
+                                               ([],[]) -> do
+                                                  x <- newName tempSym
+                                                  return (Kindle.cBind [(x, Kindle.Fun [] t [] c)], t, ValR (Kindle.ECall x [] []))
+                                               _  -> do 
+                                                  t' <- findClosureType env vs (rng te) t
+                                                  return (id, t', ValR (Kindle.closure2 t' vs t te c))
+
+
+-- Translate a Core.Exp into a Kindle value expression
+cValExp env e                           = do (bf,t,h) <- cExp env e
+                                             case h of
+                                               ValR e -> 
+                                                  return (bf, t, e)
+                                               FunR f ts -> do
+                                                  xs <- newNames paramSym (length ts)
+                                                  t' <- findClosureType env [] ts t
+                                                  let es = map Kindle.EVar xs
+                                                      te = xs `zip` ts
+                                                  return (bf, t', Kindle.closure t' t te (Kindle.CRet (f es)))
+
+
+-- Translate a Core.Exp into a Kindle function
+cFunExp env e                           = do (bf,t,h) <- cExp env e
+                                             case h of
+                                               FunR f ts -> return (bf, t, f, ts)
+                                               ValR e' -> do (ts,t') <- openClosureType t
+                                                             return (bf, t', Kindle.enter e' [], ts)
+ 
+
+-- Map a Kindle.ATEnv (unzipped) and a list of Kindle.Exps into a list of Kindle.Binds
+mkBinds xs ts es                        = zipWith3 f xs ts es
+  where f x t e                         = (x, Kindle.Val t e)
+
+
+-- Check if expression is a primitive, possibly applied to type arguments
+isPrim p (ELet bs e) 
+  | isTAppEncoding bs                   = isPrim p e
+isPrim p (EVar (Prim p' _))
+  | p == p'                             = True
+isPrim p e                              = False
+
+isCastPrim (EVar (Prim p _))
+  | p `elem` intCasts                   = Just Kindle.tInt
+  | p == IntToChar                      = Just Kindle.tChar
+  | p == IntToBITS8                     = Just Kindle.tBITS8
+  | p == IntToBITS16                    = Just Kindle.tBITS16
+  | p == IntToBITS32                    = Just Kindle.tBITS32
+  where intCasts                        = [CharToInt,BITS8ToInt,BITS16ToInt,BITS32ToInt]
+isCastPrim _                            = Nothing
+
+
+-- Extract type arguments from expression
+cTArgs env (ELet bs e)
+  | isTAppEncoding bs                   = mapM (cAType env) (tAppTypes bs)
+cTArgs env e                            = return []
+
+
+
+-- Additional entry point for translating imported environments
+c2kTEnv ds te                         = localStore f
+  where f                               = do mapM_ addToStore (filter (isClosure . fst) ds)
+                                             te <- cTEnv env0 te
+                                             return (filter p te)
+--        p (_,Kindle.FunT _ _ (Kindle.TCon n _))    
+--                                        = not (isClosure n) -- ???
+        p _                             = True
diff --git a/src/Decls.hs b/src/Decls.hs
new file mode 100644
--- /dev/null
+++ b/src/Decls.hs
@@ -0,0 +1,208 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Decls where
+
+import Common
+import Core
+import Env
+import Reduce
+import PP
+
+-- Declaration processing ---------------------------------------------------------------------
+
+{-
+
+?    Check acyclic tsym deps   
+?    Generate future subtype instances
+?    Generate future class instances
+
+-}
+
+
+-- Extend kind environment
+-- Initialize empty class witness graph
+-- Extract selector and constructor type schemes
+-- Construct class member type schemes and bindings
+-- Replace subtyping in type declarations with explicit selectors/constructors
+-- Initialize subtyping graph with reflexivity witnesses
+-- Close subtyping graph under transitivity (report cyclic and ambiguity errors)
+-- Return extended environment, transformed decls and added witness bindings
+
+
+typeDecls env (Types ke ds)             = do (ds,pe1,eq1) <- desub env0 ds
+                                             (env',bs) <- instancePreds env0 pe1
+                                             let tds = Types ke ds
+                                             return (addTEnv0 (tenvSelsCons tds) env', tds, catBinds (Binds False pe1 eq1)  bs)
+  where env0                            = addClasses cs (addKEnv0 ke env)
+        cs                              = [ c | (c, DRec True _ _ _) <- ds ]
+
+impDecls env (Types ke ds)              =  env1
+  where 
+        env1                            = addClasses cs (addKEnv0 ke env)
+        cs                              = [ c | (c, DRec True _ _ _) <- ds ]
+
+-- Close the top-level instance delcarations
+-- Return the extended environment and the added witness bindings
+
+instancePreds env pe                    = do (env',qe,eq) <- closePreds0 env pe
+                                             let bss = preferParams env' pe qe eq
+                                             return (env', concatBinds bss)
+
+impPreds env pe                         = addPreds (addPEnv0 pe env) pe
+
+
+-- Computes the stand-alone type schemes associated with selectors and constructors
+-- Note: these constants have no corresponding definition (i.e., no rhs)
+
+tenvSelsCons (Types ke ds)              = concatMap (tenvSelCon ke) ds
+
+tenvSelCon ke0 (c,DRec _ vs _ ss)       = map (f t ke) ss
+  where (t,ke)                          = mkHead ke0 c vs
+        f t ke (l, Scheme rh ps ke')    = (l, Scheme rh (scheme t : ps) (ke++ke'))
+tenvSelCon ke0 (c,DData vs _ cs)        = map (f t ke) cs
+  where (t,ke)                          = mkHead ke0 c vs
+        f t ke (k, Constr ts ps ke')    = (k, Scheme (tFun' ts t) ps (ke++ke'))
+tenvSelCon ke0 _                        = []
+
+tenvCon ke0 (c,DData vs _ cs)           = map (f t ke) cs
+  where (t,ke)                          = mkHead ke0 c vs
+        f t ke (k, Constr ts ps ke')    = (k, Scheme (tFun' ts t) ps (ke++ke'))
+tenvCon ke0 _                           = []
+
+mkHead ke0 i vs                         = (tAp' i vs, vs `zip` kArgs (findKind0 ke0 i))
+
+
+-- Decomposition of type declarations ---------------------------------------------------------
+
+desub env ds                            = do (ds',pes,eqs) <- fmap unzip3 (mapM desub' ds)
+                                             return (ds', concat pes, concat eqs)
+  where 
+    desub' (i, DData vs bs cs)          = do (pe,eq,cs') <- fmap unzip3 (mapM (con (fromMod i) (mkHead ke0 i vs)) bs)
+                                             return ((i, DData vs [] (cs'++cs)), pe, eq)
+    desub' (i, DRec isC vs bs ss)       = do (pe,eq,ss') <- fmap unzip3 (mapM (sel (fromMod i) (mkHead ke0 i vs)) bs)
+                                             return ((i, DRec isC vs [] (ss'++ss)), pe, eq)
+    desub' (i, DType vs t)              = return ((i, DType vs t), [], [])
+    ke0                                 = kindEnv0 env
+    con m (t0,ke0) (Scheme (R t) [] ke) = do w <- newNameMod m coercionSym
+                                             k <- newNameMod m (coerceConstr t t0)
+                                             x <- newName paramSym
+                                             let p  = (w, Scheme (R (t `sub` t0)) [] (ke0++ke))
+                                                 eq = (w, ELam [(x,scheme t)] (EAp (ECon k) [EVar x]))
+                                                 c  = (k, Constr [scheme t] [] ke)
+                                             return (p, eq, c)
+    sel m (t0,ke0) (Scheme (R t) [] ke) = do w <- newNameMod m coercionSym
+                                             l <- newNameMod m (coerceLabel t0 t)
+                                             x <- newName paramSym
+                                             let p  = (w, Scheme (R (t0 `sub` t)) [] (ke0++ke))
+                                                 eq = (w, ELam [(x,scheme t0)] (ESel (EVar x) l))
+                                                 s  = (l, Scheme (R t) [] ke)
+                                             return (p, eq, s)
+
+coerceConstr t t0                       = coerceConstrSym ++ "_" ++ render (prId3 (tId(tHead t))) ++ "_" ++ render (prId3 (tId (tHead t0)))
+
+coerceLabel t0 t                        = coerceLabelSym  ++ "_" ++ render (prId3 (tId(tHead t0))) ++ "_" ++ render (prId3 (tId (tHead t)))
+
+{-
+
+   *data Exists m = All a . Pack (All b . D m b a) (All b . C m b a -> m b a)
+
+    Pack :: All m,a . (All b . D m b a) -> (All b . C m b a -> m b a) -> Exists m
+
+    f1 :: All a,b . (All b . D m b a) -> D m' b a
+    f1 :: All a . (All b . D m b a) -> (All b . D m' b a)
+    f2 :: All a,b . (All b . D m b a) -> (All b . C m b a -> m b a) -> C m' b a -> m' b a
+      f2 :: All a . (All b . D m b a) -> (All b . C m b a -> m b a) -> (All b . C m' b a -> m' b a)
+    case x of
+      Pack -> \d::(All b . D m b a) -> \r::(All b . C m b a -> m b a) -> Pack (f1 d) (f2 d r)
+
+
+   *data Exists m = All a . (All b . D m b a) => Pack (All b . C m b a -> m b a)
+
+    Pack :: All m,a . (All b . D m b a) => (All b . C m b a -> m b a) -> Exists m
+
+    f1 :: All a,b . (All b . D m b a) -> D m' b a
+      f1 :: All a . (All b . D m b a) -> (All b . D m' b a)
+    f2 :: All a,b . (All b . D m b a) -> (All b . C m b a -> m b a) -> C m' b a -> m' b a
+      f2 :: All a . (All b . D m b a) -> (All b . C m b a -> m b a) -> (All b . C m' b a -> m' b a)
+    case x of
+      Pack -> \d::(All b . D m b a) => \r::(All b . C m b a -> m b a) -> Pack (f1 d) (f2 d r)
+
+
+    
+   *data Exists m = Pack (D m b a \\ b) (C m b a -> m b a \\ b) \\ a
+
+    Pack :: (D m b a \\ b) -> (C m b a -> m b a \\ b) -> Exists m \\ m, a
+
+    f1 :: (D m b a \\ b) -> D m' b a \\ a, b
+      f1 :: (D m b a \\ b) -> (D m' b a \\ b) \\ a
+    f2 :: (D m b a \\ b) -> (C m b a -> m b a \\ b) -> C m' b a -> m' b a \\ a, b
+      f2 :: (D m b a \\ b) -> (C m b a -> m b a \\ b) -> (C m' b a -> m' b a \\ b) \\ a
+    case x of
+      Pack -> \d::(D m b a \\ b) -> \r::(C m b a -> m b a \\ b) -> Pack (f1 d) (f2 d r)
+
+
+   *data Exists m = Pack (m b a \\ b, C m b a) \\ a, (D m b a \\ b)
+
+    Pack :: (m b a \\ b, C m b a) -> Exists m \\ m, a, (D m b a \\ b)
+
+    f1 :: (D m b a \\ b) -> D m' b a \\ a,b
+      f1 :: (D m b a \\ b) -> (D m' b a \\ b) \\ a
+    f2 :: (m b a \\ b, C m b a) -> m' b a \\ a, b, C m' b a, (D m b a \\ b)
+      f2 :: (m b a \\ b, C m b a) -> (m' b a \\ b, C m' b a) \\ a, (D m b a \\ b)
+    case x of
+      Pack -> \d::(D m b a \\ b) => \r::(m b a \\ b, C m b a) -> Pack (f1 d) (f2 d r)
+
+
+
+   *record T a =
+        x :: b -> a -> b \\ b, b < a
+
+    x :: T a -> b -> a -> b \\ b, b < a
+
+    f :: (b -> a -> b \\ b, b < a) -> b -> a' -> b \\ b, b < a'
+      f :: (b -> a -> b \\ b, b < a) -> (b -> a' -> b \\ b, b < a')
+    { x = f r.x }
+
+
+
+   *record T a =
+        x :: (b<a) -> b -> a -> b \\ b
+
+    x :: T a -> (b<a) -> b -> a -> b \\ b
+
+    f :: ((b<a) -> b -> a -> b \\ b) -> (b<a') -> b -> a' -> b \\ b
+      f :: ((b<a) -> b -> a -> b \\ b) -> ((b<a') -> b -> a' -> b \\ b)
+    { x = f r.x }
+-}
+
diff --git a/src/Depend.hs b/src/Depend.hs
new file mode 100644
--- /dev/null
+++ b/src/Depend.hs
@@ -0,0 +1,119 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Depend where
+
+import Common
+import Core
+import Syntax
+import PP
+
+type Graph a                    = Map a [a]
+
+graph nbors ps                  = map f ps
+  where f (i,d)                 = (i,[v | v <- nbors d, v/=i, v `elem` domain])
+        domain                  = dom ps
+ 
+scc                             :: Eq a => Graph a -> [[a]]
+scc g                           = dfs g' (concat (dfs g (dom g)))
+  where g'                      = [(i,[x | (x,ys) <- g, i `elem` ys]) | (i,_) <- g]
+
+dfs g is                        = snd (dfs' ([],[]) is)
+   where dfs' p []              = p
+         dfs' p@(vs,ns) (x:xs)
+           | x `elem` vs        = dfs' p xs
+           | otherwise          = dfs' (vs', (x:concat ns'):ns) xs
+           where (vs',ns')      = dfs' (x:vs,[]) (nbors x)
+         nbors i                = fromJust (lookup i g)
+
+order ms ns                     = ns `zip` map (fromJust . flip lookup ms) ns
+  
+group ms nss                    = map (order ms) nss
+
+topSort                         :: Eq a  => (b -> [a]) -> [(a,b)] -> Either [a] [(a,b)]
+topSort nbors ms                = case dropWhile (null . tail) ns of
+                                    []     -> Right (order ms (concat ns))
+                                    xs : _ -> Left xs
+          where ns              = scc (graph nbors ms)
+
+groupBinds (Binds _ te es)      = map f ess
+  where gs                      = scc (graph evars es)
+        ess                     = group es gs
+        f [(x,e)]               = Binds (x `elem` evars e) (restrict te [x]) (restrict es [x])
+        f es'                   = Binds True (restrict te xs) (restrict es xs)
+          where xs              = dom es'
+
+
+groupTypes (Types ke ts)        = map f tss
+  where gs                      = scc (graph tycons ts)
+        tss                     = group ts gs
+        f ts'                   = Types (restrict ke cs) (restrict ts cs)
+          where cs              = dom ts'
+
+
+groupMap bs                     = map f bss
+  where gs                      = scc (graph evars bs)
+        bss                     = group bs gs
+        f bs@[(x,b)]            = (x `elem` evars b, restrict bs [x])
+        f bs'                   = (True, restrict bs xs)
+          where xs              = dom bs'
+         
+-- Dependency analysis on Syntax bindlists -------------------------------------------
+
+isFunEqn v (BEqn (LFun v' _) _) = v == v'
+isFunEqn v _                    = False
+
+graphInfo []                    =  []
+graphInfo (s@(BSig [v] _) : bs)
+                                = (s:bs1, [v], nub (idents bs1)) : graphInfo bs2
+  where (bs1,bs2)               = span (isFunEqn v) bs
+graphInfo (e@(BEqn (LFun v _) rh) : bs) 
+                                = (e:bs1, [v], nub (idents (e:bs1))) : graphInfo bs2
+  where (bs1,bs2)               = span (isFunEqn v) bs
+graphInfo (e@(BEqn (LPat p) rh) : bs)  
+                                = ([e], nub (idents p), nub (idents rh)) : graphInfo bs
+graphInfo (BSig _ _ : bs)       = graphInfo bs
+
+buildGraph                      :: [([Bind],[Name],[Name])] -> Graph Int
+buildGraph vs                   = zip ns (map findDeps fvss)
+  where (_,bvss,fvss)           = unzip3 vs
+        ns                      = [1..]
+        dict                    = concatMap mkDict (zip bvss ns)
+        mkDict (vs,n)           = map (\v -> (v,n)) vs
+        findDeps xs             = [n | Just n <- map (flip lookup dict) xs]
+
+groupBindsS                     :: [Bind] ->  [[Bind]]
+groupBindsS bs                  = map f gs
+  where infos                   = graphInfo bs
+        gs                      = scc (buildGraph infos)
+        f indices               = concat (map (\i -> fst3 (fromJust (lookup i (zip [1..] infos)))) indices)
diff --git a/src/Derive.hs b/src/Derive.hs
new file mode 100644
--- /dev/null
+++ b/src/Derive.hs
@@ -0,0 +1,199 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Derive where
+
+import Common
+import Core
+import Env
+import PP
+
+
+derive ts ds []                       = return ([],[])
+derive ts ds (d@(Default _ _ _) : xs)
+                                      = do (is,xs) <- derive ts ds xs
+                                           return (is,d:xs)
+derive ts ds (Derive n sc : xs)       = do let (s,d) = analyze ds sc
+                                               n1 = str (fst s)
+                                               m = fromMod (fst s)
+                                           (is,xs) <- derive ts ds xs
+                                           if n1=="Show" && m==Just "Prelude"
+                                             then do i <- mkShowInstance n sc s d
+                                                     return (i:is,xs)
+                                             else 
+                                             if n1=="Parse" && m==Just "Prelude" 
+                                             then do let eq = EVar (findByNameStr ts "==")
+                                                     i <- mkParseInstance n eq sc s d
+                                                     return (i:is,xs)
+                                             else do b <- mkFunPair d
+                                                     i <- mkInstance n ts s sc b
+                                                     -- tr ("### Default instance \n"++render (prInsts i))
+                                                     return (i:is,xs)
+
+analyze ds sc                         = case tFlat (scheme2Type sc) of
+                                           (TId c,[t']) -> findDataType c t'
+                                           _ -> errorTree "Not an instance of a one-parameter type constructor" sc 
+  where findDataType c t'             = case tFlat t' of
+                                          (TId d,_) -> case lookup c (tdefsOf ds) of
+                                             Nothing -> errorTree ("Unknown typeclass "++show c) sc
+                                             Just c'@(DRec True [a] _ _) -> case lookup d (tdefsOf ds) of
+                                                                              Nothing -> errorTree ("Unknown data type "++show d) sc
+                                                                              Just d'@(DData _ _ _) -> ((c,c'),(d,d')) 
+                                                                              Just _ -> errorTree (show d++" is not a data type") sc
+                                             Just (DRec True _ _ _) -> errorTree "Default instances only for one-parameter typeclasses; not" sc
+                                             Just _ -> errorTree (show c++" is not a typeclass") sc         
+                                                   
+mkInstance n ts (nm,DRec True [a] ps ss) sc (ns,bss)
+                                      = do  fs <- mapM (mkField a ts ns) ss
+                                            return (Binds False [(n,sc)] [(n,foldr ELet (ERec nm fs) bss)])
+
+mkField a ts [from,to] (nm,sc)        = do let nm' = findByNameStr ts (str nm)
+                                           e <- expand a from to (EVar nm') sc
+                                           return (nm,e)
+
+findByNameStr ts s                  = lookup' [(name0 (str n),n {annot = (annot n) {explicit=False}}) | n <- ts ] (name0 s)
+
+expand a from to e sc                 = exp0 to (e,scheme2Type sc)
+  where exp0 f (e,TFun ts t)          = do ns <- newNames paramSym (length ts)
+                                           let xs = map EVar ns
+                                           es <- mapM (exp0 from) (zip xs ts)
+                                           e' <- exp0 to (EAp e es,t)
+                                           eLam' ns e'
+        exp0 f (e,TId n)
+          | n==a                      = return (EAp (EVar f) [e])
+        exp0 _ (e,t)                  = expTup (e,tFlat t)
+                                             
+        expTup (e,(TId (Tuple n _),ts))
+                                      = do let n = length ts
+                                           ns <- newNames paramSym n
+                                           let xs = map EVar ns
+                                           es <- mapM (exp0 to) (zip xs ts)
+                                           lam <- eLam' ns (etup n es)
+                                           return (ECase e [(PCon (tuple n), lam)])
+        expTup (e,_)                  = return e
+
+eLam' xs e                            = do ts <- mapM (\_ -> newTVar Star) xs
+                                           return (ELam (zipWith (\x t -> (x,scheme t)) xs ts) e)
+                                           
+mkFunPair (nm,DData _ (_:_) _)        = errorIds "Not yet implemented: default instances for data type with subtypes" [nm]
+mkFunPair (nm,DData vs ss cs)         = do [from,to] <- mapM newName ["from"++str nm,"to"++str nm]
+                                           frhs <- fromRHS
+                                           trhs <- toRHS
+                                           return ( [from,to], [Binds False [(from,fromType)] [(from,frhs)], Binds False [(to,toType)]  [(to,trhs)]])
+
+  where ot                            = foldr1 tEither (map mkTuple cs)
+        dt                            = foldl TAp (TId nm) (map TId vs)
+        mkTuple (_,Constr [] _ _)     = tUnit
+        mkTuple (_,Constr ss _ _)     = foldr1 (ttup2) (map scheme2Type ss)
+        ttup2 t1 t2                   = ttup 2 [t1,t2]
+        etup2 e1 e2                   = etup 2 [e1,e2]
+        fromType                      = Scheme (F [scheme dt] (R ot)) [] (map (\n -> (n,Star)) vs)
+        toType                        = Scheme (F [scheme ot] (R dt)) [] (map (\n -> (n,Star)) vs)
+
+        prefixLR fs e                 = foldr (\f e -> EAp (ECon f) [e]) e (map prim fs)
+        mkAlt fs (nm,Constr [] _ _)   = return (PCon nm,prefixLR fs (ECon (prim UNITTERM)))
+        mkAlt fs (nm,Constr ss _ _)   = do ns <- newNames tempSym (length ss)
+                                           lam <- eLam' ns  (prefixLR fs (foldr1 (etup2) (map EVar ns)))
+                                           return (PCon nm,lam)
+        alts fs [c]                   = do a <- mkAlt fs c
+                                           return [a]
+        alts fs (c:cs)                = do a <- mkAlt (fs++[LEFT]) c
+                                           as <- alts (fs++[RIGHT]) cs
+                                           return (a:as)
+        fromRHS                       = do x  <- newName paramSym
+                                           as <- alts [] cs
+                                           return (ELam [(x,scheme dt)] (ECase (EVar x) as))
+
+        mkCase t@(TAp (TAp (TId (Prim EITHER _)) a) b) (c:cs) (x:xs)
+                                      = do [y,z] <- newNames paramSym 2
+                                           l <- mkCase a [c] (y:xs)
+                                           r <- mkCase b cs (z:xs)
+                                           lam1 <- eLam' [y] l
+                                           lam2 <- eLam' [z] r
+                                           return (ECase (EVar x) [(PCon (prim LEFT),lam1),(PCon (prim RIGHT),lam2)])
+        mkCase t@(TAp (TAp (TId (Tuple 2 _)) a) b) cs (x:xs)
+                                      = do [y,z] <- newNames paramSym 2
+                                           r <- mkCase b cs (z:y:xs)
+                                           lam <- eLam' [y,z] r
+                                           return (ECase (EVar x) [(PCon (tuple 2),lam)])
+        mkCase (TId (Prim UNITTYPE _)) (c:_) xs             
+                                      = return (ECon c)
+        mkCase t (c:_) xs             = return (EAp (ECon c) (map EVar (reverse xs)))
+        toRHS                         = do x <- newName paramSym
+                                           r <- mkCase ot (map fst cs) [x] 
+                                           eLam' [x] r
+
+
+ttup n ts                             = foldl TAp (TId (tuple n)) ts
+etup n es                             = EAp (ECon (tuple n)) es
+
+
+scheme2Type (Scheme r _ _)            = rho2Type r
+rho2Type (R t)                        = t
+rho2Type (F ss r)                     = TFun (map scheme2Type ss) (rho2Type r) 
+
+mkShowInstance n sc s (nm, DData vs [] cs) 
+                                      = do sh <- mkShow
+                                           return (Binds False [(n,sc)] [(n,ERec (fst s) [(n',sh)])])
+  where DRec _ _ _ [(n',_)]           = snd s
+        mkShow                        = do x <- newName paramSym
+                                           as <- mapM mkShowAlt cs
+                                           eLam' [x] (ECase (EVar x) as)
+        mkShowAlt (nm,Constr [] _ _)  = return (PCon nm,ELit (LStr Nothing (str nm)))
+        mkShowAlt (nm,_)              = errorIds "Sorry, as yet only default Show for enumeration types, without constructors as" [nm]
+--        cons                          = ECon (prim CONS)
+--        nil                           = ECon (prim NIL)
+        chr c                         = ELit (lChr c)
+mkShowInstance n sc s (nm, DData vs _ cs) 
+                                      = errorIds "Not yet implemented: default Show instance for data type with subtypes" [nm]
+
+
+
+mkParseInstance n eq sc s (nm, DData vs [] cs) 
+                                      = do p <- mkParse
+                                           return (Binds False [(n,sc)] [(n,ERec (fst s) [(n',p)])])
+  where DRec _ _ _ [(n',_)]           = snd s
+        mkParse                       = do x <- newName paramSym
+                                           as <- mapM (mkParseAlt x) cs
+                                           eLam' [x] (EAp (EVar (prim Match)) [foldr (\x y -> EAp (EVar (prim Fatbar)) [x,y]) 
+                                                                              (EAp (EVar (prim Commit)) [EAp (ECon (prim LEFT)) [mkList "no Parse"]]) 
+                                                                              as]) 
+        mkParseAlt x (nm,Constr [] _ _) = return (ECase (EAp eq [EVar x, mkList (str nm)])
+                                                  [(PCon (prim TRUE),EAp (EVar (prim Commit)) [EAp (ECon (prim RIGHT)) [ECon nm]]),(PWild,EVar (prim Fail))])
+        mkParseAlt x (nm,_)           = errorIds "Sorry, as yet only default Parse for enumeration types, without constructors as" [nm]
+--        cons                          = ECon (prim CONS)
+--        nil                           = ECon (prim NIL)
+        mkList str                    = ELit (LStr Nothing str)
+        chr c                         = ELit (lChr c)
+mkParseInstance n eq sc s (nm, DData vs _ cs) 
+                                      = errorIds "Not yet implemented: default Parse instance for data type with subtypes" [nm]
diff --git a/src/Desugar1.hs b/src/Desugar1.hs
new file mode 100644
--- /dev/null
+++ b/src/Desugar1.hs
@@ -0,0 +1,395 @@
+{-# LANGUAGE FlexibleInstances #-}
+
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Desugar1 where
+
+import List(sort, sortBy)
+import Monad
+import Common
+import Syntax
+import Depend
+import PP
+
+desugar1 e0 (Module c is ds ps)  = do let (env,expInfo) = mkEnv c (ds ++ ps) e0
+                                      ds' <- dsDecls env ds
+                                      ps' <- dsDecls env {isPublic = False} ps
+                                      return (Module c is ds' ps',expInfo)
+
+{-
+    This module performs desugaring transformations that must be performed before the renaming pass:
+    - Implements Record Stuffing; i.e. replacing ".." in record patterns and expressions 
+      by sequences of bindings of the form "x=x" for missing record fields x.  
+    - Adds type tag to anonymous record expressions/patterns.
+    - Makes the "self" variable explicit.
+    - Checks validity of result statement
+    - Replaces prefix expression statement with dummy generator statement
+    - Replaces if/case statements with corresponding expressions forms
+    - Checks the restricted command syntax of template bodies
+    - Unfolds use of type synonyms
+-}
+
+-- The selector environment --------------------------------------------------------------------------------------
+
+data Env                        = Env { sels :: Map Name [Name], 
+                                        self :: Maybe Name , 
+                                        selSubst :: Map Name Name,
+                                        modName :: Maybe String,
+                                        isPat :: Bool,
+                                        isPublic :: Bool,
+                                        isTail :: Bool,
+                                        tsyns :: Map Name ([Name],Type)
+                                  } deriving Show
+
+
+env0 ss                       = Env { sels = [], self = Nothing, selSubst = [], modName = Nothing, isPat = False, 
+                                      isPublic = True, isTail = True, tsyns = ss }
+
+
+mkEnv c ds (rs,rn,ss)           = (env {sels = map transClose recEnv, modName = Just(str c), selSubst = rnSels },
+                                   (map (\(n,ss) -> (qName (str c) n,ss)) closeRecEnvLoc,tsynsLoc))
+  where (env,ssLoc)             = tsynE (env0 ss) [] tsynDecls
+        tsynsLoc                = map (\(n,y) -> (n {fromMod = Just (str c)},y)) ssLoc
+        recEnvLoc               = [ (c,(map type2head ts, concat (map sels ss))) | DRec _ c _ ts ss <- ds ] 
+        recEnvImp               = zip ns (zip (repeat []) ss) where (ns,ss) = unzip rs
+        closeRecEnvLoc          = map transClose recEnvLoc
+        closeRecEnvImp          = map transClose recEnvImp
+        recEnv                  = recEnvLoc ++ recEnvImp
+        selsLocQual             = concatMap (snd . snd) recEnvLoc
+        selsLoc                 = map dropMod selsLocQual
+        rnSels                  = zip selsLoc selsLocQual ++ zip selsLocQual selsLocQual ++ rn
+        sels (Sig vs _)         = map (qName (str c)) vs
+        transClose (c,(cs,ss))  = (c, sort (ss ++ nub(concat (map (selectors [c]) cs))))
+        selectors cs0 c
+          | c `elem` cs0        = errorIds "Circular struct dependencies" (c:cs0)
+          | otherwise           = case lookup c recEnv of
+                                    Just (cs,ss) -> ss ++ concat (map (selectors (c:cs0)) cs)
+                                    Nothing      -> errorIds "Unknown struct constructor"  [c]
+
+        tsynDecls                
+          | not (null dups)     = errorIds "Duplicate type synonym declarations" dups
+          | otherwise           = case topSort (tyCons . snd) syns of
+                                    Left ns     -> errorIds "Mutually recursive type synonyms" ns
+                                    Right syns' -> syns'
+        syns                    = [(c,(vs,t)) | DType c vs t <- ds]
+        dups                    = duplicates (map fst syns)
+
+
+tsynE env ls []                 = (env,ls)
+tsynE env ls ((c,(vs,t)) : ps) 
+    | c `elem` tyCons t         = errorIds "Type synonym is recursive" [c]
+    | otherwise                 = tsynE env {tsyns =p : tsyns env} (p:ls) ps
+ where p                        =  (c,(vs,ds1 env t))
+
+selsFromType env c              = case lookup c (sels env) of
+                                    Just ss -> ss
+                                    Nothing -> if fromMod c == modName env
+                                               then selsFromType env (c {fromMod = Nothing})
+                                               else errorIds "Unknown struct constructor" [c]
+
+
+typeFromSels env ss             = case [ c | (c,ss') <- sels env, ss' == ss ] of
+                                    []  -> errorIds "No struct type with selectors" ss
+                                    [c] -> c
+                                    cs  -> case filter isQualified cs of
+                                             [c] -> c
+                                             _   -> errorIds ("Multiple struct types defined by selectors") ss
+
+
+haveSelf env                    = self env /= Nothing
+
+haveTail env []                 = env
+haveTail env _                  = env { isTail = False }
+
+tSubst env c ts                 = case lookup c (tsyns env) of
+                                     Nothing -> foldl TAp (TCon c) ts1
+                                     Just (vs,t)
+                                       | length vs > length ts -> errorIds "Type synonym not fully applied" [c]
+                                       | otherwise -> foldl TAp (subst (zip vs (take (length vs) ts1)) t) 
+                                                                (drop (length vs) ts1)
+  where ts1                     = ds1 env ts
+
+ren env cs                      = map ren' cs     
+  where ren' c                  = case lookup c (selSubst env) of
+                                     Nothing -> errorIds "Unknown struct selector" [c]
+                                     Just c' -> c'
+
+patEnv env                      = env {isPat = True}
+
+sortFields fs                   = sortBy cmp fs
+  where cmp (Field l1 _) (Field l2 _) = compare (str l1) (str l2)
+
+-- Desugaring -------------------------------------------------------------------------------------------
+
+dsDecls env (DType c vs t : ds) = liftM (DType c vs (ds1 env t) :) (dsDecls env ds)
+dsDecls env (DData c vs ss cs : ds) = liftM (DData c vs (ds1 env ss) (ds1 env cs) :) (dsDecls env ds)
+dsDecls env (DRec b c vs ss ss' : ds) = liftM (DRec b c vs (ds1 env ss) (ds1 env ss') :) (dsDecls env ds)
+dsDecls env (DPSig n t : ds)    = liftM (\ds -> DInstance [n] : DBind [BSig [n] (ds1 env t)] : ds) (dsDecls env ds)
+dsDecls env (DInstance ws : ds) = liftM (DInstance ws :) (dsDecls env ds)
+dsDecls env (DTClass ts : ds)   = liftM (DTClass ts :) (dsDecls env ds)
+dsDecls env (DDefault ts : ds)  = liftM (DDefault (ds1 env ts) :) (dsDecls env ds)
+dsDecls env ds@(DBind _ : _)    = dsDs [] ds
+  where dsDs bs (DBind bs':ds)  = dsDs (bs++bs') ds
+        dsDs bs ds              = liftM (DBind (ds1 env bs) :) (dsDecls env ds)
+dsDecls env (d : ds)            = liftM (d :) (dsDecls env ds)
+dsDecls env []                  = return []
+
+
+class Desugar1 a where
+    ds1 :: Env -> a -> a
+
+instance Desugar1 a => Desugar1 [a] where
+    ds1 env                     = map (ds1 env)
+
+instance Desugar1 a => Desugar1 (Maybe a) where
+    ds1 env Nothing             = Nothing
+    ds1 env (Just a)            = Just (ds1 env a)
+
+instance Desugar1 (Default Type) where
+   ds1 env (Default _ a b)      = Default (isPublic env) a b
+   ds1 env (Derive v t)         = Derive v (ds1 env t)
+
+instance Desugar1 Constr where
+    ds1 env (Constr c ts ps)    = Constr c (ds1 env ts) (ds1 env ps)
+
+instance Desugar1 Sig where
+    ds1 env (Sig vs t)          = Sig vs (ds1 env t)
+
+instance Desugar1 Type where
+    ds1 env t@(TAp t1 t2)       = case tFlat t of
+                                     (TCon c,ts) -> tSubst env c ts
+                                     _ -> TAp (ds1 env t1) (ds1 env t2)
+    ds1 env (TQual t ps)        = TQual (ds1 env t) (ds1 env ps)
+    ds1 env (TSub t1 t2)        = TSub (ds1 env t1) (ds1 env t2)
+    ds1 env (TList t)           = TList (ds1 env t)
+    ds1 env (TTup ts)           = TTup (ds1 env ts)
+    ds1 env (TFun ts t)         = TFun (ds1 env ts) (ds1 env t)
+    ds1 env (TCon c)            = tSubst env c []
+    ds1 env t                   = t
+
+instance Desugar1 Pred where
+    ds1 env (PType t)           = PType (ds1 env t)
+    ds1 env p                   = p
+instance Desugar1 Decl where
+    ds1 env (DBind bs)          = DBind (ds1 env bs)
+    ds1 env d                   = d
+
+instance Desugar1 Bind where
+    ds1 env (BEqn lh rh)        = BEqn (ds1 env lh) (ds1 env rh)
+    ds1 env (BSig vs t)         = BSig vs (ds1 env t)
+
+instance Desugar1 Lhs where
+    ds1 env (LFun v ps)         = LFun v (ds1 (patEnv env) ps)
+    ds1 env (LPat (EVar x))     = LFun x []
+    ds1 env (LPat p)            = LPat (ds1 (patEnv env) p)
+
+instance Desugar1 (Rhs Exp) where
+    ds1 env (RExp e)            = RExp (ds1 env e)
+    ds1 env (RGrd gs)           = RGrd (ds1 env gs)
+    ds1 env (RWhere e bs)       = RWhere (ds1 env e) (ds1 env bs)
+
+instance Desugar1 (GExp Exp) where
+    ds1 env (GExp qs e)         = GExp (ds1 env qs) (ds1 env e)
+
+instance Desugar1 Qual where
+    ds1 env (QExp e)            = QExp (ds1 env e)
+    ds1 env (QGen p e)          = QGen (ds1 (patEnv env) p) (ds1 env e)
+    ds1 env (QLet bs)           = QLet (ds1 env bs)
+
+instance Desugar1 Exp where
+--    ds1 env e@(EVar _)             = e
+    ds1 env (ERec Nothing fs)
+      | not (null dups)            = errorIds "Duplicate field definitions in struct" dups
+      | otherwise                  = ERec (Just (c,True)) (sortFields (ds1 env fs))
+      where c                      = typeFromSels env (sort (ren env (bvars fs)))
+            dups                   = duplicates (bvars fs)
+    ds1 env (ERec (Just (c,all)) fs)
+      | not (null dups)            = errorIds "Duplicate field definitions in struct" dups
+      | all && not (null miss)     = errorIds "Missing selectors in struct" miss
+      | otherwise                  = ERec (Just (c,True)) (sortFields (fs' ++ ds1 env fs))
+      where miss                   = ren env (selsFromType env c) \\ ren env (bvars fs)
+            dups                   = duplicates (ren env (bvars fs))
+            fs'                    = map (\s -> Field (tag0 (mkLocal s)) (EVar (dropMod (tag0 s)))) miss
+            mkLocal s
+              | fromMod s == modName env = dropMod s
+              | otherwise          = s
+    ds1 env (EBStruct _ _ bs)      = EBStruct (Just c) labs (ds1 env bs)
+      where labs                   = selsFromType env c
+            c                      = typeFromSels env (sort (ren env (bvars bs)))
+    ds1 env (ELet bs e)            = ELet (ds1 env bs) (ds1 env e)
+    ds1 env (EAp e1 e2)            = EAp (ds1 env e1) (ds1 env e2)
+    ds1 env (ETup es)              = ETup (ds1 env es)
+    ds1 env (EList es)             = EList (ds1 env es)
+    ds1 env (ESig e t)             = ESig (ds1 env e) (ds1 env t)
+    ds1 env (ELam ps e)            = ELam (ds1 (patEnv env) ps) (ds1 env e)
+    ds1 env (ECase e as)           = ECase (ds1 env e) (ds1 env as)
+    ds1 env (EIf e1 e2 e3)         = EIf (ds1 env e1) (ds1 env e2) (ds1 env e3)
+    ds1 env (ENeg (ELit (LInt p i))) = ELit (LInt p (-i))
+    ds1 env (ENeg (ELit (LRat p r))) = ELit (LRat p (-r))
+    ds1 env (ENeg e)               = EAp (EVar (name' "negate" e)) (ds1 env e)
+    ds1 env (ESeq e1 Nothing e3)   = EAp (EAp (EVar (name' "enumFromTo" e1)) (ds1 env e1)) (ds1 env e3)
+    ds1 env (ESeq e1 (Just e2) e3) = EAp (EAp (EAp (EVar (name' "enumFromThenTo" e1)) (ds1 env e1)) (ds1 env e2)) (ds1 env e3)
+    ds1 env (EComp e qs)           = EComp (ds1 env e) (ds1 env qs)
+    ds1 env (ESectR e op)          = ESectR (ds1 env e) op
+    ds1 env (ESectL op e)          = ESectL op (ds1 env e)
+    ds1 env (ESelect e s)          = ESelect (ds1 env e) s
+    ds1 env e@(ELit (LInt _ n))
+      | isPat env                  = e
+      | otherwise                  = EAp (EVar (name' "fromInt" e)) e 
+
+    ds1 env (ETempl Nothing t ss)  = ds1 env (ETempl (Just (name0 "self")) (ds1 env t) ss)
+    ds1 env (EDo Nothing t ss)
+      | haveSelf env               = ds1 env (EDo (self env) (ds1 env t) ss)
+      | otherwise                  = ds1 env (EDo (Just (name0 "self")) (ds1 env t) ss)
+    ds1 env e@(EAct Nothing ss)
+      | haveSelf env               = ds1 env (EAct (self env) ss)
+      | otherwise                  = errorTree "Action outside class" e
+    ds1 env e@(EReq Nothing ss)
+      | haveSelf env               = ds1 env (EReq (self env) ss)
+      | otherwise                  = errorTree "Request outside class" e
+
+    ds1 env (ETempl v t ss)      = ETempl v t (ds1T (env{self=v}) [] [] ss)
+    ds1 env (EDo v t ss)         = EDo v t (ds1S (env { self=v, isTail = True }) ss)
+    ds1 env (EAct v ss)          = EAct v [SExp (EDo v Nothing (ds1S (env { isTail = False }) ss))]
+    ds1 env (EReq v ss)          = EReq v [SExp (EDo v Nothing (ds1S (env { isTail = True }) ss))]
+
+    ds1 env (EAfter e1 e2)       = EAfter (ds1 env e1) (ds1 env e2)
+    ds1 env (EBefore e1 e2)      = EBefore (ds1 env e1) (ds1 env e2) 
+
+    ds1 env e                    = e
+
+instance Desugar1 (Alt Exp) where
+    ds1 env (Alt p rh)           = Alt (ds1 (patEnv env) p) (ds1 env rh)
+
+instance Desugar1 Field where
+    ds1 env (Field l e)          = Field l (ds1 env e)
+
+
+ds1S env []                      = [SRet (ECon (prim UNITTERM))]
+ds1S env [SExp e]                = [SExp (ds1 env e)]
+ds1S env (SExp e : ss)           = SGen EWild (ds1 env e) : ds1S env ss
+ds1S env [SRet e]                = [SRet (ds1 env e)]
+ds1S env (s@(SRet _) : ss)       = errorTree "Result statement must be last in sequence" s
+ds1S env (SGen p e : ss)         = SGen (ds1 (patEnv env) p) (ds1 env e) : ds1S env ss
+ds1S env ss@(SBind _ : _)        = dsBs [] ss
+  where dsBs bs (SBind bs' : ss) = dsBs (bs++bs') ss
+        dsBs bs ss               = SBind (ds1 env bs) : ds1S env ss
+ds1S env (SAss p e : ss)         = dsAss p e : ds1S env ss
+  where dsAss (EAp (EAp (EVar (Prim IndexArray _)) a) i) e
+                                 = dsAss a (EAp (EAp (EAp (EVar (prim UpdateArray)) a) i) e)
+        dsAss p e                = SAss (ds1 env p) (ds1 env e)
+        {-
+            a|x|y|z := e
+            a|x|y   := a|x|y \\ (z,e)
+            a|x     := a|x \\ (y, a|x|y \\ (z,e))
+            a       := a \\ (x, a|x \\ (y, a|x|y \\ (z,e)))
+        -}
+ds1S env (SCase e as : ss)       = ds1S env (SExp (retComplete (haveTail env ss) (ECase e (map doAlt as))) : ss)
+  where doAlt (Alt p r)          = Alt (ds1 (patEnv env) p) (doRhs r)
+        doRhs (RExp ss)          = RExp (eDo env ss)
+        doRhs (RGrd gs)          = RGrd (map doGrd gs)
+        doRhs (RWhere r bs)      = RWhere (doRhs r) bs
+        doGrd (GExp qs ss)       = GExp qs (eDo env ss)
+ds1S env (SIf e ss' : ss)        = doIf (EIf e (eDo env ss')) ss
+  where doIf f (SElsif e ss':ss) = doIf (f . EIf e (eDo env ss')) ss
+        doIf f (SElse ss':ss)    = ds1S env (SExp (retComplete (haveTail env ss) (f (eDo env ss'))) : ss)
+        doIf f ss                = doIf f (SElse [] : ss)
+ds1S env (s@(SElsif _ _) : _)    = errorTree "elsif without corresponding if" s
+ds1S env (s@(SElse _) : _)       = errorTree "else without corresponding if" s
+ds1S env (SForall q ss' : ss)    = ds1S env (SExp (ds1Forall env q ss') : ss)
+ds1S env (SWhile e ss' : ss)     = internalError0 "while stmt not yet implemented"
+
+ds1Forall env [] ss              = eDo env ss
+ds1Forall env (QLet bs : qs) ss  = ELet bs (eDo env [SForall qs ss])
+ds1Forall env (QGen p (ESeq e1 Nothing e3) : qs) ss
+                                 = EAp (EAp (EAp (EVar (name' "forallSeq" p)) (ELam [p] (ds1Forall env qs ss))) e1) e3
+ds1Forall env (QGen p (ESeq e1 (Just e2) e3) : qs) ss
+                                 = EAp (EAp (EAp (EAp (EVar (name' "forallSeq1" p)) (ELam [p] (ds1Forall env qs ss))) e1) e2) e3
+ds1Forall env (QGen p e : qs) ss = EAp (EAp (EVar (name' "forallList" p)) (ELam [p] (ds1Forall env qs ss))) e
+ds1Forall env (QExp e : qs) ss   = EIf e (eDo env [])  (ds1Forall env qs ss)
+
+ds1T env []  asg [SRet e]        = reverse asg ++ [SRet (ds1 env e)]
+ds1T env bss asg [SRet e]        = SBind (ds1 env (concat (reverse bss))) : reverse asg ++ [SRet (ds1 env e)]
+ds1T env bss asg [s]             = errorTree "Last statement in class must be result, not" s
+ds1T env bss asg (s@(SRet _):_)  = errorTree "Result statement must be last in sequence" s
+ds1T env bss asg (SBind bs : ss) = ds1T env (bs:bss) asg ss
+ds1T env bss asg (SAss p e : ss) = ds1T env bss (SAss (ds1 (patEnv env) p) (ds1 env e) : asg) ss
+ds1T env bss asg (s : _)         = errorTree "Illegal statement in class: " s
+
+retComplete env e
+  | partialE e                   = addRetE e
+  | isTail env                   = e
+  | otherwise                    = addRetE e
+  where partialE (EIf _ e1 e2)   = partialE e1 || partialE e2
+        partialE (ECase _ alts)  = any partialA alts
+        partialE (EDo _ _ ss)    = partialS ss
+        partialE _               = False
+        partialS []              = True
+        partialS _               = False
+        partialA (Alt p r)       = partialR r
+        partialR (RExp e)        = partialE e
+        partialR (RGrd gs)       = any partialG gs
+        partialR (RWhere r bs)   = partialR r
+        partialG (GExp qs e)     = partialE e
+        
+        addRetE (EIf e e1 e2)    = EIf e (addRetE e1) (addRetE e2)
+        addRetE (ECase e alts)   = ECase e (map addRetA alts)
+        addRetE (EDo v t ss)     = EDo v t (addRetS ss)
+        addRetE e                = e
+        addRetA (Alt p r)        = Alt p (addRetR r)
+        addRetR (RExp e)         = RExp (addRetE e)
+        addRetR (RGrd gs)        = RGrd (map addRetG gs)
+        addRetR (RWhere r bs)    = RWhere (addRetR r) bs
+        addRetG (GExp qs e)      = GExp qs (addRetE e)
+        addRetS []               = [SRet (ECon (prim UNITTERM))]
+        addRetS s@[SRet (ECon (Prim UNITTERM _))]
+                                 = s
+        addRetS s@[SRet _]       = errorTree "Illegal result statement" s
+        addRetS (s:ss)           = s : addRetS ss
+
+
+eDo env ss                       = EDo (self env) Nothing ss
+
+maybeGen e []                    = [SExp e]
+maybeGen e ss                    = SGen EWild e : ss
+
+name' s  e                       = Name s 0 Nothing (noAnnot {location = loc (posInfo e)})
+  where loc Unknown              = Nothing
+        loc (Between p _)        = Just p
+
+-- Printing --------
+
+instance Pr (Module,([(Name, [Name])], [(Name, ([Name], Type))])) where
+ 
+   pr (m,_) = pr m
diff --git a/src/Desugar2.hs b/src/Desugar2.hs
new file mode 100644
--- /dev/null
+++ b/src/Desugar2.hs
@@ -0,0 +1,393 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Desugar2(desugar2) where
+
+import Monad
+import Common
+import Syntax
+import Match
+import Maybe
+import Fixity
+import PP
+
+desugar2 :: Module -> M s Module
+desugar2 m = dsModule m
+
+
+-- Modules ------------------------------------------------------------------
+
+dsModule :: Module -> M s Module
+dsModule (Module c is ds ps)    = do ds <- dsDecls ds
+                                     return (Module c is ds ps)
+
+
+-- Top level declarations ---------------------------------------------------
+
+
+
+dsDecls []                      = return []
+dsDecls (d@(DKSig _ _) : ds)    = liftM (d :) (dsDecls ds)
+dsDecls (DData c vs bs cs : ds) = liftM (DData c vs (map dsQualBaseType bs) (map dsConstr cs) :) (dsDecls ds)
+dsDecls (DRec i c vs bs ss:ds)  = liftM (DRec i c vs (map dsQualBaseType bs) (map dsSig ss) :) (dsDecls ds)
+dsDecls (DType c vs t : ds)     = liftM (DType c vs (dsType t) :) (dsDecls ds)
+dsDecls (DPSig v t : ds)        = liftM (DPSig v (dsQualPred t) :) (dsDecls ds)
+dsDecls (DInstance vs : ds)     = liftM (DInstance vs :) (dsDecls ds)
+dsDecls (DTClass vs : ds)       = dsDecls ds
+dsDecls (DDefault ts : ds)      = liftM (DDefault (map dsDefault ts) :) (dsDecls ds) 
+dsDecls (DBind bs : ds)         = do bs <- dsBinds bs
+                                     liftM (DBind bs :) (dsDecls ds)
+        
+
+dsConstr (Constr c ts ps)       = Constr c (map dsQualType ts) (map dsQual ps)
+
+dsSig (Sig vs t)                = Sig vs (dsQualType t)
+
+dsDefault (Default t a b)       = Default t a b
+dsDefault (Derive v t)          = Derive v (dsQualType t)
+
+-- Types ----------------------------------------------------------------------
+
+dsQualType (TQual t ps)         = checkQual (dsRhoType t) (map dsQual ps)
+dsQualType t                    = dsRhoType t
+
+dsRhoType (TFun ts t)           = TFun (map dsQualType ts) (dsRhoType t)
+dsRhoType t                     = dsType t
+
+dsType (TAp t t')               = TAp (dsType t) (dsType t')
+dsType (TFun ts t)              = TFun (map dsType ts) (dsType t)
+dsType (TList t)                = TAp (TCon (prim LIST)) (dsType t)
+dsType (TTup ts)                = foldl TAp (TCon (tuple (length ts))) (map dsType ts)
+dsType (TCon c)                 = TCon c
+dsType (TVar v)                 = TVar v
+dsType t                        = internalError "Bad type expressionin dsType" t
+
+
+-- Types with wildcards ---------------------------------------------------------------
+
+dsQualWildType (TQual t ps)     = checkQual (dsRhoWildType t) (map dsQual ps)
+dsQualWildType t                = TQual (dsRhoWildType t) []
+
+dsRhoWildType (TFun ts t)       = TFun (map dsQualWildType ts) (dsRhoWildType t)
+dsRhoWildType t                 = dsWildType t
+
+dsWildType (TAp t t')           = TAp (dsWildType t) (dsWildType t')
+dsWildType (TFun ts t)          = TFun (map dsWildType ts) (dsWildType t)
+dsWildType (TList t)            = TAp (TCon (prim LIST)) (dsWildType t)
+dsWildType (TTup ts)            = foldl TAp (TCon (tuple (length ts))) (map dsWildType ts)
+dsWildType (TCon c)             = TCon c
+dsWildType (TVar v)             = TVar v
+dsWildType (TWild)              = TWild
+dsWildType t                    = internalError "Bad type expression in dsWildType" t
+
+
+-- Base types -------------------------------------------------------------
+
+dsQualBaseType (TQual t ps)     = checkQual (dsBaseType t) (map dsKindQual ps)
+dsQualBaseType t                = TQual (dsBaseType t) []
+
+dsBaseType (TAp t t')           = TAp (dsBaseType t) (dsType t')
+dsBaseType (TList t)            = TAp (TCon (prim LIST)) (dsType t)
+dsBaseType (TCon c)             = TCon c
+dsBaseType t                    = internalError "Bad base type expression in dsBaseType" t
+
+
+-- Predicates ------------------------------------------------------------
+
+dsQual (PKind v k)              = PKind v k
+dsQual (PType (TVar v))         = PKind v KWild
+dsQual (PType t)                = PType (dsQualPred t)
+
+
+dsKindQual (PKind v k)          = PKind v k
+dsKindQual (PType (TVar v))     = PKind v KWild
+dsKindQual q                    = internalError "Bad qualifier in dsKindQual" q
+
+
+dsQualPred (TQual t ps)         = checkQual (dsSubOrClassPred t) (map dsQual ps)
+dsQualPred t                    = TQual (dsSubOrClassPred t) []
+
+dsSubOrClassPred (TSub t t')    = TSub (dsType t) (dsType t')
+dsSubOrClassPred t              = dsClassPred t
+
+dsClassPred (TAp t t')          = TAp (dsClassPred t) (dsType t')
+dsClassPred (TCon c)            = TCon c
+dsClassPred p                   = internalError "Bad class predicate in dsClassPred" p
+
+
+-- Bindings ---------------------------------------------------------------
+
+dsBinds []                      = return []
+dsBinds (BSig vs qt : bs)       = do bs <- dsBinds bs
+                                     return (BSig vs (dsQualWildType qt) : bs)
+dsBinds bs                      = f [] bs
+  where f eqns (BEqn lh rh :bs) = f ((lh,rh) : eqns) bs
+        f eqns bs               = do eqns <- dsEqns (reverse eqns)
+                                     bs <- dsBinds bs
+                                     return (map (uncurry BEqn) eqns ++ bs)
+
+
+-- Equations -----------------------------------------------------------------
+
+dsEqns []                       = return []
+dsEqns ((LPat p,RExp (EVar v)):eqns)
+                                = do p' <- dsPat p      -- Checks validity
+                                     sels <- mapM (sel (EVar v)) vs
+                                     dsEqns (sels ++ eqns)
+  where vs                      = pvars p
+        sel e0 v                = do es <- mapM (newEVarPos paramSym) vs
+                                     return (LFun v [], RExp (selectFrom e0 (vs `zip` es) p (EVar v)))
+dsEqns ((LPat p,rh):eqns)       = do v <- newNamePos patSym p
+                                     eqns <- dsEqns ((LPat p, RExp (EVar v)) : eqns)
+                                     e <- dsExp (rh2exp rh)
+                                     return ((LFun v [],RExp e) : eqns)
+dsEqns ((LFun v ps,rh):eqns)    = dsFunBind v [(ps,rh)] eqns
+
+
+dsFunBind v alts ((LFun v' ps,rh) : eqns)
+  | v' == v                     = dsFunBind v ((ps,rh) : alts) eqns
+dsFunBind v [(ps,RExp e)] eqns
+  | not (null ps)               = do e' <- dsExp (ELam ps e)
+                                     eqns <- dsEqns eqns
+                                     return ((LFun v [], RExp e') : eqns)
+dsFunBind v alts eqns
+  | length arities /= 1         = errorIds "Different arities for function" [v]
+  | otherwise                   = do ws <- newNamesPos paramSym (fst (head alts))
+                                     alts <- mapM dsA (reverse alts)
+                                     e <- pmc' ws alts
+                                     eqns <- dsEqns eqns 
+                                     return ((LFun v [], RExp (eLam (map EVar ws) e)) : eqns)
+  where arities                 = nub (map (length . fst) alts)
+        dsA (ps,rh)             = liftM2 (,) (mapM dsPat ps) (dsRh rh)
+
+
+-- Helper functions --------------------------------------------------
+
+checkQual t ps
+  | not (null ambig)            = errorIds "Ambiguous type scheme, orphans are" ambig
+  | otherwise                   = TQual t ps
+  where ambig                   = tvs_ps \\ (vclose tvss tvs)
+        tvs_ps                  = nub (concat tvss `intersect` bvs)
+        tvs                     = tyvars t
+        tvss                    = map tyvars ps
+        bvs                     = bvars ps
+
+
+zipSigs (v:vs) (ESig _ t : ps)  = ESig (EVar v) t : zipSigs vs ps
+zipSigs (v:vs) (p : ps)         = EVar v : zipSigs vs ps
+zipSigs _      _                = []
+
+rh2exp (RExp e)                 = e
+rh2exp (RWhere rh bs)           = ELet bs (rh2exp rh)
+rh2exp rh                       = ECase (ECon (prim UNITTERM)) [Alt (ECon (prim UNITTERM)) rh]
+
+selectFrom e0 s p e             = ECase e0 [Alt (subst s p) (RExp (subst s e))]
+
+
+-- Expressions --------------------------------------------------------
+
+
+dsExp (EAp e e')                = liftM2 EAp (dsExp e) (dsExp e')
+dsExp (ESig e qt)               = do x <- newNamePos tempSym e
+                                     dsExp (ELet [BSig [x] qt, BEqn (LFun x []) (RExp e)] (EVar x))
+dsExp (ELam ps e)            
+  | all isESigVar ps            = liftM2 ELam (mapM dsPat ps) (dsExp e)
+  | otherwise                   = do ps <- mapM dsPat ps
+                                     e <- dsExp e
+                                     ws <- newNamesPos paramSym ps
+                                     e' <- pmc' ws [(ps,RExp e)]
+                                     return (ELam (zipSigs ws ps) e')
+dsExp (ELet [BEqn (LPat p) rh] e)
+  | nonRecursive                = dsExp (ECase (rh2exp rh) [Alt p (RExp e)])
+  where nonRecursive            = not (any (`elem` evars rh) (pvars p))
+dsExp (ELet bs e)               = liftM2 ELet (dsBinds bs) (dsExp e)
+dsExp (EIf e e1 e2)             = dsExp (ECase e [Alt true  (RExp e1), Alt false (RExp e2)])
+dsExp (ESectR e op)             = dsExp (EAp (op2exp op) e)
+dsExp (ESectL op e)             = do x <- newEVarPos paramSym op
+                                     dsExp (ELam [x] (EAp (EAp (op2exp op) x) e))
+dsExp (ECase e alts)            = do e <- dsExp e
+                                     alts <- mapM dsA alts
+                                     pmc e alts
+  where dsA (Alt p rh)          = liftM2 Alt (dsPat p) (dsRh rh)
+dsExp (ESelect e s)             = liftM (flip ESelect s) (dsExp e)
+dsExp (ESel s)                  = do x <- newNamePos paramSym s
+                                     return (ELam [EVar x] (ESelect (EVar x) s))
+dsExp (EWild)                   = errorTree "Non-pattern use of wildcard variable" EWild
+dsExp (EVar v)                  = return (EVar v)
+dsExp (ECon c)                  = return (ECon c)
+dsExp (ELit l)                  = return (ELit l)
+dsExp (ERec m fs)               = liftM (ERec m) (mapM dsF fs)
+  where dsF (Field s e)         = liftM (Field s) (dsExp e)
+dsExp (EDo v t ss)              = liftM (EDo v (fmap dsWildType t)) (dsStmts False ss)
+dsExp (ETempl v t ss)           = liftM (ETempl v (fmap dsWildType t)) (dsStmts True ss)
+dsExp (EAct v ss)               = liftM (EAct v) (dsStmts False ss)
+dsExp (EReq v ss)               = liftM (EReq v) (dsStmts False ss)
+dsExp (EAfter e e')             = dsExp (EAp (EAp (EVar (prim After)) e) e')
+dsExp (EBefore e e')            = dsExp (EAp (EAp (EVar (prim Before)) e) e')
+dsExp (ETup es)                 = dsExp (foldl EAp (ECon (tuple (length es))) es)
+dsExp (EList es)                = dsExp (foldr cons nil es)
+dsExp (EComp e qs)              = do e <- comp2exp e qs nil
+                                     dsExp e
+
+
+-- List comprehensions --------------------------------------------------
+
+comp2exp e [] r                 = return (cons e r)
+comp2exp e (QExp e' : qs) r     = do e <- comp2exp e qs r
+                                     return (EIf e' e r)
+comp2exp e (QLet bs : qs) r     = do e <- comp2exp e qs r
+                                     return (ELet bs e)
+comp2exp e (QGen p e' : qs) r   = do f <- newNamePos functionSym p
+                                     x <- newEVarPos paramSym p
+                                     e <- comp2exp e qs (EAp (EVar f) x)
+                                     return (ELet (binds f x e) (EAp (EVar f) e'))
+  where binds f x e             = [BEqn (LFun f [nil]) (RExp r),
+                                   BEqn (LFun f [cons p x]) (RExp e)] ++ dflt f x
+        dflt f x | isEVar p     = []
+                 | otherwise    = [BEqn (LFun f [cons EWild x]) (RExp (EAp (EVar f) x))]
+
+
+-- Statements ------------------------------------------------------------
+
+dsStmts cl []                   = return []
+dsStmts cl (SBind [BEqn (LPat p) rh] : ss)
+  | not cl && nonRecursive      = do x <- newName tempSym
+                                     dsStmts cl [SExp (ECase (rh2exp rh) [Alt p (RExp (EDo (Just x) Nothing ss))])]
+  where nonRecursive            = not (any (`elem` evars rh) (pvars p))
+dsStmts cl (SBind bs : ss)      = do bs <- dsBinds bs
+                                     liftM (SBind bs :) (dsStmts cl ss)
+dsStmts cl [SRet e]             = do e <- dsExp e
+                                     return [SRet e]
+dsStmts cl [SExp e]             = do e <- dsExp e
+                                     return [SExp e]
+dsStmts cl (SGen p e : ss)
+  | isESigVar p                 = do p <- dsInnerPat p
+                                     e <- dsExp e
+                                     ss <- dsStmts cl ss
+                                     return (SGen p e : ss)
+  | otherwise                   = do v' <- newEVarPos tempSym p
+                                     dsStmts cl (SGen v' e : SBind [BEqn (LPat p) (RExp v')] : ss)
+dsStmts cl (s@(SAss p e) : ss)
+  | null vs                     = errorTree "Bad assignment" s
+  | not cl && p0 /= p           = errorTree "Illegal signature in assignment" s
+  | isESigVar p                 = do p <- dsPat p
+                                     e <- dsExp e
+                                     ss <- dsStmts cl ss
+                                     return (SAss p e : ss)
+  | otherwise                   = do v0 <- newNamePos tempSym p
+                                     assigns <- mapM (assign (EVar v0)) ps
+                                     dsStmts cl (SBind [BEqn (LFun v0 []) (RExp e)] : assigns ++ ss)
+  where assign e0 p             = do vs' <- newNamesPos paramSym vs
+                                     return (SAss p (selectFrom e0 (vs `zip` map EVar vs') p0 (unsig p)))
+        p0                      = unsig p
+        ps                      = sigvars p
+        vs                      = pvars ps
+dsStmts cl ss                   = internalError ("dsStmts; did not expect") ss
+
+unsig (ESig p _)                = unsig p
+unsig (ETup ps)                 = ETup (map unsig ps)
+unsig (EList ps)                = EList (map unsig ps)
+unsig (ERec m fs)               = ERec m [ Field l (unsig p) | Field l p <- fs ]
+unsig p                         = p
+
+sigvars (ETup ps)               = concatMap sigvars ps
+sigvars (EList ps)              = concatMap sigvars ps
+sigvars (ERec m fs)             = concat [ sigvars p | Field l p <- fs ]
+sigvars p
+  | isESigVar p                 = [p]
+  | otherwise                   = []
+
+
+-- Alternatives -----------------------------------------------------------------------
+
+dsRh (RExp e)                   = liftM RExp (dsExp e)
+dsRh (RGrd gs)                  = liftM RGrd (mapM dsGrd gs)
+dsRh (RWhere rh [BEqn (LPat p) rh'])
+  | nonRecursive                = liftM RExp (dsExp (ECase (rh2exp rh') [Alt p (RExp (rh2exp rh))]))
+  where nonRecursive            = not (any (`elem` evars rh') (pvars p))  
+dsRh (RWhere rh bs)             = liftM2 RWhere (dsRh rh) (dsBinds bs)
+
+dsGrd (GExp qs e)               = do qs <- mapM dsEQual qs
+                                     e <- dsExp e
+                                     return (GExp qs e)
+
+dsEQual (QExp e)                = do e <- dsExp e
+                                     return (QGen true e)
+dsEQual (QGen p e)              = do p <- dsPat p
+                                     e <- dsExp e
+                                     return (QGen p e)
+dsEQual (QLet [BEqn (LPat p) rh])
+  | nonRecursive                = do p <- dsPat p
+                                     e <- dsExp (rh2exp rh)
+                                     return (QGen p e)
+  where nonRecursive            = not (any (`elem` evars rh) (pvars p))  
+dsEQual (QLet bs)               = liftM QLet (dsBinds bs)
+
+
+-- Patterns ----------------------------------------------------------------------------
+
+dsPat (ESig p qt)
+  | isEVar p                    = do p <- dsPat p
+                                     return (ESig p (dsQualWildType qt))
+dsPat (EVar v)                  = return (EVar v)
+dsPat (EWild)                   = do v <- newName dummySym
+                                     return (EVar v)
+dsPat (ENeg (ELit (LInt p i)))  = return (ELit (LInt p (-i)))
+dsPat (ENeg (ELit (LRat p r)))  = return (ELit (LRat p (-r)))
+dsPat (ELit l)                  = return (ELit l)
+dsPat (ETup ps)                 = dsPat (foldl EAp (ECon (tuple (length ps))) ps)
+dsPat (EList ps)                = dsPat (foldr cons nil ps)
+dsPat (ERec m fs)               = liftM (ERec m) (mapM dsField fs)
+dsPat p                         = dsConPat p
+
+dsField (Field l p)             = liftM (Field l) (dsPat p)
+
+
+dsConPat (EAp p p')             = liftM2 EAp (dsConPat p) (dsInnerPat p')
+dsConPat (ECon c)               = return (ECon c)
+dsConPat p                      = errorTree "Illegal pattern" p
+
+dsInnerPat (ESig p t)
+  | isEVar p                    = do p <- dsPat p
+                                     return (ESig p (dsWildType t))
+dsInnerPat p                    = dsPat p
+
+
+-- Literals ------------------------------------------------------------------
+
+--dsLit (LStr (Just (l,c)) s)     = return (foldr cons nil (map mkLit (zipWith f s [c..])))
+--  where f s n                   = (s,Just (l,n))
+--        mkLit (c,p)             = (ELit (LChr p c))
+--dsLit l                         = return (ELit l)
+
+
diff --git a/src/Env.hs b/src/Env.hs
new file mode 100644
--- /dev/null
+++ b/src/Env.hs
@@ -0,0 +1,881 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
+
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Env where
+
+import PP
+import Common
+import Core
+
+
+
+data WGraph                             = WG  { nodes :: PEnv,
+                                                arcs  :: [(Name,Name)] 
+                                              }
+                                        deriving Show
+
+nameOf                                  = fst
+predOf                                  = snd
+
+--labelOf                                 = fst
+--witOf                                   = snd
+
+data Env = Env { kindEnv0      :: KEnv,              -- Kind for each global tycon
+                 kindEnv       :: KEnv,              -- Kind for each local skolemized tyvar
+                 typeEnv0      :: TEnv,              -- Type scheme for each top-level def (no free tyvars)
+                 typeEnv       :: TEnv,              -- Type scheme for each additional def
+                 predEnv0      :: PEnv,              -- Predicate scheme for each global witness def (no free tyvars)
+                 predEnv       :: PEnv,              -- Predicate scheme for each local witness abstraction
+
+                 tevars        :: [TVar],            -- The tvars free in typeEnv (cached)
+                 pevars        :: [TVar],            -- The tvars free in predEnv (cached)
+                 stateT        :: Maybe Type,        -- Type of current state scope (invariant: included in typeEnv as well)
+                 
+                 coercions     :: Eqns,              -- Defs of top-level subtype coercions
+
+                 aboveEnv      :: Map Name WGraph,   -- Overlap graph of all S > T for each T (closed under transitivity)
+                 belowEnv      :: Map Name WGraph,   -- Overlap graph of all S < T for each T (closed under transitivity)
+                 classEnv      :: Map Name WGraph,   -- Overlap graph of all instances for each type class (closed under subclassing)
+
+                 modName       :: Maybe String, 
+                 -- The following fields are only used during constraint reduction:
+                 history       :: [Pred],            -- Stack of predicates currently being reduced
+                 skolEnv       :: Map Name [TVar],   -- For each skolemized tyvar T: a list of free tvars not unifiable with T
+                 pols          :: ([TVar],[TVar]),   -- Pair of tvars occurring in (positive,negative) position in reduction target
+                 equalities    :: [(Name,Name)],     -- List of witness names that must be equivalent
+
+                 errPos        :: PosInfo, 
+                 ticked        :: Bool,              -- Root constraint is an automatically generated coercion (must be removed!)
+                 forced        :: Bool,              -- Non-conservative reduction turned on
+                 frozen        :: Bool               -- Treat tvars as constants (during env closure)       -- Not yet meaningful
+               }
+
+instance Show Env where
+    show env = "<env>"
+
+
+nullEnv                                 = Env { kindEnv0   = [],
+                                                kindEnv    = [],
+                                                typeEnv0   = [],
+                                                typeEnv    = [],
+                                                predEnv0   = [],
+                                                predEnv    = [],
+                                                tevars     = [],
+                                                pevars     = [],
+                                                stateT     = Nothing,
+                                                coercions  = [],
+                                                aboveEnv   = [],
+                                                belowEnv   = [],
+                                                classEnv   = [],
+                                                modName    = Nothing,
+                                                history    = [],
+                                                skolEnv    = [],
+                                                pols       = ([],[]),
+                                                equalities = [],
+                                                errPos     = Unknown,
+                                                ticked     = False,
+                                                forced     = False,
+                                                frozen     = False
+                                          }
+
+
+addTEnv0 te env                         = env { typeEnv0   = te ++ typeEnv0 env }
+
+addTEnv te env                          = env { typeEnv    = te ++ typeEnv env,
+                                                tevars     = tvs `union` tevars env }
+  where tvs                             = tvars te
+
+addKEnv0 ke env                         = env { kindEnv0   = ke ++ kindEnv0 env }
+
+addKEnv ke env                          = env { kindEnv    = ke ++ kindEnv env }
+
+
+addPEnv0 pe env                         = env { predEnv0    = pe ++ predEnv0 env }
+
+addPEnv pe env
+  | null (tvars pe)                     = env { predEnv    = pe ++ predEnv env }
+  | otherwise                           = internalError0 "Positive predicate with free variables (not yet implemented)"
+--                                        = env { predEnv    = pe ++ predEnv env,
+--                                                pevars     = nub (tvars pe `union` pevars env) }
+
+addClasses cs env                       = env { classEnv   = ce ++ classEnv env }
+  where ce                              = cs `zip` repeat nullWG
+
+setSelf x t env                         = env' { stateT = Just t }
+  where env'                            = addTEnv [(x,scheme (tRef t))] env
+
+addCoercions eqs env                    = env { coercions = filter (isCoercion . fst) eqs ++ coercions env }
+
+addSkolEnv se env                       = env { skolEnv  = se ++ skolEnv env }
+
+skolEnvs env cs                         = concat [ tvs | (c,tvs) <- skolEnv env, c `elem` cs ]
+
+tick env x                              = env { ticked = x }
+
+force env x                             = env { forced = x }
+
+freeze env                              = env { frozen = True }     -- Not yet meaningful
+
+thaw env                                = env { frozen = False }    -- Not yet meaningful
+
+target t env                            = env { pols = polvars env t `pcat` pols env }
+
+protect t env                           = env { pols = pdupl (tvars t) `pcat` pols env }
+
+addEqs eqs env                          = env { equalities = eqs ++ equalities env }
+
+setErrPos Unknown env                   = env
+setErrPos p env                         = env {errPos = p}
+
+insertClassPred pre n@(w,p) post env    = env { classEnv = insert c wg' (classEnv env) }
+  where c                               = headsym p
+        ws                              = repeat w
+        wg                              = findClass env c
+        wg'                             = WG { nodes = insertBefore n post (nodes wg),
+                                               arcs  = pre `zip` ws ++ ws `zip` post ++ arcs wg }
+
+insertDefault sigs d@(Default _ i1 i2) env
+  | c1 /= c2                            = errorTree ("Illegal defaulting; instances of different classes") d
+  | i1 `elem` post2                     = errorIds ("Cyclic default declarationsss for") [i1,i2]
+  | otherwise                           = env { classEnv = (c1,wg') : (delete c1 (classEnv env)) }
+  where p1                              = lookup' sigs i1
+        c1                              = headsym p1
+        c2                              = headsym (lookup' sigs i2)
+        WG ns as                        = findClass env c1
+        post2                           = [ j | (i,j) <- as, i == i2 ]
+        wg'                             = WG { nodes = insertBefore (i1,p1) (i2:post2) (delete i1 ns),
+                                               arcs  = (i1,i2) : (repeat i1 `zip` post2) ++ as }
+insertDefault _ _ env                   = env
+
+insertDefaults env sigs ds              = foldr (insertDefault sigs) env ds
+
+                                        
+insertSubPred n@(w,p) env               = env { aboveEnv = insert a wg_a (aboveEnv env),
+                                                belowEnv = insert b wg_b (belowEnv env) }
+  where (a,b)                           = subsyms p
+        ws                              = repeat w
+        wg_a                            = buildAbove (findAbove env a)
+        wg_b                            = buildBelow (findBelow env b)
+        
+        buildAbove wg                   = WG { nodes = insertBefore n post (nodes wg),
+                                               arcs  = pre `zip` ws ++ ws `zip` post ++ arcs wg }
+          where syms                    = mapSnd uppersym (nodes wg)
+                pre                     = [ w | (w,c) <- syms, hasCoercion env c b ]
+                post                    = [ w | (w,c) <- syms, hasCoercion env b c ]
+
+        buildBelow wg                   = WG { nodes = insertBefore n post (nodes wg),
+                                               arcs  = pre `zip` ws ++ ws `zip` post ++ arcs wg }
+          where syms                    = mapSnd lowersym (nodes wg)
+                pre                     = [ w | (w,c) <- syms, hasCoercion env a c ]
+                post                    = [ w | (w,c) <- syms, hasCoercion env c a ]
+        
+
+instance Subst WGraph TVar Type where
+    subst s (WG ns as)                  = WG (subst s ns) as
+
+
+instance Subst a TVar Type => Subst (Env,a) TVar Type where
+    subst s (env,p)                     = (subst s env, subst s p)
+
+
+instance Subst Env TVar Type where
+    subst [] env                        = env
+    subst s env
+      | null (pevars env)               = env'
+      | otherwise                       = env' { aboveEnv = subst s (aboveEnv env),
+                                                 belowEnv = subst s (belowEnv env),
+                                                 classEnv = subst s (classEnv env),
+                                                 predEnv  = subst s (predEnv env),
+                                                 pevars   = substT s (pevars env) }
+      where env'                        = env { {- typeEnv  = subst s (typeEnv env), -- redundant -}
+                                                 stateT = subst s (stateT env),
+                                                 tevars  = substT s (tevars env),
+                                                 pols = substP env s (pols env),
+                                                 skolEnv = mapSnd (substT s) (skolEnv env) }
+
+
+sapp s tvs                              = subst s (map TVar tvs)
+
+substT s tvs                            = tvars (sapp s tvs)
+
+substP env s (pvs,nvs)                  = polvars env (sapp s pvs) `pcat` pswap (polvars env (sapp s nvs))
+
+
+logHistory (env,c)                      = (env { history = c : history env }, c)
+
+conservative (env,c)                    = not (forced env)
+
+findKind0 ke (Tuple n _)                = tupleKind n
+findKind0 ke c                          = case lookup c ke of
+                                            Just k  -> k
+                                            Nothing -> Star  -- Hack!  This alternative is intended for the fresh type
+                                                             -- constants introduced when type-checking templates with 
+                                                             -- no explicit state type annotations.  The proper handling 
+                                                             -- of these names would be to thread an accumulating list 
+                                                             -- of generated type declarations through the type-checker
+                                                             -- instead, but (1) that would further complicate an already
+                                                             -- complex piece of software, and (2) these declarations 
+                                                             -- still cannot be made sufficiently polymorphic until the
+                                                             -- final substitution has been computed (i.e., after type-
+                                                             -- checking).  A more advanced alternative would be to in-
+                                                             -- troduce local type declarations to the language, although
+                                                             -- issue (2) above would still need to be handled separately.
+                                                             -- Considering that the Core2Kindle pass can generate correct
+                                                             -- Kindle types given only the generated type name and the 
+                                                             -- state variable annotations already present in template
+                                                             -- expressions, there is much merit to the shortcut implemented
+                                                             -- here.  Note also that unknown type constructor names have
+                                                             -- already been trapped and reported during renaming.
+                                                    -- error ("Internal: Unknown type constructor: " ++ show c)
+                                            
+findKind env c                          = findKind0 (kindEnv env ++ kindEnv0 env) c
+
+
+findType0 te (Tuple n _)                = tupleType n
+findType0 te v                          = case lookup v te of
+                                            Just sc -> sc
+                                            Nothing -> internalError0 ("Unknown identifier: " ++ show v)
+
+findType env v                         = findType0 (typeEnv env ++ typeEnv0 env) v
+
+
+findExplType env x
+  | explicit (annot x)                  = let Scheme t ps ke = findType env x in Scheme (tFun ps t) [] ke
+  | otherwise                           = findType env x
+  
+
+findPred env w                          = case lookup w (predEnv env ++ predEnv0 env) of
+                                            Just p  -> p
+                                            Nothing -> internalError0 ("Unknown witness identifier: " ++ show w)
+
+
+findAbove env c                         = case lookup c (aboveEnv env) of
+                                            Just wg -> wg
+                                            Nothing -> nullWG
+
+
+findBelow env c                         = case lookup c (belowEnv env) of
+                                            Just wg -> wg
+                                            Nothing -> nullWG
+
+
+findClass env c                         = case lookup c (classEnv env) of
+                                            Just wg -> wg
+                                            Nothing -> internalError0 ("Unknown class identifier: " ++ show c)
+
+
+
+findCoercion env a b
+  | a == b                              = Just reflAll
+  | otherwise                           = search (upperIs b) (nodes (findAbove env a))
+
+findCoercion' env a b                   = case findCoercion env a b of
+                                            Just n -> unitWG n
+                                            Nothing -> nullWG
+
+
+upperIs t (w,p)                         = uppersym p == t
+
+
+hasCoercion env a b                     = findCoercion env a b /= Nothing
+
+
+
+
+{-
+
+Embedding order:
+- T[a] < T[b],  a[x] < T[b], b[x] < T[x], a[x] < b[x]
+
+
+   X     Y
+    \   /
+     \ /
+ Z    Pt   C
+ |   / \   |
+ |  /   \  |
+ | /     \ |
+ ZPt     CPt
+   \     /
+    \   /
+    CZPt
+
+a->b  \\  a < Pt, a < b, CPt < b
+
+Pt->Pt,  CPt3->CPt,  CPt->CPt3,  CPt->CPt,  CPt->C
+
+Pt   b
+|  / |
+| /  |
+a   CPt
+
+a->b  \\  a < CPt, a < b, Pt < b
+
+CPt  b
+|  / |
+| /  |
+a    Pt
+
+T < Eq T, S < T, Eq a < Eq b \\ b < a  |-  x < Eq x
+
+
+-}
+
+
+
+
+findWG (RConCon i j)  (env,_)           = findCoercion' env i j
+findWG (ROrd _ Pos i) (env,_)           = addReflWG (findAbove env i)
+findWG (ROrd _ Neg i) (env,_)           = addReflWG (findBelow env i)
+findWG (RUnif)        (env,_)           = reflWG
+findWG (RInv _ Pos i) (env,_)           = concatWG reflWG (findAbove env i)
+findWG (RInv _ Neg i) (env,_)           = concatWG reflWG (findBelow env i)
+findWG (RClass _ i)   (env,_)           = lookup' (classEnv env) i
+
+
+addReflWG wg                            = WG { nodes = reflAll : nodes wg, 
+                                               arcs = (repeat (prim Refl) `zip` dom (nodes wg)) ++ arcs wg }
+                                               
+shrinkWG wg t                           = WG { nodes = filter (upperIs t) (nodes wg), arcs = [] }
+
+flattenWG wg                            = wg { arcs = [] }
+
+reflWG                                  = unitWG (reflAll)
+
+isNullWG wg                             = null (nodes wg)
+
+takeWG (WG (n:nodes) a)                 = (n, WG nodes a)
+takeWG _                                = internalError0 "takeWG: empty node list"
+
+concatWG wg1 wg2                        = WG { nodes = nodes wg1 ++ nodes wg2, arcs = [] }
+
+pruneWG w wg                            = wg { nodes = filter ((`notElem` ws) . fst) (nodes wg) }
+  where ws                              = [ w2 | (w1,w2) <- arcs wg, w1 == w ]
+
+unitWG n                                = WG { nodes = [n], arcs = [] }
+
+nullWG                                  = WG { nodes = [], arcs = [] }
+
+
+
+
+data Dir                                = Pos | Neg
+                                        deriving (Ord,Eq,Show)
+
+data Rank                               = RFun                  -- function type in either position, handle as a predicate scheme
+                                        | RConCon Name Name     -- con-con, only one solution possible (or failure!)
+                                        | ROrd    Int Dir Name  -- con-var, with gravity governed by var's position in target type
+                                        | RUnif                 -- var-var, unifiable (either safe or forced)
+                                        | RInv    Int Dir Name  -- con-var, requires unordered search 
+                                        | RClass  Int Name      -- class constraint, rank below all subpreds involving a tycon
+                                        | RVar                  -- var-var sub or var-only class, search not meaningful
+                                        deriving (Ord,Eq,Show)
+
+
+unique i []                             = Nothing
+unique i (g:gs)                         = case uniqueRank g of
+                                            Just r  -> Just (r,i)
+                                            Nothing -> unique (i+1) gs
+  where uniqueRank (_,TFun [l] u)       = uniqueRank' (tHead l) (tHead u)
+        uniqueRank (_,t)                = if null (tvars t) then Just (RClass 0 (tId (tHead t))) else Nothing
+        uniqueRank' (TFun _ _) (TFun _ _)
+                                        = Just RFun
+        uniqueRank' (TFun _ _) _        = Just RUnif
+        uniqueRank' _ (TFun _ _)        = Just RUnif
+        uniqueRank' (TId i) (TId j)     = Just (RConCon i j)
+        uniqueRank' _ _                 = Nothing
+
+
+rank info (env,TFun [l] u)              = subrank (tFlat l) (tFlat u)
+  where 
+    (emb,vs,lb,ub,lb',ub',pvs)          = info
+    approx                              = forced env                 -- solve subtype predicates at all costs
+    subrank (TFun _ _,_) (TFun _ _,_)   = RFun                       -- resubmit to predicate scheme reducer
+    subrank (TFun _ _, _) _             = RUnif
+    subrank _ (TFun _ _, _)             = RUnif
+    subrank (TId i,_) (TId j,_)         = RConCon i j                -- only one choice, highest rank
+    subrank (TId i,_) (TVar n,_)
+      | l==0 && b==0 && not (isNeg v)   = ROrd 0 Pos i               -- no embeddings, only constant bounds, right polarity
+      | approx && n `notElem` vs        = ROrd l Pos i               -- approximate in right direction if n not in environment
+      | otherwise                       = RInv l Pos i               -- otherwise rank below v-v unification (dir only for env lookup)
+      where l                           = length (filter (==n) emb)  -- # of embeddings of n
+            b                           = length (filter (==n) lb)   -- # of lower var bounds for n
+            v                           = polarity pvs n             -- polarity of n in target type
+    subrank (TVar n,_) (TId i,_)
+      | l==0 && b==0 && not (isPos v)   = ROrd 0 Neg i               -- no embeddings, only constant bounds, right polarity
+      | approx && n `notElem` vs        = ROrd l Neg i               -- approximate in right direction if n not in environment
+      | otherwise                       = RInv l Neg i               -- otherwise rank below v-v unification (dir only for env lookup)
+      where l                           = length (filter (==n) emb)  -- # of embeddings of n
+            b                           = length (filter (==n) ub)   -- # of upper var bounds for n
+            v                           = polarity pvs n             -- polarity of n in target type
+    subrank (TVar n,ts) (TVar n',ts')
+      | n == n'                         = RUnif     -- identical heads, and we only have invariant constructors
+      | l==0 && b==1 && null ts && not (isPos v)
+                                        = RUnif     -- no n embeddings, only one bound (here!), no variance problems, set n = upper bound
+      | l'==0 && b'==1 && null ts' && not (isNeg v')
+                                        = RUnif     -- no n' embeddings, only one bound (here!), no variance problems, set n' = lower bound
+      | approx                          = RUnif     -- eliminate var-to-var predicates early when approximating
+      | otherwise                       = RVar      -- just leave them be when in conservative mode
+      where l                           = length (filter (==n) emb)  -- # of embeddings of n
+            b                           = length (filter (==n) ub')  -- # of upper var OR con bounds for n
+            v                           = polarity pvs n             -- polarity of n in target type
+            l'                          = length (filter (==n') emb) -- # of embeddings of n'
+            b'                          = length (filter (==n') lb') -- # of lower var OR con bounds for n'
+            v'                          = polarity pvs n'            -- polarity of n' in target type
+rank info (env,t)
+  | all isTVar ts && not (forced env)   = RVar         -- trivial class predicate, just leave be when not approximating        
+  | otherwise                           = RClass i c   -- non-trivial class predicate, perform witness search
+  where (TId c,ts)                      = tFlat t
+        i                               = lookup' (dom (classEnv env) `zip` [0..]) c
+
+
+-- m x < n a b
+-- m in fv(env), T i < S i j, S i j < S i j, T i < T i
+-- s = [n a/m, b/x]
+-- n a c < T t
+-- m x < n a b, m x < T t
+{-
+instance Show ([TVar],[TVar],[TVar],[TVar],[TVar],[TVar],([TVar],[TVar])) where
+    show (emb,vs,lb,ub,lb',ub',pols)    = "emb = "  ++ show emb ++ "\n" ++
+                                          "vs = "   ++ show vs   ++ "\n" ++
+                                          "lb = "   ++ show lb   ++ "\n" ++
+                                          "ub = "   ++ show ub   ++ "\n" ++
+                                          "lb' = "  ++ show lb'  ++ "\n" ++
+                                          "ub' = "  ++ show ub'  ++ "\n" ++
+                                          "pols = (" ++ show (fst pols)   ++ "," ++ show (snd pols) ++ ")\n"
+-}
+varInfo gs                              = (emb, vs, lb, ub, lb', ub', polvs)
+  where (sPreds,cPreds)                 = partition isSub (map snd gs)
+        tts                             = map ((\(t1,t2) -> (tFlat t1, tFlat t2)) . subs) sPreds
+        lb                              = [ n | ((TVar _, _), (TVar n, _)) <- tts ]       -- all n with a lower var bound
+        ub                              = [ n | ((TVar n, _), (TVar _, _)) <- tts ]       -- all n with an upper var bound
+        lb'                             = [ n | (_, (TVar n, _)) <- tts ]                 -- all n with any lower bound
+        ub'                             = [ n | ((TVar n, _), _) <- tts ]                 -- all n with any upper bound
+        emb                             = concat (map (\((_,ts1),(_,ts2)) -> tvars (ts1++ts2)) tts) -- the vars inside type exps
+        vs                              = tevars env                                      -- the vars free in the environment
+        polvs                           = pnub (pols env `pcat` pdupl (vs++tvars cPreds)) -- target vars (positive & negative)
+        env                             = fst (head gs) -- arbitrary choice, but we only use info that must be equal in all gs
+
+
+
+-- Instantiation & generalization ----------------------------------------------------
+
+inst (Scheme t ps ke)           = do ts <- mapM newTVar ks
+                                     let s = vs `zip` ts
+                                     return (subst s t, subst s ps)
+  where (vs,ks)                 = unzip ke
+
+
+wildify ke pe                   = do ts <- mapM newTVar ks
+                                     return (subst (vs `zip` ts) pe)
+  where (vs,ks)                 = unzip ke
+
+
+saturate (t,ps) e               = do pe <- newEnvPos assumptionSym ps e
+                                     return (pe, t, eAp e (map EVar (dom pe)))
+
+
+instantiate sc e                = do r <- inst sc
+                                     saturate r e
+
+
+qual [] e sc                    = (e, sc)
+qual qe e (Scheme t [] ke)      = (ELam qe e, Scheme t (rng qe) ke)
+qual qe (ELam te e) (Scheme t ps ke)
+                                = (ELam (qe++te) e, Scheme t (rng qe ++ ps) ke)
+qual qe e (Scheme t ps ke)      = (ELam (qe++te) (EAp e (map EVar (dom te))), Scheme t (rng qe ++ ps) ke)
+  where te                      = abcSupply `zip` ps
+
+
+gen tvs0 sc@(Scheme t ps ke)    = do ids <- newNames tyvarSym (length tvs)
+                                     let s = tvs `zip` map TId ids
+                                         ke' = ids `zip` map tvKind tvs 
+                                     return (Scheme (subst s t) (subst s ps) (ke' ++ ke))
+  where tvs                     = nub (filter (`notElem` tvs0) (tvars t ++ tvars ps))
+
+genL tvs0 scs                   = do ids <- newNames tyvarSym (length tvs)
+                                     let s = tvs `zip` map TId ids
+                                         ke = ids `zip` map tvKind tvs
+                                         addQuant (Scheme t ps ke') = Scheme t ps (restrict ke (tyvars t) ++ ke')
+                                     return (map addQuant (subst s scs))
+  where tvs                     = nub (filter (`notElem` tvs0) (tvars scs))
+
+
+-- Variance ------------------------------------------------------------------
+
+polarity (pvs,nvs) tv                   = (tv `elem` pvs, tv `elem` nvs)
+
+isPos                                   = fst
+isNeg                                   = snd
+
+covariant                               = (True,False)
+contravariant                           = (False,True)
+invariant                               = (True,True)
+nonvariant                              = (False,False)
+
+pcat (p,n) (p',n')                      = (p++p', n++n')
+
+pswap (p,n)                             = (n, p)
+
+pdupl tvs                               = (tvs,tvs)
+
+pnub (p,n)                              = (nub p, nub n)
+
+
+class Polvars a where
+    polvars :: Env -> a -> ([TVar],[TVar])
+
+instance Polvars a => Polvars [a] where
+    polvars env []                      = ([],[])
+    polvars env (x:xs)                  = pcat (polvars env x) (polvars env xs)
+
+instance Polvars a => Polvars (Name,a) where
+    polvars env (_,t)                   = polvars env t
+
+instance Polvars Type where
+    polvars env t                       = polvars env (tFlat t)
+
+
+instance Polvars (Type,[Type]) where
+    polvars env (TFun ts t, [])         = polvars env t  `pcat` pswap (polvars env ts)
+    polvars env (TId c, ts)             = pdupl (tvars ts)
+      where k                           = findKind env c    -- Future work: let the result be determined by variances encoded in k
+    polvars env (TVar n, ts)            = ([n],[]) `pcat` pdupl (tvars ts)
+        
+instance Polvars Scheme where
+    polvars env (Scheme t ps ke)        = polvars env t `pcat` pdupl (tvars ps)
+
+instance Polvars Rho where
+    polvars env (R t)                   = polvars env t
+    polvars env (F sc rh)               = polvars env rh `pcat` pswap (polvars env sc)
+
+{-
+    T a a1 a2 a3 a4 < T a b1 b2 b3 b4 \\ a1<b1, b1<a1, a2<b2, b3<a3
+    
+    If  T t t1 t2 t3 t4 < T s s1 s2 s3 s4, where s,s1,s2,s3,s4 can have lower as well as upper bounds, then
+       t==s may have upper as well as lower bounds
+       t1 has an upper and a lower bound: [t1/a1,s1/b1](a1<b1, b1<a1) = t1<s1, s1<t1
+       t2 has an upper bound:             [t2/a2,s2/b2](a1<b2)        = t2<s2
+       t3 has a lower bound:              [t3/a3,s3/b3](b3<a3)        = s3<t3
+       t4 has no bounds:                  [t4/a4,s4/b4]()             = ()
+    
+    If  T s s1 s2 s3 s4 < T t t1 t2 t3 t4, where s,s1,s2,s3,s4 can have lower as well as upper bounds, then
+       t==s may have lower as well as upper bounds
+       t1 has a lower and an upper bound: [s1/a1,t1/t1](a1<b1, b1<a1) = s1<t1, t1<s1
+       t2 has a lower bound:              [s2/a2,t2/b2](a1<b2)        = s2<t2
+       t3 has an uooer bound:             [s3/a3,t3/b3](b3<a3)        = t3<s3
+       t4 has no bounds:                  [s4/a4,t4/b4]()             = ()
+    
+    +: a, a1, a2
+    -: a, a1, a3
+    (T t t1 t2 t3 t4) in + => (t,t1,t2) in +, (t,t1,t3) in -
+    (T t t1 t2 t3 t4( in - => (t,t1,t2) in -, (t,t1,t3) in +
+    
+-}
+
+-- Printing -------------------------------------------------------------------
+
+instance Pr Env where
+    pr env                      = vpr (kindEnv env) $$
+                                  vpr (aboveEnv env) $$
+                                  vpr (belowEnv env) $$
+                                  vpr (classEnv env) $$
+                                  vpr (typeEnv env) 
+
+instance Pr (Name,WGraph) where
+    pr (_, WG ns as)            = vpr ns $$ nest 4 (vpr as)
+
+instance Pr (Name,Name) where
+    pr (n,n')                   = prId n <+> text "<" <+> prId n'
+
+
+-- initEnv --------------------------------------------------------------------
+
+initEnv v               = nullEnv { kindEnv0 = primKindEnv,
+                                    typeEnv0 = primTypeEnv,
+                                    aboveEnv = primAboveEnv,
+                                    belowEnv = primBelowEnv,
+                                    classEnv = primClassEnv,
+                                    predEnv0 = primPredEnv,
+                                    modName  = Just (str v) }
+
+
+
+primKindEnv             = [ (prim Action,       Star),
+                            (prim Request,      KFun Star Star),
+                            (prim Class,        KFun Star Star),
+                            (prim Cmd,          KFun Star (KFun Star Star)),
+                                    
+                            (prim Msg,          Star),
+                            (prim Ref,          KFun Star Star),
+                            (prim PID,          Star),
+                            (prim PMC,          KFun Star Star),
+                            (prim Time,         Star),
+                                    
+                            (prim Int,          Star),
+                            (prim Float,        Star),
+                            (prim Char,         Star),
+                            (prim Bool,         Star),
+
+                            (prim Array,        KFun Star Star),
+
+                            (prim LIST,         KFun Star Star),
+                            (prim EITHER,       KFun Star (KFun Star Star)),
+                            (prim UNITTYPE,     Star),
+                            (prim TIMERTYPE,    Star) ]
+
+
+primTypeEnv             = [ (prim UNITTERM,     scheme0 [] tUnit),
+                            (prim NIL,          scheme1 [] (tList a)),
+                            (prim CONS,         scheme1 [a,tList a] (tList a)),
+
+                            (prim FALSE,        scheme0 [] tBool),
+                            (prim TRUE,         scheme0 [] tBool),
+                            (prim LEFT,         scheme2 [a] (tEither a b)),
+                            (prim RIGHT,        scheme2 [b] (tEither a b)),
+
+                            (prim Refl,         scheme1 [a] a),
+
+                            (prim ActToCmd,     scheme1 [tAction] (tCmd a tMsg)),
+                            (prim ReqToCmd,     scheme2 [tRequest a] (tCmd b a)),
+                            (prim RefToPID,     scheme1 [tRef a] tPID),
+
+                            (prim IntPlus,      scheme0 [tInt,tInt] tInt),
+                            (prim IntMinus,     scheme0 [tInt,tInt] tInt),
+                            (prim IntTimes,     scheme0 [tInt,tInt] tInt),
+                            (prim IntDiv,       scheme0 [tInt,tInt] tInt),
+                            (prim IntMod,       scheme0 [tInt,tInt] tInt),
+                            (prim IntNeg,       scheme0 [tInt] tInt),
+
+                            (prim IntEQ,        scheme0 [tInt,tInt] tBool),
+                            (prim IntNE,        scheme0 [tInt,tInt] tBool),
+                            (prim IntLT,        scheme0 [tInt,tInt] tBool),
+                            (prim IntLE,        scheme0 [tInt,tInt] tBool),
+                            (prim IntGE,        scheme0 [tInt,tInt] tBool),
+                            (prim IntGT,        scheme0 [tInt,tInt] tBool),
+
+                            (prim FloatPlus,    scheme0 [tFloat,tFloat] tFloat),
+                            (prim FloatMinus,   scheme0 [tFloat,tFloat] tFloat),
+                            (prim FloatTimes,   scheme0 [tFloat,tFloat] tFloat),
+                            (prim FloatDiv,     scheme0 [tFloat,tFloat] tFloat),
+                            (prim FloatNeg,     scheme0 [tFloat] tFloat),
+
+                            (prim FloatEQ,      scheme0 [tFloat,tFloat] tBool),
+                            (prim FloatNE,      scheme0 [tFloat,tFloat] tBool),
+                            (prim FloatLT,      scheme0 [tFloat,tFloat] tBool),
+                            (prim FloatLE,      scheme0 [tFloat,tFloat] tBool),
+                            (prim FloatGE,      scheme0 [tFloat,tFloat] tBool),
+                            (prim FloatGT,      scheme0 [tFloat,tFloat] tBool),
+
+                            (prim IntToFloat,   scheme0 [tInt] tFloat),
+                            (prim FloatToInt,   scheme0 [tFloat] tInt),
+
+                            (prim CharToInt,    scheme0 [tChar] tInt),
+                            (prim IntToChar,    scheme0 [tInt] tChar),
+
+                            (prim BITS8ToInt,   scheme0 [tBITS8] tInt),
+                            (prim BITS16ToInt,  scheme0 [tBITS16] tInt),
+                            (prim BITS32ToInt,  scheme0 [tBITS32] tInt),
+                            
+                            (prim IntToBITS8,   scheme0 [tInt] tBITS8),
+                            (prim IntToBITS16,  scheme0 [tInt] tBITS16),
+                            (prim IntToBITS32,  scheme0 [tInt] tBITS32),
+                            
+                            (prim LazyOr,       scheme0 [tBool,tBool] tBool),
+                            (prim LazyAnd,      scheme0 [tBool,tBool] tBool),
+
+                            (prim PidEQ,        scheme0 [tPID,tPID] tBool),
+                            (prim PidNE,        scheme0 [tPID,tPID] tBool),
+
+                            (prim Sec,          scheme0 [tInt] tTime),
+                            (prim Millisec,     scheme0 [tInt] tTime),
+                            (prim Microsec,     scheme0 [tInt] tTime),
+                            (prim Nanosec,      scheme0 [tInt] tTime),
+                            (prim Infinity,     scheme0 [] tTime),
+
+                            (prim Sqrt,         scheme0 [tFloat] tFloat),
+                            (prim Log,          scheme0 [tFloat] tFloat),
+                            (prim Log10,        scheme0 [tFloat] tFloat),
+                            (prim Exp,          scheme0 [tFloat] tFloat),
+                            (prim Sin,          scheme0 [tFloat] tFloat),
+                            (prim Cos,          scheme0 [tFloat] tFloat),
+                            (prim Tan,          scheme0 [tFloat] tFloat),
+                            (prim Asin,         scheme0 [tFloat] tFloat),
+                            (prim Acos,         scheme0 [tFloat] tFloat),
+                            (prim Atan,         scheme0 [tFloat] tFloat),
+                            (prim Sinh,         scheme0 [tFloat] tFloat),
+                            (prim Cosh,         scheme0 [tFloat] tFloat),
+                            (prim ShowFloat,    scheme0 [tFloat] (tList tChar)),
+                                
+                            (prim TimePlus,     scheme0 [tTime,tTime] tTime),
+                            (prim TimeMinus,    scheme0 [tTime,tTime] tTime),
+                            (prim TimeMin,      scheme0 [tTime,tTime] tTime),
+                                
+                            (prim TimeEQ,       scheme0 [tTime,tTime] tBool),
+                            (prim TimeNE,       scheme0 [tTime,tTime] tBool),
+                            (prim TimeLT,       scheme0 [tTime,tTime] tBool),
+                            (prim TimeLE,       scheme0 [tTime,tTime] tBool),
+                            (prim TimeGE,       scheme0 [tTime,tTime] tBool),
+                            (prim TimeGT,       scheme0 [tTime,tTime] tBool),
+
+                            (prim Raise,        scheme1 [tInt] a),          -- temporary
+                            (prim Catch,        scheme0 [] tUnit),          -- temporary
+                            
+                            (prim TIMERTERM,    scheme0 [] (tClass tTimer)),
+                            (prim Reset,        Scheme (R (tRequest tUnit)) [Scheme (R tTimer) [] []] []),
+                            (prim Sample,       Scheme (R (tRequest tTime)) [Scheme (R tTimer) [] []] []),
+                            (prim Sec,          scheme0 [tInt] tTime),
+                            (prim Millisec,     scheme0 [tInt] tTime),
+                            (prim Microsec,     scheme0 [tInt] tTime),
+                            (prim Nanosec,      scheme0 [tInt] tTime),
+                            (prim SecOf,        scheme0 [tTime] tInt),
+                            (prim MicrosecOf,   scheme0 [tTime] tInt),
+                            
+                            (prim NOT8,         scheme0 [tBITS8] tBITS8),
+                            (prim AND8,         scheme0 [tBITS8,tBITS8] tBITS8),
+                            (prim OR8,          scheme0 [tBITS8,tBITS8] tBITS8),
+                            (prim EXOR8,        scheme0 [tBITS8,tBITS8] tBITS8),
+                            (prim SHIFTL8,      scheme0 [tBITS8,tInt] tBITS8),
+                            (prim SHIFTR8,      scheme0 [tBITS8,tInt] tBITS8),
+                            (prim SHIFTRA8,     scheme0 [tBITS8,tInt] tBITS8),
+                            (prim SET8,         scheme0 [tBITS8,tInt] tBITS8),
+                            (prim CLR8,         scheme0 [tBITS8,tInt] tBITS8),
+                            (prim TST8,         scheme0 [tBITS8,tInt] tBool),
+                            
+                            (prim NOT16,        scheme0 [tBITS16] tBITS16),
+                            (prim AND16,        scheme0 [tBITS16,tBITS16] tBITS16),
+                            (prim OR16,         scheme0 [tBITS16,tBITS16] tBITS16),
+                            (prim EXOR16,       scheme0 [tBITS16,tBITS16] tBITS16),
+                            (prim SHIFTL16,     scheme0 [tBITS16,tInt] tBITS16),
+                            (prim SHIFTR16,     scheme0 [tBITS16,tInt] tBITS16),
+                            (prim SHIFTRA16,    scheme0 [tBITS16,tInt] tBITS16),
+                            (prim SET16,        scheme0 [tBITS16,tInt] tBITS16),
+                            (prim CLR16,        scheme0 [tBITS16,tInt] tBITS16),
+                            (prim TST16,        scheme0 [tBITS16,tInt] tBool),
+                            
+                            (prim NOT32,        scheme0 [tBITS32] tBITS32),
+                            (prim AND32,        scheme0 [tBITS32,tBITS32] tBITS32),
+                            (prim OR32,         scheme0 [tBITS32,tBITS32] tBITS32),
+                            (prim EXOR32,       scheme0 [tBITS32,tBITS32] tBITS32),
+                            (prim SHIFTL32,     scheme0 [tBITS32,tInt] tBITS32),
+                            (prim SHIFTR32,     scheme0 [tBITS32,tInt] tBITS32),
+                            (prim SHIFTRA32,    scheme0 [tBITS32,tInt] tBITS32),
+                            (prim SET32,        scheme0 [tBITS32,tInt] tBITS32),
+                            (prim CLR32,        scheme0 [tBITS32,tInt] tBITS32),
+                            (prim TST32,        scheme0 [tBITS32,tInt] tBool),
+                            
+                            (prim ListArray,    scheme1 [tList a] (tArray a)),
+                            (prim UniArray,     scheme1 [tInt, a] (tArray a)),
+                            (prim SizeArray,    scheme1 [tArray a] tInt),
+                            (prim IndexArray,   scheme1 [tArray a, tInt] a),
+                            (prim UpdateArray,  scheme1 [tArray a, tInt, a] (tArray a)),
+
+                            (prim Abort,        scheme1 [tMsg] (tCmd a tUnit)),
+
+                            (prim Fail,         scheme1 [] (tPMC a)),
+                            (prim Commit,       scheme1 [a] (tPMC a)),
+                            (prim Match,        scheme1 [tPMC a] a),
+                            (prim Fatbar,       scheme1 [tPMC a, tPMC a] (tPMC a)),
+
+                            (prim After,        scheme0 [tTime,tAction] tAction),
+                            (prim Before,       scheme0 [tTime,tAction] tAction),
+
+                            (prim New,          scheme1 [tClass a] a)
+                            
+                          ]
+
+primTypeEnv1            =   (prim Inherit,      scheme0 [] tTime) : primTypeEnv
+
+tAction                 = TId (prim Action)
+tRequest a              = TAp (TId (prim Request)) a
+tClass a                = TAp (TId (prim Class)) a
+tCmd a b                = TAp (TAp (TId (prim Cmd)) a) b
+tTime                   = TId (prim Time)
+tMsg                    = TId (prim Msg)
+tRef a                  = TAp (TId (prim Ref)) a
+tPID                    = TId (prim PID)
+tPMC a                  = TAp (TId (prim PMC)) a
+tInt                    = TId (prim Int)
+tFloat                  = TId (prim Float)
+tChar                   = TId (prim Char)
+tBool                   = TId (prim Bool)
+tArray a                = TAp (TId (prim Array)) a
+tList a                 = TAp (TId (prim LIST)) a
+tUnit                   = TId (prim UNITTYPE)
+tEither a b             = TAp (TAp (TId (prim EITHER)) a) b
+tTimer                  = TId (prim TIMERTYPE)
+tBITS8                  = TId (prim BITS8)
+tBITS16                 = TId (prim BITS16)
+tBITS32                 = TId (prim BITS32)
+        
+a                       = TId (name0 "a")
+b                       = TId (name0 "b")
+        
+scheme0 ts t            = Scheme (mkRho ts t) [] []
+scheme1 ts t            = Scheme (mkRho ts t) [] [(name0 "a",Star)]
+scheme2 ts t            = Scheme (mkRho ts t) [] [(name0 "a",Star),(name0 "b",Star)]
+
+mkRho [] t              = R t
+mkRho ts t              = F (map scheme ts) (R t)
+
+primAboveEnv    = [ (prim Action,   unitWG subActCmd),
+                    (prim Request,  unitWG subReqCmd),
+                    (prim Cmd,      nullWG),
+                    (prim Ref,      unitWG subRefPID),
+                    (prim PID,      nullWG)
+                  ]
+
+primBelowEnv    = [ (prim Action,   nullWG),
+                    (prim Request,  nullWG),
+                    (prim Class,    nullWG),
+                    (prim Cmd,      WG [subActCmd,subReqCmd] []),
+                    (prim Ref,      nullWG),
+                    (prim PID,      unitWG subRefPID)
+                  ]
+
+
+reflAll         = (prim Refl,       scheme1 [] (a `sub` a))
+
+subActCmd       = (prim ActToCmd,   scheme1 [] (tAction `sub` tCmd a tMsg))
+
+subReqCmd       = (prim ReqToCmd,   scheme2 [] (tRequest a `sub` tCmd b a))
+
+subRefPID       = (prim RefToPID,   scheme1 [] (tRef a `sub` tPID))
+
+
+primPredEnv     = [reflAll, subActCmd, subReqCmd, subRefPID]
+
+
+primClassEnv    = []
diff --git a/src/Execution.hs b/src/Execution.hs
new file mode 100644
--- /dev/null
+++ b/src/Execution.hs
@@ -0,0 +1,119 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+--------------------------------------------------------------------------
+--
+-- Execution control.
+--
+-- This module contains an interface to the backend and functions to
+-- control the execution of the compiler. 
+--
+---------------------------------------------------------------------------
+
+module Execution (
+                  abortCompiler,
+                  stopCompiler,
+                  compileC,
+                  linkO,
+                 ) where
+    
+import System                 (system, exitWith, ExitCode(..))
+import qualified Monad
+import qualified Directory
+import Common
+
+-- Timber compiler
+import Config
+import Name
+
+
+-- | Compile a C-file. 
+compileC cfg clo c_file = do
+                             let cmd = cCompiler cfg
+                                     ++ " -c " ++ compileFlags cfg
+                                     ++ " -I " ++ libDir clo ++ " " 
+                                     ++ " -I " ++ includeDir clo ++ " " 
+                                     ++ " -I " ++ rtsDir clo ++ " " 
+                                     ++ " -I . "
+                                     ++ c_file
+                                 o_file = rmSuffix ".c" (rmDirs c_file) ++ ".o"
+                             res <- checkUpToDate c_file o_file
+                             if not res then do
+                                putStrLn ("[compiling "++c_file++"]")
+                                execCmd clo cmd
+                              else return ()
+  where checkUpToDate c_file o_file
+                        = do o_exists <- Directory.doesFileExist o_file
+                             if not o_exists then
+                                return False
+                               else do
+                                 c_time  <- Directory.getModificationTime c_file
+                                 o_time  <- Directory.getModificationTime o_file
+                                 return (c_time <= o_time)
+
+-- | Link together a bunch of object files.
+linkO cfg clo r o_files = do let Just rmod  = fromMod r
+                                 rootId     = name2str r
+                                 initId     = "_init_" ++ map f rmod
+                                 f '\''     = '_'
+                                 f c        = c
+                             let cmd = cCompiler cfg
+                                       ++ linkFlags cfg
+                                       ++ compileFlags cfg
+                                       ++ " -o " ++ outfile clo ++ " "
+                                       ++ unwords o_files ++ " "
+                                       ++ " -L" ++ rtsDir clo ++ " " 
+                                       ++ " -I" ++ includeDir clo ++ " " 
+                                       ++ " -I" ++ libDir clo ++ " " 
+                                       ++ " -I " ++ rtsDir clo ++ " " 
+                                       ++ " -DROOT=" ++ rootId ++ " "
+                                       ++ " -DROOTINIT=" ++ initId ++ " "
+                                       ++ rtsMain clo 
+                                       ++ " -lTimber"
+                             putStrLn "[linking]"
+                             execCmd clo cmd
+
+
+-- | Return with exit code /= 0
+abortCompiler         = exitWith (ExitFailure 1)
+
+-- | Return with exit code == 0
+stopCompiler          = exitWith (ExitSuccess)
+
+execCmd clo cmd       = do Monad.when (isVerbose clo)
+                                    (putStrLn ("exec: " ++ show cmd))
+                           exitCode <- system $ cmd     
+                           case exitCode of
+                             ExitSuccess -> return ()
+                             _           -> stopCompiler
+
diff --git a/src/Fixity.hs b/src/Fixity.hs
new file mode 100644
--- /dev/null
+++ b/src/Fixity.hs
@@ -0,0 +1,110 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Fixity where
+
+import Common
+import Syntax
+import List(sort)
+
+type Precedence         = Int
+data Associativity      = LeftAss | RightAss | NonAss deriving (Eq,Show)
+
+data Fixity             = Fixity Associativity Precedence deriving (Eq,Show)
+
+data OpExp              = Nil Exp | Cons OpExp Name Exp 
+
+fixity :: String -> Fixity
+fixity op               = case lookup op fixTable of
+                            Just f  -> f
+                            Nothing -> fixFromChars op
+  where fixTable        = [(":",  Fixity RightAss 5),
+                           ("++", Fixity RightAss 5),
+                           ("+",  Fixity LeftAss  6),
+                           ("-",  Fixity LeftAss  6),
+                           ("*",  Fixity LeftAss  7),
+                           ("/",  Fixity LeftAss  7),
+                           ("div",Fixity LeftAss  7),
+                           ("mod",Fixity LeftAss  7),
+                           ("@",  Fixity RightAss 9),
+                           ("^",  Fixity RightAss 8),
+                           ("==", Fixity NonAss   4),
+                           ("/=", Fixity NonAss   4),
+                           ("<",  Fixity NonAss   4),
+                           ("<=", Fixity NonAss   4),
+                           (">",  Fixity NonAss   4),
+                           (">=", Fixity NonAss   4),
+                           ("&&", Fixity RightAss 3),
+                           ("||", Fixity RightAss 2),
+                           (">>", Fixity LeftAss  1),
+                           (">>=",Fixity LeftAss  1),
+                           ("$",  Fixity RightAss 0)
+                          ]
+        fixFromChars op = case sort (nub (intersect op "+-*/<>")) of
+                            "+"  -> Fixity LeftAss 6
+                            "-"  -> Fixity LeftAss 6
+                            "+-" -> Fixity LeftAss 6
+                            "*"  -> Fixity LeftAss 7
+                            "/"  -> Fixity LeftAss 7
+                            "*/" -> Fixity LeftAss 7
+                            "<"  -> Fixity NonAss  4
+                            ">"  -> Fixity NonAss  4
+                            "<>" -> Fixity NonAss  4
+                            _    -> Fixity LeftAss 9
+
+{-
+Transforms a tree of infix expressions as produced by the parser 
+(i.e., with all operators treated as left associative and of equal precedence) 
+to a new tree reflecting operator associativity and precedence as given by
+the function fixity.
+
+Invariant: at each call to push, the second and third arguments have
+the same length.
+-}
+
+transFix :: OpExp -> Exp
+transFix e                          = push e [] []
+  where push (Cons l o r) (o':os) es
+          | prec==prec' && (ass/=ass' || ass==NonAss)
+                                    = errorIds "Operator associativity ambiguity with operators" [o,o']
+          | prec<prec' || (prec==prec' && ass==RightAss)
+                                    = push (Cons l o (opApp r o' (head es))) os (tail es)
+          where Fixity ass  prec    = fixity (show o)
+                Fixity ass' prec'   = fixity (show o')
+        push (Cons l o r) os es     = push l (o:os) (r:es)
+        push (Nil e) os es          = popAll os (e:es)
+        opApp l o r                 = EAp (EAp (op2exp o) l) r
+         
+        popAll (o:os) (e1:e2:es)    = popAll os (opApp e1 o e2:es)
+        popAll [] es                = head es
+        
diff --git a/src/Interfaces.hs b/src/Interfaces.hs
new file mode 100644
--- /dev/null
+++ b/src/Interfaces.hs
@@ -0,0 +1,270 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Interfaces where
+
+import Common
+import List (isPrefixOf)
+import Data.Binary
+import Rename 
+import Core
+import qualified Syntax
+import Decls
+import PP
+import qualified Core2Kindle 
+import qualified Kindle 
+import Termred
+import qualified Config
+import System
+import Codec.Compression.BZip 
+import qualified Data.ByteString.Lazy
+import Directory
+
+decodeCFile ti_file     = do str <- Data.ByteString.Lazy.readFile ti_file
+                             return(decode(decompress str)) 
+
+encodeCFile ti_file ifc =  Data.ByteString.Lazy.writeFile ti_file (compress(encode ifc))
+
+{-
+Reading/writing ti files without compression.
+
+decodeCFile ti_file     = decodeFile ti_file
+
+encodeCFile ti_file ifc = encodeFile ti_file ifc
+-}
+
+-- Data type of interface file -----------------------------------------------
+
+data IFace = IFace { impsOf      :: [(Bool,Name)],                         -- imported/used modules
+                     defaults    :: [Default Scheme],               -- exported default declarations
+                     recordEnv   :: Map Name [Name],                -- exported record types and their selectors,
+                     tsynEnv     :: Map Name ([Name],Syntax.Type),  -- type synonyms
+                     tEnv        :: Types,                          -- Core type environment
+                     insts       :: [Name],                         -- types for instances
+                     valEnv      :: Binds,                          -- types for exported values (including sels and cons) and some finite eqns
+                     kdeclEnv    :: Kindle.Decls                    -- Kindle form of declarations
+                   }
+           deriving (Show)
+
+-- Building interface info from data collected during compilation of a module ---------------------------------
+{-
+Input to ifaceMod is
+      - from Desugar1: exported record types with their selectors and exported type synomyms.
+      - from Termred: the entire module in Core form after term reduction
+      - from Core2Kindle: declarations in Kindle form.
+The function checks that the public part is closed (does not mention private data) and computes
+the IFace.
+-}
+ 
+ifaceMod                   :: (Map Name [Name], Map Name ([Name], Syntax.Type)) -> Module -> Kindle.Decls -> IFace
+ifaceMod (rs,ss) (Module _ ns xs ds ws bss) kds
+   | not(null vis)                   = errorIds "Private types visible in interface" vis
+   | not(null ys)                    = errorTree "Public default declaration mentions private instance" (head ys)
+   | otherwise                       = IFace ns xs' rs ss ds1 ws bs' kds
+  where Types ke te                  = ds
+        Binds r2 ts2 es2             = concatBinds bss
+        xs'                          = [d | d@(Default True _ _) <- xs]
+        ys                           = [d | d@(Default _ i1 i2) <- xs', isPrivate i1 || isPrivate i2 ]
+        ds1                          = Types (filter exported ke) (filter exported' te)
+        bs'                          = Binds r2 (filter exported ts2) (filter (\ eqn -> fin eqn &&  exported eqn) (erase es2))
+        vis                          = nub (localTypes [] (rng (tsigsOf bs')))
+        exported (n,_)               = isQualified n
+        exported' p@(n,_)            = isQualified n && (not(isAbstract p)) --Constructors/selectors are exported
+        fin (_,e)                    = isFinite e && null(filter isPrivate (constrs e))
+
+isPrivate nm@(Name _ _ _ _)          = not(isQualified nm)
+isPrivate _                          = False
+
+isAbstract (_,DData _ _ ((c,_):_))   = isPrivate c
+isAbstract (_,DRec _ _ _ ((c,_):_))  = isPrivate c
+isAbstract (_,_)                     = False     -- this makes abstract types without selectors/constructors non-private...
+
+
+
+-- Building environments in which to compile the current module -----------------------------------------------
+{- 
+   Input to initEnvs is a map as built by chaseIFaceFiles;
+   output is four tuples of data suitable for various compiler passes.
+-}
+type ImportInfo a                     =  (Bool, a)
+
+
+type Desugar1Env     = (Map Name [Name], Map Name Name, Map Name ([Name], Syntax.Type))
+type RenameEnv       = (Map Name Name, Map Name Name, Map Name Name)
+type CheckEnv        = ([Default Scheme], Types, [Name], Binds)
+type KindleEnv       = Map Name Kindle.Decl
+
+initEnvs             :: Map a (ImportInfo IFace) -> M s (Desugar1Env, RenameEnv, CheckEnv, KindleEnv)
+initEnvs bms         = do ims <- mapM (mkEnv . snd) bms
+                          let (rs,xs,ss,rnL,rnT,rnE,ds,ws,bs,kds) 
+                               = foldr mergeMod ([],[],[],[],[],[],Types [] [],[],Binds False [] [],[]) ims
+                          return ((rs,rnL,ss),(rnL,rnT,rnE),(xs,ds,ws,bs),kds)
+
+  where mergeMod (rs1,xs1,ss1,rnL1,rnT1,rnE1,ds1,ws1,bs1,kds1)
+                 (rs2,xs2,ss2,rnL2,rnT2,rnE2,ds2,ws2,bs2,kds2) 
+                                     = (rs1 ++ rs2, xs1 ++ xs2, ss1 ++ ss2, mergeRenamings2 rnL1 rnL2, 
+                                       mergeRenamings2 rnT1 rnT2, mergeRenamings2 rnE1 rnE2,
+                                       catDecls ds1 ds2, ws1++ws2, catBinds bs1 bs2,
+                                       kds1 ++ kds2)
+
+        mkEnv (unQual,IFace ns xs rs ss ds ws bs kds)
+                                     = do ks  <- renaming (dom ke)
+                                          ts  <- renaming (dom te'')
+                                          ls' <- renaming ls -- (concatMap snd rs)
+                                          return (unMod unQual rs, xs, unMod unQual ss, unMod unQual ls',unMod unQual ks,
+                                                  unMod unQual ts,ds,ws,Binds r te' es,kds)
+          where Types ke ds'         = ds
+                Binds r te es        = bs
+                te'                  = te ++ concatMap (tenvSelCon ke) ds'
+                te''                 = te  ++ concatMap (tenvCon ke) ds'
+                ls                   = [ s | (_,DRec _ _ _ cs) <- ds', (s,_) <- cs, not (isGenerated s) ]
+                unMod b ps           = if b then [(tag0 (dropMod c),y) | (c,y) <- ps] ++ ps else ps
+
+-- Checking that public part is closed ---------------------------------------------------------
+
+class LocalTypes a where 
+  localTypes :: [Name] -> a -> [Name]
+
+instance LocalTypes a => LocalTypes [a] where
+  localTypes ns ds                = concatMap (localTypes ns) ds
+
+instance LocalTypes b => LocalTypes (a,b) where
+  localTypes ns (a,b)             = localTypes ns b
+
+instance LocalTypes Scheme where
+  localTypes ns (Scheme r ps ke)  = localTypes ns1 r ++ localTypes ns1 ps
+    where ns1                     = ns ++ dom ke
+
+instance LocalTypes Rho where
+  localTypes ns (R t)             = localTypes ns t
+  localTypes ns (F ss r)          = localTypes ns ss ++ localTypes ns r
+
+instance LocalTypes Type where
+  localTypes ns (TId n) 
+     | n `elem` ns || not (isPrivate n) = []
+     | otherwise                  = [n]
+  localTypes _ (TVar t)           = internalError0 ("ChaseImports.localTypes: TVar in interface file")
+  localTypes ns (TFun ts t)       = localTypes ns (t : ts)
+  localTypes ns (TAp t1 t2)       = localTypes ns [t1, t2]
+
+instance LocalTypes Decl where
+  localTypes ns (DData vs ps cs)  = localTypes ns1 ps ++ localTypes ns1 cs
+    where ns1                     = ns ++ vs
+  localTypes ns (DRec _ vs ps ss) = localTypes ns1 ps ++ localTypes ns1 ss
+    where ns1                     = ns ++ vs
+  localTypes ns (DType vs t)      = localTypes (ns ++ vs) t
+
+instance LocalTypes Constr where
+  localTypes ns (Constr ts ps ke) = localTypes ns1 ts ++ localTypes ns1 ps
+    where ns1                     = ns ++ dom ke
+       
+-- Binary -------------------------------------------------------------------------------
+
+instance Binary IFace  where
+  put (IFace a b c d e f g h) = put a >> put b >> put c >> put d >> put e >> put f >> put g >> put h
+  get = get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> get >>= \e -> get >>= \f ->  
+        get >>= \g -> get >>= \h -> return (IFace a b c d e f g h)
+
+-- Printing -----------------------------------------------------------------------------
+
+instance Pr IFace where
+  pr (IFace ns xs rs ss ds1 ws bs kds) =
+                                  text "Imported/used modules: " <+> prImports ns $$
+                                  text "Default declarations: " <+> hpr ',' xs $$
+                                  text ("Record types and their selectors: "++show rs) $$
+                                  text "Type synonyms: " <+> hsep (map (prId . fst) ss) $$ 
+                                  text "\nType definitions\n----------------" $$ pr ds1 $$ 
+                                  text "\nTop level bindings\n------------------" $$ pr (simpVars bs)  $$
+                                  text "\nKindle declarations\n-------------------" $$ vcat (map pr kds)
+                                  
+-- prPair (n,t)                      = prId n <+> text "::" <+> pr t
+   where simpVars (Binds rec te eqns) = Binds rec (map sV te) eqns
+         
+sV (n,t@(Scheme rh ps ke))            = case zip (filter isGenerated (idents (Scheme rh ps []))) abcSupply of
+                                          [] -> (n,t)
+                                          s ->  (n,subst s t) 
+
+listIface clo f                   = do (ifc,f) <- decodeModule clo f
+                                       --writeAPI f ifc
+                                       let modul = rmSuffix ".ti" f
+                                           htmlfile = modul++".html"
+                                       res <- checkUpToDate f htmlfile
+                                       if not res then do
+                                          writeAPI modul ifc
+                                          system (Config.pager clo ++" " ++ htmlfile)
+                                        else system (Config.pager clo ++" " ++ htmlfile)
+  where checkUpToDate tiFile htmlFile = do html_exists <- Directory.doesFileExist htmlFile
+                                           if not html_exists then
+                                              return False
+                                            else do
+                                              ti_time  <- Directory.getModificationTime tiFile
+                                              html_time  <- Directory.getModificationTime htmlFile
+                                              return (ti_time <= html_time)
+
+
+writeAPI modul ifc             = writeFile (modul ++ ".html") (render(toHTML modul (ifc :: IFace)))
+
+toHTML n (IFace ns xs rs ss ds ws bs _) = text "<html><body>\n" $$
+                                          text ("<h2>API for module "++n++"</h2>\n") $$
+                                          section ns "Imported modules" prImports $$
+                                          section xs "Default declarations" (hpr ',') $$
+                                          section ke' "Kind declarations" (pr . flip Types []) $$
+                                          section ds' "Type declarations" (pr . Types [] . map addSubs) $$
+                                          section te' "Toplevel declarations" (prTop . stripTopdecls) $$
+                                          text "</html>"
+                      
+  where section xs header f             = if null xs 
+                                           then empty 
+                                           else text ("<h4>"++header++"</h4>\n<pre>") $$ f xs $$ text "</pre>"
+        
+        Types ke ds'                    = ds
+        ke'                             = [(n,k) | (n,k) <- ke, notElem n (dom ds')]
+        Binds _ te _                    = bs
+        addSubs (n,DData vs _ cs)       = (n,DData vs (map (\(_,Constr (s:_) _ _) -> s) cs1) cs2)
+         where (cs1,cs2)                = partition (isGenerated . fst) cs
+        addSubs (n,DRec b vs _ ss)      = (n,DRec b vs (map snd ss1) ss2)
+         where (ss1, ss2)               = partition (isGenerated . fst) (map stripStar ss)
+        addSubs d                       = d
+        stripStar (n,Scheme rh ps ke)   = (n,Scheme rh ps (filter (( /= Star) . snd) ke))
+        te'                             = map (sV . stripStar)  (filter (not . isGenerated . fst) te)
+        stripTopdecls te                = bs1 ++ bs2
+         where (bs1,bs2)                = partition (flip elem ws . fst ) te
+                                                  
+        
+decodeModule clo f                      = (do ifc <- decodeCFile f
+                                              putStrLn ("[reading " ++ show f ++ "]")
+                                              return (ifc,f)) `catch`  (\e -> do let libf = Config.libDir clo ++ "/" ++ f
+                                                                                 ifc <- decodeCFile libf
+                                                                                 putStrLn ("[reading " ++ show libf ++ "]")
+                                                                                 return (ifc,libf))
+
diff --git a/src/Kind.hs b/src/Kind.hs
new file mode 100644
--- /dev/null
+++ b/src/Kind.hs
@@ -0,0 +1,231 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Kind  where
+
+import PP
+import Common
+import Core
+import Env
+import Derive
+import Depend
+import Monad
+
+kindcheck m                             = kiModule m
+
+kiModule (_,ds',_,bs') (Module v ns xs ds ws bss)
+                                         = do ds <- kiDeclsList env (groupTypes ds)
+                                              (bss',xs1) <- derive (concatMap bvars bss ++ bvars bs') (ds' `catDecls` ds) xs
+                                              let env' = addKEnv0 (ksigsOf ds) env
+                                              bss <- mapM (kiBinds env') (bss++bss')
+                                              return (Module v ns xs1 ds (ws++dom(concatMap tsigsOf bss')) bss)
+  where env                             = addKEnv0 (ksigsOf ds') (initEnv v)
+
+
+-- Kind unification ------------------------------------------------------------
+
+type KSubst = Map Int Kind
+
+type KEqs = [(Kind,Kind)]
+
+kunify                                  :: KEqs -> M s KSubst
+kunify []                               = return nullSubst
+kunify ((Star,Star):cs)                 = kunify cs
+kunify ((KVar n,k):cs)                  = kvarBind n k cs
+kunify ((k,KVar n):cs)                  = kvarBind n k cs
+kunify ((KFun k1 k2,KFun k1' k2'):cs)   = kunify ((k1,k1'):(k2,k2'):cs)
+kunify ((k1,k2):eqs)                    = fail ("Kinds do not unify: " ++ render (pr k1 <+> text "and" <+> pr k2))
+
+kvarBind n k cs
+  | k == KVar n                         = kunify cs
+  | n `elem` kvars k                    = fail "Infinite kind inferred"
+  | otherwise                           = do s' <- kunify (subst s cs)
+                                             return (s' @@ s)
+  where s                               = n +-> k
+
+
+kindUnify cs                            = do s <- kunify cs
+                                             return (freeVars s `zip` repeat Star @@ s)
+  where freeVars s                      = nub (concat (map kvars (rng s)))
+
+
+kiRho env (R t)                         = kiType env t
+kiRho env (F scs t)                     = do css <- mapM (kiScheme env) scs
+                                             cs  <- kiRho env t
+                                             return (concat css ++ cs)
+
+kiType env t                            = do (cs,k) <- kiTExp env t
+                                             return ((k,Star) : cs)
+
+kiType' env t                           = do cs <- kiType env t
+                                             s <- kunify cs
+                                             return (subst s t)
+
+kiTExp env (TFun ts t)                  = do css <- mapM (kiType env) ts
+                                             cs  <- kiType env t
+                                             return (cs ++ concat css, Star)
+kiTExp env (TId c)                      = return ([], findKind env c)
+kiTExp env (TVar n)                     = return ([], tvKind n)
+kiTExp env (TAp t t')                   = do (cs,k) <- kiTExp env t
+                                             (cs',k') <- kiTExp env t'
+                                             kv <- newKVar
+                                             return ((k,KFun k' kv):cs++cs', kv)
+
+-- Handle type declarations ----------------------------------------------------
+
+kiDeclsList env []                      = return nullDecls
+kiDeclsList env (ds:dss)                = do ds1 <- kiDecls env ds
+                                             ds2 <- kiDeclsList (addKEnv0 (ksigsOf ds) env) dss
+                                             return (catDecls ds1 ds2)
+
+
+kiDecls env t@(Types ke ds)             = do css <- mapM (kiDecl (addKEnv0 ke env)) ds
+                                             s <- kindUnify (concat css) `handle` \m -> errorTree m t
+                                             return (Types (subst s ke) (subst s ds))
+
+
+newTScope env vs                        = do ks <- mapM (const newKVar) vs
+                                             return (addKEnv (vs `zip`ks) env)
+
+
+kiDecl env (i, DData vs bs ks)          = do env' <- newTScope env vs
+                                             cs   <- kiType env' (tAp' i vs)
+                                             css1 <- mapM (kiScheme env') bs
+                                             css2 <- mapM (kiConstr env' . snd) ks
+                                             return (cs ++ concat (css1 ++ css2))
+kiDecl env (i, DRec _ vs bs ss)         = do env' <- newTScope env vs
+                                             cs   <- kiType env' (tAp' i vs)
+                                             css1 <- mapM (kiScheme env') bs
+                                             css2 <- mapM (kiScheme env' . snd) ss
+                                             return (cs ++ concat (css1 ++ css2))
+kiDecl env (i, DType vs t)              = do env' <- newTScope env vs
+                                             (cs1,k1) <- kiTExp env' (tAp' i vs)
+                                             (cs2,k2) <- kiTExp env' t
+                                             return ((k1,k2) : cs1 ++ cs2)
+
+
+kiConstr env (Constr ts ps ke)          = do css1 <- mapM (kiScheme env') ts
+                                             css2 <- mapM (kiScheme env') ps
+                                             return (concat (css1 ++ css2))
+  where env'                            = addKEnv ke env
+
+
+kiScheme env (Scheme t ps ke)           = do cs <- kiRho env' t
+                                             css <- mapM (kiScheme env') ps
+                                             return (cs ++ concat css)
+  where env'                            = addKEnv ke env
+
+
+kiTEnv env te                           = do css <- mapM (kiScheme env . snd) te
+                                             s <- kindUnify (concat css) `handle` \m -> errorTree m te
+                                             return (subst s te)
+
+kiMaybeScheme env Nothing               = return []
+kiMaybeScheme env (Just t)              = kiScheme env t
+
+
+-- Handle bindings -------------------------------------------------------------
+
+kiBinds env (Binds r te es)             = do te <- kiTEnv env te
+                                             es <- mapM (kiEqn env) es
+                                             return (Binds r te es)
+
+
+-- Traverse expressions --------------------------------------------------------
+
+
+kiExp env (ELam te e)                   = do te <- kiTEnv env te
+                                             e <- kiExp env e
+                                             return (ELam te e)
+kiExp env (EAp e es)                    = do e  <- kiExp env e
+                                             es <- mapM (kiExp env) es
+                                             return (EAp e es)
+kiExp env (ELet bs e)                   = do bs <- kiBinds env bs
+                                             e <- kiExp env e
+                                             return (ELet bs e)
+kiExp env (ERec c es)                   = do es <- mapM (kiEqn env) es
+                                             return (ERec c es)
+kiExp env (ECase e alts)                = do e <- kiExp env e
+                                             alts <- mapM (kiAlt env) alts
+                                             return (ECase e alts)
+kiExp env (EAct e e')                   = do e <- kiExp env e
+                                             e' <- kiExp env e'
+                                             return (EAct e e')
+kiExp env (EReq e e')                   = do e <- kiExp env e
+                                             e' <- kiExp env e'
+                                             return (EReq e e')
+kiExp env (ETempl x t te c)             = do t <- kiType' env t
+                                             te <- kiTEnv env te
+                                             c <- kiCmd env c
+                                             return (ETempl x t te c)
+kiExp env (EDo x t c)                   = do t <- kiType' env t
+                                             c <- kiCmd env c
+                                             return (EDo x t c)
+kiExp env e                             = return e
+
+
+kiAlt env (p,e)                         = do e <- kiExp env e
+                                             return (p,e)
+
+
+kiEqn env (v,e)                         = do e <- kiExp env e
+                                             return (v,e)
+
+
+
+-- Traverse commands -----------------------------------------------------------
+
+kiCmd env (CAss x e c)                  = do e <- kiExp env e
+                                             c <- kiCmd env c
+                                             return (CAss x e c)
+kiCmd env (CGen x t e c)                = do cs <- kiType env t
+                                             s <- kindUnify cs `handle` \m -> errorTree m t
+                                             e <- kiExp env e
+                                             c <- kiCmd env c
+                                             return (CGen x (subst s t) e c)
+kiCmd env (CLet bs c)                   = do bs <- kiBinds env bs
+                                             c <- kiCmd env c
+                                             return (CLet bs c)
+kiCmd env (CRet e)                      = do e <- kiExp env e
+                                             return (CRet e)
+kiCmd env (CExp e)                      = do e <- kiExp env e
+                                             return (CExp e)
+
+
+-- Compute kind of general type expression -------------------------------------
+
+kindOfType env (TFun _ _)               = Star
+kindOfType env (TVar n)                 = tvKind n
+kindOfType env (TId c)                  = findKind env c
+kindOfType env (TAp t t')               = k
+  where KFun k' k                       = kindOfType env t
diff --git a/src/Kindle.hs b/src/Kindle.hs
new file mode 100644
--- /dev/null
+++ b/src/Kindle.hs
@@ -0,0 +1,776 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Kindle where
+
+import Monad
+import Common
+import PP
+import qualified Core
+import qualified Env
+import Data.Binary
+import Control.Monad.Identity
+
+-- Kindle is the main back-end intermediate language.  It is a typed imperative language with dynamic 
+-- memory allocation and garbage-collection, that can be described as a slightly extended version of
+-- the common subset of C, Java and C++.  The purpose of Kindle is to function as a high-level back-
+-- end program format that can be translated into standard imperative languages as well as assembly
+-- code without too much difficulty.  None of C's pointer arithmetic features are present, neither
+-- are the class hieracrhies of Java and C++.  The type system of Kindle is a miniature variant of
+-- System F, but unsafe type-casts are supported.  The main extension compared to Java is nested
+-- recursive functions.  Heap-allocated struct objects may contain function-valued components which
+-- are invoked using self-application.  This provides a form of basic OO capability that may serve
+-- as a target for a closure conversion pass.  For more details on the relation between Kindle and
+-- the primary intermediate language Core, see module Core2Kindle.
+
+
+-- A Kindle module consists of type declarations and term bindings.  A type declaration introduces
+-- a struct type, and optionally also an enumeration of type names.  A binding defines either a named 
+-- function or a named value of atomic type.  Function bindings are immutable.  All type declarations 
+-- are mutually recursive, and so are binding groups.
+data Module     = Module  Name [Name] Decls Binds
+                deriving (Eq,Show)
+
+-- A type declaration introduces a struct type that defines the layout of heap-allocated objects.
+-- A struct type may bind type parameters and may contain both value and function fields.  Each 
+-- struct introduces a private namespace for its field names.  A struct can also be declared an
+-- extension of another struct, as indicated by the Link parameter.  If a struct is an extension,
+-- a prefix of its field names and their types must match the definition of the extended struct
+-- exactly.  If a struct is not an extension, it must either be an ordinary Top of an extension 
+-- hierarchy, or a Union - the latter form supporting case analysis between different extensions 
+-- by means of the switch command.
+type Decls      = Map Name Decl
+
+data Decl       = Struct [Name] TEnv Link
+                deriving (Eq,Show)
+
+data Link       = Top
+                | Union
+                | Extends Name
+                deriving (Eq,Show)
+
+-- A term binding is either a named value of atomic type or a named function.  A named function can
+-- bind type parameters, thus introducing polymorphism in the style of System F.  The result and 
+-- parameter types of a function are in the scope of the defined type parameters and must all be 
+-- atomic.
+type Binds      = Map Name Bind
+
+data Bind       = Val    AType Exp
+                | Fun    [Name] AType ATEnv Cmd
+                deriving (Eq,Show)
+
+
+-- The type of a binding is either just an atomic type in case of a value binding, or a triple 
+-- consisting of abstracted type parameters, the argument types, and the result type in the 
+-- function binding case.
+type TEnv       = Map Name Type
+
+data Type       = ValT   AType
+                | FunT   [Name] [AType] AType
+                deriving (Eq,Show)
+
+
+-- An atomic type is either a named constructor or a type variable, both possibly applied to
+-- further atomic type arguments.
+type ATEnv      = Map Name AType
+
+data AType      = TCon   Name [AType]
+                | TVar   Name [AType]
+                deriving (Eq,Show)
+
+
+-- A function body is a command that computes the desired result, possibly while performing imperative
+-- side-effects.  The current type system does not distinguish pure functions from side-effecting ones,
+-- although that separation will indeed be maintained by the translation from type-checked Core programs.
+data Cmd        = CRet    Exp                 -- simply return $1
+                | CRun    Exp Cmd             -- evaluate $1 for its side-effects only, then execure tail $2
+                | CBind   Bool Binds Cmd      -- introduce (recursive? $1) local bindings $2, then execute tail $3
+                | CUpd    Name Exp Cmd        -- overwrite value variable $1 with value $2, execute tail $3
+                | CUpdS   Exp Name Exp Cmd    -- overwrite value field $2 of struct $1 with value $3, execute tail $4
+                | CUpdA   Exp Exp Exp Cmd     -- overwrite index $2 of array $1 with value $3, execute tail $4
+                | CSwitch Exp [Alt]           -- depending on the dynamic value of $1, choose tails from $2
+                | CSeq    Cmd Cmd             -- execute $1; if fall-through, continue with $2
+                | CBreak                      -- break out of a surrounding switch
+                | CRaise  Exp                 -- raise an exception
+                | CWhile  Exp Cmd Cmd         -- run $2 while $1 is non-zero, then execute tail $3
+                | CCont                       -- start next turn of enclosing while loop
+                deriving (Eq,Show)
+
+-- Note 1: command (CRun e c) is identical to (CBind False [(x,e)] c) if x is a fresh name not used anywhere else
+-- Note 2: the Cmd alternatives CSeq and CBreak are intended to implement the Fatbar and Fail primitives 
+-- of the pattern-matching datatype PMC used in Core.
+
+data Alt        = ACon  Name [Name] ATEnv Cmd -- if switch value has struct type variant $1, execute tail $4 with
+                                              -- $3 bound to the actual struct fields and $2 bound to the struct
+                                              -- type arguments not statically known
+                | ALit  Lit Cmd               -- if switch value matches literal $1, execute tail $2 
+                | AWild Cmd                   -- execute tail $1 as default alternative
+                deriving (Eq,Show)
+
+-- Simple expressions that can be RH sides of value definitions as well as function arguments.
+data Exp        = EVar   Name                   -- local or global value name, enum constructor or function parameter
+                | EThis                         -- the implicit first parameter of a function-valued struct field
+                | ELit   Lit                    -- literal
+                | ESel   Exp Name               -- selection of value field $2 from struct $1
+                | ENew   Name [AType] Binds     -- a new struct of type $1 with args $2, (partially) initialized by $3
+                | ECall  Name [AType] [Exp]     -- calling local or global function $1 with type/term arguments $2/$3
+                | EEnter Exp Name [AType] [Exp] -- entering function $2 of struct $1 with type/term arguments $3/($1:$4)
+                | ECast  AType Exp              -- unchecked cast of value $2 to type $1
+                deriving (Eq,Show)
+
+-- Note: Kindle allows free variables to occur inside local functions and function-valued struct fields.  A
+-- Kindle implementation must either handle this correctly at run-time, or such variable occurrences must be 
+-- transformed away at compile-time.  The latter can be done using lambda-lifting for local functions and
+-- explicitly closing the struct functions via extra value fields accessed through "this".
+
+tId x                                   = tCon (prim x)
+
+tCon n                                  = TCon n []
+tVar n                                  = TVar n []
+
+tPOLY                                   = tId POLY
+
+tTime                                   = tId Time
+tMsg                                    = tId Msg
+tPID                                    = tId PID
+tUNIT                                   = tId UNITTYPE
+tInt                                    = tId Int
+tFloat                                  = tId Float
+tChar                                   = tId Char
+tBool                                   = tId Bool
+tBITS8                                  = tId BITS8
+tBITS16                                 = tId BITS16
+tBITS32                                 = tId BITS32
+tTimer                                  = tId TIMERTYPE
+
+tRef a                                  = TCon (prim Ref) [a]
+tLIST a                                 = TCon (prim LIST) [a]
+tArray a                                = TCon (prim Array) [a]
+
+litType (LInt _ _)                      = tInt
+litType (LRat _ _)                      = tFloat
+litType (LChr _ _)                      = tChar
+litType (LStr _ _)                      = tLIST tChar --internalError0 "Kindle.litType LStr"
+
+a                                       = name0 "a"
+b                                       = name0 "b"
+ta                                      = TVar a []
+tb                                      = TVar b []
+        
+primDecls                               = (prim Bool,       Struct []    []                                      Union) :
+                                          (prim FALSE,      Struct []    []                                      (Extends (prim Bool))) :
+                                          (prim TRUE,       Struct []    []                                      (Extends (prim Bool))) :
+                                          (prim UNITTYPE,   Struct []    []                                      Union) :
+                                          (prim UNITTERM,   Struct []    []                                      (Extends (prim UNITTYPE))) :
+                                          (prim LIST,       Struct [a]   []                                      Union) :
+                                          (prim NIL,        Struct [a]   []                                      (Extends (prim LIST))) :
+                                          (prim CONS,       Struct [a]   [(a, ValT ta), 
+                                                                          (b, ValT (tLIST ta))]                  (Extends (prim LIST))) :
+                                          (prim Msg,        Struct []    [(prim Code, FunT [] [] tUNIT),
+                                                                          (prim Baseline, ValT (tId AbsTime)),
+                                                                          (prim Deadline, ValT (tId AbsTime)),
+                                                                          (prim Next, ValT (tId Msg))]           Top) :
+                                          (prim Ref,        Struct [a]   [(prim STATE, ValT ta)]                 Top) :
+                                          (prim EITHER,     Struct [a,b] []                                      Union) :
+                                          (prim LEFT,       Struct [a,b] [(a,ValT ta)]                           (Extends (prim EITHER))) :
+                                          (prim RIGHT,      Struct [a,b] [(a,ValT tb)]                           (Extends (prim EITHER))) :
+                                          (prim TIMERTYPE,  Struct []    [(prim Reset,  FunT [] [tInt] tUNIT),
+                                                                          (prim Sample, FunT [] [tInt] tTime)]   Top) : 
+                                          []
+                                          
+isInfix (Prim p _)                      = p `elem` [MIN____KINDLE_INFIX .. MAX____KINDLE_INFIX]
+isInfix _                               = False
+
+isUnaryOp (Prim p _)                    = p `elem` [IntNeg, FloatNeg, NOT8, NOT16, NOT32]
+isUnaryOp _                             = False
+
+primKindleTerms                         = map prim [ MIN____VAR .. MAX____KINDLEVAR ]
+
+primTEnv                                = primTEnv0 ++ map cv (Env.primTypeEnv `restrict` primKindleTerms)
+  where 
+    cv (x,Core.Scheme r [] ke)          = (x, cv0 r (dom ke))
+    cv0 (Core.F ts t) vs                = FunT vs (map cv1 ts) (cv2 t)
+    cv0 (Core.R t) []                   = ValT (cv3 t)
+    cv0 (Core.R t) vs                   = FunT vs [] (cv3 t)
+    cv1 (Core.Scheme r [] [])           = cv2 r
+    cv2 (Core.R t)                      = cv3 t
+    cv3 t
+      | isCon n                         = TCon n ts'
+      | otherwise                       = TVar n ts'
+      where (Core.TId n, ts)            = Core.tFlat t
+            ts'                         = map cv3 ts
+    -- N.B.:  This type/scheme conversion algorithm is partial; it is only intended to cover the cases that appear
+    -- when converting Env.primTypeEnv restricted to primKindleTerms (note the exceptions for TIMERTERM and Abort).
+
+
+-- Primitive names only visible after translation into Kindle
+primTEnv0                               = (prim TIMERTERM,  FunT []  [tInt] (tId TIMERTYPE)) :
+                                          (prim Abort,      FunT [a] [tMsg, tRef ta] tUNIT) :
+                                          
+                                          (prim NEWREF,     FunT [a] [ta] (tRef ta)) :
+                                          (prim STATEOF,    FunT [a] [tRef ta] ta) :
+                                          (prim ASYNC,      FunT []  [tMsg,tTime,tTime] tUNIT) :
+                                          (prim LOCK,       FunT []  [tPID] tUNIT) :
+                                          (prim UNLOCK,     FunT []  [tPID] tUNIT) :
+                                          (prim Inherit,    ValT tTime) :
+                                          (prim EmptyArray, FunT [a] [tInt] (tArray ta)) :
+                                          (prim CloneArray, FunT [a] [tArray ta, tInt] (tArray ta)) :
+                                          []
+
+okRec (ValT t)                          = okRec' t
+okRec (FunT vs ts t)                    = True                            -- Good: recursive function
+okRec' (TVar _ _)                       = False                           -- Bad: statically unknown representation
+okRec' (TCon (Prim p _) _)              = p `notElem` Kindle.scalarPrims  -- Bad: type that can't fit placeholder
+okRec' (TCon n _)                       = True                            -- Good: heap allocated data
+
+scalarPrims                             = [Int, Float, Char, Bool, UNITTYPE, BITS8, BITS16, BITS32]
+
+smallPrims                              = [Char, Bool, UNITTYPE, BITS8, BITS16]
+
+tupleDecl (Tuple n _)                   = Struct ids (map f ids) Top
+  where ids                             = take n abcSupply
+        f n                             = (n, ValT (TVar n []))
+
+isVal (_, Val _ _)                      = True
+isVal (_, Fun _ _ _ _)                  = False
+
+isFunT (_, ValT _)                      = False
+isFunT (_, FunT _ _ _)                  = True
+
+isTVar (TCon _ _)                       = False
+isTVar (TVar _ _)                       = True
+
+isArray (TCon (Prim Array _) _)         = True
+isArray _                               = False
+
+isEVar (EVar _)                         = True
+isEVar _                                = False
+
+typeOf (Val t e)                        = ValT t
+typeOf (Fun vs t te c)                  = FunT vs (rng te) t
+
+rngType (ValT t)                        = t
+rngType (FunT vs ts t)                  = t
+
+typeOf' b                               = rngType (typeOf b)
+
+declsOf (Module _ _ ds _)               = ds
+
+unions ds                               = [ n | (n,Struct _ _ Union) <- ds ]
+        
+variants ds n0                          = [ n | (n,Struct _ _ (Extends n')) <- ds, n' == n0 ]
+
+structRoot ds n
+  | isTuple n                           = n
+  | otherwise                           = case lookup' ds n of
+                                            Struct _ _ (Extends n') -> n'
+                                            _                       -> n
+    
+structArity ds n 
+  | isTuple n                           = width n
+  | otherwise                           = length vs
+  where Struct vs _ _                   = lookup' ds n
+
+typeOfCon ds k
+  | isTuple k                           = (k, width k)
+  | otherwise                           = (k0, structArity ds k0)
+  where k0                              = structRoot ds k
+
+
+typeOfSel ds l                          = head [ (k,vs,t) | (k,Struct vs te _) <- ds, (l',t) <- te, l'==l ]
+
+unit                                    = ECast tUNIT (ENew (prim UNITTERM) [] [])
+
+cBind [] c                              = c
+cBind bs c                              = CBind False bs c
+
+cBindR r [] c                           = c
+cBindR r bs c                           = CBind r bs c
+
+simpleExp (EVar _)                      = True
+simpleExp (ELit _)                      = True
+simpleExp (ECast _ e)                   = simpleExp e
+simpleExp _                             = False
+
+lock t e                                = ECast t (ECall (prim LOCK) [] [ECast tPID e])
+
+unlock x c                              = cMap (CRun (ECall (prim UNLOCK) [] [e0]) . CRet) c
+  where e0                              = ECast tPID (EVar x)
+
+
+cMap f (CRet e)                         = f e
+cMap f (CRun e c)                       = CRun e (cMap f c)
+cMap f (CBind r bs c)                   = CBind r bs (cMap f c)
+cMap f (CUpd y e c)                     = CUpd y e (cMap f c)
+cMap f (CUpdS e y e' c)                 = CUpdS e y e' (cMap f c)
+cMap f (CUpdA e i e' c)                 = CUpdA e i e' (cMap f c)
+cMap f (CSwitch e alts)                 = CSwitch e (clift (cMap f) alts)
+  where g (ACon y vs te c)              = ACon y vs te (cMap f c)
+        g (ALit l c)                    = ALit l (cMap f c)
+        g (AWild c)                     = AWild (cMap f c)
+cMap f (CSeq c c')                      = CSeq (cMap f c) (cMap f c')
+cMap f (CBreak)                         = CBreak
+cMap f (CRaise e)                       = CRaise e
+cMap f (CWhile e c c')                  = CWhile e (cMap f c) (cMap f c')
+cMap f (CCont)                          = CCont
+
+
+cMap' f = cMap (CRet . f)
+
+
+class CLift a where
+    clift                               :: (Cmd -> Cmd) -> a -> a
+
+instance CLift Cmd where
+    clift f                             = f
+
+instance CLift Alt where
+    clift f (ACon y vs te c)            = ACon y vs te (f c)
+    clift f (ALit l c)                  = ALit l (f c)
+    clift f (AWild c)                   = AWild (f c)
+
+instance CLift a => CLift [a] where
+    clift f                             = map (clift f)
+
+
+cmap f                                  = clift (cMap (CRet . f))
+
+
+enter e ts es                           = EEnter e (prim Code) ts es
+
+multiEnter [] [] e                      = e
+multiEnter (ts:tss) es e                = multiEnter tss es2 (enter e [] es1)
+  where (es1,es2)                       = splitAt (length ts) es
+                                        
+
+closure t0 t te c                       = closure2 t0 [] t te c
+
+closure2 (TCon n ts) vs t te c          = ENew n ts [(prim Code, Fun vs t te c)]
+
+
+findStruct s0 []                        = Nothing
+findStruct s0 ((n,s):ds)
+  | equalStructs (s0,s)                 = Just n
+  | otherwise                           = findStruct s0 ds
+
+
+equalStructs (Struct [] te1 l1, Struct [] te2 l2)
+                                        = l1 == l2 && ls1 == ls2 && all equalTypes (ts1 `zip` ts2)
+  where (ls1,ts1)                       = unzip te1
+        (ls2,ts2)                       = unzip te2
+equalStructs (Struct vs1 te1 l1, Struct vs2 te2 l2)
+                                        = l1 == l2 && length vs1 == length vs2 &&
+                                          ls1 == ls2 && all equalTypes (subst s ts1 `zip` ts2)
+  where s                               = vs1 `zip` map tVar vs2
+        (ls1,ts1)                       = unzip te1
+        (ls2,ts2)                       = unzip te2
+
+equalTypes (ValT t1, ValT t2)           = t1 == t2
+equalTypes (FunT vs1 ts1 t1, FunT vs2 ts2 t2)
+                                        = length vs1 == length vs2 && (t1:ts1) == subst s (t2:ts2)
+  where s                               = vs2 `zip` map tVar vs1
+equalTypes _                            = False
+
+
+subexps (CRet e)                        = [e]
+subexps (CRun e _)                      = [e]
+subexps (CBind _ bs _)                  = [ e | (_,Val _ e) <- bs ]
+subexps (CUpd _ e _)                    = [e]
+subexps (CUpdS e _ e' _)                = [e,e']
+subexps (CUpdA e _ e' _)                = [e,e']
+subexps (CSwitch e _)                   = [e]
+subexps (CWhile e _ _)                  = [e]
+subexps _                               = []
+
+raises es                               = [ e | ECall (Prim Raise _) _ [e] <- es ]
+
+    
+-- Free variables ------------------------------------------------------------------------------------
+
+instance Ids Exp where
+    idents (EVar x)                     = [x]
+    idents (EThis)                      = []
+    idents (ELit l)                     = []
+    idents (ESel e l)                   = idents e
+    idents (ENew x ts bs)               = idents bs
+    idents (ECall x ts es)              = x : idents es
+    idents (EEnter e x ts es)           = idents e ++ idents es
+    idents (ECast t e)                  = idents e
+
+instance Ids Cmd where
+    idents (CRet e)                     = idents e
+    idents (CRun e c)                   = idents e ++ idents c
+    idents (CBind False bs c)           = idents bs ++ (idents c \\ dom bs)
+    idents (CBind True bs c)            = (idents bs ++ idents c) \\ dom bs
+    idents (CUpd x e c)                 = idents e ++ idents c
+    idents (CUpdS e x e' c)             = idents e ++ idents e' ++ idents c
+    idents (CUpdA e i e' c)             = idents e ++ idents i ++ idents e' ++ idents c
+    idents (CSwitch e alts)             = idents e ++ idents alts
+    idents (CSeq c c')                  = idents c ++ idents c'
+    idents (CBreak)                     = []
+    idents (CRaise e)                   = idents e
+    idents (CWhile e c c')              = idents e ++ idents c ++ idents c'
+    idents (CCont)                      = []
+
+instance Ids Alt where
+    idents (ACon x vs te c)             = idents c \\ dom te
+    idents (ALit l c)                   = idents c
+    idents (AWild c)                    = idents c
+
+instance Ids Bind where
+    idents (Val t e)                    = idents e
+    idents (Fun vs t te c)              = idents c \\ dom te
+
+instance Ids AType where
+    idents (TCon c ts)                  = c : idents ts
+    idents (TVar v ts)                  = v : idents ts
+
+instance Ids Type where
+    idents (ValT t)                     = idents t
+    idents (FunT vs ts t)               = idents (t:ts) \\ vs
+
+
+class TypeVars a where
+    typevars :: a -> [Name]
+
+instance TypeVars a => TypeVars [a] where
+    typevars xs                         = concatMap typevars xs
+
+instance TypeVars a => TypeVars (Name,a) where
+    typevars (_,x)                      = typevars x
+
+instance TypeVars Bind where
+    typevars (Val t e)                  = typevars t ++ typevars e
+    typevars (Fun vs t te c)            = (typevars t ++ typevars te ++ typevars c) \\ vs
+
+instance TypeVars Exp where
+    typevars (EVar _)                   = []
+    typevars (EThis)                    = []
+    typevars (ELit _)                   = []
+    typevars (ESel e _)                 = typevars e
+    typevars (ENew _ ts bs)             = typevars ts ++ typevars bs
+    typevars (ECall _ ts es)            = typevars ts ++ typevars es
+    typevars (EEnter e _ ts es)         = typevars ts ++ typevars (e:es)
+    typevars (ECast t e)                = typevars t ++ typevars e
+
+instance TypeVars Cmd where
+    typevars (CRet e)                   = typevars e
+    typevars (CRun e c)                 = typevars e ++ typevars c
+    typevars (CBind _ bs c)             = typevars bs ++ typevars c
+    typevars (CUpd _ e c)               = typevars e ++ typevars c
+    typevars (CUpdS e _ e' c)           = typevars [e,e'] ++ typevars c
+    typevars (CUpdA e i e' c)           = typevars [e,i,e'] ++ typevars c
+    typevars (CSwitch e alts)           = typevars e ++ typevars alts
+    typevars (CSeq c c')                = typevars c ++ typevars c'
+    typevars (CBreak)                   = []
+    typevars (CRaise e)                 = typevars e
+    typevars (CWhile e c c')            = typevars e ++ typevars [c,c']
+    typevars (CCont)                    = []
+
+instance TypeVars Alt where
+    typevars (ACon _ vs te c)           = (typevars c ++ typevars te) \\ vs
+    typevars (ALit _ c)                 = typevars c
+    typevars (AWild c)                  = typevars c
+
+instance TypeVars AType where
+    typevars (TCon _ ts)                = typevars ts
+    typevars (TVar n ts)                = n : typevars ts
+    
+-- Substitutions ------------------------------------------------------------------------------------------
+
+instance Subst Exp Name Exp where
+    subst s (EVar v)                    = case lookup v s of
+                                            Just e -> e
+                                            _      -> EVar v
+    subst s (EThis)                     = EThis
+    subst s (ELit l)                    = ELit l
+    subst s (ESel e l)                  = ESel (subst s e) l
+    subst s (ENew x ts bs)              = ENew x ts (subst s bs)
+    subst s (ECall x ts es)             = ECall x ts (subst s es)
+    subst s (EEnter e x ts es)          = EEnter (subst s e) x ts (subst s es)
+    subst s (ECast t e)                 = ECast t (subst s e)
+
+instance Subst Cmd Name Exp where
+    subst s (CRet e)                    = CRet (subst s e)
+    subst s (CRun e c)                  = CRun (subst s e) (subst s c)
+    subst s (CBind r bs c)              = CBind r (subst s bs) (subst s c)
+    subst s (CUpd x e c)                = CUpd x (subst s e) (subst s c)
+    subst s (CUpdS e x e' c)            = CUpdS (subst s e) x (subst s e') (subst s c)
+    subst s (CUpdA e i e' c)            = CUpdA (subst s e) (subst s i) (subst s e') (subst s c)
+    subst s (CSwitch e alts)            = CSwitch (subst s e) (subst s alts)
+    subst s (CSeq c c')                 = CSeq (subst s c) (subst s c')
+    subst s (CBreak)                    = CBreak
+    subst s (CRaise e)                  = CRaise (subst s e)
+    subst s (CWhile e c c')             = CWhile (subst s e) (subst s c) (subst s c')
+    subst s (CCont)                     = CCont
+
+instance Subst Alt Name Exp where
+    subst s (ACon x vs te c)            = ACon x vs te (subst s c)              -- NOTE: no alpha-conversion!!
+    subst s (ALit l c)                  = ALit l (subst s c)
+    subst s (AWild c)                   = AWild (subst s c)
+    
+instance Subst Bind Name Exp where
+    subst s (Val t e)                   = Val t (subst s e)
+    subst s (Fun vs t te c)             = Fun vs t te (subst s c)
+
+
+instance Subst Type Name AType where
+    subst s (ValT t)                    = ValT (subst s t)
+    subst s (FunT vs t ts)              = FunT vs (subst s t) (subst s ts)      -- NOTE: no alpha-conversion!!
+
+instance Subst AType Name AType where
+    subst s (TCon c ts)                 = TCon c (subst s ts)
+    subst s (TVar v ts)                 = case lookup v s of
+                                            Just t -> appargs t
+                                            _      -> TVar v ts'
+      where ts'                         = subst s ts
+            appargs (TCon c ts)         = TCon c (ts++ts')
+            appargs (TVar v ts)         = TVar v (ts++ts')
+
+
+instance Subst Exp Name AType where
+    subst s (ESel e l)                  = ESel (subst s e) l
+    subst s (ENew x ts bs)              = ENew x (subst s ts) (subst s bs)
+    subst s (ECall x ts es)             = ECall x (subst s ts) (subst s es)
+    subst s (EEnter e f ts es)          = EEnter (subst s e) f (subst s ts) (subst s es)
+    subst s (ECast t e)                 = ECast (subst s t) (subst s e)
+    subst s e                           = e
+
+instance Subst Bind Name AType where
+    subst s (Val t e)                   = Val (subst s t) (subst s e)
+    subst s (Fun vs t te c)             = Fun vs (subst s t) (subst s te) (subst s c)   -- NOTE: no alpha-conversion!!
+    
+instance Subst Cmd Name AType where
+    subst s (CRet e)                    = CRet (subst s e)
+    subst s (CRun e c)                  = CRun (subst s e) (subst s c)
+    subst s (CBind r bs c)              = CBind r (subst s bs) (subst s c)
+    subst s (CUpd x e c)                = CUpd x (subst s e) (subst s c)
+    subst s (CUpdS e x e' c)            = CUpdS (subst s e) x (subst s e') (subst s c)
+    subst s (CUpdA e i e' c)            = CUpdA (subst s e) (subst s i) (subst s e') (subst s c)
+    subst s (CSwitch e alts)            = CSwitch (subst s e) (subst s alts)
+    subst s (CSeq c c')                 = CSeq (subst s c) (subst s c')
+    subst s (CBreak)                    = CBreak
+    subst s (CRaise e)                  = CRaise (subst s e)
+    subst s (CWhile e c c')             = CWhile (subst s e) (subst s c) (subst s c')
+    subst s (CCont)                     = CCont
+    
+instance Subst Alt Name AType where
+    subst s (ACon x vs te c)            = ACon x vs (subst s te) (subst s c)
+    subst s (ALit l c)                  = ALit l (subst s c)
+    subst s (AWild c)                   = AWild (subst s c)
+    
+
+-- Tentative concrete syntax ------------------------------------------------------------------------------
+
+instance Pr Module where
+    pr (Module m ns ds bs)              = text "module" <+> prId2 m <+> text "where" $$
+                                          text "import" <+> hpr ',' ns $$
+                                          vpr ds $$ 
+                                          vpr bs
+
+
+instance Pr (Module,a) where
+    pr (m,_)                            = pr m
+
+
+instance Pr (Name, Decl) where
+    pr (c, Struct vs te lnk)            = text "struct" <+> prId2 c <+> prTyvars vs <+> text "{" $$
+                                          nest 4 (vpr te) $$
+                                          text "}" <+> pr lnk
+
+prTyvars []                             = empty
+prTyvars vs                             = text "<" <> commasep pr vs <> text ">"
+
+instance Pr Link where
+    pr Top                              = empty
+    pr Union                            = text "union"
+    pr (Extends n)                      = text "extends" <+> prId2 n
+
+
+instance Pr (Name, Type) where
+    pr (x, ValT t)                      = pr t <+> prId2 x <> text ";"
+    pr (x, FunT vs ts t)                = prTyvars vs <+> pr t <+> prId2 x <> parens (commasep pr ts) <> text ";"
+
+
+instance Pr AType where
+    pr (TCon c ts)                      = prId2 c <> prTyargs ts
+    pr (TVar v ts)                      = prId2 v <> prTyargs ts
+
+prTyargs []                             = empty
+prTyargs ts                             = text "<" <> commasep pr ts <> text ">"
+
+instance Pr (Name, AType) where
+    pr (x, t)                           = pr t <+> prId2 x
+
+
+instance Pr (Name, Bind) where
+    pr (x, Val t e)                     = pr t <+> prId2 x <+> text "=" <+> pr e <> text ";"
+    pr (x, Fun vs t te c)               = prTyvars vs <+> pr t <+> prId2 x <+> parens (commasep pr te) <+> text "{" $$
+                                          nest 4 (pr c) $$
+                                          text "}"
+
+instance Pr Cmd where
+    pr (CRet e)                         = text "return" <+> pr e <> text ";"
+    pr (CRun e c)                       = pr e <> text ";" $$
+                                          pr c
+    pr (CBind r bs c)                   = vpr bs $$
+                                          pr c
+    pr (CUpd x e c)                     = prId2 x <+> text "=" <+> pr e <> text ";" $$
+                                          pr c
+    pr (CUpdS e x e' c)                 = pr (ESel e x) <+> text "=" <+> pr e' <> text ";" $$
+                                          pr c
+    pr (CUpdA e i e' c)                 = pr (ECall (prim IndexArray) [] [e,i]) <+> text "=" <+> pr e' <> text ";" $$
+                                          pr c
+    pr (CSwitch e alts)                 = text "switch" <+> parens (pr e) <+> text "{" $$
+                                          nest 2 (vpr alts) $$
+                                          text "}"
+    pr (CSeq c1 c2)                     = pr c1 $$
+                                          pr c2
+    pr (CBreak)                         = text "break;"
+    pr (CRaise e)                       = text "RAISE" <> parens (pr e) <> text ";"
+    pr (CWhile e c c')                  = text "while" <+> parens (pr e) <+> text "{" $$
+                                          nest 4 (pr c) $$
+                                          text "}" $$
+                                          pr c'
+    pr (CCont)                          = text "continue;"
+
+
+
+prScope (CRaise e)                      = pr (CRaise e)
+prScope (CBreak)                        = pr CBreak
+prScope (CCont)                         = pr CCont
+prScope (CRet x)                        = pr (CRet x)
+prScope c                               = text "{" <+> pr c $$
+                                          text "}"
+
+instance Pr Alt where
+    pr (ACon x vs [] c)                 = prId2 x <+> prTyvars vs <> text ":" <+> prScope c
+    pr (ACon x vs te c)                 = prId2 x <+> prTyvars vs <+> parens (commasep pr te) <> text ":" <+> prScope c
+    pr (ALit l c)                       = pr l <> text ":" <+> prScope c
+    pr (AWild c)                        = text "default:" <+> prScope c
+
+
+instance Pr Exp where
+    prn 0 (ECall x [] [e1,e2])
+      | isInfix x                       = prn 0 e1 <+> prId2 x <+> prn 1 e2
+    prn 0 e                             = prn 1 e
+
+
+    prn 1 (ECall x [] [e])
+      | isUnaryOp x                     = prId2 x <> prn 1 e
+    prn 1 (ECast t e)                   = parens (pr t) <> prn 1 e
+    prn 1 e                             = prn 2 e
+
+    prn 2 (EVar x)                      = prId2 x
+    prn 2 (EThis)                       = text "this"
+    prn 2 (ELit l)                      = pr l
+    prn 2 (ENew x ts bs)
+      | all isVal bs                    = text "new" <+> prId2 x <> prTyargs ts <+> text "{" <> commasep prInit bs <> text "}"
+    prn 2 (ENew x ts bs)                = text "new" <+> prId2 x <> prTyargs ts <+> text "{" $$
+                                          nest 4 (vpr bs) $$
+                                          text "}"
+    prn 2 (ECall x ts es)               = prId2 x <> prTyargs ts <> parens (commasep pr es)
+    prn 2 (ESel e l)                    = prn 2 e <> text "->" <> prId2 l
+    prn 2 (EEnter e x ts es)            = prn 2 e <> text "->" <> prId2 x <> prTyargs ts <> parens (commasep pr es)
+    prn 2 e                             = parens (prn 0 e)
+
+
+prInit (x, Val t e)                     = prId2 x <+> text "=" <+> pr e
+prInit b                                = pr b
+
+
+-- HasPos --------------------
+
+instance HasPos AType where
+  posInfo (TCon n ts)           = between (posInfo n) (posInfo ts)
+  posInfo (TVar n ts)           = between (posInfo n) (posInfo ts)
+
+
+-- Binary --------------------
+{-
+instance Binary Module where
+  put (Module a b c d) = put a >> put b >> put c >> put d
+  get = get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> return (Module a b c d)
+-}
+instance Binary Decl where
+  put (Struct a b c) = putWord8 0 >> put a >> put b >> put c
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> get >>= \b -> get >>= \c -> return (Struct a b c)
+      _ -> fail "no parse"
+      
+instance Binary Link where
+    put Top = putWord8 0
+    put Union = putWord8 1
+    put (Extends n) = putWord8 2 >> put n
+    get = do
+      tag_ <- getWord8
+      case tag_ of
+        0 -> return Top
+        1 -> return Union
+        2 -> get >>= \a -> return (Extends a)
+        _ -> fail "no parse"
+{-
+instance Binary Bind where
+  put (Val a b) = putWord8 0 >> put a >> put b
+  put (Fun a b c) = putWord8 1 >> put a >> put b >> put c
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> get >>= \b -> return (Val a b)
+      1 -> get >>= \a -> get >>= \b -> get >>= \c -> return (Fun a b c)
+      _ -> fail "no parse"
+-}
+instance Binary Type where
+  put (ValT a) = putWord8 0 >> put a
+  put (FunT a b c) = putWord8 1 >> put a >> put b >> put c
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> return (ValT a)
+      1 -> get >>= \a -> get >>= \b -> get >>= \c -> return (FunT a b c)
+      _ -> fail "no parse"
+
+instance Binary AType where
+  put (TCon a b) = putWord8 0 >> put a >> put b
+  put (TVar a b) = putWord8 1 >> put a >> put b
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> get >>= \b -> return (TCon a b)
+      1 -> get >>= \a -> get >>= \b -> return (TVar a b)
+      _ -> fail "no parse"
+
diff --git a/src/Kindle2C.hs b/src/Kindle2C.hs
new file mode 100644
--- /dev/null
+++ b/src/Kindle2C.hs
@@ -0,0 +1,487 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Kindle2C(kindle2c) where
+
+
+import Common
+import Kindle
+import PP
+import Char
+import Depend
+
+kindle2c is m                   = return (render h, render c)
+  where h                       = k2hModule m
+        c                       = k2cModule is m
+
+-- ====================================================================================================
+-- Generate .h file
+-- ====================================================================================================
+
+k2hModule (Module n ns ds bs)   = hHeader n ns $$$
+                                  k2cDeclStubs True ds $$$
+                                  k2cDecls True ds $$$
+                                  k2cBindStubsH bs $$$
+                                  k2cInitProcStub n <> text ";" $$$
+                                  hFooter n
+  
+k2cImport n                     = text "#include \"" <> text (modToPath (str n) ++ ".h\"")
+
+
+hHeader n []                    = includeGuard n $$ text "#include \"rts.h\"" $$ text "#include \"timber.h\""
+hHeader n ns                    = includeGuard n $$ vcat (map k2cImport ns)
+
+includeGuard n                  = text ("#ifndef " ++ g) $$
+	                              text ("#define " ++ g)
+  where g                       = map toUpper (modToundSc (str n)) ++ "_H_"
+                         
+hFooter n                       = text "#endif\n"
+
+k2cDeclStubs isH ds             = vcat (map f ds)
+  where f (n, _)
+          | isH==isQualified n  = text "struct" <+> k2cName n <> text ";" $$
+                                  text "typedef" <+> text "struct" <+> k2cName n <+> text "*" <> k2cName n <> text ";"
+          | otherwise           = empty
+
+k2cDecls isH ds                 = vcat (map f ds)
+  where f (n, Struct [] te cs)
+          | isH==isQualified n  = text "struct"  <+> k2cName n <+> text "{" $$
+                                     nest 4 (k2cSigs n te) $$
+                                  text "}" <> text ";"
+          | otherwise           = empty
+        k2cSigs n te            = vcat (map f te)
+          where f (x,FunT [] ts t) 
+                                = k2cType t <+> parens (text "*" <> k2cName x) <+> parens (commasep k2cType (tCon n : ts)) <> text";"
+                f (x,ValT t)    = k2cType t <+> k2cName x <> text ";"
+
+
+k2cFunParams te                 = parens (commasep f te)
+  where f (x, t)                = k2cType t <+> k2cName x
+
+
+k2cBindStubsH bs                 = vcat (map f bs)
+  where f (x, _)
+          | not (isQualified x) = empty
+        f (x, Fun [] t te c)    = k2cType t <+> k2cName x <+> k2cFunParams te <> text";"
+        f (x, Val _ (ECall (Prim GCINFO _) _ _))
+                                = text "extern" <+> text "WORD" <+> k2cName x <> text "[];"
+        f (x, Val t e)          = text "extern" <+> k2cType t <+> k2cName x <> text ";"
+
+
+-- Generate types
+k2cType (TCon n _)              = k2cName n
+k2cType (TVar _ _)              = k2cType tPOLY
+
+
+
+-- ====================================================================================================
+-- Generate .c file
+-- ====================================================================================================
+
+{- 
+  Here we need
+  - stubs for private functions and values
+  - bindings for all functions and for values with constant initializer
+  - initialization procedure for values with non-constant initializer
+  "Constant initializer" is presently interpreted as literals only for lack of better understanding.
+-}
+
+k2cModule is (Module n ns ds bs)= cHeader n $$$
+                                  k2cDeclStubs False ds $$$
+                                  k2cDecls False ds $$$
+                                  k2cBindStubsC bs $$$
+                                  k2cTopBinds bs $$$
+                                  k2cInitProc n ns bs $$$
+                                  cFooter n
+
+
+k2cSize n                       = text "WORDS(sizeof(struct" <+> k2cName n <> text "))"
+
+
+cHeader n                       = text "#include \"" <> text (modToPath (str n)) <> text ".h\"" 
+cFooter n                       = text "\n"
+
+
+k2cBindStubsC bs                = vcat (map f bs)
+  where f (x, Fun [] t te c)
+          | isQualified x       = empty
+          | otherwise           = k2cStatic x <+> k2cType t <+> k2cName x <+> k2cFunParams te <> text";"
+        f (x, Val _ (ECall (Prim GCINFO _) _ _))
+          | isQualified x       = empty
+          | otherwise           = k2cStatic x <+> text "WORD" <+> k2cName x <> text "[];"
+        f (x, Val t e)          = k2cStatic x <+> k2cType t <+> k2cName x <> text ";"
+
+
+k2cStatic x
+  | isQualified x               = empty
+  | otherwise                   = text "static"
+
+
+k2cValBindStubsC bs             = vcat (map f bs)
+  where f (x, Val t e)          = k2cType t <+> k2cName x <> text ";"
+
+
+k2cInitProcStub n               = text "void _init_" <> text (modToundSc (str n)) <+> text "()"
+
+k2cInitImports ns               = vcat (map f ns)
+  where f n                     = text "_init_" <> text (modToundSc (str n)) <> text "();"
+
+k2cOnce p                       = text "static int INITIALIZED = 0;" $$
+                                  text "if (!INITIALIZED) {" $$
+                                  nest 4 (p $$ text "INITIALIZED = 1;") $$
+                                  text "}"
+
+
+k2cInitProc n ns bs             = k2cInitProcStub n <+> text "{" $$
+	                              nest 4 (k2cOnce (k2cInitImports ns $$ vcat (map k2cValBinds' (groupMap bs)))) $$
+                                  text "}"
+  where k2cValBinds' (r,bs)     = k2cValBinds (r, filter isInitVal bs)
+        isInitVal (_,Val _ (ECall (Prim GCINFO _) _ _))
+                                = False
+        isInitVal (_,Val _ _)   = True
+        isInitVal _             = False
+
+k2cTopBinds bs                  = vcat (map f bs)
+  where f (x, Fun [] t te c)    = k2cStatic x <+> k2cType t <+> k2cName x <+> k2cFunParams te <+> text "{" $$
+                                    nest 4 (k2cCmd c) $$
+                                  text "}"
+        f (x, Val _ (ECall (Prim GCINFO _) [] es@(EVar n : _)))
+                                = k2cStatic x <+> text "WORD" <+> k2cName x <> text "[]" <+> text "=" <+> 
+                                    braces (commasep (k2cGC n) es) <> text ";"
+        f _                     = empty
+
+
+k2cGC n (EVar x) | x == n       = k2cSize x
+                 | otherwise    = text "WORDS(offsetof(struct" <+> k2cName n <> text "," <+> k2cName x <> text "))"
+k2cGC n e                       = k2cExp e
+
+
+k2cValBinds (rec,bs)
+  | not rec || isSafe bs        = vcat (map f bs) $$
+                                  vcat (map g bs)
+  where f (x, Val t (ENew (Prim Ref _) _ _))
+                                = internalError0 "new Ref in k2cValBinds"
+        f (x, Val t (ENew n [] bs)) 
+                                = newCall t x (k2cSize n)
+        f (x, Val t (ECast _ (ENew n [] bs)))
+                                = newCall t x (k2cSize n)
+        f (x, Val t e)          = k2cName x <+> text "=" <+> k2cExp e <> text ";"
+        f _                     = empty
+        g (x, Val t (ENew n [] bs)) 
+                                = k2cStructBinds (EVar x) bs
+        g (x, Val t (ECast _ (ENew n [] bs)))
+                                = k2cStructBinds (ECast (tCon n) (EVar x)) bs
+        g _                     = empty
+        vs                      = dom bs
+        isSafe bs               = all isConst bs && strictBs bs `intersect` vs == []
+        isConst (_, Val _ (ENew _ _ _))           = True
+        isConst (_, Val _ (ECast _ (ENew _ _ _))) = True
+        isConst _                                 = False
+k2cValBinds (_,bs)              = text ("{   Array roots = CYCLIC_BEGIN(" ++ show size ++ "," ++ show n_upd ++ ");") $$
+                                  nest 4 (vcat (zipWith f [0..] bs) $$
+                                          vcat (zipWith3 g [0..] upd bs) $$
+                                          text "CYCLIC_END(roots, hp);") $$
+                                  text "}"
+  where size                    = length bs
+        upd                     = updates [] bs
+        n_upd                   = length (filter id upd)
+        f i (x, Val t (ENew (Prim Ref _) _ _))
+                                = internalError0 "new Ref in k2cValBinds"
+        f i (x, Val t _)        = k2cName x <+> text "=" <+> k2cExp (rootInd' t i) <> text ";"
+        g i u (x, Val t (ENew n [] bs'))
+                                = update u i $$
+                                  newCall t x (k2cSize n) $$
+                                  k2cExp (rootInd i) <+> text "=" <+> k2cExp (ECast tPOLY (EVar x)) <> text ";" $$
+                                  k2cStructBinds (rootInd' t i) bs'
+        g i u (x, Val t (ECast _ (ENew n [] bs')))
+                                = update u i $$
+                                  newCall t x (k2cSize n) $$
+                                  k2cExp (rootInd i) <+> text "=" <+> k2cExp (ECast tPOLY (EVar x)) <> text ";" $$
+                                  k2cStructBinds (ECast (tCon n) (rootInd' t i)) bs'
+        g i u (x, Val t e)      = update u i $$
+                                  k2cName x <+> text "=" <+> k2cExp e <> text ";" $$
+                                  k2cExp (rootInd i) <+> text "=" <+> k2cExp (ECast tPOLY (EVar x)) <> text ";"
+        update True i           = text ("CYCLIC_UPDATE(roots, " ++ show i ++ ", hp);")
+        update False i          = empty
+        rootInd i               = ECall (prim IndexArray) [] [ELit (lInt 0), EVar (name0 "roots"), ELit (lInt i)]
+        rootInd' t i            = ECast t (rootInd i)
+
+
+strictBs bs                     = concat [ strict e | (_,Val _ e) <- bs ]
+                                -- We assume all free variables of function closures have been extracted as value
+                                -- bindings by llift, hence only Val patterns need to be considered above
+strict (ECast _ e)              = strict e
+strict (ESel e l)               = evars e
+strict (EEnter e l [] es)       = evars (e:es)
+strict (ECall f [] es)          = evars es
+strict (ENew _ [] bs)           = strictBs bs
+strict _                        = []
+
+strictRhs (EVar x)              = [x]
+strictRhs (ECast _ e)           = strictRhs e
+strictRhs e                     = strict e
+
+updates prev []                 = []
+updates prev ((x,Val _ e):bs)   = mustUpdate : updates ((x,fwrefs):prev') bs
+  where computed                = dom prev
+        bwrefs                  = filter (not . isPatTemp) (strictRhs e `intersect` computed)
+        fragile                 = concat [ fws | (y,fws) <- prev, y `elem` bwrefs ]
+        mustUpdate              = not (null (fragile `intersect` computed))
+        fwrefs                  = evars e `intersect` (x:dom bs)
+        prev' | mustUpdate      = [ (y,fws \\ computed) | (y,fws) <- prev ]
+              | otherwise       = prev
+        
+
+
+newCall t x size                = text "NEW" <+> parens (k2cType t <> text "," <+> 
+                                                         k2cName x <> text "," <+> 
+                                                         size) <> text ";"
+
+
+
+k2cStructBinds e0 bs            = vcat (map f bs)
+  where f (Prim GCINFO _, Val _ (ECall x [] es))
+                                = k2cExp (ESel e0 (prim GCINFO)) <+> text "=" <+> k2cName x <> off <> text ";"
+          where off | null es   = empty
+                    | otherwise = text "+" <> parens (k2cExp (head es))
+        f (x, Val t e)          = k2cExp (ESel e0 x) <+> text "=" <+> k2cExp e <> text ";"
+        f (x, Fun [] t te (CRet (ECall f [] es)))
+                                = k2cExp (ESel e0 x) <+> text "=" <+> k2cName f <> text ";"
+        f (x, _)                = internalError0 "k2cSBind"
+
+
+
+k2cCmd (CRet e)                 = text "return" <+> k2cExp e <> text ";"
+k2cCmd (CRun e c)               = k2cExp e <> text ";" $$
+                                  k2cCmd c
+k2cCmd (CBind False [(x,Val t (ENew n [] bs))] (CBind False [(y,Val tref (ENew (Prim Ref _) [] bs'))] c))
+  | st == ECast tPOLY (EVar x)  = k2cType tref <+> k2cName y <> text ";" $$
+                                  newCall (tref) y (k2cSize (prim Ref) <> text "+" <> k2cSize n) $$
+                                  text "INITREF" <> parens (k2cName y) <> text ";" $$
+                                  k2cStructBinds (ECast t (ESel (EVar y) (prim STATE))) bs $$
+                                  k2cCmd c
+  where Val _ st                = lookup' bs' (prim STATE)
+k2cCmd (CBind False [(_,Val (TCon (Prim UNITTYPE _) _) e)] (CRet (ECast (TCon (Prim UNITTYPE _) _) _)))
+                                = k2cExp e <> text ";"
+k2cCmd (CBind False [(_,Val (TCon (Prim UNITTYPE _) _) e)] CBreak)
+                                = text "break;"
+k2cCmd (CBind False bs c)       = k2cValBindStubsC bs $$
+                                  k2cValBinds (False,bs) $$
+                                  k2cCmd c
+k2cCmd (CBind True bs c)        = k2cValBindStubsC bs $$
+                                  vcat (map k2cValBinds (groupMap bs)) $$
+                                  k2cCmd c
+k2cCmd (CUpd x e c)             = k2cName x <+> text "=" <+> k2cExp e <> text ";" $$
+                                  k2cCmd c
+k2cCmd (CUpdS e x e' c)         = k2cExp (ESel e x) <+> text "=" <+> k2cExp e' <> text ";" $$
+                                  k2cCmd c
+k2cCmd (CUpdA e i e' c)         = k2cExp (ECall (prim IndexArray) [] [ELit (lInt 0),e,i]) <+> text "=" <+> k2cExp e' <> text ";" $$
+                                  k2cCmd c
+k2cCmd (CSwitch e alts)         = case litType (firstLit alts) of
+                                    TCon (Prim LIST _) [TCon (Prim Char _) []] -> -- we know (from Prepare4C) that e is a variable
+                                      k2cStringAlts False e alts
+                                    TCon (Prim Float _) [] -> 
+                                      k2cFloatAlts False e alts
+                                    _ -> text "switch" <+> parens (k2cExp e) <+> text "{" $$
+                                         nest 4 (vcat (map k2cAlt alts)) $$
+                                         text "}"
+k2cCmd (CSeq c c')              = k2cCmd c $$
+                                  k2cCmd c'
+k2cCmd (CBreak)                 = text "break;"
+k2cCmd (CRaise e)               = text "RAISE" <> parens (k2cExp e) <> text ";"
+k2cCmd (CWhile e c c')          = text "while" <+> parens (k2cExp e) <+> text "{" $$
+                                  nest 4 (k2cCmd c) $$
+                                  text "}" $$
+                                  k2cCmd c'
+k2cCmd (CCont)                  = text "continue;"
+
+firstLit (ALit l _ : _) = l
+firstLit (_ : as)       = firstLit as
+
+k2cStringAlts b e (ALit l c : as)      
+                                = (if b then text "else " else empty) <> text "if (strEq (" <> k2cExp e <>
+                                    text "," <> k2cExp (ELit l) <> text ")) {" $$
+                                     nest 4 (k2cNestIfCmd c) $$
+                                     text "}" $$
+                                     k2cStringAlts True e as
+k2cStringAlts _ e [AWild c]       = text "else {" $$
+                                     nest 4 (k2cNestIfCmd c) $$
+                                     text "}"
+
+k2cFloatAlts b e (ALit l c : as)      
+                                  = (if b then text "else " else empty) <> text "if (" <> k2cExp e <>
+                                    text "=="<> k2cExp (ELit l) <> text ") {" $$
+                                     nest 4 (k2cNestIfCmd c) $$
+                                     text "}" $$
+                                     k2cFloatAlts True e as
+k2cFloatAlts _ e [AWild c]       = text "else {" $$
+                                     nest 4 (k2cNestIfCmd c) $$
+                                     text "}"
+         
+k2cAlt (ACon n _ _ c)           = internalError "Constructor tag in Kindle2C" n
+k2cAlt (ALit l c)               = text "case" <+> pr l <> text ":" <+> k2cNestCmd c
+k2cAlt (AWild c)                = text "default:" <+> k2cNestCmd c
+
+
+k2cNestCmd (CRet e)             = text "return" <+> k2cExp e <> text ";"
+k2cNestCmd (CBreak)             = text "break;"
+k2cNestCmd (CCont)              = text "continue;"
+k2cNestCmd (CRaise e)           = text "RAISE" <> parens (k2cExp e) <> text ";"
+k2cNestCmd c                    = text "{" <+> k2cCmd c $$
+                                  text "}" $$
+                                  text "break;"     -- important in case contains a switch that might break
+
+k2cNestIfCmd (CRet e)             = text "return" <+> k2cExp e <> text ";"
+k2cNestIfCmd (CBreak)             = empty
+k2cNestIfCmd (CCont)              = text "continue;"
+k2cNestIfCmd (CRaise e)           = text "RAISE" <> parens (k2cExp e) <> text ";"
+k2cNestIfCmd c                    = text "{" <+> k2cCmd c $$
+                                    text "}" 
+
+
+k2cExp (ECall x [] [e1,e2])
+  | isInfix x                   = parens (k2cExp e1 <+> k2cName x <+> k2cExp1 e2)
+k2cExp e                        = k2cExp1 e
+
+
+k2cExp1 (ECall x [] [e])
+  | isUnaryOp x                 = k2cName x <> k2cExp1 e
+k2cExp1 (ECast t e)             = parens (k2cType t) <> k2cExp1 e
+k2cExp1 e                       = k2cExp2 e
+
+
+k2cExp2 (EVar x)                = k2cName x
+k2cExp2 (ELit (LRat _ r))       = text (show (fromRational r :: Double))
+k2cExp2 (ELit (LStr _ str))     = text ("getStr("++show str++")")
+k2cExp2 (ELit l)                = pr l
+k2cExp2 (ESel e (Prim STATE _)) = text "STATEOF" <> parens (k2cExp e)
+k2cExp2 (ESel e l)              = k2cExp2 e <> text "->" <> k2cName l
+k2cExp2 (EEnter (EVar x) f [] es)  
+                                = k2cExp2 (ESel (EVar x) f) <> parens (commasep k2cExp (EVar x : es))
+k2cExp2 (ECall (Prim IndexArray _) [] [_,e1,e2])
+                                = k2cExp2 e1 <> text "->elems[" <> k2cExp e2 <> text "]"
+k2cExp2 (ECall (Prim SizeArray _) [] [_,e])
+                                = k2cExp2 e<> text "->size"
+k2cExp2 e@(ECall x [] es)
+  | not (isInfix x)             = k2cName x <> parens (commasep k2cExp es)
+k2cExp2 EThis                   = internalError0 "k2cExp'"
+k2cExp2 e                       = parens (k2cExp e)
+
+
+k2cName (Prim p _)              = k2cPrim p
+k2cName n                       = prId3 n
+
+
+k2cPrim IntPlus                 = text "+"
+k2cPrim IntMinus                = text "-"
+k2cPrim IntTimes                = text "*"
+k2cPrim IntDiv                  = text "/"
+k2cPrim IntMod                  = text "%"
+k2cPrim IntNeg                  = text "-"
+
+k2cPrim IntEQ                   = text "=="
+k2cPrim IntNE                   = text "!="
+k2cPrim IntLT                   = text "<"
+k2cPrim IntLE                   = text "<="
+k2cPrim IntGE                   = text ">="
+k2cPrim IntGT                   = text ">"
+                                
+k2cPrim FloatPlus               = text "+"
+k2cPrim FloatMinus              = text "-"
+k2cPrim FloatTimes              = text "*"
+k2cPrim FloatDiv                = text "/"
+k2cPrim FloatNeg                = text "-"
+                                
+k2cPrim FloatEQ                 = text "=="
+k2cPrim FloatNE                 = text "!="
+k2cPrim FloatLT                 = text "<"
+k2cPrim FloatLE                 = text "<="
+k2cPrim FloatGE                 = text ">="
+k2cPrim FloatGT                 = text ">"
+
+k2cPrim AND8                    = text "&"
+k2cPrim OR8                     = text "|"
+k2cPrim EXOR8                   = text "^"
+k2cPrim SHIFTL8                 = text "<<"
+k2cPrim SHIFTR8                 = text ">>"
+k2cPrim NOT8                    = text "~"
+                                
+k2cPrim AND16                   = text "&"
+k2cPrim OR16                    = text "|"
+k2cPrim EXOR16                  = text "^"
+k2cPrim SHIFTL16                = text "<<"
+k2cPrim SHIFTR16                = text ">>"
+k2cPrim NOT16                   = text "~"
+                                
+k2cPrim AND32                   = text "&"
+k2cPrim OR32                    = text "|"
+k2cPrim EXOR32                  = text "^"
+k2cPrim SHIFTL32                = text "<<"
+k2cPrim SHIFTR32                = text ">>"
+k2cPrim NOT32                   = text "~"
+
+k2cPrim IntToFloat              = text "(Float)"
+k2cPrim FloatToInt              = text "(Int)"
+
+k2cPrim CharToInt               = text "(Int)"
+k2cPrim IntToChar               = text "(Char)"
+
+k2cPrim LazyOr                  = text "||"
+k2cPrim LazyAnd                 = text "&&"
+
+k2cPrim PidEQ                   = text "=="
+k2cPrim PidNE                   = text "!="
+{-*                               
+k2cPrim Sec                     = text "SEC"
+k2cPrim Millisec                = text "MILLISEC"
+k2cPrim Microsec                = text "MICROSEC"
+k2cPrim Nanosec                 = text "NANOSEC"
+-}
+k2cPrim Infinity                = text "Infinity"
+k2cPrim Raise                   = text "Raise"
+--k2cPrim Catch                   = text "Catch"
+{-                           
+k2cPrim TimePlus                = text "TPLUS"
+k2cPrim TimeMinus               = text "TMINUS"
+k2cPrim TimeMin                 = text "TMIN"
+                           
+k2cPrim TimeEQ                  = text "=="
+k2cPrim TimeNE                  = text "!="
+k2cPrim TimeLT                  = text "<"
+k2cPrim TimeLE                  = text "<="
+k2cPrim TimeGE                  = text ">="
+k2cPrim TimeGT                  = text ">"
+-}
+k2cPrim Abort                   = text "ABORT"
+
+k2cPrim p                       = text (strRep2 p)
diff --git a/src/Kindlered.hs b/src/Kindlered.hs
new file mode 100644
--- /dev/null
+++ b/src/Kindlered.hs
@@ -0,0 +1,231 @@
+{-# LANGUAGE PatternGuards #-}
+
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Kindlered where
+    
+import Monad
+import Common
+import Kindle
+import PP
+
+
+kindlered ds m                          = redModule ds m
+
+
+data Env                                = Env { decls :: Decls }
+
+nullEnv                                 = Env { decls = [] }
+
+addDecls ds env                         = env { decls = ds ++ decls env }
+
+findSel env l                           = head [ t | (_,Struct _ te _) <- decls env, (l',t) <- te, l'==l ]
+
+
+-- Convert a module
+redModule dsi (Module m ns ds bs)       = do bs <- mapM (redBind env0) bs
+                                             return (Module m ns ds bs)
+  where env0                            = addDecls (ds++dsi) nullEnv
+
+
+-- Convert a binding
+redBind env (x, Fun vs t te c)          = do c <- redCmd env c
+                                             return (x, Fun vs t te c)
+redBind env (x, Val t e)                = do e <- redExp env e
+                                             return (x, Val t e)
+
+
+single x e                              = length (filter (==x) (evars e)) == 1
+
+newRef (ENew (Prim Ref _) _ _)          = True
+newRef _                                = False
+
+-- Convert a command
+redCmd env c
+  | not (null es)                       = liftM CRaise (redExp env (head es))
+  where es                              = raises (subexps c)
+redCmd env (CRet e)                     = do e <- redExp env e
+                                             redRet env e
+redCmd env e0@(CBind False [(x,Val _ e)] (CRet e'))
+  | single x e' && not (newRef e)       = redCmd env (CRet (subst [(x,e)] e'))
+redCmd env (CBind r bs c)               = liftM2 (CBind r) (mapM (redBind env) bs) (redCmd env c)
+redCmd env (CRun e c)                   = liftM2 CRun (redExp env e) (redCmd env c)
+redCmd env (CUpd x e c)                 = liftM2 (CUpd x) (redExp env e) (redCmd env c)
+redCmd env (CUpdS e x v c)              = do f <- redAssign env (arrayDepth t) (ESel e x) v
+                                             liftM f (redCmd env c)
+  where ValT t                          = findSel env x
+redCmd env (CUpdA e i e' c)             = do e <- redExp env e
+                                             liftM2 (CUpdA e i) (redExp env e') (redCmd env c)
+redCmd env (CSwitch e alts)             = liftM2 CSwitch (redExp env e) (mapM (redAlt env) alts)
+redCmd env (CSeq c c')                  = liftM2 CSeq (redCmd env c) (redCmd env c')
+redCmd env (CBreak)                     = return CBreak
+redCmd env (CRaise e)                   = liftM CRaise (redExp env e)
+redCmd env (CWhile e c c')              = liftM3 CWhile (redExp env e) (redCmd env c) (redCmd env c')
+redCmd env (CCont)                      = return CCont
+
+
+redRet env (EEnter e f ts es)           = do c <- redRet env e
+                                             return (cMap (ff env f ts es) c)
+redRet env e                            = return (CRet e)
+
+
+ff env f ts es (ENew n _ bs)            = subst (vs `zip` ts) (subst (dom te `zip` es) c)
+  where Fun vs t te c                   = lookup' bs f
+ff env f ts es e                        = CRet (EEnter e f ts es)
+
+
+
+-- Convert a switch alternative
+redAlt env (ACon x vs te c)             = liftM (ACon x vs te) (redCmd env c)
+redAlt env (ALit l c)                   = liftM (ALit l) (redCmd env c)
+redAlt env (AWild c)                    = liftM AWild (redCmd env c)
+
+
+
+
+-- Convert an expression
+redExp env (EEnter e f ts es)           = do e <- redExp env e
+                                             es <- mapM (redExp env) es
+                                             redEnter env e f ts es
+redExp env e@(ECall (Prim IndexArray _) _ _)
+                                        = redIndexArray env e 0
+redExp env (ECall p@(Prim SizeArray _) [t] [e])
+                                        = liftM (ECall p [t] . (:[])) (redExp' env e)
+redExp env (ECall x ts es)              = do es <- mapM (redExp env) es
+                                             return (ECall x ts es)
+redExp env (ENew n ts bs)               = do bs <- mapM (redBind env) bs
+                                             redNew env n ts bs
+redExp env (EVar x)                     = return (EVar x)
+redExp env (EThis)                      = return (EThis)
+redExp env (ELit l)                     = return (ELit l)
+redExp env a@(ESel e l)
+  | stateVar (annot l)                  = redIndexArray env a 0
+  | otherwise                           = liftM (flip ESel l) (redExp env e)
+redExp env (ECast t e)                  = liftM (ECast t) (redExp env e)
+
+
+redEnter env e@(ENew n _ bs) f ts es    = case c of
+                                             CRet e' -> return (subst (vs `zip` ts) (subst (dom te `zip` es) e'))
+                                             _       -> return (EEnter e f ts es)
+  where Fun vs t te c                   = lookup' bs f
+redEnter env e f ts es                  = return (EEnter e f ts es)
+
+
+redNew env n _ [(Prim Code _, Fun vs _ te (CRet (EEnter e (Prim Code _) ts es)))]
+  | ts == map tVar vs && es == map EVar (dom te)
+                                        = return e
+redNew env n ts bs                      = return (ENew n ts bs)
+
+
+-- Convert an expression in a safe context (no cloning needed)
+redExp' env (ECast t e)                 = liftM (ECast t) (redExp' env e)
+redExp' env (ESel e l)                  = liftM (flip ESel l) (redExp env e)
+redExp' env e                           = redExp env e
+
+
+-- Convert an array indexing expression
+redIndexArray env (ECall (Prim IndexArray _) [t] [a,i]) n
+                                        = do a <- redIndexArray env a (n+1)
+                                             i <- redExp env i
+                                             return (indexArray t a i)
+redIndexArray env (ESel e l) n
+  | stateVar (annot l)                  = do e <- redExp env e
+                                             return (clone (arrayDepth t - n) t (ESel e l))
+  where ValT t                          = findSel env l
+redIndexArray env a n                   = redExp env a
+
+
+indexArray t a i                        = ECall (prim IndexArray) [t] [a,i]
+
+
+intExp i                                = ELit (lInt i)
+
+arrayDepth (TCon (Prim Array _) [t])    = 1 + arrayDepth t
+arrayDepth _                            = 0
+
+clone 0 t e                             = e
+clone 1 t e@(ECall (Prim p _) _ _)
+  | p `elem` [ListArray,UniArray]       = e
+clone _ t e@(ECall (Prim p _) _ _)
+  | p `elem` [EmptyArray,SizeArray]     = e
+clone n t (ECall (Prim CloneArray _) _ [e,ELit (LInt _ n')])
+  | toInteger n == n'                   = e
+clone n t e                             = (ECall (prim CloneArray) [stripArray n t] [e, intExp n])
+
+stripArray 0 t                          = t
+stripArray n (TCon (Prim Array _) [t])  = stripArray (n-1) t
+
+{-
+    a|x|y|z := e
+    a|x|y   := a|x|y \\ (z,e)
+    a|x     := a|x \\ (y, a|x|y \\ (z,e))
+    a       := a \\ (x, a|x \\ (y, a|x|y \\ (z,e)))
+-}
+
+redAssign env n e0 (ECall (Prim UpdateArray _) [t] [a,i,v])
+  | e0 == a                         = redAssign env (n-1) (indexArray t a i) v
+  | otherwise                       = do f1 <- redAssign env n e0 a
+                                         f2 <- redAssign env (n-1) (indexArray t e0 i) v
+                                         return (f1 . f2)
+redAssign env n e0 (ECall (Prim ListArray _) [t] [e])
+  | Just es <- constElems e, 
+    let m = length es               = do f <- redAssign env n e0 (ECall (prim EmptyArray) [t] [ELit (lInt (toInteger m))])
+                                         fs <- mapM mkAssign ([0..] `zip` es)
+                                         return (foldl (.) f fs)
+  where constElems (ENew (Prim CONS _) _ bs)
+                                    = do es <- constElems eb
+                                         return (ea:es)
+          where Val _ ea            = lookup' bs (head abcSupply)
+                Val _ eb            = lookup' bs (head (tail abcSupply))
+        constElems (ENew (Prim NIL _) _ bs)
+                                    = Just []
+        constElems _                = Nothing
+        mkAssign (i,e)              = redAssign env (n-1) (indexArray t e0 (intExp i)) e
+redAssign env n e0 (ECall (Prim UniArray _) [t] [m,e])
+                                    = do x <- newName tempSym
+                                         s <- newName tempSym
+                                         i <- newName paramSym
+                                         let f0 = cBind [(x,Val t e),(s,Val tInt m),(i,Val tInt (intExp 0))]
+                                         f <- redAssign env n e0 (ECall (prim EmptyArray) [t] [EVar s])
+                                         let f1 c = CWhile (ECall (prim IntLT) [] [EVar i, EVar s]) c
+                                         f2 <- redAssign env (n-1) (indexArray t e0 (EVar i)) (EVar x)
+                                         let c = CUpd i (ECall (prim IntPlus) [] [EVar i, intExp 1]) CCont
+                                         return (f0 . f . f1 (f2 c))
+redAssign env n (ESel e x) v        = do v' <- redExp env v
+                                         return (CUpdS e x (clone n t v'))
+  where ValT t                      = findSel env x
+redAssign env n (ECall (Prim IndexArray _) [t] [e,i]) v
+                                    = do v' <- redExp env v
+                                         return (CUpdA e i (clone n t v'))
+
diff --git a/src/Lambdalift.hs b/src/Lambdalift.hs
new file mode 100644
--- /dev/null
+++ b/src/Lambdalift.hs
@@ -0,0 +1,182 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Lambdalift(lambdalift) where
+
+import Monad
+import Common
+import Kindle
+import PP
+
+
+lambdalift ds m                 = localStore (llModule ds m)
+
+
+data Env                        = Env { decls      :: Decls,                    -- global type declarations
+                                        thisVars   :: [Name],                   -- variables reachable through "this"
+                                        locals     :: ATEnv,                    -- non-global value names in scope
+                                        expansions :: Map Name ([Name],[Name])  -- non-global functions and their added type/term parameters
+                                      }
+
+nullEnv                         = Env { decls = primDecls, 
+                                        thisVars = [],
+                                        locals = [],
+                                        expansions = []
+                                      }
+
+addDecls ds env                         = env { decls = ds ++ decls env }
+
+setThisVars xs env                      = env { thisVars = xs }
+
+addLocals te env                        = env { locals = te ++ locals env }
+
+addExpansions exps env                  = env { expansions = exps ++ expansions env }
+
+
+-- Convert a module
+llModule dsi (Module m ns ds bs)        = do bs <- mapM (llBind env0) bs
+                                             s <- currentStore
+                                             return (Module m ns (ds ++ declsOfStore s) (bs ++ bindsOfStore s))
+  where env0                            = addDecls (ds ++ dsi) nullEnv
+
+
+declsOfStore s                          = [ d | Left d <- s ]
+
+bindsOfStore s                          = [ b | Right b <- s ]
+
+
+-- Convert a binding
+llBind env (x, Fun vs t te c)           = do c <- llCmd (addLocals te env) c
+                                             return (x, Fun vs t te c)
+llBind env (x, Val t e)                 = do e <- llExp env e
+                                             return (x, Val t e)
+
+
+{- Lambda-lifting a set of recursive bindings:
+
+   \v ->                                                letrec f r v x = ... r ... v ...
+   letrec f x = ... r ... v ...                                g r v y = ... f r v e ...
+          r   = { a = ... g e ... }         ==>         in \v ->
+          g y = ... f e ...                             letrec r  = { a = ... g r v e ... }
+   in f e                                               in f r v e
+-}
+
+{- Closing a struct with function fields:
+
+   \v ->                                                \v ->
+   { f x = ... v ...                                    { f x = ... this.v ...
+     w   = ... v ... }                      ==>           w   = ... v ...
+                                                          v   = v }
+-}
+
+-- Convert a command
+llCmd env (CBind r bs c)                = do vals' <- mapM (llBind env') vals
+                                             funs' <- mapM (llBind (setThisVars [] env')) funs
+                                             mapM_ liftFun funs'
+                                             c' <- llCmd env2 c
+                                             return (cBindR r vals' c')
+  where (vals,funs)                     = partition isVal bs
+        free0                           = evars funs
+        free1                           = free0 ++ concat [ xs | (f,(_,xs)) <- expansions env, f `elem` free0 ]
+        fte                             = locals (if r then env1 else env) `restrict` free1
+        tvs                             = nub (typevars funs ++ typevars fte)
+        env1                            = addLocals (mapSnd typeOf' vals) env
+        env2                            = addExpansions (dom funs `zip` repeat (tvs, dom fte)) env1
+        env'                            = if r then env2 else env
+        liftFun (x, Fun vs t te c)      = addToStore (Right (x, Fun (tvs++vs) t (fte++te) c))
+llCmd env (CRet e)                      = liftM CRet (llExp env e)
+llCmd env (CRun e c)                    = liftM2 CRun (llExp env e) (llCmd env c)
+llCmd env (CUpd x e c)                  = liftM2 (CUpd x) (llExp env e) (llCmd env c)
+llCmd env (CUpdS e x e' c)              = do e <- llExp env e
+                                             liftM2 (CUpdS e x) (llExp env e') (llCmd env c)
+llCmd env (CUpdA e i e' c)              = liftM4 CUpdA (llExp env e) (llExp env i) (llExp env e') (llCmd env c)
+llCmd env (CSwitch e alts)              = liftM2 CSwitch (llExp env e) (mapM (llAlt env) alts)
+llCmd env (CSeq c c')                   = liftM2 CSeq (llCmd env c) (llCmd env c')
+llCmd env (CBreak)                      = return CBreak
+llCmd env (CRaise e)                    = liftM CRaise (llExp env e)
+llCmd env (CWhile e c c')               = liftM3 CWhile (llExp env e) (llCmd env c) (llCmd env c')
+llCmd env (CCont)                       = return CCont
+
+
+-- Convert a switch alternative
+llAlt env (ACon x vs te c)              = liftM (ACon x vs te) (llCmd (addLocals te env) c)
+llAlt env (ALit l c)                    = liftM (ALit l) (llCmd env c)
+llAlt env (AWild c)                     = liftM AWild (llCmd env c)
+
+
+-- Convert an expression
+llExp env (ECall x ts es)               = do es <- mapM (llExp env) es
+                                             case lookup x (expansions env) of
+                                                Just (vs,xs) -> return (ECall x (map tVar vs ++ ts) (map (mkEVar env) xs ++ es))
+                                                Nothing -> return (ECall x ts es)
+llExp env ee@(ENew n ts bs)
+  | null fte && null fvs                = liftM (ENew n ts) (mapM (llBind env) bs)
+  | otherwise                           = do n' <- extendStruct n vs fvs te (mapSnd ValT fte)
+                                             vals' <- mapM (llBind env) vals
+                                             funs' <- mapM (llBind (setThisVars (dom fte) env)) funs
+                                             -- tr ("lift ENew: " ++ render (pr (TCon n ts)) ++ "  fvs: " ++ show fvs ++ "   new: " ++ show n')
+                                             return (ECast (TCon n ts) (ENew n' (ts ++ map tVar fvs) (vals' ++ funs' ++ map close fte)))
+  where (vals,funs)                     = partition isVal bs
+        free0                           = evars funs
+        free1                           = free0 ++ concat [ xs | (f,(_,xs)) <- expansions env, f `elem` free0 ]
+        fte                             = locals env `restrict` free1
+        fvs                             = nub (typevars funs ++ typevars fte)
+        Struct vs te _                  = lookup' (decls env) n   -- NOTE: n can't be a tuple or a cons if fte/fvs are nonempty...
+        close (x,t)                     = (x, Val t (mkEVar env x))
+
+
+llExp env (EVar x)                      = return (mkEVar env x)
+llExp env (EThis)                       = return (EThis)
+llExp env (ELit l)                      = return (ELit l)
+llExp env (ESel e l)                    = liftM (flip ESel l) (llExp env e)
+llExp env (EEnter e f ts es)            = do e <- llExp env e
+                                             liftM (EEnter e f ts) (mapM (llExp env) es)
+llExp env (ECast t e)                   = liftM (ECast t) (llExp env e)
+
+
+mkEVar env x                            = if x `elem` thisVars env then ESel EThis x else EVar x
+
+extendStruct n vs vs' te te'
+  | not (null (intersect vs vs'))       = do vs1 <- newNames tyvarSym (length vs)
+                                             let te1 = subst (vs `zip` map tVar vs1) te
+                                                 s1 = Struct (vs1++vs') (te1++te') (Extends n)
+                                             n <- newName typeSym
+                                             addToStore (Left (n, s1))
+                                             return n
+  | otherwise                           = do s <- currentStore
+                                             case findStruct s0 (declsOfStore s) of
+                                               Just n  -> return n
+                                               Nothing -> do n <- newName typeSym
+                                                             addToStore (Left (n, s0))
+                                                             return n
+  where s0                              = Struct (vs++vs') (te++te') (Extends n)
diff --git a/src/Lexer.hs b/src/Lexer.hs
new file mode 100644
--- /dev/null
+++ b/src/Lexer.hs
@@ -0,0 +1,460 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+{-
+**************************************************************************
+** This file is based on sources distributed as the haskell-src package **
+**************************************************************************
+The Glasgow Haskell Compiler License
+
+Copyright 2004, The University Court of the University of Glasgow. 
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+ 
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+ 
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission. 
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
+-}
+
+module Lexer (Token(..), lexer, readInteger, readNumber, readRational) where
+
+
+import ParseMonad
+import Char
+import Ratio
+import Token
+import Common
+
+
+{-
+
+The source location, (y,x), is the coordinates of the previous token.
+col is the current column in the source file.  If col is 0, we are
+somewhere at the beginning of the line before the first token.
+
+Setting col to 0 is used in two places: just after emitting a virtual
+close brace due to layout, so that next time through we check whether
+we also need to emit a semi-colon, and at the beginning of the file,
+to kick off the lexer.
+
+-}
+lexer :: (Token -> PM a) -> PM a
+lexer cont =
+    PM $ \input (y,x) col ->
+    if col == 0 then tab y x   True  input  col
+                else tab y col False input  col -- throw away old x
+    where
+    -- move past whitespace and comments
+    tab y x bol []          col = (unPM $ cont EOF) [] (y,x) col
+    tab y x bol ('\t':s)    col = tab y (nextTab x) bol s col
+    tab y x bol ('\n':s)    col = newLine s y col
+    tab y x bol ('-':'-':s) col = newLine (drop 1 (dropWhile (/= '\n') s))
+                                      y col
+    tab y x bol ('{':'-':s) col = nestedComment tab y x bol s col
+    tab y x bol (c:s)       col
+                 | isSpace c = tab y (x + 1) bol s col
+                 | otherwise =
+                     if bol then
+                         (unPM $ lexBOL cont)   (c:s) (y,x) x
+                     else
+                         (unPM $ lexToken cont) (c:s) (y,x) x
+
+    newLine s y col = tab (y + 1) 1 True s col
+
+
+nextTab x = x + (tab_length - (x - 1) `mod` tab_length)
+
+{-
+
+When we are lexing the first token of a line, check whether we need to
+insert virtual semicolons or close braces due to layout.
+
+-}
+lexBOL :: (Token -> PM a) -> PM a
+lexBOL cont =
+    PM $ \ s loc@(y,x) col ctx ->
+    if need_close_curly x ctx then 
+        -- tr' ("layout: inserting '}' at " ++ show loc ++ "\n") $
+        -- Set col to 0, indicating that we're still at the
+        -- beginning of the line, in case we need a semi-colon too.
+        -- Also pop the context here, so that we don't insert
+        -- another close brace before the parser can pop it.
+        (unPM $ cont VRightCurly) s loc 0 (tail ctx)
+    else if need_semi_colon x ctx then
+        -- tr' ("layout: inserting ';' at " ++ show loc ++ "\n") $
+        (unPM $ cont SemiColon) s loc col ctx
+    else
+        (unPM $ lexToken cont)  s loc col ctx
+    where
+        need_close_curly x []    = False
+        need_close_curly x (Layout n:Layout m:_)
+          | n <= m               = True
+        need_close_curly x (i:_) = case i of
+                                   NoLayout -> False
+                                   Layout n -> x < n
+                                   RecLayout n -> False
+
+        need_semi_colon x []     = False
+        need_semi_colon x (i:_)  = case i of
+                                   NoLayout -> False
+                                   Layout n -> x == n
+                                   RecLayout n -> x == n
+
+
+lexToken :: (Token -> PM a) -> PM a
+lexToken cont =
+    PM lexToken'
+    where
+    lexToken' (c:s) loc@(y,x') x =
+        -- trace ("lexer: y = " ++ show y ++ " x = " ++ show x ++ "\n") $ 
+        case c of
+        -- First the special symbols
+        '(' -> special LeftParen
+        ')' -> special RightParen
+        ',' -> special Comma
+        ';' -> special SemiColon
+        '[' -> special LeftSquare
+        ']' -> special RightSquare
+        '`' -> special BackQuote
+        '{' -> special LeftCurly
+        '}' -> \state ->
+               case state of
+               (_:ctxt) ->
+                   special RightCurly ctxt -- pop context on }
+               []       ->
+                   (unPM $ parseError "parse error (possibly incorrect indentation)")
+                   s loc x []
+
+        '\'' -> (unPM $ lexChar cont)   s loc (x + 1)
+        '\"' -> (unPM $ lexString cont) s loc (x + 1)
+
+        '_' | null s || not (isIdent (head s)) -> special Wildcard
+        
+        c | isDigit c ->
+              case lexInt (c:s) of
+              Decimal (n, rest) ->
+                  case rest of
+                  ('.':c2:rest2) | isDigit c2 ->
+                                     case lexFloatRest (c2:rest2) of
+                                     Nothing -> (unPM $
+                                                 parseError "illegal float.")
+                                                s loc x
+                                     Just (n2,rest3) ->
+                                         let f = n ++ ('.':n2) in
+                                         forward (length f) (FloatTok f) rest3
+                  _ -> forward (length n) (IntTok n) rest
+              Octal       (n,rest) -> forward (length n) (IntTok n) rest
+              Hexadecimal (n,rest) -> forward (length n) (IntTok n) rest
+
+          | isLower c -> lexVarId "" c s
+
+          | isUpper c -> lexQualName "" c s
+
+          | isSymbol c -> lexSymbol "" c s
+
+          | otherwise ->
+              (unPM $
+               parseError ("illegal character \'" ++
+                           showLitChar c "" ++ "\'\n"))
+              s loc x
+                  
+      where
+      special t = forward 1 t s
+      forward n t s = (unPM $ cont t) s loc (x + n)
+ 
+      join "" n = n
+      join q n  = q ++ '.' : n
+
+      len "" n = length n
+      len q n  = length q + length n + 1
+
+      lexFloatRest r = case span isDigit r of
+                       (r2, 'e':r3) -> lexFloatExp (r2 ++ "e") r3
+                       (r2, 'E':r3) -> lexFloatExp (r2 ++ "e") r3
+                       f@(r2,   r3) -> Just f
+ 
+      lexFloatExp r1 ('-':r2) = lexFloatExp2 (r1 ++ "-") r2
+      lexFloatExp r1 ('+':r2) = lexFloatExp2 (r1 ++ "+") r2
+      lexFloatExp r1      r2  = lexFloatExp2 r1          r2
+
+      lexFloatExp2 r1 r2 = case span isDigit r2 of
+                           ("", _ ) -> Nothing
+                           (ds, r3) -> Just (r1++ds,r3)
+      
+      lexVarId q c s = let (vidtail, rest) = span isIdent s
+                           vid             = c:vidtail
+                           l_vid           = len q vid
+              in
+                  case lookup vid reserved_ids of
+                  Just keyword -> case q of
+                                    "" -> forward l_vid keyword rest
+                                    _ -> (unPM $ parseError "illegal qualified name") s loc x
+                  Nothing      -> forward l_vid (VarId (q,vid)) rest
+
+      lexQualName q c s = let (contail, rest) = span isIdent s
+                              con             = join q (c:contail)
+                              l_con           = length con
+                          in case rest of
+                               '.': c' : rest'
+                                  | isUpper c' -> lexQualName con c' rest'
+                                  | isLower c' -> lexVarId con c' rest'
+                                  | isSymbol c' -> lexSymbol con c' rest'
+                                  | otherwise -> (unPM $ parseError "illegal qualified name") s loc x
+                               _ -> forward l_con (ConId (q,c:contail)) rest
+                  
+      lexSymbol q c s = let (symtail, rest) = span isSymbol s
+                            sym             = c:symtail
+                            l_sym = len q sym
+                        in case lookup sym reserved_ops of
+                                Just t  -> case q of
+                                    "" -> forward l_sym t rest
+                                    _ -> (unPM $ parseError "illegal qualified name") s loc x
+                                Nothing -> case c of
+                                 ':' -> forward l_sym (ConSym (q,sym)) rest
+                                 _   -> forward l_sym (VarSym (q,sym)) rest
+   
+      
+    lexToken' _  _ _ =
+        internalError0 "Lexer.lexToken: empty input stream."
+
+
+lexInt ('0':o:d:r) | toLower o == 'o' && isOctDigit d
+    = let (ds, rs) = span isOctDigit r
+      in
+           Octal       ('0':'o':d:ds, rs)
+lexInt ('0':x:d:r) | toLower x == 'x' && isHexDigit d
+    = let (ds, rs) = span isHexDigit r
+      in 
+           Hexadecimal ('0':'x':d:ds, rs)
+lexInt r = Decimal     (span isDigit r)
+
+
+lexChar :: (Token -> PM a) -> PM a
+lexChar cont = PM lexChar'
+    where
+    lexChar' s loc@(y,_) x =
+        case s of
+        '\\':s ->
+            let (e, s2, i) =
+                  runPM (escapeChar s) "" loc x []
+            in
+                charEnd e s2 loc (x + i)
+        c:s  -> charEnd c s  loc (x + 1)
+        []   -> internalError0 "Lexer.lexChar: empty list."
+
+    charEnd c ('\'':s)   =
+        \loc x -> (unPM $ cont (Character c)) s loc (x + 1)
+    charEnd c s         =
+        (unPM $ parseError "improperly terminated character constant.") s 
+
+
+lexString :: (Token -> PM a) -> PM a
+lexString cont = PM lexString'
+    where
+    lexString' s loc@(y',_) x = loop "" s x y'
+        where
+        loop e s x y =
+            case s of
+            '\\':'&':s  -> loop e s (x+2) y
+            '\\':c:s | isSpace c -> stringGap e s (x + 2) y
+                     | otherwise ->
+                         let (e', sr, i) =
+                               runPM (escapeChar (c:s)) ""  loc x [] 
+                         in
+                             loop (e':e) sr (x+i) y
+            '\"':s{-"-} -> (unPM $ cont (StringTok (reverse e))) s  loc (x + 1)
+            c:s       -> loop (c:e) s (x + 1) y
+            []          -> (unPM $ parseError "improperly terminated string.")
+                                    s  loc x
+
+        stringGap e s x y =
+            case s of
+                '\n':s -> stringGap e s 1 (y + 1)
+                '\\':s -> loop e s (x + 1) y
+                c:s' | isSpace c -> stringGap e s' (x + 1) y
+                     | otherwise ->
+                         (unPM $ parseError "illegal character in string gap.")
+                         s  loc x
+                []     -> internalError0 "Lexer.stringGap: empty list."
+
+
+escapeChar :: String -> PM (Char, String, Int)
+escapeChar s = case s of
+   'a':s         -> return ('\a', s, 2)
+   'b':s         -> return ('\b', s, 2)
+   'f':s         -> return ('\f', s, 2)
+   'n':s         -> return ('\n', s, 2)
+   'r':s         -> return ('\r', s, 2)
+   't':s         -> return ('\t', s, 2)
+   'v':s         -> return ('\v', s, 2)
+   '\\':s        -> return ('\\', s, 2)
+   '"':s         -> return ('\"', s, 2)      -- "
+   '\'':s        -> return ('\'', s, 2)
+
+   '^':x@(c:s)   -> cntrl x
+   'N':'U':'L':s -> return ('\NUL', s, 4)
+   'S':'O':'H':s -> return ('\SOH', s, 4)
+   'S':'T':'X':s -> return ('\STX', s, 4)
+   'E':'T':'X':s -> return ('\ETX', s, 4)
+   'E':'O':'T':s -> return ('\EOT', s, 4)
+   'E':'N':'Q':s -> return ('\ENQ', s, 4)
+   'A':'C':'K':s -> return ('\ACK', s, 4)
+   'B':'E':'L':s -> return ('\BEL', s, 4)
+   'B':'S':s     -> return ('\BS',  s, 3)
+   'H':'T':s     -> return ('\HT',  s, 3)
+   'L':'F':s     -> return ('\LF',  s, 3)
+   'V':'T':s     -> return ('\VT',  s, 3)
+   'F':'F':s     -> return ('\FF',  s, 3)
+   'C':'R':s     -> return ('\CR',  s, 3)
+   'S':'O':s     -> return ('\SO',  s, 3)
+   'S':'I':s     -> return ('\SI',  s, 3)
+   'D':'L':'E':s -> return ('\DLE', s, 4)
+   'D':'C':'1':s -> return ('\DC1', s, 4)
+   'D':'C':'2':s -> return ('\DC2', s, 4)
+   'D':'C':'3':s -> return ('\DC3', s, 4)
+   'D':'C':'4':s -> return ('\DC4', s, 4)
+   'N':'A':'K':s -> return ('\NAK', s, 4)
+   'S':'Y':'N':s -> return ('\SYN', s, 4)
+   'E':'T':'B':s -> return ('\ETB', s, 4)
+   'C':'A':'N':s -> return ('\CAN', s, 4)
+   'E':'M':s     -> return ('\EM',  s, 3)
+   'S':'U':'B':s -> return ('\SUB', s, 4)
+   'E':'S':'C':s -> return ('\ESC', s, 4)
+   'F':'S':s     -> return ('\FS',  s, 3)
+   'G':'S':s     -> return ('\GS',  s, 3)
+   'R':'S':s     -> return ('\RS',  s, 3)
+   'U':'S':s     -> return ('\US',  s, 3)
+   'S':'P':s     -> return ('\SP',  s, 3)
+   'D':'E':'L':s -> return ('\DEL', s, 4)
+
+
+   -- Depending upon the compiler/interpreter's Char type, these yield either
+   -- just 8-bit ISO-8859-1 or 2^16 UniCode.
+
+   -- Octal representation of a character
+   'o':s           -> let (ds, s') = span isOctDigit s
+                          n        = readNumber 8 ds
+                      in 
+                          numberToChar n s' (length ds + 1)
+
+   -- Hexadecimal representation of a character
+   'x':s           -> let (ds, s') = span isHexDigit s
+                          n        = readNumber 16 ds
+                      in
+                          numberToChar n s' (length ds + 1)
+ 
+   -- Base 10 representation of a character
+   d:s | isDigit d -> let (ds, s') = span isDigit s
+                          n        = readNumber 10 (d:ds)
+                      in 
+                          numberToChar n s' (length ds + 1)
+
+   _               -> parseError "illegal escape sequence."
+
+   where numberToChar n s l_n =
+             if n < (toInteger $ fromEnum (minBound :: Char)) ||
+                n > (toInteger $ fromEnum (maxBound :: Char)) then
+                 parseError "illegal character literal (number out of range)."
+             else
+                 return (chr $ fromInteger n, s, l_n)
+            
+
+cntrl :: String -> PM (Char, String, Int)
+cntrl (c   :s) | isUpper c = return (chr (ord c - ord 'A'), s, 2)
+cntrl ('@' :s)             = return ('\^@', s, 2)
+cntrl ('[' :s)             = return ('\^[', s, 2)
+cntrl ('\\':s)             = return ('\^\', s, 2)
+cntrl (']' :s)             = return ('\^]', s, 2)
+cntrl ('^' :s)             = return ('\^^', s, 2)
+cntrl ('_' :s)             = return ('\^_', s, 2)
+cntrl _                    = parseError "illegal control character"
+
+
+nestedComment cont y x bol s  col =
+    case s of
+    '-':'}':s -> cont y (x + 2) bol s  col
+    '{':'-':s -> nestedComment (nestedComment cont) y (x + 2) bol s  col
+    '\t':s    -> nestedComment cont y (nextTab x) bol s  col
+    '\n':s    -> nestedComment cont (y + 1) 1 True s  col
+    c:s       -> nestedComment cont y (x + 1) bol s  col
+    []        -> error "Open comment at end of file"
+
+
+
+readInteger :: String -> Integer
+readInteger ('0':'o':ds) = readInteger2  8 isOctDigit ds
+readInteger ('0':'O':ds) = readInteger2  8 isOctDigit ds
+readInteger ('0':'x':ds) = readInteger2 16 isHexDigit ds
+readInteger ('0':'X':ds) = readInteger2 16 isHexDigit ds
+readInteger          ds  = readInteger2 10 isDigit    ds
+
+readNumber :: Integer -> String -> Integer
+readNumber radix ds = readInteger2 radix (const True) ds
+
+readInteger2 :: Integer -> (Char -> Bool) -> String -> Integer
+readInteger2 radix isDig ds 
+  = foldl1 (\n d -> n * radix + d) (map (fromIntegral . digitToInt) 
+                                    (takeWhile isDig ds))
+
+readRational :: String -> Rational
+readRational xs
+    = (readInteger (i ++ m))%1 * 10^^((case e of
+                                       ""       -> 0
+                                       ('+':e2) -> read e2
+                                       _        -> read e) - length m)
+      where (i, r1) = span isDigit xs
+            (m, r2) = span isDigit (dropWhile (== '.') r1)
+            e       = dropWhile (== 'e') r2
+
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,448 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Main where
+
+-- Haskell98
+import System(getArgs)
+import List(isSuffixOf)
+import qualified Monad
+import qualified Char
+import qualified Control.Exception as Exception ( catch, catchJust )
+import System.Console.GetOpt
+import qualified Directory
+
+-- Timber Compiler
+import System.FilePath
+import Config
+import Execution
+import PP
+import Common
+import Parser
+import qualified Syntax
+import qualified Core
+import Desugar1
+import Rename
+import Desugar2
+import Depend
+import Syntax2Core
+import Kind
+import Type
+import Termred
+import Type2
+import Kindle
+import Kindlered
+import Prepare4C
+import Kindle2C
+import Core2Kindle
+import Lambdalift
+import Data.Binary
+import Interfaces
+import GHC.Exception
+{-
+
+Lexer:
+- Checks lexical syntax and builds token stream
+- Removes comments
+
+Parser:
+- Checks basic syntax and builds parse tree
+- Builds constructor syntax (parsed as qualified types)
+- Resolves nested infix expressions
+- Converts record labels to proper selectors (with prefix .)
+- Replaces prefix tuple constructors with primitive names
+
+Desugar1:
+- Checks record type acyclicity and selector consistence
+- Completes dotdot record patterns and expressions with missing fields
+- Translates instance declarations into instance signatures and named record terms
+- Checks and resolves if/elsif/else statements
+- Makes the "self" variable explicit.
+- Checks validity of return statement
+- Replaces prefix expression statement with dummy generator statement
+- Replaces if/case statements with corresponding expressions forms
+- Checks the restricted command syntax of template bodies
+
+Rename:
+- Checks for duplicate declarations and kind signatures
+- Checks for duplicate selectors and constructors, and overlaps with class members
+- Checks for duplicate equations and type signatures
+- Checks for duplicated variables in patterns and templates
+- Checks for duplication and dandling abstractions in type predicates
+- Checks for unbound variables (not yet implemented -- what to do with globals?)
+
+- Makes every type variable binding explicit in signatures and constructor declarations
+- Shuffles signatures as close as possible to the corresponding definition (incl. inside patterns)
+
+- Renames local variables using unique names
+- Renames local (explicitly quantified) type variables using unique names
+
+Desugar2:
+- Checks validity of type and type scheme syntax in signatures and declarations
+- Checks qualified types for syntactic ambiguity
+- Removes special syntax for list, tuple and function types, as well as subtype predicates
+- Captures single-variable predicates as short-hand for wildcard kind signature
+- Checks syntactic validity of patterns
+- Replaces after, before, [] and (:) with primitive names
+- Replaces tuple expressions with primitive constructor applications 
+- Translates if expressions, operator sections, negations
+- Collects functions defined with multiple equations while checking arities
+- Flattens pattern bindings
+- Removes non-trivial patterns in lambdas, assignments and generators
+- Translates list expressions/patterns and list comprehensions
+
+- Applies pattern-matching compiler to case expressions
+
+Syntax2Core:
+- Injects instance signatures among global type signatures
+
+- Splits predicate contexts into kind environments (quantifiers) and predicates proper (qualifiers)
+- Checks validity of base type syntax in declarations
+- Replaces _ kinds with unique unification variable
+- Replaces _ types with unique unification variable
+
+- Applies up/down signature propagation within constructor/selector/member/signature environment
+- Completes bindings and lambdas with missing signatures
+
+- Does dependency analysis on local bindings
+- Builds Core syntax tree
+
+Kind:
+- Does dependency analysis on type declarations
+- Performs kind inference, replacing every kind unification variable (defaulting to *)
+
+Decls:
+- Extracts selector and constructor type schemes
+- Generates global member signatures and bindings
+- Replaces subtyping in type declarations with explicit coercion constructors/selectors
+
+- Initiate subtyping graphs with reflexivity axioms (identity witness)
+- Computes subtype above & below graph, closed under transitivity (checks cyclic and ambiguity errors)
+- Computes instance overlap graph, closed under superclass relation (checks cyclic and ambiguity errors)
+
+Type:
+- Does dependency analysis on top-level bindings
+- Performs type inference and constraint simplification/solving
+- Makes all function calls match the arity of the called function
+- Inserts explicit overloading and subtyping witnesses
+
+Termred:
+- Does simple term level reduction and restricted inlining within primitive environment (witnesses only)
+
+Core2Kindle:
+- Converts type expressions by making closure types explicit
+- Approximates polymorphism by the wildcard type
+- Splits non-trivial datatypes into constructor records with a common tag field
+
+- Encodes monadic code by means of extra (mutable) state argument
+
+- Sorts equations into value or function definitions, on basis of arity
+- Makes fatbar and fail pattern-matching operators explicit, removes match and commit
+- Implements after and before primitives in terms of Time arithmetic
+- 
+- Replaces act and req by calls to the rts
+
+- Builds Kindle abstract syntax
+
+LambdaLift:
+- Abstracts out free local variables from local function definitions and adds corresponding arguments to call sites
+- Abstracts out free local variables from struct functions as extra value fields referenced through "this"
+- Moves local function definitions to the top level
+
+Kindle2C:
+- Makes construction of cyclic data explicit
+- Pretty-prints abstract syntax as C code
+
+
+-}
+
+
+-- | This compiles a set of Timber modules. 
+-- | Example: 'compile ["Main"] compiles the module in Main.t
+-- | leaving the result in Main.c
+-- | It also compiles every module *called* by this module 
+-- | right now.
+
+
+compileTimber clo ifs (sm,t_file) ti_file c_file h_file
+                        = do let Syntax.Module n is _ _ = sm
+                             putStrLn ("[compiling "++ t_file++"]")
+                             (imps,ifs') <- chaseIfaceFiles clo is ifs
+                             let ((htxt,mtxt),ifc) = runM (passes imps sm)
+                             encodeCFile ti_file ifc
+                             writeFile c_file mtxt
+                             writeFile h_file htxt
+                             if api clo then do
+                                                writeAPI (rmSuffix ".ti" ti_file) ifc
+                                                return ((n,ifc):ifs')
+                              else return ((n,ifc):ifs')
+  where passes imps par = do (e0,e1,e2,e3) <- initEnvs imps
+                             (d1,a0) <- pass clo (desugar1 e0)                Desugar1  par
+                             rn      <- pass clo (renameM e1)                 Rename    d1
+                             d2      <- pass clo desugar2                     Desugar2  rn
+                             co      <- pass clo syntax2core                  S2C       d2
+                             kc      <- pass clo (kindcheck e2)               KCheck    co
+                             tc      <- pass clo (typecheck e2)               TCheck    kc
+                             rd      <- pass clo (termred e2)                 Termred   tc
+                             tc2     <- pass clo (typecheck2 e2)              Type2     rd
+                             (ki,ds) <- pass clo (core2kindle e2 e3)          C2K       tc2
+                             ki'     <- pass clo (kindlered e3)               Kindlered ki
+                             ll      <- pass clo (lambdalift e3)              LLift     ki'
+                             pc      <- pass clo (prepare4c e2 e3)            Prepare4C ll
+                             c       <- pass clo (kindle2c (init_order imps)) K2C       pc
+                             return (c,ifaceMod a0 tc2 ds)
+
+        
+pass clo m p a          = do -- tr ("Pass " ++ show p ++ " ...")
+                             r <- m a
+                             Monad.when (dumpAfter clo p) 
+                                $ tr ("#### Result after " ++ show p ++ ":\n\n" ++ render (pr r))
+                             Monad.when (stopAfter clo p)
+                                $ fail ("#### Terminated after " ++ show p ++ ".")
+                             return r                                  
+
+makeProg clo cfg root   = do txt <- readFile (root ++ ".t")
+                             let ms@(Syntax.Module n is _ _) = runM (parser txt)
+                             (imps,ss) <- chaseSyntaxFiles clo is [(n,ms)]
+                             let cs = compile_order imps
+                                 is = filter nonDummy cs
+                             let ps = map (\(n,ii) -> (snd ii,modToPath (str n)++".t")) is ++ [(ms,root++".t")]
+                             ifs <- compileAll (clo {shortcut = True}) [] ps
+                             r <- checkRoot clo ifs root
+                             let basefiles = map (rmSuffix ".t" . snd) ps
+                                 c_files   = map (++ ".c") basefiles
+                                 o_files   = map ((++ ".o") . rmDirs) basefiles
+                             mapM (compileC cfg clo) c_files
+                             linkO cfg clo{outfile = root} r o_files
+  where nonDummy (_,(_,Syntax.Module n _ _ _)) = str n /= ""
+
+
+parse clo t_file        = do t_exists <- Directory.doesFileExist t_file
+                             Monad.when (not t_exists) (fail ("File " ++ t_file ++ " does not exist."))
+                             txt <- readFile t_file
+                             let syntax = runM (pass clo parser Parser txt)
+                             return (syntax,t_file)
+
+compileAll clo ifs []   = return ifs
+compileAll clo ifs (p@(ms,t_file):t_files)
+                        = do res <- checkUpToDate clo t_file ti_file c_file h_file (impNames ms)
+                             if res then do 
+                                 putStrLn ("[skipping " ++ t_file ++ " (output is up to date)]")
+                                 compileAll clo ifs t_files
+                              else do
+                                 ifs' <- compileTimber clo ifs (longName p) ti_file c_file h_file
+                                 compileAll clo ifs' t_files
+  where base            = rmSuffix ".t" t_file
+        ti_file         = base ++ ".ti"
+        c_file          = base ++ ".c"
+        h_file          = base ++ ".h"
+        qm              = takeBaseName t_file
+        longName (Syntax.Module m a b c,t)
+          |reverse(takeWhile (/= '.') (reverse qm))==str m = (Syntax.Module (name0 qm) a b c,t_file)
+          |otherwise = errorIds "Module name not last constructor id in file name" [m]
+
+checkUpToDate clo t_file ti_file c_file h_file imps
+  | shortcut clo        = do ti_exists <- Directory.doesFileExist ti_file
+                             c_exists  <- Directory.doesFileExist c_file
+                             h_exists  <- Directory.doesFileExist h_file
+                             if not ti_exists || not c_exists || not h_exists then 
+                                 return False 
+                              else do
+                                 t_time  <- Directory.getModificationTime t_file
+                                 ti_time <- Directory.getModificationTime ti_file
+                                 c_time  <- Directory.getModificationTime c_file
+                                 h_time  <- Directory.getModificationTime h_file
+                                 ti_OKs <- mapM (tiOK ti_time) imps
+                                 return (t_time < ti_time && t_time < c_time && t_time < h_time && and ti_OKs)
+  | otherwise           = return False
+  where tiOK ti_time1 n = do let ti_file = modToPath (str n) ++ ".ti"
+                             ti_exists <- Directory.doesFileExist ti_file
+                             if (not ti_exists) then do
+                                let lti_file = Config.libDir clo ++ "/" ++ modToPath (str n) ++ ".ti"
+                                lti_exists <- Directory.doesFileExist lti_file
+                                if (not lti_exists) then
+                                   internalError0 ("Cannot find interface file " ++ ti_file)
+                                 else do lti_time <- Directory.getModificationTime lti_file
+                                         return (lti_time <= ti_time1)
+                               -- return True  -- library module
+                               else do ti_time <- Directory.getModificationTime ti_file
+                                       return (ti_time <= ti_time1)
+------------------------------------------------------------------------------
+
+main                = do args <- getArgs
+                         main2 args
+
+-- | We have the second entry point so ghci/hugs users can call
+-- | main2 directly with arguments.
+
+main2 args          = do (clo, files) <- Exception.catch (cmdLineOpts args)
+                                         fatalErrorHandler
+                         cfg          <- Exception.catch (readCfg clo)
+                                         fatalErrorHandler
+
+                         let t_files  = filter (".t"  `isSuffixOf`) files
+                             i_files  = filter (".ti" `isSuffixOf`) files
+                             o_files  = filter (".o" `isSuffixOf`) files
+                             badfiles = files \\ (t_files++i_files++o_files)
+                         
+                         Monad.when (not (null badfiles)) $ do
+                             fail ("Bad input files: " ++ showids badfiles)
+                         
+                         mapM (listIface clo) i_files
+--                         Monad.when (null t_files) stopCompiler
+                         
+                         ps <- mapM (parse clo) t_files
+                         ifs <- compileAll clo [] ps `Exception.catch` handleError
+                         Monad.when (stopAtC clo) stopCompiler
+                         
+                         let root = make clo
+                         Monad.when (root/="") (makeProg clo cfg root)
+
+                         let basefiles = map (rmSuffix ".t") t_files
+                             c_files   = map (++ ".c") basefiles
+                         mapM (compileC cfg clo) c_files
+                         Monad.when (stopAtO clo) stopCompiler
+
+                         let basenames = map rmDirs basefiles
+                             o_files'   = map (++ ".o") basenames
+                         Monad.when(not (null basenames)) (do r <- checkRoot clo ifs (last basenames)
+                                                              linkO cfg clo r (o_files ++ o_files'))
+
+                         return ()
+
+handleError (ErrorCall mess) = do
+  putStr ("*** Timber compilation error ***\n"++mess++"\n")
+  abortCompiler
+
+
+checkRoot clo ifs def       = do if1 <- getIFile rootMod
+                                 if2 <- getIFile rtsMod 
+                                 let ts = tEnv if2
+                                     ke = Core.ksigsOf ts
+                                     ds = Core.tdefsOf ts
+                                     te = Core.tsigsOf (valEnv if1)
+                                 case lookup rootT ke of
+                                     Nothing   -> fail ("Cannot locate RootType in module " ++ rtsMod)
+                                     Just Star -> case lookup rootT ds of
+                                        Nothing                -> error "Internal: checkRoot"
+                                        Just (Core.DType _ t') -> checkRoot' te t'
+                                        Just _                 -> checkRoot' te (Core.TId rootT)
+                                     Just _    -> fail ("Bad RootType in module " ++ rtsMod)
+                                         
+  where rtsMod              = target clo
+        (r,rootMod)         = splitQual (root clo) def
+        rootN               = qName rootMod (name0 r)
+        rootT               = qName rtsMod (name0 "RootType")
+        checkRoot' te t0    = case [ (n,sc) | (n,sc) <- te, n == rootN ] of
+                                [(n,sc)]  -> if Core.sameType sc t0
+                                            then return n
+                                            else fail ("Incorrect root type: " ++ render (pr sc) ++ "; should be " ++ render(pr t0))
+                                _ -> fail ("Cannot locate root " ++ (root clo) ++ " in module " ++ rootMod)
+        getIFile m          = case lookup (name0 m) ifs of
+                                Just ifc -> return ifc
+                                Nothing -> do (ifc,_) <- decodeModule clo (modToPath m ++ ".ti")
+                                              return ifc
+
+------------------------------------------------------------------------------
+
+-- | Catch internal errors, print them and then abortCompiler.
+fatalErrorHandler   :: TimbercException -> IO a
+fatalErrorHandler e =  do putStrLn (show e)
+                          abortCompiler
+
+
+
+
+
+-- Getting import info ---------------------------------------------------------
+
+
+chaseImps                         :: (String -> IO (a,String)) -> (Bool -> a -> [(Name,Bool)]) -> String -> [Syntax.Import] -> Map Name a -> IO (Map Name (ImportInfo a), Map Name a)
+chaseImps readModule iNames suff imps ifs              
+                                     = do bms <- mapM (readImport ifs) imps
+                                          let newpairs = [p | (p,True) <- bms]
+                                              ifs1 =  [(c,ifc) | (c,(_,ifc)) <- newpairs] ++ ifs
+                                          chaseRecursively ifs1 (map fst bms) (concat [ iNames b c |  ((_,(b,c)),_) <- bms ])
+  where readIfile ifs c              = case lookup c ifs of
+                                        Just ifc -> return (ifc,False)
+                                        Nothing -> do (ifc,f) <- readModule f
+                                                      return (ifc,True)
+                                          where f = modToPath(str c) ++ suff
+        readImport ifs (Syntax.Import b c) 
+                                     = do (ifc,isNew) <- readIfile ifs c
+                                          return ((c,(b,ifc)),isNew)
+        chaseRecursively ifs ms []= return (ms,ifs)
+        chaseRecursively ifs ms (p@(r,unQual) : rs)
+                                     = case lookup r ms of
+                                          Just (b,_) 
+                                            | not b && unQual -> chaseRecursively ifs (update r ms) rs -- found import chain; previously only use chain
+                                            | otherwise -> chaseRecursively ifs ms rs
+                                          Nothing -> do (ifc,isNew)  <- readIfile ifs r
+                                                        chaseRecursively (if isNew then (r,ifc) : ifs else ifs) ((r,(unQual,ifc)) : ms) (rs ++ iNames unQual ifc)
+        update r ((r',(_,ifc)) : ps)
+             | r == r'              = (r,(True,ifc)) : ps
+        update r (p : ps)          = p : update r ps
+        update _ []                = internalError0 "Main.update: did not find module"
+        
+
+
+chaseIfaceFiles clo                 = chaseImps (decodeModule clo) impsOf2 ".ti"
+  where impsOf2 b i                 = map (\(b',c) -> (c,b && b')) (impsOf i)
+                                          
+impName (Syntax.Import b c)          = c
+impNames (Syntax.Module _ is _ _)    = map impName is
+
+impNames2 b (Syntax.Module _ is _ _)    
+                                     = map  (\(Syntax.Import b' c) -> (c,b && b')) is
+
+chaseSyntaxFiles clo                 = chaseImps readSyntax impNames2 ".t"
+  where readSyntax f                 = (do cont <- readFile f
+                                           let sm = runM (parser cont)
+                                           return (sm,f)) `catch` (\ e -> do  let libf = Config.libDir clo ++ "/" ++ f
+                                                                              t_exists <- Directory.doesFileExist libf
+                                                                              if t_exists 
+                                                                                then return (Syntax.Module (name0 "") [] [] [],libf) 
+                                                                                else fail ("File "++ f ++ " does not exist."))
+                                                                              
+
+transImps (_,ifc)                  = map snd (impsOf ifc)
+
+compile_order imps                   = case topSort (impNames . snd)  imps of 
+                                         Left ms  -> errorIds "Mutually recursive modules" ms
+                                         Right is -> is
+
+init_order imps                      = case topSort transImps imps of
+                                         Left ms  -> errorIds "Mutually recursive modules" ms
+                                         Right is -> map fst is
+
+
diff --git a/src/Match.hs b/src/Match.hs
new file mode 100644
--- /dev/null
+++ b/src/Match.hs
@@ -0,0 +1,175 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Match where
+
+import Common
+import Syntax
+import Monad
+import qualified List
+
+pmc :: Exp -> [Alt Exp] -> M s Exp
+pmc e alts                      = do e' <- match0 e alts
+                                     return (eMatch e')
+
+pmc' :: [Name] -> [([Pat],Rhs Exp)] -> M s Exp
+pmc' ws eqs                     = do e <- match ws eqs
+                                     return (eMatch e)
+
+
+-- The primitive pmc constants -----------------------------------------------------------
+
+eFatbar (EVar (Prim Fail _)) e  = e
+eFatbar e (EVar (Prim Fail _))  = e
+eFatbar e e'                    = foldl EAp (EVar (prim Fatbar)) [e,e']
+eFail                           = EVar (prim Fail)
+eCommit e                       = EAp (EVar (prim Commit)) e
+eMatch e                        = case e of
+                                    EAp (EVar (Prim Commit _)) e' -> e'
+                                    ELet bs (EAp (EVar (Prim Commit _)) e') -> ELet bs e'
+                                    _  -> EAp (EVar (prim Match)) e
+
+
+fat []                          = return eFail
+fat [m]                         = m
+fat (m:ms)                      = do e1 <- m
+                                     e2 <- fat ms
+                                     return (eFatbar e1 e2)
+
+
+-- Pattern-matching compiler proper -----------------------------------------------------
+
+match0 (EVar w) alts            = match [w] [ ([p], rh) | Alt p rh <- alts ]
+match0 e alts
+  | all isTriv alts             = return (ECase e [ Alt p (RExp (eCommit e)) | Alt p (RExp e) <- alts ])
+  | otherwise                   = do w <- newNamePos tempSym e
+                                     e' <- match0 (EVar w) alts
+                                     return (ELet [BEqn (LFun w []) (RExp e)] e')
+  where isTriv (Alt (ECon _) (RExp _))  = True
+        isTriv _                        = False
+
+
+match ws eqs                    = fat (match1 ws eqs)
+
+match1 ws []                    = []
+match1 [] (([],rhs):eqs)        = matchRhs rhs : match1 [] eqs
+match1 (w:ws) eqs
+  | all isVarEq eqs             = match1 ws (map f eqs)
+  where f (EVar v : ps, rh)     = (ps, subst (v +-> EVar w) rh)
+match1 ws (eq:eqs)
+  | isSigVarEq eq               = matchVar ws eq : match1 ws eqs
+  | isLitEq eq                  = matchLits ws [eq] eqs
+  | isERecEq eq                 = matchRecs ws [eq] eqs
+  | otherwise                   = matchCons ws [prepConEq eq] eqs
+
+
+isLitEq (p:ps,rh)               = isELit p
+
+isVarEq (p:ps,rh)               = isEVar p
+
+isSigVarEq (p:ps,rh)            = isESigVar p
+
+isERecEq (p:ps,rh)              = isERec p
+
+isConEq (p:ps,rh)               = isEConApp p
+
+
+
+matchVar (w:ws) (EVar v:ps, rh) = match ws [(ps, subst (v +-> EVar w) rh)]
+matchVar (w:ws) (ESig (EVar v) t : ps, rh)
+                                = match ws [(ps, RWhere rh bs)]
+  where bs                      = [BSig [v] t, BEqn (LFun v []) (RExp (EVar w))]
+
+
+matchLits ws eqs (eq:eqs')
+  | isLitEq eq                  = matchLits ws (eq:eqs) eqs'
+matchLits ws eqs eqs'           = matchLit ws (reverse eqs) : match1 ws eqs'
+
+
+matchLit (w:ws) eqs             = do alts <- mapM matchAlt lits
+                                     return (ECase (EVar w) alts)
+  where lits                    = nub [ l | (ELit l : ps, rhs) <- eqs ]
+        matchAlt l              = do e' <- match ws eqs'
+                                     return (Alt (ELit l) (RExp e'))
+          where eqs'            = [ (ps,rhs) | (ELit l' : ps, rhs) <- eqs, l'==l ]
+
+matchRecs ws eqs (eq:eqs')
+  | isERecEq eq                 = matchRecs ws (eq:eqs) eqs'
+matchRecs ws eqs eqs'           = matchRec ws (reverse eqs) : match1 ws eqs'
+
+matchRec (w:ws) eqs             = do vs <- newNamesPos tempSym fs
+                                     e <- match (vs ++ ws) (map matchAlt eqs)
+                                     return (foldr ELet e (zipWith mkEqn vs fs))
+  where ERec _ fs               = head (fst (head eqs))
+        mkEqn v (Field l _)     = [BEqn (LFun v []) (RExp (ESelect (EVar w) l))]
+        matchAlt (ERec _ fs:ps,rh)
+                                = (map patOf fs++ps,rh)
+        patOf (Field _ p)       = p
+ 
+prepConEq (p:ps,rhs)            = (c, ps', ps, rhs)
+  where (ECon c, ps')           = eFlat p
+
+
+matchCons ws ceqs (eq:eqs')
+  | isConEq eq                  = matchCons ws (prepConEq eq : ceqs) eqs'
+matchCons ws ceqs eqs'          = matchCon ws (reverse ceqs) : match1 ws eqs'
+
+
+matchCon (w:ws) ceqs            = do alts <- mapM matchAlt cs
+                                     return (ECase (EVar w) alts)
+  where cs                      = nub [ c | (c,_,_,_) <- ceqs ]
+        matchAlt c              = do vs <- newNamesPos tempSym (maxPat [] 0 eqs_c)
+                                     e  <- match (vs++ws) (map (mkeq vs) eqs_c)
+                                     return (Alt (ECon c) (RExp (eLam (map EVar vs) e)))
+          where eqs_c           = [ (ps', ps, rhs) | (c',ps',ps,rhs) <- ceqs, c==c' ]
+                maxPat ps _ []  = ps
+                maxPat ps n ((ps',_,_) : ceqs)
+                   |length ps' > n = maxPat ps' (length ps') ceqs
+                   |otherwise      = maxPat ps n ceqs
+--                arity_c         = maximum [ length ps' | (ps', ps, rhs) <- eqs_c ]
+        mkeq vs (ps',ps,rhs)    = (ps'++vs' ++ ps, rAp rhs vs')
+          where vs'             = map EVar (drop (length ps') vs)
+
+
+matchRhs (RExp e)               = return (eCommit e)
+matchRhs (RWhere rhs bs)        = do e <- matchRhs rhs
+                                     return (ELet bs e)
+matchRhs (RGrd gs)              = fat [ matchQuals qs e | GExp qs e <- gs ]
+
+
+matchQuals [] e                 = return (eCommit e)
+matchQuals (QGen p e' : qs) e   = match0 e' [Alt p (RGrd [GExp qs e])]
+matchQuals (QLet bs : qs) e     = do e' <- matchQuals qs e
+                                     return (ELet bs e')
+matchQuals (QExp e' : qs) e     = matchQuals (QGen true e' : qs) e
+
diff --git a/src/Name.hs b/src/Name.hs
new file mode 100644
--- /dev/null
+++ b/src/Name.hs
@@ -0,0 +1,619 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Name where
+
+import Debug.Trace
+import List
+import PP
+import Token
+import Char
+import Maybe
+import Data.Binary 
+
+-- The type of names ---------------------------------------------------------------------
+
+data Name                       = Name  { str :: String, tag :: Int, fromMod :: Maybe String, annot :: Annot }
+                                | Prim  { con :: Prim, annot :: Annot }
+                                | Tuple { width :: Int, annot :: Annot }
+
+
+data Annot                      = Annot { location :: Maybe (Int,Int), 
+                                          explicit :: Bool, 
+                                          stateVar :: Bool , 
+                                          generated :: Bool,
+                                          suppressMod :: Bool
+                                        }
+                                deriving Show
+
+
+-- The built-in primitives ----------------------------------------------------------------
+
+data Prim                       = 
+
+                                -- Constructor identifiers
+
+                                  MIN____TYPE
+
+                                | Action                -- Types
+                                | Request
+                                | Class
+                                | Cmd
+
+                                | Msg
+                                | Ref
+                                | PID
+                                | PMC
+                                | Time
+
+                                | Int
+                                | Float
+                                | Char
+                                | Bool
+
+                                | BITS8
+                                | BITS16
+                                | BITS32
+
+                                | Array
+                                | EITHER
+
+                                -- Constructor symbols (special syntax)
+
+                                | LIST                  -- Type
+                                | UNITTYPE              -- Type
+                                | TIMERTYPE             
+
+                                | MAX____TYPE
+                                
+                                | MIN____CONS
+                                
+                                | UNITTERM              -- Term
+                                | NIL                   -- Term
+                                | CONS                  -- Term
+
+                                -- Constructor identifiers
+
+                                | FALSE                 -- Terms
+                                | TRUE
+                                | LEFT
+                                | RIGHT
+
+                                | MAX____CONS
+                                | MIN____SELS
+
+                                | Reset
+                                | Sample
+ 
+                                | MAX____SELS
+                                
+                                -- Variable identifiers
+
+                                | MIN____VAR
+                                
+                                | Refl                  -- Terms
+
+                                | MIN____KINDLE_INFIX
+                                
+                                | IntPlus
+                                | IntMinus
+                                | IntTimes
+                                | IntDiv
+                                | IntMod
+
+                                | IntEQ
+                                | IntNE
+                                | IntLT
+                                | IntLE
+                                | IntGE
+                                | IntGT
+                                
+                                | FloatPlus
+                                | FloatMinus
+                                | FloatTimes
+                                | FloatDiv
+                                
+                                | FloatEQ
+                                | FloatNE
+                                | FloatLT
+                                | FloatLE
+                                | FloatGE
+                                | FloatGT
+
+                                | PidEQ
+                                | PidNE
+                                
+                                | LazyOr
+                                | LazyAnd
+
+                                | AND8
+                                | OR8
+                                | EXOR8
+                                | SHIFTL8
+                                | SHIFTR8
+                                
+                                | AND16
+                                | OR16
+                                | EXOR16
+                                | SHIFTL16
+                                | SHIFTR16
+                                
+                                | AND32
+                                | OR32
+                                | EXOR32
+                                | SHIFTL32
+                                | SHIFTR32
+
+                                | MAX____KINDLE_INFIX
+
+                                | SHIFTRA8
+                                | SET8
+                                | CLR8
+                                | TST8
+
+                                | SHIFTRA16
+                                | SET16
+                                | CLR16
+                                | TST16
+
+                                | SHIFTRA32
+                                | SET32
+                                | CLR32
+                                | TST32
+
+                                | IntNeg
+                                | FloatNeg
+
+                                | IntToFloat
+                                | FloatToInt
+
+                                | NOT8
+                                | NOT16
+                                | NOT32
+                                
+                                | Sqrt
+                                | Log
+                                | Log10
+                                | Exp
+                                | Sin
+                                | Cos
+                                | Tan
+                                | Asin
+                                | Acos
+                                | Atan
+                                | Sinh
+                                | Cosh
+                                | ShowFloat
+
+                                | Sec
+                                | Millisec
+                                | Microsec
+                                | Nanosec
+                                | Infinity
+                                | SecOf
+                                | MicrosecOf
+                                
+                                | TimePlus
+                                | TimeMinus
+                                | TimeMin
+                                
+                                | TimeEQ
+                                | TimeNE
+                                | TimeLT
+                                | TimeLE
+                                | TimeGE
+                                | TimeGT
+
+                                | Raise
+                                | Catch
+                                
+                                | ListArray
+                                | UniArray
+                                | SizeArray
+                                | IndexArray
+                                | UpdateArray
+                                
+                                | MAX____KINDLEVAR
+
+                                | Abort                 -- Preserved in Kindle, but given new translated types
+                                | TIMERTERM             --                       -"-
+
+                                
+-- transformed away during Kindle conversion ----------------------------------------------------
+
+                                | ActToCmd
+                                | ReqToCmd
+                                | RefToPID
+
+                                | CharToInt
+                                | IntToChar
+
+                                | BITS8ToInt
+                                | BITS16ToInt
+                                | BITS32ToInt
+                                
+                                | IntToBITS8
+                                | IntToBITS16
+                                | IntToBITS32
+                                
+                                | MAX____VAR
+
+-- invisible ------------------------------------------------------------------------------------
+
+                                | MIN____INVISIBLE
+                                
+                                | New                   -- Encoding of the class instantiation syntax in terms of an operator
+                                
+                                | Fail
+                                | Commit
+                                | Match
+                                | Fatbar
+
+                                | After
+                                | Before
+                                
+                                | NEWREF                -- RTS entry points
+                                | ASYNC
+                                | LOCK
+                                | UNLOCK
+                                
+                                | EmptyArray            -- For efficient creation of listArrays with constant lists
+                                | CloneArray            -- To open up for destructive updates in Kindle
+
+                                | Inherit               -- default Time value
+
+                                | Tag                   -- common selector of datatype/constructor structs
+                                
+                                | GCINFO                -- first selector of all structs / node constructor in gcinfo tables
+                                
+                                | STATE                 -- selector of primitive struct Ref
+                                | STATEOF               -- shortcut alternative to the above
+                                
+                                | Code                  -- selectors of primitive struct Msg
+                                | Baseline
+                                | Deadline
+                                | Next
+                                
+                                | AbsTime               -- type of selectors Baseline and Deadline
+                                
+                                | POLY                  -- Type representing polymorhic values
+                                                                
+                                | Float2POLY            -- Conversion macros required to circumvent C casting irreguliarity
+                                | POLY2Float
+                                
+                                | MAX____INVISIBLE
+                                
+                                deriving (Eq,Ord,Enum,Bounded,Show)
+
+minPrim                         = minBound :: Prim
+maxPrim                         = maxBound :: Prim
+
+isConPrim p                     = p <= MAX____CONS
+
+invisible p                     = p >= MIN____INVISIBLE
+
+doEtaExpand (Prim p _)          = not (invisible p)
+doEtaExpand (Tuple _ _)         = True
+doEtaExpand _                   = False
+
+isIdPrim p                      = p `notElem` primSyms
+
+primSyms                        = [LIST, NIL, CONS, LazyAnd, LazyOr, IndexArray]
+
+primTypes                       =  map primKeyValue [MIN____TYPE .. MAX____TYPE]
+
+primTerms                       =  map primKeyValue ([MIN____CONS .. MAX____CONS] ++ [MIN____VAR .. MAX____VAR])
+
+primSels                        = map primKeyValue [MIN____SELS .. MAX____SELS]
+                                  
+primKeyValue p                  = (name0 (strRep p), prim p)
+
+rigidNames			            = map rigidKeyValue [IndexArray, LazyAnd, LazyOr]
+
+rigidKeyValue p			        = (strRep p, prim p)
+
+lowPrims                        = [New,Sec,Millisec,Microsec,Nanosec,Raise,Catch,Baseline,Deadline,Next,
+                                   Infinity,Reset,Sample,SecOf,MicrosecOf,Abort,
+                                   Sqrt,Log,Log10,Exp,Sin,Cos,Tan,Asin,Acos,Atan,Sinh,Cosh]
+
+strRep LIST                     = "[]"
+strRep EITHER                   = "Either"
+strRep UNITTYPE                 = "()"
+strRep UNITTERM                 = "()"
+strRep NIL                      = "[]"
+strRep CONS                     = ":"
+strRep TRUE                     = "True"
+strRep FALSE                    = "False"
+strRep LEFT                     = "Left"
+strRep RIGHT                    = "Right"
+strRep LazyAnd                  = "&&"
+strRep LazyOr                   = "||"
+strRep IndexArray               = "!"
+strRep ListArray                = "array"
+strRep UniArray                 = "uniarray"
+strRep SizeArray                = "size"
+strRep TIMERTYPE                = "Timer"
+strRep TIMERTERM                = "timer"
+strRep p                        = strRep2 p
+                                
+strRep2 p
+  | p `elem` lowPrims           = toLower (head s) : tail s
+  | isConPrim p || invisible p  = s
+  | otherwise                   = "prim" ++ s
+  where s                       = show p
+
+
+-- Name construction -----
+-------------------------------------------------------
+
+noAnnot                         = Annot { location = Nothing, explicit = False, stateVar = False, 
+                                          generated = False, suppressMod = False }
+
+-- This function is used (only) by the parser to build Names
+name l (q,s)                    = case lookup s rigidNames of
+                                    Just n -> n 
+                                    Nothing -> Name s 0 (m q) (noAnnot {location = Just l})
+                                       where m "" = Nothing
+                                             m q = Just q
+joinString [x]                  = x
+joinString (x : xs)             = x ++ '.' : joinString xs                             
+
+dropMod n                       = n {fromMod = Nothing}
+qName m n                       = n {fromMod = Just m}
+
+-- Used for module names in import clauses
+modId n@(Name _ _ Nothing _)    = n
+modId (Name s t (Just m) a)     = Name (m++'.':s) t Nothing a
+
+prim p                          = Prim p noAnnot
+
+tuple n                         = Tuple n noAnnot
+
+
+splitString s                   = case break (=='.') s of
+                                    (local,[])  -> [local]                                 
+                                    (qualStart,suf)  -> qualStart : splitString (tail suf)
+
+splitQual s def                 = case splitString s of
+                                    [x]    -> (x, def)
+                                    xs -> (last xs, joinString (init xs))
+
+
+tag0 (Name s t m a)             = Name s 0 m a
+tag0 n                          = n
+
+annotExplicit n                 = n { annot = a { explicit = True } }
+  where a                       = annot n
+
+annotGenerated n                = n { annot = a { generated = True } }
+  where a                       = annot n
+
+pos n                           = location (annot n)
+
+-- Generated names ----------------------------------------------------------------
+
+genAnnot                        = noAnnot { generated = True }
+name0 s                         = Name s 0 Nothing genAnnot
+
+
+
+-- Textual name supply ---------------------------------------------------------------------------
+
+abcSupply                       = map name0 (gensupply "abcdefghijklmnopqrstuvwxyz")
+
+_abcSupply                      = map (name0 . ('_':)) (gensupply "abcdefghijklmnopqrstuvwxyz")
+
+_ABCSupply                      = map (name0 . ('_':)) (gensupply "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+
+gensupply                       :: [Char] -> [String]
+gensupply chars                 = map (:"") chars ++ concat (map g [1..])
+  where g n                     = map (replicate n) chars
+
+
+-- Internal identifier conventions -----------------------------------------------------
+
+witnessSym                      = "w"
+assumptionSym                   = "v"
+tempSym                         = "x"
+patSym                          = "p"
+functionSym                     = "f"
+dummySym                        = "d"
+paramSym                        = "a"
+etaExpSym                       = "eta"
+tyvarSym                        = "t"
+coercionSym                     = "c"
+coerceLabelSym                  = "l"
+coerceConstrSym                 = "K"
+typeSym                         = "T"
+stateTypeSym                    = "S"
+skolemSym                       = "sk"
+selfSym                         = "self"
+thisSym                         = "this"
+instanceSym                     = "inst"
+closureSym                      = "CLOS"
+tappSym                         = "TApp"
+tabsSym                         = "TAbs"
+gcinfoSym                       = "__GC__"
+
+isWitness n                     = isGenerated n && str n == witnessSym
+isAssumption n                  = isGenerated n && str n == assumptionSym
+isEtaExp n                      = isGenerated n && str n == etaExpSym
+isCoercion n                    = isGenerated n && str n == coercionSym
+isPatTemp n                     = isGenerated n && str n == patSym
+isClosure n                     = isGenerated n && isPrefixOf closureSym (str n)
+isDummy n                       = isGenerated n && str n == dummySym
+isCoerceLabel n                 = isGenerated n && isPrefixOf coerceLabelSym (str n)
+isCoerceConstr n                = isGenerated n && isPrefixOf coerceConstrSym (str n)
+isTApp n                        = isGenerated n && str n == tappSym
+isTAbs n                        = isGenerated n && str n == tabsSym
+isGCInfo n                      = isGenerated n && isPrefixOf gcinfoSym (str n)
+
+explicitSyms                    = [coercionSym, assumptionSym, witnessSym]
+
+
+-- Testing Names ----------------------------------------------------------------
+
+isId (Name s _ _ _)             = isIdent (head s)
+isId (Tuple _ _)                = True
+isId (Prim p _)                 = isIdPrim p
+
+isSym i                         = not (isId i)
+
+
+isCon (Name (c:_) _ _ _)        = isIdent c && isUpper c || c == ':'
+isCon (Tuple _ _)               = True
+isCon (Prim p _)                = isConPrim p
+
+isTuple (Tuple _ _)             = True
+isTuple _                       = False
+
+isVar i                         = not (isCon i)
+
+isQual m n                      = fromMod n == Just (str m)
+
+isGenerated (Name _ _ _ a)      = generated a 
+isGenerated _                   = False
+
+isState n                       = stateVar (annot n)
+
+isQualified (Name _ _ (Just _) _) = True
+isQualified _                    = False
+
+isLocal (Name _ _ Nothing _)    = True
+isLocal _                       = False
+
+-- Equality & Order ----------------------------------------------------------------
+
+instance Eq Name where
+  Name a 0 Nothing _  == Name b 0 Nothing _  = a == b
+  Name a s Nothing _  == Name b t Nothing _  = s == t
+  Name a 0 (Just m) _ == Name b _ (Just n) _ = a == b && m == n
+  Name a _ (Just m) _ == Name b 0 (Just n) _ = a == b && m == n
+  Name _ s (Just m) _ == Name _ t (Just n) _ = s == t && m == n
+  Tuple a _           == Tuple b _           = a == b
+  Prim a _            == Prim b _            = a == b
+  _                   == _                   = False
+
+instance Ord Name where
+  Prim a _   <= Prim b _        = a <= b
+  Prim _ _   <= _               = True
+  Tuple a _  <= Tuple b _       = a <= b
+  Tuple _ _  <= Name _ _ _ _    = True
+  Name a _ (Just m) _ <= Name b _ (Just n) _  = a < b || ( a == b && m <= n )
+  Name a 0 _ _ <= Name b 0 _ _  = a <= b
+  Name _ a _ _ <= Name _ b _ _  = a <= b
+  _          <= _               = False
+
+
+-- Printing Names -----------------------------------------------------------------
+
+instance Show Name where
+  show (Name s n m a)           = mod ++ s ++ tag
+     where tag                  = if n/=0 && generated a  then '_' : show n else ""
+           mod                  = if m==Nothing || suppressMod a then "" else fromJust m ++ "."
+  show (Tuple n _)              = '(' : replicate (n-1) ',' ++ ")"
+  show (Prim p _)               = strRep p
+
+instance Pr Name where
+--  pr (Name s n m a)             = prExpl a <> text (maybe "" (++ ".") m ++ s++'_':show n)
+  pr n                          = text (show n)
+
+prExpl a                        = if explicit a then text "~" else empty
+
+
+prId i                          = if isSym i then parens (pr i) else pr i
+
+prOp i                          = if isSym i then pr i else backQuotes (pr i)
+
+prId2 (Prim p _)                = text (strRep2 p)
+prId2 (Tuple n _)               = text ("TUP" ++ show n)
+prId2 n                         = prId n
+
+
+prId3 n@(Name s t m a)
+  | t == 0 || isClosure n || isCoerceLabel n || isCoerceConstr n
+                                = text (s ++ maybe "" (('_' :) . modToundSc) m)
+prId3 (Name s n m a)            = text (id ++ tag ++ mod ++ suff)
+  where 
+    id                          = if okForC s then s else "_sym"
+    tag                         = if mod=="" || generated a || id=="_sym"  then '_':show n else ""
+    suff                        = if take 2 id == "_sym" then "/* "++s++" */" else ""
+    mod                         = maybe "" (('_' :) . modToundSc) m
+    okForC cs                   = all (\c -> isAlphaNum c || c=='_') cs
+prId3 n                         = prId2 n
+
+name2str n                      = render (prId3 n)
+
+modToPath m                     = m -- concat (List.intersperse "/" (splitString m))
+
+modToundSc m                    = concat (List.intersperse "_" (splitString m))
+
+packName n                      = show n
+
+unpackName x                    = case break (=='_') x of
+                                    (s,"") -> let n0 = name0 s in 
+                                              case lookup n0 primTerms of
+                                                Just p  -> p
+                                                Nothing -> n0
+                                    (s,n)  -> (name0 s) { tag = read (tail n) }
+
+
+-- Binary --------------------------------------------------------
+
+instance Binary Name where
+  put (Name a b c d) = putWord8 0 >> put a >> put b >> put c >> put d
+  put (Prim a b) = putWord8 1 >> put a >> put b
+  put (Tuple a b) = putWord8 2 >> put a >> put b
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> return (Name a b c d)
+      1 -> get >>= \a -> get >>= \b -> return (Prim a b)
+      2 -> get >>= \a -> get >>= \b -> return (Tuple a b)
+      _ -> fail "no parse"
+
+
+instance Binary Annot where
+  put (Annot _ b c d e) = put b >> put c >> put d >> put e >> put False
+  get = get >>= \b -> get >>= \c -> get >>= \d -> get >>= \e -> get >>= \False -> return (Annot Nothing b c d e)
+
+
+maxPrimWord = fromIntegral (fromEnum maxPrim) :: Word8
+
+instance Binary Prim where
+  put p = putWord8 (fromIntegral (fromEnum p))
+  get = do
+    w <- getWord8
+    if w <= maxPrimWord
+        then return (toEnum (fromIntegral w))
+        else fail "no parse"
diff --git a/src/PP.hs b/src/PP.hs
new file mode 100644
--- /dev/null
+++ b/src/PP.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE  FlexibleInstances #-}
+
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module PP (module PP, module Text.PrettyPrint) where
+
+import Text.PrettyPrint hiding (TextDetails(..))
+import Char(showLitChar)
+
+
+class Pr a where
+    pr   :: a -> Doc
+    pr x = prn 0 x
+
+    prn  :: Int -> a -> Doc
+    prn n x = pr x
+
+    vpr  :: [a] -> Doc
+    vpr xs = vcat (map pr xs)
+
+    hpr  :: Char -> [a] -> Doc
+    hpr c xs = sep (punctuate (char c) (map pr xs))
+
+    dump :: a -> IO ()
+    dump x = putStr (render (pr x))
+
+
+instance Pr Int where 
+  pr = int
+
+-- XXX Is this correct?
+-- AJG It is needed by Main, but it looks wrong.
+
+instance Pr (String, String) where
+    pr (a, b) = text a <> text b
+
+infixl 4 $$$
+a $$$ b       = a $$ text " " $$ b
+
+vcat2 xs      = vcat (map ($$ text " ") xs)
+
+backQuotes p  = char '`'  <> p <> char '`'
+litChar       = charQuotes . text . lit
+litString     = doubleQuotes . text . concat . map lit
+lit c         = showLitChar c ""
+charQuotes p  = char '\'' <> p <> char '\''
+curlies       = braces
+
+commasep f xs = sep (punctuate comma (map f xs))
+
+
+show' :: Pr a => a -> String
+show' = render . pr
+
+vshow :: Pr a => [a] -> String
+vshow = render . vpr
+
+showlist :: Pr a => [a] -> String
+showlist xs = render (text "(" <> hpr ',' xs <> text ")")
+
diff --git a/src/ParseMonad.hs b/src/ParseMonad.hs
new file mode 100644
--- /dev/null
+++ b/src/ParseMonad.hs
@@ -0,0 +1,136 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+{-
+**************************************************************************
+** This file is based on sources distributed as the haskell-src package **
+**************************************************************************
+The Glasgow Haskell Compiler License
+
+Copyright 2004, The University Court of the University of Glasgow. 
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+ 
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+ 
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission. 
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
+-}
+
+module ParseMonad where
+
+import Common
+
+data ParseResult a
+    = Ok ParseState a
+    | Failed String
+      deriving Show
+
+type ParseState = [LexContext]
+
+data LexContext
+    = NoLayout
+    | Layout Int
+    | RecLayout Int
+      deriving (Eq, Ord, Show)
+
+newtype PM a 
+    = PM (   String		    -- input string
+          -> (Int,Int)		-- location of last token read (row,col)
+	      -> Int		    -- current column
+	      -> ParseState   	-- layout info
+	      -> ParseResult a)
+
+unPM (PM p) = p
+
+instance Monad PM where
+    (>>=)	= thenPM
+    return 	= returnPM
+    fail  	= failPM
+
+m `thenPM` k	= PM $ \i l c s -> 
+                    case (unPM m) i l c s of 
+                        Failed s -> Failed s
+                        Ok s' a  -> case k a of PM k' -> k' i l c s'
+returnPM a	= PM $ \i l c s -> Ok s a
+failPM a 	= PM $ \i l c s -> Failed a
+
+runPM (PM p) i l c s =
+    case p i l c s of
+        Ok _ a -> a
+	Failed err -> error err
+
+runPM2 (PM p) input =
+    case p input (1,1) 0 [] of
+        Ok _ result -> return result
+        Failed msg  -> fail msg
+
+getSrcLoc :: PM (Int,Int)
+getSrcLoc = PM $ \i l c s -> Ok s l
+
+pushContext :: LexContext -> PM ()
+pushContext ctxt =
+    PM $ \i l c s -> Ok (ctxt:s) ()
+
+popContext :: PM ()
+popContext = PM $ \i loc c stk ->
+    case stk of
+    (_:s) -> Ok s ()
+    []    -> Failed $ show loc ++
+                      ": parse error (possibly incorrect indentation)"
+
+
+parseError :: String -> PM a
+parseError err =
+    PM $ \r (l,c) -> (unPM $ fail $ "Syntax error at line "++show l++", column "++show c++ "\n") r (l,c)
diff --git a/src/Parser.y b/src/Parser.y
new file mode 100644
--- /dev/null
+++ b/src/Parser.y
@@ -0,0 +1,686 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+{
+
+module Parser (parser) where
+
+import Common
+import Token
+import Lexer
+import ParseMonad
+import Syntax
+import Fixity
+
+
+
+}
+
+%token
+        VARID 	 { VarId $$ }
+	CONID	 { ConId $$ }
+        '-'	 { VarSym ("","-") }
+        '<'      { VarSym ("","<") }
+        '>'      { VarSym ("",">") }
+        '*'	 { VarSym ("","*") }
+	VARSYM	 { VarSym $$ }
+	CONSYM	 { ConSym $$ }
+	INT	 { IntTok $$ }
+	RATIONAL { FloatTok $$ }
+ 	CHAR	 { Character $$ }
+	STRING   { StringTok $$ }
+{-
+
+Symbols
+-}
+	'('	{ LeftParen }
+	')'	{ RightParen }
+	';'	{ SemiColon }
+	'{'	{ LeftCurly }
+	'}'	{ RightCurly }
+	vccurly { VRightCurly }	      -- a virtual close brace
+	'['	{ LeftSquare }
+	']'	{ RightSquare }
+  	','	{ Comma }
+	'`'	{ BackQuote }
+        '_'     { Wildcard }
+
+{-
+
+Reserved operators
+
+-}
+        '.'     { Dot }
+	'..'	{ DotDot }
+	'::'	{ DoubleColon }
+        ':='    { Assign }
+	'='	{ Equals }
+	'\\'	{ Backslash }
+	'|'	{ Bar }
+	'<-'	{ LeftArrow }
+	'->'	{ RightArrow }
+        '\\\\'  { Backslash2 }
+{-
+
+Reserved Ids
+
+-}
+        'action'        { KW_Action }
+        'after'         { KW_After }
+        'before'        { KW_Before }
+        'case'		{ KW_Case }
+        'class'		{ KW_Class }
+        'data'		{ KW_Data }
+        'default'       { KW_Default }
+        'do'		{ KW_Do }
+        'else'		{ KW_Else }
+        'elsif'		{ KW_Elsif }
+        'forall'	{ KW_Forall }
+        'if'		{ KW_If }
+        'import'        { KW_Import }
+        'instance'      { KW_Instance }
+        'in'		{ KW_In }
+        'let'		{ KW_Let }
+        'module'	{ KW_Module }
+        'new'           { KW_New }
+        'of'		{ KW_Of }
+        'private'       { KW_Private }
+        'request'       { KW_Request }
+        'result'        { KW_Result }
+        'struct'        { KW_Struct }
+        'then'		{ KW_Then }
+        'type'		{ KW_Type }
+        'typeclass'	{ KW_Typeclass }
+        'use'           { KW_Use }
+        'where'		{ KW_Where }
+        'while'		{ KW_While }
+
+%monad { PM } { thenPM } { returnPM }
+%lexer { lexer } { EOF }
+%name parse
+%tokentype { Token }
+%%
+
+-- Module Header ------------------------------------------------------------
+
+module  :: { Module }
+        : 'module' conid 'where' body		{ mkModule $2 $4 }
+
+body    :: { ([Import],[Decl],[Decl]) }
+        : '{' layout_off imports topdecls '}' private	{ (reverse $3,reverse $4, $6) }
+        |     layout_on  imports topdecls close	private { (reverse $2, reverse $3, $5) }
+
+private :: { [Decl] }
+        : 'private' pbody			{ $2 }
+        | {- empty -}			        { [] }
+
+pbody    :: { [Decl] }
+        : '{' layout_off topdecls '}'	        { reverse $3 }
+        |     layout_on  topdecls close	        { reverse $2 }
+
+imports :: { [Import] }
+        : imports import ';'                    { $2 : $1 }
+        | {- empty -}                           { [] }
+
+import  :: { Import }
+        : 'import' conid                        { Import True (modId $2) }
+        | 'use' conid                           { Import False (modId $2) }
+
+
+-- Top-level declarations ---------------------------------------------------
+
+topdecls :: { [Decl] }
+        : topdecls ';' topdecl		        { $3 ++ $1 }
+        | topdecl				{ $1 }
+
+topdecl :: { [Decl] }
+        : conid '::' kind		        	   { [DKSig $1 $3] }
+        | 'type' conid tyvars '=' type	                   { [DType $2 (reverse $3) $5] }
+        | 'data' conid tyvars optsubs optcs                { [DData $2 (reverse $3) $4 $5] }
+        | 'struct' conid tyvars optsups optsigs            { [DRec False $2 (reverse $3) $4 $5] }
+        | 'typeclass' conid tyvars sups optsigs            { [DRec True $2 (reverse $3) $4 $5] }
+        | 'typeclass' conid tyvars 'where' siglist         { [DRec True $2 (reverse $3) [] $5] }
+        | 'typeclass' ids                                  { [DTClass $2] }
+        | 'instance' var '::' type                         { [DPSig $2 $4] }  
+        | 'instance' var '::' type 'where' bindlist        { [DBind [BEqn (exp2lhs (EVar $2)) (RExp (EBStruct Nothing [] $6))], DPSig $2 $4] }
+        | 'instance' var '::' type rhs                     { [DBind [BEqn (exp2lhs (EVar $2)) $5], DPSig $2 $4] }
+        | 'instance' ids                                   { [DInstance $2] }
+        | 'default' def                                    { [DDefault (reverse $2)] }
+        | vars '::' type		                   { [DBind [BSig (reverse $1) $3]] }
+        | lhs rhs 					   { [DBind [BEqn $1 $2]] }
+
+sups :: { [Type] }
+        : '<' types				{ reverse $2 }
+        | '<' type				{ [$2] }
+
+optsups :: { [Type] }
+        : sups                                  { $1 }
+        | {- empty -}				{ [] }
+
+optsubs :: { [Type] }
+        : '>' types				{ reverse $2 }
+        | '>' type				{ [$2] }
+        | {- empty -}				{ [] }
+
+tyvars  :: { [Name] }
+        : tyvars varid				{ $2 : $1 }
+        | {- empty -}				{ [] }
+
+
+
+ids     :: { [Name] }
+        : ids ',' id                            { $3 : $1 }
+        | id                                    { [$1] }
+
+-- Default declarations ---------------------------------------------------
+
+def     :: { [Default Type] }
+def     : '{' layout_off prefs '}'              { $3 }
+        | layout_on prefs close                 { $2 }
+      
+prefs   ::  { [Default Type] }
+        : prefs ';' pref                        { $3 : $1 }
+        | pref                                  { [$1] }
+ 
+
+pref     :: { Default Type }
+        : var '<' var                           { Default True $1 $3 }
+        | var '::' type                         { Derive $1 $3 }  
+
+
+-- Datatype declarations ---------------------------------------------------
+
+optcs   :: { [Constr] }
+        : '=' constrs				{ reverse $2 }
+        | {- empty -}				{ [] }
+        
+constrs :: { [Constr] }
+	: constrs '|' type	                { type2cons $3 : $1 }
+	| type			                { [type2cons $1] }
+
+
+-- Signatures --------------------------------------------------------------
+
+optsigs :: { [Sig] }
+        : 'where' siglist	      		{ $2 }
+        | {- empty -}				{ [] }
+        
+siglist :: { [Sig] }
+        : '{' layout_off sigs '}'		{ reverse $3 }
+        |     layout_on  sigs close		{ reverse $2 }
+
+sigs	:: { [Sig] }
+	: sigs1					{ $1 }
+	| {- empty -}				{ [] }
+	
+sigs1	:: { [Sig] }
+        : sigs1 ';' sig				{ $3 : $1 }
+        | sig					{ [$1] }
+
+sig	:: { Sig }
+        : vars '::' type	                { Sig (reverse $1) $3 }
+
+
+-- Bindings ----------------------------------------------------------------
+
+bindlist :: { [Bind] }
+	: '{' layout_off binds '}'		{ reverse $3 }
+	|     layout_on  binds close		{ reverse $2 }
+
+binds   :: { [Bind] }
+        : binds ';' bind			{ $3 : $1 }
+        | bind					{ [$1] }
+        
+bind    :: { Bind }
+	: vars '::' type	                { BSig (reverse $1) $3 }
+        | lhs rhs 				{ BEqn $1 $2 }
+
+
+recbinds   :: { [Field] }
+        : recbinds ',' recbind			{ $3 : $1 }
+        | recbind				{ [$1] }
+        
+recbind    :: { Field }
+        : var '=' exp 				{ Field $1  $3 }
+
+vars	:: { [Name] }
+	: vars ',' var				{ $3 : $1 }
+        | var					{ [$1] }
+
+lhs     :: { Lhs }
+        : exp0s                                 { exp2lhs $1 }
+
+rhs	:: { Rhs Exp }
+	: '=' exp		    		{ RExp $2 }
+	| gdrhss		    		{ RGrd (reverse $1) }
+        | rhs 'where' bindlist			{ RWhere $1 $3 }
+
+gdrhss  :: { [GExp Exp] }
+	: gdrhss gdrhs		    		{ $2 : $1 }
+	| gdrhs			    		{ [$1] }
+
+gdrhs   :: { GExp Exp }
+        : '|' quals '=' exp    			{ GExp (reverse $2) $4 }
+
+
+-- Types ---------------------------------------------------------------------
+
+type    :: { Type }
+        : ftype '\\\\' preds                    { TQual $1 $3 }
+        | ftype                                 { $1 }
+
+ftype   :: { Type }
+        : btypes                                { tFun (reverse (tail $1)) (head $1) }
+        | btype '<' btype                       { TSub $1 $3}
+
+btypes  :: { [Type] }
+        : btypes '->' btype                     { $3 : $1 }
+        | btype                                 { [$1] }
+
+btype   :: { Type }
+        : btype  atype                          { TAp $1 $2 }
+        | atype                                 { $1 }
+
+atype   :: { Type }
+	: con					{ TCon $1 }
+	| varid					{ TVar $1 }
+        | '_'                                   { TWild }
+        | '[' ']'				{ TCon (prim LIST) }
+--	| '(' '->' ')'	                	{ TCon (prim ARROW) }
+	| '(' commas ')'			{ TCon (tuple ($2+1)) }
+        | '(' ')'				{ TCon (prim UNITTYPE) }
+        | '(' type ')'                          { $2 }
+	| '(' types ')'				{ TTup (reverse $2) }
+	| '[' type ']'				{ TList $2 }
+
+types   :: { [Type] }
+	: types ',' ftype			{ $3 : $1 }
+	| ftype  ',' ftype			{ [$3, $1] }
+
+commas  :: { Int }
+	: commas ','		     		{ $1 + 1 }
+	| ','			     		{ 1 }
+
+-- Predicates -----------------------------------------------------------------
+
+preds	:: { [Pred] }
+        : preds ',' pred			{ $3 : $1 }
+        | pred					{ [$1] }
+        
+pred	:: { Pred }
+        : ftype                                 { PType $1 }
+        | varid '::' kind			{ PKind $1 $3 }
+
+kind	:: { Kind }
+        : kind1 '->' kind			{ KFun $1 $3 }
+        | kind1					{ $1 }
+
+kind1	:: { Kind }
+        : '*'					{ Star }
+        | '_'                                   { KWild }
+        | '(' kind ')'				{ $2 }
+        
+
+-- Expressions -------------------------------------------------------------
+
+exp     :: { Exp }
+        : exp0a '::' btype                      { ESig $1 $3 }
+        | exp0                                  { $1}
+        | 'struct' bindlist                     { EBStruct Nothing [] $2 }
+
+exp0    :: { Exp }
+        : exp0a                                 { $1 }
+        | exp0b                                 { $1 }
+
+exp0a	:: { Exp }
+        : opExpa			        { transFix $1 }
+	| exp10a			        { $1 }
+	  
+exp0b	:: { Exp }
+        : opExpb			        { transFix $1 }
+	| exp10b			        { $1 }
+	  
+opExpa  :: { OpExp }
+        : opExpa op '-' exp10a	                { Cons $1 $2 (ENeg $4) }
+        | opExpa op exp10a	                { Cons $1 $2 $3 }
+        | '-' exp10a			        { Nil (ENeg $2) }
+        | exp10a op '-' exp10a	                { Cons (Nil $1) $2 (ENeg $4) }
+        | exp10a op exp10a		        { Cons (Nil $1) $2 $3 }
+	  
+opExpb  :: { OpExp }
+        : opExpa op '-' exp10b	                { Cons $1 $2 (ENeg $4) }
+	| opExpa op exp10b	                { Cons $1 $2 $3 }
+	| '-' exp10b		                { Nil (ENeg $2) }
+	| exp10a op '-' exp10b	                { Cons (Nil $1) $2 (ENeg $4) }
+	| exp10a op exp10b	                { Cons (Nil $1) $2 $3 }
+	  
+exp10a  :: { Exp }
+        : 'case' exp 'of' altslist              { ECase $2 $4 }
+        | '{'  layout_off recbinds '}'          { ERec Nothing (reverse $3) }
+	| '{'  layout_off  '}'			{ ERec Nothing [] }
+        | exp10as                               { $1 }
+
+exp10as :: { Exp }
+        : loc 'do' stmtlist                     { EDo Nothing Nothing $3  }
+        | loc 'class' stmtlist                  { ETempl Nothing Nothing $3 }
+        | loc 'action' stmtlist                 { EAct Nothing $3 }
+        | loc 'request' stmtlist                { EReq Nothing $3 }
+        | con '{'  layout_off recbinds '}'      { ERec (Just ($1,True)) (reverse $4) } 
+        | con '{'  layout_off recbinds '..' '}' { ERec (Just ($1,False)) (reverse $4) } 
+        | con '{'  layout_off recbinds ',' '..' '}' { ERec (Just ($1,False)) (reverse $4) } 
+        | con '{'  layout_off '..' '}'          { ERec (Just ($1,False)) [] } 
+	| con '{'  layout_off  '}'		{ ERec (Just ($1,True)) [] }
+        | fexp                                  { $1 }
+
+exp10b :: { Exp }
+        : 'if' exp 'then' exp 'else' exp        { EIf $2 $4 $6 }
+        | exp10bs                               { $1 }
+
+exp10bs :: { Exp }
+        : '\\' apats '->' exp                   { ELam (reverse $2) $4 }
+        | 'let' bindlist 'in' exp               { ELet $2 $4 }
+        | 'after' aexp exp                      { EAfter $2 $3 }
+        | 'before' aexp exp                     { EBefore $2 $3 }
+
+fexp    :: { Exp }
+        : fexp aexp                             { EAp $1 $2 }
+        | aexp                                  { $1 }
+
+aexp    :: { Exp }
+        : aexp '.' var                          { ESelect $1 $3 }
+        | bexp                                  { $1 }
+
+bexp    :: { Exp }
+        : var                                   { EVar $1 }
+        | '_'                                   { EWild }
+        | con                                   { ECon $1 }
+        | lit                                   { ELit $1 }
+        | '(' ')'                               { ECon (prim UNITTERM) }
+        | '(' '.' var ')'                       { ESel $3 }
+        | '(' exp ')'                           { $2 }
+        | '(' exps ')'                          { ETup (reverse $2) } 
+        | '[' list ']'                          { $2 }
+        | '(' exp10a op ')'                     { ESectR $2 $3 }
+        | '(' op0 fexp ')'                      { ESectL $2 $3 }
+        | '(' commas ')'                        { ECon (tuple ($2+1)) }
+
+lit     :: { Lit }
+: loc INT                                   { LInt (Just $1) (readInteger $2) }
+| loc RATIONAL                              { LRat (Just $1) (readRational $2) }
+| loc CHAR                                  { LChr (Just $1) $2 }
+| loc STRING                                { LStr (Just $1) $2 }
+
+-- List expressions -------------------------------------------------------------
+
+list    :: { Exp }
+        : {- empty -}                           { EList [] }
+        | exp                                   { EList [$1] }
+        | exps                                  { EList (reverse $1) }
+        | exp '..' exp                          { ESeq $1 Nothing $3 }
+        | exp ',' exp '..' exp                  { ESeq $1 (Just $3) $5 }
+        | exp '|' quals                         { EComp $1 (reverse $3) }
+
+exps    :: { [Exp] }
+        : exps ',' exp                          { $3 : $1 }
+        | exp ',' exp                           { [$3,$1] }
+ 
+
+-- List comprehensions ---------------------------------------------------------
+
+quals   :: { [Qual] }
+        : quals ',' qual                        { $3 : $1 }
+        | qual                                  { [$1] }
+
+qual    :: { Qual }
+        : pat '<-' exp0s                        { QGen $1 $3 }
+        | exp0s                                 { QExp $1 }
+        | 'let' bindlist                        { QLet $2 }
+
+
+-- Case alternatives ------------------------------------------------------------
+
+altslist :: { [Alt Exp] }
+        : '{' layout_off alts '}'               { reverse $3 }
+        |     layout_on  alts close             { reverse $2 }
+
+
+alts    :: { [Alt Exp] }
+        : alts ';' alt                          { $3 : $1 }
+        | alt                                   { [$1] }
+
+alt     :: { Alt Exp }
+        : pat rhscasealts                       { Alt $1 $2 }
+
+rhscasealts :: { Rhs Exp }
+        : '->' exp                              { RExp $2 }
+        | gdcaserhss                            { RGrd (reverse $1) }
+        | rhscasealts 'where' bindlist          { RWhere $1 $3 }
+
+gdcaserhss :: { [GExp Exp] }
+        : gdcaserhss gdcaserhs                  { $2 : $1 }
+        | gdcaserhs                             { [$1] }
+
+gdcaserhs :: { GExp Exp }
+        : '|' quals  '->' exp                   { GExp (reverse $2) $4 }
+
+
+-- Case statement alternatives ------------------------------------------------------------
+
+saltslist :: { [Alt [Stmt]] }
+        : '{' layout_off salts  '}'             { reverse $3 }
+        |     layout_on  salts close            { reverse $2 }
+
+
+salts   :: { [Alt [Stmt]] }
+        : salts ';' salt                        { $3 : $1 }
+        | salt                                  { [$1] }
+
+salt    :: { Alt [Stmt] }
+        : pat srhscasealts                      { Alt $1 $2 }
+
+srhscasealts :: { Rhs [Stmt] }
+        : '->' stmtlist                         { RExp $2 }
+        | sgdcaserhss                           { RGrd (reverse $1) }
+        | srhscasealts 'where' bindlist         { RWhere $1 $3 }
+
+sgdcaserhss :: { [GExp [Stmt]] }
+        : sgdcaserhss sgdcaserhs                { $2 : $1 }
+        | sgdcaserhs                            { [$1] }
+
+sgdcaserhs :: { GExp [Stmt] }
+        : '|' quals  '->' stmtlist              { GExp (reverse $2) $4 }
+
+
+-- Statement sequences -----------------------------------------------------------
+
+stmtlist :: { [Stmt] }
+        : '{' layout_off stmts0 '}'             { reverse $3 }
+        | layout_on stmts0 close                { reverse $2 }
+
+stmts0  :: { [Stmt] }
+	: stmts					{ $1 }
+	| {- empty -}				{ [] }
+
+stmts   :: { [Stmt] }
+        : stmts ';' stmt                        { $3 : $1 }
+        | stmt                                  { [$1] }
+
+stmt    :: { Stmt }
+        : pat '<-' exp                          { SGen $1 $3 }
+        | mexp                                  { SExp $1 }
+        | vars '::' type                        { SBind [BSig $1 $3] }
+        | lhs rhs                               { SBind [BEqn $1 $2] }
+        | lhs '=' 'new' exp                     { SBind [BEqn $1 (RExp (EAp (EVar (prim New)) $4))] }
+        | pat ':=' exp                          { SAss $1 $3 }
+        | 'result' exp                          { SRet $2 }
+        | 'forall' quals 'do' stmtlist          { SForall (reverse $2) $4 }
+        | 'if' exp 'then' stmtlist              { SIf $2 $4 }
+        | 'elsif' exp 'then' stmtlist           { SElsif $2 $4 }
+        | 'else' stmtlist                       { SElse $2 }
+        | 'while' exp 'do' stmtlist             { SWhile $2 $4 }
+        | 'case' exp 'of' saltslist             { SCase $2 $4 }
+     
+
+mexp    :: { Exp }
+--      : exp0as '::' type                      { ESig $1 $3 }
+        : exp0s                                 { $1}
+
+exp0s    :: { Exp }
+        : exp0as                                { $1 }
+        | exp0bs                                { $1 }
+
+exp0as	:: { Exp }
+        : opExpas			        { transFix $1 }
+	| exp10as			        { $1 }
+	  
+exp0bs	:: { Exp }
+        : opExpbs			        { transFix $1 }
+	| exp10bs			        { $1 }
+	  
+opExpas  :: { OpExp }
+        : opExpas op '-' exp10as                { Cons $1 $2 (ENeg $4) }
+        | opExpas op exp10as	                { Cons $1 $2 $3 }
+        | '-' exp10as			        { Nil (ENeg $2) }
+        | exp10as op '-' exp10as                { Cons (Nil $1) $2 (ENeg $4) }
+        | exp10as op exp10as		        { Cons (Nil $1) $2 $3 }
+	  
+opExpbs  :: { OpExp }
+        : opExpas op '-' exp10bs                { Cons $1 $2 (ENeg $4) }
+	| opExpas op exp10bs	                { Cons $1 $2 $3 }
+	| '-' exp10bs		                { Nil (ENeg $2) }
+	| exp10as op '-' exp10bs                { Cons (Nil $1) $2 (ENeg $4) }
+	| exp10as op exp10bs	                { Cons (Nil $1) $2 $3 }
+
+
+
+-- Patterns ----------------------------------------------------------------
+
+pat     :: { Pat }
+        : exp0s                                 { $1 }
+
+apats   :: { [Pat] }
+        : apats apat                            { $2 : $1 }
+        | apat                                  { [$1] }
+
+apat    :: { Pat }
+        : aexp                                  { $1 }
+
+
+-- Variables, Constructors and Operators ------------------------------------
+
+var     :: { Name }
+        : varid                                 { $1 }
+        | '(' varsym ')'                        { $2 }
+
+con     :: { Name }
+        : conid                                 { $1 }
+        | '(' consym ')'                        { $2 }
+
+varop   :: { Name }
+        : varsym                                { $1 }
+        | '`' varid '`'                         { $2 }
+
+conop   :: { Name }
+        : consym                                { $1 }
+        | '`' conid '`'                         { $2 }
+
+op      :: { Name }
+        : varop                                 { $1 }
+        | conop                                 { $1 }
+
+id      :: { Name }
+        : varid                                 { $1 }
+        | conid                                 { $1 }
+
+op0     :: { Name }
+        : VARSYM0                               {% do l <- getSrcLoc; return (name l $1) }
+        | '`' varid '`'                         { $2 }
+        | conop                                 { $1 }
+
+
+varid   :: { Name }
+        : loc VARID                             { name $1 $2 }
+
+conid   :: { Name }
+        : loc CONID                             { name $1 $2 }
+
+varsym  :: { Name }
+        : VARSYM1                               {% do l <- getSrcLoc; return (name l $1) }
+
+consym  :: { Name }
+        : loc CONSYM                            { name $1 $2 }
+
+
+
+VARSYM1 :: { (String,String) }
+	: VARSYM0				{ $1 }
+	| '-'					{ ("","-") }
+
+VARSYM0 :: { (String,String) }
+        : VARSYM                                { $1 }
+        | '<'                                   { ("","<") }
+        | '>'                                   { ("",">") }
+        | '*'                                   { ("","*") }
+        | '\\\\'				{ ("","\\\\") }
+        
+
+-- Layout ---------------------------------------------------------------------
+
+close :: { () }
+        : vccurly                               { () } -- context popped in lexer.
+        | error                                 {% popContext }
+
+layout_off :: { () }    :                       {% pushContext NoLayout }
+layout_on  :: { () }    :                       {% do { (r,c) <- getSrcLoc ;
+                                                        pushContext (Layout c)
+                                                      }
+                                                }
+
+loc     :: { (Int,Int) }
+         : {- empty -}                          {% getSrcLoc }
+
+{-
+    layout_onR  :: { () }   :                       {% do { (_,c) <- getSrcLoc ;
+                                                        pushContext (RecLayout c)
+                                                      }
+                                                }
+-}
+
+-- Error -----------------------------------------------------------------------
+
+{
+parser     :: String -> M s Module
+parser str = runPM2 parse str
+
+happyError = parseError "parse error"
+}
diff --git a/src/Prepare4C.hs b/src/Prepare4C.hs
new file mode 100644
--- /dev/null
+++ b/src/Prepare4C.hs
@@ -0,0 +1,547 @@
+{-# LANGUAGE ParallelListComp #-}
+
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Prepare4C(prepare4c) where
+
+import Monad
+import Common
+import Kindle
+import PP
+import qualified Core
+import qualified Core2Kindle
+
+-- Establishes that:
+--   every struct function simply relays all work to a global function with an explicit "this" parameter
+--   every EEnter expression has a variable as its body
+--   every ENew expression occurs at the rhs of a Val binding
+
+-- Removes the type arguments from all type constructors except Array
+-- Replaces type variables with the special type constructor POLY
+-- Adds type casts wherever necessary
+
+-- Replaces type abstraction and application with BITSET parameters indicating pointer/non-pointer status
+
+-- Replaces nullary structs with out-of-band pointers (casts from the corresponding tag value)
+-- Replaces type constructor switching by switching on integer tags (embedded as pointer values or as explicit tag fields)
+-- Makes field selection from matched struct variants explicit
+
+-- Removes CBreak commands that appear directly under a CSeq (without any intervening CSwitch)
+-- Removes redundant defaults in CSwitch commands
+
+-- (Not yet):
+-- Flattens the struct subtyping graph by inlining the first coercion field
+-- Ditto for enums...
+
+
+prepare4c e2 e3 m             = localStore (pModule e2 e3 m)
+
+
+-- ===========================
+-- Local environment
+-- ===========================
+
+data Env                        = Env { decls   :: Decls,                 -- all structs in scope
+                                        tenv    :: TEnv,                  -- all fun and val variables in scope
+                                        strinfo :: Map Name (Int,[Bool]), -- number of ptr fields + 1 / relevance flags of tvars for each struct
+                                        polyenv :: Map Name (Exp,Int),    -- status location (refexp,bit-number) for type variables in scope
+                                        conval  :: Map Name Int,          -- numerical values of all variant constructor names
+                                        nulls   :: [Name],                -- lists all nullary struct variants
+                                        tagged  :: [Name],                -- lists all struct variants that use an explicit tag field
+                                        this    :: Maybe Name }
+
+env0                            = Env { decls = [], tenv = [], strinfo = [], polyenv = [], conval = [], nulls = [], tagged = [], this = Nothing }
+
+addDecls ds env                 = env { decls = ds ++ decls env, strinfo = info ++ strinfo env, conval = convals ++ conval env, 
+                                        nulls = nullcons ++ nulls env, tagged = taggedcons ++ taggedunions ++ tagged env }
+  where unioncons               = unions ds
+        allvariants             = map (variants ds) unioncons
+        convals                 = concat (map (`zip` [0..]) allvariants)
+        nullcons                = [ n | (n, Struct _ [] (Extends _)) <- ds ]
+        singlecons              = map head . filter ((==1) . length) . map (\\nullcons) $ allvariants
+        taggedcons              = dom convals \\ (singlecons++nullcons)
+        taggedunions            = [ n | (n,ns) <- unioncons `zip` allvariants, any (`elem` taggedcons) ns ]
+        info                    = mapSnd structInfo ds
+        
+structInfo (Struct vs te _)     = (length (ptrFields te []), map (`elem` relevant) vs)
+  where relevant                = rng (varFields te)
+
+addTEnv te env                  = env { tenv = te ++ tenv env }
+
+addVals te env                  = env { tenv = mapSnd ValT te ++ tenv env }
+
+addPolyEnv vs is es env         = env { polyenv = mkPolyEnv vs is es ++ polyenv env }
+
+-- Create a polyTag ATEnv on basis of polymorphic arity and return a mapping from each tyvar to its corresponding arg/bit
+mkPolyEnv [] _ _                = []
+mkPolyEnv (v:vs) (i:is) es      = (v, (es!!(i`div`32), i`mod`32)) : mkPolyEnv vs is es
+
+
+setThis x env                   = env { this = Just x }
+
+findValT xx te x                = t
+  where ValT t                  = lookup'' xx te x
+  
+findFunT te x ts                = (vs `zip` ts, ts', t)
+  where FunT vs ts' t           = lookup'' "B" te x
+
+findStructTEnv xx env (TCon n ts)
+  | isTuple n                   = (abcSupply `zip` ts, abcSupply `zip` map (ValT . tVar) (take (width n) abcSupply))
+  | otherwise                   = (vs `zip` ts, te)
+  where Struct vs te _          = lookup'' xx (decls env) n
+
+findStructInfo env n
+  | isTuple n                   = (width n + 1, take (width n) (repeat True))
+  | otherwise                   = lookup' (strinfo env) n
+
+findPolyTag xx env v            = lookup'' (xx ++ ": " ++ show (polyenv env)) (polyenv env) v
+
+conLit env n                    = lInt (lookup'' "GGG" (conval env) n)
+
+allCons env (ACon n _ _ _ : _)
+  | isTuple n                   = [n]
+  | otherwise                   = variants (decls env) n0
+  where Struct _ _ (Extends n0) = lookup'' "Apa" (decls env) n
+allCons env _                   = []
+
+visibleArity env n              = structArity ds (structRoot ds n)
+  where ds                      = decls env
+  
+-- =====================================
+-- Replacing polymorphism with polyTags
+-- =====================================
+    
+-- Create a list of polyTag types on basis of polymorphic arity
+polyTagTypes 0                  = []
+polyTagTypes a | a <= 32        = [tBITS32]
+               | otherwise      = tBITS32 : polyTagTypes (a-32)
+
+
+-- Create a polyTag TEnv on basis of polymorphic arity (the externally visible part)
+polyTagEnv0 a | a <= 4          = [(prim GCINFO, ValT tPOLY)]
+              | otherwise       = (prim GCINFO, ValT tPOLY) : 
+                                  _ABCSupply `zip` map ValT (polyTagTypes a)
+
+
+-- Create a polyTag TEnv on basis of polymorphic arity (the existentially quantified part)
+polyTagEnv1 a                   = _abcSupply `zip` map ValT (polyTagTypes a)
+
+
+-- Create a polyTag struct binding from a list of type arguments
+polyTagBinds env n ts           = bs0 ++ bs1
+  where mkBind (x,ValT t) e     = (x, Val t e)
+        ts0                     = zipFilter vflags ts
+        ts1                     = drop va ts
+        va                      = visibleArity env n
+        l_ts0                   = length ts0
+        te0                     = polyTagEnv0 l_ts0
+        es0                     = polyTagArgs env ts0
+        bs0 | l_ts0 <= 4        = zipWith mkBind te0 [ECall (gcInfoName n) [] (map offset es0)]
+            | otherwise         = zipWith mkBind te0 (ECall (gcInfoName n) [] [] : es0)
+        bs1                     = zipWith mkBind (polyTagEnv1 (length ts1)) (polyTagArgs env ts1)
+        offset e                = ECall (prim IntTimes) [] [ELit (lInt (d + 2)),e]
+        (d,vflags)              = findStructInfo env n
+
+
+gcInfoName n@(Name s t m a)
+  | isClosure n                 = Name (gcinfoSym ++ s) 0 m a
+  | otherwise                   = Name (gcinfoSym ++ s) t m a
+gcInfoName (Tuple n a)          = Name (gcinfoSym ++ "TUP" ++ show n) 0 Nothing a
+gcInfoName (Prim p a)           = Name (gcinfoSym ++ strRep2 p) 0 Nothing a
+
+
+-- Create a list of polyTag Exp arguments from a list of type arguments
+polyTagArgs env []              = []
+polyTagArgs env ts 
+  | vars && ordered && total    = [e0]
+  where vars                    = l_ts == length vs && length (nub es) == 1
+        l_ts                    = length ts
+        vs                      = [ n | TVar n _ <- ts ]
+        (es,is)                 = unzip (map (findPolyTag "XX" env) vs)
+        e0                      = head es
+        ordered                 = is == [0..l_ts-1]
+        total                   = length [ v | (v,(e,_)) <- polyenv env, e == e0 ] == l_ts
+polyTagArgs env ts              = args (length ts) ts
+  where 
+    args 0 []                   = []
+    args a ts | a <= 32         = [arg 0 ts]
+              | otherwise       = arg 0 ts0 : args (a-32) ts1
+      where (ts0,ts1)           = splitAt a ts
+
+    arg k []                    = intlit 0
+    arg k (TVar n _ : ts)       = bor (arg (k+1) ts) (shift (band e (mask i)) i k)
+      where (e,i)               = findPolyTag "YY" env n
+    arg k (TCon (Prim p _) _ : ts)
+      | p `elem` scalarPrims    = bor (mask k) (arg (k+1) ts)
+    arg k (_ : ts)              = arg (k+1) ts
+
+
+shift e i k | i < k             = shiftL e (ELit (lInt (k-i)))
+            | i > k             = shiftR e (ELit (lInt (i-k)))
+            | otherwise         = e
+
+shiftL e1 e2                    = ECall (prim SHIFTL32) [] [e1,e2]
+         
+shiftR e1 e2                    = ECall (prim SHIFTR32) [] [e1,e2]
+
+mask i                          = intlit (2^i)
+
+bor e1 e2 | e1 == intlit 0      = e2
+          | e2 == intlit 0      = e1
+          | otherwise           = ECall (prim OR32) [] [e1,e2]
+             
+band e1 e2                      = ECall (prim AND32) [] [e1,e2]
+
+intlit i                        = ECast tBITS32 (ELit (lInt i))
+
+
+-- =============================
+-- Prepare modules and types
+-- =============================
+    
+pModule e2 dsi (Module m ns ds bs)      
+                                = do -- tr (render (vcat (map pr dsi))
+                                     let (_,_,_,Core.Binds _ te2 _) = e2
+                                     tei <- Core2Kindle.c2kTEnv dsi te2
+                                     let env1 = addTEnv (primTEnv++tei) (addDecls (primDecls++dsi) env0)
+                                         env  = addTEnv (mapSnd typeOf bs) (addDecls ds env1)
+                                     (bs1,bs) <- pBinds pBind env bs
+                                     bs2 <- currentStore
+                                     return (Module m ns (pDecls env ds) (gcinfo env ds ++ bs1 ++ bs ++ reverse bs2))
+
+
+-- Prepare structs declarations
+pDecls env ds                   = map f ds
+  where f (n,Struct vs te _)    = (n, Struct [] (polyTagEnv0 l_vs0 ++ tagSig ++ mapSnd pType te ++ polyTagEnv1 l_vs1) Top)
+          where tagSig          = if n `elem` tagged env then [(prim Tag, ValT tInt)] else []
+                l_vs0           = length (zipFilter vflags vs)
+                l_vs1           = length (drop va vs)
+                va              = visibleArity env n
+                (_,vflags)      = findStructInfo env n
+
+
+-- gcinfo types: these must match corresponding defines in gc.c
+gcSTD                           = ELit (lInt 0)
+gcARRAY                         = ELit (lInt 1)
+gcTUPLE                         = ELit (lInt 2)
+gcBIG                           = ELit (lInt 3)
+gcMUT                           = ELit (lInt 4)
+
+-- Generate gcinfo for structs
+gcinfo env ds                   = map f (prune ds (nulls env))
+  where f (n,Struct vs te cs)   = (gcInfoName n, Val tPOLY (ECall (prim GCINFO) [] es))
+          where es | l_vs1 <= 4 = concat [ EVar n : gcSTD : pad l_es0 (ptrFields te vs) | vs <- sampleSpaces vs1 ]
+                   | otherwise  = EVar n : gcBIG : es0 ++ concat (map bitRef (varFields te)) ++ [ELit (lInt 0)]
+                es0             = ptrFields te []
+                l_es0           = length es0
+                (d,vflags)      = findStructInfo env n
+                vs1             = zipFilter vflags vs
+                l_vs1           = length vs1
+                idx             = vs1 `zip` [0..]
+                bitRef (n,v)    = [ EVar n, ELit (lInt (i `div` 32 + 1)), ELit (lInt (i `mod` 32)) ]
+                  where i       = lookup'' "DDD" idx v
+
+pad n es                        = es ++ replicate (n - length es) (ELit (lInt 0))
+
+ptrFields te vs                 = map EVar (dom (filter (isPtr vs) te)) ++ [ELit (lInt 0)]
+
+sampleSpaces []                 = [[]]
+sampleSpaces (v:vs)             = [ vs1 ++ vs2 | vs1 <- [[],[v]], vs2 <- sampleSpaces vs ]
+
+isPtr vs (n,FunT _ _ _)         = False
+isPtr vs (n,ValT (TVar v _))    = v `notElem` vs
+isPtr vs (n,ValT (TCon k _))    = not (isScalar k)
+
+isScalar (Prim p _)             = p `elem` scalarPrims
+isScalar n                      = False
+
+varFields te                    = [ (n,v) | (n,ValT (TVar v _)) <- te ]
+
+
+-- Simplify types
+pType (ValT t)                  = ValT (erase t)
+pType (FunT vs ts t)            = FunT [] (polyTagTypes (length vs) ++ map erase ts) (erase t)
+
+
+-- Erase polymorphism from atomic types
+erase (TCon n _)                = TCon n []
+erase (TVar _ _)                = tPOLY
+
+eraseEnv te                     = mapSnd erase te
+
+
+-- =============================
+-- Prepare bindings and commands
+-- =============================
+
+-- Prepare bindings
+pBinds f env xs                 = do (bss,xs) <- fmap unzip (mapM (f env) xs)
+                                     return (concat bss, xs)
+
+
+-- Prepare top-level & cmd bindings (assume code is lambda-lifted)
+pBind env (x, Val t e)          = do (bs,t',e) <- pRhsExp env e 
+                                     return (bs, (x, Val (erase t) (cast t t' e)))
+pBind env (x, Fun vs t te c)    = do te' <- newEnv paramSym (polyTagTypes (length vs))
+                                     c <- pCmd (addVals te (addPolyEnv vs [0..] (map EVar (dom te')) env)) t c
+                                     return ([], (x, Fun [] (erase t) (te' ++ eraseEnv te) c))
+
+
+-- Prepare struct bindings (assume code is lambda-lifted)
+pSBind _ te0 env (x,Val t e)    = do (bs,e) <- pExpT env t e 
+                                     return (bs, (x, Val (erase t0) (cast t0 t e)))
+  where t0                      = findValT "1" te0 x
+pSBind _ te0 env (x,Fun [] t te c@(CRet (ECall f [] (EThis:es))))
+  | okAlready                   = return ([], (x, Fun [] t te c))
+  where (_,ts0,t0)              = findFunT te0 x []
+        okAlready               = t == erase t0 && rng te == map erase ts0 && es == map EVar (dom te)
+pSBind ty te0 env (x,Fun vs t te c)
+                                = do y <- newName thisSym
+                                     te0 <- newEnv paramSym ts0
+                                     te' <- newEnv paramSym (polyTagTypes (length vs))
+                                     let bs0  = [ (x, Val t (cast t t0 (EVar x0))) | (x0,t0) <- te0 | (x,t) <- te ]
+                                         te1  = [ if isEVar e then (x,t) else xt0 | (x, Val t e) <- bs0 | xt0 <- te0 ]
+                                         bs1  = [ b | b@(_,Val _ e) <- bs0, not (isEVar e) ]
+                                         te1' = te' ++ eraseEnv te1
+                                         env' = addPolyEnv vs [0..] (map EVar (dom te')) (rebindPolyEnv ty y env)
+                                     c <- pCmd (setThis y (addVals ((y,ty):te) env')) t0 c
+                                     f <- newName functionSym
+                                     addToStore (f, Fun [] t0' ((y,erase ty):te1') (cBind bs1 c))
+                                     return ([], (x, Fun [] t0' te1' (CRet (ECall f [] (EThis : map EVar (dom te1'))))))
+  where (_,ts0,t0)              = findFunT te0 x []
+        t0'                     = erase t0
+
+
+rebindPolyEnv (TCon n ts) y env = addPolyEnv vs is (map (ESel (EVar y)) _abcSupply) env
+  where ts1                     = drop (visibleArity env n) ts
+        (vs,is)                 = unzip [ (v,i) | (TVar v _, i) <- ts1 `zip` [0..] ]
+
+
+-- Prepare commands
+pCmd env t0 (CRet e)            = do (bs,e) <- pExpT env t0 e
+                                     return (cBind bs (CRet e))
+pCmd env t0 (CRun e c)          = do (bs,_,e) <- pExp env e
+                                     liftM (cBind bs . CRun e) (pCmd env t0 c)
+pCmd env t0 (CBind False bs c)  = do (bs1,bs) <- pBinds pBind env bs
+                                     liftM (cBind bs1 . CBind False bs) (pCmd env' t0 c)
+  where env'                    = addTEnv (mapSnd typeOf bs) env
+pCmd env t0 (CBind True bs c)   = do (bs1,bs) <- pBinds pBind env' bs
+                                     liftM (CBind True (bs1++bs)) (pCmd env' t0 c)
+  where env'                    = addTEnv (mapSnd typeOf bs) env
+pCmd env t0 (CUpd x e c)        = do (bs,e) <- pExpT env (findValT "2" (tenv env) x) e
+                                     liftM (cBind bs . CUpd x e) (pCmd env t0 c)
+pCmd env t0 (CUpdS e x e' c)    = do (bs,t1,e) <- pExp env e
+                                     let (s,te) = findStructTEnv "AA" env t1
+                                     (bs',e') <- pExpT env (findValT "3" te x) e'
+                                     liftM (cBind bs . cBind bs' . CUpdS e x e') (pCmd env t0 c)
+pCmd env t0 (CUpdA e i e' c)    = do (bs,TCon (Prim Array _) [t],e) <- pExp env e
+                                     (bs',i) <- pExpT env tInt i
+                                     (bs'',e') <- pExpT env tPOLY e'
+                                     liftM (cBind bs . cBind bs' . cBind bs'' . CUpdA e i e') (pCmd env t0 c)
+pCmd env t0 (CSwitch e alts)    
+  | any litA alts               = if simple (litType (firstLit alts)) then
+                                     do (bs,e) <- pExpT env tInt e
+                                        alts <- mapM (pAlt env e tInt t0) alts
+                                        return (cBind bs (CSwitch e alts))
+                                    else mkVarSwitch env t0 e alts
+  | isEVar e || all nullA alts  = do (bs,t,e) <- pExp env e
+                                     alts <- mapM (pAlt env e t t0) alts
+                                     let (alts0,alts1) = partition nullA [ a | a@(ACon _ _ _ _) <- alts ]
+                                         altsW         = [ a | a@(AWild _) <- alts ]
+                                     return (cBind bs (mkSwitch env e (alts0++absent0 altsW) (alts1++absent1 altsW)))
+  | otherwise                   = mkVarSwitch env t0 e alts
+  where nullA (ACon k _ _ _)    = k `elem` nulls env
+        nullA _                 = False
+        absent                  = allCons env alts \\ [ k | ACon k _ _ _ <- alts ]
+        (abs0,abs1)             = partition (`elem` nulls env) absent
+        absent0 altsW           = [ ACon k [] [] d | k <- abs0, AWild d <- altsW ]
+        absent1 altsW           = [ a | a <- altsW, not (null abs1) ]
+        litA (ALit _ _)         = True
+        litA _                  = False
+        firstLit (ALit l _ : _) = l
+        firstLit (_ : as)       = firstLit as
+        simple (TCon (Prim Int _) []) = True
+        simple (TCon (Prim Char _) []) = True
+        simple _                = False
+
+pCmd env t0 (CSeq c c')         = liftM2 mkSeq (pCmd env t0 c) (pCmd env t0 c')
+pCmd env t0 (CBreak)            = return CBreak
+pCmd env t0 (CRaise e)          = do (bs,e) <- pExpT env tInt e
+                                     return (cBind bs (CRaise e))
+pCmd env t0 (CWhile e c c')     = do (bs,e) <- pExpT env tBool e
+                                     c <- pCmd env t0 c
+                                     liftM (cBind bs . CWhile e c) (pCmd env t0 c')
+pCmd env t0 (CCont)             = return CCont
+
+mkVarSwitch env t0 e alts
+  | isEVar e                    = do  (bs,t,e) <- pExp env e
+                                      alts <- mapM (pAlt env e t t0) alts
+                                      return (cBind bs (CSwitch e alts))
+  | otherwise                   = do (bs,t,e) <- pExp env e
+                                     x <- newName tempSym
+                                     c <- pCmd (addVals [(x,t)] env) t0 (CSwitch (EVar x) alts)
+                                     return (cBind bs (cBind [(x,Val t e)] c))
+
+mkSwitch env e [] [ACon n _ _ c]
+  | n `notElem` tagged env      = c
+mkSwitch env e [] [AWild c]     = c
+mkSwitch env e [] alts1         = CSwitch (ESel e (prim Tag)) (map (mkLitAlt env) alts1)
+mkSwitch env e alts0@[ACon n _ _ c] []
+  | allCons env alts0 == [n]    = c
+mkSwitch env e alts0 []         = CSwitch (ECast tInt e) (map (mkLitAlt env) alts0)
+mkSwitch env e alts0 alts1      = mkSwitch env e (alts0++[AWild d]) []
+  where d                       = mkSwitch env e [] alts1
+
+
+mkLitAlt env (ACon n [] [] c)   = ALit (conLit env n) c
+mkLitAlt env a                  = a
+
+
+-- Prepare switch alternatives
+pAlt env _ _ t0 (AWild c)       = liftM AWild (pCmd env t0 c)
+pAlt env _ _ t0 (ALit l c)      = liftM (ALit l) (pCmd env t0 c)
+pAlt env e (TCon _ ts) t0 (ACon k vs te c)
+                                = do te' <- newEnv paramSym (polyTagTypes (length vs))
+                                     c <- pCmd (addPolyEnv vs [0..] (map EVar (dom te')) (addVals te env)) t0 c
+                                     return (ACon k [] [] (cBind (bs0 te' ++ bs1) c))
+  where bs0 te                  = zipWith mkBind te (_abcSupply `zip` repeat (ValT tBITS32))
+        (_,te0)                 = findStructTEnv "KKK" env (TCon k (ts ++ map tVar vs))
+        bs1                     = filter (not . isDummy . fst) (zipWith mkBind te te0)
+        mkBind (x,t) (y,ValT u) = (x, Val t (cast t u (ESel (ECast (TCon k (ts ++ map tVar vs)) e) y)))
+        
+        
+
+mkSeq c1 c2                     = case anchor c1 of
+                                    (bf,CBreak) -> bf c2
+                                    (bf,CCont)  -> c1
+                                    _           -> CSeq c1 c2
+  where anchor (CBind r bs c)   = (CBind r bs . bf, c')
+          where (bf,c')         = anchor c
+        anchor (CRun e c)       = (CRun e . bf, c')
+          where (bf,c')         = anchor c
+        anchor (CUpd x e c)     = (CUpd x e . bf, c')
+          where (bf,c')         = anchor c
+        anchor (CUpdS e x e' c) = (CUpdS e x e' . bf, c')
+          where (bf,c')         = anchor c
+        anchor (CUpdA e i e' c) = (CUpdA e i e' . bf, c')
+          where (bf,c')         = anchor c
+        anchor c                = (id, c)
+
+
+
+-- =============================
+-- Prepare expressions
+-- =============================
+
+-- Prepare a right-hand-side expression
+pRhsExp env (ENew n ts bs)      = pNewExp env n ts bs
+pRhsExp env (ECast t (ENew n ts bs))
+                                = do (bs',t',e) <- pNewExp env n ts bs
+                                     return (bs', t, cast t t' e)
+pRhsExp env e                   = pExp env e
+
+
+pNewExp env n ts bs
+  | n `elem` nulls env          = return ([], t0, cast t0 tInt (ELit (conLit env n)))
+  | otherwise                   = do (bs1,bs) <- pBinds (pSBind t0 te0) env bs
+                                     return (bs1, t0, ENew n [] (bs''++bs'++bs))
+  where bs'                     = if n `elem` tagged env then [(prim Tag, Val tInt (ELit (conLit env n)))] else []
+        bs''                    = polyTagBinds env n ts
+        t0                      = TCon n ts
+        (_,te0)                 = findStructTEnv "BB" env t0
+
+
+pRefBind te0 env (x,Val _ e)    = do (bs,t,e) <- pRhsExp env e 
+                                     return (bs, (x, Val (erase t0) (cast t0 t e)))
+  where t0                      = findValT "1" te0 x
+
+
+-- Prepare an expression in an arbitrary position and match its type with the expected one
+pExpT env t0 e                  = do (bs,t,e) <- pExp env e
+                                     return (bs, cast t0 t e)
+
+
+cast t0 t1 e
+  | u0 == u1                    = e
+  | u0 == tPOLY && smallPrim u1 = ECast tPOLY (ECast tInt e)
+  | smallPrim u0 && u1 == tPOLY = ECast u0 (ECast tInt e)
+  | u0 == tPOLY && u1 == tFloat = ECall (prim Float2POLY) [] [e]
+  | u0 == tFloat && u1 == tPOLY = ECall (prim POLY2Float) [] [e]
+  | otherwise                   = ECast u0 e
+  where u0                      = erase t0
+        u1                      = erase t1
+
+smallPrim (TCon (Prim p _) _)   = p `elem` smallPrims
+smallPrim _                     = False
+
+
+pExpTs env [] []                = return ([], [])
+pExpTs env (t:ts) (e:es)        = do (bs1,e) <- pExpT env t e
+                                     (bs2,es) <- pExpTs env ts es
+                                     return (bs1++bs2, e:es)
+
+
+-- Prepare an expression in an arbitrary position and compute its type
+pExp env (EVar x)                   = return ([], findValT "4" (tenv env) x, EVar x)
+pExp env (ELit l)                   = return ([], litType l, ELit l)
+pExp env (EThis)                    = return ([], findValT "5" (tenv env) x, EVar x)
+  where x                           = fromJust (this env)
+pExp env (ESel e l)                 = do (bs,t1,e) <- pExp env e
+                                         let (s,te) = findStructTEnv "CC" env t1
+                                             t = findValT ("6" ++ " e: " ++ render (pr e) ++ "  te: " ++ show te) te l
+                                         specialize s t bs (ESel e l)
+pExp env (ECall f ts es)            = do (bs,es) <- pExpTs env ts0 es
+                                         specialize s t bs (ECall f [] (polyTagArgs env ts ++ es))
+  where (s,ts0,t)                   = findFunT (tenv env) f ts
+pExp env (EEnter (EVar x) f ts es)  = do let t1 = findValT "7" (tenv env) x
+                                         let (s,te) = findStructTEnv "DD" env t1
+                                             (s',ts0,t) = findFunT te f ts
+                                         (bs2,es) <- pExpTs env ts0 es
+                                         specialize (s'@@s) t bs2 (EEnter (EVar x) f [] (polyTagArgs env ts ++ es))
+pExp env (EEnter e f ts es)         = do (bs1,t1,e) <- pRhsExp env e
+                                         let (s,te) = findStructTEnv "EE" env t1
+                                             (s',ts0,t) = findFunT te f ts
+                                         (bs2,es) <- pExpTs env ts0 es
+                                         x <- newName tempSym
+                                         specialize (s'@@s) t (bs1++bs2++[(x, Val (erase t1) e)]) (EEnter (EVar x) f [] (polyTagArgs env ts ++ es))
+pExp env (ECast t e)                = do (bs,t',e) <- pExp env e
+                                         return (bs, t, cast t t' e)
+pExp env (ENew n ts bs)
+  | n `elem` nulls env              = return ([], tInt, ELit (conLit env n))
+  | otherwise                       = do (bs1,t,e) <- pNewExp env n ts bs
+                                         x <- newName tempSym
+                                         return (bs1++[(x, Val (erase t) e)], t, EVar x)
+
+specialize s t bs e                 = return (bs, t', cast t' t e)
+  where t'                          = subst s t
diff --git a/src/Reduce.hs b/src/Reduce.hs
new file mode 100644
--- /dev/null
+++ b/src/Reduce.hs
@@ -0,0 +1,950 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Reduce where
+
+import PP
+import Common
+import Core
+import Env
+import Kind
+import Depend
+import Termred
+
+
+
+
+type TSubst                             = Map TVar Type
+
+type TEqs                               = [(Type,Type)]
+
+noreduce env eqs pe                     = do s0 <- unify env eqs
+                                             return (s0, pe, id)
+
+fullreduce                              :: Env -> TEqs -> PEnv -> M s (TSubst, PEnv, Exp->Exp)
+fullreduce env eqs pe                   = do -- tr ("FULLREDUCE\n" ++ render (vpr pe))
+                                             (s1,pe1,f1) <- normalize env eqs pe
+                                             -- tr ("Subst: " ++ show s1)
+                                             let env1     = subst s1 env
+                                             (s2,pe2,f2) <- resolve env1 pe1
+                                             -- tr ("END FULLREDUCE " ++ show pe2)
+                                             return (s2@@s1, pe2, f2 . f1)
+
+topresolve env eqs pe bs                = do (s,[],f) <- fullreduce env eqs pe
+                                             let Binds r te es = collect (f (ELit (lInt 0))) `catBinds` bs
+                                             return (Binds r (subst s te) es)
+  where collect (ELet bs e)             = bs `catBinds` collect e
+        collect e                       = nullBinds
+
+normalize env eqs pe                    = do -- tr ("NORMALIZE: " ++ render (vpr pe))
+                                             s0 <- unify env eqs
+                                             -- tr ("NORMALZE B: " ++ show s0)
+                                             let env0 = subst s0 env
+                                             (s1,pe1,f1) <- norm env0 (subst s0 pe)
+                                             -- tr ("END NORMALZE ")
+                                             return (s1@@s0, pe1, f1)
+                                             
+
+norm env []                             = return ([], [], id)
+norm env pe                             = do -- tr ("NORM A\n" ++ render (nest 8 (vpr pe)))
+                                             (s1, pe1, f1) <- reduce env pe
+                                             -- tr ("NORM B\n" ++ render (nest 8 (vpr pe1)))
+                                             (s2, pe2, f2) <- simplify (subst s1 env) pe1
+                                             -- tr ("NORM C\n" ++ render (nest 8 (vpr pe2)))
+                                             return (s2@@s1, pe2, f2 . f1)
+
+-- Auxiliary function for type error messages -------------------------------------------------
+
+{-
+
+Type error messages are still a hack.
+
+The problem is to find reasonable error messages when the constraint-solver has failed after
+having backtracked and tried several alternatives. he present approach works reasonably well 
+when failing in search for a witness of a typeclass, but gives a confusing message (only
+the last alternative tried) in other cases. 
+
+Also, coding of various types of failure in the first character of the error message is not
+very elegant...
+
+-}
+
+data ErrType                            = Solve | Unify | Other
+
+typeError e env msg                     = char e : "Type error " ++ (show (errPos env)) ++ "\n" ++ msg
+  where char Solve                      = '+'
+        char Unify                      = '-'
+        char Other                      = ' '
+
+-- Conservative reduction ----------------------------------------------------------------------
+
+reduce env pe                           = do -- tr ("###reduce\n" ++ render (nest 8 (vpr pe)) ) -- ++ "\n\n" ++ show (tvars (typeEnv env)))
+                                             (s,q,[],es) <- red [] (map mkGoal pe)
+                                             -- tr ("###result\n" ++ render (nest 8 (vpr q)))
+                                             -- tr ("        " ++ show s)
+                                             return (s, q, eLet pe (dom pe `zip` es))
+  where mkGoal (v,p)                    =  (tick env{errPos = posInfo v} (isCoercion v || isDummy v), p)
+
+-- Simplification ------------------------------------------------------------------------------
+
+simplify env pe                         = do cs <- newNames skolemSym (length tvs)
+                                             -- tr ("****SIMPLIFY\n" ++ render (nest 8 (vpr (subst (tvs`zip`map TId cs) pe))))
+                                             r <- expose (closePreds env [] (subst (tvs`zip`map TId cs) pe) (cs`zip`ks))
+                                             case r of
+                                               Right (env',qe,eq) -> return (nullSubst, pe', eLet' (subst s bss))
+                                                 where (pe',bss) = preferLocals env' pe qe eq
+                                                       s = cs `zip` map TVar tvs
+                                               Left s -> case decodeError s of
+                                                 Nothing -> fail (typeError Other env s)
+                                                 Just (m,ids) | m == circularSubMsg -> 
+                                                        do (t:ts) <- mapM sat tvs'
+                                                           -- tr ("Circular: " ++ showids ids)
+                                                           s <- unify env (repeat t `zip` ts)
+                                                           -- tr ("New: " ++ render (nest 8 (vpr (subst s pe))))
+                                                           (s',pe',f) <- norm (subst s env) (subst s pe)
+                                                           return (s'@@s, pe', f)
+                                                     where tvs' = [ tv | (tv,c) <- tvs `zip` cs, c `elem` ids ]
+                                                           sat tv = do ts <- mapM newTVar (kArgs (tvKind tv))
+                                                                       return (tAp (TVar tv) ts)
+                                                 Just (m,ids) | m `elem` [ambigSubMsg, ambigInstMsg] ->
+                                                        do -- tr ("Ambiguous: " ++ showids ids)
+                                                           -- tr (render (nest 8 (vpr (t:ts))))
+                                                           s <- unifyS env (repeat t `zip` ts)
+                                                           -- tr ("New:\n" ++ render (nest 8 (vpr (subst s pe))))
+                                                           (s',pe',f) <- norm (subst s env) (subst s pe)
+                                                           return (s'@@s, pe', f)
+                                                     where (t:ts) = map (lookup' (pe ++ predEnv env ++ predEnv0 env)) ids
+  where tvs                             = tvars pe
+        ks                              = map tvKind tvs
+
+
+{-
+
+B x < C Int \\ x
+A x < B x \\ x, A x < C x \\ x
+
+A x < B x \\ x, A x < C x \\ x
+B x < C Int \\ x
+
+Show [a] \\ a
+Show [Char] \\
+
+E a \\ a
+E a \\ a, F a
+
+b x < c Int \\ x, a x < b x \\ x, a x < c x \\ x
+
+a x < b x \\ x, a x < c x \\ x, b x < c Int \\ x
+
+-}
+
+-- Forced reduction ------------------------------------------------------------------------
+
+resolve env pe                          = do -- tr ("############### Before resolve: ")
+                                             -- tr (render (nest 8 (vpr pe)))
+                                             -- tr ("tevars: " ++ show env_tvs ++ ",   reachable: " ++ show reachable_tvs)
+                                             (s1,q1,[],es) <- red [] (map mkGoal pe)
+                                             -- tr ("############### After resolve: ")
+                                             -- tr (render (nest 8 (vpr q1)))
+                                             let f1 = eLet pe (dom pe `zip` es)
+                                                 badq = filter badDummy q1
+                                             assert1 (null badq) "Cannot resolve predicates" (snd (head badq))
+                                             -- tr "DONE RESOLVING"
+                                             (s2,q2,f2) <- simplify (subst s1 env) q1
+                                             return (s2@@s1, q2, f2 . f1)
+  where env_tvs                         = tevars env
+        reachable_tvs                   = vclose (map tvars pe) (ps ++ ns ++ env_tvs)
+          where (ps,ns)                 = pols env
+        mkGoal (v,p)                    = (force env' (coercion || ambig), p)
+          where tvs                     = tvars p
+                coercion                = isCoercion v
+                ambig                   = null (tvs `intersect` reachable_tvs)
+                env'                    = tick env coercion
+        badDummy (v,p)                  = isDummy v && null (tvars p `intersect` env_tvs)
+
+
+{-
+
+    C1 x < C x
+    C2 x < C Y
+    C3 x < C y \\ x < y
+
+
+    |- m aa < C b     |- Int < Int                              (All a . Exists b . m a < C b)
+    ------------------------------                              (All a . m a < C b)
+    |- C b -> Int  <  m aa -> Int
+    ---------------------------------------                     (All a . (All b . m a < C b) =>
+    |- (All b . C b -> Int)  <  m aa -> Int
+    ----------------------------------------------
+    |- All a . (All b . C b -> Int)  <  m a -> Int
+
+
+
+    |- C1 aa < C aa     |- Int < Int                            C1 / m, aa / b
+    --------------------------------
+    |- C aa -> Int  <  C1 aa -> Int
+    ----------------------------------------
+    |- (All b . C b -> Int)  <  C1 aa -> Int
+    -----------------------------------------------
+    |- All a . (All b . C b -> Int)  <  C1 a -> Int
+
+
+
+    |- C2 aa < C Y     |- Int < Int                             C2 / m, Y / b
+    -------------------------------
+    |- C Y -> Int  <  C2 aa -> Int
+    ----------------------------------------
+    |- (All b . C b -> Int)  <  C2 aa -> Int
+    ------------------------------------------------
+    |- All a . (All b . C b -> Int)  <  C2 ab -> Int
+
+
+    All a . a < b |- aa < b                                     C3 / m
+    -----------------------
+    All a . a < b |- C3 aa < C b     |- Int < Int
+    ---------------------------------------------
+    All a . a < b |- C b -> Int  <  C3 aa -> Int
+    -----------------------------------------------------
+    All a . a < b |- (All b . C b -> Int)  <  m aa -> Int
+    ------------------------------------------------------------
+    All a . a < b |- All a . (All b . C b -> Int)  <  m a -> Int
+
+
+
+
+-}
+
+-- Scheme reduction -----------------------------------------------------------------------------
+--
+-- If   red cs ps == (s,q,es,es')    then   q |- es :: subst s cs   and   q |- es' :: subst s ps
+--
+-------------------------------------------------------------------------------------------------
+
+redg r i gs                             = do -- tr ("Chosen goal: " ++ render (pr (snd g)) ++ " at index " ++ show i ++ ",  rank: " ++ show r)
+                                             -- tr ("***All goals:")
+                                             -- tr (render (nest 4 (vpr (rng gs))))
+                                             (s,q,e:es) <- solve r g (gs1++gs2)
+                                             let (es1,es2) = splitAt i es
+                                             return (s, q, es1++[e]++es2, [])
+  where (gs1, g:gs2)                    = splitAt i gs
+
+
+red [] []                               = return (nullSubst, [], [], [])
+red gs []                               = do -- tr ("Ranks: " ++ show rs)
+                                             case unique 0 gs of
+                                               Just (r,i) -> redg r i gs   -- goal can be selected without computing costly varInfo
+                                               Nothing    -> redg r i gs   -- goal must be selected on basis of varInfo
+  where rs                              = map (rank info) gs
+        r                               = minimum rs
+        i                               = length (takeWhile (/=r) rs)
+        info                            = varInfo gs
+red gs ((env, p@(Scheme (F [sc1] t2) ps2 ke2)):ps)
+                                        = do (t1,ps1) <- inst sc1
+                                             -- tr ("redf " ++ render (pr t1 <+> text "<" <+> pr t2))
+                                             pe <- newEnv assumptionSym ps2
+                                             v  <- newName coercionSym
+                                             (env',qe,eq) <- closePreds env (tvars sc1 ++ tvars t2 ++ tvars ps2) pe ke2
+                                             let ps' = repeat (tick env' False) `zip` ps1
+                                             (s,q,es,e,es') <- redf gs env' t1 t2 (ps'++ps)
+                                             pe1 <- wildify ke2 pe
+                                             qe1 <- wildify ke2 qe
+                                             let (es1,es2) = splitAt (length ps') es'
+                                                 bss = preferParams env' pe1 qe1 eq
+                                                 e' = eLet' bss (EAp e [eAp (EVar v) es1])
+                                             return (s, q, es, eLam pe1 (ELam [(v,sc1)] e') : es2)
+red gs ((env, Scheme (R t) ps' ke):ps)  = do pe <- newEnv assumptionSym ps'
+                                             (env',qe,eq) <- closePreds env (tvars t ++ tvars ps') pe ke
+                                             (s,q,e:es,es') <- red ((env',t) : gs) ps
+                                             pe1 <- wildify ke pe
+                                             qe1 <- wildify ke qe
+                                             let bss = preferParams env' pe1 qe1 eq
+                                             return (s, q, es, eLam pe1 (eLet' bss e) : es')
+
+{-
+   ts   -> t    <        ts'   -> t'
+ts1,ts2 -> t    <    ts1',ts2' -> t'
+
+es1 :: ts1' < ts1
+e   :: ts2->t < ts2'->t'
+
+e0  = \(v::ts->t) -> \(ys1:ts1',ys2:ts2') -> e1
+
+e1  :: t'      =  e e2 ys2
+e2  :: ts2->t  =  \(xs2:ts2) -> v (es3,xs2)
+es3 :: ts1     =  es1@ys1
+-}
+
+redf gs env (F ts t) (F ts' t') ps      = do te1' <- newEnv assumptionSym ts1'
+                                             te2' <- newEnv assumptionSym ts2'
+                                             te2  <- newEnv assumptionSym ts2
+                                             v    <- newName coercionSym
+                                             (s,q,es,e,es1,es2) <- redf1 gs env (tFun ts2 t) (tFun ts2' t') ts1' ts1 ps
+                                             let e0  = ELam [(v,scheme' (F ts t))] (ELam (te1'++te2') e1)
+                                                 e1  = eAp (EAp e [e2]) (map EVar (dom te2'))
+                                                 e2  = eLam te2 (EAp (EVar v) (es3 ++ map EVar (dom te2)))
+                                                 es3 = zipWith eAp1 es1 (map EVar (dom te1'))
+                                             return (s, q, es, e0, es2)
+  where (ts1 ,ts2 )                     = splitAt (length ts') ts
+        (ts1',ts2')                     = splitAt (length ts ) ts'
+redf gs env (R (TFun ts t)) b ps        = redf gs env (F (map scheme ts) (R t)) b ps
+redf gs env a (R (TFun ts t)) ps        = redf gs env a (F (map scheme ts) (R t)) ps
+redf gs env (R a@(TVar n)) b@(F ts _) ps
+  | n `elem` tvars b                    = fail (typeError Other env "Infinite function type")
+  | otherwise                           = do (t:ts') <- mapM newTVar (replicate (length ts + 1) Star)
+                                             s <- unify env [(a, TFun ts' t)]
+                                             redf2 s gs env (F (map scheme ts') (R t)) b ps 
+redf gs env a@(F ts _) (R b@(TVar n)) ps
+  | n `elem`tvars a                     = fail (typeError Other env "Infinite function type")
+  | otherwise                           = do (t:ts') <- mapM newTVar (replicate (length ts + 1) Star)
+                                             s <- unify env [(TFun ts' t, b)]
+                                             redf2 s gs env a (F (map scheme ts') (R t)) ps 
+redf gs env (R a) (R b) ps              = do (s,q,e:es,es') <- red ((tick env True, a `sub` b) : gs) ps
+                                             return (s,q,es,e,es')
+redf _ env t1 t2 _                        = fail (typeError Other env ("Cannot solve " ++ render (pr t1) ++ " < " ++ render (pr t2)))
+
+
+redf1 gs env a b (sc1:ts1) (sc2:ts2) ps = do (s,q,es,e,es1,e2:es2) <- redf1 gs env a b ts1 ts2 ((env,sc):ps)
+                                             return (s, q, es, e, flip e2 : es1, es2)
+  where Scheme t2 ps2 ke2               = sc2
+        sc                              = Scheme (F [sc1] t2) ps2 ke2
+        flip e  | null ps2              = e
+        flip (ELam te2 (ELam te1 t))    = ELam te1 (ELam te2 t)
+redf1 gs env a b [] [] ps               = do (s,q,es,e,es2) <- redf gs env a b ps
+                                             return (s,q,es,e,[],es2)
+
+
+
+redf2 s gs env a b ps                   = do (s',q,es,e,es') <- redf (subst s gs) (subst s env) 
+                                                                   (subst s a) (subst s b) (subst s ps)
+                                             return (s'@@s,q,es,e,es')
+
+
+
+-- Predicate reduction ----------------------------------------------------------------------
+
+solve RFun (env,p) gs                   = do -- tr ("------ Resubmitting: " ++ render (pr p))
+                                             (s,q,es,[e]) <- red gs [(env, scheme' (F [scheme a] (R b)))]
+                                             return (s, q, e:es)
+  where (a,b)                           = subs p
+solve RUnif (env,p) gs                  = do -- tr ("------ Unifying: " ++ render (pr p))
+                                             s <- unify env [(a,b)]
+                                             (s',q,es,[]) <- red (subst s gs) []
+                                             return (s'@@s, q, EVar (prim Refl) : es)
+  where (a,b)                           = subs p
+solve RVar g gs                         = do -- tr ("------ Abstracting\n" ++ render (nest 4 (vpr (rng (g:gs)))))
+                                             (qs,es) <- fmap unzip (mapM newHyp (g:gs))
+                                             return (nullSubst, concat qs, es)
+solve r g gs
+  | mayLoop g                           = do assert0 (conservative g) "Recursive constraint"
+                                             -- tr ("------ Avoiding loop: " ++ render (pr (snd g)))
+                                             (s,q,es,_) <- red gs []
+                                             (q',e) <- newHyp (subst s g)
+                                             return (s, q'++q, e:es)
+  | otherwise                           = do -- tr ("------ Solving " ++ render (pr (snd g)))
+                                             -- tr (render (nest 4 (vpr (rng gs))))
+                                             -- tr ("Witness graph: " ++ show (findWG r g))
+                                             try r (Left msg) (findWG r g) (logHistory g) gs
+  where msg                             = typeError Solve (fst g) ("Cannot solve typing constraint "++render(prPred (snd g)))
+
+
+try r accum wg g gs
+  | isNullWG wg || isNull accum         = unexpose accum
+  | otherwise                           = do -- tr ("Trying " ++ render (pr (snd g)) ++ " with " ++ render (pr (predOf wit)))
+                                             res <- expose (hyp wit g gs)
+                                             accum <- plus (g : gs) accum res
+                                             -- tr ("New accum: " ++ show accum)
+                                             try r accum (wg2 res) g gs
+  where (wit,wg1)                       = takeWG wg
+        wg2 res                         = if mayPrune res r g then pruneWG (nameOf wit) wg1 else wg1
+
+mayPrune (Left _)  _          _         = False
+mayPrune (Right r) (RClass _ _) (env,c) = forced env || subst (fst3 r) c == c
+mayPrune _         _          _         = True
+
+
+hyp (w,p) (env,c) gs                    = do (R c',ps) <- inst p
+                                             -- tr ("### Trying: " ++ render (pr c) ++ "  with  " ++ render (pr (w,p)))
+                                             s <- unify env [(c,c')]
+                                             -- tr ("    OK")
+                                             let ps' = repeat (subst s env) `zip` subst s ps
+                                             -- if not (null ps') then tr ("@@ Appending\n" ++ render (nest 4 (vpr (rng ps')))) else return ()
+                                             (s',q,es,es') <- red (subst s gs) ps'
+                                             return (s'@@s, q, eAp (EVar w) es' : es)
+
+
+plus gs (Left a) (Left b)
+  |head a == '+' &&
+   head b == '-'                        = return (Left a)
+  |otherwise                            = return (Left b)
+plus gs (Left a) b                      = return b
+plus gs a (Left b)                      = return a
+plus gs (Right (s1,_,es1)) (Right (s2,_,es2))   
+                                        = do s <- auSubst env s1 s2
+                                             (s',q,es) <- auTerms (subst s gs) es1 es2
+                                             return (Right (s'@@s, q, es))
+  where env                             = fst (head gs)
+
+
+-- Anti-unification --------------------------------------------------------------------------
+
+auSubst env [] s2                       = return []
+auSubst env ((v1,t1):s1) s2             = case lookup v1 s2 of
+                                            Just t2 | h1 == h2 -> 
+                                              do ts <- auTypes ts1 ts2
+                                                 s <- auSubst env s1 s2
+                                                 return ((v1, tAp h1 ts):s)
+                                              where (h1,ts1) = tFlat t1
+                                                    (h2,ts2) = tFlat t2
+                                            _ -> auSubst env s1 s2
+  where auType t1 t2
+          | h1 == h2                    = do ts <- auTypes ts1 ts2
+                                             return (tAp h1 ts)
+          | otherwise                   = newTVar (kindOfType env t1)
+          where (h1,ts1)                = tFlat t1
+                (h2,ts2)                = tFlat t2
+        auTypes ts1 ts2                 = sequence (zipWith auType ts1 ts2)
+
+
+
+auTerms gs es1 es2                      = auZip auTerm gs es1 es2
+  where
+    auZip f [] [] []                    = return ([],[],[])
+    auZip f (g:gs) (e1:es1) (e2:es2)    = do (s,q,e) <- f g e1 e2
+                                             (s',q',es) <- auZip f (subst s gs) es1 es2
+                                             return (s'@@s, subst s' q ++ q', e:es)
+    auZip f gs es1 es2                  = internalError0 ("auZip " ++ show gs ++"\n" ++ show es1 ++ "\n" ++ show es2) 
+    auTerm g@(env,c) e1 e2              = auTerm' g (eFlat e1) (eFlat e2)
+
+
+    auTerm' g@(env,c) (EVar v1, es1) (EVar v2, es2)
+      | v1 == v2                        = do (R c',ps) <- inst (findPred env v1)
+                                             let s = matchTs [(c,c')]
+                                             (s',q,es) <- auZip auSc (repeat (subst s env) `zip` subst s ps) es1 es2
+                                             return (s'@@s, q, eAp (EVar v1) es)
+    auTerm' g@(env,c) (ELam pe1 e1, es1) (ELam pe2 e2, es2)
+      | ps1 == ps2                      = do (s,q,e) <- auTerm g e1 (subst s0 e2)
+                                             (s',q',es) <- auZip auSc (repeat (subst s env) `zip` subst s ps1) es1 es2
+                                             return (s'@@s, subst s' q ++ q', eAp (ELam pe1 e) es)
+      where (vs1,ps1)                   = unzip pe1
+            (vs2,ps2)                   = unzip pe2
+            s0                          = vs2 `zip` map EVar vs1
+    auTerm' g e1 e2                     = do (q,e) <- newHyp g
+                                             return ([], q, e)
+
+    auSc (env,Scheme (R c) [] ke) e1 e2 = auTerm (addKEnv ke env,c) e1 e2
+    auSc (env,Scheme (R c) ps ke) (ELam pe1 e1) (ELam pe2 e2)     
+                                        = do (s,q,e) <- auTerm (env',c) e1 (subst s0 e2)
+                                             return (s, q, ELam pe1 e)
+      where s0                          = dom pe2 `zip` map EVar (dom pe1)
+            env'                        = addPEnv pe1 (addKEnv ke env)
+    auSc _ _ _                          = internalError0 "auTerms"
+
+
+newHyp (env,c)                          = do -- tr ("newHyp " ++ render (pr p) ++ "   " ++ show (forced env))
+                                             v <- newName (sym env)
+                                             return ([(v,p)], eAp (EVar (annotExplicit v)) (map EVar vs))
+  where p                               = Scheme (R c) ps ke
+        (vs,ps)                         = unzip (predEnv env)
+        ke                              = kindEnv env
+        sym env
+          | forced env                  = dummySym          -- unwanted garbage predicate, trap in resolve
+          | ticked env                  = coercionSym       -- originates from a coercion predicate
+          | otherwise                   = assumptionSym     -- ordinary predicate
+
+
+-- Unification ----------------------------------------------------------
+
+unify env []                            = return nullSubst
+unify env ((TVar n,t):eqs)
+  | mayBind env n                       = tvarBind env n t eqs
+unify env ((t,TVar n):eqs)
+  | mayBind env n                       = tvarBind env n t eqs
+unify env ((TAp t u,TAp t' u'):eqs)     = unify env ((t,t'):(u,u'):eqs)
+unify env ((TId c,TId c'):eqs)
+  | c == c'                             = unify env eqs
+unify env ((TFun ts t, TFun ts' t'):eqs)
+  | length ts == length ts'             = unify env ((t,t') : ts `zip` ts' ++ eqs)
+unify env ((t1,t2):_)                   = fail (typeError Unify env ("Cannot unify " ++ render(pr t1) ++ " with " ++ render(pr t2)))
+
+tvarBind env n t eqs
+  | t == TVar n                         = unify env eqs
+  | tvKind n /= kindOfType env t        = fail (typeError Other env ("Kind mismatch in unify: "  ++ show (tvKind n) ++ 
+                                                " and " ++ show (kindOfType env t)))
+  | n `elem` tvars t                    = fail (typeError Other env "Occurs check failed in unify")
+  | n `elem` skolEnvs env (tyvars t)    = fail (typeError Other env "Skolem escape in unify")
+  | otherwise                           = do s' <- unify (subst s env) (subst s eqs)
+                                             return (s' @@ s)
+  where s                               = n +-> t
+
+mayBind env n                           = not (frozen env && n `elem` pevars env)
+
+
+-- Unification lifted to type schemes: only used to resolve ambiguities found during simplification --------------------
+
+unifyS env ((Scheme r ps ke,Scheme r' ps' ke'):eqs)
+  | rng ke == rng ke' &&
+    length ps == length ps'             = do s <- unifyR env (subst s0 r, subst s0 r')
+                                             s' <- unifyS env (subst s (subst s0 ((ps `zip` ps') ++ eqs)))
+                                             return (s' @@ s)
+  | otherwise                           = fail (typeError Other env "Quantified predicates not unifiable")
+  where s0                              = dom ke `zip` map TId (dom ke')
+unifyS env []                           = return nullSubst
+
+unifyR env (R t, R t')                  = unify env [(t,t')]
+unifyR env (F scs r, F scs' r')
+  | length scs == length scs'           = do s <- unifyS env (scs `zip` scs')
+                                             s' <- unifyR env (subst s r, subst s r')
+                                             return (s' @@ s)
+unifyR env _                            = fail (typeError Other env "Subtype predicates not unifiable")
+
+                                        
+-- Misc ----------------------------------------------------------------
+
+mayLoop (env,c)                         = any (\c' -> equalTs [(c,c')]) (history env)
+
+
+isNull (Right ([],q,es))
+  | all varTerm es                      = True
+  where varTerm (EAp e es)              = varTerm e
+        varTerm (ELam pe e)             = varTerm e
+        varTerm (EVar v)                = v `elem` vs
+        varTerm _                       = False
+        vs                              = dom q
+isNull _                                = False
+
+
+
+-- Adding predicates to the environment -------------------------------------------------
+
+closePreds0 env pe                      = do (env1,pe1,eq1) <- closeTransitive env0 pe
+                                             (env2,pe2,eq2) <- closeSuperclass env1 pe
+                                             return (env2, pe1++pe2, eq1++eq2)
+  where env0                            = addPEnv0 pe env
+
+closePreds env tvs pe ke                = do (env1,pe1,eq1) <- closeTransitive env0 pe
+                                             (env2,pe2,eq2) <- closeSuperclass env1 pe
+                                             return (thaw env2, pe1++pe2, eq1++eq2)
+  where se                              = mapSnd (const (tvs ++ pevars env)) ke
+        env0                            = freeze (addPEnv pe (addSkolEnv se (addKEnv ke env)))
+
+
+preferLocals env pe qe eq               = walk [] (equalities env)
+  where walk bs []                      = let (pe1,pe2) = partition ((`elem` dom bs) . fst) pe
+                                          in  (pe2, groupBinds (Binds False (pe1++qe) (prune eq (dom bs) ++ mapSnd EVar bs)))
+        walk bs ((x,y):eqs)
+          | x `notElem` vs1             = walk bs eqs
+          | y `notElem` vs1             = walk bs eqs
+          | otherwise                   = case (x `elem` vs0, y `elem` vs0) of
+                                            (True,  True)  -> walk ((x,y):bs) eqs
+                                            (True,  False) -> walk ((x,y):bs) eqs
+                                            (False, True)  -> walk ((y,x):bs) eqs
+                                            (False, False) -> walk ((y,x):bs) eqs
+        vs0                             = dom pe
+        vs1                             = vs0 ++ dom qe
+
+preferParams env pe qe eq               = walk [] [] (equalities env)
+  where walk ws bs []                   = groupBinds (Binds False (prune qe ws) (prune eq (ws ++ dom bs) ++ mapSnd EVar bs))
+        walk ws bs ((x,y):eqs)
+          | x `notElem` vs1             = walk ws bs eqs
+          | y `notElem` vs1             = walk ws bs eqs
+          | otherwise                   = case (x `elem` vs0, y `elem` vs0) of
+                                            (True,  True)  -> walk ws bs eqs
+                                            (True,  False) -> walk ws ((y,x):bs) eqs
+                                            (False, True)  -> walk (x:ws) bs eqs
+                                            (False, False) -> walk (x:ws) bs eqs
+        vs0                             = dom pe
+        vs1                             = vs0 ++ dom qe
+
+
+{-
+                                                        Top-level & local reduction:        Action during simplify:
+In (equalities env):  Meaning:                          (prefer assumptions (v) in (pe))    (prefer local defs (w) in (qe))
+
+    (v,v')      Two witness assumptions equal           Ignore equality info                Remove assumption v
+                                                        [only v' is in use]                 Add def "let v = v' in ..."
+
+    (v,w')      Witness assumption is equal to a        Remove local def of w' [in use]     Remove assumption v
+                local def                               Add "let w' = v in ..."             Add def "let v = w' in ..."
+
+    (w,v')      Witness assumption is equal to a        Remove local def of w               Remove assumption v'
+                local def                               [only assumption v' is in use]      Add def "let v' = w in ..."
+
+    (w,w')      Two local witness definitions           Remove local def of w               Remove local def of w'
+                are equal                               [only w' is in use]                 Add def "let w' = w in ..."
+
+    v and v' are witness assumptions (elements of (dom pe))
+    w and w' are locally generated witnesses (elements of (dom qe))
+
+-}
+
+
+mapSuccess f xs                         = do xs' <- mapM (expose . f) xs
+                                             return (unzip [ x | Right x <- xs' ])
+
+
+-- Handle subtype predicates
+closeTransitive env []                  = return (env, [], [])
+closeTransitive env ((w,p):pe)
+  | isSub' p                            = do assert1 (a /= b) "Illegal subtype predicate" p
+                                             (pe1,eq1) <- mapSuccess (mkTrans env) [ (n1,n2) | n1 <- below_a, n2 <- [(w,p)] ]
+                                             (pe2,eq2) <- mapSuccess (mkTrans env) [ (n1,n2) | n1 <- (w,p):pe1, n2 <- above_b ]
+                                             let cycles = filter (uncurry (==)) (map (subsyms . predOf) (pe1++pe2))
+                                             assert0 (null cycles) (encodeError circularSubMsg (nub (a:b:map fst cycles)))
+                                             env2 <- addPreds env ((w,p):pe1++pe2)
+                                             (env3,pe3,eq3) <- closeTransitive env2 pe
+                                             return (env3, pe1++pe2++pe3, eq1++eq2++eq3)
+  where (a,b)                           = subsyms p
+        below_a                         = nodes (findBelow env a)
+        above_b                         = nodes (findAbove env b)
+closeTransitive env (_:pe)              = closeTransitive env pe
+
+
+mkTrans env ((w1,p1), (w2,p2))          = do (pe1, R c1, e1) <- instantiate p1 (EVar w1)
+                                             (pe2, R c2, e2) <- instantiate p2 (EVar w2)
+                                             let (t1,t1') = subs c1
+                                                 (t2',t2) = subs c2
+                                             s <- unify env [(t1',t2')]
+                                             let t = subst s t1
+                                                 p = scheme (t `sub` subst s t2)
+                                             (s',qe,f) <- norm (protect p env) (subst s (pe1++pe2))
+                                             x  <- newName paramSym
+                                             let e = ELam [(x,scheme (subst s' t))] (f (EAp e2 [EAp e1 [EVar x]]))
+                                                 (e',p') = qual qe e (subst s' p)
+                                             sc <- gen (tevars env) p'
+                                             w <- newNameMod (modName env) coercionSym
+                                             e' <- redTerm (coercions env) e'
+                                             return ((w,sc), (w, e'))
+
+-- Handle class predicates
+closeSuperclass env []                  = return (env, [], [])
+closeSuperclass env ((w,p):pe)
+  | isClass' p                          = do (pe1,eq1) <- mapSuccess (mkSuper env (w,p)) [ n | n <- above_c ]
+                                             env1 <- addPreds env ((w,p):pe1)
+                                             (env2,pe2,eq2) <- closeSuperclass env1 pe
+                                             return (env2, pe1++pe2, eq1++eq2)
+  where c                               = headsym p
+        above_c                         = filter ((`elem` dom (classEnv env)) . uppersym . predOf) (nodes (findAbove env c))
+closeSuperclass env (_:pe)              = closeSuperclass env pe
+
+mkSuper env (w1,p1) (w2,p2)             = do (pe1, R c1, e1) <- instantiate p1 (EVar w1)
+                                             (pe2, R c2, e2) <- instantiate p2 (EVar w2)
+                                             let (t2',t2) = subs c2
+                                             s <- unify env [(c1,t2')]
+                                             let p = scheme (subst s t2)
+                                             (s',qe,f) <- norm (protect p env) (subst s (pe1++pe2))
+                                             let e = f (EAp e2 [e1])
+                                                 (e',p') = qual qe e (subst s' p)
+                                             sc <- gen (tevars env) p'
+                                             w <- newNameMod (modName env) witnessSym
+                                             return ((w,sc), (w,e'))
+                                             
+
+-- Add predicates to the environment and build overlap graph
+addPreds env []                         = return env
+addPreds env (n@(w,p):pe)
+  | isSub' p                            = case findCoercion env a b of
+                                             Just (w',p') -> do 
+                                                r <- implications env p' p
+                                                case r of
+                                                   Equal      -> addPreds (addEqs [(w,w')] env) pe
+                                                   ImplyRight -> addPreds env pe
+                                                   ImplyLeft  -> addPreds env pe    -- Ignore w for now (should really replace w')
+                                                   Unrelated  -> fail (encodeError ambigSubMsg [w,w'])
+                                             Nothing -> do 
+                                                addPreds (insertSubPred n env) pe
+  | isClass' p                          = do r <- cmpNode [] [] (nodes (findClass env c))
+                                             case r of
+
+                                                Right (pre,post) -> addPreds (insertClassPred pre n post env) pe
+                                                Left w'          -> addPreds (addEqs [(w,w')] env) pe
+  where (a,b)                           = subsyms p
+        c                               = headsym p
+
+        cmpNode pre post []             = return (Right (pre,post))
+        cmpNode pre post ((w',p'):pe')  = do r <- implications env p' p
+                                             case r of
+                                                Equal 
+                                                  | isGenerated w || isGenerated w' -> return (Left w')
+                                                  | otherwise                   -> fail (encodeError ambigInstMsg [w,w'])
+                                                ImplyRight -> cmpNode pre (w':post) pe'
+                                                ImplyLeft  -> cmpNode (w':pre) post pe'
+                                                Unrelated  -> cmpNode pre post pe'
+
+
+data Implications                       = Equal | ImplyRight | ImplyLeft | Unrelated
+                                        deriving (Eq,Show)
+
+implications env p1 p2                  = do (R c1,ps1) <- inst p1
+                                             (R c2,ps2) <- inst p2
+                                             r1 <- expose (unify (addKEnv (quant p2) env) [(c1,body p2)])
+                                             r2 <- expose (unify (addKEnv (quant p1) env) [(body p1,c2)])
+                                             case (r1,r2) of
+                                                (Right s, Right _)          -> return Equal
+                                                (Right _, Left _)           -> return ImplyRight
+                                                (Left _, Right _)           -> return ImplyLeft
+                                                (Left _, Left _)            -> return Unrelated
+
+
+
+
+{-
+
+    Ord a |- Ord a
+
+    Ord a \\ a |- Ord Int
+
+    C a \\ a |- D a => C a \\ a
+
+    D a => C a \\ a |- D a => E a => C a \\ a
+
+    a < b |- a < b
+
+    m a < m a \\ a |- m Int < m Int
+
+    m a < n a \\ a, C a |- m a < n a \\ a
+
+
+    x : Eq a
+    y : Eq a
+    ==>
+    eqid x : Eq a
+    eqid y : Eq a
+    ==>
+    eqid x : Eq a |- (eqid x)/y : Eq a
+
+-}
+
+
+
+{-
+          A<A:0  : A :   0:A<A          []
+          B<B:0  : B :   0:B<B       []
+
+   buildAbove 7:A<B,   (a,b)=(A,B), syms = {A}, c = A, adding A<B after A<A to aboveEnv A (0,7)
+
+          0:A<A  : A :   0:A<A,7:A<B
+
+
+   buildBelow 7:A<B,   (a,b)=(A,B), syms = {B}, c = B, adding A<B after B<B to belowEnv B (0,7)
+
+    7:A<B,0:B<B  : B :   0:B<B
+
+   
+
+-}
+
+{-
+
+    Ord a => Ord [a] \\ a
+
+    (b < a) => Ord a < Ord b \\ a,b
+    (b < a) => Ord a < Eq b \\ a,b
+
+    (a < b) => [a] < [b] \\ a,b
+
+    ...
+
+    Ord a, [b] < [a] => Eq [b]
+
+    Ord a, b < a => Eq [b]
+
+    Ord a => Eq [a]
+
+
+    Eq a => Eq [a]
+
+
+    Ord aa, Eq aa, Eq a => Eq [a] \\ a  |-  Eq aa
+    ---------------------------------------------
+    Ord aa, Eq a => Eq [a] \\ a  |-  Eq aa
+    ----------------------------------------
+    Ord aa, Eq a => Eq [a] \\ a  |-  Eq [aa]
+    ---------------------------------------------
+    Eq a => Eq [a] \\ a  |-  Ord a => Eq [a] \\ a
+
+-}
+        
+
+{-
+
+   1: A < A                            x < A   [ A < A, B < A, C < A ]     A < x   [ A < A ]
+
+   2: B < A                            x < B   [ B < B, C < B ]            B < x   [ B < B, B < A ]
+
+3: B < B  4: C < A                     x < C   [ C < C ]                   C < x   [ C < C, C < B, C < A ]
+
+   5: C < B
+
+   6: C < C
+
+(1,2) (1,4) (2,3) (2,4) (3,5) (4,5) (4,6) (5,6)
+
+
+
+Show [a] \\ Show a
+
+Show [C]
+
+w : Eq A
+
+u : Eq B
+
+Eq C
+
+x -> T \\ x < A, Show [x]
+
+x -> T \\ x < A, Eq x
+
+x -> T \\ x < y, y < a
+
+
+
+f : A->T
+eq : Eq a => a->a->Bool
+
+
+ |- w : Eq A         |- id : A->A->Bool < A->A->Bool
+-----------------------------------------------------
+ |- \v.id (v w) : Eq A => A->A->Bool < A->A->Bool
+--------------------------------------------------
+ |- \v.v w : Eq a => a->a->Bool < A->A->Bool
+x:A |- eq : Eq a => a->a->Bool
+--------------------------------
+x:A |- (\v.v w) eq : A->A->Bool              x:A |- x : A
+--------------------------------             ---------------
+x:A |- eq w x x : Bool                       x:A |- f x : T
+-----------------------------------------------------------
+x:A |- if eq w x x then f x else f x : T
+-----------------------------------------------------------
+    |- \x -> if eq w x x then f x else f x : A -> T
+
+
+ |- u : Eq B         |- id : B->B->Bool < B->B->Bool
+----------------------------------------------------
+ |- \v.id (v u) : Eq B => B->B->Bool < B->B->Bool
+--------------------------------------------------
+ |- \v.v u : Eq a => a->a->Bool < B->B->Bool
+x:B |- eq : Eq a => a->a->Bool               x.B |- x : B    |- b : B < A
+------------------------------------         ----------------------------
+x:B |- (\v.v u) eq : B->B->Bool              x:B |- b x : A
+-------------------------------              ---------------
+x:B |- eq u x x : Bool                       x:B |- f (b x) : T
+---------------------------------------------------------------
+x:B |- if eq u x x then f (b x) else f (b x) : T
+---------------------------------------------------------------
+    |- \x -> if eq u x x then f (b x) else f (b x) : B -> T
+
+
+P = k:x<A, j:Eq x
+
+
+P |- j : Eq x       P |- id : x->x->Bool < x->x->Bool
+----------------------------------------------------
+P |- \v.id (v j) : Eq B => x->x->Bool < x->x->Bool
+--------------------------------------------------
+P |- \v.v j : Eq a => a->a->Bool < x->x->Bool
+P | x:x |- eq : Eq a => a->a->Bool              P | x.x |- x : x   P |- k : x < A
+------------------------------------           -----------------------------------
+P | x:x |- (\v.v j) eq : x->x->Bool             P | x:x |- k x : A
+-----------------------------------            ----------------------
+P | x:x |- eq j x x : Bool                      P | x:x |- f (k x) : T
+----------------------------------------------------------------------
+P | x:x |- if eq j x x then f (k x) else f (k x) : T
+---------------------------------------------------------------
+P |  |- \x -> if eq j x x then f (k x) else f (k x) : x -> T
+------------------------------------------------------------------------------------
+  |  |- \k j x -> if eq j x x then f (k x) else f (k x) : (x < A, Eq x) => x -> T
+
+
+
+x < A |- x < A        x < A |- T < T
+------------------------------------
+x < A |- A -> T < x -> T
+--------------------------------
+ |- x < A => (A -> T < x -> T)
+--------------------------------
+ |- A -> T < (x < A => x < T)
+
+
+x < A, Eq x |- x < A        x < A, Eq x |- T < T
+------------------------------------------------
+x < A, Eq x |- A -> T < x -> T
+-------------------------------------
+ |- (x < T, Eq x) => (A -> T < x -> T)
+--------------------------------------
+ |- A -> T < ((x < A, Eq x) => x < T)
+
+
+w : Eq A
+u : Eq B
+c : B < A
+eq : Eq a => a -> a -> Bool
+
+eq w (f b1) (f b2)  ==  eq u b1 b2 ???
+
+
+h . g . f      ==        
+
+
+i2f : Int < Float
+
+neq : Num a => a -> a
+
+ni : Num Int
+nf : Num Float
+
+i2f (neg ni x)     ==       neg nf (i2f x)     ???
+
+
+bind : Monad m => m a -> (a->m b) -> m b
+f : Request Int
+g : Int -> Action
+
+
+Monad m, Request Int < m Int, Action < m b
+
+
+Monad Cmd, Request Int < Cmd Int, Action < Cmd ()
+
+Monad (O s), Request Int < O s Int, Action < O s ()
+
+
+ |- c : Monad m => m a -> (a -> m b) -> m b < Cmd Int -> (Int -> Cmd ()) -> Cmd ()
+ |- bind : Monad m => m a -> (a -> m b) -> m b     
+---------------------------------------------------------------------------------------------------------
+ |- c bind : Cmd Int -> (Int -> Cmd ()) -> Cmd ()
+----------------------------------------------
+ |-> c bind f g : Cmd ()
+
+-}
+
diff --git a/src/Rename.hs b/src/Rename.hs
new file mode 100644
--- /dev/null
+++ b/src/Rename.hs
@@ -0,0 +1,516 @@
+{-# LANGUAGE FlexibleInstances #-}
+
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Rename where
+
+{-
+
+This module does the following:
+  - Checks all binding groups and patterns for duplicates (both types & terms).
+  - Checks all signatures for duplicates and dangling references (kind and type sigs).
+  - Completes all type signatures and constructor definitions with explicit type variable bindings.
+  - Shuffles explicit signatures as close as possible to their binding occurrences (even inside patterns)
+  - Checks that variables bound in generators and equations in commands do not shadow state variables.
+  - Checks that assignments are to declared state variables only.
+  - Resolves proper binding occurrences for all identifier references by setting the unique tag in each Name 
+    identifier, or possibly replacing a Name with a Prim.
+-}
+
+import Monad
+import Common
+import Syntax
+import Depend
+import PP
+import List(sort)
+
+renameM e1 m                       = rename (initEnv e1) m
+                                
+
+-- Syntax traversal environment --------------------------------------------------
+
+data Env                           = Env { rE :: Map Name Name, 
+                                           rT :: Map Name Name, 
+                                           rS :: Map Name Name,
+                                           rL :: Map Name Name,
+                                           self :: [Name],
+                                           void :: [Name]
+                                         } deriving Show
+
+initEnv (rL',rT',rE')              = Env { rE = primTerms ++ rE', rT = primTypes ++ rT', rS = [], rL = primSels ++ rL', self = [], void = [] }
+
+stateVars env                      = dom (rS env)
+
+tscope env                         = dom (rT env)
+
+
+renE env n@(Tuple _ _)             = n
+renE env n@(Prim _ _)              = n
+renE env v                         = case lookup v (rE env) of
+                                       Just n  -> n { annot = (annot v) {suppressMod = suppressMod (annot n)} }
+                                       Nothing -> errorIds "Undefined identifier" [v]
+
+renS env n@(Tuple _ _)             = n
+renS env n@(Prim _ _)              = n
+renS env v                         = case lookup v (rS env) of
+                                       Just n  -> n { annot = a { stateVar = True} }
+                                       Nothing -> errorIds "Undefined state variable" [v]
+  where a                          = annot v
+
+renL env v                         = case lookup v (rL env) of
+                                       Just n  -> n { annot = (annot v){suppressMod = suppressMod (annot n)} }
+                                       Nothing -> errorIds "Undefined selector" [v]
+
+renT env n@(Tuple _ _)             = n
+renT env n@(Prim _ _)              = n
+renT env v                         = case lookup v (rT env) of
+                                       Just n  -> n { annot = (annot v) {suppressMod = suppressMod (annot n)} }
+                                       Nothing -> errorIds "Undefined type identifier" [v]
+
+extRenE env vs
+  | not (null shadowed)            = errorIds "Illegal shadowing of state variables" shadowed
+  | not (null shadowed')           = errorIds "Illegal shadowing of state reference" shadowed'
+  | otherwise                      = do rE' <- renaming (noDups "Duplicate variables" (legalBind vs))
+                                        return (env { rE = rE' ++ rE env })
+  where shadowed                   = intersect vs (stateVars env)
+        shadowed'                  = intersect vs (self env)
+
+
+setRenS env vs
+  | not (null shadowed)            = errorIds "Illegal shadowing of state reference" shadowed
+  | otherwise                      = do rS' <- renaming (noDups "Duplicate state variables" (legalBind vs))
+                                        return (env { rS = rS', void = vs })
+  where shadowed                   = intersect vs (self env)
+
+unvoid vs env                      = env { void = void env \\ vs }
+
+unvoidAll env                      = env { void = [] }
+
+extRenT env vs                     = do rT' <- renaming (noDups "Duplicate type variables" (legalBind vs))
+                                        return (env { rT = rT' ++ rT env })
+
+extRenEMod _ _ env []              = return env
+extRenEMod pub m env vs            = do rE' <- extRenXMod pub m (rE env) vs
+                                        return (env {rE = rE'})
+
+extRenTMod _ _ env []              = return env
+extRenTMod pub m env vs            = do rT' <- extRenXMod pub m (rT env) vs
+                                        return (env {rT = rT'})
+
+extRenLMod _ _ env []              = return env
+extRenLMod pub m env vs            = do rL' <- extRenXMod pub m (rL env) vs
+                                        return (env {rL = rL'})
+
+extRenSelf env s                   = do rE' <- renaming (legalBind [s])
+                                        return (env { rE = rE' ++ rE env, self = [s] })
+
+extRenXMod pub m rX vs             = if pub
+                                      then do rX1 <- renaming (map (qName (str m)) (legalBind vs))
+                                              let rX2 = map suppressPair rX1
+                                              return  (mergeRenamings1 (map dropModFst rX2) rX ++ rX2)
+                                      else do rX' <- renaming (legalBind vs)
+                                              return (mergeRenamings1 rX' rX) 
+  where suppressPair (n1,n2)       = (n1, n2 {annot = (annot n2) {suppressMod = True}}) 
+        dropModFst (n1,n2)         = (dropMod n1,n2)
+
+legalBind vs                        = map checkName vs
+  where checkName v@(Tuple _ _)	    = errorIds "Tuple constructors may not be redefined" [v]
+        checkName v@(Prim _ _)	    = errorIds "Rigid symbol may not be redefined" [v]
+        checkName v
+          | fromMod v == Nothing    = v
+          | otherwise               = errorIds "Binding occurrence may not be qualified" [v]
+
+
+-- Binding of overloaded names ------------------------------------------------------------------------
+
+oloadBinds xs ds                    = f te
+  where te                          = [ (s,t') | DRec True c vs _ sels <- ds, let p = PType (foldl TAp (TCon c) (map TVar vs)),
+                                                 Sig ss t <- sels, s <- ss, s `notElem` xs, let t' = tQual [p] t ]
+        f []                        = []
+        f (sig:te)                  = mkSig sig : mkEqn sig : f te
+        mkSig (s,t)                 = BSig [s] t
+        mkEqn (s,TQual t ps)        = BEqn (LFun s' (w:ws)) (RExp (foldl EAp (ESelect w s') ws))
+          where w:ws                = map EVar (take (length ps) abcSupply)
+                s'                  = annotExplicit s
+
+
+-- Renaming -----------------------------------------------------------------------------------------
+
+class Rename a where
+  rename :: Env -> a -> M s a
+
+instance Rename a => Rename [a] where
+  rename env as                    = mapM (rename env) as
+
+instance Rename a => Rename (Maybe a) where
+  rename env (Just e)              = liftM Just (rename env e)
+  rename env Nothing               = return Nothing
+
+
+instance Rename Module where
+  rename env (Module c is ds ps)   = do assert (null kDups) "Duplicate kind signatures" kDups
+                                        assert (null tDups) "Duplicate type constructors" tDups
+                                        assert (null sDups) "Duplicate selectors" sDups
+                                        assert (null cDups) "Duplicate constructors" cDups
+                                        assert (null wDups) "Duplicate instance declarations" wDups
+                                        assert (null eDups) "Duplicate top-level variable" eDups
+                                        assert (null tcDups) "Duplicate typeclass declaration" tcDups
+                                        assert (null dks)   "Dangling kind signatures" dks
+                                        assert (null dws1)  "Dangling instance declarations" dws1
+                                        assert (null dws2)  "Dangling instance declarations" dws2
+                                        assert (null dtcs1) "Dangling typeclass declarations" dtcs1
+                                        assert (null dtcs2) "Dangling typeclass declarations" dtcs2
+                                        assert (null badImpl) "Illegal type signature for instance" badImpl
+                                        env1 <- extRenTMod True  c env  (ts1 ++ ks1')
+                                        env2 <- extRenEMod True  c env1 (cs1 ++ vs1 ++ vs1' ++ vss++is1)
+                                        env3 <- extRenLMod True  c env2 ss1
+                                        env4 <- extRenTMod False c env3 ((ts2 \\ ks1') ++ ks2)
+                                        env5 <- extRenEMod False c env4 (cs2 ++ (vs2 \\ vss) ++ vs2'++is2)
+                                        env6 <- extRenLMod False c env5 ss2
+                                        ds <- rename env6 (ds1 ++ ps1)
+                                        bs <- rename env6 (bs1' ++ bs2' ++ shuffleB (bs1 ++ bs2))
+                                        return (Module c is (ds ++ map DBind (groupBindsS bs)) [])
+   where (ks1,ts1,ss1,cs1,ws1,tcs1,is1,bss1) = renameD [] [] [] [] [] [] [] [] ds
+         (ks2,ts2,ss2,cs2,ws2,tcs2,is2,bss2) = renameD [] [] [] [] [] [] [] [] ps
+         ds1                       = mergeTClasses tcs1 ds
+         ps1                       = mergeTClasses tcs2 ps
+         vs1                       = concat (map bvars bss1)
+         vs2                       = concat (map bvars bss2)
+         bs1                       = concat (reverse bss1)
+         bs2                       = concat (reverse bss2)
+         vss                       = concat [ ss | BSig ss _ <- bs1 ] \\ vs1
+         vs                        = vs1 ++ vs2
+         ks                        = ks1 ++ ks2
+         ts                        = ts1 ++ ts2
+         ws                        = ws1 ++ ws2
+         bs1'                      = oloadBinds vs ds1
+         bs2'                      = oloadBinds vs ps1
+         vs1'                      = bvars bs1'
+         vs2'                      = bvars bs2'
+         ks1'                      = ks1 \\ ts1
+         dks                       = ks \\ ts
+         dws1                      = ws1 \\ concat [ ss | BSig ss _ <- bs1 ]
+         dws2                      = ws2 \\ concat [ ss | BSig ss _ <- bs2 ]
+         dtcs1                     = tcs1 \\ [ n | DRec False n _ _ _ <- ds ]
+         dtcs2                     = tcs2 \\ [ n | DRec False n _ _ _ <- ps ]
+         badImpl                   = concat [ ws | BSig ss t <- bs1++bs2, not (null (ss `intersect` ws)), isWild t ]
+         kDups                     = duplicates ks
+         tDups                     = duplicates ts
+         sDups                     = duplicates (ss1 ++ ss2)
+         cDups                     = duplicates (cs1 ++ cs2)
+         wDups                     = duplicates ws
+         eDups                     = duplicates vs
+         tcDups                    = duplicates (tcs1++tcs2)
+         isWild (TQual t ps)       = isWild t || any isWild [ t | PType t <- ps ]
+         isWild (TAp t t')         = isWild t || isWild t'
+         isWild (TSub t t')        = isWild t || isWild t'
+         isWild (TList t)          = isWild t
+         isWild (TTup ts)          = any isWild ts
+         isWild (TFun ts t)        = any isWild (t:ts)
+         isWild TWild              = True
+         isWild _                  = False
+         
+mergeTClasses tcs (DRec isC n vs ts ss : ds) = DRec (isC || elem n tcs) n vs ts ss : mergeTClasses tcs ds
+mergeTClasses tcs (DTClass _ : ds) = mergeTClasses tcs ds
+mergeTClasses tcs (DBind _ : ds) = mergeTClasses tcs ds
+mergeTClasses tcs (d : ds) = d : mergeTClasses tcs ds
+mergeTClasses _ [] = []
+
+renameD ks ts ss cs ws tcs is bss (DKSig c k : ds)
+                                   = renameD (c:ks) ts ss cs ws tcs is bss ds
+renameD ks ts ss cs ws tcs is bss (DRec _ c _ _ sigs : ds)
+                                   = renameD ks (c:ts) (sels++ss) cs ws tcs is bss ds
+  where sels                       = concat [ vs | Sig vs t <- sigs ]
+renameD ks ts ss cs ws tcs is bss (DData c _ _ cdefs : ds)
+                                   = renameD ks (c:ts) ss (cons++cs) ws tcs is bss ds
+  where cons                       = [ c | Constr c _ _ <- cdefs ]
+renameD ks ts ss cs ws tcs is bss (DType c _ _ : ds)
+                                   = renameD ks (c:ts) ss cs ws tcs is bss ds
+renameD ks ts ss cs ws tcs is bss (DInstance vs : ds)
+                                   = renameD ks ts ss cs (ws++vs) tcs is bss ds
+renameD ks ts ss cs ws tcs is bss (DTClass vs : ds)
+                                   = renameD ks ts ss cs ws (tcs++vs) is bss ds
+renameD ks ts ss cs ws tcs is bss (DDefault ps : ds)
+                                   = renameD ks ts ss cs ws tcs (is1 ++ is) bss ds
+  where is1                        = [i | Derive i _ <- ps]
+renameD ks ts ss cs ws tcs is bss (DBind bs : ds)
+                                   = renameD ks ts ss cs ws tcs is (bs : bss) ds
+renameD ks ts ss cs ws tcs is bss []
+                                   = (ks, ts, ss, cs, ws, tcs, is, bss)
+
+
+instance Rename Decl where
+  rename env d@(DKSig _ _)         = return d
+  rename env (DData c vs ts cs)    = do env' <- extRenT env vs
+                                        liftM2 (DData (renT env c) (map (renT env') vs)) (renameQTs env' ts) (rename env' cs)
+  rename env (DRec isC c vs ts ss) = do env' <- extRenT env vs
+                                        liftM2 (DRec isC (renT env c) (map (renT env') vs)) (renameQTs env' ts) (rename env' ss)
+  rename env (DType c vs t)        = do env' <- extRenT env vs
+                                        liftM (DType (renT env c) (map (renT env') vs)) (rename env' t)
+  rename env (DInstance vs)        = return (DInstance (map (renE env) vs))
+  rename env (DDefault ts)         = liftM DDefault (rename env ts)
+  rename env (DBind bs)            = liftM DBind (rename env bs)
+
+instance Rename (Default Type) where
+  rename env (Default pub a b)     = return (Default pub (renE env a) (renE env b))
+  rename env (Derive v t)          = liftM (Derive (renE env v)) (renameQT env t)
+
+instance Rename Constr where
+  rename env (Constr c ts ps)      = do env' <- extRenT env (bvars ps')
+                                        liftM2 (Constr (renE env c)) (rename env' ts) (rename env' ps')
+   where ps'                       = completeP env ts ps
+
+completeP env t ps
+  | not (null dups)                = errorIds "Duplicate type variable abstractions" dups
+  | not (null dang)                = errorIds "Dangling type variable abstractions" dang
+  | otherwise                      = ps ++ zipWith PKind implicit (repeat KWild)
+  where vs                         = tyvars t ++ tyvars ps
+        bvs                        = bvars ps
+        dups                       = duplicates bvs
+        dang                       = bvs \\ vs
+        implicit                   = nub vs \\ (tscope env ++ bvs)
+
+
+renameQT env (TQual t ps)          = rename env (TQual t (completeP env t ps))
+renameQT env t
+  | null ps                        = rename env t
+  | otherwise                      = rename env (TQual t ps)
+  where ps                         = completeP env t []
+
+
+renameQTs env ts                   = mapM (renameQT env) ts
+
+
+instance Rename Sig where
+  rename env (Sig vs t)            = liftM (Sig (map (renL env) vs)) (renameQT env t)
+
+instance Rename Pred where
+  rename env (PType p)             = liftM PType (rename env p)
+  rename env (PKind v k)           = return (PKind (renT env v) k)
+
+instance Rename Type where
+  rename env (TQual t ps)          = do env' <- extRenT env (bvars ps)
+                                        liftM2 TQual (rename env' t) (rename env' ps)
+  rename env (TCon c)              = return (TCon (renT env c))
+  rename env (TVar v)              = return (TVar (renT env v))
+  rename env (TAp t1 t2)           = liftM2 TAp (rename env t1) (rename env t2)
+  rename env (TSub t1 t2)          = liftM2 TSub (rename env t1) (rename env t2)
+  rename env TWild                 = return TWild
+  rename env (TList ts)            = liftM TList (rename env ts)
+  rename env (TTup ts)             = liftM TTup (rename env ts)
+  rename env (TFun t1 t2)          = liftM2 TFun (rename env t1) (rename env t2)
+
+instance Rename Bind where
+  rename env (BEqn (LFun v ps) rh) = do env' <- extRenE env (pvars ps)
+                                        ps' <- rename env' ps
+                                        liftM (BEqn (LFun (renE env v) ps')) (rename env' rh)
+  rename env (BEqn (LPat p) rh)    = do p' <- rename env p
+                                        liftM (BEqn (LPat p')) (rename env rh)
+  rename env (BSig vs t)           = liftM (BSig (map (renE env) vs)) (renameQT env t)
+
+instance Rename Exp where
+  rename env (EVar v)
+    | v `elem` void env            = errorIds"Uninitialized state variable" [v]
+    | v `elem` stateVars env       = return (EVar (renS env v))
+    | otherwise                    = return (EVar (renE env v))
+  rename env (ECon c)              = return (ECon (renE env c))
+  rename env (ESel l)              = return (ESel (renL env l))
+  rename env (EAp e1 e2)           = liftM2 EAp (rename env e1) (rename env e2)
+  rename env (ELit l)              = return (ELit l)
+  rename env (ETup ps)             = liftM ETup (rename env ps)
+  rename env (EList es)            = liftM EList (rename env es)
+  rename env EWild                 = return EWild
+  rename env (ESig e t)            = liftM2 ESig (rename env e) (renameQT env t)
+  rename env (ERec m fs)           = liftM (ERec (renRec env m)) (rename env fs)
+  rename env (ELam ps e)           = do env' <- extRenE env (pvars ps)
+                                        liftM2 ELam (rename env' ps) (rename env' e)
+  rename env (ELet bs e)           = do env' <- extRenE env (bvars bs)
+                                        bs' <- rename env' (shuffleB bs)
+                                        e' <- rename env' e
+                                        return (foldr ELet e' (groupBindsS bs'))
+  rename env (ECase e as)          = liftM2 ECase (rename env e) (rename env as)
+  rename env (EIf e1 e2 e3)        = liftM3 EIf (rename env e1) (rename env e2) (rename env e3)
+  rename env (ENeg e)              = liftM ENeg (rename env e)
+  rename env (ESeq e1 e2 e3)       = liftM3 ESeq (rename env e1) (rename env e2) (rename env e3)
+  rename env (EComp e qs)          = do (qs,e) <- renameQ env qs e
+                                        return (EComp e qs)
+  rename env (ESectR e op)         = liftM (flip ESectR (renE env op)) (rename env e) 
+  rename env (ESectL op e)         = liftM (ESectL (renE env op)) (rename env e)
+  rename env (ESelect e l)         = liftM (flip ESelect (renL env l)) (rename env e) 
+  rename env (EAct v ss)           = liftM (EAct (fmap (renE env) v)) (renameS (unvoidAll env) (shuffleS ss))
+  rename env (EReq v ss)           = liftM (EReq (fmap (renE env) v)) (renameS (unvoidAll env) (shuffleS ss))
+  rename env (EDo (Just v) Nothing ss)
+                                   = do env1 <- extRenSelf env v
+                                        liftM (EDo (Just (renE env1 v)) Nothing) (renameS (unvoidAll env1) (shuffleS ss))
+  rename env (ETempl (Just v) Nothing ss)
+                                   = do env1 <- extRenSelf env v
+                                        env2 <- setRenS env1 st
+                                        liftM (ETempl (Just (renE env2 v)) Nothing) (renameS env2 (shuffleS ss))
+    where st                       = assignedVars ss
+  rename env (EAfter e1 e2)        = liftM2 EAfter (rename env e1) (rename env e2)
+  rename env (EBefore e1 e2)       = liftM2 EBefore (rename env e1) (rename env e2)
+  rename env e@(EBStruct (Just c) ls bs)
+                                   = do let ls' = map (dropMod . annotGenerated) ls
+                                        env' <- extRenE env ls' 
+                                        r <- rename env' (ERec (Just (c,True)) (map (\(s,s') -> Field s (EVar s')) (ls `zip` ls')))
+                                        bs' <- mapM (renSBind env' env) bs
+                                        return (foldr ELet r (groupBindsS bs'))
+
+renRec env (Just (n, t))           = Just (renT env n, t)
+renRec env Nothing                 = Nothing
+
+renSBind envL envR (BEqn (LFun v ps) rh)    = do envR' <- extRenE envR (pvars ps)
+                                                 ps'   <- rename envR' ps
+                                                 liftM (BEqn (LFun (annotGenerated (renE envL v)) ps')) (rename envR' rh)
+renSBind envL envR (BEqn (LPat (EVar v)) rh)= liftM (BEqn (LPat (EVar (annotGenerated (renE envL v))))) (rename envR rh)
+renSBind _ _ (BEqn (LPat p) _)              = errorTree "Illegal pattern in struct value" p 
+renSBind _ _ s@(BSig vs t)                  = errorTree "Signature in struct value" s 
+
+instance Rename Field where
+  rename env (Field l e)           = liftM (Field (renL env l)) (rename env e)
+
+instance Rename (Rhs Exp) where
+  rename env (RExp e)              = liftM RExp (rename env e)
+  rename env (RGrd gs)             = liftM RGrd (rename env gs)
+  rename env (RWhere e bs)         = do env' <- extRenE env (bvars bs)
+                                        bs' <- rename env' (shuffleB bs)
+                                        e' <- rename env' e
+                                        return (foldr (flip RWhere) e' (groupBindsS bs'))
+
+
+instance Rename (GExp Exp) where
+  rename env (GExp qs e)           = do (qs,e) <- renameQ env qs e
+                                        return (GExp qs e)
+
+
+renameQ env [] e0                  = do e0 <- rename env e0
+                                        return ([], e0)
+renameQ env (QExp e : qs) e0       = do e <- rename env e
+                                        (qs,e0) <- renameQ env qs e0
+                                        return (QExp e : qs, e0)
+renameQ env (QGen p e : qs) e0     = do e <- rename env e
+                                        env' <- extRenE env (pvars p)
+                                        p <- rename env' p
+                                        (qs,e0) <- renameQ env' qs e0
+                                        return (QGen p e : qs, e0)
+renameQ env (QLet bs : qs) e0      = do env' <- extRenE env (bvars bs)
+                                        bs <- rename env' bs
+                                        (qs,e0) <- renameQ env' qs e0
+                                        return (map QLet (groupBindsS bs) ++ qs, e0)
+
+
+instance Rename (Alt Exp) where
+  rename env (Alt  p rh)           = do env' <- extRenE env (pvars p)
+                                        liftM2 Alt (rename env' p) (rename env' rh) 
+
+
+renameS env []                     = return []
+renameS env [SRet e]               = liftM (:[]) (liftM SRet (rename env e))
+renameS env (SExp e : ss)          = liftM2 (:) (liftM SExp (rename env e)) (renameS env ss)
+renameS env (SGen p e : ss)        = do env' <- extRenE env (pvars p)
+                                        liftM2 (:) (liftM2 SGen (rename env' p) (rename env e)) (renameS env' ss)
+renameS env (SBind bs : ss)        = do env' <- extRenE env (bvars bs)
+                                        bs' <- rename env' bs
+                                        ss' <- renameS env' ss
+                                        return (map SBind (groupBindsS bs') ++ ss')
+renameS env (SAss p e : ss)
+  | not (null illegal)             = errorIds "Unknown state variables" illegal
+  | otherwise                      = liftM2 (:) (liftM2 SAss (rename (unvoidAll env) p) (rename env e)) (renameS (unvoid (pvars p) env) ss)
+  where illegal                    = pvars p \\ stateVars env
+
+
+
+-- Signature shuffling -------------------------------------------------------------------------
+
+shuffleB bs                        = shuffle [] bs
+
+
+shuffle [] []                      = []
+shuffle sigs []                    = errorIds "Dangling type signatures" (dom sigs)
+shuffle sigs (BSig vs t : bs)
+  | not (null s_dups)              = errorIds "Duplicate type signatures" s_dups
+  | otherwise                      = shuffle (vs `zip` repeat t ++ sigs) bs
+  where s_dups                     = duplicates vs ++ (vs `intersect` dom sigs)
+shuffle sigs (b@(BEqn (LFun v _) _) : bs)
+                                   = case lookup v sigs of
+                                       Just t  -> BSig [v] t : b : shuffle (prune sigs [v]) bs
+                                       Nothing -> b : shuffle sigs bs
+shuffle sigs (BEqn (LPat p) rh : bs)
+                                   = BEqn (LPat p') rh : shuffle sigs' bs
+  where (sigs',p')                 = attach sigs p
+
+
+
+shuffleS ss                        = shuffle' [] ss
+
+shuffle' [] []                     = []
+shuffle' sigs []                   = errorIds "Dangling type signatures for" (dom sigs)
+shuffle' sigs (SBind bs : ss)      = SBind (shuffle sigs1 bs1) : shuffle' ([ (v,t) | BSig [v] t <- bs2 ] ++ sigs2) ss
+  where (sigs1,sigs2)              = partition ((`elem` vs) . fst) sigs
+        (bs1,bs2)                  = partition local (concatMap flat bs)
+        vs                         = bvars bs
+        local (BSig [v] _)         = v `elem` vs
+        local _                    = True
+        flat (BSig vs t)           = [ BSig [v] t | v <- vs ]
+        flat b                     = [b]
+shuffle' sigs (SGen p e : ss)      = SGen p' e : shuffle' sigs' ss
+  where (sigs',p')                 = attach sigs p
+shuffle' sigs (SAss p e : ss)      = SAss p' e : shuffle' sigs2 ss
+  where (sigs',p')                 = attach sigs1 p
+        (sigs1,sigs2)              = partition ((`elem` vs) . fst) sigs
+        vs                         = evars p
+shuffle' sigs (s : ss)             = s : shuffle' sigs ss
+
+
+
+attach sigs e@(ESig (EVar v) t)
+  | v `elem` dom sigs              = errorIds "Conflicting signatures for" [v]
+  | otherwise                      = (sigs, e)
+attach sigs (EVar v)               = case lookup v sigs of
+                                       Nothing -> (sigs, EVar v)
+                                       Just t  -> (prune sigs [v], ESig (EVar v) t)
+attach sigs (EAp p1 p2)            = (sigs2, EAp p1' p2')
+  where (sigs1,p1')                = attach sigs p1
+        (sigs2,p2')                = attach sigs1 p2
+attach sigs (ETup ps)              = (sigs', ETup ps')
+  where (sigs',ps')                = attachList sigs ps
+attach sigs (EList ps)             = (sigs', EList ps')
+  where (sigs',ps')                = attachList sigs ps
+attach sigs p                      = (sigs, p)
+
+attachList sigs []                 = (sigs, [])
+attachList sigs (p:ps)             = (sigs2, p':ps')
+  where (sigs1,p')                 = attach sigs p
+        (sigs2,ps')                = attachList sigs1 ps
+
diff --git a/src/Syntax.hs b/src/Syntax.hs
new file mode 100644
--- /dev/null
+++ b/src/Syntax.hs
@@ -0,0 +1,1051 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
+
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Syntax where
+
+import Common
+import Lexer
+import PP
+import Data.Binary
+
+data Module = Module Name [Import] [Decl] [Decl]
+            deriving  (Show)
+
+data Import = Import Bool Name 
+            deriving (Show)
+            
+data Decl   = DKSig   Name Kind
+            | DData   Name [Name] [Type] [Constr]
+            | DRec    Bool Name [Name] [Type] [Sig]
+            | DType   Name [Name] Type   -- removed by desugaring
+--            | DInst   Type [Bind]        --          -"-
+            | DPSig   Name Type 
+            | DDefault [Default Type]  
+            | DInstance [Name]
+            | DTClass [Name]
+            | DBind   [Bind]
+            deriving  (Eq,Show)
+
+data Constr =  Constr Name [Type] [Pred]
+            deriving (Eq,Show)
+
+data Sig    = Sig [Name] Type
+            deriving (Eq,Show)
+
+data Bind   = BSig    [Name] Type
+            | BEqn    Lhs (Rhs Exp)
+            deriving  (Eq,Show)
+
+
+type Eqn    = (Lhs, Rhs Exp)
+
+data Type   = TQual   Type [Pred]
+            | TCon    Name
+            | TVar    Name
+            | TAp     Type Type
+            | TSub    Type Type
+            | TWild
+            | TList   Type
+            | TTup    [Type]
+            | TFun    [Type] Type
+            deriving  (Eq,Show)
+
+data Pred   = PType Type
+            | PKind   Name Kind
+            deriving (Eq,Show)
+            
+data Lhs    = LFun Name [Pat]
+            | LPat Pat
+            deriving (Eq,Show)
+
+type Pat    = Exp
+
+data Exp    = EVar    Name
+            | EAp     Exp Exp
+            | ECon    Name
+            | ESel    Name
+            | ELit    Lit
+            | ETup    [Exp]
+            | EList   [Exp]
+            | EWild
+            | ESig    Exp Type
+            | ERec    (Maybe (Name,Bool)) [Field]
+            -- pattern syntax ends here
+            | EBStruct (Maybe Name) [Name] [Bind]  -- struct value in bindlist syntax
+            | ELam    [Pat] Exp
+            | ELet    [Bind] Exp
+            | ECase   Exp [Alt Exp]
+-- the following and ETup, EList removed in desugaring
+            | EIf     Exp Exp Exp
+            | ENeg    Exp
+            | ESeq    Exp (Maybe Exp) Exp
+            | EComp   Exp [Qual]
+            | ESectR  Exp Name
+            | ESectL  Name Exp
+            | ESelect Exp Name
+            | EDo     (Maybe Name) (Maybe Type) [Stmt] 
+            | ETempl  (Maybe Name) (Maybe Type) [Stmt]
+            | EAct    (Maybe Name) [Stmt] 
+            | EReq    (Maybe Name) [Stmt] 
+            | EAfter  Exp Exp
+            | EBefore Exp Exp
+            deriving  (Eq,Show)
+
+data Field  = Field   Name Exp
+            deriving (Eq,Show)
+    
+data Rhs a  = RExp    a
+            | RGrd    [GExp a]
+            | RWhere  (Rhs a) [Bind]
+            deriving  (Eq,Show)
+
+data GExp a = GExp    [Qual] a
+            deriving (Eq,Show)
+            
+data Alt a  = Alt     Pat (Rhs a)
+            deriving  (Eq,Show)
+
+data Qual   = QExp    Exp
+            | QGen    Pat Exp
+            | QLet    [Bind]
+            deriving  (Eq,Show)
+            
+data Stmt   = SExp    Exp
+            | SRet    Exp
+            | SGen    Pat Exp
+            | SBind   [Bind]
+            | SAss    Pat Exp
+            | SForall [Qual] [Stmt]
+            | SWhile  Exp [Stmt]
+            | SIf     Exp [Stmt]
+            | SElsif  Exp [Stmt]
+            | SElse   [Stmt]
+            | SCase   Exp [Alt [Stmt]]
+            deriving  (Eq,Show)
+
+
+-- Primitives ----------------------------------------------------------------
+
+cons x xs                       = EAp (EAp (ECon (prim CONS)) x) xs
+nil                             = ECon (prim NIL)
+true                            = ECon (prim TRUE)
+false                           = ECon (prim FALSE)
+
+
+-- Helper functions ----------------------------------------------------------------
+
+imports c is 
+      | str c == "Prelude"      = []
+      | otherwise               = Import True (name0 "Prelude") : is
+
+mkModule c (is,ds,ps)           = Module c (imports c is) ds ps
+
+newEVarPos v p                  = do i <- newNamePos v p
+                                     return (EVar i)
+
+op2exp c                        = if isCon c then ECon c else EVar c
+
+isEVar (EVar _)                 = True
+isEVar (EWild)                  = True
+isEVar _                        = False
+
+isEConApp (EAp e es)            = isEConApp e
+isEConApp (ECon _)              = True
+isEConApp _                     = False
+
+isELit (ELit _)                 = True
+isELit _                        = False
+
+isERec (ERec _ _)               = True
+isERec _                        = False
+
+isESigVar (ESig e _)            = isEVar e
+isESigVar e                     = isEVar e
+
+isETup (ETup _)                 = True
+isETup _                        = False
+
+isSAss (SAss _ _)               = True
+isSAss _                        = False
+
+isSGen (SGen _ _)               = True
+isSGen _                        = False
+
+isSBind (SBind _)               = True
+isSBind _                       = False
+
+isDBind (DBind _)               = True
+isDBind _                       = False
+
+isBSig (BSig _ _)               = True
+isBSig _                        = False
+
+isPKind (PKind _ _)             = True
+isPKind _                       = False
+
+tAp isDType (DType _ _ _)       = True
+isDType _                       = False
+
+isLPatEqn (BEqn (LPat _) _)     = True
+isLPatEqn _                     = False
+
+tupSize (ETup es)               = length es
+tupSize _                       = -1
+
+
+eFlat e                         = flat e []
+  where flat (EAp e e') es      = flat e (e':es)
+        flat e es               = (e,es)
+
+eLam [] e                       = e
+eLam ps (ELam ps' e)            = ELam (ps++ps') e
+eLam ps e                       = ELam ps e
+
+rAp (RExp e) es                 = RExp (foldl EAp e es)
+rAp (RWhere rhs bs) es          = RWhere (rAp rhs es) bs
+rAp (RGrd gs) es                = RGrd [ GExp qs (foldl EAp e es) | GExp qs e <- gs ]
+
+
+eLet [] e                       = e
+eLet bs e                       = ELet bs e
+
+
+simpleEqn x e                   = BEqn (LFun x []) (RExp e)
+
+
+exp2lhs e                       = case eFlat e of
+                                       (EVar v, ps)
+                                         |not(null ps) -> LFun v ps
+                                       _               -> LPat e
+
+tFun [] t                       = t
+tFun ts t                       = TFun ts t
+
+tQual ps (TQual t ps')          = TQual t (ps++ps')
+tQual ps t                      = TQual t ps
+
+tFlat t                         = flat t []
+  where flat (TAp t1 t2) ts     = flat t1 (t2:ts)
+        flat t ts               = (t,ts)
+
+
+type2cons (TQual t ps)          = type2cons t
+type2cons t                     = case tFlat t of
+                                    (TCon c,ts) -> Constr c ts []
+                                    _           -> errorTree "Bad type constructor in" t
+
+type2head (TQual t ps)          = type2head t
+type2head t                     = case tFlat t of
+                                    (TCon c,ts) -> c
+                                    _           -> errorTree "Bad instance head in" t
+
+stripSigs (ESig p _)            = p
+stripSigs p                     = p
+
+
+tyCons :: Type -> [Name]
+tyCons (TQual t ps)             = nub (tyCons t ++ concatMap tC ps)
+   where tC (PType t)           = tyCons t
+         tC _                   = []
+tyCons (TCon c)                 = [c]
+tyCons (TVar _)                 = []
+tyCons (TAp t1 t2)              = nub (tyCons t1 ++ tyCons t2)
+tyCons (TSub t1 t2)             = nub (tyCons t1 ++ tyCons t2)
+tyCons TWild                    = []
+tyCons (TList t)                = tyCons t
+tyCons (TTup ts)                = nub (concatMap tyCons ts)
+tyCons (TFun ts t)              = nub (concatMap tyCons (t : ts))
+
+-- Substitution --------------------------------------------------------------
+
+instance Subst Bind Name Exp where
+    subst s (BSig xs t)         = BSig xs t
+    subst s (BEqn lhs rhs)      = BEqn lhs (subst s rhs)
+
+
+instance Subst Exp Name Exp where
+    subst s (EVar x)            = case lookup x s of
+                                    Just e  -> e
+                                    Nothing -> EVar x
+    subst s (EAp e e')          = EAp (subst s e) (subst s e')
+    subst s (ECon c)            = ECon c
+    subst s (ELit l)            = ELit l
+    subst s (ETup es)           = ETup (subst s es)
+    subst s (EList es)          = EList (subst s es)
+    subst s (EWild)             = EWild
+    subst s (ESig e t)          = ESig (subst s e) t
+    subst s (ELam ps e)         = ELam ps (subst s e)
+    subst s (ELet bs e)         = ELet (subst s bs) (subst s e)
+    subst s (ECase e alts)      = ECase (subst s e) (subst s alts)
+    subst s (ERec m fs)         = ERec m (subst s fs)
+    subst s (EBStruct c ls bs)  = EBStruct c ls (subst s bs)
+    subst s (EIf e1 e2 e3)      = EIf (subst s e1) (subst s e2) (subst s e3)
+    subst s (ENeg e)            = ENeg (subst s e)
+    subst s (ESeq e1 Nothing e2)  = ESeq (subst s e1) Nothing (subst s e2)
+    subst s (ESeq e1 (Just e) e2) = ESeq (subst s e1) (Just (subst s e)) (subst s e2)
+    subst s (EComp e qs)        = EComp (subst s e) (subst s qs)
+    subst s (ESectR e op)       = ESectR (subst s e) op
+    subst s (ESectL op e)       = ESectL op (subst s e)
+    subst s (ESelect e l)       = ESelect (subst s e) l
+    subst s (ESel l)            = ESel l
+    subst s (EDo v t st)        = EDo v t (subst s st)
+    subst s (ETempl v t st)     = ETempl v t (subst s st) 
+    subst s (EAct v st)         = EAct v (subst s st)
+    subst s (EReq v st)         = EReq v (subst s st)
+    subst s (EAfter e e')       = EAfter (subst s e) (subst s e')
+    subst s (EBefore e e')      = EBefore (subst s e) (subst s e')
+
+
+instance Subst Field Name Exp where
+    subst s (Field l e)         = Field l (subst s e)
+
+
+instance Subst a Name Exp => Subst (Rhs a) Name Exp where
+    subst s (RExp e)            = RExp (subst s e)
+    subst s (RGrd gs)           = RGrd (subst s gs)
+    subst s (RWhere rhs bs)     = RWhere (subst s rhs) (subst s bs)
+
+
+instance Subst a Name Exp => Subst (GExp a) Name Exp where
+    subst s (GExp qs e)         = GExp (subst s qs) (subst s e)
+
+            
+instance Subst a Name Exp => Subst (Alt a) Name Exp where
+    subst s (Alt p rhs)         = Alt p (subst s rhs)
+
+
+instance Subst Qual Name Exp where
+    subst s (QExp e)            = QExp (subst s e)
+    subst s (QGen p e)          = QGen p (subst s e)
+    subst s (QLet bs)           = QLet (subst s bs)
+
+
+            
+instance Subst Stmt Name Exp where
+    subst s (SExp e)            = SExp (subst s e)
+    subst s (SRet e)            = SRet (subst s e)
+    subst s (SGen p e)          = SGen p (subst s e)
+    subst s (SBind bs)          = SBind (subst s bs)
+    subst s (SAss p e)          = SAss p (subst s e)
+    subst s (SForall qs st)     = SForall (subst s qs) (subst s st)
+    subst s (SWhile e st)       = SWhile (subst s e) (subst s st)
+    subst s (SIf e st)          = SIf (subst s e) (subst s st)
+    subst s (SElsif e st)       = SElsif (subst s e) (subst s st)
+    subst s (SElse st)          = SElse (subst s st)
+    subst s (SCase e alts)      = SCase (subst s e) (subst s alts)
+
+
+instance Subst Type Name Type where
+    subst s (TQual t ps)        = TQual (subst s t) (subst s ps)
+    subst s (TCon c)            = TCon c
+    subst s (TVar a)            = case lookup a s of
+                                    Just t  -> t
+                                    Nothing -> TVar a
+    subst s (TAp t1 t2)         = TAp (subst s t1) (subst s t2)
+    subst s (TSub t1 t2)        = TSub (subst s t1) (subst s t2)
+    subst s TWild               = TWild
+    subst s (TList t)           = TList (subst s t)
+    subst s (TTup ts)           = TTup (subst s ts)
+    subst s (TFun ts t)         = TFun (subst s ts) (subst s t)
+
+instance Subst Pred Name Type where
+    subst s (PType t)           = PType (subst s t)
+    subst s p                   = p
+
+-- Printing ==================================================================
+
+-- Modules -------------------------------------------------------------------
+
+instance Pr Module where
+    pr (Module c is ds ps)      = text "module" <+> prId c <+> text "where"
+                                  $$ vpr is $$ vpr ds 
+                                  $$ text "private" $$ vpr ps
+
+instance Pr Import where
+   pr (Import True n)           = text "import" <+> prId n
+   pr (Import False n)          = text "use" <+> prId n
+
+-- Declarations --------------------------------------------------------------
+
+instance Pr Decl where
+    pr (DKSig c k)              = prId c <+> text "::" <+> pr k
+    pr (DType c vs t)           = text "type" <+> prId c <+> hsep (map prId vs) 
+                                  <+> equals <+> pr t
+    pr (DData c vs subs cs)     = text "data" <+> prId c <+> hsep (map prId vs) 
+                                  <+> prSubs subs <+> prCons cs
+    pr (DRec isC c vs sups ss)  = text kwd <+> prId c <+> hsep (map prId vs) 
+                                  <+> prSups sups <+> prEq ss $$ prSigs ss
+      where kwd                 = if isC then "typeclass " else "struct"
+--    pr (DInst t bs)             = text "instance" <+> pr t <+> text "=" $$ nest 4 (vpr bs)
+    pr (DPSig v t)              = text "typeclass" <+> prId v <+> text "::" <+> pr t
+    pr (DDefault ts)            = text "default" <+> hpr ',' ts
+    pr (DInstance ns)           = text "instance" <+> hpr ',' ns 
+    pr (DTClass ns)             = text "typeclass" <+> hpr ',' ns 
+    pr (DBind bs)               = vpr bs
+
+prPreds []                      = empty
+prPreds ps                      = text " \\\\" <+> hpr ',' ps
+
+prEq []                         = empty
+prEq bs                         = text "where"
+
+prSigs ss                       = nest 4 (vpr ss)
+
+-- Sub/supertypes -----------------------------------------------------------
+
+prSups []                       = empty
+prSups ts                       = char '<' <+> hpr ',' ts
+
+prSubs []                       = empty
+prSubs ts                       = char '>' <+> hpr ',' ts
+    
+
+-- Constructors and contexts -----------------------------------------------
+
+
+instance Pr Constr where
+  pr (Constr c ts ps)           = prId c <+> hsep (map (prn 3) ts) <> prPreds ps
+
+prCons []                       = empty
+prCons (c:cs)                   = vcat (char '=' <+> pr c : map ((char '|' <+>) . pr) cs)
+
+
+
+-- Signatures ------------------------------------------------------------
+
+instance Pr Sig where
+    pr (Sig vs qt)              = hcat (punctuate comma (map prId vs)) <+> text "::" <+> pr qt
+    
+    
+-- Predicates ------------------------------------------------------------
+
+instance Pr Pred where
+    pr (PType t)                = pr t
+    pr (PKind v k)              = prId v <+> text "::" <+> pr k
+
+-- Left hand sides ------------------------------------------------------
+
+instance Pr Lhs where
+   pr (LFun v ps)               = prId v <+> hsep (map (prn 13) ps)
+   pr (LPat p)                  = pr p
+
+{-
+-- Patterns --------------------------------------------------------------
+
+instance Pr Pat where
+
+    prn 0 (PCon c ps)           = prId c <+> hsep (map (prn 13) ps) 
+    prn 0 p                     = prn 13 p
+
+    prn 13 (PVar v)             = prId v
+    prn 13 (PLit l)             = pr l
+    prn 13 (PTup ps)            = parens (hpr ',' ps)
+    prn 13 (PList ps)           = brackets (hpr ',' ps)
+    prn 13 p                    = parens (pr p)
+
+    prn n p                     = prn 13 p
+-}
+
+-- Types -----------------------------------------------------------------
+
+instance Pr Type where
+    prn 0 (TQual t ps)          = prn 1 t <> prPreds ps
+    prn 0 t                     = prn 1 t
+
+    prn 1 (TFun ts t)           = prArgs ts <+> prn 2 t
+      where prArgs []           = empty
+            prArgs (t:ts)       = prn 2 t <+> text "->" <+> prArgs ts
+    prn 1 (TSub t t')           = prn 2 t <+> text "<" <+> prn 2 t'
+    prn 1 t                     = prn 2 t
+
+    prn 2 (TAp t t')            = prn 2 t <+> prn 3 t'
+    prn 2 t                     = prn 3 t
+        
+    prn 3 (TCon c)              = prId c
+    prn 3 (TVar v)              = prId v
+    prn 3 (TWild)               = text "_"
+    prn 3 (TList t)             = brackets (pr t)
+    prn 3 (TTup ts)             = parens (hpr ',' ts)
+    prn 3 t                     = parens (prn 0 t)
+
+-- Bindings ----------------------------------------------------------------
+
+instance Pr Bind where
+    pr (BSig vs qt)             = hcat (punctuate comma (map prId vs)) <+> text "::" <+> pr qt
+    pr (BEqn p (RExp e))        = pr p <+> equals <+> pr e
+    pr (BEqn p rhs)             = pr p $$ nest 2 (prRhs equals rhs)
+
+prRhs eq (RExp e)               = eq <+> pr e
+prRhs eq (RGrd gs)              = vcat (map (prGuard eq) gs)
+prRhs eq (RWhere rhs bs)        = prRhs eq rhs $$ text "where" $$ nest 4 (vpr bs)
+
+prGuard eq (GExp qs e)          = char '|' <+> hpr ',' qs <+> eq <+> pr e
+
+
+-- Expressions -------------------------------------------------------------
+
+instance Pr Exp where
+    prn 0 (ELam ps e)           = sep [char '\\' <> hsep (map (prn 13) ps) <+> text "->", pr e]
+    prn 0 (ELet bs e)           = text "let" <+> vpr bs $$ text "in" <+> pr e
+    prn 0 (EIf e e1 e2)         = text "if" <+> pr e $$
+                                    nest 3 (text "then" <+> pr e1 $$
+                                            text "else" <+> pr e2)
+    prn 0 (ECase e alts)        = text "case" <+> pr e <+> text "of" $$ nest 2 (vpr alts)
+    prn 0 (EDo v t ss)          = text "do"<>prN v <+> vpr ss 
+    prn 0 (ETempl v t ss)       = text "class"<>prN v $$ nest 4 (vpr ss)
+    prn 0 (EAct v ss)           = text "action"<>prN v $$ nest 4 (vpr ss) 
+    prn 0 (EReq v ss)           = text "request"<>prN v $$ nest 4 (vpr ss) 
+    prn 0 (EAfter e e')         = text "after" <+> prn 12 e <+> pr e'
+    prn 0 (EBefore e e')        = text "before" <+> prn 12 e <+> pr e'
+    prn 0 e                     = prn 1 e
+
+    prn 11 (EAp e e')           = prn 11 e <+> prn 12 e'
+    prn 11 e                    = prn 12 e
+        
+    prn 12 (ESelect e l)        = prn 12 e <> text "." <> prId l
+    prn 12 e                    = prn 13 e
+        
+    prn 13 (EVar v)             = prId v
+    prn 13 (ECon c)             = prId c
+    prn 13 (ESel l)             = parens (text "." <> prId l)
+    prn 13 (EWild)              = text "_"
+    prn 13 (ELit l)             = pr l
+    prn 13 (ERec Nothing fs)    = text "{" <+> hpr ',' fs <+> text "}"
+    prn 13 (ERec (Just(c,b)) fs)= prId c <+> text "{" <+> hpr ',' fs <+> (if b then empty else text "..") <+> text "}"
+    prn 13 (EBStruct _ _ bs)    = text "struct" $$ nest 4 (vpr bs)
+    prn 13 (ENeg e)             = text "-" <+> prn 0 e
+    prn 13 (ESig e qt)          = parens (pr e <+> text "::" <+> pr qt)
+    prn 13 (ETup es)            = parens (hpr ',' es)
+    prn 13 (ESectR e op)        = parens (pr e <> prOp op)
+    prn 13 (ESectL op e)        = parens (prOp op <> pr e)
+    prn 13 (EList es)           = brackets (hpr ',' es)
+    prn 13 (ESeq e Nothing to) 
+                                = brackets (pr e <> text ".." <> pr to)
+    prn 13 (ESeq e (Just by) to) 
+                                = brackets (pr e <> comma <> pr by <> text ".." <> pr to)
+    prn 13 (EComp e qs)         = brackets (empty <+> pr e <+> char '|' <+> hpr ',' qs)
+    prn 13 e                    = parens (prn 0 e)
+
+    prn n e                     = prn 11 e
+   
+prN (Just v) = text "@" <> pr v
+prN Nothing = empty 
+instance Pr Field where
+    pr (Field l e)              = prId l <+> equals <+> pr e
+    
+instance Pr a => Pr (Alt a) where
+    pr (Alt p (RExp e))         = pr p <+> text "->" <+> pr e
+    pr (Alt p rhs)              = pr p <+> prRhs (text "->") rhs
+
+instance Pr Qual where
+    pr (QExp e)                 = pr e
+    pr (QGen p e)               = pr p <+> text "<-" <+> pr e
+    pr (QLet bs)                = text "let" <+> hpr ';' bs
+
+-- Statements --------------------------------------------------------------
+
+instance Pr [Stmt] where
+    pr ss                       = vpr ss
+
+instance Pr Stmt where
+    pr (SExp e)                 = pr e
+    pr (SRet e)                 = text "result" <+> pr e
+    pr (SGen p e)               = pr p <+> text "<-" <+> pr e
+    pr (SBind bs)               = vpr bs
+    pr (SAss p e)               = pr p <+> text ":=" <+> pr e
+    pr (SIf e ss)               = text "if" <+> pr e <+> text "then" $$ nest 4 (pr ss)
+    pr (SElsif e ss)            = text "elsif" <+> pr e <+> text "then" $$ nest 4 (pr ss)
+    pr (SElse ss)               = text "else" $$ nest 4 (pr ss)
+    pr (SWhile e ss)            = text "while" <+> pr e <+> text "do" $$ nest 4 (pr ss)
+    pr (SForall qs ss)          = text "forall" <+> hpr ',' qs <+> text "do" $$ nest 4 (pr ss)
+    pr (SCase e alts)           = text "case" <+> pr e <+> text "of" $$ nest 4 (vpr alts)
+
+
+-- Free variables ------------------------------------------------------------
+
+instance Ids Bind where
+    idents (BEqn (LFun v ps) rh)= idents rh \\ (v : idents ps)
+    idents (BEqn (LPat p) rh)   = idents rh \\ idents p 
+    idents (BSig _ _)           = []
+
+instance Ids Exp where
+    idents (EVar v)             = [v]
+    idents (EAp e e')           = idents e ++ idents e'
+    idents (ETup es)            = idents es
+    idents (EList es)           = idents es
+    idents (ESig e _)           = idents e
+    idents (ERec _  fs)         = idents fs
+    idents (EBStruct _ _ bs)    = idents bs
+    idents (ELam ps e)          = idents e \\ idents ps
+    idents (ELet bs e)          = idents bs ++ (idents e \\ bvars bs)
+    idents (ECase e as)         = idents e ++ idents as
+    idents (EIf b t e)          = idents b ++ idents t ++ idents e
+    idents (ENeg e)             = idents e
+    idents (ESeq f Nothing t)   = idents f ++ idents t
+    idents (ESeq f (Just s) t)  = idents f ++ idents s ++ idents t
+    idents (EComp e qs)         = (idents e \\ bvars qs) ++ identQuals qs
+    idents (ESectR e v)         = v : idents e
+    idents (ESectL v e)         = v : idents e
+    idents (ESelect e _)        = idents e
+    idents (EDo _ _ ss)         = identStmts ss
+    idents (ETempl _ _ ss)      = identStmts ss
+    idents (EAct _ ss)          = identStmts ss 
+    idents (EReq _ ss)          = identStmts ss 
+    idents (EAfter e e')        = idents e ++ idents e'
+    idents (EBefore e e')       = idents e ++ idents e'
+    idents _                    = []
+
+instance Ids Field where
+    idents (Field _ e)          = idents e
+    
+instance Ids (Rhs Exp) where
+    idents (RExp a)             = idents a
+    idents (RGrd gs)            = idents gs
+    idents (RWhere a bs)        = idents bs ++ (idents a \\ bvars bs)
+
+instance Ids (GExp Exp) where
+    idents (GExp qs a)          = identQuals qs ++ idents a
+    
+instance Ids (Alt Exp) where
+    idents (Alt p a)            = idents a \\ idents p     
+
+instance Ids (Rhs [Stmt]) where
+    idents (RExp a)             = identStmts a
+    idents (RGrd gs)            = idents gs
+    idents (RWhere a bs)        = idents bs ++ (idents a \\ bvars bs)
+
+instance Ids (GExp [Stmt]) where
+    idents (GExp qs a)          = identQuals qs ++ identStmts a
+    
+instance Ids (Alt [Stmt]) where
+    idents (Alt p a)            = idents a \\ idents p     
+
+
+identQuals []                   = []
+identQuals (QExp e : qs)        = idents e ++ identQuals qs
+identQuals (QGen p e : qs)      = idents e ++ (identQuals qs \\ pvars p)
+identQuals (QLet bs : qs)       = idents bs ++ (identQuals qs \\ bvars bs)
+
+
+identStmts []                   = []
+identStmts (SExp e : ss)        = idents e ++ identStmts ss
+identStmts (SRet e : ss)        = idents e ++ identStmts ss
+identStmts (SGen p e : ss)      = idents e ++ (identStmts ss \\ pvars p)
+identStmts (SBind bs : ss)      = identSBind bs ss
+identStmts (SAss p e : ss)      = idents e ++ (identStmts ss \\ pvars p)
+identStmts (SForall qs ss' : ss)= identQuals qs ++ (identStmts ss' \\ bvars qs) ++ identStmts ss
+identStmts (SWhile e ss' : ss)  = idents e ++ identStmts ss' ++ identStmts ss
+identStmts (SIf e ss' : ss)     = idents e ++ identStmts ss' ++ identStmts ss
+identStmts (SElsif e ss' : ss)  = idents e ++ identStmts ss' ++ identStmts ss
+identStmts (SElse ss' : ss)     = identStmts ss' ++ identStmts ss
+identStmts (SCase e as : ss)    = idents e ++ idents as ++ identStmts ss
+
+identSBind bs (SBind bs' : ss ) = identSBind (bs++bs') ss
+identSBind bs ss                = idents bs ++ (identStmts ss \\ bvars bs)
+
+
+pvars p                         = evars p
+
+assignedVars ss                 = concat [ pvars p | SAss p _ <- ss ]
+
+
+-- Bound variables ----------------------------------------------------------
+
+instance BVars [Bind] where
+    bvars []                            = []
+    bvars (BEqn (LPat p) _ : bs)        = pvars p ++ bvars bs
+    bvars (BEqn (LFun v _) _ : bs)      = bvars' v bs
+      where bvars' v (BEqn (LFun v' _) _ : bs)
+              | v == v'                 = bvars' v bs
+              | otherwise               = v : bvars' v' bs
+            bvars' v bs                 = v : bvars bs
+    bvars (_ : bs)                      = bvars bs
+
+instance BVars [Field] where
+    bvars bs                            = [ s | Field s e <- bs ]
+
+instance BVars [Qual] where
+    bvars []                            = []
+    bvars (QGen p _ : qs)               = pvars p ++ bvars qs
+    bvars (QLet bs : qs)                = bvars bs ++ bvars qs
+    bvars (_ : qs)                      = bvars qs
+
+instance BVars [Stmt] where
+    bvars []                            = []
+    bvars (SGen p e : ss)               = pvars p ++ bvars ss
+    bvars (SBind bs : ss)               = bvars bs ++ bvars ss
+    bvars (_ : ss)                      = bvars ss
+  
+
+instance BVars Lhs where
+    bvars (LFun v ps)           = pvars ps
+    bvars (LPat p)              = []
+
+instance BVars [Pred] where
+    bvars []                    = []
+    bvars (PKind v k : ps)      = v : bvars ps
+    bvars (PType (TVar v) : ps) = v : bvars ps
+    bvars (p : ps)              = bvars ps
+
+
+-- Free type variables -------------------------------------------------------
+
+instance Ids Type where
+  idents (TQual t ps)           = (idents t ++ idents ps) \\ bvars ps
+  idents (TCon c)               = [c]
+  idents (TVar v)               = [v]
+  idents (TAp t t')             = idents t ++ idents t'
+  idents (TSub t t')            = idents t ++ idents t'
+  idents (TWild)                = []
+  idents (TList t)              = idents t
+  idents (TTup ts)              = concatMap idents ts
+  idents (TFun t t')            = idents t ++ idents t'
+
+
+instance Ids Pred where
+  idents (PType (TVar v))       = []
+  idents (PType t)              = idents t
+  idents (PKind v k)            = []
+
+
+-- PosInfo -------------------------------------------------------------------
+
+instance HasPos Type where
+  posInfo (TQual t ps)          = between (posInfo t) (posInfo ps)
+  posInfo (TCon n)              = posInfo n
+  posInfo (TVar n)              = posInfo n 
+  posInfo (TAp t t')            = between (posInfo t) (posInfo t')
+  posInfo (TSub t t')           = between (posInfo t) (posInfo t')
+  posInfo TWild                 = Unknown
+  posInfo (TList t)             = posInfo t 
+  posInfo (TTup ts)             = posInfo ts
+  posInfo (TFun ts t)           = between (posInfo ts) (posInfo t)
+
+instance HasPos Pred where
+  posInfo (PType t)              = posInfo t
+  posInfo (PKind n k)            = posInfo n
+
+instance HasPos Exp where
+  posInfo (EVar n)              = posInfo n
+  posInfo (ECon c)              = posInfo c
+  posInfo (EAp e e')            = between (posInfo e) (posInfo e')
+  posInfo (ESel n)              = posInfo n
+  posInfo (ETup es)             = posInfo es
+  posInfo (EList es)            = posInfo es
+  posInfo (ESig e t)            = between (posInfo e) (posInfo t)
+  posInfo (ERec m fs)           = between (posInfo m) (posInfo fs)
+  posInfo (EBStruct c _ bs)     = between (posInfo c) (posInfo bs)
+  posInfo (ELam ps e)           = between (posInfo ps) (posInfo e)
+  posInfo (ELet bs e)           = between (posInfo bs) (posInfo e)
+  posInfo (ECase e as)          = between (posInfo e) (posInfo as)
+  posInfo (EIf e t f)           = posInfo [e,t,f]
+  posInfo (ENeg e)              = posInfo e
+  posInfo (ESeq e1 m e2)        = foldr1 between [posInfo e1, posInfo m, posInfo e2]
+  posInfo (EComp e qs)          = between (posInfo e) (posInfo qs)
+  posInfo (ESectR e n)          = between (posInfo e) (posInfo n)
+  posInfo (ESectL n e)          = between (posInfo n) (posInfo e)
+  posInfo (ESelect e n)         = between (posInfo e) (posInfo n)
+  posInfo (EDo n t ss)          = between (posInfo n) (posInfo ss)
+  posInfo (ETempl n t ss)       = between (posInfo n) (posInfo ss)
+  posInfo (EAct n ss)           = between (posInfo n) (posInfo ss)
+  posInfo (EReq n ss)           = between (posInfo n) (posInfo ss)
+  posInfo (EAfter e e')         = between (posInfo e) (posInfo e')
+  posInfo (EBefore e e')        = between (posInfo e) (posInfo e')
+  posInfo (ELit l)              = posInfo l
+  posInfo _                     = Unknown
+
+instance HasPos Field where
+  posInfo (Field n e)           = between (posInfo n) (posInfo e)
+
+instance HasPos a => HasPos (Rhs a) where
+  posInfo (RExp a)              = posInfo a
+  posInfo (RGrd gs)             = posInfo gs
+  posInfo (RWhere r bs)         = between (posInfo r) (posInfo bs)
+ 
+instance HasPos a => HasPos (GExp a) where
+  posInfo (GExp qs a)           = between (posInfo qs) (posInfo a)
+
+instance HasPos a => HasPos (Alt a) where
+  posInfo (Alt p r)             = between (posInfo p) (posInfo r)
+
+instance HasPos Qual where
+  posInfo (QExp e)              = posInfo e
+  posInfo (QGen p e)            = between (posInfo p) (posInfo e)
+  posInfo (QLet bs)             = posInfo bs
+
+instance HasPos Stmt where
+  posInfo (SExp e)              = posInfo e
+  posInfo (SRet e)              = posInfo e
+  posInfo (SGen p e)            = between (posInfo p) (posInfo e)
+  posInfo (SBind b)             = posInfo b
+  posInfo (SAss p e)            = between (posInfo p) (posInfo e)
+  posInfo (SForall qs ss)       = between (posInfo qs) (posInfo ss)
+  posInfo (SWhile e ss)         = between (posInfo e) (posInfo ss)
+  posInfo (SIf e ss)            = between (posInfo e) (posInfo ss)
+  posInfo (SElsif e ss)         = between (posInfo e) (posInfo ss)
+  posInfo (SElse ss)            = posInfo ss
+  posInfo (SCase e as)          = between (posInfo e) (posInfo as)
+
+instance HasPos Bind where
+  posInfo (BSig ns t)           = posInfo ns
+  posInfo (BEqn l r)            = between (posInfo l) (posInfo r)
+
+instance HasPos Lhs where
+  posInfo (LFun n ps)           = between (posInfo n) (posInfo ps)
+  posInfo (LPat p)              = posInfo p
+
+-- Binary --------------------------------------------------------------------
+
+instance Binary Module where
+  put (Module a b c d) = put a >> put b >> put c >> put d
+  get = get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> return (Module a b c d)
+
+instance Binary Import where
+  put (Import a b) = put a >> put b
+  get = get >>= \a -> get >>= \b -> return (Import a b)
+
+instance Binary Decl where
+  put (DKSig a b) = putWord8 0 >> put a >> put b
+  put (DData a b c d) = putWord8 1 >> put a >> put b >> put c >> put d
+  put (DRec a b c d e) = putWord8 2 >> put a >> put b >> put c >> put d >> put e
+  put (DType a b c) = putWord8 3 >> put a >> put b >> put c
+--  put (DInst a b) = putWord8 4 >> put a >> put b
+  put (DPSig a b) = putWord8 4 >> put a >> put b
+  put (DDefault a) = putWord8 5 >> put a
+  put (DInstance a) = putWord8 6 >> put a
+  put (DTClass a) = putWord8 7 >> put a
+  put (DBind a) = putWord8 8 >> put a
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> get >>= \b -> return (DKSig a b)
+      1 -> get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> return (DData a b c d)
+      2 -> get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> get >>= \e -> return (DRec a b c d e)
+      3 -> get >>= \a -> get >>= \b -> get >>= \c -> return (DType a b c)
+--      4 -> get >>= \a -> get >>= \b -> return (DInst a b)
+      4 -> get >>= \a -> get >>= \b -> return (DPSig a b)
+      5 -> get >>= \a -> return (DDefault a)
+      6 -> get >>= \a -> return (DInstance a)
+      7 -> get >>= \a -> return (DTClass a)
+      8 -> get >>= \a -> return (DBind a)
+      _ -> fail "no parse"
+
+
+instance Binary Constr where
+  put (Constr a b c) = put a >> put b >> put c
+  get = get >>= \a -> get >>= \b -> get >>= \c -> return (Constr a b c)
+
+instance Binary Sig where
+  put (Sig a b) = put a >> put b
+  get = get >>= \a -> get >>= \b -> return (Sig a b)
+
+instance Binary Bind where
+  put (BSig a b) = putWord8 0 >> put a >> put b
+  put (BEqn a b) = putWord8 1 >> put a >> put b
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> get >>= \b -> return (BSig a b)
+      1 -> get >>= \a -> get >>= \b -> return (BEqn a b)
+      _ -> fail "no parse"
+
+instance Binary Type where
+  put (TQual a b) = putWord8 0 >> put a >> put b
+  put (TCon a) = putWord8 1 >> put a
+  put (TVar a) = putWord8 2 >> put a
+  put (TAp a b) = putWord8 3 >> put a >> put b
+  put (TSub a b) = putWord8 4 >> put a >> put b
+  put TWild = putWord8 5
+  put (TList a) = putWord8 6 >> put a
+  put (TTup a) = putWord8 7 >> put a
+  put (TFun a b) = putWord8 8 >> put a >> put b
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> get >>= \b -> return (TQual a b)
+      1 -> get >>= \a -> return (TCon a)
+      2 -> get >>= \a -> return (TVar a)
+      3 -> get >>= \a -> get >>= \b -> return (TAp a b)
+      4 -> get >>= \a -> get >>= \b -> return (TSub a b)
+      5 -> return TWild
+      6 -> get >>= \a -> return (TList a)
+      7 -> get >>= \a -> return (TTup a)
+      8 -> get >>= \a -> get >>= \b -> return (TFun a b)
+      _ -> fail "no parse"
+
+instance Binary Pred where
+  put (PType a) = putWord8 0 >> put a
+  put (PKind a b) = putWord8 1 >> put a >> put b
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> return (PType a)
+      1 -> get >>= \a -> get >>= \b -> return (PKind a b)
+      _ -> fail "no parse"
+
+instance Binary Lhs where
+  put (LFun a b) = putWord8 0 >> put a >> put b
+  put (LPat a) = putWord8 1 >> put a
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> get >>= \b -> return (LFun a b)
+      1 -> get >>= \a -> return (LPat a)
+      _ -> fail "no parse"
+
+instance Binary Exp where
+  put (EVar a) = putWord8 0 >> put a
+  put (EAp a b) = putWord8 1 >> put a >> put b
+  put (ECon a) = putWord8 2 >> put a
+  put (ESel a) = putWord8 3 >> put a
+  put (ELit a) = putWord8 4 >> put a
+  put (ETup a) = putWord8 5 >> put a
+  put (EList a) = putWord8 6 >> put a
+  put EWild = putWord8 7
+  put (ESig a b) = putWord8 8 >> put a >> put b
+  put (ERec a b) = putWord8 9 >> put a >> put b
+  put (ELam a b) = putWord8 10 >> put a >> put b
+  put (ELet a b) = putWord8 11 >> put a >> put b
+  put (ECase a b) = putWord8 12 >> put a >> put b
+  put (EIf a b c) = putWord8 13 >> put a >> put b >> put c
+  put (ENeg a) = putWord8 14 >> put a
+  put (ESeq a b c) = putWord8 15 >> put a >> put b >> put c
+  put (EComp a b) = putWord8 16 >> put a >> put b
+  put (ESectR a b) = putWord8 17 >> put a >> put b
+  put (ESectL a b) = putWord8 18 >> put a >> put b
+  put (ESelect a b) = putWord8 19 >> put a >> put b
+  put (EDo a b c) = putWord8 21 >> put a >> put b >> put c
+  put (ETempl a b c) = putWord8 22 >> put a >> put b >> put c
+  put (EAct a b) = putWord8 23 >> put a >> put b
+  put (EReq a b) = putWord8 24 >> put a >> put b
+  put (EAfter a b) = putWord8 25 >> put a >> put b
+  put (EBefore a b) = putWord8 26 >> put a >> put b
+  put (EBStruct a b c) = putWord8 27 >> put a >> put b >> put c
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> return (EVar a)
+      1 -> get >>= \a -> get >>= \b -> return (EAp a b)
+      2 -> get >>= \a -> return (ECon a)
+      3 -> get >>= \a -> return (ESel a)
+      4 -> get >>= \a -> return (ELit a)
+      5 -> get >>= \a -> return (ETup a)
+      6 -> get >>= \a -> return (EList a)
+      7 -> return EWild
+      8 -> get >>= \a -> get >>= \b -> return (ESig a b)
+      9 -> get >>= \a -> get >>= \b -> return (ERec a b)
+      10 -> get >>= \a -> get >>= \b -> return (ELam a b)
+      11 -> get >>= \a -> get >>= \b -> return (ELet a b)
+      12 -> get >>= \a -> get >>= \b -> return (ECase a b)
+      13 -> get >>= \a -> get >>= \b -> get >>= \c -> return (EIf a b c)
+      14 -> get >>= \a -> return (ENeg a)
+      15 -> get >>= \a -> get >>= \b -> get >>= \c -> return (ESeq a b c)
+      16 -> get >>= \a -> get >>= \b -> return (EComp a b)
+      17 -> get >>= \a -> get >>= \b -> return (ESectR a b)
+      18 -> get >>= \a -> get >>= \b -> return (ESectL a b)
+      19 -> get >>= \a -> get >>= \b -> return (ESelect a b)
+      21 -> get >>= \a -> get >>= \b -> get >>= \c -> return (EDo a b c)
+      22 -> get >>= \a -> get >>= \b -> get >>= \c -> return (ETempl a b c)
+      23 -> get >>= \a -> get >>= \b -> return (EAct a b)
+      24 -> get >>= \a -> get >>= \b -> return (EReq a b)
+      25 -> get >>= \a -> get >>= \b -> return (EAfter a b)
+      26 -> get >>= \a -> get >>= \b -> return (EBefore a b)
+      27 -> get >>= \a -> get >>= \b -> get >>= \c -> return (EBStruct a b c)
+      _ -> fail "no parse"
+
+instance Binary Field where
+  put (Field a b) = put a >> put b
+  get = get >>= \a -> get >>= \b -> return (Field a b)
+
+instance (Binary a) => Binary (Rhs a) where
+  put (RExp a) = putWord8 0 >> put a
+  put (RGrd a) = putWord8 1 >> put a
+  put (RWhere a b) = putWord8 2 >> put a >> put b
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> return (RExp a)
+      1 -> get >>= \a -> return (RGrd a)
+      2 -> get >>= \a -> get >>= \b -> return (RWhere a b)
+      _ -> fail "no parse"
+
+instance (Binary a) => Binary (GExp a) where
+  put (GExp a b) = put a >> put b
+  get = get >>= \a -> get >>= \b -> return (GExp a b)
+
+instance (Binary a) => Binary (Alt a) where
+  put (Alt a b) = put a >> put b
+  get = get >>= \a -> get >>= \b -> return (Alt a b)
+
+instance Binary Qual where
+  put (QExp a) = putWord8 0 >> put a
+  put (QGen a b) = putWord8 1 >> put a >> put b
+  put (QLet a) = putWord8 2 >> put a
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> return (QExp a)
+      1 -> get >>= \a -> get >>= \b -> return (QGen a b)
+      2 -> get >>= \a -> return (QLet a)
+      _ -> fail "no parse"
+
+instance Binary Stmt where
+  put (SExp a) = putWord8 0 >> put a
+  put (SRet a) = putWord8 1 >> put a
+  put (SGen a b) = putWord8 2 >> put a >> put b
+  put (SBind a) = putWord8 3 >> put a
+  put (SAss a b) = putWord8 4 >> put a >> put b
+  put (SForall a b) = putWord8 5 >> put a >> put b
+  put (SWhile a b) = putWord8 6 >> put a >> put b
+  put (SIf a b) = putWord8 7 >> put a >> put b
+  put (SElsif a b) = putWord8 8 >> put a >> put b
+  put (SElse a) = putWord8 9 >> put a
+  put (SCase a b) = putWord8 10 >> put a >> put b
+  get = do
+    tag_ <- getWord8
+    case tag_ of
+      0 -> get >>= \a -> return (SExp a)
+      1 -> get >>= \a -> return (SRet a)
+      2 -> get >>= \a -> get >>= \b -> return (SGen a b)
+      3 -> get >>= \a -> return (SBind a)
+      4 -> get >>= \a -> get >>= \b -> return (SAss a b)
+      5 -> get >>= \a -> get >>= \b -> return (SForall a b)
+      6 -> get >>= \a -> get >>= \b -> return (SWhile a b)
+      7 -> get >>= \a -> get >>= \b -> return (SIf a b)
+      8 -> get >>= \a -> get >>= \b -> return (SElsif a b)
+      9 -> get >>= \a -> return (SElse a)
+      10 -> get >>= \a -> get >>= \b -> return (SCase a b)
+      _ -> fail "no parse"
+
diff --git a/src/Syntax2Core.hs b/src/Syntax2Core.hs
new file mode 100644
--- /dev/null
+++ b/src/Syntax2Core.hs
@@ -0,0 +1,412 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Syntax2Core where
+
+
+import Common
+import Syntax
+import Monad
+import qualified Core
+import PP
+
+syntax2core m = s2c m
+
+
+-- translate a module in the empty environment
+
+s2c                             :: Module -> M s Core.Module
+s2c (Module v is ds ps)         = do (xs,ts,ws,bss) <- s2cDecls env0 ds [] [] [] [] []
+                                     return (Core.Module v is' xs ts ws bss)
+  where env0                    = Env { sigs = [] }
+        is'                     = [(b,n) | Import b n <- is]
+
+
+-- type signature environments
+data Env                        = Env { sigs :: Map Name Type }
+
+addSigs te env                  = env { sigs = te ++ sigs env }
+
+
+-- Syntax to Core translation of declarations ========================================================
+
+-- Translate top-level declarations, accumulating signature environment env, kind environment ke, 
+-- type declarations ts, instance names ws, bindings bs as well as default declarations xs
+s2cDecls env [] ke ts ws bss xs = do bss <- s2cBindsList env (reverse bss)
+                                     ke' <- mapM s2cKSig (impl_ke `zip` repeat KWild)
+                                     xs' <- mapM s2cDefault xs
+                                     let ds = Core.Types (reverse ke ++ ke') (reverse ts)
+                                     return (xs', ds, ws, bss)
+  where impl_ke                 = dom ts \\ dom ke
+
+s2cDecls env (DKSig c k : ds) ke ts ws bss xs
+                                = do ck  <- s2cKSig (c,k)
+                                     s2cDecls env ds (ck:ke) ts ws bss xs
+s2cDecls env (DData c vs bts cs : ds) ke ts ws bss xs
+                                = do bts <- mapM s2cQualType bts
+                                     cs  <- mapM s2cConstr cs
+                                     s2cDecls env' ds ke ((c,Core.DData vs bts cs):ts) ws bss xs
+  where env'                    = addSigs (teConstrs c vs cs) env
+s2cDecls env (DRec isC c vs bts ss : ds) ke ts ws bss xs
+                                = do bts <- mapM s2cQualType bts
+                                     sss <- mapM s2cSig ss
+                                     s2cDecls env' ds ke ((c,Core.DRec isC vs bts (concat sss)):ts) ws bss xs
+  where env'                    = addSigs (teSigs c vs ss) env
+s2cDecls env (DType c vs t : ds) ke ts ws bss xs
+                                = do t <- s2cType t
+                                     s2cDecls env ds ke ((c,Core.DType vs t):ts) ws bss xs
+s2cDecls env (DInstance vs : ds) ke ts ws bss xs
+                                = s2cDecls env ds ke ts (ws++vs) bss xs
+s2cDecls env (DDefault d : ds) ke ts ws bss xs
+                                = s2cDecls env ds ke ts ws bss (d ++ xs)
+s2cDecls env (DBind bs : ds) ke ts ws bss xs
+                                = s2cDecls env ds ke ts ws (bs:bss) xs
+
+
+s2cBindsList env []             = return []
+s2cBindsList env (bs:bss)       = do (te,bs) <- s2cBinds env bs
+                                     bss <- s2cBindsList (addSigs te env) bss
+                                     return (bs:bss)
+
+
+s2cDefault (Default t a b)      = return (Default t a b)
+s2cDefault (Derive n t)         = do t <- s2cQualType t
+                                     return (Derive n t)
+
+--translate a constructor declaration
+s2cConstr (Constr c ts ps)      = do ts <- mapM s2cQualType ts
+                                     (qs,ke) <- s2cQuals ps
+                                     return (c, Core.Constr ts qs ke)
+
+
+-- translate a field declaration
+s2cSig (Sig vs qt)              = s2cTSig vs qt
+
+
+-- add suppressed wildcard kind  
+pVar v                          = PKind v KWild
+
+
+-- buld a signature environment for data constructors cs in type declaration tc vs
+teConstrs tc vs cs              = map f cs
+  where t0                      = foldl TAp (TCon tc) (map TVar vs)
+        f (Constr c ts ps)      = (c,TQual (tFun ts t0) (ps ++ map pVar vs))
+
+-- build a signature environment for record selectors ss in type declaration tc vs
+teSigs tc vs ss                 = concat (map f ss)
+  where t0                      = foldl TAp (TCon tc) (map TVar vs)
+        f (Sig ws (TQual t ps)) = ws `zip` repeat (TQual (TFun [t0] t) (ps ++ map pVar vs))
+        f (Sig ws t)            = ws `zip` repeat (TQual (TFun [t0] t) (map pVar vs))
+
+
+-- Signatures =========================================================================
+
+-- translate a type signature
+s2cTSig vs t                    = do ts <- mapM (s2cQualType . const t) vs
+                                     return (vs `zip` ts)
+
+
+-- Types ==============================================================================
+
+-- translate a qualified type scheme
+s2cQualType (TQual t qs)        = do (ps,ke) <- s2cQuals qs
+                                     t <- s2cRhoType t
+                                     return (Core.Scheme t ps ke)
+s2cQualType t                   = s2cQualType (TQual t [])
+
+
+-- translate a rank-N function type
+s2cRhoType (TFun ts t)          = do ts <- mapM s2cQualType ts
+                                     t <- s2cRhoType t
+                                     return (Core.F ts t)
+s2cRhoType t                    = liftM Core.R (s2cType t)
+
+
+-- translate a monomorphic type
+s2cType (TSub t t')             = s2cType (TFun [t] t')
+s2cType (TFun ts t)             = do ts <- mapM s2cType ts
+                                     t <- s2cType t
+                                     return (Core.TFun ts t)
+s2cType (TAp t t')              = liftM2 Core.TAp (s2cType t) (s2cType t')
+
+
+s2cType (TCon c)                = return (Core.TId c)
+s2cType (TVar v)                = return (Core.TId v)
+s2cType (TWild)                 = do k <- newKVar
+                                     Core.newTVar k
+
+
+-- translate qualifiers, separating predicates from kind signatures along the way
+s2cQuals qs                     = s2c [] [] qs
+  where
+    s2c ps ke []                = return (reverse ps, reverse ke)
+    s2c ps ke (PKind v k : qs)  = do k <- s2cKind k
+                                     s2c ps ((v,k) : ke) qs
+    s2c ps ke (PType t : qs)    = do p <- s2cQualType t
+                                     s2c (p : ps) ke qs
+
+
+-- Kinds ==============================================================================
+
+-- translate a kind
+s2cKind Star                    = return Star
+s2cKind KWild                   = newKVar
+s2cKind (KFun k k')             = liftM2 KFun (s2cKind k) (s2cKind k')
+
+s2cKSig (v,k)                   = do k <- s2cKind k
+                                     return (v,k)
+
+-- Expressions and bindings ============================================================
+
+-- the translated default case alternative
+dflt                                    = [(Core.PWild, Core.EVar (prim Fail))]
+
+
+-- translate a case alternative, inheriting type signature t top-down
+s2cA env t (Alt (ELit l) (RExp e))      = do e' <- s2cEc env t e
+                                             return (Core.PLit l, e')
+s2cA env t (Alt (ECon c) (RExp e))      = do e' <- s2cEc env (TFun ts t) e
+                                             return (Core.PCon c, e')
+  where ts                              = splitArgs (lookupT c env)
+
+
+-- translate a record field
+s2cF env (Field s e)                    = do e <- s2cEc env (snd (splitT (lookupT s env))) e
+                                             return (s,e)
+
+
+-- split bindings bs into type signatures and equations
+splitBinds bs                           = s2cB [] [] bs
+  where 
+    s2cB sigs eqs []                    = (reverse sigs, reverse eqs)
+    s2cB sigs eqs (BSig vs t : bs)      = s2cB (vs `zip` repeat t ++ sigs) eqs bs
+    s2cB sigs eqs (BEqn (LFun v []) (RExp e) : bs)
+                                        = s2cB sigs ((v,e):eqs) bs
+
+
+-- translate equation eqs in the scope of corresponding signatures sigs
+s2cBinds env bs                         = do (ts,es) <- fmap unzip (mapM s2cEqn eqs)
+                                             let te = vs `zip` ts
+                                             te' <- s2cTE te
+                                             return (te, Core.Binds isRec te' (vs `zip` es))
+  where (sigs,eqs)                      = splitBinds bs
+        vs                              = dom eqs
+        isRec                           = not (null (filter (not . isPatTemp) vs `intersect` evars (rng eqs)))
+        env'                            = addSigs sigs env
+        s2cEqn (v,e)                    = case lookup v sigs of
+                                            Nothing -> s2cEi env' e
+                                            Just t  -> do e <- s2cEc env' t' e
+                                                          return (t,e)
+                                              where t' = if explicit (annot v) then expl t else peel t
+
+
+-- Expressions, inherit mode ===============================================================
+
+-- translate an expression, inheriting type signature t top-down
+s2cEc env t (ELam ps e)         = do e' <- s2cEc (addSigs te env) t' e
+                                     te' <- s2cTE te
+                                     return (Core.ELam te' e')
+  where (te,t')                 = mergeT ps t
+s2cEc env _ (EAp e1 e2)         = do (t,e1) <- s2cEi env e1
+                                     let (t1,_) = splitT t
+                                     e2 <- s2cEc env (peel t1) e2
+                                     return (Core.eAp2 e1 [e2])
+s2cEc env t (ELet bs e)         = do (te',bs') <- s2cBinds env bs
+                                     e' <- s2cEc (addSigs te' env) t e
+                                     return (Core.ELet bs' e')
+s2cEc env t (ECase e alts)      = do e <- s2cEc env TWild e
+                                     alts <- mapM (s2cA env t) alts
+                                     return (Core.ECase e (alts++dflt))
+s2cEc env t (ESelect e s)       = do e <- s2cEc env (peel t1) e
+                                     return (Core.ESel e s)
+  where (t1,_)                  = splitT (lookupT s env)
+s2cEc env t (ECon c)            = return (Core.ECon c)
+s2cEc env t (EVar v)            = return (Core.EVar v)
+s2cEc env t (ELit l)            = return (Core.ELit l)
+s2cEc env _ e                   = s2cE env e
+
+
+-- Expressions, agnostic mode ================================================================
+
+-- translate an expression whose type cannot be rank-N polymorphic 
+-- (i.e., no point inheriting nor synthesizing signatures)
+s2cE env (ERec (Just (c,_)) eqs)        = do eqs <- mapM (s2cF env) eqs
+                                             return (Core.ERec c eqs)
+s2cE env (EAct (Just x) [SExp e])       = do (_,e) <- s2cEi env e
+                                             return (Core.EAct (Core.EVar x) e)
+s2cE env (EReq (Just x) [SExp e])       = do (_,e) <- s2cEi env e
+                                             return (Core.EReq (Core.EVar x) e)
+s2cE env (EDo (Just x) Nothing ss)      = do c <- s2cS env ss
+                                             t <- s2cType TWild
+                                             return (Core.EDo x t c)
+s2cE env (ETempl (Just x) Nothing ss)   = do c <- s2cS (addSigs te env) ss
+                                             t <- s2cType TWild
+                                             te' <- s2cTE te
+                                             return (Core.ETempl x t te' c)
+  where 
+    vs                                  = assignedVars ss
+    te                                  = sigs ss
+
+    sigs []                             = []
+    sigs (SAss (ESig (EVar v) t) _ :ss) = (v,t) : sigs ss
+    sigs (SAss (EVar v) _:ss)           = (v,TWild) : sigs ss
+    sigs (_ : ss)                       = sigs ss
+
+s2cE env e                              = internalError "s2cE: did not expect" e
+
+
+-- Statements ==================================================================================
+
+-- translate a statement list
+s2cS env []                             = return (Core.CRet (Core.ECon (prim UNITTERM)))
+s2cS env [SRet e]                       = do (t,e') <- s2cEi env e
+                                             return (Core.CRet e')
+s2cS env [SExp e]                       = do (t,e') <- s2cEi env e
+                                             return (Core.CExp e')
+s2cS env (SGen (ESig (EVar v) t) e :ss) = do t' <- s2cType t
+                                             e' <- s2cEc env TWild e
+                                             c <- s2cS (addSigs [(v,t)] env) ss
+                                             return (Core.CGen v t' e' c)
+s2cS env (SGen (EVar v) e : ss)         = do (_,e') <- s2cEi env e
+                                             t <- s2cType TWild
+                                             c <- s2cS env ss
+                                             return (Core.CGen v t e' c)
+s2cS env (SAss (ESig v t) e : ss)       = s2cS env (SAss v e : ss)
+s2cS env (SAss (EVar v) e : ss)         = do e' <- s2cEc env (lookupT v env) e
+                                             c <- s2cS env ss
+                                             return (Core.CAss v e' c)
+s2cS env (SBind bs : ss)                = do (te',bs') <- s2cBinds env bs
+                                             c <- s2cS (addSigs te' env) ss
+                                             return (Core.CLet bs' c)
+
+
+-- Expressions, synthesize mode ================================================================
+
+-- translate an expression, synthesize type signature bottom-up
+s2cEi env (ELam ps e)           = do (t,e') <- s2cEi (addSigs te env) e
+                                     te' <- s2cTE te
+                                     return (TFun (rng te) t, Core.ELam te' e')
+  where (te,_)                  = mergeT ps TWild
+s2cEi env (EAp e1 e2)           = do (t,e1) <- s2cEi env e1
+                                     let (t1,t2) = splitT t
+                                     e2 <- s2cEc env (peel t1) e2
+                                     return (t2, Core.eAp2 e1 [e2])
+s2cEi env (ELet bs e)           = do (te',bs') <- s2cBinds env bs
+                                     (t,e') <- s2cEi (addSigs te' env) e
+                                     return (t, Core.ELet bs' e')
+s2cEi env (ECase e alts)        = do e <- s2cEc env TWild e
+                                     alts <- mapM (s2cA env TWild) alts
+                                     return (TWild, Core.ECase e (alts++dflt))
+s2cEi env (ESelect e s)         = do e <- s2cEc env (peel t1) e
+                                     return (t2, Core.ESel e s)
+  where (t1,t2)                 = splitT (lookupT s env)
+s2cEi env (ECon c)              = return (lookupT c env, Core.ECon c)
+s2cEi env (EVar v)              = return (lookupT v env, Core.EVar v)
+s2cEi env (ELit l)              = return (TWild, Core.ELit l)
+s2cEi env e                     = do e' <- s2cE env e
+                                     return (TWild, e')
+
+
+-- Misc ====================================================================================
+
+-- translate type enviroment te
+s2cTE te                        = mapM s2cVT te
+  where s2cVT (v,t)             = do t <- s2cQualType t
+                                     return (v,t)
+
+
+-- split a function type into domain (one parameter only) and range
+-- if not a function type, fail gracefully (error will be caught later by real type-checker)
+splitT (TFun [t] t')            = (t, t')
+splitT (TFun (t:ts) t')         = (t, TFun ts t')
+splitT TWild                    = (TWild,TWild)
+splitT _                        = (TWild,TWild)
+
+
+-- return the domain of a function type (all immediate parameters)
+splitArgs (TFun ts t)           = ts
+splitArgs t                     = []
+
+
+-- merge any signatures in patterns ps with domain of type t, pair with range of t
+mergeT ps t                     = (zipWith f ts ps, t')
+  where (ts,t')                 = split (length ps) t
+        f t (EVar v)            = (v,t)
+        f t (ESig (EVar v) t')  = (v,t')
+        f t e                   = internalError "mergeT: did not expect" e
+        split 0 t               = ([],t)
+        split n t               = (t1:ts,t')
+          where (t1,t2)         = splitT t
+                (ts,t')         = split (n-1) t2
+
+
+-- find and instantate the type signature for x if present, otherwise return _
+lookupT x env                   = case lookup x (sigs env) of
+                                    Nothing -> TWild
+                                    Just t  -> peel t
+
+
+-- peel off the outermost qualifiers of a type, replacing all bound variables with _
+peel (TQual t ps)               = mkWild (bvars ps) t
+peel t                          = t
+
+
+-- turn class and subtype predicates into explicit function arguments, and peel off the quantifiers
+expl (TQual t ps)               = mkWild (bvars ps) (TFun ts t)
+  where ts                      = [ t | PType t <- ps ]
+
+
+-- replace all variables vs in a type by _
+mkWild vs (TQual t ps)          = TQual (mkWild vs' t) (map (mkWild' vs') ps)
+  where vs'                     = vs \\ bvars ps
+mkWild vs (TAp t t')            = TAp (mkWild vs t) (mkWild vs t')
+mkWild vs (TFun ts t)           = TFun (map (mkWild vs) ts) (mkWild vs t)
+mkWild vs (TSub t t')           = TSub (mkWild vs t) (mkWild vs t')
+mkWild vs (TList t)             = TList (mkWild vs t)
+mkWild vs (TTup ts)             = TTup (map (mkWild vs) ts)
+mkWild vs (TVar v)
+          | v `elem` vs         = TWild
+mkWild vs t                     = t
+
+
+-- replace all variables vs in a predicate by _
+mkWild' vs (PType t)          = PType (mkWild vs t)
+mkWild' vs p                  = p
+
+-- Checking whether bindings are recursive 
+
+checkRecBinds (Core.Binds _ te  es@[(x,e)])
+                              = Core.Binds (x `elem` evars e) te es
+checkRecBinds (Core.Binds _ te es) 
+                              = Core.Binds True te es
+
diff --git a/src/Termred.hs b/src/Termred.hs
new file mode 100644
--- /dev/null
+++ b/src/Termred.hs
@@ -0,0 +1,465 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Termred(termred, redTerm, isFinite, constrs) where
+
+import Monad
+import Common
+import Core
+import PP
+import Char
+
+termred (_,ds',_,bs') m         = redModule (consOf ds') (eqnsOf bs') m
+
+redTerm coercions e             = redExp (initEnv { eqns = coercions }) e
+
+isFinite e                      = finite initEnv e
+
+
+data Env                        = Env { eqns :: Map Name Exp,
+                                        args :: [Name],
+                                        cons :: [Map Name Int]
+                                      }
+
+initEnv                         = Env { eqns = [], args = [], cons = cons0 }
+
+cons0                           = [ [(prim TRUE, 0), (prim FALSE, 0)] , [(prim NIL, 0), (prim CONS, 2)] ]
+
+consOf (Types _ ds)             = [ map f ce | (_,DData _ _ ce) <- ds ]
+  where f (c, Constr te pe _)   = (c, length te + length pe)
+
+
+conArity env (Tuple n _)        = n
+conArity env c                  = lookup' (concat (cons env)) c
+
+
+complete _ [Tuple _ _]          = True
+complete _ []                   = False
+complete [] cs0                 = False
+complete (cs:css) cs0           = all (`elem`cs0) (dom cs)  ||  complete css cs0
+
+addArgs env vs                  = env { args = vs ++ args env }
+
+addEqns env eqs                 = env { eqns = eqs ++ eqns env }
+
+addCons env css                 = env { cons = css ++ cons env }
+
+redModule impCons impEqs (Module m ns xs ds is bss)
+                                = do (bss,_) <- redTopBinds env1 bss
+                                     return (Module m ns xs ds is bss)
+  where env0                    = addCons initEnv (impCons ++ consOf ds)
+        env1                    = addEqns env0 (finiteEqns env0 impEqs)
+
+
+redTopBinds env []              = return ([], [])
+redTopBinds env (bs : bss)      = do Binds r te es <- redBinds env bs
+                                     (bss,vs) <- redTopBinds (addEqns env (finiteEqns env es)) bss
+                                     let necessary (v,_) = maybe (elem v vs) (const True) (fromMod v)
+                                         te' = filter necessary te
+                                         es' = filter necessary es
+                                         bs' = Binds r te' es'
+                                         bss' = if null te' then bss else bs':bss
+                                     return (bss', idents es' ++ vs)
+                                     
+
+finiteEqns env eqs              = filter p eqs
+  where p (x,e)                 = isSmall e && finite env e
+
+
+-- can be safely ignored without changing cbv semantics
+value (EVar x)                  = x /= prim New
+value (ECon _)                  = True
+value (ELit _)                  = True
+value (ESel e _)                = value e
+value (EAp (EVar (Prim IntDiv _)) [e1,e2])
+                                = value e1 && nonzero e2
+value (EAp (EVar (Prim FloatDiv _)) [e1,e2])
+                                = value e1 && nonzero e2
+value (EAp (EVar (Prim _ _)) es)
+                                = all value es
+value (EAp (EVar (Tuple _ _)) es)
+                                = all value es
+value (EAp (ECon c) es)         = all value es
+value (ELam _ _)                = True
+value (ERec _ eqs)              = all (value . snd) eqs
+value e                         = False
+
+nonzero (ELit (LInt _ n))       = n /= 0
+nonzero (ELit (LRat _ n))       = n /= 0
+nonzero _                       = False
+
+
+-- may be safely inlined (can't lead to infinite expansion even if part of a recursive binding group)
+finite env (EVar (Prim c _))    = True --c `notElem` [ListArray, UniArray, UpdateArray]
+finite env (EVar (Tuple _ _))   = True
+finite env (EVar x)             = x `elem` args env || maybe False (finite env )(lookup x (eqns env))
+finite env (ECon _)             = True
+finite env (ELit _)             = True
+finite env (ESel e _)           = finite env e
+finite env (ELam te e)          = finite (addArgs env (dom te)) e
+finite env (ERec _ eqs)         = all (finite env) (rng eqs)
+finite env (EAp e es)           = all (finite env) (e:es)
+finite env (ELet bs e)          = fin bs && finite (addArgs env (bvars bs)) e
+  where fin (Binds True _ _)    = False
+        fin (Binds _ _ eqns)    = all (finite env . snd) eqns
+finite env (ECase e alts)       = finite env e && all (finite env . snd) alts
+finite env e                    = False
+
+
+
+redBinds env (Binds r te eqns)  = liftM (Binds r te) (redEqns env eqns)
+
+
+redEqns env []                  = return []
+redEqns env ((x,e):eqns)        = do e' <- redExp env e
+                                     let env' = if finite env e' && isSmall e 
+                                                then addEqns env [(x,e')]     -- no risk of infinite inlining
+                                                else env
+                                     liftM ((x,e'):) (redEqns env' eqns)
+
+
+redExp env (ERec c eqs)         = do es' <- mapM (redExp env) es
+                                     return (ERec c (ls `zip` es'))
+  where (ls,es)                 = unzip eqs
+redExp env (ETempl x t te c)    = liftM (ETempl x t te) (redCmd env c)
+redExp env (EAct e e')          = liftM2 EAct (redExp env e) (redExp env e')
+redExp env (EReq e e')          = liftM2 EReq (redExp env e) (redExp env e')
+redExp env (EDo x t c)          = liftM (EDo x t) (redCmd env c)
+redExp env (ELam te e)          = do e <- redExp (addArgs env (dom te)) e
+                                     redEta env te e
+redExp env (ESel e s)           = do e <- redExp env e
+                                     redSel env e s
+redExp env (ECase e alts)       = do e <- redExp env e
+                                     redCase env e alts
+redExp env (ELet bs e)          = do bs'@(Binds rec te eqs) <- redBinds env bs
+                                     if rec then
+                                        liftM (ELet bs') (redExp env e)
+                                      else
+                                        redBeta (addArgs env (dom te)) te e (map (lookup' eqs) (dom te))
+redExp env e@(EVar (Prim {}))   = return e
+redExp env e@(EVar (Tuple {}))  = return e
+redExp env e@(EVar x)           = case lookup x (eqns env) of
+                                      Just e' | inline e' -> alphaConvert e'
+                                      _ -> return e
+  where inline (EVar _)         = True
+        inline (ECon _)         = True
+        inline (ELit _)         = True
+        inline (ELam _ _)       = True
+        inline _                = isGenerated x
+redExp env (EAp e es)           = do e' <- redExp env e
+                                     es' <- mapM (redExp env) es
+                                     redApp env e' es'
+redExp env (ELit l)             = return (ELit (normLit l))
+redExp env e                    = return e
+
+
+normLit (LInt p i)
+  | i >= 0x80000000             = normLit (LInt p (i - 0x100000000))
+  | i < -0x80000000             = normLit (LInt p (i + 0x100000000))
+  | otherwise                   = LInt p i
+normLit l                       = l
+
+
+isRaise (EAp (EVar (Prim Raise _)) [_])
+                                = True
+isRaise _                       = False
+
+isPMC (EVar (Prim p _))         = p `elem` [Match,Commit,Fatbar,Fail]
+isPMC _                         = False
+
+
+-- reduce an application e es (head and args already individually reduced)
+redApp env e es
+  | exception                   = return (head es')
+  where es'                     = filter isRaise (e:es)
+        exception               = not (isPMC e) && not (null es')
+redApp env (EVar (Prim p a)) es 
+                                = return (redPrim env p a es)
+redApp env e@(EVar x) es        = case lookup x (eqns env) of
+                                       Just e' | inline e' -> do e' <- alphaConvert e'; redApp env e' es
+                                       _ -> return (EAp e es)
+  where inline (ELam _ _)       = True
+        inline (EVar _)         = True
+        inline _                = False
+redApp env (ELam te e) es       = do redBeta env te e es
+redApp env (ECase e alts) es
+  | length alts' == length alts = liftM (ECase e) (redAlts env alts')
+  where alts'                   = [ a | Just a <- map (appAlt env es) alts ]
+redApp env (ELet bs e) es       = liftM (ELet bs) (redApp env e es)
+redApp env e es                 = return (EAp e es)
+
+
+appAlt env es (PCon c,e)        = case skipLambda (conArity env c) e es of
+                                    Just e' -> Just (PCon c, e')
+                                    _       -> Nothing
+appAlt env es a                 = Just a
+
+
+skipLambda 0 e es               = Just (EAp e es)
+skipLambda n (ELam te e) es
+  | n <= length te              = Just (ELam te1 (eLam te2 (EAp e es)))
+  where (te1,te2)               = splitAt n te
+skipLambda n e es               = Nothing
+
+
+
+-- perform beta reduction (if possible)
+redBeta env ((x,t):te) (EVar y) (e:es)
+  | x == y                      = redBeta env te e es                      -- trivial body
+redBeta env ((x,t):te) b (e:es)
+  | inline x e                  = do e' <- redBeta (addEqns env [(x,e)]) te b es
+                                     return (bindx e')
+  | otherwise                   = liftM (ELet bs) (redBeta env te b es)
+  where inline x e              = isSafe x || isEVar e || (value e && finite env e && isSmall e)
+        isSafe x                = isEtaExp x || isAssumption x || isCoercion x        
+        bindx e'
+          | x `elem` evars e'   = ELet bs e'
+          | otherwise           = e'
+        bs                      = Binds False [(x,t)] [(x,e)]
+        isEVar (EVar _)         = True
+        isEVar _                = False
+redBeta env [] b []             = redExp env b
+
+
+redEta env te (EAp e es)        = do es <- mapM (redExp env') es
+                                     e <- redExp env' e
+                                     if okEta e && es == map EVar xs then
+                                        return e
+                                      else do
+                                        liftM (ELam te) (redApp env' e es)
+  where okEta (ECon _)          = False
+        okEta (EVar (Prim _ _)) = False
+        okEta e                 = null (evars e `intersect` xs)
+        env'                    = addArgs env (dom te)
+        xs                      = dom te
+redEta env te e                 = liftM (ELam te) (redExp (addArgs env (dom te)) e)
+
+
+redSel env e s
+  | isRaise e                   = return e
+redSel env e@(EVar x) s         = case lookup x (eqns env) of
+                                    Just e' | inline e' -> do e' <- alphaConvert e'
+                                                              redSel env e' s
+                                    _ -> return (ESel e s)
+  where inline (ERec _ _)       = True
+        inline (EVar _)         = True
+        inline _                = False
+redSel env (ERec c eqs) s
+  | all value (rng eqs)         = case lookup s eqs of
+                                    Just e  -> return e
+                                    Nothing -> internalError0 ("redSel: did not find selector " ++ show s ++ "   in   " ++ show eqs) s
+redSel env e s                  = return (ESel e s)
+
+
+redCase env e alts
+  | isRaise e                   = return e
+redCase env e@(EVar x) alts     = case lookup x (eqns env) of
+                                    Just e' | inline (eFlat e') -> do e' <- alphaConvert e'; redCase env e' alts
+                                    Nothing -> liftM (ECase e) (redAlts env alts)
+  where inline (ECon _,_)       = True
+        inline (ELit _,_)       = True
+        inline (EVar _, [])     = True
+        inline _                = False
+redCase env (ELit l@(LStr _ _)) alts       
+                                =  redCaseStrLit env l alts
+redCase env (ELit l) alts       = findLit env l alts
+redCase env e alts              = case eFlat e of
+                                    (ECon k, es) -> findCon env k es alts
+                                    _            -> liftM (ECase e) (redAlts env alts)
+
+redAlts env alts
+  | complete (cons env) cs      = do es <- mapM (redExp env) es
+                                     return (map PCon cs `zip` es)
+  | otherwise                   = do es0 <- mapM (redExp env) es0
+                                     return (ps `zip` es0)
+  where (cs,es)                 = unzip [ (c,e) | (PCon c, e) <- alts ]
+        (ps,es0)                = unzip alts
+  
+redRhs env (ELam te e)          = do e <- redRhs (addArgs env (dom te)) e
+                                     return (ELam te e)
+redRhs env e                    = redExp env e
+
+
+findCon env k es ((PWild,e):_)  = redExp env e
+findCon env k es ((PCon k',e):_)
+  | k == k'                     = redExp env (eAp e es)
+findCon env k es (_:alts)       = findCon env k es alts
+
+
+findLit env l ((PWild,e):_)     = redExp env e
+findLit env l ((PLit l',e):_)
+  | l == l'                     = redExp env e
+findLit env l (_:alts)          = findLit env l alts
+
+redCaseStrLit env l ((PWild,e):_) = redExp env e
+redCaseStrLit env l ((PLit l',e):_)
+ | l == l'                      = redExp env e
+redCaseStrLit env (LStr _ "") ((PCon (Prim NIL _),e):alts) = redExp env e
+redCaseStrLit env l@(LStr _ str) alts@((PCon (Prim CONS _),e):_)
+                                = redCase env (foldr (\x y -> EAp cons [chr x,y]) nil str) alts
+   where chr x = ELit (LChr Nothing x)
+         cons = ECon (prim CONS)
+         nil = ECon (prim NIL)
+redCaseStrLit env l (_:alts)         = redCaseStrLit env l alts
+
+redPrim env Refl _ [e]                      = e
+redPrim env Match a [e]                     = redMatch env a e
+redPrim env Fatbar a [e,e']                 = redFat a e e'
+redPrim env UniArray a es                   = EAp (EVar (Prim UniArray a)) es
+redPrim env p _ [ELit (LInt _ x), ELit (LInt _ y)]  = redInt p x y
+redPrim env p a [ELit (LRat _ x), ELit (LRat _ y)]  = redRat p x y
+redPrim env IntNeg _ [ELit (LInt _ x)]      = ELit (lInt (-x))
+redPrim env IntToFloat _ [ELit (LInt _ x)]  = ELit (lRat (fromInteger x))
+redPrim env IntToChar _ [ELit (LInt _ x)]   = ELit (lChr (chr (fromInteger x)))
+redPrim env FloatNeg _ [ELit (LRat _ x)]    = ELit (lRat (-x))
+redPrim env FloatToInt _ [ELit (LRat _ x)]  = ELit (lInt (truncate x))
+redPrim env CharToInt _ [ELit (LChr _ x)]   = ELit (lInt (ord x))
+redPrim env p a es                          = eAp (EVar (Prim p a)) es
+
+
+redMatch env a (ELet bs e)                  = ELet bs (redMatch (addArgs env (bvars bs)) a e)
+redMatch env a (ELam te e)                  = ELam te (redMatch (addArgs env (dom te)) a e)
+redMatch env a (EAp (EVar (Prim Commit _)) [e]) = e
+redMatch env a (ECase e alts)               = ECase e (mapSnd (redMatch env a) alts)
+redMatch env _ (EVar (Prim Fail a))         = EAp (EVar (Prim Raise a)) [ELit (lInt 1)]
+redMatch env _ e@(ELit _)                   = e
+redMatch env a e                            = EAp (EVar (Prim Match a)) [e]
+
+
+redFat a (ELet bs e) e'                     = ELet bs (redFat a e e')
+redFat a (EVar (Prim Fail _)) e             = e
+redFat a e@(EAp (EVar (Prim Commit _)) _) _ = e
+redFat a e e'                               = EAp (EVar (Prim Fatbar a)) [e,e']
+
+
+redInt IntPlus a b              = ELit (normLit (lInt (a + b)))
+redInt IntMinus a b             = ELit (normLit (lInt (a - b)))
+redInt IntTimes a b             = ELit (normLit (lInt (a * b)))
+redInt IntDiv a b               = ELit (lInt (a `div` b))
+redInt IntMod a b               = ELit (lInt (a `mod` b))
+redInt IntEQ a b                = eBool (a == b)
+redInt IntNE a b                = eBool (a /= b)
+redInt IntLT a b                = eBool (a < b)
+redInt IntLE a b                = eBool (a <= b)
+redInt IntGE a b                = eBool (a >= b)
+redInt IntGT a b                = eBool (a > b)
+redInt p _ _                    = internalError0 ("redInt: unknown primitive " ++ show p)
+
+
+redRat FloatPlus a b            = ELit (lRat (a + b))
+redRat FloatMinus a b           = ELit (lRat (a - b))
+redRat FloatTimes a b           = ELit (lRat (a * b))
+redRat FloatDiv a b             = ELit (lRat (a / b))
+redRat FloatEQ a b              = eBool (a == b)
+redRat FloatNE a b              = eBool (a /= b)
+redRat FloatLT a b              = eBool (a < b)
+redRat FloatLE a b              = eBool (a <= b)
+redRat FloatGE a b              = eBool (a >= b)
+redRat FloatGT a b              = eBool (a > b)
+redRat p _ _                    = internalError0 ("redRat " ++ show p)
+
+
+eBool True                      = ECon (prim TRUE)
+eBool False                     = ECon (prim FALSE)
+
+
+redCmd env (CRet e)             = liftM CRet (redExp env e)
+redCmd env (CExp e)             = liftM CExp (redExp env e)
+redCmd env (CGen p t (ELet bs e) c)
+                                = redCmd env (CLet bs (CGen p t e c))
+redCmd env (CGen p t e c)       = liftM2 (CGen p t) (redExp env e) (redCmd env c)
+redCmd env (CLet bs c)          = do bs'@(Binds rec te eqs) <- redBinds env bs
+                                     if rec then
+                                        liftM (CLet bs') (redCmd env c)
+                                      else
+                                        redBetaC (addArgs env (dom te)) te c (map (lookup' eqs) (dom te))
+redCmd env (CAss x e c)         = liftM2 (CAss x) (redExp env e) (redCmd env c)
+
+
+-- perform beta reduction (if possible)
+redBetaC env ((x,t):te) (CRet (EVar y)) (e:es)
+  | x == y                      = redBetaC env te (CRet e) es
+redBetaC env ((x,t):te) c (e:es)
+  | inline x e                  = do c' <- redBetaC (addEqns env [(x,e)]) te c es
+                                     return (bindx c')
+  | otherwise                   = liftM (CLet bs) (redBetaC env te c es)
+  where inline x e              = isSafe x || isEVar e || (value e && finite env e && isSmall e)
+        isSafe x                = isEtaExp x || isAssumption x || isCoercion x        
+        bindx c'
+          | x `elem` evars c'   = CLet bs c'
+          | otherwise           = c'
+        bs                      = Binds False [(x,t)] [(x,e)]
+        isEVar (EVar _)         = True
+        isEVar _                = False
+redBetaC env [] c []            = redCmd env c
+
+-- Constructor presence
+
+isSmall e                       = length (constrs e) < 5
+
+class Constrs a where
+    constrs :: a -> [Name]
+
+instance Constrs Binds where
+    constrs (Binds rec te eqns) = constrs (map snd eqns)
+
+instance Constrs a => Constrs [a] where
+    constrs xs = concatMap constrs xs
+
+instance Constrs Exp where
+    constrs (ECon c)             = [c]
+    constrs (ESel e l)           = constrs e
+    constrs (ELam te e)          = constrs e
+    constrs (EAp e e')           = constrs e ++ constrs e'
+    constrs (ELet bs e)          = constrs bs ++ constrs e
+    constrs (ECase e alts)       = constrs e ++ constrs alts
+    constrs (ERec c eqs)         = constrs (map snd eqs)
+    constrs (EAct e e')          = constrs e ++ constrs e'
+    constrs (EReq e e')          = constrs e ++ constrs e'
+    constrs (ETempl x t te c)    = constrs c
+    constrs (EDo x t c)          = constrs c
+    constrs _                    = []
+
+instance Constrs Alt where
+    constrs (p,e)                = constrs e
+
+
+instance Constrs Cmd where
+    constrs (CLet bs c)          = constrs bs ++ constrs c
+    constrs (CGen x t e c)       = constrs e ++ constrs c
+    constrs (CAss x e c)         = constrs e ++ constrs c
+    constrs (CRet e)             = constrs e
+    constrs (CExp e)             = constrs e
+
diff --git a/src/Token.hs b/src/Token.hs
new file mode 100644
--- /dev/null
+++ b/src/Token.hs
@@ -0,0 +1,179 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Token where
+
+import Char
+
+
+data Token 
+    = VarId      (String,String)
+    | ConId      (String,String)
+    | VarSym     (String,String)
+    | ConSym     (String,String)
+    | IntTok     String
+    | FloatTok   String
+    | Character  Char
+    | StringTok  String
+{-
+
+Symbols
+
+-}
+    | LeftParen
+    | RightParen
+    | SemiColon
+    | LeftCurly
+    | RightCurly
+    | VRightCurly                       -- a virtual close brace
+    | LeftSquare
+    | RightSquare
+    | Comma
+    | BackQuote
+{-
+
+Reserved operators
+
+-}
+    | Assign
+    | Dot
+    | DotDot
+    | DoubleColon
+    | Equals
+    | Backslash
+    | Bar
+    | LeftArrow
+    | RightArrow
+    | Tilde
+    | Wildcard
+    | Backslash2
+{-
+
+Reserved Ids
+
+-}
+    | KW_Action
+    | KW_After
+    | KW_Before
+    | KW_Case     
+    | KW_Class    
+    | KW_Data     
+    | KW_Default  
+    | KW_Do       
+    | KW_Else   
+    | KW_Elsif
+    | KW_Forall
+    | KW_If
+    | KW_Import   
+    | KW_Instance
+    | KW_In       
+    | KW_Let
+    | KW_Module
+    | KW_New   
+    | KW_Of    
+    | KW_Private   
+    | KW_Request
+    | KW_Result
+    | KW_Struct
+    | KW_Then     
+    | KW_Type  
+    | KW_Typeclass
+    | KW_Use   
+    | KW_Where
+    | KW_While
+    | EOF
+      deriving (Eq, Show)
+
+
+reserved_ops :: [(String, Token)]
+reserved_ops
+    = [
+        ( ".",  Dot ),    
+        ( "..", DotDot ),    
+        ( "::", DoubleColon ),
+        ( ":=", Assign ),
+        ( "=",  Equals ),    
+        ( "\\", Backslash ), 
+        ( "|",  Bar ),       
+        ( "<-", LeftArrow ), 
+        ( "->", RightArrow ),
+        ( "_",  Wildcard ),
+        ( "\\\\", Backslash2 )
+      ]
+
+
+reserved_ids :: [(String, Token)]
+reserved_ids
+    = [
+        ( "action",    KW_Action ),
+        ( "after",     KW_After ),
+        ( "before",    KW_Before ),
+        ( "case",      KW_Case ),     
+        ( "class",     KW_Class ),    
+        ( "data",      KW_Data ),
+        ( "default",   KW_Default),   
+        ( "do",        KW_Do ),       
+        ( "else",      KW_Else ),
+        ( "elsif",     KW_Elsif ),     
+        ( "forall",    KW_Forall ),
+        ( "if",        KW_If ),
+        ( "import",    KW_Import ),
+        ( "instance",  KW_Instance ),     
+        ( "in",        KW_In ),       
+        ( "let",       KW_Let ),      
+        ( "module",    KW_Module ),   
+        ( "new",       KW_New ),
+        ( "of",        KW_Of ),
+        ( "private",   KW_Private ),
+        ( "request",   KW_Request ),
+        ( "result",    KW_Result ),
+        ( "struct",    KW_Struct ),
+        ( "then",      KW_Then ),     
+        ( "type",      KW_Type ),  
+        ( "typeclass", KW_Typeclass ),  
+        ( "use",       KW_Use ),   
+        ( "where",     KW_Where ),
+        ( "while",     KW_While )
+      ]
+
+
+
+tab_length = 8 :: Int
+
+isIdent  c = isAlpha c || isDigit c || c == '\'' || c == '_'
+isSymbol c = elem c ":!#$%&*+./<=>?@\\^|-~"
+
+data LexInt =
+      Decimal     (String,String)
+    | Octal       (String,String)
+    | Hexadecimal (String,String)
diff --git a/src/Type.hs b/src/Type.hs
new file mode 100644
--- /dev/null
+++ b/src/Type.hs
@@ -0,0 +1,535 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Type(typecheck) where
+      
+import Common
+import Core
+import Env
+import Depend
+import List(unzip4, zipWith3)
+import Monad
+import Kind
+import Decls
+import Reduce
+import Termred
+import PP
+import Derive
+
+--typecheck                       :: Module -> M s Module
+typecheck e2 m                     = tiModule e2 m
+
+
+{-
+
+Example 1:
+==========
+
+-- Initially:
+let f :: P => S -> T
+    f = \x -> e (f 7)
+
+-- After exp inference:
+    \x -> e w (f v 7)                                ::X->T'   \\ w::W, v::V
+
+-- After generalization:
+    \w v x -> e w (f v 7)                            ::W->V->X->T'  \\
+
+-- After mu:
+let f = c (\w v x -> e w (f v 7))                  ::P->S->T   \\ c::(W->V->X->T')->(P->S->T)
+
+-- After improvement (T' = T, X = S, V = P):
+let f = c (\w v x -> e w (f v 7))                  ::P->S->T   \\ c::(W->P->S->T)->(P->S->T)
+
+-- After reduce:
+let f = (\c -> c (\w v x -> e w (f v 7))) (\i -> i w0)             ::P->S->T  \\ w0 :: W
+
+-- After generalization:
+let f = \w0 -> (\f -> ((\c -> c (\w v x -> e w (f v 7))) (\i -> i w0))) (f w0)   ::W->P->S->T  \\
+
+-- After inlining:
+let f = \w0 -> \f -> ((\c -> c (\w v x -> e w (f v 7))) (\i -> i w0)) (f w0)  ::W->P->S->T  \\
+let f = \w0 -> (\c -> c (\w v x -> e w (f w0 v 7))) (\i -> i w0)              ::W->P->S->T  \\
+let f = \w0 -> (\i -> i w0) (\w v x -> e w (f w0 v 7))                        ::W->P->S->T  \\
+let f = \w0 -> (\w v x -> e w (f w0 v 7)) w0                                  ::W->P->S->T  \\
+let f = \w0 v x -> e w0 (f w0 v 7)                                            ::W->P->S->T  \\
+
+---------------
+\i -> i w0 :: (W->P->S->T)->P->S->T                \\ w0 :: W
+---------------
+-}
+
+tiModule (xs',ds',ws',bs') (Module v ns xs ds ws bss)
+                                = do env0' <- impPreds env0 pe'
+                                     (env1,ds1,bs1) <- typeDecls env0' ds
+                                     (env2,bs2) <- instancePreds env1 pe
+                                     -- Here it should be checked that any coercions in weqs follow the
+                                     -- restricted rules for coercions, and that the equalities collected 
+                                     -- in env2 are actually met by the equations in bs1, bs2 and bss
+                                     let env3 = insertDefaults env2 (pe'++pe) (xs'++xs)
+                                         env4 = addCoercions (weqs1 ++ weqs) env3
+                                         weqs1 = eqnsOf bs1 ++ eqnsOf bs2
+                                     (ss0,pe0,bs0) <- tiBindsList env4 bss
+                                     -- tr ("Top-level: \n" ++ render (nest 4 (vpr (tsigsOf bs0) $$ vpr pe0)))
+                                     bs3 <- topresolve env4 ss0 pe0 bs0
+                                     -- tr ("Top-level after resolve: \n" ++ render (nest 4 (vpr (tsigsOf bs3))))
+                                     return (Module v ns xs ds1 (dom weqs1 ++ ws) (groupBinds (concatBinds [bs1,bs2,bs3])))
+    where bs                    = concatBinds bss
+          weqs                  = restrict (eqnsOf bs') ws' ++ restrict (eqnsOf bs) ws
+          pe                    = restrict (tsigsOf bs) ws
+          pe'                   = restrict (tsigsOf bs') ws'
+          env0                  = addTEnv0 (tsigsOf bs') (impDecls (initEnv v) ds')
+
+
+tiBindsList env []              = return ([], [], nullBinds)
+tiBindsList env (bs:bss)        = do (ss1, pe1, bs1) <- tiBinds env bs
+                                     (ss2, pe2, bs2) <- tiBindsList (addTEnv (tsigsOf bs1) env) bss
+                                     return (ss1++ss2, pe1++pe2, bs1 `catBinds` bs2)
+
+                                     
+tiBinds env (Binds _ [] [])     = return ([], [], nullBinds)
+tiBinds env (Binds rec te eqs)  = do -- tr ("TYPE-CHECKING " ++ showids xs ++ ", at line: " ++ show (pos (fst(head te))))
+                                     -- tr (render (nest 8 (vpr te)))
+                                     -- tr ("assuming\n" ++ render (nest 4 (vpr (typeEnv env))))
+                                     (s,pe,es1)   <- tiRhs0 (addTEnv te env) explWits ts es
+                                     -- tr ("RESULT (" ++ showids xs ++ "):\n" ++ render (nest 8 (vpr pe)))
+                                     -- tr ("EXPS:\n" ++ render (nest 8 (vpr es1)))
+                                     (s',qe,f) <- fullreduce (target te (setErrPos (posInfo es) env)) s pe `handle` (fail . tail)
+                                     -- tr ("PREDICATES OBTAINED (" ++ showids xs ++ "):\n" ++ render (nest 8 (vpr qe)))
+                                     let env1      = subst s' env
+                                         ts1       = subst s' ts
+                                         tvs0      = if mono then tvars qe ++ tvs1 else []
+                                         tvs1      = concat [ tvars t | (t,e) <- ts1 `zip` es, isNewAp e ]
+                                         (qe1,qe2) = if mono then (qe,[]) else partition (isFixed (tevars env1)) qe
+                                         (vs,qs)   = unzip qe2
+                                         es2       = map f es1
+                                         es3       = if mono || not rec || null vs then es2 else map (subst (satSubst vs)) es2
+                                         (es',ts') = if mono then (es3,ts1) else unzip (zipWith (qual qe2) es3 ts1)
+                                     -- tr ("BEFORE GEN:\n" ++ render (nest 8 (vpr (xs `zip` ts') $$ vpr qe2)))
+                                     -- Note: using genL below instead of mapM gen allows us to take a simplifying 
+                                     -- shortcut later on in Type2
+                                     ts'' <- genL (tevars env1 ++ tvs0) ts'
+                                     -- tr ("DONE " ++ render (nest 8 (vpr (xs `zip` ts''))))
+                                     -- tr ("EXPS " ++ render (nest 8 (vpr (xs `zip` es'))))
+                                     return (mkEqns env s', qe1, Binds rec (xs `zip` ts'') (xs `zip` es'))
+  where ts                      = map (lookup' te) xs
+        (xs,es)                 = unzip eqs
+        explWits                = map (explicit . annot) xs
+        satSubst []             = []
+        satSubst vs             = zipWith f xs ts
+          where es              = map EVar vs
+                f x t           = (x, eLam te (EAp (EVar x) (es ++ map EVar (dom te))))
+                  where te      = abcSupply `zip` ctxt t
+        mono                    = or [ isNewAp e || arity e == 0 && null (ctxt t) | (e,t) <- es `zip` ts ]
+
+
+tiRhs0 env explWits ts es       = do (ss,pes,es') <- fmap unzip3 (mapM (tiExpT' env) (zip3 explWits ts es))
+                                     return (concat ss, concat pes, es')
+
+tiRhs env ts es                 = tiRhs0 env (repeat False) ts es
+
+
+tiExpT env t e                  = tiExpT' env (False, t, e)
+
+
+tiExpT' env (explWit, Scheme t0 ps ke, e)
+  | isNewAp e                   = do (ss,pe,t,e') <- tiExp env e
+                                     c            <- newNamePos coercionSym e'
+                                     return (ss, (c, Scheme (F [scheme' t] t0) ps ke) : pe, EAp (EVar c) [e'])
+  | null ke && not explWit      = do (ss,qe,t,e)  <- tiExp env e
+                                     c            <- newNamePos coercionSym e
+                                     pe0          <- newEnvPos assumptionSym ps e
+                                     let ws        = map EVar (dom pe0)
+                                         e1        = eLam pe0 (EAp (eAp (EVar c) ws) [e])
+                                     return (ss, (c, Scheme (F [scheme' t] t0) ps ke) : qe, e1)
+  | otherwise                   = do (ss,qe,t,e)  <- tiExp env e
+--                                     tr ("REQUIRED: " ++ render (pr (Scheme t0 ps ke)))
+--                                     tr ("INFERRED: " ++ render (pr t) ++ "\n" ++ render (nest 4 (vpr qe)))
+                                     (s,qe,f)     <- normalize (target t (setErrPos (posInfo e) env)) ss qe `handle` (fail . tail)
+                                     c            <- newNamePos coercionSym e
+                                     pe0          <- newEnvPos assumptionSym ps e >>= wildify ke
+                                     let env1      = subst s env
+                                         (qe1,qe2) = partition (isFixed (tevars env1)) (subst s qe)
+                                         (e',t')   = qual qe2 (f e) (scheme' (subst s t))
+                                         ws        = map EVar (dom pe0)
+                                         (ws',ps') = if explWit then (ws, ps) else ([], [])
+                                         e1        = eLam pe0 (eAp (EAp (eAp (EVar c) ws) [e']) ws')
+                                     sc           <- gen (tevars env1 ++ tvars qe1) t'
+                                     return (mkEqns env1 s, (c, Scheme (F [sc] (tFun ps' t0)) ps ke) : qe1, e1)
+
+mkEqns env s                    = mapFst TVar (restrict s (tevars env))
+
+isFixed tvs (w,p)               = isDummy w || all (`elem` tvs) (tvars p)
+
+
+tiAp env s pe (F scs rho) e es
+  | len_scs >= len_es           = do (s',pe',es') <- tiRhs env scs1 es
+                                     te <- newEnv paramSym scs2
+                                     return (s++s', pe++pe', tFun scs2 rho, eLam te (EAp e (es'++map EVar (dom te))))
+  | otherwise                   = do (s',pe',es') <- tiRhs env scs es1
+                                     tiAp env (s++s') (pe++pe') rho (EAp e es') es2
+  where len_scs                 = length scs
+        len_es                  = length es
+        (scs1,scs2)             = splitAt len_es scs
+        (es1,es2)               = splitAt len_scs es
+tiAp env s pe (R (TFun ts t)) e es
+                                = tiAp env s pe (F (map scheme ts) (R t)) e es
+tiAp env s pe rho e es          = do t <- newTVar Star
+                                     c <- newNamePos coercionSym e
+                                     (ss,pes,ts,es) <- fmap unzip4 (mapM (tiExp env) es)
+                                     let p = Scheme (F [scheme' rho] (F (map scheme' ts) (R t))) [] []
+                                     return (s++concat ss, (c,p):pe++concat pes, R t, EAp (EAp (EVar c) [e]) es)
+
+etaExpand pe (R (TFun ts t)) e  = etaExpand pe (F (map scheme ts) (R t)) e
+etaExpand pe (F scs t) e        = do te <- newEnv etaExpSym scs
+                                     return ([], pe, F scs t, ELam te (EAp e (map EVar (dom te))))
+etaExpand pe t e                = return ([], pe, t, e)
+
+
+tiExp env (ELit l)              = return ([], [], R (litType l), ELit l)
+tiExp env (EVar x)
+  | doEtaExpand x               = do (pe,t,e) <- instantiate (findExplType env x) (EVar (annotExplicit x))
+                                     etaExpand pe t e
+  | otherwise                   = do (pe,t,e) <- instantiate (findExplType env x) (EVar (annotExplicit x))
+                                     return ([], pe, t, e)
+tiExp env (ECon k)              = do (pe,t,e) <- instantiate (findExplType env k) (ECon (annotExplicit k))
+                                     etaExpand pe t e
+tiExp env (ESel e l)            = do (t, t0:ps) <- inst (findType env l)
+                                     (s,pe,e) <- tiExpT env t0 e
+                                     let r = if explicit (annot l) then (tFun ps t,[]) else (t,ps)
+                                     (pe',t',e') <- saturate r (ESel e (annotExplicit l))
+                                     return (s, pe++pe', t', e')
+tiExp env (ELam te e)           = do (s,pe,t,e) <- tiExp (addTEnv te env) e
+                                     return (s, pe, F (rng te) t, ELam te e)
+tiExp env (EAp e es)            = do (s,pe,t,e) <- tiExp env e
+                                     tiAp env s pe t e es
+tiExp env (ELet bs e)           = do (s,pe,bs) <- tiBinds env bs
+                                     (s',pe',t,e) <- tiExp (addTEnv (tsigsOf bs) env) e
+                                     return (s++s',pe++pe', t, ELet bs e)
+tiExp env (ERec c eqs)          = do alphas <- mapM newTVar (kArgs (findKind env c))
+                                     (t,ts,_) <- tiLhs env (foldl TAp (TId c) alphas) tiSel sels
+                                     (s,pe,es') <- tiRhs env ts es
+                                     -- tr ("RECORD " ++ render (pr t))
+                                     -- tr (render (nest 4 (vpr (sels `zip` ts))))
+                                     -- tr ("    pe :\n" ++ render (nest 4 (vpr pe)))
+                                     e <- mkRecTerm env c sels es'
+                                     return (s, pe, R t, e)
+  where (sels,es)               = unzip eqs
+        tiSel env x l           = tiExp env (ESel (EVar x) l)
+tiExp env (ECase e alts)        = do alpha <- newTVar Star
+                                     (t,ts,_) <- tiLhs env alpha tiPat pats
+                                     (s,pe,es')   <- tiRhs env ts es
+                                     let TFun [t0] t1 = t
+                                     (s1,pe1,e')  <- tiExpT env (scheme t0) e
+                                     e <- mkCaseTerm env e' (tId (tHead t0)) pats es'
+                                     return (s++s1, pe++pe1, R t1, e)
+  where (pats,es)               = unzip alts
+        tiPat env x (PLit l)    = tiExp env (EAp (EVar x) [ELit l])
+        tiPat env x (PCon k)    = do (t,_) <- inst (findType env k)
+                                     te <- newEnv paramSym (funArgs t)
+                                     tiExp env (eLam te (EAp (EVar x) [eAp (ECon k) (map EVar (dom te))]))
+        tiPat env x (PWild)     = do y <- newName tempSym
+                                     t <- newTVar Star
+                                     tiExp (addTEnv [(y,scheme t)] env) (EAp (EVar x) [EVar y])
+tiExp env (EReq e e')           = do alpha <- newTVar Star
+                                     beta <- newTVar Star
+                                     (s,pe,e) <- tiExpT env (scheme (tRef alpha)) e
+                                     (s',pe',e') <- tiExpT env (scheme (tCmd alpha beta)) e'
+                                     return (s++s', pe++pe', R (tRequest beta), EReq e e')
+tiExp env (EAct e e')           = do alpha <- newTVar Star
+                                     beta <- newTVar Star
+                                     (s,pe,e) <- tiExpT env (scheme (tRef alpha)) e
+                                     (s',pe',e') <- tiExpT env (scheme (tCmd alpha beta)) e'
+                                     return (s++s', pe++pe', R tAction, EAct e e')
+tiExp env (EDo x tx c)
+  | isTVar tx                   = do (s,pe,t,c) <- tiCmd (setSelf x tx env) c
+                                     let s' = case stateT env of Nothing -> []; Just t' -> [(t',tx)]
+                                     return (s'++s, pe, R (tCmd tx t), EDo x tx c)
+  | otherwise                   = internalError0 "Explicitly typed do expressions not yet implemented"
+tiExp env (ETempl x tx te c)
+  | isTVar tx                   = do n <- newName stateTypeSym
+                                     let env' = setSelf x (TId n) (addTEnv te (addKEnv0 [(n,Star)] env))
+                                     (s,pe,t,c) <- tiCmd env' c
+                                     return ((TId n, tx):s, pe, R (tClass t), ETempl x (TId n) te c)
+  | otherwise                   = internalError0 "Explicitly typed class expressions not yet implemented"
+
+
+tiCmd env (CRet e)              = do alpha <- newTVar Star
+                                     (s,pe,e) <- tiExpT env (scheme alpha) e
+                                     return (s, pe, alpha, CRet e)
+tiCmd env (CExp e)              = do alpha <- newTVar Star
+                                     (s,pe,e) <- tiExpT env (scheme (tCmd (fromJust (stateT env)) alpha)) e
+                                     return (s, pe, alpha, CExp e)
+tiCmd env (CGen x tx e c)       = do (s,pe,e) <- tiExpT env (scheme (tCmd (fromJust (stateT env)) tx)) e
+                                     (s',pe',t,c) <- tiCmd (addTEnv [(x,scheme tx)] env) c
+                                     return (s++s', pe++pe', t, CGen x tx e c)
+tiCmd env (CAss x e c)          = do (s,pe,e) <- tiExpT env (findType env x) e
+                                     (s',pe',t,c) <- tiCmd env c
+                                     return (s++s', pe++pe', t, CAss x e c)
+tiCmd env (CLet bs c)           = do (s,pe,bs) <- tiBinds env bs
+                                     (s',pe',t,c) <- tiCmd (addTEnv (tsigsOf bs) env) c
+                                     return (s++s', pe++pe', t, CLet bs c)
+
+
+-- Compute a list of
+tiLhs env alpha tiX xs          = do x <- newName tempSym
+                                     let env' = addTEnv [(x,scheme alpha)] env
+                                     (_,pes,ts,es) <- fmap unzip4 (mapM (tiX env' x) xs)    -- ignore returned substs (must be null)
+                                     (s,_,f) <- resolve (target alpha env) (concat pes)     -- ignore returned qe (filter pes instead)
+                                     let ts1 = map scheme' (subst s ts)
+                                         es1 = map f es
+                                         pes1 = subst s (map (filter (not . isCoercion . fst)) pes) -- preserve non-coercions for each alt
+                                         (es2,ts2) = unzip (zipWith3 qual pes1 es1 ts1)
+                                     ts3 <- genL (tevars (subst s env')) ts2
+                                     es2 <- mapM (redTerm (coercions env)) es2
+                                     return (subst s alpha, ts3, es2)
+
+
+-- Build a record term ---------------------------------------------------------------------------------------------------
+mkRecTerm env c sels es         = return (mkOne c)
+  where cs                      = map ltype sels
+        groups                  = map (\c -> (c, [ (l,e) | (c',l,e) <- zip3 cs sels es, c == c' ])) (nub cs)
+        graph                   = nodesFrom c
+        nodesFrom c             = (c,ns) : concatMap nodesFrom (rng ns)
+          where ns              = [ (sel w, snd (subsyms p)) | (w,p) <- nodes wg, w `notElem` indirect ]
+                indirect        = map snd (arcs wg)
+                sel w           = ff (lookup' (coercions env) w)
+                wg              = findAbove env c
+        ff (ELam _ (ESel _ l))  = l
+        ltype l                 = headsym (head (ctxt (findType env l)))
+        mkOne c                 = ERec c (eqs0 ++ case lookup c groups of Just eqs -> eqs; Nothing -> [])
+          where eqs0            = mapSnd mkOne (lookup' graph c)
+
+
+-- Build a case term -------------------------------------------------------------------------------------------------------
+mkCaseTerm env e0 c pats0 es0
+  | any isLitPat pats0          = return (ECase e0 (pats0 `zip` es0))
+  | otherwise                   = mkOne e0 c
+  where (altsK,altsW)           = partition (isConPat . fst) (pats0 `zip` es0)
+        (pats,es)               = unzip altsK
+        cs                      = map ptype pats
+        groups                  = map (\c -> (c, [ (p,e) | (c',p,e) <- zip3 cs pats es, c == c' ])) (nub cs)
+        graph                   = nodesFrom c
+        nodesFrom c             = (c,ns) : concatMap nodesFrom (rng ns)
+          where ns              = [ (con w, fst (subsyms p)) | (w,p) <- nodes wg, w `notElem` indirect ]
+                indirect        = map snd (arcs wg)
+                con w           = ff (lookup' (coercions env) w)
+                wg              = findBelow env c
+        ff (ELam _ (EAp (ECon k) _)) = k
+        ptype (PCon k)          = tId (tHead (body (findType env k)))
+        mkOne e0 c              = do alts0 <- mapM mkAlt0 (lookup' graph c)
+                                     return (ECase e0 (alts0 ++ (case lookup c groups of Just alts -> alts; Nothing -> []) ++ altsW))
+        mkAlt0 (k,c)            = do x <- newName tempSym
+                                     (F [sc] _, _) <- inst (findType env k)
+                                     e <- mkOne (EVar x) c
+                                     return (PCon k, ELam [(x,sc)] e)
+
+        
+
+-- data Pack m a = Pack (m a) \\ Eq a
+-- data Exists m > Pack m a \\ a
+--               = Test (m Int)
+
+-- Translation 1:
+-- data Pack m a = Pack (m a) \\ Eq a
+-- data Exists m = Exists_from_Pack (Pack m a) \\ a
+--               | Test (m Int)
+
+-- Translation 2:
+-- data Pack m a = Pack (Eq a) (m a)
+-- data Exists m = Exists_from_Pack (Pack m a) \\ a
+--               | Test (m Int)
+
+-- Constructor types:
+-- Pack             :: Eq a -> m a -> Pack m a \\ a, m
+-- Exists_from_Pack :: Pack (m a) -> Exists m \\ a, m
+-- Test             :: m Int -> Exists m \\ m
+
+-- case e0 of
+--   Pack -> (\w r -> e1)
+--   Test -> (\q -> e2
+
+-- case e0 of
+--   Exixts_from_Pack -> (\x -> case x of
+--                                Pack -> (\w r -> e1)
+--                                _    -> fail
+--   Test             -> (\q -> e2)
+
+
+-- Formulation without subtyping: ------------------------------
+--
+-- data Exists m = Pack (m a) \\ Eq a, a
+--               | Test (m Int)
+
+-- Translation:
+-- data Exists m = Pack (Eq a) (m a) \\ a
+--               | Test (m Int)
+
+-- Constructor types:
+-- Pack  :: Eq a -> m a -> Exists m \\ a, m
+-- Test  :: m Int -> Exists m \\ m
+
+-- case e0 of
+--   Pack -> (\(w :: Eq _) (r :: _ _) -> e1)
+--   Test -> (\(q :: _ Int) -> e2)
+
+
+
+
+
+{-
+   
+    record A v
+       a :: Eq v => v -> [v]            w : Eq v |- (.a) : A v -> v -> [v]  =  \t -> t.a w
+
+    record B v < A v =
+       b :: v                                    |- (.b) : B v -> v         =  \t -> t.b
+
+
+    { a v = [v], b = 0 }
+
+    w : Eq v, ca : xx < A v |- (.a) x  :  v -> [v]  =  (\t -> t.a w) (ca x)  
+
+              cb : xx < B v |- (.b) x  :  v         =  (\t -> t.b)   (cb x)
+
+    b2a/ca, id/cb, B v / xx
+
+    w : Eq v |- (.a) x  :  v -> [v]  =  (\t -> t.a w) ((.b2a) x)   =  x.b2a.a w   =  (.a) . (.b2a) .
+
+             |- (.b) x  :  v         =  (t -> t.b)    (id x)       =  x.b
+
+
+-}
+
+{-
+
+record A =
+    a :: Ta
+
+record B < A =
+    b :: Tb
+
+record C < A =
+    c :: Tc
+
+record D < B,C =
+    d :: Td
+
+===>
+
+record A =
+    a :: Ta
+
+record B =
+    b2a :: A
+    b   :: Tb
+
+record C =
+    c2A :: A
+    c   :: Tc
+
+record D =
+    d2b :: B
+    d2c :: C
+    d   :: Td
+
+
+D < B < A
+D < C < A
+
+{ a|b2a|d2b = Ma
+  a|c2a|d2c = Ma
+  b|d2b     = Mb         :: D
+  c|d2c     = Mc
+  d         = Md
+}
+
+{ d2b = { b2a = { a = Ma }
+          b   = Mb }
+  d2c = { c2a = { a = Ma }
+          c   = Mc }
+  d   = Md }
+
+        A
+      /   \
+     B     C
+      \   /
+        D
+
+{ B2A -> { D2B -> { D -> \x.Md }
+           B   -> \x.Mb }
+  C2A -> { D2C -> { D -> \x.Md }
+           C   -> \x.Mc }
+  A   -> \x.Ma }
+
+{ B2A|D2B|D -> \x.Md
+  C2A|D2C|D -> \x.Md
+  B2A|B     -> \x.Mb       :: A -> t
+  C2A|C     -> \x.Mc
+  A         -> \x.Ma
+}
+
+A->t < B->t < D->t
+A->t < C->t < D->t
+
+data D =
+    D Td
+
+data C > D =
+    C Tc
+
+data B > D =
+    B Rb
+
+data A > B,C =
+    a Ta
+
+===>
+
+data D =
+    D Td
+
+data C =
+    D2C D
+    C Tc
+
+data B =
+    D2B D
+    B Tb
+
+data A =
+    B2A B
+    C2A C
+    A Ta
+
+-}
diff --git a/src/Type2.hs b/src/Type2.hs
new file mode 100644
--- /dev/null
+++ b/src/Type2.hs
@@ -0,0 +1,284 @@
+-- The Timber compiler <timber-lang.org>
+--
+-- Copyright 2008 Johan Nordlander <nordland@csee.ltu.se>
+-- All rights reserved.
+-- 
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+-- 
+-- 1. Redistributions of source code must retain the above copyright
+--    notice, this list of conditions and the following disclaimer.
+-- 
+-- 2. Redistributions in binary form must reproduce the above copyright
+--    notice, this list of conditions and the following disclaimer in the
+--    documentation and/or other materials provided with the distribution.
+-- 
+-- 3. Neither the names of the copyright holder and any identified
+--    contributors, nor the names of their affiliations, may be used to 
+--    endorse or promote products derived from this software without 
+--    specific prior written permission.
+-- 
+-- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+-- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+-- DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+-- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+module Type2 where
+    
+import Common
+import Core
+import Env
+import Decls
+import PP
+
+typecheck2 e2 m                 = t2Module e2 m
+
+t2Module (xs',ds',ws',bs') (Module v ns xs ds ws bss)
+                                = do bss <- t2BindsList env2 bss
+                                     return (Module v ns xs ds ws bss)
+  where env2                    = addTEnv0 te2 (addKEnv0 ke2 env1)
+        te2                     = tenvSelsCons ds
+        ke2                     = ksigsOf ds
+        env1                    = addTEnv0 te1 (addKEnv0 ke1 env0)
+        te1                     = tsigsOf bs' ++ tenvSelsCons ds'
+        ke1                     = ksigsOf ds'
+        env0                    = addTEnv0 primPredEnv (initEnv v)
+
+t2BindsList env []              = return []
+t2BindsList env (bs:bss)        = do bs <- t2Binds0 env bs
+                                     bss <- t2BindsList (addTEnv (tsigsOf bs) env) bss
+                                     return (bs:bss)
+
+-- t2Binds0 is a variant of t2Binds that is optimized for use on the program top level, where the only free 
+-- occurrences of unification variables are in partial type signatures.  After type-checking a right-hand side,
+-- all unification variables that still remain will be generalized before a dependent binding group is checked.
+-- Thus there is no need to propagate any substitution from one top-level binding group to the next; and
+-- furthermore, the only fragment of a substitution that can possibly affect the type of a binding whithin
+-- the *same* group must have the free unification variables of the corresponding type signature as its domain.
+-- Hence the restriction of s1 to the tvars of sc below.  Note: this optimization has considerable impact on
+-- the efficiency of the Type2 pass!
+-- Another difference between t2Binds0 and t2Binds is that t2Binds0 also applies the computed substitution to
+-- the top-level *term* of a binding, so that nested signatures inside the right-hand side term may be properly 
+-- updated and named according to System F-like principles.  Note that this is done as early as possible 
+-- (immediately after a right-hand side has been checked), in order to allow the computed substitution to be 
+-- restricted before it is applied to any sibling bindings.
+
+t2Binds0 env (Binds r te eqs)   = do (s,eqs') <- t2Eqs eqs
+                                     scs' <- mapM (t2Gen (tevars env)) (subst s scs)
+                                     return (Binds r (xs `zip` scs') eqs')
+  where env1                    = addTEnv te env
+        (xs,scs)                = unzip te
+        t2Eqs []                = return (nullSubst, [])
+        t2Eqs ((x,e):eqs)       = do (s1,e) <- t2ExpTscoped env1 sc e
+                                     (s2,eqs) <- t2Eqs eqs
+                                     return (mergeSubsts [restrict s1 (tvars sc),s2], (x, subst s1 e):eqs)
+          where sc              = lookup' te x
+
+
+t2Binds env (Binds r te eqs)    = do (s,eqs') <- t2Eqs eqs
+                                     let scs1 = subst s scs
+                                         tvs0 = concat [ tvars sc | (sc,eq) <- scs1 `zip` eqs, isNewAp (snd eq) ]
+                                     scs2 <- mapM (t2Gen (tevars (subst s env) ++ tvs0)) (subst s scs1)
+                                     return (s, Binds r (xs `zip` scs2) eqs')
+  where env1                    = addTEnv te env
+        (xs,scs)                = unzip te
+        t2Eqs []                = return (nullSubst, [])
+        t2Eqs ((x,e):eqs)       = do (s1,e) <- t2ExpTscoped env1 sc e
+                                     (s2,eqs) <- t2Eqs eqs
+                                     return (mergeSubsts [s1,s2], (x,e):eqs)
+          where sc              = lookup' te x
+
+
+-- Note: the program is known to be typeable at this point, thus there is no need to generalize, freshly 
+-- instantiate, and then match an inferred type against a skolemized version of the expected type scheme 
+-- (together with checking for escaping skolem variables).  Instead, all we need to ensure is that any 
+-- type equalities implied by the match are captured in the resulting substitution, treating all-quantified 
+-- variables as scoped constants once we are inside the scope of a type signature (t2ExpTscoped), or using
+-- a freshly alpha-converted copy when matching against a polymorphic signature whose bound variables are
+-- not in scope (t2ExpT).
+-- 
+-- Moreover, in order to enable subsequent translation into the System F-like type system of Kindle, the
+-- type abstraction and application points are encoded in the resulting terms as uniquely shaped let-bindings.
+
+t2ExpTscoped env sc e           = do (s1,rh,e) <- t2Exp env e
+                                     s2 <- mgi rh (quickSkolem sc)
+                                     e <- encodeTAbs env (quant sc) e
+                                     return (mergeSubsts [s1,s2], e)
+                                     
+
+t2ExpT env (Scheme t qs []) e   = t2ExpTscoped env (Scheme t qs []) e
+t2ExpT env sc e                 = do sc' <- ac nullSubst sc
+                                     t2ExpTscoped env sc' e
+
+
+t2ExpTs env [] []               = return (nullSubst, [])
+t2ExpTs env (sc:scs) (e:es)     = do (s1,e) <- t2ExpT env sc e
+                                     (s2,es) <- t2ExpTs env scs es       
+                                     return (mergeSubsts [s1,s2], e:es)
+
+
+t2Exps env []                   = return (nullSubst, [], [])
+t2Exps env (e:es)               = do (s1,t,e) <- t2Exp env e
+                                     (s2,ts,es) <- t2Exps env es
+                                     let s = mergeSubsts [s1,s2]
+                                     return (s, subst s (t:ts), e:es)
+                                      
+
+t2Exp env (ELit l)              = return (nullSubst, R (litType l), ELit l)
+t2Exp env (EVar x)              = do (rh,ts) <- t2Inst (findType env x)
+                                     e <- encodeTApp env ts (EVar x)
+                                     return (nullSubst, rh, e)
+t2Exp env (ECon k)              = do (rh,ts) <- t2Inst (findType env k)
+                                     e <- encodeTApp env ts (ECon k)
+                                     return (nullSubst, rh, e)
+t2Exp env (ESel e l)            = do (F (sc:scs) rh,ts) <- t2Inst (findType env l)
+                                     (s,e) <- t2ExpT env sc e
+                                     e' <- encodeTApp env ts (ESel e l)     -- NOTE: the *full* instantiation of l is remembered here,
+                                     return (s, subst s (tFun scs rh), e')  -- including the actual struct type arguments (C.f.: c2k.cExp)
+t2Exp env (ELam te e)           = do (s,rh,e) <- t2Exp (addTEnv te env) e
+                                     return (s, F (subst s (rng te)) rh, ELam te e)
+t2Exp env (EAp e es)            = do (s,rh,e) <- t2Exp env e
+                                     t2Ap env s rh e es
+t2Exp env (ELet bs e)           = do (s1,bs) <- t2Binds env bs
+                                     (s2,rh,e) <- t2Exp (addTEnv (subst s1 (tsigsOf bs)) env) e
+                                     return (mergeSubsts [s1,s2], rh, ELet bs e)
+t2Exp env (ERec c eqs)          = do alphas <- mapM newTVar (kArgs (findKind env c))
+                                     (t,scs) <- t2Lhs env (foldl TAp (TId c) alphas) t2Sel ls
+                                     (s,es) <- t2ExpTs env scs es
+                                     e <- encodeTApp env (snd (tFlat t)) (ERec c (ls `zip` es))
+                                     return (s, R (subst s t), e)
+  where (ls,es)                 = unzip eqs
+        t2Sel env x l           = t2Exp env (ESel (EVar x) l)
+t2Exp env (ECase e alts)        = do alpha <- newTVar Star
+                                     (TFun [t0] t1,scs) <- t2Lhs env alpha t2Pat ps
+                                     (s0,e) <- t2ExpT env (scheme t0) e
+                                     (s1,es) <- t2ExpTs env scs es
+                                     let s = mergeSubsts [s0,s1]
+                                     return (s, R (subst s t1), ECase e (ps `zip` es))
+  where (ps,es)                 = unzip alts
+        t2Pat env x (PLit l)    = t2Exp env (EAp (EVar x) [ELit l])
+        t2Pat env x (PCon k)    = do (rh,_) <- t2Inst (findType env k)
+                                     te <- newEnv paramSym (funArgs rh)
+                                     t2Exp env (eLam te (EAp (EVar x) [eAp (ECon k) (map EVar (dom te))]))
+        t2Pat env x (PWild)     = do y <- newName tempSym
+                                     t <- newTVar Star
+                                     t2Exp (addTEnv [(y,scheme t)] env) (EAp (EVar x) [EVar y])
+t2Exp env (EReq e1 e2)          = do alpha <- newTVar Star
+                                     beta <- newTVar Star
+                                     (s1,e1) <- t2ExpT env (scheme (tRef alpha)) e1
+                                     (s2,e2) <- t2ExpT env (scheme (tCmd alpha beta)) e2
+                                     let s = mergeSubsts [s1,s2]
+                                     return (s, R (tRequest (subst s beta)), EReq e1 e2)
+t2Exp env (EAct e1 e2)          = do alpha <- newTVar Star
+                                     beta <- newTVar Star
+                                     (s1,e1) <- t2ExpT env (scheme (tRef alpha)) e1
+                                     (s2,e2) <- t2ExpT env (scheme (tCmd alpha beta)) e2
+                                     let s = mergeSubsts [s1,s2]
+                                     return (s, R tAction, EAct e1 e2)
+t2Exp env (EDo x tx c)          = do (s1,t,c) <- t2Cmd (setSelf x tx env) c
+                                     let s2 = case stateT env of Nothing -> nullSubst; Just t' -> unif [(t',tx)]
+                                         s = mergeSubsts [s1,s2]
+                                     return (s, R (subst s (tCmd tx t)), EDo x tx c)
+t2Exp env (ETempl x tx te c)    = do (s,t,c) <- t2Cmd (setSelf x tx (addTEnv te env)) c
+                                     return (s, R (tClass t), ETempl x tx te c)
+
+        
+t2Cmd env (CRet e)              = do alpha <- newTVar Star
+                                     (s,e) <- t2ExpT env (scheme alpha) e
+                                     return (s, subst s alpha, CRet e)
+t2Cmd env (CExp e)              = do alpha <- newTVar Star
+                                     (s,e) <- t2ExpT env (scheme (tCmd (fromJust (stateT env)) alpha)) e
+                                     return (s, subst s alpha, CExp e)
+t2Cmd env (CGen x tx e c)       = do (s1,e) <- t2ExpT env (scheme (tCmd (fromJust (stateT env)) tx)) e
+                                     (s2,t,c) <- t2Cmd (addTEnv [(x,scheme tx)] env) c
+                                     let s = mergeSubsts [s1,s2]
+                                     return (s, subst s t, CGen x tx e c)
+t2Cmd env (CAss x e c)          = do (s1,e) <- t2ExpT env (findType env x) e
+                                     (s2,t,c) <- t2Cmd env c
+                                     let s = mergeSubsts [s1,s2]
+                                     return (s, subst s t, CAss x e c)
+t2Cmd env (CLet bs c)           = do (s1,bs) <- t2Binds env bs
+                                     (s2,t,c) <- t2Cmd (addTEnv (tsigsOf bs) env) c
+                                     let s = mergeSubsts [s1,s2]
+                                     return (s, subst s t, CLet bs c)
+
+                                     
+
+t2Ap env s1 (F scs rh) e es     = do (s2,es) <- t2ExpTs env scs es
+                                     let s = mergeSubsts [s1,s2]
+                                     return (s, subst s rh, EAp e es)
+t2Ap env s1 rh e es             = do (s2,rhs,es) <- t2Exps env es
+                                     t <- newTVar Star
+                                     s3 <- mgi rh (F (map scheme' rhs) (R t))
+                                     let s = mergeSubsts [s1,s2,s3]
+                                     return (s, R (subst s t), EAp e es)
+
+
+t2Lhs env alpha t2X xs          = do x <- newName tempSym
+                                     let env' = addTEnv [(x,scheme alpha)] env
+                                     (ss,rhs,_) <- fmap unzip3 (mapM (t2X env' x) xs)
+                                     let s = mergeSubsts ss
+                                     scs <- mapM (t2Gen (tevars (subst s env')) . scheme') (subst s rhs)
+                                     return (subst s alpha, scs)
+
+
+t2Gen tvs0 (Scheme rh ps ke)    = do ids <- newNames tyvarSym (length tvs)
+                                     let s = tvs `zip` map TId ids
+                                     return (Scheme (subst s rh) ps (ke ++ ids `zip` map tvKind tvs))
+  where tvs                     = nub (filter (`notElem` tvs0) (tvars rh))
+    
+
+t2Inst (Scheme rh ps ke)        = do ts <- mapM newTVar ks
+                                     return (subst (vs `zip` ts) (tFun ps rh), ts)
+  where (vs,ks)                 = unzip ke
+
+
+
+-- Skolemize a type scheme, relying on the uniqueness of all bound type variables
+quickSkolem (Scheme rh ps ke)   = tFun ps rh
+
+
+mgi (R t) (R u)                 = return (unif [(t,u)])
+mgi (F ts t) (F us u)           = do s <- mgi t u
+                                     ss <- mapM mgiSc (us `zip` ts)
+                                     return (mergeSubsts (s:ss))
+mgi (R (TFun ts t)) rh          = mgi (F (map scheme ts) (R t)) rh
+mgi rh (R (TFun us u))          = mgi rh (F (map scheme us) (R u))
+mgi (R t) (F us u)              = do (t':ts) <- mapM newTVar (replicate (length us + 1) Star)
+                                     let s1 = unif [(t,TFun ts t')]
+                                     s2 <- mgi (R (subst s1 t)) (F us u)
+                                     return (s2@@s1)
+mgi (F ts t) (R u)              = do (u':us) <- mapM newTVar (replicate (length ts + 1) Star)
+                                     let s1 = unif [(u,TFun us u')]
+                                     s2 <- mgi (F ts t) (R (subst s1 u))
+                                     return (s2@@s1)
+
+
+mgiSc (Scheme rh [] [], Scheme rh' [] [])
+                                = mgi rh rh'
+mgiSc (sc, sc')                 = do (rh,_) <- t2Inst sc
+                                     mgi rh (quickSkolem sc')
+
+
+unif []                         = nullSubst
+unif ((TVar n,t):eqs)
+  | t == TVar n                 = unif eqs
+  | otherwise                   = let s = n +-> t; s' = unif (subst s eqs) in s' @@ s
+unif ((t,TVar n):eqs)           = let s = n +-> t; s' = unif (subst s eqs) in s' @@ s
+unif ((TAp t u, TAp t' u'):eqs) = unif ((t,t'):(u,u'):eqs)
+unif ((TId c, TId c'):eqs)
+  | c == c'                     = unif eqs
+unif ((TFun ts t, TFun us u):eqs)
+  | length ts == length us      = unif ((t,u) : (ts `zip` us) ++ eqs)
+unif eqs                        = internalError0 ("Type2.unif " ++ show eqs)
+
+
+mergeSubsts ss                  = unif (mapFst TVar (concat ss))
diff --git a/timberc.cabal b/timberc.cabal
new file mode 100644
--- /dev/null
+++ b/timberc.cabal
@@ -0,0 +1,97 @@
+Name:                timberc
+Version:             1.0.1
+Synopsis:            The Timber Compiler.
+Description:         This is a compiler for a strict and pure functional 
+		     language
+License:             BSD3
+License-file:        LICENSE
+Author:              Johan Nordlander
+Maintainer:          Johan Nordlander <nordland@csee.ltu.se>
+Homepage:	     http://www.timber-lang.org
+Build-type:	     Simple
+Cabal-Version:       >= 1.4
+extra-tmp-files:     config.log config.status 
+data-files:          examples/Counter.t,
+                     examples/Echo.t,
+                     examples/Echo2.t,
+                     examples/Echo3.t,
+                     examples/EchoServer.t,
+                     examples/EchoServer2.t,
+                     examples/MasterMind.t,
+                     examples/PingTimeServers.t,
+                     examples/Primes.t,
+                     examples/Reflex.t,
+                     examples/TCPClient.t,
+                     examples/UnionFind.t,
+                     examples/Makefile,
+                     include/arrays.c,
+                     include/float.c,
+                     include/timber.c,
+                     include/timber.h,
+                     lib/BitOps.t,
+                     lib/Data.Functional.List.t,
+                     lib/Data.Objects.Dictionary.t,
+                     lib/Data.Objects.Stack.t, 
+                     lib/POSIX.t,
+                     lib/Prelude.t,
+                     lib/RandomGenerator.t
+
+extra-source-files:  rtsPOSIX/Makefile.in,
+                     rtsPOSIX/configure,
+                     rtsPOSIX/config.guess,
+                     rtsPOSIX/config.sub,
+                     rtsPOSIX/config.h.in,
+                     rtsPOSIX/cyclic.c,
+                     rtsPOSIX/env.c,
+                     rtsPOSIX/env.h,
+                     rtsPOSIX/gc.c,
+                     rtsPOSIX/install-sh,
+                     rtsPOSIX/main.c,
+                     rtsPOSIX/rts.c,
+                     rtsPOSIX/rts.h,
+                     rtsPOSIX/timberc.cfg.in,
+                     rtsPOSIX/timer.c,
+                     timberc.spec
+
+
+Executable timberc
+  Main-is:           Main.hs
+  Build-Depends:     base >= 4, haskell98, pretty >= 1.0.0.0, binary >= 0.4.2, 
+                     mtl >= 1.1, filepath >= 1.1, array >= 0.1,
+                     bzlib >= 0.4.0.0, bytestring >= 0.9
+  build-tools:	     happy >= 1.18
+  hs-source-dirs:    src
+  other-modules:     Common,
+                     Config,
+                     Core,
+                     Core2Kindle,
+                     Decls,
+                     Depend,
+                     Derive,
+                     Desugar1,
+                     Desugar2,
+                     Env,
+                     Execution,
+                     Fixity,
+                     Interfaces,
+                     Kind,
+                     Kindle,
+                     Kindle2C,
+                     Kindlered,
+                     Lambdalift,
+                     Lexer,
+                     Match,
+                     Name,
+                     ParseMonad,
+                     Parser,
+                     PP,
+                     Prepare4C,
+                     Reduce,
+                     Rename,
+                     Syntax,
+                     Syntax2Core,
+                     Termred,
+                     Token,
+                     Type,
+                     Type2
+
diff --git a/timberc.spec b/timberc.spec
new file mode 100644
--- /dev/null
+++ b/timberc.spec
@@ -0,0 +1,83 @@
+# RPM spec file for timberc				         -*-rpm-spec-*-
+#
+# This file is subject to the same free software license as timberc.
+#
+# Copyright 2008, Peter A. Jonsson
+#
+# This file was derived from ghc.spec.in
+
+%define name    timberc
+%define version 1.0.1
+%define release 1
+
+Name:           %{name}
+Version:        %{version}
+Release:        %{release}
+License:        BSD-like
+Group:          Development/Languages/Timber
+URL:            http://timber-lang.org
+Source0:        http://timber-lang.org/dist/timberc-%{version}.tar.gz
+Packager:       Peter A. Jonsson <pj@csee.ltu.se>
+BuildRoot:      %{_tmppath}/%{name}-%{version}-build
+BuildRequires:  happy >= 1.18, ghc >= 6.10.1 
+Provides:       timber
+Summary:        The Timber Compiler
+
+%description
+
+%prep
+%setup -b0
+
+%build
+
+runhaskell Setup configure --prefix=%{_prefix}
+runhaskell Setup build
+
+%install
+
+runhaskell Setup copy --destdir=%{_tmppath}/%{name}-%{version}-build
+mv %{_tmppath}/%{name}-%{version}-build/%{_bindir}/timberc %{_tmppath}/%{name}-%{version}-build/%{_datadir}/timberc-%{version}/timberc
+
+
+# Ugly hack: construct a temporary bin/timberc by hand to build the RTS.
+SCRIPT="%{_bindir}/timberc"
+SCRIPT_TMP="%{_tmppath}/%{name}-%{version}-build/$SCRIPT"
+DATADIR="%{_datadir}/timberc-%{version}"
+DATADIR_TMP="%{_tmppath}/%{name}-%{version}-build/$DATADIR"
+
+echo "#!/bin/sh" > $SCRIPT_TMP
+echo " " >> $SCRIPT_TMP
+echo "exec $DATADIR_TMP/timberc \${1+\"\$@\"} --datadir $DATADIR_TMP" >> $SCRIPT_TMP
+chmod 755 $SCRIPT_TMP
+
+cd rtsPOSIX
+sh ./configure --prefix=$DATADIR --with-timberc=$SCRIPT_TMP
+make DESTDIR=%{_tmppath}/%{name}-%{version}-build install
+cd ..
+
+# We're done with the temporary thing. Now make a real one.
+rm $SCRIPT_TMP
+echo "#!/bin/sh" > $SCRIPT_TMP
+echo " " >> $SCRIPT_TMP
+echo "exec $DATADIR/timberc \${1+\"\$@\"} --datadir $DATADIR" >> $SCRIPT_TMP
+chmod 755 $SCRIPT_TMP
+
+%clean
+rm -rf ${RPM_BUILD_ROOT}
+
+%post
+# We should perhaps register as a Haskell package.
+
+%preun
+# If we register in post we should unregister here.
+
+%files 
+%defattr(-,root,root)
+%doc %{_prefix}/share/doc/timberc-%{version}/*
+%{_prefix}/bin/timberc
+%{_prefix}/share/timberc-%{version}/timberc
+%{_prefix}/share/timberc-%{version}/rtsPOSIX/*
+%{_prefix}/share/timberc-%{version}/examples/*
+%{_prefix}/share/timberc-%{version}/include/*
+%{_prefix}/share/timberc-%{version}/lib/*
+