[project @ 1996-11-26 15:44:35 by dnt]
authordnt <unknown>
Tue, 26 Nov 1996 15:45:25 +0000 (15:45 +0000)
committerdnt <unknown>
Tue, 26 Nov 1996 15:45:25 +0000 (15:45 +0000)
Merged in changes from new-build-system branch

19 files changed:
GHC_ONLY/bugs/sanders_array/Main-ORIG.hs [deleted file]
GHC_ONLY/cg015/Main2.hs [deleted file]
GHC_ONLY/cg015/Main3.hs [deleted file]
GHC_ONLY/cg015/Main4.hs [deleted file]
Jmakefile [deleted file]
Makefile [new file with mode: 0644]
imaginary/primes/Main2.hs [deleted file]
mk/nofib.mk [new file with mode: 0644]
mk/site.mk [new file with mode: 0644]
real/Makefile [new file with mode: 0644]
real/anna/Main.hs
real/anna/Makefile [new file with mode: 0644]
real/bspt/Makefile [new file with mode: 0644]
real/fulsom/Fulsom.hi [deleted file]
real/parser/Main-GHC.hs [deleted file]
real/reptile/Main-ALT.hs [deleted file]
spectral/compreals/makefile [deleted file]
spectral/hartel/fft/Main2.hs [deleted file]
spectral/hartel/wave4main/Main2.hs [deleted file]

diff --git a/GHC_ONLY/bugs/sanders_array/Main-ORIG.hs b/GHC_ONLY/bugs/sanders_array/Main-ORIG.hs
deleted file mode 100644 (file)
index 3af098f..0000000
+++ /dev/null
@@ -1,47 +0,0 @@
-{-
-From: Paul Sanders <psanders@srd.bt.co.uk>
-To: partain
-Subject: A puzzle for you
-Date: Mon, 28 Oct 91 17:02:19 GMT
-
-I'm struggling with the following code fragment at the moment:
--}
-
-conv_list :: [a] -> [b] -> [[c]] -> Array (a,b) c -> Array (a,b) c
-conv_list [] _ _ ar = ar
-conv_list _ _ [] ar = ar
-conv_list (r:rs) cls (rt:rts) ar
-      = conv_list rs cls rts ar'
-        where ar' = conv_elems r cls rt ar
-
-conv_elems :: a -> [b] -> [c] -> Array (a,b) c -> Array (a,b) c
-conv_elems row [] _ ar = ar
-conv_elems _ _ [] ar = ar
-conv_elems row (col:cls) (rt:rts) ar
-      = conv_elems row cls rts ar'
-        where ar' = ar // ((row,col) := rt)
-
-ar_list = [[1,2,3],
-           [6,7,8],
-           [10,12,15]]
-
-ar :: Array (Int, Int) Int
-ar = conv_list [1..3] [1..3] ar_list init_ar
-     where init_ar = array ((1,1),(3,3)) []
-
-main = appendChan stdout (show ar) abort done
-
-{-
-What it tries to do is turn a list of lists into a 2-d array in an incremental
-fashion using 2 nested for-loops. It compiles okay on the prototype compiler
-but gives a segmentation fault when it executes. I know I can define in the
-array in one go (and I have done) but, for my piece of mind, I want to get this
-way working properly.
-
-Is it a bug in the prototype or is there a glaringly obvious error in my code
-which I've been stupid to spot ????
-
-Hoping its the latter,
-
-Paul.
--}
diff --git a/GHC_ONLY/cg015/Main2.hs b/GHC_ONLY/cg015/Main2.hs
deleted file mode 100644 (file)
index 470d68a..0000000
+++ /dev/null
@@ -1,25 +0,0 @@
-import GlasgowIOMonad
-import GlasgowIO
-
-data CList = CNil | CCons Int CList
-
-mk :: Int -> CList
-mk n = if (n == 0) then
-        CNil
-       else
-                CCons 1 (mk (n - 1))
-
-clen :: CList -> Int
-clen CNil = 0
-clen (CCons _ cl) = 1 + (clen cl)
-
-main = case (clen list4) of
-       len4 ->
-         case (len4 `plusInt` len4) of
-           8 -> finish 65#     -- 'A'
-           _ -> finish 66#     -- 'B'
-      where
-      list4    = mk 4
-
-finish :: IntPrim -> IO ()
-finish n = ccall putchar n `thenIOPrim_` returnIO ()
diff --git a/GHC_ONLY/cg015/Main3.hs b/GHC_ONLY/cg015/Main3.hs
deleted file mode 100644 (file)
index 06d89b2..0000000
+++ /dev/null
@@ -1,18 +0,0 @@
-import GlasgowIOMonad
-import GlasgowIO
-
-main =  if foo == (1::Int) then
-           finish 65#  -- 'A'
-       else
-           finish 66#  -- 'B'
-     where
-       foo = f (f 3)
-
-       f = if ((3::Int) > (4::Int)) then inc else dec
-
-       inc, dec :: Int -> Int
-       inc x = x+1
-       dec x = x-1
-
-finish :: IntPrim -> IO ()
-finish n = ccall putchar n `thenIOPrim_` returnIO ()
diff --git a/GHC_ONLY/cg015/Main4.hs b/GHC_ONLY/cg015/Main4.hs
deleted file mode 100644 (file)
index c144bdd..0000000
+++ /dev/null
@@ -1,17 +0,0 @@
-import GlasgowIOMonad
-import GlasgowIO
-
-main =  if foo == (16::Int) then
-           finish 65#  -- 'A'
-       else
-           finish 66#  -- 'B'
-     where
-       foo = twice twice twice inc 0
-
-       twice f x = f (f x)
-
-       inc :: Int -> Int
-       inc x = x+1
-
-finish :: IntPrim -> IO ()
-finish n = ccall putchar n `thenIOPrim_` returnIO ()
diff --git a/Jmakefile b/Jmakefile
deleted file mode 100644 (file)
index 11fc941..0000000
--- a/Jmakefile
+++ /dev/null
@@ -1,51 +0,0 @@
-#define IHaveSubdirs
-
-#if IncludeRealNoFibTests == YES
-#define _RealTests real
-#else
-#define _RealTests /*none*/
-#endif
-
-#if IncludeSpectralNoFibTests == YES
-#define _SpectralTests spectral
-#else
-#define _SpectralTests /*none*/
-#endif
-
-#if IncludeImaginaryNoFibTests == YES
-#define _ImaginaryTests imaginary
-#else
-#define _ImaginaryTests /*none*/
-#endif
-
-#if IncludePENDINGNoFibTests == YES
-#define _PENDINGTests PENDING
-#else
-#define _PENDINGTests /*none*/
-#endif
-
-#if IncludeUNUSEDNoFibTests == YES
-#define _UNUSEDTests UNUSED
-#else
-#define _UNUSEDTests /*none*/
-#endif
-
-#if IncludeGHC_ONLYNoFibTests == YES
-#define _GHC_ONLYTests  GHC_ONLY
-#else
-#define _GHC_ONLYTests /*none*/
-#endif
-
-#if IncludePRIVATENoFibTests == YES
-#define _PRIVATETests  PRIVATE
-#else
-#define _PRIVATETests /*none*/
-#endif
-
-#if IncludeParallelNoFibTests == YES
-#define _ParallelTests  parallel
-#else
-#define _ParallelTests /*none*/
-#endif
-
-SUBDIRS = _GHC_ONLYTests _PRIVATETests _ParallelTests _PENDINGTests _UNUSEDTests _ImaginaryTests _SpectralTests _RealTests
diff --git a/Makefile b/Makefile
new file mode 100644 (file)
index 0000000..1257885
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,39 @@
+# $Id: Makefile,v 1.2 1996/11/26 15:44:36 dnt Exp $
+
+TOP = ..
+
+SUBDIRS =
+
+ifeq ($(IncludeImaginaryNoFibTests), YES)
+  SUBDIRS += imaginary
+endif
+
+ifeq ($(IncludeSpectralNoFibTests), YES)
+  SUBDIRS += spectral
+endif
+
+ifeq ($(IncludeRealNoFibTests), YES)
+  SUBDIRS += real
+endif
+
+ifeq ($(IncludePENDINGNoFibTests), YES)
+  SUBDIRS += PENDING
+endif
+
+ifeq ($(IncludeUNUSEDNoFibTests), YES)
+  SUBDIRS += UNUSED
+endif
+
+ifeq ($(IncludeGHC_ONLYNoFibTests), YES)
+  SUBDIRS += GHC_ONLY
+endif
+
+ifeq ($(IncludePRIVATENoFibTests), YES)
+  SUBDIRS += PRIVATE
+endif
+
+ifeq ($(IncludeParallelNoFibTests), YES)
+  SUBDIRS += parallel
+endif
+
+include $(TOP)/nofib/mk/nofib.mk
diff --git a/imaginary/primes/Main2.hs b/imaginary/primes/Main2.hs
deleted file mode 100644 (file)
index dbd37f2..0000000
+++ /dev/null
@@ -1,15 +0,0 @@
-succ :: Int -> Int
-succ x = x + 1
-
-isdivs :: Int  -> Int -> Bool
-isdivs n x = mod x n /= 0
-
-the_filter :: [Int] -> [Int]
-the_filter (n:ns) = filter (isdivs n) ns
-
-main = let 
-        primes :: [Int]
-        primes = map head (iterate the_filter (iterate succ 2))
-       in
-       print (primes !! 1500)
---OLD: main = print (take 300 primes)
diff --git a/mk/nofib.mk b/mk/nofib.mk
new file mode 100644 (file)
index 0000000..647e9c4
--- /dev/null
@@ -0,0 +1,116 @@
+
+include $(TOP)/nofib/mk/site.mk
+
+#-----------------------------------------------------------------------------
+# General utilities
+
+SHELL  = /bin/sh
+RM     = rm -f
+TIME   = time
+STRIP  = strip
+SIZE   = size
+
+#-----------------------------------------------------------------------------
+# Haskell utilities
+
+ifdef UseInstalledUtils
+  RUNSTDTEST = runstdtest
+else
+  RUNSTDTEST = $(TOP)/glafp-utils/runstdtest/runstdtest
+endif
+
+#-----------------------------------------------------------------------------
+# The 'all' target prints out the corrent configuration and builds runtests.
+
+all ::
+       @echo HC = $(HC)
+       @echo HCFLAGS = $(HCFLAGS)
+       @echo RUNTESTFLAGS = $(RUNTESTFLAGS)
+
+print_% ::
+       @echo HCFLAGS_$* = $(HCFLAGS_$*)
+
+all :: $(foreach way,$(WAYS),print_$(way)) runtests
+
+#-----------------------------------------------------------------------------
+# Subdirs stuff.
+
+ifdef SUBDIRS
+  clean::
+       @case '${MFLAGS}' in *[ik]*) set +e;; esac; \
+       for i in $(SUBDIRS) ; do \
+         $(MAKE) -C $$i $(MFLAGS) clean; \
+       done
+  veryclean::
+       @case '${MFLAGS}' in *[ik]*) set +e;; esac; \
+       for i in $(SUBDIRS) ; do \
+         $(MAKE) -C $$i $(MFLAGS) veryclean; \
+       done
+  runtests::
+       @case '${MFLAGS}' in *[ik]*) set +e;; esac; \
+       for i in $(SUBDIRS) ; do \
+         $(MAKE) -C $$i $(MFLAGS) runtests; \
+       done
+endif
+
+#-----------------------------------------------------------------------------
+# Cleaning things.
+
+clean ::
+       $(RM) *.CKP *.ln *.BAK *.bak *.o core a.out ,* *.a .emacs_* *.hi
+       $(RM) tags TAGS *.ind *.ilg *.idx *.idx-prev *.aux *.aux-prev *.dvi
+       $(RM) *.log *.toc *.lot *.lof *.blg *.info *.itxi *.itex *.cb errs
+
+veryclean ::
+       $(RM) .??*~ *~ *.orig *.rej
+
+#-----------------------------------------------------------------------------
+# Nofib program targets.
+
+ifdef PROG
+
+ifndef SRCS
+  SRCS = Main.hs
+endif
+
+OBJS = $(patsubst %.lhs, %.o, $(patsubst %.hs, %.o, $(SRCS)))
+
+define COMPILE
+       @echo === compiling $(PROG)/$@ $(EXTRA_HCFLAGS) ===
+       @$(TIME) $(HC) $(HCFLAGS) $(EXTRA_HCFLAGS)  -o $@ -c $< \
+         $(HCFLAGS_$(patsubst .%,%,$(suffix $(basename $@))))
+       @echo === size of $(PROG)/$@ ===
+       @$(SIZE) $@
+endef
+
+%.normal.o %.mc.o %.mr.o %.mt.o %.mp.o %.mg.o %.2s.o %.1s.o %.du.o \
+%.a.o %.b.o %.c.o %.d.o %.e.o %.f.o %.g.o %.h.o %.i.o %.j.o %.k.o \
+%.l.o %.m.o %.n.o %.o.o %.p.o %.A.o %.B.o : %.hs
+       $(COMPILE)
+
+%.normal.o %.mc.o %.mr.o %.mt.o %.mp.o %.mg.o %.2s.o %.1s.o %.du.o \
+%.a.o %.b.o %.c.o %.d.o %.e.o %.f.o %.g.o %.h.o %.i.o %.j.o %.k.o \
+%.l.o %.m.o %.n.o %.o.o %.p.o %.A.o %.B.o : %.lhs
+       $(COMPILE)
+
+$(PROG)_% : $(OBJS:.o=.%.o)
+       @echo === linking $@ $(EXTRA_HCFLAGS) ===
+       @$(TIME) $(HC) $(HCFLAGS) $(EXTRA_HCFLAGS) -o $@ $^ $(LIBS)
+       @$(STRIP) $@
+       @echo === size of $@ ===
+       @$(SIZE) $@
+
+runtest_% : $(PROG)_%
+       @echo === running $< $(EXTRA_RUNTESTFLAGS) ===
+       @$(TIME) $(RUNSTDTEST) ./$< \
+         $(addprefix -i ,$(wildcard $(PROG).stdin)) \
+         $(addprefix -o1 ,$(wildcard $(PROG).stdout)) \
+         $(addprefix -o2 ,$(wildcard $(PROG).stderr)) \
+         $(RUNTESTFLAGS) $(EXTRA_RUNTESTFLAGS)
+
+runtests :: $(foreach way,$(WAYS),$(PROG)_$(way) runtest_$(way))
+
+clean ::
+       $(RM) $(foreach way,$(WAYS),$(PROG)_$(way))
+
+endif
diff --git a/mk/site.mk b/mk/site.mk
new file mode 100644 (file)
index 0000000..8e48bc1
--- /dev/null
@@ -0,0 +1,63 @@
+#-----------------------------------------------------------------------------
+# $Id: site.mk,v 1.2 1996/11/26 15:44:59 dnt Exp $
+
+#-----------------------------------------------------------------------------
+# Haskell compiler
+
+#HC = $(TOP)/ghc/driver/ghc
+HC = ghc-2.01
+HCFLAGS = -H32m -K2m
+
+#-----------------------------------------------------------------------------
+# Flags to use when we run a test
+
+RUNTESTFLAGS = +RTS -H48m -K32m --RTS
+
+#-----------------------------------------------------------------------------
+# Set WAYS according to which ways you want to build the nofib suite
+
+WAYS = normal
+
+#WAYS = normal mc mr mt mp mg 2s 1s du p t a b c d e f g h i j k l m n o p A B
+
+# ================================================================
+# BUILDS stuff: main sequential ones
+
+HCFLAGS_normal =
+HCFLAGS_p      = -prof
+HCFLAGS_t      =
+HCFLAGS_u      =
+
+# === builds: concurrent and parallel ============================
+
+HCFLAGS_mc =
+HCFLAGS_mr =
+HCFLAGS_mt =
+HCFLAGS_mp =
+HCFLAGS_mg =
+
+# === builds: non-std garbage collectors ==========================
+
+HCFLAGS_2s = -gc-2s
+HCFLAGS_1s = -gc-1s
+HCFLAGS_du = -gc-du
+
+# === builds: "user ways" =======================================
+
+HCFLAGS_a =
+HCFLAGS_b =
+HCFLAGS_c =
+HCFLAGS_d =
+HCFLAGS_e =
+HCFLAGS_f =
+HCFLAGS_g =
+HCFLAGS_h =
+HCFLAGS_i =
+HCFLAGS_j =
+HCFLAGS_k =
+HCFLAGS_l =
+HCFLAGS_m =
+HCFLAGS_n =
+HCFLAGS_o =
+HCFLAGS_A =
+HCFLAGS_B =
diff --git a/real/Makefile b/real/Makefile
new file mode 100644 (file)
index 0000000..94cd7a4
--- /dev/null
@@ -0,0 +1,7 @@
+TOP = ../..
+
+SUBDIRS = anna bspt compress compress2 ebnf2ps fluid fulsom gamteb gg \
+  grep hidden HMMS hpg infer lift maillist mkhprog parser pic prolog \
+  reptile rsa symalg veritas
+
+include $(TOP)/nofib/mk/nofib.mk
index b5267d0..f331f32 100644 (file)
@@ -149,29 +149,6 @@ maStrictAn table flagsInit fileName
          fullEnvAug = fullEnv ++ map2nd deScheme maBaseTypes
          deScheme (Scheme _ texpr) = texpr
 
