[project @ 2001-02-26 15:44:59 by rrt]

ILX back-end. WARNING: this is code copied in that was previously added to
4.06. It's not remotely sane to try to compile it at the moment; that's what
I've got to do next. Don't worry, it's all #ifdefed at the moment.

36 files changed, 4771 insertions, 0 deletions

diff --git a/ghc/compiler/ilxGen/Entry.ilx b/ghc/compiler/ilxGen/Entry.ilx
new file mode 100644
index 0000000000..fe8b618934
--- /dev/null
+++ b/ghc/compiler/ilxGen/Entry.ilx
@@ -0,0 +1,57 @@
+.assembly test { }
+// ENTRYPOINT
+.class MainMain { 
+   .method public static void Main(class [mscorlib]System.String[]) {
+       .entrypoint
+           ldstr "LOG: loading main value\n"   call void [mscorlib]System.Console::WriteLine(class [mscorlib]System.String)
+      ldsfld (func () --> class [ilx std]'()') class Main::'Main_main'
+
+           ldstr "LOG: evaluating main value\n"
+           call void [mscorlib]System.Console::WriteLine(class [mscorlib]System.String) 
+      callfunc --> (func () --> class [ilx std]PrelBase_Z0T)
+           ldstr "LOG: calling main value\n"
+           call void [mscorlib]System.Console::WriteLine(class [mscorlib]System.String) 
+      ldvoid
+      callfunc (void) --> class [ilx std]PrelBase_Z0T
+
+      pop
+
+
+// HACK HACK HACK
+// Call the "finalizers" for stdin, stdout and stderr, because COM+ doesn't 
+// guarantee that finalizers will be run. WE DON'T GUARANTEE TO RUN ANY
+// OTHER FINALIZERS...
+
+      ldstr "LOG: calling critical finalizers manually in main()\n"
+           call void [mscorlib]System.Console::WriteLine(class [mscorlib]System.String)
+
+ldsfld (func (thunk<class [ilx std]PrelIOBase_MVar<class [ilx std]PrelIOBase_Handle__>>) --> (func () --> class [ilx std]PrelBase_Z0T))  [ilx std]'PrelHandle'::'PrelHandle_stdHandleFinalizzer'
+ldsfld thunk<class [ilx std]PrelIOBase_MVar<class [ilx std]PrelIOBase_Handle__>>  [ilx std]'PrelHandle'::'PrelHandle_stdin'
+      callfunc (thunk<class [ilx std]PrelIOBase_MVar<class [ilx std]PrelIOBase_Handle__>>) --> (func () -->  class [ilx std]PrelBase_Z0T)
+      callfunc --> (func () --> class [ilx std]PrelBase_Z0T)
+      ldvoid
+      callfunc (void) --> class [ilx std]PrelBase_Z0T
+      pop
+
+ldsfld (func (thunk<class [ilx std]PrelIOBase_MVar<class [ilx std]PrelIOBase_Handle__>>) --> (func () --> class [ilx std]PrelBase_Z0T))  [ilx std]'PrelHandle'::'PrelHandle_stdHandleFinalizzer'
+ldsfld thunk<class [ilx std]PrelIOBase_MVar<class [ilx std]PrelIOBase_Handle__>>  [ilx std]'PrelHandle'::'PrelHandle_stdout'
+      callfunc (thunk<class [ilx std]PrelIOBase_MVar<class [ilx std]PrelIOBase_Handle__>>) --> (func () -->  class [ilx std]PrelBase_Z0T)
+      callfunc --> (func () --> class [ilx std]PrelBase_Z0T)
+      ldvoid
+      callfunc (void) --> class [ilx std]PrelBase_Z0T
+      pop
+
+ldsfld (func (thunk<class [ilx std]PrelIOBase_MVar<class [ilx std]PrelIOBase_Handle__>>) --> (func () --> class [ilx std]PrelBase_Z0T))  [ilx std]'PrelHandle'::'PrelHandle_stdHandleFinalizzer'
+ldsfld thunk<class [ilx std]PrelIOBase_MVar<class [ilx std]PrelIOBase_Handle__>>  [ilx std]'PrelHandle'::'PrelHandle_stderr'
+      callfunc (thunk<class [ilx std]PrelIOBase_MVar<class [ilx std]PrelIOBase_Handle__>>) --> (func () -->  class [ilx std]PrelBase_Z0T)
+      callfunc --> (func () --> class [ilx std]PrelBase_Z0T)
+      ldvoid
+      callfunc (void) --> class [ilx std]PrelBase_Z0T
+      pop
+
+      ldstr "LOG: exit main()\n"
+           call void [mscorlib]System.Console::WriteLine(class [mscorlib]System.String)
+      ret
+   }
+}
+
diff --git a/ghc/compiler/ilxGen/IlxGen.lhs b/ghc/compiler/ilxGen/IlxGen.lhs
new file mode 100644
index 0000000000..02d068986e
--- /dev/null
+++ b/ghc/compiler/ilxGen/IlxGen.lhs
@@ -0,0 +1,2074 @@
+%
+\section{Generate COM+ extended assembler}
+
+\begin{code}
+module IlxGen( ilxGen ) where
+
+#include "HsVersions.h"
+
+import Char	( ord, chr )
+import StgSyn
+import Id	( idType, idName, isDeadBinder, idPrimRep, idArityInfo )
+import IdInfo   ( arityLowerBound )
+import Var	( Var, Id, TyVar, isId, isTyVar, tyVarKind, tyVarName )
+import VarEnv
+import TyCon	( TyCon,  tyConPrimRep, isUnboxedTupleTyCon, tyConDataCons, newTyConRep, tyConTyVars, isDataTyCon, isAlgTyCon )
+import Class	( Class,  classTyCon )
+import Type	( isUnboxedTupleType, isUnLiftedType, isTyVarTy, mkTyVarTy, splitForAllTys, splitFunTys, applyTy, splitNewType_maybe, applyTys,typeKind,getTyVar )
+import TypeRep	( Type(..), boxedKind,boxedTypeKind,openTypeKind,anyBoxKind, unboxedTypeKind )
+import DataCon	( isUnboxedTupleCon, dataConTyCon, dataConRepType, dataConRepArgTys )
+import Literal	( Literal(..), literalType )
+import PrimOp	( PrimOp(..), CCallTarget(..),CCall(..) )
+import PrimRep	( PrimRep(..) )
+import Name	( nameModule, nameOccName, isGlobalName, isLocalName, isDllName, NamedThing(getName) )
+import Unique	-- Lots of keys
+import FiniteMap
+import UniqFM
+import Subst    ( substTy, mkTyVarSubst )
+import Module	( Module, PackageName, ModuleName, moduleName, modulePackageName, isLocalModule, pprModuleName, mkThisModule, mkSrcModule, mkPrelModule )
+import CStrings		( CLabelString, pprCLabelString )
+import TysWiredIn ( unboxedTupleTyCon, unboxedTupleCon, mkUnboxedTupleTy )
+import Outputable
+import Char	( ord )
+import List	( partition, elem, sortBy, insertBy,any  )
+import UniqSet
+import TysPrim  ( byteArrayPrimTyCon, mutableByteArrayPrimTyCon )
+-- opt_DoEtaReduction is used to help with assembly naming conventions for different
+-- versions of compiled Haskell code.  We add a ".O" to all assembly and module 
+-- names when this is set.  One day this will be configured by the command line.
+import CmdLineOpts	( opt_Static, opt_InPackage, opt_DoEtaReduction )
+
+\end{code}
+
+
+
+%************************************************************************
+%*									*
+\subsection{Main driver}
+%*									*
+%************************************************************************
+
+\begin{code}
+ilxGen :: Module -> [TyCon] -> [Class] -> [(StgBinding,[Id])] -> SDoc
+ilxGen mod tycons classes binds_w_srts
+  =  vcat [vcat (map (ilxImportPackage topenv) (uniqSetToList import_packages)),
+            vcat (map (ilxImportModule topenv) (uniqSetToList import_modules)),
+            vcat (map (ilxImportTyCon topenv) (uniqSetToList import_tycons)),
+            vcat (map (ilxTyCon topenv) data_tycons),
+            vcat (map (ilxBindClosures topenv) binds),
+	    ilxTopBind mod topenv toppairs
+	 ]
+    where
+      binds = map fst binds_w_srts
+      (import_packages,import_modules,import_tycons) = importsBinds binds `unionImpInfo` importsPrelude
+      toppairs = ilxPairs binds
+      topenv = extendIlxEnvWithTops (emptyIlxEnv False mod) mod toppairs
+ 	-- Generate info from class decls as well
+      data_tycons = filter isDataTyCon (tycons ++ map classTyCon classes)
+\end{code}
+
+%************************************************************************
+%*									*
+\subsection{Find Imports}
+%*									*
+%************************************************************************
+
+\begin{code}
+
+importsBinds :: [StgBinding] -> ImportsInfo
+importsBinds binds = unionImpInfos (map importsBind binds)
+
+importsBind :: StgBinding -> ImportsInfo
+importsBind (StgNonRec b rhs) = importsRhs rhs  `unionImpInfo` importsVar b
+importsBind (StgRec pairs) = unionImpInfos (map (\(b,rhs) -> importsRhs rhs `unionImpInfo` importsVar b) pairs)
+
+importsRhs (StgRhsCon _ con args) = importsDataCon con   `unionImpInfo` importsStgArgs args
+importsRhs (StgRhsClosure _ _ srt _ upd args body) = importsExpr body `unionImpInfo` importsVars args
+
+importsExpr :: StgExpr -> ImportsInfo
+importsExpr (StgLit l)	 = emptyImpInfo
+importsExpr (StgApp f args) = importsVar f  `unionImpInfo` importsStgArgs args
+importsExpr (StgConApp con args) = importsDataCon con  `unionImpInfo` importsStgArgs args
+importsExpr (StgPrimApp op args res_ty) = importsType res_ty `unionImpInfo` importsStgArgs args
+importsExpr (StgSCC cc expr) = importsExpr expr
+importsExpr (StgCase scrut _ _ bndr srt alts)
+  = importsExpr scrut  `unionImpInfo` imports_alts alts  `unionImpInfo` importsVar bndr
+   where
+    imports_alts (StgAlgAlts ty alts deflt) 
+      = unionImpInfos (map imports_alg_alt alts) `unionImpInfo` imports_deflt deflt `unionImpInfo` importsType ty
+       where
+        imports_alg_alt (con, bndrs, _, rhs)
+	  = importsExpr rhs `unionImpInfo` importsDataCon con  `unionImpInfo` importsVars bndrs
+
+    imports_alts (StgPrimAlts ty alts deflt)
+      = unionImpInfos (map imports_prim_alt alts) `unionImpInfo` imports_deflt deflt `unionImpInfo` importsType ty
+       where
+        imports_prim_alt (lit, rhs) = importsExpr rhs
+    imports_deflt StgNoDefault = emptyImpInfo
+    imports_deflt (StgBindDefault rhs) = importsExpr rhs
+
+importsExpr (StgLetNoEscape _ _ bind body) = importsExpr (StgLet bind body)
+importsExpr (StgLet bind body)
+  = importsBind bind `unionImpInfo`  importsExpr body
+
+importsApp v args = importsVar v  `unionImpInfo`  importsStgArgs args
+importsStgArgs args = unionImpInfos (map importsStgArg args)
+
+importsStgArg :: StgArg -> ImportsInfo
+importsStgArg (StgTypeArg ty) = importsType ty
+importsStgArg (StgVarArg v) = importsVar v
+importsStgArg _ = emptyImpInfo
+
+importsVars vs = unionImpInfos (map importsVar vs)
+importsVar v = importsName (idName v) `unionImpInfo`  importsType (idType v)
+
+importsName n
+   | isLocalName n = emptyImpInfo
+   | thisModule == nameModule n  = emptyImpInfo
+   | isDllName n = singlePackageImpInfo (modulePackageName (nameModule n))
+   | otherwise = singleModuleImpInfo (moduleName (nameModule n))
+
+importsModule m
+   | thisModule   == m = emptyImpInfo
+   | isLocalModule m =  singleModuleImpInfo (moduleName m)
+   | otherwise       = singlePackageImpInfo (modulePackageName m)
+
+importsType :: Type -> ImportsInfo
+importsType ty = importsType2 (deepIlxRepType ty)
+
+importsType2 :: Type -> ImportsInfo
+importsType2 (AppTy f x) =  importsType2 f  `unionImpInfo`  importsType2 x
+importsType2 (TyVarTy _) = emptyImpInfo
+importsType2 (TyConApp tc args) =importsTyCon tc  `unionImpInfo` importsTypeArgs2 args
+importsType2 (FunTy arg res) =  importsType arg  `unionImpInfo`  importsType2 res
+importsType2 (ForAllTy tv body_ty) =  importsType2 body_ty
+importsType2 (NoteTy _ ty) = importsType2 ty
+importsTypeArgs2 tys =unionImpInfos (map importsType2 tys)
+
+importsDataCon dcon = importsTyCon (dataConTyCon dcon)
+importsTyCon tc | (not (isDataTyCon tc) || 
+                   isLocalName (getName tc) || 
+                   thisModule == nameModule (getName tc)) = emptyImpInfo
+importsTyCon tc | otherwise = importsName (getName tc) `unionImpInfo` (emptyUniqSet, emptyUniqSet,unitUniqSet tc)
+
+importsPrelude =
+   if preludePackage == opt_InPackage then singleModuleImpInfo (mkSrcModule "PrelGHC")
+   else singlePackageImpInfo  preludePackage
+
+
+-- hack to get at Module.preludePackage - we should reveal it....
+preludePackage 
+  =  if isLocalModule dummy then opt_InPackage else modulePackageName dummy
+   where
+      dummy = mkPrelModule (mkSrcModule "")
+
+type ImportsInfo = (UniqSet PackageName, UniqSet ModuleName, UniqSet TyCon) -- (Packages, Modules, Datatypes)
+
+emptyImpInfo :: ImportsInfo
+emptyImpInfo = (emptyUniqSet, emptyUniqSet, emptyUniqSet)
+singlePackageImpInfo p = (unitUniqSet p, emptyUniqSet, emptyUniqSet)
+singleModuleImpInfo m = (emptyUniqSet, unitUniqSet m, emptyUniqSet)
+
+unionImpInfo :: ImportsInfo -> ImportsInfo -> ImportsInfo
+unionImpInfo (w1,x1,y1) (w2,x2,y2) = (unionUniqSets w1 w2, unionUniqSets x1 x2, unionUniqSets y1 y2)
+
+unionImpInfos :: [ImportsInfo] -> ImportsInfo
+unionImpInfos fvs = foldr unionImpInfo emptyImpInfo fvs
+
+ilxImportTyCon :: IlxEnv -> TyCon -> SDoc
+ilxImportTyCon env tycon | isDataTyCon tycon = pprIlxTyConDef True env tycon
+ilxImportTyCon env tycon | otherwise =  empty
+
+ilxImportPackage :: IlxEnv -> PackageName -> SDoc
+ilxImportPackage env p = text ".assembly extern ilx" <+> singleQuotes (text (_UNPK_ p) <> hscOptionQual) <+> text "{ }"
+
+ilxImportModule :: IlxEnv -> ModuleName -> SDoc
+ilxImportModule env m = text ".module extern ilx" <+> singleQuotes (ppr m  <> hscOptionQual)
+
+
+\end{code}
+
+%************************************************************************
+%*									*
+\subsection{Type declarations}
+%*									*
+%************************************************************************
+
+\begin{code}
+
+
+ilxTyCon :: IlxEnv -> TyCon -> SDoc
+ilxTyCon env tycon =  pprIlxTyConDef False env tycon
+
+-- filter to get only dataTyCons?
+pprIlxTyConDef importing env tycon = 
+	vcat [empty $$ line,
+	      text ".classunion" <+> (if importing then text "extern" else empty) <+> text "thunk" 
+                  <+> ((nameReference env (getName tycon)) <> (ppr tycon))   <+> tyvars_text <+> alts_text]
+   where
+     tyvars = tyConTyVars tycon
+     (ilx_tvs, non_ilx_tvs) = categorizeTyVars tyvars
+     alts_env = extendIlxEnvWithFormalTyVars env ilx_tvs 
+     tyvars_text = pprTyVarBinders alts_env ilx_tvs 
+     alts = vcat (map (pprIlxDataCon alts_env) (tyConDataCons tycon))
+     alts_text = nest 2 (braces alts)
+
+pprIlxDataCon env dcon =
+        text ".alternative" <+> pprId dcon <+> 
+        parens (pprSepWithCommas (pprIlxTypeL env) (map deepIlxRepType (filter (not. isVoidIlxRepType) (dataConRepArgTys dcon))))
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Getting the .closures and literals out}			*
+%************************************************************************
+
+\begin{code}
+
+ilxBindClosures :: IlxEnv -> StgBinding -> SDoc
+ilxBindClosures env (StgNonRec b rhs) = ilxRhsClosures env (b,rhs)
+ilxBindClosures env (StgRec pairs)  
+  = vcat (map (ilxRhsClosures new_env) pairs)
+  where
+     new_env = extendIlxEnvWithBinds env pairs
+
+---------------
+ilxRhsClosures env (bndr, StgRhsCon _ _ _)
+  = empty
+
+ilxRhsClosures env (bndr, StgRhsClosure _ _ _ fvs upd args rhs)
+  = vcat [ilxExprClosures next_env rhs,
+
+	 empty $$ line,
+	 kind_text <+> squotes cloname <+>  free_vs_text,
+	 nest 2 (braces (
+	    nest 2 (vcat [empty,
+                          vcat [text ".apply" <+> closure_sig_text,
+                                body_text
+                          ],
+                          empty
+                    ])
+                ))
+    ]
+  where
+    kind_of_thing = case upd of
+			  Updatable -> ASSERT( null args ) ".thunk"
+			  other	    -> ".closure"
+    kind_text = text kind_of_thing 
+		
+    cloname = ilxEnvQualifyByModule env (ppr bndr)
+    next_env = ilxPlaceStgRhsClosure env bndr 
+    (free_vs_text,env_with_fvs) = pprFreeBinders next_env fvs
+
+
+    closure_sig_text =     
+      vcat [(case args of 
+               []    ->  empty
+               other -> args_text),
+             text "-->" <+>  rty_text]
+
+    (args_text,env_with_args) = pprArgBinders env_with_fvs args
+
+        -- Find the type returned, from the no. of args and the type of "bndr"
+    rty_text = 
+      case retType env_with_fvs (idIlxRepType bndr) args of
+       Just (env,ty) -> pprIlxTypeR env ty 
+       Nothing -> trace "WARNING!  IlxGen.trace could not find return type - see generated ILX for context where this occurs." (text "// Could not find return type:" <+> pprIlxTypeR env_with_fvs (idIlxRepType bndr)<+> text ", non representation: " <+> pprIlxTypeR env_with_fvs (idType bndr))
+
+    -- strip off leading ForAll and Fun type constructions
+    -- up to the given number of arguments, extending the environment as
+    -- we go.  
+    retType env ty [] = Just (env, ty)
+    retType env (ForAllTy tv ty) (arg:args) = retType (extendIlxEnvWithTyArgs env [tv]) ty args
+    retType env (FunTy l r) (arg:args) = retType env r args
+    retType _ _ _  = Nothing
+
+	-- Code for the local variables
+    locals = ilxExprLocals env_with_args rhs
+
+    env_with_locals = extendIlxEnvWithLocals env_with_args locals
+
+	-- Code for the body of the main apply method
+    body_code = vcat [empty,
+                      pprIlxLocals env_with_args locals,
+		      ilxExpr (IlxEEnv env_with_locals (mkUniqSet (filter (not.isTyVar) args))) rhs Return,
+                      empty
+	        ]
+
+    body_text = nest 2 (braces (text ".maxstack 100" <+> nest 2 body_code))
+
+
+pprIlxLocals env [] = empty
+pprIlxLocals env vs 
+   = text ".locals" <+> parens (pprSepWithCommas (pprIlxLocal env) (filter nonVoidLocal vs))
+  where
+    nonVoidLocal (LocalId v,_) = not (isVoidIlxRepId v)
+    nonVoidLocal _ = True
+
+pprIlxLocal env (LocalId v,_) = pprIlxTypeL env (idIlxRepType v) <+> pprId v
+pprIlxLocal env (LocalSDoc (ty,doc,pin),_) = pprIlxTypeL env (deepIlxRepType ty) <+> (if pin then text "pinned" else empty) <+> doc
+
+
+pprFreeBinders env fvs 
+    = (ilx_tvs_text <+> vs_text, env2)
+    where   
+       (free_ilx_tvs, free_non_ilx_tvs,free_vs) = categorizeVars fvs
+       real_free_vs = filter (not . isVoidIlxRepId) free_vs
+        -- ignore the higher order type parameters for the moment
+       env1 = extendIlxEnvWithFreeTyVars env free_ilx_tvs 
+       ilx_tvs_text = pprTyVarBinders env1 free_ilx_tvs
+       vs_text = parens (pprSepWithCommas ppr_id real_free_vs)
+       ppr_id v = pprIlxTypeL env1 (idIlxRepType v) <+> pprId v 
+       env2 = extendIlxEnvWithFreeVars env1 real_free_vs 
+
+pprIdBinder env v = parens (pprIlxTypeL env (idIlxRepType v) <+> pprId v)
+
+	-- Declarations for the arguments of the main apply method
+pprArgBinders env [] = (empty,env)
+pprArgBinders env (arg:args)
+    = (arg_text <+> rest_text, res_env)
+   where 
+     (arg_text,env') = pprArgBinder env arg
+     (rest_text,res_env) = pprArgBinders env' args 
+
+-- We could probably omit some void argument binders, but
+-- don't...
+pprArgBinder env arg 
+  | isVoidIlxRepId arg = (text "()", extendIlxEnvWithArgs env [arg])
+  | otherwise 
+      = if isTyVar arg then 
+         let env' = extendIlxEnvWithTyArgs env [arg] in 
+         (pprTyVarBinder env' arg, env')
+      else (pprIdBinder env arg,extendIlxEnvWithArgs env [arg])
+
+--------------
+-- Compute local variables used by generated method.
+-- The names of some generated locals are recorded as SDocs.
+
+data LocalSpec = LocalId Id | LocalSDoc (Type, SDoc, Bool)  -- flag is for pinning
+
+ilxExprLocals :: IlxEnv -> StgExpr -> [(LocalSpec,Maybe (IlxEnv,StgRhs))]
+ilxExprLocals env (StgLet bind body) 		  = ilxBindLocals env bind ++ ilxExprLocals env body
+ilxExprLocals env (StgLetNoEscape _ _ bind body)  = ilxBindLocals env bind ++ ilxExprLocals env body  -- TO DO????
+ilxExprLocals env (StgCase scrut _ _ bndr _ alts) 
+     = ilxExprLocals (ilxPlaceStgCaseScrut env) scrut ++ 
+       (if isDeadBinder bndr then [] else [(LocalId bndr,Nothing)]) ++ 
+       ilxAltsLocals env alts
+ilxExprLocals env (StgPrimApp (CCallOp (CCall (StaticTarget c) casm gc cconv)) args ret_ty) 
+     = concat (ilxMapPlaceArgs 0 ilxCCallArgLocals env args)
+ilxExprLocals _ _  = []
+
+-- Generate locals to use for pinning arguments as we cross the boundary
+-- to C.
+ilxCCallArgLocals env arg@(StgVarArg v) | pinCCallArg v = 
+   [(LocalSDoc (idType v, ilxEnvQualifyByExact env (ppr v) <> text "pin", True), Nothing)]
+ilxCCallArgLocals _ _ | otherwise = []
+
+ilxBindLocals env (StgNonRec b rhs) = [(LocalId b,Just (env, rhs))]
+ilxBindLocals env (StgRec pairs)  = map (\(x,y) -> (LocalId x,Just (env, y))) pairs
+
+ilxAltsLocals env (StgAlgAlts  _ alts deflt) = ilxDefltLocals env deflt ++ concat (ilxMapPlaceAlts ilxAlgAltLocals env alts)
+ilxAltsLocals env (StgPrimAlts _ alts deflt) = ilxDefltLocals env deflt ++ concat (ilxMapPlaceAlts ilxPrimAltLocals env alts)
+
+ilxAlgAltLocals env (con, bndrs, _, rhs) = map (\x -> (LocalId x,Nothing)) (filter (\v -> isId v && not (isDeadBinder v)) bndrs) ++ ilxExprLocals env rhs
+ilxPrimAltLocals env (lit, rhs)          = ilxExprLocals env rhs
+
+ilxDefltLocals env StgNoDefault 	= []
+ilxDefltLocals env (StgBindDefault rhs) = ilxExprLocals (ilxPlaceStgBindDefault env) rhs
+
+--------------
+ilxExprClosures :: IlxEnv -> StgExpr -> SDoc
+ilxExprClosures env (StgApp _ args)
+  = vcat (ilxMapPlaceArgs 0 (ilxArgClosures) env args)  -- get strings
+ilxExprClosures env (StgConApp _ args)
+  = vcat (ilxMapPlaceArgs 0 (ilxArgClosures) env args) -- get strings
+ilxExprClosures env (StgPrimApp _ args _)
+  = vcat (ilxMapPlaceArgs 0 (ilxArgClosures) env args) -- get strings
+ilxExprClosures env (StgLet bind body)
+  = ilxBindClosures env bind $$ ilxExprClosures (extendIlxEnvWithBinds env (ilxPairs1 bind)) body
+ilxExprClosures env (StgLetNoEscape _ _ bind body)  -- TO DO????
+  = ilxBindClosures env bind $$ ilxExprClosures (extendIlxEnvWithBinds env (ilxPairs1 bind)) body
+ilxExprClosures env (StgCase scrut _ _ _ _ alts)
+  = ilxExprClosures (ilxPlaceStgCaseScrut env) scrut $$ ilxAltsClosures env alts 
+ilxExprClosures env (StgLit lit) 
+  = ilxGenLit env lit 
+ilxExprClosures env other 
+  = empty
+
+ilxAltsClosures env (StgAlgAlts _ alts deflt)
+  = vcat [ilxExprClosures (ilxPlaceAlt env i) rhs | (i,(_, _, _, rhs))  <- [1..] `zip` alts]
+    $$ 
+    ilxDefltClosures env deflt
+
+ilxAltsClosures env (StgPrimAlts _ alts deflt)
+  = vcat [ilxExprClosures (ilxPlaceAlt env i) rhs | (i,(_, rhs)) <- [1..] `zip` alts]
+    $$ 
+    vcat [ ilxGenLit (ilxPlacePrimAltLit env i) lit | (i,(lit,_)) <- [1..] `zip` alts]
+    $$ 
+    ilxDefltClosures  env deflt
+
+ilxDefltClosures env (StgBindDefault rhs) = ilxExprClosures (ilxPlaceStgBindDefault env) rhs
+ilxDefltClosures env StgNoDefault	  = empty
+
+ilxArgClosures env (StgLitArg lit) = ilxGenLit env lit 
+ilxArgClosures _ _ = empty
+
+
+
+ilxGenLit env (MachStr fs) 
+  = vcat [text ".field static assembly char "  <+> squotes nm <+> text "at" <+> nm <> text "L",
+          text ".data" <+> nm <> text "L" <+> text "= char *("  <> pprFSInILStyle fs  <> text ")"
+         ]
+ where
+   nm = ilxEnvQualifyByExact env (text "string")
+
+ilxGenLit  _ _ = empty
+
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Generating code}
+%*									*
+%************************************************************************
+
+
+\begin{code}
+
+-- Environment when generating expressions
+data IlxEEnv = IlxEEnv IlxEnv (UniqSet Id)
+
+data Sequel = Return | Jump IlxLabel
+
+ilxSequel Return     = text "ret"
+ilxSequel (Jump lbl) = text "br" <+> pprIlxLabel lbl
+
+isReturn Return = True
+isReturn (Jump _) = False
+
+
+ilxExpr :: IlxEEnv -> StgExpr 
+	-> Sequel 	-- What to do at the end
+	-> SDoc
+
+ilxExpr eenv@(IlxEEnv env _) (StgApp fun args) sequel
+  = ilxFunApp env fun args (isReturn sequel) $$ ilxSequel sequel
+
+-- ilxExpr eenv (StgLit lit) sequel
+ilxExpr eenv@(IlxEEnv env _) (StgLit lit) sequel
+  = pushLit env lit $$ ilxSequel sequel
+
+-- ilxExpr eenv (StgConApp data_con args) sequel
+ilxExpr eenv@(IlxEEnv env _) (StgConApp data_con args) sequel
+  = text " /* ilxExpr:StgConApp */ " <+>  ilxConApp env data_con args $$ ilxSequel sequel
+
+-- ilxExpr eenv (StgPrimApp primop args _) sequel
+ilxExpr eenv@(IlxEEnv env _) (StgPrimApp primop args ret_ty) sequel
+  = ilxPrimApp env primop args ret_ty $$ ilxSequel sequel
+
+--BEGIN TEMPORARY
+-- The following are versions of a peephole optimizations for "let t = \[] t2[fvs] in t"
+-- I think would be subsumed by a general treatmenet of let-no-rec bindings??
+ilxExpr eenv@(IlxEEnv env _) (StgLet (StgNonRec bndr (StgRhsClosure _ _ _ fvs upd [] rhs)) (StgApp fun [])) sequel 
+              | (bndr == fun && null (ilxExprLocals env rhs)) -- TO DO???
+  = ilxExpr eenv rhs sequel
+ilxExpr eenv@(IlxEEnv env _) (StgLetNoEscape _ _ (StgNonRec bndr (StgRhsClosure _ _ _ fvs upd [] rhs)) (StgApp fun [])) sequel 
+              | (bndr == fun && null (ilxExprLocals env rhs)) -- TO DO???
+  = ilxExpr eenv rhs sequel
+--END TEMPORARY
+
+ilxExpr eenv (StgLet bind body) sequel
+  = ilxBind eenv bind $$ ilxExpr eenv body sequel
+
+
+ilxExpr eenv (StgLetNoEscape _ _ bind body) sequel -- TO DO???
+  = ilxBind eenv bind $$ ilxExpr eenv body sequel
+
+-- StgCase: Special case 1 to avoid spurious branch.
+ilxExpr eenv@(IlxEEnv env live) (StgCase (StgApp fun args) live_in_case live_in_alts bndr _ alts) sequel
+  = vcat [ilxWipe env (uniqSetToList (live `minusUniqSet` live_in_case)),
+	  ilxFunApp (ilxPlaceStgCaseScrut env) fun args False,
+          --ilxWipe env (uniqSetToList (live_in_case `minusUniqSet` live_in_alts)),
+	  --ilxAlts (IlxEEnv env live_in_alts) bndr alts sequel
+	  ilxAlts (IlxEEnv env live_in_case) bndr alts sequel
+    ]
+
+-- StgCase: Special case 2 to avoid spurious branch.
+ilxExpr eenv@(IlxEEnv env live) (StgCase (StgPrimApp primop args ret_ty) live_in_case live_in_alts bndr _ alts) sequel
+  = vcat [ilxWipe env (uniqSetToList (live `minusUniqSet` live_in_case)),
+	  ilxPrimApp (ilxPlaceStgCaseScrut env) primop args ret_ty,
+          --ilxWipe env (uniqSetToList (live_in_case `minusUniqSet` live_in_alts)),
+	  --ilxAlts (IlxEEnv env live_in_alts) bndr alts sequel
+	  ilxAlts (IlxEEnv env live_in_case) bndr alts sequel
+    ]
+
+-- StgCase: Normal case.
+ilxExpr eenv@(IlxEEnv env live) (StgCase scrut live_in_case live_in_alts bndr _ alts) sequel
+  = vcat [ilxWipe env (uniqSetToList (live `minusUniqSet` live_in_case)),
+	  ilxExpr (IlxEEnv (ilxPlaceStgCaseScrut env) live_in_case) scrut (Jump join_lbl),
+	  ilxLabel join_lbl,
+          --ilxWipe env (uniqSetToList (live_in_case `minusUniqSet` live_in_alts)),
+	  --ilxAlts (IlxEEnv env live_in_alts) bndr alts sequel
+	  ilxAlts (IlxEEnv env live_in_case) bndr alts sequel
+    ]
+  where
+    join_lbl = mkJoinLabel bndr
+
+-- Wipe out locals and arguments that are no longer in use, to
+-- prevent space leaks. If the VM is implemented 100% correctly then
+-- this should probably not be needed, as the live variable analysis
+-- in the JIT would tell the GC that these locals and arguments are
+-- no longer live.  However I'm putting it in here so we can
+-- check out if it helps.
+--
+-- Also, in any case this doesn't capture everything we need.  e.g.
+-- when making a call:
+--     case f x of ...
+-- where x is not used in the alternatives, then the variable x
+-- is no longer live from the point it is transferred to the call
+-- onwards.  We should expunge "live_in_case - live_in_alts" right
+-- before making the call, not after returning from the call....
+--
+-- Strictly speaking we also don't need to do this for primitive
+-- values such as integers and addresses, i.e. things not
+-- mapped down to GC'able objects.
+ilxWipe env ids 
+   = vcat (map (ilxWipeOne env) (filter (not.isVoidIlxRepId) ids))
+
+ilxWipeOne env id
+   = case lookupIlxVarEnv env id of
+	  Just Local  -> text "ldloca " <+> pprId id <+> text "initobj" <+> (pprIlxTypeL env (idIlxRepType id))
+	  Just Arg   -> text "deadarg " <+> pprId id <+> text "," <+> (pprIlxTypeL env (idIlxRepType id))
+	  Just (CloVar _)  -> ilxComment (text "not yet wiping closure variable" <+> pprId id )
+	  _ -> ilxComment (text "cannot wipe non-local/non-argument" <+> pprId id )
+  where 
+      
+
+----------------------
+
+ilxAlts :: IlxEEnv -> Id -> StgCaseAlts -> Sequel -> SDoc
+ilxAlts eenv@(IlxEEnv env live) bndr alts sequel
+	-- At the join label, the result is on top
+	-- of the stack
+  = vcat [store_in_bndr,
+	  do_case_analysis alts
+    ]
+  where
+    store_in_bndr | isDeadBinder bndr = empty
+                  | isVoidIlxRepId bndr 
+                        = ilxComment (text "ignoring store of zero-rep value to be analyzed")
+		  | otherwise	      = text "dup" $$ (text "stloc" <+> pprId bndr)
+
+    do_case_analysis (StgAlgAlts _ []    deflt)
+	= do_deflt deflt
+
+    do_case_analysis (StgAlgAlts ty args deflt) 
+        = do_alg_alts (deepIlxRepType ty) ([1..] `zip` args) deflt
+
+    do_case_analysis (StgPrimAlts ty alts deflt)
+	= do_prim_alts ([1..] `zip` alts) $$ do_deflt deflt
+
+    do_alg_alts ty [(i, alt@(data_con,bndrs,used_flags, rhs))] StgNoDefault | isUnboxedTupleCon data_con
+      -- Collapse the analysis of unboxed tuples where 
+      -- some or all elements are zero-sized
+      --
+      -- TO DO: add bndrs to set of live variables
+          = case bndrs' of
+                  [h] -> bind_collapse bndrs used_flags <+> do_rhs_no_pop alt_env rhs
+                  _ -> bind_components alt_env  ty dcon' bndrs 0 used_flags <+> do_rhs alt_env rhs
+           where 
+            bndrs' = filter (not. isVoidIlxRepId) bndrs
+            -- Replacement unboxed tuple type constructor, used if any of the
+            -- arguments have zero-size and more than one remains.
+            dcon'  = unboxedTupleCon (length bndrs')
+
+            alt_env = IlxEEnv (ilxPlaceAlt env i) live
+            --alt_env = IlxEEnv (ilxPlaceAlt env i) 
+
+            bind_collapse [] _ = panic "bind_collapse: unary element not found"
+            bind_collapse (h:t) (is_used:used_flags) 
+                | isVoidIlxRepId h = ilxComment (text "zero-rep binding eliminated") <+> (bind_collapse t used_flags)
+	        | not is_used = ilxComment (text "not used") <+> text "pop"
+                | otherwise = text "stloc" <+> pprId h
+
+
+    do_alg_alts ty [(i, alt@(data_con,bndrs,used_flags, rhs))] StgNoDefault 
+            = vcat [text "castdata" <+> sep [pprIlxTypeR env ty <> comma,
+		  			     ilxConRef env data_con],
+ 		do_alg_alt (IlxEEnv (ilxPlaceAlt env i) live) ty alt
+	      ]
+
+    do_alg_alts ty alts deflt
+	= vcat [text "datacase" <+> sep [pprIlxTypeR env ty,text ",",
+					 pprSepWithCommas pp_case labels_w_alts],
+		do_deflt deflt,
+		vcat (map (do_labelled_alg_alt ty) labels_w_alts)
+	  ]
+	where
+	  pp_case (i, (lbl, (data_con, _, _, _))) = parens (ilxConRef env data_con <> comma <> pprIlxLabel lbl)
+	  labels_w_alts = [(i,(mkAltLabel bndr i, alt)) | (i, alt) <- alts]
+
+    do_prim_alts [] = empty
+    do_prim_alts ((i, (lit,alt)) : alts) 
+	= vcat [text "dup", pushLit (ilxPlacePrimAltLit env i) lit, text "bne.un" <+> pprIlxLabel lbl, 
+		do_rhs (IlxEEnv (ilxPlaceAlt env i) live) alt, 
+		ilxLabel lbl, do_prim_alts alts]
+	where
+	  lbl = mkAltLabel bndr i
+
+    do_labelled_alg_alt ty (i,(lbl, alt)) 
+        = ilxLabel lbl $$ do_alg_alt (IlxEEnv (ilxPlaceAlt env i) live) ty alt
+
+    do_alg_alt alt_eenv ty (data_con, bndrs, used_flags, rhs) 
+      = vcat [bind_components alt_eenv ty data_con bndrs 0 used_flags,
+	      do_rhs alt_eenv rhs
+	     ]
+
+    bind_components alt_eenv ty data_con [] n _ = empty
+    bind_components alt_eenv ty data_con (h:t) n (is_used:used_flags) 
+       | isVoidIlxRepId h 
+             -- don't increase the count in this case
+             = ilxComment (text "zero-rep binding eliminated") 
+               <+> bind_components alt_eenv ty data_con t n used_flags
+       | otherwise 
+             = bind_component alt_eenv ty data_con h is_used n 
+               <+> bind_components alt_eenv ty data_con t (n + 1) used_flags
+
+    bind_component alt_eenv@(IlxEEnv alt_env _) ty data_con bndr is_used reduced_fld_no 
+	| not is_used 
+            = ilxComment (text "not used")
+        | isVoidIlxRepId bndr 
+            = ilxComment (text "ignoring bind of zero-rep variable")
+	| otherwise   = vcat [text "dup",
+			      ld_data alt_env ty data_con reduced_fld_no bndr,
+			      text "stloc" <+> pprId bndr]
+
+    do_deflt (StgBindDefault rhs) = do_rhs (IlxEEnv (ilxPlaceStgBindDefault env) live) rhs
+    do_deflt StgNoDefault 	  = empty
+
+    do_rhs alt_eenv rhs  
+        | isVoidIlxRepId bndr = do_rhs_no_pop alt_eenv rhs     -- void on the stack, nothing to pop
+        | otherwise = text "pop" $$ do_rhs_no_pop alt_eenv rhs  -- drop the value
+
+    do_rhs_no_pop alt_env rhs = ilxExpr alt_env rhs sequel
+
+    ld_data alt_env ty data_con reduced_fld_no bndr
+      | isUnboxedTupleCon data_con
+          = text "ldfld" <+> text "!" <> integer reduced_fld_no <+> pprIlxTypeR alt_env ty <> text "::fld" <> integer reduced_fld_no
+      | otherwise 
+          = text "lddata" <+> sep [pprIlxTypeR alt_env ty <> comma, 
+		                   ilxConRef env data_con <> comma,
+			           integer reduced_fld_no]
+
+
+-------------------------
+
+ilxBestTermArity = 3
+ilxBestTypeArity = 7
+
+
+-- Constants of unlifted types are represented as
+-- applications to no arguments.
+ilxFunApp env fun [] _ | isUnLiftedType (idType fun)
+  = pushId env fun
+
+ilxFunApp env fun args tail_call 
+  =	-- For example:
+        --	ldloc f		function of type forall a. a->a
+	--	ldloc x		arg of type Int
+	--	.tail callfunc <Int32> (!0) --> !0
+	--
+    vcat [pushId env fun,ilxFunAppArgs env 0 (idIlxRepType fun) args tail_call known_clo]
+  where
+    known_clo =
+      case lookupIlxBindEnv env fun of
+	  Just (place, StgRhsClosure  _ _ _ _ Updatable _ _) ->  Nothing 
+	  Just (place, StgRhsClosure  _ _ _ fvs _ args _)  -> Just (place,fun,args,fvs)
+	  _ ->  trace (show fun ++ " --> " ++ show (arityLowerBound (idArityInfo fun)))  Nothing 
+
+-- Push as many arguments as ILX allows us to in one go.
+-- Recurse until we're done.
+ilxFunAppArgs env num_sofar funty args tail_call known_clo
+ =   vcat [vcat (ilxMapPlaceArgs num_sofar pushArgWithVoids env now_args),
+	   call_instr <+> now_args_text
+                     <+> text "-->" 
+                     <+> (pprIlxTypeR env_after_now_tyvs later_ty),
+           later
+          ]
+  where
+    now_args_text = hsep (map (pprIlxArgInfo env_after_now_tyvs) now_arg_tys)
+
+    (now_args,now_arg_tys,env_after_now_tyvs,later_args,later_ty) = 
+	case args of
+          (StgTypeArg v:rest) -> get_type_args ilxBestTypeArity args env funty
+          _ -> get_term_args ilxBestTermArity args env funty
+
+     -- Only apply up to maxArity real (non-type) arguments
+     -- at a time.  ILX should, in principle, allow us to apply
+     -- arbitrary numbers, but you will get more succinct 
+     -- (and perhaps more efficient) IL code
+     -- if you apply in clumps according to its maxArity setting.
+     -- This is because it has to unwind the stack and store it away
+     -- in local variables to do the partial applications.
+     --
+     -- Similarly, ILX only allows one type application at a time, at
+     -- least until we implement unwinding the stack for this case.
+     --
+     -- NB: In the future we may have to be more careful 
+     -- all the way through 
+     -- this file to bind type variables as we move through
+     -- type abstractions and "forall" types.  This would apply
+     -- especially if the type variables were ever bound by expressions
+     -- involving the type variables.  
+
+    -- This part strips off at most "max" term applications or one type application
+    get_type_args 0 args env funty = ([],[],env,args,funty)
+    get_type_args max args env (NoteTy _ ty) = 
+          trace "IlxGen Internal Error: non representation type passed to get_args" (get_type_args max args env ty)
+    get_type_args max ((arg@(StgTypeArg v)):rest) env (ForAllTy tv rem_funty) 
+        = if isIlxTyVar tv then 
+            let env2 = extendIlxEnvWithFormalTyVars env [tv] in 
+            let rest_ty = deepIlxRepType (substTy (mkTyVarSubst [tv] [v]) rem_funty) in 
+            let (now,now_tys,env3,later,later_ty) = get_type_args (max - 1) rest env rest_ty in 
+            let arg_ty = mkTyVarTy tv in 
+            (arg:now,(arg,arg_ty):now_tys,env2, later, later_ty)
+          else 
+             get_type_args max rest env rem_funty  -- ? subst??
+    get_type_args _ (StgTypeArg _:_) _ _ = trace "IlxGen Internal Error: get_type_args could not get ForAllTy for corresponding arg" ([],[],env,[],funty)
+    get_type_args _ args env funty = ([],[],env,args,funty)
+
+    -- We could probably skip some  void-rep arguments.  Instead we
+    -- emit "ldvoid" for these and let ILXASM optimize them away.
+    -- get_term_args max (h@(StgVarArg v):t) env (FunTy dom ran) | isVoidIlxRepId v   
+        --  = get_term_args max t env ran
+    get_term_args max args env (NoteTy _ ty) =
+        -- Skip NoteTy types 
+          trace "IlxGen Internal Error: non representation type passed to get_term_args" (get_term_args max args env ty)
+    get_term_args 0 args env funty = ([],[],env,args,funty)
+        -- Stop if no more
+    get_term_args _ (args@(StgTypeArg _:_)) env funty = ([],[],env,args,funty)
+    get_term_args max (h:t) env (FunTy dom ran) = 
+          let (now,now_tys,env2,later,later_ty) = get_term_args (max - 1) t env ran in 
+          (h:now, (h,dom):now_tys,env2,later,later_ty)
+    get_term_args max (h:t) env funty = trace "IlxGen Internal Error: get_term_args could not get FunTy or ForAllTy for corresponding arg" ([],[],env,[],funty)
+    get_term_args max args env funty = ([],[],env,args,funty)
+
+    -- Are there any remaining arguments?
+    done  = case later_args of
+          [] -> True
+          _ -> False
+
+    -- If so, generate the subsequent calls.
+    later = if done then text "// done"  
+            else ilxFunAppArgs env (num_sofar + length now_args) later_ty later_args tail_call Nothing
+
+    -- Work out whether to issue a direct call a known closure (callclo) or
+    -- an indirect call (callfunc).  Basically, see if the identifier has
+    -- been let-bound, and then check we are applying exactly the right 
+    -- number of arguments.  Also check that it's not a thunk (actually, this
+    -- is done up above).
+    -- 
+    -- The nasty "all" check makes sure that 
+    -- the set of type variables in scope at the callsite is a superset 
+    -- of the set of type variables needed for the direct call.  This is
+    -- is needed because not all of the type variables captured by a 
+    -- let-bound binding will get propogated down to the callsite, and 
+    -- the ILX system of polymorphism demands that the free type variables
+    -- get reapplied when we issue the direct "callclo".  The
+    -- type variables are in reality also "bound up" in the closure that is
+    -- passed as the first argument, so when we do an indirect call
+    -- to that closure we're fine, which is why we don't need them in 
+    -- the "callfunc" case.
+    basic_call_instr =
+      case known_clo of
+        Just (known_env,fun,needed,fvs) | (length needed == length args) && 
+                                          all (\x -> elemIlxTyVarEnv x env) free_ilx_tvs -> 
+           vcat [text "callclo class",
+                 nameReference env (idName fun) <+> squotes (ilxEnvQualifyByModule env (ppr fun)),
+                 pprTypeArgs pprIlxTypeR env (map mkTyVarTy free_ilx_tvs)]
+           <> text ","
+          where 
+           (free_ilx_tvs, free_non_ilx_tvs,free_vs) = categorizeVars fvs
+        otherwise -> text "callfunc"
+    call_instr =
+           if (tail_call && done) then text "tail." <+> basic_call_instr
+	   else basic_call_instr
+
+
+--------------------------
+-- Print the arg info at the call site
+-- For type args we are, at the moment, required to
+-- give both the actual and the formal (bound).  The formal
+-- bound is always System.Object at the moment (bounds are
+-- not properly implemented in ILXASM in any case, and nor do
+-- we plan on making use og them) For
+-- non-type args the actuals are on the stack, and we just give the
+-- formal type.
+pprIlxArgInfo env (StgTypeArg  arg,ty) =  
+    angleBrackets (pprIlxTypeR env (deepIlxRepType arg) <+> ilxComment (text "actual for tyvar")) <+> text "<class [mscorlib] System.Object>" 
+pprIlxArgInfo env (_,ty) =  
+    parens (pprIlxTypeL env ty)
+
+
+----------------------------
+-- Code for a binding
+ilxBind :: IlxEEnv -> StgBinding -> SDoc
+ilxBind eenv@(IlxEEnv env _) bind = 
+    vcat [vcat (map (ilxRhs env rec) pairs), 
+          vcat (map (ilxFixupRec env rec) pairs)]
+       where 
+         rec = ilxRecIds1 bind
+         pairs = ilxPairs1 bind
+
+
+----------------------------
+-- Allocate a closure or constructor.  Fix up recursive definitions.
+ilxRhs :: IlxEnv -> [Id] -> (Id, StgRhs) -> SDoc
+
+ilxRhs env rec (bndr, _) | isVoidIlxRepId bndr  
+  = empty
+
+ilxRhs env rec (bndr, StgRhsCon _ con args)
+  = vcat [text " /* ilxRhs:StgRhsCon */ " <+> ilxConApp env con args,
+	   text "stloc" <+> pprId bndr
+          ]
+
+ilxRhs env rec (bndr, StgRhsClosure _ _ _ fvs upd args rhs)
+  = 	-- Assume .closure v<any A>(int64,!A) { 
+	--		.apply <any B> (int32) (B) { ... }
+	--	   }
+	-- Then
+        --    let v = \B (x:int32) (y:B). ... 
+        -- becomes:
+        --    newclo v<int32>(int64,!0)
+	--    stloc v
+    vcat [vcat (map pushFv free_vs),
+          (if null free_non_ilx_tvs then empty else (ilxComment (text "ignored some higher order type arguments in application - code will be non-verifiable"))),
+	  text "newclo" <+> clotext,
+	  text "stloc" <+> pprId bndr
+    ]
+  where
+    pushFv id = if elem id rec then text "ldnull" else pushId env id
+    (free_ilx_tvs, free_non_ilx_tvs,free_vs) = categorizeVars fvs
+    clotext = pprIlxBoxedTyConApp env (ilxEnvQualifyByModule env (ppr bndr)) (map mkTyVarTy free_ilx_tvs)
+
+ilxFixupRec env rec (bndr, _) | isVoidIlxRepId bndr = ilxComment (text "no recursive fixup for void-rep-id")
+
+ilxFixupRec env rec (bndr, StgRhsCon _ con args)
+  = text "// no recursive fixup"
+
+ilxFixupRec env rec (bndr, StgRhsClosure _ _ _ fvs upd args rhs)
+     = vcat [vcat (map fixFv rec)]
+  where
+    fixFv recid = if elem recid fvs then 
+                    vcat [pushId env bndr,
+                          pushId env recid,
+                          text "stclofld" <+> clotext <> text "," <+> pprId recid] 
+                else text "//no fixup needed for" <+> pprId recid
+    (free_ilx_tvs, free_non_ilx_tvs,free_vs) = categorizeVars fvs
+    clotext = pprIlxBoxedTyConApp env (ilxEnvQualifyByModule env (ppr bndr)) (map mkTyVarTy free_ilx_tvs)
+
+
+
+---------------------------------------------
+-- Code for a top-level binding in a module
+ilxPairs binds = concat (map ilxPairs1 binds)
+
+ilxPairs1 (StgNonRec bndr rhs) = [(bndr,rhs)]
+ilxPairs1 (StgRec pairs) = pairs
+
+ilxRecIds1 (StgNonRec bndr rhs) = []
+ilxRecIds1 (StgRec pairs) = map fst pairs
+
+---------------------------------------------
+-- Code for a top-level binding in a module
+-- TODO: fix up recursions amongst CAF's
+-- e.g. 
+--    x = S x
+-- for infinity...
+-- 
+-- For the moment I've put in a completely spurious "reverse"...
+--
+-- Consider: make fixing up of CAF's part of ILX?  i.e.
+-- put static, constant, allocated datastructures into ILX. 
+
+stableSortBy :: (a -> a -> Ordering) -> [a] -> [a]
+stableSortBy f (h:t) = insertBy f h (stableSortBy f t)
+stableSortBy f [] = []
+
+usedBy :: (Id,StgRhs) -> (Id,StgRhs) -> Ordering
+usedBy (m,_) (_,StgRhsCon _ data_con args) | any (isArg m) args = LT
+usedBy (m,_) (n,_) | m == n = EQ
+usedBy (m,_) (_,_) = GT
+
+isArg m  (StgVarArg n) = (n == m)
+isArg m _ = False
+
+
+ilxTopBind :: Module -> IlxEnv -> [(Id,StgRhs)] -> SDoc
+--ilxTopBind mod env (StgNonRec bndr rhs) = 
+--ilxTopRhs env (bndr,rhs)
+ilxTopBind mod env pairs       = 
+   vcat [text ".class" <+> pprId mod,
+         nest 2 (braces (nest 2 (vcat [empty,cctor, flds, empty])))]
+     where
+       cctor = vcat [text ".method static rtspecialname specialname void .cctor()",
+                     nest 2 (braces 
+                      (nest 2 (vcat [text ".maxstack 100",
+			             text "ldstr \"LOG: initializing module" <+> pprId mod <+> text "\" call void ['mscorlib']System.Console::WriteLine(class [mscorlib]System.String)",
+                                     vcat (map (ilxTopRhs mod env) (stableSortBy usedBy pairs)), 
+			             text "ldstr \"LOG: initialized module" <+> pprId mod <+> text "\" call void ['mscorlib']System.Console::WriteLine(class [mscorlib]System.String)",
+                                     text "ret",
+                                     empty])))]
+       flds =   vcat (map (ilxTopRhsStorage mod env) pairs)
+
+--ilxTopRhs mod env (bndr, _) | isVoidIlxRepId bndr 
+--  = empty
+
+ilxTopRhs mod env (bndr, StgRhsClosure _ _ _ fvs upd args rhs)
+  = vcat [vcat (map (pushId env) free_vs),
+         (if null free_non_ilx_tvs then empty else (ilxComment (text "ignored some higher order type arguments in application - code will be non verifiable...."))),
+	  text "newclo" <+> pprIlxBoxedTyConApp env (ilxEnvQualifyByModule env (ppr bndr)) (map mkTyVarTy free_ilx_tvs),
+	  text "stsfld"  <+> pprFieldRef env (mod,bndTy,bndr)
+    ]
+  where
+    (free_ilx_tvs, free_non_ilx_tvs,free_vs) = categorizeVars fvs
+    bndTy = idIlxRepType bndr
+
+ilxTopRhs mod env (bndr, StgRhsCon _ data_con args)
+  = vcat [ text " /* ilxTopRhs: StgRhsCon */ " <+> ilxConApp env data_con args, 
+	   text "stsfld" <+> pprFieldRef env (mod,bndTy,bndr)
+    ]
+  where
+    bndTy = idIlxRepType bndr
+
+pprFieldRef env (mod,ty,id) 
+  =  pprIlxTypeL env ty <+> moduleReference env mod <+> pprId mod <> text "::" <> pprId id
+
+ilxTopRhsStorage mod env (bndr, StgRhsClosure _ _ _ _ _ _ _) 
+  =   text ".field public static " <+> pprIlxTypeL env bndTy <+> pprId bndr
+  where
+    bndTy = idIlxRepType bndr
+ilxTopRhsStorage mod env (bndr, StgRhsCon _ _ _) 
+  =   text ".field public static " <+> pprIlxTypeL env bndTy <+> pprId bndr
+  where
+    bndTy = idIlxRepType bndr
+
+--------------------------------------
+-- Push an argument
+pushArgWithVoids =  pushArg_aux True
+pushArg = pushArg_aux False
+
+pushArg_aux voids env (StgTypeArg ty) = empty
+pushArg_aux voids env (StgVarArg var) = pushId_aux voids env var
+pushArg_aux voids env (StgLitArg lit) = pushLit env lit
+
+
+mapi f l = mapi_aux f l 0
+
+mapi_aux f [] n = []
+mapi_aux f (h:t) n = f n h : mapi_aux f t (n+1)
+
+--------------------------------------
+-- Push an Id
+pushId = pushId_aux False
+
+pushId_aux :: Bool -> IlxEnv -> Id -> SDoc
+pushId_aux voids _ id | isVoidIlxRepId id =
+   if voids then  text "ldvoid" else ilxComment (text "pushId: void rep skipped")
+pushId_aux _ env var 
+  = case lookupIlxVarEnv env var of
+	  Just Arg    -> text "ldarg"    <+> pprId var
+	  Just (CloVar n) -> text "ldenv" <+> int n
+	  Just Local  -> text "ldloc"    <+> pprId var
+	  Just (Top m)  -> 
+             vcat [ilxComment (text "pushId (Top) " <+> pprId m), 
+                   text "ldsfld" <+> pprIlxTypeL env (idIlxRepType var)
+                      <+> moduleReference env m <+> pprId (moduleName m) <> text "::" <> pprId var]
+
+	  Nothing ->  
+             vcat [ilxComment (text "pushId (import) " <+> pprIlxTopVar env var), 
+                   text "ldsfld" <+> pprIlxTypeL env (idIlxRepType var) 
+                    <+> pprIlxTopVar env var]
+
+--------------------------------------
+-- Push a literal
+pushLit env (MachChar c)   = text "ldc.i4" <+> int (ord c)
+pushLit env (MachStr s)    = text "ldsflda char "  <+> ilxEnvQualifyByExact env (text "string") -- pprFSInILStyle s 
+pushLit env (MachInt i)    = text "ldc.i4" <+> integer i
+pushLit env (MachInt64 i)  = text "ldc.i8" <+> integer i
+pushLit env (MachWord w)   = text "ldc.i4" <+> integer w <+> text "conv.u4"
+pushLit env (MachWord64 w) = text "ldc.i8" <+> integer w <+> text "conv.u8"
+pushLit env (MachFloat f)  = text "ldc.r4" <+> rational f
+pushLit env (MachDouble f) = text "ldc.r8" <+> rational f
+pushLit env (MachLitLit _ _) = trace "WARNING: Cannot compile MachLitLit to ILX in IlxGen.lhs" (text "// MachLitLit!!!  Not valid in ILX!!")
+pushLit env (MachAddr w) = text "ldc.i4 conv.i " <+> integer w
+
+
+pprIlxTopVar env v
+  | isGlobalName n = (nameReference env n) <> pprId (nameModule n) <> text "::" <> squotes (ppr (nameModule n) <> text "_" <> ppr (nameOccName n))
+  | otherwise	   = pprId (nameOccName n)
+  where
+    n = idName v
+
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Printing types}
+%*									*
+%************************************************************************
+
+
+\begin{code}
+
+isVoidIlxRepType (NoteTy   _ ty) = isVoidIlxRepType ty
+isVoidIlxRepType (TyConApp tc _) | (tyConPrimRep tc == VoidRep) = True
+isVoidIlxRepType (TyConApp tc tys) 
+  = case newTyConRep tc of
+	 Just rep_ty -> isVoidIlxRepType (applyTys rep_ty tys)
+	 Nothing     -> 
+            isUnboxedTupleTyCon tc && 
+            null (filter (not. isVoidIlxRepType) tys)
+isVoidIlxRepType _ = False
+
+isVoidIlxRepId id = isVoidIlxRepType (idType id)
+
+
+
+-- Get rid of all NoteTy and NewTy artifacts
+deepIlxRepType :: Type -> Type
+
+-- Eliminate state variables on left of arrow types...
+-- We have to be careful not to erase too much information here - 
+-- the type may not accurately describe
+-- the "functionness" of the result.   For example, 
+-- State# -> Int# 
+-- reduces to 
+--    Int#
+-- which looks like an unboxed type.  It isn't - it's
+-- just a function taking no arguments.  As such, we 
+-- have to rely on the context in which a function type is being
+-- used to know what to do.
+--
+-- deepIlxRepType (FunTy l r) | isVoidIlxRepType l 
+--   = deepIlxRepType r
+
+deepIlxRepType (FunTy l r)
+  = FunTy (deepIlxRepType l) (deepIlxRepType r)
+
+deepIlxRepType (TyConApp tc tys) 
+  = case newTyConRep tc of
+	 Just rep_ty -> ASSERT( length tys == tyConArity tc )
+		-- The assert should hold because deepIlxRepType should
+		-- only be applied to *types* (of kind *)
+			deepIlxRepType (applyTys rep_ty tys)
+	 Nothing     -> 
+           -- collapse UnboxedTupleTyCon down when it contains VoidRep types.
+            if isUnboxedTupleTyCon tc then 
+               let tys' = map deepIlxRepType (filter (not. isVoidIlxRepType) tys) in 
+               case tys' of
+                  [h] -> h
+                  _ -> mkUnboxedTupleTy (length tys') tys'
+            else 
+              TyConApp tc (map deepIlxRepType tys)
+deepIlxRepType (AppTy f x)  = AppTy (deepIlxRepType f) (deepIlxRepType x)
+deepIlxRepType (ForAllTy b ty) = ForAllTy b (deepIlxRepType ty)
+deepIlxRepType (NoteTy   _ ty) = deepIlxRepType ty
+deepIlxRepType ty@(TyVarTy tv) = ty
+
+idIlxRepType id = deepIlxRepType (idType id)
+
+--------------------------
+-- Function types and type functions are implicitly thunkable.
+-- Some primitive type constructors are not thunkable.
+-- Everything else needs to be marked thunkable.
+pprIlxTypeL :: IlxEnv -> Type -> SDoc
+
+pprIlxTypeL env ty | isVoidIlxRepType ty 
+  = trace "pprIlxTypeL: VoidRep" pprIlxTypeR env ty
+
+pprIlxTypeL env ty@(FunTy arg res) 
+  = pprIlxTypeR env ty
+
+pprIlxTypeL env ty@(ForAllTy arg res) 
+  = pprIlxTypeR env ty
+ 
+pprIlxTypeL env ty@(TyConApp tc (h:t)) | isAlgTyCon tc && null (tyConTyVars tc)
+   = ilxComment (text "what the fuck?") <+> (pprIlxTypeR env ty)
+pprIlxTypeL env ty@(TyConApp tc (h:t)) | isAlgTyCon tc && not (isIlxTyVar (hd (tyConTyVars tc)))
+  = pprIlxTypeR env ty
+
+pprIlxTypeL env ty | isUnLiftedType ty  -- must come after cases above because isUnLiftedType strips Forall's
+  = pprIlxTypeR env ty
+
+pprIlxTypeL env ty
+  = text "thunk" <> angleBrackets (pprIlxTypeR env ty)
+
+--------------------------
+-- Print non-thunkable version of type.
+--
+
+pprIlxTypeR :: IlxEnv -> Type -> SDoc
+pprIlxTypeR env ty | isVoidIlxRepType ty = text "void"
+pprIlxTypeR env ty =  pprIlxTypeR2 env ty 
+
+pprIlxTypeR2 env ty@(AppTy f _) | isTyVarTy f    = ilxComment (text "type app:" <+> pprId ty) <+> (text "class [mscorlib]System.Object")
+pprIlxTypeR2 env ty@(AppTy f x)     = trace "pprIlxTypeR: should I be beta reducing types?!" (ilxComment (text "pprIlxTypeR: should I be beta reducing types...") <+> pprIlxTypeR env (applyTy f x))
+pprIlxTypeR2 env (TyVarTy tv)       = pprIlxTyVar env tv
+
+-- The following is a special rule for types constructed out of 
+-- higher kinds, e.g. Monad f or Functor f.  
+--
+-- The code below is not as general as it should be, but as I
+-- have no idea if this approach will even work, I'm going to
+-- just try it out on some simple cases arising from the prelude.
+pprIlxTypeR2 env ty@(TyConApp tc (h:t)) | isAlgTyCon tc && null (tyConTyVars tc)
+   = ilxComment (text "what the fuck? 2") <+> (pprIlxTypeR env (TyConApp tc t))
+pprIlxTypeR2 env ty@(TyConApp tc (h:t)) | isAlgTyCon tc && not (isIlxTyVar (hd (tyConTyVars tc)))
+   = pprIlxTypeR env (TyConApp tc t)
+pprIlxTypeR2 env (TyConApp tc args) = pprIlxTyConApp env tc args
+
+  -- nb. the only legitimate place for VoidIlxRepTypes to occur in normalized IlxRepTypes 
+  -- is on the left of an arrow
+  --  We could probably eliminate all but a final occurrence of these.
+  --pprIlxTypeR2 env (FunTy arg res@(FunTy _ _)) | isVoidIlxRepType arg  
+  --   = pprIlxTypeR env res
+pprIlxTypeR2 env (FunTy arg res) | isVoidIlxRepType arg  
+  = parens (text "func () -->" <+> pprIlxTypeR env res)
+pprIlxTypeR2 env (FunTy arg res)
+    = pprIlxFunTy (pprIlxTypeL env arg) (pprIlxTypeR env res)
+
+pprIlxTypeR2 env ty@(ForAllTy tv body_ty) | isIlxTyVar tv
+  = parens (text "forall" <+> pprTyVarBinders env' [tv] <+> nest 2 (pprIlxTypeR env' body_ty))
+    where
+       env' = extendIlxEnvWithFormalTyVars env [tv]
+
+pprIlxTypeR2 env ty@(ForAllTy tv body_ty) | otherwise
+  = ilxComment (text "higher order type var " <+> pprId tv) <+>
+    pprIlxFunTy (text "class [mscorlib]System.Object") (pprIlxTypeR env body_ty)
+
+pprIlxTypeR2 env (NoteTy _ ty)       
+   = trace "WARNING! non-representation type given to pprIlxTypeR: see generated ILX for context where this occurs"
+     (vcat [text "/* WARNING! non-representation type given to pprIlxTypeR! */",
+           pprIlxTypeR env ty ])
+
+
+pprIlxFunTy dom ran = parens (hsep [text "func",parens dom,text "-->", ran])
+
+pprIlxTyConApp env tc args =
+   case lookupUFM tyPrimConTable (getUnique tc) of
+	Just f  -> f env args
+        Nothing -> 
+            (if isUnboxedTupleTyCon tc then pprIlxUnBoxedTyConApp else pprIlxBoxedTyConApp)
+              env ((nameReference env (getName tc)) <> (ppr tc)) args
+
+pprIlxUnBoxedTyConApp env tcdoc args = text "value class" <+> tcdoc <> pprTypeArgs pprIlxTypeL env args
+pprIlxBoxedTyConApp env tcdoc args = text "class" <+> tcdoc <> pprTypeArgs pprIlxTypeR env args
+
+-- Returns e.g: <Int32, Bool>
+pprTypeArgs f env tys = pprTypeArgs_aux f env (filter (not . isVoidIlxRepType) tys)
+
+pprTypeArgs_aux f env []  = empty
+pprTypeArgs_aux f env tys = angleBrackets (pprSepWithCommas (f env) tys)
+
+
+pprTyVarBinders :: IlxEnv -> [TyVar] -> SDoc
+-- Returns e.g: <class [mscorlib]System.Object> <class [mscorlib]System.Object>
+-- plus a new environment with the type variables added.
+pprTyVarBinders env [] = empty
+pprTyVarBinders env tvs = angleBrackets (pprSepWithCommas (pprTyVarBinder_aux env) tvs)
+
+pprTyVarBinder :: IlxEnv -> TyVar -> SDoc
+pprTyVarBinder env tv = 
+    if isIlxTyVar tv then 
+       angleBrackets (pprTyVarBinder_aux env tv)
+    else
+       ilxComment (text "higher order tyvar" <+> pprId tv <+> 
+                         text ":" <+> pprIlxTypeR env (tyVarKind tv)) <+>
+             ilxComment (text "omitted")
+             -- parens (text "class [mscorlib]System.Object" <+> pprId tv)
+
+
+pprTyVarBinder_aux env tv = 
+   ilxComment (text "tyvar" <+> pprId tv <+> text ":" <+> 
+                        pprIlxTypeR env (tyVarKind tv)) <+>
+             (text "class [mscorlib]System.Object")
+
+-- Only a subset of Haskell types can be generalized using the type quantification
+-- of ILX
+isIlxForAllKind h = 
+        ( h == boxedTypeKind) ||
+        ( h == unboxedTypeKind) ||
+        ( h == openTypeKind) ||
+        ( h == anyBoxKind) 
+
+isIlxTyVar v = isTyVar v && isIlxForAllKind (tyVarKind v)
+
+categorizeVars fvs = (ilx_tvs, non_ilx_tvs, vs)
+         where
+           (tvs, vs) = partition isTyVar fvs
+           (ilx_tvs, non_ilx_tvs) = categorizeTyVars tvs
+
+categorizeTyVars tyvs = partition isIlxTyVar tyvs
+
+pprValArgTys ppr_ty env tys = parens (pprSepWithCommas (ppr_ty env) tys)
+
+pprId id = squotes (ppr id)
+squotes s = text "'" <> s <> text "'"
+
+\end{code}			
+
+%************************************************************************
+%*									*
+\subsection{IlxEnv}	
+%*									*
+%************************************************************************
+
+\begin{code}
+type IlxTyEnv = [TyVar]
+emptyIlxTyEnv = []
+
+-- Nb. There is currently no distinction between the kinds of type variables.
+-- We may need to add this to print out correct numbers, esp. for
+-- "forall" types
+extendIlxTyEnvWithFreeTyVars env tyvars = env ++ mkIlxTyEnv tyvars -- bound by .closure x<...> in a closure declared with type parameters
+extendIlxTyEnvWithFormalTyVars env tyvars = env ++ mkIlxTyEnv tyvars -- bound by "forall <...>" in a type
+extendIlxTyEnvWithTyArgs env tyvars = env ++ mkIlxTyEnv tyvars -- bound by "<...>" in a closure implementing a universal type
+
+formalIlxTyEnv tyvars = mkIlxTyEnv tyvars
+mkIlxTyEnv tyvars = [ v | v <- tyvars, isIlxTyVar v ]
+
+pprIlxTyVarInIlxTyEnv :: IlxTyEnv -> TyVar -> SDoc
+pprIlxTyVarInIlxTyEnv tv_env tv
+  = go 0 tv_env
+  where
+    go n [] 		    
+      = pprTrace "pprIlxTyVar" (pprId tv <+> text "tv_env = { "
+           <+> pprSepWithCommas (\x -> pprId x <+> text ":" 
+           <+> pprIlxTypeR (IlxEnv (thisModule, tv_env, emptyVarEnv, emptyVarEnv, (empty,empty),False)) (tyVarKind x)) tv_env <+> text "}") 
+        (char '!' <> pprId tv) 
+    go n (x:xs)
+      = {- pprTrace "go" (ppr (tyVarName tv) <+> ppr (tyVarName x)) -}
+        (if tyVarName x== tyVarName tv then  char '!' <> int n <+> ilxComment (char '!' <> pprId tv) 
+         else go (n+1) xs)
+
+
+data HowBound = Top Module 	-- Bound in a modules
+	      | Arg	-- Arguments to the enclosing closure
+	      | CloVar Int -- A free variable of the enclosing closure
+                           -- The int is the index of the field in the 
+                           -- environment
+	      | Local	-- Local let binding
+
+-- The SDoc prints a unique name for the syntactic block we're currently processing,
+-- e.g. Foo_bar_baz when inside closure baz inside closure bar inside module Foo.
+data IlxEnv = IlxEnv (Module, IlxTyEnv, IdEnv HowBound,IdEnv (IlxEnv, StgRhs), Place,Bool)
+type Place = (SDoc,SDoc)
+thisModule = mkThisModule (mkSrcModule "")
+
+pprIlxTyVar (IlxEnv (_, tv_env, _, _,_,_)) tv = pprIlxTyVarInIlxTyEnv tv_env tv 
+
+emptyIlxEnv :: Bool -> Module -> IlxEnv
+emptyIlxEnv trace mod = IlxEnv (mod, emptyIlxTyEnv, emptyVarEnv, emptyVarEnv, (ppr mod,empty),trace)
+
+nextPlace place sdoc = place <> sdoc
+usePlace  place sdoc = place <> sdoc
+
+ilxEnvSetPlace (IlxEnv (m, tv_env, id_env,  bind_env, (mod,exact),tr)) sdoc 
+   = IlxEnv (m, tv_env, id_env,  bind_env, (mod, sdoc),tr)
+ilxEnvNextPlace (IlxEnv (m, tv_env, id_env,  bind_env, (mod,exact),tr)) sdoc 
+   = IlxEnv (m, tv_env, id_env,  bind_env, (mod, nextPlace exact sdoc),tr)
+ilxEnvQualifyByModule (IlxEnv (_, _, _, _,(mod,_),_)) sdoc = usePlace mod sdoc
+ilxEnvQualifyByExact (IlxEnv (_, _, _, _,(mod,exact),_)) sdoc = usePlace mod sdoc <> usePlace exact sdoc
+
+ilxPlaceStgBindDefault env = ilxEnvNextPlace env (text "D")
+ilxPlaceStgRhsClosure env bndr = ilxEnvSetPlace env (ppr bndr) -- binders are already unique
+ilxPlaceStgCaseScrut env = ilxEnvNextPlace env (text "S")
+
+ilxPlaceAlt :: IlxEnv -> Int -> IlxEnv
+ilxPlaceAlt env i = ilxEnvNextPlace env (text "a" <> int i)
+ilxPlacePrimAltLit env i = ilxEnvNextPlace env (text "P" <> int i)
+ilxMapPlaceArgs start f env args = [ f (ilxEnvNextPlace env (text "A" <> int i)) a | (i,a) <- [start..] `zip` args ]
+ilxMapPlaceAlts f env alts = [ f (ilxPlaceAlt env i) alt | (i,alt) <- [1..] `zip` alts ]
+
+extendIlxEnvWithFreeTyVars (IlxEnv (mod, tv_env, id_env,  bind_env, place,tr)) tyvars 
+  = IlxEnv (mod, extendIlxTyEnvWithFreeTyVars tv_env tyvars,id_env,  bind_env, place,tr)
+
+extendIlxEnvWithFormalTyVars (IlxEnv (mod, tv_env, id_env,  bind_env, place,tr)) tyvars 
+  = IlxEnv (mod, extendIlxTyEnvWithFormalTyVars tv_env tyvars,id_env,  bind_env, place,tr)
+
+extendIlxEnvWithTyArgs (IlxEnv (mod, tv_env, id_env,  bind_env, place,tr)) tyvars 
+  = IlxEnv (mod, extendIlxTyEnvWithTyArgs tv_env tyvars,id_env,  bind_env, place,tr)
+
+extendIlxEnvWithArgs :: IlxEnv -> [Var] -> IlxEnv
+extendIlxEnvWithArgs (IlxEnv (mod, tv_env, id_env,  bind_env, place,tr)) args
+  = IlxEnv (mod, extendIlxTyEnvWithTyArgs tv_env [tv      | tv <- args, isIlxTyVar tv],
+            extendVarEnvList id_env [(v,Arg) | v  <- args, not (isIlxTyVar v)], 
+	     bind_env, place,tr)
+
+extendIlxEnvWithFreeVars (IlxEnv (mod, tv_env, id_env,  bind_env, place,tr)) args
+  = IlxEnv (mod, 
+            extendIlxTyEnvWithFreeTyVars tv_env [tv | tv <- args, isIlxTyVar tv],
+            extendVarEnvList id_env (clovs 0 args), 
+            bind_env, 
+            place,tr)
+   where
+     clovs _ [] = []
+     clovs n (x:xs) = if not (isIlxTyVar x) then (x,CloVar n):clovs (n+1) xs else clovs n xs
+
+extendIlxEnvWithBinds env@(IlxEnv (mod, tv_env, id_env, bind_env, place,tr)) bnds
+  = IlxEnv (mod, tv_env, id_env, 
+            extendVarEnvList bind_env [(v,(env,rhs)) | (v,rhs) <- bnds], 
+            place,tr)
+
+extendIlxEnvWithLocals (IlxEnv (m, tv_env, id_env, bind_env, p,tr)) locals
+  = IlxEnv (m, tv_env, 
+            extendVarEnvList id_env [(v,Local) | (LocalId v,_) <- locals],
+            extendVarEnvList bind_env [(v,(env,rhs)) | (LocalId v,Just (env,rhs)) <- locals], 
+            p,tr)
+extendIlxEnvWithTops env@(IlxEnv (m, tv_env, id_env, bind_env, place,tr)) mod binds
+  = IlxEnv (m, tv_env, 
+            extendVarEnvList id_env [(bndr,Top mod) | (bndr,rhs) <- binds], 
+            extendVarEnvList bind_env [(bndr,(env, rhs)) | (bndr,rhs) <- binds], 
+            place,tr)
+
+formalIlxEnv (IlxEnv (m, tv_env, id_env, bind_env, place, tr)) tyvars 
+  = IlxEnv (m, formalIlxTyEnv tyvars, id_env, bind_env, place, tr)
+
+elemIlxTyVarEnv var env@(IlxEnv (_, tv_env, _,_,_,_)) = elem var tv_env 
+elemIlxVarEnv var env@(IlxEnv (_, _, id_env,_,_,_)) = elemVarEnv var id_env 
+lookupIlxVarEnv env@(IlxEnv (_, _, id_env,_,_,_)) var = lookupVarEnv id_env var
+lookupIlxBindEnv env@(IlxEnv (_, _, _, bind_env,_,_)) var = lookupVarEnv bind_env var
+
+\end{code}
+
+
+\begin{code}
+type IlxLabel = SDoc
+
+pprIlxLabel lbl = lbl
+
+mkJoinLabel :: Id -> IlxLabel
+mkJoinLabel v = text "J_" <> ppr v
+
+mkAltLabel  :: Id -> Int -> IlxLabel
+mkAltLabel v n = text "A" <> int n <> ppr v
+
+ilxLabel :: IlxLabel -> SDoc
+ilxLabel lbl =  line $$ (pprIlxLabel lbl <> colon)
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Local pretty helper functions}
+%*									*
+%************************************************************************
+
+\begin{code}
+pprSepWithCommas :: (a -> SDoc) -> [a] -> SDoc
+pprSepWithCommas pp xs = sep (punctuate comma (map pp xs))
+ilxComment pp = text "/*" <+> pp <+> text "*/"
+singleQuotes pp = char '\'' <> pp <> char '\''
+squareBrackets pp = char '[' <> pp <> char ']'
+
+line = text "// ----------------------------------"
+
+nameReference (IlxEnv (thisMod, _, _, _, _, _)) n
+  | isLocalName n = text "/* local */"
+  | thisMod == nameModule n  = text ""
+  | isDllName n = squareBrackets ((text "ilx") <+> singleQuotes (text (_UNPK_ (modulePackageName (nameModule n))) <> hscOptionQual))
+  | otherwise   = squareBrackets ((text ".module") <+> (text "ilx") <+> singleQuotes (pprModuleName (moduleName (nameModule n)) <> hscOptionQual))
+
+hscOptionQual = if opt_DoEtaReduction then text ".O" else text ".Onot"
+moduleReference (IlxEnv (thisMod, _, _, _, _, _)) m
+  | thisMod   == m    = text ""
+  | isLocalModule m = squareBrackets ((text ".module") <+> (text "ilx") <+>singleQuotes (pprModuleName (moduleName m) <> hscOptionQual))
+  | otherwise       = squareBrackets ((text "ilx") <+> singleQuotes (text (_UNPK_ (modulePackageName m)) <> hscOptionQual))
+
+prelGHCReference =
+   if preludePackage == opt_InPackage then squareBrackets (text ".module ilx PrelGHC" <> hscOptionQual) 
+   else squareBrackets (text "ilx" <+> text (_UNPK_ preludePackage)  <> hscOptionQual)
+
+prelBaseReference =
+   if preludePackage == opt_InPackage then squareBrackets (text ".module ilx PrelBase" <> hscOptionQual) 
+   else squareBrackets (text "ilx" <+> text (_UNPK_ preludePackage) <> hscOptionQual)
+
+------------------------------------------------
+-- This code is copied from absCSyn/CString.lhs,
+-- and modified to do the correct thing!  It's
+-- still a mess though.  Also, still have to do the
+-- right thing for embedded nulls.
+
+pprFSInILStyle :: FAST_STRING -> SDoc
+pprFSInILStyle fs = doubleQuotes (text (stringToC (_UNPK_ fs)))
+
+stringToC   :: String -> String
+-- Convert a string to the form required by C in a C literal string
+-- Tthe hassle is what to do w/ strings like "ESC 0"...
+stringToC ""  = ""
+stringToC [c] = charToC c
+stringToC (c:cs)
+    -- if we have something "octifiable" in "c", we'd better "octify"
+    -- the rest of the string, too.
+  = if (c < ' ' || c > '~')
+    then (charToC c) ++ (concat (map char_to_C cs))
+    else (charToC c) ++ (stringToC cs)
+  where
+    char_to_C c | c == '\n' = "\\n"	-- use C escapes when we can
+		| c == '\a' = "\\a"
+		| c == '\b' = "\\b"	-- ToDo: chk some of these...
+		| c == '\r' = "\\r"
+		| c == '\t' = "\\t"
+		| c == '\f' = "\\f"
+		| c == '\v' = "\\v"
+		| otherwise = '\\' : (trigraph (ord c))
+
+charToC :: Char -> String
+-- Convert a character to the form reqd in a C character literal
+charToC c = if (c >= ' ' && c <= '~')	-- non-portable...
+	    then case c of
+		  '\'' -> "\\'"
+		  '\\' -> "\\\\"
+		  '"'  -> "\\\""
+		  '\n' -> "\\n"
+		  '\a' -> "\\a"
+		  '\b' -> "\\b"
+		  '\r' -> "\\r"
+		  '\t' -> "\\t"
+		  '\f' -> "\\f"
+		  '\v' -> "\\v"
+		  _    -> [c]
+	    else '\\' : (trigraph (ord c))
+
+trigraph :: Int -> String
+trigraph n
+  = [chr ((n `div` 100) `rem` 10 + ord '0'),
+     chr ((n `div` 10) `rem` 10 + ord '0'),
+     chr (n `rem` 10 + ord '0')]
+
+
+\end{code}
+
+%************************************************************************
+%*									*
+\subsection{PrimOps and Constructors}
+%*									*
+%************************************************************************
+
+\begin{code}
+----------------------------
+-- Allocate a fresh constructor
+
+ilxConApp env data_con args
+  | isUnboxedTupleCon data_con
+     = let tm_args' = filter (not. isVoidIlxRepType . stgArgType) tm_args in 
+       case tm_args' of
+        [h] -> 
+          -- Collapse the construction of an unboxed tuple type where
+          -- every element is zero-sized
+            vcat (ilxMapPlaceArgs 0 pushArg env tm_args')
+        _ -> 
+          -- Minimize the construction of an unboxed tuple type, which
+          -- may contain zero-sized elements.  Recompute all the 
+          -- bits and pieces from the simpler case below for the new data
+          -- type constructor....
+           let data_con' = unboxedTupleCon (length tm_args') in 
+           let rep_ty_args' = filter (not . isVoidIlxRepType) rep_ty_args in 
+
+           let tycon' = dataConTyCon data_con' in
+           let (formal_tyvars', formal_tau_ty') = splitForAllTys (dataConRepType data_con') in 
+           let (formal_arg_tys', _)     = splitFunTys formal_tau_ty' in
+           let formal_env' 	     = formalIlxEnv env formal_tyvars' in 
+
+           vcat [vcat (ilxMapPlaceArgs 0 pushArg env tm_args'),
+	           sep [text "newobj void ",
+  		        pprIlxTyConApp env tycon' rep_ty_args',
+                        text "::.ctor",
+                        pprValArgTys pprIlxTypeR formal_env' (map deepIlxRepType formal_arg_tys')
+	           ]
+             ]
+ | otherwise
+    -- Now all other constructions
+     =	--  Assume C :: forall a. a -> T a -> T a
+   	--	ldloc x		arg of type Int
+	--	ldloc y		arg of type T Int
+	-- 	newdata classunion T<Int32>, C(!0, T <!0>)
+	--
+        let tycon   = dataConTyCon data_con in 
+        let (formal_tyvars, formal_tau_ty) = splitForAllTys (dataConRepType data_con) in
+        let (formal_arg_tys, _)     = splitFunTys formal_tau_ty in 
+
+       vcat [vcat (ilxMapPlaceArgs 0 pushArg env tm_args),
+	  sep [	text "newdata",
+		nest 2 (pprIlxTyConApp env tycon rep_ty_args <> comma),
+		nest 2 (ilxConRef env data_con)
+	  ]
+        ]
+ where
+   tycon   = dataConTyCon data_con 
+   rep_ty_args = map deepIlxRepType ty_args
+   (ty_args,tm_args) = if isAlgTyCon tycon then splitTyArgs (tyConTyVars tycon) args  else splitTyArgs1 args
+
+-- split some type arguments off, throwing away the higher kinded ones for the moment
+-- base the higher-kinded checks off a corresponding list of formals
+splitTyArgs (htv:ttv) (StgTypeArg h:t) 
+   | isIlxTyVar htv = ((h:l), r) 
+   | otherwise = trace "splitTyArgs: threw away higher kinded type arg" (l, r) 
+   where (l,r) = splitTyArgs ttv t 
+splitTyArgs _ l = ([],l)
+ 
+-- split some type arguments off, where none should be higher kinded
+splitTyArgs1 (StgTypeArg h:t) 
+   = ((h:l), r) 
+   where (l,r) = splitTyArgs1 t 
+splitTyArgs1 l = ([],l)
+ 
+
+ilxConRef env data_con
+    = pprId data_con <> pprValArgTys pprIlxTypeL env' (map deepIlxRepType (filter (not . isVoidIlxRepType) arg_tys))
+  where
+    (tyvars, tau_ty) = splitForAllTys (dataConRepType data_con)
+    (arg_tys, _)     = splitFunTys tau_ty
+    env' 	     = formalIlxEnv env tyvars
+
+
+tyPrimConTable :: UniqFM (IlxEnv -> [Type] -> SDoc)
+tyPrimConTable = listToUFM [(addrPrimTyConKey, 	(\_ _ -> repAddr)),
+			    (fileStreamPrimTyConKey, 	(\_ _ -> repFileStream)),
+			    (foreignObjPrimTyConKey, 	(\_ _ -> text "/* ForeignObj */ void *")),
+			    -- (stablePtrPrimTyConKey, 	(\_ _ -> text "/* StablePtr */ void *")),
+			    (charPrimTyConKey, 	(\_ _ -> repChar)),
+			    (wordPrimTyConKey, 	(\_ _ -> repWord)),
+	                    (byteArrayPrimTyConKey,	(\_ _ -> repByteArray)),
+			    (intPrimTyConKey, 	(\_ _ -> repInt)),
+			    (int64PrimTyConKey,	(\_ _ -> repInt64)),
+			    (word64PrimTyConKey,	(\_ _ -> repWord64)),
+			    (floatPrimTyConKey, 	(\_ _ -> text "float32")),
+			    (arrayPrimTyConKey, 	(\env [ty] -> pprIlxTypeL env ty <> text "[]")),
+			    (mutableArrayPrimTyConKey, 	(\env [_, ty] -> pprIlxTypeL env ty <> text "[]")),
+			    (mVarPrimTyConKey, 	(\env [_, ty] -> repMVar (pprIlxTypeL env ty))),
+			    (mutVarPrimTyConKey, 	(\env [ty1, ty2] -> repMutVar (pprIlxTypeL env ty1) (pprIlxTypeL env ty2))),
+	                    (mutableByteArrayPrimTyConKey,	(\_ _ -> repByteArray)),
+	                    (threadIdPrimTyConKey,	(\_ _ -> text "class [mscorlib]System.Threading.Thread /* ThreadId# */ ")),
+			    (doublePrimTyConKey,	(\_ _ -> text "float64"))
+	     ]
+
+
+\end{code}
+
+%************************************************************************
+%*									*
+\subsection{C Calls}
+%*									*
+%************************************************************************
+
+\begin{code}
+
+-- We eliminate voids in and around an IL C Call.  We don't yet emit PInvoke stubs.
+-- We also do some type-directed translation for pinning Haskell-managed blobs
+-- of data as we throw them across the boundary.
+ilxCCall env (CCall (StaticTarget c) casm gc cconv) args ret_ty =
+   ilxComment (text "C call <+> pprCLabelString c") <+> 
+	vcat [vcat (ilxMapPlaceArgs 0 pushCArg env args),
+              text "call" <+> retdoc <+> text "class " <+> prelGHCReference <+> text "PrelGHC::" <+> pprCLabelString c  <+> pprTypeArgs pprIlxTypeR env ty_args
+                    <+> pprCValArgTys pprIlxTypeL env (map deepIlxRepType (filter (not. isVoidIlxRepType) (map stgArgType tm_args))) ]
+  where 
+    retdoc = 
+          if isVoidIlxRepType ret_ty then text "void" 
+          else pprIlxTypeR env (deepIlxRepType ret_ty)
+    (ty_args,tm_args) = splitTyArgs1 args 
+
+
+hasTyCon (TyConApp tc _) tc2 = tc == tc2
+hasTyCon _  _ = False
+
+isByteArrayCArgTy ty = hasTyCon ty byteArrayPrimTyCon || hasTyCon ty mutableByteArrayPrimTyCon
+isByteArrayCArg v = isByteArrayCArgTy (deepIlxRepType (idType v))
+pinCCallArg v = isByteArrayCArg v 
+
+ilxAddrOfPinnedByteArr = text "ldc.i4 0 ldelema unsigned int8"
+
+pushCArg env arg@(StgVarArg v) | isByteArrayCArg v = pushArg env arg <+> text "dup stloc" <+> squotes (ilxEnvQualifyByExact env (ppr v) <> text "pin") <+> ilxAddrOfPinnedByteArr
+pushCArg env arg | otherwise = pushArg env arg
+
+pprCValArgTys f env tys = parens (pprSepWithCommas (pprCValArgTy f env) tys)
+pprCValArgTy f env ty | isByteArrayCArgTy ty = text "void *" <+> ilxComment (text "interior pointer into ByteArr#")
+pprCValArgTy f env ty | otherwise = f env ty
+
+
+\end{code}
+
+%************************************************************************
+%*									*
+\subsection{PrimOps}
+%*									*
+%************************************************************************
+
+\begin{code}
+
+ilxPrimApp env (CCallOp ccall) args ret_ty = ilxCCall env ccall args ret_ty
+
+ilxPrimApp env op args ret_ty
+  = case lookupFM ilxPrimOpTable op of
+	Just fn -> fn env args
+	Nothing -> ilxComment (simp_op (text "Unknown primop!:" <+> pprId op) env args)
+
+
+
+ilxMkBool =  text "call class" <+> prelBaseReference <+> 
+             text "PrelBase_Bool" <+> 
+             prelGHCReference <+> text "GHC.support::mkBool(bool)"
+ilxCgt = text "cgt " <+> ilxMkBool
+ilxCge = text "clt ldc.i4 0 ceq " <+> ilxMkBool
+ilxClt = text "clt " <+> ilxMkBool
+ilxCle = text "cgt ldc.i4 0 ceq " <+> ilxMkBool
+ilxCeq = text "ceq " <+> ilxMkBool
+ilxCne = text "ceq ldc.i4 0 ceq "  <+> ilxMkBool
+ilxCgtUn = text "cgt.un " <+> ilxMkBool
+ilxCgeUn = text "clt.un ldc.i4 0 ceq " <+> ilxMkBool
+ilxCltUn = text "clt.un " <+> ilxMkBool
+ilxCleUn = text "cgt.un ldc.i4 0 ceq " <+> ilxMkBool
+ldDummyInteger = text " ldc.i4 0 ldnull newobj void" <+> ilxUnboxedPairRep  repInt repByteArray <+> text "::.ctor(!0,!1)"
+ldDummyInteger2 = text " ldc.i4 0 ldnull ldc.i4 0 ldnull newobj void" <+> ilxUnboxedQuadRep  repInt repByteArray repInt repByteArray <+> text "::.ctor(!0,!1,!2,!3)"
+
+repByteArray = text "unsigned int8[] /* ByteArr# */ "
+repFileStream = text "void * /* FileStream# */ "  -- text "class [mscorlib]System.IO.FileStream"
+repInt = text "int32"
+repWord = text "unsigned int32"
+repAddr = text "/* Addr */ void *"
+repInt64 = text "int64"
+repWord64 = text "unsigned int64"
+repChar = text "/* Char */ unsigned int8"
+repInteger = ilxUnboxedPairRep repInt repByteArray
+repIntegerPair = ilxUnboxedQuadRep repInt repByteArray repInt repByteArray
+repMVar ty = text "class " <+> prelGHCReference <+> text "PrelGHC_MVarzh" <+> ilxTyParams [ty]
+repMutVar _ ty2 = text "class " <+> prelGHCReference <+> text "PrelGHC_MutVarzh" <+> ilxTyParams [ty2]
+repWeak ty1 = text "class " <+> prelGHCReference <+> text "PrelGHC_Weakzh" <+> ilxTyParams [ty1]
+
+ilxParamsAux [] = empty
+ilxParamsAux [h] = h
+ilxParamsAux (h:t) = h <> text "," <+> ilxParamsAux t
+ilxParams [] = empty
+ilxParams l = parens (ilxParamsAux l)
+
+ilxTyParamsAux [] = empty
+ilxTyParamsAux [h] = h
+ilxTyParamsAux (h:t) = h <> text "," <+> ilxTyParamsAux t
+ilxTyParams [] = empty
+ilxTyParams l = angleBrackets (ilxTyParamsAux l)
+
+ilxMethA = text "!!0"
+
+ilxTyPair l r = ilxTyParams [l,r]
+ilxTyTriple l m r = ilxTyParams [l,m,r]
+ilxTyQuad l m1 m2 r = ilxTyParams [l,m1,m2,r]
+ilxUnboxedPairRep l r = text "value class" <+> prelGHCReference <+> text "PrelGHC_ZLzhzx2czhZR" <+> ilxTyPair l r
+ilxUnboxedTripleRep l m r = text "value class" <+> prelGHCReference <+> text "PrelGHC_ZLzhzx2czx2czhZR" <+> ilxTyTriple l m r
+ilxUnboxedQuadRep l m1 m2 r = text "value class" <+> prelGHCReference <+> text "PrelGHC_ZLzhzx2czx2czx2czhZR" <+> ilxTyQuad l m1 m2 r
+
+ilxMethodRef rty cls nm tyargs args = rty <+> cls <+> text "::" <> squotes (text nm) <> ilxTyParams tyargs <> ilxParams args
+
+ilxSupportClass = prelGHCReference <+> text "GHC.support"
+ilxSuppMeth rty nm tyargs args = ilxMethodRef rty ilxSupportClass nm tyargs args
+
+ilxPrimOpTable :: FiniteMap PrimOp (IlxEnv -> [StgArg] -> SDoc)
+ilxPrimOpTable =
+  listToFM [(CharGtOp,    simp_op ilxCgt),
+            (CharGeOp,    simp_op ilxCge),
+            (CharEqOp,    simp_op ilxCeq),
+            (CharNeOp,    simp_op ilxCne),
+            (CharLtOp,    simp_op ilxClt),
+            (CharLeOp,    simp_op ilxCle),
+
+            (OrdOp,       simp_op (text "conv.i4")), -- chars represented by UInt32 (u4)
+            (ChrOp,       simp_op (text "conv.u4")),
+
+	    (IntGtOp,     simp_op ilxCgt),
+	    (IntGeOp,     simp_op ilxCge),
+	    (IntEqOp,     simp_op ilxCeq),
+	    (IntNeOp,     simp_op ilxCne),
+	    (IntLtOp,     simp_op ilxClt),
+	    (IntLeOp,     simp_op ilxCle),
+
+	    (WordGtOp,     simp_op ilxCgtUn), -- words represented by UInt32 (u4)
+	    (WordGeOp,     simp_op ilxCgeUn),
+	    (WordEqOp,     simp_op ilxCeq),
+	    (WordNeOp,     simp_op ilxCne),
+	    (WordLtOp,     simp_op ilxCltUn),
+	    (WordLeOp,     simp_op ilxCleUn),
+
+	    (AddrGtOp,     simp_op ilxCgt),
+	    (AddrGeOp,     simp_op ilxCge),
+	    (AddrEqOp,     simp_op ilxCeq),
+	    (AddrNeOp,     simp_op ilxCne),
+	    (AddrLtOp,     simp_op ilxClt),
+	    (AddrLeOp,     simp_op ilxCle),
+
+	    (FloatGtOp,     simp_op ilxCgt),
+	    (FloatGeOp,     simp_op ilxCge),
+	    (FloatEqOp,     simp_op ilxCeq),
+	    (FloatNeOp,     simp_op ilxCne),
+	    (FloatLtOp,     simp_op ilxClt),
+	    (FloatLeOp,     simp_op ilxCle),
+
+	    (DoubleGtOp,     simp_op ilxCgt),
+	    (DoubleGeOp,     simp_op ilxCge),
+	    (DoubleEqOp,     simp_op ilxCeq),
+	    (DoubleNeOp,     simp_op ilxCne),
+	    (DoubleLtOp,     simp_op ilxClt),
+	    (DoubleLeOp,     simp_op ilxCle),
+
+    -- Int#-related ops:
+	    (IntAddOp,    simp_op (text "add")),
+	    (IntSubOp,    simp_op (text "sub")),
+	    (IntMulOp,    simp_op (text "mul")),
+	    (IntQuotOp,   simp_op (text "div")),
+	    (IntNegOp,    simp_op (text "neg")),
+	    (IntRemOp,    simp_op (text "rem")),
+
+	    (Addr2IntOp,  simp_op (text "conv.i4")), -- Addresses are very dodgy for ILX.  They are used for both C-strings and 
+	    (Int2AddrOp,  simp_op (text "conv.i")),  -- the FFI.  This needs more work.
+	    (ISllOp,      simp_op (text "shl")),
+	    (ISraOp,      simp_op (text "shr")),
+	    (ISrlOp,      simp_op (text "shr.un")),
+	    (IntAddCOp,   simp_op (text "call" <+> ilxSuppMeth (ilxUnboxedPairRep repInt repInt) "IntAddCOp" [] [repInt, repInt])),
+	    (IntAddCOp,   simp_op (text "call" <+> ilxSuppMeth (ilxUnboxedPairRep repInt repInt) "IntSubCOp" [] [repInt, repInt])),
+	    (IntAddCOp,   simp_op (text "call" <+> ilxSuppMeth (ilxUnboxedPairRep repInt repInt) "IntMulCOp" [] [repInt, repInt])),
+	    (IntGcdOp,   simp_op (text "call" <+> ilxSuppMeth repInt "IntMulCOp" [] [repInt, repInt])),
+
+
+    -- Word#-related ops:
+	    (AndOp,  simp_op (text "and")), 
+	    (OrOp,  simp_op (text "or")), 
+	    (NotOp,  simp_op (text "not")), 
+	    (XorOp,  simp_op (text "xor")), 
+	    (SllOp,  simp_op (text "shl")), 
+	    (SrlOp,  simp_op (text "shr")), 
+	    (Word2IntOp,  simp_op (text "conv.i4")),
+	    (Int2WordOp,  simp_op (text "conv.u4")),
+
+    -- Float#-related ops:
+	    (FloatAddOp,  simp_op (text "add")),
+	    (FloatSubOp,  simp_op (text "sub")),
+	    (FloatMulOp,  simp_op (text "mul")),
+	    (FloatDivOp,  simp_op (text "div")),
+	    (FloatNegOp,  simp_op (text "neg")),
+	    (Float2IntOp,  simp_op (text "conv.i4")),
+	    (Int2FloatOp,  simp_op (text "conv.r4")),
+
+	    (DoubleAddOp,  simp_op (text "add")),
+	    (DoubleSubOp,  simp_op (text "sub")),
+	    (DoubleMulOp,  simp_op (text "mul")),
+	    (DoubleDivOp,  simp_op (text "div")),
+	    (DoubleNegOp,  simp_op (text "neg")),
+	    (Double2IntOp,  simp_op (text "conv.i4")),
+	    (Int2DoubleOp,  simp_op (text "conv.r4")),
+	    (Double2FloatOp,  simp_op (text "conv.r4")),
+	    (Float2DoubleOp,  simp_op (text "conv.r8")),
+	    (DoubleDecodeOp,   simp_op (text "call" <+> ilxSuppMeth (ilxUnboxedTripleRep repInt repInt repByteArray) "decodeDouble" [] [text "float64"])),
+	    (FloatDecodeOp,   simp_op (text "call" <+> ilxSuppMeth (ilxUnboxedTripleRep repInt repInt repByteArray) "decodeFloat" [] [text "float32"])),
+
+          (FloatExpOp,   simp_op (text "conv.r8 call float64 [mscorlib]System.Math::Exp(float64) conv.r4")),
+          (FloatLogOp,   simp_op (text "conv.r8 call float64 [mscorlib]System.Math::Log(float64) conv.r4")),
+          (FloatSqrtOp,   simp_op (text "conv.r8 call float64 [mscorlib]System.Math::Sqrt(float64) conv.r4")),
+          (FloatSinOp,   simp_op (text "conv.r8 call float64 [mscorlib]System.Math::Sin(float64) conv.r4")),
+          (FloatCosOp,   simp_op (text "conv.r8 call float64 [mscorlib]System.Math::Cos(float64) conv.r4")),
+          (FloatTanOp,   simp_op (text "conv.r8 call float64 [mscorlib]System.Math::Tan(float64) conv.r4")),
+          (FloatAsinOp,   simp_op (text "conv.r8 call float64 [mscorlib]System.Math::Asin(float64) conv.r4")),
+          (FloatAcosOp,   simp_op (text "conv.r8 call float64 [mscorlib]System.Math::Acos(float64) conv.r4")),
+          (FloatAtanOp,   simp_op (text "conv.r8 call float64 [mscorlib]System.Math::Atan(float64) conv.r4")),
+          (FloatSinhOp,   simp_op (text "conv.r8 call float64 [mscorlib]System.Math::Sinh(float64) conv.r4")),
+          (FloatCoshOp,   simp_op (text "conv.r8 call float64 [mscorlib]System.Math::Cosh(float64) conv.r4")),
+          (FloatTanhOp,   simp_op (text "conv.r8 call float64 [mscorlib]System.Math::Tanh(float64) conv.r4")),
+          (FloatPowerOp,   simp_op (text "call float64 [mscorlib]System.Math::Pow(float64, float64) conv.r4")), -- ** op, make use of implicit cast to r8...
+
+          (DoubleExpOp,   simp_op (text "call float64 [mscorlib]System.Math::Exp(float64)")),
+          (DoubleLogOp,   simp_op (text "call float64 [mscorlib]System.Math::Log(float64)")),
+          (DoubleSqrtOp,   simp_op (text "call float64 [mscorlib]System.Math::Sqrt(float64)")),
+          
+          (DoubleSinOp,   simp_op (text "call float64 [mscorlib]System.Math::Sin(float64)")),
+          (DoubleCosOp,   simp_op (text "call float64 [mscorlib]System.Math::Cos(float64)")),
+          (DoubleTanOp,   simp_op (text "call float64 [mscorlib]System.Math::Tan(float64)")),
+          
+          (DoubleAsinOp,   simp_op (text "call float64 [mscorlib]System.Math::Asin(float64)")),
+          (DoubleAcosOp,   simp_op (text "call float64 [mscorlib]System.Math::Acos(float64)")),
+          (DoubleAtanOp,   simp_op (text "call float64 [mscorlib]System.Math::Atan(float64)")),
+          
+          (DoubleSinhOp,   simp_op (text "call float64 [mscorlib]System.Math::Sinh(float64)")),
+          (DoubleCoshOp,   simp_op (text "call float64 [mscorlib]System.Math::Cosh(float64)")),
+          (DoubleTanhOp,   simp_op (text "call float64 [mscorlib]System.Math::Tanh(float64)")),
+          
+          (DoublePowerOp,   simp_op (text "call float64 [mscorlib]System.Math::Pow(float64, float64)")),
+
+    -- Integer (and related...) ops: bail out to support routines
+	    (IntegerAddOp,  simp_op (text "call" <+> ilxSuppMeth repInteger "IntegerAddOp" [] [repInt, repByteArray, repInt, repByteArray])),
+	    (IntegerSubOp,  simp_op (text "call" <+> ilxSuppMeth repInteger "IntegerSubOp" [] [repInt, repByteArray, repInt, repByteArray])),
+	    (IntegerMulOp,  simp_op (text "call" <+> ilxSuppMeth repInteger "IntegerMulOp" [] [repInt, repByteArray, repInt, repByteArray])),
+	    (IntegerGcdOp,  simp_op (text "call" <+> ilxSuppMeth repInteger "IntegerGcdOp" [] [repInt, repByteArray, repInt, repByteArray])),
+	    (IntegerQuotRemOp,  simp_op (text "call" <+> ilxSuppMeth repIntegerPair "IntegerQuotRemOp" [] [repInt, repByteArray, repInt, repByteArray])),
+	    (IntegerDivModOp,  simp_op (text "call" <+> ilxSuppMeth repIntegerPair "IntegerDivModOp" [] [repInt, repByteArray, repInt, repByteArray])),
+	    (IntegerNegOp,  simp_op (text "call" <+> ilxSuppMeth repInteger "IntegerNegOp" [] [repInt, repByteArray])),
+	    (IntegerIntGcdOp,  simp_op (text "call" <+> ilxSuppMeth repInt "IntegerIntGcdOp" [] [repInt, repByteArray, repInt])),
+	    (IntegerDivExactOp,  simp_op (text "call" <+> ilxSuppMeth repInteger "IntegerDivExactOp" [] [repInt, repByteArray, repInt, repByteArray])),
+	    (IntegerQuotOp,  simp_op (text "call" <+> ilxSuppMeth repInteger "IntegerQuotOp" [] [repInt, repByteArray, repInt, repByteArray])),
+	    (IntegerRemOp,  simp_op (text "call" <+> ilxSuppMeth repInteger "IntegerRemOp" [] [repInt, repByteArray, repInt, repByteArray])),
+	    (IntegerCmpOp,  simp_op (text "call" <+> ilxSuppMeth repInt "IntegerCmpOp" [] [repInt, repByteArray, repInt, repByteArray])),
+	    (IntegerCmpIntOp,  simp_op (text "call" <+> ilxSuppMeth repInt "IntegerCmpIntOp" [] [repInt, repByteArray, repInt])),
+	    (Integer2IntOp,  simp_op (text "call" <+> ilxSuppMeth repInt "Integer2IntOp" [] [repInt, repByteArray])),
+	    (Integer2WordOp,  simp_op (text "call" <+> ilxSuppMeth repWord "Integer2WordOp" [] [repInt, repByteArray])),
+	    (Int2IntegerOp,  simp_op (text "call" <+> ilxSuppMeth repInteger "Int2IntegerOp" [] [repInt])),
+	    (Word2IntegerOp,  simp_op (text "call" <+> ilxSuppMeth repInteger "Word2IntegerOp" [] [repWord])),
+	    (Addr2IntegerOp,  simp_op (text "call" <+> ilxSuppMeth repInteger "Addr2IntegerOp" [] [repAddr])),
+	    (IntegerToInt64Op,  simp_op (text "call" <+> ilxSuppMeth repAddr "IntegerToInt64Op" [] [repInt,repByteArray])),
+	    (Int64ToIntegerOp,  simp_op (text "call" <+> ilxSuppMeth repInteger "Int64ToIntegerOp" [] [repInt64])),
+	    (IntegerToWord64Op,  simp_op (text "call" <+> ilxSuppMeth repWord64 "IntegerToWord64Op" [] [repInt,repByteArray])),
+	    (Word64ToIntegerOp,  simp_op (text "call" <+> ilxSuppMeth repInteger "Word64ToIntegerOp" [] [repWord64])),
+
+ 	    (IndexOffForeignObjOp CharRep,  simp_op (text "add ldind.u1")),
+ 	    (IndexOffForeignObjOp IntRep,  simp_op (text "ldc.i4 4 mul add ldind.i4")),
+ 	    (IndexOffForeignObjOp WordRep,  simp_op (text "ldc.i4 4 mul add ldind.u4")),
+ 	    (IndexOffForeignObjOp AddrRep,  warn_op "IndexOffForeignObjOp AddrRep: assuing 32 bit architecture" (simp_op (text "ldc.i4 4 mul add ldind.i  "))),
+ 	    (IndexOffForeignObjOp FloatRep,  simp_op (text "ldc.i4 4 mul add ldind.r4")),
+ 	    (IndexOffForeignObjOp DoubleRep,   simp_op (text "ldc.i4 8 mul add ldind.r8")),
+ 	    (IndexOffForeignObjOp Int64Rep,  simp_op (text "ldc.i4 8 mul add ldind.i8")),
+ 	    (IndexOffForeignObjOp Word64Rep,  simp_op (text "ldc.i4 8 mul add ldind.u8")),
+
+ 	    (IndexOffAddrOp CharRep, simp_op (text "add ldind.u1")),
+ 	    (IndexOffAddrOp IntRep, simp_op (text "ldc.i4 4 mul add ldind.i4")),
+ 	    (IndexOffAddrOp WordRep, simp_op (text "ldc.i4 4 mul add ldind.u4")),
+ 	    (IndexOffAddrOp AddrRep, warn_op "IndexOffAddrOp AddrRep: assuing 32 bit architecture" (simp_op (text "ldc.i4 4 mul add ldind.i"))),
+ 	    (IndexOffAddrOp FloatRep, simp_op (text "ldc.i4 4 mul add ldind.r4")),
+ 	    (IndexOffAddrOp DoubleRep, simp_op (text "ldc.i4 8 mul add ldind.r8")),
+ 	    (IndexOffAddrOp Int64Rep, simp_op (text "ldc.i4 8 mul add ldind.i8")),
+ 	    (IndexOffAddrOp Word64Rep, simp_op (text "ldc.i4 8 mul add ldind.u8")),
+
+
+ 	    (WriteOffAddrOp CharRep, ty1_arg4_op (\sty addr n v s -> addr <+> n <+> text "add" <+> v <+> text "stind.u1")),
+ 	    (WriteOffAddrOp IntRep, ty1_arg4_op (\sty addr n v s -> addr <+> n <+> text "ldc.i4 4 mul add" <+> v <+> text "stind.i4")),
+ 	    (WriteOffAddrOp WordRep, ty1_arg4_op (\sty addr n v s -> addr <+> n <+> text "ldc.i4 4 mul add" <+> v <+> text "stind.u4")),
+ 	    (WriteOffAddrOp AddrRep, ty1_arg4_op (\sty addr n v s -> addr <+> n <+> text "ldc.i4 4 mul add" <+> v <+> text "stind.i")),
+ 	    (WriteOffAddrOp FloatRep, ty1_arg4_op (\sty addr n v s -> addr <+> n <+> text "ldc.i4 4 mul add" <+> v <+> text "stind.r4")),
+ 	    (WriteOffAddrOp DoubleRep, ty1_arg4_op (\sty addr n v s -> addr <+> n <+> text "ldc.i4 8 mul add" <+> v <+> text "stind.r8")),
+ 	    (WriteOffAddrOp Int64Rep, ty1_arg4_op (\sty addr n v s -> addr <+> n <+> text "ldc.i4 8 mul add" <+> v <+> text "stind.i8")),
+ 	    (WriteOffAddrOp Word64Rep, ty1_arg4_op (\sty addr n v s -> addr <+> n <+> text "ldc.i4 8 mul add" <+> v <+> text "stind.u8")),
+                  {-    Addr# -> Int# -> Char# -> State# s -> State# s -} 
+
+ 	    (ReadOffAddrOp CharRep, simp_op (text "add ldind.u1")),
+ 	    (ReadOffAddrOp IntRep, simp_op (text "ldc.i4 4 mul add ldind.i4")),
+ 	    (ReadOffAddrOp WordRep, simp_op (text "ldc.i4 4 mul add ldind.u4")),
+ 	    (ReadOffAddrOp AddrRep, simp_op (text "ldc.i4 4 mul add ldind.i")),
+ 	    (ReadOffAddrOp FloatRep, simp_op (text "ldc.i4 4 mul add ldind.r4")),
+ 	    (ReadOffAddrOp DoubleRep, simp_op (text "ldc.i4 8 mul add ldind.r8")),
+ 	    (ReadOffAddrOp Int64Rep, simp_op (text "ldc.i4 8 mul add ldind.i8")),
+ 	    (ReadOffAddrOp Word64Rep, simp_op (text "ldc.i4 8 mul add ldind.u8")),
+                  {-    Addr# -> Int# -> Char# -> State# s -> State# s -} 
+
+            (RaiseOp, ty2_op (\ty1 ty2 -> text "throw")),
+            (CatchOp, ty2_op  (\ty1 ty2 -> 
+		text "call" <+> ilxSuppMeth ilxMethA "catch" [ty1,ty2] [text "(func () --> !!0)", text "(func (!!1) --> (func () --> !!0))"])),
+                    {-        (State# RealWorld -> (# State# RealWorld, a #) )
+                           -> (b -> State# RealWorld -> (# State# RealWorld, a #) ) 
+                           -> State# RealWorld
+                           -> (# State# RealWorld, a #) 
+                     -} 
+
+             (BlockAsyncExceptionsOp, ty1_op (\ty1 -> 
+		text "call" <+> ilxSuppMeth ilxMethA "blockAsyncExceptions" [ty1] [text "(func () --> !!0)"])),
+
+                {-     (State# RealWorld -> (# State# RealWorld, a #))
+                    -> (State# RealWorld -> (# State# RealWorld, a #))
+                -}
+
+             (UnblockAsyncExceptionsOp, ty1_op (\ty1 -> 
+		text "call" <+> ilxSuppMeth ilxMethA "unblockAsyncExceptions" [ty1] [text "(func () --> !!0)"])),
+
+                {-
+                       (State# RealWorld -> (# State# RealWorld, a #))
+                    -> (State# RealWorld -> (# State# RealWorld, a #))
+                -}
+ 
+             (NewMVarOp, ty2_op (\sty ty -> 
+		text "newobj void " <+> repMVar ty <+> text "::.ctor()")),
+                 {- State# s -> (# State# s, MVar# s a #) -}
+
+             (TakeMVarOp, ty2_op (\sty ty -> 
+		text "call" <+> ilxSuppMeth ilxMethA "takeMVar" [ty] [repMVar ilxMethA])),
+                  {-  MVar# s a -> State# s -> (# State# s, a #) -}
+
+             (PutMVarOp, ty2_op (\sty ty -> 
+		text "call" <+> ilxSuppMeth (text "void") "putMVar" [ty] [repMVar ilxMethA, ilxMethA])),
+                   {- MVar# s a -> a -> State# s -> State# s -}
+
+             (SameMVarOp, ty2_op (\sty ty -> text "ceq " <+> ilxMkBool)),
+                   {- MVar# s a -> MVar# s a -> Bool -}
+
+             (TakeMaybeMVarOp, ty2_op (\sty ty -> 
+		text "call" <+> ilxSuppMeth (ilxUnboxedPairRep repInt ilxMethA) "tryTakeMVar" [ty] [repMVar ilxMethA])),
+
+                {- MVar# s a -> State# s -> (# State# s, Int#, a #) -}
+
+             (IsEmptyMVarOp, ty2_op (\sty ty -> 
+		text "call" <+> ilxSuppMeth repInt "isEmptyMVar" [ty] [repMVar ilxMethA])),
+               {- MVar# s a -> State# s -> (# State# s, Int# #) -}
+
+             (DataToTagOp, ty1_op (\ty1 -> 
+		text "call" <+> ilxSuppMeth repInt "dataToTag" [ty1] [ilxMethA])),
+               {- a -> Int# -}
+
+             (TagToEnumOp, ty1_op (\ty1 -> 
+		text "call" <+> ilxSuppMeth ilxMethA "tagToEnum" [ty1] [repInt])),
+               {- Int# -> a -}
+
+             (IndexByteArrayOp CharRep, simp_op (text "ldelem.u1")),
+             (IndexByteArrayOp IntRep, simp_op (text "ldelem.i4")),
+             (IndexByteArrayOp WordRep, simp_op (text "ldelem.u4")),
+             (IndexByteArrayOp AddrRep, simp_op (text "ldelem.u")),
+             (IndexByteArrayOp FloatRep, simp_op (text "ldelem.r4")),
+             (IndexByteArrayOp DoubleRep, simp_op (text "ldelem.r8")),
+             (IndexByteArrayOp StablePtrRep, simp_op (text "ldelem.i4")),
+             (IndexByteArrayOp Int64Rep, simp_op (text "ldelem.i8")),
+             (IndexByteArrayOp Word64Rep, simp_op (text "ldelem.u8")),
+
+                 {- ByteArr# -> Int# -> Char# -}
+
+             (WriteByteArrayOp CharRep, simp_op (text "stelem.u1")),
+             (WriteByteArrayOp IntRep, simp_op (text "stelem.i4")),
+             (WriteByteArrayOp WordRep, simp_op (text "stelem.u4")),
+             (WriteByteArrayOp AddrRep, simp_op (text "stelem.u")),
+             (WriteByteArrayOp FloatRep, simp_op (text "stelem.r4")),
+             (WriteByteArrayOp DoubleRep, simp_op (text "stelem.r8")),
+             (WriteByteArrayOp StablePtrRep, simp_op (text "stelem.i4")),
+             (WriteByteArrayOp Int64Rep, simp_op (text "stelem.i8")),
+             (WriteByteArrayOp Word64Rep, simp_op (text "stelem.u8")),
+
+                 {- MutByteArr# s -> Int# -> Char# -> State# s -> State# s -}
+
+            {- should be monadic??? -}
+             (ReadByteArrayOp CharRep, simp_op (text "ldelem.u1")),
+             (ReadByteArrayOp IntRep, simp_op (text "ldelem.i4")),
+             (ReadByteArrayOp WordRep, simp_op (text "ldelem.u4")),
+             (ReadByteArrayOp AddrRep, simp_op (text "ldelem.u")),
+             (ReadByteArrayOp FloatRep, simp_op (text "ldelem.r4")),
+             (ReadByteArrayOp DoubleRep, simp_op (text "ldelem.r8")),
+             (ReadByteArrayOp StablePtrRep, simp_op (text "ldelem.i4")),
+             (ReadByteArrayOp Int64Rep, simp_op (text "ldelem.i8")),
+             (ReadByteArrayOp Word64Rep, simp_op (text "ldelem.u8")),
+                 {-   MutByteArr# s -> Int# -> State# s -> (# State# s, Char# #) -}
+
+            {- should be monadic??? -}
+             (NewByteArrayOp CharRep, simp_op (text "newarr [mscorlib]System.Byte")),
+             (NewByteArrayOp IntRep, simp_op (text "newarr [mscorlib]System.Int32")),
+             (NewByteArrayOp WordRep, simp_op (text "newarr [mscorlib]System.UInt32")),
+             (NewByteArrayOp AddrRep, simp_op (text "newarr [mscorlib]System.UInt64")),
+             (NewByteArrayOp FloatRep, simp_op (text "newarr [mscorlib]System.Single")),
+             (NewByteArrayOp DoubleRep, simp_op (text "newarr [mscorlib]System.Double")),
+             (NewByteArrayOp StablePtrRep, simp_op (text "newarr [mscorlib]System.UInt32")),
+{-           (NewByteArrayOp Int64Rep, simp_op (text "newarr [mscorlib]System.Int64")),  TODO: there is no unique for this one -}
+{-           (NewByteArrayOp Word64Rep, simp_op (text "newarr  [mscorlib]System.UInt64")), -}
+                  {- Int# -> State# s -> (# State# s, MutByteArr# s #) -}
+
+             (UnsafeFreezeByteArrayOp,   ty1_op (\ty1  -> text "nop ")),
+                  {- MutByteArr# s -> State# s -> (# State# s, ByteArr# #) -}
+             (SizeofByteArrayOp,  simp_op (text "ldlen")),
+                  {- ByteArr# -> Int# -}
+
+             (SameMutableByteArrayOp, ty1_op (\ty1  -> text "ceq " <+> ilxMkBool)),
+                 {- MutByteArr# s -> MutByteArr# s -> Bool -}
+             (SizeofMutableByteArrayOp, ty1_op (\ty1  -> text "ldlen")),
+                 {- MutByteArr# s -> Int# -}
+
+             (SameMutVarOp, ty2_op (\ty1 ty2 -> text "ceq " <+> ilxMkBool)),
+                 {- MutVar# s a -> MutVar# s a -> Bool -}
+             (NewMutVarOp, ty2_op (\ty1 ty2 -> text "newobj void" <+> repMutVar ty1 ty2 <+> text "::.ctor(!0)")),
+                 {- a -> State# s -> (# State# s, MutVar# s a #) -}
+             (ReadMutVarOp, ty2_op (\ty1 ty2 ->  text "ldfld !0" <+> repMutVar ty1 ty2 <+> text "::contents")),
+                 {-  MutVar# s a -> State# s -> (# State# s, a #) -}
+             (WriteMutVarOp, ty2_op (\ty1 ty2 -> text "stfld !0" <+> repMutVar ty1 ty2 <+> text "::contents")),
+                 {- MutVar# s a -> a -> State# s -> State# s -}
+
+             (NewArrayOp, ty2_op (\ty1 ty2 -> text "call !!0[] " <+> ilxSupportClass <+> text "::newArray<" <> ty1 <> text ">(" <> repInt <> text ", !!0)")),
+                 {- Int# -> a -> State# s -> (# State# s, MutArr# s a #) -}
+             (IndexArrayOp, ty1_op (\ty1 -> text "ldelem.ref")),
+                 {- Array# a -> Int# -> (# a #) -}
+             (WriteArrayOp, ty2_op (\ty1 ty2 -> text "stelem.ref")),
+                 {- MutArr# s a -> Int# -> a -> State# s -> State# s -}
+             (ReadArrayOp, ty2_op (\ty1 ty2 -> text "ldelem.ref")),
+                 {- MutArr# s a -> Int# -> State# s -> (# State# s, a #) -}
+             (UnsafeFreezeArrayOp, ty2_op (\ty1 ty2 -> text "nop")),
+                 {-   MutArr# s a -> State# s -> (# State# s, Array# a #) -}
+             (UnsafeThawArrayOp, ty2_op (\ty1 ty2 -> text "nop")),
+                 {-  Array# a -> State# s -> (# State# s, MutArr# s a #) -}
+
+             (SameMutableArrayOp, ty2_op (\ty1 ty2 -> text "ceq " <+> ilxMkBool)),
+                 {- MutArr# s a -> MutArr# s a -> Bool -}
+
+             (MakeStablePtrOp, ty1_op (\ty1 -> text "newobj void class " <+> prelGHCReference <+> text "PrelGHC_StablePtrzh<" <> ty1 <> text ">::.ctor(!0)")),
+                 {-   a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #) -}
+
+             (DeRefStablePtrOp, ty1_op (\ty1 ->  text "ldfld !0 class " <+> prelGHCReference <+> text "PrelGHC_StablePtrzh<" <> ty1  <> text ">::contents")),
+                 {-  StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #) -}
+
+             (EqStablePtrOp, ty1_op (\ty1 -> text "ceq " <+> ilxMkBool)),
+                 {-  StablePtr# a -> StablePtr# a -> Int# -}
+
+             (MkWeakOp, ty3_op (\ty1 ty2 ty3 ->  text "call" <+> ilxMethodRef (repWeak (text "!!1")) (text "class " <+> prelGHCReference <+> text "PrelGHC_Weakzh") "bake" [ty1,ty2,ty3] [text "!!0", text "!!1", text "!!2"])),
+                 {- o -> b -> c -> State# RealWorld -> (# State# RealWorld, Weak# b #) -}
+
+             (DeRefWeakOp, ty1_op (\ty1 ->  text "call" <+> ilxMethodRef (ilxUnboxedPairRep repInt (text "!0")) (repWeak ty1) "deref" [] [])),
+             (FinalizeWeakOp, ty1_op (\ty1 ->  text "call" <+> ilxMethodRef (ilxUnboxedPairRep repInt (text "(func () --> class '()')")) (repWeak ty1) "finalizer" [] [])),
+                   {-    Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, 
+                        (State# RealWorld -> (# State# RealWorld, Unit #)) #) -}
+
+             (MkForeignObjOp, simp_op (text "nop /* newobj void class " <+> prelGHCReference <+> text "PrelGHC_ForeignObjzh::.ctor(void *) */")),
+             (WriteForeignObjOp, simp_op (text "pop /* stfld void * class " <+> prelGHCReference <+> text "PrelGHC_ForeignObjzh::contents */ ")),
+             -- (ForeignObjToAddrOp, simp_op (text "ldfld void * class " <+> prelGHCReference <+> text "PrelGHC_ForeignObjzh::contents"),
+             (YieldOp, simp_op (text "call class [mscorlib]System.Threading.Thread class [mscorlib]System.Threading.Thread::get_CurrentThread() 
+                                call void class [mscorlib]System.Threading.Thread::Suspend()")),
+             (MyThreadIdOp, simp_op (text "call default  class [mscorlib]System.Threading.Thread class [mscorlib]System.Threading.Thread::get_CurrentThread() ")),
+             (KillThreadOp, simp_op (text "call instance void class [mscorlib]System.Threading.Thread::Abort(class [mscorlib]System.Object) ")),
+              {-   ThreadId# -> a -> State# RealWorld -> State# RealWorld -}
+
+             (ForkOp, ty1_op (\ty -> text "call default class [mscorlib]System.Threading.Thread " <+> ilxSupportClass <+> text "::fork<" <> ty <> text ">(thunk<!0>)")),
+
+  	    (ParOp,  warn_op "ParOp" (simp_op (text "/* ParOp skipped... */ pop ldc.i4 0"))),
+
+            (DelayOp, simp_op (text "call void class [mscorlib]System.Threading.Thread::Sleep(int32) ")),
+                 {-    Int# -> State# s -> State# s -}
+  	    (WaitReadOp,  warn_op "WaitReadOp" (simp_op (text "/* WaitReadOp skipped... */ pop"))),
+   	    (WaitWriteOp,  warn_op "WaitWriteOp" (simp_op (text " /* WaitWriteOp skipped... */ pop")))
+
+
+
+  ]
+
+ty1_op  op env ((StgTypeArg ty1):rest)  = 
+       vcat (ilxMapPlaceArgs 1 pushArg env rest) $$ op (pprIlxTypeR env (deepIlxRepType ty1)) 
+--ty1_after1_op  op env (h:(StgTypeArg ty1):rest)  = 
+--       vcat (ilxMapPlaceArgs 0 pushArg env [h]) $$  vcat (ilxMapPlaceArgs 2 pushArg env rest) $$ op (pprIlxTypeR env (deepIlxRepType ty1)) 
+ty2_op  op env ((StgTypeArg ty1):(StgTypeArg ty2):rest)  = 
+       vcat (ilxMapPlaceArgs 2 pushArg env rest) $$ op (pprIlxTypeR env (deepIlxRepType ty1)) (pprIlxTypeR env (deepIlxRepType ty2))
+
+ty3_op  op env ((StgTypeArg ty1):(StgTypeArg ty2):(StgTypeArg ty3):rest)  = 
+       vcat (ilxMapPlaceArgs 2 pushArg env rest) $$ 
+      op (pprIlxTypeR env (deepIlxRepType ty1)) 
+         (pprIlxTypeR env (deepIlxRepType ty2))
+         (pprIlxTypeR env (deepIlxRepType ty3))
+
+ty1_arg4_op  op env [(StgTypeArg ty1), a1, a2, a3, a4] = 
+       op (pprIlxTypeR env (deepIlxRepType ty1)) 
+          (hd2 (ilxMapPlaceArgs 1 pushArg env [a1]) )
+          (hd2 (ilxMapPlaceArgs 2 pushArg env [a2]) )
+          (hd2 (ilxMapPlaceArgs 3 pushArg env [a3]) )
+          (hd2 (ilxMapPlaceArgs 4 pushArg env [a4]) )
+
+hd (h:t) = h
+hd2 (h:t) = h
+
+simp_op  op env args  = vcat (ilxMapPlaceArgs 0 pushArg env args) $$ op
+warn_op  warning f args  = trace ("WARNING! IlxGen cannot translate primop " ++ warning) (f args)
+\end{code}
diff --git a/ghc/compiler/ilxGen/Makefile.stdlib b/ghc/compiler/ilxGen/Makefile.stdlib
new file mode 100644
index 0000000000..bab993346e
--- /dev/null
+++ b/ghc/compiler/ilxGen/Makefile.stdlib
@@ -0,0 +1,82 @@
+PrelAll_SRC=Array.lhs          Maybe.lhs          PrelDynamic.lhs    PrelIOBase.lhs     PrelShow.lhs \
+CPUTime.lhs        Monad.lhs          PrelEnum.lhs       PrelList.lhs       PrelStable.lhs \
+Char.lhs           Numeric.lhs        PrelErr.lhs               PrelTup.lhs \
+Complex.lhs        PrelAddr.lhs       PrelException.lhs  PrelMaybe.lhs      PrelWeak.lhs \
+Directory.lhs      PrelArr.lhs        PrelFloat.lhs      PrelNum.lhs        Prelude.lhs \
+IO.lhs             PrelArrExtra.lhs   PrelForeign.lhs    PrelPack.lhs       Random.lhs \
+Ix.lhs             PrelBase.lhs       PrelHandle.lhs     PrelRead.lhs       Ratio.lhs \
+List.lhs           PrelByteArr.lhs    PrelHugs.lhs       PrelReal.lhs       System.lhs \
+Locale.lhs         PrelConc.lhs       PrelIO.lhs         PrelST.lhs         Time.lhs
+
+PrelAll_ILX=$(patsubst %.lhs,%.ilx,$(PrelAll_SRC))
+CLEAN_FILES += $(PrelAll_ILX)
+PrelAll_ILX_FWD=$(patsubst %.lhs,%.ilx.fwd.ok,$(PrelAll_SRC))
+PrelAll_IL=$(patsubst %.lhs,%.il,$(PrelAll_SRC))  PrelGHC.il
+PrelAll_MOD=$(patsubst %.il,%.mod,$(PrelAll_IL))
+
+
+%.ilx %.ilx.fwd: %.lhs
+	$(HC_PRE_OPTS)
+	$(HC) $(HC_OPTS) -Onot -D__ILX__ --ilx $*.lhs -o $*.ilx 
+	$(HC_POST_OPTS)
+
+
+CORRUN=
+LOCALRUN=./
+ifeq ($(HOSTNAME),msrc-hilda)
+CORRUN=cmd /c "devvs && "
+LOCALRUN=.\\
+endif    
+
+ILXASM=/devel/fcom/src/bin/ilxasmx.exe -l /devel/fcom/src/ilxasm --no-ilasm --box-everything
+ILASM=$(CORRUN)ilasm
+AL=$(CORRUN)al
+
+%.ilx.fwd.ok: %.ilx.fwd
+	if diff -q $< $@; then true; else cp $< $@; fi
+
+%.mod : %.il
+	$(ILASM) /QUIET /DLL /OUT=$@ $<
+
+PrelGHC.il: ../../compiler/ilxGen/PrelGHC.il
+	cp $< $@
+
+PrelAll.dll : ilxasm-stdlib.mod $(PrelAll_MOD)
+	$(AL) ilxasm-stdlib.mod $(PrelAll_MOD) -out:$@
+
+%.ilx_with_fwd: %.ilx $(PrelAll_ILX_FWD)
+	cat  $(PrelAll_ILX_FWD) $*.ilx > $@
+
+%.il : %.ilx_with_fwd  /devel/fcom/src/bin/ilxasmx.exe
+	$(ILXASM) --no-stdlib -o $@ $*.ilx_with_fwd 
+
+ilxasm-stdlib.il : /devel/fcom/src/bin/ilxasmx.exe /devel/fcom/src/ilxasm/stdlib-func-by-mcalli.ilx
+	rm -f tmp.ilx
+	touch tmp.ilx
+	$(ILXASM) -o $@ tmp.ilx
+	rm -f tmp.ilx
+
+
+#--------------------
+# For validation only:
+
+PrelAll.il: $(PrelAll_IL) ilxasm-stdlib.il
+	cat ilxasm-stdlib.il $(PrelAll_IL) > $@
+
+%.mvl: %.il
+	make -C ../../compiler/ilxGen/tests ilvalidx
+	ILVALID_HOME=/devel/fcom/src /devel/fcom/src/bin/ilvalidx.exe $*.il
+
+
+ilxasm:
+	make -C ../../compiler/ilxGen/tests ilxasmx
+
+ilvalid:
+	$(MAKE) -C /devel/fcom/src bin/ilvalidx.exe
+
+
+ghc:
+	make -C ../../compiler/ilxGen/tests ghc
+
+
+.PRECIOUS: %.ilx.fwd %.ilx.fwd.ok %.il %.ilx_with_fwd
diff --git a/ghc/compiler/ilxGen/primops.txt b/ghc/compiler/ilxGen/primops.txt
new file mode 100644
index 0000000000..be87f83c3d
--- /dev/null
+++ b/ghc/compiler/ilxGen/primops.txt
@@ -0,0 +1,881 @@
+{- NOT YET DONE:
+
+
+-----------------------------------------------------------------------
+-- $Id: primops.txt,v 1.1 2001/02/26 15:44:59 rrt Exp $
+--
+-- Primitive Operations
+--
+-----------------------------------------------------------------------
+
+-- To add a new primop, you currently need to update the following files:
+--
+--	- this file (ghc/compiler/prelude/primops.txt), which includes
+--	  the type of the primop, and various other properties (its
+--	  strictness attributes, whether it is defined as a macro
+--	  or as out-of-line code, etc.)
+--
+--	- ghc/lib/std/PrelGHC.hi-boot, to declare the primop
+--
+--	- if the primop is inline (i.e. a macro), then:
+--		ghc/includes/PrimOps.h
+--		ghc/compiler/nativeGen/StixPrim.lhs
+--
+--	- or, for an out-of-line primop:
+--	        ghc/includes/PrimOps.h (just add the declaration)
+--		ghc/rts/PrimOps.hc     (define it here)
+--
+--	- the User's Guide
+--
+
+-- The default attribute values which apply if you don't specify
+-- other ones.  Attribute values can be True, False, or arbitrary
+-- text between curly brackets.  This is a kludge to enable 
+-- processors of this file to easily get hold of simple info
+-- (eg, out_of_line), whilst avoiding parsing complex expressions
+-- needed for strictness and usage info.
+
+defaults
+   has_side_effects = False
+   out_of_line      = False
+   commutable       = False
+   needs_wrapper    = False
+   can_fail         = False
+   strictness       = { \ arity -> StrictnessInfo (replicate arity wwPrim) False }
+   usage            = { nomangle other }
+
+
+------------------------------------------------------------------------
+--- Support for the metacircular interpreter                         ---
+------------------------------------------------------------------------
+
+primop   IndexOffClosureOp_Ptr  "indexPtrOffClosure#"  GenPrimOp
+   a -> Int# -> (# b #)
+primop   IndexOffClosureOp_Word "indexWordOffClosure#"  GenPrimOp
+   a -> Int# -> Word#
+
+
+primop   Addr2IntOp  "addr2Int#"     GenPrimOp   Addr# -> Int#
+
+primop   DoubleDecodeOp   "decodeDouble#" GenPrimOp    
+   Double# -> (# Int#, Int#, ByteArr# #)
+   with out_of_line = True
+
+primop   FloatDecodeOp   "decodeFloat#" GenPrimOp
+   Float# -> (# Int#, Int#, ByteArr# #)
+   with out_of_line = True
+
+primop   IntegerSubOp   "minusInteger#" GenPrimOp  
+   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+   with out_of_line = True
+
+primop   IntegerMulOp   "timesInteger#" GenPrimOp   
+   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+   with commutable = True
+        out_of_line = True
+
+primop   IntegerGcdOp   "gcdInteger#" GenPrimOp    
+   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+   with commutable = True
+        out_of_line = True
+
+primop   IntegerIntGcdOp   "gcdIntegerInt#" GenPrimOp
+   Int# -> ByteArr# -> Int# -> Int#
+   with commutable = True
+
+primop   IntegerDivExactOp   "divExactInteger#" GenPrimOp
+   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+   with out_of_line = True
+
+primop   IntegerQuotOp   "quotInteger#" GenPrimOp
+   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+   with out_of_line = True
+
+primop   IntegerRemOp   "remInteger#" GenPrimOp
+   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
+   with out_of_line = True
+
+primop   IntegerCmpOp   "cmpInteger#"   GenPrimOp  
+   Int# -> ByteArr# -> Int# -> ByteArr# -> Int#
+   with needs_wrapper = True
+
+primop   IntegerCmpIntOp   "cmpIntegerInt#" GenPrimOp
+   Int# -> ByteArr# -> Int# -> Int#
+   with needs_wrapper = True
+
+primop   IntegerQuotRemOp   "quotRemInteger#" GenPrimOp
+   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr#, Int#, ByteArr# #)
+   with can_fail = True
+        out_of_line = True
+
+primop   IntegerDivModOp    "divModInteger#"  GenPrimOp
+   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr#, Int#, ByteArr# #)
+   with can_fail = True
+        out_of_line = True
+
+primop   Integer2IntOp   "integer2Int#"    GenPrimOp
+   Int# -> ByteArr# -> Int#
+   with needs_wrapper = True
+
+primop   Integer2WordOp   "integer2Word#"   GenPrimOp
+   Int# -> ByteArr# -> Word#
+   with needs_wrapper = True
+
+primop   IntegerToInt64Op   "integerToInt64#" GenPrimOp
+   Int# -> ByteArr# -> Int64#
+
+primop   IntegerToWord64Op   "integerToWord64#" GenPrimOp
+   Int# -> ByteArr# -> Word64#
+
+------------------------------------------------------------------------
+--- Arrays                                                           ---
+------------------------------------------------------------------------
+
+primop  NewByteArrayOp_Char "newCharArray#" GenPrimOp
+   Int# -> State# s -> (# State# s, MutByteArr# s #)
+   with out_of_line = True
+
+primop  NewByteArrayOp_Int "newIntArray#" GenPrimOp
+   Int# -> State# s -> (# State# s, MutByteArr# s #)
+   with out_of_line = True
+
+primop  NewByteArrayOp_Word "newWordArray#" GenPrimOp
+   Int# -> State# s -> (# State# s, MutByteArr# s #)
+   with out_of_line = True
+
+primop  NewByteArrayOp_Addr "newAddrArray#" GenPrimOp
+   Int# -> State# s -> (# State# s, MutByteArr# s #)
+   with out_of_line = True
+
+primop  NewByteArrayOp_Float "newFloatArray#" GenPrimOp
+   Int# -> State# s -> (# State# s, MutByteArr# s #)
+   with out_of_line = True
+
+primop  NewByteArrayOp_Double "newDoubleArray#" GenPrimOp
+   Int# -> State# s -> (# State# s, MutByteArr# s #)
+   with out_of_line = True
+
+primop  NewByteArrayOp_StablePtr "newStablePtrArray#" GenPrimOp
+   Int# -> State# s -> (# State# s, MutByteArr# s #)
+   with out_of_line = True
+
+
+
+primop  ReadByteArrayOp_Char "readCharArray#" GenPrimOp
+   MutByteArr# s -> Int# -> State# s -> (# State# s, Char# #)
+
+primop  ReadByteArrayOp_Int "readIntArray#" GenPrimOp
+   MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #)
+
+primop  ReadByteArrayOp_Word "readWordArray#" GenPrimOp
+   MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #)
+
+primop  ReadByteArrayOp_Addr "readAddrArray#" GenPrimOp
+   MutByteArr# s -> Int# -> State# s -> (# State# s, Addr# #)
+
+primop  ReadByteArrayOp_Float "readFloatArray#" GenPrimOp
+   MutByteArr# s -> Int# -> State# s -> (# State# s, Float# #)
+
+primop  ReadByteArrayOp_Double "readDoubleArray#" GenPrimOp
+   MutByteArr# s -> Int# -> State# s -> (# State# s, Double# #)
+
+primop  ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp
+   MutByteArr# s -> Int# -> State# s -> (# State# s, StablePtr# a #)
+
+primop  ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp
+   MutByteArr# s -> Int# -> State# s -> (# State# s, Int64# #)
+
+primop  ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp
+   MutByteArr# s -> Int# -> State# s -> (# State# s, Word64# #)
+
+
+
+primop  WriteByteArrayOp_Char "writeCharArray#" GenPrimOp
+   MutByteArr# s -> Int# -> Char# -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteByteArrayOp_Int "writeIntArray#" GenPrimOp
+   MutByteArr# s -> Int# -> Int# -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteByteArrayOp_Word "writeWordArray#" GenPrimOp
+   MutByteArr# s -> Int# -> Word# -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteByteArrayOp_Addr "writeAddrArray#" GenPrimOp
+   MutByteArr# s -> Int# -> Addr# -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteByteArrayOp_Float "writeFloatArray#" GenPrimOp
+   MutByteArr# s -> Int# -> Float# -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteByteArrayOp_Double "writeDoubleArray#" GenPrimOp
+   MutByteArr# s -> Int# -> Double# -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteByteArrayOp_StablePtr "writeStablePtrArray#" GenPrimOp
+   MutByteArr# s -> Int# -> StablePtr# a -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp
+   MutByteArr# s -> Int# -> Int64# -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp
+   MutByteArr# s -> Int# -> Word64# -> State# s -> State# s
+   with has_side_effects = True
+
+
+primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp
+   ByteArr# -> Int# -> Char#
+
+primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp
+   ByteArr# -> Int# -> Int#
+
+primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp
+   ByteArr# -> Int# -> Word#
+
+primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp
+   ByteArr# -> Int# -> Addr#
+
+primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp
+   ByteArr# -> Int# -> Float#
+
+primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp
+   ByteArr# -> Int# -> Double#
+
+primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp
+   ByteArr# -> Int# -> StablePtr# a
+
+primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp
+   ByteArr# -> Int# -> Int64#
+
+primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp
+   ByteArr# -> Int# -> Word64#
+
+
+
+
+primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Char# #)
+
+primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Int# #)
+
+primop ReadOffAddrOp_Word "readWordOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Word# #)
+
+primop ReadOffAddrOp_Addr "readAddrOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Addr# #)
+
+primop ReadOffAddrOp_Float "readFloatOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Float# #)
+
+primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Double# #)
+
+primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #)
+
+primop ReadOffAddrOp_ForeignObj "readForeignObjOffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, ForeignObj# #)
+
+primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Int64# #)
+
+primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp
+   Addr# -> Int# -> State# s -> (# State# s, Word64# #)
+
+
+primop  WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp
+   Addr# -> Int# -> Char# -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp
+   Addr# -> Int# -> Int# -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteOffAddrOp_Word "writeWordOffAddr#" GenPrimOp
+   Addr# -> Int# -> Word# -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp
+   Addr# -> Int# -> Addr# -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp
+   Addr# -> Int# -> Float# -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteOffAddrOp_Double "writeDoubleOffAddr#" GenPrimOp
+   Addr# -> Int# -> Double# -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp
+   Addr# -> Int# -> StablePtr# a -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteOffAddrOp_ForeignObj "writeForeignObjOffAddr#" GenPrimOp
+   Addr# -> Int# -> ForeignObj# -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp
+   Addr# -> Int# -> Int64# -> State# s -> State# s
+   with has_side_effects = True
+
+primop  WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp
+   Addr# -> Int# -> Word64# -> State# s -> State# s
+   with has_side_effects = True
+
+
+
+primop  NewArrayOp "newArray#" GenPrimOp
+   Int# -> a -> State# s -> (# State# s, MutArr# s a #)
+   with
+   strictness  = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
+   usage       = { mangle NewArrayOp [mkP, mkM, mkP] mkM }
+   out_of_line = True
+
+primop  SameMutableArrayOp "sameMutableArray#" GenPrimOp
+   MutArr# s a -> MutArr# s a -> Bool
+   with
+   usage = { mangle SameMutableArrayOp [mkP, mkP] mkM }
+
+primop  SameMutableByteArrayOp "sameMutableByteArray#" GenPrimOp
+   MutByteArr# s -> MutByteArr# s -> Bool
+
+primop  ReadArrayOp "readArray#" GenPrimOp
+   MutArr# s a -> Int# -> State# s -> (# State# s, a #)
+   with
+   usage = { mangle ReadArrayOp [mkM, mkP, mkP] mkM }
+
+primop  WriteArrayOp "writeArray#" GenPrimOp
+   MutArr# s a -> Int# -> a -> State# s -> State# s
+   with
+   usage            = { mangle WriteArrayOp [mkM, mkP, mkM, mkP] mkR }
+   strictness       = { \ arity -> StrictnessInfo [wwPrim, wwPrim, wwLazy, wwPrim] False }
+   has_side_effects = True
+
+primop  IndexArrayOp "indexArray#" GenPrimOp
+   Array# a -> Int# -> (# a #)
+   with
+   usage = { mangle  IndexArrayOp [mkM, mkP] mkM }
+
+primop  UnsafeFreezeArrayOp "unsafeFreezeArray#" GenPrimOp
+   MutArr# s a -> State# s -> (# State# s, Array# a #)
+   with
+   usage            = { mangle UnsafeFreezeArrayOp [mkM, mkP] mkM }
+   has_side_effects = True
+
+primop  UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp
+   MutByteArr# s -> State# s -> (# State# s, ByteArr# #)
+   with
+   has_side_effects = True
+
+primop  UnsafeThawArrayOp  "unsafeThawArray#" GenPrimOp
+   Array# a -> State# s -> (# State# s, MutArr# s a #)
+   with
+   usage       = { mangle UnsafeThawArrayOp [mkM, mkP] mkM }
+   out_of_line = True
+
+primop  SizeofByteArrayOp "sizeofByteArray#" GenPrimOp  
+   ByteArr# -> Int#
+
+primop  SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp
+   MutByteArr# s -> Int#
+
+------------------------------------------------------------------------
+--- Mutable variables                                                ---
+------------------------------------------------------------------------
+
+primop  NewMutVarOp "newMutVar#" GenPrimOp
+   a -> State# s -> (# State# s, MutVar# s a #)
+   with
+   usage       = { mangle NewMutVarOp [mkM, mkP] mkM }
+   strictness  = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
+   out_of_line = True
+
+primop  ReadMutVarOp "readMutVar#" GenPrimOp
+   MutVar# s a -> State# s -> (# State# s, a #)
+   with
+   usage = { mangle ReadMutVarOp [mkM, mkP] mkM }
+
+primop  WriteMutVarOp "writeMutVar#"  GenPrimOp
+   MutVar# s a -> a -> State# s -> State# s
+   with
+   strictness       = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
+   usage            = { mangle WriteMutVarOp [mkM, mkM, mkP] mkR }
+   has_side_effects = True
+
+primop  SameMutVarOp "sameMutVar#" GenPrimOp
+   MutVar# s a -> MutVar# s a -> Bool
+   with
+   usage = { mangle SameMutVarOp [mkP, mkP] mkM }
+
+------------------------------------------------------------------------
+--- Exceptions                                                       ---
+------------------------------------------------------------------------
+
+primop  CatchOp "catch#" GenPrimOp
+          (State# RealWorld -> (# State# RealWorld, a #) )
+       -> (b -> State# RealWorld -> (# State# RealWorld, a #) ) 
+       -> State# RealWorld
+       -> (# State# RealWorld, a #)
+   with
+   strictness = { \ arity -> StrictnessInfo [wwLazy, wwLazy, wwPrim] False }
+	-- Catch is actually strict in its first argument
+	-- but we don't want to tell the strictness
+	-- analyser about that!
+   usage = { mangle CatchOp [mkM, mkM . (inFun CatchOp mkM mkM), mkP] mkM }
+        --     [mkO, mkO . (inFun mkM mkO)] mkO
+        -- might use caught action multiply
+   out_of_line = True
+
+primop  RaiseOp "raise#" GenPrimOp
+   a -> b
+   with
+   strictness  = { \ arity -> StrictnessInfo [wwLazy] True }
+      -- NB: True => result is bottom
+   usage       = { mangle RaiseOp [mkM] mkM }
+   out_of_line = True
+
+primop  BlockAsyncExceptionsOp "blockAsyncExceptions#" GenPrimOp
+        (State# RealWorld -> (# State# RealWorld, a #))
+     -> (State# RealWorld -> (# State# RealWorld, a #))
+   with
+   strictness  = { \ arity -> StrictnessInfo [wwLazy] False }
+   out_of_line = True
+
+primop  UnblockAsyncExceptionsOp "unblockAsyncExceptions#" GenPrimOp
+        (State# RealWorld -> (# State# RealWorld, a #))
+     -> (State# RealWorld -> (# State# RealWorld, a #))
+   with
+   strictness  = { \ arity -> StrictnessInfo [wwLazy] False }
+   out_of_line = True
+
+------------------------------------------------------------------------
+--- MVars (not the same as mutable variables!)                       ---
+------------------------------------------------------------------------
+
+primop  NewMVarOp "newMVar#"  GenPrimOp
+   State# s -> (# State# s, MVar# s a #)
+   with
+   usage       = { mangle NewMVarOp [mkP] mkR }
+   out_of_line = True
+
+primop  TakeMVarOp "takeMVar#" GenPrimOp
+   MVar# s a -> State# s -> (# State# s, a #)
+   with
+   usage            = { mangle TakeMVarOp [mkM, mkP] mkM }
+   has_side_effects = True
+   out_of_line      = True
+
+primop  PutMVarOp "putMVar#" GenPrimOp
+   MVar# s a -> a -> State# s -> State# s
+   with
+   strictness       = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
+   usage            = { mangle PutMVarOp [mkM, mkM, mkP] mkR }
+   has_side_effects = True
+   out_of_line      = True
+
+primop  SameMVarOp "sameMVar#" GenPrimOp
+   MVar# s a -> MVar# s a -> Bool
+   with
+   usage = { mangle SameMVarOp [mkP, mkP] mkM }
+
+primop  TakeMaybeMVarOp "tryTakeMVar#" GenPrimOp
+   MVar# s a -> State# s -> (# State# s, Int#, a #)
+   with
+   usage            = { mangle TakeMaybeMVarOp [mkM, mkP] mkM }
+   has_side_effects = True
+   out_of_line      = True
+
+primop  IsEmptyMVarOp "isEmptyMVar#" GenPrimOp
+   MVar# s a -> State# s -> (# State# s, Int# #)
+   with
+   usage = { mangle IsEmptyMVarOp [mkP, mkP] mkM }
+
+
+------------------------------------------------------------------------
+--- delay/wait operations                                            ---
+------------------------------------------------------------------------
+
+primop  DelayOp "delay#" GenPrimOp
+   Int# -> State# s -> State# s
+   with
+   needs_wrapper    = True
+   has_side_effects = True
+   out_of_line      = True
+
+primop  WaitReadOp "waitRead#" GenPrimOp
+   Int# -> State# s -> State# s
+   with
+   needs_wrapper    = True
+   has_side_effects = True
+   out_of_line      = True
+
+primop  WaitWriteOp "waitWrite#" GenPrimOp
+   Int# -> State# s -> State# s
+   with
+   needs_wrapper    = True
+   has_side_effects = True
+   out_of_line      = True
+
+------------------------------------------------------------------------
+--- concurrency primitives                                           ---
+------------------------------------------------------------------------
+
+primop  ForkOp "fork#" GenPrimOp
+   a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
+   with
+   usage            = { mangle ForkOp [mkO, mkP] mkR }
+   strictness       = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
+   has_side_effects = True
+   out_of_line      = True
+
+primop  KillThreadOp "killThread#"  GenPrimOp
+   ThreadId# -> a -> State# RealWorld -> State# RealWorld
+   with
+   usage            = { mangle KillThreadOp [mkP, mkM, mkP] mkR }
+   has_side_effects = True
+   out_of_line      = True
+
+primop  YieldOp "yield#" GenPrimOp
+   State# RealWorld -> State# RealWorld
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  MyThreadIdOp "myThreadId#" GenPrimOp
+    State# RealWorld -> (# State# RealWorld, ThreadId# #)
+
+------------------------------------------------------------------------
+--- foreign objects                                                  ---
+------------------------------------------------------------------------
+
+primop  MkForeignObjOp "mkForeignObj#" GenPrimOp
+   Addr# -> State# RealWorld -> (# State# RealWorld, ForeignObj# #)
+   with
+   has_side_effects = True
+   out_of_line      = True
+
+primop  WriteForeignObjOp "writeForeignObj#" GenPrimOp
+   ForeignObj# -> Addr# -> State# s -> State# s
+   with
+   has_side_effects = True
+
+primop ForeignObjToAddrOp "foreignObjToAddr#" GenPrimOp
+   ForeignObj# -> Addr#
+
+primop TouchOp "touch#" GenPrimOp
+   o -> State# RealWorld -> State# RealWorld
+   with
+   strictness       = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
+
+------------------------------------------------------------------------
+--- Bytecode objects                                                 ---
+------------------------------------------------------------------------
+
+primop  NewBCOOp "newBCO#" GenPrimOp
+   Int# -> Int# -> Int# -> a -> State# RealWorld -> (# State# RealWorld, BCO# #)
+   with
+   has_side_effects = True
+   out_of_line      = True
+   strictness       = { \ arity -> StrictnessInfo 
+                                   [wwPrim, wwPrim, wwPrim, wwLazy, wwPrim] False }
+   usage            = { mangle NewBCOOp [mkP, mkP, mkP, mkM, mkP] mkR }
+
+primop  WriteBCOPtrOp "writeBCOPtr#" GenPrimOp
+   BCO# -> Int# -> o -> State# RealWorld -> State# RealWorld
+   with
+   usage            = { mangle WriteBCOPtrOp [mkP, mkP, mkM, mkP] mkR }
+   strictness       = { \ arity -> StrictnessInfo 
+                                   [wwPrim, wwPrim, wwLazy, wwPrim] False }
+   has_side_effects = True
+
+primop  WriteBCONonPtrOp "writeBCONonPtr#" GenPrimOp
+   BCO# -> Int# -> Word# -> State# RealWorld -> State# RealWorld
+   with
+   has_side_effects = True
+
+primop  WriteBCOInstrOp "writeBCOInstr#" GenPrimOp
+   BCO# -> Int# -> Word# -> State# RealWorld -> State# RealWorld
+   with
+   has_side_effects = True
+
+primop  ReadBCOPtrOp "readBCOPtr#"  GenPrimOp
+   BCO# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
+   with
+   usage = { mangle ReadBCOPtrOp [mkP, mkP] mkM }
+
+primop  ReadBCONonPtrOp "readBCONonPtr#"  GenPrimOp
+   BCO# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
+
+primop  ReadBCOInstrOp "readBCOInstr#" GenPrimOp
+   BCO# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
+
+primop  SameBCOOp "sameBCO#" GenPrimOp
+   BCO# -> BCO# -> Bool
+   with
+   -- is this usage right?
+   usage = { mangle SameMutableArrayOp [mkP, mkP] mkM }
+
+
+------------------------------------------------------------------------
+--- Weak pointers                                                    ---
+------------------------------------------------------------------------
+
+-- note that tyvar "o" denoted openAlphaTyVar
+
+primop  MkWeakOp "mkWeak#" GenPrimOp
+   o -> b -> c -> State# RealWorld -> (# State# RealWorld, Weak# b #)
+   with
+   strictness       = { \ arity -> StrictnessInfo [wwLazy, wwLazy, wwLazy, wwPrim] False }
+   usage            = { mangle MkWeakOp [mkZ, mkM, mkM, mkP] mkM }
+   has_side_effects = True
+   out_of_line      = True
+
+primop  DeRefWeakOp "deRefWeak#" GenPrimOp
+   Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, a #)
+   with
+   usage            = { mangle DeRefWeakOp [mkM, mkP] mkM }
+   has_side_effects = True
+
+primop  FinalizeWeakOp "finalizeWeak#" GenPrimOp
+   Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, 
+              (State# RealWorld -> (# State# RealWorld, Unit #)) #)
+   with
+   usage            = { mangle FinalizeWeakOp [mkM, mkP] 
+                               (mkR . (inUB FinalizeWeakOp 
+                                            [id,id,inFun FinalizeWeakOp mkR mkM])) }
+   has_side_effects = True
+   out_of_line      = True
+
+
+------------------------------------------------------------------------
+--- Stable pointers and names                                        ---
+------------------------------------------------------------------------
+
+primop  MakeStablePtrOp "makeStablePtr#" GenPrimOp
+   a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
+   with
+   strictness       = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
+   usage            = { mangle MakeStablePtrOp [mkM, mkP] mkM }
+   has_side_effects = True
+
+primop  DeRefStablePtrOp "deRefStablePtr#" GenPrimOp
+   StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
+   with
+   usage            = { mangle DeRefStablePtrOp [mkM, mkP] mkM }
+   needs_wrapper    = True
+   has_side_effects = True
+
+primop  EqStablePtrOp "eqStablePtr#" GenPrimOp
+   StablePtr# a -> StablePtr# a -> Int#
+   with
+   usage            = { mangle EqStablePtrOp [mkP, mkP] mkR }
+   has_side_effects = True
+
+primop  MakeStableNameOp "makeStableName#" GenPrimOp
+   a -> State# RealWorld -> (# State# RealWorld, StableName# a #)
+   with
+   usage            = { mangle MakeStableNameOp [mkZ, mkP] mkR }
+   strictness       = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
+   needs_wrapper    = True
+   has_side_effects = True
+   out_of_line      = True
+
+primop  EqStableNameOp "eqStableName#" GenPrimOp
+   StableName# a -> StableName# a -> Int#
+   with
+   usage = { mangle EqStableNameOp [mkP, mkP] mkR }
+
+primop  StableNameToIntOp "stableNameToInt#" GenPrimOp
+   StableName# a -> Int#
+   with
+   usage = { mangle StableNameToIntOp [mkP] mkR }
+
+------------------------------------------------------------------------
+--- Unsafe pointer equality (#1 Bad Guy: Alistair Reid :)            ---
+------------------------------------------------------------------------
+
+primop  ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp
+   a -> a -> Int#
+   with
+   usage = { mangle ReallyUnsafePtrEqualityOp [mkZ, mkZ] mkR }
+
+------------------------------------------------------------------------
+--- Parallelism                                                      ---
+------------------------------------------------------------------------
+
+primop  SeqOp "seq#" GenPrimOp
+   a -> Int#
+   with
+   usage            = { mangle  SeqOp [mkO] mkR }
+   strictness       = { \ arity -> StrictnessInfo [wwStrict] False }
+      -- Seq is strict in its argument; see notes in ConFold.lhs
+   has_side_effects = True
+
+primop  ParOp "par#" GenPrimOp
+   a -> Int#
+   with
+   usage            = { mangle ParOp [mkO] mkR }
+   strictness       = { \ arity -> StrictnessInfo [wwLazy] False }
+      -- Note that Par is lazy to avoid that the sparked thing
+      -- gets evaluted strictly, which it should *not* be
+   has_side_effects = True
+
+-- HWL: The first 4 Int# in all par... annotations denote:
+--   name, granularity info, size of result, degree of parallelism
+--      Same  structure as _seq_ i.e. returns Int#
+-- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine
+--   `the processor containing the expression v'; it is not evaluated
+
+primop  ParGlobalOp  "parGlobal#"  GenPrimOp
+   a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
+   with
+   usage            = { mangle ParGlobalOp [mkO, mkP, mkP, mkP, mkP, mkM] mkM }
+   has_side_effects = True
+
+primop  ParLocalOp  "parLocal#"  GenPrimOp
+   a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
+   with
+   usage            = { mangle ParLocalOp [mkO, mkP, mkP, mkP, mkP, mkM] mkM }
+   has_side_effects = True
+
+primop  ParAtOp  "parAt#"  GenPrimOp
+   b -> a -> Int# -> Int# -> Int# -> Int# -> c -> Int#
+   with
+   usage            = { mangle ParAtOp [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM }
+   has_side_effects = True
+
+primop  ParAtAbsOp  "parAtAbs#"  GenPrimOp
+   a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
+   with
+   usage            = { mangle ParAtAbsOp [mkO, mkP, mkP, mkP, mkP, mkM] mkM }
+   has_side_effects = True
+
+primop  ParAtRelOp  "parAtRel#" GenPrimOp
+   a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
+   with
+   usage            = { mangle ParAtRelOp [mkO, mkP, mkP, mkP, mkP, mkM] mkM }
+   has_side_effects = True
+
+primop  ParAtForNowOp  "parAtForNow#" GenPrimOp
+   b -> a -> Int# -> Int# -> Int# -> Int# -> c -> Int#
+   with
+   usage            = { mangle ParAtForNowOp [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM }
+   has_side_effects = True
+
+primop  CopyableOp  "copyable#" GenPrimOp
+   a -> Int#
+   with
+   usage            = { mangle CopyableOp [mkZ] mkR }
+   has_side_effects = True
+
+primop  NoFollowOp "noFollow#" GenPrimOp
+   a -> Int#
+   with
+   usage            = { mangle NoFollowOp [mkZ] mkR }
+   has_side_effects = True
+
+
+------------------------------------------------------------------------
+--- tag to enum stuff                                                ---
+------------------------------------------------------------------------
+
+primop  DataToTagOp "dataToTag#" GenPrimOp
+   a -> Int#
+   with
+   strictness = { \ arity -> StrictnessInfo [wwLazy] False }
+
+primop  TagToEnumOp "tagToEnum#" GenPrimOp     
+   Int# -> a
+
+
+thats_all_folks
+
+------------------------------------------------------------------------
+---                                                                  ---
+------------------------------------------------------------------------
+
+
+    -- Char#-related ops:
+
+    -- Int#-related ops:
+
+    -- Float#-related ops:
+
+    -- primitive ops for primitive arrays
+
+
+    | ReadOffAddrOp	PrimRep
+    | WriteOffAddrOp    PrimRep
+    | IndexOffAddrOp	PrimRep
+	-- PrimRep can be one of :
+	--	{Char,Int,Word,Addr,Float,Double,StablePtr,Int64,Word64}Rep.
+	-- This is just a cheesy encoding of a bunch of ops.
+	-- Note that ForeignObjRep is not included -- the only way of
+	-- creating a ForeignObj is with a ccall or casm.
+    | IndexOffForeignObjOp PrimRep
+
+    | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
+    | SizeofByteArrayOp   | SizeofMutableByteArrayOp
+
+
+
+    -- exceptions
+
+    -- foreign objects
+    | MkForeignObjOp
+    | WriteForeignObjOp
+
+    -- weak pointers
+    | MkWeakOp
+    | DeRefWeakOp
+    | FinalizeWeakOp
+
+    -- stable names
+    | MakeStableNameOp
+    | EqStableNameOp
+    | StableNameToIntOp
+
+    -- stable pointers
+    | MakeStablePtrOp
+    | DeRefStablePtrOp
+    | EqStablePtrOp
+
+    -- Foreign calls
+    | CCallOp CCall
+    -- Operation to test two closure addresses for equality (yes really!)
+    -- BLAME ALASTAIR REID FOR THIS!  THE REST OF US ARE INNOCENT!
+    | ReallyUnsafePtrEqualityOp
+
+    -- parallel stuff
+    | SeqOp
+    | ParOp
+
+    -- concurrency
+    | ForkOp
+    | KillThreadOp
+    | YieldOp
+    | MyThreadIdOp
+    | DelayOp
+    | WaitReadOp
+    | WaitWriteOp
+
+    -- more parallel stuff
+    | ParGlobalOp	-- named global par
+    | ParLocalOp	-- named local par
+    | ParAtOp		-- specifies destination of local par
+    | ParAtAbsOp	-- specifies destination of local par (abs processor)
+    | ParAtRelOp	-- specifies destination of local par (rel processor)
+    | ParAtForNowOp	-- specifies initial destination of global par
+    | CopyableOp	-- marks copyable code
+    | NoFollowOp	-- marks non-followup expression
+
+    -- tag-related
+    | DataToTagOp
+    | TagToEnumOp
+-}
diff --git a/ghc/compiler/ilxGen/tests/Makefile b/ghc/compiler/ilxGen/tests/Makefile
new file mode 100644
index 0000000000..24aa4de71e
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/Makefile
@@ -0,0 +1,299 @@
+include ../../../lib/std/Makefile.src
+
+# These settings are if you use a visual studio build
+CVS=/cvs/cvs
+CORENV_DEBUG=
+CORENV_RETAIL=
+LOCALRUN=./
+ILX_FAST=x
+ifeq ($(HOSTNAME),msrc-hilda)
+CORENV_DEBUG="call devvsnearerb1gen.bat"
+CORENV_RETAIL="call devvsnearerb1gen.bat retail"
+LOCALRUN=.\\
+ILX_FAST=
+endif    
+
+ILXASM_HOME=/devel/fcom/src
+ILXASM=$(ILXASM_HOME)/bin/ilxasm$(ILX_FAST).exe 
+ILVALID=$(ILXASM_HOME)/bin/ilvalid$(ILX_FAST).exe 
+ILXASM_FLAGS=-l $(ILXASM_HOME)/ilxasm --no-ilasm  --tailcall-indirect
+
+ghc:
+	$(MAKE) -C ../.. ilxGen/IlxGen.o hsc
+
+ilxasm:
+	$(MAKE) -C $(ILXASM_HOME) bin/ilxasm.exe
+
+ilxasmx:
+	$(MAKE) -C $(ILXASM_HOME) bin/ilxasmx.exe
+
+ilvalid:
+	$(MAKE) -C $(ILXASM_HOME) bin/ilvalid.exe
+
+ilvalidx:
+	$(MAKE) -C $(ILXASM_HOME) bin/ilvalidx.exe
+
+prel:
+	$(MAKE) -C ../../../lib/std ilxasm std.Onot.nongeneric.boxed.dll
+	$(MAKE) -C $(ILXASM_HOME)  bin/msilxlib.nongeneric.boxed.dll
+
+prelq:
+	$(MAKE) -C ../../../lib/std ilxasm std.Onot.nongeneric.boxed.trial.dll
+	$(MAKE) -C $(ILXASM_HOME)  bin/msilxlib.nongeneric.boxed.trial.dll
+
+oprel:
+	$(MAKE) -C ../../../lib/std ilxasm std.O.nongeneric.boxed.dll
+	$(MAKE) -C $(ILXASM_HOME)  bin/msilxlib.nongeneric.boxed.dll
+
+oprelq:
+	$(MAKE) -C ../../../lib/std ilxasm std.O.nongeneric.boxed.trial.dll
+	$(MAKE) -C $(ILXASM_HOME)  bin/msilxlib.nongeneric.boxed.trial.dll
+
+tprel:
+	$(MAKE) -C ../../../lib/std ilxasm std.Onot.nongeneric.boxed.traced.dll
+	$(MAKE) -C $(ILXASM_HOME)  bin/msilxlib.nongeneric.boxed.traced.dll
+
+otprel:
+	$(MAKE) -C ../../../lib/std ilxasm std.O.nongeneric.boxed.traced.dll
+	$(MAKE) -C $(ILXASM_HOME)  bin/msilxlib.nongeneric.boxed.traced.dll
+
+#gprel:
+#	$(MAKE) -C ../../../lib/std ilxasm std.Onot.generic.dll
+#	$(MAKE) -C $(ILXASM_HOME)  bin/msilxlib.generic.dll
+#
+#ogprel:
+#	$(MAKE) -C ../../../lib/std ilxasm std.O.generic.dll
+#	$(MAKE) -C $(ILXASM_HOME)  bin/msilxlib.generic.dll
+#
+#gtprel:
+#	$(MAKE) -C ../../../lib/std ilxasm std.Onot.generic.traced.dll
+#	$(MAKE) -C $(ILXASM_HOME)  bin/msilxlib.generic.traced.dll
+
+vgprel:
+	$(MAKE) -C ../../../lib/std ilxasm std.Onot.vmeth-erased.generic.dll
+	$(MAKE) -C $(ILXASM_HOME)  bin/msilxlib.vmeth-erased.generic.dll
+
+ovgprel:
+	$(MAKE) -C ../../../lib/std ilxasm std.O.vmeth-erased.generic.dll
+	$(MAKE) -C $(ILXASM_HOME)  bin/msilxlib.vmeth-erased.generic.dll
+
+ovgprelq:
+	$(MAKE) -C ../../../lib/std ilxasm std.O.vmeth-erased.generic.trial.dll
+	$(MAKE) -C $(ILXASM_HOME)  bin/msilxlib.vmeth-erased.generic.trial.dll
+
+vgtprel:
+	$(MAKE) -C ../../../lib/std ilxasm std.Onot.vmeth-erased.generic.traced.dll
+	$(MAKE) -C $(ILXASM_HOME)  bin/msilxlib.vmeth-erased.generic.traced.dll
+
+ovgtprel:
+	$(MAKE) -C ../../../lib/std ilxasm std.O.vmeth-erased.generic.traced.dll
+	$(MAKE) -C $(ILXASM_HOME)  bin/msilxlib.vmeth-erased.generic.traced.dll
+
+%.o: %.hs ../../hsc.exe
+	../../../driver/ghc-inplace -o $@ -c $*.hs
+
+std_NONGENERIC_STATIC_IL=$(patsubst %.lhs,../../../lib/std/%.nongeneric.boxed.static.il,$(std_SRC)) ../../../lib/std/PrelGHC.nongeneric.boxed.static.il
+std_GENERIC_STATIC_IL=$(patsubst %.lhs,../../../lib/std/%.generic.static.il,$(std_SRC)) ../../../lib/std/PrelGHC.generic.static.il
+
+#========================================================================
+# 1. From Haskell to ILX 
+
+%.Onot.ilx: %.hs ../../hsc.exe
+	../../../driver/ghc-inplace  -fglasgow-exts -o $@ -i../../../lib/std/.Onot -Onot --ilx $*.hs
+
+%.O.ilx: %.hs ../../hsc.exe
+	../../../driver/ghc-inplace  -fglasgow-exts -o $@ -i../../../lib/std/.O -O --ilx $*.hs
+
+../Entry.Onot.ilx: ../Entry.ilx
+	sed -e "s|ilx std|ilx std.Onot|g" ../Entry.ilx > $@.tmp
+	mv $@.tmp $@
+
+%.Onot.dlllib.ilx: %.Onot.ilx ../Entry.Onot.ilx 
+	cat ../Entry.Onot.ilx  $*.Onot.ilx > $@.tmp
+	mv $@.tmp $@
+
+../Entry.O.ilx: ../Entry.ilx
+	sed -e "s|ilx std|ilx std.O|g" ../Entry.ilx > $@.tmp
+	mv $@.tmp $@
+
+%.O.dlllib.ilx: %.O.ilx ../Entry.O.ilx 
+	cat ../Entry.O.ilx  $*.O.ilx > $@.tmp
+	mv $@.tmp $@
+
+HSstd_cbits.dll: ../../../lib/std/cbits/HSstd_cbits.dll
+	cp $< $@
+
+
+#========================================================================
+# 2. From ILX to IL
+
+#------------------------------------------------------------------------
+# Compile for a vanilla VM against a vanilla library organised as a
+# seperate assembly/DLL.
+
+%.nongeneric.boxed.dlllib.il: $(ILXASM) %.dlllib.ilx
+	$(ILXASM) --box-everything --no-stdlib $(ILXASM_FLAGS) -o $@.tmp $*.dlllib.ilx
+	mv $@.tmp $@
+
+#------------------------------------------------------------------------
+# Same
+# 	- running a trial optimization 
+# 	- for traced code on a vanilla VM
+%.nongeneric.boxed.trial.dlllib.il: $(ILXASM) %.dlllib.ilx
+	$(ILXASM) --trial-opt --box-everything --no-stdlib $(ILXASM_FLAGS) -o $@.tmp $*.dlllib.ilx
+	mv $@.tmp $@
+
+%.nongeneric.boxed.traced.dlllib.il: $(ILXASM) %.dlllib.ilx
+	$(ILXASM) --box-everything --trace-il --no-stdlib $(ILXASM_FLAGS) -o $@.tmp $*.dlllib.ilx
+	mv $@.tmp $@
+
+#------------------------------------------------------------------------
+# Same, for a generic library and generic VM
+
+%.generic.dlllib.il: $(ILXASM) %.dlllib.ilx
+	$(ILXASM) --no-pp --no-stdlib $(ILXASM_FLAGS) -o  $@.tmp $*.dlllib.ilx  
+	mv $@.tmp $@
+
+%.generic.trial.dlllib.il: $(ILXASM) %.dlllib.ilx
+	$(ILXASM) --trial-opt --no-pp --no-stdlib $(ILXASM_FLAGS) -o  $@.tmp $*.dlllib.ilx  
+	mv $@.tmp $@
+
+%.generic.traced.dlllib.il: $(ILXASM) %.dlllib.ilx
+	$(ILXASM) --trace-il --no-pp --no-stdlib $(ILXASM_FLAGS) -o  $@.tmp $*.dlllib.ilx  
+	mv $@.tmp $@
+
+%.vmeth-erased.generic.dlllib.il: $(ILXASM) %.dlllib.ilx
+	$(ILXASM) --poly-virtual-method-erase --no-pp --no-stdlib $(ILXASM_FLAGS) -o  $@.tmp $*.dlllib.ilx  
+	mv $@.tmp $@
+
+%.vmeth-erased.generic.trial.dlllib.il: $(ILXASM) %.dlllib.ilx
+	$(ILXASM) --trial-opt --poly-virtual-method-erase --no-pp --no-stdlib $(ILXASM_FLAGS) -o  $@.tmp $*.dlllib.ilx  
+	mv $@.tmp $@
+
+%.vmeth-erased.generic.traced.dlllib.il: $(ILXASM) %.dlllib.ilx
+	$(ILXASM) --poly-virtual-method-erase --trace-il --no-pp --no-stdlib $(ILXASM_FLAGS) -o  $@.tmp $*.dlllib.ilx  
+	mv $@.tmp $@
+
+
+#------------------------------------------------------------------------
+# Compile for a vanilla VM against a vanilla library compiled to IL code
+# to be statically linked as one big module.  We hack this up by textually
+# stripping out all the assembly qualifications (apart from mscorlib) 
+# from the ILX forward files and IL code itself.  We then just 
+# concatenate all the IL code together and compile it as a single .EXE.
+
+%.staticlib.ilx: %.ilx ../Entry.ilx 
+	cat  ../Entry.ilx  $*.ilx | \
+		sed -e "sQ\[std\]QQg" |   \
+		sed -e "sQ\['std'\]QQg" > $@.tmp
+	cat $@.tmp > $@.tmp2
+	mv $@.tmp2 $@
+	rm $@.tmp
+
+
+%.generic.staticlib.il: $(ILXASM) %.staticlib.ilx
+	$(ILXASM) --static --no-pp $(ILXASM_FLAGS) -o $@.tmp $*.staticlib.ilx  
+	cat $(std_GENERIC_STATIC_IL) $@.tmp > $@.tmp2
+	mv $@.tmp2 $@
+	rm $@.tmp
+
+
+%.nongeneric.boxed.staticlib.il: $(ILXASM) %.staticlib.ilx
+	$(ILXASM) --box-everything --static $(ILXASM_FLAGS) -o $@.tmp $*.staticlib.ilx
+	cat $(std_NONGENERIC_STATIC_IL) $@.tmp > $@.tmp2
+	mv $@.tmp2 $@
+	rm $@.tmp
+
+
+#------------------------------------------------------------------------
+# For compiling test cases that don't use the standard library at all.
+
+%.nolib.ilx: %.ilx PrelBase.test.ilx   ../PrelGHC.ilx ../Entry.ilx 
+	cat ../PrelGHC.ilx   PrelBase.test.ilx ../Entry.ilx  $*.ilx > $@.tmp
+	mv $@.tmp $@
+
+%.nolib.il: $(ILXASM) $(ILXASM_HOME)/ilxasm/stdlib-func-by-mcalli.ilx %.nolib.ilx
+	$(ILXASM) $(ILXASM_FLAGS) -o $@.tmp $*.nolib.ilx 
+	mv $@.tmp $@
+
+%.nolib.traced.il: $(ILXASM) $(ILXASM_HOME)/ilxasm/stdlib-func-by-mcalli.ilx %.nolib.ilx
+	$(ILXASM) --trace-il $(ILXASM_FLAGS) $*.nolib.ilx > $@.tmp
+	mv $@.tmp $@
+
+
+#------------------------------------------------------------------------
+# From IL to .EXE
+
+%.retail.exe: %.il
+	echo "$(CORENV_RETAIL)" > $@.bat
+	echo "ilasm -exe -quiet -out=$(subst /,\\,$@) $(subst /,\\,$<)" >> $@.bat
+	time -p cmd /c $(subst /,\\,$@).bat
+	rm $@.bat
+
+%.debug.exe: %.il
+	echo "$(CORENV_RETAIL)" > $@.bat
+	echo "ilasm -exe -quiet -debug -out=$(subst /,\\,$@) $(subst /,\\,$<)" >> $@.bat
+	time -p cmd /c $(subst /,\\,$@).bat
+	rm $@.bat
+#------------------------------------------------------------------------
+# From .HS to .EXE without using ILX
+
+%.Onot.exe: %.hs
+	ghc -Onot -o $@ $<
+
+%.O.exe: %.hs
+	ghc -O -o $@ $<
+
+
+
+#------------------------------------------------------------------------
+# Running:
+
+%.debug.run: HSstd_cbits.dll %.debug.exe
+	echo "$(CORENV_DEBUG)" > $@.bat
+	echo "set CORPATH=$(subst /,\\,$(ILXASM_HOME))\\bin;\\GHC\\fptools\\ghc\\lib\\std;%CORPATH%" >> $@.bat
+	echo "$(LOCALRUN)$(subst /,\\,$*).debug.exe 2>&1" >> $@.bat
+	time -p cmd /c $(subst /,\\,$@).bat
+	rm $@.bat
+
+%.retail.run: HSstd_cbits.dll %.retail.exe
+	echo "$(CORENV_RETAIL)" > $@.bat
+	echo "set CORPATH=$(subst /,\\,$(ILXASM_HOME))\\bin;\\GHC\\fptools\\ghc\\lib\\std;%CORPATH%" >> $@.bat
+	echo "$(LOCALRUN)$(subst /,\\,$*).retail.exe 2>&1" >> $@.bat
+	time -p cmd /c $(subst /,\\,$@).bat
+	rm $@.bat
+
+
+%.run: %.exe
+	time -p $<
+
+
+
+#--------------------
+
+%.debug.exe: %.nolib.il
+	echo "$(CORENV_RETAIL)" > $@.bat
+	echo "$(CORENV_RETAIL)ilasm /DEBUG /OUT=$(subst /,\\,$@) $(subst /,\\,$<)" >> $@.bat
+	time -p cmd /c $(subst /,\\,$@).bat
+	rm $@.bat
+
+%.trace-il.nolib.il: $(ILXASM) $(ILXASM_HOME)/ilxasm/stdlib-func-by-mcalli.ilx %.nolib.ilx
+	$(ILXASM) $(ILXASM_FLAGS) --trace-il  $*.nolib.ilx > $@.tmp
+	mv $@.tmp $@
+
+%.mvl: %.nolib.il
+	ILVALID_HOME=$(ILXASM_HOME) $(ILVALID) $*.nolib.il
+
+ci:
+	(cd $(ILXASM_HOME); $(CVS) ci -m "")
+	(cd ../..; cvs ci -m "")
+	(cd ../../../lib/std; $(CVS) ci -m "")
+
+upd:
+	(cd $(ILXASM_HOME); $(CVS) up)
+	(cd ../..; $(CVS) up)
+	(cd ../../../lib/std; $(CVS) up)
+
+.PRECIOUS: %.nongeneric.boxed.dlllib.il  %.generic.dlllib.il  %.generic.il %.nolib.il %.Onot.ilx %.O.ilx %.nolib.ilx %.dlllib.ilx %.exe  %.debug.exe %.dll %.O.exe
+
+.PHONY: %.run
diff --git a/ghc/compiler/ilxGen/tests/PrelNum.hs b/ghc/compiler/ilxGen/tests/PrelNum.hs
new file mode 100644
index 0000000000..ca23e149ff
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/PrelNum.hs
@@ -0,0 +1,120 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+{-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
+
+module PrelNum where
+
+import {-# SOURCE #-} PrelErr
+import PrelBase
+import PrelList
+import PrelEnum
+import PrelShow
+
+infixl 7  *
+infixl 6  +, -
+
+default ()		-- Double isn't available yet, 
+			-- and we shouldn't be using defaults anyway
+
+
+
+
+
+
+
+
+
+class  (Eq a, Show a) => Num a  where
+    (+), (-), (*)	:: a -> a -> a
+    negate		:: a -> a
+    abs, signum		:: a -> a
+    fromInteger		:: Integer -> a
+    fromInt		:: Int -> a -- partain: Glasgow extension
+
+    x - y		= x + negate y
+    negate x		= 0 - x
+    fromInt (I# i#)	= fromInteger (S# i#)
+					-- Go via the standard class-op if the
+					-- non-standard one ain't provided
+
+
+
+
+
+subtract	:: (Num a) => a -> a -> a
+{-# INLINE subtract #-}
+subtract x y	=  y - x
+
+ord_0 :: Num a => a
+ord_0 = fromInt (ord '0')
+
+
+
+
+
+
+
+
+
+
+instance  Num Int  where
+    (+)	   x y =  plusInt x y
+    (-)	   x y =  minusInt x y
+    negate x   =  negateInt x
+    (*)	   x y =  timesInt x y
+    abs    n   = if n `geInt` 0 then n else (negateInt n)
+
+    signum n | n `ltInt` 0 = negateInt 1
+	     | n `eqInt` 0 = 0
+	     | otherwise   = 1
+
+    fromInt n	  = n
+
+
+
+
+-- These can't go in PrelBase with the defn of Int, because
+-- we don't have pairs defined at that time!
+
+quotRemInt :: Int -> Int -> (Int, Int)
+a@(I# _) `quotRemInt` b@(I# _) = (a `quotInt` b, a `remInt` b)
+    -- OK, so I made it a little stricter.  Shoot me.  (WDP 94/10)
+
+divModInt ::  Int -> Int -> (Int, Int)
+divModInt x@(I# _) y@(I# _) = (x `divInt` y, x `modInt` y)
+    -- Stricter.  Sorry if you don't like it.  (WDP 94/10)
+
+
+
+
+
+
+
+
+
+
+data Integer	
+   = S# Int#				-- small integers
+   | J# Int# ByteArray#			-- large integers
+
+
+
+
+
+zeroInteger :: Integer
+zeroInteger = S# 0#
+
diff --git a/ghc/compiler/ilxGen/tests/foo.hs b/ghc/compiler/ilxGen/tests/foo.hs
new file mode 100644
index 0000000000..d66608ba22
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/foo.hs
@@ -0,0 +1,9 @@
+{-# OPTIONS -fglasgow-exts  #-}
+module Foo where
+import PrelGHC
+import PrelNum
+import PrelBase
+integer2Intx :: Integer -> Int
+integer2Intx (S# i)   = I# i
+integer2Intx (J# s d) = case (integer2Int# s d) of { n# -> I# n# }
+
diff --git a/ghc/compiler/ilxGen/tests/life.hs b/ghc/compiler/ilxGen/tests/life.hs
new file mode 100644
index 0000000000..d6bcd16f9f
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/life.hs
@@ -0,0 +1,360 @@
+--------------------------------
+--	The Game of Life      --
+--------------------------------
+
+generations x = 30
+
+data L a = N | C1 a (L a)
+
+data Tuple2 a b = T2 a b
+
+data Tuple3 a b c = T3 a b c
+
+
+main = putStr (listChar_string
+                    (append1 (C1 '\FF' N)
+                             (life1 (generations ()) (start ()))))
+
+listChar_string :: L Char -> String
+listChar_string N = []
+listChar_string (C1 x xs) = x : listChar_string xs
+
+start :: a -> L (L Int)
+start x = (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1 N
+          (C1
+           (C1 0
+           (C1 0
+           (C1 0
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 0
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 0
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 0
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 1
+           (C1 0 N))))))))))))))))))))))))))) N)))))))))))))))
+
+-- Calculating the next generation
+
+gen1 :: Int -> L (L Int) -> L (L Int)
+gen1 n board = map1 row1 (shift1 (copy1 n 0) board)
+
+row1 :: Tuple3 (L Int) (L Int) (L Int) -> L Int
+row1 (T3 last this next)
+  = zipWith31 elt1 (shift2 0 last) 
+                   (shift2 0 this) 
+                   (shift2 0 next)
+
+
+elt1 :: Tuple3 Int Int Int 
+        -> (Tuple3 Int Int Int) 
+        -> (Tuple3 Int Int Int) -> Int
+elt1 (T3 a b c) (T3 d e f) (T3 g h i) 
+ = if (not (eq tot 2))
+          && (not (eq tot 3))
+      then 0
+      else if (eq tot 3) then 1 else e
+   where tot = a `plus` b `plus` c `plus` d 
+               `plus` f `plus` g `plus` h `plus` i
+
+eq :: Int -> Int -> Bool
+eq x y = x == y
+
+plus :: Int -> Int -> Int
+plus x y = x + y
+
+shiftr1 :: L Int -> L (L Int) -> L (L Int)
+shiftr1 x xs = append2 (C1 x N)  (init1 xs)
+
+shiftl1 :: L Int -> L (L Int) -> L (L Int)
+shiftl1 x xs = append2 (tail1 xs) (C1 x N)
+
+shift1 :: L Int -> L (L Int) 
+            -> L (Tuple3 (L Int) (L Int) (L Int))
+shift1 x xs = zip31 (shiftr1 x xs) xs (shiftl1 x xs)
+
+shiftr2 :: Int -> L Int -> L Int
+shiftr2 x xs = append3 (C1 x N) (init2 xs)
+
+shiftl2 :: Int -> L Int -> L Int
+shiftl2 x xs = append3 (tail2 xs) (C1 x N)
+
+shift2 :: Int -> L Int -> L (Tuple3 Int Int Int)
+shift2 x xs = zip32 (shiftr2 x xs) xs (shiftl2 x xs)
+
+-- copy
+
+copy1 :: Int -> Int -> L Int
+copy1 0 x = N
+copy1 n x = C1 x (copy1 (n-1) x)
+
+copy2 :: Int -> L Int -> L (L Int)
+copy2 0 x = N
+copy2 n x = C1 x (copy2 (n-1) x)
+
+copy3 :: Int -> Char -> L Char
+copy3 0 x = N
+copy3 n x = C1 x (copy3 (n-1) x)
+
+-- Displaying one generation
+
+disp1 :: (Tuple2 (L Char) (L (L Int))) -> L Char
+disp1 (T2 gen xss) 
+ = append1 gen 
+    (append1 (C1 '\n' (C1 '\n' N)) 
+             (foldr_1 (glue1 (C1 '\n' N)) N
+                       (map4 (compose2 concat1 (map2 star1)) xss)))
+
+star1 :: Int -> L Char
+star1 i = case i of
+           0 -> C1 ' ' (C1 ' ' N)
+           1 -> C1 ' ' (C1 'o' N)
+
+glue1 :: L Char -> L Char -> L Char -> L Char 
+glue1 s xs ys = append1 xs (append1 s ys)
+
+-- Generating and displaying a sequence of generations
+
+life1 :: Int -> L (L Int) -> L Char
+life1 n xss 
+  = foldr_1 (glue1 (copy3 (n+2) '\VT')) N
+            (map5 disp1
+              (zip1_ (map6 (string_ListChar.show) (ints 0))
+                    gens))
+    where
+    gens = take3 (740::Int) (iterate1 (gen1 n) (initial1 n xss))
+
+ints :: Int -> L Int
+ints x = C1 x (ints (x+1))
+
+string_ListChar :: String -> L Char
+string_ListChar [] = N
+string_ListChar (x:xs) = C1 x (string_ListChar xs)
+
+initial1 :: Int -> L (L Int) -> L (L Int)
+initial1 n xss = take1 n (append2 (map3 (compose1 (take2 n)
+                           (`append3` (copy1 n 0))) xss)
+                                (copy2 n (copy1 n 0)))
+
+iterate1 :: (L (L Int) -> L (L Int)) 
+               -> L (L Int) -> L (L (L Int))
+iterate1 f x = C1 x (iterate1 f (f x))
+
+-- versions of built in functions
+
+-- take
+take1 :: Int -> L (L Int) -> L (L Int)
+take1 0 _ = N
+take1 _ N = N
+--should be:take1 (n+1) (C1 x xs) = C1 x (take1 n xs)
+take1 n (C1 x xs) | n < 0     = error "Main.take1"
+		  | otherwise = C1 x (take1 (n-1) xs)
+
+take2 :: Int -> L Int -> L Int
+take2 0 _ = N
+take2 _ N = N
+--should be:take2 (n+1) (C1 x xs) = C1 x (take2 n xs)
+take2 n (C1 x xs) | n < 0     = error "Main.take2"
+		  | otherwise = C1 x (take2 (n-1) xs)
+
+take3 :: Int -> L (L (L Int))
+             -> L (L (L Int))
+take3 0 _ = N
+take3 _ N = N
+take3 n (C1 x xs) = C1 x (take3 (n-1) xs)
+
+-- init
+
+init1 :: L (L Int) -> L (L Int)
+init1 (C1 x N) = N
+init1 (C1 x xs) = C1 x (init1 xs)
+init1 N = error "init1 got a bad list"
+
+init2 :: L Int -> L Int
+init2 (C1 x N) = N
+init2 (C1 x xs) = C1 x (init2 xs)
+init2 N = error "init1 got a bad list"
+
+-- tail
+
+tail1 :: L (L Int) -> L (L Int)
+tail1 (C1 _ xs) = xs
+tail1 N = error "tail1 got a bad list"
+
+tail2 :: L Int -> L Int
+tail2 (C1 _ xs) = xs
+tail2 N = error "tail2 got a bad list"
+
+-- maps
+
+map1 :: (Tuple3 (L Int) (L Int) (L Int) -> L Int) -> 
+                L (Tuple3 (L Int) (L Int) (L Int))
+             -> L (L Int)
+map1 f N = N
+map1 f (C1 x xs) = C1 (f x) (map1 f xs)
+
+map2 :: (Int -> L Char) -> L Int -> L (L Char)
+map2 f N = N
+map2 f (C1 x xs) = C1 (f x) (map2 f xs)
+
+map3 :: (L Int -> L Int) -> L (L Int) -> L (L Int)
+map3 f N = N
+map3 f (C1 x xs) = C1 (f x) (map3 f xs)
+
+map4 :: (L Int -> L Char)
+         -> L (L Int) -> L (L Char)
+map4 f N = N
+map4 f (C1 x xs) = C1 (f x) (map4 f xs)
+
+map5 :: (Tuple2 (L Char) (L (L Int)) -> L Char) 
+          -> L (Tuple2 (L Char) (L (L Int)))
+          -> L (L Char)
+map5 f N = N
+map5 f (C1 x xs) = C1 (f x) (map5 f xs)
+
+map6 :: (Int -> L Char) -> L Int -> L (L Char)
+map6 f N = N
+map6 f (C1 x xs) = C1 (f x) (map6 f xs)
+
+-- compose
+
+compose2 :: (L (L Char) -> L Char) 
+            -> (L Int -> L (L Char)) 
+            -> L Int -> L Char
+compose2 f g xs = f (g xs)
+
+compose1 :: (L Int -> L Int) 
+             -> (L Int -> L Int) -> L Int -> L Int
+compose1 f g xs = f (g xs)
+
+-- concat
+
+concat1 :: L (L Char) -> L Char
+concat1 = foldr_1 append1 N
+
+-- foldr
+
+foldr_1 :: (L Char -> L Char -> L Char) 
+            -> L Char -> L (L Char) -> L Char
+foldr_1 f a N = a
+foldr_1 f a (C1 x xs) = f x (foldr_1 f a xs)
+
+-- appends
+
+append1 :: L Char -> L Char -> L Char
+append1 N ys = ys
+append1 (C1 x xs) ys = C1 x (append1 xs ys)
+
+append2 :: L (L Int) -> L (L Int) -> L (L Int)
+append2 N ys = ys
+append2 (C1 x xs) ys = C1 x (append2 xs ys)
+
+append3 :: L Int -> L Int -> L Int
+append3 N ys = ys
+append3 (C1 x xs) ys = C1 x (append3 xs ys)
+
+-- zips
+
+pzip f (C1 x1 xs) (C1 y1 ys)
+ = C1 (f x1 y1) (pzip f xs ys)
+pzip f _ _ = N
+
+
+zip1_ :: L (L Char)
+         -> L (L (L Int))
+         -> L (Tuple2 (L Char) (L (L Int)))
+zip1_ = pzip T2
+
+zip2_ :: L (L Int)
+         -> L (L Int)
+         -> L (Tuple2 (L Int) (L Int))
+zip2_ = pzip T2 
+
+zip3d :: L Int -> (Tuple2 (L Int) (L Int)) 
+            -> (Tuple3 (L Int) (L Int) (L Int))
+zip3d x (T2 y z) = T3 x y z
+
+zip3_ :: L (L Int) 
+         -> L (Tuple2 (L Int) (L Int))
+         -> L (Tuple3 (L Int) (L Int) (L Int))
+zip3_ = pzip zip3d
+
+zip4_ :: L Int
+         -> L Int 
+         -> L (Tuple2 Int Int)
+zip4_ = pzip T2
+
+zip5d :: Int -> (Tuple2 Int Int) -> (Tuple3 Int Int Int)
+zip5d x (T2 y z) = T3 x y z
+
+zip5_ :: L Int 
+         -> L (Tuple2 Int Int)
+         -> L (Tuple3 Int Int Int)
+zip5_ = pzip zip5d
+
+zip6_ :: L (Tuple3 Int Int Int)
+         -> L (Tuple3 Int Int Int)
+         -> L (Tuple2 (Tuple3 Int Int Int)
+                      (Tuple3 Int Int Int))
+zip6_ = pzip T2
+
+zip31 :: L (L Int) -> L (L Int) 
+         -> L (L Int)  
+         -> L (Tuple3 (L Int) (L Int) (L Int))
+zip31 as bs cs
+  = zip3_ as (zip2_ bs cs)
+
+zip32 :: L Int -> L Int -> L Int 
+          -> L (Tuple3 Int Int Int)
+zip32 as bs cs
+  = zip5_ as (zip4_ bs cs)
+
+-- zipWith
+
+zipWith21 :: ((Tuple3 Int Int Int) 
+              -> (Tuple2 (Tuple3 Int Int Int) 
+                         (Tuple3 Int Int Int)) -> Int)
+              -> L (Tuple3 Int Int Int) 
+              -> L (Tuple2 (Tuple3 Int Int Int) 
+                           (Tuple3 Int Int Int))
+              -> L Int
+zipWith21 = pzip 
+
+zipWith31 :: ((Tuple3 Int Int Int) 
+              -> (Tuple3 Int Int Int) 
+              -> (Tuple3 Int Int Int) -> Int)
+               -> L (Tuple3 Int Int Int)
+               -> L (Tuple3 Int Int Int)
+               -> L (Tuple3 Int Int Int) -> L Int
+zipWith31 z as bs cs
+ = zipWith21 z' as (zip6_ bs cs)
+   where z' a (T2 b c) = z a b c
diff --git a/ghc/compiler/ilxGen/tests/reduce.ml b/ghc/compiler/ilxGen/tests/reduce.ml
new file mode 100644
index 0000000000..cad379b522
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/reduce.ml
@@ -0,0 +1,101 @@
+
+
+type kind = 
+    ARROW of kind * kind
+  | TYP
+
+type tycon = 
+  | TyVar of int
+  | FUN
+  | LIST
+  | STRING
+
+type typ = 
+    TyForall of kind * typ
+  | TyApp of tycon * typ list
+
+type exp = 
+  | AbsTm of typ * exp
+  | Var of int
+  | App of exp * exp
+  | String of string
+  | AbsTy of kind * exp
+  | AppTy of exp * typ
+
+type ttyp =
+  | TTyFun of ttyp * ttyp
+  | TTyList of ttyp
+  | TTyString
+  | TTyAny
+  | TTyVar of int
+  | TTyForall of ttyp
+
+type texp =
+  | TAbsTm of  ttyp * texp
+  | TVar of int
+  | TApp of texp * texp
+  | TString of string
+  | TLetTy of texp * texp
+  | TCast of texp * ttyp
+
+  | TAppTy of texp * ttyp
+  | TAbsTy of texp
+
+ 
+let (-->) x y = TyApp (FUN, [x;y])
+let (--->) x y = TTyFun (x,y)
+
+let rec trans_kind = function
+    ARROW (k1,k2) -> (trans_kind k1 ---> trans_kind k2)
+  | TYP -> (TTyForall TANY ---> TTyAny)
+
+let rec trans_typ_arg_aux = function
+    (* TyForall (k,ty) -> TAbsTm (trans_kind k, TAbsTy (trans_typ ty)) ??? *)
+  | TyApp (TyVar tv, args) -> failwith "unreduced"
+  | ty -> TAbsTm (trans_kind k, TAbsTy (trans_typ ty))failwith "unreduced"
+  | 
+let rec trans_typ_arg env = function
+  | TyApp (FUN, []) -> 
+      TAbsTm 
+	(trans_kind TYP, 
+	 TLetTy (TVar 0, 
+		 TAbsTm 
+		   (trans_kind TYP, 
+		    TLetTy (TVar 0, 
+			    TAbsTm 
+			      (TTyForall TANY, 
+			       TAppTy (TVar 0, TTyFun (TTyVar 0, TTyVar 1)))))))
+  | TyApp (TyVar tv, args) -> 
+      try List.assoc (tv,args) env 
+      with Not_found -> failwith "trans_typ: unreduced type variable"
+  | ty -> TAbsTm (TTyForall TANY, TAppTy (TVar 0, trans_typ env ty))
+(*
+  | TyApp (STRING, []) -> TAbsTm (TTyForall TANY, TAppTy (TVar 0, TTyString))
+  | TyApp (FUN, [l;r]) -> TAbsTm (TTyForall TANY, TAppTy (TVar 0, TTyFun (trans_typ l, trans_typ r)))
+*)
+
+
+let rec trans_typ env = function
+    TyForall (k,ty) -> (trans_kind k ---> TTyAny)
+  | TyApp (TyVar tv, args) -> 
+      try List.assoc (tv,args) env 
+      with Not_found -> failwith "trans_typ: unreduced type variable"
+  | TyApp (FUN, [l;r]) -> TTyFun (trans_typ env l, trans_typ env r)
+  | TyApp (STRING, []) -> TTyString
+  | _ -> failwith "trans_typ: badly formed input type"
+
+
+let rec trans_exp env = function
+  | AbsTm (ty,e) -> TAbsTm(trans_typ ty, trans_exp e)
+  | Var n -> TVar n
+  | App (l,r) -> TApp(trans_exp l, trans_exp r)
+  | String s -> TString s
+  | AbsTy (k,e) -> TAbsTm(trans_kind k, reduce env e)
+  | AppTy (tm,ty) -> TAppTy(trans_exp tm, trans_typ_arg env ty)
+
+
+open Format;;
+
+
+let rec pp_print_exp pps = function
+    L e -> fprintf pps "\
diff --git a/ghc/compiler/ilxGen/tests/test1.hs b/ghc/compiler/ilxGen/tests/test1.hs
new file mode 100644
index 0000000000..158c2a7bf0
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test1.hs
@@ -0,0 +1,89 @@
+-- To start:
+-- source /bin/devghc
+
+-- To compile GHC
+-- make ilxGen/IlxGen.o hsc
+
+-- To compile ILXASM
+-- (cd /devel/fcom/src; make bin/ilxasm.exe) 
+
+-- To compile to ILX
+-- (cd ilxGen/tests; ../../../driver/ghc-inplace --ilx test.hs) 
+
+
+
+-- To generate a complete ILX file, including preludes for GHC and ILX:
+-- (cd ilxGen/tests/; cat prelude.ilx test.ilx  /devel/fcom/src/ilxasm/stdlib-func.ilx > test.full.ilx)
+
+-- Run ILXASM to get a IL
+-- ( cd ilxGen/tests/; /devel/fcom/src/bin/ilxasm.exe --no-ilasm --no-stdlib test.full.ilx > test.il)
+
+-- To compile IL to .EXE or .DLL:
+-- With build of VS (e.g. Don & Andrew)
+--   ( cd ilxGen/tests/; cmd /C "c:\\bin\\devvs.bat && ilasm test.il") 
+-- With Lightning SDK, where env. variables are on path (e.g. Reuben):
+--   ( cd ilxGen/tests/; ilasm test.il) 
+
+-- To validate .EXE:
+-- (cd /devel/fcom/src; make  bin/ilvalid.exe mscorlib.vlb)
+-- (export ILVALID_HOME=/devel/fcom/src; cd ilxGen/tests/; /devel/fcom/src/bin/ilvalid.exe test.il) 
+
+-- To run unverifiable code:
+-- With build of VS (e.g. Don & Andrew)
+--    (cd ilxGen/tests/;  cmd /C "c:\\bin\\devvs.bat && .\test.exe")
+-- With Lightning SDK, where env. variables are on path (e.g. Reuben):
+--    (cd ilxGen/tests/; ./test.exe)
+
+-- To compile ILX to verifiable code and verify
+-- (cd /devel/fcom/src; make bin/ilxasm.exe bin/ilverify.exe)  && (cd ilxGen/tests/; export ILVALID_HOME=/devel/fcom/src; cat prelude.ilx  test.ilx /devel/fcom/src/assem/stdlib-func.ilx > test.full.ilx && cd ilxGen/tests/; /devel/fcom/src/bin/ilxasm.exe --no-ilasm test.full.ilx > test.safe.il && /devel/fcom/src/bin/ilverify.exe test.safe.il) 
+
+-- (cd ilxGen/tests/;  cmd /C "c:\\bin\\devvs.bat && .\test.safe.exe")
+
+--append:: [Char] -> [Char] -> [Char]
+--append [] l2 = l2
+--append (h:t) l2 = h:append t l2
+
+data N = Z | S N
+
+chooseN n  = 
+  case n of 
+       Z -> "even\n"
+       S Z -> "odd\n"
+       S (S m) -> chooseN m 
+
+add n m = 
+   case n of
+       Z -> m  
+       S nn -> S (add nn m)
+
+mul n m = 
+   case n of
+       Z -> Z
+       S nn -> add m (mul nn m)
+
+pow n m = 
+   case m of
+       Z -> S Z
+       S mm -> mul n (pow n mm)
+
+sq n = mul n n
+
+n1 = S Z
+n2 = add n1 n1
+n4 = add n2 n2
+n6 = add n2 n4
+n8 = add n2 n6
+n10 = add n2 n8
+n16 = add n6 n10
+n17 = add n1 n16
+n18 = add n8 n10
+n19 = add n1 n18
+n20 = add n4 n16
+
+bign = pow n2 n20
+bign1 = add bign n1
+
+main = putStr (chooseN bign1)
+
+
+
diff --git a/ghc/compiler/ilxGen/tests/test10.hs b/ghc/compiler/ilxGen/tests/test10.hs
new file mode 100644
index 0000000000..46c384d9e0
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test10.hs
@@ -0,0 +1,45 @@
+
+data N = Z | S N
+
+choose1 n1 = 
+  case n1 of 
+       Z -> "even\n"
+       S Z -> "odd\n"
+       S (S m) -> choose1 m 
+choose2 n1 n2 = 
+  case n1 of 
+       Z -> choose1 n2
+       S Z -> "odd\n"
+       S (S m) -> choose2 m n2
+choose3 n1 n2 n3 = 
+  case n1 of 
+       Z -> choose2 n2 n3
+       S Z -> "odd\n"
+       S (S m) -> choose3 m n2 n3
+
+choose4 n1 n2 n3 n4  = 
+  case n1 of 
+       Z -> choose3 n2 n3 n4
+       S Z -> "odd\n"
+       S (S m) -> choose4 m n2 n3 n4 
+
+choose5 n1 n2 n3 n4 n5 = 
+  case n1 of 
+       Z -> choose4 n2 n3 n4 n5
+       S Z -> "odd\n"
+       S (S m) -> choose5 m n2 n3 n4 n5
+
+add n m = 
+   case n of
+       Z -> m  
+       S nn -> S (add nn m)
+
+n1 = S Z
+n2 = add n1 n1
+n4 = add n2 n2
+n6 = add n2 n4
+
+
+
+main = putStr (choose5 n6 n4 n2 n2 n1)
+
diff --git a/ghc/compiler/ilxGen/tests/test11.hs b/ghc/compiler/ilxGen/tests/test11.hs
new file mode 100644
index 0000000000..ce53f71389
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test11.hs
@@ -0,0 +1,61 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+import PrelGHC
+
+class  EEq a  where
+    (===), (/==)		:: a -> a -> Bool
+
+--    x /= y		= not (x == y)
+--    x == y		= not (x /= y)
+--    x /= y		=  True
+    (/==) x y            = mynot  ((===) x y)
+    x === y		=  True
+
+data EOrdering = ELT | EEQ | EGT 
+
+mynot True = False
+mynot False = True
+
+{-
+class  (EEq a) => EOrd a  where
+    ecompare             :: a -> a -> EOrdering
+    (<<), (<<=), (>>>=), (>>>):: a -> a -> Bool
+    emax, emin		:: a -> a -> a
+
+-- An instance of Ord should define either compare or <=
+-- Using compare can be more efficient for complex types.
+    ecompare x y
+	    | x === y    = EEQ
+	    | x <<= y    = ELT	-- NB: must be '<=' not '<' to validate the
+				-- above claim about the minimal things that can
+				-- be defined for an instance of Ord
+	    | otherwise = EGT
+
+    x <<= y  = case ecompare x y of { EGT -> False; _other -> True }
+    x <<	 y  = case ecompare x y of { ELT -> True;  _other -> False }
+    x >>>= y  = case ecompare x y of { ELT -> False; _other -> True }
+    x >>>	 y  = case ecompare x y of { EGT -> True;  _other -> False }
+
+	-- These two default methods use '>' rather than compare
+	-- because the latter is often more expensive
+    emax x y = if x >>> y then x else y
+    emin x y = if x >>> y then y else x
+-}
+
+data EInt = EI Int#
+
+ezeroInt, eoneInt, etwoInt, emaxInt, eminInt :: EInt
+ezeroInt = EI 0#
+eoneInt  = EI 1#
+etwoInt  = EI 2#
+eminInt  = EI (-2147483648#)	-- GHC <= 2.09 had this at -2147483647
+emaxInt  = EI 2147483647#
+eeqInt	(EI x) (EI y) = x ==# y
+eneInt	(EI x) (EI y) = x /=# y
+
+instance EEq EInt where
+    (===) x y = x `eeqInt` y
+    (/==) x y = x `eneInt` y
+
+main = putStr (if (ezeroInt === eoneInt) then "no!\n" else "yes!\n")
+
diff --git a/ghc/compiler/ilxGen/tests/test12.hs b/ghc/compiler/ilxGen/tests/test12.hs
new file mode 100644
index 0000000000..216c792f32
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test12.hs
@@ -0,0 +1,44 @@
+class  NewFunctor f  where
+    new_fmap         :: (a -> b) -> f a -> f b
+
+data N a = Z a | S (N a)
+
+nmap f (Z x) = Z (f x)
+nmap f (S n) = S (nmap f n)
+
+tag (Z x) = x
+tag (S n) = tag n
+
+instance NewFunctor N where
+    new_fmap = nmap
+
+--class  Strange f  where
+--    zero         :: a -> f a
+--    suc         :: f a -> f a
+--    tag         :: f a -> a
+
+
+--class  FMonad m  where
+--    (>>=)       :: m a -> (a -> m b) -> m b
+--    (>>)        :: m a -> m b -> m b
+--    return      :: a -> m a
+--    fail	:: String -> m a
+--
+--    m >> k      =  m >>= \_ -> k
+--    fail s      = error s
+
+
+
+
+--instance Strange N
+--  where
+--   zero x = Z x
+--   suc y = S y
+--   tag n = gettag n
+
+twice :: NewFunctor f => (a -> a) -> f a -> f a
+twice f x = new_fmap f (new_fmap f x)
+
+main = putStr (tag (nmap (\x -> x) (Z "hello world\n")))
+--main = putStr (tag (nmap (\x -> x) (Z "hello world\n")))
+-- main = putStr (tag {- (twice (\x -> x) -}  (Z "hello world\n"))
diff --git a/ghc/compiler/ilxGen/tests/test13.hs b/ghc/compiler/ilxGen/tests/test13.hs
new file mode 100644
index 0000000000..559c8674fa
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test13.hs
@@ -0,0 +1,20 @@
+class  NewFunctor f  where
+    inj         :: a -> f a
+    surj         :: f a -> a
+
+data N a = Z a 
+
+ninj x = (Z x) 
+nsurj (Z x) = x
+
+instance NewFunctor N where
+    inj = ninj
+    surj = nsurj
+
+twice :: NewFunctor f => a -> f (f a)
+twice x = inj(inj x)
+
+undo :: NewFunctor f => f (f a) -> a
+undo x = surj(surj x)
+
+main = putStr (undo (Z (Z "hello world\n")))
diff --git a/ghc/compiler/ilxGen/tests/test14.hs b/ghc/compiler/ilxGen/tests/test14.hs
new file mode 100644
index 0000000000..86b5d1c821
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test14.hs
@@ -0,0 +1,11 @@
+class  EMonad m  where
+    aaaaa       :: m a -> (a -> m b) -> m b
+    bbbbb        :: m a -> m b -> m b
+
+    bbbbb m k      =  aaaaa m (\_ -> k)
+                  -- = \M \A \B -> \m:(M A) -> \k:(M B) -> aaaaa M A B m (\_:A -> k: M B)
+                  --   Free types must include "A"!!!
+
+main = putStr "hello world\n"
+
+
diff --git a/ghc/compiler/ilxGen/tests/test15.hs b/ghc/compiler/ilxGen/tests/test15.hs
new file mode 100644
index 0000000000..2dc494cda0
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test15.hs
@@ -0,0 +1,20 @@
+
+{-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
+
+
+module Foo where
+
+import PrelBase
+import PrelList
+import PrelEnum
+import PrelShow
+import PrelIO
+
+
+bbuild 	:: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
+{-# INLINE 2 bbuild #-}
+bbuild g = g (:) []
+
+main = putStr "hello world\n"
+
+
diff --git a/ghc/compiler/ilxGen/tests/test16.hs b/ghc/compiler/ilxGen/tests/test16.hs
new file mode 100644
index 0000000000..0e8b9974a9
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test16.hs
@@ -0,0 +1,5 @@
+
+
+data MMaybe a = No | Yes a 
+
+main = putStr "hello world\n"
\ No newline at end of file
diff --git a/ghc/compiler/ilxGen/tests/test17.hs b/ghc/compiler/ilxGen/tests/test17.hs
new file mode 100644
index 0000000000..5e551b2dcd
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test17.hs
@@ -0,0 +1,44 @@
+{-# OPTIONS -fno-implicit-prelude #-}
+
+module Test17 where
+
+import PrelGHC
+import PrelBase
+
+data Exception = IOException IOError | OtherExc
+
+data IOError 
+ = IOError 
+     String      
+
+tthrow :: Exception -> a
+
+tthrow exception = raise# exception
+ccatchException (IO m) k =  IO (\s -> catch# m (\ex -> unIO (k ex)) s)
+
+
+ccatch           :: IO a -> (IOError -> IO a) -> IO a 
+ccatch m k	=  ccatchException m handler
+  where handler (IOException err) = k err
+	handler other             = tthrow other
+
+ccatchNonIO      :: IO a -> (Exception -> IO a) -> IO a 
+ccatchNonIO m k	=  ccatchException m handler
+  where handler (IOException err) = ioError err
+	handler other             = k other
+
+newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
+
+unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
+unIO (IO a) = a
+
+ioError         :: IOError -> IO a 
+ioError err	=  IO (\s -> tthrow (IOException err) s)
+
+
+
+blockAsyncExceptions :: IO a -> IO a
+blockAsyncExceptions (IO io) = IO (blockAsyncExceptions# io)
+
+unblockAsyncExceptions :: IO a -> IO a
+unblockAsyncExceptions (IO io) = IO (unblockAsyncExceptions# io)
diff --git a/ghc/compiler/ilxGen/tests/test18.hs b/ghc/compiler/ilxGen/tests/test18.hs
new file mode 100644
index 0000000000..12ca7413f1
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test18.hs
@@ -0,0 +1,129 @@
+{-# OPTIONS -fno-implicit-prelude #-}
+
+module Test18 where
+
+import PrelGHC
+import PrelBase
+
+eftCharFB c n x y = go x
+		 where
+		    go x | x ># y    = n
+			 | otherwise = C# (chr# x) `c` go (x +# 1#)
+
+
+eftIntFB c n x y | x ># y    = n	
+		 | otherwise = go x
+		 where
+		   go x = I# x `c` if x ==# y then n else go (x +# 1#)
+
+eftIntList x y | x ># y    = []
+	       | otherwise = go x
+	       where
+		 go x = I# x : if x ==# y then [] else go (x +# 1#)
+
+
+efdCharFB c n x1 x2
+  | delta >=# 0# = go_up_char_fb c n x1 delta 255#
+  | otherwise    = go_dn_char_fb c n x1 delta 0#
+  where
+    delta = x2 -# x1
+
+efdCharList x1 x2
+  | delta >=# 0# = go_up_char_list x1 delta 255#
+  | otherwise    = go_dn_char_list x1 delta 0#
+  where
+    delta = x2 -# x1
+
+efdtCharFB c n x1 x2 lim
+  | delta >=# 0# = go_up_char_fb c n x1 delta lim
+  | otherwise    = go_dn_char_fb c n x1 delta lim
+  where
+    delta = x2 -# x1
+
+efdtCharList x1 x2 lim
+  | delta >=# 0# = go_up_char_list x1 delta lim
+  | otherwise    = go_dn_char_list x1 delta lim
+  where
+    delta = x2 -# x1
+
+go_up_char_fb c n x delta lim
+  = go_up x
+  where
+    go_up x | x ># lim  = n
+	    | otherwise	= C# (chr# x) `c` go_up (x +# delta)
+
+go_dn_char_fb c n x delta lim
+  = go_dn x
+  where
+    go_dn x | x <# lim  = n
+	    | otherwise	= C# (chr# x) `c` go_dn (x +# delta)
+
+go_up_char_list x delta lim
+  = go_up x
+  where
+    go_up x | x ># lim  = []
+	    | otherwise	= C# (chr# x) : go_up (x +# delta)
+
+
+go_dn_char_list x delta lim
+  = go_dn x
+  where
+    go_dn x | x <# lim  = []
+	    | otherwise	= C# (chr# x) : go_dn (x +# delta)
+
+efdtIntFB c n x1 x2 y
+  | delta >=# 0# = if x1 ># y then n else go_up_int_fb c n x1 delta lim
+  | otherwise    = if x1 <# y then n else go_dn_int_fb c n x1 delta lim 
+  where
+    delta = x2 -# x1
+    lim   = y -# delta
+
+efdtIntList x1 x2 y
+  | delta >=# 0# = if x1 ># y then [] else go_up_int_list x1 delta lim
+  | otherwise    = if x1 <# y then [] else go_dn_int_list x1 delta lim
+  where
+    delta = x2 -# x1
+    lim   = y -# delta
+
+efdIntFB c n x1 x2
+  | delta >=# 0# = go_up_int_fb c n x1 delta (  2147483647#  -# delta)
+  | otherwise    = go_dn_int_fb c n x1 delta ((-2147483648#) -# delta)
+  where
+    delta = x2 -# x1
+
+efdIntList x1 x2
+  | delta >=# 0# = go_up_int_list x1 delta (  2147483647#  -# delta)
+  | otherwise    = go_dn_int_list x1 delta ((-2147483648#) -# delta)
+  where
+    delta = x2 -# x1
+
+-- In all of these, the (x +# delta) is guaranteed not to overflow
+
+go_up_int_fb c n x delta lim
+  = go_up x
+  where
+    go_up x | x ># lim  = I# x `c` n
+	    | otherwise = I# x `c` go_up (x +# delta)
+
+go_dn_int_fb c n x delta lim 
+  = go_dn x
+  where
+    go_dn x | x <# lim  = I# x `c` n
+	    | otherwise = I# x `c` go_dn (x +# delta)
+
+go_up_int_list x delta lim
+  = go_up x
+  where
+    go_up x | x ># lim  = [I# x]
+	    | otherwise = I# x : go_up (x +# delta)
+
+go_dn_int_list x delta lim 
+  = go_dn x
+  where
+    go_dn x | x <# lim  = [I# x]
+	    | otherwise = I# x : go_dn (x +# delta)
+eftInt 	= eftIntList
+efdInt 	= efdIntList
+efdtInt = efdtIntList
+
+
diff --git a/ghc/compiler/ilxGen/tests/test19.hs b/ghc/compiler/ilxGen/tests/test19.hs
new file mode 100644
index 0000000000..a292599031
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test19.hs
@@ -0,0 +1,37 @@
+
+{-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
+
+
+module Test19 where
+
+import PrelST
+import PrelBase
+import PrelErr
+
+newtype IIO a = IIO (State# RealWorld -> (# State# RealWorld, a #))
+
+unIIO :: IIO a -> (State# RealWorld -> (# State# RealWorld, a #))
+unIIO (IIO a) = a
+
+instance  Functor IIO where
+   fmap f x = x >>= (return . f)
+
+instance  Monad IIO  where
+    {-# INLINE return #-}
+    {-# INLINE (>>)   #-}
+    {-# INLINE (>>=)  #-}
+    m >> k      =  m >>= \ _ -> k
+    return x	= returnIIO x
+
+    m >>= k     = bindIIO m k
+    fail s	= error s -- not ioError?
+
+
+bindIIO :: IIO a -> (a -> IIO b) -> IIO b
+bindIIO (IIO m) k = IIO ( \ s ->
+  case m s of 
+    (# new_s, a #) -> unIIO (k a) new_s
+  )
+
+returnIIO :: a -> IIO a
+returnIIO x = IIO (\ s -> (# s, x #))
diff --git a/ghc/compiler/ilxGen/tests/test1b.hs b/ghc/compiler/ilxGen/tests/test1b.hs
new file mode 100644
index 0000000000..c4b2336df1
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test1b.hs
@@ -0,0 +1,104 @@
+-- To start:
+-- source /bin/devghc
+
+-- To compile GHC
+-- make ilxGen/IlxGen.o hsc
+
+-- To compile ILXASM
+-- (cd /devel/fcom/src; make bin/ilxasm.exe) 
+
+-- To compile to ILX
+-- (cd ilxGen/tests; ../../../driver/ghc-inplace --ilx test.hs) 
+
+
+
+-- To generate a complete ILX file, including preludes for GHC and ILX:
+-- (cd ilxGen/tests/; cat prelude.ilx test.ilx  /devel/fcom/src/ilxasm/stdlib-func.ilx > test.full.ilx)
+
+-- Run ILXASM to get a IL
+-- ( cd ilxGen/tests/; /devel/fcom/src/bin/ilxasm.exe --no-ilasm --no-stdlib test.full.ilx > test.il)
+
+-- To compile IL to .EXE or .DLL:
+-- With build of VS (e.g. Don & Andrew)
+--   ( cd ilxGen/tests/; cmd /C "c:\\bin\\devvs.bat && ilasm test.il") 
+-- With Lightning SDK, where env. variables are on path (e.g. Reuben):
+--   ( cd ilxGen/tests/; ilasm test.il) 
+
+-- To validate .EXE:
+-- (cd /devel/fcom/src; make  bin/ilvalid.exe mscorlib.vlb)
+-- (export ILVALID_HOME=/devel/fcom/src; cd ilxGen/tests/; /devel/fcom/src/bin/ilvalid.exe test.il) 
+
+-- To run unverifiable code:
+-- With build of VS (e.g. Don & Andrew)
+--    (cd ilxGen/tests/;  cmd /C "c:\\bin\\devvs.bat && .\test.exe")
+-- With Lightning SDK, where env. variables are on path (e.g. Reuben):
+--    (cd ilxGen/tests/; ./test.exe)
+
+-- To compile ILX to verifiable code and verify
+-- (cd /devel/fcom/src; make bin/ilxasm.exe bin/ilverify.exe)  && (cd ilxGen/tests/; export ILVALID_HOME=/devel/fcom/src; cat prelude.ilx  test.ilx /devel/fcom/src/assem/stdlib-func.ilx > test.full.ilx && cd ilxGen/tests/; /devel/fcom/src/bin/ilxasm.exe --no-ilasm test.full.ilx > test.safe.il && /devel/fcom/src/bin/ilverify.exe test.safe.il) 
+
+-- (cd ilxGen/tests/;  cmd /C "c:\\bin\\devvs.bat && .\test.safe.exe")
+
+--append:: [Char] -> [Char] -> [Char]
+--append [] l2 = l2
+--append (h:t) l2 = h:append t l2
+
+data N = Z | S N
+
+chooseN n  = 
+  case n of 
+       Z -> "even\n"
+       S Z -> "odd\n"
+       S (S m) -> chooseN m 
+
+signN n  = 
+  case n of 
+       Z -> Z
+       S Z -> S Z
+       S (S m) -> signN m 
+add n m = 
+   case n of
+       Z -> m  
+       S nn -> S (add nn m)
+
+mul n m = 
+   case n of
+       Z -> Z
+       S nn -> add m (mul nn m)
+
+pow n m = 
+   case m of
+       Z -> S Z
+       S mm -> mul n (pow n mm)
+
+sq n = mul n n
+
+n1 = S Z
+n2 = add n1 n1
+n4 = add n2 n2
+n6 = add n2 n4
+n8 = add n2 n6
+n10 = add n2 n8
+n11 = add n1 n10
+n12 = add n1 n11
+n13 = add n1 n12
+n14 = add n1 n13
+n15 = add n1 n14
+n16 = add n1 n15
+n17 = add n1 n16
+n18 = add n1 n17
+n19 = add n1 n18
+n20 = add n1 n18
+
+bign = pow n2 n19
+bign1 = add bign n1
+
+foldn f n acc = 
+   case n of
+    Z -> acc
+    S x -> foldn f x (f n acc)
+
+main = putStr (chooseN (foldn (\x y -> add (signN x) y)  (pow n2 n4)  n1))
+
+
+
diff --git a/ghc/compiler/ilxGen/tests/test2.hs b/ghc/compiler/ilxGen/tests/test2.hs
new file mode 100644
index 0000000000..2c0c8fb416
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test2.hs
@@ -0,0 +1 @@
+main = putStr "Hello world.\n"
diff --git a/ghc/compiler/ilxGen/tests/test20.hs b/ghc/compiler/ilxGen/tests/test20.hs
new file mode 100644
index 0000000000..157a16da1d
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test20.hs
@@ -0,0 +1,9 @@
+
+data N = Z | S N
+
+res Z x y = (# x, y #)
+res (S n) x y = res n x y
+
+(# x, y #) = res (S Z) "no!" "hello world\n"
+
+main = putStr y
diff --git a/ghc/compiler/ilxGen/tests/test21.hs b/ghc/compiler/ilxGen/tests/test21.hs
new file mode 100644
index 0000000000..1870f22b97
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test21.hs
@@ -0,0 +1,13 @@
+{-# OPTIONS -fno-implicit-prelude  #-}
+
+import PrelIOBase
+import PrelIO
+import PrelBase
+import PrelAddr
+
+foreign import "libHS_cbits" "getErrStr__"  unsafe ggetErrStr__  :: Int -> IO Addr 
+
+main = putStr (uunsafePerformIO (ggetErrStr__ 4))
+
+uunsafePerformIO	:: IO Addr -> [Char]
+uunsafePerformIO (IO m) = case m realWorld# of (# _, (A# r) #)   -> (unpackCString#  r)
diff --git a/ghc/compiler/ilxGen/tests/test2b.hs b/ghc/compiler/ilxGen/tests/test2b.hs
new file mode 100644
index 0000000000..08a391f799
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test2b.hs
@@ -0,0 +1,2 @@
+foreign import "ilxHello" unsafe ilxHello :: IO ()
+main = ilxHello
diff --git a/ghc/compiler/ilxGen/tests/test2c.hs b/ghc/compiler/ilxGen/tests/test2c.hs
new file mode 100644
index 0000000000..d01df051f8
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test2c.hs
@@ -0,0 +1,14 @@
+import PrelIOBase
+
+
+bindIO2 :: IO () -> IO () -> IO ()
+bindIO2 m (IO k) = IO ( \ s -> k s )
+
+foreign import "ilxHello" unsafe ilxHello :: IO ()
+
+data N = S N | Z
+
+f Z = bindIO2 
+f (S x) = f x
+
+main = f(S Z) ilxHello ilxHello
diff --git a/ghc/compiler/ilxGen/tests/test2d.hs b/ghc/compiler/ilxGen/tests/test2d.hs
new file mode 100644
index 0000000000..8126127a32
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test2d.hs
@@ -0,0 +1,7 @@
+foreign import ccall "libHS_cbits.so" "get_prog_argc" unsafe primArgc :: Int
+
+foreign import "ilxHello" unsafe ilxHello :: IO ()
+foreign import "ilxBad" unsafe ilxBad :: IO ()
+
+
+main = if (primArgc == 0) then ilxHello else ilxBad
diff --git a/ghc/compiler/ilxGen/tests/test3.hs b/ghc/compiler/ilxGen/tests/test3.hs
new file mode 100644
index 0000000000..0254ee41c4
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test3.hs
@@ -0,0 +1,24 @@
+foreign import "ilxHello" unsafe ilxHello :: IO ()
+foreign import "ilxBad" unsafe ilxBad :: IO ()
+
+class  Eqq a  where
+    eqq		:: a -> Bool
+    eqq2	:: a -> Bool
+
+--    x /= y		= not (x == y)
+--    x == y		= not (x /= y)
+--    x /= y		=  True
+    eqq x		=  False
+    eqq2 x		=  True
+
+
+data  Unit  =  Unit
+
+instance Eqq Unit 
+--  where
+--    eqq Unit = True
+--    eqq2 Unit = False
+
+choose x = if eqq x then ilxHello else if eqq2 x then ilxBad else ilxBad
+
+main = choose Unit
diff --git a/ghc/compiler/ilxGen/tests/test4.hs b/ghc/compiler/ilxGen/tests/test4.hs
new file mode 100644
index 0000000000..080c6521e3
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test4.hs
@@ -0,0 +1,47 @@
+class  Eqq a  where
+    evenN :: a -> Bool
+    oddN	:: a -> Bool
+    evenN x		=  False
+    oddN x		=  True
+
+
+data N = Z | S N
+
+instance Eqq N 
+  where
+   evenN Z = True
+   evenN (S x) = oddN x
+   oddN Z = False
+   oddN (S x) = evenN x
+
+choose x = if evenN x then "hello world (evenN)\n" else if oddN x then "hello world (oddN)\n" else "no!\n"
+
+add n m = 
+   case n of
+       Z -> m  
+       S nn -> S (add nn m)
+
+mul n m = 
+   case n of
+       Z -> Z
+       S nn -> add m (mul nn m)
+
+pow n m = 
+   case m of
+       Z -> S Z
+       S mm -> mul n (pow n mm)
+
+n1 = S Z
+n2 = add n1 n1
+n4 = add n2 n2
+n6 = add n2 n4
+n8 = add n2 n6
+n10 = add n2 n8
+n16 = add n6 n10
+n18 = add n8 n10
+n20 = add n4 n16
+
+bign = pow n2 n16
+bign1 = add bign n1
+
+main = putStr (choose bign1)
diff --git a/ghc/compiler/ilxGen/tests/test5.hs b/ghc/compiler/ilxGen/tests/test5.hs
new file mode 100644
index 0000000000..13d6028c02
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test5.hs
@@ -0,0 +1,5 @@
+data One a = One a
+
+choose (One x) = x
+main = putStr (choose (One "hello world\n"))
+
diff --git a/ghc/compiler/ilxGen/tests/test6.hs b/ghc/compiler/ilxGen/tests/test6.hs
new file mode 100644
index 0000000000..17e51ab51d
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test6.hs
@@ -0,0 +1,8 @@
+data List a = Cons a (List a)
+
+hdL (Cons x y) = x
+tlL (Cons x y) = y
+
+test = Cons "hello world\n" test
+main = putStr (hdL (tlL test))
+
diff --git a/ghc/compiler/ilxGen/tests/test7.hs b/ghc/compiler/ilxGen/tests/test7.hs
new file mode 100644
index 0000000000..c146038052
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test7.hs
@@ -0,0 +1,8 @@
+data List a = Cons a (List a)
+
+hdL (Cons x y) = x
+tlL (Cons x y) = y
+
+mk f x = f x (mk f x)
+main = putStr (hdL (tlL (mk Cons "hello world!\n")))
+
diff --git a/ghc/compiler/ilxGen/tests/test8.hs b/ghc/compiler/ilxGen/tests/test8.hs
new file mode 100644
index 0000000000..94a7e1f83d
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test8.hs
@@ -0,0 +1,8 @@
+data Inf a = A (Inf a)
+
+hd (A x) = x
+
+choose (A (A x)) =  "hello world\n"
+mk f = f (mk f)
+main = putStr (choose (hd (mk A)))
+
diff --git a/ghc/compiler/ilxGen/tests/test9.hs b/ghc/compiler/ilxGen/tests/test9.hs
new file mode 100644
index 0000000000..311b65c4e1
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/test9.hs
@@ -0,0 +1,10 @@
+data Tree a = Node (Tree a) (Tree a)
+
+left (Node x y) = x
+right (Node x y) = y
+
+choose (Node (Node _ _) (Node _ _)) = "hello world!\n"
+
+mk f = f (mk f) (mk f)
+main = putStr (choose (mk Node))
+
diff --git a/ghc/compiler/ilxGen/tests/yes.hs b/ghc/compiler/ilxGen/tests/yes.hs
new file mode 100644
index 0000000000..1dc4f085fd
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/yes.hs
@@ -0,0 +1,5 @@
+
+foreign import "ilxHello" unsafe ilxHello :: IO ()
+
+main :: IO ()
+main = ilxHello >> main
\ No newline at end of file
diff --git a/ghc/compiler/ilxGen/tests/yes2.hs b/ghc/compiler/ilxGen/tests/yes2.hs
new file mode 100644
index 0000000000..7fa20c5b7d
--- /dev/null
+++ b/ghc/compiler/ilxGen/tests/yes2.hs
@@ -0,0 +1,18 @@
+
+import PrelIOBase
+foreign import "ilxHello" unsafe ilxHello :: IO ()
+
+
+
+seqIO :: IO () -> IO () -> IO ()
+seqIO (IO m) (IO k) = IO ( \ s ->
+  case m s of 
+    (# new_s, a #) -> k new_s
+  )
+
+
+yes () = seqIO ilxHello (yes ())
+
+main :: IO ()
+main = yes ()
+