2 % (c) The AQUA Project, Glasgow University, 1994-2000
6 {-# OPTIONS -fno-implicit-prelude #-}
13 hugsprimPmFromInteger,
16 hugsprimRunIO_toplevel,
20 hugsprimCreateAdjThunk
26 import PrelReal(Integral)
27 import Prelude(fromIntegral)
29 import PrelException(catch)
30 import PrelIOBase(IO,unsafePerformIO)
32 import PrelFloat(Double)
33 import PrelReal(Fractional,fromRational,toRational)
37 -- Stuff needed by Hugs for desugaring. Do not mess with these!
38 -- They need to correspond exactly to versions written in
39 -- the Hugs standalone Prelude.
41 --hugs doesn't know about RealWorld and so throws this
42 --away if the original type signature is used
43 --hugsprimMkIO :: (RealWorld -> (a,RealWorld)) -> IO a
44 hugsprimMkIO :: (rw -> (a,rw)) -> IO a
46 = error "hugsprimMkIO in combined mode: unimplemented"
48 hugsprimCreateAdjThunk :: (a -> b) -> String -> Char -> IO Addr
49 hugsprimCreateAdjThunk fun typestr callconv
50 = error "hugsprimCreateAdjThunk in combined mode: unimplemented"
52 fromDouble :: Fractional a => Double -> a
53 fromDouble n = fromRational (toRational n)
55 hugsprimEqChar :: Char -> Char -> Bool
56 hugsprimEqChar c1 c2 = c1 == c2
58 hugsprimPmInt :: Num a => Int -> a -> Bool
59 hugsprimPmInt n x = fromInt n == x
61 hugsprimPmInteger :: Num a => Integer -> a -> Bool
62 hugsprimPmInteger n x = fromInteger n == x
64 hugsprimPmDouble :: Fractional a => Double -> a -> Bool
65 hugsprimPmDouble n x = fromDouble n == x
67 -- The following primitives are only needed if (n+k) patterns are enabled:
68 hugsprimPmSub :: Integral a => Int -> a -> a
69 hugsprimPmSub n x = x - fromInt n
71 hugsprimPmFromInteger :: Integral a => Integer -> a
72 hugsprimPmFromInteger = fromIntegral
74 hugsprimPmSubtract :: Integral a => a -> a -> a
75 hugsprimPmSubtract x y = x - y
77 hugsprimPmLe :: Integral a => a -> a -> Bool
78 hugsprimPmLe x y = x <= y
80 -- used when Hugs invokes top level function
82 hugsprimRunIO_toplevel :: IO a -> ()
83 hugsprimRunIO_toplevel m
84 = protect 5 (fst (unST composite_action realWorld))
87 = do writeIORef prelCleanupAfterRunAction Nothing
89 cleanup_handles <- readIORef prelCleanupAfterRunAction
90 case cleanup_handles of
94 realWorld = error "primRunIO: entered the RealWorld"
95 protect :: Int -> () -> ()
99 = primCatch (protect (n-1) comp)
100 (\e -> fst (unST (putStr (show e ++ "\n")) realWorld))
102 hugsprimRunIO_toplevel :: IO a -> ()
103 hugsprimRunIO_toplevel m
105 catch (m >> return ())
106 (\e -> putStr (show e ++ "\n"))