[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.

32 files changed, 1677 insertions, 0 deletions

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 ()
+