diff options
author | partain <unknown> | 1996-01-11 14:26:13 +0000 |
---|---|---|
committer | partain <unknown> | 1996-01-11 14:26:13 +0000 |
commit | 10521d8418fd3a1cf32882718b5bd28992db36fd (patch) | |
tree | 09cb781a215d1ab0c871f9655c1460207a601497 /ghc/lib | |
parent | 7fa716e248a1f11fa686965f57aebbb83b74fa7b (diff) | |
download | haskell-10521d8418fd3a1cf32882718b5bd28992db36fd.tar.gz |
[project @ 1996-01-11 14:06:51 by partain]
Diffstat (limited to 'ghc/lib')
129 files changed, 797 insertions, 465 deletions
diff --git a/ghc/lib/Jmakefile b/ghc/lib/Jmakefile index 4702053dc7..c51e20d521 100644 --- a/ghc/lib/Jmakefile +++ b/ghc/lib/Jmakefile @@ -209,6 +209,8 @@ CAT2(blob,_HC_l) = $(CAT2(blob,_HS):.hs=_l.hc) @@\ CAT2(blob,_HC_m) = $(CAT2(blob,_HS):.hs=_m.hc) @@\ CAT2(blob,_HC_n) = $(CAT2(blob,_HS):.hs=_n.hc) @@\ CAT2(blob,_HC_o) = $(CAT2(blob,_HS):.hs=_o.hc) @@\ +CAT2(blob,_HC_A) = $(CAT2(blob,_HS):.hs=_A.hc) @@\ +CAT2(blob,_HC_B) = $(CAT2(blob,_HS):.hs=_B.hc) @@\ @@\ CAT2(blob,_DEP_norm) = $(CAT2(blob,_HC_norm):.hc=.o) @@\ CAT2(blob,_DEP_p) = $(CAT2(blob,_HC_p):.hc=.o) @@\ @@ -237,6 +239,8 @@ CAT2(blob,_DEP_l) = $(CAT2(blob,_HC_l):.hc=.o) @@\ CAT2(blob,_DEP_m) = $(CAT2(blob,_HC_m):.hc=.o) @@\ CAT2(blob,_DEP_n) = $(CAT2(blob,_HC_n):.hc=.o) @@\ CAT2(blob,_DEP_o) = $(CAT2(blob,_HC_o):.hc=.o) @@\ +CAT2(blob,_DEP_A) = $(CAT2(blob,_HC_A):.hc=.o) @@\ +CAT2(blob,_DEP_B) = $(CAT2(blob,_HC_B):.hc=.o) @@\ @@\ CAT2(blob,_HIs_p) = $(CAT2(blob,_HIs):.hi=_p.hi) @@\ CAT2(blob,_HIs_t) = $(CAT2(blob,_HIs):.hi=_t.hi) @@\ @@ -263,7 +267,9 @@ CAT2(blob,_HIs_k) = $(CAT2(blob,_HIs):.hi=_k.hi) @@\ CAT2(blob,_HIs_l) = $(CAT2(blob,_HIs):.hi=_l.hi) @@\ CAT2(blob,_HIs_m) = $(CAT2(blob,_HIs):.hi=_m.hi) @@\ CAT2(blob,_HIs_n) = $(CAT2(blob,_HIs):.hi=_n.hi) @@\ -CAT2(blob,_HIs_o) = $(CAT2(blob,_HIs):.hi=_o.hi) +CAT2(blob,_HIs_o) = $(CAT2(blob,_HIs):.hi=_o.hi) @@\ +CAT2(blob,_HIs_A) = $(CAT2(blob,_HIs):.hi=_A.hi) @@\ +CAT2(blob,_HIs_B) = $(CAT2(blob,_HIs):.hi=_B.hi) #define PrintFileStuff(blob,outf) \ @@ -295,6 +301,8 @@ CAT2(blob,_HIs_o) = $(CAT2(blob,_HIs):.hi=_o.hi) @echo 'IfGhcBuild_m(' CAT2(blob,_HC_m) = $(CAT2(blob,_HC_m)) ')' >> outf @@\ @echo 'IfGhcBuild_n(' CAT2(blob,_HC_n) = $(CAT2(blob,_HC_n)) ')' >> outf @@\ @echo 'IfGhcBuild_o(' CAT2(blob,_HC_o) = $(CAT2(blob,_HC_o)) ')' >> outf @@\ + @echo 'IfGhcBuild_A(' CAT2(blob,_HC_A) = $(CAT2(blob,_HC_A)) ')' >> outf @@\ + @echo 'IfGhcBuild_B(' CAT2(blob,_HC_B) = $(CAT2(blob,_HC_B)) ')' >> outf @@\ @echo 'IfGhcBuild_p(' CAT2(blob,_DEP_p) = $(CAT2(blob,_DEP_p)) ')' >> outf @@\ @echo 'IfGhcBuild_t(' CAT2(blob,_DEP_t) = $(CAT2(blob,_DEP_t)) ')' >> outf @@\ @echo 'IfGhcBuild_u(' CAT2(blob,_DEP_u) = $(CAT2(blob,_DEP_u)) ')' >> outf @@\ @@ -321,6 +329,8 @@ CAT2(blob,_HIs_o) = $(CAT2(blob,_HIs):.hi=_o.hi) @echo 'IfGhcBuild_m(' CAT2(blob,_DEP_m) = $(CAT2(blob,_DEP_m)) ')' >> outf @@\ @echo 'IfGhcBuild_n(' CAT2(blob,_DEP_n) = $(CAT2(blob,_DEP_n)) ')' >> outf @@\ @echo 'IfGhcBuild_o(' CAT2(blob,_DEP_o) = $(CAT2(blob,_DEP_o)) ')' >> outf @@\ + @echo 'IfGhcBuild_A(' CAT2(blob,_DEP_A) = $(CAT2(blob,_DEP_A)) ')' >> outf @@\ + @echo 'IfGhcBuild_B(' CAT2(blob,_DEP_B) = $(CAT2(blob,_DEP_B)) ')' >> outf @@\ @echo 'IfGhcBuild_p(' CAT2(blob,_HIs_p) = $(CAT2(blob,_HIs_p)) ')' >> outf @@\ @echo 'IfGhcBuild_t(' CAT2(blob,_HIs_t) = $(CAT2(blob,_HIs_t)) ')' >> outf @@\ @echo 'IfGhcBuild_u(' CAT2(blob,_HIs_u) = $(CAT2(blob,_HIs_u)) ')' >> outf @@\ @@ -346,7 +356,9 @@ CAT2(blob,_HIs_o) = $(CAT2(blob,_HIs):.hi=_o.hi) @echo 'IfGhcBuild_l(' CAT2(blob,_HIs_l) = $(CAT2(blob,_HIs_l)) ')' >> outf @@\ @echo 'IfGhcBuild_m(' CAT2(blob,_HIs_m) = $(CAT2(blob,_HIs_m)) ')' >> outf @@\ @echo 'IfGhcBuild_n(' CAT2(blob,_HIs_n) = $(CAT2(blob,_HIs_n)) ')' >> outf @@\ - @echo 'IfGhcBuild_o(' CAT2(blob,_HIs_o) = $(CAT2(blob,_HIs_o)) ')' >> outf + @echo 'IfGhcBuild_o(' CAT2(blob,_HIs_o) = $(CAT2(blob,_HIs_o)) ')' >> outf @@\ + @echo 'IfGhcBuild_A(' CAT2(blob,_HIs_A) = $(CAT2(blob,_HIs_A)) ')' >> outf @@\ + @echo 'IfGhcBuild_B(' CAT2(blob,_HIs_B) = $(CAT2(blob,_HIs_B)) ')' >> outf BASIC_HS = $(BASIC_LHS:.lhs=.hs) $(BASIC_HS_PREL) BASIC_OBJS_DIRS = $(BASIC_HS:.hs=) @@ -534,6 +546,8 @@ IfGhcBuild_l(hcs_l :: $(BASIC_HC_l) $(ONE3_HC_l) $(GHCLIB_HC_l) $(HBCLIB_HC IfGhcBuild_m(hcs_m :: $(BASIC_HC_m) $(ONE3_HC_m) $(GHCLIB_HC_m) $(HBCLIB_HC_m)) IfGhcBuild_n(hcs_n :: $(BASIC_HC_n) $(ONE3_HC_n) $(GHCLIB_HC_n) $(HBCLIB_HC_n)) IfGhcBuild_o(hcs_o :: $(BASIC_HC_o) $(ONE3_HC_o) $(GHCLIB_HC_o) $(HBCLIB_HC_o)) +IfGhcBuild_A(hcs_A :: $(BASIC_HC_A) $(ONE3_HC_A) $(GHCLIB_HC_A) $(HBCLIB_HC_A)) +IfGhcBuild_B(hcs_B :: $(BASIC_HC_B) $(ONE3_HC_B) $(GHCLIB_HC_B) $(HBCLIB_HC_B)) IfGhcBuild_normal(libs:: libHS.a libHS13.a libHSghc.a libHShbc.a) IfGhcBuild_p(libs_p :: libHS_p.a libHS13_p.a libHSghc_p.a libHShbc_p.a) @@ -562,9 +576,11 @@ IfGhcBuild_l(libs_l :: libHS_l.a libHS13_l.a libHSghc_l.a libHShbc_l.a) IfGhcBuild_m(libs_m :: libHS_m.a libHS13_m.a libHSghc_m.a libHShbc_m.a) IfGhcBuild_n(libs_n :: libHS_n.a libHS13_n.a libHSghc_n.a libHShbc_n.a) IfGhcBuild_o(libs_o :: libHS_o.a libHS13_o.a libHSghc_o.a libHShbc_o.a) +IfGhcBuild_A(libs_A :: libHS_A.a libHS13_A.a libHSghc_A.a libHShbc_A.a) +IfGhcBuild_B(libs_B :: libHS_B.a libHS13_B.a libHSghc_B.a libHShbc_B.a) /* maybe for GNU make only? */ -.PHONY :: hcs hcs_p hcs_t hcs_mg hcs_mr hcs_mt hcs_mp hcs_mg hcs_a hcs_b hcs_c hcs_d hcs_e hcs_f hcs_g hcs_h hcs_i hcs_j hcs_k hcs_l hcs_m hcs_n hcs_o +.PHONY :: hcs hcs_p hcs_t hcs_mg hcs_mr hcs_mt hcs_mp hcs_mg hcs_a hcs_b hcs_c hcs_d hcs_e hcs_f hcs_g hcs_h hcs_i hcs_j hcs_k hcs_l hcs_m hcs_n hcs_o hcs_A hcs_B #endif /* reasonable make */ @@ -900,6 +916,20 @@ IfGhcBuild_o(BigBuildTarget(_o,'*_o.o',his_o \ , $(ONE3_DEP_o), $(ONE3_HIs_o) \ )) +IfGhcBuild_A(BigBuildTarget(_A,'*_A.o',his_A \ +, $(BASIC_DEP_A), $(BASIC_HIs_A) \ +, $(GHCLIB_DEP_A), $(GHCLIB_HIs_A) \ +, $(HBCLIB_DEP_A), $(HBCLIB_HIs_A) \ +, $(ONE3_DEP_A), $(ONE3_HIs_A) \ +)) + +IfGhcBuild_B(BigBuildTarget(_B,'*_B.o',his_B \ +, $(BASIC_DEP_B), $(BASIC_HIs_B) \ +, $(GHCLIB_DEP_B), $(GHCLIB_HIs_B) \ +, $(HBCLIB_DEP_B), $(HBCLIB_HIs_B) \ +, $(ONE3_DEP_B), $(ONE3_HIs_B) \ +)) + /**************************************************************** * * * Creating the individual .hc files: * @@ -972,7 +1002,9 @@ IfGhcBuild_k(DoHs(file,isuf,_k, flags $(GHC_OPTS_k), '_k.o', '*_k.o')) \ IfGhcBuild_l(DoHs(file,isuf,_l, flags $(GHC_OPTS_l), '_l.o', '*_l.o')) \ IfGhcBuild_m(DoHs(file,isuf,_m, flags $(GHC_OPTS_m), '_m.o', '*_m.o')) \ IfGhcBuild_n(DoHs(file,isuf,_n, flags $(GHC_OPTS_n), '_n.o', '*_n.o')) \ -IfGhcBuild_o(DoHs(file,isuf,_o, flags $(GHC_OPTS_o), '_o.o', '*_o.o')) +IfGhcBuild_o(DoHs(file,isuf,_o, flags $(GHC_OPTS_o), '_o.o', '*_o.o')) \ +IfGhcBuild_A(DoHs(file,isuf,_A, flags $(GHC_OPTS_A), '_A.o', '*_A.o')) \ +IfGhcBuild_B(DoHs(file,isuf,_B, flags $(GHC_OPTS_B), '_B.o', '*_B.o')) /* now use the macro: */ @@ -1085,7 +1117,7 @@ CompilePreludishly(ghc/Readline,lhs, -ighc -fhaskell-1.3 '-#include"ghcReadline. #endif #if GhcWithSockets == YES CompilePreludishly(ghc/Socket,lhs, -ighc -fhaskell-1.3) -CompilePreludishly(ghc/SocketPrim,lhs, -ighc -fhaskell-1.3 -K2m -optcO-DNON_POSIX_SOURCE '-#include"ghcSockets.h"') +CompilePreludishly(ghc/SocketPrim,lhs, -ighc -fhaskell-1.3 -H12m -K2m -optcO-DNON_POSIX_SOURCE '-#include"ghcSockets.h"') CompilePreludishly(ghc/BSD,lhs, -ighc -fhaskell-1.3 -optcO-DNON_POSIX_SOURCE '-#include"ghcSockets.h"') CompilePreludishly(ghc/CError,lhs, -ighc -fhaskell-1.3 -K2m -fomit-derived-read) #endif @@ -1148,6 +1180,10 @@ print_file_list5 : /* now include the extra dependencies so generated */ #include "Jmake.inc5" +/* for unix-libs.lit */ +LitSuffixRule(.lhs,.hs) +LitDocRootTarget(unix-libs,lit) + /* should be *LAST* */ #if HaskellCompilerType != HC_USE_HC_FILES /* otherwise, the dependencies jeopardize our .hc files -- diff --git a/ghc/lib/ghc/BSD.hi b/ghc/lib/ghc/BSD.hi index ad080d73a0..a47f8700aa 100644 --- a/ghc/lib/ghc/BSD.hi +++ b/ghc/lib/ghc/BSD.hi @@ -3,7 +3,7 @@ interface BSD where import PreludeIOError(IOError13) import PreludeMonadicIO(Either) import SocketPrim(Family) -data Family {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX #-} +data Family {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN #-} data HostEntry = HostEntry [Char] [[Char]] Family [_Word] type HostName = [Char] type PortNumber = Int @@ -65,8 +65,8 @@ instance Ord Family _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} instance Text Family {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/BSD.lhs b/ghc/lib/ghc/BSD.lhs index 361e1b8769..5c19f8e50b 100644 --- a/ghc/lib/ghc/BSD.lhs +++ b/ghc/lib/ghc/BSD.lhs @@ -375,12 +375,28 @@ unvectorizeHostAddrs :: _Addr -> Int -> PrimIO [_Word] unvectorizeHostAddrs ptr n | str == ``NULL'' = returnPrimIO [] | otherwise = - _casm_ ``%r = (W_)ntohl(((struct hostent*)%0)->h_addr_list[(int)%1]);'' + _casm_ ``{ u_long tmp; + if ((((struct hostent*)%0)->h_addr_list[(int)%1]) == NULL) + tmp=(W_)0; + else + tmp = (W_)ntohl(((struct in_addr *)(((struct hostent*)%0)->h_addr_list[(int)%1]))->s_addr); + %r=(W_)tmp;} '' ptr n `thenPrimIO` \ x -> unvectorizeHostAddrs ptr (n+1) `thenPrimIO` \ xs -> returnPrimIO (x : xs) where str = indexAddrOffAddr ptr n +{- +unvectorizeHostAddrs :: _Addr -> Int -> PrimIO [_Word] +unvectorizeHostAddrs ptr n + | str == ``NULL'' = returnPrimIO [] + | otherwise = + _casm_ ``%r = (W_)ntohl(((struct hostent*)%0)->h_addr_list[(int)%1]);'' + ptr n `thenPrimIO` \ x -> + unvectorizeHostAddrs ptr (n+1) `thenPrimIO` \ xs -> + returnPrimIO (x : xs) + where str = indexAddrOffAddr ptr n +-} ------------------------------------------------------------------------------- mutByteArr2Addr :: _MutableByteArray _RealWorld Int -> PrimIO _Addr diff --git a/ghc/lib/ghc/BSD_mc.hi b/ghc/lib/ghc/BSD_mc.hi index ad080d73a0..a47f8700aa 100644 --- a/ghc/lib/ghc/BSD_mc.hi +++ b/ghc/lib/ghc/BSD_mc.hi @@ -3,7 +3,7 @@ interface BSD where import PreludeIOError(IOError13) import PreludeMonadicIO(Either) import SocketPrim(Family) -data Family {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX #-} +data Family {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN #-} data HostEntry = HostEntry [Char] [[Char]] Family [_Word] type HostName = [Char] type PortNumber = Int @@ -65,8 +65,8 @@ instance Ord Family _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} instance Text Family {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/BSD_mg.hi b/ghc/lib/ghc/BSD_mg.hi index ad080d73a0..2d4e906ba5 100644 --- a/ghc/lib/ghc/BSD_mg.hi +++ b/ghc/lib/ghc/BSD_mg.hi @@ -3,7 +3,7 @@ interface BSD where import PreludeIOError(IOError13) import PreludeMonadicIO(Either) import SocketPrim(Family) -data Family {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX #-} +data Family {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN #-} data HostEntry = HostEntry [Char] [[Char]] Family [_Word] type HostName = [Char] type PortNumber = Int @@ -66,7 +66,7 @@ instance Ord Family instance Text Family {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_ readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/BSD_mp.hi b/ghc/lib/ghc/BSD_mp.hi index ad080d73a0..a47f8700aa 100644 --- a/ghc/lib/ghc/BSD_mp.hi +++ b/ghc/lib/ghc/BSD_mp.hi @@ -3,7 +3,7 @@ interface BSD where import PreludeIOError(IOError13) import PreludeMonadicIO(Either) import SocketPrim(Family) -data Family {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX #-} +data Family {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN #-} data HostEntry = HostEntry [Char] [[Char]] Family [_Word] type HostName = [Char] type PortNumber = Int @@ -65,8 +65,8 @@ instance Ord Family _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} instance Text Family {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/BSD_p.hi b/ghc/lib/ghc/BSD_p.hi index ad080d73a0..a47f8700aa 100644 --- a/ghc/lib/ghc/BSD_p.hi +++ b/ghc/lib/ghc/BSD_p.hi @@ -3,7 +3,7 @@ interface BSD where import PreludeIOError(IOError13) import PreludeMonadicIO(Either) import SocketPrim(Family) -data Family {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX #-} +data Family {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN #-} data HostEntry = HostEntry [Char] [[Char]] Family [_Word] type HostName = [Char] type PortNumber = Int @@ -65,8 +65,8 @@ instance Ord Family _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} instance Text Family {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/BSD_t.hi b/ghc/lib/ghc/BSD_t.hi index ad080d73a0..a47f8700aa 100644 --- a/ghc/lib/ghc/BSD_t.hi +++ b/ghc/lib/ghc/BSD_t.hi @@ -3,7 +3,7 @@ interface BSD where import PreludeIOError(IOError13) import PreludeMonadicIO(Either) import SocketPrim(Family) -data Family {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX #-} +data Family {-# GHC_PRAGMA AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN #-} data HostEntry = HostEntry [Char] [[Char]] Family [_Word] type HostName = [Char] type PortNumber = Int @@ -65,8 +65,8 @@ instance Ord Family _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} instance Text Family {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/CError.hi b/ghc/lib/ghc/CError.hi index e13f94bde2..e53d2debe5 100644 --- a/ghc/lib/ghc/CError.hi +++ b/ghc/lib/ghc/CError.hi @@ -29,7 +29,7 @@ instance Ord CErrorCode instance Text CErrorCode {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_ readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_ _TYAPP_ patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/CError_mc.hi b/ghc/lib/ghc/CError_mc.hi index e13f94bde2..e53d2debe5 100644 --- a/ghc/lib/ghc/CError_mc.hi +++ b/ghc/lib/ghc/CError_mc.hi @@ -29,7 +29,7 @@ instance Ord CErrorCode instance Text CErrorCode {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_ readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_ _TYAPP_ patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/CError_mg.hi b/ghc/lib/ghc/CError_mg.hi index e13f94bde2..e53d2debe5 100644 --- a/ghc/lib/ghc/CError_mg.hi +++ b/ghc/lib/ghc/CError_mg.hi @@ -29,7 +29,7 @@ instance Ord CErrorCode instance Text CErrorCode {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_ readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_ _TYAPP_ patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/CError_mp.hi b/ghc/lib/ghc/CError_mp.hi index e13f94bde2..e53d2debe5 100644 --- a/ghc/lib/ghc/CError_mp.hi +++ b/ghc/lib/ghc/CError_mp.hi @@ -29,7 +29,7 @@ instance Ord CErrorCode instance Text CErrorCode {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_ readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_ _TYAPP_ patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/CError_p.hi b/ghc/lib/ghc/CError_p.hi index e13f94bde2..e53d2debe5 100644 --- a/ghc/lib/ghc/CError_p.hi +++ b/ghc/lib/ghc/CError_p.hi @@ -29,7 +29,7 @@ instance Ord CErrorCode instance Text CErrorCode {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_ readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_ _TYAPP_ patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/CError_t.hi b/ghc/lib/ghc/CError_t.hi index e13f94bde2..e53d2debe5 100644 --- a/ghc/lib/ghc/CError_t.hi +++ b/ghc/lib/ghc/CError_t.hi @@ -29,7 +29,7 @@ instance Ord CErrorCode instance Text CErrorCode {-# GHC_PRAGMA _M_ CError {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(CErrorCode, [Char])]), (Int -> CErrorCode -> [Char] -> [Char]), ([Char] -> [([CErrorCode], [Char])]), ([CErrorCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (CErrorCode), _CONSTM_ Text showsPrec (CErrorCode), _CONSTM_ Text readList (CErrorCode), _CONSTM_ Text showList (CErrorCode)] _N_ readsPrec = _A_ 2 _U_ 22 _N_ _S_ _!_ _F_ _IF_ARGS_ 0 2 XX 4 \ (u0 :: Int) (u1 :: [Char]) -> _APP_ _TYAPP_ patError# { (Int -> [Char] -> [(CErrorCode, [Char])]) } [ _NOREP_S_ "%DPreludeCore.Text.readsPrec\"", u0, u1 ] _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/FiniteMap.hi b/ghc/lib/ghc/FiniteMap.hi index 393bb4b684..1e3fa4478e 100644 --- a/ghc/lib/ghc/FiniteMap.hi +++ b/ghc/lib/ghc/FiniteMap.hi @@ -52,4 +52,6 @@ singletonFM :: a -> b -> FiniteMap a b {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} sizeFM :: FiniteMap a b -> Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-} +instance (Eq a, Eq b) => Eq (FiniteMap a b) + {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/FiniteMap.lhs b/ghc/lib/ghc/FiniteMap.lhs index 03f087a1fe..56caa587ea 100644 --- a/ghc/lib/ghc/FiniteMap.lhs +++ b/ghc/lib/ghc/FiniteMap.lhs @@ -715,6 +715,18 @@ pprX sty (Branch key elt sz fm_l fm_r) ppr sty key, ppSP, ppInt (IF_GHC(I# sz, sz)), ppSP, pprX sty fm_r, ppRparen] #endif + +#if !defined(COMPILING_GHC) +instance (Eq key, Eq elt) => Eq (FiniteMap key elt) where + fm_1 == fm_2 = (sizeFM fm_1 == sizeFM fm_2) && -- quick test + (fmToList fm_1 == fmToList fm_2) + +{- NO: not clear what The Right Thing to do is: +instance (Ord key, Ord elt) => Ord (FiniteMap key elt) where + fm_1 <= fm_2 = (sizeFM fm_1 <= sizeFM fm_2) && -- quick test + (fmToList fm_1 <= fmToList fm_2) +-} +#endif \end{code} %************************************************************************ diff --git a/ghc/lib/ghc/FiniteMap_mc.hi b/ghc/lib/ghc/FiniteMap_mc.hi index 393bb4b684..1e3fa4478e 100644 --- a/ghc/lib/ghc/FiniteMap_mc.hi +++ b/ghc/lib/ghc/FiniteMap_mc.hi @@ -52,4 +52,6 @@ singletonFM :: a -> b -> FiniteMap a b {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} sizeFM :: FiniteMap a b -> Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-} +instance (Eq a, Eq b) => Eq (FiniteMap a b) + {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/FiniteMap_mg.hi b/ghc/lib/ghc/FiniteMap_mg.hi index 393bb4b684..1e3fa4478e 100644 --- a/ghc/lib/ghc/FiniteMap_mg.hi +++ b/ghc/lib/ghc/FiniteMap_mg.hi @@ -52,4 +52,6 @@ singletonFM :: a -> b -> FiniteMap a b {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} sizeFM :: FiniteMap a b -> Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-} +instance (Eq a, Eq b) => Eq (FiniteMap a b) + {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/FiniteMap_mp.hi b/ghc/lib/ghc/FiniteMap_mp.hi index 393bb4b684..1e3fa4478e 100644 --- a/ghc/lib/ghc/FiniteMap_mp.hi +++ b/ghc/lib/ghc/FiniteMap_mp.hi @@ -52,4 +52,6 @@ singletonFM :: a -> b -> FiniteMap a b {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} sizeFM :: FiniteMap a b -> Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-} +instance (Eq a, Eq b) => Eq (FiniteMap a b) + {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/FiniteMap_p.hi b/ghc/lib/ghc/FiniteMap_p.hi index 393bb4b684..1e3fa4478e 100644 --- a/ghc/lib/ghc/FiniteMap_p.hi +++ b/ghc/lib/ghc/FiniteMap_p.hi @@ -52,4 +52,6 @@ singletonFM :: a -> b -> FiniteMap a b {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} sizeFM :: FiniteMap a b -> Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-} +instance (Eq a, Eq b) => Eq (FiniteMap a b) + {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/FiniteMap_t.hi b/ghc/lib/ghc/FiniteMap_t.hi index 393bb4b684..1e3fa4478e 100644 --- a/ghc/lib/ghc/FiniteMap_t.hi +++ b/ghc/lib/ghc/FiniteMap_t.hi @@ -52,4 +52,6 @@ singletonFM :: a -> b -> FiniteMap a b {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} sizeFM :: FiniteMap a b -> Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-} +instance (Eq a, Eq b) => Eq (FiniteMap a b) + {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/MatchPS.lhs b/ghc/lib/ghc/MatchPS.lhs index 54ed33c187..df05e3566b 100644 --- a/ghc/lib/ghc/MatchPS.lhs +++ b/ghc/lib/ghc/MatchPS.lhs @@ -264,8 +264,9 @@ replace (REmatch arr before@(_,b_end) match after lst) acc else let - x@(C# x#) = _headPS repl - xs = _tailPS' repl + x = _headPS repl + x# = case x of { C# c -> c } + xs = _tailPS' repl in case x# of '\\'# -> diff --git a/ghc/lib/ghc/PackedString.hi b/ghc/lib/ghc/PackedString.hi index e772849aa0..c7921866a3 100644 --- a/ghc/lib/ghc/PackedString.hi +++ b/ghc/lib/ghc/PackedString.hi @@ -28,6 +28,8 @@ foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldlPS _N_ #-} foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldrPS _N_ #-} +getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} headPS :: _PackedString -> Char {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _headPS _N_ #-} implode :: [Char] -> _PackedString @@ -44,12 +46,20 @@ nilPS :: _PackedString {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _CPS [] [""#, 0#] _N_ #-} nullPS :: _PackedString -> Bool {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _nullPS _N_ #-} +packBytesForC :: [Char] -> _ByteArray Int + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForC _N_ #-} +packBytesForCST :: [Char] -> _State a -> (_ByteArray Int, _State a) + {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForCST _N_ #-} packCBytes :: Int -> _Addr -> _PackedString {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} +packCBytesST :: Int -> _Addr -> _State a -> (_PackedString, _State a) + {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(P)U(P)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} packCString :: _Addr -> _PackedString {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} packString :: [Char] -> _PackedString {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packString _N_ #-} +packStringST :: [Char] -> _State a -> (_PackedString, _State a) + {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packStringST _N_ #-} psToByteArray :: _PackedString -> _ByteArray Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _psToByteArray _N_ #-} putPS :: _FILE -> _PackedString -> _State _RealWorld -> ((), _State _RealWorld) diff --git a/ghc/lib/ghc/PackedString.lhs b/ghc/lib/ghc/PackedString.lhs index 9612dddfa0..00eea352c3 100644 --- a/ghc/lib/ghc/PackedString.lhs +++ b/ghc/lib/ghc/PackedString.lhs @@ -3,56 +3,67 @@ % \section[PackedString]{Packed strings} -A non-weird interface to the wired-in @PackedString@ type. +A non-weird/abstract interface to the wired-in @PackedString@ type. \begin{code} module PackedString ( PackedString(..), - packString, - packCString, - packCBytes, + packString, -- :: [Char] -> PackedString + packCString, -- :: _Addr -> PackedString + packCBytes, -- :: Int -> _Addr -> PackedString + + packStringST, -- :: [Char] -> _ST s PackedString + packCBytesST, -- :: Int -> _Addr -> _ST s PackedString + packBytesForC, -- :: [Char] -> _ByteArray Int + packBytesForCST, -- :: [Char] -> _ST s (_ByteArray Int) + --NO: packStringForC, - nilPS, - consPS, - byteArrayToPS, - psToByteArray, + nilPS, -- :: PackedString + consPS, -- :: Char -> PackedString -> PackedString + byteArrayToPS, -- :: _ByteArray Int -> PackedString + psToByteArray, -- :: PackedString -> _ByteArray Int - unpackPS, + unpackPS, -- :: PackedString -> [Char] --NO: unpackPS#, - putPS, - - implode, explode, -- alt. names for packString, unpackPS - - headPS, - tailPS, - nullPS, - appendPS, - lengthPS, - indexPS, - mapPS, - filterPS, - foldlPS, - foldrPS, - takePS, - dropPS, - splitAtPS, - takeWhilePS, - dropWhilePS, - spanPS, - breakPS, - linesPS, - wordsPS, - reversePS, - concatPS, - - substrPS, + putPS, -- :: _FILE -> PackedString -> PrimIO () + getPS, -- :: _FILE -> Int -> PrimIO PackedString + + {- alt. names for packString, unpackPS -} + implode, -- :: [Char] -> PackedString + explode, -- :: PackedString -> [Char] + + headPS, -- :: PackedString -> Char + tailPS, -- :: PackedString -> PackedString + nullPS, -- :: PackedString -> Bool + appendPS, -- :: PackedString -> PackedString -> PackedString + lengthPS, -- :: PackedString -> Int + indexPS, -- :: PackedString -> Int -> Char + mapPS, -- :: (Char -> Char) -> PackedString -> PackedString + filterPS, -- :: (Char -> Bool) -> PackedString -> PackedString + foldlPS, -- :: (a -> Char -> a) -> a -> PackedString -> a + foldrPS, -- :: (Char -> a -> a) -> a -> PackedString -> a + takePS, -- :: Int -> PackedString -> PackedString + dropPS, -- :: Int -> PackedString -> PackedString + splitAtPS, -- :: Int -> PackedString -> PackedString + takeWhilePS, -- :: (Char -> Bool) -> PackedString -> PackedString + dropWhilePS, -- :: (Char -> Bool) -> PackedString -> PackedString + spanPS, -- :: (Char -> Bool) -> PackedString -> (PackedString, PackedString) + breakPS, -- :: (Char -> Bool) -> PackedString -> (PackedString, PackedString) + linesPS, -- :: PackedString -> [PackedString] + wordsPS, -- :: PackedString -> [PackedString] + reversePS, -- :: PackedString -> PackedString + concatPS, -- :: [PackedString] -> PackedString + + substrPS, -- :: PackedString -> Int -> Int -> PackedString -- to make interface self-sufficient _PackedString, -- abstract! _FILE ) where +import PS + type PackedString = _PackedString packString = _packString @@ -65,8 +76,14 @@ consPS = _consPS byteArrayToPS = _byteArrayToPS psToByteArray = _psToByteArray +packStringST = _packStringST +packCBytesST = _packCBytesST +packBytesForC = _packBytesForC +packBytesForCST = _packBytesForCST + unpackPS = _unpackPS putPS = _putPS +getPS = _getPS implode = _packString -- alt. names explode = _unpackPS diff --git a/ghc/lib/ghc/PackedString_mc.hi b/ghc/lib/ghc/PackedString_mc.hi index e772849aa0..c7921866a3 100644 --- a/ghc/lib/ghc/PackedString_mc.hi +++ b/ghc/lib/ghc/PackedString_mc.hi @@ -28,6 +28,8 @@ foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldlPS _N_ #-} foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldrPS _N_ #-} +getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} headPS :: _PackedString -> Char {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _headPS _N_ #-} implode :: [Char] -> _PackedString @@ -44,12 +46,20 @@ nilPS :: _PackedString {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _CPS [] [""#, 0#] _N_ #-} nullPS :: _PackedString -> Bool {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _nullPS _N_ #-} +packBytesForC :: [Char] -> _ByteArray Int + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForC _N_ #-} +packBytesForCST :: [Char] -> _State a -> (_ByteArray Int, _State a) + {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForCST _N_ #-} packCBytes :: Int -> _Addr -> _PackedString {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} +packCBytesST :: Int -> _Addr -> _State a -> (_PackedString, _State a) + {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(P)U(P)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} packCString :: _Addr -> _PackedString {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} packString :: [Char] -> _PackedString {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packString _N_ #-} +packStringST :: [Char] -> _State a -> (_PackedString, _State a) + {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packStringST _N_ #-} psToByteArray :: _PackedString -> _ByteArray Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _psToByteArray _N_ #-} putPS :: _FILE -> _PackedString -> _State _RealWorld -> ((), _State _RealWorld) diff --git a/ghc/lib/ghc/PackedString_mp.hi b/ghc/lib/ghc/PackedString_mp.hi index e772849aa0..c7921866a3 100644 --- a/ghc/lib/ghc/PackedString_mp.hi +++ b/ghc/lib/ghc/PackedString_mp.hi @@ -28,6 +28,8 @@ foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldlPS _N_ #-} foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldrPS _N_ #-} +getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} headPS :: _PackedString -> Char {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _headPS _N_ #-} implode :: [Char] -> _PackedString @@ -44,12 +46,20 @@ nilPS :: _PackedString {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _CPS [] [""#, 0#] _N_ #-} nullPS :: _PackedString -> Bool {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _nullPS _N_ #-} +packBytesForC :: [Char] -> _ByteArray Int + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForC _N_ #-} +packBytesForCST :: [Char] -> _State a -> (_ByteArray Int, _State a) + {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForCST _N_ #-} packCBytes :: Int -> _Addr -> _PackedString {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} +packCBytesST :: Int -> _Addr -> _State a -> (_PackedString, _State a) + {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(P)U(P)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} packCString :: _Addr -> _PackedString {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} packString :: [Char] -> _PackedString {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packString _N_ #-} +packStringST :: [Char] -> _State a -> (_PackedString, _State a) + {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packStringST _N_ #-} psToByteArray :: _PackedString -> _ByteArray Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _psToByteArray _N_ #-} putPS :: _FILE -> _PackedString -> _State _RealWorld -> ((), _State _RealWorld) diff --git a/ghc/lib/ghc/PackedString_p.hi b/ghc/lib/ghc/PackedString_p.hi index e772849aa0..c7921866a3 100644 --- a/ghc/lib/ghc/PackedString_p.hi +++ b/ghc/lib/ghc/PackedString_p.hi @@ -28,6 +28,8 @@ foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldlPS _N_ #-} foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldrPS _N_ #-} +getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} headPS :: _PackedString -> Char {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _headPS _N_ #-} implode :: [Char] -> _PackedString @@ -44,12 +46,20 @@ nilPS :: _PackedString {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _CPS [] [""#, 0#] _N_ #-} nullPS :: _PackedString -> Bool {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _nullPS _N_ #-} +packBytesForC :: [Char] -> _ByteArray Int + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForC _N_ #-} +packBytesForCST :: [Char] -> _State a -> (_ByteArray Int, _State a) + {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForCST _N_ #-} packCBytes :: Int -> _Addr -> _PackedString {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} +packCBytesST :: Int -> _Addr -> _State a -> (_PackedString, _State a) + {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(P)U(P)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} packCString :: _Addr -> _PackedString {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} packString :: [Char] -> _PackedString {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packString _N_ #-} +packStringST :: [Char] -> _State a -> (_PackedString, _State a) + {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packStringST _N_ #-} psToByteArray :: _PackedString -> _ByteArray Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _psToByteArray _N_ #-} putPS :: _FILE -> _PackedString -> _State _RealWorld -> ((), _State _RealWorld) diff --git a/ghc/lib/ghc/PackedString_t.hi b/ghc/lib/ghc/PackedString_t.hi index e772849aa0..c7921866a3 100644 --- a/ghc/lib/ghc/PackedString_t.hi +++ b/ghc/lib/ghc/PackedString_t.hi @@ -28,6 +28,8 @@ foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldlPS _N_ #-} foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _foldrPS _N_ #-} +getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 211 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} headPS :: _PackedString -> Char {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _headPS _N_ #-} implode :: [Char] -> _PackedString @@ -44,12 +46,20 @@ nilPS :: _PackedString {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _CPS [] [""#, 0#] _N_ #-} nullPS :: _PackedString -> Bool {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _nullPS _N_ #-} +packBytesForC :: [Char] -> _ByteArray Int + {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForC _N_ #-} +packBytesForCST :: [Char] -> _State a -> (_ByteArray Int, _State a) + {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packBytesForCST _N_ #-} packCBytes :: Int -> _Addr -> _PackedString {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} +packCBytesST :: Int -> _Addr -> _State a -> (_PackedString, _State a) + {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "U(P)U(P)L" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} packCString :: _Addr -> _PackedString {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} packString :: [Char] -> _PackedString {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packString _N_ #-} +packStringST :: [Char] -> _State a -> (_PackedString, _State a) + {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _packStringST _N_ #-} psToByteArray :: _PackedString -> _ByteArray Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 0 0 X 1 _ORIG_ PreludePS _psToByteArray _N_ #-} putPS :: _FILE -> _PackedString -> _State _RealWorld -> ((), _State _RealWorld) diff --git a/ghc/lib/ghc/Readline.lhs b/ghc/lib/ghc/Readline.lhs index e3eeece840..16cb0216d7 100644 --- a/ghc/lib/ghc/Readline.lhs +++ b/ghc/lib/ghc/Readline.lhs @@ -99,7 +99,7 @@ i.e. add the (KeyCode,RlCallbackFunction) key to the assoc. list and register the generic callback for this KeyCode. The entry point that $genericRlCback$ calls would then read the -global variables $current_i$ and $current_kc$ and do a lookup: +global variables $current\_i$ and $current\_kc$ and do a lookup: \begin{code} rlAddDefun :: String -> -- Function Name @@ -121,10 +121,10 @@ rlAddDefun name cback key = The C function $genericRlCallback$ puts the callback arguments into global variables and enters the Haskell world through the $haskellRlEntry$ function. Before exiting, the Haskell function will -deposit its result in the global varariable $rl_return$. +deposit its result in the global varariable $rl\_return$. In the Haskell action that is invoked via $enterStablePtr$, a match -between the Keycode in $current_kc$ and the Haskell callback needs to +between the Keycode in $current\_kc$ and the Haskell callback needs to be made. To essentially keep the same assoc. list of (KeyCode,cback function) as Readline does, we make use of yet another global variable $cbackList$: diff --git a/ghc/lib/ghc/Set.hi b/ghc/lib/ghc/Set.hi index b0f9dee050..ad1d9567dc 100644 --- a/ghc/lib/ghc/Set.hi +++ b/ghc/lib/ghc/Set.hi @@ -1,36 +1,38 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface Set where -import FiniteMap(FiniteMap, intersectFM, keysFM, minusFM, plusFM) +import FiniteMap(FiniteMap, keysFM, sizeFM) data FiniteMap a b {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-} -type Set a = FiniteMap a () -elementOf :: Ord a => a -> FiniteMap a () -> Bool +data Set a {-# GHC_PRAGMA MkSet (FiniteMap a ()) #-} +cardinality :: Set a -> Int + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap sizeFM { u0 } { () } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_ _TYAPP_ _TYAPP_ _ORIG_ FiniteMap sizeFM { u0 } { () } [ u2 ]; _NO_DEFLT_ } _N_ #-} +elementOf :: Ord a => a -> Set a -> Bool {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-} -emptySet :: FiniteMap a () - {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ FiniteMap EmptyFM [u0, ()] [] _N_ #-} -intersect :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap intersectFM { u0 } { () } _N_ #-} -intersectFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -isEmptySet :: FiniteMap a () -> Bool - {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +emptySet :: Set a + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intersect :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +isEmptySet :: Set a -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-} keysFM :: FiniteMap b a -> [b] {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} -mapSet :: Ord b => (a -> b) -> FiniteMap a () -> FiniteMap b () +mapSet :: Ord b => (a -> b) -> Set a -> Set b {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-} -minusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -minusSet :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap minusFM { u0 } { () } _N_ #-} -mkSet :: Ord a => [a] -> FiniteMap a () +minusSet :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +mkSet :: Ord a => [a] -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-} -plusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -setToList :: FiniteMap a () -> [a] - {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } _N_ #-} -singletonSet :: a -> FiniteMap a () +setToList :: Set a -> [a] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_ _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } [ u2 ]; _NO_DEFLT_ } _N_ #-} +singletonSet :: a -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} -union :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap plusFM { u0 } { () } _N_ #-} -unionManySets :: Ord a => [FiniteMap a ()] -> FiniteMap a () +sizeFM :: FiniteMap a b -> Int + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-} +union :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +unionManySets :: Ord a => [Set a] -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance (Eq a, Eq b) => Eq (FiniteMap a b) + {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance Eq a => Eq (Set a) + {-# GHC_PRAGMA _M_ Set {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/Set.lhs b/ghc/lib/ghc/Set.lhs index c51160f0ae..0ac419ab6b 100644 --- a/ghc/lib/ghc/Set.lhs +++ b/ghc/lib/ghc/Set.lhs @@ -1,5 +1,5 @@ % -% (c) The AQUA Project, Glasgow University, 1994 +% (c) The AQUA Project, Glasgow University, 1994-1995 % \section[Set]{An implementation of sets} @@ -7,35 +7,26 @@ This new (94/04) implementation of sets sits squarely upon our implementation of @FiniteMaps@. The interface is (roughly?) as before. -See also the @UniqSet@ module (sets of things from which you can -extract a @Unique@). +(95/08: This module is no longer part of the GHC compiler proper; it +is a GHC library module only, now.) \begin{code} -#if defined(COMPILING_GHC) && defined(DEBUG_FINITEMAPS) -#define OUTPUTABLE_a , Outputable a -#else -#define OUTPUTABLE_a {--} -#endif - module Set ( -#if defined(__GLASGOW_HASKELL__) - Set(..), -- abstract type: NOT -#else -- not a synonym so we can make it abstract Set, -#endif mkSet, setToList, emptySet, singletonSet, union, unionManySets, minusSet, elementOf, mapSet, - intersect, isEmptySet + intersect, isEmptySet, + cardinality -- to make the interface self-sufficient #if defined(__GLASGOW_HASKELL__) , FiniteMap -- abstract -- for pragmas - , intersectFM, minusFM, keysFM, plusFM + , keysFM, sizeFM #endif ) where @@ -45,28 +36,11 @@ import Maybes ( maybeToBool , Maybe(..) #endif ) -#if defined(__GLASGOW_HASKELL__) --- I guess this is here so that our friend USE_ATTACK_PRAGMAS can --- do his job of seeking out and destroying information hiding. ADR -import Util --OLD: hiding ( Set(..), emptySet ) -#endif - -#if defined(COMPILING_GHC) -import Outputable -#endif \end{code} \begin{code} -#if defined(__GLASGOW_HASKELL__) - -type Set a = FiniteMap a () - -#define MkSet {--} - -#else -- This can't be a type synonym if you want to use constructor classes. data Set a = MkSet (FiniteMap a ()) {-# STRICT #-} -#endif emptySet :: Set a emptySet = MkSet emptyFM @@ -77,27 +51,40 @@ singletonSet x = MkSet (singletonFM x ()) setToList :: Set a -> [a] setToList (MkSet set) = keysFM set -mkSet :: (Ord a OUTPUTABLE_a) => [a] -> Set a +mkSet :: Ord a => [a] -> Set a mkSet xs = MkSet (listToFM [ (x, ()) | x <- xs]) -union :: (Ord a OUTPUTABLE_a) => Set a -> Set a -> Set a +union :: Ord a => Set a -> Set a -> Set a union (MkSet set1) (MkSet set2) = MkSet (plusFM set1 set2) -unionManySets :: (Ord a OUTPUTABLE_a) => [Set a] -> Set a +unionManySets :: Ord a => [Set a] -> Set a unionManySets ss = foldr union emptySet ss -minusSet :: (Ord a OUTPUTABLE_a) => Set a -> Set a -> Set a +minusSet :: Ord a => Set a -> Set a -> Set a minusSet (MkSet set1) (MkSet set2) = MkSet (minusFM set1 set2) -intersect :: (Ord a OUTPUTABLE_a) => Set a -> Set a -> Set a +intersect :: Ord a => Set a -> Set a -> Set a intersect (MkSet set1) (MkSet set2) = MkSet (intersectFM set1 set2) -elementOf :: (Ord a OUTPUTABLE_a) => a -> Set a -> Bool +elementOf :: Ord a => a -> Set a -> Bool elementOf x (MkSet set) = maybeToBool(lookupFM set x) isEmptySet :: Set a -> Bool isEmptySet (MkSet set) = sizeFM set == 0 -mapSet :: (Ord a OUTPUTABLE_a) => (b -> a) -> Set b -> Set a +mapSet :: Ord a => (b -> a) -> Set b -> Set a mapSet f (MkSet set) = MkSet (listToFM [ (f key, ()) | key <- keysFM set ]) + +cardinality :: Set a -> Int +cardinality (MkSet set) = sizeFM set + +-- fair enough... +instance (Eq a) => Eq (Set a) where + (MkSet set_1) == (MkSet set_2) = set_1 == set_2 + +-- but not so clear what the right thing to do is: +{- NO: +instance (Ord a) => Ord (Set a) where + (MkSet set_1) <= (MkSet set_2) = set_1 <= set_2 +-} \end{code} diff --git a/ghc/lib/ghc/Set_mc.hi b/ghc/lib/ghc/Set_mc.hi index b0f9dee050..ad1d9567dc 100644 --- a/ghc/lib/ghc/Set_mc.hi +++ b/ghc/lib/ghc/Set_mc.hi @@ -1,36 +1,38 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface Set where -import FiniteMap(FiniteMap, intersectFM, keysFM, minusFM, plusFM) +import FiniteMap(FiniteMap, keysFM, sizeFM) data FiniteMap a b {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-} -type Set a = FiniteMap a () -elementOf :: Ord a => a -> FiniteMap a () -> Bool +data Set a {-# GHC_PRAGMA MkSet (FiniteMap a ()) #-} +cardinality :: Set a -> Int + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap sizeFM { u0 } { () } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_ _TYAPP_ _TYAPP_ _ORIG_ FiniteMap sizeFM { u0 } { () } [ u2 ]; _NO_DEFLT_ } _N_ #-} +elementOf :: Ord a => a -> Set a -> Bool {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-} -emptySet :: FiniteMap a () - {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ FiniteMap EmptyFM [u0, ()] [] _N_ #-} -intersect :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap intersectFM { u0 } { () } _N_ #-} -intersectFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -isEmptySet :: FiniteMap a () -> Bool - {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +emptySet :: Set a + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intersect :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +isEmptySet :: Set a -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-} keysFM :: FiniteMap b a -> [b] {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} -mapSet :: Ord b => (a -> b) -> FiniteMap a () -> FiniteMap b () +mapSet :: Ord b => (a -> b) -> Set a -> Set b {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-} -minusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -minusSet :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap minusFM { u0 } { () } _N_ #-} -mkSet :: Ord a => [a] -> FiniteMap a () +minusSet :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +mkSet :: Ord a => [a] -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-} -plusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -setToList :: FiniteMap a () -> [a] - {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } _N_ #-} -singletonSet :: a -> FiniteMap a () +setToList :: Set a -> [a] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_ _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } [ u2 ]; _NO_DEFLT_ } _N_ #-} +singletonSet :: a -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} -union :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap plusFM { u0 } { () } _N_ #-} -unionManySets :: Ord a => [FiniteMap a ()] -> FiniteMap a () +sizeFM :: FiniteMap a b -> Int + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-} +union :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +unionManySets :: Ord a => [Set a] -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance (Eq a, Eq b) => Eq (FiniteMap a b) + {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance Eq a => Eq (Set a) + {-# GHC_PRAGMA _M_ Set {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/Set_mg.hi b/ghc/lib/ghc/Set_mg.hi index b0f9dee050..ad1d9567dc 100644 --- a/ghc/lib/ghc/Set_mg.hi +++ b/ghc/lib/ghc/Set_mg.hi @@ -1,36 +1,38 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface Set where -import FiniteMap(FiniteMap, intersectFM, keysFM, minusFM, plusFM) +import FiniteMap(FiniteMap, keysFM, sizeFM) data FiniteMap a b {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-} -type Set a = FiniteMap a () -elementOf :: Ord a => a -> FiniteMap a () -> Bool +data Set a {-# GHC_PRAGMA MkSet (FiniteMap a ()) #-} +cardinality :: Set a -> Int + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap sizeFM { u0 } { () } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_ _TYAPP_ _TYAPP_ _ORIG_ FiniteMap sizeFM { u0 } { () } [ u2 ]; _NO_DEFLT_ } _N_ #-} +elementOf :: Ord a => a -> Set a -> Bool {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-} -emptySet :: FiniteMap a () - {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ FiniteMap EmptyFM [u0, ()] [] _N_ #-} -intersect :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap intersectFM { u0 } { () } _N_ #-} -intersectFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -isEmptySet :: FiniteMap a () -> Bool - {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +emptySet :: Set a + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intersect :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +isEmptySet :: Set a -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-} keysFM :: FiniteMap b a -> [b] {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} -mapSet :: Ord b => (a -> b) -> FiniteMap a () -> FiniteMap b () +mapSet :: Ord b => (a -> b) -> Set a -> Set b {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-} -minusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -minusSet :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap minusFM { u0 } { () } _N_ #-} -mkSet :: Ord a => [a] -> FiniteMap a () +minusSet :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +mkSet :: Ord a => [a] -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-} -plusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -setToList :: FiniteMap a () -> [a] - {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } _N_ #-} -singletonSet :: a -> FiniteMap a () +setToList :: Set a -> [a] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_ _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } [ u2 ]; _NO_DEFLT_ } _N_ #-} +singletonSet :: a -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} -union :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap plusFM { u0 } { () } _N_ #-} -unionManySets :: Ord a => [FiniteMap a ()] -> FiniteMap a () +sizeFM :: FiniteMap a b -> Int + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-} +union :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +unionManySets :: Ord a => [Set a] -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance (Eq a, Eq b) => Eq (FiniteMap a b) + {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance Eq a => Eq (Set a) + {-# GHC_PRAGMA _M_ Set {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/Set_mp.hi b/ghc/lib/ghc/Set_mp.hi index b0f9dee050..ad1d9567dc 100644 --- a/ghc/lib/ghc/Set_mp.hi +++ b/ghc/lib/ghc/Set_mp.hi @@ -1,36 +1,38 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface Set where -import FiniteMap(FiniteMap, intersectFM, keysFM, minusFM, plusFM) +import FiniteMap(FiniteMap, keysFM, sizeFM) data FiniteMap a b {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-} -type Set a = FiniteMap a () -elementOf :: Ord a => a -> FiniteMap a () -> Bool +data Set a {-# GHC_PRAGMA MkSet (FiniteMap a ()) #-} +cardinality :: Set a -> Int + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap sizeFM { u0 } { () } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_ _TYAPP_ _TYAPP_ _ORIG_ FiniteMap sizeFM { u0 } { () } [ u2 ]; _NO_DEFLT_ } _N_ #-} +elementOf :: Ord a => a -> Set a -> Bool {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-} -emptySet :: FiniteMap a () - {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ FiniteMap EmptyFM [u0, ()] [] _N_ #-} -intersect :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap intersectFM { u0 } { () } _N_ #-} -intersectFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -isEmptySet :: FiniteMap a () -> Bool - {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +emptySet :: Set a + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intersect :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +isEmptySet :: Set a -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-} keysFM :: FiniteMap b a -> [b] {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} -mapSet :: Ord b => (a -> b) -> FiniteMap a () -> FiniteMap b () +mapSet :: Ord b => (a -> b) -> Set a -> Set b {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-} -minusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -minusSet :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap minusFM { u0 } { () } _N_ #-} -mkSet :: Ord a => [a] -> FiniteMap a () +minusSet :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +mkSet :: Ord a => [a] -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-} -plusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -setToList :: FiniteMap a () -> [a] - {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } _N_ #-} -singletonSet :: a -> FiniteMap a () +setToList :: Set a -> [a] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_ _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } [ u2 ]; _NO_DEFLT_ } _N_ #-} +singletonSet :: a -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} -union :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap plusFM { u0 } { () } _N_ #-} -unionManySets :: Ord a => [FiniteMap a ()] -> FiniteMap a () +sizeFM :: FiniteMap a b -> Int + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-} +union :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +unionManySets :: Ord a => [Set a] -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance (Eq a, Eq b) => Eq (FiniteMap a b) + {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance Eq a => Eq (Set a) + {-# GHC_PRAGMA _M_ Set {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/Set_p.hi b/ghc/lib/ghc/Set_p.hi index b0f9dee050..ad1d9567dc 100644 --- a/ghc/lib/ghc/Set_p.hi +++ b/ghc/lib/ghc/Set_p.hi @@ -1,36 +1,38 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface Set where -import FiniteMap(FiniteMap, intersectFM, keysFM, minusFM, plusFM) +import FiniteMap(FiniteMap, keysFM, sizeFM) data FiniteMap a b {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-} -type Set a = FiniteMap a () -elementOf :: Ord a => a -> FiniteMap a () -> Bool +data Set a {-# GHC_PRAGMA MkSet (FiniteMap a ()) #-} +cardinality :: Set a -> Int + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap sizeFM { u0 } { () } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_ _TYAPP_ _TYAPP_ _ORIG_ FiniteMap sizeFM { u0 } { () } [ u2 ]; _NO_DEFLT_ } _N_ #-} +elementOf :: Ord a => a -> Set a -> Bool {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-} -emptySet :: FiniteMap a () - {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ FiniteMap EmptyFM [u0, ()] [] _N_ #-} -intersect :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap intersectFM { u0 } { () } _N_ #-} -intersectFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -isEmptySet :: FiniteMap a () -> Bool - {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +emptySet :: Set a + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intersect :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +isEmptySet :: Set a -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-} keysFM :: FiniteMap b a -> [b] {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} -mapSet :: Ord b => (a -> b) -> FiniteMap a () -> FiniteMap b () +mapSet :: Ord b => (a -> b) -> Set a -> Set b {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-} -minusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -minusSet :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap minusFM { u0 } { () } _N_ #-} -mkSet :: Ord a => [a] -> FiniteMap a () +minusSet :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +mkSet :: Ord a => [a] -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-} -plusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -setToList :: FiniteMap a () -> [a] - {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } _N_ #-} -singletonSet :: a -> FiniteMap a () +setToList :: Set a -> [a] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_ _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } [ u2 ]; _NO_DEFLT_ } _N_ #-} +singletonSet :: a -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} -union :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap plusFM { u0 } { () } _N_ #-} -unionManySets :: Ord a => [FiniteMap a ()] -> FiniteMap a () +sizeFM :: FiniteMap a b -> Int + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-} +union :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +unionManySets :: Ord a => [Set a] -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance (Eq a, Eq b) => Eq (FiniteMap a b) + {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance Eq a => Eq (Set a) + {-# GHC_PRAGMA _M_ Set {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/Set_t.hi b/ghc/lib/ghc/Set_t.hi index b0f9dee050..ad1d9567dc 100644 --- a/ghc/lib/ghc/Set_t.hi +++ b/ghc/lib/ghc/Set_t.hi @@ -1,36 +1,38 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface Set where -import FiniteMap(FiniteMap, intersectFM, keysFM, minusFM, plusFM) +import FiniteMap(FiniteMap, keysFM, sizeFM) data FiniteMap a b {-# GHC_PRAGMA EmptyFM | Branch a b Int# (FiniteMap a b) (FiniteMap a b) #-} -type Set a = FiniteMap a () -elementOf :: Ord a => a -> FiniteMap a () -> Bool +data Set a {-# GHC_PRAGMA MkSet (FiniteMap a ()) #-} +cardinality :: Set a -> Int + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap sizeFM { u0 } { () } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_ _TYAPP_ _TYAPP_ _ORIG_ FiniteMap sizeFM { u0 } { () } [ u2 ]; _NO_DEFLT_ } _N_ #-} +elementOf :: Ord a => a -> Set a -> Bool {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-} -emptySet :: FiniteMap a () - {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _!_ _ORIG_ FiniteMap EmptyFM [u0, ()] [] _N_ #-} -intersect :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap intersectFM { u0 } { () } _N_ #-} -intersectFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -isEmptySet :: FiniteMap a () -> Bool - {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} +emptySet :: Set a + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} +intersect :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +isEmptySet :: Set a -> Bool + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _N_ _N_} _N_ _N_ #-} keysFM :: FiniteMap b a -> [b] {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} -mapSet :: Ord b => (a -> b) -> FiniteMap a () -> FiniteMap b () +mapSet :: Ord b => (a -> b) -> Set a -> Set b {-# GHC_PRAGMA _A_ 1 _U_ 121 _N_ _N_ _N_ _N_ #-} -minusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -minusSet :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap minusFM { u0 } { () } _N_ #-} -mkSet :: Ord a => [a] -> FiniteMap a () +minusSet :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +mkSet :: Ord a => [a] -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 11 _N_ _N_ _N_ _N_ #-} -plusFM :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _N_ _N_ #-} -setToList :: FiniteMap a () -> [a] - {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } _N_ #-} -singletonSet :: a -> FiniteMap a () +setToList :: Set a -> [a] + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(S)" {_A_ 1 _U_ 1 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } _N_} _F_ _IF_ARGS_ 1 1 C 3 _/\_ u0 -> \ (u1 :: Set u0) -> case u1 of { _ALG_ _ORIG_ Set MkSet (u2 :: FiniteMap u0 ()) -> _APP_ _TYAPP_ _TYAPP_ _ORIG_ FiniteMap keysFM { () } { u0 } [ u2 ]; _NO_DEFLT_ } _N_ #-} +singletonSet :: a -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} -union :: Ord a => FiniteMap a () -> FiniteMap a () -> FiniteMap a () - {-# GHC_PRAGMA _A_ 1 _U_ 221 _N_ _N_ _F_ _IF_ARGS_ 1 0 X 1 _/\_ u0 -> _TYAPP_ _TYAPP_ _ORIG_ FiniteMap plusFM { u0 } { () } _N_ #-} -unionManySets :: Ord a => [FiniteMap a ()] -> FiniteMap a () +sizeFM :: FiniteMap a b -> Int + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _F_ _IF_ARGS_ 2 1 C 6 _/\_ u0 u1 -> \ (u2 :: FiniteMap u0 u1) -> case u2 of { _ALG_ _ORIG_ FiniteMap EmptyFM -> _!_ I# [] [0#]; _ORIG_ FiniteMap Branch (u3 :: u0) (u4 :: u1) (u5 :: Int#) (u6 :: FiniteMap u0 u1) (u7 :: FiniteMap u0 u1) -> _!_ I# [] [u5]; _NO_DEFLT_ } _N_ #-} +union :: Ord a => Set a -> Set a -> Set a + {-# GHC_PRAGMA _A_ 1 _U_ 211 _N_ _N_ _N_ _N_ #-} +unionManySets :: Ord a => [Set a] -> Set a {-# GHC_PRAGMA _A_ 1 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance (Eq a, Eq b) => Eq (FiniteMap a b) + {-# GHC_PRAGMA _M_ FiniteMap {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} +instance Eq a => Eq (Set a) + {-# GHC_PRAGMA _M_ Set {-dfun-} _A_ 1 _U_ 2 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/Socket.lhs b/ghc/lib/ghc/Socket.lhs index 5326dd7413..1ab6bf20ac 100644 --- a/ghc/lib/ghc/Socket.lhs +++ b/ghc/lib/ghc/Socket.lhs @@ -26,20 +26,15 @@ module Socket ( Socket ) where - import BSD import SocketPrim renaming (accept to socketPrim_accept , socketPort to socketPort_prim ) - - - \end{code} - %*************************************************************************** %* * -\subsection[Socket-Setup]{High Level "Setup" functions} +\subsection[Socket-Setup]{High Level ``Setup'' functions} %* * %*************************************************************************** @@ -62,26 +57,25 @@ data PortID = type Hostname = String -- Maybe consider this alternative. -- data Hostname = Name String | IP Int Int Int Int - - \end{code} If more control over the socket type is required then $socketPrim$ should be used instead. - - \begin{code} connectTo :: Hostname -> -- Hostname PortID -> -- Port Identifier IO Handle -- Connected Socket + connectTo hostname (Service serv) = getProtocolNumber "tcp" >>= \ proto -> socket AF_INET Stream proto >>= \ sock -> getServicePortNumber serv >>= \ port -> getHostByName hostname >>= \ (HostEntry _ _ _ haddrs) -> connect sock (SockAddrInet port (head haddrs)) >> - socketToHandle sock + socketToHandle sock >>= \ h -> + hSetBuffering h NoBuffering >> + return h connectTo hostname (PortNumber port) = getProtocolNumber "tcp" >>= \ proto -> socket AF_INET Stream proto >>= \ sock -> @@ -94,13 +88,13 @@ connectTo _ (UnixSocket path) = socketToHandle sock \end{code} - The dual to the $connectTo$ call. This creates the server side socket which has been bound to the specified port. \begin{code} listenOn :: PortID -> -- Port Identifier IO Socket -- Connected Socket + listenOn (Service serv) = getProtocolNumber "tcp" >>= \ proto -> socket AF_INET Stream proto >>= \ sock -> @@ -124,6 +118,7 @@ listeOn (UnixSocket path) = accept :: Socket -> -- Listening Socket IO (Handle, -- StdIO Handle for read/write HostName) -- HostName of Peer socket + accept sock = socketPrim_accept sock >>= \ (sock', (SockAddrInet _ haddr)) -> getHostByAddr AF_INET haddr >>= \ (HostEntry peer _ _ _) -> @@ -142,17 +137,16 @@ sendTo :: Hostname -> -- Hostname PortID-> -- Port Number String -> -- Message to send IO () + sendTo h p msg = connectTo h p >>= \ s -> hPutStr s msg >> hClose s - - - recvFrom :: Hostname -> -- Hostname PortID-> -- Port Number IO String -- Received Data + recvFrom host port = listenOn port >>= \ s -> let @@ -170,13 +164,13 @@ recvFrom host port = waiting >>= \ message -> sClose s >> return message - \end{code} \begin{code} socketPort :: Socket -> IO PortID + socketPort s = getSocketName s >>= \ sockaddr -> return (case sockaddr of @@ -185,5 +179,4 @@ socketPort s = SockAddrUnix path -> (UnixSocket path) ) - \end{code} diff --git a/ghc/lib/ghc/SocketPrim.hi b/ghc/lib/ghc/SocketPrim.hi index 4595611461..6ba97a640e 100644 --- a/ghc/lib/ghc/SocketPrim.hi +++ b/ghc/lib/ghc/SocketPrim.hi @@ -5,7 +5,7 @@ import PreludeIOError(IOError13) import PreludeMonadicIO(Either) import PreludePrimIO(_MVar) import PreludeStdIO(_Handle) -data Family = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX +data Family = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN type HostAddress = _Word data SockAddr = SockAddrUnix [Char] | SockAddrInet Int _Word data Socket @@ -112,14 +112,14 @@ instance Ord SocketType _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} instance Text Family {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text SocketType {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/SocketPrim.lhs b/ghc/lib/ghc/SocketPrim.lhs index 917b68fc55..5720a1086f 100644 --- a/ghc/lib/ghc/SocketPrim.lhs +++ b/ghc/lib/ghc/SocketPrim.lhs @@ -3,8 +3,10 @@ % % Last Modified: Fri Jul 21 15:14:43 1995 % Darren J Moffat <moffatd@dcs.gla.ac.uk> -\section[Socket]{Haskell 1.3 Socket bindings} +\section[SocketPrim]{Low-level socket bindings} +The @SocketPrim@ module is for when you want full control over the +sockets, something like what you have in C (which is very messy). \begin{code} module SocketPrim ( @@ -98,27 +100,26 @@ on sockets. \begin{code} -data SocketStatus = - -- Returned Status Function called - NotConnected -- socket - | Bound -- bindSocket - | Listening -- listen - | Connected -- connect/accept - | Error String -- Any - deriving (Eq, Text) - -data Socket = MkSocket - Int -- File Descriptor Part - Family - SocketType - Int -- Protocol Number - (MutableVar _RealWorld SocketStatus) -- Status Flag - - +data SocketStatus + -- Returned Status Function called + = NotConnected -- socket + | Bound -- bindSocket + | Listening -- listen + | Connected -- connect/accept + | Error String -- Any + deriving (Eq, Text) + +data Socket + = MkSocket + Int -- File Descriptor Part + Family + SocketType + Int -- Protocol Number + (MutableVar _RealWorld SocketStatus) -- Status Flag \end{code} -In C bind takes either a $struct sockaddr_in$ or a $struct -sockaddr_un$ but these are always type cast to $struct sockaddr$. We +In C bind takes either a $struct sockaddr\_in$ or a $struct +sockaddr\_un$ but these are always type cast to $struct sockaddr$. We attempt to emulate this and provide better type checking. Note that the socket family fields are redundant since this is caputured in the constructor names, it has thus be left out of the Haskell $SockAddr$ @@ -128,16 +129,15 @@ data type. \begin{code} type HostAddress = _Word -data SockAddr = -- C Names - SockAddrUnix -- struct sockaddr_un +data SockAddr -- C Names + = SockAddrUnix -- struct sockaddr_un String -- sun_path | SockAddrInet -- struct sockaddr_in Int -- sin_port HostAddress -- sin_addr - deriving Eq - + deriving Eq \end{code} @@ -155,7 +155,6 @@ be noted that some of these names used in the C library, bind in particular, have a different meaning to many Haskell programmers and have thus been renamed by appending the prefix Socket. - Create an unconnected socket of the given family, type and protocol. The most common invocation of $socket$ is the following: \begin{verbatim} @@ -202,7 +201,7 @@ Given a port number this {\em binds} the socket to that port. This means that the programmer is only interested in data being sent to that port number. The $Family$ passed to $bindSocket$ must be the same as that passed to $socket$. If the special port -number $aNY_PORT$ is passed then the system assigns the next +number $aNY\_PORT$ is passed then the system assigns the next available use port. Port numbers for standard unix services can be found by calling @@ -210,7 +209,7 @@ $getServiceEntry$. These are traditionally port numbers below 1000; although there are afew, namely NFS and IRC, which used higher numbered ports. -The port number allocated to a socket bound by using $aNY_PORT$ can be +The port number allocated to a socket bound by using $aNY\_PORT$ can be found by calling $port$ \begin{code} @@ -251,7 +250,6 @@ bindSocket (MkSocket s family stype protocol status) addr = else writeVar status (Bound) `seqPrimIO` return () - \end{code} @@ -403,7 +401,6 @@ accept sock@(MkSocket s family stype protocol status) = unpackSockAddr ptr `thenPrimIO` \ addr -> newVar Connected `thenPrimIO` \ status -> return ((MkSocket sock family stype protocol status), addr) - \end{code} %************************************************************************ @@ -520,12 +517,11 @@ readSocketAll s = return xs in loop "" - \end{code} The port number the given socket is currently connected to can be determined by calling $port$, is generally only useful when bind -was given $aNY_PORT$. +was given $aNY\_PORT$. \begin{code} socketPort :: Socket -> -- Connected & Bound Socket @@ -618,9 +614,9 @@ A calling sequence table for the main functions is shown in the table below. \begin{center} \begin{tabular}{|l|c|c|c|c|c|c|c|} \hline -\textbf{A Call to} & socket & connect & bindSocket & listen & accept & read & write \\ +{\bf A Call to} & socket & connect & bindSocket & listen & accept & read & write \\ \hline -\textbf{Precedes} & & & & & & & \\ +{\bf Precedes} & & & & & & & \\ \hline socket & & & & & & & \\ \hline @@ -644,7 +640,7 @@ write & & + & & + & + & + & + \\ %************************************************************************ %* * -\subsection[Socket-OSDefs]{OS Dependant Definitions} +\subsection[Socket-OSDefs]{OS Dependent Definitions} %* * %************************************************************************ @@ -653,8 +649,8 @@ The following Family and Socket Type declarations were manually derived from /usr/include/sys/socket.h on the appropriate machines. Maybe a configure script that could parse the socket.h file to produce -the following declaration is required to make it "portable" rather than -using the dreded \#ifdefs. +the following declaration is required to make it ``portable'' rather than +using the dreaded \#ifdefs. Presently only the following machine/os combinations are supported: @@ -666,7 +662,6 @@ Presently only the following machine/os combinations are supported: \end{itemize} \begin{code} - unpackFamily :: Int -> Family packFamily :: Family -> Int @@ -795,7 +790,6 @@ data SocketType = packSocketType stype = 1 + (index (Stream, Packet) stype) #endif - \end{code} %************************************************************************ diff --git a/ghc/lib/ghc/SocketPrim_mc.hi b/ghc/lib/ghc/SocketPrim_mc.hi index 4595611461..6ba97a640e 100644 --- a/ghc/lib/ghc/SocketPrim_mc.hi +++ b/ghc/lib/ghc/SocketPrim_mc.hi @@ -5,7 +5,7 @@ import PreludeIOError(IOError13) import PreludeMonadicIO(Either) import PreludePrimIO(_MVar) import PreludeStdIO(_Handle) -data Family = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX +data Family = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN type HostAddress = _Word data SockAddr = SockAddrUnix [Char] | SockAddrInet Int _Word data Socket @@ -112,14 +112,14 @@ instance Ord SocketType _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} instance Text Family {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text SocketType {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/SocketPrim_mg.hi b/ghc/lib/ghc/SocketPrim_mg.hi index 4595611461..64a96f24d6 100644 --- a/ghc/lib/ghc/SocketPrim_mg.hi +++ b/ghc/lib/ghc/SocketPrim_mg.hi @@ -5,7 +5,7 @@ import PreludeIOError(IOError13) import PreludeMonadicIO(Either) import PreludePrimIO(_MVar) import PreludeStdIO(_Handle) -data Family = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX +data Family = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN type HostAddress = _Word data SockAddr = SockAddrUnix [Char] | SockAddrInet Int _Word data Socket @@ -113,13 +113,13 @@ instance Ord SocketType instance Text Family {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_ readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text SocketType {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_ readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/SocketPrim_mp.hi b/ghc/lib/ghc/SocketPrim_mp.hi index 4595611461..6ba97a640e 100644 --- a/ghc/lib/ghc/SocketPrim_mp.hi +++ b/ghc/lib/ghc/SocketPrim_mp.hi @@ -5,7 +5,7 @@ import PreludeIOError(IOError13) import PreludeMonadicIO(Either) import PreludePrimIO(_MVar) import PreludeStdIO(_Handle) -data Family = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX +data Family = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN type HostAddress = _Word data SockAddr = SockAddrUnix [Char] | SockAddrInet Int _Word data Socket @@ -112,14 +112,14 @@ instance Ord SocketType _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} instance Text Family {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text SocketType {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/SocketPrim_p.hi b/ghc/lib/ghc/SocketPrim_p.hi index 4595611461..6ba97a640e 100644 --- a/ghc/lib/ghc/SocketPrim_p.hi +++ b/ghc/lib/ghc/SocketPrim_p.hi @@ -5,7 +5,7 @@ import PreludeIOError(IOError13) import PreludeMonadicIO(Either) import PreludePrimIO(_MVar) import PreludeStdIO(_Handle) -data Family = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX +data Family = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN type HostAddress = _Word data SockAddr = SockAddrUnix [Char] | SockAddrInet Int _Word data Socket @@ -112,14 +112,14 @@ instance Ord SocketType _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} instance Text Family {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text SocketType {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/ghc/SocketPrim_t.hi b/ghc/lib/ghc/SocketPrim_t.hi index 4595611461..6ba97a640e 100644 --- a/ghc/lib/ghc/SocketPrim_t.hi +++ b/ghc/lib/ghc/SocketPrim_t.hi @@ -5,7 +5,7 @@ import PreludeIOError(IOError13) import PreludeMonadicIO(Either) import PreludePrimIO(_MVar) import PreludeStdIO(_Handle) -data Family = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_NBS | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_NIT | AF_802 | AF_OSI | AF_X25 | AF_OSINET | AF_GOSSIP | AF_IPX +data Family = AF_UNSPEC | AF_UNIX | AF_INET | AF_IMPLINK | AF_PUP | AF_CHAOS | AF_NS | AF_ISO | AF_ECMA | AF_DATAKIT | AF_CCITT | AF_SNA | AF_DECnet | AF_DLI | AF_LAT | AF_HYLINK | AF_APPLETALK | AF_ROUTE | AF_LINK | Pseudo_AF_XTP | AF_NETMAN | AF_X25 | AF_CTF | AF_WAN type HostAddress = _Word data SockAddr = SockAddrUnix [Char] | SockAddrInet Int _Word data Socket @@ -112,14 +112,14 @@ instance Ord SocketType _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} instance Text Family {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Family, [Char])]), (Int -> Family -> [Char] -> [Char]), ([Char] -> [([Family], [Char])]), ([Family] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Family), _CONSTM_ Text showsPrec (Family), _CONSTM_ Text readList (Family), _CONSTM_ Text showList (Family)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text SocketType {-# GHC_PRAGMA _M_ SocketPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(SocketType, [Char])]), (Int -> SocketType -> [Char] -> [Char]), ([Char] -> [([SocketType], [Char])]), ([SocketType] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (SocketType), _CONSTM_ Text showsPrec (SocketType), _CONSTM_ Text readList (SocketType), _CONSTM_ Text showList (SocketType)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, - showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LE" _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, + showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/glaExts/PreludeGlaST.hi b/ghc/lib/glaExts/PreludeGlaST.hi index def8023c24..96b959935a 100644 --- a/ghc/lib/glaExts/PreludeGlaST.hi +++ b/ghc/lib/glaExts/PreludeGlaST.hi @@ -109,7 +109,7 @@ readFloatArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Float, _Sta readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b) {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-} readVar :: _MutableArray a Int b -> _State a -> (b, _State a) - {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)U(P))P)U(P)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AP)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-} returnST :: b -> _State a -> (b, _State a) @@ -171,7 +171,7 @@ writeFloatArray :: Ix a => _MutableByteArray b a -> a -> Float -> _State b -> (( writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b) {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-} writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(U(U(P)U(P))P)LU(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AP)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} instance Eq _FILE {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_ (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, diff --git a/ghc/lib/glaExts/PreludeGlaST.lhs b/ghc/lib/glaExts/PreludeGlaST.lhs index a4db1d2f24..75d4f45a25 100644 --- a/ghc/lib/glaExts/PreludeGlaST.lhs +++ b/ghc/lib/glaExts/PreludeGlaST.lhs @@ -705,8 +705,28 @@ readVar :: MutableVar s a -> _ST s a writeVar :: MutableVar s a -> a -> _ST s () sameVar :: MutableVar s a -> MutableVar s a -> Bool +{- MUCH GRATUITOUS INEFFICIENCY: WDP 95/09: + newVar init s = newArray (0,0) init s readVar v s = readArray v 0 s writeVar v val s = writeArray v 0 val s sameVar v1 v2 = sameMutableArray v1 v2 +-} + +newVar init (S# s#) + = case (newArray# 1# init s#) of { StateAndMutableArray# s2# arr# -> + (_MutableArray vAR_IXS arr#, S# s2#) } + where + vAR_IXS = error "Shouldn't access `bounds' of a MutableVar\n" + +readVar (_MutableArray _ var#) (S# s#) + = case readArray# var# 0# s# of { StateAndPtr# s2# r -> + (r, S# s2#) } + +writeVar (_MutableArray _ var#) val (S# s#) + = case writeArray# var# 0# val s# of { s2# -> + ((), S# s2#) } + +sameVar (_MutableArray _ var1#) (_MutableArray _ var2#) + = sameMutableArray# var1# var2# \end{code} diff --git a/ghc/lib/glaExts/PreludeGlaST_mc.hi b/ghc/lib/glaExts/PreludeGlaST_mc.hi index b771c3dcb1..3f8a2b9db5 100644 --- a/ghc/lib/glaExts/PreludeGlaST_mc.hi +++ b/ghc/lib/glaExts/PreludeGlaST_mc.hi @@ -109,7 +109,7 @@ readFloatArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Float, _Sta readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b) {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-} readVar :: _MutableArray a Int b -> _State a -> (b, _State a) - {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)U(P))P)U(P)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AP)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-} returnST :: b -> _State a -> (b, _State a) @@ -171,7 +171,7 @@ writeFloatArray :: Ix a => _MutableByteArray b a -> a -> Float -> _State b -> (( writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b) {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-} writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(U(U(P)U(P))P)LU(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AP)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} instance Eq _FILE {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_ (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, diff --git a/ghc/lib/glaExts/PreludeGlaST_mg.hi b/ghc/lib/glaExts/PreludeGlaST_mg.hi index def8023c24..96b959935a 100644 --- a/ghc/lib/glaExts/PreludeGlaST_mg.hi +++ b/ghc/lib/glaExts/PreludeGlaST_mg.hi @@ -109,7 +109,7 @@ readFloatArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Float, _Sta readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b) {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-} readVar :: _MutableArray a Int b -> _State a -> (b, _State a) - {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)U(P))P)U(P)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AP)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-} returnST :: b -> _State a -> (b, _State a) @@ -171,7 +171,7 @@ writeFloatArray :: Ix a => _MutableByteArray b a -> a -> Float -> _State b -> (( writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b) {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-} writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(U(U(P)U(P))P)LU(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AP)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} instance Eq _FILE {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_ (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, diff --git a/ghc/lib/glaExts/PreludeGlaST_mp.hi b/ghc/lib/glaExts/PreludeGlaST_mp.hi index def8023c24..96b959935a 100644 --- a/ghc/lib/glaExts/PreludeGlaST_mp.hi +++ b/ghc/lib/glaExts/PreludeGlaST_mp.hi @@ -109,7 +109,7 @@ readFloatArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Float, _Sta readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b) {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-} readVar :: _MutableArray a Int b -> _State a -> (b, _State a) - {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)U(P))P)U(P)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AP)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-} returnST :: b -> _State a -> (b, _State a) @@ -171,7 +171,7 @@ writeFloatArray :: Ix a => _MutableByteArray b a -> a -> Float -> _State b -> (( writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b) {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-} writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(U(U(P)U(P))P)LU(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AP)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} instance Eq _FILE {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_ (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, diff --git a/ghc/lib/glaExts/PreludeGlaST_p.hi b/ghc/lib/glaExts/PreludeGlaST_p.hi index def8023c24..96b959935a 100644 --- a/ghc/lib/glaExts/PreludeGlaST_p.hi +++ b/ghc/lib/glaExts/PreludeGlaST_p.hi @@ -109,7 +109,7 @@ readFloatArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Float, _Sta readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b) {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-} readVar :: _MutableArray a Int b -> _State a -> (b, _State a) - {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)U(P))P)U(P)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AP)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-} returnST :: b -> _State a -> (b, _State a) @@ -171,7 +171,7 @@ writeFloatArray :: Ix a => _MutableByteArray b a -> a -> Float -> _State b -> (( writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b) {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-} writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(U(U(P)U(P))P)LU(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AP)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} instance Eq _FILE {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_ (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, diff --git a/ghc/lib/glaExts/PreludeGlaST_t.hi b/ghc/lib/glaExts/PreludeGlaST_t.hi index def8023c24..96b959935a 100644 --- a/ghc/lib/glaExts/PreludeGlaST_t.hi +++ b/ghc/lib/glaExts/PreludeGlaST_t.hi @@ -109,7 +109,7 @@ readFloatArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Float, _Sta readIntArray :: Ix a => _MutableByteArray b a -> a -> _State b -> (Int, _State b) {-# GHC_PRAGMA _A_ 4 _U_ 1121 _N_ _S_ "U(AASA)U(LP)LU(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 3 _U_ 111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ } #-} readVar :: _MutableArray a Int b -> _State a -> (b, _State a) - {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(U(U(P)U(P))P)U(P)" {_A_ 4 _U_ 2222 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 2 _U_ 11 _N_ _S_ "U(AP)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-} returnST :: b -> _State a -> (b, _State a) @@ -171,7 +171,7 @@ writeFloatArray :: Ix a => _MutableByteArray b a -> a -> Float -> _State b -> (( writeIntArray :: Ix a => _MutableByteArray b a -> a -> Int -> _State b -> ((), _State b) {-# GHC_PRAGMA _A_ 5 _U_ 11211 _N_ _S_ "U(AASA)U(LP)LU(P)U(P)" {_A_ 5 _U_ 11222 _N_ _N_ _N_ _N_} _N_ _SPECIALISE_ [ Int, _N_ ] 1 { _A_ 4 _U_ 1111 _N_ _S_ "U(U(U(P)U(P))P)U(P)U(P)U(P)" {_A_ 5 _U_ 12222 _N_ _N_ _N_ _N_} _N_ _N_ } #-} writeVar :: _MutableArray b Int a -> a -> _State b -> ((), _State b) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(U(U(P)U(P))P)LU(P)" {_A_ 5 _U_ 22222 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AP)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} instance Eq _FILE {-# GHC_PRAGMA _M_ Stdio {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_FILE -> _FILE -> Bool), (_FILE -> _FILE -> Bool)] [_CONSTM_ Eq (==) (_FILE), _CONSTM_ Eq (/=) (_FILE)] _N_ (==) = _A_ 2 _U_ 11 _N_ _S_ "U(P)U(P)" {_A_ 2 _U_ 22 _N_ _N_ _F_ _IF_ARGS_ 0 2 XX 1 \ (u0 :: Addr#) (u1 :: Addr#) -> _#_ eqAddr# [] [u0, u1] _N_} _F_ _IF_ARGS_ 0 2 CC 3 \ (u0 :: _FILE) (u1 :: _FILE) -> case u0 of { _ALG_ _ORIG_ Stdio _FILE (u2 :: Addr#) -> case u1 of { _ALG_ _ORIG_ Stdio _FILE (u3 :: Addr#) -> _#_ eqAddr# [] [u2, u3]; _NO_DEFLT_ }; _NO_DEFLT_ } _N_, diff --git a/ghc/lib/haskell-1.3/LibCPUTime.lhs b/ghc/lib/haskell-1.3/LibCPUTime.lhs index c3db93ed45..5cba859708 100644 --- a/ghc/lib/haskell-1.3/LibCPUTime.lhs +++ b/ghc/lib/haskell-1.3/LibCPUTime.lhs @@ -10,12 +10,14 @@ import PreludeGlaST getCPUTime :: IO Integer getCPUTime = - _ccall_ getCPUTime `thenPrimIO` \ ptr@(A# ptr#) -> - if ptr /= ``NULL'' then - return (fromInt (I# (indexIntOffAddr# ptr# 0#)) * 1000000000 + - fromInt (I# (indexIntOffAddr# ptr# 1#)) + - fromInt (I# (indexIntOffAddr# ptr# 2#)) * 1000000000 + - fromInt (I# (indexIntOffAddr# ptr# 3#))) + newIntArray (0,3) `thenPrimIO` \ marr -> + unsafeFreezeByteArray marr `thenPrimIO` \ barr@(_ByteArray _ frozen#) -> + _ccall_ getCPUTime barr `thenPrimIO` \ ptr -> + if (ptr::_Addr) /= ``NULL'' then + return (fromInt (I# (indexIntArray# frozen# 0#)) * 1000000000 + + fromInt (I# (indexIntArray# frozen# 1#)) + + fromInt (I# (indexIntArray# frozen# 2#)) * 1000000000 + + fromInt (I# (indexIntArray# frozen# 3#))) else failWith (UnsupportedOperation "can't get CPU time") @@ -29,3 +31,4 @@ implementation-dependent. + diff --git a/ghc/lib/haskell-1.3/LibPosix.hi b/ghc/lib/haskell-1.3/LibPosix.hi index a6ec46fc80..6b61f3bda5 100644 --- a/ghc/lib/haskell-1.3/LibPosix.hi +++ b/ghc/lib/haskell-1.3/LibPosix.hi @@ -1,6 +1,6 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface LibPosix where -import LibDirectory(removeDirectory) +import LibDirectory(getCurrentDirectory, removeDirectory, setCurrentDirectory) import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell) import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem) import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes) @@ -54,6 +54,8 @@ type ProcessGroupID = Int type ProcessID = Int type UserID = Int data ExitCode {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-} +getCurrentDirectory :: _State _RealWorld -> (Either IOError13 [Char], _State _RealWorld) + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld) @@ -271,7 +273,7 @@ modificationTime :: _ByteArray () -> Int nullFileMode :: _Word {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-} openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-} otherExecuteMode :: _Word @@ -318,6 +320,8 @@ readChannel :: Int -> Int -> _State _RealWorld -> (Either IOError13 ([Char], Int {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-} +setCurrentDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} userGroupID :: UserEntry -> Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-} userID :: UserEntry -> Int @@ -654,13 +658,13 @@ instance Ord ExitCode _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} instance Text ProcessStatus {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text ExitCode {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/haskell-1.3/LibPosix.lhs b/ghc/lib/haskell-1.3/LibPosix.lhs index e97215efb4..46b66a6518 100644 --- a/ghc/lib/haskell-1.3/LibPosix.lhs +++ b/ghc/lib/haskell-1.3/LibPosix.lhs @@ -27,9 +27,12 @@ module LibPosix ( ProcessGroupID(..), UserID(..), - ExitCode - ) where + ExitCode, + + -- make interface complete: + setCurrentDirectory{-pragmas-}, getCurrentDirectory{-pragmas-} + ) where import LibPosixDB import LibPosixErr @@ -43,7 +46,7 @@ import LibPosixUtil -- runProcess is our candidate for the high-level OS-independent primitive -- If accepted, it will be moved out of LibPosix into LibSystem. -import LibDirectory ( setCurrentDirectory ) +import LibDirectory ( setCurrentDirectory, getCurrentDirectory{-pragmas-} ) import PreludeGlaST import PreludePrimIO ( takeMVar, putMVar, _MVar ) diff --git a/ghc/lib/haskell-1.3/LibPosixFiles.hi b/ghc/lib/haskell-1.3/LibPosixFiles.hi index 335aecc9a9..c27d8e1778 100644 --- a/ghc/lib/haskell-1.3/LibPosixFiles.hi +++ b/ghc/lib/haskell-1.3/LibPosixFiles.hi @@ -77,7 +77,7 @@ modificationTime :: _ByteArray () -> Int nullFileMode :: _Word {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-} openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-} otherExecuteMode :: _Word diff --git a/ghc/lib/haskell-1.3/LibPosixFiles.lhs b/ghc/lib/haskell-1.3/LibPosixFiles.lhs index f2caeb4069..d885c16719 100644 --- a/ghc/lib/haskell-1.3/LibPosixFiles.lhs +++ b/ghc/lib/haskell-1.3/LibPosixFiles.lhs @@ -247,7 +247,8 @@ openChannel name how maybe_mode append excl noctty nonblock trunc = creat# = case creat of { W# x -> x } flags = W# (creat# `or#` append# `or#` excl# `or#` - noctty# `or#` nonblock# `or#` trunc#) + noctty# `or#` nonblock# `or#` trunc# `or#` how#) + how# = case (case how of { ReadOnly -> ``O_RDONLY'';WriteOnly -> ``O_WRONLY'';ReadWrite -> ``O_RDWR''}) of { W# x -> x } append# = case (if append then ``O_APPEND'' else ``0'') of { W# x -> x } excl# = case (if excl then ``O_EXCL'' else ``0'') of { W# x -> x } noctty# = case (if noctty then ``O_NOCTTY'' else ``0'') of { W# x -> x } diff --git a/ghc/lib/haskell-1.3/LibPosixFiles_mc.hi b/ghc/lib/haskell-1.3/LibPosixFiles_mc.hi index 335aecc9a9..c27d8e1778 100644 --- a/ghc/lib/haskell-1.3/LibPosixFiles_mc.hi +++ b/ghc/lib/haskell-1.3/LibPosixFiles_mc.hi @@ -77,7 +77,7 @@ modificationTime :: _ByteArray () -> Int nullFileMode :: _Word {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-} openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-} otherExecuteMode :: _Word diff --git a/ghc/lib/haskell-1.3/LibPosixFiles_mg.hi b/ghc/lib/haskell-1.3/LibPosixFiles_mg.hi index 335aecc9a9..c27d8e1778 100644 --- a/ghc/lib/haskell-1.3/LibPosixFiles_mg.hi +++ b/ghc/lib/haskell-1.3/LibPosixFiles_mg.hi @@ -77,7 +77,7 @@ modificationTime :: _ByteArray () -> Int nullFileMode :: _Word {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-} openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-} otherExecuteMode :: _Word diff --git a/ghc/lib/haskell-1.3/LibPosixFiles_mp.hi b/ghc/lib/haskell-1.3/LibPosixFiles_mp.hi index 335aecc9a9..c27d8e1778 100644 --- a/ghc/lib/haskell-1.3/LibPosixFiles_mp.hi +++ b/ghc/lib/haskell-1.3/LibPosixFiles_mp.hi @@ -77,7 +77,7 @@ modificationTime :: _ByteArray () -> Int nullFileMode :: _Word {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-} openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-} otherExecuteMode :: _Word diff --git a/ghc/lib/haskell-1.3/LibPosixFiles_p.hi b/ghc/lib/haskell-1.3/LibPosixFiles_p.hi index 335aecc9a9..c27d8e1778 100644 --- a/ghc/lib/haskell-1.3/LibPosixFiles_p.hi +++ b/ghc/lib/haskell-1.3/LibPosixFiles_p.hi @@ -77,7 +77,7 @@ modificationTime :: _ByteArray () -> Int nullFileMode :: _Word {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-} openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-} otherExecuteMode :: _Word diff --git a/ghc/lib/haskell-1.3/LibPosixFiles_t.hi b/ghc/lib/haskell-1.3/LibPosixFiles_t.hi index 335aecc9a9..c27d8e1778 100644 --- a/ghc/lib/haskell-1.3/LibPosixFiles_t.hi +++ b/ghc/lib/haskell-1.3/LibPosixFiles_t.hi @@ -77,7 +77,7 @@ modificationTime :: _ByteArray () -> Int nullFileMode :: _Word {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-} openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-} otherExecuteMode :: _Word diff --git a/ghc/lib/haskell-1.3/LibPosixProcPrim.hi b/ghc/lib/haskell-1.3/LibPosixProcPrim.hi index b02e2ef1ab..3c57a24709 100644 --- a/ghc/lib/haskell-1.3/LibPosixProcPrim.hi +++ b/ghc/lib/haskell-1.3/LibPosixProcPrim.hi @@ -180,13 +180,13 @@ instance Ord ExitCode _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} instance Text ProcessStatus {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text ExitCode {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/haskell-1.3/LibPosixProcPrim_mc.hi b/ghc/lib/haskell-1.3/LibPosixProcPrim_mc.hi index b02e2ef1ab..3c57a24709 100644 --- a/ghc/lib/haskell-1.3/LibPosixProcPrim_mc.hi +++ b/ghc/lib/haskell-1.3/LibPosixProcPrim_mc.hi @@ -180,13 +180,13 @@ instance Ord ExitCode _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} instance Text ProcessStatus {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text ExitCode {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/haskell-1.3/LibPosixProcPrim_mp.hi b/ghc/lib/haskell-1.3/LibPosixProcPrim_mp.hi index 866badf8c5..22cabc13f0 100644 --- a/ghc/lib/haskell-1.3/LibPosixProcPrim_mp.hi +++ b/ghc/lib/haskell-1.3/LibPosixProcPrim_mp.hi @@ -180,13 +180,13 @@ instance Ord ExitCode _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} instance Text ProcessStatus {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text ExitCode {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/haskell-1.3/LibPosixProcPrim_p.hi b/ghc/lib/haskell-1.3/LibPosixProcPrim_p.hi index b02e2ef1ab..3c57a24709 100644 --- a/ghc/lib/haskell-1.3/LibPosixProcPrim_p.hi +++ b/ghc/lib/haskell-1.3/LibPosixProcPrim_p.hi @@ -180,13 +180,13 @@ instance Ord ExitCode _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} instance Text ProcessStatus {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text ExitCode {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/haskell-1.3/LibPosixProcPrim_t.hi b/ghc/lib/haskell-1.3/LibPosixProcPrim_t.hi index b02e2ef1ab..3c57a24709 100644 --- a/ghc/lib/haskell-1.3/LibPosixProcPrim_t.hi +++ b/ghc/lib/haskell-1.3/LibPosixProcPrim_t.hi @@ -180,13 +180,13 @@ instance Ord ExitCode _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} instance Text ProcessStatus {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text ExitCode {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/haskell-1.3/LibPosix_mc.hi b/ghc/lib/haskell-1.3/LibPosix_mc.hi index a6ec46fc80..6b61f3bda5 100644 --- a/ghc/lib/haskell-1.3/LibPosix_mc.hi +++ b/ghc/lib/haskell-1.3/LibPosix_mc.hi @@ -1,6 +1,6 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface LibPosix where -import LibDirectory(removeDirectory) +import LibDirectory(getCurrentDirectory, removeDirectory, setCurrentDirectory) import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell) import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem) import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes) @@ -54,6 +54,8 @@ type ProcessGroupID = Int type ProcessID = Int type UserID = Int data ExitCode {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-} +getCurrentDirectory :: _State _RealWorld -> (Either IOError13 [Char], _State _RealWorld) + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld) @@ -271,7 +273,7 @@ modificationTime :: _ByteArray () -> Int nullFileMode :: _Word {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-} openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-} otherExecuteMode :: _Word @@ -318,6 +320,8 @@ readChannel :: Int -> Int -> _State _RealWorld -> (Either IOError13 ([Char], Int {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-} +setCurrentDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} userGroupID :: UserEntry -> Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-} userID :: UserEntry -> Int @@ -654,13 +658,13 @@ instance Ord ExitCode _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} instance Text ProcessStatus {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text ExitCode {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/haskell-1.3/LibPosix_mg.hi b/ghc/lib/haskell-1.3/LibPosix_mg.hi index a6ec46fc80..2f7d0f01c5 100644 --- a/ghc/lib/haskell-1.3/LibPosix_mg.hi +++ b/ghc/lib/haskell-1.3/LibPosix_mg.hi @@ -1,6 +1,6 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface LibPosix where -import LibDirectory(removeDirectory) +import LibDirectory(getCurrentDirectory, removeDirectory, setCurrentDirectory) import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell) import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem) import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes) @@ -54,6 +54,8 @@ type ProcessGroupID = Int type ProcessID = Int type UserID = Int data ExitCode {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-} +getCurrentDirectory :: _State _RealWorld -> (Either IOError13 [Char], _State _RealWorld) + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld) @@ -271,7 +273,7 @@ modificationTime :: _ByteArray () -> Int nullFileMode :: _Word {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-} openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-} otherExecuteMode :: _Word @@ -318,6 +320,8 @@ readChannel :: Int -> Int -> _State _RealWorld -> (Either IOError13 ([Char], Int {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-} +setCurrentDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} userGroupID :: UserEntry -> Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-} userID :: UserEntry -> Int diff --git a/ghc/lib/haskell-1.3/LibPosix_mp.hi b/ghc/lib/haskell-1.3/LibPosix_mp.hi index 2019d507dc..2a3026b941 100644 --- a/ghc/lib/haskell-1.3/LibPosix_mp.hi +++ b/ghc/lib/haskell-1.3/LibPosix_mp.hi @@ -1,6 +1,6 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface LibPosix where -import LibDirectory(removeDirectory) +import LibDirectory(getCurrentDirectory, removeDirectory, setCurrentDirectory) import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell) import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem) import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes) @@ -54,6 +54,8 @@ type ProcessGroupID = Int type ProcessID = Int type UserID = Int data ExitCode {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-} +getCurrentDirectory :: _State _RealWorld -> (Either IOError13 [Char], _State _RealWorld) + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld) @@ -271,7 +273,7 @@ modificationTime :: _ByteArray () -> Int nullFileMode :: _Word {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-} openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-} otherExecuteMode :: _Word @@ -318,6 +320,8 @@ readChannel :: Int -> Int -> _State _RealWorld -> (Either IOError13 ([Char], Int {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-} +setCurrentDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} userGroupID :: UserEntry -> Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-} userID :: UserEntry -> Int @@ -654,13 +658,13 @@ instance Ord ExitCode _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} instance Text ProcessStatus {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text ExitCode {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/haskell-1.3/LibPosix_p.hi b/ghc/lib/haskell-1.3/LibPosix_p.hi index a6ec46fc80..6b61f3bda5 100644 --- a/ghc/lib/haskell-1.3/LibPosix_p.hi +++ b/ghc/lib/haskell-1.3/LibPosix_p.hi @@ -1,6 +1,6 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface LibPosix where -import LibDirectory(removeDirectory) +import LibDirectory(getCurrentDirectory, removeDirectory, setCurrentDirectory) import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell) import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem) import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes) @@ -54,6 +54,8 @@ type ProcessGroupID = Int type ProcessID = Int type UserID = Int data ExitCode {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-} +getCurrentDirectory :: _State _RealWorld -> (Either IOError13 [Char], _State _RealWorld) + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld) @@ -271,7 +273,7 @@ modificationTime :: _ByteArray () -> Int nullFileMode :: _Word {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-} openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-} otherExecuteMode :: _Word @@ -318,6 +320,8 @@ readChannel :: Int -> Int -> _State _RealWorld -> (Either IOError13 ([Char], Int {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-} +setCurrentDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} userGroupID :: UserEntry -> Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-} userID :: UserEntry -> Int @@ -654,13 +658,13 @@ instance Ord ExitCode _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} instance Text ProcessStatus {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text ExitCode {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/haskell-1.3/LibPosix_t.hi b/ghc/lib/haskell-1.3/LibPosix_t.hi index a6ec46fc80..6b61f3bda5 100644 --- a/ghc/lib/haskell-1.3/LibPosix_t.hi +++ b/ghc/lib/haskell-1.3/LibPosix_t.hi @@ -1,6 +1,6 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface LibPosix where -import LibDirectory(removeDirectory) +import LibDirectory(getCurrentDirectory, removeDirectory, setCurrentDirectory) import LibPosixDB(GroupEntry(..), UserEntry(..), getGroupEntryForID, getGroupEntryForName, getUserEntryForID, getUserEntryForName, groupID, groupMembers, groupName, homeDirectory, userGroupID, userID, userName, userShell) import LibPosixErr(ErrorCode(..), argumentListTooLong, badChannel, brokenPipe, directoryNotEmpty, e2BIG, eACCES, eAGAIN, eBADF, eBUSY, eCHILD, eDEADLK, eEXIST, eFBIG, eINTR, eINVAL, eIO, eISDIR, eMFILE, eMLINK, eNAMETOOLONG, eNFILE, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOMEM, eNOSPC, eNOSYS, eNOTDIR, eNOTEMPTY, eNOTTY, eNXIO, ePERM, ePIPE, eROFS, eSPIPE, eSRCH, eXDEV, execFormatError, fileAlreadyExists, fileTooLarge, filenameTooLong, getErrorCode, improperLink, inappropriateIOControlOperation, inputOutputError, interruptedOperation, invalidArgument, invalidSeek, isADirectory, noChildProcess, noError, noLocksAvailable, noSpaceLeftOnDevice, noSuchDeviceOrAddress, noSuchFileOrDirectory, noSuchOperationOnDevice, noSuchProcess, notADirectory, notEnoughMemory, operationNotImplemented, operationNotPermitted, permissionDenied, readOnlyFileSystem, resourceBusy, resourceDeadlockAvoided, resourceTemporarilyUnavailable, setErrorCode, tooManyLinks, tooManyOpenFiles, tooManyOpenFilesInSystem) import LibPosixFiles(DeviceID(..), DirStream(..), FileID(..), FileMode(..), FileStatus(..), OpenMode(..), PathVar(..), accessModes, accessTime, changeWorkingDirectory, closeDirStream, createDirectory, createFile, createLink, createNamedPipe, deviceID, fileGroup, fileID, fileMode, fileOwner, fileSize, getChannelStatus, getChannelVar, getFileStatus, getPathVar, getWorkingDirectory, groupExecuteMode, groupModes, groupReadMode, groupWriteMode, intersectFileModes, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, linkCount, modificationTime, nullFileMode, openChannel, openDirStream, otherExecuteMode, otherModes, otherReadMode, otherWriteMode, ownerExecuteMode, ownerModes, ownerReadMode, ownerWriteMode, queryAccess, queryFile, readDirStream, removeLink, rename, rewindDirStream, setFileCreationMask, setFileMode, setFileTimes, setGroupIDMode, setOwnerAndGroup, setUserIDMode, statusChangeTime, stdError, stdFileMode, stdInput, stdOutput, touchFile, unionFileModes) @@ -54,6 +54,8 @@ type ProcessGroupID = Int type ProcessID = Int type UserID = Int data ExitCode {-# GHC_PRAGMA ExitSuccess | ExitFailure Int #-} +getCurrentDirectory :: _State _RealWorld -> (Either IOError13 [Char], _State _RealWorld) + {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} removeDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} getGroupEntryForID :: Int -> _State _RealWorld -> (Either IOError13 GroupEntry, _State _RealWorld) @@ -271,7 +273,7 @@ modificationTime :: _ByteArray () -> Int nullFileMode :: _Word {-# GHC_PRAGMA _A_ 0 _N_ _N_ _N_ _N_ _N_ #-} openChannel :: [Char] -> OpenMode -> Maybe _Word -> Bool -> Bool -> Bool -> Bool -> Bool -> _State _RealWorld -> (Either IOError13 Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 9 _U_ 202111112 _N_ _S_ "SASEEEEEL" {_A_ 8 _U_ 22111112 _N_ _N_ _N_ _N_} _N_ _N_ #-} + {-# GHC_PRAGMA _A_ 9 _U_ 212111112 _N_ _S_ "SESEEEEEL" _N_ _N_ #-} openDirStream :: [Char] -> _State _RealWorld -> (Either IOError13 _Addr, _State _RealWorld) {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "SL" _N_ _N_ #-} otherExecuteMode :: _Word @@ -318,6 +320,8 @@ readChannel :: Int -> Int -> _State _RealWorld -> (Either IOError13 ([Char], Int {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} runProcess :: [Char] -> [[Char]] -> Maybe [([Char], [Char])] -> Maybe [Char] -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> Maybe (_MVar _Handle) -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 8 _U_ 22111111 _N_ _S_ "LLLLLLLU(P)" _N_ _N_ #-} +setCurrentDirectory :: [Char] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_ #-} userGroupID :: UserEntry -> Int {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(AAU(P)AA)" {_A_ 1 _U_ 2 _N_ _N_ _F_ _IF_ARGS_ 0 1 X 2 \ (u0 :: Int#) -> _!_ I# [] [u0] _N_} _F_ _IF_ARGS_ 0 1 C 2 \ (u0 :: UserEntry) -> case u0 of { _ALG_ _ORIG_ LibPosixDB UE (u1 :: [Char]) (u2 :: Int) (u3 :: Int) (u4 :: [Char]) (u5 :: [Char]) -> u3; _NO_DEFLT_ } _N_ #-} userID :: UserEntry -> Int @@ -654,13 +658,13 @@ instance Ord ExitCode _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} instance Text ProcessStatus {-# GHC_PRAGMA _M_ LibPosixProcPrim {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ProcessStatus, [Char])]), (Int -> ProcessStatus -> [Char] -> [Char]), ([Char] -> [([ProcessStatus], [Char])]), ([ProcessStatus] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ProcessStatus), _CONSTM_ Text showsPrec (ProcessStatus), _CONSTM_ Text readList (ProcessStatus), _CONSTM_ Text showList (ProcessStatus)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} instance Text ExitCode {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/haskell-1.3/LibSystem.hi b/ghc/lib/haskell-1.3/LibSystem.hi index 5569655960..a82df1a972 100644 --- a/ghc/lib/haskell-1.3/LibSystem.hi +++ b/ghc/lib/haskell-1.3/LibSystem.hi @@ -28,7 +28,7 @@ instance Ord ExitCode _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} instance Text ExitCode {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/haskell-1.3/LibSystem_mc.hi b/ghc/lib/haskell-1.3/LibSystem_mc.hi index 5569655960..a82df1a972 100644 --- a/ghc/lib/haskell-1.3/LibSystem_mc.hi +++ b/ghc/lib/haskell-1.3/LibSystem_mc.hi @@ -28,7 +28,7 @@ instance Ord ExitCode _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} instance Text ExitCode {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/haskell-1.3/LibSystem_mp.hi b/ghc/lib/haskell-1.3/LibSystem_mp.hi index 5569655960..a82df1a972 100644 --- a/ghc/lib/haskell-1.3/LibSystem_mp.hi +++ b/ghc/lib/haskell-1.3/LibSystem_mp.hi @@ -28,7 +28,7 @@ instance Ord ExitCode _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} instance Text ExitCode {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/haskell-1.3/LibSystem_p.hi b/ghc/lib/haskell-1.3/LibSystem_p.hi index 5569655960..a82df1a972 100644 --- a/ghc/lib/haskell-1.3/LibSystem_p.hi +++ b/ghc/lib/haskell-1.3/LibSystem_p.hi @@ -28,7 +28,7 @@ instance Ord ExitCode _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} instance Text ExitCode {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/haskell-1.3/LibSystem_t.hi b/ghc/lib/haskell-1.3/LibSystem_t.hi index 5569655960..a82df1a972 100644 --- a/ghc/lib/haskell-1.3/LibSystem_t.hi +++ b/ghc/lib/haskell-1.3/LibSystem_t.hi @@ -28,7 +28,7 @@ instance Ord ExitCode _tagCmp = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_ #-} instance Text ExitCode {-# GHC_PRAGMA _M_ LibSystem {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(ExitCode, [Char])]), (Int -> ExitCode -> [Char] -> [Char]), ([Char] -> [([ExitCode], [Char])]), ([ExitCode] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (ExitCode), _CONSTM_ Text showsPrec (ExitCode), _CONSTM_ Text readList (ExitCode), _CONSTM_ Text showList (ExitCode)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _N_ _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LS" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/haskell-1.3/LibTime.lhs b/ghc/lib/haskell-1.3/LibTime.lhs index 36b2b287b5..e3d6607fcf 100644 --- a/ghc/lib/haskell-1.3/LibTime.lhs +++ b/ghc/lib/haskell-1.3/LibTime.lhs @@ -24,6 +24,7 @@ module LibTime ( import PreludeIOError import PreludeGlaST import PS +import LibPosixUtil (allocWords, allocChars) \end{code} @@ -47,7 +48,8 @@ we use the C library routines based on 32 bit integers. instance Text ClockTime where showsPrec p (TOD sec@(J# a# s# d#) nsec) = showString (unsafePerformPrimIO ( - _ccall_ showTime (I# s#) (_ByteArray (error "ClockTime.show") d#) + allocChars 32 `thenPrimIO` \ buf -> + _ccall_ showTime (I# s#) (_ByteArray (error "ClockTime.show") d#) buf `thenPrimIO` \ str -> _ccall_ strlen str `thenPrimIO` \ len -> _packCBytesST len str `thenStrictlyST` \ ps -> @@ -155,7 +157,10 @@ ignored. \begin{code} toCalendarTime :: ClockTime -> CalendarTime toCalendarTime (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO ( - _ccall_ toLocalTime (I# s#) (_ByteArray (error "toCalendarTime") d#) + allocWords (``sizeof(struct tm)''::Int) `thenPrimIO` \ res -> + allocChars 32 `thenPrimIO` \ zoneNm -> + _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm `thenPrimIO` \ () -> + _ccall_ toLocalTime (I# s#) (_ByteArray (error "toCalendarTime") d#) res `thenPrimIO` \ tm -> if tm == (``NULL''::_Addr) then error "toCalendarTime{LibTime}: out of range" @@ -178,8 +183,8 @@ toCalendarTime (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO ( `thenPrimIO` \ yday -> _casm_ ``%r = ((struct tm *)%0)->tm_isdst;'' tm `thenPrimIO` \ isdst -> - _ccall_ ZONE tm `thenPrimIO` \ zone -> - _ccall_ GMTOFF tm `thenPrimIO` \ tz -> + _ccall_ ZONE tm `thenPrimIO` \ zone -> + _ccall_ GMTOFF tm `thenPrimIO` \ tz -> _ccall_ strlen zone `thenPrimIO` \ len -> _packCBytesST len zone `thenStrictlyST` \ tzname -> returnPrimIO (CalendarTime (1900+year) mon mday hour min sec psec @@ -188,7 +193,10 @@ toCalendarTime (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO ( toUTCTime :: ClockTime -> CalendarTime toUTCTime (TOD sec@(J# a# s# d#) psec) = unsafePerformPrimIO ( - _ccall_ toUTCTime (I# s#) (_ByteArray (error "toCalendarTime") d#) + allocWords (``sizeof(struct tm)''::Int) `thenPrimIO` \ res -> + allocChars 32 `thenPrimIO` \ zoneNm -> + _casm_ ``SETZONE((struct tm *)%0,(char *)%1); '' res zoneNm `thenPrimIO` \ () -> + _ccall_ toUTCTime (I# s#) (_ByteArray (error "toCalendarTime") d#) res `thenPrimIO` \ tm -> if tm == (``NULL''::_Addr) then error "toUTCTime{LibTime}: out of range" @@ -221,7 +229,8 @@ toClockTime (CalendarTime year mon mday hour min sec psec wday yday tzname tz is error "toClockTime{LibTime}: timezone offset out of range" else unsafePerformPrimIO ( - _ccall_ toClockSec year mon mday hour min sec tz + allocWords (``sizeof(time_t)'') `thenPrimIO` \ res -> + _ccall_ toClockSec year mon mday hour min sec tz res `thenPrimIO` \ ptr@(A# ptr#) -> if ptr /= ``NULL'' then returnPrimIO (TOD (int2Integer# (indexIntOffAddr# ptr# 0#)) psec) diff --git a/ghc/lib/hbc/Time.hi b/ghc/lib/hbc/Time.hi index 79e46a74fb..9203e3b14b 100644 --- a/ghc/lib/hbc/Time.hi +++ b/ghc/lib/hbc/Time.hi @@ -22,7 +22,7 @@ instance Ord Time _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)LLLLLLL)U(U(P)LLLLLLL)" _N_ _N_ #-} instance Text Time {-# GHC_PRAGMA _M_ Time {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Time, [Char])]), (Int -> Time -> [Char] -> [Char]), ([Char] -> [([Time], [Char])]), ([Time] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Time), _CONSTM_ Text showsPrec (Time), _CONSTM_ Text readList (Time), _CONSTM_ Text showList (Time)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LU(LLLLLLLL)" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/hbc/Time_mc.hi b/ghc/lib/hbc/Time_mc.hi index 79e46a74fb..9203e3b14b 100644 --- a/ghc/lib/hbc/Time_mc.hi +++ b/ghc/lib/hbc/Time_mc.hi @@ -22,7 +22,7 @@ instance Ord Time _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)LLLLLLL)U(U(P)LLLLLLL)" _N_ _N_ #-} instance Text Time {-# GHC_PRAGMA _M_ Time {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Time, [Char])]), (Int -> Time -> [Char] -> [Char]), ([Char] -> [([Time], [Char])]), ([Time] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Time), _CONSTM_ Text showsPrec (Time), _CONSTM_ Text readList (Time), _CONSTM_ Text showList (Time)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LU(LLLLLLLL)" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/hbc/Time_mp.hi b/ghc/lib/hbc/Time_mp.hi index 79e46a74fb..9203e3b14b 100644 --- a/ghc/lib/hbc/Time_mp.hi +++ b/ghc/lib/hbc/Time_mp.hi @@ -22,7 +22,7 @@ instance Ord Time _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)LLLLLLL)U(U(P)LLLLLLL)" _N_ _N_ #-} instance Text Time {-# GHC_PRAGMA _M_ Time {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Time, [Char])]), (Int -> Time -> [Char] -> [Char]), ([Char] -> [([Time], [Char])]), ([Time] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Time), _CONSTM_ Text showsPrec (Time), _CONSTM_ Text readList (Time), _CONSTM_ Text showList (Time)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LU(LLLLLLLL)" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/hbc/Time_p.hi b/ghc/lib/hbc/Time_p.hi index 79e46a74fb..9203e3b14b 100644 --- a/ghc/lib/hbc/Time_p.hi +++ b/ghc/lib/hbc/Time_p.hi @@ -22,7 +22,7 @@ instance Ord Time _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)LLLLLLL)U(U(P)LLLLLLL)" _N_ _N_ #-} instance Text Time {-# GHC_PRAGMA _M_ Time {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Time, [Char])]), (Int -> Time -> [Char] -> [Char]), ([Char] -> [([Time], [Char])]), ([Time] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Time), _CONSTM_ Text showsPrec (Time), _CONSTM_ Text readList (Time), _CONSTM_ Text showList (Time)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LU(LLLLLLLL)" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/hbc/Time_t.hi b/ghc/lib/hbc/Time_t.hi index 79e46a74fb..9203e3b14b 100644 --- a/ghc/lib/hbc/Time_t.hi +++ b/ghc/lib/hbc/Time_t.hi @@ -22,7 +22,7 @@ instance Ord Time _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "U(U(P)LLLLLLL)U(U(P)LLLLLLL)" _N_ _N_ #-} instance Text Time {-# GHC_PRAGMA _M_ Time {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Time, [Char])]), (Int -> Time -> [Char] -> [Char]), ([Char] -> [([Time], [Char])]), ([Time] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Time), _CONSTM_ Text showsPrec (Time), _CONSTM_ Text readList (Time), _CONSTM_ Text showList (Time)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 12 _N_ _S_ "U(P)L" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 2 _U_ 112 _N_ _S_ "LU(LLLLLLLL)" _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/make_extra_deps b/ghc/lib/make_extra_deps index 3882e895f4..213f7e8423 100644 --- a/ghc/lib/make_extra_deps +++ b/ghc/lib/make_extra_deps @@ -17,7 +17,7 @@ while (<MKF>) { '_mc', '_mr', '_mt', '_mp', '_mg', '_2s', '_1s', '_du', '_a', '_b', '_c', '_d', '_e', '_f', '_g', '_h', - '_i', '_j', '_k', '_o', '_m', '_n', '_o' ) { + '_i', '_j', '_k', '_o', '_m', '_n', '_o', '_A', '_B' ) { $copy = $_; # change all .hc and .hi diff --git a/ghc/lib/prelude/Builtin.hi b/ghc/lib/prelude/Builtin.hi index c3960218db..ff60c6414e 100644 --- a/ghc/lib/prelude/Builtin.hi +++ b/ghc/lib/prelude/Builtin.hi @@ -8,6 +8,8 @@ absent# :: a {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_ _TYAPP_ _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-} error :: [Char] -> a {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-} +parError# :: a + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_ _TYAPP_ _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! Entered parError# (a GHC bug -- please report it!)\n" ] _N_ #-} patError# :: [Char] -> a {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/Builtin.hs b/ghc/lib/prelude/Builtin.hs index c710c9afaf..c8c2eefde0 100644 --- a/ghc/lib/prelude/Builtin.hs +++ b/ghc/lib/prelude/Builtin.hs @@ -3,7 +3,8 @@ module PreludeBuiltin ( _trace, absent#, error, - patError# + patError#, + parError# ) where import Cls @@ -66,6 +67,8 @@ error__ msg_hdr s absent# = error "Oops! The program has entered an `absent' argument!\n" +parError# = error "Oops! Entered parError# (a GHC bug -- please report it!)\n" + --------------------------------------------------------------- _runST m = case m (S# realWorld#) of (r,_) -> r diff --git a/ghc/lib/prelude/Builtin_mc.hi b/ghc/lib/prelude/Builtin_mc.hi index c3960218db..ff60c6414e 100644 --- a/ghc/lib/prelude/Builtin_mc.hi +++ b/ghc/lib/prelude/Builtin_mc.hi @@ -8,6 +8,8 @@ absent# :: a {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_ _TYAPP_ _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-} error :: [Char] -> a {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-} +parError# :: a + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_ _TYAPP_ _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! Entered parError# (a GHC bug -- please report it!)\n" ] _N_ #-} patError# :: [Char] -> a {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/Builtin_mg.hi b/ghc/lib/prelude/Builtin_mg.hi index c3960218db..ff60c6414e 100644 --- a/ghc/lib/prelude/Builtin_mg.hi +++ b/ghc/lib/prelude/Builtin_mg.hi @@ -8,6 +8,8 @@ absent# :: a {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_ _TYAPP_ _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-} error :: [Char] -> a {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-} +parError# :: a + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_ _TYAPP_ _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! Entered parError# (a GHC bug -- please report it!)\n" ] _N_ #-} patError# :: [Char] -> a {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/Builtin_mp.hi b/ghc/lib/prelude/Builtin_mp.hi index c3960218db..ff60c6414e 100644 --- a/ghc/lib/prelude/Builtin_mp.hi +++ b/ghc/lib/prelude/Builtin_mp.hi @@ -8,6 +8,8 @@ absent# :: a {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_ _TYAPP_ _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-} error :: [Char] -> a {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-} +parError# :: a + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_ _TYAPP_ _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! Entered parError# (a GHC bug -- please report it!)\n" ] _N_ #-} patError# :: [Char] -> a {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/Builtin_p.hi b/ghc/lib/prelude/Builtin_p.hi index c3960218db..ff60c6414e 100644 --- a/ghc/lib/prelude/Builtin_p.hi +++ b/ghc/lib/prelude/Builtin_p.hi @@ -8,6 +8,8 @@ absent# :: a {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_ _TYAPP_ _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-} error :: [Char] -> a {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-} +parError# :: a + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_ _TYAPP_ _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! Entered parError# (a GHC bug -- please report it!)\n" ] _N_ #-} patError# :: [Char] -> a {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/Builtin_t.hi b/ghc/lib/prelude/Builtin_t.hi index c3960218db..ff60c6414e 100644 --- a/ghc/lib/prelude/Builtin_t.hi +++ b/ghc/lib/prelude/Builtin_t.hi @@ -8,6 +8,8 @@ absent# :: a {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_ _TYAPP_ _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! The program has entered an `absent' argument!\n" ] _N_ #-} error :: [Char] -> a {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ _!_ _N_ _N_ #-} +parError# :: a + {-# GHC_PRAGMA _A_ 0 _N_ _N_ _S_ _!_ _F_ _IF_ARGS_ 1 0 X 2 _/\_ u0 -> _APP_ _TYAPP_ _ORIG_ PreludeBuiltin error { u0 } [ _NOREP_S_ "Oops! Entered parError# (a GHC bug -- please report it!)\n" ] _N_ #-} patError# :: [Char] -> a {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ _!_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/Channel.hi b/ghc/lib/prelude/Channel.hi index dee15c0193..848aeae4d0 100644 --- a/ghc/lib/prelude/Channel.hi +++ b/ghc/lib/prelude/Channel.hi @@ -14,6 +14,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld) {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AL)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} +putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-} unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(LA)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/lib/prelude/Channel.lhs b/ghc/lib/prelude/Channel.lhs index 4019287596..94ed9c56e4 100644 --- a/ghc/lib/prelude/Channel.lhs +++ b/ghc/lib/prelude/Channel.lhs @@ -8,15 +8,21 @@ Standard, unbounded channel abstraction. \begin{code} module Channel ( - {- abstract -} + {- abstract type defined -} Chan, - newChan, -- :: IO (Chan a) - putChan, -- :: Chan a -> a -> IO () - getChan, -- :: Chan a -> IO a - dupChan, -- :: Chan a -> IO (Chan a) - unGetChan, -- :: Chan a -> a -> IO () - getChanContents -- :: Chan a -> IO [a] + {- creator -} + newChan, -- :: IO (Chan a) + + {- operators -} + putChan, -- :: Chan a -> a -> IO () + getChan, -- :: Chan a -> IO a + dupChan, -- :: Chan a -> IO (Chan a) + unGetChan, -- :: Chan a -> a -> IO () + + {- stream interface -} + getChanContents, -- :: Chan a -> IO [a] + putList2Chan -- :: Chan a -> [a] -> IO () ) where @@ -107,14 +113,18 @@ unGetChan (Chan read write) val \end{code} +Operators for interfacing with functional streams. + \begin{code} getChanContents :: Chan a -> IO [a] -getChanContents ch - = unsafeInterleavePrimIO ( - getChan ch) `thenPrimIO` \ ~(Right x) -> - unsafeInterleavePrimIO ( - getChanContents ch) `thenPrimIO` \ ~(Right xs) -> - return (x:xs) +getChanContents ch = + unsafeInterleavePrimIO ( + getChan ch `thenPrimIO` \ ~(Right x) -> + unsafeInterleavePrimIO (getChanContents ch) `thenPrimIO` \ ~(Right xs) -> + returnPrimIO (Right (x:xs))) + +putList2Chan :: Chan a -> [a] -> IO () +putList2Chan ch ls = sequence (map (putChan ch) ls) \end{code} diff --git a/ghc/lib/prelude/Channel_mc.hi b/ghc/lib/prelude/Channel_mc.hi index dee15c0193..848aeae4d0 100644 --- a/ghc/lib/prelude/Channel_mc.hi +++ b/ghc/lib/prelude/Channel_mc.hi @@ -14,6 +14,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld) {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AL)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} +putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-} unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(LA)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/lib/prelude/Channel_mp.hi b/ghc/lib/prelude/Channel_mp.hi index dee15c0193..848aeae4d0 100644 --- a/ghc/lib/prelude/Channel_mp.hi +++ b/ghc/lib/prelude/Channel_mp.hi @@ -14,6 +14,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld) {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AL)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} +putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-} unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(LA)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/lib/prelude/Channel_p.hi b/ghc/lib/prelude/Channel_p.hi index dee15c0193..848aeae4d0 100644 --- a/ghc/lib/prelude/Channel_p.hi +++ b/ghc/lib/prelude/Channel_p.hi @@ -14,6 +14,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld) {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AL)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} +putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-} unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(LA)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/lib/prelude/Channel_t.hi b/ghc/lib/prelude/Channel_t.hi index dee15c0193..848aeae4d0 100644 --- a/ghc/lib/prelude/Channel_t.hi +++ b/ghc/lib/prelude/Channel_t.hi @@ -14,6 +14,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld) {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(AL)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} +putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-} unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(LA)LU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/lib/prelude/Concurrent.hi b/ghc/lib/prelude/Concurrent.hi index 29976ccd5b..04dc12fba6 100644 --- a/ghc/lib/prelude/Concurrent.hi +++ b/ghc/lib/prelude/Concurrent.hi @@ -1,6 +1,6 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface Concurrent where -import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, unGetChan) +import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, putList2Chan, unGetChan) import ChannelVar(CVar(..), getCVar, newCVar, putCVar) import Merge(mergeIO, nmergeIO) import Parallel(par, seq) @@ -34,6 +34,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld) {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-} +putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-} unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-} getCVar :: CVar a -> _State _RealWorld -> (Either IOError13 a, _State _RealWorld) diff --git a/ghc/lib/prelude/Concurrent_mc.hi b/ghc/lib/prelude/Concurrent_mc.hi index f59c81cc84..5d9a33741a 100644 --- a/ghc/lib/prelude/Concurrent_mc.hi +++ b/ghc/lib/prelude/Concurrent_mc.hi @@ -1,6 +1,6 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface Concurrent where -import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, unGetChan) +import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, putList2Chan, unGetChan) import ChannelVar(CVar(..), getCVar, newCVar, putCVar) import Merge(mergeIO, nmergeIO) import Parallel(par, seq) @@ -34,6 +34,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld) {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-} +putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-} unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-} getCVar :: CVar a -> _State _RealWorld -> (Either IOError13 a, _State _RealWorld) diff --git a/ghc/lib/prelude/Concurrent_mp.hi b/ghc/lib/prelude/Concurrent_mp.hi index 9a815f8ef6..a02ed58afa 100644 --- a/ghc/lib/prelude/Concurrent_mp.hi +++ b/ghc/lib/prelude/Concurrent_mp.hi @@ -1,6 +1,6 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface Concurrent where -import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, unGetChan) +import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, putList2Chan, unGetChan) import ChannelVar(CVar(..), getCVar, newCVar, putCVar) import Merge(mergeIO, nmergeIO) import Parallel(par, seq) @@ -34,6 +34,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld) {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-} +putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-} unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-} getCVar :: CVar a -> _State _RealWorld -> (Either IOError13 a, _State _RealWorld) diff --git a/ghc/lib/prelude/Concurrent_p.hi b/ghc/lib/prelude/Concurrent_p.hi index 29976ccd5b..04dc12fba6 100644 --- a/ghc/lib/prelude/Concurrent_p.hi +++ b/ghc/lib/prelude/Concurrent_p.hi @@ -1,6 +1,6 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface Concurrent where -import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, unGetChan) +import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, putList2Chan, unGetChan) import ChannelVar(CVar(..), getCVar, newCVar, putCVar) import Merge(mergeIO, nmergeIO) import Parallel(par, seq) @@ -34,6 +34,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld) {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-} +putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-} unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-} getCVar :: CVar a -> _State _RealWorld -> (Either IOError13 a, _State _RealWorld) diff --git a/ghc/lib/prelude/Concurrent_t.hi b/ghc/lib/prelude/Concurrent_t.hi index 29976ccd5b..04dc12fba6 100644 --- a/ghc/lib/prelude/Concurrent_t.hi +++ b/ghc/lib/prelude/Concurrent_t.hi @@ -1,6 +1,6 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface Concurrent where -import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, unGetChan) +import Channel(Chan(..), dupChan, getChan, getChanContents, newChan, putChan, putList2Chan, unGetChan) import ChannelVar(CVar(..), getCVar, newCVar, putCVar) import Merge(mergeIO, nmergeIO) import Parallel(par, seq) @@ -34,6 +34,8 @@ newChan :: _State _RealWorld -> (Either IOError13 (Chan a), _State _RealWorld) {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "U(P)" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_ #-} putChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-} +putList2Chan :: Chan a -> [a] -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _N_ _N_ #-} unGetChan :: Chan a -> a -> _State _RealWorld -> (Either IOError13 (), _State _RealWorld) {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "SLS" _N_ _N_ #-} getCVar :: CVar a -> _State _RealWorld -> (Either IOError13 a, _State _RealWorld) diff --git a/ghc/lib/prelude/IBool.hi b/ghc/lib/prelude/IBool.hi index de65c79734..31c86b35ff 100644 --- a/ghc/lib/prelude/IBool.hi +++ b/ghc/lib/prelude/IBool.hi @@ -26,7 +26,7 @@ instance Ord Bool _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} instance Text Bool {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/IBool.hs b/ghc/lib/prelude/IBool.hs index 24f5d1d1e3..33c353ca72 100644 --- a/ghc/lib/prelude/IBool.hs +++ b/ghc/lib/prelude/IBool.hs @@ -61,11 +61,10 @@ instance Enum Bool where ---------------------------------------------------------------------- instance Text Bool where - readsPrec p - = readParen (p > 9) - (\ b -> [ (False, c) | ("False", c) <- lex b ] - ++ [ (True, c) | ("True", c) <- lex b ]) + readsPrec p r + = readParen False (\ b -> [ (False, c) | ("False", c) <- lex b ]) r + ++ readParen False (\ b -> [ (True, c) | ("True", c) <- lex b ]) r - showsPrec d p r = (if p then "True" else "False") ++ r + showsPrec d p = showString (if p then "True" else "False") -- ToDo: Binary diff --git a/ghc/lib/prelude/IBool_mc.hi b/ghc/lib/prelude/IBool_mc.hi index de65c79734..31c86b35ff 100644 --- a/ghc/lib/prelude/IBool_mc.hi +++ b/ghc/lib/prelude/IBool_mc.hi @@ -26,7 +26,7 @@ instance Ord Bool _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} instance Text Bool {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/IBool_mp.hi b/ghc/lib/prelude/IBool_mp.hi index de65c79734..31c86b35ff 100644 --- a/ghc/lib/prelude/IBool_mp.hi +++ b/ghc/lib/prelude/IBool_mp.hi @@ -26,7 +26,7 @@ instance Ord Bool _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} instance Text Bool {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/IBool_p.hi b/ghc/lib/prelude/IBool_p.hi index de65c79734..31c86b35ff 100644 --- a/ghc/lib/prelude/IBool_p.hi +++ b/ghc/lib/prelude/IBool_p.hi @@ -26,7 +26,7 @@ instance Ord Bool _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} instance Text Bool {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/IBool_t.hi b/ghc/lib/prelude/IBool_t.hi index de65c79734..31c86b35ff 100644 --- a/ghc/lib/prelude/IBool_t.hi +++ b/ghc/lib/prelude/IBool_t.hi @@ -26,7 +26,7 @@ instance Ord Bool _tagCmp = _A_ 2 _U_ 11 _N_ _S_ "EE" _N_ _N_ #-} instance Text Bool {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/IInt.hs b/ghc/lib/prelude/IInt.hs index 2879d6a3ff..83344d7cf9 100644 --- a/ghc/lib/prelude/IInt.hs +++ b/ghc/lib/prelude/IInt.hs @@ -17,7 +17,6 @@ plusInt (I# x) (I# y) = I# (plusInt# x y) minusInt(I# x) (I# y) = I# (minusInt# x y) timesInt(I# x) (I# y) = I# (timesInt# x y) quotInt (I# x) (I# y) = I# (quotInt# x y) -divInt (I# x) (I# y) = I# (divInt# x y) remInt (I# x) (I# y) = I# (remInt# x y) negateInt (I# x) = I# (negateInt# x) gtInt (I# x) (I# y) = gtInt# x y diff --git a/ghc/lib/prelude/IList.hs b/ghc/lib/prelude/IList.hs index 30f6da3981..1b981d250c 100644 --- a/ghc/lib/prelude/IList.hs +++ b/ghc/lib/prelude/IList.hs @@ -2,7 +2,7 @@ module PreludeBuiltin where import Prel ( (&&) ) import Cls -import Core ( _readList, _showList ) +import Core import IChar import IInt import List ( (++) ) diff --git a/ghc/lib/prelude/List.hs b/ghc/lib/prelude/List.hs index 6059ee8b70..9ef43b6056 100644 --- a/ghc/lib/prelude/List.hs +++ b/ghc/lib/prelude/List.hs @@ -665,9 +665,9 @@ concat = foldr (++) [] # ifndef USE_FOLDR_BUILD -- HBC version (stolen) concat [] = [] -concat ([]:xss) = concat xss -- for better stack behaiour! -concat ([x]:xss) = x : concat xss -- this should help too ??? -concat (xs:xss) = xs ++ concat xss +concat ([]:xss) = concat xss -- for better stack behaviour! +--NO:bad strictness: concat ([x]:xss) = x : concat xss -- this should help too ??? +concat ((y:ys):xss) = y : (ys ++ concat xss) # else {-# INLINE concat #-} concat xs = _build (\ c n -> foldr (\ x y -> foldr c y x) n xs) diff --git a/ghc/lib/prelude/PS.hi b/ghc/lib/prelude/PS.hi index b55f39259b..db63ad277f 100644 --- a/ghc/lib/prelude/PS.hi +++ b/ghc/lib/prelude/PS.hi @@ -26,6 +26,8 @@ _foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-} _foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-} +_getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} _headPS :: _PackedString -> Char {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} _indexPS :: _PackedString -> Int -> Char @@ -82,6 +84,8 @@ _wordsPS :: _PackedString -> [_PackedString] {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} unpackPS# :: Addr# -> [Char] {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-} +unpackPS2# :: Addr# -> Int# -> [Char] + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "PP" _N_ _N_ #-} instance Eq _PackedString {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_ (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, diff --git a/ghc/lib/prelude/PS.lhs b/ghc/lib/prelude/PS.lhs index e5891b1075..7ed2312313 100644 --- a/ghc/lib/prelude/PS.lhs +++ b/ghc/lib/prelude/PS.lhs @@ -26,9 +26,10 @@ module PreludePS{-yes, a Prelude module!-} ( _psToByteArray, _unpackPS, - unpackPS#, + unpackPS#, unpackPS2#, -- toCString, _putPS, + _getPS, _headPS, _tailPS, @@ -110,7 +111,8 @@ _psToByteArray :: _PackedString -> _ByteArray Int --OLD: packToCString :: [Char] -> _ByteArray Int -- hmmm... weird name _unpackPS :: _PackedString -> [Char] -unpackPS# :: Addr# -> [Char] -- calls injected by compiler +unpackPS# :: Addr# -> [Char] -- calls injected by compiler +unpackPS2# :: Addr# -> Int# -> [Char] -- calls injected by compiler --???toCString :: _PackedString -> ByteArray# _putPS :: _FILE -> _PackedString -> PrimIO () -- ToDo: more sensible type \end{code} @@ -274,6 +276,10 @@ unpackPS# addr -- calls injected by compiler where len = case (strlen# addr) of { I# x -> x } +unpackPS2# addr len -- calls injected by compiler + -- this one is for literal strings with NULs in them; rare. + = _unpackPS (_packCBytes (I# len) (A# addr)) + -- OK, but this code gets *hammered*: -- _unpackPS ps -- = [ _indexPS ps n | n <- [ 0::Int .. _lengthPS ps - 1 ] ] @@ -320,6 +326,38 @@ _putPS file (_CPS addr len) returnPrimIO () \end{code} +The dual to @_putPS@, note that the size of the chunk specified +is the upper bound of the size of the chunk returned. + +\begin{code} +_getPS :: _FILE -> Int -> PrimIO _PackedString +_getPS file len@(I# len#) + | len# <=# 0# = returnPrimIO _nilPS -- I'm being kind here. + | otherwise = + -- Allocate an array for system call to store its bytes into. + new_ps_array len# `thenPrimIO` \ ch_arr -> + freeze_ps_array ch_arr `thenPrimIO` \ (_ByteArray _ frozen#) -> + let + byte_array = _ByteArray (0, I# len#) frozen# + in + _ccall_ fread byte_array (1::Int) len file `thenPrimIO` \ (I# read#) -> + if read# ==# 0# then -- EOF or other error + error "_getPS: EOF reached or other error" + else + {- + The system call may not return the number of + bytes requested. Instead of failing with an error + if the number of bytes read is less than requested, + a packed string containing the bytes we did manage + to snarf is returned. + -} + let + has_null = byteArrayHasNUL# frozen# read# + in + returnPrimIO (_PS frozen# read# has_null) + +\end{code} + %************************************************************************ %* * \subsection{List-mimicking functions for @_PackedStrings@} diff --git a/ghc/lib/prelude/PS_mc.hi b/ghc/lib/prelude/PS_mc.hi index b55f39259b..db63ad277f 100644 --- a/ghc/lib/prelude/PS_mc.hi +++ b/ghc/lib/prelude/PS_mc.hi @@ -26,6 +26,8 @@ _foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-} _foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-} +_getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} _headPS :: _PackedString -> Char {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} _indexPS :: _PackedString -> Int -> Char @@ -82,6 +84,8 @@ _wordsPS :: _PackedString -> [_PackedString] {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} unpackPS# :: Addr# -> [Char] {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-} +unpackPS2# :: Addr# -> Int# -> [Char] + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "PP" _N_ _N_ #-} instance Eq _PackedString {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_ (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, diff --git a/ghc/lib/prelude/PS_mg.hi b/ghc/lib/prelude/PS_mg.hi index b55f39259b..ef8880ef40 100644 --- a/ghc/lib/prelude/PS_mg.hi +++ b/ghc/lib/prelude/PS_mg.hi @@ -82,6 +82,8 @@ _wordsPS :: _PackedString -> [_PackedString] {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} unpackPS# :: Addr# -> [Char] {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-} +unpackPS2# :: Addr# -> Int# -> [Char] + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "PP" _N_ _N_ #-} instance Eq _PackedString {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_ (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, diff --git a/ghc/lib/prelude/PS_mp.hi b/ghc/lib/prelude/PS_mp.hi index b55f39259b..db63ad277f 100644 --- a/ghc/lib/prelude/PS_mp.hi +++ b/ghc/lib/prelude/PS_mp.hi @@ -26,6 +26,8 @@ _foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-} _foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-} +_getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} _headPS :: _PackedString -> Char {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} _indexPS :: _PackedString -> Int -> Char @@ -82,6 +84,8 @@ _wordsPS :: _PackedString -> [_PackedString] {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} unpackPS# :: Addr# -> [Char] {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-} +unpackPS2# :: Addr# -> Int# -> [Char] + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "PP" _N_ _N_ #-} instance Eq _PackedString {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_ (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, diff --git a/ghc/lib/prelude/PS_p.hi b/ghc/lib/prelude/PS_p.hi index b55f39259b..db63ad277f 100644 --- a/ghc/lib/prelude/PS_p.hi +++ b/ghc/lib/prelude/PS_p.hi @@ -26,6 +26,8 @@ _foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-} _foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-} +_getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} _headPS :: _PackedString -> Char {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} _indexPS :: _PackedString -> Int -> Char @@ -82,6 +84,8 @@ _wordsPS :: _PackedString -> [_PackedString] {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} unpackPS# :: Addr# -> [Char] {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-} +unpackPS2# :: Addr# -> Int# -> [Char] + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "PP" _N_ _N_ #-} instance Eq _PackedString {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_ (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, diff --git a/ghc/lib/prelude/PS_t.hi b/ghc/lib/prelude/PS_t.hi index b55f39259b..db63ad277f 100644 --- a/ghc/lib/prelude/PS_t.hi +++ b/ghc/lib/prelude/PS_t.hi @@ -26,6 +26,8 @@ _foldlPS :: (a -> Char -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-} _foldrPS :: (Char -> a -> a) -> a -> _PackedString -> a {-# GHC_PRAGMA _A_ 3 _U_ 221 _N_ _S_ "LLS" _N_ _N_ #-} +_getPS :: _FILE -> Int -> _State _RealWorld -> (_PackedString, _State _RealWorld) + {-# GHC_PRAGMA _A_ 3 _U_ 111 _N_ _S_ "LU(P)U(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} _headPS :: _PackedString -> Char {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "S" _N_ _N_ #-} _indexPS :: _PackedString -> Int -> Char @@ -82,6 +84,8 @@ _wordsPS :: _PackedString -> [_PackedString] {-# GHC_PRAGMA _A_ 1 _U_ 1 _N_ _S_ "S" _N_ _N_ #-} unpackPS# :: Addr# -> [Char] {-# GHC_PRAGMA _A_ 1 _U_ 2 _N_ _S_ "P" _N_ _N_ #-} +unpackPS2# :: Addr# -> Int# -> [Char] + {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "PP" _N_ _N_ #-} instance Eq _PackedString {-# GHC_PRAGMA _M_ PreludePS {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 3 _!_ _TUP_2 [(_PackedString -> _PackedString -> Bool), (_PackedString -> _PackedString -> Bool)] [_CONSTM_ Eq (==) (_PackedString), _CONSTM_ Eq (/=) (_PackedString)] _N_ (==) = _A_ 2 _U_ 22 _N_ _S_ "SS" _N_ _N_, diff --git a/ghc/lib/prelude/PrelCore13.hi b/ghc/lib/prelude/PrelCore13.hi index 0116c44923..50ccfbd719 100644 --- a/ghc/lib/prelude/PrelCore13.hi +++ b/ghc/lib/prelude/PrelCore13.hi @@ -875,7 +875,7 @@ instance (Text a, Text b) => Text (Assoc a b) {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} instance Text Bool {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/PrelCore13_mc.hi b/ghc/lib/prelude/PrelCore13_mc.hi index 0116c44923..50ccfbd719 100644 --- a/ghc/lib/prelude/PrelCore13_mc.hi +++ b/ghc/lib/prelude/PrelCore13_mc.hi @@ -875,7 +875,7 @@ instance (Text a, Text b) => Text (Assoc a b) {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} instance Text Bool {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/PrelCore13_mp.hi b/ghc/lib/prelude/PrelCore13_mp.hi index 0109c89244..fcf715ece2 100644 --- a/ghc/lib/prelude/PrelCore13_mp.hi +++ b/ghc/lib/prelude/PrelCore13_mp.hi @@ -875,7 +875,7 @@ instance (Text a, Text b) => Text (Assoc a b) {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} instance Text Bool {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/PrelCore13_p.hi b/ghc/lib/prelude/PrelCore13_p.hi index 0116c44923..50ccfbd719 100644 --- a/ghc/lib/prelude/PrelCore13_p.hi +++ b/ghc/lib/prelude/PrelCore13_p.hi @@ -875,7 +875,7 @@ instance (Text a, Text b) => Text (Assoc a b) {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} instance Text Bool {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/PrelCore13_t.hi b/ghc/lib/prelude/PrelCore13_t.hi index 0116c44923..50ccfbd719 100644 --- a/ghc/lib/prelude/PrelCore13_t.hi +++ b/ghc/lib/prelude/PrelCore13_t.hi @@ -875,7 +875,7 @@ instance (Text a, Text b) => Text (Assoc a b) {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} instance Text Bool {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/PreludeCore.hi b/ghc/lib/prelude/PreludeCore.hi index 9f36cd0d5d..2ee598996f 100644 --- a/ghc/lib/prelude/PreludeCore.hi +++ b/ghc/lib/prelude/PreludeCore.hi @@ -862,7 +862,7 @@ instance (Text a, Text b) => Text (Assoc a b) {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} instance Text Bool {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/PreludeCore_mc.hi b/ghc/lib/prelude/PreludeCore_mc.hi index 9f36cd0d5d..2ee598996f 100644 --- a/ghc/lib/prelude/PreludeCore_mc.hi +++ b/ghc/lib/prelude/PreludeCore_mc.hi @@ -862,7 +862,7 @@ instance (Text a, Text b) => Text (Assoc a b) {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} instance Text Bool {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/PreludeCore_mp.hi b/ghc/lib/prelude/PreludeCore_mp.hi index b966a8d186..888e7ace17 100644 --- a/ghc/lib/prelude/PreludeCore_mp.hi +++ b/ghc/lib/prelude/PreludeCore_mp.hi @@ -862,7 +862,7 @@ instance (Text a, Text b) => Text (Assoc a b) {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} instance Text Bool {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/PreludeCore_p.hi b/ghc/lib/prelude/PreludeCore_p.hi index 9f36cd0d5d..2ee598996f 100644 --- a/ghc/lib/prelude/PreludeCore_p.hi +++ b/ghc/lib/prelude/PreludeCore_p.hi @@ -862,7 +862,7 @@ instance (Text a, Text b) => Text (Assoc a b) {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} instance Text Bool {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/PreludeCore_t.hi b/ghc/lib/prelude/PreludeCore_t.hi index 9f36cd0d5d..2ee598996f 100644 --- a/ghc/lib/prelude/PreludeCore_t.hi +++ b/ghc/lib/prelude/PreludeCore_t.hi @@ -862,7 +862,7 @@ instance (Text a, Text b) => Text (Assoc a b) {-# GHC_PRAGMA _M_ PreludeArray {-dfun-} _A_ 2 _U_ 22 _N_ _N_ _N_ _N_ #-} instance Text Bool {-# GHC_PRAGMA _M_ PreludeCore {-dfun-} _A_ 0 _N_ _N_ _N_ _F_ _IF_ARGS_ 0 0 X 5 _!_ _TUP_4 [(Int -> [Char] -> [(Bool, [Char])]), (Int -> Bool -> [Char] -> [Char]), ([Char] -> [([Bool], [Char])]), ([Bool] -> [Char] -> [Char])] [_CONSTM_ Text readsPrec (Bool), _CONSTM_ Text showsPrec (Bool), _CONSTM_ Text readList (Bool), _CONSTM_ Text showList (Bool)] _N_ - readsPrec = _A_ 1 _U_ 12 _N_ _S_ "U(P)" {_A_ 1 _U_ 22 _N_ _N_ _N_ _N_} _N_ _N_, + readsPrec = _A_ 2 _U_ 02 _N_ _S_ "AL" {_A_ 1 _U_ 2 _N_ _N_ _N_ _N_} _N_ _N_, showsPrec = _A_ 3 _U_ 012 _N_ _S_ "AEL" {_A_ 2 _U_ 12 _N_ _N_ _N_ _N_} _N_ _N_, readList = _A_ 0 _U_ 2 _N_ _N_ _N_ _N_, showList = _A_ 0 _U_ 12 _N_ _N_ _N_ _N_ #-} diff --git a/ghc/lib/prelude/PreludeStdIO.lhs b/ghc/lib/prelude/PreludeStdIO.lhs index 941da2f145..8207a624a9 100644 --- a/ghc/lib/prelude/PreludeStdIO.lhs +++ b/ghc/lib/prelude/PreludeStdIO.lhs @@ -160,6 +160,7 @@ _bufferMode (_ReadHandle _ m _) = m _bufferMode (_WriteHandle _ m _) = m _bufferMode (_AppendHandle _ m _) = m _bufferMode (_ReadWriteHandle _ m _) = m +_bufferMode (_SocketHandle _ _) = (Just NoBuffering) _markHandle :: _Handle -> _Handle _markHandle h@(_ReadHandle fp m b) @@ -476,9 +477,11 @@ hSetBuffering handle mode = _SemiClosedHandle _ _ -> putMVar handle htype >> failWith (IllegalOperation "handle is closed") +{- _SocketHandle _ _ -> putMVar handle htype >> failWith (IllegalOperation "buffering not supported for socket handles") +-} other -> _ccall_ setBuffering (_filePtr other) bsize `thenPrimIO` \ rc -> @@ -511,6 +514,7 @@ hSetBuffering handle mode = hcon (_WriteHandle _ _ _) = _WriteHandle hcon (_AppendHandle _ _ _) = _AppendHandle hcon (_ReadWriteHandle _ _ _) = _ReadWriteHandle + hcon (_SocketHandle _ _) = \ a _ v -> _SocketHandle a v \end{code} diff --git a/ghc/lib/unix-libs.lit b/ghc/lib/unix-libs.lit new file mode 100644 index 0000000000..e6257cf1f8 --- /dev/null +++ b/ghc/lib/unix-libs.lit @@ -0,0 +1,35 @@ +\begin{onlystandalone} +\documentstyle[11pt,literate,a4wide,titlepage]{article} +\begin{document} +\title{Adding Unix Libraries to GHC} +\author{Darren J Moffat} +\date{July 1995} +\maketitle +\tableofcontents +\end{onlystandalone} + + +\begin{onlypartofdoc} +\section[UnixLibs]{Unix Libraries} +\downsection +\end{onlypartofdoc} + + +\input{ghc/Socket.lhs} +\input{ghc/SocketPrim.lhs} +\input{ghc/BSD.lhs} +\input{ghc/Readline.lhs} +%\input{DBM.lhs} +%\input{WWW.lhs} + + +\begin{onlypartofdoc} +\upsection +\end{onlypartofdoc} + +\begin{onlystandalone} +\printindex +\end{document} +\end{onlystandalone} + + |