-{-
---==========================================================--
---
-anna :: [Flag] -> String -> Dialogue
-
-anna flags name
-   = getEnv "ANNADIR"             noANNADIR           (\anna_dir  ->
-     readFile (anna_dir++"/anna_table") noTable             (\tablestr ->
-     let table = rtReadTable tablestr in
-     readFile (name++".cor")      noFile              (\str      ->
-     let result = maStrictAn table flags str in
-     appendChan stdout result     writeFails          done)))
-     where
-        noANNADIR  err            = abandon "ANNADIR not defined"
-        noTable    err            = abandon "Cannot find $ANNADIR/table"
-        noFile     err            = abandon ("Can't open "++name++".cor")
-        writeFails (WriteError s) = abandon s
-        abandon s                 = appendChan stdout s abort done
-        getEnv envvar fail succ   = succ "/home/r62/users/sewardj/Bin"
-        twords n = "\nRead " ++ show n ++ " lattice sizes.\n"
--}
-
-
 --==========================================================--
 --
 --main :: [Response] -> [Request]
@@ -182,47 +159,11 @@ main = do
     raw_args <- getArgs
     let cmd_line_args = maGetFlags raw_args
     anna_dir <- getEnv "ANNADIR"
-    tableStr <- readFile (anna_dir++"/anna_table")
+    tableStr <- readFile (anna_dir ++ "/anna_table")
     file_contents <- getContents
     let table = rtReadTable tableStr
     putStr (maStrictAn table cmd_line_args file_contents)
 
