[project @ 1996-11-26 15:44:35 by dnt]

Merged in changes from new-build-system branch

GHC_ONLY/bugs/sanders_array/Main-ORIG.hs

-{-
-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.
--}

GHC_ONLY/cg015/Main2.hs

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

GHC_ONLY/cg015/Main3.hs

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

GHC_ONLY/cg015/Main4.hs

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

Jmakefile

-#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

Makefile

+# $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

imaginary/primes/Main2.hs

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

mk/nofib.mk

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

mk/site.mk

+#-----------------------------------------------------------------------------
+# $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 =

real/Makefile

+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

real/anna/Main.hs

@@ -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
--}
 
 --==========================================================--
 --

real/anna/Makefile

+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

real/bspt/Makefile

+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

real/fulsom/Fulsom.hi

-interface Fulsom where {
-{-# IMPORTING Shapes, Quad, Raster, Oct, Interval, Types #-}
-main :: Dialogue   {-# ARITY main = 1 #-}{-# STRICTNESS main = "T,T" ST #-}
-}

real/parser/Main-GHC.hs

-
---==========================================================--
---=== 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
-