Commit 7bc3ecec authored by andy's avatar andy

[project @ 2000-03-09 06:14:38 by andy]

improving the synatax and semantics of the privileged import

 Typical use might be:

  import Prelude
  import privileged Prelude ( IORef , unsafePerformIO )

 Which means please ignore the export that comes with Prelude,
 and let me at compiler internal magic operations, IORef and
 unsafePerformIO (both are later exported by IOExt)

I've also updated the stdlib files to use this (hugs only :-).
parent 075e0c07
......@@ -7,8 +7,8 @@
* 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 $
* ------------------------------------------------------------------------*/
......@@ -172,6 +172,7 @@
#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
......
......@@ -12,8 +12,8 @@
* 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 $
* ------------------------------------------------------------------------*/
%{
......@@ -529,9 +529,9 @@ impDecl : IMPORT modid impspec {addQualImport($2,$2);
| 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);}
......
......@@ -9,8 +9,8 @@
* 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"
......@@ -34,8 +34,8 @@ static List local checkSubentities Args((List,List,List,String,Text));
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));
......@@ -354,15 +354,28 @@ Text textParent; {
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)) {
......@@ -403,6 +416,18 @@ Cell entity; { /* Entry from import list */
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");
}
......@@ -416,9 +441,10 @@ Cell entity; { /* Entry from import list */
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;
......@@ -441,6 +467,7 @@ Cell impList; {
}
}
}
#if 0
} else if (STAR == impList) {
List xs;
for(xs=module(m).names; nonNull(xs); xs=tl(xs)) {
......@@ -460,8 +487,9 @@ Cell impList; {
|| 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;
}
......@@ -483,10 +511,15 @@ Pair importSpec; {
/* 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)) {
......
......@@ -60,7 +60,7 @@ module Prelude (
-- module Ratio,
Ratio, Rational, (%), numerator, denominator, approxRational,
-- Non-standard exports
IO(..), IOResult(..), Addr, StablePtr,
IO, IOResult(..), Addr, StablePtr,
makeStablePtr, freeStablePtr, deRefStablePtr,
Bool(False, True),
......@@ -102,49 +102,6 @@ module Prelude (
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} ----------------------------------------
......@@ -1658,11 +1615,9 @@ print :: Show a => a -> IO ()
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
......@@ -1906,12 +1861,6 @@ hugsprimRunIO_toplevel m
= 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))
......@@ -2064,6 +2013,8 @@ forkIO computation
where
realWorld = error "primForkIO: entered the RealWorld"
trace_quiet s x
= (unsafePerformIO (putStr (s ++ "\n"))) `seq` x
-- showFloat ------------------------------------------------------------------
......
......@@ -45,6 +45,15 @@ import PrelShow
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
......@@ -89,7 +98,7 @@ ixmap b f a = array b [(i, a ! f i) | i <- range b]
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
......
......@@ -65,6 +65,12 @@ foreign import "libHS_cbits" "clockTicks" clockTicks :: IO Int
#else
\begin{code}
import Prelude
import privileged Prelude ( nh_getCPUtime
, nh_getCPUprec
, unsafePerformIO
)
getCPUTime :: IO Integer
getCPUTime
= do seconds <- nh_getCPUtime
......@@ -72,7 +78,7 @@ getCPUTime
cpuTimePrecision :: Integer
cpuTimePrecision
= primRunST (
= unsafePerformIO (
do resolution <- nh_getCPUprec
return (round (resolution * 1.0e+12))
)
......
......@@ -94,6 +94,32 @@ module IO (
#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
......@@ -156,7 +182,7 @@ hWaitForInput handle msecs =
@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
......@@ -731,24 +757,24 @@ mkErr h msg
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
}
......@@ -790,7 +816,7 @@ data HState = HOpen | HSemiClosed | HClosed
-- once handles appear in the list.
allHandles :: IORef [Handle]
allHandles = primRunST (newIORef [])
allHandles = unsafePerformIO (newIORef [])
elemWriterHandles :: FilePath -> IO Bool
elemAllHandles :: FilePath -> IO Bool
......
......@@ -36,10 +36,19 @@ import PrelRead ( readDec )
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}
......@@ -184,7 +193,9 @@ instance Random Float where
\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
......@@ -270,7 +281,7 @@ getStdGen :: IO StdGen
getStdGen = readIORef theStdGen
theStdGen :: IORef StdGen
theStdGen = primRunST (newIORef (createStdGen 0))
theStdGen = unsafePerformIO (newIORef (createStdGen 0))
#else
......
......@@ -80,8 +80,16 @@ approxRational rat eps = simplest (rat-eps) (rat+eps)
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
......@@ -188,6 +188,23 @@ unpackProgName argv
--
-- 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)
......
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