From a85d9a0219765a81322dbd9d17bde6f8dba85c4b Mon Sep 17 00:00:00 2001 From: sewardj Date: Mon, 10 Jan 2000 17:19:33 +0000 Subject: [PATCH] [project @ 2000-01-10 17:19:32 by sewardj] Back out previous commit. --- ghc/interpreter/lib/Prelude.hs | 33 +++++++++++++++------------------ ghc/interpreter/link.c | 8 ++++---- ghc/interpreter/storage.c | 4 ++-- ghc/lib/hugs/Prelude.hs | 33 +++++++++++++++------------------ 4 files changed, 36 insertions(+), 42 deletions(-) diff --git a/ghc/interpreter/lib/Prelude.hs b/ghc/interpreter/lib/Prelude.hs index df4613c..ce05049 100644 --- a/ghc/interpreter/lib/Prelude.hs +++ b/ghc/interpreter/lib/Prelude.hs @@ -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. -- diff --git a/ghc/interpreter/link.c b/ghc/interpreter/link.c index 456adf2..89d63ca 100644 --- a/ghc/interpreter/link.c +++ b/ghc/interpreter/link.c @@ -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"); diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c index 2bc407b..6ec7514 100644 --- a/ghc/interpreter/storage.c +++ b/ghc/interpreter/storage.c @@ -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" diff --git a/ghc/lib/hugs/Prelude.hs b/ghc/lib/hugs/Prelude.hs index df4613c..ce05049 100644 --- a/ghc/lib/hugs/Prelude.hs +++ b/ghc/lib/hugs/Prelude.hs @@ -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. -- -- 1.7.10.4