[MLton-commit] r4424
Matthew Fluet
MLton@mlton.org
Sun, 30 Apr 2006 07:07:25 -0700
Refactored Posix.FileSys
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-27 15:48:05 UTC (rev 4423)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-30 14:07:24 UTC (rev 4424)
@@ -220,13 +220,13 @@
../posix/stub-mingw.sml
../posix/flags.sig
- (* ../posix/flags.sml *)
+ ../posix/flags.sml
../posix/signal.sig
../posix/signal.sml
../posix/proc-env.sig
../posix/proc-env.sml
../posix/file-sys.sig
- (* ../posix/file-sys.sml *)
+ ../posix/file-sys.sml
../posix/io.sig
(* ../posix/io.sml *)
../posix/process.sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml 2006-04-27 15:48:05 UTC (rev 4423)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/int1.sml 2006-04-30 14:07:24 UTC (rev 4424)
@@ -21,6 +21,16 @@
val fromInt32: Primitive.Int32.int -> int
val fromInt64: Primitive.Int64.int -> int
val fromIntInf: Primitive.IntInf.int -> int
+ (* Overflow checking, unsigned interp. *)
+ val fromWord8: Primitive.Word8.word -> int
+ val fromWord16: Primitive.Word16.word -> int
+ val fromWord32: Primitive.Word32.word -> int
+ val fromWord64: Primitive.Word64.word -> int
+ (* Overflow checking, signed interp. *)
+ val fromWord8X: Primitive.Word8.word -> int
+ val fromWord16X: Primitive.Word16.word -> int
+ val fromWord32X: Primitive.Word32.word -> int
+ val fromWord64X: Primitive.Word64.word -> int
(* Lowbits or sign-extend. *)
val toInt8Unsafe: int -> Primitive.Int8.int
val toInt16Unsafe: int -> Primitive.Int16.int
@@ -33,6 +43,16 @@
val toInt32: int -> Primitive.Int32.int
val toInt64: int -> Primitive.Int64.int
val toIntInf: int -> Primitive.IntInf.int
+ (* Lowbits or zero extend. *)
+ val toWord8: int -> Primitive.Word8.word
+ val toWord16: int -> Primitive.Word16.word
+ val toWord32: int -> Primitive.Word32.word
+ val toWord64: int -> Primitive.Word64.word
+ (* Lowbits or sign extend. *)
+ val toWord8X: int -> Primitive.Word8.word
+ val toWord16X: int -> Primitive.Word16.word
+ val toWord32X: int -> Primitive.Word32.word
+ val toWord64X: int -> Primitive.Word64.word
end
signature INT_FROM_TO_RES =
@@ -41,17 +61,25 @@
val fromIntUnsafe: Int.int -> int
val fromInt: Int.int -> int
- val fromLargeIntUnsafe: LargeInt.int -> int
- val fromLargeUnsafe: LargeInt.int -> int
val fromLargeInt: LargeInt.int -> int
val fromLarge: LargeInt.int -> int
+ val fromWord: Word.word -> int
+ val fromWordX: Word.word -> int
+ val fromLargeWord: LargeWord.word -> int
+ val fromLargeWordX: LargeWord.word -> int
+ val fromSysWord: SysWord.word -> int
+ val fromSysWordX: SysWord.word -> int
val toIntUnsafe: int -> Int.int
val toInt: int -> Int.int
- val toLargeIntUnsafe: int -> LargeInt.int
- val toLargeUnsafe: int -> LargeInt.int
val toLargeInt: int -> LargeInt.int
val toLarge: int -> LargeInt.int
+ val toWord: int -> Word.word
+ val toWordX: int -> Word.word
+ val toLargeWord: int -> LargeWord.word
+ val toLargeWordX: int -> LargeWord.word
+ val toSysWord: int -> SysWord.word
+ val toSysWordX: int -> SysWord.word
end
functor IntFromTo(I: INT_FROM_TO_ARG): INT_FROM_TO_RES where type int = I.int =
@@ -86,19 +114,6 @@
structure S =
LargeInt_ChooseInt
(type 'a t = 'a -> int
- val fInt8 = I.fromInt8Unsafe
- val fInt16 = I.fromInt16Unsafe
- val fInt32 = I.fromInt32Unsafe
- val fInt64 = I.fromInt64Unsafe
- val fIntInf = I.fromIntInfUnsafe)
- in
- val fromLargeIntUnsafe = S.f
- val fromLargeUnsafe = fromLargeIntUnsafe
- end
- local
- structure S =
- LargeInt_ChooseInt
- (type 'a t = 'a -> int
val fInt8 = I.fromInt8
val fInt16 = I.fromInt16
val fInt32 = I.fromInt32
@@ -108,6 +123,72 @@
val fromLargeInt = S.f
val fromLarge = fromLargeInt
end
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = 'a -> int
+ val fWord8 = I.fromWord8
+ val fWord16 = I.fromWord16
+ val fWord32 = I.fromWord32
+ val fWord64 = I.fromWord64)
+ in
+ val fromWord = S.f
+ end
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = 'a -> int
+ val fWord8 = I.fromWord8X
+ val fWord16 = I.fromWord16X
+ val fWord32 = I.fromWord32X
+ val fWord64 = I.fromWord64X)
+ in
+ val fromWordX = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = 'a -> int
+ val fWord8 = I.fromWord8
+ val fWord16 = I.fromWord16
+ val fWord32 = I.fromWord32
+ val fWord64 = I.fromWord64)
+ in
+ val fromLargeWord = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = 'a -> int
+ val fWord8 = I.fromWord8X
+ val fWord16 = I.fromWord16X
+ val fWord32 = I.fromWord32X
+ val fWord64 = I.fromWord64X)
+ in
+ val fromLargeWordX = S.f
+ end
+ local
+ structure S =
+ SysWord_ChooseWordN
+ (type 'a t = 'a -> int
+ val fWord8 = I.fromWord8
+ val fWord16 = I.fromWord16
+ val fWord32 = I.fromWord32
+ val fWord64 = I.fromWord64)
+ in
+ val fromSysWord = S.f
+ end
+ local
+ structure S =
+ SysWord_ChooseWordN
+ (type 'a t = 'a -> int
+ val fWord8 = I.fromWord8X
+ val fWord16 = I.fromWord16X
+ val fWord32 = I.fromWord32X
+ val fWord64 = I.fromWord64X)
+ in
+ val fromSysWordX = S.f
+ end
local
structure S =
@@ -137,19 +218,6 @@
structure S =
LargeInt_ChooseInt
(type 'a t = int -> 'a
- val fInt8 = I.toInt8Unsafe
- val fInt16 = I.toInt16Unsafe
- val fInt32 = I.toInt32Unsafe
- val fInt64 = I.toInt64Unsafe
- val fIntInf = I.toIntInfUnsafe)
- in
- val toLargeIntUnsafe = S.f
- val toLargeUnsafe = toLargeIntUnsafe
- end
- local
- structure S =
- LargeInt_ChooseInt
- (type 'a t = int -> 'a
val fInt8 = I.toInt8
val fInt16 = I.toInt16
val fInt32 = I.toInt32
@@ -159,6 +227,72 @@
val toLargeInt = S.f
val toLarge = toLargeInt
end
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = int -> 'a
+ val fWord8 = I.toWord8
+ val fWord16 = I.toWord16
+ val fWord32 = I.toWord32
+ val fWord64 = I.toWord64)
+ in
+ val toWord = S.f
+ end
+ local
+ structure S =
+ Word_ChooseWordN
+ (type 'a t = int -> 'a
+ val fWord8 = I.toWord8X
+ val fWord16 = I.toWord16X
+ val fWord32 = I.toWord32X
+ val fWord64 = I.toWord64X)
+ in
+ val toWordX = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = int -> 'a
+ val fWord8 = I.toWord8
+ val fWord16 = I.toWord16
+ val fWord32 = I.toWord32
+ val fWord64 = I.toWord64)
+ in
+ val toLargeWord = S.f
+ end
+ local
+ structure S =
+ LargeWord_ChooseWordN
+ (type 'a t = int -> 'a
+ val fWord8 = I.toWord8X
+ val fWord16 = I.toWord16X
+ val fWord32 = I.toWord32X
+ val fWord64 = I.toWord64X)
+ in
+ val toLargeWordX = S.f
+ end
+ local
+ structure S =
+ SysWord_ChooseWordN
+ (type 'a t = int -> 'a
+ val fWord8 = I.toWord8
+ val fWord16 = I.toWord16
+ val fWord32 = I.toWord32
+ val fWord64 = I.toWord64)
+ in
+ val toSysWord = S.f
+ end
+ local
+ structure S =
+ SysWord_ChooseWordN
+ (type 'a t = int -> 'a
+ val fWord8 = I.toWord8X
+ val fWord16 = I.toWord16X
+ val fWord32 = I.toWord32X
+ val fWord64 = I.toWord64X)
+ in
+ val toSysWordX = S.f
+ end
end
structure Primitive = struct
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig 2006-04-27 15:48:05 UTC (rev 4423)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/integer/integer.sig 2006-04-30 14:07:24 UTC (rev 4424)
@@ -68,6 +68,9 @@
val leu: int * int -> bool
val gtu: int * int -> bool
val geu: int * int -> bool
+
+ val fromSysWord: SysWord.word -> int
+ val toSysWord: int -> SysWord.word
end
signature INTEGER =
@@ -114,4 +117,7 @@
val leu: int * int -> bool
val gtu: int * int -> bool
val geu: int * int -> bool
+
+ val fromSysWord: SysWord.word -> int
+ val toSysWord: int -> SysWord.word
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sig 2006-04-27 15:48:05 UTC (rev 4423)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sig 2006-04-30 14:07:24 UTC (rev 4424)
@@ -124,5 +124,5 @@
sig
include POSIX_FILE_SYS
- val wordToOpenMode: SysWord.word -> open_mode
+ val flagsToOpenMode: O.flags -> open_mode
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-04-27 15:48:05 UTC (rev 4423)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-04-30 14:07:24 UTC (rev 4424)
@@ -10,20 +10,20 @@
struct
structure Error = PosixError
- (* Patch to make Time look like it deals with Int.int
+ (* Patch to make Time look like it deals with C_Time.t
* instead of LargeInt.int.
*)
structure Time =
struct
open Time
- val fromSeconds = fromSeconds o LargeInt.fromInt
+ val fromSeconds = fromSeconds o C_Time.toLarge
fun toSeconds t =
- LargeInt.toInt (Time.toSeconds t)
+ C_Time.fromLarge (Time.toSeconds t)
handle Overflow => Error.raiseSys Error.inval
end
-
+
structure SysCall = Error.SysCall
structure Prim = PrimitiveFFI.Posix.FileSys
open Prim
@@ -151,13 +151,8 @@
structure S =
struct
- open S
- local
- structure Flags = BitFlags(structure W = C_Mode
- val all = 0wxFFFF)
- in
- open Flags
- end
+ structure Flags = BitFlags(structure S = C_Mode)
+ open S Flags
type mode = C_Mode.t
val ifblk = IFBLK
val ifchr = IFCHR
@@ -186,6 +181,7 @@
structure O =
struct
+ structure Flags = BitFlags(structure S = C_Int)
open O Flags
val append = APPEND
val binary = BINARY
@@ -205,13 +201,13 @@
datatype open_mode = O_RDONLY | O_WRONLY | O_RDWR
- fun wordToOpenMode w =
- if w = O.rdonly then O_RDONLY
- else if w = O.wronly then O_WRONLY
- else if w = O.rdwr then O_RDWR
- else raise Fail "wordToOpenMode: unknown word"
+ fun flagsToOpenMode f =
+ if f = O.rdonly then O_RDONLY
+ else if f = O.wronly then O_WRONLY
+ else if f = O.rdwr then O_RDWR
+ else raise Fail "flagsToOpenMode: unknown flag"
- val openModeToWord =
+ val openModeToFlags =
fn O_RDONLY => O.rdonly
| O_WRONLY => O.wronly
| O_RDWR => O.rdwr
@@ -219,12 +215,13 @@
fun createf (pathname, openMode, flags, mode) =
let
val pathname = NullString.nullTerm pathname
- val flags = Flags.flags [openModeToWord openMode,
- flags,
- O.creat]
+ val flags = O.Flags.flags [openModeToFlags openMode,
+ flags,
+ O.creat]
+ val flags = C_Int.fromSysWord (O.Flags.toWord flags)
val fd =
SysCall.simpleResult
- (fn () => Prim.open3 (pathname, SysWord.toInt flags, mode))
+ (fn () => Prim.open3 (pathname, flags, mode))
in
fd
end
@@ -232,10 +229,11 @@
fun openf (pathname, openMode, flags) =
let
val pathname = NullString.nullTerm pathname
- val flags = Flags.flags [openModeToWord openMode, flags]
+ val flags = O.Flags.flags [openModeToFlags openMode, flags]
+ val flags = C_Int.fromSysWord (O.Flags.toWord flags)
val fd =
SysCall.simpleResult
- (fn () => Prim.open3 (pathname, SysWord.toInt flags, C_Mode.fromWord 0w0))
+ (fn () => Prim.open3 (pathname, flags, C_Mode.fromInt 0))
in
fd
end
@@ -278,7 +276,7 @@
SysCall.syscall'
({errVal = C_SSize.fromInt ~1}, fn () =>
(Prim.readlink (path, buf, C_Size.fromInt size), fn len =>
- ArraySlice.vector (ArraySlice.slice (buf, 0, SOME len))))
+ ArraySlice.vector (ArraySlice.slice (buf, 0, SOME (C_SSize.toInt len)))))
end
end
@@ -362,7 +360,7 @@
fun access (path: string, mode: access_mode list): bool =
let
- val mode = SysWord.toInt (Flags.flags (map SysWord.fromInt (A.F_OK :: (map conv_access_mode mode))))
+ val mode = List.foldl C_Int.orb 0 (A.F_OK :: (map conv_access_mode mode))
val path = NullString.nullTerm path
in
SysCall.syscallErr
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sml 2006-04-27 15:48:05 UTC (rev 4423)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/flags.sml 2006-04-30 14:07:24 UTC (rev 4424)
@@ -7,27 +7,29 @@
*)
functor BitFlags(structure S : sig
- type t
- val all: t
+ eqtype t
val toSysWord: t -> SysWord.word
val fromSysWord: SysWord.word -> t
+ val andb: t * t -> t
+ val notb: t -> t
+ val orb: t * t -> t
end): BIT_FLAGS_EXTRA =
struct
type flags = S.t
- val all: flags = S.all
+ val all: flags = S.fromSysWord (SysWord.~ 0w1)
val empty: flags = S.fromSysWord 0w0
- fun toWord f = W.toSysWord f
- fun fromWord w = W.fromSysWord (SysWord.andb(w, toWord all))
+ fun toWord f = S.toSysWord f
+ fun fromWord w = S.fromSysWord (SysWord.andb (w, toWord all))
- val flags: flags list -> flags = List.foldl W.orb empty
+ val flags: flags list -> flags = List.foldl S.orb empty
- val intersect: flags list -> flags = List.foldl W.andb all
+ val intersect: flags list -> flags = List.foldl S.andb all
- fun clear(f, f') = W.andb(W.notb f, f')
+ fun clear (f, f') = S.andb (S.notb f, f')
- fun allSet(f, f') = W.andb(f, f') = f
+ fun allSet (f, f') = S.andb (f, f') = f'
- fun anySet(f, f') = W.andb(f, f') <> empty
+ fun anySet (f, f') = S.andb (f, f') <> empty
end