Commit a85d9a02 authored by sewardj's avatar sewardj
Browse files

[project @ 2000-01-10 17:19:32 by sewardj]

Back out previous commit.
parent 810bbf81
......@@ -1545,9 +1545,6 @@ readFloat r = [(fromRational ((n%1)*10^^(k-d)),t) | (n,d,s) <- readFix r,
-- Hooks for primitives: -----------------------------------------------------
-- Do not mess with these!
-- Anything named hugsprim needs to also be available in combined mode,
-- so any such function is also present in ghc/lib/std/PrelHugs.lhs.
primCompAux :: Ord a => a -> a -> Ordering -> Ordering
primCompAux x y o = case compare x y of EQ -> o; LT -> LT; GT -> GT
......@@ -1560,6 +1557,21 @@ hugsprimPmInteger n x = fromInteger n == x
primPmDouble :: Fractional a => Double -> a -> Bool
primPmDouble n x = fromDouble n == x
-- ToDo: make the message more informative.
primPmFail :: a
primPmFail = error "Pattern Match Failure"
-- used in desugaring Foreign functions
hugsprimMkIO :: (RealWorld -> (a,RealWorld)) -> IO a
hugsprimMkIO = ST
hugsprimCreateAdjThunk :: (a -> b) -> String -> Char -> IO Addr
hugsprimCreateAdjThunk fun typestr callconv
= do sp <- makeStablePtr fun
p <- copy_String_to_cstring typestr -- is never freed
a <- primCreateAdjThunkARCH sp p callconv
return a
-- The following primitives are only needed if (n+k) patterns are enabled:
hugsprimPmSub :: Integral a => Int -> a -> a
hugsprimPmSub n x = x - fromInt n
......@@ -1573,21 +1585,6 @@ hugsprimPmSubtract x y = x - y
hugsprimPmLe :: Integral a => a -> a -> Bool
hugsprimPmLe x y = x <= y
-- ToDo: make the message more informative.
primPmFail :: a
primPmFail = error "Pattern Match Failure"
-- used in desugaring Foreign functions
primMkIO :: (RealWorld -> (a,RealWorld)) -> IO a
primMkIO = ST
primCreateAdjThunk :: (a -> b) -> String -> Char -> IO Addr
primCreateAdjThunk fun typestr callconv
= do sp <- makeStablePtr fun
p <- copy_String_to_cstring typestr -- is never freed
a <- primCreateAdjThunkARCH sp p callconv
return a
-- Unpack strings generated by the Hugs code generator.
-- Strings can contain \0 provided they're coded right.
--
......
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: link.c,v $
* $Revision: 1.30 $
* $Date: 2000/01/10 17:06:41 $
* $Revision: 1.31 $
* $Date: 2000/01/10 17:19:33 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......@@ -439,7 +439,7 @@ Void linkPreludeNames(void) { /* Hook to names defined in Prelude */
setCurrModule(modulePrelude);
/* primops */
nameMkIO = linkName("primMkIO");
nameMkIO = linkName("hugsprimMkIO");
for (i=0; asmPrimOps[i].name; ++i) {
Text t = findText(asmPrimOps[i].name);
Name n = findName(t);
......@@ -470,7 +470,7 @@ Void linkPreludeNames(void) { /* Hook to names defined in Prelude */
# endif
/* translator */
nameEqChar = linkName("primEqChar");
nameCreateAdjThunk = linkName("primCreateAdjThunk");
nameCreateAdjThunk = linkName("hugsprimCreateAdjThunk");
namePmInt = linkName("hugsprimPmInt");
namePmInteger = linkName("hugsprimPmInteger");
namePmDouble = linkName("primPmDouble");
......
......@@ -9,8 +9,8 @@
* included in the distribution.
*
* $RCSfile: storage.c,v $
* $Revision: 1.35 $
* $Date: 2000/01/10 17:06:41 $
* $Revision: 1.36 $
* $Date: 2000/01/10 17:19:32 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
......
......@@ -1545,9 +1545,6 @@ readFloat r = [(fromRational ((n%1)*10^^(k-d)),t) | (n,d,s) <- readFix r,
-- Hooks for primitives: -----------------------------------------------------
-- Do not mess with these!
-- Anything named hugsprim needs to also be available in combined mode,
-- so any such function is also present in ghc/lib/std/PrelHugs.lhs.
primCompAux :: Ord a => a -> a -> Ordering -> Ordering
primCompAux x y o = case compare x y of EQ -> o; LT -> LT; GT -> GT
......@@ -1560,6 +1557,21 @@ hugsprimPmInteger n x = fromInteger n == x
primPmDouble :: Fractional a => Double -> a -> Bool
primPmDouble n x = fromDouble n == x
-- ToDo: make the message more informative.
primPmFail :: a
primPmFail = error "Pattern Match Failure"
-- used in desugaring Foreign functions
hugsprimMkIO :: (RealWorld -> (a,RealWorld)) -> IO a
hugsprimMkIO = ST
hugsprimCreateAdjThunk :: (a -> b) -> String -> Char -> IO Addr
hugsprimCreateAdjThunk fun typestr callconv
= do sp <- makeStablePtr fun
p <- copy_String_to_cstring typestr -- is never freed
a <- primCreateAdjThunkARCH sp p callconv
return a
-- The following primitives are only needed if (n+k) patterns are enabled:
hugsprimPmSub :: Integral a => Int -> a -> a
hugsprimPmSub n x = x - fromInt n
......@@ -1573,21 +1585,6 @@ hugsprimPmSubtract x y = x - y
hugsprimPmLe :: Integral a => a -> a -> Bool
hugsprimPmLe x y = x <= y
-- ToDo: make the message more informative.
primPmFail :: a
primPmFail = error "Pattern Match Failure"
-- used in desugaring Foreign functions
primMkIO :: (RealWorld -> (a,RealWorld)) -> IO a
primMkIO = ST
primCreateAdjThunk :: (a -> b) -> String -> Char -> IO Addr
primCreateAdjThunk fun typestr callconv
= do sp <- makeStablePtr fun
p <- copy_String_to_cstring typestr -- is never freed
a <- primCreateAdjThunkARCH sp p callconv
return a
-- Unpack strings generated by the Hugs code generator.
-- Strings can contain \0 provided they're coded right.
--
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment