diff options
| author | Ian Lynagh <igloo@earth.li> | 2008-05-06 10:44:56 +0000 |
|---|---|---|
| committer | Ian Lynagh <igloo@earth.li> | 2008-05-06 10:44:56 +0000 |
| commit | f5edc6b0871a0debbc9a64f4cdb95c0dc35e5b16 (patch) | |
| tree | b3bee0766764bcf078b2cbfbd305e4477e99ad79 /compiler/ilxGen/tests | |
| parent | 911e7de13ab1c0e5426c7f234e0c8dd29185a2ba (diff) | |
| download | haskell-f5edc6b0871a0debbc9a64f4cdb95c0dc35e5b16.tar.gz | |
Remove ilxGen; part of trac #2243
Diffstat (limited to 'compiler/ilxGen/tests')
34 files changed, 0 insertions, 1630 deletions
diff --git a/compiler/ilxGen/tests/Makefile b/compiler/ilxGen/tests/Makefile deleted file mode 100644 index 423839c9e8..0000000000 --- a/compiler/ilxGen/tests/Makefile +++ /dev/null @@ -1,130 +0,0 @@ - -TOP = ../../.. -include $(TOP)/mk/boilerplate.mk - -WAYS=$(GhcLibWays) - -#----------------------------------------------------------------------------- -# Setting the standard variables -# - -HC = $(GHC_INPLACE) -SRC_HC_OPTS+=-cpp -fglasgow-exts - -#----------------------------------------------------------------------------- -# -CORENV_DEBUG= -CORENV_RETAIL= -LOCALRUN=./ -ifeq ($(HOSTNAME),MSRC-HILDA) -CORENV_DEBUG="call devcorb2gen.bat checked" -CORENV_RETAIL="call devcorb2gen.bat free" -LOCALRUN=.\\ -endif - -ghc: - $(MAKE) -C ../.. - -ilx: - $(MAKE) -C $(ILX2IL_HOME) ilxdefault - -prel: ilx - $(MAKE) -C ../../../lib/std std.$(ilx_way).dll std.$(ilx_way).vlb - -#======================================================================== -# 1. From Haskell to ILX and then to IL - see build.mk - -#------------------------------------------------------------------------ -# 2. From IL to .EXE - -%.$(ilx_way).exe : %.$(ilx_way).il ../Entry.$(ilx_way).il - cat $*.$(ilx_way).il ../Entry.$(ilx_way).il > $@.tmp -# echo "call devcorb2gen free" > tmp.bat - echo "ilasm /DEBUG /QUIET /OUT=$@ $@.tmp" >> tmp.bat - cmd /c tmp.bat - -../Entry.$(hs2ilx_suffix)_o: ../Entry.ilx - sed -e "s|ilx std|ilx std.$(hs2ilx_suffix)|g" ../Entry.ilx > $@.tmp - mv $@.tmp $@ - - -%.$(ilx_way).mvl: %.$(ilx_way).il - (ILVALID_HOME=c:\\devel\\fcom\\src\\ ILVALID_MSCORLIB=mscorlib.vlb $(ILVALID) c:\\devel\\fcom\\src\\bin\\msilxlib$(ilx2il_suffix).vlb $(TOP)/lib/std/std.$(ilx_way).vlb $<) 2>&1 - - -#------------------------------------------------------------------------ -# From .HS to .EXE without using ILX -# Used to run performance comparisons against native code GHC - -%.Onot.exe: %.hs - $(GHC_INPLACE) -Onot -o $@ $< - -%.O.exe: %.hs - $(GHC_INPLACE) -O -o $@ $< - -WIN_TOP_ABS = $(subst /,\,$(FPTOOLS_TOP_ABS)) -WIN_ILX2IL_HOME = $(subst /,\,$(ILX2IL_HOME)) - -app.config: - echo "<configuration>" > $@ - echo "<runtime>" >> $@ - echo "<assemblyBinding xmlns=\"urn:schemas-microsoft-com:asm.v1\">" >> $@ - echo "<probing privatePath=\"$(WIN_TOP_ABS)\\ghc\\lib\\std;$(WIN_ILX2IL_HOME)\\bin\"/>" >> $@ - echo "</assemblyBinding>" >> $@ - echo "</runtime>" >> $@ - echo "</configuration>" >> $@ - -%.run: %.exe app.config - time -p $< - -#------------------------------------------------------------------------ -# Running: - -HSstd_cbits.dll: $(DLL_PEN)/HSstd_cbits.dll - cp $< $@ - -%.cordbg.run: HSstd_cbits.dll %.exe - cp app.config $@.config -# echo "call devcorb2gen fastchecked" > $@.bat - echo "$(LOCALRUN)$(subst /,\\,$*).exe 2>&1" >> $@.bat - time -p cmd /c $(subst /,\\,$@).bat - rm $@.bat - -%.debug.run: HSstd_cbits.dll %.exe - cp app.config $@.config -# echo "call devcorb2gen fastchecked" > $@.bat - echo "$(LOCALRUN)$(subst /,\\,$*).exe 2>&1" >> $@.bat - time -p cmd /c $(subst /,\\,$@).bat - rm $@.bat - -%.retail.run: HSstd_cbits.dll %.exe - cp app.config $@.config -# echo "call devcorb2gen free" > $@.bat - echo "$(LOCALRUN)$(subst /,\\,$*).exe 2>&1" >> $@.bat - time -p cmd /c $(subst /,\\,$@).bat - rm $@.bat - - -%.run: %.exe - time -p $< - - -#-------------------- - -%.mvl: %.nolib.il - ILVALID_HOME=$(ILX2IL_HOME) $(ILVALID) $*.nolib.il - -ci: - (cd $(ILX2IL_HOME); $(CVS) ci -m "") - (cd ../..; cvs ci -m "") - (cd ../../../lib/std; $(CVS) ci -m "") - -upd: - (cd $(ILX2IL_HOME); $(CVS) up) - (cd ../..; $(CVS) up) - (cd ../../../lib/std; $(CVS) up) - - -.PHONY: %.run - -include $(TOP)/mk/target.mk diff --git a/compiler/ilxGen/tests/PrelNum.hs b/compiler/ilxGen/tests/PrelNum.hs deleted file mode 100644 index ca23e149ff..0000000000 --- a/compiler/ilxGen/tests/PrelNum.hs +++ /dev/null @@ -1,120 +0,0 @@ - - - - - - - - - - - - - - - - -{-# 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/compiler/ilxGen/tests/build.mk b/compiler/ilxGen/tests/build.mk deleted file mode 100644 index 285fd5de4e..0000000000 --- a/compiler/ilxGen/tests/build.mk +++ /dev/null @@ -1,121 +0,0 @@ -# 1. To make standard library: -# -# e.g. from lib/std directory: -# $(MAKE) way=ilx-Onot-mono std.ilx-Onot.mono.dll std.ilx-Onot.mono.vlb -# $(MAKE) way=ilx-O-mono std.ilx-O.mono.dll std.ilx-O.mono.vlb -# $(MAKE) way=ilx-Onot-generic std.ilx-Onot.generic.dll -# -# 2. To make tests: -# -# e.g. from ilxGen/tests directory: -# -# $ make -n way=ilx-Onot-mono test1.ilx-Onot.mono.retail.run -# -# $ make -n way=ilx-Onot-mono test1-nostdlib.ilx-Onot.mono.retail.run HC_OPTS="-fno-implicit-prelude -fglasgow-exts" -# - - -# Add all the ILX ways so dependencies get made correctly. -# (n.b. Actually we only need to add "ilx-Onot" and "ilx-O" for the -# GHC --> ILX dependencies, as these are the portions of the ILX -# ways that are relevant in terms of GHC options, -# but we list some of the others anyway. Also note that -# there are no dependencies required for the ILX --> IL or -# IL --> CLR phases as these operate on the "standalone" -# ILX and IL files). -# -#GhcLibWays+= ilx-Onot-mono ilx-Onot ilx-O ilx-O-mono -GhcLibWays+=i -GhcWithIlx=YES - -ILXized=YES - -GhcHcOpts+=-DILX -DNO_BIG_TUPLES -GhcLibHcOpts+=-optI--mono -optI--add-suffix-to-assembly -optImsilxlib -optI--suffix-to-add -optI.mono - -# Each set of args below defines one ILX way. -#ALL_WAYS+=ilx-Onot-generic -#WAY_ilx-Onot-generic_NAME=ILX with Haskell Optimizer Off to run on Generic CLR -#WAY_ilx-Onot-generic_HC_OPTS=-buildtag ilx-Onot $(GHC_ILX_OPTS) -Onot -#WAY_ilx-Onot-generic_ILX2IL_OPTS=--generic -#WAY_ilx-Onot-generic_ILX=YES - -#ALL_WAYS+=ilx-Onot-fullgeneric-verifiable -#WAY_ilx-Onot-fullgeneric-verifiable_NAME=ILX with Haskell Optimizer Off to run on Generic CLR -#WAY_ilx-Onot-fullgeneric-verifiable_HC_OPTS=-buildtag ilx-Onot $(GHC_ILX_OPTS) -Onot -#WAY_ilx-Onot-fullgeneric-verifiable_ILX2IL_OPTS=--fullgeneric --verifiable -#WAY_ilx-Onot-fullgeneric-verifiable_ILX=YES - -#ALL_WAYS+=ilx-Onot-repgeneric-verifiable -#WAY_ilx-Onot-repgeneric-verifiable_NAME=ILX with Haskell Optimizer Off to run on Generic CLR -#WAY_ilx-Onot-repgeneric-verifiable_HC_OPTS=-buildtag ilx-Onot $(GHC_ILX_OPTS) -Onot -#WAY_ilx-Onot-repgeneric-verifiable_ILX2IL_OPTS=--repgeneric --verifiable -#WAY_ilx-Onot-repgeneric-verifiable_ILX=YES - -#ALL_WAYS+=ilx-O-generic -#WAY_ilx-O-generic_NAME=ILX with Haskell Optimizer On to run on Generic CLR -#WAY_ilx-O-generic_HC_OPTS=-buildtag ilx-O $(GHC_ILX_OPTS) -O -#WAY_ilx-O-generic_ILX2IL_OPTS=--generic -#WAY_ilx-O-generic_ILX=YES - -#ALL_WAYS+=ilx-Onot-mono -#WAY_ilx-Onot-mono_NAME=ILX with Haskell Optimizer Off to run on V1 CLR -#WAY_ilx-Onot-mono_HC_OPTS=-buildtag ilx-Onot $(GHC_ILX_OPTS) -Onot -#WAY_ilx-Onot-mono_ILX2IL_OPTS=--mono -#WAY_ilx-Onot-mono_ILX=YES - -#ALL_WAYS+=ilx-Onot-mono-verifiable -#WAY_ilx-Onot-mono-verifiable_NAME=ILX with Haskell Optimizer Off to run on V1 CLR, verifiable code (CURRENTLY WILL NOT RUN BECAUSE OF LACK OF HIGHER KINDED TYPE PARAMETERS BUT IS USEFUL TO FIND BUGS USING THE VERIFIER) -#WAY_ilx-Onot-mono-verifiable_HC_OPTS=-buildtag ilx-Onot $(GHC_ILX_OPTS) -Onot -#WAY_ilx-Onot-mono-verifiable_ILX2IL_OPTS=--mono --verifiable -#WAY_ilx-Onot-mono-verifiable_ILX=YES - -#ALL_WAYS+=ilx-O-mono -#WAY_ilx-O-mono_NAME=ILX with Haskell Optimizer On to run on V1 CLR -#WAY_ilx-O-mono_HC_OPTS=-buildtag ilx-O $(GHC_ILX_OPTS) -O -#WAY_ilx-O-mono_ILX2IL_OPTS=--mono -#WAY_ilx-O-mono_ILX=YES - -#ALL_WAYS+=ilx-Onot-generic-traced -#WAY_ilx-Onot-generic-traced_NAME=ILX with Haskell Optimizer Off to run on Generic CLR -#WAY_ilx-Onot-generic-traced_HC_OPTS=-buildtag ilx-Onot $(GHC_ILX_OPTS) -Onot -#WAY_ilx-Onot-generic-traced_ILX2IL_OPTS=--generic --traced -#WAY_ilx-Onot-generic-traced_ILX=YES - -#ALL_WAYS+=ilx-O-generic-traced -#WAY_ilx-O-generic-traced_NAME=ILX with Haskell Optimizer On to run on Generic CLR -#WAY_ilx-O-generic-traced_HC_OPTS=-buildtag ilx-O $(GHC_ILX_OPTS) -O -#WAY_ilx-O-generic-traced_ILX2IL_OPTS=--generic --traced -#WAY_ilx-O-generic-traced_ILX=YES - -#ALL_WAYS+=ilx-Onot-mono-traced -#WAY_ilx-Onot-mono-traced_NAME=ILX with Haskell Optimizer Off to run on V1 CLR -#WAY_ilx-Onot-mono-traced_HC_OPTS=-buildtag ilx-Onot $(GHC_ILX_OPTS) -Onot -#WAY_ilx-Onot-mono-traced_ILX2IL_OPTS=--mono --traced -#WAY_ilx-Onot-mono-traced_ILX=YES - -#ALL_WAYS+=ilx-O-mono-traced -#WAY_ilx-O-mono-traced_NAME=ILX with Haskell Optimizer On to run on V1 CLR -#WAY_ilx-O-mono-traced_HC_OPTS=-buildtag ilx-O $(GHC_ILX_OPTS) -O -#WAY_ilx-O-mono-traced_ILX2IL_OPTS=--mono --traced -#WAY_ilx-O-mono-traced_ILX=YES - -# Put a "." after the Haskell portion of the way. Way names can't contain -# dots for some reason elsewhere in the Make system. But we need to be able -# to split out the Haskell portion of the way from the ILX portion (e.g. --generic) -# and the runtime portion (e.g. --retail). -ilx_way=$(subst ilx-Onot-,ilx-Onot.,$(subst ilx-O-,ilx-O.,$(way))) -ilx2il_suffix=$(subst ilx-Onot.,.,$(subst ilx-O.,.,$(ilx_way))) -hs2ilx_suffix=$(subst $(ilx2il_suffix),,$(ilx_way)) -HS_ILX=$(subst $(way),$(hs2ilx_suffix),$(HS_OBJS)) -#HS_IL=$(subst $(hs2ilx_suffix)_o,$(ilx_way).il,$(HS_ILX)) -HS_IL=$(subst .o,.il,$(HS_ILX)) - -ILVALID=C:/devel/fcom/bin/ilvalid.exe -ILVERIFY=C:/devel/fcom/bin/ilverify.exe - -%.$(ilx_way).mvl : %.$(ilx_way).il $(HS_IL) - ((ILVALID_HOME=c:\\devel\\fcom\\src\\ ILVALID_MSCORLIB=mscorlib.vlb $(ILVALID) c:\\devel\\fcom\\src\\bin\\msilxlib$(ilx2il_suffix).vlb $(addprefix --other-il-module ,$(filter-out $*.$(ilx_way).il,$(HS_IL))) $<) 2>&1) | tee $@ - -%.$(ilx_way).mvr : %.$(ilx_way).il $(HS_IL) - ((ILVALID_HOME=c:\\devel\\fcom\\src\\ ILVALID_MSCORLIB=mscorlib.vlb $(ILVERIFY) c:\\devel\\fcom\\src\\bin\\msilxlib$(ilx2il_suffix).vlb $(addprefix --other-il-module ,$(filter-out $<,$(HS_IL))) $<) 2>&1) | tee $@ diff --git a/compiler/ilxGen/tests/foo.hs b/compiler/ilxGen/tests/foo.hs deleted file mode 100644 index d66608ba22..0000000000 --- a/compiler/ilxGen/tests/foo.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# 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/compiler/ilxGen/tests/life.hs b/compiler/ilxGen/tests/life.hs deleted file mode 100644 index d6bcd16f9f..0000000000 --- a/compiler/ilxGen/tests/life.hs +++ /dev/null @@ -1,360 +0,0 @@ --------------------------------- --- 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/compiler/ilxGen/tests/reduce.ml b/compiler/ilxGen/tests/reduce.ml deleted file mode 100644 index cad379b522..0000000000 --- a/compiler/ilxGen/tests/reduce.ml +++ /dev/null @@ -1,101 +0,0 @@ - - -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/compiler/ilxGen/tests/test1-nostdlib.hs b/compiler/ilxGen/tests/test1-nostdlib.hs deleted file mode 100644 index 1e9053ea41..0000000000 --- a/compiler/ilxGen/tests/test1-nostdlib.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Test1_nostdlib where -foreign import "ilxHello" unsafe ilxHello :: () - -ilx_main_no_stdlib = ilxHello diff --git a/compiler/ilxGen/tests/test1.hs b/compiler/ilxGen/tests/test1.hs deleted file mode 100644 index 10f307e08e..0000000000 --- a/compiler/ilxGen/tests/test1.hs +++ /dev/null @@ -1 +0,0 @@ -main = putStr "HELLO HELLO Hello world WORLD WORLD.\n" diff --git a/compiler/ilxGen/tests/test10.hs b/compiler/ilxGen/tests/test10.hs deleted file mode 100644 index 46c384d9e0..0000000000 --- a/compiler/ilxGen/tests/test10.hs +++ /dev/null @@ -1,45 +0,0 @@ - -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/compiler/ilxGen/tests/test11.hs b/compiler/ilxGen/tests/test11.hs deleted file mode 100644 index ce53f71389..0000000000 --- a/compiler/ilxGen/tests/test11.hs +++ /dev/null @@ -1,61 +0,0 @@ -{-# 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/compiler/ilxGen/tests/test12.hs b/compiler/ilxGen/tests/test12.hs deleted file mode 100644 index 216c792f32..0000000000 --- a/compiler/ilxGen/tests/test12.hs +++ /dev/null @@ -1,44 +0,0 @@ -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/compiler/ilxGen/tests/test13.hs b/compiler/ilxGen/tests/test13.hs deleted file mode 100644 index 559c8674fa..0000000000 --- a/compiler/ilxGen/tests/test13.hs +++ /dev/null @@ -1,20 +0,0 @@ -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/compiler/ilxGen/tests/test14.hs b/compiler/ilxGen/tests/test14.hs deleted file mode 100644 index 86b5d1c821..0000000000 --- a/compiler/ilxGen/tests/test14.hs +++ /dev/null @@ -1,11 +0,0 @@ -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/compiler/ilxGen/tests/test15.hs b/compiler/ilxGen/tests/test15.hs deleted file mode 100644 index 3e522d757c..0000000000 --- a/compiler/ilxGen/tests/test15.hs +++ /dev/null @@ -1,18 +0,0 @@ - -{-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-} - - -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/compiler/ilxGen/tests/test16.hs b/compiler/ilxGen/tests/test16.hs deleted file mode 100644 index 0e8b9974a9..0000000000 --- a/compiler/ilxGen/tests/test16.hs +++ /dev/null @@ -1,5 +0,0 @@ - - -data MMaybe a = No | Yes a - -main = putStr "hello world\n"
\ No newline at end of file diff --git a/compiler/ilxGen/tests/test17.hs b/compiler/ilxGen/tests/test17.hs deleted file mode 100644 index 5e551b2dcd..0000000000 --- a/compiler/ilxGen/tests/test17.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# 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/compiler/ilxGen/tests/test18.hs b/compiler/ilxGen/tests/test18.hs deleted file mode 100644 index 12ca7413f1..0000000000 --- a/compiler/ilxGen/tests/test18.hs +++ /dev/null @@ -1,129 +0,0 @@ -{-# 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/compiler/ilxGen/tests/test19.hs b/compiler/ilxGen/tests/test19.hs deleted file mode 100644 index a292599031..0000000000 --- a/compiler/ilxGen/tests/test19.hs +++ /dev/null @@ -1,37 +0,0 @@ - -{-# 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/compiler/ilxGen/tests/test1b.hs b/compiler/ilxGen/tests/test1b.hs deleted file mode 100644 index c4b2336df1..0000000000 --- a/compiler/ilxGen/tests/test1b.hs +++ /dev/null @@ -1,104 +0,0 @@ --- 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/compiler/ilxGen/tests/test2.hs b/compiler/ilxGen/tests/test2.hs deleted file mode 100644 index 8b1f5b5eb6..0000000000 --- a/compiler/ilxGen/tests/test2.hs +++ /dev/null @@ -1,88 +0,0 @@ --- 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 n10 -bign1 = add bign n1 - -main = putStr (chooseN bign1) - - diff --git a/compiler/ilxGen/tests/test20.hs b/compiler/ilxGen/tests/test20.hs deleted file mode 100644 index 157a16da1d..0000000000 --- a/compiler/ilxGen/tests/test20.hs +++ /dev/null @@ -1,9 +0,0 @@ - -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/compiler/ilxGen/tests/test21.hs b/compiler/ilxGen/tests/test21.hs deleted file mode 100644 index 1870f22b97..0000000000 --- a/compiler/ilxGen/tests/test21.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# 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/compiler/ilxGen/tests/test2b.hs b/compiler/ilxGen/tests/test2b.hs deleted file mode 100644 index 08a391f799..0000000000 --- a/compiler/ilxGen/tests/test2b.hs +++ /dev/null @@ -1,2 +0,0 @@ -foreign import "ilxHello" unsafe ilxHello :: IO () -main = ilxHello diff --git a/compiler/ilxGen/tests/test2c.hs b/compiler/ilxGen/tests/test2c.hs deleted file mode 100644 index d01df051f8..0000000000 --- a/compiler/ilxGen/tests/test2c.hs +++ /dev/null @@ -1,14 +0,0 @@ -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/compiler/ilxGen/tests/test2d.hs b/compiler/ilxGen/tests/test2d.hs deleted file mode 100644 index 8126127a32..0000000000 --- a/compiler/ilxGen/tests/test2d.hs +++ /dev/null @@ -1,7 +0,0 @@ -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/compiler/ilxGen/tests/test3.hs b/compiler/ilxGen/tests/test3.hs deleted file mode 100644 index 0254ee41c4..0000000000 --- a/compiler/ilxGen/tests/test3.hs +++ /dev/null @@ -1,24 +0,0 @@ -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/compiler/ilxGen/tests/test4.hs b/compiler/ilxGen/tests/test4.hs deleted file mode 100644 index 080c6521e3..0000000000 --- a/compiler/ilxGen/tests/test4.hs +++ /dev/null @@ -1,47 +0,0 @@ -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/compiler/ilxGen/tests/test5.hs b/compiler/ilxGen/tests/test5.hs deleted file mode 100644 index 13d6028c02..0000000000 --- a/compiler/ilxGen/tests/test5.hs +++ /dev/null @@ -1,5 +0,0 @@ -data One a = One a - -choose (One x) = x -main = putStr (choose (One "hello world\n")) - diff --git a/compiler/ilxGen/tests/test6.hs b/compiler/ilxGen/tests/test6.hs deleted file mode 100644 index 17e51ab51d..0000000000 --- a/compiler/ilxGen/tests/test6.hs +++ /dev/null @@ -1,8 +0,0 @@ -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/compiler/ilxGen/tests/test7.hs b/compiler/ilxGen/tests/test7.hs deleted file mode 100644 index c146038052..0000000000 --- a/compiler/ilxGen/tests/test7.hs +++ /dev/null @@ -1,8 +0,0 @@ -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/compiler/ilxGen/tests/test8.hs b/compiler/ilxGen/tests/test8.hs deleted file mode 100644 index 94a7e1f83d..0000000000 --- a/compiler/ilxGen/tests/test8.hs +++ /dev/null @@ -1,8 +0,0 @@ -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/compiler/ilxGen/tests/test9.hs b/compiler/ilxGen/tests/test9.hs deleted file mode 100644 index 311b65c4e1..0000000000 --- a/compiler/ilxGen/tests/test9.hs +++ /dev/null @@ -1,10 +0,0 @@ -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/compiler/ilxGen/tests/yes.hs b/compiler/ilxGen/tests/yes.hs deleted file mode 100644 index 1dc4f085fd..0000000000 --- a/compiler/ilxGen/tests/yes.hs +++ /dev/null @@ -1,5 +0,0 @@ - -foreign import "ilxHello" unsafe ilxHello :: IO () - -main :: IO () -main = ilxHello >> main
\ No newline at end of file diff --git a/compiler/ilxGen/tests/yes2.hs b/compiler/ilxGen/tests/yes2.hs deleted file mode 100644 index 7fa20c5b7d..0000000000 --- a/compiler/ilxGen/tests/yes2.hs +++ /dev/null @@ -1,18 +0,0 @@ - -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 () - |