-{- OLD 1.2
-main resps
-   = [
-      GetArgs,
-      fr 0 (GetEnv "ANNADIR"),
-      fr 1 (ReadFile ),
-      fr 2 (ReadChan stdin),
-      fr 3 (AppendChan stdout )
-     ] ++ fr 4 [] (maStrictAn table cmd_line_args file_contents)
-     where
-        cmd_line_args = case (resps ## 0) of
-           StrList ss -> maGetFlags ss
-           _          -> panic "GetArgs request failed"
-
-        anna_dir = case (mySeq cmd_line_args (resps ## 1)) of
-           Str s -> s
-           _     -> myFail "Environment variable \"ANNADIR\" is not set."
-
-        tableStr = case (mySeq anna_dir (resps ## 2)) of
-           Str s -> s
-           _     -> myFail ("Can't read " ++ anna_dir ++ "/anna_table")
-
-        file_contents = case (mySeq (head tableStr) (resps ## 3)) of
-           Str s -> s
-           _     -> panic "ReadChan request failed"
-
-        --append_res = case (mySeq (head file_contents) (resps ## 4)) of
-        --   Success -> (42 :: Int)
-        --   _       -> panic "AppendChan request failed"
-
-        fr n x = case resps ## n of
-                    Success -> x
-                    _       -> x
-
-        table = rtReadTable tableStr
--}
 
 --==========================================================--
 --
diff --git a/real/anna/Makefile b/real/anna/Makefile
new file mode 100644 (file)
index 0000000..5d7aa5f
--- /dev/null
@@ -0,0 +1,17 @@
+TOP = ../../..
+PROG = anna
+SRCS = BaseDefs.hs MyUtils.hs Utils.hs AbstractVals2.hs \
+       SuccsAndPreds2.hs AbstractMisc.hs Dependancy.hs \
+       MakeDomains.hs  Parser2.hs  PrettyPrint.hs  LambdaLift5.hs  \
+       TypeCheck5.hs EtaAbstract.hs  DomainExpr.hs AbsConc3.hs Apply.hs \
+       Inverse.hs BarakiMeet.hs BarakiConc3.hs \
+       Constructors.hs TExpr2DExpr.hs AbstractEval2.hs \
+       PrintResults.hs Simplify.hs SmallerLattice.hs \
+       FrontierMisc2.hs FrontierDATAFN2.hs FrontierGENERIC2.hs \
+       StrictAn6.hs ReadTable.hs Main.hs
+
+EXTRA_RUNTESTFLAGS = \
+  -prescript ./anna.prescript -postscript ./anna.postscript \
+  -i big.cor -o1 big.sum.out
+
+include $(TOP)/nofib/mk/nofib.mk
diff --git a/real/bspt/Makefile b/real/bspt/Makefile
new file mode 100644 (file)
index 0000000..4327796
--- /dev/null
@@ -0,0 +1,9 @@
+TOP = ../../..
+PROG = bspt
+
+SRCS = BSPT.lhs Euclid.lhs EuclidGMS.lhs GeomNum.lhs Init.lhs \
+       Input.lhs Interface.lhs Interpret.lhs Libfuns.lhs MGRlib.lhs \
+       Main.lhs Merge.lhs Params.lhs Prog.lhs Rationals.lhs \
+       Render.lhs Stdlib.lhs
+
+include $(TOP)/nofib/mk/nofib.mk
diff --git a/real/fulsom/Fulsom.hi b/real/fulsom/Fulsom.hi
deleted file mode 100644 (file)
index fbccfbd..0000000
+++ /dev/null
@@ -1,4 +0,0 @@
-interface Fulsom where {
-{-# IMPORTING Shapes, Quad, Raster, Oct, Interval, Types #-}
-main :: Dialogue   {-# ARITY main = 1 #-}{-# STRICTNESS main = "T,T" ST #-}
-}
diff --git a/real/parser/Main-GHC.hs b/real/parser/Main-GHC.hs
deleted file mode 100644 (file)
index 4dc53d2..0000000
+++ /dev/null
@@ -1,1452 +0,0 @@
-
---==========================================================--
---=== Raw lexical analysis (tokenisation) of source      ===--
---===                                           Lexer.hs ===--
---==========================================================--
-
-module Main where
-
-----------------------------------------------------------
--- Lexemes                                              --
-----------------------------------------------------------
-
-type Token = (Int, Int, Lex, String) -- (line, column, lexeme type, value)
-
-data Lex = Lcon             -- constructor used as prefix:
-                            -- normal prefix constructor,
-                            -- or bracketed infix constructor
-
-         | Lconop           -- constructor used as infix:
-                            -- normal prefix constructor in backquotes,
-                            -- or infix constructor (starting with ":")
-
-         | Lvar             -- variable used as prefix:
-                            -- normal prefix variable,
-                            -- or bracketed infix var (operator)
-
-         | Lvarop           -- variable used as infix:
-                            -- normal prefix variable in backquotes,
-                            -- or infix variable (operator)
-
-         --| Ltycon           -- constructor starting with A-Z
-                              -- subcase of Lcon
-
-         --| Ltyvar           -- variable starting with a-z
-                              -- subcase of Lvar
-
-         | Lintlit          -- integer literal
-         | Lcharlit         -- character literal
-         | Lstringlit       -- string literal
-
-         | Llbrace          --  {
-         | Lrbrace          --  }
-         | Lsemi            --  ;
-         | Lequals          --  =
-         | Lbar             --  |
-         | Larrow           --  ->
-         | Llparen          --  (
-         | Lrparen          --  )
-         | Lcomma           --  ,
-         | Llbrack          --  [
-         | Lrbrack          --  ]
-         | Lunder           --  _
-         | Lminus           --  -
-         | Lslash           --  \
-
-         | Lmodule
-         | Linfixl
-         | Linfixr
-         | Linfix
-         | Lext
-         | Ldata
-         | Lif
-         | Lthen
-         | Lelse
-         | Llet
-         | Lin
-         | Lcase
-         | Lof
-         | Lwhere
-
-         | Leof
-#ifndef __GLASGOW_HASKELL__
-        deriving (Eq, Text)
-#else
-instance Eq Lex where
-    a == b = tag_Lex a == tag_Lex b
-     where
-       tag_Lex Lcon = (1::Int)
-       tag_Lex Lconop = 2
-       tag_Lex Lvar = 3
-       tag_Lex Lvarop = 4
-       tag_Lex Lintlit = 5
-       tag_Lex Lcharlit = 6
-       tag_Lex Lstringlit = 7
-       tag_Lex Llbrace = 8
-       tag_Lex Lrbrace = 9
-       tag_Lex Lsemi = 10 
-       tag_Lex Lequals = 11
-       tag_Lex Lbar = 12
-       tag_Lex Larrow = 13
-       tag_Lex Llparen = 14
-       tag_Lex Lrparen = 15
-       tag_Lex Lcomma = 16
-       tag_Lex Llbrack = 17
-       tag_Lex Lrbrack = 18
-       tag_Lex Lunder =19
-       tag_Lex Lminus = 20
-       tag_Lex Lslash = 21
-       tag_Lex Lmodule = 22
-       tag_Lex Linfixl = 23
-       tag_Lex Linfixr = 24
-       tag_Lex Linfix = 25
-       tag_Lex Lext = 26
-       tag_Lex Ldata =27
-       tag_Lex Lif = 28
-       tag_Lex Lthen = 29
-       tag_Lex Lelse = 30
-       tag_Lex Llet =31
-       tag_Lex Lin = 32
-       tag_Lex Lcase = 33
-       tag_Lex Lof = 34
-       tag_Lex Lwhere = 35
-       tag_Lex Leof = 36
-
-    (/=) = dEFAULT_ne
-#endif
-
-
-{- 
-   Lexing rules:
-
-   case (
-      if next is \,                                         -> Llparen
-      if next is symbol, take symbols and expect closing )  -> Lvar
-      if next is :, take tail-ident-chars, expect closing ) -> Lcon
-      otherwise                                             -> Llparen
-
-   case `
-      if next A-Z, take tail-ident-chars, expect `          -> Lconop
-      if next a-z, take tail-ident-chars, expect `          -> Lvarop
-      otherwise                                             -> error
-
-   case A-Z
-      take tail-ident-chars                                 -> Lcon
-
-   case a-z
-      take tail-ident-chars                                 -> Lvar
-
-   case 0-9
-      take 0-9s                                             -> Lintlit
-
-   case '
-      expect a lit-char, then '                             -> charlit
-
-   case "
-      expect lit-chars, then "                              -> stringlit
-
-   case {
-      case -                                                -> run_comment
-      otherwise                                             -> Llbrace
-
-   case }                                                   -> Lrbrace
-
-   case )                                                   -> Lrparen
-
-   case [                                                   -> Llbrack
-   case ]                                                   -> Lrbrack
-
-   case ;                                                   -> Lsemi
-   case ,                                                   -> Lcomma
-   case _                                                   -> Lunder
-   case -
-      case -                                                -> line_comment
-      case >                                                -> Larrow
-      otherwise                                             -> Lminus
-
-   case # in column 1: this is a preprocessor line
-
-   case :!#$%&*+./<=>?@\^|~
-      take symbols, then case resulting
-         "="                                                -> Lequals
-         "|"                                                -> Lbar
-         "\"                                                -> Lslash
-         otherwise
-            if starts with :                                -> Lconop
-            else                                            -> lvarop
--}
-
-
-
---==========================================================--
---
-leLex :: Int -> Int -> String -> [Token]
-
-leLex l n [] 
-   = repeat (99997, 99997, Leof, "")
-
-leLex l n ('(':[])
-   = [(l, n, Llparen, ")")]
-
-leLex l n ('(':c:cs)
-   | c == ':'
-   = case leChunk (n+1) leIsTailChar cs of
-        (restSym, nn, restInput) -> case restInput of
-           []        -> leFail l nn "  )  expected"
-           (')':as)  -> (l, n, Lvar, c:restSym) : leLex l (nn+1) as
-           (_:_)     -> leFail l nn "  )  expected"
-   | c == '\\'
-   = (l, n, Llparen, "(") : leLex l (n+1) (c:cs)
-   | leIsSymbol c
-   = case leChunk (n+1) leIsSymbol cs of
-        (restSym, nn, restInput) -> case restInput of
-           []        -> leFail l nn "  )  expected"
-           (')':as)  -> (l, n, Lvar, c:restSym) : leLex l (nn+1) as
-           (_:_)     -> leFail l nn "  )  expected"
-   | otherwise
-   = (l, n, Llparen, "(") : leLex l (n+1) (c:cs)
-
-leLex l n ('`':c:cs)
-   | isAlpha c
-   = case leChunk (n+1) isAlpha cs of
-        (restSym, nn, restInput) -> case restInput of
-           []        -> leFail l nn "  `  expected"
-           ('`':as)  -> (l, n, if isUpper c then Lconop else Lvarop, c:restSym) 
-                        : leLex l (nn+1) as
-           (_:_)     -> leFail l nn "  `  expected"
-   | otherwise
-   = leFail l n "Bad infix operator"
-
-leLex l n ('"':cs)
-   = case leTakeLitChars True l (n+1) cs of
-        (restSym, nn, restInput) -> case restInput of
-           []        -> leFail l nn "  \"  expected"
-           ('"':as)  -> (l, n, Lstringlit, restSym) : leLex l (nn+1) as
-           (_:_)     -> leFail l nn "  \"  expected"
-
-leLex l n ('\'':cs)
-   = case leTakeLitChars False l (n+1) cs of
-        (restSym, nn, restInput) -> case restInput of
-           []        -> leFail l nn "  '  expected"
-           ('\'':as) -> case restSym of
-                           [_] -> (l, n, Lcharlit, restSym) : leLex l (nn+1) as
-                           _   -> leFail l (n+1) "Bad character literal"
-           (_:_)     -> leFail l nn "  '  expected"
-
-leLex l n ('}':cs)
-   = (l, n, Lrbrace, "}") : leLex l (n+1) cs
-
-leLex l n (')':cs)
-   = (l, n, Lrparen, ")") : leLex l (n+1) cs
-
-leLex l n ('[':cs)
-   = (l, n, Llbrack, "[") : leLex l (n+1) cs
-
-leLex l n (']':cs)
-   = (l, n, Lrbrack, "]") : leLex l (n+1) cs
-
-leLex l n (';':cs)
-   = (l, n, Lsemi, ";") : leLex l (n+1) cs
-
-leLex l n (',':cs)
-   = (l, n, Lcomma, ",") : leLex l (n+1) cs
-
-leLex l n ('_':cs)
-   = (l, n, Lunder, "_") : leLex l (n+1) cs
-
-leLex l n ('{':cs)
-   = case cs of
-        []         -> [(l, n, Llbrace, "}")]
-        ('-':cs2)  -> leLexRComment l (n+2) cs2
-        (_:_)      -> (l, n, Llbrace, "}") : leLex l (n+1) cs
-
-leLex l n ('-':cs)
-   = case cs of
-        []         -> [(l, n, Lminus, "-")]
-        ('-':cs2)  -> leLexLComment l (n+2) cs2
-        ('>':cs3)  -> (l, n, Larrow, "->") : leLex l (n+2) cs3
-        ('}':cs3)  -> leFail l n "Misplaced -}"
-        (_:_)      -> (l, n, Lminus, "-") : leLex l (n+1) cs
-
-leLex l n (' ':cs) 
-   = leLex l (n+1) cs
-
-leLex l n ('\n':cs)
-   = leLex (l+1) 1 cs
-
-leLex l n ('\t':cs)
-   = leLex l (n - (n `mod` 8) + 9) cs
-
-leLex l n (c:cs)
-   = if   c == '#'
-     then if n == 1
-          then
-          {- This is a CPP line number thingy -}
-          let lineNoText  = takeWhile isDigit (tail cs)
-              lineNo      = leStringToInt lineNoText
-              nextLine    = drop 1 (dropWhile ((/=) '\n') cs)
-          in
-              leLex lineNo 1 nextLine
-          else
-          {- it's a symbol starting with # -}
-          case leChunk (n+1) leIsSymbol cs of
-             (restSym, nn, restText) -> (l, n, Lvarop, c:restSym) :
-                                        leLex l nn restText
-     else
-     if   isAlpha c
-     then case leChunk (n+1) leIsTailChar cs of
-             (restSym, nn, restText) -> (l, n, if   isUpper c 
-                                               then Lcon 
-                                               else Lvar, c:restSym) :
-                                        leLex l nn restText 
-     else
-     if   isDigit c
-     then case leChunk (n+1) isDigit cs of
-             (restSym, nn, restText) -> (l, n, Lintlit, c:restSym) :
-                                        leLex l nn restText 
-     else
-     if   leIsSymbol c
-     then case leChunk (n+1) leIsSymbol cs of
-             (restSym, nn, restText) -> (l, n, if   c == ':' 
-                                               then Lconop 
-                                               else Lvarop, c:restSym) :
-                                        leLex l nn restText 
-     else
-     leFail l n ("Illegal character  " ++ [c])
-
-
---==========================================================--
---
-leChunk :: Int -> (Char -> Bool) -> String -> (String, Int, String)
-
-leChunk n proper []    
-  = ([], n, [])
-
-leChunk n proper (c:cs)
-  | proper c           
-  = case leChunk (n+1) proper cs of
-       (restId, col, restInput) -> (c:restId, col, restInput)
-  | otherwise
-  = ([], n, c:cs)
-
-
---==========================================================--
---
-leTakeLitChars :: Bool -> Int -> Int -> String -> (String, Int, String)
-
-leTakeLitChars d l n []
-  = leFail l n "End of file inside literal"
-
-leTakeLitChars d l n ('\\':'\\':cs)
-  = case leTakeLitChars d l (n+2) cs of
-       (rest, col, left) -> ('\\':rest, col, left)
-
-leTakeLitChars d l n ('\\':'n':cs)
-  = case leTakeLitChars d l (n+2) cs of
-       (rest, col, left) -> ('\n':rest, col, left)
-
-leTakeLitChars d l n ('\\':'t':cs)
-  = case leTakeLitChars d l (n+2) cs of
-       (rest, col, left) -> ('\t':rest, col, left)
-
-leTakeLitChars d l n ('\\':'"':cs)
-  = case leTakeLitChars d l (n+2) cs of
-       (rest, col, left) -> ('"':rest, col, left)
-
-leTakeLitChars d l n ('\\':'\'':cs)
-  = case leTakeLitChars d l (n+2) cs of
-       (rest, col, left) -> ('\'':rest, col, left)
-
-leTakeLitChars d l n ('"':cs)
-  | d      = ([], n, ('"':cs))
-  | not d  = case leTakeLitChars d l (n+1) cs of
-                (rest, col, left) -> ('"':rest, col, left)
-
-leTakeLitChars d l n ('\'':cs)
-  | not d  = ([], n, ('\'':cs))
-  | d      = case leTakeLitChars d l (n+1) cs of
-                (rest, col, left) -> ('\'':rest, col, left)
-
-leTakeLitChars d l n ('\n':cs)
-  = leFail l n "Literal exceeds line"
-
-leTakeLitChars d l n ('\t':cs)
-  = leFail l n "Literal contains tab"
-
-leTakeLitChars d l n (c:cs)
-  = case leTakeLitChars d l (n+1) cs of
-       (rest, col, left) -> (c:rest, col, left)
-
-
---==========================================================--
---
-leLexLComment :: Int -> Int -> String -> [Token]
-
-leLexLComment l n cs
-   = leLex (l+1) 1 (drop 1 (dropWhile ((/=) '\n') cs))
-
-
---==========================================================--
---
-leLexRComment :: Int -> Int -> String -> [Token]
-
-leLexRComment l n [] 
-   = leFail l n "End of file inside {- ... -} comment"
-
-leLexRComment l n ('-':'}':cs)
-   = leLex l (n+2) cs
-
-leLexRComment l n ('\n':cs)
-   = leLexRComment (l+1) 1 cs
-
-leLexRComment l n ('\t':cs)
-   = leLexRComment l (n - (n `mod` 8) + 9) cs
-
-leLexRComment l n (c:cs)
-   = leLexRComment l (n+1) cs
-
-
---==========================================================--
---
-leIsSymbol :: Char -> Bool
-
-leIsSymbol c = c `elem` leSymbols
-
-leSymbols = ":!#$%&*+./<=>?\\@^|~"
-
-
---==========================================================--
---
-leIsTailChar :: Char -> Bool
-
-leIsTailChar c 
-   = isLower c || 
-     isUpper c || 
-     isDigit c || 
-     c == '\'' || 
-     c == '_'  ||
-     c == '\''
-
-
---==========================================================--
---
-leIsLitChar :: Char -> Bool
-
-leIsLitChar c
-   = c /= '\n' &&
-     c /= '\t' &&
-     c /= '\'' &&
-     c /= '"'
-
-
---==========================================================--
---
-leStringToInt :: String -> Int
-
-leStringToInt
-   = let s2i []      = 0
-         s2i (d:ds)  = (fromEnum d - fromEnum '0') + 10 *s2i ds
-     in s2i . reverse
-
-
---==========================================================--
---
-leFail l n m
-  = fail ("Lexical error, line " ++ show l ++ ", col " ++ show n ++ 
-          ":\n   " ++ m )
-
-fail m = error ( "\n\n" ++ m ++ "\n" )
-
---==========================================================--
---=== end                                       Lexer.hs ===--
---==========================================================--
-
---==========================================================--
---=== Keyword spotting, and offside rule implementation  ===--
---===                                          Layout.hs ===--
---==========================================================--
-
---module Layout
-
---==========================================================--
---
-laKeyword :: Token -> Token
-
-laKeyword (l, n, what, text) 
-   = let
-        f Lvarop "="      = Lequals
-        f Lvarop "|"      = Lbar
-        f Lvarop "\\"     = Lslash
-
-        f Lvar "module"   = Lmodule
-        f Lvar "infix"    = Linfix
-        f Lvar "infixl"   = Linfixl
-        f Lvar "infixr"   = Linfixr
-        f Lvar "ext"      = Lext
-        f Lvar "data"     = Ldata
-        f Lvar "if"       = Lif
-        f Lvar "then"     = Lthen
-        f Lvar "else"     = Lelse
-        f Lvar "let"      = Llet
-        f Lvar "in"       = Lin
-        f Lvar "case"     = Lcase
-        f Lvar "of"       = Lof
-        f Lvar "where"    = Lwhere
-
-        f item words      = item
-        
-     in
-         (l, n, f what text, text)
-
-
---==========================================================--
---
-laLayout :: Int -> [Int] -> [Token] -> [Token]
-
-laLayout l s []
-   = laRbrace (length s - 1) 99999 99999
-
-laLayout l s (t1:[])
-   = t1 : laRbrace (length s - 1) 99998 99998
-
-laLayout l (s:ss) (t1@(l1, n1, w1, c1) :
-                   t2@(l2, n2, w2, c2) : ts)
-
-   | w1 `elem` [Lof, Llet, Lwhere] && w2 /= Llbrace
-   = t1 :
-     (l1, n1, Llbrace, "{") :
-     t2 :
-     laLayout l2 (n2:s:ss) ts 
-
-   | l1 == l
-   = t1 :
-     laLayout l (s:ss) (t2:ts)
-
-   | n1 > s
-   = t1 :
-     laLayout l1 (s:ss) (t2:ts)
-
-   | n1 == s
-   = (l1, n1, Lsemi, ";") :
-     t1 :
-     laLayout l1 (s:ss) (t2:ts)
-
-   | n1 < s
-   = (l1, n1, Lrbrace, "}") :
-     laLayout l ss (t1:t2:ts)
-
-
---==========================================================--
---
-laRbrace c l n 
-   = take c (repeat (l, n, Lrbrace, "}"))
-
---==========================================================--
---
-laMain :: String -> [Token]
-
-laMain
-   = laLayout 1 [0] . map laKeyword . leLex 1 1
-
-
---==========================================================--
---=== end                                      Layout.hs ===--
---==========================================================--
-
---==========================================================--
---=== Abstract syntax for modules                        ===--
---===                                       AbsSyntax.hs ===--
---==========================================================--
-
---module AbsSyntax where
-
---1.3:data Maybe a = Nothing 
---             | Just a
-
-type AList a b = [(a, b)]
-
-type Id = String
-
-data Module 
-   = MkModule Id [TopDecl]
---             deriving (Text)
-
-data FixityDecl
-   = MkFixDecl Id (Fixity, Int)
---             deriving (Text)
-
-data DataDecl
-   = MkDataDecl Id ([Id], [ConstrAltDecl])
---             deriving (Text)
-
-data TopDecl
-   = MkTopF FixityDecl
-   | MkTopD DataDecl
-   | MkTopV ValBind
---             deriving (Text)
-
-data Fixity
-   = InfixL
-   | InfixR
-   | InfixN
-#ifndef __GLASGOW_HASKELL__
-             deriving (Eq,Text)
-#else
-instance Eq Fixity where
-    InfixL == InfixL = True
-    InfixR == InfixR = True
-    InfixN == InfixN = True
-    a == b = False
-
-    (/=) = dEFAULT_ne
-#endif
-
-
-type ConstrAltDecl
-   = (Id, [TypeExpr])
-
-data TypeExpr = TypeVar    Id
-              | TypeArr    TypeExpr TypeExpr
-              | TypeCon    Id [TypeExpr]
-              | TypeList   TypeExpr
-              | TypeTuple  [TypeExpr]
---             deriving (Text)
-
-data ValBind
-   = MkValBind Int Lhs Expr
---             deriving (Text)
-
-data Lhs
-   = LhsPat Pat
-   | LhsVar Id [Pat]
---             deriving (Text)
-
-data Pat 
-   = PatVar Id
-   | PatCon Id [Pat]
-   | PatWild
-   | PatList   [Pat]
-   | PatTuple  [Pat]
---             deriving (Text)
-
-data Expr
-   = ExprVar      Id
-   | ExprCon      Id
-   | ExprApp      Expr Expr
-   | ExprLam      [Pat] Expr
-   | ExprCase     Expr [ExprCaseAlt]
-   | ExprLetrec   [ValBind] Expr
-   | ExprWhere    Expr [ValBind]
-   | ExprGuards   [(Expr, Expr)]
-   | ExprLiteral  Literal
-   | ExprList     [Expr]
-   | ExprTuple    [Expr]
-   | ExprIf       Expr Expr Expr
-   | ExprBar
-   | ExprFail
---             deriving (Text)
-
-data ExprCaseAlt
-   = MkExprCaseAlt Pat Expr
---             deriving (Text)
-
-data Literal
-   = LiteralInt     Int
-   | LiteralChar    Char
-   | LiteralString  String
---             deriving (Text)
-
---==========================================================--
---=== end                                   AbsSyntax.hs ===--
---==========================================================--
-
---==========================================================--
---=== Parser generics                                    ===--
---===                                   ParserGeneric.hs ===--
---==========================================================--
-
---module ParserGeneric
-
-type PEnv = AList String (Fixity, Int)
-
-data PResult a = POk    PEnv [Token] a
-               | PFail  Token
-
-type Parser a = PEnv -> [Token] -> PResult a
-
-type PEntry = (Bool, Expr, Id)
-
---==========================================================--
---
-pgItem :: Lex -> Parser String
-
-pgItem x env [] = PFail pgEOF
-
-pgItem x env ((l, n, w, t):toks)
-   | x == w     = POk env toks t
-   | otherwise  = PFail (l, n, w, t)
-
-
---==========================================================--
---
-pgAlts :: [Parser a] -> Parser a
-
-pgAlts ps env toks
-   = let
-        useAlts [] bestErrTok 
-           = PFail bestErrTok
-        useAlts (p:ps) bestErrTok
-           = case p env toks of
-                PFail someErrTok -> useAlts ps (further someErrTok bestErrTok)
-                successful_parse -> successful_parse
-        further x1@(l1, n1, w1, t1) x2@(l2, n2, w2, t2)
-           =      if l2 > l1 then x2
-             else if l1 > l2 then x1
-             else if n1 > n2 then x1
-             else x2
-     in
-        useAlts ps (head (toks ++ [pgEOF])) 
-
-
---==========================================================--
---
-pgThen2 :: (a -> b -> c) -> 
-           Parser a -> 
-           Parser b -> 
-           Parser c
-
-pgThen2 combine p1 p2 env toks
-   = case p1 env toks of
-     {
-       PFail tok1 
-         -> PFail tok1 ;
-       POk env1 toks1 item1 
-         -> case p2 env1 toks1 of
-            {
-              PFail tok2 
-                -> PFail tok2 ;
-              POk env2 toks2 item2
-                -> POk env2 toks2 (combine item1 item2)
-            }
-     }
-
-
---==========================================================--
---
-pgThen3 :: (a -> b -> c -> d) -> 
-           Parser a -> 
-           Parser b -> 
-           Parser c -> 
-           Parser d
-
-pgThen3 combine p1 p2 p3 env toks
-   = case p1 env toks of
-     {
-       PFail tok1 
-         -> PFail tok1 ;
-       POk env1 toks1 item1 
-         -> case p2 env1 toks1 of
-            {
-              PFail tok2 
-                -> PFail tok2 ;
-              POk env2 toks2 item2
-                -> case p3 env2 toks2 of
-                   {
-                     PFail tok3
-                       -> PFail tok3 ;
-                     POk env3 toks3 item3
-                       -> POk env3 toks3 (combine item1 item2 item3)
-                   }
-            }
-     }
-
-
---==========================================================--
---
-pgThen4 :: (a -> b -> c -> d -> e) -> 
-           Parser a -> 
-           Parser b -> 
-           Parser c -> 
-           Parser d ->
-           Parser e
-
-pgThen4 combine p1 p2 p3 p4 env toks
-   = case p1 env toks of
-     {
-       PFail tok1 
-         -> PFail tok1 ;
-       POk env1 toks1 item1 
-         -> case p2 env1 toks1 of
-            {
-              PFail tok2 
-                -> PFail tok2 ;
-              POk env2 toks2 item2
-                -> case p3 env2 toks2 of
-                   {
-                     PFail tok3
-                       -> PFail tok3 ;
-                     POk env3 toks3 item3
-                       -> case p4 env3 toks3 of
-                          {
-                            PFail tok4 
-                              -> PFail tok4 ;
-                            POk env4 toks4 item4
-                              -> POk env4 toks4 (combine item1 item2 item3 item4)
-                          }
-                   }
-            }
-     }
-
-
---==========================================================--
---
-pgZeroOrMore :: Parser a -> Parser [a]
-
-pgZeroOrMore p env toks
-   = case p env toks of
-     {
-       PFail tok1 
-         -> POk env toks [] ;
-       POk env1 toks1 item1 
-         -> case pgZeroOrMore p env1 toks1 of
-            {
-              PFail tok2 
-                -> POk env1 toks1 [item1] ;
-              POk env2 toks2 item2_list
-                -> POk env2 toks2 (item1 : item2_list)
-            }
-     }
-         
-
---==========================================================--
---
-pgOneOrMore :: Parser a -> Parser [a]
-
-pgOneOrMore p
-   = pgThen2 (:) p (pgZeroOrMore p)
-
-
---==========================================================--
---
-pgApply :: (a -> b) -> Parser a -> Parser b
-
-pgApply f p env toks
-   = case p env toks of
-     {
-       PFail tok1
-         -> PFail tok1 ;
-       POk env1 toks1 item1
-         -> POk env1 toks1 (f item1)
-     }
-
-
---==========================================================--
---
-pgTwoOrMoreWithSep :: Parser a -> Parser b -> Parser [a]
-
-pgTwoOrMoreWithSep p psep
-   = pgThen4
-        (\i1 s1 i2 rest -> i1:i2:rest)
-        p
-        psep
-        p 
-        (pgZeroOrMore (pgThen2 (\sep x -> x) psep p))
-
-
---==========================================================--
---
-pgOneOrMoreWithSep :: Parser a -> Parser b -> Parser [a]
-
-pgOneOrMoreWithSep p psep
-   = pgThen2 (:) p (pgZeroOrMore (pgThen2 (\sep x -> x) psep p))
-
-
---==========================================================--
---
-pgZeroOrMoreWithSep :: Parser a -> Parser b -> Parser [a]
-
-pgZeroOrMoreWithSep p psep
-   = pgAlts
-     [
-        pgOneOrMoreWithSep p psep,
-        pgApply (\x -> x:[]) p,
-        pgEmpty []
-     ]
-
-
---==========================================================--
---
-pgOptional :: Parser a -> Parser (Maybe a)
-
-pgOptional p env toks
-   = case p env toks of
-     {
-       PFail tok1
-         -> POk env toks Nothing ;
-       POk env2 toks2 item2
-         -> POk env2 toks2 (Just item2)
-     }
-
-
---==========================================================--
---
-pgGetLineNumber :: Parser a -> Parser (Int, a)
-
-pgGetLineNumber p env toks
-   = let 
-         lineNo = case (head (toks ++ [pgEOF])) of (l, n, w, t) -> l
-     in
-         case p env toks of
-         {
-           PFail tok1
-             -> PFail tok1 ;
-           POk env2 toks2 item2
-             -> POk env2 toks2 (lineNo, item2)
-         }
-
-
---==========================================================--
---
-pgEmpty :: a -> Parser a
-
-pgEmpty item env toks
-   = POk env toks item
-
-
---==========================================================--
---
-pgEOF :: Token
-
-pgEOF = (88888, 88888, Lvar, "*** Unexpected end of source! ***")
-
-
---============================================================--
---=== Some kludgey stuff for implementing the offside rule ===--
---============================================================--
-
---==========================================================--
---
-pgEatEnd :: Parser ()
-
-pgEatEnd env [] 
-   = POk env [] ()
-
-pgEatEnd env (tok@(l, n, w, t):toks)
-   | w == Lsemi || w == Lrbrace   = POk env toks ()
-   | otherwise                    = POk env (tok:toks) ()
-
-
---==========================================================--
---
-pgDeclList :: Parser a -> Parser [a]
-
-pgDeclList p
-   = pgThen3 (\a b c -> b) (pgItem Llbrace) 
-                           (pgOneOrMoreWithSep p (pgItem Lsemi))
-                           pgEatEnd
-
-
---==========================================================--
---=== end                               ParserGeneric.hs ===--
---==========================================================--
-
---==========================================================--
---=== The parser.                                        ===--
---===                                          Parser.hs ===--
---==========================================================--
-
---module Parser where
-
-{- FIX THESE UP -}
-utLookupDef env k def
-   = head ( [ vv | (kk,vv) <- env, kk == k] ++ [def] )
-panic = error
-{- END FIXUPS -}
-
-paLiteral :: Parser Literal
-paLiteral
-   = pgAlts 
-     [
-        pgApply (LiteralInt.leStringToInt) (pgItem Lintlit),
-        pgApply (LiteralChar.head)         (pgItem Lcharlit),
-        pgApply LiteralString              (pgItem Lstringlit)
-     ]
-
-paExpr
-   = pgAlts 
-     [
-        paCaseExpr, 
-        paLetExpr, 
-        paLamExpr,
-        paIfExpr,
-        paUnaryMinusExpr,
-        hsDoExpr []
-     ]
-
-paUnaryMinusExpr
-   = pgThen2
-        (\minus (_, aexpr, _) -> 
-             ExprApp (ExprApp (ExprVar "-") (ExprLiteral (LiteralInt 0))) aexpr)
-        paMinus
-        paAExpr
-
-paCaseExpr
-   = pgThen4
-        (\casee expr off alts -> ExprCase expr alts)
-        (pgItem Lcase)
-        paExpr
-        (pgItem Lof)
-        (pgDeclList paAlt)
-
-paAlt
-   = pgAlts
-     [
-        pgThen4
-           (\pat arrow expr wheres 
-                -> MkExprCaseAlt pat (pa_MakeWhereExpr expr wheres))
-           paPat
-           (pgItem Larrow)
-           paExpr
-           (pgOptional paWhereClause),
-        pgThen3
-           (\pat agrdrhss wheres
-                -> MkExprCaseAlt pat
-                      (pa_MakeWhereExpr (ExprGuards agrdrhss) wheres))
-           paPat
-           (pgOneOrMore paGalt)
-           (pgOptional paWhereClause)
-     ]
-
-paGalt
-   = pgThen4
-        (\bar guard arrow expr -> (guard, expr))
-        (pgItem Lbar)
-        paExpr
-        (pgItem Larrow)
-        paExpr
-
-paLamExpr
-   = pgThen4
-        (\lam patterns arrow rhs -> ExprLam patterns rhs)
-        (pgItem Lslash)
-        (pgZeroOrMore paAPat)
-        (pgItem Larrow)
-        paExpr
-
-paLetExpr
-   = pgThen4
-        (\lett decls inn rhs -> ExprLetrec decls rhs)
-        (pgItem Llet)
-        paValdefs
-        (pgItem Lin)
-        paExpr
-
-paValdefs 
-   = pgApply pa_MergeValdefs (pgDeclList paValdef)
-
-pa_MergeValdefs 
-   = id
-
-paLhs
-   = pgAlts
-     [
-        pgThen2 (\v ps -> LhsVar v ps) paVar (pgOneOrMore paPat),
-        pgApply LhsPat paPat
-     ]
-
-paValdef
-   = pgAlts
-     [
-        pgThen4
-           (\(line, lhs) eq rhs wheres 
-                -> MkValBind line lhs (pa_MakeWhereExpr rhs wheres))
-           (pgGetLineNumber paLhs)
-           (pgItem Lequals)
-           paExpr
-           (pgOptional paWhereClause),
-        pgThen3
-           (\(line, lhs) grdrhss wheres 
-                -> MkValBind line lhs 
-                      (pa_MakeWhereExpr (ExprGuards grdrhss) wheres))
-           (pgGetLineNumber paLhs)
-           (pgOneOrMore paGrhs)
-           (pgOptional paWhereClause)
-     ]
-
-pa_MakeWhereExpr expr Nothing 
-   = expr
-pa_MakeWhereExpr expr (Just whereClauses) 
-   = ExprWhere expr whereClauses
-
-paWhereClause
-   = pgThen2 (\x y -> y) (pgItem Lwhere) paValdefs
-paGrhs
-   = pgThen4
-        (\bar guard equals expr -> (guard, expr))
-        (pgItem Lbar)
-        paExpr
-        (pgItem Lequals)
-        paExpr
-        
-
-paAPat
-   = pgAlts
-     [
-        pgApply PatVar paVar,
-        pgApply (\id -> PatCon id []) paCon,
-        pgApply (const PatWild) (pgItem Lunder),
-        pgApply PatTuple
-                (pgThen3 (\l es r -> es)
-                         (pgItem Llparen) 
-                         (pgTwoOrMoreWithSep paPat (pgItem Lcomma))
-                         (pgItem Lrparen)),
-        pgApply PatList
-                (pgThen3 (\l es r -> es)
-                         (pgItem Llbrack) 
-                         (pgZeroOrMoreWithSep paPat (pgItem Lcomma))
-                         (pgItem Lrbrack)),
-        pgThen3 (\l p r -> p)
-                (pgItem Llparen)
-                paPat
-                (pgItem Lrparen)
-     ]
-
-paPat
-   = pgAlts
-     [
-        pgThen2 (\c ps -> PatCon c ps)
-                paCon
-                (pgOneOrMore paAPat),
-        pgThen3 (\ap c pa -> PatCon c [ap,pa])
-                paAPat
-                paConop
-                paPat,
-        paAPat
-     ]
-
-
-paIfExpr
- = pgThen4
-      (\iff c thenn (t,f) -> ExprIf c t f)
-      (pgItem Lif)
-      paExpr
-      (pgItem Lthen)
-      (pgThen3
-         (\t elsee f -> (t,f))
-         paExpr
-         (pgItem Lelse)
-         paExpr
-      )
-
-paAExpr
- = pgApply (\x -> (False, x, []))
-   (pgAlts 
-    [
-       pgApply ExprVar paVar,
-       pgApply ExprCon paCon,
-       pgApply ExprLiteral paLiteral,
-       pgApply ExprList paListExpr,
-       pgApply ExprTuple paTupleExpr,
-       pgThen3 (\l e r -> e) (pgItem Llparen) paExpr (pgItem Lrparen)
-    ]
-   )
-
-paListExpr
-   = pgThen3 (\l es r -> es) 
-             (pgItem Llbrack) 
-             (pgZeroOrMoreWithSep paExpr (pgItem Lcomma))
-             (pgItem Lrbrack)
-
-paTupleExpr
-   = pgThen3 (\l es r -> es) 
-             (pgItem Llparen) 
-             (pgTwoOrMoreWithSep paExpr (pgItem Lcomma))
-             (pgItem Lrparen)
-
-paVar = pgItem Lvar
-paCon = pgItem Lcon
-paVarop = pgItem Lvarop
-paConop = pgItem Lconop
-paMinus = pgItem Lminus
-
-paOp
- = pgAlts [
-            pgApply (\x -> (True, ExprVar x, x)) paVarop,
-            pgApply (\x -> (True, ExprCon x, x)) paConop,
-            pgApply (\x -> (True, ExprVar x, x)) paMinus
-          ]
-
-paDataDecl
-   = pgThen2
-        (\dataa useful -> useful)
-        (pgItem Ldata)
-        paDataDecl_main
-
-paDataDecl_main
-   = pgThen4
-        (\name params eq drhs -> MkDataDecl name (params, drhs))
-        paCon
-        (pgZeroOrMore paVar)
-        (pgItem Lequals)
-        (pgOneOrMoreWithSep paConstrs (pgItem Lbar))
-
-paConstrs
-   = pgThen2
-        (\con texprs -> (con, texprs))
-        paCon
-        (pgZeroOrMore paAType)
-
-paType 
-   = pgAlts
-     [
-        pgThen3 
-           (\atype arrow typee -> TypeArr atype typee)
-           paAType
-           (pgItem Larrow)
-           paType,
-        pgThen2
-           TypeCon
-           paCon
-           (pgOneOrMore paAType),
-        paAType
-     ]
-
-paAType
-   = pgAlts
-     [
-        pgApply TypeVar paVar,
-        pgApply (\tycon -> TypeCon tycon []) paCon,
-        pgThen3
-           (\l t r -> t)
-           (pgItem Llparen)
-           paType
-           (pgItem Lrparen),
-        pgThen3
-           (\l t r -> TypeList t)
-           (pgItem Llbrack)
-           paType
-           (pgItem Lrbrack),
-        pgThen3
-           (\l t r -> TypeTuple t)
-           (pgItem Llparen)
-           (pgTwoOrMoreWithSep paType (pgItem Lcomma))
-           (pgItem Lrparen)
-     ]
-
-paInfixDecl env toks
-  = let dump (ExprVar v) = v
-        dump (ExprCon c) = c
-    in
-    pa_UpdateFixityEnv 
-       (pgThen3
-          (\assoc prio name -> MkFixDecl name (assoc, prio))
-          paInfixWord
-          (pgApply leStringToInt (pgItem Lintlit)) 
-          (pgApply (\(_, op, _) -> dump op) paOp)
-          env 
-          toks 
-       )
-
-paInfixWord
-  = pgAlts
-    [
-       pgApply (const InfixL) (pgItem Linfixl),
-       pgApply (const InfixR) (pgItem Linfixr),
-       pgApply (const InfixN) (pgItem Linfix)
-    ]
-
-pa_UpdateFixityEnv (PFail tok) 
-   = PFail tok
-
-pa_UpdateFixityEnv (POk env toks (MkFixDecl name assoc_prio))
-   = let 
-         new_env = (name, assoc_prio) : env
-     in
-         POk new_env toks (MkFixDecl name assoc_prio)
-
-paTopDecl
-   = pgAlts
-     [
-        pgApply MkTopF paInfixDecl,
-        pgApply MkTopD paDataDecl,
-        pgApply MkTopV paValdef
-     ]
-
-paModule
-   = pgThen4
-        (\modyule name wheree topdecls -> MkModule name topdecls)
-        (pgItem Lmodule)
-        paCon
-        (pgItem Lwhere)
-        (pgDeclList paTopDecl)
-   
-parser_test toks
-   = let parser_to_test
-            = --paPat
-              --paExpr
-              --paValdef
-              --pgZeroOrMore paInfixDecl
-              --paDataDecl
-              --paType
-              paModule
-              --pgTwoOrMoreWithSep (pgItem Lsemi) (pgItem Lcomma)
-              
-     in
-         parser_to_test hsPrecTable toks
-
---==============================================--
---=== The Operator-Precedence parser (yuck!) ===--
---==============================================--
-
---
---==========================================================--
---
-hsAExprOrOp 
- = pgAlts [paAExpr, paOp]
-
-hsDoExpr :: [PEntry] -> Parser Expr
--- [PaEntry] is a stack of operators and atomic expressions
--- hsDoExpr uses a parser (hsAexpOrOp :: Parsr PaEntry) for atomic
--- expressions or operators
-
-hsDoExpr stack env toks = 
-  let
-     (validIn, restIn, parseIn, err)
-        = case hsAExprOrOp env toks of
-             POk env1 toks1 item1
-                -> (True, toks1, item1, panic "hsDoExpr(1)")
-             PFail err
-                -> (False, panic "hsDoExpr(2)", panic "hsDoExpr(3)", err)
-     (opIn, valueIn, nameIn)
-        = parseIn
-     (assocIn, priorIn)
-        = utLookupDef env nameIn (InfixL, 9)
-     shift
-        = hsDoExpr (parseIn:stack) env restIn
-  in 
-     case stack of
-        s1:s2:s3:ss
-           | validIn && opS2 && opIn && priorS2 > priorIn
-              -> reduce
-           | validIn && opS2 && opIn && priorS2 == priorIn
-              -> if assocS2 == InfixL && 
-                    assocIn == InfixL 
-                 then reduce
-                else 
-                 if assocS2 == InfixR && 
-                    assocIn == InfixR 
-                 then shift
-                else PFail (head toks) -- Because of ambiguousness 
-           | not validIn && opS2
-              -> reduce
-             where
-               (opS1, valueS1, nameS1) = s1
-               (opS2, valueS2, nameS2) = s2
-               (opS3, valueS3, nameS3) = s3
-               (assocS2, priorS2) = utLookupDef env nameS2 (InfixL, 9)
-               reduce = hsDoExpr ((False, ExprApp (ExprApp valueS2 valueS3) 
-                                                  valueS1, [])
-                                  : ss) env toks
-        s1:s2:ss
-           | validIn && (opS1 || opS2) -> shift
-           | otherwise -> reduce
-             where
-                (opS1, valueS1, nameS1) = s1
-                (opS2, valueS2, nameS2) = s2
-                reduce = hsDoExpr ((False, ExprApp valueS2 valueS1, []) : ss) 
-                                  env toks
-        (s1:[])
-           | validIn -> shift
-           | otherwise -> POk env toks valueS1
-             where
-                (opS1, valueS1, nameS1) = s1
-        []
-           | validIn -> shift
-           | otherwise -> PFail err
-
---==========================================================--
---=== end                                      Parser.hs ===--
---==========================================================--
-
-hsPrecTable :: PEnv
-hsPrecTable = [
-  ("-",                (InfixL, 6)),
-  ("+",                (InfixL, 6)),
-  ("*",                (InfixL, 7)),
-  ("div",      (InfixN, 7)),
-  ("mod",      (InfixN, 7)),
-
-  ("<",                (InfixN, 4)),
-  ("<=",       (InfixN, 4)),
-  ("==",       (InfixN, 4)),
-  ("/=",       (InfixN, 4)),
-  (">=",       (InfixN, 4)),
-  (">",                (InfixN, 4)),
-
-  ("C:",        (InfixR, 5)),
-  ("++",        (InfixR, 5)),
-  ("\\",        (InfixN, 5)),
-  ("!!",        (InfixL, 9)),
-  (".",         (InfixR, 9)),
-  ("^",         (InfixR, 8)),
-  ("elem",      (InfixN, 4)),
-  ("notElem",   (InfixN, 4)),
-
-  ("||",       (InfixR, 2)),
-  ("&&",       (InfixR, 3))]
-
-
-main resps
-   = [ReadChan stdin, --ReadFile "big_big_test.hs", --"test.fp",
-      AppendChan stdout (showx parser_res)]
-                        --(show tokens)]
-     where
-          cs = case resps !! 0 of
-                  Str s -> s
-          tokens = laMain cs
-          parser_res = parser_test tokens
-
-showx (PFail t) 
- = "\n\nFailed (boo, hiss)!\n\n"
-
-showx (POk env [] result)
- = "\n\nFailed (EOF token not seen ?!?!)\n\n"
-
-showx (POk env ((l,n,w,t):_) result)
- = "\n\nSucceeded, with:\n   Size env = " ++ show (length env) ++
-   "\n   Line number of last token = " ++ show (l :: Int) ++ "\n\n"
-
-{- partain:
-showx (PFail t) 
- = "\n\nFailed on token: " {-partain ++ show t -} ++  "\n\n"
-
-showx (POk env toks result)
- = "\n\nSucceeded, with:\n   Size env = " ++ show (length env) {-partain ++
-   "\n   Next token = " ++ show (head toks) ++
-   "\n\n   Result = " ++ show result ++ "\n\n"-}
--}
-
---==========================================================--
---
-layn :: [[Char]] -> [Char]
-
-layn x =   f 1 x
-           where
-           f :: Int -> [[Char]] -> [Char]
-           f n [] = []
-           f n (a:x) = rjustify 4 (show n) ++") "++a++"\n"++f (n+1) x
-
-
-
---==========================================================--
---
-rjustify :: Int -> [Char] -> [Char]
-rjustify n s = spaces (n - length s)++s
-               where
-                  spaces :: Int -> [Char]
-                  spaces m = copy m ' '
-
-copy :: Int -> a -> [a]
-
-copy n x = take (max 0 n) xs where xs = x:xs
-
diff --git a/real/reptile/Main-ALT.hs b/real/reptile/Main-ALT.hs
deleted file mode 100644 (file)
index 65c242e..0000000
+++ /dev/null
@@ -1,34 +0,0 @@
--- Main3.hs
-
--- LML original: Sandra Foubister, 1990
--- Haskell translation: Colin Runciman, May 1991
--- with (map (AppendChan stdout) toMgr) *and* setup
-
-module Main(main) where
-
-import Mgrfuns
-import Progfuns
-import Auxprogfuns
-import Layout
-import Tilefuns
-
-main :: [Response] -> [Request]
-main ~(Str fromMgr : _) =
-  (ReadChan stdin: map (AppendChan stdout) toMgr)
-  where
-  toMgr = [set, potatotile ([],1,initalist) (lines fromMgr),clearup]
-
-set :: [Char]
-set = setmode 7 ++
-       shapewindow [0,0,1150,900] ++
-       setup
-
-clearup :: [Char]
-clearup = shapewindow [0,0,500,500] ++
-         font 8 ++
-         textreset ++
-         clear ++
-         font 15
-
-
-
diff --git a/spectral/compreals/makefile b/spectral/compreals/makefile
deleted file mode 100644 (file)
index e69de29..0000000
diff --git a/spectral/hartel/fft/Main2.hs b/spectral/hartel/fft/Main2.hs
deleted file mode 100644 (file)
index b67898e..0000000
+++ /dev/null
@@ -1,412 +0,0 @@
-module Main (main) -- fft
-where {
---partain: import Fast2haskell;
-#include "../Fast2haskell2.hs"
-    strict_show_i::Int -> [Char];
-    strict_show_i x=miraseq x (show x);
-    strict_show_d::Double -> [Char];
-    strict_show_d x=miraseq x (show x);
-
-    f_my_cmp a_x a_y=
-        if (((==) :: (Int -> Int -> Bool)) (fromEnum (f_cmp a_x a_y)) (fromEnum 't'))
-        then "t"
-        else 
-            ((++) "f(" ((++) (f_showcomplex a_x) ((++) "-" ((++) (f_showcomplex a_y) 
-            ((++) "=" ((++) (f_showcomplex (((-) :: (Complex_type -> Complex_type -> Complex_type)) a_x a_y)) ")\n"))))));
-    f_benchmark_main a_n=
-        let { 
-            r_x=f_large a_n (64 :: Int)
-         } in  (++) (f_sumcode (f_concat (f_map2 f_my_cmp (f_iaamain r_x) (f_rllmain r_x)))) "\n";
-    f_sumcode::[Char] -> [Char];
-    f_sumcode a_xs=
-        let { 
-            f_sumcode' [] a_sum a_n=(++) (strict_show_i (((+) :: (Int -> Int -> Int)) a_sum a_n)) ((:) '/' (strict_show_i a_n));
-            f_sumcode' (a_x:a_xs) a_sum a_n=f_sumcode' a_xs (((+) :: (Int -> Int -> Int)) a_sum (fromEnum a_x)) (((+) :: (Int -> Int -> Int)) a_n (1 :: Int))
-         } in  f_sumcode' a_xs (0 :: Int) (0 :: Int);
-type 
-    T_complex_array=Array_type Complex_type;
-    f_iaafft::Int -> Int -> T_complex_array -> T_complex_array;
-    f_iaafft a_size 0 a_xs=a_xs;
-    f_iaafft a_size a_n a_xs=
-        let { 
-            r_m=f_log2 (((quot) :: (Int -> Int -> Int)) a_size (((*) :: (Int -> Int -> Int)) a_n (2 :: Int)));
-            r_xs'=array (bounds a_xs) (f_concat [f_mkpair a_j|a_j<-[(0 :: Int)..((-) :: (Int -> Int -> Int)) a_size (1 :: Int)],
-                ((==) :: (Int -> Int -> Bool)) (land_i a_j (lshift_i (1 :: Int) r_m)) (0 :: Int)]);
-            f_mkpair a_j=
-                let { 
-                    r_x=(!) a_xs a_j;
-                    r_y=(!) a_xs r_k;
-                    r_z=((*) :: (Complex_type -> Complex_type -> Complex_type)) (f_unitroot a_size (((*) :: (Int -> Int -> Int)) a_n a_j)) r_y;
-                    r_k=((+) :: (Int -> Int -> Int)) a_j (f_pow2 r_m)
-                 } in  (:) ((:=) a_j (((+) :: (Complex_type -> Complex_type -> Complex_type)) r_x r_z)) ((:) ((:=) r_k (((-) :: (Complex_type -> Complex_type -> Complex_type)) r_x r_z)) [])
-         } in  f_iaafft a_size (((quot) :: (Int -> Int -> Int)) a_n (2 :: Int)) r_xs';
-    f_rllfft::Int -> Int -> [Complex_type] -> [Complex_type];
-    f_rllfft a_size a_n (a_x:[])=(:) a_x [];
-    f_rllfft a_size a_n a_xs=
-        let { 
-            r_ls'=f_map2 ((+) :: (Complex_type -> Complex_type -> Complex_type)) r_ls r_rs'';
-            r_rs'=f_map2 ((-) :: (Complex_type -> Complex_type -> Complex_type)) r_ls r_rs'';
-            r_rs''=f_map (((*) :: (Complex_type -> Complex_type -> Complex_type)) (f_unitroot a_size a_n)) r_rs;
-            (r_ls,r_rs)=f_split (((quot) :: (Int -> Int -> Int)) (length a_xs) (2 :: Int)) a_xs
-         } in  (++) (f_rllfft a_size (((quot) :: (Int -> Int -> Int)) a_n (2 :: Int)) r_ls') (f_rllfft a_size (((+) :: (Int -> Int -> Int)) (((quot) :: (Int -> Int -> Int)) a_n (2 :: Int)) 
-            (((quot) :: (Int -> Int -> Int)) a_size (4 :: Int))) r_rs');
-    f_bfly::Int -> Int -> Complex_type -> Complex_type -> (Complex_type,Complex_type);
-    f_bfly a_i a_n a_x a_y=
-        let { 
-            r_z=((*) :: (Complex_type -> Complex_type -> Complex_type)) (f_unitroot a_i a_n) a_y
-         } in  (((+) :: (Complex_type -> Complex_type -> Complex_type)) a_x r_z,((-) :: (Complex_type -> Complex_type -> Complex_type)) a_x r_z);
-    f_unitroot::Int -> Int -> Complex_type;
-    f_unitroot a_i a_n=
-        let { 
-            r_phi=((*) :: (Double -> Double -> Double)) (((/) :: (Double -> Double -> Double)) (fromIntegral (((*) :: (Int -> Int -> Int)) (2 :: Int) a_n)) (fromIntegral a_i)) c_pi
-         } in  colon_plus (((cos) :: (Double -> Double)) r_phi) (((sin) :: (Double -> Double)) r_phi);
-    f_pow2::Int -> Int;
-    f_pow2 a_x=lshift_i (1 :: Int) a_x;
-    f_log2::Int -> Int;
-    f_log2 a_x=floor (f_round_d (((/) :: (Double -> Double -> Double)) (((log) :: (Double -> Double)) (fromIntegral a_x)) (((log) :: (Double -> Double)) (2.00000 :: Double))));
-    f_round_d::Double -> Double;
-    f_round_d a_x=entier (((+) :: (Double -> Double -> Double)) a_x (0.500000 :: Double));
-    f_split::Int -> [t1] -> ([t1],[t1]);
-    f_split a_n a_xs=(f_take a_n a_xs,f_drop a_n a_xs);
-    f_join::Int -> [t1] -> [t1] -> [t1];
-    f_join a_n [] []=[];
-    f_join a_n a_x a_y=
-        let { 
-            (r_firstx,r_restx)=f_split a_n a_x;
-            (r_firsty,r_resty)=f_split a_n a_y
-         } in  (++) r_firstx ((++) r_firsty (f_join a_n r_restx r_resty));
-    f_reorder::Int -> [t1] -> [t1];
-    f_reorder 1 a_y=a_y;
-    f_reorder a_n a_y=
-        let { 
-            (r_left,r_right)=f_split (((quot) :: (Int -> Int -> Int)) r_size (2 :: Int)) a_y;
-            r_m=((quot) :: (Int -> Int -> Int)) r_size a_n;
-            r_size=length a_y
-         } in  f_reorder (((quot) :: (Int -> Int -> Int)) a_n (2 :: Int)) (f_join r_m r_left r_right);
-    f_rev_bits::Int -> Int -> Int;
-    f_rev_bits a_wid a_x=
-        let { 
-            f_rev_bits' a_w a_x a_a=
-                if (((==) :: (Int -> Int -> Bool)) a_w (0 :: Int))
-                then a_a
-                else 
-                    (f_rev_bits' (((-) :: (Int -> Int -> Int)) a_w (1 :: Int)) (rshift_i a_x (1 :: Int)) (lor_i (lshift_i a_a (1 :: Int)) (land_i a_x (1 :: Int))))
-         } in  f_rev_bits' a_wid a_x (0 :: Int);
-    f_reorderindex::Int -> Array_type Int;
-    f_reorderindex a_size=tabulate (f_rev_bits (f_log2 a_size)) (descr (0 :: Int) (((-) :: (Int -> Int -> Int)) a_size (1 :: Int)));
-    f_aareorder::(Array_type Int) -> (Array_type t1) -> Array_type t1;
-    f_aareorder a_index a_ar=
-        let { 
-            f_aareorder' a_i=(!) a_ar ((!) a_index a_i)
-         } in  tabulate f_aareorder' (bounds a_ar);
-    f_intplex::Int -> Int -> Complex_type;
-    f_intplex a_r a_i=colon_plus (fromIntegral a_r) (fromIntegral a_i);
-    c_input1::[Complex_type];
-    c_input1=
-        let { 
-            r_as=(:) (0 :: Int) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (3 :: Int) ((:) (4 :: Int) ((:) (5 :: Int) 
-                ((:) (6 :: Int) ((:) (7 :: Int) r_as)))))));
-            r_bs=(:) (0 :: Int) ((:) (1 :: Int) ((:) (2 :: Int) ((:) (1 :: Int) ((:) (0 :: Int) r_bs))))
-         } in  f_take (16 :: Int) (f_map2 f_intplex r_as r_bs);
-    c_input2=(:) (f_intplex (2 :: Int) (3 :: Int)) ((:) (f_intplex (6 :: Int) (7 :: Int)) ((:) (f_intplex (4 :: Int) (5 :: Int)) 
-        ((:) (f_intplex (8 :: Int) (9 :: Int)) [])));
-    c_input3=f_map2 f_intplex ((:) (1 :: Int) ((:) (1 :: Int) ((:) (1 :: Int) ((:) (1 :: Int) ((:) (1 :: Int) 
-        ((:) (1 :: Int) ((:) (1 :: Int) ((:) (1 :: Int) ((:) (1 :: Int) ((:) (((negate) :: (Int -> Int)) (1 :: Int)) ((:) 
-        (((negate) :: (Int -> Int)) (1 :: Int)) ((:) (((negate) :: (Int -> Int)) (1 :: Int)) ((:) (((negate) :: (Int -> Int)) (1 :: Int)) ((:) (((negate) :: (Int -> Int)) (1 :: Int)) 
-        ((:) (((negate) :: (Int -> Int)) (1 :: Int)) ((:) (((negate) :: (Int -> Int)) (1 :: Int)) [])))))))))))))))) [(0 :: Int),(0 :: Int)..];
-    c_input4=f_large (5 :: Int) (64 :: Int);
-    f_extend::Int -> [t1] -> [t1];
-    f_extend 0 a_a=a_a;
-    f_extend a_n a_a=f_extend (((-) :: (Int -> Int -> Int)) a_n (1 :: Int)) ((++) a_a a_a);
-    f_large::Int -> Int -> [Complex_type];
-    f_large a_coarse a_fine=f_extend a_coarse [f_intplex (((-) :: (Int -> Int -> Int)) a_fine a_i) (0 :: Int)|a_i<-[(1 :: Int)..a_fine]];
-    f_cmp::Complex_type -> Complex_type -> Char;
-    f_cmp a_ab a_cd=
-        let { 
-            r_a=realPart a_ab;
-            r_b=imagPart a_ab;
-            r_c=realPart a_cd;
-            r_d=imagPart a_cd
-         } in  
-            if (
-                if (((<=) :: (Double -> Double -> Bool)) (f_abs (((-) :: (Double -> Double -> Double)) r_a r_c)) c_eps)
-                then (((<=) :: (Double -> Double -> Bool)) (f_abs (((-) :: (Double -> Double -> Double)) r_b r_d)) c_eps)
-                else 
-                    False)
-            then 't'
-            else 
-                'f';
-    f_showcomplexarray::T_complex_array -> [Char];
-    f_showcomplexarray a_ar=
-        let { 
-            r_lu=bounds a_ar;
-            r_l=lowbound r_lu;
-            r_u=upbound r_lu
-         } in  (++) "[" ((++) (f_showcomplex ((!) a_ar r_l)) ((++) (f_concat [
-            (++) ", " (f_showcomplex ((!) a_ar a_i))|a_i<-[((+) :: (Int -> Int -> Int)) r_l (1 :: Int)..r_u]]) "] "));
-    f_showcomplexlist::[Complex_type] -> [Char];
-    f_showcomplexlist (a_a:a_as)=(++) "[" ((++) (f_showcomplex a_a) ((++) (f_concat [(++) ", " 
-        (f_showcomplex a_a')|a_a'<-a_as]) "] "));
-    f_showcomplex::Complex_type -> [Char];
-    f_showcomplex a_ri=(++) "C " ((++) (f_showreal (realPart a_ri)) ((++) " " (f_showreal 
-        (imagPart a_ri))));
-    f_showreal::Double -> [Char];
-    f_showreal a_r=
-        if (((<=) :: (Double -> Double -> Bool)) (f_abs a_r) c_eps)
-        then "0"
-        else 
-            (strict_show_d a_r);
-    c_eps=(0.500000 :: Double);
-    f_iaamain::[Complex_type] -> [Complex_type];
-    f_iaamain a_xs=
-        let { 
-            r_index=f_reorderindex r_size;
-            r_size=length a_xs
-         } in  elems (f_iaafft r_size (((quot) :: (Int -> Int -> Int)) r_size (2 :: Int)) (f_aareorder r_index (listArray (descr (0 :: Int) 
-            (((-) :: (Int -> Int -> Int)) r_size (1 :: Int))) a_xs)));
-    f_iaashow::[Complex_type] -> [Char];
-    f_iaashow a_xs=f_showcomplexlist (f_iaamain a_xs);
-    f_rllmain::[Complex_type] -> [Complex_type];
-    f_rllmain a_xs=
-        let { 
-            r_size=length a_xs
-         } in  f_reorder r_size (f_rllfft r_size (0 :: Int) a_xs);
-    f_rllshow::[Complex_type] -> [Char];
-    f_rllshow a_xs=f_showcomplexlist (f_rllmain a_xs);
-    f_abs::Double -> Double;
-    f_abs a_x=
-        if (((<=) :: (Double -> Double -> Bool)) a_x (0.00000 :: Double))
-        then (((negate) :: (Double -> Double)) a_x)
-        else 
-            a_x;
-    f_and::[Bool] -> Bool;
-    f_and a_xs=f_foldr (&&) True a_xs;
-    f_cjustify::Int -> [Char] -> [Char];
-    f_cjustify a_n a_s=
-        let { 
-            r_margin=((-) :: (Int -> Int -> Int)) a_n (length a_s);
-            r_lmargin=((quot) :: (Int -> Int -> Int)) r_margin (2 :: Int);
-            r_rmargin=((-) :: (Int -> Int -> Int)) r_margin r_lmargin
-         } in  (++) (f_spaces r_lmargin) ((++) a_s (f_spaces r_rmargin));
-    f_concat::[[t1]] -> [t1];
-    f_concat a_xs=f_foldr (++) [] a_xs;
-    f_const::t1 -> t2 -> t1;
-    f_const a_x a_y=a_x;
-    f_digit::Char -> Bool;
-    f_digit a_x=
-        if (((<=) :: (Int -> Int -> Bool)) (fromEnum '0') (fromEnum a_x))
-        then (((<=) :: (Int -> Int -> Bool)) (fromEnum a_x) (fromEnum '9'))
-        else 
-            False;
-    f_drop::Int -> [t1] -> [t1];
-    f_drop 0 a_x=a_x;
-    f_drop a_n (a_a:a_x)=f_drop (((-) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x;
-    f_drop a_n a_x=[];
-    f_dropwhile::(t1 -> Bool) -> [t1] -> [t1];
-    f_dropwhile a_f []=[];
-    f_dropwhile a_f (a_a:a_x)=
-        if (a_f a_a)
-        then (f_dropwhile a_f a_x)
-        else 
-            ((:) a_a a_x);
-    c_e::Double;
-    c_e=((exp) :: (Double -> Double)) (1.00000 :: Double);
-    f_filter::(t1 -> Bool) -> [t1] -> [t1];
-    f_filter a_f a_x=[a_a|a_a<-a_x,a_f a_a];
-    f_foldl::(t1 -> t2 -> t1) -> t1 -> [t2] -> t1;
-    f_foldl a_op a_r []=a_r;
-    f_foldl a_op a_r (a_a:a_x)=
-        let { 
-            f_strict a_f a_x=miraseq a_x (a_f a_x)
-         } in  f_foldl a_op (f_strict a_op a_r a_a) a_x;
-    f_foldl1::(t1 -> t1 -> t1) -> [t1] -> t1;
-    f_foldl1 a_op (a_a:a_x)=f_foldl a_op a_a a_x;
-    f_foldr::(t1 -> t2 -> t2) -> t2 -> [t1] -> t2;
-    f_foldr a_op a_r []=a_r;
-    f_foldr a_op a_r (a_a:a_x)=a_op a_a (f_foldr a_op a_r a_x);
-    f_foldr1::(t1 -> t1 -> t1) -> [t1] -> t1;
-    f_foldr1 a_op (a_a:[])=a_a;
-    f_foldr1 a_op (a_a:a_b:a_x)=a_op a_a (f_foldr1 a_op ((:) a_b a_x));
-    f_fst::(t1,t2) -> t1;
-    f_fst (a_a,a_b)=a_a;
-    f_id::t1 -> t1;
-    f_id a_x=a_x;
-    f_index::[t1] -> [Int];
-    f_index a_x=
-        let { 
-            f_f a_n []=[];
-            f_f a_n (a_a:a_x)=(:) a_n (f_f (((+) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x)
-         } in  f_f (0 :: Int) a_x;
-    f_init::[t1] -> [t1];
-    f_init (a_a:a_x)=
-        if (null a_x)
-        then []
-        else 
-            ((:) a_a (f_init a_x));
-    f_iterate::(t1 -> t1) -> t1 -> [t1];
-    f_iterate a_f a_x=(:) a_x (f_iterate a_f (a_f a_x));
-    f_last::[t1] -> t1;
-    f_last a_x=(!!) a_x (((-) :: (Int -> Int -> Int)) (length a_x) (1 :: Int));
-    f_lay::[[Char]] -> [Char];
-    f_lay []=[];
-    f_lay (a_a:a_x)=(++) a_a ((++) "\n" (f_lay a_x));
-    f_layn::[[Char]] -> [Char];
-    f_layn a_x=
-        let { 
-            f_f a_n []=[];
-            f_f a_n (a_a:a_x)=(++) (f_rjustify (4 :: Int) (strict_show_i a_n)) ((++) ") " ((++) a_a ((++) "\n" 
-                (f_f (((+) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x))))
-         } in  f_f (1 :: Int) a_x;
-    f_letter::Char -> Bool;
-    f_letter a_c=
-        if (
-            if (((<=) :: (Int -> Int -> Bool)) (fromEnum 'a') (fromEnum a_c))
-            then (((<=) :: (Int -> Int -> Bool)) (fromEnum a_c) (fromEnum 'z'))
-            else 
-                False)
-        then True
-        else 
-        if (((<=) :: (Int -> Int -> Bool)) (fromEnum 'A') (fromEnum a_c))
-        then (((<=) :: (Int -> Int -> Bool)) (fromEnum a_c) (fromEnum 'Z'))
-        else 
-            False;
-    f_limit::[Double] -> Double;
-    f_limit (a_a:a_b:a_x)=
-        if (((==) :: (Double -> Double -> Bool)) a_a a_b)
-        then a_a
-        else 
-            (f_limit ((:) a_b a_x));
-    f_lines::[Char] -> [[Char]];
-    f_lines []=[];
-    f_lines (a_a:a_x)=
-        let { 
-            r_xs=
-                if (pair a_x)
-                then (f_lines a_x)
-                else 
-                    ((:) [] [])
-         } in  
-            if (((==) :: (Int -> Int -> Bool)) (fromEnum a_a) (fromEnum '\o012'))
-            then ((:) [] (f_lines a_x))
-            else 
-                ((:) ((:) a_a (head r_xs)) (tail r_xs));
-    f_ljustify::Int -> [Char] -> [Char];
-    f_ljustify a_n a_s=(++) a_s (f_spaces (((-) :: (Int -> Int -> Int)) a_n (length a_s)));
-    f_map::(t1 -> t2) -> [t1] -> [t2];
-    f_map a_f a_x=[a_f a_a|a_a<-a_x];
-    f_map2::(t1 -> t2 -> t3) -> [t1] -> [t2] -> [t3];
-    f_map2 a_f a_x a_y=[a_f a_a a_b|(a_a,a_b)<-f_zip2 a_x a_y];
-    f_max::[Int] -> Int;
-    f_max a_xs=f_foldl1 f_max2 a_xs;
-    f_max2::Int -> Int -> Int;
-    f_max2 a_a a_b=
-        if (((>=) :: (Int -> Int -> Bool)) a_a a_b)
-        then a_a
-        else 
-            a_b;
-    f_member::[Int] -> Int -> Bool;
-    f_member a_x a_a=f_or (f_map (flip ((==) :: (Int -> Int -> Bool)) a_a) a_x);
-    f_merge::[Int] -> [Int] -> [Int];
-    f_merge [] a_y=a_y;
-    f_merge (a_a:a_x) []=(:) a_a a_x;
-    f_merge (a_a:a_x) (a_b:a_y)=
-        if (((<=) :: (Int -> Int -> Bool)) a_a a_b)
-        then ((:) a_a (f_merge a_x ((:) a_b a_y)))
-        else 
-            ((:) a_b (f_merge ((:) a_a a_x) a_y));
-    f_min::[Int] -> Int;
-    f_min a_xs=f_foldl1 f_min2 a_xs;
-    f_min2::Int -> Int -> Int;
-    f_min2 a_a a_b=
-        if (((>) :: (Int -> Int -> Bool)) a_a a_b)
-        then a_b
-        else 
-            a_a;
-    f_mkset::[Int] -> [Int];
-    f_mkset []=[];
-    f_mkset (a_a:a_x)=(:) a_a (f_filter (flip ((/=) :: (Int -> Int -> Bool)) a_a) (f_mkset a_x));
-    f_or::[Bool] -> Bool;
-    f_or a_xs=f_foldr (||) False a_xs;
-    c_pi::Double;
-    c_pi=((*) :: (Double -> Double -> Double)) (4.00000 :: Double) (((atan) :: (Double -> Double)) (1.00000 :: Double));
-    f_postfix::t1 -> [t1] -> [t1];
-    f_postfix a_a a_x=(++) a_x ((:) a_a []);
-    f_product::[Int] -> Int;
-    f_product a_xs=f_foldl ((*) :: (Int -> Int -> Int)) (1 :: Int) a_xs;
-    f_rep::Int -> t1 -> [t1];
-    f_rep a_n a_x=f_take a_n (f_repeat a_x);
-    f_repeat::t1 -> [t1];
-    f_repeat a_x=(:) a_x (f_repeat a_x);
-    f_reverse::[t1] -> [t1];
-    f_reverse a_xs=f_foldl (flip (:)) [] a_xs;
-    f_rjustify::Int -> [Char] -> [Char];
-    f_rjustify a_n a_s=(++) (f_spaces (((-) :: (Int -> Int -> Int)) a_n (length a_s))) a_s;
-    f_scan::(t1 -> t2 -> t1) -> t1 -> [t2] -> [t1];
-    f_scan a_op=
-        let { 
-            f_g a_r []=(:) a_r [];
-            f_g a_r (a_a:a_x)=(:) a_r (f_g (a_op a_r a_a) a_x)
-         } in  f_g;
-    f_snd::(t1,t2) -> t2;
-    f_snd (a_a,a_b)=a_b;
-    f_sort::[Int] -> [Int];
-    f_sort a_x=
-        let { 
-            r_n=length a_x;
-            r_n2=((quot) :: (Int -> Int -> Int)) r_n (2 :: Int)
-         } in  
-            if (((<=) :: (Int -> Int -> Bool)) r_n (1 :: Int))
-            then a_x
-            else 
-                (f_merge (f_sort (f_take r_n2 a_x)) (f_sort (f_drop r_n2 a_x)));
-    f_spaces::Int -> [Char];
-    f_spaces a_n=f_rep a_n ' ';
-    f_subtract::Int -> Int -> Int;
-    f_subtract a_x a_y=((-) :: (Int -> Int -> Int)) a_y a_x;
-    f_sum::[Int] -> Int;
-    f_sum a_xs=f_foldl ((+) :: (Int -> Int -> Int)) (0 :: Int) a_xs;
-data 
-    T_sys_message=F_Stdout [Char] | F_Stderr [Char] | F_Tofile [Char] [Char] | F_Closefile [Char] | F_Appendfile [Char] | F_System [Char] | F_Exit Int;
-    f_take::Int -> [t1] -> [t1];
-    f_take 0 a_x=[];
-    f_take a_n (a_a:a_x)=(:) a_a (f_take (((-) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x);
-    f_take a_n a_x=[];
-    f_takewhile::(t1 -> Bool) -> [t1] -> [t1];
-    f_takewhile a_f []=[];
-    f_takewhile a_f (a_a:a_x)=
-        if (a_f a_a)
-        then ((:) a_a (f_takewhile a_f a_x))
-        else 
-            [];
-    f_transpose::[[t1]] -> [[t1]];
-    f_transpose a_x=
-        let { 
-            r_x'=f_takewhile pair a_x
-         } in  
-            if (null r_x')
-            then []
-            else 
-                ((:) (f_map head r_x') (f_transpose (f_map tail r_x')));
-    f_until::(t1 -> Bool) -> (t1 -> t1) -> t1 -> t1;
-    f_until a_f a_g a_x=
-        if (a_f a_x)
-        then a_x
-        else 
-            (f_until a_f a_g (a_g a_x));
-    f_zip2::[t1] -> [t2] -> [(t1,t2)];
-    f_zip2 (a_a:a_x) (a_b:a_y)=(:) (a_a,a_b) (f_zip2 a_x a_y);
-    f_zip2 a_x a_y=[];
-    f_zip3 (a_a:a_x) (a_b:a_y) (a_c:a_z)=(:) (a_a,a_b,a_c) (f_zip3 a_x a_y a_z);
-    f_zip3 a_x a_y a_z=[];
-    f_zip4 (a_a:a_w) (a_b:a_x) (a_c:a_y) (a_d:a_z)=(:) (a_a,a_b,a_c,a_d) (f_zip4 a_w a_x a_y a_z);
-    f_zip4 a_w a_x a_y a_z=[];
-    f_zip5 (a_a:a_v) (a_b:a_w) (a_c:a_x) (a_d:a_y) (a_e:a_z)=(:) (a_a,a_b,a_c,a_d,a_e) (f_zip5 a_v a_w a_x a_y a_z);
-    f_zip5 a_v a_w a_x a_y a_z=[];
-    f_zip6 (a_a:a_u) (a_b:a_v) (a_c:a_w) (a_d:a_x) (a_e:a_y) (a_f:a_z)=(:) (a_a,a_b,a_c,a_d,a_e,a_f) (f_zip6 a_u a_v a_w a_x a_y a_z);
-    f_zip6 a_u a_v a_w a_x a_y a_z=[];
-    f_zip::([t1],[t2]) -> [(t1,t2)];
-    f_zip (a_x,a_y)=f_zip2 a_x a_y;
-    f_main a_x=f_benchmark_main a_x;
-    c_input=(5 :: Int);
-    main = putStr (f_main c_input)
-}
diff --git a/spectral/hartel/wave4main/Main2.hs b/spectral/hartel/wave4main/Main2.hs
deleted file mode 100644 (file)
index c1524b7..0000000
+++ /dev/null
@@ -1,597 +0,0 @@
-module Main (main) -- wave4main
-where {
-
-#include "../Fast2haskell2.hs"
-
-    f_benchmark_main a_n=(++) (f_sumcode (f_output_print (f_solution a_n))) "\n";
-    f_sumcode::[Char] -> [Char];
-    f_sumcode a_xs=
-        let { 
-            f_sumcode' [] a_sum a_n=(++) (show (((+) :: (Int -> Int -> Int)) a_sum a_n)) ((:) '/' (show a_n));
-            f_sumcode' (a_x:a_xs) a_sum a_n=f_sumcode' a_xs (((+) :: (Int -> Int -> Int)) a_sum (fromEnum a_x)) (((+) :: (Int -> Int -> Int)) a_n (1 :: Int))
-         } in  f_sumcode' a_xs (0 :: Int) (0 :: Int);
-type 
-    T_matrix t1=Array_type (Array_type t1);
-    f_descr_print::Descr_type -> [Char];
-    f_descr_print a_d=
-        let { 
-            r_low=lowbound a_d;
-            r_up=upbound a_d
-         } in  (++) "[" ((++) (show r_low) ((++) ".." ((++) (show r_up) "]")));
-    f_array_print::(t1 -> [Char]) -> Char -> (Array_type t1) -> [Char];
-    f_array_print a_pr a_sep a_arr=(++) (f_descr_print (bounds a_arr)) (f_concat [(:) a_sep (a_pr a_n)|a_n<-
-        elems a_arr]);
-    f_matrix_print::(t1 -> [Char]) -> Char -> (T_matrix t1) -> [Char];
-    f_matrix_print a_pr a_sep a_mat=(++) (f_descr_print (bounds a_mat)) (f_concat [(:) a_sep (f_array_print a_pr ',' a_a)|a_a<-
-        elems a_mat]);
-    f_tabulate2::(Int -> Int -> t1) -> Descr_type -> Descr_type -> T_matrix t1;
-    f_tabulate2 a_f a_di a_dj=
-        let { 
-            f_tabhulp a_f a_dj a_i=tabulate (a_f a_i) a_dj
-         } in  tabulate (f_tabhulp a_f a_dj) a_di;
-    f_getdescr2::(T_matrix t1) -> (Descr_type,Descr_type);
-    f_getdescr2 a_arr=
-        let { 
-            r_dx=bounds a_arr;
-            r_dy=bounds ((!) a_arr (lowbound r_dx))
-         } in  (r_dx,r_dy);
-    f_subscript2::T_double_matrix -> Int -> Int -> Double; -- partain:sig changed
-    f_subscript2 a_a a_i a_j=(!) ((!) a_a a_i) a_j;
-    f_transpose2::(T_matrix Double) -> T_matrix Double; -- partain: sig changed
-    f_transpose2 a_arr=
-        let { 
-            (r_dx,r_dy)=f_getdescr2 a_arr;
-            f_subhulp a_arr a_j a_i=f_subscript2 a_arr a_i a_j
-         } in  f_tabulate2 (f_subhulp a_arr) r_dy r_dx;
-    f_updaterange::(T_matrix Double) -> (T_matrix Double) -> T_matrix Double; --partain: sig changed
-    f_updaterange a_a a_b=
-        let { 
-            (r_dax,r_day)=f_getdescr2 a_a
-         } in  f_tabulate2 (f_updatehulp a_a a_b) r_dax r_day;
-    f_updatehulp::(T_matrix Double) -> (T_matrix Double) -> Int -> Int -> Double; -- partain: sig changed
-    f_updatehulp a_a a_b a_i a_j=
-        let { 
-            r_in_bx=f_indexindescr a_i r_dbx;
-            r_in_by=f_indexindescr a_j r_dby;
-            (r_dbx,r_dby)=f_getdescr2 a_b
-         } in  
-            if (
-                if r_in_bx
-                then r_in_by
-                else 
-                    False)
-            then (f_subscript2 a_b a_i a_j)
-            else 
-                (f_subscript2 a_a a_i a_j);
-    f_getleftcol::(T_matrix t1) -> Array_type t1;
-    f_getleftcol a_arr=f_getfirstel a_arr;
-    f_getrightcol::(T_matrix t1) -> Array_type t1;
-    f_getrightcol a_arr=f_getlastel a_arr;
-    f_getbottomrow::(T_matrix t1) -> Array_type t1;
-    f_getbottomrow a_arr=
-        let { 
-            f_getbottomhulp a_arr a_i=f_getfirstel ((!) a_arr a_i)
-         } in  tabulate (f_getbottomhulp a_arr) (bounds a_arr);
-    f_gettoprow::(T_matrix t1) -> Array_type t1;
-    f_gettoprow a_arr=
-        let { 
-            f_gettophulp a_arr a_i=f_getlastel ((!) a_arr a_i)
-         } in  tabulate (f_gettophulp a_arr) (bounds a_arr);
-    f_prependcol::(T_matrix Double) -> (Array_type Double) -> T_matrix Double; -- partain: sig change
-    f_prependcol a_arr a_col=f_prependel a_arr a_col;
-    f_appendcol::(T_matrix Double) -> (Array_type Double) -> T_matrix Double; -- partain: sig changed
-    f_appendcol a_arr a_col=f_appendel a_arr a_col;
-    f_prependrow::(T_matrix t1) -> (Array_type t1) -> T_matrix t1;
-    f_prependrow a_arr a_row=
-        let { 
-            f_prependhulp a_arr a_row a_i=f_prependel ((!) a_arr a_i) ((!) a_row a_i)
-         } in  tabulate (f_prependhulp a_arr a_row) (bounds a_arr);
-    f_appendrow::(T_matrix t1) -> (Array_type t1) -> T_matrix t1;
-    f_appendrow a_arr a_row=
-        let { 
-            f_appendhulp a_arr a_row a_i=f_appendel ((!) a_arr a_i) ((!) a_row a_i)
-         } in  tabulate (f_appendhulp a_arr a_row) (bounds a_arr);
-    f_indexindescr::Int -> Descr_type -> Bool;
-    f_indexindescr a_i a_d=
-        if (((>=) :: (Int -> Int -> Bool)) a_i (lowbound a_d))
-        then (((<=) :: (Int -> Int -> Bool)) a_i (upbound a_d))
-        else 
-            False;
-    f_getfirstel::(Array_type t1) -> t1;
-    f_getfirstel a_arr=(!) a_arr (lowbound (bounds a_arr));
-    f_getlastel::(Array_type t1) -> t1;
-    f_getlastel a_arr=(!) a_arr (upbound (bounds a_arr));
-    f_prependel::(Array_type t1) -> t1 -> Array_type t1;
-    f_prependel a_ar a_x=
-        let { 
-            r_lu=bounds a_ar;
-            r_l=lowbound r_lu;
-            r_u=upbound r_lu;
-            f_generate a_i=
-                if (((<) :: (Int -> Int -> Bool)) a_i r_l)
-                then a_x
-                else 
-                    ((!) a_ar a_i)
-         } in  tabulate f_generate (descr (((-) :: (Int -> Int -> Int)) r_l (1 :: Int)) r_u);
-    f_appendel::(Array_type t1) -> t1 -> Array_type t1;
-    f_appendel a_ar a_x=
-        let { 
-            r_lu=bounds a_ar;
-            r_l=lowbound r_lu;
-            r_u=upbound r_lu;
-            f_generate a_i=
-                if (((>) :: (Int -> Int -> Bool)) a_i r_u)
-                then a_x
-                else 
-                    ((!) a_ar a_i)
-         } in  tabulate f_generate (descr r_l (((+) :: (Int -> Int -> Int)) r_u (1 :: Int)));
-    c_imax,c_jmax,c_imax1,c_jmax1,c_imid,c_imid1,c_jmid,c_jmid1::Int;
-    c_imax=(7 :: Int);
-    c_jmax=(7 :: Int);
-    c_imax1=((+) :: (Int -> Int -> Int)) c_imax (1 :: Int);
-    c_jmax1=((+) :: (Int -> Int -> Int)) c_jmax (1 :: Int);
-    c_imid=((-) :: (Int -> Int -> Int)) (((div) :: (Int -> Int -> Int)) c_imax1 (2 :: Int)) (1 :: Int);
-    c_imid1=((+) :: (Int -> Int -> Int)) c_imid (1 :: Int);
-    c_jmid=((-) :: (Int -> Int -> Int)) (((div) :: (Int -> Int -> Int)) c_jmax1 (2 :: Int)) (1 :: Int);
-    c_jmid1=((+) :: (Int -> Int -> Int)) c_jmid (1 :: Int);
-    c_deltax,c_deltay,c_deltat,c_fcr,c_gam,c_psi,c_gr,c_lbd,c_vwn::Double;
-    c_deltax=(10000.0 :: Double);
-    c_deltay=(10000.0 :: Double);
-    c_deltat=(800.000 :: Double);
-    c_fcr=(0.000125000 :: Double);
-    c_gam=(3.20000e-06 :: Double);
-    c_psi=(0.00000 :: Double);
-    c_gr=(9.80000 :: Double);
-    c_lbd=(0.00240000 :: Double);
-    c_vwn=(0.00000 :: Double);
-type 
-    T_mat=T_matrix Double;
-type 
-    T_col=Array_type Double;
-type 
-    T_row=Array_type Double;
-type 
-    T_triplet=(T_mat,T_mat,T_mat);
-    f_u0::Int -> Int -> Double;
-    f_u0 a_i a_j=(0.00000 :: Double);
-    f_v0::Int -> Int -> Double;
-    f_v0 a_i a_j=(0.00000 :: Double);
-    f_h0::Int -> Int -> Double;
-    f_h0 a_i a_j=((/) :: (Double -> Double -> Double)) (fromIntegral (((*) :: (Int -> Int -> Int)) (3 :: Int) a_i)) (fromIntegral c_imax);
-    f_d::Int -> Int -> Double;
-    f_d a_i a_j=(30.0000 :: Double);
-    c_cux,c_cuy,c_ccr,c_cfr,c_windx,c_windy,c_chx,c_chy::Double;
-    c_cux=((*) :: (Double -> Double -> Double)) c_gr (((/) :: (Double -> Double -> Double)) c_deltat (((*) :: (Double -> Double -> Double)) (2.00000 :: Double) c_deltax));
-    c_cuy=((*) :: (Double -> Double -> Double)) c_gr (((/) :: (Double -> Double -> Double)) c_deltat (((*) :: (Double -> Double -> Double)) (2.00000 :: Double) c_deltay));
-    c_ccr=((*) :: (Double -> Double -> Double)) c_fcr (((/) :: (Double -> Double -> Double)) c_deltat (4.00000 :: Double));
-    c_cfr=((*) :: (Double -> Double -> Double)) (2.00000 :: Double) c_deltat;
-    c_windx=((*) :: (Double -> Double -> Double)) c_gam (((*) :: (Double -> Double -> Double)) c_vwn (((*) :: (Double -> Double -> Double)) c_vwn (((cos) :: (Double -> Double)) c_psi)));
-    c_windy=((*) :: (Double -> Double -> Double)) c_gam (((*) :: (Double -> Double -> Double)) c_vwn (((*) :: (Double -> Double -> Double)) c_vwn (((sin) :: (Double -> Double)) c_psi)));
-    c_chx=((/) :: (Double -> Double -> Double)) c_deltat (((*) :: (Double -> Double -> Double)) (4.00000 :: Double) c_deltax);
-    c_chy=((/) :: (Double -> Double -> Double)) c_deltat (((*) :: (Double -> Double -> Double)) (4.00000 :: Double) c_deltay);
-    f_updu::T_mat -> T_mat -> T_mat -> Int -> Int -> Double;
-    f_updu a_u a_v a_h a_i a_j=
-        let { 
-            r_height=((*) :: (Double -> Double -> Double)) c_cux (((-) :: (Double -> Double -> Double)) (f_subscript2 a_h a_i a_j) (f_subscript2 a_h (((-) :: (Int -> Int -> Int)) a_i (1 :: Int)) a_j));
-            r_coriolis=
-                let { 
-                    r_v1=f_subscript2 a_v (((-) :: (Int -> Int -> Int)) a_i (1 :: Int)) a_j;
-                    r_v2=f_subscript2 a_v (((-) :: (Int -> Int -> Int)) a_i (1 :: Int)) (((+) :: (Int -> Int -> Int)) a_j (1 :: Int));
-                    r_v3=f_subscript2 a_v a_i a_j;
-                    r_v4=f_subscript2 a_v a_i (((+) :: (Int -> Int -> Int)) a_j (1 :: Int))
-                 } in  ((*) :: (Double -> Double -> Double)) c_ccr (((+) :: (Double -> Double -> Double)) r_v1 (((+) :: (Double -> Double -> Double)) r_v2 (((+) :: (Double -> Double -> Double)) r_v3 r_v4)));
-            r_friction=((*) :: (Double -> Double -> Double)) c_cfr (((/) :: (Double -> Double -> Double)) (((-) :: (Double -> Double -> Double)) r_bodem c_windx) (((+) :: (Double -> Double -> Double)) (f_d a_i a_j) (f_d a_i 
-                (((+) :: (Int -> Int -> Int)) a_j (1 :: Int)))));
-            r_bodem=((*) :: (Double -> Double -> Double)) c_lbd (f_subscript2 a_u a_i a_j)
-         } in  
-            if (((==) :: (Int -> Int -> Bool)) a_i (0 :: Int))
-            then (0.00000 :: Double)
-            else 
-            if (((==) :: (Int -> Int -> Bool)) a_i c_imax1)
-            then (0.00000 :: Double)
-            else 
-                (((+) :: (Double -> Double -> Double)) (((-) :: (Double -> Double -> Double)) (f_subscript2 a_u a_i a_j) r_height) (((-) :: (Double -> Double -> Double)) r_coriolis r_friction));
-    f_updv::T_mat -> T_mat -> T_mat -> Int -> Int -> Double;
-    f_updv a_u a_v a_h a_i a_j=
-        let { 
-            r_height=((*) :: (Double -> Double -> Double)) c_cuy (((-) :: (Double -> Double -> Double)) (f_subscript2 a_h a_i a_j) (f_subscript2 a_h a_i (((-) :: (Int -> Int -> Int)) a_j (1 :: Int))));
-            r_coriolis=
-                let { 
-                    r_u1=f_subscript2 a_u a_i (((-) :: (Int -> Int -> Int)) a_j (1 :: Int));
-                    r_u2=f_subscript2 a_u (((+) :: (Int -> Int -> Int)) a_i (1 :: Int)) (((-) :: (Int -> Int -> Int)) a_j (1 :: Int));
-                    r_u3=f_subscript2 a_u a_i a_j;
-                    r_u4=f_subscript2 a_u (((+) :: (Int -> Int -> Int)) a_i (1 :: Int)) a_j
-                 } in  ((*) :: (Double -> Double -> Double)) c_ccr (((+) :: (Double -> Double -> Double)) r_u1 (((+) :: (Double -> Double -> Double)) r_u2 (((+) :: (Double -> Double -> Double)) r_u3 r_u4)));
-            r_friction=((*) :: (Double -> Double -> Double)) c_cfr (((/) :: (Double -> Double -> Double)) (((-) :: (Double -> Double -> Double)) r_bodem c_windy) (((+) :: (Double -> Double -> Double)) (f_d a_i a_j) (f_d 
-                (((+) :: (Int -> Int -> Int)) a_i (1 :: Int)) a_j)));
-            r_bodem=((*) :: (Double -> Double -> Double)) c_lbd (f_subscript2 a_v a_i a_j)
-         } in  
-            if (((==) :: (Int -> Int -> Bool)) a_j (0 :: Int))
-            then (0.00000 :: Double)
-            else 
-            if (((==) :: (Int -> Int -> Bool)) a_j c_jmax1)
-            then (0.00000 :: Double)
-            else 
-                (((-) :: (Double -> Double -> Double)) (((-) :: (Double -> Double -> Double)) (f_subscript2 a_v a_i a_j) r_height) (((+) :: (Double -> Double -> Double)) r_coriolis r_friction));
-    f_updh::T_mat -> T_mat -> T_mat -> Int -> Int -> Double;
-    f_updh a_u a_v a_h a_i a_j=
-        let { 
-            r_d1=((*) :: (Double -> Double -> Double)) (((+) :: (Double -> Double -> Double)) (f_d (((+) :: (Int -> Int -> Int)) a_i (1 :: Int)) a_j) (f_d (((+) :: (Int -> Int -> Int)) a_i (1 :: Int)) 
-                (((+) :: (Int -> Int -> Int)) a_j (1 :: Int)))) (f_subscript2 a_u (((+) :: (Int -> Int -> Int)) a_i (1 :: Int)) a_j);
-            r_d2=((*) :: (Double -> Double -> Double)) (((+) :: (Double -> Double -> Double)) (f_d a_i a_j) (f_d a_i (((+) :: (Int -> Int -> Int)) a_j (1 :: Int)))) (f_subscript2 a_u a_i a_j);
-            r_d3=((*) :: (Double -> Double -> Double)) (((+) :: (Double -> Double -> Double)) (f_d a_i (((+) :: (Int -> Int -> Int)) a_j (1 :: Int))) (f_d (((+) :: (Int -> Int -> Int)) a_i (1 :: Int)) 
-                (((+) :: (Int -> Int -> Int)) a_j (1 :: Int)))) (f_subscript2 a_v a_i (((+) :: (Int -> Int -> Int)) a_j (1 :: Int)));
-            r_d4=((*) :: (Double -> Double -> Double)) (((+) :: (Double -> Double -> Double)) (f_d a_i a_j) (f_d (((+) :: (Int -> Int -> Int)) a_i (1 :: Int)) a_j)) (f_subscript2 a_v a_i a_j)
-         } in  ((-) :: (Double -> Double -> Double)) (((-) :: (Double -> Double -> Double)) (f_subscript2 a_h a_i a_j) (((*) :: (Double -> Double -> Double)) c_chx (((-) :: (Double -> Double -> Double)) r_d1 r_d2))) (((*) :: (Double -> Double -> Double)) c_chy 
-            (((-) :: (Double -> Double -> Double)) r_d3 r_d4));
-    f_printall::[T_triplet] -> [Char];
-    f_printall a_trips=
-        let { 
-            (r_us,r_vs,r_hs)=f_unzip3 a_trips
-         } in  f_printtrip (f_join r_us,f_join r_vs,f_join r_hs);
-    f_printtrip::T_triplet -> [Char];
-    f_printtrip (a_u,a_v,a_h)=
-        let { 
-            r_us=f_matrix_print (f_showfix (3 :: Int)) '\o012' (f_transpose2 a_u);
-            r_vs=f_matrix_print (f_showfix (3 :: Int)) '\o012' (f_transpose2 a_v);
-            r_hs=f_matrix_print (f_showfix (3 :: Int)) '\o012' (f_transpose2 a_h)
-         } in  f_concat ((:) r_us ((:) ((:) '\o012' []) ((:) r_vs ((:) 
-            ((:) '\o012' []) ((:) r_hs ((:) ((:) '\o012' []) []))))));
-    f_showfix::Int -> Double -> [Char];
-    f_showfix a_w a_x=
-        let { 
-            r_sign=
-                if (((<) :: (Double -> Double -> Bool)) a_x (0.00000 :: Double))
-                then '-'
-                else 
-                    ' ';
-            r_i=floor (entier (((+) :: (Double -> Double -> Double)) (0.500000 :: Double) (f_abs (((*) :: (Double -> Double -> Double)) a_x (100.000 :: Double)))));
-            r_d3_c=toEnum (((+) :: (Int -> Int -> Int)) (fromEnum '0') (((rem) :: (Int -> Int -> Int)) r_i (10 :: Int)));
-            r_d2_c=toEnum (((+) :: (Int -> Int -> Int)) (fromEnum '0') (((rem) :: (Int -> Int -> Int)) (((div) :: (Int -> Int -> Int)) r_i (10 :: Int)) (10 :: Int)));
-            r_d1_c=toEnum (((+) :: (Int -> Int -> Int)) (fromEnum '0') (((rem) :: (Int -> Int -> Int)) (((div) :: (Int -> Int -> Int)) r_i (100 :: Int)) (10 :: Int)))
-         } in  
-            if (((>) :: (Int -> Int -> Bool)) r_i (999 :: Int))
-            then "*****"
-            else 
-                ((:) r_sign ((:) r_d1_c ((:) '.' ((:) r_d2_c ((:) r_d3_c [])))));
-    f_join::[T_mat] -> T_mat;
-    f_join a_ranges=
-        let { 
-            r_arr=f_tabulate2 f_zero2 (descr (0 :: Int) c_imax) (descr (0 :: Int) c_jmax)
-         } in  f_foldl f_updaterange r_arr a_ranges;
-    f_zero2::Int -> Int -> Double;
-    f_zero2 a_i a_j=(0.00000 :: Double);
-    f_unzip3::[(t1,t2,t3)] -> ([t1],[t2],[t3]);
-    f_unzip3 []=([],[],[]);
-    f_unzip3 ((a_u,a_v,a_h):a_ts)=
-        let { 
-            (r_us,r_vs,r_hs)=f_unzip3 a_ts
-         } in  ((:) a_u r_us,(:) a_v r_vs,(:) a_h r_hs);
-type 
-    T_double_matrix=T_matrix Double;
-type 
-    T_double_array=Array_type Double;
-type 
-    T_double_matrix_triple=(T_double_matrix,T_double_matrix,T_double_matrix);
-type 
-    T_double_array_tuple=(T_double_array,T_double_array);
-type 
-    T_double_matrix_triple_pair=(T_double_matrix_triple,T_double_matrix_triple);
-    f_matrix_first_col a_m=f_getleftcol a_m;
-    f_matrix_last_col a_m=f_getrightcol a_m;
-    -- partain: sig
-    f_matrix_tab ::(Int -> Int -> Double) -> (Descr_type, Descr_type) -> T_double_matrix;
-    f_matrix_tab a_f (a_dx,a_dy)=f_tabulate2 a_f a_dx a_dy;
-    f_matrix_append_col a_m a_c=f_appendcol a_m a_c;
-    f_matrix_prepend_col a_m a_c=f_prependcol a_m a_c;
-    f_matrix_sub a_m a_i a_j=f_subscript2 a_m a_i a_j;
-    f_solution::Int -> T_double_matrix_triple_pair;
-    f_solution a_n=f_prog c_mf0 c_mg0 (f_first_borders c_mg0) a_n;
-    f_prog::T_double_matrix_triple -> T_double_matrix_triple -> T_double_array_tuple -> Int -> T_double_matrix_triple_pair;
-    f_prog a_mfh a_mgh a_mghds 0=(a_mfh,a_mgh);
-    f_prog a_mfh a_mgh a_mghds a_n=
-        let { 
-            r_mfh'=f_fvh r_mfu;
-            r_mghds'=f_first_borders r_mgh';
-            r_mgh'=f_gvh r_mgu r_mfulst;
-            r_mfulst=f_last_borders r_mfu;
-            r_mfu=f_fu a_mfh a_mghds;
-            r_mgu=f_gu a_mgh
-         } in  f_prog r_mfh' r_mgh' r_mghds' (((-) :: (Int -> Int -> Int)) a_n (1 :: Int));
-    c_mf0,c_mg0::T_double_matrix_triple;
-    c_mf0=(c_ul0,c_vl0,c_hl0);
-    c_mg0=(c_ur0,c_vr0,c_hr0);
-    f_fvh::T_double_matrix_triple -> T_double_matrix_triple;
-    f_fvh a_mfu=f_fh (f_fv a_mfu);
-    f_gvh::T_double_matrix_triple -> T_double_array -> T_double_matrix_triple;
-    f_gvh a_mgu a_mfulst=f_gh (f_gv a_mgu a_mfulst) a_mfulst;
-    f_first_borders::T_double_matrix_triple -> T_double_array_tuple;
-    f_first_borders (a_u,a_v,a_h)=(f_matrix_first_col a_v,f_matrix_first_col a_h);
-    f_last_borders::T_double_matrix_triple -> T_double_array;
-    f_last_borders (a_u,a_v,a_h)=f_matrix_last_col a_u;
-    f_fu::T_double_matrix_triple -> T_double_array_tuple -> T_double_matrix_triple;
-    f_fu (a_u,a_v,a_h) (a_vc,a_hc)=
-        let { 
-            r_u1=f_matrix_tab (f_updu a_u (f_matrix_append_col a_v a_vc) (f_matrix_append_col a_h a_hc)) c_dul
-         } in  (r_u1,a_v,a_h);
-    f_fv::T_double_matrix_triple -> T_double_matrix_triple;
-    f_fv (a_u,a_v,a_h)=
-        let { 
-            r_v1=f_matrix_tab (f_updv a_u a_v a_h) c_dvl
-         } in  (a_u,r_v1,a_h);
-    f_fh::T_double_matrix_triple -> T_double_matrix_triple;
-    f_fh (a_u,a_v,a_h)=
-        let { 
-            r_h1=f_matrix_tab (f_updh a_u a_v a_h) c_dhl
-         } in  (a_u,a_v,r_h1);
-    f_gu::T_double_matrix_triple -> T_double_matrix_triple;
-    f_gu (a_u,a_v,a_h)=
-        let { 
-            r_u1=f_matrix_tab (f_updu a_u a_v a_h) c_dur
-         } in  (r_u1,a_v,a_h);
-    f_gv::T_double_matrix_triple -> T_double_array -> T_double_matrix_triple;
-    f_gv (a_u,a_v,a_h) a_uc=
-        let { 
-            r_v1=f_matrix_tab (f_updv (f_matrix_prepend_col a_u a_uc) a_v a_h) c_dvr
-         } in  (a_u,r_v1,a_h);
-    f_gh::T_double_matrix_triple -> T_double_array -> T_double_matrix_triple;
-    f_gh (a_u,a_v,a_h) a_uc=
-        let { 
-            r_h1=f_matrix_tab (f_updh (f_matrix_prepend_col a_u a_uc) a_v a_h) c_dhr
-         } in  (a_u,a_v,r_h1);
-    c_k::Int;
-    c_k=((div) :: (Int -> Int -> Int)) c_imax1 (2 :: Int);
-    c_dul,c_dvl,c_dhl,c_dur,c_dvr,c_dhr::(Descr_type,Descr_type);
-    c_dul=(descr (0 :: Int) c_k,descr (0 :: Int) c_jmax);
-    c_dvl=(descr (0 :: Int) (((-) :: (Int -> Int -> Int)) c_k (1 :: Int)),descr (0 :: Int) c_jmax1);
-    c_dhl=(descr (0 :: Int) (((-) :: (Int -> Int -> Int)) c_k (1 :: Int)),descr (0 :: Int) c_jmax);
-    c_dur=(descr (((+) :: (Int -> Int -> Int)) c_k (1 :: Int)) c_imax1,descr (0 :: Int) c_jmax);
-    c_dvr=(descr c_k c_imax,descr (0 :: Int) c_jmax1);
-    c_dhr=(descr c_k c_imax,descr (0 :: Int) c_jmax);
-    c_ul0,c_vl0,c_hl0,c_ur0,c_vr0,c_hr0::T_double_matrix;
-    c_ul0=f_matrix_tab f_u0 c_dul;
-    c_vl0=f_matrix_tab f_v0 c_dvl;
-    c_hl0=f_matrix_tab f_h0 c_dhl;
-    c_ur0=f_matrix_tab f_u0 c_dur;
-    c_vr0=f_matrix_tab f_v0 c_dvr;
-    c_hr0=f_matrix_tab f_h0 c_dhr;
-    f_output_print::T_double_matrix_triple_pair -> [Char];
-    f_output_print ((a_lu,a_lv,a_lh),(a_ru,a_rv,a_rh))=f_concat [(++) (f_matrix_print (f_showfix (2 :: Int)) '\o012' a_m) "\n"|a_m<-(:) a_lu ((:) a_ru 
-        ((:) a_lv ((:) a_rv ((:) a_lh ((:) a_rh [])))))];
-    f_abs::Double -> Double;
-    f_abs a_x=
-        if (((<=) :: (Double -> Double -> Bool)) a_x (0.00000 :: Double))
-        then (((negate) :: (Double -> Double)) a_x)
-        else 
-            a_x;
-    f_and::[Bool] -> Bool;
-    f_and a_xs=f_foldr (&&) True a_xs;
-    f_cjustify::Int -> [Char] -> [Char];
-    f_cjustify a_n a_s=
-        let { 
-            r_margin=((-) :: (Int -> Int -> Int)) a_n (length a_s);
-            r_lmargin=((div) :: (Int -> Int -> Int)) r_margin (2 :: Int);
-            r_rmargin=((-) :: (Int -> Int -> Int)) r_margin r_lmargin
-         } in  (++) (f_spaces r_lmargin) ((++) a_s (f_spaces r_rmargin));
-    f_concat::[[t1]] -> [t1];
-    f_concat a_xs=f_foldr (++) [] a_xs;
-    f_const::t1 -> t2 -> t1;
-    f_const a_x a_y=a_x;
-    f_digit::Char -> Bool;
-    f_digit a_x=
-        if (((<=) :: (Int -> Int -> Bool)) (fromEnum '0') (fromEnum a_x))
-        then (((<=) :: (Int -> Int -> Bool)) (fromEnum a_x) (fromEnum '9'))
-        else 
-            False;
-    f_drop::Int -> [t1] -> [t1];
-    f_drop 0 a_x=a_x;
-    f_drop a_n (a_a:a_x)=f_drop (((-) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x;
-    f_drop a_n a_x=[];
-    f_dropwhile::(t1 -> Bool) -> [t1] -> [t1];
-    f_dropwhile a_f []=[];
-    f_dropwhile a_f (a_a:a_x)=
-        if (a_f a_a)
-        then (f_dropwhile a_f a_x)
-        else 
-            ((:) a_a a_x);
-    c_e::Double;
-    c_e=((exp) :: (Double -> Double)) (1.00000 :: Double);
-    f_filter::(t1 -> Bool) -> [t1] -> [t1];
-    f_filter a_f a_x=[a_a|a_a<-a_x,a_f a_a];
-    f_foldl::(t1 -> t2 -> t1) -> t1 -> [t2] -> t1;
-    f_foldl a_op a_r []=a_r;
-    f_foldl a_op a_r (a_a:a_x)=
-        let { 
-            f_strict a_f a_x=seq a_x (a_f a_x)
-         } in  f_foldl a_op (f_strict a_op a_r a_a) a_x;
-    f_foldl1::(t1 -> t1 -> t1) -> [t1] -> t1;
-    f_foldl1 a_op (a_a:a_x)=f_foldl a_op a_a a_x;
-    f_foldr::(t1 -> t2 -> t2) -> t2 -> [t1] -> t2;
-    f_foldr a_op a_r []=a_r;
-    f_foldr a_op a_r (a_a:a_x)=a_op a_a (f_foldr a_op a_r a_x);
-    f_foldr1::(t1 -> t1 -> t1) -> [t1] -> t1;
-    f_foldr1 a_op (a_a:[])=a_a;
-    f_foldr1 a_op (a_a:a_b:a_x)=a_op a_a (f_foldr1 a_op ((:) a_b a_x));
-    f_fst::(t1,t2) -> t1;
-    f_fst (a_a,a_b)=a_a;
-    f_id::t1 -> t1;
-    f_id a_x=a_x;
-    f_index::[t1] -> [Int];
-    f_index a_x=
-        let { 
-            f_f a_n []=[];
-            f_f a_n (a_a:a_x)=(:) a_n (f_f (((+) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x)
-         } in  f_f (0 :: Int) a_x;
-    f_init::[t1] -> [t1];
-    f_init (a_a:a_x)=
-        if (null a_x)
-        then []
-        else 
-            ((:) a_a (f_init a_x));
-    f_iterate::(t1 -> t1) -> t1 -> [t1];
-    f_iterate a_f a_x=(:) a_x (f_iterate a_f (a_f a_x));
-    f_last::[t1] -> t1;
-    f_last a_x=(!!) a_x (((-) :: (Int -> Int -> Int)) (length a_x) (1 :: Int));
-    f_lay::[[Char]] -> [Char];
-    f_lay []=[];
-    f_lay (a_a:a_x)=(++) a_a ((++) "\n" (f_lay a_x));
-    f_layn::[[Char]] -> [Char];
-    f_layn a_x=
-        let { 
-            f_f a_n []=[];
-            f_f a_n (a_a:a_x)=(++) (f_rjustify (4 :: Int) (show a_n)) ((++) ") " ((++) a_a ((++) "\n" 
-                (f_f (((+) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x))))
-         } in  f_f (1 :: Int) a_x;
-    f_letter::Char -> Bool;
-    f_letter a_c=
-        if (
-            if (((<=) :: (Int -> Int -> Bool)) (fromEnum 'a') (fromEnum a_c))
-            then (((<=) :: (Int -> Int -> Bool)) (fromEnum a_c) (fromEnum 'z'))
-            else 
-                False)
-        then True
-        else 
-        if (((<=) :: (Int -> Int -> Bool)) (fromEnum 'A') (fromEnum a_c))
-        then (((<=) :: (Int -> Int -> Bool)) (fromEnum a_c) (fromEnum 'Z'))
-        else 
-            False;
-    f_limit::[Double] -> Double;
-    f_limit (a_a:a_b:a_x)=
-        if (((==) :: (Double -> Double -> Bool)) a_a a_b)
-        then a_a
-        else 
-            (f_limit ((:) a_b a_x));
-    f_lines::[Char] -> [[Char]];
-    f_lines []=[];
-    f_lines (a_a:a_x)=
-        let { 
-            r_xs=
-                if (pair a_x)
-                then (f_lines a_x)
-                else 
-                    ((:) [] [])
-         } in  
-            if (((==) :: (Int -> Int -> Bool)) (fromEnum a_a) (fromEnum '\o012'))
-            then ((:) [] (f_lines a_x))
-            else 
-                ((:) ((:) a_a (head r_xs)) (tail r_xs));
-    f_ljustify::Int -> [Char] -> [Char];
-    f_ljustify a_n a_s=(++) a_s (f_spaces (((-) :: (Int -> Int -> Int)) a_n (length a_s)));
-    f_map::(t1 -> t2) -> [t1] -> [t2];
-    f_map a_f a_x=[a_f a_a|a_a<-a_x];
-    f_map2::(t1 -> t2 -> t3) -> [t1] -> [t2] -> [t3];
-    f_map2 a_f a_x a_y=[a_f a_a a_b|(a_a,a_b)<-f_zip2 a_x a_y];
-    f_max::[Int] -> Int;
-    f_max a_xs=f_foldl1 f_max2 a_xs;
-    f_max2::Int -> Int -> Int;
-    f_max2 a_a a_b=
-        if (((>=) :: (Int -> Int -> Bool)) a_a a_b)
-        then a_a
-        else 
-            a_b;
-    f_member::[Int] -> Int -> Bool;
-    f_member a_x a_a=f_or (f_map (flip ((==) :: (Int -> Int -> Bool)) a_a) a_x);
-    f_merge::[Int] -> [Int] -> [Int];
-    f_merge [] a_y=a_y;
-    f_merge (a_a:a_x) []=(:) a_a a_x;
-    f_merge (a_a:a_x) (a_b:a_y)=
-        if (((<=) :: (Int -> Int -> Bool)) a_a a_b)
-        then ((:) a_a (f_merge a_x ((:) a_b a_y)))
-        else 
-            ((:) a_b (f_merge ((:) a_a a_x) a_y));
-    f_min::[Int] -> Int;
-    f_min a_xs=f_foldl1 f_min2 a_xs;
-    f_min2::Int -> Int -> Int;
-    f_min2 a_a a_b=
-        if (((>) :: (Int -> Int -> Bool)) a_a a_b)
-        then a_b
-        else 
-            a_a;
-    f_mkset::[Int] -> [Int];
-    f_mkset []=[];
-    f_mkset (a_a:a_x)=(:) a_a (f_filter (flip ((/=) :: (Int -> Int -> Bool)) a_a) (f_mkset a_x));
-    f_or::[Bool] -> Bool;
-    f_or a_xs=f_foldr (||) False a_xs;
-    c_pi::Double;
-    c_pi=((*) :: (Double -> Double -> Double)) (4.00000 :: Double) (((atan) :: (Double -> Double)) (1.00000 :: Double));
-    f_postfix::t1 -> [t1] -> [t1];
-    f_postfix a_a a_x=(++) a_x ((:) a_a []);
-    f_product::[Int] -> Int;
-    f_product a_xs=f_foldl ((*) :: (Int -> Int -> Int)) (1 :: Int) a_xs;
-    f_rep::Int -> t1 -> [t1];
-    f_rep a_n a_x=f_take a_n (f_repeat a_x);
-    f_repeat::t1 -> [t1];
-    f_repeat a_x=(:) a_x (f_repeat a_x);
-    f_reverse::[t1] -> [t1];
-    f_reverse a_xs=f_foldl (flip (:)) [] a_xs;
-    f_rjustify::Int -> [Char] -> [Char];
-    f_rjustify a_n a_s=(++) (f_spaces (((-) :: (Int -> Int -> Int)) a_n (length a_s))) a_s;
-    f_scan::(t1 -> t2 -> t1) -> t1 -> [t2] -> [t1];
-    f_scan a_op=
-        let { 
-            f_g a_r []=(:) a_r [];
-            f_g a_r (a_a:a_x)=(:) a_r (f_g (a_op a_r a_a) a_x)
-         } in  f_g;
-    f_snd::(t1,t2) -> t2;
-    f_snd (a_a,a_b)=a_b;
-    f_sort::[Int] -> [Int];
-    f_sort a_x=
-        let { 
-            r_n=length a_x;
-            r_n2=((div) :: (Int -> Int -> Int)) r_n (2 :: Int)
-         } in  
-            if (((<=) :: (Int -> Int -> Bool)) r_n (1 :: Int))
-            then a_x
-            else 
-                (f_merge (f_sort (f_take r_n2 a_x)) (f_sort (f_drop r_n2 a_x)));
-    f_spaces::Int -> [Char];
-    f_spaces a_n=f_rep a_n ' ';
-    f_subtract::Int -> Int -> Int;
-    f_subtract a_x a_y=((-) :: (Int -> Int -> Int)) a_y a_x;
-    f_sum::[Int] -> Int;
-    f_sum a_xs=f_foldl ((+) :: (Int -> Int -> Int)) (0 :: Int) a_xs;
-data 
-    T_sys_message=F_Stdout [Char] | F_Stderr [Char] | F_Tofile [Char] [Char] | F_Closefile [Char] | F_Appendfile [Char] | F_System [Char] | F_Exit Int;
-    f_take::Int -> [t1] -> [t1];
-    f_take 0 a_x=[];
-    f_take a_n (a_a:a_x)=(:) a_a (f_take (((-) :: (Int -> Int -> Int)) a_n (1 :: Int)) a_x);
-    f_take a_n a_x=[];
-    f_takewhile::(t1 -> Bool) -> [t1] -> [t1];
-    f_takewhile a_f []=[];
-    f_takewhile a_f (a_a:a_x)=
-        if (a_f a_a)
-        then ((:) a_a (f_takewhile a_f a_x))
-        else 
-            [];
-    f_transpose::[[t1]] -> [[t1]];
-    f_transpose a_x=
-        let { 
-            r_x'=f_takewhile pair a_x
-         } in  
-            if (null r_x')
-            then []
-            else 
-                ((:) (f_map head r_x') (f_transpose (f_map tail r_x')));
-    f_until::(t1 -> Bool) -> (t1 -> t1) -> t1 -> t1;
-    f_until a_f a_g a_x=
-        if (a_f a_x)
-        then a_x
-        else 
-            (f_until a_f a_g (a_g a_x));
-    f_zip2::[t1] -> [t2] -> [(t1,t2)];
-    f_zip2 (a_a:a_x) (a_b:a_y)=(:) (a_a,a_b) (f_zip2 a_x a_y);
-    f_zip2 a_x a_y=[];
-    f_zip3 (a_a:a_x) (a_b:a_y) (a_c:a_z)=(:) (a_a,a_b,a_c) (f_zip3 a_x a_y a_z);
-    f_zip3 a_x a_y a_z=[];
-    f_zip4 (a_a:a_w) (a_b:a_x) (a_c:a_y) (a_d:a_z)=(:) (a_a,a_b,a_c,a_d) (f_zip4 a_w a_x a_y a_z);
-    f_zip4 a_w a_x a_y a_z=[];
-    f_zip5 (a_a:a_v) (a_b:a_w) (a_c:a_x) (a_d:a_y) (a_e:a_z)=(:) (a_a,a_b,a_c,a_d,a_e) (f_zip5 a_v a_w a_x a_y a_z);
-    f_zip5 a_v a_w a_x a_y a_z=[];
-    f_zip6 (a_a:a_u) (a_b:a_v) (a_c:a_w) (a_d:a_x) (a_e:a_y) (a_f:a_z)=(:) (a_a,a_b,a_c,a_d,a_e,a_f) (f_zip6 a_u a_v a_w a_x a_y a_z);
-    f_zip6 a_u a_v a_w a_x a_y a_z=[];
-    f_zip::([t1],[t2]) -> [(t1,t2)];
-    f_zip (a_x,a_y)=f_zip2 a_x a_y;
-    f_main a_x=f_benchmark_main a_x;
-    c_input=(4000 :: Int);
-    main = putStr (f_main c_input)
-}