ghc/tests/programs/fast2haskell/Fast2haskell.hs

   1        module Fast2haskell (
   2             Complex_type, Array_type, Assoc_type, Descr_type,
   3             abortstr, delay, fix, force, iff, iffrev, seQ,
   4             pair, strcmp,
   5             entier,
   6             land_i, lnot_i, lor_i, lshift_i, rshift_i,
   7             descr,
   8             destr_update, indassoc, lowbound, tabulate, upbound, update, valassoc) where {
   9             import Word2;
  10             import Complex; -- 1.3
  11             import Array; -- 1.3
  12             type Complex_type   = Complex Double;
  13             type Array_type b   = Array Int b;
  14             type Assoc_type a   = (Int, a);
  15             type Descr_type     = (Int,Int);
  16             abortstr      str                 = error ("abort:"++str); -- abort (OtherError str);
  17             delay         x                   = abortstr "delay not implemented";
  18             fix           f                   = fix_f where {fix_f = f fix_f};
  19             force         x                   = x; -- error  "force not implemented";
  20             iff           b     x  y          = if b then x else y;
  21             iffrev        y  x      b         = if b then x else y;
  22             seQ           x    y              = seq_const y (x{-#STRICT-});
  23             seq_const     x    y              = x ;
  24             pair          []                  = False;
  25             pair          x                   = True;
  26             strcmp        :: [Char] -> [Char] -> Bool;
  27             strcmp        x      y            = x == y;
  28             entier        x                   = fromIntegral (floor x);
  29             land_i        :: Int -> Int -> Int;
  30             land_i        x    y              = wordToInt (bitAnd (fromInt x) (fromInt y));
  31             lnot_i        :: Int -> Int;
  32             lnot_i        x                   = wordToInt (bitCompl (fromInt x));
  33             lor_i         :: Int -> Int -> Int;
  34             lor_i         x    y              = wordToInt (bitOr (fromInt x) (fromInt y));
  35             lshift_i      :: Int -> Int -> Int;
  36             lshift_i      x    y              = wordToInt (bitLsh (fromInt x) y);
  37             rshift_i      :: Int -> Int -> Int;
  38             rshift_i      x    y              = wordToInt (bitRsh (fromInt x) y);
  39             write         x                   = abortstr "write not implemented";
  40             descr         l    u              = (l,u);
  41             destr_update  ar  i  x            = ar // [(i,x)];
  42             indassoc      (i,v)              = i;
  43             lowbound      (l,u)               = l;
  44             tabulate      f (l,u)             = listArray (l,u) [f i | i <- [l..u]];
  45             upbound       (l,u)               = u;
  46             update        ar i x              = ar // [(i,x)];
  47             valassoc      (i,v)               = v;
  48        }