* Hugs version 1.4, December 1997
*
* $RCSfile: options.h,v $
- * $Revision: 1.18 $
- * $Date: 2000/03/06 08:42:56 $
+ * $Revision: 1.19 $
+ * $Date: 2000/03/09 06:14:38 $
* ------------------------------------------------------------------------*/
#undef PROVIDE_PTREQUALITY
#undef PROVIDE_COERCE
+#define PROVIDE_COERCE 1
#define PROVIDE_PTREQUALITY 1
/* Set to 1 to use a non-GMP implementation of integer, in the
* included in the distribution.
*
* $RCSfile: parser.y,v $
- * $Revision: 1.23 $
- * $Date: 2000/03/09 02:47:13 $
+ * $Revision: 1.24 $
+ * $Date: 2000/03/09 06:14:38 $
* ------------------------------------------------------------------------*/
%{
| IMPORT QUALIFIED modid impspec
{addQualImport($3,$3);
$$ = gc4($3);}
- | IMPORT PRIVILEGED modid {addQualImport($3,$3);
- addUnqualImport($3,gc0(STAR));
- $$ = gc4($3);}
+ | IMPORT PRIVILEGED modid '(' imports ')'
+ {addUnqualImport($3,ap(STAR,$5));
+ $$ = gc6($3);}
| IMPORT error {syntaxError("import declaration");}
;
impspec : /* empty */ {$$ = gc0(DOTDOT);}
* included in the distribution.
*
* $RCSfile: static.c,v $
- * $Revision: 1.25 $
- * $Date: 2000/03/09 02:47:13 $
+ * $Revision: 1.26 $
+ * $Date: 2000/03/09 06:14:38 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
static List local checkExportTycon Args((List,Text,Cell,Tycon));
static List local checkExportClass Args((List,Text,Cell,Class));
static List local checkExport Args((List,Text,Cell));
-static List local checkImportEntity Args((List,Module,Cell));
-static List local resolveImportList Args((Module,Cell));
+static List local checkImportEntity Args((List,Module,Bool,Cell));
+static List local resolveImportList Args((Module,Cell,Bool));
static Void local checkImportList Args((Pair));
static Void local importEntity Args((Module,Cell));
return imports;
}
-static List local checkImportEntity(imports,exporter,entity)
+static List local checkImportEntity(imports,exporter,priv,entity)
List imports; /* Accumulated list of things to import */
Module exporter;
-Cell entity; { /* Entry from import list */
+Bool priv;
+Cell entity; { /* Entry from import list */
List oldImports = imports;
Text t = isIdent(entity) ? textOf(entity) : textOf(fst(entity));
- List es = module(exporter).exports;
+ List es = NIL;
+ if (priv) {
+ es = module(exporter).names;
+ es = dupOnto(module(exporter).tycons,es);
+ es = dupOnto(module(exporter).classes,es);
+ } else {
+ es = module(exporter).exports;
+ }
+
for(; nonNull(es); es=tl(es)) {
- Cell e = hd(es); /* :: Entity | (Entity, NIL|DOTDOT) */
+ Cell e = hd(es); /* :: Entity
+ | (Entity, NIL|DOTDOT)
+ | tycon
+ | class
+ */
if (isPair(e)) {
Cell f = fst(e);
if (isTycon(f)) {
if (isIdent(entity) && name(e).text == t) {
imports = cons(e,imports);
}
+ } else if (isTycon(e) && priv) {
+ if (tycon(e).text == t) {
+ imports = cons(e,imports);
+ return dupOnto(tycon(e).defn,imports);
+ }
+ } else if (isClass(e) && priv) {
+ if (cclass(e).text == t) {
+ imports = cons(e,imports);
+ return dupOnto(cclass(e).members,imports);
+ }
+ } else if (whatIs(e) == TUPLE && priv) {
+ // do nothing
} else {
internal("checkImportEntity3");
}
return imports;
}
-static List local resolveImportList(m,impList)
+static List local resolveImportList(m,impList,priv)
Module m; /* exporting module */
-Cell impList; {
+Cell impList;
+Bool priv; {
List imports = NIL;
if (DOTDOT == impList) {
List es = module(m).exports;
}
}
}
+#if 0
} else if (STAR == impList) {
List xs;
for(xs=module(m).names; nonNull(xs); xs=tl(xs)) {
|| tycon(t).what == NEWTYPE))
imports = dupOnto(tycon(t).defn,imports);
}
+#endif
} else {
- map1Accum(checkImportEntity,imports,m,impList);
+ map2Accum(checkImportEntity,imports,m,priv,impList);
}
return imports;
}
/* Somewhat inefficient - but obviously correct:
* imports = importsOf("module Foo") `setDifference` hidden;
*/
- hidden = resolveImportList(m, snd(impList));
- imports = resolveImportList(m, DOTDOT);
+ hidden = resolveImportList(m, snd(impList),FALSE);
+ imports = resolveImportList(m, DOTDOT,FALSE);
+ } else if (isPair(impList) && STAR == fst(impList)) {
+ /* Somewhat inefficient - but obviously correct:
+ * imports = importsOf("module Foo") `setDifference` hidden;
+ */
+ imports = resolveImportList(m, snd(impList),TRUE);
} else {
- imports = resolveImportList(m, impList);
+ imports = resolveImportList(m, impList,FALSE);
}
for(; nonNull(imports); imports=tl(imports)) {
-- module Ratio,
Ratio, Rational, (%), numerator, denominator, approxRational,
-- Non-standard exports
- IO(..), IOResult(..), Addr, StablePtr,
+ IO, IOResult(..), Addr, StablePtr,
makeStablePtr, freeStablePtr, deRefStablePtr,
Bool(False, True),
asTypeOf, error, undefined,
seq, ($!)
- , MVar, newEmptyMVar, newMVar, putMVar, takeMVar, readMVar, swapMVar
- , ThreadId, forkIO
- , trace
-
-
- , ST(..)
- , STRef, newSTRef, readSTRef, writeSTRef
- , IORef, newIORef, readIORef, writeIORef
- , PrimMutableArray, PrimMutableByteArray
- , RealWorld
-
- -- This lot really shouldn't be exported, but are needed to
- -- implement various libs.
- , runST , fixST, unsafeInterleaveST
- , stToIO , ioToST
- , unsafePerformIO
- , primReallyUnsafePtrEquality
- ,hugsprimCompAux,PrimArray, primNewArray,primWriteArray
- ,primReadArray, primIndexArray, primSizeMutableArray
- ,primSizeArray
- ,primUnsafeFreezeArray,primIndexArray,primGetRawArgs,primGetEnv
- ,nh_stdin,nh_stdout,nh_stderr,copy_String_to_cstring,nh_open
- ,nh_free,nh_close,nh_errno,nh_flush,nh_read,primIntToChar
- ,unsafeInterleaveIO,nh_write,primCharToInt,
- nullAddr, incAddr, isNullAddr,
- nh_filesize, nh_iseof, nh_system, nh_exitwith, nh_getPID,
- nh_getCPUtime, nh_getCPUprec, prelCleanupAfterRunAction,
-
- Word,
- primGtWord, primGeWord, primEqWord, primNeWord,
- primLtWord, primLeWord, primMinWord, primMaxWord,
- primPlusWord, primMinusWord, primTimesWord, primQuotWord,
- primRemWord, primQuotRemWord, primNegateWord, primAndWord,
- primOrWord, primXorWord, primNotWord, primShiftLWord,
- primShiftRAWord, primShiftRLWord, primIntToWord, primWordToInt,
-
- primAndInt, primOrInt, primXorInt, primNotInt,
- primShiftLInt, primShiftRAInt, primShiftRLInt,
-
- primAddrToInt, primIntToAddr,
-
- primDoubleToFloat, primFloatToDouble,
-
) where
-- Standard value bindings {Prelude} ----------------------------------------
print = putStrLn . show
getChar :: IO Char
-getChar = unsafeInterleaveIO (
- nh_stdin >>= \h ->
+getChar = nh_stdin >>= \h ->
nh_read h >>= \ci ->
return (primIntToChar ci)
- )
getLine :: IO String
getLine = do c <- getChar
= primCatch (protect (n-1) comp)
(\e -> fst (unIO (putStr (show e ++ "\n")) realWorld))
-trace, trace_quiet :: String -> a -> a
-trace s x
- = trace_quiet ("trace: " ++ s) x
-trace_quiet s x
- = (unsafePerformIO (putStr (s ++ "\n"))) `seq` x
-
unsafeInterleaveIO :: IO a -> IO a
unsafeInterleaveIO m = IO (\ s -> (fst (unIO m s), s))
where
realWorld = error "primForkIO: entered the RealWorld"
+trace_quiet s x
+ = (unsafePerformIO (putStr (s ++ "\n"))) `seq` x
-- showFloat ------------------------------------------------------------------
import PrelArr -- Most of the hard work is done here
import PrelBase
#else
+import Prelude
+import privileged Prelude ( PrimArray
+ , runST
+ , primNewArray
+ , primWriteArray
+ , primReadArray
+ , primUnsafeFreezeArray
+ , primIndexArray
+ )
import Ix
import List( (\\) )
#endif
data Array ix elt = Array (ix,ix) (PrimArray elt)
array :: Ix a => (a,a) -> [(a,b)] -> Array a b
-array ixs@(ix_start, ix_end) ivs = primRunST (do
+array ixs@(ix_start, ix_end) ivs = runST (do
{ mut_arr <- primNewArray (rangeSize ixs) arrEleBottom
; mapM_ (\ (i,v) -> primWriteArray mut_arr (index ixs i) v) ivs
; arr <- primUnsafeFreezeArray mut_arr
#else
\begin{code}
+import Prelude
+import privileged Prelude ( nh_getCPUtime
+ , nh_getCPUprec
+ , unsafePerformIO
+ )
+
getCPUTime :: IO Integer
getCPUTime
= do seconds <- nh_getCPUtime
cpuTimePrecision :: Integer
cpuTimePrecision
- = primRunST (
+ = unsafePerformIO (
do resolution <- nh_getCPUprec
return (round (resolution * 1.0e+12))
)
#ifdef __HUGS__
import Ix(Ix)
+import Prelude
+import privileged Prelude ( IORef
+ , unsafePerformIO
+ , prelCleanupAfterRunAction
+ , copy_String_to_cstring
+ , primIntToChar
+ , primWriteCharOffAddr
+ , nullAddr
+ , newIORef
+ , writeIORef
+ , readIORef
+ , nh_close
+ , nh_errno
+ , nh_stdin
+ , nh_stdout
+ , nh_stderr
+ , nh_flush
+ , nh_open
+ , nh_free
+ , nh_read
+ , nh_write
+ , nh_filesize
+ , nh_iseof
+ )
+
+
#else
--import PrelST
import PrelBase
@hGetChar hdl@ reads the next character from handle @hdl@,
blocking until a character is available.
-\begin{code}
+]\begin{code}
hGetChar :: Handle -> IO Char
hGetChar handle = do
c <- mayBlockRead "hGetChar" handle fileGetc
stdin
= Handle {
name = "stdin",
- file = primRunST nh_stdin,
- mut = primRunST (newIORef (Handle_Mut { state = HOpen })),
+ file = unsafePerformIO nh_stdin,
+ mut = unsafePerformIO (newIORef (Handle_Mut { state = HOpen })),
mode = ReadMode
}
stdout
= Handle {
name = "stdout",
- file = primRunST nh_stdout,
- mut = primRunST (newIORef (Handle_Mut { state = HOpen })),
+ file = unsafePerformIO nh_stdout,
+ mut = unsafePerformIO (newIORef (Handle_Mut { state = HOpen })),
mode = WriteMode
}
stderr
= Handle {
name = "stderr",
- file = primRunST nh_stderr,
- mut = primRunST (newIORef (Handle_Mut { state = HOpen })),
+ file = unsafePerformIO nh_stderr,
+ mut = unsafePerformIO (newIORef (Handle_Mut { state = HOpen })),
mode = WriteMode
}
-- once handles appear in the list.
allHandles :: IORef [Handle]
-allHandles = primRunST (newIORef [])
+allHandles = unsafePerformIO (newIORef [])
elemWriterHandles :: FilePath -> IO Bool
elemAllHandles :: FilePath -> IO Bool
import PrelIOBase ( unsafePerformIO, stToIO )
import PrelArr ( MutableVar, newVar, readVar, writeVar )
import PrelReal ( toInt )
-import CPUTime ( getCPUTime )
import PrelFloat ( float2Double, double2Float )
import Time ( getClockTime, ClockTime(..) )
#endif
+import CPUTime ( getCPUTime )
+import Prelude
+import privileged Prelude
+ ( IORef
+ , newIORef
+ , readIORef
+ , writeIORef
+ , unsafePerformIO
+ )
+
import Char ( isSpace, chr, ord )
\end{code}
\begin{code}
#ifdef __HUGS__
mkStdRNG :: Integer -> IO StdGen
-mkStdRNG o = return (createStdGen o)
+mkStdRNG o = do
+ ct <- getCPUTime
+ return (createStdGen (ct + o))
#else
mkStdRNG :: Integer -> IO StdGen
mkStdRNG o = do
getStdGen = readIORef theStdGen
theStdGen :: IORef StdGen
-theStdGen = primRunST (newIORef (createStdGen 0))
+theStdGen = unsafePerformIO (newIORef (createStdGen 0))
#else
nd'' = simplest' d' r' d r
n'' = numerator nd''
d'' = denominator nd''
+
\end{code}
+#else
+
+\begin{code}
+-- Hugs already has this functionally inside its prelude
+\end{code}
#endif
+
+
--
-- Suitable for use with Hugs 98
-----------------------------------------------------------------------------
+import Prelude
+import privileged Prelude ( primGetRawArgs
+ , primGetEnv
+ , prelCleanupAfterRunAction
+ , copy_String_to_cstring
+ , readIORef
+ , nh_stderr
+ , nh_stdout
+ , nh_stdin
+ , nh_exitwith
+ , nh_flush
+ , nh_close
+ , nh_system
+ , nh_free
+ , nh_getPID
+ )
+
data ExitCode = ExitSuccess | ExitFailure Int
deriving (Eq, Ord, Read, Show)
projects / ghc-hetmet.git / commitdiff