[project @ 1997-03-14 08:02:40 by simonpj]
[nofib.git] / spectral / hartel / Fast2haskell.hs
1
2 import GHC;
3 import PrelBase ( Int(..) );
4 import Complex;
5 import Array;
6
7 type Complex_type = Complex Double;
8 type Array_type b = Array Int b;
9 type Assoc_type a = (Int,a);
10 type Descr_type = (Int,Int);
11
12 w2i x = word2Int# x;
13 i2w x = int2Word# x;
14
15 abortstr str = error ("abort:" ++ str);
16
17 delay x = abortstr "delay not implemented";
18
19 fix :: (x -> x) -> x;
20 fix f = fix_f where {fix_f = f fix_f};
21
22 force x = x; -- error "force not implemented"
23
24 iff :: Bool -> x -> x -> x;
25 iff b x y = if b then x else y;
26
27 iffrev :: x -> x -> Bool -> x;
28 iffrev y x b = if b then x else y;
29
30 miraseq :: x -> y -> y;
31 miraseq x y = seq_const y x; -- x should be marked #STRICT
32 seq_const x y = x;
33
34 pair :: [x] -> Bool;
35 pair [] = False;
36 pair x = True;
37
38 entier :: Double -> Double;
39 entier x = fromIntegral (floor x);
40
41 land_i :: Int -> Int -> Int;
42 land_i (I# x) (I# y) = I# (w2i (and# (i2w x) (i2w y)));
43
44 lnot_i :: Int -> Int;
45 lnot_i (I# x) = I# (w2i (not# (i2w x)));
46
47 lor_i :: Int -> Int -> Int;
48 lor_i (I# x) (I# y) = I# (w2i (or# (i2w x) (i2w y)));
49
50 lshift_i :: Int -> Int -> Int;
51 lshift_i (I# x) (I# y) = I# (w2i (shiftL# (i2w x) y));
52
53 rshift_i :: Int -> Int -> Int;
54 rshift_i (I# x) (I# y) = I# (w2i (shiftRL# (i2w x) y));
55
56 write x = abortstr "write not implemented";
57
58 descr :: Int -> Int -> Descr_type;
59 descr l u = (l,u);
60
61 destr_update :: Array_type x -> Int -> x -> Array_type x;
62 destr_update ar i x = ar // [(i,x)];
63
64 indassoc :: Assoc_type x -> Int;
65 indassoc (i,v) = i;
66
67 lowbound :: Descr_type -> Int;
68 lowbound (l,u) = l;
69
70 tabulate :: (Int -> x) -> Descr_type -> Array_type x;
71 tabulate f (l,u) = array (l,u) [(i, f i) | i <- [l..u]];
72
73 upbound :: Descr_type -> Int;
74 upbound (l,u) = u;
75
76 update :: Array_type x -> Int -> x -> Array_type x;
77 update ar i x = ar // [(i,x)];
78
79 valassoc :: Assoc_type x -> x;
80 valassoc (i,v) = v;